perm filename SAIL[X,AIL] blob sn#241609 filedate 1976-10-16 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00046 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00004 00002	HISTORY
C00014 00003	
C00015 00004	Command File Descriptions
C00017 00005	Titles, Switch Settings
C00019 00006	HISTORY OF STUFF THAT USED TO BE IN HEAD
C00023 00007	DSCR EXCHOP
C00024 00008	DSCR LODBLK (TYPE,TYP1,NAME,NAME1,COUNT,COUNT1,RELOC)
C00027 00009	  MACROS FOR MANIPULATING SEMBLKS (SEE SAIL DATA DESCRIPTIONS)
C00029 00010	  MACROS FOR MANIPULATING SEMANTICS, CALLING GENERATOR ROUTINES,
C00033 00011	 Q-STACK HANDLERS
C00037 00012	Sail ACs, File Indices
C00039 00013	Sail Bits
C00047 00014	Externals, Data Allocation
C00050 00015	ZERODATA (MAIN-SEMANTICS POINTERS)
C00059 00016	II.  SEMANTICS VARIABLES
C00070 00017	ZERODATA(DISPLAY REGISTER HANDLING VARIABLES)
C00072 00018	ZERODATA (MAIN-SCANNER VARIABLES)
C00076 00019	ZERODATA (MAIN-PARSER VARIABLES)
C00087 00020	ZERODATA (MAIN-SOURCE AND LISTING FILE VARIABLES)
C00091 00021	DATA (SWITCHED VARIABLES)
C00101 00022	ZERODATA (GLOBAL STATE VARIABLES)
C00104 00023	ZERODATA (COUNTER SYSTEM VARIABLES)
C00106 00024	DATA (RANDOM GLOBAL THINGS)
C00109 00025	 SLS VARIABLES
C00111 00026	DATA (INITIAL PROC DESC SEMBLKS)
C00112 00027	Executive and Initialization
C00114 00028	Start, Ddtkil -- Once-only code to zap RAID, symbols
C00119 00029	 Larger, Sail --  Execution Starts Here
C00125 00030
C00128 00031	 Morfiles -- Execution Returns Here Each New Command Line
C00136 00032
C00141 00033	 Salnit -- Storage Initialization, Etc.
C00151 00034	 XTCOPY, RESTORE PREVIOUS STATE OF .REL FILE 
C00157 00035	Comnd, aux. routs -- Command Scanner
C00162 00036	 Opnup -- Open Files
C00165 00037	 Comnd Itself
C00177 00038	 Unswt -- End of Switched-to-File
C00179 00039	 Filnam
C00189 00040	 Delim -- Handle Switches
C00192 00041
C00195 00042
C00201 00043
C00203 00044	 Word
C00206 00045	 Tyi
C00210 00046
C00211 ENDMK
C⊗;
COMMENT ⊗HISTORY
AUTHOR,FAIL,REASON
031  102200000016  ⊗;
DEFINE .VERSION <102200000017>

COMMENT ⊗
VERSION 18-1(12) 3-1-75 BY RLS ADD TNXBND FOR TENEX ADVBUF -- (SHOULD BE DONE FOR DEC TOO PROBABLY)
VERSION 18-1(11) 2-16-75 BY JFR BAIL FLAG FOR REQUESTING SYS:BAIPDn.REL		P.24
VERSION 18-1(10) 2-15-75 BY RLS JUST LOOKING
VERSION 18-1(9) 2-15-75 BY RLS TENEX CHANGE -- PUT SRCTTY IN SWITCHED AREA
VERSION 18-1(8) 2-1-75 BY JFR BAIL FLAG FOR SKIPPING SYS:BAIL.REL	P.24
VERSION 18-1(7) 2-1-75 BY RLS MAKE EXPR!TYPE RECURSIVE
VERSION 18-1(6) 2-1-75 BY RLS MAKE EXPR!TYPE RECURSIVE
VERSION 18-1(5) 11-27-74 BY JFR AVLSRC BEING SET INCORRECTLY P. 31
VERSION 18-1(4) 11-7-74 BY JFR KEEP TRACK OF PPN IN CDB
VERSION 18-1(3) 10-20-74 BY RHT FEAT %BT% -- MAKE OUTER BLOCK PD LOOK BETTER
VERSION 18-1(2) 10-18-74 BY RHT JUST CHECKING
VERSION 18-1(1)	 10-17-74 BY RHT VERSION 18
VERSION 17-1(54) 10-16-74 BY JFR JUST CHECKING
VERSION 17-1(53) 10-16-74 BY JFR FIX BAIL SOURCE FILE COUNTING
VERSION 17-1(52) 10-10-74 BY RLS PARAMETERIZE DEFAULT DEF STACK SIZE
VERSION 17-1(51) 9-26-74 BY JFR FILE NAMES OUTPUT TO .SM1 FILE
VERSION 17-1(50) 9-20-74 BY JFR INSTALL BAIL
VERSION 17-1(49) 9-20-74 
VERSION 17-1(48) 9-20-74 
VERSION 17-1(47) 9-20-74 
VERSION 17-1(46) 9-20-74 BY RHT FIX RHT'S STUPID MISTAKE
VERSION 17-1(45) 5-28-74 BY RHT BUG #SD# ADD NEW FLAG (IEFLAG)
VERSION 17-1(44) 4-12-74 BY RHT ADD BIT TO ALLTYPS
VERSION 17-1(43) 4-6-74 BY RLS EDIT
VERSION 17-1(42) 4-6-74 BY RLS TENEX FIX TO PARC LOADER INTERFACE
VERSION 17-1(41) 3-25-74 BY JRL WE NOW USE LOADER 54 BLOCK CODES (LIBRARIES, LOAD MODULES)
VERSION 17-1(40) 3-19-74 BY RHT LOOK AT RS ADDITIONS
VERSION 17-1(39) 3-17-74 BY RLS EDIT
VERSION 17-1(38) 3-17-74 BY RLS TENEX FEATURES
VERSION 17-1(37) 1-11-74 BY RHT TURN OFF BAISW (DAMMIT!!!)
VERSION 17-1(36) 1-11-74 BY JRL CMU CHANGE PPN'S DDTKIL
VERSION 17-1(35) 1-11-74 
VERSION 17-1(34) 1-11-74 
VERSION 17-1(33) 1-11-74 
VERSION 17-1(32) 1-6-74 BY KVL ADD %BC% BAIL SYMBOL OUTPUTTING STUFF
VERSION 17-1(31) 12-7-73 BY JRL BUG #PS# DELAY SETTING UP OF MYERR
VERSION 17-1(30) 12-7-73 BY RHT DITTO
VERSION 17-1(29) 12-7-73 BY RHT NO REAL REASON
VERSION 17-1(28) 12-7-73 
VERSION 17-1(27) 12-7-73 
VERSION 17-1(26) 12-7-73 BY rht get .version back
VERSION 17-1(25) 12-6-73 BY JRL REMOVE AS MANY SPECIAL STANFORD CHARACTERS AS POSSIBLE
VERSION 17-1(24) 12-4-73 BY RHT BUG #PN# NEEDED TO GET JOBFF OK AT START -- DID RESET TO FIX
VERSION 17-1(23) 12-4-73 
VERSION 17-1(22) 12-3-73 BY RHT TURN  CALL INTO A CALL6
VERSION 17-1(21) 12-3-73 BY RHT FEAT %AY% USE INTMAP RUNTIME ROUTINE
VERSION 17-1(20) 12-3-73 
VERSION 17-1(19) 12-2-73 BY RHT GET BACK AN OLDER VERSION AFTER DISASTER
VERSION 17-1(18) 11-25-73 BY RHT FEAT %AO% .SEG2. MAY DO A SETPR2 
VERSION 17-1(17) 11-24-73 BY RHT FEAT %AL% MAKE OUTER BLOCK LOOK LIKE A PROCEDURE
VERSION 17-1(16) 11-24-73 
VERSION 17-1(15) 11-24-73 BY RHT TRANSFER IN STUFF THAT USED TO BE IN HEAD
VERSION 17-1(14) 11-24-73 
VERSION 17-1(13) 11-24-73 
VERSION 17-1(12) 11-24-73 
VERSION 17-1(11) 11-24-73 
VERSION 17-1(10) 11-24-73 
VERSION 17-1(9) 11-24-73 
VERSION 17-1(8) 11-24-73 
VERSION 17-1(7) 11-22-73 BY RHT INCREASE DATA AREAS
VERSION 17-1(6) 11-22-73 BY RHT FIX KVL TYPO
VERSION 17-1(5) 11-10-73 BY KVL INSERT CHANGES TO LOG ERR UUO
VERSION 17-1(4) 9-19-73 BY HJS ADD EVALREDEFINE AND CVPS
VERSION 17-1(3) 8-17-73 BY JRL MAKE LOADVR=52 ONLY FOR NOEXPR
VERSION 17-1(2) 8-16-73 BY jrl ifn out references to LEP
VERSION 17-1(1) 8-6-73 BY HJS BUG #NO# FIX EXTRA ENDC,ELSEC ERROR MESSAGE
VERSION 17-1(0) 7-26-73 BY RHT **** VERSION 17 !!! ***
VERSION 16-2(56) 7-26-73 BY JRL INCREASE ZERODATA SIZE FOR NON FTDEBUG
VERSION 16-2(55) 7-11-73 
VERSION 16-2(54) 7-11-73 
VERSION 16-2(53) 6-19-73 BY HJS IFCR, REDEFINE, EVALDEFINE, AND ASSIGNC IMPLEMENTATION 
VERSION 16-2(52) 5-17-73 BY HJS INITIALIZE ENDC COUNTER TO -1
VERSION 16-2(51) 3-15-73 BY JRL BUG #LT# <SOURCE-FILE NOT FOUND > ERRMSG
VERSION 16-2(50) 3-13-73 BY JRL REMOVE REFERENCES TO GAG,WOM,SLS,NODIS
VERSION 16-2(49) 12-13-72 
VERSION 16-2(48) 12-13-72 BY JRL BUG #KS# ADD LOADVR SWITCH
VERSION 16-2(47) 11-14-72 BY RHT MAKE .REL FILES DUMP NEVER
VERSION 16-2(46) 11-13-72 BY RHT BUG #KC# -- PDA,,0 FIXUP FOR HIGH SEG MESSED UP
VERSION 16-2(45) 9-27-72 BY HJS FORCE EXECUTION OF BLOCK WHEN A DEFINE IS THE ONLY DECLARATION IN THE BEGINNING OF A BLOCK.
VERSION 16-2(44) 8-13-72 BY DCS UPDATE COMMAND FILE DESCRIPTIONS
VERSION 16-2(41) 7-5-72 BY DCS BUG #IH# KEEP RAID IN DISK FILE, NOT CORE IMAGE
VERSION 16-2(40) 7-2-72 BY RHT INCREASE ZSIZE FOR NON FTDEBUG PART
VERSION 16-2(39) 6-25-72 BY DCS BUG #HX# PARAMETERIZE PROCESSOR NAME, DEFAULT EXT
VERSION 16-2(38) 6-21-72 BY RHT CHANGE THE WAY PDA,,0 SEMBLK IS LINKED
VERSION 16-2(37) 5-14-72 BY DCS BUG #HH# BETTER INITIAL CODE IF /H
VERSION 15-6(18-36) 4-6-72 LOTS OF THINGS
VERSION 15-6(17) 2-21-72 BY HJS THE BRAVE NEW PARSER WORLD
VERSION 15-6(12) 2-18-72 BY RHT THE BRAVE NEW WORLD
VERSION 15-6(11) 2-10-72 BY DCS BUG #GR# MINOR FTDEBUGGER FIXES
VERSION 15-6(10) 2-6-72 BY DCS BUG #GP# CHECK FORWARD FORMALS AGAINS REAL FORMALS
VERSION 15-6(9) 2-5-72 BY DCS BUG #GJ# ADD LSTON LISTING CONTROL STUFF
VERSION 15-6(8) 2-1-72 BY DCS BUG #GH# USE INTERRUPTS TO DO ASYNCH BREAKS, 6M MEANS SCAN BREAK
VERSION 15-6(7) 2-1-72 BY DCS BUG #GE# MODIFY FOR NEW %ALLOC INTERFACE
VERSION 15-6(6) 1-3-72 BY DCS BUG #FX# REMOVE COM2, COM2SW COMPLETELY
VERSION 15-6(5) 12-24-71 BY DCS BUG #FF# ADD FILE NAME ID TO FILE NOT FOUND MSG
VERSION 15-6(4) 12-22-71 BY DCS BUG #FT# ADD BINLIN
VERSION 15-6(3) 12-22-71 BY DCS BUG #FS# REMOVE SAILRUN, MOST COM2 CONDITIONALS
VERSION 15-2(2) 12-2-71 BY DCS SET UP VERSION NUMBER IN OBJECT COMPILER
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
⊗;

COMMENT ⊗















			There was a compiler named SAIL,
			Assembled and coded in FAIL.
			Its authors, they say
			  (one glorious day)
			Were run out of town on a rail.











⊗

COMMENT ⊗Command File Descriptions

The following command files make compilers:

1.	IT
	Standard Stanford Sail compiler, 1 or 2 segments, Leap, Global, no Debugging

RESTAB.=PROD+FOO2/NOLIST/NOLO/NON RTRAN
PROD.=HEL/NOLIST/NOLO/NON PTRAN
SAIL=CALLIS(LR)+HEAD+FILSPC+SAIL+PARSE+HEL+FOO2+PROD/FORWARD+RESTAB/FORWARD  ;
+SYM+GEN+ARRAY+EXPRS+STATS+LEAP+TOTAL+PROCSS+COMSER

2.	THAT
	Same, except Debugging turned on

RESTAB.=PROD+FOO2/NOLIST/NOLO/NON RTRAN
PROD.=HEL/NOLIST/NOLO/NON PTRAN
SAIL=CALLIS(LR)+HEAD+FILSPC+DB+SAIL+PARSE+HEL+FOO2+PROD/FORWARD+RESTAB/FORWARD  ;
+SYM+GEN+ARRAY+EXPRS+STATS+LEAP+TOTAL+PROCSS+COMSER

3.	There will eventually be a file to make a truly two-segment SAIL.
⊗

COMMENT ⊗Titles, Switch Settings⊗
TITLE SAIL -- Stare at it Later
	SUBTTL	D. SWINEHART, R. SPROULL -- FEBRUARY 1969
; Revised as of 20 Mar 1971 DCS-RFS
SUBTTL	SAIL ASSEMBLY SPECIFICATIONS
	LSTON	(SAIL)		;LIST IF ENABLED

BIT2DATA (CONDITIONAL ASSEMBLY SWITCHES)

; ** CONDITIONAL SETTINGS **

;?SAILRUN←←-1			;SWITCH USED NO LONGER
?LEAPSW ←←1			;IT CAN DO LEAP
				; (IF YOU MAKE IT 0, ALSO REMOVE THE LEAP
				; STUFF FROM HEL, THE PRODUCTION COMPILER)
;; #KS BY JRL LOADVR SWITCH
STSW (LOADVR,=54)		;ASSUME LOADER 54
STSW (FTDEBUG,0)		;DON'T USUALLY DEBUG (MUST BE 0 OR 1)
STSW	(RENSW,1)		;USUALLY ALLOW RE-ENTRANT CODE GENERATION
NOEXPO <
	?GLOBC←←1		;DON'T USUALLY DO GLOBAL UNLESS
>;NOEXPO
STSW (GLOBC,0)			;STANFORD LEAP COMPILER
?PATSW←←0			;ON UNTIL GET NEW SEGMENT UP
STSW (PATSW,0)			;IF SET, INCLUDE AOS `PAT' ON ENTRY,
			; SOS `PAT' ON EXIT FROM PROC (Proc Active Tally)

?TIMER←←0			;IF SET, INCLUDE A LITTLE TIMER TO SEE HOW
				; THINGS GO.  THIS IS A LITTLE INSTRUCTION
				; INTERPRETER IN FILE "PARSE"

;; ! JFR 10-19-75 used to be 0 for Stanford
STSW	(TMPCSW,1)

;; %AZ%  BY KVL (1/3/74)

; **			**

ENDDATA

COMMENT ⊗HISTORY OF STUFF THAT USED TO BE IN HEAD

AUTHOR,REASON
021  102100000002  ⊗;


COMMENT ⊗
VERSION 17-2(47) 11-10-73 BY RHT ADD CORERR, ERRPRI, ERFLGS BITS
VERSION 17-1(46) 7-26-73 BY RHT TRY VERSION 17
VERSION 17-1(45) 7-26-73 *********************
VERSION 16-2(44) 7-9-73 BY JRL REMOVE LAST REFERENCES TO DCS SWITCH
VERSION 16-2(43) 4-23-73 BY RHT CHANGE ARGTYP TO RFITYP
VERSION 16-2(42) 2-7-73 BY RHT ADD TYPE FOR ARG LIST ITEM
VERSION 16-2(41) 1-28-72 BY JRL PUT QBIND,FBIND HERE SO STATS CAN USE
VERSION 16-2(40) 1-23-73 BY RHT MAKE NIC & UNBOUND THE SAME
VERSION 16-2(39) 1-23-73 BY JRL CHANGE CODE FOR UNBND
VERSION 16-2(38) 1-8-73 BY JRL ADD MAXLOC MAXIMUM NUMBER OF FOREACH LOCAL ITEMVARS ALLOWED
VERSION 16-2(37) 12-13-72 BY jrl BUG #KS# ADD LOADVR SWITCH
VERSION 16-2(36) 11-21-72 
VERSION 16-2(35) 11-10-72 BY HJS MODIFY QPOP TO TAKE AS AN ARGUMENT AN ADDRESS FOR THE POPPED ENTRY
VERSION 16-2(34) 10-16-72 BY JRL CHANGE INVTYP TO 31 TO ALLOW CONTEXT ARRAY ITEMS
VERSION 16-2(33) 9-15-72 BY RHT ADD USER TABLE ENTRIES FOR INTERRUPTS
VERSION 16-2(32) 8-27-72 BY RHT PUT CELL FOR STACK UNWINDER RET ADRS IN USER TABLE
VERSION 16-2(31) 8-23-72 BY JRL ADD UNBND "ITEM"
VERSION 16-2(30) 8-20-72 BY RHT MODIFY USER TABLE
VERSION 16-2(29) 8-6-72 BY RHT ADD PRILIS TO USER TABLE
VERSION 16-2(28) 8-3-72 BY JRL ADD MPBIND TO TBITS DEFS FOR MATCHING PROCEDURES
VERSION 16-2(27) 7-27-72 BY RHT MAKE MACRO FOR DECLARING PD. ENTRIES
VERSION 16-2(26) 7-20-72 BY JRL CHANGE ARRTYP VALUE
VERSION 16-2(25) 7-20-72 BY RHT ADD PROCESS ITEM (TYPE 11)
VERSION 16-2(24) 6-20-72 BY DCS BUG #HU# BETTER TTY INFORMATION
VERSION 16-2(23) 5-16-72 BY DCS INTRODUCE VERSION 16
VERSION 15-2(9-22) 5-4-72 LOTS OF THINGS
VERSION 15-2(8) 2-19-72 BY RHT THE BRAVE NEW WORLD
VERSION 15-2(7) 2-5-72 BY DCS BUG #GJ# ADD LSTON LISTING CONTROL STUFF
VERSION 15-2(6) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR DUE TO NEW `CAT'
VERSION 15-2(5) 2-1-72 BY DCS BUG #GE# INSTALL SYMB %ALLOC BLK INDICES
VERSION 15-2(4) 1-31-72 BY DCS BUG #GE# UPDATE USER TABLE, %ALLOC BITS, INDICES
VERSION 15-2(3) 1-3-72 BY DCS BUG #FX# REMOVE COM2, COM2SW COMPLETELY
VERSION 15-2(2) 12-24-71 BY DCS BUG #FF# REMOVE SAILRUN(ASSUME RUNTIM OR LIB)
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER

⊗;

DSCR EXCHOP
DES Exchange Semantic entries in PNT,TBITS,SBITS with those
 in PNT2,TBITS2,SBITS2 -- since "GENMOV" routines generally
 operate on the first set of ACs.
⊗
DEFINE EXCHOP	<
	EXCH	PNT,PNT2
	EXCH	TBITS,TBITS2
	EXCH	SBITS,SBITS2	>

DSCR MOVOPS
DES Copy Semantic entries from PNT,TBITS,SBITS into
 PNT2,TBITS2,SBITS2
⊗;
DEFINE MOVOPS	<
	MOVE	PNT2,PNT
	MOVE	TBITS2,TBITS
	MOVE	SBITS2,SBITS
>

DSCR LODBLK (TYPE,TYP1,NAME,NAME1,COUNT,COUNT1,RELOC)
CAL MACRO
PAR TYPE, TYP1 are the symbolic and numeric reps of
  a LOADER block type
 NAME, NAME1 are the labels to be given the block and
  its descriptor (optional, see below)
 COUNT, COUNT1 are the data count and the total count
  for the descriptor (optional, etc.)
 RELOC describes the initial relocation bits
RES if NAME1 is present, a descriptor word is put out
  to provide GBOUT with count info for entire block
 Then the Type,,count word is output, labeled NAME
 Following is the RELOC word, then a block long enough
  to hold data
SEE GBOUT, Loader blocks (ENTTAB, BINTAB, etc.)
⊗
DEFINE LODBLK (TYPE,TYP1,NAME,NAME1,COUNT,COUNT1,RELOC) <

; Create LOADER OUTPUT BLOCK of type TYPE (really the
;  integer TYP1.  Name it NAME.  Give it a data count
;  of COUNT.  If there is a NAME1, create a descriptor
;  for GBOUT of the form [(COUNT1 or COUNT+2),,NAME].
;  Issue a reloc word of (RELOC or 0).
;  Put out a COUNT-word block for holding the data

IFNB (NAME1) <


;DESCRIPTOR FOR GBOUT ROUTINE
↑↑NAME1:
IFNB (COUNT1) <
	XWD	COUNT1,NAME;>	XWD   COUNT+2,NAME
>

;LOADER BLOCK HEADER
↑↑NAME: XWD	TYP1,COUNT

;RELOCATION BITS
IFNB (RELOC) <
	RELOC;>			0

;DATA WORDS
	BLOCK	COUNT
>;LODBLK


;  MACROS FOR MANIPULATING SEMBLKS (SEE SAIL DATA DESCRIPTIONS)

DSCR GETBLK (X)
CAL MACRO
PAR X is address (optional)
RES into LPSA (and X) is put address of new Semblk (zeroed)
SID LPSA, X changed -- probably TEMP too
SEE BLKGET, the routine it calls, and main SAIL data descriptions
⊗
DEFINE GETBLK ( X ) <
	PUSHJ	P,BLKGET
	IFDIF <X><>,<HRRM	LPSA,X>>

DSCR FREBLK (X)
CAL MACRO
PAR X (optional) is address of Semblk (LPSA is default)
RES Semblk is released to free Semblk list
SID TEMP, LPSA changed
SEE BLKFRE, the routine used, and main SAIL data descriptions
⊗
DEFINE FREBLK ( X ) <
	IFIDN <><X>,<PUSH P,LPSA;>  PUSH P,X
	PUSHJ	P,BLKFRE
	>

;	TAKE CDR OF A LINKED LIST, GOING ALONG LINK Y. GO TO Z
;		IF LIST IS EXHAUSTED.
DEFINE RIGHT (X,Y,Z ) <
	IFDIF <X><>,<MOVE LPSA,X>
	HRRZ	LPSA,Y(LPSA)
	IFDIF <Z><>,<JUMPE	LPSA,Z>>

;	SAME FOR MOVING LEFT ALONG A LINK.
DEFINE LEFT (X,Y,Z) <
	IFDIF <><X>,<MOVE LPSA,X>
	HLRZ	LPSA,Y(LPSA)
	IFDIF <><Z>,<JUMPE LPSA,Z>>

;  MACROS FOR MANIPULATING SEMANTICS, CALLING GENERATOR ROUTINES,
;  GENERATING CALLS ON RUNTIME ROUTINES ON BEHALF OF COMPILED CODE, ETC.

; PICK UP SEMANTICS WORDS FOR A PARSER TEMPORARY.
DEFINE GETSEM (X) <
	MOVE	PNT,GENLEF+X
	PUSHJ	P,GETAD	>

; SAME, BUT PUT SEMANTICS IN TBITS2,SBITS2
DEFINE GETSM2 (X) <
	MOVE	PNT2,GENLEF+X
	PUSHJ	P,GETAD2 >


DSCR GENMOV (Z,X,Y)
DES MACRO TO FACILITATE CALLING GENERATOR SUBROUTINES.
PAR Z IS ROUTINE NAME.
 X IS FLAGS (OPTIONAL)
 Y IS TYPE (INTEGER,,,) TO BE PASSED IN REGISTER B.
RES Calls routine after setting up AC's.
⊗;
DEFINE	GENMOV (Z,X,Y) <
	IFDIF <X><>,<HRRI FF,X>
	IFDIF <Y><>,<HRRI B,Y>
	PUSHJ	P,Z>



DSCR XCALL (X)
CAL MACRO
DES Facilitates calling runtine functions.
PAR X is the "NAME" of such a function, all of which
 are named in the beginning of the file "GEN"
RES a call (PUSHJ) to the routine is generated and fixed up
SID AC A is clobbered.
SEE XCALLQ
⊗;
DEFINE	XCALL	' (X)	<
	MOVEI	A,LIBTAB+R'X	;FIXUP LOCATION.
	PUSHJ	P,XCALLQ
	>

DSCR LPCALL (X,Y,Z)
CAL MACRO
DES Facilitates EMITting calls to LEAP interpreter
 functions. 
PAR X is function "NAME" (list is located at beginning of file "LEAP")
 Y (optional) displacement from X.
 Z tells what kind of call it is.  If non-null, we use the
  index computed by STCHK (Q.V.) to add to X, otherwise
  just the type bits computed by STCHK.
SEE LEAPC1, LEAPC2, STCHK
⊗;
DEFINE LPCALL ' (X,Y,Z) <
	MOVEI	A,L'X		;ROUTINE NAME.
	IFDIF <Y><>,<ADD A,Y>
	IFIDN <Z><>,<PUSHJ P,LEAPC1;> PUSHJ P,LEAPC2
	>

DSCR XPREP
CAL MACRO
DES Make sure AC 1 is free (I.E. erase the ACKTAB entry for it --
 so that a call on a runtime routine which returns a result
 in AC 1 can now be EMITted.
SEE STORZ
⊗;
DEFINE XPREP	<
	PUSHJ	P,[
		HRRI	D,1
		JRST	STORZ]
	>


DSCR EMIT (INSTR)
CAL MACRO
DES Facilitates calling the EMITTER for us.
PAR INSTR is the instruction and "DIRECTIVE" bits to the
 EMITTER.
⊗;
DEFINE	EMIT	(INSTR) <
	MOVE	A,[INSTR]
	PUSHJ	P,EMITER	;CALL EMITER
>



; Q-STACK HANDLERS

DSCR QPUSH (X,Y)
CAL MACRO
DES calls the generalized stack routine BPUSH.
PAR X (optional) is name of stack to be used.
 Y (optional) is data word to be pushed (AC A).
SID A, LPSA, TEMP changed
SEE BPUSH
⊗
DEFINE	QPUSH (X,Y)	<
	IFDIF <X><>,<MOVEI LPSA,X>
	IFDIF <Y><>,<MOVE A,Y>
	PUSHJ	P,BPUSH		>

DSCR QPOP
CAL MACRO
DES Facilitates calls on generalized stack routine BPOP
PAR X is name of the stack to be used (optional).. otherwise
 pointer in LPSA.
 Y (optional) is where the popped entry is to be returned.
RES Popped entry is returned in AC A and Y (optional).
SEE BPOP
⊗;
DEFINE	QPOP (X,Y)	<
	IFDIF <X><>,<MOVEI LPSA,X>
	PUSHJ 	P,BPOP
	IFDIF <Y><>,<MOVEM A,Y>	>

DSCR QLOOK
CAL MACRO
DES Allows one to get hold of the top element in the Qstack X
PAR X is the name of the stack to be used
RES the pointer to the top element in the stack is returned in AC A.
⊗
DEFINE  QLOOK (X)	<	
	HLRZ	A,X		>

DSCR QTAKE (X)
CAL MACRO
DES facilitates "taking" things out of one of the generalized
 QSTACKS (uses routine QTAK).
PAR X is name of Qstack to be used.
 AC B must have a QPUSH/QPOP-like pointer to the element requested.
RES Popped result returned in register A.
 **** SKIPS IF SUCCESSFUL ****
SEE QTAK
⊗;
DEFINE	QTAKE	(X)	<
	IFDIF <X><>,<MOVEI LPSA,X>
	PUSHJ	P,QTAK		>

DSCR QBACK 
CAL MACRO
PAR In AC B must be a QSTACK descriptor
RES B's descriptor is "popped" by one, word put in AC A.
 No storage is released
 **** SKIPS IF SUCCESSFUL ****
DES See BBACK routine in TOTAL for details of operation, AC usage, etc.
SEE BBACK
⊗

DEFINE QBACK <
	PUSHJ	P,BBACK
>


DSCR QFLUSH (X) 
CAL MACRO
PAR Qstack descriptor address
RES All storage is released for the stack, and the descriptor
 address is zeroed.
DES Used when QBACK and QTAKE operations have left blocks around.
 There should always be one actual PDP-type cell which points
 to the top (is only used in QPUSH and QPOPs).  This should be
 pointed at to flush the stack.
SEE BFLUSH
⊗

DEFINE QFLUSH (X) <
IFDIF <><X> <
	MOVEI	LPSA,X
>
	PUSHJ	P,BFLUSH
>

DSCR QBEGIN (X)
CAL MACRO
PAR X PTR TO A QPDP, LOADED TO LPSA IF PRESENT
RES B contains QPDP for QTAKEing first word, 0 if no stack
SEE BBEG
⊗
DEFINE QBEGIN (X)<
IFDIF <><X> <
	MOVEI	LPSA,X
>
	PUSHJ	P,BBEG
>

;;; THE VERY FIRST LOCATION


?LPSERR: ERR	<DRYROT -- SYMBOL TABLE>

SUBTTL	Sail ACs, File Indices

BEGIN SAIL

AC2DATA (GLOBALLY USED ACS)

?FF	←←0	;FLAG WORD, POSSIBLY
?A	← 1	;TEMPORARY AC'S -- MAY
?B	← 2	; RETAIN VALUES OVER SUBROUTINE
?C	← 3	; CALLS AS LONG AS EVERYONE UNDERSTANDS
?D	← 4	; WHAT IS HAPPENING.
?PNT	← 5	;PTR TO SYMBOL ENTRY FOR GENERATORS, ENTER, ETC.
?TBITS	← 6	;"TYPE" BITS FOR SYMBOL ENTRY
?SBITS	← 7	;"SEMANTIC" (MORE RANDOM GOOD) BITS FOR SAME
?PNT2	←10	;SAME FOR 2D ARGUMENT IN
?TBITS2	←11	; BINARY CASES -- MAY BE OTHERWISE USED
?SBITS2	←12	; IF ONE IS CAREFUL

;?SP		;STRING PUSH-DOWN STACK -- COMPILER PUSH-DOWN STACKS
;?TEMP		;USE FOR EXTREMELY TEMPORARY PURPOSES
;?USER		;LPS PARAMETER-PASSING ACS -- USE ALSO
;?LPSA		; FOR HOLDING POINTERS, BUT BE CAREFUL
;?P		;"SYSTEM" PUSH-DOWN POINTER


; SAIL  I/O  CHANNELS

?SRC	←←1	;SOURCE FILE CHANNEL
?BIN	←←2	;BINARY
?LST	←←3	;LISTING
?CMND	←←4	;COMMAND
?LOG	←←5	;LOGGING FILE CHANNEL
;; %BC%	ADD BAIL SYMBOL OUTPUTS
BAIL <
?SM1	←←6	;NAME FILE FOR SYMBOLS
>;BAIL
;; %BC%

XCOM<
?TMQ	←←17	;TEMP CHAN FOR COPYING
>;XCOM
ENDDATA


SUBTTL Sail Bits

; BIT MASKS FOR GENERATORS

BIT2DATA (TBITS, SBITS WORDS)

;  LEFT HALF BITS -- TBITS WORD
; THESE ARE THE BITS STORED IN SYMBOL TABLE ENTRIES ABOUT
; EACH USER'S IDENTIFIER, OR EACH CONSTANT (SCANNED OR CREATED).

DEFINE BIT (NAME,BITT) <
	IFNDEF NAME, <IFDIF <NAME><SPARE>,<?NAME←←BITT>>
	IFN FTDEBUG, <
	IFIDN <NAME> <SPARE>  , < 0
	>
	IFDIF <NAME> <SPARE>  ,< RADIX50 0,NAME
	>>>
; THIS WILL DEFINE THE LOCATIONS USED IN DEBUGGING
IFN FTDEBUG, <
BITABLE:	XWD .+1,BTBITS
		XWD .+1,BSBITS
		XWD .+1,GENBTS
			ARRBTS
>


BTBITS:	
	DEFTBS			;MACRO CALL TO DEFINE THEM
	?FORMAL ←← VALUE!REFRNC ;FORMAL PARAMETER IS EITHER TYPE.

ALTYPS	←←FORTRAN+PROCED+ITMVAR+PNTVAR+BOOLEAN+ITEM
ALTYPS ←←ALTYPS+STRING+SET+LABEL+LSTBIT+DBLPRC+INTEGR+FLOTNG

?ALTYPS←←ALTYPS

?SNGTYP ←← ITEM+ITMVAR+PNTVAR+INTEGR+FLOTNG+SET+DBLPRC+BOOLEAN+LSTBIT

;LEFT HALF BITS -- SBITS WORD.


BSBITS:	BIT	(INUSE,400000)	;TEMP IN USE
	BIT	(ARTEMP,200000)	;ARITHMETIC TEMP
	BIT	(STTEMP,100000)	;STRING (STACKED) TEMP
	BIT	(INAC,40000)	;VARIABLE OR TEMP IN ACCUMULATOR
	BIT	(FREEBD,20000)	;ITEMVAR MAY BE FREE OR BOUND
	BIT	(NEGAT,10000)	;SAYS THIS THING IS IN AC NEGATIVELY.

	BIT	(INDXED,4000)	;REPRESENTS CALCULATED ARRAY POINTER.
	BIT	(CORTMP,2000)	;REAL-LIVE TEMPORARY CORE LOCATION.
	BIT	(PTRAC,1000)	;POINTER TO ARGUMENT IS IN AC.
	BIT	(RTNDON,400)	;SOMEBODY RETURNED FROM THIS (TYPED) PROCEDURE
	BIT	(LPFRCH,200)	;THIS THING IS IN THE CURRENT FOREACH LIST.
	BIT	(LPFREE,100)	;THIS THING IS STILL "FREE"
	BIT	(FIXARR,40)	;TEMP CELL REPRESENTS ARR[CONST]
	BIT	(KNOWALL,20)	;USED BY ARRAY CODE ONLY
	BIT	(DISTMP,10)	;ONLY MEANINGFUL FOR DIS SYSTEMS 

NOEXPO <
IFN FTDEBUG, <
	BLOCK	=18+=5		>
>;NOEXPO



BITDATA (FF WORD)

;  FF (FLAG WORD) FLAGS

   ; LEFT HALF

?RELOC ←←400000	;IF ON, CODE IS MADE RELOCATABLE
?RLCPOS←←     0	;POSITION OF RELOC BIT IN FF
?TOPLEV←←200000	;AT TOP (GLOBAL) LEVEL OF PROGRAM
?DEFLUK←←100000	;DO NOT STACK RESULTS OF ID SCAN (IN STRING CONSTANT)
?IREGCT←← 40000	;USED BY GBOUT (BINARY OUTPUT)
 ?FFTMP1←←IREGCT;SUPER-TEMP, NOT SAVED OVER ANYTHING
?PRMSCN←← 20000	;STRING CONSTANT SCANNER SCANNING MACRO PARAM
?ERSEEN←← 10000 ;A SYNTAX ERROR IS SEEN -- NO MORE ERROR MESSGS.
?NOCRFW←←  4000	;NO CREF NOW -- EXTERNAL PROCD. BEING DEFINED.
?BAKSCN←←  2000 ;THE SCANNER IS BACK ONE SYMBOL FOR ERROR
		;RECOVERY.  PARSE/SEMANTIC TOKENS ARE IN SAVPAR,SAVSEM
?PRODEF←←  1000	;USED BY DECLARATION CODE TO SENSE AN IDLIST
?CREFSW←←   400 ;WE ARE CREFFING THIS LOSING FILE.
?NOMACR ←←  200	;DO NOT EXPANT MACROS.
?LPPROG←←   100	;LEAP FOREACH LIST IN PROGRESS
?PRMXXX←←    40	;SPECIAL FLAG FOR SCANNER (MACRO PARAMS)
?ALLOCT←←    20	;REALLY ALLOCATE WHEN CALLING TOTAL&ALOT
?FFTEMP←←    10	;A REAL-LIVE TEMPORARY BIT!!
?MAINPG←←     4	;THIS IS A MAIN (NOT PROCEDURE) PROGRAM
?BINARY←←     2	;BINARY FILE OPEN
?LISTNG←←     1	;LISTING FILE OPEN

↑ERSEEN←ERSEEN	;FOR UUO HANDLER.

   ; RIGHT HALF -- USED BY TOTAL (SEE MACRO GENMOV) FOR DIRECTIVE BITS.



BIT2DATA (SYMBOLIC SEMBLK INDICES)

?%TBUCK	←←0	;BUCKET TIE IN FIRST WORD
?%TLINK	←←0	;LINK TIE IN LEFT HALF OF FIRST WORD
?%STEMP ←←0	;SAVE TTEMP IN PROCEDURE BLOCK (2D)
?$PNAME	←←1	;PRINT NAME POINTER
?$DATA  ←←1
?%SAVET ←←1	;SAVE TTOP,,TPROC IN 2D PROCEDURE BLOCK
?$DATA2 ←←2
?$NPRMS ←←2	;SAVE #STRING PARAMS,#OTHER PARAMS IN 2D PROC BLK
?$TBITS	←←3	;TYPE BITS WORD
?$DATA3	←←3
?$BLKLP ←←3	;IN 2D PROC BLOCK, SAVE BLKLIM (LOWEST INDEX TO BLKLIS)
↑$PNAME	←←$PNAME	;STRING GARBAGE COLLECTOR HAS TO KNOW
?$SBITS	←←4	;SEMANTIC BITS WORD
?$DATA4 ←←4
?$ADR	←←5	;FIXUP ADDRESSES
?$ACNO	←←6	;NUMBER OF DIMENSIONS, AC NUMBER
?$VAL	←←7	;FIRST VALUE WORD
?$VAL2  ←←10	;SECOND VALUE WORD
?%RVARB	←←11	;VARB RING WORD
?%RSTR	←←12	;STRING RING WORD



?BUKLEN←←=13	;GOOD KIND OF NUMBER FOR BUCKET LENGTH
?BLKLEN←←=11	;LENGTH OF SYMBOL TABLE BLOCKS
?STCNBK←← 1	;IDENTIFIERS FOR VARIOUS BUCKETS
?CONBK ←← 2
?SYMBK ←← 3

NOTENX <
;INTERRUPT BITS
?INTPOV←←200000	;RH BIT -- PDL OV -  OBSOLETE BIT NOW
?IPOVIX←←=19	;POV INDEX
NOEXPO <
?INTTTI←←4	;LH BIT -- USER TYPED <ESC> I -- OBSOLETE BIT NOW
?ITTYIX←←=15	;INDEX OF <ESC>I INTERRUPT
>;NOEXPO
>;NOTENX

TENX <
;INTERRUPT BITS
?IPOVIX←←=9	;CHANNEL FOR PDL OV INTERRUPT
?ITTYIX←←5	;CHANNEL FOR TENEX CONTROL-H INTERRUPT
>;TENX



;VARIOUS RUN-TIME DECLARATIONS.  THESE PERTAIN TO THE
;CODE GENERATED.
; DON' TRY TO REDEFINE THESE --- IT TURNS OUT THAT A LOT DEPENDS ON
; THEM. (I.E. THE ABILITY TO CALL RUNTIME ROUTINES SUCH AS "CAT" AT
; COMPILE TIME).

ACDATA (RUN-TIME)

?RP	←←P	;RUN-TIME PUSH DOWN STACK.
?RSP	←←SP	;RUN-TIME SPECIAL STACK
?RTEMP ←←TEMP	;RUN-TIME SUPER-TEMP


ENDDATA

SUBTTL	Externals, Data Allocation

;THESE ARE DECLARED EXTERNAL, AND WILL BE FOUND EITHER
;IN SECOND SEGMENT OR IN THE NON-REENTRANT PART LOADED WITH
;COMPILER.

EXTERNAL	CONFIG,GOGTAB,RPGSW,CAT,PUTCH,POW,FPOW,%RENSW
EXTERNAL	ALLPDP,%UUOLNK,%ALLOC,.SEG2.,CORGET,CORREL,CANINC,CAT,CVS
EXTERNAL	SAVE,RESTR,STRGC,CORINC,JOBAPR,JOBCNI,JOBTPC
EXTERNAL	%ARRSRT,SGREM ;FOR REMOVING %ARRSRT FROM LIST
EXTERNAL	.ERRP.,%ERGO,%RECOV; FOR ERR UUO

COMMENT ⊗
All SAIL data is allocated in one or the other of these two
 blocks of storage.  The ZERODATA and DATA commands serve to
 place them here via the FAIL USE pseudo-ops. Tables of constants
 are excepted.
⊗


  ?ZSIZE←←=775			?DSIZE←←=1200
;last changed from zsize←←=750 on 4-3-75 jfr
;last changed from dsize←←=1150 on 10-16-76 jfr
IFN FTDEBUG, <
  ?ZSIZE←←ZSIZE+=32		?DSIZE←←DSIZE+=30
>
TENX <
	?ZSIZE←←ZSIZE+=300	;MOSTLY FOR NAMES, A BLOCK OF 300
>;TENX

RENC <
;EXTRA SPACE IN IMPURE CODE, MOSTLY FOR RESERVED WORD TABLE
	?ZSIZE←←ZSIZE+=100
	?DSIZE←←DSIZE+=6100

	TWOSEG 400000
>;RENC

?ZBASE:	BLOCK	ZSIZE		;ZEROED DATA (AT BEGINNING OF RUN)
	SET	ZVBLS,ZBASE	;2D PC

?DBASE:	BLOCK	DSIZE		;NON-ZEROED DATA
	SET	VBLS,DBASE	;3D PC

RENC <
	SET LSEG,DBASE+DSIZE
	RELOC 400000		;UP TO PROGRAM SEGMENT
>;RENC


ZERODATA (MAIN-SEMANTICS POINTERS)

COMMENT ⊗
I. SYMBOL TABLE BLOCKS
The central data structure of SAIL is the symbol table, and related
objects.  Each object in the symbol table is expressed as one or two
=11 word blocks, which will be called "Semblks," for "Semantics blocks,"
although they are not always used for semantics.  These Semblks take the
following form --

⊗
DSCR SEMBLK structure -- typical
I.A	Most Common Semblk Structure
0	%TLINK/%TBUCK		lh "other pointer" [1]
				 rh "bucket pointer" [2]
1	$PNAME			if this is a named entity, first word
   or	$DATA			 of string descriptor for it
2	<unnamed>		second word of string descriptor
   or	$DATA2
3	$TBITS			permanent data type bits for entity
   or	$DATA3			 (INTEGER, EXTERNAL, VALUE, SAFE, etc.)
4	$SBITS			temporary data type bits (ARTEMP, INUSE,
   or	$DATA4			 SBSCRP, etc.)--low order 6 bits for lex. level
5	$ADR			lh -- for strings, fixup chain addr for 2d
				 descriptor word
				rh -- fixup chain addr or displacement
				 (param) for this variable
6	$ACNO			rh -- accumulator number in which this
				 variable will be stored (at this PCNT)
7	$VAL			for ARITH constants, the value
10	$VAL2			would be used for 2d words of DBLPRC and
				 CMPLEX constants
11	%RVARB			VARB-ring pointers [3]
12	%RSTR			STRING-ring pointers [4]
⊗
ZERODATA (MAIN-SEMANTICS POINTERS)
COMMENT ⊗

These indices and descriptions apply only to the most common uses of
these Semblks -- in particular, simple variables and constants.  Many
others use many of the words in the same way (Procedure descriptors,
Array descriptors, etc.), but use others differently.  Each such Semblk
will be called, simply, the "Semantics" of the thing it describes. Some
Semblks use the $DATA indices instead. Others use still other symbolic
or absolute indices.  These divergent uses are described in the code
near the routines that handle them. See the list below, and the index
descriptions above for more information.

I.B	Further explanations
Some of the entries (indicated by bracketed numbers, above, need more
explanation --

[1]%TLINK This pointer is empty (0) for simple variables.  For Procedures,
	it points to a second Semblk containing more information (which
	second Semblk points to a parameter list).  For Arrays, it points
	to a Semblk describing the dimensions (see ARRAY).  For Macros, it
	points to the string const. Semantics representing the macro body. Etc.
[2]%TBUCK This pointer refers to the next symbol in the same hash bucket
	(see SYMTAB, below)
[3]%RVARB This is used to tie a symbol to those declared with it.
	It contains in its lh a pointer to the previous one, 0 if it
	is the oldest; in rh it contains a pointer to the next (in order
	of entry). This two-way pointer structure we (erroneously) call
	a "Ring".  One adds a Semblk to a Ring using one of several RNGxxx
	routines at the end of SYM, whose parameters are the new Semblk.
	One removes a Semblk via some URGxxx routines in the same area.
	Most RINGing is done in ENTERS; most ULINKing in DONES
	and ALOT.  For local declarations, the Varb Ring links 
	Semantics of all identifiers declared in the same Block head. For
	formal declarations, it ties together all the parameters of a
	Procedure. VARB is usually the RING variable for %RVARB Rings.
	Often, another pointer is kept for the old (left) end. Each 
	instance is described when its Semblk-type is completely described.
[4]%RSTR A Ring identical in form to the %RVARB Ring. Links all Semblks
	with non-constant string descriptors in them for STRNGC. STRRNG is
	the RING variable for %RSTR. Thus STRNGC traverses it rt. to left.

I.C Other Common Semblk Usages
These Semblks are used in a few applications as other than
Semantics. Here are the most common ones --

I.C.1 Buckets.
The symbol table is accessed associatively via these bucket Semblks. Each
contains pointers to 20 buckets (pointer chains, linked through %TBUCK).
There are hashing functions in ENTERS to select, for any variable name,
(or arithmetic value), the proper bucket chain during LOOKUP operations.
There are three completely independent bucket Semblks; SYMTAB points to
the one for identifiers, STRCON to the one for string constants,
and CONST to that for arithmetic variables.

The rh of the last word of the Semblk (SYMTAB only) points to a previous
bucket Semblk (see SYMTAB).

I.C.2 Qstacks
There are stack-like applications in the compiler, where the maximum
size of the stack may vary greatly from compilation to ditto.
Therefore a kind of stack called a Qstack was implemented.  Each
Qstack is a list of these Semblks, with the forward/backward links
in the first word of each, data in the rest.  The macros QPUSH,
QPOP, QTAK, QBACK, QBEGIN and QFLUSH are used to operate on the
stacks.  Each takes as at least one argument a pointer to a "Qstack-
Descriptor", whose lh is a pointer to the current top of stack, and whose
rh is a pointer to the Semblk containing the top.  See QPUSH, etc. for
calling sequences, the BPUSH, etc. routines for more detailed descriptions.
Many of the stack descriptors are declared just below; the rest are found
near the code which uses them.

I.D	Semblk Allocation
The GETBLK macro calls a routine to get the address of a free Semblk
into LPSA.  The FREBLK macro is used to return a Semblk to free storage.


II.  SEMANTICS VARIABLES

These variables (or tables) contain pointers to Semblks. They form
 the base for the SAIL data structures.
⊗

COMMENT ⊗
ACKTAB -- Each entry is either 0 (nothing in this AC) or --
rh -- ptr to Semantics of something which can reside in an AC
	(arith, pointer to Array elt., pointer to string dscr, etc.)
	This means that the code currently being generated has
	loaded the AC with the indicated entity, and can refer
	to it there. If the Semantics is a variable (named), a copy
	will also exist in core.  Otherwise it is a temp value found
	only in the AC.
	The $SBITS entry of the Semantics will have the INAC bit on,
	or there is a mistake. Also, the $ACNO entry will contain the
	number of this AC.  This table provides a useful redundancy.
lh --  If 0, this AC can be released for another use (by clearing the
	table entry, modifying the $SBITS word of its Semantics, and
	issuing instructions to store the value in core, if necessary.
       If -1, this AC is being protected.  Its Semantics cannot be 
	changed until it is explicitly unprotected.
  The GETAC routine is called to obtain a free AC number. It uses
    this table. The table is also used when it is desired to free
    all AC's (before calling a Procedure, jumping to a label, etc.)
⊗
?ACKTAB: BLOCK	20	;THE ACCUMULATOR TABLE

;ADRTAB -- RING variable or a VARB-Ring of address constant
;   Semantics (see ADCINS, MAKADR, ADCGO)
?ADRTAB: 0

COMMENT ⊗
BLKIDX -- QSTACK DESCR -- each entry in this qstack (we'll call it
    BLKLIS) is a completed VARB-Ring for a Block -- stack entry is
    ptr to oldest entry, a "Block-Semblk".  These lists are transferred
    here when the ENDs for the Blocks are seen. ALOT, which allocates
    variables, uses these lists (at termination of a Procedure). See 
    DOSYM for the reason for doing it this way.
⊗
?BLKIDX: 0		;QSTACK for completed VARB RINGS

?CONINT: 0		;VARB-Ring linking all arithmetic constants

?CONST:	 0		;ptr to bucket Semblk for arithmetic constants

?CONSTR: 0		;VARB-Ring linking all string constants

?DEFRNG: 0		;VARB-ring (old end) of current macro actual params

; GENLEF, GENRIG -- although these tables usually contain Semantics,
;    they are described below with the PARSER structures.

; LPSBOT, LPSTOP -- they define the boundaries of the last-allocated
; symbol table (Semblk) area

?LPSBOT: 0		;Address of first word of first Semblk
?LPSTOP: 0		;Address of first word not in Semblk area

COMMENT ⊗
MBLK is the 2d Procedure Semblk (see PROCED) for a dummy outer Procedure
    (initially titled "M", later changed to the program name, if there is one)
    which is assembled into the compiler.  This Procedure descriptor, labeled
    IPROC (placed in PARSE by the RTRAN program) forms the base for SAIL'S
    lexic. structure.  One non-standard feature of this descriptor is the 
    VARB-Ring growing out of its lh %RVARB pointer.  This Ring links all
    the assembled-in runtime Procedure Semantics (INPUT, EQU, etc.). The MBLK
    thing is set up as the second Semblk for IPROC at SALNIT time--since most
    code treats this Semblk as a regular Procedure, and access words in this 
    second Semblk.
⊗
?MBLK:	BLOCK	BLKLEN

;NEWSYM--SCANNER returns Semantics of lookup here--see SCANNER globals below

;;#GP# DCS 2-6-72 (1-4) CHECK FORWARD FORMALS AGAINST REAL FORMALS
;OLDPRM--Saves the Formal list from a FORWARD Procedure declaration during
;   the scanning of the formals of the actual (or another FORWARD) proc dec.

?OLDPRM: 0		;OLD FORMAL LIST STORED HERE
;;#GP# (1)
;;#SD# IEFLAG -- set ≠0 if external procedure redeclared as internal
?IEFLAG: 0

?STRCON: 0		;VARB-RING FOR STRING CONSTANTS

?STRRNG: 0		;LINKS ALL SEMBLKS WITH NON-CONST STRINGS (FOR GC)

COMMENT ⊗
SYMTAB -- points to current identifier bucket Semblk.  A new copy is made at
    each new Block entry, and linked as described above (see Buckets). At Block
    exit the previous old one is restored.  Since new entries are added at the
    beginnings of bucket lists, this "pop" operation restores the old scope of
    variables at Block exit. The first SYMTAB Semblk is copied from one
    which is assembled in via the RTRAN program, and provides (hashed) 
    access to all reserved words and built-in Procedures.
⊗
?SYMTAB: 0

COMMENT ⊗
TPROC -- points to Semantics of Proc. being compiled (originally initialized
    to point at IPROC (see MBLK above).  When a new Procedure name is seen, the
    previous TPROC and TTOP pointers are saved in its Semantics.  Both
    are then set to point at the new Semantics. TPROC, TTOP, and their saved
    previous values, are used with VARB to keep track of the lexic. structure;
    on Block and Procedure exits, values are restored as the VARB-Rings being
    removed from the structure are transferred to the BLKLIS via BLKIDX(above).
⊗
?TPROC: 0

COMMENT ⊗
TTEMP -- a VARB-Ring of all the temp-Semantics currently allocated by this
    Procedure -- temps represent things in ACs, in the string stack, and in 
    specially-allocated temp core addresses (depending on their $SBITS).  Each
    Procedure has its own set of temps.  See GETTMP for more information
    about the format of temp-Semantics.  The TTEMP pointer is saved in the old
    TPROC Semantics when new Procedure declaration is recursively encountered.
    It is then reset.  Restoration occurs as Procedure declarations are
    completed.  It is for this and similar reasons that the top of the data
    structure is a faked Procedure (IPROC), e.g., so that the Procedure-exit
    code can be used to allocate the outer-Block variables.
⊗
?TTEMP: 0

COMMENT ⊗
TTOP -- points to Semantics of Block being compiled, thus to oldest end 
   of VARB-Ring for this Block, since the Block Semantics is the first on
   the VARB-ring for a given Block.  VARB (below) points to the other end
   of the same Ring.  TTOP is saved in new Block Semantics before being
   reset to point to them.  VARB is saved in there also, then reset to 0.
   TTOP is also saved in Procedure Semantics as described above. This allows
   restoration of the lexic. structure.
⊗
?TTOP: 0

COMMENT ⊗
VARB -- the RING variable for the current VARB-Ring of identifiers local
   to the Block being compiled (usually).  TTOP points to the new end
   of the same ring.  VARB is used to add new entries (see ENTERS routine)
   as declarations are encountered.  It is also used to link Procedure and
   Macro parameters (various uses never conflict due to judicious saving).
⊗
?VARB: 0

ZERODATA(DISPLAY REGISTER HANDLING VARIABLES)


?SIMPSW:	0	;SET TO ≠0 IF COMPILING A SIMPLE PROCEDURE

?CDLEV:	0

COMMENT ⊗

CDLEV -- the current display level.  Gets bumped by one for each time
a new procedure declaration is entered and gets dropped by one at the
end of each such declaration.
⊗

?DISTAB: BLOCK 20

COMMENT ⊗

DISTAB -- table of display registers. 
	lh(DISTAB(lev)) is ac number containing rS at time of proc call
	rh(DISTAB(lev)) is ac number which points at the base of the 
			appropriate mark stack control packet.

⊗

?DISLST:0

COMMENT ⊗

DISLST-- owns varb ring of display temps, which exist solely for the 
	benefit of ACKTAB

⊗

?RECSW:	0	;SET ≠0 WHEN WE ARE COMPILING A RECURSIVE PROCEDURE

?SSDIS:	0	;STRING STACK DISPLACEMENT -- USED BY ALLOCATION & FRIENDS

?ASDIS:	0	;SAME FOR ARITH STACK

?CSPOS:	0	;NICE  LOCAL FOR ALLOCATION

BITDATA(DISPLAY STUFF)

?LLFLDL	←←6	;SIZE OF LEX LEVEL FIELD IN SBITS
?DLFLDL	←←4	;DITTO DISPLAY LEVEL
?DLFLDM	← (1⊗DLFLDL-1)⊗LLFLDL	;MASK FOR FIELD
?LLFLDM ← 1⊗LLFLDL-1
?STACKV←DLFLDM	;FIELD ≠0 IFF VAR GOES TO STACKS (MAY BE A LIE FOR TEMPS)



ZERODATA (MAIN-SCANNER VARIABLES)

COMMENT ⊗
PNAME -- this is a string descriptor, set up by SCANNER whenever it scans
   an identifier or string constant.  It is used by ENTERS to provide the
   print name of the identifier (value of the constant).  It is linked to
   the string garbage collector via standard string link blocks (see STRNGC
   routine, SALNK below).
⊗
?PNAME:	0		;XWD STRING NUM,LENGTH
	0		;BYTE POINTER

COMMENT ⊗
BITS -- As declarators (INTEGER, STRING, EXTERNAL, etc.) are encountered,
   the $TBITS bits corresponding to them are ORed into BITS (see TYPSET rout
   and friends).  These bits are used by ENTERS to set up the $TBITS word
   of newly entered identifiers and constants.  BITS is set up explicitly
   by some EXECS when they wish to create constants (stack-adjustors,
   results of constant expressions, etc.)
⊗
?BITS:	0


?SCNVAL: 0		;VALUE OF LAST ARITHMETIC CONSTANT SCANNED

?DBLVAL: 0		;UNUSED-WLD BE VALUE OF 2D WD-COMPLX AND DBLPRC CONSTS

;DEFRNG -- see Semantics variables above

COMMENT ⊗
NEWSYM -- SCANNER always returns 0 (not found) or found Semantics
   whenever it scans an identifier.  ENTERS always stores the Semantics
   of each new symbol it enters.
⊗
?NEWSYM: 0


DATA (MAIN-SCANNER VARIABLES)

;DEFPDP, DFSTRT -- PDP and base address for special DEFINE push down list
;   see code in SYM (SCANNER) for its format
↑↑DFSTRT:0		;ADDRESS OF STACK BASE
↑↑DEFPDP: 0		;DEFINE STACK PDP

;SCNWRD -- bits describing state of SCANNER (expand macros, listing,
;   print PC, print line #, etc.)--usually transferred to TBITS2 AC
;   when in use.  Other SCANNER control bits found in FF AC.
?SCNWRD: 0
;;%DF% !
?FMTWRD: 0		;SWITCH SCANNER PLACES FORMAT (/F) BITS HERE
			;CURRENTLY, ONLY USED FOR CHECK ON 100 BIT
?SPRBTS: 0		;ACCUMULATE BITS FOR CHECK!TYPE FEATURE

COMMENT ⊗ Other variables which would seem to be in the domain of the SCANNER
will be found in one of the SOURCE FILE VARIABLES areas; sometimes because
they seemed more important to the I/O side than to the scanning itself;
sometimes because they must be saved as a group with other variables when
source files are switched via the REQUIRE ... SOURCE!FILE construct.
⊗

ZERODATA (MAIN-PARSER VARIABLES)

COMMENT ⊗
GENLEF, GENRIG -- assumed is an understanding of the theory and operation
   of the parser. Semantics pointers are put on the semantics stack (synched
   with the parse stack). If a production matches the top of the parse stack,
   the top Semantics ptr is popped into GENLEF, the next into GENLEF+1, etc.
   up to the number of elements on the left side of the production.  Then the
   EXEC routines are called.  These EXEC routines place appropriate Semantics
   in GENRIG, GENRIG+1, etc. corresponding to the new top, next. etc. stack
   elements.  Unchanged Semantics are filled in by the parser.  Thus all
   communication between PARSER and EXECS is accomplished via these variables.
   See PARLEF, PARRIG, GPSAV, PPSAV for related variables.
⊗
TEMLEN←←10		;LENGTH OF THESE TABLES

?GENLEF: BLOCK	TEMLEN	;INPUTS TO EXECS

?GENRIG: BLOCK	TEMLEN	;OUTPUTS FROM EXECS

COMMENT ⊗
PARLEF, PARRIG -- same function as GENLEF, etc. for parse stack (integer
   tokens for terminal and non-terminal symbol.  EXECS on rare occasions
   modify the PARRIG elements, but they are mainly used for making stack
   adjustments easy for the PARSER.
⊗
?PARLEF: BLOCK	TEMLEN	;LEFT SIDE PARSE STACK TEMPS

?PARRIG: BLOCK	TEMLEN	;RIGHT SIDE DITTO

DATA (MAIN-PARSER VARIABLES)

↑↑GPSAV: 0		; SEMANTICS (GENERATOR) PDP STORED HERE WHEN UNUSED
↑↑PPSAV: 0		; PARSE STACK PDP STORED HERE WHEN UNUSED
?PCSAV:  0		; CURRENT PRODUCTION CONTROL STACK POINTER
?SCWSV:	 0		; CURRENT SCANWORD STACK POINTER
?SCNNO:  1		; CURRENT REMAINING NUMBER OF CALLS TO SCANNER
?SGPSAV: 0		; SAIL SEMANTIC STACK POINTER
?SPPSAV: 0		; SAIL PARSE STACK POINTER
?SPCSAV: 0		; SAIL PRODUCTION CONTROL STACK POINTER
?SSCWSV: 0		; SAIL SCANWORD STACK POINTER
?CGPSAV: 0		; CONDITIONAL ASSEMBLY SEMANTIC STACK POINTER
?CPPSAV: 0		; CONDITIONAL ASSEMBLY PARSE STACK POINTER
?CPCSAV: 0		; COND. ASS. PRODUCTION CONTROL STACK POINTER
?CSCWSV: 0		; COND. ASS. SCANWORD STACK POINTER
;#SN# (1 OF 8) RLS 1-1-75 MAKE EXPR!TYPE RECURSIVE
?EXPSPT: 0		; EXPR!TYPE STACK POINTER
?PRSCON: 0		; PARSER INITIALLY IN CONTROL - I.E.
			;  PRSCON=0   INDICATES SAIL IN CONTROL
			;  PRSCON=-1  INDICATES COND. ASS. IN CONTROL

TABCONDATA (SPACE-ALLOCATION DEFAULT SPECIFICATIONS)
; See GOGOL (%ALLOC) for the meaning of all the numbers
; The standard defaults can be changed by compiler switches (/P, etc.)

CONSIZ←←=30
IMSSS<PSSKSZ←←=128>
NOIMSSS<PSSKSZ←←=64>
IMSSS<DFSKSZ←←=160>
NOIMSSS<DFSKSZ←←=40>
;#SN# (2 OF 8) MAKE EXPR!TYPE RECURSIVE
IMSSS<EXSKSZ←←=1000>
NOIMSSS<EXSKSZ←←=100>

DEFSIZ:	XWD	STDSPC!SYSPD,=64	;P-STACK
	XWD	STDSPC!SYSSPD,=16	;SP-STACK
	XWD	STDSPC!STRSP,=3500	;STRING SPACE
	XWD	WNTPDL,PSSKSZ		;PARSE STACK
	XWD	[ASCIZ/SYNTAX STACK/],PPSAV 
	XWD	WNTPDL,PSSKSZ		;SEMANTICS STACK
	XWD	[ASCIZ/SEMANTICS STACK/],GPSAV
	XWD	WNTPDL,PSSKSZ		;PRODUCTION CONTROL STACK
	XWD	0,PCSAV
	XWD	WNTPDL,CONSIZ		;CONDITIONAL PROD. CONTROL STACK
	XWD	0,CPCSAV
	XWD	WNTPDL,CONSIZ		;CONDITIONAL SEMANTICS STACK
	XWD	0,CGPSAV
	XWD	WNTPDL,CONSIZ		;CONDITIONAL PARSER STACK
	XWD	0,CPPSAV
	XWD	WNTPDL,CONSIZ		;SAIL SCANWORD STACK
	XWD	0,SCWSV
	XWD	WNTPDL,CONSIZ		;CONDITIONAL PARSER SCANWORD STACK
	XWD	0,CSCWSV
	XWD	WNTADR!WNTPDL,DFSKSZ	;DEFINE STACK
	XWD	[ASCIZ/DEFINE STACK/],DFSTRT
;#SN# (3 OF 8)  RLS 1-1-75  MAKE EXPR!TYPE RECURSIVE
	XWD	WNTPDL,EXSKSZ
	XWD	0,EXPSPT		
;#SN#
	XWD	WNTADR!WNTEND,=2200	;SYMBOL TABLE SPACE
	XWD	0,LPSBOT
	0				;END IT ALL

ZERODATA (SPACE-ALLOCATION REQUEST BLOCK)
; See GOGOL (%ALLOC) for format and use of these things

SPREQ:	BLOCK	$SPREQ	;STANDARD SIZED BLOCK FOR LEAP GARBAGE
PDLMAX:	0		;SIZE OF SYSTEM!PDL
SPMAX:	0		;SIZE OF STRING!PDL
STMAXX:	0		;SIZE OF STRING!SPACE
PPMAX:	BLOCK	2	;SIZE AND POINTER ADDRESS OF PARSE STACK
GPMAX:	BLOCK	2	;" OF GENERATOR STACK (SHOULD = PPMAX)
PCMAX:	BLOCK	2	;SEE ABOVE
CPCMAX:	BLOCK	2
CGPMAX:	BLOCK	2
CPPMAX:	BLOCK	2
SCWMAX: BLOCK	2
CSCMAX: BLOCK	2
DFMAX:	BLOCK	2	;SIZE AND POINTER ADDRESS FOR DEFINE STACK
;#SN# (4 OF 8) MAKE EXPR!TYPE RECURSIVE
EXMAX:  BLOCK   2	;SIZE AND POINTER ADDRESS FOR EXPR!TYPE STACK
LPSMAX:	BLOCK	2	;SIZE AND POINTER ADDRESS FOR SYMBOL TABLE SPACE
	0		;NO MORE
SPREND←←.-1
	LINK	2,SPREQ	;PROVIDE THE LINK


ZERODATA (CONDITIONAL-PARSER VARIABLES)

?SWCPRS: 0		; SWITCH PARSER FLAG
?DLMSTG: 0		; POSSIBLY LOOKING FOR SPECIALLY DELIMITED STRINGS
			;   FLAG.  THESE STRINGS INCLUDE MACRO BODIES AND
			;   BODIES OF CONDITIONAL COMPILATION WHILEC, CASEC,
			;   FORC, OR FORLC STATEMENTS.
?NODFSW: 0		; FLAG TO DEFER PROCESSING OF DEFINES AFTER A BEGIN UNTIL 
			;  A BLOCK HAS BEEN EXECUTED.
?REDEFN: 0		; REDEFINE IN PROGRESS FLAG 
?EVLDEF: 0		; EVALDEFINE IN PROGRESS FLAG 
?ASGFLG: 0		; ASSIGNC IN PROGRESS FLAG 


DATA (CONDITIONAL-PARSER VARIABLES)

COMMENT ⊗
	RESLOC is a table containing for each parser interrupt trigger e 
	reserved word the following information.  The left half contains
	a set of flags which must be turned on in the left half of the 
	$TBITS entry of the reserved word and the length of the reserved 
	word.  The right half contains the address of a byte pointer to 
	the string.
⊗

?CONRES←←200000		; COND. ASS. RESERVED WORD FLAG IN LEFT HALF OF $TBITS
?DEFINT←←100000		; INDICATES PARSER INTERRUPT AND A PUSHJ TO A 
			;  PRODUCTION WITHOUT SWITCHING PARSERS
?CONDIN←←40000		; INDICATES A PARSER INTERRUPT AND A PUSHJ TO A 
			;  PRODUCTION IN THE CONDITIONAL PARSER
?CONBTS←←CONRES+DEFINT+CONDIN	; BITS THAT ARE ON IN $TBITS OF A PARSER 
			;   INTERRUPT TRIGGER RESERVED WORD
?NMCRES←←=14		; NUMBER OF PARSER INTERRUPT TRIGGER RESERVED WORDS
?IF0OFF←1000		; DESIGNATES THE RIGHTMOST BIT OF THE LEFT HALF OF 
			;  $TBITS OF A PARSER INTERRUPT TRIGGER RESERVED 
			;  WORD WHICH CONTAINS AN INDEX INTO A TABLE
			;  STARTING AT PRODGO IN PARSE OF THE PRODUCTIONS TO
			;  WHICH ONE IS PUSHJ'ING.
?IF0SHF←←=9		; NUMBER OF BITS ONE MUST SHIFT LEFT IN ORDER TO 
			;  UNPACK PARSER INTERRUPT INDEX FROM $TBITS OF
			;  THE RESERVED WORD

?RESLOC: XWD CONRES+CONDIN+3,[ASCII/IFC/]
        XWD CONRES+5,[ASCII/ELSEC/]
	XWD CONRES+4,[ASCII/ENDC/]
	XWD CONRES+CONDIN+6,[ASCII/WHILEC/]
	XWD CONRES+CONDIN+5,[ASCII/CASEC/]
	XWD CONRES+CONDIN+4,[ASCII/FORC/]
	XWD CONRES+CONDIN+5,[ASCII/FORLC/]
	XWD CONRES+DEFINT+6,[ASCII/DEFINE/]
	XWD CONRES+CONDIN+4,[ASCII/IFCR/] 
	XWD CONRES+DEFINT+10,[ASCII/REDEFINE/]
	XWD CONRES+DEFINT+12,[ASCII/EVALDEFINE/] 
	XWD CONRES+DEFINT+7,[ASCII/ASSIGNC/] 
	XWD CONRES+DEFINT+5,[ASCII/NOMAC/] 
	XWD CONRES+DEFINT+14,[ASCII/EVALREDEFINE/] 

COMMENT ⊗

	%CTRUE and %CFALS are the locations containing the tokens required
	by TWCOND which checks the value of the compilation condition
⊗


ZERODATA (MAIN-SOURCE AND LISTING FILE VARIABLES)

COMMENT ⊗
IPLINE -- BP to first word of file input line; used only by PARSE/DEBUG 
   guy when scanning a macro (PLINE normally points here too, when not
   expanding macro).  Used to print original input line when an error is
   detected (see also COMSER&DSPLIN).
⊗
↑↑IPLINE: 0

?PGSIZ←←=50		;# LINES/PAGE ON LISTING
CMU <
?PGSIZ ←← PGSIZ+5	;CMU HAS A BETTER??? LPT SERVER
>;CMU
	
;SRCDLY -- this is a flag used to signal the command scanner and end of
;   file code that a source-file switch is happening (via the
;   REQUIRE .... SOURCE!FILE stuff).
?SRCDLY: 0
↑↑CRIND:0		;SET IF CRLF/INDENT SEQUENCE NEEDED BEFORE NUMBER


DATA (MAIN-SOURCE AND LIST FILE VARIABLES)

;ASCLIN -- ascii value of line number for current input line, if file
;   has line numbers
↑↑ASCLIN: 0
	BYTE	(7) 11		;TAB FOR LIST OUTPUT AFTER LINE NO.

;LSTSTRT -- set by /nL in command line to provide an offset for 
↑↑LSTSTRT: 0		;display of PC in listing.

NOTENX <
COMMENT ⊗ The address of the Stanford UINBF UUO points to a two-word block--
 1 -- # buffers wanted
 2 -- size of each buffer.
 This functions identically to the INBUF UUO, except that the size of the
 buffer is specified exactly.  In the NOEXPO system, the size for the source
 file is always chosen 1 bigger than needed for the largest buffer provided by 
 any device.  The last word is always set 0 by SCANNER.  This serves as a flag
 to the SCANNER that a buffer is ended -- an efficiency measure.  Therefore,
 in the EXPO version, this is simulated.  UINBF takes in AC TEMP a pointer
 to a UINBF block, and allocates the buffers. (changes AC C)
⊗
EXPO <
UINBF: 	ADD	B,[XWD 400000,1]	;NOT USED BIT,PTR TO 2D WORD FIRST BUFFER
	PUSH	P,B			;SAVE PTR TO BUFFER
	MOVEM	B,SRCHDR		;PUT PTR IN BUFFER
	HRL	C,1(TEMP)		;SIZE DESIRED
	MOVE	TEMP,(TEMP)		;#BUFFERS
UINBL:	SETZM	-1(B)			;CLEAR BOOKKEEPING WORD
	HLRS	C			;SIZE,,SIZE
	ADDI	C,2(B)			;PTR TO 2D WORD NEXT BUFFER
	MOVEM	C,(B)			;2D WORD THIS BUFFER
	HRRZI	B,(C)			;PTR TO NEXT BUFFER
	SOJG	TEMP,UINBL		;DO ALL OF THEM
	POP	P,TEMP			;PTR TO 2D WORD OF FIRST
	HLRZS	C
	SUB	B,C
	HRRM	TEMP,-2(B)		;LAST PNTS TO FIRST
	HRRZI	B,-1(TEMP)		;PTR TO 1ST WORD OF BUFFERS
	POPJ	P,			;DONE
>;EXPO
>;NOTENX

DATA (SWITCHED VARIABLES)

COMMENT ⊗
This area contains all data necessary to describe the state of
 a given source file (channel, io buffers, etc.).  It is grouped
 together in order that it might be saved as a group, when the
 SCANNER switches temporarily to another source file, via the
 REQUIRE ... SOURCE!FILE construct.  The saved groups are stored
 in CORGET areas allocated for the purpose. 

The first data is the source file CDB (see MAKCDB for detailed
 description). It contains Device, File name, IO buffer headers,
 and instructions tailored for use when accessing this file (these
 instructions are XCTed during the OPEN sequence for the file.
As the MAKCDB macro will show you, labels are generated for access
 to the various parts of the CDB (channel data block).
⊗
TENX<
?BGNSWA:
>;TENX


NOTENX <
MAKCDB (SRC,SRC,0,=8,0)	

COMMENT ⊗
   Some more instructions to be XCTed.  These instructions are interpreted
    only for the source file, since this is the only case where the channel
    number might change.  The proper channel # is deposited in the AC field
    of the instructions during SAIL initialization, and when switching source
    files.
⊗
?INSRC:	INPUT	SRC,0		;XCT TO DO INPUT
?EOFSRC: STATZ	SRC,20000	;TEST EOF
?RELSRC: RELEASE	SRC,0	;TO RELEASE FILE
?TSTSRC: TSTERR	(SRC)		;TO TEST ERRORS


COMMENT ⊗
  The command scanner (which reads compilation specs) always stores the
   requested file names, extensions, etc., in sixbit, into the following 
   data block.  These are used by the command scanner to open input/output
   files.  They are also used by other routines (which call FILNAM in the
   command scanner to set them up) to convert strings specifying file names
   to this sixbit format (REQUIRE ... LOAD!MODULE, for example).
⊗

?DEVICE: 0		;DEVICE NAME IN SIXBIT
?NAME:	0		;FILE NAME
EXTEN:	0		;EXTENSION IN LH, RH UNUSED
WORD3:	0		;WORD 3 OF LOOKUP/ENTER BLOCKS, ALWAYS ZEROED
			;(AT THE SAME TIME HLLZS EXTEN)
?PPN:	0		;SPECIFIED PPN, OR 0 FOR USER DEFAULT
	0		;FOR SWAP UUO?
;;#%%# BY JFR 11-7-74 PPN NOW KEPT IN CDB
;↑SRCPPN: 0		;PPN IN SIXBIT, SAVED FROM SOURCE FILE SPEC
;;=I10=	ADD SFD'S
SFDS<
?PATHB:	BLOCK 4+SFDLVL	;PLACE FOR PATH, IF ANY
> ;SFDS
TYMSHR <
TYMUSR:	BLOCK 2
>;TYMSHR

; HERE ARE SOME CONTROL VARIABLES FOR THE COMMAND SCANNER

EOF:	0		;END OF FILE HAS BEEN SEEN ON COMMAND FILE
?EOL:	0		;END OF LINE HAS BEEN SEEN IN COMMAND FILE
NOFILE:	0		;NO FILE NAME WAS SEEN BY FILNAM ROUTINE
?SAVTYI: 0		;ONE-CHAR LOOKAHEAD SOMETIMES NEEDED IN COMND

; HERE ARE SOME CONTROL VARIABLES FOR THE SOURCE-SWITCHING FEATURE

COMMENT ⊗
AVLSRC -- bit 0 for channel 0, bit 1 for channel 1, etc.
   contains a 1-bit for every channel which is now available as a
   source file channel.  Since this is saved with the rest, a channel
   is automatically returned to the land of the free when this data
   is BLTed back during unswitching.
⊗
;; %BC% ADD BAIL SYMBOL OUTPUTING
NOBAIL <
?AVLSRC: XWD 007774,0	;CHANNELS 6 AND ABOVE AVAILABLE (INITIALLY)
>; NOBAIL
BAIL <
?AVLSRC: XWD 003774,0	;CHANNELS 7 AND ABOVE AVAILABLE ( INITIALLY)
>;BAIL
;; %BC%
>;NOTENX

TENX <
?SRCFLN:	BLOCK =30	;USED FOR THE FILE NAME, SET UP IN CC, USED IN CC, COMSER
?SRCJFN:	0
?SRCPNT:	0
?TTYSRC:	0		;TRUE IF THIS SOURCE IS THE CONTROLLING TERMINAL
?TNXBND:	0		;POINTER TO END OF BUFFER FOR ADVBUF
>;TENX

;BUFADR -- CORGET pointer to IO buffers for this source file
BUFADR: 0

;SWTLNK -- CORGET pointer to saved data for higher-level file (0 if outer)
↑SWTLNK: 0

COMMENT ⊗ These variables are cleared (independently of the main
   cleared area) at SAIL initialization and whenever file switching
   occurs. 
⊗
SLD1:			;BEGINNING OF SWITCHED-CLEARED AREA

COMMENT ⊗
PNEXTC -- this is the byte pointer used by the SCANNER for its input.
 It is saved, restored, and massaged all over the place.  It takes
 the form of the 2d word of a string descriptor, so that the garbage
 collector can alter it, if it represents a pointer into a macro body
 in string space.
⊗
	0		;USED BY STRINGC
?PNEXTC: 0		;BYTE POINTER FOR SCANNER INPUT

;PLINE -- BP (also string descriptor) to beginning of current input line
;   IPLINE always saves PLINE for input file -- PLINE may pnt into a macro.
	0		;ALSO FOR STRINGC
?PLINE: 0		;BYTE POINTER FOR BEGINNING OF "LINE"

;SAVCHR -- when an identifier is scanned, one extra character is sometimes
;   read before end of identifier is determined.  SCANNER always checks
;   this variable for the extra character before reading any more.
?SAVCHR: 0		;ONE-CHAR LOOKAHEAD FOR SCANNER


BAIL<
COMMENT ⊗
BPNXTC -- byte pointer and flag used by debugger.  Set to zero to request
 that the place in the input or listing file be remembered at the next
 token.  If non-zero, then a byte pointer to the place remembered.
 Currently zeroed whenever a BEGIN, semicolon, or ELSE is found.
 Necessary because we must remember the place at the beginning of a 
 statement but don't know whether or not we actually need a new
 coordinate until the end of the statement.
⊗
?BPNXTC: 0		;DEBUGGER BYTE POINTER
>;BAIL

; SOME FILE PARAMETERS FOR LISTING AND ERROR MESSAGE OUTPUT

?FPAGNO: 0		;PAGE NUMBER WITHIN THIS FILE
↑↑FPAGNO←FPAGNO	;..
?PAGENO: 0		;CURRENT LOGICAL PAGE NUMBER
?PAGINC: 0		;PHYSICAL PAGE NO. WITHIN THIS LOGICAL PAGE
?BINLIN: 0		;SEQUENTIAL LINE NUMBER WITHIN LOGICAL PAGE
↑↑BINLIN←BINLIN
;;#HU# ! 6-20-72 DCS BETTER TTY LISTING
↑LININD: 0		;#LEVELS TO INDENT TTY LISTING
ENDSRC←←.-1		;END OF CLEARED AREA -- END OF SWITCHED AREA
;;%CF% 2! JFR 7-8-75
	POINT	7,.+1	;SAIL STRING DESCRIPTOR TO STRING OF BLANKS
	ASCII	/                    /

TENX<
;BUFFER FOR LOADER-EDITOR COMMUNICATION
;This is tenex specific because RS wanted the flexibility 
ZERODATA (TMPCOR BUFFER)
?TMPCBF:  BLOCK 40
>;TENX

ZERODATA (GLOBAL STATE VARIABLES)

COMMENT ⊗
LEVEL -- starts at 0, has 1 added for each Block, named Compound Statement
   and Procedure declaration encountered.  Decremented when corresponding
   END or termination of Procedure body is processed.  This number is stored
   in $SBITS of each identifier declared at this level.  It is used in 
   resolving questions of scope (to determine if a declaration is a duplicate,
   if a label can be "gone to", etc.)
⊗
?LEVEL:	0

COMMENT ⊗
NMLVL -- incremented when Procedure declaration or NAMED Block or Compound
   Statement is seen -- decremented on termination.  NMLVL is the DDT level
   of a variable. It is stored only in the Block (Procedure) Semantics at
   this level.  It is placed in the level field of a Block-name loader output
   block for DDT -- also used to determine the order of output of symbols
   to DDT
⊗
?NMLVL: 0

COMMENT ⊗
PCNT -- initialized to zero, one is added for each word of code or data
   generated.  This is the (relative) program counter, and is used to format
   the REL file output.
If the program is being compiled into two segments, two PCNT variables
   are needed, one for the data (low, impure) and one for the code
   (high, pure).  HCNT holds the current value of the "other" counter
   when the "other's other" is in use.
HISW -- On if /H was typed to indicate a two-segment (re-entrent) 
   compilation.
INHIGH -- Irrelevant unless HISW on -- determines whether PCNT represents
   second segment addresses, and HCNT the low ones (ON), or vice versa.
⊗

?PCNT:	0
REN <
?HCNT:	0
?HISW:	0
?INHIGH:0
>;REN

ZERODATA (COUNTER SYSTEM VARIABLES)

COMMENT ⊗
KOUNT -- set to non-zero by the presence of a /K switch.
  Indicates that counters are to be inserted into all loops.
  For each counter inserted, a marker ('177&'02") is inserted
  into the listing file.  For counters in conditional and case
  expressions, a different marker ('177&'03) is inserted.
⊗
?KOUNT:	0

COMMENT ⊗
KCOUNT -- starts at zero, incremented with each counter inserted.
  Its final value is compiled into the object code and is used by 
  K.FIX and K.OUT to determine how many counters there are.
⊗
?KCOUNT:  0

COMMENT ⊗
KPDP -- a QSTACK is used to hold the address of each AOS instruction
  that increments a counter.  At the end of the compilation, after
  the block of counters is allocated, these locations are fixed up
  to point to the proper counter.
⊗
?KPDP:	0

DATA (RANDOM GLOBAL THINGS)

; String link blocks (for STRNGC) for PNAME, PNEXTC, PLINE

SALSTR:	1			;FOR STRING GC -- BLOCK ALWAYS ACTIVE
	XWD	2,PNEXTC-1	;PNEXTC AND PLINE
SALNK:	0			;LINK THROUGH HERE VIA
	LINK	1,SALNK		; LINK #1
	1
	XWD	1,PNAME		;FOR PNAME
SALK1:	0			;LINK THROUGH HERE ALSO
	LINK	1,SALK1

;PLEVEL -- byte pointer to access level field in $SBITS of semantics pointed
;   to by AC LPSA
?PLEVEL: POINT	LLFLDL,$SBITS(LPSA),35 ;LEXICOGRAPHIC LEVEL

?STPSAV: 0		;STRING PDP STORED HERE WHEN UNUSED

; Stack-adjusting values

?X11:	XWD	1,1
?X22:	XWD	2,2
?X33:	XWD	3,3
?X44:	XWD	4,4

↑X11←X11
↑X22←X22
↑X33←X33
↑X44←X44

;;%CF% JFR 7-8-75
IFN 0,<
↑↑INDTAB:0		;INDENTING SPACES
	ASCIZ	/   /	;LEVEL 1
	ASCIZ	/      /;LEVEL 2
	ASCIZ	/         /; L 3
	ASCIZ	/            /;4
	0		;SAFETY
>
;;%CF% ↑

BAIL<
BITDATA (DEBUGGER REQUEST BITS)
?BBCRD←←1	;COORDS--0 MEANS NO, 1 MEANS YES
?BBSYM←←2	;=0 JUST PROCS,PARAMS,INTERNALS; =1 ALL SYMBOLS
?BBPDSM←←4	;PD FOR SIMPLE PROC--0 MEANS NO, 1 MEANS YES
?BBUSR←←10	;=0 USE SYS:BAIL.REL, =1 LET USER PROVIDE HIS OWN
?BBPDS←←20	;=1 REQUEST SYS:BAIPDn.REL, =0 DON'T

ZERODATA (DEBUGGER FLAG)

↑↑BAILON:	0	; LEQ 0 BAIL OFF
>;BAIL

ZERODATA (OVERLAY AND OPTIMIZATION FLAGS)
?OVRSAI:	0	;/V SWITCH. NEQ 0 FOR GENERATING OVERLAY CODE.
			; MOSTLY JUST PUTTING ALL LOADER LINKED STUFF IN
			; LOW SEGMENT
?WHERSW:	0	;/W SWITCH. NEQ 0 FOR GENERATING OPTIONAL SYMBOLS
			; TO HELP EXTERNAL CODE OPTIMIZER.
?XTFLAG:	0	;/X SWITCH. COMPILER SAVE/RESTART FACILITY

;;%DN% JFR 7-1-76
?ASWITCH:	0	;/A SWITCH, OPTIONS FOR COMPILING CODE

BITDATA(CODE OPTIONS)
?AKIFIX←←1		;USE KIFIX
?AFIXR←←2		;USE FIXR
?AFLTR←←4		;USE FLTR
?AADJSP←←10		;USE ADJSP
?ASWF10←←20		;%DT% USE FORTRAN-10 CALL
;;%DN% ↑
; SLS VARIABLES

ENDDATA

DATA (INITIAL PROC DESC SEMBLKS)

?IPDSBK:XWD	IPDASB,0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
IPDASB:	XWD	IPDSBK,0
;;#HH#2! 5-14-72 DCS (1-2) ACCOUNT FOR POSSIBLE /H
IPDFIX:	XWD	0,5		;FIXUP FOR OUTER BLOCK STATIC LINK PUSH
				;THIS MUST BE 400005 IF /H (SEE GENINI)
	BLOCK	5
ENDDATA

SUBTTL	Executive and Initialization
DSCR LARGER, SAIL, START
CAL Monitor-initialized
DES Re-entry, Initial Start, and subsequent Start addresses
 The SAIL EXECUTIVE AND INITIALIZER -- it does these things:
1. Ask for allocation info (reenter only).
2. Scan command
3. Initialize runtime data areas
4. Initialize SAIL data areas, set up stacks, etc.
5. Prepare for compilation.
6. Compile a program
7. Go back for more or exit or start over.
⊗

DATA (INITIALIZATION FLAGS)

↑↑DSKSW: 0	;ON IF COMMAND INPUT IS NOT FROM TTY

ENDDATA
;EXTERNAL JOBREN, JOBVER
JOBREN←←124  JOBVER←←137
	LOC	JOBREN			;JOBREN ← LARGER
	LARGER
	RELOC
	LOC	JOBVER
	.VERSION			;CURRENT VERSION NUMBER
	RELOC				;COME BACK UP

COMMENT ⊗Start, Ddtkil -- Once-only code to zap RAID, symbols

;;#IH# 7-4-72 DCS (1-2) KEEP RAID IN CORE IMAGE, NOT IN COMPILER
START sets 136 to -1, starting address to DDTKIL, and exits. 
DDTKIL resets starting address to SAIL, keeps track of RPG mode.
 Then, if 136<0, it resets JOBFF and LH(JOBSA) to $BGDDT, if present.
 Following this, it sets total core size to 7k above (JOBFF). It
 then continues into the compiler, in or out of RPG mode, depending.
NOSHRK(USER) will be set as soon as possible.
⊗

III←←0
NOTENX<
;%##% MAKE THIS KLUGE STANDARD FOR DEC OR STANFORD
IFE FTDEBUG,<
III←←1
↑↑START:
STANFORD<
RENC<
	MOVE	A,JOBVER
	MOVEM	A,JOBHGH+JOBHVR	;COPY VERSION TO HIGH VERSION
	SETUWP	A,		;WRITE PROTECT UPPER SGMENT
	 HALT	.
	INIT	1,17		;MAKE COMPILER UPPER SEGMENT
	SIXBIT	/DSK/
	0
	 HALT	.
	ENTER	1,STRTDT
	 HALT	.
	MOVE	A,JOBHRL	;400000,,MAX ADDR IN UPPER
	SUBI	A,377777	;400000,,LENGTH OF UPPER
	HRLOI	A,-1(A)		;LENGTH-1,,-1
	EQVI	A,377777	;-LENGTH,,377777  [IOWD]
	SETZ	B,
	OUT	1,A
	JRST	.+2
	 HALT	.
	RELEASE	1,
DATA (COMPILER SEGMENT NAME)
STRTDT:	SIXBIT	/SAIL/
	SIXBIT	/SEG/
	0
	0
ENDDATA
>;RENC
>;STANFORD
	SETOM	136
	MOVEI	TEMP,DDTKIL
	HRRM	TEMP,JOBSA
	TERPRI	<SAVE ME!>
	CALL6	(1,EXIT)

STANFORD<RENC<DATA (START AND SEGMENT FETCH)>;RENC
>;STANFORD
	SETZM	RPGSW
	JRST	.+3
DDTKIL:	JRST	.-2		;KEEP TRACK OF RPG MODE
	SETOM	RPGSW
	MOVEM	17,INIACS+17	;AND INITIAL AC CONTENTS
	MOVEI	17,INIACS
	BLT	17,INIACS+16
;;#PN# ! RHT RESET (SO JOBFF IS OK)
	CALL6	(RESET)		;
STANFORD<RENC<
	JSP	P,.SEG2.	;GRAB SEGMENT HERE
	 JRST	DDTKIM		;NORMAL
	JRST	DDTKIM		;STPR2 WAS DONE

$PATCH:	JSP	P,.SEG2.	;ENTER HERE FROM RAID TO FETCH SECOND SEG
	JRST	@JOBDDT
	HALT	.
ENDDAT
DDTKIM:>;RENC
>;STANFORD
	MOVE	B,JOBSA		;RESET STARTING ADDRESS (AGAIN)
	SKIPL	136		;MUST WE DO ALL THIS?
	 JRST	 NOKIL		;NO, JUST GO
STANFO <
	SKIPE	C,JOBDDT	;ALSO FORGET IT IF NO DDT
	TLNN	C,-1		; OR IF NOT NEW ENOUGH RAID
	 JRST	 NOKIL
	HRL	B,-11(C)	;RESET FREE ADDRESS
>;STANFO
EXPO <
	SKIPN	C,JOBDDT	;FORGET IF NO DDT
	JRST	NOKIL		;
	HRL	B,JOBDDT	;GET IT FROM HERE INSTEAD
>;EXPO
	HLRM	B,JOBFF
	SETZM	JOBSYM
	MOVEI	C,0
	CALL6	(C,SETDDT)	;CLEAR OTHER GUYS
NOKIL:	MOVEM	B,JOBSA		;UPDATE
	HRRZ	B,JOBFF
	ADDI	B,=1024*7	;7K FOR INITIAL DATA
	CALL6	(B,CORE)	; (CORGET WON'T SHRINK IT)
	 JRST	 [TERPRI <NO CORE FOR INITIAL ALLOCATION>
		  CALL6	EXIT]
	MOVN	A,RPGSW
	JRST	SAIL(A)		;TAKE ACCOUNT OF RPG MODE
>;IFE FTDEBUG
;;%##% USED TO BE NOEXPO
;;#IH# (1-2)
>;NOTENX

TENX<
III←1
↑↑START:
	JSYS	RESET
	HRROI	B,HERALD
	HRROI	A,[ASCIZ/ Tenex SAIL 8.1 /]
	SETZ	C,
	JSYS	SIN		;COPY STRING
	MOVE	A,B
	SETO	B,
	MOVSI	C,044441	;"3-2-45" FOR EXAMPLE
	JSYS	ODTIM		;COPY TIME
	MOVE	B,A		;UPDATED BP
	HRROI	A,[ASCIZ/  (? for help)/]
	SETZ	C,
	JSYS	SIN
	MOVEI	A,SAIL
	HRRM	A,JOBSA		;FIX UP STARTING ADDRESS
	HRROI	A,[ASCIZ/
SSAVE pages 0 thru 577 as <SUBSYS>SAIL.SAV

/]
	JSYS	PSOUT
	JSYS 	HALTF		;IF CONTINUES, THEN FALLS THROUGH
>;TENX	

COMMENT ⊗ Larger, Sail --  Execution Starts Here⊗

↑LARGER: SETOM	%RENSW		;%ALLOC WILL ASK QUESTIONS
IFE III,<↑↑START:>
↑SAIL:
NOTENX <
	JRST	[SETZM	RPGSW
		JRST	.+2]
	SETOM	RPGSW
IFE III,<
	MOVEM	17,INIACS+17
	MOVEI	17,INIACS
	BLT	17,INIACS+16
>;IFE III
	SKIPE	RPGSW
	JRST	[SETNIT		;GET STACK
		PUSHJ	P,[XINI1:SETOM DSKSW
				 MOVE6	(CMDDEV,<DSK>)	;RPG MODE -- GET COMMANDS
				 CALLI	2,30		;GET JOB NUMBER
				 HRLZI	TEMP,DEFEXT	;OUR NAME
				 MOVEI	4,3
			FGLUP:	 IDIVI	2,=10		;FRNP
				 IORI	TEMP,20(3)
				 ROT	TEMP,-6
				 SOJG	4,FGLUP		;THREE DIGITS
				 MOVEM	TEMP,NAME	;CCL FILE NAME
				 MOVE6	(EXTEN,<TMP>)	;TEMP FILE NAME
				POPJ	P,]
		 JRST  BEG1]

	MOVE6	(CMDDEV,<TTY>)
	SETZM	DSKSW		;INPUT FROM TTY -- CLEAR FLAGS
BEG1:	SETOM	CONFIG		;CONFIGURATION FOR COMPILER IS -1
;; #PS# (1 OF 2)DON'T SET UP MYERR IN .ERRP. UNTIL NEEDED
	SKIPE	XTFLAG		;ONLY ONCE, EVER
	 JRST	.+3
	SETZM	A,.ERRP.	;ANOTHEREXTERNAL.
	SETZM	GOGTAB
	JSP	P,.SEG2.	;GET A SECOND SEGMENT.
;;%AO% THIS MAY SKIP RETURN NOW
	CALLI			;RESET THE WORLD
				;SKIP IF HAD TO SETPR2
				; A CALLI IS DONE RIGHT BEFORE SETPR2


	SETNIT			;GET A UUO ADDR, AND A TEMP PUSH-DOWN STACK
	SETZM	LSTSTRT		;ZERO LSTSTRT ON FIRST TIME AND NON-RPG RESTARTS

>;NOTENX
TENX <;START FOR TENEX -- THIS IS SAIL
	SKIPA			;STANDARD STARTING ADDRESS
	  JRST [SETNIT
		PUSHJ P,[XINI1:  SETOM	DSKSW	;CCL START
				 SETOM RPGSW
				 POPJ P,]
		JRST BEG1]
	SETZM	DSKSW
	SETZM	RPGSW
BEG1:	SETOM	CONFIG
	SKIPN	XTFLAG
	SETZM	A,.ERRP.	
	JSP	P,.SEG2.	;GET A SECOND SEGMENT -- NO SKIP RETURN
	JSYS	RESET	
	SETNIT			;GET A UUO ADDR, STACK
	SETOM	HISW		;DEFAULT /H COMPILATION FOR TENEX	
	SETZM	LSTSTRT		;ZERO LSTSTRT ON FIRST TIME AND NON-RPG RESTARTS	
>;TENX
	JRST	XTINI3

COMMENT ⊗  XTENDED COMPILATION RESTART ⊗

NOTENX<
RENC<
	DATA	(EXTENDED COMPILATION RESTART ADDR)
>;RENC
EXTERNAL INIACS
	SETZM	RPGSW
	JRST	.+3
↑↑XSTART:JRST	.-2
	SETOM	RPGSW
NOSTANFORD<
	SETZM	JOBHRL		;TO CURE RACE CONDITION IN DEC 5.06
>;NOSTANFORD
	JSP	P,.SEG2.	;GRAB OUR BUDDY BACK
	JRST	XTPR2W
	PUUO	3,.+2
	EXIT
	ASCIZ	/
NEED SEGMENT. TRY LATER./
XTPR2W:
RENC<
IFNDEF JOBHVR,<EXTERNAL JOBHVR>
IFNDEF JOBHGH,<EXTERNAL JOBHGH>
	MOVE	TEMP,JOBVER	;LOW SEGMENT VERSION
	CAMN	TEMP,JOBHVR+JOBHGH	;SAME AS HIGH VERSION?
	JRST	XTIN3A
	PUUO	3,.+2
	EXIT
	ASCIZ	/
LOSEG OUT OF DATE.  RECOMPILE./
	ENDDATA
>;RENC
XTIN3A:
	MOVSI	17,INIACS	;GET ACS BACK
	BLT	17,17
	SKIPN	RPGSW
	 JRST	.+3
	PUSHJ	P,XINI1
	JRST	XTINI3
	MOVE6	(CMDDEV,<TTY>)
	SETZM	DSKSW		;INPUT FROM TTY -- CLEAR FLAGS
	SETZM	RPGSW		;AND INDICATE SOURCE OF INPUT
			;GIVE BACK CORGET BUFFER SPACE FOR SRC, REL, LST
	HRRZ	TEMP,SRCHDR
	PUSHJ	P,GBBUF
	HRRZ	TEMP,BINHDR
	TLNE	FF,BINARY
	 PUSHJ	P,GBBUF
	HRRZ	TEMP,LSTHDR
	TLNE	FF,LISTNG
	 PUSHJ	P,GBBUF
XTINI3:
>;NOTENX
TENX<
RENC<	DATA	(EXTENDED COMPILATION RESTART ADDR)
>;RENC
EXTERNAL INIACS
	SETZM	RPGSW
	JRST	.+3
↑↑XSTART:JRST	.-2
	SETOM	RPGSW
	JSP	P,.SEG2.
	JRST	XTIN3A
RENC<	ENDDATA>
XTIN3A:
	MOVSI	17,INIACS
	BLT	17,17
	SKIPN	RPGSW
	  JRST	XTIN4A
	PUSHJ	P,XINI1
	JRST	XTINI3
XTIN4A:	SETZM	DSKSW
	SETZM	RPGSW
	;;;PERHAPS ADD CODE TO GIVE BACK THE BUFFER SPACES HERE
XTINI3:
>;TENX


NOTENX <
;THIS IS DONE IN TENEX COMMAND SCANNER LATER
; PRINT CRLF *  

	MOVE	TEMP,[OUTSTR [PROCSR]]
	SKIPE	XTFLAG
	MOVE	TEMP,[OUTSTR [ASCIZ/XSAIL:/]]
	SKIPN	RPGSW		;NO STAR IF IN RPG MODE
	MOVE	TEMP,[OUTCHR ["*"]]
	XCT	TEMP
NOS:

; GET ENOUGH OF COMMAND LINE TO BEGIN PROCESSING

REN<
	SKIPN	XTFLAG
	SETZM	HISW		;ASSUME NO TWO-SEGMENT COMPILATION
>;REN
;;%BZ% !
	HLLZS	EXTEN
	SETZM	WORD3		;WORDS 3 AND 4 OF ENTER TABLE
	SETZM	PPN

;  WILL RETURN HERE WHENEVER @ IS DETECTED FOLLOWING A FILE NAME

COMNIT:	SETZM	SAVTYI		;LOOKAHEAD CHARACTER
;;#UP# ! JFR 7-29-75 ALLOW MANUAL START AFTER RPG START
	SETZM	CMDMOD
IFN TMPCSW,<			;IF TMPCOR FEATURE AVAILABLE
;; #VO# 2! JFR 10-31-75 TMPCOR ONLY IF RPG MODE
	SKIPN	RPGSW
	 JRST 	NOTMP
	MOVSI	A,DEFEXT	;TEMPCORE UUO FOR STANDARD DEC
	MOVEM	A,CMDPNT	;DEC SYSTEM
	MOVE	A,[XWD -170,CMDBUF]
	MOVEM	A,CMDPNT+1
	MOVE	A,[XWD 2,CMDPNT];READ AND DELETE TEMP CORE
	CALLI	A,44
	JRST	NOTMP		;LOOK ON DSK AS USUAL
	IMULI	A,5		;NUMBER OF CHARS
	MOVEM	A,CMDCNT	;FUDGED COUNT
	MOVE	A,[POINT 7,CMDBUF+1]
	MOVEM	A,CMDPNT	;BYTE POINTER
	SETOM	CMDMOD		;TO DETECT TMPCORE IN USE
	JRST	FILEOK
NOTMP:
>;IFN TMPCSW
	RELEASE	CMND,0		;MAKE SURE FILE IS RELEASED
	MOVEI	SBITS2,CMDCDB	;OPEN COMMAND FILE
	HRLI	SBITS2,-1	;INDICATE NO CORGET
	PUSHJ	P,OPNUP		;(1 INBUF RQST IMPLIES NO CORGET, USE CMDBUF
	  IOERR	<COMMAND DEVICE NOT AVAILABLE>
	  JRST 	TRGAIN		;LOOKUP FAILED
	  JRST	FILEOK		;ALL OK

TRGAIN:	SKIPN	RPGSW		;PRINT MESSAGE IF NOT IN RPG MODE
	IOERR	<COMMAND FILE NOT FOUND>
	SKIPL	XTFLAG
	JRST	SAIL		;OTHERWISE ENTER NORMAL TTY MODE
	JRST	XSTART
>;NOTENX


COMMENT ⊗ Morfiles -- Execution Returns Here Each New Command Line⊗

FILEOK:	
DSCR MORFILES
DES Will return here whenever another command line is wanted
CAL in line
⊗

MORFILES:
	SKIPGE	XTFLAG
	 JRST	XINI4
	MOVEI	FF,0		;CLEAR FLAG WORD
	SETZM	GOGTAB		;FORCE INITIALIZATION OF CORE AREAS

; IT IS NOW SAFE (AND NECESSARY) TO CLEAR ALL THOSE VARIABLES
;  DECLARED VIA ZERODATA MACRO

	SETZM	ZBASE
	MOVE	TEMP,[XWD ZBASE,ZBASE+1]
	BLT	TEMP,ZBASE+ZSIZE-1 ;ANY ARGUMENTS?

	MOVE	TEMP,[XWD DEFSIZ,SPREQ+$SPREQ];MOVE DEFAULTS TO REQUEST BLOCK
	BLT	TEMP,SPREND
TENX<
	SETOM	HISW			;DEFAULT /H FOR TENEX
>;TENX
XINI4:
	MOVEI	TEMP,MACLST+PCOUT+LINESO ;ASSUME THIS ABOUT LISTING
	MOVSM	TEMP,SCNWRD
;;%DF%  
	LSH	TEMP,-=13		;REMEMBER THIS WAY TOO
	MOVEM	TEMP,FMTWRD
;;%DF% ↑
;RESET SRCCDB, AVLSRC IN CASE RESTART CLOBBERED IT IN SWITCH MODE
	SETZM	SWTLNK			;NO LINKS BACK
	SETZM	SRCDLY
	SETZM	BUFADR
NOTENX <
;;#%%# ! BY JFR 11-27-74  USED TO BE 17774,,0
	MOVSI	TEMP,3774	;CH7 AND ABOVE AVAILABLE
	MOVEM	TEMP,AVLSRC
	MOVEI	TEMP,SRC
FOR II←0,1 <
	DPB	TEMP,[POINT 4,SRCOP+II,12]
>
FOR II←0,3 <
	DPB	TEMP,[POINT 4,INSRC+II,12]
>
NOEXPO <
	DPB	TEMP,[POINT 4,SRCOP+2,12]	;PUSHJ IF EXPO
>;NOEXPO
>;NOTENX

	PUSHJ	P,COMND		;CALL COMMAND SCANNER
	ERR	<FATAL END OF SOURCE FILE>
	PUSHJ	P,SALNIT	;INITIALIZE RUNTIM, SAIL
	PUSHJ	P,MAKT	;PREPARE TITLE LINE
;;%DE% JFR 10-24-75
	MOVE	LPSA,SYMTAB
	HRROI	TEMP,1+[=15
			POINT 7,[ASCII/COMPILER_BANNER/]]
	POP	TEMP,PNAME+1
	POP	TEMP,PNAME
	PUSHJ	P,SHASH		;FIND IT IN SYMBOL TABLE
	MOVEI	TEMP,BANMAC	;NEW BODY
	HRLM	TEMP,%TLINK(LPSA)
;;%DE% ↑
	PUSHJ	P,HDR		;INIT PAGE NOS., PRINT HEADING IF LISTING


	SKIPGE	XTFLAG
	 JRST	XTCOPY		;WORLD LOOKS NICE, RESTORE PREVIOUS
				;STATE OF FILES
	PUSHJ	P,GENINI	;INITIALIZE GENERATORS

	PUSHJ	P,MKNSTB	; INITIALIZE NESTABLE DELIMITER TABLE
	QPUSH(DELSTK,REQDLM)		; INITIALIZE DELIMITER STACK TO NONE SPECIAL
				;   DELIMITER MODE

; TURN ON CONDITIONAL ASSEMBLY RESERVED WORD FLAG BELOW
	HRLZI	A,IF0OFF	; INITIALIZE OFFSET FOR STORING AN INDEX INTO A
				;  TABLE FOR ACCESSING THE ADDRESSES OF PRODUCTIONS
				;  WHICH ARE ENTERED BY A PUSHJ AFTER AN INTERRUPT.
				;  THESE INDICES ARE LOADED INTO BITS 6-8 OF THE 
				;  $TBITS ENTRY OF THE CORRESPONDING RESERVED WORD.
	MOVE	B,[XWD -NMCRES,RESLOC] ; SET UP LOOP
CONAGN:	MOVE	TEMP,(B)	; GET RESERVED WORD DESCRIPTOR
	TLZ	TEMP,CONBTS	; TURN OFF FLAG ENTRIES IN THE BYTE POINTER
	HLRZM	TEMP,PNAME	; LOAD RIGHT HALF OF PNAME WITH COUNT
	HRLI    TEMP,(<POINT 7,0>); FORM BYTE POINTER
	MOVEM	TEMP,PNAME+1	; LOAD PNAME+1 WITH BYTE POINTER
	MOVE	LPSA,SYMTAB	; GET BASE ADDRESS OF SYMBOL TABLE
	PUSH	P,B		; SAVE B
	PUSH	P,A		; SAVE OFFSET
	PUSHJ	P,SHASH		; GET THE SEMBLK ADDRESS
	POP	P,A		; RESTORE A
	POP	P,B		; RESTORE B
	HLLZ	TEMP,(B)	; GET LEFT HALF OF RESERVED WORD DESCRIPTOR
	AND	TEMP,[XWD CONBTS,0] ; REMOVE CHARACTER COUNT FROM LEFT HALF OF TEMP.
	TLNE	TEMP,DEFINT+CONDIN ; IF THE RESERVED WORD INDICATES THAT A
	JRST[TDO TEMP,A		;  PRODUCTION IS TO BE CALLED VIA A PUSHJ RATHER 
	ADD	A,[XWD IF0OFF,0] ;  THAN A RESUME THEN SET BITS 6-8 IN $TBITS TO 
	JRST	.+1]		;  REFLECT THE PRODUCTION THAT IS TO BE STARTED.
	IORM	TEMP,$TBITS(LPSA) ; SET COND. ASSEMBLY RESERVED WORD FLAGS
	AOBJN	B,CONAGN	; IF NOT DONE, GET NEXT


; SET UP PARSER STACK POINTERS WHICH ARE NOT YET BEING SET UP BY THE RUNTIME
; ROUTINES.  THESE ARE THE SEMANTIC, PARSE, AND CONTROL STACK POINTERS FOR
; THE CONDITIONAL PARSER AND THE SAIL PARSER.  ALSO SET UP THE CONTROL STACK
; POINTER FOR THE GENERAL PARSER.
	MOVE	TEMP,GPSAV	; GET SAIL SEMANTIC STACK POINTER
	MOVEM	TEMP,SGPSAV	; STORE IT
	MOVE	TEMP,PPSAV	; GET SAIL PARSE STACK POINTER
	MOVEM	TEMP,SPPSAV	; STORE IT
	MOVE	TEMP,PCSAV	; SAIL PROD. CONTROL STACK POINTER
	PUSH	TEMP,[XWD -1,RELSE]  ;PARSER WILL "POPJ" TO HERE
					;SEE "COMPILED PRODUCTIONS" EXPL.
	PUSH	TEMP,[PRODGO]	; ADDRESS OF FIRST SAIL PRODUCTION
	MOVEM	TEMP,SPCSAV	; STORE THE POINTER
	MOVEM	TEMP,PCSAV	; FIRST CALL TO SCANNER WITH SAIL IN CONTROL
				;++++
	MOVE	TEMP,CPCSAV	;
	PUSH	TEMP,[CPRODGO]	; INIT OTHER PARSER TO AN ERROR MESSAGE
;; #NO SINCE SWITCHING PARSERS FOR ELSEC OR ENDC WILL POP PCSAV
;; MUST HAV TWO ENTRIES ON CPCSAV STACK TO GET ERROR MESSAGE
	PUSH	TEMP,[CPRODGO]	; INIT OTHER PARSER TO AN ERROR MESSAGE
	MOVEM	TEMP,CPCSAV	;
				;++++
	SETZM	PRSCON		; DITTO
	QPUSH	(ENDCTR,[0])	; INITIALIZE ENDCTR STACK 
	QPUSH	(RECSTK,IFCREC)	; INITIALIZE RECSTK STACK 
	SETOM	SWCPRS		; SWITCHING PARSERS IS PERMISSIBLE
	MOVEI	TEMP,4001	; INITIALIZE SCNNO, SSCNNO, AND CSCNNO TO
	MOVEM	TEMP,SCNNO	; ONE SO THAT ONE WILL NOT POP THE PCSAV
	PUSHJ	P,SCANNER	;INITIALIZE FOR PARSERS -- ONE SCAN
	MOVEM	SP,PPSAV	;SAVE FIRST RESULT PTR
;; #PS# WAIT TILL LAST MOMEMT TO SET UP ERROR HANDLER
	MOVEI	TEMP,MYERR
	MOVEM	TEMP,.ERRP.

	JRST	PARSE		;THIS HERE IS THE COMPILER!


; ...
RELSE:	MOVE	TEMP,PCNT	;UPDATE LISTING OFFSET
	ADDM	TEMP,LSTSTRT
NOTENX <
RELAL:	RELEASE	LST,0
	RELEASE	BIN,0
	RELEASE	SRC,0
	RELEASE LOG,0
;; %BC%
BAIL <
	RELEASE SM1,0
>;BAIL
;; %BC%
	TERPRI
EOLCHK:	SKIPE	EOL		;SCAN UNTIL EOL COMES ON IN CASE
	JRST	ENDCOM		; GARBAGE WAS PRESENT AT END OF
	PUSHJ	P,WORD		; LINE
	JRST	EOLCHK

ENDCOM:	
;;=I06=	IF THERE WAS AN ERROR IN BATCH JOB, TYPE ?
DEC<
	SKIPLE	%BATCH		;.LT. IF NOT BATCH, .EQ. IF NO ERROR
	OUTSTR [ASCIZ	/? Error detected
/]				;if error in batch job, stop it
	SETZM	%BATCH		;reinit in case done again
> ;DEC
;;=I06=	↑
;; 2! JFR 10-30-75 BETTER WAY TO FORCE EXIT FOR /X
	SKIPE	XTFLAG
	 JRST	EXXIT		;/X ON, EXIT FORCED
	SKIPN	DSKSW		;NOW GO BACK IF IN TTY MODE, ELSE EXIT
	JRST	SAIL		; IF END OF FILE, ELSE
	SKIPN	EOF		; USE NEXT LINE OF COMMAND
	 JRST	 MORFILES	; FILE IF THERE IS MORE.
	
EXXIT:
	CALL6	(EXIT)		;STAGE LEFT.
>;NOTENX
TENX <
EXTERNAL RUNPRG
	HRROI	A,[ASCIZ/
End of compilation.
/]
	JSYS	PSOUT

	TLNE	FF,BINARY	;DONT LOAD IF NO BINARY
	SKIPN	LODMOD		;LOAD IMMEDIATELY?
	  JRST	CLOZZZ		;NO

	MOVEI	A,400000	;THIS FORK
	SETO	B,
	JSYS	DIC
	JSYS	CIS
	MOVEI	A,10		;CONTROL-H INTERRUPT
	JSYS	DTI		;DEASSIGN TERMINAL CODE

	SETZM	TMPCBF
	MOVE	A,[XWD TMPCBF,TMPCBF+1]
	BLT	A,TMPCBF+37
	HRROI	B,TMPCBF
	SETZ	C,
	HRROI	A,[SLOLOD]
	JSYS	SIN		;COPY OVER THE SAILOW NAME
	HRROI	A,[ASCIZ/DSK:/]	;ASSUME NO DDT
	SKIPE	LODDDT		;WANT A DDT?	
	  HRROI	A,[ASCIZ@/TDSK:@]
	JSYS	SIN		;COPY OVER	
	MOVE	A,B		;DESTINATION DESIGNATOR
	HRRZ	B,BINJFN
	HRLZI	C,1000		;FILE NAME ONLY
	JSYS	JFNS		;COPY RELFILE NAME
	MOVEI	C,"."	
	IDPB	C,A		;MAKE "FILE.EXT"
	HRLZI	C,000100	;EXTENSION ONLY
	JSYS	JFNS
	MOVE	B,A		;DESTINATION DESIGNATOR
IMSSS<
	SKIPN	LODSDT		;WANT SDDT?
	  JRST	NOSDT		;NOPE
	HRROI	A,[SDTLOD]
	SETZ	C,
	JSYS	SIN
NOSDT:
>;IMSSS
	MOVEI	C,175
	IDPB	C,B		;FINISH COMMAND
	SETO	A,
	JSYS	CLOSF		;CLOSE ALL FILES
	  JFCL			;ERROR RETURN
IMSSS <
	SETO	A,
	MOVEI	B,TMPCBF
	JSYS	PTINF		;PASS INFO TO THE LOADER
	  JFCL			;ERROR RETURN
>;IMSSS
NOIMSSS<
ZERODATA
CCLLOD: BLOCK 3
ENDDATA
	JSYS	GJINF		;GET THE JOB NUMBER
	MOVEM	C,B		;SAVE THE JOB NUMBER IN B
	HRROI	A,CCLLOD
 	MOVE	C,[XWD 140003,12]	;DECIMAL, FIELD LENGTH 3, LEADING ZEROS
	JSYS	NOUT
	  JFCL
	MOVEM	A,B		;DESTINATION BP
	HRROI	A,[ASCIZ/LOA.TMP/]
	SETZ	C,		;COPY UNTIL NULL BYTE
	JSYS	SIN
	MOVSI	A,400001	;WRITING, BP IN 2
	HRROI	B,CCLLOD
	JSYS	GTJFN
	  ERR	<Cannot chain to LOADER>,1
	MOVE	B,[XWD 70000,100000]
	JSYS	OPENF
	  ERR	<Cannot chain to LOADER>,1
	SETZ	C,
	HRROI	B,TMPCBF
	JSYS	SOUT
	JSYS	CLOSF
	  JFCL
>;NOIMSSS
	PUSH	P,[1]		;CCL MODE
	PUSH	P,[0]		;THIS FORK
	EXCH	SP,STPSAV
	PUSH	SP,LODDER
	PUSH	SP,LODDER+1
	PUSHJ	P,RUNPRG
	EXCH	SP,STPSAV	;CANNOT GET HERE AT ALL
	 JRST	SAIL		;ERROR RETURN

CLOZZZ:	SETO	A,
	JSYS	CLOSF
	  JFCL
;; 2! JFR 10-30-75 BETTER WAY TO FORCE EXIT IF /X
	SKIPE	XTFLAG
	 JRST	EXXIT
	JRST	SAIL
EXXIT:	JSYS	HALTF
	JRST	.-1

LODDER:	RUNLOD
	


>;TENX


COMMENT ⊗ Salnit -- Storage Initialization, Etc.
This routine handles steps 2-5 of the initializing procedure ⊗
↑SALNIT:
	NOGEN

	SKIPGE	XTFLAG
	 JRST	XTINI2
; INITIALIZE RUNTIME DATA AREAS
	POP	P,GENLEF		;ALLOC WILL LOSE STACK
	JSP	16,%ALLOC		;SET THEM UP
;;#IH#? 7-4-72 DCS (2-2) IMPROVE CORE ASSIGNMENT
	SETOM	NOSHRK(USER)		;PREVENT CAPRICIOUS CORE RELEASE
	PUSH	P,GENLEF		;RETURN RETURN TO STACK
	PUSH	P,[%ARRSRT]		;REMOVE FROM GARBAGE COLLECT RING
	PUSHJ	P,SGREM


; CLEAR SAIL SWITCHED DATA AREA, FF, JOBERR

	SKIPN	RPGSW		;IF NO ONE CAME BEFORE,
	SETZM	42		;  NO ERRORS YET
	TLO	FF,TOPLEV!MAINPG ;MAIN PROGRAM AND MARK TOP LEVEL
	SETZM	SLD1
	MOVE	TEMP,[XWD SLD1,SLD1+1]	;CLEAR ANOTHER AREA
	BLT	TEMP,ENDSRC


; ENABLE FOR PDL OVERFLOW INTERRUPT, SET UP  TABLE TO DESCRIBE 
; PROBABLE CAUSES (SEE SETPOV IN HEAD, POVTRP IN COMSER)

IFN 0, < ;THIS IS THE WAY IS USED TO BE -- RHT
;;#GH# DCS 2-1-72 (1-5) USE DIFFERENT INTERRUPT TO CATCH <ESC>I
	MOVEWI	JOBAPR,INTRPT	;ADDRESS OF INTERRUPT ROUTINE
;;#GH# USED TO BE POVTRP
EXPO <
	MOVEI	TEMP,INTPOV	;ENABLE FOR PDLOV ONLY
	CALL	TEMP,['APRENB'] ;TELL THE SYSTEM
>;EXPO
NOEXPO <
	MOVE TEMP,[XWD INTTTI,INTPOV];MOVEI TEMP,INTPOV
	CALL6	(TEMP,INTNB)	;ENABLE FOR GOOD KIND OF INTERRUPT
>;NOEXPO
;;#GH#
>;IFN 0

XTINI2:
NOTENX <
;;%AY% RHT 2-12-73 USE THE INTMAP RUNTIME ROUTINE FOR THIS
EXTERN ENABLE,INTMAP
NOEXPO <			;THIS TIME DO <ESC>I
	PUSH	P,[ITTYIX]
	PUSH	P,[ITTYDO]	
	PUSH	P,[0]
	PUSHJ	P,INTMAP
	PUSH	P,[ITTYIX]
	PUSHJ	P,ENABLE
>;NOEXPO
	PUSH	P,[IPOVIX]	; PDL OV
	PUSH	P,[POVDO]
	PUSH	P,[0]
	PUSHJ	P,INTMAP	
	PUSH	P,[IPOVIX]
	PUSHJ	P,ENABLE
;;%AY%
>;NOTENX
TENX <
;Don't use Tenex INTMAP because it saves ac's, unneeded for <ESC I>
;which saves TEMP itself, and plain wrong for POVDO which must set
;up TEMP for forced Debrk to itself.

;First make sure we got an interrupt system.
	HRRZI	A,400000	;THIS FORK
	JSYS	RIR		;READ INTERRUPT SYS. TABLE ADDR.
	EXTERN	LEVTAB,CHNTAB,ATI,ENABLE
	JUMPE	2,[MOVE 2,[XWD LEVTAB,CHNTAB]	;XX'D IN GOGOL
		   JSYS	SIR		;SET INT. SYS. TABLES
		   JRST .+1]
	JSYS	EIR		;ENABLE INT. SYS - GENERAL TURN-ON
	MOVE	A,[XWD 3,POVDO] ;DISPATCH VECTOR FOR PDLOV
	MOVEM	A,IPOVIX(2)	;IPOVIX MUST BE =9
	MOVE	A,[XWD 3,ITTYDO]	;FOR <ESC I> (I.E. CTRL H)
	MOVEM	A,ITTYIX(2)	;INTMAPS DONE. ENABLES:
	PUSH	P,[IPOVIX]
	PUSHJ	P,ENABLE
	PUSH	P,[ITTYIX]
	PUSHJ	P,ENABLE	;AND THEN ACTIVATE TERMINAL INTERRUPT
	PUSH	P,[ITTYIX]
	PUSH	P,[10]		;TERMINAL INTERRUPT CODE FOR CTRL-H
	PUSHJ	P,ATI
>;TENX


	SKIPGE	XTFLAG
	 JRST	XTINI4

	SETPOV	(P,SYSTEM!PDL -- USE /P TO INCREASE)
	SETPOV	(SP,PARSE STACKS -- USE /R TO INCREASE)
	SETPOV	(PNT,<DEFINE STACK -- CHECK FOR MACRO RECURSION,
		OR USE /D TO INCREASE>)
;GP←←7
	SETPOV	(7,PARSE STACKS -- USE /R TO INCREASE)
	SETPOV	(SP-1,STRING!PDL -- USE /Q TO INCREASE)
	;LATTER IS KLUDGE -- MOVSS OF WORD CONTAINING PARSE-STRING
	;WARNINGS WILL BE DONE WHENEVER SP CONTAINS STRING PDP --
	;INCLUDED FOR SPEED, BUT DECIDEDLY DANGEROUS IF ACS ARE
	; EVER REDISTRIBUTED



	SETOM	STPAGE		;DON'T STOP ON PAGE NUMBERS
;	AOS	SALSTR		;MARK SAIL "PROCEDURE" ACTIVE FOR STRGC
	MOVE	USER,GOGTAB
	SETOM	NOSHRK(USER)	;DON'T LET CORREL SHRINK CORE

;SET UP INITIAL SYMBOL TABLE AND BUCKETS

	PUSHJ	P,SETBLK	;GET SYMBOL BLOCKS
	MOVEI	LPSA,IPROC	;TOP LEVEL VARB RING
; DCS 9-21-71
	SETZM	%RSTR(LPSA)	;CLEAR STRING RING ENTRY
	MOVEM	LPSA,STRRNG	;PUT PROGRAM NAME BLOCK ON STRING RING
; DCS
	SETZM	QQFLAG		;INITIALIZE UNDECLARED IDENTIFIER STUFF
	SETZM	QQBLK		;
	MOVEM	LPSA,VARB	;INITIAL VARB LIST
	MOVEM	LPSA,TPROC	;TOP LEVEL PROCEDURE
	MOVEM	LPSA,TTOP	;TOP LEVEL BLOCK
	MOVEI	TEMP,MBLK	;GIVE TOP-LEVEL PROC A 2D BLOCK
	HRLM	TEMP,%TLINK(LPSA)
	MOVEI	TEMP,1
	MOVEM	TEMP,$PNAME(LPSA)	;"M" IS DEFAULT PROGRAM
	MOVE	TEMP,[<POINT 7,[ASCII /M/]>] ; NAME
	MOVEM	TEMP,$PNAME+1(LPSA)
;;#TN# BIG HACK
	MOVE	TEMP,[XWD OWN,PROCED]	;MAKE THE TBITS CORRECT
	MOVEM	TEMP,$TBITS(LPSA)
;;#TN# ↑
	SETZM	$ACNO(LPSA)
;;%BT%
	MOVEI	A,3		;PCNT AT "PRDEC"
	HRLZM	A,$VAL2(LPSA)	;
	HRRZM	A,$ADR(LPSA)	;ALSO STARTING ADR OF "PROCEDURE"
;;%BT% ↑
INITPD:	MOVEI	TEMP,IPDSBK
	MOVEM	TEMP,$VAL(LPSA)
	SETZM	$PNAME(TEMP)
	SETZM	$PNAME+1(TEMP)
;;%BT%	
	HRLZI	A,7
	MOVEM	A,$ACNO(TEMP)		;PCNT after mksemt
;;%BT% ↑
	SETZM	$VAL(TEMP)
	SETZM	$VAL2(TEMP)
	SETZM	$ADR(TEMP)
	HLRZ	TEMP,%TLINK(TEMP)
;;%AL% CHANGED THE INITIAL CODE SEQUENCE
	HRRZI	A,4			;FIXUP FOR [PDA,0]
;;#KC# 11-12-72 RHT -- FIX FOR HIGH SEGS
REN <
	SKIPE	HISW			;HIGH SEG?
	TRO	A,400000		;YES
>;REN
;;#KC#
  	HRRM	A,$ADR(TEMP)
	SETZM	$VAL2(LPSA)
	JRST	ZEVB
ZERV:	LEFT	,%RVARB,ZSTR	;GO ALONG VARB LIST ZEROING
ZEVB:	HLLZS	$ADR(LPSA)	;THE RIGHT THINGS
	JRST	ZERV
ZSTR:	GETBLK	STRCON		;BUCKET FOR STRINGS
	GETBLK	CONST		;AND FOR NUMERIC CONSTANTS

	GETBLK	SYMTAB		;SYMBOL TABLE BUCKET
	HRLI	LPSA,MBUCK	;INITIAL BUCKET
	MOVE	TEMP,LPSA
	BLT	LPSA,BLKLEN-1(TEMP)

;NOW INITIALIZE QSTACK FOR COUNTER FIXUPS

	SKIPN	KOUNT		;ARE WE GOING TO PUT OUT COUNTERS
	JRST	.+4		;NO
	MOVNI	A,1		;GET A -1
	MOVEI	LPSA,KPDP	;POINT TO THE QSTACK (EMPTY AT THIS POINT)
	PUSHJ	P,BPUSH		;PUSH ON THE MARKER

; NOW SET UP OTHER PUSH-DOWN LISTS


	MOVEM	SP,STPSAV	;SAVE STRING POINTER
	MOVE	SP,PPSAV	;AND SET UP PARSE POINTER
XTINI4:	HLLZ	TEMP,SCNWRD	;FINISH UP THE LIST CONTROL WORD
	TLC	TEMP,MACLST!MACEXP
	TLCN	TEMP,MACLST!MACEXP ;BOTH EXPAND AND LIST NAMES
	TLO	TEMP,LSTEXP	;YES


;;#GR# DCS 2-8-72 (1-3) MINOR FTDEBUGGER FIXES
; REMOVE ANY BREAKPOINTS SET BY FTDEBUGGER
; #GR# FIX REMOVED WHEN RAID IMPROVED 6-12-72
CKLS:	TLNN	FF,LISTNG	;LISTING?
;;#GR# (1)
	MOVEI	TEMP,1		;NO, NOLIST ON, ALL OTHERS OFF
	MOVEM	TEMP,SCNWRD	;UPDATE
	TLNN	FF,LISTNG	;LISTING?
	 POPJ	P,		; NO
	MOVEI	C,=50		;GET SOME CORE FOR LISTING FILE
	PUSHJ	P,CORGET
	ERR	<DRYROT AT LSTGET>,1
	MOVEM	B,LSTBUF	;LOC OF LIST OUTPUT BUFFER
	HRLI	B,440700	;INIT BYTE POINTER
	MOVEM	B,LPNT		;LIKE THAT
	POPJ	P,		;RETURN FROM SAIL INIT


COMMENT ⊗ XTCOPY, RESTORE PREVIOUS STATE OF .REL FILE ⊗
NOTENX<
XTCOPY:
	POP	P,PPN		;MOVE INFO INTO LOOKUP BLOCK
	POP	P,EXTEN
	POP	P,NAME
	POP	P,TMQDEV
	MOVEI	SBITS2,TMQCDB	;INPUT CDB
	MOVEI	TBITS2,BINCDB	;OUTPUT CDB
	MOVSI	SBITS,(<OUT BIN,>)	;OUTPUT INSTR
	SKIPE	TMQDEV
	 PUSHJ	P,XTCOP1	;COPY OLD .REL FILE
	POP	P,PPN
	POP	P,EXTEN
	POP	P,NAME
	POP	P,TMQDEV
	MOVEI	TBITS2,SM1CDB	;OUTPUT CDB
	MOVSI	SBITS,(<OUT SM1,>)	;OUTPUT INSTR
	SKIPE	TMQDEV
	 PUSHJ	P,XTCOP1	;COPY OLD .SM1 FILE
	HRRZS	XTFLAG		;RESET LEFT HALF
	JRST	XTCONT		;GET BACK INTO SCANNER LOOP

XTCOP1:
	PUSHJ	P,OPNUP		;OPEN TMQ (OLD BIN) FILE, INPUT
	 IOERR	<OPEN ERROR: TMQ>
	 IOERR	<LOOKUP ERROR: TMQ>
	MOVEI	A,[ASCIZ/
Copying @F:@F.@F@G
/]
	MOVEI	B,-1+[	PWORD	CDEV(SBITS2)
			PWORD	CFIL(SBITS2)
			PLEFT	CEXT(SBITS2)
			PWORD	CPPN(SBITS2)]
	PUSHJ	P,SPLPRT
XTCLUP:	SOSGE	CCNT(SBITS2)	;COPY TMQ TO BIN.
	 JRST	XTCIN			;CANT USE INOUT BECAUSE DIFFERENT
	ILDB	TEMP,CPNT(SBITS2)	;DATA STRUCTURES FOR FILES
	SOSG	CCNT(TBITS2)		;IN COMPILER/RUNTIMES
	 JRST	XTCOUT
XTCLP1:	IDPB	TEMP,CPNT(TBITS2)
	JRST	XTCLUP

XTCIN:	IN	TMQ,
	 JRST	XTCLUP		;NO ERROR
	GETSTS	TMQ,TEMP
	TRNE	TEMP,740000	;CHECK ERROR BITS
	IOERR	<INPUT ERROR: TMQ>
	TRNE	TEMP,20000	;CHECK EOF BIT
	 JRST	XTCDON		;YES
	JRST	XTCLUP

XTCOUT:	XCT	SBITS		;OUT CHAN,
	 JRST	XTCLP1		;NO ERROR
	IOERR	<OUTPUT ERROR>
	JRST	XTCLP1

XTCDON:	RELEASE	TMQ,
	HRRZ	TEMP,CHDR(SBITS2)
			;GIVE BACK BUFFER SPACE
GBBUF:			;ENTER WITH TEMP=ADDR OF SOME BUFFER
	HRRZ	B,(TEMP)	;ADDR OF NEXT BUFFER
	CAIG	B,(TEMP)
	 JRST	GBBUF1		;B IS ADDR+1 OF FIRST BUFFER
	MOVEI	TEMP,(B)	;TRY AGAIN
	JRST	GBBUF
GBBUF1:	MOVEI	B,-1(B)		;FWA CORGET BLOCK
	JRST	CORREL
>;NOTENX

TENX<
XTCOPY:
	BEGIN XTCOPY
	SKIPN	BINJFN
	  JRST	NOXTB
	PUSH	P,BINJFN
	PUSH	P,[XWD -1,XTBFIL]
	PUSHJ	P,XTCOP1
NOXTB:	SKIPN	SM1JFN
	  JRST	NOXTS
	PUSH	P,SM1JFN
	PUSH	P,[XWD -1,XTSFIL]
	PUSHJ	P,XTCOP1
NOXTS:	HRRZS	XTFLAG
	JRST	XTCONT
XTCOP1:
;CALL TO HERE WITH PUSHJ P,
;ARGS ON STACK:  -2(P)  JFN TO COPY TO
;		 -1(P)  BP TO STRING WITH SOURCE FILE NAME
	MOVSI	1,100001
	MOVE	2,-1(P)
	JSYS	GTJFN
	  IOERR	<GTJFN ERROR ON TMQ FILE>
	MOVE	2,[XWD 440000,200000]	;READ, 36 BIT, MODE 0
	JSYS	OPENF
	  IOERR	<OPENF ERROR ON TMQ FILE>
	MOVEM	1,-1(P)			;PUT JFN ON STACK
	HRROI	1,[ASCIZ/
Copying /]
	JSYS	PSOUT
	PUSH	P,-1(P)
	PUSHJ	P,DOJFNS
	HRROI	1,[ASCIZ/ to /]
	JSYS	PSOUT
	PUSH	P,-2(P)
	PUSHJ	P,DOJFNS
	HRROI	1,[ASCIZ/
/]
	JSYS	PSOUT
	
;THOUGH SOMEWHAT SLOW, WE WILL USE BYTE IO SINCE IT IS
;MORE EASILY DONE WITHOUT BUFFERS ETC
XTCLUP:	MOVE	1,-1(P)			;SOURCE JFN
	JSYS	BIN
	JUMPE	2,CHKEOF		;0, BETTER TEST EOF
NOTEOF:	MOVE	1,-2(P)			;DESTINATION JFN
	JSYS	BOUT
	JRST	XTCLUP
	
CHKEOF:	
	JSYS	GTSTS
	TLNE	2,(1B8)			;END OF FILE?
	  JRST	ISEOF			;YES
	SETZ	2,			;NO, CONTINUE
	JRST	NOTEOF

ISEOF:	MOVE	1,-1(P)
	JSYS	CLOSF
	  IOERR	<CANNOT CLOSF TMQ FILE>
	SUB	P,X33			;CLEAR STACK
	JRST	@3(P)			;RETURN
	

DOJFNS:
;CALL WITH PUSHJ
;JFN AT -1(P)
	MOVEI	1,100			;PRIMARY OUTPUT
	MOVE	2,-1(P)
	SETZ	3,
	JSYS	JFNS
	SUB	P,X22
	JRST	@2(P)

	BEND XTCOPY

>;TENX


SUBTTL	COMMAND SCANNER DATA (CDB's)


SUBTTL	Comnd, aux. routs -- Command Scanner

EXTERNAL SPLPRT
NOTENX <
;Everything from here to the end of SAIL has been switched out
;for TENEX except for the code at DELIM & UNSWT. A new file, CC, exists
;which should be assembled after SAIL and contains the TENEX code
;(not under a switch tho', Stanford just skips the file).
BITDATA (INDICES INTO CDBS)
CMOD←←0
CDEV←←1
CHED←←2
CHDR←←3
CPNT←←4
CCNT←←5
CFIL←←6
CEXT←←7
;;#%%# BY JFR 11-7-74 PPN NOW KEPT IN CDB
CPPN←←10
COPN←←11
CENT←←12
CSPC←←13
CBFS←←14
;;=I10= ADD SFD'S
SFDS<
CPATH←←16
> ;SFDS
ENDDATA

DSCR COMND and friends
 COMMAND SCANNER -- ALLOWS COMMANDS OF THE FORM 
   <FILENAME><,FILENAME> ← FILENAME<,FILENAME>*
 WHERE THE STAR INDICATES ANY NUMBER OF REPETITIONS
   EACH FILE NAME CAN BE FORMED FROM THE FOLLOWING PATTERN:
	<DEVICE:><NAME><.EXT><[PROJ,PROG]>
   THERE ARE SOME EXTRA RULES ABOUT WHAT MAY BE LEFT OUT
   IF EITHER DEVICE OR NAME MUST BE PRESENT. DSK
   IS ASSUMED IF DEVICE IS OMITTED.  NAME MUST BE PRESENT IF
   EXT OR PROJ,PROG ARE USED.
 THE SCANNER ASSUMES .REL FOR BINARY EXTENSIONS, .LST FOR
 LISTING FILE EXTENSIONS, AND TRIES BOTH .GOG AND BLANK EX-
 TENSIONS FOR THE SOURCE FILES.

 IF ONE OVERRIDES THE DEVICE ASSUMPTION (DSK), IT HOLDS ONLY
 FOR A SINGLE FILE TO THE LEFT OF THE ARROW. IT HOLDS
 UNTIL REPLACED ON THE RIGHT SIDE.

 A PPN OTHER THAN 0 HOLDS ONLY FOR ONE FILE NAME 

 IT WOULD BE WISE NOT TO COUNT ON ANY BUT THE FIXED ACS
  AFTER RETURN FROM COMND
⊗

DATA (COMMAND SCANNER VARIABLES)

COMMENT ⊗ The CDBs (Channel data blocks) specifying file parameters
 for all files except the source file (see SRCCDB in switched data
 in main SAIL data area) are located here.
⊗

; COMMAND FILE
MAKCDB(CMND,CMD,0,1,0)

; BINARY OUTPUT FILE (REL FILE)
MAKCDB(BIN,BIN,10,0,=8)

; TEXT OUTPUT FILE (LISTING FILE)
MAKCDB(LST,LST,0,0,=8)

;; %BC%
BAIL <
; SYMBOL TABLE FILES
MAKCDB(SM1,SM1,10,0,2)
>;BAIL
;; %BC%


XCOM<
MAKCDB(TMQ,TMQ,10,=8,0)		;TEMP FOR COPYING
>;XCOM

; COMMAND FILE BUFFER AREA -- not taken from free storage so that
;  data can be retained over multiple compilations (free storage
;  reinitialized for each).  OPNUP routine does the right thing 
;  about getting JOBFF set up right.

CMDBUF:	BLOCK	206	;ONE BUFFER IS ENOUGH FOR COMMAND FILE

ZERODATA (COMMAND SCANNER VARIABLES)

;TYICORE flag -- if on, FILNAM routine gets input from PNAME+1 bp
; (for program and library requests, source file switching).  Other-
; wise, from command input file
;TTYTYI, if set, causes FILNAM to get its input from the terminal.
;  (this flag should be SETOM'ed at the start, SETZM'ed on return)

↑TYICORE: 0
↑TTYTYI:  0
ENDDATA



COMMENT ⊗ Opnup -- Open Files
 Totally subsidiary to  COMND ⊗
OPNUP:	XCT	COPN(SBITS2)	;DO AN APPROPRIATE OPEN
	 JRST	 CNTOPN	;DEVICE NOT AVAILABLE

; ENTER HERE TO TRY A DIFFERENT FILE NAME (SEE GETSRC AND FOLLOWING)

OPNAGN:	MOVEW	(<CFIL(SBITS2)>,NAME) ;STORE NAMES FOR OTHERS
	MOVEW	(<CEXT(SBITS2)>,EXTEN) 
;;#%%# BY JFR 11-7-74 KEEP TRACK OF PPN
;;=I10=	BECAUSE OF SFD'S, PPN IS NOW MORE COMPLEX
NOSFDS<
	MOVEW	(<CPPN(SBITS2)>,PPN)	;FETCH FROM BLOCK WHICH LOOKUP WILL MANGLE
> ;NOSFDS
SFDS<
	MOVE	TEMP,PPN		;SAVE PPN - GET IT
	JUMPE	TEMP,.+3		;IF ZERO, IT'S OK
	TLNN	TEMP,777777		;IF LH NON-ZERO, ALSO OK
	MOVEI	TEMP,CPATH(SBITS2)	;MUST BE PATH PTR, USE NEW PATH
	MOVEM	TEMP,CPPN(SBITS2)	;NOW SAVE PPN IN NEW PLACE
	MOVSI	TEMP,PATHB		;NOW COPY PATH BLOCK
	HRRI	TEMP,CPATH(SBITS2)
	BLT	TEMP,CPATH+10(SBITS2)
> ;SFDS

	XCT	CENT(SBITS2)		;ENTER OR LOOKUP
	 JRST	 CNTENT			;CAN'T ENTER OR LOOKUP

;;#%%# BY JFR 11-7-74 KEEP TRACK OF PPN
	MOVEW	(PPN,<CPPN(SBITS2)>)	;CLOBBER THE NEGATIVE SWAPPED WORD COUNT

	HRRZ	C,CBFS(SBITS2)		;#BUFFERS
	IMULI	C,204			;ASSUME DISK-SIZED BUFFERS
	MOVEI	B,CMDBUF		;ASSUME NO DYNAMIC BUFFER GRABBING
	JUMPL	SBITS2,NGOOD		;IF NO DYNAMIC BUFFER GRABBING
	PUSH	P,A
	 PUSHJ	 P,CORGET		;NO, GET SOME BUFFERS
	JRST	.CORERR			;WHAT?
	POP	P,A
NGOOD:	MOVEM	B,JOBFF			;START HERE.
	ADDI	C,(B)			;END ADDR +1
	MOVEI	TEMP,1(B)
	HRLI	TEMP,(B)		;ADDR,,ADDR+1
	SETZM	-1(TEMP)		;EVIDENCE IS GROWING
	BLT	TEMP,-1(C)		;AHHHHHH !

	XCT	CSPC(SBITS2)		;UINBF OR OUTBUF

ALLOK:	AOS	(P)			;SKIP 2
CNTENT:	AOS	(P)			;SKIP 1
CNTOPN:	POPJ	P,			;SKIP 0

COMMENT ⊗ Comnd Itself⊗

COMND:
	SETZM	DEVICE		;MAKE NO ASSUMPTION YET
	SETZM	EXTEN		;BLANK EXTENSION, .REL LATER PERHAPS
	PUSHJ	P,FILNAM	;SCAN A FILE NAME
	CAIE	A,"@"		;INDIRECT FILE SPECIFICATION?
	JRST	CHKPNT		;NO

	SKIPN	TEMP,DEVICE	;PREPARE TO OPEN A NEW
	MOVE6	(CMDDEV,<DSK>)	; COMMAND FILE

	SETOM	DSKSW		;COMMANDS NOW FROM "RPG" FILE
	POP	P,A		;TOSS OUT RETURN ADDRESS
	JRST	COMNIT		; GO BACK AND INIT A NEW COMMAND FILE

CHKPNT:	CAIE	A,"!"		;AM I BEING REPLACED?
	JRST	GETDST		;NO, THIS IS A NEW COMMAND

LODNEW:
	SKIPN	TEMP,EXTEN	;ASSUME "DMP" UNLESS
EXPO <
	MOVEI	TEMP,0
>;EXPO
NOEXPO <
	MOVSI	TEMP,'DMP'
>;NOEXPO
	MOVEM	TEMP,EXTEN
	SKIPN	TEMP,DEVICE	;LIKEWISE "SYS"
	 MOVE6	 (DEVICE,<SYS>)
NOEXPO <
	MOVEWI	WORD3,1		;INCREMENT 1 OFF JOBSA
	MOVEI	P,DEVICE	;CALL FOR RUNJOB
	CALL6	P,<SWAP>	;GOODB...
>;NOEXPO
EXPO <
;;%BZ% !
	HLLZS	EXTEN		;HOPE THIS WINS
	SETZM	WORD3
	SETZM	PPN
	MOVSI	TEMP,1		;STARTING INCREMENT
	HRRI	TEMP,DEVICE	;TABLE ADDRESS
	CALL6	(TEMP,RUN)	;GOODB...
>;EXPO



; IF THIS IS A BINARY SPEC, INIT BINARY FILE

GETDST:
	SKIPN	TEMP,DEVICE	;WAS DEVICE SPECIFIED?
	MOVE6	(DEVICE,<DSK>)	;IF NOT, MAKE IT DSK

	SKIPN	NOFILE		;WAS A FILE SPECIFIED?
	JRST	GTD1		; YES
	CAIN	A,","		;ONLY LIST FILE?
	JRST	NOBIN		; YES, NO BINARY
	SKIPN	EOL		;IF EOL, ASSUME END OF DISK FILE
	JRST	CHKARR		;OR SOMETHING, GO BACK TO SCANNING
	POP	P,A		; SEQUENCE WHERE PROCESS CAN BE
	JRST	RELSE		; TERMINATED (OR MAY BE EXTRA LINE)

GTD1:
	MOVEW	(BINDEV,DEVICE)	;BINARY DEVICE (PROBABLY DSK)
	SKIPN	TEMP,EXTEN	;ASSUME REL IF NOT SPECIFIED
	MOVE6	(EXTEN,<REL>)
NOEXPO <
	MOVSI	SBITS2,400000	;KLUGE TO MAKE .REL FILE DUMP NEVER
	MOVEM	SBITS2,WORD3	;
>;NOEXPO
EXPO <
	SETZM   WORD3		;DUMP NEVER NOT FOR EXPORT
>;EXPO
;;%BZ% ! FOR DATE 75 
	HLLZS	EXTEN		;HOPE THIS WINS

	MOVEI	SBITS2,BINCDB
	PUSHJ	P,OPNUP		;OPEN BINARY FILE
	  IOERR	<BINARY DEVICE NOT AVAILABLE>
	  IOERR	<NO ROOM ON BINARY DEVICE>
	SETZM	WORD3
;;%BZ% ! FOR DATE 75 
	HLLZS	EXTEN		;HOPE THIS WINS
	  TLO	FF,BINARY	;DENOTE BINARY FILE EXISTS
;; %BC%
BAIL <
	SKIPG	BAILON		;DOING A BAIL COMPILATION?
	  JRST	NBAIO5		;NO
;;%DO% 1! JFR 7-5-76 USED TO ASSUME 'DSK'
	MOVE	SBITS2,BINDEV
	MOVEM	SBITS2,SM1DEV
	HRLZI	SBITS2,'SM1'
	MOVEM	SBITS2,EXTEN
NOEXPO<
	MOVSI	SBITS2,400000	;KLUGE FOR DUMP NEVER
	MOVEM	SBITS2,WORD3
>;NOEXPO
EXPO <
	SETZM	WORD3
>;EXPO
	MOVEI	SBITS2,SM1CDB
	PUSHJ	P,OPNUP		;OPEN AND ENTER AND ASSIGN BUFFERS
	  IOERR <OPEN FAILURE - SM1>
	  IOERR <ENTER FAILURE - SM1>
	SETZM	WORD3
;;%BZ% ! FOR DATE 75 
	HLLZS	EXTEN		;HOPE THIS WINS
NBAIO5:
>;BAIL
;; %BC%
	CAIE	A,","		;LIST FILE?
	JRST	CHKARR		; NO, GO ON

NOBIN:	MOVE6	(DEVICE,<DSK>)	;ASSUME DSK FOR LISTING FILE
NOEXPO <
	MOVE6	(EXTEN,<LST>)	;AND ASSUME EXT OF .LST
>;NOEXPO
EXPO <
	MOVE6	(EXTEN,<CRF>)	;AND ASSUME EXT OF .CRF
>;EXPO
	PUSHJ	P,FILNAM	;SCAN THE FILNAME
	SKIPE	NOFILE		;IS THERE A LISTING FILE?
	JRST	CHKARR		; NO, MUST BE FOLLOWED BY "←"
;;=I05=
	CAIE	A,"="
	CAIN	A,"←"		;MUST BE ANYWAY
	JRST	GETLST		; IS

CHKARR:
;;=I05=
	CAIE	A,"←"		;IF NO "←", THERE'S AN ERROR
	CAIN	A,"="
	JRST	NOLST		;NO LISTING FILE
	IOERR	<SAIL COMMAND ERROR>

GETLST:	
	MOVEW	(LSTDEV,DEVICE)	;LISTING DEVICE
	MOVEI	SBITS2,LSTCDB
	PUSHJ	P,OPNUP
	  IOERR	<LISTING DEVICE NOT AVAILABLE>
	  IOERR	<NO ROOM ON LISTING DEVICE>
	
	TLO	FF,LISTNG	;DENOTE EXISTENCE OF LST FILE
BAIL<
	SKIPLE	BAILON
	 PUSHJ	P,BFILOU	;IF BAIL ACTIVE, PUT OUT FILE INFO
>;BAIL
	JRST	GETSRC		; NOW GET SOURCE FILE (ONE ONLY AT FIRST)

BAIL<
BFILOU:	SKIPG	BAILON
	 POPJ	P,
	SETZ	SBITS,
	HLLM	SBITS,BCORDN	;NO LONGER DOING COORDINATES
	PUSHJ	P,VALOUT	;END PREVIOUS TABLE
	MOVEI	SBITS,BAIFIL	;FILE INFO NOW
	PUSHJ	P,VALOUT
;;=I10= NOW GIVE THEM THE WHOLE PATH
	MOVEI	SBITS,4+SFDLVL	;4 WORDS FOR FILE:DEV,NAME,EXT,PPN
	HRL	SBITS,BSRCFN	;FILE #,,# WORDS IN NAME
	PUSHJ	P,VALOUT
	MOVE	SBITS,DEVICE
	PUSHJ	P,VALOUT
	MOVE	SBITS,NAME
	PUSHJ	P,VALOUT
	MOVE	SBITS,EXTEN
	PUSHJ	P,VALOUT
	MOVE	SBITS,PPN
;;=I10=	TAKE CARE OF PATH.
SFDS<
	JUMPE	SBITS,.+3	;IF ZERO, IT'S OK
	TLNN	SBITS,777777	;OR IF LH NON-ZERO
	MOVE	SBITS,PATHB+2	;IF PTR, HERE IS REAL PPN
	PUSHJ	P,VALOUT
	MOVSI	TEMP,-SFDLVL	;NOW PUT OUT THE SFD'S.
	HRRI	TEMP,PATHB+3	;THIS IS FIRST SFD
	MOVE	SBITS,(TEMP)	;GET THE SFD
	PUSHJ	P,VALOUT
	AOBJN	TEMP,.-2	;AND TRY AGAIN IF ANY MORE
> ;SFDS
NOSFDS<
	PUSHJ	P,VALOUT	;PUT OUT SIMPLE PPN
> ;NOSFDS
	POPJ	P,
>;BAIL

;  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:	SETZM	SRCDLY		;CLEAR THIS
	SKIPE	EOL		;ARE THERE MORE?
	POPJ	P,		;NO
	JRST	GETSR1		; YES

NOLST:
GETSRC:	MOVE6	(DEVICE,<DSK>)	;ASSUME DSK ONCE
GETSR1:	MOVSI	TEMP,DEFEXT	;AND DEFAULT EXTENSION
	MOVEM	TEMP,EXTEN
	PUSHJ	P,FILNAM	;GET A SOURCE FILE NAME
	SKIPE	NOFILE		;MUST BE ONE
	IOERR	<SAIL COMMAND ERROR>
	PUSH	P,PPN		;SAVE PPN FOR SECOND TRY

EXTSPC:	MOVEW	(SRCDEV,DEVICE)	;SET UP DEVICE
	MOVEI	SBITS2,SRCCDB
	XCT	COPN(SBITS2)
	 IOERR	 <SOURCE DEVICE NOT AVAILABLE>
	MOVE	TEMP,EXTEN
	PUSHJ	P,TRYSRC	;TRY EXTENSION USER SPECIFIED
	MOVEI	TEMP,0		; BLANK -- IF USER'S SPEC WAS BLANK
	PUSHJ	P,TRYSRC	;LAST CHANCE
				;TRYSRC DUMPS RETAD, JRSTS OKSRC ON SUCCESS
;; %CT% JFR 8-12-75 try harder
TRYLST:
;;%DR% JFR 8-17-76
	SKIPN	TEMP,SWTLNK	;SOURCEFILE SWITCHING IN PROGRESS?
	 JRST	.+4		;CANT FIND ONE. OH WELL
	 MOVSI	TEMP,(TEMP)	;RESTORE THINGS SO MYERR WILL FIND RIGHT FILE
	 HRRI	TEMP,SRCCDB
	 BLT	TEMP,SRCPPN
	ERRSPL	1,[[ASCIZ/
Source file not found: @F:@F.@F@G
(type <CR> to specify from TTY)/]
			PWORD	DEVICE
			PWORD	NAME
			PLEFT	EXTEN
			PWORD	PPN]
;;%DR% ↑
	POP	P,(P)		;SAVED PPN
	PUSH	P,TTYTYI
	SETOM	TTYTYI
;;=I11=	Bug fix - need to reset DSKSW, too
	PUSH	P,DSKSW		;SAVE OLD VALUE
	SETZM	DSKSW		;WE ARE GOING TO BE USING TTY
	PUUO	3,[ASCIZ/Source file:/]	;PROMPT
	PUSHJ	P,GETSRC	;RECURSE
	 JRST	TRYLST		;FAILED AGAIN
;;=I11=
	POP	P,DSKSW
	POP	P,TTYTYI
	JRST	KPOPJ		;SUCCESS AT LAST
;;%CT% ↑

	
;;%BZ% ! FOR DATE 75 
TRYSRC:	HLLZM	TEMP,EXTEN	;THIS IS EXTENSION TO TRY
	SETZM	WORD3		;CLEAN UP
	MOVE	TEMP,-1(P)	;SAVED PPN
	MOVEM	TEMP,PPN
	PUSHJ	P,OPNAGN	;TRY AGAIN
	  JFCL			;FILE ALREADY OPEN
	  POPJ	 P,
	POP	P,TEMP		;TOSS OUT RETURN ADDRESS
OKSRC:
	MOVEM	B,BUFADR		;ADDR OF I/O BUFFERS

;;#HU# 6-20-72 DCS BETTER TTY LISTING
	SETZM	CRIND		;DON'T CRLF/INDENT BEFORE NEXT
	SKIPE	SWTLNK		;NOW TYPE NEW FILE NAME (NO CRLF IF OUTER LEVEL)
	TERPRI
;;%CF% JFR 7-8-75
IFN 0,<
	MOVE	TEMP,LININD	;#INDENT 3*LININD SPACES
	OUTSTR	INDTAB(TEMP)
>; IFN 0
;;%CF% ↑
;;#HU#

BAIL<
	AOS	TEMP,BNSRC		;ONE MORE FILE SEEN
	MOVEM	TEMP,BSRCFN		;AND IT'S THE CURRENT ONE!
	SETZM	BSRCFC		;ADVBUF WILL SET IT TO 1
	SKIPLE	BAILON
	PUSHJ	P,BFILOU
>;BAIL
	POP	P,SRCPPN		;TOSS IT OUT
;;%CF% JFR 7-8-75
	PUSH	P,A
	MOVEI	A,[ASCIZ/@I@F.@F@G/]	;INDENT SPACES,SIXBIT FILE,.,SIXBIT EXT,PPN
	MOVEI	B,-1+[PWORD LININD+1
			PWORD SRCFIL
			PLEFT SRCEXT
			PWORD SRCPPN]
	PUSHJ	P,SPLPRT
	POP	P,A		;WASN'T THAT EASY??!!!
;;%CF% ↑
	HRRZ	B,SRCHDR		;NOW SET UP POINTERS TO INDICATE
	ADDI	B,1			; THAT A READ SHOULD BE DONE TO
	HRRM	B,SRCPNT		; SCAN
	SETZM	1(B)		;SET FIRST REAL DATA WORD ZERO
	CAIN	A,","		;MUST BE COMMA OR END OF LINE
	JRST	KPOPJ
	SKIPN	EOL	
	IOERR	<SAIL COMMAND ERROR>
KPOPJ:	AOS	(P)		;GOOD RETURN
	POPJ	P,
>;NOTENX

COMMENT ⊗ Unswt -- End of Switched-to-File
  (REQUIRE SOURCE!FILE feature) -- Get back to old one, continue via
  Seol code in SYM⊗

UNSWT:	MOVE	B,BUFADR	;ADDRESS OF I/O BUFFERS FOR SOURCE
	PUSHJ	P,CORREL	;RELEASE IT
	MOVE	B,SWTLNK	;BACK TO THIS ONE
	HRL	TEMP,B		;BLT WORD
NOTENX<
	HRRI	TEMP,SRCCDB
>;NOTENX
TENX<
	HRRI	TEMP,BGNSWA
>;TENX
	BLT	TEMP,ENDSRC
	SKIPN	SWTLNK		;NEW ONE A SWITCHED-TO TOO?
	TLZ	TBITS2,INSWT	;TURN OFF INSWT BIT
	MOVEM	TBITS2,SCNWRD
	PUSHJ	P,CORREL	;RELEASE BLOCK FOR SAVED DATA
;;#HU# 6-20-72 DCS BETTER TTY LISTING
	SETOM	CRIND		;TYPE CRLF AND INDENT ON NEXT NUMBER
;;#HU#
	SETZM	LSTCHR		;FOR SAFETY
	SETZM	SAVCHR
	AOS	(P)		;FILNAM SUCCEEDS
	SETOM	SRCDLY		;TELL EOF GUY TO BEHAVE DIFFERENTLY (SYM)
	POPJ	P,

COMMENT ⊗ Filnam⊗

DSCR FILNAM subroutine
PAR TYICORE -- if on, input is from command file 
 otherwise, it is from PNAME+1 BP
RES EOF or EOL from WORD
 NOFILE set to -1 if no filename exists, else 0
 DEVICE has specified name, else unchanged
 NAME has filename (in SIXBIT) if specified, else 0
 EXTEN has XWD EXT,0 if specified, else unchanged *****
 WORD3=0
 PPN is 0 or is set to specified user
DES Usually called by COMND routines during new file
 initialization -- also called by source file switching
 routines with TYICORE set.  In addition, FILNAM is used
 by library and Rel-file request routines to convert 
 strings to SIXBIT (also with TYICORE set)
SID returns break char in "A", uses B,C,D
⊗

NOTENX <
?FILNAM:
	SETZM	NAME		;CLEAR EOF,EOL FLAGS, FILE TABLE ENTRIES
;;%BZ% ! DATE75
	HLLZS	EXTEN		;FOR DATE75 (DOUBT IF NEED IT)
	SETZM	WORD3
	SETZM	PPN
	SETZM	EOF
	SETZM	EOL
	SETOM	NOFILE		;ASSUME "NO FILE SEEN" UNTIL CONTRADICTED
;;=I10=	ZERO THE PATH BLOCK (SO WE DON'T GIVE BAIL GARBAGE IF NO SFD'S)
SFDS<
	SETZM	PATHB		;ZERO THE PATH BLOCK
	MOVE	A,[XWD PATHB,PATHB+1]	;SINCE BFILOU ASSUMES NO GARBAGE IN IT
	BLT	A,PATHB+3+SFDLVL	;NOTE EXTRA ZERO BLOCK AT END TO TERMINATE PATH
> ;SFDS

; GET DEVICE (OR FILENAME)

	PUSHJ	P,WORD		;GET A FILE OR DEVICE NAME
TYMSHR <
TYMUSN:	JUMPN B,NONTYM
	CAIE A,"("		;OPENING CHAR FOR USER DIR SCAN
	JRST DELIM		;NO.  CONTINUE SCAN.
	MOVEI D,TYMUSR		;
	HRRZM D,PPN
	SETZM TYMUSR+1		;IN CASE NO SECOND PART
	SETZM TYMUSR
	MOVEI C,=12
	HRLI D,(<POINT 6,0>)
	SKIPG A,SAVTYI
TUNLP:	PUSHJ P,TYI
	SETZM SAVTYI
	SKIPE EOF
	JRST	[PUSHJ P,SETEOL
		JRST TUNERR]
	CAIL A,140
	SUBI A,40	;CONVERT UPPER TO LOWER
	CAIE A,")"
	CAIGE A,40
	JRST TUNEND
	SOJL C,TUNLP
	SUBI A,40
	IDPB A,D
	JRST TUNLP
TUNEND:	CAIN A,15
	PUSHJ P,FAKEOL
	CAIE A,")"
TUNERR:	IOERR <ILLEGAL USER NAME>
	PUSHJ P,WORD
NONTYM:
>;TYMSHR
	JUMPE	B,DELIM		;IF NOT THERE, CHECK PROPER DELIMITER, RETURN
	CAIE	A,":"		;A DEVICE?
	JRST	NAMSET		; NO, MUST BE NAME
	MOVEM	B,DEVICE	;FILE DEVICE
	SETZM	NOFILE		; NOW WE SAW SOMETHING

; GET FILE NAME

	PUSHJ	P,WORD
	SKIPN	B		;THERE MUST BE ONE
	JRST	[SKIPE	NOFILE	;IF DEVICE ONLY, ACCEPT IT
		 IOERR	<SAIL COMMAND ERROR>
		 JRST	DELIM]
NAMSET:	MOVEM	B,NAME		;FILE NAME
	SETZM	NOFILE		;WE SAW SOMETHING

; GET EXTENSION IF THERE IS ONE

	CAIE	A,"."
	JRST	CHKPPN		;NO, CHECK PROJ-PROG SPEC
	
	PUSHJ	P,WORD
	HLLZM	B,EXTEN		;EXTENSION

; GET PROJ-PROG NUMBER IF THERE IS ONE

CHKPPN:	CAIE	A,"["
	JRST	DELIM		;NONE, CHECK VALID ENDING SEQUENCE
CMU <	;HANDLE CMU PPNS
	SKIPG A,SAVTYI		;MAYBE GET LOOKAHEAD CHAR
	PUSHJ P,TYI		;GET 1ST PPN CHAR
	MOVEM A,SAVTYI		;READY FOR DEC PPN
	PUSHJ	P,CCVXXX	;CONVERT IT
	CAIL A,"A"		;LETTER?
	CAILE A,"Z"
	  JRST DECPPN		;NO, BETTER BE DEC PPN
	SETZM SAVTYI
	MOVEI B,-"A"(A)		;COLLECT PPN IN B
	MOVEI C,3		;SET UP FOR 3 DIGITS
CMUPP1:	PUSHJ P,CCVTYI		;GET DIGIT
	CAIL A,"0"		;MAKE SURE IT IS ONE
	CAILE A,"9"
	IOERR <ILLEGAL PPN>
	IMULI B,=10		;MAKE ROOM FOR DIGIT
	ADDI B,-"0"(A)		;PUT IT IN
	SOJG C,CMUPP1
	ADDI B,11		;MAKE MIN CMU PROJ BE 11
	HRLM B,PPN		;INSERT ACCT NO.
	PUSHJ P,CCVTYI		;GET 1ST LETTER OF MAN ON.
	CAIL A,"A"		;IS IT A LETTER?
	CAILE A,"Z"
	IOERR <ILLEGAL PPN>
	MOVEI B,-"A"(A)		;COLLECT MAN NO. IN B
	PUSHJ P,CCVTYI		;GET SECOND LETTER
	CAIL A,"A"		;IS IT FOR REAL?
	CAILE A,"Z"
	IOERR <ILLEGAL PPN>
	IMULI B,=26		;MAKE ROOM FOR LETTER
	ADDI B,-"A"(A)		;INSERT IT
	PUSHJ P,CCVTYI		;GET NUMBER
	CAIL A,"0"		;CHECK IT
	CAILE A,"9"
	IOERR <ILLEGAL PPN>
	IMULI B,=10		;MAKE ROOM
	ADDI B,-"0"(A)		;INSERT
	PUSHJ P,CCVTYI		;GET LAST CHAR
	IMULI B,=36		;MAKE ROOM
	CAIL A,"A"		;LETTER?
	CAILE A,"Z"
	JRST CMUPP2		;NO, BETTER BE DIGIT
	ADDI B,=10-"A"(A)	;LEAVE ROOM FOR DIGITS
	JRST CMUPP3		;AROUND DIGIT CODE
CMUPP2:	CAIL A,"0"		;DIGIT?
	CAILE A,"9"
	IOERR <ILLEGAL PPN>
	ADDI B,-"0"(A)
CMUPP3:	HRRM B,PPN
	PUSHJ P,WORD		;PICK UP ]
	JUMPL A,PPNFIN+1
	JRST PPNFIN
CCVTYI:	PUSHJ	P,TYI
CCVXXX:	CAIL	A,"a"	;is it lower case?
	CAILE	A,"z"	;WELL?
	POPJ	P,	;NOT LC
	TRZ	A,40	;MAKE IT UC
	POPJ	P,

DECPPN:
>;CMU
	PUSHJ	P,WORD		;PROJ
NODEC<
	SKIPE	B		;CAN'T BE 0
	CAIE	A,","		;MUST BE COMMA
	IOERR	<SAIL COMMAND ERROR>
>;NODEC
DEC<
;;=I10=	FOR SFD'S WE WANT TO FOLLOW DEC STANDARD PATH FORMAT, ALLOW ZERO
;	SKIPE	B		;CAN'T BE 0
	CAIE	A,","		;MUST BE COMMA
	IOERR	<Illegal path>
;;=I10=	SFD PATCH
EXTERNAL MYPPN
	JUMPE	B,[HLLZ B,MYPPN	;IF PROJ OMITTED, USE OURS
		   JRST PRJDON]
>;DEC
	PUSH	P,FPOPJ		;CALL IN LINE
FJUST:
IFN SIXSW,<
	SUBI	C,3
	SKIPGE	C
	MOVEI	C,0
	IMULI	C,-6
	LSH	B,(C)		;RIGHT JUSTIFY WORD IN 3 CHARACTERS
>;IFN SIXSW
IFE SIXSW,<
	MOVEI	TEMP,0
BACKL:	MOVEI	A,0
	LSHC	A,6		;CONVERT TO OCTAL PPN
	CAIL	A,'0'
	CAILE	A,'7'
	IOERR	<NON-OCTAL PPN>
	LSH	TEMP,3
	IORI	TEMP,-'0'(A)
	JUMPN	B,BACKL
	MOVS	B,TEMP
>;IFE SIXSW

FPOPJ:	POPJ	P,.+1		;ALSO CALLED BELOW

DEC<
;;=I10=	SFD
PRJDON:	HLLZM	B,PPN		;PROJ
	PUSHJ	P,WORD
;;=I10=	SFD
;	SKIPE	B
SFDS<
	MOVE	C,A		;SAVE A, THE SEPARATOR CHARACTER
	CAIN	A,","		;OK IF COMMA
	JRST	.+3		; OK
> ;SFDS
	CAIE	A,"]"		;IF 0 WORD OR NO ], ERROR
	IOERR	<Illegal path>
	JUMPE	B,[HRLZ B,MYPPN	;IF NO PROG. NO, USE OURS
		   JRST PMRDON]
	PUSHJ	P,FJUST		;RIGHT JUSTIFY
PMRDON:	HLRM	B,PPN		;PROG
SFDS<
	CAIN	C,"]"		;DONE WITH PATH?
	JRST	PPNFIN		;YES
	SETZM	PATHB		;NO - LOOK FOR SFD'S
	SETZM	PATHB+1		;INITIALIZE PATH BLOCK
	MOVE	A,PPN
	MOVEM	A,PATHB+2
	MOVEI	A,PATHB		;AND USE PTR TO BLOCK AS PPN
	MOVEM	A,PPN
	MOVEI	PNT,PATHB+3	;FIRST SFD PLACE
	MOVEI	TEMP,5		;MAX NO. OF SFD'S
SFDSC:	PUSHJ	P,WORD		;NOW GET SFD
	MOVEM	B,(PNT)		;AND USE IT
	CAIN	A,"]"		;IF BRACKET, WE'RE DONE
	JRST	SFDDON
	CAIE	A,","		;ELSE, BETTER BE COMMA
	IOERR	<Illegal path>
	MOVEI	PNT,1(PNT)	;NOW PLACE FOR NEXT SFD
	SOJG	TEMP,SFDSC	;GET NEXT IF NOT TOO MANY
	IOERR	<Illegal path>
SFDDON:	SETZM	1(PNT)		;GUARANTEE PATH ENDS IN 0 (SHOULDN'T BE NEEDED)
PPNFIN:
> ;SFDS
;;=I10= ↑↑
>;DEC
NODEC<
	HLLZM	B,PPN		;PROJ
	PUSHJ	P,WORD
	SKIPE	B
	CAIE	A,"]"		;IF 0 WORD OR NO ], ERROR
	IOERR	<SAIL COMMAND ERROR>
	PUSHJ	P,FJUST		;RIGHT JUSTIFY
	HLRM	B,PPN		;PROG
>;NODEC
CMU <
PPNFIN:
>;CMU
	PUSHJ	P,WORD		;TOSS OUT ]
	SKIPE	B		;MUST BE NO WORD THIS TIME
	IOERR	<SAIL COMMAND ERROR>

COMMENT ⊗ Delim -- Handle Switches⊗

DELIM:	
	CAIE	A,"/"		;IGNORE ANY SWITCH ASSIGNMENTS
	JRST	DELIM2
	MOVEI	PNT,DELIM	;RETURN ADDRESS
>;NOTENX

↑↑SWTGET:TLZ	FF,FFTEMP	;KEEP TRACK OF SIGN
	SETZB	C,D		;COLLECT ANY NUMBERS
SWGMOR:	PUSHJ	P,TYI		;GET SWITCH INFO
SWGPAR:	CAIL	A,"0"		;DIGIT?
	CAILE	A,"9"		
	 JRST	 SWTDSP		; NO

	IMULI	C,=10
	ASH	D,3
	ADDI	C,-"0"(A)	;YES, COLLECT NUMBER
	IORI	D,-"0"(A)	;COLLECT OCTAL NUMBER TOO.
	JRST	SWGMOR		;AND KEEP GOING

SWTDSP:	CAIE	A,"-"		;NEGATE THE COUNTS GOING
	JRST	SWDGO
	TLO	FF,FFTEMP		;NOW WILL BE MINUS!
	JRST	SWGMOR		;AND KEEP GOING
SWDGO:	SUBI	A,"A"		;ALL SWITCHES ARE LETTERS
	JUMPL	A,INVSW		;INVALID SWITCH
	CAILE	A,"Z"-"A"	;CONVERT LOWER CASE
	SUBI	A,40		;
	CAILE	A,"Z"-"A"	;NOW MUST BE IN RANGE
	 JRST	 INVSW		; INVALID SWITCH

	TLNE	FF,FFTEMP		;NEG?
	 MOVNS	 D		; YES, IF OCTAL
	IDIVI	A,7		;MAKE INDEX IN A, DISPLACEMENT IN B
	IMULI	B,-5		;MAKE A BYTE POINTER
	ADDI	B,37
	MOVE	TEMP,[POINT 5,SWTTBL(A)]
	DPB	B,[POINT 6,TEMP,5] ;P FIELD
	LDB	A,TEMP		;GET DISPATCH
	
	PUSHJ	P,@SWDSP(A)	;CALL SWITCH ROUTINE
	PUSHJ	P,TYI		;GET NEXT CHAR
	JRST	(PNT)		;LOOK FOR MORE SWITCHES

NOTENX<
;;%DN% JFR 7-1-76 /A
SWTTBL:	BYTE (5)20,14,10,7,0,11,0	;A-B-C-D-e-F-g
	BYTE (5)13,0,0,12,2,1,0	;H-i-j-K-L-M-n
	BYTE (5)0,3,4,5,6,0,0	;o-P-Q-R-S-t-u
	BYTE	(5)15,16,17,0,0,0,0	;V-W-X-y-z-0-0
>;NOTENX

TENX<
SWTTBL:	BYTE (5)24,20,10,7,0,11,17 ;A-B-C-D-e-F-G
	BYTE (5)13,14,0,12,2,1,0 ;H-I-j-K-L-M-n
	BYTE (5)0,3,4,5,6,15,16	;o-P-Q-R-S-T-U
	BYTE	(5)21,22,23,0,0,0,0	;V-W-X-y-z-0-0
>;TENX


DEFINE SWITCH(NUM,DESC) <
	II←←.
	USE	SWTS
	II			;DISPATCH TO THIS ROUTINE
	USE
>

↑SWDSP:	BLOCK	=21		;ENOUGH + SOME MORE
	SET	SWTS,SWDSP	;PREPARE VECTOR PC

SWITCH (0 , INVALID)

	SUB	P,X11		;REMOVE RETURN
INVSW:	ERR	<INVALID SWITCH IN COMMAND LINE>,1
	PUSHJ	P,TYI		;GO BACK WHERE YOU CAME FROM
	JRST	(PNT)

SWITCH (1 , #M -- debugging mode setting)

; DCS ADDED LABEL, 9-21-71
↑↑STMD:	POP	P,B		;RETURN ADDRESS
IFN FTDEBUG,<
	SETZM	MULTP		;FOR MODE 5.
	SETZM	PLINSW
	CAIE	C,4
	SETZM	.DBG.		;TO GET ALL THE SWITCHES INITIALIZED.

;;#GH# DCS 2-1-72 (2-5) REDEFINE 6M -- SCANNER BREAK
	HRLOI	TEMP,400000	;XWD 400000,,-1 FOR SCAN BREAK
	CAIG	C,6		;MUST BE LESS 6 FOR VALID MODE
	XCT	DBMD(C)		;SUB-DISPATCH
	
TABCONDATA (DEBUGGING MODE SETTERS)
DBMD:	JFCL			; 0 -- NO EFFECT
	 HLLOS	.DBG.		; 1 -- EXEC ROUTINES ONLY 	[0,,-1]
	 SETZM	.DBG.		; 2 -- DON'T DEBUG		[0,,0]
	 SETOM	.DBG.		; 3 -- EXECS AND PRODUCTIONS	[-1,,-1]
	 SETOM	MULTP		; 4 -- DON'T STOP WHILE DEBUGGING
	 SETOM	PLINSW		; 5 -- JUST PRINT LINES
	 MOVEM	TEMP,.DBG.	; 6 -- BREAK AFTER EACH SCAN	[400000,,-1]
				; <ESC>I IS [400000,,377777] or .DBG.
;;#GH# (2-5)
	ENDDATA

	JRST	(B)		;RETURN FROM DEBUG SWITCH ROUTINE
>
IFE FTDEBUG ,<JRST INVSW>



SWITCH (2 , #L -- listing control)

	CAMN	D,[-1]
	MOVEI	D,5234		;LENGTH OF DDT THESE DAYS.
				;INCLUDES SAIL LOWER SEGMENT.
	CAMN	D,[-2]
	JRST	[MOVEI D,12237	;GOOD GUESS FOR LENGTH OF RAID TODAY
				; THIS FIGURE IS WITH SAIL LOW SEGMENT.
		 SKIPE JOBDDT	; HERE IS A BETTER NUMBER
		  MOVEI	D,LPSERR-1 ;END OF DDT.
		 JRST   OUTLIT]
OUTLIT:	MOVEM	D,LSTSTRT		;SET IT UP
	POPJ	P,



;;%DD% JFR 10-24-75	IF C=0, THEN DOUBLE, ELSE SET VALUE TO RH(C)

SWITCH (3 , P -- double P-stack)

	JUMPN	C,.+3
	 HRRZ	C,PDLMAX
	 LSH	C,1		;DOUBLE IT
	HRRM	C,PDLMAX
	POPJ	P, 


SWITCH (4 , Q -- double SP-stack)

	JUMPN	C,.+3
	 HRRZ	C,SPMAX
	 LSH	C,1
	HRRM	C,SPMAX
	POPJ	P, 


SWITCH ( 5 , R -- double parse and semantic stacks)

	JUMPN	C,.+3
	 HRRZ	C,PPMAX
	 LSH	C,1
	HRRM	C,PPMAX
	HRRM	C,GPMAX
	HRRM	C,PCMAX ;ALSO MAIN PARSE CONTROL
	HRRM	C,SCWMAX
	POPJ	P,  


SWITCH (6 , #S -- set string space size)

       HRRM	C,STMAXX	;CHANGE STRING SPACE
	POPJ	P,  


SWITCH (7 , D -- double define stack)

	JUMPN	C,.+3
	 HRRZ	C,DFMAX
	 LSH	C,1
	HRRM	C,DFMAX
	POPJ	P, 

SWITCH (10 , C -- turn on CREF listing if listing)

	MOVSI	TEMP,CREFIT
	 IORM	TEMP,SCNWRD
	TLO	FF,CREFSW
	 POPJ	P,



SWITCH (11 , F -- set listing format bits in SCNWRD)

;;%DF% ! RHT 10-25-75
	MOVEM	D,FMTWRD
;;%DB% JFR 9-21-75
	MOVE	TEMP,[XWD 760000,1]
	ANDCAM	TEMP,SCNWRD	;TURN OFF ALL USER-CONTROLLED BITS
	ANDI	D,77		;ONLY LOW SIX BITS MATTER
	ROT	D,-5		;SUBSTITUTE USER OPTIONS
;;%DB% ↑
	IORM	D,SCNWRD	;MARK OPTIONS
	POPJ	P,


SWITCH (12 , K -- insert counters into loops)

	TLNN	FF,LISTNG	;MAKE SURE WE'RE LISTING
	POPJ	P,		;INSERT COUNTERS ONLY WHEN LISTING
	MOVSI	TEMP,CREFIT	;GET CREF BIT
	TDNE	TEMP,SCNWRD	;ARE WE CREFFING
	ERR	(<COUNTERS AND CREF ARE PRESENTLY INCOMPATIBLE>)
	MOVEI	TEMP,MACEXP	;SPECIFY DESIRED FORMAT FOR
	HRLM	TEMP,SCNWRD	;LISTING FILE
;;%DH% 2! JFR 11-22-75
	LSH	TEMP,-=13
	MOVEM	TEMP,FMTWRD
	SETOM	KOUNT		;TURN ON THE COUNTING SWITCH
	POPJ	P,		;RETURN

SWITCH (13, H -- Generate Two-Segment Code)

	SETOM	HISW		;THIS TRIGGERS IT
	POPJ	P,

NOTENX<
BAIL<
SWITCH (14, B -- Debugger option.)
		; LEQ 0	BAIL OFF
		; BITS
		;  1	COORDS--0 MEANS NO, 1 MEANS YES
		;  2	SYMS--0 MEANS JUST PROCS,PARAMS,INTERNALS; 1 MEANS ALL
		;  4	PD FOR SIMPLE PROC--0 MEANS NO, 1 MEANS YES
	

	MOVEM	D,BAILON
	POPJ	P,
>;BAIL
SWITCH	(15, V -- OVERLAY CODE, FORCE LINKS TO LOW SEG)
	SETOM	OVRSAI
	POPJ	P,

SWITCH 	(16, W -- "WHERE" GENERATE OPTIONAL LOADER SYMBOLS)
	SETOM	WHERSW
	POPJ	P,

SWITCH	(17, X -- "XTEND" COMPILER SAVE/RESTART FACILITY)
	HLLOS	XTFLAG
	POPJ	P,

SWITCH	(20, A -- COMPILED CODE OPTIONS)
	MOVEM	D,ASWITCH
	POPJ	P,
>;NOTENX

TENX<
SWITCH (14, I -- Do not generate Two-Segment Code)

	SETZM	HISW
	POPJ	P,

SWITCH (15, T -- Load with DDT)
	SETOM	LODMOD
	SETOM	LODDDT
	POPJ	P,

SWITCH (16, U -- Load with SDDT)
	SETOM	LODMOD
	SETOM	LODDDT
	SETOM	LODSDT
	POPJ	P,

SWITCH (17,G -- Load after compilation)
	SETOM	LODMOD
	POPJ	P,

BAIL<
SWITCH (20, B -- Debugger options.)
		; LEQ 0 BAIL OFF
		; BITS
		;  1	COORDS--0 MEANS NO, 1 MEANS YES
		;  2	SYMS--0 MEANS JUST PROCS,PARAMS,INTERNALS; 1 MEANS ALL
		;  4	PD FOR SIMPLE PROC--0 MEANS NO, 1 MEANS YES

	MOVEM	D,BAILON
	POPJ	P,
>;BAIL
SWITCH	(21, V -- OVERLAY CODE, FORCE LINKS TO LOW SEG)
	SETOM	OVRSAI
	POPJ	P,

SWITCH	(22, W -- "WHERE" GENERATE OPTIONAL LOADER SYMBOLS)
	SETOM	WHERSW
	POPJ	P,

SWITCH	(23, X -- "XTEND" COMPILER SAVE/RESTART FACILITY)
	HLLOS	XTFLAG
	POPJ	P,

SWITCH	(24, A -- COMPILED CODE OPTIONS)
	MOVEM	D,ASWITCH
	POPJ	P,
>;TENX


; END OF SWITCH HANDLERS

NOTENX <
;Above switch goes to end of file.

DELIM2:	CAIE	A,"("
	JRST	DELIM4
	PUSHJ	P,TYI		;GET NEXT CHAR
DELIM3:	TLZ	FF,FFTEMP	;KEEP TRACK OF SIGN OF ANY NUMBERS
	SETZB	C,D
	JSP	PNT,SWGPAR	;GO LOOK AT SWITCHES
	CAIE	A,")"
	JRST	DELIM3
	PUSHJ	P,TYI
DELIM4:	CAIN	A,15		;IF CR, CALL ROUTINE TO
	PUSHJ	P,FAKEOL	;  SET EOL SWITCH (PERHAPS EOF)
	SKIPE	EOF		;SET EOL IF EOF
	SETOM	EOL

DELIM1:
	CAIN	A,","		;FILE NAME MUST BE FOLLOWED
	POPJ	P,		; BY , OR ← OR
;;=I05=
	CAIE	A,"="
	CAIN	A,"←"		; @ OR ! OR EOL
	POPJ	P,
	CAIN	A,"@"
	POPJ	P,
	CAIN	A,"!"
	POPJ	P,
	SKIPE	EOL
	POPJ	P,
	IOERR	<SAIL COMMAND ERROR>


COMMENT ⊗ Word
 Fetches one name, ext, etc. from Command File.
 Leaves character which broke scan in "A", -1 if EOL.
  Sets EOL if CRLF or end of file, EOF and EOL for end of file.
  Returns word (sixbit) left-justified in "B", zero if none.
 ACS:	Results in A,B; uses also C,D ⊗

WORD:
	TLZ	FF,FFTEMP	;INDICATE NO GOOD CHARS SEEN.
	MOVEI	B,0
	MOVEI	C,6		;INITIALIZE
	MOVE	D,[POINT 6,B]
	SKIPG	A,SAVTYI	;GET LOOKAHEAD CHAR IF ANY
	
WLUP:	PUSHJ	P,TYI		;GET A CHARACTER
	SETZM	SAVTYI
	SKIPE	EOF		;ON EOF, SET EOL
	JRST	SETEOL

LORD:	CAIL	A,"a"
	CAILE	A,"z"		;IF LOWER, CONVERT TO UPPER
	JRST	LUPORD		;CHECK A-Z, 0-9 IF NOT
	SUBI	A,"a"-"A"	;CONVERT TO UPPER CASE
LUPORD:	CAIL	A,"A"
	CAILE	A,"Z"		;CHECK LETTER
	JRST	[CAIL	A,"0"
		CAILE	A,"9"	; NO, CHECK DIGIT
		 JRST	ENDWRD	; NOT LETTER OR DIGIT
		 JRST	.+1]	;A DIGIT
	TLO	FF,FFTEMP	;A GOOD CHAR SEEN.

STILIN:	SUBI	A,40		;CONVERT TO SIXBIT
	SKIPN	C		; COUNT EXHAUSTED?
	JRST	WLUP		; YES, CONTINUE UNTIL END OF WORD
	IDPB	A,D		; COLLECT WORD
	SOJA	C,WLUP		; CONTINUE

ENDWRD:	CAIN	A," "		;A SPACE OF SOME VARIETY?
	JRST	[TLNN	FF,FFTEMP	;HAVE WE SEEN ANYTHING?
		JRST	WLUP		;NOT YET.
		JRST	.+1]
	CAIE	A,15		; CARRIAGE RETURN?
	POPJ	P,		; NO
FAKEOL:	PUSHJ	P,TYI		;GET LINE FEED
	SKIPN	DSKSW		;IF IN DISK MODE, MAKE SURE
	 JRST	 SETEOL		;THERE'S NO GARBAGE LEFT
FNDEOF:	PUSHJ	P,TYI
	JUMPL	A,SETEOL	;END OF FILE RIGHT AWAY
	CAIG	A,40		;IGNORE TABS, BLANKS, AND THE LIKE
	 JRST	 FNDEOF
	MOVEM	A,SAVTYI	;LOOKAHEAD CHAR -- WILL BE PICKED UP NEXT
SETEOL:	SETOB	A,EOL		;MARK END OF LINE
	SKIPN	DSKSW		;IF IN TTY MODE, RELEASE DEVICE
	RELEASE	CMND,0		;RELEASE COMMAND FILE SO THAT TTY
	POPJ	P,		;CAN BE USED FOR INPUT

; Tyi
;   Get one character, set EOF on EOF, ignore zeros

TYI:	SKIPE	TTYTYI		;IF GETTING INPUT FROM TERINAL,
	 JRST	 TTYDO		;DO SO!
	SKIPE	TYICORE		;FROM COMMAND FILE?
	 JRST	 TYCOR		; NO, FROM A STRING IN PNAME, PNAME+1
	SOSLE	CMDCNT
	JRST	TYIK
IFN TMPCSW,<
	SKIPGE	CMDMOD		;IF USING TEMP CORE
	JRST	TYDUN		;ALL DONE.
>;IFN TMPCSW
	INPUT	CMND,0
	TSTERR	CMND
	IOERR	<INPUT ERROR ON COMMAND DEVICE>
	TSTEOF	CMND,<[TYDUN: SETOB	A,EOF
		 POPJ	P,]>
TYIK:	IBP	CMDPNT
	MOVEI	A,1
	TDNE	A,@CMDPNT
	JRST	LINENO
	LDB	A,CMDPNT
	JUMPE	A,TYI
	POPJ	P,

LINENO:	AOS	CMDPNT
	MOVNI	A,5
	ADDM	A,CMDCNT
	JRST	TYI

TTYDO:	SKIPL	TTYTYI		;IF NOT BEGINNING,
	 INCHRS	 A		;JUST READ A CHAR AND SKIP
	INCHWL	A		;OTHERWISE WAIT TILL HE BEGINS.
	HRRZS	TTYTYI		;CHANGE FLAG TO NOT FIRST TIME.
	POPJ	P,

TYCOR:	SOS	A,PNAME			;TEST ALL DONE
	TRNE	A,400000		;ALL DONE?
	 JRST	 [SETOB	A,EOL		;MARK DONE
		  SETZM TYICORE		;FOR SOURCE FILE SWITCHING 
					;DCS 8/21/70
		  SETZM	PNAME		;DCS 5/2/71
		  POPJ	P,]
	ILDB	A,PNAME+1		;GET NEXT CHARACTER
	POPJ	P,


NOEXPO <
INTERNAL SAVDMP
↑SAVDMP: MOVEM	TEMP,TEMPSV
	HRRZ	TEMP,JOBSA
	HRRZM	TEMP,SWPTBL+3
	CALLI	TEMP,400062		;GETNAM
	MOVEM	TEMP,SWPTBL+1
	CALLI				;RESET JOBFF
	HRRZ	TEMP,JOBFF
	CALL6	(TEMP,CORE)		;CUT CORE IMAGE TO MINIMUM
	ERR	<CORE ERROR DURING SAVDMP OPERATION>
	MOVSI	TEMP,SWPTBL
	CALL6	(TEMP,SWAP)
	JRST	@JOBDDT
SWPTBL:	SIXBIT	/DSK/
	SIXBIT	/SAIL/
	SIXBIT	/DMP/
	0
	0

INTERNAL RAIDST
↑RAIDST: MOVEM TEMP,TEMPSV
	SKIPN	TEMP,JOBDDT		;JOBDDT BETTER BE THERE
	ERR	<DRYROT -- RAIDST>	;
	MOVEM	LPSA,LPSASV		;NEED TWO AC'S
	MOVE	LPSA,[POINT 7,RAICDS]	;
	MOVE	TEMP,-3(TEMP)		;
	MOVEM	LPSA,-1(TEMP)
RAITL:	ILDB	TEMP,LPSA		;PICK UP CHAR
	CAIN	TEMP,33		;IS IT PSEUDO ALT
	MOVEI	TEMP,175		;YES
	DPB	TEMP,LPSA
	JUMPN	TEMP,RAITL		;LOOP
	MOVE	LPSA,LPSASV
	MOVE	TEMP,TEMPSV
	JRST	@JOBDDT

TEMPSV:	0
LPSASV:	0

RAICDS:ASCIZ /SAIL≠:A≠;B≠;C≠;D≠;LPSA≠;TEMP≠;SBITS≠;SBITS2≠;PNT≠;PNT2≠;24≠I/


>;NOEXPO
SUBTTL	Production Interpreter

>;NOTENX
;Closes back to DELIM2.