[project @ 2002-05-10 12:43:02 by simonpj]

[ghc-hetmet.git] / ghc / compiler / nativeGen / RegAllocInfo.lhs

diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs
index 8d82ae3..880a50e 100644 (file)
--- a/ghc/compiler/nativeGen/RegAllocInfo.lhs
+++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs
@@ -236,6 +236,7 @@ regUsage instr = case instr of
     ADD    sz src dst  -> usageRM src dst
     SUB    sz src dst  -> usageRM src dst
     IMUL   sz src dst  -> usageRM src dst
+    IMUL64    sd1 sd2   -> mkRU [sd1,sd2] [sd1,sd2]
     MUL    sz src dst  -> usageRM src dst
     IQUOT  sz src dst  -> usageRM src dst
     IREM   sz src dst  -> usageRM src dst
@@ -258,7 +259,8 @@ regUsage instr = case instr of
     SETCC  cond op     -> mkRU [] (def_W op)
     JXX    cond lbl    -> mkRU [] []
     JMP    dsts op     -> mkRU (use_R op) []
-    CALL   imm         -> mkRU [] callClobberedRegs
+    CALL   (Left imm)  -> mkRU [] callClobberedRegs
+    CALL   (Right reg) -> mkRU [reg] callClobberedRegs
     CLTD               -> mkRU [eax] [edx]
     NOP                        -> mkRU [] []
 
@@ -340,6 +342,9 @@ regUsage instr = case instr of
     ST    sz reg addr          -> usage (reg : regAddr addr, [])
     ADD   x cc r1 ar r2        -> usage (r1 : regRI ar, [r2])
     SUB   x cc r1 ar r2        -> usage (r1 : regRI ar, [r2])
+    UMUL    cc r1 ar r2        -> usage (r1 : regRI ar, [r2])
+    SMUL    cc r1 ar r2        -> usage (r1 : regRI ar, [r2])
+    RDY   rd            -> usage ([], [rd])
     AND   b r1 ar r2   -> usage (r1 : regRI ar, [r2])
     ANDN  b r1 ar r2   -> usage (r1 : regRI ar, [r2])
     OR    b r1 ar r2           -> usage (r1 : regRI ar, [r2])
@@ -364,8 +369,10 @@ regUsage instr = case instr of
     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
     JMP   dst addr     -> usage (regAddr addr, [])
 
-    CALL  _ n True     -> noUsage
-    CALL  _ n False    -> usage (argRegs n, callClobberedRegs)
+    CALL  (Left imm)  n True  -> noUsage
+    CALL  (Left imm)  n False -> usage (argRegs n, callClobberedRegs)
+    CALL  (Right reg) n True  -> usage ([reg], [])
+    CALL  (Right reg) n False -> usage (reg : (argRegs n), callClobberedRegs)
 
     _                  -> noUsage
   where
@@ -627,6 +634,7 @@ patchRegs instr env = case instr of
     ADD  sz src dst    -> patch2 (ADD  sz) src dst
     SUB  sz src dst    -> patch2 (SUB  sz) src dst
     IMUL sz src dst    -> patch2 (IMUL sz) src dst
+    IMUL64  sd1 sd2     -> IMUL64 (env sd1) (env sd2)
     MUL sz src dst     -> patch2 (MUL sz) src dst
     IQUOT sz src dst   -> patch2 (IQUOT sz) src dst
     IREM sz src dst    -> patch2 (IREM sz) src dst
@@ -674,6 +682,9 @@ patchRegs instr env = case instr of
     GCOS sz src dst    -> GCOS sz (env src) (env dst)
     GTAN sz src dst    -> GTAN sz (env src) (env dst)
 
+    CALL (Left imm)    -> instr
+    CALL (Right reg)   -> CALL (Right (env reg))
+
     COMMENT _          -> instr
     SEGMENT _          -> instr
     LABEL _            -> instr
@@ -681,7 +692,6 @@ patchRegs instr env = case instr of
     DATA _ _           -> instr
     DELTA _            -> instr
     JXX _ _            -> instr
-    CALL _             -> instr
     CLTD               -> instr
     _                  -> pprPanic "patchRegs(x86)" empty
 
@@ -712,6 +722,9 @@ patchRegs instr env = case instr of
     ST    sz reg addr   -> ST sz (env reg) (fixAddr addr)
     ADD   x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
     SUB   x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
+    UMUL    cc r1 ar r2        -> UMUL cc (env r1) (fixRI ar) (env r2)
+    SMUL    cc r1 ar r2        -> SMUL cc (env r1) (fixRI ar) (env r2)
+    RDY   rd            -> RDY (env rd)
     AND   b r1 ar r2    -> AND b (env r1) (fixRI ar) (env r2)
     ANDN  b r1 ar r2    -> ANDN b (env r1) (fixRI ar) (env r2)
     OR    b r1 ar r2    -> OR b (env r1) (fixRI ar) (env r2)
@@ -733,6 +746,8 @@ patchRegs instr env = case instr of
     FSUB  s r1 r2 r3    -> FSUB s (env r1) (env r2) (env r3)
     FxTOy s1 s2 r1 r2   -> FxTOy s1 s2 (env r1) (env r2)
     JMP   dsts addr     -> JMP dsts (fixAddr addr)
+    CALL  (Left i) n t  -> CALL (Left i) n t
+    CALL  (Right r) n t -> CALL (Right (env r)) n t
     _ -> instr
   where
     fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)