(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "12-Oct-93 22:22:00" "{Pele:mv:envos}Sources>CLTL2>MAKEINIT.;1" 26075 changes to%: (FNS I.\ATOMCELL) previous date%: "22-Sep-92 19:17:22" {DSK}usr>users>sybalsky>cltl2>sources>MAKEINIT.;1) (* ; " Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 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 (COMSNAME (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 (COMSNAME 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 (COMSNAME 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 (COMSNAME (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 23-Jan-91 19:02 by jds") (* ;; "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))) (COND (NIL (* ;; "THIS WAS THE PRE-BIGVM CODE:") (LET [(LOC (SELECTC N (10 (I.ATOMNUMBER X)) (12 (I.ATOMNUMBER X)) (2 (I.ATOMNUMBER X)) (8 (I.ATOMNUMBER X)) (SHOULDNT] (I.ADDBASE (I.VAG2 N LOC) LOC))) [(EQ (LRSH ATOMNO 16) 0) (* ; "Xerox Lisp traditional symbol") (LET [(LOC (SELECTC N (10 4) (12 2) (2 6) (8 0) (SHOULDNT] (I.ADDBASE (I.VAG2 8 0) (IPLUS LOC (ITIMES 10 ATOMNO] (T (* ;  "New symbol that appears after traditional symbol runs out.") (LET [(OFFSET (SELECTC N (10 4) (12 2) (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 (COMSNAME (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 1993)) (DECLARE%: DONTCOPY (FILEMAP (NIL (2671 9662 (LOADMAKEINIT 2681 . 3884) (LOADMKIFILES 3886 . 4106) (RELOAD 4108 . 4590) (MAKEINIT 4592 . 8954) (MKI.START 8956 . 9660)) (9740 13640 (MKI.PASSFILE 9750 . 11542) (SCRATCHARRAY 11544 . 12193) (DOFORM 12195 . 12872) (CONSTFORMP 12874 . 13108) (NOTICECOMS 13110 . 13418) ( EVALFORMAKEINIT 13420 . 13638)) (13641 15760 (I.ADDTOVAR 13651 . 13745) (I.DECLARE%: 13747 . 14023) ( I.DEFINE-FILE-INFO 14025 . 14215) (I.FILECREATED 14217 . 14590) (I.PUTPROPS 14592 . 14705) (I.RPAQ 14707 . 14928) (I.RPAQQ 14930 . 15126) (I.RPAQ? 15128 . 15343) (I.SETTOPVAL 15345 . 15577) (I.NOUNDO 15579 . 15758)) (16396 22240 (I.ATOMNUMBER 16406 . 16841) (I.\ATOMCELL 16843 . 18496) (I.FIXUPNUM 18498 . 19315) (I.FIXUPPTR 19317 . 19798) (I.FIXUPSYM 19800 . 20748) (I.WORDSPERNAMEENTRY 20750 . 21505) (I.SETSTKNTOFFSET 21507 . 22238)) (22272 23780 (MKI.ATOM 22282 . 22478) (MKI.IEEE 22480 . 23778 )) (23877 24642 (MKI.DSET 23887 . 24170) (MKI.ADDTO 24172 . 24357) (MKI.PUTPROP 24359 . 24640)) (24818 25196 (DUMPVP 24828 . 24925) (BOUTZEROS 24927 . 25006) (BIN16 25008 . 25093) (BOUT16 25095 . 25194))) )) STOP