import SMRep ( fixedHdrSize, CgRep(..) )
import Lexer
-import ForeignCall ( CCallConv(..) )
+import ForeignCall ( CCallConv(..), Safety(..) )
import Literal ( mkMachInt )
import Unique
import UniqFM
import Outputable
import Monad ( when )
+import Data.Char ( ord )
#include "HsVersions.h"
}
return [CmmStaticLit (getLit e)] }
| type ';' { return [CmmUninitialised
(machRepByteWidth $1)] }
- | 'bits8' '[' ']' STRING ';' { return [CmmString $4] }
+ | 'bits8' '[' ']' STRING ';' { return [mkString $4] }
| 'bits8' '[' INT ']' ';' { return [CmmUninitialised
(fromIntegral $3)] }
| typenot8 '[' INT ']' ';' { return [CmmUninitialised
-- This is not C-- syntax. What to do?
vols :: { Maybe [GlobalReg] }
: {- empty -} { Nothing }
+ | '[' ']' { Just [] }
| '[' globals ']' { Just $2 }
globals :: { [GlobalReg] }
section "bss" = UninitialisedData
section s = OtherSection s
+mkString :: String -> CmmStatic
+mkString s = CmmString (map (fromIntegral.ord) s)
+
-- mkMachOp infers the type of the MachOp from the type of its first
-- argument. We assume that this is correct: for MachOps that don't have
-- symmetrical args (e.g. shift ops), the first arg determines the type of
exprMacros :: UniqFM ([CmmExpr] -> CmmExpr)
exprMacros = listToUFM [
( FSLIT("ENTRY_CODE"), \ [x] -> entryCode x ),
- ( FSLIT("GET_ENTRY"), \ [x] -> entryCode (closureInfoPtr x) ),
+ ( FSLIT("INFO_PTR"), \ [x] -> closureInfoPtr x ),
( FSLIT("STD_INFO"), \ [x] -> infoTable x ),
+ ( FSLIT("FUN_INFO"), \ [x] -> funInfoTable x ),
+ ( FSLIT("GET_ENTRY"), \ [x] -> entryCode (closureInfoPtr x) ),
( FSLIT("GET_STD_INFO"), \ [x] -> infoTable (closureInfoPtr x) ),
( FSLIT("GET_FUN_INFO"), \ [x] -> funInfoTable (closureInfoPtr x) ),
( FSLIT("INFO_TYPE"), \ [x] -> infoTableClosureType x ),
results <- sequence results_code
expr <- expr_code
args <- sequence args_code
- stmtEC (CmmCall (CmmForeignCall expr CCallConv) results args vols)
+ code (emitForeignCall' PlayRisky results
+ (CmmForeignCall expr CCallConv) args vols)
foreignCall conv _ _ _ _
= fail ("unknown calling convention: " ++ conv)