boolean AND/OR, if/else goto fixed

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]

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)))
+assembleMethod (constants, ops, lvars) (MethodDeclaration returntype name _ (TypedStatement _ (Block statements)))
-    | name == "<init>" = let
+    | name == "<init>"  = 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)