[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Symbolics set-funcallable-instance-function bug



;;; KRA: CL:LENGTH dies in ENDP as it should, while zl:LENGTH doesn't.
(defun set-funcallable-instance-function (fin new-value)
  (cond ((not (funcallable-instance-p fin))
         (error "~S is not a funcallable-instance" fin))
        ((not (functionp new-value))
         (error "~S is not a function." new-value))
        ((and (si:lexical-closure-p new-value)
	      (compiled-function-p (si:lexical-closure-function new-value)))
         (let* ((fin-env (si:lexical-closure-environment fin))
                (new-env (si:lexical-closure-environment new-value))
                (new-env-size (zl:length new-env))	; KRA
                (fin-env-size #.(- funcallable-instance-closure-size	; KRA: constant.
                                 (length funcallable-instance-data))))
           (cond ((<= new-env-size fin-env-size)
		  (dotimes (i fin-env-size)
		    (setf (sys:%p-contents-offset fin-env i)
			  (and (< i new-env-size)
			       (sys:%p-contents-offset new-env i))))
                  (setf (si:lexical-closure-function fin)
                        (si:lexical-closure-function new-value)))
                 (t                 
                  (set-funcallable-instance-function
                    fin
                    (make-trampoline new-value))))))
        (t
         (set-funcallable-instance-function fin
                                            (make-trampoline new-value)))))