Google
 

Trailing-Edge - PDP-10 Archives - -
There are no other files named in the archive.
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
?SM1TMP: BLOCK 40
>;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
				;-1 if doing RSCAN parse
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?
	skiple 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,SM1TMP]	;A NICE BIG TEMP AREA
;;#%%# ! JFR 4-23-75 TRY THIS FOR CHANGE
	MOVE	C,[111100000001]	;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,SM1TMP
	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,SM1TMP(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:	\]
	skipge xtflag
	hrroi a,[asciz \XSAIL:	\]	;special herald for extended
	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	DONE2			;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
done2:	
BAIL<
	skipge binjfn			;if no binary
	setzm bailon			;then suppress 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 COMPILERSWITCHES
	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__125		;parse field only
	 cm%hpp__124		;help pointer provided
	 cm%dpp__123		;default pointer provided
	 cm%sdh__122		;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"
	npxamb__602044		;"Ambiguous switch"

	;miscellany

	df%nrj__1b0		;don't release JFN on delf
	.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 is the scanner used to interface with the EXEC.  *
;*  Most of the subtlety is in getting the command in the  *
;*  first place.  See USR20 for the scanner used when the  *
;*  user runs SAIL directly.				   *
;***********************************************************

;Note: we want to use the COMND jsys, but we do not always have
; a file to scan, since the argument may be in a PRARG block.
; Thus we put the text to be scanned where the COMND jsys would
; have put it had you typed it in, and then simulate a reparse.
;Note that COMND suppresses <cr>'s.  So we must purge them.

;First get the commands from the EXEC

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
;Here we try to read a prarg block into TEXT and process it
	move a,[.prard,,.fhslf]	;a/ function,,process handle
	hrrzi b,text		;b/ address of block
	hrrzi c,ltext		;c/ length of block
	jsys prarg		;get program argument block
	ercal jshlt0		;handle errors
	caile c,ltext		;if block too long for text area
	jrst fousat		;fatal
	jumpe c,trytmp		;if nothing there, try .TMP file
	movn c,text		;minus number of lists to check
	hrlzi c,(c)		;set up aobjn counter 
	aos c			; with 1 as first offset
finsai:	move b,text(c)		;get offset of next list
	hlrz a,text(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
	jrst trytmp		;didn't find it, try for .TMP file

;Here when we get the command in TEXT.  B is an offset into TEXT,
;actually into TEXT+1 (i.e. B must be -1 to get TEXT).
fousai:	move a,[point 7,text]	;here's where we'll put the commands
	movei b,text+1(b) 	;this is the string with the commands
	hrli b,440700
	movni c,5*ltext		;the count of bytes which can be written
	hrlz c,c		;negative in LH (aobjn counter)
;Here we copy the string, purging <cr>'s.  This is because we are
; simulating the COMND jsys's having set up the buffer by a previous
; input and now doing a rescan.  COMND sets the flag to purge <cr>'s,
; and in fact demonstrably cannot handle <cr>'s in the buffer in
; certain cases.  Note that we are copying from TEXT into TEXT.  We
; are always moving backwards, so this is valid.
fousal:	ildb d,b		;get one
	cain d,15		;if <cr>
	jrst fousal		;ignore it
	idpb d,a
	jumpe d,fousan		;null - done
	aobjn c,fousal		;loop if still room for null
fousat: hrroi a,[asciz \?Command string too big for COMND buffer\]
	jsys psout
	jrst jshlt1		;fatal
;Now we have the commad string in TEXT - set up for COMND to read it
fousan:	hrrz a,c		;RH of aobjn is count of char's, not
				; including the 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
	move a,[point 7,cmpmt]
	movem a,costbl+.cmrty
	movei a,costbl		;a/ address of command state block
	movei b,fdini		;b/ function decsriptor address
	jsys comnd		;initialize command scanning
;Here we set things up to simulate a reparse
	pop p,costbl+.cminc	;characters are still there
	jrst reparc		;and go off to do actual parse

;Here to read from .TMP file
;make up file name in TEXT
trytmp:	gjinf			;no info in prarg, try .tmp file
				;build filename in core
	move a,[point 7,text,-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\] ;b/ pointer to string
	setz c,			;c/ number of bytes or zero
	sout			;append that string
;open the file
	hrlzi a,(gj%old+gj%sht)	;a/ flags (old file, short gtjfn)
	move b,[point 7,text,-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
;read it into TEXT
	hrroi b,text		;where to put the commands
	movni c,5*ltext-1	;how many char's to read
	sin
	delf			;delete the file
	 jfcl
	jumpe c,fousat		;file too long? - fatal
	setz a,			;put null in for copy routine
	idpb a,b
	seto b,			;fake offset for copy routine
	jrst fousai		;and go process text

;Now do the parse itself. Initialization.
;This code is just by prarg or .TMP commands.  It is enterred from fousai.

reparc:	pushj p,reinit		;reset all for reparse
;the following are defaults that are different for CCL commands
bail<
	movei b,37		;default to /bail:37
	movem b,bailon
> ;bail
	setom binjfn
;set up call to start off the finite-state machine
	movsi b,(gj%ofg)	;set up for .REL file
	movem b,gjblk+.gjgen
	setzm gjblk+.gjnam	;no default name
	hrroi b,[asciz \rel\]
	movem b,gjblk+.gjext
	movei b,lhs1		;start with 1st LHS spec
;Main dispatch for the finite-state machine.  The parsing is done
;  by a set of tables for COMND.  Each table is a list of 5-word
;  blocks.  The first 4 words are a COMND function descriptor.
;  The 5th word is the dispatch address to use if COMND finds an
;  argument described by that entry.  These tables are linked together
;  to form a simple finite-state machine.
;Since switches are legal anywhere, this always parses for switches
;  before parsing for the specified argument.  If the syntax changes,
;  I propose using LH(B) as a flag for whether switches are allowed.
;Note that file names are a bit kludgey, since the arguments are not
;  specified entirely in the function descriptor.  So before using
;  any table with a .CMFIL in it, we must set up GJBLK.

;Calling sequence:
;   Initialize GJBLK if .CMFIL is to be used.
;	MOVEI B,TABLE	;first entry in list of 5-word entries
;	JRST PARDIS	;look for one and dispatch

;In order to parse switches in every case, we insert the table
;passed in B into the "next" field of CCLSWI (an FDB for switches)
;and then use CCLSWI.  CCLSWI has a dispatch word pointing to
;PARDSW, the standard switch routine.
;  PARDIS - main entry - use a new table
;  PARDSL - entry after switch found - use same table as before
pardis:	hrrm b,cclswi		;link block he asked for after switches
pardsl:	movei a,costbl		;main comnd and dispatch
	movei b,cclswi
	jsys comnd		;look for what he wants
	tlne a,(cm%nop)		;legal?
	jrst nopars		;no - error and abort
	jrst @4(c)		;routine to process what we found

pardsw:	pushj p,usdosw		;process switch
	jrst pardsl		;now go back for more

;COMND - MACRO FOR BUILDING FUNCTION DESCRIPTOR BLOCK

DEFINE FLDDB. (TYP,FLGS,DATA,HLPM,DEFM,LST) {
	..xl__ typ11
    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}}

;Special macro for building the 5-word blocks.  Includes
;  simplified version of above.  
;	Dispatch is the routine to go to if something of this 
;	  type is found.
;	Next is a flag - non-empty is there is another entry
;	  following this one.

define field (typ,data,dispatch,next) {
   ifdif {next} {} {xwd typ11,.+5}
   ifidn {next} {} {xwd typ11,0}
   ifdif {data} {} {data}
   ifidn {data} {} {0}
	0
	0
   	xwd 0,dispatch}

define sym (str) {point 7,[asciz \str\]}
	

;Here are the tables that form the finite-state machine.  LSH1 is
;  the starting point.


;************************
;*  LSH1 - .REL file    *
;************************


lhs1:	field (.cmtok,<sym(=)>,dorhs,x)
	field (.cmtok,<sym(<,>)>,dolhs2,x)
	field (.cmfil,,dolsh1)

;dolsh1 - may be either binary or run file
dolsh1:	move a,b		;release dummy jfn
	rljfn
	erjmp jshlt0
	move d,costbl+.cmptr	;point to next char
	ildb d,d		;get next character
	cain d,"!"		;is next character "!"?
	jrst dorun		;yes, run the file
;now known to be binary
	movei a,erel1		;get the jfn for output .REL
	hrroi b,atom		;and reparse what is in atom buffer
	gtjfn
	 jrst nopars
	movem a,binjfn		;save jfn
	move b,a		;put where svdflt expects it
	pushj p,svdflt		;and save as default
	movei b,lhs2
	jrst pardis		;now back to main dispatch

;here to process a file to be run
dorun:	movei a,costbl
	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

;************************
;*  LHS2 - .LST file    *
;************************


lhs2:	field (.cmtok,<sym(=)>,dorhs,x)
	field (.cmtok,<sym(<,>)>,dolhs2)

dolhs2: movsi b,(gj%fou)	;set up for output file
	movem b,gjblk+.gjgen
	hrroi b,[asciz \lst\]	;set up for default .lst
	movem b,gjblk+.gjext
	movei b,lhs2a
	jrst pardis

lhs2a:	field (.cmtok,<sym(=)>,dorhs,x)
	field (.cmfil,,dlhs2a)

;dlhs2a - list file
dlhs2a:	movem b,lisjfn		;save jfn
	pushj p,svdflt		;save default file name, if none
	movei b,rhs
	jrst pardis		;now back for next field

;*********************************
;* RHS - = and then input files  *
;*********************************

rhs:	field (.cmtok,<sym(=)>,dorhs)

dorhs:	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,rhsfil		;parse for source file spec
	jrst pardis

rhsfil:	field (.cmfil,,dorhsf)

dorhsf: pushj p,svdflt		;save default file name, if none
	pushj p,savsou		;save source filespec
	movei b,rhsmor
	jrst pardis

rhsmor:	field (.cmtok,<sym(<,>)>,domore,x)
	field (.cmcfm,,done)

domore:	setz c,			;set up null byte
	idpb c,namptr		; and separate filespecs with one
	jrst inloop		;go get more input

;*******************************************************************
;*  Common routines for the EXEC linkage and the user command      *
;*  interface, though not all of these routines are actually used  *
;*  by both							   *
;*******************************************************************


;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

;  Note that this sets up defaults for the user scanner.  Any defaults
;  that are different for the EXEC linkage must be set up at REPARC.

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
	hllzs 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,^D4500		;[05] initial stmaxx, increased from
				;[05] 3500 to 4500 to prevent increased
				;[05] GC freq due to STRNG(SYM) fix.
	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,

;general error printer for errors that should abort the current
; command.  Since the EXEC interface is non-interactive,  all
; errors are fatal there.

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
	hrrei b,-1		;find last byte output
	adjbp b,a
	ldb b,b
	movei a,"J"-100		;output a linefeed
	cain b,"M"-100		; iff last char output was carriage return
	jsys pbout
	skipe tmpcnt		;and if doing ccl commands
	jrst jshlt1		; then die permanently
				; otherwise, fall thru

;**************************************************************
;*  Here is the command scanner for direct user interaction.  *
;**************************************************************


usr20:	skipe tmpcnt		;already done rscanned command?
	jrst [jsys haltf	;yes - done
		setzm tmpcnt	;if continue, normal restart
		jrst sail]
;First we check to see if there is a command to be had from rscan
	movei a,.rsini		;try to get command with rscan
	jsys rscan
	 jrst norm20		;failed, normal user interface
	jumpe a,norscn		;nothing there, normal user interface
	movei a,.priou		;set position to 0 to avoid extra crlf
	rfpos			;get current tty position
	hrri b,0		;set column to 0
	sfpos
	move a,[.priin,,.priou]	;normal jfn's
	movem a,costbl+.cmioj
	movei a,reparu
	movem a,costbl+.cmflg	;reparse addr
	move a,[point 7,cmnpmt]	;null prompt
	movem a,costbl+.cmrty
	movei a,costbl		;do .cmini
	movei b,fdini
	jsys comnd		;initialize comnd
	movem p,pdlsav		;save stack for reparse
	movei a,costbl		;
	movei b,fdrun		;see if RUN, R, or ERUN
	jsys comnd
	tlnn a,(cm%nop)		;if so
	jrst norscn		;use normal interface
	movsi a,(gj%ofg)	;parse only
	movem a,gjblk
	movei a,costbl
	movei b,fdfil		;now skip the SYS:SAIL.EXE
	jsys comnd
	tlne a,(cm%nop)		;was it there?
	jrst norscn		;no - use normal interface
	move a,b		;release the jfn
	jsys rljfn
	 jfcl
;We now do the initial field as at REPARU, except
;that we also allow CRLF.  If the user types CRLF, we kill the CCL
;mode and give him a normal prompt.
	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
	pushj p,setsou		;set up fdfil for source parsing
	setzm gjblk+.gjnam	;no default filename for source file
	movei b,rswsou		;get source file spec or switch
	setom tmpcnt		;say CCL mode (prevents loop if error)
	pushj p,comndj
	hrli c,331100		;byte ptr to ftn code
	ldb c,c			;get ftn code
	cain c,.cmcfm		;if <cr>
	jrst norscn		;cancel CCL mode
	jrst usinlr		;yes - continue rscan

;This reinitializes for normal user I/O in case no rescanned command
norscn:	hrroi a,[0]
	jsys rscan		;forget any rscanned stuff
	jfcl
norm20:	setzm tmpcnt		;not CCL mode (recycle if error)
	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
	move a,[point 7,cmpmt]	;use real prompt
	movem a,costbl+.cmrty
	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
;This is the reparse entry
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 b,swisou		;get source file spec or switch
	pushj p,comndj
	hrli c,331100		;byte ptr to ftn code
	ldb c,c			;c _ addr of ftn code
;Here the rescan code joins us
usinlr:	cain c,.cmswi		;was it switch?
	jrst usinla		;yes, go process switch		
	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 b,swiccf		;parse for switch, comma or carriage return
	pushj p,comndj
	hrli c,331100		;build byte pointer
	ldb c,c			;get matching function
	cain c,.cmswi		;switch?
	jrst usinl2		;yes, process switch
	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
; cclcrf is for CCL's /CREF, which doesn't take argument

cclcrf:	skipge lisjfn		;compiler gets confused if /CREF
	popj p,			;and no listing, so ignore if none
	jrst cclcr1
crfswt:	pushj p,lstswt		;get listing filespec
cclcr1:	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 b,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

;***************************************************************
;*  Here we have tables that can be used by both scanners,     *
;*  though more of them are used by the user command scanner.  *
;***************************************************************


data

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

cmpmt:	asciz \SAIL>\		;comnd prompt
cmnpmt:	asciz \\		;null prompt

	ltext__1000		;length of text buffer
text:	block ltext		;text input buffer

	latom__20		;length of atom buffer
atom:	block latom		;atom buffer

gjblk:	block 16		;gtjfn argument block

;This flddb. is in the lowseg because the code plays with the NEXT pointer
cclswi:	flddb. (.cmswi,,ccswtb)	;switches for CCL parse
	,pardsw			;dispatch if this one matches

enddata



swiccf:	flddb. (.cmcma,,,,,<[
	flddb. (.cmcfm,,,,,<[	;comma or confirm
	flddb. (.cmswi,,switab)]>)]>)	;or switch

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 or switch
	flddb. (.cmfil,cm%sdh,,source file)]>)

;rswsou is a special version of swisou for use in RSCAN.  It also
;allows a <crlf> (though it is silent about this is the help message)
;in case the user doesn't want to type the arg's on the same line.
rswsou: flddb. (.cmcfm,cm%sdh,,,,swisou)


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\]>)

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
	[cm%fw+cm%inv+cm%abr
	asciz \S\],,stspa
	[cm%fw+cm%inv+cm%abr
	asciz \ST\],,stspa
	[cm%fw+cm%inv+cm%abr
	asciz \STR\],,stspa
	[cm%fw+cm%inv+cm%abr
	asciz \STRI\],,stspa
	[cm%fw+cm%inv+cm%abr
	asciz \STRIN\],,stspa
	[cm%fw+cm%inv+cm%abr
	asciz \STRING\],,stspa
	[cm%fw+cm%inv+cm%abr
	asciz \STRING-\],,stspa
	[asciz \STRING-PDL:\],,spdswt
stspa:	[asciz \STRING-SPACE:\],,stsswt
	[asciz \TEST\],,tstswt
	[asciz \TWO-SEGMENT\],,twoswt
	switln==.-switab-1

;Special switch table for CCL use.  Note that switches specifying 
;  .REL or listing output are not appropriate for CCL use, since
;  that is handled otherwise.  Hence this list is missing a few
;  entries that are present above.

ccswtb:	ccswln,,ccswln
	[asciz \ARITHMETIC:\],,ariswt
bail<
	[asciz \BAIL:\],,baiswt
>;bail
	[asciz \CREF\],,cclcrf
	[asciz \DEFINITION-PDL:\],,dpdswt
	[asciz \EXTENDED\],,extswt
	[asciz \FORMAT:\],,fmtswt
	[cm%fw+cm%inv
	asciz \MODE-FOR-DEBUGGING:\],,modswt
	[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 \TWO-SEGMENT\],,twoswt
	ccswln==.-ccswtb-1

fdrun:	flddb. (.cmkey,,runktb)

runktb:	runktl,,runktl
	[asciz \ERUN\],,0
	[asciz \RUN\],,0
	[asciz \START\],,0
	runktl==.-runktb-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