<commit_before>{-|
Module      : Language.X86.HwTranslator
Description : Virtual Asm to Hardware Asm translator
Copyright   : (c) <NAME> and <NAME>, 2016
License     : MIT
Maintainer  : <EMAIL>
Stability   : experimental

This module is reponsible for the translation between virtual and hardware
assembly. The main steps of this translation are:

    * Compute lifetimes for every virtual register in the program (see
      "Language.X86.Lifetime")
    * Allocate hardware locations for every virtual register (see
      "Language.X86.HwAllocator")
-}

{-# LANGUAGE ScopedTypeVariables #-}

module Language.X86.HwTranslator where

import Language.Common.Misc
import Language.Common.Storage
import Language.X86.Core
import Language.X86.Hardware
import Language.X86.Hardware.Registers
import Language.X86.Lifetime
import Language.X86.Virtual

import Control.Monad.Identity
import Control.Monad.Except
import Control.Monad.State
import Control.Monad.Trans.Free

import qualified Data.Map.Strict as M

type Alg f a = f a -> a

translate
    :: M.Map SizedVirtualRegister HardwareLocation
    -> [(SizedHardwareRegister, LifetimeSpan)]
    -> VirtualAsm Int ()
    -> HardwareTranslation Int (HardwareAsm Int ())
translate vToH live = iterM phi . ($> pure ()) where
    phi :: Alg
            (AsmF Int (Operand SizedVirtualRegister Int))
            (HardwareTranslation Int (HardwareAsm Int ()))
    phi a = case a of
        -- Pass through newLabel
        NewLabel f -> f =<< gets _ip

        -- Pass through setLabel
        SetLabel l m -> do
            p <- m
            pure $ do
                setLabel l
                p

        Prologue di n -> do
            code <- case di of
                -- Function prologue: make space on the stack for spills, push
                -- safe registers that are in use throughout this function.
                Save -> do
                    off <- gets _currentSpillOffset
                    pregs <- gets _safeRegistersUsed

                    let stkoff = (negate off `div` 16) * 16
                    let s = sub rsp (Immediate $ ImmI $ fromIntegral $ stkoff)

                    saveCode <- forM pregs $ \(SizedRegister _ reg) -> case reg of
                        FloatingHwRegister _ -> throwError $ InvariantViolation
                            "No floating register is safe"
                        IntegerHwRegister r -> pure $ push $ fixedIntReg64 r

                    pure $ s >> sequence_ saveCode

                -- Mirror image of Prologue Save (pop safe registers, clear the
                -- space on the stack.
                Load -> do
                    off <- gets _currentSpillOffset
                    pregs <- gets _safeRegistersUsed

                    -- Obviously, this popping needs to be done in reverse.
                    loadCode <- forM (reverse pregs) $ \(SizedRegister _ reg) -> case reg of
                        FloatingHwRegister _ -> throwError $ InvariantViolation
                            "No floating register is safe"
                        IntegerHwRegister r -> pure $ pop $ fixedIntReg64 r

                    let stkoff = (negate off `div` 16) * 16
                    let a' = add rsp (Immediate $ ImmI $ fromIntegral $ stkoff)

                    pure $ sequence_ loadCode >> a'

            next <- n

            pure $ code >> next

        Scratch di n ->
            case di of
                -- On a scratch save, push all the scratch registers that are
                -- currently live.
                Save -> do
                    i <- gets _ip
                    let sr = getLiveScratch i live

                    modify $ \s -> s { _latestSavedRegisters = sr }

                    let ss = map (push . Register . Direct) sr
                    next <- n

                    pure $ do
                        sequence_ ss
                        when (length sr `mod` 2 /= 0) $ do
                            push rax -- add a dummy push for 16 byte alignment
                        next

                -- Mirror: pop in reverse the registers we had saved before.
                Load -> do
                    sr <- gets _latestSavedRegisters
                    let ss = map (pop . Register . Direct) (reverse sr)
                    next <- n

                    pure $ do
                        when (length sr `mod` 2 /= 0) $ do
                            -- remove the dummy push for 16 byte alignment
                            pop rax
                        sequence_ ss<commit_msg>fix 16-byte stack alignment strategy<commit_after>{-|
Module      : Language.X86.HwTranslator
Description : Virtual Asm to Hardware Asm translator
Copyright   : (c) <NAME> and <NAME>, 2016
License     : MIT
Maintainer  : <EMAIL>
Stability   : experimental

This module is reponsible for the translation between virtual and hardware
assembly. The main steps of this translation are:

    * Compute lifetimes for every virtual register in the program (see
      "Language.X86.Lifetime")
    * Allocate hardware locations for every virtual register (see
      "Language.X86.HwAllocator")
-}

{-# LANGUAGE ScopedTypeVariables #-}

module Language.X86.HwTranslator where

import Language.Common.Misc
import Language.Common.Storage
import Language.X86.Core
import Language.X86.Hardware
import Language.X86.Hardware.Registers
import Language.X86.Lifetime
import Language.X86.Virtual

import Control.Monad.Identity
import Control.Monad.Except
import Control.Monad.State
import Control.Monad.Trans.Free

import qualified Data.Map.Strict as M

type Alg f a = f a -> a

translate
    :: M.Map SizedVirtualRegister HardwareLocation
    -> [(SizedHardwareRegister, LifetimeSpan)]
    -> VirtualAsm Int ()
    -> HardwareTranslation Int (HardwareAsm Int ())
translate vToH live = iterM phi . ($> pure ()) where
    phi :: Alg
            (AsmF Int (Operand SizedVirtualRegister Int))
            (HardwareTranslation Int (HardwareAsm Int ()))
    phi a = case a of
        -- Pass through newLabel
        NewLabel f -> f =<< gets _ip

        -- Pass through setLabel
        SetLabel l m -> do
            p <- m
            pure $ do
                setLabel l
                p

        Prologue di n -> do
            code <- case di of
                -- Function prologue: make space on the stack for spills, push
                -- safe registers that are in use throughout this function.
                Save -> do
                    off <- gets _currentSpillOffset
                    pregs <- gets _safeRegistersUsed

                    let stkoff = (negate off `div` 16) * 16
                    let s = sub rsp (Immediate $ ImmI $ fromIntegral $ stkoff)

                    saveCode <- forM pregs $ \(SizedRegister _ reg) -> case reg of
                        FloatingHwRegister _ -> throwError $ InvariantViolation
                            "No floating register is safe"
                        IntegerHwRegister r -> pure $ push $ fixedIntReg64 r

                    pure $ s >> sequence_ saveCode

                -- Mirror image of Prologue Save (pop safe registers, clear the
                -- space on the stack.
                Load -> do
                    off <- gets _currentSpillOffset
                    pregs <- gets _safeRegistersUsed

                    -- Obviously, this popping needs to be done in reverse.
                    loadCode <- forM (reverse pregs) $ \(SizedRegister _ reg) -> case reg of
                        FloatingHwRegister _ -> throwError $ InvariantViolation
                            "No floating register is safe"
                        IntegerHwRegister r -> pure $ pop $ fixedIntReg64 r

                    let stkoff = (negate off `div` 16) * 16
                    let a' = add rsp (Immediate $ ImmI $ fromIntegral $ stkoff)

                    pure $ sequence_ loadCode >> a'

            next <- n

            pure $ code >> next

        Scratch di n ->
            case di of
                -- On a scratch save, push all the scratch registers that are
                -- currently live.
                Save -> do
                    i <- gets _ip
                    let sr = getLiveScratch i live

                    modify $ \s -> s { _latestSavedRegisters = sr }

                    let ss = map (push . Register . Direct) sr
                    next <- n

                    pure $ do
                        sequence_ ss
                        when (length sr `mod` 2 /= 0) $ do
                            sub rsp (Immediate (ImmI 8))
                        next

                -- Mirror: pop in reverse the registers we had saved before.
                Load -> do
                    sr <- gets _latestSavedRegisters
                    let ss = map (pop . Register . Direct) (reverse sr)
                    next <- n

                    pure $ do
                        when (length sr `mod` 2 /= 0) $ do
                            -- remove the dummy push for 16 byte alignment
                            add rsp (Immediate (ImmI 8))
                        sequence_ ss
{'fraction_non_alphanumeric': 0.06758241758241758, 'fraction_numerical': 0.009450549450549451, 'mean_word_length': 1.395630429060279, 'pattern_counts': {'":': 0, '<': 39, '<?xml version=': 0, '>': 61, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6523037', 'n_tokens_mistral': 2450, 'n_tokens_neox': 2207, 'n_words': 845}