Add command line parser
This commit is contained in:
parent
be73032b93
commit
042e4e8714
GPG Key ID:
A27FDC1E8EE902C0
@ -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
|
||||
|
||||
286
lib/Language/Elna/Architecture/RiscV.hs
Normal file
286
lib/Language/Elna/Architecture/RiscV.hs
Normal 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
|
||||
44
lib/Language/Elna/CommandLine.hs
Normal file
44
lib/Language/Elna/CommandLine.hs
Normal 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."
|
||||
@ -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
|
||||
|
||||
57
src/Main.hs
57
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_Off
|
||||
( Elf32_Ehdr(..)
|
||||
, ElfMachine(..)
|
||||
, ElfType(..)
|
||||
, ElfVersion(..)
|
||||
@ -14,37 +13,18 @@ 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 =
|
||||
riscv32Elf :: Handle -> IO (Vector Elf32_Shdr)
|
||||
riscv32Elf objectHandle =
|
||||
let stringTable = "\0shstrtab\0"
|
||||
written = Vector.fromList
|
||||
[ Elf32_Shdr
|
||||
@ -62,7 +42,7 @@ riscv32Elf outFile = withFile outFile WriteMode withObjectFile
|
||||
, Elf32_Shdr
|
||||
{ sh_type = SHT_STRTAB
|
||||
, sh_size = fromIntegral $ ByteString.length stringTable
|
||||
, sh_offset = fromIntegral headerSize
|
||||
, sh_offset = fromIntegral elfHeaderSize
|
||||
, sh_name = 1
|
||||
, sh_link = 0
|
||||
, sh_info = 0
|
||||
@ -72,13 +52,14 @@ riscv32Elf outFile = withFile outFile WriteMode withObjectFile
|
||||
, sh_addr = 0
|
||||
}
|
||||
]
|
||||
in ByteString.hPut objectHandle stringTable
|
||||
>> pure written
|
||||
header written = Elf32_Ehdr
|
||||
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 = written + headerSize
|
||||
, e_shoff = 0
|
||||
, e_shnum = 2
|
||||
, e_shentsize = 40
|
||||
, e_phoff = 0
|
||||
@ -88,8 +69,12 @@ riscv32Elf outFile = withFile outFile WriteMode withObjectFile
|
||||
, e_ident = ElfIdentification ELFCLASS32 ELFDATA2LSB
|
||||
, e_flags = 0x4 -- EF_RISCV_FLOAT_ABI_DOUBLE
|
||||
, e_entry = 0
|
||||
, e_ehsize = fromIntegral headerSize
|
||||
, 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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user