COMMENT ⊗   VALID 00017 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TENX<TENEX COMMAND SCANNER
C00005 00003	DSCR	COMND
C00009 00004	CMDSCN:	
C00014 00005	GOSUB:	IDPB	A,CMDPTR		SAVE WHATEVER CHAR IT WAS
C00017 00006	SUBCMD:	SKIPE	RPGSW
C00018 00007
C00020 00008	GETLST:
C00021 00009	PSWIT:
C00023 00010	DONE:	
C00025 00011	DSCR	Routines to print out info
C00027 00012
C00028 00013	DSCR	Typing routines
C00030 00014	DSCR	Long form GTJFN tables.
C00032 00015
C00037 00016
C00038 00017
C00039 ENDMK
C⊗;
TENX<;TENEX COMMAND SCANNER


ZERODATA (TENEX COMMAND SCANNER)

?BINJFN: 0
?LISJFN: 0
BAIL<
?SM1JFN: 0		;FOR DEBUGGER
?SM1PNT: 0
?SM1CNT: 0
SM1SIZ←←200
?SM1BUF: BLOCK SM1SIZ
>;BAIL
;SRCJFN is in switched/cleared area, along with SRCFLN
?DEFFLN: BLOCK 11		;DEFAULT FILE NAME FOR .LST, .REL FILES
SAIJFN:	0
NAMPTR:	0
SAVEP:	0
NXTPTR:	0
NAMES:	BLOCK 50		;ENOUGH FOR A LOT OF CHARS!
?XTBFIL: BLOCK 40		;NAME OF THE XSAIL BINARY FILE
?XTSFIL: BLOCK 40		;NAME OF THE XSAIL SM1 FILE (BAIL SYMBOLS)
?CMDLIN:BLOCK 100		;COMMAND LINE
CMDPTR:	0			;POINTS TO COMMAND LINE
CMDJFN:	0			;JFN FOR COMMANDS

SWTTXT:	BLOCK 10		;TEXT FOR SWITCHES
SWTPTR:	0			;POINTER TO ABOVE


RFMODB:	0			;TEMPORARIES FOR TTY MODE SETTINGS
RFCOCB:	0
RFCOCC:	0

LODMOD:	0			;SET TO TRUE IF LOADING
LODDDT:	0			;LOADING WITH DDT
LODSDT:	0			;LOADING WITH SDDT

ENDDATA

DATA
HRLDON:	0			;TRUE IF WE HAVE PRINTED THE MESSAGE ONCE
pdlsav:	0			;save pushdown stack pointer here
monf:	0			; greater than 0 if tops-20
tmpcnt:	0			; number of chars passed by EXEC
ENDDATA

HERALD:	BLOCK 25		;PUT IN HIGH CORE SINCE WE WILL SET IT THEN 
				;SSAVE CORE IMAGE AFTER LOADING







DSCR	COMND

CAL	PUSHJ

RET	+1 if unsuccessful
	+2 if successful

⊗
	;opdefs for TOPS-20

	opdef erjmp[320700000000]
	opdef ercal[320740000000]

	
COMND:	
	setzm monf		;assume not tops-20
	move a,[%cnmnt,,.gtcnf]	;get monitor type from configuration table
	gettab a,		; with universal gettab
	ercal jshlt0		;shouldnt fail
	ldb a,[point 6,a,23]	;get type field
	caie a,4		;is it tops-20?
	jrst nott20		;no, use tenex parser
	movem a,monf		;yes, + means tops-20
	skipn rpgsw		;just did ccl entry?
	skipe tmpcnt		;or still working on one?
	jrst docc20		;yes, go use tops-20 ccl command parser
	pushj p,usr20		;no, use tops-20 user interface
	jrst skptnx		;skip the tenex command parser
docc20:	pushj p,ccl20		;parse command from exec
	jrst skptnx		;skip the tenex command parser
nott20:
IMSSS<
	SKIPN	RPGSW		;CALLED IN RPGMODE?
	  JRST	NORPG		;NO

	SETO	A,
	MOVEI	B,TMPCBF	;GET BUFFER
	JSYS	GTINF	
	  JFCL
NOSUMEX,<
	SKIPN	TMPCBF+6
>;
SUMEX,<
	SKIPN	TMPCBF+21	;SOMETHING THERE?
>;
	  JRST	NORPG
IFN 0,<
   	HRROI	A,[ASCIZ/
Tenex SAIL:
/]
   	JSYS	PSOUT
>;IFN 0
SUMEX,<
	MOVE	A,[POINT 7,TMPCBF+21,-1]	;BP
>;SUMEX
NOSUMEX,<
	MOVE	A,[POINT 7,TMPCBF+6,-1]		;BP
>;NOSUMEX
	MOVEM	A,CMDJFN	;USE FOR THE COMMAND SOURCE	
IFN 0,<	JSYS	PSOUT>
	JRST	NORPG1		;SKIP OVER SETZM
>;IMSSS
NORPG:	
NOIMSSS<
	SETZM	RPGSW
>;NOIMSSS
	SETZM	CMDJFN		;START WITH NOTHING

NORPG1:	MOVEI	A,101		;SET TTY FOR COMMAND SCANNER
	JSYS	RFMOD
	MOVEM	B,RFMODB
	TRO	B,170000	;WAKE UP ON EVERYTHING
	JSYS	SFMOD
	MOVEI	A,101
	JSYS	RFCOC
	MOVEM	B,RFCOCB
	MOVEM	C,RFCOCC
	TRZ	B,006000	;NOTHING FOR ↑L
	TRZ	C,600000	;NOTHING FOR ↑R
	JSYS	SFCOC		

	PUSHJ	P,CMDSCN	;GET BIN AND LST JFN'S

	MOVEI	A,101		;RESET TTY MODES
	MOVE	B,RFMODB
	JSYS	SFMOD
	MOVEI	A,101
	MOVE	B,RFCOCB
	MOVE	C,RFCOCC
	JSYS	SFCOC
skptnx:				;here's where tops-20 rejoins
	TLZ	FF,LISTNG+BINARY;ASSUME NEITHER
	MOVE	A,BINJFN	
	JUMPL	A,TRYLST	;NO BIN FILE
	MOVE	B,[XWD 440000,100000] ;OPEN BINARY FILE
	JSYS	OPENF
	  JRST	NOBIN		;CAN'T OPEN IT
	TLO	FF,BINARY	;MADE IT
BAIL<
	SKIPLE	BAILON
	PUSHJ	P,SM1INI	;INITIALIZE .SM1 FILE
>;BAIL
TRYLST:	MOVE	A,LISJFN
	JUMPL	A,GETSRC	;NO LISTING,GO ON TO SRC
	MOVE	B,[XWD 70000,100000]
	JSYS	OPENF
	  JRST	NOLST2		;NO CAN DO
	TLO	FF,LISTNG
BAIL<
	SKIPLE	BAILON
	PUSHJ	P,SM1LST	;ENTER LISTING FILE BLOCK INTO .SM1 FILE
>;BAIL
	JRST	GETSRC		;ACTUALLY READ THE SOURCE FILE NOW

NOBIN:	ERR	<Cannot OPENF binary file.[CR for TENX message]>,1
	MOVEI	D,.+2
	JRST	ERROR
	JRST	TRYLST
NOLST2:	ERR	<Cannot OPENF listing file.[CR for TENX message]>,1
	MOVEI	D,.+2
	JRST	ERROR
	JRST	GETSRC

EOLC ←← 37
COMMA ←← ","
ESCAPE ←← 33
SWCH ←← "@"
QRBOUT ←← 177		;abort command on rubout
CTRLU←←"U"-100		;also on control-U
QMARK←←"?"		;for help
CTRLR←←"R"-100		;for .REL file
SLASH←←"/"		;for switches
SPACE←←" "		;SPACE
CTRLL←←"L"-100		;for .LST file
CTRLQ←←"Q"-100		;for halting
CTRLX←←"X"-100
CTRLA←←"A"-100
SRCBSZ←←200		;SIZE IN WRDS OF SRC FILE BUFFERS


DEFINE BACKUP <PUSHJ P,.BACKUP>		;BACK UP POINTER OR JFN
DEFINE NXTCHR <PUSHJ P,.NXTCHR>		;GET THE NEXT CHAR
CMDSCN:	
	skipg monf			;are we on tops-20?
	jrst cmdsca			;no, use usual scanner
	skipg tmpcnt			;are we doing rescanned input?
	jrst usr20			;no, use tops-20 user interface
	jrst ccl20			;yes, continue ccl file
cmdsca:
	SKIPN	XTFLAG			;EXTENDED COMPILATION?
	  JRST	CMDSC1			;NO
	HRROI	A,[ASCIZ/TENEX SAIL Extended compilation
/]
	JSYS	PSOUT
	JRST	NOHRLD			;AND DONT PRINT OUT OTHER HERALD
CMDSC1:
	SKIPE	HRLDON			;OR ALREADY PRINTED HERALD 
 	  JRST	NOHRLD			;THEN DONT PRINT AGAIN
	HRROI	A,HERALD
	SKIPE	RPGSW
	  HRROI	A,[ASCIZ/TENEX SAIL:  /]
	JSYS	PSOUT
NOHRLD:
	SETOM	HRLDON
	MOVEM	P,SAVEP
GETSAI:	MOVE	A,[POINT 7,NAMES,-1]
	MOVEM	A,NAMPTR
	MOVE	A,[POINT 7,CMDLIN,-1]
	MOVEM	A,CMDPTR
	SETZM	LODDDT
	SETZM	LODMOD
	SETZM	LODSDT
	SETZM	DEFFLN			;MARK THAT WE DONT YET HAVE A DEFAULT NAME
	SETOM	LISJFN			;ASSUME NO LISTING FILE
	SETZM	BINJFN			;ASSUME WANT A BINARY
	SKIPE	RPGSW
	  JRST	.+3
	HRROI	A,[ASCIZ/
*/]
	JSYS	PSOUT
GETSA1:	MOVEI	D,GETSAI		;FOR ERROR RETURN
	NXTCHR				;PEEK AHEAD BEFORE GTJFN
	CAIN	A,QMARK			;A QUESTION MARK?
	   JRST	QUERY			;AND RETURN TO GETSAI
	BACKUP				;BUT DONT GET CARRIED AWAY WITH PEEKING!
GETSA2:	MOVEI	A,ESAI
	MOVE	B,CMDJFN		;START WITH INPUT FROM HERE
	JSYS	GTJFN
	  JRST	.+2
	JRST	GOTSAI
	MOVEM	B,CMDJFN		;SAVE POINTER
	MOVE	B,A			;SAVE ERROR NUMBER
	CAIN	B,600104		;"OLD FILE REQUIRED" ??
	  JRST	ERROR			;YES, COMPLAIN
	BACKUP	
	NXTCHR
	CAIE	A,"←"			;PERHAPS DOES NOT WANT A BINARY
	CAIN	A,"="			;ALSO ALLOW "="
	  JRST	GETSA3
	 JRST	GETSA4
GETSA3:	SETOM	BINJFN			;INDICATE NO BINARY
	IDPB	A,CMDPTR
	JRST	GETSA1
GETSA4:	CAIE	A,QRBOUT	
	CAIN	A,CTRLU
	  JRST	CMDRES			;RESET COMMAND THING
	CAIN	A,CTRLQ
	  JRST	DOHLT
	CAIN	B,600115		;NULL COMMAND -- ALLOW IT
	  JRST	GETSAI			;REPRINT "*" AND DO ANOTHER GTJFN
	JRST	ERROR			;SOMETHING ELSE IS WRONG -- TELL THE USER

GOTSAI:	MOVEM	A,SAIJFN		;SAVE THE JFN
	MOVEM	B,CMDJFN
	MOVE	A,NAMPTR
	HRRZ	B,SAIJFN
	SETZ	C,
	JSYS	JFNS
	MOVEM	A,NAMPTR

	MOVE	A,CMDPTR
	HRRZ	B,SAIJFN
	MOVE	C,[XWD 221100,1]
	JSYS	JFNS
	MOVEM	A,CMDPTR
	
	SKIPE	DEFFLN			;DO WE ALREADY HAVE A DEFAULT NAME?
	  JRST	GTDFFN			;YES
	HRROI	A,DEFFLN		;GET THE DEFAULT FILENAME FOR OTHER THINGS
	HRRZ	B,SAIJFN	
	MOVSI	C,2000			;FILENAME ONLY
	JSYS	JFNS
	SETZ	C,0
	IDPB	C,A			;PUT A NULL BYTE ON THE END

GTDFFN:	HRRZ	A,SAIJFN		;GET RID OF SOURCE JFN FOR NOW
	JSYS	RLJFN
	  JFCL

	BACKUP
	NXTCHR
	CAIN	A,ESCAPE
	  NXTCHR
	CAIN	A,CTRLQ
	  JRST	DOHLT
	CAIN	A,CTRLU
	  JRST	CMDRES
        CAIE	A,"←"			;
	CAIN	A,"="			;ALSO ALLOW "="
	   SKIPA
	 JRST NOWNLD
	IDPB	A,CMDPTR		;SAVE IT I GUESS
	SETOM	LODMOD			;
	SETOM	LODDDT
	JRST	DONE			;MUST BE DONE -- TYPED AN ARROW
NOWNLD:
	CAIN	A,EOLC			;DONE IF EOL
	  JRST 	DONE
	CAIE	A,COMMA			;IS IT A COMMA
	  JRST	DUNCMA			;NO -- RANDOM FILE CHARACTER?
ISCMA:	IDPB	A,CMDPTR		;SAVE THE COMMA
	NXTCHR
	CAIE	A,EOLC			;IF AN EOL
	CAIN	A,SPACE			;OR SPACE
	  JRST	GOSUB			;THEN SUBCOMMAND
	CAIE	A,"←"
	CAIN	A,"="
	  JRST	[SETOM	LODMOD
		 SETOM LODDDT
		 JRST	GOSUB]
DUNCMA:	BACKUP				;MUST BE A FILE NAME -- PUT THE CHAR BACK
	SETZ	A,
	IDPB	A,NAMPTR		;SEPARATE THE NAMES WITH NULLS
	JRST	GETSA2			;FOR GTJFN

GOSUB:	IDPB	A,CMDPTR		;SAVE WHATEVER CHAR IT WAS
	SKIPE	RPGSW
	  JRST	SUBCMD
	HRROI	A,[ASCIZ/
/]
	JSYS	PSOUT
BAIL<
	JRST	SUBCMD		;GET AROUND THIS CRAP
SM1INI:
	SKIPG	BAILON			;HAS USER TURNED US OFF?
	 POPJ	P,			;YES	
	MOVE	A,SM1JFN		;INITIALIZE .SM1 FILE
	MOVE	B,[XWD 440000,100000]
	JSYS	OPENF
	 JRST	NOSM1		;ERROR EXIT
	MOVEI	TEMP,SM1SIZ		;BUFFER SIZE
	MOVEM	TEMP,SM1CNT
	MOVE	TEMP,[POINT 36,SM1BUF]
	MOVEM	TEMP,SM1PNT
	POPJ	P,

NOSM1:	ERR	<Cannot OPENF debugger's file.[CR for TENX message]>,1
	MOVEI	D,.+2			;ALLOW CONTINUATION
	JRST	ERROR
	SETOM	BAILON
	POPJ	P,					;OH WELL

SM1LST:	MOVE	B,LISJFN		;GET FILE NAME CORRESPONDING TO JFN
					;AND PUT OUT A FILE INFO BLOCK
					;THERE ARE CALLS TO SM1LST+1
	MOVE	A,[POINT 7,INIACS]	;A NICE BIG TEMP AREA
;;#%%# ! JFR 4-23-75 TRY THIS FOR CHANGE
	MOVE	C,[011100000001]	;A NICE FORMAT (?)
	JSYS	JFNS			;JFN TO STRING CONVERSION
	HRRZ	PNT,A			;UPDATED BYTE POINTER	
;;#%%# JFR 4-5-75 ZERO OUT THE REST OF THE LAST WORD
	SETZ	C,
	IDPB	C,A
	IDPB	C,A
	IDPB	C,A
	IDPB	C,A
;;#%%# ↑
	SUBI	PNT,INIACS
	ADDI	PNT,1			;# OF WORDS IN NAME
	SETZ	SBITS,
	HLLM	SBITS,BCORDN		;NO LONGER DOING COORDINATES
	PUSHJ	P,VALOUT		;END PREVIOUS TABLE
	MOVEI	SBITS,BAIFIL
	PUSHJ	P,VALOUT		;BEGIN FILE INFO  TABLE
	MOVE	SBITS,PNT
	HRL	SBITS,BSRCFN		;FILE #,,# WORDS IN NAME
	PUSHJ	P,VALOUT

	MOVN	PNT,PNT
	HRLZ	PNT,PNT			;AOBJN POINTER
SM1LS1:	MOVE	SBITS,INIACS(PNT)		;PICK UP A WORD
	PUSHJ	P,VALOUT
	AOBJN	PNT,SM1LS1
	POPJ	P,
>;BAIL
SUBCMD:	SKIPE	RPGSW
	   JRST	.+3
	HRROI	A,[ASCIZ/**/]
	JSYS	PSOUT
	MOVEI	D,SUBCMD		;SET TO RETURN TO SUBCMD
	NXTCHR				;GET THE NEXT CHARACTER	
	CAIN	A,QMARK			;QUERY
	  JRST	SUBQRY
	CAIN	A,EOLC			;DONE?
	  JRST	DONE			;YEP
	CAIN	A,CTRLL			;FOR LISTING?
	  JRST	GETLST
	CAIN	A,CTRLR			;NON-STANDARD .REL FILE
	  JRST	GETREL			;GET ONE FROM THE USER
	CAIN	A,SLASH			;SWITCH?
	  JRST	PSWIT			;		
	CAIN	A,CTRLQ			
	  JRST	DOHLT
	CAIN	A,CTRLU
	  JRST	CMDRES
	JRST	SUBCMD			;KEEP LOOPING	


GETREL:
	SKIPE	RPGSW
	  JRST	.+3
	HRROI	A,[ASCIZ/REL file  */]
	JSYS	PSOUT
	MOVEI	A,EREL			;addr. of tbl for long GTJFN
	MOVE	B,CMDJFN		;MAIN STRING POINTER IF ANY
	JSYS	GTJFN	
	  JRST	[MOVEM B,CMDJFN
		 JRST	ERROR]		;NOTE THAT ERROR RETURNS TO SUBCOMMAND LEVEL IN THIS CASE
	MOVEM	A,BINJFN		;SAVE JFN
	MOVEM	B,CMDJFN		;possibly an updated BP
BAIL<
	SKIPLE	BAILON
	PUSHJ	P,SM1INI		;FOR DEBUGGER
>;BAIL
	BACKUP
	NXTCHR
	CAIN	A,ESCAPE		;GET ANOTHER CHAR IF TERM WITH ALTMODE
	  NXTCHR
	MOVEI	A,CTRLR			;MARK THE COMMAND
	IDPB	A,CMDPTR			
	HRRZ	B,BINJFN	;ONLY RH BITS
	MOVE	A,CMDPTR		;SAVE THE JFN
	MOVE	C,[XWD 221100,000001]	;ITS ANYBODY'S GUESS IF THIS IS RIGHT!
	JSYS	JFNS		;PUT BINARY NAME INTO CMDLIN
	MOVEI	C,EOLC			;
	IDPB	C,A			;AN EOL
	MOVEM	A,CMDPTR
	TLO	FF,BINARY		;INDICATE BINARY FOR A BIT
	JRST	SUBCMD			;AND STAY IN SUBCOMMAND MODE
GETLST:
	SKIPE	RPGSW
	  JRST	.+3
	HRROI	A,[ASCIZ/LST file  */]
	JSYS	PSOUT
	MOVEI	A,ELST
	MOVE	B,CMDJFN
	JSYS	GTJFN
	  JRST	[MOVEM B,CMDJFN
		 JRST	ERROR]		
	MOVEM	A,LISJFN
	MOVEM	B,CMDJFN
BAIL<
	SKIPLE	BAILON
	PUSHJ	P,SM1LST		;DEBUGGER NEEDS TO KNOW
>;BAIL
	BACKUP
	NXTCHR
	CAIN	A,ESCAPE		;IF TERMINATED WITH ESCAPE THEN
	  NXTCHR			;GET ANOTHER CHAR
	MOVEI	A,CTRLL
	IDPB	A,CMDPTR
	HRRZ	B,LISJFN
	MOVE	A,CMDPTR
	MOVE	C,[XWD 221100,000001]
	JSYS	JFNS
	MOVEI	C,EOLC			;PUT AN EOL
	IDPB	C,A			;AT THE END OF THE COMMAND BUFFER
	MOVEM	A,CMDPTR
	TLO	FF,LISTNG		;INDICATE LISTING FOR A BIT
	JRST	SUBCMD
PSWIT:
	MOVE	D,[POINT 7,SWTTXT,-1]	;BYTE POINTER TO STRING
	SETZ	5,			;CHAR COUNT
PSWLUP:	NXTCHR
	CAIN	A,CTRLQ			;QUIT?
	  JRST	DOHLT			
	CAIN	A,CTRLU			;RESET COMMAND
	  JRST	CMDRES
	CAIE	A,CTRLR			;REPEAT LINE?
	  JRST	NORPT	
DOCTR:	HRROI	A,[ASCIZ!
/!]
	JSYS	PSOUT
	JUMPE	5,PSWLUP
	MOVEI	A,101
	MOVE	B,[POINT 7,SWTTXT,-1]
	MOVN	C,5			;COUNT
	JSYS	SOUT
	  JRST	PSWLUP			;AND CONTINUE
NORPT:	CAIE	A,CTRLX			;RUBOUT (WHICH GOES TO SUBCOMMAND LEVEL)
	  JRST	NOCTX
DOCTX:	HRROI	A,[ASCIZ/
/]
	JSYS	PSOUT
	JRST	SUBCMD
NOCTX:	CAIE	A,QRBOUT
	CAIN	A,CTRLA
	  JRST  .+2	
	JRST	NOCTA	   
	JUMPLE 	5,DOCTX
	MOVEI	A,"\"
	JSYS	PBOUT
	LDB	A,D			;LAST CHAR
	JSYS	PBOUT
	MOVE	A,D
	JSYS	BKJFN			;BACK UP THE BP
	  JFCL
	MOVEM	A,D
	SOJA	5,PSWLUP		;DECREMENT COUNT AND CONTINUE

NOCTA:	CAIE	A,EOLC
	CAIN	A,ESCAPE
	  JRST	PSWDUN
	IDPB	A,D
	AOJA	5,PSWLUP		;LOOK FOR MORE
PSWDUN:	
	SETZ	A,
	IDPB	A,D			;PUT A NULL BYTE
	MOVEI	A,SLASH

	IDPB	A,CMDPTR		;SAVE THE SWITCH
	MOVE	A,[POINT 7,SWTTXT,-1]
	MOVE	B,CMDPTR
	SETZ	C,
	JSYS	SIN
	MOVEI	C,EOLC
	IDPB	C,B
	MOVEM	B,CMDPTR
	MOVE	A,[POINT 7,SWTTXT,-1]	
	MOVEM	A,SWTPTR
	JSP	PNT,SWTGET		;PROCESS THE SWITCH
;;#XN# ! JFR 9-18-76
	SETZM	SWTPTR
	JRST	SUBCMD			;MORE SUBCOMMANDS?
DONE:	
	hrroi a,[asciz \SAIL:	\]
	skipe tmpcnt			;if in ccl mode,
	jsys psout			; output compiler name
	MOVEI	A,EOLC
	IDPB	A,CMDPTR
	IDPB	A,NAMPTR
	HRROI	A,NAMES
	MOVEM	A,NXTPTR
	SKIPE	BINJFN			;ALREADY DECIDED ABOUT BINARY
	  JRST	DONE1			;YES
	MOVEI	D,CMDSCN		;BE READY TO START OVER
	MOVEI	A,EREL1			;NO EXTRA JFNS, NO CONFIRM
	HRROI	B,DEFFLN		;USE THE DEFAULT NAME
	JSYS	GTJFN
	   JRST	ERROR			;SOMETHING IS WRONG
	MOVEM	A,BINJFN		;GOT IT
	TLO	FF,BINARY		;INDICATE BINARY FOR A BIT
BAIL<
	SKIPG	BAILON			;GET .SM1 FILE ONLY IF BAIL ACTIVE
	  JRST	DONE1			;OTHERWISE QUIT
	MOVEI	D,CMDSCN
	MOVEI	A,ESM1
	HRROI	B,DEFFLN
	JSYS	GTJFN		;FOR DEBUGGER
	  JRST	ERROR
	MOVEM	A,SM1JFN
>;BAIL

DONE1:	POPJ	P,

CMDRES:	HRROI	A,[ASCIZ/
Restarting ...
/]
	JSYS	PSOUT
	JRST	SAIL			;ALL OVER AGAIN

;HERE TO PRINT OUT LAST ERROR, RETURN ADDRESS IN D
ERROR:	HRROI	A,[ASCIZ/
/]
	JSYS	PSOUT
	MOVEI	A,101			;PRIMARY OUTPUT
	MOVE	B,[XWD 400000,-1]	;THIS FORK, MOST RECENT ERROR
	SETZ	C,
	JSYS	ERSTR
	  JFCL
	  SKIPA	A,[POINT 7,[ASCIZ/Cannot find TENEX error message.
/],-1]
	HRROI	A,[ASCIZ/
/]
	JSYS	PSOUT
	JRST	(D)

DOHLT:	HRROI	A,[ASCIZ/
Bye
/]
	JSYS	PSOUT
	JSYS	HALTF
	JRST	SAIL			;restart if continued

DSCR	Routines to print out info
⊗;

QUERY:	HRROI	A,[ASCIZ!

<filelist>	;compile file
←<filelist>	;compile with no binary
<filelist>,	;compile, subcommand mode
<filelist>←	;compile, load with DDT
<filelist>,←	;compile, load with DDT, subcommand

[Use "=" instead of "←" on TOPS20 in the above.]

↑U  start over
↑Q  quit
?   this list

!]
	JSYS	PSOUT
	JRST	(D)			;RETURN
SUBQRY:
	HRROI	A,[ASCIZ!

Type one of the following characters:
↑U	start over
↑Q	quit
↑R	non-standard .REL file
↑L	listing file
/	switch specification
?	this list

Legal switches include the following, where <num> is a number.
Edit switches with ↑R, ↑X, ↑A or rubout.

G	load after compilation
T	load with DDT
R	double parse stacks
C	produce a cref listing
D	double define PDL
P	double PDL
Q	double string PDL
H	make sharable (default on TENEX)
I	make non-sharable
K	KOUNT feature
X  	Extended compilation
<num>S	string space
<num>F	listing format --
<num>B	BAIL features
<num>A  KI and KL numerical instructions

!]
	JSYS	PSOUT
	JRST	(D)			;RETURN

NXTJFN:	MOVSI	A,100001
	MOVE	B,NXTPTR
	CAMN	B,NAMPTR
	  JRST	NXTDUN
	JSYS	GTJFN
	   CAIA					;ERROR RETURN
	JRST	NXTJF1
	MOVEM	B,NXTPTR			;SAVE NXTPTR
SYSERR:	ERR <Confusion in command scanner>,1
	JRST	NXTJFN

NXTJF1:	MOVEM	B,NXTPTR
	POPJ	P,

NXTDUN:	SETO	A,
	POPJ	P,

DSCR	Typing routines
⊗;

.BACKUP:	
	SKIPE	A,CMDJFN
	  JRST	.BACK1
	MOVEI	A,100
	JSYS	BKJFN
	  JFCL
	POPJ	P,
.BACK1:	
	JSYS	BKJFN
	  JFCL
	MOVEM	A,CMDJFN
	POPJ	P,

TYI:
;;#XN# JFR 9-18-76 for REQUIRE COMPILER_SWITCHES
	SKIPN	SWTPTR			;COMMAND LINE?
	 JRST	[SOSGE	A,PNAME		;NO, REQUIRE
		  SETZM	PNAME		;ALL DONE
		ILDB	A,PNAME+1
		POPJ	P,]
;;#XN# ↑
	ILDB	A,SWTPTR
	POPJ	P,


.NXTCHR:
	PUSH	P,B
	SKIPN	A,CMDJFN
	  JRST	.NXT1
	JSYS	BIN
	CAIN	B,15			;IF A CARRIAGE RETURN
	  JRST	.-2			;THEN IGNORE
	CAIN	B,12			;IF A LINE FEED
	  MOVEI	B,EOLC			;THEN TRANSLITERATE TO AN EOL
	MOVEM	A,CMDJFN
.NXTRET:
	MOVE	A,B	
	POP	P,B
	POPJ	P,		 
.NXT1:
	MOVEI	A,100			;PRIMARY INPUT
	JSYS	BIN
	CAIN	B,15			;IF A CARRIAGE RETURN
	  JRST	.-2			;THEN IGNORE
	CAIN	B,12			;IF A LINE FEED
	  MOVEI	B,EOLC			;THEN TRANSLITERATE TO AN EOL
	JRST	.NXTRET

DSCR	Long form GTJFN tables.
⊗;

EREL:	XWD	400000,0			;NEW VERSION
	XWD	100,101
	0
	0
	XWD	-1,DEFFLN
	XWD	-1,[ASCIZ/REL/]
	BLOCK	3

EREL1:	XWD 	400000,0
	XWD	377777,377777
	0
	0
	XWD	-1,DEFFLN
	XWD	-1,[ASCIZ/REL/]
	BLOCK	3
BAIL<
ESM1:	XWD	400000,0
	XWD	377777,377777
	0
	0
	XWD	-1,DEFFLN
	XWD	-1,[ASCIZ/SM1/]
	BLOCK 3
>;BAIL
ELST:	XWD	400000,0			;NEW VERSION
	XWD	100,101
	0
	0
       	XWD	-1,DEFFLN
	XWD	-1,[ASCIZ/LST/]
	BLOCK	3

ESAI:	XWD	100000,0
	XWD	100,101
	0
	0
	0
	XWD	-1,[ASCIZ/SAI/]
	BLOCK	3

;used by REQUIRE SOURCE!FILE
ESRC:	XWD	100000,0
	XWD	377777,377777
	BLOCK	3
	XWD	-1,[ASCIZ/SAI/]
	BLOCK	3

;when REQUIRE SOURCE!FILE fails, use this
ESRCT:	XWD	100000,0
	XWD	100,101
	BLOCK	3
	XWD	-1,[ASCIZ/SAI/]
	BLOCK	3


;  ENTER HERE FROM SCAN WHEN EOF IS REACHED AND ANOTHER
;  FILE IS NEEDED. IT IS AN ERROR IF NO MORE ARE LEFT

FILEIN:
	MOVE	TBITS2,SCNWRD
	SKIPE	SRCDLY			;IF ON, NOT END OF FILE, BUT SWITCH IN
	 JRST	 GETSR2
	TLNE	TBITS2,INSWT	;TIME TO SWITCH BACK TO PREV SOURCE FILE?
	 JRST	 UNSWT		;YES

GETSR2:	SETZ	A,
	EXCH	A,SRCDLY
	JUMPN	A,GETSWT
	PUSHJ	P,NXTJFN
	JUMPG	A,GETSR3
	POPJ	P,		;FAIL RETURN, NOSKIP

EXTERNAL TENXFI,CATCHR

GETSWT:	EXCH	SP,STPSAV
	PUSH	SP,PNAME	;CONVERT FILE NAME TO TENEX FORMAT
	PUSH	SP,PNAME+1
	PUSHJ	P,TENXFI
	PUSH	P,[0]
	PUSHJ	P,CATCHR	;AND PUT A NULL FOR GTJFN
	POP	SP,PNAME+1
	POP	SP,PNAME
	EXCH	SP,STPSAV
	MOVE	B,PNAME+1	;BYTEPOINTER
	MOVEI	A,ESRC		;LONG FORM -- TABLE ABOVE
	JSYS	GTJFN
	  JRST	GETSW1
	JRST	GETSR3		;SWITCHING DATA AREAS ALREADY DONE.

GETSW1:	ERR	<Cannot GTJFN REQUIREd file, type RETURN to GTJFN from terminal>,1
	HRROI	A,[ASCIZ/
Filename  */]
	JSYS	PSOUT
	MOVEI	A,ESRCT		;LONG FORM
	SETZ	B,		;GO TO TTY DIRECTLY
	JSYS	GTJFN
	  JRST	GETSW1		;ANOTHER ERROR!
	JRST	GETSR3

GETSRC:
GETSR1:	PUSHJ	P,NXTJFN
	JUMPLE	A,[ERR	<Need a source file>]
GETSR3:	MOVEM	A,SRCJFN
	JSYS	DVCHR			;GET THE DEVICE CHARS
	PUSH	P,B			;SAVE THEM
	PUSH	P,C
	MOVEI	A,101			;COMPARE TO THE CONTROLLING TERMINAL
	JSYS	DVCHR
	SETO	D,			;ASSUME THEY MATCH
	CAMN	B,-1(P)			;BUT DO THEY
	CAME	C,(P)
	  SETZ	D,			;NO MATCH
	MOVEM	D,TTYSRC		;SAY WHETHER OR NOT IT IS THE CONTROLLING TERMINAL
	SUB	P,X22			;ADJUST STACK
	JUMPN	D,OPNED			;DONT OPEN THE TTY -- WONT USE JFN ANYWAY

OPNUP:	MOVE	A,SRCJFN		
	MOVE	B,[XWD 440000,200000]	;OPEN SOURCE - NOTE IS 36-BIT
	JSYS	OPENF
	  ERR	<Can't open source file>

;NOW ALLOCATE INPUT BUFFER FOR SRCJFN, SET RELEVANT SWITCHED DATA
OPNED:	HRRZI	C,SRCBSZ+1	;PLUS 1 FOR EOB NULL WORD
	PUSHJ	P,CORGET
	 ERR	<DRYROT at CC:  No core for allocation>
	MOVEM	B,BUFADR
	ADD	C,B
	MOVE	TEMP,B
	HRLS	TEMP
	ADDI	TEMP,1
	SETZM	-1(TEMP)
	BLT	TEMP,-1(C)	;CLEAR OUT BUFFER, SINCE CORGET DOESNT
	SUBI	B,1
	HRLI	B,700		;MAKE THE KIND OF BP THAT POINTS A WORD EARLY
	MOVEM	B,SRCPNT
	SETZM	TNXBND		;CLEAR BUFFER END WORD FOR ADVBUF
BAIL<
	SKIPG	BAILON
	 JRST	NBAI00
	AOS	TEMP,BNSRC	;INCR FILE COUNT
	MOVEM	TEMP,BSRCFN	;START OFF IN THE NEW FILE
	SETZM	BSRCFC		;AT BLOCK ZERO (FIRST READ WILL SET BLOCK TO 1)
	MOVE	B,SRCJFN
	PUSHJ	P,SM1LST+1	;RE-USE PREVIOUS CODE
NBAI00:
>;BAIL
	SETZM	CRIND		
	HRROI 	1,[ASCIZ/
/]
	SKIPE	SWTLNK
	JSYS	PSOUT		;PRINT CRLF TO TTY
	MOVE	1,LININD
	HRROI	1,INDTAB(1)
	JSYS	PSOUT
	HRROI	A,SRCFLN	
	HRRZ	B,SRCJFN
	SETZ	C,
	JSYS	JFNS		;PRINT SRCFIL NAME TO TTY
	IDPB	C,A		;TERMINATING NULL CHAR
	HRROI	A,SRCFLN	;NOW PRINT THE NAME
	JSYS	PSOUT		
	SKIPN	TTYSRC		;IS THE CONTROLLING TERMINAL THE SOURCE?
	  JRST	.+3		;NO
	HRROI	A,[ASCIZ/
Type ↑Z for EOF, ↑R, ↑X, ↑A to edit.
/]
	JSYS	PSOUT
	AOS	(P)		;SUCCESS -- SKIP RETURN FROM FILEIN
	POPJ	P,

INDTAB:0		;INDENTING SPACES
	ASCIZ	/   /	;LEVEL 1
	ASCIZ	/      /;LEVEL 2
	ASCIZ	/         /; L 3
	ASCIZ	/            /;4
	0		;SAFETY


	;definitions for TOPS-20

	opdef jcomnd[104000000544]
	opdef jprarg[104000000545]
	opdef jrscan[104000000500]

	.gtcnf←←11		;configuration table (on TOPS-10)
	%cnmnt←←112		;monitor type offset in above

	;comnd jsys function descriptor block offsets

	.cmfnp←←0		;function code+flags,,link to next block
	 cm%po←←1⊗25		;parse field only
	 cm%hpp←←1⊗24		;help pointer provided
	 cm%dpp←←1⊗23		;default pointer provided
	 cm%sdh←←1⊗22		;suppress default help message
;	.cmdat←←1		;data for function
	.cmhlp←←2		;help text pointer
;	.cmdef←←3		;default pointer

	;comnd jsys command state block offsets

	.cmflg←←0		;flag bits,,reparse dispatch address
	.cmioj←←1		;I/O jfns
;	.cmrty←←2		;pointer to CTRL/R buffer
	.cmbfp←←3		;pointer to start of text buffer
	.cmptr←←4		;pointer to next input to be parsed
	.cmcnt←←5		;count of space left in buffer
	.cminc←←6		;count of characters left in buffer
;	.cmabp←←7		;pointer to atom buffer
;	.cmabc←←10		;size of atom buffer
;	.cmgjb←←11		;address of GTJFN argument block

	;comnd jsys function codes

	.cmkey←←0		;keyword function
	 cm%fw←←1b7		;this is flag word (in keyword table)
	 cm%inv←←1b35		;suppress output of this keyword on ?
	 cm%nor←←1b34		;do not recognize this keyword
	 cm%abr←←1b33		;this is an abbreviation
	.cmnum←←1		;number function
	.cmnoi←←2		;guide word function
	.cmswi←←3		;switch function
	.cmifi←←4		;input file spec function
	.cmofi←←5		;output file spec function
	.cmfil←←6		;arbitrary file spec function
	.cmfld←←7		;arbitrary field function 
	.cmcfm←←10		;confirm function
	.cmdir←←11		;directory name function
	.cmusr←←12		;user name function
	.cmcma←←13		;comma function
	.cmini←←14		;initialize function
	.cmflt←←15		;floating-point number function
	.cmdev←←16		;device name function
	.cmtxt←←17		;text to carriage return function
	.cmtad←←20		;date and time function
	.cmqst←←21		;quoted string function
	.cmuqs←←22		;unquoted string function
	.cmtok←←23		;token function
	.cmnux←←24		;number to non-numeric function
	.cmact←←25		;account string function
	.cmnod←←26		;network node name function

	;bits returned on comnd call

	cm%esc←←1b0		;ESC terminated this field
	cm%nop←←1b1		;field could not be parsed
	cm%eoc←←1b2		;CR terminated this field
	cm%rpt←←1b3		;reparse needed due to editing of command
	cm%swt←←1b4		;switch field terminated with a colon
	cm%pfe←←1b5		;ESC terminated previous field


	;gtjfn argument table offsets

	.gjgen←←0		;flag bits,,generation number
	 gj%fou←←1b0		;new version to be created
	 gj%new←←1b1		;file must not exist
	 gj%old←←1b2		;file must exist
	 gj%msg←←1b3		;output message if user ends with esc
	 gj%cfm←←1b4		;confirmation is required
	 gj%tmp←←1b5		;file is temporary
	 gj%ns←←1b6		;search only first spec of multiple def
	 gj%acc←←1b7		;jfn can't be accessed by inferiors
	 gj%del←←1b8		;ignore deleted bit
	 gj%jfn←←3b10		;jfn is supplied
	 gj%ifg←←1b11		;wildcards allowed
	 gj%ofg←←1b12		;associate jfn with string, not file
	 gj%flg←←1b13		;return flags if successful
	 gj%phy←←1b14		;use physical device
	 gj%xtn←←1b15		;extended argument block
	 gj%fns←←1b16		;ignored in long form gtjfn
	 gj%sht←←1b17		;must be off for long form gtjfn
	.gjsrc←←1		;i/o jfns
	.gjdev←←2		;default device pointer
	.gjdir←←3		;default directory pointer
	.gjnam←←4		;default filename pointer
	.gjext←←5		;default extension pointer
	.gjpro←←6		;default protection pointer
	.gjact←←7		;default account pointer
	.gjjfn←←10		;jfn to associate with file
	.gjf2←←11		;flags,,# words in extended block
	.gjcpp←←12		;exact copy pointer
	.gjcpc←←13		;number of bytes in above buffer
	.gjrty←←14		;pointer to ↑R buffer
	.gjbfp←←15		;pointer to destination buffer
	.gjatr←←16		;pointer to attribute block (reserved)

	;function bits for rscan

	.rsini←←0		;select rescan buffer
	.rscnt←←1		;return number of characters remaining

	;error codes

	iox4←←600220		;"end of file reached"
	npxnsw←←602045		;"Not a switch - does not begin with slash"

	;miscellany

	.fhslf←←400000		;fork handle on self
	no%lfl←←1b2		;nout flag meaning use leading fill chars
	no%zro←←1b3		;nout flag meaning use 0's for fill chars
	.nulio←←377777		;null I/O designator
	.prard←←1		;read function for prarg
	of%rd←←1b19		;allow read access flag for openf
	.prast←←2		;set function for prarg
	PM%CNT←←1B0		;REPEAT COUNT (FOR PMAP JSYS)
	.priin←←100		;primary input device
	.priou←←101		;primary output device
	.gjf2←←11		;second flag word offset in extended
				; gtjfn argument block

ccl20:	skipe tmpcnt		;already got EXEC's commands?
	jrst [	skipe costbl+.cminc ;yes, any left?
		jrst reparc	;yes, go read them
		haltf		;no, done
		setzm tmpcnt
		jrst sail]	;continue there
	move a,[.prard,,.fhslf]	;a/ function,,process handle
	hrrzi b,prblk		;b/ address of block
	hrrzi c,prbln		;c/ length of block
	jsys prarg		;get program argument block
	ercal jshlt0		;handle errors
	jumpe c,trytmp
	movn c,prblk		;minus number of lists to check
	hrlzi c,(c)		;set up aobjn counter 
	aos c			; with 1 as first offset
finsai:	move b,prblk(c)		;get offset of next list
	hlrz a,prblk(b)		;get list name
	cain a,'SAI'		;is it my list?
	jrst fousai		;yes, go parse command
	aobjn c,finsai		;no, check out next list
trytmp:	gjinf			;no info in prarg, try .tmp file
				;build filename in core
	move a,[point 7,prblk,-1] ;a/ destination designator
	move b,c		;b/ number to be output (job number)
	movei c,↑d10		;c/ radix in right half
	hrli c,<(no%lfl+no%zro)>+3 ;  flags (leading fill 0's) and number
				; of digits
	nout			;output the number
	erjmp jshlt0		;handle errors
	hrroi b,[asciz \SAI.TMP.100\] ;b/ pointer to string
	setz c,			;c/ number of bytes or zero
	sout			;append that string
	move b,[point 7,prblk,-1] ;now end string as it started
	hrroi c,-3		; output three bytes
	sout			;there, the filename's complete
	hrlzi a,(gj%old+gj%sht)	;a/ flags (old file, short gtjfn)
	move b,[point 7,prblk,-1] ;b/ source designator
	gtjfn			;get jfn on file
	erjmp [	hrroi a,[asciz \?Can't GTJFN .TMP file\] ;load up error msg
		jsys psout	;explain problem
		jrst jshlt1]	;then die
	movei b,of%rd		;b/ flags in right half (read access)
	hrli b,070000		;b/ byte size in left half (bits 0-5)
	openf			;open the file
	erjmp [	hrroi a,[asciz \?Can't OPENF .TMP file\] ;error msg
		jsys psout	;say what's happening
		jrst jshlt1]	;die
	move b,[point 7,prblk,-1] ;b/ destination designator
	movei c,prbln		;c/ number of chars to read
	movei c,0		;d/ byte to terminate on
	push p,a		;save jfn
	sin			;put string in core
	erjmp [	movei a,.fhslf	;a/ process handle (self)
		geter		;find out error
		hrrz b,b	;just error in b
		cain b,iox4	;end of file?
		jrst .+2	;yes, we expected that
		jrst jshlt0]	;no, explain error
	jrst [	hrroi a,[asciz \?Can't read all of .TMP file\]
		jsys psout	;too big?
		jrst jshlt1]	;die
	pop p,a			;a/ jfn of file
	delf			;make it go away
	ercal jserr0		;non fatal error
	seto b,			;set up offset for later code
fousai:	move a,costbl+.cmptr	;here's where we'll put the commands
	hrroi b,prblk+1(b) 	;this is the string with the commands
	move c,costbl+.cmcnt	;the count of bytes which can be written
	setz d,			;byte to stop on (null)
	sout			;put string in comnd buffer
	erjmp jshlt0		;error
	move a,costbl+.cmcnt	;get first count
	sub a,c			;comput characters read
	subi a,1		; don't count null
	push p,a		;save count of chars left to parse
	movem a,tmpcnt		; and count of chars passed
	move a,[.nulio,,.nulio]	;suppress prompt for ccl mode
	movem a,costbl+.cmioj 	; save jfns here
	movei a,reparc		;where to go on reparse
	movem a,costbl+.cmflg 	; save output jfn here
	movei a,costbl		;a/ address of command state block
	movei b,fdini		;b/ function decsriptor address
	jsys comnd		;initialize command scanning
	pop p,costbl+.cminc	;characters are still there
reparc:	pushj p,reinit		;reset all for reparse
	movsi b,(gj%fou)	;new version
	movem b,gjblk+.gjgen	; save flags here
	hrroi b,[asciz \rel\]	;default extension for object file
	movem b,gjblk+.gjext	; save it here
	hrroi b,[asciz \Binary file name\] ;say what we want
	movem b,fdfil+.cmhlp	; if asked for help
	movei a,costbl		;a/ address of command state block
	movei b,fdfil		;parse for object file spec
	jsys comnd
	tlne a,(cm%nop)		;parse successful?
	jrst norel		;no, no binary file
	movem b,binjfn		;save jfn
	pushj p,svdflt		;save default file name
	move c,costbl+.cmptr	;get pointer to input to be parsed
	ildb b,c		;get next character
	caie b,"!"		;is next character "!"?
	jrst norel		;no, go check comma
	movei b,fdcfm		;yes, confirm run command
	jsys comnd
	tlne a,(cm%nop)		;parse successful?
	jrst nopars		;no, complain
	hrlzi a,(gj%old!gj%sht)	;old file, short gtjfn
	hrroi B,atom		;pointer to string
	jsys gtjfn
	ercal jshlt0		;handle errors
	movem a,p		;save jfn
	seto	a,		;remove pages
	movsi	b,.fhslf	; from this fork
	move	c,[pm%cnt+1000]	; all 1000 pages
	move	d,[runcod,,7]	;move rest of code to
	blt	d,16		; acs 7-16
	jrst	7		;do it there
runcod:	pmap			;delete all pages from map
	movsi	a,.fhslf	;get into this fork
	hrr	a,17		;from this file
	get			;go get it
	movei	a,.fhslf	;our fork
	gevec			;get forks entry vector
	aos b			;use ccl entry
	jrst	(b)		;start fork
norel:	movei b,fdcma		;parse for comma
	jsys comnd
	tlne a,(cm%nop)		;parse successful?
	jrst nolst		;no, try switches
	pushj p,setlst		;set up for parse of listing file
	movei b,fdfil		;parse for listing file spec
	setzm atom		;clear beginning of atom buffer
	jsys comnd
	tlne a,(cm%nop)		;parse successful?
	jrst nolst		;no, no listing
	skipn atom		;if nothing was specified,
	jrst [	move a,b	;release jfn (exec passes foo,=foo
		rljfn		; meaning rel, no list)
		erjmp jshlt0	;handle errors
		movei a,costbl	;restore address of command state block to a
		jrst nolst]	;continue
	movem b,lisjfn		;save jfn
	pushj p,svdflt		;save default file name, if none
nolst:	movei b,fdcsw		;parse for cref switch
	jsys comnd
	tlne a,(cm%nop)		;parse successful?
	jrst nocref		;no, don't flag cref
	movsi b,crefit		;flag cref
	iorm b,scnwrd		; here
	tlo ff,crefsw		; and here
nocref:	movei b,fdequ		;parse for equals
	jsys comnd
	tlne a,(cm%nop)		;parse successful?
	jrst nopars		;no, complain

	move b,[point 7,names,-1] ;set up pointer 
	movem b,namptr		;  for names of source files
	movem b,nxtptr		;  and for "next file" routine
inloop:	pushj p,setsou		;set up fdfil for source parse
	movei b,fdfil		;parse for source file spec
	jsys comnd
	tlne a,(cm%nop)		;parse successful?
	jrst nopars		;no, complain
	pushj p,svdflt		;save default file name, if none
	pushj p,savsou		;save source filespec
inloo1: movei b,cmacfm		; and parse for either
	jsys comnd
	tlne a,(cm%nop)		;parse successful?
	jrst nopars		;no, complain
	hrli c,331100		;build byte pointer
	ldb c,c			;isolate matching function 
	caie c,.cmcma		;was it a comma?
	jrst done		;no, go process request
	setz c,			;set up null byte
	idpb c,namptr		; and separate filespecs with one
	jrst inloop		;yes, go get more input

;subroutine to write filespec for jfn in b to namptr
; kills flags in lh of b, kills c, releases jfn

savsou:	push p,a		;save comnd pointer
	move a,namptr		;buffer for sources
	tlz b,-1		;don't need flag bits
	setz c,			;default format
	jsys jfns
	movem a,namptr		;save source pointer
	move a,b		;now, jfn in a
	jsys rljfn		; to release the jfn for now
	ercal jshlt0		;handle errors nicely
	pop p,a			;restore pointer
	popj p,

;subroutine to set up fdfil to parse for source filespec

setsou:	movsi b,(gj%old)	;old file flag
	movem b,gjblk+.gjgen	; keep here
	hrroi b,deffln		;default filename for source file
	movem b,gjblk+.gjnam	; save it here
	hrroi b,[asciz \sai\]	;default extension for source file
	movem b,gjblk+.gjext	; goes here
	hrroi b,[asciz \Source file name\] ;what ? says we want
	movem b,fdfil+.cmhlp	; where that goes
	popj p,

;subroutine to set up fdfil to parse for listing filespec

setlst:	movsi b,(gj%fou)	;new version
	movem b,gjblk+.gjgen	; save flags here
	hrroi b,deffln		;default filename for listing file
	movem b,gjblk+.gjnam	; save it here
	hrroi b,[asciz \lst\]	;default extension for listing file
	movem b,gjblk+.gjext	; save it here
	hrroi b,[asciz \Listing file name\] ;say what we want
	movem b,fdfil+.cmhlp	; if asked for help
	popj p,

;subroutine to set up fdfil to parse for binary filespec

setbin:	movsi b,(gj%fou)	;new version
	movem b,gjblk+.gjgen	; save flags here
	hrroi b,deffln		;default filename for binary file
	movem b,gjblk+.gjnam	; save it here
	hrroi b,[asciz \rel\]	;default extension for binary file
	movem b,gjblk+.gjext	; save it here
	hrroi b,[asciz \Binary file name\] ;say what we want
	movem b,fdfil+.cmhlp	; if asked for help
	popj p,

;subroutine to save sefault file name (from jfn in b)

svdflt:	skipe deffln		;do we already have a default?
	popj p,			;yes
	push p,a		;save comnd pointer
	hrroi a,deffln		;here's where we'll save default file name
	movsi c,2000		;just the file name
	jsys jfns
	pop p,a			;restore pointer
	popj p,

;subroutine to reinitialize things 
;basically undoes anything you could possibly do

reinit:	skiple a,binjfn		;rel file specified?
	jrst [	rljfn		;yes, get rid of it
		erjmp jshlt0	;handle errors
		jrst .+1]	;continue
	setzm binjfn		;no rel file yet

	skiple a,lisjfn		;list file specified?
	jrst [	rljfn		;yes, get rid of it
		erjmp jshlt0	;handle errors
		jrst .+1]	;continue
	setom lisjfn		;no list file either

	hrlzi b,160000		;reset scnwrd
	movem b,scnwrd
	setz ff,		; flags
	setzm aswitc		;reset arithmetic switch
bail<
	setzm bailon		;reset bail switch
>;bail
	setzm deffln		;turn off default
	movei b,50		;reset definition pdl length
	hrrm b,dfmax
	movei b,20		;reset string pdl length
	hrrm b,spmax
	movei b,100		;reset parse stacks' lengths
	hrrm b,ppmax
	hrrm b,gpmax
	hrrm b,pcmax
	movei b,36		;scwmax starts out differently
	hrrm b,scwmax
	movei b,100		;reset regular pdl
	hrrm b,pdlmax
	movei b,7		;now format switch
	movem b,fmtwrd
	setzm xtflag		;extended flag
	setzm lodmod		;no load after compiling
	setzm lodddt		;no load ddt either
	setom hisw		;generate two-seg code
	setzm kount		;flag not doing profile
	movei b,6654		;initial stmaxx
	hrrm b,stmaxx
	popj p,

;routine to do comnd jsys, - no parse, no return

comndj:	movei a,costbl		;a/ addr of command state block
	jsys comnd		;do the actual jsys
	tlne a,(cm%nop)		;parse failed?
	jrst nopars		;yes, complain
	popj p,

nopars:	move p,pdlsav		;fix up pointer
	hrroi a,[asciz \
?\]				;error somewhere
	jsys psout		;start complaint
	movei a,.priou		;output designator
	hrli b,.fhslf		;fork handle in lh (error code already in rh)
	setz c,			;character count
	erstr			;output problem
	 jfcl
	 jfcl
	hrroi a,[asciz \ - \]	;separate nicely
	jsys psout
	hrroi a,atom		;point to probable problem
	jsys psout		;show user
	skipe tmpcnt		;and if doing ccl commands
	jrst jshlt1		; then die permanently
				; otherwise, fall thru

usr20:	move a,[.priin,,.priou]	;set up jfns for user interface
	movem a,costbl+.cmioj 	; save jfns here
	movei a,reparu		;where to go on reparse
	movem a,costbl+.cmflg 	; save output jfn here
	movei a,costbl		;a/ address of command state block
	movei b,fdini		;b/ function decsriptor address
	jsys comnd		;initialize command scanning
	movem p,pdlsav		;save stack pointer
reparu:	move p,pdlsav		;start with initial pointer
	pushj p,reinit		;reset everything nicely
	move b,[point 7,names,-1] ;pointer
	movem b,namptr		; for building list of names
	movem b,nxtptr		; and for retrieving them
usinlp:	pushj p,setsou		;set up fdfil for source parsing
	setzm gjblk+.gjnam	;no default filename for source file
	movei a,costbl		;a/ address of command state block
	movei b,swisou		;parse for switch (with ? indicating file ok)
	jsys comnd
	tlnn a,(cm%nop)		;success?
	jrst usinla		;yes, go process switch
	caie b,npxnsw		;began with "/"?
	jrst nopars		;yes, problems
	movei b,fdfil		;get source file spec
	pushj p,comndj
	pushj p,svdflt		;save default filename if none already there
	pushj p,savsou		;save source file spec
	jrst usinl1		;got filespec, go confirm
usinla:	pushj p,usdosw		;go process switch
	jrst usinlp		; and back for more filespecs
usinl1:	movei a,costbl		;a/ address of command state block
	movei b,swiccf		;parse for switch (with ? indicating file ok)
	jsys comnd
	tlnn a,(cm%nop)		;success?
	jrst usinl2		;yes, go process switch
	caie b,npxnsw		;began with "/"?
	jrst nopars		;yes, problems
	movei b,cmacfm		;parse for comma or carriage return
	pushj p,comndj
	hrli c,331100		;build byte pointer
	ldb c,c			;get matching function
	cain c,.cmcfm		;confirm?
	jrst done20		;yes, go process request
	setz c,			;null byte
	idpb c,namptr		; to separate filenames
	jrst usinlp		;now back for more filespecs
usinl2:	pushj p,usdosw		;process switch
	jrst usinl1		;and back for more switches

done20:	skipe lisjfn		;if no listing file,
	jrst done		; continue with processing
	pushj p,setlst		;set up for listing file spec
	push p,gjblk+.gjsrc	;save i/o jfns
	move a,[.nulio,,.nulio]	;don't need any i/o
	movem a,gjblk+.gjsrc	;set all to null
	movei a,gjblk		;a/ address of block
	hrroi b,deffln		;b/ pointer to string
	gtjfn			;get listing filespec
	erjmp jshlt0		;handle errors
	pop p,gjblk+.gjsrc	;restore i/o jfns
	movem a,lisjfn		;save jfn
	jrst done

;subroutine to process switches

usdosw:	move b,(b)		;get entry from switch table
	jrst (b)		;dispatch to switch routine

;arithmetic switch

ariswt:	movei b,onopak		;parse for octal number, open parens,
				; or arithmetic keyword
	pushj p,comndj
	hrli c,331100		;build byte pointer
	ldb c,c			;get matching function
	cain c,.cmnum		;get an octal number?
	jrst arionm		;yes, just stuff it
	caie c,.cmkey		;single keyword?
	pushj p,ari2kw		;no, go process more than one
	 pushj p,onekw		;yes, just process one keyword
	move b,d		;put switch(es) in b
arionm:	movem b,aswitc		;save specified switch here
	popj p,

ari2kw:	setz d,			;start with zero word
ari2k1:	movei b,fdakw		;parse for keyword
	pushj p,comndj
	hrrz b,(b)		;get address of switch value/noise 
	hlrz c,(b)		;get switch value
	ior d,c			;save with other switches
	hrrz b,(b)		;address of noise word in b
	pushj p,comndj
	movei b,cmacpn		;then parse comma or close parens
	pushj p,comndj
	hrli c,331100		;build byte pointer
	ldb c,c			;get function which matched
	cain c,.cmcma		;comma?
	jrst ari2k1		;yes, go get another switch
	move b,d		;return switches in b
	aos (p)			; and give skip return
	popj p,

;bail switch
bail<
baiswt:	movei b,onopbk		;parse for octal number, open parens,
 				; or bail keyword
	pushj p,comndj
	hrli c,331100		;build byte pointer
	ldb c,c			;get matching function
	cain c,.cmnum		;get an octal number?
	jrst baionm		;yes, just stuff it
	caie c,.cmkey		;single keyword?
	pushj p,bai2kw		;no, go process more than one
	 pushj p,onekw		;yes, just process one keyword
	move b,d		;put switch(es) in b
baionm:	movem b,bailon		;save specified switch here
	popj p,

bai2kw:	setz d,			;start with zero word
bai2k1:	movei b,fdbkw		;parse for keyword
	pushj p,comndj
	hrrz b,(b)		;get address of switch value/noise 
	hlrz c,(b)		;get switch value
	ior d,c			;save with other switches
	hrrz b,(b)		;address of noise word in b
	pushj p,comndj
	movei b,cmacpn		;then parse comma or close parens
	pushj p,comndj
	hrli c,331100		;build byte pointer
	ldb c,c			;get function which matched
	cain c,.cmcma		;comma?
	jrst bai2k1		;yes, go get another switch
	move b,d		;return switches in b
	aos (p)			; and give skip return
	popj p,
>;bail

;routine to output noise, return switch value

onekw:	 hrrz b,(b)		;get address of switch value/noise 
	hlrz d,(b)		;save switch value in d
	hrrz b,(b)		;address of noise word in b
	pushj p,comndj
	popj p,			;yes, return with that

;binary switch

binswt:	pushj p,nbinsw		;kill all old info about binary file
	setzm binjfn		;but remember we want one
	tlnn a,(cm%swt)		;field ended with a colon?
	popj p,			;no, don't ask for filespec
	pushj p,setbin		;set up fdfil to parse for binary file
	movei b,fdfil		;parse for listing file
	pushj p,comndj
	movem b,binjfn		;save jfn
	popj p,

;cref switch

crfswt:	pushj p,lstswt		;get listing filespec
	movsi b,crefit		;get cref switch
	iorm b,scnwrd		; turn on here
	tlo ff,crefsw		; and here
	popj p,

;definition-pdl switch

dpdswt:	tlnn a,(cm%swt)		;field ended with a colon?
	jrst dpddbl		;no, just double stack
	movei b,fddsl		;parse for decimal stack length
	pushj p,comndj
	jumpe b,dpddbl		;if zero, double stack
	jrst dpddnm		;have number, go save that
dpddbl:	hrrz b,dfmax		;get old stack value
	lsh b,1			;double it
dpddnm:	hrrm b,dfmax		;save new value
	popj p,

;extended switch

extswt:	movei b,extnoi		;noise
	pushj p,comndj
	hllos xtflag
	popj p,

;format switch

fmtswt:	movei b,onopfk		;parse for octal number, open parens,
				; or format keyword
	pushj p,comndj
	hrli c,331100		;build byte pointer
	ldb c,c			;get matching function
	cain c,.cmnum		;get an octal number?
	jrst fmtonm		;yes, just stuff it
	caie c,.cmkey		;single keyword?
	pushj p,fmt2kw		;no, go process more than one
	 pushj p,onekw		;yes, just process one keyword
	move b,d		;put switch(es) in b
fmtonm:	movem b,fmtwrd		;save specified switch here
	move c,[760000,,1]	;make mask
	andcam c,scnwrd		;turn off user-controlled bits
	andi b,77		;only six bits to change
	rot b,-5		;put them where they're found in scnwrd
	iorm b,scnwrd		; and or them in
	popj p,

fmt2kw:	setz d,			;start with zero word
fmt2k1:	movei b,fdfkw		;parse for keyword
	pushj p,comndj
	hrrz b,(b)		;get address of switch value/noise 
	hlrz c,(b)		;get switch value
	ior d,c			;save with other switches
	hrrz b,(b)		;address of noise word in b
	pushj p,comndj
	movei b,cmacpn		;then parse comma or close parens
	pushj p,comndj
	hrli c,331100		;build byte pointer
	ldb c,c			;get function which matched
	cain c,.cmcma		;comma?
	jrst fmt2k1		;yes, go get another switch
	move b,d		;return switches in b
	aos (p)			; and give skip return
	popj p,

;go switch

goswt:	movei b,gonoi		;noise
	pushj p,comndj
	setom lodmod
	popj p,

;list switch

lstswt:	pushj p,ncrfsw		;kill all old info about listing file
	setzm lisjfn		;but remember we want one
	tlnn a,(cm%swt)		;field ended with a colon?
	popj p,			;no, don't ask for filespec
	pushj p,setlst		;set up fdfil to parse for listing file
	movei b,fdfil		;parse for listing file
	pushj p,comndj
	movem b,lisjfn		;save jfn
	popj p,

;mode-for-debugging switch

modswt:	movei b,fddnm		;decimal number
	pushj p,comndj
	setzm multp		;for mode 5
	setzm plinsw
	caie b,4
	setzm .dbg.		;to get all switches initialized
	jumpl b,moddon		;no negatives
	hrloi temp,400000	;xwd 400000,-1 for scan break
	caig b,6		;must be 6 or less
	xct dbmd(b)
moddon:	popj p,

;no binary switch

nbinsw:	PUSH P,A		;SAVE AC
	skiple A,binjfn		;if binary file specified,
	jrst [	rljfn		;yes, get rid of it
		erjmp jshlt0	;handle errors
		jrst .+1]	;continue
	POP P,A			;RESTORE
	setom binjfn		;no binary file yet
	popj p,

;no cref (or listing) switch

ncrfsw:	PUSH P,A		;SAVE A
	skiple A,lisjfn		;if listing file specified,
	jrst [	rljfn		;yes, get rid of it
		erjmp jshlt0	;handle errors
		jrst .+1]	;continue
	POP P,A			;RESTORE
	setom lisjfn		;no listing file yet
	movsi b,crefit		;get cref switch
	andcam b,scnwrd		; turn off here
	tlz ff,crefsw		; and here
	popj p,

;offset switch

offswt:	tlnn a,(cm%swt)		;field ended with a colon?
	jrst offddt		;no, use -1 as default
	movei b,offnoi		;noise
	pushj p,comndj
	movei b,fdonm		;octal number
	pushj p,comndj
	camn b,[-1]		;ddt?
offddt:	movei b,lpserr-1	;length of ddt with sail low seg
	camn b,[-2]
	jrst [	movei b,12237	;length of raid with sail low seg
		skipe jobddt	; here is a better number
		movei b,lpserr-1 ;end of ddt
		jrst .+1]
	movem b,lststrt		;set it up
	popj p,

;one-segment switch

oneswt:	movei b,codnoi		;noise
	pushj p,comndj
	setzm hisw
	popj p,

;pdl switch

pdlswt:	tlnn a,(cm%swt)		;field ended with a colon?
	jrst pdldbl		;no, just double stack
	movei b,fddsl		;parse for decimal stack length
	pushj p,comndj
	jumpe b,pdldbl		;if zero, double stack
	jrst pdldnm		;have number, go save that
pdldbl:	hrrz b,pdlmax		;get old stack value
	lsh b,1			;double it
pdldnm:	hrrm b,pdlmax		;save new value
	popj p,

;parse-stacks switch

ppdswt:	tlnn a,(cm%swt)		;field ended with a colon?
	jrst ppddbl		;no, just double stack
	movei b,fddsl		;parse for decimal stack lencth
	pushj p,comndj
	jumpe b,ppddbl		;if zero, double stack
	jrst ppddnm		;have number, go save that
ppddbl:	hrrz b,ppmax		;get old stack value
	lsh b,1			;double it
ppddnm:	hrrm b,ppmax		;save new value in lots of stacks
	hrrm b,gpmax
	hrrm b,pcmax
	hrrm b,scwmax
	popj p,

;profile switch

proswt:	movei b,pronoi		;noise
	pushj p,comndj
	skipge lisjfn		;make sure we're listing
	jrst [	hrroi a,[asciz \
%PROFILE counters inserted only when listing - counters not inserted
\]
		psout
		popj p,]
	movsi b,crefit		;get cref flag
	tdne b,scnwrd		;are we creffing?
	jrst [	hrroi a,[asciz \
%PROFILE counters and CREF are presently incompatible - counters not inserted
\]
		psout
		popj p,]
	movei b,macexp		;get format for
	hrlm b,scnwrd		; listing file
	lsh b,-=13		;move it there
	movem b,fmtwrd		; and save it there
	setom kount		;flag we're inserting counters
	popj p,

;string-pdl switch

spdswt:	tlnn a,(cm%swt)		;field ended with a colon?
	jrst spddbl		;no, just double stack
	movei b,fddsl		;parse for decimal stack length
	pushj p,comndj
	jumpe b,spddbl		;if zero, double stack
	jrst spddnm		;have number, go save that
spddbl:	hrrz b,spmax		;get old stack value
	lsh b,1			;double it
spddnm:	hrrm b,spmax		;save new value
	popj p,

;string-space switch

stsswt:	movei b,fddnm		;parse for a decimal number
	pushj p,comndj
	hrrm c,stmaxx		;save new string space
	popj p,

;test switch

tstswt:	movei b,tstnoi		;noise
	pushj p,comndj
	setom lodmod		;load after compiling
	setom lodddt		;load with ddt
	popj p,

;two-segment switch

twoswt:	movei b,codnoi		;noise
	pushj p,comndj
	setom hisw
	popj p,

;dummy routine for unimplemented switches

swnimp:	movei a,"%"		;give warning message
	jsys pbout
	hlro a,b		;get switch specified
	psout			;say it
	hrroi a,[asciz \ switch not implemented yet
\]				;warn it doesn't work
	jsys psout
	popj p,

	;non-fatal jsys error handler
	;   ercal jserr0
	; returns +1: always, can be used in +1 return of jsys's

jserr0:	movei a,.priin		;a/ input designator
	jsys cfibf		;clear typeahead
	movei a,.priou		;a/ output designator
	jsys dobe		;wait for previous output to finish
	hrroi a,[asciz \
? JSYS ERROR: \]		;prefix message
	jsys psout
	movei a,.priou		;a/ output designator
	hrloi b,.fhslf		;b/ this fork,,error number (last)
	setz c,			;c/ output limit (none)
	jsys erstr		;output standard error message
	 jfcl			;error return
	 jfcl			;error return
	hrroi a,[asciz \
\]				;output crlf
	jsys psout
	popj p,			;done

	;fatal jsys error - print message and halt
	;   erjmp jshlt0
	; returns: never

jshlt0:	pushj p,jserr0		;print the message
jshlT1:	jsys haltf		;then die
	hrroi a,[asciz \PROGRAM CANNOT CONTINUE
\]				;if continued,
	jsys psout		; say can't be done
	jrst jshlt1		;then die again

data
	prbln←←100		;prarg block length
prblk:	block prbln		;prarg block

costbl:	0,,0			;flags,,reparse address
	.priin,,.priou		;I/O jfns
	-1,,cmpmt		;pointer to ↑R buffer
	-1,,text		;   "     " text buffer
	-1,,text		;   "     " next parse
	ltext*5			;how much room in buffer
	0			;how many chars in text buffer
	-1,,atom		;pointer to atom buffer
	latom*5			;how much room in atom buffer
	gjblk			;address of gtjfn argument block

cmpmt:	asciz \SAIL>\		;comnd prompt

	ltext←←100		;length of text buffer
text:	block ltext		;text input buffer

	latom←←10		;length of atom buffer
atom:	block latom		;atom buffer

gjblk:	block 16		;gtjfn argument block

enddata


;COMND - MACRO FOR BUILDING FUNCTION DESCRIPTOR BLOCK

DEFINE FLDDB. (TYP,FLGS,DATA,HLPM,DEFM,LST) {
	..xl←← typ⊗11
    ifdif {flgs⎇ {⎇ {..xl←←..xl!<flgs⊗-22>⎇
    ifdif {hlpm⎇ {⎇ {..Xl←←<cm%hpp⊗-22>!..Xl⎇
    ifdif {defm⎇ {⎇ {..Xl←←<cm%dpp⊗-22>!..Xl⎇
    ifdif {lst⎇  {⎇ {xwd ..xl,lst⎇
    ifidn {lst⎇  {⎇ {xwd ..xl,0⎇
    ifdif {data⎇ {⎇ {data⎇
    ifidn {data⎇ {⎇ {0⎇
    ifdif {hlpm⎇ {⎇ {point 7,[asciz \hlpm\]⎇
    ifidn {hlpm⎇ {⎇ {0⎇
    ifdif {defm⎇ {⎇ {point 7,[asciz \defm\]⎇
    ifidn {defm⎇ {⎇ {0⎇⎇

cmacfm:	flddb. (.cmcma,,,,,<[
	flddb. (.cmcfm)]>)	;comma or confirm

cmacpn:	flddb. (.cmcma,,,,,<[
	flddb. (.cmtok,,<point 7,[asciz \)\]>)]>) ;comma or close parens

onopak:	flddb. (.cmnum,,10,,,<[
	flddb. (.cmtok,,<point 7,[asciz \(\]>,,,<[
	flddb. (.cmkey,,akwtab)]>)]>) ;octal number, open parens,
				; or arithmetic keyword
bail<
onopbk:	flddb. (.cmnum,,10,,,<[
	flddb. (.cmtok,,<point 7,[asciz \(\]>,,,<[
	flddb. (.cmkey,,bkwtab)]>)]>) ;octal number, open parens,
				; or bail keyword
>;bail
onopfk:	flddb. (.cmnum,,10,,,<[
	flddb. (.cmtok,,<point 7,[asciz \(\]>,,,<[
	flddb. (.cmkey,,fkwtab)]>)]>) ;octal number, open parens,
				; or format keyword

swisou:	flddb. (.cmswi,,switab,<Source file name
 or>)	;parse switch indicating source file name ok, too

swiccf:	flddb. (.cmswi,,switab,<","
 or confirm with carriage return
 or>)	;parse switch indicating comma, confirm ok, too



fdini:	flddb. (.cmini)

fdifi:	flddb. (.cmifi)		;parse an input file spec

fdofi:	flddb. (.cmofi)		;parse an output file spec

fdfil:	flddb. (.cmfil,cm%sdh,,arbitrary) ;parse an arbitrary file spec

fdakw:	flddb. (.cmkey,,akwtab)	;parse arithmetic keywords

akwtab:	akwtln,,akwtln
	[asciz \ADJSP\],,[10,,anoi10]
	[asciz \F10\],,[20,,anoi20]
	[asciz \FIXR\],,[2,,anoi2]
	[asciz \FLTR\],,[4,,anoi4]
	[asciz \KIFIX\],,[1,,anoi1]
	akwtln==.-akwtab-1

anoi1:	flddb. (.cmnoi,,<point 7,[asciz \for real to integer conversion\]>)
anoi2:	flddb. (.cmnoi,,<point 7,[asciz \for real to integer conversion\]>)
anoi4:	flddb. (.cmnoi,,<point 7,[asciz \for integer to real conversion\]>)
anoi10:	flddb. (.cmnoi,,<point 7,[asciz \KL-only stack manipulation\]>)
anoi20:	flddb. (.cmnoi,,<point 7,[asciz \calling sequence for FORTRAN\]>)

bail<
fdbkw:	flddb. (.cmkey,,bkwtab)	;parse bail keywords

bkwtab:	bkwtln,,bkwtln
	[asciz \DESCRIPTORS\],,[4,,bnoi4]
	[asciz \NOLOAD\],,[10,,bnoi10]
	[asciz \PC\],,[1,,bnoi1]
	[asciz \PREDECLARED\],,[20,,bnoi20]
	[asciz \SYMBOLS\],,[2,,bnoi2]
	bkwtln==.-bkwtab-1

bnoi1:	flddb. (.cmnoi,,<point 7,[asciz \to source/listing directory\]>)
bnoi2:	flddb. (.cmnoi,,<point 7,[asciz \information included\]>)
bnoi4:	flddb. (.cmnoi,,<point 7,[asciz \for SIMPLE procedures\]>)
bnoi10:	flddb. (.cmnoi,,<point 7,[asciz \SYS:BAIL.EXE automatically\]>)
bnoi20:	flddb. (.cmnoi,,<point 7,[asciz \SAIL runtimes known\]>)
>;bail

fdfkw:	flddb. (.cmkey,,fkwtab)	;parse format keywords

fkwtab:	fkwtln,,fkwtln
	[asciz \BRACKET-MACROS\],,[20,,fnoi20]
	[asciz \EXPAND-MACROS\],,[10,,fnoi10]
	[asciz \LINES-NUMBERS\],,[2,,fnoi2]
	[asciz \MACRO-NAMES\],,[4,,fnoi4]
	[asciz \NOBANNER\],,[100,,fno100]
	[asciz \NOLIST\],,[40,,fnoi40]
	[asciz \PC\],,[1,,fnoi1]
	fkwtln==.-fkwtab-1

fnoi1:	flddb. (.cmnoi,,<point 7,[asciz \to listing file\]>)
fnoi2:	flddb. (.cmnoi,,<point 7,[asciz \from source to listing file\]>)
fnoi4:	flddb. (.cmnoi,,<point 7,[asciz \listed before expansion\]>)
fnoi10:	flddb. (.cmnoi,,<point 7,[asciz \in listing file\]>)
fnoi20:	flddb. (.cmnoi,,<point 7,[asciz \with < and >\]>)
fnoi40:	flddb. (.cmnoi,,<point 7,[asciz \generated\]>)
fno100:	flddb. (.cmnoi,,<point 7,[asciz \at the top of each page\]>)

fdcsw:	flddb. (.cmswi,,cswtab)	;parse a cref switch

cswtab:	cswtln,,cswtln
	[asciz \CREF\],,0
	cswtln==.-cswtab-1

fdswi:	flddb. (.cmswi,,switab)	;parse from a list of switches

switab:	switln,,switln
	[asciz \ARITHMETIC:\],,ariswt
bail<
	[asciz \BAIL:\],,baiswt
>;bail
	[asciz \BINARY:\],,binswt
	[asciz \CREF:\],,crfswt
	[asciz \DEFINITION-PDL:\],,dpdswt
	[asciz \EXTENDED\],,extswt
	[asciz \FORMAT:\],,fmtswt
	[asciz \GO\],,goswt
	[asciz \LIST:\],,lstswt
	[cm%fw+cm%inv
	asciz \MODE-FOR-DEBUGGING:\],,modswt
	[asciz \NOBINARY\],,nbinsw
	[asciz \NOCREF\],,ncrfsw
	[asciz \NOLIST\],,ncrfsw
	[asciz \OFFSET:\],,offswt
	[asciz \ONE-SEGMENT\],,oneswt
	[asciz \PARSE-STACKS:\],,ppdswt
	[asciz \PDL:\],,pdlswt
	[asciz \PROFILE\],,proswt
	[asciz \STRING-PDL:\],,spdswt
	[asciz \STRING-SPACE:\],,stsswt
	[asciz \TEST\],,tstswt
	[asciz \TWO-SEGMENT\],,twoswt
	switln==.-switab-1

extnoi:	flddb. (.cmnoi,,<point 7,[asciz \compiler facilities\]>)

gonoi:	flddb. (.cmnoi,,<point 7,[asciz \ahead and load after compiling\]>)

codnoi:	flddb. (.cmnoi,,<point 7,[asciz \code generated\]>)

offnoi:	flddb. (.cmnoi,,<point 7,[asciz \for PC in listing\]>)

pronoi:	flddb. (.cmnoi,,<point 7,[asciz \counters inserted\]>)

tstnoi:	flddb. (.cmnoi,,<point 7,[asciz \with DDT\]>)

fddnm:	flddb. (.cmnum,,12)	;parse a decimal number

fddsl:	flddb. (.cmnum,cm%sdh,12,<Decimal stack length
 or zero or the switch without a colon to double the current length>)
				;parse a decimal stack length

fdonm:	flddb. (.cmnum,,10)	;parse an octal number

fdcpn:	flddb. (.cmtok,,<point 7,[asciz \)\]>) ;parse a close parens

fdequ:	flddb. (.cmtok,,<point 7,[asciz \=\]>) ;parse an equals sign

fdopn:	flddb. (.cmtok,,<point 7,[asciz \(\]>) ;parse an open parens

fdcma:	flddb. (.cmcma)		;parse a comma

fdcfm:	flddb. (.cmcfm)		;comfirm command string



SUBTTL	Production Interpreter
>;TENX