perm filename CC[10X,AIL]11 blob sn#189230 filedate 1975-12-01 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00018 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	
C00003 00003	TENX<TENEX COMMAND SCANNER
C00005 00004	DSCR	COMND
C00009 00005	CMDSCN:	
C00014 00006	GOSUB:	IDPB	A,CMDPTR		SAVE WHATEVER CHAR IT WAS
C00017 00007	SUBCMD:	SKIPE	RPGSW
C00018 00008
C00020 00009	GETLST:
C00021 00010	PSWIT:
C00023 00011	DONE:	
C00025 00012	DSCR	Routines to print out info
C00027 00013
C00028 00014	DSCR	Typing routines
C00029 00015	DSCR	Long form GTJFN tables.
C00031 00016
C00036 00017
C00037 00018
C00038 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
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

⊗

	
COMND:	
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

	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:	
	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
	  JRST	.+4
	 SETOM	BINJFN			;INDICATE NO BINARY
	 IDPB	A,CMDPTR
	 JRST	GETSA1
	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,"←"			;
	   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
	CAIN	A,"←"			;ARROW MEANS
	  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,RACS]	;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,RACS
	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,RACS(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
	JRST	SUBCMD			;MORE SUBCOMMANDS?
DONE:	
	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

↑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
 
!]
	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:
	ILDB	A,SWTPTR
	POPJ	P,


.NXTCHR:
	PUSH	P,B
	SKIPN	A,CMDJFN
	  JRST	.NXT1
	JSYS	BIN
	MOVEM	A,CMDJFN
.NXTRET:
	MOVE	A,B	
	POP	P,B
	POPJ	P,		 
.NXT1:
	MOVEI	A,100			;PRIMARY INPUT
	JSYS	BIN
	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		
	HRRZI	1,37		;EOL
	SKIPE	SWTLNK
	JSYS	PBOUT		;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



SUBTTL	Production Interpreter
>;TENX