Commit b7cadd88 authored by Simon Marlow's avatar Simon Marlow
Browse files

new syntax: "prim %OP (args)" for using CallishMachOps in .cmm

parent f9c1512a
...@@ -137,6 +137,7 @@ data CmmToken ...@@ -137,6 +137,7 @@ data CmmToken
| CmmT_if | CmmT_if
| CmmT_jump | CmmT_jump
| CmmT_foreign | CmmT_foreign
| CmmT_prim
| CmmT_import | CmmT_import
| CmmT_switch | CmmT_switch
| CmmT_case | CmmT_case
...@@ -211,6 +212,7 @@ reservedWordsFM = listToUFM $ ...@@ -211,6 +212,7 @@ reservedWordsFM = listToUFM $
( "if", CmmT_if ), ( "if", CmmT_if ),
( "jump", CmmT_jump ), ( "jump", CmmT_jump ),
( "foreign", CmmT_foreign ), ( "foreign", CmmT_foreign ),
( "prim", CmmT_prim ),
( "import", CmmT_import ), ( "import", CmmT_import ),
( "switch", CmmT_switch ), ( "switch", CmmT_switch ),
( "case", CmmT_case ), ( "case", CmmT_case ),
......
...@@ -103,6 +103,7 @@ import Data.Char ( ord ) ...@@ -103,6 +103,7 @@ import Data.Char ( ord )
'if' { L _ (CmmT_if) } 'if' { L _ (CmmT_if) }
'jump' { L _ (CmmT_jump) } 'jump' { L _ (CmmT_jump) }
'foreign' { L _ (CmmT_foreign) } 'foreign' { L _ (CmmT_foreign) }
'prim' { L _ (CmmT_prim) }
'import' { L _ (CmmT_import) } 'import' { L _ (CmmT_import) }
'switch' { L _ (CmmT_switch) } 'switch' { L _ (CmmT_switch) }
'case' { L _ (CmmT_case) } 'case' { L _ (CmmT_case) }
...@@ -265,6 +266,11 @@ stmt :: { ExtCode } ...@@ -265,6 +266,11 @@ stmt :: { ExtCode }
| lreg '=' 'foreign' STRING expr '(' hint_exprs0 ')' vols ';' | lreg '=' 'foreign' STRING expr '(' hint_exprs0 ')' vols ';'
{% let result = do r <- $1; return (r,NoHint) in {% let result = do r <- $1; return (r,NoHint) in
foreignCall $4 [result] $5 $7 $9 } foreignCall $4 [result] $5 $7 $9 }
| 'prim' '%' NAME '(' hint_exprs0 ')' vols ';'
{% primCall [] $3 $5 $7 }
| lreg '=' 'prim' '%' NAME '(' hint_exprs0 ')' vols ';'
{% let result = do r <- $1; return (r,NoHint) in
primCall [result] $5 $7 $9 }
| STRING lreg '=' 'foreign' STRING expr '(' hint_exprs0 ')' vols ';' | STRING lreg '=' 'foreign' STRING expr '(' hint_exprs0 ')' vols ';'
{% do h <- parseHint $1; {% do h <- parseHint $1;
let result = do r <- $2; return (r,h) in let result = do r <- $2; return (r,h) in
...@@ -530,6 +536,12 @@ machOps = listToUFM $ ...@@ -530,6 +536,12 @@ machOps = listToUFM $
( "i2f64", flip MO_S_Conv F64 ) ( "i2f64", flip MO_S_Conv F64 )
] ]
callishMachOps = listToUFM $
map (\(x, y) -> (mkFastString x, y)) [
( "write_barrier", MO_WriteBarrier )
-- ToDo: the rest, maybe
]
parseHint :: String -> P MachHint parseHint :: String -> P MachHint
parseHint "ptr" = return PtrHint parseHint "ptr" = return PtrHint
parseHint "signed" = return SignedHint parseHint "signed" = return SignedHint
...@@ -751,6 +763,19 @@ foreignCall "C" results_code expr_code args_code vols ...@@ -751,6 +763,19 @@ foreignCall "C" results_code expr_code args_code vols
foreignCall conv _ _ _ _ foreignCall conv _ _ _ _
= fail ("unknown calling convention: " ++ conv) = fail ("unknown calling convention: " ++ conv)
primCall
:: [ExtFCode (CmmReg,MachHint)]
-> FastString
-> [ExtFCode (CmmExpr,MachHint)]
-> Maybe [GlobalReg] -> P ExtCode
primCall results_code name args_code vols
= 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)
doStore :: MachRep -> ExtFCode CmmExpr -> ExtFCode CmmExpr -> ExtCode doStore :: MachRep -> ExtFCode CmmExpr -> ExtFCode CmmExpr -> ExtCode
doStore rep addr_code val_code doStore rep addr_code val_code
= do addr <- addr_code = do addr <- addr_code
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment