;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.102
;;; Reason:
;;;  Forms returned by DEFSTRUCT, for structures that include byte fields, no
;;;  longer include pre-digested (numeric constant) byte specifiers.  That
;;;  was not portable.  The new behaviour is, in a way, more consistent with
;;;  documentation describing how byte fields are computed.
;;;  
;;;  Tests indicate that this change does not affect behaviour of DEFSTRUCT.
;;;  (Testing also revealed other severe bugs in this feature.)
;;; Written 6-Oct-88 17:04:26 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 3
;;; with Experimental System 126.101, Experimental ZWEI 126.14, Experimental ZMail 74.8, 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 103.



; From modified file DJ: L.SYS2; STRUCT.LISP#338 at 6-Oct-88 17:04:27
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; STRUCT  "

(DEFUN DEFSTRUCT-PARSE-ONE-FIELD (IT NUMBER PPSS REST CONC-NAME #+MACLISP-10 CHARS
				  &OPTIONAL SLOT-DESCRIPTION)
  (LET* ((MNAME (IF CONC-NAME #+MACLISP-10 (IMPLODE (APPEND CHARS (EXPLODEN IT)))
			      #-MACLISP-10 (DEFSTRUCT-APPEND-SYMBOLS CONC-NAME IT)
		    IT))
	 (TYPE T) (ALIST NIL) (READ-ONLY NIL) (BITS NIL) (DOCUMENTATION NIL)
	 TYPEP INITP DOCP ROP
	 (INIT-CODE (IF (NULL REST) (DEFSTRUCT-MAKE-EMPTY)
		      (SETQ INITP T)
		      (DO ((L (CDR REST) (CDDR L)))
			  ((NULL L) (CAR REST))
			(SELECTQ (CAR L)
			  (:DOCUMENTATION (SETQ DOCUMENTATION (CADR L) DOCP T))
			  (:READ-ONLY (SETQ READ-ONLY (CADR L) ROP T))
			  (:TYPE (SETQ TYPE (CADR L) TYPEP T))
			  (T (DEFSTRUCT-ERROR
			       "Unknown DEFSTRUCT slot-option" (CAR L))))))))
    ;;;;;;How to lose when porting between machines that
    ;;;;;;have differing representations for byte specs:
    ;;;
    ;;; (LET (PP SS)
    ;;; (IF (LIST-MATCH-P PPSS `(BYTE ,SS ,PP)) (SETQ PPSS
    ;;;	  (BYTE SS PP))))
    ;;;;;;
    (IF (NULL SLOT-DESCRIPTION)
	(CONS IT (MAKE-DEFSTRUCT-SLOT-DESCRIPTION
		   :NUMBER NUMBER
		   :PPSS PPSS
		   :INIT-CODE INIT-CODE
		   :REF-MACRO-NAME MNAME
		   :TYPE TYPE
		   :PROPERTY-ALIST ALIST
		   :READ-ONLY READ-ONLY
		   :BITS BITS
		   :DOCUMENTATION DOCUMENTATION))
      (SETF (DEFSTRUCT-SLOT-DESCRIPTION-REF-MACRO-NAME) MNAME)
      (if ppss
	  (setf (defstruct-slot-description-ppss) ppss))
      (IF INITP (SETF (DEFSTRUCT-SLOT-DESCRIPTION-INIT-CODE) INIT-CODE))
      (IF DOCP  (SETF (DEFSTRUCT-SLOT-DESCRIPTION-DOCUMENTATION) DOCUMENTATION))
      (IF TYPEP (IF (SUBTYPEP TYPE (LET ((TEM (DEFSTRUCT-SLOT-DESCRIPTION-TYPE)))
				     (IF (EQ TEM 'NOTYPE) T TEM)))
		    (SETF (DEFSTRUCT-SLOT-DESCRIPTION-TYPE) TYPE)
		  (DEFSTRUCT-ERROR
		    "The slot :TYPE specified is incompatible with the :INCLUDEd slot type"
		    IT)))
      (IF ROP (IF (AND (DEFSTRUCT-SLOT-DESCRIPTION-READ-ONLY) (NOT READ-ONLY))
		  (DEFSTRUCT-ERROR "A slot is not :READ-ONLY, but the :INCLUDEd slot is"
				   IT)
		(SETF (DEFSTRUCT-SLOT-DESCRIPTION-READ-ONLY) READ-ONLY))))))

))