git.iko.soy/Idris-dev
on master help sign in
Merge pull request #455 from Ralith/atomic-allocs
417f040Edwin Brady
src/IRTS/CodegenLLVM.hs+13−4
compare with master
unifiedsplit
@@ -389,8 +389,8 @@ replaceElt n val (x:xs) = x : replaceElt (n-1) val xs
389alloc' :: Operand -> Codegen Operand
389alloc' :: Operand -> Codegen Operand
390alloc' size = inst $ simpleCall "GC_malloc" [size]
390alloc' size = inst $ simpleCall "GC_malloc" [size]
391
391
392−allocAtomic :: Operand -> Codegen Operand
392+allocAtomic' :: Operand -> Codegen Operand
393−allocAtomic size = inst $ simpleCall "GC_malloc_atomic" [size]
393+allocAtomic' size = inst $ simpleCall "GC_malloc_atomic" [size]
394
394
395alloc :: Type -> Codegen Operand
395alloc :: Type -> Codegen Operand
396alloc ty = do
396alloc ty = do
@@ -398,6 +398,12 @@ alloc ty = do
398 mem <- alloc' size
398 mem <- alloc' size
399 inst $ BitCast mem (PointerType ty (AddrSpace 0)) []
399 inst $ BitCast mem (PointerType ty (AddrSpace 0)) []
400
400
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+
401sizeOf :: Type -> Codegen Operand
407sizeOf :: Type -> Codegen Operand
402sizeOf ty = ConstantOperand . C.PtrToInt
408sizeOf ty = ConstantOperand . C.PtrToInt
403 (C.GetElementPtr True (C.Null (PointerType ty (AddrSpace 0))) [C.Int 32 1])
409 (C.GetElementPtr True (C.Null (PointerType ty (AddrSpace 0))) [C.Int 32 1])
@@ -701,11 +707,14 @@ nameAlt d (SDefaultCase _) = return d
701nameAlt _ (SConCase _ _ name _ _) = getName (show name)
707nameAlt _ (SConCase _ _ name _ _) = getName (show name)
702nameAlt _ (SConstCase const _) = getName (show const)
708nameAlt _ (SConstCase const _) = getName (show const)
703
709
710+isHeapFTy :: FType -> Bool
711+isHeapFTy f = elem f [FString, FPtr, FAny, FArith (ATInt ITBig)]
712+
704box :: FType -> Operand -> Codegen Operand
713box :: FType -> Operand -> Codegen Operand
705box FUnit _ = return $ ConstantOperand nullValue
714box FUnit _ = return $ ConstantOperand nullValue
706box fty fval = do
715box fty fval = do
707 let ty = primTy (ftyToTy fty)
716 let ty = primTy (ftyToTy fty)
708− val <- alloc ty
717+ val <- if isHeapFTy fty then alloc ty else allocAtomic ty
709 tagptr <- inst $ GetElementPtr True val [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] []
718 tagptr <- inst $ GetElementPtr True val [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] []
710 valptr <- inst $ GetElementPtr True val [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] []
719 valptr <- inst $ GetElementPtr True val [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] []
711 inst' $ Store False tagptr (ConstantOperand (C.Int 32 (-1))) Nothing 0 []
720 inst' $ Store False tagptr (ConstantOperand (C.Int 32 (-1))) Nothing 0 []
@@ -1076,7 +1085,7 @@ cgStrCat x y = do
1076 zlen <- inst $ Add False True xlen ylen []
1085 zlen <- inst $ Add False True xlen ylen []
1077 ws <- getWordSize
1086 ws <- getWordSize
1078 total <- inst $ Add False True zlen (ConstantOperand (C.Int ws 1)) []
1087 total <- inst $ Add False True zlen (ConstantOperand (C.Int ws 1)) []
1079− mem <- allocAtomic total
1088+ mem <- allocAtomic' total
1080 inst $ simpleCall "memcpy" [mem, x', xlen]
1089 inst $ simpleCall "memcpy" [mem, x', xlen]
1081 i <- inst $ PtrToInt mem (IntegerType ws) []
1090 i <- inst $ PtrToInt mem (IntegerType ws) []
1082 offi <- inst $ Add False True i xlen []
1091 offi <- inst $ Add False True i xlen []