X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2FnativeGen%2FRegAllocInfo.lhs;h=53d651e99ab8557499887827ca6ac4551142b34c;hb=d70de6f98f9d833adf4c8d68afc17bd1e6493545;hp=2c30b18394f5adbf5bb6323533078012e753a426;hpb=9dd6e1c216993624a2cd74b62ca0f0569c02c26b;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs
index 2c30b18..53d651e 100644
--- a/ghc/compiler/nativeGen/RegAllocInfo.lhs
+++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The AQUA Project, Glasgow University, 1996
+% (c) The AQUA Project, Glasgow University, 1996-1998
 %
 \section[RegAllocInfo]{Machine-specific info used for register allocation}
 
@@ -35,6 +35,7 @@ module RegAllocInfo (
 	patchRegs,
 	regLiveness,
 	spillReg,
+	findReservedRegs,
 
 	RegSet,
 	elementOfRegSet,
@@ -57,15 +58,14 @@ import MachMisc
 import MachRegs
 import MachCode		( InstrList )
 
-import AbsCSyn		( MagicId )
 import BitSet		( unitBS, mkBS, minusBS, unionBS, listBS, BitSet )
 import CLabel		( pprCLabel_asm, CLabel{-instance Ord-} )
 import FiniteMap	( addToFM, lookupFM, FiniteMap )
-import OrdList		( mkUnitList, OrdList )
+import OrdList		( mkUnitList )
 import PrimRep		( PrimRep(..) )
-import Stix		( StixTree, CodeSegment )
 import UniqSet		-- quite a bit of it
 import Outputable
+import Constants	( rESERVED_C_STACK_BYTES )
 \end{code}
 
 %************************************************************************
@@ -355,86 +355,90 @@ regUsage instr = case instr of
 #if i386_TARGET_ARCH
 
 regUsage instr = case instr of
-    MOV  sz src dst	-> usage2 src dst
-    MOVZX sz src dst	-> usage2 src dst
-    MOVSX sz src dst	-> usage2 src dst
-    LEA  sz src dst	-> usage2 src dst
-    ADD  sz src dst	-> usage2 src dst
-    SUB  sz src dst	-> usage2 src dst
-    IMUL sz src dst	-> usage2 src dst
+    MOV  sz src dst	-> usage2  src dst
+    MOVZxL sz src dst	-> usage2  src dst
+    MOVSxL sz src dst	-> usage2  src dst
+    LEA  sz src dst	-> usage2  src dst
+    ADD  sz src dst	-> usage2s src dst
+    SUB  sz src dst	-> usage2s src dst
+    IMUL sz src dst	-> usage2s src dst
     IDIV sz src		-> usage (eax:edx:opToReg src) [eax,edx]
-    AND  sz src dst	-> usage2 src dst
-    OR   sz src dst	-> usage2 src dst
-    XOR  sz src dst	-> usage2 src dst
+    AND  sz src dst	-> usage2s src dst
+    OR   sz src dst	-> usage2s src dst
+    XOR  sz src dst	-> usage2s src dst
     NOT  sz op		-> usage1 op
     NEGI sz op		-> usage1 op
-    SHL  sz dst len	-> usage2 dst len -- len is either an Imm or ecx.
-    SAR  sz dst len	-> usage2 dst len -- len is either an Imm or ecx.
-    SHR  sz len dst	-> usage2 dst len -- 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) []
     POP  sz op		-> usage [] (opToReg op)
     TEST sz src dst	-> usage (opToReg src ++ opToReg dst) []
     CMP  sz src dst	-> usage (opToReg src ++ opToReg dst) []
     SETCC cond op	-> usage [] (opToReg op)
-    JXX cond label	-> usage [] []
+    JXX cond lbl	-> usage [] []
     JMP op		-> usage (opToReg op) freeRegs
     CALL imm		-> usage [] callClobberedRegs
     CLTD		-> usage [eax] [edx]
     NOP			-> usage [] []
-    SAHF 		-> usage [eax] []
-    FABS 		-> usage [st0] [st0]
-    FADD sz src		-> usage (st0:opToReg src) [st0] -- allFPRegs
-    FADDP 		-> usage [st0,st1] [st0] -- allFPRegs
-    FIADD sz asrc	-> usage (addrToRegs asrc) [st0]
-    FCHS 		-> usage [st0] [st0]
-    FCOM sz src		-> usage (st0:opToReg src) []
-    FCOS 		-> usage [st0] [st0]
-    FDIV sz src 	-> usage (st0:opToReg src) [st0]
-    FDIVP  		-> usage [st0,st1] [st0]
-    FDIVRP 		-> usage [st0,st1] [st0]
-    FIDIV sz asrc	-> usage (addrToRegs asrc) [st0]
-    FDIVR sz src 	-> usage (st0:opToReg src) [st0]
-    FIDIVR sz asrc	-> usage (addrToRegs asrc) [st0]
-    FICOM sz asrc	-> usage (addrToRegs asrc) []
-    FILD sz asrc dst	-> usage (addrToRegs asrc) [dst] -- allFPRegs
-    FIST sz adst	-> usage (st0:addrToRegs adst) []
-    FLD	 sz src 	-> usage (opToReg src) [st0] -- allFPRegs
-    FLD1 		-> usage [] [st0] -- allFPRegs
-    FLDZ 		-> usage [] [st0] -- allFPRegs
-    FMUL sz src 	-> usage (st0:opToReg src) [st0]
-    FMULP 	 	-> usage [st0,st1] [st0]
-    FIMUL sz asrc	-> usage (addrToRegs asrc) [st0]
-    FRNDINT 		-> usage [st0] [st0]
-    FSIN 		-> usage [st0] [st0]
-    FSQRT 		-> usage [st0] [st0]
-    FST sz (OpReg r)	-> usage [st0] [r]
-    FST sz dst		-> usage (st0:opToReg dst) []
-    FSTP sz (OpReg r)	-> usage [st0] [r] -- allFPRegs
-    FSTP sz dst		-> usage (st0:opToReg dst) [] -- allFPRegs
-    FSUB sz src		-> usage (st0:opToReg src) [st0] -- allFPRegs
-    FSUBR sz src	-> usage (st0:opToReg src) [st0] -- allFPRegs
-    FISUB sz asrc	-> usage (addrToRegs asrc) [st0]
-    FSUBP 		-> usage [st0,st1] [st0] -- allFPRegs
-    FSUBRP 		-> usage [st0,st1] [st0] -- allFPRegs
-    FISUBR sz asrc	-> usage (addrToRegs asrc) [st0]
-    FTST 		-> usage [st0] []
-    FCOMP sz op		-> usage (st0:opToReg op) [st0] -- allFPRegs
-    FUCOMPP 		-> usage [st0, st1] [] --  allFPRegs
-    FXCH		-> usage [st0, st1] [st0, st1]
-    FNSTSW		-> usage [] [eax]
-    _			-> noUsage
+
+    GMOV src dst	-> usage [src] [dst]
+    GLD sz src dst	-> usage (addrToRegs src) [dst]
+    GST sz src dst	-> usage [src] (addrToRegs dst)
+
+    GFTOD src dst	-> usage [src] [dst]
+    GFTOI src dst	-> usage [src] [dst]
+
+    GDTOF src dst	-> usage [src] [dst]
+    GDTOI src dst	-> usage [src] [dst]
+
+    GITOF src dst	-> usage [src] [dst]
+    GITOD src dst	-> usage [src] [dst]
+
+    GADD sz s1 s2 dst	-> usage [s1,s2] [dst]
+    GSUB sz s1 s2 dst	-> usage [s1,s2] [dst]
+    GMUL sz s1 s2 dst	-> usage [s1,s2] [dst]
+    GDIV sz s1 s2 dst	-> usage [s1,s2] [dst]
+
+    GCMP sz src1 src2	-> usage [src1,src2] []
+    GABS sz src dst	-> usage [src] [dst]
+    GNEG sz src dst	-> usage [src] [dst]
+    GSQRT sz src dst	-> usage [src] [dst]
+    GSIN sz src dst	-> usage [src] [dst]
+    GCOS sz src dst	-> usage [src] [dst]
+    GTAN sz src dst	-> usage [src] [dst]
+
+    COMMENT _		-> noUsage
+    SEGMENT _ 		-> noUsage
+    LABEL _		-> noUsage
+    ASCII _ _		-> noUsage
+    DATA _ _		-> noUsage
+    _			-> pprPanic "regUsage(x86)" empty
+
  where
+    -- 2 operand form in which the second operand is purely a destination
     usage2 :: Operand -> Operand -> RegUsage
     usage2 op (OpReg reg) = usage (opToReg op) [reg]
     usage2 op (OpAddr ea) = usage (opToReg op ++ addrToRegs ea) []
     usage2 op (OpImm imm) = usage (opToReg op) []
+
+    -- 2 operand form in which the second operand is also an input
+    usage2s :: Operand -> Operand -> RegUsage
+    usage2s op (OpReg reg) = usage (opToReg op ++ [reg]) [reg]
+    usage2s op (OpAddr ea) = usage (opToReg op ++ addrToRegs ea) []
+    usage2s op (OpImm imm) = usage (opToReg op) []
+
+    -- 1 operand form in which the operand is both used and written
     usage1 :: Operand -> RegUsage
     usage1 (OpReg reg)    = usage [reg] [reg]
     usage1 (OpAddr ea)    = usage (addrToRegs ea) []
-    allFPRegs = [st0,st1,st2,st3,st4,st5,st6,st7]
+
+    allFPRegs = [fake0,fake1,fake2,fake3,fake4,fake5]
 
     --callClobberedRegs = [ eax, ecx, edx ] -- according to gcc, anyway.
-    callClobberedRegs = [eax]
+    callClobberedRegs = [eax,fake0,fake1,fake2,fake3,fake4,fake5]
 
 -- General purpose register collecting functions.
 
@@ -455,6 +459,14 @@ regUsage instr = case instr of
     interesting (FixedReg _) = False
     interesting _ = True
 
+
+-- Allow the spiller to decide whether or not it can use 
+-- %eax and %edx as spill temporaries.
+hasFixedEAXorEDX instr = case instr of
+    IDIV _ _ -> True
+    CLTD     -> True
+    other    -> False
+
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
@@ -508,6 +520,73 @@ regUsage instr = case instr of
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
 
+
+%************************************************************************
+%*									*
+\subsection{Free, reserved, call-clobbered, and argument registers}
+%*									*
+%************************************************************************
+
+@freeRegs@ is the list of registers we can use in register allocation.
+@freeReg@ (below) says if a particular register is free.
+
+With a per-instruction clobber list, we might be able to get some of
+these back, but it's probably not worth the hassle.
+
+@callClobberedRegs@ ... the obvious.
+
+@argRegs@: assuming a call with N arguments, what registers will be
+used to hold arguments?  (NB: it doesn't know whether the arguments
+are integer or floating-point...)
+
+findReservedRegs tells us which regs can be used as spill temporaries.
+The list of instructions for which we are attempting allocation is
+supplied.  This is so that we can (at least for x86) examine it to
+discover which registers are being used in a fixed way -- for example,
+%eax and %edx are used by integer division, so they can't be used as
+spill temporaries.  However, most instruction lists don't do integer
+division, so we don't want to rule them out altogether.
+
+findReservedRegs returns not a list of spill temporaries, but a list
+of list of them.  This is so that the allocator can attempt allocating
+with at first no spill temps, then if that fails, increasing numbers.
+For x86 it is important that we minimise the number of regs reserved
+as spill temporaries, since there are so few.  For Alpha and Sparc
+this isn't a concern; we just ignore the supplied code list and return
+a singleton list which we know will satisfy all spill demands.
+
+\begin{code}
+findReservedRegs :: [Instr] -> [[RegNo]]
+findReservedRegs instrs
+#if alpha_TARGET_ARCH
+  = --[[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]]
+    error "findReservedRegs: sparc"
+#endif
+#if i386_TARGET_ARCH
+    -- Sigh.  This is where it gets complicated.
+  = -- first of all, try without any at all.
+    map (map mappedRegNo) (
+    [ [],
+    -- if that doesn't work, try one integer reg (which might fail)
+    -- and two float regs (which will always fix any float insns)
+      [ecx, fake4,fake5]
+    ]
+    -- dire straits (but still correct): see if we can bag %eax and %edx
+    ++ if   any hasFixedEAXorEDX instrs
+       then []  -- bummer
+       else [ [ecx,edx,fake4,fake5],
+              [ecx,edx,eax,fake4,fake5] ]
+    )
+#endif
+\end{code}
+
 %************************************************************************
 %*									*
 \subsection{@RegLiveness@ type; @regLiveness@ function}
@@ -653,8 +732,8 @@ patchRegs instr env = case instr of
 
 patchRegs instr env = case instr of
     MOV  sz src dst	-> patch2 (MOV  sz) src dst
-    MOVZX sz src dst	-> patch2 (MOVZX sz) src dst
-    MOVSX sz src dst	-> patch2 (MOVSX sz) src dst
+    MOVZxL sz src dst	-> patch2 (MOVZxL sz) src dst
+    MOVSxL sz src dst	-> patch2 (MOVSxL sz) src dst
     LEA  sz src dst	-> patch2 (LEA  sz) src dst
     ADD  sz src dst	-> patch2 (ADD  sz) src dst
     SUB  sz src dst	-> patch2 (SUB  sz) src dst
@@ -665,41 +744,53 @@ 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
+    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
     POP  sz op		-> patch1 (POP  sz) op
     SETCC cond op	-> patch1 (SETCC cond) op
     JMP op		-> patch1 JMP op
-    FADD sz src		-> FADD sz (patchOp src)
-    FIADD sz asrc	-> FIADD sz (lookupAddr asrc)
-    FCOM sz src		-> patch1 (FCOM sz) src
-    FDIV sz src 	-> FDIV sz (patchOp src)
-    --FDIVP sz src 	-> FDIVP sz (patchOp src)
-    FIDIV sz asrc	-> FIDIV sz (lookupAddr asrc)
-    FDIVR sz src 	-> FDIVR sz (patchOp src)
-    --FDIVRP sz src 	-> FDIVRP sz (patchOp src)
-    FIDIVR sz asrc	-> FIDIVR sz (lookupAddr asrc)
-    FICOM sz asrc	-> FICOM sz (lookupAddr asrc)
-    FILD sz asrc dst	-> FILD sz (lookupAddr asrc) (env dst)
-    FIST sz adst	-> FIST sz (lookupAddr adst)
-    FLD	sz src 		-> patch1 (FLD sz) (patchOp src)
-    FMUL sz src 	-> FMUL sz (patchOp src)
-    --FMULP sz src 	-> FMULP sz (patchOp src)
-    FIMUL sz asrc	-> FIMUL sz (lookupAddr asrc)
-    FST sz dst		-> FST sz (patchOp dst)
-    FSTP sz dst		-> FSTP sz (patchOp dst)
-    FSUB sz src		-> FSUB sz (patchOp src)
-    --FSUBP sz src	-> FSUBP sz (patchOp src)
-    FISUB sz asrc	-> FISUB sz (lookupAddr asrc)
-    FSUBR sz src 	-> FSUBR sz (patchOp src)
-    --FSUBRP sz src 	-> FSUBRP sz (patchOp src)
-    FISUBR sz asrc	-> FISUBR sz (lookupAddr asrc)
-    FCOMP sz src	-> FCOMP sz (patchOp src)
-    _			-> instr
+
+    GMOV src dst	-> GMOV (env src) (env dst)
+    GLD sz src dst	-> GLD sz (lookupAddr src) (env dst)
+    GST sz src dst	-> GST sz (env src) (lookupAddr dst)
+
+    GFTOD src dst	-> GFTOD (env src) (env dst)
+    GFTOI src dst	-> GFTOI (env src) (env dst)
+
+    GDTOF src dst	-> GDTOF (env src) (env dst)
+    GDTOI src dst	-> GDTOI (env src) (env dst)
+
+    GITOF src dst	-> GITOF (env src) (env dst)
+    GITOD src dst	-> GITOD (env src) (env dst)
+
+    GADD sz s1 s2 dst	-> GADD sz (env s1) (env s2) (env dst)
+    GSUB sz s1 s2 dst	-> GSUB sz (env s1) (env s2) (env dst)
+    GMUL sz s1 s2 dst	-> GMUL sz (env s1) (env s2) (env dst)
+    GDIV sz s1 s2 dst	-> GDIV sz (env s1) (env s2) (env dst)
+
+    GCMP sz src1 src2	-> GCMP sz (env src1) (env src2)
+    GABS sz src dst	-> GABS sz (env src) (env dst)
+    GNEG sz src dst	-> GNEG sz (env src) (env dst)
+    GSQRT sz src dst	-> GSQRT sz (env src) (env dst)
+    GSIN sz src dst	-> GSIN sz (env src) (env dst)
+    GCOS sz src dst	-> GCOS sz (env src) (env dst)
+    GTAN sz src dst	-> GTAN sz (env src) (env dst)
+
+    COMMENT _		-> instr
+    SEGMENT _ 		-> instr
+    LABEL _		-> instr
+    ASCII _ _		-> instr
+    DATA _ _		-> instr
+    JXX _ _		-> instr
+    CALL _		-> instr
+    CLTD		-> instr
+    _			-> pprPanic "patchInstr(x86)" empty
+
   where
     patch1 insn op      = insn (patchOp op)
     patch2 insn src dst = insn (patchOp src) (patchOp dst)
@@ -767,34 +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, 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)
-  = 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 below stack pointer leaving 2 words/spill-}
-	,IF_ARCH_i386 ( MOV sz (OpReg dyn) (OpAddr (spRel (-2 * i)))
+	{-I386: spill above stack pointer leaving 2 words/spill-}
+	,IF_ARCH_i386 ( let off_w = off `div` 4
+                        in
+                        if pk == FloatRep || pk == DoubleRep
+                        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)))
         ,)))
     )
-
-----------------------------
+   
 loadReg (MemoryReg i pk) dyn
-  = let
-	sz = primRepToSize pk
+  = let	sz  = primRepToSize pk
+        off = spillSlotToOffset i
     in
     mkUnitList (
-	 IF_ARCH_alpha( LD  sz dyn (spRel i)
-	,IF_ARCH_i386 ( MOV sz (OpAddr (spRel (-2 * i))) (OpReg dyn)
-	,IF_ARCH_sparc( LD  sz (fpRel (-2 * i)) dyn
+	 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 off_w) dyn
+                        else MOV sz (OpAddr (spRel off_w)) (OpReg dyn)
+	,IF_ARCH_sparc( LD  sz (fpRel (- (off `div` 4))) dyn
 	,)))
     )
 \end{code}