perm filename STRUCT[NEW,LSP]2 blob sn#388710 filedate 1978-10-11 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00026 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	   -*-MIDAS-*-
C00005 00003
C00007 00004
C00009 00005
C00013 00006
C00015 00007
C00018 00008
C00022 00009
C00024 00010
C00026 00011
C00030 00012
C00034 00013
C00036 00014
C00039 00015
C00041 00016
C00044 00017
C00046 00018
C00049 00019
C00053 00020
C00055 00021
C00058 00022
C00061 00023
C00063 00024
C00066 00025
C00068 00026
C00069 ENDMK
C⊗;
;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** INITIAL LIST STRUCTURE ******************
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1978 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
SFA$ SYMEST==1100		;ESTIMATED INITIAL NUMBER OF LISP SYMBOLS
SFA% SYMEST==1000
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==<ITS\D20>*2000/SEGSIZ

.NSTGWD		;NO STORAGE WORDS OVER MACRO DEFINITIONS

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




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

DEFINE ADDOB A,N
DEFINE OB!N
20% .RL1+A
20$ 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,D
	Q!B %
	A,,
RMTAH1 [C]A,PNL-2,[A]D,SUNBOUND,100
TERMIN

DEFINE MKAT1 A,B,C,D,E
	Q!B %
	D,,
RMTAH1 [C]D,PNL-2,[A]E,SUNBOUND,100
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,,
IFSN [C], MKAT2A [A]C
IFSE [C], MKAT2A [A]A
TERMIN

DEFINE MKAT2A PN,D
RMTAH1 [ ]D,PNL-2,[PN],SUNBOUND,100
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 A,B,C,D
IFSN [D], RMTAH1 [ ]D,,A,,C.,100
IFSE [D], RMTAH1 ,,,A,,C.,100
C..==.
LOC C.
IFSN [B],   B:
.ELSE,   V!A:
	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 A,B,C,D,E
	Q!C %
	B,,
RMTAH1 [ ]B,PNL-2,[A]E,V!B,100
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,,SUNBOUND,100
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.  OTHERWISE, 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, V THE LABEL OF THE VALUE CELL

DEFINE RMTAH1 C,D,PL,PN,AR,V,UC
PNL==.
LOC S.
PUTOB .
IFSE [C] , Q!D:
		B.,,PL
S.==.
LOC B.
	UC\777200,,V
	    NN!AR,,PNL
B.==.
LOC PNL
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,02
13,34,35,45
03,27,37,04
3777,17]R,,[1,0,2,3
4,5,6,1002
2003,3004,2007,4007
1011,2777,3777,1003
2004,4005,4006,5006
1004,3010,4010,1005
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 MKAT2A

.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)
IFN QIO,[
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)
]		;END OF IFN QIO
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
SYMSYF::			;FIRST LOC OF SYSTEM SYMBOLS
TRUTH:	$$$TRUTH,,NIL		;ATOM HEADER FOR T
	PUTOB TRUTH
20%	ADDOB -.RL1+NIL,\KNOB
20$	ADDOB NIL,\KNOB
;;;	CROCK TO PUTOB NIL CORRECTLY

;;; THESE FIVE SYMBOLS ARE **NOT** ON THE OBARRAY
QUNBOUND:	$$$UNBOUND,,NIL	;INTERNAL UNBOUND MARKER
IFN EDFLAG,[
EDLP:	$$$EDLP,,NIL
EDRP:	$$$EDRP,,NIL
EDSTAR:	$$$EDSTAR,,NIL
]		;END OF IFN EDFLAG
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
IFN EDFLAG,[
$$$EDLP:	777300,,SUNBOUND
		0,,$$EDLP
$$$EDRP:	777300,,SUNBOUND
		0,,$$EDRP
$$$EDSTAR:	777300,,SUNBOUND
		0,,$$EDSTAR
]		;END OF IFN EDFLAG

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

SEGUP BSY2SG+GSNSY2*SEGSIZ-1



	SPCBOT PFX
INR70:	R70
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)

  	$$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

SSSBRL:	QARRAY %
ASBRL:	QAUTOLOAD %

SYSBRL:	QARRAY,,SBRL

SBRL:	QSUBR %
	QFSUBR %
	QLSUBR,,NIL

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



SUBTTL	+INTERNAL FUNCTIONS AND INITIAL AUTOLOAD PROPERTIES

RDQTEB=RDQTE		;THE OTHERS WIN BECAUSE THEY ARE 6 CHARS
IRP X,,[RDQTE,RDSEMI,RDVBAR]Y,,[['],[;],[|]]
	MKAT1 [+INTERNAL-Y-MACRO]SUBR,[ ]X!B,0
TERMIN

IFE QIO,[
	MKAT1 +INTERNAL-TYO-MACRO,SUBR,[ ]TTYECOB
	MKAT1 +INTERNAL-↑H-BREAK,SUBR,[ ]CN.HB
]		;END OF IFE QIO
IFN QIO,[
	MKAT1 +INTERNAL-TTYSCAN-SUBR,SUBR,[ ]TTYBUF,3
	MKAT1 +INTERNAL-↑Q-MACRO,SUBR,[ ]CTRLQ,0
	MKAT1 +INTERNAL-↑S-MACRO,SUBR,[ ]CTRLS,0
	MKAT1 +INTERNAL-↑B-BREAK,SUBR,[ ]CN.BB,2
	MKAT1 +INTERNAL-IOL-BREAK,SUBR,[ ]IOLB,1
	MKAT1 +INTERNAL-UREAD-EOFFN,SUBR,[ ]UREOF,2
	MKAT1 +INTERNAL-INCLUDE-EOFFN,SUBR,[ ]INCEOF,2
	MKAT1 +INTERNAL-TTY-ENDPAGEFN,SUBR,[ ]TTYMOR,1
]	;END OF IFN QIO

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

  	MKAT1 +INTERNAL-PDL-BREAK,SUBR,[ ]PDLB,1
  	MKAT1 +INTERNAL-GCO-BREAK,SUBR,[ ]GCOB,1

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


	MKAT1 +INTERNAL-AUTOLOAD,SUBR,[ ]IALB

BSYSAP==.		;BEGINNING OF SYSTEM AUTOLOAD PROPERTIES
;;; NOTE THAT DUE TO THE 6-CHAR LOSS, GRINDEF HAD TO BECOME GFN IN THE LABEL
IRP A,,[GRIND,GFN,LAP,TRACE,GETMIDASOP,INDEX,SORT,LET,BAQAUL,FORMAT]B,,[GI,GE,LA,TR,GT,IN,SO,LM,BQ,FT]
	QFL.!B:	Q!A,,IRATBL
TERMIN
IFE EDFLAG,	QFL.ED:	QEDIT,,IRATBL
 		QFL.CG:	QCGOL,,IRATBL
SA$		QFL.ER:	QEREAD,,IRATBL
SA$		QFL.HE:	QHELP,,IRATBL
IFN QIO,[
IFN USELESS,	QFL.DA:	QDUMPARRAYS,,IRATBL
IFN MOBIOF,	QFL.MX:	QMPX,,IRATBL
IFN ITS,	QFL.DS:	QSLAVE,,IRATBL
IFN ITS,	QFL.NV:	QNVID,,IRATBL
IFN ITS,	QFL.LE:	QLEDIT,,IRATBL
IFN ITS,	QFL.LT:	QLISPT,,IRATBL
IFN ITS,	QFL.HM:	QHUMBLE,,IRATBL
IFN USELESS,	QFL.AL:	QALLFILES,,IRATBL
]	;END OF IFN QIO
ESYSAP==.		;END OF SYSTEM AUTOLOAD PROPERTIES

IRATBL:	QFASL %			;STANDARD FN2 AND DEVICE/DIRECTORY FOR AUTOLOAD FILES
IRACOM:
IT$	QDSK %			;ON ITS, DIR IS (DSK LISP)
IT$	QLISP,,NIL
IFN D10,[
IFN TOPS10,[
	QSYS,,NIL		;ON TOPS-10: (SYS)
]		;END OF IFN TOPS10
IFN SAIL,[
	QDSK %			;ON SAIL IT IS (DSK (MAC LSP))
	.+1,,NIL
	QMAC %
	QLSP,,NIL
]		;END OF IFN SAIL
IFN CMU,[
	QDSK %			;FOR NOW, USE JONL'S DIRECTORY ON CMU: (DSK N920JW51)
	QN920JW51,,NIL
]		;END OF IFN CMU
]		;END OF IFN D10
IFN D20,[
	QDSK %			;FOR D20 IT IS (DSK MACLISP)
	QMACLISP,,NIL
]		;END OF IFN D20
IFE .-IRACOM, WARN [IRACOM UNDEFINED]

Q%	QFASLL:	QFASL,,NIL


SUBTTL	RANDOM LIST STRUCTURE

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

IFN EDFLAG,[
EDFUNL:	QEXPR %
	QFEXPR %
	QMACRO,,NIL
  	$$EDLP:
		APN [%I(%]
  	$$EDRP:
		APN [%I)%]
  	$$EDSTAR:
		APN [%D()%]
]	;END OF IFN EDFLAG

IFN QIO,[
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

QCOMDEV:	IRACOM,,NIL
IFN ITS,[
QCOMDIR:	.+1,,NIL
		QDSK %
		QCOMMON,,NIL
]		;END OF IFN ITS
]		;END OF IFN QIO

Q% PSUDOSPACE:	203,,NIL	;WHEN RDIN WANTS TO RETURN ONE SPACE.
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 %
REPEAT HNKLOG, CONC QHUNK,\.RPCNT+1,,,.+1
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

;;; (LIST, FIXNUM, FLONUM, DOUBLE, COMPLEX, DUPLEX, BIGNUM,
;;;	SYMBOL, <HUNKS>, RANDOM, ARRAY) MUST BE IN THAT ORDER
;;; (NOTE THAT THIS OVERLAPS THE NEXT LIST!)
COMMENT # QLIST: QFIXNUM: QFLONUM: QDOUBLE: QCOMPLEX: QDUPLEX:
	  QBIGNUM: QSYMBOL: QHUNK1: QRANDOM: QARRAY: #
  		MKAT LIST,LSUBR,[ ]
  		MRA FIXNUM
  		MRA FLONUM
DB$		MRA DOUBLE
CX$		MRA COMPLEX
DX$		MRA DUPLEX
BG$		MRA BIGNUM
  		MRA SYMBOL
	IRP X,,[4,8,16,32,64,128,256,512,1024]
	IFE .IRPCNT-HNKLOG, .ISTOP
  		CONC MSA HUNK,\.IRPCNT+1,,HUNK!X
	TERMIN
  		MKAT RANDOM,LSUBR,[ ]01
;;; (ARRAY, SUBR, FSUBR, LSUBR, EXPR, FEXPR, MACRO, AUTOLOAD) MUST BE IN THAT ORDER
  		MKAT ARRAY,FSUBR,[ ]
		MKAT SUBR,SUBR,[ ]1
	IRP A,,[FSUBR,LSUBR,EXPR,FEXPR,MACRO]
		MRA A
	TERMIN
Q%		MRA AUTOLOAD
;;; FOR QIO, (AUTOLOAD, ERRSET, *RSET-TRAP, GC-DAEMON,
;;;	GC-OVERFLOW, PDL-OVERFLOW) MUST BE IN THAT ORDER
;;; NOTE THAT AUTOLOAD BELONGS TO SEQUENCE ABOVE ALSO
IFN QIO,[
		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
]			;END OF IFN QIO
		MRA [VALUE,LAMBDA,DSK,SYM,SPLICING,SINGLE,EVALARG,BPS]
		MRA [BIBOP,FASL,JCL,LISP,DDT]
		MSA GSYM,GLOBALSYM
IFN FUNAFL,	MRA [LABEL,FUNARG]
IT$		MRA COM
IT$		MRA COMMON
10$		MRA SYS
SA$		MRA [MAC,LSP]
CMU$		MRA N920JW51

;;; (REGPDL, FLPDL, FXPDL, SPECPDL) MUST BE IN THAT ORDER
		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
IT$		MRA ITS
10$		MRA DEC10
20$		MRA DEC20
T10$		MSA TOPS10,TOPS-10
20X		MSA TOPS20,TOPS-20
10X		MRA TENEX
CMU$		MRA CMU
		MRA EXPERIMENTAL
IFN USELESS,	MRA ROMAN
IFN SAIL+QIO,	MRA SAIL
IFN JOBQIO,	MRA JOB
IFN QIO,	MRA [FILE,ECHO,CLA,IMAGE,BLOCK,NEWIO,OUTPUT,SCROLL]
20$		MRA MACLISP
Q$ IT$		MRA [.LISP.,SLAVE]
Q$		MSA RDEOF,READ-EOF
Q$		MSA CN.B,[↑B]
		MSA M,[?]
		MSA ..MIS,[**MISSING-ARG**]
		MSA LA,[←]
		MSA XPRHSH,EXPR-HASH

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

;;; MUST HAVE (RUNTIME, TIME) IN THAT ORDER
	MKAT1 RUNTIME,SUBR,[ ]$RUNTIME,0
	MKAT TIME,SUBR,[ ]0


MKFV CAR,CAR,SUBR,,1
MKFV CDR,CDR,SUBR,,1
MKAT NTH,SUBR,,2
MKAT NTHCDR,SUBR,,2


IRPS A,C,[FIXP FLOATP RETURN EVALFRAME ERRFRAME,
BIGP,BOUNDP,LISTIFY 
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,CDDDDR,
NOT,ATOM TYPEP,EXPLODE,MINUSP,PLUSP,NUMBERP ZEROP,
INTERN,LAST,REVERSE,NREVERSE,READLIST,MAKNAM,
LENGTH,ABS,MINUS,ADD1,SUB1,FIX,FLOAT,
FLATSIZE,FLATC,ARG COS,SQRT,LOG,EXP,
SXHASH,NOINTERRUPT,REMOB,SYSP,MAKUNBOUND,IMPLODE,MUNKAM
MAKNUM,SYMEVAL,PLIST,PURCOPY]
	MKAT A,SUBR,[C]1
TERMIN
	MKAT1 NCONS,SUBR,,$NCONS,1
	MKAT1 SLEEP,SUBR,,$SLEEP,1
	MKAT1 SIN,SUBR,,$SIN,1
IFN USELESS,	MKAT HAULONG,SUBR,,1

IFE QIO,[
	MKAT1 TYI,LSUBR,[ ]%TYI,01
	MKAT1 TYO,SUBR,[ ]%TYO,1
	MKAT1 PRINT,SUBR,[ ]PRINT,1
	MKAT1 PRINC,SUBR,[ ]PRINC,1
	MKFV TERPRI,%TERPRI,SUBR,,0
	MKFV PRIN1,PRIN1,SUBR,,1
	MKAT ERRPRINT,SUBR,,1
	MKFV READ,OREAD,LSUBR,,01
	MKAT1 READCH,LSUBR,[ ]$READCH,01
	MKAT LISTEN,SUBR,,0
	MKAV JPG|,VJPG			;***** CROCK FOR JPG *****
]		;END OF IFE QIO

IRPS A,C,[IFIX,EXPLODEC,NULL,ASCII ALLOC]
	MKAT1 A,SUBR,[C]$!A,1
TERMIN


MKAT1 SYMBOLP,SUBR,,%SYMBOLP,1
MKAT1 EXPLODEN,SUBR,,$$EXPLODEN,1
MKAT1 ARRAYDIMS,SUBR,,ADIMS,1
MKAT1 PNGET,SUBR,,$PNGET,2

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

	MKAT1 XCONS,SUBR,,$XCONS,2
	MKAT1 GETCHARN,SUBR,,$GETCHARN,2

IFN HNKLOG,[
	MKAT CXR,SUBR,,2
	MKAT MAKHUNK,SUBR,[ ]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
]

IFN USELESS*<1-QIO>,[
	MKAT DUMPARRAYS,SUBR,,2
	MKAT LOADARRAYS,SUBR,,1
]		;END OF IFN USELESS*<1-QIO>

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

	MKAT1 ↑,SUBR,,XPTII,2
	MKAT1 ↑$,SUBR,,XPTI$,2

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

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,SETSYNTAX,SUBST]
	MKAT A,SUBR,[C]3
TERMIN

  	MKFV PUTPROP,PUTPROP,SUBR,SBRL,3

IFN USELESS*ITS, MKAT1 PURIFY,SUBR,,$PURIFY,3

IFN LHFLAG, MKAT1 LH|,SUBR,,LHVBAR,2

SUBTTL	ATOMS FOR FSUBRS AND LSUBRS

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

IFE QIO,[
IRPS A,C,[CRUNIT UKILL UREAD UWRITE UFILE UCLOSE UAPPEND ,
UPROBE IOC IOG ]
	MKAT A,FSUBR,[C]
TERMIN
]		;END OF IFE QIO

	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
IFN FUNAFL,	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 PROG2,LSUBR,[ ]2777
	MKAT PROGN,LSUBR,[ ]
	MKAT BOOLE,LSUBR,,2777

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

IT$	MKAT SYSCALL,LSUBR,[ ]3777
;THIS IS FOR LSUBR CONS
;	MKAT1 CONS,LSUBR,[ ]$CONS,1777
	MKAT1 LIST*,LSUBR,[ ]$CONS,1777
;THIS IS FOR NON-LSUBR CONS
	MKAT1 CONS,SUBR,,$C2NS,2
	MKAT FUNCALL,LSUBR,[ ]1777
	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

Q%	MKAT TYIPEEK,LSUBR,[ ]01


IFN USELESS*ITS,[
Q$	MKAT CURSORPOS,LSUBR,[ ]03
Q%	MKAT CURSORPOS,LSUBR,[ ]02
]		;END OF IFN USELESS*ITS

	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

;;; THESE FOUR MUST BE IN THIS ORDER!
				.SEE UINT32
	MKAT ODDP,SUBR,[ ]1
	MKFV EVAL,OEVAL,LSUBR,NIL,12
	MKFV EVAL-WHEN,EWHEN,FSUBR,NIL,1
	MKAT DEPOSIT,SUBR,[ ]2
	MKAT EXAMINE,SUBR,[ ]1


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

;SYSTEM "MACROS"
	MKAT1 PUSH,FSUBR,[ ]$PUSH
	MKAT1 POP,FSUBR,[ ]$POP
	MKAT DISPLACE,SUBR,,2
	MKAT2 LET,LM
	MKAT2 +INTERNAL-BACKQUOTE-MACRO,BQ,BACKQM
	MSA BAQAUL,BACKQ
	MKAT2 FORMAT,FT


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
	MKAT1 *CONS,SUBR,[ ]$C2NS,2
IRP A,,[PRINT,PRIN1,PRINC,TERPRI,TYO]B,,[PRT,PR1,PRC,TRP,TYO]C,,[1,1,1,0,1]
Q$	MKAT1 *!A,SUBR,[ ]B!$,C
Q%	MSA B!$,*!A
TERMIN
IRP A,,[READ,READCH,TYI]B,,[READ,RDCH,TYI]C,,[0,0,0]
Q$	MKAT1 *!A,SUBR,[ ]B!$,C
Q%	MSA B!$,*!A
TERMIN
	MKAT1 *EVAL,SUBR,,EVAL,1
	MKAV PURE,VPURE,IN1*PAGING	;INIT TO NIL OR 1 (IF PAGING SYS)
  	MKAV *PURE,V.PURE
	MKAV PUzCLOBRL
	MKAT1 FASLAPSETUP|,SUBR,,FSLSTP,1
	MKFV LAPSETUP|,LAPSETUP,SUBR,,2
	MKAT PAGEBPORG,SUBR,[ ]0
	MKFV TTSR|,TTSR,SUBR
	MKAT1 SQOZ|,SUBR,,5BTWD,1
	MKAT GETDDTSYM,SUBR,[ ]1
	MKAT PUTDDTSYM,SUBR,,2
	MKFV GCPROTECT,GCPRO,SUBR,,2
	MKAV SYMBOLS,V$SYMBOLS,,$SYMBOLS
	MKFV FASLOAD,FASLOAD,FSUBR,SBRL

MKAT2 GRINDEF,GE,GFN
MKAT2 GRIND0,GI,GR0
IFN QIO*JOBQIO, MKAT2 LEDIT,LE
IFN QIO*JOBQIO, MRA LISPT
IFN QIO*JOBQIO, MKAT2 [INF-EDIT]LT,INF%ED
IFN QIO*ITS, MRA HUMBLE
IFN QIO*ITS, MKAT2 [CREATE-JOB]HM,CR%JOB
MKAT2 [LAP-A-LIST]LA,L%A%L
IRPS A,,[SPRINTER,GRIND,GETMIDASOP,LAP,TRACE,INDEX,SORT,SORTCAR
CGOL,CGOLREAD]B,,[GE,GI,GT,LA,TR,IN,SO,SO,CG,CG]
	MKAT2 A,B
TERMIN
SA$	MKAT2 EREAD,ER
SA$	MKAT2 HELP,HE
IFN QIO*USELESS,[
IRP A,,[DUMPARRAYS,LOADARRAYS,ALLFILES,MAPALLFILES,DIRECTORY,MAPDIRECTORY]B,,[DA,DA,AL,AL,AL,AL]
	MKAT2 A,B
TERMIN
]	;END OF IFN QIO*USELESS

SUBTTL	ATOMS FOR ODDBALL FUNCTIONS AND VARIABLES

IFN <SAIL*<QIO-1>>+ITS, MKFV ALARMCLOCK,ALARMCLOCK,SUBR,,2
IFE <SAIL*<QIO-1>>+ITS, VALARM==VNIL
IFN QIO*USELESS,[		;THESE MUST BE IN THIS ORDER, FOLLOWNG ALARMCLOCK
	MKAV CLI-MESSAGE,VCLI,,CLI
	MKAV MAR-BREAK,VMAR,,MAR
	MKAV TTY-RETURN,VTTR,,TTR
	MKAV SYS-DEATH,VSYSD,,SYSD
]		;END OF IFN QIO*USELESS

	MKFV NOUUO,NOUUO,SUBR,,1
	MKFV NORET,NORET,SUBR,,1
Q%	MKFV ERRSET,ERRSET,FSUBR
	MKFV EVALHOOK,EVALHOOK,LSUBR,,23
	MKAV READ-*-EVAL-PRINT,VTLEVAL
	MKAV READ-EVAL-*-PRINT,VTLPRINT
	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

IFN EDFLAG,[
	MKFV EDIT,$EDIT,FSUBR,EDFUNL
	MRA EDIT
	MKAV [≠≠≠]VDLDLDL	;EDITOR'S LEFT LIST
	MKAV [↑↑↑]EDUPLST	;EDITOR'S UP LIST
	MKAV [≠≠]VDOLLAR,,DOLLAR
]		;END OF IFN EDFLAG
IFE EDFLAG, MKAT2 EDIT,ED


IFN QIO,[

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 +TYO,SUBR,,PTYO,2
	MKAT1 OPEN,LSUBR,[ ]$OPEN,04
SA$	MKAT1 EOPEN,LSUBR,[ ]$EOPEN,04
	MKAT1 OUT,SUBR,[ ]$OUT,2
	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,[
	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
	MSA WOP,WHICH-OPERATIONS
	MRA FILEMODE
	MRA UNTYI
	MRA SFA
	MRA PNAME
	MRA NAME
	MRA PROBEF
	MRA TTYSCAN
	MRA TTYCONS
]		;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
	MKFV PRIN1,%PR1,LSUBR,,12
	MKAT1 PRINC,LSUBR,[ ]%PRC,12
	MKFV TERPRI,%TERPRI,LSUBR,,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
]		;END OF IFN QIO

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

BG$	MKAV ZFUZZ,,,ZFUZZ

Q%	MKAV CHRCT,,IN777,CHRCT
Q%	MKAV LINEL,,IN777,LINEL


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

Q%	MKAV ↑B,LPTON
SA% 	MKAV [≠P]VDOLLRP,DOLLRP,DOLLRP
SA$	MKAV [}P]VDOLLRP,DOLLRP,DOLLRP
	MKAV ↑D,GCGAGV,,CN.D
Q%	MKAV ↑H,VCN.H,QCN.HB,CN.H

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

;;; FOR QIO, (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
   Q%	MKAV PDL-OVERFLOW,VPDL,QPDLB,PDL
   Q%	MKAV GC-OVERFLOW,VGCO,QGCOB,GCO

Q$	MKAV IO-LOSSAGE,VIOL,QIOLB,IOL

Q%	MKAV GC-DAEMON,VGCDAEMON
Q%	MKAV *RSET-TRAP,V.TRAP,QCB,.R.TP
	MKAV COMPILER-STATE,VCOMST
Q$	MKAV MACHINE-ERROR,VMERR,,MERR

IFN MOBIOF,[

SUBTTL	ATOMS FOR MOBY I/O FUNCTIONS


	MKAT NEXTPLOT,SUBR,,0
	IRPS A,C,[IMPX PLOT PLOTTEXT]
		MKAT A,SUBR,[C]1
	TERMIN
	IRPS A,C,[OMPX MPX NVFIX NVID ]
		MKAT A,SUBR,[C]2
	TERMIN
	MKAT NVSET,SUBR,,5
	MKAT PLOTLIST,LSUBR,[ ]12
IRP A,,[DISCOPY,DISCRIBE,DISGORGE,DISGOBBLE,DISFRAME]
	MKAT A,SUBR,,1
TERMIN
IRPS A,C,[DISBLINK,DISPLAY DISMARK]
	MKAT A,SUBR,[C]2
TERMIN
IRP A,,[DISLINK,DISCHANGE,DISLOCATE]
	MKAT A,SUBR,,3
TERMIN
	MKAT DISMOTION,SUBR,,4
	MKAT DISFLUSH,LSUBR
	MKAT DISINI,LSUBR,,02
	MKAT DISLIST,LSUBR,,01
	MKAT DISCREATE,LSUBR,,02
	MKAT DISAPOINT,LSUBR,,34
	MKAT DISALINE,LSUBR,,35
	MKAT DISCUSS,LSUBR,,45
	MKAT DISET,LSUBR,,13
	MKAV ↑F,DISON,,CN.F
	MKAV ↑N,DISPON,,CN.N

IRP A,,[MPX,PLOT,PLOTLIST,NVFIX,NVSET]B,,[MX,MX,MX,NV,NV]
	MKAT2 A,B
TERMIN
]				;END OF IFN MOBIOF
IFN ITS*QIO,[
	MKAT2 DISINI,DS
	MKAT2 SFTV|,NV,SFTV.
	MKAT2 NVID,NV
]	;END IFN ITS
	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

IFE QIO,[
VCN.AT:	NIL	;INTERRUPT FUN FOR ↑@
VICA:	NIL	; " ↑A
VIC34:	NIL	; " ↑\
VIC35:	NIL	; " CONTROL RIGHT BRACKET
VIC36:	NIL	; " ↑↑

VAUTFN:	QIALB	;AUTOLOAD FUNCTION
]		;END OF IFE QIO

IFE QIO,[
TYIMAN:	NIL	;IT'S....... TYI-MAN!
			;FASTER THAN A SPEEDING IMLAC!
			;MORE POWERFUL THAN A TECOMOTIVE!
			;ABLE TO LEAP TALL FUNCTIONS WITH A SINGLE JRST!
		;YES, IT'S TYI-MAN! WHO, IN HIS NORMAL IDENTITY AS
		; CLARK NIL (A NAMELESS NOBODY), IS EVER-READY TO
		; ASSUME A SECRET SUPER-IDENTITY TO PROTECT AND SERVE
		; FREEDOM, JUSTICE, AND THE HIRSUTE READER!!!!!!!!
TMBBC:	0	;ROBIN, TYIMAN'S BIRD-BRAINED COMPANION!
		;WOULD YOU BELIEVE TYIMAN'S BUFFERED-BACK CHARACTER?
]		;END OF IFE QIO

IFN QIO,[
TYIMAN:		$DEVICE	;WHERE TO GET CHARACTERS FROM
UNTYIMAN:	UNTYI	;WHERE TO PUT BACK CHARACTERS TO
UNREADMAN:	.+1
		.VALUE
;	UNRD	;WHERE TO PUT BACK FORMS TO
READPMAN:	.+1
	.VALUE
;	READP	;WHERE TO GO TO CHECK FOR PENDING FORMS
]		;END OF IFN QIO

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]
IFN D10,[
	NXXASG==0
	NXXZSG==0
	$HISEG
]		;END OF IFN D10
IFN ITS+D20,[
	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 ITS+D20


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 ITS+D20,[
	BXXPSG==.		;POSSIBLE SLACK PURE SEGMENT
	PAGEUP
	NXXPSG==<.-BXXPSG>/SEGSIZ
	SPCBOT IFS
	NPURFS==<.-BPURFS>/PAGSIZ
]		;END OF IFN ITS+D20
.ELSE,	SPCBOT IFS

FIRSTW:

QXSET1:	.,,NIL		;FOR XSETQ

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

FEATEX:		QEXPERIMENTAL %
FEATLS:			;INITIAL LIST FOR (STATUS FEATURES)
  		QBIBOP %
IFN BIGNUM,	QBIGNUM %
IFN EDFLAG,	QEDIT %
		QFASLOAD %
IFN HNKLOG,	QHUNK %
IFN FUNAFL,	QFUNARG %
IFN USELESS,	QROMAN %
IFN QIO,	QNEWIO %
IFN MOBIOF,	QCN.F %
IFN SFA,	QSFA %
	;PENULTIMATE IS DEC10/DEC20, OR ITS MACHINE NAME
IT$ MACHFT:	NIL %		;STARTUP PUTS MACHINE NAME HERE
10$		QDEC10 %
20$		QDEC20 %
	;OPERATING SYSTEM COMES LAST
IT$		QITS,,NIL
T10$		QTOPS10,,NIL
20X		QTOPS20,,NIL
SA$		QSAIL,,NIL
10X		QTENEX,,NIL
CMU$		QCMU,,NIL

;;; 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
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
IFE QIO,[
RDTYBF:		0		;SIMULATED TTY BUFF (FS LIST)
MKNM3:		NIL		;HOLDS LIST OF CHARS TO BE READLISTED
URUNIT:		NIL		;LAST ARG TO UREAD
UWUNIT:		NIL		;LAST ARG TO UWRITE
IUNIT:		NIL		;"CRUNIT"
]		;END OF IFE QIO
Q$	RDLARG:	NIL		;LIST OF CHARS FOR READLIST, MAKNAM, IMPLODE
IFN EDFLAG, EDSRCH:		NIL		;SAVED SEARCH LIST

IFN MOBIOF, FTVU:	NIL	;IF FAKE TV IS IN USE, HAS (G0001 DSK VIS)  ?
IFN MOBIOF, FTVBL:	NIL	;LIST OF BLOCKS CURRENTLY RESIDENT IN BUFFERS - LAST OF LIST IN LH

SUDIR:		NIL		;INITIAL SNAME (ITS) OR PPN (DEC-10)
FEATURES:	FEATLS

LDFNAM:		NIL		;FASLOAD FILE NAME
LDEVPRO:	NIL		;LIST OF EVALED-FROBS-IN-ATOMTABLE TO BE PROTECTED

NILPROPS:	NIL		;PROPERTY LIST FOR NIL

IFN QIO,[
DEOFFN:		NIL		;DEFAULT EOF FUNCTION
DENDPAGEFN:	NIL		;DEFAULT END OF PAGE FUNCTION
]		;END OF IFN QIO

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

IFN EDFLAG, DOLLAR=QDOLLAR
DOLLRP=QDOLLRP


Q%	IGCMKL==NIL	;INITIAL GCMKL
IFN QIO,[		;INITIAL GCMKL
IGCMKL:	DEDSAR %		;DEAD AREA AT TOP OF BPS
	IGCFX1 %
	INIIFA %		;INIT FILE ARRAY
	IGCFX2,,NIL
]		;END OF IFN QIO


	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:		;INITIAL ALLOCATED VALUE FOR BPORG
  	BBPSSG

VBPE1:		;INITIAL ALLOCATED VALUE FOR BPEND
   Q% IT$	<<ENDLISP+PAGSIZ-1>&PAGMSK>-1
   Q% 10$	ENDLISP
   Q$	INIIF1-2

IFN QIO,[
IGCFX1:
10%	<<ENDLISP+PAGSIZ-1>&PAGMSK>-EINIFA	;SIZE OF DEAD BLOCK
10$	0					;WILL BE CALCULATED BY ALLOC
IGCFX2:	LINIFA					;SIZE OF INIT FILE ARRAY
]		;END OF IFN QIO



  	LFWSALC==40
  	FWSALC:	BLOCK LFWSALC	;FOR ALLOC
  	NIFWAL==0
  	SPCTOP IFX,ILS,[IMPURE FIXNUM]

	SPCBOT IFL
	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

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



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

ββββ