(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) (FILECREATED "29-Jan-98 15:47:09" |{DSK}disk2>jdstools>lc3>lispcore3.0>sources>RENAMEFNS.;2| 13941 |changes| |to:| (VARS RENAMEFNSCOMS) (FNS DORENAME RENAMEFN) |previous| |date:| " 6-Nov-92 19:47:12" |{DSK}disk2>jdstools>lc3>lispcore3.0>sources>RENAMEFNS.;1|) ; Copyright (c) 1982, 1984, 1986, 1990, 1991, 1992, 1998 by Venue & Xerox Corporation. All rights reserved. (PRETTYCOMPRINT RENAMEFNSCOMS) (RPAQQ RENAMEFNSCOMS ( (* |;;|  "Create \"retargeted\" functions, to read/write to sysout files, rather than to memory.") (* |;;| "(DORENAME 'I creates I-NEW in makeinit") (* |;;| "(DORENAME 'R) creates RDSYS for library.") (* |;;| "") (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))) (* |;;| "Create \"retargeted\" functions, to read/write to sysout files, rather than to memory.") (* |;;| "(DORENAME 'I creates I-NEW in makeinit") (* |;;| "(DORENAME 'R) creates RDSYS for library.") (* |;;| "") (DEFINEQ (DORENAME (LAMBDA (TYPE NOLOADFLG MINIMALFLG) (* |bvm:| "16-Jun-86 15:35") (DORENAME0 (SETQ RENAMETYPE TYPE) NOLOADFLG MINIMALFLG) (RESETVARS ((LOADDBFLG 'NO) (NOSPELLFLG T) (CROSSCOMPILING T)) (|for| X |in| RENAMEFNSPAIRS |do| (RENAMEFN (CAR X) (CDR X)))) (MAKECOMP RENAMEDFILE (APPEND (RENAMEDVAL NEWCOMS) EXTRACOMS)))) (DORENAME0 (LAMBDA (TYPE NOLOAD MINIMALFLG) (* \; "Edited 24-Jan-91 10:35 by jds") (PROG (LISPXHIST RENAMEALIST) (DECLARE (SPECVARS . T)) (MAPC (CDR (ASSOC (OR TYPE 'I) RENAMETYPES)) (FUNCTION (LAMBDA (X) (SETATOMVAL (CAR X) (CDR X))))) (RESETVARS ((LOADDBFLG 'NO) (NOSPELLFLG T) (CROSSCOMPILING T)) (FILESLOAD (SYSLOAD) DTDECLARE) (|for| X |in| FILES |do| (COND (MINIMALFLG (PRINT (LOADFROM (FINDFILE X)) T T)) (T (* \;  "Load whole file, getting fn definitions at the same time") (LOAD (FINDFILE X) 'PROP) (LOADCOMP (FINDFILE X)) (* \;  "May need to LOADCOMP because the file's functions use local macros and optimizers....") )))) (SETQ ALLFNS (INFILECOMS? NIL '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 'PROP))))))) (SETQ NEWCOMS (MAPCAR NEWCOMS (FUNCTION (LAMBDA (X) (COND ((EQ (CADR X) '*) (CONS (CAR X) (EVAL (CADDR X)))) (T X)))))) (SETQ RENAMEALIST (GETATOMVAL SUBNAME)) (SETQ RENAMEFNSPAIRS (MAPCAR (INFILECOMS? NIL '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) '*) (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) '*) |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 '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 Y))) RENAMEHASH))) (|for| PAIR |in| (APPEND RENAMEFNSPAIRS RENAMEALIST) |do| (PUTHASH (CAR PAIR) (CDR PAIR) RENAMEHASH))))) (RENAMEFN (LAMBDA (OFN NFN) (* |bvm:| "24-Jul-86 10:57") (|until| (ERSETQ (RESETVARS ((NOSPELLFLG T) (DWIMESSGAG T) (DWIMUSERFORMS)) (LET ((NEWDEF (RNSUBST (GETDEF OFN)))) (COND ((EXPRP NFN) (* |Redefine| |existing| |expr| |to|  |avoid| |confusing| |filepkg|) (/PUTD NFN NEWDEF)) (T (/PUTPROP NFN 'EXPR NEWDEF)))))) |do| (HELP OFN "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 'NEVER) PRETTYFLG USEMAPFLG MAKEFILEREMAKEFLG) (SETQ FULL (MAKEFILE FILE '(NEW)))) (LISPXUNREAD '(F)) (LIST FULL (RESETVARS (DONTCOMPILEFNS) (RETURN (BRECOMPILE FULL NIL 'ALL))))))) (RNSUBST (LAMBDA (X) (* \;  "Edited 6-Nov-92 19:46 by sybalsky:mv:envos") (* |;;| "Make substitutions during a rename.") (COND ((NLISTP X) (OR (GETHASH X RENAMEHASH) X)) (T (LET ((A (CAR X)) (ENV (COMPILER::MAKE-ENV))) (* \;  "May need the ENV when we expand optimizers, since they can depend on the compiler environment.") (COND ((LISTP A) (* \;  "Translate LAMBDA forms recursively just like other elements") (COND ((EQ (CAR A) 'OPENLAMBDA) (RNSUBST (EXPANDOPENLAMBDA A (MAPCAR (CDR X) (FUNCTION RNSUBST))))) (T (MAPCAR X (FUNCTION RNSUBST))))) (T (SELECTQ A (* (* \; "LEAVE COMMENT PLACEHOLDERS") (CONS '* NIL)) (LOCAL (LET ((EXPR (CADR X))) (COND ((LISTP EXPR) (CONS (CAR EXPR) (MAPCAR (CDR EXPR) (FUNCTION RNSUBST)))) (T EXPR)))) (UNLESSRDSYS (SELECTQ RENAMETYPE (R (RNSUBST (CADDR X))) (RNSUBST (CADR X)))) (ALLOCAL (CADR X)) (QUOTE (* \; "Don't walk quoted forms") X) (COND ((FMEMB (CAR (LISTP (GETPROP A 'CLISPWORD))) '(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 '(DMACRO ALTOMACRO BYTEMACRO MACRO))) (LET ((OPTS (GET (CAR X) 'COMPILER:OPTIMIZER-LIST)) (TRY-MACROS T)) (* |;;| "Try expanding its optimizers:") (CL:WHEN OPTS (|for| OPT |in| OPTS |do| (LET ((RESULT (APPLY* OPT X ENV NIL))) (CL:WHEN (AND (NEQ RESULT X) (NEQ RESULT 'IGNOREMACRO) (NEQ RESULT 'COMPILER:PASS) ) (SETQ X RESULT) (SETQ TRY-MACROS NIL))))) (* |;;| "Try expanding it as a macro:") (CL:WHEN TRY-MACROS (LET ((EXPANDED-FORM (CL:MACROEXPAND-1 X))) (CL:IF (EQ EXPANDED-FORM X) (HELP X "macro expansion failed") (SETQ X EXPANDED-FORM)))))) (RNSUBST X)) (T (CONS (CAR X) (MAPCAR (CDR X) (FUNCTION RNSUBST))))))))))))) ) (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 ("Venue & Xerox Corporation" 1982 1984 1986 1990 1991 1992 1998)) (DECLARE\: DONTCOPY (FILEMAP (NIL (1664 13516 (DORENAME 1674 . 2231) (DORENAME0 2233 . 7591) (RENAMEFN 7593 . 8395) ( RENAMEDVAL 8397 . 8646) (MAKECOMP 8648 . 9137) (RNSUBST 9139 . 13514))))) STOP