Re: [spr1889] method caching problem w/ Allegro CL??

[jkf@franz.com (Sean Foderaro)]

 I've found the cause of this problem:

<cl> (set-var1 5 my-instance)

5
(#<Standard-Method SET-VAR1 (T MY-CLASS) 67375636>)
<cl> (set-var1 5 my-instance)

5
#(0 #(16615116 14097773 15398856 8907981 3420810 16621470 866414 3884872 T
(VAR1) ...))
<cl> (set-var1 5 my-instance)
Error: Received signal number 10 (Bus error)
[1] <cl>


 There are two pcl files to edit.  The changes are as follows.  This 
only applies to the Allegro CL on the sparc (since that is the only 
combination of lisp and architecture in which the fast lap 
compiler is implemented):

*** dfun.cl.0	Fri Aug 31 11:53:53 1990
--- dfun.cl	Fri Aug 31 11:58:03 1990
***************
*** 684,690 ****
  			(gather1 (get-valid-wrapper arg))))))))
        (multiple-value-bind (function appl)
  	  (get-secondary-dispatch-function generic-function args)
! 	(values wrappers invalidp function appl)))))
  
  (defun accessor-miss-values (generic-function applicable args)
    (declare (values type index))
--- 684,696 ----
  			(gather1 (get-valid-wrapper arg))))))))
        (multiple-value-bind (function appl)
  	  (get-secondary-dispatch-function generic-function args)
! 	(values wrappers invalidp (coerce-to-function function) appl)))))
! 
! (defun coerce-to-function (x)
!   #-excl x
!   #+excl (cond ((and (consp x) (eq 'lambda (car x)))
! 		(comp::.primcall 'make-interp-function-obj x))
! 	       (t x)))
  
  (defun accessor-miss-values (generic-function applicable args)
    (declare (values type index))



*** quadlap.cl.0	Fri Aug 31 12:21:32 1990
--- quadlap.cl	Fri Aug 31 12:22:03 1990
***************
*** 576,583 ****
  			(qe lsl :u (list (get-treg-of op1) shiftamt)
  			    :d (list op-treg)))
  		 else (setq op-treg (get-treg-of op1)))
! 			
! 	      (qe return :u (list op-treg))))
  
  	  (:go
  	   (qe bra :arg (cadr lap)))
--- 576,584 ----
  			(qe lsl :u (list (get-treg-of op1) shiftamt)
  			    :d (list op-treg)))
  		 else (setq op-treg (get-treg-of op1)))
! 
! 	      (qe move :u (list op-treg) :d *mv-treg-target*)
! 	      (qe return :u *mv-treg-target*)))
  
  	  (:go
  	   (qe bra :arg (cadr lap)))