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

Merge (rebase) Cleanup-character-IO-interfaces with master (#356)

Browse Source 
* Cleanup  of character IO interface

Committing this branch for further testing.  I know at least that the TTY output stream somehow is defaulting to :XCCS, which is wrong, but I haven't yet found the interface for that.

* Clean out \NSIN etc

No top-level calls to the NS specific functions, just to the generic \OUTCHAR etc.

Updated full.database

* MODERNIZE: added dragging for fixed-menu windows

They can be dragged by their title bars

* UNICODE:  Added Greek to the default set

Also made spelling of default-externalformats consistent with FILEIO

* FASLOAD: EOL conversion in FASL::READ-TEXT

EOL's printed as LF's will be read as EOL

* LLREAD:  Added meta as a CHARACTERSETNAME

meta,a maps to 1,a now.  But slowly propagating this to TEDIT, SEDIT, etc will make it easier to change the coding of meta characters, e.g. as part of a Unicode transition.

* APRINT FILEIO LLREAD: \OUTCHAR now a closed function

Removed the macro

* LLKEY: call CHARCODE.DECODE directory in \KEYACTION1

Minor cleanup, avoid typical user entry and APPLY*

* WHEELSCROLL: re-enable on AFTERMAKESYS/SYSOUT FORMS

Also sets up mappings in the \COMMANDKEYACTIONS, whatever that is

* ABASIC:  NILL and ZERO change from LAMBDA NOBIND to LAMBDA NIL

So that things like Masterscope don't break

* MASTERSCOPE:  Added WHEREIS as last-resort for CONTAINS

Looks at the WHEREIS database, if present, for FNS and FUNCTIONS if it has no other information.  . WHO CONTAINS ANY CALLING FOO works, but not the inverse:  . WHO DOES FUM CONTAIN.  We still need to figure out why the CONTAINS table isn't populated

* POSTSCRIPTSTREAM: use standard \OUTCHAR conventions

Now uses generic \OUTCHAR to get the proper function from the stream (or default)

* Recompile with right EXPORTS.ALL

Some of the macros weren't correct.

* Fix POSTSCRIPTSTREAM

Cleaner separation between external \OUTCHAR and internal BOUT

* POSTSCRIPTSTREAM gets its own external format

* Minor fix

* Compile-time warning about EXPORTS.ALL

* MODERNIZE:  Modern button fn has same args as the original

For Notecards  #343

* Fixed another glitch in the MODERNIZE  arglist thing

\TEDIT.BUTTONEVENTFN actually takes a second STREAM argument.  I don't see where it is ever called with that.  The modernize replacement binds that argument, but it isn't being passed to the original.

* FILEWATCH:  added missing record field

* Update FILEWATCH.LCOM

* Eliminating record/type name conflicts

Mostly just qualifying references, more work to get BIGBITMAP stuff out of ADISPLAY and to eliminate ambiguity of LINE record (now XXLINE in XXGEOM)

* Compile away open calls to \OUTCHAR, add loadups/full.database

Mostly new LCOMS where \OUTCHAR calls were compiled open

* Remove garbage library/XCCS

Old tools for reading wikipedia XCCS tables, sources/XCCS will deal with XCCS external format

* Next step:  Remove open input-character calls, factor XCCS to separate file

XCCS is the default, but can be swapped out (eventually) by setting a few variables, without recompiling everything

* Lots of residual cleanup for XCCS isolation

* Delete old file MACINTERFACE (migrated to MODERNIZE)

* Eliminate straggling NS calls:  LAFITE, READINTERPRESS

* Typo

* READINTERPRESS:  removed CHARSET

* MODERNIZE: Interface to control title-bar response (for Notecards)

* Many changes for external format name consistency

Very close to the end of this

* Put :FORMAT in file info, fix TEDIT plaintext hardcopy

I distributed :FORMAT :XCCS as the default marking, but somehow one of the variables seems to get revert during the loadup.  This is correct, as far as it goes.

* Getting the format in the file-info

This is all very twisty, different variables set in different places.  It now seems to do the right thing, at least for new files.  Marks them with :FORMAT :XCCS.

* Another fileinfo glitch

* CLIPBOARD -UNICODE:  Make UTF8 to UTF-8 to match standards

* MODERNIZE:  fix bug in MODERWINDOW

* External format as MAKEFILE option, LOAD applies the file's format

(MAKEFILE 'XX '((FORMAT :UTF-8)))
  will dump XX as a UTF-8 file.  LOAD will load it back to XCCS internal.

* Compilers respect DEFINE-FILE-INFO format

* MODERNIZE:  little glitch

* Delete old FILEIO.LCOM

* More edge cases of external format thru MAKEFILE, PRETTY, PRETTYFILEINDEX etc.

* FILEBROWSER:  Can SEE UTF-8 Lisp sourcefile

* INSPECT:  Better macro for inspecting readtables

* recompile changed files and do new loadup

Co-authored-by: rmkaplan <ron.kaplan@post.harvard.edu>
This commit is contained in:
Larry Masinter
2021-07-29 17:07:23 -07:00
committed by GitHub
parent 4fac4e3e96
commit 4efe2f93af
159 changed files with 41605 additions and 42552 deletions
Download Patch File Download Diff File Expand all files Collapse all files

523
sources/COMPILE
View File

@@ -1,13 +1,15 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "27-Jul-90 11:15:42" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>COMPILE.;4| 68945
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 5-Jul-2021 13:46:39" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>COMPILE.;4 77731
changes to%: (FNS BRECOMPILE)
changes to%: (FNS BCOMPL BCOMPL.BODY)
previous date%: " 8-Jun-90 11:48:47" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>COMPILE.;3|)
previous date%: " 5-Jul-2021 09:31:55"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>COMPILE.;3)
(* ; "
Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1984-1990, 2021 by Venue & Xerox Corporation.
The following program was created in 1984 but has not been published
within the meaning of the copyright law, is furnished under license,
and may not be used, copied and/or disclosed except in accordance
@@ -16,11 +18,71 @@ with the terms of said license.
(PRETTYCOMPRINT COMPILECOMS)
(RPAQQ COMPILECOMS ((FNS BCOMPL BCOMPL.BODY PRINT-COMPILE-HEADER RESETOPENFILES BCOMPL1A BCOMPL2 BCOMPL3 BLOCK%: BRECOMPILE BRECOMPILE1 BRECOMPILE2 BRECOMPILE3 BLOCKCOMPILE BLOCKCOMPILE1 COMPSET COMPSETREAD COMPSETY COMPSETF RCOMP3 TCOMPL RECOMPILE RECOMP? COMPILE COMPILE1 COMPILE1A SHOULD-BE-DWIMIFIED? COMPILE.FILECHECK COMPEM GETCFILE SPECVARS LOCALVARS GLOBALVARS) (ADDVARS (NOLINKFNS HELP ERRORX ERRORSET EVALV FAULTEVAL INTERRUPT SEARCHPDL MAPDL BREAK1 EDITE EDITL) (LINKFNS) (FREEVARS) (SYSSPECVARS HELPCLOCK LISPXHIST RESETSTATE OLDVALUE UNDOSIDE0 SPECVARS LOCALVARS GLOBALVARS) (SYSLOCALVARS) (LOCALFREEVARS) (BLKLIBRARY) (RETFNS) (BLKAPPLYFNS) (DONTCOMPILEFNS) (NLAML) (NLAMA) (LAMS) (LAMA)) (INITVARS (SPECVARS T) (LOCALVARS SYSLOCALVARS)) (INITVARS (DWIMIFYCOMPFLG NIL) (COMPILEHEADER "compiled on ") (COMPSETLST (QUOTE (ST F STF S Y N 1 2 NIL T))) (COMPSETKEYLST (QUOTE ((ST "ore and redefine " KEYLST ("" (F . "orget exprs"))) (S . "ame as last time") (F . "ile only") (T . "o terminal") (1) (2) (Y . "es") (N . "o")))) (COMPSETDEFAULTKEYLST (QUOTE ((Y . "es") (N . "o")))) (BCOMPL.SCRATCH (QUOTE {CORE}BCOMPL.SCRATCH)) (RECOMPILEDEFAULT (QUOTE CHANGES)) (COUTFILE T) (SVFLG T) (STRF T) (LSTFIL T) (LCFIL) (LAPFLG T)) (DECLARE%: DONTCOPY (RECORDS COMPFILEDESCR) (MACROS DIGITCHARP) (GLOBALVARS SYSSPECVARS SYSLOCALVARS RECOMPILEDEFAULT COMPILE.EXT NOTCOMPILEDFILES BYTECOMPFLG COMPILEHEADER COMPVERSION BCOMPL.SCRATCH LINKEDFNS NOFIXVARSLST0 NOFIXFNSLST0 CLISPTRANFLG CLISPARRAY COMPSETKEYLST REREADFLG HISTSTR0 LISPXHISTORY COMPSETDEFAULTKEYLST FILERDTBL DWIMFLG DWIMWAIT)) (P (MOVD? (QUOTE NILL) (QUOTE FILECHANGES)) (CL:PROCLAIM (QUOTE (CL:SPECIAL COMPVARMACROHASH))) (CL:PROCLAIM (QUOTE (GLOBAL SYSSPECVARS SYSLOCALVARS COMPILE.EXT NOTCOMPILEDFILES CLISPARRAY FILERDTBL DWIMFLG DWIMWAIT LISPXHISTORY)))) (COMS (* ; "COMPILEMODE") (PROP VARTYPE COMPILEMODELST) (FNS COMPILEMODE)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA GLOBALVARS LOCALVARS SPECVARS BLOCK%:) (NLAML BCOMPL3) (LAMA)))))
(RPAQQ COMPILECOMS
[(FNS BCOMPL BCOMPL.BODY PRINT-COMPILE-HEADER RESETOPENFILES BCOMPL1A BCOMPL2 BCOMPL3 BLOCK%:
BRECOMPILE BRECOMPILE1 BRECOMPILE2 BRECOMPILE3 BLOCKCOMPILE BLOCKCOMPILE1 COMPSET
COMPSETREAD COMPSETY COMPSETF RCOMP3 TCOMPL RECOMPILE RECOMP? COMPILE COMPILE1 COMPILE1A
SHOULD-BE-DWIMIFIED? COMPILE.FILECHECK COMPEM GETCFILE SPECVARS LOCALVARS GLOBALVARS)
(ADDVARS (NOLINKFNS HELP ERRORX ERRORSET EVALV FAULTEVAL INTERRUPT SEARCHPDL MAPDL BREAK1
EDITE EDITL)
(LINKFNS)
(FREEVARS)
(SYSSPECVARS HELPCLOCK LISPXHIST RESETSTATE OLDVALUE UNDOSIDE0 SPECVARS LOCALVARS
GLOBALVARS)
(SYSLOCALVARS)
(LOCALFREEVARS)
(BLKLIBRARY)
(RETFNS)
(BLKAPPLYFNS)
(DONTCOMPILEFNS)
(NLAML)
(NLAMA)
(LAMS)
(LAMA))
(INITVARS (SPECVARS T)
(LOCALVARS SYSLOCALVARS))
(INITVARS (DWIMIFYCOMPFLG NIL)
(COMPILEHEADER "compiled on ")
(COMPSETLST '(ST F STF S Y N 1 2 NIL T))
[COMPSETKEYLST '((ST "ore and redefine " KEYLST ("" (F . "orget exprs")))
(S . "ame as last time")
(F . "ile only")
(T . "o terminal")
(1)
(2)
(Y . "es")
(N . "o"]
[COMPSETDEFAULTKEYLST '((Y . "es")
(N . "o"]
(BCOMPL.SCRATCH '{CORE}BCOMPL.SCRATCH)
(RECOMPILEDEFAULT 'CHANGES)
(COUTFILE T)
(SVFLG T)
(STRF T)
(LSTFIL T)
(LCFIL)
(LAPFLG T))
(DECLARE%: DONTCOPY (RECORDS COMPFILEDESCR)
(MACROS DIGITCHARP)
(GLOBALVARS SYSSPECVARS SYSLOCALVARS RECOMPILEDEFAULT COMPILE.EXT NOTCOMPILEDFILES
BYTECOMPFLG COMPILEHEADER COMPVERSION BCOMPL.SCRATCH LINKEDFNS NOFIXVARSLST0
NOFIXFNSLST0 CLISPTRANFLG CLISPARRAY COMPSETKEYLST REREADFLG HISTSTR0
LISPXHISTORY COMPSETDEFAULTKEYLST FILERDTBL DWIMFLG DWIMWAIT))
[P (MOVD? 'NILL 'FILECHANGES)
(CL:PROCLAIM '(CL:SPECIAL COMPVARMACROHASH))
(CL:PROCLAIM '(GLOBAL SYSSPECVARS SYSLOCALVARS COMPILE.EXT NOTCOMPILEDFILES CLISPARRAY
FILERDTBL DWIMFLG DWIMWAIT LISPXHISTORY]
(COMS (* ; "COMPILEMODE")
(PROP VARTYPE COMPILEMODELST)
(FNS COMPILEMODE))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA GLOBALVARS LOCALVARS SPECVARS BLOCK%:)
(NLAML BCOMPL3)
(LAMA])
(DEFINEQ
(BCOMPL
[LAMBDA (FILES CFILE NOBLOCKSFLG OPTIONSSET) (* ; "Edited 9-Feb-87 16:22 by Pavel")
[LAMBDA (FILES CFILE NOBLOCKSFLG OPTIONSSET) (* ; "Edited 5-Jul-2021 13:39 by rmk:")
(* ;;; "BCOMPL is like TCOMPL, except that it reads in all of FILES before starting any compilations, so that a BLOCK can contain functions in several FILES. BLOCKS are set up using a DECLARE statement of the form")
@@ -28,29 +90,32 @@ with the terms of said license.
(* ;;; "where BLKFN1 ... are the functions in the BLOCK, and VAR1 ... are values for ENTRIES, RETFNS, SPECVARS, etc. A variable setting of the form (VAR . list) sets variable to UNION of the list with the variable's top level value. A variable setting of the form (VAR . ATOM) simply sets the variable to that atom, e.g. (NOLINKFLG . T)")
(RESETLST (LET ((NLAML NLAML)
(NLAMA NLAMA)
(LAMS LAMS)
(LAMA LAMA)
(DWIMIFYCOMPFLG DWIMIFYCOMPFLG)
(EXPRSLST NIL)
(NOFIXVARSLST NOFIXVARSLST)
(NOFIXFNSLST NOFIXFNSLST)
(*PRINT-ARRAY* T)
(*PRINT-LENGTH* NIL)
(*PRINT-LEVEL* NIL))
(DECLARE (SPECVARS NLAML NLAMA LAMS LAMA DWIMIFYCOMPFLG EXPRSLST NOFIXVARSLST
NOFIXFNSLST *PRINT-ARRAY* *PRINT-LEVEL* *PRINT-LENGTH*))
(SETQ FILES (RESETOPENFILES FILES))
(* ;; "Checks that all FILES are there, and if not, attempts spelling correction. Opens them for input, too, and returns the input stream")
(RESETLST
(LET ((NLAML NLAML)
(NLAMA NLAMA)
(LAMS LAMS)
(LAMA LAMA)
(DWIMIFYCOMPFLG DWIMIFYCOMPFLG)
(EXPRSLST NIL)
(NOFIXVARSLST NOFIXVARSLST)
(NOFIXFNSLST NOFIXFNSLST)
(*PRINT-ARRAY* T)
(*PRINT-LENGTH* NIL)
(*PRINT-LEVEL* NIL))
(DECLARE (SPECVARS NLAML NLAMA LAMS LAMA DWIMIFYCOMPFLG EXPRSLST NOFIXVARSLST
NOFIXFNSLST *PRINT-ARRAY* *PRINT-LEVEL* *PRINT-LENGTH*))
(BCOMPL.BODY FILES CFILE NOBLOCKSFLG OPTIONSSET])
(* ;; "Checks that all FILES are there, and if not, attempts spelling correction. Opens them for input, too, and returns the input stream")
(BCOMPL.BODY (RESETOPENFILES FILES)
CFILE NOBLOCKSFLG OPTIONSSET)))])
(BCOMPL.BODY
[LAMBDA (FILES CFILE NOBLOCKSFLG OPTIONSSET) (* bvm%: "13-Oct-86 17:07")
[LAMBDA (STREAMS CFILE NOBLOCKSFLG OPTIONSSET) (* ; "Edited 5-Jul-2021 13:46 by rmk:")
(* ;;; "FILES is a list of streams. Compile everything on them, dumping to CFILE (default first stream.dcom). NOBLOCKSFLG means TCOMPL instead of BCOMPL. OPTIONSSET is true if the Listing? question has already been asked.")
(* ;;; "STREAMS is a list of streams. Compile everything on them, dumping to CFILE (default first stream.dcom). NOBLOCKSFLG means TCOMPL instead of BCOMPL. OPTIONSSET is true if the Listing? question has already been asked.")
(* ;;; "RMK: Apply each input streams \EXTERNALFORMAT")
(DECLARE (SPECVARS CFILE))
(PROG ((SPECVARS T)
@@ -60,78 +125,87 @@ with the terms of said license.
(DECLARE (SPECVARS SPECVARS LOCALVARS CHANGES OTHERS FIRST BLOCKS BLKFNS
DESTINATIONENV DEFS))
[OR OPTIONSSET (COMPSET NIL '(F %
] (* ;
"OPTIONSSET is T on calls from TCOMPL. In this case, the first COMPSET has already been performed.")
] (* ;
"OPTIONSSET is T on calls from TCOMPL. In this case, the first COMPSET has already been performed.")
(COMPSET (OR CFILE (PACKFILENAME 'HOST [CADR (FMEMB 'HOST (SETQ UNPACKFILE
(UNPACKFILENAME (CAR FILES]
(UNPACKFILENAME (CAR STREAMS
]
'DIRECTORY
(CADR (FMEMB 'DIRECTORY UNPACKFILE))
'NAME
(SETQ FILEROOT (CADR (FMEMB 'NAME UNPACKFILE)))
'EXTENSION COMPILE.EXT)))
(* ;; "Edited by TT(8-June-90 : for Fix AR#2999)")
(* ;; "Edited by TT(8-June-90 : for Fix AR#2999)")
[COND
(LCFIL (SETQ SCRATCHFILE (OPENSTREAM BCOMPL.SCRATCH 'BOTH 'NEW]
(RESETSAVE NIL (LIST 'BCOMPL3 NIL FILES SCRATCHFILE))
(RESETSAVE NIL (LIST 'BCOMPL3 NIL STREAMS SCRATCHFILE))
(* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when bcompl finishes, or control-d or control-e occurs.")
(* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when bcompl finishes, or control-d or control-e occurs.")
[LET (DFNFLG)
(* ;; "if top level value of DFNFLG is PROP, still want to evaluate expressions in declarations etc as though it were T. i.e. make BCOMPL1A equivalent to doing a LOADCOMP")
(* ;; "if top level value of DFNFLG is PROP, still want to evaluate expressions in declarations etc as though it were T. i.e. make BCOMPL1A equivalent to doing a LOADCOMP")
(for STREAM in FILES
(for STREAM in STREAMS
do (RESETLST
(RESETSAVE NIL (LIST 'CLOSEF STREAM))
(RESETSAVE (INPUT STREAM)) (* ;
 "Needs to be primary input for some of the filepkg expressions to work")
(RESETSAVE (INPUT STREAM)) (* ;
 "Needs to be primary input for some of the filepkg expressions to work")
(WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT*
(until (OR (NULL (SETQ TEM (READ STREAM)))
(EQ TEM 'STOP)) do (BCOMPL1A TEM 'DEFAULT
'DEFAULT
'DEFAULT))))]
(EQ TEM 'STOP))
do (CL:WHEN (EQ (CAR (LISTP TEM))
'DEFINE-FILE-INFO)
(\EXTERNALFORMAT STREAM (OR (LISTGET (CDR TEM)
:FORMAT)
:XCCS)))
(BCOMPL1A TEM 'DEFAULT 'DEFAULT 'DEFAULT STREAM))))]
(SETQ NOFIXFNSLST (APPEND NLAMA NLAML LAMS (NCONC [MAPCAR DEFS (FUNCTION (LAMBDA (X)
(RCOMP3
(CAR X)
(CADR X]
NOFIXFNSLST)))
(* ;; "The BCOMPL1 reads in FILES. It returns a list of variables set in the files. The RCOMP3 adds function to NLAMA, LAMS, etc., and returns a list of functions. NOFIXFNLST is reset in case there is any dwimifying to be done.")
(* ;; "The BCOMPL1 reads in FILES. It returns a list of variables set in the files. The RCOMP3 adds function to NLAMA, LAMS, etc., and returns a list of functions. NOFIXFNLST is reset in case there is any dwimifying to be done.")
(WITH-READER-ENVIRONMENT (OR DESTINATIONENV (SETQ DESTINATIONENV
*OLD-INTERLISP-READ-ENVIRONMENT*))
(COND
(LCFIL (PRINT-COMPILE-HEADER FILES [LIST (COND
(NOBLOCKSFLG 'tcompl'd)
(T 'bcompl'd]
(LCFIL (\EXTERNALFORMAT LCFIL (OR (FETCH (READER-ENVIRONMENT REFORMAT)
OF DESTINATIONENV)
:XCCS))
(PRINT-COMPILE-HEADER STREAMS [LIST (COND
(NOBLOCKSFLG 'tcompl'd)
(T 'bcompl'd]
DESTINATIONENV)))
(COND
(SCRATCHFILE
(* ;; "writes others on a scratchfile so space can be freed up. will be copied onto lcfil aftr compilation.")
(* ;; "writes others on a scratchfile so space can be freed up. will be copied onto lcfil aftr compilation.")
(\EXTERNALFORMAT SCRATCHFILE (\EXTERNALFORMAT LCFIL))
(for X in OTHERS do (PRINT X SCRATCHFILE))
(PRINT NIL SCRATCHFILE)
(SETQ OTHERS NIL)))
[OR DWIMIFYCOMPFLG (SETQ DWIMIFYCOMPFLG (EQMEMB 'CLISP (GETPROP FILEROOT 'FILETYPE]
(* ;
 "The FILETYPE may have been set during the course of BCOMPL1.")
(* ;
 "The FILETYPE may have been set during the course of BCOMPL1.")
[MAPC FIRST (FUNCTION (LAMBDA (X)
(PRINT X LCFIL]
[PROG (LISPXHIST)
(DECLARE (SPECVARS LISPXHIST))
(* ;; "compile blocks MAPC not used because BCOMPL2 checks BLOCKS. lispxhist rebound bcause no need to save information when compiling from file")
(* ;; "compile blocks MAPC not used because BCOMPL2 checks BLOCKS. lispxhist rebound bcause no need to save information when compiling from file")
(AND NOBLOCKSFLG (GO NOBLOCKLP))
BLOCKLP
(COND
(BLOCKS (BCOMPL2 (CAR BLOCKS))
(SETQ BLOCKS (CDR BLOCKS))
(GO BLOCKLP))) (* ;
 "COMPILE other functions. done this way instead of MAPC to release the defs as soon aspossible.")
(GO BLOCKLP))) (* ;
 "COMPILE other functions. done this way instead of MAPC to release the defs as soon aspossible.")
NOBLOCKLP
(COND
(DEFS (AND (NOT (FMEMB (CAAR DEFS)
@@ -423,9 +497,240 @@ with the terms of said license.
(SETQ BLOCKS (NCONC1 BLOCKS X))))
(BRECOMPILE
(LAMBDA (FILES CFILE FNS NOBLOCKSFLG) (* ; "Edited 6-Jan-89 10:01 by jds") (* ;;; "FNS is a list of functions to be recompiled. The object is to make a file that looks exactly like that produced by BCOMPL except to greatly reduce the work by copying from CFILE the compiled definitions those functions not being recompiled.") (* ;;; "BRECOMPILE is driven by the source file(s). The algorithm is whenever a DEFINEQ is encountered, process all of the functions in the DEFINEQ as follows: COMPILE the definition of the function if it is on the list FNS, or if FNS is EXPRS and the function is currently defined as an EXPR. Otherwise copy its compiled definition from CFILE. Note that functions with compiled definitions in CFILE that do not appear in PFILE are NOT copied. This corresponds to the case where functions have been deleted from the source file.") (* ;;; "The value FNS = CHANGES means recompile anything marked changed in the file header.") (* ;;; "(RECOMPILE file cfile fns) is equivalent to (BRECOMPILE file cfile fns T).") (* ;;; "Note that CFILE=NIL is interpreted as meaning file.dcom even when FNS supplied.") (RESETLST (PROG ((*PRINT-ARRAY* T) (*PRINT-LENGTH* NIL) (*PRINT-LEVEL* NIL) (NLAMA NLAMA) (NLAML NLAML) (LAMS LAMS) (LAMA LAMA) (DWIMIFYCOMPFLG DWIMIFYCOMPFLG) (EXPRSLST NIL) (NOFIXFNSLST NOFIXFNSLST) (NOFIXVARSLST NOFIXVARSLST) (BUILDMAPFLG T) (SPECVARS T) (LOCALVARS SYSLOCALVARS) (AUXFILECOM T) CHANGES OTHERS FIRST FILEMAPLST FNLST BLKFNS BLOCKS FILE FILE.COM TEM ADRLST SCRATCHFILE COREOK DESTINATIONENV MSG) (DECLARE (SPECVARS *PRINT-ARRAY* *PRINT-LENGTH* *PRINT-LEVEL* NLAMA NLAML LAMS LAMA DWIMIFYCOMPFLG EXPRSLST NOFIXFNSLST NOFIXVARSLST BUILDMAPFLG SPECVARS LOCALVARS CHANGES OTHERS FIRST BLKFNS BLOCKS DESTINATIONENV ADRLST FILEMAPLST CFILE FNS FILE)) (COND ((AND (NULL CFILE) (NULL FNS)) (SETQ FNS RECOMPILEDEFAULT))) (RESETSAVE (INPUT)) (SETQ FILES (RESETOPENFILES FILES)) (COND ((SETQ TEM (for FILE in FILES when (NOT (RANDACCESSP FILE)) collect (FULLNAME FILE))) (GO NONRAND))) (SETQ FILE (UNPACKFILENAME (CAR FILES))) (SETQ FILE.COM (PACKFILENAME (QUOTE HOST) (CADR (FMEMB (QUOTE HOST) FILE)) (QUOTE DIRECTORY) (CADR (FMEMB (QUOTE DIRECTORY) FILE)) (QUOTE NAME) (SETQ FILE (CADR (FMEMB (QUOTE NAME) FILE))) (QUOTE EXTENSION) COMPILE.EXT)) (* ;; "Edited by TT (8-June-90 : for fix AR#2999)") (COND ((EQ FNS (QUOTE ALL)) (GO BRECALL))) CFILERETRY (COND ((NLSETQ (SETQ CFILE (OPENSTREAM (OR CFILE FILE.COM) (QUOTE INPUT) (QUOTE OLD) NIL (QUOTE ((TYPE BINARY)))))) (COND ((NOT (RANDACCESSP CFILE)) (SETQ TEM (CLOSEF CFILE)) (GO NONRAND)) ((OR (NULL (SETQ DESTINATIONENV (GET-ENVIRONMENT-AND-FILEMAP (CAR FILES)))) (CL:MULTIPLE-VALUE-BIND (ENV DUMMY START) (\PARSE-FILE-HEADER CFILE) (COND ((OR (NULL ENV) (NOT (EQUAL-READER-ENVIRONMENT ENV DESTINATIONENV))) T) (T (* "Position cfile back to start") (SETFILEPTR CFILE START) NIL)))) (SETQ TEM (CLOSEF CFILE)) (SETQ MSG " has different reader environment than the new file") (GO NONREC))) (GO BREC)) ((OR (AND (EQ AUXFILECOM T) (SETQ AUXFILECOM (SPELLFILE (ROOTFILENAME (OR CFILE FILE.COM)))) (SETQ CFILE AUXFILECOM) (GO CFILERETRY)) (EQ (ASKUSER DWIMWAIT (QUOTE Y) (LIST (OR CFILE FILE.COM) "not found;" " compile all functions on " (FULLNAME (CAR FILES)) (QUOTE "instead"))) (QUOTE Y))) (* ; "Edited by TT(8-June-90 : for Fix AR#8017)") (GO BRECALL)) ((EQ (ASKUSER DWIMWAIT (QUOTE Y) (CONS (QUOTE "Just forget about compiling") (MAPCAR FILES (FUNCTION FULLNAME)))) (QUOTE Y)) (SELECTQ (CAR READBUF) ((ST F STF) (* "E.g. From CLEANUP.") (SETQ READBUF (CDR READBUF))) NIL) (RETFROM (QUOTE BRECOMPILE))) (T (PRIN1 "File to use for CFILE (source of compiled definitions not being recompiled): " T) (SETQ CFILE (READ T T)) (GO CFILERETRY))) BRECALL (SETQQ FNS ALL) (SETQ CFILE NIL) BREC (COMPSET NIL (QUOTE (S T %
))) (SETQ LCFIL (OPENSTREAM FILE.COM (QUOTE OUTPUT) (QUOTE NEW) NIL (QUOTE ((TYPE BINARY))))) (SETQ SCRATCHFILE (OPENSTREAM BCOMPL.SCRATCH (QUOTE BOTH) (QUOTE NEW))) (RESETSAVE NIL (LIST (QUOTE BCOMPL3) CFILE FILES SCRATCHFILE)) (* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when brecompile finishes, or control-d or control-e occurs. Note that this call differs from the call for bcompl in that cfile is also specified. this corresponds to the fact that recompile has an extra file open.") (SETQ COREOK (for X in FILES always (AND (EQ (CDAR (GETPROP (SETQ TEM (ROOTFILENAME X)) (QUOTE FILEDATES))) X) (FMEMB (CDAR (GETPROP TEM (QUOTE FILE))) (QUOTE (LOADFNS T)))))) (SETQ FILEMAPLST (for STREAM in FILES collect (LET ((LDFLG (QUOTE EXPRESSIONS)) (VARLST (QUOTE COMPILING)) DONELST FNLST) (DECLARE (SPECVARS LDFLG VARLST DONELST FNLST)) (* ; "FNLST etc are used free in LOADFNSCAN") (SETFILEPTR STREAM 0) (INPUT STREAM) (* ;; "LOADFNSCAN scans the file, building a map if one not already there. Value is the map. In addition, sets DONELST to a list of all non-defineq expressions.") (CL:MULTIPLE-VALUE-BIND (ENV MAP FILECREATEDLOC) (GET-ENVIRONMENT-AND-FILEMAP STREAM) (DECLARE (CL:SPECIAL FILECREATEDLOC)) (* ; " used by LOADFNSCAN") (WITH-READER-ENVIRONMENT ENV (create COMPFILEDESCR COMPFILESTREAM _ STREAM COMPFILEENV _ ENV COMPFILEMAP _ (LOADFNSCAN MAP) COMPFILEXPRS _ (DREVERSE DONELST))))))) (SETQ FNLST (for DESCR in FILEMAPLST join (for DEFQ in (CDR (fetch COMPFILEMAP of DESCR)) join (for X in (CDDR DEFQ) collect (CAR X))))) (* ;; "FILEMAPLST is a list of information about each file, including its name, filemap and non-defineq expressions. The first entry on the filemap is NIL. We start mapping down CDR of the filemap, and each element therein corresponds to a single DEFINEQ, in the form (start stop . fnEntries). fnEntries is a list of (FN start . stop), so the inner MAPCAR gathers up the names of the functions. The reason for not asking LOADFNS to do this is in most cases the map will already have been built, so LOADFNS won't even go inside of the defineq.") (for DESCR in FILEMAPLST do (for FORM in (fetch COMPFILEXPRS of DESCR) do (BCOMPL1A FORM (QUOTE DEFAULT) (QUOTE DEFAULT) (QUOTE DEFAULT)))) (* ;; "BCOMPL1A adds VARS set in the files to NOFIXVARSLST. NOFIXFNLST and NOFIXVARSLST are reset in case there is any dwimifying to be done BCOMPL1 also sets free variable OTHERS to list of expressions to be printed on compiled file when all is done.") (SETQ NOFIXFNSLST (APPEND NLAMA NLAML LAMS FNLST NOFIXFNSLST)) (WITH-READER-ENVIRONMENT (SETQ DESTINATIONENV (fetch COMPFILEENV of (CAR FILEMAPLST))) (* ; "Start writing the compiled file. Use environment of one of the source files--usually the only one") (if LCFIL then (PRINT-COMPILE-HEADER FILES (CONS (if NOBLOCKSFLG then (QUOTE recompiled) else (QUOTE brecompiled)) (if (EQ FNS (QUOTE ALL)) then (LIST (QUOTE ALL)) else (CONS (SELECTQ FNS (CHANGES (QUOTE changes%:)) ((EXPRS T) (QUOTE exprs%:)) (QUOTE explicitly%:)) (OR (SUBSET FNLST (FUNCTION (LAMBDA (X) (RECOMP? X FNS)))) (LIST (QUOTE nothing)))))) DESTINATIONENV)) (MAPC FNLST (FUNCTION (LAMBDA (X) (RCOMP3 X (VIRGINFN X))))) (if SCRATCHFILE then (* ;; "writes others on a scratchfile so space can be freed up. will be copied onto lcfil aftr compilation.") (for X in OTHERS do (PRINT X SCRATCHFILE)) (PRINT NIL SCRATCHFILE) (SETQ OTHERS NIL)) (for X in (PROGN FIRST) do (PRINT X LCFIL)) (OR DWIMIFYCOMPFLG (SETQ DWIMIFYCOMPFLG (EQMEMB (QUOTE CLISP) (GETPROP FILE (QUOTE FILETYPE))))) (OR (EQ FNS (QUOTE ALL)) (INPUT CFILE)) (if (NOT NOBLOCKSFLG) then (for BLOCK in BLOCKS do (if (NULL (CAR BLOCK)) then (BCOMPL2 BLOCK FILEMAPLST) elseif (for X in BLOCK thereis (AND (LITATOM X) (RECOMP? X FNS))) then (* ; "If any function in the BLOCK is to be recompiled, the whole BLOCK must be recompiled.") (BCOMPL2 BLOCK FILEMAPLST COREOK) else (BRECOMPILE1 BLOCK)))) (* ;; "NOBLOCKSFLG is T for calls from RECOMPILE. In this case, even if there were any blocks, ignore them.") (* ; "Now COMPILE rest of functions.") (for X in FNLST do (if (OR (FMEMB X BLKFNS) (FMEMB X DONTCOMPILEFNS)) elseif (RECOMP? X FNS) then (* ;; "The HELP is bcause if X is on FNS, then it follows X is in the file map, and brecompile3 should be able to produce its definition.") (COMPILE1 X (CADR (SETQ TEM (BRECOMPILE3 X FILEMAPLST COREOK))) (CADDR TEM)) else (BRECOMPILE1 X T)))) (RETURN (FULLNAME LCFIL)) NONRAND (SETQ MSG " is not RANDACCESSP") NONREC (printout T TEM MSG ", using " (if NOBLOCKSFLG then (QUOTE TCOMPL) else (QUOTE BCOMPL)) " instead." T) (RETURN (BCOMPL.BODY FILES NIL NOBLOCKSFLG)))))
)
[LAMBDA (FILES CFILE FNS NOBLOCKSFLG) (* ; "Edited 5-Jul-2021 09:28 by rmk:")
(* ;;; "FNS is a list of functions to be recompiled. The object is to make a file that looks exactly like that produced by BCOMPL except to greatly reduce the work by copying from CFILE the compiled definitions those functions not being recompiled.")
(* ;;; "BRECOMPILE is driven by the source file(s). The algorithm is whenever a DEFINEQ is encountered, process all of the functions in the DEFINEQ as follows: COMPILE the definition of the function if it is on the list FNS, or if FNS is EXPRS and the function is currently defined as an EXPR. Otherwise copy its compiled definition from CFILE. Note that functions with compiled definitions in CFILE that do not appear in PFILE are NOT copied. This corresponds to the case where functions have been deleted from the source file.")
(* ;;; "The value FNS = CHANGES means recompile anything marked changed in the file header.")
(* ;;; "(RECOMPILE file cfile fns) is equivalent to (BRECOMPILE file cfile fns T).")
(* ;;; "Note that CFILE=NIL is interpreted as meaning file.dcom even when FNS supplied.")
(RESETLST
(PROG ((*PRINT-ARRAY* T)
(*PRINT-LENGTH* NIL)
(*PRINT-LEVEL* NIL)
(NLAMA NLAMA)
(NLAML NLAML)
(LAMS LAMS)
(LAMA LAMA)
(DWIMIFYCOMPFLG DWIMIFYCOMPFLG)
(EXPRSLST NIL)
(NOFIXFNSLST NOFIXFNSLST)
(NOFIXVARSLST NOFIXVARSLST)
(BUILDMAPFLG T)
(SPECVARS T)
(LOCALVARS SYSLOCALVARS)
(AUXFILECOM T)
CHANGES OTHERS FIRST FILEMAPLST FNLST BLKFNS BLOCKS FILE FILE.COM TEM ADRLST
SCRATCHFILE COREOK DESTINATIONENV MSG)
(DECLARE (SPECVARS *PRINT-ARRAY* *PRINT-LENGTH* *PRINT-LEVEL* NLAMA NLAML LAMS
LAMA DWIMIFYCOMPFLG EXPRSLST NOFIXFNSLST NOFIXVARSLST BUILDMAPFLG
SPECVARS LOCALVARS CHANGES OTHERS FIRST BLKFNS BLOCKS
DESTINATIONENV ADRLST FILEMAPLST CFILE FNS FILE))
(COND
((AND (NULL CFILE)
(NULL FNS))
(SETQ FNS RECOMPILEDEFAULT)))
(RESETSAVE (INPUT))
(SETQ FILES (RESETOPENFILES FILES))
(COND
((SETQ TEM (for FILE in FILES when (NOT (RANDACCESSP FILE))
collect (FULLNAME FILE)))
(GO NONRAND)))
(SETQ FILE (UNPACKFILENAME (CAR FILES)))
(SETQ FILE.COM (PACKFILENAME 'HOST (CADR (FMEMB 'HOST FILE))
'DIRECTORY
(CADR (FMEMB 'DIRECTORY FILE))
'NAME
(SETQ FILE (CADR (FMEMB 'NAME FILE)))
'EXTENSION COMPILE.EXT))
(* ;; "Edited by TT (8-June-90 : for fix AR#2999)")
(COND
((EQ FNS 'ALL)
(GO BRECALL)))
CFILERETRY
(COND
([NLSETQ (SETQ CFILE (OPENSTREAM (OR CFILE FILE.COM)
'INPUT
'OLD NIL '((TYPE BINARY]
(COND
((NOT (RANDACCESSP CFILE))
(SETQ TEM (CLOSEF CFILE))
(GO NONRAND))
([OR [NULL (SETQ DESTINATIONENV (GET-ENVIRONMENT-AND-FILEMAP (CAR FILES]
(CL:MULTIPLE-VALUE-BIND (ENV DUMMY START)
(\PARSE-FILE-HEADER CFILE)
(COND
((OR (NULL ENV)
(NOT (EQUAL-READER-ENVIRONMENT ENV DESTINATIONENV)))
T)
(T (* "Position cfile back to start")
(SETFILEPTR CFILE START)
NIL]
(SETQ TEM (CLOSEF CFILE))
(SETQ MSG " has different reader environment than the new file")
(GO NONREC)))
(GO BREC))
((OR (AND (EQ AUXFILECOM T)
[SETQ AUXFILECOM (SPELLFILE (ROOTFILENAME (OR CFILE FILE.COM]
(SETQ CFILE AUXFILECOM)
(GO CFILERETRY))
(EQ (ASKUSER DWIMWAIT 'Y (LIST (OR CFILE FILE.COM)
"not found;" " compile all functions on "
(FULLNAME (CAR FILES))
'"instead"))
'Y)) (* ;
 "Edited by TT(8-June-90 : for Fix AR#8017)")
(GO BRECALL))
((EQ [ASKUSER DWIMWAIT 'Y (CONS '"Just forget about compiling"
(MAPCAR FILES (FUNCTION FULLNAME]
'Y)
(SELECTQ (CAR READBUF)
((ST F STF) (* "E.g. From CLEANUP.")
(SETQ READBUF (CDR READBUF)))
NIL)
(RETFROM 'BRECOMPILE))
(T (PRIN1
"File to use for CFILE (source of compiled definitions not being recompiled): "
T)
(SETQ CFILE (READ T T))
(GO CFILERETRY)))
BRECALL
(SETQQ FNS ALL)
(SETQ CFILE NIL)
BREC
(COMPSET NIL '(S T %
))
[SETQ LCFIL (OPENSTREAM FILE.COM 'OUTPUT 'NEW NIL '((TYPE BINARY]
(SETQ SCRATCHFILE (OPENSTREAM BCOMPL.SCRATCH 'BOTH 'NEW))
(RESETSAVE NIL (LIST 'BCOMPL3 CFILE FILES SCRATCHFILE))
(* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when brecompile finishes, or control-d or control-e occurs. Note that this call differs from the call for bcompl in that cfile is also specified. this corresponds to the fact that recompile has an extra file open.")
[SETQ COREOK (for X in FILES
always (AND (EQ (CDAR (GETPROP (SETQ TEM (ROOTFILENAME X))
'FILEDATES))
X)
(FMEMB (CDAR (GETPROP TEM 'FILE))
'(LOADFNS T]
[SETQ FILEMAPLST
(for STREAM in FILES
collect (LET ((LDFLG 'EXPRESSIONS)
(VARLST 'COMPILING)
DONELST FNLST)
(DECLARE (SPECVARS LDFLG VARLST DONELST FNLST))
(* ;
 "FNLST etc are used free in LOADFNSCAN")
(SETFILEPTR STREAM 0)
(INPUT STREAM)
(* ;; "LOADFNSCAN scans the file, building a map if one not already there. Value is the map. In addition, sets DONELST to a list of all non-defineq expressions.")
(CL:MULTIPLE-VALUE-BIND (ENV MAP FILECREATEDLOC)
(GET-ENVIRONMENT-AND-FILEMAP STREAM)
(DECLARE (CL:SPECIAL FILECREATEDLOC))
(* ; " used by LOADFNSCAN")
(WITH-READER-ENVIRONMENT ENV
(create COMPFILEDESCR
COMPFILESTREAM _ STREAM
COMPFILEENV _ ENV
COMPFILEMAP _ (LOADFNSCAN MAP)
COMPFILEXPRS _ (DREVERSE DONELST)))]
[SETQ FNLST (for DESCR in FILEMAPLST
join (for DEFQ in (CDR (fetch COMPFILEMAP of DESCR))
join (for X in (CDDR DEFQ)
collect (CAR X]
(* ;; "FILEMAPLST is a list of information about each file, including its name, filemap and non-defineq expressions. The first entry on the filemap is NIL. We start mapping down CDR of the filemap, and each element therein corresponds to a single DEFINEQ, in the form (start stop . fnEntries). fnEntries is a list of (FN start . stop), so the inner MAPCAR gathers up the names of the functions. The reason for not asking LOADFNS to do this is in most cases the map will already have been built, so LOADFNS won't even go inside of the defineq.")
[for DESCR in FILEMAPLST do (for FORM
in (fetch COMPFILEXPRS of DESCR)
do (BCOMPL1A FORM 'DEFAULT
'DEFAULT
'DEFAULT]
(* ;; "BCOMPL1A adds VARS set in the files to NOFIXVARSLST. NOFIXFNLST and NOFIXVARSLST are reset in case there is any dwimifying to be done BCOMPL1 also sets free variable OTHERS to list of expressions to be printed on compiled file when all is done.")
(SETQ NOFIXFNSLST (APPEND NLAMA NLAML LAMS FNLST NOFIXFNSLST))
(WITH-READER-ENVIRONMENT (SETQ DESTINATIONENV (fetch COMPFILEENV
of (CAR FILEMAPLST)))
(* ;
"Start writing the compiled file. Use environment of one of the source files--usually the only one")
(if LCFIL
then (\EXTERNALFORMAT LCFIL (OR (LISTGET DESTINATIONENV :FORMAT)
:XCCS))
(PRINT-COMPILE-HEADER
FILES
[CONS (if NOBLOCKSFLG
then 'recompiled
else 'brecompiled)
(if (EQ FNS 'ALL)
then (LIST 'ALL)
else (CONS (SELECTQ FNS
(CHANGES 'changes%:)
((EXPRS T)
'exprs%:)
'explicitly%:)
(OR [SUBSET FNLST (FUNCTION (LAMBDA (X)
(RECOMP? X FNS]
(LIST 'nothing]
DESTINATIONENV))
[MAPC FNLST (FUNCTION (LAMBDA (X)
(RCOMP3 X (VIRGINFN X]
(if SCRATCHFILE
then
(* ;; "writes others on a scratchfile so space can be freed up. will be copied onto lcfil aftr compilation.")
(\EXTERNALFORMAT SCRATCHFILE (\EXTERNALFORMAT LCFIL))
(for X in OTHERS do (PRINT X SCRATCHFILE))
(PRINT NIL SCRATCHFILE)
(SETQ OTHERS NIL))
(for X in (PROGN FIRST) do (PRINT X LCFIL))
[OR DWIMIFYCOMPFLG (SETQ DWIMIFYCOMPFLG (EQMEMB 'CLISP (GETPROP FILE 'FILETYPE]
(OR (EQ FNS 'ALL)
(INPUT CFILE))
[if (NOT NOBLOCKSFLG)
then (for BLOCK in BLOCKS
do (if (NULL (CAR BLOCK))
then (BCOMPL2 BLOCK FILEMAPLST)
elseif (for X in BLOCK
thereis (AND (LITATOM X)
(RECOMP? X FNS)))
then (* ;
 "If any function in the BLOCK is to be recompiled, the whole BLOCK must be recompiled.")
(BCOMPL2 BLOCK FILEMAPLST COREOK)
else (BRECOMPILE1 BLOCK]
(* ;; "NOBLOCKSFLG is T for calls from RECOMPILE. In this case, even if there were any blocks, ignore them.")
(* ; "Now COMPILE rest of functions.")
(for X in FNLST
do (if (OR (FMEMB X BLKFNS)
(FMEMB X DONTCOMPILEFNS))
elseif (RECOMP? X FNS)
then
(* ;; "The HELP is bcause if X is on FNS, then it follows X is in the file map, and brecompile3 should be able to produce its definition.")
(COMPILE1 X (CADR (SETQ TEM (BRECOMPILE3 X FILEMAPLST
COREOK)))
(CADDR TEM))
else (BRECOMPILE1 X T))))
(RETURN (FULLNAME LCFIL))
NONRAND
(SETQ MSG " is not RANDACCESSP")
NONREC
(printout T TEM MSG ", using " (if NOBLOCKSFLG
then 'TCOMPL
else 'BCOMPL)
" instead." T)
(RETURN (BCOMPL.BODY FILES NIL NOBLOCKSFLG))))])
(BRECOMPILE1
(LAMBDA (FN/BLOCK NOBLOCKSFLG) (* bvm%: "29-Aug-86 22:41")
@@ -1109,63 +1414,73 @@ with the terms of said license.
THEN (SETQ GLOBALVARS (UNION A GLOBALVARS])
)
(ADDTOVAR NOLINKFNS HELP ERRORX ERRORSET EVALV FAULTEVAL INTERRUPT SEARCHPDL MAPDL BREAK1 EDITE EDITL)
(ADDTOVAR NOLINKFNS HELP ERRORX ERRORSET EVALV FAULTEVAL INTERRUPT SEARCHPDL MAPDL BREAK1 EDITE
EDITL)
(ADDTOVAR LINKFNS)
(ADDTOVAR LINKFNS )
(ADDTOVAR FREEVARS)
(ADDTOVAR FREEVARS )
(ADDTOVAR SYSSPECVARS HELPCLOCK LISPXHIST RESETSTATE OLDVALUE UNDOSIDE0 SPECVARS LOCALVARS GLOBALVARS)
(ADDTOVAR SYSSPECVARS HELPCLOCK LISPXHIST RESETSTATE OLDVALUE UNDOSIDE0 SPECVARS LOCALVARS
GLOBALVARS)
(ADDTOVAR SYSLOCALVARS)
(ADDTOVAR SYSLOCALVARS )
(ADDTOVAR LOCALFREEVARS)
(ADDTOVAR LOCALFREEVARS )
(ADDTOVAR BLKLIBRARY)
(ADDTOVAR BLKLIBRARY )
(ADDTOVAR RETFNS)
(ADDTOVAR RETFNS )
(ADDTOVAR BLKAPPLYFNS)
(ADDTOVAR BLKAPPLYFNS )
(ADDTOVAR DONTCOMPILEFNS)
(ADDTOVAR DONTCOMPILEFNS )
(ADDTOVAR NLAML)
(ADDTOVAR NLAML )
(ADDTOVAR NLAMA)
(ADDTOVAR NLAMA )
(ADDTOVAR LAMS)
(ADDTOVAR LAMS )
(ADDTOVAR LAMA)
(ADDTOVAR LAMA )
(RPAQ? SPECVARS T)
(RPAQ? SPECVARS T)
(RPAQ? LOCALVARS SYSLOCALVARS)
(RPAQ? LOCALVARS SYSLOCALVARS)
(RPAQ? DWIMIFYCOMPFLG NIL)
(RPAQ? DWIMIFYCOMPFLG NIL)
(RPAQ? COMPILEHEADER "compiled on ")
(RPAQ? COMPILEHEADER "compiled on ")
(RPAQ? COMPSETLST (QUOTE (ST F STF S Y N 1 2 NIL T)))
(RPAQ? COMPSETLST '(ST F STF S Y N 1 2 NIL T))
(RPAQ? COMPSETKEYLST (QUOTE ((ST "ore and redefine " KEYLST ("" (F . "orget exprs"))) (S . "ame as last time") (F . "ile only") (T . "o terminal") (1) (2) (Y . "es") (N . "o"))))
(RPAQ? COMPSETKEYLST '((ST "ore and redefine " KEYLST ("" (F . "orget exprs")))
(S . "ame as last time")
(F . "ile only")
(T . "o terminal")
(1)
(2)
(Y . "es")
(N . "o")))
(RPAQ? COMPSETDEFAULTKEYLST (QUOTE ((Y . "es") (N . "o"))))
(RPAQ? COMPSETDEFAULTKEYLST '((Y . "es")
(N . "o")))
(RPAQ? BCOMPL.SCRATCH (QUOTE {CORE}BCOMPL.SCRATCH))
(RPAQ? BCOMPL.SCRATCH '{CORE}BCOMPL.SCRATCH)
(RPAQ? RECOMPILEDEFAULT (QUOTE CHANGES))
(RPAQ? RECOMPILEDEFAULT 'CHANGES)
(RPAQ? COUTFILE T)
(RPAQ? COUTFILE T)
(RPAQ? SVFLG T)
(RPAQ? SVFLG T)
(RPAQ? STRF T)
(RPAQ? STRF T)
(RPAQ? LSTFIL T)
(RPAQ? LSTFIL T)
(RPAQ? LCFIL)
(RPAQ? LCFIL )
(RPAQ? LAPFLG T)
(RPAQ? LAPFLG T)
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
@@ -1174,27 +1489,33 @@ with the terms of said license.
(DECLARE%: EVAL@COMPILE
(PUTPROPS DIGITCHARP MACRO (LAMBDA (CHAR) (AND (IGEQ CHAR (CHARCODE 0)) (ILEQ CHAR (CHARCODE 9)))))
(PUTPROPS DIGITCHARP MACRO [LAMBDA (CHAR)
(AND (IGEQ CHAR (CHARCODE 0))
(ILEQ CHAR (CHARCODE 9])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS SYSSPECVARS SYSLOCALVARS RECOMPILEDEFAULT COMPILE.EXT NOTCOMPILEDFILES BYTECOMPFLG COMPILEHEADER COMPVERSION BCOMPL.SCRATCH LINKEDFNS NOFIXVARSLST0 NOFIXFNSLST0 CLISPTRANFLG CLISPARRAY COMPSETKEYLST REREADFLG HISTSTR0 LISPXHISTORY COMPSETDEFAULTKEYLST FILERDTBL DWIMFLG DWIMWAIT)
(GLOBALVARS SYSSPECVARS SYSLOCALVARS RECOMPILEDEFAULT COMPILE.EXT NOTCOMPILEDFILES BYTECOMPFLG
COMPILEHEADER COMPVERSION BCOMPL.SCRATCH LINKEDFNS NOFIXVARSLST0 NOFIXFNSLST0 CLISPTRANFLG
CLISPARRAY COMPSETKEYLST REREADFLG HISTSTR0 LISPXHISTORY COMPSETDEFAULTKEYLST FILERDTBL
DWIMFLG DWIMWAIT)
)
)
(MOVD? (QUOTE NILL) (QUOTE FILECHANGES))
(MOVD? 'NILL 'FILECHANGES)
(CL:PROCLAIM (QUOTE (CL:SPECIAL COMPVARMACROHASH)))
(CL:PROCLAIM '(CL:SPECIAL COMPVARMACROHASH))
(CL:PROCLAIM (QUOTE (GLOBAL SYSSPECVARS SYSLOCALVARS COMPILE.EXT NOTCOMPILEDFILES CLISPARRAY FILERDTBL DWIMFLG DWIMWAIT LISPXHISTORY)))
(CL:PROCLAIM '(GLOBAL SYSSPECVARS SYSLOCALVARS COMPILE.EXT NOTCOMPILEDFILES CLISPARRAY FILERDTBL
DWIMFLG DWIMWAIT LISPXHISTORY))
(* ; "COMPILEMODE")
(PUTPROPS COMPILEMODELST VARTYPE ALIST)
(PUTPROPS COMPILEMODELST VARTYPE ALIST)
(DEFINEQ
(COMPILEMODE
@@ -1217,22 +1538,22 @@ with the terms of said license.
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA GLOBALVARS LOCALVARS SPECVARS BLOCK%:)
(ADDTOVAR NLAMA GLOBALVARS LOCALVARS SPECVARS BLOCK%:)
(ADDTOVAR NLAML BCOMPL3)
(ADDTOVAR NLAML BCOMPL3)
(ADDTOVAR LAMA)
(ADDTOVAR LAMA )
)
(PUTPROPS COMPILE COPYRIGHT ("Venue & Xerox Corporation" T 1984 1985 1986 1987 1988 1989 1990))
(PUTPROPS COMPILE COPYRIGHT ("Venue & Xerox Corporation" T 1984 1985 1986 1987 1988 1989 1990 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2714 65742 (BCOMPL 2724 . 4466) (BCOMPL.BODY 4468 . 10254) (PRINT-COMPILE-HEADER 10256
. 11319) (RESETOPENFILES 11321 . 11674) (BCOMPL1A 11676 . 17689) (BCOMPL2 17691 . 24506) (BCOMPL3
24508 . 25857) (BLOCK%: 25859 . 26491) (BRECOMPILE 26493 . 34961) (BRECOMPILE1 34963 . 40815) (
BRECOMPILE2 40817 . 41619) (BRECOMPILE3 41621 . 42997) (BLOCKCOMPILE 42999 . 44859) (BLOCKCOMPILE1
44861 . 49946) (COMPSET 49948 . 52711) (COMPSETREAD 52713 . 54024) (COMPSETY 54026 . 54150) (COMPSETF
54152 . 54318) (RCOMP3 54320 . 56027) (TCOMPL 56029 . 56328) (RECOMPILE 56330 . 56413) (RECOMP? 56415
. 56875) (COMPILE 56877 . 58866) (COMPILE1 58868 . 59456) (COMPILE1A 59458 . 61105) (
SHOULD-BE-DWIMIFIED? 61107 . 61796) (COMPILE.FILECHECK 61798 . 61944) (COMPEM 61946 . 62670) (GETCFILE
62672 . 64403) (SPECVARS 64405 . 64960) (LOCALVARS 64962 . 65536) (GLOBALVARS 65538 . 65740)) (67713
68662 (COMPILEMODE 67723 . 68660)))))
(FILEMAP (NIL (3770 74020 (BCOMPL 3780 . 5430) (BCOMPL.BODY 5432 . 12011) (PRINT-COMPILE-HEADER 12013
. 13076) (RESETOPENFILES 13078 . 13431) (BCOMPL1A 13433 . 19446) (BCOMPL2 19448 . 26263) (BCOMPL3
26265 . 27614) (BLOCK%: 27616 . 28248) (BRECOMPILE 28250 . 43239) (BRECOMPILE1 43241 . 49093) (
BRECOMPILE2 49095 . 49897) (BRECOMPILE3 49899 . 51275) (BLOCKCOMPILE 51277 . 53137) (BLOCKCOMPILE1
53139 . 58224) (COMPSET 58226 . 60989) (COMPSETREAD 60991 . 62302) (COMPSETY 62304 . 62428) (COMPSETF
62430 . 62596) (RCOMP3 62598 . 64305) (TCOMPL 64307 . 64606) (RECOMPILE 64608 . 64691) (RECOMP? 64693
. 65153) (COMPILE 65155 . 67144) (COMPILE1 67146 . 67734) (COMPILE1A 67736 . 69383) (
SHOULD-BE-DWIMIFIED? 69385 . 70074) (COMPILE.FILECHECK 70076 . 70222) (COMPEM 70224 . 70948) (GETCFILE
70950 . 72681) (SPECVARS 72683 . 73238) (LOCALVARS 73240 . 73814) (GLOBALVARS 73816 . 74018)) (76481
77430 (COMPILEMODE 76491 . 77428)))))
STOP