;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.270
;;; Reason:
;;;  When you redefined a flavor and changed the :default-handler, the
;;;  old default-handler was retained.
;;; Written 11-May-88 11:04:20 by pld at site Gigamos Cambridge
;;; while running on Azathoth from band 3
;;; with Experimental System 123.269, Experimental Local-File 73.5, Experimental FILE-Server 22.5, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.2, Experimental Lambda-Diag 15.0, Experimental Tape 22.4, microcode 1756, SDU Boot Tape 3.14, SDU ROM 8, the old ones.


; From modified file DJ: L.SYS2; FLAVOR.LISP#317 at 11-May-88 11:14:01
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; FLAVOR  "

(DEFUN COMPOSE-FLAVOR-INITIALIZATIONS (FL &AUX ALIST
				       REMAINING-DEFAULT-PLIST ALL-INITTABLE-IVARS
				       AREA-FUNCTION REQUIRED-INIT-KEYWORDS
				       remaining-init-keywords
				       unhandled-init-keywords)
  (SETQ ALL-INITTABLE-IVARS (MAKE-LIST (LENGTH (FLAVOR-ALL-INSTANCE-VARIABLES FL))
				      :AREA (IF *JUST-COMPILING* DEFAULT-CONS-AREA
					       BACKGROUND-CONS-AREA)))
  (setf (flavor-default-handler fl) nil)
  ;; First make the mask saying which ivars can be initted by init kywords.
  (DOLIST (FFL (FLAVOR-DEPENDS-ON-ALL FL))
    (LET ((FFL (COMPILATION-FLAVOR FFL)))
      (OR AREA-FUNCTION
	  (SETQ AREA-FUNCTION (FLAVOR-GET FFL :INSTANCE-AREA-FUNCTION)))
      (SETQ REQUIRED-INIT-KEYWORDS
	    (UNION-EQ REQUIRED-INIT-KEYWORDS (FLAVOR-GET FFL :REQUIRED-INIT-KEYWORDS)))
      (OR (FLAVOR-DEFAULT-HANDLER FL)
	  (SETF (FLAVOR-DEFAULT-HANDLER FL)
		(GETF (FLAVOR-PLIST FFL) :DEFAULT-HANDLER)))
      (DOLIST (IIV (FLAVOR-INITTABLE-INSTANCE-VARIABLES FFL))
	(LET ((INDEX (FIND-POSITION-IN-LIST (CDR IIV) (FLAVOR-ALL-INSTANCE-VARIABLES FL))))
	  (AND INDEX
	       (SETF (NTH INDEX ALL-INITTABLE-IVARS)
		     (CAR IIV)))))))
  (SETQ REMAINING-INIT-KEYWORDS    
	(SUBSET-NOT #'MEMQ (FLAVOR-ALLOWED-INIT-KEYWORDS FL)
		    (CIRCULAR-LIST ALL-INITTABLE-IVARS)))
  (PUSHNEW :ALLOW-OTHER-KEYS REMAINING-INIT-KEYWORDS :TEST 'EQ)
  (SETF	(FLAVOR-REMAINING-INIT-KEYWORDS FL) REMAINING-INIT-KEYWORDS)
  ;; Then look at all the default init plists, for anything there
  ;; that initializes an instance variable.  If it does, make an entry on ALIST.
  ;; Any that doesn't initialize a variable, put on the "remaining" list.
  (DOLIST (FFL (FLAVOR-DEPENDS-ON-ALL FL))
    (SETQ FFL (COMPILATION-FLAVOR FFL))
    (DO ((L (GETF (FLAVOR-PLIST FFL) :DEFAULT-INIT-PLIST) (CDDR L))) ((NULL L))
      (LET* ((KEYWORD (CAR L)) (ARG (CADR L))
	     (INDEX (FIND-POSITION-IN-LIST KEYWORD ALL-INITTABLE-IVARS)))
	;; Remove this keyword from the list of required ones,
	;; since it is cannot ever be missing.
	(SETQ REQUIRED-INIT-KEYWORDS
	      (DELQ KEYWORD REQUIRED-INIT-KEYWORDS))
	(IF INDEX
	    ;; This keyword initializes an instance variable,
	    ;; so record an initialization of that variable if none found yet.
	    (OR (ASSQ INDEX ALIST)
		(PUSH (LIST INDEX ARG)
		      ALIST))
	  ;; This keyword does not just initialize an instance variable.
	  (UNLESS (GET (LOCF REMAINING-DEFAULT-PLIST) KEYWORD)
	    (PUTPROP (LOCF REMAINING-DEFAULT-PLIST) ARG KEYWORD))
	  (UNLESS (MEMQ KEYWORD REMAINING-INIT-KEYWORDS)
	    (PUSHNEW KEYWORD UNHANDLED-INIT-KEYWORDS))
	  ;;(IF (MEMQ KEYWORD (FLAVOR-REMAINING-INIT-KEYWORDS FL))
	  ;;    (OR (GET (LOCF REMAINING-DEFAULT-PLIST) KEYWORD)
	  ;;        (PUTPROP (LOCF REMAINING-DEFAULT-PLIST) ARG KEYWORD))
	  ;;  (FERROR "The flavor ~S has keyword ~S in its default init plist, but doesn't handle it" (FLAVOR-NAME FL) KEYWORD))
	  ))))
  (SETF (FLAVOR-UNHANDLED-INIT-KEYWORDS FL) UNHANDLED-INIT-KEYWORDS)
  ;; Then, look for default values provided in list of instance vars.
  (DOLIST (FFL (FLAVOR-DEPENDS-ON-ALL FL))
    (SETQ FFL (COMPILATION-FLAVOR FFL))
    (DOLIST (V (FLAVOR-LOCAL-INSTANCE-VARIABLES FFL))
      (AND (NOT (ATOM V))
	   ;; When we find one, put it in if there is no init for that variable yet.
	   (LET ((INDEX (FIND-POSITION-IN-LIST (CAR V) (FLAVOR-ALL-INSTANCE-VARIABLES FL))))
	     (AND (NOT (ASSQ INDEX ALIST))
		  (PUSH (LIST INDEX
			      (CADR V))
			ALIST))))))
  (IF AREA-FUNCTION
      (SETF (GETF (FLAVOR-PLIST FL) 'INSTANCE-AREA-FUNCTION) AREA-FUNCTION)
    (REMF (FLAVOR-PLIST FL) 'INSTANCE-AREA-FUNCTION))
  (IF REQUIRED-INIT-KEYWORDS
      (SETF (GETF (FLAVOR-PLIST FL) 'REQUIRED-INIT-KEYWORDS) REQUIRED-INIT-KEYWORDS)
    (REMF (FLAVOR-PLIST FL) 'REQUIRED-INIT-KEYWORDS))
  (SETF (FLAVOR-INSTANCE-VARIABLE-INITIALIZATIONS FL) ALIST)
  (SETF (FLAVOR-REMAINING-DEFAULT-PLIST FL) REMAINING-DEFAULT-PLIST)
  (SETF (FLAVOR-ALL-INITTABLE-INSTANCE-VARIABLES FL) ALL-INITTABLE-IVARS))

))