| ... |
... |
@@ -180,7 +180,7 @@ stmtToInstrs stmt = do |
|
180
|
180
|
format = cmmTypeFormat ty
|
|
181
|
181
|
|
|
182
|
182
|
CmmUnsafeForeignCall target result_regs args
|
|
183
|
|
- -> genCCall target result_regs args
|
|
|
183
|
+ -> genCCall platform target result_regs args
|
|
184
|
184
|
|
|
185
|
185
|
CmmBranch id -> genBranch id
|
|
186
|
186
|
CmmCondBranch arg true false prediction -> do
|
| ... |
... |
@@ -1183,24 +1183,25 @@ genCondJump id bool prediction = do |
|
1183
|
1183
|
-- @get_arg@, which moves the arguments to the correct registers/stack
|
|
1184
|
1184
|
-- locations. Apart from that, the code is easy.
|
|
1185
|
1185
|
|
|
1186
|
|
-genCCall :: ForeignTarget -- function to call
|
|
|
1186
|
+genCCall :: Platform
|
|
|
1187
|
+ -> ForeignTarget -- function to call
|
|
1187
|
1188
|
-> [CmmFormal] -- where to put the result
|
|
1188
|
1189
|
-> [CmmActual] -- arguments (of mixed type)
|
|
1189
|
1190
|
-> NatM InstrBlock
|
|
1190
|
|
-genCCall (PrimTarget MO_AcquireFence) _ _
|
|
|
1191
|
+genCCall _ (PrimTarget MO_AcquireFence) _ _
|
|
1191
|
1192
|
= return $ unitOL LWSYNC
|
|
1192
|
|
-genCCall (PrimTarget MO_ReleaseFence) _ _
|
|
|
1193
|
+genCCall _ (PrimTarget MO_ReleaseFence) _ _
|
|
1193
|
1194
|
= return $ unitOL LWSYNC
|
|
1194
|
|
-genCCall (PrimTarget MO_SeqCstFence) _ _
|
|
|
1195
|
+genCCall _ (PrimTarget MO_SeqCstFence) _ _
|
|
1195
|
1196
|
= return $ unitOL HWSYNC
|
|
1196
|
1197
|
|
|
1197
|
|
-genCCall (PrimTarget MO_Touch) _ _
|
|
|
1198
|
+genCCall _ (PrimTarget MO_Touch) _ _
|
|
1198
|
1199
|
= return $ nilOL
|
|
1199
|
1200
|
|
|
1200
|
|
-genCCall (PrimTarget (MO_Prefetch_Data _)) _ _
|
|
|
1201
|
+genCCall _ (PrimTarget (MO_Prefetch_Data _)) _ _
|
|
1201
|
1202
|
= return $ nilOL
|
|
1202
|
1203
|
|
|
1203
|
|
-genCCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n]
|
|
|
1204
|
+genCCall _ (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n]
|
|
1204
|
1205
|
= do let fmt = intFormat width
|
|
1205
|
1206
|
reg_dst = getLocalRegReg dst
|
|
1206
|
1207
|
(instr, n_code) <- case amop of
|
| ... |
... |
@@ -1250,7 +1251,7 @@ genCCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] |
|
1250
|
1251
|
(n_reg, n_code) <- getSomeReg n
|
|
1251
|
1252
|
return (op dst dst (RIReg n_reg), n_code)
|
|
1252
|
1253
|
|
|
1253
|
|
-genCCall (PrimTarget (MO_AtomicRead width _)) [dst] [addr]
|
|
|
1254
|
+genCCall _ (PrimTarget (MO_AtomicRead width _)) [dst] [addr]
|
|
1254
|
1255
|
= do let fmt = intFormat width
|
|
1255
|
1256
|
reg_dst = getLocalRegReg dst
|
|
1256
|
1257
|
form = if widthInBits width == 64 then DS else D
|
| ... |
... |
@@ -1277,12 +1278,12 @@ genCCall (PrimTarget (MO_AtomicRead width _)) [dst] [addr] |
|
1277
|
1278
|
-- This is also what gcc does.
|
|
1278
|
1279
|
|
|
1279
|
1280
|
|
|
1280
|
|
-genCCall (PrimTarget (MO_AtomicWrite width _)) [] [addr, val] = do
|
|
|
1281
|
+genCCall _ (PrimTarget (MO_AtomicWrite width _)) [] [addr, val] = do
|
|
1281
|
1282
|
code <- assignMem_IntCode (intFormat width) addr val
|
|
1282
|
1283
|
return $ unitOL HWSYNC `appOL` code
|
|
1283
|
1284
|
|
|
1284
|
|
-genCCall (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new]
|
|
1285
|
|
- | width == W32 || width == W64
|
|
|
1285
|
+genCCall platform (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new]
|
|
|
1286
|
+ | width == W32 || (width == W64 && not (target32Bit platform))
|
|
1286
|
1287
|
= do
|
|
1287
|
1288
|
(old_reg, old_code) <- getSomeReg old
|
|
1288
|
1289
|
(new_reg, new_code) <- getSomeReg new
|
| ... |
... |
@@ -1311,9 +1312,8 @@ genCCall (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] |
|
1311
|
1312
|
format = intFormat width
|
|
1312
|
1313
|
|
|
1313
|
1314
|
|
|
1314
|
|
-genCCall (PrimTarget (MO_Clz width)) [dst] [src]
|
|
1315
|
|
- = do platform <- getPlatform
|
|
1316
|
|
- let reg_dst = getLocalRegReg dst
|
|
|
1315
|
+genCCall platform (PrimTarget (MO_Clz width)) [dst] [src]
|
|
|
1316
|
+ = do let reg_dst = getLocalRegReg dst
|
|
1317
|
1317
|
if target32Bit platform && width == W64
|
|
1318
|
1318
|
then do
|
|
1319
|
1319
|
RegCode64 code vr_hi vr_lo <- iselExpr64 src
|
| ... |
... |
@@ -1361,9 +1361,8 @@ genCCall (PrimTarget (MO_Clz width)) [dst] [src] |
|
1361
|
1361
|
let cntlz = unitOL (CNTLZ format reg_dst reg)
|
|
1362
|
1362
|
return $ s_code `appOL` pre `appOL` cntlz `appOL` post
|
|
1363
|
1363
|
|
|
1364
|
|
-genCCall (PrimTarget (MO_Ctz width)) [dst] [src]
|
|
1365
|
|
- = do platform <- getPlatform
|
|
1366
|
|
- let reg_dst = getLocalRegReg dst
|
|
|
1364
|
+genCCall platform (PrimTarget (MO_Ctz width)) [dst] [src]
|
|
|
1365
|
+ = do let reg_dst = getLocalRegReg dst
|
|
1367
|
1366
|
if target32Bit platform && width == W64
|
|
1368
|
1367
|
then do
|
|
1369
|
1368
|
let format = II32
|
| ... |
... |
@@ -1425,9 +1424,8 @@ genCCall (PrimTarget (MO_Ctz width)) [dst] [src] |
|
1425
|
1424
|
, SUBFC dst r' (RIImm (ImmInt (format_bits)))
|
|
1426
|
1425
|
]
|
|
1427
|
1426
|
|
|
1428
|
|
-genCCall target dest_regs argsAndHints
|
|
1429
|
|
- = do platform <- getPlatform
|
|
1430
|
|
- case target of
|
|
|
1427
|
+genCCall platform target dest_regs argsAndHints
|
|
|
1428
|
+ = do case target of
|
|
1431
|
1429
|
PrimTarget (MO_S_QuotRem width) -> divOp1 True width
|
|
1432
|
1430
|
dest_regs argsAndHints
|
|
1433
|
1431
|
PrimTarget (MO_U_QuotRem width) -> divOp1 False width
|