perm filename HDRFIL[S,AIL]19 blob
sn#281978 filedate 1977-05-12 generic text, type T, neo UTF8
UNIVERSAL HDRFIL
↓ALWAYS←←0
DEFINE JD ' (A) <
EXTERNAL .JB'A
DEFINE JOB'A <.JB'A>
>
JD (SA)
JD (VER)
JD (REN)
JD (UUO)
JD (SYM)
JD (FF)
JD (REL)
JD (41)
JD (DDT)
JD (CNI)
JD (TPC)
JD (UUO)
JD (APR)
JD (HRL)
SUBTTL SAIL/GOGOL MACROS AND SWITCHES
DEFINE DEC <IFE STANSW!TENXSW!CMUSW!TYMSW,> ;HAS TOPS-10 FEATURES (ESP. MPB)
DEFINE NODEC <IFN STANSW!TENXSW!CMUSW,> ;SITE WITHOUT ALL TOPS-10 FEATURES
DEFINE STANFO <IFN STANSW,> ;code for stanford only
DEFINE NOSTANFO <IFE STANSW,> ;code not allowed at stanford ever
DEFINE EXPO <IFN EXPORT, > ;code for export only (BEING PHASED OUT)
DEFINE NOEXPO <IFE EXPORT, > ;code for Stanford only (BEING PHASED OUT)
DEFINE CMU <IFN CMUSW,> ;CODE ONLY FOR CMU
DEFINE NOCMU <IFE CMUSW,> ;CODE NEVER FOR CMU
DEFINE TYMSHR <IFN TYMSW,>
DEFINE NOTYMSHR <IFE TYMSW,>
DEFINE ITS <IFN ITSSW,> ;Code only for its
DEFINE NOITS <IFE ITSSW,> ;code never for its
DEFINE IMSSS <IFN IMSSSW,> ;IMSSS version of TENEX-SAIL
DEFINE NOIMSSS <IFE IMSSSW,>
DEFINE PARC <IFN PARCSW,> ;CODE ONLY FOR PARC
DEFINE NOPARC <IFE PARCSW,> ;NEVER FOR PARC
DEFINE SRIAI <IFN SRIAISW,> ;CODE ONLY FOR SRI-AI
DEFINE NOSRIAI <IFE SRIAISW,> ;NEVER
DEFINE JPL <IFN JPLSW,> ;AT JPL
DEFINE NOJPL <IFE JPLSW,> ;NOT AT JPL
DEFINE SUMEX <IFN SUMEXSW,> ;AT SUMEX
DEFINE NOSUMEX <IFE SUMEXSW,> ;NOT AT SUMEX
DEFINE UOR <IFN UORSW,> ; CODE FOR UNIV OF ROCHESTER
DEFINE NOUOR <IFE UORSW,> ;NOT AT U OF R
DEFINE URHASH <IFN URHSW,> ;NEW LEAP HASH ROUTINES AND SEARCHES
DEFINE NOURHASH <IFE URHSW,>
DEFINE URLEAP <IFN URLPSW,> ;TRUE FOR DESCENDING ITEM ALLOCATION
DEFINE NOURLEAP <IFE URLPSW,> ;LOCALS ASCENDING, GLOBALS DESCENDING
DEFINE URSTAT<IFN URSTSW,> ;TRUE IF YOU WANT LEAP SEARCH STATISTICS
DEFINE NOURSTAT <IFE URSTSW,> ;NO STATISTICS PLEASE
DEFINE BAIL <IFN BAISW,> ;DEBUGGER STUFF
DEFINE NOBAIL <IFE BAISW,>
DEFINE GLOB <IFN GLOBSW, > ;since global compiler (GLOBC) can service
DEFINE NOGLOB <IFE GLOBSW, > ; non-global code, GLOBC is different
DEFINE GLOC <IFN GLOBC, > ; from GLOB (global model)
DEFINE NOGLOC <IFE GLOBC, >
DEFINE UP <IFN UPPER,> ;upper segment code (only used in runtime)
DEFINE NOUP <IFE UPPER,> ;not
DEFINE LOW <IFN LOWER,> ;lower bootstrap for 2 seg thing (ditto)
DEFINE NOLOW <IFE LOWER,> ;not
DEFINE LEP <IFN LEAPSW,> ;this compiler understands LEAP
DEFINE NOLEP <IFE LEAPSW,> ;doesn't (applies to runtime too)
DEFINE REN <IFN RENSW,> ;Re-entrant output (comp), runtimes (runtim)
DEFINE NOREN <IFE RENSW,>
DEFINE RENC <IFN RENCSW,> ;The compiler itself is reentrant
DEFINE NORENC <IFE RENCSW,> ;The compiler itself is not reentrant
DEFINE HACK <IFN HACKSW,> ;TEMPORARILY VERSION FOR STANFORD
DEFINE NOHACK<IFE HACKSW,> ; WILL DISAPPEAR NEXT SAISG
DEFINE TENX<IFN TENXSW,> ;FOR TENEX SYSTEMS
DEFINE NOTENX<IFE TENXSW,> ;NOT
DEFINE REC <IFN RCDSW,> ;RECORDS ARE CONDITIONAL UNTIL DEBUGGED BETTER
DEFINE NOREC <IFE RCDSW,> ;RECSW WAS A VARIABLE IN THE COMPILER
DEFINE RGC <IFN RGCSW,> ;RECORD GARBAGE COLLECTION (INSTEAD OF REF CNT)
DEFINE NORGC <IFE RGCSW,> ;NOT
DEFINE NRC <IFN NRCSW,> ;NEW-STYLE RECORD DESCRIPTORS
DEFINE NONRC <IFE NRCSW,> ;NOT
DEFINE KI10 <IFN KI10SW,> ;CPU IS A KI10
DEFINE NOKI10 <IFE KI10SW,> ;NOT
DEFINE KL10 <IFN KL10SW,> ;CPU IS A KL10
DEFINE NOKL10 <IFE KL10SW,> ;NOT
DEFINE XCOM <IFN XCOMSW,> ;COMPILER SAVE/RESTART (EXTEND) FACILITY
DEFINE NOXCOM <IFE XCOMSW,>
DEFINE SFDS <IFG SFDLVL,>
DEFINE NOSFDS <IFE SFDLVL,> ;NOT USED AT THE MOMENT
DEFINE STSW (V,VL) <IFNDEF V,<?V←←VL>>
IFDEF SPCWAR,<STSW(STANSW,1)> ;SPCWAR ONLY DEFINED AT STANFORD
STSW (STANSW,0);WE MUST BE EXPORTING
STSW (HACKSW,STANSW) ;ONLY AT STANFORD
STSW (TENXSW,0); NOT USUSALLY AT TENEX
STSW (CMUSW,0); NOT USUALLY AT CMU
IFDEF AUXCAL,<STSW (TYMSW,1)>
STSW (TYMSW,0); IN CASE THE LINE ABOVE DOES NOT TAKE
STSW (ITSSW,0); NOT USUALLY AT MIT
STSW (IMSSSW,0); NOT USUALLY AT IMSSS
STSW (PARCSW,0); NOT USUALLY AT PARC
STSW (SRIAISW,0); NOT USUALLY AT SRIAI
STSW (JPLSW,0); NOT USUALLY AT JPL
STSW (SUMEXSW,0); NOT USUALLY AT SUMEX
STSW (UORSW,0); NOT USUALLY AT UOR
STSW (RENCSW,0) ;NOT USUALLY A REENTRANT COMPILER
STSW (DECSW,1); USUALLY DEC 10-50 BASED SYSTEM
STSW (HEDSYM,0) ;USUALLY NOT A USER-TABLE SYMBOL GENERATOR
STSW (KL10SW,.CPU.⊗-2) ;.CPU. IS 4 FOR KL, 2 FOR KI, 1 FOR KA, 0 FOR 6
STSW (KI10SW,.CPU.⊗-1)
STSW (XCOMSW,1) ;COMPILER SAVE/RESTART USUALLY SUPPORTED
STSW (SFDLVL,5) ;NORMAL SITE ALLOWS SFDs
NOCMU <
STSW(GLOBSW,0) ;USUALLY NOT A GLOBAL SEGMENT BEING MADE
>;NOCMU
NOSTANFO <
?EXPORT ←← 1 ; TAKE CARE OF OBSOLETE SWITCH
STSW (SIXSW,0)
>;NOSTANFO
STANFO <
?EXPORT ←← 0
STSW (SIXSW,1)
?KI10SW←←1
?KL10SW←←1
?SFDLVL←←0 ;STANFORD DOESN'T HAVE SFD'S
>;STANFO
STSW(RCDSW,1);
STSW(RGCSW,RCDSW); DITTO, ALSO REALLY ONLY USE WHEN DEBUGGING COMPILER UNTIL BETTER
STSW(NRCSW,1); USUALLY A NEW-STYLE RECORD SYSTEM (now) ****
CMU < ;**** EXTRA SWITCHES FOR CMU ******
DEFINE GGAS <IFN GASSW,> ;cmu version of global segment
DEFINE NOGGAS <IFE GASSW,> ;inverse
DEFINE GGGON <↑↑ GLOBSW←←GASSW> ;
DEFINE GGGOFF <↑↑ GLOBSW ←←0> ;USED TO SELECT SOME OF SU-AI GLOB STUFF
STSW(GASSW,0) ;NOT USUALLY CMU GLOBAL
STSW(GLOBSW,0) ;CMU WILL DIDDLE THIS SWITCH DIRECTLY
?SFDLVL←←0 ;CMU DOESN'T HAVE SFD'S
>;CMU
IMSSS <;DEFAULT SETTINGS AT IMSSS
?TENXSW←←1 ;TENEX AT IMSSS
?KI10SW←←1 ;AND A KI
?SIXSW←←1 ;USE SIXBIT PPN'S FOR LOADER AT IMSSS
>;IMSSS
PARC <
?TENXSW←←1 ;TENEX AT PARC
?KI10SW←←1
?SIXSW←←0
>;PARC
JPL <
?TENXSW←←1
?SIXSW←←0
>;JPL
SRIAI <
?TENXSW←←1
?SIXSW←←0
>;SRIAI
SUMEX <
?IMSSSW←←1 ;MOST IMSSS FEATURES
?SIXSW←←0 ;EXCEPT DONT USE SIXBIT
?TENXSW←←1 ;BUT IS TENEX
?KI10SW←←1 ;IS KI
>;SUMEX
UOR <
?DECSW ←← 1 ;DEC TOPS-10 MONITOR
?KL10SW←←1 ;IS KL
?EXPORT ←← 1 ; NOT AT STANFORD
?STANSW ←← 0 ; NOT AT STANFORD
?GLOCSW ←← 0 ; NO GLOBAL MODEL
?GLOBSW ←← 0 ; NO GLOBAL MODEL STUFF
?URHSW ←← 1 ; USE NEW HASH TECHNIQUE
?URLPSW ←← 1 ; ALLOCATE ITEMS TOP DOWN
>;UOR
TENX <
?RENCSW←←1 ;WANT A RE-ENTRANT COMPILER
?RENSW←←1 ;WANT A RE-ENTRANT RUNTIME
?DECSW←←0 ;NOT A DEC SYSTEM
?EXPORT←←1 ;AVOID STANFORD FEATURES
?STANSW←←0 ;IN FACT, EXPLICITLY NOT STANFORD
?GLOBSW←←0 ;NOT USUALLY GLOBAL FOR TENEX
?GLOBC←←0 ;
STSW(LOADVR,=54) ;TENEX SITES SEEM TO HAVE V. 54
?SFDLVL←←0 ;NO TENEX SITE HAS SFD'S
>;TENX
TYMSHR<
?SFDLVL←←0 ;NO SFD'S AT TYMSHARE
?KI10SW←←1 ;ALL KI'S
>;TYMSHR
STSW (BAISW,1) ;USUALLY ON
STSW (URHSW,0) ; LEAVE OFF UNLESS EXPLICITLY ASKED FOR
STSW (URLPSW,URHSW) ;MIGHT AS WELL USE BOTH AS ONE
STSW (URSTSW,0) ;GENERALLY DON'T WANT THIS
IFG URLPSW-URHSW,< ;IF URLPSW = 1 & URHSW = 0
PRINTX URLPSW REQUIRES URHSW [FAIL ERROR ON NEXT LINE]
#SWERR
>
KL10< ?KI10SW←←1 ;NORMALIZE
>;KL10
NOKI10< ?KL10SW←←0
>;NOKI10
IFG STANSW+TENXSW+CMUSW+TYMSW-1,< ;AT MOST ONE OF THESE CAN BE SET
PRINTX SWITCH INCOMPATIBILITY [FAIL ERROR ON NEXT LINE]
#SWERR
>
IFNDEF TSTSEG,<TSTSEG←←0>
NOTENX <
IFN TSTSEG,<
DEFINE FILXXX <SIXBIT /SAISGT/>
DEFINE SLOFIL <SIXBIT /SAILWT/>
DEFINE SGDEVC <SIXBIT /DSK/>
STANFO <
DEFINE SGPPNN <SIXBIT / SAIL/>
>;STANFO
NOSTAN <
DEFINE SGPPPN <0>
>;NOSTAN
?LOCSYM←←1
?NOPROT←←1
>
IFNDEF FILXXX,<DEFINE FILXXX <SIXBIT /SAISG8/>>
IFNDEF SLOFIL,<DEFINE SLOFIL <SIXBIT /SAILOW/>>;PRODUCTION SAIL
IFNDEF SGDEVC,<DEFINE SGDEVC <SIXBIT /SYS/>>
IFNDEF SGPPNN,<DEFINE SGPPNN <0>>
IFNDEF LOCSYM,<?LOCSYM←←0>;DON'T WANT LOCAL SEGMENT SYMBOLS
IFNDEF NOPROT,<?NOPROT←←0> ;DON'T WANT SEGMENT PROTECT IF NOT GLOBAL
DEFINE PROCSR <ASCIZ /SAIL: /> ;FOR PRINTOUT OF PROCESSOR
DEFINE RPGFIL <SIXBIT /QQSAIL/> ;FOR COMPIL PURPOSES
DEFINE DEFEXT <'SAI'> ;DEFAULT EXTENSION
IFNDEF BKTFIL,<DEFINE BKTFIL <=9
POINT 7,[ASCIZ /BKTBL.BKT/],-1 >>
?LIBLEN←←=10 ;LENGTH OF FOLLOWING STRINGS
DEFINE LIBLOW <ASCIZ /SYS:LIBSA8/> ;REQUIRED LIBRARIES
DEFINE LIBHI <ASCIZ /SYS:HLBSA8/> ; (HISEG VERSION)
BAIL<
?BALENG←←=12 ;LENGTH OF FOLLOWING STRING
DEFINE BAILOD <ASCIZ /SYS:BAIL.REL/> ;RESIDENCE OF BAIL
?BPDALN←←=14 ; LENGTH OF FOLLOWING STRING
DEFINE BAIPDS <ASCIZ /SYS:BAIPD8.REL/>
>;BAIL
DEFINE OPDEV <SIXBIT /SYS/> ;DEVICE FOR OPCODE FILE
DEFINE OPNAME <SIXBIT /2OPS2/> ;NAME OF SAME (EXTEN ALWAYS OPS)
DEFINE OPPPN <0> ;WHERE IT'S AT
GLOB <
DEFINE FILXXX <SIXBIT /GLBSG8/>
DEFINE SLOFIL <SIXBIT /GLBLOW/>
DEFINE SGDEVC,<SIXBIT /SYS/>
DEFINE SGPPNN,<0>
?NOPROT←←1
?LOCSYM←←1
>;GLOB
CMU <
GGAS < ;OH WELL
DEFINE SGDEVC <SIXBIT/DSK/>
DEFINE FILXXX <SIXBIT/CONSEG/>
DEFINE SGPPNN <XWD 1305,60410>
>;GGAS
>;CMU
>;NOTENX
TENX <
IFN TSTSEG,<
IFNDEF FILXXX,<DEFINE FILXXX <ASCIZ /<SAIL>T-SAISGT.SAV/>>
IFNDEF SLOFIL,<DEFINE SLOFIL <SIXBIT /SAILWT/>>
?LOCSYM←←1
?NOPROT←←1
IFNDEF LIBLOW,<DEFINE LIBLOW <ASCIZ /LIBSAT.REL/>>
?LIBLEN←←=10
>;IFN TSTSEG
BAIL<
?BALENG←←=14 ;LENGTH OF FOLLOWING STRING
DEFINE BAILOD <ASCIZ /<SAIL>BAIL.REL/> ;RESIDENCE OF BAIL
?BPDALN←←=16
DEFINE BAIPDS <ASCIZ /<SAIL>BAIPD8.REL/>
>;BAIL
IFE TSTSEG,<
IFNDEF FILXXX,<DEFINE FILXXX <ASCIZ /<SAIL>T-5-SAISG8.SAV/>>
IFNDEF SLOFIL,<DEFINE SLOFIL <SIXBIT /LOWTSA/>>
IFNDEF SLOLOD,<DEFINE SLOLOD <ASCIZ/SYS:LOWTSA,/>> ;FOR INTERFACE TO LOADER
?LOCSYM←←0
?NOPROT←←0
IFNDEF LIBLOW,<DEFINE LIBLOW <ASCIZ /<SAIL>LIBSA8.REL/>>
IFNDEF LIBHI,<DEFINE LIBHI <ASCIZ /<SAIL>HLBSA8.REL/>>
IMSSS<
IFNDEF SDTLOD,<DEFINE SDTLOD <ASCIZ/,SDDTRL[S,AIL]/>>
>;IMSSS
?LIBLEN←←=16
>;IFE TSTSEG
IFNDEF SEGPAG, <
?SEGPAG←←630 ;PAGE WHERE THE SEGMENT STARTS
>;IFNDEF SEGPAG
IFNDEF STARTPAGE, <
?STARTPAGE←←610 ;PAGE WHERE CHANNEL BUFFERS BEGIN
>;IFNDEF STARTPAGE
IFNDEF JFNSIZE, <
?JFNSIZE←←20 ;NUMBER OF CHANNELS ALLOWED
>;IFNDEF JFNSIZE
IFNDEF RUNLOD,<DEFINE RUNLOD <=18
POINT 7,[ASCIZ/<SUBSYS>LOADER.SAV/],-1 >>
IFNDEF LODTFN,<DEFINE LODTFN <ASCIZ/LOA.TMP/>>
IFNDEF BKTFIL,<DEFINE BKTFIL <=15
POINT 7,[ASCIZ /<SAIL>BKTBL.BKT/],-1 >>
IFNDEF UDTFIL,<DEFINE UDTFIL <ASCIZ /<SAIL>UDDT.SAV/>>
IFNDEF OPFILE,<DEFINE OPFILE <ASCIZ /<SAIL>3OPS3.OPS/>>
>;TENX
STANFO < ; ACTUALLY, NOT KEPT UP LATELY
>;STANFO
II←←1
FOR @' JJ IN (HEAD,SAIL,PARSE,PDEFS,PRODS,SUBRS,SMTB,SYM,GEN,ARRAY) <
?..'JJ←←II
II←←II⊗1
>
FOR @' JJ IN (EXPRS,STATS,LEAP,TOTAL,COMSER,GOGOL,STRSER,IOSER,LEPRUN,MESPRO,WRDGET) <
?..'JJ←←II
II←←II⊗1
>
IFDEF SETLST,<SETLST>
IFNDEF ..LIST,<
..LIST←←0
FOR @' JJ IN (HEAD,SAIL,PARSE,SYM,GEN,ARRAY,EXPRS,STATS,LEAP,TOTAL,COMSER) <
?..LIST←←..LIST!..'JJ
>
FOR @' JJ IN (GOGOL,STRSER,IOSER,LEPRUN,MESPRO,WRDGET) <
?..LIST←←..LIST!..'JJ
>>
IFDEF SETLS2,<
SETLS2
>
DEFINE LSTON ' (JJ) <
XLIST
IFN ..LIST & ..'JJ,<
LIST>
>
LSTON (HEAD)
DEFINE DSCR <COMMENT ⊗ > ; FOR DIRECTORY MAKER
DEFINE GEN <IFE .NOGEN,<LALL>>
DEFINE NOGEN <XALL>
?.NOGEN←←1 ;DON'T EXPAND MACROS AT ALL AFTER FIRST NOGEN
NOGEN
DEFINE IFNB (X) <IFDIF <><X>,>
DEFINE IFB (X) <IFIDN <><X>,>
NOTENX <
?DSPLEN←←=280 ;LAST CHANGED 2-8-77, FROM 260
>;NOTENX
TENX <
?DSPLEN←←=330 ;LAST CHANGED 3-26-75, FROM 300
>;TENX
GLOB <
?DSPLEN←←DSPLEN+=50 ; SINCE THIS TAKES MORE
>;GLOB
DEFINE HERE(X) <
UP <
FQQQQ ←← .
USE DSPCH ;SO THAT THE LABELS HAVE THE SAME ADDRESS
↑↑ X : JRST FQQQQ
IFGE .-DSPBAS-DSPLEN, <
PRINTS / Dispatch vector size exceeded, bump DSPLEN
/
>;
USE
>;UP
NOUP <
↑↑ X : ;IF NOT MAKING AN UPPER SEGMENT, DOES NOT MATTER.
>;NOUP
>
DEFINE HEREFK (X,XFAKE) <
UP<
↑↑ XFAKE: ; A FAKE LABEL (FELLOW WILL HAVE REAL THING IN SPARES
>;UP
NOUP <
HERE(X) ;ONLY MATTERS IF MAKING A SEGMENT
>;NOUP
>
DEFINE SETCOR (SIZE,FIRST,LAST) <
MOVE C,SIZE
PUSHJ P,CORGET
ERR <CAN'T GET CORE FOR FIRST ALLOCATION>
IFDIF <FIRST><>, <MOVEM B,FIRST>
IFDIF <LAST><>,<
ADD C,B
MOVEM C,LAST
>>
DEFINE DATA (MSG) <
USE VBLS
IFGE .-DBASE-DSIZE,<
PRINTX DATA AREA TOO SMALL [you will get a FAIL error on next line]
#DATERR
>>
DEFINE TABLEDATA (MSG) <
ZERODATA ()
>
DEFINE TABCONDATA (MSG) <
DATA ( )
>
DEFINE ZERODATA (MSG) <
USE ZVBLS
IFGE .-ZBASE-ZSIZE,<
PRINTX ZEROED DATA AREA TOO SMALL [you will get a FAIL error on next line]
#DATERR
>>
DEFINE BITDATA (MSG) < USE>
DEFINE BITDDATA (MSG) < USE>
DEFINE BIT2DATA (MSG) < USE>
DEFINE BITD2DATA (MSG) < USE>
DEFINE ACDATA (MSG) < USE>
DEFINE AC2DATA (MSG) < USE>
DEFINE ENDDATA <
IFDEF ZBASE, <
DATA () ;CHECK
ZERODATA () ;CHECK
USE
>>
DEFINE LEVPOINT(AD)< POINT DLFLDL,AD,35-LLFLDL>
DEFINE TRPCAL (P1,P2,P3,P4,ADR) <
BEGIN
SKIPN ADR
JRST NOTRP
CMU < GGGON ;
>;CMU
GLOB <
PUSH P,USER
MOVE USER,GOGTAB ;IT MAY HAVE BEEN GLUSER
>;GLOB
PUSH P,TEMP
PUSH P,UUO1(USER)
MOVEI TEMP,.TRACS
BLT TEMP,.TRACS+11
MOVE TEMP,-1(P)
PUSH P,P1
PUSH P,P2
PUSH P,P3
PUSH P,P4
PUSHJ P,@ADR
MOVSI TEMP,.TRACS
BLT TEMP,11
POP P,UUO1(USER)
POP P,TEMP
GLOB <
POP P,USER ;GET IT BACK
>;GLOB
CMU < GGGOFF ;DELSELECT GLOBAL STUFF
>;CMU
NOTRP:
BEND
>;END TRPCAL DEF
DEFINE MOVEWI (I,J) <
MOVEI TEMP,J
MOVEM TEMP,I
>
DEFINE MOVEW (I,J) <
MOVE TEMP,J
MOVEM TEMP,I
>
DEFINE MOVE6 (I,J) <
MOVE TEMP,[SIXBIT /J/]
MOVEM TEMP,I
>
DEFINE MOVEI7 (I,J) <
MOVEI TEMP,[ASCIZ /J/]
MOVEM TEMP,I
>
DEFINE LOAD6 (I,J) <
MOVE I,[SIXBIT /J/]
>
DEFINE LOADI7 (I,J) <
MOVEI I,[ASCIZ /J/]
>
DEFINE PWORD (A) <
POINT 36,A,35>
DEFINE PLEFT (A) <
POINT 18,A,17>
DEFINE PRIGHT (A) <
POINT 18,A,35>
DEFINE PCHAR (A) <
POINT 7,A,35>
DEFINE IPWORD (A) <
POINT 36,A>
DEFINE IPLEFT (A) <
POINT 18,A>
DEFINE IPRIGHT (A) <
POINT 18,A,17>
DEFINE IPCHAR(A) <
POINT 7,A>
DEFINE SAVACS (L) <
FOR II IN L ,<
PUSH P,II
>>
DEFINE RESTACS (L) <
FOR II IN L, <
POP P,II
>>
NOTENX <
NOSTANFO <
DEFINE CALL6 ' (I,J) <
IFDIF <><J>,<
IFDIF <><I>,<CALLI I,U'J;> CALLI U'J
>
IFIDN <><J>,<
CALLI U'I
>>
>;NOSTANFO
STANFO <
DEFINE CALL6 ' (I,J) <
IFDIF <><J>,<
IFDIF <><I>,<J I,;> J
>
IFIDN <><J>,<
I
>>
>;STANFO
NOSTANFO <
DEFINE CX ' (Y,Z) <
?U'Y←←Z
>
CX RESET,0 ;0 RESET IO
CX DDTIN,1 ;1 EXT-GET DDT CHAR.
CX SETDDT,2 ;2 SETDDT LOC IN PROTECTED JOB DATA
CX DDTOUT,3 ;3 EXT:SEND DDT CHAR.
CX DEVCHR,4 ;4 DEVICE CHARACTISTICS
CX DDTGT,5 ;5 GET DDT MODE
CX GETCHR,6 ;6 DEVICE CHAR.(DIFF. NAME)
CX DDTRL,7 ;7 RELEASE DDT MODE
CX WAIT,10 ;10 WAIT TILL DEVICE INACTIVE
CX CORE,11 ;11 CORE UUO
CX EXIT,12 ;12 EXIT
CX UTPCLR,13 ;13 CLEAR DEC TAPE DIRECTORY
CX DATE,14 ;14 GET DATE
CX APRENB,16 ;16 ENABLE APR FOR TRAPPING
CX SWITCH,17 ;20 RETURN DATA SWITCHES
CX REASSIGN,21 ;21 REASSIGN DEVICE TO ANOTHER JOB
CX TIMER,22 ;22 RETURN JIFFY CLOCK TIME
CX MSTIME,23 ;23 RETURN TIME OF DAY IN MS
CX GETPPN,24 ;24 RETURN PROJECT-PROGRAMMER NUMBER
CX TRPSET,25 ;25 SET PI TRAP LOC, AND USER IO
CX TRPJEN,26 ;26 DISMISS INTERRUPT TO EXEC MODE
CX RUNTIM,27 ;27 RETURN TOTAL JOB RUNNING TIME
CX PJOB,30 ;30 RETURN JOB NUMBER
CX SLEEP,31 ;31 SLEEP FOR N SECONDS, THEN RETURN TO USER
CX SETPOV,32 ;32 SET PUSH DOWN OVERFLOW TRAP
CX PEEK,33 ;33 PEEK INTO SYSTEM CORE. ;JS
CX GETLIN,34 ;34 GET NAME OF TTY
CX RUN,35 ;35 RUN COMMAND
CX SETUWP,36 ;36 SET USER WRITE PROTECT
CX REMAP,37 ;37 REDO CORE MAP
CX GETSEG,40 ;40 GET SEGMENT
CX GETTAB,41 ;41 GETTAB ILLEGAL AT STANFORD.
>;NOSTANFO
>;NOTENX
DEFINE OP1 &(OPR,MS,ACC) <
IFIDN <ACC><>, <II←←0>
IFDIF <ACC><>, <II←←ACC>
OPR&. II,[ASCIZ /MS/]
>
FOR OP IN (ERR,IOERR) <
DEFINE OP (MSG,AC,ADDR) <
IFIDN <ADDR><>,<OP1 (OP,<MSG>,AC)>
IFDIF <ADDR><>,<JRST [OP1 (OP,<MSG>,AC)
JRST ADDR ]>
>>
DEFINE CORERR(MSG) < JRST [ PUUO 3,[ASCIZ /MSG
/]
NOTENX <
HALT . ;DOT IN LITERALS REFERS TO THE
>;NOTENX
TENX <
JSYS HALTF
>;TENX
]>
DEFINE ERRPRI (X) <
PUSH P,A
MOVEI A,[ASCIZ /X
/]
PUSHJ P,PRINT.
POP P,A
>
DEFINE PRINT (X) <
PUUO 3,[ASCIZ /X/]
>
DEFINE TERPRI (X) <
PUUO 3,[ASCIZ /X
/]>
DEFINE SPRINT(X) < ;SAFE PRINT, BEFORE UUO SET UP
TTCALL 3,[ASCIZ /X/]
>
DEFINE MAKCDB & (CHN,NAM,MODD,I,O) <
NAM&CDB:
NAM&MOD: MODD ;DATA MODE
NAM&DEV: 0 ;DEVICE NAME IN SIXBIT
NAM&HED:
IFN O,<XWD NAM&HDR,0;> NAM&HDR ;BLOCK HEADER POINTER
NAM&HDR: 0 ;I/O HEADER BLOCK
NAM&PNT: 0 ;I/O BYTE POINTER
NAM&CNT: 0 ;I/O CHAR COUNT
↑NAM&FIL: 0 ;I/O FILE NAME
↑NAM&EXT: 0 ;I/O EXTENSION
↑NAM&PPN: 0 ;I/O PPN
NAM&OP: OPEN CHN,NAM&CDB ;OPEN INSTRUCTION
NAM&NT:
IFN I,<LOOKUP CHN,NAME;> ENTER CHN,NAME
NAM&SPC:
IFN O,<OUTBUF CHN,O>
IFE O,<
NOSTANFO <
IFIDN <NAM> <SRC>, <
PUSHJ P,[MOVEI TEMP,.+1 ; PTR TO DESCRIPTOR, CALL UINBF ROUTINE
JRST UINBF] ;>INBUF CHN,I
>;NOSTANFO
STANFO <
UINBF CHN,.+1
>;STANFO
>;IFE O
NAM&BFS: IFN O,<O;> I ;# OF BUFFERS
202 ;MAKE BIGGER BUFFERS THAN NORMAL (INPUT ONLY)
SFDS<
NAM&PTH: BLOCK 4+SFDLVL ;PLACE FOR PATH TO GO
> ;SFDS
>
DEFINE CHKCHN (AA,ROUTIN) & <
TRZE AA,777760 ;ZERO BITS AND TEST VALID
ERR <ROUTIN&: INVALID CHANNEL NUMBER>
>
DEFINE TSTERR (CHAN) <
STATZ CHAN,740000 ;ANY ERRORS?
>
DEFINE TSTEOF (CHAN,EOFADD) <
STATZ CHAN,20000 ;END OF FILE?
JRST EOFADD ; YES
>
DEFINE SETNIT <
MOVE TEMP,[PUSHJ P,%UUOLNK] ;MAKE SURE WE CAN DO UUOS
MOVEM TEMP,41
MOVE P,ALLPDP ;AND PUSHJ'S
>
DEFINE SETPOV (AC,STR) <
IFIDN <STR><><MOVEI TEMP,0;>MOVEI TEMP,[ASCIZ ?STR?] ;GET VALUE
II←←(AC+17)&17 ;BETWEEN 0 AND 17
JJ←←II-(2*(II/2)) ;ODD OR EVEN
IFE JJ,<HRLM TEMP,POVTAB+(II/2); EVEN-- LEFT> HRRM TEMP,POVTAB+(II/2)
>;SETPOV
DEFINE OPTSYM(SYM)<
MOVE TEMP,[RADIX50 50,SYM]
PUSHJ P,OPTSY.
>
DEFINE BIT(NAME,BITT) <IFDIF <NAME><SPARE>,<?NAME←←BITT>>
DEFINE DEFTBS <
BIT (RES,400000) ;RESERVED WORD
BIT (CNST,200000) ;CONSTANT ENTRY
BIT (SPARE,100000) ;****
BIT (INTRNL,40000) ;INTERNAL SYMBOL (SYMBOL EXPORTED)
BIT (EXTRNL,20000) ;EXTERNAL SYMBOL (STORAGE FOUND ELSEWHERE)
BIT (MPBIND,10000) ;MATCHING PROCEDURE OR BINDING ITEMVAR
BIT (VALUE,4000) ;FORMAL PARAMETER CALL BY VALUE
BIT (REFRNC,2000) ;FORMAL PARAMETER CALL BY REFERENCE
BIT (CONOK,1000) ;OK TO CALL INTRINSIC WITH CONST ARGS AT COMPTIME
BIT (SIMPLE,400) ;FOR DISPLAY SYSTEMS ONLY
BIT (MESSAGE,200) ;A MESSAGE PROCEDURE !!!!!(STANFORD ONLY).
BIT (OWN,100) ;OWN VARIABLE ?
BIT (ANYTYP,40) ;ANYTYPED VARIABLE (USED IN PROCEDURE CALLS)
BIT (SAFE,20) ;SAFE -- FOR ARRAYS AND SUCH.
BIT (DEFINE,10) ;DEFINED MACRO IDENTIFIER
BIT (RECURS,4) ;THIS ROUTINE IS REENTRANT
BIT (BILTIN,2) ;IF ON IN TBITS, DON'T SAVE AC'S ON CALL.
BIT (SBSCRP,1) ;SUBSCRIPED VARIABLE (ARRAY)
BIT (INPROG,400000) ;PROCEDURE BEING DEFINED, KEEP FIXUP CHAIN
BIT (GLOBL,200000) ;GLOBAL LEAP VARIABLE
BIT (FORTRAN,100000);FORTRAN PROCEDURE (EXTERNAL)
BIT (FORWRD,40000) ;FORWARD PROCEDURE OR LABEL
BIT (PROCED,20000) ;PROCEDURE
BIT (SHORT,10000) ;SHORT INTEGER OR SHORT REAL
BIT (ITMVAR,4000) ;LEAP ITEMVAR
BIT (PNTVAR,2000) ;RECORD POINTER VARIABLE
BIT (BOOLEAN,1000) ;BOOLEAN VARIABLE ?? (SAME AS INTEGER FOR NOW
BIT (ITEM,400) ;LEAP ITEM
BIT (STRING,200) ;A FHQ STRING
BIT (LPARRAY,100) ;TYPE OF THIS ITEM IS ARRAY
BIT (SET,40) ;LEAP SET
BIT (LABEL,20) ;LABEL
BIT (LSTBIT,10) ; COMPLEX NUMBER ?? (NOT IMPLEMENTED)
BIT (DBLPRC,4) ; DOUBLE PRECISION NUMBER ?? (NOT IMPLEMENTED)
BIT (FLOTNG,2) ;REAL NUMBER
BIT (INTEGR,1) ;INTEGER NUMBER
BIT (KEEP,1) ;DO NOT FLUSH TYPE AHEAD
BIT (QUIET,2) ;DO NOT PRINT MESSAGES
BIT (NUMBS,4) ;DO PRINT THE "CALLED FROM .." STUFF
BIT (LOGGIN,10) ;SEND MESSAGES TO LOG FILE
BIT (CONT,20) ;CONTINUABLE ERROR
BIT (AUTO,40) ;AUTOMATIC CONTINUATION MODE
BIT (LOGOPN,100) ;LOG FILE IS CURRENTLY OPEN
BIT (ERRNOW,200) ;WE ARE CURRENTLY IN THE MIDDLE OF AN ERR. UUO
BIT (MINUS,400) ;WE JUST SAW A MINUS!
BIT (MADEPT,1000) ;WE HAVE ALREADY MADE A BYTE POINTER FOR FAKETTY
BIT (BUFOPN,2000) ;HE HAVE A BUFFER FOR DUMP MODE LOGGING
>
DEFTBS ;DEFINE THE TBITS
?FNYNAM ←← RECURS ;EXTERNAL+OWN+FNYNAM MEANS EXT REQ IS FOR
FLOAT←2B8 OPDEF FLOAT [2B8]
STANFO <
PDPFIX←<KAFIX> OPDEF PDPFIX [KAFIX]
>;STANFO
FIX←3B8 OPDEF FIX [3B8]
DMOVE←120B8 OPDEF DMOVE [120B8]
DMOVEM←124B8 OPDEF DMOVEM [124B8]
DMOVN←121B8 OPDEF DMOVN [121B8]
DMOVNM←125B8 OPDEF DMOVNM [125B8]
FIXR←126B8 OPDEF FIXR [126B8]
FLTR←127B8 OPDEF FLTR [127B8]
KIFIX←122B8 OPDEF KIFIX [122B8]
ADJSP←105B8 OPDEF ADJSP [105B8]
DFAD←110B8 OPDEF DFAD [110B8]
DFSB←111B8 OPDEF DFSB [111B8]
DFMP←112B8 OPDEF DFMP [112B8]
DFDV←113B8 OPDEF DFDV [113B8]
DADD←114B8 OPDEF DADD [114B8]
DSUB←115B8 OPDEF DSUB [115B8]
DMUL←116B8 OPDEF DMUL [116B8]
DDIV←117B8 OPDEF DDIV [117B8]
IOERR.←4B8 OPDEF IOERR. [4B8]
ERR.←5B8 OPDEF ERR. [5B8]
SIXPNT←6B8 OPDEF SIXPNT [6B8]
ARERR←7B8 OPDEF ARERR [7B8]
RECUUO ← 10B8 OPDEF RECUUO [10B8]
DECPNT←11B8 OPDEF DECPNT [11B8]
OCTPNT←12B8 OPDEF OCTPNT [12B8]
ERRSPL←13B8 OPDEF ERRSPL [13B8]
SNGL←14B8 OPDEF SNGL [14B8]
TENX <
PUUO←15B8 OPDEF PUUO [15B8]
OPDEF TTCALL [PUUO]
>;TENX
NOTENX <
PUUO←<TTYUUO> OPDEF PUUO [TTYUUO]
OPDEF TTCALL [TTYUUO]
>;NOTENX
JFOV←<JFCL 1,0> OPDEF JFOV [JFCL 1,0]
OPDEF TRZ [ANDCMI]
OPDEF TRC [XORI]
OPDEF TRO [IORI]
STANFO <
DPYOUT←703B8 OPDEF DPYOUT [703B8]
DPYCLR←701B8 OPDEF DPYCLR [701B8]
UINBF←704B8 OPDEF UINBF [704B8]
?SEGSIZUUO ← 400022 ;GET SIZE OF SECOND SEGMENT.
?CORE2UUO ← 400015 ;GET SOME MORE SECOND SEGMENT.
?GLBAR ←← 1000 ;CURRENT LENGTH OF GLOBAL MODEL AREA.
>;STANFO
SUBTTL SAIL/GOGOL USER TABLE DESCRIPTION
DEFINE XX (SYMBOL,SIZE,BACKUP) <
?SYMBOL←←LOCAT
IFN HEDSYM,<
ENTRY SYMBOL ;FOR HEAD.REL SYMBOL FILE
>;N HEDSYM
LOCAT←←LOCAT+1
IFDIF<SIZE><>< LOCAT←←LOCAT+SIZE-1>
IFDIF<BACKUP><>< LOCAT←←LOCAT-BACKUP>
>
LOCAT←←0 ;MAKES SYMBOLS ABSOLUTE
XX CLER,,1
XX UUO1 ;TRADITIONAL LOC FOR GOGOL RETRN ADRS FOR ERROR MSGS.
XX STRLNK
XX SPLNK ;LINK END FOR SPACE ALLOCATION.
XX SETLNK ;LINK END FOR SETS.
XX SGROUT ;LINK UP STRING DSCRPTR GENERATOR ROUTINES HERE
XX KNTLNK ;PROFILE COUNTER LINK END
XX ST ;BOTTOM OF STRING SPACE
XX STTOP ;TOP OF SAME
XX STLIST ;HEAD OF LIST OF STRING SPACES
XX TOPBYTE ;NEXT FREE BYTE
XX REMCHR ;-REMAINING FREE CHARS
XX SGLIGN ;ON IF MUST BE ALIGNED TO FW BDRY (COMPILER ONLY).
XX CHANS,20
XX BKTPRV ;0→UNPRIVILEGED, ≠0→PRIVILEGED
XX BKTPTR,4,, ;POINTERS TO CORGET BLOCKS OF 18 BREAKTABLES EACH
DSPTBL←←0 ;BREAK CHAR DISPOSITION TABLE
LINTBL←←=19+DSPTBL ;LINE NUMBE " "
BRKTBL←←=19+LINTBL ;BREAK CHAR TABLE
BKJFFO←←=128+BRKTBL ;RESERVATION WORD
BRKCVT←←1+BKJFFO ;UPPER CASE CONVERSION
BRKOMT←←1+BRKCVT ;OMIT SPEED UP
BRKDUM←←1+BRKOMT ;%DQ% used to hold "Z" bit flag
XX TTYCVT ; DITTO FOR TTY INPUT
XX FSTATS ; FOR GETSTS
XX PDL ;IOWD SIZE,BASE FOR SYSTEM PDL
XX SPDL ;XWD SIZE,BASE FOR STRING PDL
STANFO <
XX ZAPBEG,,1 ;BEGINNING OF SECOND SEGMENT COPY OF STUFF.
>;STANFO
CMU <
XX ZAPBEG,,1 ;JUST LIKE SU-AI
>; CMU
STANFO <
XX CURMES ;CURRENT MESSAGE.
>;STANFO
XX MAXITM ;CURRENT TOP ITEM NUMBER.
XX OLDITM ;LINKED LIST OF OLD ITEMS (DUMP HEAP).
XX INFOTAB ;POINTER TO "GOOD POINTER" BLOCK OF CORE.
XX DATAB ;POINTER TO DATUM AREA.
XX HASTAB ;POINTER TO THE LEAP HASH TABLE.
XX FP1 ;FREE STORAGE -- 1 WORD.
XX FP2 ;FREE STORAGE -- 2 WORDS.
XX HASMSK ;THE MASK FOR HASHING INTO OUR HASH SPACE.
URHASH <
XX RMASK1 ;NEW MASK FOR MODIFIED LEAP ROUTINES
XX RMASK2
XX RMASK3
XX RMASK4 ;END OF NEW MASKS (3/15/76 --
>;URHASH
URLEAP <
XX BRACKL ;POINTER TO LIST OF BRACKETED TRIPLE BLOCKS
>;URLEAP
XX HASHP ;FOR PNAMES. XWD NEXT FREE ARRAY ENTRY,ARRAY BASE.
XX MKBP ;MAKE BREAK-POINT
XX ERBP ;ERASE BREAK-POINT
XX PUBP ;PUT BREAK-POINT (NOT IMPLEMENTED)
XX REBP ;REMOVE BREAK-POINT.(NOT IMPLEMENTED)
XX ITMTOP ;MAXIMUM PERMISSIBLE ITEM NUMBER.
XX LEABOT ; PTR TO SEARCH CONTROL BLOCK FOR DERIVED SETS ERASE.
XX FRLOC ; PTR TO CURRENT ACTIVE FOREACH CONTROL BLOCK POINTER
XX SCBCHN ; PTR TO CHAIN OF ABANDONED SCB'S
XX FREITM ;NUMBER OF FREE ITEMS REMAINING
XX ARYDIR ;FOR TELLING FOUR ARRAY ROUTINES WHICH END IS UP.
XX ARYLS ;A LINKED LIST (LUCKILY) OF STRING ARRAYS IN LEAP, AND SO FORTH.
XX BLKTAB,3,3 ;BASE OF BLOCK CONTROL TABLE
XX LOWC ;LOW LIMIT OF ALLOCATABLE "BLOCK" CORE
XX TOP ;UPPER LIMIT OF SAME
XX FRELST ;POINTER TO BLOCK FREE STORAGE LIST
XX XPAND ;PERMISSION TO EXPAND IN CORREL IF 0
XX ATTOP ;REQUEST TO ALLOCATE OFF TOP OF CORE IF NON-0
XX NOSHRK ;IF ON, CORREL NOT GIVEN PERMISSION TO SHRINK CORE
STANFO <
XX USCOR2 ;IF ON, CORGET WILL USE CORE2 ROUTINES.
>;STANFO
XX BUFACS,10,, ;FOR BUFFER ALLOCATOR
STANFO <
XX ZAPEND,,1 ;END OF SECOND SEGMENT AREA.
>;STANFO
CMU <
XX USCOR2 ;THE COPYCATS
XX ZAPEND,,1 ;ditto ZAPBEG
>;CMU
XX STBUCK,1,1 ;USED IN STRING GC TO KEEP TRACK OF BLOCKS
XX OFFSET ;Distance to move a string space, see STRNGC
XX STINCR ;String space increment size, see STRNGC
XX STREQD ;String space threshold size, see STRNGC
XX SGCCNT ;NUMBER OF TIMES STRNGC HAS BEEN CALLED
XX SGCTIME ;Time of last GC if non-zero, else not enabled
XX SGCTOTAL ;Total GC time while enabled (set SGCTIME -1 to enable)
XX SGCNUM ;Number of strings collected last GC
XX SGCWASTE ;Number of wasted words after last GC
XX SRELOC
XX CODAC ;SAVE AC 1 OVER CALLS ON "CODE" RUNTIME ROUTINE
XX WDTH ;GLOBAL WIDTH FOR STRING CONVERSION ROUTNES
XX DIGS ; "" FOR # OF DECIMAL DIGITS
XX CDBLOC ;IF CHNL IS A CH #, @CDBLOC(USER) GETS ITS CDB ADDR
XX FNAME ;ENTER-LOOKUP TABLE
XX EXT
XX WD3
XX PRPN
XX LONGWD ;LONG FORM LOOKUPS AND ENTERS POKE THIS
XX LONG2 ; AND THIS -- FILEINFO ROUTINE GIVES TO USER
XX PROJ ;USED BY FILNAM ROUTINE
TYMSHR<
XX FUSER
XX FUSER1 ;TYMSHARE USER NAMES
>
XX RACS,13,, ;RE-ENTRANT ROUTINES SAVE HERE
XX SGACS,14,, ;AVAILABLE ANY TIME IF YOU ARE NOT
XX STACS,14,, ;YET ANOTHER AC SAVE AREA
XX PGNNFL
?NPRIS←←20 ;NUMBER OF PRIORITIES
XX PRILIS,NPRIS,, ;PRIORITY LIST HEADERS
XX GGDAD ;THE BASE FOR THE MAIN PROCESS (IF HAVE ONE)
XX TIMER ;COUNTED DOWN FOR CLOCK INTERRUPTS
XX SCHDRQ ;SET ≠0 FOR A SCHEDULER REQUEST
XX STKURT ;PLACE FOR STACKUNWINDER RETN ADRS
XX INTQWP ;INTERRUPT NOTICE BUFFER WRITE PTR
XX INTQRP ;READ PTR
XX INTQWT ;TOP OF BUFFER
XX INTQWB ;BOTTOM OF BUFFER
XX INTPRC ;INTERRUPT PROCESS BASE
XX DISPAT ;DISPATCH TABLE FOR INTERRUPT LEVEL MODULE
XX DFRINF ; AOBJN PTR TABLE FOR DEFERRED INTERRUPTS
NOTENX<
XX IPDP ;INTERRUPT PDP
>;NOTENX
TENX<
XX IPDP1
XX IPDP2
XX IPDP3
XX ISPDP1
XX ISPDP2
XX ISPDP3
XX TIMFRK ;TABLE OF FORK HANDLES FOR INTERRUPT SYSTEM, PROCESSES
>;TENX
XX IJBCNI ;JOBCNI FROM A DEFERRED INTERRUPT
XX IJBTPC ;JOBTPC FROM DEFERRED INTERRUPT
XX IRUNNR ;RUNNER AT TIME OF DEFERRED INTERRUPT
NOTENX<
XX ISPDP ;STRING PDP FOR INTERRUPT LEVEL
>;NOTENX
XX $FSLIS ;LIST OF FREE STORAGE ALLOCATORS
XX PRNINF ;$PRINT DEFAULTS
XX BAILOC ;IF NONZERO, ADDRESS OF BAIL INTERCEPT ROUTINE
XX JFRCEL ; USED TO BE XX <NOTHING>
XX RSGCLK ;THE TWO WORD BLOCK REQUIRED BY SGINS
XX RSGCL2 ; AND A SECOND WORD
XX STBLST ;HEAD OF CHAIN OF STRING DESCR ARRAYS FOR RECORDS
XX RGCOFF ;SET THIS TO TURN OFF AUTO GC
XX TGRADJ ;PUT PUSHJ ADR HERE TO ADJUST OWN TRIGGER LEVELS
XX RGCRHO ;-1.0+1/"%FILL" LEVEL DESIRED FOR RECORD SPACES
XX SPARUT,1,, ;SPARE USER TABLE ENTRIES
XX PRTINF ;PRINT OUTPUT INFORMATION XWD BITS,CHAN
XX $$PROU ;PRINT OUTPUT TRAP FOR ALL STRINGS
XX $$FINT ;USER FORMATTING FUNCTION FOR INTEGERS
XX $$FREL ; " " " " REALS
XX $$FITM ; " " " " ITEMS
XX $$FSET ; " " " " SETS
XX $$FLST ; " " " " LISTS
XX $$FSTR ; " " " " STRINGS
XX $$FREC ; " " " " RECORDS
XX $$FLRL ;LONG REAL
SFDS<
XX PATHBL,4+SFDLVL,, ;PATH BLOCK
> ;SFDS
XX EXPCHR ;"@" OR "E" FOR REAL NUMBER EXPONENT CHARACTER
XX SEGBOT ;ADDR WHICH SAIL FREE STORAGE MUST NOT EXCEED
XX ENDREN ; END OF USER DATA TABLE
SUBTTL Global AC Definitions, Indices, Bits
AC2DATA (GLOBAL AC ASSIGNMENTS)
?P ←17
?SP ←16
?USER ←15
?TEMP ←14
?LPSA ←13
?RF ←←12 ;THE ALMIGHTY F REGISTER
?TAC1 ←←TEMP
?TAC2 ←←LPSA
BITDATA (BITS FOR %ALLOC SPACE REQUEST BLOCK ENTRIES)
?STDSPC ←←400000 ;"INDIRECT" SPECIFICATION OF STANDARD AREA
?WNTADR ←←200000 ;ADDRESS OF AREA TO BE STORED AS SPECIFIED
?WNTEND ←←100000 ;ADDRESS OF NEXT AREA TO BE STORED AS SPECIFIED
?WNTPDP ←← 40000 ;PDP TO AREA TO BE STORED " "
?WNTPDL ←← WNTPDP ;WNTPDP, WNTPDL -- WHAT'S THE DIFFERENCE?
?USRTB ←← 20000 ;RESULT ADDRESSES ARE IN THE USER TABLE
?MINSZ ←← 10000 ;THIS SIZE TO BE USED ONLY IF NO OTHERS GIVEN
BITDATA (INDICES OF STANDARDLY ALLOCATED AREAS (SEE %ALLOC))
?SYSPD ←← 1 ;SYSTEM!PDL
?SYSSPD ←← 2 ;STRING!PDL
?STRSP ←← 3 ;STRING!SPACE
BITDATA (INDICES INTO THE FIXED PORTION OF EACH %ALLOC SPACE REQ. BLOCK)
?$ITNO ←←1 ;MAX ITEM NUMBER DECLARED THIS COMPILATION
?$NWITM ←←2 ;XWD REQUIRED BUCKETS,REQUIRE NEW!ITEMS
?$GITNO ←←3 ;MAX (MIN?) GLOBAL ITEM NUMBER DECLARED
?$MSLNK ←←4 ;POINTER TO MESSAGE PROCEDURE LIST PUT HERE
?$PNMNO ←←5 ;REQUIRE n PNAMES PUTS n HERE
?$VRNO ←←6 ;VERSION NUMBER
?$SGNM ←←7 ;REQUIRED GLOBAL SEGMENT NAME (USUALLY EMPTY)
?$SGD ←←10 ;REQUIRED GLOBAL SEGMENT FILE DEVICE
?$SGF ←←11 ;" FILE NAME
?$SGPP ←←12 ;" PPN
?$TINIT ←←13 ; POINTER TO INITIAL ITEM TYPES
?$PINIT ←←14 ; POINTER TO INITIAL PRINTNAMES
?$CMVER ←← 15 ;com version
?$OBPDA ←← 16 ; pointer to outer block pda
?$SPREQ ←← 20 ; leaves a spare
ENDDATA
BITDATA (LINK NAMES)
?%STLNK ←← 1
?%SPLNK ←← 2
?%SETLK ←← 3
?%SGROT ←← 4
?%KTLNK ←← 5
?%PDLNK ←← 6
?%INLNK ←← 7
?%RBLNK ←← 10
BAIL<
?%BALNK ←← 11
>;BAIL
?%RCLNK ←← 12 ;RECORD CLASS LINK
BITDATA (PROCEDURE DESCRIPTOR INDICES)
DEFINE PDX(I),
<?I ←← PD.XXX
PD.XXX←←PD.XXX+1
>
PD.XXX ←← 0
PDX PD. ;0
PDX PD.ID1 ;1
PDX PD.ID2 ;2
PDX PD.PDB ;3
PDX PD.NPW ;4
PDX PD.DSW ;5
PDX PD.LLW ;6
PDX PD.DLW ;7
PDX PD.PDA ;10
PDX PD.PPD ;11
PDX PD.PCW ;12
PDX PD.BDI ;13
?PD.XXX←←PD.XXX
BITDATA (TYPE CODES WITHIN RH OF INFOTAB ENTRY)
NOTYPE ←← 1 ;NO TYPE AT ALL
BRKITM ←← 2 ;BRACKETED TRIPLE
STTYPE ←← 3 ;STRING ITEM
FLTYPE ←← 4 ;REAL ITEM
INTYPE ←← 5 ;INTEGER ITEM
LSTYPE ←← 7 ;LIST ITEM (TYPE SHOULD ALWAYS BE 1 MORE THN SETYPE
SETYPE ←← 6 ;SET ITEM
PITTYP ←← 10 ;PROCEDURE ITEM
PRCTYP ←← 11 ;PROCESS ITEM
EVTTYP ←← 12 ;EVENT TYPE ITEM
CTXTYP ←← 13 ;CONTEXT ITEM
RFITYP ←← 14 ;REFERENCE ITEM
RECTYP ←← 15 ;RECORD
LBLTYP ←← 16 ;LABEL
RCLTYP ←← 17 ;RECORD CLASS
ITVTYP ←← 20 ;ITEMVAR ***** UNUSED 12-9-76 *****
LFLTYP ←← 21 ;LONG REAL
LINTYP ←← 22 ;LONG INTEGER
MXSTYP ←← LINTYP; LAST SIMPLE TYPE
ARRTYP ←← 24 ;ARRAYS ARE THIS PLUS SIMPLE TYPE CODE
INVTYP ←← MXSTYP+ARRTYP+1; NON-VALID TYPE CODE
BITDATA (RECORD CLASS TYPE BITS)
NODELC ←← 1 ;DO NOT DELETE RECORDS OF THIS CLASS (VIA GC)
CMPLDC ←← 2 ;THIS RECORD CLASS IS COMPILED-IN
HASRPS ←← 4 ;HAS RPTR / RPTR ARRAY
HASSTR ←← 10 ;HAS STRING / STRING ARRAY SUBFIELDS
HASDBL ←← 20 ;HAS DOUBLE (LONG REAL) FIELDS
BITDATA( PROC DESC STUFF)
?BLKCOD←←17 ;BLOCK BOUNDARY CODE
?EOPCOD←←0 ;END OF PROC LVI CODE
?AACOD←←1 ;ARITH ARRAY
?SACOD←←2 ;STRING ARRAY
?SETCOD←←3 ;SET
?LACOD←←4 ;LIST OR SET ARRAY
?FRCCOD←←5 ;FOREACH STATEMENT
?KLCOD←←6 ;KILL LIST
?CTXCOD ←← 7 ;CONTEXT
?CLNCOD ←← 10 ;CLEANUP PROC
?RPCOD ←← 11 ;RECORD PTR
?RPACOD ←← 12 ;RECORD PTR ARRAY
ENDDATA
BITDATA (USE OF THE RESERVED ITEMS)
ITMANY ←← 0 ;ITEM FOR ANY
MAINPI ←← 1 ;ITEM NUMBER OF THE MAIN PROCESS ITEM
UNBND ←← 2 ;UNBOUND (?ITEMVARS ETC)
EVTYPI ←← 3 ;THE ITEM EVENT!TYPE
NIC ←← UNBND ;ITEM GET BACK FROM EMPTY NOTICE QUEUE
?MAXLOC ←← =10 ;MAXIMUM NUMBER OF LOCAL ITEMVARS IN FOREACH
?QBIND ←← 200 ;A ? ITMVR (NOT A MP PARM)
?FBIND ←← 100 ;A BIND ITMVR(HERE BECAUSE OF STATS)
BITDATA (THE NAMED BITS FOR REF ITEMS)
?TMPB ←← 400000 ; SIGN BIT MEANS A TEMP REF ITEM
?REFB ←← 200000 ;USUALLY SET
?QUESB ←← 100000;FOR ? ITEMVARS
?BINDB ←← 40000 ;FOR BIND ITEMVAR
?PROCB ←← 20000 ;NOT NOW REALLY USED
?ITEMB ←← 10000 ; AN ITEM (ITEMVAR)
?ARY2B ←← 4000 ;FOR * ARRAY ITEMVAR ARRAY REFERENCES
?MSK6BT ←← 3740 ; BITS FOR SIX BIT TYPE
?MSKUNT ←← 3700 ;BIT MASK FOR UNTYPED
ENDDATA
SYSPHS←←2 ;TWO SYSTEM PHASES
USRPHS←←3 ;THREE USER PHASES (FOR NOW)
IFN HEDSYM, < ;MAKE AN HONEST ASSEMBLY OUT OF IT
TITLE HEAD
END
>;IFN HEDSYM
DEFINE .VERSION <102200000016>
SUBTTL Command File Descriptions
LSTON (GOGOL)
SUBTTL Conditional Assembly Switches, Macros
STSW(UPPER,0) ;NOT UPPER OR LOWER IF NEITHER SET
STSW(LOWER,0)
STSW(GLOBSW,0) ;ONLY GLOBAL IF SOMEBODY ELSE SAID SO
STSW(SEGS,0)
STSW(RENSW,0) ;RE-ENTRANT LIBRARY (HISEG) IF ON
STSW(LEAPSW,1) ;ASSUME LEAP
EXPO <
STSW(APRISW,1) ;THE APR INTERRUPT PACKAGE IS TO BE USED
>;EXPO
NOEXPO <
STSW(APRISW,0) ;USUALLY USE THE MOORER PACKAGE
>;NOEXPO
DEFINE COMPIL ' (NAM,ENT,EXT,DSCRP,INT,HINHB,DUMMY) <
IFIDN <DUMMY>,<> <
SUBTTL SAI'NAM -- DSCRP
IFE ALWAYS,<
IFDIF <><ENT>,<ENTRY ENT>
TITLE SAI'NAM
REN <
IFIDN <><HINHB>,<HISEG ;LOAD TO UPPER IF POSSIBLE>
>;REN
IFDIF <><EXT>,<EXTERN EXT>
>;IFE ALWAYS
NOLOW <
IFDIF <><INT>,<INTERN INT>
IFN ALWAYS,<
IFDIF <NAM><LOR>,<
IFDIF <><ENT>,<INTERNAL ENT>
>>
>;NOLOW
>;IFIDN <DUMMY>
>
DEFINE COMPXX ' (NAM,ENT,EXT,DSCRP,INT,HINHB)
<COMPIL(<NAM>,<ENT>,<EXT>,<DSCRP>,<INT>,<HINHB>)>
DEFINE ENDCOM (NAM) <
IFE ALWAYS,<
END
>;IFE ALWAYS
>
IFNDEF ALWAYS,<?ALWAYS←←1>
IFN ALWAYS,<DEFINE ENTINT (X) <INTERNAL X>>
IFE ALWAYS,<DEFINE ENTINT (X) <ENTRY X>>
SUBTTL Titles, Versions
IFN ALWAYS,<
LOW <
TITLE LOWER
>;LOW
NOUP <
NOLOW <
TITLE RUNTIM -- SAIL RUNTIME ROUTINES
>;NOLOW
JOBVER←←137
LOC JOBVER
.VERSION&777777000000 ;CURRENT VERSION NUMBER (LH ONLY)
RELOC
>;NOUP
>;ALWAYS NEQ 0
SUBTTL AC Definitions
?FF←←0
?A←1 ;TEMPS FOR ALLES
?B←2 ; (SOMETIMES SAVED)
?C←3
?D←4
?E←5 ?X←5 ;MORE TEMPS
?Q1←6 ?Y←6
?Q2←7 ?Z←7
?Q3←10 ?CHNL←10 ;CHNL # FOR IOSER
?T←11 ?CDB←11 ;CHANNEL DATA BLOCK PTR
?T1←12 ;TRY TO KEEP 12(RF) VALID.
?LPSA←13 ;TEMP, PARAM AC
?TEMP←14 ;TEMP ONLY
?USER←15 ;PTR USER TABLE FOR RNTRNT ROUTS
?SP←16 ;STRING STACK
?P←17 ;SYSTEM STACK
SUBTTL CDB, SIMIO Indices For IOSER, OTHER INDICES
?IOSTATUS ←← 0 ;RETURN STATUS
?IOIN ←← 1 ;BUFFERED INPUT
?IODIN ←← 2 ;DUMP INPUT
?IOOUT ←← 3 ;BUFMODE OUT.
?IODOUT ←← 4 ;DUMP OUTPUT
?IOCLOSE ←← 5 ;CLOSE FILE
?IORELEASE←← 6 ;RELEASE FILE
?IOINBUF ←← 7 ;INBUF
?IOOUTBUF ←←10 ;OUTBUF
?IOSETI ←←11 ;USETI
?IOSETO ←←12 ;USETO
?SETIOSTS ←←13 ;SET IO STATUS
?IOOPEN ←←14 ;OPEN CHANNEL
?IOLOOKUP ←←15 ;LOOKUP FILE
?IOENTER ←←16 ;ENTER FILE
?IORENAME ←←17 ;RENAME FILE
TYMSHR <;CHANIO INDICES
?CIOIN←←14
?CIOOUT←←15
?CIOCLS←←1
?CIORLS←←0
?CIOIBF←←22
?CIOOBF←←23
?CIOUSI←←6
?CIOUSO←←7
?CIOSTS←←16
?CIOOPN←←13
?CIOLUK←←4
?CIOENT←←5
?CIOREN←←11
?CIOGST←←17
>;TYMSHR
DMODE ←← 0 ;DATA MODE
DNAME ←← 1 ;DEVICE
BFHED ←← 2 ;HEADER POINTERS
OBPNT ←← 3 ;OUTPUT BUF. PTR
OBP ←← 4 ;OUTPUT BYTE PTR
OCOWNT ←← 5 ;OUTPUT BYTE CNT
ONAME ←← 6 ;OUTPUT FILE NAM
OBUF ←← 7 ;OUTPUT BUFFER LOC.
IBPNT ←←10 ;SAME FOR INPUT
IBP ←←11
ICOWNT ←←12
INAME ←←13
IBUF ←←14
ICOUNT ←←15 ;INPUT DATA COUNT LIMIT ADDRESS
BRCHAR ←←16 ;XWD TTYDEV FLAG, INPUT BREAK CHAR ADDR
TTYDEV ←←16 ;LH -1 IF DEVICE IS A TTY -- USED BY OUT
ENDFL ←←17 ;INPUT END OF FILE FLAG ADDR
ERRTST ←←20 ;USER ERROR BITS SPECIFICATION WORD
LINNUM ←←21 ;ADDR OF LINE NUMBER WORD (SETPL FUNCTION)
PAGNUM ←←22 ;ADDR OF PAGE NUMBER WORD (SETPL FUNCTION)
SOSNUM ←←23 ;ADDR OF SOS NUMBER WORD (SETPL FUNCTION)
?IOTLEN ←←SOSNUM+1 ;LENGTH OF TABLE ENTRY
?LUPDL←30 ;LENGTH OF UUO PDL
?MINPDS←←=64 ;SMALLEST ALLOWABLE SYSTEM PDL SIZE
?DEFPDS←←=192 ;DEFAULT PDL SIZE
?.ERSWC ←← 20 ;SIZE OF BUILT IN .ERSTR BUFFER
GLOB <
?GBRK ←← 6000 ;MIN GLOBAL ITEM NUMBER
>;GLOB
?.HDRSIZ←←4 ;Header allocated in each string space
?.NEXT←←-1 ;Next string space
?.LIST←←-2 ;Used to link descriptors during GC
?.SIZE←←-3 ;Size of this space
?.STTOP←←-4;< ;=> 1 past last word this space (redundant)
SUBTTL Base (Low Segment) Data Descriptions -- Macros, Compil spec
NOUP <
DEFINE SGLK (ROUT,NAM,INT) <
XX (NAM,ROUT,INT) ;NAME OF STRING DSCRPTR GENERATING ROUTINE
XX (,0,) ;PLACE TO PUT A LINK
LINK %SGROT,.-1 ;WHEREWITHAL TO GENERATE SAID LINK
>
>;NOUP
UP <
DEFINE SGLK (ROUT,NAM) <
XX (NAM,ROUT,)
XX (,0,)
>
>;UP
DEFINE XX (A,B,C,D) <
IFDIF <A><>,<? A :> B
IFDIF <C><>,< C A >
>
UP <
III←←140
DEFINE XX (A,B,C,D) <
IFDIF <A><>,<? A ← III >
III ←← III + 1
IFDIF <D><>,<III←III+D-1>
>
>;UP
END
END