Google
 

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