;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.122
;;; Reason:
;;;  For CL defstructs of (:type vector) that generate the so-called type
;;;  PHONY-VECTOR structure, the type predicate was expanding into something
;;;  that blew up calling ZEROP with two arguments.  Simple fix to the
;;;  DEFSUBST.  -Keith
;;; Written 29-Jun-88 19:24:11 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 1
;;; with Experimental System 124.121, Experimental Local-File 74.3, Experimental File-Server 23.1, Unix-Interface 12.0, Experimental ZMail 72.1, Experimental Tape 23.6, Experimental Lambda-Diag 16.2, Tiger 28.0, microcode 1761, SDU Boot Tape 3.14, SDU ROM 103, Beta 3 plus patches.



; From modified file DJ: L.SYS2; STRUCT.LISP#337 at 29-Jun-88 19:24:12
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; STRUCT  "

(DEFSTRUCT-DEFINE-TYPE :PHONY-NAMED-VECTOR
  (:CONS-KEYWORDS :MAKE-ARRAY :SUBTYPE)
  (:OVERHEAD 1)
  (:DEFSTRUCT-KEYWORDS :MAKE-ARRAY :SUBTYPE)
  (:DEFSTRUCT (DESCRIPTION)
    (DEFSTRUCT-HACK-ARRAY-SUPERTYPE DESCRIPTION))
  (:CONS (ARG DESCRIPTION ETC) :ALIST
    ETC
    (SIMPLER-VECTOR-CONS-FOR-DEFSTRUCT
      ARG DESCRIPTION #'(LAMBDA (V) `(SETF (AREF ,V 0) ',(DEFSTRUCT-DESCRIPTION-NAME)))))
  (:REF (N DESCRIPTION ARG)
    `(,(SELECT-AREF-FORM DESCRIPTION) ,ARG ,(+ N 1)))
  (:PREDICATE (DESCRIPTION NAME)
    `(DEFSUBST ,NAME (X)
       (AND (VECTORP X) (NOT (ZEROP (ARRAY-LENGTH X)))
	    (EQ (AREF X 0) ',(DEFSTRUCT-DESCRIPTION-NAME))))))

))