;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.95
;;; Reason:
;;;  New variable to support cross compilation: COMPILER:*TARGET-COMPUTER*
;;; Written 29-Sep-88 08:59:03 by smh at site Gigamos Cambridge
;;; while running on Alex from band 3
;;; with Experimental System 126.92, Experimental ZWEI 126.13, Experimental ZMail 74.1, Experimental Local-File 76.0, Experimental File-Server 25.0, Experimental Lambda-Diag 18.0, Experimental Unix-Interface 15.0, Experimental Tape 26.4, microcode 1762, SDU Boot Tape 3.14, SDU ROM 102, Lambda/Falcon Development System.



; From modified file DJ: L.SYS; QCDEFS.LISP#255 at 29-Sep-88 09:00:05
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCDEFS  "

(defvar-resettable *host-computer* 'lambda-interface 'lambda-interface)	; ||| 29sep88 smh

))

; From modified file DJ: L.SYS; QFCTNS.LISP#855 at 29-Sep-88 09:00:12
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFCTNS  "

(DEFUN GETDECL (NAME PROP)
  "GET, for macro expansion and compilation.
Allows the actual property of NAME to be overridden
by a local declaration (prop name value)
such as PUTDECL or DEFDECL would create.
NAME may be any symbol or function spec."
  (DOLIST (DECL LOCAL-DECLARATIONS)
    (AND (EQ (CAR DECL) PROP)
	 (EQUAL (CADR DECL) NAME)
	 (RETURN-from getdecl (CADDR DECL))))
  (when (boundp 'compiler:*compilation-environment*)
    (do ((env compiler:*compilation-environment* (compiler:compilation-environment-next env)))
	((null env))
      (multiple-value-bind (val foundp)
	  (gethash name (compiler:compilation-environment-plist-hashtab env))
	(when foundp
	  (setq val (getf val prop))		;what about property of NIL ???
	  (when val (return-from getdecl val))))))
  #+never
  (DOLIST (DECL FILE-LOCAL-DECLARATIONS)
    (AND (EQ (CAR DECL) PROP)
	 (EQUAL (CADR DECL) NAME)
	 (RETURN (CADDR DECL))))
  ;; The AND clause added to keep the cross compiler from seeing inappropriate DEFTYPE and
  ;; SETF-METHOD definitions from the compiling host. ||| smh 28sep88
  (and (eq compiler:*host-computer* compiler:*target-computer*)
       (IF (SYMBOLP NAME)
	   (GET NAME PROP)
	 (FUNCTION-SPEC-GET NAME PROP))))

))
