(FILECREATED "14-Oct-86 14:39:21" ("compiled on " {ERIS}SOURCES>CMLARRAY-SUPPORT.;3) " 1-Oct-86 20:23:15" "COMPILE-FILEd" in "Xerox Lisp 1-Oct-86 ..." dated " 1-Oct-86 21:24:44") (FILECREATED "14-Oct-86 14:38:33" {ERIS}SOURCES>CMLARRAY-SUPPORT.;3 29598 changes to: (VARS CMLARRAY-SUPPORTCOMS) previous date: "21-Sep-86 19:42:35" {ERIS}SOURCES>CMLARRAY-SUPPORT.;2) (RPAQQ CMLARRAY-SUPPORTCOMS ((* * "Cmlarray support macros and functions") (FUNCTIONS %%CHECK-CIRCLE-PRINT %%CHECK-INDICES %%CHECK-NOT-WRITEABLE %%EXPAND-BIT-OP %%GENERAL-ARRAY-ADJUST-BASE %%GET-ARRAY-OFFSET %%GET-BASE-ARRAY) (FUNCTIONS %%BIT-TYPE-P %%CHAR-TYPE-P %%CML-TYPE-TO-TYPENUMBER-EXPANDER %%FAT-CHAR-TYPE-P %%FAT-STRING-CHAR-P %%GET-TYPE-TABLE-ENTRY %%LIT-SIZE-TO-SIZE %%LIT-TYPE-TO-TYPE %%LLARRAY-MAKE-ACCESSOR-EXPR %%LLARRAY-MAKE-SETTOR-EXPR %%LLARRAY-TYPED-GET %%LLARRAY-TYPED-PUT %%LLARRAY-TYPEP %%MAKE-ARRAY-TYPE-TABLE %%MAKE-CML-TYPE-TABLE %%PACK-TYPENUMBER %%SMALLFIXP-SMALLPOSP %%SMALLPOSP-SMALLFIXP %%THIN-CHAR-TYPE-P %%THIN-STRING-CHAR-P %%TYPE-SIZE-TO-TYPENUMBER %%TYPENUMBER-TO-BITS-PER-ELEMENT %%TYPENUMBER-TO-CML-TYPE %%TYPENUMBER-TO-DEFAULT-VALUE %%TYPENUMBER-TO-GC-TYPE %%TYPENUMBER-TO-SIZE %%TYPENUMBER-TO-TYPE \GETBASESMALL-FIXP \GETBASESTRING-CHAR \GETBASETHINSTRING-CHAR \PUTBASESMALL-FIXP \PUTBASESTRING-CHAR \PUTBASETHINSTRING-CHAR) (* * "Describes each entry of \ARRAY-TYPE-TABLE") (STRUCTURES ARRAY-TABLE-ENTRY) (* * "These vars contain all the necessary info for typed arrays") (VARIABLES %%LIT-ARRAY-SIZES %%LIT-ARRAY-TABLE %%LIT-ARRAY-TYPES) (* * "Tables that drives various macros") ( VARIABLES %%ARRAY-TYPE-TABLE %%CANONICAL-CML-TYPES) (* * "Constants for (SIGNED-BYTE 16)") (VARIABLES MAX.SMALLFIXP MIN.SMALLFIXP) (* * "Constants for STRING-CHARS") (VARIABLES %%CHAR-TYPE %%BIT-TYPE %%THIN-CHAR-TYPENUMBER %%FAT-CHAR-TYPENUMBER %%MAXTHINCHAR) (* * "Array data-type numbers") (VARIABLES %%GENERAL-ARRAY %%ONED-ARRAY %%TWOD-ARRAY) (* * "Compiler options") (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T)) (PROP FILETYPE CMLARRAY-SUPPORT))) expand-%%CHECK-CIRCLE-PRINT D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) ‡@AH¹HZ»J¼gogggogIhhhgggKoggKhgggKogoKhhhgoLhNIL (167Q CL:WHEN 140Q WRITE-CHAR 126Q .SPACECHECK. 123Q FIRSTTIME 120Q CL:WHEN 110Q CIRCLELABEL 105Q WRITE-STRING 73Q .SPACECHECK. 70Q CIRCLELABEL 65Q CL:WHEN 46Q PRINT-CIRCLE-LOOKUP 37Q MULTIPLE-VALUE-SETQ 34Q *PRINT-CIRCLE-HASHTABLE* 31Q AND 22Q LET) ( 173Q (OR (NOT CIRCLELABEL) FIRSTTIME) 144Q |\Space 133Q (1) 100Q ((VECTOR-LENGTH CIRCLELABEL)) 43Q (CIRCLELABEL FIRSTTIME) 26Q (CIRCLELABEL FIRSTTIME)) (SETF-MACRO-FUNCTION (QUOTE %%CHECK-CIRCLE-PRINT) (QUOTE expand-%%CHECK-CIRCLE-PRINT)) (LET* ((A0571 (QUOTE %%CHECK-CIRCLE-PRINT)) (A0572 (QUOTE CL:FUNCTION)) (A0573 "If A has a circle label, print it. If it's not the first time or it has no label, print the contents" )) (PROGN (COND ((FBOUNDP (QUOTE SET-DOCUMENTATION)) (SET-DOCUMENTATION A0571 A0572 A0573))) A0573)) expand-%%CHECK-INDICES D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) w@AH¹HZ»J¼ggKooggLhogggLohggogggIohhohNIL (131Q ARRAY-DIMENSION 126Q INDEX 123Q >= 114Q OR 111Q CL:IF 73Q ARG 70Q INDEX 65Q SETQ 50Q I 45Q > 26Q I 23Q CL:DO) ( 154Q ((RETURN NIL)) 136Q (DIM) 120Q (< INDEX 0) 100Q (I) 61Q (T) 41Q ((DIM 0 (1+ DIM)) INDEX) 33Q ((1+ I))) (SETF-MACRO-FUNCTION (QUOTE %%CHECK-INDICES) (QUOTE expand-%%CHECK-INDICES)) expand-%%CHECK-NOT-WRITEABLE D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) S@AH¹HZ»J¼ggogIhgIhhggKhgLhhgIhhhNIL (105Q %%MAKE-STRING-ARRAY-FAT 72Q %%FAT-STRING-CHAR-P 63Q %%THIN-CHAR-TYPE-P 60Q AND 46Q %%MAKE-ARRAY-WRITEABLE 35Q of 26Q fetch 23Q COND) ( 32Q (ARRAY-HEADER READ-ONLY-P)) (SETF-MACRO-FUNCTION (QUOTE %%CHECK-NOT-WRITEABLE) (QUOTE expand-%%CHECK-NOT-WRITEABLE)) expand-%%EXPAND-BIT-OP D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) S @H¹HZ»J\½L¾ggggKhhogggMhhogggKMhhoggNhgNggKhohhgNogNKhhgggNhgKNhhhohI_gð³#Ogð³Ogð³Ogð©Odgð²#¿ggKNhgoKNhh°Agð³ Ogð³Ogð®Ogð§Ogð´goKNh‹gOo I_dgð²¿goMNh±ægð²goMNh±ÏOdgð²¿goMNh±´gð²goMNh±Odgð²¿goMNh±‚gðŸgoMNh°lOdgð²¿goMNh°RgðŸgoMNh°=Odgð²¿goMNh°#gð´goMNh‹gOo Nh(1106Q ECASE-FAIL 507Q ECASE-FAIL) (1075Q OP 1056Q %%DO-LOGICAL-OP 1050Q ORC2 1030Q %%DO-LOGICAL-OP 1021Q ORC1 776Q %%DO-LOGICAL-OP 771Q ANDC2 751Q %%DO-LOGICAL-OP 742Q ANDC1 717Q %%DO-LOGICAL-OP 712Q NOR 671Q %%DO-LOGICAL-OP 662Q NAND 636Q %%DO-LOGICAL-OP 630Q EQV 607Q %%DO-LOGICAL-OP 600Q XOR 554Q %%DO-LOGICAL-OP 546Q IOR 525Q %%DO-LOGICAL-OP 516Q AND 476Q OP 457Q %%DO-LOGICAL-OP 451Q ORC1 442Q ANDC1 433Q NOR 423Q NAND 413Q EQV 367Q %%DO-LOGICAL-OP 356Q EQ 353Q OR 344Q ORC2 334Q ANDC2 324Q XOR 314Q IOR 304Q AND 247Q EQUAL-DIMENSIONS-P 240Q BIT-ARRAY-P 235Q AND 232Q NOT 216Q SETQ 204Q EQ 160Q ARRAY-DIMENSIONS 155Q MAKE-ARRAY 151Q SETQ 142Q NULL 137Q COND 115Q EQUAL-DIMENSIONS-P 112Q NOT 107Q CL:IF 67Q BIT-ARRAY-P 64Q NOT 61Q CL:IF 41Q BIT-ARRAY-P 36Q NOT 33Q CL:IF 30Q PROGN) ( 1103Q (AND IOR XOR EQV NAND NOR ANDC1 ANDC2 ORC1 ORC2) 1062Q (QUOTE COR) 1034Q (QUOTE OR) 1002Q (QUOTE CAND) 755Q (QUOTE AND) 723Q (QUOTE CAND) 675Q (QUOTE COR) 642Q (QUOTE XOR) 613Q (QUOTE XOR) 560Q (QUOTE OR) 531Q (QUOTE AND) 504Q (AND IOR XOR ANDC2 ORC2 EQV NAND NOR ANDC1 ORC1) 463Q (QUOTE NOT) 373Q (QUOTE COPY) 270Q ((CL:ERROR "Illegal result array")) 211Q (T) 170Q (:ELEMENT-TYPE (QUOTE BIT)) 132Q ((CL:ERROR "Bit-arrays not of same dimensions")) 102Q ((CL:ERROR "BIT-ARRAY2 not a bit array")) 54Q ((CL:ERROR "BIT-ARRAY1 not a bit array"))) (SETF-MACRO-FUNCTION (QUOTE %%EXPAND-BIT-OP) (QUOTE expand-%%EXPAND-BIT-OP)) expand-%%GENERAL-ARRAY-ADJUST-BASE D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) }@!H¹HºggogIhgogIgIohgJgJohgggJgogIhhhohhNIL (135Q of 126Q fetch 122Q < 117Q NOT 114Q CL:IF 76Q + 72Q SETQ 54Q %%GET-BASE-ARRAY 50Q SETQ 41Q LET 30Q of 21Q ffetch 16Q CL:IF) ( 156Q ((CL:ERROR "Row-major-index out of bounds (displaced to adjustable?)")) 132Q (ARRAY-HEADER TOTAL-SIZE) 103Q (%%OFFSET) 61Q (%%OFFSET) 45Q ((%%OFFSET 0)) 25Q (GENERAL-ARRAY INDIRECT-P)) (SETF-MACRO-FUNCTION (QUOTE %%GENERAL-ARRAY-ADJUST-BASE) (QUOTE expand-%%GENERAL-ARRAY-ADJUST-BASE)) expand-%%GET-ARRAY-OFFSET D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) C@gggHhgHhhgogHhhgHhohNIL (63Q %%TWOD-ARRAY-P 47Q of 40Q fetch 25Q %%GENERAL-ARRAY-P 16Q %%ONED-ARRAY-P 13Q OR 10Q COND) ( 73Q (0) 44Q (ARRAY-HEADER OFFSET)) (SETF-MACRO-FUNCTION (QUOTE %%GET-ARRAY-OFFSET) (QUOTE expand-%%GET-ARRAY-OFFSET)) expand-%%GET-BASE-ARRAY D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) 8@!H¹HºggIohogJgJohhNIL (45Q + 41Q SETQ 21Q %%BASE-ARRAY 16Q CL:DO) ( 52Q ((%%GET-ARRAY-OFFSET %%BASE-ARRAY)) 36Q ((NOT (fetch (ARRAY-HEADER INDIRECT-P) of %%BASE-ARRAY)) %%BASE-ARRAY) 26Q ((fetch (ARRAY-HEADER BASE) of %%BASE-ARRAY))) (SETF-MACRO-FUNCTION (QUOTE %%GET-BASE-ARRAY) (QUOTE expand-%%GET-BASE-ARRAY)) expand-%%BIT-TYPE-P D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) @gHoNIL (10Q EQ) ( 15Q (%%BIT-TYPE)) (SETF-MACRO-FUNCTION (QUOTE %%BIT-TYPE-P) (QUOTE expand-%%BIT-TYPE-P)) expand-%%CHAR-TYPE-P D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) @ggHhoNIL (13Q %%TYPENUMBER-TO-TYPE 10Q EQ) ( 23Q (%%CHAR-TYPE)) (SETF-MACRO-FUNCTION (QUOTE %%CHAR-TYPE-P) (QUOTE expand-%%CHAR-TYPE-P)) expand-%%CML-TYPE-TO-TYPENUMBER-EXPANDERA0001 D1 (L (0 ENTRY)) @‘h€i´@hNIL NIL () expand-%%CML-TYPE-TO-TYPENUMBER-EXPANDERA0002 D1 (L (0 ENTRY)) @´@hNIL NIL () expand-%%CML-TYPE-TO-TYPENUMBER-EXPANDERA0003A0004 D1 (L (0 ENTRY) F 0 TYPE) @´@Pð´@@hhNIL NIL () expand-%%CML-TYPE-TO-TYPENUMBER-EXPANDERA0003 D1 (I 0 TYPE F 0 CML-TYPE F 1 %%CANONICAL-CML-TYPES) @ggPhgQ h(21Q MAPCAN) (15Q expand-%%CML-TYPE-TO-TYPENUMBER-EXPANDERA0003A0004 6 CADR 3 ECASE) () expand-%%CML-TYPE-TO-TYPENUMBER-EXPANDERA0005 D1 (L (0 TYPE) F 0 %%CANONICAL-CML-TYPES) @P (4 CL:ASSOC) NIL () expand-%%CML-TYPE-TO-TYPENUMBER-EXPANDER D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM) P 0 CML-TYPE F 3 %%CANONICAL-CML-TYPES) g@!igS gS º¹ggHoiS ggHhggHhgJ gHgI hh(130Q CL:MAPCAR 113Q CL:MAPCAR 56Q CL:ASSOC 32Q REMOVE-DUPLICATES 27Q MAPCAN 20Q REMOVE 15Q MAPCAN) (124Q expand-%%CML-TYPE-TO-TYPENUMBER-EXPANDERA0005 120Q ECASE 107Q expand-%%CML-TYPE-TO-TYPENUMBER-EXPANDERA0003 100Q CAR 75Q ECASE 66Q LISTP 63Q CL:IF 42Q EQ 37Q CL:IF 23Q expand-%%CML-TYPE-TO-TYPENUMBER-EXPANDERA0002 11Q expand-%%CML-TYPE-TO-TYPENUMBER-EXPANDERA0001) ( 47Q (T)) (SETF-MACRO-FUNCTION (QUOTE %%CML-TYPE-TO-TYPENUMBER-EXPANDER) (QUOTE expand-%%CML-TYPE-TO-TYPENUMBER-EXPANDER)) expand-%%FAT-CHAR-TYPE-P D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) @gHoNIL (10Q EQ) ( 15Q (%%FAT-CHAR-TYPENUMBER)) (SETF-MACRO-FUNCTION (QUOTE %%FAT-CHAR-TYPE-P) (QUOTE expand-%%FAT-CHAR-TYPE-P)) expand-%%FAT-STRING-CHAR-P D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) @ggHhoNIL (13Q CHAR-CODE 10Q >) ( 23Q (%%MAXTHINCHAR)) (SETF-MACRO-FUNCTION (QUOTE %%FAT-STRING-CHAR-P) (QUOTE expand-%%FAT-STRING-CHAR-P)) %%GET-TYPE-TABLE-ENTRY D1 (L (0 TYPENUMBER) F 0 %%ARRAY-TYPE-TABLE) @P (4 CL:ASSOC) NIL () %%LIT-SIZE-TO-SIZE D1 (L (0 LIT-SIZE) F 0 %%LIT-ARRAY-SIZES) @P (4 CL:ASSOC) NIL () %%LIT-TYPE-TO-TYPE D1 (L (0 LIT-TYPE) F 0 %%LIT-ARRAY-TYPES) @P (4 CL:ASSOC) NIL () %%LLARRAY-MAKE-ACCESSOR-EXPR D1 (L (2 OFFSET 1 BASE 0 TYPENUMBER)) +@ !H ¹H ¿H ºIAJ™gBJh€Bh(24Q ARRAY-TABLE-ENTRY-NEEDS-SHIFT-P 17Q ARRAY-TABLE-ENTRY-BITS-PER-ELEMENT 12Q ARRAY-TABLE-ENTRY-ACCESSOR 3 %%GET-TYPE-TABLE-ENTRY) (34Q LLSH) () %%LLARRAY-MAKE-SETTOR-EXPR D1 (L (3 NEWVALUE 2 OFFSET 1 BASE 0 TYPENUMBER)) -@ !H ¹H ¿H ºIAJ™gBJh€BCh(24Q ARRAY-TABLE-ENTRY-NEEDS-SHIFT-P 17Q ARRAY-TABLE-ENTRY-BITS-PER-ELEMENT 12Q ARRAY-TABLE-ENTRY-SETTOR 3 %%GET-TYPE-TABLE-ENTRY) (34Q LLSH) () expand-%%LLARRAY-TYPED-GETA0001 D1 (L (0 TYPEENTRY) F 0 BASE F 1 OFFSET) @@PQ h(10Q %%LLARRAY-MAKE-ACCESSOR-EXPR) NIL () expand-%%LLARRAY-TYPED-GET D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM) P 4 OFFSET P 1 BASE F 5 %%ARRAY-TYPE-TABLE) @AH¹HZ»J¼gKgU (33Q CL:MAPCAR) (27Q expand-%%LLARRAY-TYPED-GETA0001 23Q ECASE) () (SETF-MACRO-FUNCTION (QUOTE %%LLARRAY-TYPED-GET) (QUOTE expand-%%LLARRAY-TYPED-GET)) expand-%%LLARRAY-TYPED-PUTA0001 D1 (L (0 TYPEENTRY) F 0 BASE F 1 OFFSET F 2 NEWVALUE) @@PQR h(11Q %%LLARRAY-MAKE-SETTOR-EXPR) NIL () expand-%%LLARRAY-TYPED-PUT D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM) P 6 NEWVALUE P 5 OFFSET P 1 BASE F 7 %%ARRAY-TYPE-TABLE) &@aH¹HZ»J\½L¾gKgW (41Q CL:MAPCAR) (34Q expand-%%LLARRAY-TYPED-PUTA0001 30Q ECASE) () (SETF-MACRO-FUNCTION (QUOTE %%LLARRAY-TYPED-PUT) (QUOTE expand-%%LLARRAY-TYPED-PUT)) expand-%%LLARRAY-TYPEPA0001 D1 (L (0 TYPEENTRY) F 0 VALUE) @@ Phh(7 ARRAY-TABLE-ENTRY-TYPE-TEST) NIL () expand-%%LLARRAY-TYPEP D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM) P 2 VALUE F 3 %%ARRAY-TYPE-TABLE) @!H¹HºgIgS (26Q CL:MAPCAR) (22Q expand-%%LLARRAY-TYPEPA0001 16Q ECASE) () (SETF-MACRO-FUNCTION (QUOTE %%LLARRAY-TYPEP) (QUOTE expand-%%LLARRAY-TYPEP)) %%MAKE-ARRAY-TYPE-TABLEA0001A0002 D1 (L (0 SIZE-ENTRY) F 0 LIT-TYPE) P@ @h(5 %%TYPE-SIZE-TO-TYPENUMBER) NIL () %%MAKE-ARRAY-TYPE-TABLEA0001 D1 (L (0 TYPE-ENTRY) P 0 LIT-TYPE) @g@ (15Q CL:MAPCAR) (7 %%MAKE-ARRAY-TYPE-TABLEA0001A0002) () %%MAKE-ARRAY-TYPE-TABLE D1 (L (2 SIZES 1 TYPES 0 LIT-TABLE)) g@ (6 MAPCAN) (2 %%MAKE-ARRAY-TYPE-TABLEA0001) () %%MAKE-CML-TYPE-TABLEA0001 D1 (L (0 TYPE-ENTRY)) @ @h(5 ARRAY-TABLE-ENTRY-CML-TYPE) NIL () %%MAKE-CML-TYPE-TABLE D1 (L (0 ARRAY-TABLE)) g@ (6 CL:MAPCAR) (2 %%MAKE-CML-TYPE-TABLEA0001) () expand-%%PACK-TYPENUMBER D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) @!H¹HºggIoJhNIL (21Q LLSH 16Q \ADDBASE) ( 26Q (4)) (SETF-MACRO-FUNCTION (QUOTE %%PACK-TYPENUMBER) (QUOTE expand-%%PACK-TYPENUMBER)) expand-%%SMALLFIXP-SMALLPOSP D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) @gHhNIL (10Q \LOLOC) () (SETF-MACRO-FUNCTION (QUOTE %%SMALLFIXP-SMALLPOSP) (QUOTE expand-%%SMALLFIXP-SMALLPOSP)) expand-%%SMALLPOSP-SMALLFIXP D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) 8@¹gIHhhggIoggIhIhh(10Q GENSYM) (46Q \SmallNegHi 43Q \VAG2 31Q > 26Q CL:IF 14Q LET) ( 36Q (MAX.SMALLFIXP)) (SETF-MACRO-FUNCTION (QUOTE %%SMALLPOSP-SMALLFIXP) (QUOTE expand-%%SMALLPOSP-SMALLFIXP)) expand-%%THIN-CHAR-TYPE-P D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) @gHoNIL (10Q EQ) ( 15Q (%%THIN-CHAR-TYPENUMBER)) (SETF-MACRO-FUNCTION (QUOTE %%THIN-CHAR-TYPE-P) (QUOTE expand-%%THIN-CHAR-TYPE-P)) expand-%%THIN-STRING-CHAR-P D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) @ggHhoNIL (13Q CHAR-CODE 10Q <=) ( 23Q (%%MAXTHINCHAR)) (SETF-MACRO-FUNCTION (QUOTE %%THIN-STRING-CHAR-P) (QUOTE expand-%%THIN-STRING-CHAR-P)) %%TYPE-SIZE-TO-TYPENUMBER D1 (L (1 LIT-SIZE 0 LIT-TYPE) F 2 %%LIT-ARRAY-TYPES F 3 %%LIT-ARRAY-SIZES) @R AS HààààIÐ(13Q CL:ASSOC 4 CL:ASSOC) NIL () expand-%%TYPENUMBER-TO-BITS-PER-ELEMENTA0001 D1 (L (0 TYPEENTRY)) @@ h(7 ARRAY-TABLE-ENTRY-BITS-PER-ELEMENT) NIL () expand-%%TYPENUMBER-TO-BITS-PER-ELEMENT D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM) F 1 %%ARRAY-TYPE-TABLE) @gHgQ (20Q CL:MAPCAR) (14Q expand-%%TYPENUMBER-TO-BITS-PER-ELEMENTA0001 10Q ECASE) () (SETF-MACRO-FUNCTION (QUOTE %%TYPENUMBER-TO-BITS-PER-ELEMENT) (QUOTE expand-%%TYPENUMBER-TO-BITS-PER-ELEMENT)) expand-%%TYPENUMBER-TO-CML-TYPEA0001 D1 (L (0 TYPEENTRY)) @g@ hh(12Q ARRAY-TABLE-ENTRY-CML-TYPE) (4 QUOTE) () expand-%%TYPENUMBER-TO-CML-TYPE D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM) F 1 %%ARRAY-TYPE-TABLE) @gHgQ (20Q CL:MAPCAR) (14Q expand-%%TYPENUMBER-TO-CML-TYPEA0001 10Q ECASE) () (SETF-MACRO-FUNCTION (QUOTE %%TYPENUMBER-TO-CML-TYPE) (QUOTE expand-%%TYPENUMBER-TO-CML-TYPE)) expand-%%TYPENUMBER-TO-DEFAULT-VALUEA0001 D1 (L (0 TYPEENTRY)) @@ h(7 ARRAY-TABLE-ENTRY-DEFAULT-VALUE) NIL () expand-%%TYPENUMBER-TO-DEFAULT-VALUE D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM) F 1 %%ARRAY-TYPE-TABLE) @gHgQ (20Q CL:MAPCAR) (14Q expand-%%TYPENUMBER-TO-DEFAULT-VALUEA0001 10Q ECASE) () (SETF-MACRO-FUNCTION (QUOTE %%TYPENUMBER-TO-DEFAULT-VALUE) (QUOTE expand-%%TYPENUMBER-TO-DEFAULT-VALUE )) expand-%%TYPENUMBER-TO-GC-TYPEA0001 D1 (L (0 TYPEENTRY)) @@ h(7 ARRAY-TABLE-ENTRY-GC-TYPE) NIL () expand-%%TYPENUMBER-TO-GC-TYPE D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM) F 1 %%ARRAY-TYPE-TABLE) @gHgQ (20Q CL:MAPCAR) (14Q expand-%%TYPENUMBER-TO-GC-TYPEA0001 10Q ECASE) () (SETF-MACRO-FUNCTION (QUOTE %%TYPENUMBER-TO-GC-TYPE) (QUOTE expand-%%TYPENUMBER-TO-GC-TYPE)) expand-%%TYPENUMBER-TO-SIZE D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) @gHoNIL (10Q LOGAND) ( 15Q (17Q)) (SETF-MACRO-FUNCTION (QUOTE %%TYPENUMBER-TO-SIZE) (QUOTE expand-%%TYPENUMBER-TO-SIZE)) expand-%%TYPENUMBER-TO-TYPE D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) @gHoNIL (10Q LRSH) ( 15Q (4)) (SETF-MACRO-FUNCTION (QUOTE %%TYPENUMBER-TO-TYPE) (QUOTE expand-%%TYPENUMBER-TO-TYPE)) expand-\GETBASESMALL-FIXP D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) @!H¹HºggIJhhNIL (21Q \GETBASE 16Q %%SMALLPOSP-SMALLFIXP) () (SETF-MACRO-FUNCTION (QUOTE \GETBASESMALL-FIXP) (QUOTE expand-\GETBASESMALL-FIXP)) expand-\GETBASESTRING-CHAR D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) @!H¹HºggIJhhNIL (21Q \GETBASE 16Q CODE-CHAR) () (SETF-MACRO-FUNCTION (QUOTE \GETBASESTRING-CHAR) (QUOTE expand-\GETBASESTRING-CHAR)) expand-\GETBASETHINSTRING-CHAR D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) @!H¹HºggIJhhNIL (21Q \GETBASEBYTE 16Q CODE-CHAR) () (SETF-MACRO-FUNCTION (QUOTE \GETBASETHINSTRING-CHAR) (QUOTE expand-\GETBASETHINSTRING-CHAR)) expand-\PUTBASESMALL-FIXP D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) $@AH¹HZ»J¼gIKgLhhNIL (30Q %%SMALLFIXP-SMALLPOSP 23Q \PUTBASE) () (SETF-MACRO-FUNCTION (QUOTE \PUTBASESMALL-FIXP) (QUOTE expand-\PUTBASESMALL-FIXP)) expand-\PUTBASESTRING-CHAR D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) $@AH¹HZ»J¼gIKgLhhNIL (30Q CHAR-CODE 23Q \PUTBASE) () (SETF-MACRO-FUNCTION (QUOTE \PUTBASESTRING-CHAR) (QUOTE expand-\PUTBASESTRING-CHAR)) expand-\PUTBASETHINSTRING-CHAR D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) $@AH¹HZ»J¼gIKgLhhNIL (30Q CHAR-CODE 23Q \PUTBASEBYTE) () (SETF-MACRO-FUNCTION (QUOTE \PUTBASETHINSTRING-CHAR) (QUOTE expand-\PUTBASETHINSTRING-CHAR)) ARRAY-TABLE-ENTRY-TYPE-TEST D1 (L (0 OBJECT)) @NIL NIL () setf-ARRAY-TABLE-ENTRY-TYPE-TEST D1 (L (1 VALUE 0 OBJECT)) @ANIL NIL () (REMPROP (QUOTE ARRAY-TABLE-ENTRY-TYPE-TEST) (QUOTE SETF-METHOD-EXPANDER)) (PUTPROPS ARRAY-TABLE-ENTRY-TYPE-TEST SETF-INVERSE setf-ARRAY-TABLE-ENTRY-TYPE-TEST) ARRAY-TABLE-ENTRY-NEEDS-SHIFT-P D1 (L (0 OBJECT)) @NIL NIL () setf-ARRAY-TABLE-ENTRY-NEEDS-SHIFT-P D1 (L (1 VALUE 0 OBJECT)) @ANIL NIL () (REMPROP (QUOTE ARRAY-TABLE-ENTRY-NEEDS-SHIFT-P) (QUOTE SETF-METHOD-EXPANDER)) (PUTPROPS ARRAY-TABLE-ENTRY-NEEDS-SHIFT-P SETF-INVERSE setf-ARRAY-TABLE-ENTRY-NEEDS-SHIFT-P) ARRAY-TABLE-ENTRY-DEFAULT-VALUE D1 (L (0 OBJECT)) @NIL NIL () setf-ARRAY-TABLE-ENTRY-DEFAULT-VALUE D1 (L (1 VALUE 0 OBJECT)) @ANIL NIL () (REMPROP (QUOTE ARRAY-TABLE-ENTRY-DEFAULT-VALUE) (QUOTE SETF-METHOD-EXPANDER)) (PUTPROPS ARRAY-TABLE-ENTRY-DEFAULT-VALUE SETF-INVERSE setf-ARRAY-TABLE-ENTRY-DEFAULT-VALUE) ARRAY-TABLE-ENTRY-GC-TYPE D1 (L (0 OBJECT)) @NIL NIL () setf-ARRAY-TABLE-ENTRY-GC-TYPE D1 (L (1 VALUE 0 OBJECT)) @ANIL NIL () (REMPROP (QUOTE ARRAY-TABLE-ENTRY-GC-TYPE) (QUOTE SETF-METHOD-EXPANDER)) (PUTPROPS ARRAY-TABLE-ENTRY-GC-TYPE SETF-INVERSE setf-ARRAY-TABLE-ENTRY-GC-TYPE) ARRAY-TABLE-ENTRY-BITS-PER-ELEMENT D1 (L (0 OBJECT)) @NIL NIL () setf-ARRAY-TABLE-ENTRY-BITS-PER-ELEMENT D1 (L (1 VALUE 0 OBJECT)) @ANIL NIL () (REMPROP (QUOTE ARRAY-TABLE-ENTRY-BITS-PER-ELEMENT) (QUOTE SETF-METHOD-EXPANDER)) (PUTPROPS ARRAY-TABLE-ENTRY-BITS-PER-ELEMENT SETF-INVERSE setf-ARRAY-TABLE-ENTRY-BITS-PER-ELEMENT) ARRAY-TABLE-ENTRY-SETTOR D1 (L (0 OBJECT)) @NIL NIL () setf-ARRAY-TABLE-ENTRY-SETTOR D1 (L (1 VALUE 0 OBJECT)) @ANIL NIL () (REMPROP (QUOTE ARRAY-TABLE-ENTRY-SETTOR) (QUOTE SETF-METHOD-EXPANDER)) (PUTPROPS ARRAY-TABLE-ENTRY-SETTOR SETF-INVERSE setf-ARRAY-TABLE-ENTRY-SETTOR) ARRAY-TABLE-ENTRY-ACCESSOR D1 (L (0 OBJECT)) @NIL NIL () setf-ARRAY-TABLE-ENTRY-ACCESSOR D1 (L (1 VALUE 0 OBJECT)) @ANIL NIL () (REMPROP (QUOTE ARRAY-TABLE-ENTRY-ACCESSOR) (QUOTE SETF-METHOD-EXPANDER)) (PUTPROPS ARRAY-TABLE-ENTRY-ACCESSOR SETF-INVERSE setf-ARRAY-TABLE-ENTRY-ACCESSOR) ARRAY-TABLE-ENTRY-CML-TYPE D1 (L (0 OBJECT)) @NIL NIL () setf-ARRAY-TABLE-ENTRY-CML-TYPE D1 (L (1 VALUE 0 OBJECT)) @ANIL NIL () (REMPROP (QUOTE ARRAY-TABLE-ENTRY-CML-TYPE) (QUOTE SETF-METHOD-EXPANDER)) (PUTPROPS ARRAY-TABLE-ENTRY-CML-TYPE SETF-INVERSE setf-ARRAY-TABLE-ENTRY-CML-TYPE) COPY-ARRAY-TABLE-ENTRY D1 (L (0 OBJECT)) ?@@@@@@@@@NIL NIL () (DEFPRINT (QUOTE ARRAY-TABLE-ENTRY) (FUNCTION \DEFPRINT.DEFSTRUCT.DEFAULT)) MAKE-ARRAY-TABLE-ENTRY D1 (L (0 -args-)) }eHkJdIó¢±·¿hñ`Hk»ºKdJó¢±·¿h¼Hk¾½NdMó¢±½¿h_¿Hk_¿_¿OdOó¢±»¿h_¿Hk_¿_¿OdOó¢±¼¿h_¿Hk_¿_¿OdOó¢±½¿h_ ¿Hk_$¿_"¿O$dO"ó¢±¾¿h_&¿Hk_*¿_(¿O*dO(󢱿¿h_,¿ILOOOO O&O,hagð–JkØa±ÿDJlÔZ±ÿ3agð–KkØa±ÿDKlÔ[±ÿ3agð–NkØa±ÿ>NlÔ^±ÿ-agð—OkØa±ÿ?OlÔ_±ÿ+agð—OkØa±ÿ>OlÔ_±ÿ*agð—OkØa±ÿ=OlÔ_±ÿ)agð—O$kØa±ÿ= OBJECT 0) (<= OBJECT 1))))) (8BIT ((UNSIGNED-BYTE 8) \GETBASEBYTE \PUTBASEBYTE 8 UNBOXEDBLOCK.GCT 0 NIL (CL:LAMBDA (OBJECT) (AND (>= OBJECT 0) (< OBJECT 256))))) (16BIT ((UNSIGNED-BYTE 16) \GETBASE \PUTBASE 16 UNBOXEDBLOCK.GCT 0 NIL (CL:LAMBDA (OBJECT) (SMALLPOSP OBJECT)))))) (SIGNED-BYTE ((16BIT ((SIGNED-BYTE 16) \GETBASESMALL-FIXP \PUTBASESMALL-FIXP 16 UNBOXEDBLOCK.GCT 0 NIL (CL:LAMBDA (OBJECT) (AND (>= OBJECT MIN.SMALLFIXP) (<= OBJECT MAX.SMALLFIXP))))) (32BIT ((SIGNED-BYTE 32) \GETBASEFIXP \PUTBASEFIXP 32 UNBOXEDBLOCK.GCT 0 1 (CL:LAMBDA (OBJECT) (AND (>= OBJECT MIN.FIXP) (<= OBJECT MAX.FIXP)))))))))) (LET* ((A0618 (QUOTE %%LIT-ARRAY-TABLE)) (A0619 (QUOTE VARIABLE)) (A0620 "Fields described by record ARRAY-TYPE-TABLE-ENTRY")) (PROGN (COND ((FBOUNDP (QUOTE SET-DOCUMENTATION) ) (SET-DOCUMENTATION A0618 A0619 A0620))) A0620)) (PROCLAIM (QUOTE (SPECIAL %%LIT-ARRAY-TYPES))) (SETQ %%LIT-ARRAY-TYPES (QUOTE ((UNSIGNED-BYTE 0) (SIGNED-BYTE 1) (T 2) (SINGLE-FLOAT 3) (STRING-CHAR 4) (XPOINTER 5)))) (LET* ((A0621 (QUOTE %%LIT-ARRAY-TYPES)) (A0622 (QUOTE VARIABLE)) (A0623 "Type codes")) (PROGN (COND ( (FBOUNDP (QUOTE SET-DOCUMENTATION)) (SET-DOCUMENTATION A0621 A0622 A0623))) A0623)) (PROCLAIM (QUOTE (SPECIAL %%ARRAY-TYPE-TABLE))) (SETQ %%ARRAY-TYPE-TABLE (%%MAKE-ARRAY-TYPE-TABLE %%LIT-ARRAY-TABLE %%LIT-ARRAY-TYPES %%LIT-ARRAY-SIZES)) (LET* ((A0624 (QUOTE %%ARRAY-TYPE-TABLE)) (A0625 (QUOTE VARIABLE)) (A0626 "Drives various macros")) ( PROGN (COND ((FBOUNDP (QUOTE SET-DOCUMENTATION)) (SET-DOCUMENTATION A0624 A0625 A0626))) A0626)) (PROCLAIM (QUOTE (SPECIAL %%CANONICAL-CML-TYPES))) (SETQ %%CANONICAL-CML-TYPES (%%MAKE-CML-TYPE-TABLE %%ARRAY-TYPE-TABLE)) (SETQ MAX.SMALLFIXP (1- (EXPT 2 15))) (PUTHASH (QUOTE MAX.SMALLFIXP) (QUOTE (CONSTANT MAX.SMALLFIXP)) COMPVARMACROHASH) (SETQ MIN.SMALLFIXP (- (EXPT 2 15))) (PUTHASH (QUOTE MIN.SMALLFIXP) (QUOTE (CONSTANT MIN.SMALLFIXP)) COMPVARMACROHASH) (SETQ %%CHAR-TYPE (%%LIT-TYPE-TO-TYPE (QUOTE STRING-CHAR))) (PUTHASH (QUOTE %%CHAR-TYPE) (QUOTE (CONSTANT %%CHAR-TYPE)) COMPVARMACROHASH) (SETQ %%BIT-TYPE (%%TYPE-SIZE-TO-TYPENUMBER (QUOTE UNSIGNED-BYTE) (QUOTE 1BIT))) (PUTHASH (QUOTE %%BIT-TYPE) (QUOTE (CONSTANT %%BIT-TYPE)) COMPVARMACROHASH) (SETQ %%THIN-CHAR-TYPENUMBER (%%TYPE-SIZE-TO-TYPENUMBER (QUOTE STRING-CHAR) (QUOTE 8BIT))) (PUTHASH (QUOTE %%THIN-CHAR-TYPENUMBER) (QUOTE (CONSTANT %%THIN-CHAR-TYPENUMBER)) COMPVARMACROHASH) (SETQ %%FAT-CHAR-TYPENUMBER (%%TYPE-SIZE-TO-TYPENUMBER (QUOTE STRING-CHAR) (QUOTE 16BIT))) (PUTHASH (QUOTE %%FAT-CHAR-TYPENUMBER) (QUOTE (CONSTANT %%FAT-CHAR-TYPENUMBER)) COMPVARMACROHASH) (SETQ %%MAXTHINCHAR (1- (EXPT 2 8))) (PUTHASH (QUOTE %%MAXTHINCHAR) (QUOTE (CONSTANT %%MAXTHINCHAR)) COMPVARMACROHASH) (SETQ %%GENERAL-ARRAY 16) (PUTHASH (QUOTE %%GENERAL-ARRAY) (QUOTE (CONSTANT %%GENERAL-ARRAY)) COMPVARMACROHASH) (LET* ((A0627 (QUOTE %%GENERAL-ARRAY)) (A0628 (QUOTE VARIABLE)) (A0629 "General-array-type-number")) ( PROGN (COND ((FBOUNDP (QUOTE SET-DOCUMENTATION)) (SET-DOCUMENTATION A0627 A0628 A0629))) A0629)) (SETQ %%ONED-ARRAY 14) (PUTHASH (QUOTE %%ONED-ARRAY) (QUOTE (CONSTANT %%ONED-ARRAY)) COMPVARMACROHASH) (LET* ((A0630 (QUOTE %%ONED-ARRAY)) (A0631 (QUOTE VARIABLE)) (A0632 "ONED-ARRAY type number")) (PROGN (COND ((FBOUNDP (QUOTE SET-DOCUMENTATION)) (SET-DOCUMENTATION A0630 A0631 A0632))) A0632)) (SETQ %%TWOD-ARRAY 15) (PUTHASH (QUOTE %%TWOD-ARRAY) (QUOTE (CONSTANT %%TWOD-ARRAY)) COMPVARMACROHASH) (LET* ((A0633 (QUOTE %%TWOD-ARRAY)) (A0634 (QUOTE VARIABLE)) (A0635 "TWOD-ARRAY type number")) (PROGN (COND ((FBOUNDP (QUOTE SET-DOCUMENTATION)) (SET-DOCUMENTATION A0633 A0634 A0635))) A0635)) (PUTPROPS CMLARRAY-SUPPORT FILETYPE COMPILE-FILE) (PUTPROPS CMLARRAY-SUPPORT COPYRIGHT ("Xerox Corporation" 1986)) NIL