[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Symbolics set-funcallable-instance-function bug
- To: CommonLoops.pa@Xerox.COM
- Subject: Symbolics set-funcallable-instance-function bug
- From: Kenneth R. Anderson <kanderson@VAX.bbn.com>
- Date: Tue, 12 Apr 88 14:53 EDT
- Redistributed: CommonLoops.pa
;;; 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)))))