From b41a77ba33fb200d6494c66ff7cb49cb40f5c017 Mon Sep 17 00:00:00 2001 From: mrab Date: Wed, 12 Jun 2024 19:57:09 +0200 Subject: [PATCH] boolean AND/OR, if/else goto fixed --- src/ByteCode/ClassFile.hs | 3 +++ src/ByteCode/Generator.hs | 35 ++++++++++++++++++++++++++++------- 2 files changed, 31 insertions(+), 7 deletions(-) diff --git a/src/ByteCode/ClassFile.hs b/src/ByteCode/ClassFile.hs index 23fbcd1..856781d 100644 --- a/src/ByteCode/ClassFile.hs +++ b/src/ByteCode/ClassFile.hs @@ -28,6 +28,7 @@ data Operation = Opiadd | Opisub | Opimul | Opidiv + | Opirem | Opiand | Opior | Opixor @@ -99,6 +100,7 @@ opcodeEncodingLength Opiadd = 1 opcodeEncodingLength Opisub = 1 opcodeEncodingLength Opimul = 1 opcodeEncodingLength Opidiv = 1 +opcodeEncodingLength Opirem = 1 opcodeEncodingLength Opiand = 1 opcodeEncodingLength Opior = 1 opcodeEncodingLength Opixor = 1 @@ -153,6 +155,7 @@ instance Serializable Operation where serialize Opisub = [0x64] serialize Opimul = [0x68] serialize Opidiv = [0x6C] + serialize Opirem = [0x70] serialize Opiand = [0x7E] serialize Opior = [0x80] serialize Opixor = [0x82] diff --git a/src/ByteCode/Generator.hs b/src/ByteCode/Generator.hs index e1c4f0d..835c168 100644 --- a/src/ByteCode/Generator.hs +++ b/src/ByteCode/Generator.hs @@ -82,9 +82,12 @@ binaryOperation Addition = Opiadd binaryOperation Subtraction = Opisub binaryOperation Multiplication = Opimul binaryOperation Division = Opidiv +binaryOperation Modulo = Opirem binaryOperation BitwiseAnd = Opiand binaryOperation BitwiseOr = Opior binaryOperation BitwiseXor = Opixor +binaryOperation And = Opiand +binaryOperation Or = Opior comparisonOperation :: BinaryOperator -> Word16 -> Operation comparisonOperation CompareEqual branchLocation = Opif_icmpeq branchLocation @@ -94,15 +97,13 @@ comparisonOperation CompareLessOrEqual branchLocation = Opif_icmple branchLoc comparisonOperation CompareGreaterThan branchLocation = Opif_icmpgt branchLocation comparisonOperation CompareGreaterOrEqual branchLocation = Opif_icmpge branchLocation - - findFieldIndex :: [ConstantInfo] -> String -> Maybe Int findFieldIndex constants name = let fieldRefNameInfos = [ -- we only skip one entry to get the name since the Java constant pool -- is 1-indexed (why) (index, constants!!(fromIntegral index + 1)) - | (index, FieldRefInfo _ _) <- (zip [1..] constants) + | (index, FieldRefInfo classIndex _) <- (zip [1..] constants) ] fieldRefNames = map (\(index, nameInfo) -> case nameInfo of Utf8Info fieldName -> (index, fieldName) @@ -252,7 +253,7 @@ classBuilder (Class name methods fields) _ = let assembleExpression :: Assembler Expression assembleExpression (constants, ops, lvars) (TypedExpression _ (BinaryOperation op a b)) - | elem op [Addition, Subtraction, Multiplication, Division, BitwiseAnd, BitwiseOr, BitwiseXor] = let + | elem op [Addition, Subtraction, Multiplication, Division, Modulo, BitwiseAnd, BitwiseOr, BitwiseXor, And, Or] = let (aConstants, aOps, _) = assembleExpression (constants, ops, lvars) a (bConstants, bOps, _) = assembleExpression (aConstants, aOps, lvars) b in @@ -265,6 +266,21 @@ assembleExpression (constants, ops, lvars) (TypedExpression _ (BinaryOperation o in (bConstants, bOps ++ cmp_ops, lvars) +{- +assembleExpression (constants, ops, lvars) (TypedExpression _ (BinaryOperation NameResolution lvar (TypedExpression _ (FieldVariable fvar)))) = let + constants_f = constants ++ [ + FieldRefInfo (fromIntegral (thisClass input)) (fromIntegral (baseIndex + 1)), + NameAndTypeInfo (fromIntegral (baseIndex + 2)) (fromIntegral (baseIndex + 3)), + Utf8Info name, + Utf8Info (datatypeDescriptor datatype) + ] + (constants_l, ops_l, lvars_l) = assembleExpression (constants, ops, lvars) lvar + constants_ + fieldIndex = findFieldIndex constants name + in case fieldIndex of + Just index -> (constants, ops ++ [Opload 0, Opgetfield (fromIntegral index)], lvars) + Nothing -> error ("No such field found in constant pool: " ++ name) +-} assembleExpression (constants, ops, lvars) (TypedExpression _ (CharacterLiteral literal)) = (constants, ops ++ [Opsipush (fromIntegral (ord literal))], lvars) @@ -493,11 +509,16 @@ assembleStatement _ stmt = error ("Not yet implemented: " ++ show stmt) assembleMethod :: Assembler MethodDeclaration -assembleMethod (constants, ops, lvars) (MethodDeclaration _ name _ (TypedStatement _ (Block statements))) - | name == "" = let +assembleMethod (constants, ops, lvars) (MethodDeclaration returntype name _ (TypedStatement _ (Block statements))) + | name == "" = let (constants_a, ops_a, lvars_a) = foldl assembleStatement (constants, ops, lvars) statements init_ops = [Opaload 0, Opinvokespecial 2] in (constants_a, init_ops ++ ops_a ++ [Opreturn], lvars_a) - | otherwise = foldl assembleStatement (constants, ops, lvars) statements + | otherwise = case returntype of + "void" -> let + (constants_a, ops_a, lvars_a) = foldl assembleStatement (constants, ops, lvars) statements + in + (constants_a, ops_a ++ [Opreturn], lvars_a) + otherwise -> foldl assembleStatement (constants, ops, lvars) statements assembleMethod _ (MethodDeclaration _ _ _ stmt) = error ("Block expected for method body, got: " ++ show stmt)