another pass at variable initialization after logout savevm sysout makesys (#1003)
This corrects some errors in the handling of initializing variables across SAVEVM, LOGOUT, SYSOUT and MAKESYS.
This is all now handled by MEDLEY-INIT-VARS (function and variable) which is called as an EVENTFN.
BEFOREMAKESYS (invoked by ENDLOADUP) clears the variables to a default setting (all directories are just {DSK}).
The other "BEFORE" events save away the current values of the variables in MEDLEY-INIT-VARS.
In order to get this to work it was necessary to change a hack for deciding where to find EXPORTS.ALL and WHEREIS.HASH. Now if you do `./scripts/loadup-all.sh` to make a full, lisp sysouts, exports.all and whereis.hash it will still build the sysouts in tmp/ but will also "link" new versions in loadups (and library for exports.all). This replaces the previous hack scanning the sysout name for "tmp/".
MEDLEY-INIT-VARS had been called both by the AROUNDEXITFN and AFTER*FORMS.
This commit is contained in:
Larry Masinter
GitHub
117
sources/APUTDQ
117
sources/APUTDQ
@@ -1,13 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "25-Aug-2021 13:12:07" {DSK}<home>larry>medley>sources>APUTDQ.;2 11185
|
||||
|
||||
changes to%: (FNS ENDLOADUP)
|
||||
(FILECREATED "25-Oct-2022 11:44:17" {DSK}<home>larry>ilisp>medley>sources>APUTDQ.;3 14079
|
||||
|
||||
previous date%: "25-Aug-2021 12:11:36" {DSK}<home>larry>medley>sources>APUTDQ.;1)
|
||||
:CHANGES-TO (FNS ENDLOADUP)
|
||||
|
||||
:PREVIOUS-DATE "25-Oct-2022 11:07:06" {DSK}<home>larry>ilisp>medley>sources>APUTDQ.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1981-1988, 1990, 2021 by Venue & Xerox Corporation.
|
||||
Copyright (c) 1981-1988, 1990, 2021-2022 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT APUTDQCOMS)
|
||||
@@ -139,33 +140,26 @@ Copyright (c) 1981-1988, 1990, 2021 by Venue & Xerox Corporation.
|
||||
(SMASHFILECOMS X])
|
||||
|
||||
(ENDLOADUP
|
||||
[LAMBDA NIL (* ; "Edited 25-Aug-2021 13:07 by larry")
|
||||
[LAMBDA NIL
|
||||
(DECLARE (GLOBALVARS USERRECLST SYSTEMINITVARS MEDLEY-INIT-VARS))
|
||||
(* ; "Edited 25-Oct-2022 11:43 by lmm")
|
||||
|
||||
(* ;; "set up for NONET configuration; sites with ethernet can load in init from other places")
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "All records existing at this point in time have been loaded as part of the system.")
|
||||
|
||||
(DECLARE (GLOBALVARS USERRECLST SYSTEMINITVARS MEDLEY-INIT-VARS AFTERSYSOUTFORMS))
|
||||
(FOR R IN USERRECLST DO (RECORDPRIORITY R 'SYSTEM))
|
||||
|
||||
(* ;; "reset variables to nil")
|
||||
|
||||
(MEDLEY-INIT-VARS T)
|
||||
(* ;; " MEDLEY-INIT-VARS is done by aroundexitfn")
|
||||
|
||||
[FOR X IN SYSTEMINITVARS WHEN (NOT (ASSOC (CAR X)
|
||||
MEDLEY-INIT-VARS))
|
||||
MEDLEY-INIT-VARS))
|
||||
DO (SETTOPVAL (CAR X)
|
||||
(COPY (CDR X]
|
||||
|
||||
(* ;; " make sure these are done first")
|
||||
|
||||
(SETQ AFTERSYSOUTFORMS (CONS '(MEDLEY-INIT-VARS)
|
||||
(REMOVE '(MEDLEY-INIT-VARS)
|
||||
AFTERSYSOUTFORMS)))
|
||||
(SETQ AFTERMAKESYSFORMS (CONS '(MEDLEY-INIT-VARS)
|
||||
(REMOVE '(MEDLEY-INIT-VARS)
|
||||
AFTERMAKESYSFORMS)))
|
||||
(COPY (CDR X]
|
||||
(FOR FILE IN (OPENP) DO (PRINTOUT T (CLOSEF FILE)
|
||||
" closed" T))
|
||||
" closed" T))
|
||||
|
||||
(* ;; "get rid of files loaded")
|
||||
|
||||
@@ -261,12 +255,87 @@ Copyright (c) 1981-1988, 1990, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PRETTYCOMPRINT APUTDQCOMS)
|
||||
|
||||
(RPAQQ APUTDQCOMS
|
||||
[
|
||||
(* ;; " this file contains some dummy definitions of functions whose real implementation is on other files")
|
||||
|
||||
(DECLARE%: EVAL@LOAD DONTCOPY (P (PRIN1 "Warning: APUTDQ contains dummy definitions of " T)
|
||||
(PRIN1
|
||||
"FAULTEVAL FAULTAPPLY ERRORX SET-DOCUMENTATION SMASHFILECOMS"
|
||||
T)
|
||||
(PRIN1 "Be careful not to confuse with the real definitions"
|
||||
T)
|
||||
(TERPRI T)))
|
||||
(FNS GREETFILENAME FAULTEVAL FAULTAPPLY ERRORX SET-DOCUMENTATION)
|
||||
(FNS SMASHFILECOMS SMASHFILECOMSLST)
|
||||
(INITVARS (DEFAULTREGISTRY)
|
||||
(USERGREETFILES)
|
||||
(LOGINHOST/DIR '{DSK}))
|
||||
(FNS LOADUP ENDLOADUP)
|
||||
(ALISTS (SYSTEMINITVARS \CONNECTED.DIRECTORY DWIMFLG ADDSPELLFLG FILEPKGFLG BUILDMAPFLG
|
||||
UPDATEMAPFLG DEFAULTREGISTRY DEFAULTPRINTINGHOST DIRECTORIES USERGREETFILES
|
||||
NETWORKOSTYPES CH.NET.HINT CH.DEFAULT.DOMAIN CH.DEFAULT.ORGANIZATION
|
||||
ADVISEDFNS LISPUSERSDIRECTORIES DISPLAYFONTDIRECTORIES DISPLAYFONTEXTENSIONS
|
||||
INTERPRESSFONTDIRECTORIES))
|
||||
[DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(* ;; "many of these are obsolete and can be removed, but it is unclear which ones")
|
||||
|
||||
(P (DUMMYDEF (ADDSTATS *)
|
||||
(LISPXWATCH NILL)
|
||||
(CLBUFS NILL)
|
||||
(FINDFILE INFILEP)
|
||||
(FILEMAP *)
|
||||
(VIRGINFN GETD))
|
||||
(DUMMYDEF (* QUOTE)
|
||||
(GETP GETPROP)
|
||||
(DECLARE QUOTE)
|
||||
(FRPLNODE2 RPLNODE2)
|
||||
(DISPLAYTERMP TRUE)
|
||||
(FRPLACA RPLACA)
|
||||
(FRPLACD RPLACD)
|
||||
(MISSPELLED? NILL)
|
||||
(UNDOSAVE NILL)
|
||||
(SETLINELENGTH ZERO)
|
||||
(DOBE NILL)
|
||||
(RELINK NILL)
|
||||
(PUT PUTPROP)
|
||||
(/PUT PUTPROP)))
|
||||
(ADDVARS (SYSFILES)
|
||||
(LISPXHISTORY)
|
||||
(LINKEDFNS))
|
||||
(VARS (CLEARSTKLST T)
|
||||
(SYSHASHARRAY (HASHARRAY 50))
|
||||
(DISPLAYTERMFLG T)
|
||||
(%#UNDOSAVES)
|
||||
(NLAMA)
|
||||
(NLAML)
|
||||
(LAMS)
|
||||
(TTYLINELENGTH 82)
|
||||
(COMPILE.EXT 'LCOM)
|
||||
(FASL.EXT 'DFASL)
|
||||
(*COMPILED-EXTENSIONS* '(DFASL LCOM))
|
||||
(SYSOUT.EXT 'SYSOUT]
|
||||
(LOCALVARS . T)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS APUTDQ COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990
|
||||
2021))
|
||||
2021 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3963 6171 (GREETFILENAME 3973 . 5846) (FAULTEVAL 5848 . 5920) (FAULTAPPLY 5922 . 6008)
|
||||
(ERRORX 6010 . 6076) (SET-DOCUMENTATION 6078 . 6169)) (6172 7192 (SMASHFILECOMS 6182 . 6524) (
|
||||
SMASHFILECOMSLST 6526 . 7190)) (7286 9211 (LOADUP 7296 . 7719) (ENDLOADUP 7721 . 9209)))))
|
||||
(FILEMAP (NIL (3978 6186 (GREETFILENAME 3988 . 5861) (FAULTEVAL 5863 . 5935) (FAULTAPPLY 5937 . 6023)
|
||||
(ERRORX 6025 . 6091) (SET-DOCUMENTATION 6093 . 6184)) (6187 7207 (SMASHFILECOMS 6197 . 6539) (
|
||||
SMASHFILECOMSLST 6541 . 7205)) (7301 8744 (LOADUP 7311 . 7734) (ENDLOADUP 7736 . 8742)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "18-Oct-2022 18:08:24" {DSK}<home>larry>ilisp>medley>sources>MEDLEYDIR.;4 9414
|
||||
(FILECREATED "25-Oct-2022 12:19:14" {DSK}<home>larry>ilisp>medley>sources>MEDLEYDIR.;11 9572
|
||||
|
||||
:CHANGES-TO (VARS MEDLEYDIRCOMS)
|
||||
(FNS MEDLEY-INIT-VARS MEDLEYDIR MEDLEYSUBSTDIR)
|
||||
:CHANGES-TO (FNS MEDLEY-INIT-VARS)
|
||||
|
||||
:PREVIOUS-DATE "18-Oct-2022 08:45:52" {DSK}<home>larry>ilisp>medley>sources>MEDLEYDIR.;3)
|
||||
:PREVIOUS-DATE "24-Oct-2022 22:35:01" {DSK}<home>larry>ilisp>medley>sources>MEDLEYDIR.;10)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYDIRCOMS)
|
||||
@@ -34,12 +33,13 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MEDLEY-INIT-VARS
|
||||
[LAMBDA (EVENT) (* ; "Edited 18-Oct-2022 18:08 by lmm")
|
||||
[LAMBDA (EVENT) (* ; "Edited 25-Oct-2022 12:18 by lmm")
|
||||
(* ; "Edited 18-Oct-2022 18:08 by lmm")
|
||||
|
||||
(* ;; "Called on events including before & after loadup")
|
||||
|
||||
(SELECTQ EVENT
|
||||
((T BEFOREMAKESYS)
|
||||
((BEFOREMAKESYS T)
|
||||
(* ;; "Clear old values")
|
||||
|
||||
(FOR X IN MEDLEY-INIT-VARS DO (IF (CDDR X)
|
||||
@@ -53,36 +53,34 @@
|
||||
COLLECT (CONS (CAR X)
|
||||
(GETTOPVAL (CAR X])
|
||||
((AFTERSYSOUT AFTERMAKESYS AFTERLOGOUT AFTERSAVEVM RESTART INIT NIL)
|
||||
(* ;;
|
||||
"Restore old values, subtituting medleydirs")
|
||||
|
||||
(LET* [[OLDMD (AND \SAVE.MEDLEYDIR (U-CASE (POP \SAVE.MEDLEYDIR]
|
||||
(NEWMD (PROGN (SETQ MEDLEYDIR)
|
||||
(MEDLEYDIR)))
|
||||
(SAME (AND OLDMD (STRING-EQUAL OLDMD NEWMD]
|
||||
[for X TMP in MEDLEY-INIT-VARS
|
||||
(* ;;
|
||||
"Any old values, restore them, substituting the new MEDLEYDIR")
|
||||
|
||||
(PROG (OLDMD NEWMD SAME TMP)
|
||||
(IF (EQ \SAVE.MEDLEYDIR T)
|
||||
THEN (* ; " Already restored")
|
||||
(RETURN))
|
||||
(IF \SAVE.MEDLEYDIR
|
||||
THEN (SETQ OLDMD (U-CASE (CAR \SAVE.MEDLEYDIR)))
|
||||
(SETQ MEDLEYDIR)
|
||||
(SETQ NEWMD (MEDLEYDIR))
|
||||
(SETQ SAME (STRING-EQUAL OLDMD NEWMD)))
|
||||
[for X in MEDLEY-INIT-VARS
|
||||
do (/SETTOPVAL (CAR X)
|
||||
(IF [OR (EQ (CADDR X)
|
||||
'RESET)
|
||||
(NOT (SETQ TMP (ASSOC (CAR X)
|
||||
\SAVE.MEDLEYDIR]
|
||||
THEN (EVAL (CADR X))
|
||||
(CDR \SAVE.MEDLEYDIR]
|
||||
THEN
|
||||
(* ;; "either RESET or no saved value")
|
||||
|
||||
(EVAL (CADR X))
|
||||
ELSEIF SAME
|
||||
THEN (CDR TMP)
|
||||
ELSE (MEDLEYSUBSTDIR OLDMD NEWMD (CDR TMP]
|
||||
|
||||
(* ;; "now some variables that are reset hard-coded")
|
||||
|
||||
[LET [(NEWSYS (STRPOS "tmp/" (UNIX-GETENV "LDESRCESYSOUT"]
|
||||
(if NEWSYS
|
||||
then (push DIRECTORIES (MEDLEYDIR "tmp")))
|
||||
(CL:WHEN (GETD 'XCL::ADD-WHERE-IS-DATABASE)
|
||||
(SETQ XCL::*WHERE-IS-CASH-FILES* NIL)
|
||||
(NLSETQ (XCL::ADD-WHERE-IS-DATABASE (MEDLEYDIR (if NEWSYS
|
||||
then "tmp"
|
||||
else "loadups")
|
||||
"WHEREIS.HASH"))))]
|
||||
NIL))
|
||||
(SETQ \SAVE.MEDLEYDIR T) (* ; "only use once")
|
||||
))
|
||||
(PROGN (* ; "no changes")
|
||||
NIL])
|
||||
|
||||
@@ -157,7 +155,7 @@
|
||||
|
||||
|
||||
(RPAQQ MEDLEY-INIT-VARS
|
||||
([LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"]
|
||||
[[LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"]
|
||||
[LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"]
|
||||
(LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES))
|
||||
(IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo"))
|
||||
@@ -176,19 +174,23 @@
|
||||
NIL NIL T))
|
||||
(UNICODEDIRECTORIES (MEDLEYDIR '("unicode/xerox")
|
||||
NIL NIL T))
|
||||
(XCL::*WHERE-IS-CASH-FILES* NIL RESET)
|
||||
(LOGINHOST/DIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
(UNIX-GETENV "HOME")))
|
||||
RESET)
|
||||
(USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM))
|
||||
(CONS LOGINHOST/DIR '("INIT"]
|
||||
RESET)
|
||||
(XCL::*WHERE-IS-CASH-FILES* NIL RESET)))
|
||||
(XCL::*WHERE-IS-CASH-FILES* (COND ((GETD 'XCL::ADD-WHERE-IS-DATABASE)
|
||||
(SETQ XCL::*WHERE-IS-CASH-FILES* NIL)
|
||||
(NLSETQ (XCL::ADD-WHERE-IS-DATABASE (MEDLEYDIR "loadups"
|
||||
"WHEREIS.HASH"
|
||||
NIL T)))
|
||||
XCL::*WHERE-IS-CASH-FILES*])
|
||||
(DECLARE%: EVAL@COMPILE DOCOPY
|
||||
|
||||
(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1521 7471 (MEDLEY-INIT-VARS 1531 . 4532) (MEDLEYDIR 4534 . 6489) (MEDLEYSUBSTDIR 6491
|
||||
. 7469)))))
|
||||
(FILEMAP (NIL (1459 7197 (MEDLEY-INIT-VARS 1469 . 4258) (MEDLEYDIR 4260 . 6215) (MEDLEYSUBSTDIR 6217
|
||||
. 7195)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user