Minor compatibility adjustments

sources/CMLREAD

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Sep-2024 11:55:33" {DSK}<home>matt>Interlisp>medley>sources>CMLREAD.;4
 12882  
+
(FILECREATED "24-Apr-2025 21:59:48" {WMEDLEY}<sources>CMLREAD.;17
 12829  
 
-      :EDIT-BY "mth"
+      :EDIT-BY rmk
 
-      :CHANGES-TO (FNS CL:READ-FROM-STRING)
+      :CHANGES-TO (VARS CMLREADCOMS)
 
-      :PREVIOUS-DATE "16-Sep-2024 12:26:09" {DSK}<home>matt>Interlisp>medley>sources>CMLREAD.;3)
+      :PREVIOUS-DATE "23-Sep-2024 11:55:33" {WMEDLEY}<sources>CMLREAD.;16)
 
 
 (PRETTYCOMPRINT CMLREADCOMS)
@@ -37,7 +37,7 @@
               (INITVARS (*COMMON-LISP-READ-ENVIRONMENT* (create READER-ENVIRONMENT REPACKAGE _
                                                                (CL:FIND-PACKAGE "USER")
                                                                REREADTABLE _ CMLRDTBL REBASE _ 10 
-                                                               REFORMAT _ :XCCS]
+                                                               REFORMAT _ :MCCS]
         (PROP FILETYPE CMLREAD)
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
                (ADDVARS (NLAMA)
@@ -274,7 +274,7 @@
 )
 
 (RPAQ? *COMMON-LISP-READ-ENVIRONMENT*
 (create READER-ENVIRONMENT REPACKAGE _ (CL:FIND-PACKAGE "USER")
-                                             REREADTABLE _ CMLRDTBL REBASE _ 10 REFORMAT _ :XCCS))
+                                             REREADTABLE _ CMLRDTBL REBASE _ 10 REFORMAT _ :MCCS))
 
 (PUTPROPS CMLREAD
 FILETYPE
 CL:COMPILE-FILE)
 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
@@ -287,9 +287,9 @@
                      CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2433 3418 (CL:COPY-READTABLE 2443 . 3416)) (3419 10627 (CL:READ-LINE 3429 . 4301) (
-CL:READ-CHAR 4303 . 4853) (CL:UNREAD-CHAR 4855 . 5316) (CL:PEEK-CHAR 5318 . 7612) (CL:LISTEN 7614 . 
-7879) (CL:READ-CHAR-NO-HANG 7881 . 8653) (CL:CLEAR-INPUT 8655 . 8892) (CL:READ-FROM-STRING 8894 . 9914
-) (CL:READ-BYTE 9916 . 10369) (CL:WRITE-BYTE 10371 . 10625)) (11621 12094 (WITH-READER-ENVIRONMENT 
-11621 . 12094)))))
+  (FILEMAP (NIL (2380 3365 (CL:COPY-READTABLE 2390 . 3363)) (3366 10574 (CL:READ-LINE 3376 . 4248) (
+CL:READ-CHAR 4250 . 4800) (CL:UNREAD-CHAR 4802 . 5263) (CL:PEEK-CHAR 5265 . 7559) (CL:LISTEN 7561 . 
+7826) (CL:READ-CHAR-NO-HANG 7828 . 8600) (CL:CLEAR-INPUT 8602 . 8839) (CL:READ-FROM-STRING 8841 . 9861
+) (CL:READ-BYTE 9863 . 10316) (CL:WRITE-BYTE 10318 . 10572)) (11568 12041 (WITH-READER-ENVIRONMENT 
+11568 . 12041)))))
 STOP

sources/COMPILE

@@ -1,23 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "24-Sep-2023 13:59:34" {WMEDLEY}<sources>COMPILE.;5
 77344  
+
(FILECREATED "24-Apr-2025 22:04:20" {WMEDLEY}<sources>COMPILE.;6
 76628  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS COMPILECOMS)
-                  (FNS COMPSET)
+      :CHANGES-TO (FNS BCOMPL.BODY BRECOMPILE)
 
-      :PREVIOUS-DATE " 5-Jul-2021 13:46:39" {WMEDLEY}<sources>COMPILE.;4)
+      :PREVIOUS-DATE "24-Sep-2023 13:59:34" {WMEDLEY}<sources>COMPILE.;5)
 
 
-(* ; "
-Copyright (c) 1984-1990, 2021 by Venue & Xerox Corporation.
-The following program was created in 1984 but has not been published
-within the meaning of the copyright law, is furnished under license,
-and may not be used, copied and/or disclosed except in accordance
-with the terms of said license.
-")
-
 (PRETTYCOMPRINT COMPILECOMS)
 
 (RPAQQ COMPILECOMS

@@ -113,101 +104,102 @@ with the terms of said license.
                     CFILE NOBLOCKSFLG OPTIONSSET)))])
 
 (BCOMPL.BODY

-  [LAMBDA (STREAMS CFILE NOBLOCKSFLG OPTIONSSET)
        (* ; "Edited  5-Jul-2021 13:46 by rmk:")

+  [LAMBDA (STREAMS CFILE NOBLOCKSFLG OPTIONSSET)
             (* ; "Edited 24-Apr-2025 22:03 by rmk")


+                                                            (* ; "Edited  5-Jul-2021 13:46 by rmk:")

 
-(* ;;; "STREAMS is a list of streams.  Compile everything on them, dumping to CFILE (default first stream.dcom).  NOBLOCKSFLG means TCOMPL instead of BCOMPL.  OPTIONSSET is true if the Listing? question has already been asked.")

+(* ;;; "STREAMS is a list of streams.  Compile everything on them, dumping to CFILE (default first stream.dcom).  NOBLOCKSFLG means TCOMPL instead of BCOMPL.  OPTIONSSET is true if the Listing? question has already been asked.")

 
-(* ;;; "RMK:  Apply each input streams \EXTERNALFORMAT")

+(* ;;; "RMK:  Apply each input streams \EXTERNALFORMAT")

 
     (DECLARE
 (SPECVARS
 CFILE))
     (PROG ((SPECVARS
 T)
            (LOCALVARS
 SYSLOCALVARS)
            DEFS CHANGES OTHERS FIRST BLOCKS BLKFNS FILEROOT TEM SCRATCHFILE DESTINATIONENV UNPACKFILE
            )
-          (DECLARE
 (SPECVARS
 SPECVARS LOCALVARS CHANGES OTHERS FIRST BLOCKS BLKFNS 
-                              DESTINATIONENV DEFS))
+          (DECLARE
 (SPECVARS
 SPECVARS LOCALVARS CHANGES OTHERS FIRST BLOCKS BLKFNS DESTINATIONENV 
+                          DEFS))
           [OR OPTIONSSET (COMPSET
 NIL '(F %
-]                                                            (* ; 
-
"OPTIONSSET is T on calls from TCOMPL.  In this case, the first COMPSET has already been performed.")

+]                                                            (* ; 
+
 "OPTIONSSET is T on calls from TCOMPL.  In this case, the first COMPSET has already been performed.")

           (COMPSET
 (OR CFILE (PACKFILENAME 'HOST [CADR (FMEMB 'HOST (SETQ UNPACKFILE
-                                                                         (UNPACKFILENAME (CAR STREAMS
-                                                                                              ]
-                                        'DIRECTORY
-                                        (CADR (FMEMB 'DIRECTORY UNPACKFILE))
-                                        'NAME
-                                        (SETQ FILEROOT (CADR (FMEMB 'NAME UNPACKFILE)))
-                                        'EXTENSION COMPILE.EXT)))
+                                                                     (UNPACKFILENAME (CAR STREAMS]
+                                    'DIRECTORY
+                                    (CADR (FMEMB 'DIRECTORY UNPACKFILE))
+                                    'NAME
+                                    (SETQ FILEROOT (CADR (FMEMB 'NAME UNPACKFILE)))
+                                    'EXTENSION COMPILE.EXT)))
 
-     (* ;; "Edited by TT(8-June-90 : for Fix AR#2999)")

+     (* ;; "Edited by TT(8-June-90 : for Fix AR#2999)")

 
           [COND
              (LCFIL (SETQ SCRATCHFILE (OPENSTREAM BCOMPL.SCRATCH 'BOTH 'NEW]
           (RESETSAVE NIL (LIST 'BCOMPL3 NIL STREAMS SCRATCHFILE))
 
-     (* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when bcompl finishes, or control-d or control-e occurs.")

+     (* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when bcompl finishes, or control-d or control-e occurs.")

 
           [LET (DFNFLG)
 
-               (* ;; "if top level value of DFNFLG is PROP, still want to evaluate expressions in declarations etc as though it were T.  i.e. make BCOMPL1A equivalent to doing a LOADCOMP")

+               (* ;; "if top level value of DFNFLG is PROP, still want to evaluate expressions in declarations etc as though it were T.  i.e. make BCOMPL1A equivalent to doing a LOADCOMP")

 
                (for
 STREAM in
 STREAMS
                   do
 (RESETLST
-                             (RESETSAVE NIL (LIST 'CLOSEF STREAM))
-                             (RESETSAVE (INPUT STREAM))      (* ; 
-
                            "Needs to be primary input for some of the filepkg expressions to work")

-                             (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT*
-                                 (until
 (OR (NULL (SETQ TEM (READ STREAM)))
-                                                (EQ TEM 'STOP))
-                                    do
 (CL:WHEN (EQ (CAR (LISTP TEM))
-                                                        'DEFINE-FILE-INFO)
-                                               (\EXTERNALFORMAT STREAM (OR (LISTGET (CDR TEM)
-                                                                                  :FORMAT)
-                                                                           :XCCS)))
-                                          (BCOMPL1A
 TEM 'DEFAULT 'DEFAULT 'DEFAULT STREAM))))]
+                         (RESETSAVE NIL (LIST 'CLOSEF STREAM))
+                         (RESETSAVE (INPUT STREAM))          (* ; 
+
                              "Needs to be primary input for some of the filepkg expressions to work")

+                         (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT*
+                             (until
 (OR (NULL (SETQ TEM (READ STREAM)))
+                                        (EQ TEM 'STOP))
+                                do
 (CL:WHEN (EQ (CAR (LISTP TEM))
+                                                'DEFINE-FILE-INFO)
+                                       (\EXTERNALFORMAT STREAM (OR (LISTGET (CDR TEM)
+                                                                          :FORMAT)
+                                                                   :MCCS)))
+                                   (BCOMPL1A
 TEM 'DEFAULT 'DEFAULT 'DEFAULT STREAM))))]
           (SETQ NOFIXFNSLST (APPEND NLAMA NLAML LAMS (NCONC [MAPCAR DEFS (FUNCTION (LAMBDA (X)
                                                                                      (RCOMP3

                                                                                       (CAR X)
                                                                                       (CADR X]
                                                             NOFIXFNSLST)))
 
-     (* ;; "The BCOMPL1 reads in FILES.  It returns a list of variables set in the files.  The RCOMP3 adds function to NLAMA, LAMS, etc., and returns a list of functions.  NOFIXFNLST is reset in case there is any dwimifying to be done.")

+     (* ;; "The BCOMPL1 reads in FILES.  It returns a list of variables set in the files.  The RCOMP3 adds function to NLAMA, LAMS, etc., and returns a list of functions.  NOFIXFNLST is reset in case there is any dwimifying to be done.")

 
           (WITH-READER-ENVIRONMENT (OR DESTINATIONENV (SETQ DESTINATIONENV 
                                                        *OLD-INTERLISP-READ-ENVIRONMENT*))
               (COND
-                 (LCFIL (\EXTERNALFORMAT LCFIL (OR (FETCH
 (READER-ENVIRONMENT REFORMAT)
-                                                      OF
 DESTINATIONENV)
-                                                   :XCCS))
+                 (LCFIL (\EXTERNALFORMAT LCFIL (OR (FETCH
 (READER-ENVIRONMENT REFORMAT) OF
 
+                                                                                       DESTINATIONENV
+                                                          )
+                                                   :MCSS))
                         (PRINT-COMPILE-HEADER
 STREAMS [LIST (COND
-                                                                   (NOBLOCKSFLG 'tcompl'd)
-                                                                   (T 'bcompl'd]
+                                                               (NOBLOCKSFLG 'tcompl'd)
+                                                               (T 'bcompl'd]
                                DESTINATIONENV)))
               (COND
                  (SCRATCHFILE 
 
-                        (* ;; "writes others on a scratchfile so space can be freed up.  will be copied onto lcfil aftr compilation.")

+                        (* ;; "writes others on a scratchfile so space can be freed up.  will be copied onto lcfil aftr compilation.")

 
                         (\EXTERNALFORMAT SCRATCHFILE (\EXTERNALFORMAT LCFIL))
                         (for
 X in
 OTHERS do
 (PRINT X SCRATCHFILE))
                         (PRINT NIL SCRATCHFILE)
                         (SETQ OTHERS NIL)))
               [OR DWIMIFYCOMPFLG (SETQ DWIMIFYCOMPFLG (EQMEMB 'CLISP (GETPROP FILEROOT 'FILETYPE]
-                                                             (* ; 
-
                                     "The FILETYPE may have been set during the course of BCOMPL1.")

+                                                             (* ; 
+
                                       "The FILETYPE may have been set during the course of BCOMPL1.")

               [MAPC FIRST (FUNCTION (LAMBDA (X)
                                       (PRINT X LCFIL]
               [PROG (LISPXHIST)
                     (DECLARE
 (SPECVARS
 LISPXHIST))
 
-               (* ;; "compile blocks MAPC not used because BCOMPL2 checks BLOCKS.  lispxhist rebound bcause no need to save information when compiling from file")

+               (* ;; "compile blocks MAPC not used because BCOMPL2 checks BLOCKS.  lispxhist rebound bcause no need to save information when compiling from file")

 
                     (AND NOBLOCKSFLG (GO NOBLOCKLP))
                 BLOCKLP
                     (COND
                        (BLOCKS (BCOMPL2
 (CAR BLOCKS))
                               (SETQ BLOCKS (CDR BLOCKS))
-                              (GO BLOCKLP)))                 (* ; 
-
  "COMPILE other functions.  done this way instead of MAPC to release the defs as soon aspossible.")

+                              (GO BLOCKLP)))                 (* ; 
+
    "COMPILE other functions.  done this way instead of MAPC to release the defs as soon aspossible.")

                 NOBLOCKLP
                     (COND
                        (DEFS (AND (NOT (FMEMB (CAAR DEFS)
@@ -499,17 +491,18 @@ with the terms of said license.
     (SETQ BLOCKS (NCONC1 BLOCKS X))))
 
 (BRECOMPILE

-  [LAMBDA (FILES CFILE FNS NOBLOCKSFLG)
                 (* ; "Edited  5-Jul-2021 09:28 by rmk:")

+  [LAMBDA (FILES CFILE FNS NOBLOCKSFLG)
                      (* ; "Edited 24-Apr-2025 22:04 by rmk")


+                                                            (* ; "Edited  5-Jul-2021 09:28 by rmk:")

 
-(* ;;; "FNS is a list of functions to be recompiled.  The object is to make a file that looks exactly like that produced by BCOMPL except to greatly reduce the work by copying from CFILE the compiled definitions those functions not being recompiled.")

+(* ;;; "FNS is a list of functions to be recompiled.  The object is to make a file that looks exactly like that produced by BCOMPL except to greatly reduce the work by copying from CFILE the compiled definitions those functions not being recompiled.")

 
-(* ;;; "BRECOMPILE is driven by the source file(s).  The algorithm is whenever a DEFINEQ is encountered, process all of the functions in the DEFINEQ as follows: COMPILE the definition of the function if it is on the list FNS, or if FNS is EXPRS and the function is currently defined as an EXPR.  Otherwise copy its compiled definition from CFILE.  Note that functions with compiled definitions in CFILE that do not appear in PFILE are NOT copied.  This corresponds to the case where functions have been deleted from the source file.")

+(* ;;; "BRECOMPILE is driven by the source file(s).  The algorithm is whenever a DEFINEQ is encountered, process all of the functions in the DEFINEQ as follows: COMPILE the definition of the function if it is on the list FNS, or if FNS is EXPRS and the function is currently defined as an EXPR.  Otherwise copy its compiled definition from CFILE.  Note that functions with compiled definitions in CFILE that do not appear in PFILE are NOT copied.  This corresponds to the case where functions have been deleted from the source file.")

 
-(* ;;; "The value FNS = CHANGES means recompile anything marked changed in the file header.")

+(* ;;; "The value FNS = CHANGES means recompile anything marked changed in the file header.")

 
-(* ;;; "(RECOMPILE file cfile fns) is equivalent to (BRECOMPILE file cfile fns T).")

+(* ;;; "(RECOMPILE file cfile fns) is equivalent to (BRECOMPILE file cfile fns T).")

 
-(* ;;; "Note that CFILE=NIL is interpreted as meaning file.dcom even when FNS supplied.")

+(* ;;; "Note that CFILE=NIL is interpreted as meaning file.dcom even when FNS supplied.")

 
     (RESETLST
         (PROG ((*PRINT-ARRAY* T)
@@ -529,10 +522,10 @@ with the terms of said license.
                (AUXFILECOM T)
                CHANGES OTHERS FIRST FILEMAPLST FNLST BLKFNS BLOCKS FILE FILE.COM TEM ADRLST 
                SCRATCHFILE COREOK DESTINATIONENV MSG)
-              (DECLARE
 (SPECVARS
 *PRINT-ARRAY* *PRINT-LENGTH* *PRINT-LEVEL* NLAMA NLAML LAMS
-                                  LAMA DWIMIFYCOMPFLG EXPRSLST NOFIXFNSLST NOFIXVARSLST BUILDMAPFLG 
-                                  SPECVARS LOCALVARS CHANGES OTHERS FIRST BLKFNS BLOCKS 
-                                  DESTINATIONENV ADRLST FILEMAPLST CFILE FNS FILE))
+              (DECLARE
 (SPECVARS
 *PRINT-ARRAY* *PRINT-LENGTH* *PRINT-LEVEL* NLAMA NLAML LAMS LAMA 
+                              DWIMIFYCOMPFLG EXPRSLST NOFIXFNSLST NOFIXVARSLST BUILDMAPFLG SPECVARS 
+                              LOCALVARS CHANGES OTHERS FIRST BLKFNS BLOCKS DESTINATIONENV ADRLST 
+                              FILEMAPLST CFILE FNS FILE))
               (COND
                  ((AND (NULL CFILE)
                        (NULL FNS))
@@ -551,7 +544,7 @@ with the terms of said license.
                                     (SETQ FILE (CADR (FMEMB 'NAME FILE)))
                                     'EXTENSION COMPILE.EXT))
 
-         (* ;; "Edited by TT (8-June-90 : for fix AR#2999)")

+         (* ;; "Edited by TT (8-June-90 : for fix AR#2999)")

 
               (COND
                  ((EQ FNS 'ALL)
@@ -572,7 +565,7 @@ with the terms of said license.
                                     ((OR (NULL ENV)
                                          (NOT (EQUAL-READER-ENVIRONMENT ENV DESTINATIONENV)))
                                      T)
-                                    (T                       (* "Position cfile back to start")

+                                    (T                       (* "Position cfile back to start")

                                        (SETFILEPTR CFILE START)
                                        NIL]
                       (SETQ TEM (CLOSEF CFILE))
@@ -587,14 +580,14 @@ with the terms of said license.
                                                      "not found;" " compile all functions on "
                                                      (FULLNAME (CAR FILES))
                                                      '"instead"))
-                          'Y))                               (* ; 
-
                                                        "Edited by TT(8-June-90 : for Fix AR#8017)")

+                          'Y))                               (* ; 
+
                                                          "Edited by TT(8-June-90 : for Fix AR#8017)")

                   (GO BRECALL))
                  ((EQ [ASKUSER DWIMWAIT 'Y (CONS '"Just forget about compiling"
                                                  (MAPCAR FILES (FUNCTION FULLNAME]
                       'Y)
                   (SELECTQ (CAR READBUF)
-                      ((ST F STF)                            (* "E.g. From CLEANUP.")

+                      ((ST F STF)                            (* "E.g. From CLEANUP.")

                            (SETQ READBUF (CDR READBUF)))
                       NIL)
                   (RETFROM 'BRECOMPILE))
@@ -613,117 +606,109 @@ with the terms of said license.
               (SETQ SCRATCHFILE (OPENSTREAM BCOMPL.SCRATCH 'BOTH 'NEW))
               (RESETSAVE NIL (LIST 'BCOMPL3 CFILE FILES SCRATCHFILE))
 
-         (* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when brecompile finishes, or control-d or control-e occurs.  Note that this call differs from the call for bcompl in that cfile is also specified.  this corresponds to the fact that recompile has an extra file open.")

+         (* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when brecompile finishes, or control-d or control-e occurs.  Note that this call differs from the call for bcompl in that cfile is also specified.  this corresponds to the fact that recompile has an extra file open.")

 
-              [SETQ COREOK (for
 X in
 FILES
-                              always
 (AND (EQ (CDAR (GETPROP (SETQ TEM (ROOTFILENAME X))
-                                                               'FILEDATES))
-                                                  X)
-                                              (FMEMB (CDAR (GETPROP TEM 'FILE))
-                                                     '(LOADFNS T]
+              [SETQ COREOK (for
 X in
 FILES always
 (AND (EQ (CDAR (GETPROP (SETQ TEM (ROOTFILENAME
+                                                                                     X))
+                                                                        'FILEDATES))
+                                                           X)
+                                                       (FMEMB (CDAR (GETPROP TEM 'FILE))
+                                                              '(LOADFNS T]
               [SETQ FILEMAPLST
                (for
 STREAM in
 FILES
                   collect
 (LET ((LDFLG 'EXPRESSIONS)
-                                    (VARLST 'COMPILING)
-                                    DONELST FNLST)
-                                   (DECLARE
 (SPECVARS
 LDFLG VARLST DONELST FNLST))
-                                                             (* ; 
-
                                                           "FNLST etc are used free in LOADFNSCAN")

-                                   (SETFILEPTR STREAM 0)
-                                   (INPUT STREAM)
+                                (VARLST 'COMPILING)
+                                DONELST FNLST)
+                               (DECLARE
 (SPECVARS
 LDFLG VARLST DONELST FNLST))
+                                                             (* ; 
+
                                                             "FNLST etc are used free in LOADFNSCAN")

+                               (SETFILEPTR STREAM 0)
+                               (INPUT STREAM)
 
-                                 (* ;; "LOADFNSCAN scans the file, building a map if one not already there.  Value is the map.  In addition, sets DONELST to a list of all non-defineq expressions.")

+                               (* ;; "LOADFNSCAN scans the file, building a map if one not already there.  Value is the map.  In addition, sets DONELST to a list of all non-defineq expressions.")

 
-                                   (CL:MULTIPLE-VALUE-BIND (ENV MAP FILECREATEDLOC)
-                                          (GET-ENVIRONMENT-AND-FILEMAP STREAM)
-                                          (DECLARE
 (CL:SPECIAL FILECREATEDLOC))
-                                                             (* ; " used by LOADFNSCAN")

-                                          (WITH-READER-ENVIRONMENT ENV
-                                              (create
 COMPFILEDESCR
-                                                     COMPFILESTREAM _ STREAM
-                                                     COMPFILEENV _ ENV
-                                                     COMPFILEMAP _ (LOADFNSCAN MAP)
-                                                     COMPFILEXPRS _ (DREVERSE DONELST)))]
+                               (CL:MULTIPLE-VALUE-BIND (ENV MAP FILECREATEDLOC)
+                                      (GET-ENVIRONMENT-AND-FILEMAP STREAM)
+                                      (DECLARE
 (CL:SPECIAL FILECREATEDLOC))
+                                                             (* ; " used by LOADFNSCAN")

+                                      (WITH-READER-ENVIRONMENT ENV
+                                          (create
 COMPFILEDESCR
+                                                 COMPFILESTREAM _ STREAM
+                                                 COMPFILEENV _ ENV
+                                                 COMPFILEMAP _ (LOADFNSCAN MAP)
+                                                 COMPFILEXPRS _ (DREVERSE DONELST)))]
               [SETQ FNLST (for
 DESCR in
 FILEMAPLST
                              join
 (for
 DEFQ in
 (CDR (fetch
 COMPFILEMAP of
 DESCR))
-                                         join
 (for
 X in
 (CDDR DEFQ)
-                                                     collect
 (CAR X]
+                                     join
 (for
 X in
 (CDDR DEFQ) collect
 (CAR X]
 
-         (* ;; "FILEMAPLST is a list of information about each file, including its name, filemap and non-defineq expressions. The first entry on the filemap is NIL.  We start mapping down CDR of the filemap, and each element therein corresponds to a single DEFINEQ, in the form (start stop . fnEntries).  fnEntries is a list of (FN start . stop), so the inner MAPCAR gathers up the names of the functions.  The reason for not asking LOADFNS to do this is in most cases the map will already have been built, so LOADFNS won't even go inside of the defineq.")

+         (* ;; "FILEMAPLST is a list of information about each file, including its name, filemap and non-defineq expressions. The first entry on the filemap is NIL.  We start mapping down CDR of the filemap, and each element therein corresponds to a single DEFINEQ, in the form (start stop . fnEntries).  fnEntries is a list of (FN start . stop), so the inner MAPCAR gathers up the names of the functions.  The reason for not asking LOADFNS to do this is in most cases the map will already have been built, so LOADFNS won't even go inside of the defineq.")

 
-              [for
 DESCR in
 FILEMAPLST do
 (for
 FORM
-                                                         in
 (fetch
 COMPFILEXPRS of
 DESCR)
-                                                         do
 (BCOMPL1A
 FORM 'DEFAULT
-                                                                       'DEFAULT
-                                                                       'DEFAULT]
+              [for
 DESCR in
 FILEMAPLST do
 (for
 FORM in
 (fetch
 COMPFILEXPRS of
 DESCR)
+                                             do
 (BCOMPL1A
 FORM 'DEFAULT 'DEFAULT 'DEFAULT]
 
-         (* ;; "BCOMPL1A adds VARS set in the files to NOFIXVARSLST.  NOFIXFNLST and NOFIXVARSLST are reset in case there is any dwimifying to be done BCOMPL1 also sets free variable OTHERS to list of expressions to be printed on compiled file when all is done.")

+         (* ;; "BCOMPL1A adds VARS set in the files to NOFIXVARSLST.  NOFIXFNLST and NOFIXVARSLST are reset in case there is any dwimifying to be done BCOMPL1 also sets free variable OTHERS to list of expressions to be printed on compiled file when all is done.")

 
               (SETQ NOFIXFNSLST (APPEND NLAMA NLAML LAMS FNLST NOFIXFNSLST))
-              (WITH-READER-ENVIRONMENT (SETQ DESTINATIONENV (fetch
 COMPFILEENV
-                                                               of
 (CAR FILEMAPLST)))
-                                                             (* ; 
-
"Start writing the compiled file.  Use environment of one of the source files--usually the only one")

+              (WITH-READER-ENVIRONMENT (SETQ DESTINATIONENV (fetch
 COMPFILEENV of
 (CAR FILEMAPLST)))
+                                                             (* ; 
+
 "Start writing the compiled file.  Use environment of one of the source files--usually the only one")

                   (if
 LCFIL
                       then
 (\EXTERNALFORMAT LCFIL (OR (LISTGET DESTINATIONENV :FORMAT)
-                                                          :XCCS))
-                            (PRINT-COMPILE-HEADER

-                             FILES
-                             [CONS (if
 NOBLOCKSFLG
-                                       then
 'recompiled
-                                     else
 'brecompiled)
-                                   (if
 (EQ FNS 'ALL)
-                                       then
 (LIST 'ALL)
-                                     else
 (CONS (SELECTQ FNS
-                                                        (CHANGES 'changes%:)
-                                                        ((EXPRS T) 
-                                                             'exprs%:)
-                                                        'explicitly%:)
-                                                    (OR [SUBSET FNLST (FUNCTION (LAMBDA (X)
-                                                                                  (RECOMP?
 X FNS]
-                                                        (LIST 'nothing]
-                             DESTINATIONENV))
+                                                      :MCCS))
+                           (PRINT-COMPILE-HEADER

+                            FILES
+                            [CONS (if
 NOBLOCKSFLG
+                                      then
 'recompiled
+                                    else
 'brecompiled)
+                                  (if
 (EQ FNS 'ALL)
+                                      then
 (LIST 'ALL)
+                                    else
 (CONS (SELECTQ FNS
+                                                   (CHANGES 'changes%:)
+                                                   ((EXPRS T) 
+                                                        'exprs%:)
+                                                   'explicitly%:)
+                                               (OR [SUBSET FNLST (FUNCTION (LAMBDA (X)
+                                                                             (RECOMP?
 X FNS]
+                                                   (LIST 'nothing]
+                            DESTINATIONENV))
                   [MAPC FNLST (FUNCTION (LAMBDA (X)
                                           (RCOMP3
 X (VIRGINFN X]
                   (if
 SCRATCHFILE
                       then
 
+                           (* ;; "writes others on a scratchfile so space can be freed up.  will be copied onto lcfil aftr compilation.")

 
-                            (* ;; "writes others on a scratchfile so space can be freed up.  will be copied onto lcfil aftr compilation.")

-
-                            (\EXTERNALFORMAT SCRATCHFILE (\EXTERNALFORMAT LCFIL))
-                            (for
 X in
 OTHERS do
 (PRINT X SCRATCHFILE))
-                            (PRINT NIL SCRATCHFILE)
-                            (SETQ OTHERS NIL))
+                           (\EXTERNALFORMAT SCRATCHFILE (\EXTERNALFORMAT LCFIL))
+                           (for
 X in
 OTHERS do
 (PRINT X SCRATCHFILE))
+                           (PRINT NIL SCRATCHFILE)
+                           (SETQ OTHERS NIL))
                   (for
 X in
 (PROGN FIRST) do
 (PRINT X LCFIL))
                   [OR DWIMIFYCOMPFLG (SETQ DWIMIFYCOMPFLG (EQMEMB 'CLISP (GETPROP FILE 'FILETYPE]
                   (OR (EQ FNS 'ALL)
                       (INPUT CFILE))
                   [if
 (NOT NOBLOCKSFLG)
                       then
 (for
 BLOCK in
 BLOCKS
-                                  do
 (if
 (NULL (CAR BLOCK))
-                                             then
 (BCOMPL2
 BLOCK FILEMAPLST)
-                                           elseif
 (for
 X in
 BLOCK
-                                                         thereis
 (AND (LITATOM X)
-                                                                          (RECOMP?
 X FNS)))
-                                             then
        (* ; 
-
            "If any function in the BLOCK is to be recompiled, the whole BLOCK must be recompiled.")

-                                                   (BCOMPL2
 BLOCK FILEMAPLST COREOK)
-                                           else
 (BRECOMPILE1
 BLOCK]
+                              do
 (if
 (NULL (CAR BLOCK))
+                                     then
 (BCOMPL2
 BLOCK FILEMAPLST)
+                                   elseif
 (for
 X in
 BLOCK thereis
 (AND (LITATOM X)
+                                                                       (RECOMP?
 X FNS)))
+                                     then
                    (* ; 
+
              "If any function in the BLOCK is to be recompiled, the whole BLOCK must be recompiled.")

+                                          (BCOMPL2
 BLOCK FILEMAPLST COREOK)
+                                   else
 (BRECOMPILE1
 BLOCK]
 
-                  (* ;; "NOBLOCKSFLG is T for calls from RECOMPILE.  In this case, even if there were any blocks, ignore them.")

-                                                             (* ; "Now COMPILE rest of functions.")

-                  (for
 X in
 FNLST
-                     do
 (if
 (OR (FMEMB X BLKFNS)
-                                        (FMEMB X DONTCOMPILEFNS))
-                              elseif
 (RECOMP?
 X FNS)
-                                then
 
+                  (* ;; "NOBLOCKSFLG is T for calls from RECOMPILE.  In this case, even if there were any blocks, ignore them.")

+                                                             (* ; "Now COMPILE rest of functions.")

+                  (for
 X in
 FNLST do
 (if
 (OR (FMEMB X BLKFNS)
+                                             (FMEMB X DONTCOMPILEFNS))
+                                       elseif
 (RECOMP?
 X FNS)
+                                         then
 
 
-                                 (* ;; "The HELP is bcause if X is on FNS, then it follows X is in the file map, and brecompile3 should be able to produce its definition.")

+                                 (* ;; "The HELP is bcause if X is on FNS, then it follows X is in the file map, and brecompile3 should be able to produce its definition.")

 
-                                      (COMPILE1
 X (CADR (SETQ TEM (BRECOMPILE3
 X FILEMAPLST 
-                                                                             COREOK)))
-                                             (CADDR TEM))
-                              else
 (BRECOMPILE1
 X T))))
+                                              (COMPILE1
 X (CADR (SETQ TEM (BRECOMPILE3
 X FILEMAPLST 
+                                                                                 COREOK)))
+                                                     (CADDR TEM))
+                                       else
 (BRECOMPILE1
 X T))))
               (RETURN (FULLNAME LCFIL))
           NONRAND
               (SETQ MSG " is not RANDACCESSP")
@@ -1532,16 +1517,15 @@ with the terms of said license.
 
 (ADDTOVAR LAMA
 )
 )
-(PUTPROPS COMPILE COPYRIGHT ("Venue & Xerox Corporation" T 1984 1985 1986 1987 1988 1989 1990 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3708 73744 (BCOMPL 3718 . 5368) (BCOMPL.BODY 5370 . 11949) (PRINT-COMPILE-HEADER 11951
- . 13014) (RESETOPENFILES 13016 . 13369) (BCOMPL1A 13371 . 19384) (BCOMPL2 19386 . 26201) (BCOMPL3 
-26203 . 27552) (BLOCK%: 27554 . 28186) (BRECOMPILE 28188 . 43177) (BRECOMPILE1 43179 . 49031) (
-BRECOMPILE2 49033 . 49835) (BRECOMPILE3 49837 . 51213) (BLOCKCOMPILE 51215 . 53075) (BLOCKCOMPILE1 
-53077 . 58162) (COMPSET 58164 . 60861) (COMPSETREAD 60863 . 62174) (COMPSETY 62176 . 62300) (COMPSETF 
-62302 . 62468) (RCOMP3 62470 . 64177) (TCOMPL 64179 . 64478) (RECOMPILE 64480 . 64563) (RECOMP? 64565
- . 65025) (COMPILE 65027 . 67016) (COMPILE1 67018 . 67606) (COMPILE1A 67608 . 69255) (
-SHOULD-BE-DWIMIFIED? 69257 . 69946) (COMPEM 69948 . 70672) (GETCFILE 70674 . 72405) (SPECVARS 72407 . 
-72962) (LOCALVARS 72964 . 73538) (GLOBALVARS 73540 . 73742)) (76094 77043 (COMPILEMODE 76104 . 77041))
+  (FILEMAP (NIL (3379 73129 (BCOMPL 3389 . 5039) (BCOMPL.BODY 5041 . 11639) (PRINT-COMPILE-HEADER 11641
+ . 12704) (RESETOPENFILES 12706 . 13059) (BCOMPL1A 13061 . 19074) (BCOMPL2 19076 . 25891) (BCOMPL3 
+25893 . 27242) (BLOCK%: 27244 . 27876) (BRECOMPILE 27878 . 42562) (BRECOMPILE1 42564 . 48416) (
+BRECOMPILE2 48418 . 49220) (BRECOMPILE3 49222 . 50598) (BLOCKCOMPILE 50600 . 52460) (BLOCKCOMPILE1 
+52462 . 57547) (COMPSET 57549 . 60246) (COMPSETREAD 60248 . 61559) (COMPSETY 61561 . 61685) (COMPSETF 
+61687 . 61853) (RCOMP3 61855 . 63562) (TCOMPL 63564 . 63863) (RECOMPILE 63865 . 63948) (RECOMP? 63950
+ . 64410) (COMPILE 64412 . 66401) (COMPILE1 66403 . 66991) (COMPILE1A 66993 . 68640) (
+SHOULD-BE-DWIMIFIED? 68642 . 69331) (COMPEM 69333 . 70057) (GETCFILE 70059 . 71790) (SPECVARS 71792 . 
+72347) (LOCALVARS 72349 . 72923) (GLOBALVARS 72925 . 73127)) (75479 76428 (COMPILEMODE 75489 . 76426))
 )))
 STOP

sources/IOCHAR

@@ -1,15 +1,16 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "11-Sep-2022 20:07:43" {DSK}<home>larry>medley>sources>IOCHAR.;2
 100127 
+
(FILECREATED "24-Aug-2025 11:45:37" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>IOCHAR.;49
 100320 
 
-      :CHANGES-TO (VARS IOCHARCOMS)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "24-Jul-2022 14:56:20" {DSK}<home>larry>medley>sources>IOCHAR.;1)
+      :CHANGES-TO (RESOURCES \FFDELTA1)
+                  (FNS MAKEBITTABLE \SETUP.FFILEPOS)
 
+      :PREVIOUS-DATE "24-Apr-2025 22:08:18" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>IOCHAR.;48)
 
-(* ; "
-Copyright (c) 1981-1988, 1990-1991, 2018, 2020 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT IOCHARCOMS)
 
@@ -203,17 +204,18 @@ Copyright (c) 1981-1988, 1990-1991, 2018, 2020 by Venue & Xerox Corporation.
 )
 
 (MAKEBITTABLE

-  [LAMBDA (L NEG A)
                                      (* ; "Edited 29-Apr-91 23:02 by jds")

+  [LAMBDA (L NEG A)
                                          (* ; "Edited 24-Aug-2025 11:45 by rmk")


+                                                             (* ; "Edited 29-Apr-91 23:02 by jds")

     [COND
-       [(type?
 CHARTABLE A)                              (* ; "Clear it")

+       [(type?
 CHARTABLE A)                                  (* ; "Clear it")

         (\ZEROBYTES A 0 \MAXTHINCHAR)
         (if
 (fetch
 (CHARTABLE NSCHARHASH) of
 A)
             then
 (CLRHASH (fetch
 (CHARTABLE NSCHARHASH) of
 A]
        (T (SETQ A (create
 CHARTABLE]
     (for
 X in
 L do
 (\SETSYNCODE A (OR (SMALLP X)
-                                                  (CHCON1 X))
-                                      1))                    (* ; "Invert 1 and 0 if NEG")

-    [AND NEG (for
 I from
 0 to
 \MAXCHAR do
 (\SETSYNCODE A I (LOGXOR 1 (\SYNCODE A I]
+                                      (CHCON1 X))
+                          1))                                (* ; "Invert 1 and 0 if NEG")

+    [AND NEG (for
 I from
 0 to
 \MAXTHINCHAR do
 (\SETSYNCODE A I (LOGXOR 1 (\SYNCODE A I]
     A])
 )
 (DECLARE%: DONTCOPY 
@@ -258,13 +260,15 @@ DONTCOPY
 (FILEPOS

   [LAMBDA (PATTERN FILE START END SKIP TAIL CASEARRAY)
 
+    (* ;; "Edited 24-Apr-2025 22:08 by rmk")

+
     (* ;; "Edited 10-Jul-2022 16:51 by rmk")

 
     (* ;; "Edited  1-Jul-2022 11:55 by rmk")

 
     (* ;; "Edited 25-Jun-2022 22:51 by rmk: The original version was a byte-level searcher, this upgrades to character searching as determined by the external format of the stream. (It is also a bit faster than the original).")

 
-    (* ;; "This provides accurate results if the stream's external format is stable, wherein each character code has a unique byte representation.  If the stream's format is unstable (i.e. XCCS runcoding), then the result is accurate if the stream's initial charset (or other contextual information) is correct for the START byte position.")

+    (* ;; "This provides accurate results if the stream's external format is stable, wherein each character code has a unique byte representation.  If the stream's format is unstable (i.e. MCCS runcoding), then the result is accurate if the stream's initial charset (or other contextual information) is correct for the START byte position.")

 
     (* ;; "Otherwise, there may be some bad matches and some missing matches.  The slow case will be accurate in those cases (and a NIL return for the format's \FORMATBYTESTRING function will kick it into the slow case (about 10 times slower).  This always defers to the slow case if SKIP or CASEARRAY are non-NIL.")

 
@@ -382,7 +386,7 @@ DONTCOPY
 
      (* ;; "Getting the character set for the start of the match is a little trickier.  We know the character set at the byte that starts the beginning of the match (= character set of PATTERN's first character.  If we set the stream to that charset, then back up one character, that should get it right.  ")

 
-     (* ;; "This should  only be necessary for an unstable format, maybe don't bother if it isn't XCCS. There is another special case here for XCCS:  if the charset is 255 at the start (=2 byte encoding), then we assume that it didn't change, and nothing to worry about.")

+     (* ;; "This should  only be necessary for an unstable format, maybe don't bother if it isn't XCCS. There is another special case here for MCCS:  if the charset is 255 at the start (=2 byte encoding), then we assume that it didn't change, and nothing to worry about.")

 
           (RETURN (IF
 TAIL
                       THEN
 (CL:UNLESS (EQ NSCHARSETSHIFT (ffetch
 (STREAM CHARSET) of
 STREAM))
@@ -412,6 +416,8 @@ DONTCOPY
 (FFILEPOS

   [LAMBDA (PATTERN FILE START END SKIP TAIL CASEARRAY)
 
+    (* ;; "Edited 24-Apr-2025 22:07 by rmk")

+
     (* ;; "Edited 10-Jul-2022 10:17 by rmk")

 
     (* ;; "Edited  1-Jul-2022 11:55 by rmk")

@@ -420,7 +426,7 @@ DONTCOPY
 
     (* ;; "Edited 10-Aug-2020 21:44 by rmk:")

 
-    (* ;; "RMK:  Added coercion from internal XCCS string to UTF8 if searching a UTF8 file")

+    (* ;; "RMK:  Added coercion from internal MCCS string to UTF8 if searching a UTF8 file")

                                                              (* Pavel "12-Oct-86 15:20")

     (PROG ((STREAM (\GETSTREAM FILE 'INPUT))
            BYTEPATTERN BPATBASE BPATOFFSET BPATLEN ORGFILEPTR STARTBYTEPOS ENDBYTEPOS BIGENDOFFSET 
@@ -587,6 +593,8 @@ DONTCOPY
 (\SETUP.FFILEPOS

   [LAMBDA (PATBASE PATOFFSET PATLEN PATCHAR DELTA1 DELTA2)
 
+    (* ;; "Edited 24-Aug-2025 11:45 by rmk")

+
     (* ;; "Edited 24-Jun-2022 16:32 by rmk: Removing CASE argument.  That forces the \SLOWFILEPOS, because the the alternative stream matches can't be anticipated.")

                                                              (* jop%: "25-Sep-86 11:44")

 
@@ -596,7 +604,7 @@ DONTCOPY
                                  PATLEN))
            (MAXPATINDEX (SUB1 PATLEN))
            CHAR)
-          (for
 I from
 0 to
 (FOLDLO \MAXCHAR BYTESPERWORD) do
 (PUTBASE DELTA1 I PATLEN,PATLEN))
+          (for
 I from
 0 to
 (FOLDLO \MAXTHINCHAR BYTESPERWORD) do
 (PUTBASE DELTA1 I PATLEN,PATLEN))
 
      (* ;; "DELTA1 initially all PATLEN, the default for chars not in the pattern.  I assume array is word-aligned")

 
@@ -780,7 +788,7 @@ DONTCOPY
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
 
-[PUTDEF '\FFDELTA1 'RESOURCES '(NEW (ARRAY (ADD1 \MAXCHAR)
+[PUTDEF '\FFDELTA1 'RESOURCES '(NEW (ARRAY (ADD1 \MAXTHINCHAR)
                                            'BYTE]
 
 [PUTDEF '\FFDELTA2 'RESOURCES '(NEW (ARRAY \MAX.PATTERN.SIZE 'BYTE]
@@ -1567,18 +1575,16 @@ DONTCOPY
 
 (ADDTOVAR LAMA
 PACK* CONCAT)
 )
-(PUTPROPS IOCHAR COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 
-1991 2018 2020))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3456 7250 (CHCON 3466 . 4316) (UNPACK 4318 . 5212) (DCHCON 5214 . 6481) (DUNPACK 6483
- . 7248)) (7251 18766 (UALPHORDER 7261 . 7357) (ALPHORDER 7359 . 9162) (CONCAT 9164 . 9809) (
-CONCATCODES 9811 . 9997) (PACKC 9999 . 12602) (PACK 12604 . 13183) (PACK* 13185 . 14907) (\PACK.ITEM 
-14909 . 15364) (STRPOS 15366 . 18764)) (18768 19057 (XCL:PACK 18768 . 19057)) (19059 19309 (XCL:PACK* 
-19059 . 19309)) (20016 22407 (STRPOSL 20026 . 21652) (MAKEBITTABLE 21654 . 22405)) (22569 23046 (
-CASEARRAY 22579 . 22769) (UPPERCASEARRAY 22771 . 23044)) (23368 56745 (FILEPOS 23378 . 32619) (
-FFILEPOS 32621 . 44842) (\SETUP.FFILEPOS 44844 . 48627) (\SLOWFILEPOS 48629 . 56743)) (57533 98780 (
-DATE 57543 . 57629) (DATEFORMAT 57631 . 57723) (GDATE 57725 . 57836) (IDATE 57838 . 69509) (
-\IDATESCANTOKEN 69511 . 70790) (\IDATE-PARSE-MONTH 70792 . 74488) (\OUTDATE 74490 . 87238) (
-\OUTDATE-STRING 87240 . 87855) (\RPLRIGHT 87857 . 88095) (\UNPACKDATE 88097 . 93888) (\PACKDATE 93890
- . 97210) (\DTSCAN 97212 . 97354) (\ISDST? 97356 . 97863) (\CHECKDSTCHANGE 97865 . 98778)))))
+  (FILEMAP (NIL (3501 7295 (CHCON 3511 . 4361) (UNPACK 4363 . 5257) (DCHCON 5259 . 6526) (DUNPACK 6528
+ . 7293)) (7296 18811 (UALPHORDER 7306 . 7402) (ALPHORDER 7404 . 9207) (CONCAT 9209 . 9854) (
+CONCATCODES 9856 . 10042) (PACKC 10044 . 12647) (PACK 12649 . 13228) (PACK* 13230 . 14952) (\PACK.ITEM
+ 14954 . 15409) (STRPOS 15411 . 18809)) (18813 19102 (XCL:PACK 18813 . 19102)) (19104 19354 (XCL:PACK*
+ 19104 . 19354)) (20061 22561 (STRPOSL 20071 . 21697) (MAKEBITTABLE 21699 . 22559)) (22723 23200 (
+CASEARRAY 22733 . 22923) (UPPERCASEARRAY 22925 . 23198)) (23522 57053 (FILEPOS 23532 . 32823) (
+FFILEPOS 32825 . 45096) (\SETUP.FFILEPOS 45098 . 48935) (\SLOWFILEPOS 48937 . 57051)) (57845 99092 (
+DATE 57855 . 57941) (DATEFORMAT 57943 . 58035) (GDATE 58037 . 58148) (IDATE 58150 . 69821) (
+\IDATESCANTOKEN 69823 . 71102) (\IDATE-PARSE-MONTH 71104 . 74800) (\OUTDATE 74802 . 87550) (
+\OUTDATE-STRING 87552 . 88167) (\RPLRIGHT 88169 . 88407) (\UNPACKDATE 88409 . 94200) (\PACKDATE 94202
+ . 97522) (\DTSCAN 97524 . 97666) (\ISDST? 97668 . 98175) (\CHECKDSTCHANGE 98177 . 99090)))))
 STOP

sources/LLCHAR

@@ -1,16 +1,15 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "28-Apr-2022 08:52:36" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>LLCHAR.;13
 104756 
+
(FILECREATED "24-Aug-2025 11:50:57" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLCHAR.;14
 104478 
 
-      :CHANGES-TO (I.S.OPRS inpname)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "23-Apr-2022 17:19:02" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>LLCHAR.;12)
+      :CHANGES-TO (VARS LLCHARCOMS)
 
+      :PREVIOUS-DATE "28-Apr-2022 08:52:36" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLCHAR.;13)
 
-(* ; "
-Copyright (c) 1982-1988, 1990, 1994, 2018, 2021 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT LLCHARCOMS)
 
@@ -44,7 +43,6 @@ Copyright (c) 1982-1988, 1990, 1994, 2018, 2021 by Venue & Xerox Corporation.
                                    (MACROS \PUTBASECHAR \GETBASECHAR)
                                    (MACROS \CHARSET \CHAR8CODE)
                                    (CONSTANTS (\CHARMASK 255)
-                                          (\MAXCHAR 255)
                                           (\MAXTHINCHAR 255)
                                           (\MAXFATCHAR 65535)
                                           (\MAXCHARSET 255)
@@ -1728,8 +1726,6 @@ Copyright (c) 1982-1988, 1990, 1994, 2018, 2021 by Venue & Xerox Corporation.
 
 (RPAQQ \CHARMASK
 255)
 
-(RPAQQ \MAXCHAR
 255)
-
 (RPAQQ \MAXTHINCHAR
 255)
 
 (RPAQQ \MAXFATCHAR
 65535)
@@ -1740,7 +1736,6 @@ Copyright (c) 1982-1988, 1990, 1994, 2018, 2021 by Venue & Xerox Corporation.
 
 
 (CONSTANTS (\CHARMASK 255)
-       (\MAXCHAR 255)
        (\MAXTHINCHAR 255)
        (\MAXFATCHAR 65535)
        (\MAXCHARSET 255)
@@ -1848,19 +1843,17 @@ Copyright (c) 1982-1988, 1990, 1994, 2018, 2021 by Venue & Xerox Corporation.
 
 
 (PUTPROPS LLCHAR
 FILETYPE
 :FAKE-COMPILE-FILE)
-(PUTPROPS LLCHAR COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1994 
-2018 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4224 74410 (ALLOCSTRING 4234 . 6257) (MKATOM 6259 . 6894) (SUBATOM 6896 . 8766) (
-CHARACTER 8768 . 9772) (\PARSE.NUMBER 9774 . 25494) (\INVALID.DOTTED.SYMBOL 25496 . 25991) (
-\INVALID.INTEGER 25993 . 27445) (\MKINTEGER 27447 . 30154) (MKSTRING 30156 . 32299) (
-\PRINDATUM.TO.STRING 32301 . 38479) (BKSYSBUF 38481 . 40015) (NCHARS 40017 . 41717) (NTHCHARCODE 41719
- . 43765) (RPLCHARCODE 43767 . 44828) (\RPLCHARCODE 44830 . 46365) (NTHCHAR 46367 . 46560) (RPLSTRING 
-46562 . 49773) (SUBSTRING 49775 . 52698) (GNC 52700 . 52873) (GNCCODE 52875 . 53643) (GLC 53645 . 
-53818) (GLCCODE 53820 . 54585) (STREQUAL 54587 . 56701) (STRING.EQUAL 56703 . 61041) (STRINGP 61043 . 
-61194) (CHCON1 61196 . 61983) (U-CASE 61985 . 65212) (L-CASE 65214 . 69074) (U-CASEP 69076 . 69650) (
-\SMASHABLESTRING 69652 . 70114) (\MAKEWRITABLESTRING 70116 . 70552) (\SMASHSTRING 70554 . 74260) (
-\FATTENSTRING 74262 . 74408)) (74595 79757 (\GETBASESTRING 74605 . 75259) (\PUTBASESTRING 75261 . 
-78000) (\PUTBASESTRINGFAT 78002 . 78748) (GetBcplString 78750 . 79415) (SetBcplString 79417 . 79755)) 
-(101142 103956 (%%COPY-ONED-ARRAY 101152 . 103002) (%%COPY-STRING-TO-ARRAY 103004 . 103954)))))
+  (FILEMAP (NIL (4108 74294 (ALLOCSTRING 4118 . 6141) (MKATOM 6143 . 6778) (SUBATOM 6780 . 8650) (
+CHARACTER 8652 . 9656) (\PARSE.NUMBER 9658 . 25378) (\INVALID.DOTTED.SYMBOL 25380 . 25875) (
+\INVALID.INTEGER 25877 . 27329) (\MKINTEGER 27331 . 30038) (MKSTRING 30040 . 32183) (
+\PRINDATUM.TO.STRING 32185 . 38363) (BKSYSBUF 38365 . 39899) (NCHARS 39901 . 41601) (NTHCHARCODE 41603
+ . 43649) (RPLCHARCODE 43651 . 44712) (\RPLCHARCODE 44714 . 46249) (NTHCHAR 46251 . 46444) (RPLSTRING 
+46446 . 49657) (SUBSTRING 49659 . 52582) (GNC 52584 . 52757) (GNCCODE 52759 . 53527) (GLC 53529 . 
+53702) (GLCCODE 53704 . 54469) (STREQUAL 54471 . 56585) (STRING.EQUAL 56587 . 60925) (STRINGP 60927 . 
+61078) (CHCON1 61080 . 61867) (U-CASE 61869 . 65096) (L-CASE 65098 . 68958) (U-CASEP 68960 . 69534) (
+\SMASHABLESTRING 69536 . 69998) (\MAKEWRITABLESTRING 70000 . 70436) (\SMASHSTRING 70438 . 74144) (
+\FATTENSTRING 74146 . 74292)) (74479 79641 (\GETBASESTRING 74489 . 75143) (\PUTBASESTRING 75145 . 
+77884) (\PUTBASESTRINGFAT 77886 . 78632) (GetBcplString 78634 . 79299) (SetBcplString 79301 . 79639)) 
+(100978 103792 (%%COPY-ONED-ARRAY 100988 . 102838) (%%COPY-STRING-TO-ARRAY 102840 . 103790)))))
 STOP

sources/LLDISPLAY

@@ -1,14 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "27-Jul-2025 20:25:24" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;25
 272767 
+
(FILECREATED " 2-Sep-2025 22:54:03" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;50
 272104 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS LLDISPLAYCOMS)
+      :CHANGES-TO (FNS \SLOWBLTCHAR)
 
-      :PREVIOUS-DATE "14-Jul-2025 22:06:59" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;23)
+      :PREVIOUS-DATE " 2-Sep-2025 22:41:14" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;49)
 
 
 (PRETTYCOMPRINT LLDISPLAYCOMS)
@@ -1141,46 +1141,38 @@
                       T])
 
 (\CHANGECHARSET.DISPLAY

-  [LAMBDA (DISPLAYDATA CHARSET)
                          (* gbn "13-Sep-85 11:47")

+  [LAMBDA (DISPLAYDATA CHARSET)
                              (* ; "Edited  2-Sep-2025 22:40 by rmk")

+                                                             (* gbn "13-Sep-85 11:47")

 
     (* ;; 
-
"Called when the character set information cached in a display stream doesn't correspond to CHARSET")

+
 "Called when the character set information cached in a display stream doesn't correspond to CHARSET")

 
-    (PROG [BM (PBT (ffetch
 DDPILOTBBT of
 DISPLAYDATA))
-              (CSINFO (\GETCHARSETINFO CHARSET (ffetch
 DDFONT of
 DISPLAYDATA]
+    (PROG (BM (PBT (ffetch
 DDPILOTBBT of
 DISPLAYDATA))
+              (CSINFO (\INSURECHARSETINFO (ffetch
 DDFONT of
 DISPLAYDATA)
+                             CHARSET)))
 
-     (* ;; "Since we called \GETCHARSETINFO without the NOSLUG?  flag, we presume we will get back a CSINFO , even if it is a slug csinfo")

+     (* ;; "Since we will get back a CSINFO , even if it is a slug csinfo")

 
           (UNINTERRUPTABLY
-              (freplace
 DDWIDTHSCACHE of
 DISPLAYDATA with
 (ffetch
 (CHARSETINFO WIDTHS
-                                                                                         )
-                                                                         of
 CSINFO))
-              (freplace
 DDOFFSETSCACHE of
 DISPLAYDATA with
 (ffetch
 (CHARSETINFO
-                                                                                    OFFSETS)
-                                                                          of
 CSINFO))
-              (freplace
 DDCHARIMAGEWIDTHS of
 DISPLAYDATA with
 (ffetch
 (CHARSETINFO
-                                                                                       IMAGEWIDTHS)
-                                                                             of
 CSINFO))
+              (freplace
 DDWIDTHSCACHE of
 DISPLAYDATA with
 (ffetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
+              (freplace
 DDOFFSETSCACHE of
 DISPLAYDATA with
 (ffetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
+              (freplace
 DDCHARIMAGEWIDTHS of
 DISPLAYDATA with
 (ffetch
 (CHARSETINFO IMAGEWIDTHS)
+                                                                 of
 CSINFO))
               (freplace
 DDCHARSET of
 DISPLAYDATA with
 CHARSET)
               (SETQ BM (ffetch
 CHARSETBITMAP of
 CSINFO))
-              (freplace
 PBTSOURCEBPL of
 PBT with
 (UNFOLD (ffetch
 BITMAPRASTERWIDTH
-                                                                        of
 BM)
-                                                                    BITSPERWORD))
+              (freplace
 PBTSOURCEBPL of
 PBT with
 (UNFOLD (ffetch
 BITMAPRASTERWIDTH of
 BM)
+                                                        BITSPERWORD))
               [COND
                  ((OR (NEQ (ffetch
 DDCHARSETASCENT of
 DISPLAYDATA)
                            (ffetch
 CHARSETASCENT of
 CSINFO))
                       (NEQ (ffetch
 DDCHARSETDESCENT of
 DISPLAYDATA)
                            (ffetch
 CHARSETDESCENT of
 CSINFO)))
                   (\SFFixY
 DISPLAYDATA CSINFO))
-                 (T (freplace
 PBTSOURCE of
 PBT with
 (\ADDBASE (ffetch
 BITMAPBASE
-                                                                             of
 BM)
-                                                                       (ITIMES (ffetch
 
-                                                                                    BITMAPRASTERWIDTH
-                                                                                  of
 BM)
-                                                                              (ffetch
 
-                                                                                    DDCHARHEIGHTDELTA
-                                                                                 of
 DISPLAYDATA])
-     ])
+                 (T (freplace
 PBTSOURCE of
 PBT with
 (\ADDBASE (ffetch
 BITMAPBASE of
 BM)
+                                                           (ITIMES (ffetch
 BITMAPRASTERWIDTH
+                                                                      of
 BM)
+                                                                  (ffetch
 DDCHARHEIGHTDELTA
+                                                                     of
 DISPLAYDATA])])
 
 (\INDICATESTRING

   [LAMBDA (CHARCODE)
                                     (* jds " 3-Oct-85 16:50")

@@ -1208,16 +1200,16 @@
                  (CHARACTER CHARCODE])
 
 (\SLOWBLTCHAR

-  [LAMBDA (CHARCODE DISPLAYSTREAM)
                     (* ; "Edited  8-Nov-89 15:19 by gadener")

+  [LAMBDA (CHARCODE DISPLAYSTREAM)
                           (* ; "Edited  2-Sep-2025 22:52 by rmk")


+                                                           (* ; "Edited  8-Nov-89 15:19 by gadener")

 
     (* ;; "case of BLTCHAR where either font is rotated or destination is a color bitmap.  DISPLAYSTREAM is known to be a display stream, and its cache fields have been updated for CHARCODE's charset")

 
     (PROG (ROTATION CHAR8CODE DD)
           (SETQ CHAR8CODE (\CHAR8CODE CHARCODE))
           (SETQ DD (ffetch
 (STREAM IMAGEDATA) of
 DISPLAYSTREAM))
-          (SETQ ROTATION (ffetch
 (FONTDESCRIPTOR ROTATION) of
 (ffetch
 (\DISPLAYDATA
-                                                                                   DDFONT)
-                                                                         of
 DD)))
+          (SETQ ROTATION (ffetch
 (FONTDESCRIPTOR ROTATION) of
 (ffetch
 (\DISPLAYDATA DDFONT)
+                                                                 of
 DD)))
           (COND
              [(EQ 0 ROTATION)
               (PROG (NEWX LEFT RIGHT CURX PILOTBBT DESTBIT WIDTH SOURCEBIT)
@@ -1247,11 +1239,9 @@
                         (SETQ SOURCEBIT (IDIFFERENCE (IPLUS (\DSPGETCHAROFFSET CHAR8CODE DD)
                                                             LEFT)
                                                CURX))
-                        (SELECTQ (ffetch
 (BITMAP BITMAPBITSPERPIXEL) of
 (ffetch

-                                                                                 (\DISPLAYDATA 
-                                                                                        DDDestination
-                                                                                        )
-                                                                                   of
 DD))
+                        (SELECTQ (ffetch
 (BITMAP BITMAPBITSPERPIXEL) of
 (ffetch
 (\DISPLAYDATA 
+                                                                                       DDDestination)
+                                                                           of
 DD))
                             (1)
                             (4 (SETQ DESTBIT (LLSH DESTBIT 2))
                                (SETQ WIDTH (LLSH WIDTH 2))
@@ -1263,33 +1253,29 @@
                                 (SETQ WIDTH (ITIMES 24 WIDTH))
                                 (SETQ SOURCEBIT (ITIMES 24 SOURCEBIT)))
                             (SHOULDNT))
-                        (.WHILE.TOP.DS. DISPLAYSTREAM (freplace
 (PILOTBBT PBTDESTBIT)
-                                                         of
 PILOTBBT with
 DESTBIT)
+                        (.WHILE.TOP.DS. DISPLAYSTREAM (freplace
 (PILOTBBT PBTDESTBIT) of
 PILOTBBT
+                                                         with
 DESTBIT)
                                (freplace
 (PILOTBBT PBTWIDTH) of
 PILOTBBT with
 WIDTH)
-                               (freplace
 (PILOTBBT PBTSOURCEBIT) of
 PILOTBBT with
 
-                                                                                           SOURCEBIT)
+                               (freplace
 (PILOTBBT PBTSOURCEBIT) of
 PILOTBBT with
 SOURCEBIT)
                                (\PILOTBITBLT PILOTBBT 0))
                         T]
              (T                                              (* ; "handle rotated fonts")

                 (PROG (YPOS HEIGHTMOVED CSINFO)
                       (SETQ YPOS (ffetch
 (\DISPLAYDATA DDYPOSITION) of
 DD))
                       (SETQ HEIGHTMOVED (\DSPGETCHARWIDTH CHAR8CODE DD))
-                      (SETQ CSINFO (\GETCHARSETINFO (\CHARSET CHARCODE)
-                                          (ffetch
 (\DISPLAYDATA DDFONT) of
 DD)))
+                      (SETQ CSINFO (\INSURECHARSETINFO (ffetch
 (\DISPLAYDATA DDFONT) of
 DD)
+                                          (\CHARSET CHARCODE)))
                       (COND
-                         ((EQ ROTATION 90)                   (* ; 
-
                                                           "don't force CR for rotated fonts.")

+                         ((EQ ROTATION 90)                   (* ; "don't force CR for rotated fonts.")

                           (\DSPYPOSITION.DISPLAY
 DISPLAYSTREAM (IPLUS YPOS HEIGHTMOVED))
                                                              (* ; 
-
                                                           "update the display stream x position.")

+
                                                             "update the display stream x position.")

                           (BITBLT
 (ffetch
 (CHARSETINFO CHARSETBITMAP) of
 CSINFO)
                                  0
                                  (\DSPGETCHAROFFSET CHAR8CODE DD)
                                  DISPLAYSTREAM
-                                 (ADD1 (IDIFFERENCE (ffetch
 (\DISPLAYDATA DDXPOSITION)
-                                                       of
 DD)
-                                              (ffetch
 (CHARSETINFO CHARSETASCENT) of
 CSINFO))
-                                       )
+                                 (ADD1 (IDIFFERENCE (ffetch
 (\DISPLAYDATA DDXPOSITION) of
 DD)
+                                              (ffetch
 (CHARSETINFO CHARSETASCENT) of
 CSINFO)))
                                  YPOS
                                  (IPLUS (ffetch
 (CHARSETINFO CHARSETASCENT) of
 CSINFO)
                                         (ffetch
 (CHARSETINFO CHARSETDESCENT) of
 CSINFO))
@@ -4593,17 +4579,25 @@
 (DEFINEQ
 
 (INITIALIZEDISPLAYSTREAMS

-  [LAMBDA NIL
                                                (* ; "Edited  6-Jul-2025 12:57 by rmk")

+  [LAMBDA NIL
                                                (* ; "Edited 18-Aug-2025 12:15 by rmk")


+                                                             (* ; "Edited  6-Jul-2025 12:57 by rmk")

                                                              (* lmm " 7-Jan-86 16:51")

     (SETQ WHOLEDISPLAY (create
 REGION))
     (SETQ \SYSPILOTBBT (create
 PILOTBBT))                    (* ; "For BITBLT")

     (SETQ \SYSBBTEXTURE (BITMAPCREATE
 16 16))                (* ; 
 
                                                             "For texture handling in \BITBLTSUB")

-                                                             (* ; 
-
    "A guaranteed display font is initialized here after pup, font, and bitmap code has been loaded.")

-    (SETQ \GUARANTEEDDISPLAYFONT (FONTCREATE 'GACHA 10 '(MEDIUM REGULAR REGULAR)
-                                        NIL
-                                        'DISPLAY))
+
+    (* ;; "A guaranteed display font is initialized here after pup, font, and bitmap code has been loaded.  This does not use FONTCREATE, so it doesn't depend on the argument checking and incore cache retrieval ")

+
+    [SETQ \GUARANTEEDDISPLAYFONT (\CREATEDISPLAYFONT (MAKEFONTSPEC 'GACHA 10 '(MEDIUM REGULAR REGULAR
+                                                                                     )
+                                                            0
+                                                            'DISPLAY]
+
+    (* ;; 
+
  "For some reason, charset 0 has to be instantiated, otherwise there is a divide by 0 in the loadup")

+
+    (\CREATECHARSET 0 \GUARANTEEDDISPLAYFONT)
     (SETQ DEFAULTFONT (FONTCLASS 'DEFAULTFONT (LIST 1 \GUARANTEEDDISPLAYFONT])
 )
 (DECLARE%: DOCOPY DONTEVAL@LOAD 
@@ -4628,44 +4622,44 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (20615 23283 (\FBITMAPBIT 20625 . 21085) (\FBITMAPBIT.UFN 21087 . 22106) (
-\NEWPAGE.DISPLAY 22108 . 22243) (INITBITMASKS 22245 . 23281)) (25208 25717 (\CreateCursorBitMap 25218
- . 25715)) (25834 86764 (BITBLT 25844 . 36234) (BLTSHADE 36236 . 37014) (\BITBLTSUB 37016 . 47151) (
-\GETPILOTBBTSCRATCHBM 47153 . 47768) (BITMAPCOPY 47770 . 48346) (BITMAPCREATE 48348 . 49908) (
-BITMAPBIT 49910 . 58297) (BITMAPEQUAL 58299 . 59761) (BLTCHAR 59763 . 60379) (\BLTCHAR 60381 . 60883) 
-(\MEDW.BLTCHAR 60885 . 65763) (\CHANGECHARSET.DISPLAY 65765 . 68723) (\INDICATESTRING 68725 . 69921) (
-\SLOWBLTCHAR 69923 . 77019) (TEXTUREP 77021 . 77291) (INVERT.TEXTURE 77293 . 77567) (
-INVERT.TEXTURE.BITMAP 77569 . 79104) (BITMAPWIDTH 79106 . 79478) (BITMAPHEIGHT 79480 . 79856) (
-READBITMAP 79858 . 82368) (\INSUREBITSPERPIXEL 82370 . 82665) (MAXIMUMCOLOR 82667 . 82808) (
-OPPOSITECOLOR 82810 . 82989) (MAXIMUMSHADE 82991 . 83202) (OPPOSITESHADE 83204 . 83383) (\MEDW.BITBLT 
-83385 . 86762)) (86765 88194 (\READBINARYBITMAP 86775 . 87413) (\PRINTBINARYBITMAP 87415 . 88192)) (
-88196 93382 (FINISH-READING-BITMAP 88196 . 93382)) (94504 94985 (BITMAPBIT.EXPANDER 94514 . 94983)) (
-94986 143520 (\BITBLT.DISPLAY 94996 . 118235) (\BITBLT.BITMAP 118237 . 127336) (\BITBLT.MERGE 127338
- . 129591) (\BLTSHADE.DISPLAY 129593 . 136693) (\BLTSHADE.BITMAP 136695 . 143518)) (143521 152841 (
-\BITBLT.BITMAP.SLOW 143531 . 152839)) (152842 169223 (\PUNT.BLTSHADE.BITMAP 152852 . 159948) (
-\PUNT.BITBLT.BITMAP 159950 . 169221)) (169224 172664 (\SCALEDBITBLT.DISPLAY 169234 . 170867) (
-\BACKCOLOR.DISPLAY 170869 . 172662)) (176519 178792 (DISPLAYSTREAMP 176529 . 177137) (DSPSOURCETYPE 
-177139 . 178148) (DSPXOFFSET 178150 . 178469) (DSPYOFFSET 178471 . 178790)) (178793 192988 (
-DSPDESTINATION 178803 . 181906) (DSPTEXTURE 181908 . 182070) (\DISPLAYSTREAMINCRXPOSITION 182072 . 
-182359) (\SFFixDestination 182361 . 183539) (\SFFixClippingRegion 183541 . 185713) (\SFFixFont 185715
- . 186765) (\SFFIXLINELENGTH 186767 . 188263) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 188265 . 190078
-) (\SFFixY 190080 . 192986)) (192989 196836 (\SIMPLE.DSPCREATE 192999 . 193549) (\COMMON.DSPCREATE 
-193551 . 196834)) (196937 199131 (\MEDW.XOFFSET 196947 . 198088) (\MEDW.YOFFSET 198090 . 199129)) (
-199132 207062 (\DSPCLIPPINGREGION.DISPLAY 199142 . 199888) (\DSPFONT.DISPLAY 199890 . 202264) (
-\DISPLAY.PILOTBITBLT 202266 . 202415) (\DSPLINEFEED.DISPLAY 202417 . 202988) (\DSPLEFTMARGIN.DISPLAY 
-202990 . 203721) (\DSPOPERATION.DISPLAY 203723 . 204747) (\DSPRIGHTMARGIN.DISPLAY 204749 . 205594) (
-\DSPXPOSITION.DISPLAY 205596 . 206453) (\DSPYPOSITION.DISPLAY 206455 . 207060)) (211250 216286 (
-TTYDISPLAYSTREAM 211260 . 216284)) (216589 217619 (DSPSCROLL 216599 . 217299) (PAGEHEIGHT 217301 . 
-217617)) (217664 220686 (\DSPRESET.DISPLAY 217674 . 220684)) (220722 221245 (\MAYBE-DRIBBLE-CHAR 
-220722 . 221245)) (221246 241884 (\DSPPRINTCHAR 221256 . 229094) (\DSPPRINTCR/LF 229096 . 241882)) (
-241885 242477 (\TTYBACKGROUND 241895 . 242475)) (242478 245765 (DSPBACKUP 242488 . 245763)) (245949 
-246205 (COLORDISPLAYP 245959 . 246203)) (246206 248277 (DISPLAYBEFOREEXIT 246216 . 247042) (
-DISPLAYAFTERENTRY 247044 . 248275)) (248649 253181 (\DSPCLIPTRANSFORMX 248659 . 249248) (
-\DSPCLIPTRANSFORMY 249250 . 249975) (\DSPTRANSFORMREGION 249977 . 250509) (\DSPUNTRANSFORMY 250511 . 
-250771) (\DSPUNTRANSFORMX 250773 . 251033) (\OFFSETCLIPPINGREGION 251035 . 253179)) (254495 257082 (
-UPDATESCREENDIMENSIONS 254505 . 255134) (\CreateScreenBitMap 255136 . 257080)) (257641 270800 (
-\CoerceToDisplayDevice 257651 . 258064) (\CREATEDISPLAY 258066 . 259906) (DISPLAYSTREAMINIT 259908 . 
-263052) (\STARTDISPLAY 263054 . 265965) (\MOVE.WINDOWS.ONTO.SCREEN 265967 . 268159) (
-\UPDATE.PBT.RASTERWIDTHS 268161 . 269943) (\STOPDISPLAY 269945 . 270437) (\DEFINEDISPLAYINFO 270439 . 
-270798)) (271408 272392 (INITIALIZEDISPLAYSTREAMS 271418 . 272390)))))
+  (FILEMAP (NIL (20613 23281 (\FBITMAPBIT 20623 . 21083) (\FBITMAPBIT.UFN 21085 . 22104) (
+\NEWPAGE.DISPLAY 22106 . 22241) (INITBITMASKS 22243 . 23279)) (25206 25715 (\CreateCursorBitMap 25216
+ . 25713)) (25832 85635 (BITBLT 25842 . 36232) (BLTSHADE 36234 . 37012) (\BITBLTSUB 37014 . 47149) (
+\GETPILOTBBTSCRATCHBM 47151 . 47766) (BITMAPCOPY 47768 . 48344) (BITMAPCREATE 48346 . 49906) (
+BITMAPBIT 49908 . 58295) (BITMAPEQUAL 58297 . 59759) (BLTCHAR 59761 . 60377) (\BLTCHAR 60379 . 60881) 
+(\MEDW.BLTCHAR 60883 . 65761) (\CHANGECHARSET.DISPLAY 65763 . 67997) (\INDICATESTRING 67999 . 69195) (
+\SLOWBLTCHAR 69197 . 75890) (TEXTUREP 75892 . 76162) (INVERT.TEXTURE 76164 . 76438) (
+INVERT.TEXTURE.BITMAP 76440 . 77975) (BITMAPWIDTH 77977 . 78349) (BITMAPHEIGHT 78351 . 78727) (
+READBITMAP 78729 . 81239) (\INSUREBITSPERPIXEL 81241 . 81536) (MAXIMUMCOLOR 81538 . 81679) (
+OPPOSITECOLOR 81681 . 81860) (MAXIMUMSHADE 81862 . 82073) (OPPOSITESHADE 82075 . 82254) (\MEDW.BITBLT 
+82256 . 85633)) (85636 87065 (\READBINARYBITMAP 85646 . 86284) (\PRINTBINARYBITMAP 86286 . 87063)) (
+87067 92253 (FINISH-READING-BITMAP 87067 . 92253)) (93375 93856 (BITMAPBIT.EXPANDER 93385 . 93854)) (
+93857 142391 (\BITBLT.DISPLAY 93867 . 117106) (\BITBLT.BITMAP 117108 . 126207) (\BITBLT.MERGE 126209
+ . 128462) (\BLTSHADE.DISPLAY 128464 . 135564) (\BLTSHADE.BITMAP 135566 . 142389)) (142392 151712 (
+\BITBLT.BITMAP.SLOW 142402 . 151710)) (151713 168094 (\PUNT.BLTSHADE.BITMAP 151723 . 158819) (
+\PUNT.BITBLT.BITMAP 158821 . 168092)) (168095 171535 (\SCALEDBITBLT.DISPLAY 168105 . 169738) (
+\BACKCOLOR.DISPLAY 169740 . 171533)) (175390 177663 (DISPLAYSTREAMP 175400 . 176008) (DSPSOURCETYPE 
+176010 . 177019) (DSPXOFFSET 177021 . 177340) (DSPYOFFSET 177342 . 177661)) (177664 191859 (
+DSPDESTINATION 177674 . 180777) (DSPTEXTURE 180779 . 180941) (\DISPLAYSTREAMINCRXPOSITION 180943 . 
+181230) (\SFFixDestination 181232 . 182410) (\SFFixClippingRegion 182412 . 184584) (\SFFixFont 184586
+ . 185636) (\SFFIXLINELENGTH 185638 . 187134) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 187136 . 188949
+) (\SFFixY 188951 . 191857)) (191860 195707 (\SIMPLE.DSPCREATE 191870 . 192420) (\COMMON.DSPCREATE 
+192422 . 195705)) (195808 198002 (\MEDW.XOFFSET 195818 . 196959) (\MEDW.YOFFSET 196961 . 198000)) (
+198003 205933 (\DSPCLIPPINGREGION.DISPLAY 198013 . 198759) (\DSPFONT.DISPLAY 198761 . 201135) (
+\DISPLAY.PILOTBITBLT 201137 . 201286) (\DSPLINEFEED.DISPLAY 201288 . 201859) (\DSPLEFTMARGIN.DISPLAY 
+201861 . 202592) (\DSPOPERATION.DISPLAY 202594 . 203618) (\DSPRIGHTMARGIN.DISPLAY 203620 . 204465) (
+\DSPXPOSITION.DISPLAY 204467 . 205324) (\DSPYPOSITION.DISPLAY 205326 . 205931)) (210121 215157 (
+TTYDISPLAYSTREAM 210131 . 215155)) (215460 216490 (DSPSCROLL 215470 . 216170) (PAGEHEIGHT 216172 . 
+216488)) (216535 219557 (\DSPRESET.DISPLAY 216545 . 219555)) (219593 220116 (\MAYBE-DRIBBLE-CHAR 
+219593 . 220116)) (220117 240755 (\DSPPRINTCHAR 220127 . 227965) (\DSPPRINTCR/LF 227967 . 240753)) (
+240756 241348 (\TTYBACKGROUND 240766 . 241346)) (241349 244636 (DSPBACKUP 241359 . 244634)) (244820 
+245076 (COLORDISPLAYP 244830 . 245074)) (245077 247148 (DISPLAYBEFOREEXIT 245087 . 245913) (
+DISPLAYAFTERENTRY 245915 . 247146)) (247520 252052 (\DSPCLIPTRANSFORMX 247530 . 248119) (
+\DSPCLIPTRANSFORMY 248121 . 248846) (\DSPTRANSFORMREGION 248848 . 249380) (\DSPUNTRANSFORMY 249382 . 
+249642) (\DSPUNTRANSFORMX 249644 . 249904) (\OFFSETCLIPPINGREGION 249906 . 252050)) (253366 255953 (
+UPDATESCREENDIMENSIONS 253376 . 254005) (\CreateScreenBitMap 254007 . 255951)) (256512 269671 (
+\CoerceToDisplayDevice 256522 . 256935) (\CREATEDISPLAY 256937 . 258777) (DISPLAYSTREAMINIT 258779 . 
+261923) (\STARTDISPLAY 261925 . 264836) (\MOVE.WINDOWS.ONTO.SCREEN 264838 . 267030) (
+\UPDATE.PBT.RASTERWIDTHS 267032 . 268814) (\STOPDISPLAY 268816 . 269308) (\DEFINEDISPLAYINFO 269310 . 
+269669)) (270279 271729 (INITIALIZEDISPLAYSTREAMS 270289 . 271727)))))
 STOP

sources/LLDISPLAY.LCOM

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED "27-Jul-2025 20:25:50" ("compiled on " 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;25) "27-Jul-2025 13:59:31" 
-"COMPILE-FILEd" in "FULL 27-Jul-2025 ..." dated "27-Jul-2025 13:59:38")
-(FILECREATED "27-Jul-2025 20:25:24" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;25 272767 :EDIT-BY rmk 
-:CHANGES-TO (VARS LLDISPLAYCOMS) :PREVIOUS-DATE "14-Jul-2025 22:06:59" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;23)
+(FILECREATED " 2-Sep-2025 22:54:03" ("compiled on " 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;50) " 2-Sep-2025 22:44:30" 
+"COMPILE-FILEd" in "FULL  2-Sep-2025 ..." dated " 2-Sep-2025 22:44:39")
+(FILECREATED " 2-Sep-2025 22:54:03" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;50 272104 :EDIT-BY rmk 
+:CHANGES-TO (FNS \SLOWBLTCHAR) :PREVIOUS-DATE " 2-Sep-2025 22:41:14" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;49)
 (RPAQQ LLDISPLAYCOMS ((DECLARE%: DONTCOPY (EXPORT (RECORDS PILOTBBT \DISPLAYDATA DISPLAYSTATE 
 DISPLAYINFO) (MACROS \GETDISPLAYDATA))) (* ; 
 "User-visible records are on ADISPLAY --- must be init'ed here") (INITRECORDS BITMAP PILOTBBT REGION 
@@ -196,7 +196,7 @@ BLTCHAR :D8
 (42 \DISPLAYDATA 35 STREAM 24 OUTPUT)
 ()
 \BLTCHAR :D8
-(P 0 A0169 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (
AghbÉ.ÉZ
@ABlH(11 \GETSTREAM)
+(P 0 A0152 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (
AghbÉ.ÉZ
@ABlH(11 \GETSTREAM)
 (25 IMAGEOPS 18 STREAM 5 OUTPUT)
 ()
 \MEDW.BLTCHAR :D8
@@ -209,11 +209,11 @@ BLTCHAR :D8
 (256 \EM.DISPINTERRUPT 191 \TOPWDS 175 \EM.DISPINTERRUPT 167 \EM.DISPINTERRUPT 132 PILOTBBT)
 ()
 \CHANGECHARSET.DISPLAY :D8
-(P 7 \INTERRUPTABLE P 5 BM P 4 CSINFO P 3 PBT I 1 CHARSET I 0 DISPLAYDATA) œ@É*@ÉÉAàÐɵ@ÉÉAàA@É
-HIÐJ¿J"@LÉ¿@LÉ¿@LÉ0¿@A>¿LɽKMÈàààànÿÿåÍ¿@È'LÈ
-ð—@È@LÈð©@L
-¿°#MÉMÈ@ÉBÚоKNÒÍ¿KNÓÍh(116 \SFFixY 30 \CREATECHARSET)
-(148 PILOTBBT 137 PILOTBBT)
+(P 8 \INTERRUPTABLE P 6 BM P 5 CSINFO P 4 PBT I 1 CHARSET I 0 DISPLAYDATA) ¦	@É*@É
HÉAàÐɵHÉAàAH
+IJÐK¿K"@MÉ¿@MÉ¿@MÉ0¿@A>¿MɾLNÈàààànÿÿåÍ¿@È'MÈ
+ð—@È@MÈð©@M
+¿°'NÉNÈ@ÉBÚÐ_¿LOÒÍ¿LOÓÍh(122 \SFFixY 35 \CREATECHARSET)
+(157 PILOTBBT 145 PILOTBBT 24 FONTDESCRIPTOR)
 ()
 \INDICATESTRINGA0001 :D8
 (NAME SI::*UNWIND-PROTECT* I 0 SI::*CLEANUP-FORMS* F 0 SI::*RESETFORMS* F 1 CHARCODE) H
gd	gi
@@ -225,18 +225,18 @@ BLTCHAR :D8
 (75 ^ 52 %# 16 SI::RESETUNWIND)
 ( 81 "" 58 "")
 \SLOWBLTCHAR :D8
-(P 16 CSINFO P 15 HEIGHTMOVED P 14 YPOS P 13 SOFTCURSORUP P 12 DISPINTERRUPT P 11 SOURCEBIT P 10 WIDTH P 9 DESTBIT P 8 PILOTBBT P 7 CURX P 6 RIGHT P 5 LEFT P 4 NEWX P 2 DD P 1 CHAR8CODE P 0 ROTATION I 1 DISPLAYSTREAM I 0 CHARCODE F 20 \SOFTCURSORP F 21 \SOFTCURSORUPP F 22 \CURSORDESTINATION F 23 \SCREENBITMAPS) b@@lÿåYAÉ0ZdÉÈXdjð¢±
~€JÉ_JÉIÐÈØ\JÉñ²l
A
-¿JÉ_JÉIÐÈؼJL¿OJÉØ_¿JÈ"dOñ¢¿O½JÈ#LJÉØ»dKñ‘¿K¾JÉ*_¿NMñ¢±
OÈ	jð’±

M_¿NMÙ_¿JÉIÐÈMØOÙ_¿JÉÈdkð³adlð²¿Oàà_¿Oàà_¿Oàà_°Ddlð²¿Oààà_¿Oààà_¿Oààà_°$lð²lOÚ_¿lOÚ_¿lOÚ_„¿ 
W(²-W*´hA
-W,ð_²`È_¿`jÍ¿¿A`ð³hA
-W.–A	¿OOÍ¿OOÍ¿OOÍ¿Ojv¿OŸ¿`OÍ¿±Î0JÉ_¿JÉIÐÈ_¿JÉÉ@ãàÐɵ$JÉÉ@ãà@ãJÉ
-O"O$ÐO&¿O&_ ¿HdlZð²;¿AOOØ
-¿O ÉjJÉIÐÈAJÉO È
-ÙkØOO È
-O ÈØO
°Hn
ð²8AOOÙ
-¿O ÉjJÉIÐÈAJÉO ÈÙJÉO È
-O ÈØO
‰o	h(606 ERROR 595 BKBITBLT 553 \DSPYPOSITION.DISPLAY 534 BKBITBLT 491 \DSPYPOSITION.DISPLAY 453 \CREATECHARSET 387 \SOFTCURSORUPCURRENT 352 \TOTOPWDS 342 DSPDESTINATION 325 \SOFTCURSORDOWN 294 DSPDESTINATION 275 SHOULDNT 55 \DSPPRINTCR/LF)
-(393 \EM.DISPINTERRUPT 332 \TOPWDS 316 \EM.DISPINTERRUPT 306 \EM.DISPINTERRUPT 111 \DISPLAYDATA 83 \DISPLAYDATA)
-( 601 "Not implemented to rotate by other than 0, 90 or 270")
+(P 18 CSINFO P 17 HEIGHTMOVED P 16 YPOS P 15 SOFTCURSORUP P 14 DISPINTERRUPT P 13 SOURCEBIT P 12 WIDTH P 11 DESTBIT P 10 PILOTBBT P 9 CURX P 8 RIGHT P 7 LEFT P 6 NEWX P 2 DD P 1 CHAR8CODE P 0 ROTATION I 1 DISPLAYSTREAM I 0 CHARCODE F 22 \SOFTCURSORP F 23 \SOFTCURSORUPP F 24 \CURSORDESTINATION F 25 \SCREENBITMAPS) n`@lÿåYAÉ0ZdÉÈXdjð¢±
ˆ€
JÉ_JÉIÐÈØ^JÉñ²l
A
+¿JÉ_JÉIÐÈؾJN¿OJÉØ_¿JÈ"dOñ¢¿O_¿JÈ#NJÉØ»dKñ‘¿K_¿JÉ*_¿OOñ¢±
OÈ	jð’±
O_¿OOÙ_¿JÉIÐÈOØOÙ_¿JÉÈdkð³adlð²¿Oàà_¿Oàà_¿Oàà_°Ddlð²¿Oààà_¿Oààà_¿Oààà_°$lð²lOÚ_¿lOÚ_¿lOÚ_„¿ W,²-W.´hA
+W0ð_²`È_¿`jÍ¿¿A`ð³hA
+W2–A	¿OOÍ¿OOÍ¿OOÍ¿Ojv¿OŸ¿`OÍ¿±Ð0JÉ_ ¿JÉIÐÈ_"¿JÉ@ã½\ÉMàÐɵ#LÉMàML
+O&O(ÐO*¿O*_$¿HdlZð²;¿AO O"Ø
+¿O$ÉjJÉIÐÈAJÉO$È
+ÙkØO O$È
+O$ÈØO"
°Hn
ð²8AO O"Ù
+¿O$ÉjJÉIÐÈAJÉO$ÈÙJÉO$È
+O$ÈØO"
‰o	h(618 ERROR 607 BKBITBLT 565 \DSPYPOSITION.DISPLAY 546 BKBITBLT 503 \DSPYPOSITION.DISPLAY 465 \CREATECHARSET 397 \SOFTCURSORUPCURRENT 362 \TOTOPWDS 352 DSPDESTINATION 335 \SOFTCURSORDOWN 304 DSPDESTINATION 285 SHOULDNT 55 \DSPPRINTCR/LF)
+(454 FONTDESCRIPTOR 403 \EM.DISPINTERRUPT 342 \TOPWDS 326 \EM.DISPINTERRUPT 316 \EM.DISPINTERRUPT 113 \DISPLAYDATA 83 \DISPLAYDATA)
+( 613 "Not implemented to rotate by other than 0, 90 or 270")
 TEXTUREP :D8
 (I 0 OBJECT) 
@d3 ³ô@Èkð´@NIL
 (18 BITMAP 10 BITMAP)
@@ -289,7 +289,7 @@ OPPOSITESHADE :D8
 NIL
 ()
 \MEDW.BITBLT :D8
-(P 9 A0172 P 8 A0171 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0170 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS) 
+(P 9 A0155 P 8 A0154 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0153 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS) 
 
@	³C	ªo	¿@òZ@²WCi
 CghÉ0HÉ2ÉHºHÉ2@ABCDEFGGGGGABlJ±
–Cô‚±¯C´‚±¨@i
 !@ghÉ0

AIÉصA
BIÉصBKÉ2ÉJ_¿KÉ2IÉNOCDEFGGGGGNIÈ"¼dLñ¡¿LOIÈ$½dMñ¡¿MlO±Þ@
@@ -455,11 +455,11 @@ Q
 (145 ERASE 138 INVERT 121 INVERT 110 PAINT 99 ERASE 86 \DISPLAYDATA 77 \DISPLAYDATA 53 INVERT 43 INPUT 32 \DISPLAYDATA 23 \DISPLAYDATA 16 STREAM 5 OUTPUT)
 ()
 DSPXOFFSET :D8
-(P 0 A0186 I 1 DISPLAYSTREAM I 0 XOFFSET) '
AghbÉ.É\
@AlH(11 \GETSTREAM)
+(P 0 A0169 I 1 DISPLAYSTREAM I 0 XOFFSET) '
AghbÉ.É\
@AlH(11 \GETSTREAM)
 (25 IMAGEOPS 18 STREAM 5 OUTPUT)
 ()
 DSPYOFFSET :D8
-(P 0 A0187 I 1 DISPLAYSTREAM I 0 YOFFSET) '
AghbÉ.É^
@AlH(11 \GETSTREAM)
+(P 0 A0170 I 1 DISPLAYSTREAM I 0 YOFFSET) '
AghbÉ.É^
@AlH(11 \GETSTREAM)
 (25 IMAGEOPS 18 STREAM 5 OUTPUT)
 ()
 DSPDESTINATION :D8
@@ -544,12 +544,12 @@ A
 (23 \DISPLAYDATA 16 STREAM 5 OUTPUT)
 ( 63 " is not a REGION.")
 \DSPFONT.DISPLAY :D8
-(P 4 \INTERRUPTABLE P 2 DD P 1 OLDFONT P 0 XFONT I 1 FONT I 0 DISPLAYSTREAM) †@@É0ZdÉYA²nAhdd@i
µJÉgiA
-µo	XIð³>JH¿JjHÈ
-Ù¿JHÉɵHÉjH
+(P 4 \INTERRUPTABLE P 2 DD P 1 OLDFONT P 0 XFONT I 1 FONT I 0 DISPLAYSTREAM) ‹@@É0ZdÉYA²sAhdd@i
µJÉgiA
+µo	XIð³CJH¿JjHÈ
+Ù¿JHÉɵHÉjH
 [¿KÉÈ ÍA¿@J
-(130 \SFFixFont 111 \CREATECHARSET 66 ERROR 54 FONTCOPY 35 FONTCREATE)
-(87 FONTDESCRIPTOR 45 NOERROR 17 \DISPLAYDATA 8 STREAM)
+(135 \SFFixFont 116 \CREATECHARSET 66 ERROR 54 FONTCOPY 35 FONTCREATE)
+(107 FONTDESCRIPTOR 87 FONTDESCRIPTOR 45 NOERROR 17 \DISPLAYDATA 8 STREAM)
 ( 61 "FONT NOT FOUND OR ILLEGAL FONTCOPY PARAMETER")
 \DISPLAY.PILOTBITBLT :D8
 (I 1 N I 0 PILOTBBT) @AvNIL
@@ -790,11 +790,11 @@ Z`S
 (167 \LastTTYLines 155 SCREENHEIGHT 148 SCREENHEIGHT 133 SCREENWIDTH 115 SCREENWIDTH 76 SCREENHEIGHT 62 \LastTTYLines 52 \TopLevelTtyWindow 47 \DEFAULTTTYDISPLAYSTREAM 35 ScreenBitMap)
 ()
 \STARTDISPLAY :D8
-(P 2 \INTERRUPTABLE P 1 W P 0 OLDWINDOWS F 3 \MAINSCREEN F 4 \WINDOWWORLD F 5 \CURSORDESTINATION F 6 \CURSORDESTRASTERWIDTH F 7 \CURSORDESTWIDTH F 8 \CURSORDESTHEIGHT) 
@``ðœ``ð³AT²>	¸``ó«``ó–H	¿HŒd


I	µò``
+(P 2 \INTERRUPTABLE P 1 W P 0 OLDWINDOWS F 3 \MAINSCREEN F 4 \WINDOWWORLD F 5 \CURSORDESTINATION F 6 WINDOWBACKGROUNDSHADE F 7 \CURSORDESTWIDTH F 8 \CURSORDESTHEIGHT F 9 \CURSORDESTRASTERWIDTH) 
<``ðœ``ð³AT²>	¸``ó«``ó–H	¿HŒd


I	µò``
 É`È
-¿ijd``hSµ;`c
-`c`c`ÈcH²P`	¿H	°:`¿S`¿S`¿°žd


I	µò``h(291 \OPENW1 235 REVERSE 228 CHANGEBACKGROUND 142 SHOWDISPLAY 113 \CreateScreenBitMap 90 \CLOSEW1 76 \MOVE.WINDOWS.ONTO.SCREEN 45 REVERSE 40 OPENWINDOWS 7 UPDATESCREENDIMENSIONS)
-(316 \OLDSCREENWIDTH 311 SCREENWIDTH 306 \OLDSCREENHEIGHT 301 SCREENHEIGHT 275 SCREENHEIGHT 270 SCREEN 261 SCREENWIDTH 256 SCREEN 247 ScreenBitMap 242 SCREEN 223 WINDOWBACKGROUNDSHADE 211 BITMAP 206 ScreenBitMap 199 SCREENHEIGHT 192 SCREENWIDTH 185 ScreenBitMap 177 WHOLESCREEN 172 WHOLEDISPLAY 162 SCREENHEIGHT 157 SCREENWIDTH 149 \DisplayStarted 135 BITMAP 130 ScreenBitMap 123 BITMAP 118 ScreenBitMap 108 SCREENHEIGHT 103 SCREENWIDTH 68 SCREENHEIGHT 63 \OLDSCREENHEIGHT 56 SCREENWIDTH 51 \OLDSCREENWIDTH 29 \OLDSCREENHEIGHT 24 SCREENHEIGHT 17 \OLDSCREENWIDTH 12 SCREENWIDTH)
+¿ijd``hSµ7`c
+`c`c`ÈcH²LV	¿H	°:`¿S`¿S`¿°¢d


I	µò``h(287 \OPENW1 231 REVERSE 224 CHANGEBACKGROUND 142 SHOWDISPLAY 113 \CreateScreenBitMap 90 \CLOSEW1 76 \MOVE.WINDOWS.ONTO.SCREEN 45 REVERSE 40 OPENWINDOWS 7 UPDATESCREENDIMENSIONS)
+(312 \OLDSCREENWIDTH 307 SCREENWIDTH 302 \OLDSCREENHEIGHT 297 SCREENHEIGHT 271 SCREENHEIGHT 266 SCREEN 257 SCREENWIDTH 252 SCREEN 243 ScreenBitMap 238 SCREEN 211 BITMAP 206 ScreenBitMap 199 SCREENHEIGHT 192 SCREENWIDTH 185 ScreenBitMap 177 WHOLESCREEN 172 WHOLEDISPLAY 162 SCREENHEIGHT 157 SCREENWIDTH 149 \DisplayStarted 135 BITMAP 130 ScreenBitMap 123 BITMAP 118 ScreenBitMap 108 SCREENHEIGHT 103 SCREENWIDTH 68 SCREENHEIGHT 63 \OLDSCREENHEIGHT 56 SCREENWIDTH 51 \OLDSCREENWIDTH 29 \OLDSCREENHEIGHT 24 SCREENHEIGHT 17 \OLDSCREENWIDTH 12 SCREENWIDTH)
 ()
 \MOVE.WINDOWS.ONTO.SCREEN :D8
 (P 4 REG P 3 YFACTOR P 2 XFACTOR P 1 W I 0 WINDOWS) Ú
@
Hµ+h´&```ëZ``ë[@
HµAh
YÉ
L
L
ØmÿØ`óµL
L
ØmÿØ`ó•Iµ¥i°¢HX°™
Yd	ð²\Ii
@@ -815,11 +815,12 @@ NIL
 (PUTPROPS DISPLAYSTARTEDP MACRO (NIL \DisplayStarted))
 (ADDTOVAR GLOBALVARS WHOLESCREEN)
 INITIALIZEDISPLAYSTREAMS :D8
-(F 0 \GUARANTEEDDISPLAYFONT F 1 DEFAULTFONT) Yodnÿdh`ld
+(F 0 \GUARANTEEDDISPLAYFONT F 1 DEFAULTFONT) eodnÿdh`ld
 gl
-ohg
cgkPh
-c(84 FONTCLASS 67 FONTCREATE 38 BITMAPCREATE)
-(74 DEFAULTFONT 61 DISPLAY 48 GACHA 43 \SYSBBTEXTURE 30 \SYSPILOTBBT 24 |PILOTBBTTYPE#| 19 WHOLEDISPLAY)
+ojg
	cjP
+gkPh
+c(96 FONTCLASS 81 \CREATECHARSET 72 \CREATEDISPLAYFONT 67 MAKEFONTSPEC 38 BITMAPCREATE)
+(86 DEFAULTFONT 61 DISPLAY 48 GACHA 43 \SYSBBTEXTURE 30 \SYSPILOTBBT 24 |PILOTBBTTYPE#| 19 WHOLEDISPLAY)
 ( 55 (MEDIUM REGULAR REGULAR) 4 -16383)
 (RPAQQ \DisplayStarted NIL)
 (RPAQQ \LastTTYLines 12)

sources/LLREAD

@@ -1,14 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "13-Aug-2025 14:40:39" {WMEDLEY}<sources>LLREAD.;121
 102895 
+
(FILECREATED "24-Aug-2025 11:47:11" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLREAD.;122
 102955 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS LLREADCOMS)
-                  (FNS CHARCODE.ENCODE CHARSET.DECODE)
+      :CHANGES-TO (FNS CHARCODEP)
 
-      :PREVIOUS-DATE " 8-Aug-2025 10:13:49" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLREAD.;118)
+      :PREVIOUS-DATE "13-Aug-2025 14:40:39" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLREAD.;121)
 
 
 (PRETTYCOMPRINT LLREADCOMS)
@@ -1558,12 +1558,12 @@
                     (CONCAT CSETNAME "," CHARNAME))])
 
 (CHARCODEP

-  [LAMBDA (CHCODE)
                                           (* ; "Edited  8-Aug-2025 09:16 by rmk")

+  [LAMBDA (CHCODE)
                                           (* ; "Edited 24-Aug-2025 11:46 by rmk")


+                                                             (* ; "Edited  8-Aug-2025 09:16 by rmk")

                                                              (* gbn "22-Jul-85 16:35")

                                                              (* ; "is CHCODE a legal character code?")

     (CL:WHEN (AND (SMALLP CHCODE)
-                  (IGEQ CHCODE 0)
-                  (ILEQ CHCODE \MAXNSCHAR))
+                  (<= 0 CHCODE \MAXFATCHAR))
            CHCODE])
 
 (CHARSET.DECODE

@@ -1892,19 +1892,19 @@
 (ADDTOVAR LAMA
 CL:PARSE-INTEGER CL:READ-DELIMITED-LIST CL:READ-PRESERVING-WHITESPACE CL:READ)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3886 12330 (LASTC 3896 . 4202) (PEEKC 4204 . 4592) (PEEKCCODE 4594 . 5005) (RATOM 5007
- . 6088) (READ 6090 . 6650) (READC 6652 . 7293) (READCCODE 7295 . 8054) (READP 8056 . 8608) (
-SETREADMACROFLG 8610 . 8909) (SKIPSEPRCODES 8911 . 9991) (SKIPSEPRS 9993 . 10379) (SKREAD 10381 . 
-12328)) (12376 20985 (CL:READ 12386 . 12935) (CL:READ-PRESERVING-WHITESPACE 12937 . 13659) (
-CL:READ-DELIMITED-LIST 13661 . 14576) (CL:PARSE-INTEGER 14578 . 20983)) (21078 33555 (RSTRING 21088 . 
-21820) (READ-EXTENDED-TOKEN 21822 . 25694) (\RSTRING2 25696 . 33553)) (33591 64324 (\TOP-LEVEL-READ 
-33601 . 35584) (\SUBREAD 35586 . 60740) (\SUBREADCONCAT 60742 . 61365) (\ORIG-READ.SYMBOL 61367 . 
-62435) (\ORIG-INVALID.SYMBOL 62437 . 63336) (\APPLYREADMACRO 63338 . 63754) (INREADMACROP 63756 . 
-64322)) (64483 64658 (READQUOTE 64493 . 64656)) (64683 76587 (READVBAR 64693 . 66024) (READHASHMACRO 
-66026 . 71836) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71838 . 72058) (DIGITBASEP 72060 . 72794) (
-READNUMBERINBASE 72796 . 74682) (ESTIMATE-DIMENSIONALITY 74684 . 75009) (SKIP.HASH.COMMENT 75011 . 
-75979) (CMLREAD.FEATURE.PARSER 75981 . 76585)) (76631 77897 (CHARACTER.READ 76641 . 77895)) (77930 
-93404 (CHARCODE.DECODE 77940 . 83109) (CHARCODE.ENCODE 83111 . 87553) (CHARCODEP 87555 . 88008) (
-CHARSET.DECODE 88010 . 88958) (CHARCODE.ENCODE 88960 . 93402)) (93405 97901 (HEXNUM? 93415 . 95758) (
-OCTALNUM? 95760 . 96573) (HEXSTRING 96575 . 97899)))))
+  (FILEMAP (NIL (3870 12314 (LASTC 3880 . 4186) (PEEKC 4188 . 4576) (PEEKCCODE 4578 . 4989) (RATOM 4991
+ . 6072) (READ 6074 . 6634) (READC 6636 . 7277) (READCCODE 7279 . 8038) (READP 8040 . 8592) (
+SETREADMACROFLG 8594 . 8893) (SKIPSEPRCODES 8895 . 9975) (SKIPSEPRS 9977 . 10363) (SKREAD 10365 . 
+12312)) (12360 20969 (CL:READ 12370 . 12919) (CL:READ-PRESERVING-WHITESPACE 12921 . 13643) (
+CL:READ-DELIMITED-LIST 13645 . 14560) (CL:PARSE-INTEGER 14562 . 20967)) (21062 33539 (RSTRING 21072 . 
+21804) (READ-EXTENDED-TOKEN 21806 . 25678) (\RSTRING2 25680 . 33537)) (33575 64308 (\TOP-LEVEL-READ 
+33585 . 35568) (\SUBREAD 35570 . 60724) (\SUBREADCONCAT 60726 . 61349) (\ORIG-READ.SYMBOL 61351 . 
+62419) (\ORIG-INVALID.SYMBOL 62421 . 63320) (\APPLYREADMACRO 63322 . 63738) (INREADMACROP 63740 . 
+64306)) (64467 64642 (READQUOTE 64477 . 64640)) (64667 76571 (READVBAR 64677 . 66008) (READHASHMACRO 
+66010 . 71820) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71822 . 72042) (DIGITBASEP 72044 . 72778) (
+READNUMBERINBASE 72780 . 74666) (ESTIMATE-DIMENSIONALITY 74668 . 74993) (SKIP.HASH.COMMENT 74995 . 
+75963) (CMLREAD.FEATURE.PARSER 75965 . 76569)) (76615 77881 (CHARACTER.READ 76625 . 77879)) (77914 
+93464 (CHARCODE.DECODE 77924 . 83093) (CHARCODE.ENCODE 83095 . 87537) (CHARCODEP 87539 . 88068) (
+CHARSET.DECODE 88070 . 89018) (CHARCODE.ENCODE 89020 . 93462)) (93465 97961 (HEXNUM? 93475 . 95818) (
+OCTALNUM? 95820 . 96633) (HEXSTRING 96635 . 97959)))))
 STOP

sources/VANILLADISK

@@ -1,62 +1,68 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "17-May-90 16:13:16" |{DSK}<usr>local>lde>lispcore>sources>VANILLADISK.;2|
 5292   
 
-      |changes| |to:|  (VARS VANILLADISKCOMS)
+
(FILECREATED "24-Aug-2025 11:50:09" 
+|{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>VANILLADISK.;3|
 5267   
 
-      |previous| |date:| " 7-Apr-88 17:53:38" |{DSK}<usr>local>lde>lispcore>sources>VANILLADISK.;1|
-)
+      :EDIT-BY |rmk|
 
+      :CHANGES-TO (FNS \\VANILLADISKINIT)
+
+      :PREVIOUS-DATE "17-May-90 16:13:16" 
+|{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>VANILLADISK.;2|)
 
-; Copyright (c) 1985, 1986, 1988, 1990 by Venue & Xerox Corporation.  All rights reserved.
 
 (PRETTYCOMPRINT VANILLADISKCOMS)
 
 (RPAQQ VANILLADISKCOMS
 ((FNS \\VANILLADISKINIT \\VANILLAHOSTNAMEP \\VANILLAEVENTFN)
-                            (INITVARS (\\PSEUDODSK))
-                            (GLOBALVARS \\PSEUDODSK \\DISKNAMECASEARRAY)
-                            (DECLARE\: DONTEVAL@LOAD (P (\\VANILLADISKINIT)))
-                            (LOCALVARS . T)))
+                        (INITVARS (\\PSEUDODSK))
+                        (GLOBALVARS \\PSEUDODSK \\DISKNAMECASEARRAY)
+                        (DECLARE\: DONTEVAL@LOAD (P (\\VANILLADISKINIT)))
+                        (LOCALVARS . T)))
 (DEFINEQ
 
-(\\vanilladiskinit

-  (lambda nil
                                            (* |bvm:| "30-Jan-85 21:43")

-    (prog ((arr (copyarray uppercasearray)))
-          (* * |Set| |up| |array| |that| |maps| |illegal| |filename| |chars| |to| 0 
-
        |and| |synonymous| |characters| |to| \a |canonical| |char|)

-          (|for|
 i |from|
 0 |to|
 (sub1 (charcode 0)) |do|
 (setcasearray arr i 0))
+(\\VANILLADISKINIT

+  (LAMBDA NIL
                                               (* \; "Edited 24-Aug-2025 11:49 by rmk")

+                                                             (* |bvm:| "30-Jan-85 21:43")

+    (PROG ((ARR (COPYARRAY UPPERCASEARRAY)))
+
+         (* * |Set| |up| |array| |that| |maps| |illegal| |filename| |chars| |to| 0 |and| 
+
         |synonymous| |characters| |to| \a |canonical| |char|)

+
+          (|for|
 I |from|
 0 |to|
 (SUB1 (CHARCODE 0)) |do|
 (SETCASEARRAY ARR I 0))
                                                              (* |Non-printing| |characters| 
-
                                                           |verboten|)

-          (|for|
 i |from|
 (add1 (charcode 9)) |to|
 (sub1 (charcode a))
-             |do|
 (setcasearray arr i 0))
-          (|for|
 i |from|
 (add1 (charcode z)) |to|
 (sub1 (charcode \a))
-             |do|
 (setcasearray arr i 0))
-          (|for|
 i |from|
 (add1 (charcode \z)) |to|
 \\maxchar
-             |do|
 (setcasearray arr i 0))
-          (setcasearray arr (charcode \;)
-                 (charcode \;))
-          (setcasearray arr (charcode !)
-                 (charcode \;))
-          (setcasearray arr (charcode *
)
-                 (charcode *
))
-          (setcasearray arr (charcode escape)
-                 (charcode *
))
-          (setcasearray arr (charcode ?)
-                 (charcode \#))
-          (setcasearray arr (charcode \.)
-                 (charcode \.))
-          (setcasearray arr (charcode -
)
-                 (charcode -
))
-          (setcasearray arr (charcode +)
-                 (charcode +))
-          (setcasearray arr (charcode $)
-                 (charcode $))
-          (setq \\disknamecasearray arr))
-          (* * |Define| \a |device| |whose| |sole| |purpose| |is| |to| |select| |the| 
-
        |appropriate| dsk |device| |depending| |on| |which| |machine| |you're| |on|)

-    (\\definedevice nil (|create|
 fdev
-                               devicename _ "VANILLADISK"
-                               eventfn _ (function nill)
-                               hostnamep _ (function \\vanillahostnamep)))))
+
                                                             |verboten|)

+          (|for|
 I |from|
 (ADD1 (CHARCODE 9)) |to|
 (SUB1 (CHARCODE A))
+             |do|
 (SETCASEARRAY ARR I 0))
+          (|for|
 I |from|
 (ADD1 (CHARCODE Z)) |to|
 (SUB1 (CHARCODE \a))
+             |do|
 (SETCASEARRAY ARR I 0))
+          (|for|
 I |from|
 (ADD1 (CHARCODE \z)) |to|
 \\MAXTHINCHAR |do|
 (SETCASEARRAY ARR I 0))
+          (SETCASEARRAY ARR (CHARCODE \;)
+                 (CHARCODE \;))
+          (SETCASEARRAY ARR (CHARCODE !)
+                 (CHARCODE \;))
+          (SETCASEARRAY ARR (CHARCODE *
)
+                 (CHARCODE *
))
+          (SETCASEARRAY ARR (CHARCODE ESCAPE)
+                 (CHARCODE *
))
+          (SETCASEARRAY ARR (CHARCODE ?)
+                 (CHARCODE \#))
+          (SETCASEARRAY ARR (CHARCODE \.)
+                 (CHARCODE \.))
+          (SETCASEARRAY ARR (CHARCODE -
)
+                 (CHARCODE -
))
+          (SETCASEARRAY ARR (CHARCODE +)
+                 (CHARCODE +))
+          (SETCASEARRAY ARR (CHARCODE $)
+                 (CHARCODE $))
+          (SETQ \\DISKNAMECASEARRAY ARR))
+
+         (* * |Define| \a |device| |whose| |sole| |purpose| |is| |to| |select| |the| 
+
         |appropriate| DSK |device| |depending| |on| |which| |machine| |you're| |on|)

+
+    (\\DEFINEDEVICE NIL (|create|
 FDEV
+                               DEVICENAME _ "VANILLADISK"
+                               EVENTFN _ (FUNCTION NILL)
+                               HOSTNAMEP _ (FUNCTION \\VANILLAHOSTNAMEP)))))
 
 (\\vanillahostnamep

   (lambda (name)
                                     (* \; "Edited  7-Apr-88 17:20 by masinter")


@@ -115,8 +121,7 @@
 
 (LOCALVARS . T)
 )
-(PUTPROPS VANILLADISK COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1988 1990))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (784 4970 (\\VANILLADISKINIT 794 . 2901) (\\VANILLAHOSTNAMEP 2903 . 4547) (
-\\VANILLAEVENTFN 4549 . 4968)))))
+  (FILEMAP (NIL (736 5028 (\\VANILLADISKINIT 746 . 2959) (\\VANILLAHOSTNAMEP 2961 . 4605) (
+\\VANILLAEVENTFN 4607 . 5026)))))
 STOP