Fix problems due to FX record incompatibly on SPY, miscompiled (#1561)

* Fix problems due to FX record incompatibly on SPY, miscompiled

* PROC recompile for safe measure

* Add ASTACK.LCOM, also needed recompile!

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/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/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