X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fbyte-interp.lisp;h=cb73c3c24f1513d03b33844907291bb7d5ac7397;hb=6cbe4d8ba6d7bc469d03a72514c789b1f3944878;hp=36177ae01b6efe6a76a51c7fdab555a75003f9b6;hpb=99ad0a384664dc98af26245a33f11619ec0854ad;p=sbcl.git diff --git a/src/code/byte-interp.lisp b/src/code/byte-interp.lisp index 36177ae..cb73c3c 100644 --- a/src/code/byte-interp.lisp +++ b/src/code/byte-interp.lisp @@ -27,19 +27,19 @@ (etypecase x (simple-byte-function `(function ,(make-list (simple-byte-function-num-args x) - :initial-element 't) + :initial-element t) *)) (hairy-byte-function (collect ((res)) (let ((min (hairy-byte-function-min-args x)) (max (hairy-byte-function-max-args x))) - (dotimes (i min) (res 't)) + (dotimes (i min) (res t)) (when (> max min) (res '&optional) (dotimes (i (- max min)) - (res 't)))) + (res t)))) (when (hairy-byte-function-rest-arg-p x) - (res '&rest 't)) + (res '&rest t)) (ecase (hairy-byte-function-keywords-p x) ((t :allow-others) (res '&key) @@ -232,7 +232,7 @@ (value (cdr x))) (setf (svref res value) (if (and (consp key) (eq (car key) '%fdefinition-marker%)) - (sb!impl::fdefinition-object (cdr key) t) + (fdefinition-object (cdr key) t) key)))) res)) @@ -299,9 +299,8 @@ ;;; implement suitable code as jump tables. (defmacro expand-into-inlines () #+nil (declare (optimize (inhibit-warnings 3))) - (iterate build-dispatch - ((bit 4) - (base 0)) + (named-let build-dispatch ((bit 4) + (base 0)) (if (minusp bit) (let ((info (svref *inline-functions* base))) (if info @@ -383,12 +382,6 @@ (defun %byte-special-unbind () (sb!sys:%primitive unbind) (values)) - -;;; obsolete... -#!-sb-fluid (declaim (inline cons-unique-tag)) -(defun cons-unique-tag () - (list '#:%unique-tag%)) -;;; FIXME: Delete this once the system is working. ;;;; two-arg function stubs ;;;; @@ -503,7 +496,7 @@ (closure-vars (make-array num-closure-vars))) (declare (type index num-closure-vars) (type simple-vector closure-vars)) - (iterate frob ((index (1- num-closure-vars))) + (named-let frob ((index (1- num-closure-vars))) (unless (minusp index) (setf (svref closure-vars index) (pop-eval-stack)) (frob (1- index)))) @@ -992,7 +985,7 @@ (type stack-pointer old-sp old-fp) (type (or null simple-vector) closure-vars)) (when closure-vars - (iterate more ((index (1- (length closure-vars)))) + (named-let more ((index (1- (length closure-vars)))) (unless (minusp index) (push-eval-stack (svref closure-vars index)) (more (1- index))))) @@ -1205,19 +1198,20 @@ (type stack-pointer more-args-start)) (cond ((not (hairy-byte-function-keywords-p xep)) - (assert restp) + (aver restp) (setf (current-stack-pointer) (1+ more-args-start)) (setf (eval-stack-ref more-args-start) rest)) (t (unless (evenp more-args-supplied) (with-debugger-info (old-component ret-pc old-fp) - (error "odd number of keyword arguments"))) - ;; If there are keyword args, then we need to leave the - ;; defaulted and supplied-p values where the more args - ;; currently are. There might be more or fewer. And also, - ;; we need to flatten the parsed args with the defaults - ;; before we scan the keywords. So we copy all the more - ;; args to a temporary area at the end of the stack. + (error "odd number of &KEY arguments"))) + ;; If there are &KEY args, then we need to leave + ;; the defaulted and supplied-p values where the + ;; more args currently are. There might be more or + ;; fewer. And also, we need to flatten the parsed + ;; args with the defaults before we scan the + ;; keywords. So we copy all the more args to a + ;; temporary area at the end of the stack. (let* ((num-more-args (hairy-byte-function-num-more-args xep)) (new-sp (+ more-args-start num-more-args))