229 lines
9.2 KiB
NASM
229 lines
9.2 KiB
NASM
|
; =====> 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
|
|||
|
|
|
|||
|
|
|