1aff488 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Loads are invariant

1aff488Benjamin Saunders13 years ago

idris.cabal+1−1

compare with master

unifiedsplit

@@ -272,7 +272,7 @@ Executable idris

272 haskeline>=0.7, split, directory,

273 containers, process, transformers, filepath,

274 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,

276 vector, vector-binary-instances

277

278 Extensions: MultiParamTypeClasses, FunctionalDependencies,

src/IRTS/CodegenLLVM.hs+14−11

@@ -396,6 +396,9 @@ sizeOf ty = ConstantOperand . C.PtrToInt

396 (C.GetElementPtr True (C.Null (PointerType ty (AddrSpace 0))) [C.Int 32 1])

397 . IntegerType <$> getWordSize

398

399+loadInv :: Operand -> Instruction

400+loadInv ptr = Load False ptr Nothing 0 [("invariant.load", MetadataNode [])]

401+

399tgtWordSize :: Target -> Word32

402tgtWordSize :: Target -> Word32

400tgtWordSize (Target { dataLayout = DataLayout { pointerLayouts = l } }) =

403tgtWordSize (Target { dataLayout = DataLayout { pointerLayouts = l } }) =

401 fst . fromJust $ M.lookup (AddrSpace 0) l

404 fst . fromJust $ M.lookup (AddrSpace 0) l

@@ -453,7 +456,7 @@ cgExpr (SChkCase inspect alts) = do

453 terminate $ CondBr isNull endBBN notNullBBN []

456 terminate $ CondBr isNull endBBN notNullBBN []

454 newBlock notNullBBN

457 newBlock notNullBBN

455 ptr <- inst $ BitCast val (PointerType (IntegerType 32) (AddrSpace 0)) []

458 ptr <- inst $ BitCast val (PointerType (IntegerType 32) (AddrSpace 0)) []

456− flag <- inst $ Load False ptr Nothing 0 []

459+ flag <- inst $ loadInv ptr

457 isVal <- inst $ ICmp IPred.EQ flag (ConstantOperand (C.Int 32 (-1))) []

460 isVal <- inst $ ICmp IPred.EQ flag (ConstantOperand (C.Int 32 (-1))) []

458 conBBN <- getName "constructor"

461 conBBN <- getName "constructor"

459 terminate $ CondBr isVal endBBN conBBN []

462 terminate $ CondBr isVal endBBN conBBN []

@@ -480,7 +483,7 @@ cgExpr (SProj conVar idx) = do

480 , ConstantOperand (C.Int 32 1)

483 , ConstantOperand (C.Int 32 1)

481 , ConstantOperand (C.Int 32 (fromIntegral idx))

484 , ConstantOperand (C.Int 32 (fromIntegral idx))

482 ] []

485 ] []

483− Just <$> inst (Load False ptr Nothing 0 [])

486+ Just <$> inst (loadInv ptr)

484cgExpr (SConst c) = Just <$> cgConst c

487cgExpr (SConst c) = Just <$> cgConst c

485cgExpr (SForeign LANG_C rty fname args) = do

488cgExpr (SForeign LANG_C rty fname args) = do

486 func <- ensureCDecl fname rty (map fst args)

489 func <- ensureCDecl fname rty (map fst args)

@@ -559,7 +562,7 @@ cgPrimCase caseValPtr defExp alts = do

559 SConstCase (TT.Ch _) _ -> IntegerType 32

562 SConstCase (TT.Ch _) _ -> IntegerType 32

560 realPtr <- inst $ BitCast caseValPtr (PointerType (primTy caseTy) (AddrSpace 0)) []

563 realPtr <- inst $ BitCast caseValPtr (PointerType (primTy caseTy) (AddrSpace 0)) []

561 valPtr <- inst $ GetElementPtr True realPtr [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] []

564 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

563 defBlockName <- getName "default"

566 defBlockName <- getName "default"

564 exitBlockName <- getName "caseExit"

567 exitBlockName <- getName "caseExit"

565 namedAlts <- mapM (\a -> do n <- nameAlt defBlockName a; return (n, a)) alts

568 namedAlts <- mapM (\a -> do n <- nameAlt defBlockName a; return (n, a)) alts

@@ -572,7 +575,7 @@ cgPrimCase caseValPtr defExp alts = do

572cgConCase :: Operand -> Maybe SExp -> [SAlt] -> Codegen (Maybe Operand)

575cgConCase :: Operand -> Maybe SExp -> [SAlt] -> Codegen (Maybe Operand)

573cgConCase con defExp alts = do

576cgConCase con defExp alts = do

574 tagPtr <- inst $ GetElementPtr True con [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] []

577 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

576 defBlockName <- getName "default"

579 defBlockName <- getName "default"

577 exitBlockName <- getName "caseExit"

580 exitBlockName <- getName "caseExit"

578 namedAlts <- mapM (\a -> do n <- nameAlt defBlockName a; return (n, a)) alts

581 namedAlts <- mapM (\a -> do n <- nameAlt defBlockName a; return (n, a)) alts

@@ -658,7 +661,7 @@ cgAlt initEnv exitBlockName name destr exp = do

658 do ptr <- inst $ GetElementPtr True con [ ConstantOperand (C.Int 32 0)

661 do ptr <- inst $ GetElementPtr True con [ ConstantOperand (C.Int 32 0)

659 , ConstantOperand (C.Int 32 1)

662 , ConstantOperand (C.Int 32 1)

660 , ConstantOperand (C.Int 32 i)] []

663 , ConstantOperand (C.Int 32 i)] []

661− Just <$> ninst argName (Load False ptr Nothing 0 [])

664+ Just <$> ninst argName (loadInv ptr)

662 altVal <- binds locals $ cgExpr exp

665 altVal <- binds locals $ cgExpr exp

663 altEnv <- gets lexenv

666 altEnv <- gets lexenv

664 altBlock <- gets currentBlockName

667 altBlock <- gets currentBlockName

@@ -709,7 +712,7 @@ unbox FUnit x = return x

709unbox fty bval = do

712unbox fty bval = do

710 val <- inst $ BitCast bval (PointerType (primTy (ftyToTy fty)) (AddrSpace 0)) []

713 val <- inst $ BitCast bval (PointerType (primTy (ftyToTy fty)) (AddrSpace 0)) []

711 fvalptr <- inst $ GetElementPtr True val [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] []

714 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

713

716

714cgConst' :: TT.Const -> C.Constant

717cgConst' :: TT.Const -> C.Constant

715cgConst' (TT.I i) = C.Int 32 (fromIntegral i)

718cgConst' (TT.I i) = C.Int 32 (fromIntegral i)

@@ -961,7 +964,7 @@ cgOp LStrCons [c,s] = do

961

964

962cgOp LStrHead [c] = do

965cgOp LStrHead [c] = do

963 s <- unbox FString c

966 s <- unbox FString c

964− c <- inst $ Load False s Nothing 0 []

967+ c <- inst $ loadInv s

965 c' <- inst $ ZExt c (IntegerType 32) []

968 c' <- inst $ ZExt c (IntegerType 32) []

966 box FChar c'

969 box FChar c'

967

970

@@ -969,7 +972,7 @@ cgOp LStrIndex [s, i] = do

969 ns <- unbox FString s

972 ns <- unbox FString s

970 ni <- unbox (FArith (ATInt (ITFixed IT32))) i

973 ni <- unbox (FArith (ATInt (ITFixed IT32))) i

971 p <- inst $ GetElementPtr True ns [ni] []

974 p <- inst $ GetElementPtr True ns [ni] []

972− c <- inst $ Load False p Nothing 0 []

975+ c <- inst $ loadInv p

973 c' <- inst $ ZExt c (IntegerType 32) []

976 c' <- inst $ ZExt c (IntegerType 32) []

974 box FChar c'

977 box FChar c'

975

978

@@ -995,15 +998,15 @@ cgOp LReadStr [p] = do

995

998

996cgOp LStdIn [] = do

999cgOp LStdIn [] = do

997 stdin <- getStdIn

1000 stdin <- getStdIn

998− ptr <- inst $ Load False stdin Nothing 0 []

1001+ ptr <- inst $ loadInv stdin

999 box FPtr ptr

1002 box FPtr ptr

1000cgOp LStdOut [] = do

1003cgOp LStdOut [] = do

1001 stdout <- getStdOut

1004 stdout <- getStdOut

1002− ptr <- inst $ Load False stdout Nothing 0 []

1005+ ptr <- inst $ loadInv stdout

1003 box FPtr ptr

1006 box FPtr ptr

1004cgOp LStdErr [] = do

1007cgOp LStdErr [] = do

1005 stdErr <- getStdErr

1008 stdErr <- getStdErr

1006− ptr <- inst $ Load False stdErr Nothing 0 []

1009+ ptr <- inst $ loadInv stdErr

1007 box FPtr ptr

1010 box FPtr ptr

1008

1011

1009cgOp prim args = ierror $ "Unimplemented primitive: [" ++ show prim ++ "]("

1012cgOp prim args = ierror $ "Unimplemented primitive: [" ++ show prim ++ "]("