perm filename HDRFIL[X,AIL]1 blob sn#085172 filedate 1974-02-01 generic text, type T, neo UTF8
↓ALWAYS←←0
EXTERNAL  JOBSA,JOBREN,JOBUUO
EXTERNAL JOBSYM,JOBFF,JOBREL,JOB41,JOBDDT,JOBCNI,JOBTPC,JOBUUO
EXTERNAL JOBAPR,JOBHRL
SUBTTL	SAIL/GOGOL MACROS AND SWITCHES
DEFINE DEC <IFN DECSW,>		;dec 10-50 based system
DEFINE NODEC <IFN DECSW,>	;impossible on DEC sys.  
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 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 HACK <IFN HACKSW,>	;TEMPORARILY VERSION FOR STANFORD
DEFINE NOHACK<IFE HACKSW,>	; WILL DISAPPEAR NEXT SAISG
DEFINE STSW (V,VL) <IFNDEF V,<?V←←VL>>
STSW(STANSW,0); ***** EXPORT *****
STSW (STANSW,1);NOT USUALLY EXPORT VERSION
STSW (HACKSW,STANSW) ;ONLY AT STANFORD
STSW (CMUSW,0); NOT USUALLY AT CMU 
STSW (DECSW,1); USUALLY DEC 10-50 BASED SYSTEM
STSW (HEDSYM,0)		;USUALLY NOT A USER-TABLE SYMBOL GENERATOR
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)
>;STANFO	
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
↑↑GLOBSW ←← 0			;CANNOT DEFINE IT (USING STSW)
DEFINE GLOB < IFNDEF GLOBSW,<GLOBSW←←0>
		IFN  GLOBSW, >
DEFINE NOGLOB < IFNDEF GLOBSW,<GLOBSW←←0>
		IFE   GLOBSW,>
>;CMU
DEFINE BAIL <IFN BAISW,>
DEFINE NOBAIL <IFE BAISW,>
STSW (BAISW,0)		;USUALLY OFF
IFNDEF TSTSEG,<TSTSEG←←0>
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 /SAISG7/>>
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
?LIBLEN←←=10				;LENGTH OF FOLLOWING STRINGS
DEFINE LIBLOW <ASCIZ /SYS:LIBSA7/>	;REQUIRED LIBRARIES
DEFINE LIBHI  <ASCIZ /SYS:HLBSA7/>	; (HISEG VERSION)
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 /GLBSG7/>
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
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>,>
DEFINE HERE(X) <
UP <
	FQQQQ ←← .
	USE DSPCH	;SO THAT THE LABELS HAVE THE SAME ADDRESS
↑↑ X :	JRST	FQQQQ
	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,<#DATERR	;DATA AREA TOO SMALL
>>
DEFINE TABLEDATA (MSG) <
	ZERODATA ()
>
DEFINE TABCONDATA (MSG) <
	DATA ( )
>
DEFINE ZERODATA (MSG) <
	USE	ZVBLS
	IFGE	.-ZBASE-ZSIZE,<#DATERR	;ZEROED DATA AREA TOO SMALL
>>
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 SAVACS (L) <
 FOR II IN  L ,<
	PUSH	P,II
>>
DEFINE RESTACS (L) <
FOR II  IN  L, <
	POP	P,II
>>
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
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
/]
				CALL6   EXIT		]>
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 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 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)	;POINTER VARIABLE ?? (NOT IMPLEMENTED YET)
	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←<FIX>	OPDEF	PDPFIX	[FIX]
>;STANFO
FIX←3B8		OPDEF	FIX	[3B8]
IOERR.←4B8	OPDEF	IOERR.	[4B8]
ERR.←5B8	OPDEF	ERR.	[5B8]
SIXPNT←6B8	OPDEF	SIXPNT	[6B8]
ARERR←7B8	OPDEF	ARERR	[7B8]
DECPNT←11B8	OPDEF	DECPNT	[11B8]
OCTPNT←12B8	OPDEF	OCTPNT	[12B8]
IFN 0, <	;WITH TENEX EXPORT IN MIND,
PUUO←15B8	OPDEF	PUUO	[15B8]
>
PUUO←<TTYUUO>	OPDEF	PUUO	[TTYUUO]
		OPDEF	TTCALL	[TTYUUO]
JFOV←<JFCL 1,0>	OPDEF	JFOV	[JFCL 1,0]
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 DSPTBL,=19,,	;BREAK CHAR DISPOSITION TABLE
 XX LINTBL,=19,,	;LINE NUMBER     "       "
 XX BRKTBL,=128,,	;CHARACTER BREAK TABLES
 XX BRKDUM		;EXTRA TO HELP STDBRK ALONG WITH DUMP MODE
 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.
 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
 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
 XX IPDP		;INTERRUPT PDP
 XX IJBCNI		;JOBCNI FROM A DEFERRED INTERRUPT
 XX IJBTPC		;JOBTPC FROM DEFERRED INTERRUPT
 XX IRUNNR		;RUNNER AT TIME OF DEFERRED INTERRUPT
 XX ISPDP		;STRING PDP FOR INTERRUPT LEVEL
XX  BRKCVT		;UPPER CASE BREAK TABLE CONVERSION
XX  TTYCVT		; DITTO FOR TTY INPUT
XX  FSTATS		; FOR GETSTS
 XX SPARUT,05,,		;SPARE USER TABLE ENTRIES
 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
HACK <
?$SPREQ	←← 15		;OFFSET OF SPACE REQUEST ENTRIES WITHIN SPACE BLOCKS
>;HACK
NOHACK <
?$CMVER ←← 15		;com version
?$SPREQ ←← 16		;ONE MORE
>;NOHACK
ENDDATA
BITDATA (LINK NAMES)
?%STLNK ←← 1
?%SPLNK ←← 2
?%SETLK ←← 3
?%SGROT ←← 4
?%KTLNK ←← 5
?%PDLNK ←← 6
?%INLNK ←← 7
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
	INVTYP ←← 31	;NON-VALID TYPE CODE
	ARRTYP ←← 15	;ARRAYS ARE THIS PLUS SIMPLE TYPE CODE
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)
	?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 <102100000052>
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
	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
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