X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcross-misc.lisp;h=0f68d1d3843b4d62a2c102c5a0dc94e71407a0ec;hb=f3a7c6b54880895d1598b1844d7e6eba98af9e53;hp=86d80827d78658ca6b247bb637111c5746d88c32;hpb=fea8ea02847ddc0864546a02480fb3e97d6fa318;p=sbcl.git

diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp
index 86d8082..0f68d1d 100644
--- a/src/code/cross-misc.lisp
+++ b/src/code/cross-misc.lisp
@@ -25,20 +25,19 @@
 ;;; 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.
 (defmacro without-interrupts (&rest forms)
-  `(progn ,@forms))
-
-;;; When we're running as a cross-compiler in an arbitrary host ANSI
-;;; Lisp, we shouldn't be doing anything which is sensitive to GC.
-;;; KLUDGE: I (WHN 19990131) think the proper long-term solution would
-;;; be to remove any operations from cross-compiler source files
-;;; (putting them in target-only source files) if they refer to these
-;;; hooks. This is a short-term hack.
-(defvar *before-gc-hooks* nil)
-(defvar *after-gc-hooks* nil)
+  `(macrolet ((allow-with-interrupts (&body body)
+                `(progn ,@body))
+              (with-local-interrupts (&body body)
+                `(progn ,@body)))
+     ,@forms))
 
 ;;; The GENESIS function works with fasl code which would, in the
 ;;; target SBCL, work on ANSI-STREAMs (streams which aren't extended
@@ -46,13 +45,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.
@@ -72,7 +77,7 @@
 (defun sb!kernel:array-header-p (x)
   (and (typep x 'array)
        (or (not (typep x 'simple-array))
-	   (/= (array-rank x) 1))))
+           (/= (array-rank x) 1))))
 
 ;;; GENESIS needs these at cross-compile time. The target
 ;;; implementation of these is reasonably efficient by virtue of its
@@ -89,10 +94,10 @@
       ;; of this function at cross-compile time don't really care if
       ;; the count is a little too high.) -- WHN 19990826
       (multiple-value-bind (symbol status)
-	  (find-symbol (symbol-name i) package)
-	(declare (ignore symbol))
-	(when (member status '(:internal :inherited))
-	  (incf result))))
+          (find-symbol (symbol-name i) package)
+        (declare (ignore symbol))
+        (when (member status '(:internal :inherited))
+          (incf result))))
     result))
 (defun package-external-symbol-count (package)
   (let ((result 0))
@@ -145,25 +150,21 @@
   (assert (typep array '(simple-array * (*))))
   (values array start end 0))
 
-#!-alpha
-(defun sb!vm::ash-left-mod32 (integer amount)
-  (ldb (byte 32 0) (ash integer amount)))
-#!+alpha
-(defun sb!vm::ash-left-mod64 (integer amount)
-  (ldb (byte 64 0) (ash integer amount)))
+(defun sb!kernel:signed-byte-32-p (number)
+  (typep number '(signed-byte 32)))
 
 ;;; package locking nops for the cross-compiler
 
 (defmacro without-package-locks (&body body)
   `(progn ,@body))
 
-(defmacro with-single-package-locked-error ((&optional kind thing &rest format) 
-					    &body body)
+(defmacro with-single-package-locked-error ((&optional kind thing &rest format)
+                                            &body body)
   (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)