Peter Trommler pushed to branch wip/T23246 at Glasgow Haskell Compiler / GHC

Commits:

1 changed file:

Changes:

  • compiler/GHC/CmmToAsm/PPC/CodeGen.hs
    ... ... @@ -1204,6 +1204,13 @@ genCCall _ (PrimTarget MO_Touch) _ _
    1204 1204
     genCCall _ (PrimTarget (MO_Prefetch_Data _)) _ _
    
    1205 1205
      = return $ nilOL
    
    1206 1206
     
    
    1207
    +genCCall platform (PrimTarget (MO_AtomicRMW W64 amop)) [dst] [addr, n]
    
    1208
    +  | not $ target32Bit platform
    
    1209
    +  = atomicRMW W64 amop dst addr n
    
    1210
    +
    
    1211
    +genCCall _ (PrimTarget (MO_AtomicRMW W32 amop)) [dst] [addr, n]
    
    1212
    +  = atomicRMW W32 amop dst addr n
    
    1213
    +
    
    1207 1214
     genCCall platform (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n]
    
    1208 1215
      = do let fmt      = intFormat (max width W32)
    
    1209 1216
               reg_dst  = getLocalRegReg dst
    
    ... ... @@ -1211,7 +1218,7 @@ genCCall platform (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n]
    1211 1218
           (Amode aligned_addr align_code, maybe_unaligned_addr) <- case width of
    
    1212 1219
              W8  -> align_address
    
    1213 1220
              W16 -> align_address
    
    1214
    -         _   -> getAmodeIndex addr
    
    1221
    +         _   -> panic "PPC: AtomicRMW illegal width"
    
    1215 1222
     
    
    1216 1223
           shift        <- getNewRegNat fmt
    
    1217 1224
           mask         <- getNewRegNat fmt
    
    ... ... @@ -1266,22 +1273,7 @@ genCCall platform (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n]
    1266 1273
           (n_ri, pre_code, mid_code, post_code) <- case width of
    
    1267 1274
             W8  -> handle_value
    
    1268 1275
             W16 -> handle_value
    
    1269
    -        _   -> do
    
    1270
    -          (n_ri, n_code) <- case amop of
    
    1271
    -            AMO_Add  -> getSomeRegOrImm True
    
    1272
    -            AMO_Sub  -> case n of
    
    1273
    -                 CmmLit (CmmInt i _) | Just imm <- makeImmediate width True (-i)
    
    1274
    -                    -> return (RIImm imm, nilOL)
    
    1275
    -                 _
    
    1276
    -                    -> do
    
    1277
    -                          (n_reg, n_code) <- getSomeReg n
    
    1278
    -                          return  (RIReg n_reg, n_code)
    
    1279
    -            AMO_And  -> getSomeRegOrImm False
    
    1280
    -            AMO_Or   -> getSomeRegOrImm False
    
    1281
    -            AMO_Xor  -> getSomeRegOrImm False
    
    1282
    -            AMO_Nand -> do (n_reg, n_code) <- getSomeReg n
    
    1283
    -                           return (RIReg n_reg, n_code)
    
    1284
    -          return (n_ri, n_code, nilOL, unitOL $ MR reg_dst tmp2)
    
    1276
    +        _   -> panic "PPC: AtomicRMW illegal width"
    
    1285 1277
     
    
    1286 1278
           let instr = case amop of
    
    1287 1279
                 AMO_Add  -> ADD tmp2 tmp1 n_ri
    
    ... ... @@ -1315,18 +1307,6 @@ genCCall platform (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n]
    1315 1307
             `appOL` post_code
    
    1316 1308
     
    
    1317 1309
             where
    
    1318
    -           getAmodeIndex (CmmMachOp (MO_Add _) [x, y])
    
    1319
    -             = do
    
    1320
    -                 (regX, codeX) <- getSomeReg x
    
    1321
    -                 (regY, codeY) <- getSomeReg y
    
    1322
    -                 return ((Amode (AddrRegReg regX regY) (codeX `appOL` codeY))
    
    1323
    -                        , Nothing)
    
    1324
    -           getAmodeIndex other
    
    1325
    -             = do
    
    1326
    -                 (reg, code) <- getSomeReg other
    
    1327
    -                 return ((Amode (AddrRegReg r0 reg) code) -- NB: r0 is 0 here!
    
    1328
    -                        , Nothing)
    
    1329
    -
    
    1330 1310
                align_address
    
    1331 1311
                  = do
    
    1332 1312
                  let addr_fmt = intFormat (wordWidth platform)
    
    ... ... @@ -1336,20 +1316,11 @@ genCCall platform (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n]
    1336 1316
                          (ucode `snocOL` (CLRRI addr_fmt aligned_addr
    
    1337 1317
                                           unaligned_addr 2)), Just unaligned_addr)
    
    1338 1318
     
    
    1339
    -           getSomeRegOrImm sign
    
    1340
    -             = case n of
    
    1341
    -                 CmmLit (CmmInt i _) | Just imm <- makeImmediate width sign i
    
    1342
    -                    -> return (RIImm imm, nilOL)
    
    1343
    -                 _
    
    1344
    -                    -> do
    
    1345
    -                          (n_reg, n_code) <- getSomeReg n
    
    1346
    -                          return  (RIReg n_reg, n_code)
    
    1347
    -
    
    1348 1319
                shift_amount platform shift
    
    1349 1320
                  = let shift_amt = case width of
    
    1350 1321
                                      W8  -> 24
    
    1351 1322
                                      W16 -> 16
    
    1352
    -                                 _   -> 0
    
    1323
    +                                 _   -> panic "PPC: AtomicRMW illegal width"
    
    1353 1324
                    in case platformByteOrder platform of
    
    1354 1325
                         BigEndian -> unitOL $ XOR shift shift
    
    1355 1326
                                                   (RIImm (ImmInt shift_amt))
    
    ... ... @@ -2734,6 +2705,79 @@ coerceFP2Int' (ArchPPC_64 _) _ toRep x = do
    2734 2705
     
    
    2735 2706
     coerceFP2Int' _ _ _ _ = panic "PPC.CodeGen.coerceFP2Int: unknown arch"
    
    2736 2707
     
    
    2708
    +atomicRMW :: Width ->
    
    2709
    +             AtomicMachOp ->
    
    2710
    +             LocalReg ->   -- destination
    
    2711
    +             CmmExpr ->    -- address
    
    2712
    +             CmmExpr ->    -- operand
    
    2713
    +             NatM InstrBlock
    
    2714
    +atomicRMW width amop dst addr n
    
    2715
    +  = do let fmt      = intFormat width
    
    2716
    +           reg_dst  = getLocalRegReg dst
    
    2717
    +       Amode reg_addr addr_code <- getAmodeIndex addr
    
    2718
    +       (n_ri, n_code) <- case amop of
    
    2719
    +         AMO_Add  -> getSomeRegOrImm True n
    
    2720
    +         AMO_Sub  -> case n of
    
    2721
    +           CmmLit (CmmInt i _) | Just imm <- makeImmediate width True (-i)
    
    2722
    +                   -> return (RIImm imm, nilOL)
    
    2723
    +           _       -> do (n_reg, n_code) <- getSomeReg n
    
    2724
    +                         return  (RIReg n_reg, n_code)
    
    2725
    +         AMO_And  -> getSomeRegOrImm False n
    
    2726
    +         AMO_Or   -> getSomeRegOrImm False n
    
    2727
    +         AMO_Xor  -> getSomeRegOrImm False n
    
    2728
    +         AMO_Nand -> do (n_reg, n_code) <- getSomeReg n
    
    2729
    +                        return (RIReg n_reg, n_code)
    
    2730
    +
    
    2731
    +       tmp <- getNewRegNat fmt
    
    2732
    +
    
    2733
    +       let instr = case amop of
    
    2734
    +             AMO_Add  -> ADD reg_dst tmp n_ri
    
    2735
    +             AMO_Sub  -> case n_ri of
    
    2736
    +               RIReg n_reg -> SUBF reg_dst n_reg tmp
    
    2737
    +               RIImm _     -> ADD  reg_dst tmp n_ri
    
    2738
    +             AMO_And  -> AND reg_dst tmp n_ri
    
    2739
    +             AMO_Or   -> OR  reg_dst tmp n_ri
    
    2740
    +             AMO_Xor  -> XOR reg_dst tmp n_ri
    
    2741
    +             AMO_Nand -> case n_ri of
    
    2742
    +               RIReg n_reg -> NAND reg_dst tmp n_reg
    
    2743
    +               _           -> panic "PPC NCG: No NAND immediate"
    
    2744
    +       lbl_retry <- getBlockIdNat
    
    2745
    +       lbl_done <- getBlockIdNat
    
    2746
    +       return $ addr_code `appOL` n_code
    
    2747
    +        `appOL` toOL [ HWSYNC
    
    2748
    +                     , BCC ALWAYS lbl_retry Nothing
    
    2749
    +
    
    2750
    +                     , NEWBLOCK lbl_retry
    
    2751
    +                     , LDR fmt tmp reg_addr
    
    2752
    +                     ]
    
    2753
    +        `snocOL` instr
    
    2754
    +        `appOL` toOL [ STC fmt reg_dst reg_addr
    
    2755
    +                     , BCC NE lbl_retry (Just False)
    
    2756
    +                     , BCC ALWAYS lbl_done Nothing
    
    2757
    +
    
    2758
    +                     , NEWBLOCK lbl_done
    
    2759
    +                     , ISYNC
    
    2760
    +                     ]
    
    2761
    +         where
    
    2762
    +           getAmodeIndex (CmmMachOp (MO_Add _) [x, y])
    
    2763
    +             = do
    
    2764
    +                 (regX, codeX) <- getSomeReg x
    
    2765
    +                 (regY, codeY) <- getSomeReg y
    
    2766
    +                 return $ Amode (AddrRegReg regX regY) (codeX `appOL` codeY)
    
    2767
    +
    
    2768
    +           getAmodeIndex other
    
    2769
    +             = do
    
    2770
    +                 (reg, code) <- getSomeReg other
    
    2771
    +                 return $ Amode (AddrRegReg r0 reg) code -- NB: r0 is 0 here!
    
    2772
    +
    
    2773
    +           getSomeRegOrImm sign (CmmLit (CmmInt i _))
    
    2774
    +             | Just imm <- makeImmediate width sign i
    
    2775
    +             = return (RIImm imm, nilOL)
    
    2776
    +           getSomeRegOrImm _ n
    
    2777
    +             = do (n_reg, n_code) <- getSomeReg n
    
    2778
    +                  return  (RIReg n_reg, n_code)
    
    2779
    +
    
    2780
    +
    
    2737 2781
     -- Note [.LCTOC1 in PPC PIC code]
    
    2738 2782
     -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    2739 2783
     -- The .LCTOC1 label is defined to point 32768 bytes into the GOT table