- -> Maybe [GlobalReg] -> P ExtCode
-foreignCall "C" results_code expr_code args_code vols
- = return $ do
- results <- sequence results_code
- expr <- expr_code
- args <- sequence args_code
- code (emitForeignCall' PlayRisky results
- (CmmForeignCall expr CCallConv) args vols)
-foreignCall conv _ _ _ _
- = fail ("unknown calling convention: " ++ conv)
+ -> Maybe [GlobalReg]
+ -> C_SRT
+ -> P ExtCode
+foreignCall conv_string results_code expr_code args_code vols srt
+ = do convention <- case conv_string of
+ "C" -> return CCallConv
+ "C--" -> return CmmCallConv
+ _ -> fail ("unknown calling convention: " ++ conv_string)
+ return $ do
+ results <- sequence results_code
+ expr <- expr_code
+ args <- sequence args_code
+ code (emitForeignCall' PlayRisky results
+ (CmmForeignCall expr convention) args vols srt) where
+
+primCall
+ :: [ExtFCode (CmmFormal,MachHint)]
+ -> FastString
+ -> [ExtFCode (CmmExpr,MachHint)]
+ -> Maybe [GlobalReg]
+ -> C_SRT
+ -> P ExtCode
+primCall results_code name args_code vols srt
+ = case lookupUFM callishMachOps name of
+ Nothing -> fail ("unknown primitive " ++ unpackFS name)
+ Just p -> return $ do
+ results <- sequence results_code
+ args <- sequence args_code
+ code (emitForeignCall' PlayRisky results (CmmPrim p) args vols srt)