DINFO was expecting to use a closed textstream without reopening (#1576)

* DINFO was expecting to use a closed textstream without reopening

Not sure why it got closed.  Also fixed some escaped backquote commas (not sure that was necessary, but...)

* Oops, dropped out the PROG1

docs/README.md

@@ -1,5 +1,5 @@
-See [Documentation links](https://github.com/Interlisp/medley/wiki/Documentation)
-a complete list of available documentation. Much of the documentation still
+See [Using Medley](https://interlisp.org/software/using-medley)
+for a list of available documentation. Much of the documentation still
 needs review and updating.
 
 This directory has source (.TEDIT) for some documents that are found elsewhere.

greetfiles/APPS-INIT

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "16-Jun-2023 17:20:09" {DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;11
 21130  
+
(FILECREATED "25-Feb-2024 13:56:23" {DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;17
 23321  
 
-      :CHANGES-TO (FNS Apps.DoInit)
+      :CHANGES-TO (VARS APPS-INITCOMS)
+                  (FNS Apps.DoInit Apps.AroundExitFn)
 
-      :PREVIOUS-DATE "19-Jan-2023 12:44:20" 
-{DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;10)
+      :PREVIOUS-DATE "25-Feb-2024 13:14:02" 
+{DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;16)
 
 
 (PRETTYCOMPRINT APPS-INITCOMS)
@@ -16,8 +17,9 @@
         (GLOBALVARS Apps.NotecardsActivated Apps.RoomsActivated)
         (INITVARS (Apps.NotecardsActivated NIL)
                (Apps.RoomsActivated NIL))
-        (FNS Apps.InitNotecards Apps.DoInit Apps.CreateButtons Apps.CreateLabel Apps.ActivateCLOS 
-             Apps.ActivateRooms Apps.ShowDoc XCL-USER::EXEC_INTERLISP)
+        (FNS Apps.InitNotecards Apps.SetUpNOTECARDSDIRECTORIES Apps.DoInit Apps.CreateButtons 
+             Apps.CreateLabel Apps.ActivateCLOS Apps.ActivateRooms Apps.ShowDoc 
+             XCL-USER::EXEC_INTERLISP Apps.AroundExitFn)
         (DECLARE%: DONTEVAL@LOAD DOCOPY (P (Apps.DoInit)))
         (DECLARE%: FIRST DONTEVAL@LOAD DOCOPY (P (BKSYSBUF " "])
 
@@ -90,6 +92,33 @@
           (if
 (NOT DoNotRefreshButtons)
               then
 (Apps.CreateButtons
])
 
+(Apps.SetUpNOTECARDSDIRECTORIES

+  [LAMBDA NIL
+
+    (* ;; "Find the location of the Notecards directory and call NC.SetUpNOTECARDSDIRECTORIES.")

+
+    (* ;; " This is needed to make sure that lazy loading of Notecard types works.")

+
+    (LET* [(LOC1 (CONCAT MEDLEYDIR "notecards>"))
+           (LOC2 (CONCAT MEDLEYDIR "..>notecards>"))
+           (LOC3 (CONCAT MEDLEYDIR "..>..>notecards>"))
+           (NCDIR (for
 LOC in
 (LIST LOC1 LOC2 LOC3) thereis
 (OR (INFILEP (CONCAT LOC 
+                                                                                "system>NOTECARDS"))
+                                                                (INFILEP (CONCAT LOC 
+                                                                              "system>NOTECARDS.LCOM"
+                                                                                ]
+          (if
 NCDIR
+              then
 [SETQ NCDIR (OR (INFILEP (CONCAT NCDIR "system>NOTECARDS"))
+                                   (INFILEP (CONCAT NCDIR "system>NOTECARDS.LCOM"]
+                   (SETQ NCDIR (SUBSTRING NCDIR 1 (IDIFFERENCE (STRPOS "system>NOTECARDS" NCDIR)
+                                                         1)))
+                   (NC.SetUpNOTECARDSDIRECTORIES NCDIR)
+                   T
+            else
 (PRIN1 "Warning: Notecards directory could not be found." T)
+                 (PRIN1 "Hence, NOTECARDSDIRECTORIES is probably not set correctly" T)
+                 (PRIN1 "and Notecards will not work properly." T)
+                 NIL])
+
 (Apps.DoInit

   [LAMBDA NIL
 
@@ -173,7 +202,16 @@
 
            (* ;; " Make sure Notecards doesn't try to load its HASH file in NC.PostGreet")

 
-           (SETTOPVAL '\NC.SourceAccessFlg NIL])
+           (SETTOPVAL '\NC.SourceAccessFlg NIL)
+
+           (* ;; "Setup NOTECARDSDIRECTORIES.")

+
+           (Apps.SetUpNOTECARDSDIRECTORIES
)
+
+           (* ;; "Add AROUNDEXITFN to ensure NOTECARDSDIRECTORIES get reset after LOGOUT, etc.")

+
+           (SETQ AROUNDEXITFNS (LSUBST '(MEDLEY-INIT-VARS Apps.AroundExitFn)
+                                      'MEDLEY-INIT-VARS AROUNDEXITFNS])
 
 (Apps.CreateButtons

   [LAMBDA (DoDocsToo)
                                      (* ; "Edited 13-Dec-2022 12:51 by frank")


@@ -366,6 +404,11 @@
                                                         YCOORD _ (IDIFFERENCE SCREENHEIGHT 460]
            (XCL:SET-DEFAULT-EXEC-TYPE 'INTERLISP)
            (XCL:SET-EXEC-TYPE 'INTERLISP])
+
+(Apps.AroundExitFn

+  [LAMBDA (EVENT)
+    (if
 (MEMB EVENT '(AFTERLOGOUT AFTERSYSOUT AFTERSAVEVM))
+        then
 (Apps.SetUpNOTECARDSDIRECTORIES
])
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
@@ -376,8 +419,8 @@
 (BKSYSBUF " ")
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1109 20996 (Apps.InitNotecards 1119 . 4981) (Apps.DoInit 4983 . 8227) (
-Apps.CreateButtons 8229 . 17053) (Apps.CreateLabel 17055 . 17865) (Apps.ActivateCLOS 17867 . 19216) (
-Apps.ActivateRooms 19218 . 20069) (Apps.ShowDoc 20071 . 20220) (XCL-USER::EXEC_INTERLISP 20222 . 20994
-)))))
+  (FILEMAP (NIL (1229 23187 (Apps.InitNotecards 1239 . 5101) (Apps.SetUpNOTECARDSDIRECTORIES 5103 . 6658
+) (Apps.DoInit 6660 . 10257) (Apps.CreateButtons 10259 . 19083) (Apps.CreateLabel 19085 . 19895) (
+Apps.ActivateCLOS 19897 . 21246) (Apps.ActivateRooms 21248 . 22099) (Apps.ShowDoc 22101 . 22250) (
+XCL-USER::EXEC_INTERLISP 22252 . 23024) (Apps.AroundExitFn 23026 . 23185)))))
 STOP

library/DATABASEFNS

@@ -1,14 +1,16 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "27-Oct-2021 10:55:18" {DSK}<home>larry>medley>library>DATABASEFNS.;7
 16051  
+
(FILECREATED "20-Feb-2024 23:45:56" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;4
 18445  
 
-      changes to%:  (FNS DUMPDB)
+      :EDIT-BY "mth"
 
-      previous date%: "24-Oct-2021 20:18:51" {DSK}<home>larry>medley>library>DATABASEFNS.;6)
+      :CHANGES-TO (FNS DUMPDB)
+
+      :PREVIOUS-DATE "19-Feb-2024 16:29:44" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;1)
 
 
 (* ; "
-Copyright (c) 1986, 1990-1993 by Xerox Corporation.
+Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT DATABASEFNSCOMS)
@@ -31,7 +33,8 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
         (INITVARS (LOADDBFLG 'ASK)
                (SAVEDBFLG 'ASK))
         (ADDVARS (MAKEFILEFORMS (MAKEDB FILE)))
-        (INITVARS (MSFILETABLE))
+        (INITVARS (MSFILETABLE)
+               (DEFAULTDATABASECOPYRIGHTOWNER 'NEVER))
                                                              (* ; "To permit MSHASH interface")

         (LOCALVARS . T)
         (BLOCKS (LOADDB LOADDB DBFILE DBFILE1 DBFILE2 (NOLINKFNS . T)))
@@ -161,52 +164,85 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
 (DEFINEQ
 
 (DUMPDB

-  [LAMBDA (FILE PROPFLG)                                     (* ; 
-
                                                           "Edited 27-Oct-2021 10:51 by larry")

-                                                             (* ; 
-
                                                           "Edited 24-Oct-2021 16:24 by rmk:")

+  [LAMBDA (FILE PROPFLG)
                                     (* ; "Edited 20-Feb-2024 23:45 by mth")


+                                                             (* ; "Edited  7-Feb-2024 18:26 by mth")


+                                                           (* ; "Edited 27-Oct-2021 10:51 by larry")


+                                                            (* ; "Edited 24-Oct-2021 16:24 by rmk:")

 
     (* ;; "Dumps a Masterscope database for functions in FILE.  Checks the DATABASE property if PROPFLG=T which is how the MAKEFILE advice calls it.  A user-level call would default PROPFLG to NIL.")

 
-    (* ;; 
-
  "The FILE check is because MAKEFILE returns a list when it doesn't understand the options")

+    (* ;; "The FILE check is because MAKEFILE returns a list when it doesn't understand the options")

 
-    (DECLARE
 (GLOBALVARS MSFILETABLE SAVEDBFLG))
+    (DECLARE
 (GLOBALVARS MSFILETABLE SAVEDBFLG COPYRIGHTFLG DEFAULTCOPYRIGHTOWNER)
+           (SPECVARS DEFAULTDATABASECOPYRIGHTOWNER))
     (CL:WHEN (AND FILE (OR (LITATOM FILE)
                            (STRINGP FILE)))
-        (PROG (DBFILE
 (FL (NAMEFIELD FILE))
-                     (FNS (FILEFNSLST FILE)))
-              (COND
-                 (FNS)
-                 ((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE)))
+        (LET ((SAVEDCOPYRIGHTFLG COPYRIGHTFLG)
+              (SAVEDDEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER))
+             (CL:UNWIND-PROTECT
+                 (PROG (DBFILE
 DBFN DBROOTFN FLCPR (FL (NAMEFIELD FILE))
+                              (FNS (FILEFNSLST FILE)))
+                       (SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE))
+                       (SETQ DBROOTFN (ROOTFILENAME DBFN))
+                       (CL:UNLESS (OR (EQ COPYRIGHTFLG 'NEVER)
+                                      (NULL DEFAULTDATABASECOPYRIGHTOWNER)
+                                      (GETPROP DBROOTFN 'COPYRIGHT))
+                           (SELECTQ DEFAULTDATABASECOPYRIGHTOWNER
+                               ((NONE NEVER) 
+                                             (* ;; 
+
                                          "Set the COPYRIGHT to NONE (I.e., never mention it again.)")

+
+                                    (/PUT DBROOTFN 'COPYRIGHT (LIST 'NONE)))
+                               (SAME 
+                                     (* ;; 
+
                         "Same as the source file. If it doesn't have one, then just normal handling")

+
+                                     (CL:WHEN (SETQ FLCPR (GETPROP FL 'COPYRIGHT))
+                                         (/PUT DBROOTFN 'COPYRIGHT (LIST (CAR FLCPR)))))
+                               (DEFAULT 
+                                        (* ;; "Use the general default for copyright")

+
+                                        (SETQ COPYRIGHTFLG 'DEFAULT))
+                               (PROGN (SETQ COPYRIGHTFLG 'DEFAULT)
+
+                                      (* ;; 
+
                        "Hopefully, DEFAULTDATABASECOPYRIGHTOWNER is one of the COPYRIGHTOWNERS keys")

+
+                                      (SETQ DEFAULTCOPYRIGHTOWNER DEFAULTDATABASECOPYRIGHTOWNER))))
+                       (COND
+                          (FNS)
+                          ((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE)))
                                                              (* ; 
-
                                                           "Always dump if this is a known file")

-                  (SETQ PROPFLG NIL))
-                 (T (COND
-                       (PROPFLG (/REMPROP FL 'DATABASE))
-                       (T (printout T T FILE " has no functions." T)))
-                    (RETURN)))
-              (CL:WHEN [OR (NULL PROPFLG)
-                           (EQ (GETPROP FL 'DATABASE)
-                               'YES)
-                           (EQ SAVEDBFLG 'YES)
-                           (AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
-                  (CL:WHEN MSFILETABLE
-                      [STORETABLE FL MSFILETABLE (CAR (GETPROP FL 'FILEDATES])
-                  [SETQ DBFILE (PRETTYDEF NIL (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL
-                                                     'BODY FILE)
-                                      `((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
-                                                  (ERROR!)))
-                                        (E [PRINT (CAR (GETPROP ',FILE 'FILEDATES]
-                                           (DUMPDATABASE ',FNS]
-                  [COND
-                     (PROPFLG (PRINT (FULLNAME DBFILE)
-                                     T))
-                     (T (/PUT FL 'DATABASEFILENAME DBFILE)   (* ; 
-
                                                   "Remember that we have this file valid already.")

-                        (/PUT FL 'DATABASE 'YES]             (* ; 
-
                                                   "Take future note of the databae on a user call")

-                  (RETURN DBFILE))))])
+
                                                             "Always dump if this is a known file")

+                           (SETQ PROPFLG NIL))
+                          (T (COND
+                                (PROPFLG (/REMPROP FL 'DATABASE))
+                                (T (printout T T FILE " has no functions." T)))
+                             (RETURN)))
+                       (CL:WHEN [OR (NULL PROPFLG)
+                                    (EQ (GETPROP FL 'DATABASE)
+                                        'YES)
+                                    (EQ SAVEDBFLG 'YES)
+                                    (AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
+                           (CL:WHEN MSFILETABLE
+                               [STORETABLE FL MSFILETABLE (CAR (GETPROP FL 'FILEDATES])
+                           [SETQ DBFILE
+                            (PRETTYDEF NIL DBFN
+                                   `((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
+                                               (ERROR!)))
+                                     (E [PRINT (CAR (GETPROP ',FILE 'FILEDATES]
+                                        (DUMPDATABASE ',FNS]
+                           [COND
+                              (PROPFLG (PRINT (FULLNAME DBFILE)
+                                              T))
+                              (T (/PUT FL 'DATABASEFILENAME DBFILE)
+                                                             (* ; 
+
                                                     "Remember that we have this file valid already.")

+                                 (/PUT FL 'DATABASE 'YES]    (* ; 
+
                                                    "Take future note of the database on a user call")

+                           (RETURN DBFILE))))
+             (SETQ COPYRIGHTFLG SAVEDCOPYRIGHTFLG)
+             (SETQ DEFAULTCOPYRIGHTOWNER SAVEDDEFAULTCOPYRIGHTOWNER)))])
 
 (LOADDB

   [LAMBDA (FILE ASKFLAG)
                                (* ; "Edited 24-Oct-2021 17:44 by rmk:")


@@ -321,6 +357,8 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
 
 (RPAQ? MSFILETABLE
 )
 
+(RPAQ? DEFAULTDATABASECOPYRIGHTOWNER
 'NEVER)
+
 
 
 (* ; "To permit MSHASH interface")

@@ -337,9 +375,9 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
 
 (RESETSAVE DWIMIFYCOMPFLG T)
 )
-(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993))
+(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993 2024))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1679 6704 (DBFILE 1689 . 3334) (DBFILE1 3336 . 4846) (DBFILE2 4848 . 6070) (LOAD 6072
- . 6302) (LOADFROM 6304 . 6492) (MAKEFILE 6494 . 6702)) (6760 15499 (DUMPDB 6770 . 9534) (LOADDB 9536
- . 14411) (MAKEDB 14413 . 15497)))))
+  (FILEMAP (NIL (1768 6793 (DBFILE 1778 . 3423) (DBFILE1 3425 . 4935) (DBFILE2 4937 . 6159) (LOAD 6161
+ . 6391) (LOADFROM 6393 . 6581) (MAKEFILE 6583 . 6791)) (6849 17838 (DUMPDB 6859 . 11873) (LOADDB 
+11875 . 16750) (MAKEDB 16752 . 17836)))))
 STOP

library/SPY

@@ -1,13 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "28-Jul-2023 20:13:45" {DSK}<home>larry>il>medley>library>SPY.;4
 64149  
+
(FILECREATED "27-Feb-2024 20:25:02" {DSK}<home>larry>il>medley>SPY.;1
 53724  
 
       :EDIT-BY "lmm"
 
-      :CHANGES-TO (VARS SPYCOMS)
-                  (FNS \SPY.INTERRUPT SPY.BUFFER.ENTRY SPY.ADD.ENTRY)
+      :CHANGES-TO (RECORDS FX)
+                  (VARS SPYOBJCOMS)
 
-      :PREVIOUS-DATE " 4-Jan-2022 14:09:48" {DSK}<home>larry>il>medley>library>SPY.;1)
+      :PREVIOUS-DATE "28-Jul-2023 20:13:45" {DSK}<home>larry>il>medley>library>SPY.;1)
 
 
 (PRETTYCOMPRINT SPYCOMS)
@@ -114,7 +114,7 @@
                                       (FUNCTION SPYOBJ.BUTTON)
                                       (FUNCTION SPYOBJ.COPYIN)
                                       NIL NIL NIL NIL NIL NIL 'SPYNODE]
-        (DECLARE%: DONTCOPY DOEVAL@COMPILE (RECORDS FX SPYOBJDATA))
+        (DECLARE%: DONTCOPY DOEVAL@COMPILE (RECORDS SPYOBJDATA))
         (INITRECORDS SPYOBJDATA)))
 (DEFINEQ
 
@@ -189,134 +189,6 @@
 (DECLARE%: DONTCOPY DOEVAL@COMPILE 
 (DECLARE%: EVAL@COMPILE
 
-(ACCESSFNS FX
 ((FXBLOCK (ADDSTACKBASE DATUM)))               (* ; "frame extension index")

-              (BLOCKRECORD FXBLOCK ((FLAGS BITS 3)           (* ; "= \STK.FX")

-                                    (FAST FLAG)
-                                    (NIL FLAG)
-                                    (INCALL FLAG)            (* ; 
-
                                                             "set when fncall microcode has to punt")

-                                    (VALIDNAMETABLE FLAG)    (* ; 
-
                                  "if on, NAMETABLE field is filled in.  If off, is same as FNHEADER")

-                                    (NOPUSH FLAG)            (* ; 
-
                           "when returning to this frame, don't push a value.  Set by interrupt code")

-                                    (USECNT BITS 8)
-                                    (%#ALINK WORD)           (* ; "low bit is SLOWP")

-                                    (FNHEADER FULLXPOINTER)
-                                    (NEXTBLOCK WORD)
-                                    (PC WORD)
-                                    (NAMETABLE# FULLXPOINTER)
-                                    (%#BLINK WORD)
-                                    (%#CLINK WORD)))
-              (BLOCKRECORD FXBLOCK ((FLAGBYTE BYTE)
-                                    (NIL BYTE)
-                                    (NIL BITS 15)            (* ; "most of the bits of #ALINK")

-                                    (SLOWP FLAG)             (* ; 
-
                           "if on, then BLINK and CLINK fields are valid.  If off, they are implicit")

-                                    (NIL FULLXPOINTER 2)
-                                    (NAMETABHI WORD)
-                                    (NAMETABLO WORD)))
-              (TYPE?
 (IEQ (fetch
 (FX FLAGS) of
 DATUM)
-                          \STK.FX))
-              [ACCESSFNS FX ((NAMETABLE (COND
-                                           ((fetch
 (FX VALIDNAMETABLE) of
 DATUM)
-                                            (fetch
 (FX NAMETABLE#) of
 DATUM))
-                                           (T (fetch
 (FX FNHEADER) of
 DATUM)))
-                                    (PROGN (replace
 (FX FAST) of
 DATUM with
 NIL)
-                                           (replace
 (FX NAMETABLE#) of
 DATUM with
 NEWVALUE)
-                                           (replace
 (FX VALIDNAMETABLE) of
 DATUM with
 T)))
-                             (FRAMENAME (fetch
 (FNHEADER FRAMENAME) of
 (fetch
 (FX NAMETABLE)
-                                                                          of
 DATUM)))
-                             (INVALIDP (EQ DATUM 0))         (* ; 
-
                                     "true when A/CLink points at nobody, i.e. FX is bottom of stack")

-                             [FASTP (NOT (fetch
 (FX SLOWP) of
 DATUM))
-                                    (PROGN (CHECK (NULL NEWVALUE))
-                                           (COND
-                                              ((fetch
 (FX FASTP) of
 DATUM)
-                                               (replace
 (FX %#BLINK) of
 DATUM
-                                                  with
 (fetch
 (FX DUMMYBF) of
 DATUM))
-                                               (replace
 (FX %#CLINK) of
 DATUM
-                                                  with
 (fetch
 (FX %#ALINK) of
 DATUM))
-                                               (replace
 (FX SLOWP) of
 DATUM with
 T]
-                             [BLINK (COND
-                                       ((fetch
 (FX FASTP) of
 DATUM)
-                                        (fetch
 (FX DUMMYBF) of
 DATUM))
-                                       (T (fetch
 (FX %#BLINK) of
 DATUM)))
-                                    (PROGN (replace
 (FX %#BLINK) of
 DATUM with
 NEWVALUE)
-                                           (COND
-                                              ((fetch
 (FX FASTP) of
 DATUM)
-                                               (replace
 (FX %#CLINK) of
 DATUM
-                                                  with
 (fetch
 (FX %#ALINK) of
 DATUM))
-                                               (replace
 (FX SLOWP) of
 DATUM with
 T]
-                             [CLINK (IDIFFERENCE (COND
-                                                    ((fetch
 (FX FASTP) of
 DATUM)
-                                                     (fetch
 (FX %#ALINK) of
 DATUM))
-                                                    (T (fetch
 (FX %#CLINK) of
 DATUM)))
-                                           \#ALINK.OFFSET)
-                                    (PROGN (replace
 (FX %#CLINK) of
 DATUM with
 (IPLUS NEWVALUE 
-                                                                                      \#ALINK.OFFSET)
-                                                  )
-                                           (COND
-                                              ((fetch
 (FX FASTP) of
 DATUM)
-                                               (replace
 (FX %#BLINK) of
 DATUM
-                                                  with
 (fetch
 (FX DUMMYBF) of
 DATUM))
-                                               (replace
 (FX SLOWP) of
 DATUM with
 T]
-                             [ALINK (IDIFFERENCE (FLOOR (fetch
 (FX %#ALINK) of
 DATUM)
-                                                        WORDSPERCELL)
-                                           \#ALINK.OFFSET)
-                                    (PROGN [COND
-                                              ((fetch
 (FX FASTP) of
 DATUM)
-                                               (replace
 (FX %#BLINK) of
 DATUM
-                                                  with
 (fetch
 (FX DUMMYBF) of
 DATUM))
-                                               (replace
 (FX %#CLINK) of
 DATUM
-                                                  with
 (fetch
 (FX %#ALINK) of
 DATUM]
-                                           (replace
 (FX %#ALINK) of
 DATUM with
 (IPLUS NEWVALUE 
-                                                                                      \#ALINK.OFFSET
-                                                                                      (SUB1 
-                                                                                         WORDSPERCELL
-                                                                                            ]
-                             [ACLINK (SHOULDNT)
-                                    (PROGN [COND
-                                              ((fetch
 (FX FASTP) of
 DATUM)
-                                               (replace
 (FX %#BLINK) of
 DATUM
-                                                  with
 (fetch
 (FX DUMMYBF) of
 DATUM]
-                                           (replace
 (FX %#CLINK) of
 DATUM with
 (IPLUS NEWVALUE 
-                                                                                      \#ALINK.OFFSET)
-                                                  )
-                                           (replace
 (FX %#ALINK) of
 DATUM with
 (IPLUS NEWVALUE 
-                                                                                      \#ALINK.OFFSET
-                                                                                      (SUB1 
-                                                                                         WORDSPERCELL
-                                                                                            ]
-                                                             (* ; 
-
                                      "replaces A & C Links at once more efficiently than separately")

-                             (DUMMYBF (IDIFFERENCE DATUM WORDSPERCELL))
-
-                             (* ;; "This is either an actual BF or %"residual%" BF that provides enough BF to find its IVAR slot.  This means that when a FX is copied, the cell preceding the FX is copied too.")

-
-                             (IVAR (fetch
 (BF IVAR) of
 (fetch
 (FX DUMMYBF) of
 DATUM)))
-                             [CHECKED (AND (type?
 FX DATUM)
-                                           (OR (IEQ (fetch
 (FX DUMMYBF) of
 DATUM)
-                                                    (fetch
 (FX BLINK) of
 DATUM))
-                                               (AND (fetch
 (BF RESIDUAL) of
 (fetch
 (FX DUMMYBF)
-                                                                               of
 DATUM))
-                                                    (IEQ (fetch
 (BF IVAR) of
 (fetch
 (FX DUMMYBF)
-                                                                                of
 DATUM))
-                                                         (fetch
 (BF IVAR) of
 (fetch
 (FX BLINK)
-                                                                                of
 DATUM]
-                             (FIRSTPVAR (IPLUS DATUM (fetch
 (FX FXSIZE) of
 T)))
-                                                             (* ; "stack offset of PVAR0")

-                             (FXSIZE (PROGN 10))             (* ; 
-
                                                             "fixed overhead from flags thru clink")

-                             (PADDING (PROGN 4))             (* ; 
-
                                                            "doublecell of garbage for microcode use")

-                             (FIRSTTEMP (IPLUS (fetch
 (FX FIRSTPVAR) of
 DATUM)
-                                               (fetch
 (FX NPVARWORDS) of
 DATUM)
-                                               (fetch
 (FX PADDING) of
 DATUM)))
-                                                             (* ; 
-
                                                 "note that NPVARWORDS is obtained from the FNHEADER")

-                             (SIZE (IDIFFERENCE (fetch
 (FX NEXTBLOCK) of
 DATUM)
-                                          DATUM])
-
 (RECORD SPYOBJDATA
 (CACHEDLABEL PERCENT LABEL))
 )
 )
@@ -1053,17 +925,17 @@
 
 (MOVD? 'NILL 'MODERNWINDOW)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4707 7314 (SPYOBJ 4717 . 5006) (SPYOBJ.BUTTON 5008 . 5118) (SPYOBJ.SAVE 5120 . 5239) (
-SPYOBJ.COPY 5241 . 5303) (SPYOBJ.GET 5305 . 5434) (SPYOBJ.IMAGEBOX 5436 . 5960) (SPYOBJ.DISPLAY 5962
- . 6261) (SPYOBJ.LABEL 6263 . 6399) (SPYOBJ.HEIGHT 6401 . 6614) (SPYOBJ.COPYIN 6616 . 6659) (
-SPY.COPYBUTTON 6661 . 6753) (SPY.MERGEINFO 6755 . 7312)) (18156 60387 (SPY.FIND.TREE 18166 . 18575) (
-SPY.TOGGLE 18577 . 18767) (SPY.TREE 18769 . 19881) (SPY.LEGEND 19883 . 20233) (SPY.GRAPH.EDITOR 20235
- . 29800) (SPY.END 29802 . 30044) (SPY.MAKEGRAPHNODES 30046 . 32146) (SPY.MAX 32148 . 33031) (
-SPY.MERGE 33033 . 34464) (SPY.MERGE1 34466 . 40949) (SPY.MERGETREE 40951 . 43881) (SPY.NEXT.TREE 43883
- . 44557) (SPY.SUM 44559 . 45248) (SPY.TITLE 45250 . 45467) (SPY.MAKE.TREE 45469 . 47494) (
-SPY.UPDATE.TITLE 47496 . 50072) (SPY.DELETE 50074 . 50609) (SPY.DRAWBOX 50611 . 51136) (
-SPY.BUFFER.ENTRY 51138 . 51481) (SPY.BUTTON 51483 . 52052) (SPY.END.ENTRY 52054 . 52134) (SPY.START 
-52136 . 52420) (SPY.INIT 52422 . 52657) (\SPY.INTERRUPT 52659 . 54064) (SPY.DUMP.BUFFER 54066 . 55526)
- (SPY.START.ENTRY 55528 . 55656) (SPY.ADD.ENTRY 55658 . 56090) (SPY.ORIGINAL 56092 . 56919) (
-SPY.OVERFLOW 56921 . 57022) (SPY.MERGE.CALLEES 57024 . 60060) (SPY.PRINT 60062 . 60385)))))
+  (FILEMAP (NIL (4660 7267 (SPYOBJ 4670 . 4959) (SPYOBJ.BUTTON 4961 . 5071) (SPYOBJ.SAVE 5073 . 5192) (
+SPYOBJ.COPY 5194 . 5256) (SPYOBJ.GET 5258 . 5387) (SPYOBJ.IMAGEBOX 5389 . 5913) (SPYOBJ.DISPLAY 5915
+ . 6214) (SPYOBJ.LABEL 6216 . 6352) (SPYOBJ.HEIGHT 6354 . 6567) (SPYOBJ.COPYIN 6569 . 6612) (
+SPY.COPYBUTTON 6614 . 6706) (SPY.MERGEINFO 6708 . 7265)) (7731 49962 (SPY.FIND.TREE 7741 . 8150) (
+SPY.TOGGLE 8152 . 8342) (SPY.TREE 8344 . 9456) (SPY.LEGEND 9458 . 9808) (SPY.GRAPH.EDITOR 9810 . 19375
+) (SPY.END 19377 . 19619) (SPY.MAKEGRAPHNODES 19621 . 21721) (SPY.MAX 21723 . 22606) (SPY.MERGE 22608
+ . 24039) (SPY.MERGE1 24041 . 30524) (SPY.MERGETREE 30526 . 33456) (SPY.NEXT.TREE 33458 . 34132) (
+SPY.SUM 34134 . 34823) (SPY.TITLE 34825 . 35042) (SPY.MAKE.TREE 35044 . 37069) (SPY.UPDATE.TITLE 37071
+ . 39647) (SPY.DELETE 39649 . 40184) (SPY.DRAWBOX 40186 . 40711) (SPY.BUFFER.ENTRY 40713 . 41056) (
+SPY.BUTTON 41058 . 41627) (SPY.END.ENTRY 41629 . 41709) (SPY.START 41711 . 41995) (SPY.INIT 41997 . 
+42232) (\SPY.INTERRUPT 42234 . 43639) (SPY.DUMP.BUFFER 43641 . 45101) (SPY.START.ENTRY 45103 . 45231) 
+(SPY.ADD.ENTRY 45233 . 45665) (SPY.ORIGINAL 45667 . 46494) (SPY.OVERFLOW 46496 . 46597) (
+SPY.MERGE.CALLEES 46599 . 49635) (SPY.PRINT 49637 . 49960)))))
 STOP

library/lafite/UNIXMAIL

@@ -1,20 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "30-Sep-2021 16:06:26" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNIXMAIL.;2|
 82866  
 
-      |changes| |to:|  (VARS UNIXMAILCOMS)
-                       (FNS UNIX.POLLNEWMAIL UNIX.NEXTMESSAGE UNIXMAILER.OPENMAILBOX 
-                            UNIXMAILER.RETRIEVEMESSAGE UNIXMAILER.CLOSEMAILBOX UNIXSPOOL.OPENMAILBOX
-                            UNIXSPOOL.RETRIEVEMESSAGE UNIXSPOOL.CLOSEMAILBOX UNIX.FLUSH.STREAM 
-                            UNIX.RETRIEVE.LINE \\UNIXMAIL.SEND \\UNIXMAIL.SEND.WRAPLINES \\SMTP-DUMP
-                            \\UNIXMAIL.SEND.PARSE \\UNIXMAIL.CHECK.ABORT \\UNIXMAIL.MUNG.RECIPIENTS 
-                            \\UNIXMAIL.SMTP \\UNIXMAIL.SMTP.FLUSH \\UNIXMAIL.CHANGE.MODE 
-                            \\UNIXMAIL.AUTHENTICATE \\UNIXMAIL.LOGIN \\UNIXMAIL.PARSENAMES 
-                            \\UNIXMAIL.MAKEANSWERFORM \\UNIXMAIL.MESSAGE.FROM.SELF.P 
-                            \\UNIXMAIL.MESSAGE.P \\UNIXMAIL.REALADDRESS \\UNIXMAIL.FQNAME 
-                            \\UNIXMAIL.FIXMICROSOFT)
+
(FILECREATED "24-Feb-2024 10:26:07" |{DSK}<home>larry>il>medley>library>lafite>UNIXMAIL.;3|
 81776  
 
-      |previous| |date:| "10-Feb-2000 12:03:28" |{DSK}<project>medley3.5>library>unixmail.;42|)
+      :EDIT-BY "lmm"
+
+      :CHANGES-TO (VARS UNIXMAILCOMS)
+
+      :PREVIOUS-DATE "30-Sep-2021 16:06:26" |{DSK}<home>larry>il>medley>library>lafite>UNIXMAIL.;1|
+)
 
 
 ; Copyright (c) 1989-1992, 1997, 1999, 1920, 2021 by ENVOS Corporation.
@@ -22,7 +15,11 @@
 (PRETTYCOMPRINT UNIXMAILCOMS)
 
 (RPAQQ UNIXMAILCOMS

-       ((DECLARE\: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
+       (
+        (* |;;| " LMM 2/24/24 need LAFITE to load")

+
+        (FILES LAFITE)
+        (DECLARE\: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
                                                   LAFITEDECLS NSMAIL)
                (RECORDS UNIXMAILBOX UNIXMAILFILEINFO UNIXMAILPARSE))
         (ALISTS (LAFITEMODELST UNIX))
@@ -90,6 +87,13 @@
                                                    '(CHANGE \\SENDMSG.CHANGE.MODE TO 
                                                            \\UNIXMAIL.CHANGE.MODE)))))
         (PROP FILETYPE UNIXMAIL)))
+
+
+
+(* |;;| " LMM 2/24/24 need LAFITE to load")

+
+
+(FILESLOAD LAFITE)
 (DECLARE\: DOEVAL@COMPILE DONTCOPY 
 
 (FILESLOAD (SOURCE)
@@ -106,8 +110,8 @@
 )
 
 (ADDTOVAR LAFITEMODELST
 (UNIX 3 \\UNIXMAIL.SEND.PARSE \\UNIXMAIL.SEND \\UNIXMAIL.MAKEANSWERFORM 
-                                  \\UNIXMAIL.AUTHENTICATE \\UNIXMAIL.MESSAGE.P 
-                                  \\UNIXMAIL.MESSAGE.FROM.SELF.P \\UNIXMAIL.LOGIN))
+                              \\UNIXMAIL.AUTHENTICATE \\UNIXMAIL.MESSAGE.P 
+                              \\UNIXMAIL.MESSAGE.FROM.SELF.P \\UNIXMAIL.LOGIN))
 
 
 
@@ -133,9 +137,9 @@
 
 
 (RPAQQ UNIXMAIL.MSOPS.LIST
 ((MAILER UNIX.POLLNEWMAIL UNIXMAILER.OPENMAILBOX UNIX.NEXTMESSAGE 
-                                       UNIXMAILER.RETRIEVEMESSAGE UNIXMAILER.CLOSEMAILBOX)
-                                (SPOOL UNIX.POLLNEWMAIL UNIXSPOOL.OPENMAILBOX UNIX.NEXTMESSAGE 
-                                       UNIXSPOOL.RETRIEVEMESSAGE UNIXSPOOL.CLOSEMAILBOX)))
+                                   UNIXMAILER.RETRIEVEMESSAGE UNIXMAILER.CLOSEMAILBOX)
+                            (SPOOL UNIX.POLLNEWMAIL UNIXSPOOL.OPENMAILBOX UNIX.NEXTMESSAGE 
+                                   UNIXSPOOL.RETRIEVEMESSAGE UNIXSPOOL.CLOSEMAILBOX)))
 
 
 
@@ -979,13 +983,13 @@
 (* |;;| "This returns multiple-values, so it's a CL:LAMBDA (what the heck).")

 
 
-(CL:DEFUN \\UNIXMAIL.SMTP.TCP.STREAMS
 ()
             (* \; "Edited 27-Feb-99 13:55 by rmk:")

+(CL:DEFUN \\UNIXMAIL.SMTP.TCP.STREAMS
 ()
                     (* \; "Edited 27-Feb-99 13:55 by rmk:")

 
    (* |;;| "Opens two streams representing the input and output streams of an SMTP TCP connection.  On failure return NIL and a string describing the failure.")

 
    (SELECTQ UNIXMAIL.SEND.MODE
        (PROCESS (|if|
 (EQ (MACHINETYPE)
-                              'MAIKO)
+                          'MAIKO)
                     |then|

 
                     (* |;;| "UNIXMAIL.SEND.PROCESS can be a list of possibilities because the process may be in different places in different operating systems (e.g. solaris vs. sunos).  If the first one doesn't exist at this time, we search the remaining ones and move the first one we find to the beginning of the list for next time.  This could be done as an AFTERSYSOUTFORMS, but easy enough just to do it here.")

@@ -993,36 +997,32 @@
                     (LET ((S (CREATE-PROCESS-STREAM
                               (CONCAT (IF
 (NLISTP UNIXMAIL.SEND.PROCESS)
                                           THEN
 UNIXMAIL.SEND.PROCESS
-                                        ELSEIF
 (INFILEP (PACKFILENAME 'HOST 'DSK 'BODY
-                                                                   (CAR UNIXMAIL.SEND.PROCESS)))
+                                        ELSEIF
 (INFILEP (PACKFILENAME 'HOST 'DSK 'BODY (CAR 
+                                                                                UNIXMAIL.SEND.PROCESS
+                                                                                            )))
                                           THEN
 (CAR UNIXMAIL.SEND.PROCESS)
                                         ELSE
 (FOR
 P IN
 (CDR UNIXMAIL.SEND.PROCESS)
-                                                    WHEN
 (INFILEP (PACKFILENAME 'HOST
-                                                                             'DSK
-                                                                             'BODY P))
-                                                    DO
 (SETQ UNIXMAIL.SEND.PROCESS
-                                                            (CONS P (DREMOVE P UNIXMAIL.SEND.PROCESS)
-                                                                  ))
-                                                          (RETURN P)))
+                                                WHEN
 (INFILEP (PACKFILENAME 'HOST 'DSK 'BODY P))
+                                                DO
 (SETQ UNIXMAIL.SEND.PROCESS
+                                                    (CONS P (DREMOVE P UNIXMAIL.SEND.PROCESS)))
+                                                   (RETURN P)))
                                      (IF
 UNIXMAIL.SEND.HOST
                                          THEN
 (CONCAT " " UNIXMAIL.SEND.HOST)
                                        ELSE
 "")))))
                          (CL:VALUES S S))
                   |else|
 (CL:VALUES NIL 
                           "this MACHINETYPE can't do Unix process-streams; change UNIXMAIL.SEND.MODE"
-                                    )))
+                                )))
        (SOCKET (|if|
 (EQ (MACHINETYPE)
-                             'MAIKO)
-                   |then|
 (LET ((S (OPENTCPSTREAM (OR UNIXMAIL.SEND.HOST (UNIX-GETPARM "HOSTNAME"
-                                                                                    ))
-                                              25)))
-                                   (CL:VALUES S S))
+                         'MAIKO)
+                   |then|
 (LET ((S (OPENTCPSTREAM (OR UNIXMAIL.SEND.HOST (UNIX-GETPARM "HOSTNAME"))
+                                          25)))
+                               (CL:VALUES S S))
                  |else|
 (LET ((S (TCP.OPEN UNIXMAIL.SEND.HOST 25 NIL 'ACTIVE 'INPUT T)))
-                                 (|if|
 S
-                                     |then|
 (CL:VALUES S (TCP.OTHER.STREAM S))
-                                   |else|
 (CL:VALUES NIL 
-                                                 "TCP.OPEN failed; check your Lisp TCP configuration"
-                                                     )))))
+                             (|if|
 S
+                                 |then|
 (CL:VALUES S (TCP.OTHER.STREAM S))
+                               |else|
 (CL:VALUES NIL 
+                                             "TCP.OPEN failed; check your Lisp TCP configuration")))))
        (ERROR "Unrecognized UNIXMAIL.SEND.MODE:" UNIXMAIL.SEND.MODE)))
 
 
@@ -1368,23 +1368,22 @@
 
     (SETQ LAFITESENDINGMENUITEMS (EDITE (CONS (CAR LAFITESENDINGMENUITEMS)
                                               (CDR LAFITESENDINGMENUITEMS))
-                                        '(CHANGE
 \\SENDMSG.CHANGE.MODE TO \\UNIXMAIL.CHANGE.MODE)
-                                        )))
+                                        '(CHANGE
 \\SENDMSG.CHANGE.MODE TO \\UNIXMAIL.CHANGE.MODE))))
 
 (PUTPROPS UNIXMAIL
 FILETYPE
 :COMPILE-FILE)
 (PUTPROPS UNIXMAIL COPYRIGHT ("ENVOS Corporation" 1989 1990 1991 1992 1997 1999 1920 2021))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (7835 26260 (UNIX.POLLNEWMAIL 7845 . 9795) (UNIX.NEXTMESSAGE 9797 . 9973) (
-UNIXMAILER.OPENMAILBOX 9975 . 14371) (UNIXMAILER.RETRIEVEMESSAGE 14373 . 15580) (
-UNIXMAILER.CLOSEMAILBOX 15582 . 16607) (UNIXSPOOL.OPENMAILBOX 16609 . 22826) (
-UNIXSPOOL.RETRIEVEMESSAGE 22828 . 24909) (UNIXSPOOL.CLOSEMAILBOX 24911 . 26258)) (26308 56798 (
-UNIX.FLUSH.STREAM 26318 . 26899) (UNIX.RETRIEVE.LINE 26901 . 28090) (\\UNIXMAIL.SEND 28092 . 38386) (
-\\UNIXMAIL.SEND.WRAPLINES 38388 . 42018) (\\SMTP-DUMP 42020 . 43290) (\\UNIXMAIL.SEND.PARSE 43292 . 
-46536) (\\UNIXMAIL.CHECK.ABORT 46538 . 47366) (\\UNIXMAIL.MUNG.RECIPIENTS 47368 . 52236) (
-\\UNIXMAIL.SMTP 52238 . 52843) (\\UNIXMAIL.SMTP.FLUSH 52845 . 55322) (\\UNIXMAIL.CHANGE.MODE 55324 . 
-56796)) (56886 60196 (\\UNIXMAIL.SMTP.TCP.STREAMS 56886 . 60196)) (60275 81847 (
-\\UNIXMAIL.AUTHENTICATE 60285 . 61976) (\\UNIXMAIL.LOGIN 61978 . 62323) (\\UNIXMAIL.PARSENAMES 62325
- . 64643) (\\UNIXMAIL.MAKEANSWERFORM 64645 . 69527) (\\UNIXMAIL.MESSAGE.FROM.SELF.P 69529 . 70658) (
-\\UNIXMAIL.MESSAGE.P 70660 . 70979) (\\UNIXMAIL.REALADDRESS 70981 . 75025) (\\UNIXMAIL.FQNAME 75027 . 
-75632) (\\UNIXMAIL.FIXMICROSOFT 75634 . 81845)))))
+  (FILEMAP (NIL (7090 25515 (UNIX.POLLNEWMAIL 7100 . 9050) (UNIX.NEXTMESSAGE 9052 . 9228) (
+UNIXMAILER.OPENMAILBOX 9230 . 13626) (UNIXMAILER.RETRIEVEMESSAGE 13628 . 14835) (
+UNIXMAILER.CLOSEMAILBOX 14837 . 15862) (UNIXSPOOL.OPENMAILBOX 15864 . 22081) (
+UNIXSPOOL.RETRIEVEMESSAGE 22083 . 24164) (UNIXSPOOL.CLOSEMAILBOX 24166 . 25513)) (25563 56053 (
+UNIX.FLUSH.STREAM 25573 . 26154) (UNIX.RETRIEVE.LINE 26156 . 27345) (\\UNIXMAIL.SEND 27347 . 37641) (
+\\UNIXMAIL.SEND.WRAPLINES 37643 . 41273) (\\SMTP-DUMP 41275 . 42545) (\\UNIXMAIL.SEND.PARSE 42547 . 
+45791) (\\UNIXMAIL.CHECK.ABORT 45793 . 46621) (\\UNIXMAIL.MUNG.RECIPIENTS 46623 . 51491) (
+\\UNIXMAIL.SMTP 51493 . 52098) (\\UNIXMAIL.SMTP.FLUSH 52100 . 54577) (\\UNIXMAIL.CHANGE.MODE 54579 . 
+56051)) (56141 59147 (\\UNIXMAIL.SMTP.TCP.STREAMS 56141 . 59147)) (59226 80798 (
+\\UNIXMAIL.AUTHENTICATE 59236 . 60927) (\\UNIXMAIL.LOGIN 60929 . 61274) (\\UNIXMAIL.PARSENAMES 61276
+ . 63594) (\\UNIXMAIL.MAKEANSWERFORM 63596 . 68478) (\\UNIXMAIL.MESSAGE.FROM.SELF.P 68480 . 69609) (
+\\UNIXMAIL.MESSAGE.P 69611 . 69930) (\\UNIXMAIL.REALADDRESS 69932 . 73976) (\\UNIXMAIL.FQNAME 73978 . 
+74583) (\\UNIXMAIL.FIXMICROSOFT 74585 . 80796)))))
 STOP

lispusers/DEMO

@@ -0,0 +1,127 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "24-Mar-2023 11:59:58" {DSK}<home>larry>il>medley>lispusers>DEMO.;3
 5662   
+
+      :EDIT-BY "lmm"
+
+      :CHANGES-TO (VARS DEMOCOMS)
+
+      :PREVIOUS-DATE "24-Mar-2023 07:29:15" {DSK}<home>larry>il>medley>lispusers>DEMO.;2)
+
+
+(PRETTYCOMPRINT DEMOCOMS)
+
+(RPAQQ DEMOCOMS
 ((VARS (HELPTIME 1)
+                       (AUTOBACKTRACEFLG 'ALWAYS))
+                 (COMS * BKSYSOBJCOMS)
+                 (FNS MEDLEY-CONTRIB OPEN-URL)))
+
+(RPAQQ HELPTIME
 1)
+
+(RPAQQ AUTOBACKTRACEFLG
 ALWAYS)
+
+(RPAQQ BKSYSOBJCOMS
 [(FNS BKSYSOBJ BKSYSOBJ.BUTTONEVENTINFN BKSYSOBJ.COPYBUTTONEVENTINFN 
+                          BKSYSOBJ.DISPLAYFN BKSYSOBJ.FINDEXEC BKSYSOBJ.IMAGEBOXFN)
+                     (INITVARS (BKSYSOBJFNS (IMAGEFNSCREATE 'BKSYSOBJ.DISPLAYFN 'BKSYSOBJ.IMAGEBOXFN
+                                                   NIL NIL NIL 'BKSYSOBJ.BUTTONEVENTINFN 
+                                                   'BKSYSOBJ.COPYBUTTONEVENTINFN])
+(DEFINEQ
+
+(BKSYSOBJ

+  [LAMBDA (STRING)
                                           (* ; "Edited 18-Mar-2023 12:52 by rmk")

+    (IMAGEOBJCREATE STRING BKSYSOBJFNS])
+
+(BKSYSOBJ.BUTTONEVENTINFN

+  [LAMBDA (OBJ WINDOW)
                                       (* ; "Edited 18-Mar-2023 13:51 by rmk")

+    (LET [(EXECW (BKSYSOBJ.FINDEXEC
))
+          (STR (IMAGEOBJPROP OBJ 'OBJECTDATUM]
+         (CL:WHEN (MEMB (NTHCHARCODE STR -1)
+                        (CHARCODE (%) %])))
+             (SETQ STR (SUBSTRING STR 1 -2)))
+         (CL:WHEN EXECW
+             (GIVE.TTY.PROCESS EXECW)
+             (BKSYSBUF STR))])
+
+(BKSYSOBJ.COPYBUTTONEVENTINFN

+  [LAMBDA (OBJ WINDOW REGION)
                                (* ; "Edited  3-Jan-2022 08:36 by rmk")

+    (CL:WHEN (CAR (IMAGEOBJPROP OBJ 'COMPAREDATA))
+        [COPYINSERT (CAR (IMAGEOBJPROP OBJ 'COMPAREDATA])])
+
+(BKSYSOBJ.DISPLAYFN

+  [LAMBDA (OBJ WINDOW)
                                       (* ; "Edited 18-Mar-2023 13:04 by rmk")

+    (DSPFONT DEFAULTFONT WINDOW)
+    (FOR
 I C (FONTARRAY _ (FONTMAPARRAY))
+         (STRING _ (IMAGEOBJPROP OBJ 'OBJECTDATUM)) FROM
 1
+       DO
 (SELCHARQ (SETQ C (NTHCHARCODE STRING I))
+               (EOL (TERPRI WINDOW))
+               (NIL (RETURN))
+               (IF
 (EQ C (CONSTANT (CHARCODE.DECODE FONTESCAPECHAR)))
+                   THEN
 (DSPFONT (ELT FONTARRAY (NTHCHARCODE STRING (ADD
 I 1)))
+                               WINDOW)
+                 ELSE
 (PRINTCCODE C WINDOW])
+
+(BKSYSOBJ.FINDEXEC

+  [LAMBDA NIL
                                                (* ; "Edited 18-Mar-2023 13:45 by rmk")

+
+    (* ;; "Finds the first exec with an Interlisp read table.")

+
+    (find
 W P in
 (OPENWINDOWS) suchthat
 (SETQ P (WINDOWPROP W 'PROCESS))
+                                     (AND (STRPOS "EXEC" (PROCESSPROP P 'NAME)
+                                                 1 NIL T)
+                                          (STREQUAL "INTERLISP" (READTABLEPROP
+                                                                 (LISTGET (PROCESSPROP P 'PROFILE)
+                                                                        '*READTABLE*)
+                                                                 'NAME])
+
+(BKSYSOBJ.IMAGEBOXFN

+  [LAMBDA (OBJ IMAGESTREAM CURRENTX RIGHTMARGIN)
             (* ; "Edited 18-Mar-2023 13:04 by rmk")

+
+    (* ;; "Calculate the height of each line, and the width of the widest line.")

+
+    (* ;; 
+
    "Probably ought to compute the max height per line, at every font change, add it at each EOL.")

+
+    (SETQ IMAGESTREAM (GETSTREAM IMAGESTREAM 'OUTPUT))
+    (FOR
 I C (STRING _ (IMAGEOBJPROP OBJ 'OBJECTDATUM))
+         (FONT _ (FONTCREATE DEFAULTFONT NIL NIL NIL IMAGESTREAM))
+         (HEIGHT _ 0)
+         (LINELENGTH _ 0)
+         (MAXLINELENGTH _ 0)
+         (FONTARRAY _ (FONTMAPARRAY)) FROM
 1
+       DO
 (SELCHARQ (SETQ C (NTHCHARCODE STRING I))
+               (EOL (ADD
 HEIGHT (FONTPROP FONT 'HEIGHT))
+                    (CL:WHEN (IGREATERP LINELENGTH MAXLINELENGTH)
+                           (SETQ MAXLINELENGTH LINELENGTH))
+                    (SETQ LINELENGTH 0))
+               (NIL                                          (* ; "end of string")

+                    (CL:WHEN (IGREATERP LINELENGTH MAXLINELENGTH)
+                           (SETQ MAXLINELENGTH LINELENGTH))
+                    (RETURN (CREATE
 IMAGEBOX
+                                   XSIZE _ MAXLINELENGTH
+                                   YSIZE _ HEIGHT
+                                   YDESC _ (DIFFERENCE HEIGHT (FONTPROP FONT 'HEIGHT))
+                                   XKERN _ 0)))
+               (IF
 (EQ C (CONSTANT (CHARCODE.DECODE FONTESCAPECHAR)))
+                   THEN
 (SETQ FONT (FONTCREATE (ELT FONTARRAY (NTHCHARCODE STRING (ADD
 I 1)))
+                                          NIL NIL NIL IMAGESTREAM))
+                 ELSE
 (ADD
 LINELENGTH (CHARWIDTH C FONT])
+)
+
+(RPAQ? BKSYSOBJFNS
 (IMAGEFNSCREATE 'BKSYSOBJ.DISPLAYFN 'BKSYSOBJ.IMAGEBOXFN NIL NIL NIL 
+                          'BKSYSOBJ.BUTTONEVENTINFN 'BKSYSOBJ.COPYBUTTONEVENTINFN))
+(DEFINEQ
+
+(MEDLEY-CONTRIB

+  [LAMBDA (REPO)
                                             (* ; "Edited 15-Mar-2023 08:05 by lmm")

+    (OPEN-URL
 (CONCAT "https://github.com/Interlisp/" REPO "/graphs/contributors"])
+
+(OPEN-URL

+  [LAMBDA (URL)
                                              (* ; "Edited 24-Mar-2023 06:31 by lmm")

+    (ShellBrowse URL])
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (1038 5085 (BKSYSOBJ 1048 . 1211) (BKSYSOBJ.BUTTONEVENTINFN 1213 . 1668) (
+BKSYSOBJ.COPYBUTTONEVENTINFN 1670 . 1923) (BKSYSOBJ.DISPLAYFN 1925 . 2572) (BKSYSOBJ.FINDEXEC 2574 . 
+3334) (BKSYSOBJ.IMAGEBOXFN 3336 . 5083)) (5264 5639 (MEDLEY-CONTRIB 5274 . 5490) (OPEN-URL 5492 . 5637
+)))))
+STOP

lispusers/DEMO.TEDIT

@@ -0,0 +1,29 @@
+
+DEMO -- utilities for running demos / tutorials in Medley
+
+includes
+   OPEN-URL (URL)  
+                 (rename of ShellBrowse)
+   MEDLEY-CONTRIB(REPO)
+                  shows GitHub contributors to given repo
+                  uses ShellBrowse
+    BKSYSOBJ(string)
+
+
+DEMO-*.TEDIT
+    contains scripts / TEDIT file talks
+    add your own
+
+
+
+BKSYSOBJ is the start of a facility
+
+(TEDIT.INSERT.OBJ (BKSYSOBJ ª(CONS NILº)     (TEXTSTREAM(WHICHW)]
+
+
+
+You should see (CONS NIL) in the TEDIT stream, clicking should shove (CONS NIL into an Interlisp exec, waiting for ) or ].  (probably the image objectg should be shaded, may also have to set the RDTBL flag on BKSYSBUF for strings, but this is a start).
+
+
+
+

lispusers/DINFO

@@ -1,16 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 4-Aug-2022 09:56:25" {DSK}<home>larry>medley>lispusers>DINFO.;2
 65548  
+
(FILECREATED "10-Mar-2024 15:38:36" {WMEDLEY}<lispusers>DINFO.;12
 65343  
 
-      :CHANGES-TO (FNS DINFO.UPDATE.FMENU DINFO.UPDATE.MENU.DISPLAY DINFO.UPDATE.HISTORY 
-                       DINFO.UPDATE.GRAPH.DISPLAY DINFO.LAYOUTGRAPH)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE " 3-Feb-2022 11:57:39" {DSK}<home>larry>medley>lispusers>DINFO.;1)
+      :CHANGES-TO (FNS DINFO.OPENTEXTSTREAM)
 
+      :PREVIOUS-DATE " 9-Mar-2024 22:21:42" {WMEDLEY}<lispusers>DINFO.;10)
 
-(* ; "
-Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
-")
 
 (PRETTYCOMPRINT DINFOCOMS)
 
@@ -538,7 +535,8 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
                 (DINFO.UPDATE.FMENU
 GRAPH])
 
 (DINFO.CREATE.FMENU

-  [LAMBDA (GRAPH)
                                       (* ; "Edited 25-Oct-2021 23:23 by rmk:")


+  [LAMBDA (GRAPH)
                                            (* ; "Edited  9-Mar-2024 14:20 by rmk")


+                                                            (* ; "Edited 25-Oct-2021 23:23 by rmk:")

                                                              (* jow "15-Jul-86 17:39")

 
 (* ;;; "Makes a DInfo FreeMenu for GRAPH")

@@ -548,7 +546,7 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
     (LET* [(ADD.ITEMS (fetch
 (DINFOGRAPH
 FREEMENUITEMS) of
 GRAPH))
            (FONT (OR (FONTP (fetch
 (DINFOGRAPH
 MENUFONT) of
 GRAPH))
                      MENUFONT))
-           [FM (FREEMENU `((PROPS FONT %, FONT)
+           [FM (FREEMENU `((PROPS FONT ,FONT)
                            ((LABEL Node%: TYPE DISPLAY FONT (HELVETICA 10))
                             (ID NODE LABEL "" TYPE DISPLAY))
                            ((LABEL Top! SELECTEDFN DINFO.FMENU.HANDLER FONT (HELVETICA 10 BOLD)
@@ -564,31 +562,30 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
                                    MESSAGE "Visit the node after the current node")
                             (ID NEXT LABEL "" TYPE DISPLAY))
                            ((LABEL Display%: TYPE DISPLAY FONT (HELVETICA 10))
-                            (LABEL Graph ID GRAPH INITSTATE %, (MEMB 'GRAPH DINFOMODES)
+                            (LABEL Graph ID GRAPH INITSTATE ,(MEMB 'GRAPH DINFOMODES)
                                    TYPE TOGGLE SELECTEDFN DINFO.TOGGLE.GRAPH FONT (HELVETICA 10 BOLD)
                                    MESSAGE "Toggle display of the graph")
-                            (LABEL Menu ID MENU INITSTATE %, (MEMB 'MENU DINFOMODES)
+                            (LABEL Menu ID MENU INITSTATE ,(MEMB 'MENU DINFOMODES)
                                    TYPE TOGGLE SELECTEDFN DINFO.TOGGLE.MENU FONT (HELVETICA 10 BOLD)
                                    MESSAGE "Toggle display of the subnode menu")
-                            (LABEL Text ID TEXT INITSTATE %, (MEMB 'TEXT DINFOMODES)
+                            (LABEL Text ID TEXT INITSTATE ,(MEMB 'TEXT DINFOMODES)
                                    TYPE TOGGLE SELECTEDFN DINFO.TOGGLE.TEXT FONT (HELVETICA 10 BOLD)
                                    MESSAGE "Toggle display of the text of the current node")
-                            (LABEL History ID HISTORY INITSTATE %, (MEMB 'HISTORY DINFOMODES)
+                            (LABEL History ID HISTORY INITSTATE ,(MEMB 'HISTORY DINFOMODES)
                                    TYPE TOGGLE FONT (HELVETICA 10 BOLD)
                                    SELECTEDFN DINFO.TOGGLE.HISTORY MESSAGE 
                                    "Toggle the display of the History Menu"))
-                           %,
-                           (APPEND '((LABEL Find! SELECTEDFN DINFO.FMENU.HANDLER FONT
-                                            (HELVETICA 10 BOLD)
-                                            MESSAGE 
+                           ,(APPEND '((LABEL Find! SELECTEDFN DINFO.FMENU.HANDLER FONT
+                                             (HELVETICA 10 BOLD)
+                                             MESSAGE 
                                    "Perform a string search in the selected text of the current node"
-                                            )
-                                     (LABEL Lookup! SELECTEDFN DINFO.FMENU.HANDLER FONT
-                                            (HELVETICA 10 BOLD)
-                                            MESSAGE 
+                                             )
+                                      (LABEL Lookup! SELECTEDFN DINFO.FMENU.HANDLER FONT
+                                             (HELVETICA 10 BOLD)
+                                             MESSAGE 
                             "Lookup a term in this graph.  LEFT for new term, MIDDLE to repeat last."
-                                            ))
-                                  ADD.ITEMS]
+                                             ))
+                                   ADD.ITEMS]
            (HEIGHT (FETCH
 (REGION HEIGHT) OF
 (WINDOWPROP FM 'REGION]
           (WINDOWPROP FM 'FM.DONTRESHAPE T)
           (WINDOWPROP FM 'MINSIZE (CONS 0 HEIGHT))
@@ -859,11 +856,11 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
                        (fetch
 (DINFONODE LABEL) of
 (fetch
 (DINFOGRAPH
 CURRENTNODE) of
 DINFO.GRAPH])
 
 (DINFO.UPDATE.FROM.GRAPH

-  [LAMBDA (GRAPHER.NODE GRAPH.WINDOW)
                        (* drc%: "12-Dec-85 18:34")

-    (AND GRAPHER.NODE (ADD.PROCESS `(DINFO.UPDATE
 (QUOTE %, (WINDOWPROP GRAPH.WINDOW 'DINFOGRAPH))
-                                           (QUOTE %, (fetch (GRAPHNODE NODEID)
-                                                            of GRAPHER.NODE))) 'NAME 
-                             "DInfo From Graph"])
+  [LAMBDA (GRAPHER.NODE GRAPH.WINDOW)
                        (* ; "Edited  9-Mar-2024 14:21 by rmk")

+                                                             (* drc%: "12-Dec-85 18:34")

+    (AND GRAPHER.NODE (ADD.PROCESS `[DINFO.UPDATE
 ',(WINDOWPROP GRAPH.WINDOW 'DINFOGRAPH)
+                                           ',(fetch
 (GRAPHNODE NODEID) of
 GRAPHER.NODE]
+                             'NAME "DInfo From Graph"])
 
 (DINFO.GET.GRAPH.WINDOW

   [LAMBDA (GRAPH REGION)
                                     (* drc%: "25-Jan-86 18:05")

@@ -1039,23 +1036,23 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
                 (PROMPTPRINT "DInfo is busy"])
 
 (DINFO.OPENTEXTSTREAM

-  [LAMBDA (FILE WINDOW FROM TO PROPS)
                        (* drc%: "25-Jan-86 18:24")

+  [LAMBDA (FILE WINDOW FROM TO PROPS)
                        (* ; "Edited 10-Mar-2024 15:37 by rmk")

+                                                             (* drc%: "25-Jan-86 18:24")

     (RESETFORM (TTYDISPLAYSTREAM (GETPROMPTWINDOW WINDOW))
            (LET ((TEXTSTREAM (WINDOWPROP WINDOW 'TEXTSTREAM))
                  (THIS.TEXT (LIST FILE FROM TO)))
                 (if
 (AND (EQUAL THIS.TEXT (fetch
 (DINFOGRAPH
 LAST.TEXT) of
 (DINFOGRAPH
 WINDOW)))
-                         TEXTSTREAM)
-                    then
                                     (* Same text, and its still there, so 
-
                                                             do nothing.)

+                         (\GETSTREAM TEXTSTREAM 'INPUT T))
+                    then
 
+                         (* ;; "Same text, and it's still there and open, so do nothing.")

+
                          TEXTSTREAM
                   else
 (AND TEXTSTREAM (TEDIT.KILL TEXTSTREAM))
                        (CLEARW T)
                        (CLEARW WINDOW)
-                       [RESETSAVE NIL `(AND RESETSTATE (WINDOWPROP %, WINDOW 'LAST.TEXT NIL]
-                       (PRINTOUT T "Fetching text from " FILE "...")
+                       [RESETSAVE NIL `(AND RESETSTATE (WINDOWPROP ,WINDOW 'LAST.TEXT NIL]
                        (PROG1 (OPENTEXTSTREAM FILE WINDOW FROM TO PROPS)
-                              (PRINTOUT T "OK.")
-                              (replace
 (DINFOGRAPH
 LAST.TEXT) of
 (DINFOGRAPH
 WINDOW) with
 THIS.TEXT])
+                           (replace
 (DINFOGRAPH
 LAST.TEXT) of
 (DINFOGRAPH
 WINDOW) with
 THIS.TEXT))])
 
 (DINFO.SHOWSEL

   [LAMBDA (TEXTSTREAM SEL)
                                   (* drc%: "16-Jan-86 21:30")

@@ -1110,23 +1107,22 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
 
 (SETTEMPLATE 'DINFOGRAPHPROP 'MACRO)
 )
-(PUTPROPS DINFO COPYRIGHT ("Xerox Corporation" 1985 1986 1987 2020 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4744 6203 (DINFOGRAPHPROP 4744 . 6203)) (7457 24595 (DINFO 7467 . 9081) (DINFO.UPDATE 
-9083 . 11947) (DINFOGRAPH 11949 . 12367) (DINFO.SPECIAL.UPDATE 12369 . 14067) (DINFO.READ.GRAPH 14069
- . 15924) (DINFO.WRITE.GRAPH 15926 . 17016) (DINFO.SELECT.GRAPH 17018 . 17925) (DINFO.DEFAULT.MENU 
-17927 . 20451) (DINFO.FIND 20453 . 23039) (DINFO.LOOKUP 23041 . 24593)) (24596 27290 (
-DINFO.READ.KOTO.GRAPH 24606 . 27288)) (27291 29605 (DINFO.SETUP.WINDOW 27301 . 27982) (DINFO.CLOSEFN 
-27984 . 28417) (DINFO.SHRINKFN 28419 . 28615) (DINFO.EXPANDFN 28617 . 29174) (DINFO.ICONFN 29176 . 
-29603)) (29606 40850 (DINFO.ADD.FMENU 29616 . 30711) (DINFO.CREATE.FMENU 30713 . 34662) (
-DINFO.FMW.CLOSEFN 34664 . 35509) (DINFO.FMENU.HANDLER 35511 . 36150) (DINFO.UPDATE.FMENU 36152 . 38341
-) (DINFO.TOGGLE.MENU 38343 . 38933) (DINFO.TOGGLE.GRAPH 38935 . 39434) (DINFO.TOGGLE.HISTORY 39436 . 
-39980) (DINFO.TOGGLE.TEXT 39982 . 40848)) (40851 48646 (DINFO.UPDATE.MENU.DISPLAY 40861 . 44982) (
-DINFO.UPDATE.FROM.MENU 44984 . 45283) (DINFO.UPDATE.HISTORY 45285 . 47815) (DINFO.HISTORIC.UPDATE 
-47817 . 48644)) (48647 58943 (DINFO.UPDATE.GRAPH.DISPLAY 48657 . 50109) (DINFO.UPDATE.FROM.GRAPH 50111
- . 50554) (DINFO.GET.GRAPH.WINDOW 50556 . 51141) (DINFO.CREATE.GRAPH.WINDOW 51143 . 52260) (
-DINFO.SHOWGRAPH 52262 . 53987) (DINFO.INVERT.NODE 53989 . 55377) (DINFO.LAYOUTGRAPH 55379 . 58941)) (
-58944 64887 (DINFO.UPDATE.TEXT.DISPLAY 58954 . 60902) (DINFO.TITLEMENUFN 60904 . 62029) (
-DINFO.OPENTEXTSTREAM 62031 . 63247) (DINFO.SHOWSEL 63249 . 63982) (DINFO.GET.FILENAME 63984 . 64885)))
+  (FILEMAP (NIL (4556 6015 (DINFOGRAPHPROP 4556 . 6015)) (7269 24407 (DINFO 7279 . 8893) (DINFO.UPDATE 
+8895 . 11759) (DINFOGRAPH 11761 . 12179) (DINFO.SPECIAL.UPDATE 12181 . 13879) (DINFO.READ.GRAPH 13881
+ . 15736) (DINFO.WRITE.GRAPH 15738 . 16828) (DINFO.SELECT.GRAPH 16830 . 17737) (DINFO.DEFAULT.MENU 
+17739 . 20263) (DINFO.FIND 20265 . 22851) (DINFO.LOOKUP 22853 . 24405)) (24408 27102 (
+DINFO.READ.KOTO.GRAPH 24418 . 27100)) (27103 29417 (DINFO.SETUP.WINDOW 27113 . 27794) (DINFO.CLOSEFN 
+27796 . 28229) (DINFO.SHRINKFN 28231 . 28427) (DINFO.EXPANDFN 28429 . 28986) (DINFO.ICONFN 28988 . 
+29415)) (29418 40740 (DINFO.ADD.FMENU 29428 . 30523) (DINFO.CREATE.FMENU 30525 . 34552) (
+DINFO.FMW.CLOSEFN 34554 . 35399) (DINFO.FMENU.HANDLER 35401 . 36040) (DINFO.UPDATE.FMENU 36042 . 38231
+) (DINFO.TOGGLE.MENU 38233 . 38823) (DINFO.TOGGLE.GRAPH 38825 . 39324) (DINFO.TOGGLE.HISTORY 39326 . 
+39870) (DINFO.TOGGLE.TEXT 39872 . 40738)) (40741 48536 (DINFO.UPDATE.MENU.DISPLAY 40751 . 44872) (
+DINFO.UPDATE.FROM.MENU 44874 . 45173) (DINFO.UPDATE.HISTORY 45175 . 47705) (DINFO.HISTORIC.UPDATE 
+47707 . 48534)) (48537 58866 (DINFO.UPDATE.GRAPH.DISPLAY 48547 . 49999) (DINFO.UPDATE.FROM.GRAPH 50001
+ . 50477) (DINFO.GET.GRAPH.WINDOW 50479 . 51064) (DINFO.CREATE.GRAPH.WINDOW 51066 . 52183) (
+DINFO.SHOWGRAPH 52185 . 53910) (DINFO.INVERT.NODE 53912 . 55300) (DINFO.LAYOUTGRAPH 55302 . 58864)) (
+58867 64756 (DINFO.UPDATE.TEXT.DISPLAY 58877 . 60825) (DINFO.TITLEMENUFN 60827 . 61952) (
+DINFO.OPENTEXTSTREAM 61954 . 63116) (DINFO.SHOWSEL 63118 . 63851) (DINFO.GET.FILENAME 63853 . 64754)))
 ))
 STOP

lispusers/MODERNIZE

@@ -1,12 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "29-Oct-2023 10:56:48" {WMEDLEY}<lispusers>MODERNIZE.;48
 30909  
+
(FILECREATED "27-Jan-2024 13:38:15" {DSK}<home>frank>il>medley>gmedley>lispusers>MODERNIZE.;7
 30816  
 
-      :EDIT-BY rmk
+      :CHANGES-TO (FNS \MODERNIZED.TEDIT.BUTTONEVENTFN)
 
-      :CHANGES-TO (FNS NEARESTCORNER)
-
-      :PREVIOUS-DATE "29-Jul-2023 10:48:55" {WMEDLEY}<lispusers>MODERNIZE.;47)
+      :PREVIOUS-DATE "27-Jan-2024 13:28:36" {DSK}<home>frank>il>medley>gmedley>lispusers>MODERNIZE.;6
+)
 
 
 (PRETTYCOMPRINT MODERNIZECOMS)
@@ -368,26 +367,24 @@
          (\CURSORPOSITION X Y])
 
 (INCORNER.REGION

-  [LAMBDA (CORNERREGION TOPMARGIN)
                      (* ; "Edited 13-Oct-2021 15:04 by rmk:")

+  [LAMBDA (CORNERREGION TOPMARGIN)
                          (* ; "Edited 13-Oct-2021 15:04 by rmk:")

 
     (* ;; "CORNERREGION, LASTMOUSEX, LASTMOUSEY in screen coordinates.")

 
     (* ;; "TOPMARGIN is the height of the titlebar for titled windows, otherwise the margin at the top of the window's content that we regard as the top. ")

 
-    (IF
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH
 LEFT OF
 CORNERREGION)))
-                  MODERN-WINDOW-MARGIN)
-        THEN
 (IF
 (NEARTOP
 CORNERREGION TOPMARGIN)
-                     THEN
 'LEFTTOP
-                   ELSEIF
 (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (FETCH
 BOTTOM
-                                                                              OF
 CORNERREGION)))
-                     THEN
 'LEFTBOTTOM)
-      ELSEIF
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH
 RIGHT OF
 CORNERREGION)))
-                       MODERN-WINDOW-MARGIN)
-        THEN
 (IF
 (NEARTOP
 CORNERREGION TOPMARGIN)
-                     THEN
 'RIGHTTOP
-                   ELSEIF
 (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (FETCH
 BOTTOM
-                                                                              OF
 CORNERREGION)))
-                     THEN
 'RIGHTBOTTOM])
+    (if
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (fetch
 LEFT of
 CORNERREGION)))
+              MODERN-WINDOW-MARGIN)
+        then
 (if
 (NEARTOP
 CORNERREGION TOPMARGIN)
+                 then
 'LEFTTOP
+               elseif
 (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (fetch
 BOTTOM of
 CORNERREGION)))
+                 then
 'LEFTBOTTOM)
+      elseif
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (fetch
 RIGHT of
 CORNERREGION)))
+                   MODERN-WINDOW-MARGIN)
+        then
 (if
 (NEARTOP
 CORNERREGION TOPMARGIN)
+                 then
 'RIGHTTOP
+               elseif
 (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (fetch
 BOTTOM of
 CORNERREGION)))
+                 then
 'RIGHTBOTTOM])
 )
 
 
@@ -510,9 +507,11 @@
     (* ;; "We pass the pane that received the click, because that's what the original \TEDIT.BUTTONEVENTFN needs to see, if we decide not to shape or move.")

 
     (MODERNWINDOW.BUTTONEVENTFN
 W (FUNCTION MODERN-ORIG-\TEDIT.BUTTONEVENTFN)
-           NIL NIL [APPLY (FUNCTION UNIONREGIONS)
-                          (bind
 PANE _ (CENTRALWINDOW W) collect
 (WINDOWPROP PANE 'REGION)
-                             repeatwhile
 (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]
+           NIL
+           (WINDOWPROP W 'MODERNIZE.TITLEPROPORTION)
+           [APPLY (FUNCTION UNIONREGIONS)
+                  (bind
 PANE _ (CENTRALWINDOW W) collect
 (WINDOWPROP PANE 'REGION)
+                     repeatwhile
 (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]
            (WINDOWPROP (CENTRALWINDOW W)
                   'TITLE])
 )
@@ -615,11 +614,11 @@
 (ADDTOVAR LAMA
 MODERN-ADD-EXEC)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5048 11410 (MODERNWINDOW 5058 . 6598) (MODERNWINDOW.SETUP 6600 . 9549) (UNMODERNWINDOW 
-9551 . 9945) (MODERNWINDOW.UNSETUP 9947 . 10759) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10761 . 11408)) (
-11475 22625 (MODERNWINDOW.BUTTONEVENTFN 11485 . 18512) (NEARTOP 18514 . 19442) (NEARESTCORNER 19444 . 
-21311) (INCORNER.REGION 21313 . 22623)) (22683 25155 (MODERN-ADD-EXEC 22693 . 23124) (MODERN-SNAPW 
-23126 . 23669) (TOTOPW.MODERNIZE 23671 . 24099) (MODERN-MENUBUTTONFN 24101 . 25153)) (25156 27585 (
-\MODERNIZED.FREEMENU.BUTTONEVENTFN 25166 . 25813) (MODERNIZED.TB.BUTTONEVENTFN 25815 . 27583)) (27626 
-29148 (TEDIT.MODERNIZE 27636 . 27989) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27991 . 29146)))))
+  (FILEMAP (NIL (5095 11457 (MODERNWINDOW 5105 . 6645) (MODERNWINDOW.SETUP 6647 . 9596) (UNMODERNWINDOW 
+9598 . 9992) (MODERNWINDOW.UNSETUP 9994 . 10806) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10808 . 11455)) (
+11522 22488 (MODERNWINDOW.BUTTONEVENTFN 11532 . 18559) (NEARTOP 18561 . 19489) (NEARESTCORNER 19491 . 
+21358) (INCORNER.REGION 21360 . 22486)) (22546 25018 (MODERN-ADD-EXEC 22556 . 22987) (MODERN-SNAPW 
+22989 . 23532) (TOTOPW.MODERNIZE 23534 . 23962) (MODERN-MENUBUTTONFN 23964 . 25016)) (25019 27448 (
+\MODERNIZED.FREEMENU.BUTTONEVENTFN 25029 . 25676) (MODERNIZED.TB.BUTTONEVENTFN 25678 . 27446)) (27489 
+29055 (TEDIT.MODERNIZE 27499 . 27852) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27854 . 29053)))))
 STOP

sources/HPRINT

@@ -1,18 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "31-Jul-2023 13:33:10" {WMEDLEY}<sources>HPRINT.;5
 57926  
+
(FILECREATED "15-Jan-2024 13:54:51" {WMEDLEY}<sources>HPRINT.;16
 62566  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS EQUALALL)
+      :CHANGES-TO (FNS BLOCKEQUALP)
 
-      :PREVIOUS-DATE " 3-Aug-2022 21:31:57" {WMEDLEY}<sources>HPRINT.;2)
+      :PREVIOUS-DATE "11-Jan-2024 10:52:14" {WMEDLEY}<sources>HPRINT.;14)
 
 
-(* ; "
-Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation.
-")
-
 (PRETTYCOMPRINT HPRINTCOMS)
 
 (RPAQQ HPRINTCOMS

@@ -23,7 +19,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation
         (FNS HPRINT HPRINT1 HPRINTEND RPTPRINT RPTEND RPTPUT HPRINTSP HPERR HVFWDCDREAD HVBAKREAD 
              HVREADCHECKGETFN HVREADEND HVRPTREAD HVFWDREAD HREAD HPINITRDTBL HVREADERR HPRINSP)
         (FNS COPYALL \COPYDATATYPE HCOPYALL HCOPYALL1)
-        (FNS EQUALALL EQUALHASH)
+        (FNS EQUALALL EQUALHASH BLOCKEQUALP)
         (BLOCKS (COPYALL COPYALL (NOLINKFNS . T)
                        (GLOBALVARS SYSHASHARRAY))
                (EQUALALL EQUALALL EQUALHASH (RETFNS EQUALHASH)
@@ -902,7 +898,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation
 (DEFINEQ
 
 (EQUALALL

-  [LAMBDA (X Y)
                                              (* ; "Edited 31-Jul-2023 13:31 by rmk")


+  [LAMBDA (X Y)
                                              (* ; "Edited 24-Dec-2023 21:34 by rmk")


+                                                             (* ; "Edited 31-Jul-2023 13:31 by rmk")


                                                             (* ; "Edited 26-Apr-2021 14:34 by rmk:")

     (OR (EQ X Y)
         (PROG ((TY (TYPENAME Y))
@@ -974,9 +971,10 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation
                                ((BITMAP BIGBM) 
                                     (BITMAPEQUAL X Y))
                                (OR (EQP X Y)
-                                   (AND (SETQ TY (GETDESCRIPTORS TY))
-                                        (for
 FIELD in
 TY always
 (EQUALALL
 (FETCHFIELD FIELD X)
-                                                                       (FETCHFIELD FIELD Y])
+                                   (if
 (SETQ TEM (GETDESCRIPTORS TY))
+                                       then
 (for
 FIELD in
 TEM always
 (EQUALALL
 (FETCHFIELD FIELD X)
+                                                                            (FETCHFIELD FIELD Y)))
+                                     else
 (BLOCKEQUALP X Y])
 
 (EQUALHASH

   [LAMBDA (AR1 AR2)
@@ -1006,6 +1004,63 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation
                                                                               (GETHASH Y AR1]
                                        (RETFROM (FUNCTION EQUALHASH]
     T])
+
+(BLOCKEQUALP

+  [LAMBDA (BLOCK1 BLOCK2)
                                    (* ; "Edited 15-Jan-2024 13:54 by rmk")


+                                                             (* ; "Edited 11-Jan-2024 10:52 by rmk")


+                                                             (* ; "Edited  1-Jan-2024 22:59 by rmk")


+                                                             (* ; "Edited 24-Dec-2023 21:14 by rmk")


+                                                             (* ; "Edited 10-Dec-2023 21:19 by rmk")

+
+    (* ;; "True if BLOCK1 and BLOCK2 are blocks (produced by \ALLOCBLOCK) of equal size and equivalent contents.  Small blocks are allocated as hunks. Hunks have their own datatypes, blocks have type NIL and type number 0.  Either way the type numbers have to be the same.")

+
+    (* ;; "The ARLEN of blocks may be bigger than the requested allocation size, given the way the allocator works.  We return NIL if they differ up to the ARLEN of the smallest block, and all the cells in the larger block above that are the initial value, NIL or 0.")

+
+    (OR (EQ BLOCK1 BLOCK2)
+        (CL:WHEN (AND (\BLOCKDATAP BLOCK1)
+                      (\BLOCKDATAP BLOCK2))
+
+            (* ;; "\BLOCKDATAP tests both arrayblocks and hunks")

+
+            [LET (HDR1 HDR2 NWORDS1 NWORDS2 GCTYPE DTD (TYPENO (NTYPX BLOCK1)))
+                 (AND (EQ TYPENO (NTYPX BLOCK2))
+                      (if
 (NEQ 0 TYPENO)
+                          then
 (SETQ DTD (\GETDTD TYPENO))   (* ; 
+
                                                        "Hunks: if TYNO's are the same, so are DTD's")

+                               (SETQ GCTYPE (fetch
 DTDGCTYPE of
 DTD))
+                               (SETQ NWORDS1 (SETQ NWORDS2 (fetch
 DTDSIZE of
 DTD)))
+                        else
 (SETQ HDR1 (\ADDBASE BLOCK1 (IMINUS \ArrayBlockHeaderWords))) 
+                                                             (* ; "Real blocks, get the headers")

+                             (SETQ HDR2 (\ADDBASE BLOCK1 (IMINUS \ArrayBlockHeaderWords)))
+                             (SETQ NWORDS1 (UNFOLD (IDIFFERENCE (ffetch
 (ARRAYBLOCK ARLEN)
+                                                                   of
 HDR1)
+                                                          \ArrayBlockOverheadCells)
+                                                  WORDSPERCELL))
+                             (SETQ NWORDS2 (UNFOLD (IDIFFERENCE (ffetch
 (ARRAYBLOCK ARLEN)
+                                                                   of
 HDR2)
+                                                          \ArrayBlockOverheadCells)
+                                                  WORDSPERCELL))
+                             (SETQ GCTYPE (ffetch
 (ARRAYBLOCK GCTYPE) of
 HDR1))
+                             (EQ GCTYPE (ffetch
 (ARRAYBLOCK GCTYPE) of
 HDR2)))
+                      (if
 (EQ PTRBLOCK.GCT GCTYPE)
+                          then
 [AND (for
 I from
 0 to
 (SUB1 (IMIN NWORDS1 NWORDS2)) by
 WORDSPERCELL
+                                       always
 (EQUALALL
 (\GETBASEPTR BLOCK1 I)
+                                                     (\GETBASEPTR BLOCK2 I)))
+                                    (if
 (IEQP NWORDS1 NWORDS2)
+                                      elseif
 (IGREATERP NWORDS1 NWORDS2)
+                                        then
 (for
 I from
 NWORDS2 to
 (SUB1 NWORDS1) by
 WORDSPERCELL
+                                                never
 (\GETBASEPTR BLOCK2 I))
+                                      else
 (for
 I from
 NWORDS1 to
 (SUB1 NWORDS2) by
 WORDSPERCELL
+                                              never
 (\GETBASEPTR BLOCK1 I]
+                        else
 (AND (for
 I from
 0 to
 (SUB1 (IMIN NWORDS1 NWORDS2)) by
 WORDSPERCELL
+                                     always
 (IEQP (\GETBASEFIXP BLOCK1 I)
+                                                  (\GETBASEFIXP BLOCK2 I)))
+                                  (if
 (IEQP NWORDS1 NWORDS2)
+                                    elseif
 (IGREATERP NWORDS1 NWORDS2)
+                                      then
 (for
 I from
 NWORDS2 to
 (SUB1 NWORDS1) by
 WORDSPERCELL
+                                              always
 (EQ 0 (\GETBASEFIXP BLOCK2 I)))
+                                    else
 (for
 I from
 NWORDS1 to
 (SUB1 NWORDS2) by
 WORDSPERCELL
+                                            always
 (EQ 0 (\GETBASEFIXP BLOCK1 I])])
 )
 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
 
@@ -1115,17 +1170,16 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation
 
 (ADDTOVAR LAMA
 )
 )
-(PUTPROPS HPRINT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991 
-1993 1994 2022))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3652 6190 (MAKEHVPRETTYCOMS 3662 . 4949) (READVARS 4951 . 5517) (HPRINT0 5519 . 6188)) 
-(6192 6525 (READVARS-FROM-STRINGS 6192 . 6525)) (6527 6914 (READVARS-FROM-STREAM 6527 . 6914)) (6915 
-8843 (READVAR-FROM-STRING 6925 . 7331) (READVARS-FROM-STRING 7333 . 7569) (HPRINT-TO-STRING 7571 . 
-7777) (HPRINT-TO-STRINGS 7779 . 8841)) (9654 38247 (HPRINT 9664 . 11655) (HPRINT1 11657 . 23159) (
-HPRINTEND 23161 . 24197) (RPTPRINT 24199 . 24437) (RPTEND 24439 . 24598) (RPTPUT 24600 . 25098) (
-HPRINTSP 25100 . 25164) (HPERR 25166 . 25263) (HVFWDCDREAD 25265 . 25644) (HVBAKREAD 25646 . 33691) (
-HVREADCHECKGETFN 33693 . 35092) (HVREADEND 35094 . 35446) (HVRPTREAD 35448 . 35974) (HVFWDREAD 35976
- . 36830) (HREAD 36832 . 37154) (HPINITRDTBL 37156 . 37990) (HVREADERR 37992 . 38105) (HPRINSP 38107
- . 38245)) (38248 47130 (COPYALL 38258 . 42161) (\COPYDATATYPE 42163 . 42852) (HCOPYALL 42854 . 43164)
- (HCOPYALL1 43166 . 47128)) (47131 54425 (EQUALALL 47141 . 52746) (EQUALHASH 52748 . 54423)))))
+  (FILEMAP (NIL (3576 6114 (MAKEHVPRETTYCOMS 3586 . 4873) (READVARS 4875 . 5441) (HPRINT0 5443 . 6112)) 
+(6116 6449 (READVARS-FROM-STRINGS 6116 . 6449)) (6451 6838 (READVARS-FROM-STREAM 6451 . 6838)) (6839 
+8767 (READVAR-FROM-STRING 6849 . 7255) (READVARS-FROM-STRING 7257 . 7493) (HPRINT-TO-STRING 7495 . 
+7701) (HPRINT-TO-STRINGS 7703 . 8765)) (9578 38171 (HPRINT 9588 . 11579) (HPRINT1 11581 . 23083) (
+HPRINTEND 23085 . 24121) (RPTPRINT 24123 . 24361) (RPTEND 24363 . 24522) (RPTPUT 24524 . 25022) (
+HPRINTSP 25024 . 25088) (HPERR 25090 . 25187) (HVFWDCDREAD 25189 . 25568) (HVBAKREAD 25570 . 33615) (
+HVREADCHECKGETFN 33617 . 35016) (HVREADEND 35018 . 35370) (HVRPTREAD 35372 . 35898) (HVFWDREAD 35900
+ . 36754) (HREAD 36756 . 37078) (HPINITRDTBL 37080 . 37914) (HVREADERR 37916 . 38029) (HPRINSP 38031
+ . 38169)) (38172 47054 (COPYALL 38182 . 42085) (\COPYDATATYPE 42087 . 42776) (HCOPYALL 42778 . 43088)
+ (HCOPYALL1 43090 . 47052)) (47055 59184 (EQUALALL 47065 . 52863) (EQUALHASH 52865 . 54540) (
+BLOCKEQUALP 54542 . 59182)))))
 STOP

sources/INSPECT

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "17-Sep-2022 22:30:33" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>sources>INSPECT.;22
 123809 
+
(FILECREATED "14-Sep-2023 23:40:42" {WMEDLEY}<sources>INSPECT.;28
 124779 
 
-      :CHANGES-TO (FNS INSPECT)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "12-Sep-2022 21:12:51" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>sources>INSPECT.;21)
+      :CHANGES-TO (FNS INSPECTABLEFIELDNAMES)
+
+      :PREVIOUS-DATE "15-Jun-2023 16:03:17" {WMEDLEY}<sources>INSPECT.;27)
 
 
 (* ; "
@@ -41,13 +41,14 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
                    INSPECT/TYPERECORD INSPECT/AS/RECORD SELECT.LIST.INSPECTOR STANDARDEDITE 
                    NTHTOPLEVELELT SETNTHTOPLEVELELT DEDITE FINDRECDECL FINDSYSRECDECL 
                    MAKE-INSPECTOR-PROFILE CONFIRM-SET)
-              (GLOBALVARS INSPECTMACROS INSPECTALLFIELDSFLG SetPropertyMenu SetStackMenu InspectMenu
-                     PropertyLeftMargin MaxValueLeftMargin INSPECTPRINTLEVEL InspectBitmapMenu 
-                     ItemWCommandMenu InspectPropsMenu MAXINSPECTARRAYLEVEL MAXINSPECTCDRLEVEL 
-                     MaxInspectorWindowWidth MaxInspectorWindowHeight INSPECT.HUNK.COMMANDS 
-                     USERRECLST SYSPROPS IT MinSpaceBetweenProperyAndValue 
+              (GLOBALVARS INSPECTMACROS INSPECTALLFIELDSFLG INSPECTDONTSORTFIELDS SetPropertyMenu 
+                     SetStackMenu InspectMenu PropertyLeftMargin MaxValueLeftMargin INSPECTPRINTLEVEL
+                     InspectBitmapMenu ItemWCommandMenu InspectPropsMenu MAXINSPECTARRAYLEVEL 
+                     MAXINSPECTCDRLEVEL MaxInspectorWindowWidth MaxInspectorWindowHeight 
+                     INSPECT.HUNK.COMMANDS USERRECLST SYSPROPS IT MinSpaceBetweenProperyAndValue 
                      MaxInspectorPropertyValueWidth)
-              (INITVARS (INSPECTALLFIELDSFLG T)
+              (INITVARS (INSPECTDONTSORTFIELDS T)
+                     (INSPECTALLFIELDSFLG T)
                      (MaxInspectorWindowWidth 330)
                      (MaxInspectorWindowHeight 606))
               (VARS INSPECTPRINTLEVEL)
@@ -1213,7 +1214,8 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
         NIL])
 
 (INSPECT/DATATYPE

-  [LAMBDA (DATUM TYPE WHERE TAG)
                             (* ; "Edited 12-Sep-2022 20:58 by rmk")


+  [LAMBDA (DATUM TYPE WHERE TAG)
                             (* ; "Edited  1-Jun-2023 22:33 by rmk")


+                                                             (* ; "Edited 12-Sep-2022 20:58 by rmk")


                                                              (* ; "Edited  9-Aug-2022 08:56 by rmk")


                                                              (* ; "Edited  1-Dec-96 20:15 by rmk:")


                                                              (* ; "Edited  7-Aug-87 10:21 by jop")

@@ -1265,21 +1267,33 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
                       (PLIST (CL:WHEN (PROPLISTP
 DATUM)
                                  (INSPECT/PLIST
 DATUM WHERE TAG)
                                  T))
-                      (LIST (INSPECT/TOP/LEVEL/LIST
 DATUM WHERE TAG)
-                            T)
+                      (LIST (INSPECT/TOP/LEVEL/LIST
 DATUM WHERE TAG))
                       NIL)))
             (T (printout PROMPTWINDOW T "No declaration for " DATUM T "Can not inspect.")
                NIL])
 
 (INSPECTABLEFIELDNAMES

-  [LAMBDA (DECL TOPONLYFLG)
                              (* ; "Edited  3-Feb-87 16:51 by jop")

+  [LAMBDA (DECL TOPONLYFLG)
                                  (* ; "Edited 14-Sep-2023 23:28 by rmk")


+                                                             (* ; "Edited 15-Jun-2023 15:36 by rmk")


+                                                             (* ; "Edited  2-Jun-2023 20:18 by rmk")


+                                                             (* ; "Edited  3-Feb-87 16:51 by jop")

 
     (* ;; "returns the list of record field names suitable for inspecting.  This is everything unless TOPONLYFLG is T which is the case for system records.")

 
-    (COND
-       (TOPONLYFLG (for
 FIELDNAME in
 (CDR (RECORDFIELDNAMES DECL T))
-                      when
 (AND FIELDNAME (NLISTP FIELDNAME)) collect
 FIELDNAME))
-       (T (REMOVEDUPS
 (RECORDFIELDNAMES DECL])
+    (LET (FIELDNAMES)
+         [SETQ FIELDNAMES (COND
+                             (TOPONLYFLG (for
 FIELDNAME in
 (CDR (RECORDFIELDNAMES DECL T))
+                                            when
 (AND FIELDNAME (NLISTP FIELDNAME)) collect
 FIELDNAME
+                                              ))
+                             (T (REMOVEDUPS
 (RECORDFIELDNAMES DECL]
+         (CL:IF (OR (NEQ 'DATATYPE (CAR (LISTP DECL)))
+                    (EQ T INSPECTDONTSORTFIELDS)
+                    (MEMB (CADR DECL)
+                          INSPECTDONTSORTFIELDS)
+                    (ILEQ (LENGTH FIELDNAMES)
+                          5))
+             FIELDNAMES
+             (SORT FIELDNAMES))])
 
 (REMOVEDUPS

   [LAMBDA (LST)
                                          (* ; "Edited  3-Feb-87 16:54 by jop")

@@ -1571,13 +1585,15 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS INSPECTMACROS INSPECTALLFIELDSFLG SetPropertyMenu SetStackMenu InspectMenu 
-       PropertyLeftMargin MaxValueLeftMargin INSPECTPRINTLEVEL InspectBitmapMenu ItemWCommandMenu 
-       InspectPropsMenu MAXINSPECTARRAYLEVEL MAXINSPECTCDRLEVEL MaxInspectorWindowWidth 
-       MaxInspectorWindowHeight INSPECT.HUNK.COMMANDS USERRECLST SYSPROPS IT 
+(GLOBALVARS INSPECTMACROS INSPECTALLFIELDSFLG INSPECTDONTSORTFIELDS SetPropertyMenu SetStackMenu 
+       InspectMenu PropertyLeftMargin MaxValueLeftMargin INSPECTPRINTLEVEL InspectBitmapMenu 
+       ItemWCommandMenu InspectPropsMenu MAXINSPECTARRAYLEVEL MAXINSPECTCDRLEVEL 
+       MaxInspectorWindowWidth MaxInspectorWindowHeight INSPECT.HUNK.COMMANDS USERRECLST SYSPROPS IT
        MinSpaceBetweenProperyAndValue MaxInspectorPropertyValueWidth)
 )
 
+(RPAQ? INSPECTDONTSORTFIELDS
 T)
+
 (RPAQ? INSPECTALLFIELDSFLG
 T)
 
 (RPAQ? MaxInspectorWindowWidth
 330)
@@ -2208,40 +2224,40 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
 (PUTPROPS INSPECT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1991 1993 
 1995 1999 2018 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (6980 45333 (INSPECTW.CREATE 6990 . 12285) (INSPECTW.REPAINTFN 12287 . 17823) (
-INSPECTW.REDISPLAY 17825 . 26697) (\INSPECTW.VALUE.MARGIN 26699 . 27102) (INSPECTW.REPLACE 27104 . 
-27812) (INSPECTW.SELECTITEM 27814 . 28804) (\INSPECTW.REDISPLAYPROP 28806 . 31236) (INSPECTW.FETCH 
-31238 . 31661) (INSPECTW.PROPERTIES 31663 . 32304) (DECODE.WINDOW.ARG 32306 . 34034) (
-DEFAULT.INSPECTW.PROPCOMMANDFN 34036 . 36064) (DEFAULT.INSPECTW.VALUECOMMANDFN 36066 . 37482) (
-DEFAULT.INSPECTW.TITLECOMMANDFN 37484 . 40933) (\SELITEM.FROM.PROPERTY 40935 . 41377) (
-\INSPECT.COMPUTE.TITLE 41379 . 42663) (LEVELEDFORM 42665 . 43384) (MAKEWITHINREGION 43386 . 45331)) (
-45334 62639 (ITEMW.REPAINTFN 45344 . 46564) (\ITEM.WINDOW.BUTTON.HANDLER 46566 . 46985) (
-\ITEM.WINDOW.SELECTION.HANDLER 46987 . 49654) (\INSPECTW.COMMAND.HANDLER 49656 . 53657) (
-ITEM.WINDOW.SET.STACK.ARG 53659 . 55863) (REPLACESTKARG 55865 . 56964) (IN/ITEM? 56966 . 57848) (
-\ITEMW.DESELECTITEM 57850 . 58114) (\ITEMW.SELECTITEM 58116 . 58378) (\ITEMW.CLEARSELECTION 58380 . 
-58735) (\ITEMW.FLIPITEM 58737 . 59210) (PRINTANDBOX 59212 . 61721) (PRINTATBOX 61723 . 62240) (
-ITEMOFPROPERTYVALUE 62242 . 62637)) (62640 66381 (\ITEM.WINDOW.COPY.HANDLER 62650 . 64507) (
-\ITEMW.FLIPCOPY 64509 . 64968) (BKSYSBUF.GENERAL 64970 . 66379)) (66773 90797 (INSPECT 66783 . 71313) 
-(\APPLYINSPECTMACRO 71315 . 72376) (INSPECT/BITMAP 72378 . 73530) (INSPECT/DATATYPE 73532 . 76967) (
-INSPECTABLEFIELDNAMES 76969 . 77490) (REMOVEDUPS 77492 . 77697) (INSPECT/ARRAY 77699 . 78764) (
-INSPECT/TOP/LEVEL/LIST 78766 . 79883) (INSPECT/PROPLIST 79885 . 80973) (NONSYSPROPNAMES 80975 . 81271)
- (INSPECT/LISTP 81273 . 81712) (ALISTP 81714 . 81923) (PROPLISTP 81925 . 82565) (INSPECT/ALIST 82567
- . 83043) (ASSOCGET 83045 . 83256) (/ASSOCPUT 83258 . 83523) (INSPECT/PLIST 83525 . 84009) (
-INSPECT/TYPERECORD 84011 . 84368) (INSPECT/AS/RECORD 84370 . 85607) (SELECT.LIST.INSPECTOR 85609 . 
-87660) (STANDARDEDITE 87662 . 87945) (NTHTOPLEVELELT 87947 . 88263) (SETNTHTOPLEVELELT 88265 . 89025) 
-(DEDITE 89027 . 89234) (FINDRECDECL 89236 . 89819) (FINDSYSRECDECL 89821 . 90222) (
-MAKE-INSPECTOR-PROFILE 90224 . 90609) (CONFIRM-SET 90611 . 90795)) (92563 100777 (INSPECT/ATOM 92573
- . 96678) (SELECT.ATOM.ASPECT 96680 . 97824) (INSPECT/AS/FUNCTION 97826 . 100112) (SELECT.FNS.EDITOR 
-100114 . 100775)) (100818 106243 (INSPECTCODE 100828 . 101980) (\TEDIT.INSPECTCODE 101982 . 103960) (
-\INSPECT/CODE/RESHAPEFN 103962 . 105501) (\INSPECT/CODE/REPAINTFN 105503 . 106241)) (106281 107887 (
-INSPECT/HARRAYP 106291 . 107039) (HARRAYKEYS 107041 . 107420) (INSPECTW.GETHASH 107422 . 107649) (
-INSPECTW.PUTHASH 107651 . 107885)) (107936 114145 (RDTBL\NONOTHERCODES 107946 . 108966) (GETSYNTAXPROP
- 108968 . 110466) (SETSYNTAXPROP 110468 . 112195) (GETTTBLPROP 112197 . 113115) (SETTTBLPROP 113117 . 
-114143)) (114624 123266 (INSPECT/AS/BLOCKRECORD 114634 . 115634) (INSPECT/TYPELESS 115636 . 117027) (
-LIST-ALL-BLOCKRECORDS 117029 . 117304) (INSPECT/HUNK 117306 . 119909) (\INSPECT.DATATYPE.RAW.FETCH 
-119911 . 120237) (\INSPECT.FETCH.8 120239 . 120388) (\INSPECT.FETCH.32 120390 . 120561) (
-\INSPECT.FETCH.CHAR 120563 . 120726) (\INSPECT.FETCH.FATCHAR 120728 . 120890) (\INSPECT.FETCH.PTR 
-120892 . 121063) (\INSPECT.STORE.8 121065 . 121371) (\INSPECT.STORE.16 121373 . 121673) (
-\INSPECT.STORE.32 121675 . 122110) (\INSPECT.STORE.CHAR 122112 . 122438) (\INSPECT.STORE.FATCHAR 
-122440 . 122762) (\INSPECT.STORE.PTR 122764 . 123111) (INSPECT/MAKE/CCODEP 123113 . 123264)))))
+  (FILEMAP (NIL (7001 45354 (INSPECTW.CREATE 7011 . 12306) (INSPECTW.REPAINTFN 12308 . 17844) (
+INSPECTW.REDISPLAY 17846 . 26718) (\INSPECTW.VALUE.MARGIN 26720 . 27123) (INSPECTW.REPLACE 27125 . 
+27833) (INSPECTW.SELECTITEM 27835 . 28825) (\INSPECTW.REDISPLAYPROP 28827 . 31257) (INSPECTW.FETCH 
+31259 . 31682) (INSPECTW.PROPERTIES 31684 . 32325) (DECODE.WINDOW.ARG 32327 . 34055) (
+DEFAULT.INSPECTW.PROPCOMMANDFN 34057 . 36085) (DEFAULT.INSPECTW.VALUECOMMANDFN 36087 . 37503) (
+DEFAULT.INSPECTW.TITLECOMMANDFN 37505 . 40954) (\SELITEM.FROM.PROPERTY 40956 . 41398) (
+\INSPECT.COMPUTE.TITLE 41400 . 42684) (LEVELEDFORM 42686 . 43405) (MAKEWITHINREGION 43407 . 45352)) (
+45355 62660 (ITEMW.REPAINTFN 45365 . 46585) (\ITEM.WINDOW.BUTTON.HANDLER 46587 . 47006) (
+\ITEM.WINDOW.SELECTION.HANDLER 47008 . 49675) (\INSPECTW.COMMAND.HANDLER 49677 . 53678) (
+ITEM.WINDOW.SET.STACK.ARG 53680 . 55884) (REPLACESTKARG 55886 . 56985) (IN/ITEM? 56987 . 57869) (
+\ITEMW.DESELECTITEM 57871 . 58135) (\ITEMW.SELECTITEM 58137 . 58399) (\ITEMW.CLEARSELECTION 58401 . 
+58756) (\ITEMW.FLIPITEM 58758 . 59231) (PRINTANDBOX 59233 . 61742) (PRINTATBOX 61744 . 62261) (
+ITEMOFPROPERTYVALUE 62263 . 62658)) (62661 66402 (\ITEM.WINDOW.COPY.HANDLER 62671 . 64528) (
+\ITEMW.FLIPCOPY 64530 . 64989) (BKSYSBUF.GENERAL 64991 . 66400)) (66794 91709 (INSPECT 66804 . 71334) 
+(\APPLYINSPECTMACRO 71336 . 72397) (INSPECT/BITMAP 72399 . 73551) (INSPECT/DATATYPE 73553 . 77067) (
+INSPECTABLEFIELDNAMES 77069 . 78402) (REMOVEDUPS 78404 . 78609) (INSPECT/ARRAY 78611 . 79676) (
+INSPECT/TOP/LEVEL/LIST 79678 . 80795) (INSPECT/PROPLIST 80797 . 81885) (NONSYSPROPNAMES 81887 . 82183)
+ (INSPECT/LISTP 82185 . 82624) (ALISTP 82626 . 82835) (PROPLISTP 82837 . 83477) (INSPECT/ALIST 83479
+ . 83955) (ASSOCGET 83957 . 84168) (/ASSOCPUT 84170 . 84435) (INSPECT/PLIST 84437 . 84921) (
+INSPECT/TYPERECORD 84923 . 85280) (INSPECT/AS/RECORD 85282 . 86519) (SELECT.LIST.INSPECTOR 86521 . 
+88572) (STANDARDEDITE 88574 . 88857) (NTHTOPLEVELELT 88859 . 89175) (SETNTHTOPLEVELELT 89177 . 89937) 
+(DEDITE 89939 . 90146) (FINDRECDECL 90148 . 90731) (FINDSYSRECDECL 90733 . 91134) (
+MAKE-INSPECTOR-PROFILE 91136 . 91521) (CONFIRM-SET 91523 . 91707)) (93533 101747 (INSPECT/ATOM 93543
+ . 97648) (SELECT.ATOM.ASPECT 97650 . 98794) (INSPECT/AS/FUNCTION 98796 . 101082) (SELECT.FNS.EDITOR 
+101084 . 101745)) (101788 107213 (INSPECTCODE 101798 . 102950) (\TEDIT.INSPECTCODE 102952 . 104930) (
+\INSPECT/CODE/RESHAPEFN 104932 . 106471) (\INSPECT/CODE/REPAINTFN 106473 . 107211)) (107251 108857 (
+INSPECT/HARRAYP 107261 . 108009) (HARRAYKEYS 108011 . 108390) (INSPECTW.GETHASH 108392 . 108619) (
+INSPECTW.PUTHASH 108621 . 108855)) (108906 115115 (RDTBL\NONOTHERCODES 108916 . 109936) (GETSYNTAXPROP
+ 109938 . 111436) (SETSYNTAXPROP 111438 . 113165) (GETTTBLPROP 113167 . 114085) (SETTTBLPROP 114087 . 
+115113)) (115594 124236 (INSPECT/AS/BLOCKRECORD 115604 . 116604) (INSPECT/TYPELESS 116606 . 117997) (
+LIST-ALL-BLOCKRECORDS 117999 . 118274) (INSPECT/HUNK 118276 . 120879) (\INSPECT.DATATYPE.RAW.FETCH 
+120881 . 121207) (\INSPECT.FETCH.8 121209 . 121358) (\INSPECT.FETCH.32 121360 . 121531) (
+\INSPECT.FETCH.CHAR 121533 . 121696) (\INSPECT.FETCH.FATCHAR 121698 . 121860) (\INSPECT.FETCH.PTR 
+121862 . 122033) (\INSPECT.STORE.8 122035 . 122341) (\INSPECT.STORE.16 122343 . 122643) (
+\INSPECT.STORE.32 122645 . 123080) (\INSPECT.STORE.CHAR 123082 . 123408) (\INSPECT.STORE.FATCHAR 
+123410 . 123732) (\INSPECT.STORE.PTR 123734 . 124081) (INSPECT/MAKE/CCODEP 124083 . 124234)))))
 STOP

sources/LLDATATYPE

@@ -1,35 +1,37 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "28-Jun-99 16:57:50" {DSK}<project>medley3.5>sources>LLDATATYPE.;2
 95620  
 
-      changes to%:  (FNS TYPENAME)
+
(FILECREATED "17-Apr-2023 08:04:06" {DSK}<home>larry>il>medley>sources>LLDATATYPE.;2
 94197  
 
-      previous date%: " 2-Feb-95 16:27:02" {DSK}<project>medley3.5>sources>LLDATATYPE.;1)
+      :EDIT-BY "lmm"
+
+      :CHANGES-TO (VARS LLDATATYPECOMS)
+                  (FNS \SET.STORAGE.STATE \MAPMDS)
+
+      :PREVIOUS-DATE "28-Jun-99 16:57:50" {DSK}<home>larry>il>medley>sources>LLDATATYPE.;1)
 
 
 (* ; "
-Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1999 by VENUE, Oakland, CA.  All rights reserved.
+Copyright (c) 1982-1995, 1999 by VENUE, Oakland, CA.
 ")
 
 (PRETTYCOMPRINT LLDATATYPECOMS)
 
 (RPAQQ LLDATATYPECOMS

-       ((COMS                                                (* ; 
-
                     "Because we use the UNLESSINEW macro in this file, we need it when compiling.")

+       ((COMS                                                (* ; 
+
                       "Because we use the UNLESSINEW macro in this file, we need it when compiling.")

               (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
                                                       RENAMEMACROS)))
-        (COMS                                                (* ; "Storage management")

+        (COMS                                                (* ; "Storage management")

               (FNS NTYPX \TYPEMASK.UFN \TYPEP.UFN \ALLOCMDSPAGE \ALLOCPAGEBLOCK 
                    \ALLOCVIRTUALPAGEBLOCK \MAPMDS \CHECKFORSTORAGEFULL \DOSTORAGEFULLINTERRUPT 
                    \SET.STORAGE.STATE \SETTYPEMASK \ADVANCE.STORAGE.STATE \NEW2PAGE \MAKEMDSENTRY 
                    \INITMDSPAGE \ASSIGNDATATYPE1 \RESOLVE.TYPENUMBER \TYPENUMBERFROMNAME CREATECELL 
                    \CREATECELL)
               
-              (* ;; 
-
            "For NEW_STORAGE option was set in Maiko, then \maiko.set.storage.state is active")

+              (* ;; 
+
              "For NEW_STORAGE option was set in Maiko, then \maiko.set.storage.state is active")

 
-              (FNS \MAIKO.SET.STORAGE.STATE)
-              [P (AND (EQ \MACHINETYPE \MAIKO)
-                      (MOVD '\MAIKO.SET.STORAGE.STATE '\SET.STORAGE.STATE]
+              SP
               (INITVARS (CROSSCOMPILING)
                      (ASSIGNDATATYPE.ASKUSERWAIT 300)
                      (\STORAGEFULLSTATE)
@@ -37,7 +39,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
               (GLOBALVARS CROSSCOMPILING \STORAGEFULLSTATE \STORAGEFULL \SYSTEMCACHEVARS 
                      \NxtArrayPage)
               (SPECVARS ASSIGNDATATYPE.ASKUSERWAIT))
-        (COMS                                                (* ; "fetch and replace")

+        (COMS                                                (* ; "fetch and replace")

               (FNS FETCHFIELD REPLACEFIELD BOXCOUNT CONSCOUNT \DTEST \TYPECHECK \DTEST.UFN 
                    \INSTANCEP.UFN \INSTANCE-P \TYPECHECK.UFN GETDESCRIPTORS GETSUPERTYPE 
                    GETFIELDSPECS NCREATE NCREATE2 REPLACEFIELDVAL PUTBASEPTRX /REPLACEFIELD TYPENAME
@@ -46,7 +48,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
                  (MOVD? 'REPLACEFIELD 'FREPLACEFIELD NIL T)
                  (MOVD? 'REPLACEFIELDVAL 'FREPLACEFIELDVAL NIL T))
               (OPTIMIZERS TYPENAMEP \INSTANCE-P))
-        [COMS                                                (* ; "STORAGE")

+        [COMS                                                (* ; "STORAGE")

               (FNS STORAGE STORAGE.LEFT \STORAGE.TYPE \STLINP \STMDSTYPE \STMDS.APPROX 
                    \STORAGE.HUNKTYPE)
               (DECLARE%: DONTCOPY (RECORDS HUNKSTAT))
@@ -55,15 +57,15 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
                           (CONSTANTS \SMALLP \FIXP \FLOATP \LITATOM \LISTP \ARRAYP \STACKP \VMEMPAGEP
                                  \STREAM \NEW-ATOM)
                           
-                          (* ;; 
-
                   "This is the list of datatypes whos type #s must be known to microcode or to C.")

+                          (* ;; 
+
                     "This is the list of datatypes whos type #s must be known to microcode or to C.")

 
                           
-                          (* ;; "It is used in \SETUP.HUNK.TYPENUMBERS (in LLARRAYELT) to create the list INITIALDTDCONTENTS for INITDATATYPES.")

+                          (* ;; "It is used in \SETUP.HUNK.TYPENUMBERS (in LLARRAYELT) to create the list INITIALDTDCONTENTS for INITDATATYPES.")

 
                           
-                          (* ;; 
-
                        "Changes to this lit need to be reflected in C and maybe in microcode.")

+                          (* ;; 
+
                          "Changes to this lit need to be reflected in C and maybe in microcode.")

 
                           (VARS \BUILT-IN-SYSTEM-TYPES))
                DONTCOPY
@@ -75,7 +77,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
                              \MDSFREELISTPAGE \MaxSysTypeNum \MaxTypeNumber \STORAGEFULL 
                              \INTERRUPTSTATE \PENDINGINTERRUPT))
                (CONSTANTS * STORAGEFULLSTATES))
-        [COMS                                                (* ; "for MAKEINIT")

+        [COMS                                                (* ; "for MAKEINIT")

               (FNS CREATEMDSTYPETABLE INITDATATYPES INITDATATYPENAMES)
               (DECLARE%: DONTCOPY
                      (ADDVARS (INITVALUES (\NxtMDSPage \FirstMDSPage)
@@ -233,8 +235,28 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
                              PAGE# _ FIRSTPAGE))))])
 
 (\MAPMDS

-(LAMBDA (TYPE FN) (* ; "Edited 19-Oct-94 09:29 by sybalsky") (* ;;; "Applies FN to each virtual page number that is of type TYPE, or to all MDS pages if TYPE is NIL") (OR (NULL TYPE) (FIXP TYPE) (SETQ TYPE (\TYPENUMBERFROMNAME TYPE))) (CHECK (EQ (FOLDLO \MDSIncrement PAGESPERSEGMENT) 2)) (* ; "I'd put this FOLDLO as the increment in the FOR below, but the translation is atrocious") (for I from 0 to (COND ((EQ \STORAGEFULLSTATE \SFS.FULLYSWITCHED) 1) (T 0)) bind TYP do (* ;; "This is pretty grody because of the two different regions MDS can live in.  Could just do everything from (IMIN \NxtMDSPage \LeastMDSPage) to \MaxMDSPage but waste time on the stuff in between") (for VP from (COND ((EQ I 0) (IMIN \NxtMDSPage \LeastMDSPage)) (T \NxtMDSPage)) by 2 to (COND ((EQ I 0) \DefaultSecondArrayPage) (T \MaxMDSPage)) do (* ;; "We could just access \MDSTypeTable directly here, but since NTYPX should be ucoded, we benefit by 'modularizing' this access.") (COND ((OR (EQ (SETQ TYP (NTYPX (create POINTER PAGE# _ VP))) TYPE) (AND (NULL TYPE) (NEQ TYP 0) (NEQ TYP \SMALLP))) (SPREADAPPLY* FN VP))))))
-)
+  [LAMBDA (TYPE FN)
                                          (* ; "Edited 17-Apr-2023 07:49 by lmm")


+                                                          (* ; "Edited 19-Oct-94 09:29 by sybalsky")

+
+(* ;;; 
+
"Applies FN to each virtual page number that is of type TYPE, or to all MDS pages if TYPE is NIL")

+
+    (OR (NULL TYPE)
+        (FIXP TYPE)
+        (SETQ TYPE (\TYPENUMBERFROMNAME
 TYPE)))
+    (LET* ((VP (\CREATECELL
 \FIXP))
+           (END (IMAX \DefaultSecondArrayPage \MaxMDSPage))
+           TYP)
+          (\PUTBASEFIXP VP 0 (IMIN \NxtMDSPage \LeastMDSPage))
+          (WHILE
 (ILEQ VP END) DO
 (COND
+                                     ((OR (EQ (SETQ TYP (NTYPX
 (create
 POINTER
+                                                                      PAGE# _ VP)))
+                                              TYPE)
+                                          (AND (NULL TYPE)
+                                               (NEQ TYP 0)
+                                               (NEQ TYP \SMALLP)))
+                                      (SPREADAPPLY* FN VP)))
+                                  (\BOXIPLUS VP 2])
 
 (\CHECKFORSTORAGEFULL

   [LAMBDA (NPAGES)
                                       (* ; "Edited  4-Jan-93 02:04 by jds")

@@ -311,18 +333,14 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
           (LISPERROR "STORAGE FULL" '"save your work & reload a.s.a.p." T])
 
 (\SET.STORAGE.STATE

-  [LAMBDA NIL
                                            (* bvm%: "12-Aug-85 14:46")

-    (PROG1 (SETQ \STORAGEFULLSTATE (COND
-                                      ((SELECTC \MACHINETYPE
-                                           (\DOLPHIN NIL)
-                                           (\DANDELION (NEQ 0 (fetch
 (IFPAGE DL24BitAddressable)
-                                                                 of
 \InterfacePage)))
-                                           T)                (* ; "we can use high addresses")

-                                       \SFS.SWITCHABLE)
-                                      (T \SFS.NOTSWITCHABLE)))
-        (push
 \SYSTEMCACHEVARS '\STORAGEFULLSTATE)       (* ; 
-
                                               "Want to recompute this if we come back from logout")

-        )])
+  [LAMBDA NIL
                                              (* ; "Edited 24-May-90 19:11 by Takeshi")

+    (COND
+       ((EQ (FETCH
 (IFPAGE DL24BitAddressable) OF
 \InterfacePage)
+            0)
+        (SETQ \STORAGEFULLSTATE \SFS.NOTSWITCHABLE))
+       (T (SETQ \STORAGEFULLSTATE \SFS.SWITCHABLE)))
+    (PUSH
 \SYSTEMCACHEVARS '\STORAGEFULLSTATE)
+    \STORAGEFULLSTATE])
 
 (\SETTYPEMASK

   [LAMBDA (NTYPX
 BITS)
@@ -600,21 +618,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
 
 (* ;; "For NEW_STORAGE option was set in Maiko, then \maiko.set.storage.state is active")

 
-(DEFINEQ
 
-(\MAIKO.SET.STORAGE.STATE

-  [LAMBDA NIL
                                          (* ; "Edited 24-May-90 19:11 by Takeshi")

-    (COND
-       ((EQ (FETCH
 (IFPAGE DL24BitAddressable) OF
 \InterfacePage)
-            0)
-        (SETQ \STORAGEFULLSTATE \SFS.NOTSWITCHABLE))
-       (T (SETQ \STORAGEFULLSTATE \SFS.SWITCHABLE)))
-    (PUSH
 \SYSTEMCACHEVARS '\STORAGEFULLSTATE)
-    \STORAGEFULLSTATE])
-)
-
-(AND (EQ \MACHINETYPE \MAIKO)
-     (MOVD '\MAIKO.SET.STORAGE.STATE '\SET.STORAGE.STATE))
+(RPAQQ SP
 NOBIND)
 
 (RPAQ? CROSSCOMPILING
 )
 
@@ -1063,38 +1068,38 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
 (MOVD? 'REPLACEFIELDVAL 'FREPLACEFIELDVAL NIL T)
 
 (DEFOPTIMIZER TYPENAMEP
 (DATUM TYPE &ENVIRONMENT ENV)
-                            (LET [(TYPE-NAME (CL:IF (AND (CL:CONSP TYPE)
-                                                         (EQ (CAR TYPE)
-                                                             'QUOTE)
-                                                         (CL:SYMBOLP (CADR TYPE)))
-                                                    (CADR TYPE]
-                                 (CL:IF [AND TYPE-NAME (NOT (EQ TYPE-NAME 'STRINGP]
-                                     [COND
-                                        [(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
-                                         `((OPCODES INSTANCEP 0 0 0 (ATOM \, (CADR TYPE)))
-                                           ,DATUM]
-                                        [(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
-                                         `((OPCODES INSTANCEP 0 0 (ATOM \, (CADR TYPE)))
-                                           ,DATUM]
-                                        (T `((OPCODES INSTANCEP 0 (ATOM \, (CADR TYPE)))
-                                             ,DATUM]
-                                     'COMPILER:PASS)))
+                        (LET [(TYPE-NAME (CL:IF (AND (CL:CONSP TYPE)
+                                                     (EQ (CAR TYPE)
+                                                         'QUOTE)
+                                                     (CL:SYMBOLP (CADR TYPE)))
+                                                (CADR TYPE]
+                             (CL:IF [AND TYPE-NAME (NOT (EQ TYPE-NAME 'STRINGP]
+                                 [COND
+                                    [(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
+                                     `((OPCODES INSTANCEP 0 0 0 (ATOM \, (CADR TYPE)))
+                                       ,DATUM]
+                                    [(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
+                                     `((OPCODES INSTANCEP 0 0 (ATOM \, (CADR TYPE)))
+                                       ,DATUM]
+                                    (T `((OPCODES INSTANCEP 0 (ATOM \, (CADR TYPE)))
+                                         ,DATUM]
+                                 'COMPILER:PASS)))
 
 (DEFOPTIMIZER \INSTANCE-P
 (&BODY BODY &ENVIRONMENT ENV)
+                          (COND
+                             [[AND (EQ (CAADR BODY)
+                                       'QUOTE)
+                                   (CL:SYMBOLP (CADR (CADR BODY]
                               (COND
-                                 [[AND (EQ (CAADR BODY)
-                                           'QUOTE)
-                                       (CL:SYMBOLP (CADR (CADR BODY]
-                                  (COND
-                                     [(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
-                                      `([OPCODES INSTANCEP 0 0 0 (ATOM \, (CADR (CADR BODY]
-                                        ,(CAR BODY]
-                                     [(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
-                                      `([OPCODES INSTANCEP 0 0 (ATOM \, (CADR (CADR BODY]
-                                        ,(CAR BODY]
-                                     (T `([OPCODES INSTANCEP 0 (ATOM \, (CADR (CADR BODY]
-                                          ,(CAR BODY]
-                                 (T 'IGNOREMACRO)))
+                                 [(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
+                                  `([OPCODES INSTANCEP 0 0 0 (ATOM \, (CADR (CADR BODY]
+                                    ,(CAR BODY]
+                                 [(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
+                                  `([OPCODES INSTANCEP 0 0 (ATOM \, (CADR (CADR BODY]
+                                    ,(CAR BODY]
+                                 (T `([OPCODES INSTANCEP 0 (ATOM \, (CADR (CADR BODY]
+                                      ,(CAR BODY]
+                             (T 'IGNOREMACRO)))
 
 
 
@@ -1363,7 +1368,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
 (DECLARE%: EVAL@COMPILE
 
 (RECORD HUNKSTAT
 (NPAGES NITEMS NFREE NINUSE NALLOCATED)
-                     NPAGES _ 0 NITEMS _ 0 NFREE _ 0 NINUSE _ 0 NALLOCATED _ 0)
+                 NPAGES _ 0 NITEMS _ 0 NFREE _ 0 NINUSE _ 0 NALLOCATED _ 0)
 )
 )
 
@@ -1371,17 +1376,16 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992,
 (DECLARE%: 
 (* "FOLLOWING DEFINITIONS EXPORTED")
 (DEFOPTIMIZER PUTBASEPTRX
 (&REST ARGS)
-                              (CONS '(OPENLAMBDA (DATUM OFFSET NEWVALUE)
-                                       (UNINTERRUPTABLY
-                                           (\PUTBASE DATUM OFFSET (LOGOR (LOGAND 61440
-                                                                                (\GETBASE DATUM 
-                                                                                       OFFSET))
-                                                                         (LOGAND (\HILOC NEWVALUE)
-                                                                                4095)))
-                                           (\PUTBASE DATUM (ADD1 OFFSET)
-                                                  (\LOLOC NEWVALUE))
-                                           NEWVALUE))
-                                    ARGS))
+                          (CONS '(OPENLAMBDA (DATUM OFFSET NEWVALUE)
+                                   (UNINTERRUPTABLY
+                                       (\PUTBASE DATUM OFFSET (LOGOR (LOGAND 61440 (\GETBASE DATUM 
+                                                                                          OFFSET))
+                                                                     (LOGAND (\HILOC NEWVALUE)
+                                                                            4095)))
+                                       (\PUTBASE DATUM (ADD1 OFFSET)
+                                              (\LOLOC NEWVALUE))
+                                       NEWVALUE))
+                                ARGS))
 (DECLARE%: EVAL@COMPILE 
 
 (RPAQQ \SMALLP
 1)
@@ -1446,58 +1450,56 @@ DONTCOPY
 (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
 
 (BLOCKRECORD DTD
 ((NIL BITS 2)
-                      (DTDOBSOLETE FLAG)                     (* ; 
-
                    "True for type of a redeclared datatype--not allowed to allocate more of these")

-                      (DTDFINALIZABLE FLAG)                  (* ; 
-
                                                        "True if finalization exists for this type")

-                      (DTDNAME POINTER)                      (* ; "Type name -- a symbol ")

-                      (DTDCNT0 WORD)                         (* ; 
-
                               "Incremental box count -- this plus DTDOLDCNT is the true box count")

-                      (DTDSIZE WORD)                         (* ; "Length of datum in words")

-                      (DTDFREE FULLXPOINTER)                 (* ; 
-
                               "Pointer to first object on free chain, or NIL.  Not used for LISTP")

-                      (DTDLOCKEDP FLAG)                      (* ; 
-
                                 "True if objects of this type must be locked down (not pagefault)")

-                      (DTDHUNKP FLAG)                        (* ; 
-
                                                  "True if this type is used as an array hunk type")

-                      (DTDGCTYPE BITS 2)                     (* ; 
-
                                          "For hunk datatypes, is analogous to arrayblock's GCTYPE")

-                      (DTDDESCRS POINTER)
-                      (DTDTYPESPECS POINTER)
-                      (DTDPTRS POINTER)                      (* ; 
-
      "List of word offsets inside datum where reference-counted pointers are stored -- used by GC")

-                      (DTDOLDCNT FIXP)                       (* ; 
-
                                     "'Box count' -- number of objects of this type ever allocated")

-                      (DTDNEXTPAGE FIXP)                     (* ; 
-
       "Currently only for LISTP pages -- page number of next page on chain of non-full cons pages")

-                      (DTDTYPEENTRY WORD)
+                  (DTDOBSOLETE FLAG)                         (* ; 
+
                      "True for type of a redeclared datatype--not allowed to allocate more of these")

+                  (DTDFINALIZABLE FLAG)                      (* ; 
+
                                                          "True if finalization exists for this type")

+                  (DTDNAME POINTER)                          (* ; "Type name -- a symbol ")

+                  (DTDCNT0 WORD)                             (* ; 
+
                                 "Incremental box count -- this plus DTDOLDCNT is the true box count")

+                  (DTDSIZE WORD)                             (* ; "Length of datum in words")

+                  (DTDFREE FULLXPOINTER)                     (* ; 
+
                                 "Pointer to first object on free chain, or NIL.  Not used for LISTP")

+                  (DTDLOCKEDP FLAG)                          (* ; 
+
                                   "True if objects of this type must be locked down (not pagefault)")

+                  (DTDHUNKP FLAG)                            (* ; 
+
                                                    "True if this type is used as an array hunk type")

+                  (DTDGCTYPE BITS 2)                         (* ; 
+
                                            "For hunk datatypes, is analogous to arrayblock's GCTYPE")

+                  (DTDDESCRS POINTER)
+                  (DTDTYPESPECS POINTER)
+                  (DTDPTRS POINTER)                          (* ; 
+
        "List of word offsets inside datum where reference-counted pointers are stored -- used by GC")

+                  (DTDOLDCNT FIXP)                           (* ; 
+
                                       "'Box count' -- number of objects of this type ever allocated")

+                  (DTDNEXTPAGE FIXP)                         (* ; 
+
         "Currently only for LISTP pages -- page number of next page on chain of non-full cons pages")

+                  (DTDTYPEENTRY WORD)
 
-                      (* ;; "The word stored in the type table for objects of this type.  Hi bits have numberp tags, ref countable, etc.")

+                  (* ;; "The word stored in the type table for objects of this type.  Hi bits have numberp tags, ref countable, etc.")

 
-                      (DTDSUPERTYPE WORD)                    (* ; 
-
                                              "Type number of immediate supertype, or zero if none")

-                      )
-                     [ACCESSFNS DTD ((DTDCNTLOC (\ADDBASE DATUM 4))
-                                     (DTDCNT (IPLUS (fetch
 DTDOLDCNT DATUM)
-                                                    (fetch
 DTDCNT0 DATUM))
-                                            (UNINTERRUPTABLY
-                                                (replace
 DTDOLDCNT of
 DATUM with
 NEWVALUE
-                                                       )
-                                                (replace
 DTDCNT0 of
 DATUM with
 0))])
+                  (DTDSUPERTYPE WORD)                        (* ; 
+
                                                "Type number of immediate supertype, or zero if none")

+                  )
+                 [ACCESSFNS DTD ((DTDCNTLOC (\ADDBASE DATUM 4))
+                                 (DTDCNT (IPLUS (fetch
 DTDOLDCNT DATUM)
+                                                (fetch
 DTDCNT0 DATUM))
+                                        (UNINTERRUPTABLY
+                                            (replace
 DTDOLDCNT of
 DATUM with
 NEWVALUE)
+                                            (replace
 DTDCNT0 of
 DATUM with
 0))])
 )
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS \GETDTD  MACRO

-   ((typeNum)
-    (ADDBASE \DTDSpaceBase (ITIMES typeNum 18))))
+(PUTPROPS \GETDTD
 MACRO
 ((typeNum)
+                         (ADDBASE \DTDSpaceBase (ITIMES typeNum 18))))
 )
 
 (DEFOPTIMIZER \TYPEMASK.UFN
 (&REST X)
-                                (LET [(CE (CONSTANTEXPRESSIONP (CADR X]
-                                     (if
 CE
-                                         then
 `((OPCODES TYPEMASK.N ,(CAR CE))
-                                                    ,(CAR X))
-                                       else
 'IGNOREMACRO)))
+                            (LET [(CE (CONSTANTEXPRESSIONP (CADR X]
+                                 (if
 CE
+                                     then
 `((OPCODES TYPEMASK.N ,(CAR CE))
+                                            ,(CAR X))
+                                   else
 'IGNOREMACRO)))
 (DECLARE%: EVAL@COMPILE 
 
 (RPAQQ \GUARDSTORAGEFULL
 128)
@@ -1518,10 +1520,10 @@ DONTCOPY
 
 
 (RPAQQ STORAGEFULLSTATES
 ((\SFS.NORMAL NIL)
-                              (\SFS.NOTSWITCHABLE 1)
-                              (\SFS.SWITCHABLE 2)
-                              (\SFS.ARRAYSWITCHED 3)
-                              (\SFS.FULLYSWITCHED 4)))
+                          (\SFS.NOTSWITCHABLE 1)
+                          (\SFS.SWITCHABLE 2)
+                          (\SFS.ARRAYSWITCHED 3)
+                          (\SFS.FULLYSWITCHED 4)))
 (DECLARE%: EVAL@COMPILE 
 
 (RPAQQ \SFS.NORMAL
 NIL)
@@ -1699,34 +1701,34 @@ DONTCOPY
 (DECLARE%: DONTCOPY 
 
 (ADDTOVAR INITVALUES
 (\NxtMDSPage \FirstMDSPage)
-                         (\LeastMDSPage \FirstMDSPage)
-                         (\SecondMDSPage \DefaultSecondMDSPage)
-                         (\SecondArrayPage \DefaultSecondArrayPage)
-                         (\MDSFREELISTPAGE)
-                         (\MaxSysTypeNum 0)
-                         (\MaxTypeNumber))
+                     (\LeastMDSPage \FirstMDSPage)
+                     (\SecondMDSPage \DefaultSecondMDSPage)
+                     (\SecondArrayPage \DefaultSecondArrayPage)
+                     (\MDSFREELISTPAGE)
+                     (\MaxSysTypeNum 0)
+                     (\MaxTypeNumber))
 
 (ADDTOVAR INITPTRS
 (\FINALIZATION.FUNCTIONS))
 
 (ADDTOVAR INEWCOMS
 (FNS NTYPX \ALLOCMDSPAGE \MAKEMDSENTRY \INITMDSPAGE \ASSIGNDATATYPE1 
-                            \TYPENUMBERFROMNAME \CREATECELL \NEW2PAGE)
-                       (FNS CREATEMDSTYPETABLE INITDATATYPES INITDATATYPENAMES)
-                       (VARS \BUILT-IN-SYSTEM-TYPES))
+                        \TYPENUMBERFROMNAME \CREATECELL \NEW2PAGE)
+                   (FNS CREATEMDSTYPETABLE INITDATATYPES INITDATATYPENAMES)
+                   (VARS \BUILT-IN-SYSTEM-TYPES))
 
 (ADDTOVAR RDCOMS
 (FNS NTYPX TYPENAME \TYPENAMEFROMNUMBER))
 
 (ADDTOVAR RDVALS
 (\MaxTypeNumber))
 
 (ADDTOVAR RD.SUBFNS
 (\ARRAYTYPENAME LAMBDA (X)
-                               'ARRAYP))
+                           'ARRAYP))
 
-(ADDTOVAR EXPANDMACROFNS
 \GETDTD PUTBASEPTRX REPLACEFIELD FETCHFIELD \GETBITS \PUTBITS \TESTBITS
-                                   GETBASEBITS PUTBASEBITS FFETCHFIELD FREPLACEFIELD FREPLACEFIELDVAL
-                                   REPLACEFIELDVAL NCREATE)
+(ADDTOVAR EXPANDMACROFNS
 \GETDTD PUTBASEPTRX REPLACEFIELD FETCHFIELD \GETBITS \PUTBITS \TESTBITS 
+                               GETBASEBITS PUTBASEBITS FFETCHFIELD FREPLACEFIELD FREPLACEFIELDVAL 
+                               REPLACEFIELDVAL NCREATE)
 
 (ADDTOVAR MKI.SUBFNS
 (\GCDISABLED . NILL)
-                         (CREATECELL . I.\CREATECELL)
-                         (\CHECKFORSTORAGEFULL . NILL))
+                     (CREATECELL . I.\CREATECELL)
+                     (\CHECKFORSTORAGEFULL . NILL))
 EVAL@COMPILE 
 
 (ADDTOVAR DONTCOMPILEFNS
 CREATEMDSTYPETABLE INITDATATYPES INITDATATYPENAMES)
@@ -1745,22 +1747,22 @@ EVAL@COMPILE
 (PUTPROPS LLDATATYPE COPYRIGHT ("VENUE, Oakland, CA" 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991
  1992 1993 1994 1995 1999))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (6675 37676 (NTYPX 6685 . 7162) (\TYPEMASK.UFN 7164 . 7688) (\TYPEP.UFN 7690 . 7859) (
-\ALLOCMDSPAGE 7861 . 9263) (\ALLOCPAGEBLOCK 9265 . 9971) (\ALLOCVIRTUALPAGEBLOCK 9973 . 12588) (
-\MAPMDS 12590 . 13706) (\CHECKFORSTORAGEFULL 13708 . 18854) (\DOSTORAGEFULLINTERRUPT 18856 . 19150) (
-\SET.STORAGE.STATE 19152 . 20025) (\SETTYPEMASK 20027 . 20974) (\ADVANCE.STORAGE.STATE 20976 . 21484) 
-(\NEW2PAGE 21486 . 21672) (\MAKEMDSENTRY 21674 . 22120) (\INITMDSPAGE 22122 . 23914) (\ASSIGNDATATYPE1
- 23916 . 33544) (\RESOLVE.TYPENUMBER 33546 . 34011) (\TYPENUMBERFROMNAME 34013 . 34553) (CREATECELL 
-34555 . 34688) (\CREATECELL 34690 . 37674)) (37775 38201 (\MAIKO.SET.STORAGE.STATE 37785 . 38199)) (
-38662 60724 (FETCHFIELD 38672 . 41863) (REPLACEFIELD 41865 . 47491) (BOXCOUNT 47493 . 47994) (
-CONSCOUNT 47996 . 48130) (\DTEST 48132 . 48265) (\TYPECHECK 48267 . 48404) (\DTEST.UFN 48406 . 51661) 
-(\INSTANCEP.UFN 51663 . 52891) (\INSTANCE-P 52893 . 53156) (\TYPECHECK.UFN 53158 . 53721) (
-GETDESCRIPTORS 53723 . 54241) (GETSUPERTYPE 54243 . 54757) (GETFIELDSPECS 54759 . 55396) (NCREATE 
-55398 . 55570) (NCREATE2 55572 . 56287) (REPLACEFIELDVAL 56289 . 56553) (PUTBASEPTRX 56555 . 57034) (
-/REPLACEFIELD 57036 . 57301) (TYPENAME 57303 . 58145) (TYPENAMEP 58147 . 58371) (\TYPENAMEFROMNUMBER 
-58373 . 58603) (\BLOCKDATAP 58605 . 58925) (USERDATATYPES 58927 . 59059) (DATATYPEP 59061 . 60210) (
-DATATYPES 60212 . 60722)) (63086 78237 (STORAGE 63096 . 67517) (STORAGE.LEFT 67519 . 71060) (
-\STORAGE.TYPE 71062 . 75122) (\STLINP 75124 . 75310) (\STMDSTYPE 75312 . 76511) (\STMDS.APPROX 76513
- . 76781) (\STORAGE.HUNKTYPE 76783 . 78235)) (85121 93820 (CREATEMDSTYPETABLE 85131 . 86920) (
-INITDATATYPES 86922 . 91767) (INITDATATYPENAMES 91769 . 93818)))))
+  (FILEMAP (NIL (6524 37135 (NTYPX 6534 . 7011) (\TYPEMASK.UFN 7013 . 7537) (\TYPEP.UFN 7539 . 7708) (
+\ALLOCMDSPAGE 7710 . 9112) (\ALLOCPAGEBLOCK 9114 . 9820) (\ALLOCVIRTUALPAGEBLOCK 9822 . 12437) (
+\MAPMDS 12439 . 13626) (\CHECKFORSTORAGEFULL 13628 . 18774) (\DOSTORAGEFULLINTERRUPT 18776 . 19070) (
+\SET.STORAGE.STATE 19072 . 19484) (\SETTYPEMASK 19486 . 20433) (\ADVANCE.STORAGE.STATE 20435 . 20943) 
+(\NEW2PAGE 20945 . 21131) (\MAKEMDSENTRY 21133 . 21579) (\INITMDSPAGE 21581 . 23373) (\ASSIGNDATATYPE1
+ 23375 . 33003) (\RESOLVE.TYPENUMBER 33005 . 33470) (\TYPENUMBERFROMNAME 33472 . 34012) (CREATECELL 
+34014 . 34147) (\CREATECELL 34149 . 37133)) (37627 59689 (FETCHFIELD 37637 . 40828) (REPLACEFIELD 
+40830 . 46456) (BOXCOUNT 46458 . 46959) (CONSCOUNT 46961 . 47095) (\DTEST 47097 . 47230) (\TYPECHECK 
+47232 . 47369) (\DTEST.UFN 47371 . 50626) (\INSTANCEP.UFN 50628 . 51856) (\INSTANCE-P 51858 . 52121) (
+\TYPECHECK.UFN 52123 . 52686) (GETDESCRIPTORS 52688 . 53206) (GETSUPERTYPE 53208 . 53722) (
+GETFIELDSPECS 53724 . 54361) (NCREATE 54363 . 54535) (NCREATE2 54537 . 55252) (REPLACEFIELDVAL 55254
+ . 55518) (PUTBASEPTRX 55520 . 55999) (/REPLACEFIELD 56001 . 56266) (TYPENAME 56268 . 57110) (
+TYPENAMEP 57112 . 57336) (\TYPENAMEFROMNUMBER 57338 . 57568) (\BLOCKDATAP 57570 . 57890) (
+USERDATATYPES 57892 . 58024) (DATATYPEP 58026 . 59175) (DATATYPES 59177 . 59687)) (61931 77082 (
+STORAGE 61941 . 66362) (STORAGE.LEFT 66364 . 69905) (\STORAGE.TYPE 69907 . 73967) (\STLINP 73969 . 
+74155) (\STMDSTYPE 74157 . 75356) (\STMDS.APPROX 75358 . 75626) (\STORAGE.HUNKTYPE 75628 . 77080)) (
+83752 92451 (CREATEMDSTYPETABLE 83762 . 85551) (INITDATATYPES 85553 . 90398) (INITDATATYPENAMES 90400
+ . 92449)))))
 STOP

sources/LLSTK

@@ -1,14 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 6-Jan-93 18:07:37" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>LLSTK.;9|
 112417 
 
-      changes to%:  (RECORDS FVARSLOT)
+
(FILECREATED "27-Feb-2024 22:46:53" {DSK}<home>larry>il>medley>sources>LLSTK.;5
 105300 
 
-      previous date%: "17-Dec-92 18:17:01" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>LLSTK.;8|)
+      :EDIT-BY "lmm"
 
+      :CHANGES-TO (RECORDS FX)
+                  (VARS LLSTKCOMS)
+
+      :PREVIOUS-DATE "27-Feb-2024 22:31:40" {DSK}<home>larry>il>medley>sources>LLSTK.;4)
 
-(* ; "
-Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 by Venue & Xerox Corporation.  All rights reserved.
-")
 
 (PRETTYCOMPRINT LLSTKCOMS)
 
@@ -28,10 +28,10 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 b
                                    (CONSTANTS \NT.IVAR \NT.PVAR \NT.FVAR))
                (RECORDS STACKCELL))
         (COMS                                                (* ; 
-
                                                           "For LAMBDA* and Common Lisp functions.")

+
                                                             "For LAMBDA* and Common Lisp functions.")

               (FNS \MYARGCOUNT \ARG0 \SETARG0))
         (COMS                                                (* ; 
-
                               "basic spaghetti for allocating, moving and reclaiming stack frames")

+
                                 "basic spaghetti for allocating, moving and reclaiming stack frames")

               (FNS \HARDRETURN \DOHARDRETURN \DOGC1 \DOGC \DOHARDRETURN1 \DOSTACKOVERFLOW \MOVEFRAME
                    \INCUSECOUNT \DECUSECOUNT \MAKESTACKP \SMASHLINK \FREESTACKBLOCK \EXTENDSTACK))
         (COMS                                                (* ; "Some ugly stack-munging ufns")

@@ -82,192 +82,186 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 b
                EVAL@COMPILE
                (ADDVARS (DONTCOMPILEFNS SETUPSTACK)))
         (LOCALVARS . T)
-        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
-                                                                             (NLAML)
-                                                                             (LAMA SI::INTERNAL-THROW
-                                                                                   
-                                                                                 SI::NON-LOCAL-RETURN
-                                                                                   ])
+        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
+               (ADDVARS (NLAMA)
+                      (NLAML)
+                      (LAMA SI::INTERNAL-THROW-VALUES SI::INTERNAL-THROW SI::NON-LOCAL-RETURN-VALUES
+                            SI::NON-LOCAL-RETURN])
 (DECLARE%: DONTCOPY 
 (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
 
-(ACCESSFNS BF
 ((BFBLOCK (ADDSTACKBASE DATUM)))           (* ; "basic frame pointer")

-                  (BLOCKRECORD BFBLOCK ((FLAGS BITS 3)
-                                        (NIL BITS 3)
-                                        (RESIDUAL FLAG)      (* ; "true if this is not a full BF")

-                                        (PADDING BITS 1)
-                                        (USECNT BITS 8)
-                                        (IVAR WORD)))
-                  (TYPE?
 (IEQ (fetch
 (BF FLAGS) of
 DATUM)
-                                  \STK.BF))
-                  [ACCESSFNS BF ((NARGS (IDIFFERENCE (FOLDLO (IDIFFERENCE DATUM (fetch

-                                                                                 (BF IVAR)
-                                                                                   of
 DATUM))
-                                                            WORDSPERCELL)
-                                               (fetch
 (BF PADDING) of
 DATUM)))
-                                 [SIZE (IPLUS 2 (IDIFFERENCE DATUM (fetch
 (BF IVAR) of
 DATUM]
-                                 (CHECKED (AND (type?
 BF DATUM)
-                                               (for
 I from
 (fetch
 (BF IVAR) of
 DATUM)
-                                                  to
 (IDIFFERENCE DATUM 2) by
 2
-                                                  always
 (IEQ \STK.NOTFLAG (fetch

-                                                                                (BF FLAGS)
-                                                                                  of
 I])
+(ACCESSFNS BF
 ((BFBLOCK (ADDSTACKBASE DATUM)))               (* ; "basic frame pointer")

+              (BLOCKRECORD BFBLOCK ((FLAGS BITS 3)
+                                    (NIL BITS 3)
+                                    (RESIDUAL FLAG)          (* ; "true if this is not a full BF")

+                                    (PADDING BITS 1)
+                                    (USECNT BITS 8)
+                                    (IVAR WORD)))
+              (TYPE?
 (IEQ (fetch
 (BF FLAGS) of
 DATUM)
+                          \STK.BF))
+              [ACCESSFNS BF ((NARGS (IDIFFERENCE (FOLDLO (IDIFFERENCE DATUM (fetch
 (BF IVAR)
+                                                                               of
 DATUM))
+                                                        WORDSPERCELL)
+                                           (fetch
 (BF PADDING) of
 DATUM)))
+                             [SIZE (IPLUS 2 (IDIFFERENCE DATUM (fetch
 (BF IVAR) of
 DATUM]
+                             (CHECKED (AND (type?
 BF DATUM)
+                                           (for
 I from
 (fetch
 (BF IVAR) of
 DATUM)
+                                              to
 (IDIFFERENCE DATUM 2) by
 2
+                                              always
 (IEQ \STK.NOTFLAG (fetch
 (BF FLAGS) of
 I])
 
-(ACCESSFNS FX
 ((FXBLOCK (ADDSTACKBASE DATUM)))           (* ; "frame extension index")

-                  (BLOCKRECORD FXBLOCK ((FLAGS BITS 3)       (* ; "= \STK.FX")

-                                        (FAST FLAG)
-                                        (NIL FLAG)
-                                        (INCALL FLAG)        (* ; 
-
                                                           "set when fncall microcode has to punt")

-                                        (VALIDNAMETABLE FLAG)(* ; 
-
                                "if on, NAMETABLE field is filled in.  If off, is same as FNHEADER")

-                                        (NOPUSH FLAG)        (* ; 
-
                         "when returning to this frame, don't push a value.  Set by interrupt code")

-                                        (USECNT BITS 8)
-                                        (%#ALINK WORD)       (* ; "low bit is SLOWP")

-                                        (FNHEADER FULLXPOINTER)
-                                        (NEXTBLOCK WORD)
-                                        (PC WORD)
-                                        (NAMETABLE# FULLXPOINTER)
-                                        (%#BLINK WORD)
-                                        (%#CLINK WORD)))
-                  (BLOCKRECORD FXBLOCK ((FLAGBYTE BYTE)
-                                        (NIL BYTE)
-                                        (NIL BITS 15)        (* ; "most of the bits of #ALINK")

-                                        (SLOWP FLAG)         (* ; 
-
                         "if on, then BLINK and CLINK fields are valid.  If off, they are implicit")

-                                        (NIL FULLXPOINTER 2)
-                                        (NAMETABHI WORD)
-                                        (NAMETABLO WORD)))
-                  (TYPE?
 (IEQ (fetch
 (FX FLAGS) of
 DATUM)
-                                  \STK.FX))
-                  [ACCESSFNS FX ((NAMETABLE (COND
-                                               ((fetch
 (FX VALIDNAMETABLE) of
 DATUM)
-                                                (fetch
 (FX NAMETABLE#) of
 DATUM))
-                                               (T (fetch
 (FX FNHEADER) of
 DATUM)))
-                                        (PROGN (replace
 (FX FAST) of
 DATUM with
 NIL)
-                                               (replace
 (FX NAMETABLE#) of
 DATUM with

-                                                                                         NEWVALUE)
-                                               (replace
 (FX VALIDNAMETABLE) of
 DATUM
-                                                  with
 T)))
-                                 (FRAMENAME (fetch
 (FNHEADER FRAMENAME)
-                                               of
 (fetch
 (FX NAMETABLE) of
 DATUM)))
-                                 (INVALIDP (EQ DATUM 0))     (* ; 
-
                                   "true when A/CLink points at nobody, i.e. FX is bottom of stack")

-                                 [FASTP (NOT (fetch
 (FX SLOWP) of
 DATUM))
-                                        (PROGN (CHECK (NULL NEWVALUE))
-                                               (COND
-                                                  ((fetch
 (FX FASTP) of
 DATUM)
-                                                   (replace
 (FX %#BLINK) of
 DATUM
-                                                      with
 (fetch
 (FX DUMMYBF) of
 DATUM))
-                                                   (replace
 (FX %#CLINK) of
 DATUM
-                                                      with
 (fetch
 (FX %#ALINK) of
 DATUM))
-                                                   (replace
 (FX SLOWP) of
 DATUM with

-                                                                                        T]
-                                 [BLINK (COND
-                                           ((fetch
 (FX FASTP) of
 DATUM)
-                                            (fetch
 (FX DUMMYBF) of
 DATUM))
-                                           (T (fetch
 (FX %#BLINK) of
 DATUM)))
-                                        (PROGN (replace
 (FX %#BLINK) of
 DATUM with
 
-                                                                                            NEWVALUE)
-                                               (COND
-                                                  ((fetch
 (FX FASTP) of
 DATUM)
-                                                   (replace
 (FX %#CLINK) of
 DATUM
-                                                      with
 (fetch
 (FX %#ALINK) of
 DATUM))
-                                                   (replace
 (FX SLOWP) of
 DATUM with

-                                                                                        T]
-                                 [CLINK (IDIFFERENCE (COND
-                                                        ((fetch
 (FX FASTP) of
 DATUM)
-                                                         (fetch
 (FX %#ALINK) of
 DATUM))
-                                                        (T (fetch
 (FX %#CLINK) of
 DATUM)))
-                                               \#ALINK.OFFSET)
-                                        (PROGN (replace
 (FX %#CLINK) of
 DATUM
-                                                  with
 (IPLUS NEWVALUE \#ALINK.OFFSET))
-                                               (COND
-                                                  ((fetch
 (FX FASTP) of
 DATUM)
-                                                   (replace
 (FX %#BLINK) of
 DATUM
-                                                      with
 (fetch
 (FX DUMMYBF) of
 DATUM))
-                                                   (replace
 (FX SLOWP) of
 DATUM with

-                                                                                        T]
-                                 [ALINK (IDIFFERENCE (FLOOR (fetch
 (FX %#ALINK) of
 DATUM)
-                                                            WORDSPERCELL)
-                                               \#ALINK.OFFSET)
-                                        (PROGN [COND
-                                                  ((fetch
 (FX FASTP) of
 DATUM)
-                                                   (replace
 (FX %#BLINK) of
 DATUM
-                                                      with
 (fetch
 (FX DUMMYBF) of
 DATUM))
-                                                   (replace
 (FX %#CLINK) of
 DATUM
-                                                      with
 (fetch
 (FX %#ALINK) of
 DATUM]
-                                               (replace
 (FX %#ALINK) of
 DATUM
-                                                  with
 (IPLUS NEWVALUE \#ALINK.OFFSET
-                                                                  (SUB1 WORDSPERCELL]
-                                 [ACLINK (SHOULDNT)
-                                        (PROGN [COND
-                                                  ((fetch
 (FX FASTP) of
 DATUM)
-                                                   (replace
 (FX %#BLINK) of
 DATUM
-                                                      with
 (fetch
 (FX DUMMYBF) of
 DATUM]
+(ACCESSFNS FX
 ((FXBLOCK (ADDSTACKBASE DATUM)))               (* ; "frame extension index")

+              (BLOCKRECORD FXBLOCK ((FLAGS BITS 3)           (* ; "= \STK.FX")

+                                    (FAST FLAG)
+                                    (NIL FLAG)
+                                    (INCALL FLAG)            (* ; 
+
                                                             "set when fncall microcode has to punt")

+                                    (VALIDNAMETABLE FLAG)    (* ; 
+
                                  "if on, NAMETABLE field is filled in.  If off, is same as FNHEADER")

+                                    (NOPUSH FLAG)            (* ; 
+
                           "when returning to this frame, don't push a value.  Set by interrupt code")

+                                    (USECNT BITS 8)
+                                    (%#ALINK WORD)           (* ; "low bit is SLOWP")

+                                    (FNHEADER FULLXPOINTER)
+                                    (NEXTBLOCK WORD)
+                                    (PC WORD)
+                                    (NAMETABLE# FULLXPOINTER)
+                                    (%#BLINK WORD)
+                                    (%#CLINK WORD)))
+              (BLOCKRECORD FXBLOCK ((FLAGBYTE BYTE)
+                                    (NIL BYTE)
+                                    (NIL BITS 15)            (* ; "most of the bits of #ALINK")

+                                    (SLOWP FLAG)             (* ; 
+
                           "if on, then BLINK and CLINK fields are valid.  If off, they are implicit")

+                                    (NIL FULLXPOINTER)       (* ; "FNHEADER")

+                                    (NIL WORD)               (* ; "NEXSTBLOCK")

+                                    (NIL WORD)               (* ; "PC")

+                                    (NAMETABHI WORD)
+                                    (NAMETABLO WORD)))
+              (TYPE?
 (IEQ (fetch
 (FX FLAGS) of
 DATUM)
+                          \STK.FX))
+              [ACCESSFNS FX ((NAMETABLE (COND
+                                           ((fetch
 (FX VALIDNAMETABLE) of
 DATUM)
+                                            (fetch
 (FX NAMETABLE#) of
 DATUM))
+                                           (T (fetch
 (FX FNHEADER) of
 DATUM)))
+                                    (PROGN (replace
 (FX FAST) of
 DATUM with
 NIL)
+                                           (replace
 (FX NAMETABLE#) of
 DATUM with
 NEWVALUE)
+                                           (replace
 (FX VALIDNAMETABLE) of
 DATUM with
 T)))
+                             (FRAMENAME (fetch
 (FNHEADER FRAMENAME) of
 (fetch
 (FX NAMETABLE)
+                                                                          of
 DATUM)))
+                             (INVALIDP (EQ DATUM 0))         (* ; 
+
                                     "true when A/CLink points at nobody, i.e. FX is bottom of stack")

+                             [FASTP (NOT (fetch
 (FX SLOWP) of
 DATUM))
+                                    (PROGN (CHECK (NULL NEWVALUE))
+                                           (COND
+                                              ((fetch
 (FX FASTP) of
 DATUM)
+                                               (replace
 (FX %#BLINK) of
 DATUM
+                                                  with
 (fetch
 (FX DUMMYBF) of
 DATUM))
                                                (replace
 (FX %#CLINK) of
 DATUM
-                                                  with
 (IPLUS NEWVALUE \#ALINK.OFFSET))
-                                               (replace
 (FX %#ALINK) of
 DATUM
-                                                  with
 (IPLUS NEWVALUE \#ALINK.OFFSET
-                                                                  (SUB1 WORDSPERCELL]
+                                                  with
 (fetch
 (FX %#ALINK) of
 DATUM))
+                                               (replace
 (FX SLOWP) of
 DATUM with
 T]
+                             [BLINK (COND
+                                       ((fetch
 (FX FASTP) of
 DATUM)
+                                        (fetch
 (FX DUMMYBF) of
 DATUM))
+                                       (T (fetch
 (FX %#BLINK) of
 DATUM)))
+                                    (PROGN (replace
 (FX %#BLINK) of
 DATUM with
 NEWVALUE)
+                                           (COND
+                                              ((fetch
 (FX FASTP) of
 DATUM)
+                                               (replace
 (FX %#CLINK) of
 DATUM
+                                                  with
 (fetch
 (FX %#ALINK) of
 DATUM))
+                                               (replace
 (FX SLOWP) of
 DATUM with
 T]
+                             [CLINK (IDIFFERENCE (COND
+                                                    ((fetch
 (FX FASTP) of
 DATUM)
+                                                     (fetch
 (FX %#ALINK) of
 DATUM))
+                                                    (T (fetch
 (FX %#CLINK) of
 DATUM)))
+                                           \#ALINK.OFFSET)
+                                    (PROGN (replace
 (FX %#CLINK) of
 DATUM with
 (IPLUS NEWVALUE 
+                                                                                      \#ALINK.OFFSET)
+                                                  )
+                                           (COND
+                                              ((fetch
 (FX FASTP) of
 DATUM)
+                                               (replace
 (FX %#BLINK) of
 DATUM
+                                                  with
 (fetch
 (FX DUMMYBF) of
 DATUM))
+                                               (replace
 (FX SLOWP) of
 DATUM with
 T]
+                             [ALINK (IDIFFERENCE (FLOOR (fetch
 (FX %#ALINK) of
 DATUM)
+                                                        WORDSPERCELL)
+                                           \#ALINK.OFFSET)
+                                    (PROGN [COND
+                                              ((fetch
 (FX FASTP) of
 DATUM)
+                                               (replace
 (FX %#BLINK) of
 DATUM
+                                                  with
 (fetch
 (FX DUMMYBF) of
 DATUM))
+                                               (replace
 (FX %#CLINK) of
 DATUM
+                                                  with
 (fetch
 (FX %#ALINK) of
 DATUM]
+                                           (replace
 (FX %#ALINK) of
 DATUM with
 (IPLUS NEWVALUE 
+                                                                                      \#ALINK.OFFSET
+                                                                                      (SUB1 
+                                                                                         WORDSPERCELL
+                                                                                            ]
+                             [ACLINK (SHOULDNT)
+                                    (PROGN [COND
+                                              ((fetch
 (FX FASTP) of
 DATUM)
+                                               (replace
 (FX %#BLINK) of
 DATUM
+                                                  with
 (fetch
 (FX DUMMYBF) of
 DATUM]
+                                           (replace
 (FX %#CLINK) of
 DATUM with
 (IPLUS NEWVALUE 
+                                                                                      \#ALINK.OFFSET)
+                                                  )
+                                           (replace
 (FX %#ALINK) of
 DATUM with
 (IPLUS NEWVALUE 
+                                                                                      \#ALINK.OFFSET
+                                                                                      (SUB1 
+                                                                                         WORDSPERCELL
+                                                                                            ]
                                                              (* ; 
-
                                    "replaces A & C Links at once more efficiently than separately")

-                                 (DUMMYBF (IDIFFERENCE DATUM WORDSPERCELL))
+
                                      "replaces A & C Links at once more efficiently than separately")

+                             (DUMMYBF (IDIFFERENCE DATUM WORDSPERCELL))
 
-                                 (* ;; "This is either an actual BF or %"residual%" BF that provides enough BF to find its IVAR slot.  This means that when a FX is copied, the cell preceding the FX is copied too.")

+                             (* ;; "This is either an actual BF or %"residual%" BF that provides enough BF to find its IVAR slot.  This means that when a FX is copied, the cell preceding the FX is copied too.")

 
-                                 (IVAR (fetch
 (BF IVAR) of
 (fetch
 (FX DUMMYBF)
-                                                                      of
 DATUM)))
-                                 [CHECKED (AND (type?
 FX DATUM)
-                                               (OR (IEQ (fetch
 (FX DUMMYBF) of
 DATUM)
-                                                        (fetch
 (FX BLINK) of
 DATUM))
-                                                   (AND (fetch
 (BF RESIDUAL)
-                                                           of
 (fetch
 (FX DUMMYBF)
-                                                                     of
 DATUM))
-                                                        (IEQ (fetch
 (BF IVAR)
-                                                                of
 (fetch
 (FX DUMMYBF)
-                                                                          of
 DATUM))
-                                                             (fetch
 (BF IVAR)
-                                                                of
 (fetch
 (FX BLINK)
-                                                                          of
 DATUM]
-                                 (FIRSTPVAR (IPLUS DATUM (fetch
 (FX FXSIZE) of
 T)))
+                             (IVAR (fetch
 (BF IVAR) of
 (fetch
 (FX DUMMYBF) of
 DATUM)))
+                             [CHECKED (AND (type?
 FX DATUM)
+                                           (OR (IEQ (fetch
 (FX DUMMYBF) of
 DATUM)
+                                                    (fetch
 (FX BLINK) of
 DATUM))
+                                               (AND (fetch
 (BF RESIDUAL) of
 (fetch
 (FX DUMMYBF)
+                                                                               of
 DATUM))
+                                                    (IEQ (fetch
 (BF IVAR) of
 (fetch
 (FX DUMMYBF)
+                                                                                of
 DATUM))
+                                                         (fetch
 (BF IVAR) of
 (fetch
 (FX BLINK)
+                                                                                of
 DATUM]
+                             (FIRSTPVAR (IPLUS DATUM (fetch
 (FX FXSIZE) of
 T)))
                                                              (* ; "stack offset of PVAR0")

-                                 (FXSIZE (PROGN 10))         (* ; 
-
                                                           "fixed overhead from flags thru clink")

-                                 (PADDING (PROGN 4))         (* ; 
-
                                                          "doublecell of garbage for microcode use")

-                                 (FIRSTTEMP (IPLUS (fetch
 (FX FIRSTPVAR) of
 DATUM)
-                                                   (fetch
 (FX NPVARWORDS) of
 DATUM)
-                                                   (fetch
 (FX PADDING) of
 DATUM)))
+                             (FXSIZE (PROGN 10))             (* ; 
+
                                                             "fixed overhead from flags thru clink")

+                             (PADDING (PROGN 4))             (* ; 
+
                                                            "doublecell of garbage for microcode use")

+                             (FIRSTTEMP (IPLUS (fetch
 (FX FIRSTPVAR) of
 DATUM)
+                                               (fetch
 (FX NPVARWORDS) of
 DATUM)
+                                               (fetch
 (FX PADDING) of
 DATUM)))
                                                              (* ; 
-
                                               "note that NPVARWORDS is obtained from the FNHEADER")

-                                 (SIZE (IDIFFERENCE (fetch
 (FX NEXTBLOCK) of
 DATUM)
-                                              DATUM])
+
                                                 "note that NPVARWORDS is obtained from the FNHEADER")

+                             (SIZE (IDIFFERENCE (fetch
 (FX NEXTBLOCK) of
 DATUM)
+                                          DATUM])
 
 (ACCESSFNS FSB
 
-                   (* ;; "FREE STACK BLOCK -- ")

+               (* ;; "FREE STACK BLOCK -- ")

 
-                   (* ;; " A piece of stack space that's free.")

+               (* ;; " A piece of stack space that's free.")

 
-                   (* ;; "The first word contains 120000Q")

+               (* ;; "The first word contains 120000Q")

 
-                   (* ;; "The 2nd word is the size of the block, in words.")

+               (* ;; "The 2nd word is the size of the block, in words.")

 
-                   ((FSBBLOCK (ADDSTACKBASE DATUM))
-                    (CHECKED (IEQ (fetch
 (FSB FLAGWORD) of
 DATUM)
-                                  \STK.FSB.WORD)))
-                   (BLOCKRECORD FSBBLOCK ((FLAGS BITS 3)
-                                          (DUMMY BITS 13)
-                                          (SIZE WORD)))
-                   (BLOCKRECORD FSBBLOCK ((FLAGWORD WORD)
-                                          (SIZE WORD)))      (* ; "free stack block")

-                   (TYPE?
 (IEQ (fetch
 (FSB FLAGS) of
 DATUM)
-                                   \STK.FSB)))
+               ((FSBBLOCK (ADDSTACKBASE DATUM))
+                (CHECKED (IEQ (fetch
 (FSB FLAGWORD) of
 DATUM)
+                              \STK.FSB.WORD)))
+               (BLOCKRECORD FSBBLOCK ((FLAGS BITS 3)
+                                      (DUMMY BITS 13)
+                                      (SIZE WORD)))
+               (BLOCKRECORD FSBBLOCK ((FLAGWORD WORD)
+                                      (SIZE WORD)))          (* ; "free stack block")

+               (TYPE?
 (IEQ (fetch
 (FSB FLAGS) of
 DATUM)
+                           \STK.FSB)))
 
-(ACCESSFNS STK
 ((STKBLOCK (ADDSTACKBASE DATUM)))         (* ; "unspecified stack block")

-                   (BLOCKRECORD STKBLOCK ((FLAGS BITS 3)))
-                   (BLOCKRECORD STKBLOCK ((FLAGWORD WORD))))
+(ACCESSFNS STK
 ((STKBLOCK (ADDSTACKBASE DATUM)))             (* ; "unspecified stack block")

+               (BLOCKRECORD STKBLOCK ((FLAGS BITS 3)))
+               (BLOCKRECORD STKBLOCK ((FLAGWORD WORD))))
 )
 (DECLARE%: EVAL@COMPILE 
 
@@ -287,47 +281,44 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 b
 (PUTPROPS ADDSTACKBASE
 DMACRO
 (= . STACKADDBASE))
 
 (PUTPROPS STACKADDBASE
 DMACRO
 ((N)
-                                       (VAG2 \STACKHI N)))
+                               (VAG2 \STACKHI N)))
 
 (PUTPROPS STACKGETBASE
 DMACRO
 ((N)
-                                       (\GETBASE (STACKADDBASE N)
-                                              0)))
+                               (\GETBASE (STACKADDBASE N)
+                                      0)))
 
 (PUTPROPS STACKGETBASEPTR
 DMACRO
 ((N)
-                                          (\GETBASEPTR (STACKADDBASE N)
-                                                 0)))
+                                  (\GETBASEPTR (STACKADDBASE N)
+                                         0)))
 
 (PUTPROPS STACKPUTBASE
 DMACRO
 ((N V)
-                                       (\PUTBASE (STACKADDBASE N)
-                                              0 V)))
+                               (\PUTBASE (STACKADDBASE N)
+                                      0 V)))
 
 (PUTPROPS STACKPUTBASEPTR
 DMACRO
 ((N V)
-                                          (\PUTBASEPTR (STACKADDBASE N)
-                                                 0 V)))
+                                  (\PUTBASEPTR (STACKADDBASE N)
+                                         0 V)))
 
 (PUTPROPS \MISCAPPLY*
 MACRO
 ((FN ARG1 ARG2)
-                                     (UNINTERRUPTABLY
-                                         (replace
 (IFPAGE MISCSTACKFN) of
 \InterfacePage
-                                            with
 FN)
-                                         (replace
 (IFPAGE MISCSTACKARG1) of
 \InterfacePage
-                                            with
 ARG1)
-                                         (replace
 (IFPAGE MISCSTACKARG2) of
 \InterfacePage
-                                            with
 ARG2)
-                                         (\CONTEXTSWITCH \MiscFXP)
-                                         (fetch
 (IFPAGE MISCSTACKRESULT) of
 \InterfacePage))))
+                             (UNINTERRUPTABLY
+                                 (replace
 (IFPAGE MISCSTACKFN) of
 \InterfacePage with
 FN)
+                                 (replace
 (IFPAGE MISCSTACKARG1) of
 \InterfacePage with
 ARG1)
+                                 (replace
 (IFPAGE MISCSTACKARG2) of
 \InterfacePage with
 ARG2)
+                                 (\CONTEXTSWITCH \MiscFXP)
+                                 (fetch
 (IFPAGE MISCSTACKRESULT) of
 \InterfacePage))))
 )
 (DECLARE%: EVAL@COMPILE
 
 (BLOCKRECORD STACKP
 ((STACKP0 WORD)
-                         (EDFXP WORD))
-                        (BLOCKRECORD STACKP ((STACKPOINTER FULLXPOINTER)))
-                        (TYPE?
 (STACKP DATUM)))
+                     (EDFXP WORD))
+                    (BLOCKRECORD STACKP ((STACKPOINTER FULLXPOINTER)))
+                    (TYPE?
 (STACKP DATUM)))
 )
 
 (RPAQQ STACKTYPES
 (\STK.GUARD \STK.FX \STK.BF \STK.NOTFLAG \STK.FSB \STK.FLAGS.SHIFT
-                             (\STK.FSB.WORD (LLSH \STK.FSB \STK.FLAGS.SHIFT))
-                             (\STK.GUARD.WORD (LLSH \STK.GUARD \STK.FLAGS.SHIFT))
-                             (\STK.BF.WORD (LLSH \STK.BF \STK.FLAGS.SHIFT))))
+                         (\STK.FSB.WORD (LLSH \STK.FSB \STK.FLAGS.SHIFT))
+                         (\STK.GUARD.WORD (LLSH \STK.GUARD \STK.FLAGS.SHIFT))
+                         (\STK.BF.WORD (LLSH \STK.BF \STK.FLAGS.SHIFT))))
 (DECLARE%: EVAL@COMPILE 
 
 (RPAQQ \STK.GUARD
 7)
@@ -375,44 +366,44 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 b
 (DECLARE%: EVAL@COMPILE
 
 (BLOCKRECORD NAMETABLESLOT
 ((VARTYPE BYTE)
-                                (VAROFFSET BYTE)))
+                            (VAROFFSET BYTE)))
 
 (BLOCKRECORD FVARSLOT
 ((BINDLO WORD)
-                           (BINDHI WORD))
-                          [ACCESSFNS FVARSLOT ((LOOKEDUP (EVENP (fetch
 BINDLO of
 DATUM)))
-                                               (BINDINGPTR (\VAG2 (fetch
 BINDHI of
 DATUM)
-                                                                  (fetch
 BINDLO of
 DATUM))
-                                                      (PROGN (replace
 BINDLO of
 DATUM
-                                                                with
 (\LOLOC NEWVALUE))
-                                                             (replace
 BINDHI of
 DATUM
-                                                                with
 (\HILOC NEWVALUE])
+                       (BINDHI WORD))
+                      [ACCESSFNS FVARSLOT ((LOOKEDUP (EVENP (fetch
 BINDLO of
 DATUM)))
+                                           (BINDINGPTR (\VAG2 (fetch
 BINDHI of
 DATUM)
+                                                              (fetch
 BINDLO of
 DATUM))
+                                                  (PROGN (replace
 BINDLO of
 DATUM with
 (\LOLOC 
+                                                                                             NEWVALUE
+                                                                                              ))
+                                                         (replace
 BINDHI of
 DATUM with
 (\HILOC 
+                                                                                             NEWVALUE
+                                                                                              ])
 
 (BLOCKRECORD PVARSLOT
 ((PVHI BITS 4)
-                           (PVVALUE XPOINTER))
-                          [ACCESSFNS PVARSLOT ((BOUND (EQ (fetch
 (PVARSLOT PVHI) of
 DATUM)
-                                                          0)
-                                                      (if
 (NULL NEWVALUE)
-                                                          then
 (replace
 (PVARSLOT PVHI)
-                                                                      of
 DATUM with
 255)
-                                                        else
 (ERROR "Illegal replace" NEWVALUE])
+                       (PVVALUE XPOINTER))
+                      [ACCESSFNS PVARSLOT ((BOUND (EQ (fetch
 (PVARSLOT PVHI) of
 DATUM)
+                                                      0)
+                                                  (if
 (NULL NEWVALUE)
+                                                      then
 (replace
 (PVARSLOT PVHI) of
 DATUM
+                                                              with
 255)
+                                                    else
 (ERROR "Illegal replace" NEWVALUE])
 
 (BLOCKRECORD STKTEMPSLOT
 ((STKTMPHI BITS 4)
-                              (VALUE XPOINTER))
-                             [ACCESSFNS STKTEMPSLOT ((BINDINGPTRP (NEQ (fetch
 STKTMPHI
-                                                                          of
 DATUM)
-                                                                       0])
+                          (VALUE XPOINTER))
+                         [ACCESSFNS STKTEMPSLOT ((BINDINGPTRP (NEQ (fetch
 STKTMPHI of
 DATUM)
+                                                                   0])
 
 (BLOCKRECORD BINDMARKSLOT
 ((BINDMARKP FLAG)
-                               (NIL BITS 15))
-                              (BLOCKRECORD BINDMARKSLOT ((BINDNEGVALUES WORD)
-                                                         (BINDLASTPVAR WORD)))
-                              [ACCESSFNS BINDMARKSLOT ((BINDNVALUES (PROGN 
+                           (NIL BITS 15))
+                          (BLOCKRECORD BINDMARKSLOT ((BINDNEGVALUES WORD)
+                                                     (BINDLASTPVAR WORD)))
+                          [ACCESSFNS BINDMARKSLOT ((BINDNVALUES (PROGN 
                                                              (* ; 
-
                          "Value stored in high half is one's complement of number of values bound")

-                                                                           (LOGXOR (fetch
 
-                                                                                        BINDNEGVALUES
-                                                                                      of
 DATUM)
-                                                                                  65535])
+
                            "Value stored in high half is one's complement of number of values bound")

+                                                                       (LOGXOR (fetch
 BINDNEGVALUES
+                                                                                  of
 DATUM)
+                                                                              65535])
 )
 (DECLARE%: EVAL@COMPILE 
 
@@ -432,13 +423,12 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 b
 (DECLARE%: EVAL@COMPILE
 
 (BLOCKRECORD STACKCELL
 ((STACKNONPOINTERBITS BITS 8)
-                            (STACKHIBITS BITS 8)
-                            (STACKLOBITS WORD))
-                           [ACCESSFNS STACKCELL ((VALIDPOINTERP (EQ 0 (fetch
 (STACKCELL 
-                                                                                  STACKNONPOINTERBITS
-                                                                                        )
-                                                                         of
 DATUM)))
-                                                 (VALIDPOINTER (\GETBASEPTR DATUM 0])
+                        (STACKHIBITS BITS 8)
+                        (STACKLOBITS WORD))
+                       [ACCESSFNS STACKCELL ((VALIDPOINTERP (EQ 0 (fetch
 (STACKCELL 
+                                                                                STACKNONPOINTERBITS)
+                                                                     of
 DATUM)))
+                                             (VALIDPOINTER (\GETBASEPTR DATUM 0])
 )
 )
 
@@ -1221,10 +1211,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 b
 )
 )
 
-(RPAQQ *HARDRESET-IGNORE-VARS*
 (SI::*CLEANUP-FORMS* SI::*DUMMY-FOR-CATCH* SI::*CATCH-RETURN-FROM*
-                                          SI::*CATCH-RETURN-TO* *FORM* *ARGVAL* *FN* *TAIL* 
-                                          *FIRSTTAIL* \INTERNAL \INTERRUPTABLE SI::*NLSETQFLAG* 
-                                          *PROCEED-CASES*))
+(RPAQQ *HARDRESET-IGNORE-VARS*
 (SI::*CLEANUP-FORMS* SI::*DUMMY-FOR-CATCH* SI::*CATCH-RETURN-FROM* 
+                                      SI::*CATCH-RETURN-TO* *FORM* *ARGVAL* *FN* *TAIL* *FIRSTTAIL* 
+                                      \INTERNAL \INTERRUPTABLE SI::*NLSETQFLAG* *PROCEED-CASES*))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS *HARDRESET-IGNORE-VARS*)
@@ -1303,118 +1292,31 @@ EVAL@COMPILE
 
 (ADDTOVAR NLAML
 )
 
-(ADDTOVAR LAMA
 SI::INTERNAL-THROW SI::NON-LOCAL-RETURN)
-)
-(PRETTYCOMPRINT LLSTKCOMS)
-
-(RPAQQ LLSTKCOMS

-       [(DECLARE%: DONTCOPY (EXPORT (RECORDS BF FX FSB STK)
-                                   (CONSTANTS \#ALINK.OFFSET)
-                                   (GLOBALVARS \PENDINGINTERRUPT \KBDSTACKBASE \MISCSTACKBASE 
-                                          \STACKOVERFLOW)
-                                   (MACROS \MYALINK ADDSTACKBASE STACKADDBASE STACKGETBASE 
-                                          STACKGETBASEPTR STACKPUTBASE STACKPUTBASEPTR \MISCAPPLY*)
-                                   (RECORDS STACKP)
-                                   (CONSTANTS * STACKTYPES)
-                                   (CONSTANTS \StackAreaSize (\InitStackSize (ITIMES \StackAreaSize 
-                                                                                    12)))
-                                   (CONSTANTS \MAXSAFEUSECOUNT)
-                                   (RECORDS NAMETABLESLOT FVARSLOT PVARSLOT STKTEMPSLOT BINDMARKSLOT)
-                                   (CONSTANTS \NT.IVAR \NT.PVAR \NT.FVAR))
-               (RECORDS STACKCELL))
-        (COMS                                                (* ; 
-
                                                           "For LAMBDA* and Common Lisp functions.")

-              (FNS \MYARGCOUNT \ARG0 \SETARG0))
-        (COMS                                                (* ; 
-
                               "basic spaghetti for allocating, moving and reclaiming stack frames")

-              (FNS \HARDRETURN \DOHARDRETURN \DOGC1 \DOGC \DOHARDRETURN1 \DOSTACKOVERFLOW \MOVEFRAME
-                   \INCUSECOUNT \DECUSECOUNT \MAKESTACKP \SMASHLINK \FREESTACKBLOCK \EXTENDSTACK))
-        (COMS                                                (* ; "Some ugly stack-munging ufns")

-              (FNS \SLOWRETURN \COPY.N.UFN \POP.N.UFN \STORE.N.UFN \UNWIND.UFN))
-        (COMS                                                (* ; "The unwinder")

-              (FNS SI::NON-LOCAL-GO SI::NON-LOCAL-RETURN SI::NON-LOCAL-RETURN-VALUES 
-                   SI::INTERNAL-THROW SI::INTERNAL-THROW-VALUES SI::UNWIND-TO-BLIP SI::UNWIND 
-                   SI::VARIABLE-NAME-IN-FRAME SI::PVAR-VALUE-IN-FRAME)
-              (FNS \DISCARDFRAME \SMASHRETURN))
-        (COMS                                                (* ; "parsing stack for gc")

-              (FNS \GCSCANSTACK))
-        (COMS                                                (* ; "setting up stack from scratch")

-              (FNS CLEARSTK HARDRESET RELSTK RELSTKP)
-              (FNS SETUPSTACK \SETUPSTACK1 \MAKEFRAME \RESETSTACK \RESETSTACK0 \SETUPUSERSTACK 
-                   \SETUPGUARDBLOCK \MAKEFREEBLOCK \REPEATEDLYEVALQT \DUMMYKEYHANDLER \DUMMYTELERAID
-                   \CAUSEINTERRUPT \CONTEXTAPPLY \INTERRUPTFRAME \INTERRUPTED \CODEFORTFRAME 
-                   \DOMISCAPPLY \DOMISCAPPLY1)
-              (INITVARS \SAVED.USER.CONTEXT \NEED.HARDRESET.CLEANUP)
-              (GLOBALVARS \SAVED.USER.CONTEXT \NEED.HARDRESET.CLEANUP))
-        (COMS                                                (* ; "HARDRESET recovery code")

-              (FNS \GATHER-CLEANUP-FORMS \GATHER-CLEANUP-FORMS1 \GATHER-SPECIAL-BINDINGS 
-                   \HARDRESET-CLEANUP \HARDRESET-CLEANUP1 \HARDRESET-CLEANUP-RUN)
-              (VARS *HARDRESET-IGNORE-VARS*)
-              (GLOBALVARS *HARDRESET-IGNORE-VARS*))
-        (COMS                                                (* ; "Ufns for RETCALL")

-              (FNS \DORETCALL \RETCALL))
-        (INITVARS (STACKTESTING T))
-        (COMS                                                (* ; "Stack overflow handler")

-              (FNS \DOSTACKFULLINTERRUPT STACK.FULL.WARNING \CLEANUP.STACKFULL)
-              (INITVARS (\PENDINGINTERRUPT)
-                     (\STACKOVERFLOW)
-                     (AUTOHARDRESETFLG T))
-              (ADDVARS (RESETFORMS (SETQ \STACKOVERFLOW)))
-              (GLOBALVARS AUTOHARDRESETFLG))
-        (DECLARE%: DONTCOPY
-               (ADDVARS [INEWCOMS (FNS SETUPSTACK \SETUPSTACK1 \SETUPGUARDBLOCK \MAKEFREEBLOCK)
-                               (ALLOCAL (ADDVARS (LOCKEDFNS \RESETSTACK0 \MAKEFRAME \SETUPSTACK1 
-                                                        \MAKEFREEBLOCK \FAULTHANDLER \KEYHANDLER 
-                                                        \DUMMYKEYHANDLER \DOTELERAID \DUMMYTELERAID 
-                                                        \DOHARDRETURN \DOGC \CAUSEINTERRUPT 
-                                                        \INTERRUPTFRAME \CODEFORTFRAME 
-                                                        \DOSTACKOVERFLOW \UNLOCKPAGES \DOMISCAPPLY)
-                                               (LOCKEDVARS \InterfacePage \DEFSPACE \STACKSPACE 
-                                                      \KBDSTACKBASE \MISCSTACKBASE 
-                                                      \SAVED.USER.CONTEXT \RUNNING.PROCESS 
-                                                      \NEED.HARDRESET.CLEANUP]
-                      (EXPANDMACROFNS ADDSTACKBASE STACKADDBASE))
-               EVAL@COMPILE
-               (ADDVARS (DONTCOMPILEFNS SETUPSTACK)))
-        (LOCALVARS . T)
-        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
-               (ADDVARS (NLAMA)
-                      (NLAML)
-                      (LAMA SI::INTERNAL-THROW-VALUES SI::INTERNAL-THROW SI::NON-LOCAL-RETURN-VALUES
-                            SI::NON-LOCAL-RETURN])
-(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
-
-(ADDTOVAR NLAMA
 )
-
-(ADDTOVAR NLAML
 )
-
 (ADDTOVAR LAMA
 SI::INTERNAL-THROW-VALUES SI::INTERNAL-THROW SI::NON-LOCAL-RETURN-VALUES 
-                         SI::NON-LOCAL-RETURN)
+                     SI::NON-LOCAL-RETURN)
 )
-(PUTPROPS LLSTK COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991 
-1992 1993))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (26973 28438 (\MYARGCOUNT 26983 . 27268) (\ARG0 27270 . 27836) (\SETARG0 27838 . 28436))
- (28522 45444 (\HARDRETURN 28532 . 28748) (\DOHARDRETURN 28750 . 28929) (\DOGC1 28931 . 29146) (\DOGC 
-29148 . 29253) (\DOHARDRETURN1 29255 . 33570) (\DOSTACKOVERFLOW 33572 . 34472) (\MOVEFRAME 34474 . 
-38001) (\INCUSECOUNT 38003 . 38769) (\DECUSECOUNT 38771 . 39916) (\MAKESTACKP 39918 . 40378) (
-\SMASHLINK 40380 . 41833) (\FREESTACKBLOCK 41835 . 44576) (\EXTENDSTACK 44578 . 45442)) (45490 49233 (
-\SLOWRETURN 45500 . 45638) (\COPY.N.UFN 45640 . 45805) (\POP.N.UFN 45807 . 46482) (\STORE.N.UFN 46484
- . 46658) (\UNWIND.UFN 46660 . 49231)) (49263 60146 (SI::NON-LOCAL-GO 49273 . 49771) (
-SI::NON-LOCAL-RETURN 49773 . 50498) (SI::NON-LOCAL-RETURN-VALUES 50500 . 51073) (SI::INTERNAL-THROW 
-51075 . 51743) (SI::INTERNAL-THROW-VALUES 51745 . 52251) (SI::UNWIND-TO-BLIP 52253 . 55986) (SI::UNWIND
- 55988 . 57544) (SI::VARIABLE-NAME-IN-FRAME 57546 . 58466) (SI::PVAR-VALUE-IN-FRAME 58468 . 60144)) (
-60147 63781 (\DISCARDFRAME 60157 . 62105) (\SMASHRETURN 62107 . 63779)) (63819 70819 (\GCSCANSTACK 
-63829 . 70817)) (70866 72307 (CLEARSTK 70876 . 71570) (HARDRESET 71572 . 71693) (RELSTK 71695 . 71893)
- (RELSTKP 71895 . 72305)) (72308 84299 (SETUPSTACK 72318 . 73336) (\SETUPSTACK1 73338 . 75247) (
-\MAKEFRAME 75249 . 75602) (\RESETSTACK 75604 . 75907) (\RESETSTACK0 75909 . 79013) (\SETUPUSERSTACK 
-79015 . 80719) (\SETUPGUARDBLOCK 80721 . 80887) (\MAKEFREEBLOCK 80889 . 81128) (\REPEATEDLYEVALQT 
-81130 . 81261) (\DUMMYKEYHANDLER 81263 . 81565) (\DUMMYTELERAID 81567 . 81680) (\CAUSEINTERRUPT 81682
- . 82730) (\CONTEXTAPPLY 82732 . 82944) (\INTERRUPTFRAME 82946 . 83140) (\INTERRUPTED 83142 . 83354) (
-\CODEFORTFRAME 83356 . 83612) (\DOMISCAPPLY 83614 . 83689) (\DOMISCAPPLY1 83691 . 84297)) (84513 
-102751 (\GATHER-CLEANUP-FORMS 84523 . 84899) (\GATHER-CLEANUP-FORMS1 84901 . 88530) (
-\GATHER-SPECIAL-BINDINGS 88532 . 91506) (\HARDRESET-CLEANUP 91508 . 95965) (\HARDRESET-CLEANUP1 95967
- . 102300) (\HARDRESET-CLEANUP-RUN 102302 . 102749)) (103213 104265 (\DORETCALL 103223 . 104165) (
-\RETCALL 104167 . 104263)) (104333 105268 (\DOSTACKFULLINTERRUPT 104343 . 104551) (STACK.FULL.WARNING 
-104553 . 104921) (\CLEANUP.STACKFULL 104923 . 105266)))))
+  (FILEMAP (NIL (25672 27137 (\MYARGCOUNT 25682 . 25967) (\ARG0 25969 . 26535) (\SETARG0 26537 . 27135))
+ (27221 44143 (\HARDRETURN 27231 . 27447) (\DOHARDRETURN 27449 . 27628) (\DOGC1 27630 . 27845) (\DOGC 
+27847 . 27952) (\DOHARDRETURN1 27954 . 32269) (\DOSTACKOVERFLOW 32271 . 33171) (\MOVEFRAME 33173 . 
+36700) (\INCUSECOUNT 36702 . 37468) (\DECUSECOUNT 37470 . 38615) (\MAKESTACKP 38617 . 39077) (
+\SMASHLINK 39079 . 40532) (\FREESTACKBLOCK 40534 . 43275) (\EXTENDSTACK 43277 . 44141)) (44189 47932 (
+\SLOWRETURN 44199 . 44337) (\COPY.N.UFN 44339 . 44504) (\POP.N.UFN 44506 . 45181) (\STORE.N.UFN 45183
+ . 45357) (\UNWIND.UFN 45359 . 47930)) (47962 58845 (SI::NON-LOCAL-GO 47972 . 48470) (
+SI::NON-LOCAL-RETURN 48472 . 49197) (SI::NON-LOCAL-RETURN-VALUES 49199 . 49772) (SI::INTERNAL-THROW 
+49774 . 50442) (SI::INTERNAL-THROW-VALUES 50444 . 50950) (SI::UNWIND-TO-BLIP 50952 . 54685) (SI::UNWIND
+ 54687 . 56243) (SI::VARIABLE-NAME-IN-FRAME 56245 . 57165) (SI::PVAR-VALUE-IN-FRAME 57167 . 58843)) (
+58846 62480 (\DISCARDFRAME 58856 . 60804) (\SMASHRETURN 60806 . 62478)) (62518 69518 (\GCSCANSTACK 
+62528 . 69516)) (69565 71006 (CLEARSTK 69575 . 70269) (HARDRESET 70271 . 70392) (RELSTK 70394 . 70592)
+ (RELSTKP 70594 . 71004)) (71007 82998 (SETUPSTACK 71017 . 72035) (\SETUPSTACK1 72037 . 73946) (
+\MAKEFRAME 73948 . 74301) (\RESETSTACK 74303 . 74606) (\RESETSTACK0 74608 . 77712) (\SETUPUSERSTACK 
+77714 . 79418) (\SETUPGUARDBLOCK 79420 . 79586) (\MAKEFREEBLOCK 79588 . 79827) (\REPEATEDLYEVALQT 
+79829 . 79960) (\DUMMYKEYHANDLER 79962 . 80264) (\DUMMYTELERAID 80266 . 80379) (\CAUSEINTERRUPT 80381
+ . 81429) (\CONTEXTAPPLY 81431 . 81643) (\INTERRUPTFRAME 81645 . 81839) (\INTERRUPTED 81841 . 82053) (
+\CODEFORTFRAME 82055 . 82311) (\DOMISCAPPLY 82313 . 82388) (\DOMISCAPPLY1 82390 . 82996)) (83212 
+101450 (\GATHER-CLEANUP-FORMS 83222 . 83598) (\GATHER-CLEANUP-FORMS1 83600 . 87229) (
+\GATHER-SPECIAL-BINDINGS 87231 . 90205) (\HARDRESET-CLEANUP 90207 . 94664) (\HARDRESET-CLEANUP1 94666
+ . 100999) (\HARDRESET-CLEANUP-RUN 101001 . 101448)) (101862 102914 (\DORETCALL 101872 . 102814) (
+\RETCALL 102816 . 102912)) (102982 103917 (\DOSTACKFULLINTERRUPT 102992 . 103200) (STACK.FULL.WARNING 
+103202 . 103570) (\CLEANUP.STACKFULL 103572 . 103915)))))
 STOP