;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.9
;;; Reason:
;;;  Implements some new #+ and #- syntax for cross compilation:
;;;    #+(TARGET FOO)  looks for FOO on COMPILER:*TARGET-FEATURES*
;;;  For symmetry and completeness:
;;;    #-(LOCAL FOO)   looks for FOO on *FEATURES*
;;; Written 3-Aug-88 12:48:45 by smh (Steve Haflich) at site Gigamos Cambridge
;;; while running on Harpo from band 1
;;; with ZWEI 125.9, ZMail 73.0, Local-File 75.1, File-Server 24.1, Unix-Interface 13.0, Tape 24.2, Lambda-Diag 17.0, Experimental System 126.7, microcode 1761, SDU Boot Tape 3.12, SDU ROM 102, 126.2 + k-sys.



; From modified file DJ: L.IO; READ.LISP#467 at 3-Aug-88 12:48:52
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; READ  "

(DEFUN XR-FEATURE-PRESENT (FEATURE &optional (feature-list *features*))
  (COND ((SYMBOLP FEATURE)
	 ;; recent common-lisp flamage claims that this should be memq, not member :test #'string=
	 ;;  Personally, I can't think of a more poorly-designed advertised feature in the
	 ;;  clisp manual than *features* and *modules*
	 (MEMQ FEATURE feature-list))
	((NUMBERP FEATURE)
	 (MEMBER-EQL FEATURE feature-list))
	((ATOM FEATURE)
	 (READ-ERROR "Unknown form ~S in #+ or #- feature list." FEATURE))
	((EQ (CAR FEATURE) :NOT)
	 (NOT (XR-FEATURE-PRESENT (CADR FEATURE) feature-list)))
	((EQ (CAR FEATURE) :AND)
	 (loop for f in (cdr feature)
	       always (XR-FEATURE-PRESENT f feature-list)))
	((EQ (CAR FEATURE) :OR)
	 (loop for f in (cdr feature)
	       thereis (XR-FEATURE-PRESENT f feature-list)))
	((eq (car feature) :PACKAGE-ROOT-NAME)	;extension, 7/18/87, RG.
	 (string-equal (si:package-root-name *previous-package*)
		       (cadr feature)))
	((eq (car feature) :target)		;cross compilation extension - 3aug88 smh
	 (xr-feature-present (cadr feature) compiler:*target-features*))
	((eq (car feature) :local)		;cross compilation extension - 3aug88 smh
	 (xr-feature-present (cadr feature) *features*))
	(T (READ-ERROR "Unknown form ~S in #+ or #- feature list." FEATURE))))

))