[Git][ghc/ghc][wip/supersven/ghc-9.10-riscv-ncg] 5 commits: Instr Haddock

Sven Tennie (@supersven) gitlab at gitlab.haskell.org
Fri Jul 26 18:42:01 UTC 2024



Sven Tennie pushed to branch wip/supersven/ghc-9.10-riscv-ncg at Glasgow Haskell Compiler / GHC


Commits:
59c11901 by Sven Tennie at 2024-07-26T19:49:11+02:00
Instr Haddock

- - - - -
4d5b69d3 by Sven Tennie at 2024-07-26T19:49:30+02:00
Fix logical error

There's no REM for any float involved - at any position.

- - - - -
606b1d93 by Sven Tennie at 2024-07-26T19:51:32+02:00
Cleanup

- - - - -
a8796fad by Sven Tennie at 2024-07-26T20:18:37+02:00
Rename DMBSY to FENCE

The plan to have one common instruction set with AArch64 didn't work
out. That way it's less confusing.

- - - - -
c5f8ea14 by Sven Tennie at 2024-07-26T20:40:26+02:00
Haddock and remove old comments

- - - - -


3 changed files:

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


Changes:

=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -1592,9 +1592,9 @@ genCCall (PrimTarget mop) dest_regs arg_regs = do
         -- atomic_thread_fence(memory_order_acquire);
         -- atomic_thread_fence(memory_order_release);
         -- atomic_thread_fence(memory_order_seq_cst);
-        MO_AcquireFence -> pure (unitOL (DMBSY DmbRead DmbReadWrite))
-        MO_ReleaseFence -> pure (unitOL (DMBSY DmbReadWrite DmbWrite))
-        MO_SeqCstFence -> pure (unitOL (DMBSY DmbReadWrite DmbReadWrite))
+        MO_AcquireFence -> pure (unitOL (FENCE FenceRead FenceReadWrite))
+        MO_ReleaseFence -> pure (unitOL (FENCE FenceReadWrite FenceWrite))
+        MO_SeqCstFence -> pure (unitOL (FENCE FenceReadWrite FenceReadWrite))
 
         MO_Touch            -> pure nilOL -- Keep variables live (when using interior pointers)
         -- Prefetch
@@ -1638,12 +1638,12 @@ genCCall (PrimTarget mop) dest_regs arg_regs = do
                       MemOrderRelaxed -> unitOL $ ann moDescr (LDR (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p))
                       MemOrderAcquire -> toOL [
                                                 ann moDescr (LDR (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p)),
-                                                DMBSY DmbRead DmbReadWrite
+                                                FENCE FenceRead FenceReadWrite
                                               ]
                       MemOrderSeqCst -> toOL [
-                                                ann moDescr (DMBSY DmbReadWrite DmbReadWrite),
+                                                ann moDescr (FENCE FenceReadWrite FenceReadWrite),
                                                 LDR (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p),
-                                                DMBSY DmbRead DmbReadWrite
+                                                FENCE FenceRead FenceReadWrite
                                               ]
                       MemOrderRelease -> panic $ "Unexpected MemOrderRelease on an AtomicRead: " ++ show mo
                   dst = getRegisterReg platform (CmmLocal dst_reg)
@@ -1663,12 +1663,12 @@ genCCall (PrimTarget mop) dest_regs arg_regs = do
               let instrs = case ord of
                       MemOrderRelaxed -> unitOL $ ann moDescr (STR fmt_val (OpReg w val) (OpAddr $ AddrReg p))
                       MemOrderSeqCst  -> toOL [
-                                                ann moDescr (DMBSY DmbReadWrite DmbWrite),
+                                                ann moDescr (FENCE FenceReadWrite FenceWrite),
                                                 STR fmt_val (OpReg w val) (OpAddr $ AddrReg p),
-                                                DMBSY DmbReadWrite DmbReadWrite
+                                                FENCE FenceReadWrite FenceReadWrite
                                               ]
                       MemOrderRelease -> toOL [
-                                                ann moDescr (DMBSY DmbReadWrite DmbWrite),
+                                                ann moDescr (FENCE FenceReadWrite FenceWrite),
                                                 STR fmt_val (OpReg w val) (OpAddr $ AddrReg p)
                                               ]
                       MemOrderAcquire ->  panic $ "Unexpected MemOrderAcquire on an AtomicWrite" ++ show mo
@@ -1925,7 +1925,7 @@ makeFarBranches {- only used when debugging -} _platform statics basic_blocks =
       STR {} -> 1
       LDR {} -> 3
       LDRU {} -> 1
-      DMBSY {} -> 1
+      FENCE {} -> 1
       FCVT {} -> 1
       SCVTF {} -> 1
       FCVTZS {} -> 1


=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -70,15 +70,12 @@ instance Outputable RegUsage where
 -- RegUsage = RU [<read regs>] [<write regs>]
 regUsageOfInstr :: Platform -> Instr -> RegUsage
 regUsageOfInstr platform instr = case instr of
-  -- 0. Meta Instructions
   ANN _ i                  -> regUsageOfInstr platform i
   COMMENT{}                -> usage ([], [])
   MULTILINE_COMMENT{}      -> usage ([], [])
   PUSH_STACK_FRAME         -> usage ([], [])
   POP_STACK_FRAME          -> usage ([], [])
   DELTA{}                  -> usage ([], [])
-
-  -- 1. Arithmetic Instructions ------------------------------------------------
   ADD dst src1 src2        -> usage (regOp src1 ++ regOp src2, regOp dst)
   MUL dst src1 src2        -> usage (regOp src1 ++ regOp src2, regOp dst)
   NEG dst src              -> usage (regOp src, regOp dst)
@@ -88,9 +85,6 @@ regUsageOfInstr platform instr = case instr of
   REMU dst src1 src2       -> usage (regOp src1 ++ regOp src2, regOp dst)
   SUB dst src1 src2        -> usage (regOp src1 ++ regOp src2, regOp dst)
   DIVU dst src1 src2       -> usage (regOp src1 ++ regOp src2, regOp dst)
-
-  -- 2. Bit Manipulation Instructions ------------------------------------------
-  -- 3. Logical and Move Instructions ------------------------------------------
   AND dst src1 src2        -> usage (regOp src1 ++ regOp src2, regOp dst)
   OR dst src1 src2         -> usage (regOp src1 ++ regOp src2, regOp dst)
   ASR dst src1 src2        -> usage (regOp src1 ++ regOp src2, regOp dst)
@@ -101,24 +95,15 @@ regUsageOfInstr platform instr = case instr of
   -- ORI's third operand is always an immediate
   ORI dst src1 _           -> usage (regOp src1, regOp dst)
   XORI dst src1 _          -> usage (regOp src1, regOp dst)
-  -- 4. Branch Instructions ----------------------------------------------------
   J_TBL _ _ t              -> usage ([t], [])
   B t                      -> usage (regTarget t, [])
   BCOND _ l r t            -> usage (regTarget t ++ regOp l ++ regOp r, [])
   BL t ps                  -> usage (t : ps, callerSavedRegisters)
-
-  -- 5. Atomic Instructions ----------------------------------------------------
-  -- 6. Conditional Instructions -----------------------------------------------
   CSET dst l r _           -> usage (regOp l ++ regOp r, regOp dst)
-  -- 7. Load and Store Instructions --------------------------------------------
   STR _ src dst            -> usage (regOp src ++ regOp dst, [])
   LDR _ dst src            -> usage (regOp src, regOp dst)
   LDRU _ dst src           -> usage (regOp src, regOp dst)
-
-  -- 8. Synchronization Instructions -------------------------------------------
-  DMBSY _ _                  -> usage ([], [])
-
-  -- 9. Floating Point Instructions --------------------------------------------
+  FENCE _ _                  -> usage ([], [])
   FCVT dst src             -> usage (regOp src, regOp dst)
   SCVTF dst src            -> usage (regOp src, regOp dst)
   FCVTZS dst src           -> usage (regOp src, regOp dst)
@@ -127,7 +112,6 @@ regUsageOfInstr platform instr = case instr of
     usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst)
 
   _ -> panic $ "regUsageOfInstr: " ++ instrCon instr
-
   where
         -- filtering the usage is necessary, otherwise the register
         -- allocator will try to allocate pre-defined fixed stg
@@ -169,14 +153,12 @@ callerSavedRegisters =
 -- | Apply a given mapping to all the register references in this instruction.
 patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
 patchRegsOfInstr instr env = case instr of
-    -- 0. Meta Instructions
     ANN d i             -> ANN d (patchRegsOfInstr i env)
     COMMENT{}           -> instr
     MULTILINE_COMMENT{} -> instr
     PUSH_STACK_FRAME    -> instr
     POP_STACK_FRAME     -> instr
     DELTA{}             -> instr
-    -- 1. Arithmetic Instructions ----------------------------------------------
     ADD o1 o2 o3   -> ADD (patchOp o1) (patchOp o2) (patchOp o3)
     MUL o1 o2 o3   -> MUL (patchOp o1) (patchOp o2) (patchOp o3)
     NEG o1 o2      -> NEG (patchOp o1) (patchOp o2)
@@ -186,10 +168,6 @@ patchRegsOfInstr instr env = case instr of
     REMU o1 o2 o3  -> REMU (patchOp o1) (patchOp o2) (patchOp o3)
     SUB o1 o2 o3   -> SUB  (patchOp o1) (patchOp o2) (patchOp o3)
     DIVU o1 o2 o3  -> DIVU (patchOp o1) (patchOp o2) (patchOp o3)
-
-    -- 2. Bit Manipulation Instructions ----------------------------------------
-
-    -- 3. Logical and Move Instructions ----------------------------------------
     AND o1 o2 o3   -> AND  (patchOp o1) (patchOp o2) (patchOp o3)
     OR o1 o2 o3    -> OR   (patchOp o1) (patchOp o2) (patchOp o3)
     ASR o1 o2 o3   -> ASR  (patchOp o1) (patchOp o2) (patchOp o3)
@@ -200,26 +178,15 @@ patchRegsOfInstr instr env = case instr of
     -- o3 cannot be a register for ORI (always an immediate)
     ORI o1 o2 o3   -> ORI  (patchOp o1) (patchOp o2) (patchOp o3)
     XORI o1 o2 o3  -> XORI  (patchOp o1) (patchOp o2) (patchOp o3)
-
-    -- 4. Branch Instructions --------------------------------------------------
     J_TBL ids mbLbl t    -> J_TBL ids mbLbl (env t)
     B t            -> B (patchTarget t)
     BL t ps          -> BL (patchReg t) ps
     BCOND c o1 o2 t -> BCOND c (patchOp o1) (patchOp o2) (patchTarget t)
-
-    -- 5. Atomic Instructions --------------------------------------------------
-    -- 6. Conditional Instructions ---------------------------------------------
     CSET o l r c   -> CSET (patchOp o) (patchOp l) (patchOp r) c
-    -- 7. Load and Store Instructions ------------------------------------------
     STR f o1 o2    -> STR f (patchOp o1) (patchOp o2)
-    -- STLR f o1 o2   -> STLR f (patchOp o1) (patchOp o2)
     LDR f o1 o2    -> LDR f (patchOp o1) (patchOp o2)
     LDRU f o1 o2    -> LDRU f (patchOp o1) (patchOp o2)
-
-    -- 8. Synchronization Instructions -----------------------------------------
-    DMBSY o1 o2    -> DMBSY o1 o2
-
-    -- 9. Floating Point Instructions ------------------------------------------
+    FENCE o1 o2    -> FENCE o1 o2
     FCVT o1 o2     -> FCVT (patchOp o1) (patchOp o2)
     SCVTF o1 o2    -> SCVTF (patchOp o1) (patchOp o2)
     FCVTZS o1 o2   -> FCVTZS (patchOp o1) (patchOp o2)
@@ -244,8 +211,6 @@ patchRegsOfInstr instr env = case instr of
         patchReg :: Reg -> Reg
         patchReg = env
 
---------------------------------------------------------------------------------
-
 -- | Checks whether this instruction is a jump/branch instruction.
 --
 -- One that can change the flow of control in a way that the
@@ -470,136 +435,131 @@ allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do
       new_code = concatMap insert_stack_insn code
     return (CmmProc info lbl live (ListGraph new_code), retargetList)
 
--- -----------------------------------------------------------------------------
--- Machine's assembly language
-
--- We have a few common "instructions" (nearly all the pseudo-ops) but
--- mostly all of 'Instr' is machine-specific.
-
--- RV64 reference card: https://cs61c.org/sp23/pdfs/resources/reference-card.pdf
--- RV64 pseudo instructions: https://github.com/riscv-non-isa/riscv-asm-manual/blob/master/riscv-asm.md#-a-listing-of-standard-risc-v-pseudoinstructions
--- We will target: RV64G(C). That is G = I+A+F+S+D
--- I: Integer Multiplication and Division
--- A: Atomic Instructions
--- F: Single Precision
--- D: Double Precision
--- C: Compressed (though we won't use that).
-
--- This most notably leaves out B. (Bit Manipulation) instructions.
-
 data Instr
-    -- 0. Pseudo Instructions --------------------------------------------------
-    -- comment pseudo-op
+    -- | Comment pseudo-op
     = COMMENT SDoc
+    -- | Multi-line comment pseudo-op
     | MULTILINE_COMMENT SDoc
-
-    -- Annotated instruction. Should print <instr> # <doc>
+    -- | Annotated instruction. Should print <instr> # <doc>
     | ANN SDoc Instr
-
-    -- location pseudo-op (file, line, col, name)
+    -- | Location pseudo-op @.loc@ (file, line, col, name)
     | LOCATION Int Int Int LexicalFastString
-
-    -- some static data spat out during code
-    -- generation.  Will be extracted before
-    -- pretty-printing.
+    -- | Static data spat out during code generation.
     | LDATA   Section RawCmmStatics
-
-    -- start a new basic block.  Useful during
-    -- codegen, removed later.  Preceding
-    -- instruction should be a jump, as per the
-    -- invariants for a BasicBlock (see Cmm).
+    -- | Start a new basic block.
+    --
+    -- Useful during codegen, removed later. Preceding instruction should be a
+    -- jump, as per the invariants for a BasicBlock (see Cmm).
     | NEWBLOCK BlockId
-
-    -- specify current stack offset for
-    -- benefit of subsequent passes
+    -- | Specify current stack offset for benefit of subsequent passes
     | DELTA   Int
-
+    -- | Push a minimal stack frame consisting of the return address (RA) and the frame pointer (FP).
     | PUSH_STACK_FRAME
+    -- | Pop the minimal stack frame of prior `PUSH_STACK_FRAME`.
     | POP_STACK_FRAME
-
-    -- == Base Instructions (I) ================================================
-    -- 1. Arithmetic Instructions ----------------------------------------------
-    -- all of these instructions can also take an immediate, in which case they
-    -- hafe a suffix I (except for U suffix, where it's IU then. E.g. SLTIU).
-    | ADD Operand Operand Operand -- rd = rs1 + rs2
-    | SUB Operand Operand Operand -- rd = rs1 - rs2
-
-    | AND Operand Operand Operand -- rd = rs1 & rs2
-    | OR  Operand Operand Operand -- rd = rs1 | rs2
-    -- | XOR Operand Operand Operand -- rd = rs1 ^ rs2
-    | LSL {- SLL -} Operand Operand Operand -- rd = rs1 << rs2 (zero ext)
-    | LSR {- SRL -} Operand Operand Operand -- rd = rs1 >> rs2 (zero ext)
-    | ASR {- SRA -} Operand Operand Operand -- rd = rs1 >> rs2 (sign ext)
-
-    -- 2. Memory Load/Store Instructions ---------------------------------------
-    -- Unlike arm, we don't have register shorthands for size.
-    -- 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 (sign-extended)
-    | LDRU Format Operand Operand -- ldr Xn, address-mode // Xn <- *addr (unsigned)
-
-    -- 3. Control Flow ---------------------------------------------------------
-    -- B{EQ,GE,GEU,LT,LTU}, these are effectively BCOND from AArch64;
-    -- however, AArch64 desugars them into CMP + BCOND. So these are a bit more
-    -- powerful.
-    -- JAL / JARL are effectively the BL instruction from AArch64.
-
-    | MUL Operand Operand Operand -- rd = rn × rm
-
-
-    -- Pseudo/synthesized:
-    | NEG Operand Operand -- rd = -op2
-
-    | DIV Operand Operand Operand -- rd = rn ÷ rm
-    | REM Operand Operand Operand -- rd = rn % rm (signed)
-    | REMU Operand Operand Operand -- rd = rn % rm (unsigned)
-
+    -- | Arithmetic addition (both integer and floating point)
+    --
+    -- @rd = rs1 + rs2@
+    | ADD Operand Operand Operand
+    -- | Arithmetic subtraction (both integer and floating point)
+    --
+    -- @rd = rs1 - rs2@
+    | SUB Operand Operand Operand
+    -- | Logical AND (integer only)
+    --
+    -- @rd = rs1 & rs2@
+    | AND Operand Operand Operand
+    -- | Logical OR (integer only)
+    --
+    -- @rd = rs1 | rs2@
+    | OR  Operand Operand Operand
+    -- | Logical left shift (zero extened, integer only)
+    --
+    -- @rd = rs1 << rs2@
+    | LSL {- SLL -} Operand Operand Operand
+    -- | Logical right shift (zero extened, integer only)
+    --
+    -- @rd = rs1 >> rs2@
+    | LSR {- SRL -} Operand Operand Operand
+    -- | Arithmetic right shift (sign-extened, integer only)
+    --
+    -- @rd = rs1 >> rs2@
+    | ASR {- SRA -} Operand Operand Operand
+    -- | Store to memory (both, integer and floating point)
+    | STR Format Operand Operand
+    -- | Load from memory (sign-extended, integer and floating point)
+    | LDR Format Operand Operand
+    -- | Load from memory (unsigned, integer and floating point)
+    | LDRU Format Operand Operand
+    -- | Arithmetic multiplication (both, integer and floating point)
+    --
+    -- @rd = rn × rm@
+    | MUL Operand Operand Operand
+    -- | Negation (both, integer and floating point)
+    --
+    -- @rd = -op2@
+    | NEG Operand Operand
+    -- | Division (both, integer and floating point)
+    --
+    -- @rd = rn ÷ rm@
+    | DIV Operand Operand Operand
+    -- | Remainder (integer only, signed)
+    --
+    -- @rd = rn % rm@
+    | REM Operand Operand Operand --
+    -- | Remainder (integer only, unsigned)
+    --
+    -- @rd = |rn % rm|@
+    | REMU Operand Operand Operand
     -- TODO: Rename: MULH
+    -- | High part of a multiplication that doesn't fit into 64bits (integer only)
+    --
+    -- E.g. for a multiplication with 64bits width: @rd = (rs1 * rs2) >> 64 at .
     | SMULH Operand Operand Operand
-    | DIVU Operand Operand Operand -- rd = rn ÷ rm
-
-    -- 2. Bit Manipulation Instructions ----------------------------------------
-
-    -- 3. Logical and Move Instructions ----------------------------------------
-    -- | AND Operand Operand Operand -- rd = rn & op2
-    -- | ANDS Operand Operand Operand -- rd = rn & op2
-    -- | ASR Operand Operand Operand -- rd = rn ≫ rm  or  rd = rn ≫ #i, i is 6 bits
-    | XOR Operand Operand Operand -- rd = rn ⊕ op2
-    -- | LSL Operand Operand Operand -- rd = rn ≪ rm  or rd = rn ≪ #i, i is 6 bits
-    -- | LSR Operand Operand Operand -- rd = rn ≫ rm  or rd = rn ≫ #i, i is 6 bits
-    | MOV Operand Operand -- rd = rn  or  rd = #i
-    | ORI Operand Operand Operand -- rd = rn | op2
-    | XORI Operand Operand Operand -- rd = rn `xor` imm
-    -- Load and stores.
-
-    -- Conditional instructions
-
+    -- | Unsigned division (integer only)
+    --
+    -- @rd = |rn ÷ rm|@
+    | DIVU Operand Operand Operand
+    -- | XOR (integer only)
+    --
+    -- @rd = rn ⊕ op2@
+    | XOR Operand Operand Operand
+    -- | ORI with immediate (integer only)
+    --
+    -- @rd = rn | op2@
+    | ORI Operand Operand Operand
+    -- | OR with immediate (integer only)
+    --
+    -- @rd = rn ⊕ op2@
+    | XORI Operand Operand Operand
+    -- | Move to register (integer and floating point)
+    --
+    -- @rd = rn@  or  @rd = #imm@
+    | MOV Operand Operand
     -- | Pseudo-op for conditional setting of a register.
     --
     -- @if(o2 cond o3) op <- 1 else op <- 0@
     | CSET Operand Operand Operand Cond
-
-    -- Branching.
     -- | A jump instruction with data for switch/jump tables
     | J_TBL [Maybe BlockId] (Maybe CLabel) Reg
     -- | Unconditional jump (no linking)
     | B Target
     -- | Unconditional jump, links return address (sets @ra@/@x1@)
     | BL Reg [Reg]
-    | BCOND Cond Operand Operand Target   -- branch with condition. b.<cond>
-    -- | pseudo-op for far branch targets
-
-    -- 8. Synchronization Instructions -----------------------------------------
-    | DMBSY DmbType DmbType
-    -- 9. Floating Point Instructions
-    -- | Float ConVerT
+    -- | branch with condition (integer only)
+    | BCOND Cond Operand Operand Target
+    -- | Fence instruction
+    --
+    -- Memory barrier.
+    | FENCE FenceType FenceType
+    -- | Floating point ConVerT
     | FCVT Operand Operand
-    -- | Signed ConVerT Float
+    -- | Signed floating point ConVerT
     | SCVTF Operand Operand
-    -- | Float ConVerT to Zero Signed
+    -- TODO: Same as SCVTF?
+    -- | Floating point ConVerT to Zero Signed
     | FCVTZS Operand Operand
-    -- | Float ABSolute value
+    -- | Floating point ABSolute value
     | FABS Operand Operand
     -- | Floating-point fused multiply-add instructions
     --
@@ -609,7 +569,8 @@ data Instr
     -- - fnmadd: d = - r1 * r2 - r3
     | FMA FMASign Operand Operand Operand Operand
 
-data DmbType = DmbRead | DmbWrite | DmbReadWrite
+-- | Operand of a FENCE instruction (@r@, @w@ or @rw@)
+data FenceType = FenceRead | FenceWrite | FenceReadWrite
 
 instrCon :: Instr -> String
 instrCon i =
@@ -649,7 +610,7 @@ instrCon i =
       B{} -> "B"
       BL{} -> "BL"
       BCOND{} -> "BCOND"
-      DMBSY{} -> "DMBSY"
+      FENCE{} -> "FENCE"
       FCVT{} -> "FCVT"
       SCVTF{} -> "SCVTF"
       FCVTZS{} -> "FCVTZS"


=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -268,12 +268,15 @@ pprDataImm p (ImmConstantSum a b) = pprDataImm p a <> char '+' <> pprDataImm p b
 pprDataImm p (ImmConstantDiff a b) = pprDataImm p a <> char '-'
                    <> lparen <> pprDataImm p b <> rparen
 
+-- | Comment @c@ with @# c@
 asmComment :: SDoc -> SDoc
 asmComment c = text "#" <+> c
 
+-- | Commen @c@ with @// c@
 asmDoubleslashComment :: SDoc -> SDoc
 asmDoubleslashComment c = text "//" <+> c
 
+-- | Comment @c@ with @/* c */@ (multiline comment)
 asmMultilineComment :: SDoc -> SDoc
 asmMultilineComment c =  text "/*" $+$ c $+$ text "*/"
 
@@ -290,11 +293,15 @@ pprOpImm platform im = case im of
   ImmCLbl l -> char '=' <> pprAsmLabel platform l
   _ -> pprPanic "RV64.Ppr.pprOpImm" (text "Unsupported immediate for instruction operands" <> colon <+> (text . show) im)
 
+-- | Negate integer immediate operand
+--
+-- This function is partial and will panic if the operand is not an integer.
 negOp :: Operand -> Operand
 negOp (OpImm (ImmInt i)) = OpImm (ImmInt (negate i))
 negOp (OpImm (ImmInteger i)) = OpImm (ImmInteger (negate i))
 negOp op = pprPanic "RV64.negOp" (text $ show op)
 
+-- | Pretty print an operand
 pprOp :: IsLine doc => Platform -> Operand -> doc
 pprOp plat op = case op of
   OpReg w r           -> pprReg w r
@@ -302,6 +309,10 @@ pprOp plat op = case op of
   OpAddr (AddrRegImm r1 im) -> pprOpImm plat im <> char '(' <> pprReg W64 r1 <> char ')'
   OpAddr (AddrReg r1)       -> text "0(" <+> pprReg W64 r1 <+> char ')'
 
+-- | Pretty print register with calling convention name
+--
+-- This representation makes it easier to reason about the emitted assembly
+-- code.
 pprReg :: forall doc. IsLine doc => Width -> Reg -> doc
 pprReg w r = case r of
   RegReal    (RealRegSingle i) -> ppr_reg_no i
@@ -414,6 +425,9 @@ isLabel :: Target -> Bool
 isLabel (TBlock _) = True
 isLabel _ = False
 
+-- | Get the pretty-printed label from a `Target`
+--
+-- This function is partial and will panic if the `Target` is not a label.
 getLabel :: (IsLine doc) => Platform -> Target -> doc
 getLabel platform (TBlock bid) = pprBlockId platform bid
   where
@@ -421,9 +435,12 @@ getLabel platform (TBlock bid) = pprBlockId platform bid
     pprBlockId platform bid = pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
 getLabel _platform _other = panic "Cannot turn this into a label"
 
+-- | Pretty-print an `Instr`
+--
+-- This function is partial and will panic if the `Instr` is not supported. This
+-- can happen due to invalid operands or unexpected meta instructions.
 pprInstr :: IsDoc doc => Platform -> Instr -> doc
 pprInstr platform instr = case instr of
-  -- Meta Instructions ---------------------------------------------------------
   -- see Note [dualLine and dualDoc] in GHC.Utils.Outputable
   COMMENT s  -> dualDoc (asmComment s) empty
   MULTILINE_COMMENT s -> dualDoc (asmMultilineComment s) empty
@@ -435,8 +452,6 @@ pprInstr platform instr = case instr of
   NEWBLOCK _ -> panic "PprInstr: NEWBLOCK"
   LDATA _ _  -> panic "pprInstr: LDATA"
 
-  -- Pseudo Instructions -------------------------------------------------------
-
   PUSH_STACK_FRAME -> lines_ [ text "\taddi sp, sp, -16"
                              , text "\tsd x1, 8(sp)"     -- store RA
                              , text "\tsd x8, 0(sp)"     -- store FP/s0
@@ -445,9 +460,7 @@ pprInstr platform instr = case instr of
   POP_STACK_FRAME -> lines_  [ text "\tld x8, 0(sp)" -- restore FP/s0
                              , text "\tld x1, 8(sp)" -- restore RA
                              , text "\taddi sp, sp, 16" ]
-  -- ===========================================================================
-  -- AArch64 Instruction Set
-  -- 1. Arithmetic Instructions ------------------------------------------------
+ 
   ADD  o1 o2 o3
     | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfadd." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3
     -- This case is used for sign extension: SEXT.W op
@@ -464,7 +477,7 @@ pprInstr platform instr = case instr of
   -- TODO: This must (likely) be refined regarding width
     -> op3 (text "\tfdiv." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3
   DIV o1 o2 o3 -> op3 (text "\tdiv") o1 o2 o3
-  REM o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3
+  REM o1 o2 o3 | isFloatOp o1 || isFloatOp o2 || isFloatOp o3
     -> panic "pprInstr - REM not implemented for floats (yet)"
   REM o1 o2 o3 -> op3 (text "\trem") o1 o2 o3
   REMU o1 o2 o3 -> op3 (text "\tremu") o1 o2 o3
@@ -474,10 +487,6 @@ pprInstr platform instr = case instr of
     | isImmOp o3 -> op3 (text "\taddi") o1 o2 (negOp o3)
     | otherwise -> op3 (text "\tsub")  o1 o2 o3
   DIVU o1 o2 o3 -> op3 (text "\tdivu") o1 o2 o3
-
-  -- 2. Bit Manipulation Instructions ------------------------------------------
-
-  -- 3. Logical and Move Instructions ------------------------------------------
   AND o1 o2 o3 | isImmOp o3 -> op3 (text "\tandi") o1 o2 o3
                | otherwise  -> op3 (text "\tand") o1 o2 o3
   OR o1 o2 o3   -> op3 (text "\tor") o1 o2 o3
@@ -516,7 +525,6 @@ pprInstr platform instr = case instr of
   ORI o1 o2 o3  -> op3 (text "\tori") o1 o2 o3
   XORI o1 o2 o3 -> op3 (text "\txori") o1 o2 o3
 
-  -- 4. Branch Instructions ----------------------------------------------------
   J_TBL _ _ r     -> pprInstr platform (B (TReg r))
   B l | isLabel l -> line $ text "\tjal" <+> pprOp platform x0 <> comma <+> getLabel platform l
   B (TReg r)      -> line $ text "\tjalr" <+> pprOp platform x0 <> comma <+> pprReg W64 r <> comma <+> text "0"
@@ -528,8 +536,6 @@ pprInstr platform instr = case instr of
 
   BCOND _ _ _ (TReg _)     -> panic "RV64.ppr: No conditional branching to registers!"
 
-  -- 5. Atomic Instructions ----------------------------------------------------
-  -- 6. Conditional Instructions -----------------------------------------------
   CSET o l r c  -> case c of
     EQ | isIntOp l && isIntOp r -> lines_ [ subFor l r
                   , text "\tseqz" <+> pprOp platform o <> comma <+> pprOp platform o]
@@ -568,10 +574,6 @@ pprInstr platform instr = case instr of
       binOp :: (IsLine doc) => String -> doc
       binOp op = text op <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform r
 
-  -- 7. Load and Store Instructions --------------------------------------------
-  -- NOTE: GHC may do whacky things where it only load the lower part of an
-  --       address. Not observing the correct size when loading will lead
-  --       inevitably to crashes.
   STR II8  o1 o2 -> op2 (text "\tsb") o1 o2
   STR II16 o1 o2 -> op2 (text "\tsh") o1 o2
   STR II32 o1 o2 -> op2 (text "\tsw") o1 o2
@@ -585,14 +587,6 @@ pprInstr platform instr = case instr of
            ]
 
   LDR _f o1 (OpImm (ImmCLbl lbl)) ->
-    -- fixing this is _really_ annoyin we need to generate code like:
-    -- 1: auipc x16, %pcrel_hi(<lbl>)
-    --    addi x16, x16, %pcrel_lo(1b)
-    -- I really dislike this (refer back to label 1 syntax from the assembler.)
-    --
-    -- So we'll go with pseudo ops. la and li it is.
-    -- op_adrp o1 (text "%pcrel_hi(" <> pprAsmLabel platform lbl <> text ")") $$
-    -- op_add o1 (text "%pcrel_lo(" <> pprAsmLabel platform lbl <> text ")")
     line $ text "\tla" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl
 
   LDR II8  o1 o2 -> op2 (text "\tlb") o1 o2
@@ -613,10 +607,8 @@ pprInstr platform instr = case instr of
   LDRU FF64 o1 o2@(OpAddr (AddrRegImm _ _)) -> op2 (text "\tfld") o1 o2
   LDRU f o1 o2 -> pprPanic "Unsupported unsigned load" ((text.show) f <+> pprOp platform o1 <+> pprOp platform o2)
 
-  -- 8. Synchronization Instructions -------------------------------------------
-  DMBSY r w -> line $ text "\tfence" <+> pprDmbType r <> char ',' <+> pprDmbType w
+  FENCE r w -> line $ text "\tfence" <+> pprFenceType r <> char ',' <+> pprFenceType w
 
-  -- 9. Floating Point Instructions --------------------------------------------
   FCVT o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.s.d") o1 o2
   FCVT o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.d.s") o1 o2
   FCVT o1 o2 -> pprPanic "RV64.pprInstr - impossible float conversion" $
@@ -649,9 +641,9 @@ pprInstr platform instr = case instr of
  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
-       pprDmbType DmbRead = text "r"
-       pprDmbType DmbWrite = text "w"
-       pprDmbType DmbReadWrite = text "rw"
+       pprFenceType FenceRead = text "r"
+       pprFenceType FenceWrite = text "w"
+       pprFenceType FenceReadWrite = text "rw"
        floatPrecission o | isSingleOp o = text "s"
                          | isDoubleOp o = text "d"
                          | otherwise  = pprPanic "Impossible floating point precission: " (pprOp platform o)
@@ -661,6 +653,10 @@ floatOpPrecision _p l r | isFloatOp l && isFloatOp r && isSingleOp l && isSingle
 floatOpPrecision _p l r | isFloatOp l && isFloatOp r && isDoubleOp l && isDoubleOp r = "d" -- double precision
 floatOpPrecision p l r = pprPanic "Cannot determine floating point precission" (text "op1" <+> pprOp p l <+> text "op2" <+> pprOp p r)
 
+-- | Pretty print a conditional branch
+--
+-- This function is partial and will panic if the conditional is not supported;
+-- i.e. if its floating point related.
 pprBcond :: (IsLine doc) => Cond -> doc
 pprBcond c = text "b" <> pprCond c
   where



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f90036f37886edbe1aae4ceedbc3a0cda3c93f73...c5f8ea14f7da40922ac5f23b61dad4c935ab1a8b

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f90036f37886edbe1aae4ceedbc3a0cda3c93f73...c5f8ea14f7da40922ac5f23b61dad4c935ab1a8b
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/20240726/c87ac1c8/attachment-0001.html>


More information about the ghc-commits mailing list