Skip to content

Commit 20d6a5d

Browse files
rmkaplanrmkaplan
committed
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.
1 parent 3ee91c5 commit 20d6a5d

File tree

2 files changed

+69
-48
lines changed

2 files changed

+69
-48
lines changed

‎sources/ADIR‎

Lines changed: 69 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,12 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
22

3-
(FILECREATED "11-May-2023 21:39:25" {DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>ADIR.;2 65907
3+
(FILECREATED "14-Sep-2023 23:20:17" {WMEDLEY}<sources>ADIR.;30 67297
44

5-
:EDIT-BY "lmm"
5+
:EDIT-BY rmk
66

7-
:CHANGES-TO (FNS OPENFILE)
7+
:CHANGES-TO (FNS \COPYSYS)
88

9-
:PREVIOUS-DATE "31-Oct-2022 23:50:03"
10-
{DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>ADIR.;1)
9+
:PREVIOUS-DATE "14-Sep-2023 22:56:19" {WMEDLEY}<sources>ADIR.;29)
1110

1211

1312
(PRETTYCOMPRINT ADIRCOMS)
@@ -79,16 +78,18 @@
7978
(\GETFILENAME X RECOG])
8079

8180
(INFILE
82-
[LAMBDA (FILE) (* rmk%: " 3-OCT-79 14:23")
83-
(INPUT (OPENFILE FILE 'INPUT 'OLD])
81+
[LAMBDA (FILE) (* ; "Edited 14-Sep-2023 22:40 by rmk")
82+
(* rmk%: " 3-OCT-79 14:23")
83+
(INPUT (OPENSTREAM FILE 'INPUT 'OLD])
8484

8585
(INFILEP
8686
[LAMBDA (FILE) (* rmk%: " 9-OCT-79 22:39")
8787
(\GETFILENAME FILE 'OLD])
8888

8989
(IOFILE
90-
[LAMBDA (FILE) (* rmk%: " 5-SEP-81 13:54")
91-
(OPENFILE FILE 'BOTH 'OLD])
90+
[LAMBDA (FILE) (* ; "Edited 14-Sep-2023 22:56 by rmk")
91+
(* rmk%: " 5-SEP-81 13:54")
92+
(OPENSTREAM FILE 'BOTH 'OLD])
9293

9394
(OPENFILE
9495
[LAMBDA (FILE ACCESS RECOG PARAMETERS OPTIONAL) (* ; "Edited 11-May-2023 21:05 by lmm")
@@ -167,8 +168,9 @@
167168
(RETURN STREAM])
168169

169170
(OUTFILE
170-
[LAMBDA (FILE) (* rmk%: " 3-OCT-79 14:24")
171-
(OUTPUT (OPENFILE FILE 'OUTPUT 'NEW])
171+
[LAMBDA (FILE) (* ; "Edited 13-Sep-2023 17:59 by rmk")
172+
(* rmk%: " 3-OCT-79 14:24")
173+
(OUTPUT (OPENSTREAM FILE 'OUTPUT 'NEW])
172174

173175
(OUTFILEP
174176
[LAMBDA (FILE) (* rmk%: " 9-OCT-79 22:39")
@@ -195,50 +197,69 @@
195197
(fetch (IFPAGE NActivePages) of \InterfacePage])
196198

197199
(\COPYSYS
198-
[LAMBDA (FILE SYSNAME DONTSAVE) (* ; "Edited 31-Oct-2022 23:49 by rmk")
200+
[LAMBDA (FILE SYSNAME DONTSAVE) (* ; "Edited 14-Sep-2023 23:19 by rmk")
201+
(* ; "Edited 3-Jul-2023 19:21 by rmk")
202+
(* ; "Edited 1-Jul-2023 12:34 by rmk")
203+
(* ; "Edited 29-Jun-2023 11:41 by rmk")
204+
(* ; "Edited 31-Oct-2022 23:49 by rmk")
199205
(* ; "Edited 16-Mar-2021 19:46 by larry")
200-
(PROG (FULLNAME VAL TFILE THOST)
206+
(PROG (TEMPNAME VAL TARGETFILE TARGETHOST PSEUDOHOSTP)
201207
RETRY
202-
(SETQ FILE (PACKFILENAME.STRING 'BODY FILE 'BODY "WORK.SYSOUT" 'BODY \CONNECTED.DIRECTORY))
203-
(SETQ TFILE (TRUEFILENAME FILE))
204-
[SELECTQ [SETQ THOST (U-CASE (FILENAMEFIELD TFILE 'HOST]
205-
(DSK [SETQ FULLNAME (PACKFILENAME.STRING 'HOST THOST 'NAME 'tmp 'EXTENSION 'SYSOUT
208+
209+
210+
(* ;; "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.")
211+
212+
(* ;; "We try to make the temp file on the same device, so that the RENAMEFILE (hopefully) won't do a copy. ")
213+
214+
(* ;; "The reason for all this fooling around is because \FLUSHVM doesn't like version numbers.")
215+
216+
(* ;; "")
217+
218+
(* ;; "Perhaps we should also check the value of RENAMEFILE to make sure it succeeded?")
219+
220+
(SETQ FILE (OUTFILEP (PACKFILENAME.STRING 'BODY FILE 'BODY "WORK.SYSOUT" 'BODY
221+
\CONNECTED.DIRECTORY)))
222+
(SETQ PSEUDOHOSTP (PSEUDOHOSTP FILE)) (* ;
223+
 "In order to return the expected name at the end.")
224+
(SETQ TARGETFILE (TRUEFILENAME FILE))
225+
[SELECTQ [SETQ TARGETHOST (U-CASE (FILENAMEFIELD TARGETFILE 'HOST]
226+
(DSK [SETQ TEMPNAME (PACKFILENAME.STRING 'HOST TARGETHOST 'NAME 'tmp 'EXTENSION
227+
'SYSOUT
206228
'BODY
207-
(\UFS.RECOGNIZE.FILE TFILE 'NON (\GETDEVICEFROMNAME THOST]
208-
(SETQ VAL (\FLUSHVM FULLNAME))
209-
(SETQ FULLNAME (RENAMEFILE FULLNAME FILE)))
210-
(UNIX [SETQ FULLNAME (CONCAT "{" THOST "}" (\UFS.RECOGNIZE.FILE TFILE 'NON (
211-
\GETDEVICEFROMNAME
212-
THOST]
229+
(\UFS.RECOGNIZE.FILE TARGETFILE 'NON (\GETDEVICEFROMNAME
230+
TARGETHOST]
231+
(SETQ VAL (\FLUSHVM TEMPNAME)))
232+
(UNIX [SETQ TEMPNAME (CONCAT "{" TARGETHOST "}" (\UFS.RECOGNIZE.FILE TARGETFILE
233+
'NON
234+
(\GETDEVICEFROMNAME TARGETHOST]
213235
(* ; "\DOFLUSHVM ")
214-
(SETQ VAL (\FLUSHVM FULLNAME))
215-
(SETQ FULLNAME (RENAMEFILE FULLNAME FILE)))
236+
(SETQ VAL (\FLUSHVM TEMPNAME)))
216237
(PROGN (SETQ VAL (\FLUSHVM))
217-
(LET ((UNIXVAR (UNIX-GETENV "LDEDESTSYSOUT")))
238+
(LET ((LDEDEST (UNIX-GETENV "LDEDESTSYSOUT")))
218239
(* ;
219-
 "\FLSUVM saves image to Unix enviroment var or lisp.virtualmem")
220-
(SETQ FULLNAME (COPYFILE (COND
221-
(UNIXVAR (CONCAT "{DSK}" UNIXVAR))
240+
 "\FLUSHVM saves image to Unix enviroment var or lisp.virtualmem. LDEDEST is assumed to be DSK??")
241+
(SETQ TEMPNAME (COPYFILE (COND
242+
(LDEDEST (CONCAT "{DSK}" LDEDEST))
222243
(T "{DSK}~/lisp.virtualmem"))
223-
FILE
244+
TARGETFILE
224245
'((TYPE BINARY]
225246
(COND
226-
((NULL VAL)
227-
228-
(* ;; "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")
229-
(* ; "Continuing in the current image")
247+
((NULL VAL) (* ; "Continuing in the current image")
248+
(CL:WHEN TARGETFILE (RENAMEFILE TEMPNAME TARGETFILE))
230249
(\DAYTIME0 \LASTUSERACTION)
231-
(RETURN FULLNAME))
250+
(RETURN (CL:IF PSEUDOHOSTP
251+
(PSEUDOFILENAME TARGETFILE)
252+
TARGETFILE)))
232253
((AND (SMALLP VAL)
233254
(IGREATERP 0 VAL)) (* ;
234255
 "Error occurred while making sysout.")
235256
(LISPERROR (IMINUS VAL)
236-
FULLNAME)
257+
TEMPNAME)
237258
(GO RETRY))
238-
(T (* ; "Starting sysout")
259+
(T (* ; "Restarting sysout")
239260
(\CLEARSYSBUF T) (* ; "Get rid of any spurious typeahead")
240261
(\RESETKEYBOARD) (* ; "Enable keyhandler")
241-
(RETURN (LIST FULLNAME])
262+
(RETURN (LIST (OR FILE TEMPNAME])
242263

243264
(\FLUSHVM
244265
[LAMBDA (MAIKO.SYSOUTFILE) (* ; "Edited 16-Mar-2021 10:59 by larry")
@@ -1229,14 +1250,14 @@
12291250
(ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME)
12301251
)
12311252
(DECLARE%: DONTCOPY
1232-
(FILEMAP (NIL (3175 14373 (DELFILE 3185 . 3346) (FULLNAME 3348 . 3715) (INFILE 3717 . 3865) (INFILEP
1233-
3867 . 4002) (IOFILE 4004 . 4144) (OPENFILE 4146 . 4449) (OPENSTREAM 4451 . 8791) (OUTFILE 8793 . 8944
1234-
) (OUTFILEP 8946 . 9082) (RENAMEFILE 9084 . 9390) (SIMPLE.FINDFILE 9392 . 9802) (VMEMSIZE 9804 . 9971)
1235-
(\COPYSYS 9973 . 13092) (\FLUSHVM 13094 . 14166) (\LOGOUT0 14168 . 14371)) (14831 36736 (
1236-
UNPACKFILENAME.STRING 14841 . 34115) (\UPF.DIRECTORY 34117 . 36734)) (38264 40936 (UNPACKFILENAME
1237-
38274 . 38460) (LASTCHPOS 38462 . 39156) (FILENAMEFIELD 39158 . 39643) (FILENAMEFIELD.STRING 39645 .
1238-
40224) (PACKFILENAME 40226 . 40569) (PACKFILENAME.STRING 40571 . 40934)) (55406 56319 (
1239-
FILEDIRCASEARRAY 55416 . 56317)) (56486 63666 (LOGOUT 56496 . 57413) (MAKESYS 57415 . 59044) (SYSOUT
1240-
59046 . 60598) (SAVEVM 60600 . 61400) (HERALD 61402 . 61562) (INTERPRET.REM.CM 61564 . 63289) (
1241-
\USEREVENT 63291 . 63664)) (63848 65575 (USERNAME 63858 . 64814) (SETUSERNAME 64816 . 65573)))))
1253+
(FILEMAP (NIL (3106 15763 (DELFILE 3116 . 3277) (FULLNAME 3279 . 3646) (INFILE 3648 . 3907) (INFILEP
1254+
3909 . 4044) (IOFILE 4046 . 4297) (OPENFILE 4299 . 4602) (OPENSTREAM 4604 . 8944) (OUTFILE 8946 . 9208
1255+
) (OUTFILEP 9210 . 9346) (RENAMEFILE 9348 . 9654) (SIMPLE.FINDFILE 9656 . 10066) (VMEMSIZE 10068 .
1256+
10235) (\COPYSYS 10237 . 14482) (\FLUSHVM 14484 . 15556) (\LOGOUT0 15558 . 15761)) (16221 38126 (
1257+
UNPACKFILENAME.STRING 16231 . 35505) (\UPF.DIRECTORY 35507 . 38124)) (39654 42326 (UNPACKFILENAME
1258+
39664 . 39850) (LASTCHPOS 39852 . 40546) (FILENAMEFIELD 40548 . 41033) (FILENAMEFIELD.STRING 41035 .
1259+
41614) (PACKFILENAME 41616 . 41959) (PACKFILENAME.STRING 41961 . 42324)) (56796 57709 (
1260+
FILEDIRCASEARRAY 56806 . 57707)) (57876 65056 (LOGOUT 57886 . 58803) (MAKESYS 58805 . 60434) (SYSOUT
1261+
60436 . 61988) (SAVEVM 61990 . 62790) (HERALD 62792 . 62952) (INTERPRET.REM.CM 62954 . 64679) (
1262+
\USEREVENT 64681 . 65054)) (65238 66965 (USERNAME 65248 . 66204) (SETUSERNAME 66206 . 66963)))))
12421263
STOP

‎sources/ADIR.LCOM‎

-43 Bytes
Binary file not shown.

0 commit comments

Comments
 (0)