755 lines
24 KiB
NASM
755 lines
24 KiB
NASM
; =====> 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
|
||
mov SI,[BP].tmp_SI
|
||
LoadPage ES,BX ; Get paragraph address of page
|
||
cmp byte ptr ptype+[BX],LISTTYPE*2 ; check port type
|
||
je sp_l02
|
||
; last cdr not nil
|
||
mov [BP].tmp_SI,SI ; save registers
|
||
mov [BP].tmp_reg1,BX
|
||
mov DX,2Eh ; print '.'
|
||
push DX
|
||
call printcha
|
||
mov SP,BP
|
||
mov DX,SPACE ; print ' '
|
||
push DX
|
||
call printcha
|
||
mov SP,BP
|
||
mov BX,[BP].tmp_reg1 ; restore registers
|
||
mov SI,[BP].tmp_SI
|
||
shr BX,1 ; corrected page number
|
||
pushm <SI, BX>
|
||
call subsprin
|
||
mov SP,BP
|
||
sp_l04: mov DX,29h ; print ')'
|
||
push DX
|
||
call printcha
|
||
mov SP,BP
|
||
jmp subp_ret
|
||
; handle for fixnum
|
||
sp_fix: mov AX,5
|
||
mov [BP].tmp_reg2,AX
|
||
push AX
|
||
C_call getmem
|
||
mov SP,BP
|
||
cmp AX,0
|
||
je mem_err
|
||
mov [BP].tmp_reg1,AX ; address of divider
|
||
mov SI,[BP].sdis ; get the value
|
||
shl SI,1
|
||
sar SI,1
|
||
pushm <AX, SI>
|
||
mov AX,DS
|
||
mov ES,AX ; get the right ES segment
|
||
call fix2big ; change to bignum
|
||
mov SP,BP
|
||
jmp printint
|
||
mem_err: mov AX,HEAPERR ; memory not available
|
||
push AX
|
||
call abort
|
||
mov SP,BP
|
||
jmp subp_ret ; return
|
||
; handle for flonum
|
||
sp_flo: mov SI,[BP].sdis ; displacement
|
||
shr BX,1 ; corrected page number
|
||
pushm <SI, BX>
|
||
call get_flo ; get a floating point value
|
||
pushm <AX, BX, CX, DX> ; in AX:BX:CX:DX
|
||
C_call printflo,,Load_ES
|
||
mov SP,BP
|
||
jmp subp_ret
|
||
; handle for array
|
||
sp_ary: mov AX,2
|
||
LoadPage ES,BX ; page segment
|
||
lea BX,ary_str ; print "#("
|
||
pushm <AX, BX>
|
||
call printstr
|
||
mov SP,BP
|
||
|
||
LoadPage ES,[BP].spg ; Get page address of array
|
||
;;; mov ES,word ptr pagetabl+[BX]
|
||
mov SI,[BP].sdis ; and segment
|
||
mov CX,word ptr ES:[SI+1]
|
||
sub CX,BLK_OVHD ; length of array
|
||
mov BX,BLK_OVHD
|
||
mov [BP].tmp_reg1,CX
|
||
sp_a01:
|
||
cmp BX,[BP].tmp_reg1
|
||
jle sp_a04
|
||
jmp sp_l04
|
||
sp_a04: mov AL,byte ptr ES:[SI+BX] ; AX <= page of array element
|
||
mov DX,word ptr ES:[SI+BX+1] ; DX <= disp. of array element
|
||
xor AH,AH
|
||
shr AX,1 ; Page number for subsprin
|
||
mov [BP].tmp_reg2,BX ; Save registers
|
||
mov [BP].tmp_SI,SI
|
||
pushm <DX, AX>
|
||
call subsprin ; print element
|
||
mov SP,BP
|
||
mov BX,[BP].tmp_reg2 ; restore BX
|
||
cmp BX,[BP].tmp_reg1 ; last element?
|
||
jge sp_a02
|
||
mov DX,SPACE ; print ' '
|
||
push DX
|
||
call printcha
|
||
mov SP,BP
|
||
mov BX,[BP].tmp_reg2 ; restore registers
|
||
sp_a02: mov SI,[BP].tmp_SI
|
||
add BX,PTRSIZE
|
||
LoadPage ES,[BP].spg ; Reload page address of array
|
||
jmp sp_a01
|
||
; handle for continuation
|
||
sp_cont: mov AX,15
|
||
lea BX,cont_str
|
||
pushm <AX, BX>
|
||
call printstr
|
||
mov SP,BP
|
||
jmp subp_ret
|
||
; handle for closure
|
||
sp_clos: mov AX,11
|
||
lea BX,clos_str
|
||
pushm <AX, BX>
|
||
call printstr ; print "#<PROCEDURE"
|
||
; fetch information operand from closure object
|
||
LoadPage ES,[BP].spg ; Get address of page
|
||
mov SI,[BP].sdis
|
||
lea BX,[BP].tmp_reg1
|
||
xor AH,AH
|
||
mov AL,byte ptr ES:[SI+3] ; Page # of information op
|
||
mov [BX].C_page,AX
|
||
mov AX,word ptr ES:[SI+4] ; Disp of information op
|
||
mov [BX].C_disp,AX
|
||
; follow information operand list to cdr of last list cell
|
||
sp_c001: mov DI,[BX].C_page
|
||
cmp DI,0
|
||
je sp_c01
|
||
cmp byte ptr ptype+[DI],LISTTYPE*2
|
||
jne sp_c01
|
||
push BX
|
||
call take_cdr
|
||
lea BX,[BP].tmp_reg1
|
||
jmp sp_c001
|
||
; If final operand is a symbol, print it
|
||
sp_c01: cmp byte ptr ptype+[DI],SYMTYPE*2
|
||
jne sp_c04
|
||
LoadPage ES,DI
|
||
mov SI,[BX].C_disp
|
||
mov BX,word ptr ES:[SI+1] ; get the object size
|
||
sub BX,BLK_OVHD+PTRSIZE
|
||
push DI ; temp-save DI
|
||
push BX
|
||
dec BX
|
||
mov [BP].tmp_reg3,BX ; BX = symbol length
|
||
C_call getmem
|
||
pop DI ; (get getmem arg off stack)
|
||
pop DI ; temp-restore DI
|
||
mov SP,BP
|
||
cmp AX,0 ; memory available?
|
||
jne sp_c02
|
||
jmp mem_err ; no, jump
|
||
sp_c02: mov [BP].tmp_reg2,AX
|
||
sar DI,1
|
||
mov CX,DS ; ES points to DS segment
|
||
mov ES,CX
|
||
pushm <[BP].tmp_reg1, DI, AX> ; [tmp_reg1] = disp
|
||
call get_sym ; get the symbol name
|
||
mov SP,BP
|
||
mov DX,SPACE
|
||
push DX
|
||
call printcha ; print ' '
|
||
mov SP,BP
|
||
pushm <[BP].tmp_reg3, [BP].tmp_reg2>
|
||
call printstr ; print the symbol name
|
||
mov SP,BP
|
||
mov BX,[BP].tmp_reg3
|
||
inc BX
|
||
pushm <BX, [BP].tmp_reg2>
|
||
C_call rlsmem
|
||
mov SP,BP
|
||
sp_c04: mov DX,3Eh
|
||
push DX
|
||
call printcha ; print '>'
|
||
mov SP,BP
|
||
jmp subp_ret
|
||
; handle for free
|
||
sp_free: mov AX,7
|
||
lea BX,free_str
|
||
pushm <AX, BX>
|
||
call printstr ; print #<FREE>
|
||
mov SP,BP
|
||
jmp subp_ret
|
||
; handle for code block
|
||
sp_code: mov AX,7
|
||
lea BX,code_str
|
||
pushm <AX, BX>
|
||
call printstr ; print #<CODE>
|
||
mov SP,BP
|
||
jmp subp_ret
|
||
; handle for environment
|
||
sp_env: mov AX,14
|
||
lea BX,env_str
|
||
pushm <AX, BX>
|
||
call printstr ; print #<ENVIRONMENT>
|
||
mov SP,BP
|
||
jmp subp_ret
|
||
; handle for symbol
|
||
sp_sym: mov AX,7Ch
|
||
mov CX,SYM_OVHD
|
||
mov SI,[BP].sdis
|
||
shr BX,1 ; corrected page number
|
||
pushm <AX, CX, SI, BX>
|
||
C_call printatm,,Load_ES ; print the symbol
|
||
mov SP,BP
|
||
jmp subp_ret
|
||
; handle for string
|
||
sp_str: LoadPage ES,BX ; Get address of page
|
||
mov SI,[BP].sdis ; and displacement
|
||
mov CX,word ptr ES:[SI+1]
|
||
cmp CX,0 ; check for small string
|
||
jge sp_s01
|
||
add CX,BLK_OVHD+PTRSIZE
|
||
sp_s01: sub CX,BLK_OVHD ; get the string length
|
||
mov [BP].tmp_reg1,CX ; save the string length
|
||
mov DX,ccount
|
||
add DX,CX
|
||
mov ccount,DX
|
||
cmp show,0
|
||
jne sp_s02
|
||
jmp subp_ret
|
||
sp_s02: add SI,BLK_OVHD ; advance pointer to string
|
||
mov [BP].tmp_SI,SI
|
||
cmp display,0
|
||
jne sp_s02a
|
||
jmp sp_sdis
|
||
; write, need to print double quotes, escape characters
|
||
sp_s02a: xor BX,BX
|
||
mov DX,2 ; strange = 2
|
||
sp_s001: cmp BX,CX
|
||
jge sp_s05
|
||
mov AL,byte ptr ES:[SI+BX]
|
||
cmp AL,5Ch ; check for \
|
||
je sp_s03
|
||
cmp AL,22h ; check for "
|
||
jne sp_s04
|
||
sp_s03: inc DX
|
||
sp_s04: inc BX
|
||
jmp sp_s001
|
||
sp_s05: add DX,CX ; strange + len
|
||
push DX
|
||
call wrap
|
||
mov AX,22h
|
||
push AX
|
||
call givechar ; print " for string
|
||
mov SP,BP
|
||
xor BX,BX
|
||
mov SI,[BP].tmp_SI
|
||
sp_s06: cmp BX,[BP].tmp_reg1 ; finish the string?
|
||
jge sp_s10
|
||
cmp s_break,0 ; check for SHIFT-BREAK
|
||
je sp_s07
|
||
jmp kill_out ; yes, jump
|
||
sp_s07:
|
||
LoadPage ES,[BP].spg ; Ensure string page loaded
|
||
mov DL,byte ptr ES:[SI+BX] ; Get one character
|
||
xor DH,DH
|
||
mov [BP].tmp_reg2,BX ; save registers
|
||
cmp DL,5Ch ; \?
|
||
je sp_s08
|
||
cmp DL,22h ; "?
|
||
jne sp_s09
|
||
sp_s08: mov AX,5Ch
|
||
mov [BP].tmp_reg3,DX ; save the character
|
||
push AX
|
||
call givechar ; print the \ for special
|
||
mov SP,BP
|
||
mov DX,[BP].tmp_reg3
|
||
sp_s09: push DX
|
||
call givechar ; print the character
|
||
mov SP,BP
|
||
mov SI,[BP].tmp_SI ; restore registers
|
||
mov BX,[BP].tmp_reg2
|
||
inc BX
|
||
jmp sp_s06
|
||
sp_s10: mov AX,22h
|
||
push AX
|
||
call givechar ; print "
|
||
mov SP,BP
|
||
jmp subp_ret
|
||
; display, just print the string
|
||
sp_sdis: push CX
|
||
call wrap
|
||
xor BX,BX
|
||
mov SI,[BP].tmp_SI
|
||
sp_s11: cmp BX,[BP].tmp_reg1 ; finish the string?
|
||
jl sp_s12
|
||
jmp subp_ret ; yes, return
|
||
sp_s12: cmp s_break,0 ; check for SHIFT-BREAK
|
||
je sp_s13
|
||
jmp kill_out ; yes, jump
|
||
sp_s13: xor AH,AH
|
||
LoadPage ES,[BP].spg ; Ensure string page loaded
|
||
mov AL,byte ptr ES:[SI+BX] ; get the character
|
||
push AX
|
||
mov [BP].tmp_reg2,BX ; save registers
|
||
call givechar ; print the character
|
||
mov SP,BP
|
||
mov BX,[BP].tmp_reg2 ; restore registers
|
||
mov SI,[BP].tmp_SI
|
||
inc BX ; increment the index
|
||
jmp sp_s11
|
||
; handle for character
|
||
sp_char: mov SI,[BP].sdis
|
||
and SI,00FFh ; get the low byte for character
|
||
cmp display,0
|
||
je sp_c10
|
||
mov AX,SI ; AL = character
|
||
lea SI,[BP].ch_buf
|
||
mov byte ptr [SI],23h ; #
|
||
mov byte ptr [SI+1],5Ch ; \
|
||
mov byte ptr [SI+2],AL ; character
|
||
mov byte ptr [SI+3],0 ; end of string
|
||
; check for a special multi-character character constant
|
||
xor BX,BX
|
||
lea DI,test_ch
|
||
sp_ch01: cmp BX,TEST_NUM ; end of comparison?
|
||
jl sp_ch02
|
||
mov BX,3 ; yes
|
||
jmp sp_ch12
|
||
sp_ch02: cmp AL,byte ptr [DI+BX] ; compare with special char
|
||
je sp_ch05
|
||
inc BX
|
||
jmp sp_ch01
|
||
sp_ch05: lea DI,t_array
|
||
shl BX,1 ; get the word offset
|
||
mov DI,word ptr [DI+BX] ; pointer to special char string
|
||
mov BX,2
|
||
sp_ch03: cmp byte ptr [DI],0 ; end of string?
|
||
je sp_ch04 ; yes, jump
|
||
mov AL,byte ptr [DI]
|
||
mov byte ptr [SI+BX],AL ; move character by character
|
||
inc BX
|
||
inc DI
|
||
jmp sp_ch03
|
||
sp_ch04: mov byte ptr [SI+BX],0 ; end of string
|
||
sp_ch12: pushm <BX, SI> ; BX = length of buffer
|
||
call printstr
|
||
mov SP,BP
|
||
jmp subp_ret
|
||
; print character without escapes
|
||
sp_c10: push SI
|
||
call printcha
|
||
mov SP,BP
|
||
jmp subp_ret
|
||
; handle for bignum
|
||
sp_big: LoadPage ES,BX
|
||
mov SI,[BP].sdis
|
||
mov AX,word ptr ES:[SI+1] ; get object size
|
||
dec AX
|
||
mov [BP].tmp_reg2,AX
|
||
push AX
|
||
C_call getmem ; allocate memory for divider
|
||
mov SP,BP
|
||
cmp AX,0 ; memory available?
|
||
jne sp_big1
|
||
jmp mem_err ; no, error
|
||
sp_big1: mov [BP].tmp_reg1,AX ; address of divider
|
||
mov BX,[BP].spg
|
||
shr BX,1
|
||
pushm <AX, [BP].sdis, BX>
|
||
mov AX,DS
|
||
mov ES,AX ; get the right ES segment
|
||
call copybig ; copy bignum to buffer
|
||
printint:
|
||
mov AX,[BP].tmp_reg2
|
||
mov BX,3
|
||
mul BX
|
||
sub AX,5
|
||
mov [BP].tmp_SI,AX
|
||
push AX
|
||
C_call getmem ; allocate memory for char buffer
|
||
mov SP,BP
|
||
cmp AX,0 ; memory available?
|
||
jne sp_big2
|
||
jmp mem_err ; no, error
|
||
sp_big2: mov [BP].tmp_reg3,AX ; address of bigchars
|
||
pushm <AX,[BP].tmp_reg1>
|
||
call big2asc ; convert bignum to char string
|
||
mov SP,BP ; AX = characters count
|
||
pushm <AX, [BP].tmp_reg3>
|
||
call printstr ; print the bignum
|
||
mov SP,BP
|
||
pushm <[BP].tmp_reg2, [BP].tmp_reg1>
|
||
C_call rlsmem
|
||
pushm <[BP].tmp_SI, [BP].tmp_reg3>
|
||
C_call rlsmem
|
||
mov SP,BP
|
||
jmp subp_ret
|
||
; handle for port
|
||
sp_port: mov AX,7
|
||
lea BX,port_str
|
||
pushm <AX, BX>
|
||
call printstr ; print #<PORT>
|
||
mov SP,BP
|
||
sp_ref:
|
||
subp_ret: add SP,offset subp_BP ; release local storage
|
||
pop BP
|
||
pop ES
|
||
ret
|
||
subsprin endp
|
||
;******************************************************************************
|
||
; Print a single character to the file, and send a newline
|
||
; if necessary.
|
||
;******************************************************************************
|
||
pch_arg struc
|
||
dw ? ; caller's BP
|
||
dw ? ; caller's return address
|
||
cha dw ? ; character
|
||
pch_arg ends
|
||
|
||
printcha proc near
|
||
push BP
|
||
mov BP,SP
|
||
inc ccount ; ccount++
|
||
cmp show,0 ; show?
|
||
je prch_ret ; no, return
|
||
call currspc ; check spaces remaining
|
||
cmp AX,0
|
||
jle prch_01
|
||
prch_001: push [BP].cha
|
||
call givechar
|
||
mov SP,BP
|
||
jmp prch_ret ; return to caller
|
||
prch_01: test direct,BINARY
|
||
jnz prch_001
|
||
mov AX,RETURN
|
||
push AX
|
||
call givechar ; newline
|
||
mov SP,BP
|
||
push [BP].cha
|
||
call isspace ; after newline, print nonspaces
|
||
test AX,AX
|
||
jnz prch_ret ; space, return
|
||
jmp prch_001
|
||
prch_ret: pop BP
|
||
ret ; return to caller
|
||
printcha endp
|
||
;******************************************************************************
|
||
; Print the string with length LEN, first sending a newline
|
||
; if necessary.
|
||
;******************************************************************************
|
||
str_arg struc
|
||
dw ? ; caller's BP
|
||
dw ? ; caller's return address
|
||
str dw ? ; string pointer
|
||
len dw ? ; string length
|
||
str_arg ends
|
||
public printstr
|
||
printstr proc near
|
||
push BP
|
||
mov BP,SP
|
||
push [BP].len
|
||
call wrap ; check available spaces
|
||
mov AX,ccount
|
||
add AX,[BP].len ; ccount += len
|
||
mov ccount,AX
|
||
cmp show,0 ; show?
|
||
je pstr_ret ; no, return
|
||
pushm <[BP].len, [BP].str>
|
||
call gvchars ; display all characters
|
||
pstr_ret: pop BP
|
||
ret
|
||
printstr endp
|
||
;******************************************************************************
|
||
; Return number of spaces remaining on current line
|
||
;******************************************************************************
|
||
currspc proc near
|
||
pop DI ; get the return address
|
||
push ES
|
||
push SI
|
||
lea SI,port_r
|
||
mov SI,[SI].C_page
|
||
LoadPage ES,SI
|
||
;;; LoadPage ES,port_seg ; Get port para address
|
||
mov SI,port_d
|
||
mov AX,word ptr ES:[SI+N_COLS] ; line length
|
||
test AX,AX ; line length defined?
|
||
jnz curr_01
|
||
mov AX,-1 ; no, return negative value
|
||
jmp curr_02
|
||
curr_01: sub AX,word ptr ES:[SI+CUR_COL]
|
||
curr_02: pop SI
|
||
pop ES
|
||
jmp DI ; return to caller
|
||
currspc endp
|
||
;******************************************************************************
|
||
; Return current column
|
||
;******************************************************************************
|
||
curr_col proc near
|
||
pop DI ; get the return address
|
||
push ES
|
||
push SI
|
||
lea SI,port_r
|
||
mov SI,[SI].C_page
|
||
LoadPage ES,SI
|
||
;;; LoadPage ES,port_seg ; Get port para address
|
||
mov SI,port_d
|
||
mov AX,word ptr ES:[SI+N_COLS] ; Get Number of columns
|
||
or AX,AX ; Maintaining column?
|
||
jz ccol_ret ; No, just return 0
|
||
mov AX,word ptr ES:[SI+CUR_COL] ; Yes, get column and return
|
||
ccol_ret: pop SI
|
||
pop ES
|
||
jmp DI ; return to caller
|
||
curr_col endp
|
||
;******************************************************************************
|
||
; Wrap issues a newline if there are less than LEN spaces
|
||
; left on the current output line.
|
||
; Note: DX = LEN
|
||
;******************************************************************************
|
||
public wrap
|
||
wrap proc near
|
||
pop DI ; get the return address
|
||
pop DX ; get the length
|
||
cmp show,0
|
||
jz wrap_ret
|
||
push DI ; save return address
|
||
call curr_col ; get the current column number
|
||
pop DI ; restore return address
|
||
cmp AX,1
|
||
jle wrap_ret
|
||
push DI ; save return address
|
||
call currspc ; get the available spaces
|
||
pop DI ; restore return address
|
||
cmp AX,DX
|
||
jge wrap_ret
|
||
mov AX,RETURN ; issue a newline
|
||
push AX
|
||
call givechar
|
||
mov SP,BP
|
||
wrap_ret: jmp DI ; return to caller
|
||
wrap endp
|
||
|
||
prog ends
|
||
end
|
||
|
||
|
||
|
||
|
||
|