;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 121.39
;;; Reason:
;;;  SI::PROCLAIM-SPECIAL, SI::PROCLAIM-UNSPECIAL, SI::PROCLAIMED-SPECIAL-P
;;;  to deal with global specialness, now uses plist as before, but may change
;;;  in the future.
;;; Written 4-Mar-87 09:22:35 by jrm (Joe Marshall) at site LMI Cambridge
;;; while running on Lambda Four A from band 2
;;; with Experimental System 121.38, Experimental Lambda-Diag 15.0, Experimental ZMail 70.2, Experimental KERMIT 32.0, Experimental Unix-Interface 10.0, Experimental Local-File 72.0, Experimental FILE-Server 21.0, Experimental Tape 13.0, microcode 1742, SDU Boot Tape 3.14, SDU ROM 102, 121.35.



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

(defun proclaim-special (symbol)
  (setf (get symbol 'special) t))

))

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

(defun proclaimed-special-p (symbol)
  (get symbol 'special))

))

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

(defun var-not-special (symbol attempt must-be-bound-p special-function &rest additional-args)
  (declare (dbg:error-reporter))
  (if *all-free-interpreter-variable-references-special*
      (apply special-function symbol additional-args)
    (signal-proceed-case ((val) 'free-variable-reference
				:symbol symbol
				:attempt attempt
				:must-be-bound-p must-be-bound-p)
      (:new-value
       val)
      (:use-dynamic-value
       (apply special-function symbol additional-args))
      (:make-special
       (proclaim-special symbol)
       (apply special-function symbol additional-args)))))

))


; From modified file DJ: L.SYS; EVAL.LISP#174 at 4-Mar-87 09:25:20
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; EVAL  "

(defun proclaim (&rest declarations &aux d)
  "Make DECLARATIONS be in effect globally.
Only SPECIAL declarations make sense to do this way,
and they are better made using DEFVAR or DEFPARAMETER."
  (dolist (decl declarations)
    (if (or (atom decl) (not (atom (setq d (car decl)))))
	(ferror "~S is an invalid declaration" decl)
      (case d
	(special
	 (dolist (x (cdr decl))
	   ;; Gag me with type check!!
;	   ;; getf of symbol-plist is for the symbolp check inherent in symbol-plist
;	   (setf (getf (symbol-plist x) 'special) t))
	   (check-type x symbol)
	   (proclaim-special x)))
	(unspecial
	 (dolist (x (cdr decl))
	   (check-type x symbol)
	   (proclaim-unspecial x)))
	(inline
	 )
	(notinline
	 )
	(declaration
	 (dolist (x (cdr decl))
	   (pushnew `(,(car decl) ignore) *interpreter-declaration-type-alist*
		    :test #'eq :key #'car)))
	(t
	 (cond ((get d 'debug-info))
	       ((assq d *interpreter-declaration-type-alist*))
	       (t (cerror "Ignore it" "~S is an unknown declaration" decl)))
	 ;; else do nothing...
	 ))))
  nil)

))

; From modified file DJ: L.SYS; EVAL.LISP#174 at 4-Mar-87 09:26:30
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; EVAL  "

(defun proclaim-unspecial (symbol)
  (remf (get symbol 'special) t))

))