From 0cf144df2c455bcd11bc6fe29f9a7722bbf15fd3 Mon Sep 17 00:00:00 2001 From: Jonathan Armond Date: Thu, 7 Mar 2013 21:48:44 +0000 Subject: [PATCH] Fix movelh-ps and movehl-ps intrinsics - movlhps and movhlps instructions only work with registers. To support operands in memory, need to generate movhps and movlps. They have the same opcodes, but different assertions in SBCL's assembler. - Modify def-binary-intrinsic to accept a keyword parameter :mem-alt-insn to specify the instruction to use if the src operand is in memory. --- sbcl-core.lisp | 13 +++++++++++-- sse-intrinsics.lisp | 6 ++++-- 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/sbcl-core.lisp b/sbcl-core.lisp index 6511fb9..fb1b986 100644 --- a/sbcl-core.lisp +++ b/sbcl-core.lisp @@ -444,7 +444,8 @@ May emit additional instructions using the temporary register." (defmacro def-binary-intrinsic (&whole whole name rtype insn cost c-name - &key commutative tags immediate-arg x-type y-type) + &key commutative mem-alt-insn tags immediate-arg + x-type y-type) (declare (ignore c-name x-type y-type)) (let* ((imm (if immediate-arg '(imm))) (immt (if immediate-arg (list immediate-arg)))) @@ -470,7 +471,15 @@ May emit additional instructions using the temporary register." `((unless (location= y r) (setf tmp r)) (ensure-load ,rtype tmp x) - (inst ,insn ,@tags tmp (ensure-reg-or-mem y) ,@imm) + ,(let ((std-inst `(inst ,insn ,@tags tmp + (ensure-reg-or-mem y) ,@imm)) + (alt-inst `(inst ,mem-alt-insn ,@tags tmp + (ensure-reg-or-mem y) ,@imm))) + (if mem-alt-insn + `(sc-case y + (#.+any-sse-reg+ ,std-inst) + (t ,alt-inst)) + std-inst)) (ensure-move ,rtype r tmp)))))))) #|---------------------------------| diff --git a/sse-intrinsics.lisp b/sse-intrinsics.lisp index 38a06a8..dbb23df 100644 --- a/sse-intrinsics.lisp +++ b/sse-intrinsics.lisp @@ -224,8 +224,10 @@ (def-binary-intrinsic move-ss float-sse-pack movss 1 "_mm_move_ss") -(def-binary-intrinsic movehl-ps float-sse-pack movhlps 1 "_mm_movehl_ps") -(def-binary-intrinsic movelh-ps float-sse-pack movlhps 1 "_mm_movelh_ps") +(def-binary-intrinsic movehl-ps float-sse-pack movhlps 1 "_mm_movehl_ps" + :mem-alt-insn movlps) +(def-binary-intrinsic movelh-ps float-sse-pack movlhps 1 "_mm_movelh_ps" + :mem-alt-insn movhps) (def-unary-intrinsic movemask-ps (unsigned-byte 4) movmskps 1 "_mm_movemask_ps" :arg-type float-sse-pack)