Add call pseudo instruction
This commit is contained in:
@ -1,25 +1,56 @@
|
||||
module Language.Elna.AST
|
||||
( Program(..)
|
||||
( Declaration(..)
|
||||
, Identifier(..)
|
||||
, Parameter(..)
|
||||
, Program(..)
|
||||
, Statement(..)
|
||||
, TypeExpression(..)
|
||||
, VariableDeclaration(..)
|
||||
{-, VariableAccess(..)
|
||||
, Condition(..)
|
||||
, Declaration(..)
|
||||
, Expression(..)
|
||||
, Identifier(..)
|
||||
, Literal(..)
|
||||
, Parameter(..)
|
||||
, Statement(..)
|
||||
, VariableDeclaration(..)
|
||||
, TypeExpression(..)-}
|
||||
, Literal(..)-}
|
||||
) where
|
||||
|
||||
data Program = Program
|
||||
{-
|
||||
import Data.Int (Int32)
|
||||
import Data.List (intercalate)
|
||||
import Data.Word (Word16, Word32)
|
||||
import Data.Char (chr)
|
||||
import Data.Word ({-Word16, -}Word32)
|
||||
import Language.Elna.Location (Identifier(..), showArrayType)
|
||||
import Numeric (showHex)
|
||||
|
||||
newtype Program = Program [Declaration]
|
||||
deriving Eq
|
||||
|
||||
instance Show Program
|
||||
where
|
||||
show (Program declarations) = unlines (show <$> declarations)
|
||||
|
||||
data Declaration
|
||||
= ProcedureDeclaration Identifier [Parameter] [VariableDeclaration] [Statement]
|
||||
-- | TypeDefinition Identifier TypeExpression
|
||||
deriving Eq
|
||||
|
||||
instance Show Declaration
|
||||
where
|
||||
{- show (TypeDefinition identifier typeExpression) =
|
||||
concat ["type ", show identifier, " = ", show typeExpression, ";"] -}
|
||||
show (ProcedureDeclaration procedureName parameters variables body)
|
||||
= "proc " <> show procedureName <> showParameters parameters <> " {\n"
|
||||
<> unlines ((" " <>) . show <$> variables)
|
||||
<> unlines ((" " <>) . show <$> body)
|
||||
<> "}"
|
||||
|
||||
data Parameter = Parameter Identifier TypeExpression Bool
|
||||
deriving Eq
|
||||
|
||||
instance Show Parameter
|
||||
where
|
||||
show (Parameter identifier typeName ref) = concat
|
||||
[ if ref then "ref " else ""
|
||||
, show identifier, ": ", show typeName
|
||||
]
|
||||
|
||||
showParameters :: [Parameter] -> String
|
||||
showParameters parameters =
|
||||
"(" <> intercalate ", " (show <$> parameters) <> ")"
|
||||
|
||||
data TypeExpression
|
||||
= NamedType Identifier
|
||||
@ -31,6 +62,45 @@ instance Show TypeExpression
|
||||
show (NamedType typeName) = show typeName
|
||||
show (ArrayType elementCount typeName) = showArrayType elementCount typeName
|
||||
|
||||
data Statement
|
||||
= EmptyStatement
|
||||
{-| AssignmentStatement VariableAccess Expression
|
||||
| IfStatement Condition Statement (Maybe Statement)
|
||||
| WhileStatement Condition Statement
|
||||
| CompoundStatement [Statement]
|
||||
| CallStatement Identifier [Expression]-}
|
||||
deriving Eq
|
||||
|
||||
instance Show Statement
|
||||
where
|
||||
show EmptyStatement = ";"
|
||||
{-show (AssignmentStatement lhs rhs) =
|
||||
concat [show lhs, " := ", show rhs, ";"]
|
||||
show (IfStatement condition if' else') = concat
|
||||
[ "if (", show condition, ") "
|
||||
, show if'
|
||||
, maybe "" ((<> " else ") . show) else'
|
||||
]
|
||||
show (WhileStatement expression statement) =
|
||||
concat ["while (", show expression, ") ", show statement, ";"]
|
||||
show (CompoundStatement statements) =
|
||||
concat ["{\n", unlines (show <$> statements), " }"]
|
||||
show (CallStatement name parameters) = show name <> "("
|
||||
<> intercalate ", " (show <$> parameters) <> ")"-}
|
||||
|
||||
data VariableDeclaration =
|
||||
VariableDeclaration Identifier TypeExpression
|
||||
deriving Eq
|
||||
|
||||
instance Show VariableDeclaration
|
||||
where
|
||||
show (VariableDeclaration identifier typeExpression) =
|
||||
concat ["var ", show identifier, ": " <> show typeExpression, ";"]
|
||||
{-
|
||||
import Data.Int (Int32)
|
||||
import Data.Char (chr)
|
||||
import Numeric (showHex)
|
||||
|
||||
data Literal
|
||||
= IntegerLiteral Int32
|
||||
| HexadecimalLiteral Int32
|
||||
@ -96,75 +166,4 @@ instance Show Condition
|
||||
show (GreaterCondition lhs rhs) = concat [show lhs, " > ", show rhs]
|
||||
show (LessOrEqualCondition lhs rhs) = concat [show lhs, " <= ", show rhs]
|
||||
show (GreaterOrEqualCondition lhs rhs) = concat [show lhs, " >= ", show rhs]
|
||||
|
||||
data Statement
|
||||
= EmptyStatement
|
||||
| AssignmentStatement VariableAccess Expression
|
||||
| IfStatement Condition Statement (Maybe Statement)
|
||||
| WhileStatement Condition Statement
|
||||
| CompoundStatement [Statement]
|
||||
| CallStatement Identifier [Expression]
|
||||
deriving Eq
|
||||
|
||||
instance Show Statement
|
||||
where
|
||||
show EmptyStatement = ";"
|
||||
show (AssignmentStatement lhs rhs) =
|
||||
concat [show lhs, " := ", show rhs, ";"]
|
||||
show (IfStatement condition if' else') = concat
|
||||
[ "if (", show condition, ") "
|
||||
, show if'
|
||||
, maybe "" ((<> " else ") . show) else'
|
||||
]
|
||||
show (WhileStatement expression statement) =
|
||||
concat ["while (", show expression, ") ", show statement, ";"]
|
||||
show (CompoundStatement statements) =
|
||||
concat ["{\n", unlines (show <$> statements), " }"]
|
||||
show (CallStatement name parameters) = show name <> "("
|
||||
<> intercalate ", " (show <$> parameters) <> ")"
|
||||
|
||||
data Parameter = Parameter Identifier TypeExpression Bool
|
||||
deriving Eq
|
||||
|
||||
instance Show Parameter
|
||||
where
|
||||
show (Parameter identifier typeName ref) = concat
|
||||
[ if ref then "ref " else ""
|
||||
, show identifier, ": ", show typeName
|
||||
]
|
||||
|
||||
data VariableDeclaration =
|
||||
VariableDeclaration Identifier TypeExpression
|
||||
deriving Eq
|
||||
|
||||
instance Show VariableDeclaration
|
||||
where
|
||||
show (VariableDeclaration identifier typeExpression) =
|
||||
concat ["var ", show identifier, ": " <> show typeExpression, ";"]
|
||||
|
||||
data Declaration
|
||||
= TypeDefinition Identifier TypeExpression
|
||||
| ProcedureDefinition Identifier [Parameter] [VariableDeclaration] [Statement]
|
||||
deriving Eq
|
||||
|
||||
instance Show Declaration
|
||||
where
|
||||
show (TypeDefinition identifier typeExpression) =
|
||||
concat ["type ", show identifier, " = ", show typeExpression, ";"]
|
||||
show (ProcedureDefinition procedureName parameters variables body)
|
||||
= "proc " <> show procedureName <> showParameters parameters <> " {\n"
|
||||
<> unlines ((" " <>) . show <$> variables)
|
||||
<> unlines ((" " <>) . show <$> body)
|
||||
<> "}"
|
||||
|
||||
newtype Program = Program [Declaration]
|
||||
deriving Eq
|
||||
|
||||
instance Show Program
|
||||
where
|
||||
show (Program declarations) = unlines (show <$> declarations)
|
||||
|
||||
showParameters :: [Parameter] -> String
|
||||
showParameters parameters =
|
||||
"(" <> intercalate ", " (show <$> parameters) <> ")"
|
||||
-}
|
||||
|
||||
@ -150,6 +150,7 @@ data RelocationType
|
||||
data Instruction
|
||||
= Instruction BaseOpcode Type
|
||||
| RelocatableInstruction BaseOpcode RelocationType
|
||||
| CallInstruction Text
|
||||
deriving Eq
|
||||
|
||||
xRegister :: XRegister -> Word8
|
||||
@ -306,6 +307,10 @@ instruction :: Instruction -> ByteString.Builder.Builder
|
||||
instruction = \case
|
||||
(Instruction base instructionType) -> go base $ type' instructionType
|
||||
(RelocatableInstruction base instructionType) -> go base $ relocationType instructionType
|
||||
(CallInstruction _) -> foldMap instruction
|
||||
[ Instruction Auipc $ U RA 0
|
||||
, Instruction Jalr $ I RA JALR RA 0
|
||||
]
|
||||
where
|
||||
go base instructionType
|
||||
= ByteString.Builder.word32LE
|
||||
|
||||
@ -10,7 +10,8 @@ import Language.Elna.SymbolTable (SymbolTable)
|
||||
|
||||
generateCode :: SymbolTable -> Vector Quadruple -> Vector RiscV.Instruction
|
||||
generateCode _ _ = Vector.fromList
|
||||
[ RiscV.Instruction RiscV.OpImm $ RiscV.I RiscV.A0 RiscV.ADDI RiscV.Zero 0
|
||||
[ RiscV.CallInstruction "printi"
|
||||
, RiscV.Instruction RiscV.OpImm $ RiscV.I RiscV.A0 RiscV.ADDI RiscV.Zero 0
|
||||
, RiscV.Instruction RiscV.OpImm $ RiscV.I RiscV.A7 RiscV.ADDI RiscV.Zero 93
|
||||
, RiscV.Instruction RiscV.System $ RiscV.Type RiscV.Zero RiscV.PRIV RiscV.Zero RiscV.ECALL
|
||||
]
|
||||
|
||||
@ -3,89 +3,48 @@ module Language.Elna.Parser
|
||||
, programP
|
||||
) where
|
||||
|
||||
-- import Control.Monad (void)
|
||||
import Control.Monad (void)
|
||||
-- import Control.Monad.Combinators.Expr (Operator(..), makeExprParser)
|
||||
import Data.Text (Text)
|
||||
-- import qualified Data.Text as Text
|
||||
import qualified Data.Text as Text
|
||||
import Data.Void (Void)
|
||||
import Language.Elna.AST
|
||||
( Program(..)
|
||||
{-, VariableAccess(..)
|
||||
, Condition(..)
|
||||
, Declaration(..)
|
||||
, Expression(..)
|
||||
( Declaration(..)
|
||||
, Identifier(..)
|
||||
, Literal(..)
|
||||
, Parameter(..)
|
||||
, Program(..)
|
||||
, Statement(..)
|
||||
, TypeExpression(..)
|
||||
, VariableDeclaration(..)-}
|
||||
, VariableDeclaration(..)
|
||||
{-, VariableAccess(..)
|
||||
, Condition(..)
|
||||
, Expression(..)
|
||||
, Literal(..)-}
|
||||
)
|
||||
import Text.Megaparsec
|
||||
( Parsec
|
||||
{-, MonadParsec(..)
|
||||
, (<?>)
|
||||
--, MonadParsec(..)
|
||||
, eof
|
||||
, optional
|
||||
, between
|
||||
, sepBy
|
||||
, choice -}
|
||||
)
|
||||
{- import Text.Megaparsec.Char
|
||||
( alphaNumChar
|
||||
, char
|
||||
, letterChar
|
||||
, space1
|
||||
, string
|
||||
--, choice
|
||||
)
|
||||
import qualified Text.Megaparsec.Char.Lexer as Lexer
|
||||
import Text.Megaparsec.Char
|
||||
( alphaNumChar
|
||||
-- , char
|
||||
, letterChar
|
||||
, space1
|
||||
-- , string
|
||||
)
|
||||
import Control.Applicative (Alternative(..))
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Functor (($>))
|
||||
-}
|
||||
-- import Data.Functor (($>))
|
||||
|
||||
type Parser = Parsec Void Text
|
||||
{-
|
||||
space :: Parser ()
|
||||
space = Lexer.space space1 (Lexer.skipLineComment "//")
|
||||
$ Lexer.skipBlockComment "/*" "*/"
|
||||
|
||||
lexeme :: forall a. Parser a -> Parser a
|
||||
lexeme = Lexer.lexeme space
|
||||
|
||||
symbol :: Text -> Parser Text
|
||||
symbol = Lexer.symbol space
|
||||
|
||||
blockP :: forall a. Parser a -> Parser a
|
||||
blockP = between (symbol "{") (symbol "}")
|
||||
|
||||
procedureP :: Parser ()
|
||||
procedureP = void $ symbol "proc"
|
||||
|
||||
parensP :: forall a. Parser a -> Parser a
|
||||
parensP = between (symbol "(") (symbol ")")
|
||||
|
||||
bracketsP :: forall a. Parser a -> Parser a
|
||||
bracketsP = between (symbol "[") (symbol "]")
|
||||
|
||||
colonP :: Parser ()
|
||||
colonP = void $ symbol ":"
|
||||
|
||||
semicolonP :: Parser ()
|
||||
semicolonP = void $ symbol ";"
|
||||
|
||||
identifierP :: Parser Identifier
|
||||
identifierP =
|
||||
let wordParser = (:) <$> letterChar <*> many alphaNumChar <?> "identifier"
|
||||
in fmap Identifier $ lexeme $ Text.pack <$> wordParser
|
||||
|
||||
typeExpressionP :: Parser TypeExpression
|
||||
typeExpressionP = arrayTypeExpression
|
||||
<|> NamedType <$> identifierP
|
||||
<?> "type expression"
|
||||
where
|
||||
arrayTypeExpression = ArrayType
|
||||
<$> (symbol "array" *> bracketsP (lexeme Lexer.decimal))
|
||||
<*> (symbol "of" *> typeExpressionP)
|
||||
|
||||
typeDefinitionP :: Parser Declaration
|
||||
typeDefinitionP = TypeDefinition
|
||||
<$> (symbol "type" *> identifierP)
|
||||
@ -93,24 +52,6 @@ typeDefinitionP = TypeDefinition
|
||||
<* semicolonP
|
||||
<?> "type definition"
|
||||
|
||||
variableDeclarationP :: Parser VariableDeclaration
|
||||
variableDeclarationP = VariableDeclaration
|
||||
<$> (symbol "var" *> identifierP)
|
||||
<*> (colonP *> typeExpressionP)
|
||||
<* semicolonP
|
||||
<?> "variable declaration"
|
||||
|
||||
parameterP :: Parser Parameter
|
||||
parameterP = paramCons
|
||||
<$> optional (symbol "ref")
|
||||
<*> identifierP
|
||||
<*> (colonP *> typeExpressionP)
|
||||
where
|
||||
paramCons ref name typeName = Parameter name typeName (isJust ref)
|
||||
|
||||
commaP :: Parser ()
|
||||
commaP = void $ symbol ","
|
||||
|
||||
literalP :: Parser Literal
|
||||
literalP
|
||||
= HexadecimalLiteral <$> (string "0x" *> lexeme Lexer.hexadecimal)
|
||||
@ -174,17 +115,80 @@ conditionP = do
|
||||
, symbol "=" >> pure EqualCondition
|
||||
, symbol "#" >> pure NonEqualCondition
|
||||
]
|
||||
-}
|
||||
symbol :: Text -> Parser Text
|
||||
symbol = Lexer.symbol space
|
||||
|
||||
space :: Parser ()
|
||||
space = Lexer.space space1 (Lexer.skipLineComment "//")
|
||||
$ Lexer.skipBlockComment "/*" "*/"
|
||||
|
||||
lexeme :: forall a. Parser a -> Parser a
|
||||
lexeme = Lexer.lexeme space
|
||||
|
||||
blockP :: forall a. Parser a -> Parser a
|
||||
blockP = between (symbol "{") (symbol "}")
|
||||
|
||||
parensP :: forall a. Parser a -> Parser a
|
||||
parensP = between (symbol "(") (symbol ")")
|
||||
|
||||
bracketsP :: forall a. Parser a -> Parser a
|
||||
bracketsP = between (symbol "[") (symbol "]")
|
||||
|
||||
colonP :: Parser ()
|
||||
colonP = void $ symbol ":"
|
||||
|
||||
commaP :: Parser ()
|
||||
commaP = void $ symbol ","
|
||||
|
||||
semicolonP :: Parser ()
|
||||
semicolonP = void $ symbol ";"
|
||||
|
||||
identifierP :: Parser Identifier
|
||||
identifierP =
|
||||
let wordParser = (:) <$> letterChar <*> many alphaNumChar <?> "identifier"
|
||||
in fmap Identifier $ lexeme $ Text.pack <$> wordParser
|
||||
|
||||
procedureP :: Parser ()
|
||||
procedureP = void $ symbol "proc"
|
||||
|
||||
parameterP :: Parser Parameter
|
||||
parameterP = paramCons
|
||||
<$> optional (symbol "ref")
|
||||
<*> identifierP
|
||||
<*> (colonP *> typeExpressionP)
|
||||
where
|
||||
paramCons ref name typeName = Parameter name typeName (isJust ref)
|
||||
|
||||
typeExpressionP :: Parser TypeExpression
|
||||
typeExpressionP = arrayTypeExpression
|
||||
<|> NamedType <$> identifierP
|
||||
<?> "type expression"
|
||||
where
|
||||
arrayTypeExpression = ArrayType
|
||||
<$> (symbol "array" *> bracketsP (lexeme Lexer.decimal))
|
||||
<*> (symbol "of" *> typeExpressionP)
|
||||
|
||||
procedureDeclarationP :: Parser Declaration
|
||||
procedureDeclarationP = procedureCons
|
||||
<$> (procedureP *> identifierP)
|
||||
<*> parensP (sepBy parameterP commaP)
|
||||
<*> blockP ((,) <$> many variableDeclarationP <*> many statementP)
|
||||
<?> "procedure definition"
|
||||
where
|
||||
procedureCons procedureName parameters (variables, body) =
|
||||
ProcedureDeclaration procedureName parameters variables body
|
||||
|
||||
statementP :: Parser Statement
|
||||
statementP
|
||||
= EmptyStatement <$ semicolonP
|
||||
<|> CompoundStatement <$> blockP (many statementP)
|
||||
{-<|> CompoundStatement <$> blockP (many statementP)
|
||||
<|> try assignmentP
|
||||
<|> try ifElseP
|
||||
<|> try whileP
|
||||
<|> try callP
|
||||
<|> try callP -}
|
||||
<?> "statement"
|
||||
where
|
||||
{-where
|
||||
ifElseP = IfStatement
|
||||
<$> (symbol "if" *> parensP conditionP)
|
||||
<*> statementP
|
||||
@ -201,19 +205,16 @@ statementP
|
||||
<* symbol ":="
|
||||
<*> expressionP
|
||||
<* semicolonP
|
||||
|
||||
procedureDefinitionP :: Parser Declaration
|
||||
procedureDefinitionP = procedureCons
|
||||
<$> (procedureP *> identifierP)
|
||||
<*> parensP (sepBy parameterP commaP)
|
||||
<*> blockP ((,) <$> many variableDeclarationP <*> many statementP)
|
||||
<?> "procedure definition"
|
||||
where
|
||||
procedureCons procedureName parameters (variables, body) =
|
||||
ProcedureDefinition procedureName parameters variables body
|
||||
-}
|
||||
variableDeclarationP :: Parser VariableDeclaration
|
||||
variableDeclarationP = VariableDeclaration
|
||||
<$> (symbol "var" *> identifierP)
|
||||
<*> (colonP *> typeExpressionP)
|
||||
<* semicolonP
|
||||
<?> "variable declaration"
|
||||
|
||||
declarationP :: Parser Declaration
|
||||
declarationP = typeDefinitionP <|> procedureDefinitionP
|
||||
-}
|
||||
declarationP = procedureDeclarationP -- <|> typeDefinitionP
|
||||
|
||||
programP :: Parser Program
|
||||
programP = pure Program -- <$> many declarationP
|
||||
programP = Program <$> many declarationP <* eof
|
||||
|
||||
@ -211,9 +211,17 @@ riscv32Elf code objectHandle = text
|
||||
, st_name = fromIntegral $ ByteString.length names
|
||||
, st_info = stInfo STB_GLOBAL STT_FUNC
|
||||
}
|
||||
printEntry = Elf32_Sym
|
||||
{ st_value = 0
|
||||
, st_size = 0
|
||||
, st_shndx = 0
|
||||
, st_other = 0
|
||||
, st_name = fromIntegral (ByteString.length names) + 7
|
||||
, st_info = stInfo STB_GLOBAL STT_FUNC
|
||||
}
|
||||
liftIO $ ByteString.hPut objectHandle $ LazyByteString.toStrict encoded
|
||||
let newResult = ElfHeaderResult (names <> "_start\0")
|
||||
$ Vector.snoc entries newEntry
|
||||
let newResult = ElfHeaderResult (names <> "_start\0printi\0")
|
||||
$ Vector.snoc (Vector.snoc entries newEntry) printEntry
|
||||
pure (newResult, size, updatedRelocations)
|
||||
encodeInstruction (instructions, offset, relocations) instruction =
|
||||
let unresolvedRelocation = case instruction of
|
||||
@ -227,6 +235,9 @@ riscv32Elf code objectHandle = text
|
||||
| RiscV.Lower12S symbolName _ _ _ <- instructionType
|
||||
-> Just -- R_RISCV_LO12_S
|
||||
$ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 28
|
||||
RiscV.CallInstruction symbolName
|
||||
-> Just -- R_RISCV_CALL_PLT
|
||||
$ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 19
|
||||
RiscV.Instruction _ _ -> Nothing
|
||||
encoded = ByteString.Builder.toLazyByteString
|
||||
$ RiscV.instruction instruction
|
||||
|
||||
Reference in New Issue
Block a user