X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprimordial-extensions.lisp;h=e91d56d1b261be5e43675c4e6e577ecb473a412a;hb=0c3bbfaa2286626a2d915c8810f690aefc702661;hp=0ca98ac2675daf5171b832543a47cd9927b2629e;hpb=2050b7c3644ab235aaf1959795bb33e89bd571a3;p=sbcl.git

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index 0ca98ac..e91d56d 100644
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -154,7 +154,7 @@
                           (stem (if (every #'alpha-char-p symbol-name)
                                     symbol-name
                                     (concatenate 'string symbol-name "-"))))
-                     `(,symbol (gensym ,stem))))
+                     `(,symbol (sb!xc:gensym ,stem))))
                  symbols)
      ,@body))
 
@@ -166,8 +166,8 @@
   (when (eq t name)
     (break))
   (if name
-      (loop repeat n collect (gensym (string name)))
-      (loop repeat n collect (gensym))))
+      (loop repeat n collect (sb!xc:gensym (string name)))
+      (loop repeat n collect (sb!xc:gensym))))
 
 ;;;; miscellany
 
@@ -222,7 +222,8 @@
                 ;; but it will immediately lead to undefined to behavior,
                 ;; since almost any operation on a deleted package is
                 ;; undefined.
-                (package-name maybe-package))
+                #-sb-xc-host
+                (package-%name maybe-package))
            maybe-package)
           (t
            ;; We're in the undefined behavior zone. First, munge the
@@ -344,6 +345,21 @@
                                        (1- max))))
         (t nil)))
 
+(defun proper-list-p (x)
+  (unless (consp x)
+    (return-from proper-list-p (null x)))
+  (let ((rabbit (cdr x))
+        (turtle x))
+    (flet ((pop-rabbit ()
+             (when (eql rabbit turtle) ; circular
+               (return-from proper-list-p nil))
+             (when (atom rabbit)
+               (return-from proper-list-p (null rabbit)))
+             (pop rabbit)))
+      (loop (pop-rabbit)
+            (pop-rabbit)
+            (pop turtle)))))
+
 ;;; Helpers for defining error-signalling NOP's for "not supported
 ;;; here" operations.
 (defmacro define-unsupported-fun (name &optional