New function: SB-EXT:SPIN-LOOP-HINT

[sbcl.git] / src / compiler / x86 / c-call.lisp

diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp
index ae98e18..7eec472 100644 (file)
--- a/src/compiler/x86/c-call.lisp
+++ b/src/compiler/x86/c-call.lisp
@@ -78,6 +78,13 @@
             (values 'unsigned-byte-32 'unsigned-reg))
       (my-make-wired-tn ptype reg-sc (result-reg-offset num-results)))))
 
+(define-alien-type-method (integer :naturalize-gen) (type alien)
+  (if (<= (alien-type-bits type) 16)
+      (if (alien-integer-type-signed type)
+          `(sign-extend ,alien ,(alien-type-bits type))
+          `(logand ,alien ,(1- (ash 1 (alien-type-bits type)))))
+      alien))
+
 (define-alien-type-method (system-area-pointer :result-tn) (type state)
   (declare (ignore type))
   (let ((num-results (result-state-num-results state)))
@@ -181,6 +188,47 @@
                                     ,@(new-args))))))
         (sb!c::give-up-ir1-transform))))
 
+;;; The ABI is vague about how signed sub-word integer return values
+;;; are handled, but since gcc versions >=4.3 no longer do sign
+;;; extension in the callee, we need to do it in the caller.  FIXME:
+;;; If the value to be extended is known to already be of the target
+;;; type at compile time, we can (and should) elide the extension.
+(defknown sign-extend ((signed-byte 32) t) fixnum
+    (foldable flushable movable))
+
+(define-vop (sign-extend)
+  (:translate sign-extend)
+  (:policy :fast-safe)
+  ;; Need to wire this to EAX since in x86 some dword registers don't
+  ;; have a matching word or byte register.
+  (:args (val :scs (signed-reg) :target eax))
+  (:temporary (:sc signed-reg :offset eax-offset :from :eval :to :result) eax)
+  (:arg-types signed-num (:constant fixnum))
+  (:info size)
+  (:results (res :scs (signed-reg)))
+  (:result-types fixnum)
+  (:ignore eax)
+  (:generator 1
+   (inst movsx res
+         (make-random-tn :kind :normal
+                         :sc (sc-or-lose (ecase size
+                                           (8 'byte-reg)
+                                           (16 'word-reg)))
+                         :offset (tn-offset val)))))
+
+#-sb-xc-host
+(defun sign-extend (x size)
+  (declare (type (signed-byte 32) x))
+  (ecase size
+    (8 (sign-extend x size))
+    (16 (sign-extend x size))))
+
+#+sb-xc-host
+(defun sign-extend (x size)
+  (if (logbitp (1- size) x)
+      (dpb x (byte size 0) -1)
+      x))
+
 (define-vop (foreign-symbol-sap)
   (:translate foreign-symbol-sap)
   (:policy :fast-safe)
@@ -300,8 +348,7 @@
       (let ((delta (logandc2 (+ amount 3) 3)))
         (inst mov temp
               (make-ea-for-symbol-tls-index *alien-stack*))
-        (inst fs-segment-prefix)
-        (inst sub (make-ea :dword :base temp) delta)))
+        (inst sub (make-ea :dword :base temp) delta :fs)))
     (load-tl-symbol-value result *alien-stack*))
   #!-sb-thread
   (:generator 0
@@ -321,8 +368,7 @@
       (let ((delta (logandc2 (+ amount 3) 3)))
         (inst mov temp
               (make-ea-for-symbol-tls-index *alien-stack*))
-        (inst fs-segment-prefix)
-        (inst add (make-ea :dword :base temp) delta))))
+        (inst add (make-ea :dword :base temp) delta :fs))))
   #!-sb-thread
   (:generator 0
     (unless (zerop amount)