rel-7-2 patches need a patch!

[rich%linus@mitre-bedford.ARPA]

We have a system which uses clos and also DEFSTRUCTs.  Seems that
your patch to COMPILE-FROM-STREAM-1 is missing the clause about
MULTIPLE-DEFINITIONS, which causes the compilation of DEFSTRUCT
to get all upset about DEFUNs and EVAL-WHENs not at the top level.

The patch should really be as follows.  The added clause has the
comment "THIS CLAUSE NEEDS TO BE ADDED" before it.

;;; -*- Package: COMPILER; Mode: LISP; Syntax: Zetalisp -*-

(DEFUN COMPILE-FROM-STREAM-1 (FORM &OPTIONAL (COMPILE-TIME-TOO NIL))
  (CATCH-ERROR-RESTART (SYS:ERROR "Skip compiling form
~2,2\COMPILER:SHORT-S-FORMAT\" FORM)
    (LET ((DEFAULT-CONS-AREA (FUNCALL *COMPILE-FUNCTION* ':CONS-AREA)))
      (LET ((ERROR-MESSAGE-HOOK
	      #'(LAMBDA ()
		  (DECLARE (SYS:DOWNWARD-FUNCTION))
		  (FORMAT T "~&While processing ~V,V\COMPILER:SHORT-S-FORMAT\"
			  DBG:*ERROR-MESSAGE-PRINLEVEL*
			  DBG:*ERROR-MESSAGE-PRINLENGTH*
			  FORM))))
	(SETQ FORM (FUNCALL *COMPILE-FUNCTION* ':MACRO-EXPAND FORM)))
      (WHEN (LISTP FORM)			;Ignore atoms at top-level
	(LET ((FUNCTION (FIRST FORM)))
	  (SELECTQ FUNCTION
	    ((QUOTE))				;and quoted constants e.g. 'COMPILE
	    ((PROGN)
	     (DOLIST (FORM (CDR FORM))
	       (COMPILE-FROM-STREAM-1 FORM COMPILE-TIME-TOO)))
	    ((EVAL-WHEN)
	     (SI:CHECK-EVAL-WHEN-TIMES (CADR FORM))
	     (LET ((COMPILE-P (OR (MEMQ 'COMPILE (CADR FORM))
				  (AND COMPILE-TIME-TOO (MEMQ 'EVAL (CADR FORM)))))
		   (LOAD-P (OR (MEMQ 'LOAD (CADR FORM)) (MEMQ 'CL:LOAD (CADR FORM))))
		   (FORMS (CDDR FORM)))
	       (COND (LOAD-P
		      (DOLIST (FORM FORMS)
			(COMPILE-FROM-STREAM-1 FORM (AND COMPILE-P ':FORCE))))
		     (COMPILE-P
		      (DOLIST (FORM FORMS)
			(FUNCALL *COMPILE-FORM-FUNCTION* FORM ':FORCE NIL))))))
	    ((DEFUN)
	     (LET ((TEM (DEFUN-COMPATIBILITY (CDR FORM) :WARN-IF-OBSOLETE T)))
	       (IF (EQ (CDR TEM) (CDR FORM))
		   (FUNCALL *COMPILE-FORM-FUNCTION* FORM COMPILE-TIME-TOO T)
		   (COMPILE-FROM-STREAM-1 TEM COMPILE-TIME-TOO))))
	    ((MACRO)
	     (FUNCALL *COMPILE-FORM-FUNCTION* FORM (OR COMPILE-TIME-TOO T) T))
	    ((DECLARE)
	     (DOLIST (FORM (CDR FORM))
	       (FUNCALL *COMPILE-FORM-FUNCTION* FORM (OR COMPILE-TIME-TOO T)
			;; (DECLARE (SPECIAL ... has load-time action as well.
			;; All other DECLARE's do not.
			(MEMQ (CAR FORM) '(SPECIAL ZL:UNSPECIAL)))))
	    ((COMPILER-LET)
	     (COMPILER-LET-INTERNAL (CADR FORM) (CDDR FORM)
				    #'COMPILE-FROM-STREAM-1 COMPILE-TIME-TOO))
	    ((SI:DEFINE-SPECIAL-FORM)
	     (FUNCALL *COMPILE-FORM-FUNCTION* FORM COMPILE-TIME-TOO T))
;;;  **************** THIS CLAUSE NEEDS TO BE ADDED  ************************
	    ((MULTIPLE-DEFINITION)
	     (DESTRUCTURING-BIND (NAME TYPE . BODY) (CDR FORM)
	       (LET ((NAME-VALID (AND (NOT (NULL NAME))
				      (OR (SYMBOLP NAME)
					  (AND (LISTP NAME) (NEQ (CAR NAME) 'QUOTE)))))
		     (TYPE-VALID (AND (NOT (NULL TYPE)) (SYMBOLP TYPE))))
		 (UNLESS (AND NAME-VALID TYPE-VALID)
		   (WARN "(~S ~S ~S ...) is invalid because~@
			  ~:[~S is not valid as a definition name~;~*~]~
			  ~:[~&~S is not valid as a definition type~;~*~]"
			 'MULTIPLE-DEFINITION NAME TYPE NAME-VALID NAME TYPE-VALID TYPE)))
	       (LET* ((COMPILED-BODY NIL)
		      (COMPILE-FUNCTION *COMPILE-FUNCTION*)
		      (*COMPILE-FUNCTION*
			(LAMBDA (OPERATION &REST ARGS)
			  (DECLARE (SYS:DOWNWARD-FUNCTION))
			  (SELECTQ OPERATION
			    (:DUMP-FORM
			     (PUSH (FUNCALL COMPILE-FUNCTION :OPTIMIZE-TOP-LEVEL-FORM
					    (FIRST ARGS))
				   COMPILED-BODY))
			    (:INSTALL-DEFINITION
			     (PUSH (FORM-FOR-DEFINE *COMPILER* (FIRST ARGS) (SECOND ARGS))
				   COMPILED-BODY))
			    (OTHERWISE (CL:APPLY COMPILE-FUNCTION OPERATION ARGS)))))
		      (LOCAL-DECLARATIONS `((FUNCTION-PARENT ,NAME ,TYPE)
					    ,@LOCAL-DECLARATIONS)))
		 (DOLIST (FORM BODY)
		   (COMPILE-FROM-STREAM-1 FORM COMPILE-TIME-TOO))
		 (FUNCALL COMPILE-FUNCTION :DUMP-FORM
			  `(LOAD-MULTIPLE-DEFINITION
			     ',NAME ',TYPE ',(NREVERSE COMPILED-BODY) NIL)))))
;;;; **************** END OF ADDED CLAUSE *************************************
	    ((pcl::top-level-form)
	     (destructuring-bind (name times . body)
				 (cdr form)
	       (si:check-eval-when-times times)
	       (let ((compile-p (or (memq 'compile times)
				    (and compile-time-too (memq 'eval times))))
		     (load-p (or (memq 'load times)
				 (memq 'cl:load times)))
		     (fspec `(pcl::top-level-form ,name)))
		 (cond (load-p
			(compile-from-stream-1
			  `(progn (defun ,fspec () . ,body)
				  (funcall (function ,fspec)))
			  (and compile-p ':force)))
		       (compile-p
			(dolist (b body)
			  (funcall *compile-form-function* form ':force nil)))))))
	    (OTHERWISE
	     (LET ((TEM (AND (SYMBOLP FUNCTION) (GET FUNCTION 'TOP-LEVEL-FORM))))
	       (IF TEM
		   (FUNCALL *COMPILE-FORM-FUNCTION* (FUNCALL TEM FORM) COMPILE-TIME-TOO T)
		   (FUNCALL *COMPILE-FORM-FUNCTION* FORM COMPILE-TIME-TOO T))))))))))