(FILECREATED " 3-Apr-85 22:26:42" {ERIS}<LISPCORE>SOURCES>I-NEW.;1
)


(PRETTYCOMPRINT I-NEWCOMS)

(RPAQQ I-NEWCOMS
 ((ADDVARS (LOCKEDFNS ERROR RAID \M44ACTONVMEMFILE \ACTONVMEMFILESUBR \ACTONVMEMPAGES 
\CLEANUPDISKQUEUE \CLEARCB \DISKERROR \DOACTONDISKPAGES \DODISKCOMMAND \EXTENDISFMAP 
\M44DOEXTENDVMEMFILE \GETDISKCB \INITBFS \INSUREVMEMFILE \LISPERROR \LOOKUPFMAP \REALDISKDA 
\VIRTUALDISKDA \CLEARWORDS \TESTPARTITION) (LOCKEDVARS \DISKREQUESTBLOCK \SWAPREQUESTBLOCK \MAINDISK 
\ISFCHUNKSIZE \EMUSCRATCH \EMUDISKBUFFERS \EMUSWAPBUFFERS \EMUDISKBUFEND \MAXSWAPBUFFERS \#DISKBUFFERS
 \InterfacePage \ISFMAP \ISFSCRATCHCAS \ISFSCRATCHDAS \SYSDISK \#SWAPBUFFERS \MAXDISKDAs 
%%STREAMTYPE# \DISKDEBUG \SPAREDISKWRITEBUFFER \#EMUBUFFERS \EMUBUFFERS \LASTVMEMFILEPAGE)) (FNS 
I.MAKEINITBFS) (ADDVARS (LOCKEDFNS \KEYHANDLER \KEYHANDLER1 \RESETKEYBOARD1 \DOTRANSITIONS 
\DOMOUSETRANSITIONS \CONTEXTAPPLY \LOCKPAGES \DECODETRANSITION \SMASHLINK \PUTEVENTQUEUE \INCUSECOUNT 
\PUTSYSBUF CLOCK0 \EVENTKEYS KEYDOWNP1 LRSH LLSH \MAKEFREEBLOCK \DECUSECOUNT \MAKENUMBER \ADDBASE 
\PERIODIC.INTERRUPTFRAME) (LOCKEDVARS \InterfacePage \TRANSITIONFLAGS \SHIFTSTATE 
\TRANSITIONSHIFTCODES \TRANSITIONCODES \EVENTSTATUS \ARMEDINTERRUPTS \EVENTQUEUE \MOUSEHOTSPOTX 
\MOUSEHOTSPOTY \MOUSETIMEBOX \SYSBUFFER \PENDINGINTERRUPT \COLORCURSORBM \COLORCURSORDOWN 
\COLORDISPLAYBITSPERPIXEL \ColorCursorBBT \COLORCURSORWIDTH \COLORSCREENCURSORLINE 
\COLORSCREENCURSORLINEBASE \COLORCURSORBASE \COLORSCREENWIDTHINBITS \COLORSCREENRASTERWIDTH 
\COLORCURSORRASTERWIDTH \PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY \LASTUSERACTION 
\MOUSECHORDTICKS) (LOCKEDVARS \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.REALUTILIN 
\EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.DISPINTERRUPT \EM.CURSORBITMAP \EM.DISPLAYHEAD)) (
ADDVARS (LOCKEDFNS \CLOCK0 \GETINTERNALCLOCK \BOXIDIFFERENCE \BOXIPLUS \BLT \SLOWIQUOTIENT) (
LOCKEDVARS \RCLKSECOND \RCLKMILLISECOND \MISCSTATS)) (FNS I.\LOCKFN I.\LOCKVAR I.\LOCKCELL 
I.\LOCKWORDS I.\LOCKCODE) (ADDVARS (LOCKEDFNS \FAULTHANDLER \FAULTINIT \D01.FAULTINIT \DL.FAULTINIT 
\CHAIN.UP.RPT \MAKESPACEFORLOCKEDPAGE \PAGEFAULT \READRP \READFLAGS \WRITEMAP \LOOKUPPAGEMAP 
\LOCKEDPAGEP \LOADVMEMPAGE \INVALIDADDR \INVALIDVP \SELECTREALPAGE \TRANSFERPAGE \SPECIALRP 
\UPDATECHAIN \MARKPAGEVACANT \FLUSHPAGE \CLEARWORDS \MOVEPAGE \ZEROPAGE \FLUSHVM \DONEWPAGE 
\DONEWEPHEMERALPAGE \WRITEDIRTYPAGE1 \COPYSYS0 \COPYSYS0SUBR \RELEASEWORKINGSET \DOFLUSHVM 
\DOLOCKPAGES \TEMPLOCKPAGES \TEMPUNLOCKPAGES \MP.ERROR RAID \DL.NEWFAULTINIT 
\DL.MARK.PAGES.UNAVAILABLE \DL.UNMAPPAGES \DL.ASSIGNBUFFERS \D01.ASSIGNBUFFERS \DOCOMPRESSVMEM 
\MOVEVMEMFILEPAGE) (LOCKEDVARS \REALPAGETABLE \RPTLAST \PAGEFAULTCOUNTER \UPDATECHAINFREQ \RPOFFSET 
\RPTSIZE \LOCKEDPAGETABLE \EMBUFBASE \EMBUFVP \EMBUFRP \LASTACCESSEDVMEMPAGE \MAXSHORTSEEK 
\MAXCLEANPROBES \MINSHORTSEEK \DIRTYPAGECOUNTER \DIRTYPAGEHINT \VMEM.INHIBIT.WRITE \VMEM.PURE.LIMIT 
\VMEM.FULL.STATE \GUARDVMEMFULL VMEM.COMPRESS.FLG \KBDSTACKBASE \MISCSTACKBASE \DOFAULTINIT \FPTOVP 
\MACHINETYPE \VMEMACCESSFN \TELERAIDBUFFER \EMUDISKBUFFERS \EMUDISKBUFEND \MAXSWAPBUFFERS \EMUBUFFERS 
\#EMUBUFFERS \#SWAPBUFFERS \#DISKBUFFERS \RCLKSECOND \RCLKMILLISECOND \VALSPACE \EMUSWAPBUFFERS 
\EM.CURSORBITMAP \PAGEMAP \PageMapTBL \IOCBPAGE \IOPAGE \MISCSTATS \DEFSPACE \InterfacePage 
\LASTVMEMFILEPAGE)) (FNS I.DUMPINITPAGES) (VARS INITCONSTANTS) (FNS I.SETUPPAGEMAP I.ADDPME 
I.MAKEROOMFORPME I.MAPPAGES) (FNS I.SETUPSTACK I.\SETUPSTACK1 I.\SETUPGUARDBLOCK I.\MAKEFREEBLOCK) (
ADDVARS (LOCKEDFNS \RESETSTACK0 \MAKEFRAME \SETUPSTACK1 \MAKEFREEBLOCK \FAULTHANDLER \KEYHANDLER 
\DUMMYKEYHANDLER \DOTELERAID \DUMMYTELERAID \DOHARDRETURN \DOGC \CAUSEINTERRUPT \INTERRUPTFRAME 
\CODEFORTFRAME \DOSTACKOVERFLOW \UNLOCKPAGES \DOMISCAPPLY) (LOCKEDVARS \InterfacePage \DEFSPACE 
\STACKSPACE \KBDSTACKBASE \MISCSTACKBASE)) (FNS I.INITGC) (FNS I.NTYPX I.\ALLOCMDSPAGE I.\MAKEMDSENTRY
 I.\GCTYPE I.\INITMDSPAGE I.\ASSIGNDATATYPE1 I.\TYPENUMBERFROMNAME I.\CREATECELL I.\NEW2PAGE) (FNS 
I.CREATEMDSTYPETABLE I.INITDATATYPES I.INITDATATYPENAMES) (VARS DTDECLS) (FNS I.FSETVAL I.SETPROPLIST 
I.PUTDEFN I.\BLT I.\ATOMCELL) (FNS I.\MKATOM I.\MKATOM.NEW I.\INITATOMPAGE I.\GCPNAMES I.\MOVEBYTES) (
FNS I.COPYATOM I.INITATOMS) (FNS I.MAKEINITFIRST I.\COPY I.MAKEINITLAST) (FNS I.\CONS.UFN 
I.\INITCONSPAGE I.\NEXTCONSPAGE) (FNS I.\GETBASEBYTE I.\PUTBASEBYTE I.CREATEPAGES I.\NEW4PAGE) (FNS 
I.ALLOCSTRING I.COPYSTRING) (ADDVARS (EXPANDMACROFNS \PUTBASETHIN \PUTBASEFAT \CHARCODEP)) (FNS 
I.\#BLOCKDATACELLS I.\PREFIXALIGNMENT? I.\ALLOCBLOCK I.\ALLOCBLOCK.NEW I.\MAKEFREEARRAYBLOCK 
I.\MERGEBACKWARD I.\LINKBLOCK) (FNS I.PREINITARRAYS I.POSTINITARRAYS I.FILEARRAYBASE 
I.FILEBLOCKTRAILER I.FILECODEBLOCK I.FILEPATCHBLOCK) (FNS I.DCODERD) (VARS \OPCODES (I.CODERDTBL (
COPYREADTABLE (QUOTE ORIG)))) (P (SETSYNTAX (CHARCODE ↑Y) (QUOTE (MACRO (LAMBDA (FILE RDTBL) (
EVALFORMAKEINIT (READ FILE RDTBL))))) I.CODERDTBL)) (FNS I.INITUFNTABLE I.\SETUFNENTRY) (VARS INITPTRS
 INITVALUES) (DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) MAKEINIT))))

(ADDTOVAR LOCKEDFNS
 ERROR RAID \M44ACTONVMEMFILE \ACTONVMEMFILESUBR \ACTONVMEMPAGES \CLEANUPDISKQUEUE 
\CLEARCB \DISKERROR \DOACTONDISKPAGES \DODISKCOMMAND \EXTENDISFMAP \M44DOEXTENDVMEMFILE \GETDISKCB 
\INITBFS \INSUREVMEMFILE \LISPERROR \LOOKUPFMAP \REALDISKDA \VIRTUALDISKDA \CLEARWORDS \TESTPARTITION)

(ADDTOVAR LOCKEDVARS
 \DISKREQUESTBLOCK \SWAPREQUESTBLOCK \MAINDISK \ISFCHUNKSIZE \EMUSCRATCH 
\EMUDISKBUFFERS \EMUSWAPBUFFERS \EMUDISKBUFEND \MAXSWAPBUFFERS \#DISKBUFFERS \InterfacePage \ISFMAP 
\ISFSCRATCHCAS \ISFSCRATCHDAS \SYSDISK \#SWAPBUFFERS \MAXDISKDAs %%STREAMTYPE# \DISKDEBUG 
\SPAREDISKWRITEBUFFER \#EMUBUFFERS \EMUBUFFERS \LASTVMEMFILEPAGE)
(DEFINEQ

(I.MAKEINITBFS

(LAMBDA NIL (*) (*) (I.\LOCKCELL (SETQ I.MAINDISK ((LAMBDA ($$1) (I.PUTBASEPTR $$1 0 NIL) $$1) (
I.\ALLOCBLOCK 18))) 34) (I.PUTBASEPTR I.MAINDISK 26 (I.\COPY (QUOTE DSK))) (I.\LOCKCELL (SETQ 
I.SWAPREQUESTBLOCK (I.\ALLOCBLOCK (LRSH (IPLUS (IPLUS 42 60) 1) 1))) (IPLUS 42 60)) (I.\LOCKCELL (SETQ
 I.DISKREQUESTBLOCK (I.\ALLOCBLOCK (LRSH (IPLUS (IPLUS 42 60) 1) 1))) (IPLUS 42 60)) (to 3 bind PREV (
CB ← (I.\ALLOCBLOCK 3)) first (I.\LOCKCELL CB 6) (SETQ PREV CB) do (I.\LOCKCELL CB 6) (SETQ PREV ((
LAMBDA ($$1) (PROG1 (SETQ $$1 (I.\ALLOCBLOCK 3)) (I.PUTBASEPTR $$1 0 PREV))) NIL)) finally (
I.PUTBASEPTR CB 0 PREV) (I.PUTBASEPTR I.MAINDISK 14 CB)) (SETQ I.FREEPAGEFID (I.\ALLOCBLOCK 3)) (*) (
for I from 0 to 4 do (I.PUTBASE I.FREEPAGEFID I (UNSIGNED -1 16)))))
)

(ADDTOVAR LOCKEDFNS
 \KEYHANDLER \KEYHANDLER1 \RESETKEYBOARD1 \DOTRANSITIONS \DOMOUSETRANSITIONS 
\CONTEXTAPPLY \LOCKPAGES \DECODETRANSITION \SMASHLINK \PUTEVENTQUEUE \INCUSECOUNT \PUTSYSBUF CLOCK0 
\EVENTKEYS KEYDOWNP1 LRSH LLSH \MAKEFREEBLOCK \DECUSECOUNT \MAKENUMBER \ADDBASE 
\PERIODIC.INTERRUPTFRAME)

(ADDTOVAR LOCKEDVARS
 \InterfacePage \TRANSITIONFLAGS \SHIFTSTATE \TRANSITIONSHIFTCODES 
\TRANSITIONCODES \EVENTSTATUS \ARMEDINTERRUPTS \EVENTQUEUE \MOUSEHOTSPOTX \MOUSEHOTSPOTY \MOUSETIMEBOX
 \SYSBUFFER \PENDINGINTERRUPT \COLORCURSORBM \COLORCURSORDOWN \COLORDISPLAYBITSPERPIXEL 
\ColorCursorBBT \COLORCURSORWIDTH \COLORSCREENCURSORLINE \COLORSCREENCURSORLINEBASE \COLORCURSORBASE 
\COLORSCREENWIDTHINBITS \COLORSCREENRASTERWIDTH \COLORCURSORRASTERWIDTH \PERIODIC.INTERRUPT 
\PERIODIC.INTERRUPT.FREQUENCY \LASTUSERACTION \MOUSECHORDTICKS)

(ADDTOVAR LOCKEDVARS
 \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.REALUTILIN 
\EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.DISPINTERRUPT \EM.CURSORBITMAP \EM.DISPLAYHEAD)

(ADDTOVAR LOCKEDFNS
 \CLOCK0 \GETINTERNALCLOCK \BOXIDIFFERENCE \BOXIPLUS \BLT \SLOWIQUOTIENT)

(ADDTOVAR LOCKEDVARS
 \RCLKSECOND \RCLKMILLISECOND \MISCSTATS)
(DEFINEQ

(I.\LOCKFN

(LAMBDA (FN) (*) (I.\LOCKCELL (SETQ FN (I.\ATOMCELL (PROGN (I.\COPY FN)) 10))) (COND ((NEQ 0 (LRSH (
I.GETBASE FN 0) 15)) (I.\LOCKCODE (I.GETBASEPTR FN 0))))))

(I.\LOCKVAR

(LAMBDA (VAR) (*) (I.\LOCKCELL (I.\ATOMCELL (PROGN (I.\COPY VAR)) 12))))

(I.\LOCKCELL

(LAMBDA (X NPGS) (*) (MKI.LOCKPAGES (I.VAG2 (I.HILOC X) (LOGAND (I.LOLOC X) 65280)) (OR NPGS 1))))

(I.\LOCKWORDS

(LAMBDA (BASE NWORDS) (*) (MKI.LOCKPAGES (I.VAG2 (I.HILOC BASE) (LOGAND (I.LOLOC BASE) 65280)) (COND (
NWORDS (LRSH (IPLUS (IPLUS (LOGAND (I.LOLOC BASE) 255) NWORDS) 255) 8)) (T 1)))))

(I.\LOCKCODE

(LAMBDA (CODEBLOCK) (*) (I.\LOCKWORDS CODEBLOCK (LLSH (I.\#BLOCKDATACELLS CODEBLOCK) 1))))
)

(ADDTOVAR LOCKEDFNS
 \FAULTHANDLER \FAULTINIT \D01.FAULTINIT \DL.FAULTINIT \CHAIN.UP.RPT 
\MAKESPACEFORLOCKEDPAGE \PAGEFAULT \READRP \READFLAGS \WRITEMAP \LOOKUPPAGEMAP \LOCKEDPAGEP 
\LOADVMEMPAGE \INVALIDADDR \INVALIDVP \SELECTREALPAGE \TRANSFERPAGE \SPECIALRP \UPDATECHAIN 
\MARKPAGEVACANT \FLUSHPAGE \CLEARWORDS \MOVEPAGE \ZEROPAGE \FLUSHVM \DONEWPAGE \DONEWEPHEMERALPAGE 
\WRITEDIRTYPAGE1 \COPYSYS0 \COPYSYS0SUBR \RELEASEWORKINGSET \DOFLUSHVM \DOLOCKPAGES \TEMPLOCKPAGES 
\TEMPUNLOCKPAGES \MP.ERROR RAID \DL.NEWFAULTINIT \DL.MARK.PAGES.UNAVAILABLE \DL.UNMAPPAGES 
\DL.ASSIGNBUFFERS \D01.ASSIGNBUFFERS \DOCOMPRESSVMEM \MOVEVMEMFILEPAGE)

(ADDTOVAR LOCKEDVARS
 \REALPAGETABLE \RPTLAST \PAGEFAULTCOUNTER \UPDATECHAINFREQ \RPOFFSET \RPTSIZE 
\LOCKEDPAGETABLE \EMBUFBASE \EMBUFVP \EMBUFRP \LASTACCESSEDVMEMPAGE \MAXSHORTSEEK \MAXCLEANPROBES 
\MINSHORTSEEK \DIRTYPAGECOUNTER \DIRTYPAGEHINT \VMEM.INHIBIT.WRITE \VMEM.PURE.LIMIT \VMEM.FULL.STATE 
\GUARDVMEMFULL VMEM.COMPRESS.FLG \KBDSTACKBASE \MISCSTACKBASE \DOFAULTINIT \FPTOVP \MACHINETYPE 
\VMEMACCESSFN \TELERAIDBUFFER \EMUDISKBUFFERS \EMUDISKBUFEND \MAXSWAPBUFFERS \EMUBUFFERS \#EMUBUFFERS 
\#SWAPBUFFERS \#DISKBUFFERS \RCLKSECOND \RCLKMILLISECOND \VALSPACE \EMUSWAPBUFFERS \EM.CURSORBITMAP 
\PAGEMAP \PageMapTBL \IOCBPAGE \IOPAGE \MISCSTATS \DEFSPACE \InterfacePage \LASTVMEMFILEPAGE)
(DEFINEQ

(I.DUMPINITPAGES

(LAMBDA (CODEFIRSTPAGE CODENEXTPAGE VERSIONS) (*) (*) (I.ADDPME (IPLUS (LLSH (I.HILOC (I.VAG2 6 0)) 8)
 (LRSH (I.LOLOC (I.VAG2 6 0)) 8)) T) (*) (for I from CODEFIRSTPAGE to (SUB1 CODENEXTPAGE) do (*) (
I.ADDPME I T)) (I.MAPPAGES 0 (ADD1 65533) (FUNCTION I.MAKEROOMFORPME)) (I.MAPPAGES 0 (ADD1 65533) (
FUNCTION I.ADDPME)) (PROGN (*) (I.PUTBASE (I.VAG2 6 0) 19 NEXTPM) (I.PUTBASE (I.VAG2 6 0) 20 (SUB1 
NEXTVMEM)) (I.PUTBASE (I.VAG2 6 0) 21 (SUB1 NEXTVMEM)) (I.PUTBASE (I.VAG2 6 0) 22 (I.GETBASE (I.VAG2 5
 0) 0)) (I.PUTBASE (I.VAG2 6 0) 23 (I.GETBASE ((LAMBDA (VPAGE) (DECLARE (LOCALVARS VPAGE)) (I.ADDBASE 
(I.VAG2 5 0) (IPLUS (I.GETBASE (I.VAG2 6 512) (LRSH VPAGE 5)) (LOGAND VPAGE 31)))) (IPLUS (LLSH (
I.HILOC (I.VAG2 6 512)) 8) (LRSH (I.LOLOC (I.VAG2 6 512)) 8))) 0)) (COND (VERSIONS (I.PUTBASE (I.VAG2 
6 0) 8 (CAR VERSIONS)) (I.PUTBASE (I.VAG2 6 0) 10 (CADDR VERSIONS)) (I.PUTBASE (I.VAG2 6 0) 9 (CADR 
VERSIONS)))) (I.PUTBASE (I.VAG2 6 0) 15 5603)) (I.MAPPAGES 0 (ADD1 65533) (FUNCTION DUMPVP)) (PROG ((
FILE (OUTPUT))) (COND ((NOT (RANDACCESSP FILE)) (* SYSOUT file is sequential; have to get it random 
access for this) (OUTPUT (SETQ FILE (OPENFILE (CLOSEF FILE) (QUOTE BOTH)))))) (SETFILEPTR FILE 
MKI.Page0Byte)) (DUMPVP (IPLUS (LLSH (I.HILOC (I.VAG2 6 0)) 8) (LRSH (I.LOLOC (I.VAG2 6 0)) 8)))))
)

(RPAQQ INITCONSTANTS
 ((* * (LISPNAME VALUE BCPLNAME UCODENAME)) (CDRCODING 1 T T) (* IF CDRCODING=0, 
CDR CODING IS OFF, OTHERWISE ON) (* * type numbers - repeated on LLBASIC too) (\SMALLP 1 SMALLTYPE 
SmallType) (\FIXP 2 INTEGERTYPE FixpType) (\FLOATP 3 FLTPTTYPE FloatpType) (\LITATOM 4 ATOMTYPE 
AtomType) (\LISTP 5 LISTTYPE ListType) (\ARRAYP 6 ARRAYPTRTYPE ArrayType) (\STRINGP 7 STRINGPTRTYPE) (
\STACKP 8) (\VMEMPAGEP 10 NIL VMemPagePType) (\STREAM 11 NIL STREAMTYPE) (* * TYPE TABLE CONSTANTS) (
\TT.TYPEMASK 255 TTTypeMask T) (\TT.NOREF 32768 NIL T) (\TT.LISPREF 16384 NIL T) (\TT.FIXP 8192) (
\TT.NUMBERP 4096) (\TT.ATOM 2048) (* * page map) (\PMblockSize 32 PMBLOCKSIZE) (\STATSsize 8 T) (
\NumPMTpages 8) (\EmptyPMTEntry 65535 T) (\FirstVmemBlock 2 T) (\MAXVMPAGE 65533) (\MAXVMSEGMENT 255) 
(* * interface page) (\IFPValidKey 5603 T) (* * MDS) (\FirstMDSPage 14846) (\MaxMDSPage 65533) (
\SecondMDSPage 65532) (\MDSIncrement 512) (* * arrays) (\ARRAYSPACE (19 0)) (\FirstArraySegment 19) (
\FirstArrayPage 4864) (\ARRAYSPACE2 (64 0)) (\SecondArrayPage 16384) (* * pname chars) (\PNCHARSSPACE 
(58 0)) (\PnCharsFirstSegment 58) (\PNAMESPACEEND (63 524287)) (\LastPnPage 1535) (* * stack block 
constants) (\StackMask 57344 T T) (\FxtnBlock 49152 T T) (\GuardBlock 57344 T T) (\BFBlock 32768 T T) 
(\FreeStackBlock 40960 T T) (\NotStackBlock 0) (* none of the above) (\MinExtraStackWords 32 T T) (* *
 backspace kludge) (ERASECHARCODE 0 T) (* * GC constants) (\HT1CNT 1024 NIL T) (\HTSTKBIT 512 NIL T) (
\HTCNTMASK 64512 NIL T) (\HTMAINSIZE 32768 NIL T) (\HTCOLLSIZE 65528 NIL T) (\HTENDFREE 1 NIL T) (
\HTFREEPTR 0 NIL T) (* * pointers and lengths of various data spaces) (\ATOMSPACE (0 0) (ATOMspace NIL
) (atomHiVal NIL)) (\AtomHI 0) (\AtomHashTable (7 0) (AHTspace AHTbase)) (\AtomHTpages 256 AHTSIZE) (
\LastAtomPage 255) (\MaxAtomFrLst 65535) (\SMALLPOSPSPACE (14 0)) (\SmallPosHi 14 SMALLPOSspace 
smallpl) (\SMALLNEGSPACE (15 0)) (\SmallNegHi 15 SMALLNEGspace smallneg) (\NumSmallPages 512) (
\PNPSPACE (8 0) (PNPspace PNPbase)) (\PNAME.HI 8) (\DEFSPACE (10 0) (DEFspace DEFbase) (DEFspace 
DEFbase)) (\DEF.HI 10) (\VALSPACE (12 0) (TOPVALspace TOPVALbase) (VALspace VALbase)) (\VAL.HI 12) (
\PLISTSPACE (2 0) (PLISTspace PLISTbase)) (\PLIST.HI 2) (\PAGEMAP (5 0) (PAGEMAPspace PAGEMAPbase)) (
\NumPageMapPages 256) (\PageMapTBL (6 512) (PMTspace PMTbase)) (\InterfacePage (6 0) (INTERFACEspace 
INTERFACEbase) (INTERFACEspace INTERFACEbase)) (\IOPAGE (0 65280)) (\IOCBPAGE (0 256)) (\FPTOVP (4 0))
 (\MDSTypeTable (6 32768) (MDSTYPEspace MDSTYPEbase) (MDSTYPEspace MDSTYPEbase)) (\MDSTTsize 128 T) (
\MISCSTATS (6 2560) (STATSspace MISCSTATSbase)) (\UFNTable (6 3072) NIL (STATSspace UFNTablebase)) (
\UFNTableSize 2) (\DTDSpaceBase (6 4096) (DTDspace DTDbase) (DTDspace DTDbase)) (\DTDSize 16 T) (
\LISTPDTD (6 4176)) (\EndTypeNumber 255) (\LOCKEDPAGETABLE (6 28672)) (\NumLPTPages 16) (\STACKSPACE (
1 0) (STACKspace NIL) (STACKspace NIL)) (\GuardStackAddr 61440) (\LastStackAddr 65534) (\STACKHI 1 T T
) (\HTMAIN (16 0) (HTMAINspace HTMAINbase) (HTMAINspace HTMAINbase)) (\HTMAINnpages 129 T) (
\HTOVERFLOW (16 32768) NIL (NIL HTOVERFLOWbase)) (\HTBIGCOUNT (16 33024)) (\HTCOLL (17 0) NIL (
HTCOLLspace HTCOLLbase)) (\DISPLAYREGION (18 0)) (\D1BCPLspace 0 T LEmubrHiVal) (\D0BCPLspace 0 T) (* 
* Interface Page locations) (\CurrentFXP 0 T T) (\ResetFXP 1 T T) (\SubovFXP 2 T T) (\KbdFXP 3 T T) (
\HardReturnFXP 4 T T) (\GCFXP 5) (\FAULTFXP 6 T T) (\MiscFXP 14 T T) (\TeleRaidFXP 24 T T) (* * 
emulator segment locations) (DCB.EM 272) (DISPINTERRUPT.EM 273) (CURSORBITMAP.EM 281) (KBDAD0.EM 65052
) (KBDAD1.EM 65053) (KBDAD2.EM 65054) (KBDAD3.EM 65055) (UTILIN.EM 65048) (CURSORX.EM 278) (CURSORY.EM
 279) (MOUSEX.EM 276) (MOUSEY.EM 277) (\LispKeyMask 8192 T T) (\BcplKeyMask 4352 T T) (* Machine types
) (\DOLPHIN 4) (\DORADO 5) (\DANDELION 6) (* * FOR DLION) (\VP.DISPLAY 4608) (* for wide display 
1024x808/16x256) (\NP.DISPLAY 202) (\RP.DISPLAY 0) (\RP.TEMPDISPLAY 1537) (\RP.MISCLOCKED 1739) (
\RP.STACK 768) (\VP.STACK 256) (\RP.MAP 256) (\NP.MAP 256) (\RP.IOPAGE 512) (\VP.IOPAGE 255) (
\VP.IFPAGE 1536) (\VP.FPTOVP 1024) (\NP.FPTOVP 256) (\RP.FPTOVP 1024) (\RP.STARTBUFFERS 640) (
\VP.TYPETABLE 1664) (\NP.TYPETABLE 128) (\RP.TYPETABLE 1280) (\VP.GCTABLE 4096) (\NP.GCTABLE 128) (
\RP.GCTABLE 1408) (\VP.GCOVERFLOW 4224) (\NP.GCOVERFLOW 1) (\RP.GCOVERFLOW 1536) (\FP.IFPAGE 2) (
\VP.IOCBS 1) (\VP.PRIMARYMAP 1538) (\VP.SECONDARYMAP 1280) (\VP.LPT 1648) (\RP.AFTERDISPLAY 206) (
\VP.INITSCRATCH 8) (\VP.RPT 128) (\VP.BUFFERS 218) (* DLion processor commands) (\DL.PROCESSORBUSY 
32768) (\DL.SETTOD 32769) (\DL.READTOD 32770) (\DL.READPID 32771) (\DL.BOOTBUTTON 32772)))
(DEFINEQ

(I.SETUPPAGEMAP

(LAMBDA NIL (*) (*) (PROG NIL (*) (MKI.NEWPAGE (I.VAG2 5 0) NIL T) (I.CREATEPAGES (I.VAG2 6 512) 8 NIL
 T) (*) (for I from 0 to (SUB1 (LLSH 8 8)) do (I.PUTBASE (I.VAG2 6 512) I 65535)) (SETQ NEXTPM 0) (for
 I from 0 to (SUB1 (LRSH 256 5)) bind (PAGEMAPKEY ← (LRSH (PROGN (IPLUS (LLSH (I.HILOC (I.VAG2 5 0)) 8
) (LRSH (I.LOLOC (I.VAG2 5 0)) 8))) 5)) do (*) (I.PUTBASE (I.VAG2 6 512) (IPLUS PAGEMAPKEY I) NEXTPM) 
(SETQ NEXTPM (IPLUS NEXTPM 32))) (SETQ NEXTVMEM 2) (*) (I.CREATEPAGES (I.VAG2 6 28672) 16 NIL T))))

(I.ADDPME

(LAMBDA (VP NEWPAGEOK) (*) (*) (PROG (PX PMP LOCKBASE) (COND ((IEQ (SETQ PMP (I.GETBASE (I.VAG2 6 512)
 (LRSH VP 5))) 65535) (*) (COND ((EVENP NEXTPM 256) (*) (SETQ PX (I.ADDBASE (I.VAG2 5 0) NEXTPM)) (OR 
NEWPAGEOK (IGREATERP (IPLUS (LLSH (I.HILOC PX) 8) (LRSH (I.LOLOC PX) 8)) VP) (HELP 
"page map needs new page after page map written out")) (MKI.NEWPAGE PX NIL T))) (I.PUTBASE (I.VAG2 6 
512) (LRSH VP 5) (SETQ PMP NEXTPM)) (SETQ NEXTPM (IPLUS NEXTPM 32)))) (SETQ PX (IPLUS PMP (LOGAND VP 
31))) (COND ((NEQ (I.GETBASE (I.VAG2 5 0) PX) 0) (HELP "page already in pagemap" VP)) (T (I.PUTBASE (
I.VAG2 5 0) PX NEXTVMEM) (COND ((MKI.LOCKEDPAGEP VP) (*) (I.PUTBASE (SETQ LOCKBASE (I.ADDBASE (I.VAG2 
6 28672) (LRSH VP 4))) 0 (LOGOR (LLSH 1 (IMOD VP 16)) (I.GETBASE LOCKBASE 0))))) (SETQ NEXTVMEM (ADD1 
NEXTVMEM)))))))

(I.MAKEROOMFORPME

(LAMBDA (VP) (*) (*) (COND ((IEQ (I.GETBASE (I.VAG2 6 512) (LRSH VP 5)) 65535) (*) (COND ((EVENP 
NEXTPM 256) (*) (MKI.NEWPAGE (I.ADDBASE (I.VAG2 5 0) NEXTPM) NIL T))) (I.PUTBASE (I.VAG2 6 512) (LRSH 
VP 5) NEXTPM) (SETQ NEXTPM (IPLUS NEXTPM 32))))))

(I.MAPPAGES

(LAMBDA (BOT TOP FN) (*) (PROG ((VP BOT) (IVP (IPLUS (LLSH (I.HILOC (I.VAG2 6 0)) 8) (LRSH (I.LOLOC (
I.VAG2 6 0)) 8)))) LP (COND ((AND (SETQ VP (MKI.NEXTPAGE VP)) (IGREATERP TOP VP)) (COND ((NOT (IEQ VP 
IVP)) (APPLY* FN VP))) (SETQ VP (ADD1 VP)) (GO LP))))))
)
(DEFINEQ

(I.SETUPSTACK

(LAMBDA (INITFLG) (*) (*) (I.CREATEPAGES (I.VAG2 1 0) (IQUOTIENT 9216 256) NIL T) (*) (
I.\SETUPGUARDBLOCK 0 2) (*) (I.PUTBASE (I.VAG2 6 0) 0 (I.\SETUPSTACK1 2 0 0 (IDIFFERENCE 768 2) 0 
RESETPC RESETPTR NIL INITFLG)) (I.PUTBASE (I.VAG2 6 0) 1 0) (I.PUTBASE (I.VAG2 6 0) 6 0) (I.PUTBASE (
I.VAG2 6 0) 2 0) (I.PUTBASE (I.VAG2 6 0) 3 0) (I.\SETUPGUARDBLOCK (IDIFFERENCE 768 2) 2) (I.PUTBASE (
I.VAG2 6 0) 30 (I.\SETUPGUARDBLOCK 768 (IDIFFERENCE (IDIFFERENCE 9216 768) 2))) (I.PUTBASE (I.VAG2 6 0
) 7 (I.\SETUPGUARDBLOCK (IDIFFERENCE 9216 2) 2))))

(I.\SETUPSTACK1

(LAMBDA (STKP ALINK CLINK STKEND NARGS PC DEFPTR ARGS INITFLG) (*) (COND ((OR INITFLG (IGREATERP (
IDIFFERENCE STKEND STKP) (IPLUS (PROG1 (I.GETBASE DEFPTR 0) (*)) (PROG1 4 (*))))) (*) (PROG ((SP STKP)
) (FRPTQ NARGS (I.PUTBASEPTR (I.VAG2 1 0) SP (CAR ARGS)) (*) (SETQ ARGS (CDR ARGS)) (SETQ SP (PLUS SP 
2))) (AND (PROG1 (COND ((ODDP SP 4) (I.PUTBASEPTR (I.VAG2 1 0) SP NIL) (*) (SETQ SP (PLUS SP 2)) T)) (
I.PUTBASE (I.VAG2 1 SP) 0 32768)) (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (
LOGAND (I.GETBASE $$PUTBITS 0) 65279) (LLSH (LOGAND 1 1) 8)))) (I.VAG2 1 SP)) 8) 1)) (I.PUTBASE (
I.VAG2 1 SP) 1 STKP) (SETQ STKP (IPLUS SP 2)) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR
 (LOGAND (I.GETBASE $$PUTBITS 0) 8191) (LLSH 6 13)))) (I.VAG2 1 STKP)) 13) (NEQ (LOGAND (LRSH ((LAMBDA
 ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 65279) (LLSH (LOGAND (COND 
(T 1) (T 0)) 1) 8)))) (I.VAG2 1 STKP)) 8) 1) 0) (NEQ (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE 
$$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 64511) (LLSH (LOGAND (COND (NIL 1) (T 0)) 1) 10))))
 (I.VAG2 1 STKP)) 10) 1) 0) (NEQ (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (
LOGAND (I.GETBASE $$PUTBITS 0) 61439) (LLSH (LOGAND (COND (NIL 1) (T 0)) 1) 12)))) (I.VAG2 1 STKP)) 12
) 1) 0) (NEQ (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE 
$$PUTBITS 0) 65023) (LLSH (LOGAND (COND (NIL 1) (T 0)) 1) 9)))) (I.VAG2 1 STKP)) 9) 1) 0) (LOGAND ((
LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 65280) (LOGAND 0 255)
))) (I.VAG2 1 STKP)) 255) (I.PUTBASE (I.VAG2 1 STKP) 8 SP) (I.PUTBASE (I.VAG2 1 STKP) 1 (IPLUS ALINK 
10 1)) (I.PUTBASE (I.VAG2 1 STKP) 9 (IPLUS CLINK 10)) (PROGN ((LAMBDA ($$1) (LRSH ((LAMBDA ($$PUTBITS)
 (I.PUTBASE $$PUTBITS 3 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 3) 255) (LLSH (PROGN $$1) 8)))) (I.VAG2 1 
STKP)) 8) (LOGAND ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 3 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 3) 
65280) (LOGAND $$1 255)))) (I.VAG2 1 STKP)) 255)) (I.HILOC DEFPTR)) (I.PUTBASE (I.VAG2 1 STKP) 2 (
I.LOLOC DEFPTR))) (I.PUTBASE (I.VAG2 1 STKP) 5 PC) (SETQ SP (IPLUS STKP (PROGN 10))) (COND ((NOT 
INITFLG) (*) (RPTQ (LLSH (ADD1 (SIGNED (I.GETBASE DEFPTR 2) 16)) 1) (PROGN (*) (I.PUTBASE (I.VAG2 1 0)
 SP 65535) (SETQ SP (PLUS SP 2)))))) (I.PUTBASE (I.VAG2 1 STKP) 4 (SETQ SP (PLUS SP (PROGN 4)))) (*) (
I.\MAKEFREEBLOCK SP (IDIFFERENCE STKEND SP)) (RETURN STKP))))))

(I.\SETUPGUARDBLOCK

(LAMBDA (STKP LEN) (*) (I.PUTBASE (I.VAG2 1 STKP) 0 57344) (I.PUTBASE (I.VAG2 1 STKP) 1 LEN) STKP))

(I.\MAKEFREEBLOCK

(LAMBDA (STK SIZE) (*) (PROGN (*) (I.PUTBASE (I.VAG2 1 STK) 1 SIZE) (I.PUTBASE (I.VAG2 1 STK) 0 40960)
)))
)

(ADDTOVAR LOCKEDFNS
 \RESETSTACK0 \MAKEFRAME \SETUPSTACK1 \MAKEFREEBLOCK \FAULTHANDLER \KEYHANDLER 
\DUMMYKEYHANDLER \DOTELERAID \DUMMYTELERAID \DOHARDRETURN \DOGC \CAUSEINTERRUPT \INTERRUPTFRAME 
\CODEFORTFRAME \DOSTACKOVERFLOW \UNLOCKPAGES \DOMISCAPPLY)

(ADDTOVAR LOCKEDVARS
 \InterfacePage \DEFSPACE \STACKSPACE \KBDSTACKBASE \MISCSTACKBASE)
(DEFINEQ

(I.INITGC

(LAMBDA NIL (*) (I.CREATEPAGES (I.VAG2 16 0) (LRSH (IPLUS 32768 255) 8) T T) (I.CREATEPAGES (I.VAG2 16
 32768) 1 T T) (I.CREATEPAGES (I.VAG2 16 33024) 1 T) (I.CREATEPAGES (I.VAG2 17 0) 1 NIL T) (
I.CREATEPAGES (I.ADDBASE (I.VAG2 17 0) 256) (SUB1 (LRSH (IPLUS 65528 255) 8)) T) (I.PUTBASE (I.VAG2 17
 0) 0 0) (I.PUTBASE (I.VAG2 17 0) 1 2)))
)
(DEFINEQ

(I.NTYPX

(LAMBDA (X) (*) (*) (LOGAND (I.GETBASE (I.VAG2 6 32768) (LRSH (IPLUS (LLSH (I.HILOC X) 8) (LRSH (
I.LOLOC X) 8)) 1)) 255)))

(I.\ALLOCMDSPAGE

(LAMBDA (TYP) (*) (PROG (VP VPTR) BEG (COND ((SETQ VP I.MDSFREELISTPAGE) (SETQ VPTR ((LAMBDA ($$1) (
I.VAG2 (LRSH (SETQ $$1 VP) 8) (LLSH (LOGAND $$1 255) 8))) NIL)) (PROG ((NXT (I.GETBASEPTR VPTR 0))) (
COND ((AND NXT (NOT (SMALLP NXT))) (\MP.ERROR 26 "MDS Free Page link bad.  ↑N to continue" (PROG1 
I.MDSFREELISTPAGE (SETQ I.MDSFREELISTPAGE))) (GO BEG)) (T (SETQ I.MDSFREELISTPAGE NXT))))) (T (NILL) (
SETQ VP I.NxtMDSPage) (SETQ I.NxtMDSPage (IDIFFERENCE VP (LRSH 512 8))) (*) (SETQ VPTR ((LAMBDA ($$1) 
(I.VAG2 (LRSH (SETQ $$1 VP) 8) (LLSH (LOGAND $$1 255) 8))) NIL)) (MKI.NEWPAGE (I.ADDBASE (MKI.NEWPAGE 
VPTR) 256)))) (I.\MAKEMDSENTRY VP TYP) (RETURN VPTR))))

(I.\MAKEMDSENTRY

(LAMBDA (VP V) (*) (I.PUTBASE (I.VAG2 6 32768) (LRSH VP 1) V)))

(I.\GCTYPE

(LAMBDA (TYPENUM DTD) (*) (if (OR (EQ 1 0) (NEQ TYPENUM 5)) then (*) (I.PUTBASEPTR DTD 2 (
I.\INITMDSPAGE (I.\ALLOCMDSPAGE (I.GETBASE DTD 14)) (I.GETBASE DTD 1) (I.GETBASEPTR DTD 2))))))

(I.\INITMDSPAGE

(LAMBDA (BASE SIZE PREV) (*) (*) (PROG ((SLOP (IREMAINDER 256 SIZE)) NPAGES LIMIT) (*) (COND ((AND (
NEQ SLOP 0) (ILESSP SLOP (LRSH SIZE 1)) (ILESSP SIZE 256)) (*) (SETQ NPAGES (IQUOTIENT 512 256)) (SETQ
 LIMIT 256)) (T (SETQ NPAGES 1) (SETQ LIMIT 512))) (to NPAGES do (for (DISP ← 0) while (ILEQ (SETQ 
DISP (PLUS DISP SIZE)) LIMIT) do (I.PUTBASEPTR BASE 0 PREV) (SETQ PREV BASE) (SETQ BASE (I.ADDBASE 
BASE SIZE))) (SETQ BASE (I.ADDBASE BASE SLOP))) (RETURN PREV))))

(I.\ASSIGNDATATYPE1

(LAMBDA (NAME DESCRIPTORS SIZE SPECS PTRFIELDS) (*) (PROG ((I.NTYPX (I.\TYPENUMBERFROMNAME NAME)) DTD)
 (COND (I.NTYPX (*) (SETQ DTD (I.ADDBASE (I.VAG2 6 4096) (LLSH I.NTYPX 4))) (COND ((AND (EQUAL 
PTRFIELDS (I.GETBASEPTR DTD 8)) (EQUAL SIZE (I.GETBASE DTD 1))) (*) (I.PUTBASEPTR DTD 4 DESCRIPTORS) (
I.PUTBASEPTR DTD 6 SPECS) (RETURN I.NTYPX)) ((OR (EQ CROSSCOMPILING T) (AND CROSSCOMPILING (NEQ (QUOTE
 Y) (ASKUSER 30 (SELECTQ CROSSCOMPILING (Y (QUOTE Y)) (QUOTE N)) (LIST (if SIZE then 
"OK TO REDECLARE DATATYPE " else "OK to deallocate DATATYPE ") NAME))))) (*) (RETURN I.NTYPX)) ((
IGREATERP I.NTYPX I.MaxSysTypeNum) (PROGN (I.PUTBASE DTD 0 (I.ATOMNUMBER (QUOTE **DEALLOC**))) (
I.PUTBASEPTR DTD 4 NIL) (I.PUTBASEPTR DTD 6 NIL))) (T (*) (ERROR "ILLEGAL DATA TYPE" NAME))))) (if (
NOT SIZE) then (*) else (COND ((EQ I.MaxTypeNumber 255) (LISPERROR "DATA TYPES FULL" NAME))) (PROGN (
SETQ I.NTYPX (SETQ I.MaxTypeNumber (PLUS I.MaxTypeNumber 1))) (SETQ DTD (I.ADDBASE (I.VAG2 6 4096) (
LLSH I.NTYPX 4))) (COND ((IGREATERP (IPLUS (LOGAND (I.LOLOC DTD) 255) 16) (CONSTANT (SUB1 256))) (*) (
MKI.NEWPAGE (I.ADDBASE DTD 16) T))) (I.PUTBASE DTD 0 (I.ATOMNUMBER NAME)) (COND ((NEQ SIZE 0) (
I.PUTBASE DTD 1 SIZE) (I.PUTBASEPTR DTD 4 (I.\COPY DESCRIPTORS)) (I.PUTBASEPTR DTD 6 (I.\COPY SPECS)) 
(I.PUTBASEPTR DTD 8 PTRFIELDS) (I.\GCTYPE I.NTYPX DTD)))) (RETURN I.NTYPX)))))

(I.\TYPENUMBERFROMNAME

(LAMBDA (TYPE) (*) (AND TYPE (NEQ TYPE (QUOTE **DEALLOC**)) (for I from 1 to I.MaxTypeNumber do (COND 
((EQ (I.ATOMNUMBER TYPE) (I.GETBASE (I.ADDBASE (I.VAG2 6 4096) (LLSH I 4)) 0)) (RETURN I)))))))

(I.\CREATECELL

(LAMBDA (TYP) (*) (if (AND (NEQ 1 0) (EQ TYP 5)) then (HELP "CREATECELL \LISTP")) (PROGN (PROG ((DTD (
I.ADDBASE (I.VAG2 6 4096) (LLSH TYP 4))) NEWCELL) (SETQ NEWCELL (OR (I.GETBASEPTR DTD 2) (I.\GCTYPE 
TYP DTD))) (*) (PROG NIL (*) (I.PUTBASEPTR DTD 2 (OR (I.GETBASEPTR NEWCELL 0) (PROGN (I.PUTBASEPTR DTD
 2 NIL) (RETURN (I.\GCTYPE TYP DTD))))) (*)) (*) (PROG ((CNT (I.GETBASE DTD 1)) (PTR NEWCELL)) (*) (
PROGN (I.PUTBASE NEWCELL (SETQ CNT (PLUS CNT -1)) 0) (I.\BLT NEWCELL (I.ADDBASE NEWCELL 1) CNT))) (
PROGN NEWCELL) (RETURN NEWCELL)))))

(I.\NEW2PAGE

(LAMBDA (BASE) (*) (MKI.NEWPAGE (I.ADDBASE (MKI.NEWPAGE BASE) 256))))
)
(DEFINEQ

(I.CREATEMDSTYPETABLE

(LAMBDA NIL (*) (*) (I.CREATEPAGES (I.VAG2 6 32768) 128 NIL T) (PROG (VP) (*) (SETQ VP 0) (FRPTQ (LLSH
 128 8) (I.PUTBASE (I.VAG2 6 32768) VP 32768) (SETQ VP (PLUS VP 1))) (*) (for SEGMENT in (LIST 14 15) 
do (for PAGE from 0 to (SUB1 256) by (LRSH 512 8) do (I.\MAKEMDSENTRY (LOGOR PAGE (LLSH SEGMENT 8)) (
LOGOR 32768 8192 4096 2048 1))))) (I.CREATEPAGES (I.VAG2 6 2560) (LRSH 512 8) NIL T) (I.\MAKEMDSENTRY 
(IPLUS (LLSH (I.HILOC (I.VAG2 6 2560)) 8) (LRSH (I.LOLOC (I.VAG2 6 2560)) 8)) (LOGOR 32768 8192 4096 
2048 2))))

(I.INITDATATYPES

(LAMBDA NIL (*) (*) (SETQ I.MaxTypeNumber 0) (I.CREATEPAGES (I.VAG2 6 4096) 1 NIL T) (for D in DTDECLS
 bind DTD as old I.MaxTypeNumber from 1 do (SETQ DTD (I.ADDBASE (I.VAG2 6 4096) (LLSH I.MaxTypeNumber 
4))) (I.PUTBASE DTD 14 (LOGOR I.MaxTypeNumber (if (FMEMB (CAR D) (QUOTE (SMALLP FIXP FLOATP))) then 
4096 else 0) (if (FMEMB (CAR D) (QUOTE (SMALLP FIXP FLOATP LITATOM))) then 2048 else 0) (if (FMEMB (
CAR D) (QUOTE (SMALLP FIXP))) then 8192 else 0) (if (NOT (CADR D)) then (*) 32768 else 0))) (COND ((
AND (CAR D) (CADR D)) (I.PUTBASE DTD 1 (CADR D)) (I.\GCTYPE I.MaxTypeNumber DTD)))) (COND ((NEQ 1 0) (
SETQ I.LISTPDTD (I.ADDBASE (I.VAG2 6 4096) (LLSH 5 4))))) NIL))

(I.INITDATATYPENAMES

(LAMBDA NIL (*) (*) (for D in DTDECLS as I.NTYPX from 1 do (*) (PROG ((DTD (I.ADDBASE (I.VAG2 6 4096) 
(LLSH I.NTYPX 4)))) (I.PUTBASE DTD 0 (I.ATOMNUMBER (CAR D))) (I.PUTBASEPTR DTD 8 (I.\COPY (CDDR D)))))
 (SETQ I.MaxSysTypeNum I.MaxTypeNumber)))
)

(RPAQQ DTDECLS
 ((SMALLP) (FIXP 2) (FLOATP 2) (LITATOM) (LISTP 4 0 2) (ARRAYP 4 0) (STRINGP 4 0) (
STACKP 2) (NIL 4 0) (VMEMPAGEP 256)))
(DEFINEQ

(I.FSETVAL

(LAMBDA (ATM VAL) (*) (*) (I.PUTBASEPTR (I.\ATOMCELL ATM 12) 0 VAL)))

(I.SETPROPLIST

(LAMBDA (ATM LST) (*) (I.PUTBASEPTR (I.\ATOMCELL ATM 2) 0 LST)))

(I.PUTDEFN

(LAMBDA (FN CA SIZE) (*) (*) (PROG ((DCELL (I.\ATOMCELL FN 10)) (BLOCKINFO (PROGN (*) (I.FILECODEBLOCK
 (LRSH (IPLUS SIZE 3) 2) (IPLUS (LOGOR (LLSH (\BYTELT CA 12) 8) (\BYTELT CA (ADD1 12))) (PROGN 8))))) 
(BASE (I.FILEARRAYBASE))) (I.PUTBASEPTR DCELL 0 BASE) (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE 
$$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 53247) (LLSH (LOGAND (LOGAND (LRSH (\BYTELT CA 8) 4
) 3) 3) 12)))) DCELL) 12) 3) (NEQ (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (
LOGAND (I.GETBASE $$PUTBITS 0) 49151) (LLSH (LOGAND (COND ((EQ (LOGOR (LLSH (\BYTELT CA 12) 8) (
\BYTELT CA (ADD1 12))) 0) 1) (T 0)) 1) 14)))) DCELL) 14) 1) 0) (NEQ (LRSH ((LAMBDA ($$PUTBITS) (
I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 32767) (LLSH (COND (T 1) (T 0)) 15)))) 
DCELL) 15) 0) (NEQ (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE
 $$PUTBITS 0) 63487) (LLSH (LOGAND (COND (NIL 1) (T 0)) 1) 11)))) DCELL) 11) 1) 0) (COND ((FMEMB FN 
LOCKEDFNS) (I.\LOCKCELL DCELL 1) (I.\LOCKCELL BASE (LRSH (IPLUS (IPLUS (LOGAND (I.LOLOC BASE) 255) (
LRSH (IPLUS SIZE 1) 1)) 255) 8)))) (COND ((EQ FN (FUNCTION \RESETSTACK)) (*) (SETQ RESETPTR (
I.FILEARRAYBASE)) (SETQ RESETPC (LOGOR (LLSH (\BYTELT CA 6) 8) (\BYTELT CA (ADD1 6)))))) (AOUT CA 0 
SIZE OUTX (QUOTE CODE)) (BOUTZEROS (IDIFFERENCE (SUB1 4) (IMOD (SUB1 SIZE) 4))) (I.FILEBLOCKTRAILER 
BLOCKINFO))))

(I.\BLT

(LAMBDA (DBASE SBASE NWORDS) (*) (*) (PROG ((NN (CONSTANT (EXPT 2 14)))) (RETURN (if (GREATERP NWORDS 
NN) then (*) (I.\BLT (I.ADDBASE DBASE NN) (I.ADDBASE SBASE NN) (DIFFERENCE NWORDS NN)) (I.\BLT DBASE 
SBASE NN) else (for I from (SUB1 NWORDS) by -1 to 0 do (I.PUTBASE DBASE I (I.GETBASE SBASE I))) DBASE)
))))

(I.\ATOMCELL

(LAMBDA (X N) (*) (if (EQ (I.HILOC X) 0) then (LET ((LOC (SELECTC N (10 (I.ATOMNUMBER X)) (12 (
I.ATOMNUMBER X)) (2 (I.ATOMNUMBER X)) (I.ATOMNUMBER X)))) (I.ADDBASE (I.VAG2 N LOC) LOC)) else (
LISPERROR "ARG NOT LITATOM" X))))
)
(DEFINEQ

(I.\MKATOM

(LAMBDA (BASE OFFST LEN) (*) (PROG (HASH HASHENT ATM# PNBASE FIRSTCHAR REPROBE) (COND ((EQ LEN 0) (*) 
(SETQ HASH 0) (SETQ FIRSTCHAR 255) (GO LP))) (SETQ FIRSTCHAR (I.\GETBASEBYTE BASE OFFST)) (COND ((AND 
(EQ LEN 1) I.OneCharAtomBase) (*) (RETURN (COND ((IGREATERP FIRSTCHAR (CHARCODE "9")) (I.ADDBASE 
I.OneCharAtomBase (IDIFFERENCE FIRSTCHAR 10))) ((IGEQ FIRSTCHAR (CHARCODE "0")) (*) (IDIFFERENCE 
FIRSTCHAR (CHARCODE "0"))) (T (I.ADDBASE I.OneCharAtomBase FIRSTCHAR))))) ((AND (ILEQ FIRSTCHAR (
CHARCODE "9")) (SETQ HASHENT (NILL BASE OFFST LEN))) (*) (RETURN HASHENT))) (*) (PROGN (*) (SETQ HASH 
(LLSH FIRSTCHAR 8)) (for BYTE# from 1 while (NEQ BYTE# LEN) do (SETQ HASH (IPLUS16 (IPLUS16 (SETQ HASH
 (IPLUS16 HASH (LLSH (LOGAND HASH 4095) 2))) (LLSH (LOGAND HASH 255) 8)) (I.\GETBASEBYTE BASE (IPLUS 
OFFST BYTE#)))))) (*) LP (COND ((NEQ 0 (SETQ HASHENT (I.GETBASE (I.VAG2 7 0) HASH))) (*) (COND ((AND (
EQ (LRSH (I.GETBASE (SETQ PNBASE (I.GETBASEPTR (I.\ATOMCELL (PROGN (\INDEXATOMPNAME (SETQ ATM# (SUB1 
HASHENT)))) 8) 0)) 0) 8) LEN) (for N from LEN by -1 until (EQ N 0) as B1 from 1 as B2 from OFFST 
always (EQ (I.\GETBASEBYTE PNBASE B1) (I.\GETBASEBYTE BASE B2)))) (RETURN (I.ADDBASE (I.VAG2 0 0) ATM#
))) (T (*) (SETQ HASH (IPLUS16 HASH (OR REPROBE (SETQ REPROBE (LOGAND 63 (LOGOR 1 (LOGXOR FIRSTCHAR 
HASH))))))) (GO LP))))) (*) (RETURN (I.\MKATOM.NEW BASE OFFST LEN HASH)))))

(I.\MKATOM.NEW

(LAMBDA (BASE OFFST LEN HASH) (*) (DECLARE (GLOBALVARS \STORAGEFULL \INTERRUPTSTATE)) (PROG (ATM PB 
CPP PNBASE) (if I.PNAMES.IN.BLOCKS? then (SETQ PNBASE (I.\ALLOCBLOCK (LRSH (IPLUS (ADD1 LEN) 3) 2) 0))
) (RETURN (PROGN (if (EVENP (SETQ ATM I.AtomFrLst) 512) then (*) (PROG ((PN (LRSH ATM 8))) (COND ((
IGEQ PN (IDIFFERENCE 255 1)) (NILL))) (I.\MAKEMDSENTRY PN (LOGOR 32768 2048 4)) (*) (I.\INITATOMPAGE 
PN) (*)) elseif (EQ ATM 65535) then (*) (\MP.ERROR 22 "No more atoms left")) (if (NOT 
I.PNAMES.IN.BLOCKS?) then (SETQ PB I.NxtPnByte) (if (ODDP PB) then (SHOULDNT 
"ODDP value in \NxtPnByte ")) (SETQ CPP I.CurPnPage) (*) (if (ILESSP (IDIFFERENCE 512 PB) (ADD1 LEN)) 
then (*) (I.\GCPNAMES)) (SETQ PNBASE (I.VAG2 (IPLUS 58 (LRSH CPP 8)) (IPLUS (LLSH (LOGAND CPP 255) 8) 
(LRSH PB 1))))) (I.PUTBASEPTR (I.\ATOMCELL (PROGN (\INDEXATOMPNAME ATM)) 8) 0 PNBASE) (*) (
I.\MOVEBYTES BASE OFFST PNBASE 1 LEN) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND
 (I.GETBASE $$PUTBITS 0) 255) (LLSH LEN 8)))) PNBASE) 8) (I.PUTBASE (I.VAG2 7 0) HASH (SETQ 
I.AtomFrLst (ADD1 ATM))) (*) (if I.PNAMES.IN.BLOCKS? then (*) (PROGN PNBASE) else (*) (SETQ 
I.NxtPnByte (IMOD (IPLUS PB (LOGAND (IPLUS LEN 2) 65534)) 512)) (if (EQ 0 I.NxtPnByte) then (
I.\GCPNAMES))) (\INDEXATOMPNAME ATM))))))

(I.\INITATOMPAGE

(LAMBDA (PN) (*) (PROG ((OFFSET (LLSH PN 8)) VALBASE) (*) (*) (I.\NEW4PAGE (I.ADDBASE (I.ADDBASE (
I.VAG2 8 0) OFFSET) OFFSET)) (I.\NEW4PAGE (I.ADDBASE (I.ADDBASE (I.VAG2 10 0) OFFSET) OFFSET)) (
I.\NEW4PAGE (I.ADDBASE (I.ADDBASE (I.VAG2 2 0) OFFSET) OFFSET)) (I.\NEW4PAGE (SETQ VALBASE (I.ADDBASE 
(I.ADDBASE (I.VAG2 12 0) OFFSET) OFFSET))) (FRPTQ (ITIMES 128 4) (*) (I.PUTBASEPTR VALBASE 0 (I.\COPY 
(QUOTE NOBIND))) (SETQ VALBASE (I.ADDBASE VALBASE 2))))))

(I.\GCPNAMES

(LAMBDA NIL (*) (PROG ((VP (ADD1 I.CurPnPage))) (COND ((IGREATERP VP 1535) (\MP.ERROR 23 
"Out of atom p-name space")) (T (MKI.NEWPAGE ((LAMBDA ($$1) (I.VAG2 (LRSH (SETQ $$1 (IPLUS VP (LLSH 58
 8))) 8) (LLSH (LOGAND $$1 255) 8))) NIL)) (SETQ I.NxtPnByte 0) (SETQ I.CurPnPage VP))))))

(I.\MOVEBYTES

(LAMBDA (SBASE SBYTE DBASE DBYTE NBYTES) (*) (*) (COND ((IGREATERP NBYTES 0) (PROG ((SB (I.ADDBASE 
SBASE (LRSH SBYTE 1))) (DB (I.ADDBASE DBASE (LRSH DBYTE 1))) SBN DBN NWORDS) (COND ((EQ (SETQ SBN (
IMOD SBYTE 2)) (SETQ DBN (IMOD DBYTE 2))) (*) (COND ((EQ SBN 1) (I.\PUTBASEBYTE DB 1 (I.\GETBASEBYTE 
SB 1)) (SETQ DB (I.ADDBASE DB 1)) (SETQ SB (I.ADDBASE SB 1)) (SETQ NBYTES (PLUS NBYTES -1)))) (I.\BLT 
DB SB (SETQ NWORDS (LRSH NBYTES 1))) (COND ((EQ (IMOD NBYTES 2) 1) (I.\PUTBASEBYTE (I.ADDBASE DB 
NWORDS) 0 (I.\GETBASEBYTE (I.ADDBASE SB NWORDS) 0))))) (T (FRPTQ NBYTES (I.\PUTBASEBYTE DB (PROG1 DBN 
(SETQ DBN (PLUS DBN 1))) (I.\GETBASEBYTE SB (PROG1 SBN (SETQ SBN (PLUS SBN 1)))))))))))))
)
(DEFINEQ

(I.COPYATOM

(LAMBDA (X) (*) (*) (PROG ((N (NCHARS X)) (BASE (I.GETBASEPTR I.SCRATCHSTRING 0)) (OFFST (I.GETBASE 
I.SCRATCHSTRING 3))) (for I from 1 to N do (I.\PUTBASEBYTE BASE (IPLUS OFFST I -1) (NTHCHARCODE X I)))
 (RETURN (I.ATOMNUMBER (I.\MKATOM BASE OFFST N))))))

(I.INITATOMS

(LAMBDA NIL (*) (*) (*) (PROG (BASE OFFST) (I.CREATEPAGES (I.VAG2 58 0) 1) (I.CREATEPAGES (I.VAG2 7 0)
 256) (SETQ I.SCRATCHSTRING (I.ALLOCSTRING 255)) (SETQ BASE (I.GETBASEPTR I.SCRATCHSTRING 0)) (SETQ 
OFFST (I.GETBASE I.SCRATCHSTRING 3)) (I.COPYATOM NIL) (I.COPYATOM (QUOTE NOBIND)) (for C from 0 to 255
 when (OR (ILESSP C 48) (IGEQ C 58)) do (I.\PUTBASEBYTE BASE OFFST C) (I.\MKATOM BASE OFFST 1)) (SETQ 
I.OneCharAtomBase (I.ADDBASE (I.VAG2 0 0) 2)) (I.COPYATOM (FUNCTION \EVALFORM)) (*) (I.COPYATOM (
FUNCTION \GC.HANDLEOVERFLOW)) (*) (I.COPYATOM (FUNCTION \DTEST.UFN)) (*) (I.COPYATOM (FUNCTION 
\OVERFLOWMAKENUMBER)) (*) (I.COPYATOM (FUNCTION \MAKENUMBER)) (*) (I.COPYATOM (FUNCTION \SETGLOBAL.UFN
)) (*) (I.COPYATOM (FUNCTION \SETFVAR.UFN)) (*) (I.COPYATOM (FUNCTION \GCMAPTABLE)) (*) (I.COPYATOM (
FUNCTION \INTERPRETER)) (*) (OR (EQ (I.ATOMNUMBER (FUNCTION \INTERPRETER)) 256) (HELP (FUNCTION 
\INTERPRETER) " not atom 400Q")))))
)
(DEFINEQ

(I.MAKEINITFIRST

(LAMBDA NIL (*) (I.CREATEMDSTYPETABLE) (I.INITDATATYPES) (I.PREINITARRAYS) (I.INITATOMS) (
I.INITDATATYPENAMES) (I.INITUFNTABLE) (I.INITGC) (MKI.NEWPAGE (I.VAG2 6 0) NIL T)))

(I.\COPY

(LAMBDA (X) (*) (*) (SELECTQ (TYPENAME X) (LITATOM (MKI.ATOM X)) (LISTP (PROG ((R (REVERSE X)) (V (
I.\COPY (CDR (LAST X))))) LP (COND ((LISTP R) (SETQ V (I.\CONS.UFN (I.\COPY (CAR R)) V)) (SETQ R (CDR 
R)) (GO LP))) (RETURN V))) ((FIXP SMALLP) (PROG (V) (COND ((IGREATERP 0 X) (*) (COND ((IGREATERP X 
-65537) (*) (RETURN (I.ADDBASE (I.VAG2 15 0) (LOGAND X 65535)))))) ((ILESSP X 65536) (*) (RETURN (
I.ADDBASE (I.VAG2 14 0) X)))) (*) (SETQ V (I.\CREATECELL 2)) (I.PUTBASE V 0 (LOGOR (COND ((IGREATERP 0
 X) 32768) (T 0)) (LOGAND (LRSH X 16) 32767))) (I.PUTBASE V 1 (LOGAND X 65535)) (RETURN V))) (STRINGP 
(I.COPYSTRING X)) (FLOATP (PROG ((VAL (I.\CREATECELL 3))) (SELECTQ (SYSTEMTYPE) ((ALTO D) (I.PUTBASE 
VAL 0 (\GETBASE X 0)) (I.PUTBASE VAL 1 (\GETBASE X 1))) (MKI.IEEE X VAL)) (RETURN VAL))) (ERROR X (
QUOTE (can't be copied to remote file))))))

(I.MAKEINITLAST

(LAMBDA (VERSIONS) (*) (I.SETUPSTACK T) (I.MAKEINITBFS) (PROGN (*) (SELECTQ (SYSTEMTYPE) ((D ALTO) (
MAPHASH MKI.PLHA (FUNCTION (LAMBDA (P A) (I.SETPROPLIST A (I.\COPY P))))) (MAPHASH MKI.TVHA (FUNCTION 
(LAMBDA (V A) (I.FSETVAL A (I.\COPY (CDR V))))))) (PROG (AL GAG) (*) (PROGN (MINFS (IMAX (MINFS) (
ITIMES 2 (ARRAYSIZE (CAR MKI.PLHA))) (ARRAYSIZE (CAR MKI.TVHA)))) (RECLAIM) (SETQ GAG (GCGAG 
"[***** GARBAGE COLLECTION - ERROR ******]")) (MAPHASH MKI.PLHA (FUNCTION (LAMBDA (P A) (push AL (CONS
 A P))))) (SETQ GAG (GCGAG GAG))) (MAPC AL (FUNCTION (LAMBDA (X) (I.SETPROPLIST (CAR X) (I.\COPY (CDR 
X)))))) (PROGN (SETQ AL) (RECLAIM) (SETQ GAG (GCGAG GAG)) (MAPHASH MKI.TVHA (FUNCTION (LAMBDA (V A) (
push AL (RPLACA V A))))) (GCGAG GAG)) (MAPC AL (FUNCTION (LAMBDA (X) (I.FSETVAL (CAR X) (I.\COPY (CDR 
X)))))))) (*)) (PROG ((AFL (I.FILEARRAYBASE))) (*) (BOUTZEROS (IDIFFERENCE (TIMES 2 512) (LLSH (IMOD (
I.LOLOC AFL) (TIMES 2 256)) 1))) (SETQ MKI.CODELASTPAGE ((LAMBDA (PTR) (DECLARE (LOCALVARS PTR)) (
IPLUS (LLSH (I.HILOC PTR) 8) (LRSH (I.LOLOC PTR) 8))) (I.FILEARRAYBASE))) (*) (I.POSTINITARRAYS AFL (
IPLUS 4864 MKI.CODESTARTOFFSET) MKI.CODELASTPAGE)) (MAPC (APPEND INITVALUES INITPTRS) (FUNCTION (
LAMBDA (X) (*) (I.ATOMNUMBER (CAR X))))) (for X in INITVALUES as A in MKI.VALUES do (SETQ A (EVALV A))
 (I.FSETVAL (CAR X) (COND ((OR (EQ A T) (EQ A NIL) (AND (FIXP A) (IGEQ A -65536) (ILEQ A 65535))) (
I.\COPY A)) (T (SHOULDNT))))) (for X in INITPTRS as A in MKI.PTRS do (I.FSETVAL (CAR X) (EVALV A))) (
for X in LOCKEDVARS do (OR (GETHASH X MKI.ATOMARRAY) (printout T "***Note: Locked var " X 
" does not exist" T)) (I.\LOCKVAR X)) (I.SETUPPAGEMAP) (I.DUMPINITPAGES (IPLUS 4864 
MKI.CODESTARTOFFSET) MKI.CODELASTPAGE VERSIONS)))
)
(DEFINEQ

(I.\CONS.UFN

(LAMBDA (X Y) (*) (COND ((ZEROP 1) (HELP) (PROG ((CELL (I.\CREATECELL 5))) (I.PUTBASEPTR CELL 0 X) (
I.PUTBASEPTR CELL 2 Y) (RETURN CELL)))) (PROGN (PROGN X) (PROGN Y) (*) (PROGN 1) (PROG (CNS.PAGE) (
SETQ CNS.PAGE (COND ((AND (EQ (I.NTYPX Y) 5) (IGREATERP (LRSH (I.GETBASE (SETQ CNS.PAGE (I.VAG2 (
I.HILOC Y) (LOGAND (I.LOLOC Y) 65280))) 0) 8) 0)) (*) ((LAMBDA (PAGE A D) (DECLARE (LOCALVARS PAGE A D
)) (PROG ((.MK.NEWCELL (I.ADDBASE PAGE (LOGAND (I.GETBASE PAGE 0) 255)))) (*) (LOGAND ((LAMBDA (
$$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 65280) (LOGAND (LRSH (
I.GETBASE .MK.NEWCELL 0) 8) 255)))) PAGE) 255) (*) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (
LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 255) (LLSH (PLUS (PROGN (LRSH (I.GETBASE PAGE 0) 8)) -1) 8)))) 
PAGE) 8) (I.PUTBASEPTR .MK.NEWCELL 0 A) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (
LOGAND (I.GETBASE $$PUTBITS 0) 255) (LLSH D 8)))) .MK.NEWCELL) 8) (RETURN .MK.NEWCELL))) CNS.PAGE X (
IPLUS 128 (LRSH (LOGAND (I.LOLOC Y) 255) 1)))) (T ((LAMBDA (PAGE A D) (DECLARE (LOCALVARS PAGE A D)) (
PROG ((.MK.NEWCELL (I.ADDBASE PAGE (LOGAND (I.GETBASE PAGE 0) 255)))) (*) (LOGAND ((LAMBDA ($$PUTBITS)
 (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 65280) (LOGAND (LRSH (I.GETBASE 
.MK.NEWCELL 0) 8) 255)))) PAGE) 255) (*) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (
LOGAND (I.GETBASE $$PUTBITS 0) 255) (LLSH (PLUS (PROGN (LRSH (I.GETBASE PAGE 0) 8)) -1) 8)))) PAGE) 8)
 (I.PUTBASEPTR .MK.NEWCELL 0 A) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (
I.GETBASE $$PUTBITS 0) 255) (LLSH D 8)))) .MK.NEWCELL) 8) (RETURN .MK.NEWCELL))) (SETQ CNS.PAGE (
I.\NEXTCONSPAGE)) X (COND ((NULL Y) 128) (T (IPLUS 0 (LRSH (LOGAND (I.LOLOC (PROGN (PROGN (PROGN (PROG
 ((.MK.NEWCELL (I.ADDBASE CNS.PAGE (LOGAND (I.GETBASE CNS.PAGE 0) 255)))) (*) (LOGAND ((LAMBDA (
$$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 65280) (LOGAND (LRSH (
I.GETBASE .MK.NEWCELL 0) 8) 255)))) CNS.PAGE) 255) (*) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS
 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 255) (LLSH (PLUS (PROGN (LRSH (I.GETBASE CNS.PAGE 0) 8)) -1)
 8)))) CNS.PAGE) 8) (I.PUTBASEPTR .MK.NEWCELL 0 Y) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (
LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 255) (LLSH 0 8)))) .MK.NEWCELL) 8) (RETURN .MK.NEWCELL)))))) 255
) 1)))))))) (PROGN CNS.PAGE) (RETURN CNS.PAGE)))))

(I.\INITCONSPAGE

(LAMBDA (BASE LINK) (*) (COND ((ZEROP 1) (HELP)) (T (PROG ((J (LOGAND ((LAMBDA ($$PUTBITS) (I.PUTBASE 
$$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 65280) (LOGAND 254 255)))) BASE) 255)) CELL) LP (
COND ((NEQ J 0) (SETQ CELL (I.ADDBASE BASE J)) (I.PUTBASEPTR CELL 0 NIL) (LRSH ((LAMBDA ($$PUTBITS) (
I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 255) (LLSH (SETQ J (IDIFFERENCE J 2)) 8))
)) CELL) 8) (GO LP))) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE 
$$PUTBITS 0) 255) (LLSH 127 8)))) BASE) 8) (*) (I.PUTBASE BASE 1 (IPLUS (LLSH (I.HILOC LINK) 8) (LRSH 
(I.LOLOC LINK) 8))) (RETURN BASE))))))

(I.\NEXTCONSPAGE

(LAMBDA NIL (*) (*) (PROG ((N (I.GETBASE I.LISTPDTD 13)) PG) LP (COND ((EQ N 0) (SETQ PG (
I.\ALLOCMDSPAGE (I.GETBASE I.LISTPDTD 14))) (I.\INITCONSPAGE PG (I.\INITCONSPAGE (I.ADDBASE PG 256) 
NIL)) (I.PUTBASE I.LISTPDTD 13 (IPLUS (LLSH (I.HILOC PG) 8) (LRSH (I.LOLOC PG) 8)))) (T (SETQ PG ((
LAMBDA ($$1) (I.VAG2 (LRSH (SETQ $$1 N) 8) (LLSH (LOGAND $$1 255) 8))) NIL)))) (COND ((IGREATERP (LRSH
 (I.GETBASE PG 0) 8) 1) (RETURN PG))) (I.PUTBASE I.LISTPDTD 13 (SETQ N (I.GETBASE PG 1))) (I.PUTBASE 
PG 1 65535) (*) (GO LP))))
)
(DEFINEQ

(I.\GETBASEBYTE

(LAMBDA (PTR N) (*) (*) (COND ((EVENP N) (LRSH (PROGN (I.GETBASE PTR (LRSH N 1))) 8)) (T (LOGAND (
PROGN (I.GETBASE PTR (LRSH N 1))) 255)))))

(I.\PUTBASEBYTE

(LAMBDA (PTR DISP BYTE) (*) (*) (SETQ BYTE (PROG1 BYTE)) (I.PUTBASE PTR (LRSH (SETQ DISP (\DTEST DISP 
(QUOTE SMALLP))) 1) (COND ((EVENP DISP 2) ((LAMBDA ($$1) (IPLUS (LLSH BYTE 8) (LOGAND $$1 255))) (
I.GETBASE PTR (LRSH DISP 1)))) (T ((LAMBDA ($$1) (IPLUS (LLSH (LRSH $$1 8) 8) BYTE)) (I.GETBASE PTR (
LRSH DISP 1)))))) BYTE))

(I.CREATEPAGES

(LAMBDA (VA N BLANKFLG LOCKFLG) (*) (*) (for I from 0 to (SUB1 N) do (MKI.NEWPAGE (I.ADDBASE VA (LLSH 
I 8)) NIL LOCKFLG BLANKFLG)) VA))

(I.\NEW4PAGE

(LAMBDA (PTR) (*) (MKI.NEWPAGE (I.ADDBASE (MKI.NEWPAGE (I.ADDBASE (MKI.NEWPAGE (I.ADDBASE (MKI.NEWPAGE
 PTR) 256)) 256)) 256))))
)
(DEFINEQ

(I.ALLOCSTRING

(LAMBDA (N INITCHAR OLD FATFLG) (*) (SETQ N (FIX N)) (*) (COND ((OR (ILESSP N 0) (IGREATERP N 65535)) 
(LISPERROR "ILLEGAL ARG" N))) (COND ((NULL INITCHAR) (SETQ INITCHAR 0)) ((\CHARCODEP INITCHAR)) (T (
SETQ INITCHAR (CHCON1 INITCHAR)))) (PROG (B (FATP (OR FATFLG (IGREATERP INITCHAR 255)))) (*) (SETQ B (
I.\ALLOCBLOCK (COND (FATP (LRSH (IPLUS N 1) 1)) (T (LRSH (IPLUS N 3) 2))))) (COND ((STRINGP OLD) (
PROGN ((LAMBDA (DATUMA0009) (DECLARE (LOCALVARS DATUMA0009)) (PROG1 DATUMA0009 (LRSH ((LAMBDA (
$$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 32767) (LLSH 1 15)))) 
DATUMA0009) 15))) ((LAMBDA (DATUMA0016) (DECLARE (LOCALVARS DATUMA0016)) (PROG1 DATUMA0016 (LOGAND (
LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 49151) (LLSH (
LOGAND 0 1) 14)))) DATUMA0016) 14) 1))) ((LAMBDA (DATUMA0022) (DECLARE (LOCALVARS DATUMA0022)) (PROG1 
DATUMA0022 (NEQ (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE 
$$PUTBITS 0) 57343) (LLSH (LOGAND (COND (NIL 1) (T 0)) 1) 13)))) DATUMA0022) 13) 1) 0))) ((LAMBDA (
DATUMA0027) (DECLARE (LOCALVARS DATUMA0027)) (PROG1 DATUMA0027 (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (
I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 49151) (LLSH (LOGAND 0 1) 14)))) 
DATUMA0027) 14) 1))) ((LAMBDA (DATUMA0031) (DECLARE (LOCALVARS DATUMA0031)) (PROG1 DATUMA0031 (
I.PUTBASE DATUMA0031 3 0))) ((LAMBDA (DATUMA0034 NEWVALUEA0033) (DECLARE (LOCALVARS DATUMA0034 
NEWVALUEA0033)) (PROG1 DATUMA0034 (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (
LOGAND (I.GETBASE $$PUTBITS 0) 61695) (LLSH (LOGAND NEWVALUEA0033 15) 8)))) DATUMA0034) 8) 15))) ((
LAMBDA (DATUMA0035) (DECLARE (LOCALVARS DATUMA0035)) (PROG1 DATUMA0035 (I.PUTBASEPTR DATUMA0035 0 B)))
 (PROG1 OLD (I.PUTBASE (\DTEST OLD (QUOTE STRINGP)) 2 N))) (COND (FATP 1) (T 0)))))))))) (T (SETQ OLD 
((LAMBDA (DATUMA0040) (DECLARE (LOCALVARS DATUMA0040)) (PROG1 DATUMA0040 (LRSH ((LAMBDA ($$PUTBITS) (
I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 32767) (LLSH 1 15)))) DATUMA0040) 15))) (
(LAMBDA (DATUMA0044 NEWVALUEA0043) (DECLARE (LOCALVARS DATUMA0044 NEWVALUEA0043)) (PROG1 DATUMA0044 (
LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 61695)
 (LLSH (LOGAND NEWVALUEA0043 15) 8)))) DATUMA0044) 8) 15))) ((LAMBDA (DATUMA0046) (DECLARE (LOCALVARS 
DATUMA0046)) (PROG1 DATUMA0046 (I.PUTBASEPTR DATUMA0046 0 B))) ((LAMBDA (DATUMA0047) (DECLARE (
LOCALVARS DATUMA0047)) (PROG1 DATUMA0047 (I.PUTBASE DATUMA0047 2 N))) (I.\CREATECELL 7))) (COND (FATP 
1) (T 0))))))) (COND ((NEQ 0 INITCHAR) (if FATP then (for I (OBASE ← (I.GETBASEPTR OLD 0)) from 0 to (
SUB1 N) do (\PUTBASEFAT OBASE I INITCHAR)) else (for I (OBASE ← (I.GETBASEPTR OLD 0)) from 0 to (SUB1 
N) do (\PUTBASETHIN OBASE I INITCHAR)))))) (*) OLD))

(I.COPYSTRING

(LAMBDA (X) (*) (PROG ((N (NCHARS X)) STR BASE OFFST) (SETQ STR (I.ALLOCSTRING N)) (SETQ BASE (
I.GETBASEPTR STR 0)) (SETQ OFFST (I.GETBASE STR 3)) (for I from 1 to N do (I.\PUTBASEBYTE BASE (IPLUS 
OFFST I -1) (IPLUS (NTHCHARCODE X I)))) (RETURN STR))))
)

(ADDTOVAR EXPANDMACROFNS
 \PUTBASETHIN \PUTBASEFAT \CHARCODEP)
(DEFINEQ

(I.\#BLOCKDATACELLS

(LAMBDA (DATAWORD) (*) (*) (PROG ((TYPENO (I.NTYPX DATAWORD))) (RETURN (if (EQ 0 TYPENO) then (if (AND
 (EQ 0 (I.NTYPX DATAWORD)) (IGEQ (I.HILOC DATAWORD) 19)) then (IDIFFERENCE (I.GETBASE (I.ADDBASE 
DATAWORD (IMINUS 2)) 1) 2) else (\ILLEGAL.ARG DATAWORD)) else (OR (AND (OR (PROGN NIL) (NEQ 0 (LOGAND 
(LRSH (I.GETBASE (I.ADDBASE (I.VAG2 6 4096) (LLSH TYPENO 4)) 4) 10) 1))) (LRSH (I.GETBASE (I.ADDBASE (
I.VAG2 6 4096) (LLSH TYPENO 4)) 1) 1)) (\ILLEGAL.ARG DATAWORD)))))))

(I.\PREFIXALIGNMENT?

(LAMBDA (ARLEN INITONPAGE ALIGN GCTYPE BASE) (*) (*) (PROG ((DAT (LRSH (I.LOLOC (PROGN (PROGN (
I.ADDBASE BASE 2)))) 1)) (ADJUSTMENT 0) FUDGE) (*) LP (COND ((AND ALIGN (NEQ (SETQ FUDGE (IREMAINDER 
DAT ALIGN)) 0)) (*) (SETQ ADJUSTMENT (PLUS ADJUSTMENT (SETQ FUDGE (IDIFFERENCE ALIGN FUDGE)))) (SETQ 
DAT (PLUS DAT FUDGE)))) (COND ((AND INITONPAGE (NEQ (LOGAND DAT (CONSTANT (LOGXOR (SUB1 128) -1))) (
LOGAND (IPLUS DAT INITONPAGE -1) (CONSTANT (LOGXOR (SUB1 128) -1))))) (*) (SETQ ADJUSTMENT (PLUS 
ADJUSTMENT (SETQ FUDGE (IDIFFERENCE 128 (IMOD DAT 128))))) (SETQ DAT (PLUS DAT FUDGE)) (*))) (COND ((
AND (EQ GCTYPE 2) (IGREATERP (IDIFFERENCE ARLEN 2) (SETQ FUDGE (IDIFFERENCE 32768 (SETQ DAT (IMOD DAT 
32768)))))) (*) (SETQ ADJUSTMENT (PLUS ADJUSTMENT FUDGE)) (SETQ DAT (PLUS DAT FUDGE)) (*))) (*) (
RETURN ADJUSTMENT))))

(I.\ALLOCBLOCK

(LAMBDA (NCELLS GCTYPE INITONPAGE ALIGN) (*) (*) (DECLARE (GLOBALVARS I.ArrayFrLst)) (COND ((ILESSP 
NCELLS 2) (COND ((ILESSP NCELLS 0) (\ILLEGAL.ARG NCELLS))) (SETQ NCELLS 2)) ((IGREATERP NCELLS 65533) 
(\LISPERROR NCELLS "ARRAY STORAGE BLOCK TOO LARGE"))) (*) (SELECTQ GCTYPE (NIL (SETQ GCTYPE 0)) (T (
SETQ GCTYPE 1)) NIL) (*) (COND ((AND INITONPAGE (OR (ILESSP INITONPAGE 0) (IGREATERP INITONPAGE 128)))
 (\ILLEGAL.ARG INITONPAGE))) (COND ((NULL ALIGN)) ((OR (ILESSP ALIGN 0) (IGREATERP ALIGN 128)) (
\ILLEGAL.ARG ALIGN)) ((ILEQ ALIGN 1) (SETQ ALIGN)) ((AND INITONPAGE (PROGN (*) NIL)) (ERROR 
"INITONPAGE and ALIGN too high"))) (OR (AND (PROGN NIL) (ILEQ NCELLS 64) (\ALLOCHUNK NCELLS GCTYPE 
INITONPAGE ALIGN)) (PROG ((ARLEN (IPLUS NCELLS 2)) ABLOCK) RETRY (PROGN (*) (SETQ ABLOCK (OR (NILL 
ARLEN GCTYPE INITONPAGE ALIGN) (I.\ALLOCBLOCK.NEW ARLEN GCTYPE INITONPAGE ALIGN) (PROGN (FRPTQ 10 (
RECLAIM)) (*) (NILL ARLEN GCTYPE INITONPAGE ALIGN)) (GO FULL))) (*) (NEQ (LOGAND ((LAMBDA ($$PUTBITS) 
(I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 65534) (LOGAND (COND (T 1) (T 0)) 1)))) 
ABLOCK) 1) 0) (NEQ (LOGAND ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE 
$$PUTBITS 0) 65534) (LOGAND (COND (T 1) (T 0)) 1)))) ((LAMBDA (BASE N) (DECLARE (LOCALVARS BASE N)) (
I.ADDBASE (I.ADDBASE BASE N) N)) ABLOCK (IDIFFERENCE (I.GETBASE ABLOCK 1) 1))) 1) 0) (LOGAND (LRSH ((
LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 65529) (LLSH (LOGAND 
GCTYPE 3) 1)))) ABLOCK) 1) 3) (NILL ABLOCK NIL) (PROGN NCELLS) (*) (SETQ ABLOCK (I.ADDBASE ABLOCK 2)) 
(PROGN ABLOCK) (RETURN ABLOCK)) FULL (LISPERROR "ARRAYS FULL" NIL T) (*) (GO RETRY)))))

(I.\ALLOCBLOCK.NEW

(LAMBDA (ARLEN GCTYPE INITONPAGE ALIGN) (*) (DECLARE (GLOBALVARS I.ArrayFrLst I.NxtArrayPage)) (*) (
PROG (FINALWORD FINALPAGE NEXTFREEBLOCK PREFIXLEN) RETRY (COND ((AND (OR INITONPAGE ALIGN) (NEQ 0 (
SETQ PREFIXLEN (I.\PREFIXALIGNMENT? ARLEN INITONPAGE ALIGN GCTYPE I.ArrayFrLst)))) (*) (COND ((SETQ 
PREFIXLEN (I.\ALLOCBLOCK.NEW PREFIXLEN)) (I.\MERGEBACKWARD PREFIXLEN) (*)) (T (RETURN))))) (SETQ 
FINALWORD (I.ADDBASE (I.ADDBASE I.ArrayFrLst ARLEN) (SUB1 ARLEN))) (*) (SETQ NEXTFREEBLOCK (I.ADDBASE 
FINALWORD 1)) (COND ((IGREATERP (SETQ FINALPAGE (IPLUS (LLSH (I.HILOC FINALWORD) 8) (LRSH (I.LOLOC 
FINALWORD) 8))) (IDIFFERENCE I.NxtMDSPage 128)) (*) (SELECTQ (NILL (ADD1 (IDIFFERENCE FINALPAGE 
I.NxtArrayPage))) (T (*)) (0 (*) (GO RETRY)) (RETURN NIL)))) (*) (until (IGREATERP I.NxtArrayPage 
FINALPAGE) do (I.\MAKEMDSENTRY I.NxtArrayPage 0) (I.\NEW2PAGE ((LAMBDA ($$1) (I.VAG2 (LRSH (SETQ $$1 
I.NxtArrayPage) 8) (LLSH (LOGAND $$1 255) 8))) NIL)) (SETQ I.NxtArrayPage (IPLUS I.NxtArrayPage 2))) (
RETURN (PROG1 (I.\MAKEFREEARRAYBLOCK I.ArrayFrLst ARLEN) (SETQ I.ArrayFrLst NEXTFREEBLOCK))))))

(I.\MAKEFREEARRAYBLOCK

(LAMBDA (BLOCK LENGTH) (*) (I.PUTBASE BLOCK 0 43688) (I.PUTBASE BLOCK 1 LENGTH) (I.PUTBASE ((LAMBDA (
BASE N) (DECLARE (LOCALVARS BASE N)) (I.ADDBASE (I.ADDBASE BASE N) N)) BLOCK (IDIFFERENCE (I.GETBASE 
BLOCK 1) 1)) 0 43688) (I.PUTBASE ((LAMBDA (BASE N) (DECLARE (LOCALVARS BASE N)) (I.ADDBASE (I.ADDBASE 
BASE N) N)) BLOCK (IDIFFERENCE (I.GETBASE BLOCK 1) 1)) 1 LENGTH) BLOCK))

(I.\MERGEBACKWARD

(LAMBDA (BASE) (*) (*) (PROG (ARLEN PARLEN PBASE PTRAILER SPLIT) (COND ((NULL BASE) (RETURN NIL)) ((OR
 (NOT (PROGN NIL)) (EQ BASE (I.VAG2 19 0)) (EQ BASE (I.VAG2 64 0)) (NEQ 0 (LOGAND (I.GETBASE (SETQ 
PTRAILER (I.ADDBASE BASE (IMINUS 2))) 0) 1))) (*) (RETURN (I.\LINKBLOCK BASE)))) (SETQ PBASE ((LAMBDA 
(BASE N) (DECLARE (LOCALVARS BASE N)) (I.ADDBASE (I.ADDBASE BASE N) N)) BASE (IMINUS (I.GETBASE 
PTRAILER 1)))) (NILL PBASE T) (\DELETEBLOCK? PBASE) (RETURN (\ARRAYBLOCKMERGER PBASE BASE)))))

(I.\LINKBLOCK

(LAMBDA (BASE) (*) (*) (if I.FREEBLOCKBUCKETS then (if (ILESSP (I.GETBASE BASE 1) 4) then (NILL BASE T
) else (PROG ((FBL ((LAMBDA (BASE N) (DECLARE (LOCALVARS BASE N)) (I.ADDBASE (I.ADDBASE BASE N) N)) 
I.FREEBLOCKBUCKETS (IMIN (INTEGERLENGTH (I.GETBASE BASE 1)) 30))) FREEBLOCK) (SETQ FREEBLOCK (
I.GETBASEPTR FBL 0)) (if (NULL FREEBLOCK) then (I.PUTBASEPTR BASE 2 BASE) (I.PUTBASEPTR BASE 4 BASE) 
else (I.PUTBASEPTR BASE 2 FREEBLOCK) (I.PUTBASEPTR BASE 4 (I.GETBASEPTR FREEBLOCK 4)) (I.PUTBASEPTR (
I.GETBASEPTR FREEBLOCK 4) 2 BASE) (I.PUTBASEPTR FREEBLOCK 4 BASE)) (I.PUTBASEPTR FBL 0 BASE) (NILL 
BASE T T)))) BASE))
)
(DEFINEQ

(I.PREINITARRAYS

(LAMBDA NIL (*) (*) (DECLARE (GLOBALVARS I.ArrayFrLst I.ArrayFrLst2 I.NxtArrayPage)) (SETQ 
I.ArrayFrLst (I.VAG2 19 0)) (SETQ I.ArrayFrLst2 (I.VAG2 64 0)) (SETQ I.NxtArrayPage (IPLUS (LLSH (
I.HILOC I.ArrayFrLst) 8) (LRSH (I.LOLOC I.ArrayFrLst) 8)))))

(I.POSTINITARRAYS

(LAMBDA (AFTERCODEPTR CODESTARTPAGE CODENEXTPAGE) (*) (*) (SETQ I.FREEBLOCKBUCKETS (I.\ALLOCBLOCK (
ADD1 30))) (PROG ((EXTRACELLS (IDIFFERENCE (LLSH CODESTARTPAGE 7) (IPLUS (LLSH (I.HILOC I.ArrayFrLst) 
15) (LRSH (I.LOLOC I.ArrayFrLst) 1))))) (*) (COND ((IGREATERP EXTRACELLS 65535) (printout T T T 
"POSTINITARRAYS:  You pre-allocated too much string space." T 19 
"MKI.CODESTARTOFFSET on MAKEINIT should be reduced by about " (IDIFFERENCE (LRSH EXTRACELLS 7) 10) "."
 T) (HELP)) ((IGEQ EXTRACELLS 4) (*) (printout T T T "POSTINITARRAYS:  There were " (LRSH EXTRACELLS 7
) " allocated but unused array pages." T T)) (T (printout T T 
"POSTINITARRAYS:  String space overflowed into code-arrays" T 19 "You should add at least " (ADD1 (
LRSH (IMINUS EXTRACELLS) 7)) " to MKI.CODESTARTOFFSET on MAKEINIT." T) (HELP))) (*) (I.\LINKBLOCK (
I.\ALLOCBLOCK.NEW EXTRACELLS)) (SETQ I.ArrayFrLst AFTERCODEPTR) (*) (SETQ I.NxtArrayPage CODENEXTPAGE)
 (for VP from (IPLUS (LLSH (I.HILOC (I.VAG2 19 0)) 8) (LRSH (I.LOLOC (I.VAG2 19 0)) 8)) to (IPLUS (
LLSH (I.HILOC I.NxtArrayPage) 8) (LRSH (I.LOLOC I.NxtArrayPage) 8)) by (LRSH 512 8) do (
I.\MAKEMDSENTRY VP 0)))))

(I.FILEARRAYBASE

(LAMBDA NIL (*) (I.ADDBASE (I.VAG2 19 0) (IPLUS (LLSH MKI.CODESTARTOFFSET 8) (LRSH (IDIFFERENCE (
GETFILEPTR (OUTPUT)) MKI.FirstDataByte) 1)))))

(I.FILEBLOCKTRAILER

(LAMBDA (BLOCKINFO) (*) (*) (BOUT16 OUTX 43689) (BOUT16 OUTX BLOCKINFO)))

(I.FILECODEBLOCK

(LAMBDA (NCELLS INITONPAGE) (*) (*) (PROG (PREFIXLEN (ARLEN (IPLUS NCELLS 2))) (*) (COND ((NEQ 0 (SETQ
 PREFIXLEN (I.\PREFIXALIGNMENT? ARLEN INITONPAGE 2 2 (I.FILEARRAYBASE)))) (*) (I.FILEPATCHBLOCK 
PREFIXLEN))) (BOUT16 OUTX 43693) (BOUT16 OUTX ARLEN) (RETURN ARLEN))))

(I.FILEPATCHBLOCK

(LAMBDA (ARLEN) (*) (*) (BOUT16 OUTX 43688) (*) (BOUT16 OUTX ARLEN) (*) (COND ((IGREATERP ARLEN 1) (*)
 (BOUTZEROS (LLSH (IDIFFERENCE ARLEN 2) 2)) (*) (BOUT16 OUTX 43688) (*) (BOUT16 OUTX ARLEN))) NIL))
)
(DEFINEQ

(I.DCODERD

(LAMBDA (FN) (*) (READC) (PROG ((COFD (GETOFD))) (PROG ((NAMETABLE (PROG1 (READ NIL I.CODERDTBL) (
READC))) (CODELEN (IPLUS (LLSH (\BIN COFD) 8) (\BIN COFD))) (NLOCALS (\BIN COFD)) (NFREEVARS (\BIN 
COFD)) (ARGTYPE (\BIN COFD)) (NARGS (\BIN COFD)) (NTSIZE 0) (FRAMENAME FN) REALSIZE STARTPC NTWORDS CA
 FVAROFFSET LOCALARGS STARTLOCALS LOCALSIZE) (COND ((EQ (CAR NAMETABLE) (QUOTE NAME)) (SETQ FRAMENAME 
(CADR NAMETABLE)) (SETQ NAMETABLE (CDDR NAMETABLE)))) (COND ((EQ (CAR NAMETABLE) (QUOTE L)) (SETQ 
LOCALARGS (CADR NAMETABLE)) (SETQ NAMETABLE (CDDR NAMETABLE)))) (COND (NAMETABLE (*) (on NAMETABLE by 
CDDDR do (SETQ NTSIZE (PLUS NTSIZE 1))) (SETQ NTSIZE (LOGAND (IPLUS (ADD1 NTSIZE) (CONSTANT (SUB1 4)))
 (CONSTANT (LOGXOR (SUB1 4) -1)))))) (SETQ NTWORDS (COND (NAMETABLE (IPLUS NTSIZE NTSIZE)) (T (
CONSTANT 4)))) (*) (SETQ STARTPC (LLSH (IPLUS (PROGN 8) NTWORDS) 1)) (*) (COND (LOCALARGS (SETQ 
STARTLOCALS STARTPC) (*) (SETQ LOCALSIZE (LOGAND (IPLUS (ADD1 (LRSH (FLENGTH LOCALARGS) 1)) (CONSTANT 
(SUB1 (IQUOTIENT 4 2)))) (CONSTANT (LOGXOR (SUB1 (IQUOTIENT 4 2)) -1)))) (*) (SETQ LOCALSIZE (LLSH 
LOCALSIZE 1)) (*) (SETQ STARTPC (PLUS STARTPC (LLSH LOCALSIZE 1))))) (SETQ REALSIZE (LOGAND (IPLUS (
IPLUS STARTPC CODELEN) (CONSTANT (SUB1 8))) (CONSTANT (LOGXOR (SUB1 8) -1)))) (SETQ CA (SCRATCHARRAY 
REALSIZE (LOGAND (IPLUS (ADD1 (LRSH (IPLUS STARTPC 3) 2)) (CONSTANT (SUB1 2))) (CONSTANT (LOGXOR (SUB1
 2) -1))))) (AIN CA STARTPC CODELEN COFD) (*) (for X on NAMETABLE by (CDDDR X) as NT1 from (ADD1 (LLSH
 (PROGN 8) 1)) by (CONSTANT 2) bind (NTBYTESIZE ← (LLSH NTSIZE 1)) do (I.FIXUPNUM CA NT1 (I.ATOMNUMBER
 (CADDR X)) -1) (*) (I.FIXUPNUM CA (IPLUS NT1 NTBYTESIZE) (IPLUS (CADR X) (SELECTQ (CAR X) (P (
CONSTANT 32768)) (F (OR FVAROFFSET (SETQ FVAROFFSET (LRSH NT1 1))) (*) (CONSTANT 49152)) (I (CONSTANT 
0)) (SHOULDNT))) -1) (*)) (COND (LOCALARGS (*) (for X on LOCALARGS by (CDDR X) as NT from (ADD1 
STARTLOCALS) by 2 do (I.FIXUPNUM CA NT (I.ATOMNUMBER (CADR X)) -1) (*) (I.FIXUPNUM CA (IPLUS NT 
LOCALSIZE) (IPLUS (CAR X) (CONSTANT 0)) -1) (*)))) (PROGN (*) ((LAMBDA (DEFA0049 VALUEA0048) (DECLARE 
(LOCALVARS DEFA0049 VALUEA0048)) (\BYTESETA DEFA0049 2 (LRSH VALUEA0048 8)) (\BYTESETA DEFA0049 (ADD1 
2) (IMOD VALUEA0048 (CONSTANT (LLSH 1 8))))) CA (UNSIGNED (PROGN (COND ((EQ ARGTYPE 2) -1) (T NARGS)))
 16)) ((LAMBDA (DEFA0051 VALUEA0050) (DECLARE (LOCALVARS DEFA0051 VALUEA0050)) (\BYTESETA DEFA0051 4 (
LRSH VALUEA0050 8)) (\BYTESETA DEFA0051 (ADD1 4) (IMOD VALUEA0050 (CONSTANT (LLSH 1 8))))) CA (
UNSIGNED (PROGN (SUB1 (LRSH (IPLUS (IPLUS NLOCALS NFREEVARS) 1) 1))) 16)) (PROGN (\BYTESETA CA 6 (LRSH
 STARTPC 8)) (\BYTESETA CA (ADD1 6) (IMOD STARTPC (CONSTANT (LLSH 1 8))))) (\BYTESETA CA 8 (LOGOR (
LOGAND (\BYTELT CA 8) 65487) (LLSH (LOGAND ARGTYPE 3) 4))) (I.FIXUPPTR CA 11 (I.\COPY FRAMENAME)) (
PROGN (\BYTESETA CA 12 (LRSH NTSIZE 8)) (\BYTESETA CA (ADD1 12) (IMOD NTSIZE (CONSTANT (LLSH 1 8))))) 
(\BYTESETA CA 14 NLOCALS) (\BYTESETA CA 15 (PROGN (OR FVAROFFSET 0))) ((LAMBDA (DEFA0053 VALUEA0052) (
DECLARE (LOCALVARS DEFA0053 VALUEA0052)) (\BYTESETA DEFA0053 0 (LRSH VALUEA0052 8)) (\BYTESETA 
DEFA0053 (ADD1 0) (IMOD VALUEA0052 (CONSTANT (LLSH 1 8))))) CA (PROGN (IPLUS (LLSH (IPLUS (SIGNED (
LOGOR (LLSH (\BYTELT CA 2) 8) (\BYTELT CA (ADD1 2))) 16) (LLSH (ADD1 (SIGNED (LOGOR (LLSH (\BYTELT CA 
4) 8) (\BYTELT CA (ADD1 4))) 16)) 1)) 1) 12 32)))) (for X on (READ NIL I.CODERDTBL) by (CDDR X) do (
I.FIXUPNUM CA (IPLUS (CAR X) STARTPC) (I.ATOMNUMBER (CADR X)) -1)) (for X on (READ NIL I.CODERDTBL) by
 (CDDR X) do (I.FIXUPNUM CA (IPLUS (CAR X) STARTPC) (I.ATOMNUMBER (CADR X)) -1)) (for X on (READ NIL 
I.CODERDTBL) by (CDDR X) do (I.FIXUPPTR CA (IPLUS (CAR X) STARTPC) (I.\COPY (CADR X)))) (I.PUTDEFN FN 
CA (IPLUS STARTPC CODELEN))))))
)

(RPAQQ \OPCODES
 ((0 -X- 0) (1 CAR 0 T 0 \CAR.UFN) (2 CDR 0 T 0 \CDR.UFN) (3 LISTP 0 T 0 LISTP) (4 
NTYPX 0 T 0 NTYPX) (5 TYPEP 1 TYPEP 0 \TYPEP.UFN) (6 DTEST 2 ATOM 0 \DTEST.UFN) (7 CDDR 0 T 0 CDDR T) 
(8 FN0 2 FN 1) (9 FN1 2 FN 0) (10 FN2 2 FN -1) (11 FN3 2 FN -2) (12 FN4 2 FN -3) (13 FNX 3 FNX FNX) (
14 APPLYFN 0 T -1) (15 CHECKAPPLY* 0 T 0 \CHECKAPPLY* (4K 12K)) (16 RETURN 0 T 0 \HARDRETURN) (17 BIND
 2) (18 UNBIND 0) (19 DUNBIND 0) (20 RPLPTR.N 1 T -1 \RPLPTR.UFN (4K)) (21 GCREF 1 T 0 \HTFIND) (22 
ASSOC 0 T -1 ASSOC (4K DORADO)) (23 GVAR← 2 ATOM 0 \SETGLOBALVAL.UFN) (24 RPLACA 0 T -1 \RPLACA.UFN 4K
) (25 RPLACD 0 T -1 \RPLACD.UFN 4K) (26 CONS 0 T -1 \CONS.UFN) (27 GETP 0 T -1 GETPROP T) (28 FMEMB 0 
T -1 FMEMB (4K DORADO)) (29 GETHASH 0 T -1 GETHASH T) (30 PUTHASH 0 T -2 PUTHASH T) (31 CREATECELL 0 T
 0 \CREATECELL 4K) (32 BIN 0 T 0 \BIN 4K) (33 BOUT 0 T -1 \BOUT T) (34 was.bitblt) (35 LIST1 0 T 0 
CONS T) (36 DOCOLLECT 0 T -1 DOCOLLECT T) (37 ENDCOLLECT 0 T -1 ENDCOLLECT T) (38 RPLCONS 0 T -1 
\RPLCONS (4K DORADO)) (39 LISTGET 0 T -1 LISTGET (4K DORADO)) (40 ELT 0 T -1 ELT T) (41 NTHCHC 0 T -1 
NTHCHARCODE T) (42 SETA 0 T -2 SETA T) (43 RPLCHARCODE 0 T -2 RPLCHARCODE T) (44 EVAL 0 T 0 \EVAL) (45
 EVALV 0 T 0 \EVALV1 T) (46 TYPECHECK 0 T 0 \TYPECHECK.UFN) (47 STKSCAN 0 T 0 \STKSCAN) (48 BUSBLT 1 (
WORDSOUT BYTESOUT BYTESOUTSWAPPED NYBBLESOUT WORDSIN BYTESIN BYTESINSWAPPED NYBBLESINSWAPPED) -3 
\BUSBLT.UFN (4K DORADO)) (49 MISC8 1 (IBLT1 IBLT2) -7 \MISC8.UFN (4K DORADO)) (50 UBFLOAT3 1 (POLY 
MATRIX.3X3 MATRIX.4X4 MATRIX.133 MATRIX.331 MATRIX.144 MATRIX.441) (-2 1) \UNBOXFLOAT3 (4K DORADO)) (
51 TYPEMASK.N 1 T 0 \TYPEMASK.UFN) ((52 58) unused) (59 DRAWLINE 0 T -8 \DRAWLINE.UFN (4K DORADO)) (60
 STORE.N 1 T 0 \STORE.N.UFN) (61 COPY.N 1 T 1 \COPY.N.UFN) (62 RAID 0 T 0 RAID T) (63 \RETURN 0 T 0 
\RETURN) ((64 70) IVAR 0 IVAR 1) (71 IVARX 1 IVAR 1) ((72 78) PVAR 0 PVAR 1) (79 PVARX 1 PVAR 1) ((80 
86) FVAR 0 FVAR 1) (87 FVARX 1 FVAR 1) ((88 94) PVAR← 0 PVAR 0) (95 PVARX← 1 PVAR 0) (96 GVAR 2 ATOM 1
) (97 ARG0 0 T 0 \ARG0 T) (98 IVARX← 1 IVAR 0) (99 FVARX← 1 FVAR 0) (100 COPY 0 T 1) (101 MYARGCOUNT 0
 T 1 \MYARGCOUNT T) (102 MYALINK 0 T 1) (103 ACONST 2 ATOM 1) (104 'NIL 0 T 1) (105 'T 0 T 1) (106 '0 
0 T 1) (107 '1 0 T 1) (108 SIC 1 SIC 1) (109 SNIC 1 SNIC 1) (110 SICX 2 SICX 1) (111 GCONST 3 GCONST 1
) (112 ATOMNUMBER 2 ATOM 1) (113 READFLAGS 0 T 0 \READFLAGS) (114 READRP 0 T 0 \READRP) (115 WRITEMAP 
0 T -2 \WRITEMAP DORADO) (116 READPRINTERPORT 0 T 1 \READPRINTERPORT.UFN 4K) (117 WRITEPRINTERPORT 0 T
 0 \WRITEPRINTERPORT.UFN 4K) (118 PILOTBITBLT 0 T -1 \PILOTBITBLT) (119 RCLK 0 T 0 \RCLKSUBR) (120 
MISC1 1 (error INPUT OUTPUT error error error error error error RWMUFMAN) 0 \MISC1.UFN) (121 MISC2 1 (
?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?10) -1 \MISC2.UFN) (122 RECLAIMCELL 0 T 0 \GCRECLAIMCELL DORADO) (123 GCSCAN1
 0 T 0 \GCSCAN1) (124 GCSCAN2 0 T 0 \GCSCAN2) (125 SUBRCALL 2 SUBRCALL) (126 CONTEXTSWITCH 0 T 0 
\CONTEXTSWITCH) (127 was.audio) ((128 143) JUMP 0 JUMP JUMP NIL) ((144 159) FJUMP 0 JUMP CJUMP NIL) ((
160 175) TJUMP 0 JUMP CJUMP NIL) (176 JUMPX 1 JUMPX JUMP) (177 JUMPXX 2 JUMPXX JUMP) (178 FJUMPX 1 
JUMPX CJUMP) (179 TJUMPX 1 JUMPX CJUMP) (180 NFJUMPX 1 JUMPX NCJUMP) (181 NTJUMPX 1 JUMPX NCJUMP) (182
 jeq) (183 jlistp) ((184 190) PVAR←↑ 0 PVAR -1 NIL) (191 POP 0 T -1) (192 POP.N 1 T (POP.N 1) 
\POP.N.UFN) (193 ATOMCELL.N 1 T 0 \ATOMCELL) (194 GETBASEBYTE 0 T -1 \GETBASEBYTE) (195 was.scanbase) 
(196 BLT 0 T -2 \BLT) (197 was.putbase) (198 was.putbaseptr) (199 PUTBASEBYTE 0 T -2 \PUTBASEBYTE) (
200 GETBASE.N 1 T 0) (201 GETBASEPTR.N 1 T 0) (202 GETBITS.N.FD 2 T 0) (203 GETBASEFIXP.N 1 T 0 
\GETBASEFIXP T) (204 PUTBASEFIXP.N 1 T -1 \PUTBASEFIXP.UFN T) (205 PUTBASE.N 1 T -1 \PUTBASE.UFN) (206
 PUTBASEPTR.N 1 T -1 \PUTBASEPTR.UFN) (207 PUTBITS.N.FD 2 T -1 \PUTBITS.UFN) (208 ADDBASE 0 T -1 
\ADDBASE) (209 VAG2 0 T -1 \VAG2) (210 HILOC 0 T 0) (211 LOLOC 0 T 0) (212 PLUS2 0 T -1 \SLOWPLUS2 *) 
(213 DIFFERENCE 0 T -1 \SLOWDIFFERENCE *) (214 TIMES2 0 T -1 \SLOWTIMES2 *) (215 QUOTIENT 0 T -1 
\SLOWQUOTIENT *) (216 IPLUS2 0 T -1 \SLOWIPLUS2) (217 IDIFFERENCE 0 T -1 \SLOWIDIFFERENCE) (218 
ITIMES2 0 T -1 \SLOWITIMES2) (219 IQUOTIENT 0 T -1 \SLOWIQUOTIENT) (220 IREMAINDER 0 T -1 IREMAINDER) 
(221 IPLUS.N 1 T 0 \SLOWIPLUS2 (4K 12K)) (222 IDIFFERENCE.N 1 T 0 \SLOWIDIFFERENCE (4K 12K)) (223 
was.iblt) (224 LLSH1 0 T 0 \SLOWLLSH1) (225 LLSH8 0 T 0 \SLOWLLSH8) (226 LRSH1 0 T 0 \SLOWLRSH1) (227 
LRSH8 0 T 0 \SLOWLRSH8) (228 LOGOR2 0 T -1 \SLOWLOGOR2) (229 LOGAND2 0 T -1 \SLOWLOGAND2) (230 LOGXOR2
 0 T -1 \SLOWLOGXOR2) (231 LSH 0 T -1 LSH T) (232 FPLUS2 0 T -1 \SLOWFPLUS2 4K) (233 FDIFFERENCE 0 T 
-1 \SLOWFDIFFERENCE 4K) (234 FTIMES2 0 T -1 \SLOWFTIMES2 4K) (235 FQUOTIENT 0 T -1 \SLOWFQUOTIENT 4K) 
(236 UBFLOAT2 1 (UFADD UFSUB UFISUB UFMULT UFDIV UFGREAT UFMAX UFMIN UFREM) (-1 1) \UNBOXFLOAT2 (4K 
DORADO)) (237 UBFLOAT1 1 (BOX UNBOX UFABS UFNEGATE) (0 1) \UNBOXFLOAT1 (4K DORADO)) (238 unused) (239 
unused) (240 EQ 0 T -1) (241 IGREATERP 0 T -1 \SLOWIGREATERP) (242 FGREATERP 0 T -1 \SLOWFGREATERP) (
243 GREATERP 0 T -1 GREATERP) (244 EQUAL 0 T -1 EQUAL) (245 MAKENUMBER 0 T -1 \MAKENUMBER 4K) (246 
BOXIPLUS 0 T -1 \BOXIPLUS 4K) (247 BOXIDIFFERENCE 0 T -1 \BOXIDIFFERENCE 4K) (248 FLOATBLT 0 (
FLOATWRAP FLOATUNWRAP FLOAT FIX FPLUS FDIFFERENCE FDIFFERENCE FPLUSABS ABSDIFFERENCE ABSFPLUS FTIMES) 
-3 \FLOATBLT (4K DORADO)) (249 FFTSTEP 0 T -1 \FFTSTEP (4K DORADO)) (250 MISC3 1 (EXPONENT MAGNITUDE 
FLOAT COMP) -2 \MISC3.UFN (4K DORADO)) (251 MISC4 1 (ARRAY.TIMES ARRAY.PERM ARRAY.PLUS 
ARRAY.DIFFERENCE ARRAY.MAGIC 3MATCH BMBIT) -3 \MISC4.UFN) (252 UPCTRACE 0 T 0 NILL (4K 12K)) (253 SWAP
 0 T 0) (254 NOP 0 T 0) (255 was.upctrace)))

(RPAQ I.CODERDTBL
 (COPYREADTABLE (QUOTE ORIG)))
(SETSYNTAX (CHARCODE ↑Y) (QUOTE (MACRO (LAMBDA (FILE RDTBL) (EVALFORMAKEINIT (READ FILE RDTBL))))) 
I.CODERDTBL)
(DEFINEQ

(I.INITUFNTABLE

(LAMBDA NIL (*) (I.CREATEPAGES (I.VAG2 6 3072) 2 NIL T) (for I from 0 to 255 do (I.\SETUFNENTRY I (
QUOTE \UNKNOWN.UFN) 0 0)) (for X in \OPCODES when (CADDDR (CDDR X)) do (I.\SETUFNENTRY (PROG ((OP (CAR
 X))) (RETURN (if (LISTP OP) then (CAR OP) else OP))) (CADDDR (CDDR X)) (if (LISTP (CADDDR (CDR X))) 
then (CADR (CADDDR (CDR X))) else (IDIFFERENCE (IPLUS 1 (COND ((EQ (CADDR X) 0) 0) (T 1))) (CADDDR (
CDR X)))) (CADDR X)))))

(I.\SETUFNENTRY

(LAMBDA (INDEX FN NARGS NEXTRA) (*) (SETQ INDEX (I.ADDBASE (I.ADDBASE (I.VAG2 6 3072) INDEX) INDEX)) (
I.PUTBASE INDEX 0 (I.ATOMNUMBER FN)) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 1 (LOGOR (LOGAND 
(I.GETBASE $$PUTBITS 1) 255) (LLSH NEXTRA 8)))) INDEX) 8) (LOGAND ((LAMBDA ($$PUTBITS) (I.PUTBASE 
$$PUTBITS 1 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 1) 65280) (LOGAND NARGS 255)))) INDEX) 255)))
)

(RPAQQ INITPTRS
 ((\MAINDISK) (\SWAPREQUESTBLOCK) (\DISKREQUESTBLOCK) (\FREEPAGEFID) (\OneCharAtomBase 
NIL) (\SCRATCHSTRING) (\LISTPDTD) (\FREEBLOCKBUCKETS) (\ArrayFrLst) (\ArrayFrLst2)))

(RPAQQ INITVALUES
 ((\NxtMDSPage \FirstMDSPage) (\LeastMDSPage \FirstMDSPage) (\MDSFREELISTPAGE) (
\MaxSysTypeNum 0) (\MaxTypeNumber) (\NxtPnByte 0) (\CurPnPage 0) (\NxtAtomPage 0) (\AtomFrLst 0) (
\PNAMES.IN.BLOCKS?) (\NxtArrayPage)))
(DECLARE: EVAL@COMPILE DONTCOPY 
(FILESLOAD (LOADCOMP) MAKEINIT)
)
STOP