(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "29-Oct-86 23:12:57" ("compiled on " {ERIS}SOURCES>APRINT.;55) "21-Oct-86 04:13:01" "COMPILE-FILEd" in "Xerox Lisp 21-Oct-86 ..." dated "21-Oct-86 04:48:43") (FILECREATED "29-Oct-86 23:12:19" {ERIS}SOURCES>APRINT.;55 69823 changes to%: (VARS APRINTCOMS) (FNS PRINT-CIRCLE-SCAN \PRINDATUM \PRINT-USING-DEFPRINT \PRINT-USING-ADDRESS \PRINDATUM-LISTP) (FUNCTIONS \PRINDATUM-LISTP) previous date%: "29-Oct-86 21:53:22" {ERIS}SOURCES>APRINT.;53) (RPAQQ APRINTCOMS ((COMS (* ; "User-level print functions") (FNS PRIN1 PRIN2 PRIN3 PRIN4 PRINT PRINTCCODE PRINTLEVEL RADIX SPACES TERPRI FRESHLINE DEFPRINT LINELENGTH)) (INITVARS (PLVLFILEFLG NIL) (\LINELENGTH 82) (\FLOATFORMAT T) (PRXFLG NIL) (*PRINT-BASE* 10) (*READ-BASE* 10) (*PRINT-RADIX* NIL) (*PRINT-ESCAPE* T) (*PRINT-CASE* (QUOTE :UPCASE)) (*PRINT-GENSYM* T) (*PRINT-LEVEL* NIL) ( *PRINT-LENGTH* NIL) (*PRINT-PRETTY* NIL) (*PRINT-CIRCLE* NIL) (*PRINT-ARRAY* NIL) ( *PRINT-CIRCLE-HASHTABLE* NIL) (*PACKAGE* NIL) (*KEYWORD-PACKAGE* NIL) (*INTERLISP-PRIN1-CASE* (QUOTE :UPCASE)) (\DEFPRINTFNS NIL)) (COMS (* ; "PRINT internals") (FNS PRINT-CIRCLE-LOOKUP PRINT-CIRCLE-LABEL-P PRINT-CIRCLE-SCAN PRINT-CIRCLE-ENTER) (FUNCTIONS \PRINDATUM-LISTP) (FNS \PRINDATUM \PRINT-USING-DEFPRINT \PRINT-USING-ADDRESS \ELIDE.PRINT.ELEMENT \ELIDE.ELEMENT.CHAR \ELIDE.PRINT.TAIL \ELIDE.TAIL.STRING \CKPOSBOUT \CKPOSSOUT \CONVERTNUMBER \LITPRIN \LITPRIN.INTERNAL \SYMBOL.ESCAPE.COUNT \NUMERIC.PNAMEP \PRINSTACKP \PRINTADDR \PRINSTRING \SOUT \OUTCHAR \FILEOUTCHARFN \TTYOUTCHARFN) (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS .FILELINELENGTH.) (EXPORT (MACROS .SPACECHECK. \CHECKRADIX))) (FNS \INVALID.RADIX) (SPECVARS \THISFILELINELENGTH)) (COMS (* ; "Internal printing") ( FNS \MAPPNAME \MAPPNAME.INTERNAL PNAMESTREAMP) (DECLARE%: DONTCOPY (RESOURCES \MAPPNAMESTREAM) (MACROS PNAMESTREAMP)) (INITRESOURCES \MAPPNAMESTREAM) (INITVARS (\PNAMEDEVICE (NCREATE (QUOTE FDEV) ( \GETDEVICEFROMHOSTNAME (QUOTE NULL) T)))) (GLOBALVARS \PNAMEDEVICE)) (COMS (* ; "Obsolete") (FNS \MAPCHARS)) (DECLARE%: EVAL@COMPILE DOCOPY (ADDVARS (SYSSPECVARS *PRINT-BASE* *READ-BASE* *PRINT-RADIX* *PRINT-ESCAPE* *PRINT-CASE* *PRINT-GENSYM* *PRINT-LEVEL* *PRINT-LENGTH* *PRINT-PRETTY* *PRINT-CIRCLE* *PRINT-ARRAY* *PACKAGE*))) (COMS (* ; "PRINTNUM and friends") (FNS PRINTNUM FLTFMT \CHECKFLTFMT) (MACROS NUMFORMATCODE) (INITVARS (NILNUMPRINTFLG))) (LOCALVARS . T) (PROP FILETYPE APRINT) (GLOBALVARS \LINELENGTH \FLOATFORMAT PRXFLG \DEFPRINTFNS) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA \PRINT-USING-ADDRESS PRINT-CIRCLE-ENTER PRINT-CIRCLE-SCAN PRINT-CIRCLE-LABEL-P))))) PRIN1 D1 (L (1 FILE 0 X) P 8 \THISFILELINELENGTH P 7 *PRINT-RADIX* P 6 *PRINT-ESCAPE* P 5 *PRINT-CASE* P 4 *PRINT-LENGTH* P 3 *PRINT-LEVEL* F 9 *READTABLE* F 10 \TERM.OFD F 11 PLVLFILEFLG F 12 *PRINT-CASE* F 13 *PRINT-LEVEL* F 14 *PRINT-LENGTH* F 15 *INTERLISP-PRIN1-CASE*) V Ag !W jh HWWYWIWWW3HZdj`nhJ_@Hj @(82 \PRINDATUM 6 \GETSTREAM) (65 \LINELENGTH 54 STREAM 14 READTABLEP 3 OUTPUT) () PRIN2 D1 (L (2 RDTBL 1 FILE 0 X) P 9 \THISFILELINELENGTH P 8 *PACKAGE* P 7 *PRINT-LENGTH* P 6 *PRINT-LEVEL* P 5 *PRINT-RADIX* P 4 *PRINT-ESCAPE* P 3 *READTABLE* F 10 *READTABLE* F 11 \TERM.OFD F 12 *PACKAGE* F 13 PLVLFILEFLG F 14 *PRINT-BASE* F 15 *PRINT-LEVEL* F 16 *PRINT-LENGTH* F 17 *INTERLISP-PACKAGE*) v Ag !BBdiWb jh HWWBiWl hIWIW B jW"W HZdj`nhJ_@Hj @(114 \PRINDATUM 6 \GETSTREAM) (97 \LINELENGTH 86 STREAM 68 READTABLEP 27 READTABLEP 22 READTABLEP 3 OUTPUT) () PRIN3 D1 (L (1 FILE 0 X) P 7 \THISFILELINELENGTH P 6 *PRINT-RADIX* P 5 *PRINT-ESCAPE* P 4 *PRINT-CASE* P 3 *PRINT-LENGTH* P 2 *PRINT-LEVEL* F 8 *READTABLE* F 9 \TERM.OFD F 10 PLVLFILEFLG F 11 *PRINT-CASE* F 12 *PRINT-LEVEL* F 13 *PRINT-LENGTH* F 14 *INTERLISP-PRIN1-CASE*) <Ag W jh HWWYWIWWW3@Hj @(56 \PRINDATUM 6 \GETSTREAM) (14 READTABLEP 3 OUTPUT) () PRIN4 D1 (L (2 RDTBL 1 FILE 0 X) P 8 \THISFILELINELENGTH P 7 *PACKAGE* P 6 *PRINT-LENGTH* P 5 *PRINT-LEVEL* P 4 *PRINT-RADIX* P 3 *PRINT-ESCAPE* P 2 *READTABLE* F 9 *READTABLE* F 10 \TERM.OFD F 11 *PACKAGE* F 12 PLVLFILEFLG F 13 *PRINT-BASE* F 14 *PRINT-LEVEL* F 15 *PRINT-LENGTH* F 16 *INTERLISP-PACKAGE*) \ Ag BBdiWb jh HWWBiWl hIWIWB jW W@Hj @(88 \PRINDATUM 6 \GETSTREAM) (68 READTABLEP 27 READTABLEP 22 READTABLEP 3 OUTPUT) () PRINT D1 (L (2 RDTBL 1 FILE 0 X)) !Ag @HB H Hl lI@(15 PRIN2 6 \GETSTREAM) (19 STREAM 3 OUTPUT) () PRINTCCODE D1 (L (1 FILE 0 CHARCODE)) )Ag @dj@@@ H HIlJ(22 \ILLEGAL.ARG 6 \GETSTREAM) (29 STREAM 3 OUTPUT) () PRINTLEVEL D1 (L (1 CDRVAL 0 CARVAL) F 0 *PRINT-LEVEL* F 1 *PRINT-LENGTH*) 6@(PmQm@j@h@cAjAhAcb@bNIL NIL () RADIX D1 (L (0 N) F 1 *PRINT-BASE*) #Q@@HdkHHdl$H c(28 \INVALID.RADIX) NIL () SPACES D1 (L (1 FILE 0 N)) OAg 1HZdj`nhJY@HIH @djH Hl lKkٰ(50 FRESHLINE 6 \GETSTREAM) (61 STREAM 40 STREAM 24 \LINELENGTH 13 STREAM 3 OUTPUT) () TERPRI D1 (L (0 FILE)) @g H Hl lIh(6 \GETSTREAM) (13 STREAM 3 OUTPUT) () FRESHLINE D1 (L (0 STREAM)) e@d:@dRlj2@dRlj@4@kH@@g bj@ @l lHih(68 GETSTREAM) (83 STREAM 73 STREAM 65 OUTPUT 48 FDEV 43 STREAM 28 STREAM 12 STREAM 4 STREAM) () DEFPRINT D1 (L (1 FN 0 TYPE)) 1@d3 b`HA@A`H` (41 DREMOVE 7 \TYPENAMEFROMNUMBER) (44 \DEFPRINTFNS 38 \DEFPRINTFNS 31 \DEFPRINTFNS 27 \DEFPRINTFNS 12 \DEFPRINTFNS) () LINELENGTH D1 (L (1 FILE 0 N)) 6Ag H@#@3k@@ H@dinj(30 \ILLEGAL.ARG 6 \GETSTREAM) (36 STREAM 13 STREAM 3 OUTPUT) () (RPAQ? PLVLFILEFLG NIL) (RPAQ? \LINELENGTH 82) (RPAQ? \FLOATFORMAT T) (RPAQ? PRXFLG NIL) (RPAQ? *PRINT-BASE* 10) (RPAQ? *READ-BASE* 10) (RPAQ? *PRINT-RADIX* NIL) (RPAQ? *PRINT-ESCAPE* T) (RPAQ? *PRINT-CASE* (QUOTE :UPCASE)) (RPAQ? *PRINT-GENSYM* T) (RPAQ? *PRINT-LEVEL* NIL) (RPAQ? *PRINT-LENGTH* NIL) (RPAQ? *PRINT-PRETTY* NIL) (RPAQ? *PRINT-CIRCLE* NIL) (RPAQ? *PRINT-ARRAY* NIL) (RPAQ? *PRINT-CIRCLE-HASHTABLE* NIL) (RPAQ? *PACKAGE* NIL) (RPAQ? *KEYWORD-PACKAGE* NIL) (RPAQ? *INTERLISP-PRIN1-CASE* (QUOTE :UPCASE)) (RPAQ? \DEFPRINTFNS NIL) PRINT-CIRCLE-LOOKUP D1 (L (0 OBJECT) F 4 *PRINT-CIRCLE-NUMBER* F 5 *PRINT-CIRCLE-HASHTABLE* F 6 *READTABLE*) l@U 1HgHhd g,V To @UTKJI Tkci H3V Ho h o (105 CL:ERROR 97 CL:VALUES 93 CONCAT 85 CHARACTER 69 CL:VALUES 58 CL::PUTHASH 46 CONCAT 38 CHARACTER 21 CL:VALUES 4 GETHASH) (79 READTABLEP 32 READTABLEP 25 T2 11 T1) ( 102 "Print-circle-lookup hashtable error!" 90 "#" 43 "=") PRINT-CIRCLE-LABEL-P D1 (L (0 OBJECT) F 1 *PRINT-CIRCLE-HASHTABLE*) @Q HgH3 H(4 GETHASH) (11 T2) () PRINT-CIRCLE-SCANA0001 D1 (L (0 DESCRIPTOR) F 0 OBJECT) @P (7 PRINT-CIRCLE-SCAN 4 FETCHFIELD) NIL () PRINT-CIRCLE-SCAN D1 (I 0 OBJECT F 6 CL::*PRINT-STRUCTURE* F 7 *PRINT-ARRAY*) @QHd@ @ @bho V@ g@ HY I iW@ @ @ kJg@ @JjLMKM MkԽ(125 PRINT-CIRCLE-SCAN 107 CL:MAKE-ARRAY 96 CL:ARRAY-RANK 91 CL:ARRAY-TOTAL-SIZE 85 PRINT-CIRCLE-ENTER 73 CL:ARRAY-ELEMENT-TYPE 67 CL:ARRAYP 61 CL:MAPCAR 58 CL::STRUCTURE-POINTER-SLOTS 55 CL:TYPE-OF 46 PRINT-CIRCLE-ENTER 37 TYPENAMEP 21 PRINT-CIRCLE-SCAN 15 PRINT-CIRCLE-ENTER) (103 :DISPLACED-TO 51 PRINT-CIRCLE-SCANA0001 8 LISTP) ( 34 "datatype included by every structure") PRINT-CIRCLE-ENTER D1 (L (0 OBJECT) F 5 *PRINT-CIRCLE-HASHTABLE* F 6 THERE-ARE-CIRCLES) A@U AH@UJIg hg@ULKg ic Hgio (62 CL:ERROR 42 CL::PUTHASH 22 CL::PUTHASH 4 CL:GETHASH) (51 T2 39 T2 27 T1 19 T1) ( 59 "Print-circle-enter hashtable error!") expand-\PRINDATUM-LISTP D1 (L (1 SI::$$MACRO-ENVIRONMENT 0 SI::$$MACRO-FORM)) oNIL NIL ( 3 (LET (LABEL FIRSTTIME) (OR CPL (SETQ CPL 0)) (if *PRINT-CIRCLE-HASHTABLE* then (CL:MULTIPLE-VALUE-SETQ (LABEL FIRSTTIME) (PRINT-CIRCLE-LOOKUP OBJECT))) (if LABEL then (\CKPOSSOUT STREAM LABEL) (CL:WHEN FIRSTTIME (\CKPOSBOUT STREAM (CHARCODE SPACE)))) (COND ((AND LABEL (NOT FIRSTTIME)) (* Second reference - just print label) NIL) ((AND *PRINT-LEVEL* (ILEQ *PRINT-LEVEL* CPL)) (\ELIDE.PRINT.ELEMENT STREAM)) (T (PROG (CDRCNT) (COND (*PRINT-LENGTH* (SETQ CDRCNT (COND ((fetch (READTABLEP COMMONLISP) of *READTABLE*) 0) (T (* Interlisp print depth is triangular, Common Lisp isn't) (COND ((IGEQ CPL *PRINT-LENGTH*) (* We would just print "(--)" so it's nicer to print "&") (RETURN (\ELIDE.PRINT.ELEMENT STREAM)))) CPL))))) (add CPL 1) (* Recursive calls will be at 1 greater depth) (\CKPOSBOUT STREAM (CHARCODE %()) LP (COND ((AND CDRCNT (IGREATERP (add CDRCNT 1) *PRINT-LENGTH*)) (* have printed as many elements as allowed) (\ELIDE.PRINT.TAIL STREAM T)) (T (\PRINDATUM (CAR OBJECT) STREAM CPL) (COND ((LISTP (SETQ OBJECT (CDR OBJECT))) (\CKPOSBOUT STREAM (CHARCODE SPACE)) (if (AND *PRINT-CIRCLE-HASHTABLE* (PRINT-CIRCLE-LABEL-P OBJECT)) then (* "Must print as a dotted tail") (\CKPOSSOUT STREAM ". ") (\PRINDATUM OBJECT STREAM CPL) else (GO LP))) (OBJECT (* Dotted tail) (\CKPOSSOUT STREAM " . ") (\PRINDATUM OBJECT STREAM))))) (\CKPOSBOUT STREAM (CHARCODE ")"))))))) (SETF-MACRO-FUNCTION (QUOTE \PRINDATUM-LISTP) (QUOTE expand-\PRINDATUM-LISTP)) \PRINDATUM D1 (L (2 CPL 1 STREAM 0 OBJECT) F 4 *PRINT-LENGTH* F 5 *PRINT-CIRCLE-HASHTABLE* F 6 *READTABLE* F 7 *PRINT-LEVEL* F 8 *PRINT-RADIX* F 9 *PRINT-BASE*) @dl@A dl@BjbU@ ZJHAH IAl HIWhTV jjBA TBBBkbAl( K4@AB @bd1Al U@ Ao @AB k[TAi Ao @A Al) hdkdlY`Ll& `;A@WZdkJJdl$J iWVHI  HIhhdlR`1l& ` A@HIA``ihh` HIdl@A l@A @d@AB @Aj @AB (449 \PRINT-USING-DEFPRINT 442 PRINT-INSTANCE 431 CL::PRINT-STRUCTURE-INSTANCE 417 \PRINSTACKP 407 \PRINSTRING 385 \CKPOSSOUT 382 \CONVERT.FLOATING.NUMBER 335 CONCAT 327 ALLOCSTRING 285 \CKPOSSOUT 282 \CONVERTNUMBER 270 \INVALID.RADIX 242 CONCAT 234 ALLOCSTRING 211 \CKPOSBOUT 204 \PRINDATUM 198 \CKPOSSOUT 188 \ELIDE.PRINT.TAIL 174 \PRINDATUM 167 \CKPOSSOUT 157 PRINT-CIRCLE-LABEL-P 149 \CKPOSBOUT 133 \PRINDATUM 122 \CKPOSBOUT 102 \ELIDE.PRINT.ELEMENT 63 \CKPOSBOUT 54 \CKPOSSOUT 39 \MVLIST 36 PRINT-CIRCLE-LOOKUP 12 \LITPRIN) (435 T 423 CL::STRUCTURE-OBJECT 394 \\NUMSTR1.GLOBALRESOURCE 389 \\NUMSTR.GLOBALRESOURCE 379 \FLOATFORMAT 373 \\NUMSTR.GLOBALRESOURCE 366 \\NUMSTR1.GLOBALRESOURCE 357 PRXFLG 351 \PNAMEDEVICE 346 STREAM 330 \\NUMSTR1.GLOBALRESOURCE 320 \\NUMSTR.GLOBALRESOURCE 307 \\NUMSTR.GLOBALRESOURCE 300 \\NUMSTR1.GLOBALRESOURCE 294 \\NUMSTR1.GLOBALRESOURCE 289 \\NUMSTR.GLOBALRESOURCE 237 \\NUMSTR1.GLOBALRESOURCE 227 \\NUMSTR.GLOBALRESOURCE 86 READTABLEP) ( 195 " . " 164 ". ") \PRINT-USING-DEFPRINT D1 (L (2 CPL 1 STREAM 0 X) P 3 *PRINT-ESCAPE* P 2 *PRINT-LEVEL* F 4 *PRINT-LEVEL*) N@ `HTdBjH@AjlIX @AB HdHA H HAB (75 \PRINDATUM 63 \PRINDATUM 45 \PRINT-USING-ADDRESS 3 TYPENAME) (6 \DEFPRINTFNS) () \PRINT-USING-ADDRESS D1 (L (2 CPL 1 STREAM 0 X) F 6 *READTABLE* F 7 \THISFILELINELENGTH) @ QV j_WAdlWA AVZ JKlIA Al ,Al{ HHA Al} A Al#lM@A i(152 \PRINTADDR 131 \CKPOSBOUT 124 \LITPRIN 116 \CKPOSBOUT 108 \CKPOSBOUT 101 \PRINTADDR 95 \CKPOSSOUT 86 \LITPRIN 40 FRESHLINE 3 TYPENAME) (136 STREAM 68 STREAM 54 STREAM 46 READTABLEP 26 STREAM 10 READTABLEP) ( 92 " @ ") \ELIDE.PRINT.ELEMENT D1 (L (0 STREAM)) @H HIlJ(3 \ELIDE.ELEMENT.CHAR) (10 STREAM) () \ELIDE.ELEMENT.CHAR D1 (F 0 *READTABLE*) P jPl&NIL (13 READTABLEP 3 READTABLEP) () \ELIDE.PRINT.TAIL D1 (L (1 NOSPACEP 0 STREAM)) A@ @l lH@ (26 \SOUT 22 \ELIDE.TAIL.STRING) (6 STREAM) () \ELIDE.TAIL.STRING D1 (F 0 *READTABLE*) P jooNIL (3 READTABLEP) ( 18 "--" 13 "...") \CKPOSBOUT D1 (L (1 X 0 STREAM) F 1 \THISFILELINELENGTH) &Q@dkQ@ @ @AlH(19 FRESHLINE) (24 STREAM 7 STREAM) () \CKPOSSOUT D1 (L (1 X 0 STREAM) F 7 \THISFILELINELENGTH) `WA@W@ AaHkٻHKHغHCjhi]Kk[JMLKLK¹@ @IlNh(24 FRESHLINE) (81 STREAM 13 STREAM 7 STRINGP) () \CONVERTNUMBER D1 (L (5 NSB 4 NS 3 RDTBL 2 IGNORE 1 R 0 N)) &@jopj@@j@XDZkٻhAlCDJmZIAܽl M&Ml0' jIlDKk[lQ iMl lA IAYjHDJmZl- Al CLj@@j@^l ANwAdlDJmZlxQlDJmZloCAlDJmZlb4DJmZlr DJmZAl l0 l ADJmZAl l0 DJmZC DJKE (291 SUBSTRING 283 RPLCHARCODE 266 RPLCHARCODE 243 RPLCHARCODE 237 IMOD 224 RPLCHARCODE 129 RPLCHARCODE 107 RPLCHARCODE 92 RPLCHARCODE) (277 READTABLEP 69 READTABLEP 29 STRINGP 26 STRINGP) ( 7 "0") \LITPRIN D1 (L (1 STREAM 0 X) F 10 \THISFILELINELENGTH F 11 *READTABLE* F 12 *PACKAGE* F 13 *PRINT-ESCAPE* F 14 *PRINT-CASE* F 15 *PRINT-GENSYM* F 16 *KEYWORD-PACKAGE*)  WW!W@HAId JW `@YhIWll: ZkH W kH h@dW hdI klH W@AWA j@WgWjhs I\I jh^HkXM(HOCjDjBW>B CuDkOB _BIlOKB _BJlOj@BO0_4_6O0 jh_8O.k_.O6CB _BJlOB AB jA _jOOQjOٱJO8O4O.O4O._2JO2IB _BIlOB _BO2lOvHk.@ l.%B _ BIlO B _"Bl.lO"OAjh `Aj@iAjhW@gDO0_8_:O0 jh_lH(145 \SOUT 136 \LITPRIN 124 STKNAME 113 RELSTKP 91 \PRINTADDR 86 \SOUT 52 FRESHLINE 25 STKNAME 16 STKNAME 7 RELSTKP) (150 STREAM 95 STREAM 68 STREAM 58 READTABLEP 39 STREAM) ( 141 "*form*" 119 "released" 82 "