(FILECREATED " 2-NOV-79 10:40:54" <LISPUSERS>LOADTIMECONSTANT.;6
 3030   

     changes to:  LOADTIMECONSTANTCOMS (LOADTIMECONSTANT MAXCMACRO) LTCDEFC LTCMAC

     previous date: "11-MAY-79 10:55:47" <LISPUSERS>LOADTIMECONSTANT.;5)


(PRETTYCOMPRINT LOADTIMECONSTANTCOMS)

(RPAQQ LOADTIMECONSTANTCOMS
 ((FNS LTCDEFC LTCMAC)
			     (MACROS CONSTANT LOADTIMECONSTANT)
			     (P (CHANGENAME (QUOTE LAPBLOCK)
					    (QUOTE DEFC)
					    (QUOTE LTCDEFC))
				(CHANGENAME (QUOTE BINRD)
					    (QUOTE DEFC)
					    (QUOTE LTCDEFC))
				(MOVD? (QUOTE CONSTANT)
				       (QUOTE LOADTIMECONSTANT)))
			     (PROP MAXCMACRO LOADTIMECONSTANT)))
(DEFINEQ

(LTCDEFC

  (LAMBDA (NM DF) (* DECLARATIONS: 
                     (BLOCKRECORD IBOX ((I INTEGER))))      (* rmk: " 6-MAY-79 18:15")


          (* Called instead of DEFC from LAPBLOCK and BINRD. Sweeps through the code array and evaluates load-time constants, 

	  then calls DEFC to do the store.)



    (bind
 L (J _(CONSTANT (IPLUS 100000)))
	  (END _(LASTLIT+1 DF)) first
 (replace
 I of
 J with
 (SUB1 (FIRSTLIT DF)))
       while
 (ILESSP (add
 (fetch
 I of
 J)
			  1)
		     END)
       do
                                                   (* Test on atom instead of string to avoid string 

							    collections when loading)

	  (COND
	    ((EQ (QUOTE LoadTimeConstant)
		 (CAR (LISTP (SETQ L (FNOPENRA DF J)))))
	      (FNCLOSERA DF J (EVAL (CDR L)))))
	  (COND
	    ((EQ (QUOTE LoadTimeConstant)
		 (CAR (LISTP (SETQ L (FNOPENRD DF J)))))
	      (FNCLOSERD DF J (EVAL (CDR L))))))
    (DEFC NM DF)))

(LTCMAC

  (LAMBDA (FORM)                                            (* rmk: "11-MAY-79 10:55")

                                                            (* Produces (perhaps) a copy of FORM with translations 

							    replacing clisp.)

    (SETQ FORM (OR (GETHASH FORM CLISPARRAY)
		   FORM))
    (COND
      ((AND (LISTP FORM)
	    (FMEMB (ARGTYPE (CAR FORM))
		   (QUOTE (0 2))))
	                                                    (* Probably should take translations for open lambda's 

							    too.)

	(CONS (CAR FORM)
	      (for
 F in
 (CDR FORM) collect
 (LTCMAC
 F))))
      (T FORM))))
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS CONSTANT MACRO
 (MACROX (PROG ((VAL (APPLY (QUOTE PROG1)
						    MACROX)))
				       (RETURN (COND
						 ((CONSTANTOK VAL)
						   (KWOTE VAL))
						 (T (CONS (QUOTE LOADTIMECONSTANT)
							  MACROX)))))))

(PUTPROPS LOADTIMECONSTANT MACRO
 (ARGS (KWOTE (CONS (QUOTE LoadTimeConstant)
						    (LTCMAC (CAR ARGS))))))
)
(CHANGENAME (QUOTE LAPBLOCK)
	    (QUOTE DEFC)
	    (QUOTE LTCDEFC))
(CHANGENAME (QUOTE BINRD)
	    (QUOTE DEFC)
	    (QUOTE LTCDEFC))
(MOVD? (QUOTE CONSTANT)
       (QUOTE LOADTIMECONSTANT))

(PUTPROPS LOADTIMECONSTANT MAXCMACRO
 (X (KWOTE (CONS LOADTIMECONSTANT (LTCMAC (CAR X))))))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (669 2326 (LTCDEFC 681 . 1668) (LTCMAC 1672 . 2323)))))
STOP