1403 lines
48 KiB
NASM
1403 lines
48 KiB
NASM
; ======> PROSPRIN.ASM
|
||
;************************************************************************
|
||
;* PC Scheme Runtime Support - Sexpression Print Routines *
|
||
;* *
|
||
;* (C) Copyright 1985 by Texas *
|
||
;* Instruments Incorporated. *
|
||
;* All rights reserved. *
|
||
;* *
|
||
;* Date Written: 24 March 1986 *
|
||
;* *
|
||
;* Modifications: *
|
||
;* *
|
||
;* 11/27/87 (tc) Rewritten for protected mode scheme. Also *
|
||
;* modified to buffer the output more effectively. *
|
||
;* *
|
||
;************************************************************************
|
||
page 60,132
|
||
title PC Scheme Print Handlers
|
||
include scheme.equ
|
||
include sinterp.arg
|
||
include xli_pro.mac
|
||
|
||
NUMBER_SPECIAL_CHARS equ 8 ;special chars defined in cread.asm
|
||
|
||
RETURN equ 0Dh
|
||
SPACE equ 20h
|
||
SYM_OVHD equ 7
|
||
HEAPERR equ -3
|
||
|
||
DGROUP group data
|
||
data segment word public 'DATA'
|
||
assume DS:DGROUP
|
||
public display, show, ccount
|
||
;from sread.asm
|
||
extrn test_ch:word
|
||
extrn t_array:word
|
||
;from xli_pro.asm
|
||
extrn rpc_handle:byte
|
||
extrn REAL_MODE_BUFFER:dword
|
||
extrn REAL_BUF_OFFSET:word,REAL_BUF_SELECTOR:word
|
||
extrn REAL_BUF_PARA:word,REAL_BUF_TOP:WORD
|
||
;from iosupport.asm
|
||
extrn port_seg:word,port_pg:word,port_ds:word
|
||
;from ???
|
||
extrn hicases:byte
|
||
|
||
;Table of strange characters used by printatm
|
||
stranges db " ,'"
|
||
db ';":()`'
|
||
db 13,12,11,10,9,0
|
||
|
||
;
|
||
; The following global data is used to tell the print handlers about
|
||
; the print characteristics, ie. to surround strings with double quotes,
|
||
; to display escape characters, etc.
|
||
;
|
||
;
|
||
display dw 0 ; whether to surround atoms/strings with | or "
|
||
show dw 1 ; whether actually printing chars or not
|
||
ccount dw 0 ; char count used to determine print length
|
||
|
||
;
|
||
; Branch table of all Scheme object print handlers
|
||
;
|
||
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 subp_ret ; [11] REFTYPE
|
||
dw sp_port ; [12] PORTTYPE
|
||
dw sp_char ; [13] CHARTYPE
|
||
dw sp_env ; [14] ENVTYPE
|
||
|
||
;
|
||
; Following text will be output for those objects which have not
|
||
; printable representations.
|
||
;
|
||
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
|
||
;
|
||
; Following are error messages
|
||
;
|
||
sp1_er db "WRITE",0
|
||
spc_er db "DISPLAY",0
|
||
spt_er db "PRINT",0
|
||
new_er db "NEWLINE",0
|
||
deep_str db "#<DEEP!>",0
|
||
ab_write db "[WARNING: Output aborted by SHIFT-BREAK]",0
|
||
bad_set db "[VM INTERNAL ERROR] setadr: bad port",CR,LF,0
|
||
|
||
data ends
|
||
|
||
PGROUP group prog
|
||
prog segment byte public 'PROG'
|
||
assume CS:PGROUP
|
||
extrn next_SP:near
|
||
extrn src_err:near
|
||
extrn get_port:near
|
||
extrn setabort:near,abort:near
|
||
extrn take_cdr:near,restart:near,stkspc:near
|
||
extrn copybig:near,fix2big:near,big2asc:near,get_flo:near
|
||
extrn isspace:near
|
||
extrn gvchars:near,ssetadr:near
|
||
extrn scannum:near
|
||
|
||
comment | Commented out 2/10/88 by TC - moved to realio routine
|
||
|
||
;******************************************************************************
|
||
;WRAP - Local macro definition. If there are less than LEN spaces left on
|
||
; the local output line, make AX non-zero to denote wrap necessary.
|
||
;
|
||
; Note: es:di are destroyed
|
||
;******************************************************************************
|
||
wrap macro len,result
|
||
local wrapend
|
||
push es
|
||
push di
|
||
xor result,result ;result = default no wrap
|
||
cmp show,0 ;are we actually printing?
|
||
jz wrapend ; no, just return with default
|
||
LoadPage es,port_pg
|
||
mov di,port_ds ;es:di => port object
|
||
cmp es:[di].pt_ncols,0 ;maintaining line length?
|
||
jz wrapend ; no, return default
|
||
cmp es:[di].pt_ccol,1 ;in the first column already?
|
||
jle wrapend ; yes, return default
|
||
mov result,es:[di].pt_ncols ;ax = number cols
|
||
sub result,es:[di].pt_ccol ;ax = remaining spaces
|
||
cmp result,len ;any room left?
|
||
mov result,0 ;
|
||
jge wrapend ; yes, return nowrap flag
|
||
inc result ; no, return wrap flag
|
||
wrapend:
|
||
pop di
|
||
pop es
|
||
endm
|
||
|
||
|
|
||
|
||
prn_proc proc near
|
||
;;;****************************************************************************
|
||
;;; VM Opcode handler for "WRITE"
|
||
;;;
|
||
;;; Print an S-Expression with slashification
|
||
;;;
|
||
;;;****************************************************************************
|
||
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:
|
||
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
|
||
mov display,0 ; default display = no
|
||
jmp next_SP ; return to interpreter
|
||
;;;****************************************************************************
|
||
;;; VM Opcode handler for "DISPLAY"
|
||
;;;
|
||
;;; Print an S-Expression without slashification
|
||
;;;
|
||
;;;****************************************************************************
|
||
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
|
||
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
|
||
;;;****************************************************************************
|
||
;;; VM Opcode handler for "PRINT"
|
||
;;;
|
||
;;; Print an S-Expression with spacing control
|
||
;;;
|
||
;;;****************************************************************************
|
||
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
|
||
inc AX
|
||
mov show,AX
|
||
mov DX,SPECCHAR
|
||
mov BX,RETURN ; carriage return
|
||
pushm <tmp_disp, tmp_page, BX, DX>
|
||
call sprint ; print it
|
||
mov SP,BP
|
||
xor AX,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 display,AX
|
||
inc AX
|
||
mov show,AX
|
||
pushm <tmp_disp, tmp_page, BX, DX>
|
||
call sprint ; print it
|
||
mov SP,BP
|
||
jmp sp1_020
|
||
;;;****************************************************************************
|
||
;;; VM Opcode handler for "NEWLINE"
|
||
;;;
|
||
;;; Output a newline character
|
||
;;;
|
||
;;;****************************************************************************
|
||
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
|
||
inc AX
|
||
mov show,AX
|
||
mov BX,SPECCHAR
|
||
mov DX,RETURN ; carriage return
|
||
pushm <tmp_disp, tmp_page, DX, BX>
|
||
call sprint
|
||
mov SP,BP
|
||
mov display,0 ; default display = no
|
||
jmp next_SP ; return to interpreter
|
||
;;;****************************************************************************
|
||
;;; VM Opcode handler for "LINE-LENGTH"
|
||
;;;
|
||
;;; 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
|
||
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
|
||
|
||
;**************************************************************************
|
||
; SPRINT - Sexpression print routine
|
||
;
|
||
; Calling Sequence: sprint(pds,ppg,dis,pg)
|
||
;
|
||
; Where: ppg:pds = page:displacement of port to output to
|
||
; pg:dis = scheme object to output
|
||
;
|
||
; Upon Exit: AX = number of characters printed
|
||
;
|
||
;**************************************************************************
|
||
|
||
spt_arg struc
|
||
dw ? ;caller's BP
|
||
dw ? ;caller's return address
|
||
pg dw ? ;page num of object to print
|
||
dis dw ? ;page disp of object to print
|
||
ppg dw ? ;page num of output port
|
||
pds dw ? ;page disp of output port
|
||
spt_arg ends
|
||
|
||
public sprint
|
||
sprint proc near
|
||
push BP
|
||
mov BP,SP ;set up stack
|
||
call setabort ;set address when abort
|
||
pushm <[BP].pds, [BP].ppg>
|
||
call ssetadr ;set port address
|
||
mov SP,BP
|
||
|
||
;fix for random i/o - note a write has taken place
|
||
mov AX,ES ;save extra segment
|
||
LoadPage ES,port_pg ;address port
|
||
mov SI,port_ds
|
||
or byte ptr ES:[SI].pt_pflgs,DIRTY ;note write has occurred
|
||
mov ES,AX ;restore extra segment
|
||
|
||
mov ccount,0 ;clear character count
|
||
pushm <[BP].dis, [BP].pg>
|
||
call subsprin ;go print the object
|
||
mov SP,BP
|
||
mov AX,ccount ;return number of characters
|
||
pop BP
|
||
ret ;return to caller
|
||
sprint endp
|
||
|
||
;**************************************************************************
|
||
; SUBSPRIN - Recursive print routine
|
||
;
|
||
; Calling Sequence: subsprin(dis,pg)
|
||
;
|
||
; Where: dis = displacement with pg of object to print
|
||
; pg = page of object to print
|
||
;
|
||
;**************************************************************************
|
||
public subsprin
|
||
subp_arg struc
|
||
tmp_reg1 dw ?
|
||
tmp_reg2 dw ?
|
||
tmp_reg3 dw ?
|
||
lst_pag dw ?
|
||
lst_dsp dw ?
|
||
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
|
||
call printcha
|
||
mov AX,41 ;length of message
|
||
lea BX,ab_write
|
||
pushm <AX, BX>
|
||
call printtxt ;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 ;#<DEEP!>
|
||
jmp subp_ret ;print message and return
|
||
; act on object type
|
||
subp_20:
|
||
shl [BP].spg,1 ;adjust page number
|
||
mov BX,[BP].spg
|
||
mov DI,ptype+[BX] ;get page type
|
||
jmp branchtab+[DI] ;envoke appropriate handler
|
||
;
|
||
; any problems with getmem should exit here
|
||
mem_err:
|
||
mov AX,HEAPERR ;memory not available
|
||
push AX
|
||
call abort
|
||
mov SP,BP
|
||
;
|
||
; return to caller
|
||
subp_ret:
|
||
add SP,offset subp_BP ;release local storage
|
||
pop BP
|
||
pop ES
|
||
ret
|
||
|
||
|
||
page 60,132
|
||
;-----------------------------------------------------------------------------
|
||
;
|
||
; Following are the print handlers for each object type, they will be invoked
|
||
; via an indirect call through BRANCHTAB.
|
||
;
|
||
; Upon entry: BX = an adjusted page number
|
||
; DI = the page type
|
||
;
|
||
; Upon exit: Jump to SUBP_RET for cleanup
|
||
;
|
||
;-----------------------------------------------------------------------------
|
||
|
||
;*******************************************************************************
|
||
;
|
||
; Print representation for code block object
|
||
;
|
||
;*******************************************************************************
|
||
public sp_code
|
||
sp_code: mov AX,7
|
||
lea BX,code_str ; #<CODE>
|
||
jmp subp_txt
|
||
;*******************************************************************************
|
||
;
|
||
; Print representation for continuation object
|
||
;
|
||
;*******************************************************************************
|
||
public sp_cont
|
||
sp_cont: mov AX,15
|
||
lea BX,cont_str ; #<CONTINUATION>
|
||
jmp subp_txt
|
||
;*******************************************************************************
|
||
;
|
||
; Print representation for environment object
|
||
;
|
||
;*******************************************************************************
|
||
public sp_env
|
||
sp_env: mov AX,14
|
||
lea BX,env_str ; #<ENVIRONMENT>
|
||
jmp subp_txt
|
||
;*******************************************************************************
|
||
;
|
||
; Print representation for free page
|
||
;
|
||
;*******************************************************************************
|
||
public sp_free
|
||
sp_free: mov AX,7
|
||
lea BX,free_str ; #<FREE>
|
||
jmp subp_txt
|
||
;*******************************************************************************
|
||
;
|
||
; Print representation for port object
|
||
;
|
||
;*******************************************************************************
|
||
public sp_port
|
||
sp_port: mov AX,7
|
||
lea BX,port_str ; #<PORT>
|
||
subp_txt:
|
||
pushm <AX, BX> ;ax = length, bx = message address
|
||
call printtxt ;print the message
|
||
mov SP,BP ;clean up stack
|
||
jmp subp_ret ;and return to caller
|
||
|
||
;*******************************************************************************
|
||
;
|
||
; Print floating point value
|
||
;
|
||
;*******************************************************************************
|
||
public sp_flo
|
||
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
|
||
|
||
;*******************************************************************************
|
||
;
|
||
; Print list
|
||
;
|
||
;*******************************************************************************
|
||
public sp_list
|
||
sp_list:
|
||
test bx,bx ;null page?
|
||
jnz sp_l01 ; no, go chase list
|
||
mov ax,2
|
||
lea bx,parens
|
||
pushm <ax, bx>
|
||
call printtxt ;print "()" for null list
|
||
mov sp,bp
|
||
jmp subp_ret
|
||
sp_l01:
|
||
mov al,byte ptr parens
|
||
call printcha ;print open paren
|
||
mov bx,[bp].spg
|
||
LoadPage es,bx
|
||
mov si,[bp].sdis ;es:si => list cell
|
||
sp_l02:
|
||
mov [bp].lst_pag,bx
|
||
mov [bp].lst_dsp,si ;save list cell
|
||
xor dh,dh
|
||
mov dl,byte ptr es:[si] ;get car of list
|
||
shr dx,1 ; make number for subsprin
|
||
mov cx,word ptr es:[si+1] ;get car's displacement
|
||
pushm <cx, dx>
|
||
call subsprin ;print car of list
|
||
mov sp,bp
|
||
mov bx,[bp].lst_pag ;restore list cell
|
||
LoadPage es,bx
|
||
mov si,[bp].lst_dsp
|
||
mov bl,byte ptr es:[si+3] ;get cdr of list
|
||
mov si,word ptr es:[si+4]
|
||
test bx,bx ;is it null?
|
||
jz sp_l04 ; yes, finished
|
||
pushm <si,bx> ;tempsave si,bx
|
||
mov al,' '
|
||
call printcha ;print space as item seperator
|
||
popm <bx,si> ;restore stack
|
||
LoadPage es,bx ;reload page of cdr
|
||
cmp byte ptr ptype+[bx],LISTTYPE*2 ;is cdr a list cell?
|
||
je sp_l02 ; yes, chase the list
|
||
; cdr is not a list cell - improper list
|
||
mov dx," ." ;need " ." due to byte swapping
|
||
pushm <si,bx,dx> ;tempsave si,bx - dx is text
|
||
mov si,sp
|
||
mov dx,2
|
||
pushm <dx,si> ;push length, address of text
|
||
call printtxt ;print ". "
|
||
add sp,6 ;dump last 3 args
|
||
popm <bx,si> ;restore saved regs
|
||
|
||
shr bx,1 ;make page a number for subsprin
|
||
pushm <si, bx>
|
||
call subsprin ;go chase last cdr
|
||
mov sp,bp ;dump args off stack
|
||
sp_l04:
|
||
mov al,byte ptr parens+1
|
||
call printcha ;and print it
|
||
mov sp,bp
|
||
jmp subp_ret ;return to caller
|
||
|
||
;*******************************************************************************
|
||
;
|
||
; Print array
|
||
;
|
||
;*******************************************************************************
|
||
public sp_ary
|
||
sp_ary: mov AX,2
|
||
LoadPage ES,BX ; page segment
|
||
lea BX,ary_str ; print "#("
|
||
pushm <AX, BX>
|
||
call printtxt
|
||
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].lst_dsp,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 ax,SPACE ; print ' '
|
||
call printcha
|
||
mov BX,[BP].tmp_reg2 ; restore registers
|
||
sp_a02: mov SI,[BP].lst_dsp
|
||
add BX,PTRSIZE
|
||
LoadPage ES,[BP].spg ; Reload page address of array
|
||
jmp sp_a01
|
||
;*******************************************************************************
|
||
;
|
||
; Print representation for closure object
|
||
;
|
||
;*******************************************************************************
|
||
public sp_clos
|
||
sp_clos: mov ax,11
|
||
lea bx,clos_str
|
||
pushm <ax,bx>
|
||
call printtxt ;print "#<PROCEDURE"
|
||
mov SP,BP
|
||
; get info operand from closure object
|
||
LoadPage es,[bp].spg
|
||
mov si,[bp].sdis ;es:si => closure object
|
||
lea bx,[bp].tmp_reg1
|
||
xor ah,ah
|
||
mov al,byte ptr es:[si+3] ;pag # of information op
|
||
mov [bx].C_page,ax ; save in tmp_reg1
|
||
mov ax,word ptr es:[si+4] ;displ of information op
|
||
mov [bx].C_disp,ax ; save in tmp_reg1
|
||
; follow info operand list
|
||
sp_c001:
|
||
mov di,[bx].C_page
|
||
cmp di,0 ;if reached end of list
|
||
je sp_c04 ; then exit loop
|
||
cmp byte ptr ptype+[di],LISTTYPE*2 ;if cdr not list cell
|
||
jne sp_c01 ; then exit loop
|
||
push bx
|
||
call take_cdr ;follow cdr of list
|
||
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 ;do we have a symbol?
|
||
jne sp_c04 ; no, jump
|
||
|
||
push bx ;tempsave reg around call
|
||
mov ax,SPACE
|
||
call printcha ;print ' '
|
||
pop bx ;restore reg
|
||
|
||
push display ;save around call
|
||
mov display,0 ;don't print escape chars
|
||
shr [bx].C_page,1 ;make page # for subsprin
|
||
pushm <[bx].C_disp,[bx].C_page> ;push page:disp of symbol
|
||
call subsprin ;go print the symbol
|
||
add sp,4 ;dump args off stack
|
||
pop display ;restore display indicator
|
||
sp_c04:
|
||
mov al,'>'
|
||
call printcha ;print '>'
|
||
mov SP,BP
|
||
jmp subp_ret
|
||
|
||
;*******************************************************************************
|
||
;
|
||
; Print symbol to output port
|
||
;
|
||
;*******************************************************************************
|
||
public printatm
|
||
printatm label near
|
||
sp_sym:
|
||
;
|
||
; Warning: local data segment is not used in code below
|
||
;
|
||
loadpage ds,bx
|
||
mov si,[bp].sdis ;ds:si => object
|
||
mov cx,[si]+1 ;get object length
|
||
sub cx,SYM_OVHD ;cx = length of atom
|
||
add SS:ccount,cx ;update character count
|
||
cmp SS:show,0 ;do we want to print the object?
|
||
jne pra_010 ; yes, continue
|
||
mov dx,ss ; no, restore data segment
|
||
mov ds,dx
|
||
jmp pra_exit ; and return
|
||
pra_010:
|
||
;cx = length of symbol
|
||
add si,SYM_OVHD ;ds:si => symbol name
|
||
GET_BUFFER ;es:di => real buffer
|
||
call atm2pbuf ;move printname to print buffer
|
||
;
|
||
; Warning: local data segment is not used in code above
|
||
;
|
||
mov dx,ss
|
||
mov ds,dx ;restore local data segment
|
||
cmp cx,0 ;if negative print length
|
||
jl pra_err ; then error, jump
|
||
;;; wrap cx,dx ;cx = length, dx = result
|
||
mov dx,1 ;check wrap flag
|
||
;cx = length, dx = check wrap flag, es:di => print buffer
|
||
call gvchars ;go print the buffer
|
||
pra_exit:
|
||
RLS_BUFFER
|
||
jmp subp_ret
|
||
pra_err:
|
||
jmp mem_err
|
||
|
||
;*******************************************************************************
|
||
;
|
||
; Print string to output port
|
||
;
|
||
;*******************************************************************************
|
||
public printstr
|
||
printstr label near
|
||
sp_str:
|
||
;
|
||
; Warning: local data segment is not used in code below
|
||
;
|
||
loadpage ds,bx
|
||
mov si,[bp].sdis ;ds:si => object
|
||
mov cx,[si]+1 ;cx = length indicator
|
||
add si,BLK_OVHD ;ds:si => actual string
|
||
or cx,cx ;small string?
|
||
jge prs_005 ; no, jump
|
||
add cx,BLK_OVHD+PTRSIZE
|
||
prs_005:
|
||
sub cx,BLK_OVHD ;cx = length of string
|
||
add SS:ccount,cx ;update character count
|
||
cmp SS:show,0 ;actually printing?
|
||
jne prs_010 ; yes, continue
|
||
mov dx,ss ; no, restore data segment
|
||
mov ds,dx
|
||
jmp pra_exit ; and return
|
||
prs_010:
|
||
|
||
;cx = string length
|
||
GET_BUFFER ;es:di => buffer for print string
|
||
call str2pbuf ;move string to print buffer
|
||
;
|
||
; Warning: local data segment is not used in code above
|
||
;
|
||
mov bx,ss ;restore local data segment
|
||
mov ds,bx
|
||
cmp cx,0 ;if negative print length
|
||
jl prs_err ; then error, jump
|
||
;;; wrap cx,dx ;cx=length, dx=result
|
||
mov dx,1 ;check wrap flag
|
||
;cx = length, dx = check wrap flag, es:di => print buffer
|
||
call gvchars ;go print the buffer
|
||
prs_exit:
|
||
RLS_BUFFER ;release the print buffer
|
||
jmp subp_ret
|
||
|
||
prs_err: jmp mem_err ;must be a long jump
|
||
|
||
|
||
;*******************************************************************************
|
||
;
|
||
; Print character to output port
|
||
;
|
||
;*******************************************************************************
|
||
public sp_char
|
||
sp_char:
|
||
cmp display,0 ;display escape chars?
|
||
jne sp_ch10 ; yes, jump
|
||
;print character without escapes
|
||
mov ax,[BP].sdis ;get character
|
||
xor ah,ah
|
||
call printcha ;call print routine
|
||
jmp subp_ret ;get outa here
|
||
;print character with escapes
|
||
sp_ch10:
|
||
mov bx,14 ;max size of character buffer
|
||
push bx
|
||
C_call getmem ;allocate space
|
||
mov sp,bp ;dump arg off stack
|
||
cmp ax,0
|
||
jne sp_ch00
|
||
jmp mem_err ;error allocating heap - jump
|
||
sp_ch00:
|
||
mov si,ax ;si => buffer
|
||
mov dx,ax ;dx => buffer
|
||
mov ax,[BP].sdis ;get character
|
||
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
|
||
mov bx,3 ;length
|
||
;
|
||
; see if character one of the multi-character constants in cread.asm
|
||
;
|
||
mov cx,ds
|
||
mov es,cx ;ensure ds=es
|
||
|
||
mov cx,NUMBER_SPECIAL_CHARS ;cx = counter
|
||
lea di,test_ch
|
||
add di,NUMBER_SPECIAL_CHARS-1 ;di => last special char
|
||
std
|
||
repne scasb ;search for special char
|
||
cld
|
||
jnz sp_ch20 ;if none found, jump
|
||
shl cx,1 ;make index into t_array
|
||
|
||
lea di,t_array
|
||
add di,cx
|
||
mov di,[di]
|
||
xchg si,di ;ds:si => character string
|
||
add di,2 ;es:di => character buffer
|
||
cld
|
||
xor al,al ;al = null terminator
|
||
sp_chlp:
|
||
movsb ;move byte into character buffer
|
||
cmp al,[si] ;reached terminator?
|
||
jne sp_chlp
|
||
sub di,dx ;calc length
|
||
mov bx,di
|
||
sp_ch20:
|
||
pushm <bx,dx> ;bx=buffer length, dx=buffer address
|
||
call printtxt ;print the character constant
|
||
mov SP,BP
|
||
|
||
mov bx,14 ;length of character buffer
|
||
pushm <bx,si>
|
||
C_call rlsmem ;release character buffer
|
||
mov sp,bp ;dump args off stack
|
||
jmp subp_ret
|
||
|
||
;*******************************************************************************
|
||
;
|
||
; Print integer value
|
||
;
|
||
;*******************************************************************************
|
||
public sp_fix
|
||
sp_fix: mov AX,5
|
||
mov [BP].tmp_reg2,AX
|
||
push AX
|
||
C_call getmem
|
||
mov SP,BP
|
||
or ax,ax
|
||
jnz sp_f10
|
||
jmp mem_err
|
||
sp_f10:
|
||
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
|
||
;*******************************************************************************
|
||
;
|
||
; Print bignum
|
||
;
|
||
;*******************************************************************************
|
||
public sp_big
|
||
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].lst_dsp,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 printtxt ; print the bignum
|
||
mov SP,BP
|
||
pushm <[BP].tmp_reg2, [BP].tmp_reg1>
|
||
C_call rlsmem
|
||
pushm <[BP].lst_dsp, [BP].tmp_reg3>
|
||
C_call rlsmem
|
||
mov SP,BP
|
||
jmp subp_ret
|
||
|
||
subsprin endp
|
||
|
||
|
||
; page 60,132
|
||
; title Print Handler Support Routines
|
||
;
|
||
;******************************************************************************
|
||
;PRINTTXT - C callable routine to print a string, first sending a newline
|
||
; character if necessary. The string is assumed to be in the
|
||
; local data segment.
|
||
;
|
||
; Calling Sequence: printtxt(string,len)
|
||
;
|
||
;******************************************************************************
|
||
str_arg struc
|
||
dw ? ; caller's BP
|
||
dw ? ; caller's ES
|
||
dw ? ; caller's return address
|
||
str dw ? ; string pointer
|
||
len dw ? ; string length
|
||
str_arg ends
|
||
public printtxt
|
||
printtxt proc near
|
||
push es
|
||
push bp
|
||
mov bp,sp ;set up stack
|
||
|
||
mov cx,[bp].len ;cx = length of string
|
||
add ccount,cx ;keep track of character count
|
||
cmp show,0 ;show?
|
||
je pstr_ret ; no, return
|
||
|
||
push display
|
||
mov display,0
|
||
mov si,[bp].str ;ds:si => string to write
|
||
GET_BUFFER ;es:di => buffer for print string
|
||
call str2pbuf ;move string to print buffer
|
||
pop display
|
||
|
||
;;; wrap cx,dx ;cx=length, dx=result
|
||
mov dx,1 ;check wrap flag
|
||
;cx = length, dx = check wrap flag, es:di => print buffer
|
||
call gvchars ;go print the buffer
|
||
RLS_BUFFER ;release the print buffer
|
||
pstr_ret:
|
||
pop bp
|
||
pop es
|
||
ret
|
||
printtxt endp
|
||
|
||
|
||
;******************************************************************************
|
||
;PRINTCHA - C callable routine to print a character, first sending a newline
|
||
; character if necessary. At least for now, this is performed by
|
||
; calling gvchars - in the future we may want output routines for
|
||
; outputting individual characters.
|
||
;
|
||
; Upon Entry: al contains character to print
|
||
;
|
||
;******************************************************************************
|
||
pcha_arg struc
|
||
dw ? ;caller's BP
|
||
dw ? ;caller's ES
|
||
dw ? ;caller's return address
|
||
pcha_arg ends
|
||
|
||
public printcha
|
||
printcha proc near
|
||
push es
|
||
push bp
|
||
mov bp,sp ;set up stack
|
||
|
||
inc ccount ;bump character count
|
||
cmp show,0 ;if not actually printing
|
||
jz pcha_ret ; then return
|
||
|
||
comment |
|
||
;see if enough space left on current output line
|
||
LoadPage es,port_pg
|
||
mov di,port_ds ;es:di => port object
|
||
xor dx,dx ;dx = wrap flag (0 = nowrap)
|
||
mov cx,es:[di].pt_ncols ;maintaining line length?
|
||
jcxz pcha_010
|
||
sub cx,es:[di].pt_ccol ;cx = space remaining
|
||
cmp cx,1 ;any space left?
|
||
jge pcha_010
|
||
mov dx,1
|
||
|
|
||
mov dx,1 ;check wrap flag
|
||
pcha_010:
|
||
RESET_REAL_BUFFER_OFFSET
|
||
MOVE_BYTE_TO_BUF al,REAL_MODE_BUFFER
|
||
mov cx,1 ;cx = length
|
||
call gvchars
|
||
pcha_ret:
|
||
xor ax,ax
|
||
pop bp
|
||
pop es
|
||
ret
|
||
printcha endp
|
||
|
||
COMMENT %
|
||
The two routines below are written such that they may run either on the
|
||
hummingboard or out of 286/386 pritected memory. The hummingboard cannot
|
||
directly address the host's physical memory, so when displaying escape
|
||
chars within a string, it is first buffered into space allocated in the
|
||
heap, then written via a block move to the print buffer. Although this is
|
||
somewhat clumsy, it significantly improves performance over writing
|
||
individual bytes to the print buffer with the BLOCK-MOVE dos function
|
||
provided by OSx86.
|
||
If in the future the hummingboard os traps instructions which are writing
|
||
to real memory, then the buffering may be discarded and simple memory
|
||
moves may be performed.
|
||
%
|
||
|
||
;******************************************************************************
|
||
;ATM2PBUF - Move symbol printname to printbuffer
|
||
;
|
||
; Description:
|
||
; The symbol name pointed to by ds:si is moved into a print buffer for output.
|
||
;
|
||
; If the display flag is set, the symbol is being output by the "write" lisp
|
||
; function and all backslashes and vertical bars (\,|) are written to the
|
||
; buffer preceeded by a backslash. In addition, the symbol must also be
|
||
; surrounded by vertical bars (|) if lowercase letters, commas, semi-colons,
|
||
; and other strange characters are encountered; or if the printname is a
|
||
; ".", a name starting with a # (other than special symbols), or is numeric.
|
||
;
|
||
; If the display flag is not set, then the printname is moved to the buffer
|
||
; without performing any translation.
|
||
;
|
||
; Upon Entry:
|
||
; cx = length of printname
|
||
; ds:si => printname
|
||
; es:di => print buffer
|
||
;
|
||
; Upon Exit:
|
||
; cx = # characters placed in print buffer
|
||
; es:di => print buffer
|
||
;
|
||
;******************************************************************************
|
||
p_struc struc
|
||
dest_top dw ?
|
||
dest_start dw ?
|
||
heap_top dw ?
|
||
heap_str dd ?
|
||
src_start dw ?
|
||
src_str dd ?
|
||
dest_str dd ?
|
||
stlen dw ?
|
||
call_bp dw ?
|
||
p_struc ends
|
||
|
||
public atm2pbuf
|
||
atm2pbuf proc near
|
||
BUFFER_IS_BUFFER ;real mode buffer treated as such
|
||
|
||
cmp ss:display,0 ;displaying escape chars?
|
||
jnz a2p_xlat ; yes, jump
|
||
;move printname to print buffer
|
||
MOVE_TO_REAL_BUF ;move entire string over
|
||
ret ;return to caller
|
||
a2p_err:
|
||
mov [bp].stlen,-1
|
||
jmp a2p_fin
|
||
|
||
;move printname to print buffer, checking for backslashes and delimiters '|'
|
||
a2p_xlat:
|
||
push bp ;save callers bp
|
||
push cx ;save length
|
||
push es
|
||
push di ;save real buffer address
|
||
push ds
|
||
push si ;save string address
|
||
sub sp,src_str ;allocate local storage
|
||
mov bp,sp
|
||
|
||
mov [bp].src_start,si ;save start location of source string
|
||
mov [bp].dest_start,di ;save print buffer start
|
||
GET_REAL_BUFFER_TOP dx
|
||
sub dx,pt_bfend+20
|
||
mov [bp].dest_top,dx ;save print buffer end
|
||
|
||
mov ax,ss
|
||
mov ds,ax
|
||
mov es,ax ;setup for c call
|
||
mov ax,512
|
||
push ax
|
||
c_call getmem ;allocate 512 bytes of storage
|
||
add sp,2 ;dump arg from stack
|
||
cmp ax,0 ;allocation successful?
|
||
jne a2p_write ; no, go write the buffer
|
||
mov [bp].stlen,-1 ;indicate error
|
||
jmp a2p_fin2 ; and exit
|
||
a2p_write:
|
||
mov [bp].heap_top,510 ;note top of heap buffer
|
||
mov word ptr [bp].heap_str,ax ;save heap buffer address
|
||
mov word ptr [bp].heap_str+2,es
|
||
mov di,ax ;es:di = buffer
|
||
mov byte ptr es:[di],'|' ;start buffer with escape char
|
||
inc di ;di = address within buffer
|
||
mov dx,1 ;dx = # chars written
|
||
lds si,[bp].src_str ;ds:si addresses the string
|
||
mov cx,[bp].stlen ;cx = char count
|
||
xor bx,bx ;bh = strangeness
|
||
cmp cx,0 ;char count zero?
|
||
jne b2p_init ; no, jump
|
||
or bh,080h ; yes, mark as strange
|
||
jmp b2p_post ; and skip loop
|
||
b2p_init:
|
||
;dx = #chars written, di=heap buffer offset, si=string offset, cx=char count
|
||
b2plp:
|
||
cmp dx,[bp].dest_top ;room left in buffer?
|
||
jg a2p_err ; no, return error status
|
||
|
||
lodsb ;fetch char from printname
|
||
cmp al,'\' ;is char escape char?
|
||
je escit ; yes, jump
|
||
cmp al,'|' ;is char delimiter?
|
||
jne storit ; no, just go store it
|
||
escit:
|
||
mov byte ptr es:[di],'\' ;write escape char to buffer
|
||
inc di ;bump print buffer ptr
|
||
inc dx ;bump # chars written
|
||
storit:
|
||
stosb ;write char to buffer
|
||
inc dx ;bump # chars written
|
||
|
||
test bh,80h ;do we already know that atom's strange?
|
||
jnz skptest ; yes, skip following tests
|
||
;if lowercase letters or comma, semi-colon, etc. encountered, then it contains
|
||
;"strange" characters and must be delimited by '|'
|
||
push si ;tempsave pname offset
|
||
mov bl,al ;save copy of char in bl
|
||
lea si,hicases ;si => table of upper cases
|
||
xchg bx,si
|
||
mov ah,al ;save char
|
||
xlat ss:hicases ;fetch upper-case equivalent
|
||
xchg bx,si
|
||
cmp ah,al ;are chars different?
|
||
jne mrkstrng ; yes, indicate strangeness
|
||
mov si,offset stranges ;si => strange-character string
|
||
strnglp: lods byte ptr ss:[si] ;fetch strange char
|
||
or al,al ;finished searching for strange chars?
|
||
jz notstrng ; yes, exit loop
|
||
cmp ah,al ;Do we have a strange char?
|
||
jne strnglp ; no, try next
|
||
mrkstrng: or bh,80h ; yes, mark strange bit
|
||
notstrng:
|
||
pop si ;restore pname offset
|
||
skptest:
|
||
cmp di,[bp].heap_top ;heap buffer full?
|
||
jl a2p_cont ; no, continue
|
||
push cx ;save loop count
|
||
mov word ptr [bp].src_str,si ;update string pointer
|
||
sub di,word ptr [bp].heap_str ;calc number chars written
|
||
mov cx,di ; and save in cx
|
||
lds si,[bp].heap_str ;ds:si = heap buffer
|
||
les di,[bp].dest_str ;es:di = real mode buffer
|
||
MOVE_TO_REAL_BUF autoinc ;move string to print buffer
|
||
add word ptr [bp].dest_str,di ;update next location in real buffer
|
||
pop cx ;restore count
|
||
lds si,[bp].src_str ;ds:si = pointer into string
|
||
les di,[bp].heap_str ;es:di = heap allocated string ptr
|
||
a2p_cont:
|
||
loop b2plp ;look at next char in printname
|
||
|
||
; bh= strangeness, dx= #chars printed, di= end of printname
|
||
; write delimeter to heap allocated string, then copy to print buffer
|
||
b2p_post:
|
||
mov al,'|' ;follow with escape char
|
||
stosb ;write to heap buffer
|
||
inc dx ;bump character count
|
||
|
||
sub di,word ptr [bp].heap_str ;calc number chars written
|
||
mov cx,di ; and save in cx
|
||
lds si,[bp].heap_str ;ds:si = heap buffer
|
||
les di,[bp].dest_str ;es:di = real mode buffer
|
||
MOVE_TO_REAL_BUF autoinc ;move string to print buffer
|
||
mov [bp].stlen,dx ;save actual # chars written
|
||
mov ds,word ptr [bp].src_str+2
|
||
mov si,[bp].src_start ;ds:si => start of source string
|
||
|
||
test bh,80h ;do we already know atom's strange?
|
||
jnz a2p_fin ; yes, jump
|
||
; Check for ., #macro, or numeric confusion
|
||
cmp dx,3 ;a single char? (remember delimiters)
|
||
jne a2p_sharp ; no, jump
|
||
mov al,byte ptr ds:[si] ;get first byte of symbol
|
||
cmp al,'.' ;do we have a period - "." ?
|
||
je a2p_fin ; yes, delimits necessary
|
||
a2p_sharp:
|
||
cmp al,'#' ;macro designator?
|
||
jne a2p_num ; no, jump
|
||
cmp dx,3 ;a single sharp? (remember delimiters)
|
||
je a2p_fin ; yes, delimits necessary
|
||
cmp [bp].spg,SPECSYM*2 ;special symbol
|
||
je a2p_nodelim ; yes, no delimeters required
|
||
jne a2p_fin ; no, delimits necessary
|
||
a2p_num:
|
||
mov ax,10 ;check for number
|
||
push ax ;base 10
|
||
push si ;ds:si => printname
|
||
call scannum ;check for number
|
||
add sp,4 ;dump args from stack
|
||
test ax,ax ;is it a number?
|
||
jnz a2p_fin ; yes, jump
|
||
a2p_nodelim:
|
||
;although symbol being witten via "write", there are no stranges chars,
|
||
;or anything, so it can be written without delimiters.
|
||
inc [bp].dest_start ;position past initial delimiter
|
||
sub [bp].stlen,2 ;exclude delimeters from length
|
||
a2p_fin:
|
||
mov ax,ss
|
||
mov ds,ax ;set up data segment
|
||
mov es,ax ; and extra segment
|
||
mov bx,512 ;length of heap buffer
|
||
pushm <bx,word ptr [bp].heap_str>
|
||
C_call rlsmem, ;release character buffer
|
||
add sp,4 ;dump args off stack
|
||
a2p_fin2:
|
||
mov es,word ptr [bp].dest_str+2
|
||
mov di,[bp].dest_start ;es:di => real buffer start
|
||
mov cx,[bp].stlen ;cx = number characters written
|
||
|
||
lds si,[bp].src_str ;restore ds:si
|
||
add sp,call_bp ;dump args off stack
|
||
pop bp ;restore base pointer
|
||
ret
|
||
|
||
atm2pbuf endp
|
||
|
||
;******************************************************************************
|
||
;STR2PBUF - Move string to printbuffer
|
||
;
|
||
; Description:
|
||
; The print buffer is in real mode, the string is moved into the print
|
||
; buffer (possibly surrounded by quotes '"' and containing escape
|
||
; characters.
|
||
;
|
||
; Upon Entry:
|
||
; cx = length of string
|
||
; ds:si => string
|
||
; es:di => print buffer
|
||
;
|
||
; Upon Exit:
|
||
; cx = number of bytes written to print buffer
|
||
; es:di => print buffer
|
||
;
|
||
;******************************************************************************
|
||
|
||
public str2pbuf
|
||
str2pbuf proc near
|
||
BUFFER_IS_BUFFER ;real mode buffer treated as such
|
||
|
||
cmp ss:display,0 ;display escape chars?
|
||
jne s2p_xlat ; yes, jump
|
||
;move string to print buffer
|
||
MOVE_TO_REAL_BUF ;move string to print buffer
|
||
ret ;and return to caller
|
||
|
||
;move string to print buffer, inserting double quotes and escape chars
|
||
s2p_xlat:
|
||
push bp ;save callers bp
|
||
push cx ;save length
|
||
push es
|
||
push di ;save real buffer address
|
||
push ds
|
||
push si ;save string address
|
||
sub sp,src_str ;allocate local storage
|
||
mov bp,sp
|
||
|
||
mov [bp].dest_start,di ;save buffer start
|
||
GET_REAL_BUFFER_TOP dx
|
||
sub dx,pt_bfend+20
|
||
mov [bp].dest_top,dx ;save buffer end
|
||
|
||
mov ax,ss
|
||
mov ds,ax
|
||
mov es,ax ;setup for c call
|
||
mov ax,512
|
||
push ax
|
||
c_call getmem ;allocate 512 bytes of storage
|
||
add sp,2 ;dump arg from stack
|
||
cmp ax,0 ;allocation successful?
|
||
jne s2p_write ; no, go write the buffer
|
||
mov cx,-1 ;indicate error
|
||
jmp s2p_fin2 ; and exit
|
||
s2p_write:
|
||
mov [bp].heap_top,510 ;note top of heap buffer
|
||
mov word ptr [bp].heap_str,ax ;save heap buffer address
|
||
mov word ptr [bp].heap_str+2,es
|
||
mov di,ax ;es:di = buffer
|
||
mov byte ptr es:[di],'"' ;start buffer with escape char
|
||
inc di ;di = address within buffer
|
||
mov dx,1 ;dx = number chars written
|
||
|
||
mov cx,[bp].stlen
|
||
jcxz s2p_done ;jump if null string
|
||
|
||
lds si,[bp].src_str ;ds:si addresses the string
|
||
;dx = #chars written, es:di=heap buffer offset, ds:si=string offset
|
||
s2p_loop:
|
||
cmp dx,[bp].dest_top ;room left in buffer?
|
||
jg s2p_err ; no, return error status
|
||
|
||
lodsb ;fetch char from string
|
||
cmp al,'\' ;Is char escape char?
|
||
je s2p_esc ; yes, jump
|
||
cmp al,'"' ;Is char double quote?
|
||
jne s2p_stor ; no, just go store it
|
||
s2p_esc:
|
||
mov ah,al
|
||
mov al,'\'
|
||
stosb ;store escape character
|
||
inc dx ;bump # chars written
|
||
xchg al,ah
|
||
s2p_stor:
|
||
stosb ;store escape character
|
||
inc dx ;bump # chars written
|
||
cmp di,[bp].heap_top ;heap buffer full?
|
||
jl s2p_cont ; no, continue
|
||
push cx ;save loop count
|
||
mov word ptr [bp].src_str,si ;update string pointer
|
||
sub di,word ptr [bp].heap_str ;calc number chars written
|
||
mov cx,di ; and save in cx
|
||
lds si,[bp].heap_str ;ds:si = heap buffer
|
||
les di,[bp].dest_str ;es:di = real mode buffer
|
||
MOVE_TO_REAL_BUF autoinc ;move string to print buffer
|
||
add word ptr [bp].dest_str,di ;update next location in real buffer
|
||
pop cx ;restore count
|
||
lds si,[bp].src_str ;ds:si = pointer into string
|
||
les di,[bp].heap_str ;es:di = heap allocated string ptr
|
||
s2p_cont:
|
||
loop s2p_loop ;look at next char in printname
|
||
s2p_done:
|
||
mov al,'"' ;follow with escape char
|
||
stosb
|
||
inc dx
|
||
|
||
sub di,word ptr [bp].heap_str ;calc number chars written
|
||
mov cx,di ; and save in cx
|
||
lds si,[bp].heap_str ;ds:si = heap buffer
|
||
les di,[bp].dest_str ;es:di = real mode buffer
|
||
MOVE_TO_REAL_BUF autoinc ;move string to print buffer
|
||
mov cx,dx ;cx = actual # chars written
|
||
jmp s2p_fin ;finished
|
||
s2p_err:
|
||
mov cx,-1 ;indicate error
|
||
s2p_fin:
|
||
push cx ;save length around call
|
||
mov bx,512 ;length of heap buffer
|
||
pushm <bx,word ptr [bp].heap_str>
|
||
C_call rlsmem,,restore_es ;release character buffer
|
||
add sp,4 ;dump args off stack
|
||
pop cx
|
||
s2p_fin2:
|
||
lds si,[bp].src_str ;restore ds:si
|
||
mov es,word ptr [bp].dest_str+2
|
||
mov di,[bp].dest_start ;es:di => real buffer start
|
||
add sp,call_bp ;dump args off stack
|
||
pop bp ;restore base pointer
|
||
ret ;return
|
||
str2pbuf endp
|
||
|
||
prog ends
|
||
end
|
||
|
||
|