(sb!c::note-name-defined name :function)
- ;; FIXME: I want to do this here (and fix bug 137), but until the
- ;; breathtaking CMU CL function name architecture is converted into
- ;; something sane, (1) doing so doesn't really fix the bug, and
- ;; (2) doing probably isn't even really safe.
- #+nil (setf (%fun-name def) name)
-
(when doc
- (setf (fdocumentation name 'function) doc)
- #!+sb-eval
- (when (typep def 'sb!eval:interpreted-function)
- (setf (sb!eval:interpreted-function-documentation def)
- doc)))
+ (setf (%fun-doc def) doc))
+
name)
\f
;;;; DEFVAR and DEFPARAMETER
(cons (list ,@(mapcar (lambda (x) `(cons ',(car x) ,(cadr x)))
mapped-bindings))
*handler-clusters*)))
- ;; KLUDGE: Only on platforms with DX FIXED-ALLOC. FIXME: Add a
- ;; feature for that, so we can conditionalize on it neatly.
- #!+(or hppa mips x86 x86-64)
+ #!+stack-allocatable-fixed-objects
(declare (truly-dynamic-extent *handler-clusters*))
(progn ,form)))))
(push `(,fun ,ll ,@body) local-funs)
(list tag type ll fun))))
cases)))
- (with-unique-names (block var form-fun)
+ (with-unique-names (block cell form-fun)
`(dx-flet ((,form-fun ()
#!-x86 ,form
;; Need to catch FP errors here!
,@(reverse local-funs))
(declare (optimize (sb!c::check-tag-existence 0)))
(block ,block
- (dx-let ((,var nil))
- (declare (ignorable ,var))
+ ;; KLUDGE: We use a dx CONS cell instead of just assigning to
+ ;; the variable directly, so that we can stack allocate
+ ;; robustly: dx value cells don't work quite right, and it is
+ ;; possible to construct user code that should loop
+ ;; indefinitely, but instead eats up some stack each time
+ ;; around.
+ (dx-let ((,cell (cons :condition nil)))
+ (declare (ignorable ,cell))
(tagbody
(%handler-bind
,(mapcar (lambda (annotated-case)
(list type
`(lambda (temp)
,(if ll
- `(setf ,var temp)
+ `(setf (cdr ,cell) temp)
'(declare (ignore temp)))
(go ,tag)))))
annotated-cases)
(list tag
`(return-from ,block
,(if ll
- `(,fun-name ,var)
+ `(,fun-name (cdr ,cell))
`(,fun-name))))))
annotated-cases))))))))))
\f