;;; -*- 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)))) ))