From 0aafa73007d42f2bc8e626f98a243019b7e63284 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Fri, 16 Mar 2001 22:40:29 +0000 Subject: [PATCH] 0.6.11.16: Bug 86 isn't a bug. INTERSECTION is an unknown type. And (specifier-type '(and (or number vector) real)) is ok. moved FIXNUMP, BIGNUMP, and RATIOP to SB!INT deleted TARGET-FIXNUMP in favor of SB-INT:FIXNUMP added a xc definition of SB-INT:FIXNUMP in cross-type.lisp fixed doc string for SB-INT:FIXNUMP tweaked type predicate wrappers to facilitate lexical search --- BUGS | 6 -- package-data-list.lisp-expr | 15 ++-- src/code/cross-type.lisp | 11 ++- src/code/early-type.lisp | 9 --- src/code/pred.lisp | 157 ++++++++++++++++++++---------------------- src/compiler/debug-dump.lisp | 2 +- src/compiler/dump.lisp | 2 +- src/compiler/srctran.lisp | 8 +-- src/compiler/x86/insts.lisp | 2 +- version.lisp-expr | 2 +- 10 files changed, 96 insertions(+), 118 deletions(-) diff --git a/BUGS b/BUGS index 82e95d2..8d402dc 100644 --- a/BUGS +++ b/BUGS @@ -825,12 +825,6 @@ Error in function C::GET-LAMBDA-TO-COMPILE: (I haven't tried to investigate this bug enough to guess whether there might be any user-level symptoms.) -86: - The system doesn't know how to reduce - (specifier-type '(intersection (or number vector) real)), - it just ends up as a HAIRY-TYPE. Smarter INTERSECTION2 methods for - UNION-TYPE might help. - 87: Despite what the manual says, (DECLAIM (SPEED 0)) doesn't cause things to be byte compiled. This seems to be true in cmucl-2.4.19, diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 59b9764..ee19b69 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -632,14 +632,6 @@ Lisp extension proposal by David N. Gray" the stuff in here originated in CMU CL's EXTENSIONS package and is retained, possibly temporariliy, because it might be used internally." :use ("CL" "SB!ALIEN" "SB!C-CALL" "SB!SYS" "SB!GRAY") - ;; FIXME: RATIOP should probably not go through this package but be - ;; called directly from SB!KERNEL, unless it's implemented as - ;; TYPEP X 'RATIO in which case it doesn't need to be in SB!KERNEL. - ;; And BIGNUMP and FIXNUMP should probably just be in this package, - ;; even if they have low-level-optimized implementations. (Their - ;; *meanings* aren't low-level, even if their implementations are.) - :import-from (("SB!KERNEL" "BIGNUMP" "FIXNUMP" "RATIOP")) - :reexport ("BIGNUMP" "FIXNUMP" "RATIOP") :export ("*AFTER-SAVE-INITIALIZATIONS*" "*BEFORE-SAVE-INITIALIZATIONS*" "*ALL-MODIFIER-NAMES*" @@ -708,6 +700,9 @@ retained, possibly temporariliy, because it might be used internally." "LONG-FLOATP" "SHORT-FLOATP" "SINGLE-FLOATP" + "FIXNUMP" + "BIGNUMP" + "RATIOP" ;; encapsulation "ARGUMENT-LIST" @@ -1161,12 +1156,12 @@ is a good idea, but see SB-SYS for blurring of boundaries." "FSET" "RAW-DEFINITION" "INVOKE-MACROEXPAND-HOOK" "DEFAULT-STRUCTURE-PRINT" - "LAYOUT" "LAYOUT-LENGTH" "RATIOP" "FIXNUMP" "TARGET-FIXNUMP" + "LAYOUT" "LAYOUT-LENGTH" "LAMBDA-WITH-ENVIRONMENT" "LAYOUT-PURE" "DSD-RAW-TYPE" "%COMPILER-DEFSTRUCT" "%COMPILER-ONLY-DEFSTRUCT" "FUNCTION-%COMPILER-ONLY-DEFSTRUCT" "DEFSTRUCT-DESCRIPTION" "UNDEFINE-STRUCTURE" - "BIGNUMP" "DD-COPIER" "UNDEFINE-FUNCTION-NAME" "DD-TYPE" + "DD-COPIER" "UNDEFINE-FUNCTION-NAME" "DD-TYPE" "CLASS-STATE" "INSTANCE" "*TYPE-SYSTEM-INITIALIZED*" "WEAK-POINTER-P" "FIND-LAYOUT" "DSD-NAME" "%TYPEP" "DD-RAW-INDEX" diff --git a/src/code/cross-type.lisp b/src/code/cross-type.lisp index d699d4d..a43b3c4 100644 --- a/src/code/cross-type.lisp +++ b/src/code/cross-type.lisp @@ -11,6 +11,13 @@ (in-package "SB!IMPL") +;;; Is X a fixnum in the target Lisp? +(defun fixnump (x) + (and (integerp x) + (<= sb!vm:*target-most-negative-fixnum* + x + sb!vm:*target-most-positive-fixnum*))) + ;;; (This was a useful warning when trying to get bootstrapping ;;; to work, but it's mostly irrelevant noise now that the system ;;; works.) @@ -75,7 +82,7 @@ ((subtypep raw-result 'integer) (cond ((<= 0 object 1) 'bit) - ((target-fixnump object) + ((fixnump object) 'fixnum) (t 'integer))) @@ -235,7 +242,7 @@ ;; Some types require translation between the cross-compilation ;; host Common Lisp and the target SBCL. (sb!xc:class (values (typep host-object 'sb!xc:class) t)) - (fixnum (values (target-fixnump host-object) t)) + (fixnum (values (fixnump host-object) t)) ;; Some types are too hard to handle in the positive case, but at ;; least we can be confident in a large fraction of the negative ;; cases.. diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp index 4042453..6b64686 100644 --- a/src/code/early-type.lisp +++ b/src/code/early-type.lisp @@ -316,13 +316,4 @@ (values-specifier-type-cache-clear)) (values)) -;;; Is X a fixnum in the target Lisp? -;;; -;;; KLUDGE: not clear this really belongs in early-type.lisp, but where? -(defun target-fixnump (x) - (and (integerp x) - (<= sb!vm:*target-most-negative-fixnum* - x - sb!vm:*target-most-positive-fixnum*))) - (!defun-from-collected-cold-init-forms !early-type-cold-init) diff --git a/src/code/pred.lisp b/src/code/pred.lisp index f144d02..1acb874 100644 --- a/src/code/pred.lisp +++ b/src/code/pred.lisp @@ -31,89 +31,80 @@ "Return T if X is NIL, otherwise return NIL." (not object)) -;;; All the primitive type predicates share a parallel form.. -(macrolet - ((frob () - `(progn - ,@(mapcar (lambda (pred) - (let* ((name (symbol-name pred)) - (stem (string-right-trim name "P-")) - (article (if (find (schar name 0) "AEIOU") - "an" - "a"))) - `(defun ,pred (object) - ,(format nil - "Return T if OBJECT is ~A ~A, ~ - and NIL otherwise." - article - stem) - (,pred object)))) - '(array-header-p - arrayp - atom - base-char-p - bignump - bit-vector-p - characterp - code-component-p - consp - compiled-function-p - complexp - complex-double-float-p - complex-float-p - #!+long-float complex-long-float-p - complex-rational-p - complex-single-float-p - ;; (COMPLEX-VECTOR-P is not included here since - ;; it's awkward to express the type it tests for - ;; in the Common Lisp type system, and since - ;; it's only used in the implementation of a few - ;; specialized things.) - double-float-p - fdefn-p - fixnump - floatp - functionp - integerp - listp - long-float-p - lra-p - null - numberp - rationalp - ratiop - realp - short-float-p - sb!kernel:simple-array-p - simple-bit-vector-p - simple-string-p - simple-vector-p - single-float-p - stringp - %instancep - symbolp - system-area-pointer-p - weak-pointer-p - vectorp - unsigned-byte-32-p - signed-byte-32-p - simple-array-unsigned-byte-2-p - simple-array-unsigned-byte-4-p - simple-array-unsigned-byte-8-p - simple-array-unsigned-byte-16-p - simple-array-unsigned-byte-32-p - simple-array-signed-byte-8-p - simple-array-signed-byte-16-p - simple-array-signed-byte-30-p - simple-array-signed-byte-32-p - simple-array-single-float-p - simple-array-double-float-p - #!+long-float simple-array-long-float-p - simple-array-complex-single-float-p - simple-array-complex-double-float-p - #!+long-float simple-array-complex-long-float-p - ))))) - (frob)) +;;; All the primitive type predicate wrappers share a parallel form.. +(macrolet ((def-type-predicate-wrapper (pred) + (let* ((name (symbol-name pred)) + (stem (string-left-trim "%" (string-right-trim "P-" name))) + (article (if (position (schar name 0) "AEIOU") "an" "a"))) + `(defun ,pred (object) + ,(format nil + "Return true if OBJECT is ~A ~A, and NIL otherwise." + article + stem) + ;; (falling through to low-level implementation) + (,pred object))))) + (def-type-predicate-wrapper array-header-p) + (def-type-predicate-wrapper arrayp) + (def-type-predicate-wrapper atom) + (def-type-predicate-wrapper base-char-p) + (def-type-predicate-wrapper bignump) + (def-type-predicate-wrapper bit-vector-p) + (def-type-predicate-wrapper characterp) + (def-type-predicate-wrapper code-component-p) + (def-type-predicate-wrapper consp) + (def-type-predicate-wrapper compiled-function-p) + (def-type-predicate-wrapper complexp) + (def-type-predicate-wrapper complex-double-float-p) + (def-type-predicate-wrapper complex-float-p) + #!+long-float (def-type-predicate-wrapper complex-long-float-p) + (def-type-predicate-wrapper complex-rational-p) + (def-type-predicate-wrapper complex-single-float-p) + ;; (COMPLEX-VECTOR-P is not included here since it's awkward to express + ;; the type it tests for in the Common Lisp type system, and since it's + ;; only used in the implementation of a few specialized things.) + (def-type-predicate-wrapper double-float-p) + (def-type-predicate-wrapper fdefn-p) + (def-type-predicate-wrapper fixnump) + (def-type-predicate-wrapper floatp) + (def-type-predicate-wrapper functionp) + (def-type-predicate-wrapper integerp) + (def-type-predicate-wrapper listp) + (def-type-predicate-wrapper long-float-p) + (def-type-predicate-wrapper lra-p) + (def-type-predicate-wrapper null) + (def-type-predicate-wrapper numberp) + (def-type-predicate-wrapper rationalp) + (def-type-predicate-wrapper ratiop) + (def-type-predicate-wrapper realp) + (def-type-predicate-wrapper short-float-p) + (def-type-predicate-wrapper sb!kernel:simple-array-p) + (def-type-predicate-wrapper simple-bit-vector-p) + (def-type-predicate-wrapper simple-string-p) + (def-type-predicate-wrapper simple-vector-p) + (def-type-predicate-wrapper single-float-p) + (def-type-predicate-wrapper stringp) + (def-type-predicate-wrapper %instancep) + (def-type-predicate-wrapper symbolp) + (def-type-predicate-wrapper system-area-pointer-p) + (def-type-predicate-wrapper weak-pointer-p) + (def-type-predicate-wrapper vectorp) + (def-type-predicate-wrapper unsigned-byte-32-p) + (def-type-predicate-wrapper signed-byte-32-p) + (def-type-predicate-wrapper simple-array-unsigned-byte-2-p) + (def-type-predicate-wrapper simple-array-unsigned-byte-4-p) + (def-type-predicate-wrapper simple-array-unsigned-byte-8-p) + (def-type-predicate-wrapper simple-array-unsigned-byte-16-p) + (def-type-predicate-wrapper simple-array-unsigned-byte-32-p) + (def-type-predicate-wrapper simple-array-signed-byte-8-p) + (def-type-predicate-wrapper simple-array-signed-byte-16-p) + (def-type-predicate-wrapper simple-array-signed-byte-30-p) + (def-type-predicate-wrapper simple-array-signed-byte-32-p) + (def-type-predicate-wrapper simple-array-single-float-p) + (def-type-predicate-wrapper simple-array-double-float-p) + #!+long-float (def-type-predicate-wrapper simple-array-long-float-p) + (def-type-predicate-wrapper simple-array-complex-single-float-p) + (def-type-predicate-wrapper simple-array-complex-double-float-p) + #!+long-float (def-type-predicate-wrapper simple-array-complex-long-float-p)) ;;; Return the specifier for the type of object. This is not simply ;;; (TYPE-SPECIFIER (CTYPE-OF OBJECT)) because CTYPE-OF has different diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp index c852972..0a4ddd4 100644 --- a/src/compiler/debug-dump.lisp +++ b/src/compiler/debug-dump.lisp @@ -100,7 +100,7 @@ 0) *byte-buffer*) - (let ((loc (if (target-fixnump label) label (label-position label)))) + (let ((loc (if (fixnump label) label (label-position label)))) (write-var-integer (- loc *previous-location*) *byte-buffer*) (setq *previous-location* loc)) diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index ca355d4..e883864 100644 --- a/src/compiler/dump.lisp +++ b/src/compiler/dump.lisp @@ -402,7 +402,7 @@ (if (eq x t) (dump-fop 'sb!impl::fop-truth file) (dump-non-immediate-object x file))) - ((target-fixnump x) (dump-integer x file)) + ((fixnump x) (dump-integer x file)) ((characterp x) (dump-character x file)) (t (dump-non-immediate-object x file)))) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index af0fbf7..ee67ba7 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -1426,12 +1426,12 @@ #!-propagate-fun-type (defoptimizer (ash derive-type) ((n shift)) (flet ((ash-outer (n s) - (when (and (target-fixnump s) + (when (and (fixnump s) (<= s 64) (> s sb!vm:*target-most-negative-fixnum*)) (ash n s))) (ash-inner (n s) - (if (and (target-fixnump s) + (if (and (fixnump s) (> s sb!vm:*target-most-negative-fixnum*)) (ash n (min s 64)) (if (minusp n) -1 0)))) @@ -1493,7 +1493,7 @@ (defun ash-derive-type-aux (n-type shift same-arg) (declare (ignore same-arg)) (flet ((ash-outer (n s) - (when (and (target-fixnump s) + (when (and (fixnump s) (<= s 64) (> s sb!vm:*target-most-negative-fixnum*)) (ash n s))) @@ -1501,7 +1501,7 @@ ;; symbolic machine word size values somehow. (ash-inner (n s) - (if (and (target-fixnump s) + (if (and (fixnump s) (> s sb!vm:*target-most-negative-fixnum*)) (ash n (min s 64)) (if (minusp n) -1 0)))) diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index 34738f7..6441221 100644 --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -709,7 +709,7 @@ (and (eql disp 0) (not (= (reg-tn-encoding base) #b101)))) #b00) - ((and (target-fixnump disp) (<= -128 disp 127)) + ((and (fixnump disp) (<= -128 disp 127)) #b01) (t #b10))) diff --git a/version.lisp-expr b/version.lisp-expr index 2e65f70..868cd5d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; versions, and a string like "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. -"0.6.11.15" +"0.6.11.16" -- 1.7.10.4