Add rake task to build a cross toolchain

2024-09-04 21:50:13 +02:00
parent ad0bf43ba5
commit be73032b93
6 changed files with 868 additions and 11 deletions
--- 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_)
+
+riscv32Elf :: FilePath -> IO ()
+riscv32Elf outFile = withFile outFile WriteMode withObjectFile
+  where
+    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 = Text.getContents
-    >>= withParseResult . runParser programP ""
-  where
-    withParseResult (Right _) = pure ()
-    withParseResult (Left errorBundle) =
-        putStr $ errorBundlePretty errorBundle
+main = riscv32Elf "here.o"