548 lines
22 KiB
NASM
548 lines
22 KiB
NASM
; =====> PROWIN.ASM
|
||
;***************************************
|
||
;* TIPC Scheme Runtime Support *
|
||
;* Window I/O support *
|
||
;* *
|
||
;* (C) Copyright 1985 by Texas *
|
||
;* Instruments Incorporated. *
|
||
;* All rights reserved. *
|
||
;* *
|
||
;* Date Written: 24 March 1986 *
|
||
;* Last Modification: 24 March 1986 *
|
||
;* 7 Jan 1987 - dbs *
|
||
;* added random I/O *
|
||
;***************************************
|
||
page 60,132
|
||
include scheme.equ
|
||
include sinterp.arg
|
||
include screen.equ
|
||
|
||
BUFFSIZE equ 256 ; input/output buffer
|
||
WINDSIZE equ 32-BLK_OVHD
|
||
PORTATTR equ 62
|
||
LABEL equ 32+BUFFSIZE ; window label field
|
||
P_FLAGS equ 6
|
||
W_FLAGS equ 26
|
||
WINDOW equ 4
|
||
B_ATTR equ 22
|
||
T_ATTR equ 24
|
||
CUR_LINE equ 10
|
||
CUR_COL equ 12
|
||
UL_LINE equ 14
|
||
UL_COL equ 16
|
||
N_LINES equ 18
|
||
N_COLS equ 20
|
||
NUM_FLDS equ 12
|
||
CHUNK equ 14
|
||
STR_PTR equ 3
|
||
OPEN equ 8
|
||
|
||
DGROUP group data
|
||
data segment word public 'DATA'
|
||
assume DS:DGROUP
|
||
extrn port_pg:word,port_ds:word
|
||
public MAX_ROWS,MAX_COLS
|
||
|
||
bad_port db "[VM INTERNAL ERROR] Bad port for window output",CR,LF,0
|
||
mk_win_st db "%MAKE_WINDOW",0
|
||
sv_win_st db "WINDOW-SAVE-CONTENTS",0
|
||
rt_win_st db "WINDOW-RESTORE-CONTENTS",0
|
||
gt_win_st db "%REIFY-PORT",0
|
||
cl_win_st db "WINDOW_CLEAR",0
|
||
|
||
defaults dw 0,0,0,0 ; default values of window object
|
||
max_rows db DEFAULT_NUM_ROWS,0
|
||
max_cols db DEFAULT_NUM_COLS,0
|
||
dw -1,15,1,0,0
|
||
|
||
wnlines dw 0 ; number of lines
|
||
wncols dw 0 ; number of columns
|
||
wulline dw 0 ; upper-left line number
|
||
wulcol dw 0 ; upper-left column number
|
||
branchtab dw setw_20 ; [0] : cursor line
|
||
dw setw_20 ; [1] : cursor column
|
||
dw setw_30 ; [2] : upper left corner line
|
||
dw setw_40 ; [3] : upper left corner column
|
||
dw setw_50 ; [4] : number of lines
|
||
dw setw_60 ; [5] : number of columns
|
||
dw setw_100 ; [6] : border attribute
|
||
dw setw_100 ; [7] : text attribute
|
||
dw setw_100 ; [8] : flags
|
||
dw setw_100 ; [9] : buffer position
|
||
dw setw_100 ; [10] : buffer end
|
||
dw setw_100 ; [11] : port flag
|
||
dw setw_70 ; [12] : # of chunks
|
||
data ends
|
||
|
||
PGROUP group prog
|
||
prog segment byte public 'PROG'
|
||
assume CS:PGROUP
|
||
extrn rest_scr:near
|
||
extrn save_scr:near
|
||
|
||
win_proc proc near
|
||
;;;************************************************************************
|
||
;;; Allocate a window object
|
||
;;;************************************************************************
|
||
extrn zero_blk:near
|
||
extrn next_SP:near
|
||
extrn src_err:near
|
||
extrn adj4bord:near
|
||
public make_win
|
||
make_win: lods byte ptr ES:[SI] ; load the operand register
|
||
save <SI>
|
||
add AX,offset reg0 ; compute register address
|
||
mov BX,AX
|
||
mov SI,[BX].C_disp ; get displacement
|
||
mov BX,[BX].C_page ; get page number
|
||
mov tmp_disp,SI ; save window label pointer
|
||
mov tmp_page,BX
|
||
cmp byte ptr ptype+[BX],STRTYPE*2 ; check string type
|
||
jne make_err
|
||
jmp short make_020
|
||
|
||
make_err: test BX,BX
|
||
jz make_020 ; null window label
|
||
lea BX,mk_win_st ; load address of text
|
||
jmp src_err ; display error message
|
||
|
||
make_020: mov BX,BUFFSIZE+WINDSIZE ; get object length
|
||
mov CX,PORTTYPE ; port type
|
||
pushm <BX,CX,AX>
|
||
C_call alloc_bl,,Load_ES ; allocate block for window object
|
||
pop BX
|
||
mov DI,[BX].C_disp ; get displacement
|
||
save <DI>
|
||
mov BX,[BX].C_page ; get page numbe of window object
|
||
LoadPage ES,BX ; get page address
|
||
shr BX,1
|
||
pushm <DI, BX>
|
||
call zero_blk ; zero window object
|
||
restore <DI>
|
||
mov word ptr ES:[DI+6],PORTATTR ; store port attribute
|
||
mov AX,DI
|
||
add DI,10 ; position to move default values
|
||
lea SI,defaults ; address of default values
|
||
mov CX,NUM_FLDS-1 ; length of defaults
|
||
rep movsw ; move defaults into object
|
||
mov DI,AX
|
||
mov AX,tmp_page
|
||
mov BX,tmp_disp
|
||
mov byte ptr ES:[DI+STR_PTR],AL ; store window label pointer
|
||
mov word ptr ES:[DI+STR_PTR+1],BX
|
||
jmp next_SP
|
||
;;;************************************************************************
|
||
;;; Get Window Attributes
|
||
;;; Get Window Attributes was translated from C. The following C comments
|
||
;;; show the mappings of the arguments to get-window-attributes to their
|
||
;;; actual locations within the port object.
|
||
;;;
|
||
;;;
|
||
;;;#define NUM_FIELDS 12
|
||
;;;static int defaults[NUM_FIELDS] = {0, /* cursor line number */
|
||
;;; 0, /* cursor column number */
|
||
;;; 0, /* upper left corner line number */
|
||
;;; 0, /* upper left corner column number */
|
||
;;; 25, /* number of lines */
|
||
;;; 80, /* number of columns */
|
||
;;; -1, /* no border */
|
||
;;; 15, /* text high intensity, enable */
|
||
;;; 1, /* wrap enabled */
|
||
;;; 0, /* current buffer position */
|
||
;;; 0, /* current buffer end */
|
||
;;;TRANSCRIPT+BINARY+WINDOW+OPEN+READ_WRITE}; /* port attributes */
|
||
;;;static int map_attr[NUM_FIELDS] = {10,12,14,16,18,20,22,24,26,28,30,6};
|
||
;;;
|
||
;;;************************************************************************
|
||
public get_wind
|
||
get_wind: lods word ptr ES:[SI] ; load register operand
|
||
save <SI> ; save the location pointer
|
||
xor BX,BX
|
||
mov BL,AH
|
||
add BX,offset reg0 ; compute address of register
|
||
xor AH,AH
|
||
add AX,offset reg0
|
||
save <AX> ; save registers
|
||
save <BX>
|
||
mov CX,1
|
||
pushm <CX, AX>
|
||
C_call get_port,,Load_ES ; get the port object
|
||
mov SP,BP
|
||
mov SI,tmp_page
|
||
cmp byte ptr ptype+[SI],PORTTYPE*2
|
||
jne get_err
|
||
restore <BX>
|
||
cmp [BX].C_page,SPECFIX*2
|
||
jne get_err
|
||
mov BX,word ptr [BX].C_disp ; get the value
|
||
shl BX,1
|
||
sar BX,1
|
||
cmp BX,0
|
||
jl get_err
|
||
cmp BX,NUM_FLDS
|
||
jg get_err ; used to be jge - dbs
|
||
LoadPage ES,SI ; get page address
|
||
mov SI,tmp_disp
|
||
restore <AX>
|
||
mov DI,AX
|
||
mov word ptr [DI].C_page,SPECFIX*2
|
||
cmp BX,12
|
||
jne get_05
|
||
mov AX,word ptr ES:[SI+CHUNK]; get chunk number
|
||
jmp get_20
|
||
get_05: cmp BX,11
|
||
jne get_10
|
||
mov AX,word ptr ES:[SI+6]
|
||
jmp get_20
|
||
get_10: shl BX,1 ; get the word offset
|
||
mov AX,word ptr ES:[SI+10+BX]
|
||
get_20:
|
||
test word ptr ES:[SI+P_FLAGS],WINDOW ; Port a window?
|
||
jz get_25 ; No, jump
|
||
and AX,07FFFh ; Yes, return integer
|
||
mov word ptr [DI].C_disp,AX
|
||
jmp next_SP ; Return to interpreter
|
||
get_25:
|
||
xor BX,BX
|
||
push BX ; push long integer value
|
||
push AX
|
||
push DI ; register to store value
|
||
C_call long2int,,Load_ES ; convert to scheme integer
|
||
mov SP,BP
|
||
jmp next_SP
|
||
get_err: lea BX,gt_win_st
|
||
jmp src_err ; link to error handler
|
||
;;;************************************************************************
|
||
;;; Modify Transcript File Status
|
||
;;;************************************************************************
|
||
public trns_chg
|
||
trns_chg: lods byte ptr ES:[SI] ; load register operand
|
||
save <SI>
|
||
add AX,offset reg0 ; compute address of register
|
||
mov BX,AX
|
||
mov SI,[BX].C_disp
|
||
mov BX,[BX].C_page
|
||
cmp byte ptr ptype+[BX],PORTTYPE*2 ; check type
|
||
jne trns_10
|
||
LoadPage ES,BX ; get page address
|
||
mov AX,word ptr ES:[SI+P_FLAGS]
|
||
mov CX,AX
|
||
and AX,OPEN ; open?
|
||
jz trns_10
|
||
and CX,3 ; read and write?
|
||
jz trns_10
|
||
mov TRNS_pag,BX
|
||
mov TRNS_dis,SI
|
||
jmp next_SP
|
||
trns_10: xor AX,AX
|
||
mov TRNS_pag,AX
|
||
mov TRNS_dis,AX
|
||
jmp next_SP
|
||
;;;************************************************************************
|
||
;;; Save Window Contents
|
||
;;;************************************************************************
|
||
public save_win
|
||
save_win: lods byte ptr ES:[SI] ; load register operand
|
||
save <SI>
|
||
add AX,offset reg0 ; compute address of register
|
||
xor BX,BX
|
||
pushm <BX, AX>
|
||
save <AX>
|
||
C_call get_port,,Load_ES ; get port object
|
||
mov SP,BP
|
||
mov BX,tmp_page
|
||
cmp byte ptr ptype+[BX],PORTTYPE*2 ; check port type
|
||
je save_01
|
||
save_err: lea BX,sv_win_st
|
||
jmp src_err ; link to error handler
|
||
save_01: LoadPage ES,BX ; get page address
|
||
mov DI,tmp_disp
|
||
mov AX,word ptr ES:[DI+P_FLAGS]
|
||
and AX,WINDOW ; window object?
|
||
jz save_err
|
||
mov AX,word ptr ES:[DI+UL_LINE]
|
||
mov BX,word ptr ES:[DI+UL_COL]
|
||
mov CX,word ptr ES:[DI+N_LINES]
|
||
mov DX,word ptr ES:[DI+N_COLS]
|
||
mov wulline,AX
|
||
mov wulcol,BX
|
||
mov wnlines,CX
|
||
mov wncols,DX
|
||
mov AX,word ptr ES:[DI+B_ATTR] ; border attribute
|
||
cmp AX,-1 ; bordered?
|
||
je save_10 ; no, jump
|
||
lea AX,wulline
|
||
lea BX,wulcol
|
||
lea CX,wnlines
|
||
lea DX,wncols
|
||
pushm <DX, BX, CX, AX>
|
||
call adj4bord ; adjust window region
|
||
save_10: mov AX,wnlines
|
||
mov BX,wncols
|
||
; compute the length of string to save window contents
|
||
mul BL
|
||
shl AX,1 ; * 2
|
||
add AX,2 ; + 2
|
||
push AX
|
||
restore <AX>
|
||
mov CX,STRTYPE ; string type
|
||
pushm <CX, AX>
|
||
C_call alloc_bl,,Load_ES ; alloc_block
|
||
mov SP,BP
|
||
pushm <wncols,wnlines,wulcol,wulline>
|
||
restore <AX>
|
||
push AX
|
||
call save_scr ; save screen
|
||
jmp next_SP ; return to interpreter
|
||
;;;************************************************************************
|
||
;;; Restore Window Contents
|
||
;;;************************************************************************
|
||
public rest_win
|
||
rest_win: lods word ptr ES:[SI] ; load register operand
|
||
save <SI> ; save the location pointer
|
||
xor BX,BX
|
||
mov BL,AH
|
||
add BX,offset reg0 ; compute address of register
|
||
xor AH,AH
|
||
add AX,offset reg0
|
||
save <BX>
|
||
xor CX,CX
|
||
pushm <CX, AX>
|
||
C_call get_port,,Load_ES ; get the port object
|
||
mov SP,BP
|
||
restore <BX> ; BX = data to be restored
|
||
mov SI,[BX].C_page
|
||
cmp byte ptr ptype+[SI],STRTYPE*2 ; check type
|
||
jne rest_err
|
||
mov DI,tmp_page
|
||
cmp byte ptr ptype+[DI],PORTTYPE*2 ; check type
|
||
jne rest_err
|
||
LoadPage ES,DI ; get page address
|
||
mov DI,tmp_disp
|
||
mov AX,word ptr ES:[DI+P_FLAGS]
|
||
and AX,WINDOW ; window object?
|
||
jz rest_err
|
||
mov AX,word ptr ES:[DI+UL_LINE]
|
||
mov BX,word ptr ES:[DI+UL_COL]
|
||
mov CX,word ptr ES:[DI+N_LINES]
|
||
mov DX,word ptr ES:[DI+N_COLS]
|
||
mov wulline,AX
|
||
mov wulcol,BX
|
||
mov wnlines,CX
|
||
mov wncols,DX
|
||
mov AX,word ptr ES:[DI+B_ATTR] ; border attribute
|
||
cmp AX,-1
|
||
je rest_10
|
||
lea AX,wulline
|
||
lea BX,wulcol
|
||
lea CX,wnlines
|
||
lea DX,wncols
|
||
pushm <DX, BX, CX, AX>
|
||
call adj4bord ; adjust window region
|
||
rest_10: pushm <wncols, wnlines, wulcol, wulline>
|
||
restore <BX>
|
||
push BX
|
||
call rest_scr ; restore screen
|
||
jmp next_SP ; return to interpreter
|
||
rest_err: lea BX,rt_win_st
|
||
jmp src_err ; link to error handler
|
||
win_proc endp
|
||
;;;************************************************************************
|
||
;;; Set Window Attribute
|
||
;;;************************************************************************
|
||
setw_arg struc
|
||
dw ? ; caller's BP
|
||
dw ? ; caller's ES
|
||
dw ? ; caller's return address
|
||
setw_reg dw ?
|
||
setw_att dw ?
|
||
setw_val dw ?
|
||
setw_arg ends
|
||
public set_wind
|
||
set_wind proc near
|
||
push ES
|
||
push BP
|
||
mov BP,SP
|
||
mov AX,1
|
||
pushm <AX, [BP].setw_reg>
|
||
C_call get_port,,Load_ES ; get port address
|
||
mov SP,BP
|
||
mov BX,tmp_page
|
||
cmp byte ptr ptype+[BX],PORTTYPE*2 ; check type
|
||
jne setw_err
|
||
mov SI,[BP].setw_att
|
||
cmp word ptr [SI].C_page,SPECFIX*2 ; check attribute type
|
||
jne setw_err
|
||
mov AX,[SI].C_disp ; get attribute value
|
||
shl AX,1
|
||
sar AX,1
|
||
cmp AX,0 ; check attribute value
|
||
jl setw_err
|
||
cmp AX,NUM_FLDS
|
||
jge setw_err
|
||
mov SI,[BP].setw_val ; get the value pointer
|
||
cmp word ptr [SI].C_page,SPECFIX*2 ; check type
|
||
je setw_10
|
||
setw_err: lea BX,gt_win_st ; address of error message
|
||
pushm <[BP].setw_val, [BP].setw_att, [BP].setw_reg>
|
||
mov AX,3
|
||
pushm <AX, BX>
|
||
C_call set_src_,,Load_ES ; set_src_err
|
||
mov SP,BP
|
||
mov AX,-1 ; return error status
|
||
jmp setw_ret
|
||
setw_10: mov CX,[SI].C_disp ; get the value
|
||
shl CX,1
|
||
sar CX,1
|
||
LoadPage ES,BX ; get page address of port
|
||
mov SI,tmp_disp ; displacement of port object
|
||
mov BX,AX
|
||
shl BX,1 ; get the word offset
|
||
jmp branchtab+[BX]
|
||
; cursor line/cursor column
|
||
setw_20: cmp CX,0
|
||
jl setw_err ; negative value, error
|
||
jmp setw_100
|
||
; upper left hand corner line number
|
||
setw_30: xor AX,AX
|
||
xor DH,DH
|
||
mov DL,MAX_ROWS
|
||
dec DX ; MAX_ROWS - 1
|
||
call fit_in_r
|
||
mov AX,word ptr ES:[SI+N_LINES]
|
||
inc DX
|
||
sub DX,CX ; MAX_ROWS - value
|
||
cmp AX,DX
|
||
jle setw_35
|
||
mov word ptr ES:[SI+N_LINES],DX
|
||
setw_35: jmp setw_100
|
||
; upper left hand corner column number
|
||
setw_40: xor AX,AX
|
||
xor DH,DH
|
||
mov DL,MAX_COLS
|
||
dec DX ; MAX_COLUMNS - 1
|
||
call fit_in_r
|
||
mov AX,word ptr ES:[SI+N_COLS]
|
||
inc DX
|
||
sub DX,CX ; MAX_COLUMNS - value
|
||
cmp AX,DX
|
||
jle setw_35
|
||
mov word ptr ES:[SI+N_COLS],DX
|
||
jmp setw_35
|
||
; number of lines
|
||
setw_50: mov AX,word ptr ES:[SI+UL_LINE]
|
||
xor DH,DH
|
||
mov DL,MAX_ROWS
|
||
sub DX,AX ; MAX_ROWS - UL_LINE
|
||
mov AX,1
|
||
call fit_in_r
|
||
jmp setw_100
|
||
; number of columns
|
||
setw_60: mov AX,word ptr ES:[SI+P_FLAGS]
|
||
and AX,WINDOW ; window?
|
||
jz setw_100 ; no, jump
|
||
mov AX,word ptr ES:[SI+UL_COL]
|
||
xor DH,DH
|
||
mov DL,MAX_COLS
|
||
sub DX,AX ; MAX_COLUMNS - UL_COL
|
||
mov AX,1
|
||
call fit_in_r
|
||
jmp setw_100
|
||
; chunk#
|
||
setw_70: mov BX,CHUNK
|
||
jmp setw_120
|
||
; store the value
|
||
setw_100: sar BX,1
|
||
cmp BX,11
|
||
jne setw_110
|
||
mov BX,6
|
||
jmp setw_120
|
||
setw_110: shl BX,1 ; word offset
|
||
add BX,10
|
||
setw_120: mov word ptr ES:[SI+BX],CX ; store the value
|
||
xor AX,AX
|
||
setw_ret: pop BP
|
||
pop ES
|
||
ret
|
||
set_wind endp
|
||
;;;************************************************************************
|
||
;;; Force Value into Range
|
||
;;; Purpose: To test a value (in CX) to determine if it falls within a
|
||
;;; range of values, as specified by an lower (in AX) and
|
||
;;; upper (in DX) bounds. If the value is within the range,
|
||
;;; the value is returned (in CX) unchanged. If it is outside
|
||
;;; the range, the value of the endpoint nearest its value
|
||
;;; is returned (in CX).
|
||
;;;************************************************************************
|
||
fit_in_r proc near
|
||
pop DI ; get the return address
|
||
cmp CX,AX ; value < lower?
|
||
jge fit_10
|
||
mov CX,AX ; yes, return lower
|
||
fit_01: jmp DI ; return to caller
|
||
fit_10: cmp CX,DX ; value > upper?
|
||
jle fit_01 ; no, return
|
||
mov CX,DX ; yes, return upper
|
||
jmp DI ; return to caller
|
||
fit_in_r endp
|
||
;;;************************************************************************
|
||
;;; Write message to the who-line
|
||
;;;************************************************************************
|
||
who_arg struc
|
||
pg dw ?
|
||
dis dw ?
|
||
who_BP dw ? ; caller's BP
|
||
dw ? ; caller's ES
|
||
dw ? ; caller's return address
|
||
str dw ? ; pointer to message string
|
||
who_arg ends
|
||
extrn ssetadr:near
|
||
extrn printtxt:near
|
||
public who_writ
|
||
who_writ proc near
|
||
push ES
|
||
push BP
|
||
sub SP,offset who_BP ; allocate local storage
|
||
mov BP,SP
|
||
|
||
mov ax,port_pg ;save current port address
|
||
mov [BP].pg,ax
|
||
mov ax,port_ds
|
||
mov [BP].dis,ax
|
||
|
||
mov AX,WHO_DISP
|
||
mov BX,WHO_PAGE*2
|
||
pushm <AX, BX>
|
||
call ssetadr ;get new port address
|
||
mov SP,BP
|
||
xor BX,BX ;compute length of string
|
||
mov SI,[BP].str
|
||
who_010: cmp byte ptr [SI+BX],0 ;string end?
|
||
je who_020 ; yes, exit loop
|
||
inc BX
|
||
jmp who_010
|
||
; Write message to the who line
|
||
who_020: push BX ;bx = strlen(str)
|
||
push SI ;si = address of string
|
||
call printtxt
|
||
mov SP,BP
|
||
mov BX,[BP].pg ;restore original port
|
||
cmp byte ptr ptype+[BX],PORTTYPE*2 ;check port type
|
||
jne who_ret
|
||
LoadPage ES,BX ;get page address
|
||
mov SI,[BP].dis
|
||
cmp byte ptr ES:[SI],PORTTYPE ;check port type
|
||
jne who_ret
|
||
pushm <SI, BX>
|
||
call ssetadr ;set port address
|
||
mov SP,BP
|
||
who_ret: add SP,offset who_BP ;release local storage
|
||
pop BP
|
||
pop ES
|
||
ret
|
||
who_writ endp
|
||
|
||
prog ends
|
||
end
|
||
|
||
|