[Git][ghc/ghc][master] AArch64: Simplify BL instruction

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Jun 19 10:47:10 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
eb612fbc by Sven Tennie at 2024-06-19T06:46:00-04:00
AArch64: Simplify BL instruction

The BL constructor carried unused data in its third argument.

- - - - -


3 changed files:

- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs


Changes:

=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -1596,7 +1596,7 @@ genCCall target dest_regs arg_regs bid = do
                        then 8 * (stackSpace' `div` 8 + 1)
                        else stackSpace'
 
-      (returnRegs, readResultsCode)   <- readResults allGpArgRegs allFpArgRegs dest_regs [] nilOL
+      readResultsCode <- readResults allGpArgRegs allFpArgRegs dest_regs [] nilOL
 
       let moveStackDown 0 = toOL [ PUSH_STACK_FRAME
                                  , DELTA (-16) ]
@@ -1614,7 +1614,7 @@ genCCall target dest_regs arg_regs bid = do
       let code =    call_target_code          -- compute the label (possibly into a register)
             `appOL` moveStackDown (stackSpace `div` 8)
             `appOL` passArgumentsCode         -- put the arguments into x0, ...
-            `appOL` (unitOL $ BL call_target passRegs returnRegs) -- branch and link.
+            `appOL` (unitOL $ BL call_target passRegs) -- branch and link.
             `appOL` readResultsCode           -- parse the results into registers
             `appOL` moveStackUp (stackSpace `div` 8)
       return (code, Nothing)
@@ -2203,8 +2203,8 @@ genCCall target dest_regs arg_regs bid = do
 
     passArguments _ _ _ _ _ _ _ = pprPanic "passArguments" (text "invalid state")
 
-    readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg]-> InstrBlock -> NatM ([Reg], InstrBlock)
-    readResults _ _ [] accumRegs accumCode = return (accumRegs, accumCode)
+    readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg]-> InstrBlock -> NatM (InstrBlock)
+    readResults _ _ [] _ accumCode = return accumCode
     readResults [] _ _ _ _ = do
       platform <- getPlatform
       pprPanic "genCCall, out of gp registers when reading results" (pdoc platform target)


=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -117,7 +117,7 @@ regUsageOfInstr platform instr = case instr of
   J t                      -> usage (regTarget t, [])
   B t                      -> usage (regTarget t, [])
   BCOND _ t                -> usage (regTarget t, [])
-  BL t ps _rs              -> usage (regTarget t ++ ps, callerSavedRegisters)
+  BL t ps                  -> usage (regTarget t ++ ps, callerSavedRegisters)
 
   -- 5. Atomic Instructions ----------------------------------------------------
   -- 6. Conditional Instructions -----------------------------------------------
@@ -254,7 +254,7 @@ patchRegsOfInstr instr env = case instr of
     -- 4. Branch Instructions --------------------------------------------------
     J t            -> J (patchTarget t)
     B t            -> B (patchTarget t)
-    BL t rs ts     -> BL (patchTarget t) rs ts
+    BL t rs        -> BL (patchTarget t) rs
     BCOND c t      -> BCOND c (patchTarget t)
 
     -- 5. Atomic Instructions --------------------------------------------------
@@ -320,7 +320,7 @@ jumpDestsOfInstr (CBZ _ t) = [ id | TBlock id <- [t]]
 jumpDestsOfInstr (CBNZ _ t) = [ id | TBlock id <- [t]]
 jumpDestsOfInstr (J t) = [id | TBlock id <- [t]]
 jumpDestsOfInstr (B t) = [id | TBlock id <- [t]]
-jumpDestsOfInstr (BL t _ _) = [ id | TBlock id <- [t]]
+jumpDestsOfInstr (BL t _) = [ id | TBlock id <- [t]]
 jumpDestsOfInstr (BCOND _ t) = [ id | TBlock id <- [t]]
 jumpDestsOfInstr _ = []
 
@@ -341,7 +341,7 @@ patchJumpInstr instr patchF
         CBNZ r (TBlock bid) -> CBNZ r (TBlock (patchF bid))
         J (TBlock bid) -> J (TBlock (patchF bid))
         B (TBlock bid) -> B (TBlock (patchF bid))
-        BL (TBlock bid) ps rs -> BL (TBlock (patchF bid)) ps rs
+        BL (TBlock bid) ps -> BL (TBlock (patchF bid)) ps
         BCOND c (TBlock bid) -> BCOND c (TBlock (patchF bid))
         _ -> panic $ "patchJumpInstr: " ++ instrCon instr
 
@@ -626,7 +626,7 @@ data Instr
     -- Branching.
     | J Target            -- like B, but only generated from genJump. Used to distinguish genJumps from others.
     | B Target            -- unconditional branching b/br. (To a blockid, label or register)
-    | BL Target [Reg] [Reg] -- branch and link (e.g. set x30 to next pc, and branch)
+    | BL Target [Reg] -- branch and link (e.g. set x30 to next pc, and branch)
     | BCOND Cond Target   -- branch with condition. b.<cond>
 
     -- 8. Synchronization Instructions -----------------------------------------


=====================================
compiler/GHC/CmmToAsm/AArch64/Ppr.hs
=====================================
@@ -426,9 +426,9 @@ pprInstr platform instr = case instr of
   B (TLabel lbl) -> line $ text "\tb" <+> pprAsmLabel platform lbl
   B (TReg r)     -> line $ text "\tbr" <+> pprReg W64 r
 
-  BL (TBlock bid) _ _ -> line $ text "\tbl" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
-  BL (TLabel lbl) _ _ -> line $ text "\tbl" <+> pprAsmLabel platform lbl
-  BL (TReg r)     _ _ -> line $ text "\tblr" <+> pprReg W64 r
+  BL (TBlock bid) _ -> line $ text "\tbl" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
+  BL (TLabel lbl) _ -> line $ text "\tbl" <+> pprAsmLabel platform lbl
+  BL (TReg r)     _ -> line $ text "\tblr" <+> pprReg W64 r
 
   BCOND c (TBlock bid) -> line $ text "\t" <> pprBcond c <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
   BCOND c (TLabel lbl) -> line $ text "\t" <> pprBcond c <+> pprAsmLabel platform lbl



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb612fbc8e94d50c9895c02f3d6ee076f61b7773

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb612fbc8e94d50c9895c02f3d6ee076f61b7773
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/20240619/b889fc8c/attachment-0001.html>


More information about the ghc-commits mailing list