home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
CPM
/
ZCPR33
/
A-R
/
LONGSUB.Z80
< prev
next >
Wrap
Text File
|
2000-06-30
|
33KB
|
1,259 lines
; LONGSUB: SUBmit utility for ZCPR33 for long submit files.
; by Thomas E. Croley II, 30 June 1987
; * Requires modification of your ZCPR33 CCP !!!! (see below)
; * Corrects ZCPR33 error in submit processing for $$$.SUB files
; longer than can be accessed with a single directory
; entry.
; * Derived from SUB34.
;
; Submit file processing is (and has always been?) limited to short *.SUB file
; lengths (fewer than 128 lines for disk allocation blocks of 2k, 256 lines
; for disk allocation blocks of 4k, ...). This is because ZCPR33 finds the
; last record in the $$$.SUB file for processing and attempts to close the file
; one record shorter to remove that record (command) from further processing;
; to do this, ZCPR33 decrements the record count in the FCB for the file before
; the close. This works if there is only one directory entry in the directory
; for the $$$.SUB file but it does not work if there are more. Subsequently,
; for longer $$$.SUB files, ZCPR33 neither finds the end of file correctly, nor
; is it able to reduce the file length past the point allocated to an earlier
; directory entry. The proper way around this is to implement direct access
; ("random access" in old CP/M terminology) file manipulations to find the end
; of the file and to keep track of the last record processed. The SUB utility
; must be modified also to use this method so that the last record (first
; command) to be accessed by the CCP is pointed to in the file (the last record
; of the file is used for this purpose here). Also, file append (for nesting
; of SUB commands), must properly maintain this pointer.
;
; If you use this SUB command, you must modify your ZCPR33 CCP by adding the
; following code as instructed below. The PENALTY is that it will slow submit
; file processing (hardly noticeable on a RAM disk but may be significant on a
; floppy) since additional disk reads and writes are required to find and
; maintain the next-command pointer. These reads and writes are not to
; sequential records on the disk since the pointer is maintained in the last
; record of the file while commands are taken successively toward the
; beginning. The ADVANTAGE is that it will allow arbitrary length submit files
; for processing.
;
; If you do not use this SUB command and do not modify your ZCPR33 CCP as
; follows, then BEWARE that submit files with line lengths exceeding the above
; limits will not be possible and there is no error message nor error checking
; for this condition within the CCP.
;
; MODIFICATIONS TO ZCPR33.Z80 (may require reconfiguration in Z33HDR.LIB to
; make room for the additional code on your machine)
;
; Find the label "subfcr:" in ZCPR33.Z80 and add the code denoted by ";TEC" as
; follows:
;
; subfcr:
; defs 1 ; Current record number
; subfr: ;TEC
; defs 3 ;TEC Random record no. (16 bits) + ovrflw byte
;
; Find the label "readbuf:" in ZCPR33.Z80 and modify or add the code as denoted
; by ";TEC" as follows:
;
; readbuf:
;
; ld a,(zexrunfl) ; Get ZEX-running flag
; or a
; jp nz,userinput ; If ZEX running, go directly to user input
;
; if subon ; If submit facility is enabled, check for it
;
; ld a,(subflag) ; Test for submit file running
; or a
; jr z,shellinput ; If not, go on to possible shell input
;
; xor a ; Log into user 0
; call setuser
; call defltdma ; Initialize DMA pointer
; ld de,subfcb ; Point to submit file FCB
; call open ; Try to open file
; jr z,readbuf1 ; Branch if open failed
;
; ;TEC ld hl,subfrc ; Point to record count in submit FCB
; ;TEC ld a,(hl) ; Get the number of records in file
; ;TEC dec a ; Reduce to number of last record
; ;TEC ld (subfcr),a ; ..and put into current record field
; ld c,23h ;TEC "Compute file size" bdos call no.
; call bdossave ;TEC DE still => subfcb; get file size in subfr
; ld hl,(subfr) ;TEC Get file size
; dec hl ;TEC Decrement to get last record no.
; ld (subfr),hl ;TEC Replace in random record field
; ld c,21h ;TEC "Read random" bdos call no.
; call bdossave ;TEC DE still => subfcb; randm read last record
; ld hl,(tbuff) ;TEC Get current "last record" from last record
; dec hl ;TEC Point to next earlier record to read
; ld (tbuff),hl ;TEC Save pointer in actual last record
; inc c ;TEC ... and write back to file (c=22h)
; call bdossave ;TEC DE still => subfcb; randm write last recrd
; ld (subfr),hl ;TEC Now prepare to read new "last record"
; dec c ;TEC (c=21h)
; call bdossave ;TEC Random read record; DE still => subfcb
; ;TEC call read ; Attempt to read submit file
; ;TEC jr nz,readbuf1 ; Branch if read failed
;
; ;TEC dec (hl) ; Reduce file record cound
; ;TEC dec hl ; Point to S2 byte of FCB (yes, this is req'd!)
; ;TEC ld (hl),a ; Stuff a zero in there (A=0 from call to READ)
; ld (subfrc-1),a ;TEC Zero FCB S2 byte (A=0 from previous read)
; call close ; Close the submit file one record smaller
; jr z,readbuf1 ; Branch if close failed
;
; END of ZCPR33.Z80 changes...
;
;
; The following program is SUB34.Z80 with ALL modifications denoted by ";TEC".
;
; PROGRAM NAME: SUB
; AUTHOR: RICHARD CONN (From SuperSUB Ver 1.1 by Ron Fowler)
; VERSION: 3.4 (Royce Shofner)
; DATE: 8 June 1987
;
; PREVIOUS VERSION: 3.3 (4 MAY 1987) HOWARD GOLDSTEIN
; PREVIOUS VERSION: 3.2 (27 APRIL 1987) JAY SAGE
; PREVIOUS VERSIONS: 3.1 (19 JAN 1985) JOE WRIGHT
; PREVIOUS VERSIONS: 3.0 (18 MAY 84) RELEASE VERSION
; PREVIOUS VERSIONS: 2.3 (6 Jan 83) - Called SUB2.ASM
; PREVIOUS VERSIONS: 2.2 (7 DEC 82), 2.1 (14 NOV 82), 2.0 (11 OCT 82)
; PREVIOUS VERSIONS: 1.4 (10 OCT 81), 1.3 (7 OCT 81)
; PREVIOUS VERSIONS: 1.2 (5 OCT 81), 1.1 (3 OCT 81), 1.0 (1 OCT 81)
; NOTE: FOR USE WITH ZCPR3
;
vers equ 34 ; Modified for ZCPR33 compatibility
;
z3env defl 0f900h
;
; SUB is derived from Ron's SuperSUB program; it provides a different
; format for the command line, a command-search hierarchy like ZCPR3, a
; resetting of the DMA address, several additional functions, and there are
; several other additions/changes. Additionally, ZCPR3-specific enhancements,
; such as appending the rest of the multiple command line to the command file
; and allowing multiple commands on a single line, are permitted.
;
; SuperSUB, VERSION 1.1 (09/13/81) by Ron Fowler
; 2/18/81 (first written) WESTLAND, MICH.
;
;
; Version 3.2 Modified to write $$$.SUB file to user 0 instead of current
; user.
; Version 3.3 Deletes $$$.SUB file from user 0. ALLOWS
; use of "^^" to represent "^". Permits only 126 characters per line
; so that there will always be a trailling null. No longer CP/M
; compatible. Requires ZCPR3 with multiple command line at least 127
; characters long. Recognizes explicit directory spec for input file
; and does not search along path if so.
; Version 3.4 Modified to take advantage of ZCPR33'S external running
; submit flag. SUB34 will set the flag after writing the submit file. If
; ZCPR33 is resident, SUB will just return to system; else, it will do
; the traditional warm boot.
;
; This program is intended as a replacement for the
; SUBMIT program provided with CP/M. It provides sev-
; eral new facilities:
; 1) Nestable SUBMIT runs
; 2) Interactive entry of SUBMIT job (no need
; to use an editor for simple SUBMIT runs)
; 3) Command line entry of small SUBMIT jobs
; 4) Ability to enter blank lines in an edited
; SUBMIT file
; 5) User customization of number of parameters
; and drive to send $$$.SUB to
;
;
; DEFINE BOOLEANS
;
false equ 0
true equ not false
;
; -- User customizable options --
;
force$sub equ false ; True if submitted file must be of type .sub
time$const equ 0c000h ; Delay for ringing bell
npar equ 10 ; Number of allowable parameters
cpbase equ 0 ; Set to 4200h for heath cp/m
opt equ '/' ; Option delimiter char
pdelim equ '$' ; Parameter delimiter
;
; SYSLIB AND Z3LIB ROUTINES
;
ext z3init,pfind,getcl1,getmsg
ext logud
ext initfcb
ext pstr,print,qprint,cout,crlf,caps,phldc
ext codend
;
; Z33LIB ROUTINES
;
ext getsrun,subon
;
; CP/M DEFINITIONS
;
fgchar equ 1 ; Get char function
diriof equ 6 ; Direct console i/o
rdbuf equ 10 ; Read console buffer
login equ 14 ; Log in disk
openf equ 15 ; Open file function
closef equ 16 ; Close file function
deletf equ 19 ; Delete file function
readf equ 20 ; Read record function
writef equ 21 ; Write record function
makef equ 22 ; Make (create) file function
getdsk equ 25 ; Return current disk
setdma equ 26 ; Set dma address
ucode equ 32 ; Get/set user code
;
udflag equ cpbase+4
bdos equ cpbase+5
;
curind equ '$' ; Current user/disk indicator
fcb equ 5ch ; Default file control block
fcbex equ 12 ; Fcb offset to extent field
fcbrc equ 15 ; Fcb offset to record count
fcbnr equ 32 ; Fcb offset to next record
fn equ 1 ; Fcb offset to file name
ft equ 9 ; Fcb offset to file type
tbuf equ cpbase+80h ; Default buffer
tpa equ cpbase+100h ; Transient program area
;
putcnt equ tbuf ; Counter for output chars
;
; DEFINE SOME TEXT CHARACTERS
;
ctrlc equ 'C'-'@'
ctrlz equ 'Z'-'@'
bel equ 7 ; Ring bell
cr equ 13 ; Carriage return
lf equ 10 ; Line feed
tab equ 9
;
; Environment Definition
;
if z3env ne 0
;
; External ZCPR3 Environment Descriptor
;
jp start
db 'Z3ENV' ; This is a zcpr3 utility
db 1 ; External environment descriptor
z3eadr:
dw z3env
start:
ld hl,(z3eadr) ; Pt to zcpr3 environment
;
else
;
; Internal ZCPR3 Environment Descriptor
;
maclib z3base.lib
maclib sysenv.lib
z3eadr:
jp start
sysenv
start:
ld hl,z3eadr ; Pt to zcpr3 environment
endif
;
; Start of Program -- Initialize ZCPR3 Environment
;
call z3init ; Initialize the zcpr3 env and the vlib env
ld hl,0 ; Save stack in case
add hl,sp ; Only help requested
ld (spsave),hl ; (not otherwise used)
call qprint
db 'SUB Version ',vers/10+'0','.',(vers mod 10)+'0',0
call codend ; Set up external buffers
ld (clbuf),hl ; Set ptr
ld (hl),128 ; Allow 128 chars
ld de,100h ; Free space
add hl,de ; Pt to free area
ld (fremem),hl ; Set ptr to free memory area
ld sp,hl ; Set stack ptr
ld a,(fcb+1) ; Anything on cmd line?
cp ' '
jp z,help ; No, go print help
call initvar ; Initialize the variable area
call getpar ; Get command line parameters and extract option
call abort ; Perform abort if flag set
call setup ; Set up read of submit file
call rdfile ; Read the submit file
call wrset ; Set up write of "$$$.SUB"
call wrsub ; Write "$$$.SUB"
call getsrun ; Is a submit file already active ?
jr nz,subxit ; If so, just return to zcpr33
call getmsg ; else, set the submit running flag
ld de,2dh
add hl,de
ld (hl),0ffh
subxit:
call subon ; zcpr33 & submit enabled ?
jp nz,gozcpr ; Return to zcpr33 if posible
jp cpbase ; else, try a warm boot
;
; SETUP SETS UP THE FILE CONTROL BLOCK
; FOR READING IN THE .SUB TEXT FILE
;
setup:
ld hl,fcb+ft ; Look at first char of
ld a,(hl) ; File type. if it is
cp ' ' ; Blank, then go move
jp z,putsub ; "sub" INTO FT FIELD
if force$sub ; File type must be of .sub
ld de,subtyp ; File type must be .sub
ld b,3 ; 3 bytes
call compar
jp nz,notfnd ; File not found if no type match
endif
ret ; If not blank, then accept any file type
;
; MOVE "SUB" INTO THE FILE TYPE
;
putsub:
ex de,hl ; By convention, move from
ld hl,subtyp ; @hl to @de
ld b,3
call move
ret
;
; MOVE # BYTES IN B REGISTER FROM @HL TO @DE
;
move:
ld a,(hl) ; Pick up
ld (de),a ; Put down
inc hl ; I'm sure
inc de ; You've seen this
dec b ; Before...
jp nz,move ; 100 times at least
ret ; I know i have
;
; GETPAR MOVES THE SUBSTITUTION PARAMETERS SPECIFIED
; IN THE COMMAND LINE INTO MEMORY, AND STORES THEIR
; ADDRESSES IN THE PARAMETER TABLE. THIS ALLOWS
; SUBSTITUTION OF $1, $2, ETC., IN THE SUBMIT COMMANDS
; WITH THEIR ACTUAL VALUES SPECIFED IN THE COMMAND
; LINE.
;
getpar:
xor a ; A=0
ld (aflag),a ; Turn off abort command
ld hl,tbuf+1 ; Where we find the command tail
call scanto ; Skip submit file name
ld (option),a ; First char of cmd line is option
ret c ; Line ended?
cp opt ; No, check option
jp nz,glp0 ; Not keyboard inp, read file
inc hl ; Point past '/'
ld a,(hl) ; Get option char
cp 'A' ; Abort command
jp z,gparabt
cp 'I' ; Interactive mode
ret z ; Return if so
jp help ; Help otherwise
gparabt:
ld a,0ffh ; Turn on abort flag
ld (aflag),a
inc hl ; Get possible bell option
ld a,(hl)
cp 'B' ; Bell option
ret nz
ld a,0ffh ; Set bell flag
ld (bell$flag),a
ret
glp0:
ld a,(hl) ; Input is from a .sub file..this
inc hl ; Code skips over the name of
or a ; The sub file to get to the
ret z ; Command line parameters
cp ' '
jp z,glp
cp tab
jp nz,glp0
glp:
call scanto ; Pass up the blanks
ret c ; Cy returned if end of cmd line
call putpar ; Now put the parameter into mem
ret c ; Cy returned if end of cmd line
jp glp ; Get them all
;
; SCANTO SCANS PAST BLANKS TO THE FIRST NON-BLANK. IF
; END OF COMMAND LINE FOUND, RETURNS CARRY SET.
;
scanto:
ld a,(hl)
inc hl
or a ; Set flags on zero
scf ; In case zero found (end of cmd lin)
ret z
cp ' '
jp z,scanto ; Scan past blanks
cp tab ; Do tabs too, just for
jp z,scanto ; Good measure
dec hl ; Found char, point back to it
or a ; Insure carry clear
ret
;
; PUTPAR PUTS THE PARAMETER POINTED TO BY HL INTO
; MEMORY POINTED TO BY "TXTPTR". ALSO STORES THE
; ADDRESS OF THE PARAMETER INTO THE PARAMETER TABLE
; FOR EASY ACCESS LATER, WHEN WE WRITE $$$.SUB
;
putpar:
push hl ; Save pointer to parm
ld hl,(txtptr) ; Next free memory
ex de,hl ; Into de
ld hl,(tblptr) ; Next free area of table
ld a,(hl) ; Non-zero in table
or a ; Indicates table
jp nz,parovf ; Table overflow (too many parms)
ld (hl),e ; Store the parm adrs
inc hl
ld (hl),d
inc hl
ld (tblptr),hl ; Save table pntr for next time
pop hl ; Get back parm pointer
push de ; Save free mem pointer because
; We will have to have it back
; Later to store the length
inc de ; Point past length storage
ld b,0 ; Initialize length of parm
pplp:
ld a,(hl) ; Get next byte of parm
inc hl
or a ; Test for end of cmd line
jp z,pp2 ; Jump if end
cp ' ' ; Test for end of command
jp z,pp2
cp tab ; Tab also ends command
jp z,pp2
ld (de),a ; Put parameter byte-by-byte
inc de ; Into free memory
inc b ; Bump length
jp pplp
pp2:
ex de,hl
ld (txtptr),hl ; New free memory pointer
pop hl ; Remember our length pointer?
ld (hl),b ; Store the length
ex de,hl ; Have to retn hl > cmd line
or a ; Now return end of line flag
scf
ret z ; Return cy if zero (eol mark)
ccf
ret
;
;
; ABORT CHECKS TO SEE IF THE ABORT FLAG IS SET AND
; EXECUTES THE ABORT FUNCTION IF SO
;
;
abort:
ld a,(aflag) ; Get the flag
or a ; 0=no
ret z
call print
db cr,lf,' Strike ^C to Abort Command File - ',0
call charinb ; Get response
cp ctrlc ; Abort?
jp nz,abort1 ; Return to opsys
abort0:
ld e,0 ; Set user 0
ld c,20h
call bdos
ld de,subfcb ; Delete submit file
ld c,deletf
call bdos
call print
db ' ... Aborted',0
jp cpbase ; Return to cp/m
abort1:
call print
db ' ... Continuing',0
jp cpbase ; Return to cp/m
;
; INPUT CHAR FROM CON:; RING BELL EVERY SO OFTEN IF FLAG SET
;
charinb:
ld a,(bell$flag) ; Get flag
or a ; 0=no
jp z,charin
push hl ; Save hl
charinb$loop:
ld hl,time$const ; Get time constant
charinb$loop1:
ex (sp),hl ; Long delay
ex (sp),hl
dec hl ; Count down
ld a,h
or l
jp nz,charinb$loop1
ld e,0ffh ; Request status
ld c,diriof ; Direct i/o
call bdos
or a ; Any input?
jp nz,charinb$done
ld e,bel ; Ring bell
ld c,diriof
call bdos
jp charinb$loop
charinb$done:
pop hl ; Restore hl
jp caps ; Capitalize char
;
; INPUT CHAR FROM CON:; CAPITALIZE IT AND ECHO <CRLF>
;
charin:
ld c,fgchar ; Get char
call bdos
jp caps ; Capitalize
;
; RDFILE READS THE .SUB FILE SPECIFIED
; IN THE SUBMIT COMMAND INTO MEMORY
;
rdfile:
ld hl,0 ; Init line number
ld (linnum),hl
ld a,(option) ; Using a file?
cp opt ; Opt option tells
jp nz,rdfile1 ; Jump if not
call print
db cr,lf,' Input Command Lines',0
call clfill ; Get first line
jp line
rdfile1:
call print
db cr,lf,' Processing SUB File',0
; CHECK FOR .SUB FILE IN SPECIFIED DIRECTORY OR ALONG PATH
ld de,fcb ; Pt to FCB
ld a,(de) ; Get drive byte
or a ; If zero, no dir specified (Z33 feature)
jr z,rdfile2
dec a ; Gt drive in range 0..15
ld b,a ; Store drive in B
ld a,(fcb+13) ; Get user number
ld c,a ; ..into C
call logud ; Log in
call initfcb ; Initialize FCB
jr rdfile3 ; ..and attempt to open file
rdfile2:
call initfcb ; Init fcb
ld a,0ffh ; Search current also
call pfind ; Look for file
jp z,notfnd ; File not found
call logud ; Log into directory
ld de,fcb ; Pt to fcb
rdfile3:
ld c,openf ; Open file
call bdos
inc a ; Set zero flag if open failed
jp z,notfnd
call fill ; Read first block
jp nz,notext ; Empty file
line:
ld hl,(linnum) ; Bump line number
inc hl
ld (linnum),hl
ld hl,(prev) ; Get prev previous line pointer
ex de,hl
ld hl,(txtptr) ; Get current free mem pointer
ld (prev),hl ; Make it the prev line (for nxt pass)
ld (hl),e ; Store at begin of current line,
inc hl ; A pointer to the previous
ld (hl),d
inc hl
push hl ; Later we will put length here
inc hl ; Skip past length
ld c,1 ; Initialize length to one
llp:
call gnb ; Get next byte from input source
cp ctrlz ; End of file?
jp z,eof ; Cy set if end of file found
and 7fh ; Mask out msb
call caps ; Convert to upper case
cp lf ; Ignore linefeeds
jp z,llp
cp cr ; If it's a carriage return,
jp z,eol ; Then do end of line
ld (hl),a ; Store all others into memory
inc hl
call size ; Make sure no memory overflow
inc c ; Bump char count
jp m,lenerr ; Max of 126 chars per line
jp llp ; Go do next char
;
; DO END OF LINE SEQUENCE
;
eol:
ld (txtptr),hl ; Save free memory pointer
pop hl ; Current line's length pointer
dec c ; Adjust length
ld (hl),c ; Store length away
jp line ; Go do next line
;
; END OF TEXT FILE
;
eof:
ld (txtptr),hl ; Save free memory pointer
dec c ; Adjust line length
push bc ; Save line length
call zmcl ; Load rest of command line
pop bc ; Restore line length
pop hl ; Current line's length pointer
ld (hl),c ; Store length away
ret ; All done reading sub file
;
; COPY COMMAND LINE INTO MEMORY BUFFER
;
zmcl:
ld hl,(linnum) ; Bump line number
inc hl
ld (linnum),hl
ld hl,(prev) ; Get prev previous line pointer
ex de,hl
ld hl,(txtptr) ; Get current free mem pointer
ld (prev),hl ; Make it the prev line (for nxt pass)
ld (hl),e ; Store at begin of current line,
inc hl ; A pointer to the previous
ld (hl),d
inc hl
push hl ; Later we will put length here
inc hl ; Skip past length
ld c,1 ; Initialize length to one
ex de,hl ; De pts to next place to store a byte
call getcl1 ; Get address of command line buffer
ld a,(hl) ; Get low
inc hl
ld h,(hl) ; Get high
ld l,a ; Hl pts to first byte of multiple command line
ld b,(hl) ; Get first char in line
ld (hl),0 ; Clear line
ld a,b ; Check to see if first char is a semicolon (cmd sep)
cp ';'
jp nz,zmcl0
inc hl ; Pt to 2nd char
ld a,(hl) ; First was a semicolon, so get second
zmcl0:
ex de,hl ; Hl pts to next buffer space, de pts to mc line
jp zmcl1a ; A=first char in mc line
;
; MAJOR LOOP TO STORE MULTIPLE COMMAND LINE
;
zmcl1:
ld a,(de) ; Get next byte from multiple command line
zmcl1a:
or a ; 0=eol
jp z,zmcl2
and 7fh ; Mask out msb
call caps ; Convert to upper case
ld (hl),a ; Store char into memory
inc hl ; Pt to next char
inc de
call size ; Make sure no memory ovfl
inc c ; Incr char count
jp m,lenerr ; Max of 128 chars in line
jp zmcl1
;
; DONE WITH INPUT OF MULTIPLE COMMAND LINE -- SAVE CHAR CNT AND SET PTR
;
zmcl2:
ld (txtptr),hl ; Save ptr
pop hl ; Pt to char count position
dec c ; Adjust char count
ld (hl),c ; Store char count
ret
;
; GET NEXT BYTE FROM INPUT FILE OR USER
;
gnb:
push hl ; Don't alter anybody
push de
push bc
ld a,(option) ; Input from .sub file?
cp opt ; Told by orig cmd line option
jp nz,gnbdisk ; Get next char from disk buffer if not from user
call gnbkbd ; Get a byte from kbd input
jp gnbxit ; Then leave
;
; GET NEXT BYTE FROM DISK FILE
;
gnbdisk:
ld a,(ibp) ; Get buffer pointer
cp 128 ; Need another block from disk?
jp c,gnbd1 ; Continue
call fill ; Get next block
jp z,gnbd1 ; Continue if not empty
ld a,1ah ; Fake eof
jp gnbxit
gnbd1:
ld e,a ; Put offset in de
ld d,0
inc a ; Point to next byte
ld (ibp),a ; Save for next
ld hl,tbuf ; Now offset into buffer
add hl,de
ld a,(hl) ; Get char
gnbxit:
pop bc ; Restore everybody
pop de
pop hl
or a ; Turn on carry
ret
;
; FILL INPUT BUFFER FROM DISK
;
fill:
xor a ; Clear input buffer ptr
ld (ibp),a
ld de,fcb ; Pt to fcb
ld c,readf ; Bdos read block function
call bdos
or a ; Return z if eof
ld a,0 ; Set ptr to first char
ret
;
; GET NEXT BYTE FROM USER (KEYBOARD INPUT)
;
gnbkbd:
ld hl,(clptr) ; Pt to next char
ld a,(hl) ; Get it
inc hl ; Pt to following
ld (clptr),hl ; Reset ptr
cp cr ; End of line?
ret nz
call clfill ; Get new line
jp z,gkend ; Empty line input - return eof
ld a,cr ; Return cr to indicate end of line
ret
gkend:
ld a,1ah ; Return eof
ret
;
; FILL THE COMMAND LINE FROM THE USER
;
clfill:
call print
db cr,lf,' Command Line? ',0
ld hl,(clbuf) ; Now fill the buffer
ex de,hl ; De pts to it
ld c,rdbuf
call bdos
ld hl,(clbuf) ; Pt to command line buffer
inc hl
ld a,(hl) ; Get char count
inc hl
ld (clptr),hl ; Reset the command line ptr
or a ; Set zero flag
push af ; Save a
add a,l ; Pt to after last char
ld l,a
ld a,h
adc 0
ld h,a
ld (hl),cr ; Set eol char
pop af ; Get char count
ret
;
; MAKE SURE NO MEMORY OVERFLOW
;
size:
ld a,(bdos+2) ; Highest page pointer
sub 9 ; Make it be under ccp
cp h ; Check it against current page
ret nc ; Nc=all okay
jp memerr ; Otherwise abort
;
; SET UP THE $$$.SUB FILE
; FOR WRITING
;
wrset:
call print
db cr,lf,' Writing Command File to Disk',0
ld e,0 ; Set user 0
ld c,20h
call bdos
ld de,subfcb
ld c,openf
call bdos ; Open the file
inc a ; Check cpm return
jp z,none1 ; None exists already
;
; $$$.SUB EXISTS, SO SET
; FCB TO APPEND TO IT
;
ld de,subfcb ;TEC Point to submit file FCB
ld c,23h ;TEC "Compute file size" bdos call no.
call bdos ;TEC Get file size in subfr
ld hl,(subfr) ;TEC Get file size
dec hl ;TEC Decrement to get last record no.
ld (oldfsz),hl ;TEC Save present file last record no.
ld (subfr),hl ;TEC Replace in random record field
ld de,subfcb ;TEC Point to submit file FCB again
ld c,21h ;TEC "Read random" bdos call no.
call bdos ;TEC Random read last record
ld hl,(tbuf) ;TEC Get current "last record" pointer
dec hl ;TEC Decr. to point to last unprocessed record
ld (subfr),hl ;TEC Now read "last record"
ld de,subfcb ;TEC Point to submit file FCB again
ld c,21h ;TEC "Read random" bdos call no.
call bdos ;TEC Random read record
ld de,subfcb ;TEC Prepare for sequential (re)write to update
ld c,15h ;TEC ... DOS pointers for further writes
call bdos ;TEC Write same info back to set DOS pointers
;TEC ld a,(subfcb+fcbrc) ; Get record count
;TEC ld (subfcb+fcbnr),a ; Make next record
ret
oldfsz: ds 2 ;TEC space for "old file size"
;
; COME HERE WHEN NO $$$.SUB EXISTS
;
none1:
xor a ;TEC
ld (oldfsz),a ;TEC Zero "old file size" since it did'nt exist
ld (oldfsz+1),a ;TEC
ld de,subfcb
ld c,makef
call bdos
inc a
jp z,nomake ; 0ffh=can't create file
ret
;
; WRITE THE "$$$.SUB" FILE
;
wrsub:
ld hl,(prev) ; This code scans backward
ld a,h ; Thru the file stored in
or l ; Memory to the first non-
jp z,notext ; Null line. if none is
ld e,(hl) ; Found, aborts
inc hl
ld d,(hl) ; Here, we pick up pntr to prev line
inc hl ; Now we point to length
ex de,hl ; We need to store away
ld (prev),hl ; Pointer to prev line
ex de,hl
ld a,(hl) ; Now pick up the length
or a ; Set z flag on length
jp nz,wrntry ; Got line w/length: go do it
ld hl,(linnum) ; Nothing here, fix line number
dec hl ; (working backward now)
ld (linnum),hl
jp wrsub
wrlop:
ld hl,(prev) ; Get prev line pointer
ld a,h
or l ; If there is no prev line
jp z,close ; Then we are done
ld e,(hl) ; Else set up prev for next
inc hl ; Pass thru here
ld d,(hl)
inc hl
ex de,hl ; Now store it away
ld (prev),hl
ex de,hl
wrntry:
call putlin ; Write the line to the file
ld hl,(linnum) ; Bump the line number
dec hl ; Down (working back now)
ld (linnum),hl
jp wrlop
;
; $$$.SUB IS WRITTEN, CLOSE THE FILE
;
close:
ld de,subfcb ;TEC
ld c,24h ;TEC Set random record number for record after
call bdos ;TEC ... last write
ld hl,(subfr) ;TEC Get rndm record no. for last record write
ld (tbuf),hl ;TEC Place in write buffer
ld de,(oldfsz) ;TEC DE = old last record number
xor a ;TEC Clear carry bit
sbc hl,de ;TEC Is new last record number >= old?
jr nc,nfeok ;TEC New file end O.K.
ld (subfr),de ;TEC ... else use old last record number
nfeok: ld de,subfcb ;TEC
ld c,22h ;TEC "Write random" bdos call no.
call bdos ;TEC Write current record no. to last record.
ld de,subfcb
ld c,closef
jp bdos
;
; THIS SUBROUTINE WRITES A LINE
; TO THE $$$.SUB FILE BUFFER,
; AND FLUSHES THE BUFFER AFTER
; THE LINE IS WRITTEN.
;
putlin:
ld a,(hl) ; Pick up length byte
inc hl ; Point past it
or a
ret z ; Don't output 0 length line
ld (getcnt),a ; Make a count for "GET"
ld (getptr),hl ; Make a pointer for "GET"
ld hl,tbuf+1 ; Text goes after length
ld (putptr),hl ; Make pointer for "PUT"
ld a,1 ; Initialize put count
ld (putcnt),a
ld b,l ; Count for clear loop
clr:
ld (hl),0 ; Zero out buffer loc
inc hl
inc b ; Count
jp nz,clr
;
; THIS LOOP COLLECTS CHARACTERS
; FROM THE LINE STORED IN MEMORY
; AND WRITES THEM TO THE FILE.
; IF THE "$" PARAMETER SPECIFIER
; IS ENCOUNTERED, PARAMETER SUB-
; STITUTION IS DONE
;
putlp:
call getchr ; Pick up a character
jp c,flush ; Cy = no more char in line
cp '^' ; Control-char translate prefix?
jp nz,notcx
call getchr ; Yes, get the next
jp c,ccerr ; Error: early end of input
cp '^' ; If "^^" just put "^" in text
jp z,notcx
sub '@' ; Make it a control-char
jp c,ccerr ; Error: too small
cp ' '
jp nc,ccerr ; Error: too large
notcx:
cp pdelim ; Parameter specifier?
jp nz,stobyt ; If not, just write char
ld a,(option) ; Check option: '$' doesn't
cp opt ; Count in opt mode
ld a,pdelim ; (restore the '$')
jp z,stobyt
call lkahed ; Peek at next char
jp c,parerr ; Line ending means param err
cp pdelim ; Another "$"?
jp nz,subs ; If not then go do substitution
call getchr ; Get the 2nd "$" (we only looked
; Ahead before)
stobyt:
call putchr ; Write char to file
jp putlp
;
; PARAMETER SUBSTITUTION...LOOKS UP THE
; PARAMETER # AFTER THE "$" AND PLUGS IT
; IN IF IT EXISTS.
;
subs:
call numtst ; It better be a number
jp c,parerr ; Otherwise param error
ld b,0 ; Initialize parm #
jp lpntry ; We join loop in progress...
sublp:
call lkahed ; Look at next char
jp c,dosubs ; If line empty, then plug in parm
call numtst ; Check for numeric
jp c,dosubs ; Done if not
lpntry:
call getchr ; Now remove the char from input stream
sub '0' ; Remove ascii bias
ld c,a ; Save it
ld a,b ; Our accumulated count
add a,a ; Multiply by ten
add a,a
add a,b
add a,a
add a,c ; Then add in new digit
ld b,a ; Restore count
jp sublp
;
; PERFORM THE SUBSTITUTION
;
dosubs:
ld a,b ; Get parm #
dec a ; Make zero relative
jp m,parerr ; Oops
call lookup ; Look it up in parm table
jp c,parerr ; It's not there
ld b,a ; Length in b
sublp1:
inc b ; Test b for zero
dec b
jp z,putlp ; Done
ld a,(hl) ; Get char of real parameter
inc hl ; Point past for next time
push hl ; Save real parm pointer
call putchr ; Put it in the file
pop hl ; Get back real parm pointer
dec b ; Countdown
jp sublp1
;
; COME HERE WHEN A LINE IS FINISHED,
; AND WE NEED TO WRITE THE BUFFER TO DISK
;
flush:
ld hl,putcnt
dec (hl) ; Adjust length
ld de,subfcb
ld c,writef
call bdos
or a
jp nz,wrerr ; Cpm returned a write error
ret
;
; GETCHR GETS ONE CHAR FROM
; LINE STORED IN MEMORY
;
getchr:
ld hl,getcnt
ld a,(hl) ; Pick up count
dec a ; Remove this char
scf ; Preset error
ret m ; Return cy if out of chars
ld (hl),a ; Update count
ld hl,(getptr) ; Current char pointer
ld a,(hl) ; Pick up char
inc hl ; Bump pointer
ld (getptr),hl ; Put it back
ccf ; Turn carry off
ret
;
; PUTCHR PUTS ONE CHAR TO
; THE OUTPUT BUFFER
;
putchr:
ld hl,putcnt
inc (hl) ; Increment count
jp m,lenerr ; Line went to > 127 chars
ld hl,(putptr) ; Get buffer pointer
and 7fh ; Mask out msb
ld (hl),a ; Put char there
inc hl ; Bump pointer
ld (putptr),hl ; Put it back
ret ; All done
;
; LOOK AHEAD ONE CHAR IN
; THE INPUT STREAM. SET
; CARRY IF NONE LEFT.
;
lkahed:
ld a,(getcnt)
or a ; See if count is down to zero
scf ; Pre set indicator
ret z
ld a,(hl) ; Pick up char
ccf ; Turn off carry flag
ret
;
; LOOK UP PARAMETER WITH NUMBER IN
; A REG. RETURN A=LENGTH OF PARM,
; AND HL => PARAMETER
;
lookup:
cp npar
jp nc,parovf ; Parm # too high
ld l,a
ld h,0 ; Now have 16 bit number
add hl,hl ; Double for word offset
ld de,table
add hl,de ; Do the offset
ld e,(hl) ; Get address of parm
inc hl
ld d,(hl)
ld a,d ; Anything there?
or e
jp nz,lkupok
xor a ; No, zero length
ret
lkupok:
ex de,hl ; Now in de
ld a,(hl) ; Pick up length
inc hl ; Point past length
ret
;
; UTILITY COMPARE SUBROUTINE
;
compar:
ld a,(de)
cp (hl)
ret nz
inc hl
inc de
dec b
jp nz,compar
ret
;
; NUMERIC TEST UTILITY SUBROUTINE
;
numtst:
cp '0'
ret c
cp '9'+1
ccf
ret
;
; ERROR HANDLERS
;
wrerr:
call errxit
db 'Disk Full',0
nomake:
call errxit
db 'Dir Full',0
memerr:
call errxit
db 'Mem Full',0
notfnd:
call errxit
db 'SUB File Not Found',0
parerr:
call errxit
db 'Param',0
parovf:
call errxit
db 'Too Many Params',0
lenerr:
call errxit
db 'Line too Long',0
notext:
call errxit
db 'SUB File Empty',0
ccerr:
call errxit
db 'Ctrl Char',0
errxit:
call crlf ; New line
pop hl
call pstr ; Print message
call print
db ' Error on Line ',0
ld hl,(linnum) ; Tell line number
call phldc
call crlf
ld de,subfcb ; Delete the $$$.sub file
ld c,deletf
call bdos
jp cpbase
;
; INITIALIZE ALL VARIABLES
;
initvar:
ld hl,var
ld bc,endvar-var
initlp:
ld (hl),0 ; Zero entire var area
inc hl
dec bc
ld a,b
or c
jp nz,initlp
ld hl,table ; Init parm table pointer
ld (tblptr),hl
ld hl,0ffffh ; Mark end of table
ld (endtbl),hl
ld hl,(fremem) ; Free memory starts txt area
ld (txtptr),hl
ret
;
; PRINT HELP WITH PROGRAM OPTIONS
;
help:
call print
db cr,lf,'Syntax:'
db cr,lf,' SUB - Print this HELP Message'
db cr,lf,' SUB /A <text> - Abort of SUBMIT File'
db cr,lf,' SUB /AB <text> - Abort and Ring Bell'
db cr,lf,' SUB /I<CR> - Go into Interactive mode'
db cr,lf,' SUB <FILE> <PARMS> - Standard SUB File'
db 0
gozcpr:
ld hl,(spsave) ; Return to opsys
ld sp,hl
ret
;
; VARIABLE STORAGE
;
var equ $
;
aflag:
db 0 ; Abort flag (0=no)
txtptr:
dw 0 ; Free memory pointer
tblptr:
dw 0 ; Pointer to parm table
duser:
db 0 ; Default user number
linnum:
dw 0 ; Current line number
prev:
dw 0 ; Pointer to prev line
getcnt:
db 0 ; Counter for 'get'
getptr:
dw 0 ; Pointer for 'get'
putptr:
dw 0 ; Pointer for 'put'
ibp:
db 0 ; Input buffer pointer
clptr:
dw 0 ; Command line pointer
bell$flag:
db 0 ; Ring bell on abort flag
option:
db 0 ; Opt option flag store
table:
ds npar*3 ; Parameter table
endtbl:
dw 0ffffh ; End of parameter table
;
endvar equ $
spsave:
dw 0 ; Stack pointer save
;
;
; FCB FOR $$$.SUB
;
subfcb:
db 1 ; Drive specifier (a selected)
db '$$$ '
subtyp:
db 'SUB'
dw 0,0,0,0 ; Initialize rest of fcb
dw 0,0,0,0
;TEC dw 0,0,0,0
dw 0,0 ;TEC
db 0 ;TEC
subfr: dw 0 ;TEC
db 0 ;TEC
;
clbuf: ds 2 ; Ptr to command line buffer
fremem: ds 2 ; Ptr to free memory area
;
end