From c2afb8265b59400702557349e4df1a0065852adf Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Fri, 19 Mar 2021 18:15:18 -0700 Subject: [PATCH] Undid prior attempt to optimize (#283) --- internal/library/MEDLEY-UTILS | 2 +- internal/library/MEDLEY-UTILS.LCOM | Bin 4097 -> 4132 bytes 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/internal/library/MEDLEY-UTILS b/internal/library/MEDLEY-UTILS index 53bf307f..24c1fb5b 100644 --- a/internal/library/MEDLEY-UTILS +++ b/internal/library/MEDLEY-UTILS @@ -1 +1 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP") (FILECREATED "15-Mar-2021 20:27:00"  |{DSK}larry>ilisp>medley>internal>library>MEDLEY-UTILS.;8| 6889 |changes| |to:| (FNS MAKE-WHEREIS-HASH) |previous| |date:| "11-Mar-2021 23:31:16" |{DSK}larry>ilisp>medley>internal>library>MEDLEY-UTILS.;7|) (PRETTYCOMPRINT MEDLEY-UTILSCOMS) (RPAQQ MEDLEY-UTILSCOMS ((FNS GATHER-INFO MEDLEY-FIX-LINKS MEDLEY-FIX-DATES) (VARS MEDLEY-FIX-DIRS) (FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH))) (DEFINEQ (GATHER-INFO (LAMBDA (PHASE) (* \; "Edited 3-Mar-2021 13:29 by larry") (SELECTQ PHASE (0 (SETQ LOADEDFILES (FOR X IN LOADEDFILELST COLLECT (FILENAMEFIELD X 'NAME))) (PRINTOUT T " loaded files not in SYSFILES or FILELST: " (FOR X IN LOADEDFILES WHEN (NOT (OR (FMEMB X SYSFILES) (FMEMB X FILELST))) COLLECT X) T) (FILESLOAD FILESETS) (SETQ ALLFILESETSFILES (FOR X IN FILESETS JOIN (APPEND (EVAL X)))) (PRINTOUT T "Files in FILESETS not loaded " (CL:SET-DIFFERENCE ALLFILESETSFILES LOADEDFILES) T) (SETQ SOURCES (FOR X IN (DIRECTORY (MEDLEYDIR "sources" "*.*;" T)) WHEN (NOT (MEMB (FILENAMEFIELD X 'EXTENSION) '(LCOM DFASL TEDIT TXT))) COLLECT (FILENAMEFIELD X 'NAME))) (PRINTOUT T "Sources not loaded: " (CL:SET-DIFFERENCE SOURCES (APPEND FILELST SYSFILES ALLFILESETSFILES)) T)) (1 (FOR X IN SYSFILES DO (LOAD X 'PROP) (PUTPROP X 'CONTENT (READFILE X)) (FOR EXR IN (GETPROP X 'CONTENT) DO (SELECTQ (CAR EXR) (DEFINEQ (FOR DFN IN (CDR EXR) DO (IF (EQUAL (CADR DFN) (GETPROP (CAR DFN) 'EXPR)) THEN (PRINTOUT T (CAR DFN) " ") (PUTPROP (CAR DFN) 'EXPR (CADR DFN)) ELSE (PRINTOUT T (CAR DFN) "* ")))) NIL))) (SETQ DEFINEDFNS (LET ((DEFD NIL)) (MAPATOMS (FUNCTION (CL:LAMBDA (X) (CL:WHEN (GETD X) (CL:SETQ DEFD (CONS X DEFD)))))))) (LET (DUPS) (FOR X IN SYSFILES DO (FOR FN IN (FILEFNSLST X) DO (IF (GETPROP FN 'WHEREIS) THEN (NCONC1 (GETPROP FN 'WHEREIS) X) (OR (FMEMB FN DUPS) (SETQ DUPS (CONS FN DUPS))) ELSE (PUTPROP FN 'WHEREIS (LIST X))))) (SETQ DUPFNS DUPS)) (PRINTOUT T "Functions on more than one file: " DUPFNS T)) (2 (FOR X IN SYSFILES DO (MASTERSCOPE `(ANALYZE ON ,X)))) (HELP)))) (MEDLEY-FIX-LINKS (LAMBDA (UNIXPATH) (* \; "Edited 18-Jan-2021 12:01 by larry") (OR UNIXPATH (SETQ UNIXPATH (UNIX-GETENV "MEDLEYDIR")) (ERROR "No Directory")) (* \; "Edited 18-Jan-2021 11:45 by larry") (|ShellCommand| (CONCAT "cd " UNIXPATH " && /bin/sh scripts/fixlinks && /bin/sh /tmp/doit")))) (MEDLEY-FIX-DATES (LAMBDA (DIRS) (* \; "Edited 28-Jan-2021 12:15 by larry") (|for| X |in| (OR DIRS MEDLEY-FIX-DIRS) |join| (FIX-DIRECTORY-DATES (MEDLEYDIR (PRINT X T)))))) ) (RPAQQ MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal/library" "greetfiles" "docs>Documentation Tools")) (DEFINEQ (MAKE-EXPORTS-ALL (LAMBDA NIL (* \; "Edited 9-Mar-2021 16:11 by larry") (* "Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/. Don't know why it does the CORE/RENAME") (*  "Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory.") (*  "Edited July 5, 1990 by Sybalsky -- point it to Pele as the truth directory.") (*  "Edited September 29, 1986 by van Melle") (CNDIR (MEDLEYDIR "sources")) (LOAD 'FILESETS) (GATHEREXPORTS EXPORTFILES (MEDLEYDIR "tmp" "exports.all" T)))) (MAKE-WHEREIS-HASH (LAMBDA NIL (* \; "Edited 15-Mar-2021 20:25 by larry") (LET ((FILING.ENUMERATION.DEPTH 1) HASHFILE) (DRIBBLE (MEDLEYDIR "tmp" "whereis.dribble" T)) (SETQ HASHFILE (XCL::WHERE-IS-NOTICE "{CORE}WHEREIS.HASH" :FILES (|for| X |in| MEDLEY-FIX-DIRS |collect| (CONCAT (MEDLEYDIR X) "*.;")) :HASH-FILE-SIZE 30000 :NEW T)) (RENAMEFILE HASHFILE (MEDLEYDIR "tmp" "whereis.hash" T)) (DRIBBLE)))) ) (DECLARE\: DONTCOPY (FILEMAP (NIL (579 5020 (GATHER-INFO 589 . 4323) (MEDLEY-FIX-LINKS 4325 . 4714) (MEDLEY-FIX-DATES 4716 . 5018)) (5178 6866 (MAKE-EXPORTS-ALL 5188 . 6137) (MAKE-WHEREIS-HASH 6139 . 6864))))) STOP \ No newline at end of file +(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP") (FILECREATED "18-Mar-2021 19:24:10"  |{DSK}larry>ilisp>medley>internal>library>MEDLEY-UTILS.;10| 6939 |changes| |to:| (FNS MAKE-WHEREIS-HASH) |previous| |date:| "15-Mar-2021 20:27:00" |{DSK}larry>ilisp>medley>internal>library>MEDLEY-UTILS.;9|) (PRETTYCOMPRINT MEDLEY-UTILSCOMS) (RPAQQ MEDLEY-UTILSCOMS ((FNS GATHER-INFO MEDLEY-FIX-LINKS MEDLEY-FIX-DATES) (VARS MEDLEY-FIX-DIRS) (FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH))) (DEFINEQ (GATHER-INFO (LAMBDA (PHASE) (* \; "Edited 3-Mar-2021 13:29 by larry") (SELECTQ PHASE (0 (SETQ LOADEDFILES (FOR X IN LOADEDFILELST COLLECT (FILENAMEFIELD X 'NAME))) (PRINTOUT T " loaded files not in SYSFILES or FILELST: " (FOR X IN LOADEDFILES WHEN (NOT (OR (FMEMB X SYSFILES) (FMEMB X FILELST))) COLLECT X) T) (FILESLOAD FILESETS) (SETQ ALLFILESETSFILES (FOR X IN FILESETS JOIN (APPEND (EVAL X)))) (PRINTOUT T "Files in FILESETS not loaded " (CL:SET-DIFFERENCE ALLFILESETSFILES LOADEDFILES) T) (SETQ SOURCES (FOR X IN (DIRECTORY (MEDLEYDIR "sources" "*.*;" T)) WHEN (NOT (MEMB (FILENAMEFIELD X 'EXTENSION) '(LCOM DFASL TEDIT TXT))) COLLECT (FILENAMEFIELD X 'NAME))) (PRINTOUT T "Sources not loaded: " (CL:SET-DIFFERENCE SOURCES (APPEND FILELST SYSFILES ALLFILESETSFILES)) T)) (1 (FOR X IN SYSFILES DO (LOAD X 'PROP) (PUTPROP X 'CONTENT (READFILE X)) (FOR EXR IN (GETPROP X 'CONTENT) DO (SELECTQ (CAR EXR) (DEFINEQ (FOR DFN IN (CDR EXR) DO (IF (EQUAL (CADR DFN) (GETPROP (CAR DFN) 'EXPR)) THEN (PRINTOUT T (CAR DFN) " ") (PUTPROP (CAR DFN) 'EXPR (CADR DFN)) ELSE (PRINTOUT T (CAR DFN) "* ")))) NIL))) (SETQ DEFINEDFNS (LET ((DEFD NIL)) (MAPATOMS (FUNCTION (CL:LAMBDA (X) (CL:WHEN (GETD X) (CL:SETQ DEFD (CONS X DEFD)))))))) (LET (DUPS) (FOR X IN SYSFILES DO (FOR FN IN (FILEFNSLST X) DO (IF (GETPROP FN 'WHEREIS) THEN (NCONC1 (GETPROP FN 'WHEREIS) X) (OR (FMEMB FN DUPS) (SETQ DUPS (CONS FN DUPS))) ELSE (PUTPROP FN 'WHEREIS (LIST X))))) (SETQ DUPFNS DUPS)) (PRINTOUT T "Functions on more than one file: " DUPFNS T)) (2 (FOR X IN SYSFILES DO (MASTERSCOPE `(ANALYZE ON ,X)))) (HELP)))) (MEDLEY-FIX-LINKS (LAMBDA (UNIXPATH) (* \; "Edited 18-Jan-2021 12:01 by larry") (OR UNIXPATH (SETQ UNIXPATH (UNIX-GETENV "MEDLEYDIR")) (ERROR "No Directory")) (* \; "Edited 18-Jan-2021 11:45 by larry") (|ShellCommand| (CONCAT "cd " UNIXPATH " && /bin/sh scripts/fixlinks && /bin/sh /tmp/doit")))) (MEDLEY-FIX-DATES (LAMBDA (DIRS) (* \; "Edited 28-Jan-2021 12:15 by larry") (|for| X |in| (OR DIRS MEDLEY-FIX-DIRS) |join| (FIX-DIRECTORY-DATES (MEDLEYDIR (PRINT X T)))))) ) (RPAQQ MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal/library" "greetfiles" "docs>Documentation Tools")) (DEFINEQ (MAKE-EXPORTS-ALL (LAMBDA NIL (* \; "Edited 9-Mar-2021 16:11 by larry") (* "Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/. Don't know why it does the CORE/RENAME") (*  "Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory.") (*  "Edited July 5, 1990 by Sybalsky -- point it to Pele as the truth directory.") (*  "Edited September 29, 1986 by van Melle") (CNDIR (MEDLEYDIR "sources")) (LOAD 'FILESETS) (GATHEREXPORTS EXPORTFILES (MEDLEYDIR "tmp" "exports.all" T)))) (MAKE-WHEREIS-HASH (LAMBDA NIL (* \; "Edited 18-Mar-2021 19:21 by larry") (LET ((FILING.ENUMERATION.DEPTH 1) HASHFILE) (DRIBBLE (MEDLEYDIR "tmp" "whereis.dribble" T)) (SETQ HASHFILE (XCL::WHERE-IS-NOTICE (MEDLEYDIR "tmp" "whereis.hash-tmp" T) :FILES (|for| X |in| MEDLEY-FIX-DIRS |collect| (CONCAT (MEDLEYDIR X) "*.;")) :HASH-FILE-SIZE 40000 :NEW T)) (RENAMEFILE HASHFILE (MEDLEYDIR "tmp" "whereis.hash" T)) (DRIBBLE)))) ) (DECLARE\: DONTCOPY (FILEMAP (NIL (580 5021 (GATHER-INFO 590 . 4324) (MEDLEY-FIX-LINKS 4326 . 4715) (MEDLEY-FIX-DATES 4717 . 5019)) (5179 6916 (MAKE-EXPORTS-ALL 5189 . 6138) (MAKE-WHEREIS-HASH 6140 . 6914))))) STOP \ No newline at end of file diff --git a/internal/library/MEDLEY-UTILS.LCOM b/internal/library/MEDLEY-UTILS.LCOM index e0228ec9e4f81f6ee9250d950fe2fc58df918681..8234db39d87857516535d848c860c2a47ee2f124 100644 GIT binary patch delta 437 zcmZXP!AiqG5Qa@J3MKW>n+F*d1Y4T2yGdGi6*Ns&5=c`_3f1;vYYPopT2euTf_U|0 z$FD*Eyf9C&ZKIRoZ;oU8sXw812QA`OC#;L)HzU*C<30{-{5xV8l z%*7Oex)>y*yXj;WKa7Tp-Ot1S0%k$$U{u5N-8dX0uJfan-P z5m-%;(ScACn!@qLjpKzta2>8~pYx6@LZNw)7PQ))EuhB0ZUwg029s^&4V+dAM=u0p z;DP7>qrhD&a<%NX7I|F(h6z0DBKa>6!T>#uN69FjSI7PN7|D?V=y5VbP?MruJw>2P Yu^rOZHkGSuLG+D1Oya>{^;2NVAG0=aKL7v# delta 387 zcmZXP&q~8U5Qo`bJV=Vrn+F*d1S_UwH%Yr$K}nO;urxgAkj zi)cYd_@OxQWeiRej=hlcejs9@%S4a5J?ROs8F<~ub9-Phby(dTG6#4h`oIYAz)b?Z zgz1Sq6<}Jx%ajz40WlchyHT2@<5^=gn2m7JG6COArWov^*lz4%pbp@BuN#YpAF)gt KC3Epv4beBgePZ|k