X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fprimordial-extensions.lisp;h=7b10afdfd33e75b6240210b46a95c7b4d1a960c7;hb=cd13034f9415f64cdaa05893a4ac5ff1e95c97bd;hp=a70b2c2cbb8ed22b154042b70c61680225e671f5;hpb=c41cb4c87eae7b04f844dca5f7edb5086c5d2d68;p=sbcl.git diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp index a70b2c2..7b10afd 100644 --- a/src/code/primordial-extensions.lisp +++ b/src/code/primordial-extensions.lisp @@ -104,13 +104,13 @@ (,bind ,(nreverse r-inits) ,@decls (tagbody - (go ,label-2) - ,label-1 - ,@code - (,step ,@(nreverse r-steps)) - ,label-2 - (unless ,(first endlist) (go ,label-1)) - (return-from ,block (progn ,@(rest endlist)))))))))) + (go ,label-2) + ,label-1 + (tagbody ,@code) + (,step ,@(nreverse r-steps)) + ,label-2 + (unless ,(first endlist) (go ,label-1)) + (return-from ,block (progn ,@(rest endlist)))))))))) ;;; This is like DO, except it has no implicit NIL block. Each VAR is ;;; initialized in parallel to the value of the specified INIT form. @@ -168,21 +168,27 @@ (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) (defun symbolicate (&rest things) (let ((name (case (length things) - ;; why isn't this just the value in the T branch? + ;; Why isn't this just the value in the T branch? ;; Well, this is called early in cold-init, before ;; the type system is set up; however, now that we ;; check for bad lengths, the type system is needed ;; for calls to CONCATENATE. So we need to make sure ;; that the calls are transformed away: (1 (concatenate 'string - (the simple-base-string (string (car things))))) + (the simple-base-string + (string (car things))))) (2 (concatenate 'string - (the simple-base-string (string (car things))) - (the simple-base-string (string (cadr things))))) + (the simple-base-string + (string (car things))) + (the simple-base-string + (string (cadr things))))) (3 (concatenate 'string - (the simple-base-string (string (car things))) - (the simple-base-string (string (cadr things))) - (the simple-base-string (string (caddr things))))) + (the simple-base-string + (string (car things))) + (the simple-base-string + (string (cadr things))) + (the simple-base-string + (string (caddr things))))) (t (apply #'concatenate 'string (mapcar #'string things)))))) (values (intern name)))))