;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 126.74
;;; Reason:
;;;  Enhanced previous patch to DEFCONSTANT to be robust if the value form
;;;  is not evaluable at compile time.  There is still potential backward
;;;  incompatibility if the form is evaluable but the value cannot be
;;;  fasdumped, e.g. it contains a package or stream object.  Caveat!
;;; Written 9-Sep-88 21:59:14 by smh at site Gigamos Cambridge
;;; while running on Alex from band 3
;;; with Experimental System 126.73, ZWEI 125.20, ZMail 73.2, Local-File 75.2, File-Server 24.1, Unix-Interface 13.0, Tape 24.2, Lambda-Diag 17.0, microcode 1762, SDU Boot Tape 3.12, SDU ROM 102, K30aug.



; From modified file DJ: L.SYS2; LMMAC.LISP#467 at 9-Sep-88 21:59:26
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; LMMAC  "

(DEFMACRO DEFCONSTANT (VARIABLE INITIAL-VALUE . ARGS)
  "Define a special variable which will never be changed, and the compiler may assume so.
It is set unconditionally to the value of INITIAL-VALUE.
DOCUMENTATION is available if the user asks for the documentation of the symbol VARIABLE."
  (DECLARE (ARGLIST VARIABLE INITIAL-VALUE &OPTIONAL DOCUMENTATION))
  `(PROGN (EVAL-WHEN (COMPILE)
	    (PROCLAIM '(SPECIAL ,VARIABLE))
	    ;; The following added 22aug88 by smh.
	    ;; The CATCH-ERROR checks that the value form evaluates without error.
	    ;; We allow this without comment, although arguably if the value form *won't*
	    ;; evaluate, the user probably wants to find out about it because he has
	    ;; loaded files in the wrong order, or some such lossage.
	    ;; There is potential lossage if the compile-time value is something that
	    ;; can't be fasdumped, like a stream or package.
	    (catch-error
	      (putdecl ',variable 'compiler:constant-for-compilation (list ,initial-value))
	      nil))
	  (EVAL-WHEN (LOAD EVAL)
	    (DEFPROP ,VARIABLE T SYSTEM-CONSTANT))
	  (EVAL-WHEN (LOAD EVAL)
	    (DEFCONST-1 ,VARIABLE ,INITIAL-VALUE . ,ARGS))))

))