[Git][ghc/ghc][wip/angerman/aarch64-ncg] 3 commits: Disable trivial deadlock detection
Moritz Angermann
gitlab at gitlab.haskell.org
Thu Aug 20 02:13:14 UTC 2020
Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC
Commits:
e5059384 by Moritz Angermann at 2020-08-20T02:11:26+00:00
Disable trivial deadlock detection
- - - - -
34c6c6d7 by Moritz Angermann at 2020-08-20T02:12:43+00:00
Adds some annotations
- - - - -
3dbc6ac6 by Moritz Angermann at 2020-08-20T02:13:02+00:00
Trying to get PIC right.
- - - - -
4 changed files:
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/PIC.hs
Changes:
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -1436,6 +1436,10 @@ pprDynamicLinkerAsmLabel platform dllInfo lbl =
SymbolPtr -> text ".LC_" <> ppr lbl
_ -> panic "pprDynamicLinkerAsmLabel"
+ | platformArch platform == ArchAArch64
+ = ppr lbl
+
+
| platformArch platform == ArchX86_64
= case dllInfo of
CodeStub -> ppr lbl <> text "@plt"
=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -522,7 +522,7 @@ getRegister' config plat expr
(op, imm_code) <- litToImm' lit
let rep = cmmLitType plat lit
format = cmmTypeFormat rep
- return (Any format (\dst -> imm_code `snocOL` LDR format (OpReg (formatToWidth format) dst) op))
+ return (Any format (\dst -> imm_code `snocOL` (ANN (text $ show expr) $ LDR format (OpReg (formatToWidth format) dst) op)))
CmmLabelOff lbl off | is12bit (fromIntegral off) -> do
(op, imm_code) <- litToImm' lit
@@ -904,13 +904,19 @@ assignReg_FltCode = assignReg_IntCode
-- -----------------------------------------------------------------------------
-- Jumps
genJump :: CmmExpr{-the branch target-} -> [Reg] -> NatM InstrBlock
-genJump (CmmLit (CmmLabel lbl)) regs
- = return $ unitOL (J (TLabel lbl))
+genJump expr@(CmmLit (CmmLabel lbl)) regs
+ = return $ unitOL (ANN (text $ show expr) (J (TLabel lbl)))
-- = return (toOL [ PUSH_STACK_FRAME
-- , DELTA (-16)
-- , B (TLabel lbl)
-- , POP_STACK_FRAME
-- , DELTA 0] )
+
+-- no reason to load label into register just to
+-- do a register jump.
+genJump expr@(CmmLoad (CmmLit (CmmLabel lbl)) _rep) regs
+ = return $ unitOL (ANN (text $ show expr) (J (TLabel lbl)))
+
genJump expr regs = do
(target, _format, code) <- getSomeReg expr
return (code `appOL` unitOL (ANN (text $ show expr) (J (TReg target)))
=====================================
compiler/GHC/CmmToAsm/AArch64/Ppr.hs
=====================================
@@ -120,7 +120,7 @@ pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr
pprBasicBlock config info_env (BasicBlock blockid instrs)
= maybe_infotable $
pprLabel platform asmLbl $$
- vcat (map (pprInstr platform) (detectTrivialDeadlock optInstrs)) $$
+ vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$
(if ncgDebugLevel config > 0
then ppr (mkAsmTempEndLabel asmLbl) <> char ':'
else empty
@@ -483,22 +483,23 @@ pprInstr platform instr = case instr of
text "\tstrh" <+> pprOp o1 <> comma <+> pprOp o2
STR f o1 o2 -> text "\tstr" <+> pprOp o1 <> comma <+> pprOp o2
+ LDR f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
+ text "\tadrp" <+> pprOp o1 <> comma <+> text ":got:" <> ppr lbl $$
+ text "\tldr" <+> pprOp o1 <> comma <+> text "[" <> pprOp o1 <> comma <+> text ":got_lo12:" <> ppr lbl <> text "]" $$
+ text "\tadd" <+> pprOp o1 <> comma <+> pprOp o1 <> comma <+> char '#' <> int off -- XXX: check that off is in 12bits.
+
LDR f o1 (OpImm (ImmIndex lbl off)) ->
text "\tadrp" <+> pprOp o1 <> comma <+> ppr lbl $$
text "\tadd" <+> pprOp o1 <> comma <+> pprOp o1 <> comma <+> text ":lo12:" <> ppr lbl $$
text "\tadd" <+> pprOp o1 <> comma <+> pprOp o1 <> comma <+> char '#' <> int off -- XXX: check that off is in 12bits.
- -- always GOT loads
- -- LDR f o1 (OpImm (ImmIndex lbl off)) ->
- -- text "\tadrp" <+> pprOp o1 <> comma <+> text ":got:" <> ppr lbl $$
- -- text "\tldr" <+> pprOp o1 <> comma <+> text "[" <> pprOp o1 <> comma <+> text":got_lo12:" <> ppr lbl <> text "]" $$
- -- text "\tadd" <+> pprOp o1 <> comma <+> pprOp o1 <> comma <+> char '#' <> int off -- XXX: check that off is in 12bits.
+
+ LDR f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
+ text "\tadrp" <+> pprOp o1 <> comma <+> text ":got:" <> ppr lbl $$
+ text "\tldr" <+> pprOp o1 <> comma <+> text "[" <> pprOp o1 <> comma <+> text ":got_lo12:" <> ppr lbl <> text "]"
LDR f o1 (OpImm (ImmCLbl lbl)) ->
text "\tadrp" <+> pprOp o1 <> comma <+> ppr lbl $$
text "\tadd" <+> pprOp o1 <> comma <+> pprOp o1 <> comma <+> text ":lo12:" <> ppr lbl
- -- LDR f o1 (OpImm (ImmCLbl lbl)) ->
- -- text "\tadrp" <+> pprOp o1 <> comma <+> text ":got:" <> ppr lbl $$
- -- text "\tldr" <+> pprOp o1 <> comma <+> text "[" <> pprOp o1 <> comma <+> text":got_lo12:" <> ppr lbl <> text "]"
LDR f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 ->
text "\tldrsb" <+> pprOp o1 <> comma <+> pprOp o2
=====================================
compiler/GHC/CmmToAsm/PIC.hs
=====================================
@@ -133,6 +133,14 @@ cmmMakeDynamicReference config referenceKind lbl
addImport stub
return $ CmmLit $ CmmLabel stub
+ -- GOT relative loads work differently on AArch64. We don't
+ -- the got symbol is loaded directly, and not through an additional
+ -- load.
+ AccessViaSymbolPtr | ArchAArch64 <- platformArch platform -> do
+ let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl
+ addImport symbolPtr
+ return $ cmmMakePicReference config symbolPtr
+
AccessViaSymbolPtr -> do
let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl
addImport symbolPtr
@@ -146,7 +154,6 @@ cmmMakeDynamicReference config referenceKind lbl
-- so just jump there if it's a call or a jump
_ -> return $ CmmLit $ CmmLabel lbl
-
-- -----------------------------------------------------------------------------
-- Create a position independent reference to a label.
-- (but do not bother with dynamic linking).
@@ -261,11 +268,11 @@ howToAccessLabel config _ OSMinGW32 this_mod _ lbl
-- is enough for ~64MB of range. Anything else will need to go through a veneer,
-- which is the job of the linker to build. We might only want to lookup
-- Data References through the GOT.
-howToAccessLabel _config ArchAArch64 _os _this_mod kind _lbl
- = case kind of
- DataReference -> AccessDirectly -- AccessViaSymbolPtr
- CallReference -> AccessDirectly
- JumpReference -> AccessDirectly
+-- howToAccessLabel _config ArchAArch64 _os _this_mod kind _lbl
+-- = case kind of
+-- DataReference -> AccessDirectly -- AccessViaSymbolPtr
+-- CallReference -> AccessDirectly
+-- JumpReference -> AccessDirectly
-- Mach-O (Darwin, Mac OS X)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cf52b0a164ea3a0406d6aa4e581a24818da03786...3dbc6ac67a0efac9eaabb5ea4623247fa717d189
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cf52b0a164ea3a0406d6aa4e581a24818da03786...3dbc6ac67a0efac9eaabb5ea4623247fa717d189
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200819/fe294e61/attachment-0001.html>
More information about the ghc-commits
mailing list