From 08e8c7fd8b530a4a041495c3a6725a7c10e742c1 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Fri, 8 Jan 2021 00:29:56 -0800 Subject: [PATCH] update MAKE-EXPORTS-ALL and run it --- internal/library/MAKE-EXPORTS-ALL | 2 +- internal/library/MAKE-EXPORTS-ALL.LCOM | Bin 0 -> 1446 bytes library/EXPORTS.ALL | 2 +- 3 files changed, 2 insertions(+), 2 deletions(-) create mode 100644 internal/library/MAKE-EXPORTS-ALL.LCOM diff --git a/internal/library/MAKE-EXPORTS-ALL b/internal/library/MAKE-EXPORTS-ALL index becbe3e6..b6f8d6f8 100644 --- a/internal/library/MAKE-EXPORTS-ALL +++ b/internal/library/MAKE-EXPORTS-ALL @@ -1 +1 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED " 3-May-2018 15:37:56"  {DSK}kaplan>Local>medley3.5>lispcore>internal>library>MAKE-EXPORTS-ALL.;1 1800 changes to%: (VARS MAKE-EXPORTS-ALLCOMS)) (PRETTYCOMPRINT MAKE-EXPORTS-ALLCOMS) (RPAQQ MAKE-EXPORTS-ALLCOMS ((* "Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/. Don't know why it does the CORE/RENAME" ) (* "Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory." ) (* "Edited July 5, 1990 by Sybalsky -- point it to Pele as the truth directory.") (* "Edited September 29, 1986 by van Melle") (P (BKSYSBUF '(PROGN (CNDIR (CONCAT (UNIX-GETENV "MEDLEYDIR") '/lispcore/sources/)) (LOAD 'FILESETS) (RENAMEFILE (GATHEREXPORTS EXPORTFILES '{CORE}EXPORTS.ALL) '../library/EXPORTS.ALL)) T)))) (* "Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/. Don't know why it does the CORE/RENAME" ) (* "Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory.") (* "Edited July 5, 1990 by Sybalsky -- point it to Pele as the truth directory.") (* "Edited September 29, 1986 by van Melle") (BKSYSBUF '(PROGN (CNDIR (CONCAT (UNIX-GETENV "MEDLEYDIR") '/lispcore/sources/)) (LOAD 'FILESETS) (RENAMEFILE (GATHEREXPORTS EXPORTFILES '{CORE}EXPORTS.ALL) '../library/EXPORTS.ALL)) T) (PUTPROPS MAKE-EXPORTS-ALL COPYRIGHT (NONE)) (DECLARE%: DONTCOPY (FILEMAP (NIL))) STOP \ No newline at end of file +(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED " 8-Jan-2021 00:18:29"  {DSK}larry>ilisp>medley>internal>library>MAKE-EXPORTS-ALL.;3 2139 changes to%: (VARS MAKE-EXPORTS-ALLCOMS) (FNS MAKE-EXPORTS-ALL) previous date%: " 3-May-2018 15:37:56" {DSK}larry>ilisp>medley>internal>library>MAKE-EXPORTS-ALL.;1) (PRETTYCOMPRINT MAKE-EXPORTS-ALLCOMS) (RPAQQ MAKE-EXPORTS-ALLCOMS [(* "Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/. Don't know why it does the CORE/RENAME" ) (* "Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory." ) (* "Edited July 5, 1990 by Sybalsky -- point it to Pele as the truth directory." ) (* "Edited September 29, 1986 by van Melle") (FNS MAKE-EXPORTS-ALL) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (BKSYSBUF " ") (MAKE-EXPORTS-ALL]) (* "Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/. Don't know why it does the CORE/RENAME" ) (* "Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory.") (* "Edited July 5, 1990 by Sybalsky -- point it to Pele as the truth directory.") (* "Edited September 29, 1986 by van Melle") (DEFINEQ (MAKE-EXPORTS-ALL [LAMBDA NIL (* ; "Edited 8-Jan-2021 00:17 by larry") (PROGN (BKSYSBUF " ") (CNDIR (MEDLEYDIR "sources")) (LOAD 'FILESETS) (RENAMEFILE (GATHEREXPORTS EXPORTFILES '{CORE}EXPORTS.ALL) (MEDLEYDIR "libary" "EXPORTS.ALL" T]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (BKSYSBUF " ") (MAKE-EXPORTS-ALL) ) (PUTPROPS MAKE-EXPORTS-ALL COPYRIGHT (NONE)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1641 2000 (MAKE-EXPORTS-ALL 1651 . 1998))))) STOP \ No newline at end of file diff --git a/internal/library/MAKE-EXPORTS-ALL.LCOM b/internal/library/MAKE-EXPORTS-ALL.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..cdc41e1ed769fb18b7d3400e02e97e82bca45bbe GIT binary patch literal 1446 zcmb_c?{AY(6s;fCkoXsvlb0B&87;J>wrCbvdEL5FKtN+Z()MK~W6)4KCCmPIFKq62 z)I|9}-h21HbMNJxgKY8f#No<#VsmBUj9t9;xoL&wfz81tPRMxY42+IH(hw@ENV#oXjnOI1OIRL$si z7#3Bj6DLrfqhBY8XK*beXl{To;25&rTG_nRg&#Tw%s@|U51iX6r;wGm~ zj9*s!`tVgl?)Twy$DEO9NuPZUGj7>@ZcTjjbR3%D5%;g9f^HACYg*{^FmkF4ZFnbr zh=XY`4-USJiQ%4#i;?T|%j>%>k{LQf)D!S9pcLpj*qtz`MFk^`l0+G_9vEpWUy3aQ ztx@U5^LZG~i7wA4BR$QdB>SHE`SX)O$nrZPkgwuOo(*(`b{B-;`V= zQ4yaDQqApz?aEZkEEnw-U}fps0;g&A9pBd_;sUFzQrTLdn!A1VQJF-#dPiekRWx@e z(B5O%1Jw)4MU-q$ODGC98JV;Kp?dApI6Y~LADb*MZb~A$!Y=Y%vBoOS#j?oqvc+or zn~{!pNeO+Ah#9KCtKo@6{3T={HibA_h@9xFfCv2w_&iE66G2Ve*<4frIuJ_o$#D+KbCx=HN NWXE+l!8sFK`Uy2KhtdE5 literal 0 HcmV?d00001 diff --git a/library/EXPORTS.ALL b/library/EXPORTS.ALL index fafe5f6d..003818d6 100644 --- a/library/EXPORTS.ALL +++ b/library/EXPORTS.ALL @@ -1 +1 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (LISPXPRIN1 "EXPORTS GATHERED FROM {DSK}kaplan>Local>medley3.5>lispcore>sources> ON 3-May-2018 15:59:42" T) (LISPXTERPRI T) (PUTPROP (QUOTE FILESETS) (QUOTE IMPORTDATE) (IDATE "29-Jan-98 16:26:53")) (RPAQQ MODARITHMACROS (CEIL FLOOR FOLDHI FOLDLO MODUP UNFOLD 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 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 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 "16-May-90 20:46:21")) (RPAQQ WINDFLG T) (CONSTANTS (WINDFLG T)) (RPAQQ INITCONSTANTS ((* ;;; "(LISPNAME VALUE BCPLNAME UCODENAME)") (CDRCODING 1 T T) (* ; "IF CDRCODING=0, CDR CODING IS OFF, OTHERWISE ON") (* ;; "type numbers -- repeated on LLBASIC too") ( \SMALLP 1 SMALLTYPE SmallType) (\FIXP 2 INTEGERTYPE FixpType) (\FLOATP 3 FLTPTTYPE FloatpType) ( \LITATOM 4 ATOMTYPE AtomType) (\LISTP 5 LISTTYPE ListType) (\ARRAYP 6 ARRAYPTRTYPE ArrayType) ( \STRINGP 7 STRINGPTRTYPE) (\STACKP 8) (\CHARACTERP 9) (\VMEMPAGEP 10 NIL VMemPagePType) (\STREAM 11 NIL STREAMTYPE) (* ;; "TYPE TABLE CONSTANTS - - - - - - - - - - - - - - - - - - - - - -") ( \TT.TYPEMASK 2047 TTTypeMask T) (\TT.NOREF 32768 NIL T) (\TT.SYMBOLP 16384 NIL T) (\TT.FIXP 8192) ( \TT.NUMBERP 4096) (\TT.ATOM 2048) (* ;; "page map - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -") (\PMblockSize 32 PMBLOCKSIZE) (\STATSsize 8 T) (\NumPMTpages 8) (\EmptyPMTEntry 65535 T) (\FirstVmemBlock 2 T) ( \MAXVMPAGE 131069) (\MAXVMSEGMENT 255) (* ;; "interface page") (\IFPValidKey 5603 T) (* ;; "MDS") ( \FirstMDSPage 16382) (\MaxMDSPage 524285) (\DefaultSecondMDSPage 65532) (\MDSIncrement 512) ( \PagesPerMDSUnit 2) (* ; "(FOLDLO \MDSIncrement WORDSPERPAGE)") (* ;; "arrays") (\ARRAYSPACE (46 0)) ( \FirstArraySegment 46) (\FirstArrayPage 11776) (\ARRAYSPACE2 (64 0)) (\DefaultSecondArrayPage 16384) ( * ;; "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 65536 NIL T) ( \HTCOLLSIZE 1048576 NIL T) (* ; "HTCOLL size in words") (\HTENDFREE 1 NIL T) (\HTFREEPTR 0 NIL T) (* ;; "pointers and lengths of various data spaces") (\ATOMSPACE (0 0) (ATOMspace NIL) (atomHiVal NIL)) ( \AtomHI 0) (\CHARHI 7) (* ; "overlap character space and the atom hash table space") (\AtomHashTable ( 21 0) (AHTspace AHTbase)) (\AtomHTpages 256 AHTSIZE) (\LastAtomPage 255) (\MaxAtomFrLst 65535) ( \SMALLPOSPSPACE (14 0)) (\SmallPosHi 14 SMALLPOSspace smallpl) (\SMALLNEGSPACE (15 0)) (\SmallNegHi 15 SMALLNEGspace smallneg) (\NumSmallPages 512) (* ;; "PNAME SPACEin the old world; used for initial atoms now.") (\PNPSPACE (8 0) (PNPspace PNPbase)) ( \PNAME.HI 8) (\OLDATOMSPACE (44 0)) (* ; "NEW ATOM SPACE") (\ATOM.HI 44) (* ; "HI PART OF NEW ATOM SPACE") (* ;; "Definitions in old atom world") (\DEFSPACE (10 0) (DEFspace DEFbase) (DEFspace DEFbase)) (\DEF.HI 10) (\VALSPACE (12 0) (TOPVALspace TOPVALbase) (VALspace VALbase )) (\VAL.HI 12) (\PLISTSPACE (2 0) (PLISTspace PLISTbase)) (\PLIST.HI 2) (\PAGEMAP (5 0) (PAGEMAPspace PAGEMAPbase)) (\NumPageMapPages 256) (\PageMapTBL (20 512) (PMTspace PMTbase)) (\InterfacePage (20 0) (INTERFACEspace INTERFACEbase) (INTERFACEspace INTERFACEbase)) (\IOPAGE (0 65280)) (\DoveIORegion (0 16384)) (\IOCBPAGE (0 256)) (\FPTOVP (2 0)) (\MDSTypeTable (24 0) (MDSTYPEspace MDSTYPEbase) ( MDSTYPEspace MDSTYPEbase)) (\MDSTTsize 1024 T) (* ; "in Pages") (\MISCSTATS (20 2560) (STATSspace MISCSTATSbase)) (\UFNTable (20 3072) NIL (STATSspace UFNTablebase)) (\UFNTableSize 2) (\DTDSpaceBase ( 20 4096) (DTDspace DTDbase) (DTDspace DTDbase)) (\DTDSize 18 T) (\LISTPDTD (20 4186)) (\EndTypeNumber 2047) (\LOCKEDPAGETABLE (20 28672)) (\NumLPTPages 16) (\STACKSPACE (1 0) (STACKspace NIL) (STACKspace NIL)) (\GuardStackAddr 61440) (\LastStackAddr 65534) (\STACKHI 1 T T) (\HTMAIN (22 0) (HTMAINspace HTMAINbase) (HTMAINspace HTMAINbase)) (\HTMAINnpages 256 T) (\HTOVERFLOW (23 0) NIL (NIL HTOVERFLOWbase)) (\HTBIGCOUNT (23 32768)) (\HTCOLL (28 0) NIL (HTCOLLspace HTCOLLbase)) ( \DISPLAYREGION (18 0)) (\D1BCPLspace 0 T LEmubrHiVal) (\D0BCPLspace 0 T) (* ;; "Interface Page locations") (\CurrentFXP 0 T T) (\ResetFXP 1 T T) (\SubovFXP 2 T T) (\KbdFXP 3 T T) ( \HardReturnFXP 4 T T) (\GCFXP 5) (\FAULTFXP 6 T T) (\MiscFXP 14 T T) (\TeleRaidFXP 24 T T) (* ;; "emulator segment locations") (DCB.EM 272) (DISPINTERRUPT.EM 273) (CURSORBITMAP.EM 281) (KBDAD0.EM 65052) (KBDAD1.EM 65053) (KBDAD2.EM 65054) (KBDAD3.EM 65055) (UTILIN.EM 65048) (CURSORX.EM 278) ( CURSORY.EM 279) (MOUSEX.EM 276) (MOUSEY.EM 277) (\LispKeyMask 8192 T T) (\BcplKeyMask 4352 T T) (* ; "Machine types") (\MAIKO 3) (\DOLPHIN 4) (\DORADO 5) (\DANDELION 6) (\DAYBREAK 8) (* ;; "FOR DLION (AND DAYBREAK)") (\VP.DISPLAY 4608) (\NP.DISPLAY 202) (* ; "for Dorado display 1024x808 pixels / (16 pixels/word x 256 words/page)") (\NP.WIDEDOVEDISPLAY 243) (* ; "Wide Dove display 1152x864 pixels") (\WIDEDOVEDISPLAYWIDTH 1152) (\RP.AFTERDISPLAY 206) (* ; "Includes 4 pages for cursor") (\RP.AFTERDOVEDISPLAY 243) (* ; "if big screen") (\RP.DISPLAY 0) ( \RP.TEMPDISPLAY 2561) (\RP.MISCLOCKED 2804) (* ; "(+ \RP.TEMPDISPLAY \NP.WIDEDOVEDISPLAY)") (\RP.STACK 768) (\VP.STACK 256) (\RP.MAP 256) (\NP.MAP 256) (\RP.IOPAGE 512) (* ; "The DOVE IOCBPAGE can go anywhere, but should be under the 1mbyte range") (\RP.DOVEIOCBPAGE 543) ( \RP.DOVEIORGN 544) (\VP.DOVEIORGN 64) (\DOVEIORGNSIZE 64) (\VP.IOPAGE 255) (\VP.IFPAGE 5120) ( \VP.FPTOVP 512) (\NP.FPTOVP 4096) (\RP.FPTOVP 1024) (\RP.STARTBUFFERS 640) (\VP.TYPETABLE 6144) ( \NP.TYPETABLE 1024) (\RP.TYPETABLE 5120) (\VP.GCTABLE 5632) (\NP.GCTABLE 256) (\RP.GCTABLE 6144) ( \VP.GCOVERFLOW 5888) (\NP.GCOVERFLOW 1) (\RP.GCOVERFLOW 6400) (\FP.IFPAGE 2) (\VP.IOCBS 1) ( \VP.PRIMARYMAP 5122) (\VP.SECONDARYMAP 1280) (\VP.LPT 5232) (\VP.INITSCRATCH 8) (\VP.RPT 128) ( \VP.BUFFERS 218) (* ; "DLion processor commands") (\DL.PROCESSORBUSY 32768) (\DL.SETTOD 32769) ( \DL.READTOD 32770) (\DL.READPID 32771) (\DL.BOOTBUTTON 32772))) (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) ( DLMOUSETIMER FIXP) (DLMOUSETEMP FIXP))) (RPAQQ IFPAGELAYOUT ((CurrentFXP WORD) (* ; "First 7 items are FX values for user and 6 system contexts.") (ResetFXP WORD) (SubovFXP WORD) (KbdFXP WORD) (HardReturnFXP WORD) (GCFXP WORD) (FAULTFXP WORD) (EndOfStack WORD) (* ; "Stack high-water mark: address of guard block at current end of stack") (LVersion WORD) (* ; "Lisp version, followed by min versions of microcode and Bcpl compatible with this Lisp") (MinRVersion WORD) (MinBVersion WORD) (RVersion WORD) (* ; "Bcpl fills in the actual microcode, Bcpl versions.") ( BVersion WORD) (MachineType WORD) (MiscFXP WORD) (* ; "FX for MISC context") (Key WORD) (* ; "= IFPValidKey if vmem consistent.") (SerialNumber WORD) (* ; "Pup host number (Dorado/Dolphin)") ( EmulatorSpace WORD) (* ; "Hiloc of bcpl space (always zero now)") (ScreenWidth WORD) (NxtPMAddr WORD) (* ; "Next page to be allocated in secondary page map table") (NActivePages WORD) (* ; "Length of vmem in use") (NDirtyPages WORD) (* ; "not used, but maintained as = NActivePages") ( filePnPMP0 WORD) (* ; "Sysout page number of first page of secondary page map table (\PAGEMAP), which is where the secondary map pages themselves live" ) (filePnPMT0 WORD) (* ; "Sysout page number of first page of primary page map table") (TELERAIDFXP WORD) (* ; "FX for TeleRaid server context") (NATIVE-START-MEM-PAGE WORD) (* ; "Unix page where native code starts") (NATIVE-LENGTH-PAGE WORD) (* ; "Unix page length of native code" ) (NATIVE-PAGE-OFFSET WORD) (* ; "Lisp Disk Page offset of native code") (UserNameAddr WORD) (* ; "Addresses in bcpl space (seg 0) of global user name and password") (UserPswdAddr WORD) (StackBase WORD) (* ; "Stack address where user stack starts") (FAULTHI WORD) (* ; "Microcode for page fault stores fault address here, then does context switch to FAULTFXP") (FAULTLO WORD) (DEVCONFIG WORD) (* ; "IT'S FOR KB,DISP TYPE") (* ; "Formerly REALPAGETABLE, back when it was always in Bcpl space.") (RPTSIZE WORD) (* ; "Number of entries in Real Page Table") (RPOFFSET WORD) (* ; "RP-RPOFFSET => index in table") ( MAXETHERBYTES WORD) (* ; "Number of bytes available in a pbi, not counting encapsulation (Dorado)") ( EMBUFVP WORD) (* ; "VP of a one-page emulator buffer") (NSHost0 WORD) (* ; "Machine's 48-bit NS host number. Lisp manages to compute this on all machines except Dolphin, where Bcpl fills it in." ) (NSHost1 WORD) (NSHost2 WORD) (MDSZone WORD) (* ; "Obsolete -- was used by Dolphin 10MB network code.") (MDSZoneLength WORD) (EMUBUFFERS WORD) (* ; "Buffer space in segment 0 for swapping/disk activity") (EMUBUFLENGTH WORD) (* ; "Number of words of said space") (LASTNUMCHARS WORD) (* ; "No longer used?") (SYSDISK WORD) (* ; "Address of sysDisk in Bcpl space -- disk obj for boot partition.") (ISFMAP WORD) (* ;; "The following 4 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) (* ; "Number pages of real memory") ( LastLockedFilePage WORD) (* ; "Last page of vmem that is locked--booting has to load at least that far.") (LastDominoFilePage WORD) (* ; "Last sysout page reserved for Dandelion microcode") (FPTOVPStart WORD) (* ; "Sysout page where FPTOVP starts") (FAKEMOUSEBITS WORD) (* ; "Used to implement fake middle button on 2-button Dandelion.") (DL24BitAddressable WORD) (* ; "non-zero if DLion capable of addressing 32MB virtual memory") (REALPAGETABLEPTR FULLXPOINTER) (* ; "Address of real page table, set up by Bcpl (but not chained together)") (DLLastVmemPage WORD) (* ; "DLion booting microcode puts length of vmem file here.") (FullSpaceUsed WORD) (* ; "Non-zero if vmem beyond initial 8MB has been allocated.") (FAKEKBDAD4 WORD) (FAKEKBDAD5 WORD) (* ;; "The following 9 items (6 words and 3 pointers) are 3 3-element vectors for the Dorado extended virtual memory code--indexed by 0,1,2 according to which of up to 3 virtual memory backing files you're working with." ) (XVmemFmapBase WORD) (* ; "Bcpl stores isf map pointer to each partition here. First is redundant with ISFMAP field above.") ( NIL WORD) (NIL WORD) (XVmemFmapHighBase WORD) (* ; "Bcpl stores the highest vm page contained in this or earlier partition.") (NIL WORD) (NIL WORD) ( XVmemDiskBase FULLXPOINTER) (* ; "Lisp stores disk objects here (just a convenient non-faulting contiguous block of storage).") (NIL FULLXPOINTER) (NIL FULLXPOINTER))) (RPAQQ MAIKO.IFPAGELAYOUT ((CurrentFXP WORD) (* ; "First 7 items are FX values for user and 6 system contexts.") (ResetFXP WORD) (SubovFXP WORD) (KbdFXP WORD) (HardReturnFXP WORD) (GCFXP WORD) (FAULTFXP WORD) (EndOfStack WORD) (* ; "Stack high-water mark: address of guard block at current end of stack") (LVersion WORD) (* ; "Lisp version, followed by min versions of microcode and Bcpl compatible with this Lisp") (MinRVersion WORD) (MinBVersion WORD) (RVersion WORD) (* ; "Bcpl fills in the actual microcode, Bcpl versions.") ( BVersion WORD) (MachineType WORD) (MiscFXP WORD) (* ; "FX for MISC context") (Key WORD) (* ; "= IFPValidKey if vmem consistent.") (SerialNumber WORD) (* ; "Pup host number (Dorado/Dolphin)") ( EmulatorSpace WORD) (* ; "Hiloc of bcpl space (always zero now)") (ScreenWidth WORD) (NxtPMAddr WORD) (* ; "Next page to be allocated in secondary page map table") (NIL WORD) (* ; "WAS NActivePages, Length of vmem in use") (NIL WORD) (* ; "WAS NDirtyPages, not used, but maintained as = NActivePages") (filePnPMP0 WORD) (* ; "Sysout page number of first page of secondary page map table (\PAGEMAP), which is where the secondary map pages themselves live" ) (filePnPMT0 WORD) (* ; "Sysout page number of first page of primary page map table") (TELERAIDFXP WORD) (* ; "FX for TeleRaid server context") (NATIVE-START-MEM-PAGE WORD) (* ; "Unix page where native code starts") (NATIVE-LENGTH-PAGE WORD) (* ; "Unix page length of native code" ) (NATIVE-PAGE-OFFSET WORD) (* ; "Lisp Disk Page offset of native code") (UserNameAddr WORD) (* ; "Addresses in bcpl space (seg 0) of global user name and password") (UserPswdAddr WORD) (StackBase WORD) (* ; "Stack address where user stack starts") (FAULTHI WORD) (* ; "Microcode for page fault stores fault address here, then does context switch to FAULTFXP") (FAULTLO WORD) (DEVCONFIG WORD) (* ; "IT'S FOR KB,DISP TYPE") (* ; "Formerly REALPAGETABLE, back when it was always in Bcpl space.") (RPTSIZE WORD) (* ; "Number of entries in Real Page Table") (RPOFFSET WORD) (* ; "RP-RPOFFSET => index in table") ( MAXETHERBYTES WORD) (* ; "Number of bytes available in a pbi, not counting encapsulation (Dorado)") ( EMBUFVP WORD) (* ; "VP of a one-page emulator buffer") (NSHost0 WORD) (* ; "Machine's 48-bit NS host number. Lisp manages to compute this on all machines except Dolphin, where Bcpl fills it in." ) (NSHost1 WORD) (NSHost2 WORD) (MDSZone WORD) (* ; "Obsolete -- was used by Dolphin 10MB network code.") (MDSZoneLength WORD) (EMUBUFFERS WORD) (* ; "Buffer space in segment 0 for swapping/disk activity") (EMUBUFLENGTH WORD) (* ; "Number of words of said space") (* ;; "The following 2 are available if NEW_STOARGE is specified in C") (ProcessSize WORD) (* ; "Process size for which can be use as LISP space") (StorageFullState WORD) (* ; "Save last storage state") (ISFMAP WORD) (* ;; "The following 4 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) (* ; "Number pages of real memory") ( LastLockedFilePage WORD) (* ; "Last page of vmem that is locked--booting has to load at least that far.") (LastDominoFilePage WORD) (* ; "Last sysout page reserved for Dandelion microcode") (FPTOVPStart WORD) (* ; "Sysout page where FPTOVP starts") (FAKEMOUSEBITS WORD) (* ; "Used to implement fake middle button on 2-button Dandelion.") (DL24BitAddressable WORD) (* ; "non-zero if DLion capable of addressing 32MB virtual memory") (REALPAGETABLEPTR FULLXPOINTER) (* ; "Address of real page table, set up by Bcpl (but not chained together)") (SYSDISK WORD) (* ; "WAS DLLastVmemPage, DLion booting microcode puts length of vmem file here.") (FullSpaceUsed WORD) (* ; "Non-zero if vmem beyond initial 8MB has been allocated.") (FAKEKBDAD4 WORD) (FAKEKBDAD5 WORD) (* ;; "The following 9 items (6 words and 3 pointers) are 3 3-element vectors for the Dorado extended virtual memory code--indexed by 0,1,2 according to which of up to 3 virtual memory backing files you're working with." ) (XVmemFmapBase WORD) (* ; "Bcpl stores isf map pointer to each partition here. First is redundant with ISFMAP field above.") ( NIL WORD) (NIL WORD) (XVmemFmapHighBase WORD) (* ; "Bcpl stores the highest vm page contained in this or earlier partition.") (NIL WORD) (NIL WORD) ( XVmemDiskBase FULLXPOINTER) (* ; "Lisp stores disk objects here (just a convenient non-faulting contiguous block of storage).") (NIL FULLXPOINTER) (NIL FULLXPOINTER) (DLLastVmemPage FIXP) (* ; "DLion booting microcode puts length of vmem file here.") (NActivePages FIXP) (* ; "Length of vmem in use") (NDirtyPages FIXP) (* ; "not used, but maintained as = NActivePages"))) (RPAQQ IOPAGELAYOUT ((NIL 18 WORD) (DLMAINTPANEL WORD NIL T) (DLFLOPPYCMD WORD) (DLTTYPORTCMD WORD) ( DLPROCESSORCMD WORD) (NEWMOUSESTATE WORD) (DLBEEPCMD WORD) (DLRS232CMISCCOMMAND WORD) (DLRS232CPUTFLAG WORD) (DLRS232CGETFLAG WORD) (NIL 6 WORD) (DLFLOPPY WORD) (DLTTYOUT WORD) (NIL 1 WORD) (DLTTYIN WORD) (NIL 1 WORD) (DLPROCESSOR2 WORD) (DLPROCESSOR1 WORD) (DLPROCESSOR0 WORD) (NEWMOUSEX WORD) (NEWMOUSEY WORD) (DLBEEPFREQ WORD) (DLRS232CPARAMETERCSBLO WORD) (DLRS232CPARAMETERCSBHI WORD) ( DLRS232CSETRS366STATUS 3 WORD) (DLRS232CPUTCSBLO WORD) (DLRS232CPUTCSBHI WORD) (DLRS232CGETCSBLO WORD) (DLRS232CGETCSBHI WORD) (DLRS232CDEVICESTATUS WORD) (DLRS232CPARAMETEROUTCOME WORD) (DLTODVALID WORD) (DLTODLO WORD NIL T) (DLTODHI WORD) (DLTODLO2 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) (DLLSEPIMAGECSB 32 WORD) (DLIOPHARDWARECONFIG WORD) (NIL 11 WORD) (DLRS232CPARAMETERCSBLO.11 WORD) (DLRS232CPARAMETERCSBHI.11 WORD) ( DLRS232CSETRS366STATUS.11 14 WORD) (NIL 60 WORD) (DLMAGTAPE 4 WORD) (DLETHERNET 12 WORD NIL T) (NIL 31 WORD) (DLDISPINTERRUPT WORD NIL T) (DLDISPCONTROL WORD) (DLDISPBORDER WORD) (DLCURSORX WORD NIL T) ( DLCURSORY WORD NIL T) (DLCURSORBITMAP 16 WORD NIL T))) (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 \CHARACTERP 9) (RPAQQ \VMEMPAGEP 10) (RPAQQ \STREAM 11) (RPAQQ \TT.TYPEMASK 2047) (RPAQQ \TT.NOREF 32768) (RPAQQ \TT.SYMBOLP 16384) (RPAQQ \TT.FIXP 8192) (RPAQQ \TT.NUMBERP 4096) (RPAQQ \TT.ATOM 2048) (RPAQQ \PMblockSize 32) (RPAQQ \STATSsize 8) (RPAQQ \NumPMTpages 8) (RPAQQ \EmptyPMTEntry 65535) (RPAQQ \FirstVmemBlock 2) (RPAQQ \MAXVMPAGE 131069) (RPAQQ \MAXVMSEGMENT 255) (RPAQQ \IFPValidKey 5603) (RPAQQ \FirstMDSPage 16382) (RPAQQ \MaxMDSPage 524285) (RPAQQ \DefaultSecondMDSPage 65532) (RPAQQ \MDSIncrement 512) (RPAQQ \PagesPerMDSUnit 2) (RPAQQ \FirstArraySegment 46) (RPAQQ \FirstArrayPage 11776) (RPAQQ \DefaultSecondArrayPage 16384) (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 65536) (RPAQQ \HTCOLLSIZE 1048576) (RPAQQ \HTENDFREE 1) (RPAQQ \HTFREEPTR 0) (RPAQQ \AtomHI 0) (RPAQQ \CHARHI 7) (RPAQQ \AtomHTpages 256) (RPAQQ \LastAtomPage 255) (RPAQQ \MaxAtomFrLst 65535) (RPAQQ \SmallPosHi 14) (RPAQQ \SmallNegHi 15) (RPAQQ \NumSmallPages 512) (RPAQQ \PNAME.HI 8) (RPAQQ \ATOM.HI 44) (RPAQQ \DEF.HI 10) (RPAQQ \VAL.HI 12) (RPAQQ \PLIST.HI 2) (RPAQQ \NumPageMapPages 256) (RPAQQ \MDSTTsize 1024) (RPAQQ \UFNTableSize 2) (RPAQQ \DTDSize 18) (RPAQQ \EndTypeNumber 2047) (RPAQQ \NumLPTPages 16) (RPAQQ \GuardStackAddr 61440) (RPAQQ \LastStackAddr 65534) (RPAQQ \STACKHI 1) (RPAQQ \HTMAINnpages 256) (RPAQQ \D1BCPLspace 0) (RPAQQ \D0BCPLspace 0) (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 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 \MAIKO 3) (RPAQQ \DOLPHIN 4) (RPAQQ \DORADO 5) (RPAQQ \DANDELION 6) (RPAQQ \DAYBREAK 8) (RPAQQ \VP.DISPLAY 4608) (RPAQQ \NP.DISPLAY 202) (RPAQQ \NP.WIDEDOVEDISPLAY 243) (RPAQQ \WIDEDOVEDISPLAYWIDTH 1152) (RPAQQ \RP.AFTERDISPLAY 206) (RPAQQ \RP.AFTERDOVEDISPLAY 243) (RPAQQ \RP.DISPLAY 0) (RPAQQ \RP.TEMPDISPLAY 2561) (RPAQQ \RP.MISCLOCKED 2804) (RPAQQ \RP.STACK 768) (RPAQQ \VP.STACK 256) (RPAQQ \RP.MAP 256) (RPAQQ \NP.MAP 256) (RPAQQ \RP.IOPAGE 512) (RPAQQ \RP.DOVEIOCBPAGE 543) (RPAQQ \RP.DOVEIORGN 544) (RPAQQ \VP.DOVEIORGN 64) (RPAQQ \DOVEIORGNSIZE 64) (RPAQQ \VP.IOPAGE 255) (RPAQQ \VP.IFPAGE 5120) (RPAQQ \VP.FPTOVP 512) (RPAQQ \NP.FPTOVP 4096) (RPAQQ \RP.FPTOVP 1024) (RPAQQ \RP.STARTBUFFERS 640) (RPAQQ \VP.TYPETABLE 6144) (RPAQQ \NP.TYPETABLE 1024) (RPAQQ \RP.TYPETABLE 5120) (RPAQQ \VP.GCTABLE 5632) (RPAQQ \NP.GCTABLE 256) (RPAQQ \RP.GCTABLE 6144) (RPAQQ \VP.GCOVERFLOW 5888) (RPAQQ \NP.GCOVERFLOW 1) (RPAQQ \RP.GCOVERFLOW 6400) (RPAQQ \FP.IFPAGE 2) (RPAQQ \VP.IOCBS 1) (RPAQQ \VP.PRIMARYMAP 5122) (RPAQQ \VP.SECONDARYMAP 1280) (RPAQQ \VP.LPT 5232) (RPAQQ \VP.INITSCRATCH 8) (RPAQQ \VP.RPT 128) (RPAQQ \VP.BUFFERS 218) (RPAQQ \DL.PROCESSORBUSY 32768) (RPAQQ \DL.SETTOD 32769) (RPAQQ \DL.READTOD 32770) (RPAQQ \DL.READPID 32771) (RPAQQ \DL.BOOTBUTTON 32772) (CONSTANTS (CDRCODING 1) (\SMALLP 1) (\FIXP 2) (\FLOATP 3) (\LITATOM 4) (\LISTP 5) (\ARRAYP 6) ( \STRINGP 7) (\STACKP 8) (\CHARACTERP 9) (\VMEMPAGEP 10) (\STREAM 11) (\TT.TYPEMASK 2047) (\TT.NOREF 32768) (\TT.SYMBOLP 16384) (\TT.FIXP 8192) (\TT.NUMBERP 4096) (\TT.ATOM 2048) (\PMblockSize 32) ( \STATSsize 8) (\NumPMTpages 8) (\EmptyPMTEntry 65535) (\FirstVmemBlock 2) (\MAXVMPAGE 131069) ( \MAXVMSEGMENT 255) (\IFPValidKey 5603) (\FirstMDSPage 16382) (\MaxMDSPage 524285) ( \DefaultSecondMDSPage 65532) (\MDSIncrement 512) (\PagesPerMDSUnit 2) (\FirstArraySegment 46) ( \FirstArrayPage 11776) (\DefaultSecondArrayPage 16384) (\StackMask 57344) (\FxtnBlock 49152) ( \GuardBlock 57344) (\BFBlock 32768) (\FreeStackBlock 40960) (\NotStackBlock 0) (\MinExtraStackWords 32 ) (ERASECHARCODE 0) (\HT1CNT 1024) (\HTSTKBIT 512) (\HTCNTMASK 64512) (\HTMAINSIZE 65536) (\HTCOLLSIZE 1048576) (\HTENDFREE 1) (\HTFREEPTR 0) (\AtomHI 0) (\CHARHI 7) (\AtomHTpages 256) (\LastAtomPage 255) (\MaxAtomFrLst 65535) (\SmallPosHi 14) (\SmallNegHi 15) (\NumSmallPages 512) (\PNAME.HI 8) (\ATOM.HI 44) (\DEF.HI 10) (\VAL.HI 12) (\PLIST.HI 2) (\NumPageMapPages 256) (\MDSTTsize 1024) (\UFNTableSize 2) (\DTDSize 18) (\EndTypeNumber 2047) (\NumLPTPages 16) (\GuardStackAddr 61440) (\LastStackAddr 65534) (\STACKHI 1) (\HTMAINnpages 256) (\D1BCPLspace 0) (\D0BCPLspace 0) (\CurrentFXP 0) (\ResetFXP 1) ( \SubovFXP 2) (\KbdFXP 3) (\HardReturnFXP 4) (\GCFXP 5) (\FAULTFXP 6) (\MiscFXP 14) (\TeleRaidFXP 24) ( 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) (\MAIKO 3) (\DOLPHIN 4) (\DORADO 5) ( \DANDELION 6) (\DAYBREAK 8) (\VP.DISPLAY 4608) (\NP.DISPLAY 202) (\NP.WIDEDOVEDISPLAY 243) ( \WIDEDOVEDISPLAYWIDTH 1152) (\RP.AFTERDISPLAY 206) (\RP.AFTERDOVEDISPLAY 243) (\RP.DISPLAY 0) ( \RP.TEMPDISPLAY 2561) (\RP.MISCLOCKED 2804) (\RP.STACK 768) (\VP.STACK 256) (\RP.MAP 256) (\NP.MAP 256 ) (\RP.IOPAGE 512) (\RP.DOVEIOCBPAGE 543) (\RP.DOVEIORGN 544) (\VP.DOVEIORGN 64) (\DOVEIORGNSIZE 64) ( \VP.IOPAGE 255) (\VP.IFPAGE 5120) (\VP.FPTOVP 512) (\NP.FPTOVP 4096) (\RP.FPTOVP 1024) ( \RP.STARTBUFFERS 640) (\VP.TYPETABLE 6144) (\NP.TYPETABLE 1024) (\RP.TYPETABLE 5120) (\VP.GCTABLE 5632 ) (\NP.GCTABLE 256) (\RP.GCTABLE 6144) (\VP.GCOVERFLOW 5888) (\NP.GCOVERFLOW 1) (\RP.GCOVERFLOW 6400) (\FP.IFPAGE 2) (\VP.IOCBS 1) (\VP.PRIMARYMAP 5122) (\VP.SECONDARYMAP 1280) (\VP.LPT 5232) ( \VP.INITSCRATCH 8) (\VP.RPT 128) (\VP.BUFFERS 218) (\DL.PROCESSORBUSY 32768) (\DL.SETTOD 32769) ( \DL.READTOD 32770) (\DL.READPID 32771) (\DL.BOOTBUTTON 32772)) (RPAQQ \MPERRORS ((\MP.OBSOLETEVMEM 1) (\MP.INVALIDVMEM 2 "Vmem inconsistent at startup") ( \MP.IOCBPAGE 3 "No place for IOCB page at startup") (\MP.MOB 4 "Map out of bounds") (\MP.INVALIDADDR 5 ) (\MP.INVALIDVP 6) (\MP.CHAIN.UNAVAIL 7 "Unavailable page on real page table chain") (\MP.SELECTLOOP 8 "Loop in \SELECTREALPAGE") (\MP.NEWPAGE 9 "Attempt to allocate already existing page") ( \MP.NEWMAPPAGE 10 "\DONEWPAGE failed to allocate new map page") (\MP.BADLOCKED 11 "Locked page occupies a file page needed to lock another") (\MP.CLOCK0 12 "Arg to CLOCK0 not an integer box") (\MP.RESIDENT 13 "Fault on resident page") (\MP.STACKFAULT 14 "Fault on stack") (\MP.VMEMTOOLONG 16 "Attempt to extend Vmem File beyond fixed limit (8mb)") ( \MP.WRITING.LOCKED.PAGE 17 "Writing a locked page with UPDATEKEY = T") (\MP.UNINTERRUPTABLE 18 "Error in uninterruptable system code") (\MP.STACKFULL 19) (\MP.MDSFULL 20) (\MP.UNKNOWN.UFN 21) ( \MP.ATOMSFULL 22) (\MP.PNAMESFULL 23) (\MP.USECOUNTOVERFLOW 24) (\MP.MDSFULLWARNING 25) ( \MP.BADMDSFREELIST 26) (\MP.BADARRAYBLOCK 27) (\MP.BADDELETEBLOCK 28) (\MP.BADARRAYRECLAIM 29) ( \MP.BIGREFCNTMISSING 30 "PTR refcnt previously overflowed, but not found in table.") ( \MP.BIGREFCNTALREADYPRESENT 31 "PTR already in overflow table") (\MP.DELREF0 32) (\MP.PROCERROR 33) ( \MP.PROCNOFRAME 34 "Failed to build frame for PROCESS use") (\MP.32MBINUSE 35) (\MP.TOPUNWOUND 36 "Unexpected (RETTO T)") (\MP.STACKRELEASED 37) (\MP.FLUSHLOCKED 38) (\MP.MAPNOTLOCKED 39) ( \MP.UNLOCKINGMAP 40) (\MP.SWAPDISKERROR 41 "Hard Disk Error in swapper") (\MP.BADRUNTABLE 42 "Malformed run table for vmem file"))) (RPAQQ \MP.OBSOLETEVMEM 1) (RPAQ \MP.INVALIDVMEM 2 "Vmem inconsistent at startup") (RPAQ \MP.IOCBPAGE 3 "No place for IOCB page at startup") (RPAQ \MP.MOB 4 "Map out of bounds") (RPAQQ \MP.INVALIDADDR 5) (RPAQQ \MP.INVALIDVP 6) (RPAQ \MP.CHAIN.UNAVAIL 7 "Unavailable page on real page table chain") (RPAQ \MP.SELECTLOOP 8 "Loop in \SELECTREALPAGE") (RPAQ \MP.NEWPAGE 9 "Attempt to allocate already existing page") (RPAQ \MP.NEWMAPPAGE 10 "\DONEWPAGE failed to allocate new map page") (RPAQ \MP.BADLOCKED 11 "Locked page occupies a file page needed to lock another") (RPAQ \MP.CLOCK0 12 "Arg to CLOCK0 not an integer box") (RPAQ \MP.RESIDENT 13 "Fault on resident page") (RPAQ \MP.STACKFAULT 14 "Fault on stack") (RPAQ \MP.VMEMTOOLONG 16 "Attempt to extend Vmem File beyond fixed limit (8mb)") (RPAQ \MP.WRITING.LOCKED.PAGE 17 "Writing a locked page with UPDATEKEY = T") (RPAQ \MP.UNINTERRUPTABLE 18 "Error in uninterruptable system code") (RPAQQ \MP.STACKFULL 19) (RPAQQ \MP.MDSFULL 20) (RPAQQ \MP.UNKNOWN.UFN 21) (RPAQQ \MP.ATOMSFULL 22) (RPAQQ \MP.PNAMESFULL 23) (RPAQQ \MP.USECOUNTOVERFLOW 24) (RPAQQ \MP.MDSFULLWARNING 25) (RPAQQ \MP.BADMDSFREELIST 26) (RPAQQ \MP.BADARRAYBLOCK 27) (RPAQQ \MP.BADDELETEBLOCK 28) (RPAQQ \MP.BADARRAYRECLAIM 29) (RPAQ \MP.BIGREFCNTMISSING 30 "PTR refcnt previously overflowed, but not found in table.") (RPAQ \MP.BIGREFCNTALREADYPRESENT 31 "PTR already in overflow table") (RPAQQ \MP.DELREF0 32) (RPAQQ \MP.PROCERROR 33) (RPAQ \MP.PROCNOFRAME 34 "Failed to build frame for PROCESS use") (RPAQQ \MP.32MBINUSE 35) (RPAQ \MP.TOPUNWOUND 36 "Unexpected (RETTO T)") (RPAQQ \MP.STACKRELEASED 37) (RPAQQ \MP.FLUSHLOCKED 38) (RPAQQ \MP.MAPNOTLOCKED 39) (RPAQQ \MP.UNLOCKINGMAP 40) (RPAQ \MP.SWAPDISKERROR 41 "Hard Disk Error in swapper") (RPAQ \MP.BADRUNTABLE 42 "Malformed run table for vmem file") (CONSTANTS (\MP.OBSOLETEVMEM 1) (\MP.INVALIDVMEM 2 "Vmem inconsistent at startup") (\MP.IOCBPAGE 3 "No place for IOCB page at startup") (\MP.MOB 4 "Map out of bounds") (\MP.INVALIDADDR 5) ( \MP.INVALIDVP 6) (\MP.CHAIN.UNAVAIL 7 "Unavailable page on real page table chain") (\MP.SELECTLOOP 8 "Loop in \SELECTREALPAGE") (\MP.NEWPAGE 9 "Attempt to allocate already existing page") (\MP.NEWMAPPAGE 10 "\DONEWPAGE failed to allocate new map page") (\MP.BADLOCKED 11 "Locked page occupies a file page needed to lock another") (\MP.CLOCK0 12 "Arg to CLOCK0 not an integer box") (\MP.RESIDENT 13 "Fault on resident page") (\MP.STACKFAULT 14 "Fault on stack") (\MP.VMEMTOOLONG 16 "Attempt to extend Vmem File beyond fixed limit (8mb)") ( \MP.WRITING.LOCKED.PAGE 17 "Writing a locked page with UPDATEKEY = T") (\MP.UNINTERRUPTABLE 18 "Error in uninterruptable system code") (\MP.STACKFULL 19) (\MP.MDSFULL 20) (\MP.UNKNOWN.UFN 21) ( \MP.ATOMSFULL 22) (\MP.PNAMESFULL 23) (\MP.USECOUNTOVERFLOW 24) (\MP.MDSFULLWARNING 25) ( \MP.BADMDSFREELIST 26) (\MP.BADARRAYBLOCK 27) (\MP.BADDELETEBLOCK 28) (\MP.BADARRAYRECLAIM 29) ( \MP.BIGREFCNTMISSING 30 "PTR refcnt previously overflowed, but not found in table.") ( \MP.BIGREFCNTALREADYPRESENT 31 "PTR already in overflow table") (\MP.DELREF0 32) (\MP.PROCERROR 33) ( \MP.PROCNOFRAME 34 "Failed to build frame for PROCESS use") (\MP.32MBINUSE 35) (\MP.TOPUNWOUND 36 "Unexpected (RETTO T)") (\MP.STACKRELEASED 37) (\MP.FLUSHLOCKED 38) (\MP.MAPNOTLOCKED 39) ( \MP.UNLOCKINGMAP 40) (\MP.SWAPDISKERROR 41 "Hard Disk Error in swapper") (\MP.BADRUNTABLE 42 "Malformed run table for vmem file")) (GLOBALVARS \ARRAYSPACE \ARRAYSPACE2 \ATOMSPACE \AtomHashTable \SMALLPOSPSPACE \SMALLNEGSPACE \PNPSPACE \OLDATOMSPACE \DEFSPACE \VALSPACE \PLISTSPACE \PAGEMAP \PageMapTBL \InterfacePage \IOPAGE \DoveIORegion \IOCBPAGE \FPTOVP \MDSTypeTable \MISCSTATS \UFNTable \DTDSpaceBase \LISTPDTD \LOCKEDPAGETABLE \STACKSPACE \HTMAIN \HTOVERFLOW \HTBIGCOUNT \HTCOLL \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) (DLMOUSETIMER FIXP) (DLMOUSETEMP FIXP)) (CREATE (\ALLOCBLOCK 31))) (BLOCKRECORD IFPAGE ((CurrentFXP WORD) (* ; "First 7 items are FX values for user and 6 system contexts.") (ResetFXP WORD) (SubovFXP WORD) (KbdFXP WORD) (HardReturnFXP WORD) (GCFXP WORD) (FAULTFXP WORD) (EndOfStack WORD) (* ; "Stack high-water mark: address of guard block at current end of stack") (LVersion WORD) (* ; "Lisp version, followed by min versions of microcode and Bcpl compatible with this Lisp") (MinRVersion WORD) (MinBVersion WORD) (RVersion WORD) (* ; "Bcpl fills in the actual microcode, Bcpl versions.") ( BVersion WORD) (MachineType WORD) (MiscFXP WORD) (* ; "FX for MISC context") (Key WORD) (* ; "= IFPValidKey if vmem consistent.") (SerialNumber WORD) (* ; "Pup host number (Dorado/Dolphin)") ( EmulatorSpace WORD) (* ; "Hiloc of bcpl space (always zero now)") (ScreenWidth WORD) (NxtPMAddr WORD) (* ; "Next page to be allocated in secondary page map table") (NIL WORD) (* ; "WAS NActivePages, Length of vmem in use") (NIL WORD) (* ; "WAS NDirtyPages, not used, but maintained as = NActivePages") (filePnPMP0 WORD) (* ; "Sysout page number of first page of secondary page map table (\PAGEMAP), which is where the secondary map pages themselves live" ) (filePnPMT0 WORD) (* ; "Sysout page number of first page of primary page map table") (TELERAIDFXP WORD) (* ; "FX for TeleRaid server context") (NATIVE-START-MEM-PAGE WORD) (* ; "Unix page where native code starts") (NATIVE-LENGTH-PAGE WORD) (* ; "Unix page length of native code" ) (NATIVE-PAGE-OFFSET WORD) (* ; "Lisp Disk Page offset of native code") (UserNameAddr WORD) (* ; "Addresses in bcpl space (seg 0) of global user name and password") (UserPswdAddr WORD) (StackBase WORD) (* ; "Stack address where user stack starts") (FAULTHI WORD) (* ; "Microcode for page fault stores fault address here, then does context switch to FAULTFXP") (FAULTLO WORD) (DEVCONFIG WORD) (* ; "IT'S FOR KB,DISP TYPE") (* ; "Formerly REALPAGETABLE, back when it was always in Bcpl space.") (RPTSIZE WORD) (* ; "Number of entries in Real Page Table") (RPOFFSET WORD) (* ; "RP-RPOFFSET => index in table") ( MAXETHERBYTES WORD) (* ; "Number of bytes available in a pbi, not counting encapsulation (Dorado)") ( EMBUFVP WORD) (* ; "VP of a one-page emulator buffer") (NSHost0 WORD) (* ; "Machine's 48-bit NS host number. Lisp manages to compute this on all machines except Dolphin, where Bcpl fills it in." ) (NSHost1 WORD) (NSHost2 WORD) (MDSZone WORD) (* ; "Obsolete -- was used by Dolphin 10MB network code.") (MDSZoneLength WORD) (EMUBUFFERS WORD) (* ; "Buffer space in segment 0 for swapping/disk activity") (EMUBUFLENGTH WORD) (* ; "Number of words of said space") (* ;; "The following 2 are available if NEW_STOARGE is specified in C") (ProcessSize WORD) (* ; "Process size for which can be use as LISP space") (StorageFullState WORD) (* ; "Save last storage state") (ISFMAP WORD) (* ;; "The following 4 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) (* ; "Number pages of real memory") ( LastLockedFilePage WORD) (* ; "Last page of vmem that is locked--booting has to load at least that far.") (LastDominoFilePage WORD) (* ; "Last sysout page reserved for Dandelion microcode") (FPTOVPStart WORD) (* ; "Sysout page where FPTOVP starts") (FAKEMOUSEBITS WORD) (* ; "Used to implement fake middle button on 2-button Dandelion.") (DL24BitAddressable WORD) (* ; "non-zero if DLion capable of addressing 32MB virtual memory") (REALPAGETABLEPTR FULLXPOINTER) (* ; "Address of real page table, set up by Bcpl (but not chained together)") (SYSDISK WORD) (* ; "WAS DLLastVmemPage, DLion booting microcode puts length of vmem file here.") (FullSpaceUsed WORD) (* ; "Non-zero if vmem beyond initial 8MB has been allocated.") (FAKEKBDAD4 WORD) (FAKEKBDAD5 WORD) (* ;; "The following 9 items (6 words and 3 pointers) are 3 3-element vectors for the Dorado extended virtual memory code--indexed by 0,1,2 according to which of up to 3 virtual memory backing files you're working with." ) (XVmemFmapBase WORD) (* ; "Bcpl stores isf map pointer to each partition here. First is redundant with ISFMAP field above.") ( NIL WORD) (NIL WORD) (XVmemFmapHighBase WORD) (* ; "Bcpl stores the highest vm page contained in this or earlier partition.") (NIL WORD) (NIL WORD) ( XVmemDiskBase FULLXPOINTER) (* ; "Lisp stores disk objects here (just a convenient non-faulting contiguous block of storage).") (NIL FULLXPOINTER) (NIL FULLXPOINTER) (DLLastVmemPage FIXP) (* ; "DLion booting microcode puts length of vmem file here.") (NActivePages FIXP) (* ; "Length of vmem in use") (NDirtyPages FIXP) (* ; "not used, but maintained as = NActivePages")) ( CREATE (\ALLOCBLOCK 43))) (BLOCKRECORD IOPAGE ((NIL 18 WORD) (DLMAINTPANEL WORD) (DLFLOPPYCMD WORD) (DLTTYPORTCMD WORD) ( DLPROCESSORCMD WORD) (NEWMOUSESTATE WORD) (DLBEEPCMD WORD) (DLRS232CMISCCOMMAND WORD) (DLRS232CPUTFLAG WORD) (DLRS232CGETFLAG WORD) (NIL 6 WORD) (DLFLOPPY WORD) (DLTTYOUT WORD) (NIL 1 WORD) (DLTTYIN WORD) (NIL 1 WORD) (DLPROCESSOR2 WORD) (DLPROCESSOR1 WORD) (DLPROCESSOR0 WORD) (NEWMOUSEX WORD) (NEWMOUSEY WORD) (DLBEEPFREQ WORD) (DLRS232CPARAMETERCSBLO WORD) (DLRS232CPARAMETERCSBHI WORD) ( DLRS232CSETRS366STATUS 3 WORD) (DLRS232CPUTCSBLO WORD) (DLRS232CPUTCSBHI WORD) (DLRS232CGETCSBLO WORD) (DLRS232CGETCSBHI WORD) (DLRS232CDEVICESTATUS WORD) (DLRS232CPARAMETEROUTCOME WORD) (DLTODVALID WORD) (DLTODLO WORD) (DLTODHI WORD) (DLTODLO2 WORD) (DLMOUSEX WORD) (DLMOUSEY WORD) (DLUTILIN WORD) ( DLKBDAD0 WORD) (DLKBDAD1 WORD) (DLKBDAD2 WORD) (DLKBDAD3 WORD) (DLKBDAD4 WORD) (DLKBDAD5 WORD) ( DLLSEPIMAGECSB 32 WORD) (DLIOPHARDWARECONFIG WORD) (NIL 11 WORD) (DLRS232CPARAMETERCSBLO.11 WORD) ( DLRS232CPARAMETERCSBHI.11 WORD) (DLRS232CSETRS366STATUS.11 14 WORD) (NIL 60 WORD) (DLMAGTAPE 4 WORD) ( DLETHERNET 12 WORD) (NIL 31 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)) (DLETHERNETPTR (\ADDBASE DATUM 192)) (DLKBDAD5PTR (\ADDBASE DATUM 67)) (DLKBDAD4PTR (\ADDBASE DATUM 66)) (DLKBDAD3PTR (\ADDBASE DATUM 65)) (DLKBDAD2PTR (\ADDBASE DATUM 64)) (DLKBDAD1PTR (\ADDBASE DATUM 63)) (DLKBDAD0PTR (\ADDBASE DATUM 62)) (DLUTILINPTR (\ADDBASE DATUM 61)) (DLMOUSEYPTR (\ADDBASE DATUM 60)) (DLMOUSEXPTR (\ADDBASE DATUM 59)) (DLTODLOPTR (\ADDBASE DATUM 56)) (DLMAINTPANELPTR (\ADDBASE DATUM 18)))) (CREATE (\ALLOCBLOCK 128))) (PUTPROPS EMADDRESS MACRO (ARGS ((LAMBDA (ADDR) (COND ((EQ \D1BCPLspace \D0BCPLspace) (LIST ( BIG-VMEM-CODE (LIST (QUOTE OPCODES) (QUOTE GCONST) 0 0 (LRSH ADDR 8) (LOGAND ADDR 255)) (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 "31-Jan-98 09:16:51")) (DATATYPE COMPILED-CLOSURE (FNHEADER ENVIRONMENT)) (RPAQQ \COMPILED-CLOSURE 13) (CONSTANTS \COMPILED-CLOSURE) (PUTPROPS \EXTENDED.EQP MACRO (OPENLAMBDA (X Y) (COND ((EQ (NTYPX X) (NTYPX Y)) (SELECTC (NTYPX X) ( \STACKP (EQ (fetch (STACKP EDFXP) of X) (fetch (STACKP EDFXP) of Y))) (\COMPILED-CLOSURE (EQDEFP X Y)) NIL))))) (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 (OPENLAMBDA (DEF LC) (LOGOR (LLSH (CODELT DEF LC) BITSPERBYTE) (CODELT DEF ( ADD1 LC))))) (PUTPROPS CODESETA2 MACRO (OPENLAMBDA (DEF LC VALUE) (CODESETA DEF LC (LRSH VALUE BITSPERBYTE)) ( CODESETA DEF (ADD1 LC) (IMOD VALUE (CONSTANT (LLSH 1 BITSPERBYTE)))))) (PUTPROPS CODESETA MACRO ((CA N NV) (\BYTESETA CA N NV))) (PUTPROPS BYTESPERNAMEENTRY MACRO (NIL (UNFOLD (CONSTANT (WORDSPERNAMEENTRY)) BYTESPERWORD))) (PUTPROPS BYTESPERNTOFFSETENTRY MACRO (NIL (UNFOLD (WORDSPERNAMEENTRY) BYTESPERWORD))) (PUTPROPS GETNAMEENTRY MACRO (OPENLAMBDA (DEF LC) (LET ((NUMBER 0)) (* ;; "Must ALWAYS be called with DEF really being either a FNHEADER or a nametable pseudo-fnheader. Never use addbase to offset from it. This is because CODEBASEELT checks the BYTESWAPPED flag in the fnheader...." ) (FOR I FROM 0 TO (CONSTANT (SUB1 (BYTESPERNAMEENTRY))) DO (SETQ NUMBER (LOGOR (LLSH NUMBER BITSPERBYTE) (CODEBASELT DEF (IPLUS LC I))))) NUMBER))) (PUTPROPS GETNTFLAGS MACRO (OPENLAMBDA (DEF LC) (CODEBASELT DEF LC))) (PUTPROPS GETNTOFFSET MACRO (OPENLAMBDA (DEF LC) (NTSLOT-OFFSET (GETNTOFFSETENTRY DEF LC)))) (PUTPROPS GETNTOFFSETENTRY MACRO (OPENLAMBDA (DEF LC) (LET ((NUMBER 0)) (for I from 0 to (CONSTANT ( SUB1 (BYTESPERNTOFFSETENTRY))) do (SETQ NUMBER (LOGOR (LLSH NUMBER BITSPERBYTE) (CODEBASELT DEF (IPLUS LC I))))) NUMBER))) (PUTPROPS GETNTTAG MACRO (OPENLAMBDA (DEF LC) (CODEBASELT DEF (ADD1 LC)))) (PUTPROPS SETNAMEENTRY MACRO (OPENLAMBDA (DEF LC VALUE) (FOR I FROM (CONSTANT (SUB1 (BYTESPERNAMEENTRY ))) TO 0 BY -1 DO (CODEBASESETA DEF (IPLUS LC I) (LOGAND VALUE (CONSTANT (SUB1 (LLSH 1 BITSPERBYTE)))) ) (SETQ VALUE (LRSH VALUE BITSPERBYTE))))) (PUTPROPS WORDSPERNTOFFSETENTRY MACRO (NIL (WORDSPERNAMEENTRY))) (PUTPROPS NTSLOT-OFFSET MACRO ((X) (LOGAND 255 X))) (DEFMACRO NEW-SYMBOL-CODE (NEW-SYMBOL-FORM OLD-SYMBOL-FORM) (* ;; "Use one form or another, depending on whether we're compiling for new 3-byte atoms or old 2-byte atom numbers." ) (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) (* ; "NEW ATOMS") (BQUOTE (\, NEW-SYMBOL-FORM ))) (T (BQUOTE (\, OLD-SYMBOL-FORM))))) (DEFOPTIMIZER BIG-VMEM-CODE (NEW-SYMBOL-FORM OLD-SYMBOL-FORM &ENVIRONMENT ENV) (* ;; "Allow for differences between 4-byte pointers and 3-byte pointers..") (COND ((FMEMB :4-BYTE ( COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\, NEW-SYMBOL-FORM))) (T (BQUOTE (\, OLD-SYMBOL-FORM) )))) (DEFOPTIMIZER SETSTKNAMEENTRY (CODEARRAY OFFSET VAL &ENVIRONMENT ENV) (* ;; "Set the name entry for a name-table entry.") (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (LET ((BASE (fetch (ARRAYP BASE) of (\, CODEARRAY))) (VALUE (\, VAL))) (COND ((FIXP VALUE) (* ; "A 20-byte atom #. Make it an atom.") (\PUTBASEPTR BASE (\, OFFSET) (\VAG2 \AtomHI VALUE) )) (T (* ; "A 3-byte atom. Just use it.") (\PUTBASEPTR BASE (\, OFFSET) VALUE)))))) (T (BQUOTE (LET ( (BASE (fetch (ARRAYP BASE) of (\, CODEARRAY)))) (\PUTBASE BASE (\, OFFSET) (\, VAL))))))) (DEFOPTIMIZER SETSTKNTOFFSETENTRY (BASE OFFSET VAL &ENVIRONMENT ENV) (* ;; "Set the offset entry for a name-table entry.") (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\PUTBASEFIXP (\, BASE) (\, OFFSET) (\, VAL)))) (T (BQUOTE (\PUTBASE (\, BASE) (\, OFFSET) (\, VAL)))))) (DEFOPTIMIZER GETSTKNAMEENTRY (BASE OFFSET &ENVIRONMENT ENV) (* ;; "Get a name entry out of a name table. BASE is the start of the name table; OFFSET is in words, not bytes or name entries." ) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\GETBASEPTR (\, BASE) (\, OFFSET)))) (T (BQUOTE (\GETBASE (\, BASE) (\, OFFSET)))))) (DEFOPTIMIZER GETSTKNTOFFSETENTRY (BASE OFFSET &ENVIRONMENT ENV) (COND ((FMEMB :3-BYTE ( COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\GETBASEFIXP (\, BASE) (\, OFFSET)))) (T (BQUOTE ( \GETBASE (\, BASE) (\, OFFSET)))))) (DEFOPTIMIZER WORDSPERNAMEENTRY (&ENVIRONMENT ENV) (* ;; "Number of words in a name-table %"Name%" entry--the space for the symbol. 1 for old symbol systems, 2 for 3-byte-atom systesm." ) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (PROGN 2))) ((AND CROSSCOMPILING (FMEMB :3-BYTE-INIT (COMPILER::ENV-TARGET-ARCHITECTURE ENV))) (BQUOTE (PROGN 2))) (T ( BQUOTE (PROGN 1))))) (DEFOPTIMIZER SETSTKNTOFFSET (BASE OFFSET TYPE VAL &ENVIRONMENT ENV) (* ;; "Set the offset entry for a name-table entry, from the symbol to fill in plus the variable-type marker value SHIFTED LEFT 14 BITS ALREADY." ) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (PROGN (\FIXCODENUM (\, BASE) (IDIFFERENCE (\, OFFSET) BYTESPERWORD) (\, TYPE)) (\FIXCODENUM (\, BASE) (\, OFFSET) (\, VAL))))) (T (BQUOTE (\FIXCODENUM (\, BASE) (\, OFFSET) (IPLUS (\, TYPE) (\, VAL))))))) (DEFOPTIMIZER SETSTKNAME-RAW (BASE OFFSET VAL &ENVIRONMENT ENV) (* ;; "Set the name entry for a name-table entry. This version works with raw storage, as opposed to SETSTKNAMEENTRY, which works on an ARRAYP." ) (* ;; "If this optimizer changes, change SETSTKNAMEENTRY as well.") (COND ((FMEMB :3-BYTE ( COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (LET ((VALUE (\, VAL))) (COND ((FIXP VALUE) (* ; "A 20-byte atom #. Make it an atom.") (\PUTBASEPTR (\, BASE) (\, OFFSET) (\VAG2 \AtomHI VALUE))) (T ( * ; "A 3-byte atom. Just use it.") (\PUTBASEPTR (\, BASE) (\, OFFSET) VALUE)))))) (T (BQUOTE ( \PUTBASE (\, BASE) (\, OFFSET) (\, VAL)))))) (DEFOPTIMIZER SETSTKNTOFFSET-RAW (BASE OFFSET TYPE VAL &ENVIRONMENT ENV) (* ;; "Set the offset entry for a name-table entry. This version works on raw storage, vs SETSTKNAMEOFFSETENTRY, which is supposed to work on codearrays. Any changes here should be made there, as well. TYPE must already be shifted left by 14 bits." ) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (PROGN (\PUTBASE (\, BASE) ( \, OFFSET) (\, TYPE)) (\PUTBASE (\, BASE) (IPLUS (\, OFFSET) 1) (\, VAL))))) (T (BQUOTE (\PUTBASE (\, BASE) (\, OFFSET) (IPLUS (\, TYPE) (\, VAL))))))) (DEFOPTIMIZER NEW-SYMBOL-CODE (NEW-SYMBOL-FORM OLD-SYMBOL-FORM &ENVIRONMENT ENV) (* ;; "Allow for differences between 3-byte atoms and 2-byte atoms.") (COND ((FMEMB :3-BYTE ( COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\, NEW-SYMBOL-FORM))) (T (BQUOTE (\, OLD-SYMBOL-FORM) )))) (DEFOPTIMIZER MAKE-NTENTRY (TYPE OFFSET &ENVIRONMENT ENV) (COND ((FMEMB :3-BYTE ( COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (IPLUS (CONSTANT (LLSH (\, TYPE) 16)) (\, OFFSET)))) ( T (BQUOTE (IPLUS (CONSTANT (\, TYPE)) (\, OFFSET)))))) (DEFOPTIMIZER NULL-NTENTRY (VALUE &ENVIRONMENT ENV) (* ;; "Predicate: Is VALUE a null entry in a name table? I.e., does it result from fetching the entry at the end that`s all zeros? For 2-byte atoms, that's the same as being zero. For 3-byte atoms, it's the same as being NIL." ) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (NULL (\, VALUE)))) (T ( BQUOTE (EQ (\, VALUE) 0))))) (DEFOPTIMIZER NTSLOT-VARTYPE (X &ENVIRONMENT ENV) (* ;; "Given the contents of a name-table Offset entry, return the variable-type bits at the top of the entry. THE RESULT IS RETURNED SHEFTED LEFT 14 BITS, THE USUAL REPRESENTATION." ) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (LOGAND 49153 (LRSH (\, X) 16 )))) (T (BQUOTE (LOGAND (\, X) 49152))))) (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) 207) (LLSH (LOGAND NEWVALUE 3) 4)))) (FRAMENAME (\VAG2 (LOGAND (CODELT2 DATUM 8) 4095) (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 ( \STKMIN DATUM))) (FRAMENAME# (PROGN 8))))) (RECORD OPCODE (OP# OPCODENAME OPNARGS OPPRINT LEVADJ UFNFN UNIMPL)) (GLOBALVARS \OPCODES) (RPAQQ PVARCODE 32768) (RPAQQ FVARCODE 49152) (RPAQQ IVARCODE 0) (RPAQQ VARCODEMASK 49152) (CONSTANTS PVARCODE FVARCODE IVARCODE VARCODEMASK) (RPAQQ \NT.IVARCODE 0) (RPAQQ \NT.PVARCODE 2) (RPAQQ \NT.FVARCODE 3) (CONSTANTS \NT.IVARCODE \NT.PVARCODE \NT.FVARCODE) (PUTPROP (QUOTE LLCODE) (QUOTE IMPORTDATE) (IDATE "19-Jan-93 10:45:33")) (RPAQQ \ERRORMESSAGELIST ("SYSTEM ERROR" " " "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")) (DEFOPTIMIZER LISPERROR (MESSAGE ARG) (BQUOTE (\LISPERROR (\, ARG) (\, (CL:IF (CL:STRINGP MESSAGE) ( FOR X IN \ERRORMESSAGELIST AS I FROM 0 WHEN (CL:EQUAL X MESSAGE) DO (RETURN I) FINALLY (RETURN (HELP "Unknown error message" (LIST MESSAGE ARG)))) MESSAGE))))) (PUTPROP (QUOTE AERROR) (QUOTE IMPORTDATE) (IDATE "16-May-90 11:58:35")) (RECORD BASEBYTESTREAM STREAM (SUBRECORD STREAM) (ACCESSFNS ((BIASOFFST (fetch (STREAM FW6) of DATUM) (replace (STREAM FW6) of DATUM with NEWVALUE)) (BBSNCHARS (fetch (STREAM FW7) of DATUM) (replace ( STREAM FW7) of DATUM with NEWVALUE)) (WRITEXTENSIONFN (fetch (STREAM F1) of DATUM) (replace (STREAM F1 ) of DATUM with NEWVALUE))))) (PUTPROPS \INSTREAMARG MACRO ((STRM NOERRORFLG) (\GETSTREAM STRM (QUOTE INPUT) NOERRORFLG))) (PUTPROPS \OUTSTREAMARG MACRO ((STRM NOERRORFLG) (\GETSTREAM STRM (QUOTE OUTPUT) NOERRORFLG))) (PUTPROPS \STREAMARG MACRO (OPENLAMBDA (STRM NOERRORFLG) (COND (NOERRORFLG (\GETSTREAM STRM NIL T)) (T (\DTEST STRM (QUOTE STREAM)))))) (PUTPROP (QUOTE AOFD) (QUOTE IMPORTDATE) (IDATE "13-Sep-90 16:39:58")) (PUTPROPS .SPACECHECK. MACRO ((STRM N) (AND \THISFILELINELENGTH (IGREATERP (IPLUS N (fetch CHARPOSITION of STRM)) \THISFILELINELENGTH) (FRESHLINE STRM)))) (PUTPROPS \CHECKRADIX MACRO (LAMBDA (R) (COND ((OR (NOT (SMALLP R)) (ILESSP R 1) (IGREATERP R 36)) ( \INVALID.RADIX R)) (T R)))) (PUTPROPS \XCCSFILEOUTCHARFN MACRO ((OUTSTREAM CHARCODE) (* ;;; "Encoder for XCCS format. Default decoder.") (COND ((EQ CHARCODE (CHARCODE EOL)) (COND ((NOT ( \RUNCODED OUTSTREAM)) (* ; "Charset is a constant 0") (\BOUT OUTSTREAM (\CHARSET (CHARCODE EOL)))) (( EQ (\CHARSET (CHARCODE EOL)) (ffetch (STREAM CHARSET) of OUTSTREAM))) (T (\BOUT OUTSTREAM NSCHARSETSHIFT) (\BOUT OUTSTREAM (freplace (STREAM CHARSET) of OUTSTREAM with (\CHARSET (CHARCODE EOL) ))))) (\BOUT OUTSTREAM (SELECTC (ffetch EOLCONVENTION of OUTSTREAM) (CR.EOLC (CHARCODE CR)) (LF.EOLC ( CHARCODE LF)) (CRLF.EOLC (\BOUT OUTSTREAM (CHARCODE CR)) (* ;; "Don't put out high-order byte preceding LF. The CRLF is EOL only if the bytes are immediately adjacent in the stream, with no additional encoding bytes" ) (CHARCODE LF)) (SHOULDNT))) (freplace CHARPOSITION of OUTSTREAM with 0)) (T (COND ((NOT (\RUNCODED OUTSTREAM)) (\BOUT OUTSTREAM (\CHARSET CHARCODE)) (\BOUT OUTSTREAM (\CHAR8CODE CHARCODE))) ((EQ ( \CHARSET CHARCODE) (ffetch (STREAM CHARSET) of OUTSTREAM)) (\BOUT OUTSTREAM (\CHAR8CODE CHARCODE))) (T (\BOUT OUTSTREAM NSCHARSETSHIFT) (\BOUT OUTSTREAM (freplace (STREAM CHARSET) of OUTSTREAM with ( \CHARSET CHARCODE))) (\BOUT OUTSTREAM (\CHAR8CODE CHARCODE)))) (freplace CHARPOSITION of OUTSTREAM with (PROGN (* ; "Ugh. Don't overflow") (IPLUS16 (ffetch CHARPOSITION of OUTSTREAM) 1))))))) (PUTPROP (QUOTE APRINT) (QUOTE IMPORTDATE) (IDATE " 6-Dec-91 11:43:22")) (GLOBALVARS \BCPLDISPLAY) (ACCESSFNS LINEBUFFER ((LPARCOUNT (fetch FW6 of DATUM) (replace FW6 of DATUM with NEWVALUE)) ( LBRKCOUNT (fetch FW7 of DATUM) (replace FW7 of DATUM with NEWVALUE)) (LINEBUFSTATE (fetch F5 of DATUM) (replace F5 of DATUM with NEWVALUE)) (* ; "F4 is free. EJS, 7/8/85") (KEYBOARDSTREAM (fetch F2 of DATUM) (replace F2 of DATUM with NEWVALUE)) (PEEKEDCHAR (fetch F3 of DATUM) (replace F3 of DATUM with NEWVALUE)) (* ; "Character read by PEEKC") (LBFLAGS (fetch FW9 of DATUM) (replace FW9 of DATUM with NEWVALUE)) (* ;; "True if peeked char was echoed when peeked. Could use this to determine whether to echo later or not, but that would be incompatible with Interlisp-10, so this field not used" )) (ACCESSFNS LINEBUFFER ((LBFLAGBASE (LOCF (fetch LBFLAGS of DATUM)))) (BLOCKRECORD LBFLAGBASE (( PEEKEDECHOFLG FLAG) (INSTRINGP FLAG))))) (RPAQQ LINEBUFFERSTATES (FILLING.LBS READING.LBS RETYPING.LBS)) (RPAQQ FILLING.LBS 0) (RPAQQ READING.LBS 1) (RPAQQ RETYPING.LBS 2) (CONSTANTS FILLING.LBS READING.LBS RETYPING.LBS) (PUTPROPS \INTERMP MACRO ((OFD) (EQ OFD \LINEBUF.OFD))) (PUTPROPS \OUTTERMP MACRO ((OFD) (EQ OFD \TERM.OFD))) (GLOBALVARS \DEFAULTLINEBUF) (PUTPROP (QUOTE ATERM) (QUOTE IMPORTDATE) (IDATE "16-May-90 12:08:04")) (DATATYPE HARRAYP ((NULLSLOTS WORD) (* ; "Number of NIL-NIL slots, which break chains") (LASTINDEX WORD) (* ; "Slot offset of last slot. Used in probe computations computations. Microcode support for \ADDBASE4 would help" ) (HARRAYPBASE POINTER) (RECLAIMABLE FLAG) (* ; "True if keys can go away when no other refs") ( OVERFLOWACTION POINTER) (NUMSLOTS WORD) (* ; "The maximum number of logical slots--returned by HARRAYSIZE") (NUMKEYS WORD) (* ; "The number of distinct keys in the array") (HASHBITSFN POINTER) (EQUIVFN POINTER) (HASHUSERDATA POINTER))) (PUTPROPS \EQHASHINGBITS MACRO (OPENLAMBDA (X) (* ; "Spread out objects whose low bits are in small arithmetic progression, esp atoms") (LOGXOR (\HILOC X) (LOGXOR (LLSH (LOGAND (\LOLOC X) 8191) 3) (LRSH (\LOLOC X) 9))))) (PUTPROPS \ADDBASE2 MACRO (OPENLAMBDA (BASE N) (\ADDBASE (\ADDBASE BASE N) N))) (PUTPROPS \ADDBASE4 MACRO (OPENLAMBDA (BASE N) (\ADDBASE2 (\ADDBASE2 BASE N) N))) (PUTPROPS HUNKSIZEFROMNUMBER MACRO ((NTYPX) (FOLDLO (fetch DTDSIZE of (\GETDTD NTYPX)) WORDSPERCELL))) (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) (EQ 0 (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.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.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.CODE 4) (\ST.PTR 6) (\ST.FLOAT 7) (\ST.BIT 8) (\ST.PTR2 11)) (RPAQQ \MAX.CELLSPERHUNK 64) (CONSTANTS \MAX.CELLSPERHUNK) (RPAQQ \IN.MAKEINIT NIL) (CONSTANTS (\IN.MAKEINIT)) (BLOCKRECORD SEQUENCEDESCRIPTOR ((ORIG BITS 1) (NIL BITS 1) (READONLY FLAG) (NIL BITS 1) (BASE POINTER ) (TYP BITS 4) (NIL BITS 4) (LENGTH BITS 24) (OFFST FIXP))) (DATATYPE ARRAYP ((* ;; "Describes an INTERLISP ARRAYP, as opposed to a CL array.") (ORIG BITS 1) (* ; "Origin, 0 or 1") (NIL BITS 1) (READONLY FLAG) (* ; "probably no READONLY arrays now") (NIL BITS 1) ( BASE POINTER) (TYP BITS 4) (* ; "Type of the contents") (NIL BITS 4) (LENGTH BITS 24) (* ; "Array's length") (OFFST FIXP) (* ; "Offset from BASE where the data really starts.")) (* ;; "note that while ARRAYP is a DATATYPE, the allocation of it actually happens at MAKEINIT time under INITDATATYPE{NAMES}" )) (BLOCKRECORD ARRAYBLOCK ((PASSWORD BITS 13) (GCTYPE BITS 2) (* ; "Unboxed, Pointers, or 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? (AND (EQ 0 (NTYPX DATUM)) (IGEQ (\HILOC DATUM) \FirstArraySegment)))) (GLOBALVARS \NxtArrayPage \FREEBLOCKBUCKETS \HUNKING?) (PUTPROPS HUNKSIZEFROMNUMBER MACRO ((NTYPX) (FOLDLO (fetch DTDSIZE of (\GETDTD NTYPX)) WORDSPERCELL))) (PUTPROP (QUOTE LLARRAYELT) (QUOTE IMPORTDATE) (IDATE "15-Sep-94 11:08:59")) (DEFOPTIMIZER PUTBASEPTRX (&REST ARGS) (CONS (QUOTE (OPENLAMBDA (DATUM OFFSET NEWVALUE) ( UNINTERRUPTABLY (\PUTBASE DATUM OFFSET (LOGOR (LOGAND 61440 (\GETBASE DATUM OFFSET)) (LOGAND (\HILOC NEWVALUE) 4095))) (\PUTBASE DATUM (ADD1 OFFSET) (\LOLOC NEWVALUE)) NEWVALUE))) ARGS)) (RPAQQ \SMALLP 1) (RPAQQ \FIXP 2) (RPAQQ \FLOATP 3) (RPAQQ \LITATOM 4) (RPAQQ \LISTP 5) (RPAQQ \ARRAYP 6) (RPAQQ \STACKP 8) (RPAQQ \VMEMPAGEP 10) (RPAQQ \STREAM 11) (RPAQQ \NEW-ATOM 21) (CONSTANTS \SMALLP \FIXP \FLOATP \LITATOM \LISTP \ARRAYP \STACKP \VMEMPAGEP \STREAM \NEW-ATOM) (RPAQQ \BUILT-IN-SYSTEM-TYPES ((SMALLP) (FIXP 2) (FLOATP 2) (LITATOM) (LISTP 4 (0 2)) (ARRAYP 6 (0)) ( STRINGP 6 (0)) (STACKP 2 NIL \RECLAIMSTACKP) (CHARACTER) (VMEMPAGEP 256 NIL RELEASINGVMEMPAGE) (STREAM ) (BITMAP) (COMPILED-CLOSURE 4 (0 2)) (ONED-ARRAY 8 (0)) (TWOD-ARRAY 10 (0)) (GENERAL-ARRAY 10 (0 8)) (BIGNUM) (RATIO) (COMPLEX) (PATHNAME) (NEW-ATOM 10 (2 4 6)) (FILLER22) (FILLER23) (FILLER24) (FILLER25 ) (FILLER26) (FILLER27) (FILLER28) (FILLER29) (FILLER30))) (BLOCKRECORD DTD ((NIL BITS 2) (DTDOBSOLETE FLAG) (* ; "True for type of a redeclared datatype--not allowed to allocate more of these") (DTDFINALIZABLE FLAG) (* ; "True if finalization exists for this type") (DTDNAME POINTER) (* ; "Type name -- a symbol ") ( DTDCNT0 WORD) (* ; "Incremental box count -- this plus DTDOLDCNT is the true box count") (DTDSIZE WORD ) (* ; "Length of datum in words") (DTDFREE FULLXPOINTER) (* ; "Pointer to first object on free chain, or NIL. Not used for LISTP") (DTDLOCKEDP FLAG) (* ; "True if objects of this type must be locked down (not pagefault)") (DTDHUNKP FLAG) (* ; "True if this type is used as an array hunk type") (DTDGCTYPE BITS 2) (* ; "For hunk datatypes, is analogous to arrayblock's GCTYPE") (DTDDESCRS POINTER) (DTDTYPESPECS POINTER) (DTDPTRS POINTER) (* ; "List of word offsets inside datum where reference-counted pointers are stored -- used by GC") ( DTDOLDCNT FIXP) (* ; "'Box count' -- number of objects of this type ever allocated") (DTDNEXTPAGE FIXP ) (* ; "Currently only for LISTP pages -- page number of next page on chain of non-full cons pages") ( DTDTYPEENTRY WORD) (* ;; "The word stored in the type table for objects of this type. Hi bits have numberp tags, ref countable, etc." ) (DTDSUPERTYPE WORD) (* ; "Type number of immediate supertype, or zero if none")) (ACCESSFNS DTD (( DTDCNTLOC (\ADDBASE DATUM 4)) (DTDCNT (IPLUS (fetch DTDOLDCNT DATUM) (fetch DTDCNT0 DATUM)) ( UNINTERRUPTABLY (replace DTDOLDCNT of DATUM with NEWVALUE) (replace DTDCNT0 of DATUM with 0)))))) (PUTPROPS \GETDTD MACRO ((typeNum) (ADDBASE \DTDSpaceBase (ITIMES typeNum 18)))) (DEFOPTIMIZER \TYPEMASK.UFN (&REST X) (LET ((CE (CONSTANTEXPRESSIONP (CADR X)))) (if CE then (BQUOTE ( (OPCODES TYPEMASK.N (\, (CAR CE))) (\, (CAR X)))) else (QUOTE IGNOREMACRO)))) (RPAQQ \GUARDSTORAGEFULL 128) (RPAQQ \GUARD1STORAGEFULL 64) (CONSTANTS \GUARDSTORAGEFULL \GUARD1STORAGEFULL) (GLOBALVARS \NxtMDSPage \LeastMDSPage \SecondArrayPage \SecondMDSPage \MDSFREELISTPAGE \MaxSysTypeNum \MaxTypeNumber \STORAGEFULL \INTERRUPTSTATE \PENDINGINTERRUPT) (PUTPROP (QUOTE LLDATATYPE) (QUOTE IMPORTDATE) (IDATE "28-Jun-99 16:57:50")) (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. DMACRO (OPENLAMBDA (X) (COND ((SMALLPOSP X) X) (T (\ILLEGAL.ARG X))))) (PUTPROPS .COERCE.TO.BYTE. DMACRO (OPENLAMBDA (X) (COND ((AND (SMALLPOSP X) (ILESSP X (CONSTANT (LLSH 1 BITSPERBYTE)))) X) (T (\ILLEGAL.ARG X))))) (BLOCKRECORD LISTP ((* ;; "Describes a CONS cell.") (CAR POINTER) (CDR POINTER)) (CREATE (CREATECELL \LISTP)) (* ;; "FOLLOWING ARE CDR-CODE FIELDS") (BLOCKRECORD LISTP ((CDRCODE BITS 4) (CARFIELD XPOINTER))) (* ;; "For chaining together free cells on a page:") (BLOCKRECORD LISTP ((NEXTFREE BYTE) ( NIL BITS 24))) (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 ((* ;; "Describes a page of CONS cells, which (when free) are chained together thru the top byte.") (NIL 2 FIXP) (* ; "Empty cells, space for another 2 CONS cells if we can figure out how.") (CNT BYTE) (* ; "# of cells free on this page") (NEXTCELL BYTE) (* ; "WORD offset of next free cell (not guaranteed to be 0 if no free cells)") (NIL WORD) (* ; "Padding") (NEXTPAGE FIXP) (* ; "Next CONS page on the DTD's free list, for searching for cells."))) (RPAQQ CONSCONSTANTS (\CDR.ONPAGE \CDR.NIL \CDR.INDIRECT \CDR.MAXINDIRECT \CONSPAGE.LAST)) (RPAQQ \CDR.ONPAGE 8) (RPAQQ \CDR.NIL 8) (RPAQQ \CDR.INDIRECT 0) (RPAQQ \CDR.MAXINDIRECT 7) (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 " 2-Feb-95 16:21:44")) (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 DMACRO (OPENLAMBDA (A) (PROG ((LO (IPLUS16 (\GETBASE A 1) 1))) (DECLARE ( LOCALVARS LO)) (* ; "Increment double word at A by 1") (\PUTBASE A 1 LO) (COND ((EQ LO 0) (\PUTBASE A 0 (ADD1 (\GETBASE A 0)))))))) (PUTPROPS IPLUS16 MACRO ((X Y) (* ; "Kludge to do 16-bit plus") (\LOLOC (\ADDBASE X Y)))) (PUTPROPS SMALLPOSP MACRO (OPENLAMBDA (X) (AND (SMALLP X) (IGEQ X 0)))) (PROGN (PUTPROPS SETXVAR MACRO (X (BQUOTE (SETQ.NOREF %, (CADAR X) %, (CADR X))))) (PUTPROPS SETXVAR DMACRO (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 VAL) (\PUTBASEPTR (LOCF (fetch (LITATOM VALUE) of (QUOTE VAR))) 0 VAL))) (PROGN (PUTPROPS IEQ MACRO ((X Y) (IEQP X Y))) (PUTPROPS IEQ DMACRO (= . EQ))) (RPAQQ WordsPerPage 256) (CONSTANTS WordsPerPage) (ACCESSFNS LITATOM ((DEFINITIONCELL (\DEFCELL DATUM)) (PROPCELL (\PROPCELL DATUM)) (VCELL (\VALCELL DATUM)) (PNAMECELL (\PNAMECELL DATUM))) (* ;; "VCELL can also be accessed directly from a value index via the record VALINDEX (as in \SETGLOBALVAL.UFN) --- Similarly, PNAMEINDEX accesses PNAMECELL for use by \MKATOM and UNCOPYATOM" ) (TYPE? (LITATOM DATUM)) (BLOCKRECORD PROPCELL ((NIL BITS 4) (* ; "former flags locations") (PROPLIST POINTER) (NIL BITS 8) (* ; "Package byte") (NIL BITS 8) (* ; "Flags from defcell") (* ;; "PROPCell flags:") (NIL BITS 1) (GENSYMP FLAG) (FATPNAMEP FLAG) (NIL BITS 5) (* ;; "Filler for final cell:") (NIL BITS 8)))) (SYNONYM CL:SYMBOL (LITATOM)) (ACCESSFNS VALINDEX ((VCELL (COND ((AND (FIXP DATUM) (ILESSP DATUM 65535)) (* ; "Xerox Lisp traditional symbol") (\ADDBASE2 \PNPSPACE (IPLUS \NEWATOM-VALOFFSET (ITIMES 10 DATUM)))) ( T (* ; "New symbol") (* ; "'90/07/19 ON") (\ADDBASE DATUM \NEWATOM-VALOFFSET)))))) (BLOCKRECORD VCELL ((VALUE FULLPOINTER))) (BLOCKRECORD DEFINITIONCELL ((CCODEP FLAG) (FASTP FLAG) (ARGTYPE BITS 2) (* ; "Former flag location") (DEFPOINTER POINTER) (NIL POINTER) (* ; "Proplist cell") (NIL BITS 8) (* ; "package") (* ;; "DEFCELL flags overflow from top 4 bits of the real cell:") (NIL BITS 4) (PSEUDOCODEP FLAG) (NIL BITS 3) (* ;; "proplist falgs and filler:") (NIL BITS 16)) (BLOCKRECORD DEFINITIONCELL ((DEFCELLFLAGS BITS 4) (NIL POINTER) (* ; "defn ptr") (NIL BITS 4) (NIL POINTER) (* ; "filler for proplist ptr") (NIL BITS 8) (AUXDEFCELLFLAGS BYTE) (NIL BITS 16)))) (BLOCKRECORD FNHEADER ((STKMIN WORD) (NA SIGNEDWORD) (PV SIGNEDWORD) (STARTPC WORD) (CLOSUREP FLAG) (* ; "T if this is a %"compiled closure%"") (BYTESWAPPED FLAG) (* ; "T if, on 386, we reswapped the code section of this function for faster access.") (ARGTYPE BITS 2) (* ; "0 = LAMBDA") (* ; "2 = LAMBDA nospread") (* ; "1 = NLAMBDA") (* ; "3 = NLAMBDA nospread") (* ;; "4 NIL BITS USED TO BE HERE.") (%#FRAMENAME XPOINTER) (NTSIZE WORD) (* ; "Size of the Name Table, IN WORDS. This value is always rounded up to the next Quad-word in size, and there' guaranteed to be one entry of zeros in the length." ) (NLOCALS BYTE) (FVAROFFSET BYTE)) (ACCESSFNS FNHEADER ((LSTARP (ILESSP (fetch (FNHEADER NA) of DATUM ) 0)) (OVERHEADWORDS (PROGN 8)) (NATIVE (PROGN NIL)) (* ; "T if this is a NATIVE-code function (never true!)") (ALIGNED (IPLUS (fetch (FNHEADER NTSIZE) of DATUM ) (fetch (FNHEADER OVERHEADWORDS) of T))) (FIXED NIL (replace (FNHEADER STKMIN) of DATUM with (\STKMIN DATUM T))) (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)))))) (BLOCKRECORD PNAMECELL ((NIL BITS 4) (PNAMEBASE XPOINTER) (NIL POINTER) (* ; "val, def, prop cells") ( NIL POINTER) (NIL POINTER) (PACKAGEINDEX BYTE) (NIL BITS 24) (* ; "filler for other flags")) ( BLOCKRECORD PNAMECELL ((FULLPNAMEBASE FULLXPOINTER) (* ; "Replacing this smashes PACKAGEINDEX to 0"))) (ACCESSFNS PNAMECELL ((PACKAGE (LET ((I (FETCH (PNAMECELL PACKAGEINDEX) OF DATUM))) (* ; "This ugly construct allows cl:symbol-package to run in the init, where *PACKAGE-FROM-INDEX* is not yet bound." ) (COND ((EQ 0 I) NIL) (T (CL:AREF *PACKAGE-FROM-INDEX* I)))) (REPLACE (PNAMECELL PACKAGEINDEX) OF DATUM WITH (IF (NULL NEWVALUE) THEN *UNINTERNED-PACKAGE-INDEX* ELSE (CL::%%PACKAGE-INDEX NEWVALUE))))) )) (ACCESSFNS PACKAGEINDEX ((PACKAGE (IF (EQ 0 DATUM) (* ; "This ugly construct allows cl:symbol-package to run in the init, where *PACKAGE-FROM-INDEX* is not yet bound." ) THEN NIL ELSE (CL:AREF *PACKAGE-FROM-INDEX* DATUM))))) (BLOCKRECORD PNAMEBASE ((PNAMELENGTH BYTE) (* ; "Length is always here, be the pname thin or fat") ( PNAMEFATPADDINGBYTE BYTE) (* ; "This byte is zero for fat pnames so that the pname chars are word-aligned"))) (ACCESSFNS PNAMEINDEX ((PNAMECELL (COND ((AND (FIXP DATUM) (ILESSP DATUM 65535)) (* ; "Xerox Lisp traditional symbol") (\ADDBASE \OLDATOMSPACE (IPLUS \NEWATOM-PNAMEOFFSET (ITIMES 10 DATUM) ))) (T (* ; "New symbol") (* ; "'90/07/19 ON") (\ADDBASE DATUM \NEWATOM-PNAMEOFFSET)))))) (BLOCKRECORD NEW-ATOM ((* ;; "An extended symbol, for expanding atom space. Kept in its own datatype.") (PNAME XPOINTER) (* ; "PNAME, same as litatom.") (VALUE POINTER) (DEF POINTER) (PROPLIST POINTER) (* ;; "Flags that used to be above the pointers, e.g. package, ccodep, gensymp:") (NIL BITS 32))) (PUTPROPS \DEFCELL MACRO ((ATOM) (\ATOMCELL ATOM \DEF.HI))) (PUTPROPS \VALCELL MACRO ((ATOM) (\ATOMCELL ATOM \VAL.HI))) (PUTPROPS \PNAMECELL MACRO ((ATOM) (\ATOMCELL ATOM \PNAME.HI))) (PUTPROPS \ATOMVALINDEX DMACRO (OPENLAMBDA (X) (COND ((EQ (NTYPX X) \LITATOM) (* ; "Original litatoms" ) (\LOLOC X)) ((EQ (NTYPX X) \NEW-ATOM) (* ; "new 3-byte symbols") X) (T (SHOULDNT))))) (PUTPROPS \ATOMDEFINDEX DMACRO (OPENLAMBDA (X) (COND ((EQ (NTYPX X) \LITATOM) (* ; "Original litatoms" ) (\LOLOC X)) ((EQ (NTYPX X) \NEW-ATOM) (* ; "new 3-byte symbols") X) (T (SHOULDNT))))) (PUTPROPS \ATOMPNAMEINDEX DMACRO (OPENLAMBDA (X) (COND ((EQ (NTYPX X) \LITATOM) (* ; "Original litatoms") (\LOLOC X)) ((EQ (NTYPX X) \NEW-ATOM) (* ; "new 3-byte symbols") X) (T (SHOULDNT) )))) (PUTPROPS \ATOMPROPINDEX DMACRO ((X) (COND ((EQ (NTYPX X) \LITATOM) (* ; "Original litatoms") (\LOLOC X)) ((EQ (NTYPX X) \NEW-ATOM) (* ; "new 3-byte symbols") X) (T (SHOULDNT))))) (PUTPROPS \INDEXATOMPNAME DMACRO (OPENLAMBDA (X) (COND ((FIXP X) (* ; "Xerox Lisp traditional symbol") (COND ((SMALLP X) (\VAG2 \AtomHI X)) (T (\VAG2 (LRSH X 16) (LOGAND X 65535))))) (T (* ; "New symbol") X)))) (PUTPROPS \INDEXATOMVAL DMACRO (OPENLAMBDA (X) (COND ((FIXP X) (* ; "Xerox Lisp traditional symbol") ( COND ((SMALLP X) (\VAG2 \AtomHI X)) (T (\VAG2 (LRSH X 16) (LOGAND X 65535))))) (T (* ; "New symbol") X )))) (PUTPROPS \INDEXATOMDEF DMACRO (OPENLAMBDA (X) (COND ((FIXP X) (* ; "Xerox Lisp traditional symbol") ( COND ((SMALLP X) (\VAG2 \AtomHI X)) (T (\VAG2 (LRSH X 16) (LOGAND X 65535))))) (T (* ; "New symbol") X )))) (PUTPROPS \ATOMNUMBER DMACRO (= . \LOLOC)) (GLOBALVARS \NxtPnByte \CurPnPage \NxtAtomPage \AtomFrLst \OneCharAtomBase \PNAMES.IN.BLOCKS? \SCRATCHSTRING COMPILEATPUTDFLG) (RPAQQ \PNAMELIMIT 255) (RPAQQ \CharsPerPnPage 512) (CONSTANTS (\PNAMELIMIT 255) (\CharsPerPnPage 512)) (RPAQQ \NEWATOM-PNAMEOFFSET 0) (RPAQQ \NEWATOM-VALOFFSET 2) (RPAQQ \NEWATOM-DEFOFFSET 4) (RPAQQ \NEWATOM-PLISTOFFSET 6) (RPAQQ \NEWATOM-TYPE# 21) (CONSTANTS (\NEWATOM-PNAMEOFFSET 0) (\NEWATOM-VALOFFSET 2) (\NEWATOM-DEFOFFSET 4) ( \NEWATOM-PLISTOFFSET 6) (\NEWATOM-TYPE# 21)) (PUTPROPS \MOVEWORDS MACRO (OPENLAMBDA (SBASE SOFFSET DBASE DOFFSET NWORDS) (\BLT (\ADDBASE DBASE DOFFSET) (\ADDBASE SBASE SOFFSET) NWORDS))) (PUTPROP (QUOTE LLBASIC) (QUOTE IMPORTDATE) (IDATE "31-Jan-98 09:55:50")) (ACCESSFNS STRINGP ((XREADONLY (fetch (ARRAY-HEADER READ-ONLY-P) of DATUM) (replace (ARRAY-HEADER READ-ONLY-P) of DATUM with NEWVALUE)) (XBASE ((OPENLAMBDA (STRING) (COND ((fetch (ARRAY-HEADER INDIRECT-P) of STRING) (%%ARRAY-BASE STRING)) (T (fetch (ARRAY-HEADER BASE) of STRING)))) DATUM) (( OPENLAMBDA (STRING NV) (replace (ARRAY-HEADER INDIRECT-P) of STRING with NIL) (replace (ARRAY-HEADER BASE) of STRING with NV) NV) DATUM NEWVALUE)) (TYP ((OPENLAMBDA (STRING) (SELECTC (COND ((fetch ( ARRAY-HEADER INDIRECT-P) of STRING) (%%ARRAY-TYPE-NUMBER STRING)) (T (fetch (ARRAY-HEADER TYPE-NUMBER) of STRING))) (%%THIN-CHAR-TYPENUMBER \ST.BYTE) (%%FAT-CHAR-TYPENUMBER \ST.POS16) (SHOULDNT "Unknown type-number"))) DATUM) ((OPENLAMBDA (STRING NV) (LET ((%%NEW-TYPE-NUMBER (SELECTC NV ( \ST.BYTE %%THIN-CHAR-TYPENUMBER) (\ST.POS16 %%FAT-CHAR-TYPENUMBER) (SHOULDNT "Unknown typ value")))) ( COND ((fetch (ARRAY-HEADER INDIRECT-P) of STRING) (%%SET-ARRAY-TYPE-NUMBER STRING %%NEW-TYPE-NUMBER)) (T (replace (ARRAY-HEADER TYPE-NUMBER) of STRING with %%NEW-TYPE-NUMBER))))) DATUM NEWVALUE)) (LENGTH (fetch (ARRAY-HEADER FILL-POINTER) of DATUM) ((OPENLAMBDA (STRING NV) (replace (ARRAY-HEADER FILL-POINTER) of STRING with NV) (replace (ARRAY-HEADER TOTAL-SIZE) of STRING with NV) (COND (( %%GENERAL-ARRAY-P STRING) (freplace (GENERAL-ARRAY DIMS) of STRING with (LIST NV)))) NV) DATUM NEWVALUE)) (OFFST ((OPENLAMBDA (STRING) (COND ((fetch (ARRAY-HEADER INDIRECT-P) of STRING) ( %%ARRAY-OFFSET STRING)) (T (fetch (ARRAY-HEADER OFFSET) of STRING)))) DATUM) ((OPENLAMBDA (STRING NV) (COND ((NOT (EQ 0 NV)) (replace (ARRAY-HEADER DISPLACED-P) of STRING with T))) (COND ((fetch ( ARRAY-HEADER INDIRECT-P) of STRING) (%%SET-ARRAY-OFFSET STRING NV)) (T (replace (ARRAY-HEADER OFFSET) of STRING with NV)))) DATUM NEWVALUE)) (* ;; "The rest of these fields only appear when smashing") ( XFLAGS (LOGAND (fetch (ARRAY-HEADER FLAGS) of DATUM) 15) ((OPENLAMBDA (STRING) (replace (ARRAY-HEADER ADJUSTABLE-P) of STRING with NIL) (replace (ARRAY-HEADER DISPLACED-P) of STRING with NIL) (replace ( ARRAY-HEADER FILL-POINTER-P) of STRING with NIL) (replace (ARRAY-HEADER EXTENDABLE-P) of STRING with NIL)) DATUM))) (ACCESSFNS STRINGP ((ORIG ((OPENLAMBDA (STRING) 1) DATUM) ((OPENLAMBDA (STRING NV) ( COND ((NOT (EQ NV 1)) (ERROR "Il:stringp's are always origin 1"))) NV) DATUM NEWVALUE)) (* ; "An inoperative field") (SUBSTRINGED ((OPENLAMBDA (STRING) NIL) DATUM) ((OPENLAMBDA (STRING NV) (OR ( NULL NV) (ERROR "Substringed field not supported"))) DATUM NEWVALUE)) (READONLY (ffetch (STRINGP XREADONLY) of DATUM) (freplace (STRINGP XREADONLY) of DATUM with NEWVALUE)) (FATSTRINGP ((OPENLAMBDA ( STRING) (EQ (COND ((fetch (ARRAY-HEADER INDIRECT-P) of STRING) (%%ARRAY-TYPE-NUMBER STRING)) (T (fetch (ARRAY-HEADER TYPE-NUMBER) of STRING))) %%FAT-CHAR-TYPENUMBER)) DATUM) ((OPENLAMBDA (STRING NV) (LET ((%%NEW-TYPE-NUMBER (COND (NV %%FAT-CHAR-TYPENUMBER) (T %%THIN-CHAR-TYPENUMBER)))) (COND ((fetch ( ARRAY-HEADER INDIRECT-P) of STRING) (%%SET-ARRAY-TYPE-NUMBER STRING %%NEW-TYPE-NUMBER)) (T (replace ( ARRAY-HEADER TYPE-NUMBER) of STRING with %%NEW-TYPE-NUMBER))))) DATUM NEWVALUE)) (BASE (ffetch ( STRINGP XBASE) of DATUM) (freplace (STRINGP XBASE) of DATUM with NEWVALUE)))) (CREATE (create ONED-ARRAY BASE _ XBASE READ-ONLY-P _ XREADONLY STRING-P _ T DISPLACED-P _ (NOT (EQ OFFST 0)) TYPE-NUMBER _ (COND ((EQ TYP \ST.POS16) %%FAT-CHAR-TYPENUMBER) (T %%THIN-CHAR-TYPENUMBER)) OFFSET _ OFFST FILL-POINTER _ LENGTH TOTAL-SIZE _ LENGTH)) (TYPE? (CL:STRINGP DATUM)) OFFST _ 0 TYP _ \ST.BYTE LENGTH _ 0) (GLOBALVARS \OneCharAtomBase) (PUTDEF (QUOTE \NUMSTR) (QUOTE RESOURCES) (QUOTE (NEW (ALLOCSTRING 128)))) (PUTDEF (QUOTE \NUMSTR1) (QUOTE RESOURCES) (QUOTE (NEW (CONCAT)))) (PUTDEF (QUOTE \PNAMESTRING) (QUOTE RESOURCES) (QUOTE (NEW (ALLOCSTRING \PNAMELIMIT NIL NIL \FATPNAMESTRINGP)))) (RPAQQ \FATPNAMESTRINGP T) (CONSTANTS (\FATPNAMESTRINGP T)) (PUTPROPS \PNAMESTRINGPUTCHAR MACRO ((BASE OFFSET CODE) (* ; "For stuffing chars into resource \PNAMESTRING") (\PUTBASECHAR \FATPNAMESTRINGP BASE OFFSET CODE))) (DEFOPTIMIZER FCHARACTER (NUM) (BQUOTE ((OPENLAMBDA (N) (COND ((IGREATERP N \MAXTHINCHAR) (* ; "The character we're getting is NOT a thin character -- do it the hard way") (CHARACTER N)) (( IGREATERP N (CHARCODE 9)) (\ADDBASE \OneCharAtomBase (IDIFFERENCE N 10))) ((IGEQ N (CHARCODE 0)) ( IDIFFERENCE N (CHARCODE 0))) (T (* ; "The common case -- just add on the one-atom base.") (\ADDBASE \OneCharAtomBase N)))) (\, NUM)))) (I.S.OPR (QUOTE inpname) NIL (QUOTE (SUBPAIR (QUOTE ($$END $$BODY $$FATP $$BASE $$OFFSET)) (LIST ( GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (BQUOTE (bind $$OFFSET _ 0 $$BODY _ BODY $$BASE $$END $$FATP declare (LOCALVARS $$END $$BODY $$FATP $$BASE $$OFFSET) first (PROG NIL $$RETRY (COND ((STRINGP $$BODY) (SETQ $$BASE (ffetch (STRINGP BASE) of $$BODY)) (SETQ $$OFFSET ( SUB1 (ffetch (STRINGP OFFST) of $$BODY))) (SETQ $$END (IPLUS $$OFFSET (ffetch (STRINGP LENGTH) of $$BODY))) (SETQ $$FATP (ffetch (STRINGP FATSTRINGP) of $$BODY))) ((LITATOM $$BODY) (SETQ $$BASE ( ffetch (LITATOM PNAMEBASE) of $$BODY)) (SETQ $$END (ffetch (PNAMEBASE PNAMELENGTH) of $$BASE)) (SETQ $$FATP (ffetch (LITATOM FATPNAMEP) of $$BODY))) (T (SETQ $$BODY (MKSTRING $$BODY)) (GO $$RETRY)))) eachtime (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (COND ($$FATP (\GETBASEFAT $$BASE $$OFFSET)) (T (\GETBASETHIN $$BASE $$OFFSET)))))))) T) (I.S.OPR (QUOTE inatom) NIL (QUOTE (SUBPAIR (QUOTE ($$OFFSET $$BODY $$BASE $$END $$FATP)) (LIST ( GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (bind $$OFFSET _ 0 $$BODY _ BODY $$BASE $$END $$FATP declare (LOCALVARS $$OFFSET $$BODY $$BASE $$END $$FATP) first (SETQ $$BASE (ffetch (LITATOM PNAMEBASE) of $$BODY)) (SETQ $$END (ffetch (PNAMEBASE PNAMELENGTH) of $$BASE)) (SETQ $$FATP (ffetch (LITATOM FATPNAMEP) of $$BODY)) eachtime (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND ( IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (COND ($$FATP (\GETBASEFAT $$BASE $$OFFSET)) (T ( \GETBASETHIN $$BASE $$OFFSET)))))))) T) (I.S.OPR (QUOTE instring) NIL (QUOTE (SUBPAIR (QUOTE ($$BODY $$END $$OFFSET $$BASE $$FATP)) (LIST ( GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (bind $$BODY _ BODY $$END $$OFFSET $$BASE $$FATP declare (LOCALVARS $$BODY $$END $$OFFSET $$BASE $$FATP) first (SETQ $$OFFSET ( SUB1 (ffetch (STRINGP OFFST) of $$BODY))) (SETQ $$BASE (ffetch (STRINGP BASE) of $$BODY)) (SETQ $$END (IPLUS $$OFFSET (ffetch (STRINGP LENGTH) of $$BODY))) (SETQ $$FATP (ffetch (STRINGP FATSTRINGP) of $$BODY)) eachtime (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (COND ($$FATP (\GETBASEFAT $$BASE $$OFFSET)) (T (\GETBASETHIN $$BASE $$OFFSET)))))))) T) (I.S.OPR (QUOTE infatatom) NIL (QUOTE (SUBPAIR (QUOTE ($$OFFSET $$BODY $$BASE $$END)) (LIST ( GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (bind $$OFFSET _ 0 $$BODY _ BODY $$BASE $$END declare (LOCALVARS $$OFFSET $$BODY $$BASE $$END) first (SETQ $$BASE (ffetch (LITATOM PNAMEBASE) of $$BODY)) (SETQ $$END (ffetch (PNAMEBASE PNAMELENGTH) of $$BASE)) eachtime (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (\GETBASEFAT $$BASE $$OFFSET)))))) T ) (I.S.OPR (QUOTE inthinatom) NIL (QUOTE (SUBPAIR (QUOTE ($$OFFSET $$BODY $$BASE $$END)) (LIST ( GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (bind $$OFFSET _ 0 $$BODY _ BODY $$BASE $$END declare (LOCALVARS $$OFFSET $$BODY $$BASE $$END) first (SETQ $$BASE (ffetch (LITATOM PNAMEBASE) of $$BODY)) (SETQ $$END (ffetch (PNAMEBASE PNAMELENGTH) of $$BASE)) eachtime (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (\GETBASETHIN $$BASE $$OFFSET)))))) T) (I.S.OPR (QUOTE infatstring) NIL (QUOTE (SUBPAIR (QUOTE ($$BODY $$END $$OFFSET $$BASE)) (LIST ( GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (bind $$BODY _ BODY $$END $$OFFSET $$BASE declare (LOCALVARS $$BODY $$END $$OFFSET $$BASE) first (SETQ $$OFFSET (SUB1 (ffetch (STRINGP OFFST) of $$BODY))) (SETQ $$BASE (ffetch (STRINGP BASE) of $$BODY)) (SETQ $$END (IPLUS $$OFFSET ( ffetch (STRINGP LENGTH) of $$BODY))) eachtime (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (\GETBASEFAT $$BASE $$OFFSET)))))) T) (I.S.OPR (QUOTE inthinstring) NIL (QUOTE (SUBPAIR (QUOTE ($$BODY $$END $$OFFSET $$BASE)) (LIST ( GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (bind $$BODY _ BODY $$END $$OFFSET $$BASE declare (LOCALVARS $$BODY $$END $$OFFSET $$BASE) first (SETQ $$OFFSET (SUB1 (ffetch (STRINGP OFFST) of $$BODY))) (SETQ $$BASE (ffetch (STRINGP BASE) of $$BODY)) (SETQ $$END (IPLUS $$OFFSET ( ffetch (STRINGP LENGTH) of $$BODY))) eachtime (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (\GETBASETHIN $$BASE $$OFFSET)))))) T) (PUTPROPS \CHARCODEP DMACRO (OPENLAMBDA (X) (* ; "used to also say (ILEQ X \MAXFATCHAR), but that's implied by the first two clauses") (AND (SMALLP X) (IGEQ X 0)))) (PUTPROPS \FATCHARCODEP DMACRO (OPENLAMBDA (X) (* ; "Used to also say (ILEQ X \MAXFATCHAR), but that's implied by the first two clauses") (AND (SMALLP X) (IGREATERP X \MAXTHINCHAR)))) (PUTPROPS \THINCHARCODEP DMACRO (OPENLAMBDA (X) (AND (SMALLP X) (IGEQ X 0) (ILEQ X \MAXTHINCHAR)))) (PUTPROPS \GETBASEFAT MACRO (= . \GETBASE)) (PUTPROPS \GETBASETHIN MACRO (= . \GETBASEBYTE)) (PUTPROPS \PUTBASEFAT MACRO (= . \PUTBASE)) (PUTPROPS \PUTBASETHIN MACRO (= . \PUTBASEBYTE)) (PUTPROPS \PUTBASECHAR MACRO (OPENLAMBDA (FATP BASE OFFSET CODE) (COND (FATP (\PUTBASEFAT BASE OFFSET CODE)) (T (\PUTBASETHIN BASE OFFSET CODE))))) (PUTPROPS \GETBASECHAR MACRO ((FATP BASE N) (COND (FATP (\GETBASEFAT BASE N)) (T (\GETBASETHIN BASE N) )))) (PUTPROPS \CHARSET MACRO ((CHARCODE) (LRSH CHARCODE 8))) (PUTPROPS \CHAR8CODE MACRO ((CHARCODE) (LOGAND CHARCODE 255))) (RPAQQ \CHARMASK 255) (RPAQQ \MAXCHAR 255) (RPAQQ \MAXTHINCHAR 255) (RPAQQ \MAXFATCHAR 65535) (RPAQQ \MAXCHARSET 255) (RPAQQ NSCHARSETSHIFT 255) (RPAQQ %#STRINGPWORDS 4) (CONSTANTS (\CHARMASK 255) (\MAXCHAR 255) (\MAXTHINCHAR 255) (\MAXFATCHAR 65535) (\MAXCHARSET 255) ( NSCHARSETSHIFT 255) (%#STRINGPWORDS 4)) (PUTPROPS \NATOMCHARS DMACRO ((AT) (fetch (LITATOM PNAMELENGTH) of AT))) (PUTPROPS \NSTRINGCHARS DMACRO ((S) (fetch (STRINGP LENGTH) of S))) (PUTPROP (QUOTE LLCHAR) (QUOTE IMPORTDATE) (IDATE "12-Jan-94 10:12:34")) (ACCESSFNS BF ((BFBLOCK (ADDSTACKBASE DATUM))) (* ; "basic frame pointer") (BLOCKRECORD BFBLOCK (( FLAGS BITS 3) (NIL BITS 3) (RESIDUAL FLAG) (* ; "true if this is not a full BF") (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) (* ; "= \STK.FX") (FAST FLAG) (NIL FLAG) (INCALL FLAG) (* ; "set when fncall microcode has to punt") (VALIDNAMETABLE FLAG) (* ; "if on, NAMETABLE field is filled in. If off, is same as FNHEADER") (NOPUSH FLAG) (* ; "when returning to this frame, don't push a value. Set by interrupt code") (USECNT BITS 8) (%#ALINK WORD) (* ; "low bit is SLOWP") (FNHEADER FULLXPOINTER) (NEXTBLOCK WORD) (PC WORD) (NAMETABLE# FULLXPOINTER) (%#BLINK WORD) (%#CLINK WORD))) (BLOCKRECORD FXBLOCK ((FLAGBYTE BYTE) (NIL BYTE) (NIL BITS 15) (* ; "most of the bits of #ALINK") (SLOWP FLAG) (* ; "if on, then BLINK and CLINK fields are valid. If off, they are implicit") (NIL FULLXPOINTER 2) ( NAMETABHI WORD) (NAMETABLO WORD))) (TYPE? (IEQ (fetch (FX FLAGS) of DATUM) \STK.FX)) (ACCESSFNS FX (( NAMETABLE (COND ((fetch (FX VALIDNAMETABLE) of DATUM) (fetch (FX NAMETABLE#) of DATUM)) (T (fetch (FX FNHEADER) of DATUM))) (PROGN (replace (FX FAST) of DATUM with NIL) (replace (FX NAMETABLE#) of DATUM with NEWVALUE) (replace (FX VALIDNAMETABLE) of DATUM with T))) (FRAMENAME (fetch (FNHEADER FRAMENAME) of (fetch (FX NAMETABLE) of DATUM))) (INVALIDP (EQ DATUM 0)) (* ; "true when A/CLink points at nobody, i.e. FX is bottom of stack") (FASTP (NOT (fetch (FX SLOWP) of DATUM)) (PROGN (CHECK (NULL NEWVALUE)) (COND ((fetch (FX FASTP) of DATUM) (replace (FX %#BLINK) of DATUM with (fetch (FX DUMMYBF) of DATUM)) (replace (FX %#CLINK) of DATUM with (fetch (FX %#ALINK) of DATUM)) (replace (FX SLOWP) of DATUM with T))))) (BLINK (COND ((fetch (FX FASTP) of DATUM) (fetch (FX DUMMYBF) of DATUM)) (T (fetch (FX %#BLINK) of DATUM))) (PROGN (replace (FX %#BLINK) of DATUM with NEWVALUE) (COND ((fetch (FX FASTP) of DATUM) (replace (FX %#CLINK) of DATUM with (fetch (FX %#ALINK) of DATUM)) (replace (FX SLOWP) of DATUM with T))))) (CLINK (IDIFFERENCE (COND ((fetch (FX FASTP) of DATUM) (fetch (FX %#ALINK) of DATUM)) (T (fetch (FX %#CLINK) of DATUM))) \#ALINK.OFFSET) (PROGN ( replace (FX %#CLINK) of DATUM with (IPLUS NEWVALUE \#ALINK.OFFSET)) (COND ((fetch (FX FASTP) of DATUM) (replace (FX %#BLINK) of DATUM with (fetch (FX DUMMYBF) of DATUM)) (replace (FX SLOWP) of DATUM with T))))) (ALINK (IDIFFERENCE (FLOOR (fetch (FX %#ALINK) of DATUM) WORDSPERCELL) \#ALINK.OFFSET) (PROGN ( COND ((fetch (FX FASTP) of DATUM) (replace (FX %#BLINK) of DATUM with (fetch (FX DUMMYBF) of DATUM)) ( replace (FX %#CLINK) of DATUM with (fetch (FX %#ALINK) of DATUM)))) (replace (FX %#ALINK) of DATUM with (IPLUS NEWVALUE \#ALINK.OFFSET (SUB1 WORDSPERCELL))))) (ACLINK (SHOULDNT) (PROGN (COND ((fetch ( FX FASTP) of DATUM) (replace (FX %#BLINK) of DATUM with (fetch (FX DUMMYBF) of DATUM)))) (replace (FX %#CLINK) of DATUM with (IPLUS NEWVALUE \#ALINK.OFFSET)) (replace (FX %#ALINK) of DATUM with (IPLUS NEWVALUE \#ALINK.OFFSET (SUB1 WORDSPERCELL))))) (* ; "replaces A & C Links at once more efficiently than separately") (DUMMYBF (IDIFFERENCE DATUM WORDSPERCELL)) (* ;; "This is either an actual BF or %"residual%" BF that provides enough BF to find its IVAR slot. This means that when a FX is copied, the cell preceding the FX is copied too." ) (IVAR (fetch (BF IVAR) of (fetch (FX 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))))))) (FIRSTPVAR (IPLUS DATUM (fetch (FX FXSIZE) of T))) (* ; "stack offset of PVAR0") (FXSIZE (PROGN 10)) (* ; "fixed overhead from flags thru clink") (PADDING ( PROGN 4)) (* ; "doublecell of garbage for microcode use") (FIRSTTEMP (IPLUS (fetch (FX FIRSTPVAR) of DATUM) (fetch (FX NPVARWORDS) of DATUM) (fetch (FX PADDING) of DATUM))) (* ; "note that NPVARWORDS is obtained from the FNHEADER") (SIZE (IDIFFERENCE (fetch (FX NEXTBLOCK) of DATUM) DATUM))))) (ACCESSFNS FSB (* ;; "FREE STACK BLOCK -- ") (* ;; " A piece of stack space that's free.") (* ;; "The first word contains 120000Q") (* ;; "The 2nd word is the size of the block, in words.") (( 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))) (* ; "unspecified stack block") (BLOCKRECORD STKBLOCK ((FLAGS BITS 3))) (BLOCKRECORD STKBLOCK ((FLAGWORD WORD)))) (RPAQQ \#ALINK.OFFSET 10) (CONSTANTS \#ALINK.OFFSET) (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) (BINDHI WORD)) (ACCESSFNS FVARSLOT ((LOOKEDUP (EVENP (fetch BINDLO of DATUM))) (BINDINGPTR (\VAG2 (fetch BINDHI of DATUM) (fetch BINDLO of DATUM)) (PROGN (replace BINDLO of DATUM with (\LOLOC NEWVALUE)) (replace BINDHI of DATUM with (\HILOC NEWVALUE))))))) (BLOCKRECORD PVARSLOT ((PVHI BITS 4) (PVVALUE XPOINTER)) (ACCESSFNS PVARSLOT ((BOUND (EQ (fetch ( PVARSLOT PVHI) of DATUM) 0) (if (NULL NEWVALUE) then (replace (PVARSLOT PVHI) of DATUM with 255) else (ERROR "Illegal replace" NEWVALUE)))))) (BLOCKRECORD STKTEMPSLOT ((STKTMPHI BITS 4) (VALUE XPOINTER)) (ACCESSFNS STKTEMPSLOT ((BINDINGPTRP ( NEQ (fetch STKTMPHI of DATUM) 0))))) (BLOCKRECORD BINDMARKSLOT ((BINDMARKP FLAG) (NIL BITS 15)) (BLOCKRECORD BINDMARKSLOT ((BINDNEGVALUES WORD) (BINDLASTPVAR WORD))) (ACCESSFNS BINDMARKSLOT ((BINDNVALUES (PROGN (* ; "Value stored in high half is one's complement of number of values bound") (LOGXOR (fetch BINDNEGVALUES of DATUM) 65535)))))) (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 " 6-Jan-93 18:07:37")) (PUTPROPS WORDCONTENTS BYTEMACRO ((PTR) (\GETBASE PTR 0))) (PUTPROPS SETWORDCONTENTS BYTEMACRO ((PTR N) (\PUTBASE PTR 0 N))) (PUTPROPS WORDOFFSET BYTEMACRO ((PTR N) (\ADDBASE PTR N))) (PUTPROPS \RELEASECPAGE MACRO ((STREAM) (PROGN (* ; "Must be under an UNINTERRUPTABLY !") (COND (( fetch CBUFDIRTY of STREAM) (\SETIODIRTY STREAM (fetch CPAGE of STREAM)) (replace CBUFDIRTY of STREAM with NIL))) (replace CBUFSIZE of STREAM with 0) (replace CBUFPTR of STREAM with NIL)))) (PUTPROP (QUOTE PMAP) (QUOTE IMPORTDATE) (IDATE " 3-Feb-2002 14:11:02")) (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 .CHECK.ALLOCATION.COUNT. MACRO (OPENLAMBDA (N) (DECLARE (GLOBALVARS \RECLAIM.COUNTDOWN)) ( AND \RECLAIM.COUNTDOWN (COND ((NOT (IGREATERP \RECLAIM.COUNTDOWN N)) (SETQ \RECLAIM.COUNTDOWN) ( \DORECLAIM)))))) (PUTPROPS \GCDISABLED MACRO (NIL (PROGN (DECLARE (GLOBALVARS \GCDISABLED)) \GCDISABLED))) (BLOCKRECORD HTOVERFLOW ((CASE BITS 4) (PTR XPOINTER)) (ACCESSFNS HTOVERFLOW ((CLEAR NIL (\PUTBASEPTR DATUM 0 NIL))))) (BLOCKRECORD GC ((CNT BITS 15) (STKBIT FLAG) (HIBITS BITS 15) (LINKP FLAG) (NXTPTR FIXP)) (BLOCKRECORD GC ((STKCNT WORD))) (ACCESSFNS GC ((EMPTY (EQ 0 (\GETBASEFIXP DATUM 0)) (\PUTBASEFIXP DATUM 0 0)) ( CONTENTS (\GETBASEFIXP DATUM 0) (\PUTBASEFIXP DATUM 0 NEWVALUE)) (LINKPTR (LOGAND (\GETBASEFIXP DATUM 0) -2) (\PUTBASEFIXP DATUM 0 (LOGOR NEWVALUE 1)))))) (BLOCKRECORD HTCOLL ((* ;; "An entry in the GC collision table. NEXTFREE is initialized to 2 by INITGC, as part of the MAKEINIT." ) (FREEPTR FIXP) (* ; "The GC table entry") (NEXTFREE FIXP) (* ; "If the entry is in use, points to the next entry in this collision chain. If not, offset (in 1/2-entries) of the next free one on the chain." ))) (PUTPROP (QUOTE LLGC) (QUOTE IMPORTDATE) (IDATE "19-Oct-94 12:30:11")) (PUTPROPS \SYNCODE DMACRO (OPENLAMBDA (TABLE CHAR) (CHECK (type? CHARTABLE TABLE)) (* ; "0 is either NONE.TC, REAL.CCE, or OTHER.RC") (COND ((IGREATERP CHAR \MAXTHINCHAR) (OR (AND (fetch ( CHARTABLE NSCHARHASH) of TABLE) (GETHASH CHAR (fetch (CHARTABLE NSCHARHASH) of TABLE))) 0)) (T ( \GETBASEBYTE TABLE CHAR))))) (PUTPROPS \SETSYNCODE DMACRO (LAMBDA (TABLE CHAR CODE) (CHECK (type? CHARTABLE TABLE)) (* ; "0 is REAL.CCE, NONE.TC, OTHER.RC") (COND ((ILEQ CHAR \MAXTHINCHAR) (\PUTBASEBYTE TABLE CHAR CODE)) (T (\SETFATSYNCODE TABLE CHAR CODE))))) (DATATYPE CHARTABLE ((CHARSET0 256 BYTE) (NSCHARHASH FULLPOINTER))) (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)) (PUTPROPS \GETREADMACRODEF MACRO ((C TBL) (GETHASH C (fetch READMACRODEFS of TBL)))) (PUTPROPS \GTREADTABLE MACRO (ARGS (COND ((LITATOM (CAR ARGS)) (SUBPAIR (QUOTE (X . FLG)) ARGS (QUOTE (SELECTQ X ((NIL T) (\DTEST *READTABLE* (QUOTE READTABLEP))) (\GTREADTABLE1 X . FLG))))) (T (QUOTE IGNOREMACRO))))) (PUTPROPS \GTREADTABLE1 DMACRO (ARGS (COND ((NULL (CDR ARGS)) (LIST (QUOTE \DTEST) (CAR ARGS) (QUOTE ( QUOTE READTABLEP)))) (T (QUOTE IGNOREMACRO))))) (RPAQQ MACROBIT 8) (RPAQQ BREAKBIT 16) (RPAQQ STOPATOMBIT 32) (RPAQQ ESCAPEBIT 64) (RPAQQ INNERESCAPEBIT 4) (CONSTANTS MACROBIT BREAKBIT STOPATOMBIT ESCAPEBIT INNERESCAPEBIT) (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))) (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 INNERESCAPEBIT 6)) (MULTIPLE-ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 7)) (PACKAGEDELIM.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 1)))) (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 INNERESCAPEBIT 6)) (RPAQ MULTIPLE-ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 7)) (RPAQ PACKAGEDELIM.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 1)) (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 INNERESCAPEBIT 6)) (MULTIPLE-ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 7)) (PACKAGEDELIM.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 1))) (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 (BITTEST DATUM ESCAPEBIT)) (STOPATOM (BITTEST DATUM STOPATOMBIT)) (INNERESCQUOTE (BITTEST DATUM (LOGOR STOPATOMBIT INNERESCAPEBIT))) ( MACROCONTEXT (LOGAND DATUM CONTEXTMASK)) (MACROP (BITTEST DATUM MACROBIT)) (WAKEUP (LOGAND DATUM WAKEUPMASK)) (BREAK (BITTEST DATUM BREAKBIT)))) (RECORD READMACRODEF (MACROTYPE . MACROFN)) (DATATYPE READTABLEP ((READSA POINTER) (* ; "A CHARTABLE defining syntax of each char") (READMACRODEFS POINTER) (* ; "A hash table associating macro chars with macro definitions") (READMACROFLG FLAG) (* ; "True if read macros are enabled (turned off by Interlisp's crufty READMACROS function)") (ESCAPEFLG FLAG) (* ; "True if the char(s) with escape syntax are enabled (turned off by Interlisp's crufty ESCAPE function)" ) (COMMONLISP FLAG) (* ; "True if table is a Common Lisp read table and hence must obey Common Lisp syntax rules") (NUMBERBASE BITS 5) (* ; "Not used") (CASEINSENSITIVE FLAG) (* ; "If true, unescaped lowercase chars are converted to uppercase in symbols") (COMMONNUMSYNTAX FLAG) (* ; "True if number notation includes Common Lisp numbers: rationals as a/b, and the dfls exponent markers" ) (USESILPACKAGE FLAG) (* ; "If true, IL:READ ignores *PACKAGE* and reads in the IL package") (NIL 5 FLAG) (DISPATCHMACRODEFS POINTER) (* ; "An a-list of dispatching macro char and its dispatch definitions") (HASHMACROCHAR BYTE) (* ; "The character code used in this read table for the # dispatch macro") (ESCAPECHAR BYTE) (* ; "The character code used in this read table for single escape") (MULTESCAPECHAR BYTE) (* ; "The character code used in this read table for multiple escape") (PACKAGECHAR BYTE) (* ; "The character code used in this read table for package delimiter") (READTBLNAME POINTER) (* ; "The canonical 'name' of this read table")) READSA _ (create CHARTABLE)) (PUTPROP (QUOTE ATBL) (QUOTE IMPORTDATE) (IDATE "20-Apr-2018 17:35:56")) (DATATYPE STREAM ((* ;; "First 8 words are fixed for BIN, BOUT opcodes. Used to require length of whole datatype be multiple of 4, but Dolphin dead now." ) (COFFSET WORD) (* ; "Offset in CPPTR of next bin or bout") (CBUFSIZE WORD) (* ; "Offset past last byte in that buffer") (PEEKEDCHARP FLAG) (* ; "if true, PEEKEDCHAR contains value of recent call to unread-char") (ACCESSBITS BITS 3) (* ; "What kind of access file is open for (read, write, append)") (CBUFPTR POINTER) (* ; "Pointer to current buffer") (BYTESIZE BYTE) (* ; "Byte size of stream, always 8 for now") (CHARSET BYTE) (* ; "the current character set for this stream. If 255, stream is not runcoded, so read-char consumes two bytes every time" ) (PEEKEDCHAR WORD) (* ; "value of unread-char call") (CHARPOSITION WORD) (* ; "Used by POSITION etc." ) (CBUFMAXSIZE WORD) (* ; "on output, the size of the physical buffer--can't extend beyond this") (* ;; "-------- Above fields (8 words) potentially known to microcode. --------") (NONDEFAULTDATEFLG FLAG) (REVALIDATEFLG FLAG) (MULTIBUFFERHINT FLAG) (* ; "True if stream likes to read and write more than one buffer at a time") (USERCLOSEABLE FLAG) (* ; "Can be closed by CLOSEF; NIL for terminal, dribble...") (FULLFILENAME POINTER) (* ; "Name by which file is known to user") (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") (CBUFDIRTY FLAG) (* ; "true if BOUT has sullied the current buffer") (DEVICE POINTER) (* ; "FDEV of this guy") (USERVISIBLE FLAG) (* ; "Listed by OPENP; NIL for terminal, dribble ...") (EOLCONVENTION BITS 2) (* ; "End-of-line convention") (NOTXCCS FLAG) (* ; "True if the character encoding format is not XCCS.") ( VALIDATION POINTER) (* ; "A number somehow identifying file, used to determine if file has changed in our absence") (CPAGE POINTER) (* ; "CPAGE,,COFFSET constitutes current file pointer for most randaccess streams") (EPAGE POINTER) (EOFFSET WORD) (* ; "Page, byte offset of eof") (LINELENGTH WORD) (* ; "LINELENGTH of stream, or -1 for no line length") (* ;; "----Following are device-specific fields----" ) (* ;; "Available for device-specific uses, NOT for application use.") (F1 POINTER) (F2 POINTER) (F3 POINTER) (F4 POINTER) (F5 POINTER) (FW6 WORD) (FW7 WORD) (FW8 WORD) (FW9 WORD) (F10 POINTER) (* ;; "----Following only filled in for open streams----") (STRMBINFN POINTER) (* ; "Either the BIN fn from the FDEV, or a trap") (STRMBOUTFN POINTER) (* ; "Either the BIN fn from the FDEV, or a trap") (OUTCHARFN POINTER) (* ; "Called by \OUTCHAR, the normal character printer.") (ENDOFSTREAMOP POINTER) (* ; "Called if EOF and we try to read.") (OTHERPROPS POINTER) (* ; "PROP LIST for holding other info.") ( IMAGEOPS POINTER) (* ; "Image operations vector") (IMAGEDATA POINTER) (* ; "Image instance variables--format depends on IMAGEOPS value") (BUFFS POINTER) (* ; "Buffer chain for pmapped streams") (MAXBUFFERS WORD) (* ; "Max # of buffers the system will allocate.") (LASTCCODE WORD) (* ; "After READ, RATOM, etc, the charcode that will be returned (as a character) by LASTC. If there is none, this field is 65535." ) (EXTRASTREAMOP POINTER) (* ; "For use of applications programs, not devices")) (BLOCKRECORD STREAM ( (NIL 2 WORD) (UCODEFLAGS1 BITS 1) (* ;; "respecification of access bits:") (RANDOMWRITEABLE FLAG) (* ; "File open for output (access = OUTPUT or BOTH)") (APPENDABLE FLAG) (* ; "File open for append (OUTPUT or APPEND or BOTH)") (READABLE FLAG) (* ; "File open for read (READ or BOTH)") (NIL POINTER))) (BLOCKRECORD STREAM ((NIL 4 WORD) (NIL BITS 14) ( * ;; "JIS character encoding format specific, overrides CHARSET field.") (IN.KANJIIN FLAG) (* ; "True if input stream is in Kanji-in mode.") (OUT.KANJIIN FLAG) (* ; "True if output stream is in Kanji-in mode."))) (ACCESSFNS STREAM ((ACCESS \GETACCESS \SETACCESS) ( FULLNAME (OR (fetch (STREAM FULLFILENAME) of DATUM) DATUM)) (NAMEDP (AND (fetch (STREAM FULLFILENAME) of DATUM) T)))) (ACCESSFNS STREAM (EXTERNALFORMAT (LISTGET (ffetch (STREAM OTHERPROPS) of DATUM) ( QUOTE EXTERNALFORMAT)) (LET ((PROPS (ffetch (STREAM OTHERPROPS) of DATUM))) (freplace (STREAM NOTXCCS) of DATUM with T) (COND (PROPS (LISTPUT PROPS (QUOTE EXTERNALFORMAT) NEWVALUE)) (T (freplace (STREAM OTHERPROPS) of DATUM with (LIST (QUOTE EXTERNALFORMAT) NEWVALUE)))) (freplace (STREAM OUTCHARFN) of DATUM with (ffetch (EXTERNALFORMAT FILEOUTCHARFN) of NEWVALUE)) (AND (ffetch (EXTERNALFORMAT EOLVALID) of NEWVALUE) (freplace (STREAM EOLCONVENTION) of DATUM with (ffetch (EXTERNALFORMAT EOL) of NEWVALUE) ))))) (ACCESSFNS STREAM (EXTERNALFORMAT.NAME (LISTGET (ffetch (STREAM OTHERPROPS) of DATUM) (QUOTE EXTERNALFORMAT.NAME)) (LET ((PROPS (ffetch (STREAM OTHERPROPS) of DATUM)) (NAME (COND ((LITATOM NEWVALUE) NEWVALUE) (T (MKATOM NEWVALUE))))) (freplace (STREAM NOTXCCS) of DATUM with T) (COND (PROPS (LISTPUT PROPS (QUOTE EXTERNALFORMAT.NAME) NAME)) (T (freplace (STREAM OTHERPROPS) of DATUM with (LIST (QUOTE EXTERNALFORMAT.NAME) NAME))))))) (ACCESSFNS STREAM (INCCODEFN (LET ((XFMT (LISTGET (ffetch ( STREAM OTHERPROPS) of DATUM) (QUOTE EXTERNALFORMAT)))) (AND (type? EXTERNALFORMAT XFMT) (fetch ( EXTERNALFORMAT INCCODEFN) of XFMT))))) (ACCESSFNS STREAM (PEEKCCODEFN (LET ((XFMT (LISTGET (ffetch ( STREAM OTHERPROPS) of DATUM) (QUOTE EXTERNALFORMAT)))) (AND (type? EXTERNALFORMAT XFMT) (fetch ( EXTERNALFORMAT PEEKCCODEFN) of XFMT))))) (ACCESSFNS STREAM (BACKCHARFN (LET ((XFMT (LISTGET (ffetch ( STREAM OTHERPROPS) of DATUM) (QUOTE EXTERNALFORMAT)))) (AND (type? EXTERNALFORMAT XFMT) (fetch ( EXTERNALFORMAT BACKCHARFN) of XFMT))))) (ACCESSFNS STREAM (FILEOUTCHARFN (ffetch (STREAM OUTCHARFN) of DATUM))) (SYNONYM CBUFPTR (CPPTR)) USERCLOSEABLE _ T USERVISIBLE _ T ACCESSBITS _ NoBits CPAGE _ 0 EPAGE _ 0 BUFFS _ NIL BYTESIZE _ 8 CBUFPTR _ NIL MAXBUFFERS _ (LET NIL (DECLARE (GLOBALVARS \STREAM.DEFAULT.MAXBUFFERS)) \STREAM.DEFAULT.MAXBUFFERS) CHARPOSITION _ 0 LINELENGTH _ (LET NIL ( DECLARE (GLOBALVARS FILELINELENGTH)) FILELINELENGTH) OUTCHARFN _ (FUNCTION \FILEOUTCHARFN) ENDOFSTREAMOP _ (FUNCTION \EOSERROR) IMAGEOPS _ \NOIMAGEOPS EOLCONVENTION _ (SELECTQ (SYSTEMTYPE) (D CR.EOLC) (VAX LF.EOLC) (JERICHO CRLF.EOLC) CR.EOLC) STRMBINFN _ (FUNCTION \STREAM.NOT.OPEN) STRMBOUTFN _ (FUNCTION \STREAM.NOT.OPEN) LASTCCODE _ 65535 NOTXCCS _ NIL) (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)) (RPAQQ \NORUNCODE 255) (CONSTANTS AppendBit NoBits ReadBit WriteBit (OutputBits (LOGOR AppendBit WriteBit)) (BothBits (LOGOR ReadBit OutputBits)) \NORUNCODE) (PUTPROPS TestMasked MACRO ((BITS MASK) (NEQ (LOGAND BITS MASK) 0))) (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 \RUNCODED MACRO (OPENLAMBDA (STREAM) (* ;; "returns NIL is the stream is not runcoded, that is, if the stream has 16 bit bytes explicitly represented" ) (* ; "note that neq is ok since charsets are known to be SMALLP's") (NEQ (fetch CHARSET of STREAM) \NORUNCODE))) (RPAQQ EOLCONVENTIONS ((CR.EOLC 0) (LF.EOLC 1) (CRLF.EOLC 2))) (RPAQQ CR.EOLC 0) (RPAQQ LF.EOLC 1) (RPAQQ CRLF.EOLC 2) (CONSTANTS (CR.EOLC 0) (LF.EOLC 1) (CRLF.EOLC 2)) (PUTPROPS FDEVOP DMACRO (ARGS (LET ((OPNAME (CAR ARGS)) (METHOD-DEVICE (CADR ARGS)) (TAIL (CDDR ARGS)) ) (COND ((AND (LISTP OPNAME) (EQ (CAR OPNAME) (QUOTE QUOTE))) (BQUOTE (SPREADAPPLY* (fetch (FDEV (\, ( CADR OPNAME))) of (\, METHOD-DEVICE)) (\,@ TAIL)))) (T (ERROR "OPNAME not quoted: " OPNAME)))))) (PUTPROPS \RECOGNIZE-HACK DMACRO (ARGS (LET ((NAME (CAR ARGS)) (RECOG (CADR ARGS)) (DEVICE (CADDR ARGS ))) (BQUOTE (if (type? STREAM (\, NAME)) then (\, NAME) else (FDEVOP (QUOTE GETFILENAME) (\, DEVICE) ( \, NAME) (\, RECOG) (\, DEVICE))))))) (DATATYPE FDEV ((RESETABLE FLAG) (* ; "Obsolete") (RANDOMACCESSP FLAG) (NODIRECTORIES FLAG) ( PAGEMAPPED FLAG) (* ; "True if i/o handled by pmap routines") (FDBINABLE FLAG) (* ; "Copied as a microcode flag for INPUT streams formed on this device") (FDBOUTABLE FLAG) (FDEXTENDABLE FLAG) (BUFFERED FLAG) (* ; "True implies that the device supports the BIN & BOUT uCode conventions, and implements the GETNEXTBUFFER method" ) (DEVICENAME POINTER) (* ; "Identifying name somehow") (REMOTEP FLAG) (* ; "true if device not local to machine") (SUBDIRECTORIES FLAG) (* ; "true if device has real subdirectories") (INPUT-INDIRECTED FLAG) (* ; "True for devices that indirect their input stream. Method INPUTSTREAM fetches it") ( OUTPUT-INDIRECTED FLAG) (* ; "True for devices that indirect their output stream. Method OUTPUTSTREAM fetches it") (DEVICEINFO POINTER) (* ; "arbitrary device-specific info stored here") (OPENFILELST POINTER) (* ; "Default place to keep list of streams open on this device") (* ;; "-----Rest of record consists of device %"methods%"-----") (* ;; "-----Following fields required of all devices-----") (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" ) (EVENTFN POINTER) (* ; "(device event), called before/after logout, sysout, makesys") (* ;; "-----Following fields required of all named devices, e.g., ones that open files-----") ( DIRECTORYNAMEP POINTER) (* ; "(host/dir) => true if directory exists on host") (OPENFILE POINTER) (* ; "(name access recog otherinfo device) => new stream open on this device, or NIL if name not found") ( CLOSEFILE POINTER) (* ; "(stream) => closes stream, returns it") (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" ) (GETFILENAME POINTER) (* ; "(name recog device) => full file name") (DELETEFILE POINTER) (* ; "(name) => deletes file so named, returning name, or NIL on failure. RECOG=OLDEST") (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" ) (RENAMEFILE POINTER) (* ; "(olddevice oldfile newdevice newfile) to rename file on this (olddevice) to a potentially different device." ) (OPENP POINTER) (* ; "(name access dev) => stream if name is open for access, or all open streams if name = NIL") ( REGISTERFILE POINTER) (* ; "(stream dev) => registers stream on its device") (UNREGISTERFILE POINTER) (* ; "(stream dev) => unregisters a stream from its device") (FREEPAGECOUNT POINTER) (* ; "(host/dir dev) => # of free pages on host/dir") (MAKEDIRECTORY POINTER) (* ; "(host/dir dev)") ( CHECKFILENAME POINTER) (* ; "(name dev) => name if it is well-formed file name for dev") (HOSTALIVEP POINTER) (* ; "(host dev) => true if host is alive, i.e., responsive; only defined if REMOTEP is true") ( BREAKCONNECTION POINTER) (* ; "(host fastp dev) => closes connections to host") (* ;; "-----The following are required methods for operating on open streams-----") (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") (READCHAR POINTER) (* ; "(stream) => next input char") (WRITECHAR POINTER) (* ; "(stream char) => writes char to stream") ( PEEKCHAR POINTER) (UNREADCHAR POINTER) (READP POINTER) (* ; "(stream flag) => T if there is input available from stream right now") (EOFP POINTER) (* ; "(stream) => T if BIN would signal eof.") (BLOCKIN POINTER) (* ; "(stream buffer byteoffset nbytes)") (BLOCKOUT POINTER) (* ; "(stream buffer byteoffset nbytes)") (FORCEOUTPUT POINTER) (* ; "(stream waitForFinish) flushes out to device anything that is buffered awaiting transmission") ( GETFILEINFO POINTER) (* ; "(stream/name attribute device) => value of attribute for open stream or name of closed file") ( SETFILEINFO POINTER) (* ; "(stream/name attribute newvalue device) sets attribute of open stream or closed file of given name") (CHARSETFN POINTER) (* ; "(stream charset) => access function for the charset slot, for benefit of indirect streams. See IMCHARSET for changing it on a file." ) (INPUTSTREAM POINTER) (* ; "(stream) => indirected input stream") (OUTPUTSTREAM POINTER) (* ; "(stream) => indirected output stream") (* ;; "-----Following are required of random-access streams-----") (GETFILEPTR POINTER) (GETEOFPTR POINTER) (SETFILEPTR POINTER) (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" ) (SETEOFPTR POINTER) (* ; "(stream length) => truncates or lengthens stream to indicated length") ( LASTC POINTER) (* ; "Should be possible only if RANDOMACCESSP") (* ;; "-----Following used for buffered streams-----") (GETNEXTBUFFER POINTER) (* ; "(stream whatfor noerrorflg) => Disposes of current buffer and optionally reads next. whatfor is READ or WRITE. Can cause EOF error unless noerrorflg" ) (RELEASEBUFFER POINTER) (* ; "(stream) => Does whatever appropriate when CBUFPTR is released") (* ;; "-----Following used for pagemapped streams-----") (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)" ) (WRITEPAGES POINTER) (* ; "(stream firstpage# buflist) writes from buflist to stream starting at firstpage# of stream") ( TRUNCATEFILE POINTER) (* ; "(stream page offset) make stream's eof be at page,offset, discarding anything after it") (* ;; "-----For window system, argh-----") (WINDOWOPS POINTER) (* ; "window system operations") (WINDOWDATA POINTER) (* ; "data for window systems") (* ;; "-----For any stream (here to not recompile everything)-----") (READCHARCODE POINTER) (* ; "Read a character code from the stream (cf BIN for bytes).")) DIRECTORYNAMEP _ (FUNCTION NILL) HOSTNAMEP _ (FUNCTION NILL) READP _ (FUNCTION \GENERIC.READP) SETFILEPTR _ (FUNCTION \IS.NOT.RANDACCESSP) GETFILEPTR _ (FUNCTION \ILLEGAL.DEVICEOP) GETEOFPTR _ (FUNCTION \IS.NOT.RANDACCESSP) EOFP _ (FUNCTION \ILLEGAL.DEVICEOP) BLOCKIN _ (FUNCTION \GENERIC.BINS) BLOCKOUT _ (FUNCTION \GENERIC.BOUTS) RENAMEFILE _ (FUNCTION \GENERIC.RENAMEFILE) FORCEOUTPUT _ (FUNCTION NILL) REGISTERFILE _ (FUNCTION NILL) OPENP _ (FUNCTION NILL) UNREGISTERFILE _ (FUNCTION NILL) READCHAR _ ( FUNCTION \GENERIC.READCHAR) WRITECHAR _ (FUNCTION \GENERIC.WRITECHAR) PEEKCHAR _ (FUNCTION \GENERIC.PEEKCHAR) UNREADCHAR _ (FUNCTION \GENERIC.UNREADCHAR) CHARSETFN _ (FUNCTION \GENERIC.CHARSET) BREAKCONNECTION _ (FUNCTION NILL) READCHARCODE _ (FUNCTION \GENERIC.READCCODE)) (RECORD FILEGENOBJ (NEXTFILEFN FILEINFOFN . GENFILESTATE)) (DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* ; "If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream.") (EOL BITS 2) (NIL BITS 1) (INCCODEFN POINTER) (* ; "Called with two arguments -- STREAM and COUNTP") ( PEEKCCODEFN POINTER) (* ; "Called with three arguments -- STREAM, NOERROR and COUNTP") (BACKCHARFN POINTER) (* ; "Called with two arguments -- STREAM and COUNTP") (FILEOUTCHARFN POINTER) (* ; "Called with two arguments -- STREAM and CHARCODE")) EOLVALID _ NIL) (PUTPROPS \OUTCHAR DMACRO (OPENLAMBDA (STREAM CHARCODE) (STREAMOP (QUOTE OUTCHARFN) STREAM STREAM CHARCODE))) (PUTPROPS \DEVICE-OPEN-STREAMS MACRO (ARGS (LET ((DEVICE (CAR ARGS))) (BQUOTE (FDEVOP (QUOTE OPENP) ( \, DEVICE) NIL NIL (\, DEVICE)))))) (PUTPROPS \CONVERT-PATHNAME DMACRO (OPENLAMBDA (PATHNAME?) (* ;; "Coerce pathnames to Interlisp strings, for the benefit of antediluvian Interlisp-D file fns") ( CL:TYPECASE PATHNAME? (PATHNAME (INTERLISP-NAMESTRING PATHNAME?)) (T PATHNAME?)))) (DEFOPTIMIZER ACCESS-CHARSET (STREAM &OPTIONAL NEWVALUE) (BQUOTE ((OPENLAMBDA (STRM) (FDEVOP (QUOTE CHARSETFN) (fetch (STREAM DEVICE) of STRM) STRM (\, NEWVALUE))) (\, STREAM)))) (PUTPROPS \DECFILEPTR MACRO ((STREAM X) (\INCFILEPTR STREAM (IMINUS X)))) (PUTPROPS \GETFILEPTR MACRO (OPENLAMBDA (STRM) (FDEVOP (QUOTE GETFILEPTR) (fetch DEVICE of STRM) STRM) )) (PUTPROPS \SIGNEDWIN MACRO ((STREAM) (SIGNED (\WIN STREAM) BITSPERWORD))) (PUTPROPS \SIGNEDWOUT MACRO ((STREAM N) (\WOUT STREAM (UNSIGNED N BITSPERWORD)))) (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 ))) (PUTPROPS SIZE.FROM.LENGTH MACRO (LAMBDA (LEN) (DECLARE (LOCALVARS LEN)) (AND LEN (FOLDHI LEN BYTESPERPAGE)))) (RPAQQ BitsPerByte 8) (RPAQ ByteOffsetSize (SELECTQ (SYSTEMTYPE) (VAX 10) 9)) (RPAQQ WordsPerPage 256) (CONSTANTS BitsPerByte (ByteOffsetSize (SELECTQ (SYSTEMTYPE) (VAX 10) 9)) WordsPerPage) (RPAQ \MAXFILEPTR (SUB1 (LLSH 1 30))) (CONSTANTS (\MAXFILEPTR (SUB1 (LLSH 1 30)))) (ACCESSFNS BYTEPTR ((PAGE (FOLDLO DATUM BYTESPERPAGE)) (OFFSET (MOD DATUM BYTESPERPAGE))) (TYPE? (AND (FIXP DATUM) (IGEQ DATUM 0) (ILEQ DATUM \MAXFILEPTR))) (CREATE (IPLUS (UNFOLD PAGE BYTESPERPAGE) OFFSET))) (PUTPROP (QUOTE FILEIO) (QUOTE IMPORTDATE) (IDATE "26-Mar-99 12:25:05")) (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 (ARGS (LET ((ARG-FORM (CAR ARGS)) (HIGH-VAR (CADR ARGS)) (LOW-VAR (CADDR ARGS) ) (BIGNUM-FORM (CADDDR ARGS))) (BQUOTE (PROG NIL UBLP (SELECTC (NTYPX (\, ARG-FORM)) (\FIXP (SETQ (\, HIGH-VAR) (ffetch (FIXP HINUM) of (\, ARG-FORM))) (SETQ (\, LOW-VAR) (ffetch (FIXP LONUM) of (\, ARG-FORM)))) (\SMALLP (COND ((ILEQ 0 (\, ARG-FORM)) (SETQ (\, HIGH-VAR) 0) (SETQ (\, LOW-VAR) (\, ARG-FORM))) (T (SETQ (\, HIGH-VAR) 65535) (SETQ (\, LOW-VAR) (\LOLOC (\, ARG-FORM)))))) (\FLOATP (SETQ (\, ARG-FORM) (\FIXP.FROM.FLOATP (\, ARG-FORM))) (GO UBLP)) (COND ((TYPENAMEP (\, ARG-FORM) (QUOTE RATIO)) (SETQ (\, ARG-FORM) (IQUOTIENT (CL::RATIO-NUMERATOR (\, ARG-FORM)) (CL::RATIO-DENOMINATOR (\, ARG-FORM)))) (GO UBLP)) (\,@ (COND (BIGNUM-FORM (BQUOTE (((CL:INTEGERP (\, ARG-FORM)) (\, BIGNUM-FORM) )))) (T (BQUOTE (((CL:INTEGERP (\, ARG-FORM)) (\ILLEGAL.ARG (\, ARG-FORM)))))))) (T ( CL::%%NOT-NONCOMPLEX-NUMBER-ERROR (\, ARG-FORM)))))))))) (PUTPROPS .NEGATE. MACRO ((HY LY) (COND ((EQ 0 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 "16-May-90 18:47:56")) (PUTPROPS POLYEVAL DMACRO ((X COEFFS DEGREE) (* ; "execute the POLYEVAL opcode on the value X, the array COEFFS with degree DEGREE") (\FLOATBOX (( OPCODES UBFLOAT3 0) (\FLOATUNBOX X) (fetch (ARRAYP BASE) of COEFFS) DEGREE)))) (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))) (BLOCKRECORD FLOATP ((NIL BITS 1) ( HIWORDNOSIGNBIT BITS 15))) (CREATE (\FLOATBOX (\VAG2 (LOGOR (LLSH SIGNBIT (PLUS 7 8)) (LLSH EXPONENT 7 ) HIFRACTION) LOFRACTION))) LOFRACTION _ 0 HIFRACTION _ 0 EXPONENT _ 0 SIGNBIT _ 0 (ACCESSFNS FLOATP ( (EXP (LOGAND (LRSH (\HILOC (\FLOATUNBOX DATUM)) 7) 255)) (HIFRAC (LOGAND (\HILOC (\FLOATUNBOX DATUM)) 127))))) (RPAQQ MAX.DIGITS.ACCURACY 9) (CONSTANTS (MAX.DIGITS.ACCURACY 9)) (PUTPROPS \CALLER.ARGS MACRO (X (LET ((ARGS (CAR X)) (FORMS (CDR X))) (BQUOTE (PROGN (\SLOWRETURN) ( LET ((AL (\MYALINK)) NEXT (\,@ (for VAR in ARGS collect (COND ((LISTP VAR) (LIST (CAR VAR) 0)) (T VAR) )))) (DECLARE (\,@ (for VAR in ARGS when (LISTP VAR) collect (BQUOTE (TYPE (\, (SELECTQ (CADR VAR) (( FLOATING FLOATP) (CADR VAR)) (HELP))) (\, (CAR VAR))))))) (SETQ NEXT (fetch (FX NEXTBLOCK) of AL)) ( \,@ (for X in (REVERSE ARGS) collect (LET ((FORMS (BQUOTE (\.GETBASE32 \STACKSPACE (SETQ NEXT ( IDIFFERENCE NEXT WORDSPERCELL)))))) (COND ((LISTP X) (BQUOTE (SETQ (\, (CAR X)) (\FLOATBOX (\, FORMS)) ))) (T (BQUOTE (SETQ (\, X) (\, FORMS)))))))) (\MAKEFREEBLOCK NEXT (TIMES (\, (LENGTH ARGS)) WORDSPERCELL)) (replace (FX NEXTBLOCK) of AL with NEXT) (PROGN (\,@ FORMS)))))))) (PUTPROP (QUOTE LLFLOAT) (QUOTE IMPORTDATE) (IDATE "16-May-90 19:26:51")) (DEFOPTIMIZER FONTPROP (&REST 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 FONTCLASS ((PRETTYFONT# BYTE) DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME)) (DATATYPE FONTDESCRIPTOR ((FONTDEVICE POINTER) (FONTFAMILY POINTER) (FONTSIZE POINTER) (FONTFACE POINTER) (\SFAscent WORD) (\SFDescent WORD) (\SFHeight WORD) (ROTATION WORD) (FBBOX SIGNEDWORD) (FBBOY SIGNEDWORD) (FBBDX SIGNEDWORD) (FBBDY SIGNEDWORD) (\SFLKerns POINTER) (\SFRWidths POINTER) ( FONTDEVICESPEC POINTER) (* ; "Holds the spec by which the font is known to the printing device, if coercion has been done") ( OTHERDEVICEFONTPROPS POINTER) (* ; "For individual devices to hang special information") (FONTSCALE POINTER) (\SFFACECODE BITS 8) (FONTAVGCHARWIDTH WORD) (* ; "Set in FONTCREATE, used to fix up the linelength when DSPFONT is called") (FONTIMAGEWIDTHS POINTER) ( * ; "This is the image width, as opposed to the advanced width; initial hack for accents, kerning. Fields is referenced by FONTCREATE." ) (FONTCHARSETVECTOR POINTER) (* ; "A 256-pointer block, with one pointer per 'character set' --each group of 256 character codes. Each pointer is either NIL if there's no info for that charset, or is a CHARSETINFO, containing widths, char bitmap, etc for the characters in that charset." ) (FONTEXTRAFIELD2 POINTER)) FONTCHARSETVECTOR _ (\CREATEFONTCHARSETVECTOR)) (RECORD FONTFACE (WEIGHT SLOPE EXPANSION) (ACCESSFNS ((COLOR (CDDDR DATUM) (RPLACD (CDDR DATUM) NEWVALUE)) (BACKCOLOR (COND ((CDDDR DATUM) (CAR (CDDDR DATUM)))) (PROGN (COND ((NULL (CDDDR DATUM)) ( RPLACD (CDDR DATUM) (LIST NIL NIL)))) (RPLACA (CDDDR DATUM) NEWVALUE))) (FORECOLOR (COND ((CDDDR DATUM ) (CADR (CDDDR DATUM)))) (PROGN (COND ((NULL (CDDDR DATUM)) (RPLACD (CDDR DATUM) (LIST NIL NIL)))) ( RPLACA (CDR (CDDDR DATUM)) NEWVALUE))))) WEIGHT _ (QUOTE MEDIUM) SLOPE _ (QUOTE REGULAR) EXPANSION _ ( QUOTE REGULAR) (TYPE? LISTP)) (DATATYPE CHARSETINFO (WIDTHS (* ; "The advance-width of each character, an array indexed by charcode. Usually the same as the imagewidth, but can differ for accents, kerns kerns. This is what should be used for stringwidth calculations." ) OFFSETS (* ; "Offset of each character into the image bitmap; X value of left edge") IMAGEWIDTHS (* ; "imagewidths is not automagically allocated since it is not always needed") CHARSETBITMAP (* ; "Bitmap containing the character images, indexed by OFFSETS") YWIDTHS (CHARSETASCENT WORD) (* ; "Max ascent for all characters in this CHARSET") (CHARSETDESCENT WORD) (* ; "Max descent for all characters in this CHARSET") LEFTKERN) WIDTHS _ (\CREATECSINFOELEMENT) OFFSETS _ (\CREATECSINFOELEMENT)) (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 ((OFFSETSBLOCK CHAR8CODE) (\GETBASE OFFSETSBLOCK CHAR8CODE))) (PUTPROPS \FSETOFFSET DMACRO ((OFFSETSBLOCK CHAR8CODE OFFSET) (\PUTBASE OFFSETSBLOCK CHAR8CODE OFFSET) )) (PUTPROPS \FGETWIDTH DMACRO ((WIDTHSBLOCK CHAR8CODE) (\GETBASE WIDTHSBLOCK CHAR8CODE))) (PUTPROPS \FSETWIDTH DMACRO ((WIDTHSBLOCK INDEX WIDTH) (\PUTBASE WIDTHSBLOCK INDEX WIDTH))) (PUTPROPS \FGETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE) (\FGETWIDTH (ffetch (CHARSETINFO WIDTHS ) of (\GETCHARSETINFO (\CHARSET CHARCODE) FONTDESC)) (\CHAR8CODE CHARCODE)))) (PUTPROPS \FSETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE WIDTH) (\FSETWIDTH (ffetch (CHARSETINFO WIDTHS) of (\GETCHARSETINFO (\CHARSET CHARCODE) FONTDESC)) (\CHAR8CODE CHARCODE) WIDTH))) (PUTPROPS \FGETIMAGEWIDTH MACRO ((IMAGEWIDTHSBLOCK CHAR8CODE) (\GETBASE IMAGEWIDTHSBLOCK CHAR8CODE))) (PUTPROPS \FSETIMAGEWIDTH DMACRO ((WIDTHSBLOCK INDEX WIDTH) (\PUTBASE WIDTHSBLOCK INDEX WIDTH))) (PUTPROPS \GETCHARSETINFO MACRO ((CHARSET FONTDESC NOSLUG?) (* ;; "fetches the charsetinfo for charset CHARSET in fontdescriptor FONTDESC. If NIL, then creates the required charset." ) (* ;; "NOSLUG? means don't create an empty (slug) csinfo if the charset is not found, just return NIL") (OR (\GETBASEPTR (ffetch FONTCHARSETVECTOR of FONTDESC) (UNFOLD CHARSET 2)) (\CREATECHARSET CHARSET FONTDESC NOSLUG?)))) (PUTPROPS \CREATECSINFOELEMENT MACRO (NIL (\ALLOCBLOCK (FOLDHI (IPLUS \MAXTHINCHAR 3) WORDSPERCELL)))) (PUTPROPS \CREATEFONTCHARSETVECTOR MACRO (NIL (* ; "Allocates a block for the character set records") (\ALLOCBLOCK (ADD1 \MAXCHARSET) T))) (DEFMACRO \CREATEKERNELEMENT NIL (BQUOTE (CL:MAKE-ARRAY (IPLUS \MAXTHINCHAR 3) :ELEMENT-TYPE (QUOTE ( SIGNED-BYTE 16)) :INITIAL-ELEMENT 0))) (DEFMACRO \FSETLEFTKERN (LEFTKERNBLOCK INDEX KERNVALUE) (BQUOTE (CL:SETF (CL:AREF (\, LEFTKERNBLOCK) ( \, INDEX)) (\, KERNVALUE)))) (DEFMACRO \FGETLEFTKERN (LEFTKERNBLOCK CHAR8CODE) (BQUOTE (CL:AREF (\, LEFTKERNBLOCK) (\, CHAR8CODE))) ) (RPAQQ \MAXNSCHAR 65535) (CONSTANTS (\MAXNSCHAR 65535)) (PUTPROP (QUOTE FONT) (QUOTE IMPORTDATE) (IDATE "28-Jun-99 16:29:49")) (BLOCKRECORD KEYACTION ((* ;; "KEYACTION Table: For interpreting keystrokes. Stored as a 8-cell block of untyped pointer hunk storage." ) FLAGS (* ; "Flag byte per key# (one for down-transtion, 1 for up-.) to describe whether lockshifting occrrs, you ignore the transition, etc." ) CODES (* ; "Table of character codes generated by each key when no shift key is pressed.") SHIFTCODES (* ; "Table of character codes generated by each key when the shift key is pressed.") ARMED (* ; "Not sure...") INTERRUPTLIST (* ; "List of armed interrupts?") ALTGRAPHCODES (* ; "Table of codes to be generated when the ALT-GRAPH key is pressed.") DEADKEYLIST (* ; "Block of dead-key handlers, with the nominal up-transition fields filled by the shifted-case tables. Each %"table%" is an ALIST of orignal code => accented code. no entry means punt the accent.." )) FLAGS _ (\ALLOCBLOCK (FOLDHI (IPLUS \NKEYS \NKEYS) BYTESPERCELL)) CODES _ (\ALLOCBLOCK (FOLDHI ( PLUS \NKEYS \NKEYS) WORDSPERCELL)) SHIFTCODES _ (\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS) WORDSPERCELL )) ARMED _ (\ALLOCBLOCK (FOLDHI (ADD1 \MAXTHINCHAR) BITSPERCELL)) ALTGRAPHCODES _ (\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS) WORDSPERCELL)) DEADKEYLIST _ (\ALLOCBLOCK (PLUS \NKEYS \NKEYS \NKEYS \NKEYS) T) (CREATE (\ALLOCBLOCK 7 PTRBLOCK.GCT)) (TYPE? (AND (\BLOCKDATAP DATUM) (IGEQ (\#BLOCKDATACELLS DATUM) 5 ) (OR (NULL (FETCH (KEYACTION INTERRUPTLIST) OF DATUM)) (LISTP (FETCH INTERRUPTLIST OF DATUM))) ( \BLOCKDATAP (FETCH (KEYACTION FLAGS) DATUM)) (\BLOCKDATAP (FETCH (KEYACTION CODES) DATUM)) ( \BLOCKDATAP (FETCH (KEYACTION ARMED) DATUM))))) (RPAQQ \NKEYS 112) (CONSTANTS \NKEYS) (DEFOPTIMIZER KEYDOWNP (KEYNAME) (BQUOTE (\NEWKEYDOWNP (\KEYNAMETONUMBER (\, KEYNAME))))) (PUTPROPS XKEYDOWNP MACRO ((KEYNAME) (KEYDOWNP1 (\KEYNAMETONUMBER KEYNAME)))) (PUTPROPS KEYDOWNP1 MACRO (OPENLAMBDA (KEYNUMBER) (DECLARE (GLOBALVARS \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.UTILIN \EM.KBDAD4 \EM.KBDAD5)) (PROG NIL (RETURN (EQ 0 (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))))))) (PUTPROPS \NEWKEYDOWNP MACRO ((KEYNUMBER) (EQ 0 (\GETBASEBIT \LASTKEYSTATE KEYNUMBER)))) (GLOBALVARS \KEYBOARD.DEVICE \KEYBOARD.STREAM) (RPAQQ HARDCURSORHEIGHT 16) (RPAQQ HARDCURSORWIDTH 16) (CONSTANTS (HARDCURSORHEIGHT 16) (HARDCURSORWIDTH 16)) (ADDTOVAR GLOBALVARS LASTMOUSEX LASTMOUSEY LASTSCREEN LASTMOUSEBUTTONS LASTMOUSETIME LASTKEYBOARD) (PUTPROPS \SETMOUSEXY MACRO ((XPOS YPOS) (PROGN (SELECTC \MACHINETYPE (\DAYBREAK ( \DoveMisc.SetMousePosition XPOS YPOS)) (\MAIKO (SUBRCALL SETMOUSEXY XPOS YPOS)) (\DANDELION (do (PROGN (replace (IOPAGE NEWMOUSEX) of \IOPAGE with XPOS) (replace (IOPAGE NEWMOUSEY) of \IOPAGE with YPOS)) repeatuntil (ILESSP (fetch (IOPAGE NEWMOUSESTATE) of \IOPAGE) 32768)) (* ; "smash position until mouse says it is not busy") (replace (IOPAGE NEWMOUSEX) of \IOPAGE with XPOS) ( replace (IOPAGE NEWMOUSEY) of \IOPAGE with YPOS) (replace (IOPAGE NEWMOUSESTATE) of \IOPAGE with 32768 )) NIL) (PROGN (\PUTBASE \EM.MOUSEX 0 XPOS) (\PUTBASE \EM.MOUSEY 0 YPOS))))) (GLOBALVARS \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.REALUTILIN \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.KBDAD4 \EM.KBDAD5 \EM.DISPINTERRUPT \EM.DISPLAYHEAD \EM.CURSORBITMAP \MACHINETYPE \DEFAULTKEYACTION \COMMANDKEYACTION \CURRENTKEYACTION \PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY) (PUTPROP (QUOTE LLKEY) (QUOTE IMPORTDATE) (IDATE " 9-Apr-2000 16:28:23")) (DATATYPE PILOTBBT ((PBTDESTLO WORD) (PBTDESTHI WORD) (PBTDESTBIT WORD) (PBTDESTBPL SIGNEDWORD) ( PBTSOURCELO WORD) (PBTSOURCEHI WORD) (PBTSOURCEBIT WORD) (PBTSOURCEBPL SIGNEDWORD) (PBTWIDTH WORD) ( PBTHEIGHT WORD) (PBTFLAGS WORD) (NIL 5 WORD)) (BLOCKRECORD PILOTBBT ((NIL 7 WORD) (NIL BITS 4) ( PBTGRAYOFFSET BITS 4) (PBTGRAYWIDTHLESSONE BITS 4) (PBTGRAYHEIGHTLESSONE BITS 4) (NIL 2 WORD) ( 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)))))) (SYSTEM)) (DATATYPE \DISPLAYDATA (DDXPOSITION DDYPOSITION DDXOFFSET DDYOFFSET DDDestination DDClippingRegion DDFONT DDSlowPrintingCase DDWIDTHSCACHE DDOFFSETSCACHE DDCOLOR DDLINEFEED DDRightMargin DDLeftMargin DDScroll DDOPERATION DDSOURCETYPE (DDClippingLeft WORD) (DDClippingRight WORD) (DDClippingBottom WORD) (DDClippingTop WORD) (NIL WORD) (DDHELDFLG FLAG) (XWINDOWHINT XPOINTER) (DDPILOTBBT POINTER) DDXSCALE DDYSCALE DDCHARIMAGEWIDTHS DDEOLFN DDPAGEFULLFN DDTexture DDMICAXPOS DDMICAYPOS DDMICARIGHTMARGIN DDCHARSET (DDCHARSETASCENT WORD) (DDCHARSETDESCENT WORD) DDCHARHEIGHTDELTA (DDSPACEWIDTH WORD)) DDPILOTBBT _ (create PILOTBBT PBTDISJOINT _ T) DDLeftMargin _ 0 DDRightMargin _ SCREENWIDTH DDXPOSITION _ 0 DDYPOSITION _ 0 DDXOFFSET _ 0 DDYOFFSET _ 0 DDClippingRegion _ (create REGION) DDDestination _ ScreenBitMap DDXSCALE _ 1 DDYSCALE _ 1 DDTexture _ 0 (ACCESSFNS ((DDFOREGROUNDCOLOR ( PROG ((VAL (fetch (\DISPLAYDATA DDCOLOR) of DATUM))) (OR (FIXP VAL) (BITMAPP VAL) (AND (NULL VAL) 1) ( CAR VAL) (MAXIMUMCOLOR (BITSPERPIXEL (fetch (\DISPLAYDATA DDDestination) of DATUM)))))) ( DDBACKGROUNDCOLOR (OR (fetch (\DISPLAYDATA DDTexture) of DATUM) 0)))) (SYSTEM)) (RECORD DISPLAYSTATE (ONOFF)) (RECORD DISPLAYINFO (DITYPE DIWIDTH DIHEIGHT DIBITSPERPIXEL DIWSOPS)) (PUTPROPS \GETDISPLAYDATA MACRO (ARGS (COND ((CADR ARGS) (SUBPAIR (QUOTE (STRM STRMVAR)) ARGS (QUOTE ( \DTEST (fetch (STREAM IMAGEDATA) of (SETQ STRMVAR (\OUTSTREAMARG STRM))) (QUOTE \DISPLAYDATA))))) (T ( SUBST (CAR ARGS) (QUOTE STRM) (QUOTE (\DTEST (fetch (STREAM IMAGEDATA) of (\OUTSTREAMARG STRM)) (QUOTE \DISPLAYDATA)))))))) (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)))) (GLOBALVARS BITMASKARRAY NOTBITMASKARRAY 4BITMASKARRAY NOT4BITMASKARRAY) (RPAQQ WORDMASK 65535) (CONSTANTS (WORDMASK 65535)) (PUTPROPS \INVALIDATEDISPLAYCACHE MACRO ((DISPLAYDATA) (* This marks the character-printing caches of the displaystream as invalid. Needed when the font or Y position changes) (freplace (\DISPLAYDATA DDCHARSET) of DISPLAYDATA with MAX.SMALLP) (freplace (\DISPLAYDATA DDCHARSETASCENT) of DISPLAYDATA with MAX.SMALLP))) (PUTPROPS \DSPGETCHARWIDTH MACRO ((CHARCODE DD) (\FGETWIDTH (ffetch (\DISPLAYDATA DDWIDTHSCACHE) of DD ) CHARCODE))) (PUTPROPS \DSPGETCHARIMAGEWIDTH MACRO ((CHARCODE DD) (\FGETIMAGEWIDTH (ffetch (\DISPLAYDATA DDCHARIMAGEWIDTHS) of DD) CHARCODE))) (PUTPROPS \DSPGETCHAROFFSET MACRO ((CHARCODE DD) (\GETBASE (ffetch (\DISPLAYDATA DDOFFSETSCACHE) of DD ) CHARCODE))) (PUTPROPS \CONVERTOP MACRO ((OP) (* rrb "14-NOV-80 11:14") (* Only for alto bitblt !!) (SELECTQ OP ( replace 0 of NIL with NIL) (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 (BITMAP 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 (BBT SourceType Operation) (PROGN (replace (PILOTBBT PBTOPERATION) of BBT with (SELECTQ Operation (ERASE 1) (PAINT 2) (INVERT 3) 0)) (replace (PILOTBBT PBTSOURCETYPE) of BBT 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))) (PROGN (PUTPROPS \INSURETOPWDS DMACRO (OPENLAMBDA (DS) (OR (EQ DS \TOPWDS) (COND ((FMEMB ( DSPDESTINATION NIL DS) \SCREENBITMAPS) (\TOTOPWDS DS)))))) (PUTPROPS \INSURETOPWDS MACRO ((DS) (* For non-window implementations) (PROGN)))) (PUTPROPS .WHILE.TOP.DS. MACRO ((FIRST . REST) (PROG (DISPINTERRUPT SOFTCURSORUP) (* FIRST should be a displaystream and a variable. This macro may also take a soft cursor down, similar to the way .WHILE.CURSOR.DOWN. does, but only if FIRST's destination is the same as the soft cursor's destination. *) (COND (\SOFTCURSORP (SETQ SOFTCURSORUP (AND \SOFTCURSORUPP (EQ (DSPDESTINATION NIL FIRST) \CURSORDESTINATION))) (COND (SOFTCURSORUP (SETQ DISPINTERRUPT (\GETBASE \EM.DISPINTERRUPT 0)) ( \PUTBASE \EM.DISPINTERRUPT 0 0) (\SOFTCURSORDOWN))))) (\INSURETOPWDS FIRST) (PROGN . REST) (COND ( SOFTCURSORUP (\SOFTCURSORUPCURRENT) (\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT)))))) (PUTPROPS .WHILE.CURSOR.DOWN. MACRO ((FIRST . REST) (PROG (DISPINTERRUPT SOFTCURSORUP) (* This macro should wrap around any code that draws or bitblts directly from or to a screen bitmap. E.g. DRAWGRAYBOX in HLDISPLAY which puts up a shadow box during GETREGION. The purpose of this macro is that a soft (e.g. color) cursor's bits not be taken to be screen bits while FIRST & REST are done. *) (COND (\SOFTCURSORP (SETQ SOFTCURSORUP \SOFTCURSORUPP) (COND (SOFTCURSORUP (SETQ DISPINTERRUPT ( \GETBASE \EM.DISPINTERRUPT 0)) (\PUTBASE \EM.DISPINTERRUPT 0 0) (\SOFTCURSORDOWN))))) (PROGN FIRST . REST) (COND (SOFTCURSORUP (\SOFTCURSORUPCURRENT) (\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT)))))) (ADDTOVAR GLOBALVARS \TOPWDS) (DEFOPTIMIZER TTYDISPLAYSTREAM (&REST X) (COND ((NULL (CAR X)) (QUOTE \TERM.OFD)) (T (QUOTE IGNOREMACRO)))) (GLOBALVARS BELLCNT BELLRATE TTYBACKGROUNDFNS \DisplayStoppedForLogout \CARET.UP) (PUTPROPS \CHECKCARET MACRO ((X) (AND \CARET.UP (\CARET.DOWN X)))) (PUTPROPS \DSPTRANSFORMX MACRO ((X DD) (* transforms an x coordinate into the destination coordinate.) (IPLUS X (fetch (\DISPLAYDATA DDXOFFSET) of DD)))) (PUTPROPS \DSPTRANSFORMY MACRO ((Y DD) (* transforms an y coordinate into the destination coordinate.) (IPLUS Y (fetch (\DISPLAYDATA DDYOFFSET) of DD)))) (PUTPROPS \OFFSETBOTTOM MACRO ((X) (* gives the destination coordinate address of the origin.) (fetch (\DISPLAYDATA DDYOFFSET) of X))) (PUTPROPS \OFFSETLEFT MACRO ((DD) (* returns the x origin of display data destination coordinates.) ( fetch (\DISPLAYDATA DDXOFFSET) of DD))) (PUTPROPS DISPLAYINITIALIZEDP MACRO (NIL (* always initialized now) T)) (PUTPROPS DISPLAYSTARTEDP MACRO (NIL \DisplayStarted)) (GLOBALVARS \DisplayStarted \DisplayStreamsInitialized \DisplayInitialed WHOLEDISPLAY WHOLESCREEN SCREENWIDTH SCREENHEIGHT) (PUTPROP (QUOTE LLDISPLAY) (QUOTE IMPORTDATE) (IDATE "18-Apr-94 00:20:42")) (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 NUMBERP)))) ( SYSTEM)) (DATATYPE BITMAP ((BITMAPBASE POINTER) (BITMAPRASTERWIDTH WORD) (BITMAPHEIGHT WORD) (BITMAPWIDTH WORD) (BITMAPBITSPERPIXEL WORD)) BITMAPBITSPERPIXEL _ 1 (BLOCKRECORD BITMAP ((BitMapHiLoc WORD) ( BitMapLoLoc WORD)) (* ; "overlay initial pointer")) (SYSTEM)) (BLOCKRECORD BITMAPWORD ((BITS WORD)) (SYSTEM)) (RECORD POSITION (XCOORD . YCOORD) (TYPE? (AND (LISTP DATUM) (NUMBERP (CAR DATUM)) (NUMBERP (CDR DATUM )))) (SYSTEM)) (DATATYPE CURSOR (CUIMAGE CUMASK CUHOTSPOTX CUHOTSPOTY CUDATA) (ACCESSFNS ((CUBITSPERPIXEL (fetch ( BITMAP BITMAPBITSPERPIXEL) of (fetch (CURSOR CUIMAGE) of DATUM))))) (SYSTEM)) (RECORD MOUSEEVENT (MOUSEX MOUSEY MOUSEBUTTONS KEYBOARD MOUSETIME) (SYSTEM)) (RECORD SCREENREGION (SCREEN . REGION) (SUBRECORD REGION) (TYPE? (AND (LISTP DATUM) (type? SCREEN (CAR DATUM)) (type? REGION (CDR DATUM)))) (SYSTEM)) (RECORD SCREENPOSITION (SCREEN . POSITION) (SUBRECORD POSITION) (TYPE? (AND (LISTP DATUM) (type? SCREEN (CAR DATUM)) (type? POSITION (CDR DATUM)))) (SYSTEM)) (PUTPROPS CURSORBITMAP MACRO (NIL CursorBitMap)) (RPAQQ HARDCURSORHEIGHT 16) (RPAQQ HARDCURSORWIDTH 16) (CONSTANTS (HARDCURSORHEIGHT 16) (HARDCURSORWIDTH 16)) (ADDTOVAR GLOBALVARS CursorBitMap) (ARRAYRECORD POLYNOMIAL (A B C D) (CREATE (ARRAY 4 (QUOTE FLOATP))) (SYSTEM)) (RECORD SPLINE (%#KNOTS SPLINEX SPLINEY SPLINEDX SPLINEDY SPLINEDDX SPLINEDDY SPLINEDDDX SPLINEDDDY)) (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)))))))) (ADDTOVAR GLOBALVARS SCREENHEIGHT SCREENWIDTH ScreenBitMap) (RPAQQ BLACKSHADE 65535) (RPAQQ WHITESHADE 0) (CONSTANTS (BLACKSHADE 65535) (WHITESHADE 0)) (RPAQQ GRAYSHADE 43605) (ADDTOVAR GLOBALVARS GRAYSHADE) (RECORD HLS (HUE LIGHTNESS SATURATION)) (RECORD RGB (RED GREEN BLUE)) (PUTPROP (QUOTE ADISPLAY) (QUOTE IMPORTDATE) (IDATE "15-Sep-94 17:07:04")) (ADDTOVAR SYSSPECVARS \INTERRUPTABLE) (PUTPROPS UNINTERRUPTABLY INFO EVAL) (PUTPROPS UNINTERRUPTABLY DMACRO ((X . Y) ((LAMBDA (\INTERRUPTABLE) (PROGN X . Y)) NIL))) (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 ")")))) (BLOCKRECORD INTERRUPTSTATE ((* ;; "This is the structure used to communicate between the emulator and Lisp re interrupts. There is a bit per interrupt type, plus space for the character code that caused a keyboard interrupt." ) (* ;; "This must match the INTSTAT definition in lispemul.h") (* ;; "PENDING-INTERRUPT FLAGS:") ( LOGMSGSPENDING FLAG) (* ; " Log/Console msgs need printing.") (ETHERINTERRUPT FLAG) (* ; "Ether packet read finished.") (IOINTERRUPT FLAG) (GCDISABLED FLAG) (* ; "No mroe room in GC tables.") (VMEMFULL FLAG) (* ; "VMEM is full!!") (STACKOVERFLOW FLAG) (* ; "Stack overflowed.") (STORAGEFULL FLAG) (* ; "Ran out of storage, atoms, etc.") (WAITINGINTERRUPT FLAG) (* ;; "INTERRUPTS-IN-PROCESS MASK:") (P-LOGMSGSPENDING FLAG) (* ; " Log/Console msgs need printing.") ( P-ETHERINTERRUPT FLAG) (* ; "Ether packet read finished.") (P-IOINTERRUPT FLAG) (P-GCDISABLED FLAG) (* ; "No mroe room in GC tables.") (P-VMEMFULL FLAG) (* ; "VMEM is full!!") (P-STACKOVERFLOW FLAG) (* ; "Stack overflowed.") (P-STORAGEFULL FLAG) (* ; "Ran out of storage, atoms, etc.") (P-WAITINGINTERRUPT FLAG) (INTCHARCODE WORD)) (BLOCKRECORD INTERRUPTSTATE ((* ;; "Alternative view of the structure:") ( PENDING BITS 8) (* ; "Pending-interrupt flags") (IN-PROGRESS BITS 8) (* ; "Mask to prevent re-interrupt for an interrupt in progress") (NIL WORD)))) (PUTPROPS \TAKEINTERRUPT DMACRO ((PREFORM POSTFORM) (DECLARE (GLOBALVARS \PENDINGINTERRUPT)) (COND (( AND \PENDINGINTERRUPT (INTERRUPTABLE~=NILUPTHESTACK)) PREFORM ((LAMBDA (\INTERRUPTABLE) ( \CALLINTERRUPTED)) T) POSTFORM)))) (PUTPROP (QUOTE AINTERRUPT) (QUOTE IMPORTDATE) (IDATE "17-Sep-92 10:42:38")) (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 ")")))) (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")))) (GLOBALVARS \ETHERWAIT1 \ETHERTIMEOUT \MAXETHERTRIES PUPTRACEFLG LOGINPASSWORDS) (GLOBALVARS PUPTRACEFILE PUPONLYTYPES PUPIGNORETYPES PUPPRINTMACROS) (RPAQQ \PUPOVLEN 22) (RPAQQ \MAX.PUPLENGTH 532) (RPAQQ \TIME.GETPUP 5) (CONSTANTS (\PUPOVLEN 22) (\MAX.PUPLENGTH 532) (\TIME.GETPUP 5)) (PUTPROPS PUPPRINTMACROS VARTYPE ALIST) (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 "19-Jan-93 11:14:09")) (PUTPROPS UNLESSRDSYS MACRO ((NORMAL RDSYS) NORMAL)) (PUTPROPS UNLESSINEW MACRO ((NORMAL I-NEW) NORMAL)) (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 "27-Apr-94 15:43:27")) (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 "15-Mar-94 10:48:02")) (PUTPROPS .COPYKEYDOWNP. MACRO (NIL (OR (KEYDOWNP (QUOTE LSHIFT)) (KEYDOWNP (QUOTE RSHIFT)) (KEYDOWNP (QUOTE COPY))))) (PUTPROPS WSOP MACRO (ARGS (LET ((METHOD (CADR (CAR ARGS))) (DISPLAY (CADR ARGS)) (OTHERARGS (CDDR ARGS))) (BQUOTE (SPREADAPPLY* (fetch (WSOPS (\, METHOD)) of (fetch (FDEV WINDOWOPS) of (\, DISPLAY))) (\, DISPLAY) (\,@ OTHERARGS)))))) (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 WINDOWOP DMACRO (ARGS (LET ((OPNAME (CAR ARGS)) (METHOD-DEVICE (CADR ARGS)) (TAIL (CDDR ARGS ))) (COND ((AND (LISTP OPNAME) (EQ (CAR OPNAME) (QUOTE QUOTE))) (BQUOTE (SPREADAPPLY* (fetch (SCREEN ( \, (CADR OPNAME))) of (\, METHOD-DEVICE)) (\, METHOD-DEVICE) (\,@ TAIL)))) (T (ERROR "OPNAME not quoted: " OPNAME)))))) (RPAQQ MinWindowWidth 26) (RPAQQ MinWindowHeight 16) (CONSTANTS (MinWindowWidth 26) (MinWindowHeight 16)) (DATATYPE WINDOW (DSP (* ; "The display stream you use to actually printto the window.") NEXTW (* ; "Next window in the open-window list") SAVE (* ; "Saved image from anything this window's on top of") REG (* ; "Screen region this window occupies") BUTTONEVENTFN (* ; "FN called when left/middle mouse button goes up/down") RIGHTBUTTONFN (* ; "FN called when right mouse button goes up/down") CURSORINFN (* ; "Fn called when mouse enters window" ) CURSOROUTFN (* ; "Called when mouse leaves window") CURSORMOVEDFN (* ; "Called when mouse moves in window") REPAINTFN (* ; "Redisplay part of thie window") RESHAPEFN (* ; "Called when window is reshaped") EXTENT (* ; "Scrolling limits") USERDATA (* ; "Proplist to hold other window properites") VERTSCROLLREG (* ; "Region of vert scroll bar") HORIZSCROLLREG (* ; "Tegion of horiz scroll bar") SCROLLFN (* ; "Fn to scroll this window") VERTSCROLLWINDOW (* ; "Vert scroll bar") HORIZSCROLLWINDOW (* ; "Horiz scroll bar") CLOSEFN (* ; "Called at close time") MOVEFN (* ; "Called when window is moved") WTITLE (* ; "Window's title string, if any") NEWREGIONFN (* ; "Called to get new window shape") WBORDER (* ; "Window border-width, in pixels") PROCESS (* ; "Medley process associated with this window") WINDOWENTRYFN (* ; "Fn to call when kbd focus is switched here") SCREEN (* ; "Screen this window appears on") (NATIVE-HANDLE FIXP) (* ; "Uniterpreted place for native window to store a C pointer to its private info") (NATIVE-INFO1 FIXP) ( * ; "Reserved in case the pointer must be 64 bits") (NATIVE-W1 WORD) (* ; "Word for use by native handler") (NATIVE-W2 WORD) (* ; "Word for use by native handler") (NATIVE-P1 POINTER) (* ; "Lisp pointer for use by native handler")) BUTTONEVENTFN _ (FUNCTION TOTOPW) WBORDER _ WBorder WINDOWENTRYFN _ (FUNCTION GIVE.TTY.PROCESS) (SYSTEM)) (DATATYPE SCREEN (SCONOFF SCDESTINATION SCWIDTH SCHEIGHT SCTOPW SCTOPWDS SCTITLEDS SCFDEV SCDS SCDATA (* ;; "Space for native window manager interface to use.") (HANDLE FIXP) (* ; "Handle for emulator to store info about display for C code use.") (HANDLE2 FIXP) (* ; "Reserved in case HANDLE needs to be 64 bits on the C side.") (NATIVE-INFO POINTER) (* ; "POINTER for the private use of the emulator window code") NATIVETYPE (* ; "Symbol to tell what kind of native window system we're using.") (* ;; "- - - Functional interface to screen management - - -") WINIMAGEOPS (* ; "IMAGEOPS to be used in display streas on this kind of screen") WINFDEV (* ; "FDEV for display streams on this screen") CREATEWFN (* ; "Create a window") OPENWFN (* ; "Open a window") CLOSEWFN (* ; "Close a window") MOVEWFN (* ; "Move a window") RELMOVEWFN (* ; "Move window, relative") SHRINKWFN (* ; "Shrink window to icon") EXPANDWFN (* ; "Expand icon to window") SHAPEWFN (* ; "Reshape a window") REDISPLAYFN (* ; "Redisplay (part of) a window") GETWINDOWPROPFN (* ; "Get window property value") PUTWINDOWPROPFN (* ; "Set window property value") BURYWFN (* ; "Move window behind all others") TOTOPWFN (* ; "Move iwindow in front of all others") IMPORTWFN (* ; "Take a native window and save its state internally") EXPORTWFN (* ; "Take a saved window state and open it on this screen, filling in screen and methods as needed.") DESTROYFN (* ; "Destroy this window, for GC finaliszation") SETCURSORFN (* ; "Set the cursor for this window.") PROMPTW (* ; "The prompt window for this screen") SHOWGCFN (* ; "Show GC indication; called with ON/OFF arg, t=>show gcing status, NIL=>turn off GC indicator.") DSPCREATEFN (* ; "Create a displaystream on this screen.") BBTTOWIN (* ; "BITBLT from a lisp bitmap to a window") BBTFROMWIN (* ; "BITBLT from a window to a lisp bitmap") BBTWINWIN (* ; "BITBLT from a window to another window.") SCCURSOR (* ; "CURSOR that's in effect for this screen by default.") SCKEYBOARD (* ; "Something about which keyboard we're receiving from.") SCDEPTH (* ; "# of bits per pixel on the screen. THIS WILL REPLACE SCBITSPERPIXEL ASAP.") SCCLOSEDOWN (* ; "Close down this screen cleanly, saving window state.") SCCLOSESCREEN (* ; "Close down thie screen cleanly, no state saving.") SCREOPEN (* ; "Reopen this screen?") SCCARETFLASH (* ; "Function to flash thecaret.") SCGETSCREENPOSITION (* ; "GETSCREENPOSITION") SCGETBOXSCREENPOSITION (* ; "GETBOXPOSITION") SCGETSCREENREGION (* ; "GETREGION") SCMOVEPOINTER (* ; "\CURSORPOSITION")) SCONOFF _ (QUOTE OFF) (ACCESSFNS ((SCBITSPERPIXEL (COND ((fetch (SCREEN SCDESTINATION) of DATUM) (fetch (BITMAP BITMAPBITSPERPIXEL) of (fetch (SCREEN SCDESTINATION) of DATUM) )) (T 1))) (SCREGION (create REGION LEFT _ 0 BOTTOM _ 0 WIDTH _ (fetch (SCREEN SCWIDTH) of DATUM) HEIGHT _ (fetch (SCREEN SCHEIGHT) of DATUM))))) (SYSTEM)) (GLOBALVARS WINDOWUSERFORMS ENDOFWINDOWUSERFORMS PROMPTWINDOW) (PUTPROP (QUOTE WINDOW) (QUOTE IMPORTDATE) (IDATE " 9-Apr-2000 17:36:29")) (PUTPROPS NNLITATOM MACRO (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 ) (NIL (QUOTE MILLISECONDS)) (\CanonicalizeTimerUnits X)))) (PUTPROPS \MACRO.EVAL DMACRO (Z (PROG ((X (EXPANDMACRO (CAR Z) T))) (if (EQ X (CAR Z)) then (ERROR "No macro property -- \MACRO.EVAL" X) else (RETURN (EVAL X)))))) (DEFOPTIMIZER \MACRO.MX (FORM) FORM) (PUTPROP (QUOTE MACROAUX) (QUOTE IMPORTDATE) (IDATE "16-May-90 20:26:31")) (RPAQQ MASK0WORD1'S 32767) (RPAQQ MASK1WORD0'S 32768) (RPAQQ MASKWORD1'S 65535) (RPAQQ MASKHALFWORD1'S 255) (RPAQQ BITSPERHALFWORD 8) (CONSTANTS MASK0WORD1'S MASK1WORD0'S MASKWORD1'S MASKHALFWORD1'S BITSPERHALFWORD) (PUTPROPS EQZEROP MACRO ((X) (EQ 0 X))) (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 .XUNBOX. MACRO ((X HX LX) (until (SETQ LX (SELECTC (NTYPX X) (\SMALLP (COND ((IGEQ X 0) ( 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 .XLLSH. MACRO ((HI LO N) (if (IGEQ N BITSPERWORD) then (* ; "Jump 16 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 .XLLSH1. MACRO ((HI LO) (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 .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 .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 .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 \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 (EQ 0 (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 (EQ 0 (LOGAND \BitMask \Byte)) then (NOT (EQ 0 VAL)) else (EQ 0 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 "16-May-90 11:46:37")) (RPAQQ \MAXFILEPAGE 65534) (CONSTANTS \MAXFILEPAGE) (PUTPROP (QUOTE LLFAULT) (QUOTE IMPORTDATE) (IDATE " 2-Jan-93 12:26:58")) (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) (RPAQQ \DOVE.RCLKMILLISECOND 63) (RPAQQ \DOVE.RCLKSECOND 62500) (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) (\DOVE.RCLKMILLISECOND 63) (\DOVE.RCLKSECOND 62500)) (PUTPROPS ALTO.TO.LISP.DATE MACRO ((DATE) (LOGXOR DATE -2147483648))) (PUTPROPS LISP.TO.ALTO.DATE MACRO ((DATE) (LOGXOR DATE -2147483648))) (PUTPROP (QUOTE LLTIMER) (QUOTE IMPORTDATE) (IDATE "16-May-90 20:13:11")) (DATATYPE SYSQUEUE ((NIL BYTE) (SYSQUEUEHEAD POINTER) (NIL BYTE) (SYSQUEUETAIL POINTER))) (BLOCKRECORD QABLEITEM ((NIL BITS 4) (QLINK POINTER) (* ; "Link to next thing in queue always in first pointer of datum, independent of what the datum is")) ( BLOCKRECORD QABLEITEM ((NIL BITS 4) (LINK POINTER) (* ; "Let's also be able to call it a LINK")))) (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)) (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") (EPRECEIVING FLAG) (* ; "True when a packet has been seen at the head of the network's input queue at least once") (NIL BITS 6 ) (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 WORD) (EPTIMESTAMP FIXP) (* ; "Gets RCLK value when transmitted/received") (EPREQUEUEFN POINTER) (* ; "FN to perform requeueing") ( NIL 4 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)))) (RPAQQ \EPT.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 \EPT.XIP \3MBTYPE.XIP \10MBTYPE.XIP \EPT.10TO3 \3MBTYPE.10TO3 \EPT.UNKNOWN) (RPAQQ \NULLCHECKSUM 65535) (CONSTANTS (\NULLCHECKSUM 65535)) (DATATYPE NDB ((NETTYPE BYTE) (* ; "10 or 3 for now") (NDBNEXT POINTER) (* ; "Link to next NDB") ( NDBPUPNET# BYTE) (* ; "Pup number of this net. May be different from NS net number, though not in Xerox world") (NDBNSNET# POINTER) (* ; "Can be 32-bits, so might as well leave its box around") (NDBTASK# BYTE) (* ; "Task # of this network") (NDBBROADCASTP POINTER) (* ; "Function that returns true if packet is of broadcast type") (NDBPUPHOST# BYTE) (* ; "My pup address on this net. NS address is global to all nets, so not needed here") (NDBTRANSMITTER POINTER) (* ; "(NDB PACKET) -- fn to send a raw packet on this net. returns NIL on failure") (NIL BYTE) (NDBENCAPSULATOR POINTER) (* ; "(NDB PACKET HOST LENGTH TYPE) -- fn to encapsulate and send a higher-level packet on this net ") ( NDBCSB POINTER) (* ; "Pointer to CSB for this network") (NDBIQLENGTH BYTE) (NDBIQ POINTER) (* ; "Queue of empty packets for receiver") (NDBTQ POINTER) (* ; "Queue of packets to transmit") ( NDBTRANSLATIONS POINTER) (* ; "Cache of translations, 3:10 or 10:3 according to network") ( NDBETHERFLUSHER POINTER) (* ; "Turns off this ether. Args NDB") (NDBWATCHER POINTER) (NDBCANHEARSELF POINTER) (* ; "True if receiver can hear packets sent by transmitter") (NDBIPNET# POINTER) (NDBIPHOST# POINTER) (NDBPUPTYPE WORD) (* ; "The packet encapsulation of PUP on this net") (NIL WORD) (NIL POINTER) (* ; "Spares"))) (RECORD ROUTING (RTNET# RTHOPCOUNT RTGATEWAY# RTNDB RTTIMER RTRECENT)) (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 "19-Jan-93 10:49:30")) (RECORD BRUSH (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR) BRUSHSHAPE _ (QUOTE ROUND) BRUSHSIZE _ 1) (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))))) (DATATYPE IMAGEOPS (IMAGETYPE IMCLOSEFN IMXPOSITION IMYPOSITION IMFONT IMLEFTMARGIN IMRIGHTMARGIN IMLINEFEED IMDRAWLINE IMDRAWCURVE IMDRAWCIRCLE IMDRAWELLIPSE IMFILLCIRCLE IMBLTSHADE IMBITBLT IMNEWPAGE IMMOVETO IMSCALE IMTERPRI IMTOPMARGIN IMBOTTOMMARGIN IMSPACEFACTOR IMFONTCREATE IMOPERATION IMCOLOR IMSTRINGWIDTH IMCHARWIDTH IMCHARWIDTHY IMBACKCOLOR IMBITMAPSIZE IMCLIPPINGREGION IMRESET IMDRAWPOLYGON IMFILLPOLYGON IMSCALEDBITBLT IMWRITEPIXEL IMCHARSET IMROTATE IMDRAWARC IMTRANSLATE IMSCALE2 IMPUSHSTATE IMPOPSTATE IMDEFAULTSTATE IMDRAWPOINT IMBLTCHAR IMXOFFSET IMYOFFSET) IMCLOSEFN _ (FUNCTION NILL) IMTERPRI _ (FUNCTION (LAMBDA (STREAM) (\OUTCHAR STREAM (CHARCODE EOL)))) IMNEWPAGE _ ( FUNCTION (LAMBDA (STREAM) (\OUTCHAR STREAM (CHARCODE ^L)))) IMOPERATION _ (FUNCTION NILL) IMCOLOR _ ( FUNCTION NILL) IMCLIPPINGREGION _ (FUNCTION NILL) IMRESET _ (FUNCTION NILL) IMBACKCOLOR _ (FUNCTION NILL) IMSTRINGWIDTH _ (FUNCTION (LAMBDA (STREAM STR RDTBL) (STRINGWIDTH STR (DSPFONT NIL STREAM) RDTBL RDTBL))) IMCHARWIDTH _ (FUNCTION (LAMBDA (STREAM CHARCODE) (CHARWIDTH CHARCODE (DSPFONT NIL STREAM))) ) IMMOVETO _ (FUNCTION (LAMBDA (STREAM X Y) (IMAGEOP (QUOTE IMXPOSITION) STREAM STREAM X) (IMAGEOP ( QUOTE IMYPOSITION) STREAM STREAM Y))) IMBITMAPSIZE _ (FUNCTION (LAMBDA (STREAM BITMAP DIMENSION) ( SELECTQ DIMENSION (WIDTH (TIMES (DSPSCALE NIL STREAM) (BITMAPWIDTH BITMAP))) (HEIGHT (TIMES (DSPSCALE NIL STREAM) (BITMAPHEIGHT BITMAP))) (NIL (CONS (TIMES (DSPSCALE NIL STREAM) (BITMAPWIDTH BITMAP)) ( TIMES (DSPSCALE NIL STREAM) (BITMAPHEIGHT BITMAP)))) (\ILLEGAL.ARG DIMENSION)))) IMWRITEPIXEL _ ( FUNCTION NILL) IMCHARSET _ (FUNCTION NILL) IMXPOSITION _ (FUNCTION NILL) IMYPOSITION _ (FUNCTION NILL) IMFONT _ (FUNCTION NILL) IMLEFTMARGIN _ (FUNCTION NILL) IMRIGHTMARGIN _ (FUNCTION NILL) IMLINEFEED _ (FUNCTION NILL) IMDRAWLINE _ (FUNCTION NILL) IMDRAWCURVE _ (FUNCTION NILL) IMDRAWCIRCLE _ (FUNCTION NILL) IMDRAWELLIPSE _ (FUNCTION NILL) IMFILLCIRCLE _ (FUNCTION NILL) IMBLTSHADE _ (FUNCTION NILL) IMBITBLT _ (FUNCTION NILL) IMSCALE _ (FUNCTION NILL) IMTOPMARGIN _ (FUNCTION NILL) IMBOTTOMMARGIN _ ( FUNCTION NILL) IMSPACEFACTOR _ (FUNCTION NILL) IMFONTCREATE _ (FUNCTION NILL) IMCHARWIDTHY _ (FUNCTION NILL) IMDRAWPOLYGON _ (FUNCTION \DRAWPOLYGON.GENERIC) IMDRAWPOINT _ (FUNCTION \DRAWPOINT.GENERIC) IMFILLPOLYGON _ (FUNCTION NILL) IMSCALEDBITBLT _ (FUNCTION NILL) IMROTATE _ (FUNCTION NILL) IMDRAWARC _ (FUNCTION NILL) IMTRANSLATE _ (FUNCTION NILL) IMPUSHSTATE _ (FUNCTION NILL) IMPOPSTATE _ (FUNCTION NILL) IMSCALE2 _ (FUNCTION NILL) IMDEFAULTSTATE _ (FUNCTION NILL) IMBLTCHAR _ (FUNCTION \MEDW.BLTCHAR) IMXOFFSET _ (FUNCTION \MEDW.XOFFSET) IMYOFFSET _ (FUNCTION \MEDW.YOFFSET)) (GLOBALVARS \NOIMAGEOPS) (PUTPROP (QUOTE IMAGEIO) (QUOTE IMPORTDATE) (IDATE "28-Jun-99 16:33:59")) (DATATYPE PROCESS ((PROCFX0 WORD) (* ; "= \STACKHI to make this look like a STACKP") (PROCFX WORD) (* ; "Stack pointer to this context when it is asleep") (PROCSTATUS BYTE) (* ; "Running or waiting") ( PROCNAME POINTER) (* ; "Name for convenience in type-in reference") (PROCPRIORITY BYTE) (* ; "Priority level, 0-4. Not currently used.") (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) (PROCNEVERSTARTED FLAG) (NIL FLAG) (NIL FLAG) (NIL FLAG) ( 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") ( PROCDRIBBLEOUTPUT POINTER) (* ; "Binding for *DRIBBLE-OUTPUT* 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) (* ; "If DON'T, can't logout") (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") (PROCHARDRESETINFO POINTER) (* ; "HARDRESET stores info about unwind-protect cleanups here") (PROCRESTARTFORM POINTER) (* ; "use this instead of PROCFORM when restarting") (PROCOLDTTYPROC POINTER) (* ; "Process that had the tty when we got it") (NIL POINTER) (* ; "For expansion")) PROCTIMERBOX _ ( CREATECELL \FIXP) PROCFX0 _ \STACKHI) (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)))))))) (GLOBALVARS \RUNNING.PROCESS \TTY.PROCESS \PROC.RESTARTME \PROC.RESETME \PROC.ABORTME) (PUTPROP (QUOTE PROC) (QUOTE IMPORTDATE) (IDATE "17-Jun-99 21:58:52")) (PUTPROPS \BACKCHAR MACRO (OPENLAMBDA (STREAM) (* ; "Backs up over an NS character") (\BACKNSCHAR STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256)))) (PUTPROPS \BACKNSCHAR MACRO ((ST SHIFTEDCHARSET COUNTERVAR) (COND ((\XCCSP ST) (\BACKXCCSCHAR ST SHIFTEDCHARSET COUNTERVAR)) (T (COND ((QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR ( CL:FUNCALL (ffetch (STREAM BACKCHARFN) of ST) ST T)))) (T (CL:FUNCALL (ffetch (STREAM BACKCHARFN) of ST) ST NIL))))))) (PUTPROPS \CHECKEOLC MACRO (OPENLAMBDA (CH EOLC STREAM PEEKBINFLG COUNTERVAR) (* ;; "Subtracts number of bytes read from COUNTERVAR, which may be NIL. In fact, should be NIL if PEEKBINFLG is T." ) (SELCHARQ CH (CR (SELECTC EOLC (CR.EOLC (CHARCODE EOL)) (CRLF.EOLC (COND (PEEKBINFLG (* ;; "T from PEEKC, compile-time constant. In this case, must leave the fileptr where it was, except for possibly advancing over character set shifts" ) (COND ((EQ (CHARCODE LF) (UNINTERRUPTABLY (\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256)) (* ;; "Read the NS CR. We know that there aren't any font-shift characters in front of the CR, because they would have already been read by the \NSPEEK that got the CR character. Since we are going to NS back the CR character, we don't need to update the counter variable" ) (PROG1 (\PEEKBIN STREAM T) (* ;; "LF must be in next BYTE after NS CR, regardless of coding. Character-set shifting bytes can't intervene. Then we back up over the CR that was \NSINed above." ) (\BACKNSCHAR STREAM)))) (CHARCODE EOL)) (T (CHARCODE CR)))) ((EQ (CHARCODE LF) (\PEEKBIN STREAM T)) (\BIN STREAM) (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (SUB1 COUNTERVAR))) (CHARCODE EOL)) (T ( CHARCODE CR)))) (CHARCODE CR))) (LF (COND ((EQ EOLC LF.EOLC) (CHARCODE EOL)) (T (CHARCODE LF)))) CH))) (PUTPROPS \INCHAR MACRO (OPENLAMBDA (STREAM COUNTERVAR) (* ; "returns a 16 bit character code") ( \CHECKEOLC (\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256) NIL COUNTERVAR) (FFETCH EOLCONVENTION OF STREAM) STREAM NIL COUNTERVAR))) (PUTPROPS \INCCODE MACRO (OPENLAMBDA (STREAM COUNTERVAR) (* ; "returns a 16 bit character code") ( \CHECKEOLC (\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256) NIL COUNTERVAR) (ffetch EOLCONVENTION of STREAM) STREAM NIL COUNTERVAR))) (PUTPROPS \PEEKCCODE MACRO (OPENLAMBDA (STREAM NOERROR) (\CHECKEOLC (\NSPEEK STREAM (UNFOLD ( ACCESS-CHARSET STREAM) 256) NIL NOERROR) (ffetch EOLCONVENTION of STREAM) STREAM T))) (PUTPROPS \NSIN MACRO ((ST SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR) (* ;;; "Dispatches to the appropriate character code decoder. If you want to support a new character encoding format, you have to write a decoder and add it here." ) (COND ((\XCCSP ST) (\XCCSIN ST SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR)) (T (COND ((QUOTE COUNTERVAR) (CL:MULTIPLE-VALUE-BIND (CODE NUM) (CL:FUNCALL (ffetch (STREAM INCCODEFN) of ST) ST T) (AND NUM (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR NUM))) CODE)) (T (CL:FUNCALL (ffetch (STREAM INCCODEFN) of ST) ST NIL))))))) (PUTPROPS \NSPEEK MACRO ((ST SHIFTEDCSET SHIFTEDCSETVAR NOERROR COUNTERVAR) (* ;;; "Dispatches to the appropriate character code decoder. If you want to support a new character encoding format, you have to write a decoder and add it here." ) (COND ((\XCCSP ST) (\XCCSPEEK ST (UNFOLD (ACCESS-CHARSET ST) 256) NIL NOERROR)) (T (COND ((QUOTE COUNTERVAR) (CL:MULTIPLE-VALUE-BIND (CODE NUM) (CL:FUNCALL (ffetch (STREAM PEEKCCODEFN) of ST) ST NOERROR T) (AND NUM (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR NUM))) CODE)) (T (CL:FUNCALL (ffetch ( STREAM PEEKCCODEFN) of ST) ST NOERROR NIL))))))) (PUTPROPS NUMERIC-CHARSET MACRO (= . ACCESS-CHARSET)) (PUTPROPS \CONV.JIS.TO.XCCS MACRO (OPENLAMBDA (KU TEN) (* ;;; "Some character code is not equivalent between JIS and XCCS. In such case, we have to convert the character to corresponding XCCS." ) (COND ((\NOT.EQUIVALENT.TO.XCCS KU) (\DO.CONV.JIS.TO.XCCS KU TEN)) (T (LOGOR (UNFOLD KU 256) TEN)))) ) (PUTPROPS \DO.CONV.JIS.TO.XCCS MACRO ((KU TEN) (* ;;; " Convert a JIS code divided into KU (high 8 bit) and TEN (low 8 bit) to an corresponding XCCS code.") (COND ((\INVALID.TENP TEN) *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (SELECTQ KU ((33 34 38) (* ; "1, 2 and 6 KU") (LET* ((CONVTABLE (\EXTARACT.CONV.TABLE KU)) (SET (\EXTRACT.SET TEN CONVTABLE)) (CODE (\EXTRACT.CODE TEN CONVTABLE))) (COND ((NEQ SET 255) (LOGOR (UNFOLD SET 256) CODE)) (T (COND ((EQ CODE 255) (* ; "Not defined in JIS.") *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (* ; "Defined in JIS but the displayable font is not assigned in the corresponding code in XCCS.") (COND ( *REPLACE-NO-FONT-CODE* *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (\EXTRACT.NO.FONT.CODE (LOGOR (UNFOLD KU 256) TEN)))))))))) (35 (* ; "3 KU") (* ; "Alpha numeric codes are all defined as single byte codes in XCCS.") TEN) (40 (* ; "8 KU") (COND ((< 0 TEN 33) (COND (*REPLACE-NO-FONT-CODE* *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (\EXTRACT.NO.FONT.CODE ( LOGOR KU TEN))))) (T *DEFAULT-NOT-CONVERTED-FAT-CODE*))) (116 (* ; "84 KU") (COND ((< 0 TEN 5) (LOGOR 29952 TEN)) (T *DEFAULT-NOT-CONVERTED-FAT-CODE*))) (117 (* ; "85 KU") (COND ((< 0 TEN 28) (LOGOR 29696 TEN)) (T *DEFAULT-NOT-CONVERTED-FAT-CODE*))) *DEFAULT-NOT-CONVERTED-FAT-CODE*))))) (PUTPROPS \CONV.XCCS.TO.JIS MACRO (OPENLAMBDA (OUTSTREAM CC) (* ;;; "Returns JIS code corresponding to XCCS charcode. Handle HANKAKU as well as ZENKAKU. If OUTSTREAM wants to convert ZENKAKUKANA to HANKAKUKANA, do so. Never returns two byte charcode for alpha-numeric character, they are all treated as single byte characode." ) (OR (COND ((\ASCIIP CC) CC) ((\NOT.EQUIVALENT.TO.JIS CC) (\DO.CONV.XCCS.TO.JIS CC)) (( \CONV.HANKAKU.TO.ZENKAKUP OUTSTREAM) (* ; "ZENKAKUKANA comes here, because their charcodes are equiavalent to JIS.") (\CONV.ZENKAKU.KANA CC)) (T CC)) CC))) (PUTPROPS \DO.CONV.XCCS.TO.JIS MACRO ((CC) (GETHASH CC *XCCS-TO-JIS-CONV-TABLE*))) (PUTPROPS \ASCIIP MACRO (OPENLAMBDA (CC) (AND (EQ (FOLDLO CC 256) 0) (< (LOGAND CC 255) 128)))) (PUTPROPS \NOT.EQUIVALENT.TO.JIS MACRO (OPENLAMBDA (CC) (OR (EQ (FOLDLO CC 256) 0) (EQ (FOLDLO CC 256) 33) (EQ (FOLDLO CC 256) 34) (EQ (FOLDLO CC 256) 38) (EQ (FOLDLO CC 256) 40) (EQ (FOLDLO CC 256) 239) (EQ (FOLDLO CC 256) 241)))) (PUTPROPS \CONV.HANKAKU.TO.ZENKAKUP MACRO ((OUTSTREAM) (STREAMPROP OUTSTREAM :HTOZP))) (PUTPROPS \CONV.ZENKAKU.KANA MACRO ((CHAR) (GETHASH CHAR *ZENKAKU-TO-HANKAKU-CONV-TABLE*))) (PUTPROPS \XCCSIN MACRO ((STREAM SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR) (* ;;; "returns a 16 bit character code. SHIFTEDCSET is STREAM's char set left shifted 8, SHIFTEDCSETVAR if non-NIL is the variable to set if char set changes. COUNTERVAR if non-NIL is decremented by number of bytes read. Doesn't do EOL conversion -- \INCHAR and \INCCODE do that." ) (LET ((CHAR (\BIN STREAM)) SCSET) (COND ((EQ CHAR NSCHARSETSHIFT) (* ; "Shifting character sets") ( ACCESS-CHARSET STREAM (SETQ SCSET (COND ((NEQ NSCHARSETSHIFT (SETQ CHAR (\BIN STREAM))) (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2))) CHAR) ((PROGN (* ; "2 shift-bytes means not run-encoded") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 3))) (EQ 0 (\BIN STREAM))) \NORUNCODE) (T (\NSIN.24BITENCODING.ERROR STREAM))))) (SETQ CHAR (\BIN STREAM)) (SETQ SCSET (COND ((QUOTE SHIFTEDCSETVAR) (* ; "CHARSETVAR=NIL means don't set") (SETQ SHIFTEDCSETVAR (UNFOLD SCSET 256))) (T (UNFOLD SCSET 256))))) (T (SETQ SCSET SHIFTEDCSET))) (COND (( EQ SCSET (UNFOLD \NORUNCODE 256)) (* ; "just read two bytes and combine them to a 16 bit value") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2))) (LOGOR (UNFOLD CHAR 256) (\BIN STREAM ))) (CHAR (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 1))) (AND CHAR (LOGOR SCSET CHAR))))))) (PUTPROPS \XCCSPEEK MACRO ((STREAM SHIFTEDCSET SHIFTEDCSETVAR NOERROR COUNTERVAR) (* ;; "Returns a 16 bit character code. Doesn't do EOL conversion--\INCHAR does that. May actually read the character-set shift, storing the result in the stream. COUNTERVAR, if given, is updated to reflect any such bytes that are actually read" ) (PROG ((CHAR (\PEEKBIN STREAM NOERROR)) SCSET) (COND ((NULL CHAR) (RETURN NIL)) ((EQ CHAR NSCHARSETSHIFT) (* ; "CHARSETVAR=NIL means don't set") (\BIN STREAM) (* ; "Consume the char shift byte") (ACCESS-CHARSET STREAM (SETQ SCSET (COND ((NEQ NSCHARSETSHIFT (SETQ CHAR (\BIN STREAM))) (* ; "Note: no eof error check on this \BIN -- an eof in the middle of a charset shift is an error") (AND ( QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2))) CHAR) ((PROGN (* ; "2 shift-bytes means not run-encoded") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 3))) (EQ 0 (\BIN STREAM))) \NORUNCODE) (T (\NSIN.24BITENCODING.ERROR STREAM))))) (SETQ SCSET (COND ((QUOTE SHIFTEDCSETVAR) (* ; "CHARSETVAR=NIL means don't set") (SETQ SHIFTEDCSETVAR ( UNFOLD SCSET 256))) (T (UNFOLD SCSET 256)))) (COND ((NULL (SETQ CHAR (\PEEKBIN STREAM NOERROR))) ( RETURN NIL)))) (T (SETQ SCSET SHIFTEDCSET))) (RETURN (COND ((EQ SCSET (UNFOLD \NORUNCODE 256)) (* ;; "just peek two bytes and combine them to a 16 bit value. Again, is an error if we hit eof in mid-character" ) (\BIN STREAM) (PROG1 (LOGOR (UNFOLD CHAR 256) (\PEEKBIN STREAM NOERROR)) (\BACKFILEPTR STREAM))) (T (LOGOR SHIFTEDCSET CHAR))))))) (PUTPROPS \BACKXCCSCHAR MACRO ((STREAM SHIFTEDCHARSET COUNTERVAR) (AND (\BACKFILEPTR STREAM) (COND (( COND (SHIFTEDCHARSET (EQ SHIFTEDCHARSET (UNFOLD \NORUNCODE 256))) (T (EQ \NORUNCODE (ACCESS-CHARSET STREAM)))) (COND ((\BACKFILEPTR STREAM) (AND (QUOTE COUNTERVAR) (add COUNTERVAR 2)) T) ((QUOTE COUNTERVAR) (add COUNTERVAR 1)))) ((QUOTE COUNTERVAR) (add COUNTERVAR 1)))))) (PUTPROPS \XCCSP MACRO (OPENLAMBDA (ST) (NOT (ffetch (STREAM NOTXCCS) of (\DTEST ST (QUOTE STREAM))))) ) (PUTPROPS \EXTRACT.NO.FONT.CODE MACRO ((JISCODE) (CDR (ASSOC JISCODE *JIS-TO-XCCS-CONV-NO-FONT-TABLE*) ))) (PUTPROPS \EXTARACT.CONV.TABLE MACRO ((KU) (CDR (ASSOC KU *JIS-TO-XCCS-CONV-TABLE-LIST*)))) (PUTPROPS \NOT.EQUIVALENT.TO.XCCS MACRO ((KU) (* ;;; " The JIS codes which are not equiavelent to XCCS reside in 1, 2, 3, 6, 8 and 84 KU. Although from 84-5 to 94-94 inclusive are not defined in JIS, that is they are GAIJI, they are also handled here." ) (OR (EQ KU 33) (EQ KU 34) (EQ KU 35) (EQ KU 38) (EQ KU 40) (EQ KU 116) (EQ KU 117)))) (PUTPROPS \EXTRACT.SET MACRO ((TEN TABLE) (ELT TABLE (IDIFFERENCE (UNFOLD (IDIFFERENCE TEN 32) 2) 1))) ) (PUTPROPS \EXTRACT.CODE MACRO ((TEN TABLE) (ELT TABLE (UNFOLD (IDIFFERENCE TEN 32) 2)))) (PUTPROPS \CHNAGE.KI.MODE MACRO (OPENLAMBDA (ST INPUTFLG ENTERP) (* ;;; "INPUTFLG is true if \CHNAGE.KI.MODE is called in the context in which ST is an input stream.") (COND (INPUTFLG (COND (ENTERP (freplace (STREAM IN.KANJIIN) of (\DTEST ST (QUOTE STREAM)) with T)) (T ( freplace (STREAM IN.KANJIIN) of (\DTEST ST (QUOTE STREAM)) with NIL)))) (T (COND (ENTERP (freplace ( STREAM OUT.KANJIIN) of (\DTEST ST (QUOTE STREAM)) with T)) (T (freplace (STREAM OUT.KANJIIN) of ( \DTEST ST (QUOTE STREAM)) with NIL))))))) (PUTPROPS \KIMODEP MACRO (OPENLAMBDA (ST INPUTFLG) (* ;;; "INPUTFLG is true if \KIMODEP is called in the context in which ST is an input stream.") (COND ( INPUTFLG (ffetch (STREAM IN.KANJIIN) of (\DTEST ST (QUOTE STREAM)))) (T (ffetch (STREAM OUT.KANJIIN) of (\DTEST ST (QUOTE STREAM))))))) (PUTPROPS \HANKAKUP MACRO ((CHAR) (< 160 CHAR 224))) (PUTPROPS \KANJIP MACRO ((CHAR) (< 12158 CHAR 29733))) (PUTPROPS \NOTGAIJIP MACRO ((CHAR) (OR (< 8480 CHAR 10305) (< 12158 CHAR 29733)))) (PUTPROPS \INVALID.TENP MACRO (OPENLAMBDA (TEN) (OR (< TEN 33) (< 126 TEN)))) (PUTPROPS \CONV.HANKAKU.KANA MACRO ((CHAR) (GETHASH CHAR *HANKAKU-TO-ZENKAKU-CONV-TABLE*))) (PUTPROPS \OUTKI MACRO ((STREAM) (\BOUT OUTSTREAM (CHARCODE ESC)) (\BOUT OUTSTREAM (CHARCODE $)) ( \BOUT OUTSTREAM (CHARCODE B)))) (PUTPROPS \OUTKO MACRO ((STREAM) (\BOUT OUTSTREAM (CHARCODE ESC)) (\BOUT OUTSTREAM (CHARCODE %()) ( \BOUT OUTSTREAM (CHARCODE J)))) (PUTPROPS \CONV.SJIS.TO.JIS MACRO (OPENLAMBDA (HI LO) (* ;;; "Convert Shift-JIS to JIS. The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of JIS code respectively." ) (SETQ CH1 (IDIFFERENCE HI (COND ((> HI 159) 177) (T 113)))) (SETQ CH1 (IPLUS (UNFOLD CH1 2) 1)) ( SETQ CH2 (COND ((> LO 158) (PROG1 (IDIFFERENCE LO 126) (SETQ CH1 (IPLUS CH1 1)))) (T (IDIFFERENCE LO ( COND ((> LO 126) (IPLUS 31 1)) (T 31)))))))) (PUTPROPS \CONV.JIS.TO.SJIS MACRO (OPENLAMBDA (HI LO) (* ;;; "Convert JIS to Shift-JIS. The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of Shift-JIS code respectively." ) (SETQ CH2 (COND ((ODDP HI) (SETQ CH2 (IPLUS LO 31)) (COND ((>= CH2 127) (IPLUS CH2 1)) (T CH2))) (T (IPLUS LO 126)))) (SETQ CH1 (IPLUS (FOLDLO (IDIFFERENCE HI 33) 2) 129)) (AND (> CH1 159) (SETQ CH1 ( IPLUS CH1 64))))) (PUTPROPS \SJIS.KANJI.FIRST.BYTEP MACRO (OPENLAMBDA (CHAR) (OR (< 127 CHAR 160) (< 223 CHAR 256)))) (PUTPROPS \EUC.KANJI.FIRST.BYTEP MACRO ((CHAR) (< 160 CHAR 255))) (PUTPROPS \GAIJIP MACRO ((CHAR) (EQ CHAR 143))) (PUTPROPS \EUC.HANKAKUP MACRO ((CHAR) (EQ CHAR 142))) (PUTPROP (QUOTE LLREAD) (QUOTE IMPORTDATE) (IDATE " 4-Aug-93 14:43:07")) (PUTPROPS EMPASSWORDLOC DMACRO (LAMBDA NIL (* lmm "24-MAR-83 06:46") (fetch (IFPAGE UserPswdAddr) of \InterfacePage))) (PUTPROPS \DECRYPT.PWD.CHAR MACRO ((CHAR) (LOGXOR CHAR 73))) (PUTPROP (QUOTE PASSWORDS) (QUOTE IMPORTDATE) (IDATE "16-May-90 21:02:21")) (RPAQQ MICASPERINCH 2540) (RPAQQ MICASPERMILLIMETER 100) (CONSTANTS (MICASPERINCH 2540) (MICASPERMILLIMETER 100)) (PUTPROP (QUOTE INTERPRESS) (QUOTE IMPORTDATE) (IDATE "16-Apr-2018 21:56:38")) (RPAQ MICASPERPT (FQUOTIENT 2540 72)) (RPAQQ IHALFMICASPERPT 17) (RPAQQ IMICASPERPT 35) (CONSTANTS (MICASPERPT (FQUOTIENT 2540 72)) (IHALFMICASPERPT 17) (IMICASPERPT 35)) (DEFMACRO \MICASTOPTS (MICAS) (COND ((NUMBERP MICAS) (QUOTIENT MICAS MICASPERPT)) (T (BQUOTE (QUOTIENT (\, MICAS) MICASPERPT))))) (PUTPROP (QUOTE HARDCOPY) (QUOTE IMPORTDATE) (IDATE "16-Apr-2018 22:15:08")) (FILESLOAD (SYSLOAD FROM VALUEOF DIRECTORIES) CMLARRAY-SUPPORT) (PUTPROP (QUOTE CMLARRAY) (QUOTE IMPORTDATE) (IDATE " 6-Jan-93 12:21:21")) (RPAQQ \MISCN-TABLE-LIST ((USER-SUBR 0 \USER-SUBR-UFN T) (CL:VALUES 1 CL::VALUES-UFN NIL) (CL:SXHASH 2 CL::SXHASH-UFN NIL) (CL::EQLHASHBITSFN 3 CL::EQLHASHBITSFN-UFN NIL) (STRINGHASHBITS 4 \STRINGHASHBITS-UFN NIL) (STRING-EQUAL-HASHBITS 5 \STRING-EQUAL-HASHBITS-UFN NIL) (CL:VALUES-LIST 6 CL::VALUES-LIST-UFN NIL) (LCFetchMethod 7 LCFetchMethod NIL) (LCFetchMethodOrHelp 8 NIL NIL) ( LCFindVarIndex 9 NIL NIL) (LCGetIVValue 10 NIL NIL) (LCPutIVValue 11 NIL NIL))) (RPAQQ \USER-SUBR-LIST ((DUMMY 10 DUMMY-UFN) (SAMPLE-USER-SUBR 0 SAMPLE-USER-SUBR-UFN))) (RPAQQ \INITSUBRS ((BACKGROUNDSUBR 6) (CHECKBCPLPASSWORD 7) (DISKPARTITION 8) (DSPBOUT 9) (DSPRATE 10) (GATHERSTATS 11) (GETPACKETBUFFER 12) (LISPFINISH 13) (MOREVMEMFILE 14) (RAID 15) (READRAWPBI 16) ( WRITERAWPBI 17) (SETSCREENCOLOR 18) (SHOWDISPLAY 19) (PUPLEVEL1STATE 20) (WRITESTATS 21) ( CONTEXTSWITCH 22) (COPYSYS0SUBR 23) (WRITEMAP 24) (UFS-GETFILENAME 34) (UFS-DELETEFILE 35) ( UFS-RENAMEFILE 36) (COM-READPAGES 37) (COM-WRITEPAGES 38) (COM-TRUNCATEFILE 39) (UFS-DIRECTORYNAMEP 41 ) (COM-GETFREEBLOCK 45) (SETUNIXTIME 48) (GETUNIXTIME 49) (COPYTIMESTATS 50) (UNIX-USERNAME 51) ( UNIX-FULLNAME 52) (UNIX-GETENV 53) (UNIX-GETPARM 54) (CHECK-SUM 55) (ETHER-SUSPEND 56) (ETHER-RESUME 57) (ETHER-AVAILABLE 58) (ETHER-RESET 59) (ETHER-GET 60) (ETHER-SEND 61) (ETHER-SETFILTER 62) ( ETHER-CHECK 63) (DSPCURSOR 64) (SETMOUSEXY 65) (DSP-VIDEOCOLOR 66) (DSP-SCREENWIDTH 67) ( DSP-SCREENHEIGHT 68) (BITBLTSUB 69) (BLTCHAR 70) (TEDIT.BLTCHAR 71) (BITBLT.BITMAP 72) ( BLTSHADE.BITMAP 73) (RS232C-CMD 74) (RS232C-READ-INIT 75) (RS232C-WRITE 76) (KEYBOARDBEEP 80) ( KEYBOARDMAP 81) (KEYBOARDSTATE 82) (VMEMSAVE 89) (LISP-FINISH 90) (NEWPAGE 91) (DORECLAIM 92) ( DUMMY-135Q 93) (NATIVE-MEMORY-REFERENCE 94) (OLD-COMPILE-LOAD-NATIVE 95) (DISABLEGC 96) ( COM-SETFILEINFO 103) (COM-OPENFILE 104) (COM-CLOSEFILE 105) (DSK-GETFILENAME 106) (DSK-DELETEFILE 107) (DSK-RENAMEFILE 108) (COM-NEXT-FILE 110) (COM-FINISH-FINFO 111) (COM-GEN-FILES 112) ( DSK-DIRECTORYNAMEP 113) (COM-GETFILEINFO 114) (COM-CHANGEDIR 116) (UNIX-HANDLECOMM 117) (RPC-CALL 119) (MESSAGE-READP 120) (MESSAGE-READ 121) (MONITOR-CONTROL 128) (GET-NATIVE-ADDR-FROM-LISP-PTR 131) ( GET-LISP-PTR-FROM-NATIVE-ADDR 132) (LOAD-NATIVE-FILE 133) (SUSPEND-LISP 134) (NEW-BLTCHAR 135) ( COLOR-INIT 136) (COLOR-SCREENMODE 137) (COLOR-MAP 138) (COLOR-BASE 139) (C-SlowBltChar 140) ( UNCOLORIZE-BITMAP 141) (COLORIZE-BITMAP 142) (COLOR-8BPPDRAWLINE 143) (TCP-OP 144) (WITH-SYMBOL 145) ( CAUSE-INTERRUPT 146) (OPEN-SOCKET 160) (CLOSE-SOCKET 161) (READ-SOCKET 162) (WRITE-SOCKET 163) ( CALL-C-FUNCTION 167) (DLD-LINK 168) (DLD-UNLINK-BY-FILE 169) (DLD-UNLINK-BY-SYMBOL 170) ( DLD-GET-SYMBOL 171) (DLD-GET-FUNC 172) (DLD-FUNCTION-EXECUTABLE-P 173) (DLD-LIST-UNDEFINED-SYMBOLS 174 ) (C-MALLOC 175) (C-FREE 176) (C-PUTBASEBYTE 177) (C-GETBASEBYTE 178) (CHAR-OPENFILE 200) (CHAR-BIN 201) (CHAR-BOUT 202) (CHAR-IOCTL 203) (CHAR-CLOSEFILE 204) (CHAR-EOFP 205) (CHAR-READP 206) (CHAR-BINS 207) (CHAR-BOUTS 208) (CHAR-FILLBUFFER 209))) (PUTPROP (QUOTE LLSUBRS) (QUOTE IMPORTDATE) (IDATE "17-Dec-92 14:28:41")) STOP \ No newline at end of file +(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP") (LISPXPRIN1 "EXPORTS GATHERED FROM {DSK}larry>ilisp>medley>sources> ON 8-Jan-2021 00:24:26" T) (LISPXTERPRI T) (PUTPROP (QUOTE FILESETS) (QUOTE IMPORTDATE) (IDATE "29-Jan-1998 16:26:53")) (RPAQQ MODARITHMACROS (CEIL FLOOR FOLDHI FOLDLO MODUP UNFOLD 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 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 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 "16-May-1990 20:46:21")) (RPAQQ WINDFLG T) (CONSTANTS (WINDFLG T)) (RPAQQ INITCONSTANTS ((* |;;;| "(LISPNAME VALUE BCPLNAME UCODENAME)") (CDRCODING 1 T T) (* \; "IF CDRCODING=0, CDR CODING IS OFF, OTHERWISE ON") (* |;;| "type numbers -- repeated on LLBASIC too") (\\SMALLP 1 SMALLTYPE |SmallType|) (\\FIXP 2 INTEGERTYPE |FixpType|) (\\FLOATP 3 FLTPTTYPE |FloatpType|) (\\LITATOM 4 ATOMTYPE |AtomType|) (\\LISTP 5 LISTTYPE |ListType|) (\\ARRAYP 6 ARRAYPTRTYPE |ArrayType|) (\\STRINGP 7 STRINGPTRTYPE) (\\STACKP 8) (\\CHARACTERP 9) (\\VMEMPAGEP 10 NIL |VMemPagePType|) (\\STREAM 11 NIL STREAMTYPE) (* |;;| "TYPE TABLE CONSTANTS - - - - - - - - - - - - - - - - - - - - - -") (\\TT.TYPEMASK 2047 |TTTypeMask| T ) (\\TT.NOREF 32768 NIL T) (\\TT.SYMBOLP 16384 NIL T) (\\TT.FIXP 8192) (\\TT.NUMBERP 4096) (\\TT.ATOM 2048) (* |;;| "page map - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -") (|\\PMblockSize| 32 PMBLOCKSIZE) (|\\STATSsize| 8 T) (|\\NumPMTpages| 8) (|\\EmptyPMTEntry| 65535 T) ( |\\FirstVmemBlock| 2 T) (\\MAXVMPAGE 131069) (\\MAXVMSEGMENT 255) (* |;;| "interface page") ( |\\IFPValidKey| 5603 T) (* |;;| "MDS") (|\\FirstMDSPage| 16382) (|\\MaxMDSPage| 524285) ( |\\DefaultSecondMDSPage| 65532) (|\\MDSIncrement| 512) (|\\PagesPerMDSUnit| 2) (* \; "(FOLDLO \\MDSIncrement WORDSPERPAGE)") (* |;;| "arrays") (\\ARRAYSPACE (46 0)) (|\\FirstArraySegment| 46) (|\\FirstArrayPage| 11776) (\\ARRAYSPACE2 (64 0)) (|\\DefaultSecondArrayPage| 16384) (* |;;| "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 65536 NIL T) (\\HTCOLLSIZE 1048576 NIL T) (* \; "HTCOLL size in words") (\\HTENDFREE 1 NIL T) (\\HTFREEPTR 0 NIL T) (* |;;| "pointers and lengths of various data spaces") (\\ATOMSPACE (0 0) (|ATOMspace| NIL) (|atomHiVal| NIL)) (|\\AtomHI| 0) (\\CHARHI 7) (* \; "overlap character space and the atom hash table space") (|\\AtomHashTable| (21 0) (|AHTspace| |AHTbase|)) (|\\AtomHTpages| 256 AHTSIZE) (|\\LastAtomPage| 255) (|\\MaxAtomFrLst| 65535) ( \\SMALLPOSPSPACE (14 0)) (|\\SmallPosHi| 14 |SMALLPOSspace| |smallpl|) (\\SMALLNEGSPACE (15 0)) ( |\\SmallNegHi| 15 |SMALLNEGspace| |smallneg|) (|\\NumSmallPages| 512) (* |;;| "PNAME SPACEin the old world; used for initial atoms now.") (\\PNPSPACE (8 0) (|PNPspace| |PNPbase|)) (\\PNAME.HI 8) (\\OLDATOMSPACE (44 0)) (* \; "NEW ATOM SPACE") (\\ATOM.HI 44) (* \; "HI PART OF NEW ATOM SPACE") (* |;;| "Definitions in old atom world") (\\DEFSPACE (10 0) (|DEFspace| |DEFbase|) (|DEFspace| |DEFbase|)) (\\DEF.HI 10) (\\VALSPACE (12 0) (|TOPVALspace| |TOPVALbase|) ( |VALspace| |VALbase|)) (\\VAL.HI 12) (\\PLISTSPACE (2 0) (|PLISTspace| |PLISTbase|)) (\\PLIST.HI 2) ( \\PAGEMAP (5 0) (|PAGEMAPspace| |PAGEMAPbase|)) (|\\NumPageMapPages| 256) (|\\PageMapTBL| (20 512) ( |PMTspace| |PMTbase|)) (|\\InterfacePage| (20 0) (|INTERFACEspace| |INTERFACEbase|) (|INTERFACEspace| |INTERFACEbase|)) (\\IOPAGE (0 65280)) (|\\DoveIORegion| (0 16384)) (\\IOCBPAGE (0 256)) (\\FPTOVP (2 0)) (|\\MDSTypeTable| (24 0) (|MDSTYPEspace| |MDSTYPEbase|) (|MDSTYPEspace| |MDSTYPEbase|)) ( |\\MDSTTsize| 1024 T) (* \; "in Pages") (\\MISCSTATS (20 2560) (|STATSspace| |MISCSTATSbase|)) ( |\\UFNTable| (20 3072) NIL (|STATSspace| |UFNTablebase|)) (|\\UFNTableSize| 2) (|\\DTDSpaceBase| (20 4096) (|DTDspace| |DTDbase|) (|DTDspace| |DTDbase|)) (|\\DTDSize| 18 T) (\\LISTPDTD (20 4186)) ( |\\EndTypeNumber| 2047) (\\LOCKEDPAGETABLE (20 28672)) (|\\NumLPTPages| 16) (\\STACKSPACE (1 0) ( |STACKspace| NIL) (|STACKspace| NIL)) (|\\GuardStackAddr| 61440) (|\\LastStackAddr| 65534) (\\STACKHI 1 T T) (\\HTMAIN (22 0) (|HTMAINspace| |HTMAINbase|) (|HTMAINspace| |HTMAINbase|)) (|\\HTMAINnpages| 256 T) (\\HTOVERFLOW (23 0) NIL (NIL |HTOVERFLOWbase|)) (\\HTBIGCOUNT (23 32768)) (\\HTCOLL (28 0) NIL (|HTCOLLspace| |HTCOLLbase|)) (\\DISPLAYREGION (18 0)) (|\\D1BCPLspace| 0 T |LEmubrHiVal|) ( |\\D0BCPLspace| 0 T) (* |;;| "Interface Page locations") (|\\CurrentFXP| 0 T T) (|\\ResetFXP| 1 T T) ( |\\SubovFXP| 2 T T) (|\\KbdFXP| 3 T T) (|\\HardReturnFXP| 4 T T) (\\GCFXP 5) (\\FAULTFXP 6 T T) ( |\\MiscFXP| 14 T T) (|\\TeleRaidFXP| 24 T T) (* |;;| "emulator segment locations") (DCB.EM 272) ( DISPINTERRUPT.EM 273) (CURSORBITMAP.EM 281) (KBDAD0.EM 65052) (KBDAD1.EM 65053) (KBDAD2.EM 65054) ( KBDAD3.EM 65055) (UTILIN.EM 65048) (CURSORX.EM 278) (CURSORY.EM 279) (MOUSEX.EM 276) (MOUSEY.EM 277) ( |\\LispKeyMask| 8192 T T) (|\\BcplKeyMask| 4352 T T) (* \; "Machine types") (\\MAIKO 3) (\\DOLPHIN 4) (\\DORADO 5) (\\DANDELION 6) (\\DAYBREAK 8) (* |;;| "FOR DLION (AND DAYBREAK)") (\\VP.DISPLAY 4608) ( \\NP.DISPLAY 202) (* \; "for Dorado display 1024x808 pixels / (16 pixels/word x 256 words/page)") ( \\NP.WIDEDOVEDISPLAY 243) (* \; "Wide Dove display 1152x864 pixels") (\\WIDEDOVEDISPLAYWIDTH 1152) ( \\RP.AFTERDISPLAY 206) (* \; "Includes 4 pages for cursor") (\\RP.AFTERDOVEDISPLAY 243) (* \; "if big screen") (\\RP.DISPLAY 0) (\\RP.TEMPDISPLAY 2561) (\\RP.MISCLOCKED 2804) (* \; "(+ \\RP.TEMPDISPLAY \\NP.WIDEDOVEDISPLAY)") (\\RP.STACK 768) (\\VP.STACK 256) (\\RP.MAP 256) ( \\NP.MAP 256) (\\RP.IOPAGE 512) (* \; "The DOVE IOCBPAGE can go anywhere, but should be under the 1mbyte range") (\\RP.DOVEIOCBPAGE 543) ( \\RP.DOVEIORGN 544) (\\VP.DOVEIORGN 64) (\\DOVEIORGNSIZE 64) (\\VP.IOPAGE 255) (\\VP.IFPAGE 5120) ( \\VP.FPTOVP 512) (\\NP.FPTOVP 4096) (\\RP.FPTOVP 1024) (\\RP.STARTBUFFERS 640) (\\VP.TYPETABLE 6144) ( \\NP.TYPETABLE 1024) (\\RP.TYPETABLE 5120) (\\VP.GCTABLE 5632) (\\NP.GCTABLE 256) (\\RP.GCTABLE 6144) (\\VP.GCOVERFLOW 5888) (\\NP.GCOVERFLOW 1) (\\RP.GCOVERFLOW 6400) (\\FP.IFPAGE 2) (\\VP.IOCBS 1) ( \\VP.PRIMARYMAP 5122) (\\VP.SECONDARYMAP 1280) (\\VP.LPT 5232) (\\VP.INITSCRATCH 8) (\\VP.RPT 128) ( \\VP.BUFFERS 218) (* \; "DLion processor commands") (\\DL.PROCESSORBUSY 32768) (\\DL.SETTOD 32769) ( \\DL.READTOD 32770) (\\DL.READPID 32771) (\\DL.BOOTBUTTON 32772))) (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) ( DLMOUSETIMER FIXP) (DLMOUSETEMP FIXP))) (RPAQQ IFPAGELAYOUT ((|CurrentFXP| WORD) (* \; "First 7 items are FX values for user and 6 system contexts.") (|ResetFXP| WORD) (|SubovFXP| WORD) ( |KbdFXP| WORD) (|HardReturnFXP| WORD) (GCFXP WORD) (FAULTFXP WORD) (|EndOfStack| WORD) (* \; "Stack high-water mark: address of guard block at current end of stack") (|LVersion| WORD) (* \; "Lisp version, followed by min versions of microcode and Bcpl compatible with this Lisp") ( |MinRVersion| WORD) (|MinBVersion| WORD) (|RVersion| WORD) (* \; "Bcpl fills in the actual microcode, Bcpl versions.") (|BVersion| WORD) (|MachineType| WORD) ( |MiscFXP| WORD) (* \; "FX for MISC context") (|Key| WORD) (* \; "= IFPValidKey if vmem consistent.") ( |SerialNumber| WORD) (* \; "Pup host number (Dorado/Dolphin)") (|EmulatorSpace| WORD) (* \; "Hiloc of bcpl space (always zero now)") (|ScreenWidth| WORD) (|NxtPMAddr| WORD) (* \; "Next page to be allocated in secondary page map table") (|NActivePages| WORD) (* \; "Length of vmem in use") (|NDirtyPages| WORD) (* \; "not used, but maintained as = NActivePages") ( |filePnPMP0| WORD) (* \; "Sysout page number of first page of secondary page map table (\\PAGEMAP), which is where the secondary map pages themselves live" ) (|filePnPMT0| WORD) (* \; "Sysout page number of first page of primary page map table") (TELERAIDFXP WORD) (* \; "FX for TeleRaid server context") (NATIVE-START-MEM-PAGE WORD) (* \; "Unix page where native code starts") (NATIVE-LENGTH-PAGE WORD) (* \; "Unix page length of native code") (NATIVE-PAGE-OFFSET WORD) (* \; "Lisp Disk Page offset of native code") (|UserNameAddr| WORD) (* \; "Addresses in bcpl space (seg 0) of global user name and password") (|UserPswdAddr| WORD) (|StackBase| WORD) (* \; "Stack address where user stack starts") (FAULTHI WORD) (* \; "Microcode for page fault stores fault address here, then does context switch to FAULTFXP") (FAULTLO WORD) (DEVCONFIG WORD) (* \; "IT'S FOR KB,DISP TYPE") (* \; "Formerly REALPAGETABLE, back when it was always in Bcpl space.") (RPTSIZE WORD) (* \; "Number of entries in Real Page Table") (RPOFFSET WORD) (* \; "RP-RPOFFSET => index in table") ( MAXETHERBYTES WORD) (* \; "Number of bytes available in a pbi, not counting encapsulation (Dorado)") ( EMBUFVP WORD) (* \; "VP of a one-page emulator buffer") (|NSHost0| WORD) (* \; "Machine's 48-bit NS host number. Lisp manages to compute this on all machines except Dolphin, where Bcpl fills it in." ) (|NSHost1| WORD) (|NSHost2| WORD) (|MDSZone| WORD) (* \; "Obsolete -- was used by Dolphin 10MB network code.") (|MDSZoneLength| WORD) (EMUBUFFERS WORD) (* \; "Buffer space in segment 0 for swapping/disk activity") (EMUBUFLENGTH WORD) (* \; "Number of words of said space") (LASTNUMCHARS WORD) (* \; "No longer used?") (SYSDISK WORD) (* \; "Address of sysDisk in Bcpl space -- disk obj for boot partition.") (ISFMAP WORD) (* |;;| "The following 4 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) (* \; "Number pages of real memory") ( |LastLockedFilePage| WORD) (* \; "Last page of vmem that is locked--booting has to load at least that far.") (|LastDominoFilePage| WORD ) (* \; "Last sysout page reserved for Dandelion microcode") (|FPTOVPStart| WORD) (* \; "Sysout page where FPTOVP starts") (FAKEMOUSEBITS WORD) (* \; "Used to implement fake middle button on 2-button Dandelion.") (|DL24BitAddressable| WORD) (* \; "non-zero if DLion capable of addressing 32MB virtual memory") (REALPAGETABLEPTR FULLXPOINTER) (* \; "Address of real page table, set up by Bcpl (but not chained together)") (|DLLastVmemPage| WORD) (* \; "DLion booting microcode puts length of vmem file here.") (|FullSpaceUsed| WORD) (* \; "Non-zero if vmem beyond initial 8MB has been allocated.") (FAKEKBDAD4 WORD) (FAKEKBDAD5 WORD) (* |;;| "The following 9 items (6 words and 3 pointers) are 3 3-element vectors for the Dorado extended virtual memory code--indexed by 0,1,2 according to which of up to 3 virtual memory backing files you're working with." ) (|XVmemFmapBase| WORD) (* \; "Bcpl stores isf map pointer to each partition here. First is redundant with ISFMAP field above.") ( NIL WORD) (NIL WORD) (|XVmemFmapHighBase| WORD) (* \; "Bcpl stores the highest vm page contained in this or earlier partition.") (NIL WORD) (NIL WORD) ( |XVmemDiskBase| FULLXPOINTER) (* \; "Lisp stores disk objects here (just a convenient non-faulting contiguous block of storage).") (NIL FULLXPOINTER) (NIL FULLXPOINTER))) (RPAQQ MAIKO.IFPAGELAYOUT ((|CurrentFXP| WORD) (* \; "First 7 items are FX values for user and 6 system contexts.") (|ResetFXP| WORD) (|SubovFXP| WORD) ( |KbdFXP| WORD) (|HardReturnFXP| WORD) (GCFXP WORD) (FAULTFXP WORD) (|EndOfStack| WORD) (* \; "Stack high-water mark: address of guard block at current end of stack") (|LVersion| WORD) (* \; "Lisp version, followed by min versions of microcode and Bcpl compatible with this Lisp") ( |MinRVersion| WORD) (|MinBVersion| WORD) (|RVersion| WORD) (* \; "Bcpl fills in the actual microcode, Bcpl versions.") (|BVersion| WORD) (|MachineType| WORD) ( |MiscFXP| WORD) (* \; "FX for MISC context") (|Key| WORD) (* \; "= IFPValidKey if vmem consistent.") ( |SerialNumber| WORD) (* \; "Pup host number (Dorado/Dolphin)") (|EmulatorSpace| WORD) (* \; "Hiloc of bcpl space (always zero now)") (|ScreenWidth| WORD) (|NxtPMAddr| WORD) (* \; "Next page to be allocated in secondary page map table") (NIL WORD) (* \; "WAS NActivePages, Length of vmem in use") (NIL WORD) (* \; "WAS NDirtyPages, not used, but maintained as = NActivePages") (|filePnPMP0| WORD) (* \; "Sysout page number of first page of secondary page map table (\\PAGEMAP), which is where the secondary map pages themselves live" ) (|filePnPMT0| WORD) (* \; "Sysout page number of first page of primary page map table") (TELERAIDFXP WORD) (* \; "FX for TeleRaid server context") (NATIVE-START-MEM-PAGE WORD) (* \; "Unix page where native code starts") (NATIVE-LENGTH-PAGE WORD) (* \; "Unix page length of native code") (NATIVE-PAGE-OFFSET WORD) (* \; "Lisp Disk Page offset of native code") (|UserNameAddr| WORD) (* \; "Addresses in bcpl space (seg 0) of global user name and password") (|UserPswdAddr| WORD) (|StackBase| WORD) (* \; "Stack address where user stack starts") (FAULTHI WORD) (* \; "Microcode for page fault stores fault address here, then does context switch to FAULTFXP") (FAULTLO WORD) (DEVCONFIG WORD) (* \; "IT'S FOR KB,DISP TYPE") (* \; "Formerly REALPAGETABLE, back when it was always in Bcpl space.") (RPTSIZE WORD) (* \; "Number of entries in Real Page Table") (RPOFFSET WORD) (* \; "RP-RPOFFSET => index in table") ( MAXETHERBYTES WORD) (* \; "Number of bytes available in a pbi, not counting encapsulation (Dorado)") ( EMBUFVP WORD) (* \; "VP of a one-page emulator buffer") (|NSHost0| WORD) (* \; "Machine's 48-bit NS host number. Lisp manages to compute this on all machines except Dolphin, where Bcpl fills it in." ) (|NSHost1| WORD) (|NSHost2| WORD) (|MDSZone| WORD) (* \; "Obsolete -- was used by Dolphin 10MB network code.") (|MDSZoneLength| WORD) (EMUBUFFERS WORD) (* \; "Buffer space in segment 0 for swapping/disk activity") (EMUBUFLENGTH WORD) (* \; "Number of words of said space") (* |;;| "The following 2 are available if NEW_STOARGE is specified in C") (|ProcessSize| WORD) (* \; "Process size for which can be use as LISP space") (|StorageFullState| WORD) (* \; "Save last storage state") (ISFMAP WORD) (* |;;| "The following 4 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) (* \; "Number pages of real memory") ( |LastLockedFilePage| WORD) (* \; "Last page of vmem that is locked--booting has to load at least that far.") (|LastDominoFilePage| WORD ) (* \; "Last sysout page reserved for Dandelion microcode") (|FPTOVPStart| WORD) (* \; "Sysout page where FPTOVP starts") (FAKEMOUSEBITS WORD) (* \; "Used to implement fake middle button on 2-button Dandelion.") (|DL24BitAddressable| WORD) (* \; "non-zero if DLion capable of addressing 32MB virtual memory") (REALPAGETABLEPTR FULLXPOINTER) (* \; "Address of real page table, set up by Bcpl (but not chained together)") (SYSDISK WORD) (* \; "WAS DLLastVmemPage, DLion booting microcode puts length of vmem file here.") (|FullSpaceUsed| WORD) ( * \; "Non-zero if vmem beyond initial 8MB has been allocated.") (FAKEKBDAD4 WORD) (FAKEKBDAD5 WORD) (* |;;| "The following 9 items (6 words and 3 pointers) are 3 3-element vectors for the Dorado extended virtual memory code--indexed by 0,1,2 according to which of up to 3 virtual memory backing files you're working with." ) (|XVmemFmapBase| WORD) (* \; "Bcpl stores isf map pointer to each partition here. First is redundant with ISFMAP field above.") ( NIL WORD) (NIL WORD) (|XVmemFmapHighBase| WORD) (* \; "Bcpl stores the highest vm page contained in this or earlier partition.") (NIL WORD) (NIL WORD) ( |XVmemDiskBase| FULLXPOINTER) (* \; "Lisp stores disk objects here (just a convenient non-faulting contiguous block of storage).") (NIL FULLXPOINTER) (NIL FULLXPOINTER) (|DLLastVmemPage| FIXP) (* \; "DLion booting microcode puts length of vmem file here.") (|NActivePages| FIXP) (* \; "Length of vmem in use") (|NDirtyPages| FIXP) (* \; "not used, but maintained as = NActivePages"))) (RPAQQ IOPAGELAYOUT ((NIL 18 WORD) (DLMAINTPANEL WORD NIL T) (DLFLOPPYCMD WORD) (DLTTYPORTCMD WORD) ( DLPROCESSORCMD WORD) (NEWMOUSESTATE WORD) (DLBEEPCMD WORD) (DLRS232CMISCCOMMAND WORD) (DLRS232CPUTFLAG WORD) (DLRS232CGETFLAG WORD) (NIL 6 WORD) (DLFLOPPY WORD) (DLTTYOUT WORD) (NIL 1 WORD) (DLTTYIN WORD) (NIL 1 WORD) (DLPROCESSOR2 WORD) (DLPROCESSOR1 WORD) (DLPROCESSOR0 WORD) (NEWMOUSEX WORD) (NEWMOUSEY WORD) (DLBEEPFREQ WORD) (DLRS232CPARAMETERCSBLO WORD) (DLRS232CPARAMETERCSBHI WORD) ( DLRS232CSETRS366STATUS 3 WORD) (DLRS232CPUTCSBLO WORD) (DLRS232CPUTCSBHI WORD) (DLRS232CGETCSBLO WORD) (DLRS232CGETCSBHI WORD) (DLRS232CDEVICESTATUS WORD) (DLRS232CPARAMETEROUTCOME WORD) (DLTODVALID WORD) (DLTODLO WORD NIL T) (DLTODHI WORD) (DLTODLO2 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) (DLLSEPIMAGECSB 32 WORD) (DLIOPHARDWARECONFIG WORD) (NIL 11 WORD) (DLRS232CPARAMETERCSBLO.11 WORD) (DLRS232CPARAMETERCSBHI.11 WORD) ( DLRS232CSETRS366STATUS.11 14 WORD) (NIL 60 WORD) (DLMAGTAPE 4 WORD) (DLETHERNET 12 WORD NIL T) (NIL 31 WORD) (DLDISPINTERRUPT WORD NIL T) (DLDISPCONTROL WORD) (DLDISPBORDER WORD) (DLCURSORX WORD NIL T) ( DLCURSORY WORD NIL T) (DLCURSORBITMAP 16 WORD NIL T))) (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 \\CHARACTERP 9) (RPAQQ \\VMEMPAGEP 10) (RPAQQ \\STREAM 11) (RPAQQ \\TT.TYPEMASK 2047) (RPAQQ \\TT.NOREF 32768) (RPAQQ \\TT.SYMBOLP 16384) (RPAQQ \\TT.FIXP 8192) (RPAQQ \\TT.NUMBERP 4096) (RPAQQ \\TT.ATOM 2048) (RPAQQ |\\PMblockSize| 32) (RPAQQ |\\STATSsize| 8) (RPAQQ |\\NumPMTpages| 8) (RPAQQ |\\EmptyPMTEntry| 65535) (RPAQQ |\\FirstVmemBlock| 2) (RPAQQ \\MAXVMPAGE 131069) (RPAQQ \\MAXVMSEGMENT 255) (RPAQQ |\\IFPValidKey| 5603) (RPAQQ |\\FirstMDSPage| 16382) (RPAQQ |\\MaxMDSPage| 524285) (RPAQQ |\\DefaultSecondMDSPage| 65532) (RPAQQ |\\MDSIncrement| 512) (RPAQQ |\\PagesPerMDSUnit| 2) (RPAQQ |\\FirstArraySegment| 46) (RPAQQ |\\FirstArrayPage| 11776) (RPAQQ |\\DefaultSecondArrayPage| 16384) (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 65536) (RPAQQ \\HTCOLLSIZE 1048576) (RPAQQ \\HTENDFREE 1) (RPAQQ \\HTFREEPTR 0) (RPAQQ |\\AtomHI| 0) (RPAQQ \\CHARHI 7) (RPAQQ |\\AtomHTpages| 256) (RPAQQ |\\LastAtomPage| 255) (RPAQQ |\\MaxAtomFrLst| 65535) (RPAQQ |\\SmallPosHi| 14) (RPAQQ |\\SmallNegHi| 15) (RPAQQ |\\NumSmallPages| 512) (RPAQQ \\PNAME.HI 8) (RPAQQ \\ATOM.HI 44) (RPAQQ \\DEF.HI 10) (RPAQQ \\VAL.HI 12) (RPAQQ \\PLIST.HI 2) (RPAQQ |\\NumPageMapPages| 256) (RPAQQ |\\MDSTTsize| 1024) (RPAQQ |\\UFNTableSize| 2) (RPAQQ |\\DTDSize| 18) (RPAQQ |\\EndTypeNumber| 2047) (RPAQQ |\\NumLPTPages| 16) (RPAQQ |\\GuardStackAddr| 61440) (RPAQQ |\\LastStackAddr| 65534) (RPAQQ \\STACKHI 1) (RPAQQ |\\HTMAINnpages| 256) (RPAQQ |\\D1BCPLspace| 0) (RPAQQ |\\D0BCPLspace| 0) (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 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 \\MAIKO 3) (RPAQQ \\DOLPHIN 4) (RPAQQ \\DORADO 5) (RPAQQ \\DANDELION 6) (RPAQQ \\DAYBREAK 8) (RPAQQ \\VP.DISPLAY 4608) (RPAQQ \\NP.DISPLAY 202) (RPAQQ \\NP.WIDEDOVEDISPLAY 243) (RPAQQ \\WIDEDOVEDISPLAYWIDTH 1152) (RPAQQ \\RP.AFTERDISPLAY 206) (RPAQQ \\RP.AFTERDOVEDISPLAY 243) (RPAQQ \\RP.DISPLAY 0) (RPAQQ \\RP.TEMPDISPLAY 2561) (RPAQQ \\RP.MISCLOCKED 2804) (RPAQQ \\RP.STACK 768) (RPAQQ \\VP.STACK 256) (RPAQQ \\RP.MAP 256) (RPAQQ \\NP.MAP 256) (RPAQQ \\RP.IOPAGE 512) (RPAQQ \\RP.DOVEIOCBPAGE 543) (RPAQQ \\RP.DOVEIORGN 544) (RPAQQ \\VP.DOVEIORGN 64) (RPAQQ \\DOVEIORGNSIZE 64) (RPAQQ \\VP.IOPAGE 255) (RPAQQ \\VP.IFPAGE 5120) (RPAQQ \\VP.FPTOVP 512) (RPAQQ \\NP.FPTOVP 4096) (RPAQQ \\RP.FPTOVP 1024) (RPAQQ \\RP.STARTBUFFERS 640) (RPAQQ \\VP.TYPETABLE 6144) (RPAQQ \\NP.TYPETABLE 1024) (RPAQQ \\RP.TYPETABLE 5120) (RPAQQ \\VP.GCTABLE 5632) (RPAQQ \\NP.GCTABLE 256) (RPAQQ \\RP.GCTABLE 6144) (RPAQQ \\VP.GCOVERFLOW 5888) (RPAQQ \\NP.GCOVERFLOW 1) (RPAQQ \\RP.GCOVERFLOW 6400) (RPAQQ \\FP.IFPAGE 2) (RPAQQ \\VP.IOCBS 1) (RPAQQ \\VP.PRIMARYMAP 5122) (RPAQQ \\VP.SECONDARYMAP 1280) (RPAQQ \\VP.LPT 5232) (RPAQQ \\VP.INITSCRATCH 8) (RPAQQ \\VP.RPT 128) (RPAQQ \\VP.BUFFERS 218) (RPAQQ \\DL.PROCESSORBUSY 32768) (RPAQQ \\DL.SETTOD 32769) (RPAQQ \\DL.READTOD 32770) (RPAQQ \\DL.READPID 32771) (RPAQQ \\DL.BOOTBUTTON 32772) (CONSTANTS (CDRCODING 1) (\\SMALLP 1) (\\FIXP 2) (\\FLOATP 3) (\\LITATOM 4) (\\LISTP 5) (\\ARRAYP 6) ( \\STRINGP 7) (\\STACKP 8) (\\CHARACTERP 9) (\\VMEMPAGEP 10) (\\STREAM 11) (\\TT.TYPEMASK 2047) ( \\TT.NOREF 32768) (\\TT.SYMBOLP 16384) (\\TT.FIXP 8192) (\\TT.NUMBERP 4096) (\\TT.ATOM 2048) ( |\\PMblockSize| 32) (|\\STATSsize| 8) (|\\NumPMTpages| 8) (|\\EmptyPMTEntry| 65535) ( |\\FirstVmemBlock| 2) (\\MAXVMPAGE 131069) (\\MAXVMSEGMENT 255) (|\\IFPValidKey| 5603) ( |\\FirstMDSPage| 16382) (|\\MaxMDSPage| 524285) (|\\DefaultSecondMDSPage| 65532) (|\\MDSIncrement| 512 ) (|\\PagesPerMDSUnit| 2) (|\\FirstArraySegment| 46) (|\\FirstArrayPage| 11776) ( |\\DefaultSecondArrayPage| 16384) (|\\StackMask| 57344) (|\\FxtnBlock| 49152) (|\\GuardBlock| 57344) ( |\\BFBlock| 32768) (|\\FreeStackBlock| 40960) (|\\NotStackBlock| 0) (|\\MinExtraStackWords| 32) ( ERASECHARCODE 0) (\\HT1CNT 1024) (\\HTSTKBIT 512) (\\HTCNTMASK 64512) (\\HTMAINSIZE 65536) ( \\HTCOLLSIZE 1048576) (\\HTENDFREE 1) (\\HTFREEPTR 0) (|\\AtomHI| 0) (\\CHARHI 7) (|\\AtomHTpages| 256 ) (|\\LastAtomPage| 255) (|\\MaxAtomFrLst| 65535) (|\\SmallPosHi| 14) (|\\SmallNegHi| 15) ( |\\NumSmallPages| 512) (\\PNAME.HI 8) (\\ATOM.HI 44) (\\DEF.HI 10) (\\VAL.HI 12) (\\PLIST.HI 2) ( |\\NumPageMapPages| 256) (|\\MDSTTsize| 1024) (|\\UFNTableSize| 2) (|\\DTDSize| 18) (|\\EndTypeNumber| 2047) (|\\NumLPTPages| 16) (|\\GuardStackAddr| 61440) (|\\LastStackAddr| 65534) (\\STACKHI 1) ( |\\HTMAINnpages| 256) (|\\D1BCPLspace| 0) (|\\D0BCPLspace| 0) (|\\CurrentFXP| 0) (|\\ResetFXP| 1) ( |\\SubovFXP| 2) (|\\KbdFXP| 3) (|\\HardReturnFXP| 4) (\\GCFXP 5) (\\FAULTFXP 6) (|\\MiscFXP| 14) ( |\\TeleRaidFXP| 24) (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) (\\MAIKO 3) ( \\DOLPHIN 4) (\\DORADO 5) (\\DANDELION 6) (\\DAYBREAK 8) (\\VP.DISPLAY 4608) (\\NP.DISPLAY 202) ( \\NP.WIDEDOVEDISPLAY 243) (\\WIDEDOVEDISPLAYWIDTH 1152) (\\RP.AFTERDISPLAY 206) (\\RP.AFTERDOVEDISPLAY 243) (\\RP.DISPLAY 0) (\\RP.TEMPDISPLAY 2561) (\\RP.MISCLOCKED 2804) (\\RP.STACK 768) (\\VP.STACK 256 ) (\\RP.MAP 256) (\\NP.MAP 256) (\\RP.IOPAGE 512) (\\RP.DOVEIOCBPAGE 543) (\\RP.DOVEIORGN 544) ( \\VP.DOVEIORGN 64) (\\DOVEIORGNSIZE 64) (\\VP.IOPAGE 255) (\\VP.IFPAGE 5120) (\\VP.FPTOVP 512) ( \\NP.FPTOVP 4096) (\\RP.FPTOVP 1024) (\\RP.STARTBUFFERS 640) (\\VP.TYPETABLE 6144) (\\NP.TYPETABLE 1024) (\\RP.TYPETABLE 5120) (\\VP.GCTABLE 5632) (\\NP.GCTABLE 256) (\\RP.GCTABLE 6144) ( \\VP.GCOVERFLOW 5888) (\\NP.GCOVERFLOW 1) (\\RP.GCOVERFLOW 6400) (\\FP.IFPAGE 2) (\\VP.IOCBS 1) ( \\VP.PRIMARYMAP 5122) (\\VP.SECONDARYMAP 1280) (\\VP.LPT 5232) (\\VP.INITSCRATCH 8) (\\VP.RPT 128) ( \\VP.BUFFERS 218) (\\DL.PROCESSORBUSY 32768) (\\DL.SETTOD 32769) (\\DL.READTOD 32770) (\\DL.READPID 32771) (\\DL.BOOTBUTTON 32772)) (RPAQQ \\MPERRORS ((\\MP.OBSOLETEVMEM 1) (\\MP.INVALIDVMEM 2 "Vmem inconsistent at startup") ( \\MP.IOCBPAGE 3 "No place for IOCB page at startup") (\\MP.MOB 4 "Map out of bounds") ( \\MP.INVALIDADDR 5) (\\MP.INVALIDVP 6) (\\MP.CHAIN.UNAVAIL 7 "Unavailable page on real page table chain") (\\MP.SELECTLOOP 8 "Loop in \\SELECTREALPAGE") ( \\MP.NEWPAGE 9 "Attempt to allocate already existing page") (\\MP.NEWMAPPAGE 10 "\\DONEWPAGE failed to allocate new map page") (\\MP.BADLOCKED 11 "Locked page occupies a file page needed to lock another") (\\MP.CLOCK0 12 "Arg to CLOCK0 not an integer box") (\\MP.RESIDENT 13 "Fault on resident page") (\\MP.STACKFAULT 14 "Fault on stack") (\\MP.VMEMTOOLONG 16 "Attempt to extend Vmem File beyond fixed limit (8mb)") ( \\MP.WRITING.LOCKED.PAGE 17 "Writing a locked page with UPDATEKEY = T") (\\MP.UNINTERRUPTABLE 18 "Error in uninterruptable system code") (\\MP.STACKFULL 19) (\\MP.MDSFULL 20) (\\MP.UNKNOWN.UFN 21) ( \\MP.ATOMSFULL 22) (\\MP.PNAMESFULL 23) (\\MP.USECOUNTOVERFLOW 24) (\\MP.MDSFULLWARNING 25) ( \\MP.BADMDSFREELIST 26) (\\MP.BADARRAYBLOCK 27) (\\MP.BADDELETEBLOCK 28) (\\MP.BADARRAYRECLAIM 29) ( \\MP.BIGREFCNTMISSING 30 "PTR refcnt previously overflowed, but not found in table.") ( \\MP.BIGREFCNTALREADYPRESENT 31 "PTR already in overflow table") (\\MP.DELREF0 32) (\\MP.PROCERROR 33) (\\MP.PROCNOFRAME 34 "Failed to build frame for PROCESS use") (\\MP.32MBINUSE 35) (\\MP.TOPUNWOUND 36 "Unexpected (RETTO T)") (\\MP.STACKRELEASED 37) (\\MP.FLUSHLOCKED 38) (\\MP.MAPNOTLOCKED 39) ( \\MP.UNLOCKINGMAP 40) (\\MP.SWAPDISKERROR 41 "Hard Disk Error in swapper") (\\MP.BADRUNTABLE 42 "Malformed run table for vmem file"))) (RPAQQ \\MP.OBSOLETEVMEM 1) (RPAQ \\MP.INVALIDVMEM 2 "Vmem inconsistent at startup") (RPAQ \\MP.IOCBPAGE 3 "No place for IOCB page at startup") (RPAQ \\MP.MOB 4 "Map out of bounds") (RPAQQ \\MP.INVALIDADDR 5) (RPAQQ \\MP.INVALIDVP 6) (RPAQ \\MP.CHAIN.UNAVAIL 7 "Unavailable page on real page table chain") (RPAQ \\MP.SELECTLOOP 8 "Loop in \\SELECTREALPAGE") (RPAQ \\MP.NEWPAGE 9 "Attempt to allocate already existing page") (RPAQ \\MP.NEWMAPPAGE 10 "\\DONEWPAGE failed to allocate new map page") (RPAQ \\MP.BADLOCKED 11 "Locked page occupies a file page needed to lock another") (RPAQ \\MP.CLOCK0 12 "Arg to CLOCK0 not an integer box") (RPAQ \\MP.RESIDENT 13 "Fault on resident page") (RPAQ \\MP.STACKFAULT 14 "Fault on stack") (RPAQ \\MP.VMEMTOOLONG 16 "Attempt to extend Vmem File beyond fixed limit (8mb)") (RPAQ \\MP.WRITING.LOCKED.PAGE 17 "Writing a locked page with UPDATEKEY = T") (RPAQ \\MP.UNINTERRUPTABLE 18 "Error in uninterruptable system code") (RPAQQ \\MP.STACKFULL 19) (RPAQQ \\MP.MDSFULL 20) (RPAQQ \\MP.UNKNOWN.UFN 21) (RPAQQ \\MP.ATOMSFULL 22) (RPAQQ \\MP.PNAMESFULL 23) (RPAQQ \\MP.USECOUNTOVERFLOW 24) (RPAQQ \\MP.MDSFULLWARNING 25) (RPAQQ \\MP.BADMDSFREELIST 26) (RPAQQ \\MP.BADARRAYBLOCK 27) (RPAQQ \\MP.BADDELETEBLOCK 28) (RPAQQ \\MP.BADARRAYRECLAIM 29) (RPAQ \\MP.BIGREFCNTMISSING 30 "PTR refcnt previously overflowed, but not found in table.") (RPAQ \\MP.BIGREFCNTALREADYPRESENT 31 "PTR already in overflow table") (RPAQQ \\MP.DELREF0 32) (RPAQQ \\MP.PROCERROR 33) (RPAQ \\MP.PROCNOFRAME 34 "Failed to build frame for PROCESS use") (RPAQQ \\MP.32MBINUSE 35) (RPAQ \\MP.TOPUNWOUND 36 "Unexpected (RETTO T)") (RPAQQ \\MP.STACKRELEASED 37) (RPAQQ \\MP.FLUSHLOCKED 38) (RPAQQ \\MP.MAPNOTLOCKED 39) (RPAQQ \\MP.UNLOCKINGMAP 40) (RPAQ \\MP.SWAPDISKERROR 41 "Hard Disk Error in swapper") (RPAQ \\MP.BADRUNTABLE 42 "Malformed run table for vmem file") (CONSTANTS (\\MP.OBSOLETEVMEM 1) (\\MP.INVALIDVMEM 2 "Vmem inconsistent at startup") (\\MP.IOCBPAGE 3 "No place for IOCB page at startup") (\\MP.MOB 4 "Map out of bounds") (\\MP.INVALIDADDR 5) ( \\MP.INVALIDVP 6) (\\MP.CHAIN.UNAVAIL 7 "Unavailable page on real page table chain") (\\MP.SELECTLOOP 8 "Loop in \\SELECTREALPAGE") (\\MP.NEWPAGE 9 "Attempt to allocate already existing page") ( \\MP.NEWMAPPAGE 10 "\\DONEWPAGE failed to allocate new map page") (\\MP.BADLOCKED 11 "Locked page occupies a file page needed to lock another") (\\MP.CLOCK0 12 "Arg to CLOCK0 not an integer box") (\\MP.RESIDENT 13 "Fault on resident page") (\\MP.STACKFAULT 14 "Fault on stack") (\\MP.VMEMTOOLONG 16 "Attempt to extend Vmem File beyond fixed limit (8mb)") ( \\MP.WRITING.LOCKED.PAGE 17 "Writing a locked page with UPDATEKEY = T") (\\MP.UNINTERRUPTABLE 18 "Error in uninterruptable system code") (\\MP.STACKFULL 19) (\\MP.MDSFULL 20) (\\MP.UNKNOWN.UFN 21) ( \\MP.ATOMSFULL 22) (\\MP.PNAMESFULL 23) (\\MP.USECOUNTOVERFLOW 24) (\\MP.MDSFULLWARNING 25) ( \\MP.BADMDSFREELIST 26) (\\MP.BADARRAYBLOCK 27) (\\MP.BADDELETEBLOCK 28) (\\MP.BADARRAYRECLAIM 29) ( \\MP.BIGREFCNTMISSING 30 "PTR refcnt previously overflowed, but not found in table.") ( \\MP.BIGREFCNTALREADYPRESENT 31 "PTR already in overflow table") (\\MP.DELREF0 32) (\\MP.PROCERROR 33) (\\MP.PROCNOFRAME 34 "Failed to build frame for PROCESS use") (\\MP.32MBINUSE 35) (\\MP.TOPUNWOUND 36 "Unexpected (RETTO T)") (\\MP.STACKRELEASED 37) (\\MP.FLUSHLOCKED 38) (\\MP.MAPNOTLOCKED 39) ( \\MP.UNLOCKINGMAP 40) (\\MP.SWAPDISKERROR 41 "Hard Disk Error in swapper") (\\MP.BADRUNTABLE 42 "Malformed run table for vmem file")) (GLOBALVARS \\ARRAYSPACE \\ARRAYSPACE2 \\ATOMSPACE |\\AtomHashTable| \\SMALLPOSPSPACE \\SMALLNEGSPACE \\PNPSPACE \\OLDATOMSPACE \\DEFSPACE \\VALSPACE \\PLISTSPACE \\PAGEMAP |\\PageMapTBL| |\\InterfacePage| \\IOPAGE |\\DoveIORegion| \\IOCBPAGE \\FPTOVP |\\MDSTypeTable| \\MISCSTATS |\\UFNTable| |\\DTDSpaceBase| \\LISTPDTD \\LOCKEDPAGETABLE \\STACKSPACE \\HTMAIN \\HTOVERFLOW \\HTBIGCOUNT \\HTCOLL \\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) (DLMOUSETIMER FIXP) (DLMOUSETEMP FIXP)) (CREATE (\\ALLOCBLOCK 31))) (BLOCKRECORD IFPAGE ((|CurrentFXP| WORD) (* \; "First 7 items are FX values for user and 6 system contexts.") (|ResetFXP| WORD) (|SubovFXP| WORD) ( |KbdFXP| WORD) (|HardReturnFXP| WORD) (GCFXP WORD) (FAULTFXP WORD) (|EndOfStack| WORD) (* \; "Stack high-water mark: address of guard block at current end of stack") (|LVersion| WORD) (* \; "Lisp version, followed by min versions of microcode and Bcpl compatible with this Lisp") ( |MinRVersion| WORD) (|MinBVersion| WORD) (|RVersion| WORD) (* \; "Bcpl fills in the actual microcode, Bcpl versions.") (|BVersion| WORD) (|MachineType| WORD) ( |MiscFXP| WORD) (* \; "FX for MISC context") (|Key| WORD) (* \; "= IFPValidKey if vmem consistent.") ( |SerialNumber| WORD) (* \; "Pup host number (Dorado/Dolphin)") (|EmulatorSpace| WORD) (* \; "Hiloc of bcpl space (always zero now)") (|ScreenWidth| WORD) (|NxtPMAddr| WORD) (* \; "Next page to be allocated in secondary page map table") (NIL WORD) (* \; "WAS NActivePages, Length of vmem in use") (NIL WORD) (* \; "WAS NDirtyPages, not used, but maintained as = NActivePages") (|filePnPMP0| WORD) (* \; "Sysout page number of first page of secondary page map table (\\PAGEMAP), which is where the secondary map pages themselves live" ) (|filePnPMT0| WORD) (* \; "Sysout page number of first page of primary page map table") (TELERAIDFXP WORD) (* \; "FX for TeleRaid server context") (NATIVE-START-MEM-PAGE WORD) (* \; "Unix page where native code starts") (NATIVE-LENGTH-PAGE WORD) (* \; "Unix page length of native code") (NATIVE-PAGE-OFFSET WORD) (* \; "Lisp Disk Page offset of native code") (|UserNameAddr| WORD) (* \; "Addresses in bcpl space (seg 0) of global user name and password") (|UserPswdAddr| WORD) (|StackBase| WORD) (* \; "Stack address where user stack starts") (FAULTHI WORD) (* \; "Microcode for page fault stores fault address here, then does context switch to FAULTFXP") (FAULTLO WORD) (DEVCONFIG WORD) (* \; "IT'S FOR KB,DISP TYPE") (* \; "Formerly REALPAGETABLE, back when it was always in Bcpl space.") (RPTSIZE WORD) (* \; "Number of entries in Real Page Table") (RPOFFSET WORD) (* \; "RP-RPOFFSET => index in table") ( MAXETHERBYTES WORD) (* \; "Number of bytes available in a pbi, not counting encapsulation (Dorado)") ( EMBUFVP WORD) (* \; "VP of a one-page emulator buffer") (|NSHost0| WORD) (* \; "Machine's 48-bit NS host number. Lisp manages to compute this on all machines except Dolphin, where Bcpl fills it in." ) (|NSHost1| WORD) (|NSHost2| WORD) (|MDSZone| WORD) (* \; "Obsolete -- was used by Dolphin 10MB network code.") (|MDSZoneLength| WORD) (EMUBUFFERS WORD) (* \; "Buffer space in segment 0 for swapping/disk activity") (EMUBUFLENGTH WORD) (* \; "Number of words of said space") (* |;;| "The following 2 are available if NEW_STOARGE is specified in C") (|ProcessSize| WORD) (* \; "Process size for which can be use as LISP space") (|StorageFullState| WORD) (* \; "Save last storage state") (ISFMAP WORD) (* |;;| "The following 4 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) (* \; "Number pages of real memory") ( |LastLockedFilePage| WORD) (* \; "Last page of vmem that is locked--booting has to load at least that far.") (|LastDominoFilePage| WORD ) (* \; "Last sysout page reserved for Dandelion microcode") (|FPTOVPStart| WORD) (* \; "Sysout page where FPTOVP starts") (FAKEMOUSEBITS WORD) (* \; "Used to implement fake middle button on 2-button Dandelion.") (|DL24BitAddressable| WORD) (* \; "non-zero if DLion capable of addressing 32MB virtual memory") (REALPAGETABLEPTR FULLXPOINTER) (* \; "Address of real page table, set up by Bcpl (but not chained together)") (SYSDISK WORD) (* \; "WAS DLLastVmemPage, DLion booting microcode puts length of vmem file here.") (|FullSpaceUsed| WORD) ( * \; "Non-zero if vmem beyond initial 8MB has been allocated.") (FAKEKBDAD4 WORD) (FAKEKBDAD5 WORD) (* |;;| "The following 9 items (6 words and 3 pointers) are 3 3-element vectors for the Dorado extended virtual memory code--indexed by 0,1,2 according to which of up to 3 virtual memory backing files you're working with." ) (|XVmemFmapBase| WORD) (* \; "Bcpl stores isf map pointer to each partition here. First is redundant with ISFMAP field above.") ( NIL WORD) (NIL WORD) (|XVmemFmapHighBase| WORD) (* \; "Bcpl stores the highest vm page contained in this or earlier partition.") (NIL WORD) (NIL WORD) ( |XVmemDiskBase| FULLXPOINTER) (* \; "Lisp stores disk objects here (just a convenient non-faulting contiguous block of storage).") (NIL FULLXPOINTER) (NIL FULLXPOINTER) (|DLLastVmemPage| FIXP) (* \; "DLion booting microcode puts length of vmem file here.") (|NActivePages| FIXP) (* \; "Length of vmem in use") (|NDirtyPages| FIXP) (* \; "not used, but maintained as = NActivePages")) ( CREATE (\\ALLOCBLOCK 43))) (BLOCKRECORD IOPAGE ((NIL 18 WORD) (DLMAINTPANEL WORD) (DLFLOPPYCMD WORD) (DLTTYPORTCMD WORD) ( DLPROCESSORCMD WORD) (NEWMOUSESTATE WORD) (DLBEEPCMD WORD) (DLRS232CMISCCOMMAND WORD) (DLRS232CPUTFLAG WORD) (DLRS232CGETFLAG WORD) (NIL 6 WORD) (DLFLOPPY WORD) (DLTTYOUT WORD) (NIL 1 WORD) (DLTTYIN WORD) (NIL 1 WORD) (DLPROCESSOR2 WORD) (DLPROCESSOR1 WORD) (DLPROCESSOR0 WORD) (NEWMOUSEX WORD) (NEWMOUSEY WORD) (DLBEEPFREQ WORD) (DLRS232CPARAMETERCSBLO WORD) (DLRS232CPARAMETERCSBHI WORD) ( DLRS232CSETRS366STATUS 3 WORD) (DLRS232CPUTCSBLO WORD) (DLRS232CPUTCSBHI WORD) (DLRS232CGETCSBLO WORD) (DLRS232CGETCSBHI WORD) (DLRS232CDEVICESTATUS WORD) (DLRS232CPARAMETEROUTCOME WORD) (DLTODVALID WORD) (DLTODLO WORD) (DLTODHI WORD) (DLTODLO2 WORD) (DLMOUSEX WORD) (DLMOUSEY WORD) (DLUTILIN WORD) ( DLKBDAD0 WORD) (DLKBDAD1 WORD) (DLKBDAD2 WORD) (DLKBDAD3 WORD) (DLKBDAD4 WORD) (DLKBDAD5 WORD) ( DLLSEPIMAGECSB 32 WORD) (DLIOPHARDWARECONFIG WORD) (NIL 11 WORD) (DLRS232CPARAMETERCSBLO.11 WORD) ( DLRS232CPARAMETERCSBHI.11 WORD) (DLRS232CSETRS366STATUS.11 14 WORD) (NIL 60 WORD) (DLMAGTAPE 4 WORD) ( DLETHERNET 12 WORD) (NIL 31 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)) (DLETHERNETPTR (\\ADDBASE DATUM 192)) (DLKBDAD5PTR ( \\ADDBASE DATUM 67)) (DLKBDAD4PTR (\\ADDBASE DATUM 66)) (DLKBDAD3PTR (\\ADDBASE DATUM 65)) ( DLKBDAD2PTR (\\ADDBASE DATUM 64)) (DLKBDAD1PTR (\\ADDBASE DATUM 63)) (DLKBDAD0PTR (\\ADDBASE DATUM 62) ) (DLUTILINPTR (\\ADDBASE DATUM 61)) (DLMOUSEYPTR (\\ADDBASE DATUM 60)) (DLMOUSEXPTR (\\ADDBASE DATUM 59)) (DLTODLOPTR (\\ADDBASE DATUM 56)) (DLMAINTPANELPTR (\\ADDBASE DATUM 18)))) (CREATE (\\ALLOCBLOCK 128))) (PUTPROPS EMADDRESS MACRO (ARGS ((LAMBDA (ADDR) (COND ((EQ |\\D1BCPLspace| |\\D0BCPLspace|) (LIST ( BIG-VMEM-CODE (LIST (QUOTE OPCODES) (QUOTE GCONST) 0 0 (LRSH ADDR 8) (LOGAND ADDR 255)) (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 "31-Jan-1998 09:16:51")) (DATATYPE COMPILED-CLOSURE (FNHEADER ENVIRONMENT)) (RPAQQ \\COMPILED-CLOSURE 13) (CONSTANTS \\COMPILED-CLOSURE) (PUTPROPS \\EXTENDED.EQP MACRO (OPENLAMBDA (X Y) (COND ((EQ (NTYPX X) (NTYPX Y)) (SELECTC (NTYPX X) ( \\STACKP (EQ (|fetch| (STACKP EDFXP) |of| X) (|fetch| (STACKP EDFXP) |of| Y))) (\\COMPILED-CLOSURE ( EQDEFP X Y)) NIL))))) (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 (OPENLAMBDA (DEF LC) (LOGOR (LLSH (CODELT DEF LC) BITSPERBYTE) (CODELT DEF ( ADD1 LC))))) (PUTPROPS CODESETA2 MACRO (OPENLAMBDA (DEF LC VALUE) (CODESETA DEF LC (LRSH VALUE BITSPERBYTE)) ( CODESETA DEF (ADD1 LC) (IMOD VALUE (CONSTANT (LLSH 1 BITSPERBYTE)))))) (PUTPROPS CODESETA MACRO ((CA N NV) (\\BYTESETA CA N NV))) (PUTPROPS BYTESPERNAMEENTRY MACRO (NIL (UNFOLD (CONSTANT (WORDSPERNAMEENTRY)) BYTESPERWORD))) (PUTPROPS BYTESPERNTOFFSETENTRY MACRO (NIL (UNFOLD (WORDSPERNAMEENTRY) BYTESPERWORD))) (PUTPROPS GETNAMEENTRY MACRO (OPENLAMBDA (DEF LC) (LET ((NUMBER 0)) (* |;;| "Must ALWAYS be called with DEF really being either a FNHEADER or a nametable pseudo-fnheader. Never use addbase to offset from it. This is because CODEBASEELT checks the BYTESWAPPED flag in the fnheader...." ) (FOR I FROM 0 TO (CONSTANT (SUB1 (BYTESPERNAMEENTRY))) DO (SETQ NUMBER (LOGOR (LLSH NUMBER BITSPERBYTE) (CODEBASELT DEF (IPLUS LC I))))) NUMBER))) (PUTPROPS GETNTFLAGS MACRO (OPENLAMBDA (DEF LC) (CODEBASELT DEF LC))) (PUTPROPS GETNTOFFSET MACRO (OPENLAMBDA (DEF LC) (NTSLOT-OFFSET (GETNTOFFSETENTRY DEF LC)))) (PUTPROPS GETNTOFFSETENTRY MACRO (OPENLAMBDA (DEF LC) (LET ((NUMBER 0)) (|for| I |from| 0 |to| ( CONSTANT (SUB1 (BYTESPERNTOFFSETENTRY))) |do| (SETQ NUMBER (LOGOR (LLSH NUMBER BITSPERBYTE) ( CODEBASELT DEF (IPLUS LC I))))) NUMBER))) (PUTPROPS GETNTTAG MACRO (OPENLAMBDA (DEF LC) (CODEBASELT DEF (ADD1 LC)))) (PUTPROPS SETNAMEENTRY MACRO (OPENLAMBDA (DEF LC VALUE) (FOR I FROM (CONSTANT (SUB1 (BYTESPERNAMEENTRY ))) TO 0 BY -1 DO (CODEBASESETA DEF (IPLUS LC I) (LOGAND VALUE (CONSTANT (SUB1 (LLSH 1 BITSPERBYTE)))) ) (SETQ VALUE (LRSH VALUE BITSPERBYTE))))) (PUTPROPS WORDSPERNTOFFSETENTRY MACRO (NIL (WORDSPERNAMEENTRY))) (PUTPROPS NTSLOT-OFFSET MACRO ((X) (LOGAND 255 X))) (DEFMACRO NEW-SYMBOL-CODE (NEW-SYMBOL-FORM OLD-SYMBOL-FORM) (* |;;| "Use one form or another, depending on whether we're compiling for new 3-byte atoms or old 2-byte atom numbers." ) (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) (* \; "NEW ATOMS") (BQUOTE (\\\, NEW-SYMBOL-FORM))) (T (BQUOTE (\\\, OLD-SYMBOL-FORM))))) (DEFOPTIMIZER BIG-VMEM-CODE (NEW-SYMBOL-FORM OLD-SYMBOL-FORM &ENVIRONMENT ENV) (* |;;| "Allow for differences between 4-byte pointers and 3-byte pointers..") (COND ((FMEMB :4-BYTE ( COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\\\, NEW-SYMBOL-FORM))) (T (BQUOTE (\\\, OLD-SYMBOL-FORM))))) (DEFOPTIMIZER SETSTKNAMEENTRY (CODEARRAY OFFSET VAL &ENVIRONMENT ENV) (* |;;| "Set the name entry for a name-table entry.") (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (LET ((BASE (|fetch| (ARRAYP BASE) |of| (\\\, CODEARRAY))) (VALUE (\\\, VAL))) (COND (( FIXP VALUE) (* \; "A 20-byte atom #. Make it an atom.") (\\PUTBASEPTR BASE (\\\, OFFSET) (\\VAG2 |\\AtomHI| VALUE))) (T (* \; "A 3-byte atom. Just use it.") (\\PUTBASEPTR BASE (\\\, OFFSET) VALUE))) ))) (T (BQUOTE (LET ((BASE (|fetch| (ARRAYP BASE) |of| (\\\, CODEARRAY)))) (\\PUTBASE BASE (\\\, OFFSET) (\\\, VAL))))))) (DEFOPTIMIZER SETSTKNTOFFSETENTRY (BASE OFFSET VAL &ENVIRONMENT ENV) (* |;;| "Set the offset entry for a name-table entry.") (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\\PUTBASEFIXP (\\\, BASE) (\\\, OFFSET) (\\\, VAL)))) (T (BQUOTE (\\PUTBASE (\\\, BASE ) (\\\, OFFSET) (\\\, VAL)))))) (DEFOPTIMIZER GETSTKNAMEENTRY (BASE OFFSET &ENVIRONMENT ENV) (* |;;| "Get a name entry out of a name table. BASE is the start of the name table; OFFSET is in words, not bytes or name entries." ) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\\GETBASEPTR (\\\, BASE) ( \\\, OFFSET)))) (T (BQUOTE (\\GETBASE (\\\, BASE) (\\\, OFFSET)))))) (DEFOPTIMIZER GETSTKNTOFFSETENTRY (BASE OFFSET &ENVIRONMENT ENV) (COND ((FMEMB :3-BYTE ( COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\\GETBASEFIXP (\\\, BASE) (\\\, OFFSET)))) (T (BQUOTE (\\GETBASE (\\\, BASE) (\\\, OFFSET)))))) (DEFOPTIMIZER WORDSPERNAMEENTRY (&ENVIRONMENT ENV) (* |;;| "Number of words in a name-table \"Name\" entry--the space for the symbol. 1 for old symbol systems, 2 for 3-byte-atom systesm." ) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (PROGN 2))) ((AND CROSSCOMPILING (FMEMB :3-BYTE-INIT (COMPILER::ENV-TARGET-ARCHITECTURE ENV))) (BQUOTE (PROGN 2))) (T ( BQUOTE (PROGN 1))))) (DEFOPTIMIZER SETSTKNTOFFSET (BASE OFFSET TYPE VAL &ENVIRONMENT ENV) (* |;;| "Set the offset entry for a name-table entry, from the symbol to fill in plus the variable-type marker value SHIFTED LEFT 14 BITS ALREADY." ) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (PROGN (\\FIXCODENUM (\\\, BASE) (IDIFFERENCE (\\\, OFFSET) BYTESPERWORD) (\\\, TYPE)) (\\FIXCODENUM (\\\, BASE) (\\\, OFFSET) ( \\\, VAL))))) (T (BQUOTE (\\FIXCODENUM (\\\, BASE) (\\\, OFFSET) (IPLUS (\\\, TYPE) (\\\, VAL))))))) (DEFOPTIMIZER SETSTKNAME-RAW (BASE OFFSET VAL &ENVIRONMENT ENV) (* |;;| "Set the name entry for a name-table entry. This version works with raw storage, as opposed to SETSTKNAMEENTRY, which works on an ARRAYP." ) (* |;;| "If this optimizer changes, change SETSTKNAMEENTRY as well.") (COND ((FMEMB :3-BYTE ( COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (LET ((VALUE (\\\, VAL))) (COND ((FIXP VALUE) (* \; "A 20-byte atom #. Make it an atom.") (\\PUTBASEPTR (\\\, BASE) (\\\, OFFSET) (\\VAG2 |\\AtomHI| VALUE))) (T (* \; "A 3-byte atom. Just use it.") (\\PUTBASEPTR (\\\, BASE) (\\\, OFFSET) VALUE)))))) (T (BQUOTE (\\PUTBASE (\\\, BASE) (\\\, OFFSET) (\\\, VAL)))))) (DEFOPTIMIZER SETSTKNTOFFSET-RAW (BASE OFFSET TYPE VAL &ENVIRONMENT ENV) (* |;;| "Set the offset entry for a name-table entry. This version works on raw storage, vs SETSTKNAMEOFFSETENTRY, which is supposed to work on codearrays. Any changes here should be made there, as well. TYPE must already be shifted left by 14 bits." ) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (PROGN (\\PUTBASE (\\\, BASE) (\\\, OFFSET) (\\\, TYPE)) (\\PUTBASE (\\\, BASE) (IPLUS (\\\, OFFSET) 1) (\\\, VAL))))) (T (BQUOTE ( \\PUTBASE (\\\, BASE) (\\\, OFFSET) (IPLUS (\\\, TYPE) (\\\, VAL))))))) (DEFOPTIMIZER NEW-SYMBOL-CODE (NEW-SYMBOL-FORM OLD-SYMBOL-FORM &ENVIRONMENT ENV) (* |;;| "Allow for differences between 3-byte atoms and 2-byte atoms.") (COND ((FMEMB :3-BYTE ( COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (\\\, NEW-SYMBOL-FORM))) (T (BQUOTE (\\\, OLD-SYMBOL-FORM))))) (DEFOPTIMIZER MAKE-NTENTRY (TYPE OFFSET &ENVIRONMENT ENV) (COND ((FMEMB :3-BYTE ( COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (IPLUS (CONSTANT (LLSH (\\\, TYPE) 16)) (\\\, OFFSET)) )) (T (BQUOTE (IPLUS (CONSTANT (\\\, TYPE)) (\\\, OFFSET)))))) (DEFOPTIMIZER NULL-NTENTRY (VALUE &ENVIRONMENT ENV) (* |;;| "Predicate: Is VALUE a null entry in a name table? I.e., does it result from fetching the entry at the end that`s all zeros? For 2-byte atoms, that's the same as being zero. For 3-byte atoms, it's the same as being NIL." ) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (NULL (\\\, VALUE)))) (T ( BQUOTE (EQ (\\\, VALUE) 0))))) (DEFOPTIMIZER NTSLOT-VARTYPE (X &ENVIRONMENT ENV) (* |;;| "Given the contents of a name-table Offset entry, return the variable-type bits at the top of the entry. THE RESULT IS RETURNED SHEFTED LEFT 14 BITS, THE USUAL REPRESENTATION." ) (COND ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) (BQUOTE (LOGAND 49153 (LRSH (\\\, X) 16)))) (T (BQUOTE (LOGAND (\\\, X) 49152))))) (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) 207) (LLSH (LOGAND NEWVALUE 3) 4)))) (FRAMENAME (\\VAG2 (LOGAND (CODELT2 DATUM 8) 4095) (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| (\\STKMIN DATUM))) (FRAMENAME# (PROGN 8))))) (RECORD OPCODE (OP# OPCODENAME OPNARGS OPPRINT LEVADJ UFNFN UNIMPL)) (GLOBALVARS \\OPCODES) (RPAQQ PVARCODE 32768) (RPAQQ FVARCODE 49152) (RPAQQ IVARCODE 0) (RPAQQ VARCODEMASK 49152) (CONSTANTS PVARCODE FVARCODE IVARCODE VARCODEMASK) (RPAQQ \\NT.IVARCODE 0) (RPAQQ \\NT.PVARCODE 2) (RPAQQ \\NT.FVARCODE 3) (CONSTANTS \\NT.IVARCODE \\NT.PVARCODE \\NT.FVARCODE) (PUTPROP (QUOTE LLCODE) (QUOTE IMPORTDATE) (IDATE "19-Jan-1993 10:45:33")) (RPAQQ \\ERRORMESSAGELIST ("SYSTEM ERROR" " " "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")) (DEFOPTIMIZER LISPERROR (MESSAGE ARG) (BQUOTE (\\LISPERROR (\\\, ARG) (\\\, (CL:IF (CL:STRINGP MESSAGE ) (FOR X IN \\ERRORMESSAGELIST AS I FROM 0 WHEN (CL:EQUAL X MESSAGE) DO (RETURN I) FINALLY (RETURN ( HELP "Unknown error message" (LIST MESSAGE ARG)))) MESSAGE))))) (PUTPROP (QUOTE AERROR) (QUOTE IMPORTDATE) (IDATE "16-May-1990 11:58:35")) (RECORD BASEBYTESTREAM STREAM (SUBRECORD STREAM) (ACCESSFNS ((BIASOFFST (|fetch| (STREAM FW6) |of| DATUM) (|replace| (STREAM FW6) |of| DATUM |with| NEWVALUE)) (BBSNCHARS (|fetch| (STREAM FW7) |of| DATUM) (|replace| (STREAM FW7) |of| DATUM |with| NEWVALUE)) (WRITEXTENSIONFN (|fetch| (STREAM F1) |of| DATUM) (|replace| (STREAM F1) |of| DATUM |with| NEWVALUE))))) (PUTPROPS \\INSTREAMARG MACRO ((STRM NOERRORFLG) (\\GETSTREAM STRM (QUOTE INPUT) NOERRORFLG))) (PUTPROPS \\OUTSTREAMARG MACRO ((STRM NOERRORFLG) (\\GETSTREAM STRM (QUOTE OUTPUT) NOERRORFLG))) (PUTPROPS \\STREAMARG MACRO (OPENLAMBDA (STRM NOERRORFLG) (COND (NOERRORFLG (\\GETSTREAM STRM NIL T)) (T (\\DTEST STRM (QUOTE STREAM)))))) (PUTPROP (QUOTE AOFD) (QUOTE IMPORTDATE) (IDATE "13-Sep-1990 16:39:58")) (PUTPROPS .SPACECHECK. MACRO ((STRM N) (AND \\THISFILELINELENGTH (IGREATERP (IPLUS N (|fetch| CHARPOSITION |of| STRM)) \\THISFILELINELENGTH) (FRESHLINE STRM)))) (PUTPROPS \\CHECKRADIX MACRO (LAMBDA (R) (COND ((OR (NOT (SMALLP R)) (ILESSP R 1) (IGREATERP R 36)) ( \\INVALID.RADIX R)) (T R)))) (PUTPROPS \\XCCSFILEOUTCHARFN MACRO ((OUTSTREAM CHARCODE) (* |;;;| "Encoder for XCCS format. Default decoder.") (COND ((EQ CHARCODE (CHARCODE EOL)) (COND ((NOT ( \\RUNCODED OUTSTREAM)) (* \; "Charset is a constant 0") (\\BOUT OUTSTREAM (\\CHARSET (CHARCODE EOL)))) ((EQ (\\CHARSET (CHARCODE EOL)) (|ffetch| (STREAM CHARSET) |of| OUTSTREAM))) (T (\\BOUT OUTSTREAM NSCHARSETSHIFT) (\\BOUT OUTSTREAM (|freplace| (STREAM CHARSET) |of| OUTSTREAM |with| (\\CHARSET ( CHARCODE EOL)))))) (\\BOUT OUTSTREAM (SELECTC (|ffetch| EOLCONVENTION |of| OUTSTREAM) (CR.EOLC ( CHARCODE CR)) (LF.EOLC (CHARCODE LF)) (CRLF.EOLC (\\BOUT OUTSTREAM (CHARCODE CR)) (* |;;| "Don't put out high-order byte preceding LF. The CRLF is EOL only if the bytes are immediately adjacent in the stream, with no additional encoding bytes" ) (CHARCODE LF)) (SHOULDNT))) (|freplace| CHARPOSITION |of| OUTSTREAM |with| 0)) (T (COND ((NOT ( \\RUNCODED OUTSTREAM)) (\\BOUT OUTSTREAM (\\CHARSET CHARCODE)) (\\BOUT OUTSTREAM (\\CHAR8CODE CHARCODE ))) ((EQ (\\CHARSET CHARCODE) (|ffetch| (STREAM CHARSET) |of| OUTSTREAM)) (\\BOUT OUTSTREAM ( \\CHAR8CODE CHARCODE))) (T (\\BOUT OUTSTREAM NSCHARSETSHIFT) (\\BOUT OUTSTREAM (|freplace| (STREAM CHARSET) |of| OUTSTREAM |with| (\\CHARSET CHARCODE))) (\\BOUT OUTSTREAM (\\CHAR8CODE CHARCODE)))) ( |freplace| CHARPOSITION |of| OUTSTREAM |with| (PROGN (* \; "Ugh. Don't overflow") (IPLUS16 (|ffetch| CHARPOSITION |of| OUTSTREAM) 1))))))) (PUTPROP (QUOTE APRINT) (QUOTE IMPORTDATE) (IDATE "17-Jan-2020 05:51:20")) (GLOBALVARS \\BCPLDISPLAY) (ACCESSFNS LINEBUFFER ((LPARCOUNT (|fetch| FW6 |of| DATUM) (|replace| FW6 |of| DATUM |with| NEWVALUE)) (LBRKCOUNT (|fetch| FW7 |of| DATUM) (|replace| FW7 |of| DATUM |with| NEWVALUE)) (LINEBUFSTATE ( |fetch| F5 |of| DATUM) (|replace| F5 |of| DATUM |with| NEWVALUE)) (* \; "F4 is free. EJS, 7/8/85") ( KEYBOARDSTREAM (|fetch| F2 |of| DATUM) (|replace| F2 |of| DATUM |with| NEWVALUE)) (PEEKEDCHAR (|fetch| F3 |of| DATUM) (|replace| F3 |of| DATUM |with| NEWVALUE)) (* \; "Character read by PEEKC") (LBFLAGS ( |fetch| FW9 |of| DATUM) (|replace| FW9 |of| DATUM |with| NEWVALUE)) (* |;;| "True if peeked char was echoed when peeked. Could use this to determine whether to echo later or not, but that would be incompatible with Interlisp-10, so this field not used" )) (ACCESSFNS LINEBUFFER ((LBFLAGBASE (LOCF (|fetch| LBFLAGS |of| DATUM)))) (BLOCKRECORD LBFLAGBASE (( PEEKEDECHOFLG FLAG) (INSTRINGP FLAG))))) (RPAQQ LINEBUFFERSTATES (FILLING.LBS READING.LBS RETYPING.LBS)) (RPAQQ FILLING.LBS 0) (RPAQQ READING.LBS 1) (RPAQQ RETYPING.LBS 2) (CONSTANTS FILLING.LBS READING.LBS RETYPING.LBS) (PUTPROPS \\INTERMP MACRO ((OFD) (EQ OFD \\LINEBUF.OFD))) (PUTPROPS \\OUTTERMP MACRO ((OFD) (EQ OFD \\TERM.OFD))) (GLOBALVARS \\DEFAULTLINEBUF) (PUTPROP (QUOTE ATERM) (QUOTE IMPORTDATE) (IDATE "16-May-1990 12:08:04")) (DATATYPE HARRAYP ((NULLSLOTS WORD) (* \; "Number of NIL-NIL slots, which break chains") (LASTINDEX WORD) (* \; "Slot offset of last slot. Used in probe computations computations. Microcode support for \\ADDBASE4 would help" ) (HARRAYPBASE POINTER) (RECLAIMABLE FLAG) (* \; "True if keys can go away when no other refs") ( OVERFLOWACTION POINTER) (NUMSLOTS WORD) (* \; "The maximum number of logical slots--returned by HARRAYSIZE") (NUMKEYS WORD) (* \; "The number of distinct keys in the array") (HASHBITSFN POINTER) (EQUIVFN POINTER) (HASHUSERDATA POINTER))) (PUTPROPS \\EQHASHINGBITS MACRO (OPENLAMBDA (X) (* \; "Spread out objects whose low bits are in small arithmetic progression, esp atoms") (LOGXOR (\\HILOC X ) (LOGXOR (LLSH (LOGAND (\\LOLOC X) 8191) 3) (LRSH (\\LOLOC X) 9))))) (PUTPROPS \\ADDBASE2 MACRO (OPENLAMBDA (BASE N) (\\ADDBASE (\\ADDBASE BASE N) N))) (PUTPROPS \\ADDBASE4 MACRO (OPENLAMBDA (BASE N) (\\ADDBASE2 (\\ADDBASE2 BASE N) N))) (PUTPROPS HUNKSIZEFROMNUMBER MACRO ((NTYPX) (FOLDLO (|fetch| DTDSIZE |of| (\\GETDTD NTYPX)) WORDSPERCELL))) (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) (EQ 0 (|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.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.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.CODE 4) (\\ST.PTR 6) (\\ST.FLOAT 7) ( \\ST.BIT 8) (\\ST.PTR2 11)) (RPAQQ \\MAX.CELLSPERHUNK 64) (CONSTANTS \\MAX.CELLSPERHUNK) (RPAQQ \\IN.MAKEINIT NIL) (CONSTANTS (\\IN.MAKEINIT)) (BLOCKRECORD SEQUENCEDESCRIPTOR ((ORIG BITS 1) (NIL BITS 1) (READONLY FLAG) (NIL BITS 1) (BASE POINTER ) (TYP BITS 4) (NIL BITS 4) (LENGTH BITS 24) (OFFST FIXP))) (DATATYPE ARRAYP ((* |;;| "Describes an INTERLISP ARRAYP, as opposed to a CL array.") (ORIG BITS 1) (* \; "Origin, 0 or 1") (NIL BITS 1) (READONLY FLAG) (* \; "probably no READONLY arrays now") (NIL BITS 1) (BASE POINTER) (TYP BITS 4) (* \; "Type of the contents") (NIL BITS 4) (LENGTH BITS 24) (* \; "Array's length") (OFFST FIXP) (* \; "Offset from BASE where the data really starts.")) (* |;;| "note that while ARRAYP is a DATATYPE, the allocation of it actually happens at MAKEINIT time under INITDATATYPE{NAMES}" )) (BLOCKRECORD ARRAYBLOCK ((PASSWORD BITS 13) (GCTYPE BITS 2) (* \; "Unboxed, Pointers, or 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? (AND (EQ 0 (NTYPX DATUM)) (IGEQ ( \\HILOC DATUM) |\\FirstArraySegment|)))) (GLOBALVARS |\\NxtArrayPage| \\FREEBLOCKBUCKETS \\HUNKING?) (PUTPROPS HUNKSIZEFROMNUMBER MACRO ((NTYPX) (FOLDLO (|fetch| DTDSIZE |of| (\\GETDTD NTYPX)) WORDSPERCELL))) (PUTPROP (QUOTE LLARRAYELT) (QUOTE IMPORTDATE) (IDATE "15-Sep-1994 11:08:59")) (DEFOPTIMIZER PUTBASEPTRX (&REST ARGS) (CONS (QUOTE (OPENLAMBDA (DATUM OFFSET NEWVALUE) ( UNINTERRUPTABLY (\\PUTBASE DATUM OFFSET (LOGOR (LOGAND 61440 (\\GETBASE DATUM OFFSET)) (LOGAND ( \\HILOC NEWVALUE) 4095))) (\\PUTBASE DATUM (ADD1 OFFSET) (\\LOLOC NEWVALUE)) NEWVALUE))) ARGS)) (RPAQQ \\SMALLP 1) (RPAQQ \\FIXP 2) (RPAQQ \\FLOATP 3) (RPAQQ \\LITATOM 4) (RPAQQ \\LISTP 5) (RPAQQ \\ARRAYP 6) (RPAQQ \\STACKP 8) (RPAQQ \\VMEMPAGEP 10) (RPAQQ \\STREAM 11) (RPAQQ \\NEW-ATOM 21) (CONSTANTS \\SMALLP \\FIXP \\FLOATP \\LITATOM \\LISTP \\ARRAYP \\STACKP \\VMEMPAGEP \\STREAM \\NEW-ATOM) (RPAQQ \\BUILT-IN-SYSTEM-TYPES ((SMALLP) (FIXP 2) (FLOATP 2) (LITATOM) (LISTP 4 (0 2)) (ARRAYP 6 (0)) (STRINGP 6 (0)) (STACKP 2 NIL \\RECLAIMSTACKP) (CHARACTER) (VMEMPAGEP 256 NIL RELEASINGVMEMPAGE) ( STREAM) (BITMAP) (COMPILED-CLOSURE 4 (0 2)) (ONED-ARRAY 8 (0)) (TWOD-ARRAY 10 (0)) (GENERAL-ARRAY 10 ( 0 8)) (BIGNUM) (RATIO) (COMPLEX) (PATHNAME) (NEW-ATOM 10 (2 4 6)) (FILLER22) (FILLER23) (FILLER24) ( FILLER25) (FILLER26) (FILLER27) (FILLER28) (FILLER29) (FILLER30))) (BLOCKRECORD DTD ((NIL BITS 2) (DTDOBSOLETE FLAG) (* \; "True for type of a redeclared datatype--not allowed to allocate more of these") (DTDFINALIZABLE FLAG) (* \; "True if finalization exists for this type") (DTDNAME POINTER) (* \; "Type name -- a symbol ") (DTDCNT0 WORD) (* \; "Incremental box count -- this plus DTDOLDCNT is the true box count") (DTDSIZE WORD) (* \; "Length of datum in words") (DTDFREE FULLXPOINTER) (* \; "Pointer to first object on free chain, or NIL. Not used for LISTP") (DTDLOCKEDP FLAG) (* \; "True if objects of this type must be locked down (not pagefault)") (DTDHUNKP FLAG) (* \; "True if this type is used as an array hunk type") (DTDGCTYPE BITS 2) (* \; "For hunk datatypes, is analogous to arrayblock's GCTYPE") (DTDDESCRS POINTER) (DTDTYPESPECS POINTER) (DTDPTRS POINTER) (* \; "List of word offsets inside datum where reference-counted pointers are stored -- used by GC") ( DTDOLDCNT FIXP) (* \; "'Box count' -- number of objects of this type ever allocated") (DTDNEXTPAGE FIXP) (* \; "Currently only for LISTP pages -- page number of next page on chain of non-full cons pages") ( DTDTYPEENTRY WORD) (* |;;| "The word stored in the type table for objects of this type. Hi bits have numberp tags, ref countable, etc." ) (DTDSUPERTYPE WORD) (* \; "Type number of immediate supertype, or zero if none")) (ACCESSFNS DTD (( DTDCNTLOC (\\ADDBASE DATUM 4)) (DTDCNT (IPLUS (|fetch| DTDOLDCNT DATUM) (|fetch| DTDCNT0 DATUM)) ( UNINTERRUPTABLY (|replace| DTDOLDCNT |of| DATUM |with| NEWVALUE) (|replace| DTDCNT0 |of| DATUM |with| 0)))))) (PUTPROPS \\GETDTD MACRO ((|typeNum|) (ADDBASE |\\DTDSpaceBase| (ITIMES |typeNum| 18)))) (DEFOPTIMIZER \\TYPEMASK.UFN (&REST X) (LET ((CE (CONSTANTEXPRESSIONP (CADR X)))) (|if| CE |then| ( BQUOTE ((OPCODES TYPEMASK.N (\\\, (CAR CE))) (\\\, (CAR X)))) |else| (QUOTE IGNOREMACRO)))) (RPAQQ \\GUARDSTORAGEFULL 128) (RPAQQ \\GUARD1STORAGEFULL 64) (CONSTANTS \\GUARDSTORAGEFULL \\GUARD1STORAGEFULL) (GLOBALVARS |\\NxtMDSPage| |\\LeastMDSPage| |\\SecondArrayPage| |\\SecondMDSPage| \\MDSFREELISTPAGE |\\MaxSysTypeNum| |\\MaxTypeNumber| \\STORAGEFULL \\INTERRUPTSTATE \\PENDINGINTERRUPT) (PUTPROP (QUOTE LLDATATYPE) (QUOTE IMPORTDATE) (IDATE "28-Jun-1999 16:57:50")) (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. DMACRO (OPENLAMBDA (X) (COND ((SMALLPOSP X) X) (T (\\ILLEGAL.ARG X)))) ) (PUTPROPS .COERCE.TO.BYTE. DMACRO (OPENLAMBDA (X) (COND ((AND (SMALLPOSP X) (ILESSP X (CONSTANT (LLSH 1 BITSPERBYTE)))) X) (T (\\ILLEGAL.ARG X))))) (BLOCKRECORD LISTP ((* |;;| "Describes a CONS cell.") (CAR POINTER) (CDR POINTER)) (CREATE (CREATECELL \\LISTP)) (* |;;| "FOLLOWING ARE CDR-CODE FIELDS") (BLOCKRECORD LISTP ((CDRCODE BITS 4) (CARFIELD XPOINTER))) (* |;;| "For chaining together free cells on a page:") (BLOCKRECORD LISTP ((NEXTFREE BYTE) (NIL BITS 24))) (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 ((* |;;| "Describes a page of CONS cells, which (when free) are chained together thru the top byte.") (NIL 2 FIXP) (* \; "Empty cells, space for another 2 CONS cells if we can figure out how.") (CNT BYTE) (* \; "# of cells free on this page") (NEXTCELL BYTE) (* \; "WORD offset of next free cell (not guaranteed to be 0 if no free cells)") (NIL WORD) (* \; "Padding") (NEXTPAGE FIXP) (* \; "Next CONS page on the DTD's free list, for searching for cells."))) (RPAQQ CONSCONSTANTS (\\CDR.ONPAGE \\CDR.NIL \\CDR.INDIRECT \\CDR.MAXINDIRECT \\CONSPAGE.LAST)) (RPAQQ \\CDR.ONPAGE 8) (RPAQQ \\CDR.NIL 8) (RPAQQ \\CDR.INDIRECT 0) (RPAQQ \\CDR.MAXINDIRECT 7) (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 " 2-Feb-1995 16:21:44")) (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| DMACRO (OPENLAMBDA (A) (PROG ((LO (IPLUS16 (\\GETBASE A 1) 1))) (DECLARE ( LOCALVARS LO)) (* \; "Increment double word at A by 1") (\\PUTBASE A 1 LO) (COND ((EQ LO 0) (\\PUTBASE A 0 (ADD1 (\\GETBASE A 0)))))))) (PUTPROPS IPLUS16 MACRO ((X Y) (* \; "Kludge to do 16-bit plus") (\\LOLOC (\\ADDBASE X Y)))) (PUTPROPS SMALLPOSP MACRO (OPENLAMBDA (X) (AND (SMALLP X) (IGEQ X 0)))) (PROGN (PUTPROPS SETXVAR MACRO (X (BQUOTE (SETQ.NOREF \, (CADAR X) \, (CADR X))))) (PUTPROPS SETXVAR DMACRO (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 VAL) (\\PUTBASEPTR (LOCF (|fetch| (LITATOM VALUE) |of| (QUOTE VAR))) 0 VAL))) (PROGN (PUTPROPS IEQ MACRO ((X Y) (IEQP X Y))) (PUTPROPS IEQ DMACRO (= . EQ))) (RPAQQ |WordsPerPage| 256) (CONSTANTS |WordsPerPage|) (ACCESSFNS LITATOM ((DEFINITIONCELL (\\DEFCELL DATUM)) (PROPCELL (\\PROPCELL DATUM)) (VCELL (\\VALCELL DATUM)) (PNAMECELL (\\PNAMECELL DATUM))) (* |;;| "VCELL can also be accessed directly from a value index via the record VALINDEX (as in \\SETGLOBALVAL.UFN) --- Similarly, PNAMEINDEX accesses PNAMECELL for use by \\MKATOM and UNCOPYATOM" ) (TYPE? (LITATOM DATUM)) (BLOCKRECORD PROPCELL ((NIL BITS 4) (* \; "former flags locations") ( PROPLIST POINTER) (NIL BITS 8) (* \; "Package byte") (NIL BITS 8) (* \; "Flags from defcell") (* |;;| "PROPCell flags:") (NIL BITS 1) (GENSYMP FLAG) (FATPNAMEP FLAG) (NIL BITS 5) (* |;;| "Filler for final cell:") (NIL BITS 8)))) (SYNONYM CL:SYMBOL (LITATOM)) (ACCESSFNS VALINDEX ((VCELL (COND ((AND (FIXP DATUM) (ILESSP DATUM 65535)) (* \; "Xerox Lisp traditional symbol") (\\ADDBASE2 \\PNPSPACE (IPLUS \\NEWATOM-VALOFFSET (ITIMES 10 DATUM))) ) (T (* \; "New symbol") (* \; "'90/07/19 ON") (\\ADDBASE DATUM \\NEWATOM-VALOFFSET)))))) (BLOCKRECORD VCELL ((VALUE FULLPOINTER))) (BLOCKRECORD DEFINITIONCELL ((CCODEP FLAG) (FASTP FLAG) (ARGTYPE BITS 2) (* \; "Former flag location") (DEFPOINTER POINTER) (NIL POINTER) (* \; "Proplist cell") (NIL BITS 8) (* \; "package") (* |;;| "DEFCELL flags overflow from top 4 bits of the real cell:") (NIL BITS 4) (PSEUDOCODEP FLAG) (NIL BITS 3) (* |;;| "proplist falgs and filler:") (NIL BITS 16)) (BLOCKRECORD DEFINITIONCELL ((DEFCELLFLAGS BITS 4) (NIL POINTER) (* \; "defn ptr") (NIL BITS 4) (NIL POINTER) (* \; "filler for proplist ptr") ( NIL BITS 8) (AUXDEFCELLFLAGS BYTE) (NIL BITS 16)))) (BLOCKRECORD FNHEADER ((STKMIN WORD) (NA SIGNEDWORD) (PV SIGNEDWORD) (STARTPC WORD) (CLOSUREP FLAG) (* \; "T if this is a \"compiled closure\"") (BYTESWAPPED FLAG) (* \; "T if, on 386, we reswapped the code section of this function for faster access.") (ARGTYPE BITS 2) (* \; "0 = LAMBDA") (* \; "2 = LAMBDA nospread") (* \; "1 = NLAMBDA") (* \; "3 = NLAMBDA nospread") (* |;;| "4 NIL BITS USED TO BE HERE.") (\#FRAMENAME XPOINTER) (NTSIZE WORD) (* \; "Size of the Name Table, IN WORDS. This value is always rounded up to the next Quad-word in size, and there' guaranteed to be one entry of zeros in the length." ) (NLOCALS BYTE) (FVAROFFSET BYTE)) (ACCESSFNS FNHEADER ((LSTARP (ILESSP (|fetch| (FNHEADER NA) |of| DATUM) 0)) (OVERHEADWORDS (PROGN 8)) (NATIVE (PROGN NIL)) (* \; "T if this is a NATIVE-code function (never true!)") (ALIGNED (IPLUS (|fetch| (FNHEADER NTSIZE) |of| DATUM) (|fetch| (FNHEADER OVERHEADWORDS) |of| T))) (FIXED NIL (|replace| (FNHEADER STKMIN) |of| DATUM |with| (\\STKMIN DATUM T))) (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)))))) (BLOCKRECORD PNAMECELL ((NIL BITS 4) (PNAMEBASE XPOINTER) (NIL POINTER) (* \; "val, def, prop cells") (NIL POINTER) (NIL POINTER) (PACKAGEINDEX BYTE) (NIL BITS 24) (* \; "filler for other flags")) ( BLOCKRECORD PNAMECELL ((FULLPNAMEBASE FULLXPOINTER) (* \; "Replacing this smashes PACKAGEINDEX to 0")) ) (ACCESSFNS PNAMECELL ((PACKAGE (LET ((I (FETCH (PNAMECELL PACKAGEINDEX) OF DATUM))) (* \; "This ugly construct allows cl:symbol-package to run in the init, where *PACKAGE-FROM-INDEX* is not yet bound." ) (COND ((EQ 0 I) NIL) (T (CL:AREF *PACKAGE-FROM-INDEX* I)))) (REPLACE (PNAMECELL PACKAGEINDEX) OF DATUM WITH (IF (NULL NEWVALUE) THEN *UNINTERNED-PACKAGE-INDEX* ELSE (CL::%PACKAGE-INDEX NEWVALUE)))))) ) (ACCESSFNS PACKAGEINDEX ((PACKAGE (IF (EQ 0 DATUM) (* \; "This ugly construct allows cl:symbol-package to run in the init, where *PACKAGE-FROM-INDEX* is not yet bound." ) THEN NIL ELSE (CL:AREF *PACKAGE-FROM-INDEX* DATUM))))) (BLOCKRECORD PNAMEBASE ((PNAMELENGTH BYTE) (* \; "Length is always here, be the pname thin or fat") ( PNAMEFATPADDINGBYTE BYTE) (* \; "This byte is zero for fat pnames so that the pname chars are word-aligned"))) (ACCESSFNS PNAMEINDEX ((PNAMECELL (COND ((AND (FIXP DATUM) (ILESSP DATUM 65535)) (* \; "Xerox Lisp traditional symbol") (\\ADDBASE \\OLDATOMSPACE (IPLUS \\NEWATOM-PNAMEOFFSET (ITIMES 10 DATUM)))) (T (* \; "New symbol") (* \; "'90/07/19 ON") (\\ADDBASE DATUM \\NEWATOM-PNAMEOFFSET)))))) (BLOCKRECORD NEW-ATOM ((* |;;| "An extended symbol, for expanding atom space. Kept in its own datatype.") (PNAME XPOINTER) (* \; "PNAME, same as litatom.") (VALUE POINTER) (DEF POINTER) (PROPLIST POINTER) (* |;;| "Flags that used to be above the pointers, e.g. package, ccodep, gensymp:") (NIL BITS 32))) (PUTPROPS \\DEFCELL MACRO ((ATOM) (\\ATOMCELL ATOM \\DEF.HI))) (PUTPROPS \\VALCELL MACRO ((ATOM) (\\ATOMCELL ATOM \\VAL.HI))) (PUTPROPS \\PNAMECELL MACRO ((ATOM) (\\ATOMCELL ATOM \\PNAME.HI))) (PUTPROPS \\ATOMVALINDEX DMACRO (OPENLAMBDA (X) (COND ((EQ (NTYPX X) \\LITATOM) (* \; "Original litatoms") (\\LOLOC X)) ((EQ (NTYPX X) \\NEW-ATOM) (* \; "new 3-byte symbols") X) (T ( SHOULDNT))))) (PUTPROPS \\ATOMDEFINDEX DMACRO (OPENLAMBDA (X) (COND ((EQ (NTYPX X) \\LITATOM) (* \; "Original litatoms") (\\LOLOC X)) ((EQ (NTYPX X) \\NEW-ATOM) (* \; "new 3-byte symbols") X) (T ( SHOULDNT))))) (PUTPROPS \\ATOMPNAMEINDEX DMACRO (OPENLAMBDA (X) (COND ((EQ (NTYPX X) \\LITATOM) (* \; "Original litatoms") (\\LOLOC X)) ((EQ (NTYPX X) \\NEW-ATOM) (* \; "new 3-byte symbols") X) (T ( SHOULDNT))))) (PUTPROPS \\ATOMPROPINDEX DMACRO ((X) (COND ((EQ (NTYPX X) \\LITATOM) (* \; "Original litatoms") ( \\LOLOC X)) ((EQ (NTYPX X) \\NEW-ATOM) (* \; "new 3-byte symbols") X) (T (SHOULDNT))))) (PUTPROPS \\INDEXATOMPNAME DMACRO (OPENLAMBDA (X) (COND ((FIXP X) (* \; "Xerox Lisp traditional symbol") (COND ((SMALLP X) (\\VAG2 |\\AtomHI| X)) (T (\\VAG2 (LRSH X 16) ( LOGAND X 65535))))) (T (* \; "New symbol") X)))) (PUTPROPS \\INDEXATOMVAL DMACRO (OPENLAMBDA (X) (COND ((FIXP X) (* \; "Xerox Lisp traditional symbol") (COND ((SMALLP X) (\\VAG2 |\\AtomHI| X)) (T (\\VAG2 (LRSH X 16) (LOGAND X 65535))))) (T (* \; "New symbol") X)))) (PUTPROPS \\INDEXATOMDEF DMACRO (OPENLAMBDA (X) (COND ((FIXP X) (* \; "Xerox Lisp traditional symbol") (COND ((SMALLP X) (\\VAG2 |\\AtomHI| X)) (T (\\VAG2 (LRSH X 16) (LOGAND X 65535))))) (T (* \; "New symbol") X)))) (PUTPROPS \\ATOMNUMBER DMACRO (= . \\LOLOC)) (GLOBALVARS |\\NxtPnByte| |\\CurPnPage| |\\NxtAtomPage| |\\AtomFrLst| |\\OneCharAtomBase| \\PNAMES.IN.BLOCKS? \\SCRATCHSTRING COMPILEATPUTDFLG) (RPAQQ \\PNAMELIMIT 255) (RPAQQ |\\CharsPerPnPage| 512) (CONSTANTS (\\PNAMELIMIT 255) (|\\CharsPerPnPage| 512)) (RPAQQ \\NEWATOM-PNAMEOFFSET 0) (RPAQQ \\NEWATOM-VALOFFSET 2) (RPAQQ \\NEWATOM-DEFOFFSET 4) (RPAQQ \\NEWATOM-PLISTOFFSET 6) (RPAQQ \\NEWATOM-TYPE# 21) (CONSTANTS (\\NEWATOM-PNAMEOFFSET 0) (\\NEWATOM-VALOFFSET 2) (\\NEWATOM-DEFOFFSET 4) ( \\NEWATOM-PLISTOFFSET 6) (\\NEWATOM-TYPE# 21)) (PUTPROPS \\MOVEWORDS MACRO (OPENLAMBDA (SBASE SOFFSET DBASE DOFFSET NWORDS) (\\BLT (\\ADDBASE DBASE DOFFSET) (\\ADDBASE SBASE SOFFSET) NWORDS))) (PUTPROP (QUOTE LLBASIC) (QUOTE IMPORTDATE) (IDATE "31-Jan-1998 09:55:50")) (ACCESSFNS STRINGP ((XREADONLY (|fetch| (ARRAY-HEADER READ-ONLY-P) |of| DATUM) (|replace| ( ARRAY-HEADER READ-ONLY-P) |of| DATUM |with| NEWVALUE)) (XBASE ((OPENLAMBDA (STRING) (COND ((|fetch| ( ARRAY-HEADER INDIRECT-P) |of| STRING) (%ARRAY-BASE STRING)) (T (|fetch| (ARRAY-HEADER BASE) |of| STRING)))) DATUM) ((OPENLAMBDA (STRING NV) (|replace| (ARRAY-HEADER INDIRECT-P) |of| STRING |with| NIL ) (|replace| (ARRAY-HEADER BASE) |of| STRING |with| NV) NV) DATUM NEWVALUE)) (TYP ((OPENLAMBDA (STRING ) (SELECTC (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) (%ARRAY-TYPE-NUMBER STRING)) (T ( |fetch| (ARRAY-HEADER TYPE-NUMBER) |of| STRING))) (%THIN-CHAR-TYPENUMBER \\ST.BYTE) ( %FAT-CHAR-TYPENUMBER \\ST.POS16) (SHOULDNT "Unknown type-number"))) DATUM) ((OPENLAMBDA (STRING NV) ( LET ((%NEW-TYPE-NUMBER (SELECTC NV (\\ST.BYTE %THIN-CHAR-TYPENUMBER) (\\ST.POS16 %FAT-CHAR-TYPENUMBER) (SHOULDNT "Unknown typ value")))) (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) ( %SET-ARRAY-TYPE-NUMBER STRING %NEW-TYPE-NUMBER)) (T (|replace| (ARRAY-HEADER TYPE-NUMBER) |of| STRING |with| %NEW-TYPE-NUMBER))))) DATUM NEWVALUE)) (LENGTH (|fetch| (ARRAY-HEADER FILL-POINTER) |of| DATUM) ((OPENLAMBDA (STRING NV) (|replace| (ARRAY-HEADER FILL-POINTER) |of| STRING |with| NV) (|replace| ( ARRAY-HEADER TOTAL-SIZE) |of| STRING |with| NV) (COND ((%GENERAL-ARRAY-P STRING) (|freplace| ( GENERAL-ARRAY DIMS) |of| STRING |with| (LIST NV)))) NV) DATUM NEWVALUE)) (OFFST ((OPENLAMBDA (STRING) (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) (%ARRAY-OFFSET STRING)) (T (|fetch| ( ARRAY-HEADER OFFSET) |of| STRING)))) DATUM) ((OPENLAMBDA (STRING NV) (COND ((NOT (EQ 0 NV)) (|replace| (ARRAY-HEADER DISPLACED-P) |of| STRING |with| T))) (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) (%SET-ARRAY-OFFSET STRING NV)) (T (|replace| (ARRAY-HEADER OFFSET) |of| STRING |with| NV)))) DATUM NEWVALUE)) (* |;;| "The rest of these fields only appear when smashing") (XFLAGS (LOGAND ( |fetch| (ARRAY-HEADER FLAGS) |of| DATUM) 15) ((OPENLAMBDA (STRING) (|replace| (ARRAY-HEADER ADJUSTABLE-P) |of| STRING |with| NIL) (|replace| (ARRAY-HEADER DISPLACED-P) |of| STRING |with| NIL) ( |replace| (ARRAY-HEADER FILL-POINTER-P) |of| STRING |with| NIL) (|replace| (ARRAY-HEADER EXTENDABLE-P) |of| STRING |with| NIL)) DATUM))) (ACCESSFNS STRINGP ((ORIG ((OPENLAMBDA (STRING) 1) DATUM) (( OPENLAMBDA (STRING NV) (COND ((NOT (EQ NV 1)) (ERROR "Il:stringp's are always origin 1"))) NV) DATUM NEWVALUE)) (* \; "An inoperative field") (SUBSTRINGED ((OPENLAMBDA (STRING) NIL) DATUM) ((OPENLAMBDA ( STRING NV) (OR (NULL NV) (ERROR "Substringed field not supported"))) DATUM NEWVALUE)) (READONLY ( |ffetch| (STRINGP XREADONLY) |of| DATUM) (|freplace| (STRINGP XREADONLY) |of| DATUM |with| NEWVALUE)) (FATSTRINGP ((OPENLAMBDA (STRING) (EQ (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) ( %ARRAY-TYPE-NUMBER STRING)) (T (|fetch| (ARRAY-HEADER TYPE-NUMBER) |of| STRING))) %FAT-CHAR-TYPENUMBER )) DATUM) ((OPENLAMBDA (STRING NV) (LET ((%NEW-TYPE-NUMBER (COND (NV %FAT-CHAR-TYPENUMBER) (T %THIN-CHAR-TYPENUMBER)))) (COND ((|fetch| (ARRAY-HEADER INDIRECT-P) |of| STRING) ( %SET-ARRAY-TYPE-NUMBER STRING %NEW-TYPE-NUMBER)) (T (|replace| (ARRAY-HEADER TYPE-NUMBER) |of| STRING |with| %NEW-TYPE-NUMBER))))) DATUM NEWVALUE)) (BASE (|ffetch| (STRINGP XBASE) |of| DATUM) (|freplace| (STRINGP XBASE) |of| DATUM |with| NEWVALUE)))) (CREATE (|create| ONED-ARRAY BASE _ XBASE READ-ONLY-P _ XREADONLY STRING-P _ T DISPLACED-P _ (NOT (EQ OFFST 0)) TYPE-NUMBER _ (COND ((EQ TYP \\ST.POS16) %FAT-CHAR-TYPENUMBER) (T %THIN-CHAR-TYPENUMBER)) OFFSET _ OFFST FILL-POINTER _ LENGTH TOTAL-SIZE _ LENGTH)) (TYPE? (CL:STRINGP DATUM)) OFFST _ 0 TYP _ \\ST.BYTE LENGTH _ 0) (GLOBALVARS |\\OneCharAtomBase|) (PUTDEF (QUOTE \\NUMSTR) (QUOTE RESOURCES) (QUOTE (NEW (ALLOCSTRING 128)))) (PUTDEF (QUOTE \\NUMSTR1) (QUOTE RESOURCES) (QUOTE (NEW (CONCAT)))) (PUTDEF (QUOTE \\PNAMESTRING) (QUOTE RESOURCES) (QUOTE (NEW (ALLOCSTRING \\PNAMELIMIT NIL NIL \\FATPNAMESTRINGP)))) (RPAQQ \\FATPNAMESTRINGP T) (CONSTANTS (\\FATPNAMESTRINGP T)) (PUTPROPS \\PNAMESTRINGPUTCHAR MACRO ((BASE OFFSET CODE) (* \; "For stuffing chars into resource \\PNAMESTRING") (\\PUTBASECHAR \\FATPNAMESTRINGP BASE OFFSET CODE))) (DEFOPTIMIZER FCHARACTER (NUM) (BQUOTE ((OPENLAMBDA (N) (COND ((IGREATERP N \\MAXTHINCHAR) (* \; "The character we're getting is NOT a thin character -- do it the hard way") (CHARACTER N)) (( IGREATERP N (CHARCODE 9)) (\\ADDBASE |\\OneCharAtomBase| (IDIFFERENCE N 10))) ((IGEQ N (CHARCODE 0)) ( IDIFFERENCE N (CHARCODE 0))) (T (* \; "The common case -- just add on the one-atom base.") (\\ADDBASE |\\OneCharAtomBase| N)))) (\\\, NUM)))) (I.S.OPR (QUOTE |inpname|) NIL (QUOTE (SUBPAIR (QUOTE ($$END $$BODY $$FATP $$BASE $$OFFSET)) (LIST ( GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (BQUOTE (|bind| $$OFFSET _ 0 $$BODY _ BODY $$BASE $$END $$FATP |declare| (LOCALVARS $$END $$BODY $$FATP $$BASE $$OFFSET) |first| ( PROG NIL $$RETRY (COND ((STRINGP $$BODY) (SETQ $$BASE (|ffetch| (STRINGP BASE) |of| $$BODY)) (SETQ $$OFFSET (SUB1 (|ffetch| (STRINGP OFFST) |of| $$BODY))) (SETQ $$END (IPLUS $$OFFSET (|ffetch| (STRINGP LENGTH) |of| $$BODY))) (SETQ $$FATP (|ffetch| (STRINGP FATSTRINGP) |of| $$BODY))) ((LITATOM $$BODY) ( SETQ $$BASE (|ffetch| (LITATOM PNAMEBASE) |of| $$BODY)) (SETQ $$END (|ffetch| (PNAMEBASE PNAMELENGTH) |of| $$BASE)) (SETQ $$FATP (|ffetch| (LITATOM FATPNAMEP) |of| $$BODY))) (T (SETQ $$BODY (MKSTRING $$BODY)) (GO $$RETRY)))) |eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) ( GO $$OUT)) (SETQ I.V. (COND ($$FATP (\\GETBASEFAT $$BASE $$OFFSET)) (T (\\GETBASETHIN $$BASE $$OFFSET) ))))))) T) (I.S.OPR (QUOTE |inatom|) NIL (QUOTE (SUBPAIR (QUOTE ($$OFFSET $$BODY $$BASE $$END $$FATP)) (LIST ( GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$OFFSET _ 0 $$BODY _ BODY $$BASE $$END $$FATP |declare| (LOCALVARS $$OFFSET $$BODY $$BASE $$END $$FATP) |first| ( SETQ $$BASE (|ffetch| (LITATOM PNAMEBASE) |of| $$BODY)) (SETQ $$END (|ffetch| (PNAMEBASE PNAMELENGTH) |of| $$BASE)) (SETQ $$FATP (|ffetch| (LITATOM FATPNAMEP) |of| $$BODY)) |eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (COND ($$FATP (\\GETBASEFAT $$BASE $$OFFSET)) (T (\\GETBASETHIN $$BASE $$OFFSET)))))))) T) (I.S.OPR (QUOTE |instring|) NIL (QUOTE (SUBPAIR (QUOTE ($$BODY $$END $$OFFSET $$BASE $$FATP)) (LIST ( GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$BODY _ BODY $$END $$OFFSET $$BASE $$FATP |declare| (LOCALVARS $$BODY $$END $$OFFSET $$BASE $$FATP) |first| (SETQ $$OFFSET (SUB1 (|ffetch| (STRINGP OFFST) |of| $$BODY))) (SETQ $$BASE (|ffetch| (STRINGP BASE) |of| $$BODY)) (SETQ $$END (IPLUS $$OFFSET (|ffetch| (STRINGP LENGTH) |of| $$BODY))) (SETQ $$FATP (|ffetch| (STRINGP FATSTRINGP) |of| $$BODY)) |eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (COND ($$FATP (\\GETBASEFAT $$BASE $$OFFSET)) (T (\\GETBASETHIN $$BASE $$OFFSET)))))))) T) (I.S.OPR (QUOTE |infatatom|) NIL (QUOTE (SUBPAIR (QUOTE ($$OFFSET $$BODY $$BASE $$END)) (LIST ( GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$OFFSET _ 0 $$BODY _ BODY $$BASE $$END |declare| (LOCALVARS $$OFFSET $$BODY $$BASE $$END) |first| (SETQ $$BASE (|ffetch| ( LITATOM PNAMEBASE) |of| $$BODY)) (SETQ $$END (|ffetch| (PNAMEBASE PNAMELENGTH) |of| $$BASE)) |eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. ( \\GETBASEFAT $$BASE $$OFFSET)))))) T) (I.S.OPR (QUOTE |inthinatom|) NIL (QUOTE (SUBPAIR (QUOTE ($$OFFSET $$BODY $$BASE $$END)) (LIST ( GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$OFFSET _ 0 $$BODY _ BODY $$BASE $$END |declare| (LOCALVARS $$OFFSET $$BODY $$BASE $$END) |first| (SETQ $$BASE (|ffetch| ( LITATOM PNAMEBASE) |of| $$BODY)) (SETQ $$END (|ffetch| (PNAMEBASE PNAMELENGTH) |of| $$BASE)) |eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND (IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. ( \\GETBASETHIN $$BASE $$OFFSET)))))) T) (I.S.OPR (QUOTE |infatstring|) NIL (QUOTE (SUBPAIR (QUOTE ($$BODY $$END $$OFFSET $$BASE)) (LIST ( GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$BODY _ BODY $$END $$OFFSET $$BASE |declare| (LOCALVARS $$BODY $$END $$OFFSET $$BASE) |first| (SETQ $$OFFSET (SUB1 (|ffetch| ( STRINGP OFFST) |of| $$BODY))) (SETQ $$BASE (|ffetch| (STRINGP BASE) |of| $$BODY)) (SETQ $$END (IPLUS $$OFFSET (|ffetch| (STRINGP LENGTH) |of| $$BODY))) |eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND ( IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (\\GETBASEFAT $$BASE $$OFFSET)))))) T) (I.S.OPR (QUOTE |inthinstring|) NIL (QUOTE (SUBPAIR (QUOTE ($$BODY $$END $$OFFSET $$BASE)) (LIST ( GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR) (GETDUMMYVAR)) (QUOTE (|bind| $$BODY _ BODY $$END $$OFFSET $$BASE |declare| (LOCALVARS $$BODY $$END $$OFFSET $$BASE) |first| (SETQ $$OFFSET (SUB1 (|ffetch| ( STRINGP OFFST) |of| $$BODY))) (SETQ $$BASE (|ffetch| (STRINGP BASE) |of| $$BODY)) (SETQ $$END (IPLUS $$OFFSET (|ffetch| (STRINGP LENGTH) |of| $$BODY))) |eachtime| (SETQ $$OFFSET (ADD1 $$OFFSET)) (AND ( IGREATERP $$OFFSET $$END) (GO $$OUT)) (SETQ I.V. (\\GETBASETHIN $$BASE $$OFFSET)))))) T) (PUTPROPS \\CHARCODEP DMACRO (OPENLAMBDA (X) (* \; "used to also say (ILEQ X \\MAXFATCHAR), but that's implied by the first two clauses") (AND (SMALLP X) (IGEQ X 0)))) (PUTPROPS \\FATCHARCODEP DMACRO (OPENLAMBDA (X) (* \; "Used to also say (ILEQ X \\MAXFATCHAR), but that's implied by the first two clauses") (AND (SMALLP X) (IGREATERP X \\MAXTHINCHAR)))) (PUTPROPS \\THINCHARCODEP DMACRO (OPENLAMBDA (X) (AND (SMALLP X) (IGEQ X 0) (ILEQ X \\MAXTHINCHAR)))) (PUTPROPS \\GETBASEFAT MACRO (= . \\GETBASE)) (PUTPROPS \\GETBASETHIN MACRO (= . \\GETBASEBYTE)) (PUTPROPS \\PUTBASEFAT MACRO (= . \\PUTBASE)) (PUTPROPS \\PUTBASETHIN MACRO (= . \\PUTBASEBYTE)) (PUTPROPS \\PUTBASECHAR MACRO (OPENLAMBDA (FATP BASE OFFSET CODE) (COND (FATP (\\PUTBASEFAT BASE OFFSET CODE)) (T (\\PUTBASETHIN BASE OFFSET CODE))))) (PUTPROPS \\GETBASECHAR MACRO ((FATP BASE N) (COND (FATP (\\GETBASEFAT BASE N)) (T (\\GETBASETHIN BASE N))))) (PUTPROPS \\CHARSET MACRO ((CHARCODE) (LRSH CHARCODE 8))) (PUTPROPS \\CHAR8CODE MACRO ((CHARCODE) (LOGAND CHARCODE 255))) (RPAQQ \\CHARMASK 255) (RPAQQ \\MAXCHAR 255) (RPAQQ \\MAXTHINCHAR 255) (RPAQQ \\MAXFATCHAR 65535) (RPAQQ \\MAXCHARSET 255) (RPAQQ NSCHARSETSHIFT 255) (RPAQQ \#STRINGPWORDS 4) (CONSTANTS (\\CHARMASK 255) (\\MAXCHAR 255) (\\MAXTHINCHAR 255) (\\MAXFATCHAR 65535) (\\MAXCHARSET 255 ) (NSCHARSETSHIFT 255) (\#STRINGPWORDS 4)) (PUTPROPS \\NATOMCHARS DMACRO ((AT) (|fetch| (LITATOM PNAMELENGTH) |of| AT))) (PUTPROPS \\NSTRINGCHARS DMACRO ((S) (|fetch| (STRINGP LENGTH) |of| S))) (PUTPROP (QUOTE LLCHAR) (QUOTE IMPORTDATE) (IDATE "11-Nov-2018 13:08:04")) (ACCESSFNS BF ((BFBLOCK (ADDSTACKBASE DATUM))) (* \; "basic frame pointer") (BLOCKRECORD BFBLOCK (( FLAGS BITS 3) (NIL BITS 3) (RESIDUAL FLAG) (* \; "true if this is not a full BF") (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) (* \; "= \\STK.FX") (FAST FLAG) (NIL FLAG) (INCALL FLAG) (* \; "set when fncall microcode has to punt") (VALIDNAMETABLE FLAG) (* \; "if on, NAMETABLE field is filled in. If off, is same as FNHEADER") (NOPUSH FLAG) (* \; "when returning to this frame, don't push a value. Set by interrupt code") (USECNT BITS 8) (\#ALINK WORD) (* \; "low bit is SLOWP") (FNHEADER FULLXPOINTER) (NEXTBLOCK WORD) (PC WORD) (NAMETABLE# FULLXPOINTER) (\#BLINK WORD) (\#CLINK WORD))) (BLOCKRECORD FXBLOCK ((FLAGBYTE BYTE) (NIL BYTE) (NIL BITS 15) (* \; "most of the bits of #ALINK") (SLOWP FLAG) (* \; "if on, then BLINK and CLINK fields are valid. If off, they are implicit") (NIL FULLXPOINTER 2) ( NAMETABHI WORD) (NAMETABLO WORD))) (TYPE? (IEQ (|fetch| (FX FLAGS) |of| DATUM) \\STK.FX)) (ACCESSFNS FX ((NAMETABLE (COND ((|fetch| (FX VALIDNAMETABLE) |of| DATUM) (|fetch| (FX NAMETABLE#) |of| DATUM)) ( T (|fetch| (FX FNHEADER) |of| DATUM))) (PROGN (|replace| (FX FAST) |of| DATUM |with| NIL) (|replace| ( FX NAMETABLE#) |of| DATUM |with| NEWVALUE) (|replace| (FX VALIDNAMETABLE) |of| DATUM |with| T))) ( FRAMENAME (|fetch| (FNHEADER FRAMENAME) |of| (|fetch| (FX NAMETABLE) |of| DATUM))) (INVALIDP (EQ DATUM 0)) (* \; "true when A/CLink points at nobody, i.e. FX is bottom of stack") (FASTP (NOT (|fetch| (FX SLOWP) |of| DATUM)) (PROGN (CHECK (NULL NEWVALUE)) (COND ((|fetch| (FX FASTP) |of| DATUM) (|replace| ( FX \#BLINK) |of| DATUM |with| (|fetch| (FX DUMMYBF) |of| DATUM)) (|replace| (FX \#CLINK) |of| DATUM |with| (|fetch| (FX \#ALINK) |of| DATUM)) (|replace| (FX SLOWP) |of| DATUM |with| T))))) (BLINK (COND ((|fetch| (FX FASTP) |of| DATUM) (|fetch| (FX DUMMYBF) |of| DATUM)) (T (|fetch| (FX \#BLINK) |of| DATUM))) (PROGN (|replace| (FX \#BLINK) |of| DATUM |with| NEWVALUE) (COND ((|fetch| (FX FASTP) |of| DATUM) (|replace| (FX \#CLINK) |of| DATUM |with| (|fetch| (FX \#ALINK) |of| DATUM)) (|replace| (FX SLOWP) |of| DATUM |with| T))))) (CLINK (IDIFFERENCE (COND ((|fetch| (FX FASTP) |of| DATUM) (|fetch| ( FX \#ALINK) |of| DATUM)) (T (|fetch| (FX \#CLINK) |of| DATUM))) \\#ALINK.OFFSET) (PROGN (|replace| (FX \#CLINK) |of| DATUM |with| (IPLUS NEWVALUE \\#ALINK.OFFSET)) (COND ((|fetch| (FX FASTP) |of| DATUM) ( |replace| (FX \#BLINK) |of| DATUM |with| (|fetch| (FX DUMMYBF) |of| DATUM)) (|replace| (FX SLOWP) |of| DATUM |with| T))))) (ALINK (IDIFFERENCE (FLOOR (|fetch| (FX \#ALINK) |of| DATUM) WORDSPERCELL) \\#ALINK.OFFSET) (PROGN (COND ((|fetch| (FX FASTP) |of| DATUM) (|replace| (FX \#BLINK) |of| DATUM |with| (|fetch| (FX DUMMYBF) |of| DATUM)) (|replace| (FX \#CLINK) |of| DATUM |with| (|fetch| (FX \#ALINK) |of| DATUM)))) (|replace| (FX \#ALINK) |of| DATUM |with| (IPLUS NEWVALUE \\#ALINK.OFFSET ( SUB1 WORDSPERCELL))))) (ACLINK (SHOULDNT) (PROGN (COND ((|fetch| (FX FASTP) |of| DATUM) (|replace| (FX \#BLINK) |of| DATUM |with| (|fetch| (FX DUMMYBF) |of| DATUM)))) (|replace| (FX \#CLINK) |of| DATUM |with| (IPLUS NEWVALUE \\#ALINK.OFFSET)) (|replace| (FX \#ALINK) |of| DATUM |with| (IPLUS NEWVALUE \\#ALINK.OFFSET (SUB1 WORDSPERCELL))))) (* \; "replaces A & C Links at once more efficiently than separately") (DUMMYBF (IDIFFERENCE DATUM WORDSPERCELL)) (* |;;| "This is either an actual BF or \"residual\" BF that provides enough BF to find its IVAR slot. This means that when a FX is copied, the cell preceding the FX is copied too." ) (IVAR (|fetch| (BF IVAR) |of| (|fetch| (FX 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))))))) (FIRSTPVAR (IPLUS DATUM (|fetch| (FX FXSIZE) |of| T))) (* \; "stack offset of PVAR0") (FXSIZE (PROGN 10)) (* \; "fixed overhead from flags thru clink") (PADDING (PROGN 4)) (* \; "doublecell of garbage for microcode use") (FIRSTTEMP (IPLUS (|fetch| (FX FIRSTPVAR) |of| DATUM) ( |fetch| (FX NPVARWORDS) |of| DATUM) (|fetch| (FX PADDING) |of| DATUM))) (* \; "note that NPVARWORDS is obtained from the FNHEADER") (SIZE (IDIFFERENCE (|fetch| (FX NEXTBLOCK) |of| DATUM) DATUM))))) (ACCESSFNS FSB (* |;;| "FREE STACK BLOCK -- ") (* |;;| " A piece of stack space that's free.") (* |;;| "The first word contains 120000Q") (* |;;| "The 2nd word is the size of the block, in words.") (( 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))) (* \; "unspecified stack block") (BLOCKRECORD STKBLOCK ((FLAGS BITS 3))) (BLOCKRECORD STKBLOCK ((FLAGWORD WORD)))) (RPAQQ \\#ALINK.OFFSET 10) (CONSTANTS \\#ALINK.OFFSET) (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) (BINDHI WORD)) (ACCESSFNS FVARSLOT ((LOOKEDUP (EVENP (|fetch| BINDLO |of| DATUM))) (BINDINGPTR (\\VAG2 (|fetch| BINDHI |of| DATUM) (|fetch| BINDLO |of| DATUM)) ( PROGN (|replace| BINDLO |of| DATUM |with| (\\LOLOC NEWVALUE)) (|replace| BINDHI |of| DATUM |with| ( \\HILOC NEWVALUE))))))) (BLOCKRECORD PVARSLOT ((PVHI BITS 4) (PVVALUE XPOINTER)) (ACCESSFNS PVARSLOT ((BOUND (EQ (|fetch| ( PVARSLOT PVHI) |of| DATUM) 0) (|if| (NULL NEWVALUE) |then| (|replace| (PVARSLOT PVHI) |of| DATUM |with| 255) |else| (ERROR "Illegal replace" NEWVALUE)))))) (BLOCKRECORD STKTEMPSLOT ((STKTMPHI BITS 4) (VALUE XPOINTER)) (ACCESSFNS STKTEMPSLOT ((BINDINGPTRP ( NEQ (|fetch| STKTMPHI |of| DATUM) 0))))) (BLOCKRECORD BINDMARKSLOT ((BINDMARKP FLAG) (NIL BITS 15)) (BLOCKRECORD BINDMARKSLOT ((BINDNEGVALUES WORD) (BINDLASTPVAR WORD))) (ACCESSFNS BINDMARKSLOT ((BINDNVALUES (PROGN (* \; "Value stored in high half is one's complement of number of values bound") (LOGXOR (|fetch| BINDNEGVALUES |of| DATUM) 65535)))))) (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 " 6-Jan-1993 18:07:37")) (PUTPROPS WORDCONTENTS BYTEMACRO ((PTR) (\\GETBASE PTR 0))) (PUTPROPS SETWORDCONTENTS BYTEMACRO ((PTR N) (\\PUTBASE PTR 0 N))) (PUTPROPS WORDOFFSET BYTEMACRO ((PTR N) (\\ADDBASE PTR N))) (PUTPROPS \\RELEASECPAGE MACRO ((STREAM) (PROGN (* \; "Must be under an UNINTERRUPTABLY !") (COND (( |fetch| CBUFDIRTY |of| STREAM) (\\SETIODIRTY STREAM (|fetch| CPAGE |of| STREAM)) (|replace| CBUFDIRTY |of| STREAM |with| NIL))) (|replace| CBUFSIZE |of| STREAM |with| 0) (|replace| CBUFPTR |of| STREAM |with| NIL)))) (PUTPROP (QUOTE PMAP) (QUOTE IMPORTDATE) (IDATE " 3-Feb-2002 14:11:02")) (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 .CHECK.ALLOCATION.COUNT. MACRO (OPENLAMBDA (N) (DECLARE (GLOBALVARS \\RECLAIM.COUNTDOWN)) ( AND \\RECLAIM.COUNTDOWN (COND ((NOT (IGREATERP \\RECLAIM.COUNTDOWN N)) (SETQ \\RECLAIM.COUNTDOWN) ( \\DORECLAIM)))))) (PUTPROPS \\GCDISABLED MACRO (NIL (PROGN (DECLARE (GLOBALVARS \\GCDISABLED)) \\GCDISABLED))) (BLOCKRECORD HTOVERFLOW ((CASE BITS 4) (PTR XPOINTER)) (ACCESSFNS HTOVERFLOW ((CLEAR NIL (\\PUTBASEPTR DATUM 0 NIL))))) (BLOCKRECORD GC ((CNT BITS 15) (STKBIT FLAG) (HIBITS BITS 15) (LINKP FLAG) (NXTPTR FIXP)) (BLOCKRECORD GC ((STKCNT WORD))) (ACCESSFNS GC ((EMPTY (EQ 0 (\\GETBASEFIXP DATUM 0)) (\\PUTBASEFIXP DATUM 0 0)) ( CONTENTS (\\GETBASEFIXP DATUM 0) (\\PUTBASEFIXP DATUM 0 NEWVALUE)) (LINKPTR (LOGAND (\\GETBASEFIXP DATUM 0) -2) (\\PUTBASEFIXP DATUM 0 (LOGOR NEWVALUE 1)))))) (BLOCKRECORD HTCOLL ((* |;;| "An entry in the GC collision table. NEXTFREE is initialized to 2 by INITGC, as part of the MAKEINIT." ) (FREEPTR FIXP) (* \; "The GC table entry") (NEXTFREE FIXP) (* \; "If the entry is in use, points to the next entry in this collision chain. If not, offset (in 1/2-entries) of the next free one on the chain." ))) (PUTPROP (QUOTE LLGC) (QUOTE IMPORTDATE) (IDATE "19-Oct-1994 12:30:11")) (PUTPROPS \\SYNCODE DMACRO (OPENLAMBDA (TABLE CHAR) (CHECK (|type?| CHARTABLE TABLE)) (* \; "0 is either NONE.TC, REAL.CCE, or OTHER.RC") (COND ((IGREATERP CHAR \\MAXTHINCHAR) (OR (AND (|fetch| (CHARTABLE NSCHARHASH) |of| TABLE) (GETHASH CHAR (|fetch| (CHARTABLE NSCHARHASH) |of| TABLE))) 0)) (T (\\GETBASEBYTE TABLE CHAR))))) (PUTPROPS \\SETSYNCODE DMACRO (LAMBDA (TABLE CHAR CODE) (CHECK (|type?| CHARTABLE TABLE)) (* \; "0 is REAL.CCE, NONE.TC, OTHER.RC") (COND ((ILEQ CHAR \\MAXTHINCHAR) (\\PUTBASEBYTE TABLE CHAR CODE)) (T (\\SETFATSYNCODE TABLE CHAR CODE))))) (DATATYPE CHARTABLE ((CHARSET0 256 BYTE) (NSCHARHASH FULLPOINTER))) (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)) (PUTPROPS \\GETREADMACRODEF MACRO ((C TBL) (GETHASH C (|fetch| READMACRODEFS |of| TBL)))) (PUTPROPS \\GTREADTABLE MACRO (ARGS (COND ((LITATOM (CAR ARGS)) (SUBPAIR (QUOTE (X . FLG)) ARGS (QUOTE (SELECTQ X ((NIL T) (\\DTEST *READTABLE* (QUOTE READTABLEP))) (\\GTREADTABLE1 X . FLG))))) (T (QUOTE IGNOREMACRO))))) (PUTPROPS \\GTREADTABLE1 DMACRO (ARGS (COND ((NULL (CDR ARGS)) (LIST (QUOTE \\DTEST) (CAR ARGS) (QUOTE (QUOTE READTABLEP)))) (T (QUOTE IGNOREMACRO))))) (RPAQQ MACROBIT 8) (RPAQQ BREAKBIT 16) (RPAQQ STOPATOMBIT 32) (RPAQQ ESCAPEBIT 64) (RPAQQ INNERESCAPEBIT 4) (CONSTANTS MACROBIT BREAKBIT STOPATOMBIT ESCAPEBIT INNERESCAPEBIT) (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))) (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 INNERESCAPEBIT 6)) (MULTIPLE-ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 7)) (PACKAGEDELIM.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 1)))) (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 INNERESCAPEBIT 6)) (RPAQ MULTIPLE-ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 7)) (RPAQ PACKAGEDELIM.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 1)) (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 INNERESCAPEBIT 6)) (MULTIPLE-ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 7)) (PACKAGEDELIM.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 1))) (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 (BITTEST DATUM ESCAPEBIT)) (STOPATOM (BITTEST DATUM STOPATOMBIT)) (INNERESCQUOTE (BITTEST DATUM (LOGOR STOPATOMBIT INNERESCAPEBIT))) ( MACROCONTEXT (LOGAND DATUM CONTEXTMASK)) (MACROP (BITTEST DATUM MACROBIT)) (WAKEUP (LOGAND DATUM WAKEUPMASK)) (BREAK (BITTEST DATUM BREAKBIT)))) (RECORD READMACRODEF (MACROTYPE . MACROFN)) (DATATYPE READTABLEP ((READSA POINTER) (* \; "A CHARTABLE defining syntax of each char") ( READMACRODEFS POINTER) (* \; "A hash table associating macro chars with macro definitions") ( READMACROFLG FLAG) (* \; "True if read macros are enabled (turned off by Interlisp's crufty READMACROS function)") (ESCAPEFLG FLAG) (* \; "True if the char(s) with escape syntax are enabled (turned off by Interlisp's crufty ESCAPE function)" ) (COMMONLISP FLAG) (* \; "True if table is a Common Lisp read table and hence must obey Common Lisp syntax rules") (NUMBERBASE BITS 5) (* \; "Not used") (CASEINSENSITIVE FLAG) (* \; "If true, unescaped lowercase chars are converted to uppercase in symbols") (COMMONNUMSYNTAX FLAG) (* \; "True if number notation includes Common Lisp numbers: rationals as a/b, and the dfls exponent markers" ) (USESILPACKAGE FLAG) (* \; "If true, IL:READ ignores *PACKAGE* and reads in the IL package") (NIL 5 FLAG) (DISPATCHMACRODEFS POINTER) (* \; "An a-list of dispatching macro char and its dispatch definitions") (HASHMACROCHAR BYTE) (* \; "The character code used in this read table for the # dispatch macro") (ESCAPECHAR BYTE) (* \; "The character code used in this read table for single escape") (MULTESCAPECHAR BYTE) (* \; "The character code used in this read table for multiple escape") (PACKAGECHAR BYTE) (* \; "The character code used in this read table for package delimiter") (READTBLNAME POINTER) (* \; "The canonical 'name' of this read table")) READSA _ (|create| CHARTABLE)) (PUTPROP (QUOTE ATBL) (QUOTE IMPORTDATE) (IDATE "20-Apr-2018 17:35:56")) (DATATYPE STREAM ((* |;;| "First 8 words are fixed for BIN, BOUT opcodes. Used to require length of whole datatype be multiple of 4, but Dolphin dead now." ) (COFFSET WORD) (* \; "Offset in CPPTR of next bin or bout") (CBUFSIZE WORD) (* \; "Offset past last byte in that buffer") (PEEKEDCHARP FLAG) (* \; "if true, PEEKEDCHAR contains value of recent call to unread-char") (ACCESSBITS BITS 3) (* \; "What kind of access file is open for (read, write, append)") (CBUFPTR POINTER) (* \; "Pointer to current buffer") (BYTESIZE BYTE) (* \; "Byte size of stream, always 8 for now") (CHARSET BYTE) (* \; "the current character set for this stream. If 255, stream is not runcoded, so read-char consumes two bytes every time" ) (PEEKEDCHAR WORD) (* \; "value of unread-char call") (CHARPOSITION WORD) (* \; "Used by POSITION etc.") (CBUFMAXSIZE WORD) (* \; "on output, the size of the physical buffer--can't extend beyond this") (* |;;| "-------- Above fields (8 words) potentially known to microcode. --------") (NONDEFAULTDATEFLG FLAG) (REVALIDATEFLG FLAG) (MULTIBUFFERHINT FLAG) (* \; "True if stream likes to read and write more than one buffer at a time") (USERCLOSEABLE FLAG) (* \; "Can be closed by CLOSEF; NIL for terminal, dribble...") (FULLFILENAME POINTER) (* \; "Name by which file is known to user") (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") (CBUFDIRTY FLAG) (* \; "true if BOUT has sullied the current buffer") (DEVICE POINTER) (* \; "FDEV of this guy") (USERVISIBLE FLAG) (* \; "Listed by OPENP; NIL for terminal, dribble ...") (EOLCONVENTION BITS 2) (* \; "End-of-line convention") (NOTXCCS FLAG) (* \; "True if the character encoding format is not XCCS.") ( VALIDATION POINTER) (* \; "A number somehow identifying file, used to determine if file has changed in our absence") (CPAGE POINTER) (* \; "CPAGE,,COFFSET constitutes current file pointer for most randaccess streams") (EPAGE POINTER) (EOFFSET WORD) (* \; "Page, byte offset of eof") (LINELENGTH WORD) (* \; "LINELENGTH of stream, or -1 for no line length") (* |;;| "----Following are device-specific fields----") (* |;;| "Available for device-specific uses, NOT for application use.") (F1 POINTER) (F2 POINTER) (F3 POINTER) (F4 POINTER) (F5 POINTER) (FW6 WORD) (FW7 WORD) (FW8 WORD) (FW9 WORD) (F10 POINTER) (* |;;| "----Following only filled in for open streams----") (STRMBINFN POINTER) (* \; "Either the BIN fn from the FDEV, or a trap") (STRMBOUTFN POINTER) (* \; "Either the BIN fn from the FDEV, or a trap") (OUTCHARFN POINTER) (* \; "Called by \\OUTCHAR, the normal character printer.") (ENDOFSTREAMOP POINTER) (* \; "Called if EOF and we try to read.") (OTHERPROPS POINTER) (* \; "PROP LIST for holding other info.") ( IMAGEOPS POINTER) (* \; "Image operations vector") (IMAGEDATA POINTER) (* \; "Image instance variables--format depends on IMAGEOPS value") (BUFFS POINTER) (* \; "Buffer chain for pmapped streams") (MAXBUFFERS WORD) (* \; "Max # of buffers the system will allocate.") (LASTCCODE WORD) (* \; "After READ, RATOM, etc, the charcode that will be returned (as a character) by LASTC. If there is none, this field is 65535." ) (EXTRASTREAMOP POINTER) (* \; "For use of applications programs, not devices")) (BLOCKRECORD STREAM ((NIL 2 WORD) (UCODEFLAGS1 BITS 1) (* |;;| "respecification of access bits:") (RANDOMWRITEABLE FLAG) ( * \; "File open for output (access = OUTPUT or BOTH)") (APPENDABLE FLAG) (* \; "File open for append (OUTPUT or APPEND or BOTH)") (READABLE FLAG) (* \; "File open for read (READ or BOTH)") (NIL POINTER))) (BLOCKRECORD STREAM ((NIL 4 WORD) (NIL BITS 14) ( * |;;| "JIS character encoding format specific, overrides CHARSET field.") (IN.KANJIIN FLAG) (* \; "True if input stream is in Kanji-in mode.") (OUT.KANJIIN FLAG) (* \; "True if output stream is in Kanji-in mode."))) (ACCESSFNS STREAM ((ACCESS \\GETACCESS \\SETACCESS) ( FULLNAME (OR (|fetch| (STREAM FULLFILENAME) |of| DATUM) DATUM)) (NAMEDP (AND (|fetch| (STREAM FULLFILENAME) |of| DATUM) T)))) (ACCESSFNS STREAM (EXTERNALFORMAT (LISTGET (|ffetch| (STREAM OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT)) (LET ((PROPS (|ffetch| (STREAM OTHERPROPS) |of| DATUM) )) (|freplace| (STREAM NOTXCCS) |of| DATUM |with| T) (COND (PROPS (LISTPUT PROPS (QUOTE EXTERNALFORMAT ) NEWVALUE)) (T (|freplace| (STREAM OTHERPROPS) |of| DATUM |with| (LIST (QUOTE EXTERNALFORMAT) NEWVALUE)))) (|freplace| (STREAM OUTCHARFN) |of| DATUM |with| (|ffetch| (EXTERNALFORMAT FILEOUTCHARFN) |of| NEWVALUE)) (AND (|ffetch| (EXTERNALFORMAT EOLVALID) |of| NEWVALUE) (|freplace| (STREAM EOLCONVENTION) |of| DATUM |with| (|ffetch| (EXTERNALFORMAT EOL) |of| NEWVALUE)))))) (ACCESSFNS STREAM (EXTERNALFORMAT.NAME (LISTGET (|ffetch| (STREAM OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT.NAME)) ( LET ((PROPS (|ffetch| (STREAM OTHERPROPS) |of| DATUM)) (NAME (COND ((LITATOM NEWVALUE) NEWVALUE) (T ( MKATOM NEWVALUE))))) (|freplace| (STREAM NOTXCCS) |of| DATUM |with| T) (COND (PROPS (LISTPUT PROPS ( QUOTE EXTERNALFORMAT.NAME) NAME)) (T (|freplace| (STREAM OTHERPROPS) |of| DATUM |with| (LIST (QUOTE EXTERNALFORMAT.NAME) NAME))))))) (ACCESSFNS STREAM (INCCODEFN (LET ((XFMT (LISTGET (|ffetch| (STREAM OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT)))) (AND (|type?| EXTERNALFORMAT XFMT) (|fetch| ( EXTERNALFORMAT INCCODEFN) |of| XFMT))))) (ACCESSFNS STREAM (PEEKCCODEFN (LET ((XFMT (LISTGET (|ffetch| (STREAM OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT)))) (AND (|type?| EXTERNALFORMAT XFMT) (|fetch| (EXTERNALFORMAT PEEKCCODEFN) |of| XFMT))))) (ACCESSFNS STREAM (BACKCHARFN (LET ((XFMT (LISTGET ( |ffetch| (STREAM OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT)))) (AND (|type?| EXTERNALFORMAT XFMT) (|fetch| (EXTERNALFORMAT BACKCHARFN) |of| XFMT))))) (ACCESSFNS STREAM (FILEOUTCHARFN (|ffetch| (STREAM OUTCHARFN) |of| DATUM))) (SYNONYM CBUFPTR (CPPTR)) USERCLOSEABLE _ T USERVISIBLE _ T ACCESSBITS _ |NoBits| CPAGE _ 0 EPAGE _ 0 BUFFS _ NIL BYTESIZE _ 8 CBUFPTR _ NIL MAXBUFFERS _ (LET NIL (DECLARE ( GLOBALVARS \\STREAM.DEFAULT.MAXBUFFERS)) \\STREAM.DEFAULT.MAXBUFFERS) CHARPOSITION _ 0 LINELENGTH _ ( LET NIL (DECLARE (GLOBALVARS FILELINELENGTH)) FILELINELENGTH) OUTCHARFN _ (FUNCTION \\FILEOUTCHARFN) ENDOFSTREAMOP _ (FUNCTION \\EOSERROR) IMAGEOPS _ \\NOIMAGEOPS EOLCONVENTION _ (SELECTQ (SYSTEMTYPE) (D CR.EOLC) (VAX LF.EOLC) (JERICHO CRLF.EOLC) CR.EOLC) STRMBINFN _ (FUNCTION \\STREAM.NOT.OPEN) STRMBOUTFN _ (FUNCTION \\STREAM.NOT.OPEN) LASTCCODE _ 65535 NOTXCCS _ NIL) (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|)) (RPAQQ \\NORUNCODE 255) (CONSTANTS |AppendBit| |NoBits| |ReadBit| |WriteBit| (|OutputBits| (LOGOR |AppendBit| |WriteBit|)) ( |BothBits| (LOGOR |ReadBit| |OutputBits|)) \\NORUNCODE) (PUTPROPS |TestMasked| MACRO ((BITS MASK) (NEQ (LOGAND BITS MASK) 0))) (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 \\RUNCODED MACRO (OPENLAMBDA (STREAM) (* |;;| "returns NIL is the stream is not runcoded, that is, if the stream has 16 bit bytes explicitly represented" ) (* \; "note that neq is ok since charsets are known to be SMALLP's") (NEQ (|fetch| CHARSET |of| STREAM) \\NORUNCODE))) (RPAQQ EOLCONVENTIONS ((CR.EOLC 0) (LF.EOLC 1) (CRLF.EOLC 2))) (RPAQQ CR.EOLC 0) (RPAQQ LF.EOLC 1) (RPAQQ CRLF.EOLC 2) (CONSTANTS (CR.EOLC 0) (LF.EOLC 1) (CRLF.EOLC 2)) (PUTPROPS FDEVOP DMACRO (ARGS (LET ((OPNAME (CAR ARGS)) (METHOD-DEVICE (CADR ARGS)) (TAIL (CDDR ARGS)) ) (COND ((AND (LISTP OPNAME) (EQ (CAR OPNAME) (QUOTE QUOTE))) (BQUOTE (SPREADAPPLY* (|fetch| (FDEV ( \\\, (CADR OPNAME))) |of| (\\\, METHOD-DEVICE)) (\\\,@ TAIL)))) (T (ERROR "OPNAME not quoted: " OPNAME )))))) (PUTPROPS \\RECOGNIZE-HACK DMACRO (ARGS (LET ((NAME (CAR ARGS)) (RECOG (CADR ARGS)) (DEVICE (CADDR ARGS))) (BQUOTE (|if| (|type?| STREAM (\\\, NAME)) |then| (\\\, NAME) |else| (FDEVOP (QUOTE GETFILENAME) (\\\, DEVICE) (\\\, NAME) (\\\, RECOG) (\\\, DEVICE))))))) (DATATYPE FDEV ((RESETABLE FLAG) (* \; "Obsolete") (RANDOMACCESSP FLAG) (NODIRECTORIES FLAG) ( PAGEMAPPED FLAG) (* \; "True if i/o handled by pmap routines") (FDBINABLE FLAG) (* \; "Copied as a microcode flag for INPUT streams formed on this device") (FDBOUTABLE FLAG) (FDEXTENDABLE FLAG) (BUFFERED FLAG) (* \; "True implies that the device supports the BIN & BOUT uCode conventions, and implements the GETNEXTBUFFER method" ) (DEVICENAME POINTER) (* \; "Identifying name somehow") (REMOTEP FLAG) (* \; "true if device not local to machine") (SUBDIRECTORIES FLAG) (* \; "true if device has real subdirectories") (INPUT-INDIRECTED FLAG) (* \; "True for devices that indirect their input stream. Method INPUTSTREAM fetches it") ( OUTPUT-INDIRECTED FLAG) (* \; "True for devices that indirect their output stream. Method OUTPUTSTREAM fetches it") (DEVICEINFO POINTER) (* \; "arbitrary device-specific info stored here") (OPENFILELST POINTER) (* \; "Default place to keep list of streams open on this device") (* |;;| "-----Rest of record consists of device \"methods\"-----") (* |;;| "-----Following fields required of all devices-----") (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" ) (EVENTFN POINTER) (* \; "(device event), called before/after logout, sysout, makesys") (* |;;| "-----Following fields required of all named devices, e.g., ones that open files-----") ( DIRECTORYNAMEP POINTER) (* \; "(host/dir) => true if directory exists on host") (OPENFILE POINTER) (* \; "(name access recog otherinfo device) => new stream open on this device, or NIL if name not found") (CLOSEFILE POINTER) (* \; "(stream) => closes stream, returns it") (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" ) (GETFILENAME POINTER) (* \; "(name recog device) => full file name") (DELETEFILE POINTER) (* \; "(name) => deletes file so named, returning name, or NIL on failure. RECOG=OLDEST") (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" ) (RENAMEFILE POINTER) (* \; "(olddevice oldfile newdevice newfile) to rename file on this (olddevice) to a potentially different device." ) (OPENP POINTER) (* \; "(name access dev) => stream if name is open for access, or all open streams if name = NIL") ( REGISTERFILE POINTER) (* \; "(stream dev) => registers stream on its device") (UNREGISTERFILE POINTER) (* \; "(stream dev) => unregisters a stream from its device") (FREEPAGECOUNT POINTER) (* \; "(host/dir dev) => # of free pages on host/dir") (MAKEDIRECTORY POINTER) (* \; "(host/dir dev)") ( CHECKFILENAME POINTER) (* \; "(name dev) => name if it is well-formed file name for dev") (HOSTALIVEP POINTER) (* \; "(host dev) => true if host is alive, i.e., responsive; only defined if REMOTEP is true") ( BREAKCONNECTION POINTER) (* \; "(host fastp dev) => closes connections to host") (* |;;| "-----The following are required methods for operating on open streams-----") (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") (READCHAR POINTER) (* \; "(stream) => next input char") (WRITECHAR POINTER) (* \; "(stream char) => writes char to stream") ( PEEKCHAR POINTER) (UNREADCHAR POINTER) (READP POINTER) (* \; "(stream flag) => T if there is input available from stream right now") (EOFP POINTER) (* \; "(stream) => T if BIN would signal eof.") (BLOCKIN POINTER) (* \; "(stream buffer byteoffset nbytes)") (BLOCKOUT POINTER) (* \; "(stream buffer byteoffset nbytes)") (FORCEOUTPUT POINTER) (* \; "(stream waitForFinish) flushes out to device anything that is buffered awaiting transmission") ( GETFILEINFO POINTER) (* \; "(stream/name attribute device) => value of attribute for open stream or name of closed file") ( SETFILEINFO POINTER) (* \; "(stream/name attribute newvalue device) sets attribute of open stream or closed file of given name") (CHARSETFN POINTER) (* \; "(stream charset) => access function for the charset slot, for benefit of indirect streams. See IMCHARSET for changing it on a file." ) (INPUTSTREAM POINTER) (* \; "(stream) => indirected input stream") (OUTPUTSTREAM POINTER) (* \; "(stream) => indirected output stream") (* |;;| "-----Following are required of random-access streams-----") (GETFILEPTR POINTER) (GETEOFPTR POINTER) (SETFILEPTR POINTER) (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" ) (SETEOFPTR POINTER) (* \; "(stream length) => truncates or lengthens stream to indicated length") ( LASTC POINTER) (* \; "Should be possible only if RANDOMACCESSP") (* |;;| "-----Following used for buffered streams-----") (GETNEXTBUFFER POINTER) (* \; "(stream whatfor noerrorflg) => Disposes of current buffer and optionally reads next. whatfor is READ or WRITE. Can cause EOF error unless noerrorflg" ) (RELEASEBUFFER POINTER) (* \; "(stream) => Does whatever appropriate when CBUFPTR is released") (* |;;| "-----Following used for pagemapped streams-----") (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)" ) (WRITEPAGES POINTER) (* \; "(stream firstpage# buflist) writes from buflist to stream starting at firstpage# of stream") ( TRUNCATEFILE POINTER) (* \; "(stream page offset) make stream's eof be at page,offset, discarding anything after it") (* |;;| "-----For window system, argh-----") (WINDOWOPS POINTER) (* \; "window system operations") (WINDOWDATA POINTER) (* \; "data for window systems") (* |;;| "-----For any stream (here to not recompile everything)-----") (READCHARCODE POINTER) (* \; "Read a character code from the stream (cf BIN for bytes).")) DIRECTORYNAMEP _ (FUNCTION NILL) HOSTNAMEP _ (FUNCTION NILL) READP _ (FUNCTION \\GENERIC.READP) SETFILEPTR _ (FUNCTION \\IS.NOT.RANDACCESSP) GETFILEPTR _ (FUNCTION \\ILLEGAL.DEVICEOP) GETEOFPTR _ (FUNCTION \\IS.NOT.RANDACCESSP) EOFP _ (FUNCTION \\ILLEGAL.DEVICEOP) BLOCKIN _ (FUNCTION \\GENERIC.BINS) BLOCKOUT _ (FUNCTION \\GENERIC.BOUTS) RENAMEFILE _ (FUNCTION \\GENERIC.RENAMEFILE) FORCEOUTPUT _ ( FUNCTION NILL) REGISTERFILE _ (FUNCTION NILL) OPENP _ (FUNCTION NILL) UNREGISTERFILE _ (FUNCTION NILL) READCHAR _ (FUNCTION \\GENERIC.READCHAR) WRITECHAR _ (FUNCTION \\GENERIC.WRITECHAR) PEEKCHAR _ ( FUNCTION \\GENERIC.PEEKCHAR) UNREADCHAR _ (FUNCTION \\GENERIC.UNREADCHAR) CHARSETFN _ (FUNCTION \\GENERIC.CHARSET) BREAKCONNECTION _ (FUNCTION NILL) READCHARCODE _ (FUNCTION \\GENERIC.READCCODE)) (RECORD FILEGENOBJ (NEXTFILEFN FILEINFOFN . GENFILESTATE)) (DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* \; "If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream.") (EOL BITS 2) (NIL BITS 1) (INCCODEFN POINTER) (* \; "Called with two arguments -- STREAM and COUNTP") ( PEEKCCODEFN POINTER) (* \; "Called with three arguments -- STREAM, NOERROR and COUNTP") (BACKCHARFN POINTER) (* \; "Called with two arguments -- STREAM and COUNTP") (FILEOUTCHARFN POINTER) (* \; "Called with two arguments -- STREAM and CHARCODE")) EOLVALID _ NIL) (PUTPROPS \\OUTCHAR DMACRO (OPENLAMBDA (STREAM CHARCODE) (STREAMOP (QUOTE OUTCHARFN) STREAM STREAM CHARCODE))) (PUTPROPS \\DEVICE-OPEN-STREAMS MACRO (ARGS (LET ((DEVICE (CAR ARGS))) (BQUOTE (FDEVOP (QUOTE OPENP) ( \\\, DEVICE) NIL NIL (\\\, DEVICE)))))) (PUTPROPS \\CONVERT-PATHNAME DMACRO (OPENLAMBDA (PATHNAME?) (* |;;| "Coerce pathnames to Interlisp strings, for the benefit of antediluvian Interlisp-D file fns") ( CL:TYPECASE PATHNAME? (PATHNAME (INTERLISP-NAMESTRING PATHNAME?)) (T PATHNAME?)))) (DEFOPTIMIZER ACCESS-CHARSET (STREAM &OPTIONAL NEWVALUE) (BQUOTE ((OPENLAMBDA (STRM) (FDEVOP (QUOTE CHARSETFN) (|fetch| (STREAM DEVICE) |of| STRM) STRM (\\\, NEWVALUE))) (\\\, STREAM)))) (PUTPROPS \\DECFILEPTR MACRO ((STREAM X) (\\INCFILEPTR STREAM (IMINUS X)))) (PUTPROPS \\GETFILEPTR MACRO (OPENLAMBDA (STRM) (FDEVOP (QUOTE GETFILEPTR) (|fetch| DEVICE |of| STRM) STRM))) (PUTPROPS \\SIGNEDWIN MACRO ((STREAM) (SIGNED (\\WIN STREAM) BITSPERWORD))) (PUTPROPS \\SIGNEDWOUT MACRO ((STREAM N) (\\WOUT STREAM (UNSIGNED N BITSPERWORD)))) (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))) (PUTPROPS SIZE.FROM.LENGTH MACRO (LAMBDA (LEN) (DECLARE (LOCALVARS LEN)) (AND LEN (FOLDHI LEN BYTESPERPAGE)))) (RPAQQ |BitsPerByte| 8) (RPAQ |ByteOffsetSize| (SELECTQ (SYSTEMTYPE) (VAX 10) 9)) (RPAQQ |WordsPerPage| 256) (CONSTANTS |BitsPerByte| (|ByteOffsetSize| (SELECTQ (SYSTEMTYPE) (VAX 10) 9)) |WordsPerPage|) (RPAQ \\MAXFILEPTR (SUB1 (LLSH 1 30))) (CONSTANTS (\\MAXFILEPTR (SUB1 (LLSH 1 30)))) (ACCESSFNS BYTEPTR ((PAGE (FOLDLO DATUM BYTESPERPAGE)) (OFFSET (MOD DATUM BYTESPERPAGE))) (TYPE? (AND (FIXP DATUM) (IGEQ DATUM 0) (ILEQ DATUM \\MAXFILEPTR))) (CREATE (IPLUS (UNFOLD PAGE BYTESPERPAGE) OFFSET))) (PUTPROP (QUOTE FILEIO) (QUOTE IMPORTDATE) (IDATE "13-Aug-2020 11:43:08")) (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 (ARGS (LET ((ARG-FORM (CAR ARGS)) (HIGH-VAR (CADR ARGS)) (LOW-VAR (CADDR ARGS) ) (BIGNUM-FORM (CADDDR ARGS))) (BQUOTE (PROG NIL UBLP (SELECTC (NTYPX (\\\, ARG-FORM)) (\\FIXP (SETQ ( \\\, HIGH-VAR) (|ffetch| (FIXP HINUM) |of| (\\\, ARG-FORM))) (SETQ (\\\, LOW-VAR) (|ffetch| (FIXP LONUM) |of| (\\\, ARG-FORM)))) (\\SMALLP (COND ((ILEQ 0 (\\\, ARG-FORM)) (SETQ (\\\, HIGH-VAR) 0) ( SETQ (\\\, LOW-VAR) (\\\, ARG-FORM))) (T (SETQ (\\\, HIGH-VAR) 65535) (SETQ (\\\, LOW-VAR) (\\LOLOC ( \\\, ARG-FORM)))))) (\\FLOATP (SETQ (\\\, ARG-FORM) (\\FIXP.FROM.FLOATP (\\\, ARG-FORM))) (GO UBLP)) ( COND ((TYPENAMEP (\\\, ARG-FORM) (QUOTE RATIO)) (SETQ (\\\, ARG-FORM) (IQUOTIENT (CL::RATIO-NUMERATOR (\\\, ARG-FORM)) (CL::RATIO-DENOMINATOR (\\\, ARG-FORM)))) (GO UBLP)) (\\\,@ (COND (BIGNUM-FORM ( BQUOTE (((CL:INTEGERP (\\\, ARG-FORM)) (\\\, BIGNUM-FORM))))) (T (BQUOTE (((CL:INTEGERP (\\\, ARG-FORM )) (\\ILLEGAL.ARG (\\\, ARG-FORM)))))))) (T (CL::%NOT-NONCOMPLEX-NUMBER-ERROR (\\\, ARG-FORM)))))))))) (PUTPROPS .NEGATE. MACRO ((HY LY) (COND ((EQ 0 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 "16-May-1990 18:47:56")) (PUTPROPS POLYEVAL DMACRO ((X COEFFS DEGREE) (* \; "execute the POLYEVAL opcode on the value X, the array COEFFS with degree DEGREE") (\\FLOATBOX (( OPCODES UBFLOAT3 0) (\\FLOATUNBOX X) (|fetch| (ARRAYP BASE) |of| COEFFS) DEGREE)))) (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))) (BLOCKRECORD FLOATP ((NIL BITS 1) ( HIWORDNOSIGNBIT BITS 15))) (CREATE (\\FLOATBOX (\\VAG2 (LOGOR (LLSH SIGNBIT (PLUS 7 8)) (LLSH EXPONENT 7) HIFRACTION) LOFRACTION))) LOFRACTION _ 0 HIFRACTION _ 0 EXPONENT _ 0 SIGNBIT _ 0 (ACCESSFNS FLOATP ((EXP (LOGAND (LRSH (\\HILOC (\\FLOATUNBOX DATUM)) 7) 255)) (HIFRAC (LOGAND (\\HILOC (\\FLOATUNBOX DATUM)) 127))))) (RPAQQ MAX.DIGITS.ACCURACY 9) (CONSTANTS (MAX.DIGITS.ACCURACY 9)) (PUTPROPS \\CALLER.ARGS MACRO (X (LET ((ARGS (CAR X)) (FORMS (CDR X))) (BQUOTE (PROGN (\\SLOWRETURN) ( LET ((AL (\\MYALINK)) NEXT (\\\,@ (|for| VAR |in| ARGS |collect| (COND ((LISTP VAR) (LIST (CAR VAR) 0) ) (T VAR))))) (DECLARE (\\\,@ (|for| VAR |in| ARGS |when| (LISTP VAR) |collect| (BQUOTE (TYPE (\\\, ( SELECTQ (CADR VAR) ((FLOATING FLOATP) (CADR VAR)) (HELP))) (\\\, (CAR VAR))))))) (SETQ NEXT (|fetch| ( FX NEXTBLOCK) |of| AL)) (\\\,@ (|for| X |in| (REVERSE ARGS) |collect| (LET ((FORMS (BQUOTE ( \\.GETBASE32 \\STACKSPACE (SETQ NEXT (IDIFFERENCE NEXT WORDSPERCELL)))))) (COND ((LISTP X) (BQUOTE ( SETQ (\\\, (CAR X)) (\\FLOATBOX (\\\, FORMS))))) (T (BQUOTE (SETQ (\\\, X) (\\\, FORMS)))))))) ( \\MAKEFREEBLOCK NEXT (TIMES (\\\, (LENGTH ARGS)) WORDSPERCELL)) (|replace| (FX NEXTBLOCK) |of| AL |with| NEXT) (PROGN (\\\,@ FORMS)))))))) (PUTPROP (QUOTE LLFLOAT) (QUOTE IMPORTDATE) (IDATE "16-May-1990 19:26:51")) (DEFOPTIMIZER FONTPROP (&REST 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 FONTCLASS ((PRETTYFONT# BYTE) DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME)) (DATATYPE FONTDESCRIPTOR ((FONTDEVICE POINTER) (FONTFAMILY POINTER) (FONTSIZE POINTER) (FONTFACE POINTER) (|\\SFAscent| WORD) (|\\SFDescent| WORD) (|\\SFHeight| WORD) (ROTATION WORD) (FBBOX SIGNEDWORD) (FBBOY SIGNEDWORD) (FBBDX SIGNEDWORD) (FBBDY SIGNEDWORD) (|\\SFLKerns| POINTER) ( |\\SFRWidths| POINTER) (FONTDEVICESPEC POINTER) (* \; "Holds the spec by which the font is known to the printing device, if coercion has been done") ( OTHERDEVICEFONTPROPS POINTER) (* \; "For individual devices to hang special information") (FONTSCALE POINTER) (\\SFFACECODE BITS 8) (FONTAVGCHARWIDTH WORD) (* \; "Set in FONTCREATE, used to fix up the linelength when DSPFONT is called") (FONTIMAGEWIDTHS POINTER) ( * \; "This is the image width, as opposed to the advanced width; initial hack for accents, kerning. Fields is referenced by FONTCREATE." ) (FONTCHARSETVECTOR POINTER) (* \; "A 256-pointer block, with one pointer per 'character set' --each group of 256 character codes. Each pointer is either NIL if there's no info for that charset, or is a CHARSETINFO, containing widths, char bitmap, etc for the characters in that charset." ) (FONTEXTRAFIELD2 POINTER)) FONTCHARSETVECTOR _ (\\CREATEFONTCHARSETVECTOR)) (RECORD FONTFACE (WEIGHT SLOPE EXPANSION) (ACCESSFNS ((COLOR (CDDDR DATUM) (RPLACD (CDDR DATUM) NEWVALUE)) (BACKCOLOR (COND ((CDDDR DATUM) (CAR (CDDDR DATUM)))) (PROGN (COND ((NULL (CDDDR DATUM)) ( RPLACD (CDDR DATUM) (LIST NIL NIL)))) (RPLACA (CDDDR DATUM) NEWVALUE))) (FORECOLOR (COND ((CDDDR DATUM ) (CADR (CDDDR DATUM)))) (PROGN (COND ((NULL (CDDDR DATUM)) (RPLACD (CDDR DATUM) (LIST NIL NIL)))) ( RPLACA (CDR (CDDDR DATUM)) NEWVALUE))))) WEIGHT _ (QUOTE MEDIUM) SLOPE _ (QUOTE REGULAR) EXPANSION _ ( QUOTE REGULAR) (TYPE? LISTP)) (DATATYPE CHARSETINFO (WIDTHS (* \; "The advance-width of each character, an array indexed by charcode. Usually the same as the imagewidth, but can differ for accents, kerns kerns. This is what should be used for stringwidth calculations." ) OFFSETS (* \; "Offset of each character into the image bitmap; X value of left edge") IMAGEWIDTHS ( * \; "imagewidths is not automagically allocated since it is not always needed") CHARSETBITMAP (* \; "Bitmap containing the character images, indexed by OFFSETS") YWIDTHS (CHARSETASCENT WORD) (* \; "Max ascent for all characters in this CHARSET") (CHARSETDESCENT WORD) (* \; "Max descent for all characters in this CHARSET") LEFTKERN) WIDTHS _ (\\CREATECSINFOELEMENT) OFFSETS _ (\\CREATECSINFOELEMENT)) (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 ((OFFSETSBLOCK CHAR8CODE) (\\GETBASE OFFSETSBLOCK CHAR8CODE))) (PUTPROPS \\FSETOFFSET DMACRO ((OFFSETSBLOCK CHAR8CODE OFFSET) (\\PUTBASE OFFSETSBLOCK CHAR8CODE OFFSET))) (PUTPROPS \\FGETWIDTH DMACRO ((WIDTHSBLOCK CHAR8CODE) (\\GETBASE WIDTHSBLOCK CHAR8CODE))) (PUTPROPS \\FSETWIDTH DMACRO ((WIDTHSBLOCK INDEX WIDTH) (\\PUTBASE WIDTHSBLOCK INDEX WIDTH))) (PUTPROPS \\FGETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE) (\\FGETWIDTH (|ffetch| (CHARSETINFO WIDTHS) |of| (\\GETCHARSETINFO (\\CHARSET CHARCODE) FONTDESC)) (\\CHAR8CODE CHARCODE)))) (PUTPROPS \\FSETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE WIDTH) (\\FSETWIDTH (|ffetch| ( CHARSETINFO WIDTHS) |of| (\\GETCHARSETINFO (\\CHARSET CHARCODE) FONTDESC)) (\\CHAR8CODE CHARCODE) WIDTH))) (PUTPROPS \\FGETIMAGEWIDTH MACRO ((IMAGEWIDTHSBLOCK CHAR8CODE) (\\GETBASE IMAGEWIDTHSBLOCK CHAR8CODE)) ) (PUTPROPS \\FSETIMAGEWIDTH DMACRO ((WIDTHSBLOCK INDEX WIDTH) (\\PUTBASE WIDTHSBLOCK INDEX WIDTH))) (PUTPROPS \\GETCHARSETINFO MACRO ((CHARSET FONTDESC NOSLUG?) (* |;;| "fetches the charsetinfo for charset CHARSET in fontdescriptor FONTDESC. If NIL, then creates the required charset." ) (* |;;| "NOSLUG? means don't create an empty (slug) csinfo if the charset is not found, just return NIL") (OR (\\GETBASEPTR (|ffetch| FONTCHARSETVECTOR |of| FONTDESC) (UNFOLD CHARSET 2)) (\\CREATECHARSET CHARSET FONTDESC NOSLUG?)))) (PUTPROPS \\CREATECSINFOELEMENT MACRO (NIL (\\ALLOCBLOCK (FOLDHI (IPLUS \\MAXTHINCHAR 3) WORDSPERCELL) ))) (PUTPROPS \\CREATEFONTCHARSETVECTOR MACRO (NIL (* \; "Allocates a block for the character set records" ) (\\ALLOCBLOCK (ADD1 \\MAXCHARSET) T))) (DEFMACRO \\CREATEKERNELEMENT NIL (BQUOTE (CL:MAKE-ARRAY (IPLUS \\MAXTHINCHAR 3) :ELEMENT-TYPE (QUOTE (SIGNED-BYTE 16)) :INITIAL-ELEMENT 0))) (DEFMACRO \\FSETLEFTKERN (LEFTKERNBLOCK INDEX KERNVALUE) (BQUOTE (CL:SETF (CL:AREF (\\\, LEFTKERNBLOCK ) (\\\, INDEX)) (\\\, KERNVALUE)))) (DEFMACRO \\FGETLEFTKERN (LEFTKERNBLOCK CHAR8CODE) (BQUOTE (CL:AREF (\\\, LEFTKERNBLOCK) (\\\, CHAR8CODE)))) (RPAQQ \\MAXNSCHAR 65535) (CONSTANTS (\\MAXNSCHAR 65535)) (PUTPROP (QUOTE FONT) (QUOTE IMPORTDATE) (IDATE "28-Jun-1999 16:29:49")) (BLOCKRECORD KEYACTION ((* |;;| "KEYACTION Table: For interpreting keystrokes. Stored as a 8-cell block of untyped pointer hunk storage." ) FLAGS (* \; "Flag byte per key# (one for down-transtion, 1 for up-.) to describe whether lockshifting occrrs, you ignore the transition, etc." ) CODES (* \; "Table of character codes generated by each key when no shift key is pressed.") SHIFTCODES (* \; "Table of character codes generated by each key when the shift key is pressed.") ARMED (* \; "Not sure...") INTERRUPTLIST (* \; "List of armed interrupts?") ALTGRAPHCODES (* \; "Table of codes to be generated when the ALT-GRAPH key is pressed.") DEADKEYLIST (* \; "Block of dead-key handlers, with the nominal up-transition fields filled by the shifted-case tables. Each \"table\" is an ALIST of orignal code => accented code. no entry means punt the accent.." )) FLAGS _ (\\ALLOCBLOCK (FOLDHI (IPLUS \\NKEYS \\NKEYS) BYTESPERCELL)) CODES _ (\\ALLOCBLOCK (FOLDHI (PLUS \\NKEYS \\NKEYS) WORDSPERCELL)) SHIFTCODES _ (\\ALLOCBLOCK (FOLDHI (PLUS \\NKEYS \\NKEYS) WORDSPERCELL)) ARMED _ (\\ALLOCBLOCK (FOLDHI (ADD1 \\MAXTHINCHAR) BITSPERCELL)) ALTGRAPHCODES _ ( \\ALLOCBLOCK (FOLDHI (PLUS \\NKEYS \\NKEYS) WORDSPERCELL)) DEADKEYLIST _ (\\ALLOCBLOCK (PLUS \\NKEYS \\NKEYS \\NKEYS \\NKEYS) T) (CREATE (\\ALLOCBLOCK 7 PTRBLOCK.GCT)) (TYPE? (AND (\\BLOCKDATAP DATUM) ( IGEQ (\\#BLOCKDATACELLS DATUM) 5) (OR (NULL (FETCH (KEYACTION INTERRUPTLIST) OF DATUM)) (LISTP (FETCH INTERRUPTLIST OF DATUM))) (\\BLOCKDATAP (FETCH (KEYACTION FLAGS) DATUM)) (\\BLOCKDATAP (FETCH ( KEYACTION CODES) DATUM)) (\\BLOCKDATAP (FETCH (KEYACTION ARMED) DATUM))))) (RPAQQ \\NKEYS 112) (CONSTANTS \\NKEYS) (DEFOPTIMIZER KEYDOWNP (KEYNAME) (BQUOTE (\\NEWKEYDOWNP (\\KEYNAMETONUMBER (\\\, KEYNAME))))) (PUTPROPS XKEYDOWNP MACRO ((KEYNAME) (KEYDOWNP1 (\\KEYNAMETONUMBER KEYNAME)))) (PUTPROPS KEYDOWNP1 MACRO (OPENLAMBDA (KEYNUMBER) (DECLARE (GLOBALVARS \\EM.KBDAD0 \\EM.KBDAD1 \\EM.KBDAD2 \\EM.KBDAD3 \\EM.UTILIN \\EM.KBDAD4 \\EM.KBDAD5)) (PROG NIL (RETURN (EQ 0 (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))))))) (PUTPROPS \\NEWKEYDOWNP MACRO ((KEYNUMBER) (EQ 0 (\\GETBASEBIT \\LASTKEYSTATE KEYNUMBER)))) (GLOBALVARS \\KEYBOARD.DEVICE \\KEYBOARD.STREAM) (RPAQQ HARDCURSORHEIGHT 16) (RPAQQ HARDCURSORWIDTH 16) (CONSTANTS (HARDCURSORHEIGHT 16) (HARDCURSORWIDTH 16)) (ADDTOVAR GLOBALVARS LASTMOUSEX LASTMOUSEY LASTSCREEN LASTMOUSEBUTTONS LASTMOUSETIME LASTKEYBOARD) (PUTPROPS \\SETMOUSEXY MACRO ((XPOS YPOS) (PROGN (SELECTC \\MACHINETYPE (\\DAYBREAK ( |\\DoveMisc.SetMousePosition| XPOS YPOS)) (\\MAIKO (SUBRCALL SETMOUSEXY XPOS YPOS)) (\\DANDELION (|do| (PROGN (|replace| (IOPAGE NEWMOUSEX) |of| \\IOPAGE |with| XPOS) (|replace| (IOPAGE NEWMOUSEY) |of| \\IOPAGE |with| YPOS)) |repeatuntil| (ILESSP (|fetch| (IOPAGE NEWMOUSESTATE) |of| \\IOPAGE) 32768)) (* \; "smash position until mouse says it is not busy") (|replace| (IOPAGE NEWMOUSEX) |of| \\IOPAGE |with| XPOS) (|replace| (IOPAGE NEWMOUSEY) |of| \\IOPAGE |with| YPOS) (|replace| (IOPAGE NEWMOUSESTATE ) |of| \\IOPAGE |with| 32768)) NIL) (PROGN (\\PUTBASE \\EM.MOUSEX 0 XPOS) (\\PUTBASE \\EM.MOUSEY 0 YPOS))))) (GLOBALVARS \\EM.MOUSEX \\EM.MOUSEY \\EM.CURSORX \\EM.CURSORY \\EM.UTILIN \\EM.REALUTILIN \\EM.KBDAD0 \\EM.KBDAD1 \\EM.KBDAD2 \\EM.KBDAD3 \\EM.KBDAD4 \\EM.KBDAD5 \\EM.DISPINTERRUPT \\EM.DISPLAYHEAD \\EM.CURSORBITMAP \\MACHINETYPE \\DEFAULTKEYACTION \\COMMANDKEYACTION \\CURRENTKEYACTION \\PERIODIC.INTERRUPT \\PERIODIC.INTERRUPT.FREQUENCY) (PUTPROP (QUOTE LLKEY) (QUOTE IMPORTDATE) (IDATE "19-May-2018 13:32:12")) (DATATYPE PILOTBBT ((PBTDESTLO WORD) (PBTDESTHI WORD) (PBTDESTBIT WORD) (PBTDESTBPL SIGNEDWORD) ( PBTSOURCELO WORD) (PBTSOURCEHI WORD) (PBTSOURCEBIT WORD) (PBTSOURCEBPL SIGNEDWORD) (PBTWIDTH WORD) ( PBTHEIGHT WORD) (PBTFLAGS WORD) (NIL 5 WORD)) (BLOCKRECORD PILOTBBT ((NIL 7 WORD) (NIL BITS 4) ( PBTGRAYOFFSET BITS 4) (PBTGRAYWIDTHLESSONE BITS 4) (PBTGRAYHEIGHTLESSONE BITS 4) (NIL 2 WORD) ( 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)))))) (SYSTEM)) (DATATYPE \\DISPLAYDATA (DDXPOSITION DDYPOSITION DDXOFFSET DDYOFFSET |DDDestination| |DDClippingRegion| DDFONT |DDSlowPrintingCase| DDWIDTHSCACHE DDOFFSETSCACHE DDCOLOR DDLINEFEED |DDRightMargin| |DDLeftMargin| |DDScroll| DDOPERATION DDSOURCETYPE (|DDClippingLeft| WORD) ( |DDClippingRight| WORD) (|DDClippingBottom| WORD) (|DDClippingTop| WORD) (NIL WORD) (DDHELDFLG FLAG) ( XWINDOWHINT XPOINTER) (DDPILOTBBT POINTER) DDXSCALE DDYSCALE DDCHARIMAGEWIDTHS DDEOLFN DDPAGEFULLFN |DDTexture| DDMICAXPOS DDMICAYPOS DDMICARIGHTMARGIN DDCHARSET (DDCHARSETASCENT WORD) (DDCHARSETDESCENT WORD) DDCHARHEIGHTDELTA (DDSPACEWIDTH WORD)) DDPILOTBBT _ (|create| PILOTBBT PBTDISJOINT _ T) |DDLeftMargin| _ 0 |DDRightMargin| _ SCREENWIDTH DDXPOSITION _ 0 DDYPOSITION _ 0 DDXOFFSET _ 0 DDYOFFSET _ 0 |DDClippingRegion| _ (|create| REGION) |DDDestination| _ |ScreenBitMap| DDXSCALE _ 1 DDYSCALE _ 1 |DDTexture| _ 0 (ACCESSFNS ((DDFOREGROUNDCOLOR (PROG ((VAL (|fetch| (\\DISPLAYDATA DDCOLOR) |of| DATUM))) (OR (FIXP VAL) (BITMAPP VAL) (AND (NULL VAL) 1) (CAR VAL) (MAXIMUMCOLOR ( BITSPERPIXEL (|fetch| (\\DISPLAYDATA |DDDestination|) |of| DATUM)))))) (DDBACKGROUNDCOLOR (OR (|fetch| (\\DISPLAYDATA |DDTexture|) |of| DATUM) 0)))) (SYSTEM)) (RECORD DISPLAYSTATE (ONOFF)) (RECORD DISPLAYINFO (DITYPE DIWIDTH DIHEIGHT DIBITSPERPIXEL DIWSOPS)) (PUTPROPS \\GETDISPLAYDATA MACRO (ARGS (COND ((CADR ARGS) (SUBPAIR (QUOTE (STRM STRMVAR)) ARGS (QUOTE (\\DTEST (|fetch| (STREAM IMAGEDATA) |of| (SETQ STRMVAR (\\OUTSTREAMARG STRM))) (QUOTE \\DISPLAYDATA)) ))) (T (SUBST (CAR ARGS) (QUOTE STRM) (QUOTE (\\DTEST (|fetch| (STREAM IMAGEDATA) |of| (\\OUTSTREAMARG STRM)) (QUOTE \\DISPLAYDATA)))))))) (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)))) (GLOBALVARS BITMASKARRAY NOTBITMASKARRAY 4BITMASKARRAY NOT4BITMASKARRAY) (RPAQQ WORDMASK 65535) (CONSTANTS (WORDMASK 65535)) (PUTPROPS \\INVALIDATEDISPLAYCACHE MACRO ((DISPLAYDATA) (* |This| |marks| |the| |character-printing| |caches| |of| |the| |displaystream| |as| |invalid.| |Needed| |when| |the| |font| |or| Y |position| |changes|) (|freplace| (\\DISPLAYDATA DDCHARSET) |of| DISPLAYDATA |with| MAX.SMALLP) (|freplace| ( \\DISPLAYDATA DDCHARSETASCENT) |of| DISPLAYDATA |with| MAX.SMALLP))) (PUTPROPS \\DSPGETCHARWIDTH MACRO ((CHARCODE DD) (\\FGETWIDTH (|ffetch| (\\DISPLAYDATA DDWIDTHSCACHE) |of| DD) CHARCODE))) (PUTPROPS \\DSPGETCHARIMAGEWIDTH MACRO ((CHARCODE DD) (\\FGETIMAGEWIDTH (|ffetch| (\\DISPLAYDATA DDCHARIMAGEWIDTHS) |of| DD) CHARCODE))) (PUTPROPS \\DSPGETCHAROFFSET MACRO ((CHARCODE DD) (\\GETBASE (|ffetch| (\\DISPLAYDATA DDOFFSETSCACHE) |of| DD) CHARCODE))) (PUTPROPS \\CONVERTOP MACRO ((OP) (* |rrb| "14-NOV-80 11:14") (* |Only| |for| |alto| |bitblt| !!) ( SELECTQ OP (|replace| 0 |of| NIL |with| NIL) (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| (BITMAP 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 (BBT |SourceType| |Operation|) (PROGN (|replace| ( PILOTBBT PBTOPERATION) |of| BBT |with| (SELECTQ |Operation| (ERASE 1) (PAINT 2) (INVERT 3) 0)) ( |replace| (PILOTBBT PBTSOURCETYPE) |of| BBT |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))) (PROGN (PUTPROPS \\INSURETOPWDS DMACRO (OPENLAMBDA (DS) (OR (EQ DS \\TOPWDS) (COND ((FMEMB ( DSPDESTINATION NIL DS) \\SCREENBITMAPS) (\\TOTOPWDS DS)))))) (PUTPROPS \\INSURETOPWDS MACRO ((DS) (* |For| |non-window| |implementations|) (PROGN)))) (PUTPROPS .WHILE.TOP.DS. MACRO ((FIRST . REST) (PROG (DISPINTERRUPT SOFTCURSORUP) (* FIRST |should| |be| \a |displaystream| |and| \a |variable.| |This| |macro| |may| |also| |take| \a |soft| |cursor| |down,| |similar| |to| |the| |way| .WHILE.CURSOR.DOWN. |does,| |but| |only| |if| |FIRST's| |destination| |is| |the| |same| |as| |the| |soft| |cursor's| |destination.| *) (COND (\\SOFTCURSORP ( SETQ SOFTCURSORUP (AND \\SOFTCURSORUPP (EQ (DSPDESTINATION NIL FIRST) \\CURSORDESTINATION))) (COND ( SOFTCURSORUP (SETQ DISPINTERRUPT (\\GETBASE \\EM.DISPINTERRUPT 0)) (\\PUTBASE \\EM.DISPINTERRUPT 0 0) (\\SOFTCURSORDOWN))))) (\\INSURETOPWDS FIRST) (PROGN . REST) (COND (SOFTCURSORUP ( \\SOFTCURSORUPCURRENT) (\\PUTBASE \\EM.DISPINTERRUPT 0 DISPINTERRUPT)))))) (PUTPROPS .WHILE.CURSOR.DOWN. MACRO ((FIRST . REST) (PROG (DISPINTERRUPT SOFTCURSORUP) (* |This| |macro| |should| |wrap| |around| |any| |code| |that| |draws| |or| |bitblts| |directly| |from| |or| |to| \a |screen| |bitmap.| E.\g. DRAWGRAYBOX |in| HLDISPLAY |which| |puts| |up| \a |shadow| |box| |during| GETREGION. |The| |purpose| |of| |this| |macro| |is| |that| \a |soft| (|e.g.| |color|) |cursor's| |bits| |not| |be| |taken| |to| |be| |screen| |bits| |while| FIRST & REST |are| |done.| *) ( COND (\\SOFTCURSORP (SETQ SOFTCURSORUP \\SOFTCURSORUPP) (COND (SOFTCURSORUP (SETQ DISPINTERRUPT ( \\GETBASE \\EM.DISPINTERRUPT 0)) (\\PUTBASE \\EM.DISPINTERRUPT 0 0) (\\SOFTCURSORDOWN))))) (PROGN FIRST . REST) (COND (SOFTCURSORUP (\\SOFTCURSORUPCURRENT) (\\PUTBASE \\EM.DISPINTERRUPT 0 DISPINTERRUPT)))))) (ADDTOVAR GLOBALVARS \\TOPWDS) (DEFOPTIMIZER TTYDISPLAYSTREAM (&REST X) (COND ((NULL (CAR X)) (QUOTE \\TERM.OFD)) (T (QUOTE IGNOREMACRO)))) (GLOBALVARS BELLCNT BELLRATE TTYBACKGROUNDFNS |\\DisplayStoppedForLogout| \\CARET.UP) (PUTPROPS \\CHECKCARET MACRO ((X) (AND \\CARET.UP (\\CARET.DOWN X)))) (PUTPROPS \\DSPTRANSFORMX MACRO ((X DD) (* |transforms| |an| \x |coordinate| |into| |the| |destination| |coordinate.|) (IPLUS X (|fetch| (\\DISPLAYDATA DDXOFFSET) |of| DD)))) (PUTPROPS \\DSPTRANSFORMY MACRO ((Y DD) (* |transforms| |an| \y |coordinate| |into| |the| |destination| |coordinate.|) (IPLUS Y (|fetch| (\\DISPLAYDATA DDYOFFSET) |of| DD)))) (PUTPROPS \\OFFSETBOTTOM MACRO ((X) (* |gives| |the| |destination| |coordinate| |address| |of| |the| |origin.|) (|fetch| (\\DISPLAYDATA DDYOFFSET) |of| X))) (PUTPROPS \\OFFSETLEFT MACRO ((DD) (* |returns| |the| \x |origin| |of| |display| |data| |destination| |coordinates.|) (|fetch| (\\DISPLAYDATA DDXOFFSET) |of| DD))) (PUTPROPS DISPLAYINITIALIZEDP MACRO (NIL (* |always| |initialized| |now|) T)) (PUTPROPS DISPLAYSTARTEDP MACRO (NIL |\\DisplayStarted|)) (GLOBALVARS |\\DisplayStarted| |\\DisplayStreamsInitialized| |\\DisplayInitialed| WHOLEDISPLAY WHOLESCREEN SCREENWIDTH SCREENHEIGHT) (PUTPROP (QUOTE LLDISPLAY) (QUOTE IMPORTDATE) (IDATE "18-Apr-1994 00:20:42")) (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 NUMBERP)))) (SYSTEM)) (DATATYPE BITMAP ((BITMAPBASE POINTER) (BITMAPRASTERWIDTH WORD) (BITMAPHEIGHT WORD) (BITMAPWIDTH WORD) (BITMAPBITSPERPIXEL WORD)) BITMAPBITSPERPIXEL _ 1 (BLOCKRECORD BITMAP ((|BitMapHiLoc| WORD) ( |BitMapLoLoc| WORD)) (* \; "overlay initial pointer")) (SYSTEM)) (BLOCKRECORD BITMAPWORD ((BITS WORD)) (SYSTEM)) (RECORD POSITION (XCOORD . YCOORD) (TYPE? (AND (LISTP DATUM) (NUMBERP (CAR DATUM)) (NUMBERP (CDR DATUM )))) (SYSTEM)) (DATATYPE CURSOR (CUIMAGE CUMASK CUHOTSPOTX CUHOTSPOTY CUDATA) (ACCESSFNS ((CUBITSPERPIXEL (|fetch| ( BITMAP BITMAPBITSPERPIXEL) |of| (|fetch| (CURSOR CUIMAGE) |of| DATUM))))) (SYSTEM)) (RECORD MOUSEEVENT (MOUSEX MOUSEY MOUSEBUTTONS KEYBOARD MOUSETIME) (SYSTEM)) (RECORD SCREENREGION (SCREEN . REGION) (SUBRECORD REGION) (TYPE? (AND (LISTP DATUM) (|type?| SCREEN ( CAR DATUM)) (|type?| REGION (CDR DATUM)))) (SYSTEM)) (RECORD SCREENPOSITION (SCREEN . POSITION) (SUBRECORD POSITION) (TYPE? (AND (LISTP DATUM) (|type?| SCREEN (CAR DATUM)) (|type?| POSITION (CDR DATUM)))) (SYSTEM)) (PUTPROPS CURSORBITMAP MACRO (NIL |CursorBitMap|)) (RPAQQ HARDCURSORHEIGHT 16) (RPAQQ HARDCURSORWIDTH 16) (CONSTANTS (HARDCURSORHEIGHT 16) (HARDCURSORWIDTH 16)) (ADDTOVAR GLOBALVARS |CursorBitMap|) (ARRAYRECORD POLYNOMIAL (A B C D) (CREATE (ARRAY 4 (QUOTE FLOATP))) (SYSTEM)) (RECORD SPLINE (\#KNOTS SPLINEX SPLINEY SPLINEDX SPLINEDY SPLINEDDX SPLINEDDY SPLINEDDDX SPLINEDDDY)) (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)))))))) (ADDTOVAR GLOBALVARS SCREENHEIGHT SCREENWIDTH |ScreenBitMap|) (RPAQQ BLACKSHADE 65535) (RPAQQ WHITESHADE 0) (CONSTANTS (BLACKSHADE 65535) (WHITESHADE 0)) (RPAQQ GRAYSHADE 43605) (ADDTOVAR GLOBALVARS GRAYSHADE) (RECORD HLS (HUE LIGHTNESS SATURATION)) (RECORD RGB (RED GREEN BLUE)) (PUTPROP (QUOTE ADISPLAY) (QUOTE IMPORTDATE) (IDATE "15-Sep-1994 17:07:04")) (ADDTOVAR SYSSPECVARS \\INTERRUPTABLE) (PUTPROPS UNINTERRUPTABLY INFO EVAL) (PUTPROPS UNINTERRUPTABLY DMACRO ((X . Y) ((LAMBDA (\\INTERRUPTABLE) (PROGN X . Y)) NIL))) (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 ")")))) (BLOCKRECORD INTERRUPTSTATE ((* |;;| "This is the structure used to communicate between the emulator and Lisp re interrupts. There is a bit per interrupt type, plus space for the character code that caused a keyboard interrupt." ) (* |;;| "This must match the INTSTAT definition in lispemul.h") (* |;;| "PENDING-INTERRUPT FLAGS:") (LOGMSGSPENDING FLAG) (* \; " Log/Console msgs need printing.") (ETHERINTERRUPT FLAG) (* \; "Ether packet read finished.") (IOINTERRUPT FLAG) (GCDISABLED FLAG) (* \; "No mroe room in GC tables." ) (VMEMFULL FLAG) (* \; "VMEM is full!!") (STACKOVERFLOW FLAG) (* \; "Stack overflowed.") (STORAGEFULL FLAG) (* \; "Ran out of storage, atoms, etc.") (WAITINGINTERRUPT FLAG) (* |;;| "INTERRUPTS-IN-PROCESS MASK:") (P-LOGMSGSPENDING FLAG) (* \; " Log/Console msgs need printing.") ( P-ETHERINTERRUPT FLAG) (* \; "Ether packet read finished.") (P-IOINTERRUPT FLAG) (P-GCDISABLED FLAG) ( * \; "No mroe room in GC tables.") (P-VMEMFULL FLAG) (* \; "VMEM is full!!") (P-STACKOVERFLOW FLAG) (* \; "Stack overflowed.") (P-STORAGEFULL FLAG) (* \; "Ran out of storage, atoms, etc.") ( P-WAITINGINTERRUPT FLAG) (INTCHARCODE WORD)) (BLOCKRECORD INTERRUPTSTATE ((* |;;| "Alternative view of the structure:") (PENDING BITS 8) (* \; "Pending-interrupt flags") (IN-PROGRESS BITS 8) (* \; "Mask to prevent re-interrupt for an interrupt in progress") (NIL WORD)))) (PUTPROPS \\TAKEINTERRUPT DMACRO ((PREFORM POSTFORM) (DECLARE (GLOBALVARS \\PENDINGINTERRUPT)) (COND ( (AND \\PENDINGINTERRUPT (INTERRUPTABLE~=NILUPTHESTACK)) PREFORM ((LAMBDA (\\INTERRUPTABLE) ( \\CALLINTERRUPTED)) T) POSTFORM)))) (PUTPROP (QUOTE AINTERRUPT) (QUOTE IMPORTDATE) (IDATE "17-Sep-1992 10:42:38")) (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 ")")))) (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")))) (GLOBALVARS \\ETHERWAIT1 \\ETHERTIMEOUT \\MAXETHERTRIES PUPTRACEFLG LOGINPASSWORDS) (GLOBALVARS PUPTRACEFILE PUPONLYTYPES PUPIGNORETYPES PUPPRINTMACROS) (RPAQQ \\PUPOVLEN 22) (RPAQQ \\MAX.PUPLENGTH 532) (RPAQQ \\TIME.GETPUP 5) (CONSTANTS (\\PUPOVLEN 22) (\\MAX.PUPLENGTH 532) (\\TIME.GETPUP 5)) (PUTPROPS PUPPRINTMACROS VARTYPE ALIST) (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 "19-Jan-1993 11:14:09")) (PUTPROPS UNLESSRDSYS MACRO ((NORMAL RDSYS) NORMAL)) (PUTPROPS UNLESSINEW MACRO ((NORMAL I-NEW) NORMAL)) (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 "27-Apr-1994 15:43:27")) (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 "15-Mar-1994 10:48:02")) (PUTPROPS .COPYKEYDOWNP. MACRO (NIL (OR (KEYDOWNP (QUOTE LSHIFT)) (KEYDOWNP (QUOTE RSHIFT)) (KEYDOWNP (QUOTE COPY))))) (PUTPROPS WSOP MACRO (ARGS (LET ((METHOD (CADR (CAR ARGS))) (DISPLAY (CADR ARGS)) (OTHERARGS (CDDR ARGS))) (BQUOTE (SPREADAPPLY* (|fetch| (WSOPS (\\\, METHOD)) |of| (|fetch| (FDEV WINDOWOPS) |of| (\\\, DISPLAY))) (\\\, DISPLAY) (\\\,@ OTHERARGS)))))) (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 WINDOWOP DMACRO (ARGS (LET ((OPNAME (CAR ARGS)) (METHOD-DEVICE (CADR ARGS)) (TAIL (CDDR ARGS ))) (COND ((AND (LISTP OPNAME) (EQ (CAR OPNAME) (QUOTE QUOTE))) (BQUOTE (SPREADAPPLY* (|fetch| (SCREEN (\\\, (CADR OPNAME))) |of| (\\\, METHOD-DEVICE)) (\\\, METHOD-DEVICE) (\\\,@ TAIL)))) (T (ERROR "OPNAME not quoted: " OPNAME)))))) (RPAQQ |MinWindowWidth| 26) (RPAQQ |MinWindowHeight| 16) (CONSTANTS (|MinWindowWidth| 26) (|MinWindowHeight| 16)) (DATATYPE WINDOW (DSP (* \; "The display stream you use to actually printto the window.") NEXTW (* \; "Next window in the open-window list") SAVE (* \; "Saved image from anything this window's on top of") REG (* \; "Screen region this window occupies") BUTTONEVENTFN (* \; "FN called when left/middle mouse button goes up/down") RIGHTBUTTONFN (* \; "FN called when right mouse button goes up/down") CURSORINFN (* \; "Fn called when mouse enters window") CURSOROUTFN (* \; "Called when mouse leaves window") CURSORMOVEDFN (* \; "Called when mouse moves in window") REPAINTFN (* \; "Redisplay part of thie window") RESHAPEFN (* \; "Called when window is reshaped") EXTENT (* \; "Scrolling limits") USERDATA (* \; "Proplist to hold other window properites") VERTSCROLLREG (* \; "Region of vert scroll bar") HORIZSCROLLREG (* \; "Tegion of horiz scroll bar") SCROLLFN (* \; "Fn to scroll this window") VERTSCROLLWINDOW (* \; "Vert scroll bar") HORIZSCROLLWINDOW (* \; "Horiz scroll bar") CLOSEFN (* \; "Called at close time") MOVEFN (* \; "Called when window is moved") WTITLE (* \; "Window's title string, if any") NEWREGIONFN (* \; "Called to get new window shape") WBORDER (* \; "Window border-width, in pixels") PROCESS (* \; "Medley process associated with this window") WINDOWENTRYFN (* \; "Fn to call when kbd focus is switched here") SCREEN (* \; "Screen this window appears on") ( NATIVE-HANDLE FIXP) (* \; "Uniterpreted place for native window to store a C pointer to its private info") (NATIVE-INFO1 FIXP) ( * \; "Reserved in case the pointer must be 64 bits") (NATIVE-W1 WORD) (* \; "Word for use by native handler") (NATIVE-W2 WORD) (* \; "Word for use by native handler") (NATIVE-P1 POINTER) (* \; "Lisp pointer for use by native handler")) BUTTONEVENTFN _ (FUNCTION TOTOPW) WBORDER _ |WBorder| WINDOWENTRYFN _ (FUNCTION GIVE.TTY.PROCESS) (SYSTEM)) (DATATYPE SCREEN (SCONOFF SCDESTINATION SCWIDTH SCHEIGHT SCTOPW SCTOPWDS SCTITLEDS SCFDEV SCDS SCDATA (* |;;| "Space for native window manager interface to use.") (HANDLE FIXP) (* \; "Handle for emulator to store info about display for C code use.") (HANDLE2 FIXP) (* \; "Reserved in case HANDLE needs to be 64 bits on the C side.") (NATIVE-INFO POINTER) (* \; "POINTER for the private use of the emulator window code") NATIVETYPE (* \; "Symbol to tell what kind of native window system we're using.") (* |;;| "- - - Functional interface to screen management - - -") WINIMAGEOPS (* \; "IMAGEOPS to be used in display streas on this kind of screen") WINFDEV (* \; "FDEV for display streams on this screen") CREATEWFN (* \; "Create a window") OPENWFN (* \; "Open a window") CLOSEWFN (* \; "Close a window") MOVEWFN (* \; "Move a window") RELMOVEWFN (* \; "Move window, relative") SHRINKWFN (* \; "Shrink window to icon") EXPANDWFN (* \; "Expand icon to window") SHAPEWFN (* \; "Reshape a window") REDISPLAYFN (* \; "Redisplay (part of) a window") GETWINDOWPROPFN (* \; "Get window property value") PUTWINDOWPROPFN (* \; "Set window property value") BURYWFN (* \; "Move window behind all others") TOTOPWFN (* \; "Move iwindow in front of all others") IMPORTWFN (* \; "Take a native window and save its state internally") EXPORTWFN (* \; "Take a saved window state and open it on this screen, filling in screen and methods as needed.") DESTROYFN (* \; "Destroy this window, for GC finaliszation") SETCURSORFN (* \; "Set the cursor for this window.") PROMPTW (* \; "The prompt window for this screen") SHOWGCFN (* \; "Show GC indication; called with ON/OFF arg, t=>show gcing status, NIL=>turn off GC indicator.") DSPCREATEFN (* \; "Create a displaystream on this screen.") BBTTOWIN (* \; "BITBLT from a lisp bitmap to a window") BBTFROMWIN (* \; "BITBLT from a window to a lisp bitmap") BBTWINWIN (* \; "BITBLT from a window to another window.") SCCURSOR (* \; "CURSOR that's in effect for this screen by default.") SCKEYBOARD (* \; "Something about which keyboard we're receiving from.") SCDEPTH (* \; "# of bits per pixel on the screen. THIS WILL REPLACE SCBITSPERPIXEL ASAP.") SCCLOSEDOWN (* \; "Close down this screen cleanly, saving window state.") SCCLOSESCREEN (* \; "Close down thie screen cleanly, no state saving.") SCREOPEN (* \; "Reopen this screen?") SCCARETFLASH (* \; "Function to flash thecaret.") SCGETSCREENPOSITION (* \; "GETSCREENPOSITION") SCGETBOXSCREENPOSITION (* \; "GETBOXPOSITION") SCGETSCREENREGION (* \; "GETREGION") SCMOVEPOINTER (* \; "\\CURSORPOSITION")) SCONOFF _ (QUOTE OFF) (ACCESSFNS ((SCBITSPERPIXEL (COND ((|fetch| (SCREEN SCDESTINATION) |of| DATUM) (|fetch| (BITMAP BITMAPBITSPERPIXEL) |of| (|fetch| (SCREEN SCDESTINATION) |of| DATUM))) (T 1))) (SCREGION (|create| REGION LEFT _ 0 BOTTOM _ 0 WIDTH _ (|fetch| (SCREEN SCWIDTH) |of| DATUM) HEIGHT _ (|fetch| (SCREEN SCHEIGHT) |of| DATUM))))) (SYSTEM)) (GLOBALVARS WINDOWUSERFORMS ENDOFWINDOWUSERFORMS PROMPTWINDOW) (PUTPROP (QUOTE WINDOW) (QUOTE IMPORTDATE) (IDATE " 9-Apr-2000 17:36:29")) (PUTPROPS NNLITATOM MACRO (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) (NIL (QUOTE MILLISECONDS)) (|\\CanonicalizeTimerUnits| X)))) (PUTPROPS \\MACRO.EVAL DMACRO (Z (PROG ((X (EXPANDMACRO (CAR Z) T))) (|if| (EQ X (CAR Z)) |then| ( ERROR "No macro property -- \\MACRO.EVAL" X) |else| (RETURN (EVAL X)))))) (DEFOPTIMIZER \\MACRO.MX (FORM) FORM) (PUTPROP (QUOTE MACROAUX) (QUOTE IMPORTDATE) (IDATE "16-May-1990 20:26:31")) (RPAQQ MASK0WORD1\'S 32767) (RPAQQ MASK1WORD0\'S 32768) (RPAQQ MASKWORD1\'S 65535) (RPAQQ MASKHALFWORD1\'S 255) (RPAQQ BITSPERHALFWORD 8) (CONSTANTS MASK0WORD1\'S MASK1WORD0\'S MASKWORD1\'S MASKHALFWORD1\'S BITSPERHALFWORD) (PUTPROPS EQZEROP MACRO ((X) (EQ 0 X))) (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 .XUNBOX. MACRO ((X HX LX) (|until| (SETQ LX (SELECTC (NTYPX X) (\\SMALLP (COND ((IGEQ X 0) ( 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 .XLLSH. MACRO ((HI LO N) (|if| (IGEQ N BITSPERWORD) |then| (* \; "Jump 16 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 .XLLSH1. MACRO ((HI LO) (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 .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 .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 .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 \\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| (EQ 0 (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| (EQ 0 (LOGAND |\\BitMask| |\\Byte|)) |then| (NOT (EQ 0 VAL)) |else| (EQ 0 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 "16-May-1990 11:46:37")) (RPAQQ \\MAXFILEPAGE 65534) (CONSTANTS \\MAXFILEPAGE) (PUTPROP (QUOTE LLFAULT) (QUOTE IMPORTDATE) (IDATE " 2-Jan-1993 12:26:58")) (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) (RPAQQ \\DOVE.RCLKMILLISECOND 63) (RPAQQ \\DOVE.RCLKSECOND 62500) (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) (\\DOVE.RCLKMILLISECOND 63) (\\DOVE.RCLKSECOND 62500)) (PUTPROPS ALTO.TO.LISP.DATE MACRO ((DATE) (LOGXOR DATE -2147483648))) (PUTPROPS LISP.TO.ALTO.DATE MACRO ((DATE) (LOGXOR DATE -2147483648))) (PUTPROP (QUOTE LLTIMER) (QUOTE IMPORTDATE) (IDATE "16-May-1990 20:13:11")) (DATATYPE SYSQUEUE ((NIL BYTE) (SYSQUEUEHEAD POINTER) (NIL BYTE) (SYSQUEUETAIL POINTER))) (BLOCKRECORD QABLEITEM ((NIL BITS 4) (QLINK POINTER) (* \; "Link to next thing in queue always in first pointer of datum, independent of what the datum is")) ( BLOCKRECORD QABLEITEM ((NIL BITS 4) (LINK POINTER) (* \; "Let's also be able to call it a LINK")))) (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)) (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") (EPRECEIVING FLAG) (* \; "True when a packet has been seen at the head of the network's input queue at least once") (NIL BITS 6 ) (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 WORD) (EPTIMESTAMP FIXP) (* \; "Gets RCLK value when transmitted/received") (EPREQUEUEFN POINTER) (* \; "FN to perform requeueing") ( NIL 4 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)))) (RPAQQ \\EPT.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 \\EPT.XIP \\3MBTYPE.XIP \\10MBTYPE.XIP \\EPT.10TO3 \\3MBTYPE.10TO3 \\EPT.UNKNOWN) (RPAQQ \\NULLCHECKSUM 65535) (CONSTANTS (\\NULLCHECKSUM 65535)) (DATATYPE NDB ((NETTYPE BYTE) (* \; "10 or 3 for now") (NDBNEXT POINTER) (* \; "Link to next NDB") ( NDBPUPNET# BYTE) (* \; "Pup number of this net. May be different from NS net number, though not in Xerox world") (NDBNSNET# POINTER) (* \; "Can be 32-bits, so might as well leave its box around") (NDBTASK# BYTE) (* \; "Task # of this network") (NDBBROADCASTP POINTER) (* \; "Function that returns true if packet is of broadcast type") (NDBPUPHOST# BYTE) (* \; "My pup address on this net. NS address is global to all nets, so not needed here") (NDBTRANSMITTER POINTER) (* \; "(NDB PACKET) -- fn to send a raw packet on this net. returns NIL on failure") (NIL BYTE) (NDBENCAPSULATOR POINTER) (* \; "(NDB PACKET HOST LENGTH TYPE) -- fn to encapsulate and send a higher-level packet on this net ") ( NDBCSB POINTER) (* \; "Pointer to CSB for this network") (NDBIQLENGTH BYTE) (NDBIQ POINTER) (* \; "Queue of empty packets for receiver") (NDBTQ POINTER) (* \; "Queue of packets to transmit") ( NDBTRANSLATIONS POINTER) (* \; "Cache of translations, 3:10 or 10:3 according to network") ( NDBETHERFLUSHER POINTER) (* \; "Turns off this ether. Args NDB") (NDBWATCHER POINTER) (NDBCANHEARSELF POINTER) (* \; "True if receiver can hear packets sent by transmitter") (NDBIPNET# POINTER) ( NDBIPHOST# POINTER) (NDBPUPTYPE WORD) (* \; "The packet encapsulation of PUP on this net") (NIL WORD) (NIL POINTER) (* \; "Spares"))) (RECORD ROUTING (RTNET# RTHOPCOUNT RTGATEWAY# RTNDB RTTIMER RTRECENT)) (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 "19-Jan-1993 10:49:30")) (RECORD BRUSH (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR) BRUSHSHAPE _ (QUOTE ROUND) BRUSHSIZE _ 1) (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))))) (DATATYPE IMAGEOPS (IMAGETYPE IMCLOSEFN IMXPOSITION IMYPOSITION IMFONT IMLEFTMARGIN IMRIGHTMARGIN IMLINEFEED IMDRAWLINE IMDRAWCURVE IMDRAWCIRCLE IMDRAWELLIPSE IMFILLCIRCLE IMBLTSHADE IMBITBLT IMNEWPAGE IMMOVETO IMSCALE IMTERPRI IMTOPMARGIN IMBOTTOMMARGIN IMSPACEFACTOR IMFONTCREATE IMOPERATION IMCOLOR IMSTRINGWIDTH IMCHARWIDTH IMCHARWIDTHY IMBACKCOLOR IMBITMAPSIZE IMCLIPPINGREGION IMRESET IMDRAWPOLYGON IMFILLPOLYGON IMSCALEDBITBLT IMWRITEPIXEL IMCHARSET IMROTATE IMDRAWARC IMTRANSLATE IMSCALE2 IMPUSHSTATE IMPOPSTATE IMDEFAULTSTATE IMDRAWPOINT IMBLTCHAR IMXOFFSET IMYOFFSET) IMCLOSEFN _ (FUNCTION NILL) IMTERPRI _ (FUNCTION (LAMBDA (STREAM) (\\OUTCHAR STREAM (CHARCODE EOL)))) IMNEWPAGE _ (FUNCTION (LAMBDA (STREAM) (\\OUTCHAR STREAM (CHARCODE ^L)))) IMOPERATION _ (FUNCTION NILL) IMCOLOR _ (FUNCTION NILL) IMCLIPPINGREGION _ (FUNCTION NILL) IMRESET _ (FUNCTION NILL) IMBACKCOLOR _ (FUNCTION NILL) IMSTRINGWIDTH _ (FUNCTION (LAMBDA (STREAM STR RDTBL) (STRINGWIDTH STR (DSPFONT NIL STREAM) RDTBL RDTBL))) IMCHARWIDTH _ (FUNCTION (LAMBDA (STREAM CHARCODE) (CHARWIDTH CHARCODE (DSPFONT NIL STREAM))) ) IMMOVETO _ (FUNCTION (LAMBDA (STREAM X Y) (IMAGEOP (QUOTE IMXPOSITION) STREAM STREAM X) (IMAGEOP ( QUOTE IMYPOSITION) STREAM STREAM Y))) IMBITMAPSIZE _ (FUNCTION (LAMBDA (STREAM BITMAP DIMENSION) ( SELECTQ DIMENSION (WIDTH (TIMES (DSPSCALE NIL STREAM) (BITMAPWIDTH BITMAP))) (HEIGHT (TIMES (DSPSCALE NIL STREAM) (BITMAPHEIGHT BITMAP))) (NIL (CONS (TIMES (DSPSCALE NIL STREAM) (BITMAPWIDTH BITMAP)) ( TIMES (DSPSCALE NIL STREAM) (BITMAPHEIGHT BITMAP)))) (\\ILLEGAL.ARG DIMENSION)))) IMWRITEPIXEL _ ( FUNCTION NILL) IMCHARSET _ (FUNCTION NILL) IMXPOSITION _ (FUNCTION NILL) IMYPOSITION _ (FUNCTION NILL) IMFONT _ (FUNCTION NILL) IMLEFTMARGIN _ (FUNCTION NILL) IMRIGHTMARGIN _ (FUNCTION NILL) IMLINEFEED _ (FUNCTION NILL) IMDRAWLINE _ (FUNCTION NILL) IMDRAWCURVE _ (FUNCTION NILL) IMDRAWCIRCLE _ (FUNCTION NILL) IMDRAWELLIPSE _ (FUNCTION NILL) IMFILLCIRCLE _ (FUNCTION NILL) IMBLTSHADE _ (FUNCTION NILL) IMBITBLT _ (FUNCTION NILL) IMSCALE _ (FUNCTION NILL) IMTOPMARGIN _ (FUNCTION NILL) IMBOTTOMMARGIN _ ( FUNCTION NILL) IMSPACEFACTOR _ (FUNCTION NILL) IMFONTCREATE _ (FUNCTION NILL) IMCHARWIDTHY _ (FUNCTION NILL) IMDRAWPOLYGON _ (FUNCTION \\DRAWPOLYGON.GENERIC) IMDRAWPOINT _ (FUNCTION \\DRAWPOINT.GENERIC) IMFILLPOLYGON _ (FUNCTION NILL) IMSCALEDBITBLT _ (FUNCTION NILL) IMROTATE _ (FUNCTION NILL) IMDRAWARC _ (FUNCTION NILL) IMTRANSLATE _ (FUNCTION NILL) IMPUSHSTATE _ (FUNCTION NILL) IMPOPSTATE _ (FUNCTION NILL) IMSCALE2 _ (FUNCTION NILL) IMDEFAULTSTATE _ (FUNCTION NILL) IMBLTCHAR _ (FUNCTION \\MEDW.BLTCHAR ) IMXOFFSET _ (FUNCTION \\MEDW.XOFFSET) IMYOFFSET _ (FUNCTION \\MEDW.YOFFSET)) (GLOBALVARS \\NOIMAGEOPS) (PUTPROP (QUOTE IMAGEIO) (QUOTE IMPORTDATE) (IDATE "28-Jun-1999 16:33:59")) (DATATYPE PROCESS ((PROCFX0 WORD) (* \; "= \\STACKHI to make this look like a STACKP") (PROCFX WORD) ( * \; "Stack pointer to this context when it is asleep") (PROCSTATUS BYTE) (* \; "Running or waiting") (PROCNAME POINTER) (* \; "Name for convenience in type-in reference") (PROCPRIORITY BYTE) (* \; "Priority level, 0-4. Not currently used.") (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) (PROCNEVERSTARTED FLAG) (NIL FLAG) (NIL FLAG) (NIL FLAG) ( 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") ( PROCDRIBBLEOUTPUT POINTER) (* \; "Binding for *DRIBBLE-OUTPUT* 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) (* \; "If DON'T, can't logout") (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") ( PROCHARDRESETINFO POINTER) (* \; "HARDRESET stores info about unwind-protect cleanups here") ( PROCRESTARTFORM POINTER) (* \; "use this instead of PROCFORM when restarting") (PROCOLDTTYPROC POINTER ) (* \; "Process that had the tty when we got it") (NIL POINTER) (* \; "For expansion")) PROCTIMERBOX _ (CREATECELL \\FIXP) PROCFX0 _ \\STACKHI) (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)))))))) (GLOBALVARS \\RUNNING.PROCESS \\TTY.PROCESS \\PROC.RESTARTME \\PROC.RESETME \\PROC.ABORTME) (PUTPROP (QUOTE PROC) (QUOTE IMPORTDATE) (IDATE "17-Jun-1999 21:58:52")) (PUTPROPS \\BACKCHAR MACRO (OPENLAMBDA (STREAM) (* \; "Backs up over an NS character") (\\BACKNSCHAR STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256)))) (PUTPROPS \\BACKNSCHAR MACRO ((ST SHIFTEDCHARSET COUNTERVAR) (COND ((\\XCCSP ST) (\\BACKXCCSCHAR ST SHIFTEDCHARSET COUNTERVAR)) (T (COND ((QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR ( CL:FUNCALL (|ffetch| (STREAM BACKCHARFN) |of| ST) ST T)))) (T (CL:FUNCALL (|ffetch| (STREAM BACKCHARFN ) |of| ST) ST NIL))))))) (PUTPROPS \\CHECKEOLC MACRO (OPENLAMBDA (CH EOLC STREAM PEEKBINFLG COUNTERVAR) (* |;;| "Subtracts number of bytes read from COUNTERVAR, which may be NIL. In fact, should be NIL if PEEKBINFLG is T." ) (SELCHARQ CH (CR (SELECTC EOLC (CR.EOLC (CHARCODE EOL)) (CRLF.EOLC (COND (PEEKBINFLG (* |;;| "T from PEEKC, compile-time constant. In this case, must leave the fileptr where it was, except for possibly advancing over character set shifts" ) (COND ((EQ (CHARCODE LF) (UNINTERRUPTABLY (\\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256)) (* |;;| "Read the NS CR. We know that there aren't any font-shift characters in front of the CR, because they would have already been read by the \\NSPEEK that got the CR character. Since we are going to NS back the CR character, we don't need to update the counter variable" ) (PROG1 (\\PEEKBIN STREAM T) (* |;;| "LF must be in next BYTE after NS CR, regardless of coding. Character-set shifting bytes can't intervene. Then we back up over the CR that was \\NSINed above." ) (\\BACKNSCHAR STREAM)))) (CHARCODE EOL)) (T (CHARCODE CR)))) ((EQ (CHARCODE LF) (\\PEEKBIN STREAM T) ) (\\BIN STREAM) (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (SUB1 COUNTERVAR))) (CHARCODE EOL)) (T ( CHARCODE CR)))) (CHARCODE CR))) (LF (COND ((EQ EOLC LF.EOLC) (CHARCODE EOL)) (T (CHARCODE LF)))) CH))) (PUTPROPS \\INCHAR MACRO (OPENLAMBDA (STREAM COUNTERVAR) (* \; "returns a 16 bit character code") ( \\CHECKEOLC (\\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256) NIL COUNTERVAR) (FFETCH EOLCONVENTION OF STREAM) STREAM NIL COUNTERVAR))) (PUTPROPS \\INCCODE MACRO (OPENLAMBDA (STREAM COUNTERVAR) (* \; "returns a 16 bit character code") ( \\CHECKEOLC (\\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256) NIL COUNTERVAR) (|ffetch| EOLCONVENTION |of| STREAM) STREAM NIL COUNTERVAR))) (PUTPROPS \\PEEKCCODE MACRO (OPENLAMBDA (STREAM NOERROR) (\\CHECKEOLC (\\NSPEEK STREAM (UNFOLD ( ACCESS-CHARSET STREAM) 256) NIL NOERROR) (|ffetch| EOLCONVENTION |of| STREAM) STREAM T))) (PUTPROPS \\NSIN MACRO ((ST SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR) (* |;;;| "Dispatches to the appropriate character code decoder. If you want to support a new character encoding format, you have to write a decoder and add it here." ) (COND ((\\XCCSP ST) (\\XCCSIN ST SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR)) (T (COND ((QUOTE COUNTERVAR ) (CL:MULTIPLE-VALUE-BIND (CODE NUM) (CL:FUNCALL (|ffetch| (STREAM INCCODEFN) |of| ST) ST T) (AND NUM (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR NUM))) CODE)) (T (CL:FUNCALL (|ffetch| (STREAM INCCODEFN) |of| ST) ST NIL))))))) (PUTPROPS \\NSPEEK MACRO ((ST SHIFTEDCSET SHIFTEDCSETVAR NOERROR COUNTERVAR) (* |;;;| "Dispatches to the appropriate character code decoder. If you want to support a new character encoding format, you have to write a decoder and add it here." ) (COND ((\\XCCSP ST) (\\XCCSPEEK ST (UNFOLD (ACCESS-CHARSET ST) 256) NIL NOERROR)) (T (COND ((QUOTE COUNTERVAR) (CL:MULTIPLE-VALUE-BIND (CODE NUM) (CL:FUNCALL (|ffetch| (STREAM PEEKCCODEFN) |of| ST) ST NOERROR T) (AND NUM (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR NUM))) CODE)) (T (CL:FUNCALL (|ffetch| ( STREAM PEEKCCODEFN) |of| ST) ST NOERROR NIL))))))) (PUTPROPS NUMERIC-CHARSET MACRO (= . ACCESS-CHARSET)) (PUTPROPS \\CONV.JIS.TO.XCCS MACRO (OPENLAMBDA (KU TEN) (* |;;;| "Some character code is not equivalent between JIS and XCCS. In such case, we have to convert the character to corresponding XCCS." ) (COND ((\\NOT.EQUIVALENT.TO.XCCS KU) (\\DO.CONV.JIS.TO.XCCS KU TEN)) (T (LOGOR (UNFOLD KU 256) TEN)) ))) (PUTPROPS \\DO.CONV.JIS.TO.XCCS MACRO ((KU TEN) (* |;;;| " Convert a JIS code divided into KU (high 8 bit) and TEN (low 8 bit) to an corresponding XCCS code.") (COND ((\\INVALID.TENP TEN) *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (SELECTQ KU ((33 34 38) (* \; "1, 2 and 6 KU") (LET* ((CONVTABLE (\\EXTARACT.CONV.TABLE KU)) (SET (\\EXTRACT.SET TEN CONVTABLE)) ( CODE (\\EXTRACT.CODE TEN CONVTABLE))) (COND ((NEQ SET 255) (LOGOR (UNFOLD SET 256) CODE)) (T (COND (( EQ CODE 255) (* \; "Not defined in JIS.") *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (* \; "Defined in JIS but the displayable font is not assigned in the corresponding code in XCCS.") (COND ( *REPLACE-NO-FONT-CODE* *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (\\EXTRACT.NO.FONT.CODE (LOGOR (UNFOLD KU 256) TEN)))))))))) (35 (* \; "3 KU") (* \; "Alpha numeric codes are all defined as single byte codes in XCCS.") TEN) (40 (* \; "8 KU") (COND ((< 0 TEN 33) (COND (*REPLACE-NO-FONT-CODE* *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (\\EXTRACT.NO.FONT.CODE ( LOGOR KU TEN))))) (T *DEFAULT-NOT-CONVERTED-FAT-CODE*))) (116 (* \; "84 KU") (COND ((< 0 TEN 5) (LOGOR 29952 TEN)) (T *DEFAULT-NOT-CONVERTED-FAT-CODE*))) (117 (* \; "85 KU") (COND ((< 0 TEN 28) (LOGOR 29696 TEN)) (T *DEFAULT-NOT-CONVERTED-FAT-CODE*))) *DEFAULT-NOT-CONVERTED-FAT-CODE*))))) (PUTPROPS \\CONV.XCCS.TO.JIS MACRO (OPENLAMBDA (OUTSTREAM CC) (* |;;;| "Returns JIS code corresponding to XCCS charcode. Handle HANKAKU as well as ZENKAKU. If OUTSTREAM wants to convert ZENKAKUKANA to HANKAKUKANA, do so. Never returns two byte charcode for alpha-numeric character, they are all treated as single byte characode." ) (OR (COND ((\\ASCIIP CC) CC) ((\\NOT.EQUIVALENT.TO.JIS CC) (\\DO.CONV.XCCS.TO.JIS CC)) (( \\CONV.HANKAKU.TO.ZENKAKUP OUTSTREAM) (* \; "ZENKAKUKANA comes here, because their charcodes are equiavalent to JIS.") (\\CONV.ZENKAKU.KANA CC)) ( T CC)) CC))) (PUTPROPS \\DO.CONV.XCCS.TO.JIS MACRO ((CC) (GETHASH CC *XCCS-TO-JIS-CONV-TABLE*))) (PUTPROPS \\ASCIIP MACRO (OPENLAMBDA (CC) (AND (EQ (FOLDLO CC 256) 0) (< (LOGAND CC 255) 128)))) (PUTPROPS \\NOT.EQUIVALENT.TO.JIS MACRO (OPENLAMBDA (CC) (OR (EQ (FOLDLO CC 256) 0) (EQ (FOLDLO CC 256 ) 33) (EQ (FOLDLO CC 256) 34) (EQ (FOLDLO CC 256) 38) (EQ (FOLDLO CC 256) 40) (EQ (FOLDLO CC 256) 239) (EQ (FOLDLO CC 256) 241)))) (PUTPROPS \\CONV.HANKAKU.TO.ZENKAKUP MACRO ((OUTSTREAM) (STREAMPROP OUTSTREAM :HTOZP))) (PUTPROPS \\CONV.ZENKAKU.KANA MACRO ((CHAR) (GETHASH CHAR *ZENKAKU-TO-HANKAKU-CONV-TABLE*))) (PUTPROPS \\XCCSIN MACRO ((STREAM SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR) (* |;;;| "returns a 16 bit character code. SHIFTEDCSET is STREAM's char set left shifted 8, SHIFTEDCSETVAR if non-NIL is the variable to set if char set changes. COUNTERVAR if non-NIL is decremented by number of bytes read. Doesn't do EOL conversion -- \\INCHAR and \\INCCODE do that." ) (LET ((CHAR (\\BIN STREAM)) SCSET) (COND ((EQ CHAR NSCHARSETSHIFT) (* \; "Shifting character sets") (ACCESS-CHARSET STREAM (SETQ SCSET (COND ((NEQ NSCHARSETSHIFT (SETQ CHAR (\\BIN STREAM))) (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2))) CHAR) ((PROGN (* \; "2 shift-bytes means not run-encoded") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 3))) (EQ 0 (\\BIN STREAM))) \\NORUNCODE) (T (\\NSIN.24BITENCODING.ERROR STREAM))))) (SETQ CHAR (\\BIN STREAM)) (SETQ SCSET (COND ((QUOTE SHIFTEDCSETVAR) (* \; "CHARSETVAR=NIL means don't set") (SETQ SHIFTEDCSETVAR (UNFOLD SCSET 256))) (T (UNFOLD SCSET 256))))) (T (SETQ SCSET SHIFTEDCSET))) ( COND ((EQ SCSET (UNFOLD \\NORUNCODE 256)) (* \; "just read two bytes and combine them to a 16 bit value") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR ( IDIFFERENCE COUNTERVAR 2))) (LOGOR (UNFOLD CHAR 256) (\\BIN STREAM))) (CHAR (AND (QUOTE COUNTERVAR) ( SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 1))) (AND CHAR (LOGOR SCSET CHAR))))))) (PUTPROPS \\XCCSPEEK MACRO ((STREAM SHIFTEDCSET SHIFTEDCSETVAR NOERROR COUNTERVAR) (* |;;| "Returns a 16 bit character code. Doesn't do EOL conversion--\\INCHAR does that. May actually read the character-set shift, storing the result in the stream. COUNTERVAR, if given, is updated to reflect any such bytes that are actually read" ) (PROG ((CHAR (\\PEEKBIN STREAM NOERROR)) SCSET) (COND ((NULL CHAR) (RETURN NIL)) ((EQ CHAR NSCHARSETSHIFT) (* \; "CHARSETVAR=NIL means don't set") (\\BIN STREAM) (* \; "Consume the char shift byte") (ACCESS-CHARSET STREAM (SETQ SCSET (COND ((NEQ NSCHARSETSHIFT (SETQ CHAR (\\BIN STREAM))) (* \; "Note: no eof error check on this \\BIN -- an eof in the middle of a charset shift is an error") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2))) CHAR) ((PROGN (* \; "2 shift-bytes means not run-encoded") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 3))) (EQ 0 (\\BIN STREAM))) \\NORUNCODE) (T (\\NSIN.24BITENCODING.ERROR STREAM))))) (SETQ SCSET (COND ((QUOTE SHIFTEDCSETVAR) (* \; "CHARSETVAR=NIL means don't set") (SETQ SHIFTEDCSETVAR ( UNFOLD SCSET 256))) (T (UNFOLD SCSET 256)))) (COND ((NULL (SETQ CHAR (\\PEEKBIN STREAM NOERROR))) ( RETURN NIL)))) (T (SETQ SCSET SHIFTEDCSET))) (RETURN (COND ((EQ SCSET (UNFOLD \\NORUNCODE 256)) (* |;;| "just peek two bytes and combine them to a 16 bit value. Again, is an error if we hit eof in mid-character" ) (\\BIN STREAM) (PROG1 (LOGOR (UNFOLD CHAR 256) (\\PEEKBIN STREAM NOERROR)) (\\BACKFILEPTR STREAM))) (T (LOGOR SHIFTEDCSET CHAR))))))) (PUTPROPS \\BACKXCCSCHAR MACRO ((STREAM SHIFTEDCHARSET COUNTERVAR) (AND (\\BACKFILEPTR STREAM) (COND ( (COND (SHIFTEDCHARSET (EQ SHIFTEDCHARSET (UNFOLD \\NORUNCODE 256))) (T (EQ \\NORUNCODE (ACCESS-CHARSET STREAM)))) (COND ((\\BACKFILEPTR STREAM) (AND (QUOTE COUNTERVAR) (|add| COUNTERVAR 2)) T) ((QUOTE COUNTERVAR) (|add| COUNTERVAR 1)))) ((QUOTE COUNTERVAR) (|add| COUNTERVAR 1)))))) (PUTPROPS \\XCCSP MACRO (OPENLAMBDA (ST) (NOT (|ffetch| (STREAM NOTXCCS) |of| (\\DTEST ST (QUOTE STREAM)))))) (PUTPROPS \\EXTRACT.NO.FONT.CODE MACRO ((JISCODE) (CDR (ASSOC JISCODE *JIS-TO-XCCS-CONV-NO-FONT-TABLE* )))) (PUTPROPS \\EXTARACT.CONV.TABLE MACRO ((KU) (CDR (ASSOC KU *JIS-TO-XCCS-CONV-TABLE-LIST*)))) (PUTPROPS \\NOT.EQUIVALENT.TO.XCCS MACRO ((KU) (* |;;;| " The JIS codes which are not equiavelent to XCCS reside in 1, 2, 3, 6, 8 and 84 KU. Although from 84-5 to 94-94 inclusive are not defined in JIS, that is they are GAIJI, they are also handled here." ) (OR (EQ KU 33) (EQ KU 34) (EQ KU 35) (EQ KU 38) (EQ KU 40) (EQ KU 116) (EQ KU 117)))) (PUTPROPS \\EXTRACT.SET MACRO ((TEN TABLE) (ELT TABLE (IDIFFERENCE (UNFOLD (IDIFFERENCE TEN 32) 2) 1)) )) (PUTPROPS \\EXTRACT.CODE MACRO ((TEN TABLE) (ELT TABLE (UNFOLD (IDIFFERENCE TEN 32) 2)))) (PUTPROPS \\CHNAGE.KI.MODE MACRO (OPENLAMBDA (ST INPUTFLG ENTERP) (* |;;;| "INPUTFLG is true if \\CHNAGE.KI.MODE is called in the context in which ST is an input stream.") (COND (INPUTFLG (COND (ENTERP (|freplace| (STREAM IN.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| T)) ( T (|freplace| (STREAM IN.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| NIL)))) (T (COND (ENTERP ( |freplace| (STREAM OUT.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| T)) (T (|freplace| (STREAM OUT.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| NIL))))))) (PUTPROPS \\KIMODEP MACRO (OPENLAMBDA (ST INPUTFLG) (* |;;;| "INPUTFLG is true if \\KIMODEP is called in the context in which ST is an input stream.") (COND ( INPUTFLG (|ffetch| (STREAM IN.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)))) (T (|ffetch| (STREAM OUT.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM))))))) (PUTPROPS \\HANKAKUP MACRO ((CHAR) (< 160 CHAR 224))) (PUTPROPS \\KANJIP MACRO ((CHAR) (< 12158 CHAR 29733))) (PUTPROPS \\NOTGAIJIP MACRO ((CHAR) (OR (< 8480 CHAR 10305) (< 12158 CHAR 29733)))) (PUTPROPS \\INVALID.TENP MACRO (OPENLAMBDA (TEN) (OR (< TEN 33) (< 126 TEN)))) (PUTPROPS \\CONV.HANKAKU.KANA MACRO ((CHAR) (GETHASH CHAR *HANKAKU-TO-ZENKAKU-CONV-TABLE*))) (PUTPROPS \\OUTKI MACRO ((STREAM) (\\BOUT OUTSTREAM (CHARCODE ESC)) (\\BOUT OUTSTREAM (CHARCODE $)) ( \\BOUT OUTSTREAM (CHARCODE B)))) (PUTPROPS \\OUTKO MACRO ((STREAM) (\\BOUT OUTSTREAM (CHARCODE ESC)) (\\BOUT OUTSTREAM (CHARCODE \()) ( \\BOUT OUTSTREAM (CHARCODE J)))) (PUTPROPS \\CONV.SJIS.TO.JIS MACRO (OPENLAMBDA (HI LO) (* |;;;| "Convert Shift-JIS to JIS. The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of JIS code respectively." ) (SETQ CH1 (IDIFFERENCE HI (COND ((> HI 159) 177) (T 113)))) (SETQ CH1 (IPLUS (UNFOLD CH1 2) 1)) ( SETQ CH2 (COND ((> LO 158) (PROG1 (IDIFFERENCE LO 126) (SETQ CH1 (IPLUS CH1 1)))) (T (IDIFFERENCE LO ( COND ((> LO 126) (IPLUS 31 1)) (T 31)))))))) (PUTPROPS \\CONV.JIS.TO.SJIS MACRO (OPENLAMBDA (HI LO) (* |;;;| "Convert JIS to Shift-JIS. The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of Shift-JIS code respectively." ) (SETQ CH2 (COND ((ODDP HI) (SETQ CH2 (IPLUS LO 31)) (COND ((>= CH2 127) (IPLUS CH2 1)) (T CH2))) (T (IPLUS LO 126)))) (SETQ CH1 (IPLUS (FOLDLO (IDIFFERENCE HI 33) 2) 129)) (AND (> CH1 159) (SETQ CH1 ( IPLUS CH1 64))))) (PUTPROPS \\SJIS.KANJI.FIRST.BYTEP MACRO (OPENLAMBDA (CHAR) (OR (< 127 CHAR 160) (< 223 CHAR 256)))) (PUTPROPS \\EUC.KANJI.FIRST.BYTEP MACRO ((CHAR) (< 160 CHAR 255))) (PUTPROPS \\GAIJIP MACRO ((CHAR) (EQ CHAR 143))) (PUTPROPS \\EUC.HANKAKUP MACRO ((CHAR) (EQ CHAR 142))) (PUTPROP (QUOTE LLREAD) (QUOTE IMPORTDATE) (IDATE " 4-Aug-1993 14:43:07")) (PUTPROPS EMPASSWORDLOC DMACRO (LAMBDA NIL (* |lmm| "24-MAR-83 06:46") (|fetch| (IFPAGE |UserPswdAddr| ) |of| |\\InterfacePage|))) (PUTPROPS \\DECRYPT.PWD.CHAR MACRO ((CHAR) (LOGXOR CHAR 73))) (PUTPROP (QUOTE PASSWORDS) (QUOTE IMPORTDATE) (IDATE "16-May-1990 21:02:21")) (RPAQQ MICASPERINCH 2540) (RPAQQ MICASPERMILLIMETER 100) (CONSTANTS (MICASPERINCH 2540) (MICASPERMILLIMETER 100)) (PUTPROP (QUOTE INTERPRESS) (QUOTE IMPORTDATE) (IDATE "16-Apr-2018 21:56:38")) (RPAQ MICASPERPT (FQUOTIENT 2540 72)) (RPAQQ IHALFMICASPERPT 17) (RPAQQ IMICASPERPT 35) (CONSTANTS (MICASPERPT (FQUOTIENT 2540 72)) (IHALFMICASPERPT 17) (IMICASPERPT 35)) (DEFMACRO \\MICASTOPTS (MICAS) (COND ((NUMBERP MICAS) (QUOTIENT MICAS MICASPERPT)) (T (BQUOTE ( QUOTIENT (\\\, MICAS) MICASPERPT))))) (PUTPROP (QUOTE HARDCOPY) (QUOTE IMPORTDATE) (IDATE "16-Apr-2018 22:15:08")) (FILESLOAD (SYSLOAD FROM VALUEOF DIRECTORIES) CMLARRAY-SUPPORT) (PUTPROP (QUOTE CMLARRAY) (QUOTE IMPORTDATE) (IDATE " 6-Jan-1993 12:21:21")) (RPAQQ \\MISCN-TABLE-LIST ((USER-SUBR 0 \\USER-SUBR-UFN T) (CL:VALUES 1 CL::VALUES-UFN NIL) (CL:SXHASH 2 CL::SXHASH-UFN NIL) (CL::EQLHASHBITSFN 3 CL::EQLHASHBITSFN-UFN NIL) (STRINGHASHBITS 4 \\STRINGHASHBITS-UFN NIL) (STRING-EQUAL-HASHBITS 5 \\STRING-EQUAL-HASHBITS-UFN NIL) (CL:VALUES-LIST 6 CL::VALUES-LIST-UFN NIL) (|LCFetchMethod| 7 |LCFetchMethod| NIL) (|LCFetchMethodOrHelp| 8 NIL NIL) ( |LCFindVarIndex| 9 NIL NIL) (|LCGetIVValue| 10 NIL NIL) (|LCPutIVValue| 11 NIL NIL))) (RPAQQ \\USER-SUBR-LIST ((DUMMY 10 DUMMY-UFN) (SAMPLE-USER-SUBR 0 SAMPLE-USER-SUBR-UFN))) (RPAQQ \\INITSUBRS ((BACKGROUNDSUBR 6) (CHECKBCPLPASSWORD 7) (DISKPARTITION 8) (DSPBOUT 9) (DSPRATE 10 ) (GATHERSTATS 11) (GETPACKETBUFFER 12) (LISPFINISH 13) (MOREVMEMFILE 14) (RAID 15) (READRAWPBI 16) ( WRITERAWPBI 17) (SETSCREENCOLOR 18) (SHOWDISPLAY 19) (PUPLEVEL1STATE 20) (WRITESTATS 21) ( CONTEXTSWITCH 22) (COPYSYS0SUBR 23) (WRITEMAP 24) (UFS-GETFILENAME 34) (UFS-DELETEFILE 35) ( UFS-RENAMEFILE 36) (COM-READPAGES 37) (COM-WRITEPAGES 38) (COM-TRUNCATEFILE 39) (UFS-DIRECTORYNAMEP 41 ) (COM-GETFREEBLOCK 45) (SETUNIXTIME 48) (GETUNIXTIME 49) (COPYTIMESTATS 50) (UNIX-USERNAME 51) ( UNIX-FULLNAME 52) (UNIX-GETENV 53) (UNIX-GETPARM 54) (CHECK-SUM 55) (ETHER-SUSPEND 56) (ETHER-RESUME 57) (ETHER-AVAILABLE 58) (ETHER-RESET 59) (ETHER-GET 60) (ETHER-SEND 61) (ETHER-SETFILTER 62) ( ETHER-CHECK 63) (DSPCURSOR 64) (SETMOUSEXY 65) (DSP-VIDEOCOLOR 66) (DSP-SCREENWIDTH 67) ( DSP-SCREENHEIGHT 68) (BITBLTSUB 69) (BLTCHAR 70) (TEDIT.BLTCHAR 71) (BITBLT.BITMAP 72) ( BLTSHADE.BITMAP 73) (RS232C-CMD 74) (RS232C-READ-INIT 75) (RS232C-WRITE 76) (KEYBOARDBEEP 80) ( KEYBOARDMAP 81) (KEYBOARDSTATE 82) (VMEMSAVE 89) (LISP-FINISH 90) (NEWPAGE 91) (DORECLAIM 92) ( DUMMY-135Q 93) (NATIVE-MEMORY-REFERENCE 94) (OLD-COMPILE-LOAD-NATIVE 95) (DISABLEGC 96) ( COM-SETFILEINFO 103) (COM-OPENFILE 104) (COM-CLOSEFILE 105) (DSK-GETFILENAME 106) (DSK-DELETEFILE 107) (DSK-RENAMEFILE 108) (COM-NEXT-FILE 110) (COM-FINISH-FINFO 111) (COM-GEN-FILES 112) ( DSK-DIRECTORYNAMEP 113) (COM-GETFILEINFO 114) (COM-CHANGEDIR 116) (UNIX-HANDLECOMM 117) (RPC-CALL 119) (MESSAGE-READP 120) (MESSAGE-READ 121) (MONITOR-CONTROL 128) (GET-NATIVE-ADDR-FROM-LISP-PTR 131) ( GET-LISP-PTR-FROM-NATIVE-ADDR 132) (LOAD-NATIVE-FILE 133) (SUSPEND-LISP 134) (NEW-BLTCHAR 135) ( COLOR-INIT 136) (COLOR-SCREENMODE 137) (COLOR-MAP 138) (COLOR-BASE 139) (|C-SlowBltChar| 140) ( UNCOLORIZE-BITMAP 141) (COLORIZE-BITMAP 142) (COLOR-8BPPDRAWLINE 143) (TCP-OP 144) (WITH-SYMBOL 145) ( CAUSE-INTERRUPT 146) (OPEN-SOCKET 160) (CLOSE-SOCKET 161) (READ-SOCKET 162) (WRITE-SOCKET 163) ( CALL-C-FUNCTION 167) (DLD-LINK 168) (DLD-UNLINK-BY-FILE 169) (DLD-UNLINK-BY-SYMBOL 170) ( DLD-GET-SYMBOL 171) (DLD-GET-FUNC 172) (DLD-FUNCTION-EXECUTABLE-P 173) (DLD-LIST-UNDEFINED-SYMBOLS 174 ) (C-MALLOC 175) (C-FREE 176) (C-PUTBASEBYTE 177) (C-GETBASEBYTE 178) (CHAR-OPENFILE 200) (CHAR-BIN 201) (CHAR-BOUT 202) (CHAR-IOCTL 203) (CHAR-CLOSEFILE 204) (CHAR-EOFP 205) (CHAR-READP 206) (CHAR-BINS 207) (CHAR-BOUTS 208) (CHAR-FILLBUFFER 209))) (PUTPROP (QUOTE LLSUBRS) (QUOTE IMPORTDATE) (IDATE "17-Dec-1992 14:28:41")) STOP \ No newline at end of file