1210 lines
48 KiB
NASM
1210 lines
48 KiB
NASM
; =====> 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
|
||
|