[project @ 2002-03-12 16:48:52 by simonmar]

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

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index 023225c..3c89799 100644 (file)
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -1241,6 +1241,7 @@ getRegister (StMachOp mop [x]) -- unary PrimOps
   = case mop of
       MO_NatS_Neg      -> trivialUCode (SUB False False g0) x
       MO_Nat_Not       -> trivialUCode (XNOR False g0) x
+      MO_32U_to_8U     -> trivialCode (AND False) x (StInt 255)
 
       MO_Flt_Neg       -> trivialUFCode FloatRep (FNEG F) x
       MO_Dbl_Neg       -> trivialUFCode DoubleRep (FNEG DF) x
@@ -1265,6 +1266,7 @@ getRegister (StMachOp mop [x]) -- unary PrimOps
       MO_NatP_to_NatS -> conversionNop IntRep    x
 
       -- sign-extending widenings
+      MO_8U_to_32U    -> integerExtend False 24 x
       MO_8U_to_NatU   -> integerExtend False 24 x
       MO_8S_to_NatS   -> integerExtend True  24 x
       MO_16U_to_NatU  -> integerExtend False 16 x
@@ -2703,18 +2705,6 @@ genCCall fn cconv kind args
 
 #if i386_TARGET_ARCH
 
-genCCall fn cconv ret_rep [StInt i]
-  | isLeft fn && unLeft fn == SLIT ("PerformGC_wrapper")
-  = let call = toOL [
-                  MOV L (OpImm (ImmInt (fromInteger i))) (OpReg eax),
-                 CALL (Left (ImmLit (ptext (if   underscorePrefix 
-                                       then (SLIT ("_PerformGC_wrapper"))
-                                       else (SLIT ("PerformGC_wrapper"))))))
-               ]
-    in
-    returnNat call
-
-
 genCCall fn cconv ret_rep args
   = mapNat push_arg
            (reverse args)      `thenNat` \ sizes_n_codes ->
@@ -2728,7 +2718,7 @@ genCCall fn cconv ret_rep args
            -> returnNat (unitOL (CALL (Left (fn__2 tot_arg_size))))
         Right dyn 
            -> get_op dyn `thenNat` \ (dyn_c, dyn_r, dyn_rep) ->
-              ASSERT(dyn_rep == L)
+              ASSERT(case dyn_rep of { L -> True; _ -> False})
               returnNat (dyn_c `snocOL` CALL (Right dyn_r))
     ) 
                                `thenNat` \ callinsns ->
@@ -2762,6 +2752,10 @@ genCCall fn cconv ret_rep args
        | cconv == StdCallConv = '@':show tot_arg_size
        | otherwise            = ""
 
+    -- floats are always promoted to doubles when passed to a ccall
+    promote_size F  = DF
+    promote_size sz = sz
+
     arg_size DF = 8
     arg_size F  = 4
     arg_size _  = 4
@@ -2785,14 +2779,17 @@ genCCall fn cconv ret_rep args
       | otherwise
       = get_op arg                     `thenNat` \ (code, reg, sz) ->
         getDeltaNat                    `thenNat` \ delta ->
-        arg_size sz                    `bind`    \ size ->
+       let 
+               real_sz = promote_size sz
+               size    = arg_size real_sz
+       in
         setDeltaNat (delta-size)       `thenNat` \ _ ->
-        if   (case sz of DF -> True; F -> True; _ -> False)
+        if   (case real_sz of DF -> True; _ -> False)
         then returnNat (size,
                         code `appOL`
                         toOL [SUB L (OpImm (ImmInt size)) (OpReg esp),
                               DELTA (delta-size),
-                              GST sz reg (AddrBaseIndex (Just esp) 
+                              GST DF reg (AddrBaseIndex (Just esp) 
                                                         Nothing 
                                                         (ImmInt 0))]
                        )