;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.18
;;; Reason:
;;;  Patch to evaluator by GJC and KMC:
;;;    1. Changes made to evaluator using VARIABLE-GLOBALLY-SPECIAL-P were done
;;;       incorrectly -- GETL was wrapped around it in INTERPRETER-VALUE-CELL-LOCATION
;;;       which causes an error on. e.g., (eval '(variable-boundp *foo*))
;;;    2. Changed PROCLAIMED-SPECIAL-P to a DEFSUBST, eliminating a function call on every
;;;       special variable reference
;;; Written 22-Sep-87 18:08:14 by pld at site LMI Cambridge
;;; while running on Death from band 2
;;; with Experimental System 123.17, Experimental Local-File 73.0, Experimental FILE-Server 22.0, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.0, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, microcode 1754, SDU Boot Tape 3.13, SDU ROM 102.



; From modified file DJ: L.SYS; EVAL.LISP#178 at 22-Sep-87 18:09:12
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; EVAL  "

(defsubst proclaimed-special-p (symbol)
  (cadr (getl symbol variable-special-properties)))

))

; From modified file DJ: L.SYS; EVAL.LISP#178 at 22-Sep-87 18:11:06
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; EVAL  "

(defsubst variable-globally-special-p (variable)
  (proclaimed-special-p variable))

))

; From modified file DJ: L.SYS; EVAL.LISP#178 at 22-Sep-87 18:13:01
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; EVAL  "

(defun interpreter-symeval (symbol)
  (declare (dbg:uninteresting-function eval))
  (do ((tail *interpreter-variable-environment* (cdr tail))
       (loc (locf (symbol-value symbol)))
       tem)
      ((atom tail)				;assume free references are special
       (if (or tail
	       (variable-globally-special-p symbol))
	   (symbol-value symbol)
	 (var-not-special symbol "evaluate it" t #'symbol-value)))
    (when (setq tem (get-lexical-value-cell (car tail) loc))
      (return (contents tem)))))

))

; From modified file DJ: L.SYS; EVAL.LISP#178 at 22-Sep-87 18:14:51
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; EVAL  "

(defun interpreter-value-cell-location (symbol)
  (declare (dbg:uninteresting-function))
  (do ((tail *interpreter-variable-environment* (cdr tail))
       (loc (locf (symbol-value symbol)))
       tem)
      ((atom tail)				;assume free references are special
       (if (or tail (variable-globally-special-p symbol))
	   (%external-value-cell symbol)
	 (var-not-special symbol "find its value cell" nil #'value-cell-location)))
    (when (setq tem (get-lexical-value-cell (car tail) loc))
      (return (follow-cell-forwarding tem t)))))

))

; From modified file DJ: L.SYS; EVAL.LISP#178 at 22-Sep-87 18:15:20
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; EVAL  "

(defun eval (form &optional nohook)
  "Evaluate FORM in the global environment, returning its value(s).
Free variables in FORM must be special.
If there is an *EVALHOOK*, it is invoked to do the work, unless NOHOOK is true."
  (binding-interpreter-environment (())
    (cond ((and *evalhook* (not nohook))
	   (let ((tem *evalhook*)
		 (*evalhook* nil)
		 (*applyhook* nil))
	     (with-current-interpreter-environment (env)
	       (funcall tem form env))))
	  ((symbolp form)
	   (if (or (keywordp form) (variable-globally-special-p form))
	       (symbol-value form)
	     (var-not-special form "evaluate it" t #'symbol-value)))
	  ((atom form) form)
	  (t
	   (eval1 form)))))

))