perm filename SAIL[S,AIL]3 blob
sn#012235 filedate 1972-11-14 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00039 PAGES VERSION 16-2(47)
RECORD PAGE DESCRIPTION
00001 00001
00005 00002 HISTORY
00008 00003
00009 00004 Command File Descriptions
00011 00005 Titles, Switch Settings
00013 00006 Sail ACs, File Indices
00015 00007 Sail Bits
00022 00008 Externals, Data Allocation
00024 00009 ZERODATA (MAIN-SEMANTICS POINTERS)
00033 00010 II. SEMANTICS VARIABLES
00044 00011 ZERODATA(DISPLAY REGISTER HANDLING VARIABLES)
00046 00012 ZERODATA (MAIN-SCANNER VARIABLES)
00050 00013 ZERODATA (MAIN-PARSER VARIABLES)
00060 00014 ZERODATA (MAIN-SOURCE AND LISTING FILE VARIABLES)
00064 00015 DATA (SWITCHED VARIABLES)
00072 00016 ZERODATA (GLOBAL STATE VARIABLES)
00075 00017 ZERODATA (COUNTER SYSTEM VARIABLES)
00077 00018 DATA (RANDOM GLOBAL THINGS)
00079 00019 SLS VARIABLES
00081 00020 DATA (INITIAL PROC DESC SEMBLKS)
00082 00021 Executive and Initialization
00084 00022 Start, Ddtkil -- Once-only code to zap RAID, symbols
00087 00023 Larger, Sail -- Execution Starts Here
00089 00024
00092 00025 Morfiles -- Execution Returns Here Each New Command Line
00099 00026
00100 00027 Salnit -- Storage Initialization, Etc.
00108 00028
00112 00029 Comnd, aux. routs -- Command Scanner
00116 00030 Opnup -- Open Files
00118 00031 Comnd Itself
00126 00032 Unswt -- End of Switched-to-File
00128 00033 Filnam
00132 00034 Delim -- Handle Switches
00135 00035
00138 00036
00141 00037
00142 00038 Word
00145 00039 Tyi
00149 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,FAIL,REASON
031 202000000057 ⊗;
DEFINE .VERSION <202000000057>
COMMENT ⊗
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 HEL2, THE PRODUCTION COMPILER)
STSW (FTDEBUG,0) ;DON'T USUALLY DEBUG (MUST BE 0 OR 1)
STSW (RENSW,1) ;USUALLY ALLOW RE-ENTRANT CODE GENERATION
NOEXPO <
LEP <
↓GLOBC←←1 ;DON'T USUALLY DO GLOBAL UNLESS
>;LEP
>;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←←=600 ↓DSIZE←←=900
IFN FTDEBUG, <
↓ZSIZE←←ZSIZE+=32 ↓DSIZE←←DSIZE+=30
>
LEP <
↓ZSIZE←←ZSIZE+=45 ↓DSIZE←←DSIZE+=10
>;LEP
↓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)
DIS <
↓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)
>;DIS
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.
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←←8 ; 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/]
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.
⊗
GAG < ;DON'T ZERO IF COMPILING IN
DATA (GLOBAL STATE VARIABLES)
>;GAG
↓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
GAG <
DATA (SLS VARIABLES)
COMMENT ⊗
code blocks --
entries are ... bit table size,,data area size
current corget → to block
current aobjn pointer for storing stuff
home -- i.e. the first one we put out.
⊗
XWD =100,=1200
↓CODSTK: BLOCK 4 ;SLS CODE BLOCK DESCRIPTOR FOR CODE
XWD =10,=120
↓STRSTK: BLOCK 4 ;SLS CODE BLOCK DESCRIPTOR FOR STRINGS
XWD =20,=240
↓VARSTK: BLOCK 4 ;SLS CODE BLOCK DESCRIPTOR FOR NON-STRINGS
↓WASTE: BLOCK 2 ;USED DURING ABOVE "STACK" INITS
↓PRGBLK: 0 ;CURRENT PRGBLK ID
↓SYMJOB: 0 ;SAVED JOBSYM, FOR REEINIT?
↓STRTAD: 0 ;STARTING ADDR FOR SLS-COMPILED CODE
↓STDCS: 0 ;RANDOM ONCE-ONLY FLAG
ZERODATA (SLS VARIABLES)
INTERNAL LINKS
↑LINKS: 0 ;GLOBAL INTEGER FOR COMMUNICATING SLS_MWS
INTERNAL PRGBSTK
↑PRGBSTK: 0 ;QSTACK DSCRPTR FOR STACK OF SAVED PRGBLKS
INTERNAL SALACS
↑SALACS: BLOCK 15 ;FOR SAVING ACS WHEN CALLING SAIL-COMPILED ROUTS
>;GAG
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.
GAG <
GAGSTR:
>;GAG
SETNIT ;GET A UUO ADDR, AND A TEMP PUSH-DOWN STACK
GAG <
SETZM GOGTAB
PUSHJ P,GAGNIT ;INITIALIZE FOR GAG
>;GAG
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
NOWOM <
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
>;NOWOM
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
NOGAG <
SETZM GOGTAB ;FORCE INITIALIZATION OF CORE AREAS
>;NOGAG
; 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
WOM <
MOVEI TEMP,MACLST ;MAKE IT VERY SIMPLE
>;WOM
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
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
NOGAG <
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.
>;NOGAG
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)
NODIS <
SETZM $VAL(LPSA)
>;NODIS
DIS <
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)
>;DIS
SETZM $VAL2(LPSA)
NOGAG < ;NO ZEROING -- SINCE ADDRESSES ALREADY THERE!
JRST ZEVB
ZERV: LEFT ,%RVARB,ZSTR ;GO ALONG VARB LIST ZEROING
ZEVB: HLLZS $ADR(LPSA) ;THE RIGHT THINGS
JRST ZERV
>;NOGAG
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
SLS <
SALCAL (SLSNIT,,)
>;SLS
;;#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
GAG <; INITIALIZE FOR GAG RUN
GAGNIT:
; FIRST, ADD A NEW LENGTH COUNT IN THE LAST PROGRAM NAME BLOCK
HRRZ LPSA,JOBSYM ;LOWER EDGE OF SYMBOLS
SUBI LPSA,2 ;SEARCH FOR PROGRAM NAME
HLRE TEMP,JOBSYM ; BLOCK WITH 0 LENGTH ENTRY
SUB LPSA,TEMP ; →FIRST PROGRAM NAME
LUP1: HLRE TEMP,1(LPSA) ;GET LENGTH SPEC
JUMPE TEMP,OKENDL ; DONE
ADD LPSA,TEMP ;MOVE TO NEXT
JRST LUP1
OKENDL: HRRZ TEMP,JOBSYM ;CALC LENGTH FROM LAST TO NEW
SUBI TEMP,2(LPSA)
HRLM TEMP,1(LPSA) ;NEW LENGTH TO RIGHT PLACE
SKIPE STDCS ;HAVE WE BEEN HERE BEFORE?
JRST STRQQQQ;RFS***** POPJ P, ; YES, NO MORE NEEDED
SETOM STDCS ;NOW WE'VE BEEN HERE
; NEXT, EXPAND THE SYMBOL TABLE TO HOLD MORE LOSER SYMBOLS
MOVE A,JOBSYM ;NOW MAKE SYMBOL AREA 500 WORDS
HRRZI TEMP,=500(A) ;BIGGER
HLRE B,A ;THIS IS THE LENGTH OF THE SYMBOL TABLE
SUB TEMP,B ;ONE PAST THE END
HRLM TEMP,JOBSA ;RESET JOBFF POINTERS
HRRM TEMP,JOBFF ; (JUST IN CASE)
CALL6 (TEMP,CORE) ;GET MORE BEFORE ALLOC RUSHES IN
HALT
MOVEM A,SYMJOB ;OLD JOBSYM IS LIMIT FOR ADDITIONS
HRLZI TEMP,-=500
ADDM TEMP,SYMJOB ;THIS MAKES FINAL LENGTH RIGHT
ADDI A,=500 ;NEW SYMBOL BOTTOM
MOVEM A,JOBSYM ;SO NEW JOBSYM
SUBI A,=500(B) ;END OF CURRENT SYMBOL TABLE
MOVE B,A ;DO AOBJN'S ON B, SUBI'S ON A
XLUP: MOVE TEMP,-1(A) ;OLD WORD
MOVEM TEMP,=500-1(A) ; TO NEW LOC
SUBI A,1 ; UNTIL
AOBJN B,XLUP ; DONE
; INITIALIZE THE VARIOUS "STACKS" WHICH WILL HOLD THE CODE AND DATA
STRQQQQ:
SETZM CODSTK+1
SETZM CODSTK+2
SETZM CODSTK+3
SETZM VARSTK+1 ;INITIALIZE "COMPILE-AND-GO" AREAS
SETZM VARSTK+2 ;CLEAR BP'S TOO
SETZM VARSTK+3
SETZM STRSTK+1 ; (WANT TO DO THIS ONLY ONCE)
SETZM STRSTK+2
SETZM STRSTK+3
; SET UP FIRST PROGRAM COUNTER
MOVNI A,1
MOVEI B,0 ;NO BITS
MOVEI LPSA,CODSTK ;PUT OUT ONE
PUSHJ P,CPUSH ; WITH THIS
HRRZM TEMP,PCNT ;FIRST PCNT
HRRZM TEMP,STRTAD ;STARTING ADDRESS
POPJ P, ;PLEASE DON'T FORGET TO RETURN!
>;GAG
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
NOWOM <
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:
NOGAG <
MOVEW (BINDEV,DEVICE) ;BINARY DEVICE (PROBABLY DSK)
SKIPN TEMP,EXTEN ;ASSUME REL IF NOT SPECIFIED
MOVE6 (EXTEN,<REL>)
MOVSI SBITS2,400000 ;KLUGE TO MAKE .REL FILE DUMP NEVER
MOVEM SBITS2,WORD3 ;
MOVEI SBITS2,BINCDB
PUSHJ P,OPNUP ;OPEN BINARY FILE
IOERR <BINARY DEVICE NOT AVAILABLE>
IOERR <NO ROOM ON BINARY DEVICE>
SETZM WORD3
>;NOGAG
TLO FF,BINARY ;DENOTE BINARY FILE EXISTS
CAIE A,"," ;LIST FILE?
JRST CHKARR ; NO, GO ON
>;NOWOM
WOM <
TERPRI <LIST FILE ?>
>;WOM
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?
NOWOM <
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>
>;NOWOM
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>
MOVE LPSA,SRCFIL ;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
NOWOM <
CAIN A,"," ;MUST BE COMMA OR END OF LINE
JRST KPOPJ
SKIPN EOL
IOERR <SAIL COMMAND ERROR>
>;NOWOM
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
WOM <
SKIPN NEWTY#
JRST GOTST ;GOT IT
TERPRI <INPUT ?>
SETZM NEWTY
TTYUUO 4,A ;INCHWL -- WAIT FOR LINE.
SKIPA
GOTST: TTYUUO A ;INCHRW -- WAIT FOR CHAR.
POPJ P, ;GOT IT.
>;WOM
NOWOM <
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
>;NOWOM
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