X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmForeign.hs;h=af00c79e4e8076f590893ebeaa6524886de3d5ed;hb=b48fc016e9b15c465ba2c2f1d42b6221bcd19b45;hp=711b79e13f6e9179d406e74af1870980f69a7d83;hpb=497302c44ad08c6c27d0e15d94a787f332c0cfec;p=ghc-hetmet.git

diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index 711b79e..af00c79 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -37,6 +37,7 @@ import StaticFlags
 import Maybes
 import Outputable
 import ZipCfgCmmRep
+import BasicTypes
 
 import Control.Monad
 
@@ -53,21 +54,22 @@ cgForeignCall :: [LocalReg]		-- r1,r2  where to put the results
 
 cgForeignCall results result_hints (CCall (CCallSpec target cconv safety)) stg_args
   = do	{ cmm_args <- getFCallArgs stg_args
-	; let (args, arg_hints) = unzip cmm_args
-	      fc = ForeignConvention cconv arg_hints result_hints
-	      (call_args, cmm_target)
-		= case target of
-		   StaticTarget lbl -> (args, CmmLit (CmmLabel 
-						(mkForeignLabel lbl (call_size args) False IsFunction)))
-		   DynamicTarget    ->  case args of
-                                        fn:rest -> (rest, fn)
-                                        [] -> panic "cgForeignCall []"
-	      call_target = ForeignTarget cmm_target fc
-	
-	; srt <- getSRTInfo NoSRT	-- SLPJ: Not sure what SRT 
-					-- is right here
+        ; let ((call_args, arg_hints), cmm_target)
+                = case target of
+                    StaticTarget lbl ->
+                      (unzip cmm_args,
+                       CmmLit (CmmLabel (mkForeignLabel lbl (call_size cmm_args)
+                                                        False IsFunction)))
+                    DynamicTarget    ->  case cmm_args of
+                                           (fn,_):rest -> (unzip rest, fn)
+                                           [] -> panic "cgForeignCall []"
+              fc = ForeignConvention cconv arg_hints result_hints
+              call_target = ForeignTarget cmm_target fc
+        
+        ; srt <- getSRTInfo NoSRT        -- SLPJ: Not sure what SRT 
+                                        -- is right here
                                         -- JD: Does it matter in the new codegen?
-	; emitForeignCall safety results call_target call_args srt CmmMayReturn }
+        ; emitForeignCall safety results call_target call_args srt CmmMayReturn }
   where
 	-- in the stdcall calling convention, the symbol needs @size appended
 	-- to it, where size is the total number of bytes of arguments.  We
@@ -78,7 +80,7 @@ cgForeignCall results result_hints (CCall (CCallSpec target cconv safety)) stg_a
 	| otherwise            = Nothing
 
 	-- ToDo: this might not be correct for 64-bit API
-      arg_size arg = max (widthInBytes $ typeWidth $ cmmExprType arg) wORD_SIZE
+      arg_size (arg, _) = max (widthInBytes $ typeWidth $ cmmExprType arg) wORD_SIZE
 
 cgForeignCall _ _ (DNCall _) _
   = panic "cgForeignCall: DNCall"