From 1cbbef19afcf997315431e3aa45f824fe8a8a0e7 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sun, 8 Sep 2024 02:08:13 +0200 Subject: [PATCH] Stub the implementation for all phases --- elna.cabal | 3 +- lib/Language/Elna/AST.hs | 9 +- lib/Language/Elna/Architecture/RiscV.hs | 6 + lib/Language/Elna/CodeGenerator.hs | 15 ++- lib/Language/Elna/Intermediate.hs | 35 +++-- lib/Language/Elna/NameAnalysis.hs | 32 ++--- lib/Language/Elna/Object/Elf.hs | 17 ++- lib/Language/Elna/Parser.hs | 26 ++-- lib/Language/Elna/PrinterWriter.hs | 172 ++++++++++++++++++++++++ lib/Language/Elna/SymbolTable.hs | 24 ++-- lib/Language/Elna/TypeAnalysis.hs | 25 ++-- rakelib/tester.rake | 3 +- src/Main.hs | 91 ++++--------- 13 files changed, 319 insertions(+), 139 deletions(-) create mode 100644 lib/Language/Elna/PrinterWriter.hs diff --git a/elna.cabal b/elna.cabal index 1d87b2e..2c3fc44 100644 --- a/elna.cabal +++ b/elna.cabal @@ -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 diff --git a/lib/Language/Elna/AST.hs b/lib/Language/Elna/AST.hs index ac86e63..a13798c 100644 --- a/lib/Language/Elna/AST.hs +++ b/lib/Language/Elna/AST.hs @@ -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) <> ")" +-} diff --git a/lib/Language/Elna/Architecture/RiscV.hs b/lib/Language/Elna/Architecture/RiscV.hs index 5d8c247..f4c3887 100644 --- a/lib/Language/Elna/Architecture/RiscV.hs +++ b/lib/Language/Elna/Architecture/RiscV.hs @@ -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) diff --git a/lib/Language/Elna/CodeGenerator.hs b/lib/Language/Elna/CodeGenerator.hs index cdbfc01..6097843 100644 --- a/lib/Language/Elna/CodeGenerator.hs +++ b/lib/Language/Elna/CodeGenerator.hs @@ -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 + ] diff --git a/lib/Language/Elna/Intermediate.hs b/lib/Language/Elna/Intermediate.hs index 4e23fd9..d334661 100644 --- a/lib/Language/Elna/Intermediate.hs +++ b/lib/Language/Elna/Intermediate.hs @@ -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 +-} diff --git a/lib/Language/Elna/NameAnalysis.hs b/lib/Language/Elna/NameAnalysis.hs index 0034628..78b3ce4 100644 --- a/lib/Language/Elna/NameAnalysis.hs +++ b/lib/Language/Elna/NameAnalysis.hs @@ -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 +-} diff --git a/lib/Language/Elna/Object/Elf.hs b/lib/Language/Elna/Object/Elf.hs index 4328f56..5dbbd78 100644 --- a/lib/Language/Elna/Object/Elf.hs +++ b/lib/Language/Elna/Object/Elf.hs @@ -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 diff --git a/lib/Language/Elna/Parser.hs b/lib/Language/Elna/Parser.hs index aa7c315..4828bf5 100644 --- a/lib/Language/Elna/Parser.hs +++ b/lib/Language/Elna/Parser.hs @@ -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 diff --git a/lib/Language/Elna/PrinterWriter.hs b/lib/Language/Elna/PrinterWriter.hs new file mode 100644 index 0000000..38c3549 --- /dev/null +++ b/lib/Language/Elna/PrinterWriter.hs @@ -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 + } diff --git a/lib/Language/Elna/SymbolTable.hs b/lib/Language/Elna/SymbolTable.hs index b56d0c7..c8406fc 100644 --- a/lib/Language/Elna/SymbolTable.hs +++ b/lib/Language/Elna/SymbolTable.hs @@ -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) +-} diff --git a/lib/Language/Elna/TypeAnalysis.hs b/lib/Language/Elna/TypeAnalysis.hs index 0d939e3..ac61b62 100644 --- a/lib/Language/Elna/TypeAnalysis.hs +++ b/lib/Language/Elna/TypeAnalysis.hs @@ -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 +-} diff --git a/rakelib/tester.rake b/rakelib/tester.rake index ef05556..c348303 100644 --- a/rakelib/tester.rake +++ b/rakelib/tester.rake @@ -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 diff --git a/src/Main.hs b/src/Main.hs index 4d5e406..872cad9 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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