Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
cobol-source/cmnd20.mac
There are 12 other files named cmnd20.mac in the archive. Click here to see a list.
; UPD ID= 1519 on 2/2/84 at 3:34 PM by RMEYERS
TITLE CMND20 - The TOPS-20 Native Mode Command Scanner
SUBTTL Randall Meyers/DMN
SEARCH COPYRT
SALL
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983, 1984
;AUTHOR: Randall Meyers
;Modified by: David M. Nixon
ENTRY CMND20
SUBTTL Revision History
Comment \
***** Begin Revision History *****
\
SEARCH JOBDAT,MONSYM,MACSYM
;Globals used by Language specific routine
INTERN SCANSW
INTERN STATE
INTERN GETDEF
INTERN USRERR
INTERN CNTIDX
INTERN SRCFIL
INTERN CMD
INTERN MONERR
INTERN ATMBUF ;Atom buffer for COMND% JSYS
INTERN CJFNBK
INTERN CMDSOU
INTERN CONFIRM
INTERN DEFFIL
INTERN ERRPFX
INTERN JOBNUM
INTERN LSTTYP
INTERN SRCGJB
INTERN BINGJB
INTERN LSTGJB
INTERN FLAG10 ;-1 if command is scanned by SCAN10
INTERN .HELP ;Handle /HELP for TOPS-10 scanner
INTERN .ECHOOP ;/ECHO-OPTION switch action
INTERN .NEW ;Handle switch that gets back to TOPS-20 scanner
INTERN .NOOPTION ;/NOOPTION: switch action
INTERN .OPTION ;/OPTION: switch action
INTERN .COBSW ;-1 if called from COBOL
INTERN .FORSW ;-1 if called from Fortran
INTERN .OLDSW ;Use TOPS-10 style command scanner
EXTERN INITFL ;Clear the flags
EXTERN ONFLG ;The flags that must be turned on
EXTERN OFFFLG ;The flags that must be turned off
EXTERN SONFLG ;Holds ON flags from command line during SWITCH.INI processing.
EXTERN SOFFLG ;Holds OFF flags from command line during SWITCH.INI processing.
EXTERN BINJFN ;JFN of binary file
EXTERN LSTJFN ;JFN of listing file
EXTERN COMSW ;List of possible commands
EXTERN OCOMSW ;List of possible TOPS-10 only commands
EXTERN HLPSTR ;HELP file on device HLP:
EXTERN HLPSYS ;HELP file on device SYS:
EXTERN LNGNAM ;Name of compiler
EXTERN LNGTYP ;Default type of source file
EXTERN PROMPT ;Language prompt string
EXTERN PRANAM ;Process arg name used by EXEC
EXTERN PRBFIL ;File name used for CCL command
EXTERN DEFOFL ;Default output file name
EXTERN LNGWPF ;Warning prefix
EXTERN LNGFPF ;Fatal prefix
EXTERN LNGCMD ;Command error message
EXTERN LNGPSC ;...
EXTERN DOCOMPILER ;Call language specific part to start compilation
EXTERN .NOLIST ;Standard action for /NOLIST
EXTERN CCLSW ;Contains 0 or 1, the start address offset used
; to start the compiler
SALL
.HIGH.==400000 ;Start of compiler's high segment
CMDTRC==0 ;Turn on tracing
BUFSIZ==^D96 ;Length (words) of command line buffer
ATMBLN==^D34 ;Length (words) of atom buffer
MAXFILES==^D20 ;Maximum number of sources files in one command
TMPLEN==200 ;Length of the PRARG block
TAKLEN==^D10 ;Nesting depth of TAKE files
TWOSEG .HIGH.
.COPYRIGHT ;Put standard copyright statement in REL file
;AC'S USED BY COMMAND SCANNER
F==0 ;Known as FLGREG by the compiler.
SW==0 ;Used as a flag register by rest of the compiler.
T1==1 ;TEMP
T2==2 ; ..
T3==3 ; ..
T4==4 ; ..
T5==5 ; ..
T6==6 ; ..
P1==7 ;PRESERVED AC
P2==10 ; ..
P3==11 ; ..
P4==12 ;
P5==13 ;
P6==14 ;
VREG=15 ;BLIS10 VALUE RETURN REG
; FREG=16 ;BLIS10 FRAME POINTER
SREG=17 ;BLIS10 STACK POINTER
OPDEF PJRST [JRST] ;PUSHJ and POPJ
OPDEF NOOP [TRN] ;Fastest No-op in machine
.NODDT PJRST,NOOP
DEFINE TRACE(S)<
IFN CMDTRC,<
PUSH SREG,T1
HRROI T1,[ASCIZ \
Got to 'S
\]
PSOUT%
POP SREG,T1>
>
FRMTTY==0 ;Command input comes from terminal
FRMPRA==1 ;Command input comes from PRARGs
FRMTAK==2 ;Command input comes from /TAKE file
FRMSWI==3 ;Command input comes from SWITCH.INI
FRMTEN==4 ;Command input is under TOPS-10 compatibility
SUBTTL Flag Mask Definitions
;Flags are stored in a multi-word table.
;The only flags that CMND20 is allowed to look at are in RHS of ONFLG and OFFFLG.
;All other flags are language specific.
;Flags in ONFLG+$F and OFFFLG+$F
SW.CRF==1B2 ;CREF wanted
SW.ERA==1B3 ;Print errors on terminal
RELFLG==1B22 ;REL file wanted
LSTFLG==1B25 ;LIST file wanted
TTYINP==1B30 ;INPUT DEVICE IS A TTY
SUBTTL Low Segment Data Area
RELOC 0
STATE: BLOCK .CMGJB+1 ;State block for COMND% JSYS
BUFF: BLOCK BUFSIZ ;Command buffer for COMND% JSYS
ATMBUF: BLOCK ATMBLN ;Atom buffer for COMND% JSYS
DEFFIL: BLOCK ATMBLN ;Holds default filename for /LIST & /OBJECT
LSTTYP: BLOCK ATMBLN ;Holds user's typescript of value to /LIST
INIFIL: BLOCK ^D19 ;Holds filename of SWITCH.INI file
CMDSOU: BLOCK 1 ;Source code,,Optional JFN of COMND% input
ERRPFX: BLOCK 1 ;Default byte pointer to prefix of error message line
OLDSTK: BLOCK 1 ;Used to restore the stack pointer
PRAFIL: BLOCK 5 ;[1643] Used to read EXEC args if PRARG fails
CNTIDX: BLOCK 1 ;Index in SRCFIL to currently open source file
SRCIDX: BLOCK 1 ;Index to get last source file JFN in SRCFIL
SRCFIL: BLOCK MAXFILES ;JFN's of source files
JOBNUM: BLOCK 1 ;[1631] Job number
.OLDSW: BLOCK 1 ;Flag: Is TOPS-10 style scanner wanted
BATCH: BLOCK 1 ;Flag: Is this a batch job?
FLAG10: BLOCK 1 ;Flag: Is current command being scanned by SCAN10
.COBSW: BLOCK 1 ;-1 if called from COBOL
.FORSW: BLOCK 1 ;-1 if called from Fortran
TDEPTH: BLOCK 1 ;Level of nesting of /TAKE: files
ECHOFLG:BLOCK 1 ;Flag: Is command to be echoed?
OPTECHO:BLOCK 1 ;Flag: Are option lines from SWITCH.INI echoed?
NOPTION:BLOCK 1 ;Flag: Has /NOOPTION been seen?
OPTION: BLOCK 10 ;Storage for option string--stores 39 chars
ARGBLK: BLOCK TMPLEN ;Area to hold Process Args
CJFNBK: BLOCK .GJATR+1 ;Block for GTJFN%
SRCGJB: BLOCK .GJJFN+1 ;Default GTJFN block for input files
BINGJB: BLOCK .GJJFN+1 ;Default GTJFN block for output file
LSTGJB: BLOCK .GJJFN+1 ;Default GTJFN block for listing file
RELOC 400000
SUBTTL Compiler Initialization
CMND20: MOVE T1,[STATEB,,STATE]
BLT T1,STATE+.CMGJB ;Load COMND% state block
SETZM ECHOFLG ;[1645] Assume that commands are not echoed
SETZM STATE+.CMFLG ;[1671] No reparse address or flags
MOVE T1,[XWD .PRIIN,.PRIOU] ;[1671] JFNs for command input, output
MOVEM T1,STATE+.CMIOJ ;[1671] Restore JFNs
MOVE T1,[POINT 7,BUFF] ;[1671] Pointer to command buffer
MOVEM T1,STATE+.CMBFP ;[1671]
MOVEM T1,STATE+.CMPTR ;[1671]
MOVX T1,5*BUFSIZ ;[1671] # Chars unused in buffer
MOVEM T1,STATE+.CMCNT ;[1671]
SETZM STATE+.CMINC ;[1671] # Chars unparsed in buffer
SUBTTL Get Name of SWITCH.INI file
;**********************************************************************
;
; Get name of the user's SWITCH.INI file.
;
;**********************************************************************
;Rewritten edit 1623
SETO T1, ;Get info about this job
MOVE T2,[XWD -<.JILNO+1>,BUFF] ;-Length,,address
MOVEI T3,.JIJNO ;First thing that we are interested in
GETJI%
ERCAL UNXERR ;Failure return
MOVE T1,BUFF+.JIJNO ;[1631] Get job number
MOVEM T1,JOBNUM ;[1631] Store
MOVE T1,BUFF+.JIBAT ;Get batch flag
MOVEM T1,BATCH ;Store
HRROI T1,INIFIL ;Area to receive name of switch file
MOVE T2,BUFF+.JILNO ;Get number of logged-in directory
DIRST%
ERCAL UNXERR ;Failure return
MOVEI P1,^D11 ;Source is ten characters
MOVE P2,[POINT 7,[ASCIZ \SWITCH.INI\]] ;Source byte pointer
SETZB P3,P6 ;No second word in byte pointers
MOVEI P4,^D11 ;Destination to receive ten characters
MOVE P5,T1 ;Destination Byte pointer
EXTEND P1,[MOVSLJ ;Copy the string
0]
NOOP
MOVE T1,[PRBFIL,,PRAFIL]
BLT T1,PRAFIL+4 ;Copy Process file name
MOVE T1,JOBNUM ;Get job number
IDIVI T1,^D100 ;Get hundreds digit
MOVE T3,T1 ;Store hundreds digit
MOVE T1,T2 ;Get remainder of job number
IDIVI T1,^D10 ;Get tens and ones digits
LSH T3,7 ;Make room for tens digit
ADD T3,T1 ;Add in tens digit
LSH T3,7 ;Make room for ones digit
ADD T3,T2 ;Add in ones digit
LSH T3,^D8 ;Position in order to form filename
ADDM T3,PRAFIL+1 ;Form filename of TMP file
SUBTTL Process Fork Argument from the EXEC
;**********************************************************************
;
; Read and process the proccess arguments set up by the EXEC. The
; EXEC sets up the process arguments when it calls compiler to do
; a COMPILE, EXECUTE, etc. EXEC command.
;
;**********************************************************************
SKIPN CCLSW ;Was compiler started at the CCL entry point?
JRST MAIN ;No--Don't try to get process arguments
MOVE T1,[XWD .PRARD,.FHSLF] ;Read arguments for this fork
MOVEI T2,ARGBLK ;Area in which to get arguments
MOVEI T3,TMPLEN ;Length of area to hold text
PRARG%
SKIPG T1,ARGBLK ;Get number of "files" in TMPCOR
JRST DSKTMP ;[1631] Get arguments from file on disk
LOOP: MOVE T2,ARGBLK(T1) ;Get displacement of file in TMPCOR
HLRZ T3,ARGBLK(T2) ;Get header of first file
CAMN T3,PRANAM ;Have we got the file we want?
JRST FOUND ;Yes--process it
SOJG T1,LOOP
JRST MAIN
FOUND: HRRZ P1,ARGBLK(T2) ;Get length (in words) of TMP file
IMULI P1,5 ;Get length (in characters) of TMP file
MOVEI P2,ARGBLK+1(T2) ;Get address of string in TMP file
HRLI P2,(POINT 7,0,-1) ;Make into a byte pointer
SL2: HRLZI T1,FRMPRA ;The command stream is the process arguments
MOVE T2,[XWD .NULIO,.NULIO] ;COMND% will not have to do I/O
HRROI T3,PROMPT ;Prompt pointer
PUSHJ SREG,CMDINI ;Init COMND% JSYS and its state block
MOVE P3,STATE+.CMCNT ;Get length of receiving area
MOVE T1,STATE+.CMPTR ;Get byte pointer to command buffer
L2: ILDB T2,P2 ;Get a character from TMP file
IDPB T2,T1 ;Deposit in command buffer
SOJE P1,GOTSTR ;Jump if no more text in TMP file
CAIN T2,.CHLFD ;Was character linefeed?
SOJA P3,GOTSTR ;Yes--Got the command string
SOJGE P3,L2 ;If room still in command buffer, loop
HRROI T1,[ASCIZ \ Command passed by EXEC is too long
\]
PUSHJ SREG,FCMDERR
JRST MAIN
GOTSTR: SETZM TDEPTH ;No take files nested here!
EXCH P3,STATE+.CMCNT ;Move into memory the length of unused buffer
SUB P3,STATE+.CMCNT ;Get the number of unparsed characters
MOVEM P3,STATE+.CMINC ;Store number of unparsed chars in state block
PUSHJ SREG,SCAN20 ;Scan the command line
MOVE T1,P2 ;Get copy of pointer to text in TMP file
ILDB T2,T1 ;Get next character
JUMPE T2,PFAHLT ;[1611]If char is null, then got end of command
JUMPN P1,SL2 ;Continue processing if more text
PFAHLT: HALTF% ;[1611] Through processing fork arguments
JRST MAIN ;[1631] User typed "CONTINUE" ...
STATEB: XWD 0,0 ;Flags,,Reparse address
XWD .PRIIN,.PRIOU ;Input JFN,,Output JFN
EXP 0 ;Pointer to Command Prompt
POINT 7,BUFF ;Pointer to command buffer
POINT 7,BUFF ;Pointer to next text to parse
EXP 5*BUFSIZ ;# of Chars unused in buffer
EXP 0 ;# of Chars unparsed in buffer
POINT 7,ATMBUF ;Pointer to atom buffer
EXP 5*ATMBLN ;# of chars in atom buffer
EXP CJFNBK ;Pointer to GTJFN% block
SUBTTL Process TMP file on DSK:
;[1631] This routine added by RVM
DSKTMP: HRLZI T1,FRMPRA ;The command stream is the process arguments
MOVE T2,[XWD .NULIO,.NULIO] ;COMND% will not have to do I/O
HRROI T3,PROMPT ;Prompt pointer
PUSHJ SREG,CMDINI ;Init COMND% JSYS and its state block
MOVX T1,GJ%SHT+GJ%OLD+GJ%TMP ;[1643] An existing TMP file
MOVE T2,[POINT 7,PRAFIL+1,6] ;[1643] Filename is in PRAFIL
GTJFN% ;[1643] Get a JFN to see if file exists
ERJMP MAIN ;[1643] Can't read file--get commands from tty
MOVE T1,[XWD PRAFIL,BUFF] ;From PRAFIL to BUFF
BLT T1,BUFF+4 ;[1643] Move the command string+null byte
SETZM TDEPTH ;No take files nested here (yet)!
MOVEI T1,^D20 ;[1643] Number of characters in command
MOVEM T1,STATE+.CMINC ;Store number of unparsed chars in state block
SUB T1,STATE+.CMCNT ;Get - number of unparsed characters
MOVNM T1,STATE+.CMCNT ;Store number of unparsed characters
PUSHJ SREG,SCAN20 ;Scan the command line
MOVX T1,.FHSLF+CZ%NIF+CZ%ABT ;Abort I/O for this process
CLZFF% ;Close open files and release all JFNs
MOVX T1,GJ%SHT+GJ%OLD+GJ%TMP ;[1643] Get a JFN on an old TMP file
MOVE T2,[POINT 7,PRAFIL+1,6] ;Filename pointer
GTJFN%
ERCAL UNXERR ;Unexpected error
HRRZ T1,T1 ;Zero left half of T1
DELF% ;Delete the TMP file
ERCAL UNXERR ;Unexpected error
HALTF% ;Done
SUBTTL Main Command Loop of the Compiler
;**********************************************************************
;
; This is the main command loop of the compiler. It is responsable
; for calling SCAN20 or SCAN10 to process a command line input from
; the terminal.
;
;**********************************************************************
MAIN:
SKIPN .OLDSW ;Want TOPS-10 scanner?
SKIPE BATCH ;Are we running under batch?
JRST GOTBAT ;Yes--Might have to do -10 compatability stuff
NOTBAT: MOVX T1,.FHSLF+CZ%NIF+CZ%ABT ;[1623] Abort I/O for this process
CLZFF% ;[1623] Close open files and release all JFNs
SETZM TDEPTH ;No take files are nested here!
HRLZI T1,FRMTTY ;COMND% input comes from terminal
MOVE T2,[XWD .PRIIN,.PRIOU] ;Input from terminal,,ouput to terminal
HRROI T3,PROMPT ;Prompt pointer
PUSHJ SREG,CMDINI ;Init COMND% JSYS and its state block
PUSHJ SREG,SCAN20 ;Scan a TOPS-20 command line
JRST MAIN
GOTBAT: MOVX T1,.FHSLF+CZ%NIF+CZ%ABT ;[1623] Abort I/O for this process
CLZFF% ;[1623] Close open files and release all JFNs
SETZB P1,TDEPTH ;No charaters read Yet and no take files are nested here!
SKIPE .OLDSW ;Do we want TOPS-10 scanner?
JRST TERM10 ;Yes
MOVEI T1,"*" ;The batch prompt
PBOUT%
MOVE T2,STATE+.CMBFP ;[1603] Disable CONTROL/H feature under batch
MOVEM T2,STATE+.CMPTR ;[1603] Disable CONTROL/H feature under batch
MOVE T2,[POINT 7,BUFF] ;This is the COMND% JSYS buffer
BATLP: PBIN% ;Get a character
AOJ P1, ;Got another character
CAILE P1,BUFSIZ*5 ;Have we exceeded the size of the buffer?
JRST CMDOVL ;Yes--Buffer overflowed!
IDPB T1,T2 ;Store character in COMND%'s buffer
CAIN T1,"=" ;Is this character an equal sign?
JRST TERM10 ;Yes--Got a TOPS-10 command
CAIE T1,"+" ;Is this character an plus sign?
CAIN T1,"?" ;Is this character a question mark?
JRST TERM20 ;Yes--Got a TOPS-20 command
CAIE T1,.CHCNF ;Is this character a CONTROL/F?
CAIN T1,.CHESC ;Is this character an escape?
JRST TERM20 ;Yes--Got a TOPS-20 command
CAIE T1,.CHCNV ;Is this character a CONTROL/V?
CAIN T1,.CHLFD ;Is this character a linefeed?
JRST TERM20 ;Yes--Got a TOPS-20 command
CAIE T1,.CHFFD ;Is this character a form feed?
JRST BATLP ;No--Go get another character
TERM20: HRLZI T1,FRMTTY ;COMND% input comes from terminal
MOVE T2,[XWD .PRIIN,.NULIO] ;Input from terminal,,ouput to nowhere
HRROI T3,PROMPT ;Prompt pointer
PUSHJ SREG,CMDINI ;Init COMND% JSYS and its state block
MOVEM P1,STATE+.CMINC ;Store number of unparsed characters
MOVN P1,P1 ;Get ready to subtract from free buffer space
ADDM P1,STATE+.CMCNT ;Decrease the amount of free buffer space
PUSHJ SREG,SCAN20 ;Scan a TOPS-20 command line
JRST MAIN
TERM10: MOVSI T1,FRMTEN ;COMND% input processed under -10 compatibility
SKIPE .OLDSW ;Did user ask for TOPS-10 explicitly?
SKIPA T2,[XWD .PRIIN,.PRIOU] ;Yes, Input from terminal,,ouput to terminal
MOVE T2,[XWD .PRIIN,.NULIO] ;Input from terminal,,ouput to nowhere
HRROI T3,[ASCIZ \*\] ;Prompt pointer
PUSHJ SREG,CMDINI ;Init COMND% JSYS and its state block
MOVEM P1,STATE+.CMINC ;Store number of unparsed characters
MOVN P1,P1 ;Get ready to subtract from free buffer space
ADDM P1,STATE+.CMCNT ;Decrease the amount of free buffer space
PUSHJ SREG,SCAN10 ;Scan a TOPS-10 command line
JRST MAIN
CMDOVL: HRROI T1,[ASCIZ \ Command too big for internal buffer
\]
PUSHJ SREG,FCMDERR
JRST MAIN
SUBTTL UNXERR -- Unexpected JSYS error
;************************************************************************
; This rouine is used when an unexpected JSYS error occurs
;************************************************************************
UNXERR: HRROI T1,[ASCIZ \ Unexpected JSYS error at PC \]
PUSHJ SREG,FCMDERR
MOVEI T1,.PRIOU ;Output to primary output stream
HRRZ T2,(SREG) ;Get the return address from the PC
SOJ T2, ;Back the PC over the call
MOVX T3,NO%ZRO+FLD(6,NO%COL)+FLD(^D8,NO%RDX) ;6 col. octal #
NOUT% ;Output number
NOOP ;Pretty bad if this fails
HRROI T1,[ASCIZ \
\]
PSOUT%
HALTF% ;Halt this fork
POPJ SREG, ;Brave person typed "CONTINUE"--so return
SUBTTL Misc. Utility Routines
;SUBROUTINE TO PSOUT% A STRING FROM BLISS
; [1563] /PLB
TTYSTR::
PUSH SREG,T1 ;SAVE AC 1
HRRO T1,-2(P) ;GET -1,,ADDR
PSOUT% ;OUTPUT
POP SREG,T1 ;RESTORE
POPJ SREG,
;SUBROUTINE TO SIMULATE AN EXIT UUO
; [1563] /PLB
EXITUUO::
PUSH SREG,T1 ;SAVE AC 1
HRROI T1, [ASCIZ \
Exit\] ;BE LIKE TOP-10 (ALMOST)
PSOUT% ;STUFF IT
POP SREG,T1 ;RESTORE
HALTF%
JRST .-1
;Convert a 7 bit ASICZ string to 6 bit.
;The 7 bit string is assumed to be in the atom buff. Up to the
;first 6 characters will be converted and stored in VREG left
;justified.
CVT76:
SETZ VREG, ;Clear VREG so it can get 6 bit string
MOVE T1,[POINT 7,ATMBUF] ;7 bit string comes from the atom buffer
MOVE T2,[POINT 6,VREG] ;6 bits string goes into VREG
MOVEI T4,6 ;Process up to 6 characters
C76LP: ILDB T3,T1 ;Get a seven bit character
JUMPE T3,C76RET ;Return if null encountered
SUBI T3," "-' ' ;Convert 7 bit to sixbit
IDPB T3,T2 ;Store sixbit character
SOJG T4,C76LP ;Process up to 6 characters
C76RET: POPJ SREG, ;Return
SUBTTL SCAN20 -- Scan a TOPS-20 Command Line
;**********************************************************************
;
; SCAN20: scan and process a TOPS-20 compiler command line.
;
;**********************************************************************
SCAN20:
TRACE <SCAN20:>
SETZM FLAG10 ;Set scanned by SCAN20
PUSH SREG,P1 ;Save P1
PUSH SREG,P2 ;Save P2
PUSH SREG,P3 ;Save P3
PUSH SREG,P4 ;Save P4
PUSH SREG,P5 ;Save P5
PUSH SREG,P6 ;Save P6
PUSH SREG,STATE+.CMFLG ;Save the Reparse address of the COMND% JSYS
PUSH SREG,OLDSTK ;Save old "old stack pointer"
MOVEM SREG,OLDSTK ;Save stack pointer so we can abort
MOVEI T1,REPARSE ;Get address of code to handle a reparse
HRRM T1,STATE+.CMFLG ;Store in state block
JRST GETCOMM
REPARSE:
TRACE <REPARSE>
MOVE SREG,OLDSTK ;Restore the stack pointer
SKIPL T1,BINJFN ;Get JFN of object file (-1 means no JFN)
RLJFN% ;Release JFN
ERJMP MONERR
SKIPL T1,LSTJFN ;Get JFN of list file (-1 means no JFN)
RLJFN% ;Release JFN
ERJMP MONERR
SKIPGE T5,SRCIDX ;Get index to JFN of last source file
JRST GETCOMM ;No source file JFN's
RL: MOVE T1,SRCFIL(T5) ;Get JFN of next source file
RLJFN% ;Release JFN
ERJMP MONERR
SOJGE T5,RL ;Loop to release rest of source file JFN's
GETCOMM:
TRACE <GETCOMMAND>
PUSHJ SREG,INITFL ;Clear flags
SETOM LSTJFN ;Clear JFN of list file
SETOM BINJFN ;Clear JFN of object file
SETOM SRCIDX ;No source files have JFN's
SETZM LSTTYP ;Throw away typescript from /LIST:
SETZM OPTECHO ;Don't echo options from SWITCH.INI
SETZM NOPTION ;/NOOPTION has not been seen--read SWITCH.INI
SETZM OPTION ;No option string has been given
HRROI T1,LNGCMD ;Get pointer to prefix of error messages
MOVEM T1,ERRPFX ;Store error message prefix
MOVX T1,GJ%OLD!GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device
SETZM CJFNBK+.GJNAM ;Set default name
MOVEI T2,ACTVRB ;Look for action or filespec
PUSHJ SREG,FCMD ;Do COMND% JSYS
JRST RET.EOF ;EOF return--take eof return to caller
CAIN T3,CMFILE ;Was a filename found?
JRST GOTSOU ;Yes--process a compile command
CAIN T3,CMSW ;Was a compilation switch found
JRST GOTSWI ;Yes--process a compile command
CAIN T3,CONFIRM ;Was a carriage return found?
JRST RET.OK ;Yes--Return
HRRZ T2,(T2) ;Get action code
JRST (T2) ;Other alternative, handle action switch
.EXIT:
TRACE <.EXIT>
MOVEI T2,CONFIRM ;Wait for confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
HALTF% ;All done
JRST RET.OK ;Continue the compiler
.NEW:
TRACE <.NEW>
MOVEI T2,CONFIRM ;Wait for confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
SETZM .OLDSW ;Force TOPS-20 style command scanner
JRST RET.OK ;Continue the compiler
.OLD:
TRACE <.OLD>
MOVEI T2,CONFIRM ;Wait for confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
SETOM .OLDSW ;Force TOPS-10 style command scanner
JRST RET.OK ;Continue the compiler
.HELP: ;[1611] Routine added
TRACE <.HELP>
MOVEI T2,CONFIRM ;Wait for confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
MOVX T1,GJ%OLD+GJ%SHT ;Try logical HLP:
HRROI T2,HLPSTR
GTJFN%
TRNA ;Failure return, try next source
JRST HLPOPN ;Success return, Open the file
MOVX T1,GJ%OLD+GJ%SHT+GJ%PHY ;Try physical HLP:
HRROI T2,HLPSTR
GTJFN%
TRNA ;Failure return, try next source
JRST HLPOPN ;Success return, Open the file
MOVX T1,GJ%OLD+GJ%SHT ;Try logical SYS:
HRROI T2,HLPSYS
GTJFN%
TRNA ;Failure return, try next source
JRST HLPOPN ;Success return, Open the file
MOVX T1,GJ%OLD+GJ%SHT+GJ%PHY ;Try physical SYS:
HRROI T2,HLPSYS
GTJFN%
JRST HLPERR ;Failure return, Cannot open the file
HLPOPN: HRRZ T5,T1 ;Save JFN of help file
MOVX T2,FLD(7,OF%BSZ)+OF%RD ;Read the file
OPENF%
JRST HLPERR ;Failure return, tell user
HLPLP: MOVE T1,T5 ;Get JFN of help file
HRROI T2,BUFF ;Area in which to put string
MOVNI T3,BUFSIZ*5 ;Size of string buffer
SIN%
ERJMP HLPEOF ;Failure, maybe EOF
SETZ T3, ;Need a zero byte
IDPB T3,T2 ;Mark end of buffer with zero byte
HRROI T1,BUFF ;Point to string in buff
PSOUT%
JRST HLPLP ;Type rest of help file
HLPEOF:
SETZ T3, ;Need a zero byte
IDPB T3,T2 ;Mark end of buffer with zero byte
HRROI T1,BUFF ;Point to string in buff
PSOUT%
MOVE T1,T5 ;Get JFN of help file
CLOSF% ;Close file
NOOP ;Not likely
JRST RET.OK ;Return to caller
HLPERR: HRROI T1,LNGWPF ;Put out warning prefix
PSOUT%
HRROI T1,[ASCIZ \CMD Can't open help file; I'm sorry but I can't help you.
\]
PSOUT%
JRST RET.OK ;Nothing really bad occured, take normal return
;Register usage
; P1 JFN of file to run in new fork
.PUSH:
TRACE <.PUSH>
MOVX T1,GJ%OLD!GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device
SETZM CJFNBK+.GJNAM ;Clear default name
HRROI T1,[ASCIZ \EXE\]
MOVEM T1,CJFNBK+.GJEXT ;Set default extension
MOVEI T2,PUSHFILE ;Look for a filename
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
SETZ P1, ;Assume no JFN
CAIN T3,CONFIRM ;Was command confirmed?
JRST GTPUSH ;Yes, get JFN of standard exec
MOVE P1,T2 ;Save JFN of file to run
MOVEI T2,CONFIRM ;Wait for confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
DOPUSH: MOVX T1,CR%CAP ;Create a lower fork for exec
CFORK%
JRST NOFORK
MOVE P2,T1 ;Save lower fork process handle
HRLZS T1
HRR T1,P1
GET%
MOVEI T1,.FHSLF ;Don't allow lower fork to log out
RPCAP%
TXZ T2,SC%LOG
SETZ T3, ;No privs enabled
MOVE T1,P2 ;Get lower fork handle
EPCAP% ;Set its capabilities
MOVE T1,P2
SETZ T2,
SFRKV% ;Start the fork
WFORK% ;Wait for it to halt
KFORK% ;Kill it
MOVE T1,P1 ;Get JFN
RLJFN% ;Release JFN
NOOP
JRST RET.OK
GTPUSH: MOVX T1,GJ%OLD!GJ%PHY!GJ%SHT
HRROI T2,[ASCIZ /PS:<SYSTEM>EXEC.EXE/]
GTJFN%
JRST NOEXEC ;Failed
MOVE P1,T1 ;Store JFN
JRST DOPUSH
NOEXEC: HRROI T1,LNGWPF ;Put out warning prefix
PSOUT%
HRROI [ASCIZ /EXEC not available
/]
PSOUT%
JRST RET.ERR
NOFORK: HRROI T1,LNGWPF ;Put out warning prefix
PSOUT%
HRROI [ASCIZ /No lower forks available
/]
PSOUT%
JRST RET.ERR
PUSHFILE:
FLDDB. (.CMFIL,CM%SDH,,<filespec of EXEC to run in inferior fork>,,CONFIRM)
;Register Usage:
; P1 JFN of file to run
; P2 Offset to be added to its start address
; P3 Program name in SIXBIT
.RUN:
TRACE <.RUN>
MOVEI T2,[FLDDB. (.CMNOI,,<POINT 7,[ASCIZ \program\]>)]
PUSHJ SREG,CMD ;Look for guide word
JRST USRERR ;EOF return--command not completed
MOVX T1,GJ%OLD!GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags
HRROI T1,[ASCIZ \SYS\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device
SETZM CJFNBK+.GJNAM ;Clear default name
HRROI T1,[ASCIZ \EXE\]
MOVEM T1,CJFNBK+.GJEXT ;Set default extension
MOVEI T2,RUNFIL ;Look for a filename
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
MOVE P1,T2 ;Save JFN of file to run
SETZ P2, ;Assume an offset of zero
MOVEI T2,OFFSET ;Look for /OFFSET or confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,CONFIRM ;Was command confirmed?
JRST DORUN ;Yes--Run the program
MOVEI P2,1 ;Assume an offset of 1
MOVEI T2,RUNNUM ;Look for a number or confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,CONFIRM ;Was command confirmed?
JRST DORUN ;Yes--Run the program
MOVE P2,T2 ;Get new value of offset
MOVEI T2,CONFIRM ;Wait for confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
DORUN: JUMPL P2,BIGOFF ;Is the offset too small?
CAILE P2,1 ;Is the offset too big?
JRST BIGOFF ;Yes--Complain
;Get name of program in SIXBIT
HRROI T1,ATMBUF ;Get string in atom buffer
MOVE T2,P1 ;Get the JFN
MOVX T3,FLD(.JSAOF,JS%NAM) ;We want the name field
JFNS% ;Get the name
ERJMP MONERR
PUSHJ SREG,CVT76 ;Convert atom buffer to sixbit
MOVE P3,VREG ;Store the sixbit program name
;Get the directory of the program file if the file is on disk
MOVE T1,P1 ;Get JFN of file to run
DVCHR%
TXNN T2,DV%MDD ;Does device have multiple directories?
JRST NOTSYS ;No, not disk, so program has no system name
HRROI T1,ATMBUF ;Get string in atom buffer
MOVE T2,P1 ;Get the JFN
MOVX T3,FLD(.JSAOF,JS%DIR) ;We want the directory of file
JFNS% ;Get the directory
;Compare the directory of the program with the system's directory
; of SUBSYS. If the directories are equal, then assume that this
; program has comes from PS:<SUBSYS>.
MOVEI T1,7 ;Number of characters in ASCIZ 'SUBSYS'
MOVE T2,[POINT 7,[ASCIZ \SUBSYS\]]
MOVEI T4,7 ;May not have 7 characters, but who cares
MOVE T5,[POINT 7,ATMBUF] ;Directory of file
EXTEND T1,[CMPSN] ;Is the directory of the file SUBSYS?
SKIPA T1,P3 ;Yes--System name is name of program
NOTSYS: MOVE T1,[SIXBIT \(PRIV)\] ;System name is "(PRIV)"
MOVE T2,P3 ;Private name is name of file
SETSN% ;Tell the monitor
NOOP ;Error return is never taken
MOVEI T1,.FHSLF ;This process
SETZ T2, ;Allow UUOs
SCVEC%
HRRM P1,RUNERR ;Temp place to hold JFN
HRLZM P2,RUNOFF ;[1611] Store the start address offset
MOVSI 17,RUNCOD ;[1611] Load Run code into the registers
BLT 17,13 ;[1611] Move the code into the registers
HRRM RUNERR,RUNJFN ;[1611] Store JFN of file to run
MOVE RUNERR,.JBERR ;[1611] Get this fork's error count
;[1611] Store error count for run code
JRST 4 ;[1611] Do the run code
RUNCOD:
PHASE 0
RUNJFN:!XWD .FHSLF,.-. ; 0- .-. gets JFN of file to run
EXP -1 ; 1-Throw away pages
XWD .FHSLF,0 ; 2-Of this fork starting at page zero
EXP PM%CNT+1000 ; 3-and going through to the last page
PMAP% ; 4-Throw away pages
MOVE 1,0 ; 5-Get JFN of file to run
GET% ; 6-Map its pages
RESET% ; 7-Reset the world
RUNSTO:!ADDM 15,.JBERR ;10-Increment value of .JBERR
MOVEI 1,.FHSLF ;11-This fork
MOVE 2,14 ;12-Get value of start address offset
SFRKV% ;13-Start this fork
RUNOFF:!EXP .-. ;14- .-. gets start address offset
RUNERR:!EXP .-. ;15- .-. gets old value of .JBERR
DEPHASE
BIGOFF: HRROI T1,[ASCIZ \ Value of /OFFSET: can not be greater than 1
\]
PUSHJ SREG,FCMDERR
JRST RET.ERR ;Take Error return
RUNFIL:
FLDDB. (.CMFIL,CM%SDH,,<filespec of .EXE file to run>)
RUNNUM:
FLDDB. (.CMNUM,CM%SDH,^D8,<offset from start address, must be 0 or 1>,1,CONFIRM)
;Register usage:
; P1 JFN of indirect command file
; P2 Past value of echo switch
.TAKE:
TRACE <.TAKE>
MOVEI T2,[FLDDB. (.CMNOI,,<POINT 7,[ASCIZ \commands from\]>)]
PUSHJ SREG,CMD ;Look for guide word
JRST USRERR ;EOF return--command not completed
MOVX T1,GJ%OLD+GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device
SETZ CJFNBK+.GJNAM ;Set default name
HRROI T1,[ASCIZ \CMD\]
MOVEM T1,CJFNBK+.GJEXT ;Set default extension
MOVEI T2,TAKEFIL ;Look for a filename
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
HRRZ P1,T2 ;Save JFN of indirect command file
MOVE P2,ECHOFLG ;[1645] Assume current value of the echo switch
MOVEI T2,ECHO ;Look for echo switch or confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,CONFIRM ;Was command confirmed?
JRST TAKLVL ;[1673] Yes--Check that this /TAKE is not
; too many levels deep
HRRZ P2,(T2) ;[1645] /ECHO or /NOECHO was given--get new
; value of ECHOFLG from table entry
MOVEI T2,CONFIRM ;Wait for confirmation
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
TAKLVL: AOS T1,TDEPTH ;About to nest another level
CAIG T1,TAKLEN ;Have we nested more than max. levels deep?
JRST READF ;[1673] No--It is OK to do the /TAKE
SOS TDEPTH ;[1673] Since we didn't really nest
HRROI T1,LNGWPF ;Warning prefix
PSOUT%
HRROI T1,[ASCIZ \CMD /TAKE: commands may not be nested more than ten levels deep
\]
HRROI T1,LNGWPF ;Warning prefix on new line
PSOUT%
HRROI T1,[ASCIZ \CMD /TAKE:\] ;[1673]
PSOUT% ;[1673]
MOVEI T1,.PRIOU ;[1673] Output goes to terminal
HRRZ T2,P1 ;[1673] Get optional JFN of source
MOVE T3,[FLD(.JSSSD,JS%DEV)+FLD(.JSSSD,JS%DIR)+FLD(.JSSSD,JS%NAM)+FLD(.JSAOF,JS%TYP)+JS%PAF] ;[1673]
JFNS% ;[1673]
HRROI T1,[ASCIZ \ is ignored
\] ;[1673]
PSOUT% ;[1673]
JRST RET.OK ;[1673] Not an error, since we can recover
READF: EXCH P2,ECHOFLG ;Exchange new and old values of echo flag
MOVE T1,P1 ;JFN of take file
MOVX T2,FLD(7,OF%BSZ)+.GSNRM+OF%RD ;Ascii Chars, normal read access
OPENF%
ERJMP TAKERR
TAKLOOP:
MOVE T1,P1 ;Get JFN of /TAKE file
HRLI T1,FRMTAK ;The input is coming from a take file
HRL T2,P1 ;Input from take file
HRRI T2,.NULIO ;Throw away output
HRROI T3,PROMPT ;Prompt pointer
PUSHJ SREG,CMDINI ;Init COMND% JSYS and its state block
PUSHJ SREG,SCAN20
JUMPE VREG,TAKLOOP ;If no error and not EOF, then loop
MOVEM P2,ECHOFLG ;Restore echo flag to its old value
SOS TDEPTH ;We've come up one level of nesting
HRRZ T1,P1 ;Get JFN of indirect command file
CLOSF% ;Close file
JRST MONERR ;Failure return
JUMPL VREG,RET.OK ;If end of file, then do a normal return
JRST RET.ERR ;Otherwise, pass back that we got an error
TAKERR: HRROI T1,LNGFPF ;Fatal prefix
PSOUT%
HRROI T1,[ASCIZ \CMD Cannot open /TAKE file \]
PSOUT%
MOVEI T1,.PRIOU ;Output goes to terminal
MOVE T2,P1 ;JFN of /TAKE file
MOVE T3,[FLD(.JSSSD,JS%DEV)+FLD(.JSSSD,JS%DIR)+FLD(.JSSSD,JS%NAM)+FLD(.JSAOF,JS%TYP)+JS%PAF]
JFNS%
HRROI T1,[ASCIZ \ -- \]
PSOUT%
MOVX T1,.PRIOU ;Primary output stream
HRLOI T2,.FHSLF ;This process' most recent error
SETZ T3, ;Write all of message
ERSTR%
JRST UNKERR ;Unknown error return
JRST BADCALL ;Bad call to ERSTR% return
HRROI T1,[ASCIZ \
\]
PSOUT%
JRST RET.ERR ;Take the error return
TAKEFILE:
FLDDB. (.CMFIL,CM%SDH,,<filespec of indirect command file>)
.COMPILE:
STATE1: MOVX T1,GJ%OLD!GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags for the source file
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device for the source file
SETZM CJFNBK+.GJNAM ;No default name for the source file
HRROI T1,LNGCMD ;Get pointer to prefix of error messages
MOVEM T1,ERRPFX ;Store error message prefix
MOVEI T2,STA1 ;Look for a filespec or switch
PUSHJ SREG,FCMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,S1FILE ;Did we get a filespec?
JRST GOTSOU ;Yes--store filename
;Must have got switch
GOTSWI: HRROI T1,LNGCMD ;Get pointer to prefix of error messages
MOVEM T1,ERRPFX ;Store error message prefix
HRRZ T2,(T2) ;Get action code from selected switch
PUSHJ SREG,@(T2) ;Call the routine to process the switch
JRST STATE1
GOTSOU: AOS T1,SRCIDX ;Get index to use to store new source file JFN
CAIL T1,MAXFILES ;Does index still fit in table
JRST TOOMANY ;No--give an error message
HRRZM T2,SRCFIL(T1) ;Store JFN of source file
STATE2:
HRROI T4,LNGPSC ;ASCIZ \xxxCMD "+", switch, or confirm required -- \
MOVEM T4,ERRPFX ;Store error message prefix
MOVEI T2,STA2 ;Look for a "+", switch, or confirm
PUSHJ SREG,FCMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,S2PLUS ;Was a "+" found?
JRST STATE1 ;Yes--goto state 1
CAIN T3,CONFIRM ;Was command confirmed?
JRST STATE3 ;Yes--command is done
;Must have got a switch
HRROI T1,LNGCMD ;Get pointer to prefix of error messages
MOVEM T1,ERRPFX ;Store error message prefix
HRRZ T2,(T2) ;Get action code from selected switch
PUSHJ SREG,@(T2) ;Call the routine to process the switch
JRST STATE2 ;Stay in state 2
STATE3: PUSHJ SREG,GETDEF ;Get the default filename for /LIST and /OBJECT
PUSHJ SREG,DOCOMPILE ;Compile the program
JRST RET.OK ;Return from SCAN20
STA1:
S1FILE: FLDDB. (.CMFIL,CM%SDH,,<filespec of source file>,,S1SWIT)
S1SWIT: FLDDB. (.CMSWI,0,COMSW,<a compilation switch,>)
STA2:
S2PLUS: FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ \+\]>,<a "+" followed by filespec of the next source file>,,S2SWIT)
S2SWIT: FLDDB. (.CMSWI,0,COMSW,<a compilation switch,>,,CONFIRM)
NOSRC: HRROI T1,[ASCIZ \ No source files specified
\]
PUSHJ SREG,FCMDERR
JRST RET.OK
TOOMANY:
HRROI T1,[ASCIZ \ Too many source files
\]
PUSHJ SREG,FCMDERR
JRST RET.OK
SUBTTL GETDEF - Setup default filename for list and object files
;++
; FUNCTIONAL DESCRIPTION:
;
; This routine stores the default name for the listing and object
; files into DEFFIL. The default name is an ASCIZ string, and is
; name of the last source file, or the string "FORTRAN-OUTPUT" if
; no source files have been scanned or if the last source files
; didn't have a name.
;
; CALLING SEQUENCE:
;
; PUSHJ SREG,GETDEF
;
; INPUT PARAMETERS:
;
; None
;
; IMPLICIT INPUTS:
;
; SRCIDX The index to the last source file JFN
; SRCFIL Table of source file JFNs
;
; OUTPUT PARAMETERS:
;
; None
;
; IMPLICIT OUTPUTS:
;
; DEFFIL The ASCIZ default name string
;
; COMPLETION CODES:
;
; None
;
; SIDE EFFECTS:
;
; None
;
;--
GETDEF: HRROI T1,DEFFIL ;Get pointer to where to store default file
MOVE T2,SRCIDX ;Get index to last source file
JUMPL T2,NUL ;Negative index means no source files yet
MOVE T2,SRCFIL(T2) ;Get JFN of last source file
MOVX T3,FLD(.JSAOF,JS%NAM) ;Write only the name of the source file
JFNS% ;Convert source JFN to a string
LDB T1,[POINT 7,DEFFIL,6] ;Get first character of file name
JUMPN T1,GDRET ;Everything is fine if filename isn't null
NUL: MOVE T1,[DEFOFL,,DEFFIL]
BLT T1,DEFFIL+3-1 ;Move in the 3 word default string
GDRET: POPJ SREG, ;Return
GETSWITCH:
TRACE <GETSWITCH:>
MOVEI T2,COMPSW ;Look for compile switches
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,CONFIRM ;Was command confirmed?
POPJ SREG, ;Yes--Return
DOSWITCH:
TRACE <DOSWITCH:>
HRRZ T2,(T2) ;Get action code
PUSHJ SREG,@(T2) ;Other alternative, handle action switch
JUMPE VREG,GETSWITCH ;Need to get a new switch
JUMPL VREG,DOSWITCH ;Next switch already read--process it
POPJ SREG, ;Got confirm--return to caller
SUBTTL CMDINI -- Initilize the COMND% JSYS
;Call to this routine:
; T1 CMDSOU designator
; T2 INPUT,,OUTPUT JFN's for command
; T3 Byte pointer to ASCIZ prompt
CMDINI:
MOVEM T1,CMDSOU ;Tell error routine from where commands come
MOVEM T2,STATE+.CMIOJ ;Store I/O JFNs in COMND% state block
MOVEM T3,STATE+.CMRTY ;Store prompt pointer for COMND%
MOVEI T1,STATE ;Point at COMND% state block
MOVEI T2,[FLDDB. (.CMINI)] ;Do COMND% initialize function
COMND%
ERJMP MONERR ;This should never happen!
POPJ SREG, ;Return
SUBTTL CMD -- Do a COMND% JSYS
;Call to this routine:
; MOVEI T2,descriptor ;Get address of function descriptor
; PUSHJ SREG,CMD ;Do COMND% JSYS
; End of file return
; Normal return
;
;
;Registers, on normal return:
; T1 COMND% state Flags,,Pointer to COMND% state block
; T2 Data returned by COMND%
; T3 Address for function descriptor used (the alternative found)
CMD:
MOVEI T1,STATE ;Point at COMND% state block
COMND%
ERJMP CMERR ;Maybe end of file?
TXNE T1,CM%NOP ;Was something found?
PJRST USRERR ;Nope--a user error
CFOUND: AOS (SREG) ;Assume a normal return
HRRZ T3,T3 ;Get address of function descriptor used
CAIN T3,CONFIRM ;Was a carriage return found?
SKIPN ECHOFLG ;Is this command supposted to be echoed?
POPJ SREG, ;Take normal return
PUSH SREG,T1 ;Save value returned by COMND% JSYS
MOVE T1,STATE+.CMRTY ;Get pointer to prompt string
PSOUT% ;Echo on terminal
HRROI T1,BUFF ;Get pointer to command buffer
PSOUT% ;Echo on terminal
POP SREG,T1 ;Restore value returned by COMND% JSYS
POPJ SREG, ;Return
CMERR:
MOVX T1,.FHSLF ;This process's last error
GETER% ;Get last error in T2
HRRZ T2,T2 ;Throw away fork handle
CAIE T2,COMNX9 ;Was "error" really end of file?
CAIN T2,IOX4 ;Was "error" really end of file?
POPJ SREG, ;Yes--Take failure return
CAIE T2,COMNX2 ;Was field too long for internal buffer?
CAIN T2,COMNX3 ;Was command too long for internal buffer?
PJRST USRERR ;Yes--Show user where his command went wrong
CAIE T2,DESX1 ;[1711] Was error "invalid source designator"?
PJRST MONERR ;[1711] No--Some strange error happened
HLRZ T2,CMDSOU ;[1711] Get source of command
CAIE T2,FRMTTY ;[1711] Was source designator the terminal?
PJRST MONERR ;[1711] No--Some strange error happened
;[1711] The "error" was that the primary input JFN is illegal. This
;[1711] means that the compiler is being run as a background fork.
;[1711] Since the compiler cannot get another command string, simply
;[1711] exit.
HALTF% ;[1711]
JRST RET.OK ;[1711] Try and get a new command ...
SUBTTL FCMD -- Do a COMND% JSYS to get Source File
;Call to this routine:
; MOVEI T2,descriptor ;Get address of function descriptor
; PUSHJ SREG,FCMD ;Do COMND% JSYS
; End of file return
; Normal return
;
;
;Registers, on normal return:
; T1 COMND% state Flags,,Pointer to COMND% state block
; T2 Data returned by COMND%
; T3 Address for function descriptor used (the alternative found)
FCMD:
HRROI T4,LNGTYP ;Get pointer to possible extension
MOVEM T4,CJFNBK+.GJEXT ;Store in GTJFN% block
MOVEI T1,STATE ;Point at COMND% state block
COMND%
ERJMP CMERR ;Maybe end of file?
TXNN T1,CM%NOP ;Was something found?
PJRST CFOUND ;Yes--process
SETZM CJFNBK+.GJEXT ;Try null extension
HLRO T2,T3 ;Get back address of descriptor block for call
MOVEI T1,STATE ;Point at COMND% state block
COMND%
ERJMP CMERR ;Maybe end of file?
TXNN T1,CM%NOP ;Was something found?
PJRST CFOUND ;Yes--process
CAIE T2,NPXNOM ;No, is it "Does not match switch or keyword"?
PJRST USRERR ;No--Must have been a user error
PJRST SRCERR ;Yes, give a better message
SUBTTL SCANSW -- Scan SWITCH.INI
;Register usage:
; P1 Stores the first character of the switch line
; P2 Stores the old value of the /ECHO flag
; P3 Flag: True iff at least one line selected from SWITCH.INI
; P4 JFN of SWITCH.INI file
SCANSW:
TRACE <SCANSW:>
SKIPGE NOPTION ;Was /NOOPTION specified?
POPJ SREG, ;Yes--just return
PUSH SREG,P1 ;Save P1
PUSH SREG,P2 ;Save P2
PUSH SREG,P3 ;Save P3
PUSH SREG,P4 ;Save P4
PUSH SREG,P5 ;Save P5
PUSH SREG,P6 ;Save P6
PUSH SREG,STATE+.CMFLG ;Save the Reparse address of the COMND% JSYS
PUSH SREG,OLDSTK ;Save old "old stack pointer"
MOVEM SREG,OLDSTK ;Save stack pointer so we can abort
MOVX T1,GJ%SHT+GJ%OLD ;[1623] Short arg block, File must exist
HRROI T2,INIFIL ;[1623] Filename of SWITCH.INI is in INIFIL
GTJFN% ;[1623]
JRST NOINI ;[1623] Failure return--maybe no file at all?
HRRZ P4,T1 ;Save JFN of switch file for later use
SETZ P3, ;[1611] No lines yet selected from SWITCH.INI
MOVE P2,ECHOFLG ;Save the value of the /ECHO flag
MOVE T1,OPTECHO ;Get the value of the SWITCH.INI echo flag
MOVEM T1,ECHOFLG ;Store in new value of the echo flag
MOVE T1,P4 ;Get JFN of switch file
MOVX T2,FLD(7,OF%BSZ)+.GSNRM+OF%RD ;ASCII chars, normal read access
OPENF%
JRST [CAIN T1,OPNX31 ;[1672] Did open fail because file was offline?
JRST RET.OK ;[1672] Yes--Not an error, just return
JRST IOERR] ;[1672] No--We have a real I/O error
NEWLINE:
TRACE <NEWLINE:>
MOVE T1,P4 ;Get JFN of SWITCH.INI for BIN% JSYS
MOVE T3,[POINT 7,LNGNAM] ;Look for line starting with ...
FNDPFX: BIN%
ERJMP EOF
CAILE T2,140 ;Is character lower case?
SUBI T2,40 ;Yes--Convert to upper case
ILDB T4,T3 ;Get character from pattern
CAMN T4,T2 ;Is this the character we are looking for?
JUMPN T4,FNDPFX ;Yes--but let's not be fooled by null
JUMPN T4,REJECT ;Reject this line, if ending char wasn't null
CAIE T2,"N" ;[1611] Is character the optional "N"
JRST DIFFER ;[1611]No--make sure char doesn't differentiate
;[1611] compiler from some other program
BIN% ;[1611] Get character following the "N"
ERJMP EOF ;[1611]
CAILE T2,140 ;[1611] Is character lower case?
SUBI T2,40 ;[1611] Yes--Convert to upper case
DIFFER: CAIN T2,"-" ;Is character a hyphen
JRST REJECT ;Yes--Reject this line
CAIGE T2,"0" ;Is character outside the range of digits?
JRST GETOPT ;Yes--Try and get the option string
CAIG T2,"9" ;Is character outside the range of digits?
JRST REJECT ;No--Reject this line
CAIGE T2,"A" ;Is character outside the range of letters?
JRST GETOPT ;Yes--Try and get the option string
CAIG T2,"Z" ;Is character outside the range of letters?
JRST REJECT ;No--Reject this line
GETOPT: SKIPN OPTION ;Is the option string from /OPTION null?
JRST NOCOLON ;Yes--A selected line if it doesn't have colon
CAIE T2,":" ;Is this character a colon?
JRST REJECT ;No--Scan line for continuation
MOVE T3,[POINT 7,OPTION] ;Look for the option
FNDOPT: BIN%
ERJMP EOF
CAILE T2,140 ;Is character lower case?
SUBI T2,40 ;Yes--Convert to upper case
ILDB T4,T3 ;Get character from option pattern
CAMN T4,T2 ;Is this the character we are looking for?
JUMPN T4,FNDOPT ;Yes--but let's not be fooled by null
JUMPN T4,REJECT ;Reject this line, if ending char wasn't null
CAIN T2,"-" ;Is character a hyphen
JRST REJECT ;Yes-Reject this line
CAIGE T2,"0" ;Is character outside the range of digits?
JRST SELECT ;Yes--Select this line
CAIG T2,"9" ;Is character outside the range of digits?
JRST REJECT ;No--Reject this line
CAIGE T2,"A" ;Is character outside the range of letters?
JRST SELECT ;Yes--Select this line
CAIG T2,"Z" ;Is character outside the range of letters?
JRST REJECT ;No--Reject this line
SELECT:
TRACE <SELECT:>
SETO P3, ;[1611] At least one line has been selected
MOVE P1,T2 ;Save the unparsed character
MOVE T1,P4 ;Get JFN of COMND% input
HRLI T1,FRMSWI ;Input is coming for SWITCH.INI
HRL T2,P4 ;COMND% JSYS input comes from SWITCH.INI
HRRI T2,.NULIO ;COMND% JSYS output goes to NUL:
HRROI T3,[ASCIZ \Option: \] ;Prompt pointer
PUSHJ SREG,CMDINI ;Init COMND% JSYS and its state block
AOS STATE+.CMINC ;We have one unparsed character already
SOS STATE+.CMCNT ;Which means there is one less space in buffer
DPB P1,[POINT 7,BUFF,6] ;Store the character in COMND%'s buffer
PUSHJ SREG,SSWITCH ;Scan the switch line
JUMPE VREG,NEWLINE ;If all is OK, then look for more lines
JUMPG VREG,REJECT ;If an error occured, reject rest of line
JRST CLOSE ;If EOF, then close files
NOCOLON:
CAIE T2,":" ;Is character a colon?
JRST SELECT ;Yes--This line has been selected
REJECT:
TRACE <REJECT:>
BIN%
ERJMP EOF
CAIN T2,"!" ;Is character a exclamation point?
JRST EXCL ;Yes--look for end of comment
CAIN T2,";" ;Is character a semicolon?
JRST SEMI ;Yes--find end of line
CAIN T2,"-" ;Is character a minus sign?
JRST MINUS ;Yes--see if this line is continued
CAIE T2,.CHCRT ;Is character a carriage return?
JRST REJECT ;No--Get another character
EATLF:
BIN%
ERJMP EOF
JRST NEWLINE ;See if we want this line
EXCL: BIN%
ERJMP EOF
CAIN T2,"!" ;Is character an exclamation point?
JRST REJECT ;Yes--comment closed
CAIE T2,.CHCRT ;Is character a carriage return?
JRST EXCL ;No--get another character
JRST EATLF
SEMI:
BIN%
ERJMP EOF
CAIE T2,.CHCRT ;Is character a carriage return?
JRST SEMI ;No--get another character
JRST EATLF
MINUS:
BIN%
ERJMP EOF
CAIE T2,.CHCRT ;Is character a carriage return?
JRST REJECT ;Nope--continue scanning line
BIN% ;Eat a linefeed
ERJMP EOF
JRST REJECT ;Scan this line as a continuation of the first
EOF:
TRACE <EOF>
MOVE T1,P4 ;Get JFN of SWITCH.INI
GTSTS% ;Get status of that JFN
TXNE T2,GS%EOF ;Did end of file occur?
JRST CLOSE ;Yes--Close up and go home (to get some sleep)
IOERR: MOVEM P2,ECHOFLG ;[1645] Restore the /ECHO flag
MOVX T1,.FHSLF ;This process
GETER% ;Get last error in T2
HRRZ T2,T2 ;Throw away fork handle
HRRO T1,LNGCMD
PSOUT% ;[1672]
MOVX T1,.PRIOU ;Primary output stream
HRLOI T2,.FHSLF ;This process' most recent error
SETZ T3, ;Write all of message
ERSTR%
JRST UNKERR ;Unknown error return
JRST BADCALL ;Bad call to ERSTR% return
HRROI T1,[ASCIZ \
Error occurred while processing file SWITCH.INI from your logged-in directory
\] ;[1672]
PSOUT% ;[1672]
JRST RET.ERR ;[1672] Return and signal error
CLOSE: MOVEM P2,ECHOFLG ;[1645] Restore the /ECHO flag
MOVE T1,P4 ;Get JFN of SWITCH.INI
CLOSF% ;Close file
ERJMP IOERR
JUMPN P3,RET.OK ;[1611] If at least one line was select, all OK
SKIPN OPTION ;[1611]If the user didn't give a /OPTION switch
JRST RET.OK ;[1611] then all is OK
;The user gave a /OPTION switch but no line from SWITCH.INI matched.
;Warn user that the option string was probably mistyped.
HRROI T1,LNGWPF ;Warning prefix
PSOUT%
HRROI T1,[ASCIZ \CMD No lines from SWITCH.INI matched the /OPTION: specified.
\]
PSOUT% ;[1611]
JRST RET.OK ;Return to caller
NOINI: CAIE T1,GJFX24 ;[1623] Was file not found?
CAIN T1,GJFX18 ;[1623] Was there no such filename?
JRST RET.OK ;[1623] Yes--no switch file exits, just return
CAIN T1,GJFX19 ;[1623] Was there no such filetype?
JRST RET.OK ;[1623] Yes--no switch file exits, just return
HRROI T1,LNGWPF ;Warning prefix
PSOUT%
HRROI T1,[ASCIZ \CMD Can't read SWITCH.INI -- \] ;[1623]
PSOUT% ;[1623]
MOVX T1,.PRIOU ;[1623] Primary output stream
HRLOI T2,.FHSLF ;[1623] This process' most recent error
SETZ T3, ;[1623] Write all of message
ERSTR% ;[1623]
NOOP ;[1623] Unknown error return
NOOP ;[1623] Bad call to ERSTR% return
HRROI T1,[ASCIZ \
\] ;[1623]
PSOUT% ;[1623]
JRST RET.OK ;[1623]
SSWITCH:
PUSH SREG,P1 ;Save P1
PUSH SREG,P2 ;Save P2
PUSH SREG,P3 ;Save P3
PUSH SREG,P4 ;Save P4
PUSH SREG,P5 ;Save P5
PUSH SREG,P6 ;Save P6
PUSH SREG,STATE+.CMFLG ;Save the Reparse address of the COMND% JSYS
PUSH SREG,OLDSTK ;Save old "old stack pointer"
MOVEM SREG,OLDSTK ;Save stack pointer so we can abort
PUSHJ SREG,GETSWITCH ;Scan Switches
JRST RET.OK ;Take normal return.
;Note that this routine may abort. If it aborts,
;VREG will have the value:
; -1 if a EOF occured
; 1 if an error occured
;If nothing when wrong, this routine will return and
;VREG will have the value zero.
SUBTTL Command Line Error Routines
SRCERR:
SKIPN ECHOFLG ;Is this command supposted to be echoed?
JRST SRCER1 ;No--skip over echoing
MOVE T1,STATE+.CMRTY ;Get pointer to prompt string
PSOUT% ;Echo on terminal
HRROI T1,BUFF ;Get pointer to command buffer
PSOUT% ;Echo on terminal
SRCER1:
HRROI T1,LNGCMD ;Get pointer to prefix of error messages
ESOUT% ;Write it out
HRROI T1,[ASCIZ /Does not match keyword, or file not found/]
PSOUT% ;Give better message
JRST USRER1 ;Finish off error
USRERR:
TRACE <USRERR>
SKIPN ECHOFLG ;Is this command supposted to be echoed?
JRST NOECHO ;No--skip over echoing
MOVE T1,STATE+.CMRTY ;Get pointer to prompt string
PSOUT% ;Echo on terminal
HRROI T1,BUFF ;Get pointer to command buffer
PSOUT% ;Echo on terminal
NOECHO:
MOVE T1,ERRPFX ;Get prefix string of error message
ESOUT%
MOVX T1,.PRIOU ;Primary output stream
HRLOI T2,.FHSLF ;This process' most recent error
SETZ T3, ;Write all of message
ERSTR%
JRST UNKERR ;Unknown error return
JRST BADCALL ;Bad call to ERSTR% return
; This section of code determines the number of unparsed characters
; that are in the command buffer minus the number of characters
; that terminated the command. The number of terminating chars
; is one except in the case of line-feed, which may be preceded
; by a carriage return. Register P1 will hold the result.
USRER1: MOVE P1,STATE+.CMINC ;Get number of unparsed chars in buffer
MOVE T1,P1 ;Copy set up for ADJBP
SOJ P1, ;Last char is terminator--don't count it
ADJBP T1,STATE+.CMPTR ;Get ptr to last char of text unparsed
LDB T3,T1 ;Get last char
CAIE T3,.CHLFD ;Was character a linefeed?
JRST OUT ;No, we now know length of unparsed string
SETO T2, ;T2 gets minus one
ADJBP T2,T1 ;Backup byte pointer, put it in T2
LDB T3,T2 ;Get new last char
CAIN T3,.CHCRT ;Is character a carriage return?
SOJ P1, ;Yes, don't count it
OUT:
HRROI T1,[ASCIZ \ -- "\]
PSOUT%
MOVX T1,.PRIOU ;Type on terminal
MOVE T2,STATE+.CMPTR ;Get ptr to text left unparsed
MOVN T3,P1 ;Get negative count
CAIE T3,0 ;If there is some error text
SOUT% ; then write it out
HRROI T1,[ASCIZ \"
\]
PSOUT%
HLRZ T4,CMDSOU ;Get source of command
CAIN T4,FRMTTY ;Did the command come from the terminal?
JRST RET.ERR ;Yes--Don't tell user where command came from
HRROI T1,[ASCIZ \Error occurred while processing \]
PSOUT%
MOVE T1,FRMTAB-1(T4) ;Get source message
PSOUT%
HRRZ T2,CMDSOU ;Get optional JFN of source
JUMPE T2,WRIRET ;If no JFN, then write final return-linefeed
MOVEI T1,.PRIOU ;Output goes to terminal
MOVE T3,[FLD(.JSSSD,JS%DEV)+FLD(.JSSSD,JS%DIR)+FLD(.JSSSD,JS%NAM)+FLD(.JSAOF,JS%TYP)+JS%PAF]
JFNS%
WRIRET: HRROI T1,[ASCIZ \
\]
PSOUT%
JRST RET.ERR ;Return and signal error
FRMTAB: POINT 7,[ASCIZ \arguments from the EXEC\]
POINT 7,[ASCIZ \command file \] ;[1657]
POINT 7,[ASCIZ \switch file \]
POINT 7,[ASCIZ \a TOPS-10 command line\]
MONERR:
HRROI T1,LNGCMD
ESOUT%
MOVX T1,.PRIOU ;Primary output stream
HRLOI T2,.FHSLF ;This process' most recent error
SETZ T3, ;Write all of message
ERSTR%
JRST UNKERR ;Unknown error return
JRST BADCALL ;Bad call to ERSTR% return
PJRST WRIRET ;Write final CR/LF and return
UNKERR:
TRACE <UNKERR>
HRROI T1,[ASCIZ \Unknown error
\]
PSOUT%
JRST RET.ERR ;Return and signal error
BADCALL:
TRACE <BADCALL>
HRROI T1,[ASCIZ \Bad call to ERSTR%
\]
PSOUT%
JRST RET.ERR ;Return and signal error
SUBTTL Return Code
RET.ERR: MOVEI VREG,1 ;Return value of 1 means error encountered
JRST RESTOR
RET.OK: TDZA VREG,VREG ;RETURN value of 0 means that all is OK
RET.EOF: SETO VREG, ;Return value of -1 means EOF was encountered
RESTOR: MOVE SREG,OLDSTK ;Recover the original stack pointer
POP SREG,OLDSTK
POP SREG,STATE+.CMFLG ;Restore the Reparse address for COMND% JSYS
POP SREG,P6 ;Restore P6
POP SREG,P5 ;Restore P5
POP SREG,P4 ;Restore P4
POP SREG,P3 ;Restore P3
POP SREG,P2 ;Restore P2
POP SREG,P1 ;Restore P1
POPJ SREG, ;Return
SUBTTL SCAN10 - The TOP-10 Compatibility Command Scanner
;Register Usage:
; P1 Location to return to after processing a switch
; P2 Flag--Has an object file been specified?
; P3 Flag--Has a list file been specified?
SCAN10:
SETOM FLAG10 ;Set scanned by SCAN10
PUSH SREG,P1 ;Save P1
PUSH SREG,P2 ;Save P2
PUSH SREG,P3 ;Save P3
PUSH SREG,P4 ;Save P4
PUSH SREG,P5 ;Save P5
PUSH SREG,P6 ;Save P6
PUSH SREG,STATE+.CMFLG ;Save the Reparse address of the COMND% JSYS
PUSH SREG,OLDSTK ;Save old "old stack pointer"
MOVEM SREG,OLDSTK ;Save stack pointer so we can abort
MOVEI T1,XREP10 ;Get address of code to handle a reparse
HRRM T1,STATE+.CMFLG ;Store in state block
JRST OBJ10
XREP10:
TRACE <XREP10>
MOVE SREG,OLDSTK ;Restore the stack pointer
SKIPL T1,BINJFN ;Get JFN of object file
RLJFN% ;Release JFN
ERJMP MONERR
SKIPL T1,LSTJFN ;Get JFN of list file
RLJFN% ;Release JFN
ERJMP MONERR
SKIPGE T5,SRCIDX ;Get index to JFN of last source file
JRST OBJ10 ;No source file JFN's
XRL: MOVE T1,SRCFIL(T5) ;Get JFN of next source file
RLJFN% ;Release JFN
ERJMP MONERR
SOJGE T5,XRL ;Loop to release rest of source file JFN's
OBJ10:
PUSHJ SREG,INITFL ;Clear flags
SETOM LSTJFN ;Clear JFN of list file
SETOM BINJFN ;Clear JFN of object file
SETOM SRCIDX ;No source files have JFN's
SETZM LSTTYP ;Throw away typescript from /LIST:
SETZM OPTECHO ;Don't echo options from SWITCH.INI
SETZM NOPTION ;/NOOPTION has not been seen--read SWITCH.INI
SETZM OPTION ;No option string has been given
SETZM DEFFIL ;No default source file yet
HRROI T4,LNGCMD
MOVEM T4,ERRPFX ;Store error message prefix
SETZB P2,P3 ;Assume /NOOBJECT and /NOLIST
SKIPE .COBSW ;Unless its Cobol
SETOB P2,P3 ;Then we assume both by default
MOVEI P1,. ;Location to return to if a switch is found
MOVX T1,GJ%FOU+GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags for object file
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device for object file
SETZM CJFNBK+.GJNAM ;No default name for object file
HRROI T1,[ASCIZ \REL\]
MOVEM T1,CJFNBK+.GJEXT ;Set default extension for object file
MOVEI T2,OFILE ;Look for a filename
SKIPE .COBSW ;If Cobol
MOVEI T2,OHYPHN ;Allow "-" also
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,OCMPSW ;Was a switch found?
JRST DOSW ;Yes--Process the switch
CAIN T3,CONFIRM ;Was a carriage return found?
JRST ERR1 ;Yes--Give error message
CAIN T3,EQUAL ;Was an equal sign found?
JRST SOU10 ;Yes--Get source files
CAIN T3,COMMA1 ;Was a comma found?
JRST LIST10 ;Yes--Get listing file
CAIN T3,OHYPHN ;Was a hyphen found?
JRST NOOBJ ;Yes--no object file wanted
SETO P2, ;Got a object file
HRRZM T2,BINJFN ;Store its JFN
MOVX T1,RELFLG ;Get flag that says a .REL file is being made
IORM T1,ONFLG ;Turn on flag that says a .REL file is made
ANDCAM T1,OFFFLG ;Turn off the no .REL file flag
MOVEI P1,. ;Come back here if switch is found
MOVEI T2,COMMA1 ;Look for a comma, switch, equals
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,OCMPSW ;Was a switch found?
JRST DOSW ;Yes--Process the switch
CAIN T3,CONFIRM ;Was a carriage return found?
JRST ERR1 ;Yes--Give error message
CAIN T3,EQUAL ;Was an equal sign found?
JRST SOU10 ;Yes--Get source file
JRST LIST10
NOOBJ: SETZ P2, ;Signal no object file wanted
MOVEI T2,COMMA1 ;Look for "," or "=" at this point
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return, command not completed
CAIN T3,COMMA1 ;Was a comma found?
JRST LIST10 ;Yes, get listing file
CAIN T3,EQUAL ;Was an equal sign found?
JRST SOU10 ;Yes, get source file
CAIN T3,CONFIRM ;Was a carriage return found?
JRST ERR1 ;Yes, give error message
LIST10:
MOVEI P1,. ;Location to return to if a switch is found
MOVX T1,GJ%FOU+GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags of list file
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device of list file
SETZM CJFNBK+.GJNAM ;No default name of list file
HRROI T1,[ASCIZ \LST\]
MOVEM T1,CJFNBK+.GJEXT ;Set default extension of list file
MOVEI T2,LFILE ;Look for a comma, switch, equals
SKIPE .COBSW ;If Cobol
MOVEI T2,LHYPHN ;Allow "-" also
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,OCMPSW ;Was a switch found?
JRST DOSW ;Yes--Process the switch
CAIN T3,CONFIRM ;Was a carriage return found?
JRST ERR1 ;Yes--Give error message
CAIN T3,EQUAL ;Was a equal sign found?
JRST SOU10 ;Yes--Get source file
CAIN T3,LHYPHN ;Was a hyphen found?
JRST NOLIST ;Yes--no listing file wanted
SETO P3, ;Got a listing file
HRRZM T2,LSTJFN ;Store its JFN
MOVE T1,[POINT 7,ATMBUF]
MOVE T2,[POINT 7,LSTTYP]
L10CPY: ILDB T3,T1 ;Copy what the user typed . . .
IDPB T3,T2 ;. . . into the area to hold his typescript
JUMPN T3,L10CPY ;Copy until null byte is found
MOVEI P1,. ;Come back here if a switch is found
MOVEI T2,EQUAL ;Look for a equal sign or switch
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,OCMPSW ;Was a switch found?
JRST DOSW ;Yes--Process the switch
CAIN T3,CONFIRM ;Was a carriage return found?
JRST ERR1 ;Yes--Give error message
JRST SOU10
NOLIST: SETZ P3, ;Signal no listing file wanted
MOVEI T2,EQUAL ;Look for "=" at this point
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST USRERR ;EOF return, command not completed
CAIN T3,EQUAL ;Was an equal sign found?
JRST SOU10 ;Yes, get source file
CAIN T3,CONFIRM ;Was a carriage return found?
JRST ERR1 ;Yes, give error message
SOU10:
MOVEI P1,. ;Come back here is a switch is found
MOVX T1,GJ%OLD!GJ%XTN
MOVEM T1,CJFNBK+.GJGEN ;Set default flags for source file
HRROI T1,[ASCIZ \DSK\]
MOVEM T1,CJFNBK+.GJDEV ;Set default device for source file
SETZM CJFNBK+.GJNAM ;No default name for source file
LOOP10:
MOVEI T2,SFILE ;Look for a source file or switch
PUSHJ SREG,FCMD ;Do COMND% JSYS
JRST USRERR ;EOF return--command not completed
CAIN T3,OCMPSW ;Was a switch found?
JRST DOSW ;Yes--Process the switch
CAIN T3,CONFIRM ;Was a carriage return found?
JRST NOSRC ;Yes--Give no src err messge
AOS T1,SRCIDX ;Get index to use to store new source file JFN
CAIL T1,MAXFILES ;Does index still fit in table
JRST TOOMANY ;No--give an error message
HRRZM T2,SRCFIL(T1) ;Store JFN of source file
MOVEI P1,. ;Come back here if a switch is found
MOVEI T2,COMMA2 ;Look for a comma, switch, or confirm
PUSHJ SREG,CMD ;Do COMND% JSYS
JRST EOC ;EOF return--Command is done, call compiler
CAIN T3,CONFIRM ;Was a carriage return found?
JRST EOC ;Yes--Call compiler
CAIE T3,OCMPSW ;Was a switch found?
JRST LOOP10 ;No--Loop to get source file
DOSW:
HRRZ T2,(T2) ;Get action code
PUSHJ SREG,@(T2) ;Other alternative, handle action switch
JUMPE VREG,(P1) ;Return to processing command line
JUMPL VREG,DOSW ;Next switch already read--process it
EOC:
HRROI T1,DEFFIL ;Get pointer to where to store default file
MOVE T2,SRCIDX ;Get index to last source file
MOVE T2,SRCFIL(T2) ;Get JFN of last source file
MOVX T3,FLD(.JSAOF,JS%NAM) ;Write only the name of the source file
JFNS% ;Convert source JFN to a string
LDB T1,[POINT 7,DEFFIL,6] ;Get first character of file name
JUMPN T1,EOC1 ;Everything is fine if filename isn't null
MOVE T1,[DEFOFL,,DEFFIL]
BLT T1,DEFFIL+3-1 ;Move in the 3 word default string
EOC1:
JUMPN P2,CHKLST ;Was an object file specified?
MOVX T3,RELFLG ;No-Get flag object file flag
ANDCAM T3,ONFLG ;Turn off bit that might say that flag is true
IORM T3,OFFFLG ;Turn on bit that says that flag must be false
CHKLST: SKIPN P3 ;Was a list file specified?
PUSHJ SREG,.NOLIST ;No--Make sure list flags are turned off
PUSHJ SREG,DOCOMPILE ;Compile this program
JRST RET.OK
ERR1: HRROI T1,[ASCIZ \ You may not end a TOPS-10 style command at this point
\]
PUSHJ SREG,FCMDERR
JRST RET.OK
SUBTTL TOPS-20 parse functions
ACTVRB:
FLDDB. (.CMKEY,0,VRBKEY,<Command,>,,ACTNSW)
ACTNSW: FLDDB. (.CMSWI,CM%SDH,ACTSW,,,CMFILE)
CMFILE: FLDDB. (.CMFIL,CM%SDH,,<filespec of source file to implicitly begin COMPILE command>,,CMSW)
CMSW: FLDDB. (.CMSWI,0,COMSW,<switch to implicitly begin COMPILE command,>)
COMPSW: FLDDB. (.CMSWI,0,COMSW,<a compilation switch,>,,CONFIRM)
CONFIRM:
FLDDB. (.CMCFM)
OFFSET: FLDDB. (.CMSWI,0,OFFSX,,,CONFIRM)
ECHO:
FLDDB. (.CMSWI,0,ECHOX,,,CONFIRM)
COMMA.: FLDDB. (.CMCMA,CM%SDH,,<"," or ")">,,LEFTP)
LEFTP: FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ \)\]>)
SUBTTL TOPS-10 only parse functions
OCMPSW: FLDDB. (.CMSWI,0,OCOMSW,<a compilation switch,>,,CONFIRM)
OFILE: FLDDB. (.CMFIL,CM%SDH,,<filespec of output file>,,EXCLAM)
LFILE: FLDDB. (.CMFIL,CM%SDH,,<filespec of listing file>,,EQUAL)
SFILE: FLDDB. (.CMFIL,,,,,OCMPSW)
EXCLAM:; FLDDB. (.CMTOK,,<POINT 7,[ASCIZ \!\]>,,,COMMA1)
COMMA1: FLDDB. (.CMCMA,,,,,EQUAL)
EQUAL: FLDDB. (.CMTOK,,<POINT 7,[ASCIZ \=\]>,,,OCMPSW)
COMMA2: FLDDB. (.CMCMA,,,,,PLUS)
PLUS: FLDDB. (.CMTOK,,<POINT 7,[ASCIZ \+\]>,,,OCMPSW)
OHYPHN: FLDDB. (.CMTOK,,<POINT 7,[ASCIZ \-\]>,,,OFILE) ;Cobol only
LHYPHN: FLDDB. (.CMTOK,,<POINT 7,[ASCIZ \-\]>,,,LFILE) ;Cobol only
SUBTTL Switch tables
SUBTTL Function block for the COMND% JSYS
ABBRIV==CM%FW ! CM%INV ! CM%ABR
INVIS==CM%FW ! CM%INV
DEFINE TBL(STRING,FLAGS,ACTION)<
IFE FLAGS, <XWD [ASCIZ \'STRING\],ACTION>
IFN FLAGS, <XWD [EXP FLAGS
ASCIZ \'STRING\],ACTION>
>
ACTSW: XWD ACTSWL,ACTSWL ;Count of number of entries
; TBL <COMPILE>,,.COMPILE
TBL <EXIT>,,.EXIT
TBL <HELP>,,.HELP
; TBL <OLD-STYLE-SCANNER>,,.OLD
TBL <PUSH:>,,.PUSH
TBL <RUN:>,,.RUN
TBL <TAKE:>,,.TAKE
ACTSWL==.-ACTSW-1
VRBKEY: XWD VRBKYL,VRBKYL ;Count of number of entries
TBL <COMPILE>,,.COMPILE
TBL <EXIT>,,.EXIT
TBL <HELP>,,.HELP
TBL <OLD-STYLE-SCANNER>,,.OLD
TBL <PUSH>,,.PUSH
TBL <RUN>,,.RUN
TBL <TAKE>,,.TAKE
VRBKYL==.-VRBKEY-1
ECHOX: XWD 2,2
TBL <ECHO>,,1
TBL <NOECHO>,,0
OFFSX: XWD 2,2
TBL <OFFSET:>,,0
TBL <RUNOFFSET:>,INVIS,0
SUBTTL Standard switch actions
.ECHOOP:
TRACE <.ECHO-OPTION>
SETOM OPTECHO ;Echo the switches read from SWITCH.INI
OKRET: SETZ VREG, ;Signal that next switch has not been scanned
POPJ SREG, ;Get next switch
.NOOPTION:
TRACE <.NOOPTION>
SETOM NOPTION ;Do not read SWITCH.INI
JRST OKRET ;Go get next switch
.OPTION:
TRACE <.OPTION>
MOVEI T2,[FLDDB.(.CMFLD,CM%SDH,,<option name>)]
PUSHJ SREG,CMD ;Try and get option string
JRST RET.ERR ;EOF return--error command not completed
MOVE T1,[POINT 7,ATMBUF] ;Get pointer to option string
MOVE T2,[POINT 7,OPTION] ;Get pointer to where to store it
MOVEI T3,^D40 ;Get max. number characters allowed (including
;null character that ends string)
OPTLP: SOJL T3,OPTLNG ;Jump if option becomes too long
ILDB T4,T1 ;Get a character of the option string
CAILE T4,140 ;Is character lower case?
SUBI T4,40 ;Yes--Convert to upper case
IDPB T4,T2 ;Store in its new home
JUMPN T4,OPTLP ;Loop until null is copied
CAIE T3,^D39 ;Skip if option is too short
JRST OKRET ;Signal that next switch has not been scanned
OPTSHT: SKIPA T1,[POINT 7,[ASCIZ \ Option name was not specified
\]]
OPTLNG: HRROI T1,[ASCIZ \ Option name may not exceed 39 characters
\]
PUSHJ SREG,FCMDERR
JRST RET.ERR
SUBTTL STANDARD ERROR PROCESSORS
;Type message using ESOUT%
;Enter with T1 = text string
FCMDERR:
PUSH SREG,T1
HRROI T1,LNGCMD ;Normal prefix
ESOUT%
POP SREG,T1
PSOUT%
POPJ SREG,
END