perm filename SAIL[S,AIL]10 blob sn#058523 filedate 1973-08-17 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00039 PAGES VERSION 17-1(3)
RECORD PAGE   DESCRIPTION
 00001 00001
 00005 00002	HISTORY
 00010 00003	
 00011 00004	Command File Descriptions
 00013 00005	Titles, Switch Settings
 00015 00006	Sail ACs, File Indices
 00017 00007	Sail Bits
 00024 00008	Externals, Data Allocation
 00026 00009	ZERODATA (MAIN-SEMANTICS POINTERS)
 00035 00010	II.  SEMANTICS VARIABLES
 00046 00011	ZERODATA(DISPLAY REGISTER HANDLING VARIABLES)
 00048 00012	ZERODATA (MAIN-SCANNER VARIABLES)
 00052 00013	ZERODATA (MAIN-PARSER VARIABLES)
 00062 00014	ZERODATA (MAIN-SOURCE AND LISTING FILE VARIABLES)
 00066 00015	DATA (SWITCHED VARIABLES)
 00074 00016	ZERODATA (GLOBAL STATE VARIABLES)
 00077 00017	ZERODATA (COUNTER SYSTEM VARIABLES)
 00079 00018	DATA (RANDOM GLOBAL THINGS)
 00081 00019	 SLS VARIABLES
 00082 00020	DATA (INITIAL PROC DESC SEMBLKS)
 00083 00021	Executive and Initialization
 00085 00022	Start, Ddtkil -- Once-only code to zap RAID, symbols
 00088 00023	 Larger, Sail --  Execution Starts Here
 00090 00024	
 00093 00025	 Morfiles -- Execution Returns Here Each New Command Line
 00100 00026	
 00101 00027	 Salnit -- Storage Initialization, Etc.
 00108 00028	
 00109 00029	Comnd, aux. routs -- Command Scanner
 00113 00030	 Opnup -- Open Files
 00115 00031	 Comnd Itself
 00123 00032	 Unswt -- End of Switched-to-File
 00125 00033	 Filnam
 00129 00034	 Delim -- Handle Switches
 00132 00035	
 00135 00036	
 00138 00037	
 00139 00038	 Word
 00142 00039	 Tyi
 00145 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,FAIL,REASON
031  102100000003  ⊗;
DEFINE .VERSION <102100000003>

COMMENT ⊗
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∨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
	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
NOEXPO <
↓LOADVR ←← =52			;WE USE LOADER 52
>;NOEXPO
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"
EXPO <
STSW	(TMPCSW,1)
>;EXPO
NOEXPO <
STSW	(TMPCSW,0)		;NO TMPCOR UUO
>;NOEXPO

; **			**

ENDDATA

↓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	;→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

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

;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

;INTERRUPT BITS
↓INTPOV←←200000	;RH BIT -- PDL OV
NOEXPO <
↓INTTTI←←4	;LH BIT -- USER TYPED <ESC> I
>;NOEXPO
;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,ERRSPC,GOGTAB,RPGSW,CAT,PUTCH,POW,FPOW,%RENSW
EXTERNAL	ALLPDP,UUO0,%ALLOC,.SEG2.,CORGET,CORREL,CANINC,CAT,CVS
EXTERNAL	SAVE,RESTR,STRGC,DPYSW,CORINC,JOBAPR,JOBCNI,JOBTPC
EXTERNAL	%ARRSRT,SGREM ;FOR REMOVING %ARRSRT FROM LIST

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←←=625			↓DSIZE←←=920
IFN FTDEBUG, <
  ↓ZSIZE←←ZSIZE+=32		↓DSIZE←←DSIZE+=30
>
 ↓ZSIZE←←ZSIZE+=45		↓DSIZE←←DSIZE+=10



↓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
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 -- → 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		;→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)

↓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
↓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
↓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

DEFSIZ:	XWD	STDSPC!SYSPD,=64	;P-STACK
	XWD	STDSPC!SYSSPD,=16	;SP-STACK
	XWD	STDSPC!STRSP,=3500	;STRING SPACE
	XWD	WNTPDL,=64		;PARSE STACK
	XWD	[ASCIZ/SYNTAX STACK/],PPSAV 
	XWD	WNTPDL,=64		;SEMANTICS STACK
	XWD	[ASCIZ/SEMANTICS STACK/],GPSAV
	XWD	WNTPDL,=64		;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,=40	;DEFINE STACK
	XWD	[ASCIZ/DEFINE STACK/],DFSTRT
	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
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←←=13		; 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/] 

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
	
;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.

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,→2D WORD FIRST BUFFER
	PUSH	P,B			;SAVE →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)			;→2D WORD NEXT BUFFER
	MOVEM	C,(B)			;2D WORD THIS BUFFER
	HRRZI	B,(C)			;→NEXT BUFFER
	SOJG	TEMP,UINBL		;DO ALL OF THEM
	POP	P,TEMP			;→2D WORD OF FIRST
	HLRZS	C
	SUB	B,C
	HRRM	TEMP,-2(B)		;LAST →FIRST
	HRRZI	B,-1(TEMP)		;→1ST WORD OF BUFFERS
	POPJ	P,			;DONE
>;EXPO
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).
⊗
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).
  SRCPPN is a saved version of the proj/prog spec. in sixbit for the source
   file -- used by the edit feature in the error UUO, to re-edit file (PPN
   should be saved in CDB, but it ain't.
⊗

↓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
↓PPN:	0		;SPECIFIED PPN, OR 0 FOR USER DEFAULT
	0		;FOR SWAP UUO?
↑SRCPPN: 0		;PPN IN SIXBIT, SAVED FROM SOURCE FILE SPEC

; 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 α channel 0, bit 1 α 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.
⊗
↓AVLSRC: XWD 17774,0	;CHANNELS 5 AND ABOVE AVAILABLE (INITIALLY)

;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 → 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

; 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#2↓ 6-20-72 DCS BETTER TTY LISTING
↑LININD: 0		;#LEVELS TO INDENT TTY LISTING
↑↑MAXIND←←4

ENDSRC←←.-1		;END OF CLEARED AREA -- END OF SWITCHED AREA
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&"α") is inserted
  into the listing file.  For counters in conditional and case
  expressions, a different marker ('177&"β") 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

↑↑INDTAB:0		;INDENTING SPACES
	ASCIZ	/   /	;LEVEL 1
	ASCIZ	/      /;LEVEL 2
	ASCIZ	/         /; L 3
	ASCIZ	/            /;4
	0		;SAFETY
; 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
NOEXPO <
IFE FTDEBUG,<
III←←1
↑↑START:
	SETOM	136
	MOVEI	TEMP,DDTKIL
	HRRM	TEMP,JOBSA
	TERPRI	<SAVE ME!>
	CALL6	(1,EXIT)

DDTKIL:	TDZA	A,A		;KEEP TRACK OF RPG MODE
	MOVEI	A,1
	MOVE	B,JOBSA		;RESET STARTING ADDRESS (AGAIN)
	SKIPL	136		;MUST WE DO ALL THIS?
	 JRST	 NOKIL		;NO, JUST GO
	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
	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]
	JRST	SAIL(A)		;TAKE ACCOUNT OF RPG MODE
>;IFE FTDEBUG
>;NOEXPO
;;#IH# (1-2)
COMMENT ⊗ Larger, Sail --  Execution Starts Here⊗

↑LARGER: SETOM	%RENSW		;%ALLOC WILL ASK QUESTIONS
IFE III,<↑↑START:>
↑SAIL:	SKIPA
	JRST	[SETOM DSKSW
		 SETOM RPGSW
		 MOVE6	(CMDDEV,<DSK>)	;RPG MODE -- GET COMMANDS
EXPO <
		 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
>;EXPO
NOEXPO <
		 MOVEW (NAME,<[RPGFIL]>);FROM QQSAIL.RPG ON 1,3
		 MOVE6 (EXTEN,<RPG>)  ;AND SET APPROPRIATE SWITCHES
>;NOEXPO
		 JRST  BEG1]

	SETZM	DSKSW		;INPUT FROM TTY -- CLEAR FLAGS
	SETZM	RPGSW		;AND INDICATE SOURCE OF INPUT
	MOVE6	(CMDDEV,<TTY>)
BEG1:	MOVNI	A,1		;TYPE FOR COMPILER.
	MOVEM	A,CONFIG	;CONFIGURATION.
	MOVEI	A,MYERR		;AND SPECIAL ERROR ROUTINE.
	MOVEM	A,ERRSPC	;ANOTHEREXTERNAL.
	SETZM	GOGTAB
	JSP	P,.SEG2.	;GET A SECOND SEGMENT.

	SETNIT			;GET A UUO ADDR, AND A TEMP PUSH-DOWN STACK

	CALLI			;RESET THE WORLD
	SETZM	LSTSTRT		;ZERO LSTSTRT ON FIRST TIME AND NON-RPG RESTARTS

; PRINT CRLF *  

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

; GET ENOUGH OF COMMAND LINE TO BEGIN PROCESSING

	SETZM	HISW		;ASSUME NO TWO-SEGMENT COMPILATION
	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
IFN TMPCSW,<			;IF TMPCOR FEATURE AVAILABLE
	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 ⊃ 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>
	JRST	SAIL		;OTHERWISE ENTER NORMAL TTY MODE

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:
	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
	MOVEI	TEMP,MACLST+PCOUT+LINESO ;ASSUME THIS ABOUT LISTING
	MOVSM	TEMP,SCNWRD
;RESET SRCCDB IN CASE RESTART CLOBBERED IT IN SWITCH MODE
	MOVE	TEMP,[XWD 17774,0]	;CH5 AND ABOVE AVAILABLE
	MOVEM	TEMP,AVLSRC
	SETZM	SWTLNK			;NO LINKS BACK
	SETZM	SRCDLY
	SETZM	BUFADR
	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

	PUSHJ	P,COMND		;CALL COMMAND SCANNER
	ERR	<FATAL END OF SOURCE FILE>
	PUSHJ	P,SALNIT	;INITIALIZE RUNTIM, SAIL
	PUSHJ	P,MAKT	;PREPARE TITLE LINE
	PUSHJ	P,HDR		;INIT PAGE NOS., PRINT HEADING IF LISTING


	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

	JRST	PARSE		;THIS HERE IS THE COMPILER!

; ...
RELSE:	MOVE	TEMP,PCNT	;UPDATE LISTING OFFSET
	ADDM	TEMP,LSTSTRT
RELAL:	RELEASE	LST,0
	RELEASE	BIN,0
	RELEASE	SRC,0
	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:	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:
NOEXPO <
	PUSHJ	P,DSPCLR	; CLEAR THE DISPLAY IF RUNNING.
>;NOEXPO
	CALL6	(EXIT)		;STAGE LEFT.

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

; 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)

;;#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 <
IFN FTDEBUG,<MOVE TEMP,[XWD INTTTI,INTPOV];>MOVEI TEMP,INTPOV
	CALL6	(TEMP,INTNB)	;ENABLE FOR GOOD KIND OF INTERRUPT
>;NOEXPO
;;#GH#

	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)
	SETZM	$ADR(LPSA)
	SETZM	$ACNO(LPSA)
INITPD:	MOVEI	TEMP,IPDSBK
	MOVEM	TEMP,$VAL(LPSA)
	SETZM	$PNAME(TEMP)
	SETZM	$PNAME+1(TEMP)
	SETZM	$ACNO(TEMP)
	SETZM	$VAL(TEMP)
	SETZM	$VAL2(TEMP)
	SETZM	$ADR(TEMP)
	HLRZ	TEMP,%TLINK(TEMP)
	HRRZI	A,5			;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
	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


SUBTTL	COMMAND SCANNER DATA (CDB's)
SUBTTL	Comnd, aux. routs -- Command Scanner

BITDATA (INDICES INTO CDBS)
CMOD←←0
CFIL←←6
CEXT←←7
COPN←←10
CENT←←11
CSPC←←12
CBFS←←13
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)

; 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

↑TYICORE: 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) 

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

	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.
	ADD	C,B			;END ADDR +1
	MOVE	TEMP,B
	HRLS	TEMP			;ADDR,ADDR
	ADDI	TEMP,1			;LOOKS LIKE A ZEROING BLT WORD!
	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 <
	SETZM	WORD3
	SETZM	PPN
	MOVSI	TEMP,1		;STARTING INCREMENT
	HRRI	TEMP,DEVICE	;TABLE ADDRESS
	CALL	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

	MOVEI	SBITS2,BINCDB
	PUSHJ	P,OPNUP		;OPEN BINARY FILE
	  IOERR	<BINARY DEVICE NOT AVAILABLE>
	  IOERR	<NO ROOM ON BINARY DEVICE>
	SETZM	WORD3
	  TLO	FF,BINARY	;DENOTE BINARY FILE EXISTS
	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 "←"
	CAIN	A,"←"		;MUST BE ANYWAY
	JRST	GETLST		; IS

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

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
	JRST	GETSRC		; NOW GET SOURCE FILE (ONE ONLY AT FIRST)

;  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:	SETZM	EXTEN		;MAKE NO ASSUMPTIONS YET
	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>
;; #LT# FOLLOWING LOADED FROM SRCFIL, SRCFIL DOESN'T GET VALUE UNTIL
;; 	OPNAGN CALLED
	MOVE	LPSA,NAME	;FOR POSSIBLE ERROR PRINTOUT
	SKIPN	TEMP,EXTEN	;IF USER DIDN'T SPECIFY EXTEN,
	 JRST	 TRYALL		; TRY MANY
TRYLST:	PUSHJ	P,TRYSRC	;JUST THIS ONE
	 IOERR	 <SOURCE FILE NOT FOUND -- >,15 ;GIVE UP -- NOT FOUND
				;TRYSRC DUMPS RETAD, JRSTS OKSRC ON SUCCESS
TRYALL:	MOVSI	TEMP,DEFEXT	;TRY DEFAULT EXTENSION NAME,
	PUSHJ	P,TRYSRC
	MOVSI	TEMP,'SAI'	; .SAI,
	PUSHJ	P,TRYSRC
	MOVEI	TEMP,0		; BLANK -- IF USER'S SPEC WAS BLANK
	JRST	TRYLST		; LAST CHANCE

	
TRYSRC:	MOVEM	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
	MOVE	TEMP,LININD	;#INDENT 3*LININD SPACES
	OUTSTR	INDTAB(TEMP)
	SIXPNT	SRCFIL		;PRINT FILE NAME
;;#HU#

	POP	P,SRCPPN		;TOSS IT OUT
	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,
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
	HRRI	TEMP,SRCCDB
	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
⊗

↓FILNAM:
	SETZM	NAME		;CLEAR EOF,EOL FLAGS, FILE TABLE ENTRIES
	SETZM	WORD3
	SETZM	PPN
	SETZM	EOF
	SETZM	EOL
	SETOM	NOFILE		;ASSUME "NO FILE SEEN" UNTIL CONTRADICTED

; GET DEVICE (OR FILENAME)

	PUSHJ	P,WORD		;GET A FILE OR DEVICE NAME
	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
	SKIPN	B
	IOERR	<SAIL COMMAND ERROR>
	HLLZM	B,EXTEN		;EXTENSION

; GET PROJ-PROG NUMBER IF THERE IS ONE

CHKPPN:	CAIE	A,"["
	JRST	DELIM		;NONE, CHECK VALID ENDING SEQUENCE
	PUSHJ	P,WORD		;PROJ
	SKIPE	B		;CAN'T BE 0
	CAIE	A,","		;MUST BE COMMA
	IOERR	<SAIL COMMAND ERROR>
	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

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

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

SWTTBL:	BYTE (5)0,0,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
	0			;v THRU z

DEFINE SWITCH(NUM,DESC) <
	II←←.
	USE	SWTS
	II			;DISPATCH TO THIS ROUTINE
	USE
>


↑SWDSP:	BLOCK	=15		;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]∨.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,

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

       HRRZ	C,PDLMAX		;CHANGE P STACK
	ADDM	C,PDLMAX		; (DOUBLE IT)
	POPJ	P, 


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

       HRRZ	C,SPMAX		;CHANGE SP STACK
	ADDM	C,SPMAX
	POPJ	P, 


SWITCH ( 5 ,double parse and semantic stacks)

       HRRZ	C,PPMAX	;CHANGE PARSE AND SEMANTIC
	ADDM	C,PPMAX
	ADDM	C,GPMAX
	ADDM	C,PCMAX ;ALSO MAIN PARSE CONTROL
	ADDM	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)

       HRRZ	C,DFMAX		;CHANGE DEFINE STACK
	ADDM	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)

	MOVSI	TEMP,-1≠CREFIT
	 ANDCAM	TEMP,SCNWRD	;TURN OFF ALL BUT CREFIT
	 LSH	D,=31		;SUBSTITUTE USER OPTIONS
	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
	SETOM	KOUNT		;TURN ON THE COUNTING SWITCH
	POPJ	P,		;RETURN

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

	SETOM	HISW		;THIS TRIGGERS IT
	POPJ	P,

; END OF SWITCH HANDLERS

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
	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	TYICORE		;FROM COMMAND FILE?
	 JRST	 TYCOR		; NO, FROM A STRING IN PNAME, PNAME+1
	SOSLE	CMDCNT
	JRST	TYIK
EXPO <
	SKIPGE	CMDMOD		;IF USING TEMP CORE
	JRST	TYDUN		;ALL DONE.
>;EXPO
	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


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
	CALL	TEMP,[SIXBIT /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