=> trivialCode's is not restrictive enough (sigh.)
-}
- SllOp -> shift_code (SHL L) x y {-False-}
- SrlOp -> shift_code (SHR L) x y {-False-}
-
+ SllOp -> shift_code (SHL L) x y {-False-}
+ SrlOp -> shift_code (SHR L) x y {-False-}
ISllOp -> shift_code (SHL L) x y {-False-}
ISraOp -> shift_code (SAR L) x y {-False-}
ISrlOp -> shift_code (SHR L) x y {-False-}
where
--------------------
- shift_code :: (Operand -> Operand -> Instr)
+ shift_code :: (Imm -> Operand -> Instr)
-> StixTree
-> StixTree
-> UniqSM Register
shift_code instr x y{-amount-}
| maybeToBool imm
= getRegister x `thenUs` \ register ->
- let
- op_imm = OpImm imm__2
+ let op_imm = OpImm imm__2
code__2 dst =
- let
- code = registerCode register dst
- src = registerName register dst
+ let code = registerCode register dst
+ src = registerName register dst
in
- mkSeqInstr (COMMENT SLIT("shift_code")) .
code .
if isFixed register && src /= dst
- then
- mkSeqInstrs [MOV L (OpReg src) (OpReg dst),
- instr op_imm (OpReg dst)]
- else
- mkSeqInstr (instr op_imm (OpReg src))
+ then mkSeqInstrs [MOV L (OpReg src) (OpReg dst),
+ instr imm__2 (OpReg dst)]
+ else mkSeqInstr (instr imm__2 (OpReg src))
in
returnUs (Any IntRep code__2)
where
imm__2 = case imm of Just x -> x
{- Case2: shift length is complex (non-immediate) -}
+ -- Since ECX is always used as a spill temporary, we can't
+ -- use it here to do non-immediate shifts. No big deal --
+ -- they are only very rare, and we can use an equivalent
+ -- test-and-jump sequence which doesn't use ECX.
+ -- DO NOT USE REPLACE THIS CODE WITH THE "OBVIOUS" shl/shr/sar CODE,
+ -- SINCE IT WILL CAUSE SERIOUS PROBLEMS WITH THE SPILLER
shift_code instr x y{-amount-}
= getRegister x `thenUs` \ register1 ->
getRegister y `thenUs` \ register2 ->
BT L (ImmInt 4) r_tmp,
JXX GEU lbl_test3,
- instr (OpImm (ImmInt 16)) r_dst,
+ instr (ImmInt 16) r_dst,
LABEL lbl_test3,
BT L (ImmInt 3) r_tmp,
JXX GEU lbl_test2,
- instr (OpImm (ImmInt 8)) r_dst,
+ instr (ImmInt 8) r_dst,
LABEL lbl_test2,
BT L (ImmInt 2) r_tmp,
JXX GEU lbl_test1,
- instr (OpImm (ImmInt 4)) r_dst,
+ instr (ImmInt 4) r_dst,
LABEL lbl_test1,
BT L (ImmInt 1) r_tmp,
JXX GEU lbl_test0,
- instr (OpImm (ImmInt 2)) r_dst,
+ instr (ImmInt 2) r_dst,
LABEL lbl_test0,
BT L (ImmInt 0) r_tmp,
JXX GEU lbl_after,
- instr (OpImm (ImmInt 1)) r_dst,
+ instr (ImmInt 1) r_dst,
LABEL lbl_after,
COMMENT (_PK_ "end shift sequence")
in
returnUs (Any IntRep code__2)
-{-
- -- since ECX is always used as a spill temporary, we can't
- -- use it here to do non-immediate shifts. No big deal --
- -- they are only very rare, and we can give an equivalent
- -- insn sequence which doesn't use ECX.
- -- DO NOT USE THIS CODE, SINCE IT IS INCOMPATIBLE WITH THE SPILLER
- = getRegister y `thenUs` \ register1 ->
- getRegister x `thenUs` \ register2 ->
- let
- -- Note: we force the shift length to be loaded
- -- into ECX, so that we can use CL when shifting.
- -- (only register location we are allowed
- -- to put shift amounts.)
- --
- -- The shift instruction is fed ECX as src reg,
- -- but we coerce this into CL when printing out.
- src1 = registerName register1 ecx
- code1 = if src1 /= ecx then -- if it is not in ecx already, force it!
- registerCode register1 ecx .
- mkSeqInstr (MOV L (OpReg src1) (OpReg ecx))
- else
- registerCode register1 ecx
- code__2 =
- let
- code2 = registerCode register2 eax
- src2 = registerName register2 eax
- in
- code1 . code2 .
- mkSeqInstr (instr (OpReg ecx) (OpReg eax))
- in
- returnUs (Fixed IntRep eax code__2)
--}
-
--------------------
add_code :: Size -> StixTree -> StixTree -> UniqSM Register
import PrimRep ( PrimRep(..) )
import UniqSet -- quite a bit of it
import Outputable
+import Constants ( rESERVED_C_STACK_BYTES )
\end{code}
%************************************************************************
XOR sz src dst -> usage2s src dst
NOT sz op -> usage1 op
NEGI sz op -> usage1 op
- SHL sz len dst -> usage2s len dst -- len is either an Imm or ecx.
- SAR sz len dst -> usage2s len dst -- len is either an Imm or ecx.
- SHR sz len dst -> usage2s len dst -- len is either an Imm or ecx.
+ SHL sz imm dst -> usage1 dst
+ SAR sz imm dst -> usage1 dst
+ SHR sz imm dst -> usage1 dst
BT sz imm src -> usage (opToReg src) []
PUSH sz op -> usage (opToReg op) []
LABEL _ -> noUsage
ASCII _ _ -> noUsage
DATA _ _ -> noUsage
- _ -> pprPanic "regUsage(x86) " empty
+ _ -> pprPanic "regUsage(x86)" empty
where
-- 2 operand form in which the second operand is purely a destination
findReservedRegs :: [Instr] -> [[RegNo]]
findReservedRegs instrs
#if alpha_TARGET_ARCH
- = [[NCG_Reserved_I1, NCG_Reserved_I2,
- NCG_Reserved_F1, NCG_Reserved_F2]]
+ = --[[NCG_Reserved_I1, NCG_Reserved_I2,
+ -- NCG_Reserved_F1, NCG_Reserved_F2]]
+ error "findReservedRegs: alpha"
#endif
#if sparc_TARGET_ARCH
- = [[NCG_Reserved_I1, NCG_Reserved_I2,
- NCG_Reserved_F1, NCG_Reserved_F2,
- NCG_Reserved_D1, NCG_Reserved_D2]]
+ = --[[NCG_Reserved_I1, NCG_Reserved_I2,
+ -- NCG_Reserved_F1, NCG_Reserved_F2,
+ -- NCG_Reserved_D1, NCG_Reserved_D2]]
+ error "findReservedRegs: sparc"
#endif
#if i386_TARGET_ARCH
-- Sigh. This is where it gets complicated.
XOR sz src dst -> patch2 (XOR sz) src dst
NOT sz op -> patch1 (NOT sz) op
NEGI sz op -> patch1 (NEGI sz) op
- SHL sz imm dst -> patch2 (SHL sz) imm dst
- SAR sz imm dst -> patch2 (SAR sz) imm dst
- SHR sz imm dst -> patch2 (SHR sz) imm dst
- BT sz imm src -> patch1 (BT sz imm) src
+ SHL sz imm dst -> patch1 (SHL sz imm) dst
+ SAR sz imm dst -> patch1 (SAR sz imm) dst
+ SHR sz imm dst -> patch1 (SHR sz imm) dst
+ BT sz imm src -> patch1 (BT sz imm) src
TEST sz src dst -> patch2 (TEST sz) src dst
CMP sz src dst -> patch2 (CMP sz) src dst
PUSH sz op -> patch1 (PUSH sz) op
Spill to memory, and load it back...
-JRS, 000122: on x86, don't spill directly above the stack pointer, since
-some insn sequences (int <-> conversions) use this as a temp location.
-Leave 16 bytes of slop.
+JRS, 000122: on x86, don't spill directly above the stack pointer,
+since some insn sequences (int <-> conversions, and eventually
+StixInteger) use this as a temp location. Leave 8 words (ie, 64 bytes
+for a 64-bit arch) of slop.
\begin{code}
+maxSpillSlots :: Int
+maxSpillSlots = (rESERVED_C_STACK_BYTES - 64) `div` 8
+
+-- convert a spill slot number to a *byte* offset, with no sign:
+-- decide on a per arch basis whether you are spilling above or below
+-- the C stack pointer.
+spillSlotToOffset :: Int -> Int
+spillSlotToOffset slot
+ | slot >= 0 && slot < maxSpillSlots
+ = 64 + 8 * slot
+ | otherwise
+ = pprPanic "spillSlotToOffset:"
+ (text "invalid spill location: " <> int slot)
+
spillReg, loadReg :: Reg -> Reg -> InstrList
spillReg dyn (MemoryReg i pk)
- | i >= 0 -- JRS paranoia
- = let sz = primRepToSize pk
+ = let sz = primRepToSize pk
+ off = spillSlotToOffset i
in
mkUnitList (
{-Alpha: spill below the stack pointer (?)-}
- IF_ARCH_alpha( ST sz dyn (spRel i)
+ IF_ARCH_alpha( ST sz dyn (spRel (- (off `div` 8)))
{-I386: spill above stack pointer leaving 2 words/spill-}
- ,IF_ARCH_i386 ( let loc | i < 60 = 4 + 2 * i
- | otherwise = -2000 - 2 * i
+ ,IF_ARCH_i386 ( let off_w = off `div` 4
in
if pk == FloatRep || pk == DoubleRep
- then GST DF dyn (spRel loc)
- else MOV sz (OpReg dyn) (OpAddr (spRel loc))
+ then GST DF dyn (spRel off_w)
+ else MOV sz (OpReg dyn) (OpAddr (spRel off_w))
{-SPARC: spill below frame pointer leaving 2 words/spill-}
- ,IF_ARCH_sparc( ST sz dyn (fpRel (-2 * i))
+ ,IF_ARCH_sparc( ST sz dyn (fpRel (- (off `div` 4)))
,)))
)
- | otherwise
- = pprPanic "spillReg:" (text "invalid spill location: " <> int i)
-----------------------------
loadReg (MemoryReg i pk) dyn
- | i >= 0 -- JRS paranoia
- = let sz = primRepToSize pk
+ = let sz = primRepToSize pk
+ off = spillSlotToOffset i
in
mkUnitList (
- IF_ARCH_alpha( LD sz dyn (spRel i)
- ,IF_ARCH_i386 ( let loc | i < 60 = 4 + 2 * i
- | otherwise = -2000 - 2 * i
+ IF_ARCH_alpha( LD sz dyn (spRel (- (off `div` 8)))
+ ,IF_ARCH_i386 ( let off_w = off `div` 4
in
if pk == FloatRep || pk == DoubleRep
- then GLD DF (spRel loc) dyn
- else MOV sz (OpAddr (spRel loc)) (OpReg dyn)
- ,IF_ARCH_sparc( LD sz (fpRel (-2 * i)) dyn
+ then GLD DF (spRel off_w) dyn
+ else MOV sz (OpAddr (spRel off_w)) (OpReg dyn)
+ ,IF_ARCH_sparc( LD sz (fpRel (- (off `div` 4))) dyn
,)))
)
- | otherwise
- = pprPanic "loadReg:" (text "invalid spill location: " <> int i)
\end{code}
projects / ghc-hetmet.git / commitdiff