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

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)

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)

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)
@@ -16,3 +18,12 @@ assembleStatementExpression
     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)
+
+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)