From bef35d1423bf5baf8a64dc8cdb488be6596b5cc3 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Fri, 12 Feb 2021 23:14:33 -0800 Subject: [PATCH] Fixing init build --- sources/DLFIXINIT | 118 +---------------- sources/DLFIXINIT.LCOM | Bin 12150 -> 10808 bytes sources/FILESETS | 176 +------------------------- sources/MAKEINIT | 251 +------------------------------------ sources/MAKEINIT.LCOM | Bin 0 -> 13022 bytes sources/MAKEINITGREET | 1 + sources/MAKEINITGREET.LCOM | Bin 0 -> 1352 bytes 7 files changed, 6 insertions(+), 540 deletions(-) create mode 100755 sources/MAKEINIT.LCOM create mode 100755 sources/MAKEINITGREET create mode 100755 sources/MAKEINITGREET.LCOM diff --git a/sources/DLFIXINIT b/sources/DLFIXINIT index c10cbe6e..6ec6fa4d 100644 --- a/sources/DLFIXINIT +++ b/sources/DLFIXINIT @@ -1,44 +1,4 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "29-Jan-98 17:51:06" {DSK}disk2>jdstools>lc3>lispcore3.0>sources>DLFIXINIT.;2 27711 - - changes to%: (FNS DLCOPYPAGEMAP) - - previous date%: " 9-Nov-92 14:54:57" -{DSK}disk2>jdstools>lc3>lispcore3.0>sources>DLFIXINIT.;1) - - -(* ; " -Copyright (c) 1983, 1984, 1990, 1992, 1998 by Venue & Xerox Corporation. All rights reserved. -") - -(PRETTYCOMPRINT DLFIXINITCOMS) - -(RPAQQ DLFIXINITCOMS - [(FNS DLFIXINIT DLSORTSYSOUTPAGES DLNEXTFP DLLOCKEDPAGEP DLSETLOCKBIT DLCOPYPAGEMAP - DLCOPYVMPAGE DLADDPAGEMAPENTRIES ASSIGNFILEPAGE ASSIGNFILEPAGERANGE DLDUMPSYSOUT - DLDUMPFPTOVP DLDUMPPAGEMAPS DLDUMPVMEMPAGES DLSETBOOTPTR DLDUMPARRAY DLMARKASDUMPED - DLDUMPVMEMPAGE INSTALLDOMINO INSTALLDOMINO.DIRECT INSTALLNEWDOMINO) - (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]) -(DEFINEQ - -(DLFIXINIT [LAMBDA (SYSOUTFILE DLBOOTFILE DBFILE %#UCODEPAGES) (* ;  "Edited 2-Nov-92 08:16 by sybalsky:mv:envos") [COND ((NOT DLBOOTFILE) (SETQ DLBOOTFILE (PACKFILENAME 'EXTENSION 'DLINIT 'VERSION NIL 'BODY SYSOUTFILE] (FILESLOAD (SYSLOAD) READSYS RDSYS) (RESETLST (SETQ DBFILE (OPENFILE (OR DBFILE '{PHYLUM}FUGUE>DLISPDOMINO.DB) 'INPUT)) (RESETSAVE NIL (LIST 'CLOSEF DBFILE)) (PROG ((DBPAGES (IPLUS (FOLDHI (GETFILEINFO DBFILE 'LENGTH) BYTESPERPAGE) 2)) (%#ADDEDFILEPAGES 0) %#OLDFILEPAGES %#NEWFILEPAGES %#FPTOVPPAGES DLFILEX) (DECLARE (SPECVARS %#NEWFILEPAGES %#OLDFILEPAGES %#ADDEDFILEPAGES %#FPTOVPPAGES DLFILEX)) (* ;  "Plus 2 is to allow for interface page and copy of page 0") (COND ((NOT %#UCODEPAGES) (SETQ %#UCODEPAGES (IQUOTIENT (ITIMES DBPAGES 5) 4)) (printout T " Assuming " .P2 %#UCODEPAGES " pages of uCode/Domino" T)) ((ILESSP %#UCODEPAGES DBPAGES) (printout T "Not enough space for Domino; raising it to " .P2 (SETQ %#UCODEPAGES DBPAGES) " pages" T))) (READSYS SYSOUTFILE) (RESETSAVE NIL '(READSYS)) (* ;  "To close the sysout source on exit") (SETQ %#OLDFILEPAGES (FOLDHI (GETFILEINFO VMEMFILE 'LENGTH) BYTESPERPAGE)) (DLCOPYPAGEMAP) (SETQ NEWFPFROMOLD (ARRAY %#OLDFILEPAGES 'WORD \NO.PAGE.ASSIGNED 1)) (DLSORTSYSOUTPAGES) (until (ERSETQ (DLDUMPSYSOUT)) do (printout T T "DLFIXINIT failed, trying again..." T)) (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 +(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 @@ -89,78 +49,4 @@ Copyright (c) 1983, 1984, 1990, 1992, 1998 by Venue & Xerox Corporation. All ri (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 3-Nov-92 10:50 by sybalsky:mv:envos") (PROG [(DLPAGEOFZEROS (NCREATE 'VMEMPAGEP] [RESETSAVE [SETQ DLFILEX (OPENSTREAM DLBOOTFILE 'OUTPUT 'NEW 8 (CONS (LIST 'LENGTH (UNFOLD %#NEWFILEPAGES BYTESPERPAGE)) '((SEQUENTIAL T) (TYPE BINARY] '(PROGN (CLOSEF? OLDVALUE) (AND RESETSTATE (DELFILE OLDVALUE] (SETQ DLBOOTFILE (FULLNAME DLFILEX)) (PROGN (COPYBYTES DBFILE DLFILEX 0 BYTESPERPAGE) (* ; "First page of domino") (\BOUTS DLFILEX DLIFPAGE 0 BYTESPERPAGE) (* ; "Interface Page") (COPYBYTES DBFILE DLFILEX) (* ; "Rest of Domino") (RPTQ (IDIFFERENCE (UNFOLD (SUB1 DLLASTDOMINOPAGE) BYTESPERPAGE) (IPLUS (GETFILEPTR DBFILE) BYTESPERPAGE)) (\BOUT DLFILEX 0)) (* ;  "(SETFILEPTR DLFILEX (UNFOLD (SUB1 DLLASTDOMINOPAGE) BYTESPERPAGE))") (SETFILEPTR DBFILE 0) (COPYBYTES DBFILE DLFILEX 0 BYTESPERPAGE) (* ; "Replicate domino first page") ) (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]) - -(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)))]) -) -(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) -) -(PUTPROPS DLFIXINIT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1990 1992 1998)) -(DECLARE%: DONTCOPY - (FILEMAP (NIL (1368 25824 (DLFIXINIT 1378 . 3816) (DLSORTSYSOUTPAGES 3818 . 8944) (DLNEXTFP 8946 . -9283) (DLLOCKEDPAGEP 9285 . 9499) (DLSETLOCKBIT 9501 . 9763) (DLCOPYPAGEMAP 9765 . 12816) ( -DLCOPYVMPAGE 12818 . 13208) (DLADDPAGEMAPENTRIES 13210 . 14025) (ASSIGNFILEPAGE 14027 . 15260) ( -ASSIGNFILEPAGERANGE 15262 . 15669) (DLDUMPSYSOUT 15671 . 17682) (DLDUMPFPTOVP 17684 . 18723) ( -DLDUMPPAGEMAPS 18725 . 19425) (DLDUMPVMEMPAGES 19427 . 20083) (DLSETBOOTPTR 20085 . 20315) ( -DLDUMPARRAY 20317 . 20704) (DLMARKASDUMPED 20706 . 21159) (DLDUMPVMEMPAGE 21161 . 21849) ( -INSTALLDOMINO 21851 . 22498) (INSTALLDOMINO.DIRECT 22500 . 23652) (INSTALLNEWDOMINO 23654 . 25822)) ( -25825 27182 (DLPRINTFPTOVP 25835 . 26124) (PRINTPRIMARYMAP 26126 . 26840) (DLREADPAGEOFWORDS 26842 . -27009) (SETDIF 27011 . 27180))))) -STOP + (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 index cefd8ac0393f4481243e34166724bcb50baa4479..a8f36d86d58e7d7155107f1ff734b3244d4d407b 100644 GIT binary patch delta 1749 zcmbVN&2!sS5Vu31X$AxBFl3rAbYt+u?l>Mxvh3K&1k^}MG?6XEQoc$Ds>m;~Qdu&R z(ljuPxo~Gj!ymwrvo9Q&VYqST)aj|v>7USEVV|5&IDrqVef#$9{`R-;tzUiillk4& z0BZ9x*_&s}ECVdlDAyZhJ`4G*?f3eQOFH0tkcF>AWBu!;uHPfet`!6)%Z}@W{pB9% zxa4Fx^p66Ygv+8TD?3U{F-wcpOaYJ8=Y@WNvCCy(78+%y!LeD`3&?qJd(gGK0}|#M zAgbbKQ#W=EZPNtDgG{!WL2a(6J)KnZ0ah*#?IR7qW#+ zURG3Tr7a1jB%;$l${j2;_}c%e57=s@%7Z<^51Giv8uD_>xKc;~`T=?5_(x%a5?!t! zU@C(~g>SHkAoHIo<_no~!l5B9Wb!&xF*~hy2Xx>e_o1wt+Lo>htCE413R+syHgz~N zB1Oq=OF&!+RUH;DfL<^HRit7IlQs*#wXWP_+M9w7Yz4qlXliHdAGB9YN=XX%2*zamu z0w-R7J9iJ+`!PM9O1YD_Z=_T0gquXT6UoQ;<5_ol+NU&4XI`ftd#saCY>#iO9eQJ_ zgvVbt9?-o@>$UjTDM*{~^QpOkku+f=Io3sX8N8({s%A(Cj;DOlXGY5$amjELCbgY% zXdr86UAW}N&|0b6=t==o=KmF|UWWUFyZC+$s4c+#k%lci)hcz6H&wMIG$p7opy^V} zFtPJZB%8r*h-ypPG4&=e90hQSN7fP08PV8dT-T|uDj24yHIk!w$S?Uqe z!D;10A@m$O@NK_Cfb{lACoy}8yW=@g5~~P!5SoIruEDVtdUFw2fq&$6N?`ct>V$){ zbde7|>mh-__j|DK2baPhBLJVCrO8VmJ+?_df)J-UM(_^u9~aR1pc?^s+$VOFK*(hk zFCxLdWfR>xAh|49A@os09{l~pg%(@PVH`Lna{&RDSdTCq)<)-d-^HWg`NvuOD~Kya zDgLrJlg`B77sdE#@qN@@6<6O<@Cpd3I%*`uv$OBT*8ICS@dX*sPDaA%Xc&GmAEc+~ U(=t>|5U*~=&q_<K&>%2)X)nFBfR4Ge|A7&;KyQlzJ+%LU(*i}(qNiT!OM2*`eQzkqS_A!9EJnjO zZ{EC*-}}w{I{5krKWjw=F@L8!$}1HRl&UOLizN17QWk-TQ>v}_Vb8tNFe>@0JC(K>c;XujT;m3JJ!g#7h{4f89EJpu#8pT|CnN(E} z1d#>_s#+z@yC8yZR;xE_YEawDdwS6H?7ZPQjhoRnv5mPTzhbA1Nqk)*NlV%K%XTZI||7KE!z% zJslH*nQEYSD3#EYUB?L)S_O#XUwq5Yhm?cl^~>vtWc%8$zQIz*h7HVNl;~Y!AMI<0 z+3ewdHrswV+k3ek3rQm}O8)D~U;aEyJvqwkUTkm9_`Tu9KMdFY*xNh{X??)7&f1&v z2@^iPzSrJ-`uTTPHTHVvRG4~{I2&9hD`)L2`(+!Je%z;}rL%Ka?lBnLVdA5Q-z1f9 z(ZIx+tLyjaqy1Voley$vVMaHZ?%#iT!QPy`K0hz^EQ+0<%O3x>{R*N=suUp5J=Zg_ z<4SpU{Ag)IY1WA-Z^*ptMTqEN8N~eMtRTQXWZL!{_ zZ8#v71V9GS&;W=p>6C&q4wg#w#lCrj~61SCsZlmLyzT1D}^)e1PSZqq5)780(` zn*<`MAgzLZwG}`T6(CHz)VYXc44@2c$J0Qp$YAMqJ=g=WtU#-wHyHTj(n2g1p=LS0 zj&Lo2X}iq;D)6bh*Rh(7N4G4~cWaKP??gtk-qewvQJ^^u({{GCUGxzXF95eB7hmV#t=+(mZeuzSkD+2INFN8#zgAxw_Dy*@k$ z$DoBD4MyR+Fz(g|6S6lrK{5p{jol|N3_$n*PHW+Q|9i1I2M7xeK%GoZar*%vcHXKylCJ{u0%^mclk0Q_MpZZ8I4Kl5ga zEwV2*FtnfDSWhBgOJ!C=MiWiDZQ2@?B>14w!n6iZEaTbp>yM!|0=WQGFW+)h4GIFd zYVAD|*lL3ig1{plUbTl{+jX=KmK$2S=bMfl^AO#s$f5e(K(|RswJTJB=MlkVJ-39j zN1)D8&St;3@YBl|B|$EiW^(%0S|ovrUzIWvB(k4Hed8GSbkFgT?h4F%;#~uIcgc;^ zf-59g!rY(ZUjw~jchGtAtf1ZsbLSxO^@Ru%KHPXClSwjCXg;gR@DiK1zWNf`ku7G^ z7pXeEbriI(WP4Y9R*l|9;2(`r3C2ceKC9sGH{ze$nPkepPrFECxOV5ti-8~W4wF9Q zzxe9QfSJMdCtq}qo_^*Z#R}%b$4`U#Jn*OA-h@>9>a@DK6}6bcA<>mg7Xn>_)Q1bw zq5P1HzVT7uV>eT7&#Q^}B8X*iPOz~FEYB&GB_Pt;?F4w$5kui^6cJq9z{3Yc1wPot z+ZUTpTCfgV5KAlD%E$*x8wgILX<39eK*}I)@&jz*2C+d&pJ1|uXf}8_<&~bIxHEq@FAR9oBnC5{zBTsM5~q+Ckv)BpPNniQF8jv zoN|xHU@-!O%91Wv%{;Td7vLkj)gPVq;cd9vABR7LS~xxq$K8`bI6|sbkQ;H3aZm&r P@P1O13bwm#TIqiSM-b_1 diff --git a/sources/FILESETS b/sources/FILESETS index 44f2109e..dcb746e2 100644 --- a/sources/FILESETS +++ b/sources/FILESETS @@ -1,175 +1 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "29-Jan-98 16:26:53" {DSK}disk2>jdstools>lc3>lispcore3.0>sources>FILESETS.;2 7340 - - changes to%: (VARS RENAMETYPES) - - previous date%: " 9-Apr-90 16:57:44" -{DSK}disk2>jdstools>lc3>lispcore3.0>sources>FILESETS.;1) - - -(* ; " -Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1998 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 MOD44IO 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 LLETHER PUP LEAF PASSWORDS FONT SUNFONT 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)) -(DECLARE%: DONTCOPY - (FILEMAP (NIL))) -STOP +(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 diff --git a/sources/MAKEINIT b/sources/MAKEINIT index 895c1666..bbef8e56 100644 --- a/sources/MAKEINIT +++ b/sources/MAKEINIT @@ -1,143 +1,4 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "30-Jan-98 12:46:00" {DSK}disk2>jdstools>lc3>lispcore3.0>sources>MAKEINIT.;3 26173 - - changes to%: (FNS I.\ATOMCELL) - - previous date%: "30-Jan-98 12:10:24" -{DSK}disk2>jdstools>lc3>lispcore3.0>sources>MAKEINIT.;2) - - -(* ; " -Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1998 by Venue & Xerox Corporation. All rights reserved. -") - -(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 (* mjs "13-Mar-84 14:41") (for X in (UNION MAKEINITFILES (SELECTQ (SYSTEMTYPE) ((ALTO D) NIL) MAXC.MAKEINITFILES)) do (RELOAD (PACKFILENAME (QUOTE BODY) X (QUOTE 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 TYPE TOFILE LOADUPDIRS FONTDIRS) (* ; "Edited 19-Jul-90 17:26 by jds") (LOADMKIFILES) (* ;  "Load the files that have to be here to start making the init.") (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 (COND [NIL (* ;  "Can't do this until we can do GETFILEPTR on a sequential output file") (APPEND MKI.SEQUENTIAL '((TYPE BINARY)) (AND SIZEGUESS (CONS (LIST 'LENGTH (UNFOLD SIZEGUESS BYTESPERPAGE] (T '((TYPE BINARY] (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 " 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 [LAMBDA (X N) (* ;  "Edited 26-Oct-92 14:24 by sybalsky:mv:envos") (LET ((ATOMNO (I.ATOMNUMBER X))) @@ -175,112 +36,4 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1998 b (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)) -(DECLARE%: DONTCOPY - (FILEMAP (NIL (2691 9683 (LOADMAKEINIT 2701 . 3904) (LOADMKIFILES 3906 . 4126) (RELOAD 4128 . 4611) ( -MAKEINIT 4613 . 8975) (MKI.START 8977 . 9681)) (9761 13662 (MKI.PASSFILE 9771 . 11564) (SCRATCHARRAY -11566 . 12215) (DOFORM 12217 . 12894) (CONSTFORMP 12896 . 13130) (NOTICECOMS 13132 . 13440) ( -EVALFORMAKEINIT 13442 . 13660)) (13663 15783 (I.ADDTOVAR 13673 . 13767) (I.DECLARE%: 13769 . 14045) ( -I.DEFINE-FILE-INFO 14047 . 14237) (I.FILECREATED 14239 . 14613) (I.PUTPROPS 14615 . 14728) (I.RPAQ -14730 . 14951) (I.RPAQQ 14953 . 15149) (I.RPAQ? 15151 . 15366) (I.SETTOPVAL 15368 . 15600) (I.NOUNDO -15602 . 15781)) (16359 22359 (I.ATOMNUMBER 16369 . 16860) (I.\ATOMCELL 16862 . 18615) (I.FIXUPNUM -18617 . 19434) (I.FIXUPPTR 19436 . 19917) (I.FIXUPSYM 19919 . 20867) (I.WORDSPERNAMEENTRY 20869 . -21624) (I.SETSTKNTOFFSET 21626 . 22357)) (22391 23899 (MKI.ATOM 22401 . 22597) (MKI.IEEE 22599 . 23897 -)) (23996 24761 (MKI.DSET 24006 . 24289) (MKI.ADDTO 24291 . 24476) (MKI.PUTPROP 24478 . 24759)) (24935 - 25313 (DUMPVP 24945 . 25042) (BOUTZEROS 25044 . 25123) (BIN16 25125 . 25210) (BOUT16 25212 . 25311))) -)) -STOP + (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 diff --git a/sources/MAKEINIT.LCOM b/sources/MAKEINIT.LCOM new file mode 100755 index 0000000000000000000000000000000000000000..eaa990f6211cc870e34f67ed4826421c8702ea86 GIT binary patch literal 13022 zcmb_jZERcDc_uIA#7RSkvJJOUjpRg$GfJxzUVez8GbFqsFU>1aB*jbW!*$olA{~9u zlA({b#;`6JvJ@=_3~7TVT~}-<(00R$PLV5M&IS<3pCUhs_D2UO`%xrTJPi9KuUl6P z7`*3w&$%Cz6UPB!*q8U5dp_Rtp7(v;k8>Q&n+2t?NF+0}mWXw5Y8bz`h_sCvw>O`*pI!ciI^hgNknFZxA#sL;AN6pzJqp^u)8jh;=! z`bD&VVeRsjrFN?+)>hHzkMj1!AOFGP+U3@>?fLcftIsaAmo~0Ed%4wYx2`_Bv9`6o z(As!*(wH!6(c`6 zVG(JzaK;f!t0LS#$&-l0a7q-m+HGN9#eADW=pNz2!^8ceIll>V`~CIt_}K)lssG+q z{jpam;;E5LN~mRs@a7tp!u-V|%*g?~mwn6eFB0FTjhgo{SDCa2#Fh2dmzLJHHh3`@ zE8M+5>9fhq*;M-D??-AN%#*7P5@++H;ix5IqGZ(0nT6810TDPF2n2%k2rNbd(PY<_ z41~*8DI8U!IQzt-R58k|CqGQ-fF38b z(C)8k%0xocOd?anM+J#C4OBKJP3&GgA;6(3Du&J3I>brf$1K}cr7ZNg7^~#x&}ty8 z22hmgqR=RnoM8l!nupj6S~=B%$Sn=4?iIl-llCAHw0r;a^pjnZr6)UCrqgS%lg_SD zi$2+6F*4_UoBh9AJEtu9p(6(^eu^3|MPw%)w6pz6AgY6KvsSCrL?$Duje50Ksfy7N zX1quz#W}N1M6#-n=%QMKmW$*F)mKGgL=bBVmRSP7(pXM8PpyTX;072A49O&TG+y*b zMp&%&;2BpW!5;LWcU#0`V$v!P6Of!UYhu*xhfx3EIw6!AFkCas#bJXfmNWs$u!E1>QJFlo3sZ(d0f;h%-w=W2yVhFalcD#X;kwTRGNq? zRLXT#7!gJR=uE&!Lx2Hjkrws2s#&t>eN-@Ll3W)=MogPE5^EYqhrC)fkXor(*dtWP zEdx>nex*Ga2(sMqqqh6d%(39^{a(#XgmuiTXdmT@g&t<^Vqf24pWU}`pX^S>W*=A7 zpsw|WlSfHvXHNY&sc+D7RrNpX-{l^4DaZ|3YRJ;`PR5&$-=>|(q{d)Q*^)nUoh;8B zmknvpW8lcJvymkOOo9y&Fb~5aMWY=LGCq*LJg+jxqw#w(A4|*mB#Hq;b6gqTsssV`- zdJ4lD)f`?tGz4B%AuMuBb*OC~X1Zj|DG6~mSBHEP_^}YVwP`F#fwoVrl1WiEXG9|7 z5Dqo*@DKyd&dx%T2o*(AwP8Jmv5Gq5`3V~kdK#aig+@77Crpi&jLEUQA&nVq6+kL# zSD<-!lK26gAhe=TLbn{C2E$@QrcfcGz%r;nRYd*pt{5w#l8cVS&kd09JGE>F7_Xcf zcfkXG(=afAY1xR-d~!s4&ZZiCspB&>kXTCOL8}NgRm-Rga@0(=_JB>oNfpZL;TX_k zcQkVIjF4i5w$_BqHob_~icm0NiNX~y}KnB&bLeR(t|-`LF0Z_bZh-E2{HoN*c*7>N^%Aob~@LEj`GRZFszl4zq^N~|&J zl}V#kGv=synuh{tVY8_$vC1oh3xr*4Cxh_^;6N-c9B(e1oH@lTo#~T5r{#~}ABorf zy;Dbuq1~c&eBsHN&&a|S3Xk&V#U^j$lKkPFoq0-r>65_xJfVK?<44P(-Oa^F@Sho? zOTo5w`8K;T-2V$DEy#0nsWbUc~wnL_66$o zKfx~^YX+IDgKL>!!J*R3gnIp`8;=rr|rC#h1It zDQkcD#_b&JNCs>kE&zPUI>a;Bzu^nHN_7tYr7kWM&YR?L#o^nq!N^Fbb5Q8;n(W4y zgnM8)Ky zlt*l=g5e=1)+|q3wMuys?FI)#@UaI&@H!Kbol`!Sp9Se+VEaF^q217*z7hB(%b;v9 zbCTUA6%B-BC4X-pojDagLJD&+z$3_BYB1&LWS5$(IMT1}?G4Hxh?QWmuU9`Z^O^f- zh`F}|*4vu(b`Spc_B_B!`30#8-=Eygm4Z8Gik`o8F;EIhJ(6=eZq*6y#}q`GQb#+8 zuYS8230-@fzcmxtgTLp2CY2&`>(2IHOsbccp*j$de1+Uw#1;vNYCc!Vn>9olBMu(N zQ?xS_tU(KCFI?$~!y8fFc^tloRVLReuFF=^gNw)H{waSBs!4JK@x|~wsIHtZR3S1U zDUp$m4y2XFTaPJRWtR}D?phdxP;$;R{38Sh%AJFA<_1Zi{ewIZOm%@=$!X+5Qj#Rn zEFgr>-GfVJ*8v=pA=x6Mvw1c-EF(`JIuG$AYbVJ|CVWm?g64p` z26-pP0m4s;8Xt*?{;~O{a8o9iwpJH5m)2IHyQ2uo{7xLQ9Cof|)N@5?XOtFW2iPYt zO4hkDYgc(}jzT_)WoYBL^?(R`EffrB_II*2%fYRkQv1Hgn#;e?LY-_ow0GmiaV$(Vq=p09+P;5%c{)P6nPO+`6?EO-fe~!=S9SC$5?&}!uzPs|ya<8V1Tfe#1 zZ?nL^9gx569+t!Lz2%>E##erIe*4!pTn5_q3y5?HdJ5JooUXXIP^y$0lL8xgp=i+? zB=3SzDphi0_%{J~;-!!m1?K69gt?5Zilx*m>IcF~vK4;-J;WAWlq(#8lhdRU8WOlD z{9~EpA{g~_Pzz{TX{VTWV#90353(!8hmS>SuRAK=nac9#1q};Aa6+h@;BNA=9<>|~;dNBi`WAY&&)|h3+3nMo!;K#)ZoJm9Gzn|un*1;jMd;>Hi8a7A z&6_!-!AzvvAY)8C;w%0|)@hLUgg}9|SGgyT~2!3g$NE^7#XnJ8RRvI z-@(u|oql*yD3zl~ybsdMWAmv6(jM#tL@3Xhl4%Mj~G;ivxMjzCp)BYW2O3 zYeioA++SmvGDE~m-yUR6pz?h45X_7NW(aEB)M+4^CJ`WEqqHxFJ>>a8^+*!Psq+94 z>rFYBM83CKhapBQ#RnqZPd&PmXKBt9MF5rQHI%_6WD#Y2}~Jt?PZluXARIDGT{TcTMlc&TaK8dYs+EB9g9QK zUamCC`N|zQ`1>sD!4;lNAxACWWw$zoAj9JQ6*PUZ3V>1uqVKoxS(3%)0kvbj`B3_DN+rm0Z9JB*BLTuxuQkq z0gal805R}qaD#hTfb7$+XN@t5nOS4y9r{PGpxjsatK3&>@2%rGZ1lhF-yF-`+;88$ z`F?Lm`;eyNKRbbe(dKSVh;fMgyPROe6kX-yXm=S=i{c3wModJ$!0~}0e(DwJbM=Ol zgnGkaka|Pn!Ko8x6GId$C=q35V_-)@5vo*3Fp1k#-NkKi^7~*^Xw0Vsuo%R{;(l-F z$b{me{8d~m?M)JEip-k3Hfd|v4m{qRQ{!0t>jo2VIrHxCVkC=Tifg{9~s2JvbU{i+7=IMo}%LiGltuig+!I_*3SaK+x9 z`y|EwRiD^@57NoV{qbd=yWOJ#aNB#(0?4MH+erQ(g!Z8YczdV?e2T6HsYLe(0AEi} zDAxD4rrm@=P@E?nRIeGg5-A2%ha`Y{1IRgbhxBHqQp?*_vqnA#vQS9wFQGeHy2v(zC3d{$^W?Ffvt7U;FJ!B*3l)s8?!=%$J1|VyCFI7AC~5Pn2WTa`pJK$i2}Q2YnJQtEZ7uBb}6xnKg1!d>o2zLaK6mvJU2#ld}$dLr;8Q z4%G5WSOy^JE=%Mb28^d;17!HFVj$G>t^oXTgbssS8N(4U!0D*~1)R;D{wjM6yM5WF z3TD39nR)gdL9`m&If1ZD({!+s4AVJmPa|)#K`+z{ zvgn9+klP?H)t1>A*sF>RnaQ%hMV5WJ+3YzN3JzQXfg$d_4MczV6({6*KvV^?3yaquqtg`ZSw29PRjXX0lF;GHThO>>bidc|? zOCo2OPNylosN-10Eg&J--&kF5;YQ6yYjtz}V!I_S;i|&s(&`ICSJswRH^u7K<%_L# z+^~s@*la0_28jo}$*+rvo%8@P@aYwok3!1ZLjxQb<$QXL!#i~wsAo`=z^X;vc zSi2;?YOAY9O>t>`?J|`&*YF(p>X|c02C`mocJ$sCapuq>c8__aE=I5*R+dM${~HO6 zxM-B=tQbT&^dBZzohzujEr-a6D_+vo7UWY2cRZ%jQ5qB=33@_4rtUrr5JCK?m}mUn zUrGKNQtpb5y9RvWvrRtMho|r7D&mU|qnA!y`lHqLwJWXl&8x&v$>zoR4RNv6T6OrX zIGk@xR;PVwI=mBT(q$6RevfK^R`?suDmn5eaoU5ph`4^8`=Z);M6GakBM>6 zcNE@#Fe~263OMN`Uo2w-Ve03#bpj3QaS}b?!R_;Gfco1v`Ax2f=fl}}_q;f2N0dHC zc8-&tP6~};a4c7b?EXr+g@99e%5pf>vf$i0Q&+s)k0j=N*30(|ka~;`if3?hj&3JG z*?p;V+-KYn^Q%olp&`Oh`FlItp5 z411BPFA2bLETuG5zEF(@Cxg_HvUvV%9K9d9*-6&V%R>26JTk3-{*rS}mVu7KR5AqL zWQff79H3ZWkZ>pVl7M$i8urf#4I!agp?_m@>(V7$U0a6?64Q&V(L|Cmj+2b1}Y1k<#O;jt|JA^aL%m4mx9GO;(;LFTi)i>pO%|#7kCr^|-Pl zqIaGbV=d0rQChaA12_uuXQT5Kz8(;z3rfmnMZL2}unVVa4R>9;B<^<6zzJ_fA>B+OjWu$$3MtPlV}&_|t56_R5=YZOv}tbY1=iuFG5&-d znr%Id&VwrLN>mYRL(7hW%kmj`O0t;FB zobPxS+U-={9Yx7Pt H;d}l+!$SdH literal 0 HcmV?d00001 diff --git a/sources/MAKEINITGREET b/sources/MAKEINITGREET new file mode 100755 index 00000000..2d89d3a8 --- /dev/null +++ b/sources/MAKEINITGREET @@ -0,0 +1 @@ +(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED " 7-Feb-2021 18:10:42" {DSK}larry>ilisp>medley>sources>MAKEINITGREET.;33 1897 changes to%: (FNS MAKEINITGREET) (FILES RENAMEFNS) (VARS MAKEINITGREETCOMS) previous date%: " 5-Dec-2017 15:26:33" {DSK}larry>ilisp>medley>sources>MAKEINITGREET.;28 ) (PRETTYCOMPRINT MAKEINITGREETCOMS) (RPAQQ MAKEINITGREETCOMS ((FNS MAKEINITGREET) (FILES (SOURCE) FILESETS) (FILES RENAMEFNS MAKEINIT DLFIXINIT XCL-PACKAGE CMLARRAY-SUPPORT VMEM))) (DEFINEQ (MAKEINITGREET [LAMBDA NIL (* ; "Edited 7-Feb-2021 18:06 by lmm") (* ;  "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) (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 (681 1718 (MAKEINITGREET 691 . 1716))))) STOP \ No newline at end of file diff --git a/sources/MAKEINITGREET.LCOM b/sources/MAKEINITGREET.LCOM new file mode 100755 index 0000000000000000000000000000000000000000..436d37d4a820471028e5923c06d86a556e03c8bf GIT binary patch literal 1352 zcmbVM?`xY-6b)nhunl29c!OefIepnvZEBtzc@1$)Jq=@4MQ} zq$!N8`CxqaUOo4md#*}ALYfdQq!H0*5;8dB#0!M?Eg~S(L=Ya)ES2Fb_54fk;#p9Y zl;$}fpAaMf8Ae)|-)g3A8ellCp}PZ921Q;}t94Q4OQ;^ONctIMm%qN=SF3zd&NrLK zNl_N{da}xwW&Sv+tKDXi*OS=0Bs8Jof)gV8Uo1<-XUCei-XMUkHvqcfS_p8v$vcF_ z{rurBuRpsWJ$nHZ2pzWwVD)VXcV!9LBZ6%Kj6>V~eqV;=e2dM>$8pniEd+Grf8+d0 zib!fa0%=bIwiWVF!X$%dTvUvq>=|&9crn2|My4J=Df3y3iS;J`QB=FSCDq6xgRKSm z0!1`NVA!rXbS+DUS9NSU>WR#5;Gii$hlmPKuvpvMM)O%RB|M`n(XeZDR{$XxaL!50 zrj7OXPQ$`DCW*+-F>gXZIq?PK6zPUw;W3}^vN?0}o z>}f<`+7K}>fHB