From 298e7a785bd89b51e0e8c34980cd4ceac7d3dce0 Mon Sep 17 00:00:00 2001 From: sewardj Date: Mon, 31 Jan 2000 18:11:50 +0000 Subject: [PATCH] [project @ 2000-01-31 18:11:50 by sewardj] Spilling and x86 shift-code cleanups. --- ghc/compiler/main/Constants.lhs | 8 +++ ghc/compiler/nativeGen/MachCode.lhs | 73 ++++++++------------------ ghc/compiler/nativeGen/MachMisc.lhs | 8 +-- ghc/compiler/nativeGen/PprMach.lhs | 8 +-- ghc/compiler/nativeGen/RegAllocInfo.lhs | 85 +++++++++++++++++-------------- 5 files changed, 84 insertions(+), 98 deletions(-) diff --git a/ghc/compiler/main/Constants.lhs b/ghc/compiler/main/Constants.lhs index 4a2e0cd..53495da 100644 --- a/ghc/compiler/main/Constants.lhs +++ b/ghc/compiler/main/Constants.lhs @@ -25,6 +25,7 @@ module Constants ( tICKY_HDR_SIZE, aRR_WORDS_HDR_SIZE, aRR_PTRS_HDR_SIZE, + rESERVED_C_STACK_BYTES, sTD_ITBL_SIZE, pROF_ITBL_SIZE, @@ -229,3 +230,10 @@ using: interfaceFileFormatVersion :: Int interfaceFileFormatVersion = HscIfaceFileVersion \end{code} + +This tells the native code generator the size of the spill +area is has available. + +\begin{code} +rESERVED_C_STACK_BYTES = (RESERVED_C_STACK_BYTES :: Int) +\end{code} diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index b38b24b..0ae1867 100644 --- a/ghc/compiler/nativeGen/MachCode.lhs +++ b/ghc/compiler/nativeGen/MachCode.lhs @@ -631,9 +631,8 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps => 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-} @@ -649,7 +648,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps where -------------------- - shift_code :: (Operand -> Operand -> Instr) + shift_code :: (Imm -> Operand -> Instr) -> StixTree -> StixTree -> UniqSM Register @@ -659,21 +658,16 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps 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 @@ -681,6 +675,12 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps 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 -> @@ -707,27 +707,27 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps 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") @@ -735,39 +735,6 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps 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 diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs index 893bf87..6f53373 100644 --- a/ghc/compiler/nativeGen/MachMisc.lhs +++ b/ghc/compiler/nativeGen/MachMisc.lhs @@ -503,11 +503,11 @@ current translation. | XOR Size Operand Operand | NOT Size Operand | NEGI Size Operand -- NEG instruction (name clash with Cond) - | SHL Size Operand Operand -- 1st operand must be an Imm or CL - | SAR Size Operand Operand -- 1st operand must be an Imm or CL - | SHR Size Operand Operand -- 1st operand must be an Imm or CL - | NOP + | SHL Size Imm Operand -- Only immediate shifts allowed + | SAR Size Imm Operand -- Only immediate shifts allowed + | SHR Size Imm Operand -- Only immediate shifts allowed | BT Size Imm Operand + | NOP -- Float Arithmetic. -- ToDo for 386 diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs index 6232f37..3933351 100644 --- a/ghc/compiler/nativeGen/PprMach.lhs +++ b/ghc/compiler/nativeGen/PprMach.lhs @@ -977,9 +977,10 @@ pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst pprInstr (NOT size op) = pprSizeOp SLIT("not") size op pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op -pprInstr (SHL size imm dst) = {-pprSizeByteOpOp-} pprSizeOpOp SLIT("shl") size imm dst -pprInstr (SAR size imm dst) = {-pprSizeByteOpOp-} pprSizeOpOp SLIT("sar") size imm dst -pprInstr (SHR size imm dst) = {-pprSizeByteOpOp-} pprSizeOpOp SLIT("shr") size imm dst +pprInstr (SHL size imm dst) = pprSizeImmOp SLIT("shl") size imm dst +pprInstr (SAR size imm dst) = pprSizeImmOp SLIT("sar") size imm dst +pprInstr (SHR size imm dst) = pprSizeImmOp SLIT("shr") size imm dst +pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst @@ -989,7 +990,6 @@ pprInstr PUSHA = ptext SLIT("\tpushal") pprInstr POPA = ptext SLIT("\tpopal") pprInstr (NOP) = ptext SLIT("\tnop") -pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src pprInstr (CLTD) = ptext SLIT("\tcltd") pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op) diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs index c1bd50c..620d503 100644 --- a/ghc/compiler/nativeGen/RegAllocInfo.lhs +++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs @@ -65,6 +65,7 @@ import OrdList ( mkUnitList ) import PrimRep ( PrimRep(..) ) import UniqSet -- quite a bit of it import Outputable +import Constants ( rESERVED_C_STACK_BYTES ) \end{code} %************************************************************************ @@ -367,9 +368,9 @@ regUsage instr = case instr of 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) [] @@ -414,7 +415,7 @@ regUsage instr = case instr of 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 @@ -558,13 +559,15 @@ a singleton list which we know will satisfy all spill demands. 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. @@ -741,10 +744,10 @@ patchRegs instr env = case instr of 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 @@ -855,52 +858,60 @@ patchRegs instr env = case instr of 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} -- 1.7.10.4