github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-26 04:08:08 +00:00
Code Issues Projects Releases Wiki Activity

Remove calls to openfile (#1333)

Browse Source 
* 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
2023-10-17 21:54:17 -07:00
committed by GitHub
parent 9273cffce2
commit 50dc0a9269
20 changed files with 990 additions and 432 deletions
Download Patch File Download Diff File Expand all files Collapse all files

131
sources/CMLCOMPILE
View File

@@ -1,20 +1,48 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 2-Jul-90 20:24:02" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>CMLCOMPILE.;7| 21037
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS COMPILE-FILE-EXPRESSION FAKE-COMPILE-FILE COMPILE-FILE-SCAN-FIRST)
(FILECREATED "24-Sep-2023 14:11:25" {WMEDLEY}<sources>CMLCOMPILE.;2 22597
previous date%: "30-Jun-90 18:55:12" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>CMLCOMPILE.;6|)
:EDIT-BY rmk
:CHANGES-TO (FNS COMPILE-IN-CORE)
:PREVIOUS-DATE " 2-Jul-90 20:24:02" {WMEDLEY}<sources>CMLCOMPILE.;1)
(* ; "
Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1985-1987, 1990 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT CMLCOMPILECOMS)
(RPAQQ CMLCOMPILECOMS ((COMS (FUNCTIONS CL:DISASSEMBLE) (FNS FAKE-COMPILE-FILE INTERLISP-FORMAT-P INTERLISP-NLAMBDA-FUNCTION-P COMPILE-FILE-EXPRESSION COMPILE-FILE-WALK-FUNCTION ARGTYPE.STATE COMPILE.CHECK.ARGTYPE COMPILE.FILE.DEFINEQ COMPILE-FILE-SETF-SYMBOL-FUNCTION COMPILE-FILE-EX/IMPORT COMPILE.FILE.APPLY COMPILE.FILE.RESET COMPILE-IN-CORE) (FNS COMPILE-FILE-SCAN-FIRST) (* ; "This function is support for AR#11185") (VARS ARGTYPE.VARS) (PROP COMPILE-FILE-EXPRESSION DEFINEQ * SETF-SYMBOL-FUNCTION PRETTYCOMPRINT) (FUNCTIONS COMPILE-FILE-DECLARE%:)) (COMS (FNS NEWDEFC) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD (QUOTE NEWDEFC) (QUOTE DEFC))))) (PROP FILETYPE CMLCOMPILE) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA FAKE-COMPILE-FILE)))))
(RPAQQ CMLCOMPILECOMS
[(COMS (FUNCTIONS CL:DISASSEMBLE)
(FNS FAKE-COMPILE-FILE INTERLISP-FORMAT-P INTERLISP-NLAMBDA-FUNCTION-P
COMPILE-FILE-EXPRESSION COMPILE-FILE-WALK-FUNCTION ARGTYPE.STATE
COMPILE.CHECK.ARGTYPE COMPILE.FILE.DEFINEQ COMPILE-FILE-SETF-SYMBOL-FUNCTION
COMPILE-FILE-EX/IMPORT COMPILE.FILE.APPLY COMPILE.FILE.RESET COMPILE-IN-CORE)
(FNS COMPILE-FILE-SCAN-FIRST)
(* ;
 "This function is support for AR#11185")
(VARS ARGTYPE.VARS)
(PROP COMPILE-FILE-EXPRESSION DEFINEQ * SETF-SYMBOL-FUNCTION PRETTYCOMPRINT)
(FUNCTIONS COMPILE-FILE-DECLARE%:))
[COMS (FNS NEWDEFC)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD 'NEWDEFC 'DEFC]
(PROP FILETYPE CMLCOMPILE)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA FAKE-COMPILE-FILE])
(CL:DEFUN CL:DISASSEMBLE (NAME-OR-COMPILED-FUNCTION &KEY LEVEL-P (RADIX 8) (OUTPUT *STANDARD-OUTPUT*) FIRST-BYTE MARKED-PC) (PRINTCODE (if (CCODEP NAME-OR-COMPILED-FUNCTION) then NAME-OR-COMPILED-FUNCTION else (CL:COMPILE NIL (if (CL:SYMBOLP NAME-OR-COMPILED-FUNCTION) then (CL:SYMBOL-FUNCTION NAME-OR-COMPILED-FUNCTION) else NAME-OR-COMPILED-FUNCTION))) LEVEL-P RADIX OUTPUT FIRST-BYTE MARKED-PC))
(CL:DEFUN CL:DISASSEMBLE (NAME-OR-COMPILED-FUNCTION &KEY LEVEL-P (RADIX 8)
(OUTPUT *STANDARD-OUTPUT*)
FIRST-BYTE MARKED-PC)
(PRINTCODE (if (CCODEP NAME-OR-COMPILED-FUNCTION)
then NAME-OR-COMPILED-FUNCTION
else (CL:COMPILE NIL (if (CL:SYMBOLP NAME-OR-COMPILED-FUNCTION)
then (CL:SYMBOL-FUNCTION NAME-OR-COMPILED-FUNCTION)
else NAME-OR-COMPILED-FUNCTION)))
LEVEL-P RADIX OUTPUT FIRST-BYTE MARKED-PC))
(DEFINEQ
(FAKE-COMPILE-FILE
@@ -132,18 +160,24 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r
(COMPILE-IN-CORE
[LAMBDA (fn-name fn-expr fn-type NOSAVE)
(DECLARE (SPECVARS LCFIL LAPFLG STRF SVFLG LSTFIL SPECVARS LOCALVARS DONT-TRANSFER-PUTD))
(* ; "Edited 24-Sep-2023 14:11 by rmk")
(* lmm " 2-Jun-86 22:04")
(* ;; "in-core compiling for functions and forms, without the interview. if X is a list, we assume that we are being called merely to display the lap and machine code. the form is compiled as the definition of FOO but the compiled CODE is thrown away. --- if X is a litatom, then saving, redefining, and printing is controlled by the flags.")
(* in-core compiling for functions and forms, without the interview.
 if X is a list, we assume that we are being called merely to display the lap
 and machine code. the form is compiled as the definition of FOO but the
 compiled :CODE is thrown away. -
 if X is a litatom, then saving, redefining, and printing is controlled by the
 flags.)
 if X is a list, we assume that we are being called merely to display the lap and
 machine code. the form is compiled as the definition of FOO but the compiled
 :CODE is thrown away. -
 if X is a litatom, then saving, redefining, and printing is controlled by the
 flags.)
(LET ((NOREDEFINE NIL)
(PRINTLAP NIL)
(DONT-TRANSFER-PUTD T))
(* ;; "RMK: Is it really worth saving NULLFILE from one invocation to the next?")
(RESETVARS [(NLAMA NLAMA)
(NLAML NLAML)
(LAMS LAMS)
@@ -155,10 +189,9 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r
(STREAMP NULLFILE)
(OPENP NULLFILE))
NULLFILE)
(T (SETQ NULLFILE (OPENFILE '{NULL} 'OUTPUT]
(RETURN (RESETLST (* RESETLST to provide reset context
 for macros under COMPILE1 as
 generated e.g. by DECL.)
(T (SETQ NULLFILE (OPENSTREAM '{NULL} 'OUTPUT]
(RETURN (RESETLST (* ;
 "RESETLST to provide reset context for macros under COMPILE1 as generated e.g. by DECL.")
[PROG ((LCFIL)
[LAPFLG (AND PRINTLAP (COND
(BYTECOMPFLG T)
@@ -186,17 +219,46 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r
(* ; "This function is support for AR#11185")
(RPAQQ ARGTYPE.VARS ((1 NLAML "NLAMBDA spread") (2 LAMA "LAMBDA nospread") (0 LAMS "LAMBDA spread") (3 NLAMA "NLAMBDA no-spread")))
(RPAQQ ARGTYPE.VARS ((1 NLAML "NLAMBDA spread")
(2 LAMA "LAMBDA nospread")
(0 LAMS "LAMBDA spread")
(3 NLAMA "NLAMBDA no-spread")))
(PUTPROPS DEFINEQ COMPILE-FILE-EXPRESSION COMPILE.FILE.DEFINEQ)
(PUTPROPS DEFINEQ COMPILE-FILE-EXPRESSION COMPILE.FILE.DEFINEQ)
(PUTPROPS * COMPILE-FILE-EXPRESSION NILL)
(PUTPROPS * COMPILE-FILE-EXPRESSION NILL)
(PUTPROPS SETF-SYMBOL-FUNCTION COMPILE-FILE-EXPRESSION COMPILE-FILE-SETF-SYMBOL-FUNCTION)
(PUTPROPS SETF-SYMBOL-FUNCTION COMPILE-FILE-EXPRESSION COMPILE-FILE-SETF-SYMBOL-FUNCTION)
(PUTPROPS PRETTYCOMPRINT COMPILE-FILE-EXPRESSION NILL)
(PUTPROPS PRETTYCOMPRINT COMPILE-FILE-EXPRESSION NILL)
(CL:DEFUN COMPILE-FILE-DECLARE%: (FORM COMPILED.FILE EVAL@COMPILE DOCOPY DEFER) (CL:DO ((TAIL (CDR FORM) (CDR TAIL))) ((CL:ENDP TAIL)) (CL:IF (CL:SYMBOLP (CAR TAIL)) (CASE (CAR TAIL) ((EVAL@LOAD DOEVAL@LOAD DONTEVAL@LOAD) NIL) ((EVAL@LOADWHEN) (CL:POP TAIL)) ((EVAL@COMPILE DOEVAL@COMPILE) (SETQ EVAL@COMPILE T)) ((DONTEVAL@COMPILE) (SETQ EVAL@COMPILE NIL)) ((EVAL@COMPILEWHEN) (SETQ EVAL@COMPILE (EVAL (CAR (SETQ TAIL (CDR TAIL)))))) ((COPY DOCOPY) (SETQ DOCOPY T)) ((DONTCOPY) (SETQ DOCOPY NIL)) ((COPYWHEN) (SETQ DOCOPY (EVAL (CAR (SETQ TAIL (CDR TAIL)))))) ((FIRST)) ((NOTFIRST COMPILERVARS)) (CL:OTHERWISE (CL:FORMAT COUTFILE "Warning: Ignoring unrecognized DECLARE: tag: ~S~%%" (CAR TAIL)))) (COND ((EQ (QUOTE DECLARE%:) (CAR (CAR TAIL))) (COMPILE-FILE-DECLARE%: (CAR TAIL) COMPILED.FILE EVAL@COMPILE DOCOPY DEFER)) (T (CL:WHEN EVAL@COMPILE (EVAL (CAR TAIL))) (CL:WHEN DOCOPY (COMPILE-FILE-EXPRESSION (CAR TAIL) COMPILED.FILE EVAL@COMPILE DEFER)))))))
(CL:DEFUN COMPILE-FILE-DECLARE%: (FORM COMPILED.FILE EVAL@COMPILE DOCOPY DEFER)
(CL:DO ((TAIL (CDR FORM)
(CDR TAIL)))
((CL:ENDP TAIL))
(CL:IF (CL:SYMBOLP (CAR TAIL))
(CASE (CAR TAIL)
((EVAL@LOAD DOEVAL@LOAD DONTEVAL@LOAD) NIL)
((EVAL@LOADWHEN) (CL:POP TAIL))
((EVAL@COMPILE DOEVAL@COMPILE) (SETQ EVAL@COMPILE T))
((DONTEVAL@COMPILE) (SETQ EVAL@COMPILE NIL))
((EVAL@COMPILEWHEN) [SETQ EVAL@COMPILE (EVAL (CAR (SETQ TAIL (CDR TAIL])
((COPY DOCOPY) (SETQ DOCOPY T))
((DONTCOPY) (SETQ DOCOPY NIL))
((COPYWHEN) [SETQ DOCOPY (EVAL (CAR (SETQ TAIL (CDR TAIL])
((FIRST) )
((NOTFIRST COMPILERVARS) )
(CL:OTHERWISE (CL:FORMAT COUTFILE "Warning: Ignoring unrecognized DECLARE: tag: ~S~%%"
(CAR TAIL))))
[COND
((EQ 'DECLARE%: (CAR (CAR TAIL)))
(COMPILE-FILE-DECLARE%: (CAR TAIL)
COMPILED.FILE EVAL@COMPILE DOCOPY DEFER))
(T (CL:WHEN EVAL@COMPILE
(EVAL (CAR TAIL)))
(CL:WHEN DOCOPY
(COMPILE-FILE-EXPRESSION (CAR TAIL)
COMPILED.FILE EVAL@COMPILE DEFER))])))
(DEFINEQ
(NEWDEFC
@@ -228,25 +290,26 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(MOVD (QUOTE NEWDEFC) (QUOTE DEFC))
(MOVD 'NEWDEFC 'DEFC)
)
(PUTPROPS CMLCOMPILE FILETYPE CL:COMPILE-FILE)
(PUTPROPS CMLCOMPILE FILETYPE CL:COMPILE-FILE)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA)
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA FAKE-COMPILE-FILE)
(ADDTOVAR LAMA FAKE-COMPILE-FILE)
)
(PUTPROPS CMLCOMPILE COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1675 16480 (FAKE-COMPILE-FILE 1685 . 5121) (INTERLISP-FORMAT-P 5123 . 5341) (
INTERLISP-NLAMBDA-FUNCTION-P 5343 . 5577) (COMPILE-FILE-EXPRESSION 5579 . 8929) (
COMPILE-FILE-WALK-FUNCTION 8931 . 9178) (ARGTYPE.STATE 9180 . 9340) (COMPILE.CHECK.ARGTYPE 9342 .
11334) (COMPILE.FILE.DEFINEQ 11336 . 11829) (COMPILE-FILE-SETF-SYMBOL-FUNCTION 11831 . 12425) (
COMPILE-FILE-EX/IMPORT 12427 . 12755) (COMPILE.FILE.APPLY 12757 . 13017) (COMPILE.FILE.RESET 13019 .
13880) (COMPILE-IN-CORE 13882 . 16478)) (16481 18210 (COMPILE-FILE-SCAN-FIRST 16491 . 18208)) (19612
20676 (NEWDEFC 19622 . 20674)))))
(FILEMAP (NIL (1636 2253 (CL:DISASSEMBLE 1636 . 2253)) (2254 17523 (FAKE-COMPILE-FILE 2264 . 5700) (
INTERLISP-FORMAT-P 5702 . 5920) (INTERLISP-NLAMBDA-FUNCTION-P 5922 . 6156) (COMPILE-FILE-EXPRESSION
6158 . 9508) (COMPILE-FILE-WALK-FUNCTION 9510 . 9757) (ARGTYPE.STATE 9759 . 9919) (
COMPILE.CHECK.ARGTYPE 9921 . 11913) (COMPILE.FILE.DEFINEQ 11915 . 12408) (
COMPILE-FILE-SETF-SYMBOL-FUNCTION 12410 . 13004) (COMPILE-FILE-EX/IMPORT 13006 . 13334) (
COMPILE.FILE.APPLY 13336 . 13596) (COMPILE.FILE.RESET 13598 . 14459) (COMPILE-IN-CORE 14461 . 17521))
(17524 19253 (COMPILE-FILE-SCAN-FIRST 17534 . 19251)) (19796 21163 (COMPILE-FILE-DECLARE%: 19796 .
21163)) (21164 22228 (NEWDEFC 21174 . 22226)))))
STOP