llvm-general 3.3.3.0 → 3.3.4.0
raw patch · 8 files changed
+72/−18 lines, 8 files
Files
- llvm-general.cabal +2/−2
- src/LLVM/General/AST/Constant.hs +12/−0
- src/LLVM/General/Internal/Constant.hs +11/−4
- src/LLVM/General/Internal/FFI/BinaryOperator.hs +3/−3
- src/LLVM/General/Internal/FFI/Constant.hs +9/−5
- src/LLVM/General/Internal/FFI/ConstantC.cpp +26/−0
- src/LLVM/General/Internal/Instruction.hs +3/−3
- test/LLVM/General/Test/Constants.hs +6/−1
llvm-general.cabal view
@@ -1,5 +1,5 @@ name: llvm-general-version: 3.3.3.0+version: 3.3.4.0 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet <fgthb0@greynode.net>@@ -34,7 +34,7 @@ type: git location: git://github.com/bscarlet/llvm-general.git branch: llvm-3.3- tag: v3.3.3.0+ tag: v3.3.4.0 flag shared-llvm description: link against llvm shared rather than static library
src/LLVM/General/AST/Constant.hs view
@@ -31,6 +31,8 @@ | BlockAddress { blockAddressFunction :: Name, blockAddressBlock :: Name } | GlobalReference Name | Add { + nsw :: Bool,+ nuw :: Bool, operand0 :: Constant, operand1 :: Constant }@@ -39,6 +41,8 @@ operand1 :: Constant } | Sub {+ nsw :: Bool,+ nuw :: Bool, operand0 :: Constant, operand1 :: Constant }@@ -47,6 +51,8 @@ operand1 :: Constant } | Mul { + nsw :: Bool,+ nuw :: Bool, operand0 :: Constant, operand1 :: Constant }@@ -55,10 +61,12 @@ operand1 :: Constant } | UDiv { + exact :: Bool, operand0 :: Constant, operand1 :: Constant } | SDiv { + exact :: Bool, operand0 :: Constant, operand1 :: Constant }@@ -79,14 +87,18 @@ operand1 :: Constant } | Shl { + nsw :: Bool,+ nuw :: Bool, operand0 :: Constant, operand1 :: Constant } | LShr { + exact :: Bool, operand0 :: Constant, operand1 :: Constant } | AShr { + exact :: Bool, operand0 :: Constant, operand1 :: Constant }
src/LLVM/General/Internal/Constant.hs view
@@ -28,6 +28,7 @@ import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI import qualified LLVM.General.Internal.FFI.User as FFI import qualified LLVM.General.Internal.FFI.Value as FFI+import qualified LLVM.General.Internal.FFI.BinaryOperator as FFI import qualified LLVM.General.AST.Constant as A (Constant) import qualified LLVM.General.AST.Constant as A.C hiding (Constant)@@ -99,23 +100,25 @@ o -> $(do let constExprInfo = ID.outerJoin ID.astConstantRecs (ID.innerJoin ID.astInstructionRecs ID.instructionDefs) TH.caseE [| o |] $ do- (name, (Just (TH.RecC n fs'), instrInfo)) <- Map.toList constExprInfo- let fns = [ TH.mkName . TH.nameBase $ fn | (fn, _, _) <- fs' ]+ (name, (Just (TH.RecC n fs), instrInfo)) <- Map.toList constExprInfo+ let fns = [ TH.mkName . TH.nameBase $ fn | (fn, _, _) <- fs ] coreCall n = TH.dyn $ "FFI.constant" ++ n buildBody c = [ TH.bindS (TH.varP fn) [| encodeM $(TH.varE fn) |] | fn <- fns ] ++ [ TH.noBindS [| liftIO $(foldl TH.appE c (map TH.varE fns)) |] ]+ hasFlags = any (== ''Bool) [ h | (_, _, TH.ConT h) <- fs ] core <- case instrInfo of Just (_, iDef) -> do let opcode = TH.dataToExpQ (const Nothing) (ID.cppOpcode iDef) case ID.instructionKind iDef of- ID.Binary -> return [| $(coreCall "BinaryOperator") $(opcode) |]+ ID.Binary | hasFlags -> return $ coreCall name+ | True -> return [| $(coreCall "BinaryOperator") $(opcode) |] ID.Cast -> return [| $(coreCall "Cast") $(opcode) |] _ -> return $ coreCall name Nothing -> if (name `elem` ["Vector", "Null", "Array", "Undef"]) then return $ coreCall name else [] return $ TH.match- (TH.recP n [(fn,) <$> (TH.varP . TH.mkName . TH.nameBase $ fn) | (fn, _, _) <- fs'])+ (TH.recP n [(fn,) <$> (TH.varP . TH.mkName . TH.nameBase $ fn) | (fn, _, _) <- fs]) (TH.normalB (TH.doE (buildBody core))) [] )@@ -196,6 +199,10 @@ return [| liftIO $ decodeM =<< FFI.getConstantFCmpPredicate c |] | h == ''Bool -> case TH.nameBase fn of "inBounds" -> return [| liftIO $ decodeM =<< FFI.getInBounds v |]+ "exact" -> return [| liftIO $ decodeM =<< FFI.isExact v |]+ "nsw" -> return [| liftIO $ decodeM =<< FFI.hasNoSignedWrap v |]+ "nuw" -> return [| liftIO $ decodeM =<< FFI.hasNoUnsignedWrap v |]+ x -> error $ "constant bool field " ++ show x ++ " not handled yet" TH.AppT TH.ListT (TH.ConT h) | h == ''Word32 -> return [|
src/LLVM/General/Internal/FFI/BinaryOperator.hs view
@@ -22,11 +22,11 @@ Ptr Value -> IO (Ptr BinaryOperator) foreign import ccall unsafe "LLVM_General_HasNoSignedWrap" hasNoSignedWrap ::- Ptr BinaryOperator -> IO LLVMBool+ Ptr Value -> IO LLVMBool foreign import ccall unsafe "LLVM_General_HasNoUnsignedWrap" hasNoUnsignedWrap ::- Ptr BinaryOperator -> IO LLVMBool+ Ptr Value -> IO LLVMBool foreign import ccall unsafe "LLVM_General_IsExact" isExact ::- Ptr BinaryOperator -> IO LLVMBool+ Ptr Value -> IO LLVMBool
src/LLVM/General/Internal/FFI/Constant.hs view
@@ -93,11 +93,15 @@ let tm = fix tm' where tm' _ (TH.ConT h) | h == ''A.C.Constant = [t| Ptr Constant |] tm' x t = typeMappingU x t- - liftM concat $ sequence [ - foreignDecl ("LLVMConst" ++ name) ("constant" ++ name) [tm t | (_, _, t) <- fs ] [t| Ptr Constant |]- | (name, ((TH.RecC _ fs,_), ID.InstructionDef { ID.instructionKind = ID.Other })) <- Map.toList constExprInfo- ]+ liftM concat $ sequence $ do+ (name, ((TH.RecC _ fs,_), ID.InstructionDef { ID.instructionKind = ik })) <- Map.toList constExprInfo+ let hasFlags = any (== ''Bool) [ h | (_, _, TH.ConT h) <- fs ]+ prefix <- case ik of+ ID.Other -> return "LLVM"+ ID.Binary | hasFlags -> return "LLVM_General_"+ _ -> []+ return $+ foreignDecl (prefix ++ "Const" ++ name) ("constant" ++ name) [tm t | (_, _, t) <- fs ] [t| Ptr Constant |] ) foreign import ccall unsafe "LLVMConstGEP" constantGetElementPtr' ::
src/LLVM/General/Internal/FFI/ConstantC.cpp view
@@ -52,6 +52,32 @@ return wrap(ConstantExpr::get(opcode, unwrap<Constant>(o0), unwrap<Constant>(o1))); } +#define LLVM_GENERAL_FOR_EACH_OVERFLOWING_BINARY_OPERATOR(macro) \+ macro(Add) \+ macro(Sub) \+ macro(Mul) \+ macro(Shl)++#define CASE_CODE(op) \+LLVMValueRef LLVM_General_Const ## op(unsigned nsw, unsigned nuw, LLVMValueRef o0, LLVMValueRef o1) { \+ return wrap(ConstantExpr::get ## op(unwrap<Constant>(o0), unwrap<Constant>(o1), nuw != 0, nsw != 0)); \+}+LLVM_GENERAL_FOR_EACH_OVERFLOWING_BINARY_OPERATOR(CASE_CODE)+#undef CASE_CODE++#define LLVM_GENERAL_FOR_EACH_POSSIBLY_EXACT_BINARY_OPERATOR(macro) \+ macro(UDiv) \+ macro(SDiv) \+ macro(LShr) \+ macro(AShr)++#define CASE_CODE(op) \+LLVMValueRef LLVM_General_Const ## op(unsigned isExact, LLVMValueRef o0, LLVMValueRef o1) { \+ return wrap(ConstantExpr::get ## op(unwrap<Constant>(o0), unwrap<Constant>(o1), isExact != 0)); \+}+LLVM_GENERAL_FOR_EACH_POSSIBLY_EXACT_BINARY_OPERATOR(CASE_CODE)+#undef CASE_CODE+ unsigned LLVM_General_GetConstCPPOpcode(LLVMValueRef v) { return unwrap<ConstantExpr>(v)->getOpcode(); }
src/LLVM/General/Internal/Instruction.hs view
@@ -231,9 +231,9 @@ nOps <- liftIO $ FFI.getNumOperands (FFI.upCast i) let op n = decodeM =<< (liftIO $ FFI.getOperand (FFI.upCast i) n) cop n = decodeM =<< (liftIO $ FFI.isAConstant =<< FFI.getOperand (FFI.upCast i) n)- get_nsw b = liftIO $ decodeM =<< FFI.hasNoSignedWrap b- get_nuw b = liftIO $ decodeM =<< FFI.hasNoUnsignedWrap b- get_exact b = liftIO $ decodeM =<< FFI.isExact b+ get_nsw b = liftIO $ decodeM =<< FFI.hasNoSignedWrap (FFI.upCast b)+ get_nuw b = liftIO $ decodeM =<< FFI.hasNoUnsignedWrap (FFI.upCast b)+ get_exact b = liftIO $ decodeM =<< FFI.isExact (FFI.upCast b) n <- liftIO $ FFI.getInstructionDefOpcode i $(
test/LLVM/General/Test/Constants.hs view
@@ -116,8 +116,13 @@ ), ( "binop/cast", IntegerType 64,- C.Add (C.PtrToInt (C.GlobalReference (UnName 1)) (IntegerType 64)) (C.Int 64 2),+ C.Add False False (C.PtrToInt (C.GlobalReference (UnName 1)) (IntegerType 64)) (C.Int 64 2), "global i64 add (i64 ptrtoint (i32* @1 to i64), i64 2)"+ ), (+ "binop/cast nsw",+ IntegerType 64,+ C.Add True False (C.PtrToInt (C.GlobalReference (UnName 1)) (IntegerType 64)) (C.Int 64 2),+ "global i64 add nsw (i64 ptrtoint (i32* @1 to i64), i64 2)" ), ( "icmp", IntegerType 1,