0.8.21.5:

[sbcl.git] / src / compiler / generic / vm-fndb.lisp

diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp
index de26bcb..98bebdc 100644 (file)
--- a/src/compiler/generic/vm-fndb.lisp
+++ b/src/compiler/generic/vm-fndb.lisp
@@ -22,6 +22,8 @@
           complex-vector-p
           base-char-p %standard-char-p %instancep
           base-string-p simple-base-string-p
+           #!+sb-unicode character-string-p
+           #!+sb-unicode simple-character-string-p
           array-header-p
           simple-array-p simple-array-nil-p vector-nil-p
           simple-array-unsigned-byte-2-p
@@ -52,9 +54,9 @@
           simple-array-complex-double-float-p
           #!+long-float simple-array-complex-long-float-p
           system-area-pointer-p realp
-           #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+           ;; #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
            unsigned-byte-32-p
-           #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+           ;; #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
            signed-byte-32-p
            #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
            unsigned-byte-64-p
@@ -164,6 +166,11 @@
   (foldable flushable))
 (defknown (%set-raw-bits) (t fixnum sb!vm:word) sb!vm:word
   (unsafe))
+;; These two are mostly used for bit-bashing operations.
+(defknown %vector-raw-bits (t fixnum) sb!vm:word
+  (foldable flushable))
+(defknown (%set-vector-raw-bits) (t fixnum sb!vm:word) sb!vm:word
+  (unsafe))
 
 
 (defknown allocate-vector ((unsigned-byte 8) index index) (simple-array * (*))
@@ -281,26 +288,34 @@
 \f
 ;;;; bit-bashing routines
 
-(defknown copy-to-system-area
-         ((simple-unboxed-array (*)) index system-area-pointer index index)
-  (values)
-  ())
-
-(defknown copy-from-system-area
-         (system-area-pointer index (simple-unboxed-array (*)) index index)
-  (values)
-  ())
-
-(defknown system-area-copy
-         (system-area-pointer index system-area-pointer index index)
-  (values)
-  ())
-
-(defknown bit-bash-copy
-         ((simple-unboxed-array (*)) index
-          (simple-unboxed-array (*)) index index)
-  (values)
-  ())
+;;; FIXME: there's some ugly duplication between the (INTERN (FORMAT ...))
+;;; magic here and the same magic in src/code/bit-bash.lisp.  I don't know
+;;; of any good way to clean it up, but it's definitely violating OAOO.
+(macrolet ((define-known-copiers ()
+            `(progn
+              ,@(loop for i = 1 then (* i 2)
+                      collect `(defknown ,(intern (format nil "UB~A-BASH-COPY" i)
+                                                  (find-package "SB!KERNEL"))
+                                ((simple-unboxed-array (*)) index (simple-unboxed-array (*)) index index)
+                                (values)
+                                ())
+                      collect `(defknown ,(intern (format nil "SYSTEM-AREA-UB~A-COPY" i)
+                                                  (find-package "SB!KERNEL"))
+                                (system-area-pointer index system-area-pointer index index)
+                                (values)
+                                ())
+                      collect `(defknown ,(intern (format nil "COPY-UB~A-TO-SYSTEM-AREA" i)
+                                                  (find-package "SB!KERNEL"))
+                                ((simple-unboxed-array (*)) index system-area-pointer index index)
+                                (values)
+                                ())
+                      collect `(defknown ,(intern (format nil "COPY-UB~A-FROM-SYSTEM-AREA" i)
+                                                  (find-package "SB!KERNEL"))
+                                (system-area-pointer index (simple-unboxed-array (*)) index index)
+                                (values)
+                                ())
+                      until (= i sb!vm:n-word-bits)))))
+  (define-known-copiers))
 
 ;;; (not really a bit-bashing routine, but starting to take over from
 ;;; bit-bashing routines in byte-sized copies as of sbcl-0.6.12.29:)