00100 COMMENT  VALID 00046 PAGES 00200 C REC PAGE DESCRIPTION 00300 C00001 00001 00400 C00004 00002 HISTORY 00500 C00014 00003 00600 C00015 00004 Command File Descriptions 00700 C00017 00005 Titles, Switch Settings 00800 C00019 00006 HISTORY OF STUFF THAT USED TO BE IN HEAD 00900 C00023 00007 DSCR EXCHOP 01000 C00024 00008 DSCR LODBLK (TYPE,TYP1,NAME,NAME1,COUNT,COUNT1,RELOC) 01100 C00027 00009 MACROS FOR MANIPULATING SEMBLKS (SEE SAIL DATA DESCRIPTIONS) 01200 C00029 00010 MACROS FOR MANIPULATING SEMANTICS, CALLING GENERATOR ROUTINES, 01300 C00034 00011 Q-STACK HANDLERS 01400 C00038 00012 Sail ACs, File Indices 01500 C00040 00013 Sail Bits 01600 C00048 00014 Externals, Data Allocation 01700 C00051 00015 ZERODATA (MAIN-SEMANTICS POINTERS) 01800 C00060 00016 II. SEMANTICS VARIABLES 01900 C00071 00017 ZERODATA(DISPLAY REGISTER HANDLING VARIABLES) 02000 C00073 00018 ZERODATA (MAIN-SCANNER VARIABLES) 02100 C00077 00019 ZERODATA (MAIN-PARSER VARIABLES) 02200 C00088 00020 ZERODATA (MAIN-SOURCE AND LISTING FILE VARIABLES) 02300 C00092 00021 DATA (SWITCHED VARIABLES) 02400 C00102 00022 ZERODATA (GLOBAL STATE VARIABLES) 02500 C00105 00023 ZERODATA (COUNTER SYSTEM VARIABLES) 02600 C00107 00024 DATA (RANDOM GLOBAL THINGS) 02700 C00110 00025 SLS VARIABLES 02800 C00112 00026 DATA (INITIAL PROC DESC SEMBLKS) 02900 C00113 00027 Executive and Initialization 03000 C00115 00028 Start, Ddtkil -- Once-only code to zap RAID, symbols 03100 C00120 00029 Larger, Sail -- Execution Starts Here 03200 C00126 00030 03300 C00129 00031 Morfiles -- Execution Returns Here Each New Command Line 03400 C00137 00032 03500 C00142 00033 Salnit -- Storage Initialization, Etc. 03600 C00152 00034 XTCOPY, RESTORE PREVIOUS STATE OF .REL FILE 03700 C00158 00035 Comnd, aux. routs -- Command Scanner 03800 C00163 00036 Opnup -- Open Files 03900 C00166 00037 Comnd Itself 04000 C00179 00038 Unswt -- End of Switched-to-File 04100 C00181 00039 Filnam 04200 C00191 00040 Delim -- Handle Switches 04300 C00194 00041 04400 C00197 00042 04500 C00203 00043 04600 C00205 00044 Word 04700 C00208 00045 Tyi 04800 C00212 00046 04900 C00213 ENDMK 05000 C; 00100 COMMENT HISTORY 00200 AUTHOR,FAIL,REASON 00300 031 102200000016 ; 00400 DEFINE .VERSION <102300000021> 00500 00600 COMMENT  00700 VERSION 18-1(12) 3-1-75 BY RLS ADD TNXBND FOR TENEX ADVBUF -- (SHOULD BE DONE FOR DEC TOO PROBABLY) 00800 VERSION 18-1(11) 2-16-75 BY JFR BAIL FLAG FOR REQUESTING SYS:BAIPDn.REL P.24 00900 VERSION 18-1(10) 2-15-75 BY RLS JUST LOOKING 01000 VERSION 18-1(9) 2-15-75 BY RLS TENEX CHANGE -- PUT SRCTTY IN SWITCHED AREA 01100 VERSION 18-1(8) 2-1-75 BY JFR BAIL FLAG FOR SKIPPING SYS:BAIL.REL P.24 01200 VERSION 18-1(7) 2-1-75 BY RLS MAKE EXPR!TYPE RECURSIVE 01300 VERSION 18-1(6) 2-1-75 BY RLS MAKE EXPR!TYPE RECURSIVE 01400 VERSION 18-1(5) 11-27-74 BY JFR AVLSRC BEING SET INCORRECTLY P. 31 01500 VERSION 18-1(4) 11-7-74 BY JFR KEEP TRACK OF PPN IN CDB 01600 VERSION 18-1(3) 10-20-74 BY RHT FEAT %BT% -- MAKE OUTER BLOCK PD LOOK BETTER 01700 VERSION 18-1(2) 10-18-74 BY RHT JUST CHECKING 01800 VERSION 18-1(1) 10-17-74 BY RHT VERSION 18 01900 VERSION 17-1(54) 10-16-74 BY JFR JUST CHECKING 02000 VERSION 17-1(53) 10-16-74 BY JFR FIX BAIL SOURCE FILE COUNTING 02100 VERSION 17-1(52) 10-10-74 BY RLS PARAMETERIZE DEFAULT DEF STACK SIZE 02200 VERSION 17-1(51) 9-26-74 BY JFR FILE NAMES OUTPUT TO .SM1 FILE 02300 VERSION 17-1(50) 9-20-74 BY JFR INSTALL BAIL 02400 VERSION 17-1(49) 9-20-74 02500 VERSION 17-1(48) 9-20-74 02600 VERSION 17-1(47) 9-20-74 02700 VERSION 17-1(46) 9-20-74 BY RHT FIX RHT'S STUPID MISTAKE 02800 VERSION 17-1(45) 5-28-74 BY RHT BUG #SD# ADD NEW FLAG (IEFLAG) 02900 VERSION 17-1(44) 4-12-74 BY RHT ADD BIT TO ALLTYPS 03000 VERSION 17-1(43) 4-6-74 BY RLS EDIT 03100 VERSION 17-1(42) 4-6-74 BY RLS TENEX FIX TO PARC LOADER INTERFACE 03200 VERSION 17-1(41) 3-25-74 BY JRL WE NOW USE LOADER 54 BLOCK CODES (LIBRARIES, LOAD MODULES) 03300 VERSION 17-1(40) 3-19-74 BY RHT LOOK AT RS ADDITIONS 03400 VERSION 17-1(39) 3-17-74 BY RLS EDIT 03500 VERSION 17-1(38) 3-17-74 BY RLS TENEX FEATURES 03600 VERSION 17-1(37) 1-11-74 BY RHT TURN OFF BAISW (DAMMIT!!!) 03700 VERSION 17-1(36) 1-11-74 BY JRL CMU CHANGE PPN'S DDTKIL 03800 VERSION 17-1(35) 1-11-74 03900 VERSION 17-1(34) 1-11-74 04000 VERSION 17-1(33) 1-11-74 04100 VERSION 17-1(32) 1-6-74 BY KVL ADD %BC% BAIL SYMBOL OUTPUTTING STUFF 04200 VERSION 17-1(31) 12-7-73 BY JRL BUG #PS# DELAY SETTING UP OF MYERR 04300 VERSION 17-1(30) 12-7-73 BY RHT DITTO 04400 VERSION 17-1(29) 12-7-73 BY RHT NO REAL REASON 04500 VERSION 17-1(28) 12-7-73 04600 VERSION 17-1(27) 12-7-73 04700 VERSION 17-1(26) 12-7-73 BY rht get .version back 04800 VERSION 17-1(25) 12-6-73 BY JRL REMOVE AS MANY SPECIAL STANFORD CHARACTERS AS POSSIBLE 04900 VERSION 17-1(24) 12-4-73 BY RHT BUG #PN# NEEDED TO GET JOBFF OK AT START -- DID RESET TO FIX 05000 VERSION 17-1(23) 12-4-73 05100 VERSION 17-1(22) 12-3-73 BY RHT TURN CALL INTO A CALL6 05200 VERSION 17-1(21) 12-3-73 BY RHT FEAT %AY% USE INTMAP RUNTIME ROUTINE 05300 VERSION 17-1(20) 12-3-73 05400 VERSION 17-1(19) 12-2-73 BY RHT GET BACK AN OLDER VERSION AFTER DISASTER 05500 VERSION 17-1(18) 11-25-73 BY RHT FEAT %AO% .SEG2. MAY DO A SETPR2 05600 VERSION 17-1(17) 11-24-73 BY RHT FEAT %AL% MAKE OUTER BLOCK LOOK LIKE A PROCEDURE 05700 VERSION 17-1(16) 11-24-73 05800 VERSION 17-1(15) 11-24-73 BY RHT TRANSFER IN STUFF THAT USED TO BE IN HEAD 05900 VERSION 17-1(14) 11-24-73 06000 VERSION 17-1(13) 11-24-73 06100 VERSION 17-1(12) 11-24-73 06200 VERSION 17-1(11) 11-24-73 06300 VERSION 17-1(10) 11-24-73 06400 VERSION 17-1(9) 11-24-73 06500 VERSION 17-1(8) 11-24-73 06600 VERSION 17-1(7) 11-22-73 BY RHT INCREASE DATA AREAS 06700 VERSION 17-1(6) 11-22-73 BY RHT FIX KVL TYPO 06800 VERSION 17-1(5) 11-10-73 BY KVL INSERT CHANGES TO LOG ERR UUO 06900 VERSION 17-1(4) 9-19-73 BY HJS ADD EVALREDEFINE AND CVPS 07000 VERSION 17-1(3) 8-17-73 BY JRL MAKE LOADVR=52 ONLY FOR NOEXPR 07100 VERSION 17-1(2) 8-16-73 BY jrl ifn out references to LEP 07200 VERSION 17-1(1) 8-6-73 BY HJS BUG #NO# FIX EXTRA ENDC,ELSEC ERROR MESSAGE 07300 VERSION 17-1(0) 7-26-73 BY RHT **** VERSION 17 !!! *** 07400 VERSION 16-2(56) 7-26-73 BY JRL INCREASE ZERODATA SIZE FOR NON FTDEBUG 07500 VERSION 16-2(55) 7-11-73 07600 VERSION 16-2(54) 7-11-73 07700 VERSION 16-2(53) 6-19-73 BY HJS IFCR, REDEFINE, EVALDEFINE, AND ASSIGNC IMPLEMENTATION 07800 VERSION 16-2(52) 5-17-73 BY HJS INITIALIZE ENDC COUNTER TO -1 07900 VERSION 16-2(51) 3-15-73 BY JRL BUG #LT# ERRMSG 08000 VERSION 16-2(50) 3-13-73 BY JRL REMOVE REFERENCES TO GAG,WOM,SLS,NODIS 08100 VERSION 16-2(49) 12-13-72 08200 VERSION 16-2(48) 12-13-72 BY JRL BUG #KS# ADD LOADVR SWITCH 08300 VERSION 16-2(47) 11-14-72 BY RHT MAKE .REL FILES DUMP NEVER 08400 VERSION 16-2(46) 11-13-72 BY RHT BUG #KC# -- PDA,,0 FIXUP FOR HIGH SEG MESSED UP 08500 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. 08600 VERSION 16-2(44) 8-13-72 BY DCS UPDATE COMMAND FILE DESCRIPTIONS 08700 VERSION 16-2(41) 7-5-72 BY DCS BUG #IH# KEEP RAID IN DISK FILE, NOT CORE IMAGE 08800 VERSION 16-2(40) 7-2-72 BY RHT INCREASE ZSIZE FOR NON FTDEBUG PART 08900 VERSION 16-2(39) 6-25-72 BY DCS BUG #HX# PARAMETERIZE PROCESSOR NAME, DEFAULT EXT 09000 VERSION 16-2(38) 6-21-72 BY RHT CHANGE THE WAY PDA,,0 SEMBLK IS LINKED 09100 VERSION 16-2(37) 5-14-72 BY DCS BUG #HH# BETTER INITIAL CODE IF /H 09200 VERSION 15-6(18-36) 4-6-72 LOTS OF THINGS 09300 VERSION 15-6(17) 2-21-72 BY HJS THE BRAVE NEW PARSER WORLD 09400 VERSION 15-6(12) 2-18-72 BY RHT THE BRAVE NEW WORLD 09500 VERSION 15-6(11) 2-10-72 BY DCS BUG #GR# MINOR FTDEBUGGER FIXES 09600 VERSION 15-6(10) 2-6-72 BY DCS BUG #GP# CHECK FORWARD FORMALS AGAINS REAL FORMALS 09700 VERSION 15-6(9) 2-5-72 BY DCS BUG #GJ# ADD LSTON LISTING CONTROL STUFF 09800 VERSION 15-6(8) 2-1-72 BY DCS BUG #GH# USE INTERRUPTS TO DO ASYNCH BREAKS, 6M MEANS SCAN BREAK 09900 VERSION 15-6(7) 2-1-72 BY DCS BUG #GE# MODIFY FOR NEW %ALLOC INTERFACE 10000 VERSION 15-6(6) 1-3-72 BY DCS BUG #FX# REMOVE COM2, COM2SW COMPLETELY 10100 VERSION 15-6(5) 12-24-71 BY DCS BUG #FF# ADD FILE NAME ID TO FILE NOT FOUND MSG 10200 VERSION 15-6(4) 12-22-71 BY DCS BUG #FT# ADD BINLIN 10300 VERSION 15-6(3) 12-22-71 BY DCS BUG #FS# REMOVE SAILRUN, MOST COM2 CONDITIONALS 10400 VERSION 15-2(2) 12-2-71 BY DCS SET UP VERSION NUMBER IN OBJECT COMPILER 10500 VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER 10600 ; 10700 00100 COMMENT  00200 00300 00400 00500 00600 00700 00800 00900 01000 01100 01200 01300 01400 01500 01600 01700 There was a compiler named SAIL, 01800 Assembled and coded in FAIL. 01900 Its authors, they say 02000 (one glorious day) 02100 Were run out of town on a rail. 02200 02300 02400 02500 02600 02700 02800 02900 03000 03100 03200 03300  03400 00100 COMMENT Command File Descriptions 00200 00300 The following command files make compilers: 00400 00500 1. IT 00600 Standard Stanford Sail compiler, 1 or 2 segments, Leap, Global, no Debugging 00700 00800 RESTAB.=PROD+FOO2/NOLIST/NOLO/NON RTRAN 00900 PROD.=HEL/NOLIST/NOLO/NON PTRAN 01000 SAIL=CALLIS(LR)+HEAD+FILSPC+SAIL+PARSE+HEL+FOO2+PROD/FORWARD+RESTAB/FORWARD ; 01100 +SYM+GEN+ARRAY+EXPRS+STATS+LEAP+TOTAL+PROCSS+COMSER 01200 01300 2. THAT 01400 Same, except Debugging turned on 01500 01600 RESTAB.=PROD+FOO2/NOLIST/NOLO/NON RTRAN 01700 PROD.=HEL/NOLIST/NOLO/NON PTRAN 01800 SAIL=CALLIS(LR)+HEAD+FILSPC+DB+SAIL+PARSE+HEL+FOO2+PROD/FORWARD+RESTAB/FORWARD ; 01900 +SYM+GEN+ARRAY+EXPRS+STATS+LEAP+TOTAL+PROCSS+COMSER 02000 02100 3. There will eventually be a file to make a truly two-segment SAIL. 02200  02300 00100 COMMENT Titles, Switch Settings 00200 TITLE SAIL -- Stare at it Later 00300 SUBTTL D. SWINEHART, R. SPROULL -- FEBRUARY 1969 00400 ; Revised as of 20 Mar 1971 DCS-RFS 00500 SUBTTL SAIL ASSEMBLY SPECIFICATIONS 00600 LSTON (SAIL) ;LIST IF ENABLED 00700 00800 BIT2DATA (CONDITIONAL ASSEMBLY SWITCHES) 00900 01000 ; ** CONDITIONAL SETTINGS ** 01100 01200 ;?SAILRUN__-1 ;SWITCH USED NO LONGER 01300 ?LEAPSW __1 ;IT CAN DO LEAP 01400 ; (IF YOU MAKE IT 0, ALSO REMOVE THE LEAP 01500 ; STUFF FROM HEL, THE PRODUCTION COMPILER) 01600 ;; #KS BY JRL LOADVR SWITCH 01700 STSW (LOADVR,=54) ;ASSUME LOADER 54 01800 STSW (FTDEBUG,0) ;DON'T USUALLY DEBUG (MUST BE 0 OR 1) 01900 STSW (RENSW,1) ;USUALLY ALLOW RE-ENTRANT CODE GENERATION 02000 NOEXPO < 02100 ?GLOBC__1 ;DON'T USUALLY DO GLOBAL UNLESS 02200 >;NOEXPO 02300 STSW (GLOBC,0) ;STANFORD LEAP COMPILER 02400 ?PATSW__0 ;ON UNTIL GET NEW SEGMENT UP 02500 STSW (PATSW,0) ;IF SET, INCLUDE AOS `PAT' ON ENTRY, 02600 ; SOS `PAT' ON EXIT FROM PROC (Proc Active Tally) 02700 02800 ?TIMER__0 ;IF SET, INCLUDE A LITTLE TIMER TO SEE HOW 02900 ; THINGS GO. THIS IS A LITTLE INSTRUCTION 03000 ; INTERPRETER IN FILE "PARSE" 03100 03200 ;; ! JFR 10-19-75 used to be 0 for Stanford 03300 STSW (TMPCSW,1) 03400 03500 ;; %AZ% BY KVL (1/3/74) 03600 03700 ; ** ** 03800 03900 ENDDATA 04000 00100 COMMENT HISTORY OF STUFF THAT USED TO BE IN HEAD 00200 00300 AUTHOR,REASON 00400 021 102100000002 ; 00500 00600 00700 COMMENT  00800 VERSION 17-2(47) 11-10-73 BY RHT ADD CORERR, ERRPRI, ERFLGS BITS 00900 VERSION 17-1(46) 7-26-73 BY RHT TRY VERSION 17 01000 VERSION 17-1(45) 7-26-73 ********************* 01100 VERSION 16-2(44) 7-9-73 BY JRL REMOVE LAST REFERENCES TO DCS SWITCH 01200 VERSION 16-2(43) 4-23-73 BY RHT CHANGE ARGTYP TO RFITYP 01300 VERSION 16-2(42) 2-7-73 BY RHT ADD TYPE FOR ARG LIST ITEM 01400 VERSION 16-2(41) 1-28-72 BY JRL PUT QBIND,FBIND HERE SO STATS CAN USE 01500 VERSION 16-2(40) 1-23-73 BY RHT MAKE NIC & UNBOUND THE SAME 01600 VERSION 16-2(39) 1-23-73 BY JRL CHANGE CODE FOR UNBND 01700 VERSION 16-2(38) 1-8-73 BY JRL ADD MAXLOC MAXIMUM NUMBER OF FOREACH LOCAL ITEMVARS ALLOWED 01800 VERSION 16-2(37) 12-13-72 BY jrl BUG #KS# ADD LOADVR SWITCH 01900 VERSION 16-2(36) 11-21-72 02000 VERSION 16-2(35) 11-10-72 BY HJS MODIFY QPOP TO TAKE AS AN ARGUMENT AN ADDRESS FOR THE POPPED ENTRY 02100 VERSION 16-2(34) 10-16-72 BY JRL CHANGE INVTYP TO 31 TO ALLOW CONTEXT ARRAY ITEMS 02200 VERSION 16-2(33) 9-15-72 BY RHT ADD USER TABLE ENTRIES FOR INTERRUPTS 02300 VERSION 16-2(32) 8-27-72 BY RHT PUT CELL FOR STACK UNWINDER RET ADRS IN USER TABLE 02400 VERSION 16-2(31) 8-23-72 BY JRL ADD UNBND "ITEM" 02500 VERSION 16-2(30) 8-20-72 BY RHT MODIFY USER TABLE 02600 VERSION 16-2(29) 8-6-72 BY RHT ADD PRILIS TO USER TABLE 02700 VERSION 16-2(28) 8-3-72 BY JRL ADD MPBIND TO TBITS DEFS FOR MATCHING PROCEDURES 02800 VERSION 16-2(27) 7-27-72 BY RHT MAKE MACRO FOR DECLARING PD. ENTRIES 02900 VERSION 16-2(26) 7-20-72 BY JRL CHANGE ARRTYP VALUE 03000 VERSION 16-2(25) 7-20-72 BY RHT ADD PROCESS ITEM (TYPE 11) 03100 VERSION 16-2(24) 6-20-72 BY DCS BUG #HU# BETTER TTY INFORMATION 03200 VERSION 16-2(23) 5-16-72 BY DCS INTRODUCE VERSION 16 03300 VERSION 15-2(9-22) 5-4-72 LOTS OF THINGS 03400 VERSION 15-2(8) 2-19-72 BY RHT THE BRAVE NEW WORLD 03500 VERSION 15-2(7) 2-5-72 BY DCS BUG #GJ# ADD LSTON LISTING CONTROL STUFF 03600 VERSION 15-2(6) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR DUE TO NEW `CAT' 03700 VERSION 15-2(5) 2-1-72 BY DCS BUG #GE# INSTALL SYMB %ALLOC BLK INDICES 03800 VERSION 15-2(4) 1-31-72 BY DCS BUG #GE# UPDATE USER TABLE, %ALLOC BITS, INDICES 03900 VERSION 15-2(3) 1-3-72 BY DCS BUG #FX# REMOVE COM2, COM2SW COMPLETELY 04000 VERSION 15-2(2) 12-24-71 BY DCS BUG #FF# REMOVE SAILRUN(ASSUME RUNTIM OR LIB) 04100 VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER 04200 04300 ; 04400 00100 DSCR EXCHOP 00200 DES Exchange Semantic entries in PNT,TBITS,SBITS with those 00300 in PNT2,TBITS2,SBITS2 -- since "GENMOV" routines generally 00400 operate on the first set of ACs. 00500  00600 DEFINE EXCHOP < 00700 EXCH PNT,PNT2 00800 EXCH TBITS,TBITS2 00900 EXCH SBITS,SBITS2 > 01000 01100 DSCR MOVOPS 01200 DES Copy Semantic entries from PNT,TBITS,SBITS into 01300 PNT2,TBITS2,SBITS2 01400 ; 01500 DEFINE MOVOPS < 01600 MOVE PNT2,PNT 01700 MOVE TBITS2,TBITS 01800 MOVE SBITS2,SBITS 01900 > 02000 00100 DSCR LODBLK (TYPE,TYP1,NAME,NAME1,COUNT,COUNT1,RELOC) 00200 CAL MACRO 00300 PAR TYPE, TYP1 are the symbolic and numeric reps of 00400 a LOADER block type 00500 NAME, NAME1 are the labels to be given the block and 00600 its descriptor (optional, see below) 00700 COUNT, COUNT1 are the data count and the total count 00800 for the descriptor (optional, etc.) 00900 RELOC describes the initial relocation bits 01000 RES if NAME1 is present, a descriptor word is put out 01100 to provide GBOUT with count info for entire block 01200 Then the Type,,count word is output, labeled NAME 01300 Following is the RELOC word, then a block long enough 01400 to hold data 01500 SEE GBOUT, Loader blocks (ENTTAB, BINTAB, etc.) 01600  01700 DEFINE LODBLK (TYPE,TYP1,NAME,NAME1,COUNT,COUNT1,RELOC) < 01800 01900 ; Create LOADER OUTPUT BLOCK of type TYPE (really the 02000 ; integer TYP1. Name it NAME. Give it a data count 02100 ; of COUNT. If there is a NAME1, create a descriptor 02200 ; for GBOUT of the form [(COUNT1 or COUNT+2),,NAME]. 02300 ; Issue a reloc word of (RELOC or 0). 02400 ; Put out a COUNT-word block for holding the data 02500 02600 IFNB (NAME1) < 02700 02800 02900 ;DESCRIPTOR FOR GBOUT ROUTINE 03000 ^^NAME1: 03100 IFNB (COUNT1) < 03200 XWD COUNT1,NAME;> XWD COUNT+2,NAME 03300 > 03400 03500 ;LOADER BLOCK HEADER 03600 ^^NAME: XWD TYP1,COUNT 03700 03800 ;RELOCATION BITS 03900 IFNB (RELOC) < 04000 RELOC;> 0 04100 04200 ;DATA WORDS 04300 BLOCK COUNT 04400 >;LODBLK 04500 04600 00100 ; MACROS FOR MANIPULATING SEMBLKS (SEE SAIL DATA DESCRIPTIONS) 00200 00300 DSCR GETBLK (X) 00400 CAL MACRO 00500 PAR X is address (optional) 00600 RES into LPSA (and X) is put address of new Semblk (zeroed) 00700 SID LPSA, X changed -- probably TEMP too 00800 SEE BLKGET, the routine it calls, and main SAIL data descriptions 00900  01000 DEFINE GETBLK ( X ) < 01100 PUSHJ P,BLKGET 01200 IFDIF <>,> 01300 01400 DSCR FREBLK (X) 01500 CAL MACRO 01600 PAR X (optional) is address of Semblk (LPSA is default) 01700 RES Semblk is released to free Semblk list 01800 SID TEMP, LPSA changed 01900 SEE BLKFRE, the routine used, and main SAIL data descriptions 02000  02100 DEFINE FREBLK ( X ) < 02200 IFIDN <>, PUSH P,X 02300 PUSHJ P,BLKFRE 02400 > 02500 02600 ; TAKE CDR OF A LINKED LIST, GOING ALONG LINK Y. GO TO Z 02700 ; IF LIST IS EXHAUSTED. 02800 DEFINE RIGHT (X,Y,Z ) < 02900 IFDIF <>, 03000 HRRZ LPSA,Y(LPSA) 03100 IFDIF <>,> 03200 03300 ; SAME FOR MOVING LEFT ALONG A LINK. 03400 DEFINE LEFT (X,Y,Z) < 03500 IFDIF <>, 03600 HLRZ LPSA,Y(LPSA) 03700 IFDIF <>,> 03800 00100 ; MACROS FOR MANIPULATING SEMANTICS, CALLING GENERATOR ROUTINES, 00200 ; GENERATING CALLS ON RUNTIME ROUTINES ON BEHALF OF COMPILED CODE, ETC. 00300 00400 ; PICK UP SEMANTICS WORDS FOR A PARSER TEMPORARY. 00500 DEFINE GETSEM (X) < 00600 MOVE PNT,GENLEF+X 00700 PUSHJ P,GETAD > 00800 00900 ; SAME, BUT PUT SEMANTICS IN TBITS2,SBITS2 01000 DEFINE GETSM2 (X) < 01100 MOVE PNT2,GENLEF+X 01200 PUSHJ P,GETAD2 > 01300 01400 01500 DSCR GENMOV (Z,X,Y) 01600 DES MACRO TO FACILITATE CALLING GENERATOR SUBROUTINES. 01700 PAR Z IS ROUTINE NAME. 01800 X IS FLAGS (OPTIONAL) 01900 Y IS TYPE (INTEGER,,,) TO BE PASSED IN REGISTER B. 02000 RES Calls routine after setting up AC's. 02100 ; 02200 DEFINE GENMOV (Z,X,Y) < 02300 IFDIF <>, 02400 IFDIF <>, 02500 ;;#YR# JFR 2-2-77 02600 IFE <>&,< 02700 ;BOTH PROTECT AND UNPROTECT ARE ON. PRESUMABLY THIS MEANS YOU WANT 02800 ;TO PROTECT THE AC GIVEN IN RH(D), INVOKE 'GET' OR 'ACCESS' (ETC.), 02900 ;THEN UNPROTECT WHAT YOU ORIGINALLY PROTECTED. UNFORTUNATELY 03000 ;'GET' PROBABLY CHANGED D. THIS CAUSED ABSOLUTELY HORRIBLE WRONG CODE 03100 ;WITH NO ERROR MESSAGE. TRY TO CORRECT DESIGN ERROR. 03200 PUSH P,D ;SAVE AC 03300 PUSHJ P,Z ;ORIGINAL ROUTINE 03400 EXCH D,(P) 03500 HRRI FF,UNPROTECT 03600 PUSHJ P,POST 03700 POP P,D> 03800 IFN <>&,< 03900 ;ONE OR THE OTHER OF PROTECT, UNPROTECT IS OFF. 04000 PUSHJ P,Z> 04100 ;;#YR# ^ 04200 > 04300 04400 04500 DSCR XCALL (X) 04600 CAL MACRO 04700 DES Facilitates calling runtine functions. 04800 PAR X is the "NAME" of such a function, all of which 04900 are named in the beginning of the file "GEN" 05000 RES a call (PUSHJ) to the routine is generated and fixed up 05100 SID AC A is clobbered. 05200 SEE XCALLQ 05300 ; 05400 DEFINE XCALL ' (X) < 05500 MOVEI A,LIBTAB+R'X ;FIXUP LOCATION. 05600 PUSHJ P,XCALLQ 05700 > 05800 05900 DSCR LPCALL (X,Y,Z) 06000 CAL MACRO 06100 DES Facilitates EMITting calls to LEAP interpreter 06200 functions. 06300 PAR X is function "NAME" (list is located at beginning of file "LEAP") 06400 Y (optional) displacement from X. 06500 Z tells what kind of call it is. If non-null, we use the 06600 index computed by STCHK (Q.V.) to add to X, otherwise 06700 just the type bits computed by STCHK. 06800 SEE LEAPC1, LEAPC2, STCHK 06900 ; 07000 DEFINE LPCALL ' (X,Y,Z) < 07100 MOVEI A,L'X ;ROUTINE NAME. 07200 IFDIF <>, 07300 IFIDN <>, PUSHJ P,LEAPC2 07400 > 07500 07600 DSCR XPREP 07700 CAL MACRO 07800 DES Make sure AC 1 is free (I.E. erase the ACKTAB entry for it -- 07900 so that a call on a runtime routine which returns a result 08000 in AC 1 can now be EMITted. 08100 SEE STORZ 08200 ; 08300 DEFINE XPREP < 08400 PUSHJ P,[ 08500 HRRI D,1 08600 JRST STORZ] 08700 > 08800 ;;%DU% 2ND AC OF LONG REAL PROCEDURE 08900 DEFINE XPREP2 < 09000 PUSHJ P,[ 09100 HRRI D,2 09200 JRST STORZ] 09300 > 09400 09500 09600 DSCR EMIT (INSTR) 09700 CAL MACRO 09800 DES Facilitates calling the EMITTER for us. 09900 PAR INSTR is the instruction and "DIRECTIVE" bits to the 10000 EMITTER. 10100 ; 10200 DEFINE EMIT (INSTR) < 10300 IFDIF <>, 10400 PUSHJ P,EMITER ;CALL EMITER 10500 > 10600 10700 10800 00100 ; Q-STACK HANDLERS 00200 00300 DSCR QPUSH (X,Y) 00400 CAL MACRO 00500 DES calls the generalized stack routine BPUSH. 00600 PAR X (optional) is name of stack to be used. 00700 Y (optional) is data word to be pushed (AC A). 00800 SID A, LPSA, TEMP changed 00900 SEE BPUSH 01000  01100 DEFINE QPUSH (X,Y) < 01200 IFDIF <>, 01300 IFDIF <>, 01400 PUSHJ P,BPUSH > 01500 01600 DSCR QPOP 01700 CAL MACRO 01800 DES Facilitates calls on generalized stack routine BPOP 01900 PAR X is name of the stack to be used (optional).. otherwise 02000 pointer in LPSA. 02100 Y (optional) is where the popped entry is to be returned. 02200 RES Popped entry is returned in AC A and Y (optional). 02300 SEE BPOP 02400 ; 02500 DEFINE QPOP (X,Y) < 02600 IFDIF <>, 02700 PUSHJ P,BPOP 02800 IFDIF <>, > 02900 03000 DSCR QLOOK 03100 CAL MACRO 03200 DES Allows one to get hold of the top element in the Qstack X 03300 PAR X is the name of the stack to be used 03400 RES the pointer to the top element in the stack is returned in AC A. 03500  03600 DEFINE QLOOK (X) < 03700 HLRZ A,X > 03800 03900 DSCR QTAKE (X) 04000 CAL MACRO 04100 DES facilitates "taking" things out of one of the generalized 04200 QSTACKS (uses routine QTAK). 04300 PAR X is name of Qstack to be used. 04400 AC B must have a QPUSH/QPOP-like pointer to the element requested. 04500 RES Popped result returned in register A. 04600 **** SKIPS IF SUCCESSFUL **** 04700 SEE QTAK 04800 ; 04900 DEFINE QTAKE (X) < 05000 IFDIF <>, 05100 PUSHJ P,QTAK > 05200 05300 DSCR QBACK 05400 CAL MACRO 05500 PAR In AC B must be a QSTACK descriptor 05600 RES B's descriptor is "popped" by one, word put in AC A. 05700 No storage is released 05800 **** SKIPS IF SUCCESSFUL **** 05900 DES See BBACK routine in TOTAL for details of operation, AC usage, etc. 06000 SEE BBACK 06100  06200 06300 DEFINE QBACK < 06400 PUSHJ P,BBACK 06500 > 06600 06700 06800 DSCR QFLUSH (X) 06900 CAL MACRO 07000 PAR Qstack descriptor address 07100 RES All storage is released for the stack, and the descriptor 07200 address is zeroed. 07300 DES Used when QBACK and QTAKE operations have left blocks around. 07400 There should always be one actual PDP-type cell which points 07500 to the top (is only used in QPUSH and QPOPs). This should be 07600 pointed at to flush the stack. 07700 SEE BFLUSH 07800  07900 08000 DEFINE QFLUSH (X) < 08100 IFDIF <> < 08200 MOVEI LPSA,X 08300 > 08400 PUSHJ P,BFLUSH 08500 > 08600 08700 DSCR QBEGIN (X) 08800 CAL MACRO 08900 PAR X PTR TO A QPDP, LOADED TO LPSA IF PRESENT 09000 RES B contains QPDP for QTAKEing first word, 0 if no stack 09100 SEE BBEG 09200  09300 DEFINE QBEGIN (X)< 09400 IFDIF <> < 09500 MOVEI LPSA,X 09600 > 09700 PUSHJ P,BBEG 09800 > 09900 10000 ;;; THE VERY FIRST LOCATION 10100 10200 10300 ?LPSERR: ERR 10400 00100 SUBTTL Sail ACs, File Indices 00200 00300 BEGIN SAIL 00400 00500 AC2DATA (GLOBALLY USED ACS) 00600 00700 ?FF __0 ;FLAG WORD, POSSIBLY 00800 ?A _ 1 ;TEMPORARY AC'S -- MAY 00900 ?B _ 2 ; RETAIN VALUES OVER SUBROUTINE 01000 ?C _ 3 ; CALLS AS LONG AS EVERYONE UNDERSTANDS 01100 ?D _ 4 ; WHAT IS HAPPENING. 01200 ?PNT _ 5 ;PTR TO SYMBOL ENTRY FOR GENERATORS, ENTER, ETC. 01300 ?TBITS _ 6 ;"TYPE" BITS FOR SYMBOL ENTRY 01400 ?SBITS _ 7 ;"SEMANTIC" (MORE RANDOM GOOD) BITS FOR SAME 01500 ?PNT2 _10 ;SAME FOR 2D ARGUMENT IN 01600 ?TBITS2 _11 ; BINARY CASES -- MAY BE OTHERWISE USED 01700 ?SBITS2 _12 ; IF ONE IS CAREFUL 01800 01900 ;?SP ;STRING PUSH-DOWN STACK -- COMPILER PUSH-DOWN STACKS 02000 ;?TEMP ;USE FOR EXTREMELY TEMPORARY PURPOSES 02100 ;?USER ;LPS PARAMETER-PASSING ACS -- USE ALSO 02200 ;?LPSA ; FOR HOLDING POINTERS, BUT BE CAREFUL 02300 ;?P ;"SYSTEM" PUSH-DOWN POINTER 02400 02500 02600 ; SAIL I/O CHANNELS 02700 02800 ?SRC __1 ;SOURCE FILE CHANNEL 02900 ?BIN __2 ;BINARY 03000 ?LST __3 ;LISTING 03100 ?CMND __4 ;COMMAND 03200 ?LOG __5 ;LOGGING FILE CHANNEL 03300 ;; %BC% ADD BAIL SYMBOL OUTPUTS 03400 BAIL < 03500 ?SM1 __6 ;NAME FILE FOR SYMBOLS 03600 >;BAIL 03700 ;; %BC% 03800 03900 XCOM< 04000 ?TMQ __17 ;TEMP CHAN FOR COPYING 04100 >;XCOM 04200 ENDDATA 04300 04400 00100 SUBTTL Sail Bits 00200 00300 ; BIT MASKS FOR GENERATORS 00400 00500 BIT2DATA (TBITS, SBITS WORDS) 00600 00700 ; LEFT HALF BITS -- TBITS WORD 00800 ; THESE ARE THE BITS STORED IN SYMBOL TABLE ENTRIES ABOUT 00900 ; EACH USER'S IDENTIFIER, OR EACH CONSTANT (SCANNED OR CREATED). 01000 01100 DEFINE BIT (NAME,BITT) < 01200 IFNDEF NAME, ,> 01300 IFN FTDEBUG, < 01400 IFIDN , < 0 01500 > 01600 IFDIF ,< RADIX50 0,NAME 01700 >>> 01800 ; THIS WILL DEFINE THE LOCATIONS USED IN DEBUGGING 01900 IFN FTDEBUG, < 02000 BITABLE: XWD .+1,BTBITS 02100 XWD .+1,BSBITS 02200 XWD .+1,GENBTS 02300 ARRBTS 02400 > 02500 02600 02700 BTBITS: 02800 DEFTBS ;MACRO CALL TO DEFINE THEM 02900 ?FORMAL __ VALUE!REFRNC ;FORMAL PARAMETER IS EITHER TYPE. 03000 03100 ALTYPS __FORTRAN+PROCED+ITMVAR+PNTVAR+BOOLEAN+ITEM 03200 ALTYPS __ALTYPS+STRING+SET+LABEL+LSTBIT+DBLPRC+INTEGR+FLOTNG 03300 03400 ?ALTYPS__ALTYPS 03500 03600 ?SNGTYP __ ITEM+ITMVAR+PNTVAR+INTEGR+FLOTNG+SET+DBLPRC+BOOLEAN+LSTBIT 03700 03800 ;LEFT HALF BITS -- SBITS WORD. 03900 04000 04100 BSBITS: BIT (INUSE,400000) ;TEMP IN USE 04200 BIT (ARTEMP,200000) ;ARITHMETIC TEMP 04300 BIT (STTEMP,100000) ;STRING (STACKED) TEMP 04400 BIT (INAC,40000) ;VARIABLE OR TEMP IN ACCUMULATOR 04500 BIT (FREEBD,20000) ;ITEMVAR MAY BE FREE OR BOUND 04600 BIT (NEGAT,10000) ;SAYS THIS THING IS IN AC NEGATIVELY. 04700 04800 BIT (INDXED,4000) ;REPRESENTS CALCULATED ARRAY POINTER. 04900 BIT (CORTMP,2000) ;REAL-LIVE TEMPORARY CORE LOCATION. 05000 BIT (PTRAC,1000) ;POINTER TO ARGUMENT IS IN AC. 05100 BIT (RTNDON,400) ;SOMEBODY RETURNED FROM THIS (TYPED) PROCEDURE 05200 BIT (LPFRCH,200) ;THIS THING IS IN THE CURRENT FOREACH LIST. 05300 BIT (LPFREE,100) ;THIS THING IS STILL "FREE" 05400 BIT (FIXARR,40) ;TEMP CELL REPRESENTS ARR[CONST] 05500 BIT (KNOWALL,20) ;USED BY ARRAY CODE ONLY 05600 BIT (DISTMP,10) ;ONLY MEANINGFUL FOR DIS SYSTEMS 05700 05800 NOEXPO < 05900 IFN FTDEBUG, < 06000 BLOCK =18+=5 > 06100 >;NOEXPO 06200 06300 06400 06500 BITDATA (FF WORD) 06600 06700 ; FF (FLAG WORD) FLAGS 06800 06900 ; LEFT HALF 07000 07100 ?RELOC __400000 ;IF ON, CODE IS MADE RELOCATABLE 07200 ?RLCPOS__ 0 ;POSITION OF RELOC BIT IN FF 07300 ?TOPLEV__200000 ;AT TOP (GLOBAL) LEVEL OF PROGRAM 07400 ?DEFLUK__100000 ;DO NOT STACK RESULTS OF ID SCAN (IN STRING CONSTANT) 07500 ?IREGCT__ 40000 ;USED BY GBOUT (BINARY OUTPUT) 07600 ?FFTMP1__IREGCT;SUPER-TEMP, NOT SAVED OVER ANYTHING 07700 ?PRMSCN__ 20000 ;STRING CONSTANT SCANNER SCANNING MACRO PARAM 07800 ?ERSEEN__ 10000 ;A SYNTAX ERROR IS SEEN -- NO MORE ERROR MESSGS. 07900 ?NOCRFW__ 4000 ;NO CREF NOW -- EXTERNAL PROCD. BEING DEFINED. 08000 ?BAKSCN__ 2000 ;THE SCANNER IS BACK ONE SYMBOL FOR ERROR 08100 ;RECOVERY. PARSE/SEMANTIC TOKENS ARE IN SAVPAR,SAVSEM 08200 ?PRODEF__ 1000 ;USED BY DECLARATION CODE TO SENSE AN IDLIST 08300 ?CREFSW__ 400 ;WE ARE CREFFING THIS LOSING FILE. 08400 ?NOMACR __ 200 ;DO NOT EXPANT MACROS. 08500 ?LPPROG__ 100 ;LEAP FOREACH LIST IN PROGRESS 08600 ?PRMXXX__ 40 ;SPECIAL FLAG FOR SCANNER (MACRO PARAMS) 08700 ?ALLOCT__ 20 ;REALLY ALLOCATE WHEN CALLING TOTAL&ALOT 08800 ?FFTEMP__ 10 ;A REAL-LIVE TEMPORARY BIT!! 08900 ?MAINPG__ 4 ;THIS IS A MAIN (NOT PROCEDURE) PROGRAM 09000 ?BINARY__ 2 ;BINARY FILE OPEN 09100 ?LISTNG__ 1 ;LISTING FILE OPEN 09200 09300 ^ERSEEN_ERSEEN ;FOR UUO HANDLER. 09400 09500 ; RIGHT HALF -- USED BY TOTAL (SEE MACRO GENMOV) FOR DIRECTIVE BITS. 09600 09700 09800 09900 BIT2DATA (SYMBOLIC SEMBLK INDICES) 10000 10100 ?%TBUCK __0 ;BUCKET TIE IN FIRST WORD 10200 ?%TLINK __0 ;LINK TIE IN LEFT HALF OF FIRST WORD 10300 ?%STEMP __0 ;SAVE TTEMP IN PROCEDURE BLOCK (2D) 10400 ?$PNAME __1 ;PRINT NAME POINTER 10500 ?$DATA __1 10600 ?%SAVET __1 ;SAVE TTOP,,TPROC IN 2D PROCEDURE BLOCK 10700 ?$DATA2 __2 10800 ?$NPRMS __2 ;SAVE #STRING PARAMS,#OTHER PARAMS IN 2D PROC BLK 10900 ?$TBITS __3 ;TYPE BITS WORD 11000 ?$DATA3 __3 11100 ?$BLKLP __3 ;IN 2D PROC BLOCK, SAVE BLKLIM (LOWEST INDEX TO BLKLIS) 11200 ^$PNAME __$PNAME ;STRING GARBAGE COLLECTOR HAS TO KNOW 11300 ?$SBITS __4 ;SEMANTIC BITS WORD 11400 ?$DATA4 __4 11500 ?$ADR __5 ;FIXUP ADDRESSES 11600 ?$ACNO __6 ;NUMBER OF DIMENSIONS, AC NUMBER 11700 ?$VAL __7 ;FIRST VALUE WORD 11800 ?$VAL2 __10 ;SECOND VALUE WORD 11900 ?%RVARB __11 ;VARB RING WORD 12000 ?%RSTR __12 ;STRING RING WORD 12100 12200 12300 12400 ?BUKLEN__=13 ;GOOD KIND OF NUMBER FOR BUCKET LENGTH 12500 ?BLKLEN__=11 ;LENGTH OF SYMBOL TABLE BLOCKS 12600 ?STCNBK__ 1 ;IDENTIFIERS FOR VARIOUS BUCKETS 12700 ?CONBK __ 2 12800 ?SYMBK __ 3 12900 13000 NOTENX < 13100 ;INTERRUPT BITS 13200 ?INTPOV__200000 ;RH BIT -- PDL OV - OBSOLETE BIT NOW 13300 ?IPOVIX__=19 ;POV INDEX 13400 NOEXPO < 13500 ?INTTTI__4 ;LH BIT -- USER TYPED I -- OBSOLETE BIT NOW 13600 ?ITTYIX__=15 ;INDEX OF I INTERRUPT 13700 >;NOEXPO 13800 >;NOTENX 13900 14000 TENX < 14100 ;INTERRUPT BITS 14200 ?IPOVIX__=9 ;CHANNEL FOR PDL OV INTERRUPT 14300 ?ITTYIX__5 ;CHANNEL FOR TENEX CONTROL-H INTERRUPT 14400 >;TENX 14500 14600 14700 14800 ;VARIOUS RUN-TIME DECLARATIONS. THESE PERTAIN TO THE 14900 ;CODE GENERATED. 15000 ; DON' TRY TO REDEFINE THESE --- IT TURNS OUT THAT A LOT DEPENDS ON 15100 ; THEM. (I.E. THE ABILITY TO CALL RUNTIME ROUTINES SUCH AS "CAT" AT 15200 ; COMPILE TIME). 15300 15400 ACDATA (RUN-TIME) 15500 15600 ?RP __P ;RUN-TIME PUSH DOWN STACK. 15700 ?RSP __SP ;RUN-TIME SPECIAL STACK 15800 ?RTEMP __TEMP ;RUN-TIME SUPER-TEMP 15900 16000 16100 ENDDATA 16200 00100 SUBTTL Externals, Data Allocation 00200 00300 ;THESE ARE DECLARED EXTERNAL, AND WILL BE FOUND EITHER 00400 ;IN SECOND SEGMENT OR IN THE NON-REENTRANT PART LOADED WITH 00500 ;COMPILER. 00600 00700 EXTERNAL CONFIG,GOGTAB,RPGSW,CAT,PUTCH,POW,FPOW,%RENSW 00800 EXTERNAL ALLPDP,%UUOLNK,%ALLOC,.SEG2.,CORGET,CORREL,CANINC,CAT,CVS 00900 EXTERNAL SAVE,RESTR,STRGC,CORINC ;,JOBAPR,JOBCNI,JOBTPC 01000 EXTERNAL %ARRSRT,SGREM ;FOR REMOVING %ARRSRT FROM LIST 01100 EXTERNAL .ERRP.,%ERGO,%RECOV; FOR ERR UUO 01200 EXTERNAL .ERBWD 01300 TENX< 01400 EXTERNAL $OSTYP 01500 > ;TENX 01600 PRINTX CHANGE HERE FOR DLOGS,DPOW 01700 IFN 0, 01800 01900 COMMENT  02000 All SAIL data is allocated in one or the other of these two 02100 blocks of storage. The ZERODATA and DATA commands serve to 02200 place them here via the FAIL USE pseudo-ops. Tables of constants 02300 are excepted. 02400  02500 02600 ?ZSIZE__=775 ?DSIZE__=1200 02700 ;last changed from zsize__=750 on 4-3-75 jfr 02800 ;last changed from dsize__=1150 on 10-16-76 jfr 02900 IFN FTDEBUG, < 03000 ?ZSIZE__ZSIZE+=32 ?DSIZE__DSIZE+=30 03100 > 03200 TENX < 03300 ?ZSIZE__ZSIZE+=300 ;MOSTLY FOR NAMES, A BLOCK OF 300 03400 >;TENX 03500 03600 RENC < 03700 ;EXTRA SPACE IN IMPURE CODE, MOSTLY FOR RESERVED WORD TABLE 03800 ?ZSIZE__ZSIZE+=100 03900 ?DSIZE__DSIZE+=6100 04000 04100 TWOSEG 400000 04200 >;RENC 04300 04400 ?ZBASE: BLOCK ZSIZE ;ZEROED DATA (AT BEGINNING OF RUN) 04500 SET ZVBLS,ZBASE ;2D PC 04600 04700 ?DBASE: BLOCK DSIZE ;NON-ZEROED DATA 04800 SET VBLS,DBASE ;3D PC 04900 05000 RENC < 05100 SET LSEG,DBASE+DSIZE 05200 RELOC 400000 ;UP TO PROGRAM SEGMENT 05300 >;RENC 05400 05500 00100 ZERODATA (MAIN-SEMANTICS POINTERS) 00200 00300 COMMENT  00400 I. SYMBOL TABLE BLOCKS 00500 The central data structure of SAIL is the symbol table, and related 00600 objects. Each object in the symbol table is expressed as one or two 00700 =11 word blocks, which will be called "Semblks," for "Semantics blocks," 00800 although they are not always used for semantics. These Semblks take the 00900 following form -- 01000 01100  01200 DSCR SEMBLK structure -- typical 01300 I.A Most Common Semblk Structure 01400 0 %TLINK/%TBUCK lh "other pointer" [1] 01500 rh "bucket pointer" [2] 01600 1 $PNAME if this is a named entity, first word 01700 or $DATA of string descriptor for it 01800 2 second word of string descriptor 01900 or $DATA2 02000 3 $TBITS permanent data type bits for entity 02100 or $DATA3 (INTEGER, EXTERNAL, VALUE, SAFE, etc.) 02200 4 $SBITS temporary data type bits (ARTEMP, INUSE, 02300 or $DATA4 SBSCRP, etc.)--low order 6 bits for lex. level 02400 5 $ADR lh -- for strings, fixup chain addr for 2d 02500 descriptor word 02600 rh -- fixup chain addr or displacement 02700 (param) for this variable 02800 6 $ACNO rh -- accumulator number in which this 02900 variable will be stored (at this PCNT) 03000 7 $VAL for ARITH constants, the value 03100 10 $VAL2 would be used for 2d words of DBLPRC and 03200 CMPLEX constants 03300 11 %RVARB VARB-ring pointers [3] 03400 12 %RSTR STRING-ring pointers [4] 03500  03600 ZERODATA (MAIN-SEMANTICS POINTERS) 03700 COMMENT  03800 03900 These indices and descriptions apply only to the most common uses of 04000 these Semblks -- in particular, simple variables and constants. Many 04100 others use many of the words in the same way (Procedure descriptors, 04200 Array descriptors, etc.), but use others differently. Each such Semblk 04300 will be called, simply, the "Semantics" of the thing it describes. Some 04400 Semblks use the $DATA indices instead. Others use still other symbolic 04500 or absolute indices. These divergent uses are described in the code 04600 near the routines that handle them. See the list below, and the index 04700 descriptions above for more information. 04800 04900 I.B Further explanations 05000 Some of the entries (indicated by bracketed numbers, above, need more 05100 explanation -- 05200 05300 [1]%TLINK This pointer is empty (0) for simple variables. For Procedures, 05400 it points to a second Semblk containing more information (which 05500 second Semblk points to a parameter list). For Arrays, it points 05600 to a Semblk describing the dimensions (see ARRAY). For Macros, it 05700 points to the string const. Semantics representing the macro body. Etc. 05800 [2]%TBUCK This pointer refers to the next symbol in the same hash bucket 05900 (see SYMTAB, below) 06000 [3]%RVARB This is used to tie a symbol to those declared with it. 06100 It contains in its lh a pointer to the previous one, 0 if it 06200 is the oldest; in rh it contains a pointer to the next (in order 06300 of entry). This two-way pointer structure we (erroneously) call 06400 a "Ring". One adds a Semblk to a Ring using one of several RNGxxx 06500 routines at the end of SYM, whose parameters are the new Semblk. 06600 One removes a Semblk via some URGxxx routines in the same area. 06700 Most RINGing is done in ENTERS; most ULINKing in DONES 06800 and ALOT. For local declarations, the Varb Ring links 06900 Semantics of all identifiers declared in the same Block head. For 07000 formal declarations, it ties together all the parameters of a 07100 Procedure. VARB is usually the RING variable for %RVARB Rings. 07200 Often, another pointer is kept for the old (left) end. Each 07300 instance is described when its Semblk-type is completely described. 07400 [4]%RSTR A Ring identical in form to the %RVARB Ring. Links all Semblks 07500 with non-constant string descriptors in them for STRNGC. STRRNG is 07600 the RING variable for %RSTR. Thus STRNGC traverses it rt. to left. 07700 07800 I.C Other Common Semblk Usages 07900 These Semblks are used in a few applications as other than 08000 Semantics. Here are the most common ones -- 08100 08200 I.C.1 Buckets. 08300 The symbol table is accessed associatively via these bucket Semblks. Each 08400 contains pointers to 20 buckets (pointer chains, linked through %TBUCK). 08500 There are hashing functions in ENTERS to select, for any variable name, 08600 (or arithmetic value), the proper bucket chain during LOOKUP operations. 08700 There are three completely independent bucket Semblks; SYMTAB points to 08800 the one for identifiers, STRCON to the one for string constants, 08900 and CONST to that for arithmetic variables. 09000 09100 The rh of the last word of the Semblk (SYMTAB only) points to a previous 09200 bucket Semblk (see SYMTAB). 09300 09400 I.C.2 Qstacks 09500 There are stack-like applications in the compiler, where the maximum 09600 size of the stack may vary greatly from compilation to ditto. 09700 Therefore a kind of stack called a Qstack was implemented. Each 09800 Qstack is a list of these Semblks, with the forward/backward links 09900 in the first word of each, data in the rest. The macros QPUSH, 10000 QPOP, QTAK, QBACK, QBEGIN and QFLUSH are used to operate on the 10100 stacks. Each takes as at least one argument a pointer to a "Qstack- 10200 Descriptor", whose lh is a pointer to the current top of stack, and whose 10300 rh is a pointer to the Semblk containing the top. See QPUSH, etc. for 10400 calling sequences, the BPUSH, etc. routines for more detailed descriptions. 10500 Many of the stack descriptors are declared just below; the rest are found 10600 near the code which uses them. 10700 10800 I.D Semblk Allocation 10900 The GETBLK macro calls a routine to get the address of a free Semblk 11000 into LPSA. The FREBLK macro is used to return a Semblk to free storage. 11100 11200 00100 II. SEMANTICS VARIABLES 00200 00300 These variables (or tables) contain pointers to Semblks. They form 00400 the base for the SAIL data structures. 00500  00600 00700 COMMENT  00800 ACKTAB -- Each entry is either 0 (nothing in this AC) or -- 00900 rh -- ptr to Semantics of something which can reside in an AC 01000 (arith, pointer to Array elt., pointer to string dscr, etc.) 01100 This means that the code currently being generated has 01200 loaded the AC with the indicated entity, and can refer 01300 to it there. If the Semantics is a variable (named), a copy 01400 will also exist in core. Otherwise it is a temp value found 01500 only in the AC. 01600 The $SBITS entry of the Semantics will have the INAC bit on, 01700 or there is a mistake. Also, the $ACNO entry will contain the 01800 number of this AC. This table provides a useful redundancy. 01900 lh -- If 0, this AC can be released for another use (by clearing the 02000 table entry, modifying the $SBITS word of its Semantics, and 02100 issuing instructions to store the value in core, if necessary. 02200 If -1, this AC is being protected. Its Semantics cannot be 02300 changed until it is explicitly unprotected. 02400 The GETAC routine is called to obtain a free AC number. It uses 02500 this table. The table is also used when it is desired to free 02600 all AC's (before calling a Procedure, jumping to a label, etc.) 02700  02800 ?ACKTAB: BLOCK 20 ;THE ACCUMULATOR TABLE 02900 03000 ;ADRTAB -- RING variable or a VARB-Ring of address constant 03100 ; Semantics (see ADCINS, MAKADR, ADCGO) 03200 ?ADRTAB: 0 03300 03400 COMMENT  03500 BLKIDX -- QSTACK DESCR -- each entry in this qstack (we'll call it 03600 BLKLIS) is a completed VARB-Ring for a Block -- stack entry is 03700 ptr to oldest entry, a "Block-Semblk". These lists are transferred 03800 here when the ENDs for the Blocks are seen. ALOT, which allocates 03900 variables, uses these lists (at termination of a Procedure). See 04000 DOSYM for the reason for doing it this way. 04100  04200 ?BLKIDX: 0 ;QSTACK for completed VARB RINGS 04300 04400 ?CONINT: 0 ;VARB-Ring linking all arithmetic constants 04500 04600 ?CONST: 0 ;ptr to bucket Semblk for arithmetic constants 04700 04800 ?CONSTR: 0 ;VARB-Ring linking all string constants 04900 05000 ?DEFRNG: 0 ;VARB-ring (old end) of current macro actual params 05100 05200 ; GENLEF, GENRIG -- although these tables usually contain Semantics, 05300 ; they are described below with the PARSER structures. 05400 05500 ; LPSBOT, LPSTOP -- they define the boundaries of the last-allocated 05600 ; symbol table (Semblk) area 05700 05800 ?LPSBOT: 0 ;Address of first word of first Semblk 05900 ?LPSTOP: 0 ;Address of first word not in Semblk area 06000 06100 COMMENT  06200 MBLK is the 2d Procedure Semblk (see PROCED) for a dummy outer Procedure 06300 (initially titled "M", later changed to the program name, if there is one) 06400 which is assembled into the compiler. This Procedure descriptor, labeled 06500 IPROC (placed in PARSE by the RTRAN program) forms the base for SAIL'S 06600 lexic. structure. One non-standard feature of this descriptor is the 06700 VARB-Ring growing out of its lh %RVARB pointer. This Ring links all 06800 the assembled-in runtime Procedure Semantics (INPUT, EQU, etc.). The MBLK 06900 thing is set up as the second Semblk for IPROC at SALNIT time--since most 07000 code treats this Semblk as a regular Procedure, and access words in this 07100 second Semblk. 07200  07300 ?MBLK: BLOCK BLKLEN 07400 07500 ;NEWSYM--SCANNER returns Semantics of lookup here--see SCANNER globals below 07600 07700 ;;#GP# DCS 2-6-72 (1-4) CHECK FORWARD FORMALS AGAINST REAL FORMALS 07800 ;OLDPRM--Saves the Formal list from a FORWARD Procedure declaration during 07900 ; the scanning of the formals of the actual (or another FORWARD) proc dec. 08000 08100 ?OLDPRM: 0 ;OLD FORMAL LIST STORED HERE 08200 ;;#GP# (1) 08300 ;;#SD# IEFLAG -- set 0 if external procedure redeclared as internal 08400 ?IEFLAG: 0 08500 08600 ?STRCON: 0 ;VARB-RING FOR STRING CONSTANTS 08700 08800 ?STRRNG: 0 ;LINKS ALL SEMBLKS WITH NON-CONST STRINGS (FOR GC) 08900 09000 COMMENT  09100 SYMTAB -- points to current identifier bucket Semblk. A new copy is made at 09200 each new Block entry, and linked as described above (see Buckets). At Block 09300 exit the previous old one is restored. Since new entries are added at the 09400 beginnings of bucket lists, this "pop" operation restores the old scope of 09500 variables at Block exit. The first SYMTAB Semblk is copied from one 09600 which is assembled in via the RTRAN program, and provides (hashed) 09700 access to all reserved words and built-in Procedures. 09800  09900 ?SYMTAB: 0 10000 10100 COMMENT  10200 TPROC -- points to Semantics of Proc. being compiled (originally initialized 10300 to point at IPROC (see MBLK above). When a new Procedure name is seen, the 10400 previous TPROC and TTOP pointers are saved in its Semantics. Both 10500 are then set to point at the new Semantics. TPROC, TTOP, and their saved 10600 previous values, are used with VARB to keep track of the lexic. structure; 10700 on Block and Procedure exits, values are restored as the VARB-Rings being 10800 removed from the structure are transferred to the BLKLIS via BLKIDX(above). 10900  11000 ?TPROC: 0 11100 11200 COMMENT  11300 TTEMP -- a VARB-Ring of all the temp-Semantics currently allocated by this 11400 Procedure -- temps represent things in ACs, in the string stack, and in 11500 specially-allocated temp core addresses (depending on their $SBITS). Each 11600 Procedure has its own set of temps. See GETTMP for more information 11700 about the format of temp-Semantics. The TTEMP pointer is saved in the old 11800 TPROC Semantics when new Procedure declaration is recursively encountered. 11900 It is then reset. Restoration occurs as Procedure declarations are 12000 completed. It is for this and similar reasons that the top of the data 12100 structure is a faked Procedure (IPROC), e.g., so that the Procedure-exit 12200 code can be used to allocate the outer-Block variables. 12300  12400 ?TTEMP: 0 12500 12600 COMMENT  12700 TTOP -- points to Semantics of Block being compiled, thus to oldest end 12800 of VARB-Ring for this Block, since the Block Semantics is the first on 12900 the VARB-ring for a given Block. VARB (below) points to the other end 13000 of the same Ring. TTOP is saved in new Block Semantics before being 13100 reset to point to them. VARB is saved in there also, then reset to 0. 13200 TTOP is also saved in Procedure Semantics as described above. This allows 13300 restoration of the lexic. structure. 13400  13500 ?TTOP: 0 13600 13700 COMMENT  13800 VARB -- the RING variable for the current VARB-Ring of identifiers local 13900 to the Block being compiled (usually). TTOP points to the new end 14000 of the same ring. VARB is used to add new entries (see ENTERS routine) 14100 as declarations are encountered. It is also used to link Procedure and 14200 Macro parameters (various uses never conflict due to judicious saving). 14300  14400 ?VARB: 0 14500 00100 ZERODATA(DISPLAY REGISTER HANDLING VARIABLES) 00200 00300 00400 ?SIMPSW: 0 ;SET TO 0 IF COMPILING A SIMPLE PROCEDURE 00500 00600 ?CDLEV: 0 00700 00800 COMMENT  00900 01000 CDLEV -- the current display level. Gets bumped by one for each time 01100 a new procedure declaration is entered and gets dropped by one at the 01200 end of each such declaration. 01300  01400 01500 ?DISTAB: BLOCK 20 01600 01700 COMMENT  01800 01900 DISTAB -- table of display registers. 02000 lh(DISTAB(lev)) is ac number containing rS at time of proc call 02100 rh(DISTAB(lev)) is ac number which points at the base of the 02200 appropriate mark stack control packet. 02300 02400  02500 02600 ?DISLST:0 02700 02800 COMMENT  02900 03000 DISLST-- owns varb ring of display temps, which exist solely for the 03100 benefit of ACKTAB 03200 03300  03400 03500 ?RECSW: 0 ;SET 0 WHEN WE ARE COMPILING A RECURSIVE PROCEDURE 03600 03700 ?SSDIS: 0 ;STRING STACK DISPLACEMENT -- USED BY ALLOCATION & FRIENDS 03800 03900 ?ASDIS: 0 ;SAME FOR ARITH STACK 04000 04100 ?CSPOS: 0 ;NICE LOCAL FOR ALLOCATION 04200 04300 BITDATA(DISPLAY STUFF) 04400 04500 ?LLFLDL __6 ;SIZE OF LEX LEVEL FIELD IN SBITS 04600 ?DLFLDL __4 ;DITTO DISPLAY LEVEL 04700 ?DLFLDM _ (1DLFLDL-1)LLFLDL ;MASK FOR FIELD 04800 ?LLFLDM _ 1LLFLDL-1 04900 ?STACKV_DLFLDM ;FIELD 0 IFF VAR GOES TO STACKS (MAY BE A LIE FOR TEMPS) 05000 05100 05200 00100 ZERODATA (MAIN-SCANNER VARIABLES) 00200 00300 COMMENT  00400 PNAME -- this is a string descriptor, set up by SCANNER whenever it scans 00500 an identifier or string constant. It is used by ENTERS to provide the 00600 print name of the identifier (value of the constant). It is linked to 00700 the string garbage collector via standard string link blocks (see STRNGC 00800 routine, SALNK below). 00900  01000 ?PNAME: 0 ;XWD STRING NUM,LENGTH 01100 0 ;BYTE POINTER 01200 01300 COMMENT  01400 BITS -- As declarators (INTEGER, STRING, EXTERNAL, etc.) are encountered, 01500 the $TBITS bits corresponding to them are ORed into BITS (see TYPSET rout 01600 and friends). These bits are used by ENTERS to set up the $TBITS word 01700 of newly entered identifiers and constants. BITS is set up explicitly 01800 by some EXECS when they wish to create constants (stack-adjustors, 01900 results of constant expressions, etc.) 02000  02100 ?BITS: 0 02200 02300 02400 ?SCNVAL: 0 ;VALUE OF LAST ARITHMETIC CONSTANT SCANNED 02500 02600 ?DBLVAL: 0 ;UNUSED-WLD BE VALUE OF 2D WD-COMPLX AND DBLPRC CONSTS 02700 02800 ;DEFRNG -- see Semantics variables above 02900 03000 COMMENT  03100 NEWSYM -- SCANNER always returns 0 (not found) or found Semantics 03200 whenever it scans an identifier. ENTERS always stores the Semantics 03300 of each new symbol it enters. 03400  03500 ?NEWSYM: 0 03600 03700 03800 DATA (MAIN-SCANNER VARIABLES) 03900 04000 ;DEFPDP, DFSTRT -- PDP and base address for special DEFINE push down list 04100 ; see code in SYM (SCANNER) for its format 04200 ^^DFSTRT:0 ;ADDRESS OF STACK BASE 04300 ^^DEFPDP: 0 ;DEFINE STACK PDP 04400 04500 ;SCNWRD -- bits describing state of SCANNER (expand macros, listing, 04600 ; print PC, print line #, etc.)--usually transferred to TBITS2 AC 04700 ; when in use. Other SCANNER control bits found in FF AC. 04800 ?SCNWRD: 0 04900 ;;%DF% ! 05000 ?FMTWRD: 0 ;SWITCH SCANNER PLACES FORMAT (/F) BITS HERE 05100 ;CURRENTLY, ONLY USED FOR CHECK ON 100 BIT 05200 ?SPRBTS: 0 ;ACCUMULATE BITS FOR CHECK!TYPE FEATURE 05300 05400 COMMENT  Other variables which would seem to be in the domain of the SCANNER 05500 will be found in one of the SOURCE FILE VARIABLES areas; sometimes because 05600 they seemed more important to the I/O side than to the scanning itself; 05700 sometimes because they must be saved as a group with other variables when 05800 source files are switched via the REQUIRE ... SOURCE!FILE construct. 05900  06000 00100 ZERODATA (MAIN-PARSER VARIABLES) 00200 00300 COMMENT  00400 GENLEF, GENRIG -- assumed is an understanding of the theory and operation 00500 of the parser. Semantics pointers are put on the semantics stack (synched 00600 with the parse stack). If a production matches the top of the parse stack, 00700 the top Semantics ptr is popped into GENLEF, the next into GENLEF+1, etc. 00800 up to the number of elements on the left side of the production. Then the 00900 EXEC routines are called. These EXEC routines place appropriate Semantics 01000 in GENRIG, GENRIG+1, etc. corresponding to the new top, next. etc. stack 01100 elements. Unchanged Semantics are filled in by the parser. Thus all 01200 communication between PARSER and EXECS is accomplished via these variables. 01300 See PARLEF, PARRIG, GPSAV, PPSAV for related variables. 01400  01500 TEMLEN__10 ;LENGTH OF THESE TABLES 01600 01700 ?GENLEF: BLOCK TEMLEN ;INPUTS TO EXECS 01800 01900 ?GENRIG: BLOCK TEMLEN ;OUTPUTS FROM EXECS 02000 02100 COMMENT  02200 PARLEF, PARRIG -- same function as GENLEF, etc. for parse stack (integer 02300 tokens for terminal and non-terminal symbol. EXECS on rare occasions 02400 modify the PARRIG elements, but they are mainly used for making stack 02500 adjustments easy for the PARSER. 02600  02700 ?PARLEF: BLOCK TEMLEN ;LEFT SIDE PARSE STACK TEMPS 02800 02900 ?PARRIG: BLOCK TEMLEN ;RIGHT SIDE DITTO 03000 03100 DATA (MAIN-PARSER VARIABLES) 03200 03300 ^^GPSAV: 0 ; SEMANTICS (GENERATOR) PDP STORED HERE WHEN UNUSED 03400 ^^PPSAV: 0 ; PARSE STACK PDP STORED HERE WHEN UNUSED 03500 ?PCSAV: 0 ; CURRENT PRODUCTION CONTROL STACK POINTER 03600 ?SCWSV: 0 ; CURRENT SCANWORD STACK POINTER 03700 ?SCNNO: 1 ; CURRENT REMAINING NUMBER OF CALLS TO SCANNER 03800 ?SGPSAV: 0 ; SAIL SEMANTIC STACK POINTER 03900 ?SPPSAV: 0 ; SAIL PARSE STACK POINTER 04000 ?SPCSAV: 0 ; SAIL PRODUCTION CONTROL STACK POINTER 04100 ?SSCWSV: 0 ; SAIL SCANWORD STACK POINTER 04200 ?CGPSAV: 0 ; CONDITIONAL ASSEMBLY SEMANTIC STACK POINTER 04300 ?CPPSAV: 0 ; CONDITIONAL ASSEMBLY PARSE STACK POINTER 04400 ?CPCSAV: 0 ; COND. ASS. PRODUCTION CONTROL STACK POINTER 04500 ?CSCWSV: 0 ; COND. ASS. SCANWORD STACK POINTER 04600 ;#SN# (1 OF 8) RLS 1-1-75 MAKE EXPR!TYPE RECURSIVE 04700 ?EXPSPT: 0 ; EXPR!TYPE STACK POINTER 04800 ?PRSCON: 0 ; PARSER INITIALLY IN CONTROL - I.E. 04900 ; PRSCON=0 INDICATES SAIL IN CONTROL 05000 ; PRSCON=-1 INDICATES COND. ASS. IN CONTROL 05100 05200 TABCONDATA (SPACE-ALLOCATION DEFAULT SPECIFICATIONS) 05300 ; See GOGOL (%ALLOC) for the meaning of all the numbers 05400 ; The standard defaults can be changed by compiler switches (/P, etc.) 05500 05600 CONSIZ__=30 05700 IMSSS 05800 NOIMSSS 05900 IMSSS 06000 NOIMSSS 06100 ;#SN# (2 OF 8) MAKE EXPR!TYPE RECURSIVE 06200 IMSSS 06300 NOIMSSS 06400 06500 DEFSIZ: XWD STDSPC!SYSPD,=64 ;P-STACK 06600 XWD STDSPC!SYSSPD,=16 ;SP-STACK 06700 XWD STDSPC!STRSP,=4500 ;[05] STRING SPACE 06800 XWD WNTPDL,PSSKSZ ;PARSE STACK 06900 XWD [ASCIZ/SYNTAX STACK/],PPSAV 07000 XWD WNTPDL,PSSKSZ ;SEMANTICS STACK 07100 XWD [ASCIZ/SEMANTICS STACK/],GPSAV 07200 XWD WNTPDL,PSSKSZ ;PRODUCTION CONTROL STACK 07300 XWD 0,PCSAV 07400 XWD WNTPDL,CONSIZ ;CONDITIONAL PROD. CONTROL STACK 07500 XWD 0,CPCSAV 07600 XWD WNTPDL,CONSIZ ;CONDITIONAL SEMANTICS STACK 07700 XWD 0,CGPSAV 07800 XWD WNTPDL,CONSIZ ;CONDITIONAL PARSER STACK 07900 XWD 0,CPPSAV 08000 XWD WNTPDL,CONSIZ ;SAIL SCANWORD STACK 08100 XWD 0,SCWSV 08200 XWD WNTPDL,CONSIZ ;CONDITIONAL PARSER SCANWORD STACK 08300 XWD 0,CSCWSV 08400 XWD WNTADR!WNTPDL,DFSKSZ ;DEFINE STACK 08500 XWD [ASCIZ/DEFINE STACK/],DFSTRT 08600 ;#SN# (3 OF 8) RLS 1-1-75 MAKE EXPR!TYPE RECURSIVE 08700 XWD WNTPDL,EXSKSZ 08800 XWD 0,EXPSPT 08900 ;#SN# 09000 XWD WNTADR!WNTEND,=2200 ;SYMBOL TABLE SPACE 09100 XWD 0,LPSBOT 09200 0 ;END IT ALL 09300 09400 ZERODATA (SPACE-ALLOCATION REQUEST BLOCK) 09500 ; See GOGOL (%ALLOC) for format and use of these things 09600 09700 SPREQ: BLOCK $SPREQ ;STANDARD SIZED BLOCK FOR LEAP GARBAGE 09800 PDLMAX: 0 ;SIZE OF SYSTEM!PDL 09900 SPMAX: 0 ;SIZE OF STRING!PDL 10000 STMAXX: 0 ;SIZE OF STRING!SPACE 10100 PPMAX: BLOCK 2 ;SIZE AND POINTER ADDRESS OF PARSE STACK 10200 GPMAX: BLOCK 2 ;" OF GENERATOR STACK (SHOULD = PPMAX) 10300 PCMAX: BLOCK 2 ;SEE ABOVE 10400 CPCMAX: BLOCK 2 10500 CGPMAX: BLOCK 2 10600 CPPMAX: BLOCK 2 10700 SCWMAX: BLOCK 2 10800 CSCMAX: BLOCK 2 10900 DFMAX: BLOCK 2 ;SIZE AND POINTER ADDRESS FOR DEFINE STACK 11000 ;#SN# (4 OF 8) MAKE EXPR!TYPE RECURSIVE 11100 EXMAX: BLOCK 2 ;SIZE AND POINTER ADDRESS FOR EXPR!TYPE STACK 11200 LPSMAX: BLOCK 2 ;SIZE AND POINTER ADDRESS FOR SYMBOL TABLE SPACE 11300 0 ;NO MORE 11400 SPREND__.-1 11500 LINK 2,SPREQ ;PROVIDE THE LINK 11600 11700 11800 ZERODATA (CONDITIONAL-PARSER VARIABLES) 11900 12000 ?SWCPRS: 0 ; SWITCH PARSER FLAG 12100 ?DLMSTG: 0 ; POSSIBLY LOOKING FOR SPECIALLY DELIMITED STRINGS 12200 ; FLAG. THESE STRINGS INCLUDE MACRO BODIES AND 12300 ; BODIES OF CONDITIONAL COMPILATION WHILEC, CASEC, 12400 ; FORC, OR FORLC STATEMENTS. 12500 ?NODFSW: 0 ; FLAG TO DEFER PROCESSING OF DEFINES AFTER A BEGIN UNTIL 12600 ; A BLOCK HAS BEEN EXECUTED. 12700 ?REDEFN: 0 ; REDEFINE IN PROGRESS FLAG 12800 ?EVLDEF: 0 ; EVALDEFINE IN PROGRESS FLAG 12900 ?ASGFLG: 0 ; ASSIGNC IN PROGRESS FLAG 13000 13100 13200 DATA (CONDITIONAL-PARSER VARIABLES) 13300 13400 COMMENT  13500 RESLOC is a table containing for each parser interrupt trigger e 13600 reserved word the following information. The left half contains 13700 a set of flags which must be turned on in the left half of the 13800 $TBITS entry of the reserved word and the length of the reserved 13900 word. The right half contains the address of a byte pointer to 14000 the string. 14100  14200 14300 ?CONRES__200000 ; COND. ASS. RESERVED WORD FLAG IN LEFT HALF OF $TBITS 14400 ?DEFINT__100000 ; INDICATES PARSER INTERRUPT AND A PUSHJ TO A 14500 ; PRODUCTION WITHOUT SWITCHING PARSERS 14600 ?CONDIN__40000 ; INDICATES A PARSER INTERRUPT AND A PUSHJ TO A 14700 ; PRODUCTION IN THE CONDITIONAL PARSER 14800 ?CONBTS__CONRES+DEFINT+CONDIN ; BITS THAT ARE ON IN $TBITS OF A PARSER 14900 ; INTERRUPT TRIGGER RESERVED WORD 15000 ?NMCRES__=14 ; NUMBER OF PARSER INTERRUPT TRIGGER RESERVED WORDS 15100 ?IF0OFF_1000 ; DESIGNATES THE RIGHTMOST BIT OF THE LEFT HALF OF 15200 ; $TBITS OF A PARSER INTERRUPT TRIGGER RESERVED 15300 ; WORD WHICH CONTAINS AN INDEX INTO A TABLE 15400 ; STARTING AT PRODGO IN PARSE OF THE PRODUCTIONS TO 15500 ; WHICH ONE IS PUSHJ'ING. 15600 ?IF0SHF__=9 ; NUMBER OF BITS ONE MUST SHIFT LEFT IN ORDER TO 15700 ; UNPACK PARSER INTERRUPT INDEX FROM $TBITS OF 15800 ; THE RESERVED WORD 15900 16000 ?RESLOC: XWD CONRES+CONDIN+3,[ASCII/IFC/] 16100 XWD CONRES+5,[ASCII/ELSEC/] 16200 XWD CONRES+4,[ASCII/ENDC/] 16300 XWD CONRES+CONDIN+6,[ASCII/WHILEC/] 16400 XWD CONRES+CONDIN+5,[ASCII/CASEC/] 16500 XWD CONRES+CONDIN+4,[ASCII/FORC/] 16600 XWD CONRES+CONDIN+5,[ASCII/FORLC/] 16700 XWD CONRES+DEFINT+6,[ASCII/DEFINE/] 16800 XWD CONRES+CONDIN+4,[ASCII/IFCR/] 16900 XWD CONRES+DEFINT+10,[ASCII/REDEFINE/] 17000 XWD CONRES+DEFINT+12,[ASCII/EVALDEFINE/] 17100 XWD CONRES+DEFINT+7,[ASCII/ASSIGNC/] 17200 XWD CONRES+DEFINT+5,[ASCII/NOMAC/] 17300 XWD CONRES+DEFINT+14,[ASCII/EVALREDEFINE/] 17400 17500 COMMENT  17600 17700 %CTRUE and %CFALS are the locations containing the tokens required 17800 by TWCOND which checks the value of the compilation condition 17900  18000 18100 00100 ZERODATA (MAIN-SOURCE AND LISTING FILE VARIABLES) 00200 00300 COMMENT  00400 IPLINE -- BP to first word of file input line; used only by PARSE/DEBUG 00500 guy when scanning a macro (PLINE normally points here too, when not 00600 expanding macro). Used to print original input line when an error is 00700 detected (see also COMSER&DSPLIN). 00800  00900 ^^IPLINE: 0 01000 01100 ?PGSIZ__=50 ;# LINES/PAGE ON LISTING 01200 CMU < 01300 ?PGSIZ __ PGSIZ+5 ;CMU HAS A BETTER??? LPT SERVER 01400 >;CMU 01500 01600 ;SRCDLY -- this is a flag used to signal the command scanner and end of 01700 ; file code that a source-file switch is happening (via the 01800 ; REQUIRE .... SOURCE!FILE stuff). 01900 ?SRCDLY: 0 02000 ^^CRIND:0 ;SET IF CRLF/INDENT SEQUENCE NEEDED BEFORE NUMBER 02100 02200 02300 DATA (MAIN-SOURCE AND LIST FILE VARIABLES) 02400 02500 ;ASCLIN -- ascii value of line number for current input line, if file 02600 ; has line numbers 02700 ^^ASCLIN: 0 02800 BYTE (7) 11 ;TAB FOR LIST OUTPUT AFTER LINE NO. 02900 03000 ;LSTSTRT -- set by /nL in command line to provide an offset for 03100 ^^LSTSTRT: 0 ;display of PC in listing. 03200 03300 NOTENX < 03400 COMMENT  The address of the Stanford UINBF UUO points to a two-word block-- 03500 1 -- # buffers wanted 03600 2 -- size of each buffer. 03700 This functions identically to the INBUF UUO, except that the size of the 03800 buffer is specified exactly. In the NOEXPO system, the size for the source 03900 file is always chosen 1 bigger than needed for the largest buffer provided by 04000 any device. The last word is always set 0 by SCANNER. This serves as a flag 04100 to the SCANNER that a buffer is ended -- an efficiency measure. Therefore, 04200 in the EXPO version, this is simulated. UINBF takes in AC TEMP a pointer 04300 to a UINBF block, and allocates the buffers. (changes AC C) 04400  04500 EXPO < 04600 UINBF: ADD B,[XWD 400000,1] ;NOT USED BIT,PTR TO 2D WORD FIRST BUFFER 04700 PUSH P,B ;SAVE PTR TO BUFFER 04800 MOVEM B,SRCHDR ;PUT PTR IN BUFFER 04900 HRL C,1(TEMP) ;SIZE DESIRED 05000 MOVE TEMP,(TEMP) ;#BUFFERS 05100 UINBL: SETZM -1(B) ;CLEAR BOOKKEEPING WORD 05200 HLRS C ;SIZE,,SIZE 05300 ADDI C,2(B) ;PTR TO 2D WORD NEXT BUFFER 05400 MOVEM C,(B) ;2D WORD THIS BUFFER 05500 HRRZI B,(C) ;PTR TO NEXT BUFFER 05600 SOJG TEMP,UINBL ;DO ALL OF THEM 05700 POP P,TEMP ;PTR TO 2D WORD OF FIRST 05800 HLRZS C 05900 SUB B,C 06000 HRRM TEMP,-2(B) ;LAST PNTS TO FIRST 06100 HRRZI B,-1(TEMP) ;PTR TO 1ST WORD OF BUFFERS 06200 POPJ P, ;DONE 06300 >;EXPO 06400 >;NOTENX 06500 00100 DATA (SWITCHED VARIABLES) 00200 00300 COMMENT  00400 This area contains all data necessary to describe the state of 00500 a given source file (channel, io buffers, etc.). It is grouped 00600 together in order that it might be saved as a group, when the 00700 SCANNER switches temporarily to another source file, via the 00800 REQUIRE ... SOURCE!FILE construct. The saved groups are stored 00900 in CORGET areas allocated for the purpose. 01000 01100 The first data is the source file CDB (see MAKCDB for detailed 01200 description). It contains Device, File name, IO buffer headers, 01300 and instructions tailored for use when accessing this file (these 01400 instructions are XCTed during the OPEN sequence for the file. 01500 As the MAKCDB macro will show you, labels are generated for access 01600 to the various parts of the CDB (channel data block). 01700  01800 TENX< 01900 ?BGNSWA: 02000 >;TENX 02100 02200 02300 NOTENX < 02400 MAKCDB (SRC,SRC,0,=8,0) 02500 02600 COMMENT  02700 Some more instructions to be XCTed. These instructions are interpreted 02800 only for the source file, since this is the only case where the channel 02900 number might change. The proper channel # is deposited in the AC field 03000 of the instructions during SAIL initialization, and when switching source 03100 files. 03200  03300 ?INSRC: INPUT SRC,0 ;XCT TO DO INPUT 03400 ?EOFSRC: STATZ SRC,20000 ;TEST EOF 03500 ?RELSRC: RELEASE SRC,0 ;TO RELEASE FILE 03600 ?TSTSRC: TSTERR (SRC) ;TO TEST ERRORS 03700 03800 03900 COMMENT  04000 The command scanner (which reads compilation specs) always stores the 04100 requested file names, extensions, etc., in sixbit, into the following 04200 data block. These are used by the command scanner to open input/output 04300 files. They are also used by other routines (which call FILNAM in the 04400 command scanner to set them up) to convert strings specifying file names 04500 to this sixbit format (REQUIRE ... LOAD!MODULE, for example). 04600  04700 04800 ?DEVICE: 0 ;DEVICE NAME IN SIXBIT 04900 ?NAME: 0 ;FILE NAME 05000 EXTEN: 0 ;EXTENSION IN LH, RH UNUSED 05100 WORD3: 0 ;WORD 3 OF LOOKUP/ENTER BLOCKS, ALWAYS ZEROED 05200 ;(AT THE SAME TIME HLLZS EXTEN) 05300 ?PPN: 0 ;SPECIFIED PPN, OR 0 FOR USER DEFAULT 05400 0 ;FOR SWAP UUO? 05500 ;;#%%# BY JFR 11-7-74 PPN NOW KEPT IN CDB 05600 ;^SRCPPN: 0 ;PPN IN SIXBIT, SAVED FROM SOURCE FILE SPEC 05700 ;;=I10= ADD SFD'S 05800 SFDS< 05900 ?PATHB: BLOCK 4+SFDLVL ;PLACE FOR PATH, IF ANY 06000 > ;SFDS 06100 TYMSHR < 06200 TYMUSR: BLOCK 2 06300 >;TYMSHR 06400 06500 ; HERE ARE SOME CONTROL VARIABLES FOR THE COMMAND SCANNER 06600 06700 EOF: 0 ;END OF FILE HAS BEEN SEEN ON COMMAND FILE 06800 ?EOL: 0 ;END OF LINE HAS BEEN SEEN IN COMMAND FILE 06900 NOFILE: 0 ;NO FILE NAME WAS SEEN BY FILNAM ROUTINE 07000 ?SAVTYI: 0 ;ONE-CHAR LOOKAHEAD SOMETIMES NEEDED IN COMND 07100 07200 ; HERE ARE SOME CONTROL VARIABLES FOR THE SOURCE-SWITCHING FEATURE 07300 07400 COMMENT  07500 AVLSRC -- bit 0 for channel 0, bit 1 for channel 1, etc. 07600 contains a 1-bit for every channel which is now available as a 07700 source file channel. Since this is saved with the rest, a channel 07800 is automatically returned to the land of the free when this data 07900 is BLTed back during unswitching. 08000  08100 ;; %BC% ADD BAIL SYMBOL OUTPUTING 08200 NOBAIL < 08300 ?AVLSRC: XWD 007774,0 ;CHANNELS 6 AND ABOVE AVAILABLE (INITIALLY) 08400 >; NOBAIL 08500 BAIL < 08600 ?AVLSRC: XWD 003774,0 ;CHANNELS 7 AND ABOVE AVAILABLE ( INITIALLY) 08700 >;BAIL 08800 ;; %BC% 08900 >;NOTENX 09000 09100 TENX < 09200 ?SRCFLN: BLOCK =30 ;USED FOR THE FILE NAME, SET UP IN CC, USED IN CC, COMSER 09300 ?SRCJFN: 0 09400 ?SRCPNT: 0 09500 ?TTYSRC: 0 ;TRUE IF THIS SOURCE IS THE CONTROLLING TERMINAL 09600 ?TNXBND: 0 ;POINTER TO END OF BUFFER FOR ADVBUF 09700 >;TENX 09800 09900 ;BUFADR -- CORGET pointer to IO buffers for this source file 10000 BUFADR: 0 10100 10200 ;SWTLNK -- CORGET pointer to saved data for higher-level file (0 if outer) 10300 ^SWTLNK: 0 10400 10500 COMMENT  These variables are cleared (independently of the main 10600 cleared area) at SAIL initialization and whenever file switching 10700 occurs. 10800  10900 SLD1: ;BEGINNING OF SWITCHED-CLEARED AREA 11000 11100 COMMENT  11200 PNEXTC -- this is the byte pointer used by the SCANNER for its input. 11300 It is saved, restored, and massaged all over the place. It takes 11400 the form of the 2d word of a string descriptor, so that the garbage 11500 collector can alter it, if it represents a pointer into a macro body 11600 in string space. 11700  11800 0 ;USED BY STRINGC 11900 ?PNEXTC: 0 ;BYTE POINTER FOR SCANNER INPUT 12000 12100 ;PLINE -- BP (also string descriptor) to beginning of current input line 12200 ; IPLINE always saves PLINE for input file -- PLINE may pnt into a macro. 12300 0 ;ALSO FOR STRINGC 12400 ?PLINE: 0 ;BYTE POINTER FOR BEGINNING OF "LINE" 12500 12600 ;SAVCHR -- when an identifier is scanned, one extra character is sometimes 12700 ; read before end of identifier is determined. SCANNER always checks 12800 ; this variable for the extra character before reading any more. 12900 ?SAVCHR: 0 ;ONE-CHAR LOOKAHEAD FOR SCANNER 13000 13100 13200 BAIL< 13300 COMMENT  13400 BPNXTC -- byte pointer and flag used by debugger. Set to zero to request 13500 that the place in the input or listing file be remembered at the next 13600 token. If non-zero, then a byte pointer to the place remembered. 13700 Currently zeroed whenever a BEGIN, semicolon, or ELSE is found. 13800 Necessary because we must remember the place at the beginning of a 13900 statement but don't know whether or not we actually need a new 14000 coordinate until the end of the statement. 14100  14200 ?BPNXTC: 0 ;DEBUGGER BYTE POINTER 14300 >;BAIL 14400 14500 ; SOME FILE PARAMETERS FOR LISTING AND ERROR MESSAGE OUTPUT 14600 14700 ?FPAGNO: 0 ;PAGE NUMBER WITHIN THIS FILE 14800 ^^FPAGNO_FPAGNO ;.. 14900 ?PAGENO: 0 ;CURRENT LOGICAL PAGE NUMBER 15000 ?PAGINC: 0 ;PHYSICAL PAGE NO. WITHIN THIS LOGICAL PAGE 15100 ?BINLIN: 0 ;SEQUENTIAL LINE NUMBER WITHIN LOGICAL PAGE 15200 ^^BINLIN_BINLIN 15300 ;;#HU# ! 6-20-72 DCS BETTER TTY LISTING 15400 ^LININD: 0 ;#LEVELS TO INDENT TTY LISTING 15500 ENDSRC__.-1 ;END OF CLEARED AREA -- END OF SWITCHED AREA 15600 ;;%CF% 2! JFR 7-8-75 15700 POINT 7,.+1 ;SAIL STRING DESCRIPTOR TO STRING OF BLANKS 15800 ASCII / / 15900 16000 TENX< 16100 ;BUFFER FOR LOADER-EDITOR COMMUNICATION 16200 ;This is tenex specific because RS wanted the flexibility 16300 ZERODATA (TMPCOR BUFFER) 16400 ?TMPCBF: BLOCK 40 16500 >;TENX 16600 00100 ZERODATA (GLOBAL STATE VARIABLES) 00200 00300 COMMENT  00400 LEVEL -- starts at 0, has 1 added for each Block, named Compound Statement 00500 and Procedure declaration encountered. Decremented when corresponding 00600 END or termination of Procedure body is processed. This number is stored 00700 in $SBITS of each identifier declared at this level. It is used in 00800 resolving questions of scope (to determine if a declaration is a duplicate, 00900 if a label can be "gone to", etc.) 01000  01100 ?LEVEL: 0 01200 01300 COMMENT  01400 NMLVL -- incremented when Procedure declaration or NAMED Block or Compound 01500 Statement is seen -- decremented on termination. NMLVL is the DDT level 01600 of a variable. It is stored only in the Block (Procedure) Semantics at 01700 this level. It is placed in the level field of a Block-name loader output 01800 block for DDT -- also used to determine the order of output of symbols 01900 to DDT 02000  02100 ?NMLVL: 0 02200 02300 COMMENT  02400 PCNT -- initialized to zero, one is added for each word of code or data 02500 generated. This is the (relative) program counter, and is used to format 02600 the REL file output. 02700 If the program is being compiled into two segments, two PCNT variables 02800 are needed, one for the data (low, impure) and one for the code 02900 (high, pure). HCNT holds the current value of the "other" counter 03000 when the "other's other" is in use. 03100 HISW -- On if /H was typed to indicate a two-segment (re-entrent) 03200 compilation. 03300 INHIGH -- Irrelevant unless HISW on -- determines whether PCNT represents 03400 second segment addresses, and HCNT the low ones (ON), or vice versa. 03500  03600 03700 ?PCNT: 0 03800 REN < 03900 ?HCNT: 0 04000 ?HISW: 0 04100 ?INHIGH:0 04200 >;REN 04300 00100 ZERODATA (COUNTER SYSTEM VARIABLES) 00200 00300 COMMENT  00400 KOUNT -- set to non-zero by the presence of a /K switch. 00500 Indicates that counters are to be inserted into all loops. 00600 For each counter inserted, a marker ('177&'02") is inserted 00700 into the listing file. For counters in conditional and case 00800 expressions, a different marker ('177&'03) is inserted. 00900  01000 ?KOUNT: 0 01100 01200 COMMENT  01300 KCOUNT -- starts at zero, incremented with each counter inserted. 01400 Its final value is compiled into the object code and is used by 01500 K.FIX and K.OUT to determine how many counters there are. 01600  01700 ?KCOUNT: 0 01800 01900 COMMENT  02000 KPDP -- a QSTACK is used to hold the address of each AOS instruction 02100 that increments a counter. At the end of the compilation, after 02200 the block of counters is allocated, these locations are fixed up 02300 to point to the proper counter. 02400  02500 ?KPDP: 0 02600 00100 DATA (RANDOM GLOBAL THINGS) 00200 00300 ; String link blocks (for STRNGC) for PNAME, PNEXTC, PLINE 00400 00500 SALSTR: 1 ;FOR STRING GC -- BLOCK ALWAYS ACTIVE 00600 XWD 2,PNEXTC-1 ;PNEXTC AND PLINE 00700 SALNK: 0 ;LINK THROUGH HERE VIA 00800 LINK 1,SALNK ; LINK #1 00900 1 01000 XWD 1,PNAME ;FOR PNAME 01100 SALK1: 0 ;LINK THROUGH HERE ALSO 01200 LINK 1,SALK1 01300 01400 ;PLEVEL -- byte pointer to access level field in $SBITS of semantics pointed 01500 ; to by AC LPSA 01600 ?PLEVEL: POINT LLFLDL,$SBITS(LPSA),35 ;LEXICOGRAPHIC LEVEL 01700 01800 ?STPSAV: 0 ;STRING PDP STORED HERE WHEN UNUSED 01900 02000 ; Stack-adjusting values 02100 02200 ?X11: XWD 1,1 02300 ?X22: XWD 2,2 02400 ?X33: XWD 3,3 02500 ?X44: XWD 4,4 02600 02700 ^X11_X11 02800 ^X22_X22 02900 ^X33_X33 03000 ^X44_X44 03100 03200 ;;%CF% JFR 7-8-75 03300 IFN 0,< 03400 ^^INDTAB:0 ;INDENTING SPACES 03500 ASCIZ / / ;LEVEL 1 03600 ASCIZ / /;LEVEL 2 03700 ASCIZ / /; L 3 03800 ASCIZ / /;4 03900 0 ;SAFETY 04000 > 04100 ;;%CF% ^ 04200 04300 BAIL< 04400 BITDATA (DEBUGGER REQUEST BITS) 04500 ?BBCRD__1 ;COORDS--0 MEANS NO, 1 MEANS YES 04600 ?BBSYM__2 ;=0 JUST PROCS,PARAMS,INTERNALS; =1 ALL SYMBOLS 04700 ?BBPDSM__4 ;PD FOR SIMPLE PROC--0 MEANS NO, 1 MEANS YES 04800 ?BBUSR__10 ;=0 USE SYS:BAIL.REL, =1 LET USER PROVIDE HIS OWN 04900 ?BBPDS__20 ;=1 REQUEST SYS:BAIPDn.REL, =0 DON'T 05000 05100 ZERODATA (DEBUGGER FLAG) 05200 05300 ^^BAILON: 0 ; LEQ 0 BAIL OFF 05400 >;BAIL 05500 05600 ZERODATA (OVERLAY AND OPTIMIZATION FLAGS) 05700 ?OVRSAI: 0 ;/V SWITCH. NEQ 0 FOR GENERATING OVERLAY CODE. 05800 ; MOSTLY JUST PUTTING ALL LOADER LINKED STUFF IN 05900 ; LOW SEGMENT 06000 ?WHERSW: 0 ;/W SWITCH. NEQ 0 FOR GENERATING OPTIONAL SYMBOLS 06100 ; TO HELP EXTERNAL CODE OPTIMIZER. 06200 ?XTFLAG: 0 ;/X SWITCH. COMPILER SAVE/RESTART FACILITY 06300 06400 ;;%DN% JFR 7-1-76 06500 ?ASWITCH: 0 ;/A SWITCH, OPTIONS FOR COMPILING CODE 06600 06700 BITDATA(CODE OPTIONS) 06800 ?AKIFIX__1 ;USE KIFIX 06900 ?AFIXR__2 ;USE FIXR 07000 ?AFLTR__4 ;USE FLTR 07100 ?AADJSP__10 ;USE ADJSP 07200 ?ASWF10__20 ;%DT% USE FORTRAN-10 CALL 07300 ;;%DN% ^ 00100 ; SLS VARIABLES 00200 00300 ENDDATA 00400 00100 DATA (INITIAL PROC DESC SEMBLKS) 00200 00300 ?IPDSBK:XWD IPDASB,0 00400 0 00500 0 00600 0 00700 0 00800 0 00900 0 01000 0 01100 0 01200 0 01300 0 01400 IPDASB: XWD IPDSBK,0 01500 ;;#HH#2! 5-14-72 DCS (1-2) ACCOUNT FOR POSSIBLE /H 01600 IPDFIX: XWD 0,5 ;FIXUP FOR OUTER BLOCK STATIC LINK PUSH 01700 ;THIS MUST BE 400005 IF /H (SEE GENINI) 01800 BLOCK 5 01900 ENDDATA 02000 00100 SUBTTL Executive and Initialization 00200 DSCR LARGER, SAIL, START 00300 CAL Monitor-initialized 00400 DES Re-entry, Initial Start, and subsequent Start addresses 00500 The SAIL EXECUTIVE AND INITIALIZER -- it does these things: 00600 1. Ask for allocation info (reenter only). 00700 2. Scan command 00800 3. Initialize runtime data areas 00900 4. Initialize SAIL data areas, set up stacks, etc. 01000 5. Prepare for compilation. 01100 6. Compile a program 01200 7. Go back for more or exit or start over. 01300  01400 01500 DATA (INITIALIZATION FLAGS) 01600 01700 ^^DSKSW: 0 ;ON IF COMMAND INPUT IS NOT FROM TTY 01800 01900 ENDDATA 02000 ;EXTERNAL JOBREN, JOBVER 02100 JOBREN__124 JOBVER__137 02200 LOC JOBREN ;JOBREN _ LARGER 02300 LARGER 02400 RELOC 02500 LOC JOBVER 02600 .VERSION ;CURRENT VERSION NUMBER 02700 RELOC ;COME BACK UP 02800 00100 COMMENT Start, Ddtkil -- Once-only code to zap RAID, symbols 00200 00300 ;;#IH# 7-4-72 DCS (1-2) KEEP RAID IN CORE IMAGE, NOT IN COMPILER 00400 START sets 136 to -1, starting address to DDTKIL, and exits. 00500 DDTKIL resets starting address to SAIL, keeps track of RPG mode. 00600 Then, if 136<0, it resets JOBFF and LH(JOBSA) to $BGDDT, if present. 00700 Following this, it sets total core size to 7k above (JOBFF). It 00800 then continues into the compiler, in or out of RPG mode, depending. 00900 NOSHRK(USER) will be set as soon as possible. 01000  01100 01200 III__0 01300 NOTENX< 01400 ;%##% MAKE THIS KLUGE STANDARD FOR DEC OR STANFORD 01500 IFE FTDEBUG,< 01600 III__1 01700 ^^START: 01800 STANFORD< 01900 RENC< 02000 MOVE A,JOBVER 02100 MOVEM A,JOBHGH+JOBHVR ;COPY VERSION TO HIGH VERSION 02200 SETUWP A, ;WRITE PROTECT UPPER SGMENT 02300 HALT . 02400 INIT 1,17 ;MAKE COMPILER UPPER SEGMENT 02500 SIXBIT /DSK/ 02600 0 02700 HALT . 02800 ENTER 1,STRTDT 02900 HALT . 03000 MOVE A,JOBHRL ;400000,,MAX ADDR IN UPPER 03100 SUBI A,377777 ;400000,,LENGTH OF UPPER 03200 HRLOI A,-1(A) ;LENGTH-1,,-1 03300 EQVI A,377777 ;-LENGTH,,377777 [IOWD] 03400 SETZ B, 03500 OUT 1,A 03600 JRST .+2 03700 HALT . 03800 RELEASE 1, 03900 DATA (COMPILER SEGMENT NAME) 04000 STRTDT: SIXBIT /SAIL/ 04100 SIXBIT /SEG/ 04200 0 04300 0 04400 ENDDATA 04500 >;RENC 04600 >;STANFORD 04700 SETOM 136 04800 MOVEI TEMP,DDTKIL 04900 HRRM TEMP,JOBSA 05000 TERPRI 05100 CALL6 (1,EXIT) 05200 05300 STANFORD;RENC 05400 >;STANFORD 05500 SETZM RPGSW 05600 JRST .+3 05700 DDTKIL: JRST .-2 ;KEEP TRACK OF RPG MODE 05800 SETOM RPGSW 05900 MOVEM 17,INIACS+17 ;AND INITIAL AC CONTENTS 06000 MOVEI 17,INIACS 06100 BLT 17,INIACS+16 06200 ;;#PN# ! RHT RESET (SO JOBFF IS OK) 06300 CALL6 (RESET) ; 06400 STANFORD;RENC 07400 >;STANFORD 07500 MOVE B,JOBSA ;RESET STARTING ADDRESS (AGAIN) 07600 SKIPL 136 ;MUST WE DO ALL THIS? 07700 JRST NOKIL ;NO, JUST GO 07800 STANFO < 07900 SKIPE C,JOBDDT ;ALSO FORGET IT IF NO DDT 08000 TLNN C,-1 ; OR IF NOT NEW ENOUGH RAID 08100 JRST NOKIL 08200 HRL B,-11(C) ;RESET FREE ADDRESS 08300 >;STANFO 08400 EXPO < 08500 SKIPN C,JOBDDT ;FORGET IF NO DDT 08600 JRST NOKIL ; 08700 HRL B,JOBDDT ;GET IT FROM HERE INSTEAD 08800 >;EXPO 08900 HLRM B,JOBFF 09000 SETZM JOBSYM 09100 MOVEI C,0 09200 CALL6 (C,SETDDT) ;CLEAR OTHER GUYS 09300 NOKIL: MOVEM B,JOBSA ;UPDATE 09400 HRRZ B,JOBFF 09500 ADDI B,=1024*7 ;7K FOR INITIAL DATA 09600 CALL6 (B,CORE) ; (CORGET WON'T SHRINK IT) 09700 JRST [TERPRI 09800 CALL6 EXIT] 09900 MOVN A,RPGSW 10000 JRST SAIL(A) ;TAKE ACCOUNT OF RPG MODE 10100 >;IFE FTDEBUG 10200 ;;%##% USED TO BE NOEXPO 10300 ;;#IH# (1-2) 10400 >;NOTENX 10500 10600 TENX< 10700 III_1 10800 ^^START: 10900 JSYS RESET 11000 HRROI B,HERALD 11100 HRROI A,[ASCIZ/ Tenex SAIL 8.1 /] 11200 SETZ C, 11300 JSYS SIN ;COPY STRING 11400 MOVE A,B 11500 SETO B, 11600 MOVSI C,044441 ;"3-2-45" FOR EXAMPLE 11700 JSYS ODTIM ;COPY TIME 11800 MOVE B,A ;UPDATED BP 11900 HRROI A,[ASCIZ/ (? for help)/] 12000 SETZ C, 12100 JSYS SIN 12200 MOVEI A,SAIL 12300 HRRM A,JOBSA ;FIX UP STARTING ADDRESS 12400 HRROI A,[ASCIZ/ 12500 SSAVE pages 0 thru 577 as SAIL.SAV 12600 12700 /] 12800 SKIPE $OSTYP ;[CLH] BETTER MESSAGE FOR T20 12900 HRROI A,[ASCIZ/ 13000 SAVE as SYS:SAIL.EXE 13100 13200 /] 13300 JSYS PSOUT 13400 JSYS HALTF ;IF CONTINUES, THEN FALLS THROUGH 13500 >;TENX 13600 00100 COMMENT  Larger, Sail -- Execution Starts Here 00200 00300 ^LARGER: SETOM %RENSW ;%ALLOC WILL ASK QUESTIONS 00400 IFE III,<^^START:> 00500 ^SAIL: 00600 NOTENX < 00700 JRST [SETZM RPGSW 00800 JRST .+2] 00900 SETOM RPGSW 01000 IFE III,< 01100 MOVEM 17,INIACS+17 01200 MOVEI 17,INIACS 01300 BLT 17,INIACS+16 01400 >;IFE III 01500 SKIPE RPGSW 01600 JRST [SETNIT ;GET STACK 01700 PUSHJ P,[XINI1:SETOM DSKSW 01800 MOVE6 (CMDDEV,) ;RPG MODE -- GET COMMANDS 01900 CALLI 2,30 ;GET JOB NUMBER 02000 HRLZI TEMP,DEFEXT ;OUR NAME 02100 MOVEI 4,3 02200 FGLUP: IDIVI 2,=10 ;FRNP 02300 IORI TEMP,20(3) 02400 ROT TEMP,-6 02500 SOJG 4,FGLUP ;THREE DIGITS 02600 MOVEM TEMP,NAME ;CCL FILE NAME 02700 MOVE6 (EXTEN,) ;TEMP FILE NAME 02800 POPJ P,] 02900 JRST BEG1] 03000 03100 MOVE6 (CMDDEV,) 03200 SETZM DSKSW ;INPUT FROM TTY -- CLEAR FLAGS 03300 BEG1: SETOM CONFIG ;CONFIGURATION FOR COMPILER IS -1 03400 ;; #PS# (1 OF 2)DON'T SET UP MYERR IN .ERRP. UNTIL NEEDED 03500 SKIPE XTFLAG ;ONLY ONCE, EVER 03600 JRST BEG1XU 03700 SETZM A,.ERRP. ;ANOTHEREXTERNAL. 03800 SETZM GOGTAB 03900 ;;#XU# COMMAND-LINE ERROR MESSAGES NEED THIS 04000 SETZM .ERBWD 04100 BEG1XU: JSP P,.SEG2. ;GET A SECOND SEGMENT. 04200 ;;%AO% THIS MAY SKIP RETURN NOW 04300 CALLI ;RESET THE WORLD 04400 ;SKIP IF HAD TO SETPR2 04500 ; A CALLI IS DONE RIGHT BEFORE SETPR2 04600 04700 04800 SETNIT ;GET A UUO ADDR, AND A TEMP PUSH-DOWN STACK 04900 SETZM LSTSTRT ;ZERO LSTSTRT ON FIRST TIME AND NON-RPG RESTARTS 05000 05100 >;NOTENX 05200 TENX <;START FOR TENEX -- THIS IS SAIL 05300 SKIPA ;STANDARD STARTING ADDRESS 05400 JRST [SETNIT 05500 PUSHJ P,[XINI1: SETOM DSKSW ;CCL START 05600 SETOM RPGSW 05700 POPJ P,] 05800 JRST BEG1] 05900 SETZM DSKSW 06000 SETZM RPGSW 06100 BEG1: SETOM CONFIG 06200 SKIPN XTFLAG 06300 SETZM A,.ERRP. 06400 ;[clh] in compiler, only need to set up $OSTYP - nobody looks at $OS 06500 MOVE A,[XWD 112,11] ;GET SYSTEM TYPE 06600 CALLI A,41 ;GETTAB 06700 MOVEI A,3B23 ;FAILED, MUST BE OLD TENEX 06800 LDB A,[POINT 6,A,23] ;TYPE CODE 06900 SETZM $OSTYP ;ASSUME TENEX 07000 CAIN A,3 ;IS IT? 07100 JRST .+3 ;YES 07200 AOS $OSTYP ;NO - SET TO 2 07300 AOS $OSTYP 07400 ;[clh]^^ 07500 JSP P,.SEG2. ;GET A SECOND SEGMENT -- NO SKIP RETURN 07600 JSYS RESET 07700 SETZM BINJFN ;[clh] 07800 SETZM SM1JFN ;[clh] 07900 SETZM LISJFN ;[clh] 08000 SETNIT ;GET A UUO ADDR, STACK 08100 SETOM HISW ;DEFAULT /H COMPILATION FOR TENEX 08200 SETZM LSTSTRT ;ZERO LSTSTRT ON FIRST TIME AND NON-RPG RESTARTS 08300 >;TENX 08400 JRST XTINI3 08500 08600 COMMENT  XTENDED COMPILATION RESTART  08700 08800 NOTENX< 08900 RENC< 09000 DATA (EXTENDED COMPILATION RESTART ADDR) 09100 >;RENC 09200 EXTERNAL INIACS 09300 SETZM RPGSW 09400 JRST .+3 09500 ^^XSTART:JRST .-2 09600 SETOM RPGSW 09700 NOSTANFORD< 09800 SETZM JOBHRL ;TO CURE RACE CONDITION IN DEC 5.06 09900 >;NOSTANFORD 10000 JSP P,.SEG2. ;GRAB OUR BUDDY BACK 10100 JRST XTPR2W 10200 PUUO 3,.+2 10300 EXIT 10400 ASCIZ / 10500 NEED SEGMENT. TRY LATER./ 10600 XTPR2W: 10700 RENC< 10800 IFNDEF JOBHVR, 10900 IFNDEF JOBHGH, 11000 MOVE TEMP,JOBVER ;LOW SEGMENT VERSION 11100 CAMN TEMP,JOBHVR+JOBHGH ;SAME AS HIGH VERSION? 11200 JRST XTIN3A 11300 PUUO 3,.+2 11400 EXIT 11500 ASCIZ / 11600 LOSEG OUT OF DATE. RECOMPILE./ 11700 ENDDATA 11800 >;RENC 11900 XTIN3A: 12000 MOVSI 17,INIACS ;GET ACS BACK 12100 BLT 17,17 12200 SKIPN RPGSW 12300 JRST .+3 12400 PUSHJ P,XINI1 12500 JRST XTINI3 12600 MOVE6 (CMDDEV,) 12700 SETZM DSKSW ;INPUT FROM TTY -- CLEAR FLAGS 12800 SETZM RPGSW ;AND INDICATE SOURCE OF INPUT 12900 ;GIVE BACK CORGET BUFFER SPACE FOR SRC, REL, LST 13000 HRRZ TEMP,SRCHDR 13100 PUSHJ P,GBBUF 13200 HRRZ TEMP,BINHDR 13300 TLNE FF,BINARY 13400 PUSHJ P,GBBUF 13500 HRRZ TEMP,LSTHDR 13600 TLNE FF,LISTNG 13700 PUSHJ P,GBBUF 13800 XTINI3: 13900 >;NOTENX 14000 TENX< 14100 RENC< DATA (EXTENDED COMPILATION RESTART ADDR) 14200 >;RENC 14300 EXTERNAL INIACS 14400 SETZM RPGSW 14500 JRST .+3 14600 ^^XSTART:JRST .-2 14700 SETOM RPGSW 14800 ;[clh] in compiler, only need to set up $OSTYP - nobody looks at $OS 14900 MOVE A,[XWD 112,11] ;GET SYSTEM TYPE 15000 CALLI A,41 ;GETTAB 15100 MOVEI A,3B23 ;FAILED, MUST BE OLD TENEX 15200 LDB A,[POINT 6,A,23] ;TYPE CODE 15300 SETZM $OSTYP ;ASSUME TENEX 15400 CAIN A,3 ;IS IT? 15500 JRST .+3 ;YES 15600 AOS $OSTYP ;NO - SET TO 2 15700 AOS $OSTYP 15800 ;[clh]^^ 15900 JSP P,.SEG2. 16000 JSYS RESET ;[clh] 16100 SETZM BINJFN ;[clh] 16200 SETZM SM1JFN ;[clh] 16300 SETZM LISJFN ;[clh] 16400 JRST XTIN3A 16500 RENC< ENDDATA> 16600 XTIN3A: 16700 MOVSI 17,INIACS 16800 BLT 17,17 16900 SKIPN RPGSW 17000 JRST XTIN4A 17100 PUSHJ P,XINI1 17200 JRST XTINI3 17300 XTIN4A: SETZM DSKSW 17400 SETZM RPGSW 17500 ;;;PERHAPS ADD CODE TO GIVE BACK THE BUFFER SPACES HERE 17600 XTINI3: 17700 >;TENX 17800 00100 00200 NOTENX < 00300 ;THIS IS DONE IN TENEX COMMAND SCANNER LATER 00400 ; PRINT CRLF * 00500 00600 MOVE TEMP,[OUTSTR [PROCSR]] 00700 SKIPE XTFLAG 00800 MOVE TEMP,[OUTSTR [ASCIZ/XSAIL:/]] 00900 SKIPN RPGSW ;NO STAR IF IN RPG MODE 01000 MOVE TEMP,[OUTCHR ["*"]] 01100 XCT TEMP 01200 NOS: 01300 01400 ; GET ENOUGH OF COMMAND LINE TO BEGIN PROCESSING 01500 01600 REN< 01700 SKIPN XTFLAG 01800 SETZM HISW ;ASSUME NO TWO-SEGMENT COMPILATION 01900 >;REN 02000 ;;%BZ% ! 02100 HLLZS EXTEN 02200 SETZM WORD3 ;WORDS 3 AND 4 OF ENTER TABLE 02300 SETZM PPN 02400 ;;=I13= JFR 1-2-77 02500 DEC< 02600 CALL6 (A,GETPPN) ;get my ppn for use in filename scanning 02700 MOVEM A,MYPPN 02800 >;DEC 02900 03000 ; WILL RETURN HERE WHENEVER @ IS DETECTED FOLLOWING A FILE NAME 03100 03200 COMNIT: SETZM SAVTYI ;LOOKAHEAD CHARACTER 03300 ;;#UP# ! JFR 7-29-75 ALLOW MANUAL START AFTER RPG START 03400 SETZM CMDMOD 03500 IFN TMPCSW,< ;IF TMPCOR FEATURE AVAILABLE 03600 ;; #VO# 2! JFR 10-31-75 TMPCOR ONLY IF RPG MODE 03700 SKIPN RPGSW 03800 JRST NOTMP 03900 MOVSI A,DEFEXT ;TEMPCORE UUO FOR STANDARD DEC 04000 MOVEM A,CMDPNT ;DEC SYSTEM 04100 MOVE A,[XWD -170,CMDBUF] 04200 MOVEM A,CMDPNT+1 04300 MOVE A,[XWD 2,CMDPNT];READ AND DELETE TEMP CORE 04400 CALLI A,44 04500 JRST NOTMP ;LOOK ON DSK AS USUAL 04600 IMULI A,5 ;NUMBER OF CHARS 04700 MOVEM A,CMDCNT ;FUDGED COUNT 04800 MOVE A,[POINT 7,CMDBUF+1] 04900 MOVEM A,CMDPNT ;BYTE POINTER 05000 SETOM CMDMOD ;TO DETECT TMPCORE IN USE 05100 JRST FILEOK 05200 NOTMP: 05300 >;IFN TMPCSW 05400 RELEASE CMND,0 ;MAKE SURE FILE IS RELEASED 05500 MOVEI SBITS2,CMDCDB ;OPEN COMMAND FILE 05600 HRLI SBITS2,-1 ;INDICATE NO CORGET 05700 PUSHJ P,OPNUP ;(1 INBUF RQST IMPLIES NO CORGET, USE CMDBUF 05800 IOERR 05900 JRST TRGAIN ;LOOKUP FAILED 06000 JRST FILEOK ;ALL OK 06100 06200 TRGAIN: SKIPN RPGSW ;PRINT MESSAGE IF NOT IN RPG MODE 06300 IOERR 06400 SKIPL XTFLAG 06500 JRST SAIL ;OTHERWISE ENTER NORMAL TTY MODE 06600 JRST XSTART 06700 >;NOTENX 06800 06900 00100 COMMENT  Morfiles -- Execution Returns Here Each New Command Line 00200 00300 FILEOK: 00400 DSCR MORFILES 00500 DES Will return here whenever another command line is wanted 00600 CAL in line 00700  00800 00900 MORFILES: 01000 SKIPGE XTFLAG 01100 JRST XINI4 01200 MOVEI FF,0 ;CLEAR FLAG WORD 01300 SETZM GOGTAB ;FORCE INITIALIZATION OF CORE AREAS 01400 ;;#XU# ! JFR 11-26-76 01500 SETZM .ERBWD 01600 01700 ; IT IS NOW SAFE (AND NECESSARY) TO CLEAR ALL THOSE VARIABLES 01800 ; DECLARED VIA ZERODATA MACRO 01900 02000 SETZM ZBASE 02100 MOVE TEMP,[XWD ZBASE,ZBASE+1] 02200 BLT TEMP,ZBASE+ZSIZE-1 ;ANY ARGUMENTS? 02300 02400 MOVE TEMP,[XWD DEFSIZ,SPREQ+$SPREQ];MOVE DEFAULTS TO REQUEST BLOCK 02500 BLT TEMP,SPREND 02600 TENX< 02700 SETOM HISW ;DEFAULT /H FOR TENEX 02800 >;TENX 02900 XINI4: 03000 MOVEI TEMP,MACLST+PCOUT+LINESO ;ASSUME THIS ABOUT LISTING 03100 MOVSM TEMP,SCNWRD 03200 ;;%DF% 03300 LSH TEMP,-=13 ;REMEMBER THIS WAY TOO 03400 MOVEM TEMP,FMTWRD 03500 ;;%DF% ^ 03600 ;RESET SRCCDB, AVLSRC IN CASE RESTART CLOBBERED IT IN SWITCH MODE 03700 SETZM SWTLNK ;NO LINKS BACK 03800 SETZM SRCDLY 03900 SETZM BUFADR 04000 ;;=I12= 1-Jan-77 to get default setting for /A, change next instruction 04100 ;;=I12= Currently 0, which gives same result as Stanford's distributed code 04200 movei temp,0 ;[CLH]default value for /A 04300 movem temp,ASWITCH ;[CLH] 04400 NOTENX < 04500 ;;#%%# ! BY JFR 11-27-74 USED TO BE 17774,,0 04600 MOVSI TEMP,3774 ;CH7 AND ABOVE AVAILABLE 04700 MOVEM TEMP,AVLSRC 04800 MOVEI TEMP,SRC 04900 FOR II_0,1 < 05000 DPB TEMP,[POINT 4,SRCOP+II,12] 05100 > 05200 FOR II_0,3 < 05300 DPB TEMP,[POINT 4,INSRC+II,12] 05400 > 05500 NOEXPO < 05600 DPB TEMP,[POINT 4,SRCOP+2,12] ;PUSHJ IF EXPO 05700 >;NOEXPO 05800 >;NOTENX 05900 ;; \UR#31\ JRL (8-9-78) DEFAULT IS FORTRAN-10 AND KI OPCODES 06000 NIH < 06100 MOVEI A,26 06200 MOVEM A,ASWITCH 06300 >;NIH 06400 ;; \UR#32\ JRL (8-10-78) DEFAULT ASWITCH 06500 UOR < 06600 MOVEI A,35 ;FORTRAN-10, ADJSP, TRUNCATE 06700 MOVEM A,ASWITCH 06800 >; UOR 06900 ;; \UR#33\ 07000 07100 PUSHJ P,COMND ;CALL COMMAND SCANNER 07200 ERR 07300 PUSHJ P,SALNIT ;INITIALIZE RUNTIM, SAIL 07400 PUSHJ P,MAKT ;PREPARE TITLE LINE 07500 ;;%DE% JFR 10-24-75 07600 MOVE LPSA,SYMTAB 07700 HRROI TEMP,1+[=15 07800 POINT 7,[ASCII/COMPILERBANNER/]] 07900 POP TEMP,PNAME+1 08000 POP TEMP,PNAME 08100 PUSHJ P,SHASH ;FIND IT IN SYMBOL TABLE 08200 MOVEI TEMP,BANMAC ;NEW BODY 08300 HRLM TEMP,%TLINK(LPSA) 08400 ;;%DE% ^ 08500 PUSHJ P,HDR ;INIT PAGE NOS., PRINT HEADING IF LISTING 08600 08700 08800 SKIPGE XTFLAG 08900 JRST XTCOPY ;WORLD LOOKS NICE, RESTORE PREVIOUS 09000 ;STATE OF FILES 09100 PUSHJ P,GENINI ;INITIALIZE GENERATORS 09200 09300 PUSHJ P,MKNSTB ; INITIALIZE NESTABLE DELIMITER TABLE 09400 QPUSH(DELSTK,REQDLM) ; INITIALIZE DELIMITER STACK TO NONE SPECIAL 09500 ; DELIMITER MODE 09600 09700 ; TURN ON CONDITIONAL ASSEMBLY RESERVED WORD FLAG BELOW 09800 HRLZI A,IF0OFF ; INITIALIZE OFFSET FOR STORING AN INDEX INTO A 09900 ; TABLE FOR ACCESSING THE ADDRESSES OF PRODUCTIONS 10000 ; WHICH ARE ENTERED BY A PUSHJ AFTER AN INTERRUPT. 10100 ; THESE INDICES ARE LOADED INTO BITS 6-8 OF THE 10200 ; $TBITS ENTRY OF THE CORRESPONDING RESERVED WORD. 10300 MOVE B,[XWD -NMCRES,RESLOC] ; SET UP LOOP 10400 CONAGN: MOVE TEMP,(B) ; GET RESERVED WORD DESCRIPTOR 10500 TLZ TEMP,CONBTS ; TURN OFF FLAG ENTRIES IN THE BYTE POINTER 10600 HLRZM TEMP,PNAME ; LOAD RIGHT HALF OF PNAME WITH COUNT 10700 HRLI TEMP,(); FORM BYTE POINTER 10800 MOVEM TEMP,PNAME+1 ; LOAD PNAME+1 WITH BYTE POINTER 10900 MOVE LPSA,SYMTAB ; GET BASE ADDRESS OF SYMBOL TABLE 11000 PUSH P,B ; SAVE B 11100 PUSH P,A ; SAVE OFFSET 11200 PUSHJ P,SHASH ; GET THE SEMBLK ADDRESS 11300 POP P,A ; RESTORE A 11400 POP P,B ; RESTORE B 11500 HLLZ TEMP,(B) ; GET LEFT HALF OF RESERVED WORD DESCRIPTOR 11600 AND TEMP,[XWD CONBTS,0] ; REMOVE CHARACTER COUNT FROM LEFT HALF OF TEMP. 11700 TLNE TEMP,DEFINT+CONDIN ; IF THE RESERVED WORD INDICATES THAT A 11800 JRST[TDO TEMP,A ; PRODUCTION IS TO BE CALLED VIA A PUSHJ RATHER 11900 ADD A,[XWD IF0OFF,0] ; THAN A RESUME THEN SET BITS 6-8 IN $TBITS TO 12000 JRST .+1] ; REFLECT THE PRODUCTION THAT IS TO BE STARTED. 12100 IORM TEMP,$TBITS(LPSA) ; SET COND. ASSEMBLY RESERVED WORD FLAGS 12200 AOBJN B,CONAGN ; IF NOT DONE, GET NEXT 12300 12400 12500 ; SET UP PARSER STACK POINTERS WHICH ARE NOT YET BEING SET UP BY THE RUNTIME 12600 ; ROUTINES. THESE ARE THE SEMANTIC, PARSE, AND CONTROL STACK POINTERS FOR 12700 ; THE CONDITIONAL PARSER AND THE SAIL PARSER. ALSO SET UP THE CONTROL STACK 12800 ; POINTER FOR THE GENERAL PARSER. 12900 MOVE TEMP,GPSAV ; GET SAIL SEMANTIC STACK POINTER 13000 MOVEM TEMP,SGPSAV ; STORE IT 13100 MOVE TEMP,PPSAV ; GET SAIL PARSE STACK POINTER 13200 MOVEM TEMP,SPPSAV ; STORE IT 13300 MOVE TEMP,PCSAV ; SAIL PROD. CONTROL STACK POINTER 13400 PUSH TEMP,[XWD -1,RELSE] ;PARSER WILL "POPJ" TO HERE 13500 ;SEE "COMPILED PRODUCTIONS" EXPL. 13600 PUSH TEMP,[PRODGO] ; ADDRESS OF FIRST SAIL PRODUCTION 13700 MOVEM TEMP,SPCSAV ; STORE THE POINTER 13800 MOVEM TEMP,PCSAV ; FIRST CALL TO SCANNER WITH SAIL IN CONTROL 13900 ;++++ 14000 MOVE TEMP,CPCSAV ; 14100 PUSH TEMP,[CPRODGO] ; INIT OTHER PARSER TO AN ERROR MESSAGE 14200 ;; #NO SINCE SWITCHING PARSERS FOR ELSEC OR ENDC WILL POP PCSAV 14300 ;; MUST HAV TWO ENTRIES ON CPCSAV STACK TO GET ERROR MESSAGE 14400 PUSH TEMP,[CPRODGO] ; INIT OTHER PARSER TO AN ERROR MESSAGE 14500 MOVEM TEMP,CPCSAV ; 14600 ;++++ 14700 SETZM PRSCON ; DITTO 14800 QPUSH (ENDCTR,[0]) ; INITIALIZE ENDCTR STACK 14900 QPUSH (RECSTK,IFCREC) ; INITIALIZE RECSTK STACK 15000 SETOM SWCPRS ; SWITCHING PARSERS IS PERMISSIBLE 15100 MOVEI TEMP,4001 ; INITIALIZE SCNNO, SSCNNO, AND CSCNNO TO 15200 MOVEM TEMP,SCNNO ; ONE SO THAT ONE WILL NOT POP THE PCSAV 15300 PUSHJ P,SCANNER ;INITIALIZE FOR PARSERS -- ONE SCAN 15400 MOVEM SP,PPSAV ;SAVE FIRST RESULT PTR 15500 ;; #PS# WAIT TILL LAST MOMEMT TO SET UP ERROR HANDLER 15600 MOVEI TEMP,MYERR 15700 MOVEM TEMP,.ERRP. 15800 15900 JRST PARSE ;THIS HERE IS THE COMPILER! 16000 00100 00200 ; ... 00300 RELSE: MOVE TEMP,PCNT ;UPDATE LISTING OFFSET 00400 ADDM TEMP,LSTSTRT 00500 NOTENX < 00600 RELAL: RELEASE LST,0 00700 RELEASE BIN,0 00800 RELEASE SRC,0 00900 RELEASE LOG,0 01000 ;; %BC% 01100 BAIL < 01200 RELEASE SM1,0 01300 >;BAIL 01400 ;; %BC% 01500 TERPRI 01600 EOLCHK: SKIPE EOL ;SCAN UNTIL EOL COMES ON IN CASE 01700 JRST ENDCOM ; GARBAGE WAS PRESENT AT END OF 01800 PUSHJ P,WORD ; LINE 01900 JRST EOLCHK 02000 02100 ENDCOM: 02200 ;;=I06= IF THERE WAS AN ERROR IN BATCH JOB, TYPE ? 02300 DEC< 02400 SKIPLE %BATCH ;.LT. IF NOT BATCH, .EQ. IF NO ERROR 02500 OUTSTR [ASCIZ /? Error detected 02600 /] ;if error in batch job, stop it 02700 SETZM %BATCH ;reinit in case done again 02800 > ;DEC 02900 ;;=I06= ^ 03000 ;; 2! JFR 10-30-75 BETTER WAY TO FORCE EXIT FOR /X 03100 SKIPE XTFLAG 03200 JRST EXXIT ;/X ON, EXIT FORCED 03300 SKIPN DSKSW ;NOW GO BACK IF IN TTY MODE, ELSE EXIT 03400 JRST SAIL ; IF END OF FILE, ELSE 03500 SKIPN EOF ; USE NEXT LINE OF COMMAND 03600 JRST MORFILES ; FILE IF THERE IS MORE. 03700 03800 EXXIT: 03900 CALL6 (EXIT) ;STAGE LEFT. 04000 >;NOTENX 04100 TENX < 04200 EXTERNAL RUNPRG 04300 HRROI A,[ASCIZ/ 04400 End of compilation./] 04500 skipe $ostyp ;[clh] if tenex 04600 skipn tmpcnt ;[clh] or not CCL 04700 JSYS PSOUT ;[clh] give the message 04800 hrroi a,[asciz/ 04900 /] 05000 jsys psout ;[clh] always need crlf 05100 05200 TLNE FF,BINARY ;DONT LOAD IF NO BINARY 05300 SKIPN LODMOD ;LOAD IMMEDIATELY? 05400 JRST CLOZZZ ;NO 05500 05600 MOVEI A,400000 ;THIS FORK 05700 SETO B, 05800 JSYS DIC 05900 JSYS CIS 06000 MOVEI A,10 ;CONTROL-H INTERRUPT 06100 JSYS DTI ;DEASSIGN TERMINAL CODE 06200 06300 SETZM TMPCBF 06400 MOVE A,[XWD TMPCBF,TMPCBF+1] 06500 BLT A,TMPCBF+37 06600 HRROI B,TMPCBF 06700 SETZ C, 06800 HRROI A,[SLOLOD] 06900 JSYS SIN ;COPY OVER THE SAILOW NAME 07000 HRROI A,[ASCIZ/DSK:/] ;ASSUME NO DDT 07100 SKIPE LODDDT ;WANT A DDT? 07200 HRROI A,[ASCIZ@/DDSK:@] 07300 JSYS SIN ;COPY OVER 07400 MOVE A,B ;DESTINATION DESIGNATOR 07500 HRRZ B,BINJFN 07600 MOVE C,[1B8+1B11+1B35] ;SAY NAME.EXT 07700 JSYS JFNS ;COPY RELFILE NAME 07800 MOVE B,A ;DESTINATION DESIGNATOR 07900 IMSSS< 08000 SKIPN LODSDT ;WANT SDDT? 08100 JRST NOSDT ;NOPE 08200 HRROI A,[SDTLOD] 08300 SETZ C, 08400 JSYS SIN 08500 NOSDT: 08600 >;IMSSS 08700 HRROI A,[ASCIZ @/G 08800 @] 08900 SETZ C, 09000 JSYS SIN 09100 SETO A, 09200 JSYS CLOSF ;CLOSE ALL FILES 09300 JFCL ;ERROR RETURN 09400 IMSSS < 09500 SETO A, 09600 MOVEI B,TMPCBF 09700 JSYS PTINF ;PASS INFO TO THE LOADER 09800 JFCL ;ERROR RETURN 09900 >;IMSSS 10000 NOIMSSS< 10100 ZERODATA 10200 CCLLOD: BLOCK 3 10300 ENDDATA 10400 JSYS GJINF ;GET THE JOB NUMBER 10500 MOVEM C,B ;SAVE THE JOB NUMBER IN B 10600 HRROI A,CCLLOD 10700 MOVE C,[XWD 140003,12] ;DECIMAL, FIELD LENGTH 3, LEADING ZEROS 10800 JSYS NOUT 10900 JFCL 11000 GSYSIN ;[CLH] TENEX/T 20 11100 MOVE B,[LODTFN]+1(SYSIND) ;[CLH] LOADER TMP FILE NAME 11200 EXCH B,A ;[CLH] A HAS DEST BP. Problem is that 11300 ;[CLH] SYSIND is B, so old code failed 11400 SETZ C, ;COPY UNTIL NULL BYTE 11500 JSYS SIN 11600 MOVSI A,400001 ;WRITING, BP IN 2 11700 HRROI B,CCLLOD 11800 JSYS GTJFN 11900 ERR ,1 12000 MOVE B,[XWD 70000,100000] 12100 JSYS OPENF 12200 ERR ,1 12300 SETZ C, 12400 HRROI B,TMPCBF 12500 JSYS SOUT 12600 JSYS CLOSF 12700 JFCL 12800 >;NOIMSSS 12900 PUSH P,[1] ;CCL MODE 13000 PUSH P,[0] ;THIS FORK 13100 EXCH SP,STPSAV 13200 GSYSIN ;[clh] 13300 PUSH SP,LODDER(SYSIND) ;[clh] 13400 PUSH SP,LODDER+1(SYSIND) ;[clh] 13500 PUSHJ P,RUNPRG 13600 EXCH SP,STPSAV ;CANNOT GET HERE AT ALL 13700 JRST SAIL ;ERROR RETURN 13800 13900 CLOZZZ: SETO A, 14000 JSYS CLOSF 14100 JFCL 14200 ;; 2! JFR 10-30-75 BETTER WAY TO FORCE EXIT IF /X 14300 SKIPE XTFLAG 14400 JRST EXXIT 14500 JRST SAIL 14600 EXXIT: JSYS HALTF 14700 JRST .-1 14800 14900 LODDER: RUNLOD 15000 15100 15200 15300 >;TENX 15400 15500 00100 COMMENT  Salnit -- Storage Initialization, Etc. 00200 This routine handles steps 2-5 of the initializing procedure  00300 ^SALNIT: 00400 NOGEN 00500 00600 SKIPGE XTFLAG 00700 JRST XTINI2 00800 ; INITIALIZE RUNTIME DATA AREAS 00900 POP P,GENLEF ;ALLOC WILL LOSE STACK 01000 JSP 16,%ALLOC ;SET THEM UP 01100 ;;#IH#? 7-4-72 DCS (2-2) IMPROVE CORE ASSIGNMENT 01200 SETOM NOSHRK(USER) ;PREVENT CAPRICIOUS CORE RELEASE 01300 PUSH P,GENLEF ;RETURN RETURN TO STACK 01400 PUSH P,[%ARRSRT] ;REMOVE FROM GARBAGE COLLECT RING 01500 PUSHJ P,SGREM 01600 01700 01800 ; CLEAR SAIL SWITCHED DATA AREA, FF, JOBERR 01900 02000 SKIPN RPGSW ;IF NO ONE CAME BEFORE, 02100 SETZM 42 ; NO ERRORS YET 02200 TLO FF,TOPLEV!MAINPG ;MAIN PROGRAM AND MARK TOP LEVEL 02300 SETZM SLD1 02400 MOVE TEMP,[XWD SLD1,SLD1+1] ;CLEAR ANOTHER AREA 02500 BLT TEMP,ENDSRC 02600 02700 02800 ; ENABLE FOR PDL OVERFLOW INTERRUPT, SET UP TABLE TO DESCRIBE 02900 ; PROBABLE CAUSES (SEE SETPOV IN HEAD, POVTRP IN COMSER) 03000 03100 IFN 0, < ;THIS IS THE WAY IS USED TO BE -- RHT 03200 ;;#GH# DCS 2-1-72 (1-5) USE DIFFERENT INTERRUPT TO CATCH I 03300 MOVEWI JOBAPR,INTRPT ;ADDRESS OF INTERRUPT ROUTINE 03400 ;;#GH# USED TO BE POVTRP 03500 EXPO < 03600 MOVEI TEMP,INTPOV ;ENABLE FOR PDLOV ONLY 03700 CALL TEMP,['APRENB'] ;TELL THE SYSTEM 03800 >;EXPO 03900 NOEXPO < 04000 MOVE TEMP,[XWD INTTTI,INTPOV];MOVEI TEMP,INTPOV 04100 CALL6 (TEMP,INTNB) ;ENABLE FOR GOOD KIND OF INTERRUPT 04200 >;NOEXPO 04300 ;;#GH# 04400 >;IFN 0 04500 04600 XTINI2: 04700 NOTENX < 04800 ;;%AY% RHT 2-12-73 USE THE INTMAP RUNTIME ROUTINE FOR THIS 04900 EXTERN ENABLE,INTMAP 05000 NOEXPO < ;THIS TIME DO I 05100 PUSH P,[ITTYIX] 05200 PUSH P,[ITTYDO] 05300 PUSH P,[0] 05400 PUSHJ P,INTMAP 05500 PUSH P,[ITTYIX] 05600 PUSHJ P,ENABLE 05700 >;NOEXPO 05800 PUSH P,[IPOVIX] ; PDL OV 05900 PUSH P,[POVDO] 06000 PUSH P,[0] 06100 PUSHJ P,INTMAP 06200 PUSH P,[IPOVIX] 06300 PUSHJ P,ENABLE 06400 ;;%AY% 06500 >;NOTENX 06600 TENX < 06700 ;Don't use Tenex INTMAP because it saves ac's, unneeded for 06800 ;which saves TEMP itself, and plain wrong for POVDO which must set 06900 ;up TEMP for forced Debrk to itself. 07000 07100 ;First make sure we got an interrupt system. 07200 HRRZI A,400000 ;THIS FORK 07300 JSYS RIR ;READ INTERRUPT SYS. TABLE ADDR. 07400 EXTERN LEVTAB,CHNTAB,ATI,ENABLE 07500 JUMPE 2,[MOVE 2,[XWD LEVTAB,CHNTAB] ;XX'D IN GOGOL 07600 JSYS SIR ;SET INT. SYS. TABLES 07700 JRST .+1] 07800 JSYS EIR ;ENABLE INT. SYS - GENERAL TURN-ON 07900 MOVE A,[XWD 3,POVDO] ;DISPATCH VECTOR FOR PDLOV 08000 MOVEM A,IPOVIX(2) ;IPOVIX MUST BE =9 08100 MOVE A,[XWD 3,ITTYDO] ;FOR (I.E. CTRL H) 08200 MOVEM A,ITTYIX(2) ;INTMAPS DONE. ENABLES: 08300 PUSH P,[IPOVIX] 08400 PUSHJ P,ENABLE 08500 PUSH P,[ITTYIX] 08600 PUSHJ P,ENABLE ;AND THEN ACTIVATE TERMINAL INTERRUPT 08700 PUSH P,[ITTYIX] 08800 PUSH P,[10] ;TERMINAL INTERRUPT CODE FOR CTRL-H 08900 PUSHJ P,ATI 09000 >;TENX 09100 09200 09300 SKIPGE XTFLAG 09400 JRST XTINI4 09500 09600 SETPOV (P,SYSTEM!PDL -- USE /P TO INCREASE) 09700 SETPOV (SP,PARSE STACKS -- USE /R TO INCREASE) 09800 SETPOV (PNT,) 10000 ;GP__7 10100 SETPOV (7,PARSE STACKS -- USE /R TO INCREASE) 10200 SETPOV (SP-1,STRING!PDL -- USE /Q TO INCREASE) 10300 ;LATTER IS KLUDGE -- MOVSS OF WORD CONTAINING PARSE-STRING 10400 ;WARNINGS WILL BE DONE WHENEVER SP CONTAINS STRING PDP -- 10500 ;INCLUDED FOR SPEED, BUT DECIDEDLY DANGEROUS IF ACS ARE 10600 ; EVER REDISTRIBUTED 10700 10800 10900 11000 SETOM STPAGE ;DON'T STOP ON PAGE NUMBERS 11100 ; AOS SALSTR ;MARK SAIL "PROCEDURE" ACTIVE FOR STRGC 11200 MOVE USER,GOGTAB 11300 SETOM NOSHRK(USER) ;DON'T LET CORREL SHRINK CORE 11400 11500 ;SET UP INITIAL SYMBOL TABLE AND BUCKETS 11600 11700 PUSHJ P,SETBLK ;GET SYMBOL BLOCKS 11800 MOVEI LPSA,IPROC ;TOP LEVEL VARB RING 11900 ; DCS 9-21-71 12000 SETZM %RSTR(LPSA) ;CLEAR STRING RING ENTRY 12100 MOVEM LPSA,STRRNG ;PUT PROGRAM NAME BLOCK ON STRING RING 12200 ; DCS 12300 SETZM QQFLAG ;INITIALIZE UNDECLARED IDENTIFIER STUFF 12400 SETZM QQBLK ; 12500 MOVEM LPSA,VARB ;INITIAL VARB LIST 12600 MOVEM LPSA,TPROC ;TOP LEVEL PROCEDURE 12700 MOVEM LPSA,TTOP ;TOP LEVEL BLOCK 12800 MOVEI TEMP,MBLK ;GIVE TOP-LEVEL PROC A 2D BLOCK 12900 HRLM TEMP,%TLINK(LPSA) 13000 MOVEI TEMP,1 13100 MOVEM TEMP,$PNAME(LPSA) ;"M" IS DEFAULT PROGRAM 13200 MOVE TEMP,[] ; NAME 13300 MOVEM TEMP,$PNAME+1(LPSA) 13400 ;;#TN# BIG HACK 13500 MOVE TEMP,[XWD OWN,PROCED] ;MAKE THE TBITS CORRECT 13600 MOVEM TEMP,$TBITS(LPSA) 13700 ;;#TN# ^ 13800 SETZM $ACNO(LPSA) 13900 ;;%BT% 14000 MOVEI A,3 ;PCNT AT "PRDEC" 14100 HRLZM A,$VAL2(LPSA) ; 14200 HRRZM A,$ADR(LPSA) ;ALSO STARTING ADR OF "PROCEDURE" 14300 ;;%BT% ^ 14400 INITPD: MOVEI TEMP,IPDSBK 14500 MOVEM TEMP,$VAL(LPSA) 14600 SETZM $PNAME(TEMP) 14700 SETZM $PNAME+1(TEMP) 14800 ;;%BT% 14900 HRLZI A,7 15000 MOVEM A,$ACNO(TEMP) ;PCNT after mksemt 15100 ;;%BT% ^ 15200 SETZM $VAL(TEMP) 15300 SETZM $VAL2(TEMP) 15400 SETZM $ADR(TEMP) 15500 HLRZ TEMP,%TLINK(TEMP) 15600 ;;%AL% CHANGED THE INITIAL CODE SEQUENCE 15700 HRRZI A,4 ;FIXUP FOR [PDA,0] 15800 ;;#KC# 11-12-72 RHT -- FIX FOR HIGH SEGS 15900 REN < 16000 SKIPE HISW ;HIGH SEG? 16100 TRO A,400000 ;YES 16200 >;REN 16300 ;;#KC# 16400 HRRM A,$ADR(TEMP) 16500 SETZM $VAL2(LPSA) 16600 JRST ZEVB 16700 ZERV: LEFT ,%RVARB,ZSTR ;GO ALONG VARB LIST ZEROING 16800 ZEVB: HLLZS $ADR(LPSA) ;THE RIGHT THINGS 16900 JRST ZERV 17000 ZSTR: GETBLK STRCON ;BUCKET FOR STRINGS 17100 GETBLK CONST ;AND FOR NUMERIC CONSTANTS 17200 17300 GETBLK SYMTAB ;SYMBOL TABLE BUCKET 17400 HRLI LPSA,MBUCK ;INITIAL BUCKET 17500 MOVE TEMP,LPSA 17600 BLT LPSA,BLKLEN-1(TEMP) 17700 17800 ;NOW INITIALIZE QSTACK FOR COUNTER FIXUPS 17900 18000 SKIPN KOUNT ;ARE WE GOING TO PUT OUT COUNTERS 18100 JRST .+4 ;NO 18200 MOVNI A,1 ;GET A -1 18300 MOVEI LPSA,KPDP ;POINT TO THE QSTACK (EMPTY AT THIS POINT) 18400 PUSHJ P,BPUSH ;PUSH ON THE MARKER 18500 18600 ; NOW SET UP OTHER PUSH-DOWN LISTS 18700 18800 18900 MOVEM SP,STPSAV ;SAVE STRING POINTER 19000 MOVE SP,PPSAV ;AND SET UP PARSE POINTER 19100 XTINI4: HLLZ TEMP,SCNWRD ;FINISH UP THE LIST CONTROL WORD 19200 TLC TEMP,MACLST!MACEXP 19300 TLCN TEMP,MACLST!MACEXP ;BOTH EXPAND AND LIST NAMES 19400 TLO TEMP,LSTEXP ;YES 19500 19600 19700 ;;#GR# DCS 2-8-72 (1-3) MINOR FTDEBUGGER FIXES 19800 ; REMOVE ANY BREAKPOINTS SET BY FTDEBUGGER 19900 ; #GR# FIX REMOVED WHEN RAID IMPROVED 6-12-72 20000 CKLS: TLNN FF,LISTNG ;LISTING? 20100 ;;#GR# (1) 20200 MOVEI TEMP,1 ;NO, NOLIST ON, ALL OTHERS OFF 20300 MOVEM TEMP,SCNWRD ;UPDATE 20400 TLNN FF,LISTNG ;LISTING? 20500 POPJ P, ; NO 20600 MOVEI C,=50 ;GET SOME CORE FOR LISTING FILE 20700 PUSHJ P,CORGET 20800 ERR ,1 20900 MOVEM B,LSTBUF ;LOC OF LIST OUTPUT BUFFER 21000 HRLI B,440700 ;INIT BYTE POINTER 21100 MOVEM B,LPNT ;LIKE THAT 21200 ;;%EB% 21300 STSW(FTL$DBG,STANSW&FTDEBUG) 21400 IFN FTL$DBG,< 21500 MOVEI C,5*=50 21600 MOVEM C,L$CNT 21700 >;IFN FTL$DBG 21800 21900 ;;%EA% 4! JFR 1-28-77 TURN OFF SOS LINE NUMBER BITS 22000 SETZM (B) 22100 MOVSI C,(B) 22200 IORI C,1(B) 22300 BLT C,=50-1(B) 22400 POPJ P, ;RETURN FROM SAIL INIT 22500 22600 00100 COMMENT  XTCOPY, RESTORE PREVIOUS STATE OF .REL FILE  00200 NOTENX< 00300 XTCOPY: 00400 POP P,PPN ;MOVE INFO INTO LOOKUP BLOCK 00500 POP P,EXTEN 00600 POP P,NAME 00700 POP P,TMQDEV 00800 MOVEI SBITS2,TMQCDB ;INPUT CDB 00900 MOVEI TBITS2,BINCDB ;OUTPUT CDB 01000 MOVSI SBITS,() ;OUTPUT INSTR 01100 SKIPE TMQDEV 01200 PUSHJ P,XTCOP1 ;COPY OLD .REL FILE 01300 POP P,PPN 01400 POP P,EXTEN 01500 POP P,NAME 01600 POP P,TMQDEV 01700 MOVEI TBITS2,SM1CDB ;OUTPUT CDB 01800 MOVSI SBITS,() ;OUTPUT INSTR 01900 SKIPE TMQDEV 02000 PUSHJ P,XTCOP1 ;COPY OLD .SM1 FILE 02100 HRRZS XTFLAG ;RESET LEFT HALF 02200 JRST XTCONT ;GET BACK INTO SCANNER LOOP 02300 02400 XTCOP1: 02500 PUSHJ P,OPNUP ;OPEN TMQ (OLD BIN) FILE, INPUT 02600 IOERR 02700 IOERR 02800 MOVEI A,[ASCIZ/ 02900 Copying @F:@F.@F@G 03000 /] 03100 MOVEI B,-1+[ PWORD CDEV(SBITS2) 03200 PWORD CFIL(SBITS2) 03300 PLEFT CEXT(SBITS2) 03400 PWORD CPPN(SBITS2)] 03500 PUSHJ P,SPLPRT 03600 XTCLUP: SOSGE CCNT(SBITS2) ;COPY TMQ TO BIN. 03700 JRST XTCIN ;CANT USE INOUT BECAUSE DIFFERENT 03800 ILDB TEMP,CPNT(SBITS2) ;DATA STRUCTURES FOR FILES 03900 SOSG CCNT(TBITS2) ;IN COMPILER/RUNTIMES 04000 JRST XTCOUT 04100 XTCLP1: IDPB TEMP,CPNT(TBITS2) 04200 JRST XTCLUP 04300 04400 XTCIN: IN TMQ, 04500 JRST XTCLUP ;NO ERROR 04600 GETSTS TMQ,TEMP 04700 TRNE TEMP,740000 ;CHECK ERROR BITS 04800 IOERR 04900 TRNE TEMP,20000 ;CHECK EOF BIT 05000 JRST XTCDON ;YES 05100 JRST XTCLUP 05200 05300 XTCOUT: XCT SBITS ;OUT CHAN, 05400 JRST XTCLP1 ;NO ERROR 05500 IOERR 05600 JRST XTCLP1 05700 05800 XTCDON: RELEASE TMQ, 05900 HRRZ TEMP,CHDR(SBITS2) 06000 ;GIVE BACK BUFFER SPACE 06100 GBBUF: ;ENTER WITH TEMP=ADDR OF SOME BUFFER 06200 HRRZ B,(TEMP) ;ADDR OF NEXT BUFFER 06300 CAIG B,(TEMP) 06400 JRST GBBUF1 ;B IS ADDR+1 OF FIRST BUFFER 06500 MOVEI TEMP,(B) ;TRY AGAIN 06600 JRST GBBUF 06700 GBBUF1: MOVEI B,-1(B) ;FWA CORGET BLOCK 06800 JRST CORREL 06900 >;NOTENX 07000 07100 TENX< 07200 XTCOPY: 07300 BEGIN XTCOPY 07400 SKIPN BINJFN 07500 JRST NOXTB 07600 SKIPN XTBFIL 07700 IOERR 07800 PUSH P,BINJFN 07900 PUSH P,[XWD -1,XTBFIL] 08000 PUSHJ P,XTCOP1 08100 NOXTB: SKIPN SM1JFN 08200 JRST NOXTS 08300 SKIPN XTSFIL 08400 IOERR 08500 PUSH P,SM1JFN 08600 PUSH P,[XWD -1,XTSFIL] 08700 PUSHJ P,XTCOP1 08800 NOXTS: HRRZS XTFLAG 08900 JRST XTCONT 09000 XTCOP1: 09100 ;CALL TO HERE WITH PUSHJ P, 09200 ;ARGS ON STACK: -2(P) JFN TO COPY TO 09300 ; -1(P) BP TO STRING WITH SOURCE FILE NAME 09400 MOVSI 1,100001 09500 MOVE 2,-1(P) 09600 JSYS GTJFN 09700 IOERR 09800 MOVE 2,[XWD 440000,200000] ;READ, 36 BIT, MODE 0 09900 JSYS OPENF 10000 IOERR 10100 MOVEM 1,-1(P) ;PUT JFN ON STACK 10200 HRROI 1,[ASCIZ/ 10300 Copying /] 10400 JSYS PSOUT 10500 PUSH P,-1(P) 10600 PUSHJ P,DOJFNS 10700 HRROI 1,[ASCIZ/ to /] 10800 JSYS PSOUT 10900 PUSH P,-2(P) 11000 PUSHJ P,DOJFNS 11100 HRROI 1,[ASCIZ/ 11200 /] 11300 JSYS PSOUT 11400 11500 ;THOUGH SOMEWHAT SLOW, WE WILL USE BYTE IO SINCE IT IS 11600 ;MORE EASILY DONE WITHOUT BUFFERS ETC 11700 XTCLUP: MOVE 1,-1(P) ;SOURCE JFN 11800 JSYS BIN 11900 JUMPE 2,CHKEOF ;0, BETTER TEST EOF 12000 NOTEOF: MOVE 1,-2(P) ;DESTINATION JFN 12100 JSYS BOUT 12200 JRST XTCLUP 12300 12400 CHKEOF: 12500 JSYS GTSTS 12600 TLNE 2,(1B8) ;END OF FILE? 12700 JRST ISEOF ;YES 12800 SETZ 2, ;NO, CONTINUE 12900 JRST NOTEOF 13000 13100 ISEOF: MOVE 1,-1(P) 13200 JSYS CLOSF 13300 IOERR 13400 SUB P,X33 ;CLEAR STACK 13500 JRST @3(P) ;RETURN 13600 13700 13800 DOJFNS: 13900 ;CALL WITH PUSHJ 14000 ;JFN AT -1(P) 14100 MOVEI 1,100 ;PRIMARY OUTPUT 14200 MOVE 2,-1(P) 14300 SETZ 3, 14400 JSYS JFNS 14500 SUB P,X22 14600 JRST @2(P) 14700 14800 BEND XTCOPY 14900 15000 >;TENX 15100 15200 15300 SUBTTL COMMAND SCANNER DATA (CDB's) 15400 15500 00100 SUBTTL Comnd, aux. routs -- Command Scanner 00200 00300 EXTERNAL SPLPRT 00400 NOTENX < 00500 ;Everything from here to the end of SAIL has been switched out 00600 ;for TENEX except for the code at DELIM & UNSWT. A new file, CC, exists 00700 ;which should be assembled after SAIL and contains the TENEX code 00800 ;(not under a switch tho', Stanford just skips the file). 00900 BITDATA (INDICES INTO CDBS) 01000 CMOD__0 01100 CDEV__1 01200 CHED__2 01300 CHDR__3 01400 CPNT__4 01500 CCNT__5 01600 CFIL__6 01700 CEXT__7 01800 ;;#%%# BY JFR 11-7-74 PPN NOW KEPT IN CDB 01900 CPPN__10 02000 COPN__11 02100 CENT__12 02200 CSPC__13 02300 CBFS__14 02400 ;;=I10= ADD SFD'S 02500 SFDS< 02600 CPATH__16 02700 > ;SFDS 02800 ENDDATA 02900 03000 DSCR COMND and friends 03100 COMMAND SCANNER -- ALLOWS COMMANDS OF THE FORM 03200 <,FILENAME> _ FILENAME<,FILENAME>* 03300 WHERE THE STAR INDICATES ANY NUMBER OF REPETITIONS 03400 EACH FILE NAME CAN BE FORMED FROM THE FOLLOWING PATTERN: 03500 <.EXT><[PROJ,PROG]> 03600 THERE ARE SOME EXTRA RULES ABOUT WHAT MAY BE LEFT OUT 03700 IF EITHER DEVICE OR NAME MUST BE PRESENT. DSK 03800 IS ASSUMED IF DEVICE IS OMITTED. NAME MUST BE PRESENT IF 03900 EXT OR PROJ,PROG ARE USED. 04000 THE SCANNER ASSUMES .REL FOR BINARY EXTENSIONS, .LST FOR 04100 LISTING FILE EXTENSIONS, AND TRIES BOTH .GOG AND BLANK EX- 04200 TENSIONS FOR THE SOURCE FILES. 04300 04400 IF ONE OVERRIDES THE DEVICE ASSUMPTION (DSK), IT HOLDS ONLY 04500 FOR A SINGLE FILE TO THE LEFT OF THE ARROW. IT HOLDS 04600 UNTIL REPLACED ON THE RIGHT SIDE. 04700 04800 A PPN OTHER THAN 0 HOLDS ONLY FOR ONE FILE NAME 04900 05000 IT WOULD BE WISE NOT TO COUNT ON ANY BUT THE FIXED ACS 05100 AFTER RETURN FROM COMND 05200  05300 05400 DATA (COMMAND SCANNER VARIABLES) 05500 05600 COMMENT  The CDBs (Channel data blocks) specifying file parameters 05700 for all files except the source file (see SRCCDB in switched data 05800 in main SAIL data area) are located here. 05900  06000 06100 ; COMMAND FILE 06200 MAKCDB(CMND,CMD,0,1,0) 06300 06400 ; BINARY OUTPUT FILE (REL FILE) 06500 MAKCDB(BIN,BIN,10,0,=8) 06600 06700 ; TEXT OUTPUT FILE (LISTING FILE) 06800 MAKCDB(LST,LST,0,0,=8) 06900 07000 ;; %BC% 07100 BAIL < 07200 ; SYMBOL TABLE FILES 07300 MAKCDB(SM1,SM1,10,0,2) 07400 >;BAIL 07500 ;; %BC% 07600 07700 07800 XCOM< 07900 MAKCDB(TMQ,TMQ,10,=8,0) ;TEMP FOR COPYING 08000 >;XCOM 08100 08200 ; COMMAND FILE BUFFER AREA -- not taken from free storage so that 08300 ; data can be retained over multiple compilations (free storage 08400 ; reinitialized for each). OPNUP routine does the right thing 08500 ; about getting JOBFF set up right. 08600 08700 CMDBUF: BLOCK 206 ;ONE BUFFER IS ENOUGH FOR COMMAND FILE 08800 08900 ZERODATA (COMMAND SCANNER VARIABLES) 09000 09100 ;TYICORE flag -- if on, FILNAM routine gets input from PNAME+1 bp 09200 ; (for program and library requests, source file switching). Other- 09300 ; wise, from command input file 09400 ;TTYTYI, if set, causes FILNAM to get its input from the terminal. 09500 ; (this flag should be SETOM'ed at the start, SETZM'ed on return) 09600 09700 ^TYICORE: 0 09800 ^TTYTYI: 0 09900 ENDDATA 10000 10100 10200 00100 COMMENT  Opnup -- Open Files 00200 Totally subsidiary to COMND  00300 OPNUP: XCT COPN(SBITS2) ;DO AN APPROPRIATE OPEN 00400 JRST CNTOPN ;DEVICE NOT AVAILABLE 00500 00600 ; ENTER HERE TO TRY A DIFFERENT FILE NAME (SEE GETSRC AND FOLLOWING) 00700 00800 OPNAGN: MOVEW (,NAME) ;STORE NAMES FOR OTHERS 00900 MOVEW (,EXTEN) 01000 ;;#%%# BY JFR 11-7-74 KEEP TRACK OF PPN 01100 ;;=I10= BECAUSE OF SFD'S, PPN IS NOW MORE COMPLEX 01200 NOSFDS< 01300 MOVEW (,PPN) ;FETCH FROM BLOCK WHICH LOOKUP WILL MANGLE 01400 > ;NOSFDS 01500 SFDS< 01600 MOVE TEMP,PPN ;SAVE PPN - GET IT 01700 JUMPE TEMP,.+3 ;IF ZERO, IT'S OK 01800 TLNN TEMP,777777 ;IF LH NON-ZERO, ALSO OK 01900 MOVEI TEMP,CPATH(SBITS2) ;MUST BE PATH PTR, USE NEW PATH 02000 MOVEM TEMP,CPPN(SBITS2) ;NOW SAVE PPN IN NEW PLACE 02100 MOVSI TEMP,PATHB ;NOW COPY PATH BLOCK 02200 HRRI TEMP,CPATH(SBITS2) 02300 BLT TEMP,CPATH+10(SBITS2) 02400 > ;SFDS 02500 02600 XCT CENT(SBITS2) ;ENTER OR LOOKUP 02700 JRST CNTENT ;CAN'T ENTER OR LOOKUP 02800 02900 ;;#%%# BY JFR 11-7-74 KEEP TRACK OF PPN 03000 MOVEW (PPN,) ;CLOBBER THE NEGATIVE SWAPPED WORD COUNT 03100 03200 HRRZ C,CBFS(SBITS2) ;#BUFFERS 03300 IMULI C,204 ;ASSUME DISK-SIZED BUFFERS 03400 MOVEI B,CMDBUF ;ASSUME NO DYNAMIC BUFFER GRABBING 03500 JUMPL SBITS2,NGOOD ;IF NO DYNAMIC BUFFER GRABBING 03600 PUSH P,A 03700 PUSHJ P,CORGET ;NO, GET SOME BUFFERS 03800 JRST .CORERR ;WHAT? 03900 POP P,A 04000 NGOOD: MOVEM B,JOBFF ;START HERE. 04100 ADDI C,(B) ;END ADDR +1 04200 MOVEI TEMP,1(B) 04300 HRLI TEMP,(B) ;ADDR,,ADDR+1 04400 SETZM -1(TEMP) ;EVIDENCE IS GROWING 04500 BLT TEMP,-1(C) ;AHHHHHH ! 04600 04700 XCT CSPC(SBITS2) ;UINBF OR OUTBUF 04800 04900 ALLOK: AOS (P) ;SKIP 2 05000 CNTENT: AOS (P) ;SKIP 1 05100 CNTOPN: POPJ P, ;SKIP 0 05200 00100 COMMENT  Comnd Itself 00200 00300 COMND: 00400 SETZM DEVICE ;MAKE NO ASSUMPTION YET 00500 SETZM EXTEN ;BLANK EXTENSION, .REL LATER PERHAPS 00600 PUSHJ P,FILNAM ;SCAN A FILE NAME 00700 CAIE A,"@" ;INDIRECT FILE SPECIFICATION? 00800 JRST CHKPNT ;NO 00900 01000 SKIPN TEMP,DEVICE ;PREPARE TO OPEN A NEW 01100 MOVE6 (CMDDEV,) ; COMMAND FILE 01200 01300 SETOM DSKSW ;COMMANDS NOW FROM "RPG" FILE 01400 POP P,A ;TOSS OUT RETURN ADDRESS 01500 JRST COMNIT ; GO BACK AND INIT A NEW COMMAND FILE 01600 01700 CHKPNT: CAIE A,"!" ;AM I BEING REPLACED? 01800 JRST GETDST ;NO, THIS IS A NEW COMMAND 01900 02000 LODNEW: 02100 SKIPN TEMP,EXTEN ;ASSUME "DMP" UNLESS 02200 EXPO < 02300 MOVEI TEMP,0 02400 >;EXPO 02500 NOEXPO < 02600 MOVSI TEMP,'DMP' 02700 >;NOEXPO 02800 MOVEM TEMP,EXTEN 02900 SKIPN TEMP,DEVICE ;LIKEWISE "SYS" 03000 MOVE6 (DEVICE,) 03100 NOEXPO < 03200 MOVEWI WORD3,1 ;INCREMENT 1 OFF JOBSA 03300 MOVEI P,DEVICE ;CALL FOR RUNJOB 03400 CALL6 P, ;GOODB... 03500 >;NOEXPO 03600 EXPO < 03700 ;;%BZ% ! 03800 HLLZS EXTEN ;HOPE THIS WINS 03900 SETZM WORD3 04000 SETZM PPN 04100 MOVSI TEMP,1 ;STARTING INCREMENT 04200 HRRI TEMP,DEVICE ;TABLE ADDRESS 04300 CALL6 (TEMP,RUN) ;GOODB... 04400 >;EXPO 04500 04600 04700 04800 ; IF THIS IS A BINARY SPEC, INIT BINARY FILE 04900 05000 GETDST: 05100 SKIPN TEMP,DEVICE ;WAS DEVICE SPECIFIED? 05200 MOVE6 (DEVICE,) ;IF NOT, MAKE IT DSK 05300 05400 SKIPN NOFILE ;WAS A FILE SPECIFIED? 05500 JRST GTD1 ; YES 05600 CAIN A,"," ;ONLY LIST FILE? 05700 JRST NOBIN ; YES, NO BINARY 05800 SKIPN EOL ;IF EOL, ASSUME END OF DISK FILE 05900 JRST CHKARR ;OR SOMETHING, GO BACK TO SCANNING 06000 POP P,A ; SEQUENCE WHERE PROCESS CAN BE 06100 JRST RELSE ; TERMINATED (OR MAY BE EXTRA LINE) 06200 06300 GTD1: 06400 MOVEW (BINDEV,DEVICE) ;BINARY DEVICE (PROBABLY DSK) 06500 SKIPN TEMP,EXTEN ;ASSUME REL IF NOT SPECIFIED 06600 MOVE6 (EXTEN,) 06700 NOEXPO < 06800 MOVSI SBITS2,400000 ;KLUGE TO MAKE .REL FILE DUMP NEVER 06900 MOVEM SBITS2,WORD3 ; 07000 >;NOEXPO 07100 EXPO < 07200 SETZM WORD3 ;DUMP NEVER NOT FOR EXPORT 07300 >;EXPO 07400 ;;%BZ% ! FOR DATE 75 07500 HLLZS EXTEN ;HOPE THIS WINS 07600 07700 MOVEI SBITS2,BINCDB 07800 PUSHJ P,OPNUP ;OPEN BINARY FILE 07900 IOERR 08000 IOERR 08100 SETZM WORD3 08200 ;;%BZ% ! FOR DATE 75 08300 HLLZS EXTEN ;HOPE THIS WINS 08400 TLO FF,BINARY ;DENOTE BINARY FILE EXISTS 08500 ;; %BC% 08600 BAIL < 08700 SKIPG BAILON ;DOING A BAIL COMPILATION? 08800 JRST NBAIO5 ;NO 08900 ;;%DO% 1! JFR 7-5-76 USED TO ASSUME 'DSK' 09000 MOVE SBITS2,BINDEV 09100 MOVEM SBITS2,SM1DEV 09200 HRLZI SBITS2,'SM1' 09300 MOVEM SBITS2,EXTEN 09400 NOEXPO< 09500 MOVSI SBITS2,400000 ;KLUGE FOR DUMP NEVER 09600 MOVEM SBITS2,WORD3 09700 >;NOEXPO 09800 EXPO < 09900 SETZM WORD3 10000 >;EXPO 10100 MOVEI SBITS2,SM1CDB 10200 PUSHJ P,OPNUP ;OPEN AND ENTER AND ASSIGN BUFFERS 10300 IOERR 10400 IOERR 10500 SETZM WORD3 10600 ;;%BZ% ! FOR DATE 75 10700 HLLZS EXTEN ;HOPE THIS WINS 10800 NBAIO5: 10900 >;BAIL 11000 ;; %BC% 11100 CAIE A,"," ;LIST FILE? 11200 JRST CHKARR ; NO, GO ON 11300 11400 NOBIN: MOVE6 (DEVICE,) ;ASSUME DSK FOR LISTING FILE 11500 NOEXPO < 11600 MOVE6 (EXTEN,) ;AND ASSUME EXT OF .LST 11700 >;NOEXPO 11800 EXPO < 11900 MOVE6 (EXTEN,) ;AND ASSUME EXT OF .CRF 12000 >;EXPO 12100 PUSHJ P,FILNAM ;SCAN THE FILNAME 12200 SKIPE NOFILE ;IS THERE A LISTING FILE? 12300 JRST CHKARR ; NO, MUST BE FOLLOWED BY "_" 12400 ;;=I05= 12500 CAIE A,"=" 12600 CAIN A,"_" ;MUST BE ANYWAY 12700 JRST GETLST ; IS 12800 12900 CHKARR: 13000 ;;=I05= 13100 CAIE A,"_" ;IF NO "_", THERE'S AN ERROR 13200 CAIN A,"=" 13300 JRST NOLST ;NO LISTING FILE 13400 IOERR 13500 13600 GETLST: 13700 MOVEW (LSTDEV,DEVICE) ;LISTING DEVICE 13800 MOVEI SBITS2,LSTCDB 13900 PUSHJ P,OPNUP 14000 IOERR 14100 IOERR 14200 14300 TLO FF,LISTNG ;DENOTE EXISTENCE OF LST FILE 14400 BAIL< 14500 SKIPLE BAILON 14600 PUSHJ P,BFILOU ;IF BAIL ACTIVE, PUT OUT FILE INFO 14700 >;BAIL 14800 JRST GETSRC ; NOW GET SOURCE FILE (ONE ONLY AT FIRST) 14900 15000 BAIL< 15100 BFILOU: SKIPG BAILON 15200 POPJ P, 15300 SETZ SBITS, 15400 HLLM SBITS,BCORDN ;NO LONGER DOING COORDINATES 15500 PUSHJ P,VALOUT ;END PREVIOUS TABLE 15600 MOVEI SBITS,BAIFIL ;FILE INFO NOW 15700 PUSHJ P,VALOUT 15800 ;;=I10= NOW GIVE THEM THE WHOLE PATH 15900 MOVEI SBITS,4+SFDLVL ;4 WORDS FOR FILE:DEV,NAME,EXT,PPN 16000 HRL SBITS,BSRCFN ;FILE #,,# WORDS IN NAME 16100 PUSHJ P,VALOUT 16200 MOVE SBITS,DEVICE 16300 PUSHJ P,VALOUT 16400 MOVE SBITS,NAME 16500 PUSHJ P,VALOUT 16600 MOVE SBITS,EXTEN 16700 PUSHJ P,VALOUT 16800 MOVE SBITS,PPN 16900 ;;=I10= TAKE CARE OF PATH. 17000 SFDS< 17100 JUMPE SBITS,.+3 ;IF ZERO, IT'S OK 17200 TLNN SBITS,777777 ;OR IF LH NON-ZERO 17300 MOVE SBITS,PATHB+2 ;IF PTR, HERE IS REAL PPN 17400 PUSHJ P,VALOUT 17500 MOVSI TEMP,-SFDLVL ;NOW PUT OUT THE SFD'S. 17600 HRRI TEMP,PATHB+3 ;THIS IS FIRST SFD 17700 MOVE SBITS,(TEMP) ;GET THE SFD 17800 PUSHJ P,VALOUT 17900 AOBJN TEMP,.-2 ;AND TRY AGAIN IF ANY MORE 18000 > ;SFDS 18100 NOSFDS< 18200 PUSHJ P,VALOUT ;PUT OUT SIMPLE PPN 18300 > ;NOSFDS 18400 POPJ P, 18500 >;BAIL 18600 18700 ; ENTER HERE FROM SCAN WHEN EOF IS REACHED AND ANOTHER 18800 ; FILE IS NEEDED. IT IS AN ERROR IF NO MORE ARE LEFT 18900 19000 FILEIN: 19100 MOVE TBITS2,SCNWRD 19200 SKIPE SRCDLY ;IF ON, NOT END OF FILE, BUT SWITCH IN 19300 JRST GETSR2 19400 TLNE TBITS2,INSWT ;TIME TO SWITCH BACK TO PREV SOURCE FILE? 19500 JRST UNSWT ;YES 19600 GETSR2: SETZM SRCDLY ;CLEAR THIS 19700 SKIPE EOL ;ARE THERE MORE? 19800 POPJ P, ;NO 19900 JRST GETSR1 ; YES 20000 20100 NOLST: 20200 GETSRC: MOVE6 (DEVICE,) ;ASSUME DSK ONCE 20300 GETSR1: MOVSI TEMP,DEFEXT ;AND DEFAULT EXTENSION 20400 MOVEM TEMP,EXTEN 20500 PUSHJ P,FILNAM ;GET A SOURCE FILE NAME 20600 SKIPE NOFILE ;MUST BE ONE 20700 IOERR 20800 PUSH P,PPN ;SAVE PPN FOR SECOND TRY 20900 21000 EXTSPC: MOVEW (SRCDEV,DEVICE) ;SET UP DEVICE 21100 MOVEI SBITS2,SRCCDB 21200 XCT COPN(SBITS2) 21300 IOERR 21400 MOVE TEMP,EXTEN 21500 PUSHJ P,TRYSRC ;TRY EXTENSION USER SPECIFIED 21600 MOVEI TEMP,0 ; BLANK -- IF USER'S SPEC WAS BLANK 21700 PUSHJ P,TRYSRC ;LAST CHANCE 21800 ;TRYSRC DUMPS RETAD, JRSTS OKSRC ON SUCCESS 21900 ;; %CT% JFR 8-12-75 try harder 22000 TRYLST: 22100 ;;%DR% JFR 8-17-76 22200 SKIPN TEMP,SWTLNK ;SOURCEFILE SWITCHING IN PROGRESS? 22300 JRST .+4 ;CANT FIND ONE. OH WELL 22400 MOVSI TEMP,(TEMP) ;RESTORE THINGS SO MYERR WILL FIND RIGHT FILE 22500 HRRI TEMP,SRCCDB 22600 BLT TEMP,SRCPPN 22700 ERRSPL 1,[[ASCIZ/ 22800 Source file not found: @F:@F.@F@G 22900 (type to specify from TTY)/] 23000 PWORD DEVICE 23100 PWORD NAME 23200 PLEFT EXTEN 23300 PWORD PPN] 23400 ;;%DR% ^ 23500 ;;=I14= JFR 1-2-77 23600 DEC< 23700 SKIPLE %BATCH ;.gt. if batch job 23800 IOERR ;if batch, can't recover 23900 >;DEC 24000 POP P,(P) ;SAVED PPN 24100 PUSH P,TTYTYI 24200 SETOM TTYTYI 24300 ;;=I11= Bug fix - need to reset DSKSW, too 24400 PUSH P,DSKSW ;SAVE OLD VALUE 24500 SETZM DSKSW ;WE ARE GOING TO BE USING TTY 24600 PUUO 3,[ASCIZ/Source file:/] ;PROMPT 24700 PUSHJ P,GETSRC ;RECURSE 24800 JRST TRYLST ;FAILED AGAIN 24900 ;;=I11= 25000 POP P,DSKSW 25100 POP P,TTYTYI 25200 JRST KPOPJ ;SUCCESS AT LAST 25300 ;;%CT% ^ 25400 25500 25600 ;;%BZ% ! FOR DATE 75 25700 TRYSRC: HLLZM TEMP,EXTEN ;THIS IS EXTENSION TO TRY 25800 SETZM WORD3 ;CLEAN UP 25900 MOVE TEMP,-1(P) ;SAVED PPN 26000 MOVEM TEMP,PPN 26100 PUSHJ P,OPNAGN ;TRY AGAIN 26200 JFCL ;FILE ALREADY OPEN 26300 POPJ P, 26400 POP P,TEMP ;TOSS OUT RETURN ADDRESS 26500 OKSRC: 26600 MOVEM B,BUFADR ;ADDR OF I/O BUFFERS 26700 26800 ;;#HU# 6-20-72 DCS BETTER TTY LISTING 26900 SETZM CRIND ;DON'T CRLF/INDENT BEFORE NEXT 27000 SKIPE SWTLNK ;NOW TYPE NEW FILE NAME (NO CRLF IF OUTER LEVEL) 27100 TERPRI 27200 ;;%CF% JFR 7-8-75 27300 IFN 0,< 27400 MOVE TEMP,LININD ;#INDENT 3*LININD SPACES 27500 OUTSTR INDTAB(TEMP) 27600 >; IFN 0 27700 ;;%CF% ^ 27800 ;;#HU# 27900 28000 BAIL< 28100 AOS TEMP,BNSRC ;ONE MORE FILE SEEN 28200 MOVEM TEMP,BSRCFN ;AND IT'S THE CURRENT ONE! 28300 SETZM BSRCFC ;ADVBUF WILL SET IT TO 1 28400 SKIPLE BAILON 28500 PUSHJ P,BFILOU 28600 >;BAIL 28700 POP P,SRCPPN ;TOSS IT OUT 28800 ;;%CF% JFR 7-8-75 28900 PUSH P,A 29000 MOVEI A,[ASCIZ/@I@F.@F@G/] ;INDENT SPACES,SIXBIT FILE,.,SIXBIT EXT,PPN 29100 MOVEI B,-1+[PWORD LININD+1 29200 PWORD SRCFIL 29300 PLEFT SRCEXT 29400 PWORD SRCPPN] 29500 PUSHJ P,SPLPRT 29600 POP P,A ;WASN'T THAT EASY??!!! 29700 ;;%CF% ^ 29800 HRRZ B,SRCHDR ;NOW SET UP POINTERS TO INDICATE 29900 ADDI B,1 ; THAT A READ SHOULD BE DONE TO 30000 HRRM B,SRCPNT ; SCAN 30100 SETZM 1(B) ;SET FIRST REAL DATA WORD ZERO 30200 CAIN A,"," ;MUST BE COMMA OR END OF LINE 30300 JRST KPOPJ 30400 SKIPN EOL 30500 IOERR 30600 KPOPJ: AOS (P) ;GOOD RETURN 30700 POPJ P, 30800 >;NOTENX 30900 00100 COMMENT  Unswt -- End of Switched-to-File 00200 (REQUIRE SOURCE!FILE feature) -- Get back to old one, continue via 00300 Seol code in SYM 00400 00500 UNSWT: MOVE B,BUFADR ;ADDRESS OF I/O BUFFERS FOR SOURCE 00600 PUSHJ P,CORREL ;RELEASE IT 00700 MOVE B,SWTLNK ;BACK TO THIS ONE 00800 HRL TEMP,B ;BLT WORD 00900 NOTENX< 01000 HRRI TEMP,SRCCDB 01100 >;NOTENX 01200 TENX< 01300 HRRI TEMP,BGNSWA 01400 >;TENX 01500 BLT TEMP,ENDSRC 01600 SKIPN SWTLNK ;NEW ONE A SWITCHED-TO TOO? 01700 TLZ TBITS2,INSWT ;TURN OFF INSWT BIT 01800 MOVEM TBITS2,SCNWRD 01900 PUSHJ P,CORREL ;RELEASE BLOCK FOR SAVED DATA 02000 ;;#HU# 6-20-72 DCS BETTER TTY LISTING 02100 SETOM CRIND ;TYPE CRLF AND INDENT ON NEXT NUMBER 02200 ;;#HU# 02300 SETZM LSTCHR ;FOR SAFETY 02400 SETZM SAVCHR 02500 AOS (P) ;FILNAM SUCCEEDS 02600 SETOM SRCDLY ;TELL EOF GUY TO BEHAVE DIFFERENTLY (SYM) 02700 POPJ P, 02800 00100 COMMENT  Filnam 00200 00300 DSCR FILNAM subroutine 00400 PAR TYICORE -- if on, input is from command file 00500 otherwise, it is from PNAME+1 BP 00600 RES EOF or EOL from WORD 00700 NOFILE set to -1 if no filename exists, else 0 00800 DEVICE has specified name, else unchanged 00900 NAME has filename (in SIXBIT) if specified, else 0 01000 EXTEN has XWD EXT,0 if specified, else unchanged ***** 01100 WORD3=0 01200 PPN is 0 or is set to specified user 01300 DES Usually called by COMND routines during new file 01400 initialization -- also called by source file switching 01500 routines with TYICORE set. In addition, FILNAM is used 01600 by library and Rel-file request routines to convert 01700 strings to SIXBIT (also with TYICORE set) 01800 SID returns break char in "A", uses B,C,D 01900  02000 02100 NOTENX < 02200 ?FILNAM: 02300 SETZM NAME ;CLEAR EOF,EOL FLAGS, FILE TABLE ENTRIES 02400 ;;%BZ% ! DATE75 02500 HLLZS EXTEN ;FOR DATE75 (DOUBT IF NEED IT) 02600 SETZM WORD3 02700 SETZM PPN 02800 SETZM EOF 02900 SETZM EOL 03000 SETOM NOFILE ;ASSUME "NO FILE SEEN" UNTIL CONTRADICTED 03100 ;;=I10= ZERO THE PATH BLOCK (SO WE DON'T GIVE BAIL GARBAGE IF NO SFD'S) 03200 SFDS< 03300 SETZM PATHB ;ZERO THE PATH BLOCK 03400 MOVE A,[XWD PATHB,PATHB+1] ;SINCE BFILOU ASSUMES NO GARBAGE IN IT 03500 BLT A,PATHB+3+SFDLVL ;NOTE EXTRA ZERO BLOCK AT END TO TERMINATE PATH 03600 > ;SFDS 03700 03800 ; GET DEVICE (OR FILENAME) 03900 04000 PUSHJ P,WORD ;GET A FILE OR DEVICE NAME 04100 TYMSHR < 04200 TYMUSN: JUMPN B,NONTYM 04300 CAIE A,"(" ;OPENING CHAR FOR USER DIR SCAN 04400 JRST DELIM ;NO. CONTINUE SCAN. 04500 MOVEI D,TYMUSR ; 04600 HRRZM D,PPN 04700 SETZM TYMUSR+1 ;IN CASE NO SECOND PART 04800 SETZM TYMUSR 04900 MOVEI C,=12 05000 HRLI D,() 05100 SKIPG A,SAVTYI 05200 TUNLP: PUSHJ P,TYI 05300 SETZM SAVTYI 05400 SKIPE EOF 05500 JRST [PUSHJ P,SETEOL 05600 JRST TUNERR] 05700 CAIL A,140 05800 SUBI A,40 ;CONVERT UPPER TO LOWER 05900 CAIE A,")" 06000 CAIGE A,40 06100 JRST TUNEND 06200 SOJL C,TUNLP 06300 SUBI A,40 06400 IDPB A,D 06500 JRST TUNLP 06600 TUNEND: CAIN A,15 06700 PUSHJ P,FAKEOL 06800 CAIE A,")" 06900 TUNERR: IOERR 07000 PUSHJ P,WORD 07100 NONTYM: 07200 >;TYMSHR 07300 JUMPE B,DELIM ;IF NOT THERE, CHECK PROPER DELIMITER, RETURN 07400 CAIE A,":" ;A DEVICE? 07500 JRST NAMSET ; NO, MUST BE NAME 07600 MOVEM B,DEVICE ;FILE DEVICE 07700 SETZM NOFILE ; NOW WE SAW SOMETHING 07800 07900 ; GET FILE NAME 08000 08100 PUSHJ P,WORD 08200 SKIPN B ;THERE MUST BE ONE 08300 JRST [SKIPE NOFILE ;IF DEVICE ONLY, ACCEPT IT 08400 IOERR 08500 JRST DELIM] 08600 NAMSET: MOVEM B,NAME ;FILE NAME 08700 SETZM NOFILE ;WE SAW SOMETHING 08800 08900 ; GET EXTENSION IF THERE IS ONE 09000 09100 CAIE A,"." 09200 JRST CHKPPN ;NO, CHECK PROJ-PROG SPEC 09300 09400 PUSHJ P,WORD 09500 HLLZM B,EXTEN ;EXTENSION 09600 09700 ; GET PROJ-PROG NUMBER IF THERE IS ONE 09800 09900 CHKPPN: CAIE A,"[" 10000 JRST DELIM ;NONE, CHECK VALID ENDING SEQUENCE 10100 CMU < ;HANDLE CMU PPNS 10200 SKIPG A,SAVTYI ;MAYBE GET LOOKAHEAD CHAR 10300 PUSHJ P,TYI ;GET 1ST PPN CHAR 10400 MOVEM A,SAVTYI ;READY FOR DEC PPN 10500 PUSHJ P,CCVXXX ;CONVERT IT 10600 CAIL A,"A" ;LETTER? 10700 CAILE A,"Z" 10800 JRST DECPPN ;NO, BETTER BE DEC PPN 10900 SETZM SAVTYI 11000 MOVEI B,-"A"(A) ;COLLECT PPN IN B 11100 MOVEI C,3 ;SET UP FOR 3 DIGITS 11200 CMUPP1: PUSHJ P,CCVTYI ;GET DIGIT 11300 CAIL A,"0" ;MAKE SURE IT IS ONE 11400 CAILE A,"9" 11500 IOERR 11600 IMULI B,=10 ;MAKE ROOM FOR DIGIT 11700 ADDI B,-"0"(A) ;PUT IT IN 11800 SOJG C,CMUPP1 11900 ADDI B,11 ;MAKE MIN CMU PROJ BE 11 12000 HRLM B,PPN ;INSERT ACCT NO. 12100 PUSHJ P,CCVTYI ;GET 1ST LETTER OF MAN ON. 12200 CAIL A,"A" ;IS IT A LETTER? 12300 CAILE A,"Z" 12400 IOERR 12500 MOVEI B,-"A"(A) ;COLLECT MAN NO. IN B 12600 PUSHJ P,CCVTYI ;GET SECOND LETTER 12700 CAIL A,"A" ;IS IT FOR REAL? 12800 CAILE A,"Z" 12900 IOERR 13000 IMULI B,=26 ;MAKE ROOM FOR LETTER 13100 ADDI B,-"A"(A) ;INSERT IT 13200 PUSHJ P,CCVTYI ;GET NUMBER 13300 CAIL A,"0" ;CHECK IT 13400 CAILE A,"9" 13500 IOERR 13600 IMULI B,=10 ;MAKE ROOM 13700 ADDI B,-"0"(A) ;INSERT 13800 PUSHJ P,CCVTYI ;GET LAST CHAR 13900 IMULI B,=36 ;MAKE ROOM 14000 CAIL A,"A" ;LETTER? 14100 CAILE A,"Z" 14200 JRST CMUPP2 ;NO, BETTER BE DIGIT 14300 ADDI B,=10-"A"(A) ;LEAVE ROOM FOR DIGITS 14400 JRST CMUPP3 ;AROUND DIGIT CODE 14500 CMUPP2: CAIL A,"0" ;DIGIT? 14600 CAILE A,"9" 14700 IOERR 14800 ADDI B,-"0"(A) 14900 CMUPP3: HRRM B,PPN 15000 PUSHJ P,WORD ;PICK UP ] 15100 JUMPL A,PPNFIN+1 15200 JRST PPNFIN 15300 CCVTYI: PUSHJ P,TYI 15400 CCVXXX: CAIL A,"a" ;is it lower case? 15500 CAILE A,"z" ;WELL? 15600 POPJ P, ;NOT LC 15700 TRZ A,40 ;MAKE IT UC 15800 POPJ P, 15900 16000 DECPPN: 16100 >;CMU 16200 PUSHJ P,WORD ;PROJ 16300 NODEC< 16400 SKIPE B ;CAN'T BE 0 16500 CAIE A,"," ;MUST BE COMMA 16600 IOERR 16700 >;NODEC 16800 DEC< 16900 ;;=I10= FOR SFD'S WE WANT TO FOLLOW DEC STANDARD PATH FORMAT, ALLOW ZERO 17000 ; SKIPE B ;CAN'T BE 0 17100 CAIE A,"," ;MUST BE COMMA 17200 IOERR 17300 ;;=I10= SFD PATCH 17400 EXTERNAL MYPPN 17500 JUMPE B,[HLLZ B,MYPPN ;IF PROJ OMITTED, USE OURS 17600 JRST PRJDON] 17700 >;DEC 17800 PUSH P,FPOPJ ;CALL IN LINE 17900 FJUST: 18000 IFN SIXSW,< 18100 SUBI C,3 18200 SKIPGE C 18300 MOVEI C,0 18400 IMULI C,-6 18500 LSH B,(C) ;RIGHT JUSTIFY WORD IN 3 CHARACTERS 18600 >;IFN SIXSW 18700 IFE SIXSW,< 18800 MOVEI TEMP,0 18900 BACKL: MOVEI A,0 19000 LSHC A,6 ;CONVERT TO OCTAL PPN 19100 CAIL A,'0' 19200 CAILE A,'7' 19300 IOERR 19400 LSH TEMP,3 19500 IORI TEMP,-'0'(A) 19600 JUMPN B,BACKL 19700 MOVS B,TEMP 19800 >;IFE SIXSW 19900 20000 FPOPJ: POPJ P,.+1 ;ALSO CALLED BELOW 20100 20200 DEC< 20300 ;;=I10= SFD 20400 PRJDON: HLLZM B,PPN ;PROJ 20500 PUSHJ P,WORD 20600 ;;=I10= SFD 20700 ; SKIPE B 20800 SFDS< 20900 MOVE C,A ;SAVE A, THE SEPARATOR CHARACTER 21000 CAIN A,"," ;OK IF COMMA 21100 JRST .+3 ; OK 21200 > ;SFDS 21300 CAIE A,"]" ;IF 0 WORD OR NO ], ERROR 21400 IOERR 21500 JUMPE B,[HRLZ B,MYPPN ;IF NO PROG. NO, USE OURS 21600 JRST PMRDON] 21700 PUSHJ P,FJUST ;RIGHT JUSTIFY 21800 PMRDON: HLRM B,PPN ;PROG 21900 SFDS< 22000 CAIN C,"]" ;DONE WITH PATH? 22100 JRST PPNFIN ;YES 22200 SETZM PATHB ;NO - LOOK FOR SFD'S 22300 SETZM PATHB+1 ;INITIALIZE PATH BLOCK 22400 MOVE A,PPN 22500 MOVEM A,PATHB+2 22600 MOVEI A,PATHB ;AND USE PTR TO BLOCK AS PPN 22700 MOVEM A,PPN 22800 MOVEI PNT,PATHB+3 ;FIRST SFD PLACE 22900 MOVEI TEMP,5 ;MAX NO. OF SFD'S 23000 SFDSC: PUSHJ P,WORD ;NOW GET SFD 23100 MOVEM B,(PNT) ;AND USE IT 23200 CAIN A,"]" ;IF BRACKET, WE'RE DONE 23300 JRST SFDDON 23400 CAIE A,"," ;ELSE, BETTER BE COMMA 23500 IOERR 23600 MOVEI PNT,1(PNT) ;NOW PLACE FOR NEXT SFD 23700 SOJG TEMP,SFDSC ;GET NEXT IF NOT TOO MANY 23800 IOERR 23900 SFDDON: SETZM 1(PNT) ;GUARANTEE PATH ENDS IN 0 (SHOULDN'T BE NEEDED) 24000 PPNFIN: 24100 > ;SFDS 24200 ;;=I10= ^^ 24300 >;DEC 24400 NODEC< 24500 HLLZM B,PPN ;PROJ 24600 PUSHJ P,WORD 24700 SKIPE B 24800 CAIE A,"]" ;IF 0 WORD OR NO ], ERROR 24900 IOERR 25000 PUSHJ P,FJUST ;RIGHT JUSTIFY 25100 HLRM B,PPN ;PROG 25200 >;NODEC 25300 CMU < 25400 PPNFIN: 25500 >;CMU 25600 PUSHJ P,WORD ;TOSS OUT ] 25700 SKIPE B ;MUST BE NO WORD THIS TIME 25800 IOERR 25900 00100 COMMENT  Delim -- Handle Switches 00200 00300 DELIM: 00400 CAIE A,"/" ;IGNORE ANY SWITCH ASSIGNMENTS 00500 JRST DELIM2 00600 MOVEI PNT,DELIM ;RETURN ADDRESS 00700 >;NOTENX 00800 00900 ^^SWTGET:TLZ FF,FFTEMP ;KEEP TRACK OF SIGN 01000 SETZB C,D ;COLLECT ANY NUMBERS 01100 SWGMOR: PUSHJ P,TYI ;GET SWITCH INFO 01200 SWGPAR: CAIL A,"0" ;DIGIT? 01300 CAILE A,"9" 01400 JRST SWTDSP ; NO 01500 01600 IMULI C,=10 01700 ASH D,3 01800 ADDI C,-"0"(A) ;YES, COLLECT NUMBER 01900 IORI D,-"0"(A) ;COLLECT OCTAL NUMBER TOO. 02000 JRST SWGMOR ;AND KEEP GOING 02100 02200 SWTDSP: CAIE A,"-" ;NEGATE THE COUNTS GOING 02300 JRST SWDGO 02400 TLO FF,FFTEMP ;NOW WILL BE MINUS! 02500 JRST SWGMOR ;AND KEEP GOING 02600 SWDGO: SUBI A,"A" ;ALL SWITCHES ARE LETTERS 02700 JUMPL A,INVSW ;INVALID SWITCH 02800 CAILE A,"Z"-"A" ;CONVERT LOWER CASE 02900 SUBI A,40 ; 03000 CAILE A,"Z"-"A" ;NOW MUST BE IN RANGE 03100 JRST INVSW ; INVALID SWITCH 03200 03300 TLNE FF,FFTEMP ;NEG? 03400 MOVNS D ; YES, IF OCTAL 03500 IDIVI A,7 ;MAKE INDEX IN A, DISPLACEMENT IN B 03600 IMULI B,-5 ;MAKE A BYTE POINTER 03700 ADDI B,37 03800 MOVE TEMP,[POINT 5,SWTTBL(A)] 03900 DPB B,[POINT 6,TEMP,5] ;P FIELD 04000 LDB A,TEMP ;GET DISPATCH 04100 04200 PUSHJ P,@SWDSP(A) ;CALL SWITCH ROUTINE 04300 PUSHJ P,TYI ;GET NEXT CHAR 04400 JRST (PNT) ;LOOK FOR MORE SWITCHES 04500 04600 NOTENX< 04700 ;;%DN% JFR 7-1-76 /A 04800 SWTTBL: BYTE (5)20,14,10,7,0,11,0 ;A-B-C-D-e-F-g 04900 BYTE (5)13,0,0,12,2,1,0 ;H-i-j-K-L-M-n 05000 BYTE (5)0,3,4,5,6,0,0 ;o-P-Q-R-S-t-u 05100 BYTE (5)15,16,17,0,0,0,0 ;V-W-X-y-z-0-0 05200 >;NOTENX 05300 05400 TENX< 05500 SWTTBL: BYTE (5)24,20,10,7,0,11,17 ;A-B-C-D-e-F-G 05600 BYTE (5)13,14,0,12,2,1,0 ;H-I-j-K-L-M-n 05700 BYTE (5)0,3,4,5,6,15,16 ;o-P-Q-R-S-T-U 05800 BYTE (5)21,22,23,0,0,0,0 ;V-W-X-y-z-0-0 05900 >;TENX 06000 00100 00200 DEFINE SWITCH(NUM,DESC) < 00300 II__. 00400 USE SWTS 00500 II ;DISPATCH TO THIS ROUTINE 00600 USE 00700 > 00800 00900 ^SWDSP: BLOCK =21 ;ENOUGH + SOME MORE 01000 SET SWTS,SWDSP ;PREPARE VECTOR PC 01100 01200 SWITCH (0 , INVALID) 01300 01400 SUB P,X11 ;REMOVE RETURN 01500 INVSW: ERR ,1 01600 PUSHJ P,TYI ;GO BACK WHERE YOU CAME FROM 01700 JRST (PNT) 01800 01900 SWITCH (1 , #M -- debugging mode setting) 02000 02100 ; DCS ADDED LABEL, 9-21-71 02200 ^^STMD: POP P,B ;RETURN ADDRESS 02300 IFN FTDEBUG,< 02400 SETZM MULTP ;FOR MODE 5. 02500 SETZM PLINSW 02600 CAIE C,4 02700 SETZM .DBG. ;TO GET ALL THE SWITCHES INITIALIZED. 02800 02900 ;;#GH# DCS 2-1-72 (2-5) REDEFINE 6M -- SCANNER BREAK 03000 HRLOI TEMP,400000 ;XWD 400000,,-1 FOR SCAN BREAK 03100 CAIG C,6 ;MUST BE LESS 6 FOR VALID MODE 03200 XCT DBMD(C) ;SUB-DISPATCH 03300 03400 TABCONDATA (DEBUGGING MODE SETTERS) 03500 DBMD: JFCL ; 0 -- NO EFFECT 03600 HLLOS .DBG. ; 1 -- EXEC ROUTINES ONLY [0,,-1] 03700 SETZM .DBG. ; 2 -- DON'T DEBUG [0,,0] 03800 SETOM .DBG. ; 3 -- EXECS AND PRODUCTIONS [-1,,-1] 03900 SETOM MULTP ; 4 -- DON'T STOP WHILE DEBUGGING 04000 SETOM PLINSW ; 5 -- JUST PRINT LINES 04100 MOVEM TEMP,.DBG. ; 6 -- BREAK AFTER EACH SCAN [400000,,-1] 04200 ; I IS [400000,,377777] or .DBG. 04300 ;;#GH# (2-5) 04400 ENDDATA 04500 04600 JRST (B) ;RETURN FROM DEBUG SWITCH ROUTINE 04700 > 04800 IFE FTDEBUG , 04900 05000 05100 05200 SWITCH (2 , #L -- listing control) 05300 05400 CAMN D,[-1] 05500 MOVEI D,5234 ;LENGTH OF DDT THESE DAYS. 05600 ;INCLUDES SAIL LOWER SEGMENT. 05700 CAMN D,[-2] 05800 JRST [MOVEI D,12237 ;GOOD GUESS FOR LENGTH OF RAID TODAY 05900 ; THIS FIGURE IS WITH SAIL LOW SEGMENT. 06000 SKIPE JOBDDT ; HERE IS A BETTER NUMBER 06100 MOVEI D,LPSERR-1 ;END OF DDT. 06200 JRST OUTLIT] 06300 OUTLIT: MOVEM D,LSTSTRT ;SET IT UP 06400 POPJ P, 06500 06600 00100 00200 ;;%DD% JFR 10-24-75 IF C=0, THEN DOUBLE, ELSE SET VALUE TO RH(C) 00300 00400 SWITCH (3 , P -- double P-stack) 00500 00600 JUMPN C,.+3 00700 HRRZ C,PDLMAX 00800 LSH C,1 ;DOUBLE IT 00900 HRRM C,PDLMAX 01000 POPJ P, 01100 01200 01300 SWITCH (4 , Q -- double SP-stack) 01400 01500 JUMPN C,.+3 01600 HRRZ C,SPMAX 01700 LSH C,1 01800 HRRM C,SPMAX 01900 POPJ P, 02000 02100 02200 SWITCH ( 5 , R -- double parse and semantic stacks) 02300 02400 JUMPN C,.+3 02500 HRRZ C,PPMAX 02600 LSH C,1 02700 HRRM C,PPMAX 02800 HRRM C,GPMAX 02900 HRRM C,PCMAX ;ALSO MAIN PARSE CONTROL 03000 HRRM C,SCWMAX 03100 POPJ P, 03200 03300 03400 SWITCH (6 , #S -- set string space size) 03500 03600 HRRM C,STMAXX ;CHANGE STRING SPACE 03700 POPJ P, 03800 03900 04000 SWITCH (7 , D -- double define stack) 04100 04200 JUMPN C,.+3 04300 HRRZ C,DFMAX 04400 LSH C,1 04500 HRRM C,DFMAX 04600 POPJ P, 04700 04800 SWITCH (10 , C -- turn on CREF listing if listing) 04900 05000 MOVSI TEMP,CREFIT 05100 IORM TEMP,SCNWRD 05200 TLO FF,CREFSW 05300 POPJ P, 05400 05500 05600 05700 SWITCH (11 , F -- set listing format bits in SCNWRD) 05800 05900 ;;%DF% ! RHT 10-25-75 06000 MOVEM D,FMTWRD 06100 ;;%DB% JFR 9-21-75 06200 MOVE TEMP,[XWD 760000,1] 06300 ANDCAM TEMP,SCNWRD ;TURN OFF ALL USER-CONTROLLED BITS 06400 ANDI D,77 ;ONLY LOW SIX BITS MATTER 06500 ROT D,-5 ;SUBSTITUTE USER OPTIONS 06600 ;;%DB% ^ 06700 IORM D,SCNWRD ;MARK OPTIONS 06800 POPJ P, 06900 07000 07100 SWITCH (12 , K -- insert counters into loops) 07200 07300 TLNN FF,LISTNG ;MAKE SURE WE'RE LISTING 07400 POPJ P, ;INSERT COUNTERS ONLY WHEN LISTING 07500 MOVSI TEMP,CREFIT ;GET CREF BIT 07600 TDNE TEMP,SCNWRD ;ARE WE CREFFING 07700 ERR () 07800 MOVEI TEMP,MACEXP ;SPECIFY DESIRED FORMAT FOR 07900 HRLM TEMP,SCNWRD ;LISTING FILE 08000 ;;%DH% 2! JFR 11-22-75 08100 LSH TEMP,-=13 08200 MOVEM TEMP,FMTWRD 08300 SETOM KOUNT ;TURN ON THE COUNTING SWITCH 08400 POPJ P, ;RETURN 08500 08600 SWITCH (13, H -- Generate Two-Segment Code) 08700 08800 SETOM HISW ;THIS TRIGGERS IT 08900 POPJ P, 09000 09100 NOTENX< 09200 BAIL< 09300 SWITCH (14, B -- Debugger option.) 09400 ; LEQ 0 BAIL OFF 09500 ; BITS 09600 ; 1 COORDS--0 MEANS NO, 1 MEANS YES 09700 ; 2 SYMS--0 MEANS JUST PROCS,PARAMS,INTERNALS; 1 MEANS ALL 09800 ; 4 PD FOR SIMPLE PROC--0 MEANS NO, 1 MEANS YES 09900 10000 10100 MOVEM D,BAILON 10200 POPJ P, 10300 >;BAIL 10400 SWITCH (15, V -- OVERLAY CODE, FORCE LINKS TO LOW SEG) 10500 SETOM OVRSAI 10600 POPJ P, 10700 10800 SWITCH (16, W -- "WHERE" GENERATE OPTIONAL LOADER SYMBOLS) 10900 SETOM WHERSW 11000 POPJ P, 11100 11200 SWITCH (17, X -- "XTEND" COMPILER SAVE/RESTART FACILITY) 11300 HLLOS XTFLAG 11400 POPJ P, 11500 11600 SWITCH (20, A -- COMPILED CODE OPTIONS) 11700 MOVEM D,ASWITCH 11800 POPJ P, 11900 >;NOTENX 12000 12100 TENX< 12200 SWITCH (14, I -- Do not generate Two-Segment Code) 12300 12400 SETZM HISW 12500 POPJ P, 12600 12700 SWITCH (15, T -- Load with DDT) 12800 SETOM LODMOD 12900 SETOM LODDDT 13000 POPJ P, 13100 13200 SWITCH (16, U -- Load with SDDT) 13300 SETOM LODMOD 13400 SETOM LODDDT 13500 SETOM LODSDT 13600 POPJ P, 13700 13800 SWITCH (17,G -- Load after compilation) 13900 SETOM LODMOD 14000 POPJ P, 14100 14200 BAIL< 14300 SWITCH (20, B -- Debugger options.) 14400 ; LEQ 0 BAIL OFF 14500 ; BITS 14600 ; 1 COORDS--0 MEANS NO, 1 MEANS YES 14700 ; 2 SYMS--0 MEANS JUST PROCS,PARAMS,INTERNALS; 1 MEANS ALL 14800 ; 4 PD FOR SIMPLE PROC--0 MEANS NO, 1 MEANS YES 14900 15000 MOVEM D,BAILON 15100 POPJ P, 15200 >;BAIL 15300 SWITCH (21, V -- OVERLAY CODE, FORCE LINKS TO LOW SEG) 15400 SETOM OVRSAI 15500 POPJ P, 15600 15700 SWITCH (22, W -- "WHERE" GENERATE OPTIONAL LOADER SYMBOLS) 15800 SETOM WHERSW 15900 POPJ P, 16000 16100 SWITCH (23, X -- "XTEND" COMPILER SAVE/RESTART FACILITY) 16200 HLLOS XTFLAG 16300 POPJ P, 16400 16500 SWITCH (24, A -- COMPILED CODE OPTIONS) 16600 MOVEM D,ASWITCH 16700 POPJ P, 16800 >;TENX 16900 00100 00200 ; END OF SWITCH HANDLERS 00300 00400 NOTENX < 00500 ;Above switch goes to end of file. 00600 00700 DELIM2: CAIE A,"(" 00800 JRST DELIM4 00900 PUSHJ P,TYI ;GET NEXT CHAR 01000 DELIM3: TLZ FF,FFTEMP ;KEEP TRACK OF SIGN OF ANY NUMBERS 01100 SETZB C,D 01200 JSP PNT,SWGPAR ;GO LOOK AT SWITCHES 01300 CAIE A,")" 01400 JRST DELIM3 01500 PUSHJ P,TYI 01600 DELIM4: CAIN A,15 ;IF CR, CALL ROUTINE TO 01700 PUSHJ P,FAKEOL ; SET EOL SWITCH (PERHAPS EOF) 01800 SKIPE EOF ;SET EOL IF EOF 01900 SETOM EOL 02000 02100 DELIM1: 02200 CAIN A,"," ;FILE NAME MUST BE FOLLOWED 02300 POPJ P, ; BY , OR _ OR 02400 ;;=I05= 02500 CAIE A,"=" 02600 CAIN A,"_" ; @ OR ! OR EOL 02700 POPJ P, 02800 CAIN A,"@" 02900 POPJ P, 03000 CAIN A,"!" 03100 POPJ P, 03200 SKIPE EOL 03300 POPJ P, 03400 IOERR 03500 03600 00100 COMMENT  Word 00200 Fetches one name, ext, etc. from Command File. 00300 Leaves character which broke scan in "A", -1 if EOL. 00400 Sets EOL if CRLF or end of file, EOF and EOL for end of file. 00500 Returns word (sixbit) left-justified in "B", zero if none. 00600 ACS: Results in A,B; uses also C,D  00700 00800 WORD: 00900 TLZ FF,FFTEMP ;INDICATE NO GOOD CHARS SEEN. 01000 MOVEI B,0 01100 MOVEI C,6 ;INITIALIZE 01200 MOVE D,[POINT 6,B] 01300 SKIPG A,SAVTYI ;GET LOOKAHEAD CHAR IF ANY 01400 01500 WLUP: PUSHJ P,TYI ;GET A CHARACTER 01600 SETZM SAVTYI 01700 SKIPE EOF ;ON EOF, SET EOL 01800 JRST SETEOL 01900 02000 LORD: CAIL A,"a" 02100 CAILE A,"z" ;IF LOWER, CONVERT TO UPPER 02200 JRST LUPORD ;CHECK A-Z, 0-9 IF NOT 02300 SUBI A,"a"-"A" ;CONVERT TO UPPER CASE 02400 LUPORD: CAIL A,"A" 02500 CAILE A,"Z" ;CHECK LETTER 02600 JRST [CAIL A,"0" 02700 CAILE A,"9" ; NO, CHECK DIGIT 02800 JRST ENDWRD ; NOT LETTER OR DIGIT 02900 JRST .+1] ;A DIGIT 03000 TLO FF,FFTEMP ;A GOOD CHAR SEEN. 03100 03200 STILIN: SUBI A,40 ;CONVERT TO SIXBIT 03300 SKIPN C ; COUNT EXHAUSTED? 03400 JRST WLUP ; YES, CONTINUE UNTIL END OF WORD 03500 IDPB A,D ; COLLECT WORD 03600 SOJA C,WLUP ; CONTINUE 03700 03800 ENDWRD: CAIN A," " ;A SPACE OF SOME VARIETY? 03900 JRST [TLNN FF,FFTEMP ;HAVE WE SEEN ANYTHING? 04000 JRST WLUP ;NOT YET. 04100 JRST .+1] 04200 CAIE A,15 ; CARRIAGE RETURN? 04300 POPJ P, ; NO 04400 FAKEOL: PUSHJ P,TYI ;GET LINE FEED 04500 SKIPN DSKSW ;IF IN DISK MODE, MAKE SURE 04600 JRST SETEOL ;THERE'S NO GARBAGE LEFT 04700 FNDEOF: PUSHJ P,TYI 04800 JUMPL A,SETEOL ;END OF FILE RIGHT AWAY 04900 CAIG A,40 ;IGNORE TABS, BLANKS, AND THE LIKE 05000 JRST FNDEOF 05100 MOVEM A,SAVTYI ;LOOKAHEAD CHAR -- WILL BE PICKED UP NEXT 05200 SETEOL: SETOB A,EOL ;MARK END OF LINE 05300 SKIPN DSKSW ;IF IN TTY MODE, RELEASE DEVICE 05400 RELEASE CMND,0 ;RELEASE COMMAND FILE SO THAT TTY 05500 POPJ P, ;CAN BE USED FOR INPUT 05600 00100 ; Tyi 00200 ; Get one character, set EOF on EOF, ignore zeros 00300 00400 TYI: SKIPE TTYTYI ;IF GETTING INPUT FROM TERINAL, 00500 JRST TTYDO ;DO SO! 00600 SKIPE TYICORE ;FROM COMMAND FILE? 00700 JRST TYCOR ; NO, FROM A STRING IN PNAME, PNAME+1 00800 SOSLE CMDCNT 00900 JRST TYIK 01000 IFN TMPCSW,< 01100 SKIPGE CMDMOD ;IF USING TEMP CORE 01200 JRST TYDUN ;ALL DONE. 01300 >;IFN TMPCSW 01400 INPUT CMND,0 01500 TSTERR CMND 01600 IOERR 01700 TSTEOF CMND,<[TYDUN: SETOB A,EOF 01800 POPJ P,]> 01900 TYIK: IBP CMDPNT 02000 MOVEI A,1 02100 TDNE A,@CMDPNT 02200 JRST LINENO 02300 LDB A,CMDPNT 02400 JUMPE A,TYI 02500 POPJ P, 02600 02700 LINENO: AOS CMDPNT 02800 MOVNI A,5 02900 ADDM A,CMDCNT 03000 JRST TYI 03100 03200 TTYDO: SKIPL TTYTYI ;IF NOT BEGINNING, 03300 INCHRS A ;JUST READ A CHAR AND SKIP 03400 INCHWL A ;OTHERWISE WAIT TILL HE BEGINS. 03500 HRRZS TTYTYI ;CHANGE FLAG TO NOT FIRST TIME. 03600 POPJ P, 03700 03800 TYCOR: SOS A,PNAME ;TEST ALL DONE 03900 TRNE A,400000 ;ALL DONE? 04000 JRST [SETOB A,EOL ;MARK DONE 04100 SETZM TYICORE ;FOR SOURCE FILE SWITCHING 04200 ;DCS 8/21/70 04300 SETZM PNAME ;DCS 5/2/71 04400 POPJ P,] 04500 ILDB A,PNAME+1 ;GET NEXT CHARACTER 04600 POPJ P, 04700 04800 04900 NOEXPO < 05000 INTERNAL SAVDMP 05100 ^SAVDMP: MOVEM TEMP,TEMPSV 05200 HRRZ TEMP,JOBSA 05300 HRRZM TEMP,SWPTBL+3 05400 CALLI TEMP,400062 ;GETNAM 05500 MOVEM TEMP,SWPTBL+1 05600 CALLI ;RESET JOBFF 05700 HRRZ TEMP,JOBFF 05800 CALL6 (TEMP,CORE) ;CUT CORE IMAGE TO MINIMUM 05900 ERR 06000 MOVSI TEMP,SWPTBL 06100 CALL6 (TEMP,SWAP) 06200 JRST @JOBDDT 06300 SWPTBL: SIXBIT /DSK/ 06400 SIXBIT /SAIL/ 06500 SIXBIT /DMP/ 06600 0 06700 0 06800 06900 INTERNAL RAIDST 07000 ^RAIDST: MOVEM TEMP,TEMPSV 07100 SKIPN TEMP,JOBDDT ;JOBDDT BETTER BE THERE 07200 ERR ; 07300 MOVEM LPSA,LPSASV ;NEED TWO AC'S 07400 MOVE LPSA,[POINT 7,RAICDS] ; 07500 MOVE TEMP,-3(TEMP) ; 07600 MOVEM LPSA,-1(TEMP) 07700 RAITL: ILDB TEMP,LPSA ;PICK UP CHAR 07800 CAIN TEMP,33 ;IS IT PSEUDO ALT 07900 MOVEI TEMP,175 ;YES 08000 DPB TEMP,LPSA 08100 JUMPN TEMP,RAITL ;LOOP 08200 MOVE LPSA,LPSASV 08300 MOVE TEMP,TEMPSV 08400 JRST @JOBDDT 08500 08600 TEMPSV: 0 08700 LPSASV: 0 08800 08900 RAICDS:ASCIZ /SAIL:A;B;C;D;LPSA;TEMP;SBITS;SBITS2;PNT;PNT2;24I/ 09000 09100 09200 >;NOEXPO 09300 SUBTTL Production Interpreter 09400 09500 >;NOTENX 09600 ;Closes back to DELIM2. 09700 00100 00200 00300 00400 00500 00600 00700 00800 00900 01000 01100 01200 01300 01400