From 7d8efbdfd6aacd591b248d4ccf90092bfe036c0d Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Sun, 28 Mar 2021 11:27:21 -0700 Subject: [PATCH] Fix MAKESYSNAME (misspelled) and move GATHER-INFO to my personal init --- internal/library/MEDLEY-UTILS | 2 +- internal/library/MEDLEY-UTILS.LCOM | Bin 5050 -> 1966 bytes sources/LOADUP-LISP | 2 +- sources/LOADUP-LISP.LCOM | Bin 6175 -> 6140 bytes 4 files changed, 2 insertions(+), 2 deletions(-) diff --git a/internal/library/MEDLEY-UTILS b/internal/library/MEDLEY-UTILS index b08017d0..131ee56d 100644 --- a/internal/library/MEDLEY-UTILS +++ b/internal/library/MEDLEY-UTILS @@ -1 +1 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP") (FILECREATED "24-Mar-2021 15:45:15"  |{DSK}larry>ilisp>medley>internal>library>MEDLEY-UTILS.;2| 8564 |changes| |to:| (FNS GATHER-INFO MAKE-WHEREIS-HASH) |previous| |date:| "18-Mar-2021 19:24:10" |{DSK}larry>ilisp>medley>internal>library>MEDLEY-UTILS.;1|) (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 24-Mar-2021 15:13 by larry") (SELECTQ PHASE (1 (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)) (2 (SETQ DEFINEDFNS (LET ((DEFD NIL)) (MAPATOMS (FUNCTION (CL:LAMBDA (X) (CL:WHEN (GETD X) (CL:SETQ DEFD (CONS X DEFD)))))) DEFD)) (FOR X IN DEFINEDFNS |when| (CCODEP X) DO (LET ((Y (PUTPROP X 'CCC (CALLSCCODE X)))) (FOR REV IN '(BLOCK-CALLED-BY CALLED-BY SPECIAL-BY GLOBAL-BY) AS VAL IN Y DO (FOR S IN VAL DO (PUTPROP S REV (CONS X (GETPROP S REV))))))) (SETQ CALLEDFNS NIL) (MAPATOMS (FUNCTION (LAMBDA (X) (IF (AND (NOT (GETD X)) (GETPROP X 'CALLED-BY)) THEN (CL:PUSH X CALLEDFNS))))) (PRINTOUT T "Functions called and not defined" CALLEDFNS T)) (3 (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 ALLCONTENT (FOR X IN SYSFILES COLLECT (CONS X (GETPROP X 'CONTENT)))) (* \; " don't edit with SEDIT") (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) (PRINTOUT T "Functions compiled but no expr" (SETQ NO-SOURCE (FOR X IN DEFINEDFNS WHEN (NOT (GETPROP X 'EXPR)) (* \;  " should test for blockcompiled fns and function gensyms") COLLECT X)) T)) (4 (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 24-Mar-2021 13:26 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 60000 :NEW T)) (RENAMEFILE HASHFILE (MEDLEYDIR "tmp" "whereis.hash" T)) (DRIBBLE)))) ) (DECLARE\: DONTCOPY (FILEMAP (NIL (591 6646 (GATHER-INFO 601 . 5949) (MEDLEY-FIX-LINKS 5951 . 6340) (MEDLEY-FIX-DATES 6342 . 6644)) (6804 8541 (MAKE-EXPORTS-ALL 6814 . 7763) (MAKE-WHEREIS-HASH 7765 . 8539))))) STOP \ No newline at end of file +(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP") (FILECREATED "28-Mar-2021 10:17:29"  |{DSK}larry>ilisp>medley>internal>library>MEDLEY-UTILS.;4| 3190 |changes| |to:| (VARS MEDLEY-UTILSCOMS) |previous| |date:| "24-Mar-2021 15:45:15" |{DSK}larry>ilisp>medley>internal>library>MEDLEY-UTILS.;3|) (PRETTYCOMPRINT MEDLEY-UTILSCOMS) (RPAQQ MEDLEY-UTILSCOMS ((FNS MEDLEY-FIX-LINKS MEDLEY-FIX-DATES) (VARS MEDLEY-FIX-DIRS) (FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH))) (DEFINEQ (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 24-Mar-2021 13:26 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 60000 :NEW T)) (RENAMEFILE HASHFILE (MEDLEYDIR "tmp" "whereis.hash" T)) (DRIBBLE)))) ) (DECLARE\: DONTCOPY (FILEMAP (NIL (567 1272 (MEDLEY-FIX-LINKS 577 . 966) (MEDLEY-FIX-DATES 968 . 1270)) (1430 3167 ( MAKE-EXPORTS-ALL 1440 . 2389) (MAKE-WHEREIS-HASH 2391 . 3165))))) STOP \ No newline at end of file diff --git a/internal/library/MEDLEY-UTILS.LCOM b/internal/library/MEDLEY-UTILS.LCOM index db7ebf752fb47d10836fabdfefa29c84da741574..e6a1ca48113a0fab5d67d1dee8c3c6bbe7ff8d4b 100644 GIT binary patch delta 289 zcmdm`zK(x_hp>gNZ(@BQ*3dXpMW1tlXSNdrqOQ*$c=BPE5J zq~!eEf*kdf8U@~(%)A-}CBOWn%)Ar@WaWB#dO(#ai6yB(W!MZdR?_6vaP#zWbq;cM z3~_ZqRm1^ui@BAN<>XvOhZqx}O~!_n1`0LF8Hsu6sl_!4H6{60H3}MGjzPf+zOF7l zu93Q-A)Y?L&i=l^nhG@qMX6<(`K2I*AU6P&DjAs|`P3BXO)EoFB?aEe`HXf<#xgE>=6qOQQ0012tPRsxR literal 5050 zcmbtY+ix3b6}OW@x68W3$u6)~s18FF>`*(N@%Y+Rl!-lVCK=DT9;Z%9w`pR#wN=Ls zwgas&LJJZ?JfMBzVISdz%Zt-uw1Bk!OSnl$NIVq@cwK(qHy)3ZtPs+slKWlG{haSy zCYV$6nxTgCny!X5BX81;lB(p&%BHT8u$R>Zx=~cJJIWnwHKVMSbj>OXAzzSTWC2@N zb0kP|xNz7FOHoNAF`kj*88InPP^fl}PnxZIjXG@-$T#>-&f59zJB`k9eZ6(q?LJ>` zwwk?@_2YW2RmY~?uXo#rt@T#(sC$Upf|}FS{qSyC)2+yDX%GS@$>k(T8ClFoDS-w@ z-MYhT;G;pcaoB!R?_~ybM=5WqC0n(EvZID8*s7Wp-cqbB8Z_Gj5(=C>QU0{mBI|jt zbK0j_K9NWSENX}SdTl_yb0Uao@Xy4O|BprDAo3{WMEm1s07QYM%31$7EWX)i>1iW1^3 z7b4H+JzkG@}k^)f@}~ zsyAG!FW=gD!l=K_SzNPOG{8hm(H*s1ESW_*&o3y($R-xv+()3FV{LOSk`$%9K}8bN zl-n&@Y?UH#XNx4MdnL9=&^<+Gi#V0kdu$;Q2Nh|b?QAPxm4*&Qis6^(Q$%R0&fl*ux8OIaH-&J2u)%?!dW6BCst+a!~EvQCjhkpZR& z55&MK7Nx8SlV;0oBQnle6A8fJdx;D)Z1ZE+G180>UHR%;K6tbC^wrPKyx$x9qjQg# z)rVB``n~fzt{)aZ)J9jg8iD)oZLR!nZhrLF?ZxV9hru?vpT?C{zw(+sKN1RylanTo z5e~ywAYMrgi{68UM+|TI<=f^$&0hZc;QH7YT{o{c0uSFE>vIo=ADY)!9uEIwi^0(w zoX_Ik{0G`-{`+U1A8y^>A48HqL6TeNB)L^t<*=9Ku)#jZ*xMp0*9!Bays=n~&QPdC zxm5h8a*LC4e{7<*ZVQ~q{?^-PA3yUREV|a>#5m5&Wpn2IU}0=thn@?Kz`^y83Uluc ze_$@GK>6XnTXS%M=ghzGIw!*^kIgq1t5VJHpWmJztu8gHvU@ixuY67@?>9K|3(*uc@Ms1-q zHP?ZGi}C(vMA^E3VTtQGd^i)A!yUGH(+s-UFIHxEJBVQdD?mF1TK_Fv#&&iQoi0?HI{;C`2BBXWY z)r*j=$(Ok%9Gw3^nm~X@3=`*XjRlU+l5aGgpegX<|)0EXS zmRb(yw0s`TmyuObXJmLmDHc^DCy|t5KAG;4j?*O>MO7=I2AQRORJa&KU>zaOPz;j} zGl`jzM~NiLpTsQc=q`e^%Sc2krLqz&qC??DkkwmCPqj!ncnQa3G5Ngm=nupw4ow3@ zP&^ew(f9AOD27q2{YjBd!$S{lBX*-`4T>d7A($t9D50Tq*YeCc;$cc4nPS!0uD(eK z<6hvgaFPjl-CiJ!?b?5r60nhjmWaX+6B2PAqpb5u#avo)5?w+zOEOCTg$7PScpz-u zUfS;JVt9ZoL=Y4rxT86+G+07{x>E_IWRjbVy(1CwFgx=#+9MYzZPUS-+wuSk=A|^A zfRI0JSNqLQyGKr&Pe5gu0@>R%3vK*adS3PX8A?L7NgG7C* z)gL$8^_qZ3BT^7;Qvt1^V(Ez2oK~jtUO9x0OeVqVoOY}A9!F|*4r}!qlTktj6ILUu zw*?>8kQW090~63~roa}e^r+dkBNmO|3_7sW35)}*VZ==ci3CSBX>J3X7m%l>?{poP zfOp6@8M*S>URc+R9m{RAcMWY1xnc|bwS+3*-FO+`MTO`0BhRng&6qDY_%E+U90X|} zp*gS`^;Rp}IX;H9284iTnOG^46eqP*LWW0^%vgodovX&ZN&ipGCbY6bYe&uYTCYL9 zYPWgP@2x#YyIPswOXgyhX>&0YK<8chA=vmYhqCBce>9J3K;yHY;s=l z9ERG7;%--toWnY46f1iuWfo#*FvsmH7-CTWH%4D84{!1sxMP<{t~mcetNBxH^v0yk z{Nwht+Z+B90}rx2PoOO8aH3)_;wG*d~LA}rV8X-ozqKGovso29Z9Mwf1TjLlf~ zArA&fDPkz{xK83y@hZ(%MSjD7n%rl+%V0iBOy2#31tF$qq>=49#qzGf(sJ6pWVtat zjZ*fMQEvpi*G{+Ji{Qz?J@5*gg=gqSIb!hAoX*EbHmI>VNhCJAGqtecbxJetL{ww9 zpq7*}5>OK`3GMNG5v=no&4vPd z;2{d$Q}Cu|&-r@}`q*TA=~-Qh%24Q{JWiP5%hxn#3zLsoC^qa{*J-cbMJ5-VZ(VEd o^^1>{$pf&c&j diff --git a/sources/LOADUP-LISP b/sources/LOADUP-LISP index b27af80e..e58b7f16 100644 --- a/sources/LOADUP-LISP +++ b/sources/LOADUP-LISP @@ -1 +1 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP") (FILECREATED "25-Mar-2021 16:34:41" |{DSK}larry>ilisp>medley>sources>LOADUP-LISP.;2| 8475 |changes| |to:| (FNS LOADUP-LISP) |previous| |date:| "16-Mar-2021 10:17:58" |{DSK}larry>ilisp>medley>sources>LOADUP-LISP.;1| ) (PRETTYCOMPRINT LOADUP-LISPCOMS) (RPAQQ LOADUP-LISPCOMS ((FNS LOADUP-LISP) (FNS MEDLEY-INIT-VARS MEDLEYDIR) (INITVARS (FILING.ENUMERATION.DEPTH T)) (VARS MEDLEY-INIT-VARS) (GLOBALVARS XCL::*WHERE-IS-CASH-FILES* LISPMAKESYSDATE MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST))) (DEFINEQ (LOADUP-LISP (LAMBDA NIL (* \; "Edited 25-Mar-2021 16:28 by larry") (SETQQ COMPILE.EXT LCOM) (* \; "should be set earlier") (DRIBBLE (MEDLEYDIR "tmp" "lisp.dribble" T)) (FOR X IN BOOTLOADEDFILES DO (CL:UNLESS (MEMB X SYSFILES) (PRINTOUT T X " bootloaded" T) (SETQ SYSFILES (CONS X SYSFILES)))) (SETQ BOOTLOADEDFILES NIL) (IF (NOT (BOUNDP 'DIRECTORIES)) THEN (SETQ DIRECTORIES LOADUPDIRECTORIES)) (* |;;| "following files are really loaded earlier, this call to LOADUP just cleans up") (LOADUP '(ACODE MACHINEINDEPENDENT POSTLOADUP)) (* |;;| "establish all package exports early") (LOADUP '(LISP-PACKAGE FASL-PACKAGE D-ASSEM-PACKAGE COMPILER-PACKAGE)) (* |;;| "load FASL loader here, so we can load DFASLs earlier in loadup") (LOADUP '(ERROR-RUNTIME CMLARITH CONDITION-HIERARCHY CMLHASH D-ASSEM FASLOAD)) (* |;;| "These are needed by any FASL files") (LOADUP '(DEFFER-RUNTIME CMLPRINT CLSTREAMS CMLSTRING CMLSYMBOL CMLTYPES CMLSEQCOMMON CMLSEQMAPPERS CMLPATHNAME CMLFILESYS)) (* |;;;| "* 'FASL files may be loaded after this point' * * *") (LOADUP '(CMLDEFFER ERROR-RUNTIME-AFTER-FASL WRAPPERS)) (* |;;| "early runtime support for Common Lisp and (temporarily) debugger") (LOADUP '(STACKFNS CMLMVS MACROS MACROAUX UNWINDMACROS)) (LOADUP '(COMMON XCLC-RUNTIME CMLTYPES CL-ERROR)) (LOADUP '(AFONT EDIT WEDIT PRETTY DSPRINTDEF NEWPRINTDEF FONTPROFILE SPELLFILE PRINTFN LOADFNS DMISC DIRECTORY SPELLFILE FILEPKG RESOURCE)) (* |;;| "needed for makesys") (* |;;| "The Byte Compiler (DLAP, BYTECOMPILER, COMPILER) used to be here. Moved after XCL Compiler so that one byte compiler init will work. JDS 10/11/89") (LOADUP '(HIST UNDO SPELL DWIM WTFIX CLISP DWIMIFY CLISPIFY RECORD)) (LOADUP '(GAINSPACE COROUTINE ARGLIST ASKUSER SYSPRETTY COMMON COMPARE)) (DWIM 'C) (* |;;| "Kernel Common Lisp files") (LOADUP '(CMLSTEP CMLDOC CMLPARSE CMLSETF CMLPRED CMLREAD WALKER CMLSEQFINDER CMLSEQMODIFY CMLSORT DEFSTRUCT CMLMISCIO CMLCOMPILE CMLDESTRUCT CL-ERROR CMLFORMAT CMLENVIRONMENT CMLLOAD CMLFLOAT CMLTIME CMLRAND CMLMODULES)) (LOADUP '(PROFILE CMLEXEC EXEC-COMMANDS DEBUGGER IL-ERROR-STUFF DEBUGEDIT)) (LOADUP '(ADDARITH)) (LOADUP '(CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY MENU WINDOWOBJ WINDOWSCROLL WINDOW WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT DESCRIBE CMLARRAYINSPECTOR EDITINTERFACE TTYIN)) (LOADUP '(BREAK-AND-TRACE)) (LOADUP '(FASDUMP XCL-COMPILER ADVISE)) (* |;;| "the bytecompiler and Interlisp compiler interface functions") (LOADUP '(DLAP BYTECOMPILER COMPILE)) (LOADUP '(HARDCOPY LOGOW IDLER ICONW FREEMENU SEDIT)) (* \; "don't want LOGOW ") (COND ((WINDOWP (LOGOW)) (CLOSEW (LOGOW)) (MOVD 'NILL 'LOGOW))) (LOADUP '(DSK UFS UFSCALLC MAIKOBITBLT)) (LOADUP '(TIME)) (LOADUP '(BRKDWN)) (LOADUP '(XCL-EXTRAS)) (*  "CMLPACKAGE pushes onto INSPECTMACROS") (LOADUP '(CMLPACKAGE)) (* |;;| "Puts ARGNAME properties on CL and XCL functions that IL:SMARTARGLIST can't hack. Keep this last so everything will be defined when it runs") (LOADUP '(CMLSMARTARGS)) (LOADUP '(IMPLICIT-KEY-HASH CLOSURE-CACHE)) (* |;;| "Already enabled, but this time fixes tables that weren't defined in the init") (PACKAGE-ENABLE) (LOADUP '(PUP 10MBDRIVER LEAF LLETHER DPUPFTP LOCALFILE DSKDISPLAY COURIER LLNS TRSERVER SPP NSPRINT AUTHENTICATION BSP CLEARINGHOUSE NSFILING MAIKOETHER)) (DRIBBLE) (SETQ MAKESSNAME ':MEDLEY))) ) (DEFINEQ (MEDLEY-INIT-VARS (LAMBDA (CLEAR) (* \; "Edited 17-Jan-2021 14:29 by larry") (* |;;| "MEDLEY-INIT-VARS has variables that might need to get reset. ") (|if| CLEAR |then| (SETQ MEDLEYDIR NIL) (SETQ XCL::*WHERE-IS-CASH-FILES* NIL) (|for| X |in| MEDLEY-INIT-VARS |do| (SET (CAR X))) |elseif| (OR (NOT (BOUNDP 'MEDLEYDIR)) (AND (NULL MEDLEYDIR) (NULL (MEDLEYDIR)))) |then| (PRINTOUT T "WARNING: MEDLEYDIR not set correctly" " set it and call (MEDLEY-INIT-VARS) again" T) |else| (|for| X |in| MEDLEY-INIT-VARS |do| (SET (CAR X) (EVAL (CADR X)))) (* |;;| "WHEREIS doesn't follow conventions") (CL:WHEN (GETD 'XCL::ADD-WHERE-IS-DATABASE) (SETQ XCL::*WHERE-IS-CASH-FILES* NIL) (NLSETQ (XCL::ADD-WHERE-IS-DATABASE (MEDLEYDIR "loadups" "WHEREIS.HASH")))) NIL))) (MEDLEYDIR (LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* \; "Edited 14-Dec-2020 17:12 by larry") (|if| (NULL DIRNAME) |then| (|if| (OR (NOT (BOUNDP 'MEDLEYDIR)) (NOT MEDLEYDIR)) |then| (OR (SETQ MEDLEYDIR (DIRECTORYNAME (OR (UNIX-GETENV "MEDLEYDIR") T))) (DIRECTORYNAME T)) |elseif| (STRPOS "/" MEDLEYDIR) |then| (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR)) |else| MEDLEYDIR) |elseif| (LISTP DIRNAME) |then| (|for| X |in| DIRNAME |collect| (MEDLEYDIR X)) |elseif| FILENAME |then| (SETQ FILENAME (CONCAT (MEDLEYDIR DIRNAME) FILENAME)) (|if| OUTPUT |then| FILENAME |else| (OR NOERROR (INFILEP FILENAME) (ERROR "No such medley file" FILENAME))) |else| (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR) DIRNAME)) NOERROR (ERROR "No such medley directory" DIRNAME))))) ) (RPAQ? FILING.ENUMERATION.DEPTH T) (RPAQQ MEDLEY-INIT-VARS ((LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal/library"))) (LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"))) (LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES)) (IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo")) (IRM.DINFOGRAPH) (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES)) (LOGINHOST/DIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") (UNIX-GETENV "HOME")))) (USERGREETFILES `((,LOGINHOST/DIR "INIT" COM) (,LOGINHOST/DIR "INIT"))) (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/displayfonts" "fonts/altofonts"))) (POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts"))) (INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts"))) (XCL::*WHERE-IS-CASH-FILES*))) (DECLARE\: DOEVAL@COMPILE DONTCOPY (GLOBALVARS XCL::*WHERE-IS-CASH-FILES* LISPMAKESYSDATE MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST) ) (DECLARE\: DONTCOPY (FILEMAP (NIL (764 4855 (LOADUP-LISP 774 . 4853)) (4856 7355 (MEDLEY-INIT-VARS 4866 . 6011) (MEDLEYDIR 6013 . 7353))))) STOP \ No newline at end of file +(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP") (FILECREATED "28-Mar-2021 10:06:54" |{DSK}larry>ilisp>medley>sources>LOADUP-LISP.;4| 8886 |changes| |to:| (FNS LOADUP-LISP) |previous| |date:| "25-Mar-2021 16:34:41" |{DSK}larry>ilisp>medley>sources>LOADUP-LISP.;3| ) (PRETTYCOMPRINT LOADUP-LISPCOMS) (RPAQQ LOADUP-LISPCOMS ((FNS LOADUP-LISP) (FNS MEDLEY-INIT-VARS MEDLEYDIR) (INITVARS (FILING.ENUMERATION.DEPTH T)) (VARS MEDLEY-INIT-VARS) (GLOBALVARS XCL::*WHERE-IS-CASH-FILES* LISPMAKESYSDATE MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST))) (DEFINEQ (LOADUP-LISP (LAMBDA NIL (* \; "Edited 28-Mar-2021 10:06 by larry") (SETQQ COMPILE.EXT LCOM) (* \; "should be set earlier") (DRIBBLE (MEDLEYDIR "tmp" "lisp.dribble" T)) (FOR X IN BOOTLOADEDFILES DO (CL:UNLESS (MEMB X SYSFILES) (PRINTOUT T X " bootloaded" T) (SETQ SYSFILES (CONS X SYSFILES)))) (SETQ BOOTLOADEDFILES NIL) (IF (NOT (BOUNDP 'DIRECTORIES)) THEN (SETQ DIRECTORIES LOADUPDIRECTORIES)) (* |;;| "following files are really loaded earlier, this call to LOADUP just cleans up") (LOADUP '(ACODE MACHINEINDEPENDENT POSTLOADUP)) (* |;;| "establish all package exports early") (LOADUP '(LISP-PACKAGE FASL-PACKAGE D-ASSEM-PACKAGE COMPILER-PACKAGE)) (* |;;| "load FASL loader here, so we can load DFASLs earlier in loadup") (LOADUP '(ERROR-RUNTIME CMLARITH CONDITION-HIERARCHY CMLHASH D-ASSEM FASLOAD)) (* |;;| "These are needed by any FASL files") (LOADUP '(DEFFER-RUNTIME CMLPRINT CLSTREAMS CMLSTRING CMLSYMBOL CMLTYPES CMLSEQCOMMON CMLSEQMAPPERS CMLPATHNAME CMLFILESYS)) (* |;;;| "* 'FASL files may be loaded after this point' * * *") (LOADUP '(CMLDEFFER ERROR-RUNTIME-AFTER-FASL WRAPPERS)) (* |;;| "early runtime support for Common Lisp and (temporarily) debugger") (LOADUP '(STACKFNS CMLMVS MACROS MACROAUX UNWINDMACROS)) (LOADUP '(COMMON XCLC-RUNTIME CMLTYPES CL-ERROR)) (LOADUP '(AFONT EDIT WEDIT PRETTY DSPRINTDEF NEWPRINTDEF FONTPROFILE SPELLFILE PRINTFN LOADFNS DMISC DIRECTORY SPELLFILE FILEPKG RESOURCE)) (* |;;| "needed for makesys") (* |;;| "The Byte Compiler (DLAP, BYTECOMPILER, COMPILER) used to be here. Moved after XCL Compiler so that one byte compiler init will work. JDS 10/11/89") (LOADUP '(HIST UNDO SPELL DWIM WTFIX CLISP DWIMIFY CLISPIFY RECORD)) (LOADUP '(GAINSPACE COROUTINE ARGLIST ASKUSER SYSPRETTY COMMON COMPARE)) (DWIM 'C) (* |;;| "Kernel Common Lisp files") (LOADUP '(CMLSTEP CMLDOC CMLPARSE CMLSETF CMLPRED CMLREAD WALKER CMLSEQFINDER CMLSEQMODIFY CMLSORT DEFSTRUCT CMLMISCIO CMLCOMPILE CMLDESTRUCT CL-ERROR CMLFORMAT CMLENVIRONMENT CMLLOAD CMLFLOAT CMLTIME CMLRAND CMLMODULES)) (LOADUP '(PROFILE CMLEXEC EXEC-COMMANDS DEBUGGER IL-ERROR-STUFF DEBUGEDIT)) (LOADUP '(ADDARITH)) (LOADUP '(CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY MENU WINDOWOBJ WINDOWSCROLL WINDOW WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT DESCRIBE CMLARRAYINSPECTOR EDITINTERFACE TTYIN)) (LOADUP '(BREAK-AND-TRACE)) (LOADUP '(FASDUMP XCL-COMPILER ADVISE)) (* |;;| "the bytecompiler and Interlisp compiler interface functions") (LOADUP '(DLAP BYTECOMPILER COMPILE)) (LOADUP '(HARDCOPY LOGOW IDLER ICONW FREEMENU SEDIT)) (* \; "don't want LOGOW ") (COND ((WINDOWP (LOGOW)) (CLOSEW (LOGOW)) (MOVD 'NILL 'LOGOW))) (LOADUP '(DSK UFS UFSCALLC MAIKOBITBLT)) (LOADUP '(TIME)) (LOADUP '(BRKDWN)) (LOADUP '(XCL-EXTRAS)) (*  "CMLPACKAGE pushes onto INSPECTMACROS") (LOADUP '(CMLPACKAGE)) (* |;;| "Puts ARGNAME properties on CL and XCL functions that IL:SMARTARGLIST can't hack. Keep this last so everything will be defined when it runs") (LOADUP '(CMLSMARTARGS)) (LOADUP '(IMPLICIT-KEY-HASH CLOSURE-CACHE)) (* |;;| "Already enabled, but this time fixes tables that weren't defined in the init") (PACKAGE-ENABLE) (LOADUP '(PUP 10MBDRIVER LEAF LLETHER DPUPFTP LOCALFILE DSKDISPLAY COURIER LLNS TRSERVER SPP NSPRINT AUTHENTICATION BSP CLEARINGHOUSE NSFILING MAIKOETHER)) (DRIBBLE) (SETQ MAKESYSNAME ':MEDLEY))) ) (DEFINEQ (MEDLEY-INIT-VARS (LAMBDA (CLEAR) (* \; "Edited 17-Jan-2021 14:29 by larry") (* |;;| "MEDLEY-INIT-VARS has variables that might need to get reset. ") (|if| CLEAR |then| (SETQ MEDLEYDIR NIL) (SETQ XCL::*WHERE-IS-CASH-FILES* NIL) (|for| X |in| MEDLEY-INIT-VARS |do| (SET (CAR X))) |elseif| (OR (NOT (BOUNDP 'MEDLEYDIR)) (AND (NULL MEDLEYDIR) (NULL (MEDLEYDIR)))) |then| (PRINTOUT T "WARNING: MEDLEYDIR not set correctly" " set it and call (MEDLEY-INIT-VARS) again" T) |else| (|for| X |in| MEDLEY-INIT-VARS |do| (SET (CAR X) (EVAL (CADR X)))) (* |;;| "WHEREIS doesn't follow conventions") (CL:WHEN (GETD 'XCL::ADD-WHERE-IS-DATABASE) (SETQ XCL::*WHERE-IS-CASH-FILES* NIL) (NLSETQ (XCL::ADD-WHERE-IS-DATABASE (MEDLEYDIR "loadups" "WHEREIS.HASH")))) NIL))) (MEDLEYDIR (LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* \; "Edited 14-Dec-2020 17:12 by larry") (|if| (NULL DIRNAME) |then| (|if| (OR (NOT (BOUNDP 'MEDLEYDIR)) (NOT MEDLEYDIR)) |then| (OR (SETQ MEDLEYDIR (DIRECTORYNAME (OR (UNIX-GETENV "MEDLEYDIR") T))) (DIRECTORYNAME T)) |elseif| (STRPOS "/" MEDLEYDIR) |then| (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR)) |else| MEDLEYDIR) |elseif| (LISTP DIRNAME) |then| (|for| X |in| DIRNAME |collect| (MEDLEYDIR X)) |elseif| FILENAME |then| (SETQ FILENAME (CONCAT (MEDLEYDIR DIRNAME) FILENAME)) (|if| OUTPUT |then| FILENAME |else| (OR NOERROR (INFILEP FILENAME) (ERROR "No such medley file" FILENAME))) |else| (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR) DIRNAME)) NOERROR (ERROR "No such medley directory" DIRNAME))))) ) (RPAQ? FILING.ENUMERATION.DEPTH T) (RPAQQ MEDLEY-INIT-VARS ((LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal/library"))) (LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"))) (LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES)) (IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo")) (IRM.DINFOGRAPH) (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES)) (LOGINHOST/DIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") (UNIX-GETENV "HOME")))) (USERGREETFILES `((,LOGINHOST/DIR "INIT" COM) (,LOGINHOST/DIR "INIT"))) (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/displayfonts" "fonts/altofonts"))) (POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts"))) (INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts"))) (XCL::*WHERE-IS-CASH-FILES*))) (DECLARE\: DOEVAL@COMPILE DONTCOPY (GLOBALVARS XCL::*WHERE-IS-CASH-FILES* LISPMAKESYSDATE MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST) ) (DECLARE\: DONTCOPY (FILEMAP (NIL (764 4856 (LOADUP-LISP 774 . 4854)) (4857 7356 (MEDLEY-INIT-VARS 4867 . 6012) (MEDLEYDIR 6014 . 7354))))) STOP \ No newline at end of file diff --git a/sources/LOADUP-LISP.LCOM b/sources/LOADUP-LISP.LCOM index 7f2eb13c92b0089dd64b9e05938fb5faddf6f343..da79f25d9c03142fd9acb856bebe2f2cf347877b 100644 GIT binary patch delta 234 zcmbPl@JD}whp>gNZ(@)dZQXm1tlXB6iFi^D-#1Hg_@+I z)a3l!g3O%Mlo|!zn&gbcy!6y!s~QC#e@B2VmamLLzSXG1oKygbH