;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** INITIAL LIST STRUCTURE ******************
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************



SUBTTL	MACROS FOR CREATING INITIAL LIST STRUCTURE

PFXEST==3200			;ESTIMATED SPACE NEEDED FOR PURE FIXNUMS
SYMEST==1100			;ESTIMATED INITIAL NUMBER OF LISP SYMBOLS
LSYALC==20
GSNSYSG==<SYMEST+SEGSIZ-1>/SEGSIZ	;GUESS AT THE NUMBER OF SYM SEGS NEEDED
GSNSY2==<<SYMEST*2>+SEGSIZ-1>/SEGSIZ	;GUESS AT THE NUMBER OF SY2 SEGS NEEDED
GSNPFXSG==<PFXEST+SEGSIZ-1>/SEGSIZ	;GUESS AT THE NUMBER OF PFX SEGS NEEDED

MAYBE NXVCSG==PAGING*2000/SEGSIZ

.NSTGWD		;NO STORAGE WORDS OVER MACRO DEFINITIONS

KNOB==0		;NUMBER OF OBJECTS FOR OBARRAY
.XCREF KNOB




DEFINE PUTOB A
REL$ ADDOB \A-.RL1,\KNOB
REL% ADDOB \A,\KNOB
TERMIN

DEFINE ADDOB A,N
DEFINE OB!N
REL$ .RL1+A
REL% A
TERMIN
KNOB==KNOB+1
TERMIN

;;; STANDARD FUNCTION MAKERS

;;; MKAT <PNAME/INTERNAL-NAME>,<PROP-NAME>,<SPACE-FOR-Q-LABEL>,<ARGS-PROP>
;;; MKAT1 <PNAME>,<PROP-NAME>,<SPACE-FOR-Q-LABEL>,<INTERNAL-NAME>,<ARGS-PROP>

DEFINE MKAT A,B,C,AR
	Q!B %
	A,,NIL
RMTAH1 [C]A,PNL-2,[A]AR
TERMIN

DEFINE MKAT1 A,B,C,D,AR,IP
	Q!B %
	D,,NIL
RMTAH1 [C]D,PNL-2,[A]AR,,IP
TERMIN


;;; MKAT2 USED TO CREATE AUTOLOAD ATOMS
;;; MKAT2 <ATOM-NAME>,<BRIEF-NAME-FOR-AUTOLOAD-PROP>,<LABEL-FOR-HEADER>

DEFINE MKAT2 A,D,C
	QAUTOLOAD %
	QFL.!D,,NIL
IFSN [C], RMTAH1 [ ]C,PNL-2,[A]
IFSE [C], RMTAH1 [ ]A,PNL-2,[A]
TERMIN


;;; MAKE AN ATOM WITH AUTOLOAD PROPERTY FROM A SHARED PROPERTY LIST
;;; <PNAME>,<2-CHAR-PLIST-ID>,<BRIEF-INTERNAL-NAME>,<NO.-OF-ARGS>
DEFINE MKAL A,D,C,AR,IP
IFSN [C], RMTAH1 [ ]C,D!$AL,[A]AR,,IP
IFSE [C], RMTAH1 ,,D!$AL,[A]AR,,IP
TERMIN

;;; SAME AS MKAL, BUT WITH A VALUE CELL.
;;;   "BRIEF" INTERNAL NAME MAY NOT BE OMITTED
DEFINE MKALV A,D,C,AR,VAL,IP
RMTAH1 [ ]C,D!$AL,[A]AR,V!C,IP
RMTVC V!C,VAL
TERMIN

;;; MAKES AN ATOM WITH A VALUE CELL, BUT NO OTHER PROPERTIES
;;; MKAV <PNAME>,<LABEL-FOR-VCELL>,<CONTENTS-OF-VCELL>,<LABEL-FOR-HEADER>

DEFINE MKAV PN,VCL,C,D,IP
IFSN [D], RMTAH1 [ ]D,,[PN],C.,IP
IFSE [D], RMTAH1 ,,,[PN],C.,IP
C..==.
LOC C.
IFSN [VCL],   VCL:
.ELSE,   V!PN:
	IFSN [C],	C
	.ELSE,		NIL 
C.==.
LOC C..
TERMIN

;;; MAKES A FUNCTION WITH A VALUE CELL
;;; MKFV <PNAME>,<INTERNAL-NAME>,<PROP-NAME>,<INITIAL-VALUE>,<ARGS-PROP>

DEFINE MKFV PN,B,C,D,AR,IP
	Q!C %
	B,,NIL
RMTAH1 [ ]B,PNL-2,[PN]AR,V!B,IP
RMTVC V!B,D
TERMIN

;;; STRINGS TOGETHER THE WORDS OF A PNAME INTO A LIST

DEFINE APN,PN
	(F.)!REPEAT <<.LENGTH ~PN~>+4>/5-1,[%
(F.+.RPCNT+1)]
PNL==.
LOC F.
ASCII ~PN~
F.==.
LOC PNL
TERMIN




;;; MAKES A "SYSTEM" ATOM.  USUSALLY HAS NO PROPERTIES.
;;; MSA <INTERNAL-NAME>,<PNAME>

DEFINE MSA LN,PN
RMTAH1 [ ]LN,,[PN]
TERMIN


;;; MAKE A "RANDOM ATOM" (OR ATOMS)

DEFINE MRA PNS
IRP PN,,[PNS]
MSA PN,PN
TERMIN
TERMIN

;;; C = <SPACE> MEANS THAT WE SHOULD HAVE A LABEL FOR THE HEADER
;;; D IS THE LABEL, MORE OR LESS, IF C IS A <SPACE>
;;; PL IS FLAG FOR PROPERTY LIST.  IF NULL, THEN NIL [= 0] GETS 
;;;    ASSEMBLED.  FOR MKAT CASE, IT MUST BE "PNL-2", SINCE THE PROPERTY 
;;;    LIST WILL ALWAYS HAVE 2 CELLS JUST PRECEEDING THE PNAME-LIST
;;; PN IS THE PNAME STRING, 
;;; AR THE ARGS PROPERTY, 
;;; VC THE LABEL OF THE VALUE CELL
;;; IP IF NOT NULL, IS A MACRO WHICH SHOULD ADD A PREFIX TO THE PNAME


DEFINE RMTAH1 C,D,PL,PN,AR,VC,IP
PNL==.
LOC S.
PUTOB .
IFSE [C] , Q!D:
		B.,,PL
S.==.
LOC B.
IFSE [VC], 777300,,SUNBOUND
.ELSE 	   777300,,VC
	    NN!AR,,PNL
B.==.
LOC PNL
IFSN [IP], IP
APN [PN]
TERMIN


;;; REMOTE VALUE CELL MAKER

DEFINE RMTVC A,C
ZZ==.
LOC C.
A:
IFSN [C],	C
.ELSE,		NIL
C.==.
LOC ZZ
TERMIN



;;; ARGS TO IRP IN GROUPS OF 4 FOR EASY COUNTING

IRP Q,,[0,,1,2
3,4,5,01
12,23,16,36
08,1777,2777,4777,02
13,25,34,35,45
03,27,37,04,58
3777,17]R,,[1,0,2,3
4,5,6,1002
2003,3004,2007,4007
1011,2777,3777,5777,1003
2004,3006,4005,4006,5006
1004,3010,4010,1005,6011
4777,2010]
NN!Q==R
TERMIN		;FOR BIBOP ARGS PROPERTIES



SUBTTL STARTS FOR SAR, VC, IS2, AND SYM [SYMBOL-HEADER] SPACES

;;; STATE OF THE WORLD HERE HAD BETTER BE 
;;; 1) LOSEG IF IN D10
;;; 2) BEGINNING ON A SEGMENT BOUNDARY

.XCREF RMTAH1 MKAT MKAT1 MKAT2 MKAV MKFV RMTVC MSA 
   .XCREF MKAL MKALV

.YSTGWD		;STORAGE WORDS ARE OKAY NOW

	PGBOT ATM

BLSTIM==.MRUNT


;;; FORMAT OF SYMBOL HEADER FOR BIBOP:
;;; THE MAIN HEADER OF A SYMBOL IS A SINGLE WORD IN SYMBOL SPACE.
;;; THE RIGHT HALF CONTAINS THE PROPERTY LIST, AND THE LEFT HALF
;;; POINTS TO THE REST OF THE HEADER, WHICH IS IN THE IS2 OR SY2 AREA.
;;; SINCE THE REST OF THE HEADER (ALSO CALLED A "SYMBOL BLOCK") MUST
;;; LIE ON AN EVEN WORD BOUNDARY, THE LOW BIT OF THE LEFT HALF OF
;;; THE MAIN HEADER IS NORMALLY ZERO. THIS BIT IS USED BY THE
;;; GARBAGE COLLECTOR FOR MARKING PURPOSES, AND THEN RESET TO ZERO.
;;; THE SYMBOL BLOCK IS 2 WORDS LONG:
;;;		<VARIOUS BITS>,,<POINTER TO VALUE CELL>
;;;		<ARGS PROPERTY>,,<PNAME LIST>
;;; THE "VARIOUS BITS" ARE:
;;;	4.9-3.9	ONES (FOR NO PARTICULARLY GOOD REASON)
;;;	3.9	ZERO (RESERVED FOR SPECIAL VALUE CELL/LAP HACK)
;;;	3.8	1 => SYMBOL BLOCK MAY BE PURE (SEE GCMARK)
;;;	3.7	ONE IFF COMPILED CODE NEEDS THE SYMBOL
;;;	3.6	ONE IFF COMPILED CODE REFERENCES BY OTHER THAN CALL UUO
;;;		(IMPLIES 3.7 WHICH *MUST* ALSO BE ON)
;;;	3.5-3.1	ZERO (SO CAN INDIRECT THROUGH THE WORD TO GET VALUE)
;;; THE ARGS PROPERTY IS IN THE SAME FORMAT FASLOAD USES,
;;; TWO NINE-BIT BYTES DECODED AS FOLLOWS:
;;;		0 => NIL
;;;		777 => 777 (EFFECTIVELY INFINITY)
;;;		N => N-1, N NOT 0 OR 777
;;; THUS 000006 = (NIL . 5), 004005 = (3 . 4), AND 002777 = (1 . 777)




SPCBOT SAR

DEDSAR:	     0,,ADEAD		;DEAD SAR (PROTECTED BY GC)
		TTDEAD
DBM:	     0,,ADEAD		;DEAD BLOCK MARKER
		TTDEAD
BSYSAR==.		;BEGINNING OF "SYSTEM" ARRAY PROPS (SEE SYSP)
OBARRAY:	AS<OBA+SX+GCP>,,IOBAR1	;OBARRAY
		TTS<1D+CN>,,IOBAR2(TT)
READTABLE:	AS<RDT+FX>,,RSXTB1	;READTABLE
		TTS<1D+CN>,,RCT(TT)
PRDTBL:		AS<RDT+FX>,,RSXTB2	;PURE READTABLE
		TTS<1D+CN>,,RCT0(TT)
TTYIFA:		AS<FIL+SX+GCP>,,TTYIF1	;TTY INPUT FILE ARRAY
		TTS<1D+CL+CN+TY>,,TTYIF2(TT)
TTYOFA:		AS<FIL+SX+GCP>,,TTYOF1	;TTY OUTPUT FILE ARRAY
		TTS<1D+CL+CN+TY+IO>,,TTYOF2(TT)
INIIFA:		AS<FIL+SX+GCP>,,INIIF1	;INIT FILE ARRAY
		TTS<1D+CL>,,INIIF2(TT)
STR%AR:		ADEAD
		TTDEDC

ESYSAR==.

SPCTOP SAR,ILS,[SAR]


;;; BEGINS ON A SEGMENT BOUNDARY, BECAUSE OF THE "SPCTOP SAR"

SPCBOT VC
C.==.	;LOCATION COUNTER FOR VALUE CELL SPACE
	;;; NOTE THAT VALUE CELLS FOR T, NIL, UNBOUND, AND UBAR 
	;;; ARE IN PURE FREE STORAGE
BLOCK 400
SEGUP .
BXVCSG==.
IFN NXVCSG,[
	PAGEUP
	BXVCSG==.
	LOC .+NXVCSG*SEGSIZ-1
	PAGEUP
]
EVCSG==.


SPCBOT IS2
SY2ALC:
LOC .+2*LSYALC
SPCTOP IS2,ILS,[IMPURE SYMBOL BLOCK]



SPCBOT SYM

TRUTH:	$$$TRUTH,,NIL		;ATOM HEADER FOR T
	PUTOB TRUTH
REL$	ADDOB -.RL1+NIL,\KNOB
REL%	ADDOB NIL,\KNOB
;;;	CROCK TO PUTOB NIL CORRECTLY

QUNBOUND:	$$$UNBOUND,,NIL	;INTERNAL UNBOUND MARKER
SYALC:	BLOCK LSYALC	;FOR ALLOC
S.==.	;LOCATION COUNTER FOR SYMBOL SPACE

SEGUP BSYMSG+GSNSYSG*SEGSIZ-1
		;END OF SYMBOL GUESS
ESYMGS==.
PAGEUP



SUBTTL STARTS FOR SY2, PFX, AND PFS [PURE LIST] SPACES

10$	$HISEG

SPCBOT SY2
$$$TRUTH:	777300,,VTRUTH
		0,,$$TRUTH
$$$UNBOUND:	777300,,SUNBOUND
		0,,$$UNBOUND

B.==.	;LOCATION COUNTER FOR SYMBOL BLOCK SPACE

SEGUP BSY2SG+GSNSY2*SEGSIZ-1



	SPCBOT PFX

INR70:	R70

IFN D10,[
IFE SAIL,[
IPPN1:		.		;INITIAL PPN FOR LISP'S "SYS" DEVICE
IPPN2:		.
]	;END OF IFE SAIL
;for SAIL, we have to do the definition after "MAC" and "LSP" are defined
]	;END OF IFN D10


;; HAC FOR MINIMIZING USAGES OF "+INTERNAL-" IN PNAMES
;; MACROS NAMES %DVST, %PIPN, %ARRY, %SIEX, %FIXN, %FLON 
IRP A,,[DVST,DEFM,PIPN,MXPN,ARRY,SIEX,SICH,FIXN,FLON,MTPL,READ
FEXF,SIDC,VALU]B,,[defvs,DEFMA,+INTERNAL-,MACROEXPAN,ARRAY,SI:EX
SI:CH,FIXNU,FLONU,MULTIPLE-VALUE-,READ-,FILE-EXIT-FUNCT,SI:DEFCLAS,VALUE]
$$!A:	ASCII \B\
DEFINE %!A
REPEAT <<.LENGTH ~B~>+4>/5,[
	($$!A+.RPCNT) %
]
TERMIN
TERMIN

F.==.	;LOCATION COUNTER FOR PURE FIXNUMS - USED FOR PNAMES AND INUMS

SEGUP BPFXSG+GSNPFXSG*SEGSIZ-1
EPFXGS==.



SPCBOT PFS
BPURFS==.		;BEGINNING OF PURE FS (FOR INSERT FILE PAGE)




;;; FREE STORAGE STUFF THAT IS NEVER GC'ED, NOR DARE MARKED FROM (NON-BIBOP)

PWIOINT: NIL			   ;WITHOUT INTERRUPTS SPECIAL PURE LOCATION

  	$$UNBOUND:
			APN UNBOUND

  	$$NIL:			;PNAME FOR NIL
		APN NIL

VNIL:	NIL	;NIL'S VALUE CELL IS IN PFS - THAT WAY YOU CAN'T SETQ IT

  	$$TRUTH:		;PNAME OF T
		APN T
VT:
VTRUTH:	TRUTH	;LIKEWISE CAN'T SETQ T


;;; STANDARD UNBOUND VALUE CELL - POINTED TO BY ALL SYMBOLS WHICH
;;; DON'T HAVE THEIR OWN VALUE CELL. NOTE: ALL SUCH SYMBOLS ARE
;;; HELIOCENTRIC. MUST HAVE SUNBOUND ABOVE END OF VALUE CELL AREA
;;; - SEE GYSP5A AND SSYSTEM.

  	SUNBOUND:	QUNBOUND


SUBTTL	INITIAL PURE LIST STRUCTURE

PSBRL:	Q%ISM,,SBRL

SSSBRL:	QARRAY %
ASBRL:	QAUTOLOAD %
SYSBRL:	QARRAY %
SBRL:	QSUBR %
	QFSUBR %
	QLSUBR,,NIL

;; "GETL" list for FBOUNDP
FBDPL:	QEXPR %
	QFEXPR %
	QMACRO,,SBRL

QGRTL:	Q$GREAT,,NIL		;(>) FOR UGREAT

IGSBV:	OBARRAY,,READTABLE	;FOR "ERROR-BREAK-ENVIRONMENT"

QLSTF.X: QSTF.X,,NIL

IFN NEWRD,[
;;;INITIAL ASSQ LIST OF MACRO-FUNCTIONS
PRMCLS:		.+1,,.+2
		47,,QRDQTE
		.+1,,NIL
		73,,QRDSEMI
]	;END OF IFN NEWRD


BSYSAP==.		;BEGINNING OF SYSTEM AUTOLOAD PROPERTIES
;;; NOTE THAT DUE TO THE 6-CHAR LOSS, GRINDEF HAD TO BECOME GFN IN THE LABEL
;;;  HERE ARE THE NAMELISTS WHICH WILL BECOME AUTOLOAD PROPERTIES

;;; [EREAD,HELP,ALLFI,DUMPA,LEDIT,LISPT,HUMBLE],,[ER,HE,FL,DP,LE,LT,HM]

IRP A,,[GRIND,GFN,LAP,GETMIDASOP,SORT,LET,BACKQ,FORMAT,CGOL,DUMPARRAYS
DEFMACRO,$DFMX,DEFVST,$DEFVSX,%DEFVSY,MACAI,MLMAC,MLSUB,SETF,$EDIT
TRACE,SHARPM,STRING,SUBSEQ,EXTEND,EXTSTR,EXTBAS,EXTSFA,EXTMAC,BLTARRAY
ERRCK,CERROR,YESNOP,LOOP,DESCRIBE]B,,[GI,GE,LA,GT,SO,LM,BQ,FT,CG,DP,DM,MX
DV,DX,DY,MA,MM,MS,SF,ED,TR,SH,ST,SB,EX,ES,EB,EA,EM,BL,EC,CE,YN,LO,DS]
	QFL.!B:	IRACOM %
		Q!A,,IRATBL
	B!$AL:  QAUTOLOAD %
		QFL.!B,,NIL
TERMIN

IFN SAIL,[
	QFL.ER:	IRACOM %
		QEREAD,,IRATBL
	ER$AL:  QAUTOLOAD %
		QFL.ER,,NIL
	QFL.HE:	IRACOM %
		QHELP,,IRATBL
	HE$AL:  QAUTOLOAD %
		QFL.HE,,NIL
]

IFN ITS,[
	QFL.AL: IRACOM %
		QALLFILES,,IRATBL
	AL$AL:  QAUTOLOAD %
		QFL.AL,,NIL
]	;END OF IFN ITS
IFN JOBQIO\D20,[
QFL.LE:	IRACOM %
	QLEDIT,,IRATBL
LE$AL:  QAUTOLOAD %
	QFL.LE,,NIL
]
IFN JOBQIO,[
QFL.HM:	IRACOM %
	QHUMBLE,,IRATBL
HM$AL:  QAUTOLOAD %		;for HUMBLE
	QFL.HM,,NIL
QFL.LT:	IRACOM %		;for LISPT
	QLISPT,,IRATBL
LT$AL:  QAUTOLOAD %
	QFL.LT,,NIL
]		;END OF IFN JOBQIO

ESYSAP==.		;END OF SYSTEM AUTOLOAD PROPERTIES



Q%ALD:			;"AUTOLOAD-DEVICE", BUT NOTE Q%XALD BELOW!
20%	QDSK %
20$ 	QPS %
IT$ 	QLISP,,NIL
20$	QMACLISP,,NIL
IFN D10,[
	.+1,,NIL
	IPPN1 %
	IPPN2,,NIL
]	;END OF IFN D10
20$  Q%XALD: QDSK,,Q%ALD+1

QA%DDD:	IRACOM,,NIL	;AUTOLOAD DEFAULT DEVICE/DIRECTORY LIST
IRATBL:	QFASL,,NIL
IRACOM:	QLISP,,NIL	;STANDARD DEVICE/DIRECTORY FOR AUTOLOAD FILES 

IFN BIGNUM,[
BNM23A:	IN0 %
	IN1,,NIL
BNM23B:	IN0 %
	IN2,,NIL
BN.1A:	IN0+1,,NIL
BNV2A:	BNV1,,NIL
]		;END OF IFN BIGNUM


QTLIST:	TRUTH,,NIL
IFN ITS,[
QLSPOUT:	Q.LISP. %		;FOR ITS, (/.LISP/. OUTPUT)
		QOUTPUT,,NIL
]			;END OF IFN ITS
IFN D20,[
QLSPOUT:	QMACLISP %		;FOR D20, (MACLISP OUTPUT)
		QOUTPUT,,NIL
]			;END OF IFN D20
;QLSPOUT CONSTRUCTED AT RUN TIME FOR D10


QUWL:	QUWRITE,,NIL
QURL:	QUREAD,,NIL
LGOR:	QGO %
	QRETURN,,NIL

QNILSETQ:	QSETQ %		;FOR NIHIL ERROR MESSAGE
	.+1,,NIL
	NIL,,NIL

QTSETQ:	QSETQ %			;FOR VERITAS ERROR MESSAGE
	.+1,,NIL
	TRUTH,,NIL

QXSETQ:	QSETQ %			;FOR PURITAS ERROR MESSAGE
	QXSET1,,NIL

ARQLS:	QARRAY %		;(ARRAY ?)
$QMLST:	QM,,NIL			;LIST OF A QUESTION MARK: (?)

QSJCL:	QSTATUS %		;(STATUS JCL)
	QJCL,,NIL

SPCNAMES:			;(STATUS SPCNAMES)
	QSYMBOL %
	QARRAY %
PURSPCNAMES:			;(STATUS PURSPCNAMES)
	QLIST %
IFN HNKLOG,[
	RADIX 10.
	REPEAT HNKLOG+1, CONC QHUNK,\.RPCNT,,,.+1
	RADIX 8
]	;END OF IFN HNKLOG
BG$	QBIGNUM %
DX$	QDUPLEX %
CX$	QCOMPLEX %
DB$	QDOUBLE %
	QFLONUM %
	QFIXNUM ,,NIL

PDLNAMES:
IRPS XX,Y,[REG FL FX SPEC]
	Q!XX!PDL,,IFSE [Y][ ][.+1]
TERMIN


SUBTTL	RANDOM SYSTEMIC ATOMS


;; +INTERNAL-/'-MACRO *MUST* be first in this table, for (STATUS SYSTEM ...)
;; QRDQTE is first symbol except for TRUTH and QUNBOUND --RWK

RDQTEB=RDQTE		;THE OTHERS WIN BECAUSE THEY ARE 6 CHARS
IRP X,,[RDQTEB,RDSEMI,RDVBAR,RDDBLQ]Y,,[['],[;],[|],["]]
	MKAT1 [Y-MACRO]SUBR,[ ]X,0,%PIPN
TERMIN
	MKAT1 TTYSCAN-SUBR,SUBR,[ ]TTYBUF,3,%PIPN
	MKAT1 ^B-BREAK,SUBR,[ ]CN.BB,2,%PIPN
	MKAT1 IOL-BREAK,SUBR,[ ]IOLB,1,%PIPN
	MKAT1 UREAD-EOFFN,SUBR,[ ]UREOF,2,%PIPN
	MKAT1 INCLUDE-EOFFN,SUBR,[ ]INCEOF,2,%PIPN
	MKAT1 TTY-ENDPAGEFN,SUBR,[ ]TTYMOR,1,%PIPN
IFN ITS+SAIL,[
	MKAT1 ^Q-MACRO,SUBR,[ ]CTRLQ,0,%PIPN
 	MKAT1 ^S-MACRO,SUBR,[ ]CTRLS,0,%PIPN
]	;END OF IFN ITS+SAIL

	MKAT1 *RSET-BREAK,SUBR,[ ]CB,1,%PIPN
IRP X,,[UDF,UBV,WTA,UGT,WNA,GCL,FAC]
	MKAT1 X-BREAK,SUBR,[ ]X!B,1,%PIPN
TERMIN

  	MKAT1 PDL-BREAK,SUBR,[ ]PDLB,1,%PIPN
  	MKAT1 GCO-BREAK,SUBR,[ ]GCOB,1,%PIPN
	MKAT1 AUTOLOAD,SUBR,[ ]IALB,1,%PIPN

	MKAT1 CHAR-N,SUBR,,%ISC.N,2,%PIPN
	MKAT1 RPLACHAR-N,SUBR,,%ISR.N,3,%PIPN
	MKAT1 STRING-WORD-N,SUBR,,%ISW.N,2,%PIPN
	MKAT1 SET-STRING-WORD-N,SUBR,,%ISSW.N,3,%PIPN


;;; NOTE WELL! the symbol headers for
;;; 		LIST, FIXNUM, FLONUM, DOUBLE, COMPLEX, DUPLEX, BIGNUM,
;;;		SYMBOL, <HUNKS>, RANDOM, ARRAY
;;;   must be allocated sequentially, in that order. [Note also that this
;;;   constraint overlaps the next constraint too.]  This is so that
;;;   certain routines, notably EVAL, may quickly dispatch thru a table
;;;   of routines, indexed by the sequence number of TYPEP of a form.

COMMENT # QLIST: QFIXNUM: QFLONUM: QDOUBLE: QCOMPLEX: QDUPLEX:
	  QBIGNUM: QSYMBOL: QHUNK0: ... QHUNKn:  QRANDOM: QARRAY: #
  		MKAT LIST,LSUBR,[ ]
		RMTAH1 [ ]FIXNUM,,M,,,%FIXN
		RMTAH1 [ ]FLONUM,,M,,,%FLON
DB$		MRA DOUBLE
CX$		MRA COMPLEX
DX$		MRA DUPLEX
BG$		MRA BIGNUM
  		MRA SYMBOL
IFN HNKLOG,[
    IRP X,,[0,1,2,3,4,5,6,7,8,9]SZ,,[2,4,8,16,32,64,128,256,512,1024]
	    MSA HUNK!X,HUNK!SZ
	    IFE .IRPCNT-HNKLOG, .ISTOP
    TERMIN
]	;END OF IFN HNKLOG
  		MKAT RANDOM,LSUBR,[ ]01

;;; NOTE WELL! the symbol headers for
;;; 		ARRAY, SUBR, FSUBR, LSUBR, EXPR, FEXPR, MACRO, AUTOLOAD
;;;   must be allocated sequentially, in that order. [Note also that this
;;;   constraint overlaps the preceeding, as well as the next constraint too.]
;;;   This is so that certain routines, notably EVAL and APPLY and UUO-handler,
;;;   may quickly determine whether a given property is a functional property.

  		MKAT ARRAY,FSUBR,[ ]
		MKAT SUBR,SUBR,[ ]1
	IRP A,,[FSUBR,LSUBR,EXPR,FEXPR]
		MRA A
	TERMIN
		MKAL MACRO,DM,MACRO

;;; NOTE WELL! the symbol headers for
;;; 		AUTOLOAD, ERRSET, *RSET-TRAP, 
;;; 		GC-DAEMON, GC-OVERFLOW, PDL-OVERFLOW
;;;   must be allocated sequentially, in that order -- .see uint90
;;;   [Note also that this  constraint overlaps the preceeding constraint too.]
;;;   This is so that the interrupt handler may have an easier time(?)

		MKAV AUTOLOAD,VAUTFN,QIALB,AUTOLOAD
		MKFV ERRSET,ERRSET,FSUBR
		MKAV *RSET-TRAP,V.TRAP,QCB,.R.TP
		MKAV GC-DAEMON,VGCDAEMON
		MKAV GC-OVERFLOW,VGCO,QGCOB,GCO
		MKAV PDL-OVERFLOW,VPDL,QPDLB,PDL

MRA [VALUE,LAMBDA,DSK,SYM,SPLICING,SINGLE,EVALARG,BPS,SPECIAL]

	MKAV [TTYSCAN-STRINGERS|]VTSCSR,ITSCSR,TSCSR
ITSCSR:	.+1,,.+2
	IN0+73,,IN0+15		;(#/; . #\CR)
	.+1,,.+2
	IN0+174,,IN0+174	;(#/| . #/|)
	.+1,,NIL
	IN0+42,,IN0+42		;(#/" . #/")

RMTAH1 [ ]%ISM,,STRING-MARKER,,,%PIPN
RMTAH1 [ ]$COMPLR,,COMPLR
;; see PLLISP in writeable free storage
RMTAH1 [ ]LISP,PLLISP,LISP,,SUNBOUND
	MRA [FASL,JCL,DDT]
	MSA %GLOBALSYM,GLOBALSYM
	MRA [LABEL,FUNARG]
SA$	MRA [MAC]
10$ 	MRA [LSP]
IFN SAIL,[
IPPN1==QMAC
IPPN2==QLSP
;see previous definitions of IPPNi for other systems
]	;END OF IFN SAIL


;Don't change order from here to &RESTV, must be consecutive with &OPTIONAL
;first and &RESTV last for DEFUN to work.

	IRP PN,,[WHOLE,OPTIONAL,REST,AUX]
		MSA %!PN,&!PN
	TERMIN
		MSA %RSTL,&RESTL
		MSA %RSTV,&RESTV

;;; NOTE WELL! the symbol headers for
;;; 		REGPDL, FLPDL, FXPDL, SPECPDL
;;;   must be allocated sequentially, in that order.  This is so that
;;;   status routines, and pdl-overflow routines may "index" off the kind
;;;   of pdl being talked about.

		MRA [REGPDL,FLPDL,FXPDL,SPECPDL]


;;; NEED COPIES OF DOUBLE, COMPLEX, DUPLEX, BIGNUM EVEN IF TYPES NOT IMPLEMENTED
.SEE LDATER
DB%		MRA DOUBLE
CX%		MRA COMPLEX
DX%		MRA DUPLEX
BG%		MRA BIGNUM
HN%		MRA HUNK

PG$		MRA PAGING
		MRA PPN
20$ 		MRA PS
IFN ITS,[
		MRA [ITS,AI,ML,MC,DM]
		MRA EXPERIMENTAL
		MRA .LISP.
]	;END OF IFN ITS
IFN D20,[
		MRA DEC20
		MSA TOPS20,TOPS-20
		MRA TENEX
]	;END OF IFN D20
IFN D10,[
		MRA DEC10
HS%		MRA ONESEGMENT
    IFE SAIL,[
		MRA CMU
		MSA TOPS10,TOPS-10
    ]		;END OF IFE SAIL
]	;END OF IFN D10
IFN USELESS,	MRA ROMAN
		MRA SAIL
IFN JOBQIO,	MRA JOB
		MRA [FILE,ECHO,CLA,IMAGE,BLOCK,NEWIO,OUTPUT,SCROLL]
		MRA [MACLISP,PDP10]
		MSA RDEOF,READ-EOF
		MSA CN.B,[^B]
		MSA M,[?]
		MSA ..MIS,[**MISSING-ARG**]
		MSA LA,[_]
		MSA XPRHSH,EXPR-HASH
		MRA CALLI

;;; NOTE WELL! the symbol headers for
;;; 		ODDP, EVAL, DEPOSIT, EXAMINE
;;;   must be allocated sequentially, in that order.  This is so that
;;;   the machine-error interrupt handler may "index" off the kind
;;;   of interrupt being talked about.

				.SEE UINT32
	MKAT ODDP,SUBR,[ ]1
	MKFV EVAL,OEVAL,LSUBR,NIL,12
	MKAT DEPOSIT,SUBR,[ ]2
	MKAT EXAMINE,SUBR,[ ]1


SUBTTL	ATOMS FOR SUBRS

;DUMMY ATOM SO THAT BAKTRACE PRINTS SOMETHING REASONABLE IN CERTAIN SCREW CASES
	MKAT1 QMARK,SUBR,,QMARK,0
	MKAT GC,SUBR,,0
	MKAT1 ^G,SUBR,,CTRLG,0



;;; NOTE WELL! the symbol headers for
;;; 		<all the carcdr functions>
;;;   must be allocated sequentially, in the order shown below; "CAR" must be
;;;   the firs, and "CDDDDR" the last, with labels for at least each of these
;;;   two.  This is so that the +INTERNAL-CARCDRP function may determine 
;;;   whether something is a carcdr operation by address comparison.

MKFV CAR,CAR,SUBR,,1
MKFV CDR,CDR,SUBR,,1
IRP A,,[CAAR,CADR,CDAR,CDDR,CAAAR,CAADR,CADAR,CADDR,CDAAR,CDADR,CDDAR,CDDDR
CAAAAR,CAAADR,CAADAR,CAADDR,CADAAR,CADADR,CADDAR,CADDDR,CDAAAR,CDAADR,CDADAR
CDADDR,CDDAAR,CDDADR,CDDDAR]
	MKAT A,SUBR,,1
TERMIN
	MKAT CDDDDR,SUBR,[ ]1

	MKAT1 CARCDRP,SUBR,,ICADRP,1,%PIPN

IRPS A,C,[FIXP FLOATP EVALFRAME ERRFRAME,BIGP,BOUNDP,FBOUNDP,PAIRP
LISTIFY NOT,ATOM TYPEP,EXPLODE MINUSP,PLUSP,NUMBERP ZEROP,INTERN,LAST
REVERSE,NREVERSE,READLIST,MAKNAM,LENGTH,ABS,MINUS,ADD1,SUB1,FLOAT
FLATSIZE FLATC ARG COS,SQRT,LOG,EXP,SXHASH NOINTERRUPT,REMOB,SYSP
MAKUNBOUND,IMPLODE,MUNKAM,MAKNUM,HAULONG,PLIST SYMEVAL,PUREP
WRITEABLEP]
	MKAT A,SUBR,[C]1
TERMIN

MKAT1 RETURN,SUBR,[ ]RETURN,1

;;; NOTE WELL! the symbol headers for
;;; 		RUNTIME, TIME
;;;   must be allocated sequentially, in that order.  This is so that
;;;   the alarmclock function may "index" off the kind of alarm required.

	MKAT1 RUNTIME,SUBR,[ ]$RUNTIME,0
	MKAT1 TIME,SUBR,[ ]$TIME,0

IRPS A,C,[FIX,IFIX,EXPLODEC NULL,ASCII ALLOC,NCONS,SLEEP,SIN]
	MKAT1 A,SUBR,[C]$!A,1
TERMIN
IRPS A,C,[XCONS GETCHARN,GET PNGET]
	MKAT1 A,SUBR,[C]$!A,2
TERMIN

MKFV PURCOPY,PURCOPY,SUBR,NIL,1
MKFV PUTPROP,PUTPROP,SUBR,PSBRL,3
MKAT1 PURIFY,SUBR,,$PURIFY,3
MKAT1 SYMBOLP,SUBR,,%SYMBOLP,1
MKAT1 EXPLODEN,SUBR,[ ]$$EXPLODEN,1
MKAT1 DIMS,SUBR,,ADIMS,1,%ARRY
MKAT1 -DIMENSION-N,SUBR,,ADIMN,2,%ARRY
MKAT1 [-#-DIMS]SUBR,,ANDIM,1,%ARRY
MKAT1 -TYPE,SUBR,,ARRTYP,1,%ARRY
MKAT1 [-CELL-LOCATION]SUBR,,VALLOC,1,%VALU 

IRPS A,C,[SUBLIS REMPROP SET,RPLACA,RPLACD,NTH,NTHCDR,DISPLACE,
EQ,FRETURN,FRETRY,EXPT,MEMQ,SETARG MEMBER,EQUAL GETL,ASSOC,ASSQ,
REMAINDER,ATAN,SAMEPNAMEP ALPHALESSP GETCHAR,COPYSYMBOL,PNPUT,
FILLARRAY NRECONC,SETPLIST]
	MKAT A,SUBR,[C]2
TERMIN


	MKAT1 *BREAK,SUBR,,$BREAK,2
	MKAT1 *THROW,SUBR,,.THROW,2


IFN HNKLOG,[
	MKAT CXR,SUBR,[ ]2
	MKFV MAKHUNK,MAKHUNK,SUBR,TRUTH,1
	MKFV HUNKP,HUNKP,SUBR,TRUTH,1
	MKAT HUNKSIZE,SUBR,,1
	MKAT HUNK,LSUBR,[ ]
	MKAT RPLACX,SUBR,,3
]		;END OF IFN HNKLOG


IFN USELESS,[
	MKAT1 [\\]SUBR,,.GCD,2
IRPS A,C,[RECLAIM,HAIPART,GCD]
	MKAT A,SUBR,[C]2
TERMIN
]

IRP A,,[LSH,ROT,FSC,ASH]
	MKAT1 A,SUBR,,$!A,2
TERMIN

IRP A,,[LOAD-BYTE,DEPOSIT-BYTE,LDB,DPB]B,,[LOADB,DEPOB,LDB,DPB]C,,[3,4,2,3]
	MKAT1 A,SUBR,,$!B,C
	MKAT1 *!A,SUBR,,%!B,C
TERMIN

	MKAT1 ^,SUBR,,XPTII,2
	MKAT1 ^$,SUBR,,XPTI$,2

	MKAT1 M-IDENTITY,SUBR,,FXIDEN,1,%FIXN
	MKAT1 M-IDENTITY,SUBR,,FLIDEN,1,%FLON

IRPS A,,[DIF,QUO]
	MKAT1 [*A]SUBR,,.!A,2
TERMIN

IRP A,,[1+,1-]B,,[ADD1,SUB1]
	IRP C,,[$,]D,,[$,I]
		MKAT1 [A!!C]SUBR,,[D!!B]1
	TERMIN
TERMIN


IRP A,,[>,<]B,,[GREAT,LESS]
	MKAT1 A,SUBR,[ ]$!B,2
TERMIN

MKAT1 =,SUBR,,$EQUAL,2
MKAT1 [\]SUBR,,REMAINDER,2

IRPS A,C,[SASSOC,SASSQ,SUBST SETSYNTAX]
	MKAT A,SUBR,[C]3
TERMIN

PG$ MKAT1 LH|,SUBR,,LHVBAR,2

SUBTTL	ATOMS FOR FSUBRS AND LSUBRS

IRPS A,C,[COND PROG QUOTE DO DECLARE PROGV,
DEFPROP BREAK GO ,
SETQ ERR SIGNP STORE STATUS SSTATUS FUNCTION CASEQ]
	MKAT A,FSUBR,[C]
TERMIN

	MKAT1 PUSH,FSUBR,[ ]$PUSH
	MKAT1 POP,FSUBR,[ ]$POP

	MKFV DEFUN,DEFUN,FSUBR,NIL
	MKAT1 COMMENT,FSUBR,[ ]$COMMENT
	MKAT1 UNWIND-PROTECT,FSUBR,[ ]UNWINP
	MKAT1 *CATCH,FSUBR,[ ].CATCH
	MKAT1 CATCHALL,FSUBR,,CATCHALL
	MKAT1 CATCH-BARRIER,FSUBR,,CATCHB
	MKAT1 AND,FSUBR,,$AND
	MKAT1 OR,FSUBR,,$OR
	MKAT1 EVAL-WHEN,FSUBR,[ ]EWHEN
	MKAT1 *FUNCTION,FSUBR,[ ]%%FUNCTION

;;; MUST HAVE (MAPLIST,MAPCAR,MAP,MAPC,MAPCON,MAPCAN) IN THAT ORDER
	MKAT MAPLIST,LSUBR,[ ]2777
	MKAT MAPCAR,LSUBR,[ ]2777
	MKAT1 MAP,LSUBR,[ ]$MAP,2777
	MKAT MAPC,LSUBR,[ ]2777
	MKAT MAPCON,LSUBR,[ ]2777
	MKAT1 MAPCAN,LSUBR,[ ]$MAPCAN,2777

	MKAT PROG1,LSUBR,[ ]1777
	MKAT PROG2,LSUBR,[ ]2777
	MKAT PROGN,LSUBR,[ ]
	MKAT BOOLE,LSUBR,,2777

IRPS A,C,[DELQ DELETE APPLY DELASSQ]
	MKAT A,LSUBR,[C]23
TERMIN

IT$	MKAT SYSCALL,LSUBR,[ ]2777
	MKAT1 LIST*,LSUBR,[ ]LIST.,1777
	MKAT1 MAKE-LIST,SUBR,[ ]MAKLST,1
	MKAT1 CONS,SUBR,,$C2NS,2
	MKAT FUNCALL,LSUBR,[ ]1777
	MKAT1 LEXPR-FUNCALL,LSUBR,[ ]%LXFC,2777
	MKAT1 ARRAYCALL,FSUBR,[ ]%ARRAYCALL
	MKAT SUBRCALL,FSUBR,[ ]
	MKAT1 LSUBRCALL,FSUBR,[ ]%LSUBRCALL

IRPS A,C,[VALRET BAKTRACE BAKLIST GENSYM ]
	MKAT A,LSUBR,[C]01
TERMIN

	MKAT SUSPEND,LSUBR,[ ]02
IFN USELESS,	MKAT CURSORPOS,LSUBR,[ ]03
	MKAT QUIT,LSUBR,[ ]01
	MKAT1 ERROR,LSUBR,[ ]$ERROR,03
	MKAT GETSP,LSUBR,[ ]12
	MKAT MAPATOMS,LSUBR,[ ]12

IRPS A,C,[NCONC PLUS,TIMES,DIFFERENCE,QUOTIENT,APPEND ]
	MKAT A,LSUBR,[C]
TERMIN


;;; MUST HAVE (MAX,GREATERP,MIN,LESSP) IN THAT ORDER
	MKAT MAX,LSUBR,[ ]1777
	MKAT GREATERP,LSUBR,[ ]2777
	MKAT MIN,LSUBR,[ ]1777
	MKAT LESSP,LSUBR,[ ]2777

;;; IN THE FOLLOWING, NOTE THAT +, -, *, AND / GET VALUE CELLS

IRP A,,[+,-,*,/]B,,[PLUS,DIFFERENCE,TIMES,QUOTIENT]
	MKFV [A]I!B,LSUBR,QI!B
TERMIN

IRP A,,[+,-,*,/]B,,[PLUS,DIFFERENCE,TIMES,QUOTIENT]
	MKAT1 [A!$]LSUBR,,[$!B]
TERMIN


	MKAT1 *REARRAY,LSUBR,[ ].REARRAY,17
	MKAT1 *ARRAY,LSUBR,[ ]%%ARRAY,27
	MKAT LISTARRAY,LSUBR,[ ]12



SUBTTL	ATOMS FOR LAP, FASLAP, AND FASLOAD USAGE

;;; SUBROUTINES USED BY COMPILER OUTPUT - ERGO, NEEDED BY LAP
;;; AND FASLOAD. ALSO OTHER GOODIES FOR LAP AND FASLAP.

IRP A,,[DELQ,DELETE,APPEND,TIMES,GREAT,LESS,PLUS,NCONC,APPLY]
	MKAT1 *A,SUBR,[ ].!A,2
TERMIN
IRP A,,[PRINT,PRIN1,PRINC,TERPRI,TYO]B,,[PRT,PR1,PRC,TRP,TYO]C,,[1,1,1,0,1]
	MKAT1 *!A,SUBR,[ ]B!$,C
TERMIN

IRP A,,[READ,READCH,TYI]B,,[READ,RDCH,TYI]C,,[0,0,0]
	MKAT1 *!A,SUBR,[ ]B!$,C
TERMIN
	MKAT1 *EVAL,SUBR,,EVAL,1
	MKAV PURE,VPURE,IN1*PAGING	;INIT TO NIL OR 1 (IF PAGING SYS)
  	MKAV *PURE,V.PURE
	MKAV PURCLOBRL
	MKAT1 FASLAPSETUP|,SUBR,,FSLSTP,1
	MKFV LAPSETUP|,LAPSETUP,SUBR,,2
	MKAT PAGEBPORG,SUBR,[ ]0
	MKFV TTSR|,TTSR,SUBR,,1
	MKAT GETDDTSYM,SUBR,[ ]1
	MKAT PUTDDTSYM,SUBR,,2
	MKFV GCPROTECT,GCPRO,SUBR,,2
	MKAV SYMBOLS,V$SYMBOLS,,$SYMBOLS
	MKFV FASLOAD,FASLOAD,FSUBR,SBRL
	MKAV IONS,VFEXITFUNCTIONS,,,%FEXF
	MKAV [IONS-DEFAULT]VFEXDEFAULT,,,%FEXF

SUBTTL ATOMS FOR AUTOLOAD FEATURES

	MRA [VERSION]

	MRA [STRING]
	MKAL MAKE-STRING,ST,,12
	MKAL STRING-PNPUT,ST,,2
	MKAL *:FIXNUM-TO-CHARACTER,ST,,1

	MKAL SUBSEQ,SB,SUBSEQ,13
	MKAL REPLACE,SB,,25
	IRP A,,[LIST,VECTOR,STRING,BITS]
	    MKAL TO-!A,SB,.TO.!A,13
	TERMIN

	MRA [SHARPM]
	MKAL DEFSHARP,SH
	MKAL [#-MACRO]SH,RDSHP,0,%PIPN
	MKAL SETSYNTAX-SHARP-MACRO,SH,,34
	MKAV [#-MACRO-DATALIST]V%MDL,NIL

	MRA [BACKQ]
	MKAV BACKQUOTE-EXPAND-WHEN,V%BEW,QOEVAL
	MKAL [`-expander|]BQ
	MKAL [`-macro|]BQ,I%B%F,0,%PIPN
	MKAL [,-macro|]BQ,I%C%F,0,%PIPN

	IRP A,,[LET,LET*,DESETQ]B,,[LET,LET.,DESETQ]
	    MKAL A,LM,B
	    MKAL [A!-EXPANDER-1]LM,,1
	TERMIN

	MKAL SETF,SF,SETF
	MSA STF.X,[SETF-X]
	MKAL SETF-X,SF,ISTFX,2,%PIPN
	MKAL PUSH-X,SF,IPUX,2,%PIPN
	MKAL POP-X,SF,IPOX,2,%PIPN


	RMTAH1 [ ]$DFMX,,X,,,%DEFM	;; MSA $DFMX,DEFMAX
	MKAV MACRO-EXPANSION-USE,V%MEU,Q%MXPD
	MKALV DED,MX,%MXPD,,,%MXPN
	MKAL [forget-macromemos|]MX,,1
	MKAL [FLUSH-MACROMEMOS]MX,,2
	MKAL MACROFETCH,MX,,1
	MKALV MACROMEMO,MX,%MCMO,3
	MKAL D,MX,,1,%MXPN
	MKAL D-1,MX,,1,%MXPN
	MKAL D-1*,MX,,1,%MXPN
	MKAL D-1*M,MX,MX1.M,1,%MXPN
	MKAL [TRY-AUTOLOADP]MX,,1,%PIPN

	MKAL CRO,DM,DEFMA,,%DEFM
	MKAL CRO-DISPLACE,DM,,,%DEFM
	MKAL [defmacro-1|]DM,DFM.1,2
	MKAV CRO-CHECK-ARGS,V%DCA,TRUTH,,%DEFM
	MKAV CRO-DISPLACE-CALL,V%DDC,TRUTH,,%DEFM
	MKAV CRO-FOR-COMPILING,V%DFC,TRUTH,,%DEFM
	MKALV [DEFUN&]DM,%DEFUN
	MKALV [&r-l|]DM,%R.L,3,QUNBOUND
;;; 	MKAL MACRO,DM,MACRO  	;;; NOTE THAT THIS MUST BE "ABOVE"


	MRA [MACAID]
	MKAL FLATTEN-SYMS,MA,,2
	MKALV [carcdrp|]MA,%%CRP,1,TRUTH
	MKAL [no-funp|]MA,,1
	MKAL DUP-P,MA,,1,%PIPN
	MKAL [side-effectsp|]MA,,1 
	MKAL [constant-p|]MA,,1
	MKAL DEFSIMPLEMAC,MA
	MKAL DEFCOMPLRMAC,MA
	MKAL DEFBOTHMACRO,MA
	MKAL SYMBOLCONC,MA,,1777

	MRA [MLMAC]
	MKAL HERALD,MM
	MKAL IF,MM
	MKAL SETQ-IF-UNBOUND,MM
	MKAL SELECTQ,MM
	MKAL CATCH,MM,CATCH
	MKAL THROW,MM,THROW
	MKAL DEFVAR,MM
	MKAL DEFCONST,MM
	MKAL PSETQ,MM
	MKAL MULTIPLE-VALUE,MM
	MKAL S,MM,,,%VALU
	MKAL LIST,MM,,,%MTPL
	MKAL BIND,MM,,,%MTPL
	MKAL WITH-INTERRUPTS,MM
	MKAL WITHOUT-INTERRUPTS,MM
	MKAL WITHOUT-TTY-INTERRUPTS,MM

	MRA [MLSUB]
	MKAL LISTP,MS,,1
	MKAL LIST|,MS,,1,%MTPL
	MKAL S-LIST,MS,,1,%VALU
	MKAL [ECK-MULTIPLICITIES]MS,,1,%SICH
	MKAL <=,MS,,2777
	MKAL >=,MS,,2777

	MKAL LOGAND,MS
	MKAL LOGIOR,MS
	MKAL LOGXOR,MS
	MKAL LOGNOT,MS
	MKAL MP,MS,,1,%FIXN
	MKAL MP,MS,,1,%FLON
	MKAL EVENP,MS

	MKAL SEND,EX,SEND,2777
	MKAL CLASSP,EX,,1
	MKAL CLASS-OF,EX,,1
	MKAL TENDP,EX,,1,%SIEX
	MKAL EXTENDP,EX,,1


	MRA [EXTBAS]
	MKAL SI:MAKE-EXTEND,EB,,2
	MKAL TEND,EB,,1777,%SIEX
	MKAL SI:XREF,EB,,2
	MKAL SI:XSET,EB,,3
	MKAL TEND-LENGTH,EB,,1,%SIEX

	MRA [EXTSTR]
	MKAL S*-2,ES,,45,%SIDC
	MKAL **SELF-EVAL**,ES
	MKAL **CLASS-SELF-EVAL**,EX

	MRA [EXTEND]
	MKAL PTR-TYPEP,EX,,1
	MKAL S*-1,EX,,34,%SIDC
	MKAL ADD-METHOD,EX,,3
	MKAL FIND-METHOD,EX,,2

	MKAL DESCRIBE,DS,DESCRIBE,12
	MKAL WHICH-OPERATIONS,DS,WOP,1

	MRA [YESNOP]
	MKAL Y-OR-N-P,YN
	MKAL YES-OR-NO-P,YN

	MRA [EXTMAC]
	MKAL DEFCLASS*,EM
	MKAL DEFMETHOD*,EM

	MKAL CERROR,CE,CERROR,4777
	MKAL FERROR,CE,,2777
	MKAL ERROR-RESTART,CE
	MKAL LOSSAGE,CE,,3,%PIPN

	MRA [EXTSFA]
	MKAL SFA-UNCLAIMED-MESSAGE,EA,,3

	MRA [ERRCK]
	MKAL CHECK-TYPE,EC
	MKAL [ECK-TYPER]EC,,3,%SICH
	MKAL CHECK-SUBSEQUENCE,EC
	MKAL [ECK-SUBSEQUENCER]EC,,58,%SICH


	MKAL DEFVST,DV,DEFVST

	RMTAH1 [ ]$DEFVSX,,DEFVSX
	MKAL SETVST,DX
	MKAL [t-construction|]DX,,2,%DVST
	MKAL [t-construction-1|]DX,,2,%DVST
	MKAL [t-selection-1|]DX,,1,%DVST
	MKAL [t-xref|]DX,,1,%DVST

	RMTAH1 [ ]%DEFVSY,,DEFVSY
	MKAL [t-typchk|]DY,,3,%DVST
	MKAL STRUCT-TYPEP,DY,,1
	MKAL [t-initialize|]DY,,5,%DVST


IRP A,,[GRIND,CGOLREAD,LAP,TRACE,CGOL]B,,[GI,CG,LA,TR,CG]
	MKAL A,B,A
TERMIN
	MKAL FORMAT,FT,FORMAT,2777
	MKAL GRIND0,GI
	MKALV GRINDEF,GE,GFN
	MKAL SPRINTER,GE,,1
	MKAL SPRIN1,GE,,12
	MKAL READMACROINVERSE,GE,$RMI

	MKAL GETMIDASOP,GT,GETMIDASOP,1
	MKAL SORT,SO,SORT,2
	MKAL SORTCAR,SO,,2
	MKALV EDIT,ED,$EDIT
	MKAL [LAP-A-LIST]LA
SA$	MKAT2 EREAD,ER
SA$	MKAT2 HELP,HE
IFN USELESS,[
	MKAL BLTARRAY,BL,BLTARRAY,2
	MKAL DUMPARRAYS,DP,DUMPARRAYS,2
	MKAL LOADARRAYS,DP,,1
]		;END OF IFN USELESS
IFN ITS,[
	MKAL ALLFILES,AL,ALLFILES,1
    IRP A,,[MAPALLFILES,DIRECTORY,MAPDIRECTORY]AR,,[2,12,23]
	MKAL A,AL,,AR
    TERMIN
]   		;END OF IFN ITS

IFN JOBQIO\D20	MKAL LEDIT,LE,LEDIT
IFN JOBQIO,[
	MKAL LISPT,LT,LISPT
	MKAL [INF-EDIT]LT
]		;END OF IFN JOBQIO
IT$ 	MRA [HUMBLE]
IT$	MKAL [CREATE-JOB]HM


	MKAL LOOP,LO,LOOP
	MKAL DEFINE-LOOP-PATH,LO

SUBTTL	ATOMS FOR ODDBALL FUNCTIONS AND VARIABLES

IFN ITS, MKFV ALARMCLOCK,ALARMCLOCK,SUBR,,2
IFE ITS,[
SA$	MKAV ALARMCLOCK
SA%	VALARM==VNIL
]	;END OF IFE ITS

;FOLLOWING SYMBOLS MUST BE IN THIS ORDER, JUST AFTER ALARMCLOCK -- .SEE UINT90
IFN USELESS,[	
    IFN ITS\SAIL,[	
		MKAV CLI-MESSAGE,VCLI,,CLI
		MKAV MAR-BREAK,VMAR,,MAR
		MKAV TTY-RETURN,VTTR,,TTR
		MKAV SYS-DEATH,VSYSD,,SYSD
	]	    ;END OF IFN ITS\SAIL
;;Really, for the SAIL case, we'd like to just have
;;     	REPEAT UIFSYS, 0
;; in the Sail case, since we don't need all those 4 atom headers
;; However, we must note that it is a space of four words needed
;; in value-cell space.
;; ZZZ==.
;; LOC C.
;;     	REPEAT UIFSYS, 0
;; LOC ZZZ
    IFN SAIL,[
    	MKAV SI:SAIL-MAIL-SERVICE,V.SMS
    ]	    ;END OF IFN SAIL
]		;END OF IFN USELESS


	MKFV NOUUO,NOUUO,SUBR,,1
	MKFV NORET,NORET,SUBR,,1
	MKFV EVALHOOK,EVALHOOK,LSUBR,,23
	MKFV EVAL-*-PRINT,TLPRINT,SUBR,,1,%READ
	MKFV EVAL-PRINT-*,TLTERPRI,SUBR,,0,%READ
	MKFV *-READ-EVAL-PRINT,$TLREAD,SUBR,,0
	MKFV *-EVAL-PRINT,TLEVAL,SUBR,,1,%READ
	MKFV GCTWA,GCTWA,FSUBR
	MKFV ARGS,ARGS,LSUBR,,12
	MKFV *RSET,.RSET,SUBR,TRUTH,1
	MKFV *NOPOINT,.NOPOINT,SUBR,,1

	MKFV OBARRAY,OBARRAY,ARRAY,OBARRAY
	MKFV READTABLE,READTABLE,ARRAY,READTABLE

	MKAV ERROR-BREAK-ENVIRONMENT,VE.B.E,IGSBV

	MKAV *:TRUTH,VT.ITY,TRUTH
	MKAT1 [STR:ARRAY]ARRAY,,STR%AR

SUBTTL	ATOMS FOR NEWIO FUNCTIONS AND VARIABLES

IRPS A,C,[NAMELIST NAMESTRING SHORTNAMESTRING,TRUENAME INPUSH,PROBEF LOAD FILEP]
	MKAT A,SUBR,[C]1
TERMIN

	MKFV DEFAULTF,DEFAULTF,SUBR,,1
	MRA NODEFAULT
	MKAT1 FORCE-OUTPUT,SUBR,[ ]FORCE,1
	MKAT1 CLEAR-OUTPUT,SUBR,[ ]CLROUT,1
	MKAT1 CLEAR-INPUT,SUBR,[ ]CLRIN,1

IRPS A,C,[CLOSE DELETEF IN FASLP ]
	MKAT1 A,SUBR,[C]$!A,1
TERMIN

	MKAT1 +TYI,SUBR,,PTYI,1
	MKAT1 +TYO,SUBR,,PTYO,2
	MKAT1 UNTYI,SUBR,[ ]UNTYI,2
	MKAT1 OPEN,LSUBR,[ ]$OPEN,02
SA$	MKAT1 EOPEN,LSUBR,[ ]$EOPEN,04
	MKAT1 OUT,SUBR,[ ]$OUT,2
	MKAT1 INCLUDEF,SUBR,,.INCLU,1
	MKAT1 RENAMEF,SUBR,[ ]$RENAMEF,2
	MKAT CNAMEF,SUBR,[ ]2
	MKAT MERGEF,SUBR,,2
	MKAT1 LENGTHF,SUBR,[ ]$LENGTHF,1
	MKAT1 LISTEN,LSUBR,[ ]$LISTEN,01

IFN SFA,[
	MRA SFA
	MKAT1 SFA-CREATE,SUBR,,STCREA,3
	MKAT1 SFA-CALL,SUBR,,STCALL,3
	MKAT1 SFAP,SUBR,,STPRED,1
	MKAT1 SFA-GET,SUBR,,STGET,2
	MKAT1 SFA-STORE,SUBR,,STSTOR,3
	MRA PNAME		  ;Needed as symbolic name for 'PNAME' slot
	 ; Other symbolic slots are 'PLIST', 'FUNCTION', 'WHICH-OPERATIONS',
	 ;  AND 'XCONS'.  actually, 'which-operations' is cached on the plist.
	;MSA WOP,WHICH-OPERATIONS ;done for EXTEND above
	MRA FILEMODE
	;MRA TTYCONS 		  ;No longer needed - use 'XCONS' slot instead 
	MRA [TTYSCAN,TTYINT,TTYSIZE,TTYTYPE,OSPEED,LINMOD]
]		;END IFN SFA


IRPS A,C,[CRUNIT,UKILL,UFILE UCLOSE,UAPPEND,UPROBE,INCLUDE]
	MKAT A,FSUBR,[C]
TERMIN
	MKFV UREAD,UREAD,FSUBR
	MKFV UWRITE,UWRITE,FSUBR


IRPS A,,[INFILE,INSTACK,OUTFILES,ECHOFILES]C,,[TRUTH,,,]
	MKAV A,,C
TERMIN
	MKAV MSGFILES,,QTLIST,MSGFILES

	MKFV TYI,%TYI,LSUBR,TTYIFA,02
	MKAT1 READLINE,LSUBR,[ ]%READLINE,02
	MKAT TYIPEEK,LSUBR,[ ]03

	MKFV TYO,%TYO,LSUBR,TTYOFA,12
	MKAT1 PRINT,LSUBR,[ ]%PRINT,12
	MSA %SLFPR,[:PRINT-SELF]
	MKFV PRIN1,%PR1,LSUBR,,12
	MKAT1 PRINC,LSUBR,[ ]%PRC,12
	MKAT1 [PRINT-OBJECT]LSUBR,[ ]%PRO,45
	MKAT1 [FLATSIZE-OBJECT]LSUBR,[ ]%FLO,45
	MKFV TERPRI,%TERPRI,LSUBR,TRUTH,01
	MKFV READ,OREAD,LSUBR,,02
	MKAT1 READCH,LSUBR,[ ]$READCH,02

IRPS A,C,[ENDPAGEFN EOFFN PAGEL CHARPOS LINENUM PAGENUM LINEL RUBOUT FILEPOS ERRPRINT ]
	MKAT A,LSUBR,[C]12
TERMIN

SUBTTL	ATOMS FOR VARIABLES AND USER INTERRUPT BREAKS

;;; TTYOPN WILL INIT VLINEL TO THE RIGHT THINGS.
;;; FOR NON-BIBOP, NOTE THAT LINEL AND CHRCT POINT INTO THE
;;; (UNRELOCATED!) INUM AREA DURING ALLOC. THEY WILL THUS
;;; HAVE THE RIGHT VALUES BUT THE WRONG TYPE (I.E. TYPEP
;;; OF THEM WOULD LOSE.) THUS PRINT ETC. SHOULD NOT CHECK
;;; TYPEP OF THESE THINGS. ALLOC REHACKS THEIR VALUES AFTERWARDS.
;;; CHRCT IS INITIALLY 777 SO ALLOC WON'T GENERATE CR'S.

COMMENT | VBPORG: VBPEND: VERRLIST: VTTY: VZUNDERFLOW: VZFUZZ: VCHRCT: VLINEL: |

IRP A,,[BPEND,BPORG,ERRLIST,TTY,ZUNDERFLOW]C,,[VBPE1,VBP1,,,]
	MKAV A,,C,A
TERMIN

SA$ 	MKAV SI:ECALLEDP,VECALL
SA$	MKAV SI:EJOBNUM,VEJOBN
BG$	MKAV ZFUZZ,,,ZFUZZ

COMMENT | VIBASE: VBASE: V%LEVEL: V%LENGTH: TAPRED: TTYOFF: TAPWRT: SIGNAL: |

;;; FOR NON-BIBOP, ALLOC REHACKS VBASE AND VIBASE AFTERWARDS.

   MKAV IBASE,,IN10,IBASE
   MKAV BASE,,IN10,BASE


IFN USELESS,[
	MKAV PRINLEVEL,V%LEVEL,,%LEVEL
	MKAV PRINLENGTH,V%LENGTH,,%LENGTH
]		;END OF IFN USELESS

IRP A,,[^Q,^W,^R,^A]B,,[TAPRED,TTYOFF,TAPWRT,SIGNAL]
	MKAV A,B
TERMIN

    ;; MAKES THE VALUE CELL POINT TO "PWIOINT"
	RMTAH1 ,,,WITHOUT-INTERRUPTS,,PWIOINT,%PIPN

	MKAV INTERRUPT-BOUND-VARIABLES,V%IBVL,NIL,,%PIPN
SA% 	MKAV [P]VDOLLRP,QDOLLRP,DOLLRP
SA$	MKAV [}P]VDOLLRP,QDOLLRP,DOLLRP
DOLLRP==QDOLLRP
	MKAV ^D,GCGAGV,,CN.D

;;;  (UNDF-FNCTN, UNBND-VRBL, WRNG-TYPE-ARG,
;;;	UNSEEN-GO-TAG, WRNG-NO-ARGS, GC-LOSSAGE, FAIL-ACT,
;;;	IO-LOSSAGE) MUST BE IN THAT ORDER

IRP A,,[UDF,UBV,WTA,UGT,WNA,GCL,FAC]PN,,[UNDF-FNCTN,UNBND-VRBL
WRNG-TYPE-ARG,UNSEEN-GO-TAG,WRNG-NO-ARGS,GC-LOSSAGE,FAIL-ACT]
	MKAV PN,V!A,Q!A!B,A
TERMIN

	MKAV IO-LOSSAGE,VIOL,QIOLB,IOL
	MKAV COMPILER-STATE,VCOMST
	MKAV MACHINE-ERROR,VMERR,,MERR

	PGTOP ATM,[SYSTEM ATOMS AND STUFF]

;;;	************* END OF PURE LISP (NON-BIBOP) ************* 



  	PFSLAST==.	;GUARANTEED SAFE OVER SPCTOP
   10$ 	$LOSEG
  	LOC C.
  	ESYSVC==.
  	EXPUNGE C.

SUBTTL	RANDOM BINDABLE CELLS

;;; HERE ARE THINGS WHICH ARE LIKE VALUE CELLS, IN THAT SPECPDL
;;; UNBINDING MUST WORK ON THEM; BUT THEY ARE NOT NECESSARILY
;;; MARKED FROM.

LISAR:	NIL		;LAST INTERPRETIVELY-SEEN ARRAY - ASAR

TYIMAN:		$DEVICE	;WHERE TO GET CHARACTERS FROM
UNTYIMAN:	IUNTYI	;WHERE TO PUT BACK CHARACTERS TO
UNREADMAN:	.+1
		.VALUE
READPMAN:	.+1
	.VALUE


FASLP:	NIL		;FASLOADING-P?
TIRPATE:	0	;PSEUDO VALUE CELL, USED TO EXTIRPATE THE CONSEQUENT UNBINDING 
			;FOLLOWING A SETQ DONE ON NIL OR T

;;; #### MOOOBY IMPORTANT!  MUST HAVE <ADDRESS OF ARGNUM> = <ADDRESS OF ARGLOC> + 1
ARGLOC:	0		;FOR LEXPRS - LOCATION OF ARG VECTOR ON PDL
ARGNUM:	0		;HOLDS FIXNUM WHICH IS # OF ARGS FOR LEXPR IN ARGLOC


SUBTTL	BIBOP STORAGE PARAMETER CALCULATIONS

BFVCS:
INFVCS==BXVCSG-BFVCS
IFL INFVCS, WARN \-INFVCS,[=TOO MANY VALUE CELLS]
SPCTOP VC,ILS,[VALUE CELL]


LOC S.
EXPUNGE S. B.
IFL ESYMGS-1-.,	WARN \.-ESYMGS,[=TOO MANY SYMBOLS (SYMEST=]\SYMEST,[)]
SYMSYL==:.			;ADR OF LAST SYSTEM SYM
SPCTOP SYM,ILS,[SYMBOL HEADER]
IFE PAGING,[
	NXXASG==0
	NXXZSG==0
	$HISEG
]		;END OF IFE PAGING
IFN PAGING,[
	BXXASG==.
	NXXASG==<<<BXXASG+PAGSIZ-1>&PAGMSK>-BXXASG>/SEGSIZ
	BXXZSG==BXXASG+NXXASG*SEGSIZ	;TAKE UP SLACK PAGES BEFORE SY2
	NXXZSG==<BSY2SG-BXXZSG>/SEGSIZ
]		;END OF IFN PAGING


NSY2SG==<BPFXSG-BSY2SG>/SEGSIZ
SEGUP BSY2SG+NSY2SG*SEGSIZ-1
SPCTOP SY2,ILS,[PURE SYMBOL BLOCK]


LOC F.
EXPUNGE F.
IFL EPFXGS-1-HINUM-LONUM-., WARN \.+HINUM+LONUM-EPFXGS,[=TOO MANY PURE FIXNUMS (PFXEST=]\PFXEST,[)]

ZZ==EPFXGS-.
ZZZ==<ZZ-HINUM-LONUM>/2		; THEN TO THE NEXT PAGE BOUNDARY
XHINUM==HINUM+ZZZ		;DISTRIBUTE ANY SUCH EXTRA SPACE EVENLY
IFL XHINUM-777,XHINUM==777	;MANY LOSERS DEPEND ON HINUM BEING AT LEAST THIS BIG
XLONUM==ZZ-XHINUM		; BETWEEN POSITIVE AND NEGATIVE INUMS
IFL XLONUM-10,[
	WARN [XLONUM=]\XLONUM,[, YOU WILL CERTAINLY LOSE]
	.ERR INUM LOSSAGE
]
	REPEAT XLONUM, .RPCNT-XLONUM
IN0:		;HAIRY PAGE (APPROXIMATELY) OF SMALL FIXNUMS
REPEAT XHINUM, .RPCNT
IRP X,,[1,2,3,4,5,6,7,10,777]
	IN!X=IN0+X
TERMIN

INFORM [HIGHEST NLISP INUM=]\XHINUM
INFORM [LOWEST NLISP INUM=-]\XLONUM

SPCTOP PFX,ILS,[PURE FIXNUM]



LOC PFSLAST
SPCTOP PFS,ILS,[PURE LIST]
SPCBOT PFL
	;;; INITIAL ASSEMBLED PURE FLONUMS GO HERE (HA HA!)
SPCTOP PFL,ILS,[PURE FLONUM]
10$	$LOSEG

SUBTTL	INITIAL RANDOM IMPURE FREE STORAGE

IFN PAGING,[
	BXXPSG==.		;POSSIBLE SLACK PURE SEGMENT
	PAGEUP
	NXXPSG==<.-BXXPSG>/SEGSIZ
	SPCBOT IFS
	NPURFS==<.-BPURFS>/PAGSIZ
]		;END OF IFN PAGING
.ELSE,	SPCBOT IFS

FIRSTW:

;;; First few cells of impure list space are not sweepped -- they
;;; are considered pre-protectd.

QXSET1:	.,,NIL		;FOR XSETQ

	NUNMRK==.-FIRSTW		.SEE GCP6
	IFG NUNMRK-40, WARN \NUNMRK,[=TOO MANY UNMARKABLE FS LOCATIONS]

;;; PROPERTY LIST FOR "LISP" WITH ITS INITIAL "PPN" PROPERTY FOR LISP SYSTEM
;;;  FILE DIRECTORY SPECIFICAITON.  In TOPS-20 world, will possibly be
;;;  reset upon each start-up
PLLISP:	QPPN %
10$ INIT1Y:	
	Q%ALD,,NIL

IT$ FEATEX:		QEXPERIMENTAL %
FEATLS:			;INITIAL LIST FOR (STATUS FEATURES)
		QMACLISP %
		QPDP10 %
IFN BIGNUM,	QBIGNUM %
		QFASLOAD %
IFN HNKLOG,	QHUNK %
		QFUNARG %
IFN USELESS,	QROMAN %
IFN SFA,	QSFA %
10$ HS%		QONESEGMENT %
PG$		QPAGING %
		QNEWIO,,FEATL1


;;; FROM BPROTECT, FOR DISTANCE LPROTECT, IS PROTECTED BY THE GARBAGE COLLECTOR.
.SEE GCP6Q2

BPROTECT:

BG$		BNV1,,ARGNUM	;TO PROTECT CONTENTS OF  THESE CELLS
BG%		 NIL,,ARGNUM
TLF:		NIL		;TOP LEVEL FORM - NIL FOR STANDARD
BLF:		NIL		;ANALOGOUSLY, THE BREAK LEVEL FORM
VCTRS:	0	;() OR LIST OF SUBR ADDRESSES  [ (VECTORP VECTOR-LENGTH VREF) ]
QF1SB:		NIL		;SAVE B DURING QF1
PA3:		0		;RH = PROG BODY (I.E. CDDR OF PROG FORM)
				;LH = NEXT PROG STATEMENT
GCPSAR:		0		;POINTS TO SAR FOR HASH ARRAY FOR GC-PROTECTION LISTS
	RDLARG:	NIL		;LIST OF CHARS FOR READLIST, MAKNAM, IMPLODE

SUDIR:		NIL		;INITIAL SNAME (ITS) OR PPN (DEC-10)
LDFNAM:		NIL		;FASLOAD FILE NAME
LDEVPRO:	NIL		;LIST OF EVALED-FROBS-IN-ATOMTABLE TO BE PROTECTED

NILPROPS:	NIL		;PROPERTY LIST FOR NIL

DEOFFN:		NIL		;DEFAULT EOF FUNCTION
DENDPAGEFN:	NIL		;DEFAULT END OF PAGE FUNCTION

UUSRHNK:	NIL		;USER-HUNK checking routine
USENDI:		NIL		;User SEND interpreter
UCALLI:		NIL		;User CALL interpreter


FEATURES:	FEATLS
;;; Three cells of the initial FEATURES list are special -- those for
;;; OPSYSTEM-TYPE, SITE, and FILESYSTEM-TYPE
FEATL1:
;; Beware! non-ITS depends upon OPSYFT having a CDR link to SITEFT, which
;;   the code in UDIRSET may splice out.
IFE ITS,[
OPSYFT:					;Operating system type --  on TOPS
10$ SA%		QTOPS10 %		; systems, we want this info as well
20$ 		QTOPS20 %		; as "FILE-SYSTEM-TYPE"
]	;END OF IFE ITS
;"SITE"
  ;Startup puts "AI", "ML", or "MC" here on ITS systems,
  ; "TOPS-20" or "TENEX" for DEC20 style systems
  ; "TOPS-10" or "CMU" for non-SAIL DEC10 style systems
  ;But may be spliced out by UDIRSET Code.
SITEFT:		
SA$		QSAIL %
SA%		NIL %	
;FILE SYSTEM TYPE COMES LAST
FILEFT:	
IT$		QITS,,NIL
10$		QDEC10,,NIL
20$		QDEC20,,NIL




LPROTECT==:.-BPROTECT

Q.=:QITIMES		;ALIASES FOR THE SYMBOL *
V.=:VITIMES
.HKILL QITIMES VITIMES

IGCMKL:	DEDSAR %		;DEAD AREA AT TOP OF BPS
	IGCFX1 %
	INIIFA %		;INIT FILE ARRAY
	IGCFX2,,NIL


	OBTFS:	BLOCK KNOB+10	;FREE STORAGE FOR OBARRAY CONSAGE
	LFSALC==100
	FSALC:	BLOCK LFSALC	;FOR ALLOC
	SPCTOP IFS,ILS,[IMPURE LIST]




  	SPCBOT IFX

BG$ BNV1:	.	;TEMPORARILY RPLACED BY BNCVTM



VBP1:	BBPSSG		;INITIAL ALLOCATED VALUE FOR BPORG
VBPE1:	INIIF1-2	;INITIAL ALLOCATED VALUE FOR BPEND

IGCFX1:
PG$	<<ENDLISP+PAGSIZ-1>&PAGMSK>-EINIFA	;SIZE OF DEAD BLOCK
PG%	0					;WILL BE CALCULATED BY ALLOC
IGCFX2:	LINIFA					;SIZE OF INIT FILE ARRAY




  	LFWSALC==40
  	FWSALC:	BLOCK LFWSALC	;FOR ALLOC
  	NIFWAL==0
  	SPCTOP IFX,ILS,[IMPURE FIXNUM]

	SPCBOT IFL
	1.0	;NEED AT LEAST ONE IMPURE FLONUM SEGMENT
	SPCTOP IFL,ILS,[IMPURE FLONUM]

IFN BIGNUM,[
	SPCBOT BN
BBIGPRO:		.SEE GCP6Q3	;PROTECTED BIGNUMS
BN235:	0,,BNM23A
BNM235:	-1,,BNM23A
BNM236:	-1,,BNM23B
BNV2:	0,,BNV2A
BN.1:	0,,BN.1A
LBIGPRO==.-BBIGPRO
	SPCTOP BN,ILS,[BIGNUM]
]		;END OF IFN BIGNUM

IFE BIGNUM,[
  	BBNSG==.
  	NBNSG==0
]		;END OF IFE BIGNUM

IFN PAGING,[
	BXXBSG==.		;TAKE UP SLACK UNTIL FIRST PAGE OF BPS
	PAGEUP
	NXXBSG==<.-BXXBSG>/SEGSIZ
]		;END OF IFN PAGING



IF2 GEXPUN
BLSTIM==.MRUNT-BLSTIM
INFORM [TIME TO MAKE INITIAL STRUCT, PASS ]\.PASS,[ = ]\BLSTIM/1000.,[ SECS]