perm filename HEAD[10X,AIL] blob sn#189232 filedate 1975-12-01 generic text, type T, neo UTF8
00100	COMMENT ⊗   VALID 00017 PAGES VERSION 18-2(14)
00200	C REC  PAGE   DESCRIPTION
00300	C00001 00001
00400	C00003 00002	HISTORY
00500	C00013 00003	 INTRODUCTION
00600	C00014 00004	  SWITCHES : AN INTRODUCTION
00700	C00019 00005	 SWITCH SETTINGS & MACROS
00800	C00028 00006	 THE FILSPC STUFF -- OLDER HISTORY 
00900	C00030 00007	 FILSPC FILES
01000	C00036 00008	 NARRATIVE FILSPC ACCOUNTS
01100	C00042 00009	LISTING CONTROL MACROS & THE LIKE
01200	C00050 00010	 MACHINE-EXTENDING MACROS (SOME USEFUL CONSTANT, STORAGE/STORAGE MANIPULATORS)
01300	C00056 00011	  TELETYPE COMMUNICATION MACROS
01400	C00060 00012	  INPUT/OUTPUT AIDS
01500	C00063 00013	 RANDOM OTHER MACROS
01600	C00065 00014	TBITS DEFINITIONS
01700	C00070 00015	 VARIOUS DEFINITIONS OF USER UUO'S.
01800	C00072 00016	DSCR USER DATA AREA TEMPLATE  
01900	C00085 00017	Global AC Definitions, Indices, Bits
02000	C00093 ENDMK
02100	C⊗;
     

00100	COMMENT ⊗HISTORY
00200	AUTHOR,REASON
00300	021  202200000016  ⊗;
00400	
00500	
00600	COMMENT ⊗
00700	VERSION 18-2(14) 3-26-75 BY JFR TENX DSPLEN←←=330 (P.9)
00800	VERSION 18-2(13) 2-16-75 BY JFR BAIL P.7,17 TYPE CODE FOR REC!PNTR, RUNTIME PROC DESCR FILE
00900	VERSION 18-2(12) 2-16-75 BY RLS JUST LOOKING
01000	VERSION 18-2(11) 2-16-75 BY RLS LOOKING AT TENEX SWITCH SETTINGS
01100	VERSION 18-2(10) 2-2-75 BY JFR CLAIM TYPE CODE FOR ITEMVARS IN BAIL, P.17
01200	VERSION 18-2(9) 2-1-75 BY RLS TENEX PSI SYSTEM
01300	VERSION 18-2(8) 12-10-74 BY JFR MORE BAIL LOADMODULE RESIDENCE DEFINITION
01400	VERSION 18-2(7) 12-7-74 BY JFR DEFINE RESIDENCE OF  BAIL  LOADMODULE
01500	VERSION 18-2(6) 11-17-74 BY JFR USER TABLE ENTRY FOR COMMUNICATION BETWEEN BAIL AND ERROR HANDLER
01600	VERSION 18-2(5) 11-7-74 BY JFR KEEP PPN IN CDB
01700	VERSION 18-2(4) 11-2-74 BY JFR REVISE DATA AND ZERODAT CHECKS TO USE "PRINTX", GIVE MORE INFORMATION
01800	VERSION 18-2(3) 10-18-74 BY rls check TENEX file setting for v. 8
01900	VERSION 18-2(2) 10-18-74 BY RHT V 18
02000	VERSION 17-2(104) 10-14-74 BY RHT MAKE FILES SAY SAISG8, ETC
02100	VERSION 17-2(103) 10-10-74 BY JFR FEAT %BS% NEW WAY TO DO BREAK TABLES
02200	VERSION 17-2(102) 10-10-74 BY RHT FEAT BR ELIMINATE HACKS
02300	VERSION 17-2(101) 10-10-74 
02400	VERSION 17-2(100) 10-10-74 
02500	VERSION 17-2(99) 9-20-74 BY JFR INSTALL BAIL
02600	VERSION 17-2(98) 9-5-74 BY RHT ADD ITSSW
02700	VERSION 17-2(97) 7-18-74 BY RHT FEAT %BK% NEEDED NEW LOSER TABLE ENTRY
02800	VERSION 17-2(96) 7-7-74 BY RHT MINOR EDITS FOR REC GC
02900	VERSION 17-2(95) 7-7-74 
03000	VERSION 17-2(94) 6-6-74 BY RHT ADD RGCSW
03100	VERSION 17-2(93) 5-30-74 BY RLS BUG #SM# TEST FOR OVERFLOW OF DISPATCH TABLE
03200	VERSION 17-2(92) 5-27-74 
03300	VERSION 17-2(91) 5-25-74 BY RLS MAKE V. 54 OF LOADER DEFAULT ON TENEX
03400	VERSION 17-2(90) 5-25-74 BY RLS EDIT
03500	VERSION 17-2(89) 5-25-74 BY rls edit
03600	VERSION 17-2(88) 5-25-74 BY RLS PARAMETERIZE JRST TABLE
03700	VERSION 17-2(87) 5-25-74 
03800	VERSION 17-2(86) 5-25-74 BY RLS NEW STDBRK
03900	VERSION 17-2(85) 5-24-74 
04000	VERSION 17-2(84) 5-10-74 BY RHT MODIFY CMU TREATMENT OF GLOBSW MACROS
04100	VERSION 17-2(83) 5-5-74 BY RHT ADD PRNINF TO USER TABLE
04200	VERSION 17-2(82) 4-11-74 BY RHT ADD RECSW & ASSOCIATED MACROS
04300	VERSION 17-2(81) 4-7-74 BY RHT FEAT %BI% ADD RECUUO
04400	VERSION 17-2(80) 4-7-74 BY RHT ADD RECTYP DEF
04500	VERSION 17-2(79) 3-26-74 BY RLS CHANGE TENEX LOADVR TO 54
04600	VERSION 17-2(78) 3-19-74 BY RHT GO OVER FILE WITH RS
04700	VERSION 17-2(77) 3-17-74 BY RLS  EDIT
04800	VERSION 17-2(76) 3-17-74 BY RLS INSTALL SITE SWITCHES
04900	VERSION 17-2(75) 3-17-74 BY RLS INSTALL TENEX FEATURES, TENEX SYSTEM SWITCHES
05000	VERSION 17-2(75) 2-24-74 BY RHT FEAT %BH% TMPB FOR REF ITEM DATUM
05100	VERSION 17-2(74) 1-11-74 
05200	VERSION 17-2(73) 1-11-74 BY JRL ADD CMU SWITCHES SPACE ALLOCATION COMVER
05300	VERSION 17-2(72) 1-11-74 
05400	VERSION 17-2(71) 1-11-74 
05500	VERSION 17-2(70) 12-9-73 BY KVL %BC% ADD BAIL SWITCH
05600	VERSION 17-2(69) 12-6-73 BY jrl REMOVE AS MANY NON STANFORD CHARS AS POSSIBLE
05700	VERSION 17-2(68) 12-3-73 BY RHT ITMANY←←0
05800	VERSION 17-2(67) 12-3-73 
05900	VERSION 17-2(66) 12-3-73 BY RFS INSERT CALLIS FOR EXPORT SYSTEM
06000	VERSION 17-2(65) 12-3-73 
06100	VERSION 17-2(64) 12-3-73 BY RFS ELIMINATED ALL III DISPLAY STUFF
06200	VERSION 17-2(63) 12-2-73 BY RHT HEREFK MACRO & REMOVE USELESS FILSPC TAPE HISTORY
06300	VERSION 17-2(62) 12-2-73 
06400	VERSION 17-2(61) 11-30-73 BY RHT ADD STANSW & DECSW
06500	VERSION 17-2(60) 11-26-73 
06600	VERSION 17-2(59) 11-26-73 
06700	VERSION 17-2(58) 11-26-73 BY RHT DIDDLE THE FILSPC STUFF
06800	VERSION 17-2(57) 11-24-73 BY RHT FEAT %AM% ALLOW MANY USER PHASES OF INIT
06900	VERSION 17-2(56) 11-24-73 
07000	VERSION 17-2(55) 11-21-73 BY RFS CHANGE 'TEST' TO 'TSTSEG'
07100	VERSION 17-2(54) 11-18-73 
07200	VERSION 17-2(53) 11-18-73 BY RHT FEAT %AJ% -- ADD IN FILSPC
07300	VERSION 17-2(52) 11-18-73 
07400	VERSION 17-2(51) 11-18-73 
07500	VERSION 17-2(50) 11-18-73 
07600	VERSION 17-2(49) 11-18-73 
07700	VERSION 17-2(48) 11-18-73 BY RHT FEAT %AJ% -- RESTRUCTURE HEAD
07800	VERSION 17-2(47) 11-10-73 BY RHT ADD CORERR, ERRPRI, ERFLGS BITS
07900	VERSION 17-1(46) 7-26-73 BY RHT TRY VERSION 17
08000	VERSION 17-1(45) 7-26-73 *********************
08100	VERSION 16-2(44) 7-9-73 BY JRL REMOVE LAST REFERENCES TO DCS SWITCH
08200	VERSION 16-2(43) 4-23-73 BY RHT CHANGE ARGTYP TO RFITYP
08300	VERSION 16-2(42) 2-7-73 BY RHT ADD TYPE FOR ARG LIST ITEM
08400	VERSION 16-2(41) 1-28-73 BY JRL PUT QBIND,FBIND HERE SO STATS CAN USE
08500	VERSION 16-2(40) 1-23-73 BY RHT MAKE NIC & UNBOUND THE SAME
08600	VERSION 16-2(39) 1-23-73 BY JRL CHANGE CODE FOR UNBND
08700	VERSION 16-2(38) 1-8-73 BY JRL ADD MAXLOC MAXIMUM NUMBER OF FOREACH LOCAL ITEMVARS ALLOWED
08800	VERSION 16-2(37) 12-13-72 BY jrl BUG #KS# ADD LOADVR SWITCH
08900	VERSION 16-2(36) 11-21-72 
09000	VERSION 16-2(35) 11-10-72 BY HJS MODIFY QPOP TO TAKE AS AN ARGUMENT AN ADDRESS FOR THE POPPED ENTRY
09100	VERSION 16-2(34) 10-16-72 BY JRL CHANGE INVTYP TO 31 TO ALLOW CONTEXT ARRAY ITEMS
09200	VERSION 16-2(33) 9-15-72 BY RHT ADD USER TABLE ENTRIES FOR INTERRUPTS
09300	VERSION 16-2(32) 8-27-72 BY RHT PUT CELL FOR STACK UNWINDER RET ADRS IN USER TABLE
09400	VERSION 16-2(31) 8-23-72 BY JRL ADD UNBND "ITEM"
09500	VERSION 16-2(30) 8-20-72 BY RHT MODIFY USER TABLE
09600	VERSION 16-2(29) 8-6-72 BY RHT ADD PRILIS TO USER TABLE
09700	VERSION 16-2(28) 8-3-72 BY JRL ADD MPBIND TO TBITS DEFS FOR MATCHING PROCEDURES
09800	VERSION 16-2(27) 7-27-72 BY RHT MAKE MACRO FOR DECLARING PD. ENTRIES
09900	VERSION 16-2(26) 7-20-72 BY JRL CHANGE ARRTYP VALUE
10000	VERSION 16-2(25) 7-20-72 BY RHT ADD PROCESS ITEM (TYPE 11)
10100	VERSION 16-2(24) 6-20-72 BY DCS BUG #HU# BETTER TTY INFORMATION
10200	VERSION 16-2(23) 5-16-72 BY DCS INTRODUCE VERSION 16
10300	VERSION 15-2(9-22) 5-4-72 LOTS OF THINGS
10400	VERSION 15-2(8) 2-19-72 BY RHT THE BRAVE NEW WORLD
10500	VERSION 15-2(7) 2-5-72 BY DCS BUG #GJ# ADD LSTON LISTING CONTROL STUFF
10600	VERSION 15-2(6) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR DUE TO NEW `CAT'
10700	VERSION 15-2(5) 2-1-72 BY DCS BUG #GE# INSTALL SYMB %ALLOC BLK INDICES
10800	VERSION 15-2(4) 1-31-72 BY DCS BUG #GE# UPDATE USER TABLE, %ALLOC BITS, INDICES
10900	VERSION 15-2(3) 1-3-72 BY DCS BUG #FX# REMOVE COM2, COM2SW COMPLETELY
11000	VERSION 15-2(2) 12-24-71 BY DCS BUG #FF# REMOVE SAILRUN(ASSUME RUNTIM OR LIB)
11100	VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
11200	
11300	⊗;
     

00100	COMMENT ⊗ INTRODUCTION
00200		THIS IS THE FILE OF MACRO DEFINITIONS AND GLOBAL AC
00300		ASSIGNMENTS FOR THE SAIL COMPILER, THE SAIL RUNTIME
00400		ROUTINES.  NEEDLESS TO SAY, NOT ALL PORTIONS ARE USED
00500		BY ALL PEOPLE.
00600	⊗
00700	
00800	
00900	
01000	EXTERNAL  JOBSA,JOBREN,JOBUUO
01100	EXTERNAL JOBSYM,JOBFF,JOBREL,JOB41,JOBDDT,JOBCNI,JOBTPC,JOBUUO
01200	EXTERNAL JOBAPR,JOBHRL
01300	
01400	
01500	
01600	SUBTTL	SAIL/GOGOL MACROS AND SWITCHES
     

00100	COMMENT ⊗  SWITCHES : AN INTRODUCTION
00200	Conditional assembly runs rampant in SAIL.  Most of the switches are used to
00300	 select options (debug or no debug, etc.) Some are only valid at Stanford.
00400	 There is one, EXPORT, tested by the macros NOEXPO and EXPO, which decides
00500	 whether this is for Stanford or somebody else.
00600	
00700	We have a program which, by reading the SAIL files and looking for switch-
00800	 testing macros, can do the conditional assembly once and for all (removing
00900	 the conditional stuff from the files.  It is such a set of files which
01000	 we normally send out, so if you see some switches and macros below that
01100	 never get referenced, it's because that code was taken out of your files.
01200	
01300	The conditional assembly switches are assigned in the following files:
01400	
01500	DCS	DCS	←2				;SLS (experimental) system
01600		FTDEBUG ←1				;include debugging in cmplr
01700	
01800	;NOCOM	COM2SW	←0				;OBSOLETE SWITCH, WAS TO
01900							; DISTINGUISH 2-SEG COMPILER
02000	WOM	DCS	←1				;WOM (experimental) system
02100	
02200	HEAD	EXPORT	←if NDEF then 0 else EXPORT
02300		DCS	←if NDEF then 0 else DCS
02400	;	COM2SW	←if NDEF then 1 else 0
02500		SIXSW	←if NDEF then (if EXPO then 0 else 1) else SIXSW ;sixbit PPN's
02600		HEDSYM	←if NDEF then 0 else HEDSYM	;With HEDSYM on, assembling HEAD
02700							; yields HEAD.REL, a symbol
02800							; file for the USERCON function
02900	
03000	GLB	GLOBSW	←1				;runtimes know about glb mdl
03100	
03200	LOW	SEGS	←1				;upper or lower assembly
03300		LOWER	←1				;assembles SAILOW or GLBLOW
03400		UPPER	←0
03500	
03600	UP	SEGS	←1
03700		LOWER	←0
03800		UPPER	←1				;assembles UPPER or GLOBAL
03900	
04000	FILSPC IS PART OF HEAD AS OF NOV 1973
04100	FILSPC	FILXXX	←SAISGn				;SAIL upper segment name
04200		SLOFIL	←SAILOW				;SAIL lower segment name
04300	GLOB <
04400		FILXXX	←GLBSGn				;global model upper segment name
04500		SLOFIL	←GLBLOW				;global model lower segment name
04600	>;GLOB
04700		SGDEVC	←SYS				;device for segment files
04800		SGPPNN	←0				;PPN for segment files
04900		LOCSYM	←0				;no local uppers in lower file
05000		NOPROT	←0				;want upper segment protected
05100	
05200	DB	FTDEBUG	←1
05300	
05400	SAIL	LEAPSW	←1				;LEAP exists
05500		FTDEBUG	←if NDEF then 0 else FTDEBUG
05600		GLOBC	←if LEAP and NOEXPO then 1 else if NDEF then 0 else GLOBC
05700		PATSW	←if NDEF then 0 else PATSW	;compile AOS/SOS to PAT words
05800		RENSW	←if NDEF then 1 else RENSW	;compile Re-entrant Code
05900		TMPCSW	←if NDEF then (if EXPO then 1 else 0) else TMPCSW
06000						;TMPCOR UUO available and used
06100	;; #KS BY JRL (12-13-72) ADD LOADVR SWITCH
06200		LOADVR  ←if NDEF then 54 else LOADVR (for differences in block code
06300				for required rel files,libraries in LOADER 54)
06400		 SAILRUN was a switch controlling some runtimes.  Now runtimes will
06500		  be assembled to assume a compiler (since that's common anyway).
06600	;; %BC% BY KVL (1/3/74) ADD BAIL SWITCH
06700		BAISW	←if STANFO then 1 else 0	;Bail only at stanford
06800	
06900	GOGOL	UPPER	←if NDEF then 0 else 
07000		UPPER	←if NDEF then 0 else UPPER
07100		LOWER	←if NDEF then 0 else LOWER
07200		SEGS	←UPPER or LOWER
07300		GLOBSW	←if NDEF then 0 else GLOBSW
07400		RENSW	←if NDEF then 1 else RENSW	;assemble Upper-Segment Library
07500		 SAILRUN  no longer exists.
     

00100	; SWITCH SETTINGS & MACROS
00150	?sumexsw←←1
00200	
00300	These macros come in pairs, and exist so that the above-mentioned
00400	 program will have an easy job of it.  The meaning of each pair is
00500	 obvious.  They may be used only as in the following example:
00600	SW <			;or NOSW, starting in col. 1 (any comment out here)
00700	(code to appear under this switch)
00800	>;SW			or NOSW, must be same, any comment out here
00900	 These things may be nested without confusing anyone.
01000	
01100	Here are the macros
01200	⊗
01300	
01350	?SUMEXSW←←1
01400	DEFINE DEC <IFN DECSW,>		;dec 10-50 based system
01500	DEFINE NODEC <IFN DECSW,>	;impossible on DEC sys.  
01600					;(actually, usually use some other
01700					;system switch
01800	DEFINE STANFO <IFN STANSW,>	;code for stanford only
01900	DEFINE NOSTANFO <IFE STANSW,>	;code not allowed at stanford ever
02000	DEFINE EXPO <IFN EXPORT, >	;code for export only (BEING PHASED OUT)
02100	DEFINE NOEXPO <IFE EXPORT, >	;code for Stanford only (BEING PHASED OUT)
02200	DEFINE CMU <IFN CMUSW,>		;CODE ONLY FOR CMU
02300	DEFINE NOCMU <IFE CMUSW,>	  ;CODE NEVER FOR CMU
02400	DEFINE ITS <IFN ITSSW,>		;Code only for its
02500	DEFINE NOITS <IFE ITSSW,>	;code never for its
02600	DEFINE IMSSS <IFN IMSSSW,>	;IMSSS version of TENEX-SAIL
02700	DEFINE NOIMSSS <IFE IMSSSW,>
02800	DEFINE PARC <IFN PARCSW,>	;CODE ONLY FOR PARC
02900	DEFINE NOPARC <IFE PARCSW,>	;NEVER FOR PARC
03000	DEFINE SRIAI <IFN SRIAISW,>	;CODE ONLY FOR SRI-AI
03100	DEFINE NOSRIAI <IFE SRIAISW,>	;NEVER 
03200	DEFINE JPL <IFN JPLSW,>		;AT JPL
03300	DEFINE NOJPL <IFE JPLSW,>	;NOT AT JPL
03400	DEFINE SUMEX <IFN SUMEXSW,>	;AT SUMEX
03500	DEFINE NOSUMEX <IFE SUMEXSW,>	;NOT AT SUMEX
03600	DEFINE BAIL <IFN BAISW,>	;DEBUGGER STUFF
03700	DEFINE NOBAIL <IFE BAISW,>
03800	DEFINE GLOB <IFN GLOBSW, >	;since global compiler (GLOBC) can service
03900	DEFINE NOGLOB <IFE GLOBSW, >	; non-global code, GLOBC is different
04000	DEFINE GLOC <IFN GLOBC, >	; from GLOB (global model)
04100	DEFINE NOGLOC <IFE GLOBC, >
04200	DEFINE UP <IFN UPPER,>		;upper segment code (only used in runtime)
04300	DEFINE NOUP <IFE UPPER,>	;not
04400	DEFINE LOW <IFN LOWER,>		;lower bootstrap for 2 seg thing (ditto)
04500	DEFINE NOLOW <IFE LOWER,>	;not
04600	DEFINE LEP <IFN LEAPSW,>	;this compiler understands LEAP
04700	DEFINE NOLEP <IFE LEAPSW,>	;doesn't (applies to runtime too)
04800	DEFINE REN <IFN RENSW,>		;Re-entrant output (comp), runtimes (runtim)
04900	DEFINE NOREN <IFE RENSW,>
05000	DEFINE RENC <IFN RENCSW,>	;The compiler itself is reentrant
05100	DEFINE NORENC <IFE RENCSW,>	;The compiler itself is not reentrant
05200	DEFINE HACK <IFN HACKSW,>	;TEMPORARILY VERSION FOR STANFORD
05300	DEFINE NOHACK<IFE HACKSW,>	; WILL DISAPPEAR NEXT SAISG
05400	DEFINE TENX<IFN TENXSW,>	;FOR TENEX SYSTEMS
05500	DEFINE NOTENX<IFE TENXSW,>	;NOT
05600	DEFINE REC <IFN RCDSW,>		;RECORDS ARE CONDITIONAL UNTIL DEBUGGED BETTER
05700	DEFINE NOREC <IFE RCDSW,>	;RECSW WAS A VARIABLE IN THE COMPILER
05800	DEFINE RGC <IFN RGCSW,>		;RECORD GARBAGE COLLECTION (INSTEAD OF REF CNT)
05900	DEFINE NORGC <IFE RGCSW,>	;NOT
06000	DEFINE NRC <IFN NRCSW,>		;NEW-STYLE RECORD DESCRIPTORS
06100	DEFINE NONRC <IFE NRCSW,>	;NOT
06200	DEFINE KI10 <IFN KI10SW,>	;CPU IS A KI10
06300	DEFINE NOKI10 <IFE KI10SW,>	;NOT
06400	DEFINE XCOM <IFN XCOMSW,>	;COMPILER SAVE/RESTART (EXTEND) FACILITY
06500	DEFINE NOXCOM <IFE XCOMSW,>
06600	
06700	; ** CONDITIONAL SETTINGS **
06800	
06900	DEFINE STSW (V,VL) <IFNDEF V,<?V←←VL>>
07000	
07100	
07200	IFDEF SPCWAR,<STSW(STANSW,1)> ;SPCWAR ONLY DEFINED AT STANFORD
07300	
07400	STSW (STANSW,0);WE MUST BE EXPORTING
07500	STSW (HACKSW,STANSW) ;ONLY AT STANFORD
07600	STSW (TENXSW,0); NOT USUSALLY AT TENEX
07700	STSW (CMUSW,0); NOT USUALLY AT CMU 
07800	STSW (ITSSW,0); NOT USUALLY AT MIT
07900	STSW (IMSSSW,0); NOT USUALLY AT IMSSS
08000	STSW (PARCSW,0); NOT USUALLY AT PARC
08100	STSW (SRIAISW,0); NOT USUALLY AT SRIAI
08200	STSW (JPLSW,0);	NOT USUALLY AT JPL
08300	STSW (SUMEXSW,0); NOT USUALLY AT SUMEX
08400	STSW (RENCSW,0)	;NOT USUALLY A REENTRANT COMPILER
08500	STSW (DECSW,1); USUALLY DEC 10-50 BASED SYSTEM
08600	STSW (HEDSYM,0)		;USUALLY NOT A USER-TABLE SYMBOL GENERATOR
08700	STSW (KI10SW,0)		;USUALLY NOT A KI10 PROCESSOR
08800	STSW (XCOMSW,1)		;COMPILER SAVE/RESTART USUALLY SUPPORTED
08900	NOCMU <
09000	STSW(GLOBSW,0)		;USUALLY NOT A GLOBAL SEGMENT BEING MADE
09100	>;NOCMU
09200	
09300	NOSTANFO <
09400	?EXPORT ←← 1 	; TAKE CARE OF OBSOLETE SWITCH
09500	STSW (SIXSW,0)
09600	>;NOSTANFO
09700	STANFO <
09800	?EXPORT ←← 0
09900	STSW (SIXSW,1)
10000	>;STANFO	
10100	STSW(RCDSW,1); 
10200	STSW(RGCSW,RCDSW); DITTO, ALSO REALLY ONLY USE WHEN DEBUGGING COMPILER UNTIL BETTER
10300	STSW(NRCSW,1); USUALLY A NEW-STYLE RECORD SYSTEM (now) ****
10400	
10500	CMU < ;**** EXTRA SWITCHES FOR CMU ******
10600	DEFINE GGAS <IFN GASSW,>	;cmu version of global segment
10700	DEFINE NOGGAS <IFE GASSW,>	;inverse
10800	DEFINE GGGON <↑↑ GLOBSW←←GASSW>	;
10900	DEFINE GGGOFF <↑↑ GLOBSW ←←0>	;USED TO SELECT SOME OF SU-AI GLOB STUFF
11000	STSW(GASSW,0)			;NOT USUALLY CMU GLOBAL
11100	STSW(GLOBSW,0)			;CMU WILL DIDDLE THIS SWITCH DIRECTLY
11200	>;CMU
11300	
11400	IMSSS <;DEFAULT SETTINGS AT IMSSS
11500	?TENXSW←←1			;TENEX AT IMSSS
11600	?SIXSW←←1			;USE SIXBIT PPN'S FOR LOADER AT IMSSS
11700	>;IMSSS
11800	
11900	PARC <
12000	?TENXSW←←1			;TENEX AT PARC
12100	?SIXSW←←0
12200	>;PARC
12300	
12400	JPL <
12500	?TENXSW←←1
12600	?SIXSW←←0
12700	>;JPL
12800	
12900	SRIAI <
13000	?TENXSW←←1			
13100	?SIXSW←←0
13200	?RUBCHAR←←"A"-100		;CONTROL-A FOR CHARACTER DELETE
13300	?DELLINE←←"X"-100		;CONTROL-X FOR LINE DELETE
13400	>;SRIAI
13500	
13600	SUMEX <
13700	?IMSSSW←←1			;MOST IMSSS FEATURES
13800	?SIXSW←←0			;EXCEPT DONT USE SIXBIT
13900	?TENXSW←←1			;BUT IS TENEX
14000	>;SUMEX
14100	
14200	TENX <
14300	?RENCSW←←1			;WANT A RE-ENTRANT COMPILER
14400	?RENSW←←1			;WANT A RE-ENTRANT RUNTIME
14500	?DECSW←←0			;NOT A DEC SYSTEM
14600	?EXPORT←←1			;AVOID STANFORD FEATURES
14700	?STANSW←←0			;IN FACT, EXPLICITLY NOT STANFORD
14800	?GLOBSW←←0			;NOT USUALLY GLOBAL FOR TENEX
14900	?GLOBC←←0			;
15000	STSW(LOADVR,=54)			;TENEX SITES SEEM TO HAVE V. 54
15100	>;TENX
15200	
15300	
15400	;; %BC% KVL 1-6-74	ADD BAILD SWITCH
15500	STSW (BAISW,1)		;USUALLY ON
15600	;; %BC%
     

00100	COMMENT ⊗ THE FILSPC STUFF -- OLDER HISTORY ⊗
00200	
00300	
00400	COMMENT ⊗
00500	VERSION 17(3) 8-19-73 BY RHT DECUS!!!
00600	VERSION 17(2) 7-26-73 
00700	VERSION 16-2(11) 7-26-73 BY JRL VERSION 17
00800	VERSION 16-2(10) 7-26-73 BY jrl RECONFIGURE FOR VERSION 17
00900	VERSION 16-2(9) 1-8-73 BY JRL LIB NAMES NOW LIBSA5,HLBSA5
01000	VERSION 16-2(8) 12-2-72 BY RHT CONFIGURE FOR SAISG5, ETC
01100	VERSION 16-2(7) 9-21-72 BY JRL RECONFIGURE FOR SAIL
01200	VERSION 16-2(6) 8-29-72 BY RHT CONFIGURE FOR NSAIL (PROCESSES, EVENTS, ETC.)
01300	VERSION 16-2(5) 7-2-72 BY RHT PUT UP VERSION 16
01400	VERSION 16-2(4) 6-25-72 BY DCS SAISG4 UPDATES V16 FEATURES
01500	VERSION 16-2(3) 6-24-72 BY DCS BUG #HX# PARAM PROCESSOR NAME, LIBRARIES
01600	VERSION 16-2(2) 5-13-72 BY DCS INSTALL VERSION 16
01700	VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
01800	
01900	⊗;
     

00100	; FILSPC FILES
00200	
00300	IFNDEF TSTSEG,<TSTSEG←←0>
00400	NOTENX <
00500	IFN TSTSEG,<
00600	DEFINE FILXXX <SIXBIT /SAISGT/>
00700	DEFINE SLOFIL <SIXBIT /SAILWT/>
00800	DEFINE SGDEVC <SIXBIT /DSK/>
00900	STANFO <
01000	DEFINE SGPPNN <SIXBIT /  SAIL/>
01100	>;STANFO
01200	NOSTAN <
01300	DEFINE SGPPPN <0>
01400	>;NOSTAN
01500	?LOCSYM←←1
01600	?NOPROT←←1
01700	>
01800	IFNDEF FILXXX,<DEFINE FILXXX <SIXBIT /SAISG8/>>
01900	;SAILOW FOR PROCESSOR SAIL, EXTENSION SAI
02000	;SAILOX  "	      OSAIL,   "      OSA
02100	;SAILOY  "	      NSAIL,   "      NSA
02200	IFNDEF SLOFIL,<DEFINE SLOFIL <SIXBIT /SAILOW/>>;PRODUCTION SAIL
02300	IFNDEF SGDEVC,<DEFINE SGDEVC <SIXBIT /SYS/>>
02400	IFNDEF SGPPNN,<DEFINE SGPPNN <0>>
02500	IFNDEF LOCSYM,<?LOCSYM←←0>;DON'T WANT LOCAL SEGMENT SYMBOLS
02600	IFNDEF NOPROT,<?NOPROT←←0>	;DON'T WANT SEGMENT PROTECT IF NOT GLOBAL
02700	
02800	DEFINE PROCSR <ASCIZ /SAIL: />	;FOR PRINTOUT OF PROCESSOR
02900	DEFINE RPGFIL <SIXBIT /QQSAIL/> ;FOR COMPIL PURPOSES
03000	DEFINE DEFEXT <'SAI'>		;DEFAULT EXTENSION
03100	IFNDEF BKTFIL,<DEFINE BKTFIL <=9
03200				     POINT 7,[ASCIZ /BKTBL.BKT/],-1 >>
03300	
03400	?LIBLEN←←=10				;LENGTH OF FOLLOWING STRINGS
03500	DEFINE LIBLOW <ASCIZ /SYS:LIBSA8/>	;REQUIRED LIBRARIES
03600	DEFINE LIBHI  <ASCIZ /SYS:HLBSA8/>	; (HISEG VERSION)
03700	BAIL<
03800	?BALENG←←=12				;LENGTH OF FOLLOWING STRING
03900	DEFINE BAILOD <ASCIZ /SYS:BAIL.REL/>	;RESIDENCE OF BAIL
04000	;;%##% JFR 2-16-75 FOR KNOWLEDGE OF SAIL RUNTIMES
04100	?BPDALN←←=14				; LENGTH OF FOLLOWING STRING
04200	DEFINE BAIPDS <ASCIZ /SYS:BAIPD8.REL/>
04300	>;BAIL
04400	
04500	DEFINE OPDEV   <SIXBIT /SYS/>		;DEVICE FOR OPCODE FILE
04600	DEFINE OPNAME  <SIXBIT /2OPS2/>		;NAME OF SAME (EXTEN ALWAYS OPS)
04700	DEFINE OPPPN   <0>			;WHERE IT'S AT
04800	
04900	GLOB <
05000	DEFINE FILXXX <SIXBIT /GLBSG8/>
05100	DEFINE SLOFIL <SIXBIT /GLBLOW/>
05200	DEFINE SGDEVC,<SIXBIT /SYS/>
05300	DEFINE SGPPNN,<0>
05400	?NOPROT←←1
05500	?LOCSYM←←1
05600	>;GLOB
05700	
05800	CMU <
05900	GGAS <	;OH WELL
06000	DEFINE SGDEVC <SIXBIT/DSK/>
06100	DEFINE FILXXX <SIXBIT/CONSEG/>
06200	DEFINE SGPPNN <XWD 1305,60410>	
06300			;KLUDGE - HACK - A700CR00, WHEREON THE CONTROLLER LIVES.
06400	>;GGAS
06500	>;CMU
06600	>;NOTENX
06700	
06800	TENX <
06900	IFN TSTSEG,<
07000	IFNDEF FILXXX,<DEFINE FILXXX <ASCIZ /<SAIL>T-SAISGT.SAV/>>
07100	IFNDEF SLOFIL,<DEFINE SLOFIL <SIXBIT /SAILWT/>>
07200	?LOCSYM←←1
07300	?NOPROT←←1
07400	IFNDEF LIBLOW,<DEFINE LIBLOW <ASCIZ /LIBSAT.REL/>>
07500	?LIBLEN←←=10
07600	>;IFN TSTSEG
07700	BAIL<
07800	?BALENG←←=14				;LENGTH OF FOLLOWING STRING
07900	DEFINE BAILOD <ASCIZ /<SAIL>BAIL.REL/>	;RESIDENCE OF BAIL
08000	;;%##% JFR 2-16-75 FOR KNOWLEDGE OF SAIL RUNTIMES
08100	?BPDALN←←=16
08200	DEFINE BAIPDS <ASCIZ /<SAIL>BAIPD8.REL/>
08300	>;BAIL
08400	IFE TSTSEG,<
08500	IFNDEF FILXXX,<DEFINE FILXXX <ASCIZ /<SAIL>T-5-SAISG8.SAV/>>
08600	IFNDEF SLOFIL,<DEFINE SLOFIL <SIXBIT /LOWTSA/>>
08700	IFNDEF SLOLOD,<DEFINE SLOLOD <ASCIZ/SYS:LOWTSA,/>>	;FOR INTERFACE TO LOADER
08800	?LOCSYM←←0
08900	?NOPROT←←0
09000	IFNDEF LIBLOW,<DEFINE LIBLOW <ASCIZ /<SAIL>LIBSA8.REL/>>
09100	IFNDEF LIBHI,<DEFINE LIBHI <ASCIZ /<SAIL>HLBSA8.REL/>>
09200	IMSSS<
09300	IFNDEF SDTLOD,<DEFINE SDTLOD <ASCIZ/,SDDTRL[S,AIL]/>>
09400	>;IMSSS
09500	?LIBLEN←←=16
09600	>;IFE TSTSEG
09700	IFNDEF SEGPAG, <
09800	?SEGPAG←←630				;PAGE WHERE THE SEGMENT STARTS
09900	>;IFNDEF SEGPAG
10000	IFNDEF STARTPAGE, <
10100	?STARTPAGE←←610				;PAGE WHERE CHANNEL BUFFERS BEGIN
10200	>;IFNDEF STARTPAGE
10300	IFNDEF JFNSIZE, <
10400	?JFNSIZE←←20				;NUMBER OF CHANNELS ALLOWED
10500	>;IFNDEF JFNSIZE
10600	IFNDEF RUNLOD,<DEFINE RUNLOD <=18
10700				      POINT 7,[ASCIZ/<SUBSYS>LOADER.SAV/],-1 >>
10800	IFNDEF BKTFIL,<DEFINE BKTFIL <=15
10900				     POINT 7,[ASCIZ /<SAIL>BKTBL.BKT/],-1 >>
11000	IFNDEF UDTFIL,<DEFINE UDTFIL <ASCIZ /<SAIL>UDDT.SAV/>>
11100	IFNDEF OPFILE,<DEFINE OPFILE <ASCIZ /<SAIL>3OPS3.OPS/>>
11200	>;TENX
     

00100	; NARRATIVE FILSPC ACCOUNTS
00200	
00300	STANFO <  ; ACTUALLY, NOT KEPT UP LATELY
00400	COMMENT ⊗
00500	HISTORY OF SAIL SYSTEMS
00600	3-1-71   VERSION 'SG1',,10
00700	 NEW SAIL SYSTEM UP, COMPILER AND RUNTIME
00800	 FEATURES:
00900	   NEW SEGMENT SCHEME ELIMINATES SAISYM GARBAGE, ALLOWS EXPO SHARED
01000		SEGMENTS, USE OF LATEST DEC LOADER.
01100	   NEW RAID WENT UP AT SAME TIME.
01200	   NEW LOADER (.052 MODIFIED) AT SAME TIME; WORKS AS LISP LOADER.
01300	   NEW DDT?
01400	   I/O ERROR ENABLE BUSINESS; BETTER SUBSTRING STUFF;
01500		PUNCTUATION ERROR ENABLE IN LOOKUP, ETC.
01600	   NONSTD BUFFER SIZES
01700	   USERCON
01800	   FREITM
01900	   GC CHANGE (WORKS WITH XPAND 0)
02000	   CVFIL, CVOS BETTER.
02100	3-12-71  GLOBAL SEGMENT GLBLOW,GLBSG2 UP
02200	   FIXED PTYALL BUG, WHICH CAUSED MESSAGE PROCEDURES TO BLOW
02300	3-15-71 GLOBAL SEGMENT GLBLOW,GLBSG3 UP
02400	   PTYALL FIXES SOME MORE -- GLUB.
02500	3-21-71  GLBLOW, GLBSG4 CREATED, TESTED
02600	    REQUIRE -1 NEW!ITEMS (GLOBAL OR NOT) INHIBITS LOCAL MODEL
02700	3-21-71 FILES FOR RUNTIMES, GREATLY MODIFIED, TRANSFERRED
02800	    FROM T,AIL WHERE THEY HAD BEEN SUCCESSFULLY TESTED IN
02900	    ALL CONFIGURATIONS I COULD THINK OF -- FACILITATE MUCH
03000	    MORE RAPID LIBRARY CREATION (THERE IS NOW ONLY 1 SCISS).
03100	6-22-71  MESPRO CHANGED TO ADD NEW FEATURE TO PUT!DATA.
03200	
03300	7-16-71 VERSION 'SG2',,11  (version SG6 for global model)
03400	 NEW SAIL SYSTEM, COMPILER AND RUNTIME
03500	 FEATURES:
03600	  CASE STATEMENT IMPROVEMENTS OUTLINED IN NEWMAN AND DOCS.UPD
03700	  REQUIRE n VERSION IMPLEMENTED
03800	  MYRIAD BUGS FIXED
03900	  LEABOT AND FRLOC TABLES ELIMINATED FROM USER TABLE
04000	  REQUIRE -1 NEW!ITEMS GIVES NO LOCAL MODEL ALLOCATION
04100	  RETURN CODE CHANGED -- MORE EFFICIENT -- NOW A LOCAL STRING
04200	    VARIABLE MAY BE RETURNED FROM A RECURSIVE STRING PROCEDURE.
04300	  AOS PAT/SOS PAT STUFF REMOVED FROM GENERATED PROCEDURES.
04400	  FREITM MOVED TO BE WITH OTHERS IN USER TABLE
04500	  THE RES COUNTER SYSTEM (/K) INSTALLED (SEE DOCS.UPD ETC.)
04600	7-21-71 VERSION GLBLOW,GLBSG7 UP
04700		MESSAGE PROCEDURE ROUTINE PUT!DATA(0,0,NAME) CHANGED TO REQUIRE
04800	ALL JOBS ENTERED TO HAVE SAME VERSION NUMBER
04900	10-20-71 VERSION GLBSG8 UP - RANDOM BUGS FIXED
05000	
05100	5-13-72 VERSION 16 (16 runtime) OF SAIL UP FOR EXPERIMENTATION
05200	 FEATURES:
05300	  1. Various improvements
05400	  2. New stack structure, up-level addressing, jumps out BY RHT
05500	  3. Improved LEAP by JRL
05600	  4. Improved macros by HJS
05700	 SAISG3
05800	6-25-72 VERSION 16 PUT UP AS STANDARD PROCESSOR,  NSAIL.  The files:
05900	  NSAIL.DMP[1,3] is the compiler, ext. NSA (uses SAISG4).
06000	  SAILOY.REL[1,3] is the low segment (always for NSAIL)
06100	  SAISG4.SEG[1,3] is the segment
06200	  LIBSA1, HLBSA1[1,3] are the libraries.
06300	 Will go back to SAISG3 shortly.
06400	7-3-72 VESRION 16 PUT UP AS STANDARD SAIL
06500	  OLD SAIL (VERSION "15") BECOMES STANDARD PROCESSOR "OSAIL"
06600		EXTENSION .OSA , LOW SEGMENT IS SAILOX (PREV SAILOW)
06700		SAISG2.REL IS ITS UPPER
06800	  NOW SAISG3.SEG IS THE UPPER, SAILOW.REL IS THE LOWER, LIBSA1, HLBSA1 
06900	  ARE THE LIBRARIES.
07000	10-22-72 NEWER, BETTER SAIL PUT UP.  SAISG4 IS THE SEGMENT
07100	
07200	12-7-72 VERSION 16 (REVISED) PUT UP AS STANDARD PROCESSOR
07300	 FEATURES:
07400	  1. miscellaneous bugs fixed
07500	  2. More LEAP modifications by JRL
07600	  3. CLEANUPs to blocks
07700	  4. User initialization happens as first executable statement.
07800	
07900	 SAISG5.SEG is the segment.  LIBSA5.REL is the library.
08000	
08100	7-25-73 VERSION 17 PUT UP AS STANDARD PROCESSOR (DECUS RELEASE??)
08200	 FEATURES
08300	  1. bug fixes
08400	  2. macro changes
08500	  3. process changes
08600	 SAISG6.SEG is the segment. LIBSA6.REL, the library.
08700	 GLBSG6.SEG is the global segment.
08800	
08900	8-19-73 TRANSFERRED FILES OVER TO X,AIL FOR DECUS RELEASE
09000	⊗
09100	>;STANFO
09200	
09300	
     

00100	;LISTING CONTROL MACROS & THE LIKE
00200	
00300	;VARIOUS HANDY MACRO DEFINITIONS TO TRY TO MAKE THE CODE
00400	;SOMEWHAT MORE READABLE.
00500	
00600	II←←1
00700	FOR @' JJ IN (HEAD,SAIL,PARSE,PDEFS,PRODS,SUBRS,SMTB,SYM,GEN,ARRAY) <
00800	?..'JJ←←II
00900	II←←II⊗1
01000	>
01100	FOR @' JJ IN (EXPRS,STATS,LEAP,TOTAL,COMSER,GOGOL,STRSER,IOSER,LEPRUN,MESPRO,WRDGET) <
01200	?..'JJ←←II
01300	II←←II⊗1
01400	>
01500	IFDEF SETLST,<SETLST>
01600	
01700	IFNDEF ..LIST,<
01800	..LIST←←0
01900	FOR @' JJ IN (HEAD,SAIL,PARSE,SYM,GEN,ARRAY,EXPRS,STATS,LEAP,TOTAL,COMSER) <
02000	?..LIST←←..LIST!..'JJ
02100	>
02200	FOR @' JJ IN (GOGOL,STRSER,IOSER,LEPRUN,MESPRO,WRDGET) <
02300	?..LIST←←..LIST!..'JJ
02400	>>
02500	IFDEF SETLS2,<
02600		SETLS2
02700	>
02800	DEFINE LSTON ' (JJ) <
02900		XLIST
03000	IFN ..LIST & ..'JJ,<
03100		LIST>
03200	>
03300		LSTON	(HEAD)
03400	
03500	DEFINE DSCR <COMMENT ⊗ > ; FOR DIRECTORY MAKER
03600	
03700	DEFINE GEN <IFE .NOGEN,<LALL>>
03800	DEFINE NOGEN <XALL>
03900	?.NOGEN←←1	;DON'T EXPAND MACROS AT ALL AFTER FIRST NOGEN
04000		NOGEN
04100	
04200	DEFINE IFNB (X) <IFDIF <><X>,>
04300	DEFINE IFB (X) <IFIDN <><X>,>
04400	
04500	
04600	DSCR  STORAGE MANAGEMENT MACROS
04700	⊗
04800	
04900	DSCR  HERE
05000	CAL MACRO
05100	PAR ROUTINE NAME
05200	DES For runtime routine vector.  If this is a library or one-segment
05300	 run, this is equivalent to placing a label "HERE".  Otherwise, the
05400	 label is placed on a JRST instruction in a vector of JRST's in the
05500	 upper segment.  The  JRST is to "HERE".  This allows the code for
05600	 runtimes to be changed without forcing everyone to forsake their
05700	 SAIL-compiled core images.
05800	⊗
05900	
06000	NOTENX <
06100	?DSPLEN←←=260
06200	>;NOTENX
06300	TENX <
06400	?DSPLEN←←=330	;LAST CHANGED 3-26-75, FROM 300
06500	>;TENX
06600	GLOB <
06700	?DSPLEN←←DSPLEN+=50 ; SINCE THIS TAKES MORE
06800	>;GLOB
06900	
07000	;;#SM# 5-30-74 RLS TEST FOR OVERFLOW OF DISPATCH TABLE
07100	DEFINE HERE(X) <
07200	UP <
07300		FQQQQ ←← .
07400		USE DSPCH	;SO THAT THE LABELS HAVE THE SAME ADDRESS
07500				;FROM ONE ASSEMBLY TO ANOTHE.
07600	↑↑ X :	JRST	FQQQQ
07700	IFGE .-DSPBAS-DSPLEN, <
07800	PRINTS / Dispatch vector size exceeded, bump DSPLEN
07900	/
08000	>;
08100		USE
08200	>;UP
08300	NOUP <
08400	↑↑ X :			;IF NOT MAKING AN UPPER SEGMENT, DOES NOT MATTER.
08500	>;NOUP
08600	>
08700	;;#SM#
08800	
08900	DEFINE HEREFK (X,XFAKE) <
09000	UP<
09100	↑↑ XFAKE:		; A FAKE LABEL (FELLOW WILL HAVE REAL THING IN SPARES
09200	>;UP
09300	NOUP <
09400	HERE(X)			;ONLY MATTERS IF MAKING A SEGMENT
09500	>;NOUP
09600	>
09700	
09800	DSCR SETCOR (SIZE,FIRST,LAST)
09900	CAL MACRO
10000	PAR SIZE is CORGET size desired
10100	 FIRST (optional) is vbl which will point to first word
10200	 LAST (optional) is vbl which will point to first word after block
10300	RES CORGET called, B put into FIRST, LAST computed
10400	ERR if not enough core, complains
10500	DES used in ALLOC (SAILOR sequence)
10600	SEE ALLOC
10700	⊗
10800	
10900	DEFINE SETCOR (SIZE,FIRST,LAST) <
11000		MOVE	C,SIZE
11100		PUSHJ	P,CORGET
11200		ERR	<CAN'T GET CORE FOR FIRST ALLOCATION>
11300		IFDIF <FIRST><>, <MOVEM	B,FIRST>
11400		IFDIF <LAST><>,<
11500			ADD	C,B
11600			MOVEM	C,LAST
11700	>>
11800	
11900	DSCR DATA, ZERODATA, TABLEDATA,--etc.
12000	CAL MACRO
12100	PAR One argument, a description
12200	RES For ZERODATA, the ZVBLS PC is switched to for the data.  For others,
12300	 the VBLS PC.  A check is made to ensure that the appropriate area is
12400	 big enough for the new data.
12500	DES This allows data to be concentrated in one area (for reentrancy
12600	 consideration, one-instruction CLEAR operations, etc.), but to
12700	 be defined locally.  Some special purpose programs can examine the
12800	 CREF listing file to print summaries, sorted cross-references, etc.
12900	⊗
13000	
13100	DEFINE DATA (MSG) <
13200		USE	VBLS
13300		IFGE	.-DBASE-DSIZE,<
13400		PRINTX	DATA AREA TOO SMALL [you will get a FAIL error on next line]
13500		#DATERR
13600	>>
13700	
13800	DEFINE TABLEDATA (MSG) <
13900		ZERODATA ()
14000	>
14100	
14200	DEFINE TABCONDATA (MSG) <
14300		DATA ( )
14400	>
14500	
14600	DEFINE ZERODATA (MSG) <
14700		USE	ZVBLS
14800		IFGE	.-ZBASE-ZSIZE,<
14900		PRINTX	ZEROED DATA AREA TOO SMALL [you will get a FAIL error on next line]
15000		#DATERR
15100	>>
15200	
15300	DEFINE BITDATA (MSG) <	USE>
15400	
15500	DEFINE BITDDATA (MSG) <	USE>
15600	
15700	DEFINE BIT2DATA (MSG) <	USE>
15800	
15900	DEFINE BITD2DATA (MSG) < USE>
16000	
16100	DEFINE ACDATA (MSG) <	USE>
16200	
16300	DEFINE AC2DATA (MSG) <	USE>
16400	
16500	DEFINE ENDDATA <
16600	IFDEF ZBASE, <
16700		DATA ()		;CHECK
16800		ZERODATA ()		;CHECK
16900		USE
17000	>>
17100	
17200	
17300	
17400	
17500	COMMENT ⊗
17600	
17700	DSCR LEVPOINT
17800	DES CHEAP MACRO TO GENERATE POINTERS TO DISPLAY LEVEL FIELD OF WORDS
17900	⊗
18000	
18100	DEFINE LEVPOINT(AD)< POINT DLFLDL,AD,35-LLFLDL>
18200	
18300	;;%  % CMU STYLE TRAP CALL MACRO -- SHOULD REALLY BE TURNED INTO ROUTINE CALL
18400	DEFINE TRPCAL (P1,P2,P3,P4,ADR) <
18500	BEGIN
18600		SKIPN	ADR
18700		 JRST 	 NOTRP
18800	CMU <  GGGON	;
18900	>;CMU
19000	GLOB <
19100		PUSH	P,USER
19200		MOVE	USER,GOGTAB	;IT MAY HAVE BEEN GLUSER
19300	>;GLOB
19400		PUSH	P,TEMP
19500		PUSH	P,UUO1(USER)
19600		MOVEI	TEMP,.TRACS
19700		BLT	TEMP,.TRACS+11
19800		MOVE	TEMP,-1(P)
19900		PUSH	P,P1
20000		PUSH	P,P2
20100		PUSH	P,P3
20200		PUSH	P,P4
20300		PUSHJ	P,@ADR
20400		MOVSI	TEMP,.TRACS
20500		BLT	TEMP,11
20600		POP	P,UUO1(USER)
20700		POP	P,TEMP
20800	GLOB <
20900		POP	P,USER		;GET IT BACK
21000	>;GLOB
21100	CMU <   GGGOFF			;DELSELECT GLOBAL STUFF
21200	>;CMU
21300	NOTRP:
21400	BEND
21500	>;END TRPCAL DEF
     

00100	; MACHINE-EXTENDING MACROS (SOME USEFUL CONSTANT, STORAGE/STORAGE MANIPULATORS)
00200	
00300	DSCR MOVEWI, MOVEW, MOVE6, MOVEI7, LOAD6, LOADI7
00400	CAL MACRO
00500	DES Provide extended "instructions" for data movement
00600	 MOVEWI(I,J) moves J (immed) to I via TEMP
00700	 MOVEW(I,J)  moves J to I via TEMP
00800	 MOVE6(I,J)  moves SIXBIT /J/ to I via TEMP
00900	 MOVEI7(I,J) moves addr of ASCIZ /J/ to I via TEMP
01000	 LOAD6 (I,J) moves SIXBIT /J/ to AC I
01100	 LOADI7(I,J) moves addr of ASCIS /J/ to AC I
01200	SID TEMP -- sometimes changed
01300	⊗
01400	
01500	DEFINE MOVEWI (I,J) <
01600			MOVEI TEMP,J
01700			MOVEM TEMP,I
01800	>
01900	
02000	DEFINE MOVEW (I,J) <
02100			MOVE	TEMP,J
02200			MOVEM	TEMP,I
02300	>
02400	
02500	DEFINE MOVE6 (I,J) <
02600			MOVE	TEMP,[SIXBIT /J/]
02700			MOVEM	TEMP,I
02800	>
02900	
03000	DEFINE MOVEI7 (I,J) <
03100			MOVEI	TEMP,[ASCIZ /J/]
03200			MOVEM	TEMP,I
03300	>
03400	
03500	DEFINE LOAD6 (I,J) <
03600			MOVE	I,[SIXBIT /J/]
03700	>
03800	
03900	DEFINE LOADI7 (I,J) <
04000			MOVEI	I,[ASCIZ /J/]
04100	>
04200	
04300	DSCR	PWORD,PCHAR,IPWORD,IPCHAR,PLEFT,PRIGHT,IPLEFT,IPRIGHT
04400	CAL MACRO
04500	DES MAKE BYTE POINTERS EASIER TO TYPE
04600	  THE ONES WITH "P" ARE SETUP SO THAT AN LDB FETCHES THE VALUE
04700	  THE ONES WITH "IP" ARE SETUP SO THAT AN ILDB FETCHES THE VALUE
04800	⊗
04900	
05000	DEFINE PWORD (A) <
05100		POINT	36,A,35>
05200	DEFINE PLEFT (A) <
05300		POINT	18,A,17>
05400	DEFINE PRIGHT (A) <
05500		POINT	18,A,35>
05600	DEFINE PCHAR (A) <
05700		POINT	7,A,35>
05800	DEFINE IPWORD (A) <
05900		POINT	36,A>
06000	DEFINE IPLEFT (A) <
06100		POINT	18,A>
06200	DEFINE IPRIGHT (A) <
06300		POINT	18,A,17>
06400	DEFINE IPCHAR(A) <
06500		POINT	7,A>
06600	
06700	DSCR SAVACS, RESTACS (L)
06800	CAL MACRO
06900	PAR a list like <A,C,LPSA>
07000	RES specified AC's pushed on (popped from) P-stack
07100	⊗
07200	DEFINE SAVACS (L) <
07300	 FOR II IN  L ,<
07400		PUSH	P,II
07500	>>
07600	DEFINE RESTACS (L) <
07700	FOR II  IN  L, <
07800		POP	P,II
07900	>>
08000	
08100	DSCR CALL6(I,J)
08200	CAL MACRO
08300	PAR I is AC# if J is present, else see J
08400	 J is symbolic value for a system CALL
08500	RES does CALLI AC,U&INDEX 
08600	 AC defaulted to 0
08700	⊗
08800	
08900	NOTENX <
09000	NOSTANFO <
09100	DEFINE CALL6 ' (I,J) <
09200		IFDIF <><J>,<
09300			IFDIF <><I>,<CALLI I,U'J;>  CALLI U'J
09400	>
09500		IFIDN <><J>,<
09600			CALLI	U'I
09700	>>
09800	>;NOSTANFO
09900	
10000	STANFO <
10100	DEFINE CALL6 ' (I,J) <
10200		IFDIF <><J>,<
10300			IFDIF <><I>,<J I,;> J
10400	>
10500		IFIDN <><J>,<
10600			I
10700	>>
10800	>;STANFO
10900	
11000	NOSTANFO <
11100	DEFINE CX ' (Y,Z) <
11200	?U'Y←←Z
11300	>
11400	
11500		CX RESET,0	;0 RESET IO
11600		CX DDTIN,1	;1 EXT-GET DDT CHAR.
11700		CX SETDDT,2	;2 SETDDT LOC IN PROTECTED JOB DATA
11800		CX DDTOUT,3	;3 EXT:SEND DDT CHAR.
11900		CX DEVCHR,4	;4 DEVICE CHARACTISTICS
12000		CX DDTGT,5	;5 GET DDT MODE
12100		CX GETCHR,6	;6 DEVICE CHAR.(DIFF. NAME)
12200		CX DDTRL,7	;7 RELEASE DDT MODE
12300		CX WAIT,10	;10 WAIT TILL DEVICE INACTIVE
12400		CX CORE,11	;11 CORE UUO
12500		CX EXIT,12	;12 EXIT
12600		CX UTPCLR,13	;13 CLEAR DEC TAPE DIRECTORY 
12700		CX DATE,14	;14 GET DATE
12800		CX APRENB,16	;16 ENABLE APR FOR TRAPPING
12900		CX SWITCH,17	;20 RETURN DATA SWITCHES
13000		CX REASSIGN,21	;21 REASSIGN DEVICE TO ANOTHER JOB
13100		CX TIMER,22	;22 RETURN JIFFY CLOCK TIME
13200		CX MSTIME,23	;23 RETURN TIME OF DAY IN MS
13300		CX GETPPN,24	;24 RETURN PROJECT-PROGRAMMER NUMBER
13400		CX TRPSET,25	;25 SET PI TRAP LOC, AND USER IO
13500		CX TRPJEN,26	;26 DISMISS INTERRUPT TO EXEC MODE
13600		CX RUNTIM,27	;27 RETURN TOTAL JOB RUNNING TIME
13700		CX PJOB,30	;30 RETURN JOB NUMBER
13800		CX SLEEP,31	;31 SLEEP FOR N SECONDS, THEN RETURN TO USER
13900		CX SETPOV,32	;32 SET PUSH DOWN OVERFLOW TRAP
14000					;(FOR COMPATIBILITY ONLY)
14100		CX PEEK,33	;33 PEEK INTO SYSTEM CORE.		;JS
14200		CX GETLIN,34	;34 GET NAME OF TTY
14300		CX RUN,35	;35 RUN COMMAND
14400		CX SETUWP,36	;36 SET USER WRITE PROTECT
14500		CX REMAP,37	;37 REDO CORE MAP
14600		CX GETSEG,40	;40 GET SEGMENT
14700		CX GETTAB,41	;41 GETTAB ILLEGAL AT STANFORD.
14800	>;NOSTANFO
14900	>;NOTENX
15000	
15100	
     

00100	;  TELETYPE COMMUNICATION MACROS
00200	
00300	DEFINE OP1 &(OPR,MS,ACC)  <
00400		IFIDN <ACC><>, <II←←0>
00500		IFDIF <ACC><>, <II←←ACC>
00600		OPR&. II,[ASCIZ /MS/]
00700	>
00800	
00900	DSCR IOERR (STR)
01000	CAL MACRO
01100	PAR ASCII string to be printed
01200	RES calls IOERR. UUO to print message, either restart
01300	 compiler or EXIT
01400	⊗
01500	
01600	DSCR ERR (STR,CODE,ROUT)
01700	CAL MACRO -- calls ERR. UUO
01800	PAR STR ASCII string to be printed
01900	 CODE determines how UUO functions
02000	 ROUT is address or literal to jump to if ERR continues
02100	RES If SAIL is on DPY, displays input line
02200	 Prints STR
02300	 CODE%2 determines what else to print -- if CODE is:
02400	  0-1:  Print nothing more
02500	  2-3:  Ident name for Semantics in LPSA (SAIL only)
02600	  4-5:  Ident name for Semantics in UUO instr (SAIL only)
02700	  6-7:  Value of AC in AC field of instr preceding UUO
02800	 10-11: The UUO in octal
02900	 12-13: Value of AC field of instr preceding that indicated
03000	        by UUO1(GOGTAB)
03100	
03200	 If CODE is even, don't allow continuation -- otherwise
03300	  allow continuation in manner described by error message.
03400	 If ROUT is present, jump to it -- else continue in line
03500	⊗
03600	FOR OP  IN  (ERR,IOERR) <
03700	DEFINE OP (MSG,AC,ADDR) <
03800		IFIDN	<ADDR><>,<OP1 (OP,<MSG>,AC)>
03900		IFDIF <ADDR><>,<JRST	[OP1 (OP,<MSG>,AC)
04000				   JRST	ADDR ]>
04100	>>
04200	
04300	DSCR CORERR
04400	CAL MACR
04500	PAR	message
04600	RES	Types the message, then exits the program 
04700	SID none
04800	⊗
04900	DEFINE CORERR(MSG) < JRST [	PUUO	3,[ASCIZ /MSG
05000	/]
05100	NOTENX <
05200					HALT	.	;DOT IN LITERALS REFERS TO THE
05300							;LOC COUNTER OUTSIDE THE LITERAL
05400	>;NOTENX
05500	TENX <
05600					JSYS	HALTF
05700	>;TENX
05800								]>
05900	
06000	DSCR PRINT, TERPRI (STR)
06100	CAL MACRO -- calls prin.. uuo.  
06200	PAR Ascii message
06300	RES Types string -- types CRLF after if TERPRI -- ERRPRI sends to log file if
06400	user is enabled for that.
06500	SID none
06600	⊗
06700	DEFINE ERRPRI (X) <
06800		PUSH	P,A
06900		MOVEI	A,[ASCIZ /X
07000	/]
07100		PUSHJ	P,PRINT.
07200		POP	P,A
07300	>
07400	
07500	DEFINE PRINT (X) <
07600		PUUO 3,[ASCIZ /X/]
07700	>
07800	
07900	DEFINE TERPRI (X) <
08000		PUUO	3,[ASCIZ /X
08100	/]>
08200	
08300	DEFINE SPRINT(X) <	;SAFE PRINT, BEFORE UUO SET UP
08400		TTCALL 	3,[ASCIZ /X/]
08500	>
08600	
     

00100	;  INPUT/OUTPUT AIDS
00200	
00300	DSCR MAKCDB (CHN, NAM, MODE, I, O)
00400	CAL MACRO
00500	PAR CHN channel number
00600	 NAM Prefix for symbols defined
00700	 MODE data mode
00800	 I,O # input, # output buffers
00900	RES generates a table to specify all (most?) data about
01000	 a file (Source, Rel, Command, etc.), instructions
01100	 tailored for this channel -- it takes the form: 
01200	⊗
01300	
01400	DEFINE MAKCDB &  (CHN,NAM,MODD,I,O)  <
01500	NAM&CDB:
01600	NAM&MOD: MODD			;DATA MODE
01700	NAM&DEV: 0			;DEVICE NAME IN SIXBIT
01800	NAM&HED:
01900		IFN O,<XWD NAM&HDR,0;> NAM&HDR  ;BLOCK HEADER POINTER
02000	NAM&HDR: 0			;I/O HEADER BLOCK
02100	NAM&PNT: 0			;I/O BYTE POINTER
02200	NAM&CNT: 0			;I/O CHAR COUNT
02300	↑NAM&FIL: 0			;I/O FILE NAME
02400	↑NAM&EXT: 0			;I/O EXTENSION
02500	;;#%%# BY JFR 11-7-74 KEEP PPN HERE, TOO
02600	↑NAM&PPN: 0			;I/O PPN
02700	NAM&OP:	OPEN	CHN,NAM&CDB	;OPEN INSTRUCTION
02800	NAM&NT:
02900		IFN I,<LOOKUP CHN,NAME;> ENTER CHN,NAME
03000	NAM&SPC:
03100		IFN O,<OUTBUF CHN,O>
03200	IFE O,<
03300	NOSTANFO <
03400		 IFIDN <NAM> <SRC>, <
03500			PUSHJ P,[MOVEI TEMP,.+1 ; PTR TO DESCRIPTOR, CALL UINBF ROUTINE
03600				 JRST	UINBF] ;>INBUF CHN,I
03700	>;NOSTANFO
03800	STANFO <
03900			    UINBF CHN,.+1
04000	>;STANFO
04100	>;IFE O
04200	NAM&BFS: IFN O,<O;>	I		;# OF BUFFERS
04300		202	;MAKE BIGGER BUFFERS THAN NORMAL (INPUT ONLY)
04400	>
04500	
04600	DSCR CHKCHN, TSTERR, TSTEOF
04700	CAL MACRO
04800	PAR First argument is channel # (AC containing same for CHKCHN)
04900	 2d argument is routine name for CHKCHN, address for TSTEOF
05000	RES CHKCHN makes sure channel # in AC is legal
05100	  prints error message using routine name, if not legal
05200	 TSTERR does an error STATZ
05300	 TSTEOF jumps to Address if EOF is present on the channel
05400	⊗
05500	DEFINE CHKCHN (AA,ROUTIN) & <
05600			TRZE	AA,777760	;ZERO BITS AND TEST VALID
05700			ERR <ROUTIN&: INVALID CHANNEL NUMBER>
05800	>
05900	
06000	DEFINE TSTERR (CHAN) <
06100			STATZ CHAN,740000 ;ANY ERRORS?
06200	>
06300	
06400	DEFINE TSTEOF (CHAN,EOFADD) <
06500			STATZ CHAN,20000  ;END OF FILE?
06600			JRST EOFADD	  ; YES
06700	>
06800	
     

00100	; RANDOM OTHER MACROS
00200	
00300	DEFINE SETNIT <
00400		MOVE	TEMP,[PUSHJ P,%UUOLNK]	;MAKE SURE WE CAN DO UUOS
00500		MOVEM	TEMP,41
00600		MOVE	P,ALLPDP	;AND PUSHJ'S
00700	>
00800	
00900	DSCR SETPOV(AC,STR)
01000	CAL MACRO
01100	PAR AC REPRESENTING PUSH-DOWN POINTER
01200	STR REPRESENTING SOME SUGGESTIONS FOR ACTION WHEN THIS PTR OVERFLOWS
01300	RES POVTAB has one entry for each AC.  the string pointer (0 if none)
01400	 is put into this entry.  If a PDP in this AC overflows,  POVTRP, which
01500	 is enabled in SALNIT for PDL-OV, prints the string as a standard fatal
01600	 error message.  POVTRP is in  COMSER.
01700	SEE POVTRP
01800	⊗
01900	
02000	DEFINE SETPOV (AC,STR) <
02100	 IFIDN <STR><><MOVEI TEMP,0;>MOVEI TEMP,[ASCIZ ?STR?] ;GET VALUE
02200	 II←←(AC+17)&17			;BETWEEN 0 AND 17
02300	 JJ←←II-(2*(II/2))		;ODD OR EVEN
02400	 IFE JJ,<HRLM TEMP,POVTAB+(II/2); EVEN-- LEFT> HRRM TEMP,POVTAB+(II/2)
02500	>;SETPOV
02600	
02700	DSCR OPTSYM(SYM)
02800	CAL MACRO
02900	PAR SYM IS SYMBOL TO BE DEFINED
03000	RES IF  WHERSW  IS ON, THEN  SYM  is defined as a loader symbol
03100	with value of PCNT.
03200	Principally to help external code optimizer.
03300	⊗
03400	
03500	DEFINE OPTSYM(SYM)<
03600		MOVE	TEMP,[RADIX50 50,SYM]
03700		PUSHJ	P,OPTSY.
03800	>
03900	
     

00100	;TBITS DEFINITIONS
00200	
00300	DEFINE BIT(NAME,BITT) <IFDIF <NAME><SPARE>,<?NAME←←BITT>>
00400	DEFINE DEFTBS <
00500		BIT	(RES,400000)	;RESERVED WORD
00600		BIT	(CNST,200000)	;CONSTANT ENTRY
00700		BIT	(SPARE,100000)	;****
00800		BIT	(INTRNL,40000)	;INTERNAL SYMBOL (SYMBOL EXPORTED)
00900		BIT	(EXTRNL,20000)	;EXTERNAL SYMBOL (STORAGE FOUND ELSEWHERE)
01000		BIT	(MPBIND,10000)	;MATCHING PROCEDURE OR BINDING ITEMVAR
01100		BIT	(VALUE,4000)	;FORMAL PARAMETER CALL BY VALUE
01200		BIT	(REFRNC,2000)	;FORMAL PARAMETER CALL BY REFERENCE
01300		BIT	(CONOK,1000)	;OK TO CALL INTRINSIC WITH CONST ARGS AT COMPTIME
01400		BIT	(SIMPLE,400)	;FOR DISPLAY SYSTEMS ONLY
01500		BIT	(MESSAGE,200)	;A MESSAGE PROCEDURE !!!!!(STANFORD ONLY).
01600		BIT	(OWN,100)	;OWN VARIABLE ?
01700		BIT	(ANYTYP,40)	;ANYTYPED VARIABLE (USED IN PROCEDURE CALLS)
01800		BIT	(SAFE,20)	;SAFE -- FOR ARRAYS AND SUCH.
01900		BIT	(DEFINE,10)	;DEFINED MACRO IDENTIFIER
02000		BIT	(RECURS,4)	;THIS ROUTINE IS REENTRANT
02100		BIT	(BILTIN,2)	;IF ON IN TBITS, DON'T SAVE AC'S ON CALL.
02200		BIT	(SBSCRP,1)	;SUBSCRIPED VARIABLE (ARRAY)
02300	
02400	;RIGHT HALF BITS -- TBITS WORD.
02500	
02600		BIT	(INPROG,400000)	;PROCEDURE BEING DEFINED, KEEP FIXUP CHAIN
02700		BIT	(GLOBL,200000)	;GLOBAL LEAP VARIABLE
02800		BIT	(FORTRAN,100000);FORTRAN PROCEDURE (EXTERNAL)
02900		BIT	(FORWRD,40000)	;FORWARD PROCEDURE OR LABEL
03000		BIT	(PROCED,20000)	;PROCEDURE
03100		BIT	(SHORT,10000)	;SHORT INTEGER OR SHORT REAL
03200		BIT	(ITMVAR,4000)	;LEAP ITEMVAR
03300		BIT	(PNTVAR,2000)	;RECORD POINTER VARIABLE
03400		BIT	(BOOLEAN,1000)	;BOOLEAN VARIABLE ?? (SAME AS INTEGER FOR NOW
03500					; SEE TYPSET IN FILE "GEN"
03600		BIT	(ITEM,400)	;LEAP ITEM
03700		BIT	(STRING,200)	;A FHQ STRING
03800		BIT	(LPARRAY,100)	;TYPE OF THIS ITEM IS ARRAY
03900		BIT	(SET,40)	;LEAP SET
04000		BIT	(LABEL,20)	;LABEL
04100		BIT	(LSTBIT,10)	; COMPLEX NUMBER ?? (NOT IMPLEMENTED)
04200		BIT	(DBLPRC,4)	; DOUBLE PRECISION NUMBER ?? (NOT IMPLEMENTED)
04300		BIT	(FLOTNG,2)	;REAL NUMBER
04400		BIT	(INTEGR,1)	;INTEGER NUMBER
04500	
04600	;LEFT HALF OF %ERFLGS WORD -- STATE OF ERROR HANDLER
04700	
04800		BIT	(KEEP,1)	;DO NOT FLUSH TYPE AHEAD
04900		BIT	(QUIET,2)	;DO NOT PRINT MESSAGES
05000		BIT	(NUMBS,4)	;DO PRINT THE "CALLED FROM .." STUFF
05100		BIT	(LOGGIN,10)	;SEND MESSAGES TO LOG FILE
05200		BIT	(CONT,20)	;CONTINUABLE ERROR
05300		BIT	(AUTO,40)	;AUTOMATIC CONTINUATION MODE
05400		BIT	(LOGOPN,100)	;LOG FILE IS CURRENTLY OPEN
05500		BIT	(ERRNOW,200)	;WE ARE CURRENTLY IN THE MIDDLE OF AN ERR. UUO
05600		BIT	(MINUS,400)	;WE JUST SAW A MINUS!
05700		BIT	(MADEPT,1000)	;WE HAVE ALREADY MADE A BYTE POINTER FOR FAKETTY
05800		BIT	(BUFOPN,2000)	;HE HAVE A BUFFER FOR DUMP MODE LOGGING
05900	
06000	>
06100	
06200	DEFTBS		;DEFINE THE TBITS
06300	
06400	?FNYNAM ←← RECURS 		;EXTERNAL+OWN+FNYNAM MEANS EXT REQ IS FOR
06500					; FOO$ INSTEAD OF FOO (CF SIN)
06600	
     

00100	; VARIOUS DEFINITIONS OF USER UUO'S.
00200	NOKI10 <
00300	FLOAT←2B8	OPDEF	FLOAT	[2B8]
00400	STANFO <
00500	PDPFIX←<FIX>	OPDEF	PDPFIX	[FIX]
00600	>;STANFO
00700	FIX←3B8		OPDEF	FIX	[3B8]
00800	>;NOKI10
00900	
01000	KI10 <
01100	FLOAT←127000000000
01200			OPDEF	FLOAT	[127000000000]
01300	FIX←126000000000
01400			OPDEF	FIX	[126000000000]
01500	>;KI10
01600	
01700	IOERR.←4B8	OPDEF	IOERR.	[4B8]
01800	ERR.←5B8	OPDEF	ERR.	[5B8]
01900	SIXPNT←6B8	OPDEF	SIXPNT	[6B8]
02000	ARERR←7B8	OPDEF	ARERR	[7B8]
02100	;;%BI% --! RECORDS
02200	RECUUO ← 10B8	OPDEF	RECUUO	[10B8]
02300	DECPNT←11B8	OPDEF	DECPNT	[11B8]
02400	OCTPNT←12B8	OPDEF	OCTPNT	[12B8]
02500	;;%CJ% JFR 7-20-75
02600	ERRSPL←13B8	OPDEF	ERRSPL	[13B8]
02700	TENX <
02800	PUUO←15B8	OPDEF	PUUO	[15B8]
02900			OPDEF	TTCALL	[PUUO]
03000	>;TENX
03100	NOTENX <
03200	PUUO←<TTYUUO>	OPDEF	PUUO	[TTYUUO]
03300			OPDEF	TTCALL	[TTYUUO]
03400	>;NOTENX
03500	
03600	JFOV←<JFCL 1,0>	OPDEF	JFOV	[JFCL 1,0]
03700	
03800	;;3! JFR 9-17-75 CHEAP WAY TO GET SOME MICRO-EFFICIENCY
03900			OPDEF	TRZ	[ANDCMI]
04000			OPDEF	TRC	[XORI]
04100			OPDEF	TRO	[IORI]
04200	
04300	STANFO <
04400	DPYOUT←703B8	OPDEF	DPYOUT	[703B8]
04500	DPYCLR←701B8	OPDEF	DPYCLR	[701B8]
04600	UINBF←704B8	OPDEF 	UINBF	[704B8]
04700	
04800	?SEGSIZUUO 	← 400022	;GET SIZE OF SECOND SEGMENT.
04900	?CORE2UUO	← 400015	;GET SOME MORE SECOND SEGMENT.
05000	?GLBAR		←← 1000		;CURRENT LENGTH OF GLOBAL MODEL AREA.
05100	>;STANFO
05200	
05300	
05400	
05500	SUBTTL	SAIL/GOGOL USER TABLE DESCRIPTION
     

00100	DSCR USER DATA AREA TEMPLATE  
00200	DES These values serve as indices for the run-time routines
00300	  into the user's data table. The table is necessary to allow
00400	  the routines to be re-entrant.  The table is allocated
00500	  in the SAILOR sequence at startup time; many of its values
00600	  (data area bounds, etc.) are placed in it at that time.
00700	 One can force re-initialization of this and all other dynamic
00800	  areas by setting GOGTAB to 0 before next CORGET.
00900	SEE XX descriptions for all these goodies directly below
01000	⊗
01100	
01200	DEFINE XX (SYMBOL,SIZE,BACKUP) <
01300		?SYMBOL←←LOCAT
01400	IFN HEDSYM,<
01500		ENTRY	SYMBOL			;FOR HEAD.REL SYMBOL FILE
01600	>;N HEDSYM
01700		LOCAT←←LOCAT+1
01800		IFDIF<SIZE><>< LOCAT←←LOCAT+SIZE-1>
01900		IFDIF<BACKUP><>< LOCAT←←LOCAT-BACKUP>
02000	>
02100	
02200	LOCAT←←0		;MAKES SYMBOLS ABSOLUTE
02300	
02400	; THESE VARIABLES WILL NOT BE RE-INITIALIZED BY THE INIT ROUTINE
02500	
02600	
02700	; LINK TO STRING BLOCKS FOR STRING GARBAGE COLLECTOR
02800	
02900	 XX CLER,,1
03000	
03100	 XX UUO1	;TRADITIONAL LOC FOR GOGOL RETRN ADRS FOR ERROR MSGS.
03200	
03300	;LOADER LINK CHAINS
03400	 XX STRLNK
03500	 XX SPLNK	;LINK END FOR SPACE ALLOCATION.
03600	 XX SETLNK	;LINK END FOR SETS.
03700	 XX SGROUT	;LINK UP STRING DSCRPTR GENERATOR ROUTINES HERE
03800	 XX KNTLNK	;PROFILE COUNTER LINK END
03900	
04000	;IMPORTANT STRING SPACE ENTRIES
04100	 XX ST		;BOTTOM OF STRING SPACE
04200	 XX STTOP	;TOP OF SAME
04300	;;%  % DCS 12-3-73 New entries
04400	 XX STLIST	;HEAD OF LIST OF STRING SPACES
04500	 XX TOPBYTE	;NEXT FREE BYTE
04600	 XX REMCHR	;-REMAINING FREE CHARS
04700	;;#GI# DCS 2-5-72 REMOVE TOPSTR
04800	 XX SGLIGN	;ON IF MUST BE ALIGNED TO FW BDRY (COMPILER ONLY).
04900	
05000	; I/O CHANNEL POINTER TABLE
05100	; EACH POINTS TO A "CHANNEL DATA BLOCK" FULL OF GOODIES
05200	 XX CHANS,20
05300	
05400	; I/O BREAK TABLES (FOR INPUT SCANNING ROUTINES)
05500	;;%BS%
05600	 XX BKTPRV		;0→UNPRIVILEGED, ≠0→PRIVILEGED
05700	 XX BKTPTR,4,,		;POINTERS TO CORGET BLOCKS OF 18 BREAKTABLES EACH
05800		DSPTBL←←0		;BREAK CHAR DISPOSITION TABLE
05900		LINTBL←←=19+DSPTBL	;LINE NUMBER    "	"
06000		BRKTBL←←=19+LINTBL	;BREAK CHAR TABLE
06100		BKJFFO←←=128+BRKTBL	;RESERVATION WORD
06200		BRKCVT←←1+BKJFFO	;UPPER CASE CONVERSION
06300		BRKOMT←←1+BRKCVT	;OMIT SPEED UP
06400		BRKDUM←←1+BRKOMT	;NOT USED NOW
06500	;;%BS% ↑ MOVED INTO CORGET BLOCK FOR BREAK TABLES
06600	
06700	;;%##% RHT THESE FOR ADDED RUNTIMES
06800	XX  TTYCVT		; DITTO FOR TTY INPUT
06900	XX  FSTATS		; FOR GETSTS
07000	
07100	 XX PDL		;IOWD SIZE,BASE  FOR SYSTEM PDL
07200	 XX SPDL	;XWD SIZE,BASE FOR STRING PDL
07300	
07400	STANFO <
07500	XX  ZAPBEG,,1	;BEGINNING OF SECOND SEGMENT COPY OF STUFF.
07600			;FOR GLOBAL MODEL ONLY.
07700	>;STANFO
07800	CMU <
07900	XX  ZAPBEG,,1	;JUST LIKE SU-AI
08000	>; CMU
08100	
08200	;LEAP   THINGS.
08300	
08400	STANFO <
08500	 XX CURMES		;CURRENT MESSAGE.
08600	>;STANFO
08700	 XX MAXITM		;CURRENT TOP ITEM NUMBER.
08800	 XX OLDITM		;LINKED LIST OF OLD ITEMS (DUMP HEAP).
08900	 XX INFOTAB		;POINTER TO "GOOD POINTER" BLOCK OF CORE.
09000	 XX DATAB		;POINTER TO DATUM AREA.
09100	 XX HASTAB		;POINTER TO THE LEAP HASH TABLE.
09200	 XX FP1			;FREE STORAGE -- 1 WORD.
09300	 XX FP2			;FREE STORAGE -- 2 WORDS.
09400	 XX HASMSK		;THE MASK FOR HASHING INTO OUR HASH SPACE.
09500	 XX HASHP		;FOR PNAMES. XWD NEXT FREE ARRAY ENTRY,ARRAY BASE.
09600	 XX MKBP		;MAKE BREAK-POINT
09700	 XX ERBP		;ERASE BREAK-POINT
09800	 XX PUBP		;PUT BREAK-POINT (NOT IMPLEMENTED)
09900	 XX REBP		;REMOVE BREAK-POINT.(NOT IMPLEMENTED)
10000	 XX ITMTOP		;MAXIMUM PERMISSIBLE ITEM NUMBER.
10100	 XX LEABOT		; PTR TO SEARCH CONTROL BLOCK FOR DERIVED SETS ERASE. 
10200	 XX FRLOC		; PTR TO CURRENT ACTIVE FOREACH CONTROL BLOCK POINTER
10300	 XX SCBCHN		; PTR TO CHAIN OF ABANDONED SCB'S
10400	 XX FREITM	;NUMBER OF FREE ITEMS REMAINING
10500	
10600	; MISC. ARRAY THINGS.
10700	 XX ARYDIR	;FOR TELLING FOUR ARRAY ROUTINES WHICH END IS UP.
10800	 XX ARYLS	;A LINKED LIST (LUCKILY) OF STRING ARRAYS IN LEAP, AND SO FORTH.
10900			;THIS IS SO STRING GARB COLLECTOR CAN FIND THEM ALL.
11000	
11100	; BLOCK CONTROL TABLE INFORMATION
11200	;THIS IS FOR SAIL'S CORE MANAGEMENT ROUTINES (CORGET,CORREL,CORINC...)
11300	
11400	XX BLKTAB,3,3	;BASE OF BLOCK CONTROL TABLE
11500	   XX LOWC	;LOW LIMIT OF ALLOCATABLE "BLOCK" CORE
11600	   XX TOP	;UPPER LIMIT OF SAME
11700	   XX FRELST	;POINTER TO BLOCK FREE STORAGE LIST
11800	
11900	 XX XPAND	;PERMISSION TO EXPAND IN CORREL IF 0
12000	 XX ATTOP	;REQUEST TO ALLOCATE OFF TOP OF CORE IF NON-0
12100	 XX NOSHRK	;IF ON, CORREL NOT GIVEN PERMISSION TO SHRINK CORE
12200	STANFO <
12300	 XX USCOR2	;IF ON, CORGET WILL USE CORE2 ROUTINES.
12400	>;STANFO
12500	
12600	 XX BUFACS,10,,	;FOR BUFFER ALLOCATOR
12700	STANFO <
12800	XX ZAPEND,,1	;END OF SECOND SEGMENT AREA.
12900	>;STANFO
13000	CMU <
13100	XX USCOR2		;THE COPYCATS
13200	XX ZAPEND,,1		;ditto ZAPBEG
13300	>;CMU
13400	
13500	; INTERNAL VARIABLES FOR RE-ENTRANT ROUTINES
13600	
13700	;;%  % DCS 12-3-73 New entries, delete some old ones (strngc) 
13800	 XX STBUCK,1,1	;USED IN STRING GC TO KEEP TRACK OF BLOCKS
13900	   XX OFFSET		;Distance to move a string space, see STRNGC
14000	 XX STINCR		;String space increment size, see STRNGC
14100	 XX STREQD		;String space threshold size, see STRNGC
14200	
14300	 XX SGCCNT		;NUMBER OF TIMES STRNGC HAS BEEN CALLED
14400	 XX SGCTIME		;Time of last GC if non-zero, else not enabled
14500	 XX SGCTOTAL		;Total GC time while enabled (set SGCTIME -1 to enable)
14600	 XX SGCNUM		;Number of strings collected last GC
14700	 XX SGCWASTE		;Number of wasted words after last GC
14800	
14900	 XX SRELOC
15000	 XX CODAC		;SAVE AC 1 OVER CALLS ON "CODE" RUNTIME ROUTINE
15100	 XX WDTH		;GLOBAL WIDTH FOR STRING CONVERSION ROUTNES
15200	 XX DIGS		; "" FOR # OF DECIMAL DIGITS
15300	
15400	; I/O INTERNAL VARIABLES
15500	
15600	 XX CDBLOC	;IF CHNL IS A CH #, @CDBLOC(USER) GETS ITS CDB ADDR
15700	
15800	 XX FNAME	;ENTER-LOOKUP TABLE
15900	 XX EXT
16000	 XX WD3
16100	 XX PRPN
16200	 XX LONGWD	;LONG FORM LOOKUPS AND ENTERS POKE THIS
16300	 XX LONG2	; AND THIS -- FILEINFO ROUTINE GIVES TO USER
16400	
16500	 XX PROJ		;USED BY FILNAM ROUTINE
16600	
16700	; AC SAVE AREAS
16800	
16900	 XX RACS,13,,	;RE-ENTRANT ROUTINES SAVE HERE
17000	 XX SGACS,14,,	;AVAILABLE ANY TIME IF YOU ARE NOT
17100	 		; LIKELY TO CALL STRNGC
17200	 XX STACS,14,,	;YET ANOTHER AC SAVE AREA
17300	 XX PGNNFL
17400	
17500	;SOME STUFF FOR MULTIPLE PROCESSES
17600	
17700	?NPRIS←←20	;NUMBER OF PRIORITIES
17800	 XX PRILIS,NPRIS,, 	;PRIORITY LIST HEADERS
17900	 XX GGDAD		;THE BASE FOR THE MAIN PROCESS (IF HAVE ONE)
18000	 XX TIMER		;COUNTED DOWN FOR CLOCK INTERRUPTS
18100	 XX SCHDRQ		;SET ≠0 FOR A SCHEDULER REQUEST
18200				;(USED BY EVENTS)
18300	 XX STKURT		;PLACE FOR STACKUNWINDER RETN ADRS
18400	 XX INTQWP		;INTERRUPT NOTICE BUFFER WRITE PTR
18500	 XX INTQRP		;READ PTR
18600	 XX INTQWT		;TOP OF BUFFER 
18700	 XX INTQWB		;BOTTOM OF BUFFER
18800	 XX INTPRC		;INTERRUPT PROCESS BASE
18900	 XX DISPAT		;DISPATCH TABLE FOR INTERRUPT LEVEL MODULE
19000	 XX DFRINF		; AOBJN PTR TABLE FOR DEFERRED INTERRUPTS
19100	NOTENX<
19200	 XX IPDP		;INTERRUPT PDP
19300	>;NOTENX
19400	TENX<
19500	 XX IPDP1
19600	 XX IPDP2
19700	 XX IPDP3
19800	 XX ISPDP1
19900	 XX ISPDP2
20000	 XX ISPDP3
20100	 XX TIMFRK		;TABLE OF FORK HANDLES FOR INTERRUPT SYSTEM, PROCESSES
20200	>;TENX
20300	 XX IJBCNI		;JOBCNI FROM A DEFERRED INTERRUPT
20400	 XX IJBTPC		;JOBTPC FROM DEFERRED INTERRUPT
20500	 XX IRUNNR		;RUNNER AT TIME OF DEFERRED INTERRUPT
20600	NOTENX<
20700	 XX ISPDP		;STRING PDP FOR INTERRUPT LEVEL
20800	>;NOTENX
20900	;;%##%  ADDING THESE
21000	 XX $FSLIS		;LIST OF FREE STORAGE ALLOCATORS
21100	 XX PRNINF		;$PRINT DEFAULTS
21200	;;%##% BY JFR 11-17-74 COMMUNICATION BETWEEN BAIL AND ERROR HANDLER
21300	 XX BAILOC		;IF NONZERO, ADDRESS OF BAIL INTERCEPT ROUTINE
21400	 XX JFRCEL		; USED TO BE XX <NOTHING>
21500	;;%CC% FOR STRNGC OF RECORD STRINGS
21600	 XX RSGCLK		;THE TWO WORD BLOCK REQUIRED BY SGINS
21700	 XX RSGCL2		; AND A SECOND WORD
21800	 XX STBLST		;HEAD OF CHAIN OF STRING DESCR ARRAYS FOR RECORDS
21900	;;%CC% ↑
22000	;;%DA%			
22100	 XX RGCOFF		;SET THIS TO TURN OFF AUTO GC
22200	 XX TGRADJ		;PUT PUSHJ ADR HERE TO ADJUST OWN TRIGGER LEVELS
22300	 XX RGCRHO		;-1.0+1/"%FILL" LEVEL DESIRED FOR RECORD SPACES
22400	;;%BR% -- RHT USED TO BE 2 %DA MADE IT 1 (FROM 4)
22500	 XX SPARUT,1,,		;SPARE USER TABLE ENTRIES
22600	;;%DA% ↑↑
22700	 XX PRTINF		;PRINT OUTPUT INFORMATION  XWD BITS,CHAN
22800	 XX $$PROU		;PRINT OUTPUT TRAP FOR ALL STRINGS
22900	 XX $$FINT		;USER FORMATTING FUNCTION FOR INTEGERS
23000	 XX $$FREL		; "         "       "      "  REALS
23100	 XX $$FITM		; "         "       "      "  ITEMS
23200	 XX $$FSET		; "         "	    "	   "  SETS
23300	 XX $$FLST		; "	    "	    "	   "  LISTS
23400	 XX $$FSTR		; "	    "       "      "  STRINGS
23500	 XX $$FREC		; "         "       "      "  RECORDS
23600	
23700	 XX ENDREN	; END OF USER DATA TABLE
23800	
23900	
24000	
24100	
24200	
24300	
     

00100	SUBTTL	Global AC Definitions, Indices, Bits
00200	
00300	AC2DATA (GLOBAL AC ASSIGNMENTS)
00400	?P	←17
00500	?SP	←16
00600	?USER	←15
00700	?TEMP	←14
00800	?LPSA	←13
00900	?RF	←←12			;THE ALMIGHTY F REGISTER
01000	?TAC1	←←TEMP
01100	?TAC2	←←LPSA
01200	
01300	BITDATA (BITS FOR %ALLOC SPACE REQUEST BLOCK ENTRIES)
01400	?STDSPC ←←400000	;"INDIRECT" SPECIFICATION OF STANDARD AREA
01500	?WNTADR ←←200000	;ADDRESS OF AREA TO BE STORED AS SPECIFIED
01600	?WNTEND ←←100000	;ADDRESS OF NEXT AREA TO BE STORED AS SPECIFIED
01700	?WNTPDP ←← 40000	;PDP TO AREA TO BE STORED " "
01800	?WNTPDL ←← WNTPDP	;WNTPDP, WNTPDL -- WHAT'S THE DIFFERENCE?
01900	?USRTB  ←← 20000	;RESULT ADDRESSES ARE IN THE USER TABLE
02000	?MINSZ  ←← 10000	;THIS SIZE TO BE USED ONLY IF NO OTHERS GIVEN
02100	
02200	BITDATA (INDICES OF STANDARDLY ALLOCATED AREAS (SEE %ALLOC))
02300	?SYSPD	←← 1		;SYSTEM!PDL
02400	?SYSSPD	←← 2		;STRING!PDL
02500	?STRSP	←← 3		;STRING!SPACE
02600	
02700	BITDATA (INDICES INTO THE FIXED PORTION OF EACH %ALLOC SPACE REQ. BLOCK)
02800	?$ITNO	←←1		;MAX ITEM NUMBER DECLARED THIS COMPILATION
02900	?$NWITM ←←2		;XWD REQUIRED BUCKETS,REQUIRE  NEW!ITEMS 
03000	?$GITNO	←←3		;MAX (MIN?) GLOBAL ITEM NUMBER DECLARED
03100	?$MSLNK	←←4		;POINTER TO MESSAGE PROCEDURE LIST PUT HERE
03200	?$PNMNO	←←5		;REQUIRE n PNAMES PUTS n HERE
03300	?$VRNO	←←6		;VERSION NUMBER
03400	?$SGNM	←←7		;REQUIRED GLOBAL SEGMENT NAME (USUALLY EMPTY)
03500	?$SGD	←←10		;REQUIRED GLOBAL SEGMENT FILE DEVICE
03600	?$SGF	←←11		;" FILE NAME
03700	?$SGPP	←←12		;" PPN
03800	?$TINIT ←←13		; POINTER TO INITIAL ITEM TYPES
03900	?$PINIT ←←14		; POINTER TO INITIAL PRINTNAMES
04000	?$CMVER ←← 15		;com version
04100	?$OBPDA ←← 16		; pointer to outer block pda
04200	?$SPREQ ←← 20		; leaves a spare
04300			; *** SEE ALSO SPCSIZ (TOTAL) IF CHANGE THIS ***
04400	ENDDATA
04500	
04600	
04700	BITDATA (LINK NAMES)
04800	?%STLNK ←← 1
04900	?%SPLNK ←← 2
05000	?%SETLK ←← 3
05100	?%SGROT ←← 4
05200	?%KTLNK ←← 5
05300	?%PDLNK ←← 6
05400	?%INLNK ←← 7
05500	?%RBLNK ←← 10
05600	BAIL<
05700	?%BALNK ←← 11
05800	>;BAIL
05900	;;%CB% ! NEED A NEW LINK TYPE
06000	?%RCLNK ←← 12		;RECORD CLASS LINK
06100	
06200	BITDATA (PROCEDURE DESCRIPTOR INDICES)
06300	
06400		DEFINE PDX(I),
06500			<?I ←← PD.XXX
06600			PD.XXX←←PD.XXX+1
06700	>
06800	PD.XXX	←← 0
06900		PDX	PD.	;0
07000		PDX	PD.ID1	;1
07100		PDX	PD.ID2	;2
07200		PDX	PD.PDB	;3
07300		PDX	PD.NPW	;4
07400		PDX	PD.DSW	;5
07500		PDX	PD.LLW	;6
07600		PDX	PD.DLW	;7
07700		PDX	PD.PDA	;10
07800		PDX	PD.PPD	;11
07900		PDX	PD.PCW	;12
08000		PDX	PD.BDI	;13
08100	
08200	?PD.XXX←←PD.XXX
08300	
08400	BITDATA (TYPE CODES WITHIN RH OF INFOTAB ENTRY)
08500		NOTYPE ←← 1	;NO TYPE AT ALL
08600	        BRKITM ←← 2	;BRACKETED TRIPLE
08700		STTYPE ←← 3	;STRING ITEM
08800		FLTYPE ←← 4	;REAL ITEM
08900		INTYPE ←← 5	;INTEGER ITEM
09000		LSTYPE ←← 7	;LIST ITEM (TYPE SHOULD ALWAYS BE 1 MORE THN SETYPE
09100		SETYPE ←← 6	;SET ITEM
09200		PITTYP ←← 10	;PROCEDURE ITEM
09300		PRCTYP ←← 11	;PROCESS ITEM
09400		EVTTYP ←← 12	;EVENT TYPE ITEM
09500		CTXTYP ←← 13	;CONTEXT ITEM
09600		RFITYP ←← 14	;REFERENCE ITEM
09700		RECTYP ←← 15	;RECORD
09800	;;%BR% -- ADD A FEW & LEAVE ROOM TO GROW
09900		LBLTYP ←← 16	;LABEL
10000		RCLTYP ←← 17	;RECORD CLASS
10100	;;#%%# 2! BY JFR 2-2-75 CLAIM ONE FOR BAIL
10200		ITVTYP ←← 20	;ITEMVAR
10300		MXSTYP ←← ITVTYP; LAST SIMPLE TYPE
10400		ARRTYP ←← 24	;ARRAYS ARE THIS PLUS SIMPLE TYPE CODE
10500				; used to be 15.
10600	;;%BR% ↑
10700		INVTYP ←← MXSTYP+ARRTYP+1; NON-VALID TYPE CODE
10800	
10900	BITDATA (RECORD CLASS TYPE BITS)
11000		NODELC ←← 1	;DO NOT DELETE RECORDS OF THIS CLASS (VIA GC)
11100		CMPLDC ←← 2	;THIS RECORD CLASS IS COMPILED-IN
11200		HASRPS ←← 4	;HAS RPTR / RPTR ARRAY
11300		HASSTR ←← 10	;HAS STRING / STRING ARRAY SUBFIELDS
11400	
11500	BITDATA( PROC DESC STUFF)
11600	?BLKCOD←←17				;BLOCK BOUNDARY CODE
11700	?EOPCOD←←0				;END OF PROC LVI CODE
11800	?AACOD←←1					;ARITH ARRAY
11900	?SACOD←←2					;STRING ARRAY
12000	?SETCOD←←3				;SET
12100	?LACOD←←4					;LIST OR SET ARRAY
12200	?FRCCOD←←5				;FOREACH STATEMENT
12300	?KLCOD←←6				;KILL LIST
12400	?CTXCOD ←← 7				;CONTEXT
12500	?CLNCOD ←← 10				;CLEANUP PROC
12600	?RPCOD ←← 11				;RECORD PTR
12700	?RPACOD ←← 12				;RECORD PTR ARRAY
12800	ENDDATA
12900	
13000	BITDATA (USE OF THE RESERVED ITEMS)
13100	; ANY IS REPRESENTED BY 0
13200		ITMANY ←← 0	;ITEM FOR ANY
13300		MAINPI ←← 1	;ITEM NUMBER OF THE MAIN PROCESS ITEM
13400		UNBND  ←← 2	;UNBOUND (?ITEMVARS ETC)
13500		EVTYPI ←← 3	;THE ITEM EVENT!TYPE
13600		NIC    ←← UNBND	;ITEM GET BACK FROM EMPTY NOTICE QUEUE
13700	;;# # MAKE NIC & UNBOUND THE SAME ITEM -- RHT
13800	;;     I.E. NULL INTERROGATIONS RETURN UNBOUND NOW
13900	
14000		?MAXLOC ←← =10	;MAXIMUM NUMBER OF LOCAL ITEMVARS IN FOREACH
14100		?QBIND ←← 200	;A ? ITMVR (NOT A MP PARM)
14200		?FBIND ←← 100	;A BIND ITMVR(HERE BECAUSE OF STATS)
14300	
14400	BITDATA (THE NAMED BITS FOR REF ITEMS)
14500	;;%BH% RHT ADD TEMP BIT
14600		?TMPB ←← 400000 ; SIGN BIT MEANS A TEMP REF ITEM
14700		?REFB ←← 200000	;USUALLY SET
14800		?QUESB ←← 100000;FOR ? ITEMVARS
14900		?BINDB ←← 40000	;FOR BIND ITEMVAR
15000		?PROCB ←← 20000	;NOT NOW REALLY USED
15100		?ITEMB ←← 10000	; AN ITEM (ITEMVAR)
15200		?ARY2B ←← 4000	;FOR * ARRAY ITEMVAR ARRAY REFERENCES
15300		?MSK6BT ←← 3740 ; BITS FOR SIX BIT TYPE
15400		?MSKUNT ←← 3700	;BIT MASK FOR UNTYPED 
15500	ENDDATA
15600	
15700	;;%AM% MANY USER PHASES 
15800	 SYSPHS←←2			;TWO SYSTEM PHASES
15900	 USRPHS←←3			;THREE USER PHASES (FOR NOW)
16000					; (0, 1, 2) -- 1 IS DEFAULT
16100	
16200	IFN HEDSYM, <		;MAKE AN HONEST ASSEMBLY OUT OF IT
16300		TITLE	HEAD
16400		END
16500	>;IFN HEDSYM
16600