Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
b7cadd88
Commit
b7cadd88
authored
Jun 29, 2006
by
Simon Marlow
Browse files
new syntax: "prim %OP (args)" for using CallishMachOps in .cmm
parent
f9c1512a
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/CmmLex.x
View file @
b7cadd88
...
...
@@ -137,6 +137,7 @@ data CmmToken
| CmmT_if
| CmmT_jump
| CmmT_foreign
| CmmT_prim
| CmmT_import
| CmmT_switch
| CmmT_case
...
...
@@ -211,6 +212,7 @@ reservedWordsFM = listToUFM $
( "if", CmmT_if ),
( "jump", CmmT_jump ),
( "foreign", CmmT_foreign ),
( "prim", CmmT_prim ),
( "import", CmmT_import ),
( "switch", CmmT_switch ),
( "case", CmmT_case ),
...
...
compiler/cmm/CmmParse.y
View file @
b7cadd88
...
...
@@ -103,6 +103,7 @@ import Data.Char ( ord )
'if' { L _ (CmmT_if) }
'jump' { L _ (CmmT_jump) }
'foreign' { L _ (CmmT_foreign) }
'prim' { L _ (CmmT_prim) }
'import' { L _ (CmmT_import) }
'switch' { L _ (CmmT_switch) }
'case' { L _ (CmmT_case) }
...
...
@@ -265,6 +266,11 @@ stmt :: { ExtCode }
| lreg '=' 'foreign' STRING expr '(' hint_exprs0 ')' vols ';'
{% let result = do r <- $1; return (r,NoHint) in
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 ';'
{% do h <- parseHint $1;
let result = do r <- $2; return (r,h) in
...
...
@@ -530,6 +536,12 @@ machOps = listToUFM $
( "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 "ptr" = return PtrHint
parseHint "signed" = return SignedHint
...
...
@@ -751,6 +763,19 @@ foreignCall "C" results_code expr_code args_code vols
foreignCall 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 rep addr_code val_code
= do addr <- addr_code
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment