FILEIO: stream records detected EOL, also RENAMEFILE uses COPYBYTES

UFS doesn't check file devices identity, doesn't give type-change message. Recompiled for create stream
Interlisp · Dec 18, 2024 · fa97aa6 · fa97aa6
1 parent eb09861
commit fa97aa6
Show file tree

Hide file tree

Showing 4 changed files with 153 additions and 109 deletions.
diff --git a/sources/FILEIO b/sources/FILEIO
@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED "17-Dec-2024 16:07:42" {MEDLEY}<sources>FILEIO.;2 165071 
+(FILECREATED "17-Dec-2024 16:36:44" {WMEDLEY}<sources>FILEIO.;136 165961 
 
       :EDIT-BY rmk
 
       :CHANGES-TO (RECORDS STREAM)
 
-      :PREVIOUS-DATE "15-Jul-2024 22:29:54" {MEDLEY}<sources>FILEIO.;1)
+      :PREVIOUS-DATE "17-Dec-2024 15:11:51" {WMEDLEY}<sources>FILEIO.;135)
 
 
 (PRETTYCOMPRINT FILEIOCOMS)
@@ -150,10 +150,9 @@
        '(WORD WORD FLAG (BITS 3)
               POINTER BYTE BYTE WORD WORD WORD FLAG FLAG FLAG FLAG POINTER FLAG FLAG FLAG FLAG 
               POINTER FLAG (BITS 2)
-              FLAG POINTER POINTER POINTER WORD WORD (BITS 2)
-              POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD POINTER POINTER POINTER 
-              POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER 
-              POINTER POINTER)
+              FLAG POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER POINTER POINTER WORD 
+              WORD WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
+              WORD WORD POINTER POINTER POINTER POINTER POINTER (BITS 2))
        '((STREAM 0 (BITS . 15))
          (STREAM 1 (BITS . 15))
          (STREAM 2 (FLAGBITS . 0))
@@ -182,7 +181,6 @@
          (STREAM 16 POINTER)
          (STREAM 18 (BITS . 15))
          (STREAM 19 (BITS . 15))
-         (STREAM 16 (BITS . 1))
          (STREAM 20 POINTER)
          (STREAM 22 POINTER)
          (STREAM 24 POINTER)
@@ -207,7 +205,8 @@
          (STREAM 56 POINTER)
          (STREAM 58 POINTER)
          (STREAM 60 POINTER)
-         (STREAM 62 POINTER))
+         (STREAM 62 POINTER)
+         (STREAM 62 (BITS . 1)))
        '64)
 )
 (ADDTOVAR SYSTEMRECLST
@@ -240,7 +239,6 @@
                   (EPAGE POINTER)
                   (EOFFSET WORD)
                   (LINELENGTH WORD)
-                  (DETECTEDEOLCONVENTION BITS 2)
                   (F1 POINTER)
                   (F2 POINTER)
                   (F3 POINTER)
@@ -265,7 +263,8 @@
                   (INCCODEFN POINTER)
                   (PEEKCCODEFN POINTER)
                   (BACKCCODEFN POINTER)
-                  (EXTERNALFORMAT POINTER)))
+                  (EXTERNALFORMAT POINTER)
+                  (DETECTEDEOLCONVENTION BITS 2)))
 )
 (DECLARE%: DONTCOPY 
 (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
@@ -322,7 +321,6 @@
            (EOFFSET WORD)                                    (* ; "Page, byte offset of eof")
            (LINELENGTH WORD)                                 (* ; 
                                                      "LINELENGTH of stream, or -1 for no line length")
-           (DETECTEDEOLCONVENTION BITS 2)                    (* ; "For input files (particularly if read with ANY.EOLD, the byte convention used for the first EOL seen on the file. Value ANY.EOLC means EOL not seen yet")
 
            (* ;; "----Following are device-specific fields----")
 
@@ -361,7 +359,9 @@
            (INCCODEFN POINTER)                               (* ; "Set by \EXTERNALFORMAT")
            (PEEKCCODEFN POINTER)
            (BACKCCODEFN POINTER)
-           (EXTERNALFORMAT POINTER))
+           (EXTERNALFORMAT POINTER)
+           (DETECTEDEOLCONVENTION BITS 2)                    (* ; "For input files (particularly if read with ANY.EOLD, the byte convention used for the first EOL seen on the file. Value ANY.EOLC means EOL not seen yet")
+           )
           (BLOCKRECORD STREAM ((NIL 2 WORD)
                                (UCODEFLAGS1 BITS 1)
 
@@ -414,10 +414,9 @@
        '(WORD WORD FLAG (BITS 3)
               POINTER BYTE BYTE WORD WORD WORD FLAG FLAG FLAG FLAG POINTER FLAG FLAG FLAG FLAG 
               POINTER FLAG (BITS 2)
-              FLAG POINTER POINTER POINTER WORD WORD (BITS 2)
-              POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD POINTER POINTER POINTER 
-              POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER 
-              POINTER POINTER)
+              FLAG POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER POINTER POINTER WORD 
+              WORD WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
+              WORD WORD POINTER POINTER POINTER POINTER POINTER (BITS 2))
        '((STREAM 0 (BITS . 15))
          (STREAM 1 (BITS . 15))
          (STREAM 2 (FLAGBITS . 0))
@@ -446,7 +445,6 @@
          (STREAM 16 POINTER)
          (STREAM 18 (BITS . 15))
          (STREAM 19 (BITS . 15))
-         (STREAM 16 (BITS . 1))
          (STREAM 20 POINTER)
          (STREAM 22 POINTER)
          (STREAM 24 POINTER)
@@ -471,7 +469,8 @@
          (STREAM 56 POINTER)
          (STREAM 58 POINTER)
          (STREAM 60 POINTER)
-         (STREAM 62 POINTER))
+         (STREAM 62 POINTER)
+         (STREAM 62 (BITS . 1)))
        '64)
 (DECLARE%: EVAL@COMPILE 
 
@@ -1512,12 +1511,22 @@
     (FOR FN IN STREAM-AFTER-OPEN-FNS DO (APPLY* FN STREAM ACCESS PARAMETERS])
 
 (\RENAMEFILE
-  [LAMBDA (OLDFILE NEWFILE)                              (* hdj " 7-May-86 12:22")
+  [LAMBDA (OLDFILE NEWFILE)                                  (* ; "Edited 16-Dec-2024 21:07 by rmk")
+                                                             (* hdj " 7-May-86 12:22")
     (SETQ OLDFILE (\ADD.CONNECTED.DIR OLDFILE))
     (SETQ NEWFILE (\ADD.CONNECTED.DIR NEWFILE))
-    (LET ((OLD-DEVICE (\GETDEVICEFROMNAME OLDFILE T))
-          (NEW-DEVICE (\GETDEVICEFROMNAME NEWFILE T)))
-         (AND OLD-DEVICE (FDEVOP 'RENAMEFILE OLD-DEVICE OLD-DEVICE OLDFILE NEW-DEVICE NEWFILE])
+
+    (* ;; "\GETDEVICEFROMNAME errors if the devices don't exist")
+
+    (LET ((OLD-DEVICE (TRUEDEVICE (\GETDEVICEFROMNAME OLDFILE NIL T)))
+          (NEW-DEVICE (TRUEDEVICE (\GETDEVICEFROMNAME NEWFILE NIL T)))
+          NEWFULLNAME)
+         (CL:WHEN (SETQ NEWFULLNAME (FDEVOP 'RENAMEFILE OLD-DEVICE OLD-DEVICE (TRUEFILENAME OLDFILE)
+                                           NEW-DEVICE
+                                           (TRUEFILENAME NEWFILE)))
+             (CL:IF (PSEUDOHOSTP NEWFILE)
+                 (PSEUDOFILENAME NEWFULLNAME)
+                 NEWFULLNAME))])
 
 (\REVALIDATEFILE
   [LAMBDA (STREAM)                                       (* bvm%: "30-DEC-81 17:45")
@@ -2633,30 +2642,38 @@ update the map")
            (add OFF 1])
 
 (\GENERIC.RENAMEFILE
-  [LAMBDA (OLDDEVICE OLDFILE NEWDEVICE NEWFILE)          (* ; "Edited  2-Jul-90 16:03 by nm")
-    (if (NOT (FDEVOP 'OPENP OLDDEVICE (FULLNAME OLDFILE)
-                        NIL OLDDEVICE))
-        then (RESETLST
-                     [RESETSAVE [SETQ OLDFILE (OPENSTREAM OLDFILE 'INPUT 'OLD '((SEQUENTIAL T)
-                                                                                DON'TCACHE]
-                            '(AND RESETSTATE (CLOSEF? OLDVALUE]
-                     [COND
-                        ((SETQ NEWFILE (\COPYOPENFILE OLDFILE NEWFILE))
-                         (if (\DELETEFILE (CLOSEF OLDFILE))
-                             then NEWFILE
-                           else (CONDITIONS:RESTART-CASE (CL:ERROR 
-                                                                    '
-                                                             XCL::FS-RENAMEFILE-SOURCE-COULDNT-DELETE
-                                                                    :PATHNAME OLDFILE)
-                                           (DELETE-DESTINATION NIL :CONDITION 
-                                                  XCL::FS-RENAMEFILE-SOURCE-COULDNT-DELETE :REPORT 
-                                                  "Delete the destination file too." (DELFILE NEWFILE
-                                                                                            )
-                                                  NIL)
-                                           (DONT-DELETE-DESTINATION NIL :CONDITION 
-                                                  XCL::FS-RENAMEFILE-SOURCE-COULDNT-DELETE :REPORT 
+  [LAMBDA (OLDDEVICE OLDFILE NEWDEVICE NEWFILE)              (* ; "Edited 16-Dec-2024 21:52 by rmk")
+
+    (* ;; "Names and devices are true, not pseudo")
+                                                             (* ; "Edited  2-Jul-90 16:03 by nm")
+    (CL:UNLESS (FDEVOP 'OPENP OLDDEVICE (FULLNAME OLDFILE)
+                      NIL OLDDEVICE)                         (* ; "Can't rename an open file")
+        (RESETLST
+            [LET (INSTREAM OUTSTREAM)
+                 [RESETSAVE [SETQ INSTREAM (OPENSTREAM OLDFILE 'INPUT 'OLD '((SEQUENTIAL T)
+                                                                             (DON'TCACHE T]
+                        '(PROGN (CLOSEF? OLDVALUE]
+                 [RESETSAVE [SETQ OUTSTREAM (OPENSTREAM NEWFILE 'OUTPUT 'NEW
+                                                   `((SEQUENTIAL T)
+                                                     (DON'TCACHE T)
+                                                     (CREATIONDATE ,(GETFILEINFO OLDFILE 
+                                                                           'CREATIONDATE]
+                        '(AND RESETSTATE (SETQ OLDVALUE (CLOSEF OLDVALUE))
+                              (DELFILE OLDVALUE]
+                 (COPYBYTES INSTREAM OUTSTREAM)
+                 (CLOSEF OUTSTREAM)
+                 (if (\DELETEFILE (CLOSEF INSTREAM))
+                     then (FULLNAME OUTSTREAM)
+                   else (CONDITIONS:RESTART-CASE (CL:ERROR 'XCL::FS-RENAMEFILE-SOURCE-COULDNT-DELETE
+                                                        :PATHNAME OLDFILE)
+                               (DELETE-DESTINATION NIL :CONDITION 
+                                      XCL::FS-RENAMEFILE-SOURCE-COULDNT-DELETE :REPORT 
+                                      "Delete the destination file too." (DELFILE NEWFILE)
+                                      NIL)
+                               (DONT-DELETE-DESTINATION NIL :CONDITION 
+                                      XCL::FS-RENAMEFILE-SOURCE-COULDNT-DELETE :REPORT 
                          "Don't delete the destination file.  Just returns the destination filename."
-                                                  NEWFILE])])
+                                      NEWFILE]))])
 
 (\GENERIC.OPENP
   [LAMBDA (FILENAME ACCESS DEVICE)                       (* hdj " 6-Oct-86 17:07")
@@ -3143,39 +3160,39 @@ update the map")
 (ADDTOVAR LAMA \IS.NOT.RANDACCESSP \ILLEGAL.DEVICEOP STREAMPROP)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (28126 32242 (STREAMPROP 28136 . 28570) (GETSTREAMPROP 28572 . 29321) (PUTSTREAMPROP 
-29323 . 32090) (STREAMP 32092 . 32240)) (32285 35664 (\DEFPRINT.BY.NAME 32295 . 33447) (
-\STREAM.DEFPRINT 33449 . 35357) (\FDEV.DEFPRINT 35359 . 35662)) (35922 40963 (\GETACCESS 35932 . 36386
-) (\SETACCESS 36388 . 40961)) (61189 67158 (\DEFINEDEVICE 61199 . 63515) (\GETDEVICEFROMNAME 63517 . 
-63990) (\GETDEVICEFROMHOSTNAME 63992 . 65036) (\REMOVEDEVICE 65038 . 66161) (\REMOVEDEVICE.NAMES 66163
- . 67156)) (67198 93852 (\CLOSEFILE 67208 . 68033) (\DELETEFILE 68035 . 68329) (\DEVICEEVENT 68331 . 
-70101) (\GENERATEFILES 70103 . 71050) (\GENERATENEXTFILE 71052 . 71703) (\GENERATEFILEINFO 71705 . 
-72166) (\GETFILENAME 72168 . 72557) (\GENERIC.OUTFILEP 72559 . 73029) (\OPENFILE 73031 . 75609) (
-\DO.PARAMS.AT.OPEN 75611 . 79262) (\RENAMEFILE 79264 . 79688) (\REVALIDATEFILE 79690 . 82292) (
-\PAGED.REVALIDATEFILELST 82294 . 83852) (\PAGED.REVALIDATEFILES 83854 . 85573) (\PAGED.REVALIDATEFILE 
-85575 . 87858) (\BUFFERED.REVALIDATEFILE 87860 . 90146) (\BUFFERED.REVALIDATEFILELST 90148 . 91332) (
-\PRINT-REVALIDATION-RESULT 91334 . 92176) (\TRUNCATEFILE 92178 . 92569) (\FILE-CONFLICT 92571 . 93850)
-) (93888 98551 (\GENERATENOFILES 93898 . 95994) (\NULLFILEGENERATOR 95996 . 96240) (\NOFILESNEXTFILEFN
- 96242 . 98233) (\NOFILESINFOFN 98235 . 98549)) (98670 100578 (\FILE.NOT.OPEN 98680 . 99193) (
-\FILE.WONT.OPEN 99195 . 99523) (\ILLEGAL.DEVICEOP 99525 . 99807) (\IS.NOT.RANDACCESSP 99809 . 100255) 
-(\STREAM.NOT.OPEN 100257 . 100576)) (100713 103011 (\FDEVINSTANCE 100723 . 103009)) (104213 111587 (
-CNDIR 104223 . 105528) (DIRECTORYNAME 105530 . 109713) (DIRECTORYNAMEP 109715 . 110331) (HOSTNAMEP 
-110333 . 111140) (\ADD.CONNECTED.DIR 111142 . 111585)) (111632 139911 (\BACKFILEPTR 111642 . 111830) (
-\BACKPEEKBIN 111832 . 112193) (\BACKBIN 112195 . 112546) (BIN 112548 . 112765) (\BIN 112767 . 113044) 
-(\BINS 113046 . 113332) (BOUT 113334 . 113696) (\BOUT 113698 . 114013) (\BOUTS 114015 . 114326) (
-COPYBYTES 114328 . 117660) (COPYCHARS 117662 . 121328) (COPYFILE 121330 . 122394) (\COPYOPENFILE 
-122396 . 125595) (\INFER.FILE.TYPE 125597 . 126551) (EOFP 126553 . 126850) (FORCEOUTPUT 126852 . 
-127099) (\FLUSH.OPEN.STREAMS 127101 . 127457) (CHARSET 127459 . 128818) (ACCESS-CHARSET 128820 . 
-129348) (GETEOFPTR 129350 . 129600) (GETFILEINFO 129602 . 132795) (\TYPE.FROM.FILETYPE 132797 . 133267
-) (\FILETYPE.FROM.TYPE 133269 . 133448) (GETFILEPTR 133450 . 133702) (SETFILEINFO 133704 . 137810) (
-SETFILEPTR 137812 . 139531) (BOUT16 139533 . 139718) (BIN16 139720 . 139909)) (140014 146668 (
-\GENERIC.BINS 140024 . 140304) (\GENERIC.BOUTS 140306 . 140571) (\GENERIC.RENAMEFILE 140573 . 142404) 
-(\GENERIC.OPENP 142406 . 143721) (\GENERIC.READP 143723 . 144875) (\GENERIC.CHARSET 144877 . 146666)) 
-(146669 147008 (\MAP-OPEN-STREAMS 146679 . 147006)) (148863 150943 (\EOF.ACTION 148873 . 149124) (
-\EOSERROR 149126 . 149319) (\GETEOFPTR 149321 . 149503) (\INCFILEPTR 149505 . 149855) (\PEEKBIN 149857
- . 150048) (\SETCLOSEDFILELENGTH 150050 . 150384) (\SETEOFPTR 150386 . 150574) (\SETFILEPTR 150576 . 
-150941)) (150944 151486 (\FIXPOUT 150954 . 151254) (\FIXPIN 151256 . 151484)) (151487 152053 (\BOUTEOL
- 151497 . 152051)) (154949 164813 (\BUFFERED.BIN 154959 . 155811) (\BUFFERED.PEEKBIN 155813 . 156595) 
-(\BUFFERED.BOUT 156597 . 157457) (\BUFFERED.BINS 157459 . 161144) (\BUFFERED.BOUTS 161146 . 162947) (
-\BUFFERED.COPYBYTES 162949 . 164811)))))
+  (FILEMAP (NIL (28114 32230 (STREAMPROP 28124 . 28558) (GETSTREAMPROP 28560 . 29309) (PUTSTREAMPROP 
+29311 . 32078) (STREAMP 32080 . 32228)) (32273 35652 (\DEFPRINT.BY.NAME 32283 . 33435) (
+\STREAM.DEFPRINT 33437 . 35345) (\FDEV.DEFPRINT 35347 . 35650)) (35910 40951 (\GETACCESS 35920 . 36374
+) (\SETACCESS 36376 . 40949)) (61177 67146 (\DEFINEDEVICE 61187 . 63503) (\GETDEVICEFROMNAME 63505 . 
+63978) (\GETDEVICEFROMHOSTNAME 63980 . 65024) (\REMOVEDEVICE 65026 . 66149) (\REMOVEDEVICE.NAMES 66151
+ . 67144)) (67186 94325 (\CLOSEFILE 67196 . 68021) (\DELETEFILE 68023 . 68317) (\DEVICEEVENT 68319 . 
+70089) (\GENERATEFILES 70091 . 71038) (\GENERATENEXTFILE 71040 . 71691) (\GENERATEFILEINFO 71693 . 
+72154) (\GETFILENAME 72156 . 72545) (\GENERIC.OUTFILEP 72547 . 73017) (\OPENFILE 73019 . 75597) (
+\DO.PARAMS.AT.OPEN 75599 . 79250) (\RENAMEFILE 79252 . 80161) (\REVALIDATEFILE 80163 . 82765) (
+\PAGED.REVALIDATEFILELST 82767 . 84325) (\PAGED.REVALIDATEFILES 84327 . 86046) (\PAGED.REVALIDATEFILE 
+86048 . 88331) (\BUFFERED.REVALIDATEFILE 88333 . 90619) (\BUFFERED.REVALIDATEFILELST 90621 . 91805) (
+\PRINT-REVALIDATION-RESULT 91807 . 92649) (\TRUNCATEFILE 92651 . 93042) (\FILE-CONFLICT 93044 . 94323)
+) (94361 99024 (\GENERATENOFILES 94371 . 96467) (\NULLFILEGENERATOR 96469 . 96713) (\NOFILESNEXTFILEFN
+ 96715 . 98706) (\NOFILESINFOFN 98708 . 99022)) (99143 101051 (\FILE.NOT.OPEN 99153 . 99666) (
+\FILE.WONT.OPEN 99668 . 99996) (\ILLEGAL.DEVICEOP 99998 . 100280) (\IS.NOT.RANDACCESSP 100282 . 100728
+) (\STREAM.NOT.OPEN 100730 . 101049)) (101186 103484 (\FDEVINSTANCE 101196 . 103482)) (104686 112060 (
+CNDIR 104696 . 106001) (DIRECTORYNAME 106003 . 110186) (DIRECTORYNAMEP 110188 . 110804) (HOSTNAMEP 
+110806 . 111613) (\ADD.CONNECTED.DIR 111615 . 112058)) (112105 140384 (\BACKFILEPTR 112115 . 112303) (
+\BACKPEEKBIN 112305 . 112666) (\BACKBIN 112668 . 113019) (BIN 113021 . 113238) (\BIN 113240 . 113517) 
+(\BINS 113519 . 113805) (BOUT 113807 . 114169) (\BOUT 114171 . 114486) (\BOUTS 114488 . 114799) (
+COPYBYTES 114801 . 118133) (COPYCHARS 118135 . 121801) (COPYFILE 121803 . 122867) (\COPYOPENFILE 
+122869 . 126068) (\INFER.FILE.TYPE 126070 . 127024) (EOFP 127026 . 127323) (FORCEOUTPUT 127325 . 
+127572) (\FLUSH.OPEN.STREAMS 127574 . 127930) (CHARSET 127932 . 129291) (ACCESS-CHARSET 129293 . 
+129821) (GETEOFPTR 129823 . 130073) (GETFILEINFO 130075 . 133268) (\TYPE.FROM.FILETYPE 133270 . 133740
+) (\FILETYPE.FROM.TYPE 133742 . 133921) (GETFILEPTR 133923 . 134175) (SETFILEINFO 134177 . 138283) (
+SETFILEPTR 138285 . 140004) (BOUT16 140006 . 140191) (BIN16 140193 . 140382)) (140487 147558 (
+\GENERIC.BINS 140497 . 140777) (\GENERIC.BOUTS 140779 . 141044) (\GENERIC.RENAMEFILE 141046 . 143294) 
+(\GENERIC.OPENP 143296 . 144611) (\GENERIC.READP 144613 . 145765) (\GENERIC.CHARSET 145767 . 147556)) 
+(147559 147898 (\MAP-OPEN-STREAMS 147569 . 147896)) (149753 151833 (\EOF.ACTION 149763 . 150014) (
+\EOSERROR 150016 . 150209) (\GETEOFPTR 150211 . 150393) (\INCFILEPTR 150395 . 150745) (\PEEKBIN 150747
+ . 150938) (\SETCLOSEDFILELENGTH 150940 . 151274) (\SETEOFPTR 151276 . 151464) (\SETFILEPTR 151466 . 
+151831)) (151834 152376 (\FIXPOUT 151844 . 152144) (\FIXPIN 152146 . 152374)) (152377 152943 (\BOUTEOL
+ 152387 . 152941)) (155839 165703 (\BUFFERED.BIN 155849 . 156701) (\BUFFERED.PEEKBIN 156703 . 157485) 
+(\BUFFERED.BOUT 157487 . 158347) (\BUFFERED.BINS 158349 . 162034) (\BUFFERED.BOUTS 162036 . 163837) (
+\BUFFERED.COPYBYTES 163839 . 165701)))))
 STOP
diff --git a/sources/FILEIO.LCOM b/sources/FILEIO.LCOM