X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fc-call.lisp;h=fe5502b5e63c70a62f5e650f7915868b6fba5cfe;hb=f3f677703e37f5a335b3be7fa64f7748ad969517;hp=9cbca959859e59f68ed26d7a2905590869d28d10;hpb=78fa16bf55be44cc16845be84d98023e83fb14bc;p=sbcl.git diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp index 9cbca95..fe5502b 100644 --- a/src/compiler/x86-64/c-call.lisp +++ b/src/compiler/x86-64/c-call.lisp @@ -81,13 +81,16 @@ (setf (result-state-num-results state) (1+ num-results)) (multiple-value-bind (ptype reg-sc) (if (alien-integer-type-signed type) - (values (if (= (sb!alien::alien-integer-type-bits type) 32) - 'signed-byte-32 - 'signed-byte-64) - 'signed-reg) + (values 'signed-byte-64 'signed-reg) (values 'unsigned-byte-64 'unsigned-reg)) (my-make-wired-tn ptype reg-sc (result-reg-offset num-results))))) +(define-alien-type-method (integer :naturalize-gen) (type alien) + (if (and (alien-integer-type-signed type) + (<= (alien-type-bits type) 32)) + `(sign-extend ,alien) + alien)) + (define-alien-type-method (system-area-pointer :result-tn) (type state) (declare (ignore type)) (let ((num-results (result-state-num-results state))) @@ -105,7 +108,7 @@ (declare (ignore type)) (let ((num-results (result-state-num-results state))) (setf (result-state-num-results state) (1+ num-results)) - (my-make-wired-tn 'single-float 'single-reg num-results 2))) + (my-make-wired-tn 'single-float 'single-reg num-results))) (define-alien-type-method (values :result-tn) (type state) (let ((values (alien-values-type-values type))) @@ -184,8 +187,28 @@ ,@(new-args)))))) (sb!c::give-up-ir1-transform)))) +;;; The ABI specifies that signed short/int's are returned as 32-bit +;;; values. Negative values need to be sign-extended to 64-bits (done +;;; in a :NATURALIZE-GEN alien-type-method). +(defknown sign-extend (fixnum) fixnum (foldable flushable movable)) - +(define-vop (sign-extend) + (:translate sign-extend) + (:policy :fast-safe) + (:args (val :scs (any-reg))) + (:arg-types fixnum) + (:results (res :scs (any-reg))) + (:result-types fixnum) + (:generator 1 + (inst movsxd res + (make-random-tn :kind :normal + :sc (sc-or-lose 'dword-reg) + :offset (tn-offset val))))) + +(defun sign-extend (x) + (if (logbitp 31 x) + (dpb x (byte 32 0) -1) + (ldb (byte 32 0) x))) (define-vop (foreign-symbol-address) (:translate foreign-symbol-address) @@ -196,7 +219,7 @@ (:results (res :scs (sap-reg))) (:result-types system-area-pointer) (:generator 2 - (inst lea res (make-fixup (extern-alien-name foreign-symbol) :foreign)))) + (inst lea res (make-fixup foreign-symbol :foreign)))) #!+linkage-table (define-vop (foreign-symbol-dataref-address) @@ -208,15 +231,14 @@ (:results (res :scs (sap-reg))) (:result-types system-area-pointer) (:generator 2 - (inst mov res (make-fixup (extern-alien-name foreign-symbol) :foreign-dataref)))) + (inst mov res (make-fixup foreign-symbol :foreign-dataref)))) (define-vop (call-out) (:args (function :scs (sap-reg)) (args :more t)) (:results (results :more t)) (:temporary (:sc unsigned-reg :offset rax-offset :to :result) rax) - (:temporary (:sc unsigned-reg :offset rcx-offset - :from :eval :to :result) rcx) + (:ignore results) (:vop-var vop) (:save-p t) (:generator 0 @@ -230,22 +252,11 @@ (inst call function) ;; To give the debugger a clue. XX not really internal-error? (note-this-location vop :internal-error) - ;; Sign-extend s-b-32 return values. - (dolist (res (if (listp results) - results - (list results))) - (let ((tn (tn-ref-tn res))) - (when (eq (sb!c::tn-primitive-type tn) - (primitive-type-or-lose 'signed-byte-32)) - (inst movsxd tn (make-random-tn :kind :normal - :sc (sc-or-lose 'dword-reg) - :offset (tn-offset tn)))))) ;; FLOAT15 needs to contain FP zero in Lispland - (inst xor rcx rcx) - (inst movd (make-random-tn :kind :normal + (let ((float15 (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg) - :offset float15-offset) - rcx))) + :offset float15-offset))) + (inst xorpd float15 float15)))) (define-vop (alloc-number-stack-space) (:info amount) @@ -253,15 +264,17 @@ (:generator 0 (aver (location= result rsp-tn)) (unless (zerop amount) - (let ((delta (logandc2 (+ amount 3) 3))) + (let ((delta (logandc2 (+ amount 7) 7))) (inst sub rsp-tn delta))) + ;; C stack must be 16 byte aligned + (inst and rsp-tn #xfffffff0) (move result rsp-tn))) (define-vop (dealloc-number-stack-space) (:info amount) (:generator 0 (unless (zerop amount) - (let ((delta (logandc2 (+ amount 3) 3))) + (let ((delta (logandc2 (+ amount 7) 7))) (inst add rsp-tn delta))))) (define-vop (alloc-alien-stack-space) @@ -272,7 +285,7 @@ (:generator 0 (aver (not (location= result rsp-tn))) (unless (zerop amount) - (let ((delta (logandc2 (+ amount 3) 3))) + (let ((delta (logandc2 (+ amount 7) 7))) (inst mov temp (make-ea :dword :disp (+ nil-value @@ -286,7 +299,7 @@ (:generator 0 (aver (not (location= result rsp-tn))) (unless (zerop amount) - (let ((delta (logandc2 (+ amount 3) 3))) + (let ((delta (logandc2 (+ amount 7) 7))) (inst sub (make-ea :qword :disp (+ nil-value (static-symbol-offset '*alien-stack*) @@ -301,7 +314,7 @@ #!+sb-thread (:generator 0 (unless (zerop amount) - (let ((delta (logandc2 (+ amount 3) 3))) + (let ((delta (logandc2 (+ amount 7) 7))) (inst mov temp (make-ea :dword :disp (+ nil-value @@ -313,7 +326,7 @@ #!-sb-thread (:generator 0 (unless (zerop amount) - (let ((delta (logandc2 (+ amount 3) 3))) + (let ((delta (logandc2 (+ amount 7) 7))) (inst add (make-ea :qword :disp (+ nil-value (static-symbol-offset '*alien-stack*)