[Git][ghc/ghc][wip/supersven/riscv64-ncg] Fix: LDRB -> LB, LDRH -> LH

[Sven Tennie (@supersven)]

Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC


Commits:
c3508989 by Sven Tennie at 2023-05-19T11:41:17+02:00
Fix: LDRB -> LB, LDRH -> LH

A simple translation of these instructions from ARM to RISCV.

Add panic-ing pattern matches to fetch the outstanding STR and LDR
cases.

- - - - -


3 changed files:

- compiler/GHC/CmmToAsm/RV64/Instr.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs
- compiler/GHC/CmmToAsm/RV64/Regs.hs


Changes:

=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -592,7 +592,7 @@ data Instr
 
     -- 2. Memory Load/Store Instructions ---------------------------------------
     -- Unlike arm, we don't have register shorthands for size.
-    -- We do hover have {L,S}{B,H,W,D}[U] instructions for Load/Store, Byte, Half, Word, Double, (Unsigned).
+    -- We do however have {L,S}{B,H,W,D}[U] instructions for Load/Store, Byte, Half, Word, Double, (Unsigned).
     -- Reusing the arm logic with the _format_ specifier will hopefully work.
     | STR Format Operand Operand -- str Xn, address-mode // Xn -> *addr
     | LDR Format Operand Operand -- ldr Xn, address-mode // Xn <- *addr
@@ -906,3 +906,4 @@ fitsIn12bitImm off = off >= intMin12bit && off <= intMax12bit
 
 fitsIn32bits  :: (Num a, Ord a, Bits a) => a -> Bool
 fitsIn32bits i = (-1 `shiftL` 31) <= i && i <= (1 `shiftL` 31 -1)
+


=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -596,6 +596,8 @@ pprInstr platform instr = case instr of
   STR II16 o1 o2 -> op2 (text "\tsh") o1 o2
   STR II32 o1 o2 -> op2 (text "\tsw") o1 o2
   STR II64 o1 o2 -> op2 (text "\tsd") o1 o2
+  STR f o1 o2    -> pprPanic "RV64.pprInstr - STR not implemented for ... "
+                              (text "STR" <+> (text.show) f <+> pprOp platform o1 <+> pprOp platform o2)
 
   LDR _f o1 (OpImm (ImmIndex lbl off)) ->
     lines_ [ text "\tla" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl
@@ -613,15 +615,17 @@ pprInstr platform instr = case instr of
     -- op_add o1 (text "%pcrel_lo(" <> pprAsmLabel platform lbl <> text ")")
     line $ text "\tla" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl
 
-  LDR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 ->
-    op2 (text "\tldrb") o1 o2
-  LDR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 ->
-    op2 (text "\tldrh") o1 o2
+  LDR _f o1@(OpReg W8 reg) o2 | isIntRealReg reg ->
+    op2 (text "\tlb") o1 o2
+  LDR _f o1@(OpReg W16 reg) o2 | isIntRealReg reg ->
+    op2 (text "\tlh") o1 o2
 
   LDR II8  o1 o2 -> op2 (text "\tlb") o1 o2
   LDR II16 o1 o2 -> op2 (text "\tlh") o1 o2
   LDR II32 o1 o2 -> op2 (text "\tlw") o1 o2
   LDR II64 o1 o2 -> op2 (text "\tld") o1 o2
+  LDR f o1 o2    -> pprPanic "RV64.pprInstr - LDR not implemented for ... "
+                              (text "LDR" <+> (text.show) f <+> pprOp platform o1 <+> pprOp platform o2)
   -- LDAR _f o1 o2 -> op2 (text "\tldar") o1 o2
 
   -- STP _f o1 o2 o3 -> op3 (text "\tstp") o1 o2 o3
@@ -634,6 +638,7 @@ pprInstr platform instr = case instr of
   SCVTF o1 o2 -> op2 (text "\tscvtf") o1 o2
   FCVTZS o1 o2 -> op2 (text "\tfcvtzs") o1 o2
   FABS o1 o2 -> op2 (text "\tfabs") o1 o2
+  instr -> panic $ "RV64.pprInstr - Unknown instruction: " ++ (instrCon instr)
  where op2 op o1 o2        = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2
        op3 op o1 o2 o3     = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
        op4 op o1 o2 o3 o4  = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4


=====================================
compiler/GHC/CmmToAsm/RV64/Regs.hs
=====================================
@@ -145,6 +145,10 @@ classOfRealReg (RealRegSingle i)
         | i < 32        = RcInteger
         | otherwise     = RcDouble
 
+isIntRealReg :: Reg -> Bool
+isIntRealReg (RegReal r) = classOfRealReg r == RcInteger
+isIntRealReg _ = False
+
 regDotColor :: RealReg -> SDoc
 regDotColor reg
  = case classOfRealReg reg of



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c3508989f96f9c44af768c33d7b21f8f1d6ae1df
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/20230519/80d768e4/attachment-0001.html>