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

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

View File

@ -2,10 +2,9 @@ module Main
( main
) where
import Language.Elna.CommandLine (CommandLine(..), commandLine, execParser)
import Language.Elna.Object.Elf
( ByteOrder(..)
, Elf32_Ehdr(..)
, Elf32_Off
( Elf32_Ehdr(..)
, ElfMachine(..)
, ElfType(..)
, ElfVersion(..)
@ -14,82 +13,68 @@ import Language.Elna.Object.Elf
, ElfData(..)
, Elf32_Shdr(..)
, ElfSectionType(..)
, elf32Ehdr
, elf32Shdr
, elfHeaderSize
, 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 System.IO (Handle, IOMode(..), SeekMode(..), hSeek, withFile)
import Data.Foldable (traverse_)
import Data.Maybe (fromMaybe)
import System.IO (Handle)
import System.FilePath (replaceExtension, takeFileName)
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
}
riscv32Elf :: Handle -> IO (Vector Elf32_Shdr)
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 = riscv32Elf "here.o"
main = execParser commandLine >>= withCommandLine
where
withCommandLine CommandLine{..} =
let defaultOutput = replaceExtension (takeFileName input) "o"
in elfObject (fromMaybe defaultOutput output) riscv32Header riscv32Elf