GHC/CmmToAsm/AArch64/Ppr.hs

    {-# OPTIONS_GHC -fno-warn-orphans #-}
    {-# LANGUAGE CPP #-}

    module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl, pprInstr) where

    import GHC.Prelude hiding (EQ)

    import Data.Word
    import qualified Data.Array.Unsafe as U ( castSTUArray )
    import Data.Array.ST
    import Control.Monad.ST

    import GHC.CmmToAsm.AArch64.Instr
    import GHC.CmmToAsm.AArch64.Regs
    import GHC.CmmToAsm.AArch64.Cond
    import GHC.CmmToAsm.Ppr
    import GHC.CmmToAsm.Format
    import GHC.Platform.Reg
    import GHC.CmmToAsm.Config
    import GHC.CmmToAsm.Types
    import GHC.CmmToAsm.Utils

    import GHC.Cmm hiding (topInfoTable)
    import GHC.Cmm.Dataflow.Collections
    import GHC.Cmm.Dataflow.Label
    import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes)

    import GHC.Cmm.BlockId
    import GHC.Cmm.CLabel
    import GHC.Cmm.Ppr.Expr () -- For Outputable instances

    import GHC.Types.Unique ( pprUniqueAlways, getUnique )
    import GHC.Platform
    import GHC.Utils.Outputable

    import GHC.Utils.Panic

    pprProcAlignment :: NCGConfig -> SDoc
    pprProcAlignment config = maybe empty (pprAlign platform . mkAlignment) (ncgProcAlignment config)
       where
          platform = ncgPlatform config

    pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc
    pprNatCmmDecl config (CmmData section dats) =
      pprSectionAlign config section $$ pprDatas config dats

    pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
      let platform = ncgPlatform config in
      pprProcAlignment config $$
      case topInfoTable proc of
        Nothing ->
            -- special case for code without info table:
            pprSectionAlign config (Section Text lbl) $$
            -- do not
            -- pprProcAlignment config $$
            pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed
            vcat (map (pprBasicBlock config top_info) blocks) $$
            (if ncgDwarfEnabled config
             then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$
            pprSizeDecl platform lbl

        Just (CmmStaticsRaw info_lbl _) ->
          pprSectionAlign config (Section Text info_lbl) $$
          -- pprProcAlignment config $$
          (if platformHasSubsectionsViaSymbols platform
              then ppr (mkDeadStripPreventer info_lbl) <> char ':'
              else empty) $$
          vcat (map (pprBasicBlock config top_info) blocks) $$
          -- above: Even the first block gets a label, because with branch-chain
          -- elimination, it might be the target of a goto.
          (if platformHasSubsectionsViaSymbols platform
           then -- See Note [Subsections Via Symbols]
                    text "\t.long "
                <+> ppr info_lbl
                <+> char '-'
                <+> ppr (mkDeadStripPreventer info_lbl)
           else empty) $$
          pprSizeDecl platform info_lbl

    pprLabel :: Platform -> CLabel -> SDoc
    pprLabel platform lbl =
       pprGloblDecl platform lbl
       $$ pprTypeDecl platform lbl
       $$ (pdoc platform lbl <> char ':')

    pprAlign :: Platform -> Alignment -> SDoc
    pprAlign _platform alignment
            = text "\t.balign " <> int (alignmentBytes alignment)

    -- | Print appropriate alignment for the given section type.
    pprAlignForSection :: Platform -> SectionType -> SDoc
    pprAlignForSection _platform _seg
        -- .balign is stable, whereas .align is platform dependent.
        = text "\t.balign 8" --  always 8

    instance Outputable Instr where
        ppr = pprInstr genericPlatform

    -- | Print section header and appropriate alignment for that section.
    --
    -- This one will emit the header:
    --
    --     .section .text
    --     .balign 8
    --
    pprSectionAlign :: NCGConfig -> Section -> SDoc
    pprSectionAlign _config (Section (OtherSection _) _) =
         panic "AArch64.Ppr.pprSectionAlign: unknown section"
    pprSectionAlign config sec@(Section seg _) =
        pprSectionHeader config sec
        $$ pprAlignForSection (ncgPlatform config) seg

    -- | Output the ELF .size directive.
    pprSizeDecl :: Platform -> CLabel -> SDoc
    pprSizeDecl platform lbl
     = if osElfTarget (platformOS platform)
       then text "\t.size" <+> pdoc platform lbl <> text ", .-" <> pdoc platform lbl
       else empty

    pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr
                  -> SDoc
    pprBasicBlock config info_env (BasicBlock blockid instrs)
      = maybe_infotable $
        pprLabel platform asmLbl $$
        vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$
        (if  ncgDwarfEnabled config
          then ppr (mkAsmTempEndLabel asmLbl) <> char ':'
          else empty
        )
      where
        -- Filter out identity moves. E.g. mov x18, x18 will be dropped.
        optInstrs = filter f instrs
          where f (MOV o1 o2) | o1 == o2 = False
                f _ = True

        asmLbl = blockLbl blockid
        platform = ncgPlatform config
        maybe_infotable c = case mapLookup blockid info_env of
           Nothing   -> c
           Just (CmmStaticsRaw info_lbl info) ->
              --  pprAlignForSection platform Text $$
               infoTableLoc $$
               vcat (map (pprData config) info) $$
               pprLabel platform info_lbl $$
               c $$
               (if ncgDwarfEnabled config
                 then ppr (mkAsmTempEndLabel info_lbl) <> char ':'
                 else empty)
        -- Make sure the info table has the right .loc for the block
        -- coming right after it. See [Note: Info Offset]
        infoTableLoc = case instrs of
          (l@LOCATION{} : _) -> pprInstr platform l
          _other             -> empty

    pprDatas :: NCGConfig -> RawCmmStatics -> SDoc
    -- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
    pprDatas config (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
      | lbl == mkIndStaticInfoLabel
      , let labelInd (CmmLabelOff l _) = Just l
            labelInd (CmmLabel l) = Just l
            labelInd _ = Nothing
      , Just ind' <- labelInd ind
      , alias `mayRedirectTo` ind'
      = pprGloblDecl (ncgPlatform config) alias
        $$ text ".equiv" <+> pdoc (ncgPlatform config) alias <> comma <> pdoc (ncgPlatform config) (CmmLabel ind')

    pprDatas config (CmmStaticsRaw lbl dats)
      = vcat (pprLabel platform lbl : map (pprData config) dats)
       where
          platform = ncgPlatform config

    pprData :: NCGConfig -> CmmStatic -> SDoc
    pprData _config (CmmString str) = pprString str
    pprData _config (CmmFileEmbed path) = pprFileEmbed path

    pprData config (CmmUninitialised bytes)
     = let platform = ncgPlatform config
       in if platformOS platform == OSDarwin
             then text ".space " <> int bytes
             else text ".skip "  <> int bytes

    pprData config (CmmStaticLit lit) = pprDataItem config lit

    pprGloblDecl :: Platform -> CLabel -> SDoc
    pprGloblDecl platform lbl
      | not (externallyVisibleCLabel lbl) = empty
      | otherwise = text "\t.globl " <> pdoc platform lbl

    -- Note [Always use objects for info tables]
    -- See discussion in X86.Ppr
    -- for why this is necessary.  Essentially we need to ensure that we never
    -- pass function symbols when we migth want to lookup the info table.  If we
    -- did, we could end up with procedure linking tables (PLT)s, and thus the
    -- lookup wouldn't point to the function, but into the jump table.
    --
    -- Fun fact: The LLVMMangler exists to patch this issue su on the LLVM side as
    -- well.
    pprLabelType' :: Platform -> CLabel -> SDoc
    pprLabelType' platform lbl =
      if isCFunctionLabel lbl || functionOkInfoTable then
        text "@function"
      else
        text "@object"
      where
        functionOkInfoTable = platformTablesNextToCode platform &&
          isInfoTableLabel lbl && not (isConInfoTableLabel lbl)

    -- this is called pprTypeAndSizeDecl in PPC.Ppr
    pprTypeDecl :: Platform -> CLabel -> SDoc
    pprTypeDecl platform lbl
        = if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
          then text ".type " <> pdoc platform lbl <> text ", " <> pprLabelType' platform lbl
          else empty

    pprDataItem :: NCGConfig -> CmmLit -> SDoc
    pprDataItem config lit
      = vcat (ppr_item (cmmTypeFormat $ cmmLitType platform lit) lit)
        where
            platform = ncgPlatform config

            imm = litToImm lit

            ppr_item II8  _ = [text "\t.byte\t"  <> pprImm platform imm]
            ppr_item II16 _ = [text "\t.short\t" <> pprImm platform imm]
            ppr_item II32 _ = [text "\t.long\t"  <> pprImm platform imm]
            ppr_item II64 _ = [text "\t.quad\t"  <> pprImm platform imm]

            ppr_item FF32  (CmmFloat r _)
               = let bs = floatToBytes (fromRational r)
                 in  map (\b -> text "\t.byte\t" <> pprImm platform (ImmInt b)) bs

            ppr_item FF64 (CmmFloat r _)
               = let bs = doubleToBytes (fromRational r)
                 in  map (\b -> text "\t.byte\t" <> pprImm platform (ImmInt b)) bs

            ppr_item _ _ = pprPanic "pprDataItem:ppr_item" (text $ show lit)

    floatToBytes :: Float -> [Int]
    floatToBytes f
       = runST (do
            arr <- newArray_ ((0::Int),3)
            writeArray arr 0 f
            arr <- castFloatToWord8Array arr
            i0 <- readArray arr 0
            i1 <- readArray arr 1
            i2 <- readArray arr 2
            i3 <- readArray arr 3
            return (map fromIntegral [i0,i1,i2,i3])
         )

    castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
    castFloatToWord8Array = U.castSTUArray

    pprImm :: Platform -> Imm -> SDoc
    pprImm _ (ImmInt i)     = int i
    pprImm _ (ImmInteger i) = integer i
    pprImm p (ImmCLbl l)    = pdoc p l
    pprImm p (ImmIndex l i) = pdoc p l <> char '+' <> int i
    pprImm _ (ImmLit s)     = s

    -- TODO: See pprIm below for why this is a bad idea!
    pprImm _ (ImmFloat f)
      | f == 0 = text "wzr"
      | otherwise = float (fromRational f)
    pprImm _ (ImmDouble d)
      | d == 0 = text "xzr"
      | otherwise = double (fromRational d)

    pprImm p (ImmConstantSum a b) = pprImm p a <> char '+' <> pprImm p b
    pprImm p (ImmConstantDiff a b) = pprImm p a <> char '-'
                       <> lparen <> pprImm p b <> rparen

    -- aarch64 GNU as uses // for comments.
    asmComment :: SDoc -> SDoc
    asmComment c = whenPprDebug $ text "#" <+> c

    asmDoubleslashComment :: SDoc -> SDoc
    asmDoubleslashComment c = whenPprDebug $ text "//" <+> c

    asmMultilineComment :: SDoc -> SDoc
    asmMultilineComment c = whenPprDebug $ text "/*" $+$ c $+$ text "*/"

    pprIm :: Platform -> Imm -> SDoc
    pprIm platform im = case im of
      ImmInt i     -> char '#' <> int i
      ImmInteger i -> char '#' <> integer i

      -- TODO: This will only work for
      -- The floating point value must be expressable as ±n ÷ 16 × 2^r,
      -- where n and r are integers such that 16 ≤ n ≤ 31 and -3 ≤ r ≤ 4.
      -- and 0 needs to be encoded as wzr/xzr.
      --
      -- Except for 0, we might want to either split it up into enough
      -- ADD operations into an Integer register and then just bit copy it into
      -- the double register? See the toBytes + fromRational above for data items.
      -- This is something the x86 backend does.
      --
      -- We could also just turn them into statics :-/ Which is what the
      -- PowerPC backend odes.
      ImmFloat f | f == 0 -> text "wzr"
      ImmFloat f -> char '#' <> float (fromRational f)
      ImmDouble d | d == 0 -> text "xzr"
      ImmDouble d -> char '#' <> double (fromRational d)
      -- =<lbl> pseudo instruction!
      ImmCLbl l    -> char '=' <> pdoc platform l
      ImmIndex l o -> text "[=" <> pdoc platform l <> comma <+> char '#' <> int o <> char ']'
      _            -> panic "AArch64.pprIm"

    pprExt :: ExtMode -> SDoc
    pprExt EUXTB = text "uxtb"
    pprExt EUXTH = text "uxth"
    pprExt EUXTW = text "uxtw"
    pprExt EUXTX = text "uxtx"
    pprExt ESXTB = text "sxtb"
    pprExt ESXTH = text "sxth"
    pprExt ESXTW = text "sxtw"
    pprExt ESXTX = text "sxtx"

    pprShift :: ShiftMode -> SDoc
    pprShift SLSL = text "lsl"
    pprShift SLSR = text "lsr"
    pprShift SASR = text "asr"
    pprShift SROR = text "ror"

    pprOp :: Platform -> Operand -> SDoc
    pprOp plat op = case op of
      OpReg w r           -> pprReg w r
      OpRegExt w r x 0 -> pprReg w r <> comma <+> pprExt x
      OpRegExt w r x i -> pprReg w r <> comma <+> pprExt x <> comma <+> char '#' <> int i
      OpRegShift w r s i -> pprReg w r <> comma <+> pprShift s <+> char '#' <> int i
      OpImm im          -> pprIm plat im
      OpImmShift im s i -> pprIm plat im <> comma <+> pprShift s <+> char '#' <> int i
      -- TODO: Address compuation always use registers as 64bit -- is this correct?
      OpAddr (AddrRegReg r1 r2) -> char '[' <+> pprReg W64 r1 <> comma <+> pprReg W64 r2 <+> char ']'
      OpAddr (AddrRegImm r1 im) -> char '[' <+> pprReg W64 r1 <> comma <+> pprImm plat im <+> char ']'
      OpAddr (AddrReg r1)       -> char '[' <+> pprReg W64 r1 <+> char ']'

    pprReg :: Width -> Reg -> SDoc
    pprReg w r = case r of
      RegReal    (RealRegSingle i) -> ppr_reg_no w i
      RegReal    (RealRegPair{})   -> panic "AArch64.pprReg: no reg pairs on this arch!"
      -- virtual regs should not show up, but this is helpful for debugging.
      RegVirtual (VirtualRegI u)   -> text "%vI_" <> pprUniqueAlways u
      RegVirtual (VirtualRegF u)   -> text "%vF_" <> pprUniqueAlways u
      RegVirtual (VirtualRegD u)   -> text "%vD_" <> pprUniqueAlways u
      _                            -> pprPanic "AArch64.pprReg" (text $ show r)

      where
        ppr_reg_no :: Width -> Int -> SDoc
        ppr_reg_no w 31
             | w == W64 = text "sp"
             | w == W32 = text "wsp"

        ppr_reg_no w i
             | i < 0, w == W32 = text "wzr"
             | i < 0, w == W64 = text "xzr"
             | i < 0 = pprPanic "Invalid Zero Reg" (ppr w <+> int i)
             -- General Purpose Registers
             | i <= 31, w == W8  = text "w" <> int i      -- there are no byte or half
             | i <= 31, w == W16 = text "w" <> int i      -- words... word will do.
             | i <= 31, w == W32 = text "w" <> int i
             | i <= 31, w == W64 = text "x" <> int i
             | i <= 31 = pprPanic "Invalid Reg" (ppr w <+> int i)
             -- Floating Point Registers
             | i <= 63, w == W8  = text "b" <> int (i-32)
             | i <= 63, w == W16 = text "h" <> int (i-32)
             | i <= 63, w == W32 = text "s" <> int (i-32)
             | i <= 63, w == W64 = text "d" <> int (i-32)
             -- no support for 'q'uad in GHC's NCG yet.
             | otherwise = text "very naughty powerpc register"

    isFloatOp :: Operand -> Bool
    isFloatOp (OpReg _ (RegReal (RealRegSingle i))) | i > 31 = True
    isFloatOp (OpReg _ (RegVirtual (VirtualRegF _))) = True
    isFloatOp (OpReg _ (RegVirtual (VirtualRegD _))) = True
    isFloatOp _ = False

    pprInstr :: Platform -> Instr -> SDoc
    pprInstr platform instr = case instr of
      -- Meta Instructions ---------------------------------------------------------
      COMMENT s  -> asmComment s
      MULTILINE_COMMENT s -> asmMultilineComment s
      ANN d i -> pprInstr platform i <+> asmDoubleslashComment d
      LOCATION file line col _name
        -> text "\t.loc" <+> ppr file <+> ppr line <+> ppr col
      DELTA d    -> asmComment $ text ("\tdelta = " ++ show d)
      NEWBLOCK _ -> panic "PprInstr: NEWBLOCK"
      LDATA _ _  -> panic "pprInstr: LDATA"

      -- Pseudo Instructions -------------------------------------------------------

      PUSH_STACK_FRAME -> text "\tstp x29, x30, [sp, #-16]!"
                       $$ text "\tmov x29, sp"

      POP_STACK_FRAME -> text "\tldp x29, x30, [sp], #16"
      -- ===========================================================================
      -- AArch64 Instruction Set
      -- 1. Arithmetic Instructions ------------------------------------------------
      ADD  o1 o2 o3
        | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> text "\tfadd"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
        | otherwise -> text "\tadd"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      CMN  o1 o2    -> text "\tcmn"  <+> pprOp platform o1 <> comma <+> pprOp platform o2
      CMP  o1 o2
        | isFloatOp o1 && isFloatOp o2 -> text "\tfcmp"  <+> pprOp platform o1 <> comma <+> pprOp platform o2
        | otherwise -> text "\tcmp" <+> pprOp platform o1 <> comma <+> pprOp platform o2
      MSUB o1 o2 o3 o4 -> text "\tmsub" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
      MUL  o1 o2 o3
        | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> text "\tfmul"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
        | otherwise -> text "\tmul"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      SMULH o1 o2 o3 -> text "\tsmulh"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      SMULL o1 o2 o3 -> text "\tsmull"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      NEG  o1 o2
        | isFloatOp o1 && isFloatOp o2 -> text "\tfneg"  <+> pprOp platform o1 <> comma <+> pprOp platform o2
        | otherwise -> text "\tneg"  <+> pprOp platform o1 <> comma <+> pprOp platform o2
      SDIV o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3
        -> text "\tfdiv" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      SDIV o1 o2 o3 -> text "\tsdiv" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3

      SUB  o1 o2 o3
        | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> text "\tfsub"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
        | otherwise -> text "\tsub"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      UDIV o1 o2 o3 -> text "\tudiv" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3

      -- 2. Bit Manipulation Instructions ------------------------------------------
      SBFM o1 o2 o3 o4 -> text "\tsbfm" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
      UBFM o1 o2 o3 o4 -> text "\tubfm" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
      -- signed and unsigned bitfield extract
      SBFX o1 o2 o3 o4 -> text "\tsbfx" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
      UBFX o1 o2 o3 o4 -> text "\tubfx" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
      SXTB o1 o2       -> text "\tsxtb" <+> pprOp platform o1 <> comma <+> pprOp platform o2
      UXTB o1 o2       -> text "\tuxtb" <+> pprOp platform o1 <> comma <+> pprOp platform o2
      SXTH o1 o2       -> text "\tsxth" <+> pprOp platform o1 <> comma <+> pprOp platform o2
      UXTH o1 o2       -> text "\tuxth" <+> pprOp platform o1 <> comma <+> pprOp platform o2

      -- 3. Logical and Move Instructions ------------------------------------------
      AND o1 o2 o3  -> text "\tand" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      ANDS o1 o2 o3 -> text "\tands" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      ASR o1 o2 o3  -> text "\tasr" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      BIC o1 o2 o3  -> text "\tbic" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      BICS o1 o2 o3 -> text "\tbics" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      EON o1 o2 o3  -> text "\teon" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      EOR o1 o2 o3  -> text "\teor" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      LSL o1 o2 o3  -> text "\tlsl" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      LSR o1 o2 o3  -> text "\tlsr" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      MOV o1 o2
        | isFloatOp o1 || isFloatOp o2 -> text "\tfmov" <+> pprOp platform o1 <> comma <+> pprOp platform o2
        | otherwise -> text "\tmov" <+> pprOp platform o1 <> comma <+> pprOp platform o2
      MOVK o1 o2    -> text "\tmovk" <+> pprOp platform o1 <> comma <+> pprOp platform o2
      MVN o1 o2     -> text "\tmvn" <+> pprOp platform o1 <> comma <+> pprOp platform o2
      ORN o1 o2 o3  -> text "\torn" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      ORR o1 o2 o3  -> text "\torr" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      ROR o1 o2 o3  -> text "\tror" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      TST o1 o2     -> text "\ttst" <+> pprOp platform o1 <> comma <+> pprOp platform o2

      -- 4. Branch Instructions ----------------------------------------------------
      J t            -> pprInstr platform (B t)
      B (TBlock bid) -> text "\tb" <+> pdoc platform (mkLocalBlockLabel (getUnique bid))
      B (TLabel lbl) -> text "\tb" <+> pdoc platform lbl
      B (TReg r)     -> text "\tbr" <+> pprReg W64 r

      BL (TBlock bid) _ _ -> text "\tbl" <+> pdoc platform (mkLocalBlockLabel (getUnique bid))
      BL (TLabel lbl) _ _ -> text "\tbl" <+> pdoc platform lbl
      BL (TReg r)     _ _ -> text "\tblr" <+> pprReg W64 r

      BCOND c (TBlock bid) -> text "\t" <> pprBcond c <+> pdoc platform (mkLocalBlockLabel (getUnique bid))
      BCOND c (TLabel lbl) -> text "\t" <> pprBcond c <+> pdoc platform lbl
      BCOND _ (TReg _)     -> panic "AArch64.ppr: No conditional branching to registers!"

      -- 5. Atomic Instructions ----------------------------------------------------
      -- 6. Conditional Instructions -----------------------------------------------
      CSET o c  -> text "\tcset" <+> pprOp platform o <> comma <+> pprCond c

      CBZ o (TBlock bid) -> text "\tcbz" <+> pprOp platform o <> comma <+> pdoc platform (mkLocalBlockLabel (getUnique bid))
      CBZ o (TLabel lbl) -> text "\tcbz" <+> pprOp platform o <> comma <+> pdoc platform lbl
      CBZ _ (TReg _)     -> panic "AArch64.ppr: No conditional (cbz) branching to registers!"

      CBNZ o (TBlock bid) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pdoc platform (mkLocalBlockLabel (getUnique bid))
      CBNZ o (TLabel lbl) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pdoc platform lbl
      CBNZ _ (TReg _)     -> panic "AArch64.ppr: No conditional (cbnz) branching to registers!"

      -- 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 _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 ->
        text "\tstrb" <+> pprOp platform o1 <> comma <+> pprOp platform o2
      STR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 ->
        text "\tstrh" <+> pprOp platform o1 <> comma <+> pprOp platform o2
      STR _f o1 o2 -> text "\tstr" <+> pprOp platform o1 <> comma <+> pprOp platform o2

    #if defined(darwin_HOST_OS)
      LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
        text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$
        text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" $$
        text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.

      LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl ->
        text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$
        text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" $$
        text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.

      LDR _f o1 (OpImm (ImmIndex lbl off)) ->
        text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@page" $$
        text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@pageoff" $$
        text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.

      LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
        text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$
        text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]"

      LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl ->
        text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$
        text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]"

      LDR _f o1 (OpImm (ImmCLbl lbl)) ->
        text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@page" $$
        text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@pageoff"
    #else
      LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
        text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$
        text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" $$
        text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.

      LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl ->
        text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$
        text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" $$
        text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.

      LDR _f o1 (OpImm (ImmIndex lbl off)) ->
        text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl $$
        text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pdoc platform lbl $$
        text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.

      LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
        text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$
        text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]"

      LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl ->
        text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$
        text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]"

      LDR _f o1 (OpImm (ImmCLbl lbl)) ->
        text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl $$
        text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pdoc platform lbl
    #endif

      LDR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 ->
        text "\tldrb" <+> pprOp platform o1 <> comma <+> pprOp platform o2
      LDR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 ->
        text "\tldrh" <+> pprOp platform o1 <> comma <+> pprOp platform o2
      LDR _f o1 o2 -> text "\tldr" <+> pprOp platform o1 <> comma <+> pprOp platform o2

      STP _f o1 o2 o3 -> text "\tstp" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
      LDP _f o1 o2 o3 -> text "\tldp" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3

      -- 8. Synchronization Instructions -------------------------------------------
      DMBSY -> text "\tdmb sy"
      -- 9. Floating Point Instructions --------------------------------------------
      FCVT o1 o2 -> text "\tfcvt" <+> pprOp platform o1 <> comma <+> pprOp platform o2
      SCVTF o1 o2 -> text "\tscvtf" <+> pprOp platform o1 <> comma <+> pprOp platform o2
      FCVTZS o1 o2 -> text "\tfcvtzs" <+> pprOp platform o1 <> comma <+> pprOp platform o2
      FABS o1 o2 -> text "\tfabs" <+> pprOp platform o1 <> comma <+> pprOp platform o2

    pprBcond :: Cond -> SDoc
    pprBcond c = text "b." <> pprCond c

    pprCond :: Cond -> SDoc
    pprCond c = case c of
      ALWAYS -> text "al" -- Always
      EQ     -> text "eq" -- Equal
      NE     -> text "ne" -- Not Equal

      SLT    -> text "lt" -- Signed less than                  ; Less than, or unordered
      SLE    -> text "le" -- Signed less than or equal         ; Less than or equal, or unordered
      SGE    -> text "ge" -- Signed greater than or equal      ; Greater than or equal
      SGT    -> text "gt" -- Signed greater than               ; Greater than

      ULT    -> text "lo" -- Carry clear/ unsigned lower       ; less than
      ULE    -> text "ls" -- Unsigned lower or same            ; Less than or equal
      UGE    -> text "hs" -- Carry set/unsigned higher or same ; Greater than or equal, or unordered
      UGT    -> text "hi" -- Unsigned higher                   ; Greater than, or unordered

      NEVER  -> text "nv" -- Never
      VS     -> text "vs" -- Overflow                          ; Unordered (at least one NaN operand)
      VC     -> text "vc" -- No overflow                       ; Not unordered

      -- Orderd variants.  Respecting NaN.
      OLT    -> text "mi"
      OLE    -> text "ls"
      OGE    -> text "ge"
      OGT    -> text "gt"

      -- Unordered
      UOLT   -> text "lt"
      UOLE   -> text "le"
      UOGE   -> text "pl"
      UOGT   -> text "hi"