[project @ 2001-10-23 22:25:46 by sof]

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

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index 69aceae..d4ea026 100644 (file)
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -20,8 +20,11 @@ import OrdList               ( OrdList, nilOL, isNilOL, unitOL, appOL, toOL,
                          snocOL, consOL, concatOL )
 import AbsCUtils       ( magicIdPrimRep )
 import ForeignCall     ( CCallConv(..) )
-import CLabel          ( isAsmTemp, CLabel, labelDynamic )
-import Maybes          ( maybeToBool, expectJust )
+import CLabel          ( CLabel, labelDynamic )
+#if sparc_TARGET_ARCH || alpha_TARGET_ARCH
+import CLabel          ( isAsmTemp )
+#endif
+import Maybes          ( maybeToBool )
 import PrimRep         ( isFloatingRep, PrimRep(..) )
 import PrimOp          ( PrimOp(..) )
 import Stix            ( getNatLabelNCG, StixTree(..),
@@ -253,7 +256,7 @@ maybeImm (StCLbl l)
 maybeImm (StIndex rep (StCLbl l) (StInt off)) 
    = Just (ImmIndex l (fromInteger off * sizeOf rep))
 maybeImm (StInt i)
-  | i >= toInteger minInt && i <= toInteger maxInt
+  | i >= toInteger (minBound::Int) && i <= toInteger (maxBound::Int)
   = Just (ImmInt (fromInteger i))
   | otherwise
   = Just (ImmInteger i)
@@ -457,7 +460,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
       AddrNeOp -> int_NE_code x y
       AddrLtOp -> trivialCode (CMP ULT) x y
       AddrLeOp -> trivialCode (CMP ULE) x y
-
+       
       FloatGtOp -> cmpF_code (FCMP TF LE) EQQ x y
       FloatGeOp -> cmpF_code (FCMP TF LTT) EQQ x y
       FloatEqOp -> cmpF_code (FCMP TF EQQ) NE x y
@@ -494,6 +497,10 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
       DoubleMulOp -> trivialFCode  DoubleRep (FMUL TF) x y
       DoubleDivOp -> trivialFCode  DoubleRep (FDIV TF) x y
 
+      AddrAddOp  -> trivialCode (ADD Q False) x y
+      AddrSubOp  -> trivialCode (SUB Q False) x y
+      AddrRemOp  -> trivialCode (REM Q True) x y
+
       AndOp  -> trivialCode AND x y
       OrOp   -> trivialCode OR  x y
       XorOp  -> trivialCode XOR x y
@@ -765,6 +772,10 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
       DoubleMulOp -> trivialFCode DoubleRep GMUL x y
       DoubleDivOp -> trivialFCode DoubleRep GDIV x y
 
+      AddrAddOp -> add_code L x y
+      AddrSubOp -> sub_code L x y
+      AddrRemOp -> trivialCode (IREM L) Nothing x y
+
       AndOp -> let op = AND L in trivialCode op (Just op) x y
       OrOp  -> let op = OR  L in trivialCode op (Just op) x y
       XorOp -> let op = XOR L in trivialCode op (Just op) x y
@@ -1132,6 +1143,10 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
       DoubleMulOp -> trivialFCode DoubleRep FMUL x y
       DoubleDivOp -> trivialFCode DoubleRep FDIV x y
 
+      AddrAddOp -> trivialCode (ADD False False) x y
+      AddrSubOp -> trivialCode (SUB False False) x y
+      AddrRemOp -> imul_div SLIT(".rem")  x y
+
       AndOp -> trivialCode (AND False) x y
       OrOp  -> trivialCode (OR  False) x y
       XorOp -> trivialCode (XOR False) x y
@@ -2344,7 +2359,7 @@ register allocator.
 \begin{code}
 genCCall
     :: FAST_STRING     -- function to call
-    -> CallConv
+    -> CCallConv
     -> PrimRep         -- type of the result
     -> [StixTree]      -- arguments (of mixed type)
     -> NatM InstrBlock
@@ -2441,9 +2456,12 @@ genCCall fn cconv kind args
        call = toOL (
                   [CALL (fn__2 tot_arg_size)]
                   ++
+                       -- Deallocate parameters after call for ccall;
+                       -- but not for stdcall (callee does it)
                   (if cconv == StdCallConv then [] else 
                   [ADD L (OpImm (ImmInt tot_arg_size)) (OpReg esp)])
                   ++
+
                   [DELTA (delta + tot_arg_size)]
                )
     in
@@ -2459,7 +2477,7 @@ genCCall fn cconv kind args
     fn__2 tot_arg_size
        | head fn_u == '.'
        = ImmLit (text (fn_u ++ stdcallsize tot_arg_size))
-       | otherwise 
+       | otherwise     -- General case
        = ImmLab False (text (fn_u ++ stdcallsize tot_arg_size))
 
     stdcallsize tot_arg_size