From 967c3a4b41b7a2d61577bc8de3b9527ca00534fb Mon Sep 17 00:00:00 2001 From: mrab Date: Sat, 4 May 2024 16:28:42 +0200 Subject: [PATCH] Moved bytecode stuff into separate folder --- project.cabal | 14 +++-- src/ByteCode/ByteUtil.hs | 19 +++++++ src/{ => ByteCode}/ClassFile.hs | 80 +++++++++++------------------ src/ByteCode/ClassFile/Generator.hs | 1 + src/ByteUtil.hs | 19 ------- src/Main.hs | 4 +- 6 files changed, 61 insertions(+), 76 deletions(-) create mode 100644 src/ByteCode/ByteUtil.hs rename src/{ => ByteCode}/ClassFile.hs (52%) create mode 100644 src/ByteCode/ClassFile/Generator.hs delete mode 100644 src/ByteUtil.hs diff --git a/project.cabal b/project.cabal index 69ef52a..520b172 100644 --- a/project.cabal +++ b/project.cabal @@ -8,11 +8,15 @@ executable compiler main-is: Main.hs build-depends: base, array, - HUnit + HUnit, + utf8-string, + bytestring default-language: Haskell2010 - hs-source-dirs: src + hs-source-dirs: src, + src/ByteCode, + src/ByteCode/ClassFile build-tool-depends: alex:alex, happy:happy - other-modules: Parser.Lexer, Ast + other-modules: Parser.Lexer, Ast, Parser.JavaParser, ByteCode.ByteUtil, ByteCode.ClassFile, ByteCode.ClassFile.Generator test-suite tests type: exitcode-stdio-1.0 @@ -20,6 +24,8 @@ test-suite tests hs-source-dirs: src,Test build-depends: base, array, - HUnit + HUnit, + utf8-string, + bytestring build-tool-depends: alex:alex, happy:happy other-modules: Parser.Lexer, TestLexer diff --git a/src/ByteCode/ByteUtil.hs b/src/ByteCode/ByteUtil.hs new file mode 100644 index 0000000..daa419a --- /dev/null +++ b/src/ByteCode/ByteUtil.hs @@ -0,0 +1,19 @@ +module ByteCode.ByteUtil(unpackWord16, unpackWord32) where + +import Data.Word ( Word8, Word16, Word32 ) +import Data.Int +import Data.Bits + +unpackWord16 :: Word16 -> [Word8] +unpackWord16 v = [ + fromIntegral (shiftR ((.&.) v 0xFF00) 8), + fromIntegral (shiftR ((.&.) v 0x00FF) 0) + ] + +unpackWord32 :: Word32 -> [Word8] +unpackWord32 v = [ + fromIntegral (shiftR ((.&.) v 0xFF000000) 24), + fromIntegral (shiftR ((.&.) v 0x00FF0000) 16), + fromIntegral (shiftR ((.&.) v 0x0000FF00) 8), + fromIntegral (shiftR ((.&.) v 0x000000FF) 0) + ] \ No newline at end of file diff --git a/src/ClassFile.hs b/src/ByteCode/ClassFile.hs similarity index 52% rename from src/ClassFile.hs rename to src/ByteCode/ClassFile.hs index 382ce8f..b1aa39c 100644 --- a/src/ClassFile.hs +++ b/src/ByteCode/ClassFile.hs @@ -1,19 +1,21 @@ +module ByteCode.ClassFile where + import Data.Word import Data.Int import Data.ByteString (unpack) import Data.ByteString.UTF8 (fromString) -import ByteUtil +import ByteCode.ByteUtil -tag_class :: Word8 = 0x07 -tag_fieldref :: Word8 = 0x09 -tag_methodref :: Word8 = 0x0A -tag_nameandtype:: Word8 = 0x0C -tag_integer :: Word8 = 0x03 -tag_utf8 :: Word8 = 0x01 +tagClass = 0x07 +tagFieldref = 0x09 +tagMethodref = 0x0A +tagNameandtype = 0x0C +tagInteger = 0x03 +tagUtf8 = 0x01 -access_public :: Word16 = 0x01 -access_private :: Word16 = 0x02 -access_protected :: Word16 = 0x04 +accessPublic = 0x01 +accessPrivate = 0x02 +accessProtected = 0x04 data ConstantInfo = ClassInfo Word16 | FieldRefInfo Word16 Word16 @@ -32,7 +34,7 @@ data MemberInfo = MemberInfo { memberAttributes :: [Attribute] } deriving Show -data ClassFile = ClassFile { +data ClassFile = ClassFile { constantPool :: [ConstantInfo], accessFlags :: Word16, thisClass :: Word16, @@ -42,66 +44,42 @@ data ClassFile = ClassFile { attributes :: [Attribute] } deriving Show -class Serializable a where +class Serializable a where serialize :: a -> [Word8] instance Serializable ConstantInfo where - serialize :: ConstantInfo -> [Word8] - serialize (ClassInfo nameIndex) = tag_class : unpackWord16 nameIndex - serialize (FieldRefInfo classIndex nameAndTypeIndex) = tag_fieldref : (unpackWord16 classIndex ++ unpackWord16 nameAndTypeIndex) - serialize (MethodRefInfo classIndex nameAndTypeIndex) = tag_methodref : (unpackWord16 classIndex ++ unpackWord16 nameAndTypeIndex) - serialize (NameAndTypeInfo classIndex descriptorIndex) = tag_nameandtype : (unpackWord16 classIndex ++ unpackWord16 descriptorIndex) - serialize (IntegerInfo value) = tag_integer : unpackWord32 (fromIntegral value) - serialize (Utf8Info string) = tag_utf8 : (unpackWord16 num_bytes) ++ bytes where + serialize (ClassInfo nameIndex) = tagClass : unpackWord16 nameIndex + serialize (FieldRefInfo classIndex nameAndTypeIndex) = tagFieldref : (unpackWord16 classIndex ++ unpackWord16 nameAndTypeIndex) + serialize (MethodRefInfo classIndex nameAndTypeIndex) = tagMethodref : (unpackWord16 classIndex ++ unpackWord16 nameAndTypeIndex) + serialize (NameAndTypeInfo classIndex descriptorIndex) = tagNameandtype : (unpackWord16 classIndex ++ unpackWord16 descriptorIndex) + serialize (IntegerInfo value) = tagInteger : unpackWord32 (fromIntegral value) + serialize (Utf8Info string) = tagUtf8 : unpackWord16 num_bytes ++ bytes where bytes = unpack (fromString string) num_bytes = fromIntegral $ length bytes instance Serializable MemberInfo where - serialize :: MemberInfo -> [Word8] serialize member = unpackWord16 (memberAccessFlags member) ++ unpackWord16 (memberNameIndex member) ++ unpackWord16 (memberDescriptorIndex member) ++ unpackWord16 (fromIntegral (length (memberAttributes member))) - ++ concat (map serialize (memberAttributes member)) + ++ concatMap serialize (memberAttributes member) instance Serializable Attribute where - serialize :: Attribute -> [Word8] serialize (Attribute nameIndex bytes) = unpackWord16 nameIndex ++ unpackWord32 (fromIntegral (length bytes)) ++ bytes instance Serializable ClassFile where - serialize :: ClassFile -> [Word8] - serialize classfile = unpackWord32 (fromIntegral 0xC0FEBABE) -- magic - ++ unpackWord16 (fromIntegral 0) -- minor version - ++ unpackWord16 (fromIntegral 49) -- major version + serialize classfile = unpackWord32 0xC0FEBABE -- magic + ++ unpackWord16 0 -- minor version + ++ unpackWord16 49 -- major version ++ unpackWord16 (fromIntegral (1 + length (constantPool classfile))) -- constant pool count - ++ concat (map serialize (constantPool classfile)) -- constant pool + ++ concatMap serialize (constantPool classfile) -- constant pool ++ unpackWord16 (accessFlags classfile) -- access flags ++ unpackWord16 (thisClass classfile) -- this class ++ unpackWord16 (superClass classfile) -- super class - ++ unpackWord16 (fromIntegral 0) -- interface count + ++ unpackWord16 0 -- interface count ++ unpackWord16 (fromIntegral (length (fields classfile))) -- fields count - ++ concat (map serialize (fields classfile)) -- fields info + ++ concatMap serialize (fields classfile) -- fields info ++ unpackWord16 (fromIntegral (length (methods classfile))) -- methods count - ++ concat (map serialize (methods classfile)) -- methods info + ++ concatMap serialize (methods classfile) -- methods info ++ unpackWord16 (fromIntegral (length (attributes classfile))) -- attributes count - ++ concat (map serialize (attributes classfile)) -- attributes info - -example = ClassFile { - constantPool, - accessFlags, - thisClass, - superClass, - fields, - methods, - attributes - } where - constantPool = [] - accessFlags = 1 - thisClass = 0 - superClass = 0 - fields = [] - methods = [] - attributes = [ - Attribute 0x1234 [0, 1, 2, 3], - Attribute 0x2345 [1, 2, 3, 4], - Attribute 0x3456 [2, 3, 4, 5]] + ++ concatMap serialize (attributes classfile) -- attributes info \ No newline at end of file diff --git a/src/ByteCode/ClassFile/Generator.hs b/src/ByteCode/ClassFile/Generator.hs new file mode 100644 index 0000000..9bcbfff --- /dev/null +++ b/src/ByteCode/ClassFile/Generator.hs @@ -0,0 +1 @@ +module ByteCode.ClassFile.Generator where diff --git a/src/ByteUtil.hs b/src/ByteUtil.hs deleted file mode 100644 index 0105edc..0000000 --- a/src/ByteUtil.hs +++ /dev/null @@ -1,19 +0,0 @@ -module ByteUtil(unpackWord16, unpackWord32) where - -import Data.Word -import Data.Int -import Data.Bits - -unpackWord16 :: Word16 -> [Word8] -unpackWord16 v = [ - fromIntegral (shiftR ((.&.) v (fromIntegral 0xFF00)) 8), - fromIntegral (shiftR ((.&.) v (fromIntegral 0x00FF)) 0) - ] - -unpackWord32 :: Word32 -> [Word8] -unpackWord32 v = [ - fromIntegral (shiftR ((.&.) v (fromIntegral 0xFF000000)) 24), - fromIntegral (shiftR ((.&.) v (fromIntegral 0x00FF0000)) 16), - fromIntegral (shiftR ((.&.) v (fromIntegral 0x0000FF00)) 8), - fromIntegral (shiftR ((.&.) v (fromIntegral 0x000000FF)) 0) - ] \ No newline at end of file diff --git a/src/Main.hs b/src/Main.hs index 9b3e8f6..3b01e3c 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,6 +1,6 @@ module Main where -import Parser.Lexer +import Parser.Lexer ( alexScanTokens ) main = do - print $ alexScanTokens "/**/" \ No newline at end of file + print $ alexScanTokens "/**/"