;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.111
;;; Reason:
;;;  Improve checking of byte field slots; warn if more than one defined
;;;  (it can break the constructor badly!); don't assume a slot is a CONS!
;;; Written 14-Oct-88 20:09:58 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 3
;;; with Experimental System 126.108, Experimental ZWEI 126.19, Experimental ZMail 74.9, Experimental Local-File 76.0, Experimental File-Server 25.0, Experimental Lambda-Diag 18.0, Experimental Unix-Interface 15.0, Experimental Tape 26.4, Experimental IMicro 20.0, microcode 1762, SDU Boot Tape 3.14, SDU ROM 103.



; From modified file DJ: L.SYS; QCOPT.LISP#188 at 14-Oct-88 20:09:59
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCOPT  "

(defun defstruct-check-valid-byte-fields (form)
  (let ((slots (cddr form)))
    (dolist (slot slots)
      (when (and (consp slot) (consp (car slot)))
	(dolist (subslot slot)
	  (and (consp subslot) (second subslot)
	       (let ((flag (check-byte-spec subslot nil nil)))
		 (when flag
		   (return (defstruct-check-warn :not-portable
			     "invalid byte spec -- ~A" flag))))))))))

))

; From modified file DJ: L.SYS; QCOPT.LISP#188 at 14-Oct-88 20:16:01
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCOPT  "

  
(defun defstruct-check-no-byte-fields (form)
  (let ((slots (cddr form)))
    (dolist (slot slots)
      (when (and (consp slot) (consp (car slot)))		;probably a byte field
	(return (defstruct-check-warn :not-portable
		  "contains subslot fields (this may not be portable)"))))))

))

; From modified file DJ: L.SYS; QCOPT.LISP#188 at 14-Oct-88 20:16:06
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCOPT  "


(defun defstruct-check-valid-byte-fields (form)
  (let ((slots (cddr form)))
    (dolist (slot slots)
      (when (and (consp slot) (consp (car slot)))	;probably a byte field
	(let (whole-word-slot)
	  (dolist (subslot slot)
	    (and (consp subslot)
		 (cond
		   ((second subslot)
		    (let ((flag (check-byte-spec subslot nil nil)))
		      (when flag
			(return (defstruct-check-warn :not-portable
				  "invalid byte spec -- ~A" flag)))))
		   (whole-word-slot
		    (return (defstruct-check-warn :implausible
			      "more than one whole-word byte field slot specified")))
		   (t (setq whole-word-slot t))))))))))

))