Add command line parser

elna.cabal

@@ -19,6 +19,7 @@ common warnings
         base >=4.7 && <5,
         bytestring ^>= 0.12.1,
         megaparsec ^>= 9.6,
+        optparse-applicative ^>= 0.18.1,
         vector ^>= 0.13.1,
         text ^>= 2.0
     ghc-options: -Wall
@@ -34,7 +35,9 @@ common warnings
 library elna-internal
     import: warnings
     exposed-modules:
+        Language.Elna.Architecture.RiscV
         Language.Elna.AST
+        Language.Elna.CommandLine
         Language.Elna.CodeGenerator
         Language.Elna.Intermediate
         Language.Elna.Location
@@ -56,7 +59,8 @@ executable elna
     import: warnings
     main-is: Main.hs
     build-depends:
-        elna:elna-internal
+        elna:elna-internal,
+        filepath ^>= 1.5.3
     hs-source-dirs: src
 
 test-suite elna-test

lib/Language/Elna/Architecture/RiscV.hs

@@ -0,0 +1,286 @@
+module Language.Elna.Architecture.RiscV
+    ( BaseOpcode(..)
+    , Funct3(..)
+    , Funct7(..)
+    , Funct12(..)
+    , Instruction(..)
+    , Type(..)
+    , XRegister(..)
+    , baseOpcode
+    , funct3
+    , funct12
+    , instruction
+    , xRegister
+    ) where
+
+import qualified Data.ByteString.Builder as ByteString.Builder
+import Data.Bits (Bits(..))
+import Data.Word (Word8, Word32)
+
+data XRegister
+    = Zero
+    | RA
+    | SP
+    | GP
+    | TP
+    | T0
+    | T1
+    | T2
+    | S0
+    | S1
+    | A0
+    | A1
+    | A2
+    | A3
+    | A4
+    | A5
+    | A6
+    | A7
+    | S2
+    | S3
+    | S4
+    | S5
+    | S6
+    | S7
+    | S8
+    | S9
+    | S10
+    | S11
+    | T3
+    | T4
+    | T5
+    | T6
+    deriving Eq
+
+data Funct3
+    = ADDI
+    | SLTI
+    | SLTIU
+    | ANDI
+    | ORI
+    | XORI
+    | SLLI
+    | SRLI
+    | SRAI
+    | ADD
+    | SLT
+    | SLTU
+    | AND
+    | OR
+    | XOR
+    | SLL
+    | SRL
+    | SUB
+    | SRA
+    | BEQ
+    | BNE
+    | BLT
+    | BLTU
+    | BGE
+    | BGEU
+    | FENCE
+    | FENCEI
+    | CSRRW
+    | CSRRS
+    | CSRRC
+    | CSRRWI
+    | CSRRSI
+    | CSRRCI
+    | PRIV
+    | SB
+    | SH
+    | SW
+    | LB
+    | LH
+    | LW
+    | LBU
+    | LHU
+    | JALR
+    | MUL
+    | MULH
+    | MULHSU
+    | MULHU
+    | DIV
+    | DIVU
+    | REM
+    | REMU
+    deriving Eq
+
+data Funct12
+    = ECALL
+    | EBREAK
+    deriving Eq
+
+newtype Funct7 = Funct7
+    { funct7 :: Word8
+    } deriving Eq
+
+data BaseOpcode
+    = OpImm
+    | Lui
+    | Auipc
+    | Op
+    | Jal
+    | Jalr
+    | Branch
+    | Load
+    | Store
+    | MiscMem
+    | System
+    deriving Eq
+
+data Type
+    = I XRegister Funct3 XRegister Word32
+    | S Word32 Funct3 XRegister XRegister
+    | B Word32 Funct3 XRegister XRegister
+    | R XRegister Funct3 XRegister XRegister Funct7
+    | U XRegister Word32
+    | J XRegister Word32
+
+data Instruction = Instruction BaseOpcode Type
+
+xRegister :: XRegister -> Word8
+xRegister Zero = 0
+xRegister RA = 1
+xRegister SP = 2
+xRegister GP = 3
+xRegister TP = 4
+xRegister T0 = 5
+xRegister T1 = 6
+xRegister T2 = 7
+xRegister S0 = 8
+xRegister S1 = 9
+xRegister A0 = 10
+xRegister A1 = 11
+xRegister A2 = 12
+xRegister A3 = 13
+xRegister A4 = 14
+xRegister A5 = 15
+xRegister A6 = 16
+xRegister A7 = 17
+xRegister S2 = 18
+xRegister S3 = 19
+xRegister S4 = 20
+xRegister S5 = 21
+xRegister S6 = 22
+xRegister S7 = 23
+xRegister S8 = 24
+xRegister S9 = 25
+xRegister S10 = 26
+xRegister S11 = 27
+xRegister T3 = 28
+xRegister T4 = 29
+xRegister T5 = 30
+xRegister T6 = 31
+
+funct3 :: Funct3 -> Word8
+funct3 ADDI = 0b000
+funct3 SLTI = 0b001
+funct3 SLTIU = 0b011
+funct3 ANDI = 0b111
+funct3 ORI = 0b110
+funct3 XORI = 0b100
+funct3 SLLI = 0b000
+funct3 SRLI = 0b101
+funct3 SRAI = 0b101
+funct3 ADD = 0b000
+funct3 SLT = 0b010
+funct3 SLTU = 0b011
+funct3 AND = 0b111
+funct3 OR = 0b110
+funct3 XOR = 0b100
+funct3 SLL = 0b001
+funct3 SRL = 0b101
+funct3 SUB = 0b000
+funct3 SRA = 0b101
+funct3 BEQ = 0b000
+funct3 BNE = 0b001
+funct3 BLT = 0b100
+funct3 BLTU = 0b110
+funct3 BGE = 0b101
+funct3 BGEU = 0b111
+funct3 FENCE = 0b000
+funct3 FENCEI = 0b001
+funct3 CSRRW = 0b001
+funct3 CSRRS = 0b010
+funct3 CSRRC = 0b011
+funct3 CSRRWI = 0b101
+funct3 CSRRSI = 0b110
+funct3 CSRRCI = 0b111
+funct3 PRIV = 0b000
+funct3 SB = 0b000
+funct3 SH = 0b001
+funct3 SW = 0b010
+funct3 LB = 0b000
+funct3 LH = 0b001
+funct3 LW = 0b010
+funct3 LBU = 0b100
+funct3 LHU = 0b101
+funct3 JALR = 0b000
+funct3 MUL = 0b000
+funct3 MULH = 0b001
+funct3 MULHSU = 0b010
+funct3 MULHU = 0b011
+funct3 DIV = 0b100
+funct3 DIVU = 0b101
+funct3 REM = 0b110
+funct3 REMU = 0b111
+
+funct12 :: Funct12 -> Word8
+funct12 ECALL = 0b000000000000
+funct12 EBREAK = 0b000000000001
+
+baseOpcode :: BaseOpcode -> Word8
+baseOpcode OpImm = 0b0010011
+baseOpcode Lui = 0b0110111
+baseOpcode Auipc = 0b0010111
+baseOpcode Op = 0b0110011
+baseOpcode Jal = 0b1101111
+baseOpcode Jalr = 0b1100111
+baseOpcode Branch = 0b1100011
+baseOpcode Load = 0b0000011
+baseOpcode Store = 0b0100011
+baseOpcode MiscMem = 0b0001111
+baseOpcode System = 0b1110011
+
+type' :: Type -> Word32
+type' (I rd funct3' rs1 immediate)
+    = (fromIntegral (xRegister rd) `shiftL` 7)
+    .|. (fromIntegral (funct3 funct3') `shiftL` 12)
+    .|. (fromIntegral (xRegister rs1) `shiftL` 15)
+    .|. (immediate `shiftL` 20);
+type' (S immediate funct3' rs1 rs2)
+    = ((immediate .&. 0x1f) `shiftL` 7)
+    .|. (fromIntegral (funct3 funct3') `shiftL` 12)
+    .|. (fromIntegral (xRegister rs1) `shiftL` 15)
+    .|. (fromIntegral (xRegister rs2) `shiftL` 20)
+    .|. ((immediate .&. 0xfe0) `shiftL` 20)
+type' (B immediate funct3' rs1 rs2)
+    = ((immediate .&. 0x800) `shiftR` 4)
+    .|. ((immediate .&. 0x1e) `shiftL` 7)
+    .|. (fromIntegral (funct3 funct3') `shiftL` 12)
+    .|. (fromIntegral (xRegister rs1) `shiftL` 15)
+    .|. (fromIntegral (xRegister rs2) `shiftL` 20)
+    .|. ((immediate .&. 0x7e0) `shiftL` 20)
+    .|. ((immediate .&. 0x1000) `shiftL` 19)
+type' (R rd funct3' rs1 rs2 funct7')
+    = (fromIntegral (xRegister rd) `shiftL` 7)
+    .|. (fromIntegral (funct3 funct3') `shiftL` 12)
+    .|. (fromIntegral (xRegister rs1) `shiftL` 15)
+    .|. (fromIntegral (xRegister rs2) `shiftL` 20)
+    .|. (fromIntegral (funct7 funct7') `shiftL` 25);
+type' (U rd immediate)
+    = (fromIntegral (xRegister rd) `shiftL` 7)
+    .|. (immediate `shiftL` 12)
+type' (J rd immediate)
+     = (fromIntegral (xRegister rd) `shiftL` 7)
+     .|. (immediate .&. 0xff000)
+     .|. ((immediate .&. 0x800) `shiftL` 9)
+     .|. ((immediate .&. 0x7fe) `shiftL` 20)
+     .|. ((immediate .&. 0x100000) `shiftL` 11);
+
+instruction :: Instruction -> ByteString.Builder.Builder
+instruction (Instruction base instructionType)
+    = ByteString.Builder.word32LE
+    $ fromIntegral (baseOpcode base)
+    .|. type' instructionType

lib/Language/Elna/CommandLine.hs

@@ -0,0 +1,44 @@
+module Language.Elna.CommandLine
+    ( CommandLine(..)
+    , commandLine
+    , execParser
+    ) where
+
+import Options.Applicative
+    ( Parser
+    , ParserInfo(..)
+    , argument
+    , execParser
+    , fullDesc
+    , help
+    , helper
+    , info
+    , long
+    , metavar
+    , optional
+    , progDesc
+    , short
+    , str
+    , strOption
+    )
+import Control.Applicative ((<**>))
+
+data CommandLine = CommandLine
+    { input :: FilePath
+    , output :: Maybe FilePath
+    } deriving (Eq, Show)
+
+parser :: Parser CommandLine
+parser = CommandLine
+    <$> argument str inFile
+    <*> optional (strOption outFile)
+  where
+    inFile = metavar "INFILE" <> help "Input file."
+    outFile = long "output"
+        <> short 'o'
+        <> metavar "OUTFILE"
+        <> help "Output file."
+
+commandLine :: ParserInfo CommandLine
+commandLine = info (parser <**> helper)
+    $ fullDesc <> progDesc "Elna compiler."

lib/Language/Elna/Object/Elf.hs

@@ -30,17 +30,23 @@ module Language.Elna.Object.Elf
     , elf32Rel
     , elf32Rela
     , elf32Sym
+    , elfHeaderSize
     , elfIdentification
+    , elfObject
     , rInfo
     , stInfo
     ) where
 
-import Control.Exception (Exception(..))
+import Control.Exception (Exception(..), throwIO)
 import Data.Bits (Bits(..))
 import qualified Data.ByteString.Builder as ByteString.Builder
 import Data.Int (Int32)
 import Data.Word (Word8, Word16, Word32)
 import qualified Data.ByteString as ByteString
+import Data.Vector (Vector)
+import qualified Data.Vector as Vector
+import System.IO (Handle, IOMode(..), SeekMode(..), hSeek, withFile)
+import Data.Foldable (traverse_)
 
 -- * Data types.
 
@@ -345,27 +351,6 @@ instance Enum ElfSectionType
     fromEnum SHT_HIUSER = 0xffffffff
     fromEnum (ElfSectionType x) = fromIntegral x
 
--- * Help types and functions.
-
-data ByteOrder = LSB | MSB
-    deriving Eq
-
-data ElfEncodingError
-    = ElfInvalidByteOrderError
-    | ElfUnsupportedClassError ElfClass
-    deriving Eq
-
-instance Show ElfEncodingError
-  where
-    show ElfInvalidByteOrderError = "Invalid byte order."
-    show (ElfUnsupportedClassError class') =
-        concat ["Elf class \"", show class', "\" is not supported."]
-
-instance Exception ElfEncodingError
-
-fromIntegralEnum :: (Enum a, Num b) => a -> b
-fromIntegralEnum = fromIntegral . fromEnum
-
 -- * Encoding functions.
 
 elf32Addr :: ByteOrder -> Elf32_Addr -> ByteString.Builder.Builder
@@ -462,3 +447,47 @@ stInfo binding type' = fromIntegralEnum binding `shiftL` 4
 rInfo :: Elf32_Word -> Word8 -> Elf32_Word
 rInfo symbol type' = symbol `shiftL` 8
     .|. fromIntegralEnum type'
+
+-- * Help types and functions.
+
+data ByteOrder = LSB | MSB
+    deriving Eq
+
+data ElfEncodingError
+    = ElfInvalidByteOrderError
+    | ElfUnsupportedClassError ElfClass
+    deriving Eq
+
+instance Show ElfEncodingError
+  where
+    show ElfInvalidByteOrderError = "Invalid byte order."
+    show (ElfUnsupportedClassError class') =
+        concat ["Elf class \"", show class', "\" is not supported."]
+
+instance Exception ElfEncodingError
+
+fromIntegralEnum :: (Enum a, Num b) => a -> b
+fromIntegralEnum = fromIntegral . fromEnum
+
+elfHeaderSize :: Elf32_Off
+elfHeaderSize = 52
+
+-- Writes an ELF object with the given header to the provided file path.
+-- The callback writes the sections and returns headers for those sections.
+elfObject :: FilePath -> Elf32_Ehdr -> (Handle -> IO (Vector Elf32_Shdr)) -> IO ()
+elfObject outFile header putContents = withFile outFile WriteMode withObjectFile
+  where
+    withObjectFile objectHandle
+        = hSeek objectHandle AbsoluteSeek (fromIntegral elfHeaderSize)
+        >> putContents objectHandle
+        >>= afterContents objectHandle
+    afterContents objectHandle headers =
+        let headerEncodingResult = elf32Ehdr
+                $ header
+                    { e_shoff = elfHeaderSize + 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

src/Main.hs

@@ -2,10 +2,9 @@ module Main
     ( main
     ) where
 
+import Language.Elna.CommandLine (CommandLine(..), commandLine, execParser)
 import Language.Elna.Object.Elf
-    ( ByteOrder(..)
+    ( Elf32_Ehdr(..)
-    , Elf32_Ehdr(..)
-    , Elf32_Off
     , ElfMachine(..)
     , ElfType(..)
     , ElfVersion(..)
@@ -14,82 +13,68 @@ import Language.Elna.Object.Elf
     , ElfData(..)
     , Elf32_Shdr(..)
     , ElfSectionType(..)
-    , elf32Ehdr
+    , elfHeaderSize
-    , elf32Shdr
+    , elfObject
     )
 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 Data.Maybe (fromMaybe)
-import System.IO (Handle, IOMode(..), SeekMode(..), hSeek, withFile)
+import System.IO (Handle)
-import Data.Foldable (traverse_)
+import System.FilePath (replaceExtension, takeFileName)
 
-riscv32Elf :: FilePath -> IO ()
+riscv32Elf :: Handle -> IO (Vector Elf32_Shdr)
-riscv32Elf outFile = withFile outFile WriteMode withObjectFile
+riscv32Elf objectHandle =
-  where
+    let stringTable = "\0shstrtab\0"
-    headerSize :: Elf32_Off
+        written = Vector.fromList
-    headerSize = 52
+            [ Elf32_Shdr
-    withObjectFile objectHandle
+                { sh_type = SHT_NULL
-        = hSeek objectHandle AbsoluteSeek (fromIntegral headerSize)
+                , sh_size = 0
-        >> putContents objectHandle
+                , sh_offset = 0
-        >>= afterContents objectHandle
+                , sh_name = 0
-    afterContents objectHandle headers =
+                , sh_link = 0
-        let headerEncodingResult = elf32Ehdr
+                , sh_info = 0
-                $ header
+                , sh_flags = 0
-                $ Vector.foldr ((+) . sh_size) 0 headers
+                , sh_entsize = 0
-         in traverse_ (ByteString.Builder.hPutBuilder objectHandle . elf32Shdr LSB) headers
+                , sh_addralign = 0
-            >> either throwIO (putHeaders objectHandle) headerEncodingResult
+                , sh_addr = 0
-    putHeaders objectHandle encodedHeader
+                }
-        = hSeek objectHandle AbsoluteSeek 0
+            , Elf32_Shdr
-        >> ByteString.Builder.hPutBuilder objectHandle encodedHeader
+                { sh_type = SHT_STRTAB
-    putContents :: Handle -> IO (Vector Elf32_Shdr)
+                , sh_size = fromIntegral $ ByteString.length stringTable
-    putContents objectHandle =
+                , sh_offset = fromIntegral elfHeaderSize
-        let stringTable = "\0shstrtab\0"
+                , sh_name = 1
-            written = Vector.fromList
+                , sh_link = 0
-                [ Elf32_Shdr
+                , sh_info = 0
-                    { sh_type = SHT_NULL
+                , sh_flags = 0
-                    , sh_size = 0
+                , sh_entsize = 0
-                    , sh_offset = 0
+                , sh_addralign = 0
-                    , sh_name = 0
+                , sh_addr = 0
-                    , sh_link = 0
+                }
-                    , sh_info = 0
+            ]
-                    , sh_flags = 0
+        in ByteString.hPut objectHandle stringTable >> pure written
-                    , sh_entsize = 0
+
-                    , sh_addralign = 0
+riscv32Header :: Elf32_Ehdr
-                    , sh_addr = 0
+riscv32Header = Elf32_Ehdr
-                    }
+    { e_version = EV_CURRENT
-                , Elf32_Shdr
+    , e_type = ET_REL
-                    { sh_type = SHT_STRTAB
+    , e_shstrndx = 1 -- String table. SHN_UNDEF
-                    , sh_size = fromIntegral $ ByteString.length stringTable
+    , e_shoff = 0
-                    , sh_offset = fromIntegral headerSize
+    , e_shnum = 2
-                    , sh_name = 1
+    , e_shentsize = 40
-                    , sh_link = 0
+    , e_phoff = 0
-                    , sh_info = 0
+    , e_phnum = 0
-                    , sh_flags = 0
+    , e_phentsize = 32
-                    , sh_entsize = 0
+    , e_machine = EM_RISCV
-                    , sh_addralign = 0
+    , e_ident = ElfIdentification ELFCLASS32 ELFDATA2LSB
-                    , sh_addr = 0
+    , e_flags = 0x4 -- EF_RISCV_FLOAT_ABI_DOUBLE
-                    }
+    , e_entry = 0
-                ]
+    , e_ehsize = fromIntegral elfHeaderSize
-         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"
+main  = execParser commandLine >>= withCommandLine
+  where
+    withCommandLine CommandLine{..} =
+        let defaultOutput = replaceExtension (takeFileName input) "o"
+         in elfObject (fromMaybe defaultOutput output) riscv32Header riscv32Elf