Stub the implementation for all phases

This commit is contained in:
Eugen Wissner 2024-09-08 02:08:13 +02:00
parent a625bbff50
commit 1cbbef19af
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
13 changed files with 319 additions and 139 deletions

View File

@ -37,8 +37,9 @@ library elna-internal
exposed-modules:
Language.Elna.Architecture.RiscV
Language.Elna.AST
Language.Elna.CommandLine
Language.Elna.CodeGenerator
Language.Elna.CommandLine
Language.Elna.PrinterWriter
Language.Elna.Intermediate
Language.Elna.Location
Language.Elna.NameAnalysis

View File

@ -1,17 +1,19 @@
module Language.Elna.AST
( VariableAccess(..)
( Program(..)
{-, VariableAccess(..)
, Condition(..)
, Declaration(..)
, Expression(..)
, Identifier(..)
, Literal(..)
, Parameter(..)
, Program(..)
, Statement(..)
, VariableDeclaration(..)
, TypeExpression(..)
, TypeExpression(..)-}
) where
data Program = Program
{-
import Data.Int (Int32)
import Data.List (intercalate)
import Data.Word (Word16, Word32)
@ -165,3 +167,4 @@ instance Show Program
showParameters :: [Parameter] -> String
showParameters parameters =
"(" <> intercalate ", " (show <$> parameters) <> ")"
-}

View File

@ -136,6 +136,7 @@ data Type
| R XRegister Funct3 XRegister XRegister Funct7
| U XRegister Word32
| J XRegister Word32
| Type XRegister Funct3 XRegister Funct12 -- Privileged.
data Instruction = Instruction BaseOpcode Type
@ -278,6 +279,11 @@ type' (J rd immediate)
.|. ((immediate .&. 0x800) `shiftL` 9)
.|. ((immediate .&. 0x7fe) `shiftL` 20)
.|. ((immediate .&. 0x100000) `shiftL` 11);
type' (Type rd funct3' rs1 funct12')
= (fromIntegral (xRegister rd) `shiftL` 7)
.|. (fromIntegral (funct3 funct3') `shiftL` 12)
.|. (fromIntegral (xRegister rs1) `shiftL` 15)
.|. (fromIntegral (funct12 funct12') `shiftL` 20);
instruction :: Instruction -> ByteString.Builder.Builder
instruction (Instruction base instructionType)

View File

@ -1,3 +1,16 @@
module Language.Elna.CodeGenerator
(
( generateCode
) where
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Language.Elna.Intermediate (Quadruple(..))
import qualified Language.Elna.Architecture.RiscV as RiscV
import Language.Elna.SymbolTable (SymbolTable)
generateCode :: SymbolTable -> Vector Quadruple -> Vector RiscV.Instruction
generateCode _ _ = Vector.fromList
[ RiscV.Instruction RiscV.OpImm $ RiscV.I RiscV.A0 RiscV.ADDI RiscV.Zero 0
, RiscV.Instruction RiscV.OpImm $ RiscV.I RiscV.A7 RiscV.ADDI RiscV.Zero 93
, RiscV.Instruction RiscV.System $ RiscV.Type RiscV.Zero RiscV.PRIV RiscV.Zero RiscV.ECALL
]

View File

@ -1,11 +1,28 @@
module Language.Elna.Intermediate
( Label(..)
( Quadruple(..)
{- , Label(..)
, Operand(..)
, Quadruple(..)
, Variable(..)
, Variable(..) -}
, intermediate
) where
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import qualified Language.Elna.AST as AST
import Language.Elna.SymbolTable (SymbolTable{-, Info(..) -})
data Quadruple
= StartQuadruple
| StopQuadruple
deriving (Eq, Show)
intermediate :: SymbolTable -> AST.Program -> {- HashMap AST.Identifier (-} Vector Quadruple --)
intermediate _globalTable = const $ Vector.fromList [StartQuadruple, StopQuadruple]
{- = fst
. flip runState mempty
. runIntermediate
. program globalTable -}
{-
import Control.Monad.Trans.State (State, runState, gets, modify')
import Data.Bifunctor (Bifunctor(..))
import Data.Int (Int32)
@ -13,11 +30,7 @@ import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import Data.Word (Word32)
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import qualified Language.Elna.AST as AST
import Language.Elna.Types (Type(..))
import Language.Elna.SymbolTable (SymbolTable, Info(..))
import qualified Language.Elna.SymbolTable as SymbolTable
import Data.Foldable (Foldable(..), foldrM)
import GHC.Records (HasField(..))
@ -129,13 +142,6 @@ createTemporary = do
{ temporaryCounter = getField @"temporaryCounter" generator + 1
}
intermediate :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector Quadruple)
intermediate globalTable
= fst
. flip runState mempty
. runIntermediate
. program globalTable
program
:: SymbolTable
-> AST.Program
@ -326,3 +332,4 @@ literal (AST.CharacterLiteral character) = IntOperand $ fromIntegral character
literal (AST.BooleanLiteral boolean)
| boolean = IntOperand 1
| otherwise = IntOperand 0
-}

View File

@ -1,8 +1,22 @@
module Language.Elna.NameAnalysis
( Error(..)
, nameAnalysis
( nameAnalysis
-- , Error(..)
) where
import qualified Language.Elna.AST as AST
import Language.Elna.SymbolTable
( SymbolTable
, empty
--, Info(..)
-- , ParameterInfo(..)
)
nameAnalysis :: AST.Program -> SymbolTable -- Either Error SymbolTable
nameAnalysis = const empty {- runExcept
. flip runReaderT builtInSymbolTable
. runNameAnalysis
. program -}
{-
import Control.Monad.Trans.Except (Except, runExcept, throwE)
import Control.Monad.Trans.Reader
( ReaderT(..)
@ -12,14 +26,7 @@ import Control.Monad.Trans.Reader
, withReaderT
)
import Data.Functor ((<&>))
import qualified Language.Elna.AST as AST
import Language.Elna.Location (Identifier(..))
import Language.Elna.SymbolTable
( Info(..)
, ParameterInfo(..)
, SymbolTable
, builtInSymbolTable
)
import qualified Language.Elna.SymbolTable as SymbolTable
import Language.Elna.Types (Type(..))
import Control.Monad.Trans.Class (MonadTrans(..))
@ -53,12 +60,6 @@ instance Monad NameAnalysis
where
(NameAnalysis x) >>= f = NameAnalysis $ x >>= (runNameAnalysis . f)
nameAnalysis :: AST.Program -> Either Error SymbolTable
nameAnalysis = runExcept
. flip runReaderT builtInSymbolTable
. runNameAnalysis
. program
program :: AST.Program -> NameAnalysis SymbolTable
program (AST.Program declarations)
= NameAnalysis ask
@ -206,3 +207,4 @@ dataType (AST.NamedType baseType) = do
_ -> NameAnalysis $ lift $ throwE $ UndefinedTypeError baseType
dataType (AST.ArrayType arraySize baseType) =
dataType baseType <&> ArrayType arraySize
-}

View File

@ -33,6 +33,7 @@ module Language.Elna.Object.Elf
, elfHeaderSize
, elfIdentification
, elfObject
, elfSectionsSize
, rInfo
, stInfo
) where
@ -469,11 +470,23 @@ instance Exception ElfEncodingError
fromIntegralEnum :: (Enum a, Num b) => a -> b
fromIntegralEnum = fromIntegral . fromEnum
-- * Object file generation.
-- | ELF header size.
elfHeaderSize :: Elf32_Off
elfHeaderSize = 52
-- | Calculates the size of all sections based on the 'sh_size' in the given
-- headers and adds 'elfHeaderSize' to it.
elfSectionsSize :: Vector Elf32_Shdr -> Elf32_Off
elfSectionsSize = (elfHeaderSize +)
. Vector.foldr ((+) . sh_size) 0
-- Writes an ELF object with the given header to the provided file path.
-- The callback writes the sections and returns headers for those sections.
--
-- It updates some of the header header according to the given headers and
-- expects .shstrtab be the last header in the list.
elfObject :: FilePath -> Elf32_Ehdr -> (Handle -> IO (Vector Elf32_Shdr)) -> IO ()
elfObject outFile header putContents = withFile outFile WriteMode withObjectFile
where
@ -484,7 +497,9 @@ elfObject outFile header putContents = withFile outFile WriteMode withObjectFile
afterContents objectHandle headers =
let headerEncodingResult = elf32Ehdr
$ header
{ e_shoff = elfHeaderSize + Vector.foldr ((+) . sh_size) 0 headers
{ e_shoff = elfSectionsSize headers
, e_shnum = fromIntegral $ Vector.length headers
, e_shstrndx = fromIntegral (Vector.length headers) - 1
}
in traverse_ (ByteString.Builder.hPutBuilder objectHandle . elf32Shdr LSB) headers
>> either throwIO (putHeaders objectHandle) headerEncodingResult

View File

@ -3,34 +3,34 @@ module Language.Elna.Parser
, programP
) where
import Control.Monad (void)
import Control.Monad.Combinators.Expr (Operator(..), makeExprParser)
-- import Control.Monad (void)
-- import Control.Monad.Combinators.Expr (Operator(..), makeExprParser)
import Data.Text (Text)
import qualified Data.Text as Text
-- import qualified Data.Text as Text
import Data.Void (Void)
import Language.Elna.AST
( VariableAccess(..)
( Program(..)
{-, VariableAccess(..)
, Condition(..)
, Declaration(..)
, Expression(..)
, Identifier(..)
, Literal(..)
, Parameter(..)
, Program(..)
, Statement(..)
, TypeExpression(..)
, VariableDeclaration(..)
, VariableDeclaration(..)-}
)
import Text.Megaparsec
( Parsec
, MonadParsec(..)
{-, MonadParsec(..)
, (<?>)
, optional
, between
, sepBy
, choice
, choice -}
)
import Text.Megaparsec.Char
{- import Text.Megaparsec.Char
( alphaNumChar
, char
, letterChar
@ -41,9 +41,9 @@ import qualified Text.Megaparsec.Char.Lexer as Lexer
import Control.Applicative (Alternative(..))
import Data.Maybe (isJust)
import Data.Functor (($>))
-}
type Parser = Parsec Void Text
{-
space :: Parser ()
space = Lexer.space space1 (Lexer.skipLineComment "//")
$ Lexer.skipBlockComment "/*" "*/"
@ -214,6 +214,6 @@ procedureDefinitionP = procedureCons
declarationP :: Parser Declaration
declarationP = typeDefinitionP <|> procedureDefinitionP
-}
programP :: Parser Program
programP = Program <$> many declarationP
programP = pure Program -- <$> many declarationP

View File

@ -0,0 +1,172 @@
-- | Writer assembler to an object file.
module Language.Elna.PrinterWriter
( riscv32Elf
, riscv32Header
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Builder as ByteString.Builder
import qualified Data.ByteString.Lazy as LazyByteString
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Language.Elna.Object.Elf
( ByteOrder(..)
, Elf32_Ehdr(..)
, Elf32_Half
, Elf32_Sym(..)
, ElfMachine(..)
, ElfType(..)
, ElfVersion(..)
, ElfIdentification(..)
, ElfClass(..)
, ElfData(..)
, Elf32_Shdr(..)
, ElfSectionType(..)
, ElfSymbolBinding(..)
, ElfSymbolType(..)
, elf32Sym
, elfHeaderSize
, elfSectionsSize
, stInfo
)
import System.IO (Handle)
import qualified Language.Elna.Architecture.RiscV as RiscV
data ElfHeaderResult a = ElfHeaderResult ByteString (Vector a)
riscv32Elf :: Vector RiscV.Instruction -> Handle -> IO (Vector Elf32_Shdr)
riscv32Elf code objectHandle =
let zeroHeader = Elf32_Shdr
{ sh_type = SHT_NULL
, sh_size = 0
, sh_offset = 0
, sh_name = 0
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 0
, sh_addr = 0
}
in text (ElfHeaderResult "\0" $ Vector.singleton zeroHeader)
>>= shstrtab
>>= finalize
where
finalize (ElfHeaderResult _ headers) = pure headers
shstrtab (ElfHeaderResult names headers) = do
let stringTable = names <> ".shstrtab\0"
nextHeader = Elf32_Shdr
{ sh_type = SHT_STRTAB
, sh_size = fromIntegral $ ByteString.length stringTable
, sh_offset = elfSectionsSize headers
, sh_name = fromIntegral $ ByteString.length names
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 0
, sh_addr = 0
}
ByteString.hPut objectHandle stringTable
pure $ ElfHeaderResult stringTable
$ Vector.snoc headers nextHeader
strtab stringTable (ElfHeaderResult names headers) = do
let newHeader = Elf32_Shdr
{ sh_type = SHT_STRTAB
, sh_size = fromIntegral $ ByteString.length stringTable
, sh_offset = elfSectionsSize headers
, sh_name = fromIntegral $ ByteString.length names
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 0
, sh_addr = 0
}
ByteString.hPut objectHandle stringTable
pure $ ElfHeaderResult (names <> ".strtab\0")
$ Vector.snoc headers newHeader
symtab strtabIndex entries (ElfHeaderResult names headers) = do
let encoded = LazyByteString.toStrict
$ ByteString.Builder.toLazyByteString
$ foldMap (elf32Sym LSB) entries
newHeader = Elf32_Shdr
{ sh_type = SHT_SYMTAB
, sh_size = fromIntegral $ ByteString.length encoded
, sh_offset = elfSectionsSize headers
, sh_name = fromIntegral $ ByteString.length names
, sh_link = strtabIndex
, sh_info = 1
, sh_flags = 0
, sh_entsize = 16
, sh_addralign = 0
, sh_addr = 0
}
ByteString.hPut objectHandle encoded
pure $ ElfHeaderResult (names <> ".symtab\0")
$ Vector.snoc headers newHeader
text (ElfHeaderResult names headers) = do
let textTabIndex = fromIntegral $ Vector.length headers
strtabIndex = fromIntegral $ textTabIndex + 2
ElfHeaderResult stringTable entries <- symbolEntry textTabIndex code
$ ElfHeaderResult "\0"
$ Vector.singleton
$ Elf32_Sym
{ st_value = 0
, st_size = 0
, st_shndx = 0
, st_other = 0
, st_name = 0
, st_info = 0
}
let newHeader = Elf32_Shdr
{ sh_type = SHT_PROGBITS
, sh_size = fromIntegral $ foldr ((+) . st_size) 0 entries
, sh_offset = elfSectionsSize headers
, sh_name = fromIntegral $ ByteString.length names
, sh_link = 0
, sh_info = 0
, sh_flags = 0b110
, sh_entsize = 0
, sh_addralign = 0
, sh_addr = 0
}
newResult = ElfHeaderResult (names <> ".text\0")
$ Vector.snoc headers newHeader
symtab strtabIndex entries newResult
>>= strtab stringTable
symbolEntry :: Elf32_Half -> Vector RiscV.Instruction -> ElfHeaderResult Elf32_Sym -> IO (ElfHeaderResult Elf32_Sym)
symbolEntry shndx instructions (ElfHeaderResult names entries) = do
let encoded = LazyByteString.toStrict
$ ByteString.Builder.toLazyByteString
$ foldMap RiscV.instruction instructions
newEntry = Elf32_Sym
{ st_value = 0
, st_size = fromIntegral $ ByteString.length encoded
, st_shndx = shndx
, st_other = 0
, st_name = fromIntegral $ ByteString.length names
, st_info = stInfo STB_GLOBAL STT_FUNC
}
ByteString.hPut objectHandle encoded
pure $ ElfHeaderResult (names <> "_start\0")
$ Vector.snoc entries newEntry
riscv32Header :: Elf32_Ehdr
riscv32Header = Elf32_Ehdr
{ e_version = EV_CURRENT
, e_type = ET_REL
, e_shstrndx = 2 -- String table. SHN_UNDEF
, e_shoff = 0
, e_shnum = 0
, e_shentsize = 40
, e_phoff = 0
, e_phnum = 0
, e_phentsize = 32
, e_machine = EM_RISCV
, e_ident = ElfIdentification ELFCLASS32 ELFDATA2LSB
, e_flags = 0x4 -- EF_RISCV_FLOAT_ABI_DOUBLE
, e_entry = 0
, e_ehsize = fromIntegral elfHeaderSize
}

View File

@ -1,15 +1,22 @@
module Language.Elna.SymbolTable
( Info(..)
, ParameterInfo(..)
, SymbolTable
, builtInSymbolTable
( SymbolTable
, empty
{-, Info(..)
, ParameterInfo(..)
, builtInSymbolTable
, enter
, fromList
, lookup
, member
, member -}
) where
data SymbolTable = SymbolTable -- (HashMap Identifier Info)
deriving (Eq, Show)
empty :: SymbolTable
empty = SymbolTable -- HashMap.empty
{-
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.List (sort)
@ -20,9 +27,6 @@ import Language.Elna.Location (Identifier(..))
import Language.Elna.Types (Type(..), intType, booleanType)
import Prelude hiding (lookup)
newtype SymbolTable = SymbolTable (HashMap Identifier Info)
deriving (Eq, Show)
instance Semigroup SymbolTable
where
(SymbolTable lhs) <> (SymbolTable rhs) = SymbolTable $ rhs <> lhs
@ -37,9 +41,6 @@ builtInSymbolTable = SymbolTable $ HashMap.fromList
, ("int", TypeInfo intType)
]
empty :: SymbolTable
empty = SymbolTable HashMap.empty
enter :: Identifier -> Info -> SymbolTable -> Maybe SymbolTable
enter identifier info table@(SymbolTable hashTable)
| member identifier table = Nothing
@ -76,3 +77,4 @@ data Info
| VariableInfo Bool Type
| ProcedureInfo SymbolTable (Vector ParameterInfo)
deriving (Eq, Show)
-}

View File

@ -1,15 +1,24 @@
module Language.Elna.TypeAnalysis
( Error(..)
, typeAnalysis
( typeAnalysis
, -- Error(..)
) where
import qualified Language.Elna.AST as AST
import Language.Elna.SymbolTable ({-Info(..), ParameterInfo(..), -}SymbolTable)
typeAnalysis :: SymbolTable -> AST.Program -> () -- Maybe Error
typeAnalysis _globalTable = const () {- either Just (const Nothing)
. runExcept
. flip runReaderT globalTable
. runTypeAnalysis
. program -}
{-
import Control.Applicative (Alternative(..))
import Control.Monad.Trans.Except (Except, runExcept, throwE)
import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT, withReaderT, ask)
import qualified Data.Vector as Vector
import qualified Language.Elna.AST as AST
import Language.Elna.Location (Identifier(..))
import Language.Elna.SymbolTable (Info(..), ParameterInfo(..), SymbolTable)
import qualified Language.Elna.SymbolTable as SymbolTable
import Language.Elna.Types (Type(..), booleanType, intType)
import Control.Monad.Trans.Class (MonadTrans(..))
@ -48,13 +57,6 @@ instance Monad TypeAnalysis
where
(TypeAnalysis x) >>= f = TypeAnalysis $ x >>= (runTypeAnalysis . f)
typeAnalysis :: SymbolTable -> AST.Program -> Maybe Error
typeAnalysis globalTable = either Just (const Nothing)
. runExcept
. flip runReaderT globalTable
. runTypeAnalysis
. program
program :: AST.Program -> TypeAnalysis ()
program (AST.Program declarations) = traverse_ declaration declarations
@ -181,3 +183,4 @@ literal (AST.IntegerLiteral _) = pure intType
literal (AST.HexadecimalLiteral _) = pure intType
literal (AST.CharacterLiteral _) = pure intType
literal (AST.BooleanLiteral _) = pure booleanType
-}

View File

@ -46,7 +46,8 @@ namespace :test do
file init => [root_directory] do |task|
cp (TMP + 'tools/init'), task.name
end
test_files << init << executable_directory << expectation_directory
# Directories should come first.
test_files.unshift executable_directory, expectation_directory, init
file (TMP + 'riscv/root.cpio') => test_files do |task|
root_files = task.prerequisites

View File

@ -3,78 +3,33 @@ module Main
) where
import Language.Elna.CommandLine (CommandLine(..), commandLine, execParser)
import Language.Elna.Object.Elf
( Elf32_Ehdr(..)
, ElfMachine(..)
, ElfType(..)
, ElfVersion(..)
, ElfIdentification(..)
, ElfClass(..)
, ElfData(..)
, Elf32_Shdr(..)
, ElfSectionType(..)
, elfHeaderSize
, elfObject
)
import qualified Data.ByteString as ByteString
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Language.Elna.PrinterWriter (riscv32Elf, riscv32Header)
import Language.Elna.Object.Elf (elfObject)
import Language.Elna.Parser (programP)
import Language.Elna.NameAnalysis (nameAnalysis)
import Language.Elna.TypeAnalysis (typeAnalysis)
import Language.Elna.Intermediate (intermediate)
import Language.Elna.CodeGenerator (generateCode)
import Data.Maybe (fromMaybe)
import System.IO (Handle)
import System.FilePath (replaceExtension, takeFileName)
riscv32Elf :: Handle -> IO (Vector Elf32_Shdr)
riscv32Elf objectHandle =
let stringTable = "\0shstrtab\0"
written = Vector.fromList
[ Elf32_Shdr
{ sh_type = SHT_NULL
, sh_size = 0
, sh_offset = 0
, sh_name = 0
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 0
, sh_addr = 0
}
, Elf32_Shdr
{ sh_type = SHT_STRTAB
, sh_size = fromIntegral $ ByteString.length stringTable
, sh_offset = fromIntegral elfHeaderSize
, sh_name = 1
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 0
, sh_addr = 0
}
]
in ByteString.hPut objectHandle stringTable >> pure written
riscv32Header :: Elf32_Ehdr
riscv32Header = Elf32_Ehdr
{ e_version = EV_CURRENT
, e_type = ET_REL
, e_shstrndx = 1 -- String table. SHN_UNDEF
, e_shoff = 0
, e_shnum = 2
, e_shentsize = 40
, e_phoff = 0
, e_phnum = 0
, e_phentsize = 32
, e_machine = EM_RISCV
, e_ident = ElfIdentification ELFCLASS32 ELFDATA2LSB
, e_flags = 0x4 -- EF_RISCV_FLOAT_ABI_DOUBLE
, e_entry = 0
, e_ehsize = fromIntegral elfHeaderSize
}
import Text.Megaparsec (runParser, errorBundlePretty)
import qualified Data.Text.IO as Text
main :: IO ()
main = execParser commandLine >>= withCommandLine
where
withCommandLine CommandLine{..} =
let defaultOutput = replaceExtension (takeFileName input) "o"
in elfObject (fromMaybe defaultOutput output) riscv32Header riscv32Elf
let defaultOutput = flip fromMaybe output
$ replaceExtension (takeFileName input) "o"
in Text.readFile input
>>= withParsedInput defaultOutput
. runParser programP input
withParsedInput output (Right program) =
let symbolTable = nameAnalysis program
_ = typeAnalysis symbolTable program
intermediate' = intermediate symbolTable program
in elfObject output riscv32Header
$ riscv32Elf
$ generateCode symbolTable intermediate'
withParsedInput _ (Left errorBundle) = putStrLn
$ errorBundlePretty errorBundle