Unpack disk2.tgz
This commit is contained in:
parent
e5f37aa173
commit
3a12151067
|
@ -0,0 +1,124 @@
|
|||
; =====> ALINK.ASM
|
||||
;***************************************
|
||||
;* TIPC Scheme '84 Runtime Support *
|
||||
;* Misc Utilities *
|
||||
;* *
|
||||
;* (C) Copyright 1985 by Texas *
|
||||
;* Instruments Incorporated. *
|
||||
;* All rights reserved. *
|
||||
;* *
|
||||
;* Date Written: 23 June 1985 *
|
||||
;* Last Modification: 29 May 1986 *
|
||||
;***************************************
|
||||
page 60,132
|
||||
|
||||
MSDOS equ 021h
|
||||
|
||||
DGROUP group data
|
||||
data segment word public 'DATA'
|
||||
assume DS:DGROUP
|
||||
extrn _psp:dword
|
||||
ret_area db 20 dup (0) ; filename return area
|
||||
dir_fnd db ' <DIR>'
|
||||
|
||||
data ends
|
||||
|
||||
PGROUP group prog
|
||||
prog segment byte public 'PROG'
|
||||
assume CS:PGROUP
|
||||
|
||||
;************************************************************************
|
||||
;* Find Match File *
|
||||
;* *
|
||||
;* Purpose: Given a pathname specification, which may contain wildcard *
|
||||
;* characters, this routine returns the first filename in *
|
||||
;* the current directory which matches the specification. *
|
||||
;************************************************************************
|
||||
|
||||
find_arg struc
|
||||
dw ? ; caller's ES
|
||||
dw ? ; caller's BP
|
||||
dw ? ; return address
|
||||
filespec dw ? ; pointer to file spec (ASCIZ string)
|
||||
find_arg ends
|
||||
|
||||
public dir1
|
||||
dir1 proc near
|
||||
push BP ; save the caller's BP
|
||||
push ES
|
||||
mov BP,SP ; establish local addressability
|
||||
|
||||
mov AX,word ptr _psp+2
|
||||
mov ES,AX ; set ES to point to the psp
|
||||
|
||||
push DS ; save DS
|
||||
push ES
|
||||
pop DS ; set DS to point to the psp
|
||||
|
||||
; set Disk Transfer Address (DTA) to 80h in the psp
|
||||
mov AH,1ah ; load "set DTA" function code
|
||||
mov DX,80h ; load DTA offset
|
||||
int MSDOS
|
||||
pop DS ; restore DS
|
||||
|
||||
; issue service call to find the first file match
|
||||
mov DX,[BP].filespec ; load address of filespec in DS:DX
|
||||
mov CX,10h ; set attributes to search for,
|
||||
; directories and all files except for
|
||||
; hidden and system files.
|
||||
mov AH,04Eh ; load "find match file" function code
|
||||
int MSDOS ; perform the service call
|
||||
; if no file found, return a null string ("")
|
||||
jnc dir1_ok ; if filename returned, jump
|
||||
dir1_nf: xor AX,AX ; return a null pointer
|
||||
jmp short dir1_ret
|
||||
; copy filename found from DTA to local storage
|
||||
dir1_ok: mov SI,09eh ; load offset of DTA filename area
|
||||
mov DI,offset ret_area ; load address of local filename storage
|
||||
cmp byte ptr ES:[SI],2eh ; don't bother with . and ..
|
||||
je dir2_nxt
|
||||
|
||||
dir1_x: mov AL,ES:[SI] ; load next character of filename
|
||||
cmp AL,00H ; character a null string?
|
||||
je dir1_y
|
||||
mov [DI],AL ; and store it into return area
|
||||
inc DI ; increment return area pointer
|
||||
inc SI
|
||||
jmp dir1_x ; if more characters, loop (jump)
|
||||
dir1_y: and byte ptr ES:[95h],10h ; check for directory bit
|
||||
cmp byte ptr ES:[95h],10h
|
||||
jne dir_done
|
||||
mov SI,offset dir_fnd ; load offset of directory message
|
||||
mov CX,6
|
||||
dir1_z: mov AL,[SI]
|
||||
mov [DI],AL
|
||||
inc DI
|
||||
inc SI
|
||||
loop dir1_z
|
||||
dir_done: mov byte ptr [DI],00h ; add in null byte to terminate string
|
||||
mov AX,offset ret_area ; load offset of filename copy
|
||||
; return to caller
|
||||
dir1_ret: pop ES
|
||||
pop BP ; restore caller's BP
|
||||
ret ; return to caller
|
||||
dir1 endp
|
||||
|
||||
public dir2
|
||||
dir2 proc near
|
||||
push BP ; save the caller's BP
|
||||
push ES
|
||||
|
||||
mov AX,word ptr _psp+2
|
||||
mov ES,AX ; set ES to point to the psp
|
||||
|
||||
; issue service call to find the next file match
|
||||
dir2_nxt: mov AH,04Fh ; load "step, matching files" function code
|
||||
int MSDOS ; perform the service call
|
||||
; if no file found, return a null string ("")
|
||||
jnc dir1_ok ; if filename returned, jump
|
||||
jmp short dir1_nf ; else, return filename found
|
||||
dir2 endp
|
||||
|
||||
prog ends
|
||||
end
|
||||
|
|
@ -0,0 +1,352 @@
|
|||
; =====> BASICIO.ASM
|
||||
;********************************************************
|
||||
;* Scheme Runtime Support *
|
||||
;* Memory Allocation Routines *
|
||||
;* for Variable Length Objects *
|
||||
;* *
|
||||
;* (C) Copyright 1985 by Texas *
|
||||
;* Instruments Incorporated. *
|
||||
;* All rights reserved. *
|
||||
;* *
|
||||
;* Date Written: 31 December 1987 *
|
||||
;* Last Modification: *
|
||||
;********************************************************
|
||||
page 60,132
|
||||
include memtype.equ
|
||||
include scheme.equ
|
||||
|
||||
SMALL_SIZE equ 1024 ;space in page not worth searching
|
||||
|
||||
DGROUP group data
|
||||
data segment word public 'DATA'
|
||||
assume DS:DGROUP
|
||||
data ends
|
||||
|
||||
PGROUP group prog
|
||||
prog segment byte public 'PROG'
|
||||
assume CS:PGROUP
|
||||
|
||||
extrn alloc_bi:near,alloc_pa:near,garbage:near,gcsquish:near
|
||||
extrn out_of_m:near
|
||||
|
||||
;;;ALLOC_BLOCK
|
||||
;;;
|
||||
;;; calling sequence: alloc_block(reg, type, size)
|
||||
;;;
|
||||
;;; local storage: int temp_ret,*last_page,page,str_size
|
||||
;;;
|
||||
al_args struc
|
||||
temp_ret dw ? ;return address from srch_block
|
||||
last_page dw ? ;address of pagelink chain
|
||||
page dw ? ;page # of candidate
|
||||
str_size dw ? ;actual size of object
|
||||
al_bp dw ? ;callers bp
|
||||
dw ? ;callers es
|
||||
dw ? ;return address
|
||||
ret_reg dw ? ;register for return value
|
||||
ob_typ dw ? ;type of object to find
|
||||
ob_siz dw ? ;size of object to find
|
||||
al_args ends
|
||||
|
||||
public alloc_bl
|
||||
alloc_bl proc near
|
||||
|
||||
push es
|
||||
push bp
|
||||
sub sp,al_bp
|
||||
mov bp,sp
|
||||
|
||||
;if object is string, check for small string and adjust size appropriately
|
||||
mov ax,[bp].ob_siz ;get object size
|
||||
mov [bp].str_size,ax ;and save for later
|
||||
cmp [BP].ob_typ,STRTYPE ;is it a string?
|
||||
jnz al005 ; no, jump
|
||||
cmp ax,PTRSIZE ;is it a small string?
|
||||
jge al005 ; no, jump
|
||||
mov [bp].ob_siz,PTRSIZE ;size = PTRSIZE
|
||||
al005:
|
||||
add [bp].ob_siz,BLK_OVHD ;size += BLK_OVHD
|
||||
|
||||
;search page type chain for block
|
||||
call srch_block
|
||||
jc al050 ;jump if block found
|
||||
|
||||
; Didn't find a block, test for a large block
|
||||
mov ax,[BP].ob_siz
|
||||
cmp ax,pagesize ;requested size > pagesize?
|
||||
jb al010 ; no, jump
|
||||
|
||||
public try_big
|
||||
try_big:
|
||||
|
||||
;try to allocate a big block
|
||||
mov si,[bp].ret_reg
|
||||
mov word ptr [si+02],NIL_PAGE*2 ;clear ret reg in case of GC
|
||||
push ax ;size
|
||||
push [BP].ob_typ ;type
|
||||
push si ;return reg
|
||||
call alloc_bi ;Allocate Big Block
|
||||
mov sp,bp
|
||||
jmp al050 ;return to caller
|
||||
|
||||
;block not found in allocated pages, try to allocate a new page
|
||||
al010:
|
||||
push [bp].ob_typ ;type
|
||||
call alloc_pa ;Allocate new page
|
||||
mov sp,bp
|
||||
mov [bp].page,ax ;update page
|
||||
cmp ax,END_LIST ;did we succeed?
|
||||
jnz al040 ; yes, jump
|
||||
;no more pages, try a garbage collection, then search the pages again
|
||||
;for a free block
|
||||
mov si,[bp].ret_reg
|
||||
mov word ptr [si+02],NIL_PAGE*2 ;clear reg before GC
|
||||
call garbage ;do garbage collection
|
||||
call srch_block ;search for block again
|
||||
jc al050 ;return on success
|
||||
;
|
||||
; Still couldn't find a block large enough, try to allocate a new page once
|
||||
; again (since we just did a garbage collection).
|
||||
;
|
||||
push [BP].ob_typ ;type
|
||||
call alloc_pa ;Allocate a new page
|
||||
mov sp,bp
|
||||
mov [bp].page,AX ;save page number
|
||||
cmp ax,END_LIST ;did we succeed?
|
||||
jnz al040 ; yes, jump
|
||||
; We're getting desperate now. Try a collection with compaction, then try to
|
||||
; allocate a new page for the object
|
||||
mov si,[bp].ret_reg
|
||||
mov word ptr [si+02],0 ;clear for possible GC
|
||||
call gcsquish ;Compact memory
|
||||
push [bp].ob_typ ;type
|
||||
call alloc_pa ;Allocate a new page
|
||||
mov sp,bp
|
||||
mov [bp].page,ax
|
||||
cmp ax,END_LIST ;Did we succeed?
|
||||
jz alloc_err ; no, out of memory
|
||||
;at this point, a new page has been allocated; get a block from it
|
||||
al040:
|
||||
push [bp].page ;page
|
||||
push [bp].ob_siz ;size
|
||||
push [bp].ob_typ ;type
|
||||
push [bp].ret_reg ;return reg
|
||||
call find_block ;Allocate a Block
|
||||
mov sp,bp
|
||||
jnc alloc_err
|
||||
;
|
||||
; We have found a block, set up the header and return
|
||||
;
|
||||
al050:
|
||||
cmp [bp].ob_typ,STRTYPE
|
||||
jnz alloc_ret
|
||||
cmp [bp].str_size,PTRSIZE
|
||||
jge alloc_ret
|
||||
;for small strings, put the negative value for object length
|
||||
push es
|
||||
mov si,[bp].ret_reg
|
||||
mov bx,[si+02] ;bx = page
|
||||
mov si,[si] ;si = displacement
|
||||
LoadPage es,bx
|
||||
mov cx,[bp].str_size
|
||||
sub cx,PTRSIZE ;cx = size - PTRSIZE
|
||||
mov word ptr es:[si+1],cx ;replace object length
|
||||
pop es ;restore extra segment
|
||||
alloc_ret:
|
||||
add sp,al_bp ;remove local data
|
||||
pop bp ;restore base pointer
|
||||
pop es ;restore extra segment
|
||||
ret ;return to caller
|
||||
public alloc_err
|
||||
alloc_err:
|
||||
call out_of_m ;out of memory
|
||||
jmp alloc_ret ;control will not return here
|
||||
|
||||
|
||||
; SRCH_BLOCK - Search through all the pages of a given type looking for a
|
||||
; block large enough to fill the size request.
|
||||
;
|
||||
; Upon Entry: All local storage and args to ALLOC_BLOCK are used. Do
|
||||
; not modify BP.
|
||||
;
|
||||
; Upon Exit: Carry Flag set, ret_reg will contain the page:disp of the block.
|
||||
; Carry Flag clear, ret_reg will contain page of -1
|
||||
;
|
||||
public srch_block
|
||||
srch_block label near
|
||||
pop [bp].temp_ret ;save return value
|
||||
|
||||
mov bx,[bp].ob_typ ;bx = object type
|
||||
shl bx,1 ;make into table index
|
||||
mov si,bx
|
||||
add bx,offset pagelist ;bx = address of pagelist[type]
|
||||
mov [bp].last_page,bx ;save in last_page
|
||||
mov ax,pagelist[si] ;ax = page number for this type
|
||||
cmp ax,END_LIST ;any pages to search?
|
||||
clc ;carry clear = failure
|
||||
jz srch_end ; no, skip loop
|
||||
srch_loop:
|
||||
mov [bp].page,ax ;save page number for later
|
||||
|
||||
push ax ;page number
|
||||
push [bp].ob_siz ;size of object
|
||||
push [bp].ob_typ ;type of object
|
||||
push [bp].ret_reg ;register to return value in
|
||||
call find_block ;look for free space in page
|
||||
mov sp,bp ;dump args off stack
|
||||
jc srch_end ;carry set = success
|
||||
;
|
||||
; Block not found within current page.
|
||||
;
|
||||
mov si,[bp].page ;get page number
|
||||
shl si,1 ; and make into index
|
||||
cmp [bp].ob_siz,SMALL_SiZE ;size <= SMALL_SIZE?
|
||||
jg sr10 ; no, jump
|
||||
; less than small_size space is left within the page; this isn't worth searching
|
||||
; again, so update the last position in the chain (last_page) to point to the
|
||||
; next page in the chain.
|
||||
mov ax,pagelink[si] ;get next page link
|
||||
mov di,[bp].last_page
|
||||
mov [di],ax ;*last_page = pagelink[page]
|
||||
sr10:
|
||||
; update last_page to contain the address of the next position in the chain,
|
||||
; and get the next page from pagelink[page].
|
||||
mov bx,offset pagelink ;bx = address of pagelink table
|
||||
add bx,si ;bx = address of pagelink[page]
|
||||
mov [bp].last_page,bx ;save in last_page
|
||||
mov ax,pagelink[si] ;get next page number
|
||||
cmp ax,END_LIST ;reached end of chain?
|
||||
jne srch_loop ; no, continue search for block
|
||||
clc ;carry clear = failure
|
||||
srch_end:
|
||||
jmp [bp].temp_ret ;return to caller
|
||||
|
||||
alloc_bl endp
|
||||
|
||||
;;;FIND_BLOCK
|
||||
;;;
|
||||
;;; calling sequence: find_block(reg, type, size, page)
|
||||
;;;
|
||||
;;; Upon Exit: carry flag set: reg contains page:displ of new block
|
||||
;;; carry flag clr: reg contains page of -1
|
||||
;;;
|
||||
fb_args struc
|
||||
dw ? ;callers bp
|
||||
dw ? ;return address
|
||||
r_reg dw ? ;register for return value
|
||||
bl_typ dw ? ;block type
|
||||
bl_siz dw ? ;block size
|
||||
bl_pag dw ? ;page number
|
||||
fb_args ends
|
||||
|
||||
public find_block
|
||||
find_block proc near
|
||||
push bp
|
||||
mov bp,sp
|
||||
|
||||
mov si,[bp].r_reg ;get return register
|
||||
mov Word Ptr [si+02],-1 ;default to block not found
|
||||
|
||||
mov si,[bp].bl_pag ;get page number
|
||||
shl si,1 ;si = page index
|
||||
LoadPage es,si ;es => page
|
||||
|
||||
; lets see if there's space in the free pool of this block
|
||||
mov bx,nextcell[si] ;bx = next cell in page
|
||||
cmp bx,END_LIST ;if no more space
|
||||
jz fb015 ; then jump
|
||||
mov ax,es:[bx+1] ;ax = free pool size
|
||||
mov dx,[bp].bl_siz ;get size required
|
||||
cmp ax,dx ;if not enough space in pool
|
||||
jl fb015 ; then jump
|
||||
|
||||
; allocate a block from the free pool.
|
||||
; ax = free pool size, bx = displacement, dx = object size
|
||||
mov cx,[bp].bl_typ ;cx = type of object
|
||||
mov byte ptr es:[bx],cl ;store type of new object
|
||||
mov word ptr es:[bx+1],dx ;store size of new object
|
||||
mov di,bx ;cx = displacement
|
||||
add di,dx ;di = new displacement
|
||||
mov cx,psize[si] ;get page size
|
||||
sub cx,BLK_OVHD ; and subtract block overhead
|
||||
cmp cx,di ;next displ still in page?
|
||||
jb fb010 ; no, jump
|
||||
mov byte ptr es:[di],FREETYPE ;mark next area as free
|
||||
sub ax,dx ;ax = pool size - object size
|
||||
mov word ptr es:[di+1],ax ;update free pool size
|
||||
mov nextcell[si],di ;update nextcell chain
|
||||
jmp fb045 ;return to caller
|
||||
fb010:
|
||||
mov nextcell[si],END_LIST ;nextcell[page] = END_LIST
|
||||
jmp fb045 ;return to caller
|
||||
|
||||
; A block was not found in the free pool. Search the entire block for a fragment
|
||||
; to satisfy the request.
|
||||
fb015:
|
||||
xor bx,bx ;bx = displacement
|
||||
mov cx,psize[si]
|
||||
sub cx,[bp].bl_siz ;cx = displacement threshold
|
||||
cmp cx,bx ;threshhold >= displacement?
|
||||
clc ;zero flag not set = failure
|
||||
jl fb050 ;return with no block found
|
||||
|
||||
;the following loop requires bx=displacement, cx=threshold, dx=free size
|
||||
fb020:
|
||||
mov dx,word ptr es:[bx+1] ;dx = size of object
|
||||
cmp byte ptr es:[bx],FREETYPE ;is next area free?
|
||||
jz fb035 ; yes, jump
|
||||
fb025: mov ax,BLK_OVHD+PTRSIZE ;ax = ovhd for small string
|
||||
test dx,dx ;if size negative
|
||||
js fb030 ; then jump
|
||||
mov ax,dx ; else ax = size of object
|
||||
fb030: add bx,ax ;displacement += size
|
||||
cmp cx,bx ;if disp <= threshhold
|
||||
jge fb020 ; then go look at next object
|
||||
clc ;zero flag not set = failure
|
||||
jmp fb050 ;return with no block found
|
||||
|
||||
;we have found a free space in the block; if not big enough then jump back
|
||||
;into loop above, otherwise allocate the new storage
|
||||
fb035:
|
||||
mov ax,[bp].bl_siz
|
||||
cmp ax,dx ;compare size to free size
|
||||
jl fb025 ;if less, return to loop
|
||||
jnz fb040 ;if not equal, jump
|
||||
; we found an exact match
|
||||
mov ax,[bp].bl_typ
|
||||
mov byte ptr es:[bx],al ;just update the type field
|
||||
jmp fb045 ;and return to caller
|
||||
fb040:
|
||||
mov di,dx
|
||||
sub di,BLK_OVHD ;di = free size - block overhead
|
||||
cmp di,ax ;can object fit into free space?
|
||||
jle fb025 ; no, return to loop
|
||||
; we can fit into a larger block, split block to allocate storage
|
||||
mov cx,[bp].bl_typ ;cx = type of object
|
||||
mov byte ptr es:[bx],cl ;store type of new object
|
||||
mov word ptr es:[bx+1],ax ;store size of new object
|
||||
;ax=new object size, bx=disp, dx= free size
|
||||
mov di,bx
|
||||
add di,ax ;di = new displacement
|
||||
mov cx,dx
|
||||
sub cx,ax ;cx = free size - new size
|
||||
mov byte ptr es:[di],FREETYPE ;mark next area as free
|
||||
mov word ptr es:[di+1],cx ;update next area free size
|
||||
;
|
||||
; block found; return page,disp in return register.
|
||||
; si = page index, bx = displacement
|
||||
fb045:
|
||||
mov ax,si ;ax = page index
|
||||
mov si,[bp].r_reg ;si = address of return reg
|
||||
mov [si+02],ax ;put page index in register
|
||||
mov [si],bx ;put diplacement in register
|
||||
stc ;carry set = success
|
||||
fb050:
|
||||
pop bp ;restore base pointer
|
||||
ret ;return to caller
|
||||
|
||||
find_block endp
|
||||
|
||||
prog ends
|
||||
END
|
||||
|
|
@ -0,0 +1,648 @@
|
|||
; =====> BORDER.ASM
|
||||
;***************************************
|
||||
;* TIPC Scheme Runtime Support *
|
||||
;* Window Support Routines *
|
||||
;* *
|
||||
;* (C) Copyright 1985 by Texas *
|
||||
;* Instruments Incorporated. *
|
||||
;* All rights reserved. *
|
||||
;* *
|
||||
;* Date Written: 16 May 1985 *
|
||||
;* Last Modification: *
|
||||
;* 14 April 1986 : *
|
||||
;* Make references to pagetabl *
|
||||
;* call Memory Manager for use *
|
||||
;* with extended/expanded mem. *
|
||||
;* 26 Sept 1986 : *
|
||||
;* added EGA support *
|
||||
;* 13 May 1987 : *
|
||||
;* Fixed Save/restore problem. *
|
||||
;***************************************
|
||||
page 60,132
|
||||
include scheme.equ
|
||||
include pcmake.equ
|
||||
|
||||
MSDOS equ 021h
|
||||
TI_CRT equ 049h
|
||||
IBM_CRT equ 010h
|
||||
|
||||
|
||||
DGROUP group data
|
||||
data segment word public 'DATA'
|
||||
assume DS:DGROUP
|
||||
extrn MAX_ROWS:byte,MAX_COLS:byte
|
||||
|
||||
|
||||
; ___ __ __
|
||||
; + -| |- _|_ | -- | __| |__ | | (extra)
|
||||
map_tab db 0c5h,0b4h,0c3h,0c1h,0c2h,0c4h,0b3h,0d9h,0c0h,0bfh,0dah,0dah
|
||||
map_tabx equ $
|
||||
|
||||
trns_tab db 0dah,0c2h,0c3h,0c5h,0c3h,0c2h,0c2h,0c5h,0c3h,0c5h,0c5h
|
||||
db 0c2h,0bfh,0c5h,0b4h,0b4h,0c2h,0c2h,0c5h,0c5h,0b4h,0c5h
|
||||
db 0c3h,0c5h,0c0h,0c1h,0c3h,0c1h,0c5h,0c1h,0c3h,0c5h,0c5h
|
||||
db 0c5h,0b4h,0c1h,0d9h,0b4h,0c1h,0c5h,0c1h,0c5h,0b4h,0c5h
|
||||
db 0c3h,0b4h,0c3h,0b4h,0b3h,0c5h,0c5h,0c5h,0c3h,0b4h,0c5h
|
||||
db 0c2h,0c2h,0c1h,0c1h,0c5h,0c4h,0c2h,0c1h,0c5h,0c5h,0c5h
|
||||
|
||||
m14_attr equ $
|
||||
;33-60 ! " # $ % & ' ( ) * + , - . / 0 1 2 3 4 5 6 7 8 9 : ; <
|
||||
db 1,0,2,2,1,4,2,0,0,3,3,7,3,5,6,2,6,6,5,3,5,2,1,2,2,1,7,3
|
||||
|
||||
;61-88 = > ? @ A B C D E F G H I J K L M N O P Q R S T U V W X
|
||||
db 2,6,1,2,2,0,3,0,0,0,3,1,0,4,0,0,1,1,3,0,3,0,2,0,1,3,1,1
|
||||
|
||||
;89-116 Y Z [ \ ] ^ _ ` a b c d e f g h i j k l m n o p q r s t
|
||||
db 0,1,0,0,0,3,7,1,5,0,3,4,3,3,3,0,6,6,0,0,2,2,3,2,3,2,3,2
|
||||
|
||||
;117-126 u v w x y z { | } ~
|
||||
db 2,3,3,2,2,2,3,1,0,1
|
||||
|
||||
;127-191
|
||||
db 64 dup (0)
|
||||
|
||||
;192-197
|
||||
db 5,2,0,0,0,4
|
||||
|
||||
;198-218
|
||||
db 20 dup (0)
|
||||
;219-220
|
||||
db 2,5
|
||||
|
||||
m16_attr equ $
|
||||
;33-60 ! " # $ % & ' ( ) * + , - . / 0 1 2 3 4 5 6 7 8 9 : ; <
|
||||
db 3,1,4,4,4,7,4,2,2,6,6,11,6,9,9,4,10,10,9,6,9,4,2,4,4,3,10,6
|
||||
|
||||
;61-88 = > ? @ A B C D E F G H I J K L M N O P Q R S T U V W X
|
||||
db 5,10,3,4,5,2,5,2,2,2,5,2,2,8,2,2,2,2,5,2,5,2,4,2,2,5,2,2
|
||||
|
||||
;89-116 Y Z [ \ ] ^ _ ` a b c d e f g h i j k l m n o p q r s t
|
||||
db 2,2,2,2,2,3,12,2,9,2,6,7,6,6,6,2,10,11,2,2,5,5,6,5,6,5,6,4
|
||||
|
||||
;117-126 u v w x y z { | } ~
|
||||
db 5,5,5,5,5,5,6,2,2,3
|
||||
db 64 dup (0)
|
||||
db 7,2,0,0,0,7
|
||||
db 20 dup (0)
|
||||
db 2,7
|
||||
|
||||
public m18_attr
|
||||
m18_attr equ $
|
||||
;33-60 ! " # $ % & ' ( ) * + , - . / 0 1 2 3 4 5 6 7 8 9 : ; <
|
||||
db 2,1,4,4,8,8,4,2,2,6,6,10,9,10,05,4,10,10,10,6,10,4,2,4,4,10,10,6
|
||||
|
||||
;61-88 = > ? @ A B C D E F G H I J K L M N O P Q R S T U V W X
|
||||
db 9,06,2,4,4,2,6,2,2,2,6,2,2,8,2,2,2,2,6,2,6,2,4,2,2,6,2,2
|
||||
|
||||
;89-116 Y Z [ \ ] ^ _ ` a b c d e f g h i j k l m n o p q r s t
|
||||
db 2,2,2,3,2,3,13,2,10,2,6,8,6,6,6,2,10,12,2,2,5,5,6,5,6,5,6,4
|
||||
|
||||
;117-126 u v w x y z { | } ~
|
||||
db 5,6,6,5,5,5,6,2,2,2
|
||||
db 64 dup (0)
|
||||
db 10,4,0,0,0,8
|
||||
db 20 dup (0)
|
||||
db 8,8
|
||||
|
||||
last_char db 0dbh
|
||||
|
||||
extrn char_hgt:byte
|
||||
extrn vid_mode:word
|
||||
data ends
|
||||
|
||||
XGROUP group PROGX
|
||||
PROGX segment byte public 'PROGX'
|
||||
assume CS:XGROUP
|
||||
|
||||
;************************************************************************
|
||||
;* Perform appropriate VIDEO I/O interrupt *
|
||||
;* Any difference in register definition should be handled by *
|
||||
;* the caller except where DH,DL contain row,col information. *
|
||||
;************************************************************************
|
||||
public crt_dsr
|
||||
crt_dsr proc far
|
||||
cmp PC_MAKE,TIPC
|
||||
jne ibm_dsr
|
||||
int TI_CRT
|
||||
ret
|
||||
ibm_dsr: xchg DH,DL ; Do this now instead of making special checks
|
||||
int IBM_CRT ; IBM's row,col is diff'rnt from TI's col,row
|
||||
ret
|
||||
crt_dsr endp
|
||||
|
||||
;************************************************************************
|
||||
;* Draw Border *
|
||||
;************************************************************************
|
||||
zb_args struc
|
||||
dw ? ; caller's BP
|
||||
dd ? ; return address (far linkage)
|
||||
dw ? ; return address (original)
|
||||
zb_line dw ? ; upper left corner line number
|
||||
zb_col dw ? ; upper left corner column number
|
||||
zb_nlines dw ? ; number of lines
|
||||
zb_ncols dw ? ; number of columns
|
||||
zb_battr dw ? ; border attributes
|
||||
zb_label dw ? ; pointer to label text
|
||||
zb_args ends
|
||||
|
||||
public z%border
|
||||
z%border proc far
|
||||
push BP ; save caller's BP
|
||||
mov BP,SP
|
||||
|
||||
; output corners
|
||||
mov BL,byte ptr [BP].zb_battr ; load attribute bits
|
||||
mov DH,byte ptr [BP].zb_col ; load left column number
|
||||
mov DL,byte ptr [BP].zb_line ; load left line number
|
||||
dec DL
|
||||
dec DH
|
||||
mov AL,0DAh ; load upper left corner character
|
||||
call zcorner
|
||||
inc DH
|
||||
add DH,byte ptr [BP].zb_ncols
|
||||
mov AL,0BFh ; load upper right corner character
|
||||
call zcorner
|
||||
inc DL
|
||||
add DL,byte ptr [BP].zb_nlines
|
||||
mov AL,0D9h ; load lower right corner character
|
||||
call zcorner
|
||||
dec DH
|
||||
sub DH,byte ptr [BP].zb_ncols
|
||||
mov AL,0C0h ; load lower left corner character
|
||||
call zcorner
|
||||
|
||||
; output sides
|
||||
mov DH,byte ptr [BP].zb_col ; reload upper left column number
|
||||
mov DL,byte ptr [BP].zb_line ; and line number
|
||||
dec DH ; decrement column number
|
||||
mov CX,[BP].zb_nlines
|
||||
call zside ; draw the left hand border
|
||||
mov DH,byte ptr [BP].zb_col ; reload upper left column number
|
||||
mov DL,byte ptr [BP].zb_line ; and line number
|
||||
add DH,byte ptr [BP].zb_ncols ; add in line length
|
||||
mov CX,[BP].zb_nlines
|
||||
call zside ; draw the right hand border
|
||||
|
||||
; Output the top of the border
|
||||
mov DL,byte ptr [BP].zb_line ; load upper left row number
|
||||
dec DL
|
||||
jl z_no_top ; if row negative, skip write
|
||||
mov DH,byte ptr [BP].zb_col ; load upper left column number
|
||||
mov CX,[BP].zb_ncols
|
||||
call ztop
|
||||
; Put the label in the top left corner of the border, if it'll fit
|
||||
mov BX,[BP].zb_label ; load pointer to the label's text
|
||||
cmp BX,0 ; if pointer NULL, no label
|
||||
je z_no_top ; jump, if NULL pointer
|
||||
mov DX,[BP].zb_ncols ; load window width
|
||||
xor CX,CX ; zero the character counter
|
||||
zb_loop: cmp byte ptr [BX],0 ; end of string?
|
||||
je zb_eos ; if end of string, jump
|
||||
inc CX ; increment the character count
|
||||
inc BX ; increment the character string pointer
|
||||
cmp CX,DX ; compare to window width
|
||||
jl zb_loop ; if label still shorter than window, loop
|
||||
zb_eos: jcxz z_no_top ; if no label, jump
|
||||
push CX ; save label length
|
||||
; Write the label
|
||||
mov DL,byte ptr [BP].zb_line ; load upper left row number
|
||||
mov DH,byte ptr [BP].zb_col ; load upper left column number
|
||||
dec DL ; decrement row number
|
||||
xor BH,BH ; IBMism (page 0 for text-mode)
|
||||
mov AH,02h ; load "put cursor" code
|
||||
call CRT_DSR ; put cursor in upper left corner of border
|
||||
pop CX ; restore label's character count
|
||||
cmp PC_MAKE,TIPC
|
||||
jne ibm_cblk
|
||||
mov AH,011h ; load "write block of characters" code
|
||||
mov DX,DS ; load segment address
|
||||
mov BX,[BP].zb_label ; load label offset
|
||||
int TI_CRT ; write the label
|
||||
jmp short z_no_top
|
||||
;
|
||||
ibm_cblk: mov AL,byte ptr [BP].zb_col
|
||||
add AL,CL
|
||||
cmp AL,MAX_COLS
|
||||
jle zb_sml ; jump if label length is OK
|
||||
sub AL,MAX_COLS
|
||||
sub CL,AL ; force label to remain within 80-col screen
|
||||
zb_sml: mov DI,[BP].zb_label ; load label offset
|
||||
lbl_loop: mov AH,0Eh ; Write ASCII Teletype
|
||||
mov AL,byte ptr [DI]
|
||||
mov BL,byte ptr [BP].zb_battr ; load attribute bits just in case
|
||||
xor BH,BH ; page # for alpha mode
|
||||
push CX
|
||||
push DI
|
||||
int IBM_CRT
|
||||
pop DI
|
||||
pop CX
|
||||
inc DI
|
||||
loop lbl_loop ; DECrement CX and jump if != 0
|
||||
; Output the bottom of the border
|
||||
z_no_top: mov BL,byte ptr [BP].zb_battr ; load attribute bits
|
||||
mov DL,byte ptr [BP].zb_line
|
||||
add DL,byte ptr [BP].zb_nlines
|
||||
mov DH,byte ptr [BP].zb_col ; load upper left column number
|
||||
mov CX,[BP].zb_ncols
|
||||
call ztop
|
||||
|
||||
; return to caller
|
||||
pop BP ; restore caller's BP
|
||||
ret ; return
|
||||
z%border endp
|
||||
|
||||
;************************************************************************
|
||||
;* Local Support: Draw a single character at cursor position *
|
||||
;* *
|
||||
;* Input Registers: AL - the character to be output *
|
||||
;* BL - the character attributes for the write *
|
||||
;* DH - column *
|
||||
;* DL - row *
|
||||
;* *
|
||||
;* Registers Modified: AX,CX,SI,DI *
|
||||
;************************************************************************
|
||||
zcorner proc near ; draw a single corner character
|
||||
cmp DH,MAX_COLS
|
||||
jae zcornret
|
||||
cmp DL,MAX_ROWS
|
||||
jae zcornret
|
||||
push DX ; save cursor coordinates
|
||||
push AX ; save character to be output
|
||||
xor BH,BH ; page number (=0 for graphics mode also)
|
||||
mov AH,02h ; load "put cursor" code
|
||||
call CRT_DSR ; position the cursor
|
||||
; read the character in this screen position
|
||||
; ** This is tricky 'cause DH/DL are correct but
|
||||
; ** will be swapped back (to incorrect) by CRT_DSR proc
|
||||
; ** if using an IBM!!!
|
||||
cmp PC_MAKE,TIPC
|
||||
je no_swap
|
||||
xchg DH,DL
|
||||
xor BH,BH ; IBM display page
|
||||
no_swap: mov AH,08h
|
||||
call CRT_DSR
|
||||
; see if it's one of the borderline characters
|
||||
call map_char
|
||||
mov SI,AX
|
||||
pop AX ; recover character to be output
|
||||
cmp SI,0
|
||||
jl zcornput
|
||||
; map corner to border character
|
||||
call map_char
|
||||
mov DL,map_tabx-map_tab-1
|
||||
mul DL
|
||||
add SI,AX
|
||||
mov AL,trns_tab+[SI]
|
||||
; output the corner character
|
||||
zcornput: mov AH,09h ; load "write character/attribute" code
|
||||
mov CX,1 ; number of characters = 1
|
||||
xor BH,BH ; Display page for IBM text mode (=0)
|
||||
call CRT_DSR ; write it to the screen at cursor position
|
||||
pop DX ; restore cursor coordinates
|
||||
zcornret: ret ; return
|
||||
zcorner endp
|
||||
|
||||
;************************************************************************
|
||||
;* Local Support: Draw a border sides *
|
||||
;* *
|
||||
;* Input Registers: DH - column *
|
||||
;* DL - row *
|
||||
;* CX - number of rows *
|
||||
;* *
|
||||
;* Registers Modified: AX,CX,DL *
|
||||
;************************************************************************
|
||||
zside proc near
|
||||
cmp DH,MAX_COLS ; is column within the CRT's boundaries?
|
||||
jae zsideret ; if not, jump
|
||||
zside_lp: mov AL,0B3h ; load "|" border character
|
||||
push CX ; save line count
|
||||
push DX ; save next cursor position
|
||||
call zcorner ; output the border character
|
||||
pop DX ; restore current cursor position
|
||||
pop CX ; restore line counter
|
||||
inc DL ; increment the row number
|
||||
loop zside_lp ; loop until side is drawn
|
||||
zsideret: ret
|
||||
zside endp
|
||||
|
||||
;************************************************************************
|
||||
;* Local Support: Draw a border - Top or Bottom *
|
||||
;* *
|
||||
;* Input Registers: DH - column *
|
||||
;* DL - row *
|
||||
;* CX - number of columns *
|
||||
;* *
|
||||
;* Registers Modified: AX,CX *
|
||||
;************************************************************************
|
||||
ztop proc near
|
||||
cmp DL,MAX_ROWS ; is row within the CRT's boundaries?
|
||||
jae ztopret ; if not, jump
|
||||
ztop_lp: mov AL,0C4h ; load "-" border character
|
||||
push CX ; save line count
|
||||
push DX ; save next cursor position
|
||||
call zcorner ; output the border character
|
||||
pop DX ; restore current cursor position
|
||||
pop CX ; restore line counter
|
||||
inc DH ; increment the column number
|
||||
loop ztop_lp ; loop until top/bottom is drawn
|
||||
ztopret: ret
|
||||
ztop endp
|
||||
|
||||
map_char proc near
|
||||
mov CX,map_tabx-map_tab
|
||||
mov DI,offset map_tab
|
||||
repne scasb
|
||||
mov AX,CX
|
||||
dec AX
|
||||
ret
|
||||
map_char endp
|
||||
|
||||
;************************************************************************
|
||||
;* Save Screen Contents *
|
||||
;* *
|
||||
;* Purpose: To save a rectangular region of the CRT in a string data *
|
||||
;* object. *
|
||||
;* *
|
||||
;* Calling Sequence: save_scr(str_reg, ul_row, ul_col, n_rows, ncols) *
|
||||
;* where str_reg - pointer to string data object *
|
||||
;* which is to receive the screen *
|
||||
;* contents *
|
||||
;* ul_row - row number of the upper left *
|
||||
;* corner of the region to be *
|
||||
;* saved *
|
||||
;* ul_col - column number of the upper left *
|
||||
;* corner of the region to be *
|
||||
;* saved *
|
||||
;* n_rows - number of rows in the region to *
|
||||
;* be saved *
|
||||
;* n_cols - number of columns in the region *
|
||||
;* to be saved *
|
||||
;************************************************************************
|
||||
sv_args struc
|
||||
dw ? ; caller's BP
|
||||
dw ? ; caller's ES
|
||||
dd ? ; return address (long)
|
||||
; dw ? ; original return address (short)
|
||||
sv_str dw ? ; address of register pointing to string
|
||||
sv_ulrow dw ? ; upper left hand corner's row number
|
||||
sv_ulcol dw ? ; upper left hand corner's column number
|
||||
sv_nrow dw ? ; number of rows
|
||||
sv_ncol dw ? ; number of columns
|
||||
sv_args ends
|
||||
|
||||
public save%scr
|
||||
save%scr proc far
|
||||
push ES
|
||||
push BP ; save the caller's BP register
|
||||
mov BP,SP ; and establish local addressability
|
||||
; create a pointer to the string object
|
||||
mov BX,[BP].sv_str ; load address of register
|
||||
mov DI,[BX].C_disp ; load the string
|
||||
mov BX,[BX].C_page ; pointer
|
||||
%LoadPage ES,BX ; load string page's paragraph address
|
||||
;;; mov ES,pagetabl+[BX] ; load string page's paragraph address
|
||||
add DI,BLK_OVHD ; advance pointer past string header
|
||||
; store number of rows and columns into the first two bytes of the string
|
||||
mov AL,byte ptr [BP].sv_nrow
|
||||
stosb
|
||||
mov AL,byte ptr [BP].sv_ncol
|
||||
stosb
|
||||
; adjust number of lines/columns for test conditions
|
||||
mov AX,[BP].sv_ulrow
|
||||
add [BP].sv_nrow,AX
|
||||
mov AX,[BP].sv_ulcol
|
||||
add [BP].sv_ncol,AX
|
||||
; loop until all rows processed
|
||||
mov DL,byte ptr [BP].sv_ulrow
|
||||
rw_loop: mov DH,byte ptr [BP].sv_ulcol
|
||||
; position cursor
|
||||
cl_loop: push DX ; save current position
|
||||
mov AH,02h ; load "put cursor" function id
|
||||
xor BH,BH ; IBMism (page number for cursor)
|
||||
call crt_dsr ; position the cursor
|
||||
; read character/attributes at current screen position
|
||||
mov AH,08h ; load "read char/attribute" function id
|
||||
xor BH,BH ; IBMism (display page #)
|
||||
call crt_dsr ; read said
|
||||
;*******
|
||||
cmp vid_mode,14
|
||||
jl sav_01 ; not graphics modes
|
||||
cmp AL,0 ; don't bother with attributes if nul
|
||||
je sav_01
|
||||
; cmp AL,07fh ; is it above the first 128 characters ?
|
||||
; jno sav_00 ; no
|
||||
cmp AL,0dah
|
||||
jbe sav_00
|
||||
; test AL,010h ; look for D0-DF
|
||||
; je sav_00
|
||||
xor AL,AL ; set to nul
|
||||
jmp sav_01
|
||||
sav_00: call graph_attr ; mode 14,16, and 18 attribute function
|
||||
;******
|
||||
sav_01: stosw ; store char/attr into output string
|
||||
; increment column number, test, branch
|
||||
pop DX
|
||||
inc DH
|
||||
cmp DH,byte ptr [BP].sv_ncol
|
||||
jl cl_loop
|
||||
; increment row number, test, branch
|
||||
inc DL
|
||||
cmp DL,byte ptr [BP].sv_nrow
|
||||
jl rw_loop
|
||||
|
||||
; return to caller
|
||||
pop BP
|
||||
pop ES
|
||||
ret ; return to caller
|
||||
save%scr endp
|
||||
|
||||
;************************************************************************
|
||||
;* Restore Screen Contents *
|
||||
;* *
|
||||
;* Purpose: To restore a rectangular region of the CRT from a string *
|
||||
;* data object. *
|
||||
;* *
|
||||
;* Calling Sequence: rest_scr(str_reg, ul_row, ul_col) *
|
||||
;* where str_reg - pointer to string data object *
|
||||
;* which contains the screen *
|
||||
;* contents *
|
||||
;* ul_row - row number of the upper left *
|
||||
;* corner of the region to be *
|
||||
;* restored *
|
||||
;* ul_col - column number of the upper left *
|
||||
;* corner of the region to be *
|
||||
;* restored *
|
||||
;************************************************************************
|
||||
rs_args struc
|
||||
rs_nrow dw ? ; number of rows in saved data
|
||||
rs_ncol dw ? ; number of columns in saved data
|
||||
rs_BP dw ? ; caller's BP
|
||||
dw ? ; caller's ES
|
||||
dd ? ; return address (long)
|
||||
; dw ? ; original return address (short)
|
||||
rs_str dw ? ; address of register pointing to string
|
||||
rs_ulrow dw ? ; upper left hand corner's row number
|
||||
rs_ulcol dw ? ; upper left hand corner's column number
|
||||
rs_mrow dw ? ; number of rows in new window
|
||||
rs_mcol dw ? ; number of columns in new window
|
||||
rs_args ends
|
||||
|
||||
public rest%scr
|
||||
rest%scr proc far
|
||||
push ES
|
||||
push BP ; save the caller's BP register
|
||||
sub SP,offset rs_BP
|
||||
mov BP,SP ; and establish local addressability
|
||||
; create a pointer to the string object
|
||||
mov BX,[BP].rs_str ; load address of register
|
||||
mov SI,[BX].C_disp ; load the string
|
||||
mov BX,[BX].C_page ; pointer
|
||||
%LoadPage ES,BX ; load string page's paragraph address
|
||||
;;; mov ES,pagetabl+[BX] ; load string page's paragraph address
|
||||
add SI,BLK_OVHD ; advance pointer past string header
|
||||
; recover number of rows and columns from screen object
|
||||
xor AX,AX
|
||||
lods byte ptr ES:[SI]
|
||||
add AX,[BP].rs_ulrow
|
||||
mov [BP].rs_nrow,AX
|
||||
lods byte ptr ES:[SI]
|
||||
add AX,[BP].rs_ulcol
|
||||
mov [BP].rs_ncol,AX
|
||||
; adjust number of lines/columns for test conditions
|
||||
mov AX,[BP].rs_ulrow
|
||||
add [BP].rs_mrow,AX
|
||||
mov AX,[BP].rs_ulcol
|
||||
add [BP].rs_mcol,AX
|
||||
; loop until all rows processed
|
||||
mov DL,byte ptr [BP].rs_ulrow
|
||||
xw_loop: mov DH,byte ptr [BP].rs_ulcol
|
||||
; position cursor
|
||||
xl_loop: cmp DH,byte ptr [BP].rs_mcol ; column too long for new window?
|
||||
jge x_long ; if too long, jump
|
||||
push DX ; save current position
|
||||
mov AH,02h ; load "put cursor" function id
|
||||
xor BH,BH ; IBMism (page number/0 in graphic mode)
|
||||
call crt_dsr ; position the cursor
|
||||
; read character/attributes at current screen position
|
||||
lods word ptr ES:[SI] ; fetch the character and attribute
|
||||
|
||||
;;;;;;;; cmp AL,20h
|
||||
;;;;;;;; je x_sp ; if a space skip
|
||||
|
||||
mov BL,AH ; and copy attribute to BL
|
||||
mov AH,09h ; load "write char/attribute" function id
|
||||
xor BH,BH ; IBMism (page number)
|
||||
mov CX,1 ; character count = 1
|
||||
call crt_dsr ; read said
|
||||
; increment column number, test, branch
|
||||
x_sp: pop DX ; recover the row/column coordinates
|
||||
x_more: inc DH ; increment the column number
|
||||
cmp DH,byte ptr [BP].rs_ncol ; more characters in this row?
|
||||
jl xl_loop ; if so, jump
|
||||
; increment row number, test, branch
|
||||
inc DL ; increment the row number
|
||||
cmp DL,byte ptr [BP].rs_mrow ; check against new window boundary
|
||||
jge rs_fin ; if all rows filled, jump
|
||||
cmp DL,byte ptr [BP].rs_nrow ; check against saved data
|
||||
jl xw_loop ; if more lines, jump
|
||||
|
||||
; return to caller
|
||||
rs_fin: add SP,offset rs_BP ; deallocate local storage
|
||||
pop BP ; restore the caller's BP register
|
||||
pop ES ; restore the caller's ES register
|
||||
ret ; return to caller
|
||||
;
|
||||
x_long: inc SI ; increment index into saved screen
|
||||
inc SI ; buffer
|
||||
jmp short x_more ; continue processing row
|
||||
rest%scr endp
|
||||
|
||||
;************************************************************************
|
||||
;* Graphics Character Attribute *
|
||||
;* *
|
||||
;* Purpose: To retrieve the attribute of a character on an IBM screen *
|
||||
;* in a graphics mode, either 14 or 16. *
|
||||
;* *
|
||||
;************************************************************************
|
||||
|
||||
public graph_attr
|
||||
graph_attr proc near
|
||||
|
||||
cmp AL,20h ; skip if a space
|
||||
je grphend
|
||||
|
||||
cmp AL,00h ; skip if a null
|
||||
je grphend
|
||||
|
||||
cmp AL,0dbh ; block character?
|
||||
je grphend
|
||||
|
||||
push ES
|
||||
push SI
|
||||
push AX ; save character
|
||||
push DX ; save row and column
|
||||
xor AH,AH ; clear AH
|
||||
mov SI,AX ; use SI as an index
|
||||
sub SI,21h
|
||||
|
||||
mov AL,DL ; row
|
||||
mul char_hgt ; pixels per character
|
||||
xor BX,BX
|
||||
|
||||
mov BL,byte ptr m18_attr[SI] ; default mode 18 adjustment
|
||||
cmp vid_mode,18 ; are we in mode 18?
|
||||
je grph_02 ; yes, jump
|
||||
mov BL,byte ptr m16_attr[SI] ; default mode 16 adjustment
|
||||
cmp vid_mode,16 ; are we in mode 16?
|
||||
je grph_02 ; yes, jump
|
||||
mov BL,byte ptr m14_attr[SI] ; must be mode 14
|
||||
grph_02:
|
||||
add AX,BX
|
||||
mov BX,80 ; 80 bytes per line
|
||||
mul BX
|
||||
|
||||
pop DX ; restore the column
|
||||
xor DL,DL ; clear the row
|
||||
xchg DH,DL ; set AX to the row
|
||||
add AX,DX
|
||||
mov SI,AX ; put result in SI
|
||||
|
||||
mov AX,0a000h ; load in graphics plane
|
||||
mov ES,AX
|
||||
xor CX,CX ; clear CX
|
||||
|
||||
mov CH,01
|
||||
mov AH,0
|
||||
grph_03: call get_val
|
||||
|
||||
shl CH,1 ; shift mask one bit to the left
|
||||
inc AH ; next plane
|
||||
cmp AH,3
|
||||
jbe grph_03
|
||||
|
||||
pop AX ; retrieve character
|
||||
mov AH,CL ; set attribute byte
|
||||
pop SI
|
||||
pop ES
|
||||
grphend: ret
|
||||
graph_attr endp
|
||||
|
||||
get_val proc near
|
||||
push AX ; save AH
|
||||
mov DX,3ceh ; port addr of sequencer
|
||||
mov AL,04h ; index to other map mask register
|
||||
out DX,AL ; set index register
|
||||
inc DX
|
||||
xchg AL,AH
|
||||
out DX,AL ; enable bank
|
||||
pop AX ; restore AH
|
||||
mov AL,ES:[SI]
|
||||
or AL,AL
|
||||
jz get_end
|
||||
or CL,CH ; set attribute bit
|
||||
get_end: ret
|
||||
get_val endp
|
||||
|
||||
PROGX ends
|
||||
end
|
||||
|
|
@ -0,0 +1,229 @@
|
|||
; =====> CPRINT.ASM
|
||||
;******************************************
|
||||
;* TIPC Scheme Runtime Support *
|
||||
;* Scheme Interpreter Support for write *
|
||||
;* *
|
||||
;* (C) Copyright 1985 by Texas *
|
||||
;* Instruments Incorporated. *
|
||||
;* All rights reserved. *
|
||||
;* *
|
||||
;* Date Written: 21 March 1986 *
|
||||
;* Last Modification: 21 March 1986 *
|
||||
;******************************************
|
||||
page 60,132
|
||||
include scheme.equ
|
||||
include sinterp.arg
|
||||
LF equ 0Ah
|
||||
SPACE equ 20h
|
||||
|
||||
DGROUP group data
|
||||
data segment word public 'DATA'
|
||||
assume DS:DGROUP
|
||||
extrn display:word
|
||||
extrn show:word
|
||||
;;; extrn detail:word
|
||||
sp1_er db "WRITE",0
|
||||
spc_er db "DISPLAY",0
|
||||
spt_er db "PRINT",0
|
||||
new_er db "NEWLINE",0
|
||||
data ends
|
||||
|
||||
PGROUP group prog
|
||||
prog segment byte public 'PROG'
|
||||
assume CS:PGROUP
|
||||
prn_proc proc near
|
||||
extrn next_SP:near
|
||||
extrn src_err:near
|
||||
extrn get_port:near
|
||||
extrn sprint:near
|
||||
;;;
|
||||
;;; Does not set the value for flag "detail" (which is removed in CPRINT1.ASM)
|
||||
;;;
|
||||
;;;****************************************************************************
|
||||
;;; Print an S-Expression (w/ slashification)
|
||||
;;; Purpose: Scheme interpreter support to output an s-expression to
|
||||
;;; a port.
|
||||
;;;****************************************************************************
|
||||
public spprin1
|
||||
spprin1: lods word ptr ES:[SI] ; load register operand
|
||||
save <SI>
|
||||
xor BX,BX
|
||||
mov BL,AH
|
||||
add BX,offset reg0 ; BX = port object
|
||||
xor AH,AH
|
||||
add AX,offset reg0 ; AX = s-expression pointer
|
||||
mov DI,AX
|
||||
save <DI>
|
||||
mov CX,1 ; write indicator
|
||||
pushm <CX, BX>
|
||||
C_call get_port,,Load_ES ; get port address
|
||||
mov SP,BP
|
||||
test AX,AX ; check return status
|
||||
jz sp1_010
|
||||
lea BX,sp1_er
|
||||
jmp src_err ; link to error handler
|
||||
sp1_010:
|
||||
;;; mov detail,AX
|
||||
inc AX
|
||||
mov display,AX
|
||||
mov show,AX
|
||||
pushm <tmp_disp, tmp_page>
|
||||
restore <DI>
|
||||
mov BX,[DI].C_page
|
||||
shr BX,1
|
||||
pushm <[DI].C_disp, BX>
|
||||
call sprint ; write
|
||||
mov SP,BP
|
||||
sp1_020: restore <DI> ; get the register pointer
|
||||
mov [DI].C_page,NPR_PAGE*2 ; return as non-printable object
|
||||
mov [DI].C_disp,NPR_DISP
|
||||
jmp next_SP ; return to interpreter
|
||||
;;;****************************************************************************
|
||||
;;; Print an S-Expression (w/o slashification)
|
||||
;;; Purpose: Scheme interpreter support to output an s-expression to
|
||||
;;; a port.
|
||||
;;;****************************************************************************
|
||||
public spprinc
|
||||
spprinc: lods word ptr ES:[SI] ; load register operand
|
||||
save <SI>
|
||||
xor BX,BX
|
||||
mov BL,AH
|
||||
add BX,offset reg0 ; BX = port object
|
||||
xor AH,AH
|
||||
add AX,offset reg0 ; AX = s-expression pointer
|
||||
mov DI,AX
|
||||
save <DI>
|
||||
mov CX,1
|
||||
pushm <CX, BX>
|
||||
C_call get_port,,Load_ES ; get port address
|
||||
mov SP,BP
|
||||
test AX,AX ; check return status
|
||||
jz spc_010
|
||||
lea BX,spc_er
|
||||
jmp src_err ; link to error handler
|
||||
spc_010: mov display,AX
|
||||
;;; mov detail,AX
|
||||
inc AX
|
||||
mov show,AX
|
||||
pushm <tmp_disp, tmp_page>
|
||||
restore <DI>
|
||||
mov BX,[DI].C_page
|
||||
shr BX,1
|
||||
pushm <[DI].C_disp, BX>
|
||||
call sprint ; display
|
||||
mov SP,BP
|
||||
jmp sp1_020
|
||||
;;;****************************************************************************
|
||||
;;; Print an S-Expression (w/ spacing control)
|
||||
;;; Purpose: Scheme interpreter support to output an s-expression to
|
||||
;;; a port.
|
||||
;;;****************************************************************************
|
||||
public spprint
|
||||
spprint: lods word ptr ES:[SI] ; load register operand
|
||||
save <SI>
|
||||
xor BX,BX
|
||||
mov BL,AH
|
||||
add BX,offset reg0 ; BX = port object
|
||||
xor AH,AH
|
||||
add AX,offset reg0 ; AX = s-expression pointer
|
||||
mov DI,AX
|
||||
save <DI>
|
||||
mov CX,1
|
||||
pushm <CX, BX>
|
||||
C_call get_port,,Load_ES ; get port address
|
||||
mov SP,BP
|
||||
test AX,AX ; check return status
|
||||
jz spt_010
|
||||
lea BX,spt_er
|
||||
jmp src_err ; link to error handler
|
||||
spt_010: mov display,AX
|
||||
;;; mov detail,AX
|
||||
inc AX
|
||||
mov show,AX
|
||||
mov DX,SPECCHAR
|
||||
mov BX,LF ; line feed
|
||||
pushm <tmp_disp, tmp_page, BX, DX>
|
||||
call sprint ; print it
|
||||
mov SP,BP
|
||||
xor AX,AX
|
||||
;;; mov detail,AX
|
||||
inc AX
|
||||
mov show,AX
|
||||
mov display,AX
|
||||
pushm <tmp_disp, tmp_page>
|
||||
restore <DI>
|
||||
mov BX,[DI].C_page
|
||||
shr BX,1
|
||||
pushm <[DI].C_disp, BX>
|
||||
call sprint ; print the s-expression
|
||||
mov SP,BP
|
||||
mov BX,SPACE
|
||||
mov DX,SPECCHAR ; space
|
||||
xor AX,AX
|
||||
;;; mov detail,AX
|
||||
mov display,AX
|
||||
inc AX
|
||||
mov show,AX
|
||||
pushm <tmp_disp, tmp_page, BX, DX>
|
||||
call sprint ; print it
|
||||
mov SP,BP
|
||||
jmp sp1_020
|
||||
;;;****************************************************************************
|
||||
;;; Print a "newline" character
|
||||
;;; Purpose: Scheme interpreter support to output a newline character
|
||||
;;; to a port.
|
||||
;;;****************************************************************************
|
||||
public spnewlin
|
||||
spnewlin: lods byte ptr ES:[SI] ; load register operand
|
||||
save <SI>
|
||||
add AX,offset reg0 ; AX = port object
|
||||
mov CX,1
|
||||
pushm <CX, AX>
|
||||
C_call get_port,,Load_ES ; get port address
|
||||
mov SP,BP
|
||||
test AX,AX ; check return status
|
||||
jz new_010
|
||||
lea BX,new_er
|
||||
jmp src_err ; link to error handler
|
||||
new_010: mov display,AX
|
||||
;;; mov detail,AX
|
||||
inc AX
|
||||
mov show,AX
|
||||
mov BX,SPECCHAR
|
||||
mov DX,LF ; linefeed
|
||||
pushm <tmp_disp, tmp_page, DX, BX>
|
||||
call sprint
|
||||
mov SP,BP
|
||||
jmp next_SP ; return to interpreter
|
||||
;;;****************************************************************************
|
||||
;;; Find Print-length of an S-Expression
|
||||
;;; Purpose: Scheme interpreter support to determine the print length
|
||||
;;; of a scheme object.
|
||||
;;;****************************************************************************
|
||||
public prt_len
|
||||
prt_len: lods byte ptr ES:[SI] ; load register operand
|
||||
save <SI>
|
||||
add AX,offset reg0 ; AX = port object
|
||||
mov DI,AX
|
||||
xor CX,CX
|
||||
mov display,CX ; no display and show
|
||||
mov show,CX
|
||||
;;; inc CX
|
||||
;;; mov detail,CX
|
||||
save <DI>
|
||||
mov DX,OUT_PAGE*2
|
||||
mov CX,OUT_DISP
|
||||
mov BX,[DI].C_page
|
||||
shr BX,1 ; correct page number
|
||||
pushm <CX, DX, [DI].C_disp, BX>
|
||||
call sprint
|
||||
mov SP,BP ; AX = print length
|
||||
restore <DI>
|
||||
mov [DI].C_page,SPECFIX*2
|
||||
mov [DI].C_disp,AX ; get the print length
|
||||
jmp next_SP ; return to interpreter
|
||||
prn_proc endp
|
||||
prog ends
|
||||
end
|
||||
|
||||
|
|
@ -0,0 +1,755 @@
|
|||
; =====> CPRINT1.ASM
|
||||
;***************************************
|
||||
;* TIPC Scheme Runtime Support *
|
||||
;* S-Expression printing *
|
||||
;* *
|
||||
;* (C) Copyright 1985 by Texas *
|
||||
;* Instruments Incorporated. *
|
||||
;* All rights reserved. *
|
||||
;* *
|
||||
;* Date Written: 24 March 1986 *
|
||||
;* Last Modification: 10 Feb 1987 *
|
||||
;* *
|
||||
;* tc 2/10/87 fixed problem printing *
|
||||
;* circular data structs *
|
||||
;* rb 1/21/88 binary I/O uses *
|
||||
;* line-length = 0; *
|
||||
;* set dirty bit on writes *
|
||||
;* (commented out) *
|
||||
;* *
|
||||
;***************************************
|
||||
page 60,132
|
||||
include scheme.equ
|
||||
|
||||
P_FLAGS equ 6
|
||||
TEST_NUM equ 8
|
||||
RETURN equ 0Dh
|
||||
SPACE equ 20h
|
||||
CUR_COL equ 12
|
||||
N_COLS equ 20
|
||||
SYM_OVHD equ 7
|
||||
HEAPERR equ -3
|
||||
|
||||
DGROUP group data
|
||||
data segment word public 'DATA'
|
||||
assume DS:DGROUP
|
||||
public display, show, detail, ccount
|
||||
extrn port_seg:word
|
||||
extrn port_d:word
|
||||
extrn port_r:word
|
||||
extrn direct:word
|
||||
extrn test_ch:word
|
||||
extrn t_array:word
|
||||
ab_write db "[WARNING: Output aborted by SHIFT-BREAK]",0
|
||||
deep_str db "#<DEEP!>",0
|
||||
port_str db "#<PORT>",0
|
||||
parens db "()",0
|
||||
cont_str db "#<CONTINUATION>",0
|
||||
ary_str db "#("
|
||||
free_str db "#<FREE>",0
|
||||
code_str db "#<CODE>",0
|
||||
env_str db "#<ENVIRONMENT>",0
|
||||
clos_str db "#<PROCEDURE",0
|
||||
display dw 1 ; whether to use | and "
|
||||
show dw 1 ; whether to send actual char
|
||||
detail dw 1 ; whether to show detail
|
||||
ccount dw 0 ; character count
|
||||
branchtab dw sp_list ; [0] LISTTYPE
|
||||
dw sp_fix ; [1] FIXTYPE
|
||||
dw sp_flo ; [2] FLOTYPE
|
||||
dw sp_big ; [3] BIGTYPE
|
||||
dw sp_sym ; [4] SYMTYPE
|
||||
dw sp_str ; [5] STRTYPE
|
||||
dw sp_ary ; [6] ARYTYPE
|
||||
dw sp_cont ; [7] CONTTYPE
|
||||
dw sp_clos ; [8] CLOSTYPE
|
||||
dw sp_free ; [9] FREETYPE
|
||||
dw sp_code ; [10] CODETYPE
|
||||
dw sp_ref ; [11] REFTYPE
|
||||
dw sp_port ; [12] PORTTYPE
|
||||
dw sp_char ; [13] CHARTYPE
|
||||
dw sp_env ; [14] ENVTYPE
|
||||
data ends
|
||||
|
||||
PGROUP group prog
|
||||
prog segment byte public 'PROG'
|
||||
assume CS:PGROUP
|
||||
spt_arg struc
|
||||
dw ? ; caller's BP
|
||||
dw ? ; caller's return address
|
||||
pg dw ? ; location of item to be printed
|
||||
dis dw ?
|
||||
ppg dw ? ; location of output port
|
||||
pds dw ?
|
||||
spt_arg ends
|
||||
extrn setabort:near
|
||||
extrn ssetadr:near
|
||||
public sprint
|
||||
sprint proc near
|
||||
push BP
|
||||
mov BP,SP
|
||||
call setabort ; set address when abort
|
||||
xor AX,AX
|
||||
mov ccount,AX
|
||||
pushm <[BP].pds, [BP].ppg>
|
||||
call ssetadr ; set port address
|
||||
mov SP,BP
|
||||
|
||||
;fix for random i/o - note a write has taken place
|
||||
lea SI,port_r
|
||||
mov BX,[SI].C_page
|
||||
LoadPage ES,BX
|
||||
mov SI,port_d
|
||||
or word ptr ES:[SI+P_FLAGS],DIRTY
|
||||
|
||||
pushm <[BP].dis, [BP].pg>
|
||||
call subsprin ; print it
|
||||
mov SP,BP
|
||||
mov AX,ccount ; return number of characters
|
||||
pop BP
|
||||
ret
|
||||
sprint endp
|
||||
;**************************************************************************
|
||||
extrn take_cdr:near
|
||||
extrn restart:near
|
||||
extrn stkspc:near
|
||||
extrn get_sym:near
|
||||
extrn givechar:near
|
||||
extrn gvchars:near
|
||||
extrn copybig:near
|
||||
extrn fix2big:near
|
||||
extrn big2asc:near
|
||||
extrn get_flo:near
|
||||
extrn isspace:near
|
||||
extrn abort:near
|
||||
|
||||
subp_arg struc
|
||||
tmp_reg1 dw ?
|
||||
tmp_reg2 dw ?
|
||||
tmp_reg3 dw ?
|
||||
tmp_pg dw ?
|
||||
tmp_SI dw ?
|
||||
ch_buf db 14 dup (0) ; character buffer
|
||||
subp_BP dw ? ; caller's BP
|
||||
dw ? ; caller's ES
|
||||
dw ? ; caller's return address
|
||||
spg dw ? ; page number
|
||||
sdis dw ? ; displacement
|
||||
subp_arg ends
|
||||
|
||||
subsprin proc near
|
||||
push ES
|
||||
push BP
|
||||
sub SP,offset subp_BP ; allocate local storage
|
||||
mov BP,SP
|
||||
cmp s_break,0 ; check for SHIFT-BREAK
|
||||
je subp_10
|
||||
kill_out: mov AX,RETURN ; carriage return
|
||||
push AX
|
||||
call givechar
|
||||
mov SP,BP
|
||||
mov AX,41 ; length of message
|
||||
lea BX,ab_write
|
||||
pushm <AX, BX>
|
||||
call printstr ; display message
|
||||
mov SP,BP
|
||||
cmp show,0
|
||||
je kill_01
|
||||
xor AX,AX
|
||||
jmp kill_02
|
||||
kill_01: mov AX,2
|
||||
kill_02: push AX ; instruction length
|
||||
C_call restart ; link to scheme debugger
|
||||
; control does not return to here
|
||||
subp_10: call stkspc ; check stack space
|
||||
cmp AX,64 ; stack low?
|
||||
jge subp_20 ; no, jump
|
||||
mov AX,8
|
||||
lea BX,deep_str
|
||||
pushm <AX, BX>
|
||||
call printstr ; print no deeper
|
||||
mov SP,BP
|
||||
jmp subp_ret
|
||||
; act on object type
|
||||
subp_20: shl [BP].spg,1 ; adjust page number
|
||||
mov BX,[BP].spg
|
||||
mov DI,ptype+[BX] ; get port type
|
||||
jmp branchtab+[DI]
|
||||
|
||||
;; the individual type handlers
|
||||
|
||||
; handle for list
|
||||
sp_list: test BX,BX ; null page?
|
||||
jnz sp_l01 ; no, jump
|
||||
mov AX,2
|
||||
lea BX,parens
|
||||
pushm <AX, BX>
|
||||
call printstr ; print "()"
|
||||
mov SP,BP
|
||||
jmp subp_ret
|
||||
sp_l01: mov DX,28h ; '('
|
||||
push DX
|
||||
call printcha
|
||||
mov SP,BP
|
||||
mov BX,[BP].spg ; Get page
|
||||
LoadPage ES,BX ; Get paragraph address of page
|
||||
mov SI,[BP].sdis ; dispacement
|
||||
sp_l02: mov [BP].tmp_pg,BX ; Save page
|
||||
mov [BP].tmp_SI,SI ; and displacement
|
||||
xor DH,DH
|
||||
mov DL,byte ptr ES:[SI] ; Get car's page
|
||||
shr DX,1 ; Change to number for subsprin
|
||||
mov CX,word ptr ES:[SI+1] ; Get car's displacement
|
||||
pushm <CX, DX>
|
||||
call subsprin ; Go print it
|
||||
mov SP,BP
|
||||
mov BX,[BP].tmp_pg ; Restore page
|
||||
LoadPage ES,BX ; Its para address
|
||||
mov SI,[BP].tmp_SI ; and displacement
|
||||
mov BL,byte ptr ES:[SI+3] ; Get cdr's page offset
|
||||
mov SI,word ptr ES:[SI+4] ; and displacement
|
||||
test BX,BX ; more items in list?
|
||||
jz sp_l04 ; no, jump
|
||||
mov [BP].tmp_SI,SI ; save registers
|
||||
mov [BP].tmp_reg1,BX
|
||||
mov DX,SPACE ; print ' '
|
||||
push DX
|
||||
call printcha
|
||||
mov SP,BP
|
||||
mov BX,[BP].tmp_reg1 ; restore registers
|
||||