-----------------------------------------------------------------------------
--
-- Pretty-printing assembly language
--
-- (c) The University of Glasgow 1993-2005
--
-----------------------------------------------------------------------------

module PprBase (
        castFloatToWord8Array,
        castDoubleToWord8Array,
        floatToBytes,
        doubleToBytes,
        pprSectionHeader
)

where

import CLabel
import Cmm
import DynFlags
import FastString
import Outputable
import Platform

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

import Control.Monad.ST

import Data.Word



-- -----------------------------------------------------------------------------
-- Converting floating-point literals to integrals for printing

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

castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
castDoubleToWord8Array = U.castSTUArray

-- floatToBytes and doubleToBytes convert to the host's byte
-- order.  Providing that we're not cross-compiling for a
-- target with the opposite endianness, this should work ok
-- on all targets.

-- ToDo: this stuff is very similar to the shenanigans in PprAbs,
-- could they be merged?

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])
     )

doubleToBytes :: Double -> [Int]
doubleToBytes d
   = runST (do
        arr <- newArray_ ((0::Int),7)
        writeArray arr 0 d
        arr <- castDoubleToWord8Array arr
        i0 <- readArray arr 0
        i1 <- readArray arr 1
        i2 <- readArray arr 2
        i3 <- readArray arr 3
        i4 <- readArray arr 4
        i5 <- readArray arr 5
        i6 <- readArray arr 6
        i7 <- readArray arr 7
        return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])
     )

-- ----------------------------------------------------------------------------
-- Printing section headers.
--
-- If -split-section was specified, include the suffix label, otherwise just
-- print the section type. For Darwin, where subsections-for-symbols are
-- used instead, only print section type.
--
-- For string literals, additional flags are specified to enable merging of
-- identical strings in the linker. With -split-sections each string also gets
-- a unique section to allow strings from unused code to be GC'd.

pprSectionHeader :: Platform -> Section -> SDoc
pprSectionHeader platform (Section t suffix) =
 case platformOS platform of
   OSAIX    -> pprXcoffSectionHeader t
   OSDarwin -> pprDarwinSectionHeader t
   _        -> pprGNUSectionHeader t suffix

pprGNUSectionHeader :: SectionType -> CLabel -> SDoc
pprGNUSectionHeader t suffix = sdocWithDynFlags $ \dflags ->
  let splitSections = gopt Opt_SplitSections dflags
      subsection | splitSections = char '.' <> ppr suffix
                 | otherwise     = empty
  in  text ".section " <> ptext (header dflags) <> subsection <>
      flags dflags
  where
    header dflags = case t of
      Text -> sLit ".text"
      Data -> sLit ".data"
      ReadOnlyData -> sLit ".rodata"
      RelocatableReadOnlyData -> sLit ".data.rel.ro"
      UninitialisedData -> sLit ".bss"
      ReadOnlyData16 -> sLit ".rodata.cst16"
      CString
        | OSMinGW32 <- platformOS (targetPlatform dflags)
          -> sLit ".rdata"
        | otherwise -> sLit ".rodata.str"
      OtherSection _ ->
        panic "PprBase.pprGNUSectionHeader: unknown section type"
    flags dflags = case t of
      CString
        | OSMinGW32 <- platformOS (targetPlatform dflags)
          -> text ",\"dr\""
        | otherwise -> text ",\"aMS\",@progbits,1"
      _ -> empty

-- XCOFF doesn't support relocating label-differences, so we place all
-- RO sections into .text[PR] sections
pprXcoffSectionHeader :: SectionType -> SDoc
pprXcoffSectionHeader t = text $ case t of
     Text                    -> ".csect .text[PR]"
     Data                    -> ".csect .data[RW]"
     ReadOnlyData            -> ".csect .text[PR] # ReadOnlyData"
     RelocatableReadOnlyData -> ".csect .text[PR] # RelocatableReadOnlyData"
     ReadOnlyData16          -> ".csect .text[PR] # ReadOnlyData16"
     CString                 -> ".csect .text[PR] # CString"
     UninitialisedData       -> ".csect .data[BS]"
     OtherSection _          ->
       panic "PprBase.pprXcoffSectionHeader: unknown section type"

pprDarwinSectionHeader :: SectionType -> SDoc
pprDarwinSectionHeader t =
  ptext $ case t of
     Text -> sLit ".text"
     Data -> sLit ".data"
     ReadOnlyData -> sLit ".const"
     RelocatableReadOnlyData -> sLit ".const_data"
     UninitialisedData -> sLit ".data"
     ReadOnlyData16 -> sLit ".const"
     CString -> sLit ".section\t__TEXT,__cstring,cstring_literals"
     OtherSection _ ->
       panic "PprBase.pprDarwinSectionHeader: unknown section type"