Stub the implementation for all phases
This commit is contained in:
		| @@ -37,8 +37,9 @@ library elna-internal | |||||||
|     exposed-modules: |     exposed-modules: | ||||||
|         Language.Elna.Architecture.RiscV |         Language.Elna.Architecture.RiscV | ||||||
|         Language.Elna.AST |         Language.Elna.AST | ||||||
|         Language.Elna.CommandLine |  | ||||||
|         Language.Elna.CodeGenerator |         Language.Elna.CodeGenerator | ||||||
|  |         Language.Elna.CommandLine | ||||||
|  |         Language.Elna.PrinterWriter | ||||||
|         Language.Elna.Intermediate |         Language.Elna.Intermediate | ||||||
|         Language.Elna.Location |         Language.Elna.Location | ||||||
|         Language.Elna.NameAnalysis |         Language.Elna.NameAnalysis | ||||||
|   | |||||||
| @@ -1,17 +1,19 @@ | |||||||
| module Language.Elna.AST | module Language.Elna.AST | ||||||
|     ( VariableAccess(..) |     ( Program(..) | ||||||
|  |     {-, VariableAccess(..) | ||||||
|     , Condition(..) |     , Condition(..) | ||||||
|     , Declaration(..) |     , Declaration(..) | ||||||
|     , Expression(..) |     , Expression(..) | ||||||
|     , Identifier(..) |     , Identifier(..) | ||||||
|     , Literal(..) |     , Literal(..) | ||||||
|     , Parameter(..) |     , Parameter(..) | ||||||
|     , Program(..) |  | ||||||
|     , Statement(..) |     , Statement(..) | ||||||
|     , VariableDeclaration(..) |     , VariableDeclaration(..) | ||||||
|     , TypeExpression(..) |     , TypeExpression(..)-} | ||||||
|     ) where |     ) where | ||||||
|  |  | ||||||
|  | data Program = Program | ||||||
|  | {- | ||||||
| import Data.Int (Int32) | import Data.Int (Int32) | ||||||
| import Data.List (intercalate) | import Data.List (intercalate) | ||||||
| import Data.Word (Word16, Word32) | import Data.Word (Word16, Word32) | ||||||
| @@ -165,3 +167,4 @@ instance Show Program | |||||||
| showParameters :: [Parameter] -> String | showParameters :: [Parameter] -> String | ||||||
| showParameters parameters = | showParameters parameters = | ||||||
|     "(" <> intercalate ", " (show <$> parameters) <> ")" |     "(" <> intercalate ", " (show <$> parameters) <> ")" | ||||||
|  | -} | ||||||
|   | |||||||
| @@ -136,6 +136,7 @@ data Type | |||||||
|     | R XRegister Funct3 XRegister XRegister Funct7 |     | R XRegister Funct3 XRegister XRegister Funct7 | ||||||
|     | U XRegister Word32 |     | U XRegister Word32 | ||||||
|     | J XRegister Word32 |     | J XRegister Word32 | ||||||
|  |     | Type XRegister Funct3 XRegister Funct12 -- Privileged. | ||||||
|  |  | ||||||
| data Instruction = Instruction BaseOpcode Type | data Instruction = Instruction BaseOpcode Type | ||||||
|  |  | ||||||
| @@ -278,6 +279,11 @@ type' (J rd immediate) | |||||||
|      .|. ((immediate .&. 0x800) `shiftL` 9) |      .|. ((immediate .&. 0x800) `shiftL` 9) | ||||||
|      .|. ((immediate .&. 0x7fe) `shiftL` 20) |      .|. ((immediate .&. 0x7fe) `shiftL` 20) | ||||||
|      .|. ((immediate .&. 0x100000) `shiftL` 11); |      .|. ((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 -> ByteString.Builder.Builder | ||||||
| instruction (Instruction base instructionType) | instruction (Instruction base instructionType) | ||||||
|   | |||||||
| @@ -1,3 +1,16 @@ | |||||||
| module Language.Elna.CodeGenerator | module Language.Elna.CodeGenerator | ||||||
|     ( |     ( generateCode | ||||||
|     ) where |     ) 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 | ||||||
|  |     ] | ||||||
|   | |||||||
| @@ -1,11 +1,28 @@ | |||||||
| module Language.Elna.Intermediate | module Language.Elna.Intermediate | ||||||
|     ( Label(..) |     ( Quadruple(..) | ||||||
|  |     {- , Label(..) | ||||||
|     , Operand(..) |     , Operand(..) | ||||||
|     , Quadruple(..) |     , Variable(..) -} | ||||||
|     , Variable(..) |  | ||||||
|     , intermediate |     , intermediate | ||||||
|     ) where |     ) 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 Control.Monad.Trans.State (State, runState, gets, modify') | ||||||
| import Data.Bifunctor (Bifunctor(..)) | import Data.Bifunctor (Bifunctor(..)) | ||||||
| import Data.Int (Int32) | import Data.Int (Int32) | ||||||
| @@ -13,11 +30,7 @@ import Data.HashMap.Strict (HashMap) | |||||||
| import qualified Data.HashMap.Strict as HashMap | import qualified Data.HashMap.Strict as HashMap | ||||||
| import Data.Text (Text) | import Data.Text (Text) | ||||||
| import Data.Word (Word32) | 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.Types (Type(..)) | ||||||
| import Language.Elna.SymbolTable (SymbolTable, Info(..)) |  | ||||||
| import qualified Language.Elna.SymbolTable as SymbolTable | import qualified Language.Elna.SymbolTable as SymbolTable | ||||||
| import Data.Foldable (Foldable(..), foldrM) | import Data.Foldable (Foldable(..), foldrM) | ||||||
| import GHC.Records (HasField(..)) | import GHC.Records (HasField(..)) | ||||||
| @@ -129,13 +142,6 @@ createTemporary = do | |||||||
|         { temporaryCounter = getField @"temporaryCounter" generator + 1 |         { temporaryCounter = getField @"temporaryCounter" generator + 1 | ||||||
|         } |         } | ||||||
|  |  | ||||||
| intermediate :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector Quadruple) |  | ||||||
| intermediate globalTable |  | ||||||
|     = fst |  | ||||||
|     . flip runState mempty |  | ||||||
|     . runIntermediate |  | ||||||
|     . program globalTable |  | ||||||
|  |  | ||||||
| program | program | ||||||
|     :: SymbolTable |     :: SymbolTable | ||||||
|     -> AST.Program |     -> AST.Program | ||||||
| @@ -326,3 +332,4 @@ literal (AST.CharacterLiteral character) = IntOperand $ fromIntegral character | |||||||
| literal (AST.BooleanLiteral boolean) | literal (AST.BooleanLiteral boolean) | ||||||
|     | boolean = IntOperand 1 |     | boolean = IntOperand 1 | ||||||
|     | otherwise = IntOperand 0 |     | otherwise = IntOperand 0 | ||||||
|  | -} | ||||||
|   | |||||||
| @@ -1,8 +1,22 @@ | |||||||
| module Language.Elna.NameAnalysis | module Language.Elna.NameAnalysis | ||||||
|     ( Error(..) |     ( nameAnalysis | ||||||
|     , nameAnalysis |     -- , Error(..) | ||||||
|     ) where |     ) 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.Except (Except, runExcept, throwE) | ||||||
| import Control.Monad.Trans.Reader | import Control.Monad.Trans.Reader | ||||||
|     ( ReaderT(..) |     ( ReaderT(..) | ||||||
| @@ -12,14 +26,7 @@ import Control.Monad.Trans.Reader | |||||||
|     , withReaderT |     , withReaderT | ||||||
|     ) |     ) | ||||||
| import Data.Functor ((<&>)) | import Data.Functor ((<&>)) | ||||||
| import qualified Language.Elna.AST as AST |  | ||||||
| import Language.Elna.Location (Identifier(..)) | import Language.Elna.Location (Identifier(..)) | ||||||
| import Language.Elna.SymbolTable |  | ||||||
|     ( Info(..) |  | ||||||
|     , ParameterInfo(..) |  | ||||||
|     , SymbolTable |  | ||||||
|     , builtInSymbolTable |  | ||||||
|     ) |  | ||||||
| import qualified Language.Elna.SymbolTable as SymbolTable | import qualified Language.Elna.SymbolTable as SymbolTable | ||||||
| import Language.Elna.Types (Type(..)) | import Language.Elna.Types (Type(..)) | ||||||
| import Control.Monad.Trans.Class (MonadTrans(..)) | import Control.Monad.Trans.Class (MonadTrans(..)) | ||||||
| @@ -53,12 +60,6 @@ instance Monad NameAnalysis | |||||||
|   where |   where | ||||||
|     (NameAnalysis x) >>= f = NameAnalysis $ x >>= (runNameAnalysis . f) |     (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 -> NameAnalysis SymbolTable | ||||||
| program (AST.Program declarations) | program (AST.Program declarations) | ||||||
|     = NameAnalysis ask |     = NameAnalysis ask | ||||||
| @@ -206,3 +207,4 @@ dataType (AST.NamedType baseType) = do | |||||||
|         _ -> NameAnalysis $ lift $ throwE $ UndefinedTypeError baseType |         _ -> NameAnalysis $ lift $ throwE $ UndefinedTypeError baseType | ||||||
| dataType (AST.ArrayType arraySize baseType) = | dataType (AST.ArrayType arraySize baseType) = | ||||||
|     dataType baseType <&> ArrayType arraySize |     dataType baseType <&> ArrayType arraySize | ||||||
|  | -} | ||||||
|   | |||||||
| @@ -33,6 +33,7 @@ module Language.Elna.Object.Elf | |||||||
|     , elfHeaderSize |     , elfHeaderSize | ||||||
|     , elfIdentification |     , elfIdentification | ||||||
|     , elfObject |     , elfObject | ||||||
|  |     , elfSectionsSize | ||||||
|     , rInfo |     , rInfo | ||||||
|     , stInfo |     , stInfo | ||||||
|     ) where |     ) where | ||||||
| @@ -469,11 +470,23 @@ instance Exception ElfEncodingError | |||||||
| fromIntegralEnum :: (Enum a, Num b) => a -> b | fromIntegralEnum :: (Enum a, Num b) => a -> b | ||||||
| fromIntegralEnum = fromIntegral . fromEnum | fromIntegralEnum = fromIntegral . fromEnum | ||||||
|  |  | ||||||
|  | -- * Object file generation. | ||||||
|  |  | ||||||
|  | -- | ELF header size. | ||||||
| elfHeaderSize :: Elf32_Off | elfHeaderSize :: Elf32_Off | ||||||
| elfHeaderSize = 52 | 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. | -- Writes an ELF object with the given header to the provided file path. | ||||||
| -- The callback writes the sections and returns headers for those sections. | -- 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 :: FilePath -> Elf32_Ehdr -> (Handle -> IO (Vector Elf32_Shdr)) -> IO () | ||||||
| elfObject outFile header putContents = withFile outFile WriteMode withObjectFile | elfObject outFile header putContents = withFile outFile WriteMode withObjectFile | ||||||
|   where |   where | ||||||
| @@ -484,7 +497,9 @@ elfObject outFile header putContents = withFile outFile WriteMode withObjectFile | |||||||
|     afterContents objectHandle headers = |     afterContents objectHandle headers = | ||||||
|         let headerEncodingResult = elf32Ehdr |         let headerEncodingResult = elf32Ehdr | ||||||
|                 $ header |                 $ 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 |          in traverse_ (ByteString.Builder.hPutBuilder objectHandle . elf32Shdr LSB) headers | ||||||
|             >> either throwIO (putHeaders objectHandle) headerEncodingResult |             >> either throwIO (putHeaders objectHandle) headerEncodingResult | ||||||
|   | |||||||
| @@ -3,34 +3,34 @@ module Language.Elna.Parser | |||||||
|     , programP |     , programP | ||||||
|     ) where |     ) where | ||||||
|  |  | ||||||
| import Control.Monad (void) | -- import Control.Monad (void) | ||||||
| import Control.Monad.Combinators.Expr (Operator(..), makeExprParser) | -- import Control.Monad.Combinators.Expr (Operator(..), makeExprParser) | ||||||
| import Data.Text (Text) | import Data.Text (Text) | ||||||
| import qualified Data.Text as Text | -- import qualified Data.Text as Text | ||||||
| import Data.Void (Void) | import Data.Void (Void) | ||||||
| import Language.Elna.AST | import Language.Elna.AST | ||||||
|     ( VariableAccess(..) |     ( Program(..) | ||||||
|  |     {-, VariableAccess(..) | ||||||
|     , Condition(..) |     , Condition(..) | ||||||
|     , Declaration(..) |     , Declaration(..) | ||||||
|     , Expression(..) |     , Expression(..) | ||||||
|     , Identifier(..) |     , Identifier(..) | ||||||
|     , Literal(..) |     , Literal(..) | ||||||
|     , Parameter(..) |     , Parameter(..) | ||||||
|     , Program(..) |  | ||||||
|     , Statement(..) |     , Statement(..) | ||||||
|     , TypeExpression(..) |     , TypeExpression(..) | ||||||
|     , VariableDeclaration(..) |     , VariableDeclaration(..)-} | ||||||
|     ) |     ) | ||||||
| import Text.Megaparsec | import Text.Megaparsec | ||||||
|     ( Parsec |     ( Parsec | ||||||
|     , MonadParsec(..) |     {-, MonadParsec(..) | ||||||
|     , (<?>) |     , (<?>) | ||||||
|     , optional |     , optional | ||||||
|     , between |     , between | ||||||
|     , sepBy |     , sepBy | ||||||
|     , choice |     , choice -} | ||||||
|     ) |     ) | ||||||
| import Text.Megaparsec.Char | {- import Text.Megaparsec.Char | ||||||
|     ( alphaNumChar |     ( alphaNumChar | ||||||
|     , char |     , char | ||||||
|     , letterChar |     , letterChar | ||||||
| @@ -41,9 +41,9 @@ import qualified Text.Megaparsec.Char.Lexer as Lexer | |||||||
| import Control.Applicative (Alternative(..)) | import Control.Applicative (Alternative(..)) | ||||||
| import Data.Maybe (isJust) | import Data.Maybe (isJust) | ||||||
| import Data.Functor (($>)) | import Data.Functor (($>)) | ||||||
|  | -} | ||||||
| type Parser = Parsec Void Text | type Parser = Parsec Void Text | ||||||
|  | {- | ||||||
| space :: Parser () | space :: Parser () | ||||||
| space = Lexer.space space1 (Lexer.skipLineComment "//") | space = Lexer.space space1 (Lexer.skipLineComment "//") | ||||||
|     $ Lexer.skipBlockComment "/*" "*/" |     $ Lexer.skipBlockComment "/*" "*/" | ||||||
| @@ -214,6 +214,6 @@ procedureDefinitionP = procedureCons | |||||||
|  |  | ||||||
| declarationP :: Parser Declaration | declarationP :: Parser Declaration | ||||||
| declarationP = typeDefinitionP <|> procedureDefinitionP | declarationP = typeDefinitionP <|> procedureDefinitionP | ||||||
|  | -} | ||||||
| programP :: Parser Program | programP :: Parser Program | ||||||
| programP = Program <$> many declarationP | programP = pure Program -- <$> many declarationP | ||||||
|   | |||||||
							
								
								
									
										172
									
								
								lib/Language/Elna/PrinterWriter.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										172
									
								
								lib/Language/Elna/PrinterWriter.hs
									
									
									
									
									
										Normal 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 | ||||||
|  |     } | ||||||
| @@ -1,15 +1,22 @@ | |||||||
| module Language.Elna.SymbolTable | module Language.Elna.SymbolTable | ||||||
|     ( Info(..) |     ( SymbolTable | ||||||
|     , ParameterInfo(..) |  | ||||||
|     , SymbolTable |  | ||||||
|     , builtInSymbolTable |  | ||||||
|     , empty |     , empty | ||||||
|  |     {-, Info(..) | ||||||
|  |     , ParameterInfo(..) | ||||||
|  |     , builtInSymbolTable | ||||||
|     , enter |     , enter | ||||||
|     , fromList |     , fromList | ||||||
|     , lookup |     , lookup | ||||||
|     , member |     , member -} | ||||||
|     ) where |     ) where | ||||||
|  |  | ||||||
|  | data SymbolTable = SymbolTable -- (HashMap Identifier Info) | ||||||
|  |     deriving (Eq, Show) | ||||||
|  |  | ||||||
|  | empty :: SymbolTable | ||||||
|  | empty = SymbolTable -- HashMap.empty | ||||||
|  |  | ||||||
|  | {- | ||||||
| import Data.HashMap.Strict (HashMap) | import Data.HashMap.Strict (HashMap) | ||||||
| import qualified Data.HashMap.Strict as HashMap | import qualified Data.HashMap.Strict as HashMap | ||||||
| import Data.List (sort) | import Data.List (sort) | ||||||
| @@ -20,9 +27,6 @@ import Language.Elna.Location (Identifier(..)) | |||||||
| import Language.Elna.Types (Type(..), intType, booleanType) | import Language.Elna.Types (Type(..), intType, booleanType) | ||||||
| import Prelude hiding (lookup) | import Prelude hiding (lookup) | ||||||
|  |  | ||||||
| newtype SymbolTable = SymbolTable (HashMap Identifier Info) |  | ||||||
|     deriving (Eq, Show) |  | ||||||
|  |  | ||||||
| instance Semigroup SymbolTable | instance Semigroup SymbolTable | ||||||
|   where |   where | ||||||
|     (SymbolTable lhs) <> (SymbolTable rhs) = SymbolTable $ rhs <> lhs |     (SymbolTable lhs) <> (SymbolTable rhs) = SymbolTable $ rhs <> lhs | ||||||
| @@ -37,9 +41,6 @@ builtInSymbolTable = SymbolTable $ HashMap.fromList | |||||||
|     , ("int", TypeInfo intType) |     , ("int", TypeInfo intType) | ||||||
|     ] |     ] | ||||||
|  |  | ||||||
| empty :: SymbolTable |  | ||||||
| empty = SymbolTable HashMap.empty |  | ||||||
|  |  | ||||||
| enter :: Identifier -> Info -> SymbolTable -> Maybe SymbolTable | enter :: Identifier -> Info -> SymbolTable -> Maybe SymbolTable | ||||||
| enter identifier info table@(SymbolTable hashTable) | enter identifier info table@(SymbolTable hashTable) | ||||||
|     | member identifier table = Nothing |     | member identifier table = Nothing | ||||||
| @@ -76,3 +77,4 @@ data Info | |||||||
|     | VariableInfo Bool Type |     | VariableInfo Bool Type | ||||||
|     | ProcedureInfo SymbolTable (Vector ParameterInfo) |     | ProcedureInfo SymbolTable (Vector ParameterInfo) | ||||||
|     deriving (Eq, Show) |     deriving (Eq, Show) | ||||||
|  | -} | ||||||
|   | |||||||
| @@ -1,15 +1,24 @@ | |||||||
| module Language.Elna.TypeAnalysis | module Language.Elna.TypeAnalysis | ||||||
|     ( Error(..) |     ( typeAnalysis | ||||||
|     , typeAnalysis |     , -- Error(..) | ||||||
|     ) where |     ) 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.Applicative (Alternative(..)) | ||||||
| import Control.Monad.Trans.Except (Except, runExcept, throwE) | import Control.Monad.Trans.Except (Except, runExcept, throwE) | ||||||
| import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT, withReaderT, ask) | import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT, withReaderT, ask) | ||||||
| import qualified Data.Vector as Vector | import qualified Data.Vector as Vector | ||||||
| import qualified Language.Elna.AST as AST |  | ||||||
| import Language.Elna.Location (Identifier(..)) | import Language.Elna.Location (Identifier(..)) | ||||||
| import Language.Elna.SymbolTable (Info(..), ParameterInfo(..), SymbolTable) |  | ||||||
| import qualified Language.Elna.SymbolTable as SymbolTable | import qualified Language.Elna.SymbolTable as SymbolTable | ||||||
| import Language.Elna.Types (Type(..), booleanType, intType) | import Language.Elna.Types (Type(..), booleanType, intType) | ||||||
| import Control.Monad.Trans.Class (MonadTrans(..)) | import Control.Monad.Trans.Class (MonadTrans(..)) | ||||||
| @@ -48,13 +57,6 @@ instance Monad TypeAnalysis | |||||||
|   where |   where | ||||||
|     (TypeAnalysis x) >>= f = TypeAnalysis $ x >>= (runTypeAnalysis . f) |     (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 -> TypeAnalysis () | ||||||
| program (AST.Program declarations) = traverse_ declaration declarations | program (AST.Program declarations) = traverse_ declaration declarations | ||||||
|  |  | ||||||
| @@ -181,3 +183,4 @@ literal (AST.IntegerLiteral _) = pure intType | |||||||
| literal (AST.HexadecimalLiteral _) = pure intType | literal (AST.HexadecimalLiteral _) = pure intType | ||||||
| literal (AST.CharacterLiteral _) = pure intType | literal (AST.CharacterLiteral _) = pure intType | ||||||
| literal (AST.BooleanLiteral _) = pure booleanType | literal (AST.BooleanLiteral _) = pure booleanType | ||||||
|  | -} | ||||||
|   | |||||||
| @@ -46,7 +46,8 @@ namespace :test do | |||||||
|   file init => [root_directory] do |task| |   file init => [root_directory] do |task| | ||||||
|     cp (TMP + 'tools/init'), task.name |     cp (TMP + 'tools/init'), task.name | ||||||
|   end |   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| |   file (TMP + 'riscv/root.cpio') => test_files do |task| | ||||||
|     root_files = task.prerequisites |     root_files = task.prerequisites | ||||||
|   | |||||||
							
								
								
									
										91
									
								
								src/Main.hs
									
									
									
									
									
								
							
							
						
						
									
										91
									
								
								src/Main.hs
									
									
									
									
									
								
							| @@ -3,78 +3,33 @@ module Main | |||||||
|     ) where |     ) where | ||||||
|  |  | ||||||
| import Language.Elna.CommandLine (CommandLine(..), commandLine, execParser) | import Language.Elna.CommandLine (CommandLine(..), commandLine, execParser) | ||||||
| import Language.Elna.Object.Elf | import Language.Elna.PrinterWriter (riscv32Elf, riscv32Header) | ||||||
|     ( Elf32_Ehdr(..) | import Language.Elna.Object.Elf (elfObject) | ||||||
|     , ElfMachine(..) | import Language.Elna.Parser (programP) | ||||||
|     , ElfType(..) | import Language.Elna.NameAnalysis (nameAnalysis) | ||||||
|     , ElfVersion(..) | import Language.Elna.TypeAnalysis (typeAnalysis) | ||||||
|     , ElfIdentification(..) | import Language.Elna.Intermediate (intermediate) | ||||||
|     , ElfClass(..) | import Language.Elna.CodeGenerator (generateCode) | ||||||
|     , ElfData(..) |  | ||||||
|     , Elf32_Shdr(..) |  | ||||||
|     , ElfSectionType(..) |  | ||||||
|     , elfHeaderSize |  | ||||||
|     , elfObject |  | ||||||
|     ) |  | ||||||
| import qualified Data.ByteString as ByteString |  | ||||||
| import Data.Vector (Vector) |  | ||||||
| import qualified Data.Vector as Vector |  | ||||||
| import Data.Maybe (fromMaybe) | import Data.Maybe (fromMaybe) | ||||||
| import System.IO (Handle) |  | ||||||
| import System.FilePath (replaceExtension, takeFileName) | import System.FilePath (replaceExtension, takeFileName) | ||||||
|  | import Text.Megaparsec (runParser, errorBundlePretty) | ||||||
| riscv32Elf :: Handle -> IO (Vector Elf32_Shdr) | import qualified Data.Text.IO as Text | ||||||
| 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 |  | ||||||
|     } |  | ||||||
|  |  | ||||||
| main :: IO () | main :: IO () | ||||||
| main  = execParser commandLine >>= withCommandLine | main  = execParser commandLine >>= withCommandLine | ||||||
|   where |   where | ||||||
|     withCommandLine CommandLine{..} = |     withCommandLine CommandLine{..} = | ||||||
|         let defaultOutput = replaceExtension (takeFileName input) "o" |         let defaultOutput = flip fromMaybe output | ||||||
|          in elfObject (fromMaybe defaultOutput output) riscv32Header riscv32Elf |                 $ 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 | ||||||
|   | |||||||
		Reference in New Issue
	
	Block a user