Add command line parser

This commit is contained in:
Eugen Wissner 2024-09-05 23:18:48 +02:00
parent be73032b93
commit 042e4e8714
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
5 changed files with 446 additions and 98 deletions

View File

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

View File

@ -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

View File

@ -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."

View File

@ -30,17 +30,23 @@ module Language.Elna.Object.Elf
, elf32Rel , elf32Rel
, elf32Rela , elf32Rela
, elf32Sym , elf32Sym
, elfHeaderSize
, elfIdentification , elfIdentification
, elfObject
, rInfo , rInfo
, stInfo , stInfo
) where ) where
import Control.Exception (Exception(..)) import Control.Exception (Exception(..), throwIO)
import Data.Bits (Bits(..)) import Data.Bits (Bits(..))
import qualified Data.ByteString.Builder as ByteString.Builder import qualified Data.ByteString.Builder as ByteString.Builder
import Data.Int (Int32) import Data.Int (Int32)
import Data.Word (Word8, Word16, Word32) import Data.Word (Word8, Word16, Word32)
import qualified Data.ByteString as ByteString 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. -- * Data types.
@ -345,27 +351,6 @@ instance Enum ElfSectionType
fromEnum SHT_HIUSER = 0xffffffff fromEnum SHT_HIUSER = 0xffffffff
fromEnum (ElfSectionType x) = fromIntegral x 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. -- * Encoding functions.
elf32Addr :: ByteOrder -> Elf32_Addr -> ByteString.Builder.Builder 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 :: Elf32_Word -> Word8 -> Elf32_Word
rInfo symbol type' = symbol `shiftL` 8 rInfo symbol type' = symbol `shiftL` 8
.|. fromIntegralEnum type' .|. 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

View File

@ -2,10 +2,9 @@ module Main
( main ( main
) where ) where
import Language.Elna.CommandLine (CommandLine(..), commandLine, execParser)
import Language.Elna.Object.Elf import Language.Elna.Object.Elf
( ByteOrder(..) ( Elf32_Ehdr(..)
, Elf32_Ehdr(..)
, Elf32_Off
, ElfMachine(..) , ElfMachine(..)
, ElfType(..) , ElfType(..)
, ElfVersion(..) , ElfVersion(..)
@ -14,82 +13,68 @@ import Language.Elna.Object.Elf
, ElfData(..) , ElfData(..)
, Elf32_Shdr(..) , Elf32_Shdr(..)
, ElfSectionType(..) , ElfSectionType(..)
, elf32Ehdr , elfHeaderSize
, elf32Shdr , elfObject
) )
import qualified Data.ByteString as ByteString import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Builder as ByteString.Builder
import Data.Vector (Vector) import Data.Vector (Vector)
import qualified Data.Vector as 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 :: 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