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
/
ZSYS
/
SIMTEL20
/
ZCPR3
/
SUB.MAC
< prev
next >
Wrap
Text File
|
2000-06-30
|
23KB
|
1,043 lines
;
; PROGRAM NAME: SUB
; AUTHOR: RICHARD CONN (From SuperSUB Ver 1.1 by Ron Fowler)
; VERSION: 3.0
; DATE: 18 May 84
; 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 30
z3env SET 0f400h
;
; 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.
;
;
; 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
EXT LOGUD,GETUD,PUTUD
EXT INITFCB
EXT PSTR,PRINT,QPRINT,COUT,CRLF,CAPS,PHLDC
EXT CODEND
;
; 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
;
jmp start
db 'Z3ENV' ;This is a ZCPR3 Utility
db 1 ;External Environment Descriptor
z3eadr:
dw z3env
start:
lhld z3eadr ;pt to ZCPR3 environment
;
else
;
; Internal ZCPR3 Environment Descriptor
;
MACLIB Z3BASE.LIB
MACLIB SYSENV.LIB
z3eadr:
jmp start
SYSENV
start:
lxi h,z3eadr ;pt to ZCPR3 environment
endif
;
; Start of Program -- Initialize ZCPR3 Environment
;
call z3init ;initialize the ZCPR3 Env and the VLIB Env
LXI H,0 ;SAVE STACK IN CASE
DAD SP ; ONLY HELP REQUESTED
SHLD SPSAVE ;(NOT OTHERWISE USED)
CALL PUTUD ;SAVE HOME DIR
CALL QPRINT
DB 'SUB Version ',VERS/10+'0','.',(VERS MOD 10)+'0',0
CALL CODEND ;SET UP EXTERNAL BUFFERS
SHLD CLBUF ;SET PTR
MVI M,128 ;ALLOW 128 CHARS
LXI D,100H ;FREE SPACE
DAD D ;PT TO FREE AREA
SHLD FREMEM ;SET PTR TO FREE MEMORY AREA
SPHL ;SET STACK PTR
LDA FCB+1 ;ANYTHING ON CMD LINE?
CPI ' '
JZ 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"
JMP CPBASE ;GO START THE SUBMIT
;
; SETUP SETS UP THE FILE CONTROL BLOCK
; FOR READING IN THE .SUB TEXT FILE
;
SETUP:
LXI H,FCB+FT ;LOOK AT FIRST CHAR OF
MOV A,M ;FILE TYPE. IF IT IS
CPI ' ' ;BLANK, THEN GO MOVE
JZ PUTSUB ;"SUB" INTO FT FIELD
IF FORCE$SUB ;FILE TYPE MUST BE OF .SUB
LXI D,SUBTYP ;FILE TYPE MUST BE .SUB
MVI B,3 ;3 BYTES
CALL COMPAR
JNZ 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:
XCHG ;BY CONVENTION, MOVE FROM
LXI H,SUBTYP ; @HL TO @DE
MVI B,3
CALL MOVE
RET
;
; MOVE # BYTES IN B REGISTER FROM @HL TO @DE
;
MOVE:
MOV A,M ;PICK UP
STAX D ;PUT DOWN
INX H ;I'M SURE
INX D ; YOU'VE SEEN THIS
DCR B ; BEFORE...
JNZ 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:
XRA A ;A=0
STA AFLAG ;TURN OFF ABORT COMMAND
LXI H,TBUF+1 ;WHERE WE FIND THE COMMAND TAIL
CALL SCANTO ;SKIP SUBMIT FILE NAME
STA OPTION ;FIRST CHAR OF CMD LINE IS OPTION
RC ;LINE ENDED?
CPI OPT ;NO, CHECK OPTION
JNZ GLP0 ;NOT KEYBOARD INP, READ FILE
INX H ;POINT PAST '/'
MOV A,M ;GET OPTION CHAR
CPI 'A' ;ABORT COMMAND
JZ GPARABT
CPI 'I' ;INTERACTIVE MODE
RZ ;RETURN IF SO
JMP HELP ;HELP OTHERWISE
GPARABT:
MVI A,0FFH ;TURN ON ABORT FLAG
STA AFLAG
INX H ;GET POSSIBLE BELL OPTION
MOV A,M
CPI 'B' ;BELL OPTION
RNZ
MVI A,0FFH ; SET BELL FLAG
STA BELL$FLAG
RET
GLP0:
MOV A,M ;INPUT IS FROM A .SUB FILE..THIS
INX H ; CODE SKIPS OVER THE NAME OF
ORA A ; THE SUB FILE TO GET TO THE
RZ ; COMMAND LINE PARAMETERS
CPI ' '
JZ GLP
CPI TAB
JNZ GLP0
GLP:
CALL SCANTO ;PASS UP THE BLANKS
RC ;CY RETURNED IF END OF CMD LINE
CALL PUTPAR ;NOW PUT THE PARAMETER INTO MEM
RC ;CY RETURNED IF END OF CMD LINE
JMP GLP ;GET THEM ALL
;
; SCANTO SCANS PAST BLANKS TO THE FIRST NON-BLANK. IF
; END OF COMMAND LINE FOUND, RETURNS CARRY SET.
;
SCANTO:
MOV A,M
INX H
ORA A ;SET FLAGS ON ZERO
STC ;IN CASE ZERO FOUND (END OF CMD LIN)
RZ
CPI ' '
JZ SCANTO ;SCAN PAST BLANKS
CPI TAB ;DO TABS TOO, JUST FOR
JZ SCANTO ; GOOD MEASURE
DCX H ;FOUND CHAR, POINT BACK TO IT
ORA 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 H ;SAVE POINTER TO PARM
LHLD TXTPTR ;NEXT FREE MEMORY
XCHG ; INTO DE
LHLD TBLPTR ;NEXT FREE AREA OF TABLE
MOV A,M ;NON-ZERO IN TABLE
ORA A ; INDICATES TABLE
JNZ PAROVF ; TABLE OVERFLOW (TOO MANY PARMS)
MOV M,E ;STORE THE PARM ADRS
INX H
MOV M,D
INX H
SHLD TBLPTR ;SAVE TABLE PNTR FOR NEXT TIME
POP H ;GET BACK PARM POINTER
PUSH D ;SAVE FREE MEM POINTER BECAUSE
; WE WILL HAVE TO HAVE IT BACK
; LATER TO STORE THE LENGTH
INX D ;POINT PAST LENGTH STORAGE
MVI B,0 ;INITIALIZE LENGTH OF PARM
PPLP:
MOV A,M ;GET NEXT BYTE OF PARM
INX H
ORA A ;TEST FOR END OF CMD LINE
JZ PP2 ;JUMP IF END
CPI ' ' ;TEST FOR END OF COMMAND
JZ PP2
CPI TAB ;TAB ALSO ENDS COMMAND
JZ PP2
STAX D ;PUT PARAMETER BYTE-BY-BYTE
INX D ;INTO FREE MEMORY
INR B ;BUMP LENGTH
JMP PPLP
PP2:
XCHG
SHLD TXTPTR ;NEW FREE MEMORY POINTER
POP H ;REMEMBER OUR LENGTH POINTER?
MOV M,B ;STORE THE LENGTH
XCHG ;HAVE TO RETN HL > CMD LINE
ORA A ;NOW RETURN END OF LINE FLAG
STC
RZ ;RETURN CY IF ZERO (EOL MARK)
CMC
RET
;
;
; ABORT CHECKS TO SEE IF THE ABORT FLAG IS SET AND
; EXECUTES THE ABORT FUNCTION IF SO
;
;
ABORT:
LDA AFLAG ;GET THE FLAG
ORA A ;0=NO
RZ
CALL PRINT
DB CR,LF,' Strike ^C to Abort Command File - ',0
CALL CHARINB ;GET RESPONSE
CPI CTRLC ;ABORT?
JNZ ABORT1 ;RETURN TO OPSYS
ABORT0:
LXI D,SUBFCB ;DELETE SUBMIT FILE
MVI C,DELETF
CALL BDOS
CALL PRINT
DB ' ... Aborted',0
JMP CPBASE ;RETURN TO CP/M
ABORT1:
CALL PRINT
DB ' ... Continuing',0
JMP CPBASE ; RETURN TO CP/M
;
; INPUT CHAR FROM CON:; RING BELL EVERY SO OFTEN IF FLAG SET
;
CHARINB:
LDA BELL$FLAG ; GET FLAG
ORA A ; 0=NO
JZ CHARIN
PUSH H ; SAVE HL
CHARINB$LOOP:
LXI H,TIME$CONST ; GET TIME CONSTANT
CHARINB$LOOP1:
XTHL ; LONG DELAY
XTHL
DCX H ; COUNT DOWN
MOV A,H
ORA L
JNZ CHARINB$LOOP1
MVI E,0FFH ; REQUEST STATUS
MVI C,DIRIOF ; DIRECT I/O
CALL BDOS
ORA A ; ANY INPUT?
JNZ CHARINB$DONE
MVI E,BEL ; RING BELL
MVI C,DIRIOF
CALL BDOS
JMP CHARINB$LOOP
CHARINB$DONE:
POP H ; RESTORE HL
JMP CAPS ; CAPITALIZE CHAR
;
; INPUT CHAR FROM CON:; CAPITALIZE IT AND ECHO <CRLF>
;
CHARIN:
MVI C,FGCHAR ;GET CHAR
CALL BDOS
JMP CAPS ;CAPITALIZE
;
; RDFILE READS THE .SUB FILE SPECIFIED
; IN THE SUBMIT COMMAND INTO MEMORY
;
RDFILE:
LXI H,0 ;INIT LINE NUMBER
SHLD LINNUM
LDA OPTION ;USING A FILE?
CPI OPT ;OPT OPTION TELLS
JNZ RDFILE1 ;JUMP IF NOT
CALL PRINT
DB CR,LF,' Input Command Lines',0
CALL CLFILL ;GET FIRST LINE
JMP LINE
RDFILE1:
CALL PRINT
DB CR,LF,' Processing SUB File',0
; CHECK FOR .SUB FILE IN CURRENT USER/CURRENT DISK
LXI D,FCB ;WE ARE, OPEN IT
CALL INITFCB ;INIT FCB
MVI A,0FFH ;SEARCH CURRENT ALSO
CALL PFIND ;LOOK FOR FILE
JZ NOTFND ;FILE NOT FOUND
CALL LOGUD ;LOG INTO DIRECTORY
LXI D,FCB ;PT TO FCB
MVI C,OPENF ;OPEN FILE
CALL BDOS
CALL FILL ;READ FIRST BLOCK
JNZ NOTEXT ;EMPTY FILE
LINE:
LHLD LINNUM ;BUMP LINE NUMBER
INX H
SHLD LINNUM
LHLD PREV ;GET PREV PREVIOUS LINE POINTER
XCHG
LHLD TXTPTR ;GET CURRENT FREE MEM POINTER
SHLD PREV ;MAKE IT THE PREV LINE (FOR NXT PASS)
MOV M,E ;STORE AT BEGIN OF CURRENT LINE,
INX H ; A POINTER TO THE PREVIOUS
MOV M,D
INX H
PUSH H ;LATER WE WILL PUT LENGTH HERE
INX H ;SKIP PAST LENGTH
MVI C,0 ;INITIALIZE LENGTH TO ZERO
LLP:
CALL GNB ;GET NEXT BYTE FROM INPUT SOURCE
CPI CTRLZ ;END OF FILE?
JZ EOF ;CY SET IF END OF FILE FOUND
ANI 7FH ;MASK OUT MSB
CALL CAPS ;CONVERT TO UPPER CASE
CPI LF ;IGNORE LINEFEEDS
JZ LLP
CPI CR ;IF IT'S A CARRIAGE RETURN,
JZ EOL ; THEN DO END OF LINE
MOV M,A ;STORE ALL OTHERS INTO MEMORY
INX H
CALL SIZE ;MAKE SURE NO MEMORY OVERFLOW
INR C ;BUMP CHAR COUNT
JM LENERR ;MAX OF 128 CHARS PER LINE
JMP LLP ;GO DO NEXT CHAR
;
; DO END OF LINE SEQUENCE
;
EOL:
SHLD TXTPTR ;SAVE FREE MEMORY POINTER
POP H ;CURRENT LINE'S LENGTH POINTER
MOV M,C ;STORE LENGTH AWAY
JMP LINE ;GO DO NEXT LINE
;
; END OF TEXT FILE
;
EOF:
SHLD TXTPTR ;SAVE FREE MEMORY POINTER
PUSH B ;SAVE LINE LENGTH
CALL ZMCL ;LOAD REST OF COMMAND LINE
POP B ;RESTORE LINE LENGTH
POP H ;CURRENT LINE'S LENGTH POINTER
MOV M,C ;STORE LENGTH AWAY
RET ;ALL DONE READING SUB FILE
;
; COPY COMMAND LINE INTO MEMORY BUFFER
;
ZMCL:
CALL GETCL1 ;GET ADDRESS OF COMMAND LINE BUFFER
MOV A,H ;CHECK FOR ANY
ORA L
RZ
LHLD LINNUM ;BUMP LINE NUMBER
INX H
SHLD LINNUM
LHLD PREV ;GET PREV PREVIOUS LINE POINTER
XCHG
LHLD TXTPTR ;GET CURRENT FREE MEM POINTER
SHLD PREV ;MAKE IT THE PREV LINE (FOR NXT PASS)
MOV M,E ;STORE AT BEGIN OF CURRENT LINE,
INX H ; A POINTER TO THE PREVIOUS
MOV M,D
INX H
PUSH H ;LATER WE WILL PUT LENGTH HERE
INX H ;SKIP PAST LENGTH
MVI C,0 ;INITIALIZE LENGTH TO ZERO
XCHG ;DE PTS TO NEXT PLACE TO STORE A BYTE
CALL GETCL1 ;GET ADDRESS OF COMMAND LINE BUFFER
MOV A,M ;GET LOW
INX H
MOV H,M ;GET HIGH
MOV L,A ;HL PTS TO FIRST BYTE OF MULTIPLE COMMAND LINE
MOV B,M ;GET FIRST CHAR IN LINE
MVI M,0 ;CLEAR LINE
MOV A,B ;CHECK TO SEE IF FIRST CHAR IS A SEMICOLON (CMD SEP)
CPI ';'
JNZ ZMCL0
INX H ;PT TO 2ND CHAR
MOV A,M ;FIRST WAS A SEMICOLON, SO GET SECOND
ZMCL0:
XCHG ;HL PTS TO NEXT BUFFER SPACE, DE PTS TO MC LINE
JMP ZMCL1A ;A=FIRST CHAR IN MC LINE
;
; MAJOR LOOP TO STORE MULTIPLE COMMAND LINE
;
ZMCL1:
LDAX D ;GET NEXT BYTE FROM MULTIPLE COMMAND LINE
ZMCL1A:
ORA A ;0=EOL
JZ ZMCL2
ANI 7FH ;MASK OUT MSB
CALL CAPS ;CONVERT TO UPPER CASE
MOV M,A ;STORE CHAR INTO MEMORY
INX H ;PT TO NEXT CHAR
INX D
CALL SIZE ;MAKE SURE NO MEMORY OVFL
INR C ;INCR CHAR COUNT
JM LENERR ;MAX OF 128 CHARS IN LINE
JMP ZMCL1
;
; DONE WITH INPUT OF MULTIPLE COMMAND LINE -- SAVE CHAR CNT AND SET PTR
;
ZMCL2:
SHLD TXTPTR ;SAVE PTR
POP H ;PT TO CHAR COUNT POSITION
MOV M,C ;STORE CHAR COUNT
RET
;
; GET NEXT BYTE FROM INPUT FILE OR USER
;
GNB:
PUSH H ;DON'T ALTER ANYBODY
PUSH D
PUSH B
LDA OPTION ;INPUT FROM .SUB FILE?
CPI OPT ;TOLD BY ORIG CMD LINE OPTION
JNZ GNBDISK ;GET NEXT CHAR FROM DISK BUFFER IF NOT FROM USER
CALL GNBKBD ;GET A BYTE FROM KBD INPUT
JMP GNBXIT ;THEN LEAVE
;
; GET NEXT BYTE FROM DISK FILE
;
GNBDISK:
LDA IBP ;GET BUFFER POINTER
CPI 128 ;NEED ANOTHER BLOCK FROM DISK?
JC GNBD1 ;CONTINUE
CALL FILL ;GET NEXT BLOCK
JZ GNBD1 ;CONTINUE IF NOT EMPTY
CALL GETUD ;RETURN HOME
MVI A,1AH ;FAKE EOF
JMP GNBXIT
GNBD1:
MOV E,A ;PUT OFFSET IN DE
MVI D,0
INR A ;POINT TO NEXT BYTE
STA IBP ;SAVE FOR NEXT
LXI H,TBUF ;NOW OFFSET INTO BUFFER
DAD D
MOV A,M ;GET CHAR
GNBXIT:
POP B ;RESTORE EVERYBODY
POP D
POP H
ORA A ;TURN ON CARRY
RET
;
; FILL INPUT BUFFER FROM DISK
;
FILL:
XRA A ;CLEAR INPUT BUFFER PTR
STA IBP
LXI D,FCB ;PT TO FCB
MVI C,READF ;BDOS READ BLOCK FUNCTION
CALL BDOS
ORA A ;RETURN Z IF EOF
MVI A,0 ;SET PTR TO FIRST CHAR
RET
;
; GET NEXT BYTE FROM USER (KEYBOARD INPUT)
;
GNBKBD:
LHLD CLPTR ;PT TO NEXT CHAR
MOV A,M ;GET IT
INX H ;PT TO FOLLOWING
SHLD CLPTR ;RESET PTR
CPI CR ;END OF LINE?
RNZ
CALL CLFILL ;GET NEW LINE
JZ GKEND ;EMPTY LINE INPUT - RETURN EOF
MVI A,CR ;RETURN CR TO INDICATE END OF LINE
RET
GKEND:
MVI A,1AH ;RETURN EOF
RET
;
; FILL THE COMMAND LINE FROM THE USER
;
CLFILL:
CALL PRINT
DB CR,LF,' Command Line? ',0
LHLD CLBUF ;NOW FILL THE BUFFER
XCHG ;...DE PTS TO IT
MVI C,RDBUF
CALL BDOS
LHLD CLBUF ;PT TO COMMAND LINE BUFFER
INX H
MOV A,M ;GET CHAR COUNT
INX H
SHLD CLPTR ;RESET THE COMMAND LINE PTR
ORA A ;SET ZERO FLAG
PUSH PSW ;SAVE A
ADD L ;PT TO AFTER LAST CHAR
MOV L,A
MOV A,H
ACI 0
MOV H,A
MVI M,CR ;SET EOL CHAR
POP PSW ;GET CHAR COUNT
RET
;
; MAKE SURE NO MEMORY OVERFLOW
;
SIZE:
LDA BDOS+2 ;HIGHEST PAGE POINTER
SUI 9 ;MAKE IT BE UNDER CCP
CMP H ;CHECK IT AGAINST CURRENT PAGE
RNC ;NC=ALL OKAY
JMP MEMERR ;OTHERWISE ABORT
;
; SET UP THE $$$.SUB FILE
; FOR WRITING
;
WRSET:
CALL PRINT
DB CR,LF,' Writing Command File to Disk',0
LXI D,SUBFCB
MVI C,OPENF
CALL BDOS ;OPEN THE FILE
INR A ;CHECK CPM RETURN
JZ NONE1 ;NONE EXISTS ALREADY
;
; $$$.SUB EXISTS, SO SET
; FCB TO APPEND TO IT
;
LDA SUBFCB+FCBRC ;GET RECORD COUNT
STA SUBFCB+FCBNR ;MAKE NEXT RECORD
RET
;
; COME HERE WHEN NO $$$.SUB EXISTS
;
NONE1:
LXI D,SUBFCB
MVI C,MAKEF
CALL BDOS
INR A
JZ NOMAKE ;0FFH=CAN'T CREATE FILE
RET
;
; WRITE THE "$$$.SUB" FILE
;
WRSUB:
LHLD PREV ;THIS CODE SCANS BACKWARD
MOV A,H ; THRU THE FILE STORED IN
ORA L ; MEMORY TO THE FIRST NON-
JZ NOTEXT ; NULL LINE. IF NONE IS
MOV E,M ; FOUND, ABORTS
INX H
MOV D,M ;HERE, WE PICK UP PNTR TO PREV LINE
INX H ;NOW WE POINT TO LENGTH
XCHG ;WE NEED TO STORE AWAY
SHLD PREV ; POINTER TO PREV LINE
XCHG
MOV A,M ;NOW PICK UP THE LENGTH
ORA A ;SET Z FLAG ON LENGTH
JNZ WRNTRY ;GOT LINE W/LENGTH: GO DO IT
LHLD LINNUM ;NOTHING HERE, FIX LINE NUMBER
DCX H ;(WORKING BACKWARD NOW)
SHLD LINNUM
JMP WRSUB
WRLOP:
LHLD PREV ;GET PREV LINE POINTER
MOV A,H
ORA L ;IF THERE IS NO PREV LINE
JZ CLOSE ; THEN WE ARE DONE
MOV E,M ;ELSE SET UP PREV FOR NEXT
INX H ; PASS THRU HERE
MOV D,M
INX H
XCHG ;NOW STORE IT AWAY
SHLD PREV
XCHG
WRNTRY:
CALL PUTLIN ;WRITE THE LINE TO THE FILE
LHLD LINNUM ;BUMP THE LINE NUMBER
DCX H ;DOWN (WORKING BACK NOW)
SHLD LINNUM
JMP WRLOP
;
; $$$.SUB IS WRITTEN, CLOSE THE FILE
;
CLOSE:
LXI D,SUBFCB
MVI C,CLOSEF
JMP BDOS
;
; THIS SUBROUTINE WRITES A LINE
; TO THE $$$.SUB FILE BUFFER,
; AND FLUSHES THE BUFFER AFTER
; THE LINE IS WRITTEN.
;
PUTLIN:
MOV A,M ;PICK UP LENGTH BYTE
INX H ;POINT PAST IT
STA GETCNT ;MAKE A COUNT FOR "GET"
SHLD GETPTR ;MAKE A POINTER FOR "GET"
LXI H,TBUF+1 ;TEXT GOES AFTER LENGTH
SHLD PUTPTR ;MAKE POINTER FOR "PUT"
XRA A ;INITIALIZE PUT COUNT
STA PUTCNT
MOV B,L ;COUNT FOR CLEAR LOOP
CLR:
MOV M,A ;ZERO OUT BUFFER LOC
INX H
INR B ;COUNT
JNZ 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
JC FLUSH ;CY = NO MORE CHAR IN LINE
CPI '^' ;CONTROL-CHAR TRANSLATE PREFIX?
JNZ NOTCX
CALL GETCHR ;YES, GET THE NEXT
JC CCERR ;ERROR: EARLY END OF INPUT
SUI '@' ;MAKE IT A CONTROL-CHAR
JC CCERR ;ERROR: TOO SMALL
CPI ' '
JNC CCERR ;ERROR: TOO LARGE
NOTCX:
CPI PDELIM ;PARAMETER SPECIFIER?
JNZ STOBYT ;IF NOT, JUST WRITE CHAR
LDA OPTION ;CHECK OPTION: '$' DOESN'T
CPI OPT ; COUNT IN OPT MODE
MVI A,PDELIM ;(RESTORE THE '$')
JZ STOBYT
CALL LKAHED ;PEEK AT NEXT CHAR
JC PARERR ;LINE ENDING MEANS PARAM ERR
CPI PDELIM ;ANOTHER "$"?
JNZ SUBS ;IF NOT THEN GO DO SUBSTITUTION
CALL GETCHR ;GET THE 2ND "$" (WE ONLY LOOKED
; AHEAD BEFORE)
STOBYT:
CALL PUTCHR ;WRITE CHAR TO FILE
JMP PUTLP
;
; PARAMETER SUBSTITUTION...LOOKS UP THE
; PARAMETER # AFTER THE "$" AND PLUGS IT
; IN IF IT EXISTS.
;
SUBS:
CALL NUMTST ;IT BETTER BE A NUMBER
JC PARERR ; OTHERWISE PARAM ERROR
MVI B,0 ;INITIALIZE PARM #
JMP LPNTRY ;WE JOIN LOOP IN PROGRESS...
SUBLP:
CALL LKAHED ;LOOK AT NEXT CHAR
JC DOSUBS ;IF LINE EMPTY, THEN PLUG IN PARM
CALL NUMTST ;CHECK FOR NUMERIC
JC DOSUBS ;DONE IF NOT
LPNTRY:
CALL GETCHR ;NOW REMOVE THE CHAR FROM INPUT STREAM
SUI '0' ;REMOVE ASCII BIAS
MOV C,A ;SAVE IT
MOV A,B ;OUR ACCUMULATED COUNT
ADD A ;MULTIPLY BY TEN
ADD A
ADD B
ADD A
ADD C ;THEN ADD IN NEW DIGIT
MOV B,A ;RESTORE COUNT
JMP SUBLP
;
; PERFORM THE SUBSTITUTION
;
DOSUBS:
MOV A,B ;GET PARM #
DCR A ;MAKE ZERO RELATIVE
JM PARERR ;OOPS
CALL LOOKUP ;LOOK IT UP IN PARM TABLE
JC PARERR ;IT'S NOT THERE
MOV B,A ;LENGTH IN B
SUBLP1:
INR B ;TEST B FOR ZERO
DCR B
JZ PUTLP ;DONE
MOV A,M ;GET CHAR OF REAL PARAMETER
INX H ;POINT PAST FOR NEXT TIME
PUSH H ;SAVE REAL PARM POINTER
CALL PUTCHR ;PUT IT IN THE FILE
POP H ;GET BACK REAL PARM POINTER
DCR B ;COUNTDOWN
JMP SUBLP1
;
; COME HERE WHEN A LINE IS FINISHED,
; AND WE NEED TO WRITE THE BUFFER TO DISK
;
FLUSH:
LXI D,SUBFCB
MVI C,WRITEF
CALL BDOS
ORA A
JNZ WRERR ;CPM RETURNED A WRITE ERROR
RET
;
; GETCHR GETS ONE CHAR FROM
; LINE STORED IN MEMORY
;
GETCHR:
LXI H,GETCNT
MOV A,M ;PICK UP COUNT
DCR A ;REMOVE THIS CHAR
STC ;PRESET ERROR
RM ;RETURN CY IF OUT OF CHARS
MOV M,A ;UPDATE COUNT
LHLD GETPTR ;CURRENT CHAR POINTER
MOV A,M ;PICK UP CHAR
INX H ;BUMP POINTER
SHLD GETPTR ;PUT IT BACK
CMC ;TURN CARRY OFF
RET
;
; PUTCHR PUTS ONE CHAR TO
; THE OUTPUT BUFFER
;
PUTCHR:
LXI H,PUTCNT
INR M ;INCREMENT COUNT
JM LENERR ;LINE WENT TO > 128 CHARS
LHLD PUTPTR ;GET BUFFER POINTER
ANI 7FH ;MASK OUT MSB
MOV M,A ;PUT CHAR THERE
INX H ;BUMP POINTER
SHLD PUTPTR ;PUT IT BACK
RET ;ALL DONE
;
; LOOK AHEAD ONE CHAR IN
; THE INPUT STREAM. SET
; CARRY IF NONE LEFT.
;
LKAHED:
LDA GETCNT
ORA A ;SEE IF COUNT IS DOWN TO ZERO
STC ;PRE SET INDICATOR
RZ
MOV A,M ;PICK UP CHAR
CMC ;TURN OFF CARRY FLAG
RET
;
; LOOK UP PARAMETER WITH NUMBER IN
; A REG. RETURN A=LENGTH OF PARM,
; AND HL => PARAMETER
;
LOOKUP:
CPI NPAR
JNC PAROVF ;PARM # TOO HIGH
MOV L,A
MVI H,0 ;NOW HAVE 16 BIT NUMBER
DAD H ;DOUBLE FOR WORD OFFSET
LXI D,TABLE
DAD D ;DO THE OFFSET
MOV E,M ;GET ADDRESS OF PARM
INX H
MOV D,M
MOV A,D ;ANYTHING THERE?
ORA E
JNZ LKUPOK
XRA A ;NO, ZERO LENGTH
RET
LKUPOK:
XCHG ;NOW IN DE
MOV A,M ;PICK UP LENGTH
INX H ;POINT PAST LENGTH
RET
;
; UTILITY COMPARE SUBROUTINE
;
COMPAR:
LDAX D
CMP M
RNZ
INX H
INX D
DCR B
JNZ COMPAR
RET
;
; NUMERIC TEST UTILITY SUBROUTINE
;
NUMTST:
CPI '0'
RC
CPI '9'+1
CMC
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 H
CALL PSTR ;PRINT MESSAGE
CALL PRINT
DB ' Error on Line ',0
LHLD LINNUM ;TELL LINE NUMBER
CALL PHLDC
CALL CRLF
LXI D,SUBFCB ;DELETE THE $$$.SUB FILE
MVI C,DELETF
CALL BDOS
JMP CPBASE
;
; INITIALIZE ALL VARIABLES
;
INITVAR:
LXI H,VAR
LXI B,ENDVAR-VAR
INITLP:
MVI M,0 ;ZERO ENTIRE VAR AREA
INX H
DCX B
MOV A,B
ORA C
JNZ INITLP
LXI H,TABLE ;INIT PARM TABLE POINTER
SHLD TBLPTR
LXI H,0FFFFH ;MARK END OF TABLE
SHLD ENDTBL
LHLD FREMEM ;FREE MEMORY STARTS TXT AREA
SHLD TXTPTR
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
LHLD SPSAVE ;RETURN TO OPSYS
SPHL
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
DW 0,0,0,0
;
CLBUF: DS 2 ;PTR TO COMMAND LINE BUFFER
FREMEM: DS 2 ;PTR TO FREE MEMORY AREA
;
END