(RPAQQ FILESETS (0LISPSET 1LISPSET 2LISPSET 3LISPSET 4LISPSET 5LISPSET 6LISPSET 7LISPSET 8LISPSET
9LISPSET))
(RPAQQ 0LISPSET (LLFAULT LLSUBRS LLBFS LLNEW FILEIO IMAGEIO LLBASIC LLGC LLINTERP LLARITH LLFLOAT
LLREAD LLCHAR LLARRAYELT LLSTK LLDATATYPE LLKEY))
(RPAQQ 1LISPSET (ASTACK DTDECLARE ATBL LLCODE IOCHAR COREIO AOFD ADIR PMAP MOD44IO ATERM APRINT ABASIC
AERROR AINTERRUPT MISC BOOTSTRAP PROC LLETHER PUP LEAF PASSWORDS FONT LLDISPLAY APUTDQ))
(RPAQQ 2LISPSET (ACODE MACHINEINDEPENDENT POSTLOADUP))
(RPAQQ 3LISPSET (MACROS DLAP BYTECOMPILER COMPILE))
(RPAQQ 4LISPSET (EDIT WEDIT HELPDL PRETTY COMMENT BREAK ADVISE LOADFNS FILEPKG DFILE DMISC))
(RPAQQ 5LISPSET (HIST UNDO SPELL DWIM WTFIX CLISP DWIMIFY CLISPIFY RECORD ASSIST))
(RPAQQ 6LISPSET (MSANALYZE MSPARSE MASTERSCOPE HPRINT BRKDWN MATCH))
(RPAQQ 7LISPSET (ADISPLAY DEXEC AARITH PRESS HLDISPLAY MENU WINDOW WBREAK INSPECT BSP CHAT TRSERVER
10MBDRIVER LLNS DISKDLION SPP COURIER NSFILING INTERPRESS ADDARITH MACROAUX))
(RPAQQ 8LISPSET (MAKEINIT MEM RENAMEFNS))
(RPAQQ 9LISPSET (LLFCOMPILE VMEM READSYS APS PCALLSTATS UPCSTATS REMOTEVMEM))
(DEFINEQ (SETDIRECTORIES (LAMBDA NIL (* bvm: " 6-MAY-83 22:31") (RPAQ DIRECTORIES ((LAMBDA (DIRS) (
APPEND DIRS (LDIFFERENCE DIRECTORIES DIRS))) (SELECTQ (SYSTEMTYPE) (TENEX (QUOTE (BLISP NEWLISP LISP
LISPUSERS))) (QUOTE ({PHYLUM}<LISPCORE>FUGUE> {PHYLUM}<LISPCORE>SOURCES> {PHYLUM}<LISPCORE>SYSTEM>))))
))))
(SETDIRECTORIES)
(SELECTQ (SYSTEMTYPE) (D) (ADDTOVAR POSTGREETFORMS (SETDIRECTORIES)))
(PUTPROP (QUOTE FILESETS) (QUOTE IMPORTDATE) (IDATE "31-JUL-83 15:46:03"))
(RPAQQ MODARITHMACROS (CEIL FLOOR FOLDHI FOLDLO MODUP UNFOLD UNSIGNED SIGNED MOD))
(PUTPROPS CEIL MACRO ((X N) (FLOOR (IPLUS X (CONSTANT (SUB1 N))) N)))
(PUTPROPS FLOOR MACRO ((X N) (LOGAND X (CONSTANT (LOGXOR (SUB1 N) -1)))))
(PUTPROPS FOLDHI MACRO (X (PROG ((FORM (CAR X)) (DIVISOR (CAR (CONSTANTEXPRESSIONP (CADR X))))) (OR (
AND DIVISOR (POWEROFTWOP DIVISOR)) (\ILLEGAL.ARG (CADR X))) (RETURN (LIST (QUOTE LRSH) (LIST (QUOTE
IPLUS) FORM (SUB1 DIVISOR)) (SUB1 (INTEGERLENGTH DIVISOR)))))))
(PUTPROPS FOLDLO MACRO (X (PROG ((FORM (CAR X)) (DIVISOR (CAR (CONSTANTEXPRESSIONP (CADR X))))) (OR (
AND DIVISOR (POWEROFTWOP DIVISOR)) (\ILLEGAL.ARG (CADR X))) (RETURN (LIST (QUOTE LRSH) FORM (SUB1 (
INTEGERLENGTH DIVISOR)))))))
(PUTPROPS MODUP MACRO (OPENLAMBDA (X N) (IDIFFERENCE (SUB1 N) (IMOD (SUB1 X) N))))
(PUTPROPS UNFOLD MACRO (X (PROG ((FORM (CAR X)) (DIVISOR (CAR (CONSTANTEXPRESSIONP (CADR X))))) (OR (
AND DIVISOR (POWEROFTWOP DIVISOR)) (\ILLEGAL.ARG (CADR X))) (RETURN (LIST (QUOTE LLSH) FORM (SUB1 (
INTEGERLENGTH DIVISOR)))))))
(PUTPROPS UNSIGNED MACRO ((X WIDTH) (LOGAND X (CONSTANT (SUB1 (LLSH 1 WIDTH))))))
(PUTPROPS SIGNED MACRO ((N WIDTH) ((LAMBDA (X) (DECLARE (LOCALVARS . T)) (COND ((IGREATERP X (CONSTANT
(SUB1 (LLSH 1 (SUB1 WIDTH))))) (SUB1 (IDIFFERENCE X (CONSTANT (SUB1 (LLSH 1 WIDTH)))))) (T X))) N)))
(PUTPROPS SIGNED BYTEMACRO (ARGS (COND (EFF (CAR ARGS)) (T (BQUOTE ((LAMBDA (X) (DECLARE (LOCALVARS .
T)) (COND ((IGREATERP X (SUB1 (LLSH 1 (SUB1 , (CADR ARGS))))) (SUB1 (IDIFFERENCE X (SUB1 (LLSH 1 , (
CADR ARGS)))))) (T X))) , (CAR ARGS)))))))
(PUTPROPS MOD MACRO (= . IMOD))
(RPAQQ BITSPERNIBBLE 4)
(RPAQQ NIBBLESPERBYTE 2)
(RPAQQ BITSPERBYTE 8)
(RPAQQ BITSPERCELL 32)
(RPAQQ BITSPERWORD 16)
(RPAQQ BYTESPERCELL 4)
(RPAQQ BYTESPERPAGE 512)
(RPAQQ BYTESPERWORD 2)
(RPAQQ CELLSPERPAGE 128)
(RPAQQ CELLSPERSEGMENT 32768)
(RPAQQ PAGESPERSEGMENT 256)
(RPAQQ WORDSPERCELL 2)
(RPAQQ WORDSPERPAGE 256)
(RPAQQ WORDSPERSEGMENT 65536)
(RPAQQ WORDSPERQUAD 4)
(RPAQQ CELLSPERQUAD 2)
(RPAQQ BYTESPERQUAD 8)
(CONSTANTS BITSPERNIBBLE NIBBLESPERBYTE BITSPERBYTE BITSPERCELL BITSPERWORD BYTESPERCELL BYTESPERPAGE
BYTESPERWORD CELLSPERPAGE CELLSPERSEGMENT PAGESPERSEGMENT WORDSPERCELL WORDSPERPAGE WORDSPERSEGMENT
WORDSPERQUAD CELLSPERQUAD BYTESPERQUAD)
(RPAQQ BITSPERHALFWORD 8)
(RPAQQ MASKHALFWORD1'S 255)
(RPAQQ MASKWORD1'S 65535)
(RPAQQ MASK1WORD0'S 32768)
(RPAQQ MASK0WORD1'S 32767)
(CONSTANTS BITSPERHALFWORD MASKHALFWORD1'S MASKWORD1'S MASK1WORD0'S MASK0WORD1'S)
(RPAQQ INTEGERSIZECONSTANTS ((BITS.PER.SMALLP (ADD1 BITSPERWORD)) (SMALLP.LENGTH (SUB1 BITS.PER.SMALLP
)) (MAX.SMALLP (LOGOR (LSH 1 (SUB1 SMALLP.LENGTH)) (SUB1 (LSH 1 (SUB1 SMALLP.LENGTH))))) (MIN.SMALLP (
IDIFFERENCE -1 MAX.SMALLP)) (BITS.PER.FIXP BITSPERCELL) (FIXP.LENGTH (SUB1 BITS.PER.FIXP)) (MAX.FIXP (
LOGOR (LSH 1 (SUB1 FIXP.LENGTH)) (SUB1 (LSH 1 (SUB1 FIXP.LENGTH))))) (MIN.FIXP (IDIFFERENCE -1
MAX.FIXP))))
(RPAQ BITS.PER.SMALLP (ADD1 BITSPERWORD))
(RPAQ SMALLP.LENGTH (SUB1 BITS.PER.SMALLP))
(RPAQ MAX.SMALLP (LOGOR (LSH 1 (SUB1 SMALLP.LENGTH)) (SUB1 (LSH 1 (SUB1 SMALLP.LENGTH)))))
(RPAQ MIN.SMALLP (IDIFFERENCE -1 MAX.SMALLP))
(RPAQ BITS.PER.FIXP BITSPERCELL)
(RPAQ FIXP.LENGTH (SUB1 BITS.PER.FIXP))
(RPAQ MAX.FIXP (LOGOR (LSH 1 (SUB1 FIXP.LENGTH)) (SUB1 (LSH 1 (SUB1 FIXP.LENGTH)))))
(RPAQ MIN.FIXP (IDIFFERENCE -1 MAX.FIXP))
(CONSTANTS (BITS.PER.SMALLP (ADD1 BITSPERWORD)) (SMALLP.LENGTH (SUB1 BITS.PER.SMALLP)) (MAX.SMALLP (
LOGOR (LSH 1 (SUB1 SMALLP.LENGTH)) (SUB1 (LSH 1 (SUB1 SMALLP.LENGTH))))) (MIN.SMALLP (IDIFFERENCE -1
MAX.SMALLP)) (BITS.PER.FIXP BITSPERCELL) (FIXP.LENGTH (SUB1 BITS.PER.FIXP)) (MAX.FIXP (LOGOR (LSH 1 (
SUB1 FIXP.LENGTH)) (SUB1 (LSH 1 (SUB1 FIXP.LENGTH))))) (MIN.FIXP (IDIFFERENCE -1 MAX.FIXP)))
(PUTPROP (QUOTE MODARITH) (QUOTE IMPORTDATE) (IDATE "11-JUN-83 21:05:26"))
(RPAQQ WINDFLG T)
(CONSTANTS (WINDFLG T))
(RPAQQ INITCONSTANTS ((* (LISPNAME VALUE BCPLNAME UCODENAME)) (* * version numbers) (\MinRamVersion
4096 T T) (\MinBcplVersion 8960 T T) (\LispVersion 36608 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 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) (* * page map) (\PMblockSize 32
PMBLOCKSIZE) (\STATSsize 8 T) (\NumPMTpages 2) (\EmptyPMTEntry 65535 T) (\FirstVmemBlock 2 T) (* *
interface page) (\IFPValidKey 5603 T) (* * atoms) (\HashInc 19 T) (* * MDS) (\FirstMDSPage 256 T) (
\MDSIncrement 512) (* * 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) (\SMALLPOSPSPACE (
14 0)) (\SmallPosHi 14 SMALLPOSspace smallpl) (\SMALLNEGSPACE (15 0)) (\SmallNegHi 15 SMALLNEGspace
smallneg) (\NumSmallPages 512) (\Guard1MDSPage 3328) (\GuardMDSPage 3360) (\LastMDSPage 3583) (
\PNPSPACE (16 0) (PNPspace PNPbase)) (\LastPnPage 2047) (\DEFSPACE (17 0) (DEFspace DEFbase) (DEFspace
DEFbase)) (\VALSPACE (18 0) (TOPVALspace TOPVALbase) (VALspace VALbase)) (\PLISTSPACE (19 0) (
PLISTspace PLISTbase)) (\AtomHashTable (20 0) (AHTspace AHTbase)) (\AtomHTpages 128 AHTSIZE) (\PAGEMAP
(21 0) (PAGEMAPspace PAGEMAPbase)) (\NumPageMapPages 256) (\PageMapTBL (22 0) (PMTspace PMTbase)) (
\InterfacePage (22 4096) (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 14 T T) (\TeleRaidFXP 24 T T) (\IOPAGE (0 65280)) (\IOCBPAGE (0 256)) (\MDSTypeTable
(22 32768) (MDSTYPEspace MDSTYPEbase) (NIL MDSTYPEbase)) (\MDSTTsize 32 T) (\STATSSPACE (22 40960) (
STATSspace STATSbase) (STATSspace NIL)) (\InterruptTBL (22 41600) (NIL InterruptTBLbase)) (\MISCSTATS
(22 41984) (NIL MISCSTATSbase)) (\UFNTable (22 42496) NIL (NIL UFNTablebase)) (\DTDSpaceBase (22 43008
) (DTDspace DTDbase) (DTDspace DTDbase)) (\DTDSize 16 T) (\LISTPDTD (22 43088)) (\EndTypeNumber 255) (
\STACKSPACE (23 0) (STACKspace NIL) (STACKspace NIL)) (\GuardStackAddr 61440) (\LastStackAddr 65534) (
\STACKHI 23 NIL T) (\PNCHARSSPACE (24 0)) (\PNAMESPACEEND (31 65535)) (\ARRAYSPACE (32 0) NIL (
ARRAYspace NIL)) (\ARRAYspace 32) (\ARRAYbase 0) (\LastArrayPage 6911) (\HTMAIN (59 0) (HTMAINspace
HTMAINbase) (HTMAINspace HTMAINbase)) (\HTMAINnpages 129 T) (\HTMAIN1 (59 1)) (\HTOVERFLOW (59 32768)
NIL (NIL HTOVERFLOWbase)) (\HTCOLL (60 0) NIL (HTCOLLspace HTCOLLbase)) (\HTCOLL1 (60 1)) (
\DISPLAYREGION (62 0)) (\DefaultScARRAYhi 62) (\D1BCPLspace 0 T LEmubrHiVal) (\D0BCPLspace 0 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 15872) (* for wide display
1024x808/16x256) (\NP.DISPLAY 202) (\RP.DISPLAY 0) (\RP.STACK 512) (\VP.STACK 5888) (\VP.STATS 5760) (
\RP.STATS 384) (\NP.STATS 128) (\RP.MAP 256) (\NP.MAP 64) (\RP.IOPAGE 320) (\VP.IOPAGE 255) (
\VP.IFPAGE 5648) (\VP.FPTOVP 5696) (\NP.FPTOVP 64) (\RP.FPTOVP 321) (\RP.STARTBUFFERS 385) (
\VP.TYPETABLE 5760) (\NP.TYPETABLE 32) (\RP.TYPETABLE 896) (\VP.GCTABLE 15104) (\NP.GCTABLE 128) (
\RP.GCTABLE 768) (\VP.GCOVERFLOW 15232) (\NP.GCOVERFLOW 1) (\RP.GCOVERFLOW 928) (\FP.IFPAGE 2) (
\VP.IOCBS 1) (\RP.TEMPDISPLAY 929) (* DLion processor commands) (\DL.PROCESSORBUSY 32768) (\DL.SETTOD
32769) (\DL.READTOD 32770) (\DL.READPID 32771) (\DL.BOOTBUTTON 32772) (\RP.AFTERDISPLAY 206) (
\VP.INITSCRATCH 8) (\VP.RPT 128) (\VP.BUFFERS 192) (* * These going away...) (\RP.IOCBS 769) (\RP.RPT
321)))
(RPAQQ \INITSUBRS (\uCodeCheck was\StackOverflow \NWWInterrupt was\PageFault \StatsOverflow NOOPSUBR
\BACKGROUNDSUBR \CHECKBCPLPASSWORD DISKPARTITION DSPBOUT \DSPRATE \GATHERSTATS \GETPACKETBUFFER
\LISPFINISH \MOREVMEMFILE RAID \READRAWPBI \WRITERAWPBI SETSCREENCOLOR SHOWDISPLAY \PUPLEVEL1STATE
\WRITESTATS \CONTEXTSWITCH \COPYSYS0SUBR \WRITEMAP))
(RPAQQ MISCSTATSLAYOUT ((STARTTIME FIXP MSstrtTime) (TOTALTIME FIXP) (SWAPWAITTIME FIXP T) (PAGEFAULTS
FIXP T) (SWAPWRITES FIXP T) (DISKIOTIME FIXP T) (DISKOPS FIXP T) (KEYBOARDWAITTIME FIXP T) (GCTIME
FIXP T) (NETIOTIME FIXP T) (NETIOOPS FIXP T) (SWAPTEMP0 FIXP) (SWAPTEMP1 FIXP) (RCLKSECOND FIXP) (
SECONDSCLOCK FIXP) (MILLISECONDSCLOCK FIXP) (BASECLOCK FIXP) (RCLKTEMP0 FIXP) (SECONDSTMP FIXP) (
MILLISECONDSTMP FIXP) (BASETMP FIXP) (EXCESSTIMETMP FIXP) (CLOCKTEMP0 FIXP) (DISKTEMP0 FIXP) (
DISKTEMP1 FIXP) (TELERAIDTEMP1 FIXP) (TELERAIDTEMP2 FIXP) (TELERAIDTEMP3 FIXP) (LASTUSERACTION FIXP)))
(RPAQQ IFPAGELAYOUT ((CurrentFXP WORD) (ResetFXP WORD) (SubovFXP WORD) (KbdFXP WORD) (HardReturnFXP
WORD) (GCFXP WORD) (FAULTFXP WORD) (EndOfStack WORD) (LVersion WORD) (MinRVersion WORD) (MinBVersion
WORD) (RVersion WORD) (BVersion WORD) (MachineType WORD) (MiscFXP WORD) (Key WORD) (SerialNumber WORD)
(EmulatorSpace WORD) (ScreenWidth WORD) (NxtPMAddr WORD) (NActivePages WORD) (NDirtyPages WORD) (
filePnPMP0 WORD) (filePnPMT0 WORD) (TELERAIDFXP WORD) (wasInterruptEnable WORD) (wasInterruptChar WORD
) (wasRaidExitFn WORD) (UserNameAddr WORD) (UserPswdAddr WORD) (StackBase WORD) (FAULTHI WORD) (
FAULTLO WORD) (REALPAGETABLE WORD) (RPTSIZE WORD) (RPOFFSET WORD) (RPTLAST WORD) (EMBUFVP WORD) (
NSHost0 WORD) (NSHost1 WORD) (NSHost2 WORD) (MDSZone WORD) (MDSZoneLength WORD) (EMUBUFFERS WORD) (
EMUBUFLENGTH WORD) (LASTNUMCHARS WORD) (SYSDISK WORD) (ISFMAP WORD) (* These are for \MISCAPPLY* --
note that they are not ref counted, so don't pass the only pointer to something this way!) (
MISCSTACKFN FULLXPOINTER) (MISCSTACKARG1 FULLXPOINTER) (MISCSTACKARG2 FULLXPOINTER) (MISCSTACKRESULT
FULLXPOINTER) (NRealPages WORD) (LastLockedFilePage WORD) (LastDominoFilePage WORD) (FPTOVPStart WORD)
))
(RPAQQ IOPAGELAYOUT ((NIL 56 WORD) (DLMOUSEX WORD NIL T) (DLMOUSEY WORD NIL T) (DLUTILIN WORD NIL T) (
DLKBDAD0 WORD NIL T) (DLKBDAD1 WORD NIL T) (DLKBDAD2 WORD NIL T) (DLKBDAD3 WORD NIL T) (DLKBDAD4 WORD
NIL T) (DLKBDAD5 WORD NIL T) (DLMAINTPANEL WORD NIL T) (NIL 2 WORD) (DLCP 5 WORD) (DLFLOPPY 8 WORD) (
DLTTYPORT 6 WORD NIL T) (DLPROCESSOR2 WORD) (DLPROCESSOR1 WORD) (DLPROCESSOR0 WORD) (DLPROCESSORCMD
WORD) (NEWMOUSEX WORD) (NEWMOUSEY WORD) (NEWMOUSESTATE WORD) (DLBEEPCMD WORD) (DLBEEPFREQ WORD) (
DLRS232 13 WORD NIL T) (NIL 79 WORD) (DLMAGTAPE 4 WORD) (DLETHERNET 16 WORD NIL T) (DLTODVALID WORD) (
DLTODLO WORD NIL T) (DLTODHI WORD) (DLTODLO2 WORD) (NIL 23 WORD) (DLDISPINTERRUPT WORD NIL T) (
DLDISPCONTROL WORD) (DLDISPBORDER WORD) (DLCURSORX WORD NIL T) (DLCURSORY WORD NIL T) (DLCURSORBITMAP
16 WORD NIL T)))
(PUTPROPS \uCodeCheck ARGNAMES (DUMMY))
(PUTPROPS was\StackOverflow ARGNAMES (DUMMY))
(PUTPROPS \NWWInterrupt ARGNAMES (DUMMY))
(PUTPROPS \StatsOverflow ARGNAMES (DUMMY))
(PUTPROPS NOOPSUBR ARGNAMES (DUMMY))
(PUTPROPS \BACKGROUNDSUBR ARGNAMES (DUMMY))
(PUTPROPS \CHECKBCPLPASSWORD ARGNAMES (PASS VECTOR))
(PUTPROPS DISKPARTITION ARGNAMES NIL)
(PUTPROPS DSPBOUT ARGNAMES (CHARCODE))
(PUTPROPS \DSPRATE ARGNAMES (AC0 AC1 AC2))
(PUTPROPS \GATHERSTATS ARGNAMES (FID))
(PUTPROPS \GETPACKETBUFFER ARGNAMES NIL)
(PUTPROPS \LISPFINISH ARGNAMES (DUMMY))
(PUTPROPS \MOREVMEMFILE ARGNAMES (FILEPAGE))
(PUTPROPS RAID ARGNAMES (MESS1 MESS2 FLG))
(PUTPROPS \READRAWPBI ARGNAMES NIL)
(PUTPROPS \WRITERAWPBI ARGNAMES (PBI))
(PUTPROPS SETSCREENCOLOR ARGNAMES (FLG))
(PUTPROPS SHOWDISPLAY ARGNAMES (BASE RASTERWIDTH))
(PUTPROPS \PUPLEVEL1STATE ARGNAMES (FLG))
(PUTPROPS \WRITESTATS ARGNAMES (TYPE X1 X2 X3 X4 X5 X6 X7 X8 X9 X10))
(PUTPROPS \CONTEXTSWITCH ARGNAMES (DUMMY))
(PUTPROPS \COPYSYS0SUBR ARGNAMES (FID))
(PUTPROPS \WRITEMAP ARGNAMES (VP RP FLAGS))
(RPAQQ \MinRamVersion 4096)
(RPAQQ \MinBcplVersion 8960)
(RPAQQ \LispVersion 36608)
(RPAQQ CDRCODING 1)
(RPAQQ \SMALLP 1)
(RPAQQ \FIXP 2)
(RPAQQ \FLOATP 3)
(RPAQQ \LITATOM 4)
(RPAQQ \LISTP 5)
(RPAQQ \ARRAYP 6)
(RPAQQ \STRINGP 7)
(RPAQQ \STACKP 8)
(RPAQQ \VMEMPAGEP 10)
(RPAQQ \STREAM 11)
(RPAQQ \TT.TYPEMASK 255)
(RPAQQ \TT.NOREF 32768)
(RPAQQ \TT.LISPREF 16384)
(RPAQQ \PMblockSize 32)
(RPAQQ \STATSsize 8)
(RPAQQ \NumPMTpages 2)
(RPAQQ \EmptyPMTEntry 65535)
(RPAQQ \FirstVmemBlock 2)
(RPAQQ \IFPValidKey 5603)
(RPAQQ \HashInc 19)
(RPAQQ \FirstMDSPage 256)
(RPAQQ \MDSIncrement 512)
(RPAQQ \StackMask 57344)
(RPAQQ \FxtnBlock 49152)
(RPAQQ \GuardBlock 57344)
(RPAQQ \BFBlock 32768)
(RPAQQ \FreeStackBlock 40960)
(RPAQQ \NotStackBlock 0)
(RPAQQ \MinExtraStackWords 32)
(RPAQQ ERASECHARCODE 0)
(RPAQQ \HT1CNT 1024)
(RPAQQ \HTSTKBIT 512)
(RPAQQ \HTCNTMASK 64512)
(RPAQQ \HTMAINSIZE 32768)
(RPAQQ \HTCOLLSIZE 65528)
(RPAQQ \HTENDFREE 1)
(RPAQQ \HTFREEPTR 0)
(RPAQQ \AtomHI 0)
(RPAQQ \SmallPosHi 14)
(RPAQQ \SmallNegHi 15)
(RPAQQ \NumSmallPages 512)
(RPAQQ \Guard1MDSPage 3328)
(RPAQQ \GuardMDSPage 3360)
(RPAQQ \LastMDSPage 3583)
(RPAQQ \LastPnPage 2047)
(RPAQQ \AtomHTpages 128)
(RPAQQ \NumPageMapPages 256)
(RPAQQ \CurrentFXP 0)
(RPAQQ \ResetFXP 1)
(RPAQQ \SubovFXP 2)
(RPAQQ \KbdFXP 3)
(RPAQQ \HardReturnFXP 4)
(RPAQQ \GCFXP 5)
(RPAQQ \FAULTFXP 6)
(RPAQQ \MiscFXP 14)
(RPAQQ \TeleRaidFXP 24)
(RPAQQ \MDSTTsize 32)
(RPAQQ \DTDSize 16)
(RPAQQ \EndTypeNumber 255)
(RPAQQ \GuardStackAddr 61440)
(RPAQQ \LastStackAddr 65534)
(RPAQQ \STACKHI 23)
(RPAQQ \ARRAYspace 32)
(RPAQQ \ARRAYbase 0)
(RPAQQ \LastArrayPage 6911)
(RPAQQ \HTMAINnpages 129)
(RPAQQ \DefaultScARRAYhi 62)
(RPAQQ \D1BCPLspace 0)
(RPAQQ \D0BCPLspace 0)
(RPAQQ DCB.EM 272)
(RPAQQ DISPINTERRUPT.EM 273)
(RPAQQ CURSORBITMAP.EM 281)
(RPAQQ KBDAD0.EM 65052)
(RPAQQ KBDAD1.EM 65053)
(RPAQQ KBDAD2.EM 65054)
(RPAQQ KBDAD3.EM 65055)
(RPAQQ UTILIN.EM 65048)
(RPAQQ CURSORX.EM 278)
(RPAQQ CURSORY.EM 279)
(RPAQQ MOUSEX.EM 276)
(RPAQQ MOUSEY.EM 277)
(RPAQQ \LispKeyMask 8192)
(RPAQQ \BcplKeyMask 4352)
(RPAQQ \DOLPHIN 4)
(RPAQQ \DORADO 5)
(RPAQQ \DANDELION 6)
(RPAQQ \VP.DISPLAY 15872)
(RPAQQ \NP.DISPLAY 202)
(RPAQQ \RP.DISPLAY 0)
(RPAQQ \RP.STACK 512)
(RPAQQ \VP.STACK 5888)
(RPAQQ \VP.STATS 5760)
(RPAQQ \RP.STATS 384)
(RPAQQ \NP.STATS 128)
(RPAQQ \RP.MAP 256)
(RPAQQ \NP.MAP 64)
(RPAQQ \RP.IOPAGE 320)
(RPAQQ \VP.IOPAGE 255)
(RPAQQ \VP.IFPAGE 5648)
(RPAQQ \VP.FPTOVP 5696)
(RPAQQ \NP.FPTOVP 64)
(RPAQQ \RP.FPTOVP 321)
(RPAQQ \RP.STARTBUFFERS 385)
(RPAQQ \VP.TYPETABLE 5760)
(RPAQQ \NP.TYPETABLE 32)
(RPAQQ \RP.TYPETABLE 896)
(RPAQQ \VP.GCTABLE 15104)
(RPAQQ \NP.GCTABLE 128)
(RPAQQ \RP.GCTABLE 768)
(RPAQQ \VP.GCOVERFLOW 15232)
(RPAQQ \NP.GCOVERFLOW 1)
(RPAQQ \RP.GCOVERFLOW 928)
(RPAQQ \FP.IFPAGE 2)
(RPAQQ \VP.IOCBS 1)
(RPAQQ \RP.TEMPDISPLAY 929)
(RPAQQ \DL.PROCESSORBUSY 32768)
(RPAQQ \DL.SETTOD 32769)
(RPAQQ \DL.READTOD 32770)
(RPAQQ \DL.READPID 32771)
(RPAQQ \DL.BOOTBUTTON 32772)
(RPAQQ \RP.AFTERDISPLAY 206)
(RPAQQ \VP.INITSCRATCH 8)
(RPAQQ \VP.RPT 128)
(RPAQQ \VP.BUFFERS 192)
(RPAQQ \RP.IOCBS 769)
(RPAQQ \RP.RPT 321)
(CONSTANTS (\MinRamVersion 4096) (\MinBcplVersion 8960) (\LispVersion 36608) (CDRCODING 1) (\SMALLP 1)
(\FIXP 2) (\FLOATP 3) (\LITATOM 4) (\LISTP 5) (\ARRAYP 6) (\STRINGP 7) (\STACKP 8) (\VMEMPAGEP 10) (
\STREAM 11) (\TT.TYPEMASK 255) (\TT.NOREF 32768) (\TT.LISPREF 16384) (\PMblockSize 32) (\STATSsize 8)
(\NumPMTpages 2) (\EmptyPMTEntry 65535) (\FirstVmemBlock 2) (\IFPValidKey 5603) (\HashInc 19) (
\FirstMDSPage 256) (\MDSIncrement 512) (\StackMask 57344) (\FxtnBlock 49152) (\GuardBlock 57344) (
\BFBlock 32768) (\FreeStackBlock 40960) (\NotStackBlock 0) (\MinExtraStackWords 32) (ERASECHARCODE 0)
(\HT1CNT 1024) (\HTSTKBIT 512) (\HTCNTMASK 64512) (\HTMAINSIZE 32768) (\HTCOLLSIZE 65528) (\HTENDFREE
1) (\HTFREEPTR 0) (\AtomHI 0) (\SmallPosHi 14) (\SmallNegHi 15) (\NumSmallPages 512) (\Guard1MDSPage
3328) (\GuardMDSPage 3360) (\LastMDSPage 3583) (\LastPnPage 2047) (\AtomHTpages 128) (\NumPageMapPages
256) (\CurrentFXP 0) (\ResetFXP 1) (\SubovFXP 2) (\KbdFXP 3) (\HardReturnFXP 4) (\GCFXP 5) (\FAULTFXP
6) (\MiscFXP 14) (\TeleRaidFXP 24) (\MDSTTsize 32) (\DTDSize 16) (\EndTypeNumber 255) (
\GuardStackAddr 61440) (\LastStackAddr 65534) (\STACKHI 23) (\ARRAYspace 32) (\ARRAYbase 0) (
\LastArrayPage 6911) (\HTMAINnpages 129) (\DefaultScARRAYhi 62) (\D1BCPLspace 0) (\D0BCPLspace 0) (
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) (\BcplKeyMask 4352) (\DOLPHIN 4) (\DORADO 5) (\DANDELION 6) (
\VP.DISPLAY 15872) (\NP.DISPLAY 202) (\RP.DISPLAY 0) (\RP.STACK 512) (\VP.STACK 5888) (\VP.STATS 5760)
(\RP.STATS 384) (\NP.STATS 128) (\RP.MAP 256) (\NP.MAP 64) (\RP.IOPAGE 320) (\VP.IOPAGE 255) (
\VP.IFPAGE 5648) (\VP.FPTOVP 5696) (\NP.FPTOVP 64) (\RP.FPTOVP 321) (\RP.STARTBUFFERS 385) (
\VP.TYPETABLE 5760) (\NP.TYPETABLE 32) (\RP.TYPETABLE 896) (\VP.GCTABLE 15104) (\NP.GCTABLE 128) (
\RP.GCTABLE 768) (\VP.GCOVERFLOW 15232) (\NP.GCOVERFLOW 1) (\RP.GCOVERFLOW 928) (\FP.IFPAGE 2) (
\VP.IOCBS 1) (\RP.TEMPDISPLAY 929) (\DL.PROCESSORBUSY 32768) (\DL.SETTOD 32769) (\DL.READTOD 32770) (
\DL.READPID 32771) (\DL.BOOTBUTTON 32772) (\RP.AFTERDISPLAY 206) (\VP.INITSCRATCH 8) (\VP.RPT 128) (
\VP.BUFFERS 192) (\RP.IOCBS 769) (\RP.RPT 321))
(ADDTOVAR GLOBALVARS \ATOMSPACE \SMALLPOSPSPACE \SMALLNEGSPACE \PNPSPACE \DEFSPACE \VALSPACE
\PLISTSPACE \AtomHashTable \PAGEMAP \PageMapTBL \InterfacePage \IOPAGE \IOCBPAGE \MDSTypeTable
\STATSSPACE \InterruptTBL \MISCSTATS \UFNTable \DTDSpaceBase \LISTPDTD \STACKSPACE \PNCHARSSPACE
\PNAMESPACEEND \ARRAYSPACE \HTMAIN \HTMAIN1 \HTOVERFLOW \HTCOLL \HTCOLL1 \DISPLAYREGION)
(BLOCKRECORD MISCSTATS ((STARTTIME FIXP) (TOTALTIME FIXP) (SWAPWAITTIME FIXP) (PAGEFAULTS FIXP) (
SWAPWRITES FIXP) (DISKIOTIME FIXP) (DISKOPS FIXP) (KEYBOARDWAITTIME FIXP) (GCTIME FIXP) (NETIOTIME
FIXP) (NETIOOPS FIXP) (SWAPTEMP0 FIXP) (SWAPTEMP1 FIXP) (RCLKSECOND FIXP) (SECONDSCLOCK FIXP) (
MILLISECONDSCLOCK FIXP) (BASECLOCK FIXP) (RCLKTEMP0 FIXP) (SECONDSTMP FIXP) (MILLISECONDSTMP FIXP) (
BASETMP FIXP) (EXCESSTIMETMP FIXP) (CLOCKTEMP0 FIXP) (DISKTEMP0 FIXP) (DISKTEMP1 FIXP) (TELERAIDTEMP1
FIXP) (TELERAIDTEMP2 FIXP) (TELERAIDTEMP3 FIXP) (LASTUSERACTION FIXP)) (CREATE (\ALLOCBLOCK 29)))
(BLOCKRECORD IFPAGE ((CurrentFXP WORD) (ResetFXP WORD) (SubovFXP WORD) (KbdFXP WORD) (HardReturnFXP
WORD) (GCFXP WORD) (FAULTFXP WORD) (EndOfStack WORD) (LVersion WORD) (MinRVersion WORD) (MinBVersion
WORD) (RVersion WORD) (BVersion WORD) (MachineType WORD) (MiscFXP WORD) (Key WORD) (SerialNumber WORD)
(EmulatorSpace WORD) (ScreenWidth WORD) (NxtPMAddr WORD) (NActivePages WORD) (NDirtyPages WORD) (
filePnPMP0 WORD) (filePnPMT0 WORD) (TELERAIDFXP WORD) (wasInterruptEnable WORD) (wasInterruptChar WORD
) (wasRaidExitFn WORD) (UserNameAddr WORD) (UserPswdAddr WORD) (StackBase WORD) (FAULTHI WORD) (
FAULTLO WORD) (REALPAGETABLE WORD) (RPTSIZE WORD) (RPOFFSET WORD) (RPTLAST WORD) (EMBUFVP WORD) (
NSHost0 WORD) (NSHost1 WORD) (NSHost2 WORD) (MDSZone WORD) (MDSZoneLength WORD) (EMUBUFFERS WORD) (
EMUBUFLENGTH WORD) (LASTNUMCHARS WORD) (SYSDISK WORD) (ISFMAP WORD) (* These are for \MISCAPPLY* --
note that they are not ref counted, so don't pass the only pointer to something this way!) (
MISCSTACKFN FULLXPOINTER) (MISCSTACKARG1 FULLXPOINTER) (MISCSTACKARG2 FULLXPOINTER) (MISCSTACKRESULT
FULLXPOINTER) (NRealPages WORD) (LastLockedFilePage WORD) (LastDominoFilePage WORD) (FPTOVPStart WORD)
) (CREATE (\ALLOCBLOCK 30)))
(BLOCKRECORD IOPAGE ((NIL 56 WORD) (DLMOUSEX WORD) (DLMOUSEY WORD) (DLUTILIN WORD) (DLKBDAD0 WORD) (
DLKBDAD1 WORD) (DLKBDAD2 WORD) (DLKBDAD3 WORD) (DLKBDAD4 WORD) (DLKBDAD5 WORD) (DLMAINTPANEL WORD) (
NIL 2 WORD) (DLCP 5 WORD) (DLFLOPPY 8 WORD) (DLTTYPORT 6 WORD) (DLPROCESSOR2 WORD) (DLPROCESSOR1 WORD)
(DLPROCESSOR0 WORD) (DLPROCESSORCMD WORD) (NEWMOUSEX WORD) (NEWMOUSEY WORD) (NEWMOUSESTATE WORD) (
DLBEEPCMD WORD) (DLBEEPFREQ WORD) (DLRS232 13 WORD) (NIL 79 WORD) (DLMAGTAPE 4 WORD) (DLETHERNET 16
WORD) (DLTODVALID WORD) (DLTODLO WORD) (DLTODHI WORD) (DLTODLO2 WORD) (NIL 23 WORD) (DLDISPINTERRUPT
WORD) (DLDISPCONTROL WORD) (DLDISPBORDER WORD) (DLCURSORX WORD) (DLCURSORY WORD) (DLCURSORBITMAP 16
WORD)) (ACCESSFNS IOPAGE ((DLCURSORBITMAPPTR (\ADDBASE DATUM 240)) (DLCURSORYPTR (\ADDBASE DATUM 239))
(DLCURSORXPTR (\ADDBASE DATUM 238)) (DLDISPINTERRUPTPTR (\ADDBASE DATUM 235)) (DLTODLOPTR (\ADDBASE
DATUM 209)) (DLETHERNETPTR (\ADDBASE DATUM 192)) (DLRS232PTR (\ADDBASE DATUM 96)) (DLTTYPORTPTR (
\ADDBASE DATUM 81)) (DLMAINTPANELPTR (\ADDBASE DATUM 65)) (DLKBDAD5PTR (\ADDBASE DATUM 64)) (
DLKBDAD4PTR (\ADDBASE DATUM 63)) (DLKBDAD3PTR (\ADDBASE DATUM 62)) (DLKBDAD2PTR (\ADDBASE DATUM 61)) (
DLKBDAD1PTR (\ADDBASE DATUM 60)) (DLKBDAD0PTR (\ADDBASE DATUM 59)) (DLUTILINPTR (\ADDBASE DATUM 58)) (
DLMOUSEYPTR (\ADDBASE DATUM 57)) (DLMOUSEXPTR (\ADDBASE DATUM 56)))) (CREATE (\ALLOCBLOCK 128)))
(PUTPROPS EMADDRESS MACRO (ARGS ((LAMBDA (ADDR) (COND ((EQ \D1BCPLspace \D0BCPLspace) (LIST (LIST (
QUOTE OPCODES) (QUOTE GCONST) 0 (LRSH ADDR 8) (LOGAND ADDR 255)))) (T (BQUOTE (\VAG2 (fetch
EmulatorSpace of \InterfacePage) , ADDR))))) (EVAL (CAR ARGS)))))
(PUTPROPS EMGETBASE MACRO ((OFFSET) (\GETBASE (EMADDRESS OFFSET) 0)))
(PUTPROPS EMPUTBASE MACRO ((OFFSET VAL) (\PUTBASE (EMADDRESS OFFSET) 0 VAL)))
(PUTPROPS EMULATORSEGMENT MACRO (NIL (fetch EmulatorSpace of \InterfacePage)))
(PUTPROPS EMPOINTER MACRO (X (COND ((NEQ \D1BCPLspace \D0BCPLspace) (LIST (QUOTE \VAG2) (QUOTE (fetch
(IFPAGE EmulatorSpace) of \InterfacePage)) (CAR X))) ((ZEROP (CAR X)) NIL) (T (LIST (QUOTE \VAG2)
\D0BCPLspace (CAR X))))))
(PUTPROPS EMADDRESSP MACRO (X (LIST (QUOTE EQ) (LIST (QUOTE \HILOC) (CAR X)) (COND ((EQ \D1BCPLspace
\D0BCPLspace) \D0BCPLspace) (T (QUOTE (fetch (IFPAGE EmulatorSpace) of \InterfacePage)))))))
(PUTPROP (QUOTE LLPARAMS) (QUOTE IMPORTDATE) (IDATE "12-AUG-83 22:35:22"))
(PUTPROPS DPUTCODE MACRO ((FN CA SIZE) (SELECTQ (SYSTEMTYPE) (D (DEFC FN CA)) (/PUTPROP FN (QUOTE
DCODE) CA))))
(PUTPROPS MCODEP MACRO ((X) (OR (ARRAYP X) (AND (LITATOM X) (ARRAYP (SELECTQ (SYSTEMTYPE) (D (GETD X))
(GETPROP X (QUOTE DCODE))))))))
(PUTPROPS CODELT MACRO ((CA N) (\BYTELT CA N)))
(PUTPROPS CODELT2 MACRO (LAMBDA (DEF LC) (IPLUS (LLSH (CODELT DEF LC) 8) (CODELT DEF (ADD1 LC)))))
(PUTPROPS CODESETA2 MACRO (LAMBDA (DEF LC VALUE) (CODESETA DEF LC (LRSH VALUE 8)) (CODESETA DEF (ADD1
LC) (LOGAND VALUE 255))))
(PUTPROPS CODESETA MACRO ((CA N NV) (\BYTESETA CA N NV)))
(ADDTOVAR SYSSPECVARS CA)
(ACCESSFNS CODEARRAY ((STKMIN (CODELT2 DATUM 0) (CODESETA2 DATUM 0 NEWVALUE)) (NA (SIGNED (CODELT2
DATUM 2) BITSPERWORD) (CODESETA2 DATUM 2 (UNSIGNED NEWVALUE BITSPERWORD))) (PV (SIGNED (CODELT2 DATUM
4) BITSPERWORD) (CODESETA2 DATUM 4 (UNSIGNED NEWVALUE BITSPERWORD))) (STARTPC (CODELT2 DATUM 6) (
CODESETA2 DATUM 6 NEWVALUE)) (ARGTYPE (LOGAND (LRSH (CODELT DATUM 8) 4) 3) (CODESETA DATUM 8 (LOGOR (
LOGAND (CODELT DATUM 8) 65487) (LLSH (LOGAND NEWVALUE 3) 4)))) (FRAMENAME (\VAG2 (CODELT DATUM 9) (
CODELT2 DATUM 10)) (\FIXCODEPTR DATUM 11 (EVQ NEWVALUE))) (NTSIZE (CODELT2 DATUM 12) (CODESETA2 DATUM
12 NEWVALUE)) (NLOCALS (CODELT DATUM 14) (CODESETA DATUM 14 NEWVALUE)) (FVAROFFSET (CODELT DATUM 15) (
CODESETA DATUM 15 NEWVALUE))) (ACCESSFNS CODEARRAY ((LSTARP (ILESSP (fetch (CODEARRAY NA) of DATUM) 0)
) (OVERHEADWORDS (PROGN 8)) (ALIGNED (IPLUS (fetch (CODEARRAY NTSIZE) of DATUM) (fetch (CODEARRAY
OVERHEADWORDS) of T))) (FIXED NIL (replace (CODEARRAY STKMIN) of DATUM with (IPLUS (UNFOLD (IPLUS (
fetch (CODEARRAY NA) of DATUM) (UNFOLD (ADD1 (fetch (CODEARRAY PV) of DATUM)) CELLSPERQUAD))
WORDSPERCELL) 12 32))) (FRAMENAME# (PROGN 8)))))
(RECORD OPCODE (OP# OPCODENAME OPNARGS OPPRINT LEVADJ OPLAST UFNFN))
(ADDTOVAR GLOBALVARS \OPCODES)
(RPAQQ PVARCODE 32768)
(RPAQQ FVARCODE 49152)
(RPAQQ IVARCODE 0)
(RPAQQ VARCODEMASK 49152)
(CONSTANTS PVARCODE FVARCODE IVARCODE VARCODEMASK)
(PUTPROP (QUOTE LLCODE) (QUOTE IMPORTDATE) (IDATE " 5-MAR-83 00:28:13"))
(RPAQQ \ERRORMESSAGELIST ("SYSTEM ERROR" "UNUSED" "STACK OVERFLOW" "ILLEGAL RETURN" "ARG NOT LIST"
"HARD DISK ERROR" "ATTEMPT TO SET NIL OR T" "ATTEMPT TO RPLAC NIL" "UNDEFINED OR ILLEGAL GO"
"FILE WON'T OPEN" "NON-NUMERIC ARG" "ATOM TOO LONG" "ATOM HASH TABLE FULL" "FILE NOT OPEN"
"ARG NOT LITATOM" "! too many files open" "END OF FILE" "ERROR" "BREAK" "ILLEGAL STACK ARG"
"FAULT IN EVAL" "ARRAYS FULL" "FILE SYSTEM RESOURCES EXCEEDED" "FILE NOT FOUND" "BAD SYSOUT FILE"
"UNUSUAL CDR ARG LIST" "HASH TABLE FULL" "ILLEGAL ARG" "ARG NOT ARRAY" "ILLEGAL OR IMPOSSIBLE BLOCK"
"STACK PTR HAS BEEN RELEASED" "STORAGE FULL" "ATTEMPT TO USE ITEM OF INCORRECT TYPE"
"ILLEGAL DATA TYPE NUMBER" "DATA TYPES FULL" "ATTEMPT TO BIND NIL OR T"
"! too many user interrupt characters" "! read-macro context error" "ILLEGAL READTABLE"
"ILLEGAL TERMINAL TABLE" "! swapblock too big for buffer" "PROTECTION VIOLATION" "BAD FILE NAME"
"USER BREAK" "UNBOUND ATOM" "UNDEFINED CAR OF FORM" "UNDEFINED FUNCTION" "CONTROL-E"
"FLOATING UNDERFLOW" "FLOATING OVERFLOW" "OVERFLOW" "ARG NOT HARRAY" "TOO MANY ARGUMENTS"))
(PUTPROPS LISPERROR MACRO (ARGS (CONS (QUOTE \LISPERROR) (CONS (CADR ARGS) (CONS (COND ((STRINGP (CAR
ARGS)) (for X in \ERRORMESSAGELIST as I from 0 when (EQUAL X (CAR ARGS)) do (RETURN I) finally (RETURN
(HELP "Unknown error message" ARGS)))) (T (CAR ARGS))) (CDDR ARGS))))))
(PUTPROP (QUOTE AERROR) (QUOTE IMPORTDATE) (IDATE " 6-DEC-82 00:04:13"))
(PUTPROP (QUOTE AOFD) (QUOTE IMPORTDATE) (IDATE "26-JUL-83 22:00:35"))
(PUTPROPS \INTERMP MACRO ((OFD) (EQ OFD \LINEBUF.OFD)))
(PUTPROPS \OUTTERMP MACRO ((OFD) (EQ OFD \TERM.OFD)))
(ADDTOVAR GLOBALVARS \DEFAULTLINEBUF)
(PUTPROP (QUOTE ATERM) (QUOTE IMPORTDATE) (IDATE "24-JUL-83 23:10:18"))
(ADDTOVAR GLOBALVARS SYSHASHARRAY)
(PUTPROPS \#BLOCKDATACELLS MACRO ((DATAWORD) (IDIFFERENCE (fetch (ARRAYBLOCK ARLEN) of (\ADDBASE
DATAWORD (IMINUS \ArrayBlockHeaderWords))) \ArrayBlockOverheadCells)))
(PUTPROPS \ADDBASE2 MACRO (OPENLAMBDA (BASE N) (\ADDBASE (\ADDBASE BASE N) N)))
(PUTPROPS \ADDBASE4 MACRO (OPENLAMBDA (BASE N) (\ADDBASE2 (\ADDBASE2 BASE N) N)))
(PUTPROPS \BYTELT DMACRO (OPENLAMBDA (A J) (\GETBASEBYTE (fetch (ARRAYP BASE) of A) (IPLUS (fetch (
ARRAYP OFFST) of A) J))))
(PUTPROPS \BYTESETA DMACRO (OPENLAMBDA (A J V) (\PUTBASEBYTE (fetch (ARRAYP BASE) of A) (IPLUS (fetch
(ARRAYP OFFST) of A) J) V)))
(PUTPROPS \WORDELT DMACRO (OPENLAMBDA (A J) (CHECK (AND (ARRAYP A) (ZEROP (fetch (ARRAYP ORIG) of A))
(EQ \ST.POS16 (fetch (ARRAYP TYP) of A)))) (CHECK (IGREATERP (fetch (ARRAYP LENGTH) of A) J)) (
\GETBASE (fetch (ARRAYP BASE) of A) (IPLUS (fetch (ARRAYP OFFST) of A) J))))
(RPAQQ BLOCKGCTYPECONSTANTS ((CODEBLOCK.GCT 2) (PTRBLOCK.GCT 1) (UNBOXEDBLOCK.GCT 0)))
(RPAQQ CODEBLOCK.GCT 2)
(RPAQQ PTRBLOCK.GCT 1)
(RPAQQ UNBOXEDBLOCK.GCT 0)
(CONSTANTS (CODEBLOCK.GCT 2) (PTRBLOCK.GCT 1) (UNBOXEDBLOCK.GCT 0))
(RPAQQ ARRAYCONSTANTS (\ArrayBlockHeaderCells \ArrayBlockHeaderWords \ArrayBlockTrailerCells
\ArrayBlockTrailerWords (\ArrayBlockOverheadCells (IPLUS \ArrayBlockHeaderCells
\ArrayBlockTrailerCells)) (\ArrayBlockOverheadWords (IPLUS \ArrayBlockHeaderWords
\ArrayBlockTrailerWords)) \ArrayBlockLinkingCells (\MinArrayBlockSize (IPLUS \ArrayBlockOverheadCells
\ArrayBlockLinkingCells)) (\MaxArrayBlockSize 65535) (\MaxArrayNCells (IDIFFERENCE \MaxArrayBlockSize
\ArrayBlockOverheadCells)) \MaxArrayLen (\ABPASSWORDSHIFT 3) (\ArrayBlockPassword (LRSH 43690
\ABPASSWORDSHIFT)) (\FreeArrayFlagWord (LOGOR (LLSH \ArrayBlockPassword \ABPASSWORDSHIFT) (LLSH
UNBOXEDBLOCK.GCT 1))) (\UsedArrayFlagWord (LOGOR (LLSH \ArrayBlockPassword \ABPASSWORDSHIFT) 1)) (
\CodeArrayFlagWord (LOGOR (LLSH \ArrayBlockPassword \ABPASSWORDSHIFT) (LLSH CODEBLOCK.GCT 1) 1))))
(RPAQQ \ArrayBlockHeaderCells 1)
(RPAQQ \ArrayBlockHeaderWords 2)
(RPAQQ \ArrayBlockTrailerCells 1)
(RPAQQ \ArrayBlockTrailerWords 2)
(RPAQ \ArrayBlockOverheadCells (IPLUS \ArrayBlockHeaderCells \ArrayBlockTrailerCells))
(RPAQ \ArrayBlockOverheadWords (IPLUS \ArrayBlockHeaderWords \ArrayBlockTrailerWords))
(RPAQQ \ArrayBlockLinkingCells 2)
(RPAQ \MinArrayBlockSize (IPLUS \ArrayBlockOverheadCells \ArrayBlockLinkingCells))
(RPAQQ \MaxArrayBlockSize 65535)
(RPAQ \MaxArrayNCells (IDIFFERENCE \MaxArrayBlockSize \ArrayBlockOverheadCells))
(RPAQQ \MaxArrayLen 65535)
(RPAQQ \ABPASSWORDSHIFT 3)
(RPAQ \ArrayBlockPassword (LRSH 43690 \ABPASSWORDSHIFT))
(RPAQ \FreeArrayFlagWord (LOGOR (LLSH \ArrayBlockPassword \ABPASSWORDSHIFT) (LLSH UNBOXEDBLOCK.GCT 1))
)
(RPAQ \UsedArrayFlagWord (LOGOR (LLSH \ArrayBlockPassword \ABPASSWORDSHIFT) 1))
(RPAQ \CodeArrayFlagWord (LOGOR (LLSH \ArrayBlockPassword \ABPASSWORDSHIFT) (LLSH CODEBLOCK.GCT 1) 1))
(CONSTANTS \ArrayBlockHeaderCells \ArrayBlockHeaderWords \ArrayBlockTrailerCells
\ArrayBlockTrailerWords (\ArrayBlockOverheadCells (IPLUS \ArrayBlockHeaderCells
\ArrayBlockTrailerCells)) (\ArrayBlockOverheadWords (IPLUS \ArrayBlockHeaderWords
\ArrayBlockTrailerWords)) \ArrayBlockLinkingCells (\MinArrayBlockSize (IPLUS \ArrayBlockOverheadCells
\ArrayBlockLinkingCells)) (\MaxArrayBlockSize 65535) (\MaxArrayNCells (IDIFFERENCE \MaxArrayBlockSize
\ArrayBlockOverheadCells)) \MaxArrayLen (\ABPASSWORDSHIFT 3) (\ArrayBlockPassword (LRSH 43690
\ABPASSWORDSHIFT)) (\FreeArrayFlagWord (LOGOR (LLSH \ArrayBlockPassword \ABPASSWORDSHIFT) (LLSH
UNBOXEDBLOCK.GCT 1))) (\UsedArrayFlagWord (LOGOR (LLSH \ArrayBlockPassword \ABPASSWORDSHIFT) 1)) (
\CodeArrayFlagWord (LOGOR (LLSH \ArrayBlockPassword \ABPASSWORDSHIFT) (LLSH CODEBLOCK.GCT 1) 1)))
(RPAQQ ARRAYTYPES ((\ST.BYTE 0) (\ST.POS16 1) (\ST.INT32 2) (\ST.HASH 3) (\ST.CODE 4) (\ST.PTR 6) (
\ST.FLOAT 7) (\ST.BIT 8) (\ST.PTR2 11)))
(RPAQQ \ST.BYTE 0)
(RPAQQ \ST.POS16 1)
(RPAQQ \ST.INT32 2)
(RPAQQ \ST.HASH 3)
(RPAQQ \ST.CODE 4)
(RPAQQ \ST.PTR 6)
(RPAQQ \ST.FLOAT 7)
(RPAQQ \ST.BIT 8)
(RPAQQ \ST.PTR2 11)
(CONSTANTS (\ST.BYTE 0) (\ST.POS16 1) (\ST.INT32 2) (\ST.HASH 3) (\ST.CODE 4) (\ST.PTR 6) (\ST.FLOAT 7
) (\ST.BIT 8) (\ST.PTR2 11))
(BLOCKRECORD SEQUENCEDESCRIPTOR ((ORIG BITS 1) (NIL BITS 1) (READONLY FLAG) (NIL BITS 1) (TYP BITS 4)
(BASE POINTER) (LENGTH WORD) (OFFST WORD)))
(DATATYPE ARRAYP ((ORIG BITS 1) (NIL BITS 1) (READONLY FLAG) (* probably no READONLY arrays now) (NIL
BITS 1) (TYP BITS 4) (BASE POINTER) (LENGTH WORD) (OFFST WORD)) (* note that while ARRAYP is a
DATATYPE, the allocation of it actually happens at MAKEINIT time under INITDATATYPE{NAMES}))
(DATATYPE STRINGP ((ORIG BITS 1) (* ORIG is always 1) (NIL BITS 1) (READONLY FLAG) (NIL BITS 1) (TYP
BITS 4) (* TYP is always \ST.BYTE) (BASE POINTER) (LENGTH WORD) (OFFST WORD)) TYP ← \ST.BYTE ORIG ← 1
(* while STRINGP is declared as a declaration, the initialization really happens at MAKEINIT time
under INITDATATYPES using the DTDECLS list))
(BLOCKRECORD ARRAYBLOCK ((PASSWORD BITS 13) (GCTYPE BITS 2) (* Unboxed, Pointers, Code, ?) (INUSE FLAG
) (ARLEN WORD) (FWD FULLXPOINTER) (* Only when on free list) (BKWD FULLXPOINTER)) (BLOCKRECORD
ARRAYBLOCK ((ABFLAGS WORD) (* Used for header and trailer))) (ACCESSFNS ARRAYBLOCK ((DAT (\ADDBASE
DATUM \ArrayBlockHeaderWords)) (TRAILER (\ADDBASE2 DATUM (IDIFFERENCE (fetch (ARRAYBLOCK ARLEN) of
DATUM) \ArrayBlockTrailerCells))))) (TYPE? (PROGN (DECLARE (GLOBALVARS \ArrayFrLst)) (AND (ILEQ
\ARRAYspace (\HILOC DATUM)) (PTRGTP \ArrayFrLst DATUM)))))
(/DECLAREDATATYPE (QUOTE ARRAYP) (QUOTE ((BITS 1) (BITS 1) FLAG (BITS 1) (BITS 4) POINTER WORD WORD)))
(/DECLAREDATATYPE (QUOTE STRINGP) (QUOTE ((BITS 1) (BITS 1) FLAG (BITS 1) (BITS 4) POINTER WORD WORD))
)
(PUTPROP (QUOTE LLARRAYELT) (QUOTE IMPORTDATE) (IDATE " 5-JUL-83 14:31:40"))
(PUTPROPS PUTBASEPTRX MACRO (OPENLAMBDA (DATUM OFFSET NEWVALUE) (UNINTERRUPTABLY (\PUTBASE DATUM
OFFSET (LOGOR (LOGAND 65280 (\GETBASE DATUM OFFSET)) (\HILOC NEWVALUE))) (\PUTBASE DATUM (ADD1 OFFSET)
(LOLOC NEWVALUE)) NEWVALUE)))
(BLOCKRECORD DTD ((DTDNAME WORD) (DTDSIZE WORD) (DTDFREE FULLXPOINTER) (DTDDESCRS POINTER) (
DTDTYPESPECS POINTER) (DTDPTRS POINTER) (DTDOLDCNT FIXP) (DTDCNT0 WORD) (DTDNEXTPAGE WORD)) (ACCESSFNS
DTD ((DTDCNTLOC (\ADDBASE DATUM 10)) (DTDCNT (IPLUS (fetch DTDOLDCNT DATUM) (fetch DTDCNT0 DATUM)) (
UNINTERRUPTABLY (replace DTDCNT0 of DATUM with 0) (replace DTDOLDCNT of DATUM with NEWVALUE))))))
(PUTPROPS \GETDTD MACRO ((typeNum) (ADDBASE \DTDSpaceBase (LLSH typeNum 4))))
(PUTPROP (QUOTE LLDATATYPE) (QUOTE IMPORTDATE) (IDATE "13-AUG-83 01:39:28"))
(ACCESSFNS POINTER ((PAGE# (IPLUS (LLSH (\HILOC DATUM) 8) (LRSH (\LOLOC DATUM) 8))) (WORDINPAGE (
LOGAND (\LOLOC DATUM) 255)) (CELLINPAGE (LRSH (fetch WORDINPAGE of DATUM) 1)) (BYTEINPAGE (LLSH (fetch
WORDINPAGE of DATUM) 1)) (SEGMENT# (\HILOC DATUM)) (WORDINSEGMENT (\LOLOC DATUM)) (CELLINSEGMENT (
LRSH (fetch WORDINSEGMENT of DATUM) 1)) (WORD# (fetch WORDINPAGE of DATUM)) (DBLWORD# (fetch
CELLINPAGE of DATUM)) (PAGEBASE (\VAG2 (\HILOC DATUM) (LOGAND (\LOLOC DATUM) 65280)))) (CREATE (\VAG2
(LRSH PAGE# 8) (LLSH (LOGAND PAGE# 255) 8))))
(ACCESSFNS WORD ((HIBYTE (LRSH DATUM 8)) (LOBYTE (LOGAND DATUM 255))) (CREATE (IPLUS (LLSH HIBYTE 8)
LOBYTE)))
(PUTPROPS PTRGTP MACRO (OPENLAMBDA (X Y) (OR (IGREATERP (\HILOC X) (\HILOC Y)) (AND (EQ (\HILOC X) (
\HILOC Y)) (IGREATERP (\LOLOC X) (\LOLOC Y))))))
(PUTPROPS .COERCE.TO.SMALLPOSP. MACRO ((X) (COND ((IGREATERP 0 (SETQ X (\DTEST X (QUOTE SMALLP)))) (
\ILLEGAL.ARG X)) (T X))))
(PUTPROPS .COERCE.TO.BYTE. MACRO ((X) (COND ((OR (IGREATERP 0 (SETQ X (\DTEST X (QUOTE SMALLP)))) (
IGREATERP X 255)) (\ILLEGAL.ARG X)) (T X))))
(BLOCKRECORD LISTP ((CAR POINTER) (CDR POINTER)) (CREATE (CREATECELL \LISTP)) (* FOLLOWING ARE
CDR-CODE FIELDS) (BLOCKRECORD LISTP ((CDRCODE BYTE) (CARFIELD XPOINTER))) (ACCESSFNS LISTP ((
FULLCARFIELD NIL (\PUTBASEPTR DATUM 0 NEWVALUE)))) (* because replace of XPOINTER is slow, the CAR
field is stored with PUTBASEPTR, even though that smashes the hi byte))
(BLOCKRECORD CONSPAGE ((CNT BYTE) (NEXTCELL BYTE) (NEXTPAGE WORD)))
(RPAQQ CONSCONSTANTS (\CDR.ONPAGE \CDR.NIL \CDR.INDIRECT \CDR.MAXINDIRECT \CONSPAGE.LAST))
(RPAQQ \CDR.ONPAGE 128)
(RPAQQ \CDR.NIL 128)
(RPAQQ \CDR.INDIRECT 0)
(RPAQQ \CDR.MAXINDIRECT 127)
(RPAQQ \CONSPAGE.LAST 65535)
(CONSTANTS \CDR.ONPAGE \CDR.NIL \CDR.INDIRECT \CDR.MAXINDIRECT \CONSPAGE.LAST)
(PUTPROPS LOCAL MACRO ((X) X))
(PUTPROPS ALLOCAL MACRO ((X) X))
(PUTPROP (QUOTE LLNEW) (QUOTE IMPORTDATE) (IDATE "22-JUN-83 15:12:46"))
(PUTPROPS CHECK MACRO (ARGS (COND ((AND (BOUNDP (QUOTE CHECK)) CHECK) (CONS (QUOTE PROGN) (for I in
ARGS collect (LIST (QUOTE OR) I (LIST (QUOTE RAID) (KWOTE (LIST (QUOTE Check-failure:) I))))))) (T (
CONS COMMENTFLG ARGS)))))
(PUTPROPS \StatsZero BYTEMACRO (OPENLAMBDA (N) (\PUTBASE N 0 0) (\PUTBASE N 1 0)))
(PUTPROPS \StatsAdd1 BYTEMACRO (OPENLAMBDA (A) (PROG NIL (\PUTBASE A 1 ((LAMBDA (J) (DECLARE (
LOCALVARS . T)) (COND ((EQ J MAX.SMALL.INTEGER) (\PUTBASE A 0 (COND ((EQ (\GETBASE A 0) MAX.POS.HINUM)
0) (T (ADD1 (\GETBASE A 0))))) 0) (T (ADD1 J)))) (\GETBASE A 1))))))
(PUTPROPS SMALLPOSP MACRO ((X) (EQ (\HILOC X) (CONSTANT \SmallPosHi))))
(PUTPROPS SETXVAR MACRO (X (COND ((EQ (CAAR X) (QUOTE QUOTE)) (LIST (QUOTE SETQ) (CADAR X) (CADR X)))
((LITATOM (CAR X)) (LIST (QUOTE SET) (CAR X) (CADR X))) (T (HELP (CONS X (QUOTE (bad SETXVAR form)))))
)))
(PUTPROPS SETXVAR ALTOMACRO (X (OR (AND (EQ (CAAR X) (QUOTE QUOTE)) (LITATOM (CADAR X))) (SHOULDNT)) (
GLOBALVARS \VALSPACE) (LIST (QUOTE SETQ.NOREF) (CADAR X) (CADR X))))
(PUTPROPS SETQ.NOREF DMACRO ((VAR VALUE) (\PUTBASEPTR \VALSPACE (LLSH (\ATOMVALINDEX (QUOTE VAR)) 1)
VALUE)))
(PUTPROPS IEQ MACRO ((X Y) (IEQP X Y)))
(PUTPROPS IEQ ALTOMACRO (= . EQ))
(PUTPROPS IEQ DMACRO (= . EQ))
(SETTEMPLATE (QUOTE SPREADAPPLY*) (QUOTE (FUNCTIONAL .. EVAL)))
(SETTEMPLATE (QUOTE SPREADAPPLY) (QUOTE (FUNCTIONAL EVAL . PPE)))
(SETTEMPLATE (QUOTE SETQ.NOREF) (QUOTE (SET EVAL . PPE)))
(RPAQQ WordsPerPage 256)
(CONSTANTS WordsPerPage)
(ACCESSFNS LITATOM ((PNPCELL (\ADDBASE \PNPSPACE (LLSH (\ATOMPROPINDEX DATUM) 1))) (DEFINITIONCELL (
\ADDBASE \DEFSPACE (LLSH (\ATOMDEFINDEX DATUM) 1))) (PROPCELL (\ADDBASE \PLISTSPACE (LLSH (
\ATOMPROPINDEX DATUM) 1))) (VALINDEX (\ATOMVALINDEX DATUM))) (TYPE? (LITATOM DATUM)) (BLOCKRECORD
PNPCELL ((PNAMEBASE FULLXPOINTER)) (BLOCKRECORD PNAMEBASE ((PNAMELENGTH BYTE)))) (BLOCKRECORD PROPCELL
((PROPLIST POINTER))))
(BLOCKRECORD VCELL ((VALUE FULLPOINTER)))
(ACCESSFNS VALINDEX ((VCELL (\ADDBASE \VALSPACE (LLSH DATUM 1)))))
(BLOCKRECORD DEFINITIONCELL ((CCODEP FLAG) (FASTP FLAG) (ARGTYPE BITS 2) (PSEUDOCODEP FLAG) (NIL BITS
3) (DEFPOINTER POINTER)))
(BLOCKRECORD FNHEADER ((STKMIN WORD) (NA SIGNEDWORD) (PV SIGNEDWORD) (STARTPC WORD) (NIL FLAG) (NIL
FLAG) (ARGTYPE BITS 2) (NIL BITS 4) (#FRAMENAME XPOINTER) (NTSIZE WORD) (NLOCALS BYTE) (FVAROFFSET
BYTE)) (ACCESSFNS FNHEADER ((LSTARP (ILESSP (fetch (FNHEADER NA) of DATUM) 0)) (OVERHEADWORDS (PROGN 8
)) (ALIGNED (IPLUS (fetch (FNHEADER NTSIZE) of DATUM) (fetch (FNHEADER OVERHEADWORDS) of T))) (FIXED
NIL (replace (FNHEADER STKMIN) of DATUM with (IPLUS (UNFOLD (IPLUS (fetch (FNHEADER NA) of DATUM) (
UNFOLD (ADD1 (fetch (FNHEADER PV) of DATUM)) CELLSPERQUAD)) WORDSPERCELL) 12 32))) (NPVARWORDS (UNFOLD
(ADD1 (fetch (FNHEADER PV) of DATUM)) WORDSPERQUAD)) (FRAMENAME (fetch (FNHEADER #FRAMENAME) of DATUM
) (UNINTERRUPTABLY (CHECK (NEQ (\HILOC DATUM) \STACKHI)) (\DELREF (fetch (FNHEADER #FRAMENAME) of
DATUM)) (\ADDREF NEWVALUE) (replace (FNHEADER #FRAMENAME) of DATUM with NEWVALUE))))))
(PUTPROPS \ATOMVALINDEX DMACRO (= . \LOLOC))
(PUTPROPS \ATOMDEFINDEX DMACRO (= . \LOLOC))
(PUTPROPS \ATOMPNAMEINDEX DMACRO (= . \LOLOC))
(PUTPROPS \ATOMPROPINDEX DMACRO (= . \LOLOC))
(PUTPROPS \INDEXATOMPNAME DMACRO ((X) (\VAG2 \AtomHI X)))
(PUTPROPS \INDEXATOMVAL DMACRO ((X) (\VAG2 \AtomHI X)))
(PUTPROPS \INDEXATOMDEF DMACRO ((X) (\VAG2 \AtomHI X)))
(ADDTOVAR GLOBALVARS \NxtPnByte \CurPnPage \NxtAtomPage \AtomFrLst \OneCharAtomBase \SCRATCHSTRING
COMPILEATPUTDFLG)
(RPAQQ \LastAtomPage 127)
(RPAQQ \PNAMELIMIT 127)
(RPAQQ \CharsPerPnPage 512)
(RPAQQ \AtomHTmask 32767)
(RPAQQ \PnCharsFblock 24)
(CONSTANTS (\LastAtomPage 127) \PNAMELIMIT (\CharsPerPnPage 512) (\AtomHTmask 32767) (\PnCharsFblock
24))
(PUTPROPS ALTO.TO.LISP.DATE MACRO ((DATE) (LOGXOR DATE -2147483648)))
(PUTPROPS LISP.TO.ALTO.DATE MACRO ((DATE) (LOGXOR DATE -2147483648)))
(PUTPROP (QUOTE LLBASIC) (QUOTE IMPORTDATE) (IDATE " 2-AUG-83 13:00:44"))
(ADDTOVAR GLOBALVARS \OneCharAtomBase)
(RPAQQ \NUMSTR NIL)
(RPAQQ \NUMSTR1 NIL)
(RPAQQ \PNAMESTRING NIL)
(ADDTOVAR GLOBALVARS \NUMSTR \NUMSTR1 \PNAMESTRING)
(PUTDEF (QUOTE \NUMSTR) (QUOTE GLOBALRESOURCES) (QUOTE (ALLOCSTRING 38)))
(PUTDEF (QUOTE \NUMSTR1) (QUOTE GLOBALRESOURCES) (QUOTE (CONCAT)))
(PUTDEF (QUOTE \PNAMESTRING) (QUOTE GLOBALRESOURCES) (QUOTE (ALLOCSTRING \PNAMELIMIT)))
(PUTPROPS FCHARACTER DMACRO (OPENLAMBDA (N) (COND ((IGREATERP N (CHARCODE 9)) (\ADDBASE
\OneCharAtomBase (IDIFFERENCE N 10))) ((IGEQ N (CHARCODE 0)) (IDIFFERENCE N (CHARCODE 0))) (T (
\ADDBASE \OneCharAtomBase N)))))
(I.S.OPR (QUOTE INATOM) NIL (QUOTE (SUBPAIR (QUOTE ($$OFF $$BASE $$END $$BODY)) (LIST (GETDUMMYVAR) (
GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (BIND $$OFF ← 1 $$BODY ← BODY $$BASE $$END FIRST
$$BASE ← (fetch (LITATOM PNAMEBASE) of BODY) $$END ← (fetch (LITATOM PNAMELENGTH) of BODY) EACHTIME (
COND ((IGREATERP $$OFF $$END) (GO $$OUT))) (SETQ I.V. (GETBASEBYTE $$BASE (PROG1 $$OFF (SETQ $$OFF (
ADD1 $$OFF))))))))) T)
(I.S.OPR (QUOTE INSTRING) NIL (QUOTE (SUBPAIR (QUOTE ($$END $$OFF $$BASE $$BODY)) (LIST (GETDUMMYVAR)
(GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (BIND $$BODY ← BODY $$END $$OFF $$BASE FIRST (SETQ
$$OFF (fetch (STRINGP OFFST) of $$BODY)) (SETQ $$BASE (fetch (STRINGP BASE) of $$BODY)) (SETQ $$END (
IPLUS $$OFF (SUB1 (fetch (STRINGP LENGTH) of $$BODY)))) EACHTIME (COND ((IGREATERP $$OFF $$END) (GO
$$OUT))) (SETQ I.V. (\GETBASEBYTE $$BASE (PROG1 $$OFF (SETQ $$OFF (ADD1 $$OFF))))))))) T)
(RPAQQ \CHARMASK 255)
(RPAQQ \MAXCHAR 255)
(CONSTANTS (\CHARMASK 255) (\MAXCHAR 255))
(PUTPROPS \NATOMCHARS DMACRO ((AT) (FETCH (LITATOM PNAMELENGTH) OF AT)))
(PUTPROPS \NSTRINGCHARS DMACRO ((S) (fetch (STRINGP LENGTH) of S)))
(PUTPROPS \RPLCHARCODE DMACRO ((X N CHAR) (\PUTBASEBYTE (fetch (STRINGP BASE) of X) (IPLUS (fetch (
STRINGP OFFST) of X) (SUB1 N)) CHAR)))
(PUTPROP (QUOTE LLCHAR) (QUOTE IMPORTDATE) (IDATE " 1-AUG-83 15:59:39"))
(ACCESSFNS BF ((BFBLOCK (ADDSTACKBASE DATUM))) (* basic frame pointer) (BLOCKRECORD BFBLOCK ((FLAGS
BITS 3) (NIL BITS 3) (RESIDUAL FLAG) (PADDING BITS 1) (USECNT BITS 8) (IVAR WORD))) (TYPE? (IEQ (fetch
(BF FLAGS) of DATUM) \STK.BF)) (ACCESSFNS BF ((NARGS (IDIFFERENCE (FOLDLO (IDIFFERENCE DATUM (fetch (
BF IVAR) of DATUM)) WORDSPERCELL) (fetch (BF PADDING) of DATUM))) (SIZE (IPLUS 2 (IDIFFERENCE DATUM (
fetch (BF IVAR) of DATUM)))) (CHECKED (AND (type? BF DATUM) (for I from (fetch (BF IVAR) of DATUM) to
(IDIFFERENCE DATUM 2) by 2 always (IEQ \STK.NOTFLAG (fetch (BF FLAGS) of I))))))))
(ACCESSFNS FX ((FXBLOCK (ADDSTACKBASE DATUM))) (* frame extension index) (BLOCKRECORD FXBLOCK ((FLAGS
BITS 3) (FAST FLAG) (NIL FLAG) (INCALL FLAG) (VALIDNAMETABLE FLAG) (NOPUSH FLAG) (USECNT BITS 8) (
#ALINK WORD) (FNHEADLO WORD) (FNHEADHI1 BYTE) (FNHEADHI2 BYTE) (NEXTBLOCK WORD) (PC WORD) (NAMETABLO
WORD) (NAMETABHI1 BYTE) (NAMETABHI2 BYTE) (#BLINK WORD) (#CLINK WORD))) (TYPE? (IEQ (fetch (FX FLAGS)
of DATUM) \STK.FX)) (ACCESSFNS FX ((FNHEADER (\VAG2 (fetch FNHEADHI of DATUM) (fetch FNHEADLO of DATUM
)) (PROGN (replace FNHEADHI of DATUM with (\HILOC NEWVALUE)) (replace FNHEADLO of DATUM with (\LOLOC
NEWVALUE)))) (FNHEADHI (fetch FNHEADHI2 of DATUM) (PROGN (replace FNHEADHI1 of DATUM with NEWVALUE) (
replace FNHEADHI2 of DATUM with NEWVALUE))) (NAMETABLE# (\VAG2 (fetch NAMETABHI of DATUM) (fetch
NAMETABLO of DATUM)) (PROGN (replace NAMETABHI of DATUM with (\HILOC NEWVALUE)) (replace NAMETABLO of
DATUM with (\LOLOC NEWVALUE)))) (NAMETABLE (COND ((fetch VALIDNAMETABLE of DATUM) (fetch NAMETABLE# of
DATUM)) (T (fetch FNHEADER of DATUM))) (PROGN (replace FAST of DATUM with NIL) (replace NAMETABLE# of
DATUM with NEWVALUE) (replace VALIDNAMETABLE of DATUM with T))) (NAMETABHI (fetch NAMETABHI2 of DATUM
) (PROGN (replace NAMETABHI1 of DATUM with NEWVALUE) (replace NAMETABHI2 of DATUM with NEWVALUE))) (
FRAMENAME (fetch (FNHEADER FRAMENAME) of (fetch (FX NAMETABLE) of DATUM))) (INVALIDP (ZEROP DATUM)) (
FIRSTPVAR (IPLUS DATUM (fetch FXSIZE of T))) (FXSIZE (PROGN 10)) (FASTP (EVENP (fetch #ALINK of DATUM)
WORDSPERCELL) (PROGN (CHECK (NULL NEWVALUE)) (COND ((fetch (FX FASTP) of DATUM) (replace #BLINK of
DATUM with (fetch DUMMYBF of DATUM)) (replace #CLINK of DATUM with (fetch #ALINK of DATUM)) (replace
#ALINK of DATUM with (IPLUS (fetch #ALINK of DATUM) (SUB1 WORDSPERCELL))))))) (BLINK (COND ((fetch (FX
FASTP) of DATUM) (fetch DUMMYBF of DATUM)) (T (fetch #BLINK of DATUM))) (PROGN (replace (FX FASTP) of
DATUM with NIL) (replace #BLINK of DATUM with NEWVALUE))) (CLINK (IDIFFERENCE (COND ((fetch (FX FASTP
) of DATUM) (fetch #ALINK of DATUM)) (T (fetch #CLINK of DATUM))) \#ALINK.OFFSET) (PROGN (replace (FX
FASTP) of DATUM with NIL) (replace #CLINK of DATUM with (IPLUS NEWVALUE \#ALINK.OFFSET)))) (ALINK (
IDIFFERENCE (FLOOR (fetch #ALINK of DATUM) WORDSPERCELL) \#ALINK.OFFSET) (PROGN (replace (FX FASTP) of
DATUM with NIL) (replace #ALINK of DATUM with (IPLUS NEWVALUE \#ALINK.OFFSET (SUB1 WORDSPERCELL)))))
(DUMMYBF (IDIFFERENCE DATUM WORDSPERCELL)) (IVAR (fetch (BF IVAR) of (fetch DUMMYBF of DATUM))) (
CHECKED (AND (type? FX DATUM) (OR (IEQ (fetch (FX DUMMYBF) of DATUM) (fetch (FX BLINK) of DATUM)) (AND
(fetch (BF RESIDUAL) of (fetch (FX DUMMYBF) of DATUM)) (IEQ (fetch (BF IVAR) of (fetch (FX DUMMYBF)
of DATUM)) (fetch (BF IVAR) of (fetch (FX BLINK) of DATUM))))))) (PADDING (PROGN 4)) (FIRSTTEMP (IPLUS
(fetch (FX FIRSTPVAR) of DATUM) (fetch (FX NPVARWORDS) of DATUM) (fetch (FX PADDING) of DATUM))) (
SIZE (IDIFFERENCE (fetch (FX NEXTBLOCK) of DATUM) DATUM))) (* FNHEADER: note FNHEADER pointer is
swapped order with \HILOC duplicated - NAMETABLE: use FNHEADER unless VALIDNAMETABLE bit set -
INVALIDP is used when scanning up ALINK/CLINK chains - FIRSTPVAR is "pointer" to first PVAR slot -
FXSIZE is constant which is size of "fixed" overhead - FASTP is the "field" which says that the BLINK
and CLINK fields are valid - IVAR: a FX is ALWAYS preceded by enough of its basic frame to find its
IVAR slot. This means however that when a FX is copied, the cell preceding the FX is copied too -
FIRSTTEMP: note that NPVARWORDS is obtained from the FNHEADER; WORDSPERQUAD addition is doublecell of
garbage for microcode use)))
(ACCESSFNS FSB ((FSBBLOCK (ADDSTACKBASE DATUM)) (CHECKED (IEQ (fetch (FSB FLAGWORD) of DATUM)
\STK.FSB.WORD))) (BLOCKRECORD FSBBLOCK ((FLAGS BITS 3) (DUMMY BITS 13) (SIZE WORD))) (BLOCKRECORD
FSBBLOCK ((FLAGWORD WORD) (SIZE WORD))) (* free stack block) (TYPE? (IEQ (fetch (FSB FLAGS) of DATUM)
\STK.FSB)))
(ACCESSFNS STK ((STKBLOCK (ADDSTACKBASE DATUM))) (* random stack pointer) (BLOCKRECORD STKBLOCK ((
FLAGS BITS 3))) (BLOCKRECORD STKBLOCK ((FLAGWORD WORD))))
(RPAQQ \#ALINK.OFFSET 10)
(CONSTANTS \#ALINK.OFFSET)
(ADDTOVAR GLOBALVARS \PENDINGINTERRUPT \KBDSTACKBASE \MISCSTACKBASE \STACKOVERFLOW)
(PUTPROPS \MYALINK DMACRO (NIL ((OPCODES MYALINK))))
(PUTPROPS ADDSTACKBASE DMACRO (= . STACKADDBASE))
(PUTPROPS STACKADDBASE DMACRO ((N) (VAG2 \STACKHI N)))
(PUTPROPS STACKGETBASE DMACRO ((N) (\GETBASE (STACKADDBASE N) 0)))
(PUTPROPS STACKGETBASEPTR DMACRO ((N) (\GETBASEPTR (STACKADDBASE N) 0)))
(PUTPROPS STACKPUTBASE DMACRO ((N V) (\PUTBASE (STACKADDBASE N) 0 V)))
(PUTPROPS STACKPUTBASEPTR DMACRO ((N V) (\PUTBASEPTR (STACKADDBASE N) 0 V)))
(PUTPROPS \MISCAPPLY* MACRO ((FN ARG1 ARG2) (UNINTERRUPTABLY (replace (IFPAGE MISCSTACKFN) of
\InterfacePage with FN) (replace (IFPAGE MISCSTACKARG1) of \InterfacePage with ARG1) (replace (IFPAGE
MISCSTACKARG2) of \InterfacePage with ARG2) (\CONTEXTSWITCH \MiscFXP) (fetch (IFPAGE MISCSTACKRESULT)
of \InterfacePage))))
(BLOCKRECORD STACKP ((STACKP0 WORD) (EDFXP WORD)) (BLOCKRECORD STACKP ((STACKPOINTER FULLXPOINTER))) (
TYPE? (STACKP DATUM)))
(RPAQQ STACKTYPES (\STK.GUARD \STK.FX \STK.BF \STK.NOTFLAG \STK.FSB \STK.FLAGS.SHIFT (\STK.FSB.WORD (
LLSH \STK.FSB \STK.FLAGS.SHIFT)) (\STK.GUARD.WORD (LLSH \STK.GUARD \STK.FLAGS.SHIFT)) (\STK.BF.WORD (
LLSH \STK.BF \STK.FLAGS.SHIFT))))
(RPAQQ \STK.GUARD 7)
(RPAQQ \STK.FX 6)
(RPAQQ \STK.BF 4)
(RPAQQ \STK.NOTFLAG 0)
(RPAQQ \STK.FSB 5)
(RPAQQ \STK.FLAGS.SHIFT 13)
(RPAQ \STK.FSB.WORD (LLSH \STK.FSB \STK.FLAGS.SHIFT))
(RPAQ \STK.GUARD.WORD (LLSH \STK.GUARD \STK.FLAGS.SHIFT))
(RPAQ \STK.BF.WORD (LLSH \STK.BF \STK.FLAGS.SHIFT))
(CONSTANTS \STK.GUARD \STK.FX \STK.BF \STK.NOTFLAG \STK.FSB \STK.FLAGS.SHIFT (\STK.FSB.WORD (LLSH
\STK.FSB \STK.FLAGS.SHIFT)) (\STK.GUARD.WORD (LLSH \STK.GUARD \STK.FLAGS.SHIFT)) (\STK.BF.WORD (LLSH
\STK.BF \STK.FLAGS.SHIFT)))
(RPAQQ \StackAreaSize 768)
(RPAQ \InitStackSize (ITIMES \StackAreaSize 12))
(CONSTANTS \StackAreaSize (\InitStackSize (ITIMES \StackAreaSize 12)))
(RPAQQ \MAXSAFEUSECOUNT 200)
(CONSTANTS \MAXSAFEUSECOUNT)
(BLOCKRECORD NAMETABLESLOT ((VARTYPE BYTE) (VAROFFSET BYTE)))
(BLOCKRECORD FVARSLOT ((BINDLO WORD) (BINDHI1 BYTE) (BINDHI2 BYTE)) (ACCESSFNS FVARSLOT ((LOOKEDUP (
EVENP (fetch BINDLO of DATUM))) (BINDINGPTR (\VAG2 (fetch BINDHI1 of DATUM) (fetch BINDLO of DATUM)) (
PROGN (replace BINDLO of DATUM with (\LOLOC NEWVALUE)) (replace BINDHI1 of DATUM with (replace BINDHI2
of DATUM with (\HILOC NEWVALUE))))))))
(BLOCKRECORD PVARSLOT ((PVHI BYTE) (PVVALUE XPOINTER)) (ACCESSFNS PVARSLOT ((BOUND (ZEROP (fetch PVHI
of DATUM))))))
(BLOCKRECORD STKTEMPSLOT ((STKTMPHI BYTE) (VALUE XPOINTER)) (ACCESSFNS STKTEMPSLOT ((BINDINGPTRP (NOT
(ZEROP (fetch STKTMPHI of DATUM)))))))
(RPAQQ \NT.IVAR 0)
(RPAQQ \NT.PVAR 128)
(RPAQQ \NT.FVAR 192)
(CONSTANTS \NT.IVAR \NT.PVAR \NT.FVAR)
(PUTPROP (QUOTE LLSTK) (QUOTE IMPORTDATE) (IDATE "22-JUN-83 18:54:13"))
(PUTPROPS WORDCONTENTS BYTEMACRO ((PTR) (\GETBASE PTR 0)))
(PUTPROPS SETWORDCONTENTS BYTEMACRO ((PTR N) (\PUTBASE PTR 0 N)))
(PUTPROPS WORDOFFSET BYTEMACRO ((PTR N) (\ADDBASE PTR N)))
(PUTPROP (QUOTE PMAP) (QUOTE IMPORTDATE) (IDATE "10-MAR-83 23:34:22"))
(PUTPROPS ADDREF MACRO (OPENLAMBDA (PTR) (PROG1 PTR (\ADDREF PTR))))
(PUTPROPS \ADDREF DMACRO ((X) ((OPCODES GCREF 0) X)))
(PUTPROPS DELETEREF MACRO (OPENLAMBDA (PTR) (PROG1 PTR (\DELREF PTR))))
(PUTPROPS \DELREF DMACRO ((X) ((OPCODES GCREF 1) X)))
(PUTPROPS SCANREF MACRO (= . \STKREF))
(PUTPROPS \STKREF DMACRO ((X) ((OPCODES GCREF 2) X)))
(PUTPROPS UNSCANREF MACRO ((PTR) (\HTFIND PTR 3)))
(PUTPROPS CREATEREF MACRO (= . \CREATEREF))
(PUTPROPS \CREATEREF MACRO (OPENLAMBDA (PTR) (PROG1 (\DELREF PTR) (.INCREMENT.ALLOCATION.COUNT. 1))))
(PUTPROPS .INCREMENT.ALLOCATION.COUNT. MACRO (OPENLAMBDA (N) (DECLARE (GLOBALVARS \RECLAIM.COUNTDOWN))
(AND \RECLAIM.COUNTDOWN (COND ((IGREATERP \RECLAIM.COUNTDOWN N) (SETQ \RECLAIM.COUNTDOWN (IDIFFERENCE
\RECLAIM.COUNTDOWN N))) (T (SETQ \RECLAIM.COUNTDOWN) (\DORECLAIM))))))
(PUTPROPS \GCDISABLED MACRO (NIL (* lmm "30-NOV-81 14:08") (IGEQ (fetch (HTCOLL NEXTFREE) of \HTCOLL)
\HTCOLLSIZE)))
(BLOCKRECORD HTOVERFLOW ((CASE BYTE) (PTR XPOINTER)) (ACCESSFNS HTOVERFLOW ((CLEAR NIL (\PUTBASEPTR
DATUM 0 NIL)))))
(BLOCKRECORD GC ((CNT BITS 6) (STKBIT FLAG) (HIBITS BITS 8) (LINKP FLAG) (NXTPTR WORD)) (BLOCKRECORD
GC ((STKCNT BITS 7))) (ACCESSFNS GC ((EMPTY (ZEROP (\GETBASE DATUM 0)) (\PUTBASE DATUM 0 0)) (CONTENTS
(\GETBASE DATUM 0) (\PUTBASE DATUM 0 NEWVALUE)) (LINKPTR (LOGAND (\GETBASE DATUM 0) 65534) (\PUTBASE
DATUM 0 (LOGOR NEWVALUE 1))))))
(BLOCKRECORD HTCOLL ((FREEPTR WORD) (NEXTFREE WORD)))
(PUTPROP (QUOTE LLGC) (QUOTE IMPORTDATE) (IDATE "13-FEB-83 13:59:35"))
(RPAQQ CCECHOMODES (REAL.CCE IGNORE.CCE SIMULATE.CCE INDICATE.CCE))
(RPAQQ REAL.CCE 0)
(RPAQQ IGNORE.CCE 8)
(RPAQQ SIMULATE.CCE 16)
(RPAQQ INDICATE.CCE 24)
(CONSTANTS REAL.CCE IGNORE.CCE SIMULATE.CCE INDICATE.CCE)
(RPAQQ TERMCLASSES (NONE.TC EOL.TC CHARDELETE.TC WORDDELETE.TC WORDSEPR.TC LINEDELETE.TC RETYPE.TC
CTRLV.TC))
(RPAQQ NONE.TC 0)
(RPAQQ EOL.TC 1)
(RPAQQ CHARDELETE.TC 2)
(RPAQQ WORDDELETE.TC 6)
(RPAQQ WORDSEPR.TC 7)
(RPAQQ LINEDELETE.TC 3)
(RPAQQ RETYPE.TC 4)
(RPAQQ CTRLV.TC 5)
(CONSTANTS NONE.TC EOL.TC CHARDELETE.TC WORDDELETE.TC WORDSEPR.TC LINEDELETE.TC RETYPE.TC CTRLV.TC)
(ACCESSFNS TERMCODE ((CCECHO (LOGAND DATUM 24)) (TERMCLASS (LOGAND DATUM 7))) (* We assume that values
are appropriately shifted) (CREATE (LOGOR CCECHO TERMCLASS)))
(DATATYPE TERMTABLEP (TERMSA RAISEFLG DELCHARECHO LINEDELETE 1STCHDEL NTHCHDEL POSTCHDEL EMPTYCHDEL (
CONTROLFLG FLAG) (ECHOFLG FLAG)) TERMSA ← (create CHARTABLE))
(/DECLAREDATATYPE (QUOTE TERMTABLEP) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER FLAG FLAG)))
(PUTPROPS \GETREADMACRODEF MACRO ((C TBL) (GETHASH C (fetch READMACRODEFS of TBL))))
(PUTPROPS \GTREADTABLE MACRO (ARGS (COND ((LITATOM (CAR ARGS)) (LIST (QUOTE PROGN) (QUOTE (DECLARE (
GLOBALVARS \SYSREADTABLE))) (SUBPAIR (QUOTE (X . FLG)) ARGS (QUOTE (SELECTQ X (NIL \PRIMREADTABLE) (T
\SYSREADTABLE) (\GTREADTABLE1 X . FLG)))))) (T (QUOTE IGNOREMACRO)))))
(RPAQQ MACROBIT 8)
(RPAQQ BREAKBIT 16)
(RPAQQ STOPATOMBIT 32)
(RPAQQ ESCAPEBIT 64)
(CONSTANTS MACROBIT BREAKBIT STOPATOMBIT ESCAPEBIT)
(RPAQQ READCODEMASKS ((CONTEXTMASK (LOGOR MACROBIT STOPATOMBIT BREAKBIT 1)) (WAKEUPMASK (LOGOR
MACROBIT 2))))
(RPAQ CONTEXTMASK (LOGOR MACROBIT STOPATOMBIT BREAKBIT 1))
(RPAQ WAKEUPMASK (LOGOR MACROBIT 2))
(CONSTANTS (CONTEXTMASK (LOGOR MACROBIT STOPATOMBIT BREAKBIT 1)) (WAKEUPMASK (LOGOR MACROBIT 2)))
(RPAQQ READMACROCONTEXTS ((ALWAYS.RMC (LOGOR MACROBIT STOPATOMBIT BREAKBIT 0)) (FIRST.RMC (LOGOR
MACROBIT 0)) (ALONE.RMC (LOGOR MACROBIT 1))))
(RPAQ ALWAYS.RMC (LOGOR MACROBIT STOPATOMBIT BREAKBIT 0))
(RPAQ FIRST.RMC (LOGOR MACROBIT 0))
(RPAQ ALONE.RMC (LOGOR MACROBIT 1))
(CONSTANTS (ALWAYS.RMC (LOGOR MACROBIT STOPATOMBIT BREAKBIT 0)) (FIRST.RMC (LOGOR MACROBIT 0)) (
ALONE.RMC (LOGOR MACROBIT 1)))
(* OTHER.RC must be 0 cause of initialization.)
(RPAQQ READCLASSES ((OTHER.RC 0) (SEPRCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT 0)) (BREAKCHAR.RC (LOGOR
ESCAPEBIT STOPATOMBIT BREAKBIT 0)) (STRINGDELIM.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 1)) (
LEFTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 2)) (RIGHTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT
BREAKBIT 3)) (LEFTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 4)) (RIGHTBRACKET.RC (LOGOR
ESCAPEBIT STOPATOMBIT BREAKBIT 5)) (ESCAPE.RC (LOGOR ESCAPEBIT 6))))
(RPAQQ OTHER.RC 0)
(RPAQ SEPRCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT 0))
(RPAQ BREAKCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 0))
(RPAQ STRINGDELIM.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 1))
(RPAQ LEFTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 2))
(RPAQ RIGHTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 3))
(RPAQ LEFTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 4))
(RPAQ RIGHTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 5))
(RPAQ ESCAPE.RC (LOGOR ESCAPEBIT 6))
(CONSTANTS (OTHER.RC 0) (SEPRCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT 0)) (BREAKCHAR.RC (LOGOR ESCAPEBIT
STOPATOMBIT BREAKBIT 0)) (STRINGDELIM.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 1)) (LEFTPAREN.RC (
LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 2)) (RIGHTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 3)) (
LEFTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 4)) (RIGHTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT
BREAKBIT 5)) (ESCAPE.RC (LOGOR ESCAPEBIT 6)))
(RPAQQ READMACROWAKEUPS ((IMMEDIATE.RMW (LOGOR MACROBIT 2)) (NONIMMEDIATE.RMW (LOGOR MACROBIT 0))))
(RPAQ IMMEDIATE.RMW (LOGOR MACROBIT 2))
(RPAQ NONIMMEDIATE.RMW (LOGOR MACROBIT 0))
(CONSTANTS (IMMEDIATE.RMW (LOGOR MACROBIT 2)) (NONIMMEDIATE.RMW (LOGOR MACROBIT 0)))
(RPAQQ READMACROESCAPES ((ESC.RME ESCAPEBIT) (NOESC.RME 0)))
(RPAQ ESC.RME ESCAPEBIT)
(RPAQQ NOESC.RME 0)
(CONSTANTS (ESC.RME ESCAPEBIT) (NOESC.RME 0))
(ACCESSFNS READCODE ((ESCAPE (LOGAND DATUM ESCAPEBIT)) (ESCQUOTE (NOT (ZEROP (LOGAND DATUM ESCAPEBIT))
)) (STOPATOM (NOT (ZEROP (LOGAND DATUM STOPATOMBIT)))) (MACROCONTEXT (LOGAND DATUM CONTEXTMASK)) (
MACROP (NOT (ZEROP (LOGAND DATUM MACROBIT)))) (WAKEUP (LOGAND DATUM WAKEUPMASK)) (BREAK (NOT (ZEROP (
LOGAND DATUM BREAKBIT))))))
(RECORD READMACRODEF (MACROTYPE . MACROFN))
(DATATYPE READTABLEP (READSA READMACRODEFS (READMACROFLG FLAG) (ESCAPEFLG FLAG)) READSA ← (create
CHARTABLE))
(/DECLAREDATATYPE (QUOTE READTABLEP) (QUOTE (POINTER POINTER FLAG FLAG)))
(PUTPROPS \SYNCODE DMACRO (OPENLAMBDA (TABLE CHAR) (CHECK (type? CHARTABLE TABLE)) (\GETBASEBYTE TABLE
CHAR)))
(PUTPROPS \SYNCODE VAXMACRO (OPENLAMBDA (TABLE CHAR) (CHECK (type? CHARTABLE TABLE)) (0GetBaseByte
TABLE CHAR)))
(PUTPROPS \SETSYNCODE DMACRO ((TABLE CHAR CODE) (CHECK (type? CHARTABLE TABLE)) (\PUTBASEBYTE TABLE
CHAR CODE)))
(PUTPROPS \SETSYNCODE VAXMACRO ((TABLE CHAR CODE) (CHECK (type? CHARTABLE TABLE)) (0SetBaseByte TABLE
CHAR CODE)))
(DATATYPE CHARTABLE ((TABLE 256 BYTE)))
(/DECLAREDATATYPE (QUOTE CHARTABLE) (QUOTE (BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE)))
(PUTPROP (QUOTE ATBL) (QUOTE IMPORTDATE) (IDATE "22-JUL-83 14:57:53"))
(DATATYPE STREAM ((* First 4 words are fixed for BIN, BOUT opcodes. Length of whole datatype is
multiple of 4, so quad-aligned) (COFFSET WORD) (* Offset in CPPTR of next bin or bout) (CBUFSIZE WORD)
(* Offset past last byte in that buffer) (BINABLE FLAG) (* BIN punts unless this bit on) (BOUTABLE
FLAG) (* BOUT punts unless this bit on) (EXTENDABLE FLAG) (* BOUT punts when COFFSET ge CBUFFSIZE
unless this bit set and COFFSET lt 512) (NIL BITS 5) (CPPTR POINTER) (* Pointer to current buffer) (
NIL BITS 3) (USERCLOSEABLE FLAG) (* Can be closed by CLOSEF; NIL for terminal, dribble...) (
USERVISIBLE FLAG) (* Listed by OPENP; NIL for terminal, dribble ...) (ACCESSBITS BITS 3) (* What kind
of access file is open for (read, write, append)) (FULLFILENAME POINTER) (* Name by which file is
known to user) (DEVICE POINTER) (* FDEV of this guy) (VALIDATION POINTER) (* A number somehow
identifying file, used to determine if file has changed in our absence) (EPAGE WORD) (EOFFSET WORD) (*
Page, byte offset of eof) (* Following are device-specific fields) (F1 POINTER) (F2 POINTER) (F3
POINTER) (F4 POINTER) (F5 POINTER) (FW6 WORD) (FW7 WORD) (* Following only filled in for open streams)
(BYTESIZE BYTE) (BUFFS POINTER) (CPAGE WORD) (FW8 WORD) (MAXBUFFERS WORD) (XPOSITION WORD) (DIRTYBITS
WORD) (LINELENGTH WORD) (OUTCHARFN POINTER) (ENDOFSTREAMOP POINTER) (* For use of applications
programs, not devices) (USERFIELD POINTER) (IMAGEOPS POINTER) (* Image operations vector) (IMAGEDATA
POINTER) (* Image instance variables--format depends on IMAGEOPS value) (EXTRASTREAMOP POINTER)) (
BLOCKRECORD STREAM ((NIL 2 WORD) (UCODEFLAGS BYTE) (NIL POINTER))) (ACCESSFNS STREAM ((ACCESS
\GETACCESS \SETACCESS) (CPDIRTY (ZEROP (fetch DIRTYBITS of DATUM)) (replace DIRTYBITS of DATUM with (
if NEWVALUE then 0 else 1))) (FULLNAME (OR (fetch FULLFILENAME of DATUM) DATUM)) (NAMEDP (AND (fetch
FULLFILENAME of DATUM) T)))) USERCLOSEABLE ← T USERVISIBLE ← T ACCESSBITS ← NoBits BUFFS ← NIL
BYTESIZE ← 8 CPPTR ← NIL DIRTYBITS ← 1 MAXBUFFERS ← 3 XPOSITION ← 0 LINELENGTH ← (PROGN (DECLARE (
GLOBALVARS FILELINELENGTH)) FILELINELENGTH) OUTCHARFN ← (FUNCTION \FILEOUTCHARFN) ENDOFSTREAMOP ← (
FUNCTION \EOSERROR) IMAGEOPS ← \NOIMAGEOPS)
(/DECLAREDATATYPE (QUOTE STREAM) (QUOTE (WORD WORD FLAG FLAG FLAG (BITS 5) POINTER (BITS 3) FLAG FLAG
(BITS 3) POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER POINTER POINTER WORD WORD BYTE
POINTER WORD WORD WORD WORD WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER)))
(PUTPROPS STREAMOP MACRO (ARGS (CONS (QUOTE SPREADAPPLY*) (CONS (COND ((EQ (CAR (LISTP (CAR ARGS))) (
QUOTE QUOTE)) (LIST (QUOTE fetch) (CADAR ARGS) (QUOTE of) (CADR ARGS))) (T (HELP
"STREAMOP - OPNAME not quoted:" ARGS))) (CDDR ARGS)))))
(RPAQQ AppendBit 2)
(RPAQQ NoBits 0)
(RPAQQ ReadBit 1)
(RPAQQ WriteBit 4)
(RPAQ OutputBits (LOGOR AppendBit WriteBit))
(RPAQ BothBits (LOGOR ReadBit OutputBits))
(CONSTANTS AppendBit NoBits ReadBit WriteBit (OutputBits (LOGOR AppendBit WriteBit)) (BothBits (LOGOR
ReadBit OutputBits)))
(PUTPROPS APPENDABLE MACRO ((STREAM) (TestMasked (fetch ACCESSBITS of STREAM) AppendBit)))
(PUTPROPS APPENDONLY MACRO ((STREAM) (EQ (fetch ACCESSBITS of STREAM) AppendBit)))
(PUTPROPS DIRTYABLE MACRO ((STREAM) (TestMasked (fetch ACCESSBITS of STREAM) (CONSTANT (LOGOR
AppendBit WriteBit)))))
(PUTPROPS OPENED MACRO ((STREAM) (NEQ (fetch ACCESSBITS of STREAM) NoBits)))
(PUTPROPS OVERWRITEABLE MACRO ((STREAM) (TestMasked (fetch ACCESSBITS of STREAM) WriteBit)))
(PUTPROPS READABLE MACRO ((STREAM) (TestMasked (fetch ACCESSBITS of STREAM) ReadBit)))
(PUTPROPS READONLY MACRO ((STREAM) (EQ (fetch ACCESSBITS of STREAM) ReadBit)))
(PUTPROPS WRITEABLE MACRO ((STREAM) (OR (OVERWRITEABLE STREAM) (AND (APPENDABLE STREAM) (\EOFP STREAM)
))))
(PUTPROPS TestMasked MACRO ((BITS MASK) (NOT (ZEROP (LOGAND BITS MASK)))))
(PUTPROPS FDEVOP MACRO (ARGS (CONS (QUOTE SPREADAPPLY*) (CONS (COND ((EQ (CAR (LISTP (CAR ARGS))) (
QUOTE QUOTE)) (LIST (QUOTE fetch) (CADAR ARGS) (QUOTE of) (CADR ARGS))) (T (HELP
"FDEVOP - OPNAME not quoted:" ARGS))) (CDDR ARGS)))))
(DATATYPE FDEV ((DEVICENAME POINTER) (RESETABLE FLAG) (RANDOMACCESSP FLAG) (NODIRECTORIES FLAG) (
PAGEMAPPED FLAG) (* True if i/o handled by pmap routines) (* Device operations:) (CLOSEFILE POINTER) (
* (stream) => closes stream, returns it) (DELETEFILE POINTER) (* (name) => deletes file so named,
returning name, or NIL on failure. RECOG=OLDEST) (DIRECTORYNAMEP POINTER) (* (host/dir) => true if
directory exists on host) (EVENTFN POINTER) (* (device event) , called before/after logout, sysout,
makesys) (GENERATEFILES POINTER) (* (device pattern) => generator object for files matching pattern.
Car of object is generator function, cdr is arbitrary state. Generator fn returns next file, or NIL
when finished) (GETFILEINFO POINTER) (* (stream/name attribute device) => value of attribute for open
stream or name of closed file) (GETFILENAME POINTER) (* (name recog device) => full file name) (
HOSTNAMEP POINTER) (* (hostname {device}) => T if hostname is valid. If device is given, return a FDEV
for this {new} host, or T to use existing device) (OPENFILE POINTER) (* (name access recog otherinfo
device) => new stream open on this device, or NIL if name not found) (READPAGES POINTER) (* (stream
firstpage# buflist) => # of bytes read, starting at firstpage#, reading into buflist, a list of
buffers or a single buffer (the usual case)) (REOPENFILE POINTER) (* (name access recog otherinfo
device stream) like openfile, but called after logout to revalidate file, so optionally uses info in
old stream to keep this opening like the previous) (SETFILEINFO POINTER) (* (stream/name attribute
newvalue device) sets attribute of open stream or closed file of given name) (TRUNCATEFILE POINTER) (*
(stream page offset) make stream's eof be at page,offset, discarding anything after it) (WRITEPAGES
POINTER) (* (stream firstpage# buflist) writes from buflist to stream starting at firstpage# of stream
) (BIN POINTER) (* (stream) => next byte of input) (BOUT POINTER) (* (stream byte) output byte to
stream) (PEEKBIN POINTER) (* (stream) => next byte without advancing position in stream) (READP
POINTER) (* (stream flag) => T if there is input available from stream) (BACKFILEPTR POINTER) (* (
stream) backs up "fileptr" by one. Stream is only required to be able to do this once, i.e.
one-character buffer suffices) (DEVICEINFO POINTER) (* arbitrary device-specific info stored here) (
EOLCONVENTION POINTER) (LASTC POINTER) (* Should be possible only if RANDOMACCESSP) (SETFILEPTR
POINTER) (GETFILEPTR POINTER) (GETEOFPTR POINTER) (EOFP POINTER) (BLOCKIN POINTER) (* (stream buffer
byteoffset nbytes)) (BLOCKOUT POINTER) (* (stream buffer byteoffset nbytes)) (RENAMEFILE POINTER) (*
oldfile newfile device)) DIRECTORYNAMEP ← (FUNCTION NILL) HOSTNAMEP ← (FUNCTION NILL) READP ← (
FUNCTION \GENERIC.READP) SETFILEPTR ← (FUNCTION \ILLEGAL.DEVICEOP) GETFILEPTR ← (FUNCTION
\ILLEGAL.DEVICEOP) GETEOFPTR ← (FUNCTION \ILLEGAL.DEVICEOP) EOFP ← (FUNCTION \ILLEGAL.DEVICEOP)
BLOCKIN ← (FUNCTION \NONPAGEDBINS) BLOCKOUT ← (FUNCTION \NONPAGEDBOUTS) RENAMEFILE ← (FUNCTION
\GENERIC.RENAMEFILE))
(RECORD FILEGENOBJ (NEXTFILEFN . GENFILESTATE))
(/DECLAREDATATYPE (QUOTE FDEV) (QUOTE (POINTER FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER)))
(PUTPROPS \DECFILEPTR MACRO ((STREAM X) (\INCFILEPTR STREAM (IMINUS X))))
(PUTPROPS \GETFILEPTR MACRO (OPENLAMBDA (STRM) (COND ((fetch (FDEV PAGEMAPPED) of (fetch (STREAM
DEVICE) of STRM)) (create BYTEPTR PAGE ← (fetch CPAGE of STRM) OFFSET ← (fetch COFFSET of STRM))) (T (
FDEVOP (QUOTE GETFILEPTR) (fetch DEVICE of STRM) STRM)))))
(PUTPROPS \WIN MACRO (OPENLAMBDA (STREAM) (create WORD HIBYTE ← (\BIN STREAM) LOBYTE ← (\BIN STREAM)))
)
(PUTPROPS \WOUT MACRO (OPENLAMBDA (STREAM W) (\BOUT STREAM (fetch HIBYTE of W)) (\BOUT STREAM (fetch
LOBYTE of W))))
(PUTPROPS \BINS BYTEMACRO (OPENLAMBDA (STRM BASE OFF NBYTES) (FDEVOP (QUOTE BLOCKIN) (fetch (STREAM
DEVICE) of STRM) STRM BASE OFF NBYTES)))
(PUTPROPS \BOUTS BYTEMACRO (OPENLAMBDA (STRM BASE OFF NBYTES) (FDEVOP (QUOTE BLOCKOUT) (fetch (STREAM
DEVICE) of STRM) STRM BASE OFF NBYTES)))
(PUTPROPS \EOFP BYTEMACRO (OPENLAMBDA (STRM) (FDEVOP (QUOTE EOFP) (fetch (STREAM DEVICE) of STRM) STRM
)))
(RPAQQ BitsPerByte 8)
(RPAQ ByteOffsetSize (SELECTQ (SYSTEMTYPE) (VAX 10) 9))
(RPAQQ WordsPerPage 256)
(CONSTANTS BitsPerByte (ByteOffsetSize (SELECTQ (SYSTEMTYPE) (VAX 10) 9)) WordsPerPage)
(ACCESSFNS BYTEPTR ((PAGE (FOLDLO DATUM BYTESPERPAGE)) (OFFSET (MOD DATUM BYTESPERPAGE))) (TYPE? (AND
(FIXP DATUM) (IGEQ DATUM 0))) (CREATE (IPLUS (UNFOLD PAGE BYTESPERPAGE) OFFSET)))
(PUTPROP (QUOTE FILEIO) (QUOTE IMPORTDATE) (IDATE "25-JUL-83 02:48:16"))
(BLOCKRECORD FIXP ((HINUM WORD) (LONUM WORD)) (CREATE (CREATECELL \FIXP)) (TYPE? (EQ (NTYPX DATUM)
\FIXP)))
(RPAQQ MAX.SMALL.INTEGER 65535)
(RPAQQ MAX.POS.HINUM 32767)
(CONSTANTS (MAX.SMALL.INTEGER 65535) (MAX.POS.HINUM 32767))
(PUTPROPS .UNBOX. MACRO ((V HV LV) (PROG NIL UBLP (SELECTC (NTYPX V) (\FIXP (SETQ HV (fetch (FIXP
HINUM) of V)) (SETQ LV (fetch (FIXP LONUM) of V))) (\SMALLP (COND ((SMALLPOSP V) (SETQ HV 0) (SETQ LV
V)) (T (SETQ HV 65535) (SETQ LV (LOLOC V))))) (\FLOATP (SETQ V (\FIXP.FROM.FLOATP V)) (GO UBLP)) (
PROGN (SETQ V (LISPERROR "NON-NUMERIC ARG" V)) (GO UBLP))))))
(PUTPROPS .NEGATE. MACRO ((HY LY) (COND ((ZEROP LY) (AND (NEQ HY 0) (SETQ HY (ADD1 (IDIFFERENCE
MAX.SMALL.INTEGER HY))))) (T (SETQ HY (IDIFFERENCE MAX.SMALL.INTEGER HY)) (SETQ LY (ADD1 (IDIFFERENCE
MAX.SMALL.INTEGER LY)))))))
(PUTPROPS .LLSH1. MACRO ((HI LO) (* shift the pair left one, assuming no overflow) (SETQ HI (LLSH HI 1
)) (SETQ LO (LLSH (COND ((IGREATERP LO MAX.POS.HINUM) (add HI 1) (LOGAND LO MAX.POS.HINUM)) (T LO)) 1)
)))
(PUTPROPS .LRSH1. MACRO ((HI LO) (SETQ LO (LRSH LO 1)) (COND ((NEQ (LOGAND HI 1) 0) (SETQ LO (IPLUS LO
\SIGNBIT)))) (SETQ HI (LRSH HI 1))))
(PUTPROPS .BOXIPLUS. MACRO (OPENLAMBDA (X Y) (PROG ((HX (\GETBASE X 0)) (LX (\GETBASE X 1)) HY LY) (
.UNBOX. Y HY LY) (SETQ HX (COND ((IGREATERP HX (IDIFFERENCE MAX.SMALL.INTEGER HY)) (IDIFFERENCE HX (
ADD1 (IDIFFERENCE MAX.SMALL.INTEGER HY)))) (T (IPLUS HX HY)))) (* Add high parts) (\PUTBASE X 1 (COND
((IGREATERP LX (IDIFFERENCE MAX.SMALL.INTEGER LY)) (* Carry into high part.) (SETQ HX (COND ((EQ HX
MAX.SMALL.INTEGER) 0) (T (ADD1 HX)))) (IDIFFERENCE LX (ADD1 (IDIFFERENCE MAX.SMALL.INTEGER LY)))) (T (
IPLUS LX LY)))) (\PUTBASE X 0 HX) (RETURN X))))
(PUTPROPS PutUnboxed DMACRO (= . \PUTFIXP))
(PUTPROP (QUOTE LLARITH) (QUOTE IMPORTDATE) (IDATE "25-JUL-83 02:37:58"))
(BLOCKRECORD FLOATP ((SIGNBIT BITS 1) (EXPONENT BITS 8) (HIFRACTION BITS 7) (LOFRACTION BITS 16)) (
BLOCKRECORD FLOATP ((HIWORD WORD) (LOWORD WORD))) (BLOCKRECORD FLOATP ((NIL BITS 9) (LONGFRACTION BITS
23))) (BLOCKRECORD FLOATP ((FLOATCONTENTS BITS 32))) (CREATE (CREATECELL \FLOATP)))
(RPAQQ MAX.DIGITS.ACCURACY 9)
(CONSTANTS (MAX.DIGITS.ACCURACY 9))
(PUTPROP (QUOTE LLFLOAT) (QUOTE IMPORTDATE) (IDATE "16-OCT-82 23:44:00"))
(PUTPROPS FONTPROP MACRO (ARGS (SELECTQ (AND (EQ (CAADR ARGS) (QUOTE QUOTE)) (CADADR ARGS)) (ASCENT (
LIST (QUOTE FONTASCENT) (CAR ARGS))) (DESCENT (LIST (QUOTE FONTDESCENT) (CAR ARGS))) (HEIGHT (LIST (
QUOTE FONTHEIGHT) (CAR ARGS))) (QUOTE IGNOREMACRO))))
(DATATYPE FONTDESCRIPTOR (FONTDEVICE CHARACTERBITMAP FONTFAMILY FONTSIZE FONTFACE \SFWidths \SFOffsets
\SFWidthsY (FIRSTCHAR WORD) (LASTCHAR WORD) (\SFAscent WORD) (\SFDescent WORD) (\SFHeight WORD) (
ROTATION WORD) (FBBOX SIGNEDWORD) (FBBOY SIGNEDWORD) (FBBDX SIGNEDWORD) (FBBDY SIGNEDWORD) (
\SFFACECODE BITS 8) \SFLKerns \SFRWidths) (DATATYPE FONTDESCRIPTOR (FONTDEVICE CHARACTERBITMAP
FONTFAMILY FONTSIZE FONTFACE \SFWidths \SFOffsets \SFWidthsY (FIRSTCHAR WORD) (LASTCHAR WORD) (
\SFAscent WORD) (\SFDescent WORD) (\SFHeight WORD) (ROTATION WORD) (\SFMaxRasterWidth SIGNEDWORD) (
\SFTotalRasterWidth SIGNEDWORD) (\SFMaxCharWidth SIGNEDWORD) (\SFTotalCharWidth SIGNEDWORD) (
\SFFACECODE BITS 8) \SFLKerns \SFRWidths)))
(RECORD FONTFACE (WEIGHT SLOPE EXPANSION) WEIGHT ← (QUOTE MEDIUM) SLOPE ← (QUOTE REGULAR) EXPANSION ←
(QUOTE REGULAR) (TYPE? LISTP))
(/DECLAREDATATYPE (QUOTE FONTDESCRIPTOR) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER WORD WORD WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD SIGNEDWORD SIGNEDWORD (BITS 8)
POINTER POINTER)))
(/DECLAREDATATYPE (QUOTE FONTDESCRIPTOR) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER WORD WORD WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD SIGNEDWORD SIGNEDWORD (BITS 8)
POINTER POINTER)))
(PUTPROPS FONTASCENT MACRO ((FONTSPEC) (ffetch \SFAscent of (\GETFONTDESC FONTSPEC))))
(PUTPROPS FONTDESCENT MACRO ((FONTSPEC) (ffetch \SFDescent of (\GETFONTDESC FONTSPEC))))
(PUTPROPS FONTHEIGHT MACRO ((FONTSPEC) (ffetch \SFHeight of (\GETFONTDESC FONTSPEC))))
(PUTPROPS \FGETOFFSET DMACRO ((BASE INDEX) (ELT BASE INDEX)))
(PUTPROPS \FGETOFFSET JMACRO ((BASE INDEX) (.LDB BASE INDEX (CONSTANT (\SSPP 16 16)))))
(PUTPROPS \FGETWIDTH DMACRO ((BASE INDEX) (\GETBASE BASE INDEX)))
(PUTPROPS \FGETWIDTH JMACRO ((BASE INDEX) (.LDB BASE INDEX (CONSTANT (\SSPP 16 0)))))
(PUTPROPS \GETOFFSET DMACRO ((ARR INDEX) (ELT ARR INDEX)))
(PUTPROPS \GETOFFSET JMACRO ((ARR INDEX) (.LDB ARR (ADD1 INDEX) (CONSTANT (\SSPP 16 16)))))
(PUTPROPS \GETWIDTH DMACRO ((ARR INDEX) (\WORDELT ARR INDEX)))
(PUTPROPS \GETWIDTH JMACRO ((ARR INDEX) (.LDB ARR (ADD1 INDEX) (CONSTANT (\SSPP 16 0)))))
(PUTPROP (QUOTE FONT) (QUOTE IMPORTDATE) (IDATE "18-JUL-83 13:42:22"))
(ADDTOVAR GLOBALVARS \KEYBOARD.DEVICE \KEYBOARD.STREAM)
(PUTPROPS COLORNUMBERBITSPERPIXEL MACRO (NIL (DECLARE (GLOBALVARS \COLORDISPLAYBITSPERPIXEL))
\COLORDISPLAYBITSPERPIXEL))
(PUTPROPS \BITADDRESSOFPIXEL MACRO (OPENLAMBDA (BITSPERPIXEL PIXEL) (COND ((EQ BITSPERPIXEL 4) (LLSH
PIXEL 2)) (T (LLSH PIXEL 3)))))
(PUTPROPS .TAKE.DOWN.COLOR.CURSOR MACRO (NIL (* uses same bitblt table that the cursor was put up with
to take it down.) (\PILOTBITBLT \ColorCursorBBT 0)))
(RPAQQ COLORSCREENWIDTH 640)
(RPAQQ COLORSCREENHEIGHT 480)
(CONSTANTS (COLORSCREENWIDTH 640) (COLORSCREENHEIGHT 480))
(PUTPROPS KEYDOWNP MACRO (ARGS (COND ((AND (LISTP (CAR ARGS)) (EQ (CAAR ARGS) (QUOTE QUOTE))) (LIST (
QUOTE KEYDOWNP1) (\KEYNAMETONUMBER (CADAR ARGS)))) (T (QUOTE IGNOREMACRO)))))
(PUTPROPS KEYDOWNP1 MACRO (OPENLAMBDA (KEYNUMBER) (DECLARE (GLOBALVARS \EM.KBDAD0 \EM.KBDAD1
\EM.KBDAD2 \EM.KBDAD3 \EM.UTILIN \EM.KBDAD4 \EM.KBDAD5)) (PROG NIL (RETURN (ZEROP (LOGAND (LRSH (LLSH
1 15) (PROGN (* (IMOD KEYNUMBER BITSPERWORD) - GETD cause IMOD and BITSPERWORD not exported to user) (
LOGAND KEYNUMBER 15))) (\GETBASE (SELECTQ (PROGN (* (FOLDLO KEYNUMBER BITSPERWORD) GETD follows since
FOLDLO and BITSPERWORD not exported to user) (LRSH KEYNUMBER 4)) (0 \EM.KBDAD0) (1 \EM.KBDAD1) (2
\EM.KBDAD2) (3 \EM.KBDAD3) (4 \EM.UTILIN) (5 (OR \EM.KBDAD4 (RETURN))) (6 (OR \EM.KBDAD5 (RETURN))) (
RETURN)) 0)))))))
(BLOCKRECORD INTERRUPTSTATE ((NIL BITS 5) (STACKOVERFLOW FLAG) (STORAGEFULL FLAG) (WAITINGINTERRUPT
FLAG) (INTCHARCODE BYTE)))
(ACCESSFNS ARMEDINTERRUPTS ((ARMED (NOT (ZEROP (LOGAND (GETBASE \ARMEDINTERRUPTS (FOLDLO DATUM
BITSPERWORD)) (LLSH 1 (IMOD DATUM BITSPERWORD))))) (PUTBASE \ARMEDINTERRUPTS (FOLDLO DATUM BITSPERWORD
) (COND (NEWVALUE (LOGOR (GETBASE \ARMEDINTERRUPTS (FOLDLO DATUM BITSPERWORD)) (LLSH 1 (IMOD DATUM
BITSPERWORD)))) (T (LOGAND (GETBASE \ARMEDINTERRUPTS (FOLDLO DATUM BITSPERWORD)) (LOGXOR (LLSH 1 (IMOD
DATUM BITSPERWORD)) 65535))))))))
(RPAQQ CURSORHEIGHT 16)
(RPAQQ CURSORWIDTH 16)
(CONSTANTS (CURSORHEIGHT 16) (CURSORWIDTH 16))
(PUTPROPS FLIPCURSORBAR MACRO ((X) (* Flip bar of cursor during this.) (\PUTBASE \EM.CURSORBITMAP X (
LOGXOR (\GETBASE \EM.CURSORBITMAP X) (CONSTANT MAX.SMALL.INTEGER)))))
(ADDTOVAR GLOBALVARS BUTTONCHARCODE)
(ADDTOVAR GLOBALVARS LASTMOUSEX LASTMOUSEY LASTMOUSEBUTTONS LASTMOUSETIME LASTKEYBOARD)
(PUTPROPS \SETMOUSEXY MACRO ((XPOS YPOS) (PROGN (SELECTC \MACHINETYPE (\DANDELION (do (PROGN (replace
NEWMOUSEX of \IOPAGE with XPOS) (replace NEWMOUSEY of \IOPAGE with YPOS)) repeatuntil (ILESSP (fetch
NEWMOUSESTATE of \IOPAGE) 32768)) (* smash position until mouse says it is not busy) (replace
NEWMOUSEX of \IOPAGE with XPOS) (replace NEWMOUSEY of \IOPAGE with YPOS) (replace NEWMOUSESTATE of
\IOPAGE with 32768)) NIL) (PROGN (\PUTBASE \EM.MOUSEX 0 XPOS) (\PUTBASE \EM.MOUSEY 0 YPOS)))))
(ADDTOVAR GLOBALVARS \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.KBDAD0 \EM.KBDAD1
\EM.KBDAD2 \EM.KBDAD3 \EM.KBDAD4 \EM.KBDAD5 \EM.DISPINTERRUPT \EM.CURSORBITMAP
\SCREENDCB#SCANLINESADDR \MACHINETYPE \COLORCURSORBM \COLORCURSOR \COLORCURSORDOWN \ColorCursorBBT
\COLORCURSORWIDTH \COLORSCREENCURSORLINEBASE \COLORSCREENCURSORLINE \COLORCURSORBASE
\COLORSCREENWIDTHINBITS \COLORSCREENRASTERWIDTH \COLORCURSORRASTERWIDTH)
(PUTPROP (QUOTE LLKEY) (QUOTE IMPORTDATE) (IDATE " 2-AUG-83 18:26:18"))
(PUTPROPS \BITMASK MACRO ((N) (\WORDELT BITMASKARRAY (LOGAND N 15))))
(PUTPROPS \4BITMASK MACRO ((N) (\WORDELT 4BITMASKARRAY (LOGAND N 3))))
(PUTPROPS \NOTBITMASK MACRO ((N) (DECLARE (GLOBALVARS NOTBITMASKARRAY)) (\WORDELT NOTBITMASKARRAY (
LOGAND N 15))))
(PUTPROPS \NOT4BITMASK MACRO ((N) (\WORDELT NOT4BITMASKARRAY (LOGAND N 3))))
(ADDTOVAR GLOBALVARS BITMASKARRAY NOTBITMASKARRAY 4BITMASKARRAY NOT4BITMASKARRAY)
(RPAQQ WORDMASK 65535)
(CONSTANTS (WORDMASK 65535))
(PUTPROPS \DSPGETCHARWIDTH MACRO ((CHARCODE DS) (\GETBASE (ffetch \SFWIDTHSCACHE of DS) CHARCODE)))
(PUTPROPS \DSPGETCHAROFFSET MACRO ((CHARCODE DS) (\GETBASE (ffetch \SFOFFSETSCACHE of DS) CHARCODE)))
(PUTPROPS \CONVERTOP MACRO ((OP) (* rrb "14-NOV-80 11:14") (* Only for alto bitblt !!) (SELECTQ OP (
REPLACE 0) (PAINT 1) (INVERT 2) (ERASE 3) 0)))
(PUTPROPS \SFInvert MACRO ((BitMap y) (* corrects for the fact that alto bitmaps are stored with 0,0
as upper left while lisp bitmaps have 0,0 as lower left. The correction is actually off by one (
greater) because a majority of the places that it is called actually need one more than corrected Y
value.) (IDIFFERENCE (fetch BITMAPHEIGHT of BitMap) y)))
(PUTPROPS \SFReplicate MACRO (LAMBDA (pattern) (LOGOR pattern (LLSH pattern 8) (SETQ pattern (LLSH
pattern 4)) (LLSH pattern 8))))
(PUTPROPS \SETPBTFUNCTION MACRO (OPENLAMBDA (PILOTBBT SourceType Operation) (PROGN (replace
PBTOPERATION of PILOTBBT with (SELECTQ Operation (ERASE 1) (PAINT 2) (INVERT 3) 0)) (replace
PBTSOURCETYPE of PILOTBBT with (COND ((EQ (EQ SourceType (QUOTE INVERT)) (EQ Operation (QUOTE ERASE)))
0) (T 1))))))
(PUTPROPS \BITBLT1 MACRO ((bbt) (BitBltSUBR bbt)))
(PUTPROP (QUOTE BITBLT) (QUOTE MACRO) (QUOTE (= . BKBITBLT)))
(RECORD STREAMOFDISPLAYSTREAM STREAM (SUBRECORD STREAM) (ACCESSFNS ((DISPLAYSTREAM (fetch (STREAM F1)
of DATUM) (replace (STREAM F1) of DATUM with NEWVALUE)))))
(PUTPROPS \SFInsureDisplayStream MACRO ((X) (\DTEST X (QUOTE DISPLAYSTREAM))))
(PUTPROPS \GETDISPLAYSTREAMFROMSTREAM MACRO ((STRM) (* fetches the DISPLAYSTREAM from a STRM and makes
sure STRM is the ofd of DS) ((LAMBDA (DS) (DECLARE (LOCALVARS . T)) (COND ((EQ (ffetch (DISPLAYSTREAM
\SFOFD) of DS) STRM)) (T (freplace (DISPLAYSTREAM \SFOFD) of DS with STRM))) DS) (ffetch
DISPLAYSTREAM of STRM))))
(PUTPROPS \SFMARKUNFONTED MACRO ((DS) (freplace (DISPLAYSTREAM \SFOFFSETSCACHE) of DS with NIL)))
(PUTPROPS \SFHASFONT MACRO ((DS) (FFETCH (DISPLAYSTREAM \SFOFFSETSCACHE) of DS)))
(PUTPROPS \INSURETOPWDS DMACRO (OPENLAMBDA (DS) (OR (EQ DS \TOPWDS) (\TOTOPWDS DS))))
(PUTPROPS \INSURETOPWDS MACRO ((DS) (* For non-window implementations) (PROGN)))
(PUTPROPS .WHILE.TOP.DS. MACRO ((FIRST . REST) (* FIRST should be a displaystream and a variable.) (
UNINTERRUPTABLY (AND \COLORCURSORBM (\IFCOLORDS\TAKEDOWNCOLORCURSOR FIRST)) (\INSURETOPWDS FIRST) (
PROGN . REST) (AND \COLORCURSORDOWN (\PUTUPCOLORCURSOR)))))
(PUTPROPS .WHILE.TOP.IF.DS. MACRO ((FIRST COLOR? . REST) (* FIRST should be a displaystream and a
variable.) (UNINTERRUPTABLY (COND (FIRST (\INSURETOPWDS FIRST))) (COND (COLOR? (* this actually takes
down the cursor whenever a bitblt is done to any color bitmap. Not optimal but works.) (AND
\COLORCURSORBM (\TAKEDOWNCOLORCURSOR)))) (PROGN . REST) (AND \COLORCURSORDOWN (\PUTUPCOLORCURSOR)))))
(PUTPROPS \PIXELOFBITADDRESS MACRO (OPENLAMBDA (BITSPERPIXEL BITADDRESS) (SELECTQ BITSPERPIXEL (1
BITADDRESS) (4 (LRSH BITADDRESS 2)) (LRSH BITADDRESS 3))))
(ADDTOVAR GLOBALVARS \TOPWDS)
(PUTPROPS TTYDISPLAYSTREAM MACRO (X (COND ((NULL (CAR X)) (QUOTE TtyDisplayStream)) (T (QUOTE
IGNOREMACRO)))))
(ADDTOVAR GLOBALVARS \CARET \CARETDOWN \CARETFLG \CARETFLASHTIME \CARETNOWTIME BELLCNT BELLRATE
\CARETRATE \DisplayStoppedForLogout SystemColorMap)
(PUTPROPS \DSPTRANSFORMX MACRO ((X DS) (* transforms an x coordinate into the destination coordinate.)
(IPLUS X (fetch \SFXOFFSET of DS))))
(PUTPROPS \DSPTRANSFORMY MACRO ((Y DS) (* transforms an y coordinate into the destination coordinate.)
(IPLUS Y (fetch \SFYOFFSET of DS))))
(PUTPROPS \OFFSETBOTTOM MACRO ((X) (* gives the destination coordinate address of the origin.) (fetch
\SFYOFFSET of X)))
(PUTPROPS \OFFSETLEFT MACRO ((X) (* returns the x origin of in destination coordinates.) (fetch
\SFXOFFSET of X)))
(ADDTOVAR GLOBALVARS \DisplayStarted \DisplayStreamsInitialized \DisplayInitialed WHOLEDISPLAY
WHOLESCREEN)
(PUTPROPS DISPLAYINITIALIZEDP MACRO (NIL (* always initialized now) T))
(PUTPROPS DISPLAYSTARTEDP MACRO (NIL \DisplayStarted))
(PUTPROP (QUOTE LLDISPLAY) (QUOTE IMPORTDATE) (IDATE "23-JUL-83 22:49:28"))
(RECORD REGION (LEFT BOTTOM WIDTH HEIGHT) LEFT ← -16383 BOTTOM ← -16383 WIDTH ← 32767 HEIGHT ← 32767 (
ACCESSFNS ((TOP (IPLUS (fetch (REGION BOTTOM) of DATUM) (fetch (REGION HEIGHT) of DATUM) -1)) (PTOP (
IPLUS (fetch (REGION BOTTOM) of DATUM) (fetch (REGION HEIGHT) of DATUM))) (RIGHT (IPLUS (fetch (REGION
LEFT) of DATUM) (fetch (REGION WIDTH) of DATUM) -1)) (PRIGHT (IPLUS (fetch (REGION LEFT) of DATUM) (
fetch (REGION WIDTH) of DATUM))))) (TYPE? (AND (EQLENGTH DATUM 4) (EVERY DATUM (FUNCTION FIXP)))))
(DATATYPE BITMAP ((BITMAPBASE POINTER) (BITMAPRASTERWIDTH WORD) (BITMAPHEIGHT WORD) (BITMAPWIDTH WORD)
(BITMAPBITSPERPIXEL WORD)) BITMAPBITSPERPIXEL ← 1 (BLOCKRECORD BITMAP ((BitMapHiLoc WORD) (
BitMapLoLoc WORD)) (* overlay inital pointer)))
(BLOCKRECORD BITMAPWORD ((BITS WORD)))
(DATATYPE DISPLAYSTREAM (\SFXPOSITION \SFYPOSITION \SFXOFFSET \SFYOFFSET \SFDestination
\SFClippingRegion \SFFONT \SFSlowPrintingCase \SFWIDTHSCACHE (* array of the distance to be moved in X
when each character is printed.) \SFOFFSETSCACHE \SFCOLOR \SFLINEFEED \SFRightMargin \SFLeftMargin
\SFScroll \SFOFD \SFOPERATION \SFSOURCETYPE (\SFClippingLeft WORD) (\SFClippingRight WORD) (
\SFClippingBottom WORD) (\SFClippingTop WORD) (\SFTexture WORD) (\SFHELDFLG FLAG) (XWINDOWHINT
XPOINTER) (\SFPILOTBBT POINTER) (* For Pilot testing) \SFXSCALE \SFYSCALE \SFCHARIMAGEWIDTHS (* array
of image widths for each character) \SFEOLFN \SFPAGEFULLFN) \SFLeftMargin ← 0 \SFRightMargin ←
SCREENWIDTH \SFXPOSITION ← 0 \SFYPOSITION ← 0 \SFXOFFSET ← 0 \SFYOFFSET ← 0 \SFClippingRegion ← (
create REGION) \SFDestination ← (SCREENBITMAP) \SFXSCALE ← 1 \SFYSCALE ← 1 (ACCESSFNS ((
\SFFOREGROUNDCOLOR (OR (CAR (fetch (DISPLAYSTREAM \SFCOLOR) of DATUM)) BLACKCOLOR)) (
\SFBACKGROUNDCOLOR (OR (CDR (fetch (DISPLAYSTREAM \SFCOLOR) of DATUM)) WHITECOLOR)))))
(RECORD POSITION (XCOORD . YCOORD) (TYPE? (AND (LISTP DATUM) (NUMBERP (CAR DATUM)) (NUMBERP (CDR DATUM
)))))
(RECORD CURSOR (CURSORBITMAP . CURSORHOTSPOT) CURSORHOTSPOT ← (create POSITION) (ACCESSFNS ((
CURSORHOTSPOTX (fetch (POSITION XCOORD) of (fetch (CURSOR CURSORHOTSPOT) of DATUM)) (replace (POSITION
XCOORD) of (fetch (CURSOR CURSORHOTSPOT) of DATUM) with NEWVALUE)) (CURSORHOTSPOTY (fetch (POSITION
YCOORD) of (fetch (CURSOR CURSORHOTSPOT) of DATUM)) (replace (POSITION YCOORD) of (fetch (CURSOR
CURSORHOTSPOT) of DATUM) with NEWVALUE)))) (TYPE? (AND (type? BITMAP (fetch (CURSOR CURSORBITMAP) of (
LISTP DATUM))) (type? POSITION (fetch (CURSOR CURSORHOTSPOT) of DATUM)))))
(RECORD MOUSEEVENT (MOUSEX MOUSEY MOUSEBUTTONS KEYBOARD MOUSETIME))
(/DECLAREDATATYPE (QUOTE BITMAP) (QUOTE (POINTER WORD WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE DISPLAYSTREAM) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD
WORD WORD WORD WORD FLAG XPOINTER POINTER POINTER POINTER POINTER POINTER POINTER)))
(DATATYPE BitBltTable ((BBTFunction WORD) (BBTUnused WORD) (BBTDBCA WORD) (BBTDBMR WORD) (BBTDLX WORD)
(BBTDTY WORD) (BBTDW WORD) (BBTDH WORD) (BBTSBCA WORD) (BBTSBMR WORD) (BBTSLX WORD) (BBTSTY WORD) (
BBTGray0 WORD) (BBTGray1 WORD) (BBTGray2 WORD) (BBTGray3 WORD) (BBTSLoloc WORD) (BBTSHiloc WORD) (
BBTDLoloc WORD) (BBTDHiloc WORD)) (* must fall on even word for alto emulator microcode.) (BLOCKRECORD
BitBltTable ((BBTLONG FLAG) (NIL BITS 11) (BBTSOURCETYPE BITS 2) (BBTOPERATION BITS 2))) (ACCESSFNS
BitBltTable ((BBTSOURCE (\VAG2 (fetch BBTSHiloc of DATUM) (fetch BBTSLoloc of DATUM)) (PROGN (replace
BBTSHiloc of DATUM with (\HILOC NEWVALUE)) (replace BBTSLoloc of DATUM with (\LOLOC NEWVALUE)))) (
BBTDEST (\VAG2 (fetch BBTDHiloc of DATUM) (fetch BBTDLoloc of DATUM)) (PROGN (replace BBTDHiloc of
DATUM with (\HILOC NEWVALUE)) (replace BBTDLoloc of DATUM with (\LOLOC NEWVALUE)))))))
(DATATYPE PILOTBBT ((PBTDESTLO WORD) (PBTDESTHI WORD) (PBTDESTBIT WORD) (* Destination bit address) (
PBTDESTBPL SIGNEDWORD) (* Destination bits per line -- distance in bits to move between items) (
PBTSOURCELO WORD) (PBTSOURCEHI WORD) (PBTSOURCEBIT WORD) (* Source bit address) (PBTSOURCEBPL
SIGNEDWORD) (* Source bits per line) (PBTWIDTH WORD) (* Width of an item in bits) (PBTHEIGHT WORD) (*
Number of items -- height in scanlines) (PBTFLAGS WORD) (NIL 5 WORD) (* Unused, needed to make
16-alignment)) (BLOCKRECORD PILOTBBT ((NIL 7 WORD) (NIL BITS 4) (* Overlay on PBTSOURCEBPL when
PBTUSEGRAY) (PBTGRAYOFFSET BITS 4) (* Offset in gray block where BITBLT should start) (
PBTGRAYWIDTHLESSONE BITS 4) (* Width-1 of gray block in words) (PBTGRAYHEIGHTLESSONE BITS 4) (*
Height-1 of gray block) (NIL 2 WORD) (* Overlay on PBTFLAGS ...) (PBTBACKWARD FLAG) (PBTDISJOINT FLAG)
(PBTDISJOINTITEMS FLAG) (PBTUSEGRAY FLAG) (PBTSOURCETYPE BITS 1) (PBTOPERATION BITS 2) (NIL BITS 9)))
(ACCESSFNS PILOTBBT ((PBTSOURCE (\VAG2 (fetch PBTSOURCEHI of DATUM) (fetch PBTSOURCELO of DATUM)) (
PROGN (replace PBTSOURCEHI of DATUM with (\HILOC NEWVALUE)) (replace PBTSOURCELO of DATUM with (\LOLOC
NEWVALUE)))) (PBTDEST (\VAG2 (fetch PBTDESTHI of DATUM) (fetch PBTDESTLO of DATUM)) (PROGN (replace
PBTDESTHI of DATUM with (\HILOC NEWVALUE)) (replace PBTDESTLO of DATUM with (\LOLOC NEWVALUE)))))))
(/DECLAREDATATYPE (QUOTE BitBltTable) (QUOTE (WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE PILOTBBT) (QUOTE (WORD WORD WORD SIGNEDWORD WORD WORD WORD SIGNEDWORD WORD
WORD WORD WORD WORD WORD WORD WORD)))
(PUTPROPS CURSORBITMAP MACRO (NIL CursorBitMap))
(RPAQQ CURSORHEIGHT 16)
(RPAQQ CURSORWIDTH 16)
(CONSTANTS (CURSORHEIGHT 16) (CURSORWIDTH 16))
(ADDTOVAR GLOBALVARS CursorBitMap)
(PUTPROPS DSPOPERATION MACRO (ARGS (CDSPACCESS ARGS (QUOTE \SFOPERATION))))
(PUTPROPS DSPSOURCETYPE MACRO (ARGS (CDSPACCESS ARGS (QUOTE \SFSOURCETYPE))))
(PUTPROPS DSPXPOSITION MACRO (TAIL (CDSPACCESS TAIL (QUOTE \SFXPOSITION))))
(PUTPROPS DSPYPOSITION MACRO (ARGS (CDSPACCESS ARGS (QUOTE \SFYPOSITION))))
(PUTPROPS DSPYOFFSET MACRO (ARGS (CDSPACCESS ARGS (QUOTE \SFYOFFSET))))
(PUTPROPS DSPLEFTMARGIN MACRO (ARGS (CDSPACCESS ARGS (QUOTE \SFLeftMargin))))
(PUTPROPS DSPRIGHTMARGIN MACRO (ARGS (CDSPACCESS ARGS (QUOTE \SFRightMargin))))
(PUTPROPS DSPTEXTURE MACRO (ARGS (CDSPACCESS ARGS (QUOTE \SFTexture))))
(DEFINEQ (CDSPACCESS (LAMBDA (ARGS FIELD) (* lmm "16-NOV-82 16:38") (* compute macro for calls to
DSPXPOSITION and DSPYPOSITION, and the offset fields. Looks for calls which are only accessing the
current value and also which default to the current stream.) (COND ((CAR ARGS) (QUOTE IGNOREMACRO)) (T
(* return current value) (BQUOTE (ffetch , FIELD of (\DTEST , (CADR ARGS) (QUOTE DISPLAYSTREAM)))))))
))
(BLOCK: NIL CDSPACCESS)
(PUTPROPS HALF MACRO ((X) (LRSH X 1)))
(PUTPROPS \FILLCIRCLEBLT MACRO (OPENLAMBDA (CX CY X Y) (* calls bitblt twice to fill in one line of
the circle.) (\LINEBLT FCBBT (IDIFFERENCE CX X) (IPLUS CY Y) (IPLUS CX X) DESTINATIONBASE RASTERWIDTH
LEFT RIGHT BOTTOM TOP GRAYWIDTH GRAYHEIGHT GRAYBASE NBITS) (\LINEBLT FCBBT (IDIFFERENCE CX X) (
IDIFFERENCE CY Y) (IPLUS CX X) DESTINATIONBASE RASTERWIDTH LEFT RIGHT BOTTOM TOP GRAYWIDTH GRAYHEIGHT
GRAYBASE NBITS)))
(PUTDEF (QUOTE BITMAPS) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO (X (VARS . X))))))
(PUTDEF (QUOTE CURSORS) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO (X (E (MAPC (QUOTE X) (QUOTE
PRINTCURSOR))))))))
(PUTPROPS SCREENBITMAP MACRO (NIL ScreenBitMap))
(PUTPROPS BITMAPP MACRO ((X) (type? BITMAP X)))
(ADDTOVAR GLOBALVARS SCREENHEIGHT SCREENWIDTH ScreenBitMap)
(RPAQQ BLACKSHADE 65535)
(RPAQQ WHITESHADE 0)
(CONSTANTS (BLACKSHADE 65535) (WHITESHADE 0))
(RPAQQ GRAYSHADE 43605)
(RPAQQ BLACKCOLOR 0)
(RPAQQ WHITECOLOR 7)
(ADDTOVAR GLOBALVARS GRAYSHADE WHITECOLOR BLACKCOLOR)
(PUTPROPS DSPXOFFSET MACRO (ARGS (CDSPACCESS ARGS (QUOTE \SFXOFFSET))))
(PUTPROPS \CHECKCARET MACRO (X (PROG ((DS (EXPANDMACRO (CAR X) T)) (TTYD (EXPANDMACRO (QUOTE (
TTYDISPLAYSTREAM)) T)) (FORM (QUOTE (PROGN (AND \CARETFLG (\SHOWCARET (TTYDISPLAYSTREAM))) (SETQ
\CARETDOWN T))))) (* \CARETDOWN is set so that caret will come up quickly.) (COND ((
CONSTANTEXPRESSIONP DS) (ERROR X "CONSTANT ARG TO \CHECKCARET??")) ((NOT (EQUAL TTYD DS)) (* (BQUOTE (
COND ((AND (EQ , DS (TTYDISPLAYSTREAM)) \CARET) , FORM)))) (SETQ FORM (LIST (QUOTE COND) (LIST (LIST (
QUOTE AND) (LIST (QUOTE EQ) DS (QUOTE (TTYDISPLAYSTREAM))) (QUOTE \CARET)) FORM))))) (RETURN FORM))))
(PUTPROP (QUOTE ADISPLAY) (QUOTE IMPORTDATE) (IDATE "27-JUL-83 19:48:29"))
(PUTPROPS UNINTERRUPTABLY INFO EVAL)
(ADDTOVAR SYSSPECVARS \INTERRUPTABLE)
(PUTPROPS UNINTERRUPTABLY DMACRO ((X . Y) ((LAMBDA (\INTERRUPTABLE) (PROGN X . Y)) NIL)))
(PUTPROPS \TAKEINTERRUPT DMACRO ((PREFORM POSTFORM) (DECLARE (GLOBALVARS \PENDINGINTERRUPT)) (COND ((
AND \PENDINGINTERRUPT (INTERRUPTABLE~=NILUPTHESTACK)) PREFORM ((LAMBDA (\INTERRUPTABLE) (
\CALLINTERRUPTED)) T) POSTFORM))))
(PUTPROPS \CHARCODEP DMACRO (OPENLAMBDA (X) (AND (SMALLP X) (IGEQ X 0) (ILEQ X (CONSTANT (SUB1 (EXPT 2
BITSPERBYTE)))))))
(ADDTOVAR PRETTYPRINTMACROS (UNINTERRUPTABLY LAMBDA (FORM) (PROG ((POS (IPLUS 4 (POSITION)))) (PRIN1
"(") (PRIN2 (CAR FORM)) (OR (EQ COMMENTFLG (CAAR (SETQ FORM (CDR FORM)))) (TAB POS 0)) (PRINTDEF FORM
POS T T FNSLST) (PRIN1 ")"))))
(PUTPROP (QUOTE AINTERRUPT) (QUOTE IMPORTDATE) (IDATE "11-AUG-83 12:23:14"))
(ACCESSFNS PUP ((PUPBASE (LOCF (fetch (ETHERPACKET EPBODY) of DATUM)))) (BLOCKRECORD PUPBASE ((
PUPLENGTH WORD) (PUPTCONTROL BYTE) (PUPTYPE BYTE) (PUPID FIXP) (PUPDEST WORD) (PUPDESTSOCKET FIXP) (
PUPSOURCE WORD) (PUPSOURCESOCKET FIXP) (PUPDATASTART 266 WORD)) (BLOCKRECORD PUPBASE ((NIL WORD) (
TYPEWORD WORD) (PUPIDHI WORD) (PUPIDLO WORD) (PUPDESTNET BYTE) (PUPDESTHOST BYTE) (PUPDESTSOCKETHI
WORD) (PUPDESTSOCKETLO WORD) (PUPSOURCENET BYTE) (PUPSOURCEHOST BYTE) (PUPSOURCESOCKETHI WORD) (
PUPSOURCESOCKETLO WORD)) (* Temporary extra synonyms) (SYNONYM PUPDESTNET (DESTNET)) (SYNONYM
PUPDESTHOST (DESTHOST)) (SYNONYM PUPDESTSOCKETHI (DESTSKTHI)) (SYNONYM PUPDESTSOCKETLO (DESTSKTLO)) (
SYNONYM PUPSOURCENET (SOURCENET)) (SYNONYM PUPSOURCEHOST (SOURCEHOST)) (SYNONYM PUPSOURCESOCKETHI (
SOURCESKTHI)) (SYNONYM PUPSOURCESOCKETLO (SOURCESKTLO))) (SYNONYM PUPDEST (DEST)) (SYNONYM
PUPDESTSOCKET (DESTSKT)) (SYNONYM PUPSOURCE (SOURCE)) (SYNONYM PUPSOURCESOCKET (SOURCESKT)) (ACCESSFNS
PUPDATASTART ((PUPCONTENTS (LOCF DATUM))))) (ACCESSFNS PUP ((PUPCHECKSUMBASE (fetch PUPBASE of DATUM)
) (PUPCHECKSUMLOC (\ADDBASE (fetch PUPBASE of DATUM) (FOLDLO (SUB1 (fetch PUPLENGTH of DATUM))
BYTESPERWORD)))) (BLOCKRECORD PUPCHECKSUMLOC ((PUPCHECKSUM WORD)))) (TYPE? (type? ETHERPACKET DATUM)))
(ACCESSFNS PUPADDRESS ((PUPNET# (LRSH DATUM 8)) (PUPHOST# (LOGAND DATUM 255))) (CREATE (IPLUS (LLSH
PUPNET# 8) PUPHOST#)))
(PUTPROPS \LOCALPUPADDRESS MACRO (NIL \LOCALPUPNETHOST))
(PUTPROPS \LOCALPUPHOSTNUMBER MACRO (NIL (fetch PUPHOST# of \LOCALPUPNETHOST)))
(PUTPROPS \LOCALPUPNETNUMBER MACRO (NIL (fetch PUPNET# of \LOCALPUPNETHOST)))
(ACCESSFNS ERRORPUP ((ERRORPUPBASE (fetch PUPCONTENTS of DATUM))) (BLOCKRECORD ERRORPUPBASE ((
ERRORPUPCOPY 10 WORD) (* Copy of pup header) (ERRORPUPCODE WORD) (ERRORPUPARG WORD) (* Usually zero) (
ERRORPUPSTRINGBASE WORD) (* Human readable message))))
(RPAQQ PUPERRORCODES ((\PUPE.CHECKSUM 1) (\PUPE.NOSOCKET 2) (\PUPE.SOCKETFULL 3) (\PUPE.GATEWAY.BADPUP
513) (\PUPE.NOROUTE 514) (\PUPE.NOHOST 515) (\PUPE.LOOPED 516) (\PUPE.TOOLARGE 517) (
\PUPE.WRONG.GATEWAY 518) (\PUPE.GATEWAYFULL 519)))
(RPAQQ \PUPE.CHECKSUM 1)
(RPAQQ \PUPE.NOSOCKET 2)
(RPAQQ \PUPE.SOCKETFULL 3)
(RPAQQ \PUPE.GATEWAY.BADPUP 513)
(RPAQQ \PUPE.NOROUTE 514)
(RPAQQ \PUPE.NOHOST 515)
(RPAQQ \PUPE.LOOPED 516)
(RPAQQ \PUPE.TOOLARGE 517)
(RPAQQ \PUPE.WRONG.GATEWAY 518)
(RPAQQ \PUPE.GATEWAYFULL 519)
(CONSTANTS (\PUPE.CHECKSUM 1) (\PUPE.NOSOCKET 2) (\PUPE.SOCKETFULL 3) (\PUPE.GATEWAY.BADPUP 513) (
\PUPE.NOROUTE 514) (\PUPE.NOHOST 515) (\PUPE.LOOPED 516) (\PUPE.TOOLARGE 517) (\PUPE.WRONG.GATEWAY 518
) (\PUPE.GATEWAYFULL 519))
(PUTPROPS BINDPUPS MACRO (X (CONS (LIST (QUOTE LAMBDA) (CAR X) (CONS (QUOTE PROGN) (CDR X))) (in (CAR
X) collect (LIST (QUOTE ALLOCATE.PUP))))))
(PUTPROPS BINDPUPS INFO BINDS)
(ADDTOVAR PRETTYPRINTMACROS (BINDPUPS LAMBDA (FORM) (PROG ((POS (IPLUS 2 (POSITION)))) (PRIN1 "(") (
PRIN2 (CAR FORM)) (SPACES 1) (PRINTDEF (CADR FORM) (POSITION)) (OR (EQ COMMENTFLG (CAAR (SETQ FORM (
CDDR FORM)))) (TAB POS 0)) (PRINTDEF FORM POS T T FNSLST) (PRIN1 ")"))))
(ADDTOVAR GLOBALVARS PUPTRACEFILE PUPONLYTYPES PUPIGNORETYPES PUPPRINTMACROS)
(BLOCKRECORD PORT ((NETHOST WORD) (SOCKET FIXP)) (BLOCKRECORD PORT ((NET BYTE) (HOST BYTE) (SOCKETHI
WORD) (SOCKETLO WORD))))
(ACCESSFNS ERRORPUP ((ERRORPUPBASE (fetch PUPCONTENTS of DATUM))) (BLOCKRECORD ERRORPUPBASE ((
ERRORPUPCOPY 10 WORD) (* Copy of pup header) (ERRORPUPCODE WORD) (ERRORPUPARG WORD) (* Usually zero) (
ERRORPUPSTRINGBASE WORD) (* Human readable message))))
(ADDTOVAR GLOBALVARS \ETHERWAIT1 \ETHERTIMEOUT \MAXETHERTRIES PUPTRACEFLG LOGINPASSWORDS
NILPUPTRACEFLG)
(RPAQQ \PUPOVLEN 22)
(RPAQQ \MAX.PUPLENGTH 532)
(RPAQQ \TIME.GETPUP 5)
(CONSTANTS (\PUPOVLEN 22) (\MAX.PUPLENGTH 532) (\TIME.GETPUP 5))
(PUTPROPS PUPPRINTMACROS VARTYPE ALIST)
(I.S.OPR (QUOTE INCHARS) NIL (QUOTE (SUBPAIR (QUOTE ($BASE $OFF $END)) (LIST (GETDUMMYVAR) (
GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (bind $BASE $OFF $END first (COND ((LITATOM BODY) (SETQ $OFF 1) (
SETQ $BASE (fetch (LITATOM PNAMEBASE) of BODY)) (SETQ $END (fetch (LITATOM PNAMELENGTH) of BODY))) (T
(SETQ $OFF (fetch (STRINGP OFFST) of (OR (STRINGP BODY) (SETQ BODY (MKSTRING BODY))))) (SETQ $BASE (
fetch (STRINGP BASE) of BODY)) (SETQ $END (IPLUS $OFF (fetch (STRINGP LENGTH) of BODY) -1)))) eachtime
(COND ((IGREATERP $OFF $END) (GO $$OUT)) (T (SETQ I.V. (\GETBASEBYTE $BASE $OFF)) (SETQ $OFF (ADD1
$OFF)))))))) T)
(PUTPROPS \GETPUPWORD DMACRO ((PUP WORD#) (\GETBASE (fetch PUPCONTENTS of PUP) WORD#)))
(PUTPROPS \PUTPUPWORD DMACRO ((PUP WORD# VALUE) (\PUTBASE (fetch PUPCONTENTS of PUP) WORD# VALUE)))
(PUTPROPS \GETPUPBYTE DMACRO ((PUP BYTE#) (\GETBASEBYTE (fetch PUPCONTENTS of PUP) BYTE#)))
(PUTPROPS \PUTPUPBYTE DMACRO ((PUP BYTE# VALUE) (\PUTBASEBYTE (fetch PUPCONTENTS of PUP) BYTE# VALUE))
)
(RPAQQ RAWPUPTYPES ((\PT.ECHOME 1) (\PT.IAMECHO 2) (\PT.IAMBADECHO 3) (\PT.ERROR 4) (\PT.RFC 8) (
\PT.ABORT 9) (\PT.END 10) (\PT.ENDREPLY 11) (\PT.DATA 16) (\PT.ADATA 17) (\PT.ACK 18) (\PT.MARK 19) (
\PT.INTERRUPT 20) (\PT.INTERRUPTREPLY 21) (\PT.AMARK 22) (\PT.GATEWAYREQUEST 128) (\PT.GATEWAYRESPONSE
129) (\PT.ALTOTIMEREQUEST 134) (\PT.ALTOTIMERESPONSE 135) (\PT.MSGCHECK 136) (\PT.NEWMAIL 137) (
\PT.NONEWMAIL 138) (\PT.NOMAILBOX 139) (\PT.LAURELCHECK 140) (\PT.NAMELOOKUP 144) (\PT.NAMERESPONSE
145) (\PT.NAME/ADDRERROR 146) (\PT.ADDRLOOKUP 147) (\PT.ADDRRESPONSE 148) (\PT.PRINTERSTATUS 128) (
\PT.STATUSRESPONSE 129) (\PT.PRINTERCAPABILITY 130) (\PT.CAPABILITYRESPONSE 131) (\PT.PRINTJOBSTATUS
132) (\PT.PRINTJOBRESPONSE 133)))
(RPAQQ \PT.ECHOME 1)
(RPAQQ \PT.IAMECHO 2)
(RPAQQ \PT.IAMBADECHO 3)
(RPAQQ \PT.ERROR 4)
(RPAQQ \PT.RFC 8)
(RPAQQ \PT.ABORT 9)
(RPAQQ \PT.END 10)
(RPAQQ \PT.ENDREPLY 11)
(RPAQQ \PT.DATA 16)
(RPAQQ \PT.ADATA 17)
(RPAQQ \PT.ACK 18)
(RPAQQ \PT.MARK 19)
(RPAQQ \PT.INTERRUPT 20)
(RPAQQ \PT.INTERRUPTREPLY 21)
(RPAQQ \PT.AMARK 22)
(RPAQQ \PT.GATEWAYREQUEST 128)
(RPAQQ \PT.GATEWAYRESPONSE 129)
(RPAQQ \PT.ALTOTIMEREQUEST 134)
(RPAQQ \PT.ALTOTIMERESPONSE 135)
(RPAQQ \PT.MSGCHECK 136)
(RPAQQ \PT.NEWMAIL 137)
(RPAQQ \PT.NONEWMAIL 138)
(RPAQQ \PT.NOMAILBOX 139)
(RPAQQ \PT.LAURELCHECK 140)
(RPAQQ \PT.NAMELOOKUP 144)
(RPAQQ \PT.NAMERESPONSE 145)
(RPAQQ \PT.NAME/ADDRERROR 146)
(RPAQQ \PT.ADDRLOOKUP 147)
(RPAQQ \PT.ADDRRESPONSE 148)
(RPAQQ \PT.PRINTERSTATUS 128)
(RPAQQ \PT.STATUSRESPONSE 129)
(RPAQQ \PT.PRINTERCAPABILITY 130)
(RPAQQ \PT.CAPABILITYRESPONSE 131)
(RPAQQ \PT.PRINTJOBSTATUS 132)
(RPAQQ \PT.PRINTJOBRESPONSE 133)
(CONSTANTS (\PT.ECHOME 1) (\PT.IAMECHO 2) (\PT.IAMBADECHO 3) (\PT.ERROR 4) (\PT.RFC 8) (\PT.ABORT 9) (
\PT.END 10) (\PT.ENDREPLY 11) (\PT.DATA 16) (\PT.ADATA 17) (\PT.ACK 18) (\PT.MARK 19) (\PT.INTERRUPT
20) (\PT.INTERRUPTREPLY 21) (\PT.AMARK 22) (\PT.GATEWAYREQUEST 128) (\PT.GATEWAYRESPONSE 129) (
\PT.ALTOTIMEREQUEST 134) (\PT.ALTOTIMERESPONSE 135) (\PT.MSGCHECK 136) (\PT.NEWMAIL 137) (
\PT.NONEWMAIL 138) (\PT.NOMAILBOX 139) (\PT.LAURELCHECK 140) (\PT.NAMELOOKUP 144) (\PT.NAMERESPONSE
145) (\PT.NAME/ADDRERROR 146) (\PT.ADDRLOOKUP 147) (\PT.ADDRRESPONSE 148) (\PT.PRINTERSTATUS 128) (
\PT.STATUSRESPONSE 129) (\PT.PRINTERCAPABILITY 130) (\PT.CAPABILITYRESPONSE 131) (\PT.PRINTJOBSTATUS
132) (\PT.PRINTJOBRESPONSE 133))
(RPAQ? PUPTYPES RAWPUPTYPES)
(RPAQQ WELLKNOWNPUPSOCKETS ((\PUPSOCKET.TELNET 1) (\PUPSOCKET.ROUTING 2) (\PUPSOCKET.FTP 3) (
\PUPSOCKET.MISCSERVICES 4) (\PUPSOCKET.ECHO 5) (\PUPSOCKET.EFTP 16) (\PUPSOCKET.PRINTERSTATUS 17) (
\PUPSOCKET.LEAF 35)))
(RPAQQ \PUPSOCKET.TELNET 1)
(RPAQQ \PUPSOCKET.ROUTING 2)
(RPAQQ \PUPSOCKET.FTP 3)
(RPAQQ \PUPSOCKET.MISCSERVICES 4)
(RPAQQ \PUPSOCKET.ECHO 5)
(RPAQQ \PUPSOCKET.EFTP 16)
(RPAQQ \PUPSOCKET.PRINTERSTATUS 17)
(RPAQQ \PUPSOCKET.LEAF 35)
(CONSTANTS (\PUPSOCKET.TELNET 1) (\PUPSOCKET.ROUTING 2) (\PUPSOCKET.FTP 3) (\PUPSOCKET.MISCSERVICES 4)
(\PUPSOCKET.ECHO 5) (\PUPSOCKET.EFTP 16) (\PUPSOCKET.PRINTERSTATUS 17) (\PUPSOCKET.LEAF 35))
(PUTPROP (QUOTE PUP) (QUOTE IMPORTDATE) (IDATE "11-AUG-83 15:26:28"))
(PUTPROPS UNLESSRDSYS MACRO ((X) X))
(PUTPROPS 1ST MACRO ((A . B) A))
(PUTPROPS 2ND MACRO ((A B . C) B))
(PUTPROPS LOCAL MACRO ((X) X))
(PUTPROPS ALLOCAL MACRO ((X) X))
(PUTPROPS ADDBASE DMACRO (= . \ADDBASE))
(PUTPROPS GETBASE DMACRO (= . \GETBASE))
(PUTPROPS GETBASEBYTE DMACRO (= . \GETBASEBYTE))
(PUTPROPS GETBASEPTR DMACRO (= . \GETBASEPTR))
(PUTPROPS HILOC DMACRO (= . \HILOC))
(PUTPROPS LOLOC DMACRO (= . \LOLOC))
(PUTPROPS PUTBASE DMACRO (= . \PUTBASE))
(PUTPROPS PUTBASEBYTE DMACRO (= . \PUTBASEBYTE))
(PUTPROPS PUTBASEPTR DMACRO (= . \PUTBASEPTR))
(PUTPROPS REPLACEPTRFIELD DMACRO (= . \RPLPTR))
(PUTPROPS VAG2 DMACRO (= . \VAG2))
(PUTPROPS PAGEBASE MACRO ((PTR) (fetch (POINTER PAGEBASE) of PTR)))
(PUTPROPS PAGELOC MACRO (OPENLAMBDA (PTR) (IPLUS (LLSH (\HILOC PTR) 8) (LRSH (\LOLOC PTR) 8))))
(PUTPROP (QUOTE RENAMEMACROS) (QUOTE IMPORTDATE) (IDATE "19-OCT-82 16:50:57"))
(* Mouse selection code)
(DEFINEQ (MOUSESTATE-EXPR (LAMBDA (EXPR MOUSEONLYFLG) (* rrb "13-JUN-82 11:53") (* if MOUSEONLYFLG is
non-NIL, the testing should be done only on the mouse buttons. MOUSEONLYFLG will be passed in as T by
MOUSESTATE but will get reset if any of the names are not mouse button names.) (PROG (NAMEMASK (
MOUSEBUTTONMASK 7)) (RETURN (COND ((NLISTP EXPR) (COND ((EQ EXPR (QUOTE UP)) (LIST (QUOTE ZEROP) (COND
(MOUSEONLYFLG (LIST (QUOTE LOGAND) MOUSEBUTTONMASK (QUOTE LASTMOUSEBUTTONS))) (T (QUOTE
LASTMOUSEBUTTONS))))) (T (* MOUSEONLYFLG can be ignored on this branch because it is generating code
for the case where the user is listing the button names and if he includes keyset names you want to
include them anyway.) (LIST (QUOTE NEQ) (LIST (QUOTE LOGAND) (QUOTE LASTMOUSEBUTTONS) (MOUSESTATE-NAME
EXPR)) 0)))) ((EQ (CAR EXPR) (QUOTE ONLY)) (COND ((SETQ NAMEMASK (MOUSESTATE-NAME (CADR EXPR)
MOUSEONLYFLG))) ((SETQ NAMEMASK (MOUSESTATE-NAME (CADR EXPR) NIL)) (* non-mouse buttons were named,
use all keys.) (SETQ MOUSEONLYFLG NIL))) (LIST (QUOTE EQ) (COND (MOUSEONLYFLG (LIST (QUOTE LOGAND)
MOUSEBUTTONMASK (QUOTE LASTMOUSEBUTTONS))) (T (QUOTE LASTMOUSEBUTTONS))) NAMEMASK)) ((for I in EXPR
always (AND (ATOM I) (NEQ I (QUOTE UP)))) (* Cant use LOGx trick for UP as it is a disjunct not a key
selector) (SELECTQ (CAR EXPR) (OR (LIST (QUOTE NEQ) 0 (LIST (QUOTE LOGAND) (QUOTE LASTMOUSEBUTTONS) (
CONS (QUOTE LOGOR) (for X in (CDR EXPR) collect (MOUSESTATE-NAME X)))))) (AND (LIST (QUOTE EQ) (CONS (
QUOTE LOGOR) (for X in (CDR EXPR) collect (MOUSESTATE-NAME X))) (LIST (QUOTE LOGAND) (QUOTE
LASTMOUSEBUTTONS) (CONS (QUOTE LOGOR) (for X in (CDR EXPR) collect (MOUSESTATE-NAME X)))))) (NOT (COND
((CDDR EXPR) (SHOULDNT))) (LIST (QUOTE ZEROP) (LIST (QUOTE LOGAND) (QUOTE LASTMOUSEBUTTONS) (
MOUSESTATE-NAME (CADR EXPR))))) (HELP (CAR EXPR) " unrecognized mouse key operator"))) (T (CONS (CAR
EXPR) (for OPT in (CDR EXPR) collect (MOUSESTATE-EXPR OPT MOUSEONLYFLG))))))))) (MOUSESTATE-NAME (
LAMBDA (KEYNAME MOUSEONLYFLG) (* rrb "13-JUN-82 11:17") (* return the numeric code for a mouse or
keyset key.) (SELECTQ KEYNAME ((LEFT RED) 4) ((RIGHT BLUE) 2) ((YELLOW MIDDLE) 1) (COND ((NOT
MOUSEONLYFLG) (* if wants mouse only, return NIL) (SELECTQ KEYNAME (LEFTKEY 128) (LEFTMIDDLEKEY 64) (
MIDDLEKEY 32) (RIGHTMIDDLEKEY 16) (RIGHTKEY 8) (HELP KEYNAME " is not a recognized key name."))))))))
(PUTPROPS MOUSESTATE ARGNAMES (BUTTONFORM))
(PUTPROPS LASTMOUSESTATE ARGNAMES (BUTTONFORM))
(PUTPROPS UNTILMOUSESTATE ARGNAMES (BUTTONFORM INTERVAL))
(PUTPROPS KEYSETSTATE ARGNAMES (BUTTONFORM))
(PUTPROPS LASTKEYSETSTATE ARGNAMES (BUTTONFORM))
(PUTPROPS MOUSESTATE MACRO (ARGS (LIST (QUOTE PROGN) (QUOTE (GETMOUSESTATE)) (MOUSESTATE-EXPR (CAR
ARGS) T))))
(PUTPROPS LASTMOUSESTATE MACRO (ARGS (MOUSESTATE-EXPR (CAR ARGS) T)))
(PUTPROPS UNTILMOUSESTATE MACRO (ARGS (COND ((AND (CDR ARGS) (CADR ARGS) (NEQ (CADR ARGS) T)) (* time
argument is given and is not T or NIL; compile in time keeping loop.) (LIST (QUOTE PROG) (LIST (LIST (
QUOTE TIMEOUT) (LIST (QUOTE IPLUS) (QUOTE (CLOCK 0)) (LIST (QUOTE OR) (LIST (QUOTE NUMBERP) (CADR ARGS
)) 100))) (QUOTE (NOWTIME (CLOCK 0)))) (QUOTE LP) (LIST (QUOTE COND) (LIST (CONS (QUOTE MOUSESTATE) (
LIST (CAR ARGS) T)) (QUOTE (RETURN T)))) (QUOTE (COND ((IGREATERP (CLOCK0 NOWTIME) TIMEOUT) (RETURN
NIL)) (T (\BACKGROUND)))) (QUOTE (GO LP)))) (T (LIST (QUOTE PROG) NIL (QUOTE LP) (LIST (QUOTE COND) (
LIST (CONS (QUOTE MOUSESTATE) (LIST (CAR ARGS) T)) (QUOTE (RETURN T)))) (QUOTE (\BACKGROUND)) (QUOTE (
GO LP)))))))
(PUTPROPS KEYSETSTATE MACRO (ARGS (LIST (QUOTE PROGN) (QUOTE (GETMOUSESTATE)) (MOUSESTATE-EXPR (CAR
ARGS)))))
(PUTPROPS LASTKEYSETSTATE MACRO (ARGS (MOUSESTATE-EXPR (CAR ARGS))))
(PUTPROPS WITHIN MACRO ((A B C) (AND (IGEQ A B) (ILESSP A (IPLUS B C)))))
(ADDTOVAR GLOBALVARS LASTMOUSEX LASTMOUSEY LASTMOUSEBUTTONS)
(PUTPROPS IABS MACRO (OPENLAMBDA (A) (COND ((IGEQ A 0) A) (T (IMINUS A)))))
(PUTPROP (QUOTE HLDISPLAY) (QUOTE IMPORTDATE) (IDATE "11-AUG-83 12:35:31"))
(DATATYPE MENU (IMAGE SAVEIMAGE ITEMS MENUROWS MENUCOLUMNS MENUGRID CENTERFLG CHANGEOFFSETFLG MENUFONT
TITLE MENUOFFSET WHENSELECTEDFN MENUBORDERSIZE MENUOUTLINESIZE WHENHELDFN MENUPOSITION WHENUNHELDFN
MENUUSERDATA) MENUGRID ← (create REGION LEFT ← 0 BOTTOM ← 0) WHENHELDFN ← (QUOTE DEFAULTMENUHELDFN)
WHENUNHELDFN ← (QUOTE CLRPROMPT) (ACCESSFNS ((ITEMWIDTH (fetch (REGION WIDTH) of (fetch (MENU MENUGRID
) of DATUM)) (replace (REGION WIDTH) of (fetch (MENU MENUGRID) of DATUM) with NEWVALUE)) (ITEMHEIGHT (
fetch (REGION HEIGHT) of (fetch (MENU MENUGRID) of DATUM)) (replace (REGION HEIGHT) of (fetch (MENU
MENUGRID) of DATUM) with NEWVALUE)) (IMAGEWIDTH (fetch (BITMAP BITMAPWIDTH) of (CHECK/MENU/IMAGE DATUM
))) (IMAGEHEIGHT (fetch (BITMAP BITMAPHEIGHT) of (CHECK/MENU/IMAGE DATUM))) (MENUREGIONLEFT (
IDIFFERENCE (fetch (REGION LEFT) of (fetch (MENU MENUGRID) of DATUM)) (fetch MENUOUTLINESIZE of DATUM)
)) (MENUREGIONBOTTOM (IDIFFERENCE (fetch (REGION BOTTOM) of (fetch (MENU MENUGRID) of DATUM)) (fetch
MENUOUTLINESIZE of DATUM))))))
(/DECLAREDATATYPE (QUOTE MENU) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)))
(PUTPROP (QUOTE MENU) (QUOTE IMPORTDATE) (IDATE "18-APR-83 18:54:23"))
(PUTPROPS \COERCETODS MACRO (OPENLAMBDA (X) (COND ((type? WINDOW X) (fetch (WINDOW DSP) of X)) (T (
\ILLEGAL.ARG X)))))
(PUTPROPS .WHILE.ON.TOP. MACRO ((FIRST . REST) (UNINTERRUPTABLY (\INTERNALTOTOPW FIRST) . REST)))
(PUTPROPS WINDOWPROP MACRO (X (CONS (COND ((IGREATERP (LENGTH X) 2) (QUOTE PUTWINDOWPROP)) (T (QUOTE
GETWINDOWPROP))) X)))
(PUTPROPS WINDOWWORLD MACRO (X (COND ((NULL X) (QUOTE (type? WINDOW TOPW))) (T (QUOTE IGNOREMACRO)))))
(DATATYPE WINDOW (DSP NEXTW SAVE REG BUTTONEVENTFN RIGHTBUTTONFN CURSORINFN CURSOROUTFN CURSORMOVEDFN
DISPLAYCONTENTSFN RESHAPEFN OBJECTEXTENT USERDATA VERTSCROLLREG HORIZSCROLLREG SCROLLFN
VERTSCROLLWINDOW HORIZSCROLLWINDOW CLOSEFN MOVEFN WTITLE NEWREGIONFN WBORDER PROCESS WINDOWENTRYFN)
BUTTONEVENTFN ← (FUNCTION TOTOPW) WBORDER ← WBorder WINDOWENTRYFN ← (FUNCTION GIVE.TTY.PROCESS))
(/DECLAREDATATYPE (QUOTE WINDOW) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER)))
(ADDTOVAR GLOBALVARS TOPW WINDOWUSERFORMS ENDOFWINDOWUSERFORMS PROMPTWINDOW KNOWNWINDOWS)
(PUTPROP (QUOTE WINDOW) (QUOTE IMPORTDATE) (IDATE "12-AUG-83 16:43:01"))
(PUTPROPS NNLITATOM MACRO (OPENLAMBDA (X) (AND X (LITATOM X))))
(PUTPROPS NNLITATOM DMACRO (OPENLAMBDA (X) (AND X (LITATOM X))))
(PUTPROPS \NULL.OR.FIXP MACRO (OPENLAMBDA (X) (OR (NULL X) (FIXP X))))
(PUTPROPS \CHECKTYPE MACRO (X (PROG ((VAR (CAR X)) (PRED (CADR X))) (if (AND (LISTP PRED) (MEMB (CAR
PRED) (QUOTE (QUOTE FUNCTION)))) then (SETQ PRED (LIST (CADR PRED) VAR))) (RETURN (SUBPAIR (QUOTE (MSG
VAR PRED)) (LIST (CONCAT "
is not a suitable value for the variable: " VAR) VAR PRED) (QUOTE (until PRED do (SETQ VAR (ERROR
VAR MSG)))))))))
(PUTPROPS CANONICAL.TIMERUNITS MACRO (OPENLAMBDA (X) (* Checks for common abbreviations before calling
\CanonicalizeTimerUnits) (SELECTQ X ((TICKS MILLISECONDS SECONDS) (* These are the canonical forms) X
) ((TICS) (QUOTE TICKS)) ((NIL MS MILLISECS) (QUOTE MILLISECONDS)) ((SECS) (QUOTE SECONDS)) (
\CanonicalizeTimerUnits X))))
(* Macros which do, respectively, macro-expansion and evaluation of their "argument")
(DEFINEQ (\MACRO...ppmacro (LAMBDA (L) (* JonL "19-NOV-82 21:46") (PROG ((POS (POSITION)) (LNL (
LINELENGTH))) (printout NIL (QUOTE %() .FONT CLISPFONT (CAR L) .FONT SYSTEMFONT (PROGN (if (NOT (FITP
(CADR L) LNL)) then (TAB (IPLUS POS 1))) (QUOTE % )) .PPFTL (CDR L) (QUOTE %)))))))
(PUTPROPS \MACRO.MX MACRO (Z (PROG ((X (EXPANDMACRO (CAR Z) T))) (COND ((EQ X (CAR Z)) (ERROR
"No macro property -- \MACRO.MX" X)) (T (RETURN X))))))
(PUTPROPS \MACRO.EVAL MACRO (Z (PROG ((X (EXPANDMACRO (CAR Z) T))) (if (EQ X (CAR Z)) then (ERROR
"No macro property -- \MACRO.EVAL" X) else (RETURN (EVAL X))))))
(ADDTOVAR PRETTYPRINTMACROS (\MACRO.MX . \MACRO...ppmacro) (\MACRO.EVAL . \MACRO...ppmacro))
(PUTPROP (QUOTE MACROAUX) (QUOTE IMPORTDATE) (IDATE "12-JUN-83 01:27:03"))
(PUTPROPS \CHECK.BYTESPEC MACRO (X (PROG ((POS (CAR X)) (SIZE (CADR X)) (LENGTHLIMIT (CADDR X))) (*
Currently, this macro may only be call with "pos" and "size" arguments as litatoms, so that they may
be "SETQ'd" in-line.) (if (NOT (NNLITATOM POS)) then (SETERRORN 14 POS) (ERRORX) elseif (NOT (
NNLITATOM SIZE)) then (SETERRORN 14 SIZE) (ERRORX) elseif (AND LENGTHLIMIT (NOT (LITATOM LENGTHLIMIT))
) then (SETERRORN 14 LENGTHLIMIT) (ERRORX)) (RETURN (BQUOTE (PROGN (\CHECKTYPE , POS (AND (
\INDEXABLE.FIXP , POS) ,@ (AND LENGTHLIMIT (BQUOTE ((ILEQ , POS , LENGTHLIMIT)))))) (\CHECKTYPE , SIZE
(AND (\INDEXABLE.FIXP , SIZE) ,@ (AND LENGTHLIMIT (BQUOTE ((ILEQ (IPLUS , POS , SIZE) , LENGTHLIMIT))
))))))))))
(PUTPROPS \INDEXABLE.FIXP MACRO (OPENLAMBDA (X) (AND (FIXP X) (IGEQ X 0))))
(PUTPROPS \INDEXABLE.FIXP DMACRO (OPENLAMBDA (X) (AND (SMALLP X) (IGEQ X 0))))
(PUTPROPS .XUNBOX. MACRO ((X HX LX) (until (SETQ LX (SELECTC (NTYPX X) (\SMALLP (COND ((SMALLPOSP X) (
SETQ HX 0) X) (T (SETQ HX MASKWORD1'S) (LOLOC X)))) (\FIXP (SETQ HX (fetch (FIXP HINUM) of X)) (fetch
(FIXP LONUM) of X)) NIL)) do (SETQ X (LISPERROR "ILLEGAL ARG" X T)))))
(PUTPROPS \MOVETOBOX DMACRO (OPENLAMBDA (N D) (SELECTC (NTYPX N) (\SMALLP (replace (FIXP HINUM) of D
with 0) (replace (FIXP LONUM) of D with N)) (\FIXP (replace (FIXP HINUM) of D with (fetch (FIXP HINUM)
of N)) (replace (FIXP LONUM) of D with (fetch (FIXP LONUM) of N))) (\ILLEGAL.ARG N))))
(PUTPROPS .XLLSH. MACRO ((HI LO N) (if (IGEQ N BITSPERWORD) then (* Jump 10 bits in a single bound!) (
SETQ HI LO) (SETQ LO 0) (SETQ N (IDIFFERENCE N BITSPERWORD))) (if (IGEQ N BITSPERHALFWORD) then (*
Jump 8 bits in a single bound!) (SETQ HI (LOGOR (.LOHALFWORDHI. HI) (.HIHALFWORDLO. LO))) (SETQ LO (
.LOHALFWORDHI. LO)) (SETQ N (IDIFFERENCE N BITSPERHALFWORD))) (if (IGEQ N 4) then (* Jump 4 bits in a
single bound!) (SETQ HI (LOGOR (LRSH LO (CONSTANT (IDIFFERENCE BITSPERWORD 4))) (LLSH (LOGAND HI (
CONSTANT (MASK.1'S 0 (IDIFFERENCE BITSPERWORD 4)))) 4))) (SETQ LO (LLSH (LOGAND LO (CONSTANT (MASK.1'S
0 (IDIFFERENCE BITSPERWORD 4)))) 4)) (SETQ N (IDIFFERENCE N 4))) (* MASK0WORD1'S should be same as (
SUB1 (LSH 1 (SUB1 BITSPERWORD)))) (FRPTQ N (SETQ HI (LLSH (LOGAND HI MASK0WORD1'S) 1)) (SETQ LO (LLSH
(if (IGEQ LO MASK1WORD0'S) then (add HI 1) (LOGAND LO MASK0WORD1'S) else LO) 1)))))
(PUTPROPS .XLRSH. MACRO ((HI LO N) (if (IGEQ N BITSPERWORD) then (* Jump 10 bits in a single bound!) (
SETQ LO HI) (SETQ HI 0) (SETQ N (IDIFFERENCE N BITSPERWORD))) (if (IGEQ N BITSPERHALFWORD) then (*
Jump 8 bits in a single bound!) (SETQ LO (LOGOR (.HIHALFWORDLO. LO) (.LOHALFWORDHI. HI))) (SETQ HI (
.HIHALFWORDLO. HI)) (SETQ N (IDIFFERENCE N BITSPERHALFWORD))) (if (IGEQ N 4) then (* Jump 4 bits in a
single bound!) (SETQ LO (LOGOR (LLSH (LOGAND HI (CONSTANT (MASK.1'S 0 4))) (CONSTANT (IDIFFERENCE
BITSPERWORD 4))) (LRSH LO 4))) (SETQ HI (LRSH HI 4)) (SETQ N (IDIFFERENCE N 4))) (* MASK1WORD0'S
should be same as \SIGNBIT) (FRPTQ N (SETQ LO (if (ODDP HI) then (LOGOR (LRSH LO 1) MASK1WORD0'S) else
(LRSH LO 1))) (SETQ HI (LRSH HI 1)))))
(PUTPROPS .XLLSH1. MACRO ((HI LO) (PROGN (SETQ HI (LLSH (LOGAND HI MASK0WORD1'S) 1)) (SETQ LO (LSH (
COND ((IGEQ LO MASK1WORD0'S) (SETQ HI (LOGOR HI 1)) (LOGAND LO MASK0WORD1'S)) (T LO)) 1)))))
(PUTPROPS .SUMSMALLMOD. MACRO ((X Y OVERFLOWFORM) ((LAMBDA (\SumSmallModVar) (DECLARE (LOCALVARS
\SumSmallModVar)) (IF (ILEQ X \SumSmallModVar) THEN (IPLUS X Y) ELSE OVERFLOWFORM (IDIFFERENCE X (ADD1
\SumSmallModVar)))) (IDIFFERENCE MAX.SMALL.INTEGER Y))))
(PUTPROPS .DIFFERENCESMALLMOD. MACRO ((X Y BORROWFORM) (IF (NOT (IGREATERP Y X)) THEN (IDIFFERENCE X Y
) ELSE BORROWFORM (ADD1 (IDIFFERENCE MAX.SMALL.INTEGER (IDIFFERENCE Y X))))))
(PUTPROPS .ADD.2WORD.INTEGERS. MACRO ((HX LX HY LY) (* Ignores carry out of high-order word) (SETQ HX
(.SUMSMALLMOD. HX HY)) (SETQ LX (.SUMSMALLMOD. LX LY (SETQ HX (if (EQ HX MAX.SMALL.INTEGER) then 0
else (ADD1 HX)))))))
(PUTPROPS .SUB.2WORD.INTEGERS. MACRO ((HX LX HY LY) (* Ignores carry out of high-order word) (SETQ HX
(.DIFFERENCESMALLMOD. HX HY)) (SETQ LX (.DIFFERENCESMALLMOD. LX LY (SETQ HX (if (EQ HX 0) then
MAX.SMALL.INTEGER else (SUB1 HX)))))))
(PUTPROPS .32BITMUL. MACRO ((HR LR X Y) (PROG (HX LX HY LY) (if (ILESSP X Y) then (swap X Y)) (* Y is
the lesser of the two now) (.XUNBOX. X HX LX) (.XUNBOX. Y HY LY) LP (if (ODDP LY) then (
.ADD.2WORD.INTEGERS. HR LR HX LX)) (if (EQ HY 0) then (SETQ LY (LRSH LY 1)) (if (EQ LY 0) then (RETURN
)) else (.LRSH1. HY LY)) (* Trim off highest bits, so that left-shifting doesn't generate FIXPs) (SETQ
HX (LOGAND HX MASK0WORD1'S)) (.LLSH1. HX LX) (GO LP))))
(PUTPROPS \GETBASEFLOATP DMACRO ((BASE OFFST) ((LAMBDA (\NewBaseAddr) (DECLARE (LOCALVARS \NewBaseAddr
)) (create FLOATP HIWORD ← (\GETBASE \NewBaseAddr 0) LOWORD ← (\GETBASE \NewBaseAddr 1))) (\ADDBASE
BASE OFFST))))
(PUTPROPS \PUTBASEFLOATP DMACRO ((BASE OFFST VAL) ((LAMBDA (\NewBaseAddr \NewVal) (DECLARE (LOCALVARS
\NewBaseAddr \NewVal)) (OR (FLOATP \NewVal) (\ILLEGAL.ARG \NewVal)) (\PUTBASE \NewBaseAddr 0 (fetch (
FLOATP HIWORD) of \NewVal)) (\PUTBASE \NewBaseAddr 1 (fetch (FLOATP LOWORD) of \NewVal)) \NewVal) (
\ADDBASE BASE OFFST) VAL)))
(PUTPROPS \GETBASEFIXP DMACRO ((BASE D) ((LAMBDA (\NewBaseAddr) (\MAKENUMBER (\GETBASE \NewBaseAddr 0)
(\GETBASE \NewBaseAddr 1))) (\ADDBASE BASE D))))
(PUTPROPS \PUTBASEFIXP DMACRO ((BASE OFFST VAL) (* JonL "14-OCT-82 11:24") ((LAMBDA (\NewBaseAddr
\NewVal \HiPart \LoPart) (DECLARE (LOCALVARS \NewBaseAddr \NewVal \HiPart \LoPart)) (.XUNBOX. \NewVal
\HiPart \LoPart) (\PUTBASE \NewBaseAddr 0 \HiPart) (\PUTBASE \NewBaseAddr 1 \LoPart) \NewVal) (
\ADDBASE BASE OFFST) VAL)))
(PUTPROPS \GETBASENIBBLE DMACRO (OPENLAMBDA (BASE OFFST) ((LAMBDA (\Byte) (DECLARE (LOCALVARS \Byte))
(if (ODDP OFFST) then (LOGAND \Byte (CONSTANT (MASK.1'S 0 BITSPERNIBBLE))) else (LRSH \Byte
BITSPERNIBBLE))) (\GETBASEBYTE BASE (FOLDLO OFFST NIBBLESPERBYTE)))))
(PUTPROPS \PUTBASENIBBLE DMACRO (OPENLAMBDA (BASE OFFST VAL) ((LAMBDA (\ByteNo) (DECLARE (LOCALVARS
\ByteNo)) ((LAMBDA (\Byte) (DECLARE (LOCALVARS \Byte)) (\PUTBASEBYTE BASE \ByteNo (if (ODDP OFFST)
then (LOGOR (LOGAND \Byte (CONSTANT (MASK.1'S BITSPERNIBBLE BITSPERNIBBLE))) VAL) else (LOGOR (LOGAND
\Byte (CONSTANT (MASK.1'S 0 BITSPERNIBBLE))) (LLSH VAL BITSPERNIBBLE))))) (\GETBASEBYTE BASE \ByteNo))
) (FOLDLO OFFST NIBBLESPERBYTE))))
(PUTPROPS \GETBASEBIT DMACRO (OPENLAMBDA (BASE OFFST) ((LAMBDA (\ByteNo \BitMask) (DECLARE (LOCALVARS
\ByteNo \BitMask)) (if (ZEROP (LOGAND \BitMask (\GETBASEBYTE BASE \ByteNo))) then 0 else 1)) (FOLDLO
OFFST BITSPERBYTE) (MASK.1'S (IDIFFERENCE (CONSTANT (SUB1 BITSPERBYTE)) (IMOD OFFST BITSPERBYTE)) 1)))
)
(PUTPROPS \PUTBASEBIT DMACRO (OPENLAMBDA (BASE OFFST VAL) ((LAMBDA (\ByteNo \BitMask \Byte) (DECLARE (
LOCALVARS \ByteNo \BitMask \Byte)) (SETQ \Byte (\GETBASEBYTE BASE \ByteNo)) (if (if (ZEROP (LOGAND
\BitMask \Byte)) then (NOT (ZEROP VAL)) else (ZEROP VAL)) then (\PUTBASEBYTE BASE \ByteNo (LOGXOR
\BitMask \Byte))) VAL) (FOLDLO OFFST BITSPERBYTE) (MASK.1'S (IDIFFERENCE (CONSTANT (SUB1 BITSPERBYTE))
(IMOD OFFST BITSPERBYTE)) 1))))
(PUTPROP (QUOTE ADDARITH) (QUOTE IMPORTDATE) (IDATE "19-JUL-83 02:21:23"))
(PUTPROPS \UPDATETIMERS MACRO (NIL (* * Moves excess time from the processor clock to our software
clocks. Needs to be run often, uninterruptably, preferably from the vertical retrace interrupt) (* Get
processor clock) (PROG ((EXCESS (\BOXIDIFFERENCE (\RCLK (LOCF (fetch RCLKTEMP0 of \MISCSTATS))) (LOCF
(fetch BASECLOCK of \MISCSTATS))))) (RETURN (COND ((OR (IGEQ EXCESS \RCLKSECOND) (ILESSP EXCESS 0)) (
* More than one second has elapsed since we updated clocks) (\BOXIPLUS (LOCF (fetch BASECLOCK of
\MISCSTATS)) \RCLKSECOND) (* Increment base by one second) (\BOXIPLUS (LOCF (fetch MILLISECONDSCLOCK
of \MISCSTATS)) 1000) (* Increment clocks by 1 second) (\BOXIPLUS (LOCF (fetch SECONDSCLOCK of
\MISCSTATS)) 1) T))))))
(RPAQQ \RTCSECONDS 378)
(RPAQQ \RTCMILLISECONDS 380)
(RPAQQ \RTCBASE 382)
(RPAQQ \OFFSET.SECONDS 0)
(RPAQQ \OFFSET.MILLISECONDS 2)
(RPAQQ \OFFSET.BASE 4)
(RPAQQ \ALTO.RCLKSECOND 1680000)
(RPAQQ \ALTO.RCLKMILLISECOND 1680)
(RPAQQ \DLION.RCLKMILLISECOND 35)
(RPAQQ \DLION.RCLKSECOND 34746)
(CONSTANTS (\RTCSECONDS 378) (\RTCMILLISECONDS 380) (\RTCBASE 382) (\OFFSET.SECONDS 0) (
\OFFSET.MILLISECONDS 2) (\OFFSET.BASE 4) (\ALTO.RCLKSECOND 1680000) (\ALTO.RCLKMILLISECOND 1680) (
\DLION.RCLKMILLISECOND 35) (\DLION.RCLKSECOND 34746))
(PUTPROP (QUOTE LLFAULT) (QUOTE IMPORTDATE) (IDATE " 6-AUG-83 22:47:15"))
(DATATYPE SYSQUEUE ((NIL BYTE) (SYSQUEUEHEAD POINTER) (NIL BYTE) (SYSQUEUETAIL POINTER)))
(BLOCKRECORD QABLEITEM ((NIL BYTE) (QLINK POINTER) (* Link to next thing in queue always in first
pointer of datum, independent of what the datum is)) (BLOCKRECORD QABLEITEM ((NIL BYTE) (LINK POINTER)
(* Let's also be able to call it a LINK))))
(/DECLAREDATATYPE (QUOTE SYSQUEUE) (QUOTE (BYTE POINTER BYTE POINTER)))
(PUTPROPS \QUEUEHEAD MACRO ((Q) (fetch (SYSQUEUE SYSQUEUEHEAD) of Q)))
(PUTPROPS \DETCONC MACRO (OPENLAMBDA (TQ) (PROG1 (\PEEKTCONC TQ) (if (NULL (CAR (RPLACA TQ (CDAR TQ)))
) then (RPLACD TQ)))))
(PUTPROPS \ENTCONC MACRO (= . TCONC))
(PUTPROPS \PEEKTCONC MACRO (= . CAAR))
(* * Skeletal ether packet. Other users define with respect to)
(DATATYPE ETHERPACKET ((NIL BYTE) (EPLINK POINTER) (* For queue maintenence) (EPFLAGS BYTE) (*
optional flags for some applications) (EPUSERFIELD POINTER) (* Arbitrary pointer for applications) (
NIL BYTE) (EPPLIST POINTER) (* Extra field for use as an A-list for properties) (EPTRANSMITTING FLAG)
(* True while packet is being transmitted and hence cannot be reused) (NIL BITS 7) (EPREQUEUE POINTER)
(* Where to requeue this packet after transmission) (NIL BYTE) (EPSOCKET POINTER) (NIL BYTE) (
EPNETWORK POINTER) (EPTYPE WORD) (* Type of packet to be encapsulated (PUP or XIP or 10TO3)) (NIL 9
WORD) (* Space for expansion) (* Note: This next field wants to be quad+2 aligned so that the 10mb
packet is quad+3 aligned) (EPENCAPSULATION 8 WORD) (* 10mb encapsulation, or 3mb encapsulation with
padding) (EPBODY 289 WORD) (* Body of packet, header up to 16 words plus data up to 546 bytes)))
(ACCESSFNS ETHERAUX ((AUXPTR (CDR (ASSOC (QUOTE AUXPTR) (fetch EPPLIST of DATUM))) (\EP.PUT.AUX DATUM
(QUOTE AUXPTR) NEWVALUE)) (AUXWORD (OR (CDR (ASSOC (QUOTE AUXWORD) (fetch EPPLIST of DATUM))) 0) (
\EP.PUT.AUX DATUM (QUOTE AUXWORD) NEWVALUE)) (AUXBYTE (OR (CDR (ASSOC (QUOTE AUXBYTE) (fetch EPPLIST
of DATUM))) 0) (\EP.PUT.AUX DATUM (QUOTE AUXBYTE) NEWVALUE))))
(/DECLAREDATATYPE (QUOTE ETHERPACKET) (QUOTE (BYTE POINTER BYTE POINTER BYTE POINTER FLAG (BITS 7)
POINTER BYTE POINTER BYTE POINTER WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD)))
(RPAQQ \EPT.PUP 512)
(RPAQQ \3MBTYPE.PUP 512)
(RPAQQ \10MBTYPE.PUP 512)
(RPAQQ \EPT.XIP 1536)
(RPAQQ \3MBTYPE.XIP 1536)
(RPAQQ \10MBTYPE.XIP 1536)
(RPAQQ \EPT.10TO3 1537)
(RPAQQ \3MBTYPE.10TO3 1537)
(RPAQQ \EPT.UNKNOWN 255)
(CONSTANTS \EPT.PUP \3MBTYPE.PUP \10MBTYPE.PUP \EPT.XIP \3MBTYPE.XIP \10MBTYPE.XIP \EPT.10TO3
\3MBTYPE.10TO3 \EPT.UNKNOWN)
(DATATYPE NSADDRESS ((NSNET FIXP) (NSHNM0 WORD) (NSHNM1 WORD) (NSHNM2 WORD) (NSSOCKET WORD)) (
ACCESSFNS (NSHOSTNUMBER (LOADNSHOSTNUMBER (LOCF (fetch NSHNM0 of DATUM))) (STORENSHOSTNUMBER (LOCF (
fetch NSHNM0 of DATUM)) NEWVALUE))) (BLOCKRECORD NSADDRESS ((NSNETHI WORD) (NSNETLO WORD))))
(TYPERECORD NSHOSTNUMBER (NSHOST0 NSHOST1 NSHOST2))
(/DECLAREDATATYPE (QUOTE NSADDRESS) (QUOTE (FIXP WORD WORD WORD WORD)))
(PUTPROPS LOADNSHOSTNUMBER MACRO (= . \LOADNSHOSTNUMBER))
(PUTPROPS STORENSHOSTNUMBER MACRO (= . \STORENSHOSTNUMBER))
(PUTPROPS \MOVENSADDRESSES MACRO ((BASE1 BASE2) (\BLT BASE2 BASE1 \#WDS.NSADDRESS)))
(PUTPROPS \SWAPNSADDRESSES MACRO (OPENLAMBDA (BASE1 BASE2) (for I from 0 to (SUB1 \#WDS.NSADDRESS) do
(\PUTBASE BASE1 I (PROG1 (\GETBASE BASE2 I) (\PUTBASE BASE2 I (PROGN (\GETBASE BASE1 I))))))))
(RPAQQ \#WDS.NSADDRESS 6)
(RPAQQ \#WDS.NSHOSTNUMBER 3)
(CONSTANTS (\#WDS.NSADDRESS 6) (\#WDS.NSHOSTNUMBER 3))
(PUTPROPS \LOCALNSHOSTNUMBER MACRO (NIL \MY.NSHOSTNUMBER))
(PUTPROPS \LOCALNSNETNUMBER MACRO (NIL \MY.NSNETNUMBER))
(PUTPROPS \LOCALNSADDRESS MACRO (NIL \MY.NSADDRESS))
(PUTPROPS EQNSHOSTNUMBER MACRO (= . EQUAL))
(PUTPROPS \BLTLOCALHOSTNUMBER MACRO ((BASE) (\BLT BASE (LOCF (fetch (IFPAGE NSHost0) of \InterfacePage
)) 3)))
(ADDTOVAR GLOBALVARS BROADCASTNSHOSTNUMBER \MY.NSADDRESS \MY.NSHOSTNUMBER \MY.NSNETNUMBER)
(RPAQQ \NULLCHECKSUM 65535)
(CONSTANTS (\NULLCHECKSUM 65535))
(PUTPROPS \SERIALNUMBER MACRO (NIL (fetch (IFPAGE SerialNumber) of \InterfacePage)))
(PUTPROPS \DEVICE.INPUT DOPVAL (1 MISC1 1))
(PUTPROPS \DEVICE.OUTPUT DOPVAL (2 MISC2 2))
(PUTPROPS \D0.STARTIO DOPVAL (1 MISC1 0))
(PUTPROP (QUOTE LLETHER) (QUOTE IMPORTDATE) (IDATE " 9-AUG-83 16:47:05"))
(PUTPROPS IMAGEOP MACRO (ARGS (CONS (QUOTE SPREADAPPLY*) (CONS (COND ((EQ (CAR (LISTP (CAR ARGS))) (
QUOTE QUOTE)) (LIST (QUOTE fetch) (LIST (QUOTE IMAGEOPS) (CADAR ARGS)) (QUOTE of) (LIST (QUOTE fetch)
(QUOTE (STREAM IMAGEOPS)) (QUOTE of) (CADR ARGS)))) (T (HELP "IMAGEOP - OPNAME not quoted:" ARGS))) (
CDDR ARGS)))))
(PUTPROPS \DISPLAYSTREAMP MACRO ((X) (type? DISPLAYSTREAM X)))
(DATATYPE IMAGEOPS (IMAGETYPE IMCLOSEFN IMXPOSITION IMYPOSITION IMFONT IMLEFTMARGIN IMRIGHTMARGIN
IMLINEFEED IMDRAWLINE IMDRAWCURVE IMDRAWCIRCLE IMDRAWELLIPSE IMBLTSHADE))
(/DECLAREDATATYPE (QUOTE IMAGEOPS) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER)))
(ADDTOVAR GLOBALVARS \NOIMAGEOPS)
(PUTPROP (QUOTE IMAGEIO) (QUOTE IMPORTDATE) (IDATE "16-JUL-83 12:30:48"))
(DATATYPE PROCESS ((NIL BYTE) (MYSTACK POINTER) (* Stack pointer to this context when it is asleep) (
PROCSTATUS BYTE) (* Running, waiting) (PROCNAME POINTER) (* Name for convenience in type-in reference)
(PROCPRIORITY BYTE) (* Priority level, 0-4) (PROCQUEUE POINTER) (* Queue of processes at the same
priority) (NIL BYTE) (NEXTPROCHANDLE POINTER) (* Pointer to next one) (PROCTIMERSET FLAG) (* True if
PROCWAKEUPTIMER has an interesting value) (PROCBEINGDELETED FLAG) (* True if proc was deleted, but
hasn't been removed from \PROCESSES yet) (PROCDELETED FLAG) (PROCSYSTEMP FLAG) (NIL BITS 4) (
PROCWAKEUPTIMER POINTER) (* a largep recording the time this proc last went to sleep) (PROCTIMERLINK
POINTER) (* For linking proc in timer queue) (PROCTIMERBOX POINTER) (* Scratch box to use for
PROCWAKEUPTIMER when user does not give one explicitly) (WAKEREASON POINTER) (* Reason process is
being run. From WAKE.PROCESS or timer or event wakeup; T from simple BLOCK) (PROCEVENTORLOCK POINTER)
(* EVENT or MONITOR lock that this proc is waiting for) (PROCFORM POINTER) (* Form to EVAL to start it
going) (RESTARTABLE POINTER) (* T = autorestart on error, HARDRESET = restart only on hard reset, NIL
= never restart) (PROCWINDOW POINTER) (* Window this process lives in, if any) (PROCFINISHED POINTER)
(* True if proc finished. Value is indication of how: NORMAL, DELETED, ERROR) (PROCRESULT POINTER) (*
Value it returned if it finished normally) (PROCFINISHEVENT POINTER) (* Optional EVENT to be notified
when proc finishes) (PROCMAILBOX POINTER) (* Message queue) (PROCRESETVARSLST POINTER) (* Binding for
RESETVARSLST in this process) (PROCINFOHOOK POINTER) (* Optional user fn that displays info about
process) (PROCTYPEAHEAD POINTER) (* Buffer of typeahead destined for this proc) (PROCREMOTEINFO
POINTER) (* For Enterprise) (PROCUSERDATA POINTER) (* For PROCESSPROP) (PROCEVENTLINK POINTER) (* Used
to maintain EVENT queues) (PROCAFTEREXIT POINTER) (* What to do with this process when coming back
from a LOGOUT, etc) (PROCBEFOREEXIT POINTER) (* For expansion) (PROCOWNEDLOCKS POINTER) (* Pointer to
first lock I currently own) (PROCEVAPPLYRESULT POINTER) (* For PROCESS.EVAL and PROCESS.APPLY when
WAITFORRESULT is true) (PROCTTYENTRYFN POINTER) (* Is applied to a process when it becomes the tty
process) (PROCTTYEXITFN POINTER) (* Is applied to a process when it ceases to be the tty process) (
PROCDRIBBLEOFD POINTER) (NIL POINTER) (NIL POINTER) (NIL POINTER) (* For expansion)) (ACCESSFNS
PROCESS ((PROCFX (fetch EDFXP of (fetch MYSTACK of DATUM)) (replace EDFXP of (fetch MYSTACK of DATUM)
with NEWVALUE)))) PROCTIMERBOX ← (CREATECELL \FIXP))
(/DECLAREDATATYPE (QUOTE PROCESS) (QUOTE (BYTE POINTER BYTE POINTER BYTE POINTER BYTE POINTER FLAG
FLAG FLAG FLAG (BITS 4) POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER)))
(PUTPROPS THIS.PROCESS MACRO (NIL \RUNNING.PROCESS))
(PUTPROPS TTY.PROCESS MACRO (X (COND ((CAR X) (QUOTE IGNOREMACRO)) (T (QUOTE \TTY.PROCESS)))))
(PUTPROPS TTY.PROCESSP MACRO (X (COND ((CAR X) (QUOTE IGNOREMACRO)) (T (QUOTE (OR (NULL (THIS.PROCESS)
) (EQ (THIS.PROCESS) (TTY.PROCESS))))))))
(ADDTOVAR GLOBALVARS \RUNNING.PROCESS \TTY.PROCESS \PROC.RESTARTME \PROC.RESETME)
(PUTPROP (QUOTE PROC) (QUOTE IMPORTDATE) (IDATE "11-AUG-83 12:34:59"))
STOP