(FILECREATED "22-JUN-83 19:23:33" {PHYLUM}<LISPCORE>SOURCES>I-NEW.;1


      previous date: "22-JUN-83 17:43:54" {PHYLUM}<LISPCORE>FUGUE>I-NEW.;82)


(PRETTYCOMPRINT I-NEWCOMS)

(RPAQQ I-NEWCOMS
 ((ADDVARS (LOCKEDFNS ERROR RAID \M44ACTONVMEMFILE \ACTONVMEMFILESUBR \ACTONVMEMPAGES 
\CLEANUPDISKQUEUE \CLEARCB \DISKERROR \DOACTONDISKPAGES \DODISKCOMMAND \EXTENDISFMAP \EXTENDVMEMFILE 
\GETDISKCB \INITBFS \INSUREVMEMFILE \LISPERROR \LOOKUPFMAP \REALDISKDA \VIRTUALDISKDA \WARN.OF.BADVMEM
 \ZEROPAGE \ZEROWORDS \TESTPARTITION) (LOCKEDVARS \DISKREQUESTBLOCK \SWAPREQUESTBLOCK \MAINDISK 
\ISFCHUNKSIZE \EMUSCRATCH \EMUDISKBUFFERS \EMUSWAPBUFFERS \EMUDISKBUFEND \MAXSWAPBUFFERS \#DISKBUFFERS
 \InterfacePage \ISFMAP \ISFSCRATCHCAS \ISFSCRATCHDAS \SYSDISK \#SWAPBUFFERS \MAXDISKDAs 
%%STREAMTYPE# \DISKDEBUG \MAXSWAPBUFFERS \SPAREDISKWRITEBUFFER \#EMUBUFFERS \EMUBUFFERS 
\FRAGMENTATIONWARNED)) (FNS I.MAKEINITBFS) (ADDVARS (LOCKEDFNS \KEYHANDLER \KEYHANDLER1 
\RESETKEYBOARD1 \DOTRANSITIONS \CONTEXTAPPLY \LOCKPAGES \DECODETRANSITION \SMASHLINK \PUTEVENTQUEUE 
\INCUSECOUNT \PUTSYSBUF CLOCK0 \EVENTKEYS KEYDOWNP1 LRSH LLSH \MAKEFREEBLOCK \DECUSECOUNT \MAKENUMBER 
\ADDBASE \PERIODIC.INTERRUPTFRAME \CAUSE.PERIODIC.INTERRUPT) (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) (LOCKEDVARS \EM.MOUSEX 
\EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 
\EM.DISPINTERRUPT \EM.CURSORBITMAP \EM.DISPLAYHEAD)) (ADDVARS (LOCKEDFNS \CLOCK0 \GETINTERNALCLOCK 
\BOXIDIFFERENCE \BOXIPLUS \BLT \RCLKSUBR \SLOWIQUOTIENT) (LOCKEDVARS \RCLKSECOND \RCLKMILLISECOND 
\MISCSTATS)) (ADDVARS (LOCKEDFNS \FAULTHANDLER \FAULTINIT \D01.FAULTINIT \DL.FAULTINIT 
\MAKESPACEFORLOCKEDPAGE \PAGEFAULT \READRP \READFLAGS \WRITEMAP \LOOKUPPAGEMAP \LOADVMEMPAGE 
\INVALIDADDR RAID \INVALIDVP \SELECTREALPAGE \TRANSFERPAGE \UPDATECHAIN \MARKPAGEVACANT \FLUSHPAGE 
\MOVEPAGE \ZEROPAGE \FLUSHVM \DONEWPAGE \DONEWEPHEMERALPAGE \WRITEDIRTYPAGE1 \COPYSYS0 \COPYSYS0SUBR 
\RELEASEWORKINGSET \DOFLUSHVM \DOLOCKPAGES \TEMPLOCKPAGES \TEMPUNLOCKPAGES \MP.ERROR \DL.NEWFAULTINIT 
\DL.ASSIGNBUFFERS) (LOCKEDVARS \REALPAGETABLE \PAGEFAULTCOUNTER \UPDATECHAINFREQ \RPOFFSET \RPTSIZE 
\EMBUFBASE \EMBUFVP \EMBUFRP \LASTACCESSEDVMEMPAGE \MAXSHORTSEEK \MAXCLEANPROBES \MINSHORTSEEK 
\DIRTYPAGECOUNTER \VMEM.INHIBIT.WRITE \KBDSTACKBASE \MISCSTACKBASE \DOFAULTINIT \FPTOVP \MACHINETYPE 
\VMEMACCESSFN)) (FNS I.\LOCKFN I.\LOCKVAR I.\LOCKCELL I.\LOCKWORDS I.\LOCKCODE) (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.ASSIGNDATATYPE 
I.\TYPENUMBERFROMNAME I.\CREATECELL) (FNS I.CREATEMDSTYPETABLE I.INITDATATYPES I.INITDATATYPENAMES) (
VARS DTDECLS) (FNS I.FSETVAL I.SETPROPLIST I.PUTDEFN) (FNS I.\MKATOM I.NewAtom I.\INITATOMPAGE 
I.\GCPNAMES I.\MOVEBYTES) (FNS I.COPYATOM I.INITATOMS) (BLOCKS (I.\MKATOM I.\MKATOM I.NewAtom 
I.\MOVEBYTES (NOLINKFNS . T))) (FNS I.INITUFNTABLE I.SETUFNENTRY) (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.\ALLOCBLOCK I.\ALLOCNEWBLOCK I.\LINKBLOCK 
I.\MERGEBACKWARD I.\PATCHBLOCK) (FNS I.COPYSTRING I.PREINITARRAYS I.POSTINITARRAYS I.FILEARRAYBASE 
I.FILEBLOCKTRAILER I.FILECODEBLOCK I.FILEPATCHBLOCK) (FNS I.DCODERD) (VARS \OPCODES (CODERDTBL)) (VARS
 INITPTRS INITVALUES) (DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) MAKEINIT))))

(ADDTOVAR LOCKEDFNS
 ERROR RAID \M44ACTONVMEMFILE \ACTONVMEMFILESUBR \ACTONVMEMPAGES \CLEANUPDISKQUEUE 
\CLEARCB \DISKERROR \DOACTONDISKPAGES \DODISKCOMMAND \EXTENDISFMAP \EXTENDVMEMFILE \GETDISKCB \INITBFS
 \INSUREVMEMFILE \LISPERROR \LOOKUPFMAP \REALDISKDA \VIRTUALDISKDA \WARN.OF.BADVMEM \ZEROPAGE 
\ZEROWORDS \TESTPARTITION)

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

(I.MAKEINITBFS

(LAMBDA NIL (*) (*) (I.\LOCKCELL (SETQ I.MAINDISK ((LAMBDA ($$1) (I.PUTBASEPTR $$1 0 NIL) $$1) (
I.\ALLOCBLOCK 22Q))) 42Q) (I.PUTBASEPTR I.MAINDISK 32Q (I.\COPY (QUOTE DSK))) (I.\LOCKCELL (SETQ 
I.SWAPREQUESTBLOCK (I.\ALLOCBLOCK (LRSH (IPLUS (IPLUS 52Q 74Q) 1) 1))) (IPLUS 52Q 74Q)) (I.\LOCKCELL (
SETQ I.DISKREQUESTBLOCK (I.\ALLOCBLOCK (LRSH (IPLUS (IPLUS 52Q 74Q) 1) 1))) (IPLUS 52Q 74Q)) (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 16Q CB)) (SETQ I.FREEPAGEFID (I.\ALLOCBLOCK 3)) (*) (
for I from 0 to 4 do (I.PUTBASE I.FREEPAGEFID I (LOGAND -1 (CONSTANT (SUB1 (LLSH 1 20Q))))))))
)

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

(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)

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

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

(ADDTOVAR LOCKEDVARS
 \RCLKSECOND \RCLKMILLISECOND \MISCSTATS)

(ADDTOVAR LOCKEDFNS
 \FAULTHANDLER \FAULTINIT \D01.FAULTINIT \DL.FAULTINIT \MAKESPACEFORLOCKEDPAGE 
\PAGEFAULT \READRP \READFLAGS \WRITEMAP \LOOKUPPAGEMAP \LOADVMEMPAGE \INVALIDADDR RAID \INVALIDVP 
\SELECTREALPAGE \TRANSFERPAGE \UPDATECHAIN \MARKPAGEVACANT \FLUSHPAGE \MOVEPAGE \ZEROPAGE \FLUSHVM 
\DONEWPAGE \DONEWEPHEMERALPAGE \WRITEDIRTYPAGE1 \COPYSYS0 \COPYSYS0SUBR \RELEASEWORKINGSET \DOFLUSHVM 
\DOLOCKPAGES \TEMPLOCKPAGES \TEMPUNLOCKPAGES \MP.ERROR \DL.NEWFAULTINIT \DL.ASSIGNBUFFERS)

(ADDTOVAR LOCKEDVARS
 \REALPAGETABLE \PAGEFAULTCOUNTER \UPDATECHAINFREQ \RPOFFSET \RPTSIZE \EMBUFBASE 
\EMBUFVP \EMBUFRP \LASTACCESSEDVMEMPAGE \MAXSHORTSEEK \MAXCLEANPROBES \MINSHORTSEEK \DIRTYPAGECOUNTER 
\VMEM.INHIBIT.WRITE \KBDSTACKBASE \MISCSTACKBASE \DOFAULTINIT \FPTOVP \MACHINETYPE \VMEMACCESSFN)
(DEFINEQ

(I.\LOCKFN

(LAMBDA (FN) (*) (I.\LOCKCELL (SETQ FN (I.ADDBASE (I.VAG2 21Q 0) (LLSH (I.ATOMNUMBER (PROGN (I.\COPY 
FN))) 1)))) (COND ((NOT (ZEROP (LRSH (I.GETBASE FN 0) 17Q))) (I.\LOCKCODE (I.GETBASEPTR FN 0))))))

(I.\LOCKVAR

(LAMBDA (VAR) (*) (I.\LOCKCELL (I.ADDBASE (I.VAG2 22Q 0) (LLSH (PROGN (I.ATOMNUMBER (PROGN (I.\COPY 
VAR)))) 1)))))

(I.\LOCKCELL

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

(I.\LOCKWORDS

(LAMBDA (BASE NWORDS) (*) (MKI.LOCKPAGES (I.VAG2 (I.HILOC BASE) (LOGAND (I.LOLOC BASE) 177400Q)) (COND
 (NWORDS (LRSH (IPLUS (IPLUS (LOGAND (I.LOLOC BASE) 377Q) NWORDS) 377Q) 10Q)) (T 1)))))

(I.\LOCKCODE

(LAMBDA (CODEBLOCK) (*) (I.\LOCKWORDS CODEBLOCK (LLSH (IDIFFERENCE (I.GETBASE (I.ADDBASE CODEBLOCK (
IMINUS 2)) 1) 4) 1))))
)
(DEFINEQ

(I.DUMPINITPAGES

(LAMBDA (CODESTARTOFFSET CODELASTPAGE) (*) (*) (I.ADDPME (IPLUS (LLSH (I.HILOC (I.VAG2 26Q 10000Q)) 
10Q) (LRSH (I.LOLOC (I.VAG2 26Q 10000Q)) 10Q)) T) (*) (for I from (IPLUS (LLSH 40Q 10Q) 
CODESTARTOFFSET) to CODELASTPAGE do (*) (I.ADDPME I T)) (I.MAPPAGES 0 (ADD1 37777Q) (FUNCTION 
I.MAKEROOMFORPME)) (I.MAPPAGES 0 (ADD1 37777Q) (FUNCTION I.ADDPME)) (PROGN (*) (I.PUTBASE (I.VAG2 26Q 
10000Q) 23Q NEXTPM) (I.PUTBASE (I.VAG2 26Q 10000Q) 24Q (SUB1 NEXTVMEM)) (I.PUTBASE (I.VAG2 26Q 10000Q)
 25Q (SUB1 NEXTVMEM)) (I.PUTBASE (I.VAG2 26Q 10000Q) 26Q (LOGAND (PROGN (I.GETBASE (I.VAG2 25Q 0) 0)) 
77777Q)) (I.PUTBASE (I.VAG2 26Q 10000Q) 27Q (LOGAND (PROGN (I.GETBASE (I.VAG2 25Q 0) (I.GETBASE (
I.VAG2 26Q 0) (LRSH (PROGN (IPLUS (LLSH (I.HILOC (I.VAG2 26Q 0)) 10Q) (LRSH (I.LOLOC (I.VAG2 26Q 0)) 
10Q))) 5)))) 77777Q)) (I.PUTBASE (I.VAG2 26Q 10000Q) 10Q 107400Q) (I.PUTBASE (I.VAG2 26Q 10000Q) 11Q 
10000Q) (I.PUTBASE (I.VAG2 26Q 10000Q) 12Q 21400Q) (I.PUTBASE (I.VAG2 26Q 10000Q) 17Q 12743Q)) (
I.MAPPAGES 0 (ADD1 37777Q) (FUNCTION DUMPVP)) (SETFILEPTR (OUTPUT) MKI.Page0Byte) (DUMPVP (IPLUS (LLSH
 (I.HILOC (I.VAG2 26Q 10000Q)) 10Q) (LRSH (I.LOLOC (I.VAG2 26Q 10000Q)) 10Q)))))
)

(RPAQQ INITCONSTANTS
 ((* (LISPNAME VALUE BCPLNAME UCODENAME)) (* * version numbers) (\MinRamVersion 
10000Q T T) (\MinBcplVersion 21400Q T T) (\LispVersion 107400Q T T) (* IF CDRCODING=0, CDR CODING IS 
OFF, OTHERWISE ON) (CDRCODING 1 T T) (* * type numbers) (\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 10Q) (
\VMEMPAGEP 12Q NIL VMemPagePType) (\STREAM 13Q NIL STREAMTYPE) (* * TYPE TABLE CONSTANTS) (
\TT.TYPEMASK 377Q TTTypeMask T) (\TT.NOREF 100000Q NIL T) (\TT.LISPREF 40000Q NIL T) (* * page map) (
\PMblockSize 40Q PMBLOCKSIZE) (\STATSsize 10Q T) (\NumPMTpages 2) (\EmptyPMTEntry 177777Q T) (
\FirstVmemBlock 2 T) (* * interface page) (\IFPValidKey 12743Q T) (* * atoms) (\HashInc 23Q T) (* * 
MDS) (\FirstMDSPage 400Q T) (\MDSIncrement 1000Q) (* * stack block constants) (\StackMask 160000Q T T)
 (\FxtnBlock 140000Q T T) (\GuardBlock 160000Q T T) (\BFBlock 100000Q T T) (\FreeStackBlock 120000Q T 
T) (\NotStackBlock 0) (* none of the above) (\MinExtraStackWords 40Q T T) (* * backspace kludge) (
ERASECHARCODE 0 T) (* * GC constants) (\HT1CNT 2000Q NIL T) (\HTSTKBIT 1000Q NIL T) (\HTCNTMASK 
176000Q NIL T) (\HTMAINSIZE 100000Q NIL T) (\HTCOLLSIZE 177770Q 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) (\SMALLPOSPSPACE (16Q 0)) (\SmallPosHi 16Q SMALLPOSspace smallpl) (
\SMALLNEGSPACE (17Q 0)) (\SmallNegHi 17Q SMALLNEGspace smallneg) (\NumSmallPages 1000Q) (\GuardMDSPage
 6300Q) (\LastMDSPage 6377Q) (\PNPSPACE (20Q 0) (PNPspace PNPbase)) (\LastPnPage 3777Q) (\DEFSPACE (
21Q 0) (DEFspace DEFbase) (DEFspace DEFbase)) (\VALSPACE (22Q 0) (TOPVALspace TOPVALbase) (VALspace 
VALbase)) (\PLISTSPACE (23Q 0) (PLISTspace PLISTbase)) (\AtomHashTable (24Q 0) (AHTspace AHTbase)) (
\AtomHTpages 200Q AHTSIZE) (\PAGEMAP (25Q 0) (PAGEMAPspace PAGEMAPbase)) (\NumPageMapPages 400Q) (
\PageMapTBL (26Q 0) (PMTspace PMTbase)) (\InterfacePage (26Q 10000Q) (INTERFACEspace INTERFACEbase) (
INTERFACEspace INTERFACEbase)) (\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 16Q T T) (\TeleRaidFXP 30Q T T) (
\IOPAGE (0 177400Q)) (\IOCBPAGE (0 400Q)) (\MDSTypeTable (26Q 100000Q) (MDSTYPEspace MDSTYPEbase) (NIL
 MDSTYPEbase)) (\MDSTTsize 40Q T) (\STATSSPACE (26Q 120000Q) (STATSspace STATSbase) (STATSspace NIL)) 
(\InterruptTBL (26Q 121200Q) (NIL InterruptTBLbase)) (\MISCSTATS (26Q 122000Q) (NIL MISCSTATSbase)) (
\UFNTable (26Q 123000Q) NIL (NIL UFNTablebase)) (\DTDSpaceBase (26Q 124000Q) (DTDspace DTDbase) (
DTDspace DTDbase)) (\DTDSize 20Q T) (\LISTPDTD (26Q 124120Q)) (\EndTypeNumber 377Q) (\STACKSPACE (27Q 
0) (STACKspace NIL) (STACKspace NIL)) (\GuardStackAddr 170000Q) (\LastStackAddr 177776Q) (\STACKHI 27Q
 NIL T) (\PNCHARSSPACE (30Q 0)) (\PNAMESPACEEND (37Q 177777Q)) (\ARRAYSPACE (40Q 0) NIL (ARRAYspace 
NIL)) (\ARRAYspace 40Q) (\ARRAYbase 0) (\LastArrayPage 15377Q) (\HTMAIN (73Q 0) (HTMAINspace 
HTMAINbase) (HTMAINspace HTMAINbase)) (\HTMAINnpages 201Q T) (\HTMAIN1 (73Q 1)) (\HTOVERFLOW (73Q 
100000Q) NIL (NIL HTOVERFLOWbase)) (\HTCOLL (74Q 0) NIL (HTCOLLspace HTCOLLbase)) (\HTCOLL1 (74Q 1)) (
\DISPLAYREGION (76Q 0)) (\DefaultScARRAYhi 76Q) (\D1BCPLspace 0 T LEmubrHiVal) (\D0BCPLspace 0 T) (* 
emulator segment locations) (DCB.EM 420Q) (DISPINTERRUPT.EM 421Q) (CURSORBITMAP.EM 431Q) (KBDAD0.EM 
177034Q) (KBDAD1.EM 177035Q) (KBDAD2.EM 177036Q) (KBDAD3.EM 177037Q) (UTILIN.EM 177030Q) (CURSORX.EM 
426Q) (CURSORY.EM 427Q) (MOUSEX.EM 424Q) (MOUSEY.EM 425Q) (\LispKeyMask 20000Q T T) (\BcplKeyMask 
10400Q T T) (* Machine types) (\DOLPHIN 4) (\DORADO 5) (\DANDELION 6) (* * FOR DLION) (\VP.DISPLAY 
37000Q) (* for wide display 1024x808/16x256) (\NP.DISPLAY 312Q) (\RP.DISPLAY 0) (\RP.STACK 1000Q) (
\VP.STACK 13400Q) (\VP.STATS 13200Q) (\RP.STATS 600Q) (\NP.STATS 200Q) (\RP.MAP 400Q) (\NP.MAP 100Q) (
\RP.IOPAGE 500Q) (\VP.IOPAGE 377Q) (\VP.IFPAGE 13020Q) (\VP.FPTOVP 13100Q) (\NP.FPTOVP 100Q) (
\RP.FPTOVP 501Q) (\RP.STARTBUFFERS 601Q) (\VP.TYPETABLE 13200Q) (\NP.TYPETABLE 40Q) (\RP.TYPETABLE 
1600Q) (\VP.GCTABLE 35400Q) (\NP.GCTABLE 200Q) (\RP.GCTABLE 1400Q) (\VP.GCOVERFLOW 35600Q) (
\NP.GCOVERFLOW 1) (\RP.GCOVERFLOW 1640Q) (\FP.IFPAGE 2) (\VP.IOCBS 1) (\RP.TEMPDISPLAY 1641Q) (* DLion
 processor commands) (\DL.PROCESSORBUSY 100000Q) (\DL.SETTOD 100001Q) (\DL.READTOD 100002Q) (
\DL.READPID 100003Q) (\DL.BOOTBUTTON 100004Q) (\RP.AFTERDISPLAY 316Q) (\VP.INITSCRATCH 10Q) (\VP.RPT 
200Q) (\VP.BUFFERS 300Q) (* * These going away...) (\RP.IOCBS 1401Q) (\RP.RPT 501Q)))
(DEFINEQ

(I.SETUPPAGEMAP

(LAMBDA NIL (*) (*) (PROG (VPX) (*) (MKI.NEWPAGE (I.VAG2 25Q 0) NIL T) (I.CREATEPAGES (I.VAG2 26Q 0) 2
 NIL T) (*) (for I from 0 to (SUB1 (LLSH 2 10Q)) do (I.PUTBASE (I.VAG2 26Q 0) I 177777Q)) (SETQ NEXTPM
 0) (SETQ VPX (LRSH (PROGN (IPLUS (LLSH (I.HILOC (I.VAG2 25Q 0)) 10Q) (LRSH (I.LOLOC (I.VAG2 25Q 0)) 
10Q))) 5)) (for I from 0 to (SUB1 (LRSH 400Q 5)) do (I.PUTBASE (I.VAG2 26Q 0) (IPLUS VPX I) NEXTPM) (
SETQ NEXTPM (IPLUS NEXTPM 40Q))) (*) (SETQ NEXTVMEM 2))))

(I.ADDPME

(LAMBDA (VP NEWPAGEOK) (*) (*) (PROG (PX PMP) (COND ((IEQ (SETQ PMP (I.GETBASE (I.VAG2 26Q 0) (LRSH VP
 5))) 177777Q) (*) (COND ((EVENP NEXTPM 400Q) (*) (SETQ PX (I.ADDBASE (I.VAG2 25Q 0) NEXTPM)) (OR 
NEWPAGEOK (IGREATERP (IPLUS (LLSH (I.HILOC PX) 10Q) (LRSH (I.LOLOC PX) 10Q)) VP) (HELP 
"page map needs new page after page map written out")) (MKI.NEWPAGE PX NIL T))) (I.PUTBASE (I.VAG2 26Q
 0) (LRSH VP 5) (SETQ PMP NEXTPM)) (SETQ NEXTPM (IPLUS NEXTPM 40Q)))) (SETQ PX (IPLUS PMP (LOGAND VP 
37Q))) (COND ((NEQ (I.GETBASE (I.VAG2 25Q 0) PX) 0) (HELP "page already in pagemap" VP)) (T (I.PUTBASE
 (I.VAG2 25Q 0) PX (COND ((MKI.LOCKEDPAGEP VP) (IPLUS 100000Q NEXTVMEM)) (T NEXTVMEM))))) (SETQ 
NEXTVMEM (ADD1 NEXTVMEM)))))

(I.MAKEROOMFORPME

(LAMBDA (VP) (*) (*) (COND ((IEQ (I.GETBASE (I.VAG2 26Q 0) (LRSH VP 5)) 177777Q) (*) (COND ((EVENP 
NEXTPM 400Q) (*) (MKI.NEWPAGE (I.ADDBASE (I.VAG2 25Q 0) NEXTPM) NIL T))) (I.PUTBASE (I.VAG2 26Q 0) (
LRSH VP 5) NEXTPM) (SETQ NEXTPM (IPLUS NEXTPM 40Q))))))

(I.MAPPAGES

(LAMBDA (BOT TOP FN) (*) (PROG ((VP BOT) (IVP (IPLUS (LLSH (I.HILOC (I.VAG2 26Q 10000Q)) 10Q) (LRSH (
I.LOLOC (I.VAG2 26Q 10000Q)) 10Q)))) 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 27Q 0) (IQUOTIENT 22000Q 400Q) NIL T) (*) (
I.\SETUPGUARDBLOCK 0 2) (*) (I.PUTBASE (I.VAG2 26Q 10000Q) 0 (I.\SETUPSTACK1 2 0 0 (IDIFFERENCE 1400Q 
2) 0 RESETPC RESETPTR NIL INITFLG)) (I.PUTBASE (I.VAG2 26Q 10000Q) 1 0) (I.PUTBASE (I.VAG2 26Q 10000Q)
 6 0) (I.PUTBASE (I.VAG2 26Q 10000Q) 2 0) (I.PUTBASE (I.VAG2 26Q 10000Q) 3 0) (I.\SETUPGUARDBLOCK (
IDIFFERENCE 1400Q 2) 2) (I.PUTBASE (I.VAG2 26Q 10000Q) 36Q (I.\SETUPGUARDBLOCK 1400Q (IDIFFERENCE (
IDIFFERENCE 22000Q 1400Q) 2))) (I.PUTBASE (I.VAG2 26Q 10000Q) 7 (I.\SETUPGUARDBLOCK (IDIFFERENCE 
22000Q 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 27Q 0) SP (CAR ARGS)) (*) (SETQ ARGS (CDR ARGS)) (SETQ SP (IPLUS 
SP 2))) (AND (PROG1 (COND ((ODDP SP 4) (I.PUTBASEPTR (I.VAG2 27Q 0) SP NIL) (*) (SETQ SP (IPLUS SP 2))
 T)) (I.PUTBASE (I.VAG2 27Q SP) 0 100000Q)) (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 
(LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 177377Q) (LLSH (LOGAND 1 1) 10Q)))) (I.VAG2 27Q SP)) 10Q) 1)) (
I.PUTBASE (I.VAG2 27Q SP) 1 STKP) (SETQ STKP (IPLUS SP 2)) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE 
$$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 17777Q) (LLSH 6 15Q)))) (I.VAG2 27Q STKP)) 15Q) (
NEQ (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 
177377Q) (LLSH (LOGAND (COND (T 1) (T 0)) 1) 10Q)))) (I.VAG2 27Q STKP)) 10Q) 1) 0) (NEQ (LOGAND (LRSH 
((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 175777Q) (LLSH (
LOGAND (COND (NIL 1) (T 0)) 1) 12Q)))) (I.VAG2 27Q STKP)) 12Q) 1) 0) (NEQ (LOGAND (LRSH ((LAMBDA (
$$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 167777Q) (LLSH (LOGAND (COND 
(NIL 1) (T 0)) 1) 14Q)))) (I.VAG2 27Q STKP)) 14Q) 1) 0) (NEQ (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (
I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 176777Q) (LLSH (LOGAND (COND (NIL 1) (T 0
)) 1) 11Q)))) (I.VAG2 27Q STKP)) 11Q) 1) 0) (LOGAND ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR
 (LOGAND (I.GETBASE $$PUTBITS 0) 177400Q) (LOGAND 0 377Q)))) (I.VAG2 27Q STKP)) 377Q) (I.PUTBASE (
I.VAG2 27Q STKP) 10Q SP) (I.PUTBASE (I.VAG2 27Q STKP) 1 (IPLUS ALINK 12Q 1)) (I.PUTBASE (I.VAG2 27Q 
STKP) 11Q (IPLUS CLINK 12Q)) (PROGN ((LAMBDA ($$1) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 3 (
LOGOR (LOGAND (I.GETBASE $$PUTBITS 3) 377Q) (LLSH (PROGN $$1) 10Q)))) (I.VAG2 27Q STKP)) 10Q) (LOGAND 
((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 3 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 3) 177400Q) (LOGAND 
$$1 377Q)))) (I.VAG2 27Q STKP)) 377Q)) (I.HILOC DEFPTR)) (I.PUTBASE (I.VAG2 27Q STKP) 2 (I.LOLOC 
DEFPTR))) (I.PUTBASE (I.VAG2 27Q STKP) 5 PC) (SETQ SP (IPLUS STKP (PROGN 12Q))) (COND ((NOT INITFLG) (
*) (RPTQ (LLSH (ADD1 ((LAMBDA (X) (DECLARE (LOCALVARS . T)) (COND ((IGREATERP X (SUB1 (LLSH 1 (SUB1 
20Q)))) (SUB1 (IDIFFERENCE X (SUB1 (LLSH 1 20Q))))) (T X))) (I.GETBASE DEFPTR 2))) 1) (PROGN (*) (
I.PUTBASE (I.VAG2 27Q 0) SP 177777Q) (SETQ SP (IPLUS SP 2)))))) (I.PUTBASE (I.VAG2 27Q STKP) 4 (SETQ 
SP (IPLUS SP (PROGN 4)))) (*) (I.\MAKEFREEBLOCK SP (IDIFFERENCE STKEND SP)) (RETURN STKP))))))

(I.\SETUPGUARDBLOCK

(LAMBDA (STKP LEN) (*) (I.PUTBASE (I.VAG2 27Q STKP) 0 160000Q) (I.PUTBASE (I.VAG2 27Q STKP) 1 LEN) 
STKP))

(I.\MAKEFREEBLOCK

(LAMBDA (STK SIZE) (*) (PROGN (*) (I.PUTBASE (I.VAG2 27Q STK) 1 SIZE) (I.PUTBASE (I.VAG2 27Q STK) 0 
120000Q))))
)

(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 73Q 0) (LRSH (IPLUS 100000Q 377Q) 10Q) T T) (I.CREATEPAGES (
I.VAG2 73Q 100000Q) 1 T T) (I.CREATEPAGES (I.VAG2 74Q 0) 1 NIL T) (I.CREATEPAGES (I.ADDBASE (I.VAG2 
74Q 0) 400Q) (SUB1 (LRSH (IPLUS 177770Q 377Q) 10Q)) T) (I.PUTBASE (I.VAG2 74Q 0) 0 0) (I.PUTBASE (
I.VAG2 74Q 0) 1 2)))
)
(DEFINEQ

(I.NTYPX

(LAMBDA (X) (*) (*) (LOGAND (I.GETBASE (I.VAG2 26Q 100000Q) (LRSH (IPLUS (LLSH (I.HILOC X) 10Q) (LRSH 
(I.LOLOC X) 10Q)) 1)) 377Q)))

(I.\ALLOCMDSPAGE

(LAMBDA (TYP) (*) (DECLARE (GLOBALVARS \INTERRUPTSTATE \PENDINGINTERRUPT)) (PROG ((VP I.NxtMDSPage) 
VPTR) (COND ((OR (IGEQ VP 6300Q) (NILL)) (*) (COND ((EQ VP (LOGAND 6377Q (CONSTANT (LOGXOR (SUB1 2) -1
)))) (*) (do (HELP "Main Data Space completely full")))) (COND ((NOT \STORAGEFULL) (SETQ \STORAGEFULL 
T) (NEQ (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 
0) 176777Q) (LLSH (LOGAND (COND (T 1) (T 0)) 1) 11Q)))) \INTERRUPTSTATE) 11Q) 1) 0) (SETQ 
\PENDINGINTERRUPT T))))) (SETQ I.NxtMDSPage (IPLUS VP 2)) (*) (I.\MAKEMDSENTRY VP (COND ((NILL) (LOGOR
 TYP 100000Q)) ((EQ TYP 12Q) (LOGOR 12Q 40000Q)) (T TYP))) (*) (MKI.NEWPAGE (I.ADDBASE (MKI.NEWPAGE (
SETQ VPTR ((LAMBDA ($$1) (I.VAG2 (LRSH (SETQ $$1 VP) 10Q) (LLSH (LOGAND $$1 377Q) 10Q))) NIL))) 400Q))
 (RETURN VPTR))))

(I.\MAKEMDSENTRY

(LAMBDA (VP V) (*) (I.PUTBASE (I.VAG2 26Q 100000Q) (LRSH VP 1) V)))

(I.\GCTYPE

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

(I.\INITMDSPAGE

(LAMBDA (BASE SIZE PREV) (*) (*) (PROG ((DISP 0)) (while (ILEQ (IPLUS DISP SIZE) 1000Q) do (
I.PUTBASEPTR BASE 0 PREV) (SETQ PREV BASE) (SETQ BASE (I.ADDBASE BASE SIZE)) (SETQ DISP (IPLUS DISP 
SIZE))) (RETURN PREV))))

(I.ASSIGNDATATYPE

(LAMBDA (NAME DESCRIPTORS SIZE SPECS PTRFIELDS GVNAME) (*) (PROG (DTD (I.NTYPX (I.\TYPENUMBERFROMNAME 
NAME))) (COND (I.NTYPX (*) (SETQ DTD (I.ADDBASE (I.VAG2 26Q 124000Q) (LLSH I.NTYPX 4))) (COND ((OR (
EQUAL DESCRIPTORS (I.GETBASEPTR DTD 4)) (EQ CROSSCOMPILING T) (AND CROSSCOMPILING (NEQ (QUOTE Y) (
ASKUSER NIL (QUOTE N) (LIST "OK TO REDECLARE DATATYPE " NAME))))) (*) (RETURN I.NTYPX))) (COND ((
IGREATERP I.NTYPX I.MaxSysTypeNum) (PROGN (I.PUTBASE DTD 0 (I.ATOMNUMBER (QUOTE **DEALLOC**))) (
I.PUTBASEPTR DTD 4 NIL) (I.PUTBASEPTR DTD 6 NIL))) ((AND (EQ SIZE (I.GETBASE DTD 1)) (EQUAL PTRFIELDS 
(I.GETBASEPTR DTD 10Q))) (RETURN I.NTYPX)) (T (*) (ERROR "ILLEGAL DATA TYPE" NAME))))) (COND ((EQ 
I.MaxTypeNumber 377Q) (LISPERROR "DATA TYPES FULL" NAME))) (PROGN (SETQ I.NTYPX (SETQ I.MaxTypeNumber 
(IPLUS I.MaxTypeNumber 1))) (SETQ DTD (I.ADDBASE (I.VAG2 26Q 124000Q) (LLSH I.NTYPX 4))) (COND ((
IGREATERP 20Q (LOGAND (IPLUS (I.LOLOC DTD) 20Q) 377Q)) (*) (*) (MKI.NEWPAGE (I.ADDBASE DTD 20Q) 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 10Q 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 26Q 124000Q) (LLSH I 4)) 0)) (RETURN I)))))))

(I.\CREATECELL

(LAMBDA (TYP) (*) (PROG (NEWCELL (DTD (I.ADDBASE (I.VAG2 26Q 124000Q) (LLSH TYP 4)))) (PROGN (SETQ 
NEWCELL (OR (I.GETBASEPTR DTD 2) (I.\GCTYPE TYP DTD))) (COND ((AND (NEQ 1 0) (EQ TYP 5)) (HELP 
"CREATECELL \LISTP")) (T (*))) (PROG NIL (*) (I.PUTBASEPTR DTD 2 (OR (I.GETBASEPTR NEWCELL 0) (PROGN (
I.PUTBASEPTR DTD 2 NIL) (RETURN (I.\GCTYPE TYP DTD)))))) (*) (PROG ((PTR NEWCELL)) (FRPTQ (LRSH (
I.GETBASE DTD 1) 1) (I.PUTBASEPTR PTR 0 NIL) (SETQ PTR (I.ADDBASE PTR 2)))) (*) (PROGN NEWCELL)) (
RETURN NEWCELL))))
)
(DEFINEQ

(I.CREATEMDSTYPETABLE

(LAMBDA NIL (*) (*) (I.CREATEPAGES (I.VAG2 26Q 100000Q) 40Q NIL T) (PROG (VP) (*) (SETQ VP 0) (FRPTQ (
LLSH 40Q 10Q) (I.PUTBASE (I.VAG2 26Q 100000Q) VP 100000Q) (SETQ VP (IPLUS VP 1))) (*) (SETQ VP (IPLUS 
(LLSH (I.HILOC (I.VAG2 16Q 0)) 10Q) (LRSH (I.LOLOC (I.VAG2 16Q 0)) 10Q))) (FRPTQ 1000Q (
I.\MAKEMDSENTRY VP (LOGOR 100000Q 1)) (SETQ VP (IPLUS VP 1))) (SETQ VP (IPLUS (LLSH (I.HILOC (I.VAG2 
40Q 0)) 10Q) (LRSH (I.LOLOC (I.VAG2 40Q 0)) 10Q))) (FRPTQ 15377Q (I.\MAKEMDSENTRY VP 0) (SETQ VP (
IPLUS VP 1))))))

(I.INITDATATYPES

(LAMBDA NIL (*) (*) (I.CREATEPAGES (I.VAG2 26Q 120000Q) 10Q NIL T) (*) (SETQ I.MaxTypeNumber 0) (
I.CREATEPAGES (I.VAG2 26Q 124000Q) 1 NIL T) (for D in DTDECLS bind DTD as old I.MaxTypeNumber from 1 
do (COND ((AND (CAR D) (CADR D)) (I.PUTBASE (SETQ DTD (I.ADDBASE (I.VAG2 26Q 124000Q) (LLSH 
I.MaxTypeNumber 4))) 1 (CADR D)) (I.\GCTYPE I.MaxTypeNumber DTD)))) (COND ((NEQ 1 0) (SETQ I.LISTPDTD 
(I.ADDBASE (I.VAG2 26Q 124000Q) (LLSH 5 4))))) NIL))

(I.INITDATATYPENAMES

(LAMBDA NIL (*) (*) (SETQ I.MaxSysTypeNum (SETQ I.MaxTypeNumber 0)) (*) (for D in DTDECLS do (*) (
I.ASSIGNDATATYPE (CAR D) NIL (OR (CADR D) 0) NIL (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 400Q)))
(DEFINEQ

(I.FSETVAL

(LAMBDA (ATM VAL) (*) (*) (I.PUTBASEPTR (I.ADDBASE (I.VAG2 22Q 0) (LLSH (PROGN (I.ATOMNUMBER ATM)) 1))
 0 VAL)))

(I.SETPROPLIST

(LAMBDA (ATM LST) (*) (I.PUTBASEPTR (I.ADDBASE (I.VAG2 23Q 0) (LLSH (I.ATOMNUMBER ATM) 1)) 0 LST)))

(I.PUTDEFN

(LAMBDA (FN CA SIZE) (*) (PROG ((DCELL (I.ADDBASE (I.VAG2 21Q 0) (LLSH (I.ATOMNUMBER FN) 1))) (
BLOCKINFO (PROGN (*) (I.FILECODEBLOCK (LRSH (IPLUS SIZE 3) 2) (IPLUS ((LAMBDA (DEF LC) (IPLUS (LLSH (
\BYTELT DEF LC) 10Q) (\BYTELT DEF (ADD1 LC)))) CA 14Q) (PROGN 10Q))))) (BASE (I.FILEARRAYBASE))) (
I.PUTBASEPTR DCELL 0 BASE) (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (
I.GETBASE $$PUTBITS 0) 147777Q) (LLSH (LOGAND (LOGAND (LRSH (\BYTELT CA 10Q) 4) 3) 3) 14Q)))) DCELL) 
14Q) 3) (NEQ (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE 
$$PUTBITS 0) 137777Q) (LLSH (LOGAND (COND ((ZEROP ((LAMBDA (DEF LC) (IPLUS (LLSH (\BYTELT DEF LC) 10Q)
 (\BYTELT DEF (ADD1 LC)))) CA 14Q)) 1) (T 0)) 1) 16Q)))) DCELL) 16Q) 1) 0) (NEQ (LRSH ((LAMBDA (
$$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 77777Q) (LLSH (COND (T 1) (T 
0)) 17Q)))) DCELL) 17Q) 0) (NEQ (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (
LOGAND (I.GETBASE $$PUTBITS 0) 173777Q) (LLSH (LOGAND (COND (NIL 1) (T 0)) 1) 13Q)))) DCELL) 13Q) 1) 0
) (COND ((FMEMB FN LOCKEDFNS) (I.\LOCKCELL DCELL 1) (I.\LOCKCELL BASE (LRSH (IPLUS (IPLUS (LOGAND (
I.LOLOC BASE) 377Q) (LRSH (IPLUS SIZE 1) 1)) 377Q) 10Q)))) (COND ((EQ FN (FUNCTION \RESETSTACK)) (SETQ
 RESETPTR (I.FILEARRAYBASE)) (SETQ RESETPC ((LAMBDA (DEF LC) (IPLUS (LLSH (\BYTELT DEF LC) 10Q) (
\BYTELT DEF (ADD1 LC)))) CA 6)))) (AOUT CA 0 SIZE OUTX (QUOTE CODE)) (BOUTZEROS (IDIFFERENCE (SUB1 4) 
(IMOD (SUB1 SIZE) 4))) (I.FILEBLOCKTRAILER BLOCKINFO))))
)
(DEFINEQ

(I.\MKATOM

(LAMBDA (BASE OFFST LEN) (*) (PROG ((L 1) (H 0) H1 P Q C) (COND ((ZEROP LEN) (GO LP))) (SETQ C (
I.\GETBASEBYTE BASE OFFST)) (PROGN (COND ((AND (IGREATERP 2 LEN) I.OneCharAtomBase) (RETURN (COND ((
IGREATERP C 71Q) (I.ADDBASE I.OneCharAtomBase (IDIFFERENCE C 12Q))) ((IGREATERP C 57Q) (IDIFFERENCE C 
60Q)) (T (I.ADDBASE I.OneCharAtomBase C)))))) (COND ((AND (ILEQ C (CONSTANT (CHCON1 "9"))) (SETQ P (
NILL BASE OFFST LEN))) (*) (RETURN P)))) (*) (SETQ H C) HASH (COND ((NEQ L LEN) (SETQ H (LOGAND (IPLUS
 (IPLUS (LOGAND (SETQ H1 (IPLUS H (LLSH (LOGAND H 7777Q) 2))) 77777Q) (LLSH (LOGAND H1 177Q) 10Q)) (
I.\GETBASEBYTE BASE (IPLUS OFFST L))) 77777Q)) (SETQ L (ADD1 L)) (GO HASH))) (*) LP (COND ((NEQ (SETQ 
P (I.GETBASE (I.VAG2 24Q 0) H)) 0) (COND ((AND (EQ (LRSH (I.GETBASE (I.GETBASEPTR (I.ADDBASE (I.VAG2 
20Q 0) (LLSH (I.ATOMNUMBER (PROGN (SETQ Q (I.ADDBASE (I.VAG2 0 0) (SUB1 P))))) 1)) 0) 0) 10Q) LEN) ((
LAMBDA (BASE1 BN1 BASE2 BN2 LEN) (PROG NIL LP (COND ((ZEROP LEN) (RETURN T)) ((NEQ (I.\GETBASEBYTE 
BASE1 BN1) (I.\GETBASEBYTE BASE2 BN2)) (RETURN)) (T (SETQ BN1 (IPLUS BN1 1)) (SETQ BN2 (IPLUS BN2 1)) 
(SETQ LEN (IPLUS LEN -1)) (GO LP))))) (I.GETBASEPTR (I.ADDBASE (I.VAG2 20Q 0) (LLSH (I.ATOMNUMBER Q) 1
)) 0) 1 BASE OFFST LEN)) (RETURN Q)) (T (SETQ H (LOGAND (IPLUS H 23Q) 77777Q)) (GO LP))))) (*) (RETURN
 (I.NewAtom BASE OFFST LEN H)))))

(I.NewAtom

(LAMBDA (BASE BN LEN H) (*) (PROG (ATM PB CPP PNP) (RETURN (PROGN (SETQ ATM I.AtomFrLst) (SETQ PB 
I.NxtPnByte) (COND ((NOT (ZEROP (LOGAND PB 1))) (COND ((ZEROP (SETQ PB (LOGAND (ADD1 PB) (SUB1 1000Q))
)) (I.\GCPNAMES)) (T (SETQ I.NxtPnByte PB))))) (SETQ CPP I.CurPnPage) (*) (COND ((ILESSP (IDIFFERENCE 
1000Q PB) (ADD1 LEN)) (I.\GCPNAMES))) (COND ((EVENP ATM 1000Q) (PROG ((PN (LRSH ATM 10Q))) (COND ((
IGREATERP PN 177Q) (*) (HELP "No more atoms left"))) (*) (I.\MAKEMDSENTRY PN (LOGOR 100000Q 4)) (*) (
I.\INITATOMPAGE PN)))) (I.PUTBASEPTR (I.ADDBASE (I.VAG2 20Q 0) (LLSH ATM 1)) 0 (SETQ PNP (I.VAG2 (
IPLUS 30Q (LRSH CPP 10Q)) (IPLUS (LLSH (LOGAND CPP 377Q) 10Q) (LRSH PB 1))))) (*) (I.\MOVEBYTES BASE 
BN PNP 1 LEN) (I.\PUTBASEBYTE PNP 0 LEN) (SETQ I.AtomFrLst (I.PUTBASE (I.VAG2 24Q 0) H (ADD1 ATM))) (
COND ((ZEROP (SETQ I.NxtPnByte (LOGAND (IPLUS PB (LOGAND (IPLUS LEN 2) 177776Q)) (SUB1 1000Q)))) (
I.\GCPNAMES))) (I.ADDBASE (I.VAG2 0 0) ATM))))))

(I.\INITATOMPAGE

(LAMBDA (PN) (*) (PROG ((OFFSET (LLSH PN 11Q)) J DEFBASE VALBASE) (*) (*) (I.\NEW4PAGE (I.ADDBASE (
I.VAG2 20Q 0) OFFSET)) (I.\NEW4PAGE (SETQ DEFBASE (I.ADDBASE (I.VAG2 21Q 0) OFFSET))) (I.\NEW4PAGE (
I.ADDBASE (I.VAG2 23Q 0) OFFSET)) (I.\NEW4PAGE (SETQ VALBASE (I.ADDBASE (I.VAG2 22Q 0) OFFSET))) (for 
I from 0 to (SUB1 (ITIMES 400Q 4)) by 2 do (I.PUTBASEPTR VALBASE I (I.\COPY (QUOTE NOBIND)))))))

(I.\GCPNAMES

(LAMBDA NIL (*) (PROG ((VP (ADD1 I.CurPnPage))) (COND ((IGREATERP VP 3777Q) (HELP 
"Out of atom p-name space"))) (MKI.NEWPAGE (I.VAG2 (IPLUS 30Q (LRSH VP 10Q)) (LLSH (LOGAND VP 377Q) 
10Q))) (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 (IPLUS NBYTES -1)))) (\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 (IPLUS DBN 1))) (I.\GETBASEBYTE SB (PROG1 SBN (SETQ SBN (IPLUS 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 30Q 0) 1) (I.CREATEPAGES (I.VAG2 24Q
 0) 200Q) (SETQ I.SCRATCHSTRING (I.ALLOCSTRING 177Q)) (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 377Q when (OR (ILESSP C 60Q) (IGEQ C 72Q)) 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 \DTESTFAIL)) (*) (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)) 400Q) (HELP (
FUNCTION \INTERPRETER) " not atom 400Q")) (I.COPYATOM (FUNCTION MAKEFLOATNUMBER)) (*))))
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: I.\MKATOM I.\MKATOM I.NewAtom I.\MOVEBYTES (NOLINKFNS . T))
]
(DEFINEQ

(I.INITUFNTABLE

(LAMBDA NIL (*) (for I from 0 to 377Q do (I.SETUFNENTRY I (QUOTE \UNKNOWN.UFN) 0 0)) (for X in 
\OPCODES when (CADDDR (CDDDR X)) do (I.SETUFNENTRY (CAR X) (CADDDR (CDDDR X)) (IDIFFERENCE (IPLUS 1 (
COND ((ZEROP (CADDR X)) 0) (T 1))) (CADDDR (CDR X))) (CADDR X)))))

(I.SETUFNENTRY

(LAMBDA (INDEX FN NARGS NEXTRA) (*) (SETQ INDEX (I.ADDBASE (I.VAG2 26Q 123000Q) (LLSH INDEX 1))) (
I.PUTBASE INDEX 0 (I.ATOMNUMBER FN)) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 1 (LOGOR (LOGAND 
(I.GETBASE $$PUTBITS 1) 377Q) (LLSH NEXTRA 10Q)))) INDEX) 10Q) (LOGAND ((LAMBDA ($$PUTBITS) (I.PUTBASE
 $$PUTBITS 1 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 1) 177400Q) (LOGAND NARGS 377Q)))) INDEX) 377Q)))
)
(DEFINEQ

(I.MAKEINITFIRST

(LAMBDA NIL (*) (I.CREATEMDSTYPETABLE) (I.INITDATATYPES) (I.PREINITARRAYS) (I.INITATOMS) (
I.INITDATATYPENAMES) (I.INITUFNTABLE) (I.INITGC) (MKI.NEWPAGE (I.VAG2 26Q 10000Q) 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 
-200001Q) (*) (RETURN (I.ADDBASE (I.VAG2 17Q 0) (LOGAND X 177777Q)))))) ((ILESSP X 200000Q) (*) (
RETURN (I.ADDBASE (I.VAG2 16Q 0) X)))) (*) (SETQ V (I.\CREATECELL 2)) (I.PUTBASE V 0 (LOGOR (COND ((
IGREATERP 0 X) 100000Q) (T 0)) (LOGAND (LRSH X 20Q) 77777Q))) (I.PUTBASE V 1 (LOGAND X 177777Q)) (
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 NIL (*) (I.SETUPSTACK T) (I.MAKEINITBFS) (I.\MAKEMDSENTRY (IPLUS (LLSH (I.HILOC (I.VAG2 26Q 
122000Q)) 10Q) (LRSH (I.LOLOC (I.VAG2 26Q 122000Q)) 10Q)) 2) (*) (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))) (*) (SETQ MKI.CODELASTPAGE (IPLUS (LLSH (I.HILOC AFL) 
10Q) (LRSH (I.LOLOC AFL) 10Q))) (BOUTZEROS (IDIFFERENCE 1000Q (LLSH (LOGAND (I.LOLOC AFL) 377Q) 1))) (
*) (I.POSTINITARRAYS AFL (IPLUS (LLSH 40Q 10Q) MKI.CODESTARTOFFSET))) (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 -200000Q
) (ILEQ A 177777Q))) (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 
MKI.CODESTARTOFFSET MKI.CODELASTPAGE)))
)
(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 ((NULL Y) ((LAMBDA (PAGEA0100) (DECLARE (LOCALVARS PAGEA0100)) (PROG ((.MK.NEWCELL
 (I.ADDBASE PAGEA0100 (LOGAND (I.GETBASE PAGEA0100 0) 377Q)))) (*) (LOGAND ((LAMBDA ($$PUTBITS) (
I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 177400Q) (LOGAND (LRSH (I.GETBASE 
.MK.NEWCELL 0) 10Q) 377Q)))) PAGEA0100) 377Q) (*) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (
LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 377Q) (LLSH (IPLUS (PROGN (LRSH (I.GETBASE PAGEA0100 0) 10Q)) -1
) 10Q)))) PAGEA0100) 10Q) (I.PUTBASEPTR .MK.NEWCELL 0 X) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE 
$$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 377Q) (LLSH 200Q 10Q)))) .MK.NEWCELL) 10Q) (RETURN 
.MK.NEWCELL))) (I.\NEXTCONSPAGE))) ((AND (EQ (I.NTYPX Y) 5) (IGREATERP (LRSH (I.GETBASE (SETQ CNS.PAGE
 (I.VAG2 (I.HILOC Y) (LOGAND (I.LOLOC Y) 177400Q))) 0) 10Q) 0)) (*) ((LAMBDA (PAGE A D) (DECLARE (
LOCALVARS PAGE A D)) (PROG ((.MK.NEWCELL (I.ADDBASE PAGE (LOGAND (I.GETBASE PAGE 0) 377Q)))) (*) (
LOGAND ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 177400Q) (
LOGAND (LRSH (I.GETBASE .MK.NEWCELL 0) 10Q) 377Q)))) PAGE) 377Q) (*) (LRSH ((LAMBDA ($$PUTBITS) (
I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 377Q) (LLSH (IPLUS (PROGN (LRSH (
I.GETBASE PAGE 0) 10Q)) -1) 10Q)))) PAGE) 10Q) (I.PUTBASEPTR .MK.NEWCELL 0 A) (LRSH ((LAMBDA (
$$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 377Q) (LLSH D 10Q)))) 
.MK.NEWCELL) 10Q) (RETURN .MK.NEWCELL))) CNS.PAGE X (IPLUS 200Q (LRSH (LOGAND (I.LOLOC Y) 377Q) 1)))) 
(T ((LAMBDA (PAGE A D) (DECLARE (LOCALVARS PAGE A D)) (PROG ((.MK.NEWCELL (I.ADDBASE PAGE (LOGAND (
I.GETBASE PAGE 0) 377Q)))) (*) (LOGAND ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (
I.GETBASE $$PUTBITS 0) 177400Q) (LOGAND (LRSH (I.GETBASE .MK.NEWCELL 0) 10Q) 377Q)))) PAGE) 377Q) (*) 
(LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 377Q) (LLSH (
IPLUS (PROGN (LRSH (I.GETBASE PAGE 0) 10Q)) -1) 10Q)))) PAGE) 10Q) (I.PUTBASEPTR .MK.NEWCELL 0 A) (
LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 377Q) (LLSH D 
10Q)))) .MK.NEWCELL) 10Q) (RETURN .MK.NEWCELL))) (SETQ CNS.PAGE (I.\NEXTCONSPAGE)) X (IPLUS 0 (LRSH (
LOGAND (I.LOLOC (PROGN (PROGN (PROGN (PROG ((.MK.NEWCELL (I.ADDBASE CNS.PAGE (LOGAND (I.GETBASE 
CNS.PAGE 0) 377Q)))) (*) (LOGAND ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE
 $$PUTBITS 0) 177400Q) (LOGAND (LRSH (I.GETBASE .MK.NEWCELL 0) 10Q) 377Q)))) CNS.PAGE) 377Q) (*) (LRSH
 ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 377Q) (LLSH (IPLUS
 (PROGN (LRSH (I.GETBASE CNS.PAGE 0) 10Q)) -1) 10Q)))) CNS.PAGE) 10Q) (I.PUTBASEPTR .MK.NEWCELL 0 Y) (
LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 377Q) (LLSH 0 
10Q)))) .MK.NEWCELL) 10Q) (RETURN .MK.NEWCELL)))))) 377Q) 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) 177400Q) (LOGAND 376Q 377Q)))) BASE) 377Q)) 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) 377Q) (LLSH (SETQ J (IDIFFERENCE J 2))
 10Q)))) CELL) 10Q) (GO LP))) (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (
I.GETBASE $$PUTBITS 0) 377Q) (LLSH 177Q 10Q)))) BASE) 10Q) (*) (I.PUTBASE BASE 1 (IPLUS (LLSH (I.HILOC
 LINK) 10Q) (LRSH (I.LOLOC LINK) 10Q))) (RETURN BASE))))))

(I.\NEXTCONSPAGE

(LAMBDA NIL (*) (PROG (PG N) LP (COND ((ZEROP (SETQ N (I.GETBASE I.LISTPDTD 15Q))) (SETQ PG (
I.\ALLOCMDSPAGE 5)) (I.\INITCONSPAGE PG (I.\INITCONSPAGE (I.ADDBASE PG 400Q) NIL)) (I.PUTBASE 
I.LISTPDTD 15Q (SETQ N (IPLUS (LLSH (I.HILOC PG) 10Q) (LRSH (I.LOLOC PG) 10Q)))))) (COND ((IGREATERP (
SETQ N (LRSH (I.GETBASE (SETQ PG ((LAMBDA ($$1) (I.VAG2 (LRSH (SETQ $$1 N) 10Q) (LLSH (LOGAND $$1 377Q
) 10Q))) NIL)) 0) 10Q)) 1) (RETURN PG))) (SETQ N (I.GETBASE PG 1)) (I.PUTBASE PG 1 177777Q) (*) (
I.PUTBASE I.LISTPDTD 15Q N) (GO LP))))
)
(DEFINEQ

(I.\GETBASEBYTE

(LAMBDA (PTR N) (*) (*) (COND ((ZEROP (LOGAND N 1)) (LRSH (PROGN (I.GETBASE PTR (LRSH N 1))) 10Q)) (T 
(LOGAND (PROGN (I.GETBASE PTR (LRSH N 1))) 377Q)))))

(I.\PUTBASEBYTE

(LAMBDA (PTR DISP BYTE) (*) (*) (I.PUTBASE PTR (LRSH DISP 1) (SELECTQ (LOGAND DISP 1) (0 ((LAMBDA ($$1
) (IPLUS (LLSH (SETQ BYTE (PROG1 BYTE)) 10Q) (LOGAND $$1 377Q))) (I.GETBASE PTR (LRSH DISP 1)))) ((
LAMBDA ($$1) (IPLUS (LLSH (LRSH $$1 10Q) 10Q) 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 10Q)) NIL LOCKFLG BLANKFLG)) VA))

(I.\NEW4PAGE

(LAMBDA (PTR) (*) (MKI.NEWPAGE (I.ADDBASE (MKI.NEWPAGE (I.ADDBASE (MKI.NEWPAGE (I.ADDBASE (MKI.NEWPAGE
 PTR) 400Q)) 400Q)) 400Q))))
)
(DEFINEQ

(I.ALLOCSTRING

(LAMBDA (N INITCHAR OLD) (*) (SETQ N (FIX N)) (*) (COND ((OR (ILESSP N 0) (IGREATERP N 177777Q)) (
LISPERROR "ILLEGAL ARG" N))) (PROG ((B (I.\ALLOCBLOCK (LRSH (IPLUS N 3) 2)))) (*) (COND ((STRINGP OLD)
 (PROGN ((LAMBDA (DATUMA0107) (DECLARE (LOCALVARS DATUMA0107)) (PROG1 DATUMA0107 (LRSH ((LAMBDA (
$$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 77777Q) (LLSH 1 17Q)))) 
DATUMA0107) 17Q))) ((LAMBDA (DATUMA0113) (DECLARE (LOCALVARS DATUMA0113)) (PROG1 DATUMA0113 (LOGAND (
LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 137777Q) (LLSH
 (LOGAND 1 1) 16Q)))) DATUMA0113) 16Q) 1))) ((LAMBDA (DATUMA0118) (DECLARE (LOCALVARS DATUMA0118)) (
PROG1 DATUMA0118 (NEQ (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (
I.GETBASE $$PUTBITS 0) 157777Q) (LLSH (LOGAND (COND (NIL 1) (T 0)) 1) 15Q)))) DATUMA0118) 15Q) 1) 0)))
 ((LAMBDA (DATUMA0122) (DECLARE (LOCALVARS DATUMA0122)) (PROG1 DATUMA0122 (LOGAND (LRSH ((LAMBDA (
$$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 137777Q) (LLSH (LOGAND 1 1) 
16Q)))) DATUMA0122) 16Q) 1))) ((LAMBDA (DATUMA0125) (DECLARE (LOCALVARS DATUMA0125)) (PROG1 DATUMA0125
 (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 
170377Q) (LLSH (LOGAND 0 17Q) 10Q)))) DATUMA0125) 10Q) 17Q))) ((LAMBDA (DATUMA0127) (DECLARE (
LOCALVARS DATUMA0127)) (PROG1 DATUMA0127 (I.PUTBASE DATUMA0127 3 0))) ((LAMBDA (DATUMA0128) (DECLARE (
LOCALVARS DATUMA0128)) (PROG1 DATUMA0128 (I.PUTBASEPTR DATUMA0128 0 B))) (PROG1 OLD (I.PUTBASE (\DTEST
 OLD (QUOTE STRINGP)) 2 N))))))))))) (T (SETQ OLD ((LAMBDA (DATUMA0132) (DECLARE (LOCALVARS DATUMA0132
)) (PROG1 DATUMA0132 (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE 
$$PUTBITS 0) 77777Q) (LLSH 1 17Q)))) DATUMA0132) 17Q))) ((LAMBDA (DATUMA0135) (DECLARE (LOCALVARS 
DATUMA0135)) (PROG1 DATUMA0135 (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (
LOGAND (I.GETBASE $$PUTBITS 0) 170377Q) (LLSH (LOGAND 0 17Q) 10Q)))) DATUMA0135) 10Q) 17Q))) ((LAMBDA 
(DATUMA0137) (DECLARE (LOCALVARS DATUMA0137)) (PROG1 DATUMA0137 (I.PUTBASEPTR DATUMA0137 0 B))) ((
LAMBDA (DATUMA0138) (DECLARE (LOCALVARS DATUMA0138)) (PROG1 DATUMA0138 (I.PUTBASE DATUMA0138 2 N))) (
I.\CREATECELL 7))))))))) (*) (COND ((AND INITCHAR (NEQ 0 (SETQ INITCHAR (LOGAND (OR (SMALLP INITCHAR) 
(CHCON1 INITCHAR)) \CHARMASK)))) (for I (OBASE ← (I.GETBASEPTR OLD 0)) from 0 to (SUB1 N) do (
I.\PUTBASEBYTE OBASE I INITCHAR)))) OLD))

(I.\ALLOCBLOCK

(LAMBDA (NCELLS GCTYPE ALIGN) (*) (*) (DECLARE (GLOBALVARS I.ArrayFrLst)) (COND ((IGREATERP NCELLS 0) 
(COND ((ILESSP NCELLS 2) (SETQ NCELLS 2)) ((IGREATERP NCELLS 177775Q) (ERROR 
"ARRAY STORAGE BLOCK TOO LARGE" NCELLS))) (*) (PROG (BLOCK (ARLEN (IPLUS NCELLS 2))) (*) RETRY (PROGN 
(SETQ BLOCK (COND ((NILL ARLEN ALIGN)) ((I.\ALLOCNEWBLOCK ARLEN ALIGN)) (T (RECLAIM) (*) (OR (NILL 
ARLEN ALIGN) (GO FULL))))) (*) (NEQ (LOGAND ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND
 (I.GETBASE $$PUTBITS 0) 177776Q) (LOGAND (COND (T 1) (T 0)) 1)))) BLOCK) 1) 0) (NEQ (LOGAND ((LAMBDA 
($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 177776Q) (LOGAND (COND (T 1)
 (T 0)) 1)))) ((LAMBDA (BASE N) (DECLARE (LOCALVARS BASE N)) (I.ADDBASE (I.ADDBASE BASE N) N)) BLOCK (
IDIFFERENCE (I.GETBASE BLOCK 1) 1))) 1) 0) (LOGAND (LRSH ((LAMBDA ($$PUTBITS) (I.PUTBASE $$PUTBITS 0 (
LOGOR (LOGAND (I.GETBASE $$PUTBITS 0) 177771Q) (LLSH (LOGAND (SELECTQ GCTYPE (NIL 0) (T (*) 1) GCTYPE)
 3) 1)))) BLOCK) 1) 3) (PROGN NCELLS) (*) (SETQ BLOCK (I.ADDBASE BLOCK 2)) (PROGN BLOCK) (RETURN BLOCK
)) FULL (LISPERROR "ARRAYS FULL" NIL T) (*) (GO RETRY))))))

(I.\ALLOCNEWBLOCK

(LAMBDA (ARLEN ALIGN) (*) (DECLARE (GLOBALVARS I.ArrayFrLst I.NxtArrayPage)) (*) (COND (ALIGN (*) (
PROG (NLEFT (DATAWORD (I.ADDBASE I.ArrayFrLst 2))) (COND ((NEQ 2 (SETQ NLEFT (IDIFFERENCE 2 (IMOD (
LRSH (LOGAND (I.LOLOC DATAWORD) 377Q) 1) 2)))) (I.\PATCHBLOCK NLEFT) (SETQ DATAWORD (I.ADDBASE 
I.ArrayFrLst 2)))) (COND ((IGREATERP ALIGN (SETQ NLEFT (IDIFFERENCE 200Q (LRSH (LOGAND (I.LOLOC 
DATAWORD) 377Q) 1)))) (*) (I.\PATCHBLOCK NLEFT) (SETQ DATAWORD (I.ADDBASE I.ArrayFrLst 2)))) (*) (COND
 ((IGREATERP (IDIFFERENCE ARLEN 2) (SETQ NLEFT (IDIFFERENCE 100000Q (LRSH (I.LOLOC DATAWORD) 1)))) (*)
 (I.\PATCHBLOCK NLEFT) (SETQ DATAWORD (I.ADDBASE I.ArrayFrLst 2)))) (*)))) (PROG (FINALPAGE FINALWORD 
TRAILER (NEXTFREEBLOCK (I.ADDBASE (I.ADDBASE I.ArrayFrLst ARLEN) ARLEN))) (SETQ FINALWORD (I.ADDBASE 
NEXTFREEBLOCK -1)) (*) (COND ((IGREATERP (SETQ FINALPAGE (IPLUS (LLSH (I.HILOC FINALWORD) 10Q) (LRSH (
I.LOLOC FINALWORD) 10Q))) (IPLUS (LLSH 40Q 10Q) 15377Q)) (*) (RETURN NIL))) (SETQ TRAILER (I.ADDBASE 
NEXTFREEBLOCK (IMINUS 2))) LP (COND ((IGREATERP I.NxtArrayPage FINALPAGE) (*) (I.PUTBASE I.ArrayFrLst 
0 125250Q) (I.PUTBASE I.ArrayFrLst 1 ARLEN) (COND ((IGREATERP ARLEN 1) (*) (I.PUTBASE TRAILER 0 
125250Q) (I.PUTBASE TRAILER 1 ARLEN))) (RETURN (PROG1 I.ArrayFrLst (SETQ I.ArrayFrLst NEXTFREEBLOCK)))
)) (MKI.NEWPAGE ((LAMBDA ($$1) (I.VAG2 (LRSH (SETQ $$1 I.NxtArrayPage) 10Q) (LLSH (LOGAND $$1 377Q) 
10Q))) NIL)) (SETQ I.NxtArrayPage (ADD1 I.NxtArrayPage)) (GO LP))))

(I.\LINKBLOCK

(LAMBDA (BASE) (*) (*) (DECLARE (GLOBALVARS I.FREEBLOCKLIST)) (COND ((IGEQ (I.GETBASE BASE 1) 4) (COND
 ((NULL I.FREEBLOCKLIST) (I.PUTBASEPTR BASE 2 BASE) (I.PUTBASEPTR BASE 4 BASE)) (T (I.PUTBASEPTR BASE 
2 I.FREEBLOCKLIST) (I.PUTBASEPTR BASE 4 (I.GETBASEPTR I.FREEBLOCKLIST 4)) (I.PUTBASEPTR (I.GETBASEPTR 
I.FREEBLOCKLIST 4) 2 BASE) (I.PUTBASEPTR I.FREEBLOCKLIST 4 BASE))) (SETQ I.FREEBLOCKLIST BASE)))))

(I.\MERGEBACKWARD

(LAMBDA (BASE) (*) (*) (DECLARE (GLOBALVARS MERGEBACKFLAG)) (COND ((AND (NEQ BASE (I.VAG2 40Q 0)) (NOT
 (NOT (ZEROP (LOGAND (I.GETBASE (I.ADDBASE BASE (IMINUS 2)) 0) 1))))) (PROG (PBASE PL (PTRAIL (
I.ADDBASE BASE (IMINUS 2))) (L (I.GETBASE BASE 1))) (OR (IEQ 12525Q (LRSH (I.GETBASE PTRAIL 0) 3)) (
HELP "Bad array block")) (SETQ PL (I.GETBASE PTRAIL 1)) (COND ((IGREATERP PL (IDIFFERENCE 177777Q L)) 
(*) (I.\LINKBLOCK BASE) (RETURN BASE))) (SETQ PBASE ((LAMBDA (BASE N) (DECLARE (LOCALVARS BASE N)) (
I.ADDBASE (I.ADDBASE BASE N) N)) BASE (IMINUS PL))) (I.PUTBASE PBASE 1 (SETQ L (IPLUS L PL))) (
I.PUTBASE ((LAMBDA (BASE N) (DECLARE (LOCALVARS BASE N)) (I.ADDBASE (I.ADDBASE BASE N) N)) PBASE (
IDIFFERENCE (I.GETBASE PBASE 1) 1)) 1 L) (*) (COND ((OR (ILESSP PL 4) (NULL (I.GETBASEPTR PBASE 2))) (
*) (I.\LINKBLOCK PBASE))) (RETURN PBASE))) (T (I.\LINKBLOCK BASE) BASE))))

(I.\PATCHBLOCK

(LAMBDA (ARLEN) (*) (*) (I.\MERGEBACKWARD (I.\ALLOCNEWBLOCK ARLEN))))
)
(DEFINEQ

(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))))

(I.PREINITARRAYS

(LAMBDA NIL (*) (*) (DECLARE (GLOBALVARS I.FREEBLOCKLIST I.ArrayFrLst I.NxtArrayPage)) (SETQ 
I.ArrayFrLst (I.VAG2 40Q 0)) (SETQ I.NxtArrayPage (IPLUS (LLSH (I.HILOC I.ArrayFrLst) 10Q) (LRSH (
I.LOLOC I.ArrayFrLst) 10Q))) (SETQ I.FREEBLOCKLIST NIL)))

(I.POSTINITARRAYS

(LAMBDA (AFTERCODEPTR CODESTARTPAGE) (*) (*) (PROG ((EXTRACELLS (IDIFFERENCE (LLSH CODESTARTPAGE 7) (
IPLUS (LLSH (I.HILOC I.ArrayFrLst) 17Q) (LRSH (I.LOLOC I.ArrayFrLst) 1))))) (*) (COND ((IGREATERP 
EXTRACELLS 177777Q) (printout T T T "POSTINITARRAYS:  You pre-allocated too much string space." T 23Q 
"MKI.CODESTARTOFFSET on MAKEINIT should be reduced by about " (IDIFFERENCE (LRSH EXTRACELLS 7) 12Q) 
"." 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 23Q "You should add at least " (ADD1 (
LRSH (IMINUS EXTRACELLS) 7)) " to MKI.CODESTARTOFFSET on MAKEINIT." T) (HELP))) (*) (I.\PATCHBLOCK 
EXTRACELLS) (SETQ I.ArrayFrLst AFTERCODEPTR) (SETQ I.NxtArrayPage (ADD1 (IPLUS (LLSH (I.HILOC 
I.ArrayFrLst) 10Q) (LRSH (I.LOLOC I.ArrayFrLst) 10Q)))))))

(I.FILEARRAYBASE

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

(I.FILEBLOCKTRAILER

(LAMBDA (BLOCKINFO) (*) (*) (BOUT16 OUTX 125251Q) (BOUT16 OUTX BLOCKINFO)))

(I.FILECODEBLOCK

(LAMBDA (NCELLS ALIGNED) (*) (*) (PROG (NLEFT (DATAWORD (I.ADDBASE (I.FILEARRAYBASE) 2)) (ARLEN (IPLUS
 NCELLS 2))) (*) (COND ((NEQ 2 (SETQ NLEFT (IDIFFERENCE 2 (IMOD (LRSH (LOGAND (I.LOLOC DATAWORD) 377Q)
 1) 2)))) (I.FILEPATCHBLOCK NLEFT) (SETQ DATAWORD (I.ADDBASE (I.FILEARRAYBASE) 2)))) (COND ((IGREATERP
 ALIGNED (SETQ NLEFT (IDIFFERENCE 200Q (LRSH (LOGAND (I.LOLOC DATAWORD) 377Q) 1)))) (*) (
I.FILEPATCHBLOCK NLEFT) (SETQ DATAWORD (I.ADDBASE (I.FILEARRAYBASE) 2)))) (COND ((IGREATERP NCELLS (
SETQ NLEFT (IDIFFERENCE 100000Q (LRSH (I.LOLOC DATAWORD) 1)))) (I.FILEPATCHBLOCK NLEFT) (SETQ DATAWORD
 (I.ADDBASE (I.FILEARRAYBASE) 2)))) (BOUT16 OUTX 125255Q) (BOUT16 OUTX ARLEN) (RETURN ARLEN))))

(I.FILEPATCHBLOCK

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

(I.DCODERD

(LAMBDA (FN) (*) (READC) (PROG ((COFD (GETOFD))) (PROG ((NAMETABLE (PROG1 (READ NIL CODERDTBL) (READC)
)) (CODELEN (IPLUS (LLSH (\BIN COFD) 10Q) (\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 (IPLUS 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 10Q) 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 (IPLUS STARTPC (LLSH LOCALSIZE 1))))) (SETQ REALSIZE (LOGAND (IPLUS (
IPLUS STARTPC CODELEN) (CONSTANT (SUB1 10Q))) (CONSTANT (LOGXOR (SUB1 10Q) -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 10Q) 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 100000Q)) (F (OR FVAROFFSET (SETQ FVAROFFSET (LRSH NT1 1))) (*) (CONSTANT 140000Q)
) (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 (DEF LC VALUE) (
\BYTESETA DEF LC (LRSH VALUE 10Q)) (\BYTESETA DEF (ADD1 LC) (LOGAND VALUE 377Q))) CA 2 (LOGAND (PROGN 
(COND ((EQ ARGTYPE 2) -1) (T NARGS))) (CONSTANT (SUB1 (LLSH 1 20Q))))) ((LAMBDA (DEF LC VALUE) (
\BYTESETA DEF LC (LRSH VALUE 10Q)) (\BYTESETA DEF (ADD1 LC) (LOGAND VALUE 377Q))) CA 4 (LOGAND (PROGN 
(SUB1 (LRSH (IPLUS (IPLUS NLOCALS NFREEVARS) 1) 1))) (CONSTANT (SUB1 (LLSH 1 20Q))))) ((LAMBDA (DEF LC
 VALUE) (\BYTESETA DEF LC (LRSH VALUE 10Q)) (\BYTESETA DEF (ADD1 LC) (LOGAND VALUE 377Q))) CA 6 
STARTPC) (\BYTESETA CA 10Q (LOGOR (LOGAND (\BYTELT CA 10Q) 177717Q) (LLSH (LOGAND ARGTYPE 3) 4))) (
I.FIXUPPTR CA 13Q (I.\COPY FRAMENAME)) ((LAMBDA (DEF LC VALUE) (\BYTESETA DEF LC (LRSH VALUE 10Q)) (
\BYTESETA DEF (ADD1 LC) (LOGAND VALUE 377Q))) CA 14Q NTSIZE) (\BYTESETA CA 16Q NLOCALS) (\BYTESETA CA 
17Q (PROGN (OR FVAROFFSET 0))) ((LAMBDA (DEF LC VALUE) (\BYTESETA DEF LC (LRSH VALUE 10Q)) (\BYTESETA 
DEF (ADD1 LC) (LOGAND VALUE 377Q))) CA 0 (PROGN (IPLUS (LLSH (IPLUS ((LAMBDA (X) (DECLARE (LOCALVARS
 . T)) (COND ((IGREATERP X (SUB1 (LLSH 1 (SUB1 20Q)))) (SUB1 (IDIFFERENCE X (SUB1 (LLSH 1 20Q))))) (T 
X))) ((LAMBDA (DEF LC) (IPLUS (LLSH (\BYTELT DEF LC) 10Q) (\BYTELT DEF (ADD1 LC)))) CA 2)) (LLSH (ADD1
 ((LAMBDA (X) (DECLARE (LOCALVARS . T)) (COND ((IGREATERP X (SUB1 (LLSH 1 (SUB1 20Q)))) (SUB1 (
IDIFFERENCE X (SUB1 (LLSH 1 20Q))))) (T X))) ((LAMBDA (DEF LC) (IPLUS (LLSH (\BYTELT DEF LC) 10Q) (
\BYTELT DEF (ADD1 LC)))) CA 4))) 1)) 1) 14Q 40Q)))) (for X on (READ NIL CODERDTBL) by (CDDR X) do (
I.FIXUPNUM CA (IPLUS (CAR X) STARTPC) (I.ATOMNUMBER (CADR X)) -1)) (for X on (READ NIL CODERDTBL) by (
CDDR X) do (I.FIXUPNUM CA (IPLUS (CAR X) STARTPC) (I.ATOMNUMBER (CADR X)) -1)) (for X on (READ NIL 
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 NIL \CAR.UFN) (2 CDR 0 T 0 NIL \CDR.UFN) (3 LISTP 0 T 0 NIL 
LISTP) (4 NTYPX 0 T 0 NIL NTYPX) (5 TYPEP 1 TYPEP 0) (6 DTEST 2 ATOM 0 NIL \DTESTFAIL) (7 CDDR 0 T 0 
NIL CDDR) (10Q FN0 2 FN 1) (11Q FN1 2 FN 0) (12Q FN2 2 FN -1) (13Q FN3 2 FN -2) (14Q FN4 2 FN -3) (15Q
 FNX 3 FNX FNX) (16Q APPLYFN 0 T -1) (17Q CHECKAPPLY* 0 T 0 NIL \CHECKAPPLY*) (20Q RETURN 0 T 0 NIL 
\HARDRETURN) (21Q BIND 2) (22Q UNBIND 0) (23Q DUNBIND 0) (24Q RPLPTR.N 1 T -1 NIL \RPLPTR.UFN) (25Q 
GCREF 1 T 0 NIL \HTFIND) (26Q was.htfind 0 T) (27Q GVAR← 2 ATOM 0 NIL \SETGLOBALVAL.UFN) (30Q RPLACA 0
 T -1 NIL \RPLACA.UFN) (31Q RPLACD 0 T -1 NIL \RPLACD.UFN) (32Q CONS 0 T -1 NIL \CONS.UFN) (33Q GETP 0
 T -1 NIL GETPROP) (34Q FMEMB 0 T -1 NIL FMEMB) (35Q GETHASH 0 T -1 NIL GETHASH) (36Q PUTHASH 0 T -2 
NIL PUTHASH) (37Q CREATECELL 0 T 0 NIL \CREATECELL) (40Q BIN 0 T 0 NIL \BIN) (41Q BOUT 0 T -1 NIL 
\BOUT) (42Q BITBLT 0 T -1 NIL BitBltSUBR) (43Q LIST1 0 T 0 NIL CONS) (44Q DOCOLLECT 0 T -1 NIL 
DOCOLLECT) (45Q ENDCOLLECT 0 T -1 NIL ENDCOLLECT) (46Q RPLCONS 0 T -1 NIL \RPLCONS) (47Q unused) (50Q 
ELT 0 T -1 NIL ELT) (51Q NTHCHC 0 T -1 NIL NTHCHARCODE) (52Q SETA 0 T -2 NIL SETA) (53Q RPLCHARCODE 0 
T -2 NIL RPLCHARCODE) (54Q EVAL 0 T 0 NIL \EVAL) (55Q EVALV 0 T 0 NIL \EVALV1) (56Q unused) (57Q 
STKSCAN 0 T 0 NIL \STKSCAN) (60Q unused NIL NIL NIL 73Q) (74Q STORE.N 1 T 0) (75Q COPY.N 1 T 1) (76Q 
RAID 0 T 0 NIL RAID) (77Q \RETURN 0 T 0 NIL \RETURN) (100Q IVAR 0 IVAR 1 106Q) (107Q IVARX 1 IVAR 1) (
110Q PVAR 0 PVAR 1 116Q) (117Q PVARX 1 PVAR 1) (120Q FVAR 0 FVAR 1 126Q) (127Q FVARX 1 FVAR 1) (130Q 
PVAR← 0 PVAR 0 136Q) (137Q PVARX← 1 PVAR 0) (140Q GVAR 2 ATOM 1) (141Q ARG0 0 T 0 NIL \ARG0) (142Q 
IVARX← 1 IVAR 0) (143Q FVARX← 1 FVAR 0) (144Q COPY 0 T 1) (145Q MYARGCOUNT 0 T 1 NIL \MYARGCOUNT) (
146Q MYALINK 0 T 1) (147Q ACONST 2 ATOM 1) (150Q 'NIL 0 T 1) (151Q 'T 0 T 1) (152Q '0 0 T 1) (153Q '1 
0 T 1) (154Q SIC 1 SIC 1) (155Q SNIC 1 SNIC 1) (156Q SICX 2 SICX 1) (157Q GCONST 3 GCONST 1) (160Q 
ATOMNUMBER 2 ATOM 1) (161Q READFLAGS 0 T 0 NIL \READFLAGS) (162Q READRP 0 T 0 NIL \READRP) (163Q 
WRITEMAP 0 T -2 NIL \WRITEMAP) (164Q READPRINTERPORT 0 T 1 NIL NILL) (165Q WRITEPRINTERPORT 0 T 0 NIL 
NILL) (166Q PILOTBITBLT 0 T -1 NIL \PILOTBITBLT) (167Q RCLK 0 T 0 NIL \RCLKSUBR) (170Q MISC1 1 T 0 NIL
 \MISC1.UFN) (171Q MISC2 1 T -1 NIL \MISC2.UFN) (172Q RECLAIMCELL 0 T 0 NIL \GCRECLAIMCELL) (173Q 
GCSCAN1 0 T 0 NIL \GCSCAN1) (174Q GCSCAN2 0 T 0 NIL \GCSCAN2) (175Q SUBRCALL 2) (176Q CONTEXTSWITCH 0 
T 0 NIL \CONTEXTSWITCH) (177Q AUDIO 0 T 0 NIL NILL) (200Q JUMP 0 JUMP JUMP 217Q) (220Q FJUMP 0 JUMP 
CJUMP 237Q) (240Q TJUMP 0 JUMP CJUMP 257Q) (260Q JUMPX 1 JUMPX JUMP) (261Q JUMPXX 2 JUMPXX JUMP) (262Q
 FJUMPX 1 JUMPX CJUMP) (263Q TJUMPX 1 JUMPX CJUMP) (264Q NFJUMPX 1 JUMPX NCJUMP) (265Q NTJUMPX 1 JUMPX
 NCJUMP) (266Q jeq) (267Q jlistp) (270Q PVAR←↑ 0 PVAR -1 276Q) (277Q POP 0 T -1) (300Q was.getbase) (
301Q was.getbaseptr) (302Q GETBASEBYTE 0 T -1 NIL \GETBASEBYTE) (303Q was.scanbase) (304Q BLT 0 T -2 
NIL \BLT) (305Q was.putbase) (306Q was.putbaseptr) (307Q PUTBASEBYTE 0 T -2 NIL \PUTBASEBYTE) (310Q 
GETBASE.N 1 T 0) (311Q GETBASEPTR.N 1 T 0) (312Q GETBITS.N.FD 2 T 0) (313Q unused) (314Q unused) (315Q
 PUTBASE.N 1 T -1 NIL \PUTBASE.UFN) (316Q PUTBASEPTR.N 1 T -1 NIL \PUTBASEPTR.UFN) (317Q PUTBITS.N.FD 
2 T -1 NIL \PUTBITS.UFN) (320Q ADDBASE 0 T -1 NIL \ADDBASE) (321Q VAG2 0 T -1 NIL \VAG2) (322Q HILOC 0
 T 0) (323Q LOLOC 0 T 0) (324Q PLUS2 0 T -1 NIL PLUS) (325Q DIFFERENCE 0 T -1 NIL DIFFERENCE) (326Q 
TIMES2 0 T -1 NIL TIMES) (327Q QUOTIENT 0 T -1 NIL QUOTIENT) (330Q IPLUS2 0 T -1 NIL \SLOWIPLUS2) (
331Q IDIFFERENCE 0 T -1 NIL \SLOWIDIFFERENCE) (332Q ITIMES2 0 T -1 NIL \SLOWITIMES2) (333Q IQUOTIENT 0
 T -1 NIL \SLOWIQUOTIENT) (334Q IREMAINDER 0 T -1 NIL IREMAINDER) (335Q IPLUS.N 1 T 0 NIL \SLOWIPLUS2)
 (336Q IDIFFERENCE.N 1 T 0 NIL \SLOWIDIFFERENCE) (337Q unused) (340Q LLSH1 0 T 0 NIL \SLOWLLSH1) (341Q
 LLSH8 0 T 0 NIL \SLOWLLSH8) (342Q LRSH1 0 T 0 NIL \SLOWLRSH1) (343Q LRSH8 0 T 0 NIL \SLOWLRSH8) (344Q
 LOGOR2 0 T -1 NIL \SLOWLOGOR2) (345Q LOGAND2 0 T -1 NIL \SLOWLOGAND2) (346Q LOGXOR2 0 T -1 NIL 
\SLOWLOGXOR2) (347Q unused) (350Q FPLUS2 0 T -1 NIL FPLUS2) (351Q FDIFFERENCE 0 T -1 NIL FDIFFERENCE) 
(352Q FTIMES2 0 T -1 NIL FTIMES2) (353Q FQUOTIENT 0 T -1 NIL FQUOTIENT) (354Q unused NIL NIL NIL 357Q)
 (360Q EQ 0 T -1) (361Q IGREATERP 0 T -1 NIL \SLOWIGREATERP) (362Q FGREATERP 0 T -1 NIL FGREATERP) (
363Q GREATERP 0 T -1 NIL GREATERP) (364Q unused) (365Q MAKENUMBER 0 T -1 NIL \MAKENUMBER) (366Q 
BOXIPLUS 0 T -1 NIL \BOXIPLUS) (367Q BOXIDIFFERENCE 0 T -1 NIL \BOXIDIFFERENCE) (370Q unused NIL NIL 
NIL 374Q) (375Q SWAP 0 T 0) (376Q NOP 0 T 0) (377Q UPCTRACE 0 T 0 NIL NILL)))

(RPAQQ CODERDTBL
 NIL)

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

(RPAQQ INITVALUES
 ((\NxtMDSPage 400Q) (\MaxSysTypeNum 0) (\MaxTypeNumber) (\NxtPnByte 0) (\CurPnPage 0
) (\NxtAtomPage 0) (\AtomFrLst 0) (\NxtArrayPage)))
(DECLARE: EVAL@COMPILE DONTCOPY 
(FILESLOAD (LOADCOMP) MAKEINIT)
)
STOP