X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fdefboot.lisp;h=ac72b1154973a5fb35b2ab3b0dbeef0561e6aa30;hb=9837343101c3da7b3a8f94609ec116ec5025436a;hp=0df13b61e51aa501507a0967416ba9fed55ef59d;hpb=e082422c19768dd7d6e30126740fe7f05cbd603a;p=sbcl.git

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index 0df13b6..ac72b11 100644
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -41,7 +41,7 @@
     (if (= (length vars) 1)
       `(let ((,(car vars) ,value-form))
          ,@body)
-      (let ((ignore (gensym)))
+      (let ((ignore (sb!xc:gensym)))
         `(multiple-value-call #'(lambda (&optional ,@(mapcar #'list vars)
                                          &rest ,ignore)
                                   (declare (ignore ,ignore))
@@ -82,7 +82,9 @@
                            ,n-result
                            (cond ,@more))))
                   (if (eq t test)
-                      `(progn ,@forms)
+                      ;; THE to perserve non-toplevelness for FOO in
+                      ;;   (COND (T (FOO)))
+                      `(the t (progn ,@forms))
                       `(if ,test
                            (progn ,@forms)
                            ,(when more `(cond ,@more))))))))))
@@ -101,7 +103,9 @@ evaluated as a PROGN."
 
 (defmacro-mundanely and (&rest forms)
   (cond ((endp forms) t)
-        ((endp (rest forms)) (first forms))
+        ((endp (rest forms))
+         ;; Preserve non-toplevelness of the form!
+         `(the t ,(first forms)))
         (t
          `(if ,(first forms)
               (and ,@(rest forms))
@@ -109,7 +113,9 @@ evaluated as a PROGN."
 
 (defmacro-mundanely or (&rest forms)
   (cond ((endp forms) nil)
-        ((endp (rest forms)) (first forms))
+        ((endp (rest forms))
+         ;; Preserve non-toplevelness of the form!
+         `(the t ,(first forms)))
         (t
          (let ((n-result (gensym)))
            `(let ((,n-result ,(first forms)))
@@ -243,7 +249,7 @@ evaluated as a PROGN."
 
 (defmacro-mundanely defvar (var &optional (val nil valp) (doc nil docp))
   #!+sb-doc
-  "Define a global variable at top level. Declare the variable
+  "Define a special variable at top level. Declare the variable
   SPECIAL and, optionally, initialize it. If the variable already has a
   value, the old value is not clobbered. The third argument is an optional
   documentation string for the variable."
@@ -500,7 +506,7 @@ evaluated as a PROGN."
                 (k '() (list* (cadr l) (car l) k)))
                ((or (null l) (not (member (car l) keys)))
                 (values (nreverse k) l)))))
-    (let ((block-tag (gensym))
+    (let ((block-tag (sb!xc:gensym "BLOCK"))
           (temp-var (gensym))
           (data
            (macrolet (;; KLUDGE: This started as an old DEFMACRO
@@ -533,7 +539,7 @@ evaluated as a PROGN."
                                                     &rest forms)
                                             (cddr clause))
                          (list (car clause) ;name=0
-                               (gensym) ;tag=1
+                               (sb!xc:gensym "TAG") ;tag=1
                                (transform-keywords :report report ;keywords=2
                                                    :interactive interactive
                                                    :test test)
@@ -601,7 +607,7 @@ evaluated as a PROGN."
                                                             (and (consp x)
                                                                  (eq 'lambda (car x))
                                                                  (setf lambda-form x))))))
-                                            (let ((name (gensym "LAMBDA")))
+                                            (let ((name (sb!xc:gensym "LAMBDA")))
                                               (push `(,name ,@(cdr lambda-form)) local-funs)
                                               (list type `(function ,name)))
                                             binding))))
@@ -646,13 +652,13 @@ specification."
                    (handler-case (return-from ,normal-return ,form)
                      ,@(remove no-error-clause cases)))))))
         (let* ((local-funs nil)
-               (annotated-cases (mapcar (lambda (case)
-                                          (let ((tag (gensym "TAG"))
-                                                (fun (gensym "FUN")))
-                                            (destructuring-bind (type ll &body body) case
-                                              (push `(,fun ,ll ,@body) local-funs)
-                                              (list tag type ll fun))))
-                                        cases)))
+               (annotated-cases
+                (mapcar (lambda (case)
+                          (with-unique-names (tag fun)
+                            (destructuring-bind (type ll &body body) case
+                              (push `(,fun ,ll ,@body) local-funs)
+                              (list tag type ll fun))))
+                        cases)))
           (with-unique-names (block var form-fun)
             `(dx-flet ((,form-fun ()
                          #!-x86 ,form