Re: #+lispm bugs

[Daniel Cerys <cerys@bbn.com>]

The recent bug with the definition of the pcl::generic-clobbers-function
error condition was correct in identifying a problem, but the fix was
incomplete.  Both the Explorer and 36XX machines support error handling
of this type, albeit a little differently.  To further confuse the
matter, the new Symbolics syntax for flavor methods is different from
the old syntax that TI uses.

So, the following fixes add the support of the
pcl::generic-clobbers-function condition for both machines.  Note that
it is appropriate to use #+LISPM in some cases.

;;;From boot.lisp

#+Lispm						;For both #+Symbolics and #+TI
(zl:defflavor generic-clobbers-function
	(name)
	(si:error)
  :initable-instance-variables)

#+Lispm						;The only difference here between TI and Symbolics is the method
spec
(zl:defmethod
  #+symbolics (dbg:report generic-clobbers-function)
  #+ti (generic-clobbers-function :report)          (stream)
  (format stream "~S aready names a ~a"
	  name
	  (if (and (symbolp name) (macro-function name))
	      "macro"
	      "function")))


#+Symbolics
(zl:defmethod (sys:proceed generic-clobbers-function :specialize-it) ()
  "Make it specializable anyway?"
  (make-specializable name))

#+ti
(zl:defmethod
  (generic-clobbers-function :case :proceed-asking-user :specialize-it)
(continuation ignore)
  "Make it specializable anyway?"
  (make-specializable name)
  (funcall continuation :specialize-it))

(defun ensure-generic-function (spec &rest keys
				     &key lambda-list
					  argument-precedence-order
					  declarations
					  documentation
					  method-combination
					  generic-function-class
					  method-class)
  (declare (ignore lambda-list argument-precedence-order declarations
		   documentation method-combination method-class))
  (let ((existing (and (gboundp spec)
		       (gdefinition spec))))
    (cond ((null existing)
	   (let ((new (apply #'ensure-gf-internal spec keys)))
	     (setq new (set-function-name new spec))
	     (setf (gdefinition spec) new)))
	  ((funcallable-instance-p existing) existing)	  
	  (existing
	   #+Lispm
	   (zl:signal 'generic-clobbers-function :name spec)
	   #-Lispm
	   (error "~S already names an ordinary function or a macro,~%~
                   it can't be converted to a generic function."
		  spec)))))