on master help sign in
Use atomic allocations when safe in LLVM codegen.

This reduces the amount of memory Boehm has to scan.

commit2f8a33a406d63e2270b283c46c8f7101309b389d authorBenjamin Saunders <besaunde@sfu.ca> dateFri 16 Aug 2013, 15:53 (13 years ago) parent3aa61b3
1 file changed+13−4
src/IRTS/CodegenLLVM.hs+13−4
src/IRTS/CodegenLLVM.hs+13−4
@@ -389,8 +389,8 @@ replaceElt n val (x:xs) = x : replaceElt (n-1) val xs
389389alloc' :: Operand -> Codegen Operand
390390alloc' size = inst $ simpleCall "GC_malloc" [size]
391391
392−allocAtomic :: Operand -> Codegen Operand
393−allocAtomic size = inst $ simpleCall "GC_malloc_atomic" [size]
392+allocAtomic' :: Operand -> Codegen Operand
393+allocAtomic' size = inst $ simpleCall "GC_malloc_atomic" [size]
394394
395395alloc :: Type -> Codegen Operand
396396alloc ty = do
@@ -398,6 +398,12 @@ alloc ty = do
398398 mem <- alloc' size
399399 inst $ BitCast mem (PointerType ty (AddrSpace 0)) []
400400
401+allocAtomic :: Type -> Codegen Operand
402+allocAtomic ty = do
403+ size <- sizeOf ty
404+ mem <- allocAtomic' size
405+ inst $ BitCast mem (PointerType ty (AddrSpace 0)) []
406+
401407sizeOf :: Type -> Codegen Operand
402408sizeOf ty = ConstantOperand . C.PtrToInt
403409 (C.GetElementPtr True (C.Null (PointerType ty (AddrSpace 0))) [C.Int 32 1])
@@ -701,11 +707,14 @@ nameAlt d (SDefaultCase _) = return d
701707nameAlt _ (SConCase _ _ name _ _) = getName (show name)
702708nameAlt _ (SConstCase const _) = getName (show const)
703709
710+isHeapFTy :: FType -> Bool
711+isHeapFTy f = elem f [FString, FPtr, FAny, FArith (ATInt ITBig)]
712+
704713box :: FType -> Operand -> Codegen Operand
705714box FUnit _ = return $ ConstantOperand nullValue
706715box fty fval = do
707716 let ty = primTy (ftyToTy fty)
708− val <- alloc ty
717+ val <- if isHeapFTy fty then alloc ty else allocAtomic ty
709718 tagptr <- inst $ GetElementPtr True val [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] []
710719 valptr <- inst $ GetElementPtr True val [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] []
711720 inst' $ Store False tagptr (ConstantOperand (C.Int 32 (-1))) Nothing 0 []
@@ -1076,7 +1085,7 @@ cgStrCat x y = do
10761085 zlen <- inst $ Add False True xlen ylen []
10771086 ws <- getWordSize
10781087 total <- inst $ Add False True zlen (ConstantOperand (C.Int ws 1)) []
1079− mem <- allocAtomic total
1088+ mem <- allocAtomic' total
10801089 inst $ simpleCall "memcpy" [mem, x', xlen]
10811090 i <- inst $ PtrToInt mem (IntegerType ws) []
10821091 offi <- inst $ Add False True i xlen []