(FILECREATED "25-Jun-86 12:37:48" {ERIS}<LISPCORE>SOURCES>RENAMEFNS.;3 10801
changes to: (FNS DORENAME DORENAME0 RENAMEFN RENAMEDVAL MAKECOMP RNSUBST)
(VARS RENAMEFNSCOMS)
previous date: "15-Mar-86 21:25:58" {ERIS}<LISPCORE>SOURCES>RENAMEFNS.;2)
(* Copyright (c) 1982, 1984, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RENAMEFNSCOMS)
(RPAQQ RENAMEFNSCOMS ((FNS DORENAME DORENAME0 RENAMEFN RENAMEDVAL MAKECOMP RNSUBST)
(FILES (SOURCE)
FILESETS)
(BLOCKS (RNSUBST RNSUBST (NOLINKFNS . T)))
(GLOBALVARS RENAMEHASH RENAMETYPE EXPANDMACROFNS RENAMETYPES INITCONSTANTS
RENAMEFNSPAIRS VAG2FN RENAMEDFILE NEWCOMS EXTRACOMS)))
(DEFINEQ
(DORENAME
[LAMBDA (TYPE NOLOADFLG MINIMALFLG) (* bvm: "16-Jun-86 15:35")
(DORENAME0 (SETQ RENAMETYPE TYPE)
NOLOADFLG MINIMALFLG)
(for X in RENAMEFNSPAIRS do (RENAMEFN (CAR X)
(CDR X)))
(MAKECOMP RENAMEDFILE (APPEND (RENAMEDVAL NEWCOMS)
EXTRACOMS])
(DORENAME0
[LAMBDA (TYPE NOLOAD MINIMALFLG) (* bvm: "16-Jun-86 15:34")
(PROG (LISPXHIST RENAMEALIST)
(DECLARE (SPECVARS . T))
[MAPC (CDR (ASSOC (OR TYPE (QUOTE I))
RENAMETYPES))
(FUNCTION (LAMBDA (X)
(SETATOMVAL (CAR X)
(CDR X]
[RESETVARS ((LOADDBFLG (QUOTE NO))
(NOSPELLFLG T)
(CROSSCOMPILING T))
(FILESLOAD (SYSLOAD)
DTDECLARE)
(for X in FILES do (COND
(MINIMALFLG (PRINT (LOADFROM X)
T T))
(T (* Load whole file, getting fn
definitions at the same time)
(LOAD X (QUOTE PROP]
[SETQ ALLFNS (INFILECOMS? NIL (QUOTE FNS)
(SETQ NEWCOMS (GETATOMVAL COMSNAME]
[COND
(MINIMALFLG (* Load the fns specified as needed by
NEWCOMS)
(RESETVARS ((NOSPELLFLG T))
(MAPC FILES (FUNCTION (LAMBDA (FILE)
(LOADFNS ALLFNS FILE (QUOTE PROP]
[SETQ NEWCOMS (MAPCAR NEWCOMS (FUNCTION (LAMBDA (X)
(COND
[(EQ (CADR X)
(QUOTE *))
(CONS (CAR X)
(EVAL (CADDR X]
(T X]
(SETQ RENAMEALIST (GETATOMVAL SUBNAME))
[SETQ RENAMEFNSPAIRS (MAPCAR (INFILECOMS? NIL (QUOTE FNS)
NEWCOMS)
(FUNCTION (LAMBDA (FN)
(CONS FN (OR (CDR (ASSOC FN RENAMEALIST))
(PACK* PREFIX FN]
(SETQ RENAMEHASH (HASHARRAY (LENGTH RENAMEALIST))) (* "Store SUBNAME associations in hash array for faster access. First add other things, then elts of SUBNAME, since they have absolute precedence over anything implicitly declared here")
(for X in INITCONSTANTS when (AND (NEQ (CAR X)
(QUOTE *))
(LISTP (CADR X)))
do (*
"Do substitutions on all constants declared as addresses")
(PUTHASH (CAR X)
(LIST VAG2FN (CAADR X)
(CADR (CADR X)))
RENAMEHASH))
(for X in (APPEND (GETATOMVAL VALUES)
(GETATOMVAL PTRS)) when (NEQ (CAR X)
(QUOTE *))
do (* "These are global variables containing simple values and pointers that are renamed so that the operations on them happen in the remote image instead of the local one.")
(PUTHASH (CAR X)
(PACK* PREFIX (SUBSTRING (CAR X)
2 -1))
RENAMEHASH))
(for X in FILES do (for Y in (FILECOMSLST X (QUOTE CONSTANTS))
do (*
"Arrange for all constants to be substituted explicitly, rather than rely on the compiler to do so")
(PUTHASH Y (COND
((OR (NULL (SETQ Y (EVAL Y)))
(EQ Y T)
(NUMBERP Y))
Y)
(T (LIST (QUOTE QUOTE)
Y)))
RENAMEHASH)))
(for PAIR in (APPEND RENAMEFNSPAIRS RENAMEALIST) do (PUTHASH (CAR PAIR)
(CDR PAIR)
RENAMEHASH])
(RENAMEFN
[LAMBDA (OFN NFN) (* bvm: "14-Jun-86 17:30")
(until [ERSETQ (RESETVARS ((NOSPELLFLG T)
(DWIMESSGAG T)
(DWIMUSERFORMS))
(/PUTD NFN (RNSUBST (OR (AND (EXPRP OFN)
(GETD OFN))
(GETDEF OFN)
(HELP OFN (QUOTE (no DEFINITION FOUND]
do (HELP OFN (QUOTE (rename failed -- RETURN to try again])
(RENAMEDVAL
[LAMBDA (VAL) (* bvm: "14-Jun-86 17:30")
(RESETVARS ((NOSPELLFLG T)
(DWIMESSGAG T)
(DWIMUSERFORMS))
(RETURN (RNSUBST VAL])
(MAKECOMP
[LAMBDA (FILE COMS) (* bvm: "14-Jun-86 17:31")
(LET (FULL)
(SETATOMVAL (FILECOMS FILE)
COMS)
[RESETVARS ((COPYRIGHTFLG (QUOTE NEVER))
PRETTYFLG USEMAPFLG MAKEFILEREMAKEFLG)
(SETQ FULL (MAKEFILE FILE (QUOTE (NEW]
(LISPXUNREAD (QUOTE (F)))
(LIST FULL (RESETVARS (DONTCOMPILEFNS)
(RETURN (BRECOMPILE FULL NIL (QUOTE ALL])
(RNSUBST
[LAMBDA (X) (* bvm: "14-Jun-86 17:32")
(COND
((NLISTP X)
(OR (GETHASH X RENAMEHASH)
X))
(T (PROG ((A (CAR X)))
(COND
((LISTP A)
(GO LST)))
[RETURN (SELECTQ A
(* (QUOTE (*)))
(LOCAL (COND
[(LISTP (CADR X))
(CONS (CAADR X)
(MAPCAR (CDADR X)
(FUNCTION RNSUBST]
(T (CADR X))))
(UNLESSRDSYS (SELECTQ RENAMETYPE
(R (RNSUBST (CADDR X)))
(RNSUBST (CADR X))))
(ALLOCAL (CADR X))
(OPENLAMBDA (CONS (QUOTE LAMBDA)
(RNSUBST (CDR X))))
(COND
[(FMEMB [CAR (LISTP (GETPROP A (QUOTE CLISPWORD]
(QUOTE (RECORDTRAN CHANGETRAN)))
(* most CLISP forms don't need or want
to substitute under, but do so for
record expressions)
(RNSUBST (OR (GETHASH (DWIMIFY X T)
CLISPARRAY)
(PROGN (HELP X "DWIM failed")
X]
[(SETQ A (GETHASH A RENAMEHASH))
(RNSUBST (CONS A (CDR X]
((FMEMB (CAR X)
EXPANDMACROFNS)
[RESETVARS [(COMPILERMACROPROPS (QUOTE (DMACRO ALTOMACRO BYTEMACRO
MACRO]
(COND
((EQUAL X (SETQ X (EXPANDMACRO X T)))
(HELP X (QUOTE "macro expansion failed"]
(RNSUBST X))
(T (SETQ A (DOCOLLECT (CAR X)))
(GO NXT]
LST (SETQ A)
DLP (SETQ A (DOCOLLECT (RNSUBST (CAR X))
A))
NXT (AND (LISTP (SETQ X (CDR X)))
(GO DLP))
(RETURN (ENDCOLLECT A (RNSUBST X])
)
(FILESLOAD (SOURCE)
FILESETS)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: RNSUBST RNSUBST (NOLINKFNS . T))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS RENAMEHASH RENAMETYPE EXPANDMACROFNS RENAMETYPES INITCONSTANTS RENAMEFNSPAIRS VAG2FN
RENAMEDFILE NEWCOMS EXTRACOMS)
)
(PUTPROPS RENAMEFNS COPYRIGHT ("Xerox Corporation" 1982 1984 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (813 10410 (DORENAME 823 . 1230) (DORENAME0 1232 . 6132) (RENAMEFN 6134 . 6764) (
RENAMEDVAL 6766 . 7014) (MAKECOMP 7016 . 7525) (RNSUBST 7527 . 10408)))))
STOP