(FILECREATED "31-Aug-86 17:18:06" {ERIS}<LISPCORE>BVM>MAKEINIT.;1 31150  

      changes to:  (VARS MAKEINITCOMS)
                   (PROPS (DEFINE-FILE-INFO MKI))
                   (FNS MKI.PASSFILE DOFORM I.DEFINE-FILE-INFO)

      previous date: "27-Aug-86 22:19:18" {ERIS}<LISPCORE>SOURCES>MAKEINIT.;16)


(* Copyright (c) 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT MAKEINITCOMS)

(RPAQQ MAKEINITCOMS 
       ((FNS I.RPAQ? LOADMAKEINIT LOADMKIFILES RELOAD)
        (FNS MAKEINIT MKI.START)
        (FNS DUMPVP)
        (FNS BOUTZEROS BIN16 BOUT16)
        (VARS BYTECOMPILE.EXT (MKI.FirstDataByte 1024)
              (MKI.Page0Byte 512)
              (MKI.DATE (DATE))
              MKI.CODESTARTOFFSET MKI.SEQUENTIAL PRINTEXPRS)
        (FNS MKI.PASSFILE SCRATCHARRAY DOFORM CONSTFORMP NOTICECOMS I.ADDTOVAR I.DECLARE: 
             I.FILECREATED I.DEFINE-FILE-INFO I.PUTPROPS I.RPAQ I.RPAQQ EVALFORMAKEINIT I.SETTOPVAL 
             I.NOUNDO)
        (FNS I.ATOMNUMBER I.FIXUPNUM I.FIXUPPTR)
        (FNS MKI.ATOM MKI.IEEE)
        (FNS MKI.DSET MKI.ADDTO MKI.PUTPROP)
        (VARS (MKI.ARRAY)
              (MKI.TVHA (HASHARRAY 400))
              (MKI.PLHA (HASHARRAY 150))
              (MKI.ATOMARRAY (HASHARRAY 5000))
              (INIT.EXT (QUOTE SYSOUT)))
        (INITVARS (PRINTEXPRS T))
        (PROP MKI ADDTOVAR DECLARE: DEFINE-FILE-INFO FILECREATED PUTPROPS RPAQ RPAQ? RPAQQ LISPXPRINT 
              PRETTYCOMPRINT * SETTOPVAL SETQQ SETQ /SETTOPVAL)
        [DECLARE: DONTEVAL@LOAD DOCOPY (P (PUTPROP (NAMEFIELD (INPUT)
                                                          T)
                                                 (QUOTE LOADDATE)
                                                 (GETFILEINFO (INPUT)
                                                        (QUOTE ICREATIONDATE]
        (DECLARE: EVAL@COMPILE (PROP MACRO SETXVAR IEQ)
               DONTCOPY
               (FILES (LOADCOMP)
                      MEM))))
(DEFINEQ

(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])

(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])
)
(DEFINEQ

(MAKEINIT
  [LAMBDA (VERSIONS TYPE TOFILE LOADUPDIRS)                  (* jds "26-Aug-86 21:11")
          
          (* * LOAD THE FILES NECESSARY TO MAKE THE INIT.)
          
          (* * TYPELST IS A LIST OF THE FORM (TYPE FILE-LIST AFTER-INIT-FILES 
          INIT-SIZE-GUESS))
          
          (* * GENERALLY LOADS THE FILES IN 0LISPSET AND 1LISPSET
          (\, WITH) 2LISPSET GETTING LOADED IMMEDIATELY AFTER THE INIT STARTS.)

    (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 (QUOTE ?]
           FILES SIZEGUESS AFTERINITFILESET EXPRESSIONS)
          (SETQ FILES (CADR TYPELST))
          (SETQ AFTERINITFILESET (CADDR TYPELST))
          (SETQ SIZEGUESS (CADDDR TYPELST))
          (RESETLST
           [RESETSAVE (OUTPUT (SETQ TOFILE
                               (OPENFILE (PACKFILENAME (QUOTE BODY)
                                                (OR TOFILE (CAR TYPELST)
                                                    (QUOTE XXX))
                                                (QUOTE EXTENSION)
                                                INIT.EXT)
                                      (QUOTE OUTPUT)
                                      (QUOTE NEW)
                                      8
                                      (COND
                                         [NIL                (* Can't do this until we can do 
                                                             GETFILEPTR on a sequential output file)
                                              (APPEND MKI.SEQUENTIAL (QUOTE ((TYPE BINARY)))
                                                     (AND SIZEGUESS (CONS (LIST (QUOTE LENGTH)
                                                                                (UNFOLD SIZEGUESS 
                                                                                       BYTESPERPAGE]
                                         (T (QUOTE ((TYPE BINARY]
           (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (FL)
                                            (AND (OPENP FL)
                                                 (CLOSEF FL))
                                            (AND RESETSTATE (DELFILE FL]
                                TOFILE))
           (PROG [(OUTX (GETOFD TOFILE (QUOTE OUTPUT]
                 (MKI.START)
                 (for X in FILES do (MKI.PASSFILE X))
                 (AND LOADUPDIRS (MKI.DSET (QUOTE LOADUPDIRECTORIES)
                                        LOADUPDIRS))
                 [COND
                    (AFTERINITFILESET
                     [MKI.ADDTO
                      (QUOTE MAKEINIT.EXPRESSIONS)
                      (BQUOTE ((MAPC (QUOTE , (EVAL AFTERINITFILESET))
                                     (FUNCTION (LAMBDA (FILE)
                                                 (OR [SOME LOADUPDIRECTORIES
                                                           (FUNCTION (LAMBDA (DIR FL)
                                                                       (COND
                                                                          ((SETQ FL
                                                                            (INFILEP
                                                                             (PACKFILENAME
                                                                              (QUOTE DIRECTORY)
                                                                              DIR
                                                                              (QUOTE NAME)
                                                                              FILE
                                                                              (QUOTE EXTENSION)
                                                                              COMPILE.EXT)))
                                                                           (LOAD FL (QUOTE SYSLOAD))
                                                                           T]
                                                     (PRINT (CONS FILE (QUOTE (not found)))
                                                            T]
                     (MKI.ADDTO (QUOTE BOOTFILES)
                            (QUOTE (MAKEINIT.EXPRESSIONS]
                 (I.MAKEINITLAST VERSIONS)))
          (RETURN 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])
)
(DEFINEQ

(DUMPVP
  [LAMBDA (VP)                                               (* lpd: "27-APR-77 20:24")
    (PRIN1 (QUOTE *)
           T)
    (WriteoutPage OUTX VP])
)
(DEFINEQ

(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 BYTECOMPILE.EXT DCOM)

(RPAQQ MKI.FirstDataByte 1024)

(RPAQQ MKI.Page0Byte 512)

(RPAQ MKI.DATE (DATE))

(RPAQQ MKI.CODESTARTOFFSET 60)

(RPAQQ MKI.SEQUENTIAL ((SEQUENTIAL T)))

(RPAQQ PRINTEXPRS T)
(DEFINEQ

(MKI.PASSFILE
  [LAMBDA (FILESET)                                          (* bvm: "30-Aug-86 16:00")
          
          (* * 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 (QUOTE BODY)
                                                                FILESET
                                                                (QUOTE EXTENSION)
                                                                BYTECOMPILE.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)
                                              (RATOM)
                                              (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)                                     (* lmm "21-AUG-81 23:14")
    [COND
       ((OR (NULL MKI.ARRAY)
            (IGREATERP NBYTES (ARRAYSIZE MKI.ARRAY)))        (* make sure the scratch array is big 
                                                             enough)
        (SETQ MKI.ARRAY (\CODEARRAY NBYTES 0]
    (for I from 0 to (SUB1 (UNFOLD ALIGN BYTESPERCELL)) do (\BYTESETA MKI.ARRAY I 0))
    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.RPAQQ I.RPAQ 
                                                             I.DECLARE: I.DEFLIST I.PUTPROPS 
                                                             I.ADDTOVAR I.SETHASHQ 
                                                             I.PRETTYDEFMACROS I.FILECREATED 
                                                             I.DEFINE-FILE-INFO))
                  (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])

(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")
                                                             (* edited (2-APR-75 . 934))
    (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.FILECREATED
  [LAMBDA (X)                                                (* lmm " 6-MAR-80 17:48")
    (COND
       ((LITATOM (CADDR X))
        (PROG (NAME)
              [MKI.ADDTO (QUOTE BOOTLOADEDFILES)
                     (LIST (SETQ NAME (NAMEFIELD (CADDR X]
              (MKI.PUTPROP NAME (QUOTE FILEDATES)
                     (LIST (CONS (CADR X)
                                 (CADDR X])

(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.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])

(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])

(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])
)
(DEFINEQ

(I.ATOMNUMBER
  [LAMBDA (A)                                                (* lmm " 9-NOV-81 23:28")
    (I.LOLOC (COND
                ((LITATOM A)
                 (MKI.ATOM A))
                (T A])

(I.FIXUPNUM
  [LAMBDA (CA BN NUM MASK)                                   (* lmm " 2-AUG-80 10:29")
    (\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)                                        (* lmm " 2-AUG-80 10:29")
                                                             (* 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)
                 (I.HILOC PTR])
)
(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)
    (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])
)
(DEFINEQ

(MKI.DSET
  [LAMBDA (A VAL)                                            (* mjs "19-Jul-84 13:09")
    (PROG ((LST (GETHASH A MKI.TVHA)))
          (COND
             (LST (COND
                     ((NOT (EQUAL VAL (CDR LST)))
                      (LISPXPRINT (LIST A (QUOTE (value changed from))
                                        (CDR LST)
                                        (QUOTE (to))
                                        VAL)
                             T T)))
                  (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)                                       (* lpd: "29-APR-77 13:19")
    (PROG ((LST (GETHASH A MKI.PLHA)))
          (COND
             (LST (COND
                     ((LISTGET LST PROP)
                      (LISPXPRINT (LIST A (QUOTE (- prop))
                                        PROP
                                        (QUOTE (has been changed)))
                             T T)))
                  (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)

(RPAQ? PRINTEXPRS T)

(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)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(PUTPROP (NAMEFIELD (INPUT)
                T)
       (QUOTE LOADDATE)
       (GETFILEINFO (INPUT)
              (QUOTE ICREATIONDATE)))
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS SETXVAR MACRO [X (BQUOTE (SETQ.NOREF , (CADAR X)
                                          ,
                                          (CADR X])

(PUTPROPS IEQ MACRO ((X Y)
                     (IEQP X Y)))
DONTCOPY 
(FILESLOAD (LOADCOMP)
       MEM)
)
(PUTPROPS MAKEINIT COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2018 5959 (I.RPAQ? 2028 . 2449) (LOADMAKEINIT 2451 . 4408) (LOADMKIFILES 4410 . 5060) (
RELOAD 5062 . 5957)) (5960 12354 (MAKEINIT 5970 . 10634) (MKI.START 10636 . 12352)) (12355 12541 (
DUMPVP 12365 . 12539)) (12542 13028 (BOUTZEROS 12552 . 12690) (BIN16 12692 . 12864) (BOUT16 12866 . 
13026)) (13265 23916 (MKI.PASSFILE 13275 . 17123) (SCRATCHARRAY 17125 . 17617) (DOFORM 17619 . 18940) 
(CONSTFORMP 18942 . 19362) (NOTICECOMS 19364 . 20287) (I.ADDTOVAR 20289 . 20454) (I.DECLARE: 20456 . 
21067) (I.FILECREATED 21069 . 21493) (I.DEFINE-FILE-INFO 21495 . 21760) (I.PUTPROPS 21762 . 21956) (
I.RPAQ 21958 . 22408) (I.RPAQQ 22410 . 22741) (EVALFORMAKEINIT 22743 . 23145) (I.SETTOPVAL 23147 . 
23557) (I.NOUNDO 23559 . 23914)) (23917 25103 (I.ATOMNUMBER 23927 . 24145) (I.FIXUPNUM 24147 . 24576) 
(I.FIXUPPTR 24578 . 25101)) (25104 28340 (MKI.ATOM 25114 . 25553) (MKI.IEEE 25555 . 28338)) (28341 
29812 (MKI.DSET 28351 . 28955) (MKI.ADDTO 28957 . 29249) (MKI.PUTPROP 29251 . 29810)))))
STOP