Unpack disk2.tgz

This commit is contained in:
Lassi Kortela 2023-05-20 12:57:05 +03:00
parent e5f37aa173
commit 3a12151067
96 changed files with 34755 additions and 0 deletions

124
alink.asm Normal file
View File

@ -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


352
block.asm Normal file
View File

@ -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


648
border.asm Normal file
View File

@ -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


1465
cio.asm Normal file

File diff suppressed because it is too large Load Diff

229
cprint.asm Normal file
View File

@ -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


755
cprint1.asm Normal file
View File

@ -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