X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcross-misc.lisp;h=70d6f35816b41bfa27968fba9e31609d14d32a82;hb=408ed62925d643c163f0e9fc7b3fd41cce65fbea;hp=e57a563018df7393084b30c15314aa64945ebc19;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp
index e57a563..70d6f35 100644
--- a/src/code/cross-misc.lisp
+++ b/src/code/cross-misc.lisp
@@ -29,7 +29,27 @@
 ;;; use address-dependent (and thus GC-dependent) hashes, and we only
 ;;; have a single thread of control.
 (defmacro without-interrupts (&rest forms)
-  `(progn ,@forms))
+  `(macrolet ((allow-with-interrupts (&body body)
+                `(progn ,@body))
+              (with-local-interrupts (&body body)
+                `(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
@@ -37,13 +57,19 @@
 ;;; CL:STREAM.
 (deftype ansi-stream () 'stream)
 
-;;; In the target SBCL, the INSTANCE type refers to a base
-;;; implementation for compound types. There's no way to express
-;;; exactly that concept portably, but we can get essentially the same
-;;; effect by testing for any of the standard types which would, in
-;;; the target SBCL, be derived from INSTANCE:
 (deftype sb!kernel:instance ()
-  '(or condition standard-object structure-object))
+  '(or condition structure-object standard-object))
+(deftype sb!kernel:funcallable-instance ()
+  (error "not clear how to represent FUNCALLABLE-INSTANCE type"))
+
+;;; In the target SBCL, the INSTANCE type refers to a base
+;;; implementation for compound types with lowtag
+;;; INSTANCE-POINTER-LOWTAG. There's no way to express exactly that
+;;; concept portably, but we can get essentially the same effect by
+;;; testing for any of the standard types which would, in the target
+;;; SBCL, be derived from INSTANCE:
+(defun %instancep (x)
+  (typep x '(or condition structure-object standard-object)))
 
 ;;; There aren't any FUNCALLABLE-INSTANCEs in the cross-compilation
 ;;; host Common Lisp.
@@ -111,6 +137,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)
@@ -136,6 +171,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)))
 
@@ -149,8 +188,8 @@
   (declare (ignore kind thing format))
   `(progn ,@body))
 
-(defun compiler-assert-symbol-home-package-unlocked (symbol control)
-  (declare (ignore control))
+(defun program-assert-symbol-home-package-unlocked (context symbol control)
+  (declare (ignore context control))
   symbol)
 
 (defun assert-package-unlocked (package &optional control &rest args)