diff options
| -rw-r--r-- | elna.cabal | 6 | ||||
| -rw-r--r-- | lib/Language/Elna/Architecture/RiscV.hs | 286 | ||||
| -rw-r--r-- | lib/Language/Elna/CommandLine.hs | 44 | ||||
| -rw-r--r-- | lib/Language/Elna/Object/Elf.hs | 73 | ||||
| -rw-r--r-- | src/Main.hs | 135 |
5 files changed, 446 insertions, 98 deletions
@@ -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 diff --git a/lib/Language/Elna/Architecture/RiscV.hs b/lib/Language/Elna/Architecture/RiscV.hs new file mode 100644 index 0000000..5d8c247 --- /dev/null +++ b/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 diff --git a/lib/Language/Elna/CommandLine.hs b/lib/Language/Elna/CommandLine.hs new file mode 100644 index 0000000..b23be7d --- /dev/null +++ b/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." diff --git a/lib/Language/Elna/Object/Elf.hs b/lib/Language/Elna/Object/Elf.hs index 1a4bcc8..4328f56 100644 --- a/lib/Language/Elna/Object/Elf.hs +++ b/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 diff --git a/src/Main.hs b/src/Main.hs index 4004d5c..4d5e406 100644 --- a/src/Main.hs +++ b/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,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 |