pcs/sbid.asm

512 lines
17 KiB
NASM
Raw Permalink Normal View History

2023-05-20 05:57:06 -04:00
;
;***************************************
;* 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