From 6f4143a60a5bf58e8832099c41b4be24d9052798 Mon Sep 17 00:00:00 2001 From: mrab Date: Thu, 16 May 2024 11:42:48 +0200 Subject: [PATCH] increment/decrement --- src/ByteCode/ClassFile.hs | 3 + .../Generation/Assembler/Expression.hs | 98 +++++++++++++++++++ .../Generation/Assembler/Statement.hs | 5 + .../Assembler/StatementExpression.hs | 13 ++- 4 files changed, 118 insertions(+), 1 deletion(-) diff --git a/src/ByteCode/ClassFile.hs b/src/ByteCode/ClassFile.hs index 37481db..358b91a 100644 --- a/src/ByteCode/ClassFile.hs +++ b/src/ByteCode/ClassFile.hs @@ -32,6 +32,7 @@ data Operation = Opiadd | Opior | Opixor | Opineg + | Opdup | Opif_icmplt Word16 | Opif_icmple Word16 | Opif_icmpgt Word16 @@ -99,6 +100,7 @@ opcodeEncodingLength Opiand = 1 opcodeEncodingLength Opior = 1 opcodeEncodingLength Opixor = 1 opcodeEncodingLength Opineg = 1 +opcodeEncodingLength Opdup = 1 opcodeEncodingLength (Opif_icmplt _) = 3 opcodeEncodingLength (Opif_icmple _) = 3 opcodeEncodingLength (Opif_icmpgt _) = 3 @@ -149,6 +151,7 @@ instance Serializable Operation where serialize Opior = [0x80] serialize Opixor = [0x82] serialize Opineg = [0x74] + serialize Opdup = [0x59] serialize (Opif_icmplt branch) = 0xA1 : unpackWord16 branch serialize (Opif_icmple branch) = 0xA4 : unpackWord16 branch serialize (Opif_icmpgt branch) = 0xA3 : unpackWord16 branch diff --git a/src/ByteCode/Generation/Assembler/Expression.hs b/src/ByteCode/Generation/Assembler/Expression.hs index a7f3d15..6921956 100644 --- a/src/ByteCode/Generation/Assembler/Expression.hs +++ b/src/ByteCode/Generation/Assembler/Expression.hs @@ -21,15 +21,20 @@ assembleExpression (constants, ops, lvars) (TypedExpression _ (BinaryOperation o cmp_ops = [cmp_op, Opsipush 0, Opgoto 6, Opsipush 1] in (bConstants, bOps ++ cmp_ops, lvars) + assembleExpression (constants, ops, lvars) (TypedExpression _ (CharacterLiteral literal)) = (constants, ops ++ [Opsipush (fromIntegral (ord literal))], lvars) + assembleExpression (constants, ops, lvars) (TypedExpression _ (BooleanLiteral literal)) = (constants, ops ++ [Opsipush (if literal then 1 else 0)], lvars) + assembleExpression (constants, ops, lvars) (TypedExpression _ (IntegerLiteral literal)) | literal <= 32767 && literal >= -32768 = (constants, ops ++ [Opsipush (fromIntegral literal)], lvars) | otherwise = (constants ++ [IntegerInfo (fromIntegral literal)], ops ++ [Opldc_w (fromIntegral (1 + length constants))], lvars) + assembleExpression (constants, ops, lvars) (TypedExpression _ NullLiteral) = (constants, ops ++ [Opaconst_null], lvars) + assembleExpression (constants, ops, lvars) (TypedExpression etype (UnaryOperation Not expr)) = let (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr newConstant = fromIntegral (1 + length exprConstants) @@ -37,19 +42,112 @@ assembleExpression (constants, ops, lvars) (TypedExpression etype (UnaryOperatio "int" -> (exprConstants ++ [IntegerInfo 0x7FFFFFFF], exprOps ++ [Opldc_w newConstant, Opixor], lvars) "char" -> (exprConstants, exprOps ++ [Opsipush 0xFFFF, Opixor], lvars) "boolean" -> (exprConstants, exprOps ++ [Opsipush 0x01, Opixor], lvars) + assembleExpression (constants, ops, lvars) (TypedExpression _ (UnaryOperation Minus expr)) = let (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr in (exprConstants, exprOps ++ [Opineg], lvars) + +assembleExpression + (constants, ops, lvars) + (TypedExpression _ (UnaryOperation PreIncrement (TypedExpression dtype (LocalVariable name)))) = let + localIndex = findIndex ((==) name) lvars + expr = (TypedExpression dtype (LocalVariable name)) + (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr + incrOps = exprOps ++ [Opsipush 1, Opiadd, Opdup] + in case localIndex of + Just index -> (exprConstants, incrOps ++ [Opistore (fromIntegral index)], lvars) + Nothing -> error("No such local variable found in local variable pool: " ++ name) + +assembleExpression + (constants, ops, lvars) + (TypedExpression _ (UnaryOperation PostIncrement (TypedExpression dtype (LocalVariable name)))) = let + localIndex = findIndex ((==) name) lvars + expr = (TypedExpression dtype (LocalVariable name)) + (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr + incrOps = exprOps ++ [Opdup, Opsipush 1, Opiadd] + in case localIndex of + Just index -> (exprConstants, incrOps ++ [Opistore (fromIntegral index)], lvars) + Nothing -> error("No such local variable found in local variable pool: " ++ name) + +assembleExpression + (constants, ops, lvars) + (TypedExpression _ (UnaryOperation PreDecrement (TypedExpression dtype (LocalVariable name)))) = let + localIndex = findIndex ((==) name) lvars + expr = (TypedExpression dtype (LocalVariable name)) + (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr + incrOps = exprOps ++ [Opsipush 1, Opiadd, Opisub] + in case localIndex of + Just index -> (exprConstants, incrOps ++ [Opistore (fromIntegral index)], lvars) + Nothing -> error("No such local variable found in local variable pool: " ++ name) + +assembleExpression + (constants, ops, lvars) + (TypedExpression _ (UnaryOperation PostDecrement (TypedExpression dtype (LocalVariable name)))) = let + localIndex = findIndex ((==) name) lvars + expr = (TypedExpression dtype (LocalVariable name)) + (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr + incrOps = exprOps ++ [Opdup, Opsipush 1, Opisub] + in case localIndex of + Just index -> (exprConstants, incrOps ++ [Opistore (fromIntegral index)], lvars) + Nothing -> error("No such local variable found in local variable pool: " ++ name) + +assembleExpression + (constants, ops, lvars) + (TypedExpression _ (UnaryOperation PreIncrement (TypedExpression dtype (FieldVariable name)))) = let + fieldIndex = findFieldIndex constants name + expr = (TypedExpression dtype (FieldVariable name)) + (exprConstants, exprOps, _) = assembleExpression (constants, ops ++ [Opaload 0], lvars) expr + incrOps = exprOps ++ [Opsipush 1, Opiadd, Opdup] + in case fieldIndex of + Just index -> (exprConstants, incrOps ++ [Opputfield (fromIntegral index)], lvars) + Nothing -> error("No such field variable found in field variable pool: " ++ name) + +assembleExpression + (constants, ops, lvars) + (TypedExpression _ (UnaryOperation PostIncrement (TypedExpression dtype (FieldVariable name)))) = let + fieldIndex = findFieldIndex constants name + expr = (TypedExpression dtype (FieldVariable name)) + (exprConstants, exprOps, _) = assembleExpression (constants, ops ++ [Opaload 0], lvars) expr + incrOps = exprOps ++ [Opdup, Opsipush 1, Opiadd] + in case fieldIndex of + Just index -> (exprConstants, incrOps ++ [Opputfield (fromIntegral index)], lvars) + Nothing -> error("No such field variable found in field variable pool: " ++ name) + +assembleExpression + (constants, ops, lvars) + (TypedExpression _ (UnaryOperation PreDecrement (TypedExpression dtype (FieldVariable name)))) = let + fieldIndex = findFieldIndex constants name + expr = (TypedExpression dtype (FieldVariable name)) + (exprConstants, exprOps, _) = assembleExpression (constants, ops ++ [Opaload 0], lvars) expr + incrOps = exprOps ++ [Opsipush 1, Opiadd, Opisub] + in case fieldIndex of + Just index -> (exprConstants, incrOps ++ [Opputfield (fromIntegral index)], lvars) + Nothing -> error("No such field variable found in field variable pool: " ++ name) + +assembleExpression + (constants, ops, lvars) + (TypedExpression _ (UnaryOperation PostDecrement (TypedExpression dtype (FieldVariable name)))) = let + fieldIndex = findFieldIndex constants name + expr = (TypedExpression dtype (FieldVariable name)) + (exprConstants, exprOps, _) = assembleExpression (constants, ops ++ [Opaload 0], lvars) expr + incrOps = exprOps ++ [Opdup, Opsipush 1, Opisub] + in case fieldIndex of + Just index -> (exprConstants, incrOps ++ [Opputfield (fromIntegral index)], lvars) + Nothing -> error("No such field variable found in field variable pool: " ++ name) + + assembleExpression (constants, ops, lvars) (TypedExpression _ (FieldVariable name)) = let fieldIndex = findFieldIndex constants name in case fieldIndex of Just index -> (constants, ops ++ [Opaload 0, Opgetfield (fromIntegral index)], lvars) Nothing -> error ("No such field found in constant pool: " ++ name) + assembleExpression (constants, ops, lvars) (TypedExpression dtype (LocalVariable name)) = let localIndex = findIndex ((==) name) lvars isPrimitive = elem dtype ["char", "boolean", "int"] in case localIndex of Just index -> (constants, ops ++ if isPrimitive then [Opiload (fromIntegral index)] else [Opaload (fromIntegral index)], lvars) Nothing -> error ("No such local variable found in local variable pool: " ++ name) + assembleExpression _ expr = error ("unimplemented: " ++ show expr) diff --git a/src/ByteCode/Generation/Assembler/Statement.hs b/src/ByteCode/Generation/Assembler/Statement.hs index 5d80942..ed4dcc9 100644 --- a/src/ByteCode/Generation/Assembler/Statement.hs +++ b/src/ByteCode/Generation/Assembler/Statement.hs @@ -4,6 +4,7 @@ import Ast import ByteCode.ClassFile(ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..), opcodeEncodingLength) import ByteCode.Generation.Generator import ByteCode.Generation.Assembler.Expression +import ByteCode.Generation.Assembler.StatementExpression assembleStatement :: Assembler Statement assembleStatement (constants, ops, lvars) (TypedStatement stype (Return expr)) = case expr of @@ -43,4 +44,8 @@ assembleStatement (constants, ops, lvars) (TypedStatement _ (LocalVariableDeclar storeLocal = if isPrimitive then [Opistore localIndex] else [Opastore localIndex] in (constants_init, ops_init ++ storeLocal, lvars ++ [name]) + +assembleStatement (constants, ops, lvars) (TypedStatement _ (StatementExpressionStatement expr)) = + assembleStatementExpression (constants, ops, lvars) expr + assembleStatement _ stmt = error ("Not yet implemented: " ++ show stmt) diff --git a/src/ByteCode/Generation/Assembler/StatementExpression.hs b/src/ByteCode/Generation/Assembler/StatementExpression.hs index f1648a2..e9fcb07 100644 --- a/src/ByteCode/Generation/Assembler/StatementExpression.hs +++ b/src/ByteCode/Generation/Assembler/StatementExpression.hs @@ -5,7 +5,9 @@ import ByteCode.ClassFile(ClassFile (..), ConstantInfo (..), MemberInfo(..), Ope import ByteCode.Generation.Generator import Data.List import ByteCode.Generation.Assembler.Expression +import ByteCode.Generation.Builder.Field +-- TODO untested assembleStatementExpression :: Assembler StatementExpression assembleStatementExpression (constants, ops, lvars) @@ -15,4 +17,13 @@ assembleStatementExpression isPrimitive = elem dtype ["char", "boolean", "int"] in case localIndex of Just index -> (constants_a, ops_a ++ if isPrimitive then [Opistore (fromIntegral index)] else [Opastore (fromIntegral index)], lvars) - Nothing -> error ("No such local variable found in local variable pool: " ++ name) \ No newline at end of file + Nothing -> error ("No such local variable found in local variable pool: " ++ name) + +assembleStatementExpression + (constants, ops, lvars) + (TypedStatementExpression _ (Assignment (TypedExpression dtype (FieldVariable name)) expr)) = let + fieldIndex = findFieldIndex constants name + (constants_a, ops_a, _) = assembleExpression (constants, ops ++ [Opaload 0], lvars) expr + in case fieldIndex of + Just index -> (constants_a, ops_a ++ [Opputfield (fromIntegral index)], lvars) + Nothing -> error ("No such field variable found in constant pool: " ++ name) \ No newline at end of file