{-|
Module      : Htcc.Asm.Intrinsic.Structure.Section.Data
Description : The modules of intrinsic (x86_64) assembly
Copyright   : (c) roki, 2019
License     : MIT
Maintainer  : falgon53@yahoo.co.jp
Stability   : experimental
Portability : POSIX

The modules of intrinsic (x86_64) assembly
-}
{-# LANGUAGE OverloadedStrings #-}
module Htcc.Asm.Intrinsic.Structure.Section.Data (
    DataSectionCtx,
    DataLabelCtx,
    dAta,
    label,
    byte,
    sbyte,
    ascii,
    asciiz,
    zero,
    quad,
) where

import qualified Data.ByteString                       as B
import qualified Data.Text                             as T
import qualified Htcc.Asm.Intrinsic.Structure.Internal as C
import           Numeric.Natural

import           Htcc.Utils                            (tshow)

-- | the type representing the context inside the data section
data DataSectionCtx

-- | the type representing the context inside the data label
data DataLabelCtx

-- | data section
dAta :: C.Asm DataSectionCtx e a -> C.Asm C.AsmCodeCtx e a
dAta :: Asm DataSectionCtx e a -> Asm AsmCodeCtx e a
dAta = Text -> Asm DataSectionCtx e a -> Asm AsmCodeCtx e a
forall ctx e a. Text -> Asm ctx e a -> Asm AsmCodeCtx e a
C.section "data"

-- | label in data section.
label :: T.Text -> C.Asm DataLabelCtx e a -> C.Asm DataSectionCtx e a
label :: Text -> Asm DataLabelCtx e a -> Asm DataSectionCtx e a
label lbl :: Text
lbl asm :: Asm DataLabelCtx e a
asm = Text -> Asm DataSectionCtx e ()
forall ctx e. Text -> Asm ctx e ()
C.putStrLnWithIndent (Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":") Asm DataSectionCtx e ()
-> Asm DataSectionCtx e a -> Asm DataSectionCtx e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Asm DataLabelCtx e a -> Asm DataSectionCtx e a
forall ctx e a ctx'. Asm ctx e a -> Asm ctx' e a
C.unCtx (Asm DataLabelCtx e a -> Asm DataLabelCtx e a
forall ctx e a. Asm ctx e a -> Asm ctx e a
C.labeled Asm DataLabelCtx e a
asm)

-- | @byte@ in data section
byte :: B.ByteString -> C.Asm DataLabelCtx e ()
byte :: ByteString -> Asm DataLabelCtx e ()
byte = Text -> Asm DataLabelCtx e ()
forall ctx e. Text -> Asm ctx e ()
C.putStrLnWithIndent (Text -> Asm DataLabelCtx e ())
-> (ByteString -> Text) -> ByteString -> Asm DataLabelCtx e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append ".byte " (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate ", " ([Text] -> Text) -> (ByteString -> [Text]) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Text) -> [Word8] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Text
forall a. Show a => a -> Text
tshow ([Word8] -> [Text])
-> (ByteString -> [Word8]) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack

-- | @.x.byte@ in data section
sbyte :: (Num i, Show i) => Natural -> i -> C.Asm DataLabelCtx e ()
sbyte :: Natural -> i -> Asm DataLabelCtx e ()
sbyte sz :: Natural
sz val :: i
val
    | Natural
sz Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = Text -> Asm DataLabelCtx e ()
forall ctx e. Text -> Asm ctx e ()
C.putStrLnWithIndent (Text -> Asm DataLabelCtx e ()) -> Text -> Asm DataLabelCtx e ()
forall a b. (a -> b) -> a -> b
$ ".byte " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> i -> Text
forall a. Show a => a -> Text
tshow i
val
    | Bool
otherwise = Text -> Asm DataLabelCtx e ()
forall ctx e. Text -> Asm ctx e ()
C.putStrLnWithIndent (Text -> Asm DataLabelCtx e ()) -> Text -> Asm DataLabelCtx e ()
forall a b. (a -> b) -> a -> b
$ "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Natural -> Text
forall a. Show a => a -> Text
tshow Natural
sz Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "byte " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> i -> Text
forall a. Show a => a -> Text
tshow i
val

-- | @ascii@ in data section
ascii :: B.ByteString -> C.Asm DataLabelCtx e ()
ascii :: ByteString -> Asm DataLabelCtx e ()
ascii = Text -> Asm DataLabelCtx e ()
forall ctx e. Text -> Asm ctx e ()
C.putStrLnWithIndent (Text -> Asm DataLabelCtx e ())
-> (ByteString -> Text) -> ByteString -> Asm DataLabelCtx e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append ".ascii " (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a. Show a => a -> Text
tshow

-- | @asciiz@ in data section
asciiz :: B.ByteString -> C.Asm DataLabelCtx e ()
asciiz :: ByteString -> Asm DataLabelCtx e ()
asciiz = ByteString -> Asm DataLabelCtx e ()
forall e. ByteString -> Asm DataLabelCtx e ()
byte (ByteString -> Asm DataLabelCtx e ())
-> (ByteString -> ByteString)
-> ByteString
-> Asm DataLabelCtx e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> ByteString
`B.append` "\0")

-- | @zero@ in data section
zero :: Natural -> C.Asm DataLabelCtx e ()
zero :: Natural -> Asm DataLabelCtx e ()
zero = Text -> Asm DataLabelCtx e ()
forall ctx e. Text -> Asm ctx e ()
C.putStrLnWithIndent (Text -> Asm DataLabelCtx e ())
-> (Natural -> Text) -> Natural -> Asm DataLabelCtx e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append ".zero " (Text -> Text) -> (Natural -> Text) -> Natural -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Text
forall a. Show a => a -> Text
tshow

-- | @quad@ in data section
quad :: T.Text -> C.Asm DataLabelCtx e ()
quad :: Text -> Asm DataLabelCtx e ()
quad = Text -> Asm DataLabelCtx e ()
forall ctx e. Text -> Asm ctx e ()
C.putStrLnWithIndent (Text -> Asm DataLabelCtx e ())
-> (Text -> Text) -> Text -> Asm DataLabelCtx e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append ".quad "