on master help sign in
Loads are invariant
commit1aff4884a9088ed217b10089457da2067991fd11 authorBenjamin Saunders <besaunde@sfu.ca> dateSun 7 Jul 2013, 22:20 (13 years ago) parentc810796
2 files changed+15−12
idris.cabal+1−1 src/IRTS/CodegenLLVM.hs+14−11
idris.cabal+1−1
@@ -272,7 +272,7 @@ Executable idris
272272 haskeline>=0.7, split, directory,
273273 containers, process, transformers, filepath,
274274 directory, binary, bytestring, text, pretty,
275− language-java>=0.2.2, libffi, llvm-general==3.3.3.*,
275+ language-java>=0.2.2, libffi, llvm-general>=3.3.4.1 && <3.3.5,
276276 vector, vector-binary-instances
277277
278278 Extensions: MultiParamTypeClasses, FunctionalDependencies,
src/IRTS/CodegenLLVM.hs+14−11
@@ -396,6 +396,9 @@ sizeOf ty = ConstantOperand . C.PtrToInt
396396 (C.GetElementPtr True (C.Null (PointerType ty (AddrSpace 0))) [C.Int 32 1])
397397 . IntegerType <$> getWordSize
398398
399+loadInv :: Operand -> Instruction
400+loadInv ptr = Load False ptr Nothing 0 [("invariant.load", MetadataNode [])]
401+
399402tgtWordSize :: Target -> Word32
400403tgtWordSize (Target { dataLayout = DataLayout { pointerLayouts = l } }) =
401404 fst . fromJust $ M.lookup (AddrSpace 0) l
@@ -453,7 +456,7 @@ cgExpr (SChkCase inspect alts) = do
453456 terminate $ CondBr isNull endBBN notNullBBN []
454457 newBlock notNullBBN
455458 ptr <- inst $ BitCast val (PointerType (IntegerType 32) (AddrSpace 0)) []
456− flag <- inst $ Load False ptr Nothing 0 []
459+ flag <- inst $ loadInv ptr
457460 isVal <- inst $ ICmp IPred.EQ flag (ConstantOperand (C.Int 32 (-1))) []
458461 conBBN <- getName "constructor"
459462 terminate $ CondBr isVal endBBN conBBN []
@@ -480,7 +483,7 @@ cgExpr (SProj conVar idx) = do
480483 , ConstantOperand (C.Int 32 1)
481484 , ConstantOperand (C.Int 32 (fromIntegral idx))
482485 ] []
483− Just <$> inst (Load False ptr Nothing 0 [])
486+ Just <$> inst (loadInv ptr)
484487cgExpr (SConst c) = Just <$> cgConst c
485488cgExpr (SForeign LANG_C rty fname args) = do
486489 func <- ensureCDecl fname rty (map fst args)
@@ -559,7 +562,7 @@ cgPrimCase caseValPtr defExp alts = do
559562 SConstCase (TT.Ch _) _ -> IntegerType 32
560563 realPtr <- inst $ BitCast caseValPtr (PointerType (primTy caseTy) (AddrSpace 0)) []
561564 valPtr <- inst $ GetElementPtr True realPtr [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] []
562− caseVal <- inst $ Load False valPtr Nothing 0 []
565+ caseVal <- inst $ loadInv valPtr
563566 defBlockName <- getName "default"
564567 exitBlockName <- getName "caseExit"
565568 namedAlts <- mapM (\a -> do n <- nameAlt defBlockName a; return (n, a)) alts
@@ -572,7 +575,7 @@ cgPrimCase caseValPtr defExp alts = do
572575cgConCase :: Operand -> Maybe SExp -> [SAlt] -> Codegen (Maybe Operand)
573576cgConCase con defExp alts = do
574577 tagPtr <- inst $ GetElementPtr True con [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] []
575− tag <- inst $ Load False tagPtr Nothing 0 []
578+ tag <- inst $ loadInv tagPtr
576579 defBlockName <- getName "default"
577580 exitBlockName <- getName "caseExit"
578581 namedAlts <- mapM (\a -> do n <- nameAlt defBlockName a; return (n, a)) alts
@@ -658,7 +661,7 @@ cgAlt initEnv exitBlockName name destr exp = do
658661 do ptr <- inst $ GetElementPtr True con [ ConstantOperand (C.Int 32 0)
659662 , ConstantOperand (C.Int 32 1)
660663 , ConstantOperand (C.Int 32 i)] []
661− Just <$> ninst argName (Load False ptr Nothing 0 [])
664+ Just <$> ninst argName (loadInv ptr)
662665 altVal <- binds locals $ cgExpr exp
663666 altEnv <- gets lexenv
664667 altBlock <- gets currentBlockName
@@ -709,7 +712,7 @@ unbox FUnit x = return x
709712unbox fty bval = do
710713 val <- inst $ BitCast bval (PointerType (primTy (ftyToTy fty)) (AddrSpace 0)) []
711714 fvalptr <- inst $ GetElementPtr True val [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] []
712− inst $ Load False fvalptr Nothing 0 []
715+ inst $ loadInv fvalptr
713716
714717cgConst' :: TT.Const -> C.Constant
715718cgConst' (TT.I i) = C.Int 32 (fromIntegral i)
@@ -961,7 +964,7 @@ cgOp LStrCons [c,s] = do
961964
962965cgOp LStrHead [c] = do
963966 s <- unbox FString c
964− c <- inst $ Load False s Nothing 0 []
967+ c <- inst $ loadInv s
965968 c' <- inst $ ZExt c (IntegerType 32) []
966969 box FChar c'
967970
@@ -969,7 +972,7 @@ cgOp LStrIndex [s, i] = do
969972 ns <- unbox FString s
970973 ni <- unbox (FArith (ATInt (ITFixed IT32))) i
971974 p <- inst $ GetElementPtr True ns [ni] []
972− c <- inst $ Load False p Nothing 0 []
975+ c <- inst $ loadInv p
973976 c' <- inst $ ZExt c (IntegerType 32) []
974977 box FChar c'
975978
@@ -995,15 +998,15 @@ cgOp LReadStr [p] = do
995998
996999cgOp LStdIn [] = do
9971000 stdin <- getStdIn
998− ptr <- inst $ Load False stdin Nothing 0 []
1001+ ptr <- inst $ loadInv stdin
9991002 box FPtr ptr
10001003cgOp LStdOut [] = do
10011004 stdout <- getStdOut
1002− ptr <- inst $ Load False stdout Nothing 0 []
1005+ ptr <- inst $ loadInv stdout
10031006 box FPtr ptr
10041007cgOp LStdErr [] = do
10051008 stdErr <- getStdErr
1006− ptr <- inst $ Load False stdErr Nothing 0 []
1009+ ptr <- inst $ loadInv stdErr
10071010 box FPtr ptr
10081011
10091012cgOp prim args = ierror $ "Unimplemented primitive: [" ++ show prim ++ "]("