conservatory
/
pcs
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
pcs/proio.asm

1210 lines
48 KiB
NASM
Raw Permalink Normal View History

Unpack disk2.tgz
2023-05-20 05:57:05 -04:00
; =====> PROIO.ASM
;********************************************************
;* Scheme Runtime Support *
;* Low level I/O Support Routines *
;* *
;* (C) Copyright 1985 by Texas *
;* Instruments Incorporated. *
;* All rights reserved. *
;* *
;* Date Written: 09 November 1987 *
;* Last Modification: *
;********************************************************
page 60,132
.286c
include sinterp.arg
include memtype.equ
include scheme.equ
include pcmake.equ
include rpc.equ
include realio.equ
include xli_pro.mac
;
; local equates
;
EXT_ERR equ 059h ;get extended error
TI_CRT equ 049h ;ti video bios interrupt
IBM_CRT equ 010h ;ibm video bios interrupt
CURSMASK equ 10011111b ;zeros are the bits that disable cursor
NOCURSOR equ 00100000b ;byte mask to disable cursor
;------------------------------------------------------------------------------
;
; Data Definitions
;
;-------------------------------------------------------------------------------
DGROUP group data
data segment word public 'DATA'
assume DS:DGROUP
;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 ???
extrn port_pg:word,port_ds:word,port_r:dword
;from proio.asm
extrn char_hgt:word,cur_off:word
;from prowin.asm
extrn MAX_ROWS:byte,MAX_COLS:byte
public zapcurs
zapcurs dw 0 ; for disabling cursor altogether
curs_sav dw 400Ch ; Cache for cursor size
local_pds dw 0 ; Local copy of port disp
local_ppg dw 0 ; Local copy of port page
public pro_msb
pro_msb dw 0,0,0,0,0,0,0,0,0 ; Machine State Block for crt_dsr
sfp_err db "SET-FILE-POSITION!",0
;
; Graphics are implemented via the RPC mechanism, the following data
; structures support the %graphics primitives.
;
public vid_mode
vid_mode dw 3
graphic_go db 3,0,0,0,1,1,0,0,0 ; graphics functions which return vals
m_graph db "%GRAPHICS",0
data ends
;------------------------------------------------------------------------------
;
; Code Definitions
;
;-------------------------------------------------------------------------------
PGROUP group prog
prog segment byte public 'PROG'
assume CS:PGROUP
extrn next_sp:near, src_err:near
;************************************************************************
;* Generate a Bell Character *
;* *
;* Purpose: To generate a "bell character" (i.e., make a noise) to *
;* simulate the effect of outputting a bell character *
;* (control-G) in the output stream. *
;* *
;* Calling Sequence: zbell(); *
;* *
;* Input Parameters: None. *
;* *
;* Output Parameters: None. *
;* *
;************************************************************************
no_args struc
dw ? ; caller's BP
dw ? ; return address
no_arg dw ? ; designates no args on stack
no_args ends
public zbell
zbell proc near
push bp
mov bp,sp
REALIO REAL_BELL,no_arg,no_arg,continue
pop bp
ret
zbell endp
;************************************************************************
;* Clear a Window *
;************************************************************************
zc_args struc
dw ? ; caller's BP
dw ? ; return address
zc_row dw ? ; upper left hand corner row number
zc_col dw ? ; upper left hand corner column number
zc_nrows dw ? ; number of rows
zc_len dw ? ; line length (number of characters)
zc_attrib dw ? ; character attributes
zc_args ends
public zclear
zclear proc near
push BP ; save caller's BP
mov BP,SP
pusha
REALIO REAL_CLEAR,zc_row,zc_attrib,continue
popa
pop bp
ret
zclear endp
;************************************************************************
;* Draw Border *
;************************************************************************
zb_args struc
dw ? ; caller's BP
dw ? ; return address
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 zborder
zborder proc near
push bp
mov bp,sp
mov si,[bp].zb_label ;ds:si => label
cmp byte ptr [si],0 ;is it null?
jne zb_010 ; no, jump
mov [bp].zb_label,0 ; yes, note null
jmp zb_020 ; and skip
zb_010:
mov ax,REAL_BUF_PARA
mov [bp].zb_label,ax ;seg addr of real buffer
;determine length of label
xor ax,ax
xor cx,cx ;hold count
zb_loop:
inc cx
lodsb
cmp ah,al
jnz zb_loop
sub si,cx ;ds:si => label
;move label to real mode buffer @ address 0
les di,REAL_MODE_BUFFER ;es:si => real buffer
xor di,di
mov ax,BLOCK_XFER
int DOS
push ds
pop es
;now do the real mode I/O call
zb_020:
REALIO REAL_BORDER zb_line,zb_label,continue
pop bp
ret
zborder 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
dw ? ; return address
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 near
push es
push bp
mov bp,sp
push [bp].sv_str ;save register for later
mov ax,REAL_BUF_PARA
mov [bp].sv_str,ax ;seg addr of real mode buffer
REALIO REAL_SAVESCR,sv_str,sv_ncol
pop bx ;restore register ptr
mov di,[bx].C_disp
mov bx,[bx].C_page
loadPage es,bx
add di,BLK_OVHD ;es:di => string
mov ax,[bp].sv_ncol ;determine # chars to copy
mul [bp].sv_nrow
mov cx,2
mul cx
add ax,2 ;add for row/col info
mov cx,ax
mov ax,REAL_BUF_SELECTOR
mov ds,ax
xor si,si ;ds:si => real mode buffer
mov AX,BLOCK_XFER ;move real string into heap
int dos
mov bx,ss ;restore local data seg
mov ds,bx
pop bp ;restore regs
pop es
ret ;return
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
dw ? ; caller's BP
dw ? ; caller's ES
dw ? ; return address
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 near
push es
push bp
mov bp,sp
mov bx,[bp].rs_str ;register holding string ptr
mov si,[bx].C_disp
mov bx,[bx].C_page
loadpage ds,bx
mov cx,word ptr ds:[si]+1 ;cx = string length
add si,BLK_OVHD ;ds:si => string object
mov es,ss:REAL_BUF_SELECTOR
xor di,di ;es:di => real mode buffer
mov ax,BLOCK_XFER
int dos
mov ax,ss
mov ds,ax ;restore data seg
mov ax,REAL_BUF_PARA ;replace string reg with addr
mov [bp].rs_str,ax ;of real mode buffer
REALIO REAL_RESTSCR,rs_str,rs_mcol,continue
pop bp
pop es
ret
rest_scr endp
;************************************************************************
;* Cursor On *
;************************************************************************
public zcuron
zcuron proc near
cmp zapcurs,0 ; if cursor disabled
jne zcon_ret ; then return
mov cx,curs_sav ; attributes for cursor on
mov ah,01h ; load "set cursor type" code
call far ptr crt_dsr ; turn the cursor on
zcon_ret:
ret ; return to caller
zcuron endp
;************************************************************************
;* Cursor Off *
;************************************************************************
public zcuroff
zcuroff proc near
push bp
mov bp,sp
call ega_curs
mov ah,03
xor bh,bh ;IBM page number/must be 0 for graphics mode
call far ptr crt_dsr ;get the cursor position/mode
cmp zapcurs,0 ; if cursor disabled
jne zcoff_01 ; then jump
mov curs_sav,cx ;save it for restoration
zcoff_01:
and ch,CURSMASK ;mask off bits to select cursor type
or ch,NOCURSOR ;disables cursor (turns it off)
mov ah,01h ;load "set cursor type" code
call far ptr crt_dsr ;turn the cursor off
pop bp
ret ;return to caller
zcuroff endp
;************************************************************************
;* Put Cursor *
;************************************************************************
zpc_args struc
dw ? ; caller's BP
dw ? ; return address
zpc_row dw ? ; upper left hand corner row number
zpc_col dw ? ; upper left hand corner column number
zpc_args ends
public zputcur
zputcur proc near
push bp ; save caller's BP
mov bp,sp
; put cursor in desired location
mov dh,byte ptr [bp].zpc_col ;load column number
mov dl,byte ptr [bp].zpc_row ;load row number
xor bh,bh ;IBMism: page number (0 if in graphics mode)
mov ah,02H ;load "put cursor" code
call far ptr crt_dsr ;position the cursor (DSR swaps DH/DL)
call ega_curs ;display cursor for ega mode
; Return to caller
pop bp ; restore caller's BP
ret ; return
zputcur endp
;************************************************************************
;* Output Character To Window *
;************************************************************************
zp_args struc
dw ? ; caller's BP
dw ? ; return address
zp_line dw ? ; cursor position - line number
zp_col dw ? ; cursor position - column number
zp_char dw ? ; character to write
zp_attr dw ? ; character's attributes
zp_args ends
public zputc
zputc proc near
push BP ; save caller's BP
mov BP,SP
pusha
REALIO REAL_PUTC,zp_line,zp_attr,continue
popa
pop BP
ret
zputc endp
;************************************************************************
;* Scroll a Window *
;************************************************************************
zs_args struc
dw ? ; caller's BP
dw ? ; return address
zs_line dw ? ; upper left hand corner line number
zs_col dw ? ; upper left hand corner column number
zs_nline dw ? ; number of lines
zs_ncols dw ? ; number of columns
zs_attr dw ? ; text attributes (used for blanking)
zs_args ends
public zscroll
zscroll proc near
push BP ; save caller's BP
mov BP,SP
pusha
REALIO REAL_SCROLLUP,zs_line,zs_attr,continue
popa
pop BP
ret
zscroll endp
;************************************************************************
;* Scroll Window Down one line *
;************************************************************************
s_args struc
dw ? ; caller's BP
dw ? ; return address
s_line dw ? ; upper left hand corner line number
s_col dw ? ; upper left hand corner column number
s_nline dw ? ; number of lines
s_ncols dw ? ; number of columns
s_attr dw ? ; text attributes (used for blanking)
s_args ends
public scroll_d
scroll_d proc near
push BP ; save caller's BP
mov BP,SP
pusha
REALIO REAL_SCROLLDN,s_line,s_attr,continue
popa
pop BP
ret
scroll_d endp
;************************************************************************
;* Emulate cursor in EGA mode *
;* *
;* On Entry: ES:SI points to port object *
;************************************************************************
public ega_curs
ega_curs proc near
push bp
mov bp,sp
cmp vid_mode,14 ; are we in in EGA mode?
jl ega_03 ; no, return
test cur_off,7fh ; cursor already off? (bit one zero)
jz ega_02 ; yes, jump
and cur_off,0feh ; turn off bit one
jmp ega_03
ega_02: cmp es:[si].pt_text,0 ; black attribute?
je ega_03 ; forget it
; set up BIOS call for ega cursor
mov AX,09DBh ; reverse-video block
mov BX,8Fh ; attr = xor,white
mov CX,1 ; repetition count = 1
int 10h
ega_03:
pop bp
ret
ega_curs endp
;************************************************************************
;* Note Changes to Video Mode *
;************************************************************************
vm_chg struc
dw ? ; caller's BP
dw ? ; return address
vm_chgt dw ? ; new video mode
vm_mode dw ? ; new character height
vm_rows dw ? ; new # rows for screen
vm_chg ends
public chg_vmode
chg_vmode proc near
push bp
mov bp,sp
REALIO REAL_CHGVMODE,vm_chgt,vm_rows,continue
pop bp
ret
chg_vmode endp
;************************************************************************
;GVCHARS - display characters
;
; Upon Entry:
; cx = number of characters
; dx = wrap flag (0 = don't check for wrap, else check for wrap)
; es:di => print buffer
;
;************************************************************************
public gvchars
gvchars proc near
push cx ;character count
push REAL_BUF_PARA ;buffer segment
push di ;buffer offset
push dx ;wrap indicator
push REAL_WRTSTRNG ;op code
;
; Warning: DS does not reference data segment in code below
;
mov cx,pt_bfend ;cx = number bytes to write
mov si,port_ds
LoadPage ds,port_pg ;ds:si => port object
gv_again:
mov ss:local_pds,si ;save port address locally
mov ss:local_ppg,ds
mov di,ss:REAL_BUF_TOP ;get top address of buffer
sub di,cx ;es:di => buffer area
mov ax,BLOCK_XFER ;xfer port object to real memory
int DOS
mov ax,ss ;restore local data segment
mov ds,ax
; stack at this point contains opcode, wrap, buffer offset/seg and length
mov cx,10 ;move 10 bytes
sub di,cx ;es:di => real buffer
mov si,sp ;ds:si => args
mov ax,BLOCK_XFER ;xfer arg data to real memory
int DOS
; issue call to real mode I/O handler
mov al,rpc_handle ;real procedure handle
mov ah,RPC ;rpc function call
push di ;stack pointer
push XLI_REALIO ;real i/o function designator
mov dx,sp ;ds:dx => rpc buffer
mov cx,4 ;cx = # bytes in rpc buffer
mov bx,2 ;bx = number return bytes
int DOS ;issue RPC - I/O request
pop ax ;ax = result status
add sp,2 ;dump other arg from stack
or ax,ax ;test result status
jnz disk_err ;go report error
; update port object
mov cx,pt_bfend ;cx = number bytes to fetch
mov si,REAL_BUF_TOP
sub si,cx
mov bx,es
les di,dword ptr local_pds ;es:di => port object
mov ds,bx ;ds:si => updated port data
mov ax,BLOCK_XFER ;xfer block to scheme heap
int DOS
; everything is written, is there a transcript file?
cmp ss:TRNS_pag,0 ;transcript file associated?
je gvch_ret ; no, return
test es:[di].pt_pflgs,TRANSCRI ;this port have bit set?
jz gvch_ret ; no, return
mov bx,ds
mov cx,pt_bfend ;cx = number bytes to write
mov es,bx ;es => real buffer
mov si,ss:TRNS_dis
LoadPage ds,ss:TRNS_pag ;ds:si => port object
jmp gv_again ;stack still contains orig argments
;
; Warning: DS does not reference data segment in above code
;
gvch_ret:
mov bx,ss ;restore data segment
mov ds,bx
add sp,10 ;dump args off stack
xor ax,ax ;return status = 0
ret ;return to caller
public disk_err
; ax= dos error, or if negative - disk full
disk_err:
jns der_01
mov ax,DISK_FULL_ERROR
jmp der_02
der_01: add ax,(IO_ERRORS_START - 1);make into scheme error
der_02: mov bx,1 ;non-restartable
lea cx,port_r ;port object
pushm <cx,ax,bx> ;invoke scheme error handler
call dos_err ;control will not return
gvchars endp
MSDOS equ 021h
TI_CRT equ 049h
IBM_CRT equ 010h
TI_KEYBD equ 04Ah
IBM_KEYB equ 016h
;************************************************************************
;* Character at Keyboard ? *
;* *
;* Our equivalent to Lattic C's kbhit function *
;* *
;************************************************************************
public char_rdy
char_rdy proc near
mov ah,01h ; load "check keyboard status" function code
IFNDEF PROMEM ;;;; PROTECTED MODE will ignore
cmp pc_make,TIPC ; TI or IBM flavored PC?
jne zch_IBM
int TI_KEYBD ; issue TI keyboard DSR service call
jz zch_no ; is character buffered? if not, jump
ELSE
jmp zch_IBM
ENDIF
zch_yes: xor AH,AH ; clear high order byte of AX
cmp AL,0 ; test next character to be read
jne zch_ret ; binary zero? if not, jump
mov AX,256 ; if character is 0, make it non-zero
zch_ret: ret ; return (true)
zch_IBM: int IBM_KEYB ; issue IBM keyboard DSR service call
jnz zch_yes ; is character buffered? if so, jump
zch_no: xor AX,AX ; set result = false
ret ; return (false)
char_rdy endp
;************************************************************************
;* Buffered Keyboard Input *
;* *
;* Calling Sequence: ch = getch(); *
;* where ch - the character read from the keyboard *
;************************************************************************
public getch
getch proc near
push si
push di
mov AH,07h ; function code = Direct Console Input
int MSDOS ; do it
xor AH,AH ; clear the high order byte
pop di
pop si
ret ; return to caller
getch endp
;************************************************************************
;* Get Extended Error Information *
;* *
;* Use the Dos function to get extended error information when error *
;* reported on DOS I/O. *
;************************************************************************
;; public get_io_err
;;get_io_err proc near
;;
;; mov AH,EXT_ERR ; function code = get extended error
;; int MSDOS ; ax will contain error number
;; stc ; set carry flag
;; ret ; return to caller
;;get_io_err endp
;************************************************************************
;* Create a File *
;* *
;* Calling sequence: stat = zcreate(handle, pathname) *
;* where: int *handle - location to store handle *
;* returned by open request*
;* char *pathname - zero terminated string *
;* containing the file's *
;* pathname *
;* int stat - the completion code *
;* 0=no errors *
;* 3=path not found *
;* 4=too many open files *
;* 5=access denied *
;************************************************************************
zop_args struc
dw ? ; caller's BP
dw ? ; return address
zhandle dw ? ; address of handle
zpathnam dw ? ; address of string containing file pathname
zmode dw ? ; mode: 0=read, 1=write, 2=read/write
zhigh dw ? ; address of high word of file size
zlow dw ? ; address of low word of file size
zop_args ends
public zcreate
zcreate proc near
push BP ; save caller's BP
mov BP,SP
mov AH,03Ch ; load function request id
mov DX,[BP].zpathnam ; load pointer to pathname
mov CX,020h ; create with "archive" attribute
int MSDOS ; issue create request
jc zcr_ret ; if error, jump
mov BX,[BP].zhandle ; load address of handle
mov [BX],AX ; and store returned handle value
xor AX,AX ; set return code for normal return
zcr_ret: pop BP ; restore caller's BP
ret ; return
zcreate endp
;************************************************************************
;* Open a File *
;* *
;* Calling sequence: stat = zopen(handle, pathname, access_code) *
;* where: int *handle - location to store handle *
;* returned by open request*
;* char *pathname - zero terminated string *
;* containing the file's *
;* pathname *
;* int access_code - 0=read, 1=write, *
;* 2=read and write *
;* int stat - the completion code *
;* 0=no errors *
;* 2=file not found *
;* 4=too many open files *
;* 5=access denied *
;* 12=invalid access *
;************************************************************************
public zopen
zopen proc near
push BP ; save caller's BP
mov BP,SP
mov AH,03Dh ; load function request id
mov AL,byte ptr [BP].zmode ; load access code (mode)
mov DX,[BP].zpathnam ; load pointer to pathname
int MSDOS ; issue open request
jc zop_ret ; if error, jump
mov BX,[BP].zhandle ; load address of handle
mov [BX],AX ; and store returned handle value
;
push AX ; save file handle
mov BX,AX ; set bx to file handle
xor CX,CX
xor DX,DX
mov AX,4202h ; poisition file pointer at eof
int MSDOS
jc zop_ret
;
mov BX,[BP].zhigh ; load address of hsize
mov [BX],DX ; and store returned hsize value
mov BX,[BP].zlow ; load address of lsize
mov [BX],AX ; and store returned lsize value
;
pop BX ; retrieve file handle
xor CX,CX
xor DX,DX
mov AX,4200h ; reset file pointer to begining of file
int MSDOS
jc zop_ret
;
xor AX,AX ; set return code for normal return
zop_ret: pop BP ; restore caller's BP
ret ; return
zopen endp
;************************************************************************
;* Close a File *
;* *
;* Calling sequence: stat = zclose(handle) *
;* where: int handle - handle returned by open *
;* request *
;* int stat - the completion code *
;* 0=no errors *
;* 6=invalid handle *
;************************************************************************
public zclose
zclose proc near
push BP ; save caller's BP
mov BP,SP
mov AH,03Eh ; load function request id
mov BX,[BP].zhandle ; load handle of file to close
int MSDOS ; issue close request
jc zcl_ret ; if error, jump
xor AX,AX ; set return code for normal return
zcl_ret: pop BP ; restore caller's BP
ret ; return
zclose endp
;************************************************************************
;* Read From a File *
;* *
;* Calling sequence: stat = zread(handle, buffer, length) *
;* where: int handle - handle returned by open *
;* request *
;* char *buffer - address of character *
;* buffer into which data *
;* is to be read *
;* int *length - on input, the maximum *
;* number of characters *
;* which the buffer will *
;* hold. On output, the *
;* number of characters *
;* actually read. Note: *
;* a return value of zero *
;* characters read *
;* indicates end of file. *
;* int stat - the completion code *
;* 0=no errors *
;* 5=access denied *
;* 6=invalid handle *
;************************************************************************
zrw_args struc
dw ? ; caller's BP
dw ? ; return address
dw ? ; zhandle (use previous equate)
zbuffer dw ? ; input/output buffer
zlength dw ? ; address of length value
zrw_args ends
public zread
zread proc near
push BP ; save caller's BP
mov BP,SP
mov AH,03Fh ; load function request id
mov DX,[BP].zbuffer ; load address of input buffer
mov BX,[BP].zlength ; load address of length value
mov CX,[BX] ; then load length for read
mov BX,[BP].zhandle ; load file's handle
int MSDOS ; issue create request
jc zrd_ret ; if error, jump
mov BX,[BP].zlength ; load address of length parameter
mov [BX],AX ; and store number of characters read
xor AX,AX ; set return code for normal return
zrd_ret: pop BP ; restore caller's BP
ret ; return
zread endp
;************************************************************************
;* Write to a File *
;* *
;* Calling sequence: stat = zwrite(handle, buffer, length) *
;* where: int handle - handle returned by open *
;* char *buffer - address of character *
;* buffer from which data *
;* is to be written *
;* int *length - on input, the number of *
;* characters to write. *
;* The actual number of *
;* characters which were *
;* written is returned in *
;* "length" *
;* int stat - the completion code *
;* 0=no errors *
;* 5=access denied *
;* 6=invalid handle *
;************************************************************************
public zwrite
zwrite proc near
push BP ; save caller's BP
mov BP,SP
mov AH,040h ; load function request id
mov DX,[BP].zbuffer ; load address of input buffer
mov BX,[BP].zlength ; load address of length value
mov CX,[BX] ; then load length for write
mov BX,[BP].zhandle ; load file's handle
int MSDOS ; issue write request
jc zwr_ret ; if error, jump
mov BX,[BP].zlength ; load address of length parameter
mov [BX],AX ; and store number of characters written
xor AX,AX ; set return code for normal return
zwr_ret: pop BP ; restore caller's BP
ret ; return
zwrite endp
;************************************************************************
;* Read characters from a string *
;* *
;* Calling Sequence: stringrd(page, disp, buffer, &length) *
;* where page,disp: location of string-fed port *
;* buffer and length are as in ZREAD (see above) *
;* *
;* Note: The passing parameter `page' is page # *
;************************************************************************
strd struc
dw ? ;caller's BP
dw ? ;return address
strdpg dw ? ;Page, displacement of port
strdds dw ?
strdbuf dw ? ;Buffer address
strdlen dw ? ;Length address
strd ends
public stringrd
stringrd proc near
push bp
mov bp,sp
push ds ;save caller's ds
mov ax,es ;save caller's es (making ax nonzero as well)
mov bx,[bp].strdlen ;cx = number of chars to transfer
mov cx,[bx]
mov di,[bp].strdpg ;get port page
mov dx,di ; and save for later
LoadPage ds,di
mov di,[bp].strdds ;ds:di => port object
mov si,word ptr[di+car].pt_ptr ;point DS:SI to string
mov bl,[di+car_page].pt_ptr
xor bh,bh
LoadPage ds,bx
cmp byte ptr[si],STRTYPE ;is this a string?
jne nostr ; no, jump (error)
mov bx,[si].str_len ;fetch string length
cmp bX,0 ;check for small string
jge strn_01
add bx,BLK_OVHD+PTRSIZE
strn_01: LoadPage es,dx ;restore ptr to port
mov dx,es:[di].pt_ullin ;fetch position within string
sub bx,dx ;bx = #chars left
jns notpast ;if not negative, skip
xor bx,bx ; else #chars = 0
notpast: cmp bx,cx
jae max ;set CX to # of chars left or max
mov cx,bx ;called for, whichever is smaller
max: add si,dx ;adjust si into string
add dx,cx ;reset pointer into string
mov es:[di].pt_ullin,dx
mov es,ax ;restore for C
mov di,[bp].strdbuf ;point di to buffer
xor ax,ax ;prepare to return 0 (all's well)
jmp short storlen ;store # of chars
nostr: xor cx,cx ;when not a string, move no chars
storlen: mov bx,[bp].strdlen ;set length to # of chars read
mov es:[bx],cx
rep movsb ;transfer bytes
pop ds ;restore caller's ds
pop bp
ret
stringrd endp
;********************************************************************
;Set File Position *
; *
; set_pos will set the file position, determing which chunk *
; of the file to read and then setting the file position to *
; the appropriate place. A chunk is a multiple of 256 bytes. *
; *
;********************************************************************
set_arg struc
dw ? ;callers bp
dw ? ;callers es
dw ? ;return addres
set_prt dw ? ;port
set_amt dw ? ;chunk
set_buf dw ? ;position within chunk
set_arg ends
public set_pos
set_pos proc near
push es
push bp
mov bp,sp ;set up stack
mov ax,1
pushm <ax, [bp].set_prt>
C_call get_port,,Load_ES ;get port object
mov sp,bp ;dump args
test ax,ax ;check return status
jz set_010 ;jump if we have a port
setferr:
lea bx,sfp_err ;address of error message
pushm <[bp].set_buf, [bp].set_amt, [bp].set_prt>
mov ax,3
pushm <ax, bx>
C_call set_src_,,Load_ES ;set_src_err
mov sp,bp
mov ax,-1
jmp set_don
set_010:
mov bx,tmp_page
LoadPage es,bx ;get page address of port
mov si,tmp_disp
test es:[si].pt_pflgs,WINDOW ;window port?
jnz setferr
;we have a file
mov di,[bp].set_amt
mov dx,[di] ;dx = chunk number
inc dx
mov word ptr es:[si].pt_chunk,dx ;update chunk # in port
dec dx
mov cl,8 ;make chunk number into # bytes
xor bx,bx
mov bl,dh
xor dh,dh
shl dx,cl ;multiply dx by 256
mov cx,bx ;cx:dx = # bytes (32bit int)
test byte ptr es:[si].pt_pflgs,READWRITE+WRITE_ONLY ;test port flags
pushf ;save flags for later
jz set_015 ;if input port, jump
or byte ptr es:[si].pt_pflgs,DIRTY ;else set dirty bit
mov bx,[bp].set_buf ; get chunk offset
add dx,[bx] ; and add to file position
set_015: ;cx:dx = distance to move (bytes)
mov bx,es:[si].pt_handl ;bx = file handle
mov ah,42h ;move file pointer
mov al,0 ;position from file start
int MSDOS ;move it
popf ;restore flags
jnz set_020 ;jump if output port
mov cx,256 ;cx = length of buffer
mov bx,es:[si].pt_handl ;bx = file handle
mov dx,si
add dx,pt_buffr ;dx = start of buffer
push ds
push es
pop ds ;ds:dx => buffer
mov ah,3fh ;read from a file
int MSDOS
pop ds ;restore ds
jc set_don ;return on error
mov es:[si].pt_bfend,ax ;update number of bytes read
set_020:
mov bx,[bp].set_buf
mov ax,[bx]
mov es:[si].pt_bfpos,ax ;update buffer position
set_don:
pop bp
pop es
ret
set_pos endp
;********************************************************************
;SGRAPH *
; Interface to Graphic Primitives (%graphics arg1 ... arg7) *
; *
;********************************************************************
public sgraph
BUFFER_IS_STACK ; denote emulate stack with real buffer
sgraph: mov CX,7 ; load counter-- seven arguments
xor DX,DX ; set error flag = FALSE
lods byte ptr ES:[SI] ; load first argument
save <AX> ; and save as destination register
GET_REAL_BUFFER_STACK ; es:di => top of buffer
jmp short sgraph0
; loop thru args, moving to real mode buffer
sgraph1: lods byte ptr ES:[SI] ; load next argument
sgraph0: xor AH,AH ; be sure high byte is zero
mov BX,AX ; copy register number to BX
cmp byte ptr reg0_pag+[BX],SPECFIX*2 ; is arg a fixnum?
je sgraph2 ; if arg *is* a fixnum, o.k. (jump)
inc DX ; indicate an invalid argument
sgraph2: mov AX,reg0_dis+[BX] ; expand 15-bit signed int to 16-bit signed int
shl AX,1
sar AX,1
push ES
push SI
push CX ; save around following
MOVE_ARGS_TO_BUF <ax>,REAL_MODE_BUFFER,autodecr,save
pop CX ; restore count
pop SI
pop ES
loop sgraph1 ; continue 'til all arguments processed
; all args moved to buffer
cmp DX,0 ; any argument errors?
je sg_005
jmp sgraph3 ; if errors encountered, jump
sg_005:
save <SI> ; save the location pointer
mov BX,[BP].save_AX ; restore first argument register (op-code)
; use graphics op-code as index into graphics-go table to indicate whether
; return values are expected; on hboard parallel processing can exist.
mov BX,reg0_dis+[BX] ; get value
shl BX,1 ; expand to 16 bit signed integer
sar BX,1
mov bl,[graphic_go+bx] ; index into return value table
push bx ; save # return values for later
or bl,bl ; does it return a value?
jz sg_010 ; no, jump
mov bx,2 ; bx = # bytes to return
; build rpc buffer on the local stack and issue the rpc call
sg_010:
GET_REAL_BUFFER ; es:di => next loc in stack buffer
add di,2 ; make last loc top of stack
push di ; pass stack ptr
mov cx,4 ; cx = # bytes to pass
push XLI_GRAPH ; Type code - %graphics
mov dx,sp ; ds:dx => transaction buffer
mov al,rpc_handle
mov ah,RPC ;Issue RPC
int DOS
xor ax,ax ;default return result to zero
pop bx ;bx = return result
pop cx ;adjust stack
; if return value not expected exit back to interpreter loop, otherwise
; if set-video-mode op code get additional return values from transaction
; buffer
pop cx ;if no result expected
jcxz sg_030 ; then return
mov ax,bx ;ax = return result
or ax,ax ;If negative result
jl sg_030 ; then some kind of error
cmp cx,1 ;Additional values expected?
je sg_030 ; no, jump
; yes, must be set-video-mode
push ax ; save return result around call
add di,8 ; address buffer for 3 return
MOVE_ARGS_FROM_BUF <AX,CHAR_HGT,VID_MODE>
mov MAX_ROWS,AL
push AX
push vid_mode
push char_hgt
call chg_vmode ; tell real mode i/o code about changes
add sp,6 ; dump args off stack
;
;The following must be done so that OS/386 recognizes mode change has been made.
;
cmp pc_make,1 ;tipc?
je sg_028 ; yes, jump
mov ax,VID_MODE
xor ah,ah
int 10h
sg_028:
pop ax ; restore return result
; at this point, ax contains the return result
sg_030:
shl AX,1 ; clear high order bit of result
shr AX,1 ; (convert to immediate value)
mov BX,[BP].save_AX ; restore destination register number
mov reg0_dis+[BX],AX ; store returned result into destination reg
not_pc: jmp next_SP ; return to interpreter
sgraph3: mov BX,offset m_graph ; load addr of "%graphics" text
jmp src_err ; link to Scheme debugger
BUFFER_IS_BUFFER ;subsequent uses of buffer as buffer
;***************************************************************************
;* Link for routines in PROGX *
;***************************************************************************
extrn shft_brk:near
extrn dos_err:near
public shft%brk
public dos%err
shft%brk proc far
call shft_brk ;link to SHF BREAK process
ret
shft%brk endp
dos%err proc far
call dos_err ;link to DOS fatal error process
ret
dos%err endp
prog 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
IFDEF PROMEM ;;; PROTECTED MODE
mov pro_msb,ax ;Save Machine State Block
mov pro_msb+2,bx
mov pro_msb+4,cx
mov pro_msb+6,dx
lea dx,pro_msb ;;; Do real mode interrupt
xor bx,bx
cmp ah,3 ;;; Read Cursor position
je crt_d02
cmp ah,8 ;;; Read Char and Attribute
jne crt_d04
crt_d02: mov bx,8 ;;; Wait for return value
crt_d04:
mov ax,0E349h
int 21h
mov ax,pro_msb ;;; restore ax
mov bx,pro_msb+2 ;;; restore bx
mov cx,pro_msb+4 ;;; restore cx
ret
ELSE
int TI_CRT
ret
ENDIF
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
PROGX ends
end