From af16fb48fa5982088432c3ed6f866c7d6db236e7 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Wed, 18 Aug 2021 12:22:45 -0700 Subject: [PATCH] Restore package/reatable eval in define file fino (#415) * Adds fields to reader-environment to remember evaluation forms for reprinting For package and readtable, not for base or external format. This restores previous package/readtable behavior. ATBL also is now not radix 8 * THINFILES: now can add extensions/file names to operate on Not related to other things in this branch, just a useful extension to a simple lispusers package. You can now add dribble as an extension, and things like I-NEW as a name, to make it easy to clean up the tmp/ loadup directory in particular. --- lispusers/THINFILES | 70 ++- lispusers/THINFILES.LCOM | Bin 2495 -> 2892 bytes sources/ATBL | 1258 +++++++++++++++++++------------------- sources/ATBL.LCOM | Bin 35417 -> 35117 bytes sources/BOOTSTRAP | 119 ++-- sources/BOOTSTRAP.LCOM | Bin 14326 -> 14608 bytes sources/CMLREAD | 80 +-- sources/CMLREAD.LCOM | Bin 7368 -> 6066 bytes 8 files changed, 777 insertions(+), 750 deletions(-) diff --git a/lispusers/THINFILES b/lispusers/THINFILES index c1465750..666823ba 100644 --- a/lispusers/THINFILES +++ b/lispusers/THINFILES @@ -1,23 +1,30 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED " 1-May-92 16:49:39" {DSK}lfg>parser>THINFILES.;5 8005 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) +(FILECREATED " 8-Aug-2021 15:05:08"  +{DSK}kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;3 8422 - changes to%: (FNS FB.THINP) + changes to%: (VARS THINFILESCOMS) + (FNS FB.THINP) - previous date%: "28-Sep-89 16:38:11" {DSK}lfg>parser>THINFILES.;2) + previous date%: " 8-Aug-2021 15:00:48" +{DSK}kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;2) (* ; " -Copyright (c) 1987, 1988, 1989, 1992 by Xerox Corporation. All rights reserved. +Copyright (c) 1987-1989, 1992, 2021 by Xerox Corporation. ") (PRETTYCOMPRINT THINFILESCOMS) -(RPAQQ THINFILESCOMS [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) - FILEBROWSER)) - (FNS FB.THINCOMMAND FB.THINP) - (APPENDVARS (FB.MENU.ITEMS (Thin FB.THINCOMMAND +(RPAQQ THINFILESCOMS + [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) + FILEBROWSER)) + (FNS FB.THINCOMMAND FB.THINP) + (INITVARS [THINEXTENSIONS (UNION *COMPILED-EXTENSIONS* + '(SYSOUT DCOM DATABASE LCOM DFASL MCOM MFASL DRIBBLE] + (THINNAMES NIL)) + (APPENDVARS (FB.MENU.ITEMS (Thin FB.THINCOMMAND "Delvers non-source files and removes all but the last source file of each day." - ]) + ]) (DECLARE%: EVAL@COMPILE DONTCOPY (FILESLOAD (LOADCOMP) @@ -110,34 +117,41 @@ Copyright (c) 1987, 1988, 1989, 1992 by Xerox Corporation. All rights reserved. (FB.THINP [LAMBDA (FILENAME AGE DELTATIMESTAMP OLDESTVERSION? ONEDAY) - (* ; "Edited 1-May-92 16:49 by rmk:") - (LET [(EXT (U-CASE (FILENAMEFIELD FILENAME 'EXTENSION] - (COND - ((OR (FMEMB EXT '(SYSOUT DCOM DATABASE LCOM DFASL MCOM MFASL)) - (FMEMB EXT *COMPILED-EXTENSIONS*)) (* ; + (* ; "Edited 8-Aug-2021 15:05 by rmk:") + (COND + ((FMEMB (U-CASE (FILENAMEFIELD FILENAME 'EXTENSION)) + THINEXTENSIONS) (* ;  "always delver files that can be reconstructed from the source.") - T) - (OLDESTVERSION? (* ; + T) + ((AND THINNAMES (EQMEMB (U-CASE (FILENAMEFIELD FILENAME 'NAME)) + THINNAMES)) + T) + (OLDESTVERSION? (* ;  "don't delete the oldest version of source files.") - NIL) - ((ILESSP AGE ONEDAY) (* ; + NIL) + ((ILESSP AGE ONEDAY) (* ;  "don't delete anything written within 24 hours.") - NIL) - ((ILESSP (ITIMES DELTATIMESTAMP 3) - ONEDAY) (* ; + NIL) + ((ILESSP (ITIMES DELTATIMESTAMP 3) + ONEDAY) (* ;  "delete anything that occurs on the same day as something else (except for the first day)") - T) - ((ILESSP DELTATIMESTAMP (IQUOTIENT AGE 30)) + T) + ((ILESSP DELTATIMESTAMP (IQUOTIENT AGE 30)) - (* ;; "after one month, delete things that are within a day of each other, after two months, within two days, etc.") + (* ;; "after one month, delete things that are within a day of each other, after two months, within two days, etc.") - T]) + T]) ) +(RPAQ? THINEXTENSIONS (UNION *COMPILED-EXTENSIONS* + '(SYSOUT DCOM DATABASE LCOM DFASL MCOM MFASL DRIBBLE))) + +(RPAQ? THINNAMES NIL) + (APPENDTOVAR FB.MENU.ITEMS (Thin FB.THINCOMMAND "Delvers non-source files and removes all but the last source file of each day." )) -(PUTPROPS THINFILES COPYRIGHT ("Xerox Corporation" 1987 1988 1989 1992)) +(PUTPROPS THINFILES COPYRIGHT ("Xerox Corporation" 1987 1988 1989 1992 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (925 7713 (FB.THINCOMMAND 935 . 6343) (FB.THINP 6345 . 7711))))) + (FILEMAP (NIL (1159 7953 (FB.THINCOMMAND 1169 . 6577) (FB.THINP 6579 . 7951))))) STOP diff --git a/lispusers/THINFILES.LCOM b/lispusers/THINFILES.LCOM index 5936f10e1f7c0e24298c596e02520c3085b3c07e..dfb8f3bfedc947a5b20d814e09e42b939bb1d7bb 100644 GIT binary patch delta 1195 zcmbW1|7z1v6vtbqt_%CaDGZdc9U{{NX=sxULMNTK&5gS(zna|675t}ep%%Nfw3{d* zeFn*!xcQ&p3kdooqHo~2sjFQTlwFdLdvfnNpYJ*6=F_du%l8zE+RUSQn>jSkJlluW zfYf%#V+u0!I1L>Z1@gP4+oLLpC=?5@YWtx}IIQl~YLO}_VrMO+gi{M-F!SW3o!1L` z5sDk-0$!#JioD-D?035H0rZY=k@UujcHTa04CBGD@}kx6wvH-JZ@<;89L5LT__d*J zRN9^6{CHOBc82|vQM#CKBO?Zkv`s^u30Eo`M!BG)`)7lA5-@(%9}L&aU{^JlX;w|sWH@LYBjH62W2dI9j{ZyOWt9CP49t?Q!~XNuQ9B;OaS!R0-4O{RkS6+T zz8k5a*j_YIrb2%ZzwGo*hN%+Vbx{h|qEIejIW7gcE^0LiuWjn8^ed%^;u6n-vSmuA zAG2SsVyYOF!1t&{n!vyS-?3=KcWD?g-`hfy4iSs00)o$e3!i-uZ#qI@Uc!&VxhLm$e)rxVTbFkQ!J@X~Q^|H*DmlI#;9-lJ zR&4IL6ujfdwB_?|y~)vZI7<4M zjKSlR743h1KAlZICcQ=dDCv)qQ?;z6Uy562LT#2u0Glu>Khsc?WevTVWcAz3~EgHoKv=upl z{{jju>c(d5c#Ji@5Cmp}LPj=-Z+cXO4U+y{-+Cvaa8fK5ZoM27*eYdZBP*N5LUT#| zzUbs2%t0du^&Dt9c-rh={r2thJ6=6Vf34w+XlP5jW<)_&5p0LL7Q32l9iDAQE~*T$ zNl}$yEeVal&4>yc$7GK$Gf-7n8K+bbb)ujhLj!#sQ$HJ=xv?*7(KzlfQP^Tn6>&3t vvwpkCrHAWp?_WRB{NB?3#-sGSbce~#H`=V8l;kCDvHGWEuZbe(J1+MRTPe}E diff --git a/sources/ATBL b/sources/ATBL index bdd1f53b..99fbfc49 100644 --- a/sources/ATBL +++ b/sources/ATBL @@ -1,10 +1,11 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED " 9-Jul-2021 15:28:19" {DSK}kaplan>Local>medley3.5>git-medley>sources>ATBL.;11 260310Q +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(FILECREATED "17-Aug-2021 15:52:57" {DSK}kaplan>Local>medley3.5>git-medley>sources>ATBL.;16 91732 - changes to%: (FNS SET-READER-ENVIRONMENT) + changes to%: (VARS ATBLCOMS) + (FNS EQUAL-READER-ENVIRONMENT MAKE-READER-ENVIRONMENT) - previous date%: "28-Jun-2021 09:37:15" -{DSK}kaplan>Local>medley3.5>git-medley>sources>ATBL.;10) + previous date%: "16-Aug-2021 23:44:27" +{DSK}kaplan>Local>medley3.5>git-medley>sources>ATBL.;15) (* ; " @@ -14,8 +15,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (PRETTYCOMPRINT ATBLCOMS) (RPAQQ ATBLCOMS - [(E (RESETSAVE (RADIX 8))) - (COMS (* ; + [(COMS (* ;  "Common features of read and terminal tables") (DECLARE%: DONTCOPY (EXPORT (MACROS \SYNCODE \SETSYNCODE) (RECORDS CHARTABLE)) @@ -107,7 +107,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. ) (DECLARE%: EVAL@COMPILE -(DATATYPE CHARTABLE ((CHARSET0 400Q BYTE) +(DATATYPE CHARTABLE ((CHARSET0 256 BYTE) (NSCHARHASH FULLPOINTER))) ) @@ -129,270 +129,270 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE FULLPOINTER) '((CHARTABLE 0 (BITS . 7)) - (CHARTABLE 0 (BITS . 207Q)) + (CHARTABLE 0 (BITS . 135)) (CHARTABLE 1 (BITS . 7)) - (CHARTABLE 1 (BITS . 207Q)) + (CHARTABLE 1 (BITS . 135)) (CHARTABLE 2 (BITS . 7)) - (CHARTABLE 2 (BITS . 207Q)) + (CHARTABLE 2 (BITS . 135)) (CHARTABLE 3 (BITS . 7)) - (CHARTABLE 3 (BITS . 207Q)) + (CHARTABLE 3 (BITS . 135)) (CHARTABLE 4 (BITS . 7)) - (CHARTABLE 4 (BITS . 207Q)) + (CHARTABLE 4 (BITS . 135)) (CHARTABLE 5 (BITS . 7)) - (CHARTABLE 5 (BITS . 207Q)) + (CHARTABLE 5 (BITS . 135)) (CHARTABLE 6 (BITS . 7)) - (CHARTABLE 6 (BITS . 207Q)) + (CHARTABLE 6 (BITS . 135)) (CHARTABLE 7 (BITS . 7)) - (CHARTABLE 7 (BITS . 207Q)) - (CHARTABLE 10Q (BITS . 7)) - (CHARTABLE 10Q (BITS . 207Q)) - (CHARTABLE 11Q (BITS . 7)) - (CHARTABLE 11Q (BITS . 207Q)) - (CHARTABLE 12Q (BITS . 7)) - (CHARTABLE 12Q (BITS . 207Q)) - (CHARTABLE 13Q (BITS . 7)) - (CHARTABLE 13Q (BITS . 207Q)) - (CHARTABLE 14Q (BITS . 7)) - (CHARTABLE 14Q (BITS . 207Q)) - (CHARTABLE 15Q (BITS . 7)) - (CHARTABLE 15Q (BITS . 207Q)) - (CHARTABLE 16Q (BITS . 7)) - (CHARTABLE 16Q (BITS . 207Q)) - (CHARTABLE 17Q (BITS . 7)) - (CHARTABLE 17Q (BITS . 207Q)) - (CHARTABLE 20Q (BITS . 7)) - (CHARTABLE 20Q (BITS . 207Q)) - (CHARTABLE 21Q (BITS . 7)) - (CHARTABLE 21Q (BITS . 207Q)) - (CHARTABLE 22Q (BITS . 7)) - (CHARTABLE 22Q (BITS . 207Q)) - (CHARTABLE 23Q (BITS . 7)) - (CHARTABLE 23Q (BITS . 207Q)) - (CHARTABLE 24Q (BITS . 7)) - (CHARTABLE 24Q (BITS . 207Q)) - (CHARTABLE 25Q (BITS . 7)) - (CHARTABLE 25Q (BITS . 207Q)) - (CHARTABLE 26Q (BITS . 7)) - (CHARTABLE 26Q (BITS . 207Q)) - (CHARTABLE 27Q (BITS . 7)) - (CHARTABLE 27Q (BITS . 207Q)) - (CHARTABLE 30Q (BITS . 7)) - (CHARTABLE 30Q (BITS . 207Q)) - (CHARTABLE 31Q (BITS . 7)) - (CHARTABLE 31Q (BITS . 207Q)) - (CHARTABLE 32Q (BITS . 7)) - (CHARTABLE 32Q (BITS . 207Q)) - (CHARTABLE 33Q (BITS . 7)) - (CHARTABLE 33Q (BITS . 207Q)) - (CHARTABLE 34Q (BITS . 7)) - (CHARTABLE 34Q (BITS . 207Q)) - (CHARTABLE 35Q (BITS . 7)) - (CHARTABLE 35Q (BITS . 207Q)) - (CHARTABLE 36Q (BITS . 7)) - (CHARTABLE 36Q (BITS . 207Q)) - (CHARTABLE 37Q (BITS . 7)) - (CHARTABLE 37Q (BITS . 207Q)) - (CHARTABLE 40Q (BITS . 7)) - (CHARTABLE 40Q (BITS . 207Q)) - (CHARTABLE 41Q (BITS . 7)) - (CHARTABLE 41Q (BITS . 207Q)) - (CHARTABLE 42Q (BITS . 7)) - (CHARTABLE 42Q (BITS . 207Q)) - (CHARTABLE 43Q (BITS . 7)) - (CHARTABLE 43Q (BITS . 207Q)) - (CHARTABLE 44Q (BITS . 7)) - (CHARTABLE 44Q (BITS . 207Q)) - (CHARTABLE 45Q (BITS . 7)) - (CHARTABLE 45Q (BITS . 207Q)) - (CHARTABLE 46Q (BITS . 7)) - (CHARTABLE 46Q (BITS . 207Q)) - (CHARTABLE 47Q (BITS . 7)) - (CHARTABLE 47Q (BITS . 207Q)) - (CHARTABLE 50Q (BITS . 7)) - (CHARTABLE 50Q (BITS . 207Q)) - (CHARTABLE 51Q (BITS . 7)) - (CHARTABLE 51Q (BITS . 207Q)) - (CHARTABLE 52Q (BITS . 7)) - (CHARTABLE 52Q (BITS . 207Q)) - (CHARTABLE 53Q (BITS . 7)) - (CHARTABLE 53Q (BITS . 207Q)) - (CHARTABLE 54Q (BITS . 7)) - (CHARTABLE 54Q (BITS . 207Q)) - (CHARTABLE 55Q (BITS . 7)) - (CHARTABLE 55Q (BITS . 207Q)) - (CHARTABLE 56Q (BITS . 7)) - (CHARTABLE 56Q (BITS . 207Q)) - (CHARTABLE 57Q (BITS . 7)) - (CHARTABLE 57Q (BITS . 207Q)) - (CHARTABLE 60Q (BITS . 7)) - (CHARTABLE 60Q (BITS . 207Q)) - (CHARTABLE 61Q (BITS . 7)) - (CHARTABLE 61Q (BITS . 207Q)) - (CHARTABLE 62Q (BITS . 7)) - (CHARTABLE 62Q (BITS . 207Q)) - (CHARTABLE 63Q (BITS . 7)) - (CHARTABLE 63Q (BITS . 207Q)) - (CHARTABLE 64Q (BITS . 7)) - (CHARTABLE 64Q (BITS . 207Q)) - (CHARTABLE 65Q (BITS . 7)) - (CHARTABLE 65Q (BITS . 207Q)) - (CHARTABLE 66Q (BITS . 7)) - (CHARTABLE 66Q (BITS . 207Q)) - (CHARTABLE 67Q (BITS . 7)) - (CHARTABLE 67Q (BITS . 207Q)) - (CHARTABLE 70Q (BITS . 7)) - (CHARTABLE 70Q (BITS . 207Q)) - (CHARTABLE 71Q (BITS . 7)) - (CHARTABLE 71Q (BITS . 207Q)) - (CHARTABLE 72Q (BITS . 7)) - (CHARTABLE 72Q (BITS . 207Q)) - (CHARTABLE 73Q (BITS . 7)) - (CHARTABLE 73Q (BITS . 207Q)) - (CHARTABLE 74Q (BITS . 7)) - (CHARTABLE 74Q (BITS . 207Q)) - (CHARTABLE 75Q (BITS . 7)) - (CHARTABLE 75Q (BITS . 207Q)) - (CHARTABLE 76Q (BITS . 7)) - (CHARTABLE 76Q (BITS . 207Q)) - (CHARTABLE 77Q (BITS . 7)) - (CHARTABLE 77Q (BITS . 207Q)) - (CHARTABLE 100Q (BITS . 7)) - (CHARTABLE 100Q (BITS . 207Q)) - (CHARTABLE 101Q (BITS . 7)) - (CHARTABLE 101Q (BITS . 207Q)) - (CHARTABLE 102Q (BITS . 7)) - (CHARTABLE 102Q (BITS . 207Q)) - (CHARTABLE 103Q (BITS . 7)) - (CHARTABLE 103Q (BITS . 207Q)) - (CHARTABLE 104Q (BITS . 7)) - (CHARTABLE 104Q (BITS . 207Q)) - (CHARTABLE 105Q (BITS . 7)) - (CHARTABLE 105Q (BITS . 207Q)) - (CHARTABLE 106Q (BITS . 7)) - (CHARTABLE 106Q (BITS . 207Q)) - (CHARTABLE 107Q (BITS . 7)) - (CHARTABLE 107Q (BITS . 207Q)) - (CHARTABLE 110Q (BITS . 7)) - (CHARTABLE 110Q (BITS . 207Q)) - (CHARTABLE 111Q (BITS . 7)) - (CHARTABLE 111Q (BITS . 207Q)) - (CHARTABLE 112Q (BITS . 7)) - (CHARTABLE 112Q (BITS . 207Q)) - (CHARTABLE 113Q (BITS . 7)) - (CHARTABLE 113Q (BITS . 207Q)) - (CHARTABLE 114Q (BITS . 7)) - (CHARTABLE 114Q (BITS . 207Q)) - (CHARTABLE 115Q (BITS . 7)) - (CHARTABLE 115Q (BITS . 207Q)) - (CHARTABLE 116Q (BITS . 7)) - (CHARTABLE 116Q (BITS . 207Q)) - (CHARTABLE 117Q (BITS . 7)) - (CHARTABLE 117Q (BITS . 207Q)) - (CHARTABLE 120Q (BITS . 7)) - (CHARTABLE 120Q (BITS . 207Q)) - (CHARTABLE 121Q (BITS . 7)) - (CHARTABLE 121Q (BITS . 207Q)) - (CHARTABLE 122Q (BITS . 7)) - (CHARTABLE 122Q (BITS . 207Q)) - (CHARTABLE 123Q (BITS . 7)) - (CHARTABLE 123Q (BITS . 207Q)) - (CHARTABLE 124Q (BITS . 7)) - (CHARTABLE 124Q (BITS . 207Q)) - (CHARTABLE 125Q (BITS . 7)) - (CHARTABLE 125Q (BITS . 207Q)) - (CHARTABLE 126Q (BITS . 7)) - (CHARTABLE 126Q (BITS . 207Q)) - (CHARTABLE 127Q (BITS . 7)) - (CHARTABLE 127Q (BITS . 207Q)) - (CHARTABLE 130Q (BITS . 7)) - (CHARTABLE 130Q (BITS . 207Q)) - (CHARTABLE 131Q (BITS . 7)) - (CHARTABLE 131Q (BITS . 207Q)) - (CHARTABLE 132Q (BITS . 7)) - (CHARTABLE 132Q (BITS . 207Q)) - (CHARTABLE 133Q (BITS . 7)) - (CHARTABLE 133Q (BITS . 207Q)) - (CHARTABLE 134Q (BITS . 7)) - (CHARTABLE 134Q (BITS . 207Q)) - (CHARTABLE 135Q (BITS . 7)) - (CHARTABLE 135Q (BITS . 207Q)) - (CHARTABLE 136Q (BITS . 7)) - (CHARTABLE 136Q (BITS . 207Q)) - (CHARTABLE 137Q (BITS . 7)) - (CHARTABLE 137Q (BITS . 207Q)) - (CHARTABLE 140Q (BITS . 7)) - (CHARTABLE 140Q (BITS . 207Q)) - (CHARTABLE 141Q (BITS . 7)) - (CHARTABLE 141Q (BITS . 207Q)) - (CHARTABLE 142Q (BITS . 7)) - (CHARTABLE 142Q (BITS . 207Q)) - (CHARTABLE 143Q (BITS . 7)) - (CHARTABLE 143Q (BITS . 207Q)) - (CHARTABLE 144Q (BITS . 7)) - (CHARTABLE 144Q (BITS . 207Q)) - (CHARTABLE 145Q (BITS . 7)) - (CHARTABLE 145Q (BITS . 207Q)) - (CHARTABLE 146Q (BITS . 7)) - (CHARTABLE 146Q (BITS . 207Q)) - (CHARTABLE 147Q (BITS . 7)) - (CHARTABLE 147Q (BITS . 207Q)) - (CHARTABLE 150Q (BITS . 7)) - (CHARTABLE 150Q (BITS . 207Q)) - (CHARTABLE 151Q (BITS . 7)) - (CHARTABLE 151Q (BITS . 207Q)) - (CHARTABLE 152Q (BITS . 7)) - (CHARTABLE 152Q (BITS . 207Q)) - (CHARTABLE 153Q (BITS . 7)) - (CHARTABLE 153Q (BITS . 207Q)) - (CHARTABLE 154Q (BITS . 7)) - (CHARTABLE 154Q (BITS . 207Q)) - (CHARTABLE 155Q (BITS . 7)) - (CHARTABLE 155Q (BITS . 207Q)) - (CHARTABLE 156Q (BITS . 7)) - (CHARTABLE 156Q (BITS . 207Q)) - (CHARTABLE 157Q (BITS . 7)) - (CHARTABLE 157Q (BITS . 207Q)) - (CHARTABLE 160Q (BITS . 7)) - (CHARTABLE 160Q (BITS . 207Q)) - (CHARTABLE 161Q (BITS . 7)) - (CHARTABLE 161Q (BITS . 207Q)) - (CHARTABLE 162Q (BITS . 7)) - (CHARTABLE 162Q (BITS . 207Q)) - (CHARTABLE 163Q (BITS . 7)) - (CHARTABLE 163Q (BITS . 207Q)) - (CHARTABLE 164Q (BITS . 7)) - (CHARTABLE 164Q (BITS . 207Q)) - (CHARTABLE 165Q (BITS . 7)) - (CHARTABLE 165Q (BITS . 207Q)) - (CHARTABLE 166Q (BITS . 7)) - (CHARTABLE 166Q (BITS . 207Q)) - (CHARTABLE 167Q (BITS . 7)) - (CHARTABLE 167Q (BITS . 207Q)) - (CHARTABLE 170Q (BITS . 7)) - (CHARTABLE 170Q (BITS . 207Q)) - (CHARTABLE 171Q (BITS . 7)) - (CHARTABLE 171Q (BITS . 207Q)) - (CHARTABLE 172Q (BITS . 7)) - (CHARTABLE 172Q (BITS . 207Q)) - (CHARTABLE 173Q (BITS . 7)) - (CHARTABLE 173Q (BITS . 207Q)) - (CHARTABLE 174Q (BITS . 7)) - (CHARTABLE 174Q (BITS . 207Q)) - (CHARTABLE 175Q (BITS . 7)) - (CHARTABLE 175Q (BITS . 207Q)) - (CHARTABLE 176Q (BITS . 7)) - (CHARTABLE 176Q (BITS . 207Q)) - (CHARTABLE 177Q (BITS . 7)) - (CHARTABLE 177Q (BITS . 207Q)) - (CHARTABLE 200Q FULLPOINTER)) - '202Q) + (CHARTABLE 7 (BITS . 135)) + (CHARTABLE 8 (BITS . 7)) + (CHARTABLE 8 (BITS . 135)) + (CHARTABLE 9 (BITS . 7)) + (CHARTABLE 9 (BITS . 135)) + (CHARTABLE 10 (BITS . 7)) + (CHARTABLE 10 (BITS . 135)) + (CHARTABLE 11 (BITS . 7)) + (CHARTABLE 11 (BITS . 135)) + (CHARTABLE 12 (BITS . 7)) + (CHARTABLE 12 (BITS . 135)) + (CHARTABLE 13 (BITS . 7)) + (CHARTABLE 13 (BITS . 135)) + (CHARTABLE 14 (BITS . 7)) + (CHARTABLE 14 (BITS . 135)) + (CHARTABLE 15 (BITS . 7)) + (CHARTABLE 15 (BITS . 135)) + (CHARTABLE 16 (BITS . 7)) + (CHARTABLE 16 (BITS . 135)) + (CHARTABLE 17 (BITS . 7)) + (CHARTABLE 17 (BITS . 135)) + (CHARTABLE 18 (BITS . 7)) + (CHARTABLE 18 (BITS . 135)) + (CHARTABLE 19 (BITS . 7)) + (CHARTABLE 19 (BITS . 135)) + (CHARTABLE 20 (BITS . 7)) + (CHARTABLE 20 (BITS . 135)) + (CHARTABLE 21 (BITS . 7)) + (CHARTABLE 21 (BITS . 135)) + (CHARTABLE 22 (BITS . 7)) + (CHARTABLE 22 (BITS . 135)) + (CHARTABLE 23 (BITS . 7)) + (CHARTABLE 23 (BITS . 135)) + (CHARTABLE 24 (BITS . 7)) + (CHARTABLE 24 (BITS . 135)) + (CHARTABLE 25 (BITS . 7)) + (CHARTABLE 25 (BITS . 135)) + (CHARTABLE 26 (BITS . 7)) + (CHARTABLE 26 (BITS . 135)) + (CHARTABLE 27 (BITS . 7)) + (CHARTABLE 27 (BITS . 135)) + (CHARTABLE 28 (BITS . 7)) + (CHARTABLE 28 (BITS . 135)) + (CHARTABLE 29 (BITS . 7)) + (CHARTABLE 29 (BITS . 135)) + (CHARTABLE 30 (BITS . 7)) + (CHARTABLE 30 (BITS . 135)) + (CHARTABLE 31 (BITS . 7)) + (CHARTABLE 31 (BITS . 135)) + (CHARTABLE 32 (BITS . 7)) + (CHARTABLE 32 (BITS . 135)) + (CHARTABLE 33 (BITS . 7)) + (CHARTABLE 33 (BITS . 135)) + (CHARTABLE 34 (BITS . 7)) + (CHARTABLE 34 (BITS . 135)) + (CHARTABLE 35 (BITS . 7)) + (CHARTABLE 35 (BITS . 135)) + (CHARTABLE 36 (BITS . 7)) + (CHARTABLE 36 (BITS . 135)) + (CHARTABLE 37 (BITS . 7)) + (CHARTABLE 37 (BITS . 135)) + (CHARTABLE 38 (BITS . 7)) + (CHARTABLE 38 (BITS . 135)) + (CHARTABLE 39 (BITS . 7)) + (CHARTABLE 39 (BITS . 135)) + (CHARTABLE 40 (BITS . 7)) + (CHARTABLE 40 (BITS . 135)) + (CHARTABLE 41 (BITS . 7)) + (CHARTABLE 41 (BITS . 135)) + (CHARTABLE 42 (BITS . 7)) + (CHARTABLE 42 (BITS . 135)) + (CHARTABLE 43 (BITS . 7)) + (CHARTABLE 43 (BITS . 135)) + (CHARTABLE 44 (BITS . 7)) + (CHARTABLE 44 (BITS . 135)) + (CHARTABLE 45 (BITS . 7)) + (CHARTABLE 45 (BITS . 135)) + (CHARTABLE 46 (BITS . 7)) + (CHARTABLE 46 (BITS . 135)) + (CHARTABLE 47 (BITS . 7)) + (CHARTABLE 47 (BITS . 135)) + (CHARTABLE 48 (BITS . 7)) + (CHARTABLE 48 (BITS . 135)) + (CHARTABLE 49 (BITS . 7)) + (CHARTABLE 49 (BITS . 135)) + (CHARTABLE 50 (BITS . 7)) + (CHARTABLE 50 (BITS . 135)) + (CHARTABLE 51 (BITS . 7)) + (CHARTABLE 51 (BITS . 135)) + (CHARTABLE 52 (BITS . 7)) + (CHARTABLE 52 (BITS . 135)) + (CHARTABLE 53 (BITS . 7)) + (CHARTABLE 53 (BITS . 135)) + (CHARTABLE 54 (BITS . 7)) + (CHARTABLE 54 (BITS . 135)) + (CHARTABLE 55 (BITS . 7)) + (CHARTABLE 55 (BITS . 135)) + (CHARTABLE 56 (BITS . 7)) + (CHARTABLE 56 (BITS . 135)) + (CHARTABLE 57 (BITS . 7)) + (CHARTABLE 57 (BITS . 135)) + (CHARTABLE 58 (BITS . 7)) + (CHARTABLE 58 (BITS . 135)) + (CHARTABLE 59 (BITS . 7)) + (CHARTABLE 59 (BITS . 135)) + (CHARTABLE 60 (BITS . 7)) + (CHARTABLE 60 (BITS . 135)) + (CHARTABLE 61 (BITS . 7)) + (CHARTABLE 61 (BITS . 135)) + (CHARTABLE 62 (BITS . 7)) + (CHARTABLE 62 (BITS . 135)) + (CHARTABLE 63 (BITS . 7)) + (CHARTABLE 63 (BITS . 135)) + (CHARTABLE 64 (BITS . 7)) + (CHARTABLE 64 (BITS . 135)) + (CHARTABLE 65 (BITS . 7)) + (CHARTABLE 65 (BITS . 135)) + (CHARTABLE 66 (BITS . 7)) + (CHARTABLE 66 (BITS . 135)) + (CHARTABLE 67 (BITS . 7)) + (CHARTABLE 67 (BITS . 135)) + (CHARTABLE 68 (BITS . 7)) + (CHARTABLE 68 (BITS . 135)) + (CHARTABLE 69 (BITS . 7)) + (CHARTABLE 69 (BITS . 135)) + (CHARTABLE 70 (BITS . 7)) + (CHARTABLE 70 (BITS . 135)) + (CHARTABLE 71 (BITS . 7)) + (CHARTABLE 71 (BITS . 135)) + (CHARTABLE 72 (BITS . 7)) + (CHARTABLE 72 (BITS . 135)) + (CHARTABLE 73 (BITS . 7)) + (CHARTABLE 73 (BITS . 135)) + (CHARTABLE 74 (BITS . 7)) + (CHARTABLE 74 (BITS . 135)) + (CHARTABLE 75 (BITS . 7)) + (CHARTABLE 75 (BITS . 135)) + (CHARTABLE 76 (BITS . 7)) + (CHARTABLE 76 (BITS . 135)) + (CHARTABLE 77 (BITS . 7)) + (CHARTABLE 77 (BITS . 135)) + (CHARTABLE 78 (BITS . 7)) + (CHARTABLE 78 (BITS . 135)) + (CHARTABLE 79 (BITS . 7)) + (CHARTABLE 79 (BITS . 135)) + (CHARTABLE 80 (BITS . 7)) + (CHARTABLE 80 (BITS . 135)) + (CHARTABLE 81 (BITS . 7)) + (CHARTABLE 81 (BITS . 135)) + (CHARTABLE 82 (BITS . 7)) + (CHARTABLE 82 (BITS . 135)) + (CHARTABLE 83 (BITS . 7)) + (CHARTABLE 83 (BITS . 135)) + (CHARTABLE 84 (BITS . 7)) + (CHARTABLE 84 (BITS . 135)) + (CHARTABLE 85 (BITS . 7)) + (CHARTABLE 85 (BITS . 135)) + (CHARTABLE 86 (BITS . 7)) + (CHARTABLE 86 (BITS . 135)) + (CHARTABLE 87 (BITS . 7)) + (CHARTABLE 87 (BITS . 135)) + (CHARTABLE 88 (BITS . 7)) + (CHARTABLE 88 (BITS . 135)) + (CHARTABLE 89 (BITS . 7)) + (CHARTABLE 89 (BITS . 135)) + (CHARTABLE 90 (BITS . 7)) + (CHARTABLE 90 (BITS . 135)) + (CHARTABLE 91 (BITS . 7)) + (CHARTABLE 91 (BITS . 135)) + (CHARTABLE 92 (BITS . 7)) + (CHARTABLE 92 (BITS . 135)) + (CHARTABLE 93 (BITS . 7)) + (CHARTABLE 93 (BITS . 135)) + (CHARTABLE 94 (BITS . 7)) + (CHARTABLE 94 (BITS . 135)) + (CHARTABLE 95 (BITS . 7)) + (CHARTABLE 95 (BITS . 135)) + (CHARTABLE 96 (BITS . 7)) + (CHARTABLE 96 (BITS . 135)) + (CHARTABLE 97 (BITS . 7)) + (CHARTABLE 97 (BITS . 135)) + (CHARTABLE 98 (BITS . 7)) + (CHARTABLE 98 (BITS . 135)) + (CHARTABLE 99 (BITS . 7)) + (CHARTABLE 99 (BITS . 135)) + (CHARTABLE 100 (BITS . 7)) + (CHARTABLE 100 (BITS . 135)) + (CHARTABLE 101 (BITS . 7)) + (CHARTABLE 101 (BITS . 135)) + (CHARTABLE 102 (BITS . 7)) + (CHARTABLE 102 (BITS . 135)) + (CHARTABLE 103 (BITS . 7)) + (CHARTABLE 103 (BITS . 135)) + (CHARTABLE 104 (BITS . 7)) + (CHARTABLE 104 (BITS . 135)) + (CHARTABLE 105 (BITS . 7)) + (CHARTABLE 105 (BITS . 135)) + (CHARTABLE 106 (BITS . 7)) + (CHARTABLE 106 (BITS . 135)) + (CHARTABLE 107 (BITS . 7)) + (CHARTABLE 107 (BITS . 135)) + (CHARTABLE 108 (BITS . 7)) + (CHARTABLE 108 (BITS . 135)) + (CHARTABLE 109 (BITS . 7)) + (CHARTABLE 109 (BITS . 135)) + (CHARTABLE 110 (BITS . 7)) + (CHARTABLE 110 (BITS . 135)) + (CHARTABLE 111 (BITS . 7)) + (CHARTABLE 111 (BITS . 135)) + (CHARTABLE 112 (BITS . 7)) + (CHARTABLE 112 (BITS . 135)) + (CHARTABLE 113 (BITS . 7)) + (CHARTABLE 113 (BITS . 135)) + (CHARTABLE 114 (BITS . 7)) + (CHARTABLE 114 (BITS . 135)) + (CHARTABLE 115 (BITS . 7)) + (CHARTABLE 115 (BITS . 135)) + (CHARTABLE 116 (BITS . 7)) + (CHARTABLE 116 (BITS . 135)) + (CHARTABLE 117 (BITS . 7)) + (CHARTABLE 117 (BITS . 135)) + (CHARTABLE 118 (BITS . 7)) + (CHARTABLE 118 (BITS . 135)) + (CHARTABLE 119 (BITS . 7)) + (CHARTABLE 119 (BITS . 135)) + (CHARTABLE 120 (BITS . 7)) + (CHARTABLE 120 (BITS . 135)) + (CHARTABLE 121 (BITS . 7)) + (CHARTABLE 121 (BITS . 135)) + (CHARTABLE 122 (BITS . 7)) + (CHARTABLE 122 (BITS . 135)) + (CHARTABLE 123 (BITS . 7)) + (CHARTABLE 123 (BITS . 135)) + (CHARTABLE 124 (BITS . 7)) + (CHARTABLE 124 (BITS . 135)) + (CHARTABLE 125 (BITS . 7)) + (CHARTABLE 125 (BITS . 135)) + (CHARTABLE 126 (BITS . 7)) + (CHARTABLE 126 (BITS . 135)) + (CHARTABLE 127 (BITS . 7)) + (CHARTABLE 127 (BITS . 135)) + (CHARTABLE 128 FULLPOINTER)) + '130) (* "END EXPORTED DEFINITIONS") (DECLARE%: EVAL@COMPILE -(RPAQQ \NSCHARHASHKEYS 12Q) +(RPAQQ \NSCHARHASHKEYS 10) (RPAQQ \NSCHARHASHOVERFLOW 1.3) @@ -412,7 +412,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (DEFINEQ (GETSYNTAX - [LAMBDA (CH TABLE) (* bvm%: " 8-Mar-86 17:22") + [LAMBDA (CH TABLE) (* bvm%: " 8-Mar-86 17:22") (COND [(FIXP (SETQ CH (\GETCHARCODE CH))) (COND @@ -423,31 +423,33 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (COND ((SETQ TEM (\READCLASSTOCODE CH)) (SETQ CHARTBL (fetch READSA of (\GTREADTABLE TABLE T))) - (\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY) - (DECLARE (USEDFREE TEM RESULT)) - (COND - ((EQ TEM VAL) - (push RESULT KEY] + (\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY) + (DECLARE (USEDFREE TEM RESULT)) + (COND + ((EQ TEM VAL) + (push RESULT KEY] CHARTBL)) ((EQ CH 'BREAK) (SETQ CHARTBL (fetch READSA of (\GTREADTABLE TABLE T))) - (\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY) - (DECLARE (USEDFREE TEM RESULT)) - (COND - ((fetch BREAK of VAL) - (push RESULT KEY] + (\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY) + (DECLARE (USEDFREE TEM RESULT)) + (COND + ((fetch BREAK of VAL) + (push RESULT KEY] CHARTBL)) ((SETQ TEM (\TERMCLASSTOCODE CH)) (SETQ CHARTBL (fetch TERMSA of (\GTTERMTABLE TABLE T))) - (\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY) - (DECLARE (USEDFREE TEM RESULT)) - (COND - ((EQ TEM (fetch TERMCLASS of VAL)) - (push RESULT (PROG1 KEY + (\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY) + (DECLARE (USEDFREE TEM RESULT)) + (COND + ((EQ TEM (fetch TERMCLASS of VAL)) + (push RESULT (PROG1 KEY (* SELECTC TEM ((LIST NONE.TC - WORDSEPR.TC) (* ; - "Only these classes have multiple members") - KEY) (RETURN (CONS KEY)))] + WORDSEPR.TC) (* ; + "Only these classes have multiple members") + KEY) + (RETURN (CONS KEY))) + )] CHARTBL)) [(FMEMB CH '(MACRO SPLICE INFIX)) (PROG [LST (A (fetch READMACRODEFS of (\GTREADTABLE TABLE T] @@ -458,33 +460,33 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (RETURN LST] ((SETQ TEM (fetch (CONTEXTS VAL) of CH)) (SETQ CHARTBL (fetch READSA of (\GTREADTABLE TABLE T))) - (\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY) - (DECLARE (USEDFREE TEM RESULT)) - (COND - ((EQ TEM (fetch MACROCONTEXT of VAL)) - (push RESULT KEY] + (\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY) + (DECLARE (USEDFREE TEM RESULT)) + (COND + ((EQ TEM (fetch MACROCONTEXT of VAL)) + (push RESULT KEY] CHARTBL)) ((SETQ TEM (fetch (WAKEUPS VAL) of CH)) (SETQ CHARTBL (fetch READSA of (\GTREADTABLE TABLE T))) - (\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY) - (DECLARE (USEDFREE TEM RESULT)) - (COND - ((EQ TEM (fetch WAKEUP of VAL)) - (push RESULT KEY] + (\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY) + (DECLARE (USEDFREE TEM RESULT)) + (COND + ((EQ TEM (fetch WAKEUP of VAL)) + (push RESULT KEY] CHARTBL)) ((SETQ TEM (fetch (ESCAPES VAL) of CH)) (SETQ CHARTBL (fetch READSA of (\GTREADTABLE TABLE T))) - (\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY) - (DECLARE (USEDFREE TEM RESULT)) - (COND - ((EQ TEM (fetch ESCAPE of VAL)) - (push RESULT KEY] + (\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY) + (DECLARE (USEDFREE TEM RESULT)) + (COND + ((EQ TEM (fetch ESCAPE of VAL)) + (push RESULT KEY] CHARTBL)) (T (\ILLEGAL.ARG CH))) (RETURN RESULT]) (SETSYNTAX - [LAMBDA (CHAR CLASS TBL) (* rmk%: "20-Nov-84 15:47") + [LAMBDA (CHAR CLASS TBL) (* rmk%: "20-Nov-84 15:47") (OR (FIXP (SETQ CHAR (\GETCHARCODE CHAR))) (\ILLEGAL.ARG CHAR)) [OR (type? READTABLEP TBL) @@ -512,47 +514,57 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (\SETTERMSYNTAX CHAR CLASS TBL]) (SYNTAXP - [LAMBDA (CODE CLASS TABLE) (* rmk%: " 5-JUN-80 22:40") + [LAMBDA (CODE CLASS TABLE) (* rmk%: " 5-JUN-80 22:40") (PROG (D) (RETURN (COND ((EQ CLASS 'BREAK) - (fetch BREAK of (\SYNCODE (fetch READSA of (\GTREADTABLE TABLE)) - CODE))) + (fetch BREAK of (\SYNCODE (fetch READSA of (\GTREADTABLE + TABLE)) + CODE))) ((SETQ D (\READCLASSTOCODE CLASS)) (EQ D (\SYNCODE (fetch READSA of (\GTREADTABLE TABLE)) CODE))) [(SETQ D (\TERMCLASSTOCODE CLASS)) - (EQ D (fetch TERMCLASS of (\SYNCODE (fetch TERMSA of (\GTTERMTABLE TABLE)) - CODE] + (EQ D (fetch TERMCLASS of (\SYNCODE (fetch TERMSA + of (\GTTERMTABLE TABLE)) + CODE] [(FMEMB CLASS '(MACRO SPLICE INFIX)) (AND (SETQ D (fetch READMACRODEFS of (\GTREADTABLE TABLE))) (EQ CLASS (fetch MACROTYPE of (GETHASH CODE D] [(SETQ D (fetch (CONTEXTS VAL) of CLASS)) - (EQ D (fetch MACROCONTEXT of (\SYNCODE (fetch READSA of (\GTREADTABLE TABLE)) - CODE] + (EQ D (fetch MACROCONTEXT of (\SYNCODE (fetch READSA + of (\GTREADTABLE + TABLE)) + CODE] [(SETQ D (fetch (WAKEUPS VAL) of CLASS)) - (EQ D (fetch WAKEUP of (\SYNCODE (fetch READSA of (\GTREADTABLE TABLE)) - CODE] + (EQ D (fetch WAKEUP of (\SYNCODE (fetch READSA of ( + \GTREADTABLE + TABLE)) + CODE] [(SETQ D (fetch (ESCAPES VAL) of CLASS)) - (EQ D (fetch ESCAPE of (\SYNCODE (fetch READSA of (\GTREADTABLE TABLE)) - CODE] + (EQ D (fetch ESCAPE of (\SYNCODE (fetch READSA of ( + \GTREADTABLE + TABLE)) + CODE] (T (\ILLEGAL.ARG CLASS]) (\COPYSYNTAX - [LAMBDA (A B) (* gbn "15-Sep-85 22:36") - - (* ;; "Copies chartable A into chartable B") + [LAMBDA (A B) (* gbn "15-Sep-85 22:36") + + (* ;; "Copies chartable A into chartable B") (CHECK (AND (type? CHARTABLE A) (type? CHARTABLE B))) (\MOVEBYTES A 0 B 0 (ADD1 \MAXTHINCHAR)) (COND ((fetch (CHARTABLE NSCHARHASH) of A) - (replace (CHARTABLE NSCHARHASH) of B with (REHASH (fetch (CHARTABLE NSCHARHASH) of A) - (\CREATENSCHARHASH]) + (replace (CHARTABLE NSCHARHASH) of B with (REHASH (fetch (CHARTABLE + NSCHARHASH) + of A) + (\CREATENSCHARHASH]) (\GETCHARCODE - [LAMBDA (C) (* rmk%: "20-Nov-84 15:46") + [LAMBDA (C) (* rmk%: "20-Nov-84 15:46") (COND ((AND (NUMBERP C) (\CHARCODEP (FIX C))) @@ -563,25 +575,27 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (T C]) (\SETFATSYNCODE - [LAMBDA (TABLE CHAR CODE) (* bvm%: " 8-Mar-86 17:03") + [LAMBDA (TABLE CHAR CODE) (* bvm%: " 8-Mar-86 17:03") (* ;;; "Called by \SETSYNCODE macro for fat characters") (SETQ TABLE (\DTEST TABLE 'CHARTABLE)) (* ; - "CODE = 0 is REAL.CCE, NONE.TC, OTHER.RC") + "CODE = 0 is REAL.CCE, NONE.TC, OTHER.RC") (COND ((ILEQ CHAR \MAXTHINCHAR) (\PUTBASEBYTE TABLE CHAR CODE)) ((EQ 0 CODE) (COND - ((fetch (CHARTABLE NSCHARHASH) of TABLE) (* ; - "there was already a table here so record the change") + ((fetch (CHARTABLE NSCHARHASH) of TABLE) (* ; + "there was already a table here so record the change") (PUTHASH CHAR CODE (fetch (CHARTABLE NSCHARHASH) of TABLE))) (T (* ; - "No hashtable yet, and only the default is being stored, so don't build the hashtable") + "No hashtable yet, and only the default is being stored, so don't build the hashtable") 0))) (T (PUTHASH CHAR CODE (OR (fetch (CHARTABLE NSCHARHASH) of TABLE) - (replace (CHARTABLE NSCHARHASH) of TABLE with (\CREATENSCHARHASH]) + (replace (CHARTABLE NSCHARHASH) of TABLE with ( + \CREATENSCHARHASH + ]) (\MAPCHARTABLE [LAMBDA (FN CHARTBL) (* ; "Edited 20-Apr-2018 16:53 by rmk:") @@ -600,43 +614,48 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (DEFINEQ (CONTROL - [LAMBDA (MODE TTBL) (* rmk%: " 8-FEB-80 11:59") + [LAMBDA (MODE TTBL) (* rmk%: " 8-FEB-80 11:59") (PROG1 (fetch CONTROLFLG of (SETQ TTBL (\GTTERMTABLE TTBL))) - (replace CONTROLFLG of TTBL with (AND MODE T]) + (replace CONTROLFLG of TTBL with (AND MODE T)))]) (COPYTERMTABLE - [LAMBDA (TTBL) (* lmm "14-APR-81 14:27") + [LAMBDA (TTBL) (* lmm "14-APR-81 14:27") (create TERMTABLEP using (SETQ TTBL (\GTTERMTABLE TTBL T)) - TERMSA _ (create CHARTABLE using (fetch TERMSA of TTBL]) + TERMSA _ (create CHARTABLE using (fetch TERMSA + of TTBL]) (DELETECONTROL - [LAMBDA (TYPE MESSAGE TTBL) (* lmm " 1-Jan-85 21:34") + [LAMBDA (TYPE MESSAGE TTBL) (* lmm " 1-Jan-85 21:34") (PROG [VAL (TBL (\GTTERMTABLE TTBL (NULL MESSAGE] (SETQ VAL (SELECTQ TYPE ((ECHO NOECHO) (PROG1 (fetch DELCHARECHO of TBL) (replace DELCHARECHO of TBL with TYPE))) (DELCHARECHO (PROG1 (fetch DELCHARECHO of TBL) - (SELECTQ MESSAGE - (NIL (* ; "Called only to get current value")) - ((ECHO NOECHO) - (replace DELCHARECHO of TBL with MESSAGE)) - (LISPERROR "ILLEGAL ARG" MESSAGE)))) + (SELECTQ MESSAGE + (NIL (* ; + "Called only to get current value")) + ((ECHO NOECHO) + (replace DELCHARECHO of TBL with + MESSAGE)) + (LISPERROR "ILLEGAL ARG" MESSAGE)))) ((LINEDELETE DELETELINE) - [PROG1 (fetch LINEDELETE of TBL) - (AND MESSAGE (replace LINEDELETE of TBL with (\LITCHECK MESSAGE]) - (1STCHDEL [PROG1 (fetch 1STCHDEL of TBL) - (AND MESSAGE (replace 1STCHDEL of TBL with (\LITCHECK - MESSAGE]) - (NTHCHDEL [PROG1 (fetch NTHCHDEL of TBL) - (AND MESSAGE (replace NTHCHDEL of TBL with (\LITCHECK - MESSAGE]) - (POSTCHDEL [PROG1 (fetch POSTCHDEL of TBL) - (AND MESSAGE (replace POSTCHDEL of TBL with (\LITCHECK - MESSAGE]) - (EMPTYCHDEL [PROG1 (fetch EMPTYCHDEL of TBL) - (AND MESSAGE (replace EMPTYCHDEL of TBL - with (\LITCHECK MESSAGE]) + (PROG1 (fetch LINEDELETE of TBL) + (AND MESSAGE (replace LINEDELETE of TBL with + (\LITCHECK + MESSAGE))))) + (1STCHDEL (PROG1 (fetch 1STCHDEL of TBL) + (AND MESSAGE (replace 1STCHDEL of TBL + with (\LITCHECK MESSAGE))))) + (NTHCHDEL (PROG1 (fetch NTHCHDEL of TBL) + (AND MESSAGE (replace NTHCHDEL of TBL + with (\LITCHECK MESSAGE))))) + (POSTCHDEL (PROG1 (fetch POSTCHDEL of TBL) + (AND MESSAGE (replace POSTCHDEL of TBL + with (\LITCHECK MESSAGE))))) + (EMPTYCHDEL (PROG1 (fetch EMPTYCHDEL of TBL) + (AND MESSAGE (replace EMPTYCHDEL of TBL + with (\LITCHECK MESSAGE))))) (LISPERROR "ILLEGAL ARG" TYPE))) (RETURN (COND ((STRINGP VAL) @@ -644,7 +663,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (T VAL]) (GETDELETECONTROL - [LAMBDA (TYPE TTBL) (* lmm " 1-Jan-85 21:20") + [LAMBDA (TYPE TTBL) (* lmm " 1-Jan-85 21:20") (PROG (TBL VAL) (SETQ TBL (\GTTERMTABLE TTBL T)) (SETQ VAL (SELECTQ TYPE @@ -664,7 +683,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (T VAL]) (ECHOCHAR - [LAMBDA (CHARCODE MODE TTBL) (* lmm " 1-Jan-85 21:29") + [LAMBDA (CHARCODE MODE TTBL) (* lmm " 1-Jan-85 21:29") (COND ((LISTP CHARCODE) (for X in CHARCODE do (ECHOCHAR X MODE TTBL))) @@ -674,38 +693,38 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (IGNORE.CCE 'IGNORE) (SIMULATE.CCE 'SIMULATE) 'INDICATE) - (AND MODE (\SETSYNCODE SA CHARCODE (create TERMCODE - using B CCECHO _ - (SELECTQ MODE - (REAL REAL.CCE) - (IGNORE IGNORE.CCE) - (SIMULATE SIMULATE.CCE) - ((INDICATE UPARROW) - INDICATE.CCE) - (\ILLEGAL.ARG MODE]) + [AND MODE (\SETSYNCODE SA CHARCODE (create TERMCODE + using B CCECHO _ + (SELECTQ MODE + (REAL REAL.CCE) + (IGNORE IGNORE.CCE) + (SIMULATE SIMULATE.CCE) + ((INDICATE UPARROW) + INDICATE.CCE) + (\ILLEGAL.ARG MODE])]) (ECHOCONTROL - [LAMBDA (CHAR MODE TTBL) (* rmk%: "20-Nov-84 15:14") + [LAMBDA (CHAR MODE TTBL) (* rmk%: "20-Nov-84 15:14") (PROG ((C (\GETCHARCODE CHAR))) (OR [AND (\THINCHARCODEP C) - (OR (ILESSP C 40Q) + (OR (ILESSP C 32) (AND (IGEQ C (CHARCODE A)) (ILEQ C (CHARCODE Z)) - (SETQ C (IDIFFERENCE C 100Q] + (SETQ C (IDIFFERENCE C 64] (\ILLEGAL.ARG C)) (RETURN (ECHOCHAR C MODE TTBL]) (ECHOMODE - [LAMBDA (FLG TTBL) (* rmk%: " 8-FEB-80 11:57") + [LAMBDA (FLG TTBL) (* rmk%: " 8-FEB-80 11:57") (PROG1 (fetch ECHOFLG of (SETQ TTBL (\GTTERMTABLE TTBL))) - (replace ECHOFLG of TTBL with (AND FLG T]) + (replace ECHOFLG of TTBL with (AND FLG T)))]) (GETECHOMODE - [LAMBDA (TTBL) (* lmm " 1-Jan-85 21:21") + [LAMBDA (TTBL) (* lmm " 1-Jan-85 21:21") (fetch ECHOFLG of (\GTTERMTABLE TTBL T]) (GETCONTROL - [LAMBDA (TTBL) (* lmm " 1-Jan-85 21:21") + [LAMBDA (TTBL) (* lmm " 1-Jan-85 21:21") (fetch CONTROLFLG of (\GTTERMTABLE TTBL T]) (GETTERMTABLE @@ -713,19 +732,19 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (\GTTERMTABLE TTBL NIL]) (RAISE - [LAMBDA (FLG TTBL) (* bvm%: "14-Feb-85 00:17") + [LAMBDA (FLG TTBL) (* bvm%: "14-Feb-85 00:17") (PROG1 (fetch RAISEFLG of (SETQ TTBL (\GTTERMTABLE TTBL))) - (replace RAISEFLG of TTBL with (COND - ((EQ FLG 0) - 0) - (FLG T]) + (replace RAISEFLG of TTBL with (COND + ((EQ FLG 0) + 0) + (FLG T))))]) (GETRAISE - [LAMBDA (TTBL) (* lmm " 1-Jan-85 21:21") + [LAMBDA (TTBL) (* lmm " 1-Jan-85 21:21") (fetch RAISEFLG of (\GTTERMTABLE TTBL T]) (RESETTERMTABLE - [LAMBDA (TTBL FROM) (* lmm "14-APR-81 14:34") + [LAMBDA (TTBL FROM) (* lmm "14-APR-81 14:34") (PROG ((FR (\GTTERMTABLE FROM T)) (TT (\GTTERMTABLE TTBL))) (\COPYSYNTAX (fetch TERMSA of FR) @@ -742,22 +761,22 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (RETURN TT]) (SETTERMTABLE - [LAMBDA (TBL) (* rmk%: " 8-FEB-80 12:16") - (PROG1 \PRIMTERMTABLE (SETQ \PRIMTERMSA (fetch TERMSA of (SETQ \PRIMTERMTABLE (\GTTERMTABLE - TBL]) + [LAMBDA (TBL) (* rmk%: " 8-FEB-80 12:16") + (PROG1 \PRIMTERMTABLE + [SETQ \PRIMTERMSA (fetch TERMSA of (SETQ \PRIMTERMTABLE (\GTTERMTABLE TBL])]) (TERMTABLEP - [LAMBDA (TTBL) (* rmk%: "20-FEB-80 12:29") + [LAMBDA (TTBL) (* rmk%: "20-FEB-80 12:29") (AND (type? TERMTABLEP TTBL) TTBL]) (\GETTERMSYNTAX - [LAMBDA (C TBL) (* rmk%: "24-APR-80 09:44") + [LAMBDA (C TBL) (* rmk%: "24-APR-80 09:44") (\TERMCODETOCLASS (fetch TERMCLASS of (\SYNCODE (fetch TERMSA of TBL) - C]) + C]) (\GTTERMTABLE - [LAMBDA (TTBL FLG) (* lmm " 6-MAY-80 20:35") + [LAMBDA (TTBL FLG) (* lmm " 6-MAY-80 20:35") (COND ((type? TERMTABLEP TTBL) TTBL) @@ -769,15 +788,15 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (T (LISPERROR "ILLEGAL TERMINAL TABLE" TTBL]) (\ORIGTERMTABLE - [LAMBDA NIL (* rrb " 5-Oct-85 10:33") - - (* ;; "Creates the original terminal table") - - (* ;; "must be created with a hash table big enough to hold all of the indicates in character set 1 because this gets evaluated in the loadup before HASHOVERFLOW is defined. rrb 5-oct-85") + [LAMBDA NIL (* rrb " 5-Oct-85 10:33") + + (* ;; "Creates the original terminal table") + + (* ;; "must be created with a hash table big enough to hold all of the indicates in character set 1 because this gets evaluated in the loadup before HASHOVERFLOW is defined. rrb 5-oct-85") (PROG ((TBL (create TERMTABLEP TERMSA _ (create CHARTABLE - NSCHARHASH _ (\CREATENSCHARHASH 454Q)) + NSCHARHASH _ (\CREATENSCHARHASH 300)) DELCHARECHO _ 'ECHO ECHOFLG _ T LINEDELETE _ "## @@ -788,23 +807,23 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. EMPTYCHDEL _ "## "))) (PROGN (\SETTERMSYNTAX (SELECTQ (SYSTEMTYPE) - ((TENEX D) - (CHARCODE ^A)) - ((JERICHO VAX TOPS-20) - (CHARCODE DEL)) - (SHOULDNT)) + ((TENEX D) + (CHARCODE ^A)) + ((JERICHO VAX TOPS-20) + (CHARCODE DEL)) + (SHOULDNT)) 'CHARDELETE TBL) (\SETTERMSYNTAX (CHARCODE ^H) 'CHARDELETE TBL) (* ; - "Added ^H as a CHARDELETE character 9/30/85") + "Added ^H as a CHARDELETE character 9/30/85") (\SETTERMSYNTAX (CHARCODE ^W) 'WORDDELETE TBL) (\SETTERMSYNTAX (SELECTQ (SYSTEMTYPE) - ((TENEX D) - (CHARCODE ^Q)) - ((JERICHO VAX) - (CHARCODE ^U)) - (SHOULDNT)) + ((TENEX D) + (CHARCODE ^Q)) + ((JERICHO VAX) + (CHARCODE ^U)) + (SHOULDNT)) 'LINEDELETE TBL) (\SETTERMSYNTAX (CHARCODE ^R) 'RETYPE TBL) @@ -813,10 +832,10 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (\SETTERMSYNTAX (CHARCODE EOL) 'WAKEUPCHAR TBL) (for C - in (CHARCODE (SPACE TAB ! @ %# $ ~ & * - = + %| { } ^ _ %: ; < > %, %. ? /)) - do (\SETTERMSYNTAX C 'WORDSEPR TBL))) - (PROGN (ECHOCHAR (CHARCODE (NULL ^A ^B ^C ^D ^E ^F ^H ^K ^L ^N ^O ^P ^Q ^R ^S ^T ^U ^V ^W - ^X ^Y ^Z ^\ ^%] ^^)) + in (CHARCODE (SPACE TAB ! @ %# $ ~ & * - = + %| { } ^ _ %: ; < > %, + %. ? /)) do (\SETTERMSYNTAX C 'WORDSEPR TBL))) + (PROGN (ECHOCHAR (CHARCODE (NULL ^A ^B ^C ^D ^E ^F ^H ^K ^L ^N ^O ^P ^Q ^R ^S ^T ^U ^V + ^W ^X ^Y ^Z ^\ ^%] ^^)) 'INDICATE TBL) (ECHOCHAR (CHARCODE (BELL TAB LF CR)) 'REAL TBL) @@ -825,29 +844,32 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. 'IGNORE TBL) (ECHOCHAR (CHARCODE (BELL TAB ESCAPE LF TENEXEOL)) 'SIMULATE TBL)) - (JERICHO (ECHOCHAR [CONSTANT (CONS ERASECHARCODE (CHARCODE (BELL TAB ESCAPE EOL] + (JERICHO (ECHOCHAR [CONSTANT (CONS ERASECHARCODE + (CHARCODE (BELL TAB ESCAPE EOL] 'SIMULATE TBL)) (VAX (ECHOCHAR (CHARCODE (TAB ESCAPE EOL DEL)) 'SIMULATE TBL)) NIL)) - (for C from 200Q to \MAXTHINCHAR do (ECHOCHAR C 'REAL TBL)) - (for C from (CHARCODE 1,0) to (CHARCODE 1,377) do (ECHOCHAR C 'INDICATE TBL)) + (for C from 128 to \MAXTHINCHAR do (ECHOCHAR C 'REAL TBL)) + (for C from (CHARCODE 1,0) to (CHARCODE 1,377) do (ECHOCHAR + C + 'INDICATE TBL)) (RETURN TBL]) (\SETTERMSYNTAX - [LAMBDA (C CLASS TBL) (* rmk%: "26-Mar-85 23:45") - - (* ;; "Changes the terminal syntax class for charcode C. Unlike Interlisp-10, does not turn off previous characters for CHARDELETE, etc. classes") + [LAMBDA (C CLASS TBL) (* rmk%: "26-Mar-85 23:45") + + (* ;; "Changes the terminal syntax class for charcode C. Unlike Interlisp-10, does not turn off previous characters for CHARDELETE, etc. classes") (\SETSYNCODE (fetch TERMSA of TBL) C (create TERMCODE using (\SYNCODE (fetch TERMSA of TBL) - C) - TERMCLASS _ (OR (\TERMCLASSTOCODE CLASS) - (LISPERROR "ILLEGAL ARG" CLASS]) + C) + TERMCLASS _ (OR (\TERMCLASSTOCODE CLASS) + (LISPERROR "ILLEGAL ARG" CLASS]) (\TERMCLASSTOCODE - [LAMBDA (CLASS) (* rmk%: "11-FEB-82 21:24") + [LAMBDA (CLASS) (* rmk%: "11-FEB-82 21:24") (SELECTQ CLASS ((EOL WAKEUPCHAR) EOL.TC) @@ -862,7 +884,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. NIL]) (\TERMCODETOCLASS - [LAMBDA (CODE) (* rmk%: "11-FEB-82 21:24") + [LAMBDA (CODE) (* rmk%: "11-FEB-82 21:24") (SELECTC CODE (EOL.TC 'EOL) (NONE.TC 'NONE) @@ -875,10 +897,10 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. NIL]) (\LITCHECK - [LAMBDA (X) (* rmk%: "11-FEB-82 21:26") + [LAMBDA (X) (* rmk%: "11-FEB-82 21:26") (COND ((EQ X 'BACKUP) (* ; - "Means take terminal/implementation dependent backup action") + "Means take terminal/implementation dependent backup action") X) ((LITATOM X) (MKSTRING X)) @@ -893,11 +915,11 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (RPAQQ REAL.CCE 0) -(RPAQQ IGNORE.CCE 10Q) +(RPAQQ IGNORE.CCE 8) -(RPAQQ SIMULATE.CCE 20Q) +(RPAQQ SIMULATE.CCE 16) -(RPAQQ INDICATE.CCE 30Q) +(RPAQQ INDICATE.CCE 24) (CONSTANTS REAL.CCE IGNORE.CCE SIMULATE.CCE INDICATE.CCE) @@ -928,7 +950,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. ) (DECLARE%: EVAL@COMPILE -(ACCESSFNS TERMCODE ((CCECHO (LOGAND DATUM 30Q)) +(ACCESSFNS TERMCODE ((CCECHO (LOGAND DATUM 24)) (TERMCLASS (LOGAND DATUM 7))) (* ;  "We assume that values are appropriately shifted") (CREATE (LOGOR CCECHO TERMCLASS))) @@ -945,13 +967,13 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (TERMTABLEP 2 POINTER) (TERMTABLEP 4 POINTER) (TERMTABLEP 6 POINTER) - (TERMTABLEP 10Q POINTER) - (TERMTABLEP 12Q POINTER) - (TERMTABLEP 14Q POINTER) - (TERMTABLEP 16Q POINTER) - (TERMTABLEP 16Q (FLAGBITS . 0)) - (TERMTABLEP 16Q (FLAGBITS . 20Q))) - '20Q) + (TERMTABLEP 8 POINTER) + (TERMTABLEP 10 POINTER) + (TERMTABLEP 12 POINTER) + (TERMTABLEP 14 POINTER) + (TERMTABLEP 14 (FLAGBITS . 0)) + (TERMTABLEP 14 (FLAGBITS . 16))) + '16) (* "END EXPORTED DEFINITIONS") @@ -963,13 +985,13 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (TERMTABLEP 2 POINTER) (TERMTABLEP 4 POINTER) (TERMTABLEP 6 POINTER) - (TERMTABLEP 10Q POINTER) - (TERMTABLEP 12Q POINTER) - (TERMTABLEP 14Q POINTER) - (TERMTABLEP 16Q POINTER) - (TERMTABLEP 16Q (FLAGBITS . 0)) - (TERMTABLEP 16Q (FLAGBITS . 20Q))) - '20Q) + (TERMTABLEP 8 POINTER) + (TERMTABLEP 10 POINTER) + (TERMTABLEP 12 POINTER) + (TERMTABLEP 14 POINTER) + (TERMTABLEP 14 (FLAGBITS . 0)) + (TERMTABLEP 14 (FLAGBITS . 16))) + '16) @@ -978,47 +1000,47 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (DEFINEQ (COPYREADTABLE - [LAMBDA (RDTBL) (* rmk%: " 2-FEB-80 12:26") + [LAMBDA (RDTBL) (* rmk%: " 2-FEB-80 12:26") (RESETREADTABLE (create READTABLEP) (\GTREADTABLE RDTBL T]) (FIND-READTABLE - [LAMBDA (NAME) (* bvm%: "27-Jul-86 15:53") + [LAMBDA (NAME) (* bvm%: "27-Jul-86 15:53") (GETHASH NAME \READTABLEHASH]) (IN-READTABLE - [LAMBDA (RDTBL) (* bvm%: "27-Jul-86 15:55") + [LAMBDA (RDTBL) (* bvm%: "27-Jul-86 15:55") (SETQ *READTABLE* (\GTREADTABLE RDTBL T]) (ESCAPE - [LAMBDA (FLG RDTBL) (* rmk%: " 1-FEB-80 13:12") + [LAMBDA (FLG RDTBL) (* rmk%: " 1-FEB-80 13:12") (PROG1 (fetch ESCAPEFLG of (SETQ RDTBL (\GTREADTABLE RDTBL))) - (replace ESCAPEFLG of RDTBL with (NEQ FLG NIL]) + (replace ESCAPEFLG of RDTBL with (NEQ FLG NIL)))]) (GETBRK - [LAMBDA (RDTBL) (* rmk%: " 2-MAY-80 17:04") + [LAMBDA (RDTBL) (* rmk%: " 2-MAY-80 17:04") (GETSYNTAX 'BREAK RDTBL]) (GETREADTABLE - [LAMBDA (RDTBL) (* lmm%: 4-FEB-76 3 62Q) + [LAMBDA (RDTBL) (* lmm%: 4-FEB-76 3 50) (\GTREADTABLE RDTBL]) (GETSEPR - [LAMBDA (RDTBL) (* rmk%: " 2-MAY-80 17:05") + [LAMBDA (RDTBL) (* rmk%: " 2-MAY-80 17:05") (GETSYNTAX 'SEPR RDTBL]) (READMACROS - [LAMBDA (FLG RDTBL) (* rmk%: " 1-FEB-80 13:11") + [LAMBDA (FLG RDTBL) (* rmk%: " 1-FEB-80 13:11") (PROG1 (fetch READMACROFLG of (SETQ RDTBL (\GTREADTABLE RDTBL))) - (replace READMACROFLG of RDTBL with (NEQ FLG NIL]) + (replace READMACROFLG of RDTBL with (NEQ FLG NIL)))]) (READTABLEP - [LAMBDA (RDTBL) (* rmk%: "20-FEB-80 12:32") + [LAMBDA (RDTBL) (* rmk%: "20-FEB-80 12:32") (AND (type? READTABLEP RDTBL) RDTBL]) (READTABLEPROP - [LAMBDA ARGS (* bvm%: "28-Aug-86 15:28") + [LAMBDA ARGS (* bvm%: "28-Aug-86 15:28") (COND ((LESSP ARGS 2) (\ILLEGAL.ARG NIL)) @@ -1029,74 +1051,75 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (NEWVALUE (AND (EQ ARGS 3) (ARG ARGS 3] (SELECTQ (ARG ARGS 2) - (NUMBERBASE [PROG1 (fetch (READTABLEP NUMBERBASE) of RDTBL) - (COND - (NEWVALUEP (replace (READTABLEP NUMBERBASE) of RDTBL - with NEWVALUE]) + (NUMBERBASE (PROG1 (fetch (READTABLEP NUMBERBASE) of RDTBL) + (COND + (NEWVALUEP (replace (READTABLEP NUMBERBASE) + of RDTBL with NEWVALUE))))) (NAME [LET ((OLDNAME (fetch (READTABLEP READTBLNAME) of RDTBL))) - (PROG1 OLDNAME (COND - (NEWVALUEP (COND - (OLDNAME (REMHASH OLDNAME - \READTABLEHASH))) - (replace (READTABLEP READTBLNAME) of RDTBL - with NEWVALUE) - (PUTHASH NEWVALUE RDTBL \READTABLEHASH]) - (COMMONLISP [PROG1 (fetch (READTABLEP COMMONLISP) of RDTBL) - (COND - (NEWVALUEP (replace (READTABLEP COMMONLISP) of RDTBL - with NEWVALUE) - (if NEWVALUE - then (* ; - "COMMONLISP implies COMMONNUMSYNTAX and not USESILPACKAGE") - (replace (READTABLEP COMMONNUMSYNTAX) - of RDTBL with T) - (replace (READTABLEP USESILPACKAGE) - of RDTBL with NIL]) + (PROG1 OLDNAME + (COND + (NEWVALUEP (COND + (OLDNAME (REMHASH OLDNAME \READTABLEHASH))) + (replace (READTABLEP READTBLNAME) of RDTBL + with NEWVALUE) + (PUTHASH NEWVALUE RDTBL \READTABLEHASH))))]) + (COMMONLISP (PROG1 (fetch (READTABLEP COMMONLISP) of RDTBL) + [COND + (NEWVALUEP (replace (READTABLEP COMMONLISP) + of RDTBL with NEWVALUE) + (if NEWVALUE + then (* ; + "COMMONLISP implies COMMONNUMSYNTAX and not USESILPACKAGE") + (replace (READTABLEP COMMONNUMSYNTAX) + of RDTBL with T) + (replace (READTABLEP USESILPACKAGE) + of RDTBL with NIL])) (COMMONNUMSYNTAX - [PROG1 (fetch (READTABLEP COMMONNUMSYNTAX) of RDTBL) - (COND - (NEWVALUEP (replace (READTABLEP COMMONNUMSYNTAX) of RDTBL - with NEWVALUE]) - (USESILPACKAGE [PROG1 (fetch (READTABLEP USESILPACKAGE) of RDTBL) - (COND - (NEWVALUEP (replace (READTABLEP USESILPACKAGE) - of RDTBL with NEWVALUE]) - (CASEINSENSITIVE - [PROG1 (fetch (READTABLEP CASEINSENSITIVE) of RDTBL) - (COND - (NEWVALUEP (replace (READTABLEP CASEINSENSITIVE) of RDTBL - with NEWVALUE]) - (ESCAPECHAR [PROG1 (fetch (READTABLEP ESCAPECHAR) of RDTBL) + (PROG1 (fetch (READTABLEP COMMONNUMSYNTAX) of RDTBL) + (COND + (NEWVALUEP (replace (READTABLEP COMMONNUMSYNTAX) of RDTBL + with NEWVALUE))))) + (USESILPACKAGE (PROG1 (fetch (READTABLEP USESILPACKAGE) of RDTBL) (COND - (NEWVALUEP (\SETREADSYNTAX NEWVALUE 'ESCAPE RDTBL) - (replace (READTABLEP ESCAPECHAR) of RDTBL - with NEWVALUE]) + (NEWVALUEP (replace (READTABLEP USESILPACKAGE) + of RDTBL with NEWVALUE))))) + (CASEINSENSITIVE + (PROG1 (fetch (READTABLEP CASEINSENSITIVE) of RDTBL) + (COND + (NEWVALUEP (replace (READTABLEP CASEINSENSITIVE) of RDTBL + with NEWVALUE))))) + (ESCAPECHAR (PROG1 (fetch (READTABLEP ESCAPECHAR) of RDTBL) + (COND + (NEWVALUEP (\SETREADSYNTAX NEWVALUE 'ESCAPE RDTBL) + (replace (READTABLEP ESCAPECHAR) of RDTBL + with NEWVALUE))))) (MULTIPLE-ESCAPECHAR - [PROG1 (fetch (READTABLEP MULTESCAPECHAR) of RDTBL) - (COND - (NEWVALUEP (\SETREADSYNTAX NEWVALUE 'MULTIPLE-ESCAPE RDTBL) - (replace (READTABLEP MULTESCAPECHAR) of RDTBL with NEWVALUE]) - (PACKAGECHAR [PROG1 (fetch (READTABLEP PACKAGECHAR) of RDTBL) - (COND - (NEWVALUEP (\SETREADSYNTAX NEWVALUE 'PACKAGEDELIM RDTBL) - (replace (READTABLEP PACKAGECHAR) of RDTBL - with NEWVALUE]) - (HASHMACROCHAR [PROG1 (fetch (READTABLEP HASHMACROCHAR) of RDTBL) - (COND - (NEWVALUEP (\SETREADSYNTAX NEWVALUE - '(INFIX ALWAYS NONIMMEDIATE ESCQUOTE - READVBAR) RDTBL) - (replace (READTABLEP HASHMACROCHAR) of RDTBL - with NEWVALUE]) + (PROG1 (fetch (READTABLEP MULTESCAPECHAR) of RDTBL) + (COND + (NEWVALUEP (\SETREADSYNTAX NEWVALUE 'MULTIPLE-ESCAPE RDTBL) + (replace (READTABLEP MULTESCAPECHAR) of RDTBL + with NEWVALUE))))) + (PACKAGECHAR (PROG1 (fetch (READTABLEP PACKAGECHAR) of RDTBL) + (COND + (NEWVALUEP (\SETREADSYNTAX NEWVALUE 'PACKAGEDELIM RDTBL) + (replace (READTABLEP PACKAGECHAR) of RDTBL + with NEWVALUE))))) + (HASHMACROCHAR (PROG1 (fetch (READTABLEP HASHMACROCHAR) of RDTBL) + (COND + (NEWVALUEP (\SETREADSYNTAX NEWVALUE + '(INFIX ALWAYS NONIMMEDIATE ESCQUOTE + READVBAR) + RDTBL) + (replace (READTABLEP HASHMACROCHAR) + of RDTBL with NEWVALUE))))) (\ILLEGAL.ARG (ARG ARGS 2]) (RESETREADTABLE - [LAMBDA (RDTBL FROM) (* ; "Edited 12-Feb-2021 22:54 by larry") - (* ; - "Edited 20-Apr-2018 16:22 by rmk:") - (* bvm%: "27-Aug-86 22:28") + [LAMBDA (RDTBL FROM) (* ; "Edited 12-Feb-2021 22:54 by larry") + (* ; "Edited 20-Apr-2018 16:22 by rmk:") + (* bvm%: "27-Aug-86 22:28") - (* ;; "RMK: Copy the macrodefs") + (* ;; "RMK: Copy the macrodefs") [replace READMACROFLG of (SETQ RDTBL (\GTREADTABLE RDTBL)) with (fetch READMACROFLG of (SETQ FROM (\GTREADTABLE FROM T] @@ -1133,7 +1156,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. DISPATCHMACRODEFS) of FROM))) - (* ;; "Placeholder. If DISPATCHMACRODEFS ends up containing a CHARTABLE or a hash table, will have to do a REHASH or \COPYSYNTAX as well") + (* ;; "Placeholder. If DISPATCHMACRODEFS ends up containing a CHARTABLE or a hash table, will have to do a REHASH or \COPYSYNTAX as well") [LET ((RDEFS (fetch (READTABLEP READMACRODEFS) of RDTBL)) (FDEFS (fetch (READTABLEP READMACRODEFS) of FROM))) @@ -1147,18 +1170,18 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. RDTBL]) (SETBRK - [LAMBDA (LST FLG RDTBL) (* rmk%: "13-AUG-81 00:01") + [LAMBDA (LST FLG RDTBL) (* rmk%: "13-AUG-81 00:01") (* ; - "This is a very ugly def which needs to be cleaned up cause a lot of people call SETBRK") + "This is a very ugly def which needs to be cleaned up cause a lot of people call SETBRK") (COND [(EQ LST T) [MAPC (GETSYNTAX 'BREAK RDTBL) (FUNCTION (LAMBDA (X) (SETSYNTAX X 'OTHER RDTBL] (MAPC (GETSYNTAX 'BREAK (COND - ((EQ RDTBL T) - 'ORIG) - (T T))) + ((EQ RDTBL T) + 'ORIG) + (T T))) (FUNCTION (LAMBDA (X) (SETSYNTAX X 'BREAK RDTBL] (T (SELECTQ FLG @@ -1178,22 +1201,23 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. NIL]) (SETREADTABLE - [LAMBDA (RDTBL FLG) (* bvm%: " 4-May-86 16:32") - (PROG1 *READTABLE* (SETQ *READTABLE* (\GTREADTABLE RDTBL]) + [LAMBDA (RDTBL FLG) (* bvm%: " 4-May-86 16:32") + (PROG1 *READTABLE* + (SETQ *READTABLE* (\GTREADTABLE RDTBL)))]) (SETSEPR - [LAMBDA (LST FLG RDTBL) (* rmk%: " 8-JUN-80 07:16") + [LAMBDA (LST FLG RDTBL) (* rmk%: " 8-JUN-80 07:16") (* ; - "This one also needs to be cleaned up") + "This one also needs to be cleaned up") (COND [(EQ LST T) [MAPC (GETSYNTAX 'SEPR RDTBL) (FUNCTION (LAMBDA (X) (SETSYNTAX X 'OTHER RDTBL] (MAPC (GETSYNTAX 'SEPR (COND - ((EQ RDTBL T) - 'ORIG) - (T T))) + ((EQ RDTBL T) + 'ORIG) + (T T))) (FUNCTION (LAMBDA (X) (SETSYNTAX X 'SEPR RDTBL] (T (SELECTQ FLG @@ -1212,32 +1236,33 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. NIL]) (\GETREADSYNTAX - [LAMBDA (C TBL) (* bvm%: "30-Jun-86 17:49") + [LAMBDA (C TBL) (* bvm%: "30-Jun-86 17:49") (LET ((B (\SYNCODE (fetch READSA of TBL) C))) - - (* ;; "This will turn into a SELECTQ that keys off syntax code numbers and produces class tokens. The default clause at the end: if it's not a built-in class, must be a macro") - - (* ;; "Sample code:") + + (* ;; "This will turn into a SELECTQ that keys off syntax code numbers and produces class tokens. The default clause at the end: if it's not a built-in class, must be a macro") + + (* ;; "Sample code:") (* (SELECTQ B (0 (QUOTE OTHER)) - (140Q (QUOTE SEPRCHAR)) - (160Q (QUOTE BREAKCHAR)) - (161Q (QUOTE STRINGDELIM)) - (162Q (QUOTE LEFTPAREN)) - (163Q (QUOTE RIGHTPAREN)) - (164Q (QUOTE LEFTBRACKET)) - (165Q (QUOTE RIGHTBRACKET)) - (106Q (QUOTE ESCAPE)) - (107Q (QUOTE MULTIPLE-ESCAPE)) - (105Q (QUOTE PACKAGEDELIM)) )) + (96 (QUOTE SEPRCHAR)) + (112 (QUOTE BREAKCHAR)) + (113 (QUOTE STRINGDELIM)) + (114 (QUOTE LEFTPAREN)) + (115 (QUOTE RIGHTPAREN)) + (116 (QUOTE LEFTBRACKET)) + (117 (QUOTE RIGHTBRACKET)) + (70 (QUOTE ESCAPE)) + (71 (QUOTE MULTIPLE-ESCAPE)) + (69 (QUOTE PACKAGEDELIM)) )) (\COMPUTED.FORM `(SELECTQ B (\,@ [for PAIR in READCLASSTOKENS collect (LIST (EVAL (CADR PAIR)) - (KWOTE (CAR PAIR]) + (KWOTE (CAR PAIR]) (LET ((E (\GETREADMACRODEF C TBL)) KEY) `(,(fetch MACROTYPE of E) - ,(fetch (CONTEXTS KEY) of (fetch MACROCONTEXT of B)) + ,(fetch (CONTEXTS KEY) of (fetch MACROCONTEXT + of B)) ,@(AND (NEQ (SETQ KEY (fetch (WAKEUPS KEY) of (fetch WAKEUP of B))) 'NONIMMEDIATE) @@ -1249,14 +1274,14 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. ,(fetch MACROFN of E]) (\GTREADTABLE - [LAMBDA (X FLG) (* bvm%: " 5-May-86 11:05") + [LAMBDA (X FLG) (* bvm%: " 5-May-86 11:05") (SELECTQ X ((NIL T) (\DTEST *READTABLE* 'READTABLEP)) (\GTREADTABLE1 X FLG]) (\GTREADTABLE1 - [LAMBDA (X FLG) (* bvm%: "27-Jul-86 15:37") + [LAMBDA (X FLG) (* bvm%: "27-Jul-86 15:37") (COND ((type? READTABLEP X) X) @@ -1264,24 +1289,24 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (T (LISPERROR "ILLEGAL READTABLE" X]) (\ORIGREADTABLE - [LAMBDA NIL (* ; "Edited 16-Apr-87 17:45 by bvm:") - - (* ;; "Creates a copy of the 'original' read-table.") + [LAMBDA NIL (* ; "Edited 16-Apr-87 17:45 by bvm:") + + (* ;; "Creates a copy of the 'original' read-table.") (PROG [(TBL (create READTABLEP READMACROFLG _ T ESCAPEFLG _ T - NUMBERBASE _ 12Q + NUMBERBASE _ 10 USESILPACKAGE _ T ESCAPECHAR _ (CHARCODE %%) PACKAGECHAR _ (PROGN - - (* ;; "Need to have a character for package delimiter in all read tables, but for old read tables want one that is unlikely to have appeared in a symbol in an old source file. Also would like it to be a 7-bit char, so we don't needlessly force MAKEFILE to produce binary files.") + + (* ;; "Need to have a character for package delimiter in all read tables, but for old read tables want one that is unlikely to have appeared in a symbol in an old source file. Also would like it to be a 7-bit char, so we don't needlessly force MAKEFILE to produce binary files.") (CHARCODE "^^")) HASHMACROCHAR _ (CHARCODE "|"] - - (* ;; "Actually, '|' is not defined in ORIG table, but rather later. But the radix printer and others want it, and this is better than nothing") + + (* ;; "Actually, '|' is not defined in ORIG table, but rather later. But the radix printer and others want it, and this is better than nothing") (SETSEPR (CHARCODE (SPACE TENEXEOL CR ^L LF TAB)) 1 TBL) @@ -1297,13 +1322,13 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. 'ESCAPE TBL) (\SETREADSYNTAX (CHARCODE %") 'STRINGDELIM TBL) - (\SETREADSYNTAX 247Q 'PACKAGEDELIM TBL) (* ; "Old choice for package delim char: the NS section symbol. Keep for compatibility with Lyric Beta files") + (\SETREADSYNTAX 167 'PACKAGEDELIM TBL) (* ; "Old choice for package delim char: the NS section symbol. Keep for compatibility with Lyric Beta files") (\SETREADSYNTAX (CHARCODE "^^") 'PACKAGEDELIM TBL) (RETURN TBL]) (\READCLASSTOCODE - [LAMBDA (CLASS) (* bvm%: " 9-Jul-85 00:43") + [LAMBDA (CLASS) (* bvm%: " 9-Jul-85 00:43") (* ;;; "This turns into a SELECTQ that goes from CLASS token to numeric code") @@ -1314,7 +1339,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. NIL]) (\SETMACROSYNTAX - [LAMBDA (C CLASS TBL) (* rmk%: " 3-Jan-84 13:20") + [LAMBDA (C CLASS TBL) (* rmk%: " 3-Jan-84 13:20") (OR (AND (FMEMB (CAR CLASS) '(MACRO SPLICE INFIX)) (CDR CLASS)) @@ -1335,8 +1360,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (\ILLEGAL.ARG CLASS)) [COND (A - - (* ;; "This hack guarantees that the hasharray will not overflow and cause an error in the uninterruptable PUTHASH below. If it didn't already have a value for C, then the macro bits are not set in C's syntax code, so the T value is harmless.") + (* ;; "This hack guarantees that the hasharray will not overflow and cause an error in the uninterruptable PUTHASH below. If it didn't already have a value for C, then the macro bits are not set in C's syntax code, so the T value is harmless.") (OR (GETHASH C A) (PUTHASH C T A))) @@ -1353,7 +1377,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (OR WAKEUP NONIMMEDIATE.RMW))))]) (\SETREADSYNTAX - [LAMBDA (C CLASS TBL) (* bvm%: " 8-Mar-86 16:37") + [LAMBDA (C CLASS TBL) (* bvm%: " 8-Mar-86 16:37") (PROG ((OLDSYNTAX (\SYNCODE (fetch (READTABLEP READSA) of TBL) C)) TEM) @@ -1363,28 +1387,28 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. ((fetch BREAK of OLDSYNTAX) (RETURN)) (T (SETQ CLASS 'BREAKCHAR] (* ; - "If already a BREAK character but also something else, like LPAR, leave it alone") + "If already a BREAK character but also something else, like LPAR, leave it alone") (COND ((LISTP CLASS) (\SETMACROSYNTAX C CLASS TBL)) ((SETQ TEM (\READCLASSTOCODE CLASS)) (UNINTERRUPTABLY [COND - ((fetch MACROP of OLDSYNTAX) (* ; "No longer a macro") + ((fetch MACROP of OLDSYNTAX) (* ; "No longer a macro") (REMHASH C (fetch READMACRODEFS of TBL] (\SETSYNCODE (fetch READSA of TBL) C TEM))) (T (\ILLEGAL.ARG CLASS]) (\READTABLEP.DEFPRINT - [LAMBDA (RDTBL STREAM) (* bvm%: "13-Oct-86 17:32") - - (* ;; "Print read table as, for example, #") + [LAMBDA (RDTBL STREAM) (* bvm%: "13-Oct-86 17:32") + + (* ;; "Print read table as, for example, #") (LET ((NAME (fetch (READTABLEP READTBLNAME) of RDTBL))) [.SPACECHECK. STREAM (IPLUS (CONSTANT (NCHARS "")) (PROGN (* ; "Longest address is `177,177777'") - 12Q) + 10) (COND (NAME (NCHARS NAME)) (T 0] @@ -1486,13 +1510,13 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. ) (DECLARE%: EVAL@COMPILE -(RPAQQ MACROBIT 10Q) +(RPAQQ MACROBIT 8) -(RPAQQ BREAKBIT 20Q) +(RPAQQ BREAKBIT 16) -(RPAQQ STOPATOMBIT 40Q) +(RPAQQ STOPATOMBIT 32) -(RPAQQ ESCAPEBIT 100Q) +(RPAQQ ESCAPEBIT 64) (RPAQQ INNERESCAPEBIT 4) @@ -1656,24 +1680,24 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. '((READTABLEP 0 POINTER) (READTABLEP 2 POINTER) (READTABLEP 2 (FLAGBITS . 0)) - (READTABLEP 2 (FLAGBITS . 20Q)) - (READTABLEP 2 (FLAGBITS . 40Q)) + (READTABLEP 2 (FLAGBITS . 16)) + (READTABLEP 2 (FLAGBITS . 32)) (READTABLEP 4 (BITS . 4)) - (READTABLEP 2 (FLAGBITS . 60Q)) + (READTABLEP 2 (FLAGBITS . 48)) (READTABLEP 0 (FLAGBITS . 0)) - (READTABLEP 0 (FLAGBITS . 20Q)) - (READTABLEP 0 (FLAGBITS . 40Q)) - (READTABLEP 0 (FLAGBITS . 60Q)) - (READTABLEP 4 (FLAGBITS . 120Q)) - (READTABLEP 4 (FLAGBITS . 140Q)) - (READTABLEP 4 (FLAGBITS . 160Q)) + (READTABLEP 0 (FLAGBITS . 16)) + (READTABLEP 0 (FLAGBITS . 32)) + (READTABLEP 0 (FLAGBITS . 48)) + (READTABLEP 4 (FLAGBITS . 80)) + (READTABLEP 4 (FLAGBITS . 96)) + (READTABLEP 4 (FLAGBITS . 112)) (READTABLEP 6 POINTER) (READTABLEP 5 (BITS . 7)) - (READTABLEP 5 (BITS . 207Q)) - (READTABLEP 4 (BITS . 207Q)) - (READTABLEP 10Q (BITS . 7)) - (READTABLEP 12Q POINTER)) - '14Q) + (READTABLEP 5 (BITS . 135)) + (READTABLEP 4 (BITS . 135)) + (READTABLEP 8 (BITS . 7)) + (READTABLEP 10 POINTER)) + '12) (* "END EXPORTED DEFINITIONS") @@ -1690,24 +1714,24 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. '((READTABLEP 0 POINTER) (READTABLEP 2 POINTER) (READTABLEP 2 (FLAGBITS . 0)) - (READTABLEP 2 (FLAGBITS . 20Q)) - (READTABLEP 2 (FLAGBITS . 40Q)) + (READTABLEP 2 (FLAGBITS . 16)) + (READTABLEP 2 (FLAGBITS . 32)) (READTABLEP 4 (BITS . 4)) - (READTABLEP 2 (FLAGBITS . 60Q)) + (READTABLEP 2 (FLAGBITS . 48)) (READTABLEP 0 (FLAGBITS . 0)) - (READTABLEP 0 (FLAGBITS . 20Q)) - (READTABLEP 0 (FLAGBITS . 40Q)) - (READTABLEP 0 (FLAGBITS . 60Q)) - (READTABLEP 4 (FLAGBITS . 120Q)) - (READTABLEP 4 (FLAGBITS . 140Q)) - (READTABLEP 4 (FLAGBITS . 160Q)) + (READTABLEP 0 (FLAGBITS . 16)) + (READTABLEP 0 (FLAGBITS . 32)) + (READTABLEP 0 (FLAGBITS . 48)) + (READTABLEP 4 (FLAGBITS . 80)) + (READTABLEP 4 (FLAGBITS . 96)) + (READTABLEP 4 (FLAGBITS . 112)) (READTABLEP 6 POINTER) (READTABLEP 5 (BITS . 7)) - (READTABLEP 5 (BITS . 207Q)) - (READTABLEP 4 (BITS . 207Q)) - (READTABLEP 10Q (BITS . 7)) - (READTABLEP 12Q POINTER)) - '14Q) + (READTABLEP 5 (BITS . 135)) + (READTABLEP 4 (BITS . 135)) + (READTABLEP 8 (BITS . 7)) + (READTABLEP 10 POINTER)) + '12) (RPAQ? \READTABLEHASH ) (DEFINEQ @@ -1725,7 +1749,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (* ;; "RMK: If reloading, don't smash an existing hash table") [OR (HARRAYP \READTABLEHASH) - (SETQ \READTABLEHASH (HASHARRAY 24Q NIL (FUNCTION STRING-EQUAL-HASHBITS) + (SETQ \READTABLEHASH (HASHARRAY 20 NIL (FUNCTION STRING-EQUAL-HASHBITS) (FUNCTION STRING-EQUAL] (LET (TRDTBL NEW-IL-RDTBL) (PROGN (* ; "The ORIG read table") @@ -1757,7 +1781,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (SETQ *OLD-INTERLISP-READ-ENVIRONMENT* (create READER-ENVIRONMENT REREADTABLE _ FILERDTBL - REBASE _ 12Q + REBASE _ 10 REFORMAT _ :XCCS)) (* ;  "need this to read files in the loadup") ) @@ -1770,9 +1794,9 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (READTABLEPROP NEW-IL-RDTBL 'COMMONNUMSYNTAX T) (READTABLEPROP NEW-IL-RDTBL 'USESILPACKAGE NIL) (READTABLEPROP NEW-IL-RDTBL 'NAME "INTERLISP") - (for I from 1 to 32Q do (SETSYNTAX I 'SEPRCHAR FILERDTBL) + (for I from 1 to 26 do (SETSYNTAX I 'SEPRCHAR FILERDTBL) (* ; "Make font switch chars seprs") - (SETSYNTAX I 'SEPRCHAR NEW-IL-RDTBL)) + (SETSYNTAX I 'SEPRCHAR NEW-IL-RDTBL)) (SETQ *READTABLE* NEW-IL-RDTBL)) (* ;; "Make ^Y like #. in the old T readtable and the new INTERLISP one.") @@ -1795,13 +1819,14 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. NIL]) ) -(/DECLAREDATATYPE 'READER-ENVIRONMENT '(POINTER POINTER POINTER POINTER POINTER) +(/DECLAREDATATYPE 'READER-ENVIRONMENT '(POINTER POINTER POINTER POINTER POINTER POINTER) '((READER-ENVIRONMENT 0 POINTER) (READER-ENVIRONMENT 2 POINTER) (READER-ENVIRONMENT 4 POINTER) (READER-ENVIRONMENT 6 POINTER) - (READER-ENVIRONMENT 10Q POINTER)) - '12Q) + (READER-ENVIRONMENT 8 POINTER) + (READER-ENVIRONMENT 10 POINTER)) + '12) @@ -1810,7 +1835,8 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (DEFINEQ (MAKE-READER-ENVIRONMENT - [LAMBDA (PACKAGE READTABLE BASE FORMAT) (* ; "Edited 28-Jun-2021 09:32 by rmk:") + [LAMBDA (PACKAGE READTABLE BASE FORMAT PACKAGEFORM READTABLEFORM) + (* ; "Edited 16-Aug-2021 23:44 by rmk:") (create READER-ENVIRONMENT REPACKAGE _ (COND (PACKAGE (\DTEST PACKAGE 'PACKAGE)) @@ -1821,10 +1847,12 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. REBASE _ (COND (BASE (\CHECKRADIX BASE)) (T *PRINT-BASE*)) - REFORMAT _ (OR FORMAT *DEFAULT-EXTERNALFORMAT*]) + REFORMAT _ (OR FORMAT *DEFAULT-EXTERNALFORMAT*) + REPACKAGEFORM _ PACKAGEFORM + REREADTABLEFORM _ READTABLEFORM]) (EQUAL-READER-ENVIRONMENT - [LAMBDA (ENV1 ENV2) (* ; "Edited 28-Jun-2021 09:37 by rmk:") + [LAMBDA (ENV1 ENV2) (* ; "Edited 16-Aug-2021 23:43 by rmk:") (* ; ":XCCS is the prehistoric value") (AND (EQ (fetch (READER-ENVIRONMENT REREADTABLE) of ENV1) (fetch (READER-ENVIRONMENT REREADTABLE) of ENV2)) @@ -1835,7 +1863,11 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (EQ (OR (fetch (READER-ENVIRONMENT REFORMAT) of ENV1) :XCCS) (OR (fetch (READER-ENVIRONMENT REFORMAT) of ENV2) - :XCCS]) + :XCCS)) + (EQUAL (fetch (READER-ENVIRONMENT REPACKAGEFORM) of ENV1) + (fetch (READER-ENVIRONMENT REPACKAGEFORM) of ENV2)) + (EQUAL (fetch (READER-ENVIRONMENT REREADTABLEFORM) of ENV1) + (fetch (READER-ENVIRONMENT REREADTABLEFORM) of ENV2]) (SET-READER-ENVIRONMENT [LAMBDA (ENV STREAM) (* ; "Edited 9-Jul-2021 14:42 by rmk:") @@ -1871,27 +1903,25 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (ADDTOVAR LAMA READTABLEPROP) ) -(PUTPROPS ATBL COPYRIGHT ("Venue & Xerox Corporation" 3676Q 3677Q 3700Q 3701Q 3702Q 3703Q 3706Q 3711Q -3742Q 3745Q)) +(PUTPROPS ATBL COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1993 2018 +2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (44154Q 67405Q (GETSYNTAX 44166Q . 55115Q) (SETSYNTAX 55117Q . 57204Q) (SYNTAXP 57206Q - . 62612Q) (\COPYSYNTAX 62614Q . 63677Q) (\GETCHARCODE 63701Q . 64345Q) (\SETFATSYNCODE 64347Q . -66522Q) (\MAPCHARTABLE 66524Q . 67403Q)) (67446Q 124234Q (CONTROL 67460Q . 70060Q) (COPYTERMTABLE -70062Q . 70524Q) (DELETECONTROL 70526Q . 75346Q) (GETDELETECONTROL 75350Q . 77256Q) (ECHOCHAR 77260Q - . 102156Q) (ECHOCONTROL 102160Q . 103100Q) (ECHOMODE 103102Q . 103474Q) (GETECHOMODE 103476Q . -103746Q) (GETCONTROL 103750Q . 104222Q) (GETTERMTABLE 104224Q . 104327Q) (RAISE 104331Q . 105153Q) ( -GETRAISE 105155Q . 105423Q) (RESETTERMTABLE 105425Q . 107525Q) (SETTERMTABLE 107527Q . 110216Q) ( -TERMTABLEP 110220Q . 110465Q) (\GETTERMSYNTAX 110467Q . 111076Q) (\GTTERMTABLE 111100Q . 111624Q) ( -\ORIGTERMTABLE 111626Q . 120467Q) (\SETTERMSYNTAX 120471Q . 121670Q) (\TERMCLASSTOCODE 121672Q . -122553Q) (\TERMCODETOCLASS 122555Q . 123364Q) (\LITCHECK 123366Q . 124232Q)) (131225Q 210205Q ( -COPYREADTABLE 131237Q . 131551Q) (FIND-READTABLE 131553Q . 132002Q) (IN-READTABLE 132004Q . 132250Q) ( -ESCAPE 132252Q . 132653Q) (GETBRK 132655Q . 133073Q) (GETREADTABLE 133075Q . 133306Q) (GETSEPR 133310Q - . 133526Q) (READMACROS 133530Q . 134143Q) (READTABLEP 134145Q . 134414Q) (READTABLEPROP 134416Q . -146614Q) (RESETREADTABLE 146616Q . 157136Q) (SETBRK 157140Q . 162244Q) (SETREADTABLE 162246Q . 162533Q -) (SETSEPR 162535Q . 165535Q) (\GETREADSYNTAX 165537Q . 172717Q) (\GTREADTABLE 172721Q . 173266Q) ( -\GTREADTABLE1 173270Q . 173674Q) (\ORIGREADTABLE 173676Q . 177515Q) (\READCLASSTOCODE 177517Q . -200426Q) (\SETMACROSYNTAX 200430Q . 204044Q) (\SETREADSYNTAX 204046Q . 206131Q) (\READTABLEP.DEFPRINT -206133Q . 210203Q)) (241721Q 252472Q (\ATBLSET 241733Q . 252470Q)) (253313Q 257342Q ( -MAKE-READER-ENVIRONMENT 253325Q . 254504Q) (EQUAL-READER-ENVIRONMENT 254506Q . 256214Q) ( -SET-READER-ENVIRONMENT 256216Q . 257340Q))))) + (FILEMAP (NIL (18106 29258 (GETSYNTAX 18116 . 22947) (SETSYNTAX 22949 . 24022) (SYNTAXP 24024 . 26521) + (\COPYSYNTAX 26523 . 27240) (\GETCHARCODE 27242 . 27530) (\SETFATSYNCODE 27532 . 28823) ( +\MAPCHARTABLE 28825 . 29256)) (29291 44378 (CONTROL 29301 . 29553) (COPYTERMTABLE 29555 . 29922) ( +DELETECONTROL 29924 . 32565) (GETDELETECONTROL 32567 . 33529) (ECHOCHAR 33531 . 34972) (ECHOCONTROL +34974 . 35431) (ECHOMODE 35433 . 35679) (GETECHOMODE 35681 . 35845) (GETCONTROL 35847 . 36013) ( +GETTERMTABLE 36015 . 36082) (RAISE 36084 . 36510) (GETRAISE 36512 . 36674) (RESETTERMTABLE 36676 . +37760) (SETTERMTABLE 37762 . 37996) (TERMTABLEP 37998 . 38159) (\GETTERMSYNTAX 38161 . 38432) ( +\GTTERMTABLE 38434 . 38770) (\ORIGTERMTABLE 38772 . 42503) (\SETTERMSYNTAX 42505 . 43140) ( +\TERMCLASSTOCODE 43142 . 43571) (\TERMCODETOCLASS 43573 . 43960) (\LITCHECK 43962 . 44376)) (46908 +70732 (COPYREADTABLE 46918 . 47116) (FIND-READTABLE 47118 . 47265) (IN-READTABLE 47267 . 47427) ( +ESCAPE 47429 . 47682) (GETBRK 47684 . 47822) (GETREADTABLE 47824 . 47960) (GETSEPR 47962 . 48100) ( +READMACROS 48102 . 48365) (READTABLEP 48367 . 48530) (READTABLEPROP 48532 . 53690) (RESETREADTABLE +53692 . 57939) (SETBRK 57941 . 59551) (SETREADTABLE 59553 . 59741) (SETSEPR 59743 . 61285) ( +\GETREADSYNTAX 61287 . 63977) (\GTREADTABLE 63979 . 64204) (\GTREADTABLE1 64206 . 64462) ( +\ORIGREADTABLE 64464 . 66372) (\READCLASSTOCODE 66374 . 66825) (\SETMACROSYNTAX 66827 . 68622) ( +\SETREADSYNTAX 68624 . 69685) (\READTABLEP.DEFPRINT 69687 . 70730)) (83824 88277 (\ATBLSET 83834 . +88275)) (88724 91256 (MAKE-READER-ENVIRONMENT 88734 . 89512) (EQUAL-READER-ENVIRONMENT 89514 . 90658) +(SET-READER-ENVIRONMENT 90660 . 91254))))) STOP diff --git a/sources/ATBL.LCOM b/sources/ATBL.LCOM index 2ed726449f232f0c4b7b144340a7e8403d1ace65..ea2196f7968d5d65c76d50f9a71264771a77aced 100644 GIT binary patch delta 3554 zcmai1YfN0n72dn70bdgb!xA0_GpqsM1w-!K$G#wDFS~aiW?$?s2GWfa433k=jw8jv z7TAEXF<5aF$Ky0=n;&r=ZllNw_Cl*RX=s(GRn`1x)JK#))Z|a3TK$2mB>hvVJ#+7c zeb`m^$LySQzVppFXU@#desM@`jHJgyOigSbP2qG5tco& z=;858rxJAzJJ{r$P2fEe_DJrRKCdUwOxBTe^Yx^X*_zD9ba!{#(8Sn@!xMFrUsu}{TC4XYJHL)}Zz}v7RF9XpdNghGtXJpcEj+e8saD?UTEcvcEoD*)F6FH&3 zB$N}bl;l}%=L`LoJj?eiO^if-VrdzZQ3n*-pH})KYKI+}JGU?eOGBe(zsdZ}J8^`1t>5Zi zD*)^;0E^nfBe$BBD`nPlLwSfyl{Rd15Y zqk3%E;UbCc*4g5C@Llm>zBnEiuor~v5K)F^>5C|-R66d9`&A@^E~skBr$%FGWduoD z2zk|j@{rHB?wVyeS#%))>p+F)c_;YuXcL=2GIr&Q5@Z;Qt0^C_y7k%MP&}<7$>~Iz z+To(#hEkRa=^aRt92nqoBfi2+qI~M z0>Zf((lu~l2{GJ){SeUr!hBKs7`ZpIkEmh-xeE3gS}-pY?92-TZeTl`QqyEGgtA{( zTw)lO%x^zxq3Y~Ex2H-NHXEqwFl!2O!umYJUa8@>u^enT!rdZVmSWAZ+?Dvlnx6v0 z_yY=s!0zdgcON(o+UDAwI?aD})|27d{h<0gYAUBo`QnLDg4=4yUuutl+F#epQng== zsA-k_t+^rlX5BXsTlV`6!;Bu>H#-|?u+>eU>GFEh0V)TZFYAl^x%u^6SPN)eUro2M zEg>t*VO(4Y@_0+|-iBYaJXEpq^N>`+DRK!lkXD-qSRb`D>8x`$?>(KfzqbiA_OjO9 zdhDdT?J0`P?+0xo$c;9>8cy$BajmzVgOyISbNWiJwLc4@b&oD)y?dt3Air<_62><= zD0EL}hGT8CEo>PZg3hzq=yp&6PLgf+ZZKlEu|4l}{sCOh?se$w@9n(`VxsFAUHqtv z5{9}*b@8q4GxxI`w4&l07)t12;|DJRAk8$hxy0!)N>uF z8-Bwd0}eOt)H$BOp6x6r=^d{lma(>LVqP=rh6!r#j@{zRHoHG0ge~_ zNO!#9pP@v11Mf7@GbSSr-bErj*WikQJA_AWJDkcpfp-CPE%=7+6biM{q>k9 z&TKK2K1N>~&ED1iYgNkXNXn4RYgPTLU1>wItX26|ONI=oe64E2Z!KM$ zP_67*rS{laet!pJ3QcTbUR`@Cbmw|#;%Mug@2rKiH%ry>dphR2iNjqybXqueK#7F? z-ATnC9)a3ps77vo5&Vc5;gh#c4(*$RK+Rr_;@4)y_+DQ*W~fYt%Cx@nu%WUTD$Dvx zkho4Y^DFI!rPQ#Lezj6{_oy$f_tpAI!4&KHlR(n>6yLLJEGQ+=U$6dn}xz08u|oetFJew6H>qfcqXb)X)^ z65&jQ%$}(MrmJV-l||1Fmh{dwko#tE^pcxRuTAYBHX% z(+^ALmg>o`&P4!XJx?i4o<9iVAJ0>2&w>-ixuquZ;zAH+pDsKKqw@mA@r#Y*M;GW1 z5wl3OV~f=9=ZlZSxMxYJ)3>AVu8R!lGUVf>^7~+M#OZG$j??~g{Cg>EX7%aA7wx3< zVvQS)WFj7pL75>~1J1%(1!rx$`%p(DoJw>V9on&}hP18io0tK0bU2>$=fg7ezYiQ` SD8cQE;}tCZ+Xk$(=l%<}HH;zv delta 4028 zcma)9TW}NC8J6S=#2_PID{R?52xC^l7JJiWZBu(Ktu5iTR!H)#W1`?oQ-Z-<99m-= zaWf=snZ!Lw+Uc~Rp&ed287_iJr)|8{olYicIsHyFywU z9;%0<{m=iO@B7Yw{ypdH+uyR>dCl@_H;d}Km3W_+MD;_#V8T^Gbw^|=7?;GP6hclU zwCsFwvW2Bt1~J}NHqgoli!a1@#7Uy@=GpIzMIfg}9Rx~{Y#8h`Q zk!7#g>Ouz(PaNGl_2LnY6WmTV05d$G&yW^cIX_Hf@mQys#xoXWtu-2vt(41(Z&@OF zV^cvaZ_E^g^Tzu|&!$3Sn9;ahSZ84a_+H^ACo3Q~WIL1;yJX4jLIrA_*<|T_#st4n z6Nj#OFjG{${X6PlYcc6t*jqyWw8mC;zqIUTjUGI7EhWA#j_SjWW$a3&Vp~>hlNO~M7!=#Sk5aZPe^V-RB$iChP|CA3mJ8Y( zhpvs|+eKA(U9$Gs#;a-N;N@tDE4K=4#+hG*$&8dKz8JjBRNBfjH9<&C)vF3p>WQF61uZKG1UZQy z1cDF1iFDo=Ku!MmI1{xUnEW@>$ z+@r$k_zQZ8?X;OF!RtjM5m}acMA;+8dyv5UQJ)wKi-|A__*gX3lYCsyX^BC8fzP@9 zwBP6kuaBj3UN6V3^74Kr=jHj;UM?Wyyd13&C#86w_97uxfQ~e=gR+=NB$c2Nk`No< zazhxww~CJO<^jp@{6vUSkWS`hg!A$cBx%!43`djV5aI>nFnnQcW7Tw387z#kbjV5F%sz`|-3b0=NX;;6Jlu&@-kk(D}K*eQ;3te00u;z|nzx zd;n>IX^7+mlnvu({Yj5u7=s$GV9b)2_pQ|CMP5jwL7SKLtuSd0iLw%vU=3K*9f>EB zi1!O9Ey{!9a02nZRe(I=L8AeX=T-pnj2}g!-4R$+I)D-}ITDl*Cy){e#udZ`XoGkT z)-1oo9Ft$v^blE94so!ux$=x5*3TOTus&lZSXx*)cNVcUW0cB3=^K5 z5r~1rx8-FqbY7OGib2AvQZu6REWTY*Q%H`#%)OG!X0sJvSU;)T8?1=}vo$kjb6d0y zyjcDX@YhvP>#P(c7BLyJFY{b)5 zJE2Rhs?)pvRCNN(J=N_x^;^}|7NGu#ebBsyXoCvI(3fehDIgN*+B%xk$=KW3!Z+7Pa^Qc#Zh6>@3E{^^FEr#t@Gup^JQ84Us29Lfs*KI(kxpv(ir zf}~8NbF;aKz$fs>4PU@xn-e6QdxHFf&2)v8@;=dTZ9ENhi;a{%v3DDffXQsp&CKpC zvydNrXX{^~y-AVKkZT0mw_FaZ)rlBE&-_RNZ)mK-AG?;o_omyYgZ{5cAX9oOAOfwZ)rt{s}pv(aC4^nF)-$PRRvX2L2$u~jz8ifzd z+Ke-ww;m;hwy%A+o`IV_JN|QfYb~rPZ+M?HM7RbMN%&za$_(!i$T)GobR8#fk3&EMz8?NWN1Td8iM_OQM7QgEUvc4IPxq%? z$aKI`U@Cl$+!7l)Z?whBEavcdq|&68i#K*9vX(_H@4C^H%vyzNdGN*>ZAi9ft!mS* z99Mo>W;TV#i_G6s_k|x^3Xe}VK6pb7YuCf_E6aM!+i>*=z|A8%AO__~$P*Vsks_8Cf@i7;(h1Dv(TQO zwqwspGJftPiT?EDSf$}LjVmA>esIQ|*@zFHk|9JrHEK0X4f*h+Q`IbES&{<&u@6r}!KdsDufp+T=!A05aoM-s7?Y-ze-8uKsJHszeX((s@X b4;lQ_2&pJYG=wg_G`8MKKEVNwe2@MQwvsb+ diff --git a/sources/BOOTSTRAP b/sources/BOOTSTRAP index fed56159..35c66e41 100644 --- a/sources/BOOTSTRAP +++ b/sources/BOOTSTRAP @@ -1,11 +1,11 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED "30-Jul-2021 10:02:14"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;49 46093 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(FILECREATED "17-Aug-2021 00:08:39"  +{DSK}kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;58 47657 - changes to%: (FNS READ-READER-ENVIRONMENT) + changes to%: (FNS \DO-DEFINE-FILE-INFO PRINT-READER-ENVIRONMENT) - previous date%: "29-Jul-2021 20:31:41" -{DSK}kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;48) + previous date%: "15-Aug-2021 21:21:35" +{DSK}kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;57) (* ; " @@ -714,38 +714,58 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation. (SET-READER-ENVIRONMENT (\DO-DEFINE-FILE-INFO NIL ARGS]) (\DO-DEFINE-FILE-INFO - [LAMBDA (STREAM ARGS) (* ; "Edited 17-Jul-2021 22:17 by rmk:") + [LAMBDA (STREAM ARGS) (* ; "Edited 17-Aug-2021 00:05 by rmk:") (* ;;; "Processes the (DEFINE-FILE-INFO . ARGS) at the front of STREAM. This converts the ARGS list to a READER-ENVIRONMENT, and also imposes the external format on STREAM, if non-NIL.") (* ;; "Include the :PACKAGE... for bootstrapping before in sysouts without an updated version of \LOAD-STREAM") - (LET (PACKAGE READTABLE BASE FORMAT VALUE) +(* ;;; "") + +(* ;;; "The LISTP forms for package and readtable are to allow for those to be created if they don't already exist. If they do exist, the forms should not make any incompatiblel changes--those should be in a file command somewhere.") + +(* ;;; "It doesn't make sense to produce an a new number base by evaluation in a particular runtime environment. I'm leaving this in for reading, for backward compatibility. Presumably future writing will instantiate to the particular number.") + + (LET (PACKAGE READTABLE BASE FORMAT VALUE PACKAGEFORM READTABLEFORM) [for TAIL on ARGS by (CDDR TAIL) do (SETQ VALUE (CADR TAIL)) (SELECTQ (CAR TAIL) ((:PACKAGE %:PACKAGE) - (SETQ PACKAGE - (OR (if (LISTP VALUE) - then (LET ((P (EVAL VALUE))) - (if (TYPEP P 'PACKAGE) - then P - else (CL:FIND-PACKAGE P))) - else (CL:FIND-PACKAGE VALUE)) - (ERROR "Can't find package for reader environment" VALUE)))) + (SETQ PACKAGE (if (LISTP VALUE) + then (SETQ PACKAGEFORM VALUE) + (EVAL VALUE) + ELSE VALUE)) + (IF (TYPEP PACKAGE 'PACKAGE) + ELSEIF (SETQ PACKAGE (CL:FIND-PACKAGE PACKAGE)) + ELSE + + (* ;; "Better message than just \DTEST") + + (ERROR + "Can't find package for DEFINE-FILE-INFO reader environment" + VALUE))) ((:READTABLE %:READTABLE) - (SETQ READTABLE (OR (if (LISTP VALUE) - then (\DTEST (EVAL VALUE) - 'READTABLEP) - else (FIND-READTABLE VALUE)) - (ERROR - "Can't find read table for reader environment" - VALUE)))) - ((:BASE %:BASE) + (SETQ READTABLE (if (LISTP VALUE) + then (SETQ READTABLEFORM VALUE) + (EVAL VALUE) + ELSE VALUE)) + (IF (TYPEP READTABLE 'READTABLEP) + ELSEIF (SETQ READTABLE (FIND-READTABLE READTABLE)) + ELSE + + (* ;; "Better message than just \DTEST") + + (ERROR + "Can't find read table for DEFINE-FILE-INFO reader environment" + VALUE))) + ((:BASE %:BASE) (* ; + "RMK: An EVAL form here makes no sense. ") (SETQ BASE (OR (\CHECKRADIX (if (LISTP VALUE) then (EVAL VALUE) else VALUE)) - (ERROR "Bad read base for reader environment" VALUE)))) + (ERROR + "Bad read base for DEFINE-FILE-INFO reader environment" + VALUE)))) ((:FORMAT FORMAT %:FORMAT) (SETQ FORMAT (FETCH (EXTERNALFORMAT NAME) OF (FIND-FORMAT VALUE)))) @@ -759,26 +779,33 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation. REPACKAGE _ (OR PACKAGE *INTERLISP-PACKAGE*) REREADTABLE _ (OR READTABLE FILERDTBL) REBASE _ (OR BASE 10) - REFORMAT _ FORMAT]) + REFORMAT _ FORMAT + REPACKAGEFORM _ PACKAGEFORM + REREADTABLEFORM _ READTABLEFORM]) (PRINT-READER-ENVIRONMENT - [LAMBDA (ENV STREAM) (* ; "Edited 18-Jul-2021 09:05 by rmk:") + [LAMBDA (ENV STREAM) (* ; "Edited 16-Aug-2021 23:51 by rmk:") (* ;;; "If ENV is not the old default interlisp reader environment, writes a DEFINE-FILE-INFO expression on STREAM that will produce this environment when the file is loaded.") (CL:UNLESS (EQUAL-READER-ENVIRONMENT ENV *OLD-INTERLISP-READ-ENVIRONMENT*) (LET ((*PACKAGE* *INTERLISP-PACKAGE*) (*PRINT-BASE* 10) - PKG) - (PRINT [CONS 'DEFINE-FILE-INFO `(,@[AND (SETQ PKG (fetch REPACKAGE of ENV)) - `(:PACKAGE ,(CL:PACKAGE-NAME PKG] - :READTABLE - ,(READTABLEPROP (fetch REREADTABLE of ENV) - 'NAME) - :BASE - ,(fetch REBASE of ENV) - :FORMAT - ,(FETCH REFORMAT OF ENV] + PKG RDTBL) + [SETQ PKG (IF (FETCH REPACKAGEFORM OF ENV) + ELSEIF (fetch REPACKAGE of ENV) + THEN (CL:PACKAGE-NAME (fetch REPACKAGE of ENV] + [SETQ RDTBL (IF (FETCH REREADTABLEFORM OF ENV) + ELSEIF (fetch REREADTABLE of ENV) + THEN (READTABLEPROP (fetch REREADTABLE of ENV) + 'NAME] + (PRINT [CONS 'DEFINE-FILE-INFO + `(,@[AND PKG `(:PACKAGE ,PKG] + ,@[AND RDTBL `(:READTABLE ,RDTBL] + :BASE + ,(fetch REBASE of ENV) + ,@(CL:UNLESS (EQ :XCCS (FETCH REFORMAT OF ENV)) + `(:FORMAT ,(FETCH REFORMAT OF ENV)))] STREAM (FETCH (READER-ENVIRONMENT REREADTABLE) OF *DEFINE-FILE-INFO-ENV*))))]) @@ -954,13 +981,13 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation. (PUTPROPS BOOTSTRAP COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1992 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4740 14412 (GETPROP 4750 . 5322) (SETATOMVAL 5324 . 5453) (RPAQQ 5455 . 5508) (RPAQ -5510 . 5822) (RPAQ? 5824 . 6194) (MOVD 6196 . 8060) (MOVD? 8062 . 8492) (SELECTQ 8494 . 8681) ( -SELECTQ1 8683 . 9025) (NCONC1 9027 . 9223) (PUTPROP 9225 . 10709) (PROPNAMES 10711 . 10902) (ADDPROP -10904 . 12967) (REMPROP 12969 . 13823) (MEMB 13825 . 14084) (CLOSEF? 14086 . 14410)) (14485 35049 ( -LOAD 14495 . 15664) (\LOAD-STREAM 15666 . 28740) (FILECREATED 28742 . 30160) (FILECREATED1 30162 . -31270) (PRETTYCOMPRINT 31272 . 31757) (BOOTSTRAP-NAMEFIELD 31759 . 32719) (PUTPROPS 32721 . 33089) ( -DECLARE%: 33091 . 33223) (DECLARE%:1 33225 . 34097) (ROOTFILENAME 34099 . 35047)) (35087 43925 ( -DEFINE-FILE-INFO 35097 . 35532) (\DO-DEFINE-FILE-INFO 35534 . 38596) (PRINT-READER-ENVIRONMENT 38598 - . 39879) (READ-READER-ENVIRONMENT 39881 . 42647) (MAKE-DEFINE-FILE-INFO-ENV 42649 . 43923))))) + (FILEMAP (NIL (4748 14420 (GETPROP 4758 . 5330) (SETATOMVAL 5332 . 5461) (RPAQQ 5463 . 5516) (RPAQ +5518 . 5830) (RPAQ? 5832 . 6202) (MOVD 6204 . 8068) (MOVD? 8070 . 8500) (SELECTQ 8502 . 8689) ( +SELECTQ1 8691 . 9033) (NCONC1 9035 . 9231) (PUTPROP 9233 . 10717) (PROPNAMES 10719 . 10910) (ADDPROP +10912 . 12975) (REMPROP 12977 . 13831) (MEMB 13833 . 14092) (CLOSEF? 14094 . 14418)) (14493 35057 ( +LOAD 14503 . 15672) (\LOAD-STREAM 15674 . 28748) (FILECREATED 28750 . 30168) (FILECREATED1 30170 . +31278) (PRETTYCOMPRINT 31280 . 31765) (BOOTSTRAP-NAMEFIELD 31767 . 32727) (PUTPROPS 32729 . 33097) ( +DECLARE%: 33099 . 33231) (DECLARE%:1 33233 . 34105) (ROOTFILENAME 34107 . 35055)) (35095 45489 ( +DEFINE-FILE-INFO 35105 . 35540) (\DO-DEFINE-FILE-INFO 35542 . 39888) (PRINT-READER-ENVIRONMENT 39890 + . 41443) (READ-READER-ENVIRONMENT 41445 . 44211) (MAKE-DEFINE-FILE-INFO-ENV 44213 . 45487))))) STOP diff --git a/sources/BOOTSTRAP.LCOM b/sources/BOOTSTRAP.LCOM index 531c0946dc0d3f687c041e23db7bf72d9fd34f2d..e93e61bb1e7c3ae9c3f83da5614433f22e6c26bb 100644 GIT binary patch delta 2184 zcma)8U2M}<6i(7oii@D7p^Q-A5L!ro5`67APO?d@8#~m*iH+^D778?NLR(Q%RJv&o zn~HdxCXMY1G3{lbX&Ty7yHX*vP1!UwX^)fkJZ%qqn>2Vq;$_;gorH`rX;E{2zH`q# z=bro7>C@$#D>t)!156~VYD&gbBwLXoOvI@4#(b1xIRY%3W|L_?^}$;^H$tIJqAk}X)kU;|P5yT3cwT$>|l{Nn{DJ0OUgX5hDj zCkU8e0AazFR1K{J;5cMk8q<`lZsrjYz>qRI>7?sZ1@yJ0ojzZn>&^~o!{1iw@-uoc z;Qv|=`b+aZ{5-x_(_ao%wNlHi^E(`L@_R>qxZ(S0-1E`=VcEg74c~(oGY8$w3+~FP zdgg7_^LJwEdtU1LJ9PNS!F?TiPidR~lj>!?=gH@2FZDgSUDbQ&%n@ZR=x3ZN)$Tx` zWvk`J#$V5JpSgX0HM%uE3VzkB-Bm9Lmeh@ z5!Z}KmI8#wy*vv!)acIuJWhYQ;X{&xhS#cqz|reRj|Bvt-aC5eGD#&NJXS2hN*Tp$ z@md)!Ew6yA;HZ?SbFQdb$m(vmyaMIQn~N*Ul`G}SY8V?}A)F~zj<3R{#Y%09)#B{Z z%lDwW`+9~%?jI>vi*uKY^Z&7aq%YCVgEv=tt?xB|oUZrv`2~9CcxdfWYrq#6wcYDS zQa*H9w8V6UTSnWESiT?Iw)WR7-~HWn%VqJ|n#XJ%s#$^i!Mf%0)7|x)Yo5B_;pv4? zC|9#{3!$};i`KGQYr5S9A8&Ry2ir08I(|ExwnEZ`*IvMNI~O{A5t1Tcm`EBRVgfQ+ zS~3i!AVZ34x>Zxh*8%TDT~5(2`i}*YaY_b)Ed+^(dOr~oO*~1~h(_YXTgCH^mI)^| zXoG8>^MtUNUL!0ZE&j!UqzDBmuRxM@HVTN2+Uxh6c*4baPjQ|i!sffj_O%{mBBmjo zJ`H2KZd0_jnKGqoWvEjb23gb94@6GUnJH#m=LA8as>f^obJ6w}lLSb^_4)RT!mb*?zRH zv(t2>cQ1XA5NU*j5ZNIfrn4l8){NLgH%J<-KZw(V$vOQzA5e2?? z8xtNFV5r0g*J^Q)Usv;4?Iix7I42*02}8yoy1ZmGgL1ae>`Jn18H%PgV`CGlCclv8 zJd{T6Wb-m>%5qRkY!oc$Hcr<-PuDJ4Ma18zA+^B183Fofp^SxY`tU5yN39 z76nYhvv$)nv988EHg@lAaqzqG12~g!;z_Z-n_()pJ%wD#OBqwQprC4vvR=%d!c$we z7oo$#DEm_7DHwFPwXL4H+EL9ZtU6F)=rz&tVw@pmsDvP zV-o6Mh#P3d5=i`r3kbN;jb7MB4m*K_gv0>}q#?u^v|Tvt0KA`@lxW%kOL_c$&-?Rz z-}~d-sQp#Fk>enivz&3Y0I`W|)*T2Ya)zmA9bGNx8pL@fdE%wTB*$OVV1eAcG(=G7r;p#ma1X8CI(O3M6uQ7lK~6yW87NcST#b<`{)% z6@ew*w2-;AO#gNu!hi!d$oR7%0|nJEz3X7D&h4Toy7Sr&bv+O%bq01?VLEWf3I|HF z6h03=Z@h0Rb+goVGuA=a&OnD1xksdTtjL>I#3v(f_^*vnl_<<0!HIS1>&F8nNTBz9 z+wBy!pQ4`NH@Qw-_s$gg*rEP(a>kC%&;b$l>_C0*BZbiMdgZgSX;P25z(`_4V zudo08$JnR-nQsqoWTwdO&yH^F@P)gj@hDX{8mn(g`6yjKvC+O5ys*1ovUW$?>!q>i z&U$#v4_N>59+lul5zgro1>MQ3W}}6;v;ex}SPpO^3#&OJuO*u*Hr-S)Je)J~r&ZI? zQjV$_6Tqf<(2)RE;2KseCxh>gov0Pm5mN`2&1_m_nxSyJtf}~BwwfJNkLw_%x2R)H zPLO;*Y$u-MF{-IMT4BTlo{`~*k;f~ThHEDq=0}icyhrias?35yh5~Pc5gxlLp0r>>vZ36HRKCmV-KM4K%F;se6PrF6$fj>qhGVdINx9|)>hN8AN3^ZvZRsES(xx! zpB(OP4}`osM-L+2KRS;%Iyi;+#o!ELI9W!#oOBV_2KIQrCdW}qrijJcsSAjIrlt{{ zAtK)wS?~9uL6pMGS;PgVg!ltPEFMY2-U{1~(o|aYeqo^!#RmpL3CC7XzJRIK3x&y197NsOBDFKdc+NaN z5b~}G(Q{2xEtmJnhNr4&uC1G9D>rh=Ftu^jZska}?6KpmlsoAX*2N7T2>bRnH*j=U zFPv5#*K`Z0iityAO%)m9iBZGnr^If&$Q7{<@gwm7;%$*6<0mnL7?y}UDDCfQ`Zf+w zn6z~l@`j0_FG%~)Xq}09?@C#eewIi*j-^SqFtgs>^cYGV85!|aF6~{-?0pKuZGO-g W4DexQx--PeG6&@E6Vr)tL;nJzve`2L diff --git a/sources/CMLREAD b/sources/CMLREAD index dcb8e201..62cd1cc0 100644 --- a/sources/CMLREAD +++ b/sources/CMLREAD @@ -1,11 +1,11 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED "29-Jul-2021 20:34:35"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;10 14968 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(FILECREATED "16-Aug-2021 23:42:49"  +{DSK}kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;16 12625 - changes to%: (FUNCTIONS WITH-READER-ENVIRONMENT) + changes to%: (RECORDS READER-ENVIRONMENT) - previous date%: " 9-Jul-2021 08:09:06" -{DSK}kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;9) + previous date%: "14-Aug-2021 20:32:52" +{DSK}kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;15) (* ; " @@ -45,9 +45,8 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation. (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) - (LAMA CL:WRITE-BYTE CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT - CL:READ-CHAR-NO-HANG CL:LISTEN CL:PEEK-CHAR CL:UNREAD-CHAR CL:READ-CHAR - CL:READ-LINE CL:COPY-READTABLE]) + (LAMA CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT CL:READ-CHAR-NO-HANG + CL:PEEK-CHAR CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE]) @@ -240,16 +239,18 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation. (DECLARE%: EVAL@COMPILE -(DATATYPE READER-ENVIRONMENT (REPACKAGE REREADTABLE REBASE NIL REFORMAT)) +(DATATYPE READER-ENVIRONMENT (REPACKAGE REREADTABLE REBASE REPACKAGEFORM REFORMAT REREADTABLEFORM + )) ) -(/DECLAREDATATYPE 'READER-ENVIRONMENT '(POINTER POINTER POINTER POINTER POINTER) +(/DECLAREDATATYPE 'READER-ENVIRONMENT '(POINTER POINTER POINTER POINTER POINTER POINTER) '((READER-ENVIRONMENT 0 POINTER) (READER-ENVIRONMENT 2 POINTER) (READER-ENVIRONMENT 4 POINTER) (READER-ENVIRONMENT 6 POINTER) - (READER-ENVIRONMENT 8 POINTER)) - '10) + (READER-ENVIRONMENT 8 POINTER) + (READER-ENVIRONMENT 10 POINTER)) + '12) (DEFMACRO WITH-READER-ENVIRONMENT (ENV . BODY) `((CL:LAMBDA (E) @@ -279,58 +280,13 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation. (ADDTOVAR NLAML ) -(ADDTOVAR LAMA CL:WRITE-BYTE CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT CL:READ-CHAR-NO-HANG - CL:LISTEN CL:PEEK-CHAR CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE - CL:COPY-READTABLE) -) -(PRETTYCOMPRINT CMLREADCOMS) - -(RPAQQ CMLREADCOMS - [(COMS - (* ;; "Misc Common Lisp reader functions") - - (FNS CL:COPY-READTABLE) - (FNS CL:READ-LINE CL:READ-CHAR CL:UNREAD-CHAR CL:PEEK-CHAR CL:LISTEN - CL:READ-CHAR-NO-HANG CL:CLEAR-INPUT CL:READ-FROM-STRING CL:READ-BYTE CL:WRITE-BYTE - ) - (* ; - "must turn off packed version of CLISP infix") - (VARS [CLISPCHARS (LDIFFERENCE CLISPCHARS '(- *] - (CLISPCHARRAY (MAKEBITTABLE CLISPCHARS)) - (DWIMINMACROSFLG)) - (VARIABLES *READ-DEFAULT-FLOAT-FORMAT*) - (GLOBALVARS CMLRDTBL READ-LINE-RDTBL)) - [COMS - (* ;; "Crude means to aid reading and printing things in same reader environment. There are some fns and an INITRECORDS for this on ATBL to get it early in the loadup") - - (RECORDS READER-ENVIRONMENT) - (FUNCTIONS WITH-READER-ENVIRONMENT) - (ADDVARS (SYSSPECVARS *PACKAGE* *READTABLE* *READ-BASE* *PRINT-BASE*)) - (PROP INFO WITH-READER-ENVIRONMENT) - (GLOBALVARS *COMMON-LISP-READ-ENVIRONMENT*) - (INITVARS (*COMMON-LISP-READ-ENVIRONMENT* (create READER-ENVIRONMENT REPACKAGE _ - (CL:FIND-PACKAGE "USER") - REREADTABLE _ CMLRDTBL REBASE _ 10 - REFORMAT _ :XCCS] - (PROP FILETYPE CMLREAD) - (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS - (ADDVARS (NLAMA) - (NLAML) - (LAMA CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT CL:READ-CHAR-NO-HANG - CL:PEEK-CHAR CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE]) -(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS - -(ADDTOVAR NLAMA ) - -(ADDTOVAR NLAML ) - (ADDTOVAR LAMA CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT CL:READ-CHAR-NO-HANG CL:PEEK-CHAR CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE) ) (PUTPROPS CMLREAD COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1993 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2600 3585 (CL:COPY-READTABLE 2610 . 3583)) (3586 10219 (CL:READ-LINE 3596 . 4468) ( -CL:READ-CHAR 4470 . 5020) (CL:UNREAD-CHAR 5022 . 5483) (CL:PEEK-CHAR 5485 . 7469) (CL:LISTEN 7471 . -7736) (CL:READ-CHAR-NO-HANG 7738 . 8510) (CL:CLEAR-INPUT 8512 . 8749) (CL:READ-FROM-STRING 8751 . 9506 -) (CL:READ-BYTE 9508 . 9961) (CL:WRITE-BYTE 9963 . 10217))))) + (FILEMAP (NIL (2527 3512 (CL:COPY-READTABLE 2537 . 3510)) (3513 10146 (CL:READ-LINE 3523 . 4395) ( +CL:READ-CHAR 4397 . 4947) (CL:UNREAD-CHAR 4949 . 5410) (CL:PEEK-CHAR 5412 . 7396) (CL:LISTEN 7398 . +7663) (CL:READ-CHAR-NO-HANG 7665 . 8437) (CL:CLEAR-INPUT 8439 . 8676) (CL:READ-FROM-STRING 8678 . 9433 +) (CL:READ-BYTE 9435 . 9888) (CL:WRITE-BYTE 9890 . 10144))))) STOP diff --git a/sources/CMLREAD.LCOM b/sources/CMLREAD.LCOM index 36710f228c1e3cc5f777c50905038bfc6283a828..8fe4f843991748c245d21b4382721fd118a28f09 100644 GIT binary patch delta 365 zcmX?Mxk-P5n~ElvhMT94t8L22&Fj-AFj)_ZSa+|QtWLIHP2}1*fB2B0wE(JrQ&F6%3 Km?x*pBmw{sHC(Cy delta 398 zcmdm_f5LKtn~{Q?n}3k6V~B!WgtK$7CYOerr;n?1kgH>etBZn?k)^IzX^yUufsvtt zk%5)5iIuVG#H`?Y15KcuF+$GJ(8|EX%G69rflJBR-!}kghAzmU6eWesJOw4UP#+%! zWc7M_dP)i@i6yBinC6&T85$_zcL)c>B}xjD?=w1x8YplXnpm1yC?sbj=B1|=E0pA` zT1|e!qB?myqo9Zak{1jttPCuz49q6qVRT}&+^oPfpM@(t$TP%M*C{f@b@FaDHwi9h zA1fcv;1E|o1t2TH)zw?q*~2kNVKYB_DL0Rwr;kFADei7GTBhrlSzYXa*eQ!7(&j_KvR<|wW1&~FGY9q2Nv