512 lines
17 KiB
NASM
512 lines
17 KiB
NASM
|
;
|
|||
|
;***************************************
|
|||
|
;* TIPC Scheme Runtime Support *
|
|||
|
;* *
|
|||
|
;* (C) Copyright 1985 by Texas *
|
|||
|
;* Instruments Incorporated. *
|
|||
|
;* All rights reserved. *
|
|||
|
;* *
|
|||
|
;* Date Written: 5 June 1985 *
|
|||
|
;* Last Modification: 15 May 1986 *
|
|||
|
;***************************************
|
|||
|
page 60,132
|
|||
|
|
|||
|
MSDOS equ 021h ; MS-DOS service call interrupt
|
|||
|
FREEMEM equ 049h ; Free memory function identifier
|
|||
|
MODIFMEM equ 04Ah ; Modify allocated memory function id
|
|||
|
BIDTASK equ 04Bh ; Load and execute program function id
|
|||
|
PRSTRING equ 09h
|
|||
|
CREATE_FL equ 3Ch ; Create file function
|
|||
|
OPEN_FL equ 3Dh ; Open file function
|
|||
|
CLOSE_FL equ 3Eh ; Close file function
|
|||
|
READ_FL equ 3Fh ; Read file function
|
|||
|
WRITE_FL equ 40h ; Write file function
|
|||
|
DELETE_FL equ 41h ; Delete file function
|
|||
|
GET_DRIVE equ 19h ; Current disk function
|
|||
|
SET_DRIVE equ 0Eh ; Select disk function
|
|||
|
GET_DIR equ 47h ; Return text of current directory function
|
|||
|
SET_DIR equ 3Bh ; Change the current directory function
|
|||
|
TI_CRTINT equ 49h*4 ; CRT dsr interrupt - TI
|
|||
|
IBM_CRTINT equ 10h*4 ; CRT dsr interrupt - IBM
|
|||
|
|
|||
|
DGROUP group data
|
|||
|
data segment word public 'DATA'
|
|||
|
assume DS:DGROUP
|
|||
|
extrn _paras:word ; total number of paragraphs available
|
|||
|
extrn _psp:dword ; program segment prefix paragraph address
|
|||
|
; extrn first_pa:word ; seg addr of 1st page in Scheme heap
|
|||
|
extrn first_dos:word ; seg addr of memory allocated to Scheme heap
|
|||
|
extrn PC_MAKE:word ; type of machine
|
|||
|
drive db ? ; place holder for current drive number
|
|||
|
dir_path db ? ; Drive Letter (as part of the path name)
|
|||
|
db ":\" ; GET_DIR function doesn't prepend "root"
|
|||
|
path db 80 dup(?) ; dir path buffer, excluding drive
|
|||
|
sav_file db "pc__s.sav",00 ; ASCIZ save file pathname
|
|||
|
len_sav_name equ $-sav_file
|
|||
|
cmd_ db "COMSPEC="
|
|||
|
cmd_1 equ $
|
|||
|
ENVPTR dw 0 ; DOS EXEC parameter block
|
|||
|
CMDOFF dw 0 ; "
|
|||
|
CMDSEG dw 0 ; "
|
|||
|
FCB1OFF dw 5Ch ; "
|
|||
|
FCB1SEG dw 0 ; "
|
|||
|
FCB2OFF dw 6Ch ; "
|
|||
|
FCB2SEG dw 0 ; "
|
|||
|
data ends
|
|||
|
|
|||
|
XGROUP group PROGX
|
|||
|
PROGX segment byte public 'PROGX'
|
|||
|
assume CS:XGROUP
|
|||
|
public install
|
|||
|
public uninstall
|
|||
|
|
|||
|
;************************************************************************
|
|||
|
;* Bid another Task *
|
|||
|
;************************************************************************
|
|||
|
bid_args struc
|
|||
|
dw ? ; caller's BP
|
|||
|
dw ? ; caller's ES
|
|||
|
dd ? ; far return address to caller of bid_task
|
|||
|
dw ? ; near return address to caller of bid
|
|||
|
bid_file dw ? ; program's file name
|
|||
|
bid_parm dw ? ; parameters
|
|||
|
free_req dw ? ; requested # of free paragraphs
|
|||
|
bid_args ends
|
|||
|
|
|||
|
sav_SP dw 0 ; save area for current stack pointer
|
|||
|
sav_SS dw 0 ; save area for stack segment register
|
|||
|
|
|||
|
;
|
|||
|
; Paragraph Addresses
|
|||
|
;
|
|||
|
; _paras --> +--------------------+ <----
|
|||
|
; | /|\ | : Freed for bidded task,
|
|||
|
; | | | : Saved to disk save file
|
|||
|
; | | -- free_req | : start: _paras - free_req
|
|||
|
; | | | : length: free_req
|
|||
|
; | \|/ | : (free_req >= _paras - first_dos)
|
|||
|
; |~~~~~~~~~~~~~~~~~~~~| <----
|
|||
|
; | | :
|
|||
|
; | (heap) | : Allocated to stay resident
|
|||
|
; | | : # paras: _paras -
|
|||
|
; first_pa --> +--------------------+ : _psp -
|
|||
|
; | (unused area) | : free_req
|
|||
|
; first_dos --> +--------------------+ :
|
|||
|
; | | :
|
|||
|
; | (PCS) | :
|
|||
|
; | | :
|
|||
|
; | | :
|
|||
|
; _psp --> +--------------------+ <----
|
|||
|
; | |
|
|||
|
;
|
|||
|
|
|||
|
close proc near ; Closes the file whose handle is in BX
|
|||
|
mov AH,CLOSE_FL
|
|||
|
int MSDOS
|
|||
|
ret
|
|||
|
close endp
|
|||
|
|
|||
|
delete proc near ; Deletes the save file
|
|||
|
assume DS:DGROUP
|
|||
|
mov DX,offset dir_path
|
|||
|
mov AH,DELETE_FL
|
|||
|
int MSDOS
|
|||
|
ret
|
|||
|
delete endp
|
|||
|
|
|||
|
|
|||
|
bid_task proc far
|
|||
|
push ES
|
|||
|
push BP
|
|||
|
mov BP,SP ; establish local addressability
|
|||
|
|
|||
|
; Check if requested # of free paragraphs within bounds
|
|||
|
cmp [BP].free_req,0 ; default to free max?
|
|||
|
je free_all ; yes, branch
|
|||
|
mov AX,_paras ; compute requested base of free area
|
|||
|
sub AX,[BP].free_req ;
|
|||
|
jb free_all ; request greater than all memory? branch
|
|||
|
cmp AX,first_dos ; below base of free-able area?
|
|||
|
jnb req_ok ; no, ok -- jump
|
|||
|
free_all: mov AX,_paras ; compute max # of free-able paras
|
|||
|
sub AX,first_dos ;
|
|||
|
mov [BP].free_req,AX ; update # of paras to free
|
|||
|
req_ok:
|
|||
|
|
|||
|
; Save Scheme's user memory
|
|||
|
; First create save file
|
|||
|
; Save current drive and directory path
|
|||
|
mov AH,GET_DRIVE ; get current drive number (0=A,1=B,...,4=E)
|
|||
|
int MSDOS
|
|||
|
mov drive,AL ; and save it
|
|||
|
inc AL ; "correct" current drive number
|
|||
|
mov DL,AL ; put current drive into DL
|
|||
|
add AL,40h ; (make it a capital letter)
|
|||
|
mov dir_path,AL ; put the drive letter into dir_path
|
|||
|
mov SI,offset path ; point DS:SI to path buffer
|
|||
|
mov AH,GET_DIR ; get current path
|
|||
|
int MSDOS
|
|||
|
; Append save file's name to end of directory path
|
|||
|
find_end: mov BX,offset path ; point to beginning of path name
|
|||
|
mov CX,64 ; maximum length of path name
|
|||
|
findloop: cmp byte ptr [BX],0
|
|||
|
je name_end
|
|||
|
inc BX
|
|||
|
loop findloop
|
|||
|
|
|||
|
name_end: cmp byte ptr [BX-1],'\' ; was last character a backslash?
|
|||
|
je add_save ; if so then don't append another one (jump!)
|
|||
|
mov byte ptr [BX],'\' ; else append a backslash then the filename
|
|||
|
inc BX
|
|||
|
add_save: push SI ; Now add concat'nate filename (PC__S.SAV)
|
|||
|
mov AX,DS
|
|||
|
mov ES,AX
|
|||
|
mov DI,BX ; load destination address
|
|||
|
mov SI,offset sav_file
|
|||
|
mov CX,len_sav_name
|
|||
|
rep movsb ; appending the save file name + NULL
|
|||
|
pop SI
|
|||
|
|
|||
|
; Now open the save file...
|
|||
|
mov DX,offset dir_path ; point DS:DX to ASCIZ save file path
|
|||
|
mov CX,20h ; file attribute
|
|||
|
mov AH,CREATE_FL
|
|||
|
int MSDOS ; do it
|
|||
|
jnb crt_ok ; branch if create ok
|
|||
|
jmp exit ; quit now if unable to create save file
|
|||
|
crt_ok:
|
|||
|
|
|||
|
; Now dump memory to the file (file handle in AX)
|
|||
|
mov BX,AX ; put file handle into BX
|
|||
|
mov DI,[BP].free_req ; DI = number of paras to write
|
|||
|
mov AX,_paras ; compute base of area to free
|
|||
|
sub AX,[BP].free_req ;
|
|||
|
push DS ; save DS
|
|||
|
mov DS,AX ; init DS:DX to base of area to save
|
|||
|
xor DX,DX ;
|
|||
|
wrt_para: cmp DI,0FFFh ; can write all paras in one shot?
|
|||
|
jbe wrt_last ; yes, jump
|
|||
|
sub DI,0FFFh ; dec paras-to-write count
|
|||
|
mov CX,0FFF0h ; write FFF0 bytes
|
|||
|
mov AH,WRITE_FL
|
|||
|
int MSDOS ; do it
|
|||
|
jb wrt_err ; branch if error
|
|||
|
cmp AX,CX ; wrote all bytes?
|
|||
|
je wrt_ok1 ; yes, branch
|
|||
|
mov AX,20 ; indicate write count error
|
|||
|
jmp short wrt_err
|
|||
|
wrt_ok1: mov AX,DS ; inc buffer pointer
|
|||
|
add AX,0FFFh
|
|||
|
mov DS,AX
|
|||
|
jmp wrt_para ; write out next FFF paras
|
|||
|
wrt_last: mov CL,4 ; shift para count to byte count
|
|||
|
shl DI,CL
|
|||
|
mov CX,DI ; put byte count into CX
|
|||
|
mov AH,WRITE_FL
|
|||
|
int MSDOS ; do it
|
|||
|
jb wrt_err ; branch if error
|
|||
|
cmp AX,CX ; wrote all bytes?
|
|||
|
je wrt_ok2
|
|||
|
mov AX,20 ; indicate write count error
|
|||
|
wrt_err: pop DS ; restore DS
|
|||
|
push AX ; save error code
|
|||
|
call close ; close and delete save file
|
|||
|
call delete
|
|||
|
pop AX ; restore error code
|
|||
|
jmp exit ; and quit
|
|||
|
wrt_ok2: pop DS ; restore DS
|
|||
|
call close ; close up file for safe keeping
|
|||
|
jnb wrt_ok3 ; branch if all ok
|
|||
|
jmp exit ; quit if can't close file
|
|||
|
wrt_ok3:
|
|||
|
|
|||
|
; Free up Scheme's user memory
|
|||
|
mov ES,first_dos ; point ES to base of allocated area
|
|||
|
mov BX,_paras ; compute # paras to remain allocated
|
|||
|
sub BX,first_dos ;
|
|||
|
sub BX,[BP].free_req ;
|
|||
|
mov AH,MODIFMEM ; load modify memory function id
|
|||
|
int MSDOS ; change PCS memory allocation
|
|||
|
jnc mem_ok
|
|||
|
memerr: push AX ; save error code
|
|||
|
call delete ; delete save file
|
|||
|
pop AX ; restore error code
|
|||
|
jmp exit ; and quit
|
|||
|
mem_ok:
|
|||
|
|
|||
|
; Bid up specified program
|
|||
|
; Set up parameter block
|
|||
|
mov AX,[BP].bid_parm ; Set up dword pointer to command line
|
|||
|
mov CMDOFF,AX
|
|||
|
mov CMDSEG,DS
|
|||
|
|
|||
|
mov AX,word ptr _psp+2 ; Point to FCBs in program segment prefix
|
|||
|
mov FCB1SEG,AX
|
|||
|
mov FCB2SEG,AX
|
|||
|
|
|||
|
mov ES,AX
|
|||
|
mov AX,ES:[02Ch] ; copy current environment ptr to
|
|||
|
mov ENVPTR,AX ; parameter area
|
|||
|
|
|||
|
; Set ES:BX to address of parameter block
|
|||
|
mov AX,DS
|
|||
|
mov ES,AX
|
|||
|
mov BX,offset ENVPTR
|
|||
|
|
|||
|
; Set DS:DX to address of ASCIZ pathname (of file to be loaded)
|
|||
|
push DS ; save DS segment register
|
|||
|
mov DX,[BP].bid_file
|
|||
|
mov DI,DX
|
|||
|
cmp byte ptr [di],0 ; check if pt'ed to string is empty
|
|||
|
jne bid_it
|
|||
|
|
|||
|
; No filename-- bid up a new command interpreter;
|
|||
|
; have to search environment for COMSPEC= string
|
|||
|
mov ES,ENVPTR ; ES:DI points to 1st string in environment
|
|||
|
xor DI,DI
|
|||
|
|
|||
|
; Test for end of environment
|
|||
|
get_plop: cmp byte ptr ES:[DI],0 ; last entry in environment?
|
|||
|
je cmd_err ; if so, COMSPEC= not found
|
|||
|
mov SI,offset cmd_ ; load address of comparison string
|
|||
|
mov CX,cmd_1-cmd_ ; and length of same
|
|||
|
repe cmps cmd_,ES:[DI] ; does this entry begin "COMSPEC="?
|
|||
|
je found ; if so, found it! (jump)
|
|||
|
xor AX,AX ; clear AX for search
|
|||
|
mov CX,-1 ; set CX for maximum length
|
|||
|
repne scas byte ptr ES:[DI] ; find \0 which terminates string
|
|||
|
jmp get_plop ; loop
|
|||
|
|
|||
|
; No command interpreter found
|
|||
|
cmd_err: mov AX,10 ; treat as bad-environment error
|
|||
|
jmp short bid_err
|
|||
|
|
|||
|
; Found COMSPEC=
|
|||
|
found: mov DX,DI ; DS:DX is ptr to command interpreter
|
|||
|
push DS ; (swap DS and ES)
|
|||
|
push ES
|
|||
|
pop DS
|
|||
|
pop ES
|
|||
|
|
|||
|
; issue load task function call
|
|||
|
bid_it: push BP ; Old IBM-PCs & XTs destroy BP on func 4B.
|
|||
|
mov CS:sav_SP,SP ; save current stack pointer
|
|||
|
mov CS:sav_SS,SS ; save stack segment register
|
|||
|
xor AL,AL ; load and execute condition
|
|||
|
mov AH,BIDTASK ; load "load and execute" ftn id
|
|||
|
int MSDOS ; perform service call
|
|||
|
cli ; disable all interrupts
|
|||
|
mov SS,CS:sav_SS ; restore stack base pointer
|
|||
|
mov SP,CS:sav_SP ; restore stack pointer
|
|||
|
sti ; enable interrupts
|
|||
|
pop BP ; restore BP (Thanks IBM) :-(
|
|||
|
pop DS ; restore DS segment register
|
|||
|
jb bid_err ; branch if error in bidding task
|
|||
|
xor AX,AX ; indicate no error
|
|||
|
bid_err: push AX ; save error code
|
|||
|
|
|||
|
; ReAllocate Scheme's user memory
|
|||
|
mov ES,first_dos ; point ES to base of allocated area
|
|||
|
mov BX,_paras ; compute # of all available paras
|
|||
|
sub BX,first_dos ;
|
|||
|
mov AH,MODIFMEM ; load modify memory function id
|
|||
|
int MSDOS ; change PCS memory allocation
|
|||
|
jnc read_mem
|
|||
|
fatal: pop AX ; throw away bid error code
|
|||
|
call delete ; delete save file
|
|||
|
mov AX,0FFFFh ; indicate cannot continue, -1
|
|||
|
jmp exit
|
|||
|
|
|||
|
; Restore Scheme's user memory
|
|||
|
; First open save file
|
|||
|
read_mem: mov DX,offset dir_path ; point DS:DX to ASCIZ save file path
|
|||
|
mov AL,00 ; access code for reading
|
|||
|
mov AH,OPEN_FL
|
|||
|
int MSDOS ; do it
|
|||
|
jb fatal ; abort if cannot open save file
|
|||
|
|
|||
|
; Now read memory from the file (file handle in AX)
|
|||
|
mov BX,AX ; put file handle into BX
|
|||
|
mov DI,[BP].free_req ; DI = number of paras to read
|
|||
|
mov AX,_paras ; compute base of area to restore from disk
|
|||
|
sub AX,[BP].free_req ;
|
|||
|
push DS ; save DS
|
|||
|
mov DS,AX ; init DS:DX to base of area to restore
|
|||
|
xor DX,DX
|
|||
|
rd_para: cmp DI,0FFFh ; can read all paras in one shot?
|
|||
|
jbe rd_last ; yes, jump
|
|||
|
sub DI,0FFFh ; dec paras-to-read count
|
|||
|
mov CX,0FFF0h ; read FFF0 bytes
|
|||
|
mov AH,READ_FL
|
|||
|
int MSDOS ; do it
|
|||
|
jb read_err ; branch if read error
|
|||
|
cmp AX,CX ; read all bytes?
|
|||
|
jne read_err ; no, branch
|
|||
|
read_ok1: mov AX,DS ; inc buffer pointer
|
|||
|
add AX,0FFFh
|
|||
|
mov DS,AX
|
|||
|
jmp rd_para ; read in next FFF paras
|
|||
|
rd_last: mov CL,4 ; shift para count to byte count
|
|||
|
shl DI,CL
|
|||
|
mov CX,DI ; put byte count into CX
|
|||
|
mov AH,READ_FL
|
|||
|
int MSDOS ; do it
|
|||
|
jb read_err ; branch if error reading file
|
|||
|
cmp AX,CX ; read all bytes?
|
|||
|
je read_ok2 ; yes, branch
|
|||
|
read_err: pop DS ; restore DS
|
|||
|
call close ; close save file
|
|||
|
jmp fatal ; and abort
|
|||
|
read_ok2: pop DS ; restore DS
|
|||
|
call close ; close save file
|
|||
|
call delete ; and delete it
|
|||
|
pop AX ; restore bid error code
|
|||
|
|
|||
|
exit: pop BP ; restore caller's BP
|
|||
|
pop ES ; restore ES segment register
|
|||
|
ret ; return to caller
|
|||
|
bid_task endp
|
|||
|
|
|||
|
;------------------------------------------------------------------------
|
|||
|
; The following routines will inhibit text display to the screen for
|
|||
|
; the duration of the dos-call.
|
|||
|
;
|
|||
|
; Note: Programs such as Lotus 1-2-3 which write directly to the
|
|||
|
; screen memory will still be visible.
|
|||
|
;
|
|||
|
;------------------------------------------------------------------------
|
|||
|
|
|||
|
exec_args struc
|
|||
|
dw ? ; caller's BP
|
|||
|
dd ? ; far return address to caller of install
|
|||
|
dw ? ; near return address to caller of exec
|
|||
|
file dw ? ; program's file name
|
|||
|
parm dw ? ; parameters
|
|||
|
fre_req dw ? ; requested # of free paragraphs
|
|||
|
display dw ? ; Indicates if screen should be disturbed
|
|||
|
exec_args ends
|
|||
|
|
|||
|
CRTSAV dd ?
|
|||
|
CRTINT dw ?
|
|||
|
DSSAV dw ?
|
|||
|
INSTALLED dw ?
|
|||
|
|
|||
|
install proc far
|
|||
|
; This routine installs a routine at the CRT DSR interrupt
|
|||
|
;
|
|||
|
push bp
|
|||
|
mov bp,sp
|
|||
|
push bx
|
|||
|
mov cs:INSTALLED,0 ; Assume routine won't be installed
|
|||
|
mov bx,[BP].display ; Indicates if commands will be sent
|
|||
|
cmp bx,0 ; Screen can be disturbed?
|
|||
|
pop bx
|
|||
|
jne non_null ; Install new interrupt routine
|
|||
|
jmp xinstall ; exit
|
|||
|
non_null:
|
|||
|
mov cs:INSTALLED,1
|
|||
|
push ds
|
|||
|
push es
|
|||
|
push ax
|
|||
|
push bx
|
|||
|
push dx
|
|||
|
push si
|
|||
|
push di
|
|||
|
mov ax,ds
|
|||
|
mov cs:DSSAV,ax
|
|||
|
;
|
|||
|
; Install new routine at the CRT DSR interrupt
|
|||
|
;
|
|||
|
mov ax,0 ; Save off routine adr of CRT DSR
|
|||
|
mov ds,ax
|
|||
|
mov si,offset xgroup:CRTSAV
|
|||
|
mov word ptr cs:[CRTINT],IBM_CRTINT ; Assume its IBM
|
|||
|
mov es,cs:DSSAV
|
|||
|
cmp word ptr es:PC_MAKE,1 ; Is it a TI?
|
|||
|
jne is_IBM
|
|||
|
mov word ptr cs:[CRTINT],TI_CRTINT
|
|||
|
is_IBM:
|
|||
|
mov di,cs:CRTINT
|
|||
|
mov ax,ds:[di]
|
|||
|
mov cs:[si],ax
|
|||
|
mov ax,ds:[di+2]
|
|||
|
mov cs:[si+2],ax
|
|||
|
cli ; Clear interrupts
|
|||
|
mov ax,offset xgroup:crtdsr
|
|||
|
mov ds:[di],ax
|
|||
|
mov ds:[di+2],cs
|
|||
|
sti ; Enable interrupts
|
|||
|
pop di
|
|||
|
pop si
|
|||
|
pop dx
|
|||
|
pop bx
|
|||
|
pop ax
|
|||
|
pop es
|
|||
|
pop ds
|
|||
|
xinstall:
|
|||
|
pop bp
|
|||
|
ret
|
|||
|
install endp
|
|||
|
; **************************************************************************
|
|||
|
; This routine restores the original routine for the CRT DSR interrupt
|
|||
|
;
|
|||
|
uninstall proc far
|
|||
|
cmp cs:INSTALLED,1 ; Was an int routine installed?
|
|||
|
je non_null2
|
|||
|
jmp xuninstall
|
|||
|
non_null2:
|
|||
|
push ds
|
|||
|
push ax
|
|||
|
push si
|
|||
|
push di
|
|||
|
mov ax,0
|
|||
|
mov ds,ax
|
|||
|
mov si,offset xgroup:CRTSAV ; Restore CRT DSR routine
|
|||
|
mov ax,cs:[si]
|
|||
|
mov di,cs:CRTINT
|
|||
|
mov ds:[di],ax
|
|||
|
mov ax,cs:[si+2]
|
|||
|
mov ds:[di+2],ax
|
|||
|
pop di
|
|||
|
pop si
|
|||
|
pop ax
|
|||
|
pop ds
|
|||
|
xuninstall:
|
|||
|
ret
|
|||
|
uninstall endp
|
|||
|
;
|
|||
|
; This is the do-nothing routine installed at the CRT DSR interrupt
|
|||
|
;
|
|||
|
crtproc proc far
|
|||
|
crtdsr:
|
|||
|
sti
|
|||
|
mov ax,0
|
|||
|
iret
|
|||
|
crtproc endp
|
|||
|
|
|||
|
|
|||
|
PROGX ends
|
|||
|
|
|||
|
PGROUP group prog
|
|||
|
prog segment byte public 'PROG'
|
|||
|
assume CS:PGROUP
|
|||
|
extrn unfixint:near
|
|||
|
extrn zcuron:near
|
|||
|
extrn zcuroff:near
|
|||
|
extrn fix_intr:near
|
|||
|
public bid
|
|||
|
bid proc near
|
|||
|
call unfixint ; reset shift-break vector
|
|||
|
call zcuron ; turn the cursor back on
|
|||
|
call install
|
|||
|
call bid_task
|
|||
|
push AX ; save error code
|
|||
|
call uninstall
|
|||
|
call zcuroff ; turn the cursor back off
|
|||
|
call fix_intr ; set shift-break vector
|
|||
|
pop AX ; restore error code
|
|||
|
ret
|
|||
|
bid endp
|
|||
|
prog ends
|
|||
|
end
|
|||
|
|