X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcross-misc.lisp;h=1753e34996c685c11bca39a1d83ec6878ada3f72;hb=ba39d165a0bb6fabba6d6feb9b6fb88ae4d544ff;hp=0f68d1d3843b4d62a2c102c5a0dc94e71407a0ec;hpb=60a7d6fe1a3005f89973181c065d2bfa8c974e55;p=sbcl.git

diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp
index 0f68d1d..1753e34 100644
--- a/src/code/cross-misc.lisp
+++ b/src/code/cross-misc.lisp
@@ -25,10 +25,6 @@
 ;;; may then have to wade through some irrelevant warnings).
 (declaim (declaration inhibit-warnings))
 
-;;; We sometimes want to enable DX unconditionally in our own code,
-;;; but the host can ignore this without harm.
-(declaim (declaration sb!c::stack-allocate-dynamic-extent))
-
 ;;; Interrupt control isn't an issue in the cross-compiler: we don't
 ;;; use address-dependent (and thus GC-dependent) hashes, and we only
 ;;; have a single thread of control.
@@ -39,6 +35,22 @@
                 `(progn ,@body)))
      ,@forms))
 
+(defmacro with-locked-hash-table ((table) &body body)
+  (declare (ignore table))
+  `(progn ,@body))
+
+(defmacro with-locked-system-table ((table) &body body)
+  (declare (ignore table))
+  `(progn ,@body))
+
+(defmacro defglobal (name value &rest doc)
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (defparameter ,name
+       (if (boundp ',name)
+           (symbol-value ',name)
+           ,value)
+       ,@doc)))
+
 ;;; The GENESIS function works with fasl code which would, in the
 ;;; target SBCL, work on ANSI-STREAMs (streams which aren't extended
 ;;; Gray streams). In ANSI Common Lisp, an ANSI-STREAM is just a
@@ -114,7 +126,8 @@
 ;;; the host Lisp, this is only used at cold load time, and we don't
 ;;; care as much about efficiency, so it's fine to treat the host
 ;;; Lisp's INTERN as primitive and implement INTERN* in terms of it.
-(defun intern* (nameoid length package)
+(defun intern* (nameoid length package &key no-copy)
+  (declare (ignore no-copy))
   (intern (replace (make-string length) nameoid :end2 length) package))
 
 ;;; In the target Lisp this is implemented by reading a fixed slot in
@@ -125,6 +138,15 @@
   (declare (type symbol symbol))
   (sxhash symbol))
 
+(defvar sb!xc:*gensym-counter* 0)
+
+(defun sb!xc:gensym (&optional (thing "G"))
+  (declare (type string thing))
+  (let ((n sb!xc:*gensym-counter*))
+    (prog1
+        (make-symbol (concatenate 'string thing (write-to-string n :base 10 :radix nil :pretty nil)))
+      (incf sb!xc:*gensym-counter*))))
+
 ;;; These functions are needed for constant-folding.
 (defun sb!kernel:simple-array-nil-p (object)
   (when (typep object 'array)
@@ -150,6 +172,10 @@
   (assert (typep array '(simple-array * (*))))
   (values array start end 0))
 
+(defun sb!kernel:%with-array-data/fp (array start end)
+  (assert (typep array '(simple-array * (*))))
+  (values array start end 0))
+
 (defun sb!kernel:signed-byte-32-p (number)
   (typep number '(signed-byte 32)))
 
@@ -176,3 +202,9 @@
   name)
 
 (declaim (declaration enable-package-locks disable-package-locks))
+
+;;; printing structures
+
+(defun sb!kernel::default-structure-print (structure stream depth)
+  (declare (ignore depth))
+  (write structure :stream stream :circle t))