summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs102
1 files changed, 92 insertions, 10 deletions
diff --git a/src/Main.hs b/src/Main.hs
index bb8be4c..4004d5c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,13 +1,95 @@
-module Main where
+module Main
+ ( main
+ ) where
-import Language.Elna.Parser (programP)
-import Text.Megaparsec (runParser, errorBundlePretty)
-import qualified Data.Text.IO as Text
+import Language.Elna.Object.Elf
+ ( ByteOrder(..)
+ , Elf32_Ehdr(..)
+ , Elf32_Off
+ , ElfMachine(..)
+ , ElfType(..)
+ , ElfVersion(..)
+ , ElfIdentification(..)
+ , ElfClass(..)
+ , ElfData(..)
+ , Elf32_Shdr(..)
+ , ElfSectionType(..)
+ , elf32Ehdr
+ , elf32Shdr
+ )
+import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.Builder as ByteString.Builder
+import Data.Vector (Vector)
+import qualified Data.Vector as Vector
+import Control.Exception (throwIO)
+import System.IO (Handle, IOMode(..), SeekMode(..), hSeek, withFile)
+import Data.Foldable (traverse_)
-main :: IO ()
-main = Text.getContents
- >>= withParseResult . runParser programP ""
+riscv32Elf :: FilePath -> IO ()
+riscv32Elf outFile = withFile outFile WriteMode withObjectFile
where
- withParseResult (Right _) = pure ()
- withParseResult (Left errorBundle) =
- putStr $ errorBundlePretty errorBundle
+ headerSize :: Elf32_Off
+ headerSize = 52
+ withObjectFile objectHandle
+ = hSeek objectHandle AbsoluteSeek (fromIntegral headerSize)
+ >> putContents objectHandle
+ >>= afterContents objectHandle
+ afterContents objectHandle headers =
+ let headerEncodingResult = elf32Ehdr
+ $ header
+ $ Vector.foldr ((+) . sh_size) 0 headers
+ in traverse_ (ByteString.Builder.hPutBuilder objectHandle . elf32Shdr LSB) headers
+ >> either throwIO (putHeaders objectHandle) headerEncodingResult
+ putHeaders objectHandle encodedHeader
+ = hSeek objectHandle AbsoluteSeek 0
+ >> ByteString.Builder.hPutBuilder objectHandle encodedHeader
+ putContents :: Handle -> IO (Vector Elf32_Shdr)
+ putContents 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 headerSize
+ , 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
+ header written = Elf32_Ehdr
+ { e_version = EV_CURRENT
+ , e_type = ET_REL
+ , e_shstrndx = 1 -- String table. SHN_UNDEF
+ , e_shoff = written + headerSize
+ , 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 headerSize
+ }
+
+main :: IO ()
+main = riscv32Elf "here.o"