Remove calls to openfile (#1333)
* Remove calls to OPENFILE OPENFILE is a residual Interlisp function that returns a litatom instead of a stream. In almost all cases, this immediate causes an error that litatom files are no longer supported. I have found (FINDCALLERS) all the examples in lispusers/sources/library/ and replaced OPENFILE with OPENSTREAM (except for the calls from \PEEKPUP and \PEEKNS, that I didn't track down). There was a trivai call in COMPILE.FILECHECK in COMPILE, but that function is not called anywhere. So I removed it. * ADIR: remove OPENFILE calls, also another stab at \COPYSYS With respect to \COPYSYS, this replaces the draft PR #1263. This applies TRUEFILENAME at the start, but remembers whether it was in fact a pseudohost and restores that for the return value. So if you start in a pseudo world you end up there. --------- Co-authored-by: Larry Masinter <lmm@acm.org>
This commit is contained in:
rmkaplan
GitHub
117
sources/ADIR
117
sources/ADIR
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "11-May-2023 21:39:25" {DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>ADIR.;2 65907
|
||||
(FILECREATED "14-Sep-2023 23:20:17" {WMEDLEY}<sources>ADIR.;30 67297
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS OPENFILE)
|
||||
:CHANGES-TO (FNS \COPYSYS)
|
||||
|
||||
:PREVIOUS-DATE "31-Oct-2022 23:50:03"
|
||||
{DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>ADIR.;1)
|
||||
:PREVIOUS-DATE "14-Sep-2023 22:56:19" {WMEDLEY}<sources>ADIR.;29)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT ADIRCOMS)
|
||||
@@ -79,16 +78,18 @@
|
||||
(\GETFILENAME X RECOG])
|
||||
|
||||
(INFILE
|
||||
[LAMBDA (FILE) (* rmk%: " 3-OCT-79 14:23")
|
||||
(INPUT (OPENFILE FILE 'INPUT 'OLD])
|
||||
[LAMBDA (FILE) (* ; "Edited 14-Sep-2023 22:40 by rmk")
|
||||
(* rmk%: " 3-OCT-79 14:23")
|
||||
(INPUT (OPENSTREAM FILE 'INPUT 'OLD])
|
||||
|
||||
(INFILEP
|
||||
[LAMBDA (FILE) (* rmk%: " 9-OCT-79 22:39")
|
||||
(\GETFILENAME FILE 'OLD])
|
||||
|
||||
(IOFILE
|
||||
[LAMBDA (FILE) (* rmk%: " 5-SEP-81 13:54")
|
||||
(OPENFILE FILE 'BOTH 'OLD])
|
||||
[LAMBDA (FILE) (* ; "Edited 14-Sep-2023 22:56 by rmk")
|
||||
(* rmk%: " 5-SEP-81 13:54")
|
||||
(OPENSTREAM FILE 'BOTH 'OLD])
|
||||
|
||||
(OPENFILE
|
||||
[LAMBDA (FILE ACCESS RECOG PARAMETERS OPTIONAL) (* ; "Edited 11-May-2023 21:05 by lmm")
|
||||
@@ -167,8 +168,9 @@
|
||||
(RETURN STREAM])
|
||||
|
||||
(OUTFILE
|
||||
[LAMBDA (FILE) (* rmk%: " 3-OCT-79 14:24")
|
||||
(OUTPUT (OPENFILE FILE 'OUTPUT 'NEW])
|
||||
[LAMBDA (FILE) (* ; "Edited 13-Sep-2023 17:59 by rmk")
|
||||
(* rmk%: " 3-OCT-79 14:24")
|
||||
(OUTPUT (OPENSTREAM FILE 'OUTPUT 'NEW])
|
||||
|
||||
(OUTFILEP
|
||||
[LAMBDA (FILE) (* rmk%: " 9-OCT-79 22:39")
|
||||
@@ -195,50 +197,69 @@
|
||||
(fetch (IFPAGE NActivePages) of \InterfacePage])
|
||||
|
||||
(\COPYSYS
|
||||
[LAMBDA (FILE SYSNAME DONTSAVE) (* ; "Edited 31-Oct-2022 23:49 by rmk")
|
||||
[LAMBDA (FILE SYSNAME DONTSAVE) (* ; "Edited 14-Sep-2023 23:19 by rmk")
|
||||
(* ; "Edited 3-Jul-2023 19:21 by rmk")
|
||||
(* ; "Edited 1-Jul-2023 12:34 by rmk")
|
||||
(* ; "Edited 29-Jun-2023 11:41 by rmk")
|
||||
(* ; "Edited 31-Oct-2022 23:49 by rmk")
|
||||
(* ; "Edited 16-Mar-2021 19:46 by larry")
|
||||
(PROG (FULLNAME VAL TFILE THOST)
|
||||
(PROG (TEMPNAME VAL TARGETFILE TARGETHOST PSEUDOHOSTP)
|
||||
RETRY
|
||||
(SETQ FILE (PACKFILENAME.STRING 'BODY FILE 'BODY "WORK.SYSOUT" 'BODY \CONNECTED.DIRECTORY))
|
||||
(SETQ TFILE (TRUEFILENAME FILE))
|
||||
[SELECTQ [SETQ THOST (U-CASE (FILENAMEFIELD TFILE 'HOST]
|
||||
(DSK [SETQ FULLNAME (PACKFILENAME.STRING 'HOST THOST 'NAME 'tmp 'EXTENSION 'SYSOUT
|
||||
|
||||
|
||||
(* ;; "RMK: Get the full target name, including version in particular for DSK, at the outset so we know what the RENAMEFILE will do and we can return that value.")
|
||||
|
||||
(* ;; "We try to make the temp file on the same device, so that the RENAMEFILE (hopefully) won't do a copy. ")
|
||||
|
||||
(* ;; "The reason for all this fooling around is because \FLUSHVM doesn't like version numbers.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Perhaps we should also check the value of RENAMEFILE to make sure it succeeded?")
|
||||
|
||||
(SETQ FILE (OUTFILEP (PACKFILENAME.STRING 'BODY FILE 'BODY "WORK.SYSOUT" 'BODY
|
||||
\CONNECTED.DIRECTORY)))
|
||||
(SETQ PSEUDOHOSTP (PSEUDOHOSTP FILE)) (* ;
|
||||
"In order to return the expected name at the end.")
|
||||
(SETQ TARGETFILE (TRUEFILENAME FILE))
|
||||
[SELECTQ [SETQ TARGETHOST (U-CASE (FILENAMEFIELD TARGETFILE 'HOST]
|
||||
(DSK [SETQ TEMPNAME (PACKFILENAME.STRING 'HOST TARGETHOST 'NAME 'tmp 'EXTENSION
|
||||
'SYSOUT
|
||||
'BODY
|
||||
(\UFS.RECOGNIZE.FILE TFILE 'NON (\GETDEVICEFROMNAME THOST]
|
||||
(SETQ VAL (\FLUSHVM FULLNAME))
|
||||
(SETQ FULLNAME (RENAMEFILE FULLNAME FILE)))
|
||||
(UNIX [SETQ FULLNAME (CONCAT "{" THOST "}" (\UFS.RECOGNIZE.FILE TFILE 'NON (
|
||||
\GETDEVICEFROMNAME
|
||||
THOST]
|
||||
(\UFS.RECOGNIZE.FILE TARGETFILE 'NON (\GETDEVICEFROMNAME
|
||||
TARGETHOST]
|
||||
(SETQ VAL (\FLUSHVM TEMPNAME)))
|
||||
(UNIX [SETQ TEMPNAME (CONCAT "{" TARGETHOST "}" (\UFS.RECOGNIZE.FILE TARGETFILE
|
||||
'NON
|
||||
(\GETDEVICEFROMNAME TARGETHOST]
|
||||
(* ; "\DOFLUSHVM ")
|
||||
(SETQ VAL (\FLUSHVM FULLNAME))
|
||||
(SETQ FULLNAME (RENAMEFILE FULLNAME FILE)))
|
||||
(SETQ VAL (\FLUSHVM TEMPNAME)))
|
||||
(PROGN (SETQ VAL (\FLUSHVM))
|
||||
(LET ((UNIXVAR (UNIX-GETENV "LDEDESTSYSOUT")))
|
||||
(LET ((LDEDEST (UNIX-GETENV "LDEDESTSYSOUT")))
|
||||
(* ;
|
||||
"\FLSUVM saves image to Unix enviroment var or lisp.virtualmem")
|
||||
(SETQ FULLNAME (COPYFILE (COND
|
||||
(UNIXVAR (CONCAT "{DSK}" UNIXVAR))
|
||||
"\FLUSHVM saves image to Unix enviroment var or lisp.virtualmem. LDEDEST is assumed to be DSK??")
|
||||
(SETQ TEMPNAME (COPYFILE (COND
|
||||
(LDEDEST (CONCAT "{DSK}" LDEDEST))
|
||||
(T "{DSK}~/lisp.virtualmem"))
|
||||
FILE
|
||||
TARGETFILE
|
||||
'((TYPE BINARY]
|
||||
(COND
|
||||
((NULL VAL)
|
||||
|
||||
(* ;; "First clause of OR is T when resuming this vmem; second is starting the sysout. Unless \COPYSYS1 itself does a \FLUSHVM, the second never returns T, yes? NIL is normal return (continuing in same image), <fixp> is error return")
|
||||
(* ; "Continuing in the current image")
|
||||
((NULL VAL) (* ; "Continuing in the current image")
|
||||
(CL:WHEN TARGETFILE (RENAMEFILE TEMPNAME TARGETFILE))
|
||||
(\DAYTIME0 \LASTUSERACTION)
|
||||
(RETURN FULLNAME))
|
||||
(RETURN (CL:IF PSEUDOHOSTP
|
||||
(PSEUDOFILENAME TARGETFILE)
|
||||
TARGETFILE)))
|
||||
((AND (SMALLP VAL)
|
||||
(IGREATERP 0 VAL)) (* ;
|
||||
"Error occurred while making sysout.")
|
||||
(LISPERROR (IMINUS VAL)
|
||||
FULLNAME)
|
||||
TEMPNAME)
|
||||
(GO RETRY))
|
||||
(T (* ; "Starting sysout")
|
||||
(T (* ; "Restarting sysout")
|
||||
(\CLEARSYSBUF T) (* ; "Get rid of any spurious typeahead")
|
||||
(\RESETKEYBOARD) (* ; "Enable keyhandler")
|
||||
(RETURN (LIST FULLNAME])
|
||||
(RETURN (LIST (OR FILE TEMPNAME])
|
||||
|
||||
(\FLUSHVM
|
||||
[LAMBDA (MAIKO.SYSOUTFILE) (* ; "Edited 16-Mar-2021 10:59 by larry")
|
||||
@@ -1229,14 +1250,14 @@
|
||||
(ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3175 14373 (DELFILE 3185 . 3346) (FULLNAME 3348 . 3715) (INFILE 3717 . 3865) (INFILEP
|
||||
3867 . 4002) (IOFILE 4004 . 4144) (OPENFILE 4146 . 4449) (OPENSTREAM 4451 . 8791) (OUTFILE 8793 . 8944
|
||||
) (OUTFILEP 8946 . 9082) (RENAMEFILE 9084 . 9390) (SIMPLE.FINDFILE 9392 . 9802) (VMEMSIZE 9804 . 9971)
|
||||
(\COPYSYS 9973 . 13092) (\FLUSHVM 13094 . 14166) (\LOGOUT0 14168 . 14371)) (14831 36736 (
|
||||
UNPACKFILENAME.STRING 14841 . 34115) (\UPF.DIRECTORY 34117 . 36734)) (38264 40936 (UNPACKFILENAME
|
||||
38274 . 38460) (LASTCHPOS 38462 . 39156) (FILENAMEFIELD 39158 . 39643) (FILENAMEFIELD.STRING 39645 .
|
||||
40224) (PACKFILENAME 40226 . 40569) (PACKFILENAME.STRING 40571 . 40934)) (55406 56319 (
|
||||
FILEDIRCASEARRAY 55416 . 56317)) (56486 63666 (LOGOUT 56496 . 57413) (MAKESYS 57415 . 59044) (SYSOUT
|
||||
59046 . 60598) (SAVEVM 60600 . 61400) (HERALD 61402 . 61562) (INTERPRET.REM.CM 61564 . 63289) (
|
||||
\USEREVENT 63291 . 63664)) (63848 65575 (USERNAME 63858 . 64814) (SETUSERNAME 64816 . 65573)))))
|
||||
(FILEMAP (NIL (3106 15763 (DELFILE 3116 . 3277) (FULLNAME 3279 . 3646) (INFILE 3648 . 3907) (INFILEP
|
||||
3909 . 4044) (IOFILE 4046 . 4297) (OPENFILE 4299 . 4602) (OPENSTREAM 4604 . 8944) (OUTFILE 8946 . 9208
|
||||
) (OUTFILEP 9210 . 9346) (RENAMEFILE 9348 . 9654) (SIMPLE.FINDFILE 9656 . 10066) (VMEMSIZE 10068 .
|
||||
10235) (\COPYSYS 10237 . 14482) (\FLUSHVM 14484 . 15556) (\LOGOUT0 15558 . 15761)) (16221 38126 (
|
||||
UNPACKFILENAME.STRING 16231 . 35505) (\UPF.DIRECTORY 35507 . 38124)) (39654 42326 (UNPACKFILENAME
|
||||
39664 . 39850) (LASTCHPOS 39852 . 40546) (FILENAMEFIELD 40548 . 41033) (FILENAMEFIELD.STRING 41035 .
|
||||
41614) (PACKFILENAME 41616 . 41959) (PACKFILENAME.STRING 41961 . 42324)) (56796 57709 (
|
||||
FILEDIRCASEARRAY 56806 . 57707)) (57876 65056 (LOGOUT 57886 . 58803) (MAKESYS 58805 . 60434) (SYSOUT
|
||||
60436 . 61988) (SAVEVM 61990 . 62790) (HERALD 62792 . 62952) (INTERPRET.REM.CM 62954 . 64679) (
|
||||
\USEREVENT 64681 . 65054)) (65238 66965 (USERNAME 65248 . 66204) (SETUSERNAME 66206 . 66963)))))
|
||||
STOP
|
||||
|
||||
Reference in New Issue
Block a user