Changed the PACKAGECHAR in the define-file-info readtable to :
This commit is contained in:
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Apr-2025 23:39:10" {WMEDLEY}<sources>BOOTSTRAP.;61 47417
|
||||
(FILECREATED "25-Feb-2026 15:03:24" {WMEDLEY}<sources>BOOTSTRAP.;69 47041
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS PRINT-READER-ENVIRONMENT \DO-DEFINE-FILE-INFO)
|
||||
:CHANGES-TO (FNS MAKE-DEFINE-FILE-INFO-ENV READ-READER-ENVIRONMENT)
|
||||
|
||||
:PREVIOUS-DATE "27-Sep-2021 10:25:31" {WMEDLEY}<sources>BOOTSTRAP.;59)
|
||||
:PREVIOUS-DATE "25-Feb-2026 13:52:00" {WMEDLEY}<sources>BOOTSTRAP.;66)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT BOOTSTRAPCOMS)
|
||||
@@ -365,15 +365,15 @@
|
||||
|
||||
(\LOAD-STREAM
|
||||
[LAMBDA (STREAM LDFLG PRINTFLG LOAD-VERBOSE-STREAM PACKAGE)
|
||||
(DECLARE (SPECVARS LDFLG PRINTFLG LOAD-VERBOSE-STREAM))
|
||||
(* ; "Edited 17-Jul-2021 21:58 by rmk:")
|
||||
(DECLARE (SPECVARS LDFLG PRINTFLG LOAD-VERBOSE-STREAM)) (* ; "Edited 25-Feb-2026 13:46 by rmk")
|
||||
(* ; "Edited 17-Jul-2021 21:58 by rmk:")
|
||||
|
||||
(* ;;; "Internal function that loads from an already open stream. LOAD-VERBOSE-STREAM if non-nil is the stream to which to print %"file created%" messages and such. Similarly, PRINTFLG, if non-nil, is the stream to which to print the value of each expression.")
|
||||
(* ;;; "Internal function that loads from an already open stream. LOAD-VERBOSE-STREAM if non-nil is the stream to which to print %"file created%" messages and such. Similarly, PRINTFLG, if non-nil, is the stream to which to print the value of each expression.")
|
||||
|
||||
(PROG ((*STANDARD-INPUT* STREAM)
|
||||
(FILE (FULLNAME STREAM))
|
||||
(*PACKAGE* *PACKAGE*)
|
||||
(*READTABLE* (PROG1 FILERDTBL (* ; "This initial value important for SKIPSEPRCODES below, but *READTABLE* gets reset appropriately before anything else is read")
|
||||
(*READTABLE* (PROG1 FILERDTBL (* ; "This initial value important for SKIPSEPRCODES below, but *READTABLE* gets reset appropriately before anything else is read")
|
||||
))
|
||||
(DFNFLG DFNFLG)
|
||||
(BUILDMAPFLG BUILDMAPFLG)
|
||||
@@ -385,176 +385,168 @@
|
||||
FILEMAP FNADRLST ROOTNAME TEM FILECREATEDLST LOADA MAYBEWANTFILEMAP INTERLISP-P
|
||||
FILECREATEDLOC)
|
||||
(DECLARE (SPECVARS DFNFLG BUILDMAPFLG FILEPKGFLG ADDSPELLFLG LISPXHIST FILECREATEDLST
|
||||
DEFINEDENV FILECREATEDLOC FILE))
|
||||
DEFINEDENV FILECREATEDLOC FILE))
|
||||
(if (AND LOAD-VERBOSE-STREAM FILE)
|
||||
then (LISPXTERPRI LOAD-VERBOSE-STREAM)
|
||||
(if (NEQ LOAD-VERBOSE-STREAM T)
|
||||
then (* ;
|
||||
"CL:LOAD says to prefix this stuff with comment marker")
|
||||
(PRIN1 "; Loading " LOAD-VERBOSE-STREAM))
|
||||
(* ;
|
||||
"Might use EXEC-FORMAT here except that it isn't defined early in loadup")
|
||||
(LISPXPRIN1 FILE LOAD-VERBOSE-STREAM)
|
||||
(LISPXTERPRI LOAD-VERBOSE-STREAM))
|
||||
(if (NEQ LOAD-VERBOSE-STREAM T)
|
||||
then (* ;
|
||||
"CL:LOAD says to prefix this stuff with comment marker")
|
||||
(PRIN1 "; Loading " LOAD-VERBOSE-STREAM))
|
||||
(* ;
|
||||
"Might use EXEC-FORMAT here except that it isn't defined early in loadup")
|
||||
(LISPXPRIN1 FILE LOAD-VERBOSE-STREAM)
|
||||
(LISPXTERPRI LOAD-VERBOSE-STREAM))
|
||||
(if (EQ (SETQ DFNFLG LDFLG)
|
||||
'SYSLOAD)
|
||||
'SYSLOAD)
|
||||
then (SETQ DFNFLG T)
|
||||
(SETQ ADDSPELLFLG NIL)
|
||||
(SETQ BUILDMAPFLG NIL)
|
||||
(SETQ FILEPKGFLG NIL)
|
||||
(SETQ LISPXHIST NIL))
|
||||
(SETQ ADDSPELLFLG NIL)
|
||||
(SETQ BUILDMAPFLG NIL)
|
||||
(SETQ FILEPKGFLG NIL)
|
||||
(SETQ LISPXHIST NIL))
|
||||
(if LISPXHIST
|
||||
then (* ;
|
||||
"Want UNDOSAVE to keep saving regardless of how many undosaves are involved")
|
||||
(if (SETQ LOADA (FMEMB 'SIDE LISPXHIST))
|
||||
then (FRPLACA (CADR LOADA)
|
||||
-1)
|
||||
else (LISPXPUT 'SIDE (LIST -1)
|
||||
NIL LISPXHIST)))
|
||||
then (* ;
|
||||
"Want UNDOSAVE to keep saving regardless of how many undosaves are involved")
|
||||
(if (SETQ LOADA (FMEMB 'SIDE LISPXHIST))
|
||||
then (FRPLACA (CADR LOADA)
|
||||
-1)
|
||||
else (LISPXPUT 'SIDE (LIST -1)
|
||||
NIL LISPXHIST)))
|
||||
(if (EQ (SETQ TEM (SKIPSEPRCODES STREAM))
|
||||
FASL:SIGNATURE)
|
||||
then (* ;
|
||||
"FASL file handled by FASL loader")
|
||||
(FASL:PROCESS-FILE STREAM)
|
||||
[LET [(MANAGED-FILE-P (GET (SETQ ROOTNAME (ROOTFILENAME FILE T))
|
||||
'FILEDATES]
|
||||
(if (NOT (MEMB FILE LOADEDFILELST))
|
||||
then (* ;
|
||||
"Keep track of every file loaded.")
|
||||
(SETQ LOADEDFILELST (CONS FILE LOADEDFILELST)))
|
||||
(if MANAGED-FILE-P
|
||||
then (if (EQ LDFLG 'SYSLOAD)
|
||||
then
|
||||
FASL:SIGNATURE)
|
||||
then (* ; "FASL file handled by FASL loader")
|
||||
(FASL:PROCESS-FILE STREAM)
|
||||
[LET [(MANAGED-FILE-P (GET (SETQ ROOTNAME (ROOTFILENAME FILE T))
|
||||
'FILEDATES]
|
||||
(if (NOT (MEMB FILE LOADEDFILELST))
|
||||
then (* ; "Keep track of every file loaded.")
|
||||
(SETQ LOADEDFILELST (CONS FILE LOADEDFILELST)))
|
||||
(if MANAGED-FILE-P
|
||||
then (if (EQ LDFLG 'SYSLOAD)
|
||||
then
|
||||
(* ;;
|
||||
"Don't notice DFASL's when you are coming from CL:LOAD, and the user didn't specify a load flag")
|
||||
|
||||
(* ;;
|
||||
"Don't notice DFASL's when you are coming from CL:LOAD, and the user didn't specify a load flag")
|
||||
|
||||
(if (NOT (MEMB ROOTNAME SYSFILES))
|
||||
then (SETQ SYSFILES (NCONC1 SYSFILES
|
||||
ROOTNAME)))
|
||||
(SMASHFILECOMS ROOTNAME)
|
||||
elseif FILEPKGFLG
|
||||
then (ADDFILE ROOTNAME 'Compiled]
|
||||
(RETURN FILE)
|
||||
(if (NOT (MEMB ROOTNAME SYSFILES))
|
||||
then (SETQ SYSFILES (NCONC1 SYSFILES ROOTNAME)))
|
||||
(SMASHFILECOMS ROOTNAME)
|
||||
elseif FILEPKGFLG
|
||||
then (ADDFILE ROOTNAME 'Compiled]
|
||||
(RETURN FILE)
|
||||
elseif (NEQ TEM (CHARCODE "("))
|
||||
then (RETURN (\CML-LOAD STREAM PRINTFLG LOAD-VERBOSE-STREAM PACKAGE)))
|
||||
(if (AND BUILDMAPFLG (RANDACCESSP STREAM))
|
||||
then (SETQ MAYBEWANTFILEMAP T))
|
||||
|
||||
(* ;; "Get the environment from the DEFINE-FILE-INFO expression. This is read in the DEFINE-FILE-INFO-ENVIRONMENT.")
|
||||
(* ;; "Get the environment from the DEFINE-FILE-INFO expression. This is read in the DEFINE-FILE-INFO-ENVIRONMENT.")
|
||||
|
||||
(SETQ DEFINEDENV (READ-READER-ENVIRONMENT STREAM *OLD-INTERLISP-READ-ENVIRONMENT*))
|
||||
(SETQ DEFINEDENV (READ-READER-ENVIRONMENT STREAM))
|
||||
(CL:WHEN PACKAGE
|
||||
|
||||
(* ;; "Caller better really mean it--overrides what's on file! But we don't want to smash what the reader returned, couldbe the old-interlisp-file-env.")
|
||||
(* ;; "Caller better really mean it--overrides what's on file! But we don't want to smash what the reader returned, couldbe the old-interlisp-file-env.")
|
||||
|
||||
[SETQ DEFINEDENV (CREATE READER-ENVIRONMENT USING DEFINEDENV REPACKAGE _
|
||||
(SETQ *PACKAGE*
|
||||
(\DTEST PACKAGE 'PACKAGE])
|
||||
(SETQ *PACKAGE* (\DTEST PACKAGE
|
||||
'PACKAGE])
|
||||
|
||||
(* ;; "At this point we have the environment for the file, the external format is set. We now read/interpret all the other forms.")
|
||||
(* ;; "At this point we have the environment for the file, the external format is set. We now read/interpret all the other forms.")
|
||||
|
||||
(WITH-READER-ENVIRONMENT DEFINEDENV
|
||||
(PROG (ADR)
|
||||
LP (if FILEMAP
|
||||
then (* ;
|
||||
"need to build map, so read carefully")
|
||||
(SETQ LOADA (SKIPSEPRCODES STREAM))
|
||||
(if (OR (SYNTAXP LOADA 'LEFTPAREN)
|
||||
(SYNTAXP LOADA 'LEFTBRACKET))
|
||||
then (* ; "See if we have a DEFINEQ")
|
||||
(SETQ ADR (GETFILEPTR STREAM))
|
||||
(READCCODE STREAM) (* ; "Eat paren")
|
||||
(if (EQ (RATOM STREAM)
|
||||
'DEFINEQ)
|
||||
then (SETQ FNADRLST (TCONC NIL ADR))
|
||||
(TCONC FNADRLST NIL)
|
||||
(TCONC FILEMAP (CAR FNADRLST))
|
||||
(GO DEFQLP))
|
||||
(* ; "Not a DEFINEQ, so back out")
|
||||
(SETFILEPTR STREAM ADR)))
|
||||
then (* ;
|
||||
"need to build map, so read carefully")
|
||||
(SETQ LOADA (SKIPSEPRCODES STREAM))
|
||||
(if (OR (SYNTAXP LOADA 'LEFTPAREN)
|
||||
(SYNTAXP LOADA 'LEFTBRACKET))
|
||||
then (* ; "See if we have a DEFINEQ")
|
||||
(SETQ ADR (GETFILEPTR STREAM))
|
||||
(READCCODE STREAM) (* ; "Eat paren")
|
||||
(if (EQ (RATOM STREAM)
|
||||
'DEFINEQ)
|
||||
then (SETQ FNADRLST (TCONC NIL ADR))
|
||||
(TCONC FNADRLST NIL)
|
||||
(TCONC FILEMAP (CAR FNADRLST))
|
||||
(GO DEFQLP)) (* ; "Not a DEFINEQ, so back out")
|
||||
(SETFILEPTR STREAM ADR)))
|
||||
(SELECTQ (SETQ LOADA (READ STREAM))
|
||||
((STOP NIL)
|
||||
(if (EQ LDFLG 'SYSLOAD)
|
||||
then (if (NOT (MEMB (SETQ ROOTNAME
|
||||
(ROOTFILENAME FILE
|
||||
(CDR FILECREATEDLST)))
|
||||
SYSFILES))
|
||||
then (SETQ SYSFILES (NCONC1 SYSFILES
|
||||
ROOTNAME)))
|
||||
(SMASHFILECOMS ROOTNAME)
|
||||
elseif FILEPKGFLG
|
||||
then
|
||||
((STOP NIL)
|
||||
(if (EQ LDFLG 'SYSLOAD)
|
||||
then (if (NOT (MEMB (SETQ ROOTNAME (ROOTFILENAME FILE (CDR
|
||||
FILECREATEDLST
|
||||
)))
|
||||
SYSFILES))
|
||||
then (SETQ SYSFILES (NCONC1 SYSFILES ROOTNAME)))
|
||||
(SMASHFILECOMS ROOTNAME)
|
||||
elseif FILEPKGFLG
|
||||
then
|
||||
|
||||
(* ;; "Do not want any items that are added to FILEPKGCHANGES as a result of being mentioned in this file to remain on FILEPKGCHANGES. Also, we want items mentioned earlier to be deleted if they are taken care of by this file. The extra argument to ADDFILE allows it to restore FILEPKGCHANGES to the intersection of its current value and its previous value.")
|
||||
(* ;; "Do not want any items that are added to FILEPKGCHANGES as a result of being mentioned in this file to remain on FILEPKGCHANGES. Also, we want items mentioned earlier to be deleted if they are taken care of by this file. The extra argument to ADDFILE allows it to restore FILEPKGCHANGES to the intersection of its current value and its previous value.")
|
||||
|
||||
(ADDFILE FILE T PRLST FILECREATEDLST))
|
||||
[if FILEMAP
|
||||
then (PUTFILEMAP FILE (CAR FILEMAP)
|
||||
FILECREATEDLST DEFINEDENV NIL FILECREATEDLOC)
|
||||
(if UPDATEMAPFLG
|
||||
then (SETFILEPTR STREAM ADR)
|
||||
(* ;
|
||||
"address of last expression read. good hint for finding filemap")
|
||||
(UPDATEFILEMAP STREAM (CAR FILEMAP]
|
||||
(if (NOT (MEMB FILE LOADEDFILELST))
|
||||
then (/SETTOPVAL 'LOADEDFILELST (CONS FILE LOADEDFILELST)))
|
||||
(RETURN))
|
||||
NIL)
|
||||
(ADDFILE FILE T PRLST FILECREATEDLST))
|
||||
[if FILEMAP
|
||||
then (PUTFILEMAP FILE (CAR FILEMAP)
|
||||
FILECREATEDLST DEFINEDENV NIL FILECREATEDLOC)
|
||||
(if UPDATEMAPFLG
|
||||
then (SETFILEPTR STREAM ADR)
|
||||
(* ;
|
||||
"address of last expression read. good hint for finding filemap")
|
||||
(UPDATEFILEMAP STREAM (CAR FILEMAP]
|
||||
(if (NOT (MEMB FILE LOADEDFILELST))
|
||||
then (/SETTOPVAL 'LOADEDFILELST (CONS FILE LOADEDFILELST)))
|
||||
(RETURN))
|
||||
NIL)
|
||||
[if (LISTP LOADA)
|
||||
then
|
||||
(SELECTQ (CAR LOADA)
|
||||
(FILECREATED (if MAYBEWANTFILEMAP
|
||||
then (* ; "See if we have a valid file map")
|
||||
(SETQ ADR (GETFILEPTR STREAM))
|
||||
(if [AND (FIXP (SETQ TEM (CADDDR LOADA)))
|
||||
[SETQ TEM (CAR (NLSETQ (SETFILEPTR STREAM
|
||||
TEM)
|
||||
(READ STREAM]
|
||||
(EQ (CAR TEM)
|
||||
'FILEMAP)
|
||||
(NULL (CAR (SETQ TEM (CADR TEM]
|
||||
then (* ; "Has ok map")
|
||||
(PUTFILEMAP FILE TEM NIL DEFINEDENV)
|
||||
else (* ;
|
||||
"Need to build a file map as we go")
|
||||
(SETQ FILEMAP (TCONC NIL NIL)))
|
||||
(SETFILEPTR STREAM ADR)
|
||||
(SETQ MAYBEWANTFILEMAP NIL))
|
||||
(SETQ LOADA (\EVAL LOADA)))
|
||||
(SETQ LOADA (\EVAL LOADA)))
|
||||
else (* ;
|
||||
"Atom found. Compiled code definition.")
|
||||
(if ADDSPELLFLG
|
||||
then (ADDSPELL LOADA))
|
||||
(if FILEMAP
|
||||
then (SETQ ADR (GETFILEPTR STREAM)))
|
||||
(LAPRD LOADA)
|
||||
(if FILEMAP
|
||||
then (TCONC FILEMAP (CONS ADR (CONS (GETFILEPTR STREAM)
|
||||
LOADA]
|
||||
(FILECREATED (if MAYBEWANTFILEMAP
|
||||
then (* ; "See if we have a valid file map")
|
||||
(SETQ ADR (GETFILEPTR STREAM))
|
||||
(if [AND (FIXP (SETQ TEM (CADDDR LOADA)))
|
||||
[SETQ TEM (CAR (NLSETQ (SETFILEPTR STREAM
|
||||
TEM)
|
||||
(READ STREAM]
|
||||
(EQ (CAR TEM)
|
||||
'FILEMAP)
|
||||
(NULL (CAR (SETQ TEM (CADR TEM]
|
||||
then (* ; "Has ok map")
|
||||
(PUTFILEMAP FILE TEM NIL DEFINEDENV)
|
||||
else (* ; "Need to build a file map as we go")
|
||||
(SETQ FILEMAP (TCONC NIL NIL)))
|
||||
(SETFILEPTR STREAM ADR)
|
||||
(SETQ MAYBEWANTFILEMAP NIL))
|
||||
(SETQ LOADA (\EVAL LOADA)))
|
||||
(SETQ LOADA (\EVAL LOADA)))
|
||||
else (* ;
|
||||
"Atom found. Compiled code definition.")
|
||||
(if ADDSPELLFLG
|
||||
then (ADDSPELL LOADA))
|
||||
(if FILEMAP
|
||||
then (SETQ ADR (GETFILEPTR STREAM)))
|
||||
(LAPRD LOADA)
|
||||
(if FILEMAP
|
||||
then (TCONC FILEMAP (CONS ADR (CONS (GETFILEPTR STREAM)
|
||||
LOADA]
|
||||
LP1 (if PRINTFLG
|
||||
then (PRINT LOADA PRINTFLG))
|
||||
(GO LP)
|
||||
DEFQLP
|
||||
(SELCHARQ (SKIPSEPRCODES STREAM)
|
||||
((%) %]) (* ; "Closes DEFINEQ.")
|
||||
((%) %]) (* ; "Closes DEFINEQ.")
|
||||
(READCCODE STREAM)
|
||||
(if FNADRLST
|
||||
then (RPLACA (CDAR FNADRLST)
|
||||
(GETFILEPTR STREAM)))
|
||||
(* ;
|
||||
"FNADRLST is a TCONC format list, hence want to RPLACA CDAR, not just CDR.")
|
||||
(GETFILEPTR STREAM)))
|
||||
(* ;
|
||||
"FNADRLST is a TCONC format list, hence want to RPLACA CDAR, not just CDR.")
|
||||
(SETQ LOADA (DEFINE (DREVERSE LOADA)))
|
||||
(GO LP1))
|
||||
((%( %[) (* ;
|
||||
"another function/definition pair")
|
||||
((%( %[) (* ; "another function/definition pair")
|
||||
(SETQ ADR (GETFILEPTR STREAM))
|
||||
(SETQ LOADA (CONS (READ STREAM)
|
||||
LOADA))
|
||||
[if FNADRLST
|
||||
then (TCONC FNADRLST (CONS (CAAR LOADA)
|
||||
(CONS ADR (GETFILEPTR STREAM]
|
||||
(CONS ADR (GETFILEPTR STREAM]
|
||||
(GO DEFQLP))
|
||||
NIL)
|
||||
(ERROR "illegal argument in defineq")))
|
||||
@@ -808,20 +800,22 @@
|
||||
(TERPRI STREAM)))])
|
||||
|
||||
(READ-READER-ENVIRONMENT
|
||||
[LAMBDA (STREAM DEFAULTENV RETURNFORM) (* ; "Edited 26-Sep-2021 23:31 by rmk:")
|
||||
[LAMBDA (STREAM DEFAULTENV RETURNFORM) (* ; "Edited 25-Feb-2026 14:15 by rmk")
|
||||
(* ; "Edited 26-Sep-2021 23:31 by rmk:")
|
||||
|
||||
(* ;; "Starting environment is the old interlisp file, just for the seprchar scans.")
|
||||
|
||||
(* ;; "On exit, if the stream begins with a DEFINE-FILE-INFO expression, it is positioned just after that expression. If not, it is left at its starting position. ")
|
||||
|
||||
(* ;; "RETURNFORM=T means return the DEFINE-FILE-INFO as a second value, for READFILE")
|
||||
|
||||
(CL:UNLESS DEFAULTENV (SETQ DEFAULTENV *OLD-INTERLISP-READ-ENVIRONMENT*))
|
||||
(LET ((START (GETFILEPTR STREAM))
|
||||
ARGS
|
||||
(ENV DEFAULTENV)
|
||||
(*READTABLE* (FETCH (READER-ENVIRONMENT REREADTABLE) OF
|
||||
*OLD-INTERLISP-READ-ENVIRONMENT*
|
||||
)))
|
||||
(*READTABLE* (FETCH (READER-ENVIRONMENT REREADTABLE) OF *OLD-INTERLISP-READ-ENVIRONMENT*)))
|
||||
(DECLARE (SPECVARS *READTABLE*))
|
||||
(SETFILEPTR STREAM 0) (* ; "Hope we are RANDACCESSP")
|
||||
(SELCHARQ (SKIPSEPRCODES STREAM)
|
||||
(";" (* ; "Assume it's a common lisp file")
|
||||
(\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF
|
||||
@@ -831,24 +825,21 @@
|
||||
("(" (\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF
|
||||
*DEFINE-FILE-INFO-ENV*
|
||||
)) (* ;
|
||||
"Should we reset the format if we fail?")
|
||||
"Should we reset the format if we fail?")
|
||||
(READCCODE STREAM)
|
||||
(WITH-READER-ENVIRONMENT *DEFINE-FILE-INFO-ENV*
|
||||
(IF (STREQUAL "DEFINE-FILE-INFO" (RSTRING STREAM))
|
||||
THEN
|
||||
(if (STREQUAL "DEFINE-FILE-INFO" (RSTRING STREAM))
|
||||
then
|
||||
(* ;;
|
||||
"After the \DO-DEFINE-FILE-INFO, we have the new environment and we have set the new format.")
|
||||
|
||||
(* ;;
|
||||
"After the \DO-DEFINE-FILE-INFO, we have the new environment and we have set the new format.")
|
||||
|
||||
[SETQ ENV (\DO-DEFINE-FILE-INFO STREAM (SETQ ARGS
|
||||
(CL:READ-DELIMITED-LIST
|
||||
(CHARCODE ")")
|
||||
STREAM]
|
||||
ELSE (* ; "Hope we are RANDACCESSP")
|
||||
(SETFILEPTR STREAM START))
|
||||
(SETQ ARGS (CL:READ-DELIMITED-LIST (CHARCODE ")")
|
||||
STREAM))
|
||||
(SETQ ENV (\DO-DEFINE-FILE-INFO STREAM ARGS))
|
||||
else (SETFILEPTR STREAM START))
|
||||
|
||||
(* ;;
|
||||
"If we didn't see ARGS, then we didn't see a DEFINE-FILE-INFO, no form to return.")
|
||||
"If we didn't see ARGS, then we didn't see a DEFINE-FILE-INFO, no form to return.")
|
||||
|
||||
(CL:IF (AND RETURNFORM ARGS)
|
||||
(CL:VALUES ENV (CONS 'DEFINE-FILE-INFO ARGS))
|
||||
@@ -856,25 +847,26 @@
|
||||
DEFAULTENV])
|
||||
|
||||
(MAKE-DEFINE-FILE-INFO-ENV
|
||||
[LAMBDA NIL (* ; "Edited 29-Jul-2021 20:29 by rmk:")
|
||||
[LAMBDA NIL (* ; "Edited 25-Feb-2026 15:03 by rmk")
|
||||
(* ; "Edited 29-Jul-2021 20:29 by rmk:")
|
||||
|
||||
(* ;; "Makes the reader environment and read table used for printing and reading the DEFINE-FILE-INFO expression. Like the OLD-INTERLISP-FILE, but : is the preferred package delim")
|
||||
(* ;; "Makes the reader environment and read table used for printing and reading the DEFINE-FILE-INFO expression. Like the OLD-INTERLISP-FILE, but : is the preferred package delim")
|
||||
|
||||
(LET [(RTBL (COPYREADTABLE (FETCH REREADTABLE OF *OLD-INTERLISP-READ-ENVIRONMENT*]
|
||||
|
||||
(* ;;
|
||||
"But this is all rather silly: Why not just have ordinary Interlisp atoms for the key words. ")
|
||||
(* (READTABLEPROP RTBL
|
||||
(QUOTE PACKAGECHAR)
|
||||
(CHARCODE %:)))
|
||||
(* ;;
|
||||
"But this is all rather silly: Why not just have ordinary Interlisp atoms for the key words. ")
|
||||
(* (READTABLEPROP RTBL
|
||||
(QUOTE PACKAGECHAR) (CHARCODE %:)))
|
||||
(SETSYNTAX (CHARCODE %:)
|
||||
'PACKAGEDELIM RTBL) (* ;
|
||||
"In transition: read : but don't yet put it out")
|
||||
'PACKAGEDELIM RTBL)
|
||||
(replace (READTABLEP PACKAGECHAR) of RTBL with (CHARCODE %:))
|
||||
(* ;
|
||||
"Use : instead of ^^ for printing too")
|
||||
|
||||
(* ;; "The INTERLISP package doesn't exist in bootstrap, the REPACKAGE field is filled in in PACKAGE-ENABLE in PACKAGE-STARTUP")
|
||||
(* ;; "The INTERLISP package doesn't exist in bootstrap, the REPACKAGE field is filled in in PACKAGE-ENABLE in PACKAGE-STARTUP")
|
||||
|
||||
(CREATE READER-ENVIRONMENT USING *OLD-INTERLISP-READ-ENVIRONMENT* REREADTABLE _ RTBL
|
||||
])
|
||||
(CREATE READER-ENVIRONMENT USING *OLD-INTERLISP-READ-ENVIRONMENT* REREADTABLE _ RTBL])
|
||||
)
|
||||
|
||||
(RPAQ? *DEFINE-FILE-INFO-ENV* (MAKE-DEFINE-FILE-INFO-ENV))
|
||||
@@ -977,13 +969,13 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4617 14289 (GETPROP 4627 . 5199) (SETATOMVAL 5201 . 5330) (RPAQQ 5332 . 5385) (RPAQ
|
||||
5387 . 5699) (RPAQ? 5701 . 6071) (MOVD 6073 . 7937) (MOVD? 7939 . 8369) (SELECTQ 8371 . 8558) (
|
||||
SELECTQ1 8560 . 8902) (NCONC1 8904 . 9100) (PUTPROP 9102 . 10586) (PROPNAMES 10588 . 10779) (ADDPROP
|
||||
10781 . 12844) (REMPROP 12846 . 13700) (MEMB 13702 . 13961) (CLOSEF? 13963 . 14287)) (14362 34926 (
|
||||
LOAD 14372 . 15541) (\LOAD-STREAM 15543 . 28617) (FILECREATED 28619 . 30037) (FILECREATED1 30039 .
|
||||
31147) (PRETTYCOMPRINT 31149 . 31634) (BOOTSTRAP-NAMEFIELD 31636 . 32596) (PUTPROPS 32598 . 32966) (
|
||||
DECLARE%: 32968 . 33100) (DECLARE%:1 33102 . 33974) (ROOTFILENAME 33976 . 34924)) (34964 45363 (
|
||||
DEFINE-FILE-INFO 34974 . 35409) (\DO-DEFINE-FILE-INFO 35411 . 39554) (PRINT-READER-ENVIRONMENT 39556
|
||||
. 41308) (READ-READER-ENVIRONMENT 41310 . 44085) (MAKE-DEFINE-FILE-INFO-ENV 44087 . 45361)))))
|
||||
(FILEMAP (NIL (4621 14293 (GETPROP 4631 . 5203) (SETATOMVAL 5205 . 5334) (RPAQQ 5336 . 5389) (RPAQ
|
||||
5391 . 5703) (RPAQ? 5705 . 6075) (MOVD 6077 . 7941) (MOVD? 7943 . 8373) (SELECTQ 8375 . 8562) (
|
||||
SELECTQ1 8564 . 8906) (NCONC1 8908 . 9104) (PUTPROP 9106 . 10590) (PROPNAMES 10592 . 10783) (ADDPROP
|
||||
10785 . 12848) (REMPROP 12850 . 13704) (MEMB 13706 . 13965) (CLOSEF? 13967 . 14291)) (14366 34343 (
|
||||
LOAD 14376 . 15545) (\LOAD-STREAM 15547 . 28034) (FILECREATED 28036 . 29454) (FILECREATED1 29456 .
|
||||
30564) (PRETTYCOMPRINT 30566 . 31051) (BOOTSTRAP-NAMEFIELD 31053 . 32013) (PUTPROPS 32015 . 32383) (
|
||||
DECLARE%: 32385 . 32517) (DECLARE%:1 32519 . 33391) (ROOTFILENAME 33393 . 34341)) (34381 44987 (
|
||||
DEFINE-FILE-INFO 34391 . 34826) (\DO-DEFINE-FILE-INFO 34828 . 38971) (PRINT-READER-ENVIRONMENT 38973
|
||||
. 40725) (READ-READER-ENVIRONMENT 40727 . 43553) (MAKE-DEFINE-FILE-INFO-ENV 43555 . 44985)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user