@@ -161,6 +161,7 @@ initDefs tgt =
161161 -- , exfun "llvm.llvm.memcpy.p0i8.p0i8.i32" VoidType [ptrI8, ptrI8, IntegerType 32, IntegerType 32, IntegerType 1] False
162162 -- , exfun "llvm.llvm.memcpy.p0i8.p0i8.i64" VoidType [ptrI8, ptrI8, IntegerType 64, IntegerType 32, IntegerType 1] False
163163 , exfun "memcpy" ptrI8 [ptrI8, ptrI8, intPtr] False
164+ , exfun "llvm.invariant.start" (PointerType (StructureType False []) (AddrSpace 0)) [IntegerType 64, ptrI8] False
164165 , exfun "snprintf" (IntegerType 32) [ptrI8, intPtr, ptrI8] True
165166 , exfun "strcmp" (IntegerType 32) [ptrI8, ptrI8] False
166167 , exfun "strlen" intPtr [ptrI8] False
@@ -395,6 +396,9 @@ sizeOf ty = ConstantOperand . C.PtrToInt
395396 (C.GetElementPtr True (C.Null (PointerType ty (AddrSpace 0))) [C.Int 32 1])
396397 . IntegerType <$> getWordSize
397398
399+loadInv :: Operand -> Instruction
400+loadInv ptr = Load False ptr Nothing 0 [("invariant.load", MetadataNode [])]
401+
398402tgtWordSize :: Target -> Word32
399403tgtWordSize (Target { dataLayout = DataLayout { pointerLayouts = l } }) =
400404 fst . fromJust $ M.lookup (AddrSpace 0) l
@@ -423,7 +427,8 @@ cgExpr (SCon tag name args) = do
423427 case sequence argSlots of
424428 Nothing -> return Nothing
425429 Just argVals -> do
426− con <- alloc . conType . fromIntegral . length $ argVals
430+ let ty = conType . fromIntegral . length $ argVals
431+ con <- alloc ty
427432 tagPtr <- inst $ GetElementPtr True con [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] []
428433 inst' $ Store False tagPtr (ConstantOperand (C.Int 32 (fromIntegral tag))) Nothing 0 []
429434 forM_ (zip argVals [0..]) $ \(arg, i) -> do
@@ -431,6 +436,8 @@ cgExpr (SCon tag name args) = do
431436 , ConstantOperand (C.Int 32 1)
432437 , ConstantOperand (C.Int 32 i)] []
433438 inst' $ Store False ptr arg Nothing 0 []
439+ ptrI8 <- inst $ BitCast con (PointerType (IntegerType 8) (AddrSpace 0)) []
440+ inst' $ simpleCall "llvm.invariant.start" [ConstantOperand $ C.Int 64 (-1), ptrI8]
434441 Just <$> inst (BitCast con (PointerType valueType (AddrSpace 0)) [])
435442cgExpr (SCase inspect alts) = do
436443 val <- var inspect
@@ -449,7 +456,7 @@ cgExpr (SChkCase inspect alts) = do
449456 terminate $ CondBr isNull endBBN notNullBBN []
450457 newBlock notNullBBN
451458 ptr <- inst $ BitCast val (PointerType (IntegerType 32) (AddrSpace 0)) []
452− flag <- inst $ Load False ptr Nothing 0 []
459+ flag <- inst $ loadInv ptr
453460 isVal <- inst $ ICmp IPred.EQ flag (ConstantOperand (C.Int 32 (-1))) []
454461 conBBN <- getName "constructor"
455462 terminate $ CondBr isVal endBBN conBBN []
@@ -476,7 +483,7 @@ cgExpr (SProj conVar idx) = do
476483 , ConstantOperand (C.Int 32 1)
477484 , ConstantOperand (C.Int 32 (fromIntegral idx))
478485 ] []
479− Just <$> inst (Load False ptr Nothing 0 [])
486+ Just <$> inst (loadInv ptr)
480487cgExpr (SConst c) = Just <$> cgConst c
481488cgExpr (SForeign LANG_C rty fname args) = do
482489 func <- ensureCDecl fname rty (map fst args)
@@ -555,7 +562,7 @@ cgPrimCase caseValPtr defExp alts = do
555562 SConstCase (TT.Ch _) _ -> IntegerType 32
556563 realPtr <- inst $ BitCast caseValPtr (PointerType (primTy caseTy) (AddrSpace 0)) []
557564 valPtr <- inst $ GetElementPtr True realPtr [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] []
558− caseVal <- inst $ Load False valPtr Nothing 0 []
565+ caseVal <- inst $ loadInv valPtr
559566 defBlockName <- getName "default"
560567 exitBlockName <- getName "caseExit"
561568 namedAlts <- mapM (\a -> do n <- nameAlt defBlockName a; return (n, a)) alts
@@ -568,7 +575,7 @@ cgPrimCase caseValPtr defExp alts = do
568575cgConCase :: Operand -> Maybe SExp -> [SAlt] -> Codegen (Maybe Operand)
569576cgConCase con defExp alts = do
570577 tagPtr <- inst $ GetElementPtr True con [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] []
571− tag <- inst $ Load False tagPtr Nothing 0 []
578+ tag <- inst $ loadInv tagPtr
572579 defBlockName <- getName "default"
573580 exitBlockName <- getName "caseExit"
574581 namedAlts <- mapM (\a -> do n <- nameAlt defBlockName a; return (n, a)) alts
@@ -654,7 +661,7 @@ cgAlt initEnv exitBlockName name destr exp = do
654661 do ptr <- inst $ GetElementPtr True con [ ConstantOperand (C.Int 32 0)
655662 , ConstantOperand (C.Int 32 1)
656663 , ConstantOperand (C.Int 32 i)] []
657− Just <$> ninst argName (Load False ptr Nothing 0 [])
664+ Just <$> ninst argName (loadInv ptr)
658665 altVal <- binds locals $ cgExpr exp
659666 altEnv <- gets lexenv
660667 altBlock <- gets currentBlockName
@@ -690,11 +697,14 @@ nameAlt _ (SConstCase const _) = getName (show const)
690697box :: FType -> Operand -> Codegen Operand
691698box FUnit _ = return $ ConstantOperand nullValue
692699box fty fval = do
693− val <- alloc (primTy (ftyToTy fty))
700+ let ty = primTy (ftyToTy fty)
701+ val <- alloc ty
694702 tagptr <- inst $ GetElementPtr True val [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] []
695703 valptr <- inst $ GetElementPtr True val [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] []
696704 inst' $ Store False tagptr (ConstantOperand (C.Int 32 (-1))) Nothing 0 []
697705 inst' $ Store False valptr fval Nothing 0 []
706+ ptrI8 <- inst $ BitCast val (PointerType (IntegerType 8) (AddrSpace 0)) []
707+ inst' $ simpleCall "llvm.invariant.start" [ConstantOperand $ C.Int 64 (-1), ptrI8]
698708 inst $ BitCast val (PointerType valueType (AddrSpace 0)) []
699709
700710unbox :: FType -> Operand -> Codegen Operand
@@ -702,7 +712,7 @@ unbox FUnit x = return x
702712unbox fty bval = do
703713 val <- inst $ BitCast bval (PointerType (primTy (ftyToTy fty)) (AddrSpace 0)) []
704714 fvalptr <- inst $ GetElementPtr True val [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] []
705− inst $ Load False fvalptr Nothing 0 []
715+ inst $ loadInv fvalptr
706716
707717cgConst' :: TT.Const -> C.Constant
708718cgConst' (TT.I i) = C.Int 32 (fromIntegral i)
@@ -955,7 +965,7 @@ cgOp LStrCons [c,s] = do
955965
956966cgOp LStrHead [c] = do
957967 s <- unbox FString c
958− c <- inst $ Load False s Nothing 0 []
968+ c <- inst $ loadInv s
959969 c' <- inst $ ZExt c (IntegerType 32) []
960970 box (FArith (ATInt ITChar)) c'
961971
@@ -963,7 +973,7 @@ cgOp LStrIndex [s, i] = do
963973 ns <- unbox FString s
964974 ni <- unbox (FArith (ATInt (ITFixed IT32))) i
965975 p <- inst $ GetElementPtr True ns [ni] []
966− c <- inst $ Load False p Nothing 0 []
976+ c <- inst $ loadInv p
967977 c' <- inst $ ZExt c (IntegerType 32) []
968978 box (FArith (ATInt ITChar)) c'
969979
@@ -989,15 +999,15 @@ cgOp LReadStr [p] = do
989999
9901000cgOp LStdIn [] = do
9911001 stdin <- getStdIn
992− ptr <- inst $ Load False stdin Nothing 0 []
1002+ ptr <- inst $ loadInv stdin
9931003 box FPtr ptr
9941004cgOp LStdOut [] = do
9951005 stdout <- getStdOut
996− ptr <- inst $ Load False stdout Nothing 0 []
1006+ ptr <- inst $ loadInv stdout
9971007 box FPtr ptr
9981008cgOp LStdErr [] = do
9991009 stdErr <- getStdErr
1000− ptr <- inst $ Load False stdErr Nothing 0 []
1010+ ptr <- inst $ loadInv stdErr
10011011 box FPtr ptr
10021012
10031013cgOp prim args = ierror $ "Unimplemented primitive: [" ++ show prim ++ "]("