Merge branch 'bytecode' of https://gitea.hb.dhbw-stuttgart.de/MisterChaos69/MiniJavaCompiler into bytecode

Test/TestByteCodeGenerator.hs

@@ -39,8 +39,8 @@ expectedClassWithFields = ClassFile {
             Utf8Info "Code",
             ClassInfo 9,
             Utf8Info "Testklasse",
-            FieldRefInfo (fromIntegral 8) (fromIntegral 11),
-            NameAndTypeInfo (fromIntegral 12) (fromIntegral 13),
+            FieldRefInfo 8 11,
+            NameAndTypeInfo 12 13,
             Utf8Info "testvariable",
             Utf8Info "I"
         ],
@@ -59,11 +59,58 @@ expectedClassWithFields = ClassFile {
         attributes = []
     }
 
+method = MethodDeclaration "int" "add_two_numbers" [
+    ParameterDeclaration "int" "a",
+    ParameterDeclaration "int" "b" ]
+    (Block [Return (Just (BinaryOperation Addition (Reference "a") (Reference "b")))])
+
+
+classWithMethod = Class "Testklasse" [method] []
+expectedClassWithMethod = ClassFile {
+        constantPool = [
+            ClassInfo 4,
+            MethodRefInfo 1 3,
+            NameAndTypeInfo 5 6,
+            Utf8Info "java/lang/Object",
+            Utf8Info "<init>",
+            Utf8Info "()V",
+            Utf8Info "Code",
+            ClassInfo 9,
+            Utf8Info "Testklasse",
+            FieldRefInfo 8 11,
+            NameAndTypeInfo 12 13,
+            Utf8Info "add_two_numbers",
+            Utf8Info "(II)I"
+        ],
+        accessFlags = accessPublic,
+        thisClass = 8,
+        superClass = 1,
+        fields = [],
+        methods = [
+            MemberInfo {
+                memberAccessFlags = accessPublic,
+                memberNameIndex = 12,
+                memberDescriptorIndex = 13,
+                memberAttributes = [
+                    CodeAttribute {
+                        attributeMaxStack = 420,
+                        attributeMaxLocals = 420,
+                        attributeCode = [Opiadd]
+                    }
+                ]
+            }
+        ],
+        attributes = []
+    }
 
 testBasicConstantPool = TestCase $ assertEqual "basic constant pool" expectedClass $ classBuilder nakedClass emptyClassFile
 testFields = TestCase $ assertEqual "fields in constant pool" expectedClassWithFields $ classBuilder classWithFields emptyClassFile
+testMethodDescriptor = TestCase $ assertEqual "method descriptor" "(II)I" (methodDescriptor method)
+testMethodAssembly = TestCase $ assertEqual "method assembly" expectedClassWithMethod (classBuilder classWithMethod emptyClassFile)
 
 tests = TestList [
     TestLabel "Basic constant pool" testBasicConstantPool,
-    TestLabel "Fields constant pool" testFields
+    TestLabel "Fields constant pool" testFields,
+    TestLabel "Method descriptor building" testMethodDescriptor,
+    TestLabel "Method assembly" testMethodAssembly
     ]

project.cabal

@@ -16,7 +16,7 @@ executable compiler
                         src/ByteCode,
                         src/ByteCode/ClassFile
     build-tool-depends: alex:alex, happy:happy
-    other-modules:      Ast, Example, Typecheck, ByteCode.ByteUtil, ByteCode.ClassFile, ByteCode.ClassFile.Generator, ByteCode.Constants, ByteCode.Operations
+    other-modules:      Ast, Example, Typecheck, ByteCode.ByteUtil, ByteCode.ClassFile, ByteCode.ClassFile.Generator, ByteCode.Constants
 
 test-suite tests
     type:               exitcode-stdio-1.0

src/ByteCode/ClassFile.hs

@@ -3,6 +3,7 @@ module ByteCode.ClassFile(
     Attribute(..),
     MemberInfo(..),
     ClassFile(..),
+    Operation(..),
     serialize,
     emptyClassFile
 ) where
@@ -23,38 +24,20 @@ data ConstantInfo = ClassInfo Word16
                   deriving (Show, Eq)
 
 
-{-
-    Code_attribute {
-    u2 attribute_name_index;
-    u4 attribute_length;
-    u2 max_stack;
-    u2 max_locals;
-    u4 code_length;
-    u1 code[code_length];
-    u2 exception_table_length;
-    {   u2 start_pc;
-        u2 end_pc;
-        u2 handler_pc;
-        u2 catch_type;
-    } exception_table[exception_table_length];
-    u2 attributes_count;
-    attribute_info attributes[attributes_count];
--}
---data Attribute = Attribute Word16 [Word8] deriving (Show, Eq)
-data Operation = Iadd
-               | Isub
-               | Imul
-               | Idiv
-               | Return
-               | IReturn
-               | Sipush Word16
-               | Ldc_w Word16
-               | Aload Word16
-               | Iload Word16
-               | Astore Word16
-               | Istore Word16
-               | Putfield Word16
-               | GetField Word16
+data Operation = Opiadd
+               | Opisub
+               | Opimul
+               | Opidiv
+               | Opreturn
+               | OpiReturn
+               | Opsipush Word16
+               | Opldc_w Word16
+               | Opaload Word16
+               | Opiload Word16
+               | Opastore Word16
+               | Opistore Word16
+               | Opputfield Word16
+               | OpgetField Word16
     deriving (Show, Eq)
 
 
@@ -114,6 +97,22 @@ instance Serializable MemberInfo where
                     ++ concatMap serialize (memberAttributes member)
 
 instance Serializable Operation where
+<<<<<<< HEAD
+    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 Iadd              = [0x60]
     serialize Isub              = [0x64]
     serialize Imul              = [0x68]
@@ -128,6 +127,7 @@ instance Serializable Operation where
     serialize (Istore index)    = [0xC4, 0x36] ++ unpackWord16 index
     serialize (Putfield index)  = 0xB5 : unpackWord16 index
     serialize (GetField index)  = 0xB4 : unpackWord16 index
+>>>>>>> 8b5650dd6104d1e350128fdcee37502d65824370
 
 instance Serializable Attribute where
     serialize (CodeAttribute { attributeMaxStack = maxStack,

src/ByteCode/ClassFile/Generator.hs

@@ -1,22 +1,40 @@
 module ByteCode.ClassFile.Generator(
-    classBuilder
+    classBuilder,
+    datatypeDescriptor,
+    methodParameterDescriptor,
+    methodDescriptor,
 ) where
 
 import ByteCode.Constants
-import ByteCode.ClassFile (ClassFile (..), ConstantInfo (..), MemberInfo(..))
+import ByteCode.ClassFile (ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..))
 import Ast
-import ByteCode.Operations
 
 
 type ClassFileBuilder a = a -> ClassFile -> ClassFile
 
 
 datatypeDescriptor :: String -> String
+datatypeDescriptor "void" = "V"
 datatypeDescriptor "int" = "I"
 datatypeDescriptor "char" = "C"
 datatypeDescriptor "boolean" = "B"
 datatypeDescriptor x = "L" ++ x
 
+methodParameterDescriptor :: String -> String
+methodParameterDescriptor "void" = "V"
+methodParameterDescriptor "int" = "I"
+methodParameterDescriptor "char" = "C"
+methodParameterDescriptor "boolean" = "B"
+methodParameterDescriptor x = "L" ++ x ++ ";"
+
+methodDescriptor :: MethodDeclaration -> String
+methodDescriptor (MethodDeclaration returntype _ parameters _) = let 
+        parameter_types = [datatype | ParameterDeclaration datatype _ <- parameters]
+    in
+        "("
+        ++ (concat (map methodParameterDescriptor parameter_types))
+        ++ ")"
+        ++ datatypeDescriptor returntype
 
 classBuilder :: ClassFileBuilder Class
 classBuilder (Class name methods fields) _ = let
@@ -40,7 +58,7 @@ classBuilder (Class name methods fields) _ = let
             attributes = []
         }
     in
-        foldr fieldBuilder nakedClassFile fields
+        foldr methodBuilder (foldr fieldBuilder nakedClassFile fields) methods
         
         
 
@@ -64,3 +82,31 @@ fieldBuilder (VariableDeclaration datatype name _) input = let
             constantPool = (constantPool input) ++ constants,
             fields = (fields input) ++ [field]
         }
+
+methodBuilder :: ClassFileBuilder MethodDeclaration
+methodBuilder (MethodDeclaration returntype name parameters statement) input = let
+        baseIndex = 1 + length (constantPool input)
+        constants = [
+                FieldRefInfo (fromIntegral (thisClass input)) (fromIntegral (baseIndex + 1)),
+                NameAndTypeInfo (fromIntegral (baseIndex + 2)) (fromIntegral (baseIndex + 3)),
+                Utf8Info name,
+                Utf8Info (methodDescriptor (MethodDeclaration returntype name parameters (Block [])))
+            ]
+        --code = assembleByteCode statement
+        method = MemberInfo {
+            memberAccessFlags = accessPublic,
+            memberNameIndex = (fromIntegral (baseIndex + 2)),
+            memberDescriptorIndex = (fromIntegral (baseIndex + 3)),
+            memberAttributes = [
+                   CodeAttribute {
+                        attributeMaxStack = 420,
+                        attributeMaxLocals = 420,
+                        attributeCode = [Opiadd]
+                    }
+                ]
+            }
+    in
+        input {
+            constantPool = (constantPool input) ++ constants,
+            methods = (fields input) ++ [method]
+        }

src/ByteCode/Operations.hs

@@ -1,3 +0,0 @@
-module ByteCode.Operations where 
-data Operation = Iadd
-            --   |