From 176b98d659e82577f8041300c60019e57ed0257c Mon Sep 17 00:00:00 2001 From: mrab Date: Tue, 7 May 2024 21:18:01 +0200 Subject: [PATCH] expression assembler --- src/Ast.hs | 18 ++++----- src/ByteCode/ClassFile.hs | 55 +++++++++++++++++++-------- src/ByteCode/ClassFile/Generator.hs | 59 ++++++++++++++++++++++++++++- 3 files changed, 106 insertions(+), 26 deletions(-) diff --git a/src/Ast.hs b/src/Ast.hs index 80f4a2b..6d9a930 100644 --- a/src/Ast.hs +++ b/src/Ast.hs @@ -4,10 +4,10 @@ type CompilationUnit = [Class] type DataType = String type Identifier = String -data ParameterDeclaration = ParameterDeclaration DataType Identifier deriving (Show) -data VariableDeclaration = VariableDeclaration DataType Identifier (Maybe Expression) deriving (Show) -data Class = Class DataType [MethodDeclaration] [VariableDeclaration] deriving (Show) -data MethodDeclaration = MethodDeclaration DataType Identifier [ParameterDeclaration] Statement deriving (Show) +data ParameterDeclaration = ParameterDeclaration DataType Identifier deriving (Show, Eq) +data VariableDeclaration = VariableDeclaration DataType Identifier (Maybe Expression) deriving (Show, Eq) +data Class = Class DataType [MethodDeclaration] [VariableDeclaration] deriving (Show, Eq) +data MethodDeclaration = MethodDeclaration DataType Identifier [ParameterDeclaration] Statement deriving (Show, Eq) data Statement = If Expression Statement (Maybe Statement) @@ -17,14 +17,14 @@ data Statement | Return (Maybe Expression) | StatementExpressionStatement StatementExpression | TypedStatement DataType Statement - deriving (Show) + deriving (Show, Eq) data StatementExpression = Assignment Identifier Expression | ConstructorCall DataType [Expression] | MethodCall Identifier [Expression] | TypedStatementExpression DataType StatementExpression - deriving (Show) + deriving (Show, Eq) data BinaryOperator = Addition @@ -43,12 +43,12 @@ data BinaryOperator | And | Or | NameResolution - deriving (Show) + deriving (Show, Eq) data UnaryOperator = Not | Minus - deriving (Show) + deriving (Show, Eq) data Expression = IntegerLiteral Int @@ -60,4 +60,4 @@ data Expression | UnaryOperation UnaryOperator Expression | StatementExpressionExpression StatementExpression | TypedExpression DataType Expression - deriving (Show) + deriving (Show, Eq) diff --git a/src/ByteCode/ClassFile.hs b/src/ByteCode/ClassFile.hs index aeab84a..a7b0779 100644 --- a/src/ByteCode/ClassFile.hs +++ b/src/ByteCode/ClassFile.hs @@ -23,13 +23,24 @@ data ConstantInfo = ClassInfo Word16 | Utf8Info [Char] deriving (Show, Eq) - data Operation = Opiadd | Opisub | Opimul | Opidiv + | Opiand + | Opior + | Opixor + | Opineg + | Opif_icmplt Word16 + | Opif_icmple Word16 + | Opif_icmpgt Word16 + | Opif_icmpge Word16 + | Opif_icmpeq Word16 + | Opif_icmpne Word16 + | Opaconst_null | Opreturn - | OpiReturn + | Opireturn + | Opareturn | Opsipush Word16 | Opldc_w Word16 | Opaload Word16 @@ -97,20 +108,32 @@ instance Serializable MemberInfo where ++ concatMap serialize (memberAttributes member) instance Serializable Operation where - serialize Opiadd = [0x60] - serialize Opisub = [0x64] - serialize Opimul = [0x68] - serialize Opidiv = [0x6C] - serialize Opreturn = [0xB1] - serialize OpiReturn = [0xAC] - serialize (Opsipush index) = 0x11 : unpackWord16 index - serialize (Opldc_w index) = 0x13 : unpackWord16 index - serialize (Opaload index) = [0xC4, 0x19] ++ unpackWord16 index - serialize (Opiload index) = [0xC4, 0x15] ++ unpackWord16 index - serialize (Opastore index) = [0xC4, 0x3A] ++ unpackWord16 index - serialize (Opistore index) = [0xC4, 0x36] ++ unpackWord16 index - serialize (Opputfield index) = 0xB5 : unpackWord16 index - serialize (OpgetField index) = 0xB4 : unpackWord16 index + serialize Opiadd = [0x60] + serialize Opisub = [0x64] + serialize Opimul = [0x68] + serialize Opidiv = [0x6C] + serialize Opiand = [0x7E] + serialize Opior = [0x80] + serialize Opixor = [0x82] + serialize Opineg = [0x74] + serialize (Opif_icmplt branch) = 0xA1 : unpackWord16 branch + serialize (Opif_icmple branch) = 0xA4 : unpackWord16 branch + serialize (Opif_icmpgt branch) = 0xA3 : unpackWord16 branch + serialize (Opif_icmpge branch) = 0xA2 : unpackWord16 branch + serialize (Opif_icmpeq branch) = 0x9F : unpackWord16 branch + serialize (Opif_icmpne branch) = 0xA0 : unpackWord16 branch + serialize Opaconst_null = [0x01] + serialize Opreturn = [0xB1] + serialize Opireturn = [0xAC] + serialize Opareturn = [0xB0] + serialize (Opsipush index) = 0x11 : unpackWord16 index + serialize (Opldc_w index) = 0x13 : unpackWord16 index + serialize (Opaload index) = [0xC4, 0x19] ++ unpackWord16 index + serialize (Opiload index) = [0xC4, 0x15] ++ unpackWord16 index + serialize (Opastore index) = [0xC4, 0x3A] ++ unpackWord16 index + serialize (Opistore index) = [0xC4, 0x36] ++ unpackWord16 index + serialize (Opputfield index) = 0xB5 : unpackWord16 index + serialize (OpgetField index) = 0xB4 : unpackWord16 index instance Serializable Attribute where serialize (CodeAttribute { attributeMaxStack = maxStack, diff --git a/src/ByteCode/ClassFile/Generator.hs b/src/ByteCode/ClassFile/Generator.hs index 371d2c9..3bdd0ec 100644 --- a/src/ByteCode/ClassFile/Generator.hs +++ b/src/ByteCode/ClassFile/Generator.hs @@ -8,6 +8,7 @@ module ByteCode.ClassFile.Generator( import ByteCode.Constants import ByteCode.ClassFile (ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..)) import Ast +import Data.Char type ClassFileBuilder a = a -> ClassFile -> ClassFile @@ -109,4 +110,60 @@ methodBuilder (MethodDeclaration returntype name parameters statement) input = l input { constantPool = (constantPool input) ++ constants, methods = (fields input) ++ [method] - } \ No newline at end of file + } + +type Assembler a = a -> ([ConstantInfo], [Operation]) -> ([ConstantInfo], [Operation]) + +returnOperation :: DataType -> Operation +returnOperation dtype + | elem dtype ["int", "char", "boolean"] = Opireturn + | otherwise = Opareturn + +binaryOperation :: BinaryOperator -> Operation +binaryOperation Addition = Opiadd +binaryOperation Subtraction = Opisub +binaryOperation Multiplication = Opimul +binaryOperation Division = Opidiv +binaryOperation BitwiseAnd = Opiand +binaryOperation BitwiseOr = Opior +binaryOperation BitwiseXor = Opixor + +assembleMethod :: Assembler MethodDeclaration +assembleMethod (MethodDeclaration _ _ _ (Block statements)) (constants, ops) = + foldr assembleStatement (constants, ops) statements + +assembleStatement :: Assembler Statement +assembleStatement (TypedStatement stype (Return expr)) (constants, ops) = case expr of + Nothing -> (constants, ops ++ [Opreturn]) + Just expr -> let + (expr_constants, expr_ops) = assembleExpression expr (constants, ops) + in + (expr_constants, expr_ops ++ [returnOperation stype]) + +assembleExpression :: Assembler Expression +assembleExpression (TypedExpression _ (BinaryOperation op a b)) (constants, ops) + | elem op [Addition, Subtraction, Multiplication, Division, BitwiseAnd, BitwiseOr, BitwiseXor] = let + (aConstants, aOps) = assembleExpression a (constants, ops) + (bConstants, bOps) = assembleExpression b (aConstants, aOps) + in + (bConstants, bOps ++ [binaryOperation op]) +assembleExpression (TypedExpression _ (CharacterLiteral literal)) (constants, ops) = + (constants, ops ++ [Opsipush (fromIntegral (ord literal))]) +assembleExpression (TypedExpression _ (BooleanLiteral literal)) (constants, ops) = + (constants, ops ++ [Opsipush (if literal then 1 else 0)]) +assembleExpression (TypedExpression _ (IntegerLiteral literal)) (constants, ops) + | literal <= 32767 && literal >= -32768 = (constants, ops ++ [Opsipush (fromIntegral literal)]) + | otherwise = (constants ++ [IntegerInfo (fromIntegral literal)], ops ++ [Opldc_w (fromIntegral (1 + length constants))]) +assembleExpression (TypedExpression _ NullLiteral) (constants, ops) = + (constants, ops ++ [Opaconst_null]) +assembleExpression (TypedExpression etype (UnaryOperation Not expr)) (constants, ops) = let + (exprConstants, exprOps) = assembleExpression expr (constants, ops) + newConstant = fromIntegral (1 + length exprConstants) + in case etype of + "int" -> (exprConstants ++ [IntegerInfo 0x7FFFFFFF], exprOps ++ [Opldc_w newConstant, Opixor]) + "char" -> (exprConstants, exprOps ++ [Opsipush 0xFFFF, Opixor]) + "boolean" -> (exprConstants, exprOps ++ [Opsipush 0x01, Opixor]) +assembleExpression (TypedExpression _ (UnaryOperation Minus expr)) (constants, ops) = let + (exprConstants, exprOps) = assembleExpression expr (constants, ops) + in + (exprConstants, exprOps ++ [Opineg])