Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
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# <SOURCE-FILE NOT FOUND > 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 <X><>,<HRRM LPSA,X>>
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 <><X>,<PUSH P,LPSA;> 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 <X><>,<MOVE LPSA,X>
03000 HRRZ LPSA,Y(LPSA)
03100 IFDIF <Z><>,<JUMPE LPSA,Z>>
03200
03300 ; SAME FOR MOVING LEFT ALONG A LINK.
03400 DEFINE LEFT (X,Y,Z) <
03500 IFDIF <><X>,<MOVE LPSA,X>
03600 HLRZ LPSA,Y(LPSA)
03700 IFDIF <><Z>,<JUMPE LPSA,Z>>
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 <X><>,<HRRI FF,X>
02400 IFDIF <Y><>,<HRRI B,Y>
02500 ;;#YR# JFR 2-2-77
02600 IFE <<X><PROTECT!UNPROTECT>>&<PROTECT!UNPROTECT>,<
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 <<X><PROTECT!UNPROTECT>>&<PROTECT!UNPROTECT>,<
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 <Y><>,<ADD A,Y>
07300 IFIDN <Z><>,<PUSHJ P,LEAPC1;> 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 <INSTR><>,<MOVE A,[INSTR]>
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 <X><>,<MOVEI LPSA,X>
01300 IFDIF <Y><>,<MOVE A,Y>
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 <X><>,<MOVEI LPSA,X>
02700 PUSHJ P,BPOP
02800 IFDIF <Y><>,<MOVEM A,Y> >
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 <X><>,<MOVEI LPSA,X>
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 <><X> <
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 <><X> <
09500 MOVEI LPSA,X
09600 >
09700 PUSHJ P,BBEG
09800 >
09900
10000 ;;; THE VERY FIRST LOCATION
10100
10200
10300 ?LPSERR: ERR <DRYROT -- SYMBOL TABLE>
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, <IFDIF <NAME><SPARE>,<?NAME__BITT>>
01300 IFN FTDEBUG, <
01400 IFIDN <NAME> <SPARE> , < 0
01500 >
01600 IFDIF <NAME> <SPARE> ,< 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 <ESC> I -- OBSOLETE BIT NOW
13600 ?ITTYIX__=15 ;INDEX OF <ESC>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,<EXTERNAL DLOGS,DPOW>
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 <unnamed> 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<PSSKSZ__=128>
05800 NOIMSSS<PSSKSZ__=64>
05900 IMSSS<DFSKSZ__=160>
06000 NOIMSSS<DFSKSZ__=40>
06100 ;#SN# (2 OF 8) MAKE EXPR!TYPE RECURSIVE
06200 IMSSS<EXSKSZ__=1000>
06300 NOIMSSS<EXSKSZ__=100>
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 <SAVE ME!>
05100 CALL6 (1,EXIT)
05200
05300 STANFORD<RENC<DATA (START AND SEGMENT FETCH)>;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<
06500 JSP P,.SEG2. ;GRAB SEGMENT HERE
06600 JRST DDTKIM ;NORMAL
06700 JRST DDTKIM ;STPR2 WAS DONE
06800
06900 $PATCH: JSP P,.SEG2. ;ENTER HERE FROM RAID TO FETCH SECOND SEG
07000 JRST @JOBDDT
07100 HALT .
07200 ENDDAT
07300 DDTKIM:>;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 <NO CORE FOR INITIAL ALLOCATION>
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 <SUBSYS>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,<DSK>) ;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,<TMP>) ;TEMP FILE NAME
02800 POPJ P,]
02900 JRST BEG1]
03000
03100 MOVE6 (CMDDEV,<TTY>)
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,<EXTERNAL JOBHVR>
10900 IFNDEF JOBHGH,<EXTERNAL 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,<TTY>)
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 <COMMAND DEVICE NOT AVAILABLE>
05900 JRST TRGAIN ;LOOKUP FAILED
06000 JRST FILEOK ;ALL OK
06100
06200 TRGAIN: SKIPN RPGSW ;PRINT MESSAGE IF NOT IN RPG MODE
06300 IOERR <COMMAND FILE NOT FOUND>
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 <Fatal end of source file>
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,(<POINT 7,0>); 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 <Cannot chain to LOADER>,1
12000 MOVE B,[XWD 70000,100000]
12100 JSYS OPENF
12200 ERR <Cannot chain to LOADER>,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 <ESC>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 <ESC>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 <ESC I>
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 <ESC I> (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,<DEFINE STACK -- CHECK FOR MACRO RECURSION,
09900 OR USE /D TO INCREASE>)
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,[<POINT 7,[ASCII /M/]>] ; 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 <DRYROT AT LSTGET>,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,(<OUT BIN,>) ;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,(<OUT SM1,>) ;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 <OPEN ERROR: TMQ>
02700 IOERR <LOOKUP ERROR: TMQ>
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 <INPUT ERROR: TMQ>
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 <OUTPUT ERROR>
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 <XSAIL made with no .REL output>
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 <XSAIL made with BAIL off>
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 <GTJFN ERROR ON TMQ FILE>
09800 MOVE 2,[XWD 440000,200000] ;READ, 36 BIT, MODE 0
09900 JSYS OPENF
10000 IOERR <OPENF ERROR ON TMQ FILE>
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 <CANNOT CLOSF TMQ FILE>
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<,FILENAME>*
03300 WHERE THE STAR INDICATES ANY NUMBER OF REPETITIONS
03400 EACH FILE NAME CAN BE FORMED FROM THE FOLLOWING PATTERN:
03500 <DEVICE:><NAME><.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 (<CFIL(SBITS2)>,NAME) ;STORE NAMES FOR OTHERS
00900 MOVEW (<CEXT(SBITS2)>,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 (<CPPN(SBITS2)>,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,<CPPN(SBITS2)>) ;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,<DSK>) ; 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,<SYS>)
03100 NOEXPO <
03200 MOVEWI WORD3,1 ;INCREMENT 1 OFF JOBSA
03300 MOVEI P,DEVICE ;CALL FOR RUNJOB
03400 CALL6 P,<SWAP> ;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,<DSK>) ;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,<REL>)
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 <BINARY DEVICE NOT AVAILABLE>
08000 IOERR <CAN'T ENTER OBJECT FILE>
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 <OPEN FAILURE - SM1>
10400 IOERR <ENTER FAILURE - SM1>
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,<DSK>) ;ASSUME DSK FOR LISTING FILE
11500 NOEXPO <
11600 MOVE6 (EXTEN,<LST>) ;AND ASSUME EXT OF .LST
11700 >;NOEXPO
11800 EXPO <
11900 MOVE6 (EXTEN,<CRF>) ;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 <SAIL COMMAND ERROR>
13500
13600 GETLST:
13700 MOVEW (LSTDEV,DEVICE) ;LISTING DEVICE
13800 MOVEI SBITS2,LSTCDB
13900 PUSHJ P,OPNUP
14000 IOERR <LISTING DEVICE NOT AVAILABLE>
14100 IOERR <CAN'T ENTER LISTING FILE>
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,<DSK>) ;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 <SAIL COMMAND ERROR>
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 <SOURCE DEVICE NOT AVAILABLE>
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 <CR> 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 <Can't continue> ;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 <SAIL COMMAND ERROR>
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,(<POINT 6,0>)
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 <ILLEGAL USER NAME>
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 <SAIL COMMAND ERROR>
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 <ILLEGAL PPN>
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 <ILLEGAL PPN>
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 <ILLEGAL PPN>
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 <ILLEGAL PPN>
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 <ILLEGAL PPN>
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 <SAIL COMMAND ERROR>
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 <Illegal path>
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 <NON-OCTAL PPN>
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 <Illegal path>
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 <Illegal path>
23600 MOVEI PNT,1(PNT) ;NOW PLACE FOR NEXT SFD
23700 SOJG TEMP,SFDSC ;GET NEXT IF NOT TOO MANY
23800 IOERR <Illegal path>
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 <SAIL COMMAND ERROR>
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 <SAIL COMMAND ERROR>
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 <INVALID SWITCH IN COMMAND LINE>,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 ; <ESC>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 ,<JRST INVSW>
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 (<COUNTERS AND CREF ARE PRESENTLY INCOMPATIBLE>)
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 <SAIL COMMAND ERROR>
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 <INPUT ERROR ON COMMAND DEVICE>
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 <CORE ERROR DURING SAVDMP OPERATION>
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 <DRYROT -- RAIDST> ;
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