faster VECTOR-SUBSEQ*

[sbcl.git] / src / code / host-alieneval.lisp

diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp
index db3baad..c29bdd5 100644 (file)
--- a/src/code/host-alieneval.lisp
+++ b/src/code/host-alieneval.lisp
@@ -160,7 +160,7 @@
 (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
   (defun auxiliary-type-definitions (env)
     (multiple-value-bind (result expanded-p)
-        (sb!xc:macroexpand '&auxiliary-type-definitions& env)
+        (%macroexpand '&auxiliary-type-definitions& env)
       (if expanded-p
           result
           ;; This is like having the global symbol-macro definition be
@@ -364,8 +364,8 @@
   (declare (ignore type))
   'system-area-pointer)
 
-(define-alien-type-method (system-area-pointer :alien-rep) (type)
-  (declare (ignore type))
+(define-alien-type-method (system-area-pointer :alien-rep) (type context)
+  (declare (ignore type context))
   'system-area-pointer)
 
 (define-alien-type-method (system-area-pointer :naturalize-gen) (type alien)
@@ -468,10 +468,10 @@
 (def!macro maybe-with-pinned-objects (variables types &body body)
   (declare (ignorable variables types))
   (let ((pin-variables
-         ;; Only pin things on x86/x86-64, since on non-conservative
-         ;; gcs it'd imply disabling the GC. Which is something we
-         ;; don't want to do every time we're calling to C.
-         #!+(or x86 x86-64)
+         ;; Only pin things on GENCGC, since on CHENEYGC it'd imply
+         ;; disabling the GC.  Which is something we don't want to do
+         ;; every time we're calling to C.
+         #!+gencgc
          (loop for variable in variables
             for type in types
             when (invoke-alien-type-method :deport-pin-p type)
@@ -502,8 +502,11 @@
 (defun compute-lisp-rep-type (type)
   (invoke-alien-type-method :lisp-rep type))
 
-(defun compute-alien-rep-type (type)
-  (invoke-alien-type-method :alien-rep type))
+;;; CONTEXT is either :NORMAL (the default) or :RESULT (alien function
+;;; return values).  See the :ALIEN-REP method for INTEGER for
+;;; details.
+(defun compute-alien-rep-type (type &optional (context :normal))
+  (invoke-alien-type-method :alien-rep type context))
 \f
 ;;;; default methods
 
@@ -521,8 +524,8 @@
   (declare (ignore type))
   nil)
 
-(define-alien-type-method (root :alien-rep) (type)
-  (declare (ignore type))
+(define-alien-type-method (root :alien-rep) (type context)
+  (declare (ignore type context))
   '*)
 
 (define-alien-type-method (root :naturalize-gen) (type alien)
@@ -588,10 +591,25 @@
   (list (if (alien-integer-type-signed type) 'signed-byte 'unsigned-byte)
         (alien-integer-type-bits type)))
 
-(define-alien-type-method (integer :alien-rep) (type)
-  (list (if (alien-integer-type-signed type) 'signed-byte 'unsigned-byte)
-        (alien-integer-type-bits type)))
-
+(define-alien-type-method (integer :alien-rep) (type context)
+  ;; When returning integer values that are narrower than a machine
+  ;; register from a function, some platforms leave the higher bits of
+  ;; the register uninitialized.  On those platforms, we use an
+  ;; alien-rep of the full register width when checking for purposes
+  ;; of return values and override the naturalize method to perform
+  ;; the sign extension (in compiler/target/c-call.lisp).
+  (ecase context
+    ((:normal #!-(or x86 x86-64) :result)
+     (list (if (alien-integer-type-signed type) 'signed-byte 'unsigned-byte)
+           (alien-integer-type-bits type)))
+    #!+(or x86 x86-64)
+    (:result
+     (list (if (alien-integer-type-signed type) 'signed-byte 'unsigned-byte)
+           sb!vm:n-word-bits))))
+
+;;; As per the comment in the :ALIEN-REP method above, this is defined
+;;; elsewhere for x86oids.
+#!-(or x86 x86-64)
 (define-alien-type-method (integer :naturalize-gen) (type alien)
   (declare (ignore type))
   alien)
@@ -787,7 +805,8 @@
 (define-alien-type-method (float :lisp-rep) (type)
   (alien-float-type-type type))
 
-(define-alien-type-method (float :alien-rep) (type)
+(define-alien-type-method (float :alien-rep) (type context)
+  (declare (ignore context))
   (alien-float-type-type type))
 
 (define-alien-type-method (float :naturalize-gen) (type alien)
@@ -1183,7 +1202,7 @@
   #!+sb-doc
   "Return an Alien pointer to the data addressed by Expr, which must be a call
    to SLOT or DEREF, or a reference to an Alien variable."
-  (let ((form (sb!xc:macroexpand expr env)))
+  (let ((form (%macroexpand expr env)))
     (or (typecase form
           (cons
            (case (car form)