X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FUtilities.hs;h=43e264ce76877fa0b5d3c4fc5f9c10da7803ec35;hb=6eb91f6ec18c7cbfecd62fa80083aa03cecdeae8;hp=565d4b1809528f786a88f57179bdddbf4d443484;hpb=f82dbecc763818452667ac568da96b7c5dd7cc97;p=mate.git diff --git a/Mate/Utilities.hs b/Mate/Utilities.hs index 565d4b1..43e264c 100644 --- a/Mate/Utilities.hs +++ b/Mate/Utilities.hs @@ -1,23 +1,25 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Mate.Utilities where import Data.Word import qualified Data.Map as M +import qualified Data.Set as S import qualified Data.ByteString.Lazy as B import Data.List +import Data.Maybe import JVM.ClassFile import Mate.Types - +import Mate.NativeSizes buildMethodID :: Class Direct -> Word16 -> MethodInfo buildMethodID cls idx = MethodInfo (ntName nt) rc (ntSignature nt) - where (rc, nt) = case constsPool cls M.! idx of - (CMethod rc' nt') -> (rc', nt') - (CIfaceMethod rc' nt') -> (rc', nt') - _ -> error "buildMethodID: something wrong. abort." + where + (rc, nt) = case constsPool cls M.! idx of + (CMethod rc' nt') -> (rc', nt') + (CIfaceMethod rc' nt') -> (rc', nt') + _ -> error "buildMethodID: something wrong. abort." buildStaticFieldID :: Class Direct -> Word16 -> StaticFieldInfo buildStaticFieldID cls idx = StaticFieldInfo rc (ntName fnt) @@ -31,14 +33,16 @@ buildClassID :: Class Direct -> Word16 -> B.ByteString buildClassID cls idx = cl where (CClass cl) = constsPool cls M.! idx -methodGetArgsCount :: Class Direct -> Word16 -> Word32 -methodGetArgsCount cls idx = fromIntegral $ length args - where - nt = case constsPool cls M.! idx of - (CMethod _ nt') -> nt' - (CIfaceMethod _ nt') -> nt' - _ -> error "methodGetArgsCount: something wrong. abort." - (MethodSignature args _) = ntSignature nt + +methodNameTypeByIdx :: Class Direct -> Word16 -> NameType (Method Direct) +methodNameTypeByIdx cls idx = case constsPool cls M.! idx of + (CMethod _ nt') -> nt' + (CIfaceMethod _ nt') -> nt' + _ -> error "methodGetArgsCount: something wrong. abort." + +methodGetArgsCount :: NameType (Method Direct) -> NativeWord +methodGetArgsCount nt = genericLength args + where (MethodSignature args _) = ntSignature nt -- TODO(bernhard): Extend it to more than just int, and provide typeinformation methodHaveReturnValue :: Class Direct -> Word16 -> Bool @@ -51,11 +55,18 @@ methodHaveReturnValue cls idx = case ret of (Returns (ObjectType _)) -> True; _ -> error $ "methodHaveReturnValue: todo: " ++ show ret where - nt = case constsPool cls M.! idx of - (CMethod _ nt') -> nt' - (CIfaceMethod _ nt') -> nt' - _ -> error "methodHaveReturnValue: something wrong. abort." - (MethodSignature _ ret) = ntSignature nt + nt = case constsPool cls M.! idx of + (CMethod _ nt') -> nt' + (CIfaceMethod _ nt') -> nt' + _ -> error "methodHaveReturnValue: something wrong. abort." + (MethodSignature _ ret) = ntSignature nt + +methodInfoToMethod :: MethodInfo -> Class Direct -> Method Direct +methodInfoToMethod mi cls = + fromJust $ lookupMethodSig (methName mi) (methSignature mi) cls + +methodIsStatic :: Method Direct -> Bool +methodIsStatic = S.member ACC_STATIC . methodAccessFlags lookupMethodSig :: B.ByteString -> MethodSignature -> Class Direct -> Maybe (Method Direct) lookupMethodSig name sig cls =