mirror of
https://github.com/PDP-10/its.git
synced 2026-01-20 09:55:52 +00:00
1693 lines
39 KiB
Plaintext
1693 lines
39 KiB
Plaintext
;;; -*-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,MD,MX,DB,KA]
|
||
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", "MD", "MX", 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]
|
||
|