From 3e6e104d86f09deb63a74123a8413a17a4590c6c Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Mon, 8 Mar 2021 22:36:27 -0800 Subject: [PATCH] Main cleanup of new init process, scripts, etc (#243) --- scripts/loadup-full.sh | 4 +-- scripts/loadup-init.sh | 2 +- scripts/loadup-lisp-from-mid.sh | 4 +-- scripts/loadup-mid-from-init.sh | 2 +- sources/DLFIXINIT | 52 -------------------------------- sources/DLFIXINIT.LCOM | Bin 10808 -> 0 bytes sources/FILESETS | 2 +- sources/LOADUP-FULL | 2 +- sources/LOADUP-FULL.LCOM | Bin 4932 -> 4946 bytes sources/LOADUP-INIT.LISP | 9 ++---- sources/LOADUP-LISP | 2 +- sources/LOADUP-LISP.CM | Bin 0 -> 523 bytes sources/LOADUP-LISP.LCOM | Bin 4222 -> 6668 bytes sources/MAIKOINIT | 4 +-- sources/MAKEINIT | 4 +-- sources/MAKEINIT.LCOM | Bin 13022 -> 24089 bytes sources/MAKEINITGREET | 1 - sources/MAKEINITGREET.LCOM | Bin 1332 -> 0 bytes 18 files changed, 15 insertions(+), 73 deletions(-) delete mode 100644 sources/DLFIXINIT delete mode 100644 sources/DLFIXINIT.LCOM create mode 100644 sources/LOADUP-LISP.CM delete mode 100644 sources/MAKEINITGREET delete mode 100644 sources/MAKEINITGREET.LCOM diff --git a/scripts/loadup-full.sh b/scripts/loadup-full.sh index f2223a96..e3f0a7d3 100755 --- a/scripts/loadup-full.sh +++ b/scripts/loadup-full.sh @@ -10,9 +10,9 @@ scr="-sc 1024x768 -g 1042x790" rm -f ~/rem.cm -./run-medley $scr -greet $MEDLEYDIR/sources/LOADUP-FULL.LCOM $MEDLEYDIR/loadups/lisp.sysout +./run-medley $scr -greet $MEDLEYDIR/sources/LOADUP-FULL.LCOM $MEDLEYDIR/tmp/lisp.sysout echo ----- made ---- -ls -l loadups/full.sysout +ls -l tmp/full.sysout echo --------------- diff --git a/scripts/loadup-init.sh b/scripts/loadup-init.sh index 94c894a6..ddd320de 100755 --- a/scripts/loadup-init.sh +++ b/scripts/loadup-init.sh @@ -14,5 +14,5 @@ mkdir -p "$MEDLEYDIR/tmp" ./run-medley $scr -greet "$MEDLEYDIR"/sources/LOADUP-INIT.LISP -full echo ---- made ---- -ls -l tmp loadups/init* +ls -l tmp echo -------------- diff --git a/scripts/loadup-lisp-from-mid.sh b/scripts/loadup-lisp-from-mid.sh index 1721ea5d..2c1c1f25 100755 --- a/scripts/loadup-lisp-from-mid.sh +++ b/scripts/loadup-lisp-from-mid.sh @@ -10,9 +10,9 @@ fi scr="-sc 1024x768 -g 1042x790" -./run-medley $scr -greet $MEDLEYDIR/sources/YREM.CM tmp/init-mid.sysout +./run-medley $scr -greet $MEDLEYDIR/sources/LOADUP-LISP.CM tmp/init-mid.sysout echo ----- created: ------- -ls -l loadups/lisp.sysout +ls -l tmp/lisp.sysout tmp/lisp.dribble echo ---------------------- diff --git a/scripts/loadup-mid-from-init.sh b/scripts/loadup-mid-from-init.sh index 481a7139..32667db4 100755 --- a/scripts/loadup-mid-from-init.sh +++ b/scripts/loadup-mid-from-init.sh @@ -10,7 +10,7 @@ fi mkdir -p "$MEDLEYDIR/tmp" scr="-sc 1024x768 -g 1042x790" -./run-medley -prog ldeinit -greet $MEDLEYDIR/sources/XREM.CM $scr -vmem tmp/init-mid.sysout loadups/init.dlinit +./run-medley -prog ldeinit -greet $MEDLEYDIR/sources/XREM.CM $scr -vmem tmp/init-mid.sysout tmp/init.dlinit echo ---- made ---- ls -l tmp/ diff --git a/sources/DLFIXINIT b/sources/DLFIXINIT deleted file mode 100644 index 6ec6fa4d..00000000 --- a/sources/DLFIXINIT +++ /dev/null @@ -1,52 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED " 7-Feb-2021 21:08:57" {DSK}larry>ilisp>medley>sources>DLFIXINIT.;6 26465 changes to%: (FNS DLDUMPSYSOUT) previous date%: " 7-Feb-2021 14:45:27" {DSK}larry>ilisp>medley>sources>DLFIXINIT.;5) (PRETTYCOMPRINT DLFIXINITCOMS) (RPAQQ DLFIXINITCOMS [ (* ;; " This file is all because the dandelion needed its microcode embedded in the init file, and MAIKO wasn't around. So this is all to make room for microcode we don't need. Except something(?) might expect the %"InterfacePage%" as page 2 of the file, so we're leaving it in place now") (FNS DLFIXINIT DLSORTSYSOUTPAGES DLNEXTFP DLLOCKEDPAGEP DLSETLOCKBIT DLCOPYPAGEMAP DLCOPYVMPAGE DLADDPAGEMAPENTRIES ASSIGNFILEPAGE ASSIGNFILEPAGERANGE DLDUMPSYSOUT DLDUMPFPTOVP DLDUMPPAGEMAPS DLDUMPVMEMPAGES DLSETBOOTPTR DLDUMPARRAY DLMARKASDUMPED DLDUMPVMEMPAGE INSTALLDOMINO INSTALLDOMINO.DIRECT INSTALLNEWDOMINO) (FILES RDSYS READSYS) (FNS DLPRINTFPTOVP PRINTPRIMARYMAP DLREADPAGEOFWORDS SETDIF) (CONSTANTS \NO.PAGE.ASSIGNED) (GLOBALVARS DLPRIMARYMAP DLSECONDARYMAP DLLOCKBITS DLLASTDOMINOPAGE DLIFPAGE DLNEXTPM DLPAGEMAPFP FPTOVP NEWFPFROMOLD VMEMFILE VMEMFILEX) (DECLARE%: DONTEVAL@LOAD EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) READSYS LLFAULT) (P (CHECKIMPORTS '(MODARITH LLPARAMS) T]) (* ;; " This file is all because the dandelion needed its microcode embedded in the init file, and MAIKO wasn't around. So this is all to make room for microcode we don't need. Except something(?) might expect the %"InterfacePage%" as page 2 of the file, so we're leaving it in place now" ) (DEFINEQ (DLFIXINIT [LAMBDA (SYSOUTFILE DLBOOTFILE) (* ; "Edited 7-Feb-2021 13:49 by lmm") (* ;  "Edited 2-Nov-92 08:16 by sybalsky:mv:envos") (PROG ((DBPAGES 3) (%#UCODEPAGES 3) (%#ADDEDFILEPAGES 0) %#OLDFILEPAGES %#NEWFILEPAGES %#FPTOVPPAGES DLFILEX) (DECLARE (SPECVARS %#UCODEPAGES NEWFPFROMOLD DBPAGES %#NEWFILEPAGES %#OLDFILEPAGES %#ADDEDFILEPAGES %#FPTOVPPAGES DLFILEX)) (READSYS SYSOUTFILE) (SETQ %#OLDFILEPAGES (FOLDHI (GETFILEINFO VMEMFILE 'LENGTH) BYTESPERPAGE)) (DLCOPYPAGEMAP) (SETQ NEWFPFROMOLD (ARRAY %#OLDFILEPAGES 'WORD \NO.PAGE.ASSIGNED 1)) (DLSORTSYSOUTPAGES) (DLDUMPSYSOUT) (READSYS) (RETURN DLBOOTFILE]) (DLSORTSYSOUTPAGES [LAMBDA NIL (* ;  "Edited 4-Nov-92 15:47 by sybalsky:mv:envos") (DECLARE (USEDFREE FPSIZE NEWFPFROMOLD FPTOVPSIZE FPTOVP PGTAB %#FPTOVPPAGES) (SPECVARS LASTFP)) (PROG (LASTFP) (ASSIGNFILEPAGE \FP.IFPAGE \VP.IFPAGE (SUB1 \FP.IFPAGE) T) (* ;  "SUB1 because old FP's are zero-based! See VMEM structures") (ASSIGNFILEPAGERANGE \VP.DISPLAY \NP.DISPLAY (DLFPFROMRP \RP.TEMPDISPLAY)) (ASSIGNFILEPAGERANGE \VP.STACK PAGESPERSEGMENT (DLFPFROMRP \RP.STACK) T) (ASSIGNFILEPAGERANGE \VP.TYPETABLE \NP.TYPETABLE (DLFPFROMRP \RP.TYPETABLE)) (ASSIGNFILEPAGERANGE \VP.GCTABLE \NP.GCTABLE (DLFPFROMRP \RP.GCTABLE)) (ASSIGNFILEPAGERANGE \VP.GCOVERFLOW \NP.GCOVERFLOW (DLFPFROMRP \RP.GCOVERFLOW)) (ASSIGNFILEPAGERANGE \VP.FPTOVP %#FPTOVPPAGES (DLFPFROMRP \RP.FPTOVP)) (replace (IFPAGE FPTOVPStart) of DLIFPAGE with (DLFPFROMRP \RP.FPTOVP)) (replace (IFPAGE LastDominoFilePage) of DLIFPAGE with (SETQ DLLASTDOMINOPAGE %#UCODEPAGES)) [SETQ LASTFP (SUB1 (SETQ DLPAGEMAPFP (DLFPFROMRP \RP.MISCLOCKED] (* ;; "Assign next the pagemap pages, since we have to know where they live (some are new) and it is very convenient for them to be contiguous") (for J from 0 to (SUB1 \NumPMTpages) do (ASSIGNFILEPAGE (DLNEXTFP) (IPLUS J \VP.PRIMARYMAP) NIL T)) (replace (IFPAGE filePnPMT0) of DLIFPAGE with DLPAGEMAPFP) (replace (IFPAGE filePnPMP0) of DLIFPAGE with (IPLUS DLPAGEMAPFP \NumPMTpages)) (* ;; "NO LONGER -- 5,,0 TAKEN FOR FPTOVP IN MEDLEY 2.1 -- but we need the decondary page table up thru building things, so assign it:") (for J from 0 to (SUB1 (FOLDHI DLNEXTPM WORDSPERPAGE)) do (ASSIGNFILEPAGE (DLNEXTFP) (IPLUS J \VP.SECONDARYMAP) NIL T)) (* ;; "Similarly, assign locked page table, which is another structure we rewrite") (for J from 0 to (SUB1 \NumLPTPages) do (ASSIGNFILEPAGE (DLNEXTFP) (IPLUS J \VP.LPT) NIL T)) (* ;; "Finally, assign file pages for everyone we haven't taken care of yet. First the locked pages, which have to be at the front of the sysout, after the fixed assignments we have already made") [for IFLOCKED in '(T NIL) do (for VPSEG from 0 to \MAXVMSEGMENT bind PGTAB2 when (NEQ (SETQ PGTAB2 (FASTELT PGTAB VPSEG)) PGEMPTY) do (for I from 0 to (SUB1 PAGESPERSEGMENT) bind (VPBASE _ (UNFOLD VPSEG PAGESPERSEGMENT)) OLDFP when (AND [NOT (ZEROP (SETQ OLDFP (FASTELTN PGTAB2 I ] (EQ (DLLOCKEDPAGEP (IPLUS VPBASE I)) IFLOCKED) (EQ (FASTELTN NEWFPFROMOLD OLDFP) \NO.PAGE.ASSIGNED)) do (ASSIGNFILEPAGE (DLNEXTFP) (IPLUS VPBASE I) OLDFP IFLOCKED))) (COND (IFLOCKED (replace (IFPAGE LastLockedFilePage) of DLIFPAGE with LASTFP) (SETQ LASTFP DLLASTDOMINOPAGE] (replace (IFPAGE NDirtyPages) of DLIFPAGE with (replace (IFPAGE NActivePages ) of DLIFPAGE with %#NEWFILEPAGES ]) (DLNEXTFP [LAMBDA NIL (* ;  "Edited 2-Nov-92 12:29 by sybalsky:mv:envos") (do (add LASTFP 1) repeatuntil (EQ (FASTELTN FPTOVP (LLSH LASTFP 1)) \NO.VMEM.PAGE)) LASTFP]) (DLLOCKEDPAGEP [LAMBDA (VP) (* bvm%: " 6-Dec-84 22:25") (NEQ 0 (LOGAND (.LOCKEDVPMASK. VP) (FASTELTN DLLOCKBITS (FOLDLO VP BITSPERWORD]) (DLSETLOCKBIT [LAMBDA (VP) (* bvm%: " 6-Dec-84 22:26") (FASTSETAN DLLOCKBITS (FOLDLO VP BITSPERWORD) (LOGOR (.LOCKEDVPMASK. VP) (FASTELTN DLLOCKBITS (FOLDLO VP BITSPERWORD]) (DLCOPYPAGEMAP - [LAMBDA NIL (* ; - "Edited 3-Nov-92 15:46 by sybalsky:mv:envos") - (PROG NIL - [SETQ DLIFPAGE (DLCOPYVMPAGE \VP.IFPAGE (NCREATE 'VMEMPAGEP] - (* ; "Install interface page by magic") - (SETQ DLPRIMARYMAP (ARRAY (UNFOLD \NumPMTpages WORDSPERPAGE) - 'WORD 0 0)) (* ; "Primary map table") - [for J from 0 to (SUB1 \NumPMTpages) - do (DLCOPYVMPAGE (IPLUS J \VP.PRIMARYMAP) - (\ADDBASE (fetch (ARRAYP BASE) of DLPRIMARYMAP) - (UNFOLD J WORDSPERPAGE] - (SETQ DLNEXTPM (fetch (IFPAGE NxtPMAddr) of DLIFPAGE)) - (* ; - "First free offset in secondary map") - (DLADDPAGEMAPENTRIES \VP.FPTOVP \NP.FPTOVP) - (COND - ((NOT (VMPAGEP \VP.DISPLAY)) - (DLADDPAGEMAPENTRIES \VP.DISPLAY \NP.DISPLAY) - (add %#ADDEDFILEPAGES \NP.DISPLAY))) - (SETQ %#NEWFILEPAGES (IPLUS (SUB1 %#OLDFILEPAGES) - (SUB1 %#UCODEPAGES))) - - (* ;; "Used to use WORDSPERPAGE, until an FPTOVP entry went from word to cell 11/3/92 JDS:") - - (SETQ %#FPTOVPPAGES (ADD1 (FOLDHI (IPLUS %#NEWFILEPAGES %#ADDEDFILEPAGES) - CELLSPERPAGE))) - - (* ;; "Number of pages of FPTOVP needed -- cover everything in sysout, plus one more possibly needed to cover FPTOVP itself") - - (add %#ADDEDFILEPAGES %#FPTOVPPAGES) - (add %#NEWFILEPAGES %#ADDEDFILEPAGES) - - (* ;; -"Make FPTOVP big enough to hold #NEWPAGES, plus a couple of entries as slop, to prevent off-by-1's.") - - (SETQ FPTOVP (ARRAY (+ 16384 (LLSH %#NEWFILEPAGES 1)) - 'WORD \NO.VMEM.PAGE 1)) - (SETQ DLSECONDARYMAP (ARRAY (CEIL DLNEXTPM WORDSPERPAGE) - 'WORD 0 0)) - - (* ;; "Allocate enough space to accomodate existing secondary map plus anything we added. Round up to a page boundary") - - (replace (IFPAGE NxtPMAddr) of DLIFPAGE with DLNEXTPM) - (* ; - "Store back new DLNEXTPM as updated by DLADDPAGEMAPENTRIES") - (SETQ DLLOCKBITS (ARRAY (UNFOLD \NumLPTPages WORDSPERPAGE) - 'WORD 0 0)) (* ; "Read the locked page table") - (for J from 0 to (SUB1 \NumLPTPages) - do (DLCOPYVMPAGE (IPLUS J \VP.LPT) - (\ADDBASE (fetch (ARRAYP BASE) of DLLOCKBITS) - (UNFOLD J WORDSPERPAGE]) (DLCOPYVMPAGE [LAMBDA (VP BASE) (* bvm%: "14-Dec-84 12:46") (* Reads page VP from VMEMFILE into  BASE, returning BASE) (SETVMPTR (UNFOLD VP WORDSPERPAGE)) (\BINS VMEMFILEX BASE 0 BYTESPERPAGE) BASE]) (DLADDPAGEMAPENTRIES [LAMBDA (VP NPAGES) (* bvm%: "27-MAR-83 17:53") (to NPAGES do [COND ((IEQ (FASTELTN DLPRIMARYMAP (fetch (VP PRIMARYKEY) of VP)) \EmptyPMTEntry) (COND ((EVENP DLNEXTPM WORDSPERPAGE) (* must add a new page map page) (add %#ADDEDFILEPAGES 1))) (FASTSETAN DLPRIMARYMAP (fetch (VP PRIMARYKEY) of VP) DLNEXTPM) (SETQ DLNEXTPM (IPLUS DLNEXTPM \PMblockSize] (add VP 1]) (ASSIGNFILEPAGE [LAMBDA (FP VP OLDFP LOCKED) (* ;  "Edited 9-Nov-92 14:54 by sybalsky:mv:envos") (* ;; "Assign VP to live in FP (and hence a related real page); OLDFP is where VP lives in the old sysout") (COND ([NOT (ZEROP (OR OLDFP (SETQ OLDFP (LOGAND (FASTELTN (FASTELT PGTAB (LRSH VP 8)) (LOGAND VP 255)) 32767] (FASTSETAN NEWFPFROMOLD OLDFP FP))) (FASTSETAN FPTOVP (ADD1 (LLSH FP 1)) VP) (FASTSETAN FPTOVP (LLSH FP 1) 0) (PROG [(SECONDARY (FASTELTN DLPRIMARYMAP (fetch (VP PRIMARYKEY) of VP] (* ;  "Update pagemap to point to the new FP") (COND ((IEQ SECONDARY \EmptyPMTEntry) (HELP VP "has no primary map entry")) (T (FASTSETAN DLSECONDARYMAP (IPLUS SECONDARY (fetch (VP SECONDARYKEY) of VP)) FP))) (COND (LOCKED (DLSETLOCKBIT VP]) (ASSIGNFILEPAGERANGE [LAMBDA (VPSTART NPAGES FPSTART ONLYIFTHERE) (* bvm%: "25-MAR-83 12:44") (for I from 0 to (SUB1 NPAGES) unless [AND ONLYIFTHERE (NOT (VMPAGEP (IPLUS VPSTART I] do (ASSIGNFILEPAGE (IPLUS FPSTART I) (IPLUS VPSTART I) NIL T]) (DLDUMPSYSOUT [LAMBDA NIL (* ; "Edited 7-Feb-2021 20:46 by larry") (* ; "Edited 7-Feb-2021 14:28 by lmm") (* ;  "Edited 3-Nov-92 10:50 by sybalsky:mv:envos") (PROG [(DLPAGEOFZEROS (NCREATE 'VMEMPAGEP] [SETQ DLFILEX (OPENSTREAM DLBOOTFILE 'OUTPUT 'NEW 8 (CONS (LIST 'LENGTH (UNFOLD %#NEWFILEPAGES BYTESPERPAGE )) '((SEQUENTIAL T) (TYPE BINARY] (SETQ DLBOOTFILE (FULLNAME DLFILEX)) (PROGN (\BOUTS DLFILEX DLPAGEOFZEROS 0 BYTESPERPAGE) (\BOUTS DLFILEX DLIFPAGE 0 BYTESPERPAGE) (\BOUTS DLFILEX DLPAGEOFZEROS 0 BYTESPERPAGE)) (DLDUMPVMEMPAGES (ADD1 DLLASTDOMINOPAGE) (SUB1 (DLFPFROMRP \RP.FPTOVP))) (DLDUMPFPTOVP) (DLDUMPVMEMPAGES (IPLUS (DLFPFROMRP \RP.FPTOVP) %#FPTOVPPAGES) (SUB1 DLPAGEMAPFP)) (DLDUMPPAGEMAPS) (DLDUMPVMEMPAGES (IPLUS DLPAGEMAPFP \NumPMTpages (FOLDHI DLNEXTPM WORDSPERPAGE) \NumLPTPages) %#NEWFILEPAGES) (CLOSEF DLFILEX]) (DLDUMPFPTOVP [LAMBDA NIL (* ;  "Edited 4-Nov-92 13:56 by sybalsky:mv:envos") (printout T "[FPTOVP]") (* ;; "Filepages are one-based, but FPTOVP in the sysout is zero-based for convenience. Hence, first entry (page zero) is dummy") (\WOUT DLFILEX \NO.VMEM.PAGE) (* ;; "With BIG VM, each FPTOVP entry is 2 words, and word 1 (the 1st element of the array) is actually part of the entry for page 0 (which we dumped the other half above). So we need to dump 2*#pages + 1 elements of the array:") (DLDUMPARRAY FPTOVP (ADD1 (LLSH %#NEWFILEPAGES 1))) (RPTQ (IDIFFERENCE (UNFOLD %#FPTOVPPAGES WORDSPERPAGE) (LLSH (ADD1 %#NEWFILEPAGES) 1)) (\WOUT DLFILEX \NO.VMEM.PAGE)) (* ; "Fill out rest of FPTOVP with no such page. Fill from #pages*2 (it's cells now, not words per FPTOVP entry), out to the end of the FPTOVP pages.") NIL]) (DLDUMPPAGEMAPS [LAMBDA NIL (* ;  "Edited 3-Nov-92 10:47 by sybalsky:mv:envos") (printout T "[PageMaps]") (DLDUMPARRAY DLPRIMARYMAP (UNFOLD \NumPMTpages WORDSPERPAGE)) (* ; "Dump primary map") (DLDUMPARRAY DLSECONDARYMAP (CEIL DLNEXTPM WORDSPERPAGE)) (* ; "Dump secondary map") (DLDUMPARRAY DLLOCKBITS (UNFOLD \NumLPTPages WORDSPERPAGE)) (* ; "Dump locked page table") NIL]) (DLDUMPVMEMPAGES [LAMBDA (FIRSTFP LASTFP) (* ;  "Edited 2-Nov-92 12:30 by sybalsky:mv:envos") (for FP from FIRSTFP to LASTFP bind VP do (COND ((AND (NEQ [SETQ VP (FASTELTN FPTOVP (ADD1 (LLSH FP 1] \NO.VMEM.PAGE) (VMPAGEP VP)) (SETVMPTR (UNFOLD VP WORDSPERPAGE)) (COPYBYTES VMEMFILE DLFILEX BYTESPERPAGE) (PRIN1 '* T)) (T (\BOUTS DLFILEX DLPAGEOFZEROS 0 BYTESPERPAGE) (PRIN1 'x T]) (DLSETBOOTPTR [LAMBDA (FP) (* bvm%: "27-MAR-83 17:39") (printout T "[" .P2 FP "]") (SETFILEPTR DLFILEX (UNFOLD (SUB1 FP) BYTESPERPAGE]) (DLDUMPARRAY [LAMBDA (ARR NWORDS) (* ;  "Edited 3-Nov-92 11:52 by sybalsky:mv:envos") (* ;; "Dump NWORDS from array ARR, starting with the first byte in the array's contents.") (\BOUTS DLFILEX (fetch (ARRAYP BASE) of ARR) 0 (UNFOLD NWORDS BYTESPERWORD]) (DLMARKASDUMPED [LAMBDA (FIRSTFP NPAGES) (* ;  "Edited 2-Nov-92 12:30 by sybalsky:mv:envos") (for I from FIRSTFP to (IPLUS FIRSTFP NPAGES -1) do (FASTSETAN FPTOVP (LLSH I 1) \NO.VMEM.PAGE]) (DLDUMPVMEMPAGE [LAMBDA (NEWFP VP LOCKEDP) (* bvm%: "28-MAR-83 12:11") (COND ((VMPAGEP VP) (SETVMPTR (UNFOLD VP WORDSPERPAGE)) [PROG ((DESTINATIONBYTE (UNFOLD (SUB1 NEWFP) BYTESPERPAGE))) (COND ((NOT (IEQP (\GETFILEPTR DLFILEX) DESTINATIONBYTE)) (printout T "[" .P2 NEWFP "]") (SETFILEPTR DLFILEX DESTINATIONBYTE] (COPYBYTES VMEMFILE DLFILEX BYTESPERPAGE) (PRIN1 (COND (LOCKEDP '$) (T '*)) T)) (T (PRIN1 'x T]) (INSTALLDOMINO [LAMBDA (DBFILE) (* edited%: "14-APR-83 12:00") (DLSETBOOTPTR 1) (COPYBYTES DBFILE DLFILEX 0 BYTESPERPAGE) (DLSETBOOTPTR (ADD1 \FP.IFPAGE)) (* Skip over InterfacePage) (COPYBYTES DBFILE DLFILEX) (* Copy rest of Domino) (DLSETBOOTPTR DLLASTDOMINOPAGE) (SETFILEPTR DBFILE 0) (* Copy first DB page into scratch at end of Domino reserved space so that  SYSOUT can get it (Dolphin and Dorado smash first page of vmem)) (COPYBYTES DBFILE DLFILEX 0 BYTESPERPAGE]) (INSTALLDOMINO.DIRECT [LAMBDA (DBFILE) (* bvm%: "29-JUL-83 16:16") (PROG [(BUFFER (COND ((IGREATERP \#SWAPBUFFERS 1) (RESETSAVE \EMUSWAPBUFFERS (\ADDBASE \EMUSWAPBUFFERS WORDSPERPAGE)) (RESETSAVE \#SWAPBUFFERS (SUB1 \#SWAPBUFFERS)) \EMUSWAPBUFFERS) (T (RESETSAVE \EMUDISKBUFFERS (\ADDBASE \EMUDISKBUFFERS WORDSPERPAGE)) (RESETSAVE \#DISKBUFFERS (SUB1 \#DISKBUFFERS)) \EMUDISKBUFFERS] (replace ENDOFSTREAMOP of DBFILE with (FUNCTION ZERO)) (\BINS DBFILE BUFFER 0 BYTESPERPAGE) (COND ((EQ \MACHINETYPE \DANDELION) (\ACTONVMEMFILE 1 BUFFER 1 T))) (\BINS DBFILE BUFFER 0 BYTESPERPAGE) (* Skip over InterfacePage) (for I from (ADD1 \FP.IFPAGE) until (\EOFP DBFILE) do (\BINS DBFILE BUFFER 0 BYTESPERPAGE) (\ACTONVMEMFILE I BUFFER 1 T)) (* Copy rest of Domino) ]) (INSTALLNEWDOMINO [LAMBDA (SYSOUTFILE DBFILE) (* bvm%: "29-JUL-83 16:08") (RESETLST (SETQ DBFILE (GETSTREAM (OPENFILE (OR DBFILE (INFILEP '{DSK}DLISPDOMINO.DB) '{PHYLUM}DLION>BASICS>DLISPDOMINO.DB) 'INPUT) 'INPUT)) (RESETSAVE NIL (LIST 'CLOSEF DBFILE)) (PROG ((DBPAGES (IPLUS (FOLDHI (GETFILEINFO DBFILE 'LENGTH) BYTESPERPAGE) 2)) %#UCODEPAGES DLFILEX) (DECLARE (SPECVARS DLFILEX)) [COND [SYSOUTFILE [RESETSAVE NIL (LIST 'CLOSEF (SETQ SYSOUTFILE (OPENFILE SYSOUTFILE 'INPUT] (SETQ %#UCODEPAGES (SETQ DLLASTDOMINOPAGE (fetch (IFPAGE LastDominoFilePage ) of (\MAPPAGE 1 (GETSTREAM SYSOUTFILE] ((ASKUSER NIL NIL (LIST "Shall I install" (fetch FULLFILENAME of DBFILE) "directly into the vmem file")) (SETQ %#UCODEPAGES (SETQ DLLASTDOMINOPAGE (fetch (IFPAGE LastDominoFilePage) of \InterfacePage] (COND ((ILESSP %#UCODEPAGES DBPAGES) (RETURN "Not enough space for Domino"))) (COND (SYSOUTFILE (OPENFILE (CLOSEF SYSOUTFILE) 'BOTH) (SETQ DLFILEX (GETSTREAM SYSOUTFILE)) (INSTALLDOMINO DBFILE)) (T (INSTALLDOMINO.DIRECT DBFILE))) (RETURN SYSOUTFILE)))]) ) (FILESLOAD RDSYS READSYS) (DEFINEQ (DLPRINTFPTOVP [LAMBDA (STREAM) (* bvm%: "28-MAR-83 12:42") (\PRINTFPTOVP (\ADDBASE (fetch (ARRAYP BASE) of FPTOVP) -1) (fetch (IFPAGE NActivePages) of DLIFPAGE) STREAM]) (PRINTPRIMARYMAP [LAMBDA NIL (* bvm%: "28-MAR-83 23:25") (for I from 0 to 63 do (printout T I ": " 8) [for J from 0 to 7 bind PMPE do (COND ((EQ [SETQ PMPE (ELT DLPRIMARYMAP (PLUS J (TIMES I 8] 65535) (printout T " -----")) (T (printout T .I6.8 PMPE] (TERPRI T) unless (for J from 0 to 7 always (EQ (ELT DLPRIMARYMAP (PLUS J (TIMES I 8))) 65535]) (DLREADPAGEOFWORDS [LAMBDA (STREAM) (* bvm%: "29-MAR-83 00:03") (to WORDSPERPAGE collect (\WIN STREAM]) (SETDIF [LAMBDA (X Y) (* bvm%: "28-MAR-83 15:28") (for EL in X collect EL unless (FMEMB EL Y]) ) (DECLARE%: EVAL@COMPILE (RPAQQ \NO.PAGE.ASSIGNED 0) (CONSTANTS \NO.PAGE.ASSIGNED) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS DLPRIMARYMAP DLSECONDARYMAP DLLOCKBITS DLLASTDOMINOPAGE DLIFPAGE DLNEXTPM DLPAGEMAPFP FPTOVP NEWFPFROMOLD VMEMFILE VMEMFILEX) ) (DECLARE%: DONTEVAL@LOAD EVAL@COMPILE DONTCOPY (FILESLOAD (LOADCOMP) READSYS LLFAULT) (CHECKIMPORTS '(MODARITH LLPARAMS) T) ) (DECLARE%: DONTCOPY (FILEMAP (NIL (1881 24637 (DLFIXINIT 1891 . 2879) (DLSORTSYSOUTPAGES 2881 . 8007) (DLNEXTFP 8009 . 8346) (DLLOCKEDPAGEP 8348 . 8562) (DLSETLOCKBIT 8564 . 8826) (DLCOPYPAGEMAP 8828 . 11879) ( DLCOPYVMPAGE 11881 . 12271) (DLADDPAGEMAPENTRIES 12273 . 13088) (ASSIGNFILEPAGE 13090 . 14323) ( ASSIGNFILEPAGERANGE 14325 . 14732) (DLDUMPSYSOUT 14734 . 16495) (DLDUMPFPTOVP 16497 . 17536) ( DLDUMPPAGEMAPS 17538 . 18238) (DLDUMPVMEMPAGES 18240 . 18896) (DLSETBOOTPTR 18898 . 19128) ( DLDUMPARRAY 19130 . 19517) (DLMARKASDUMPED 19519 . 19972) (DLDUMPVMEMPAGE 19974 . 20662) ( INSTALLDOMINO 20664 . 21311) (INSTALLDOMINO.DIRECT 21313 . 22465) (INSTALLNEWDOMINO 22467 . 24635)) ( 24665 26022 (DLPRINTFPTOVP 24675 . 24964) (PRINTPRIMARYMAP 24966 . 25680) (DLREADPAGEOFWORDS 25682 . 25849) (SETDIF 25851 . 26020))))) STOP \ No newline at end of file diff --git a/sources/DLFIXINIT.LCOM b/sources/DLFIXINIT.LCOM deleted file mode 100644 index a8f36d86d58e7d7155107f1ff734b3244d4d407b..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 10808 zcmbVSU2GiJb)H?)GNYIZDYCY~w)V|hvPsoqclL+m(yqKi?yPpm-JQ|SkRoNd3B_HD zfoOQk>I!}89(cka)*=X~coXYOc0FB(<-V$mq;7maGs6farY?7Vha7YU>4=(Vz8 zTM6+}P1g#JHdF4Zp3!VwsL8SZQ5s+ty&SzD5@PaVv2o*KDw$G6N}W#Trjyx(7)`8p zHn-MWjk@Tx(dke`BJ546o%bYFpbFJDC*f)O1pvPNx#$#&*LWe06Q5eY3H1ep(dDg@uY`FWcsV zBi7rZKT+YqMS46dinm%VVc*6)yF#eJg2%_l6QaJdi)ALl^{Lc!8uLvh{aW9>;`IepXT9t)BYE;OwdVR}}nxlYVZ} z&uRK;$Bqv_|JB=lRG#PRjplRo@B;mCb?~DND5H}pK^l%(#KdGo++reyXWOhfatU&U z*_6;~HEmg>b7-A4t!1jOXqHG#ipx5$o2^Op2Zq*UCj|-1D%Q*jL?kj@vvZ5oiF2hz+d}521tzSkd zEsSE>oSlbxVv%AFze!QnYzJc$g-WLpK3Y`Ksf7**HFUJ$(;gGC&%fHED1!q^E8ZSf zn(Hj&_F1L%i}q>dt0e4pOsTiy$8O7uO1oES4;{;<=c%>*g8TG>(rmxzmgCCR=i5E< z;hQ{6&+&sdxODYJKEwyp?bA=V)O@(qdUj(l9-lLw+`T-+o%rX$3qiTnclh9Wer!QC znh(AHe>l|onpb{fsH5QTj`Afd$6R|jez+zVzCYJIxVHBLxBeL=TK}one=A!55B1n! ztfzInF?jY=rTpYC?GA=E=RQRdaybzcIXVbWbyf zpXvFYIm}vqFKwPR2M)PBe{}ae4`2>+?~S9ozr)MmF6Qt&AH}{o&^-9Yz}}CCD$Rp; z?i_zOH2=5!R_Q@*p9?=3iuc^_`I9@xi~QJf1C%X(vxK3QX$E7(455t#cO)aL^-2| zx?)`SJy=(|dydoujpWXe%A8n3DoqCMwWqQt-iKQI?YZvZYg!eqa4OmLmaLwbdTMnx z^VI6h(+2@yM5QLjR=WoQevo%4l#L<@4B#;pddScw$easi#i*LHM>-SqNMjEX@JXv# z;DlbW9H3Y-EinTCL~uvavMNGl>~oO~C#V9z{Q1=^0J|J&1eyhnkaMIFlbu+fnhfnA z7nHG6kxFL8s3WRId5lodJw67%q7PhSLit@KrYKhPU{#UoY(0_=;Q09H?!Q~mTOg{Z zbQl+~DNzn(8aJ$fJUIE9MGFH9MNwkSeCump@PKR;`Cs9WAHUc*T06q%sf<55aJXEy zOEd|IokpH99NV49)*ZJ-I#z$4KcIPn(SPHN|H76?hKMcToH3vVGYZYG`U}9Sf(5`w z2M_LQ!Vb%GC~yfyIEE9Rx(L@1g?;oRzaMoM#0?^DzX(4Rb|7#T7vs;sAq*?6(=W3W z8NSlX*Bz55Hz zhl|aJhpVURwZqo859!?S*F0S9t2t=5YX_^R+Ihu(binMOeS93^2YecE6PwBxk~@S} z#%=ubU9{(Q3;~j1UWiy8_jj{HQsiP#)ssLXf3S zQH!n5n$?0kh>H2-TN9pVVVr`yU|uTJjN8HY3TOu)`^c1LU~0%1WpYTrqe$0 zTN0_XC>HcZ;IFV9@KPYL8Z^7hJ9%U-fT^NNr)@KDULxn#-jp z-(4GEHD!d85C@w$x;x3Wtz+QbM>U{quS8kdjoTQOWNk|vvW@QNn+G?PeW>`}k3g-% zc$J#)@eM>ecq$?IUB78IdGxzgavx5ehlmT0th zw{IizjvlY1O1=j(_-xH;dD$pBCA~(WBerDOj#hI}?y?N7##vvav(`8!AfE$UnEhVf zkTm;mW{g9Wy)b}ad+(o>(KPTiN_DYr7g5Lh!CEA}2xT992$8hNWTtCV=!Fv`!o0+W z8VY;=FOCS(20>`%NWay57}Ro41X}Vx!mPvAz@g3UR|1uVanF`b1Q9S_ z!grDp#k>-;)HL}!s&hS-4VCaB@=!MrIoZv_eelKZv2saqeFm8yTR_X*5>(tRAyOzV zl*?7E0xqoz)6%OFY)P-#d3ipGA;(<~vEWpc_~vNlF6uo&J9CLTtjCM)CrIxJ%&{uO zQl#*(pwUrVzp?<=Y-nZSjDhzqTe_Grs&IN^On*rp?nYUUy0zv6KO@Q}UtqC9P3#x~ zbykFRc_OW2{=a|4E%2$;09IUWKdvV4BQ?CbJ$B zLVE6kK>E!~lMxBm(5fKPg7_$Ebmau8ypFIj7P5x@yu0*Jot1Asd@RFB zs0@@Ei{{J*Mg}{U8-q?$Ar;bTMt|B(;++H^xv$Go+xV2(84;6}Gz~3Sp?{KC;b<@D znUi*^FQxdmg)|m5U<&trTlOzKsKCjuN=STv&x~4*} zx*TIsY8KY;8XRLhuN`h4ALa++u5WY|2#O<>gAe;(;SxhU4-*0;BgaD1dYT?g4nywgbd-46{mFf<+-I%K1vE`Yt)+6o%_5S?RINzW|f%k)-JEZB42$pB=fxh|H>B zS+%Bd=4|O9a%ðy64K*sql&L`oV~^Xy^fBUbi53#t4-xD3UITD$szaKSAlCqgy= z-xN|OsJZL}vMkjJe#(6<6BtX@vlX%r$n68Tk{rxIMGEVj$OXA$B-5lW0G52GCP1-C zCBYdJZ$l>y_&cp!mIX%0nW-!8(b0U3ll=* z8Ug`mX<$zoPO=A<3%3w-9dZfh)4=T z5phy5K`LcXLc$!sh;;Fc>=;0pN|aPjikXFCQLmu`FvSxWK+Tw*zEIO?TV}0dUqHrV z=@jI~7SsIl?iE%NNxw$8%q_@)yGen?k=5t+pWeykS^M0DU)wXE-t)H{4z?n}hDRN~ z;37{D!N&5;30u9!8EFr#Q%4^+OU?CGFR$m!{)t!O-YauwhDcZ7F`|9m9E|nmo8>cS z@1>#*h?t-8Uap)Onh#Gi-#qwi?^7B6q)CY!(^>>`q65UI7w-wk9JC?37&IYq9kjq2 zf);$u30h!UehcXp&i*m)pZPB!sl2ffGU#F640lDJOG$1rO1(|^@mr9c}~#RO-DkG=j%v_|c& zp(RB7z+ayjDS2{qB$c|mO=Y>tzN%T?8sMp~zY?jyYmtg92zsOfK7zd>VkDq+B|R*tkA;*C>nozb`cdM<^)72k9vBPn0;RoCK*W=D7 z-+(@5`~KN9CwD$A8DD9Oc4Di2TrhPf~Pi6DoW8^Wx2O!AvfRt&XzK#nNyRF-} zC9&HPyK4>c-ezM{yo=i!=z#?$?6no#moU&_XBVY_K==mcc~ko24HyNx0FNUh>ehNT zBwGJc$*^T&#x)u8s1cJv?CkXe(|f50q}Yabv#PPu@lT(Ezx{KkVqh7F-e^8vg0ya2 z6M=dxVjzdUVY}+&FPm`zq5_6T-(wU(x(56n-!JLfL%@>c0b@z8U}ovzU8=r${7bf% zR!veMX31C=xsUKrq_a>z?|UjH!=d|01ANA$>^l*X5RK;d@#E#xT@nwv0!|O9run-* zI6W5jBTDzQ-onRim$>ssm7e*zC-+|F1+f*6?7qn}{CsGgPmSZmJI4)~$HZMD>VoumkR9naW~R70Xcjr7?_m4&%l1 zgKAHy=YFp-5UXpy_v6pz?)T5Hja*yaFU6Pk{%!u%YkU6@9&OaBf%PoUniUd>!%;3@ zm_iMGeymyAl`GL&q?|5@H{QT~DB-NF@35H*{3i>)(O6x%wbNh>sIRo^jn+DDYqcAV zIxa-5@9v1r_0{dpYNy^1jm;a4I#;*3`+9qQm&bZt;6+ipVt2Fnx&_7shZ0(92To=Ot?VF=-jiK|+ zH6YsuTfi<}!TCf4i_a$nQpsC{$|=!#m%9+8y^dkT`;FJO8=}=%c@LvuXLLbqt3~M8 z?!2GCRWtYMm3#dR670T<PimCCht8DG2KWp8aR6XxEobTeDI*QK#Bvm zs@&UEzED|J-BoirFi?SIcUzvc7`%;-IPfb~OzfUp2Tpepr|bX*#s`*jn0=JHQOdZFQPW`cW5^@ZpS+i8^Tg4E@NnUT7zN$t{GY_kpEv#+FEd6b diff --git a/sources/FILESETS b/sources/FILESETS index dcb746e2..72c7ae5a 100644 --- a/sources/FILESETS +++ b/sources/FILESETS @@ -1 +1 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED " 7-Feb-2021 20:03:00" {DSK}larry>ilisp>medley>sources>FILESETS.;3 7121 changes to%: (VARS 1LISPSET) previous date%: " 7-Feb-2021 19:45:53" {DSK}larry>ilisp>medley>sources>FILESETS.;2) (* ; " Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1998, 2021 by Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT FILESETSCOMS) (RPAQQ FILESETSCOMS ( (* ;;; "contains all of the lists of files which are used in various ways") (* ;; "I took out the EXPORT of the filesets because it led to inconsistency when one had loaded ABC. -- Pavel") (VARS * FILESETS) (VARS EXPORTFILES) (VARS MAKEINITFILES MAKEINITTYPES RENAMETYPES ABCFILES READSYSFILES DATABASEFILES) (VARS DEADFNS))) (* ;;; "contains all of the lists of files which are used in various ways") (* ;; "I took out the EXPORT of the filesets because it led to inconsistency when one had loaded ABC. -- Pavel" ) (RPAQQ FILESETS (0LISPSET 1LISPSET 2LISPSET 3LISPSET 4LISPSET 5LISPSET 6LISPSET 7LISPSET 8LISPSET 9LISPSET)) (RPAQQ 0LISPSET (PACKAGE-CONVERSION-TABLE LLFAULT LLSUBRS LLBFS LLNEW FILEIO IMAGEIO LLBASIC LLGC LLARRAYELT LLINTERP LLMVS DEFSTRUCT-RUN-TIME SETF-RUNTIME CMLSEQBASICS LLARITH LLFLOAT LLBIGNUM LLREAD LLCHAR LLSTK LLDATATYPE IOCHAR LLKEY LLTIMER)) (RPAQQ 1LISPSET (ASTACK DTDECLARE ATBL LLCODE ACODE COREIO AOFD ADIR PMAP VANILLADISK ATERM APRINT ABASIC AERROR AINTERRUPT MISC BOOTSTRAP CMLMACROS CMLEVAL CMLPROGV CMLSPECIALFORMS LLRESTART LLERROR LLSYMBOL LLPACKAGE PACKAGE-STARTUP CONDITION-PACKAGE XCL-PACKAGE PROC CMLARRAY DSK UFS UFSCALLC PASSWORDS FONT LLDISPLAY APUTDQ COMPATIBILITY DMISC CMLMACROS CMLLIST CMLCHARACTER CMLREADTABLE MAIKOLOADUPFNS MAIKOBITBLT MAIKOINIT)) (RPAQQ 2LISPSET (MACHINEINDEPENDENT POSTLOADUP)) (RPAQQ 3LISPSET (MACROS DLAP BYTECOMPILER COMPILE)) (RPAQQ 4LISPSET (EDIT WEDIT HELPDL PRETTY COMMENT BREAK ADVISE LOADFNS FILEPKG DFILE DMISC)) (RPAQQ 5LISPSET (HIST UNDO SPELL DWIM WTFIX CLISP DWIMIFY CLISPIFY RECORD ASSIST)) (RPAQQ 6LISPSET (MSANALYZE MSPARSE MASTERSCOPE HPRINT BRKDWN MATCH)) (RPAQQ 7LISPSET (ADISPLAY DEXEC AARITH AFONT HARDCOPY PRESS HLDISPLAY MENU WINDOW WBREAK INSPECT INSPECT-CLOSURE BSP CHAT TRSERVER 10MBDRIVER LLNS DISKDLION SPP COURIER NSPRINT CLEARINGHOUSE NSFILING INTERPRESS ADDARITH MACROAUX DEDIT DSPRINTDEF NEWPRINTDEF TTYIN DPUPFTP FLOPPY)) (RPAQQ 8LISPSET (MAKEINIT MEM RENAMEFNS)) (RPAQQ 9LISPSET (LLFCOMPILE VMEM READSYS APS PCALLSTATS UPCSTATS REMOTEVMEM)) (RPAQQ EXPORTFILES (FILESETS MODARITH LLPARAMS LLCODE AERROR AOFD APRINT ATERM LLARRAYELT LLDATATYPE LLNEW LLBASIC LLCHAR LLSTK PMAP LLGC ATBL FILEIO LLARITH LLFLOAT FONT LLKEY LLDISPLAY ADISPLAY AINTERRUPT PUP RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER LLETHER IMAGEIO PROC LLREAD PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS)) (RPAQQ MAKEINITFILES (MAKEINIT MEM I-NEW)) (RPAQQ MAKEINITTYPES ((NIL INIT (0 1) 2LISPSET 1600) (SMALLINIT SMALLINIT (LLFAULT LLSUBRS LLNEW FILEIO LLBASIC LLGC LLINTERP LLARITH LLREAD LLCHAR TINYPATCH)) (MACROTEST MACROTEST ((MACROTEST) 0 1) 2LISPSET) (MICROTEST MICROTEST ((MICROTEST LLFAULT LLSTK LLSUBRS LLKEY LLBFS))) (NANOTEST NANOTEST ((MICROTEST LLSUBRS))) (NULL NULL ((DUMMY))) (MILLITEST MILLITEST ((MACROTEST LLFAULT LLSUBRS LLNEW LLBASIC LLGC LLINTERP LLARITH LLFLOAT LLARRAYELT LLSTK LLDATATYPE LLKEY ABASIC LLCHAR ASTACK MISC APUTDQ))) (CHECKARRAYS CHECKARRAYS (CHECKARRAYSPACE 0 1) 2LISPSET))) (RPAQQ RENAMETYPES ((I (FILES LLPARAMS LLCODE LLARRAYELT LLCHAR LLNEW LLBASIC LLDATATYPE LLGC LLSTK RENAMEMACROS MODARITH LLFAULT LLKEY LLBFS LLTIMER) (RENAMEDFILE . I-NEW) (SUBNAME . MKI.SUBFNS) (COMSNAME . INEWCOMS) (EXTRACOMS (VARS INITPTRS INITVALUES) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) MAKEINIT))) (MKI.SUBFNS) (INEWCOMS) (VALUES . INITVALUES) (PTRS . INITPTRS) (PREFIX . I.) (VAG2FN . I.VAG2)) (R (FILES LLCODE LLPARAMS LLBASIC LLDATATYPE LLNEW ACODE LLARRAYELT LLCHAR LLINTERP LLSTK RENAMEMACROS MODARITH LLFAULT) (RENAMEDFILE . RDSYS) (SUBNAME . RD.SUBFNS) (COMSNAME . RDCOMS) (EXTRACOMS (* ;; "YOU MUST REMAKE THIS FILE using (DORENAME 'R) (after CONNing to library) whenever the SYSOUT layout changes in LLPARAMS (e.g., if MDSTypeTable moves)") (FILES VMEM) (VARS RDVALS RDPTRS) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) VMEM))) (RD.SUBFNS (\CALLME . *)) (RDCOMS) (PTRS . RDPTRS) (PREFIX . V) (VAG2FN . VVAG2) (VALUES . RDVALS) (RDPTRS) (RDVALUES)))) (RPAQQ ABCFILES (LOADABC COMPILEBANG SAMEDIR WHEREIS COMPILEFORMSLIST CHECKSET CMACROS DCODEFOR10 DTDECLARE BYTECOMPILER DLAP LLCODE ACODE MACROAUX)) (RPAQQ READSYSFILES (RDSYS READSYS VMEM REMOTEVMEM)) (RPAQQ DATABASEFILES (0LISPSET 1LISPSET (2LISPSET ACODE) (3LISPSET DLAP) (4LISPSET DFILE DMISC) 7LISPSET (8LISPSET MAKEINIT MEM) 9LISPSET (10LISPSET LLPARAMS) (NIL CHECKARRAYSPACE MAKEINEW PMEMSTATS PPAGESTATS LLFCOMPILE))) (RPAQQ DEADFNS ((PUTBASE \PUTBASE) (GETBASE \GETBASE) (ADDBASE \ADDBASE) (GETBASEBYTE \GETBASEBYTE) (PUTBASEBYTE \PUTBASEBYTE) (PUTBASEPTR \PUTBASEPTR) (HILOC \HILOC) (LOLOC \LOLOC) (VAG2 \VAG2) (PAGEBASE NIL) (PAGELOC NIL) (WordsPerPage WORDSPERPAGE) (ALTOMACRO DMACRO) (\STACKSPACE ??) (GETBASEPTR \GETBASEPTR) (FPLUS2) (FTIMES2) (CREATECELL \CREATECELL))) (PUTPROPS FILESETS COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1998 2021)) (DECLARE%: DONTCOPY (FILEMAP (NIL))) STOP \ No newline at end of file +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED " 6-Mar-2021 20:01:54" {DSK}larry>ilisp>medley>sources>FILESETS.;5 6224 changes to%: (VARS EXPORTFILES) previous date%: " 6-Mar-2021 16:22:11" {DSK}larry>ilisp>medley>sources>FILESETS.;4) (* ; " Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation. ") (PRETTYCOMPRINT FILESETSCOMS) (RPAQQ FILESETSCOMS ( (* ;;; "contains all of the lists of files which are used in various ways") (* ;; "I took out the EXPORT of the filesets because it led to inconsistency when one had loaded ABC. -- Pavel") (VARS * FILESETS) (VARS EXPORTFILES) (VARS MAKEINITFILES MAKEINITTYPES RENAMETYPES ABCFILES READSYSFILES DATABASEFILES) (VARS DEADFNS))) (* ;;; "contains all of the lists of files which are used in various ways") (* ;; "I took out the EXPORT of the filesets because it led to inconsistency when one had loaded ABC. -- Pavel" ) (RPAQQ FILESETS (0LISPSET 1LISPSET 2LISPSET 3LISPSET)) (RPAQQ 0LISPSET (PACKAGE-CONVERSION-TABLE LLFAULT LLSUBRS LLBFS LLNEW FILEIO IMAGEIO LLBASIC LLGC LLARRAYELT LLINTERP LLMVS DEFSTRUCT-RUN-TIME SETF-RUNTIME CMLSEQBASICS LLARITH LLFLOAT LLBIGNUM LLREAD LLCHAR LLSTK LLDATATYPE IOCHAR LLKEY LLTIMER)) (RPAQQ 1LISPSET (ASTACK DTDECLARE ATBL LLCODE ACODE COREIO AOFD ADIR PMAP VANILLADISK ATERM APRINT ABASIC AERROR AINTERRUPT MISC BOOTSTRAP CMLMACROS CMLEVAL CMLPROGV CMLSPECIALFORMS LLRESTART LLERROR LLSYMBOL LLPACKAGE PACKAGE-STARTUP CONDITION-PACKAGE XCL-PACKAGE PROC CMLARRAY DSK UFS UFSCALLC PASSWORDS FONT LLDISPLAY APUTDQ COMPATIBILITY DMISC CMLMACROS CMLLIST CMLCHARACTER CMLREADTABLE MAIKOLOADUPFNS MAIKOBITBLT MAIKOINIT)) (RPAQQ 2LISPSET (MACHINEINDEPENDENT POSTLOADUP)) (RPAQQ 3LISPSET (MACROS DLAP BYTECOMPILER COMPILE)) (RPAQQ EXPORTFILES (MODARITH LLPARAMS LLCODE AERROR AOFD APRINT ATERM LLARRAYELT LLDATATYPE LLNEW LLBASIC LLCHAR LLSTK PMAP LLGC ATBL FILEIO LLARITH LLFLOAT FONT LLKEY LLDISPLAY ADISPLAY AINTERRUPT RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER IMAGEIO PROC LLREAD PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS)) (RPAQQ MAKEINITFILES (MAKEINIT MEM I-NEW)) (RPAQQ MAKEINITTYPES ((NIL INIT (0 1) 2LISPSET 1600) (SMALLINIT SMALLINIT (LLFAULT LLSUBRS LLNEW FILEIO LLBASIC LLGC LLINTERP LLARITH LLREAD LLCHAR TINYPATCH)) (MACROTEST MACROTEST ((MACROTEST) 0 1) 2LISPSET) (MICROTEST MICROTEST ((MICROTEST LLFAULT LLSTK LLSUBRS LLKEY LLBFS))) (NANOTEST NANOTEST ((MICROTEST LLSUBRS))) (NULL NULL ((DUMMY))) (MILLITEST MILLITEST ((MACROTEST LLFAULT LLSUBRS LLNEW LLBASIC LLGC LLINTERP LLARITH LLFLOAT LLARRAYELT LLSTK LLDATATYPE LLKEY ABASIC LLCHAR ASTACK MISC APUTDQ))) (CHECKARRAYS CHECKARRAYS (CHECKARRAYSPACE 0 1) 2LISPSET))) (RPAQQ RENAMETYPES ((I (FILES LLPARAMS LLCODE LLARRAYELT LLCHAR LLNEW LLBASIC LLDATATYPE LLGC LLSTK RENAMEMACROS MODARITH LLFAULT LLKEY LLBFS LLTIMER) (RENAMEDFILE . I-NEW) (SUBNAME . MKI.SUBFNS) (COMSNAME . INEWCOMS) (EXTRACOMS (VARS INITPTRS INITVALUES) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) MAKEINIT))) (MKI.SUBFNS) (INEWCOMS) (VALUES . INITVALUES) (PTRS . INITPTRS) (PREFIX . I.) (VAG2FN . I.VAG2)) (R (FILES LLCODE LLPARAMS LLBASIC LLDATATYPE LLNEW ACODE LLARRAYELT LLCHAR LLINTERP LLSTK RENAMEMACROS MODARITH LLFAULT) (RENAMEDFILE . RDSYS) (SUBNAME . RD.SUBFNS) (COMSNAME . RDCOMS) (EXTRACOMS (* ;; "YOU MUST REMAKE THIS FILE using (DORENAME 'R) (after CONNing to library) whenever the SYSOUT layout changes in LLPARAMS (e.g., if MDSTypeTable moves)") (FILES VMEM) (VARS RDVALS RDPTRS) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) VMEM))) (RD.SUBFNS (\CALLME . *)) (RDCOMS) (PTRS . RDPTRS) (PREFIX . V) (VAG2FN . VVAG2) (VALUES . RDVALS) (RDPTRS) (RDVALUES)))) (RPAQQ ABCFILES (LOADABC COMPILEBANG SAMEDIR WHEREIS COMPILEFORMSLIST CHECKSET CMACROS DCODEFOR10 DTDECLARE BYTECOMPILER DLAP LLCODE ACODE MACROAUX)) (RPAQQ READSYSFILES (RDSYS READSYS VMEM REMOTEVMEM)) (RPAQQ DATABASEFILES (0LISPSET 1LISPSET (2LISPSET ACODE) (3LISPSET DLAP) (4LISPSET DFILE DMISC) 7LISPSET (8LISPSET MAKEINIT MEM) 9LISPSET (10LISPSET LLPARAMS) (NIL CHECKARRAYSPACE MAKEINEW PMEMSTATS PPAGESTATS LLFCOMPILE))) (RPAQQ DEADFNS ((PUTBASE \PUTBASE) (GETBASE \GETBASE) (ADDBASE \ADDBASE) (GETBASEBYTE \GETBASEBYTE) (PUTBASEBYTE \PUTBASEBYTE) (PUTBASEPTR \PUTBASEPTR) (HILOC \HILOC) (LOLOC \LOLOC) (VAG2 \VAG2) (PAGEBASE NIL) (PAGELOC NIL) (WordsPerPage WORDSPERPAGE) (ALTOMACRO DMACRO) (\STACKSPACE ??) (GETBASEPTR \GETBASEPTR) (FPLUS2) (FTIMES2) (CREATECELL \CREATECELL))) (PUTPROPS FILESETS COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1998 2021)) (DECLARE%: DONTCOPY (FILEMAP (NIL))) STOP \ No newline at end of file diff --git a/sources/LOADUP-FULL b/sources/LOADUP-FULL index cc62c5e0..f836370c 100644 --- a/sources/LOADUP-FULL +++ b/sources/LOADUP-FULL @@ -1 +1 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "28-Feb-2021 19:48:05" {DSK}larry>medley>sources>LOADUP-FULL.;2 5934 changes to%: (FNS MAKEFULLSYSOUT) previous date%: "14-Feb-2021 10:08:45" {DSK}larry>medley>sources>LOADUP-FULL.;1) (PRETTYCOMPRINT LOADUP-FULLCOMS) (RPAQQ LOADUP-FULLCOMS ((COMMANDS "cd" "pwd" "ls") (FNS LOADFULLFONTS MAKEFULLSYSOUT FIXMETA) (P (FIXMETA)) (GLOBALVARS MISSINGDISPLAYFONTCOERCIONS MISSINGCHARSETDISPLAYFONTCOERCIONS) (DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE DOCOPY (P (MAKEFULLSYSOUT T))) (PROP FILETYPE))) (DEFCOMMAND "cd" (DIR) (/CNDIR DIR)) (DEFCOMMAND "pwd" NIL (DIRECTORYNAME T)) (DEFCOMMAND "ls" (FIRST . REST) (DODIR (CONS FIRST REST))) (DEFINEQ (LOADFULLFONTS [LAMBDA NIL (* ; "Edited 13-Feb-2021 22:51 by larry") (* ;; " Don't do Interpress. Do character set 0 and the symbol character sets 41Q, 42Q, 356Q, 357Q and extended and accented Latin 43Q and 361Q") (PRINTOUT T "Loading FULL fonts..." T) (SETQ DISPLAYFONTEXTENSIONS '(DISPLAYFONT STRIKE)) (SETQ *POSTSCRIPT-FILE-TYPE* 'TEXT) (RESETVARS ((MISSINGDISPLAYFONTCOERCIONS NIL) (MISSINGCHARSETDISPLAYFONTCOERCIONS NIL)) (* ;  "Don't let the font loader substitute just because a server went catatonic on us") (for FAMILY in '(CLASSIC MODERN TERMINAL) do (PRINTOUT T " Loading " FAMILY " ") [for SIZE in '(8 10 12) do (PRINTOUT T SIZE " ") (for FACE in '(MRR BRR MIR) do (for CSET in '(0 33 34 35 238 239 241) do (NLSETQ (FONTCREATE FAMILY SIZE FACE NIL 'DISPLAY NIL CSET] (PRINTOUT T T)) (PRINTOUT T " Loading postscript fonts" T) (for F in (FILDIR (CONCAT (CAR POSTSCRIPTFONTDIRECTORIES) ">c0>*.*")) do (PSCFONT.READFONT F)) (PRINTOUT T "FULL fonts loaded" T]) (MAKEFULLSYSOUT [LAMBDA (DOIT) (* ; "Edited 28-Feb-2021 19:47 by larry") (* ; "Edited 14-May-2018 15:01 by kaplan") (* ; "Edited 28-Sep-2020 12:35 by rmk:") (* ; "Edited 17-Apr-2018 08:41 by ") (* ; "Edited 21-Apr-2018 07:27 by rmk:") (* ; "Edited 23-Feb-94 15:04 by bvm") (CLRPROMPT) (SETQ MAKESYSFILENAME (CONCAT (MEDLEYDIR "loadups") "full.sysout")) (SETQ MAKESYSNAME (CONCAT "Medley from Interlisp.org of " (DATE))) (DRIBBLE (PACKFILENAME 'EXTENSION "dribble" 'BODY MAKESYSFILENAME)) (* ;; "BKSYSBUF stops page holding ") (PRINTOUT T T "Full loadup started at " (DATE) " while connected to " (DIRECTORYNAME T) T T) (BKSYSBUF " ") (SETQ DEFAULTFILETYPE 'BINARY) (* ;  "These prevent bits from being lost due to lack of knowledge") (DREMOVE (ASSOC NIL DEFAULTFILETYPELIST) DEFAULTFILETYPELIST) (push DEFAULTFILETYPELIST '(TXT . TEXT) '(TEXT . TEXT) '(TEX . TEXT) '(HTML . TEXT) '(HTM . TEXT)) (MEDLEY-INIT-VARS) (SETQ LOADUPDIRECTORIES DIRECTORIES) (LOADUP '(POSTSCRIPTSTREAM)) (* ; " to get PSCFONT.READFONT") (LOADFULLFONTS) (LISTPUT IDLE.PROFILE 'TIMEOUT 0) (SETQQ *DEFAULT-CLEANUP-COMPILER* BCOMPL) (LOADUP '(CHAT PRESS INTERPRESS TEDIT HRULE TEDITCHAT READNUMBER EDITBITMAP FILEBROWSER THINFILES GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT UNICODE ISO8859IO HELPSYS DINFO CLIPBOARD MODERNIZE PRETTYFILEINDEX WHO-LINE UNIXCOMM UNIXCHAT)) (SETQ *WHO-LINE-ANCHOR* '(:CENTER :TOP)) (* ;; "Turn off who-line until after the user has greeted") (CL:WHEN (WINDOWP *WHO-LINE*) (CLOSEW *WHO-LINE*)) [SETQ POSTGREETFORMS (APPEND POSTGREETFORMS '((INSTALL-WHO-LINE-OPTIONS] (LISTPUT IDLE.PROFILE 'TIMEOUT 20) (SETTOPVAL 'INITIALS NIL) (ENDLOADUP) (COND ((WINDOWP LOGOW) (CLOSEW LOGOW))) (DREMOVE (ASSOC 'LOGOW AFTERMAKESYSFORMS) AFTERMAKESYSFORMS) (push AFTERMAKESYSFORMS '(CLRPROMPT) '(MEDLEY-INIT-VARS)) (* ;; "Set up for making the sysout, if we made it this far.") (CL:WHEN DOIT (PRINTOUT T "Creating FULL sysout on " MAKESYSFILENAME T) (BKSYSBUF (CONCAT "(IL:MAKESYS %"" MAKESYSFILENAME "%" %"Medley " " Full Sysout%")" " (IL:LOGOUT T)"))) (DRIBBLE]) (FIXMETA [LAMBDA NIL (* ;  "Edited 25-Jun-2017 17:12 by rmk:") (KEYACTION 'BLANK-TOP '(METADOWN . METAUP) \CURRENTKEYACTION) (KEYACTION 'BLANK-TOP '(METADOWN . METAUP]) ) (FIXMETA) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS MISSINGDISPLAYFONTCOERCIONS MISSINGCHARSETDISPLAYFONTCOERCIONS) ) (DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE DOCOPY (MAKEFULLSYSOUT T) ) (DECLARE%: DONTCOPY (FILEMAP (NIL (802 5706 (LOADFULLFONTS 812 . 2400) (MAKEFULLSYSOUT 2402 . 5395) (FIXMETA 5397 . 5704)) ))) STOP \ No newline at end of file +(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED " 6-Mar-2021 13:32:51" {DSK}larry>ilisp>medley>sources>LOADUP-FULL.;4 5942 changes to%: (FNS MAKEFULLSYSOUT) previous date%: "28-Feb-2021 19:48:05" {DSK}larry>ilisp>medley>sources>LOADUP-FULL.;3) (PRETTYCOMPRINT LOADUP-FULLCOMS) (RPAQQ LOADUP-FULLCOMS ((COMMANDS "cd" "pwd" "ls") (FNS LOADFULLFONTS MAKEFULLSYSOUT FIXMETA) (P (FIXMETA)) (GLOBALVARS MISSINGDISPLAYFONTCOERCIONS MISSINGCHARSETDISPLAYFONTCOERCIONS) (DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE DOCOPY (P (MAKEFULLSYSOUT T))) (PROP FILETYPE))) (DEFCOMMAND "cd" (DIR) (/CNDIR DIR)) (DEFCOMMAND "pwd" NIL (DIRECTORYNAME T)) (DEFCOMMAND "ls" (FIRST . REST) (DODIR (CONS FIRST REST))) (DEFINEQ (LOADFULLFONTS [LAMBDA NIL (* ; "Edited 13-Feb-2021 22:51 by larry") (* ;; " Don't do Interpress. Do character set 0 and the symbol character sets 41Q, 42Q, 356Q, 357Q and extended and accented Latin 43Q and 361Q") (PRINTOUT T "Loading FULL fonts..." T) (SETQ DISPLAYFONTEXTENSIONS '(DISPLAYFONT STRIKE)) (SETQ *POSTSCRIPT-FILE-TYPE* 'TEXT) (RESETVARS ((MISSINGDISPLAYFONTCOERCIONS NIL) (MISSINGCHARSETDISPLAYFONTCOERCIONS NIL)) (* ;  "Don't let the font loader substitute just because a server went catatonic on us") (for FAMILY in '(CLASSIC MODERN TERMINAL) do (PRINTOUT T " Loading " FAMILY " ") [for SIZE in '(8 10 12) do (PRINTOUT T SIZE " ") (for FACE in '(MRR BRR MIR) do (for CSET in '(0 33 34 35 238 239 241) do (NLSETQ (FONTCREATE FAMILY SIZE FACE NIL 'DISPLAY NIL CSET] (PRINTOUT T T)) (PRINTOUT T " Loading postscript fonts" T) (for F in (FILDIR (CONCAT (CAR POSTSCRIPTFONTDIRECTORIES) ">c0>*.*")) do (PSCFONT.READFONT F)) (PRINTOUT T "FULL fonts loaded" T]) (MAKEFULLSYSOUT [LAMBDA (DOIT) (* ; "Edited 6-Mar-2021 13:32 by larry") (* ; "Edited 14-May-2018 15:01 by kaplan") (* ; "Edited 28-Sep-2020 12:35 by rmk:") (* ; "Edited 17-Apr-2018 08:41 by ") (* ; "Edited 21-Apr-2018 07:27 by rmk:") (* ; "Edited 23-Feb-94 15:04 by bvm") (CLRPROMPT) (SETQ MAKESYSFILENAME (CONCAT (MEDLEYDIR "tmp") "full.sysout")) (SETQ MAKESYSNAME (CONCAT "Medley from Interlisp.org of " (DATE))) (DRIBBLE (PACKFILENAME 'EXTENSION "dribble" 'BODY MAKESYSFILENAME)) (* ;; "BKSYSBUF stops page holding ") (PRINTOUT T T "Full loadup started at " (DATE) " while connected to " (DIRECTORYNAME T) T T) (BKSYSBUF " ") (SETQ DEFAULTFILETYPE 'BINARY) (* ;  "These prevent bits from being lost due to lack of knowledge") (DREMOVE (ASSOC NIL DEFAULTFILETYPELIST) DEFAULTFILETYPELIST) (push DEFAULTFILETYPELIST '(TXT . TEXT) '(TEXT . TEXT) '(TEX . TEXT) '(HTML . TEXT) '(HTM . TEXT)) (MEDLEY-INIT-VARS) (SETQ LOADUPDIRECTORIES DIRECTORIES) (LOADUP '(POSTSCRIPTSTREAM)) (* ; " to get PSCFONT.READFONT") (LOADFULLFONTS) (LISTPUT IDLE.PROFILE 'TIMEOUT 0) (SETQQ *DEFAULT-CLEANUP-COMPILER* BCOMPL) (LOADUP '(CHAT PRESS INTERPRESS TEDIT HRULE TEDITCHAT READNUMBER EDITBITMAP FILEBROWSER THINFILES GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT UNICODE ISO8859IO HELPSYS DINFO CLIPBOARD MODERNIZE PRETTYFILEINDEX WHO-LINE UNIXCOMM UNIXCHAT)) (SETQ *WHO-LINE-ANCHOR* '(:CENTER :TOP)) (* ;; "Turn off who-line until after the user has greeted") (CL:WHEN (WINDOWP *WHO-LINE*) (CLOSEW *WHO-LINE*)) [SETQ POSTGREETFORMS (APPEND POSTGREETFORMS '((INSTALL-WHO-LINE-OPTIONS] (LISTPUT IDLE.PROFILE 'TIMEOUT 20) (SETTOPVAL 'INITIALS NIL) (ENDLOADUP) (COND ((WINDOWP LOGOW) (CLOSEW LOGOW))) (DREMOVE (ASSOC 'LOGOW AFTERMAKESYSFORMS) AFTERMAKESYSFORMS) (push AFTERMAKESYSFORMS '(CLRPROMPT) '(MEDLEY-INIT-VARS)) (* ;; "Set up for making the sysout, if we made it this far.") (CL:WHEN DOIT (PRINTOUT T "Creating FULL sysout on " MAKESYSFILENAME T) (BKSYSBUF (CONCAT "(IL:MAKESYS %"" MAKESYSFILENAME "%" %"Medley " " Full Sysout%")" " (IL:LOGOUT T)"))) (DRIBBLE]) (FIXMETA [LAMBDA NIL (* ;  "Edited 25-Jun-2017 17:12 by rmk:") (KEYACTION 'BLANK-TOP '(METADOWN . METAUP) \CURRENTKEYACTION) (KEYACTION 'BLANK-TOP '(METADOWN . METAUP]) ) (FIXMETA) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS MISSINGDISPLAYFONTCOERCIONS MISSINGCHARSETDISPLAYFONTCOERCIONS) ) (DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE DOCOPY (MAKEFULLSYSOUT T) ) (DECLARE%: DONTCOPY (FILEMAP (NIL (814 5714 (LOADFULLFONTS 824 . 2412) (MAKEFULLSYSOUT 2414 . 5403) (FIXMETA 5405 . 5712)) ))) STOP \ No newline at end of file diff --git a/sources/LOADUP-FULL.LCOM b/sources/LOADUP-FULL.LCOM index 524c7113ca622252c7e2fd322b1cb2d5bd756653..22ea0f7c4e6991d0ec837afbe52f676d4a07f8b8 100644 GIT binary patch delta 313 zcmX@2c1dl5udRZau5V(Iu91O}p@N~Ym9dePsj-rRhEj5VZb4>FYKlUBo`RABZ?#LX zcdboEer~E=PGV6}rCnxDW^uvf7)Dt`6HTB3WK#^SOpL6IER__Jic;amBxfY%rKc9F zS}E{Oyr>?CtU*stPe~yqu>@!t7K4lpl{9%Z+&q0;or7E*LtI_Z6hYiKa+-x}_#TJ#1-ZVqs-qir0gT#+!dKuIFPe$t~Et IUSKK{0A>_dy8r+H delta 258 zcmcblc0_H0ubGjBu3Ku7u91O}p@N~Mm5GIwftiwmhEj5VZb4>FYKlUBo`RA>wM(#f ztxZOLZmL~QVo_1$eyh?^92>k{IRt6?k21XP2OH90>Zi6hPr>Cc+z?+g- z0yGhe9%EA_OqL7@Cn3tYftWc7#YNepT wJ9##vstB@$hCsJiSeckkEEJjij!}lua5Fd4dOr4?{KS;fg5u441*S3q0C>|#wg3PC diff --git a/sources/LOADUP-INIT.LISP b/sources/LOADUP-INIT.LISP index 2c54250a..65dfe0a3 100644 --- a/sources/LOADUP-INIT.LISP +++ b/sources/LOADUP-INIT.LISP @@ -1,10 +1,7 @@ -(* "make init files") +(* "make init files; this file is loaded as a 'greet' file by scripts/loadup-init.sh") (CNDIR (MEDLEYDIR "tmp")) (MOVD 'NILL 'PAGEFULLFN) -(LOAD (MEDLEYDIR "sources" "MAKEINITGREET.LCOM")) -(PROGN (DRIBBLE "makeinit.dribble") - (BKSYSBUF " ") - (MAKEINITGREET) - (DRIBBLE) +(LOAD (MEDLEYDIR "sources" "MAKEINIT.LCOM")) +(PROGN (MAKEINITGREET) (LOGOUT T)) diff --git a/sources/LOADUP-LISP b/sources/LOADUP-LISP index 45d29593..d8edfa8a 100644 --- a/sources/LOADUP-LISP +++ b/sources/LOADUP-LISP @@ -1 +1 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP") (FILECREATED "13-Feb-2021 22:31:02" |{DSK}larry>ilisp>medley>sources>LOADUP-LISP.;6| 5987 |changes| |to:| (FNS ENDLOADUP) |previous| |date:| "13-Feb-2021 20:05:39" |{DSK}larry>ilisp>medley>sources>LOADUP-LISP.;4| ) (PRETTYCOMPRINT LOADUP-LISPCOMS) (RPAQQ LOADUP-LISPCOMS ((FNS ENDLOADUP 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) (FUNCTIONS WITHOUT.PAGEHOLD))) (DEFINEQ (ENDLOADUP (LAMBDA NIL (* \; "Edited 13-Feb-2021 19:26 by lmm") (* \; "Edited 11-Oct-90 11:02 by jds") (* |;;|  "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.") (MAPC USERRECLST (FUNCTION (LAMBDA (R) (AND R (RECORDPRIORITY R 'SYSTEM))))) (MEDLEY-INIT-VARS T) (|for| X |in| SYSTEMINITVARS |when| (NOT (ASSOC X MEDLEY-INIT-VARS)) |do| (SETTOPVAL (CAR X) (COPY (CDR X)))) (|for| TYPE |in| FILEPKGTYPES |do| (FILEPKGCHANGES TYPE NIL)) (CLRPROMPT))) (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) (* \; "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 (INFILEP FILENAME) (ERROR "No such medley file" FILENAME))) |else| (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR) DIRNAME)) (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) ) (DEFMACRO WITHOUT.PAGEHOLD (WINDOW &BODY FORMS) `(RESETLST (LET* ((TTYWINDOW ,WINDOW) (ORIGINAL.PAGEFULLFN (WINDOWPROP TTYWINDOW 'PAGEFULLFN)) (NEW.PAGEFULLFN (FUNCTION NILL))) (RESETSAVE (WINDOWPROP TTYWINDOW 'PAGEFULLFN NEW.PAGEFULLFN) (LIST (FUNCTION (LAMBDA (TTYWINDOW NEW.PAGEFULLFN ORIGINAL.PAGEFULLFN) (COND ((EQ (WINDOWPROP TTYWINDOW 'PAGEFULLFN) NEW.PAGEFULLFN) (WINDOWPROP TTYWINDOW 'PAGEFULLFN ORIGINAL.PAGEFULLFN))))) TTYWINDOW NEW.PAGEFULLFN ORIGINAL.PAGEFULLFN))) ,@FORMS)) (DECLARE\: DONTCOPY (FILEMAP (NIL (783 4092 (ENDLOADUP 793 . 1638) (MEDLEY-INIT-VARS 1640 . 2785) (MEDLEYDIR 2787 . 4090)) ))) STOP \ No newline at end of file +(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP") (FILECREATED " 6-Mar-2021 20:47:27" |{DSK}larry>ilisp>medley>sources>LOADUP-LISP.;6| 9575 |changes| |to:| (VARS LOADUP-LISPCOMS) (FNS LOADUP-LISP LOADUP-LISP-SYSOUT) |previous| |date:| " 6-Mar-2021 19:05:04" |{DSK}larry>ilisp>medley>sources>LOADUP-LISP.;3| ) (PRETTYCOMPRINT LOADUP-LISPCOMS) (RPAQQ LOADUP-LISPCOMS ((FNS LOADUP-LISP ENDLOADUP) (DECLARE\: DONTEVAL@LOAD DOCOPY (P (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) (FUNCTIONS WITHOUT.PAGEHOLD))) (DEFINEQ (LOADUP-LISP (LAMBDA NIL (* \; "Edited 6-Mar-2021 20:44 by larry") (SETQQ COMPILE.EXT LCOM) (* \; "should be set earlier") (SETQ SYSFILES (UNION BOOTLOADEDFILES SYSFILES)) (SETQ BOOTLOADEDFILES) (* |;;| "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") (LOADUP '(MOD44IO)) (* |;;| "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)) (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))) (ENDLOADUP (LAMBDA NIL (* \; "Edited 13-Feb-2021 19:26 by lmm") (* \; "Edited 11-Oct-90 11:02 by jds") (* |;;|  "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.") (MAPC USERRECLST (FUNCTION (LAMBDA (R) (AND R (RECORDPRIORITY R 'SYSTEM))))) (MEDLEY-INIT-VARS T) (|for| X |in| SYSTEMINITVARS |when| (NOT (ASSOC X MEDLEY-INIT-VARS)) |do| (SETTOPVAL (CAR X) (COPY (CDR X)))) (|for| TYPE |in| FILEPKGTYPES |do| (FILEPKGCHANGES TYPE NIL)) (CLRPROMPT))) ) (DECLARE\: DONTEVAL@LOAD DOCOPY (LOADUP-LISP) ) (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) (* \; "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 (INFILEP FILENAME) (ERROR "No such medley file" FILENAME))) |else| (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR) DIRNAME)) (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) ) (DEFMACRO WITHOUT.PAGEHOLD (WINDOW &BODY FORMS) `(RESETLST (LET* ((TTYWINDOW ,WINDOW) (ORIGINAL.PAGEFULLFN (WINDOWPROP TTYWINDOW 'PAGEFULLFN)) (NEW.PAGEFULLFN (FUNCTION NILL))) (RESETSAVE (WINDOWPROP TTYWINDOW 'PAGEFULLFN NEW.PAGEFULLFN) (LIST (FUNCTION (LAMBDA (TTYWINDOW NEW.PAGEFULLFN ORIGINAL.PAGEFULLFN) (COND ((EQ (WINDOWPROP TTYWINDOW 'PAGEFULLFN) NEW.PAGEFULLFN) (WINDOWPROP TTYWINDOW 'PAGEFULLFN ORIGINAL.PAGEFULLFN))))) TTYWINDOW NEW.PAGEFULLFN ORIGINAL.PAGEFULLFN))) ,@FORMS)) (DECLARE\: DONTCOPY (FILEMAP (NIL (842 5163 (LOADUP-LISP 852 . 4314) (ENDLOADUP 4316 . 5161)) (5218 7680 (MEDLEY-INIT-VARS 5228 . 6373) (MEDLEYDIR 6375 . 7678))))) STOP \ No newline at end of file diff --git a/sources/LOADUP-LISP.CM b/sources/LOADUP-LISP.CM new file mode 100644 index 0000000000000000000000000000000000000000..c3efbb28deb2bf6e52cc768c34a48eadb09a6a08 GIT binary patch literal 523 zcmaJ-OHRWu5Ow+N$Q`V1uorDqR;W8So+efuJGC7|w}mb$6;U;10f-}T8g|@+^8}}H zM7zO~?a_NPZ)RRUB8AbZBHW0{L;^{)N|+<_Qaix!+|E8IDV4Y%q~Ji^1tJG7VZnu= zG$8T*X&Z0W)pq!}TQ8TJ74?+Vj0Z)0B8iVRJL*WZgW~G>W%sbE;zp?~22$9ft`Qp6 zNG3XOdSuLS0~Q>mk*c}(2$rUkj5o1 zh0p{2fc8Vf{giy{Z|YwteP*Sz?4~KH!K<0wxtV8Xo>}QH`fc?4>{B`pvwP3Ns2>d| z>Q6=|lVSh$cj=A&!Rh2EnhcL$|M5kg8X>D9OtmX${rKsc4zh~}PcB{&B`=>mA@}O} z<;xdz-Rt4u;Q_55+jtWdNf2XL7b&76Sfp~hN+2=6mPXn#s+c= z&f_#h04r)XL5{)HF60uJDMFq>sWZ5XkZ2&?f~v&ve=O28rcCICnd)+yV&Ef?C725< zV^ge93(i%`R9Vuo$(NK^r81RQc)NHp8&IMxvcS{mw$;Ae{_;+-EK2s*c1I7q-zzlj;l&WAa(!~5IaLuclC8x^7?^wJvprf>smLgritv|k- zAlWM=Gg2oje_||WnYhwc$QQPmcCj`rwQXY&b!ZJ*jJ%l`n~BoLSNWN?CPzQK51uG* z0l{xD8+pSbV}1fa#jga^3s*@nLt`BH4I5+e8q&EUkRPvBbl)v12jrNx!YY)RnUdUxAEuVhUCwkbqA_>j3EXgT6C_ix~1)819B*7YWCek~62F+i=K>?W1+i%NW50UxPZS(cs koz0JXU+(U2e%(tp;oj#T(EjGny>D(`vwri{?bU~W16P-fhX4Qo delta 298 zcmeA%`KK_!UBu8>*DWFFsc)TAVqq^1BBAj=p*3^G#Eu# MMXWb(6A5Dl0GVx2`Tzg` diff --git a/sources/MAIKOINIT b/sources/MAIKOINIT index a57ccc94..a9767e22 100755 --- a/sources/MAIKOINIT +++ b/sources/MAIKOINIT @@ -1,7 +1,5 @@ (RPAQQ SI::*CLOSURE-CACHE-ENABLED* NIL) -(QUOTE (\\TEDIT.BLTCHAR \\MAIKO.PUNTBLTCHAR SI::*CLOSURE-CACHE* XCL::*DELETED-IMPLICIT-HASH-SLOT* )) - -(PUTPROPS MAIKOINIT COPYRIGHT ("Venue" 1990)) +(QUOTE ( SI::*CLOSURE-CACHE* XCL::*DELETED-IMPLICIT-HASH-SLOT* )) STOP diff --git a/sources/MAKEINIT b/sources/MAKEINIT index bbef8e56..44430dae 100644 --- a/sources/MAKEINIT +++ b/sources/MAKEINIT @@ -1,4 +1,4 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED " 7-Feb-2021 18:08:30" {DSK}larry>ilisp>medley>sources>MAKEINIT.;6 25695 changes to%: (FILES MEM) (FNS MAKEINIT LOADMKIFILES) (VARS MAKEINITCOMS) previous date%: " 7-Feb-2021 17:49:57" {DSK}larry>ilisp>medley>sources>MAKEINIT.;5) (* ; " Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1998, 2021 by Venue & Xerox Corporation. ") (PRETTYCOMPRINT MAKEINITCOMS) (RPAQQ MAKEINITCOMS ((FNS LOADMAKEINIT LOADMKIFILES RELOAD MAKEINIT MKI.START) (COMS (* ;  "reading compiled files and processing well-known expressions") (FNS MKI.PASSFILE SCRATCHARRAY DOFORM CONSTFORMP NOTICECOMS EVALFORMAKEINIT) (FNS I.ADDTOVAR I.DECLARE%: I.DEFINE-FILE-INFO I.FILECREATED I.PUTPROPS I.RPAQ I.RPAQQ I.RPAQ? I.SETTOPVAL I.NOUNDO) (PROP MKI ADDTOVAR DECLARE%: DEFINE-FILE-INFO FILECREATED PUTPROPS RPAQ RPAQ? RPAQQ LISPXPRINT PRETTYCOMPRINT * SETTOPVAL SETQQ SETQ /SETTOPVAL)) (FNS I.ATOMNUMBER I.\ATOMCELL I.FIXUPNUM I.FIXUPPTR I.FIXUPSYM I.WORDSPERNAMEENTRY I.SETSTKNTOFFSET) (COMS (* ; "stuff for MAXC") (FNS MKI.ATOM MKI.IEEE)) [COMS (* ;  "stuff to maintain symbol values, prop lists during makeinit--all dumped at end.") (FNS MKI.DSET MKI.ADDTO MKI.PUTPROP) (VARS (MKI.ARRAY) (MKI.TVHA (HASHARRAY 400)) (MKI.PLHA (HASHARRAY 150)) (MKI.ATOMARRAY (HASHARRAY 5000)) (INIT.EXT 'SYSOUT] (COMS (FNS DUMPVP BOUTZEROS BIN16 BOUT16) (VARS (MKI.FirstDataByte 1024) (MKI.Page0Byte 512) (MKI.DATE (DATE)) MKI.CODESTARTOFFSET MKI.SEQUENTIAL PRINTEXPRS)) (INITVARS (PRINTEXPRS T) (REMOTECOMPILE.EXT COMPILE.EXT)) [DECLARE%: DONTEVAL@LOAD DOCOPY (P (PUTPROP (NAMEFIELD (INPUT) T) 'LOADDATE (GETFILEINFO (INPUT) 'ICREATIONDATE] (DECLARE%: EVAL@COMPILE (PROP MACRO SETXVAR IEQ) DONTCOPY (FILES (LOADCOMP) MEM)))) (DEFINEQ (LOADMAKEINIT (LAMBDA (LARGEFLG) (* lmm "31-JUL-81 14:27") (SELECTQ (SYSTEMTYPE) ((D ALTO)) (PROGN (ADDTOVAR DIRECTORIES BLISP) (GCGAG 1000) (COND ((NOT LARGEFLG) (SETSEPR (QUOTE (%| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)) 1 FILERDTBL) (MINFS 45000 (QUOTE ARRAYP)) (MINFS 10000 (QUOTE FIXP)) (MINFS 3000 (QUOTE STRING.CHARS)) (MINFS 2000 (QUOTE ATOM.CHARS)))) (MOVD? (QUOTE NILL) (QUOTE MKNUMATOM)) (* ;; "This is a kludge to get around the problem that, while MKATOM is in LLNEW, MKNUMATOM is not, and MKATOM calls MKNUMATOM when given an atom beginning with a digit. It turns out that MKNUMATOM will always return NIL in the cases called from MAKEINIT because MAKEINIT is merely copying things which it knows are really LITATOM and spelled like it.") (MOVD? (QUOTE *) (QUOTE BLOCKRECORD)) (PUTDQ? FIXSPELL1 (LAMBDA (OLD NEW) (PRINT (LIST OLD (QUOTE ->) NEW) T T))))) (LOADMKIFILES) (SELECTQ (SYSTEMTYPE) ((D ALTO)) (PROGN (MINFS 10000 (QUOTE ALTOPOINTER)) (* ; "doesn't work until after datatype declaration has been loaded") (RECLAIM (QUOTE ARRAYP)) (RECLAIM (QUOTE ATOM.CHARS)) (MINFS 10000 (QUOTE ARRAYP)) (MINFS 5000 (QUOTE LISTP)) (SYSOUT (QUOTE MKI.SAV))))) ) (LOADMKIFILES [LAMBDA NIL (* ; "Edited 7-Feb-2021 17:39 by lmm") (* mjs "13-Mar-84 14:41") (for X in MAKEINITFILES do (RELOAD (PACKFILENAME 'BODY X 'EXTENSION COMPILE.EXT]) (RELOAD (LAMBDA (FILE) (* lmm "13-APR-81 21:16") (PROG (DATE FULLFILENAME) RETRY (COND ((ILESSP (OR (GETPROP FILE (QUOTE LOADDATE)) MIN.INTEGER) (SETQ DATE (GETFILEINFO (SETQ FULLFILENAME (OR (FINDFILE FILE T) (GO NOTFOUND))) (QUOTE ICREATIONDATE)))) (LOAD FULLFILENAME T) (PUTPROP FILE (QUOTE LOADDATE) DATE))) (RETURN T) NOTFOUND (COND ((GETP (NAMEFIELD FILE) (QUOTE FILEDATES)) (PRINT (CONS FILE (QUOTE (already loaded))) T) (RETURN))) (ERROR FILE "not found.") (GO RETRY))) ) (MAKEINIT [LAMBDA (VERSIONS TOFILE TYPE LOADUPDIRS FONTDIRS) (* ; "Edited 7-Feb-2021 17:46 by lmm") (* ; "Edited 19-Jul-90 17:26 by jds") (LOADMKIFILES) (PROG ([TYPELST (OR (LISTP TYPE) (OR (CDR (ASSOC TYPE MAKEINITTYPES)) (ERROR TYPE '?] FILES SIZEGUESS AFTERINITFILESET EXPRESSIONS) (* ;; "TYPELST is a list of the form (type file-list after-init-files init-size-guess)") (SETQ FILES (CADR TYPELST)) (SETQ AFTERINITFILESET (CADDR TYPELST)) (SETQ SIZEGUESS (CADDDR TYPELST)) (RESETLST [RESETSAVE (OUTPUT (SETQ TOFILE (OPENSTREAM (PACKFILENAME.STRING 'BODY (OR TOFILE (CAR TYPELST) 'XXX) 'EXTENSION INIT.EXT) 'OUTPUT 'NEW 8] (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (FL) (AND (OPENP FL) (CLOSEF FL)) (AND RESETSTATE (DELFILE (FULLNAME FL] TOFILE)) (PROG ((OUTX TOFILE)) (SETQ DIRECTORIES LOADUPDIRS) (MKI.START) (for X in FILES do (MKI.PASSFILE X)) (* ;; "Generally loads the files in 0LISPSET and 1LISPSET, with 2LISPSET getting loaded immediately after the init starts.") (AND LOADUPDIRS (MKI.DSET 'LOADUPDIRECTORIES LOADUPDIRS)) (AND FONTDIRS (MKI.DSET 'DISPLAYFONTDIRECTORIES FONTDIRS)) [COND (AFTERINITFILESET (* ; "Load stuff that has to be loaded before we can call LOADUP. Ugly expression here is because FILESLOAD is on MACHINEINDEPENDENT.") [MKI.ADDTO 'MAKEINIT.EXPRESSIONS `((MAPC ',(EVAL AFTERINITFILESET) (FUNCTION (LAMBDA (FILE) (OR [SOME LOADUPDIRECTORIES (FUNCTION (LAMBDA (DIR FL) (COND ((SETQ FL (INFILEP (PACKFILENAME.STRING 'DIRECTORY DIR 'NAME FILE 'EXTENSION COMPILE.EXT))) (LOAD FL 'SYSLOAD) T] (PRINT (CONS FILE '(not found)) T] (MKI.ADDTO 'BOOTFILES '(MAKEINIT.EXPRESSIONS] (I.MAKEINITLAST VERSIONS))) (RETURN (FULLNAME TOFILE]) (MKI.START (LAMBDA NIL (* bvm%: "12-Dec-84 15:23") (SETQ RESETPTR) (SETQ RESETPC) (BOUTZEROS MKI.FirstDataByte) (CLRHASH MKI.TVHA) (CLRHASH MKI.PLHA) (CLRHASH MKI.ATOMARRAY) (RESETMEMORY) (SETQ MKI.VALUES (for X in INITVALUES bind Y collect (SET (SETQ Y (PACK* "I." (SUBSTRING (CAR X) 2 -1))) (EVAL (CADR X))) Y)) (SETQ MKI.PTRS (for X in INITPTRS bind Y collect (SET (SETQ Y (PACK* "I." (SUBSTRING (CAR X) 2 -1))) (CADR X)) Y)) (I.MAKEINITFIRST) (MKI.DSET NIL NIL) (MKI.DSET T T) (MKI.DSET (QUOTE MAKEINITDATES) (LIST MKI.DATE (DATE))) (for X in INITCONSTANTS when (NEQ (CAR X) (QUOTE *)) do (I.FSETVAL (CAR X) (COND ((LISTP (CADR X)) (I.VAG2 (CAADR X) (CADR (CADR X)))) (T (I.\COPY (CADR X))))))) ) ) (* ; "reading compiled files and processing well-known expressions") (DEFINEQ (MKI.PASSFILE (LAMBDA (FILESET) (* ; "Edited 30-Mar-87 17:17 by bvm:") (* ;;; "Read a DCOM file and load its contents into the INIT.") (* ;;; "FILESET can be one of a number, which is a LISPSET number, or a list of file names, or a file name") (COND ((NUMBERP FILESET) (* ; "We were given a nLISPSET number. Pack it up to get the list of files") (MKI.PASSFILE (EVALV (PACK* FILESET (QUOTE LISPSET))))) ((LISTP FILESET) (* ; "We were given a list of file names") (MAPC FILESET (FUNCTION MKI.PASSFILE))) (T (* ; "It's a file name. Read it in.") (INPUT (SETQ FILESET (OPENSTREAM (OR (FINDFILE (PACKFILENAME.STRING (QUOTE BODY) FILESET (QUOTE EXTENSION) REMOTECOMPILE.EXT) T) FILESET) (QUOTE INPUT) (QUOTE OLD) 8 MKI.SEQUENTIAL))) (MKI.ADDTO (QUOTE LOADEDFILELST) (LIST (SETQ FILESET (FULLNAME FILESET)))) (PRINT FILESET T T) (LET* ((FILEROOT (NAMEFIELD FILESET)) (COMSNAMES (LIST (PACK* FILEROOT (QUOTE COMS)))) SKIPVARS MEXPRS X) (DECLARE (SPECVARS COMSNAMES SKIPVARS MEXPRS)) (* ; " used by I.RPAQQ and DOFORM") (* ;;; "Loop here reading from the dcom file into the init.") (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT* (until (SELECTQ (SETQ X (READ)) ((STOP NIL) (* ; "End of file") T) NIL) do (COND ((NLISTP X) (* ;; "Start of a code object. Skip the code indicator (assume it says to read with DCODERD) and read the code") (IF (NOT (LITATOM (READ))) THEN (ERROR "Bad compiled function" X)) (I.DCODERD X)) (T (* ; "It's a form. go either do it now or add it to the forms to execute inside the init.") (DOFORM X))) finally (COND ((CAR MEXPRS) (* ; "There are expressions to be executed in the INIT when it comes up. Save them.") (MKI.ADDTO (SETQ FILESET (PACK* FILEROOT ".EXPRESSIONS")) (CAR MEXPRS)) (MKI.ADDTO (QUOTE BOOTFILES) (LIST FILESET)))))) (CLOSEF (INPUT)))))) ) (SCRATCHARRAY (LAMBDA (NBYTES ALIGN) (* ; "Edited 30-Mar-87 16:20 by bvm:") (COND ((OR (NULL MKI.ARRAY) (IGREATERP NBYTES (ARRAYSIZE MKI.ARRAY))) (* ;; "make sure the scratch array is big enough. Note that the scratch array is unboxed, not code, since we aren't going to be storing legitimate local code in it (let's not fool the garbage collector too much).") (SETQ MKI.ARRAY (create ARRAYP TYP _ \ST.BYTE BASE _ (\ALLOCBLOCK (FOLDHI NBYTES BYTESPERCELL) UNBOXEDBLOCK.GCT 0 CELLSPERQUAD) LENGTH _ NBYTES ORIG _ 0)))) (for I from 0 to (SUB1 (UNFOLD ALIGN BYTESPERCELL)) do (\BYTESETA MKI.ARRAY I 0)) (* ; "clear the fnheader area") MKI.ARRAY) ) (DOFORM (LAMBDA (X NOPROP) (* bvm%: "30-Aug-86 15:36") (* ;;; "Handle a raw form found in a dcom file that's going into a makeinit.") (LET ((FN (GETPROP (CAR X) (QUOTE MKI)))) (if (AND FN (NOT NOPROP)) then (* ; "it's a local command that can be run `renamed' . Execute it in the local context.") (* ASSERT%: (CALLS I.ADDTOVAR I.DECLARE%: I.DEFINE-FILE-INFO I.DEFLIST I.FILECREATED I.PRETTYDEFMACROS I.PUTPROPS I.RPAQ I.RPAQQ I.SETHASHQ)) (APPLY* FN X) else (* ;; "it's a command that has to be done remotely, since we don't know how to do it from here. Add it to the collection of init expressions.") (COND (PRINTEXPRS (PRINT X T T))) (SETQ MEXPRS (TCONC MEXPRS X))))) ) (CONSTFORMP (LAMBDA (X) (* lmm " 7-MAR-80 08:54") (COND ((LISTP X) (SELECTQ (CAR X) ((QUOTE FUNCTION) X) NIL)) ((LITATOM X) (SELECTQ X (NIL (QUOTE (QUOTE NIL))) (T T) (AND (SETQ X (GETHASH X MKI.TVHA)) (KWOTE (CDR X))))) (T X))) ) (NOTICECOMS (LAMBDA (VAL) (* lmm "10-Mar-85 14:51") (for X in VAL when (LISTP X) do (COND ((AND (EQ (CADR X) (QUOTE *)) (LITATOM (CADDR X))) (COND ((EQ (CAR X) (QUOTE COMS)) (push COMSNAMES (CADDR X))) (T (push SKIPVARS (CADDR X))))) (T (SELECTQ (CAR X) ((COMS DECLARE%:) (NOTICECOMS (CDR X))) NIL))))) ) (EVALFORMAKEINIT (LAMBDA (FORM) (* bvm%: " 2-NOV-83 15:22") (COND ((LISTP FORM) (SELECTQ (CAR FORM) (MKATOM (COND ((STRINGP (CADR FORM)) (MKATOM (CADR FORM))) (T (HELP)))) (HELP))) ((FIXP FORM) FORM) (T (HELP)))) ) ) (DEFINEQ (I.ADDTOVAR (LAMBDA (FORM) (* lmm " 2-DEC-81 23:58") (MKI.ADDTO (CADR FORM) (CDDR FORM)))) (I.DECLARE%: (LAMBDA (FORM) (* lmm "18-FEB-80 14:04") (PROG ((L FORM) (FLAG T) X FN) LP (COND ((NULL (SETQ L (CDR L))) (RETURN)) ((NLISTP (SETQ X (CAR L))) (SELECTQ X ((EVAL@LOAD DOEVAL@LOAD) (SETQ FLAG T)) (DONTEVAL@LOAD (SETQ FLAG NIL)) NIL)) (T (DOFORM X))) (GO LP))) ) (I.DEFINE-FILE-INFO (LAMBDA (FORM) (* bvm%: "30-Aug-86 15:32") (* ;;; "Set reader environment for reading rest of file") (SET-READER-ENVIRONMENT (\DO-DEFINE-FILE-INFO NIL (CDR FORM)))) ) (I.FILECREATED (LAMBDA (X) (* ; "Edited 12-Jan-88 11:00 by bvm") (* ;; "Form is (FILECREATED date filename . otherstuff)") (COND ((NLISTP (CADDR X)) (* ; "FILENAME a list is for the %"compiled on%" expression") (LET ((NAME (NAMEFIELD (CADDR X)))) (MKI.ADDTO (QUOTE BOOTLOADEDFILES) (LIST NAME)) (MKI.PUTPROP NAME (QUOTE FILEDATES) (LIST (CONS (CADR X) (CADDR X)))))))) ) (I.PUTPROPS (LAMBDA (FORM) (* lpd%: "29-APR-77 13:22") (MKI.PUTPROP (CADR FORM) (CADDR FORM) (CADDDR FORM)))) (I.RPAQ (LAMBDA (FORM) (* edited%: "10-Jul-84 14:05") (PROG ((VAL (CADDR FORM)) V) (COND ((SETQ V (CONSTFORMP VAL)) (MKI.DSET (CADR FORM) (EVAL V))) (T (DOFORM (LIST (QUOTE SETTOPVAL) (KWOTE (CADR FORM)) VAL) T))))) ) (I.RPAQQ (LAMBDA (FORM) (* lmm "30-APR-80 22:12") (PROG ((ATM (CADR FORM)) (VAL (CADDR FORM))) (COND ((FMEMB ATM COMSNAMES) (NOTICECOMS VAL)) ((FMEMB ATM SKIPVARS)) (T (MKI.DSET ATM VAL))))) ) (I.RPAQ? (LAMBDA (FORM) (* lmm " 7-MAR-80 08:36") (PROG ((VAL (CADDR FORM)) V) (COND ((SETQ V (CONSTFORMP VAL)) (MKI.DSET (CADR FORM) (EVAL V))) (T (DOFORM (LIST (QUOTE SETTOPVAL) (KWOTE (CADR FORM)) VAL)))))) ) (I.SETTOPVAL (LAMBDA (FORM) (* edited%: "10-Jul-84 14:07") (PROG (V) (if (AND (EQ (CAR (LISTP (CADR FORM))) (QUOTE QUOTE)) (SETQ V (CONSTFORMP (CADDR FORM)))) then (MKI.DSET (CADR (CADR FORM)) (EVAL V)) else (DOFORM FORM T)))) ) (I.NOUNDO (LAMBDA (FORM) (* edited%: "10-Jul-84 14:02") (if (EQ (NTHCHAR (CAR FORM) 1) (QUOTE /)) then (DOFORM (CONS (SUBATOM (CAR FORM) 2 -1) (CDR FORM))) else (SHOULDNT))) ) ) (PUTPROPS ADDTOVAR MKI I.ADDTOVAR) (PUTPROPS DECLARE%: MKI I.DECLARE%:) (PUTPROPS DEFINE-FILE-INFO MKI I.DEFINE-FILE-INFO) (PUTPROPS FILECREATED MKI I.FILECREATED) (PUTPROPS PUTPROPS MKI I.PUTPROPS) (PUTPROPS RPAQ MKI I.RPAQ) (PUTPROPS RPAQ? MKI I.RPAQ?) (PUTPROPS RPAQQ MKI I.RPAQQ) (PUTPROPS LISPXPRINT MKI NILL) (PUTPROPS PRETTYCOMPRINT MKI NILL) (PUTPROPS * MKI NILL) (PUTPROPS SETTOPVAL MKI I.SETTOPVAL) (PUTPROPS SETQQ MKI I.RPAQQ) (PUTPROPS SETQ MKI I.RPAQ) (PUTPROPS /SETTOPVAL MKI I.NOUNDO) (DEFINEQ (I.ATOMNUMBER [LAMBDA (A) (* ;  "Edited 27-Oct-92 14:10 by sybalsky:mv:envos") (* ;; "Given a symbol, return the symbol's atom #, in the INIT being made.") (* ;; "NB that this will work only so long as there are no NEW-SYMBOLs in the INIT, because of the LOLOC.") (I.LOLOC (COND ((LITATOM A) (MKI.ATOM A)) (T A]) (I.\ATOMCELL +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED " 6-Mar-2021 11:41:32" {DSK}larry>ilisp>medley>sources>MAKEINIT.;5 53134 changes to%: (VARS MAKEINITCOMS) (FNS DLFIXINIT DLSORTSYSOUTPAGES DLNEXTFP DLLOCKEDPAGEP DLSETLOCKBIT DLCOPYPAGEMAP DLCOPYVMPAGE DLADDPAGEMAPENTRIES ASSIGNFILEPAGE ASSIGNFILEPAGERANGE DLDUMPSYSOUT DLDUMPFPTOVP DLDUMPPAGEMAPS DLDUMPVMEMPAGES DLSETBOOTPTR DLDUMPARRAY DLMARKASDUMPED DLDUMPVMEMPAGE INSTALLDOMINO INSTALLDOMINO.DIRECT INSTALLNEWDOMINO DLPRINTFPTOVP PRINTPRIMARYMAP DLREADPAGEOFWORDS SETDIF BIN16 BOUT16 MAKEINITGREET) previous date%: " 7-Feb-2021 18:08:30" {DSK}larry>ilisp>medley>sources>MAKEINIT.;1) (* ; " Copyright (c) 1982-1988, 1990-1992, 1998, 2021 by Venue & Xerox Corporation. ") (PRETTYCOMPRINT MAKEINITCOMS) (RPAQQ MAKEINITCOMS ((COMS (* ;;; "From MAKEINITGREET") (FNS MAKEINITGREET) (FILES (SOURCE) FILESETS) (FILES (LOADCOMP) LLARITH LLFLOAT) (FILES RENAMEFNS XCL-PACKAGE CMLARRAY-SUPPORT VMEM)) (COMS (* ;; "From original MAKEINIT") (FNS LOADMAKEINIT LOADMKIFILES RELOAD MAKEINIT MKI.START) (COMS (* ;  "reading compiled files and processing well-known expressions") (FNS MKI.PASSFILE SCRATCHARRAY DOFORM CONSTFORMP NOTICECOMS EVALFORMAKEINIT) (FNS I.ADDTOVAR I.DECLARE%: I.DEFINE-FILE-INFO I.FILECREATED I.PUTPROPS I.RPAQ I.RPAQQ I.RPAQ? I.SETTOPVAL I.NOUNDO) (PROP MKI ADDTOVAR DECLARE%: DEFINE-FILE-INFO FILECREATED PUTPROPS RPAQ RPAQ? RPAQQ LISPXPRINT PRETTYCOMPRINT * SETTOPVAL SETQQ SETQ /SETTOPVAL)) (FNS I.ATOMNUMBER I.\ATOMCELL I.FIXUPNUM I.FIXUPPTR I.FIXUPSYM I.WORDSPERNAMEENTRY I.SETSTKNTOFFSET) (COMS (* ; "stuff for MAXC") (FNS MKI.ATOM MKI.IEEE)) [COMS (* ;  "stuff to maintain symbol values, prop lists during makeinit--all dumped at end.") (FNS MKI.DSET MKI.ADDTO MKI.PUTPROP) (VARS (MKI.ARRAY) (MKI.TVHA (HASHARRAY 400)) (MKI.PLHA (HASHARRAY 150)) (MKI.ATOMARRAY (HASHARRAY 5000)) (INIT.EXT 'SYSOUT] (COMS (FNS DUMPVP BOUTZEROS BIN16 BOUT16) (VARS (MKI.FirstDataByte 1024) (MKI.Page0Byte 512) (MKI.DATE (DATE)) MKI.CODESTARTOFFSET MKI.SEQUENTIAL PRINTEXPRS)) (INITVARS (PRINTEXPRS T) (REMOTECOMPILE.EXT COMPILE.EXT)) (DECLARE%: EVAL@COMPILE (PROP MACRO SETXVAR IEQ) DONTCOPY (FILES (LOADCOMP) MEM))) (COMS (* ;; "from DLFIXINIT") (* ;; " This file is all because the dandelion needed its microcode embedded in the init file, and MAIKO wasn't around. So this is all to make room for microcode we don't need. Except something(?) might expect the %"InterfacePage%" as page 2 of the file, so we're leaving it in place now") (FNS DLFIXINIT DLSORTSYSOUTPAGES DLNEXTFP DLLOCKEDPAGEP DLSETLOCKBIT DLCOPYPAGEMAP DLCOPYVMPAGE DLADDPAGEMAPENTRIES ASSIGNFILEPAGE ASSIGNFILEPAGERANGE DLDUMPSYSOUT DLDUMPFPTOVP DLDUMPPAGEMAPS DLDUMPVMEMPAGES DLSETBOOTPTR DLDUMPARRAY DLMARKASDUMPED DLDUMPVMEMPAGE INSTALLDOMINO INSTALLDOMINO.DIRECT INSTALLNEWDOMINO) (FILES READSYS) (FNS DLPRINTFPTOVP PRINTPRIMARYMAP DLREADPAGEOFWORDS SETDIF) (CONSTANTS \NO.PAGE.ASSIGNED) (GLOBALVARS DLPRIMARYMAP DLSECONDARYMAP DLLOCKBITS DLLASTDOMINOPAGE DLIFPAGE DLNEXTPM DLPAGEMAPFP FPTOVP NEWFPFROMOLD VMEMFILE VMEMFILEX)))) (* ;;; "From MAKEINITGREET") (DEFINEQ (MAKEINITGREET [LAMBDA NIL (* ; "Edited 4-Mar-2021 20:02 by larry") (* ; "Edited 5-Dec-2017 15:26 by rmk:") (* ;; "") (* ;; " Updated Lisp version for big physical memory --bvm |11/3/87") (* ;; "") (* Versions are Lisp Microcode Bcpl) (DRIBBLE (MEDLEYDIR "tmp" "init.dribble" T)) (DORENAME 'I) (DORENAME 'R) (DLFIXINIT (MAKEINIT '(39424 5682 11008) (MEDLEYDIR "tmp" "init.sysout" T) NIL DIRECTORIES DISPLAYFONTDIRECTORIES) (MEDLEYDIR "tmp" "init.dlinit" T)) (DRIBBLE]) ) (FILESLOAD (SOURCE) FILESETS) (FILESLOAD (LOADCOMP) LLARITH LLFLOAT) (FILESLOAD RENAMEFNS XCL-PACKAGE CMLARRAY-SUPPORT VMEM) (* ;; "From original MAKEINIT") (DEFINEQ (LOADMAKEINIT (LAMBDA (LARGEFLG) (* lmm "31-JUL-81 14:27") (SELECTQ (SYSTEMTYPE) ((D ALTO)) (PROGN (ADDTOVAR DIRECTORIES BLISP) (GCGAG 1000) (COND ((NOT LARGEFLG) (SETSEPR (QUOTE (%| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)) 1 FILERDTBL) (MINFS 45000 (QUOTE ARRAYP)) (MINFS 10000 (QUOTE FIXP)) (MINFS 3000 (QUOTE STRING.CHARS)) (MINFS 2000 (QUOTE ATOM.CHARS)))) (MOVD? (QUOTE NILL) (QUOTE MKNUMATOM)) (* ;; "This is a kludge to get around the problem that, while MKATOM is in LLNEW, MKNUMATOM is not, and MKATOM calls MKNUMATOM when given an atom beginning with a digit. It turns out that MKNUMATOM will always return NIL in the cases called from MAKEINIT because MAKEINIT is merely copying things which it knows are really LITATOM and spelled like it.") (MOVD? (QUOTE *) (QUOTE BLOCKRECORD)) (PUTDQ? FIXSPELL1 (LAMBDA (OLD NEW) (PRINT (LIST OLD (QUOTE ->) NEW) T T))))) (LOADMKIFILES) (SELECTQ (SYSTEMTYPE) ((D ALTO)) (PROGN (MINFS 10000 (QUOTE ALTOPOINTER)) (* ; "doesn't work until after datatype declaration has been loaded") (RECLAIM (QUOTE ARRAYP)) (RECLAIM (QUOTE ATOM.CHARS)) (MINFS 10000 (QUOTE ARRAYP)) (MINFS 5000 (QUOTE LISTP)) (SYSOUT (QUOTE MKI.SAV))))) ) (LOADMKIFILES [LAMBDA NIL (* ; "Edited 7-Feb-2021 17:39 by lmm") (* mjs "13-Mar-84 14:41") (for X in MAKEINITFILES do (RELOAD (PACKFILENAME 'BODY X 'EXTENSION COMPILE.EXT]) (RELOAD (LAMBDA (FILE) (* lmm "13-APR-81 21:16") (PROG (DATE FULLFILENAME) RETRY (COND ((ILESSP (OR (GETPROP FILE (QUOTE LOADDATE)) MIN.INTEGER) (SETQ DATE (GETFILEINFO (SETQ FULLFILENAME (OR (FINDFILE FILE T) (GO NOTFOUND))) (QUOTE ICREATIONDATE)))) (LOAD FULLFILENAME T) (PUTPROP FILE (QUOTE LOADDATE) DATE))) (RETURN T) NOTFOUND (COND ((GETP (NAMEFIELD FILE) (QUOTE FILEDATES)) (PRINT (CONS FILE (QUOTE (already loaded))) T) (RETURN))) (ERROR FILE "not found.") (GO RETRY))) ) (MAKEINIT [LAMBDA (VERSIONS TOFILE TYPE LOADUPDIRS FONTDIRS) (* ; "Edited 7-Feb-2021 17:46 by lmm") (* ; "Edited 19-Jul-90 17:26 by jds") (LOADMKIFILES) (PROG ([TYPELST (OR (LISTP TYPE) (OR (CDR (ASSOC TYPE MAKEINITTYPES)) (ERROR TYPE '?] FILES SIZEGUESS AFTERINITFILESET EXPRESSIONS) (* ;; "TYPELST is a list of the form (type file-list after-init-files init-size-guess)") (SETQ FILES (CADR TYPELST)) (SETQ AFTERINITFILESET (CADDR TYPELST)) (SETQ SIZEGUESS (CADDDR TYPELST)) (RESETLST [RESETSAVE (OUTPUT (SETQ TOFILE (OPENSTREAM (PACKFILENAME.STRING 'BODY (OR TOFILE (CAR TYPELST) 'XXX) 'EXTENSION INIT.EXT) 'OUTPUT 'NEW 8] (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (FL) (AND (OPENP FL) (CLOSEF FL)) (AND RESETSTATE (DELFILE (FULLNAME FL] TOFILE)) (PROG ((OUTX TOFILE)) (SETQ DIRECTORIES LOADUPDIRS) (MKI.START) (for X in FILES do (MKI.PASSFILE X)) (* ;; "Generally loads the files in 0LISPSET and 1LISPSET, with 2LISPSET getting loaded immediately after the init starts.") (AND LOADUPDIRS (MKI.DSET 'LOADUPDIRECTORIES LOADUPDIRS)) (AND FONTDIRS (MKI.DSET 'DISPLAYFONTDIRECTORIES FONTDIRS)) [COND (AFTERINITFILESET (* ; "Load stuff that has to be loaded before we can call LOADUP. Ugly expression here is because FILESLOAD is on MACHINEINDEPENDENT.") [MKI.ADDTO 'MAKEINIT.EXPRESSIONS `((MAPC ',(EVAL AFTERINITFILESET) (FUNCTION (LAMBDA (FILE) (OR [SOME LOADUPDIRECTORIES (FUNCTION (LAMBDA (DIR FL) (COND ((SETQ FL (INFILEP (PACKFILENAME.STRING 'DIRECTORY DIR 'NAME FILE 'EXTENSION COMPILE.EXT))) (LOAD FL 'SYSLOAD) T] (PRINT (CONS FILE '(not found)) T] (MKI.ADDTO 'BOOTFILES '(MAKEINIT.EXPRESSIONS] (I.MAKEINITLAST VERSIONS))) (RETURN (FULLNAME TOFILE]) (MKI.START (LAMBDA NIL (* bvm%: "12-Dec-84 15:23") (SETQ RESETPTR) (SETQ RESETPC) (BOUTZEROS MKI.FirstDataByte) (CLRHASH MKI.TVHA) (CLRHASH MKI.PLHA) (CLRHASH MKI.ATOMARRAY) (RESETMEMORY) (SETQ MKI.VALUES (for X in INITVALUES bind Y collect (SET (SETQ Y (PACK* "I." (SUBSTRING (CAR X) 2 -1))) (EVAL (CADR X))) Y)) (SETQ MKI.PTRS (for X in INITPTRS bind Y collect (SET (SETQ Y (PACK* "I." (SUBSTRING (CAR X) 2 -1))) (CADR X)) Y)) (I.MAKEINITFIRST) (MKI.DSET NIL NIL) (MKI.DSET T T) (MKI.DSET (QUOTE MAKEINITDATES) (LIST MKI.DATE (DATE))) (for X in INITCONSTANTS when (NEQ (CAR X) (QUOTE *)) do (I.FSETVAL (CAR X) (COND ((LISTP (CADR X)) (I.VAG2 (CAADR X) (CADR (CADR X)))) (T (I.\COPY (CADR X))))))) ) ) (* ; "reading compiled files and processing well-known expressions") (DEFINEQ (MKI.PASSFILE (LAMBDA (FILESET) (* ; "Edited 30-Mar-87 17:17 by bvm:") (* ;;; "Read a DCOM file and load its contents into the INIT.") (* ;;; "FILESET can be one of a number, which is a LISPSET number, or a list of file names, or a file name") (COND ((NUMBERP FILESET) (* ; "We were given a nLISPSET number. Pack it up to get the list of files") (MKI.PASSFILE (EVALV (PACK* FILESET (QUOTE LISPSET))))) ((LISTP FILESET) (* ; "We were given a list of file names") (MAPC FILESET (FUNCTION MKI.PASSFILE))) (T (* ; "It's a file name. Read it in.") (INPUT (SETQ FILESET (OPENSTREAM (OR (FINDFILE (PACKFILENAME.STRING (QUOTE BODY) FILESET (QUOTE EXTENSION) REMOTECOMPILE.EXT) T) FILESET) (QUOTE INPUT) (QUOTE OLD) 8 MKI.SEQUENTIAL))) (MKI.ADDTO (QUOTE LOADEDFILELST) (LIST (SETQ FILESET (FULLNAME FILESET)))) (PRINT FILESET T T) (LET* ((FILEROOT (NAMEFIELD FILESET)) (COMSNAMES (LIST (PACK* FILEROOT (QUOTE COMS)))) SKIPVARS MEXPRS X) (DECLARE (SPECVARS COMSNAMES SKIPVARS MEXPRS)) (* ; " used by I.RPAQQ and DOFORM") (* ;;; "Loop here reading from the dcom file into the init.") (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT* (until (SELECTQ (SETQ X (READ)) ((STOP NIL) (* ; "End of file") T) NIL) do (COND ((NLISTP X) (* ;; "Start of a code object. Skip the code indicator (assume it says to read with DCODERD) and read the code") (IF (NOT (LITATOM (READ))) THEN (ERROR "Bad compiled function" X)) (I.DCODERD X)) (T (* ; "It's a form. go either do it now or add it to the forms to execute inside the init.") (DOFORM X))) finally (COND ((CAR MEXPRS) (* ; "There are expressions to be executed in the INIT when it comes up. Save them.") (MKI.ADDTO (SETQ FILESET (PACK* FILEROOT ".EXPRESSIONS")) (CAR MEXPRS)) (MKI.ADDTO (QUOTE BOOTFILES) (LIST FILESET)))))) (CLOSEF (INPUT)))))) ) (SCRATCHARRAY (LAMBDA (NBYTES ALIGN) (* ; "Edited 30-Mar-87 16:20 by bvm:") (COND ((OR (NULL MKI.ARRAY) (IGREATERP NBYTES (ARRAYSIZE MKI.ARRAY))) (* ;; "make sure the scratch array is big enough. Note that the scratch array is unboxed, not code, since we aren't going to be storing legitimate local code in it (let's not fool the garbage collector too much).") (SETQ MKI.ARRAY (create ARRAYP TYP _ \ST.BYTE BASE _ (\ALLOCBLOCK (FOLDHI NBYTES BYTESPERCELL) UNBOXEDBLOCK.GCT 0 CELLSPERQUAD) LENGTH _ NBYTES ORIG _ 0)))) (for I from 0 to (SUB1 (UNFOLD ALIGN BYTESPERCELL)) do (\BYTESETA MKI.ARRAY I 0)) (* ; "clear the fnheader area") MKI.ARRAY) ) (DOFORM (LAMBDA (X NOPROP) (* bvm%: "30-Aug-86 15:36") (* ;;; "Handle a raw form found in a dcom file that's going into a makeinit.") (LET ((FN (GETPROP (CAR X) (QUOTE MKI)))) (if (AND FN (NOT NOPROP)) then (* ; "it's a local command that can be run `renamed' . Execute it in the local context.") (* ASSERT%: (CALLS I.ADDTOVAR I.DECLARE%: I.DEFINE-FILE-INFO I.DEFLIST I.FILECREATED I.PRETTYDEFMACROS I.PUTPROPS I.RPAQ I.RPAQQ I.SETHASHQ)) (APPLY* FN X) else (* ;; "it's a command that has to be done remotely, since we don't know how to do it from here. Add it to the collection of init expressions.") (COND (PRINTEXPRS (PRINT X T T))) (SETQ MEXPRS (TCONC MEXPRS X))))) ) (CONSTFORMP (LAMBDA (X) (* lmm " 7-MAR-80 08:54") (COND ((LISTP X) (SELECTQ (CAR X) ((QUOTE FUNCTION) X) NIL)) ((LITATOM X) (SELECTQ X (NIL (QUOTE (QUOTE NIL))) (T T) (AND (SETQ X (GETHASH X MKI.TVHA)) (KWOTE (CDR X))))) (T X))) ) (NOTICECOMS (LAMBDA (VAL) (* lmm "10-Mar-85 14:51") (for X in VAL when (LISTP X) do (COND ((AND (EQ (CADR X) (QUOTE *)) (LITATOM (CADDR X))) (COND ((EQ (CAR X) (QUOTE COMS)) (push COMSNAMES (CADDR X))) (T (push SKIPVARS (CADDR X))))) (T (SELECTQ (CAR X) ((COMS DECLARE%:) (NOTICECOMS (CDR X))) NIL))))) ) (EVALFORMAKEINIT (LAMBDA (FORM) (* bvm%: " 2-NOV-83 15:22") (COND ((LISTP FORM) (SELECTQ (CAR FORM) (MKATOM (COND ((STRINGP (CADR FORM)) (MKATOM (CADR FORM))) (T (HELP)))) (HELP))) ((FIXP FORM) FORM) (T (HELP)))) ) ) (DEFINEQ (I.ADDTOVAR (LAMBDA (FORM) (* lmm " 2-DEC-81 23:58") (MKI.ADDTO (CADR FORM) (CDDR FORM)))) (I.DECLARE%: (LAMBDA (FORM) (* lmm "18-FEB-80 14:04") (PROG ((L FORM) (FLAG T) X FN) LP (COND ((NULL (SETQ L (CDR L))) (RETURN)) ((NLISTP (SETQ X (CAR L))) (SELECTQ X ((EVAL@LOAD DOEVAL@LOAD) (SETQ FLAG T)) (DONTEVAL@LOAD (SETQ FLAG NIL)) NIL)) (T (DOFORM X))) (GO LP))) ) (I.DEFINE-FILE-INFO (LAMBDA (FORM) (* bvm%: "30-Aug-86 15:32") (* ;;; "Set reader environment for reading rest of file") (SET-READER-ENVIRONMENT (\DO-DEFINE-FILE-INFO NIL (CDR FORM)))) ) (I.FILECREATED (LAMBDA (X) (* ; "Edited 12-Jan-88 11:00 by bvm") (* ;; "Form is (FILECREATED date filename . otherstuff)") (COND ((NLISTP (CADDR X)) (* ; "FILENAME a list is for the %"compiled on%" expression") (LET ((NAME (NAMEFIELD (CADDR X)))) (MKI.ADDTO (QUOTE BOOTLOADEDFILES) (LIST NAME)) (MKI.PUTPROP NAME (QUOTE FILEDATES) (LIST (CONS (CADR X) (CADDR X)))))))) ) (I.PUTPROPS (LAMBDA (FORM) (* lpd%: "29-APR-77 13:22") (MKI.PUTPROP (CADR FORM) (CADDR FORM) (CADDDR FORM)))) (I.RPAQ (LAMBDA (FORM) (* edited%: "10-Jul-84 14:05") (PROG ((VAL (CADDR FORM)) V) (COND ((SETQ V (CONSTFORMP VAL)) (MKI.DSET (CADR FORM) (EVAL V))) (T (DOFORM (LIST (QUOTE SETTOPVAL) (KWOTE (CADR FORM)) VAL) T))))) ) (I.RPAQQ (LAMBDA (FORM) (* lmm "30-APR-80 22:12") (PROG ((ATM (CADR FORM)) (VAL (CADDR FORM))) (COND ((FMEMB ATM COMSNAMES) (NOTICECOMS VAL)) ((FMEMB ATM SKIPVARS)) (T (MKI.DSET ATM VAL))))) ) (I.RPAQ? (LAMBDA (FORM) (* lmm " 7-MAR-80 08:36") (PROG ((VAL (CADDR FORM)) V) (COND ((SETQ V (CONSTFORMP VAL)) (MKI.DSET (CADR FORM) (EVAL V))) (T (DOFORM (LIST (QUOTE SETTOPVAL) (KWOTE (CADR FORM)) VAL)))))) ) (I.SETTOPVAL (LAMBDA (FORM) (* edited%: "10-Jul-84 14:07") (PROG (V) (if (AND (EQ (CAR (LISTP (CADR FORM))) (QUOTE QUOTE)) (SETQ V (CONSTFORMP (CADDR FORM)))) then (MKI.DSET (CADR (CADR FORM)) (EVAL V)) else (DOFORM FORM T)))) ) (I.NOUNDO (LAMBDA (FORM) (* edited%: "10-Jul-84 14:02") (if (EQ (NTHCHAR (CAR FORM) 1) (QUOTE /)) then (DOFORM (CONS (SUBATOM (CAR FORM) 2 -1) (CDR FORM))) else (SHOULDNT))) ) ) (PUTPROPS ADDTOVAR MKI I.ADDTOVAR) (PUTPROPS DECLARE%: MKI I.DECLARE%:) (PUTPROPS DEFINE-FILE-INFO MKI I.DEFINE-FILE-INFO) (PUTPROPS FILECREATED MKI I.FILECREATED) (PUTPROPS PUTPROPS MKI I.PUTPROPS) (PUTPROPS RPAQ MKI I.RPAQ) (PUTPROPS RPAQ? MKI I.RPAQ?) (PUTPROPS RPAQQ MKI I.RPAQQ) (PUTPROPS LISPXPRINT MKI NILL) (PUTPROPS PRETTYCOMPRINT MKI NILL) (PUTPROPS * MKI NILL) (PUTPROPS SETTOPVAL MKI I.SETTOPVAL) (PUTPROPS SETQQ MKI I.RPAQQ) (PUTPROPS SETQ MKI I.RPAQ) (PUTPROPS /SETTOPVAL MKI I.NOUNDO) (DEFINEQ (I.ATOMNUMBER [LAMBDA (A) (* ;  "Edited 27-Oct-92 14:10 by sybalsky:mv:envos") (* ;; "Given a symbol, return the symbol's atom #, in the INIT being made.") (* ;; "NB that this will work only so long as there are no NEW-SYMBOLs in the INIT, because of the LOLOC.") (I.LOLOC (COND ((LITATOM A) (MKI.ATOM A)) (T A]) (I.\ATOMCELL [LAMBDA (X N) (* ;  "Edited 26-Oct-92 14:24 by sybalsky:mv:envos") (LET ((ATOMNO (I.ATOMNUMBER X))) @@ -36,4 +36,4 @@ (2 6) (8 0) (SHOULDNT] - (I.ADDBASE ATOMNO OFFSET]) (I.FIXUPNUM [LAMBDA (CA BN NUM MASK) (* ; "Edited 17-Jul-90 14:28 by jds") (* ;; "ÿ2ÿPerform atom-number fixup for a code block.") (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) (* ;; "If it's on a machine wiht 3 byte atom numbers, treat it as a pointer.") (I.FIXUPPTR CA BN NUM)) (T (* ;; "Otherwise, fill in the two bytes.") (\BYTESETA CA (SUB1 BN) (LOGOR (LOGAND (\BYTELT CA (SUB1 BN)) (LRSH (LOGXOR MASK 65535) 8)) (LOGAND (LRSH (LOGAND NUM MASK) 8) 255))) (\BYTESETA CA BN (LOGAND NUM 255]) (I.FIXUPPTR [LAMBDA (CA BN PTR) (* ; "Edited 22-Jul-90 12:10 by jds") (* ;; "Specific for MAXC --- actual ptr is same as simulated ptr") (PROG ((LOLOC (I.LOLOC PTR))) (\BYTESETA CA (SUB1 BN) (LRSH LOLOC 8)) (\BYTESETA CA BN (LOGAND LOLOC 255)) (\BYTESETA CA (IDIFFERENCE BN 2) (LOGOR (\BYTELT CA (IDIFFERENCE BN 2)) (I.HILOC PTR]) (I.FIXUPSYM [LAMBDA (CA BN NUM MASK) (* ; "Edited 23-Jan-91 19:04 by jds") (* ;; "ÿ2ÿPerform SYMBOL fixup for a code block.") (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) (* ;; "If it's on a machine wiht 3 byte atom numbers, treat it as a pointer.") (I.FIXUPPTR CA BN (I.ATOMNUMBER NUM))) (T (* ;; "Otherwise, fill in the two bytes.") (\BYTESETA CA (SUB1 BN) (LOGOR (LOGAND (\BYTELT CA (SUB1 BN)) (LRSH (LOGXOR MASK 65535) 8)) (LOGAND (LRSH (LOGAND (I.ATOMNUMBER NUM) MASK) 8) 255))) (\BYTESETA CA BN (LOGAND (I.ATOMNUMBER NUM) 255]) (I.WORDSPERNAMEENTRY [LAMBDA NIL (* ; "Edited 25-Jan-91 15:35 by jds") (* ;; "For MAKEINIT, returns the number of words in a name-table entry.") (* ;; "For the old 2-byte atom case, it's 1 word; for 3-byte atoms, 2 words.") (* ;; "An %"Entry%" means an entry in each half of the name table (symbol & type/offset).") (* ;; "While we're building the INIT, react to either :3-BYTE or :3-BYTE-INIT in the target architecture -- we're automatically CROSSCOMPILING as far as this function is concerned.") (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) 2) ((FMEMB :3-BYTE-INIT COMPILER::*TARGET-ARCHITECTURE*) 2) (T 1]) (I.SETSTKNTOFFSET [LAMBDA (BASE OFFSET TYPE VAL) (* ; "Edited 25-Jan-91 16:00 by jds") (* ;; "FOR MAKEINIT: Set the offset entry for a name-table entry, from the symbol to fill in plus the variable-type marker value SHIFTED LEFT 14 BITS ALREADY.") (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) (I.FIXUPNUM BASE (IDIFFERENCE OFFSET BYTESPERWORD) TYPE) (I.FIXUPNUM BASE OFFSET VAL)) ((FMEMB :3-BYTE-INIT COMPILER::*TARGET-ARCHITECTURE*) (I.FIXUPNUM BASE (IDIFFERENCE OFFSET BYTESPERWORD) TYPE) (I.FIXUPNUM BASE OFFSET VAL)) (T (I.FIXUPNUM BASE OFFSET (IPLUS TYPE VAL]) ) (* ; "stuff for MAXC") (DEFINEQ (MKI.ATOM (LAMBDA (X) (* lmm "29-JUL-81 22:46") (* ; "for MAXC") (AND X (OR (GETHASH X MKI.ATOMARRAY) (PUTHASH X (COND ((EQ X (QUOTE NOBIND)) PTRNOBIND) (T (I.COPYATOM X))) MKI.ATOMARRAY)))) ) (MKI.IEEE (LAMBDA (X BOX) (* bvm%: "16-Dec-80 00:44") (* ;; "Converts pdp-10 floating-point number X to IEEE standard for Dolphin, storing (with I.PUTBASE) into BOX. For MAXC only.") (PROG (MAGNITUDE (SIGN 0) (EXP 0) (FRAC 0)) RETRY (SETQ MAGNITUDE (COND ((MINUSP X) (SETQ SIGN 32768) (IMINUS (OPENR (LOC X)))) (T (OPENR (LOC X))))) (COND ((ZEROP MAGNITUDE) (GO DONE)) ((IEQP (LOGAND MAGNITUDE 67108864) 0) (* ; "unnormalized number???") (SETQ X (FPLUS X 0.0)) (GO RETRY))) (COND ((ILEQ (SETQ EXP (IDIFFERENCE (LRSH MAGNITUDE 27) 2)) 0) (* ;; "Exponent bias is off by 1, plus another 1 because of the implicit high bit. Thus have to watch for underflow") (ERROR "Unrepresentable floating-point number" X) (SETQ EXP (SETQ SIGN 0)) (* ; "If continued, make it zero") (GO DONE))) (SETQ FRAC (IPLUS (LOGAND (LRSH MAGNITUDE 3) 16777215) (COND ((OR (ILESSP (LOGAND MAGNITUDE 7) 4) (EQ (LOGAND MAGNITUDE 15) 4)) (* ; "Round down") 0) (T 1)))) (COND ((IGREATERP FRAC 16777215) (* ; "Rounding overflowed the high bit") (SETQ FRAC (LRSH FRAC 1)) (* ; "EXP can't overflow, because of bias difference") (SETQ EXP (ADD1 EXP)))) (* ; "FRAC is now a 24-bit fraction with its high bit on") DONE (I.PUTBASE BOX 0 (LOGOR SIGN (LLSH EXP 7) (LOGAND (LRSH FRAC 16) 127))) (I.PUTBASE BOX 1 (LOGAND FRAC 65535)))) ) ) (* ; "stuff to maintain symbol values, prop lists during makeinit--all dumped at end.") (DEFINEQ (MKI.DSET (LAMBDA (A VAL) (* ; "Edited 12-Jan-88 11:03 by bvm") (LET ((LST (GETHASH A MKI.TVHA))) (COND (LST (COND ((NOT (EQUAL VAL (CDR LST))) (EXEC-FORMAT "(Value of ~S changed from ~S to ~S)~%%" A (CDR LST) VAL))) (RPLACD LST VAL)) (T (PUTHASH A (CONS NIL VAL) MKI.TVHA))))) ) (MKI.ADDTO (LAMBDA (A VAL) (* lpd%: "29-APR-77 13:20") (PROG ((LST (GETHASH A MKI.TVHA))) (COND (LST (RPLACD LST (UNION VAL (CDR LST)))) (T (PUTHASH A (CONS NIL VAL) MKI.TVHA))))) ) (MKI.PUTPROP (LAMBDA (A PROP VAL) (* ; "Edited 12-Jan-88 11:04 by bvm") (LET ((LST (GETHASH A MKI.PLHA))) (COND (LST (COND ((LISTGET LST PROP) (EXEC-FORMAT "(Property ~S of ~S has been changed)~%%" A PROP))) (LISTPUT LST PROP VAL)) (T (PUTHASH A (LIST PROP VAL) MKI.PLHA))))) ) ) (RPAQQ MKI.ARRAY NIL) (RPAQ MKI.TVHA (HASHARRAY 400)) (RPAQ MKI.PLHA (HASHARRAY 150)) (RPAQ MKI.ATOMARRAY (HASHARRAY 5000)) (RPAQQ INIT.EXT SYSOUT) (DEFINEQ (DUMPVP (LAMBDA (VP) (* lpd%: "27-APR-77 20:24") (PRIN1 (QUOTE *) T) (WriteoutPage OUTX VP))) (BOUTZEROS (LAMBDA (N) (* lmm "16-MAY-81 16:49") (FRPTQ N (\BOUT OUTX 0)))) (BIN16 (LAMBDA (J) (* lmm "16-MAY-81 16:49") (IPLUS (LLSH (\BIN J) 8) (\BIN J)))) (BOUT16 (LAMBDA (J N) (* lmm "16-MAY-81 16:51") (\BOUT J (LRSH N 8)) (\BOUT J (LOGAND N 255)))) ) (RPAQQ MKI.FirstDataByte 1024) (RPAQQ MKI.Page0Byte 512) (RPAQ MKI.DATE (DATE)) (RPAQQ MKI.CODESTARTOFFSET 60) (RPAQQ MKI.SEQUENTIAL ((SEQUENTIAL T))) (RPAQQ PRINTEXPRS T) (RPAQ? PRINTEXPRS T) (RPAQ? REMOTECOMPILE.EXT COMPILE.EXT) (DECLARE%: DONTEVAL@LOAD DOCOPY (PUTPROP (NAMEFIELD (INPUT) T) 'LOADDATE (GETFILEINFO (INPUT) 'ICREATIONDATE)) ) (DECLARE%: EVAL@COMPILE (PUTPROPS SETXVAR MACRO [X `(SETQ.NOREF %, (CADAR X) %, (CADR X]) (PUTPROPS IEQ MACRO ((X Y) (IEQP X Y))) DONTCOPY (FILESLOAD (LOADCOMP) MEM) ) (PUTPROPS MAKEINIT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991 1992 1998 2021)) (DECLARE%: DONTCOPY (FILEMAP (NIL (2735 9120 (LOADMAKEINIT 2745 . 3948) (LOADMKIFILES 3950 . 4265) (RELOAD 4267 . 4750) ( MAKEINIT 4752 . 8412) (MKI.START 8414 . 9118)) (9198 13099 (MKI.PASSFILE 9208 . 11001) (SCRATCHARRAY 11003 . 11652) (DOFORM 11654 . 12331) (CONSTFORMP 12333 . 12567) (NOTICECOMS 12569 . 12877) ( EVALFORMAKEINIT 12879 . 13097)) (13100 15220 (I.ADDTOVAR 13110 . 13204) (I.DECLARE%: 13206 . 13482) ( I.DEFINE-FILE-INFO 13484 . 13674) (I.FILECREATED 13676 . 14050) (I.PUTPROPS 14052 . 14165) (I.RPAQ 14167 . 14388) (I.RPAQQ 14390 . 14586) (I.RPAQ? 14588 . 14803) (I.SETTOPVAL 14805 . 15037) (I.NOUNDO 15039 . 15218)) (15856 21856 (I.ATOMNUMBER 15866 . 16357) (I.\ATOMCELL 16359 . 18112) (I.FIXUPNUM 18114 . 18931) (I.FIXUPPTR 18933 . 19414) (I.FIXUPSYM 19416 . 20364) (I.WORDSPERNAMEENTRY 20366 . 21121) (I.SETSTKNTOFFSET 21123 . 21854)) (21888 23396 (MKI.ATOM 21898 . 22094) (MKI.IEEE 22096 . 23394 )) (23493 24258 (MKI.DSET 23503 . 23786) (MKI.ADDTO 23788 . 23973) (MKI.PUTPROP 23975 . 24256)) (24432 24810 (DUMPVP 24442 . 24539) (BOUTZEROS 24541 . 24620) (BIN16 24622 . 24707) (BOUT16 24709 . 24808))) )) STOP \ No newline at end of file + (I.ADDBASE ATOMNO OFFSET]) (I.FIXUPNUM [LAMBDA (CA BN NUM MASK) (* ; "Edited 17-Jul-90 14:28 by jds") (* ;; "ÿ2ÿPerform atom-number fixup for a code block.") (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) (* ;; "If it's on a machine wiht 3 byte atom numbers, treat it as a pointer.") (I.FIXUPPTR CA BN NUM)) (T (* ;; "Otherwise, fill in the two bytes.") (\BYTESETA CA (SUB1 BN) (LOGOR (LOGAND (\BYTELT CA (SUB1 BN)) (LRSH (LOGXOR MASK 65535) 8)) (LOGAND (LRSH (LOGAND NUM MASK) 8) 255))) (\BYTESETA CA BN (LOGAND NUM 255]) (I.FIXUPPTR [LAMBDA (CA BN PTR) (* ; "Edited 22-Jul-90 12:10 by jds") (* ;; "Specific for MAXC --- actual ptr is same as simulated ptr") (PROG ((LOLOC (I.LOLOC PTR))) (\BYTESETA CA (SUB1 BN) (LRSH LOLOC 8)) (\BYTESETA CA BN (LOGAND LOLOC 255)) (\BYTESETA CA (IDIFFERENCE BN 2) (LOGOR (\BYTELT CA (IDIFFERENCE BN 2)) (I.HILOC PTR]) (I.FIXUPSYM [LAMBDA (CA BN NUM MASK) (* ; "Edited 23-Jan-91 19:04 by jds") (* ;; "ÿ2ÿPerform SYMBOL fixup for a code block.") (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) (* ;; "If it's on a machine wiht 3 byte atom numbers, treat it as a pointer.") (I.FIXUPPTR CA BN (I.ATOMNUMBER NUM))) (T (* ;; "Otherwise, fill in the two bytes.") (\BYTESETA CA (SUB1 BN) (LOGOR (LOGAND (\BYTELT CA (SUB1 BN)) (LRSH (LOGXOR MASK 65535) 8)) (LOGAND (LRSH (LOGAND (I.ATOMNUMBER NUM) MASK) 8) 255))) (\BYTESETA CA BN (LOGAND (I.ATOMNUMBER NUM) 255]) (I.WORDSPERNAMEENTRY [LAMBDA NIL (* ; "Edited 25-Jan-91 15:35 by jds") (* ;; "For MAKEINIT, returns the number of words in a name-table entry.") (* ;; "For the old 2-byte atom case, it's 1 word; for 3-byte atoms, 2 words.") (* ;; "An %"Entry%" means an entry in each half of the name table (symbol & type/offset).") (* ;; "While we're building the INIT, react to either :3-BYTE or :3-BYTE-INIT in the target architecture -- we're automatically CROSSCOMPILING as far as this function is concerned.") (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) 2) ((FMEMB :3-BYTE-INIT COMPILER::*TARGET-ARCHITECTURE*) 2) (T 1]) (I.SETSTKNTOFFSET [LAMBDA (BASE OFFSET TYPE VAL) (* ; "Edited 25-Jan-91 16:00 by jds") (* ;; "FOR MAKEINIT: Set the offset entry for a name-table entry, from the symbol to fill in plus the variable-type marker value SHIFTED LEFT 14 BITS ALREADY.") (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) (I.FIXUPNUM BASE (IDIFFERENCE OFFSET BYTESPERWORD) TYPE) (I.FIXUPNUM BASE OFFSET VAL)) ((FMEMB :3-BYTE-INIT COMPILER::*TARGET-ARCHITECTURE*) (I.FIXUPNUM BASE (IDIFFERENCE OFFSET BYTESPERWORD) TYPE) (I.FIXUPNUM BASE OFFSET VAL)) (T (I.FIXUPNUM BASE OFFSET (IPLUS TYPE VAL]) ) (* ; "stuff for MAXC") (DEFINEQ (MKI.ATOM (LAMBDA (X) (* lmm "29-JUL-81 22:46") (* ; "for MAXC") (AND X (OR (GETHASH X MKI.ATOMARRAY) (PUTHASH X (COND ((EQ X (QUOTE NOBIND)) PTRNOBIND) (T (I.COPYATOM X))) MKI.ATOMARRAY)))) ) (MKI.IEEE (LAMBDA (X BOX) (* bvm%: "16-Dec-80 00:44") (* ;; "Converts pdp-10 floating-point number X to IEEE standard for Dolphin, storing (with I.PUTBASE) into BOX. For MAXC only.") (PROG (MAGNITUDE (SIGN 0) (EXP 0) (FRAC 0)) RETRY (SETQ MAGNITUDE (COND ((MINUSP X) (SETQ SIGN 32768) (IMINUS (OPENR (LOC X)))) (T (OPENR (LOC X))))) (COND ((ZEROP MAGNITUDE) (GO DONE)) ((IEQP (LOGAND MAGNITUDE 67108864) 0) (* ; "unnormalized number???") (SETQ X (FPLUS X 0.0)) (GO RETRY))) (COND ((ILEQ (SETQ EXP (IDIFFERENCE (LRSH MAGNITUDE 27) 2)) 0) (* ;; "Exponent bias is off by 1, plus another 1 because of the implicit high bit. Thus have to watch for underflow") (ERROR "Unrepresentable floating-point number" X) (SETQ EXP (SETQ SIGN 0)) (* ; "If continued, make it zero") (GO DONE))) (SETQ FRAC (IPLUS (LOGAND (LRSH MAGNITUDE 3) 16777215) (COND ((OR (ILESSP (LOGAND MAGNITUDE 7) 4) (EQ (LOGAND MAGNITUDE 15) 4)) (* ; "Round down") 0) (T 1)))) (COND ((IGREATERP FRAC 16777215) (* ; "Rounding overflowed the high bit") (SETQ FRAC (LRSH FRAC 1)) (* ; "EXP can't overflow, because of bias difference") (SETQ EXP (ADD1 EXP)))) (* ; "FRAC is now a 24-bit fraction with its high bit on") DONE (I.PUTBASE BOX 0 (LOGOR SIGN (LLSH EXP 7) (LOGAND (LRSH FRAC 16) 127))) (I.PUTBASE BOX 1 (LOGAND FRAC 65535)))) ) ) (* ; "stuff to maintain symbol values, prop lists during makeinit--all dumped at end.") (DEFINEQ (MKI.DSET (LAMBDA (A VAL) (* ; "Edited 12-Jan-88 11:03 by bvm") (LET ((LST (GETHASH A MKI.TVHA))) (COND (LST (COND ((NOT (EQUAL VAL (CDR LST))) (EXEC-FORMAT "(Value of ~S changed from ~S to ~S)~%%" A (CDR LST) VAL))) (RPLACD LST VAL)) (T (PUTHASH A (CONS NIL VAL) MKI.TVHA))))) ) (MKI.ADDTO (LAMBDA (A VAL) (* lpd%: "29-APR-77 13:20") (PROG ((LST (GETHASH A MKI.TVHA))) (COND (LST (RPLACD LST (UNION VAL (CDR LST)))) (T (PUTHASH A (CONS NIL VAL) MKI.TVHA))))) ) (MKI.PUTPROP (LAMBDA (A PROP VAL) (* ; "Edited 12-Jan-88 11:04 by bvm") (LET ((LST (GETHASH A MKI.PLHA))) (COND (LST (COND ((LISTGET LST PROP) (EXEC-FORMAT "(Property ~S of ~S has been changed)~%%" A PROP))) (LISTPUT LST PROP VAL)) (T (PUTHASH A (LIST PROP VAL) MKI.PLHA))))) ) ) (RPAQQ MKI.ARRAY NIL) (RPAQ MKI.TVHA (HASHARRAY 400)) (RPAQ MKI.PLHA (HASHARRAY 150)) (RPAQ MKI.ATOMARRAY (HASHARRAY 5000)) (RPAQQ INIT.EXT SYSOUT) (DEFINEQ (DUMPVP (LAMBDA (VP) (* lpd%: "27-APR-77 20:24") (PRIN1 (QUOTE *) T) (WriteoutPage OUTX VP))) (BOUTZEROS (LAMBDA (N) (* lmm "16-MAY-81 16:49") (FRPTQ N (\BOUT OUTX 0)))) (BIN16 [LAMBDA (STREAM) (* edited%: " 2-Apr-85 17:11") (LOGOR (LLSH (BIN STREAM) 8) (BIN STREAM]) (BOUT16 [LAMBDA (STREAM N) (* edited%: " 2-Apr-85 17:11") (BOUT STREAM (LRSH N 8)) (BOUT STREAM (LOGAND N 255)) N]) ) (RPAQQ MKI.FirstDataByte 1024) (RPAQQ MKI.Page0Byte 512) (RPAQ MKI.DATE (DATE)) (RPAQQ MKI.CODESTARTOFFSET 60) (RPAQQ MKI.SEQUENTIAL ((SEQUENTIAL T))) (RPAQQ PRINTEXPRS T) (RPAQ? PRINTEXPRS T) (RPAQ? REMOTECOMPILE.EXT COMPILE.EXT) (DECLARE%: EVAL@COMPILE (PUTPROPS SETXVAR MACRO [X `(SETQ.NOREF %, (CADAR X) %, (CADR X]) (PUTPROPS IEQ MACRO ((X Y) (IEQP X Y))) DONTCOPY (FILESLOAD (LOADCOMP) MEM) ) (* ;; "from DLFIXINIT") (* ;; " This file is all because the dandelion needed its microcode embedded in the init file, and MAIKO wasn't around. So this is all to make room for microcode we don't need. Except something(?) might expect the %"InterfacePage%" as page 2 of the file, so we're leaving it in place now" ) (DEFINEQ (DLFIXINIT [LAMBDA (SYSOUTFILE DLBOOTFILE) (* ; "Edited 7-Feb-2021 13:49 by lmm") (* ;  "Edited 2-Nov-92 08:16 by sybalsky:mv:envos") (PROG ((DBPAGES 3) (%#UCODEPAGES 3) (%#ADDEDFILEPAGES 0) %#OLDFILEPAGES %#NEWFILEPAGES %#FPTOVPPAGES DLFILEX) (DECLARE (SPECVARS %#UCODEPAGES NEWFPFROMOLD DBPAGES %#NEWFILEPAGES %#OLDFILEPAGES %#ADDEDFILEPAGES %#FPTOVPPAGES DLFILEX)) (READSYS SYSOUTFILE) (SETQ %#OLDFILEPAGES (FOLDHI (GETFILEINFO VMEMFILE 'LENGTH) BYTESPERPAGE)) (DLCOPYPAGEMAP) (SETQ NEWFPFROMOLD (ARRAY %#OLDFILEPAGES 'WORD \NO.PAGE.ASSIGNED 1)) (DLSORTSYSOUTPAGES) (DLDUMPSYSOUT) (READSYS) (RETURN DLBOOTFILE]) (DLSORTSYSOUTPAGES [LAMBDA NIL (* ;  "Edited 4-Nov-92 15:47 by sybalsky:mv:envos") (DECLARE (USEDFREE FPSIZE NEWFPFROMOLD FPTOVPSIZE FPTOVP PGTAB %#FPTOVPPAGES) (SPECVARS LASTFP)) (PROG (LASTFP) (ASSIGNFILEPAGE \FP.IFPAGE \VP.IFPAGE (SUB1 \FP.IFPAGE) T) (* ;  "SUB1 because old FP's are zero-based! See VMEM structures") (ASSIGNFILEPAGERANGE \VP.DISPLAY \NP.DISPLAY (DLFPFROMRP \RP.TEMPDISPLAY)) (ASSIGNFILEPAGERANGE \VP.STACK PAGESPERSEGMENT (DLFPFROMRP \RP.STACK) T) (ASSIGNFILEPAGERANGE \VP.TYPETABLE \NP.TYPETABLE (DLFPFROMRP \RP.TYPETABLE)) (ASSIGNFILEPAGERANGE \VP.GCTABLE \NP.GCTABLE (DLFPFROMRP \RP.GCTABLE)) (ASSIGNFILEPAGERANGE \VP.GCOVERFLOW \NP.GCOVERFLOW (DLFPFROMRP \RP.GCOVERFLOW)) (ASSIGNFILEPAGERANGE \VP.FPTOVP %#FPTOVPPAGES (DLFPFROMRP \RP.FPTOVP)) (replace (IFPAGE FPTOVPStart) of DLIFPAGE with (DLFPFROMRP \RP.FPTOVP)) (replace (IFPAGE LastDominoFilePage) of DLIFPAGE with (SETQ DLLASTDOMINOPAGE %#UCODEPAGES)) [SETQ LASTFP (SUB1 (SETQ DLPAGEMAPFP (DLFPFROMRP \RP.MISCLOCKED] (* ;; "Assign next the pagemap pages, since we have to know where they live (some are new) and it is very convenient for them to be contiguous") (for J from 0 to (SUB1 \NumPMTpages) do (ASSIGNFILEPAGE (DLNEXTFP) (IPLUS J \VP.PRIMARYMAP) NIL T)) (replace (IFPAGE filePnPMT0) of DLIFPAGE with DLPAGEMAPFP) (replace (IFPAGE filePnPMP0) of DLIFPAGE with (IPLUS DLPAGEMAPFP \NumPMTpages)) (* ;; "NO LONGER -- 5,,0 TAKEN FOR FPTOVP IN MEDLEY 2.1 -- but we need the decondary page table up thru building things, so assign it:") (for J from 0 to (SUB1 (FOLDHI DLNEXTPM WORDSPERPAGE)) do (ASSIGNFILEPAGE (DLNEXTFP) (IPLUS J \VP.SECONDARYMAP) NIL T)) (* ;; "Similarly, assign locked page table, which is another structure we rewrite") (for J from 0 to (SUB1 \NumLPTPages) do (ASSIGNFILEPAGE (DLNEXTFP) (IPLUS J \VP.LPT) NIL T)) (* ;; "Finally, assign file pages for everyone we haven't taken care of yet. First the locked pages, which have to be at the front of the sysout, after the fixed assignments we have already made") [for IFLOCKED in '(T NIL) do (for VPSEG from 0 to \MAXVMSEGMENT bind PGTAB2 when (NEQ (SETQ PGTAB2 (FASTELT PGTAB VPSEG)) PGEMPTY) do (for I from 0 to (SUB1 PAGESPERSEGMENT) bind (VPBASE _ (UNFOLD VPSEG PAGESPERSEGMENT)) OLDFP when (AND [NOT (ZEROP (SETQ OLDFP (FASTELTN PGTAB2 I ] (EQ (DLLOCKEDPAGEP (IPLUS VPBASE I)) IFLOCKED) (EQ (FASTELTN NEWFPFROMOLD OLDFP) \NO.PAGE.ASSIGNED)) do (ASSIGNFILEPAGE (DLNEXTFP) (IPLUS VPBASE I) OLDFP IFLOCKED))) (COND (IFLOCKED (replace (IFPAGE LastLockedFilePage) of DLIFPAGE with LASTFP) (SETQ LASTFP DLLASTDOMINOPAGE] (replace (IFPAGE NDirtyPages) of DLIFPAGE with (replace (IFPAGE NActivePages ) of DLIFPAGE with %#NEWFILEPAGES ]) (DLNEXTFP [LAMBDA NIL (* ;  "Edited 2-Nov-92 12:29 by sybalsky:mv:envos") (do (add LASTFP 1) repeatuntil (EQ (FASTELTN FPTOVP (LLSH LASTFP 1)) \NO.VMEM.PAGE)) LASTFP]) (DLLOCKEDPAGEP [LAMBDA (VP) (* bvm%: " 6-Dec-84 22:25") (NEQ 0 (LOGAND (.LOCKEDVPMASK. VP) (FASTELTN DLLOCKBITS (FOLDLO VP BITSPERWORD]) (DLSETLOCKBIT [LAMBDA (VP) (* bvm%: " 6-Dec-84 22:26") (FASTSETAN DLLOCKBITS (FOLDLO VP BITSPERWORD) (LOGOR (.LOCKEDVPMASK. VP) (FASTELTN DLLOCKBITS (FOLDLO VP BITSPERWORD]) (DLCOPYPAGEMAP [LAMBDA NIL (* ;  "Edited 3-Nov-92 15:46 by sybalsky:mv:envos") (PROG NIL [SETQ DLIFPAGE (DLCOPYVMPAGE \VP.IFPAGE (NCREATE 'VMEMPAGEP] (* ; "Install interface page by magic") (SETQ DLPRIMARYMAP (ARRAY (UNFOLD \NumPMTpages WORDSPERPAGE) 'WORD 0 0)) (* ; "Primary map table") [for J from 0 to (SUB1 \NumPMTpages) do (DLCOPYVMPAGE (IPLUS J \VP.PRIMARYMAP) (\ADDBASE (fetch (ARRAYP BASE) of DLPRIMARYMAP) (UNFOLD J WORDSPERPAGE] (SETQ DLNEXTPM (fetch (IFPAGE NxtPMAddr) of DLIFPAGE)) (* ;  "First free offset in secondary map") (DLADDPAGEMAPENTRIES \VP.FPTOVP \NP.FPTOVP) (COND ((NOT (VMPAGEP \VP.DISPLAY)) (DLADDPAGEMAPENTRIES \VP.DISPLAY \NP.DISPLAY) (add %#ADDEDFILEPAGES \NP.DISPLAY))) (SETQ %#NEWFILEPAGES (IPLUS (SUB1 %#OLDFILEPAGES) (SUB1 %#UCODEPAGES))) (* ;; "Used to use WORDSPERPAGE, until an FPTOVP entry went from word to cell 11/3/92 JDS:") (SETQ %#FPTOVPPAGES (ADD1 (FOLDHI (IPLUS %#NEWFILEPAGES %#ADDEDFILEPAGES) CELLSPERPAGE))) (* ;; "Number of pages of FPTOVP needed -- cover everything in sysout, plus one more possibly needed to cover FPTOVP itself") (add %#ADDEDFILEPAGES %#FPTOVPPAGES) (add %#NEWFILEPAGES %#ADDEDFILEPAGES) (* ;; "Make FPTOVP big enough to hold #NEWPAGES, plus a couple of entries as slop, to prevent off-by-1's.") (SETQ FPTOVP (ARRAY (+ 16384 (LLSH %#NEWFILEPAGES 1)) 'WORD \NO.VMEM.PAGE 1)) (SETQ DLSECONDARYMAP (ARRAY (CEIL DLNEXTPM WORDSPERPAGE) 'WORD 0 0)) (* ;; "Allocate enough space to accomodate existing secondary map plus anything we added. Round up to a page boundary") (replace (IFPAGE NxtPMAddr) of DLIFPAGE with DLNEXTPM) (* ;  "Store back new DLNEXTPM as updated by DLADDPAGEMAPENTRIES") (SETQ DLLOCKBITS (ARRAY (UNFOLD \NumLPTPages WORDSPERPAGE) 'WORD 0 0)) (* ; "Read the locked page table") (for J from 0 to (SUB1 \NumLPTPages) do (DLCOPYVMPAGE (IPLUS J \VP.LPT) (\ADDBASE (fetch (ARRAYP BASE) of DLLOCKBITS) (UNFOLD J WORDSPERPAGE]) (DLCOPYVMPAGE [LAMBDA (VP BASE) (* bvm%: "14-Dec-84 12:46") (* Reads page VP from VMEMFILE into  BASE, returning BASE) (SETVMPTR (UNFOLD VP WORDSPERPAGE)) (\BINS VMEMFILEX BASE 0 BYTESPERPAGE) BASE]) (DLADDPAGEMAPENTRIES [LAMBDA (VP NPAGES) (* bvm%: "27-MAR-83 17:53") (to NPAGES do [COND ((IEQ (FASTELTN DLPRIMARYMAP (fetch (VP PRIMARYKEY) of VP)) \EmptyPMTEntry) (COND ((EVENP DLNEXTPM WORDSPERPAGE) (* must add a new page map page) (add %#ADDEDFILEPAGES 1))) (FASTSETAN DLPRIMARYMAP (fetch (VP PRIMARYKEY) of VP) DLNEXTPM) (SETQ DLNEXTPM (IPLUS DLNEXTPM \PMblockSize] (add VP 1]) (ASSIGNFILEPAGE [LAMBDA (FP VP OLDFP LOCKED) (* ;  "Edited 9-Nov-92 14:54 by sybalsky:mv:envos") (* ;; "Assign VP to live in FP (and hence a related real page); OLDFP is where VP lives in the old sysout") (COND ([NOT (ZEROP (OR OLDFP (SETQ OLDFP (LOGAND (FASTELTN (FASTELT PGTAB (LRSH VP 8)) (LOGAND VP 255)) 32767] (FASTSETAN NEWFPFROMOLD OLDFP FP))) (FASTSETAN FPTOVP (ADD1 (LLSH FP 1)) VP) (FASTSETAN FPTOVP (LLSH FP 1) 0) (PROG [(SECONDARY (FASTELTN DLPRIMARYMAP (fetch (VP PRIMARYKEY) of VP] (* ;  "Update pagemap to point to the new FP") (COND ((IEQ SECONDARY \EmptyPMTEntry) (HELP VP "has no primary map entry")) (T (FASTSETAN DLSECONDARYMAP (IPLUS SECONDARY (fetch (VP SECONDARYKEY) of VP)) FP))) (COND (LOCKED (DLSETLOCKBIT VP]) (ASSIGNFILEPAGERANGE [LAMBDA (VPSTART NPAGES FPSTART ONLYIFTHERE) (* bvm%: "25-MAR-83 12:44") (for I from 0 to (SUB1 NPAGES) unless [AND ONLYIFTHERE (NOT (VMPAGEP (IPLUS VPSTART I] do (ASSIGNFILEPAGE (IPLUS FPSTART I) (IPLUS VPSTART I) NIL T]) (DLDUMPSYSOUT [LAMBDA NIL (* ; "Edited 7-Feb-2021 20:46 by larry") (* ; "Edited 7-Feb-2021 14:28 by lmm") (* ;  "Edited 3-Nov-92 10:50 by sybalsky:mv:envos") (PROG [(DLPAGEOFZEROS (NCREATE 'VMEMPAGEP] [SETQ DLFILEX (OPENSTREAM DLBOOTFILE 'OUTPUT 'NEW 8 (CONS (LIST 'LENGTH (UNFOLD %#NEWFILEPAGES BYTESPERPAGE )) '((SEQUENTIAL T) (TYPE BINARY] (SETQ DLBOOTFILE (FULLNAME DLFILEX)) (PROGN (\BOUTS DLFILEX DLPAGEOFZEROS 0 BYTESPERPAGE) (\BOUTS DLFILEX DLIFPAGE 0 BYTESPERPAGE) (\BOUTS DLFILEX DLPAGEOFZEROS 0 BYTESPERPAGE)) (DLDUMPVMEMPAGES (ADD1 DLLASTDOMINOPAGE) (SUB1 (DLFPFROMRP \RP.FPTOVP))) (DLDUMPFPTOVP) (DLDUMPVMEMPAGES (IPLUS (DLFPFROMRP \RP.FPTOVP) %#FPTOVPPAGES) (SUB1 DLPAGEMAPFP)) (DLDUMPPAGEMAPS) (DLDUMPVMEMPAGES (IPLUS DLPAGEMAPFP \NumPMTpages (FOLDHI DLNEXTPM WORDSPERPAGE) \NumLPTPages) %#NEWFILEPAGES) (CLOSEF DLFILEX]) (DLDUMPFPTOVP [LAMBDA NIL (* ;  "Edited 4-Nov-92 13:56 by sybalsky:mv:envos") (printout T "[FPTOVP]") (* ;; "Filepages are one-based, but FPTOVP in the sysout is zero-based for convenience. Hence, first entry (page zero) is dummy") (\WOUT DLFILEX \NO.VMEM.PAGE) (* ;; "With BIG VM, each FPTOVP entry is 2 words, and word 1 (the 1st element of the array) is actually part of the entry for page 0 (which we dumped the other half above). So we need to dump 2*#pages + 1 elements of the array:") (DLDUMPARRAY FPTOVP (ADD1 (LLSH %#NEWFILEPAGES 1))) (RPTQ (IDIFFERENCE (UNFOLD %#FPTOVPPAGES WORDSPERPAGE) (LLSH (ADD1 %#NEWFILEPAGES) 1)) (\WOUT DLFILEX \NO.VMEM.PAGE)) (* ; "Fill out rest of FPTOVP with no such page. Fill from #pages*2 (it's cells now, not words per FPTOVP entry), out to the end of the FPTOVP pages.") NIL]) (DLDUMPPAGEMAPS [LAMBDA NIL (* ;  "Edited 3-Nov-92 10:47 by sybalsky:mv:envos") (printout T "[PageMaps]") (DLDUMPARRAY DLPRIMARYMAP (UNFOLD \NumPMTpages WORDSPERPAGE)) (* ; "Dump primary map") (DLDUMPARRAY DLSECONDARYMAP (CEIL DLNEXTPM WORDSPERPAGE)) (* ; "Dump secondary map") (DLDUMPARRAY DLLOCKBITS (UNFOLD \NumLPTPages WORDSPERPAGE)) (* ; "Dump locked page table") NIL]) (DLDUMPVMEMPAGES [LAMBDA (FIRSTFP LASTFP) (* ;  "Edited 2-Nov-92 12:30 by sybalsky:mv:envos") (for FP from FIRSTFP to LASTFP bind VP do (COND ((AND (NEQ [SETQ VP (FASTELTN FPTOVP (ADD1 (LLSH FP 1] \NO.VMEM.PAGE) (VMPAGEP VP)) (SETVMPTR (UNFOLD VP WORDSPERPAGE)) (COPYBYTES VMEMFILE DLFILEX BYTESPERPAGE) (PRIN1 '* T)) (T (\BOUTS DLFILEX DLPAGEOFZEROS 0 BYTESPERPAGE) (PRIN1 'x T]) (DLSETBOOTPTR [LAMBDA (FP) (* bvm%: "27-MAR-83 17:39") (printout T "[" .P2 FP "]") (SETFILEPTR DLFILEX (UNFOLD (SUB1 FP) BYTESPERPAGE]) (DLDUMPARRAY [LAMBDA (ARR NWORDS) (* ;  "Edited 3-Nov-92 11:52 by sybalsky:mv:envos") (* ;; "Dump NWORDS from array ARR, starting with the first byte in the array's contents.") (\BOUTS DLFILEX (fetch (ARRAYP BASE) of ARR) 0 (UNFOLD NWORDS BYTESPERWORD]) (DLMARKASDUMPED [LAMBDA (FIRSTFP NPAGES) (* ;  "Edited 2-Nov-92 12:30 by sybalsky:mv:envos") (for I from FIRSTFP to (IPLUS FIRSTFP NPAGES -1) do (FASTSETAN FPTOVP (LLSH I 1) \NO.VMEM.PAGE]) (DLDUMPVMEMPAGE [LAMBDA (NEWFP VP LOCKEDP) (* bvm%: "28-MAR-83 12:11") (COND ((VMPAGEP VP) (SETVMPTR (UNFOLD VP WORDSPERPAGE)) [PROG ((DESTINATIONBYTE (UNFOLD (SUB1 NEWFP) BYTESPERPAGE))) (COND ((NOT (IEQP (\GETFILEPTR DLFILEX) DESTINATIONBYTE)) (printout T "[" .P2 NEWFP "]") (SETFILEPTR DLFILEX DESTINATIONBYTE] (COPYBYTES VMEMFILE DLFILEX BYTESPERPAGE) (PRIN1 (COND (LOCKEDP '$) (T '*)) T)) (T (PRIN1 'x T]) (INSTALLDOMINO [LAMBDA (DBFILE) (* edited%: "14-APR-83 12:00") (DLSETBOOTPTR 1) (COPYBYTES DBFILE DLFILEX 0 BYTESPERPAGE) (DLSETBOOTPTR (ADD1 \FP.IFPAGE)) (* Skip over InterfacePage) (COPYBYTES DBFILE DLFILEX) (* Copy rest of Domino) (DLSETBOOTPTR DLLASTDOMINOPAGE) (SETFILEPTR DBFILE 0) (* Copy first DB page into scratch at end of Domino reserved space so that  SYSOUT can get it (Dolphin and Dorado smash first page of vmem)) (COPYBYTES DBFILE DLFILEX 0 BYTESPERPAGE]) (INSTALLDOMINO.DIRECT [LAMBDA (DBFILE) (* bvm%: "29-JUL-83 16:16") (PROG [(BUFFER (COND ((IGREATERP \#SWAPBUFFERS 1) (RESETSAVE \EMUSWAPBUFFERS (\ADDBASE \EMUSWAPBUFFERS WORDSPERPAGE)) (RESETSAVE \#SWAPBUFFERS (SUB1 \#SWAPBUFFERS)) \EMUSWAPBUFFERS) (T (RESETSAVE \EMUDISKBUFFERS (\ADDBASE \EMUDISKBUFFERS WORDSPERPAGE)) (RESETSAVE \#DISKBUFFERS (SUB1 \#DISKBUFFERS)) \EMUDISKBUFFERS] (replace ENDOFSTREAMOP of DBFILE with (FUNCTION ZERO)) (\BINS DBFILE BUFFER 0 BYTESPERPAGE) (COND ((EQ \MACHINETYPE \DANDELION) (\ACTONVMEMFILE 1 BUFFER 1 T))) (\BINS DBFILE BUFFER 0 BYTESPERPAGE) (* Skip over InterfacePage) (for I from (ADD1 \FP.IFPAGE) until (\EOFP DBFILE) do (\BINS DBFILE BUFFER 0 BYTESPERPAGE) (\ACTONVMEMFILE I BUFFER 1 T)) (* Copy rest of Domino) ]) (INSTALLNEWDOMINO [LAMBDA (SYSOUTFILE DBFILE) (* bvm%: "29-JUL-83 16:08") (RESETLST (SETQ DBFILE (GETSTREAM (OPENFILE (OR DBFILE (INFILEP '{DSK}DLISPDOMINO.DB) '{PHYLUM}DLION>BASICS>DLISPDOMINO.DB) 'INPUT) 'INPUT)) (RESETSAVE NIL (LIST 'CLOSEF DBFILE)) (PROG ((DBPAGES (IPLUS (FOLDHI (GETFILEINFO DBFILE 'LENGTH) BYTESPERPAGE) 2)) %#UCODEPAGES DLFILEX) (DECLARE (SPECVARS DLFILEX)) [COND [SYSOUTFILE [RESETSAVE NIL (LIST 'CLOSEF (SETQ SYSOUTFILE (OPENFILE SYSOUTFILE 'INPUT] (SETQ %#UCODEPAGES (SETQ DLLASTDOMINOPAGE (fetch (IFPAGE LastDominoFilePage ) of (\MAPPAGE 1 (GETSTREAM SYSOUTFILE] ((ASKUSER NIL NIL (LIST "Shall I install" (fetch FULLFILENAME of DBFILE) "directly into the vmem file")) (SETQ %#UCODEPAGES (SETQ DLLASTDOMINOPAGE (fetch (IFPAGE LastDominoFilePage) of \InterfacePage] (COND ((ILESSP %#UCODEPAGES DBPAGES) (RETURN "Not enough space for Domino"))) (COND (SYSOUTFILE (OPENFILE (CLOSEF SYSOUTFILE) 'BOTH) (SETQ DLFILEX (GETSTREAM SYSOUTFILE)) (INSTALLDOMINO DBFILE)) (T (INSTALLDOMINO.DIRECT DBFILE))) (RETURN SYSOUTFILE)))]) ) (FILESLOAD READSYS) (DEFINEQ (DLPRINTFPTOVP [LAMBDA (STREAM) (* bvm%: "28-MAR-83 12:42") (\PRINTFPTOVP (\ADDBASE (fetch (ARRAYP BASE) of FPTOVP) -1) (fetch (IFPAGE NActivePages) of DLIFPAGE) STREAM]) (PRINTPRIMARYMAP [LAMBDA NIL (* bvm%: "28-MAR-83 23:25") (for I from 0 to 63 do (printout T I ": " 8) [for J from 0 to 7 bind PMPE do (COND ((EQ [SETQ PMPE (ELT DLPRIMARYMAP (PLUS J (TIMES I 8] 65535) (printout T " -----")) (T (printout T .I6.8 PMPE] (TERPRI T) unless (for J from 0 to 7 always (EQ (ELT DLPRIMARYMAP (PLUS J (TIMES I 8))) 65535]) (DLREADPAGEOFWORDS [LAMBDA (STREAM) (* bvm%: "29-MAR-83 00:03") (to WORDSPERPAGE collect (\WIN STREAM]) (SETDIF [LAMBDA (X Y) (* bvm%: "28-MAR-83 15:28") (for EL in X collect EL unless (FMEMB EL Y]) ) (DECLARE%: EVAL@COMPILE (RPAQQ \NO.PAGE.ASSIGNED 0) (CONSTANTS \NO.PAGE.ASSIGNED) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS DLPRIMARYMAP DLSECONDARYMAP DLLOCKBITS DLLASTDOMINOPAGE DLIFPAGE DLNEXTPM DLPAGEMAPFP FPTOVP NEWFPFROMOLD VMEMFILE VMEMFILEX) ) (PUTPROPS MAKEINIT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991 1992 1998 2021)) (DECLARE%: DONTCOPY (FILEMAP (NIL (4466 5254 (MAKEINITGREET 4476 . 5252)) (5437 11822 (LOADMAKEINIT 5447 . 6650) ( LOADMKIFILES 6652 . 6967) (RELOAD 6969 . 7452) (MAKEINIT 7454 . 11114) (MKI.START 11116 . 11820)) ( 11900 15801 (MKI.PASSFILE 11910 . 13703) (SCRATCHARRAY 13705 . 14354) (DOFORM 14356 . 15033) ( CONSTFORMP 15035 . 15269) (NOTICECOMS 15271 . 15579) (EVALFORMAKEINIT 15581 . 15799)) (15802 17922 ( I.ADDTOVAR 15812 . 15906) (I.DECLARE%: 15908 . 16184) (I.DEFINE-FILE-INFO 16186 . 16376) ( I.FILECREATED 16378 . 16752) (I.PUTPROPS 16754 . 16867) (I.RPAQ 16869 . 17090) (I.RPAQQ 17092 . 17288) (I.RPAQ? 17290 . 17505) (I.SETTOPVAL 17507 . 17739) (I.NOUNDO 17741 . 17920)) (18558 24558 ( I.ATOMNUMBER 18568 . 19059) (I.\ATOMCELL 19061 . 20814) (I.FIXUPNUM 20816 . 21633) (I.FIXUPPTR 21635 . 22116) (I.FIXUPSYM 22118 . 23066) (I.WORDSPERNAMEENTRY 23068 . 23823) (I.SETSTKNTOFFSET 23825 . 24556)) (24590 26098 (MKI.ATOM 24600 . 24796) (MKI.IEEE 24798 . 26096)) (26195 26960 (MKI.DSET 26205 . 26488) (MKI.ADDTO 26490 . 26675) (MKI.PUTPROP 26677 . 26958)) (27134 27686 (DUMPVP 27144 . 27241) ( BOUTZEROS 27243 . 27322) (BIN16 27324 . 27505) (BOUT16 27507 . 27684)) (28601 51335 (DLFIXINIT 28611 . 29586) (DLSORTSYSOUTPAGES 29588 . 34714) (DLNEXTFP 34716 . 35053) (DLLOCKEDPAGEP 35055 . 35269) ( DLSETLOCKBIT 35271 . 35533) (DLCOPYPAGEMAP 35535 . 38586) (DLCOPYVMPAGE 38588 . 38978) ( DLADDPAGEMAPENTRIES 38980 . 39795) (ASSIGNFILEPAGE 39797 . 41030) (ASSIGNFILEPAGERANGE 41032 . 41439) (DLDUMPSYSOUT 41441 . 43193) (DLDUMPFPTOVP 43195 . 44234) (DLDUMPPAGEMAPS 44236 . 44936) ( DLDUMPVMEMPAGES 44938 . 45594) (DLSETBOOTPTR 45596 . 45826) (DLDUMPARRAY 45828 . 46215) ( DLMARKASDUMPED 46217 . 46670) (DLDUMPVMEMPAGE 46672 . 47360) (INSTALLDOMINO 47362 . 48009) ( INSTALLDOMINO.DIRECT 48011 . 49163) (INSTALLNEWDOMINO 49165 . 51333)) (51357 52714 (DLPRINTFPTOVP 51367 . 51656) (PRINTPRIMARYMAP 51658 . 52372) (DLREADPAGEOFWORDS 52374 . 52541) (SETDIF 52543 . 52712 ))))) STOP \ No newline at end of file diff --git a/sources/MAKEINIT.LCOM b/sources/MAKEINIT.LCOM index eaa990f6211cc870e34f67ed4826421c8702ea86..637f3e256fe1cd82841561fbbed1a29fbcf40a7a 100755 GIT binary patch literal 24089 zcmb_^du*K7b>}>2nNdu6D5|oMqJuyC3*?k3r712oNIvt5cZf!HZJMS!AJ0i*dtyP$S~K(eCjZvUcI zyKS(*F86oNx!-F@zuE})@Vk%ie&?Qh-uK+wn@Fb2T(Uo9W|IA8E|phL7L53maW<)X z%v?EH%$TJ@k9xA0G!kWFBGXbmVU&_8JlNOKO9RBwtDH=z9yQXRU0Cmr3`W8#96mD? zJ`)}4QN2BjYpa)+>(z={YoODwCrVRa{Or=&YW0Qs!utBv7nbYG8<$^Ltyb#Qt1oP< zU0GkOZoH5+rjlmPEDt_(Ehdv? zHDTt$BWfZ)UB;h8CS}giuy`uvi{;XM2@M6zyQDf2nOt(NoGPF#laEg&6I4&7QnE}H z6Z~2{Uzn$ctU*mwn#ocb1tY<)pe30r7fp<5luG8=93hFjba=}}BggM0rn3cs1cOi^ zRVe3YXm~2d@DwVoYudC8ktnj8%QD;2|1_pXmWnmKp($V8?h(yjr!)FG=Js*P5BL4uwQp3@3 zbVzB+Q5~CWpq}0tqgb+OD4x%j`c!W!N9cZU+W9b~gH`#*(9Q>v4#xi_(9ZjlPRBo< zc0QPNIyCKgIM>6}ed_Xh_4CVXS2mb#uxdSOv_Dn7sAbRCnZdC$(ZL?o@ll0MxUa+W zC3Pk-1}Ucom2gI$*t$>oF8TaE-g66aJgi$bnB7q^s9T1HRc~~BC^DpmN5&#h6N7_eeG2c%KI(qdex>80dV3awPQb3f} zH1dY>o%UmC&uu+j@pt-VHPgJNuh42dLO;CDU4h`vPwA7=2O1yl?`wW#oz!k=WWWae`!9D!C!%%fLdhaP~5tpJ!((-}w`8AcJP320bFGpAb2 z`bq$^?o|F5gT~ad^YAMKTx?lN&opBWJ#y9dXpG6MTY4;o=AD=4{_p+mlcqE@WzaO! z^m0gE;t`r#uY(!^c(Pc`7uEQNkZe_e4w>K8&X(x^bm3=gT^h5CARp>kE#*A^<(N}t2;#^B&!n0_J-oux7$ zkwL64L=u!{nNa^ESl=(W{XO~9EWFtvPmFQU1ZI{<@(QX*gjbWf515N*@}*=-4XZqi z1k6`sLdWu#yTlCeZX00F2RRpt3YGE<`G zF<1$(&xo#5VBnc#k;s}}4TD}?G6NN|WF$Cm29EmtOn3ZK+<9d7n1APCr)D<9Jmyr? z+qq(~jgh<5-M!RZ>Rvn|uT!zo%@swkYkBbmi-Osc|B~3(Z`!Q-Kg-|ZH_AfD(^8t2 z(#-a_^F4l=u|6gogKtVtZsa;C&mNbKwC01r$bhww83Ra)KyYWL%mEmNLUdpk_rXreqP4$5iWxgi)A%DM#~QdRKsDWrcxP3SXRNJ zaZ8~ARGYc8;D<2O1(}PyoGJ|7JU0!BQsH3?YZT&maHJvDwE$v~B@KgZ-$NmULEj|& zn22mOF^VZ^vFc*0p&yO z)q4nHRj**tqWJkfB7Uou^#IE&tHz#ipIbHb_2ILuMCf}mB3uHhK}#9U)Inq^fd@7N zL{`sUTgXv2>Fo$MOW}>W8+MRD##LWp*aqUj&_F z#lY;s+}aWtWjQ~r=6Ny5UKy7~B$tl`EdvDJWg$!Nr{k{Kl$0~jXYw!BFKYy$e@CUb_3HbeY?&OaJ z`~m;&=Rzxcf07SX9tv)ERTzffZ!Ue+15PgRYuEPU&?DnO^FRv1hqOav9P2l5fjmdp zmtl1wbv{W3R|K{VD~xe5I!~)GtftcRgot~{a?lwml%a7;%?z?$Kt~wyu8xC360C8^ zyC6$*%vCokguv}&jM*wK1*@T~qGLjl2utLP^9t5*JX1^?rL+PMSdZax=aJ0b=`zg% z_Bkx%aRrb_cfy(=$yPRU<&qk6xSlON)&p=DdQ8}HVYmN6j=CkOgHwg{jC| z8dIk!JYkndrObgXY9GN168)mmF!LNZgJd6xG@y0LEO1zWq#cC>NF-2`*yBYgRogfx zq=PlcXv~tm<}&|L4FyX)o;){=5Rr-XMO{Rl&Sw$`!|AwNKLeZ0&6ve}E{lGr!A(yc z4Z`Y-hPF?-OnxS$i@vSDjRkjtzj@8~6Q)7wFnfZ{ChZLbrIOq0?XxGv>%8dW5#%jB zn6`9c%N1rEv1>a!{o({M6D)Oih98=J{0O-l^EZ6vjevQh4gYnveTf-kpf>1?xv!0MdN;J0j?|GoCW<>7Y-1=8p z{qR+=4hSTXC-WA*MHHl(i02c@B0P-|OCCqyi4uNQ1YE%4&N8kdutv0X9)T@l=E$^) zkY|h)6ALafDC?)~Ij|SBGuuf5?1xz(_|ye5C1((J9hUDCXF)=^%srT7r7{FZ7_Jz>nk@FaNDNd6 z76oOi@i43BB)er~>4WD%o}}#ryrHPeXp7P}V6K7Q$#4Mi6Qf2(;ORFoZ^ef3IX zadUaC0p1;hQ|30}z{RC_(J05$qGvQ0V+GhIFfxdsGI!-B=E>zFUxt^2v{Ik){dUmr z3zU98R$@B1zn!Tcd8)GVH-TU?RuAsJ`|e7m9$;4J4EWO(^MtQ?9G*hDB9#3%f!}VX z>w((tPo(?~n(?;J*IYc(G;ZIn-CF4k1SZV~*LzA#@Hc$&x8BBdIJvv>m(9uA>D7 zEx}|6(^|mOCDDU$VL<`y7c%+WbQbXrbs=ri6DaQj0MmT#Vmar0sT6M}O>QaR3U1%-e~hLI~To;njVL&u_eF zhIT&A@2BAa0!lb8fQhsYV1Y}Z9h-4*m-Y+*HCLjYRF*ce;e8_lkjt0NI7#Y~Wh#?@ z%~mK&Xt&H~Pg<)3Oz2`DfC-U!4DPhS@R-M+t!zM$ytmzJ!rbI(J!x7N!W*b6b}zPV zox%fovRhA>7B>D^W8<4mGazD(Oq1{Vdf~b`P+|@+O%usD!eB`RKS5&*Jp3#Ei>T9S zUK0`uv?SVmb{2*z0ewFNI4{T37QiQB+9r9!dI+_Xm=8tO_Ag?8_Iw*nZMm~22n<&KAml#}-{5JXxqmmQ(fsx1@>^SXq;mV#(py{q zN$Zk#KvF|mm0%`df&>Dggw7Z{X&gp%ia>!~&=Wtf!N$OI1W$1PC?Q}eCbQ?y5(*%s zlVvslTIBPnx{%2Cw~p#U6S-a1PMj?w*mYsafYlyHT$Awa4_*(`AO0wq%3>s52T}7_ zeCmO)2O9w)igON2n8J$qMLnu;*im*s0JH*uqeFC2Rzrk0Q7UBi^>x6}kl3MSIu~lX z9NHi-0)7Dk=n>tiUvy2rSTN2xygS3>K-RNs(8-{ledi|wX`cH0zr{2qLc~+wI?b3s z<@rjBn3;r_AyH$8PJO+j;6QC^xI#8yJ)#6M>KuWH`63`LGKp;OWEqMWy)+&OcsKNT zoh(bEoVDRsB+QAo#qewqLeH=ek|kp$S9}5jgy;CrOHX_+ZSwRuR_zKkfoR<#MF%3y z0Rrd64?w2*!N~0UU}Q3c1Qtw;UlJ~D+*%VrB*Dfacwm%xpflu)k&9*ty{9Z@nA`5c z>cdQ6$QWy1)$w%ZfUpH7Y#=g0*e8NE;U$Mp;#qR&aZBS6wdeBFxkUbe9Q-uXy1&LB z(~{_9%yC>}0dbnO7=}U~RHbx&I+K7ZhP7$o4bhzG36{sBDpyXEF$MAh8Gc4n8MVRq zm_U@=7Dc3zf0Y3s9i^k$UykXWgvS2F%lJ6|HSSN48j!m)ls{OZ@6OB(*k`qA`%+1(9& z_#uO7{p!>%O&lw0qZ$g=a=pRJb~Sdw1{};1#^G-Zf)sSNjVd(~h5J4h9UdDZVt{El zT_96XF9pcSC`|z~5k<9xrwKt+oZ>Y0E>aP@0SNxW*6BBj@w7?%0n^1K97NwggBje$ z1XOzBjhHbZGBak>ZqffF7PR>)f3^8)?*90A91H#PyZ0vI_wLsB@BOSZ7v`Fo6D_!OS<(3rOjuSMeo2qPpSUSQe4AV2+x@VS0MNJ2khGe|!n@L<)c zGtqwX6*P%5vN5nlp>S35M3{tas`g+TnEWmf6`XJ}0W=2TFnzZ(_|TNbqWslZ%!WWBMR|&&>Dt*^i;r;^ps&By30(i zqZZo2h{R|NhT#ee>B0wbYT^Cr4zM`&6Wl`m1f{Q^;7VHk91gI_zBK>KB>S(s$o@N^ zPL|vso%Z>)56J-B_d{?2Xw!{tI8Jb(UD5)$ZRr7Ky^X*WnZL_1(Q`HK7nR z=7|UOLPiGOLEHqUKttkWzUnhYd{DCbpmyv(B|?pgWMM$9ZWV z4!#KB6LDF10x>n>NfDVbBQE4)L3|HX72lOQs9z4wTH+gg;u7YNT22YmfJl0uDRK-0 z%G1&T;=XGi2=%-w5dPRghr-Px8zuqa^sJ8@&dPRAfh~re?pQ@TGhb_-`wEk0!GaaG zCQN0C#S&-~L}n9V+~q9;Xg#>K17RkUNlR9eVmgcEnNB2Gp{I%lX>|BIh;5LSO8IRf zLG$7=lV<-hY4(*$rL!xz5__Orc3$tG7+nAHH}0kEiO7 z-mAC4Uiflt_dGY<|Gmj~-!^NzZy76T^S1n(ynDC)rF%d78KbOe)F#R3;Q~uosBrdE zB;j$CRvQ?V65{5P20>z2N9Ad26QR2zS!SeSz=TqUv5m6!SP+97LdXZ)YOMvymPvTU|BzBHDpe}_lA!e3OZ2fNpFd}L?M|;Hp%7VWYV7;%P zb6Z-#h-h3=Y7642BzGL7(pDN6U%-D_V-^0zd%;V)E3iT&hygmjaB)nM2-{M4arc9Y?C=FnGio{1X8R z08+ec<^FeyE4(akrE9n5w(gts1+WqgVY~K{1E_^Rqz$Jy0LXT@0REV|6H`AEeWKl0 zo#(4xu)GcXwO_$&u;uRZcOmrm@9~o%lcSfB;^G0o$@5Lx{$@&T=D(aUf*zoV~-hKBa!kTZ2*LJ1GjQtqZaJBP8*nn`MO#*xc z(nTi_>l9@OoP){J2o8z9f&}#Dxk5$4T_Hd@BMcs?9vDGd{jVEGea!3)zpv5=?CX}teT_C>qf0ia8z+5eZ9Jw+kNIki$Mti-H+!-Xl)@{t zW+=S#JU`7o&WrfYna0rv`~+^QKdg5xw$FBPC;oZoG3UA7zWdHeF4jRB_AbZvXS(W- zTJJvJ#Zu~;?>-a9WaC6&cS!)3EssCc^$+>H^>11IFMI3%10`hz>-#I6$B$$)559KI z_gf5tZ0Y?PKkr??gbvv|on1%sq5QE2*JpG25EJp|PQX$y@+aWx=TC^O5X~RYhj#gS zYH#}#50F2>y%9|K6$XR5*PHE5Jd);ohu&2PFM;Am&}xN zDmqFmE(A$T4+2F}iEUR<(xcrKXa*4y%U1IIJ3~!COsQXN0n$%@iRF!UI{$b^#GOpc5#Q z0}RrG;$>EkDCXc1K2g|W1)S?Bl##^%-Iko*rlQ9t?=W0A#oqg@pDO2yI8EYJOB`oVXv`Tk5K`d@WP?|`on^2r(>_lZtDjIIRC5dF18oTXfG9SE*@#be5Knr**bt1 z^Hf{ZdPV8_Wwu&GK>p6WDLF`K`5K6PvPuOyoCuC|Ic03CrKn`#5KK)@mu+gW- zBIYJCkrzNW5taP2+Am_VOp(>#F5 zBc=$w#vxKV^he$fi-Tt%W&*K0OmMQGM{m3U|B;`Kl}5lcKiq2eO6+!RSDaUF zi``z~Mj4o83-dOm;1kNfZLlTDbz368Or!qPy`Kqf*ME|i6kd5V?f4_aJc{&Kf>J`)b^ESj7p*KOV)2wv(r{2zgX71cZu!TvkTQVIN+huof@o4$R z(Hk+)WjQTE$~@Mks{&%`OZB8(9khB*9TUo}?KXn{k4d@Rhkx+IW{-*Hs@-y`nHAt= z$zS+byY41n$|4zv>^@|Z+Y)H?S%s$kn@PF zz*iz(0CUmF3OfO|jB^cq005yLC_Nlt@E&Ak5~C=%LoZ~MwGarIWG?#)1XA+D5oZ#R zFxI*HJ|n+rJ@CR5A;-A7bf;L`y?u+t-~Bhctxk6DCI_j04t<8iQjSq^{y&F|fKI`- zm&aDgo5m!$MEq(I9`)5Kx!E8jl_k-2BWfWt~;xVgYTVxT#d zmRZP|3l=>Hga|)-0486FNXj;K?64jgB({lzD5Fg!IH%MiBM<5=o*zXDvkR9uoEbXw z?G+!0CqsNdw{un(sVxM}L1u8YNa=IBIR|H2We3rwmMmEKdK=OljacXLfQUUtj%ls) zc~VE$dncI%x7DOrFk%3dVYP^kV=1!Ltp!7{JS{>25`bHTqR1AQ-}(-c^RVSlaZoyT zOD3Y^sbY)GGJN3OTXGb3qNQqbAOZN-uTg~Uv_b^UGKRQmL708*CtyX#s|H= z%x807vdL9QMneTv#G8h^UTAU4c|iDyHW+8+*bSd?8#_a362w1Bn=6ypvN;ywT|phi zZ8?Ol$s~+nThyJV35@+Is5?YkW&5ZB-At-O|;u zwMd!4VPIvJER`Xx=*StZHK5{D7rHWnAp{N660tb|9FTOjR_Qlkpa#X(*-@>pDjaN`>q+xcZV~Li^Y@ zx8i)4!wZz~>E=2}ZKo@Ta$GD4&(monh3&Lqnrzy8wIym>rfc21p(!0PIU+V}_&|j6 zBf?P>vBs|$STGhW0}F?Oh$bhdQz_(j5#8A+J9xwoL5EKt0q&SHYWKI#F@=b2)XmS_ zf-tmp&S$z8A88)mNn1Nj?!vEanoSCZPjW2vDMLGCPgKx>G_BFe0IdEqdW+t<{dbI4}-}PU!VrQY)DHp(nsJ+@O0=1{B-x?(UQ|DJAU=RE|S;EZw_!n*=b&E zcfHoEiATc2Zar0DrBk}m&VSKQc0Rt%9QIddI2!U++Pwb_ZV#1rj>^%Sa)?28KGKw7 z-%&fTz=}K*Mp76)z3m*)=_9zd*0n{Jz@#JV$ef%mLG*Fj zA$%4x2T|Z7A$nZ8LB$>y*~a)HeS&u+!Hq5eB!NS|Plv$hiM1J&<3yfzB*9__+#lKq zxL`ImtLv{WELM4Q97ieTycB|ZdKP$7J4RqhT?cnapER=`AP|1Nke<&>XTSJaI#U(L z-7PO5RF}`afL%>9UZO&&AcQ=Sn1FN4x7>JZLH5|YfWel-{TJ27+LcR7YU471!(|xj zDzUb@+*re5EGW93$}+Ce+N@v2WlhM#*j%cr&#zWj)vLI&3q1f}PibiZS2vmHu(63J zM_JnpWtmB|y9?Qdm4aDB8mg7bnQ;hyIb%-toMsWyTpkvI8)@|eZ#;=azd#Ap%=E>S z#y{;o{G)T*(CF|yThCUL52g=kLsn=SvcYCK08~MUdk=TB)IiJv7Ls-8m2HvO*#uAG z%c4nd_*VCS!u(M$G8ai)i$DTlxJLn5x|0I&9o`+W_ORTBD8GguE1;~616T#P)eCrx z@}@PcVqoWcbc;~^MJL$9I|jk2$p_b;Vz{Qvdi#IA$*_?J^oL7dg@Su&>(27=>r2+X zFK%PA-o7L^5jAO~<83sO#7$izU7(@9<$CR3@N-7L$zQn9wan|p-qN-GD&?(?C>(Xg z%$WXonw0fSM-Zt%m&f6XnM|237(xV%E|rmbg!1Hpa_%z}PM{P@UM34k9Qi;eT}Bty z*tig44*M@-efSD;WmG@?!-aKYs^^SS?9EVGf_ReR!yH`iXAyGpcgBLXmtfF5cs(8B z1eD#k&7DVZKxF=hnD5rlC!c+5>lbck2JApLq499I+aZj@{7Ch~Jq^BRC`~Tb84l9n zF*D?^7*Bj3XVUq2`FxX3e*KTBXU}i_y?Zp=0ReMko)R#LHtlN%=x_)oD`!cp17B2$ zXp8(gt)74WdDWAmlq;(PUy;{?2n=0t=BcDQh(5fI8}f>AWSMXgtlg*N+CMbWnI3|q z4;yVp(S&rwwMD3;n2x+H*G|#sbMZ_+9bP5j9M7UVPH*;?rV9mJ!^ds`U2x$*imTul z(zW&FOUsRgx(%HLEq&X97?E!jtoxnxWlDAFg)19Xw#zDzP1QQ&k7`t_xV=m* zgS1wc7a^_IDpgfQVsM448{C~JjmLV9g<94yr}F9x3mc73ZK{QJz7tKA$l}AN^w*f0 zYgM(r1}#CBqBHszs;aU^uhO>%RPwdO>g7$ffqPsrK;u&Hi+$*PX$i#q+GW_248f@$ zk5PQ8M`07}GUbj&C`FZQO)@i|!!QuEpIWb~dUfIR#3_Ir40X9q7Au5rPY0HTY0bhK z#aUWzaFyURLc|iY{-_tYBG7tp`?+O9%v=137r5#OKl$=xXq0FQPGr{|f^P|cN|W`T zWyR{NS-pWX%Q0%TbP0W|&#mlB3!Tgx68>c43R2xNp6DXkR;vgA!uBZ%zn_Iad-PDMomYrttf333sFW2POEyrXLoS~ zkMyz2-cBvXfYsMq?S93rxTUwN#@*3|M0#08cNf<8(oB!7O)rw9#`LI-Znd(8(8ht& z=y{VpJtjqd9s2-uz|?-X#g3psTDzP+^hMjU&`{ZB_vomEDe@kWQKPHP{hnjD=nitm z7hP!b{FZ2F0#?^j&%;%T6d!nI)p+59n;`+qUKwm)ZlF3Hf?VQHU?JUaRC*-Y%NK!m)xz zpcLx5cTV+A$Ps+L*AM5hi^-Ha^&BLbfov;yWLANmMQ+&iXC|?lG7bj9tuwu-Dc}MM z-miAa7fZTY^Ex0K72)RnWT$Hewg*F|MbSK)F5@!wnQ8;aXr5Jb)%CU4RD5my^4dC% z2l3T9+O&7LfDQNTU{{xz$ Bmqq{p delta 628 zcmbQahw)zOgz(9iSwtu1IMkbI@+v4PSn4_!6zLin7#JuRT38tvS{WNDDI^u8CgKNkcGWi0F#KanddNTzhQ!`6bm^&1BOY(tk0jmVM!qrz3$o4~W53(zPa$$}^ z2uWvu-(XFJf}+&2%>2?~uxo&3@hT~pBiw0dZe?O=WooXZQ0)@zT|2Q+Z}TcPJ~e(X zO$7!H1_lO32Ze_Y3O6R7(NWe1iHQKkm>e7*a{*}v2gjWMPr)n!1`R`Vg%~IQ&=3VE ztvPv+0s|>f@rI z;pqny)l>i?jlfX<5La+SxB$ZlDB$iI0tz!vKR184LZ~WUPjElarry>ilisp>medley>sources>MAKEINITGREET.;2 1770 changes to%: (FNS MAKEINITGREET) previous date%: " 7-Feb-2021 18:10:42" {DSK}larry>ilisp>medley>sources>MAKEINITGREET.;1 ) (PRETTYCOMPRINT MAKEINITGREETCOMS) (RPAQQ MAKEINITGREETCOMS ((FNS MAKEINITGREET) (FILES (SOURCE) FILESETS) (FILES RENAMEFNS MAKEINIT DLFIXINIT XCL-PACKAGE CMLARRAY-SUPPORT VMEM))) (DEFINEQ (MAKEINITGREET [LAMBDA NIL (* ; "Edited 14-Feb-2021 09:56 by larry") (* ; "Edited 5-Dec-2017 15:26 by rmk:") (* ;; "") (* ;; " Updated Lisp version for big physical memory --bvm |11/3/87") (* ;; "") (XCL:RESTORE-PROFILE "INTERLISP") (* ; "Doesn't exist") (SETQ LITATOM-PACKAGE-CONVERSION-ENABLED NIL) (SETQ *REMOVE-INTERLISP-COMMENTS* NIL) (LOAD 'FILESETS) (* ; "rmk: VMEM has WORDARRAY") (* Versions are Lisp Microcode Bcpl) (BKSYSBUF " ") (DORENAME 'I) (DLFIXINIT (MAKEINIT '(39424 5682 11008) (MEDLEYDIR "loadups" "init.sysout" T) NIL DIRECTORIES DISPLAYFONTDIRECTORIES) (MEDLEYDIR "loadups" "init.dlinit" T]) ) (FILESLOAD (SOURCE) FILESETS) (FILESLOAD RENAMEFNS MAKEINIT DLFIXINIT XCL-PACKAGE CMLARRAY-SUPPORT VMEM) (PUTPROPS MAKEINITGREET COPYRIGHT (NONE)) (DECLARE%: DONTCOPY (FILEMAP (NIL (596 1591 (MAKEINITGREET 606 . 1589))))) STOP \ No newline at end of file diff --git a/sources/MAKEINITGREET.LCOM b/sources/MAKEINITGREET.LCOM deleted file mode 100644 index f7a020b6eb0db567380fe8d1b51a0ac05ebe5870..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1332 zcmbVL+iKfD5H+QJXp5m=5DtQZ6p)c*$rrU46ls+T>y}+P#E*_G8i5iSUkai0-#b!M z-;#$m63CuCJ3DjEo{>G~2QgFqAY^I~`w7lCbG*#C2pOax&KM5^kxDpA9e3jWzO9)OWNBXAFN-o?pn8CW_D@fYe|^2H?(2xG4W*chsm`YQsYf1mWSC{ZQdeHlQ4ecia*i^(p z_G5t~9txJL{6|r3*G;3eM?!xux<0UV%{EDt*NLnvC$ibzfbJL?!XR_9BvPMTpt?zX z&A14XSY>f-77spjoO2c>*R_+Lj6)lvh{c&WC)|J+aOP$S51631OR-2pXX+<$b^s}8 z&0B9wbLHG-T`1*@Dfh6BZjVpi?NuBiwV)Q5GIa?A#U8z=1dS#rlvfphlIRi zY6xIxs6)XrK}#4|kcx+5(^-`DkA#5+sjOy;?Q$)lM?r(G8@EcZX!{PeG|1hdX_&Bj z0|UCQX#)ja%AwahoL;Jwa+YONx{Z|6(?zRwGdy*!uAU>1U-Dry`2w;?CfsGp zo)o#Z=7&E59Xc58z0#!6UoXLpLWgr_s)|XPCOpG+#3DtZj+&DiO`q2}L|>@&Kcz^W cNk;dSo=h9uB%Si$@>>QuPGUwa#X;Eq4Z=ZH@&Et;