X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcross-misc.lisp;h=a2545b0a4c8413014b37687350f69d86c90aaab7;hb=148ae852a476ec673020ecbf99be3bcb4a70eafc;hp=2b2a6c5e57960f69678e59980e6f188bb29225d8;hpb=ff92598854bf7cae8d57fe49cef4d9a98e1ab345;p=sbcl.git diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp index 2b2a6c5..a2545b0 100644 --- a/src/code/cross-misc.lisp +++ b/src/code/cross-misc.lisp @@ -31,28 +31,25 @@ (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) - ;;; 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 ;;; 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 +69,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 +86,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,27 +142,22 @@ (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)) -(defmacro with-deferred-package-lock-violations (&body body) - `(flet ((prepend-package-lock-violations (forms) forms) - (package-lock-violations () nil)) - ,@body)) +(defun compiler-assert-symbol-home-package-unlocked (symbol control) + (declare (ignore control)) + symbol) (defun assert-package-unlocked (package &optional control &rest args) (declare (ignore control args)) @@ -175,10 +167,4 @@ (declare (ignore format continuablep)) name) -(deftype package-lock-violation () nil) - -(deftype package-locked-error () nil) - -(deftype symbol-package-locked-error () nil) - (declaim (declaration enable-package-locks disable-package-locks))