diff --git a/src/s2/base/Data/CompactRegion.ds b/src/s2/base/Data/CompactRegion.ds index 3e8015cb1..282e32ef1 100644 --- a/src/s2/base/Data/CompactRegion.ds +++ b/src/s2/base/Data/CompactRegion.ds @@ -1,30 +1,43 @@ module Data.CompactRegion -export { allocCR; storeCR; deleteCR } +export { allocCR; storeCR; storeCRIgnoreRef; deleteCR; allocTestRaw } import Data.Numeric import foreign boxed type CR : Region -> Data + import foreign c value - ddcPrimCompactRegionAlloc : {@r : Region} -> Nat -> S (Alloc r) (CR r) - ddcPrimCompactRegionStore : {@r : Region} -> {@a: Data} -> CR r-> a -> S (Write r) a + ddcPrimCompactRegionAlloc : {@r : Region} -> Unit -> S (Alloc r) (CR r) + ddcPrimCompactRegionStore : {@r : Region} -> {@a: Data} -> CR r-> a -> Bool# -> S (Write r) a ddcPrimCompactRegionMarkDead : {@r : Region} -> CR r -> S (Write r) Unit + ddcPrimVectorAlloc8 : {@r : Region} -> Nat# -> S (Alloc r + Write r) (Vector# r Word8#) + where allocCR {@r : Region} - (x : Nat) + (u : Unit) : S (Alloc r) (CR r) - = ddcPrimCompactRegionAlloc {@r} x + = ddcPrimCompactRegionAlloc {@r} () storeCR {@r : Region} {@a: Data} (cr : CR r) (x: a) : S (Write r) a - = ddcPrimCompactRegionStore {@r} cr x + = ddcPrimCompactRegionStore {@r} cr x False + +storeCRIgnoreRef {@r : Region} {@a: Data} + (cr : CR r) (x: a) + : S (Write r) a + = ddcPrimCompactRegionStore {@r} cr x True deleteCR {@r : Region} (x : CR r) : S (Write r) Unit = ddcPrimCompactRegionMarkDead {@r} x + +allocTestRaw {@r : Region} + (size : Nat#) + : S (Alloc r + Write r) (Vector# r Word8#) + = ddcPrimVectorAlloc8 {@r} size \ No newline at end of file diff --git a/src/s2/ddc-runtime/salt/runtime/Collect.dcs b/src/s2/ddc-runtime/salt/runtime/Collect.dcs index 4393ed331..7b0f947ea 100644 --- a/src/s2/ddc-runtime/salt/runtime/Collect.dcs +++ b/src/s2/ddc-runtime/salt/runtime/Collect.dcs @@ -53,6 +53,20 @@ import foreign c value ddcPrimStdoutPutString : TextLit# -> Void# ddcPrimStdoutPutAddr : Addr# -> Void# + ddcPrimStderrPutAddr : Addr# -> Void# + ddcPrimStderrPutNat : Nat# -> Void# + + ddcCompactRegionDebugPrint : TextLit# -> Unit + ddcPrintCompactRegionHeader : Addr# -> Unit + ddcCompactRegionDebug : Unit -> Bool# + + ddcCompactRegionDestroy : Addr# -> Unit + ddcCompactRegionGetNext : Addr# -> Addr# + ddcCompactRegionGetRefList : Addr# -> Addr# + ddcCompactRegionGetTail : Addr# -> Addr# + ddcCompactRegionGetData : Addr# -> Addr# + traceCR : Addr# -> Unit + with letrec @@ -92,6 +106,7 @@ ddcCollectHeap aBackBase' = read# [Addr#] aaBackBase 0# write# aaBackTop 0# aBackBase' + -- ddcCompactRegionDebugPrint "root\n"# -- Evacuate all the root objects to the to-space. ddcEvacuateRoots aRootStart @@ -99,11 +114,20 @@ ddcCollectHeap aaBackTop (read# aaBackMax 0#) + -- after LLVM root, directly scan compact region root + -- ddcCompactRegionDebugPrint "table\n"# + + ddcScanCompactRegionTable aaBackTop + + -- ddcCompactRegionDebugPrint "heap\n"# + -- Recursively follow pointers in to-space, -- copying out any reachable objects from the from-space. ddcScanHeap aaBackTop (read# aaBackBase 0#) + + -- ddcCompactRegionDebugPrint "Swap\n"# -- Flip the front and back heaps. aHeapBase = read# [Addr#] aaHeapBase 0# @@ -122,10 +146,14 @@ ddcCollectHeap write# [Addr#] aaBackTop 0# aHeapTop write# [Addr#] aaBackMax 0# aHeapMax + -- ddcCompactRegionDebugPrint "CR\n"# + -- collect compact regions ddcCollectCompactRegionTable (read# [Addr#] (global# [Addr#] "ddcCRTableBase"#) 0#) (read# [Addr#] (global# [Addr#] "ddcCRTableMax"#) 0#) + + -- ddcCompactRegionDebugPrint "end\n"# ddcStatsOnGCEnd () () @@ -210,12 +238,89 @@ ddcEvacuateRoot -- Evacuate an object, returning its new address in the to-space. aObjNew = ddcEvacuateObject aaBackTop aObj + -- ddcCompactRegionDebugPrint "root slot update| "# + -- ddcPrimStderrPutAddr aaObj + -- ddcCompactRegionDebugPrint " ["# + -- ddcPrimStderrPutAddr (read# aaObj 0#) + -- ddcCompactRegionDebugPrint " -> "# + -- ddcPrimStderrPutAddr aObjNew + -- ddcCompactRegionDebugPrint "] "# + -- ddcCompactRegionDebugPrint "\n"# + -- Update the slot entry to point to the new location. write# aaObj 0# aObjNew - () + + + + + +-- | Scan the compact region RefList header +-- trace object in the RefList, copy objects on the heap to the back-heap +-- as root objects +ddcScanCompactRegionTable + (aaBackTop : Addr#) + : Unit + = do + tableBase = read# [Addr#] (global# [Addr#] "ddcCRTableBase"#) 0# + tableMax = read# [Addr#] (global# [Addr#] "ddcCRTableMax"#) 0# + ddcScanCompactRegionTable_iter aaBackTop tableBase tableMax + + +ddcScanCompactRegionTable_iter + (aaBackTop : Addr#) + (curr : Addr#) + (max : Addr#) + : Unit + = do + case ge# curr max of + True# -> () + False# -> do rawBase = read# [Addr#] curr 0# + case ddcCompactRegionIsLive rawBase of + -- not live, skip + False# -> do ddcScanCompactRegionTable_iter aaBackTop (plusAddr# curr 8#) max + True# -> do ddcCompactRegionDebugPrint "GC| CR| Enter "# + ddcPrintCompactRegionHeader rawBase + -- traceCR rawBase + refList = ddcCompactRegionGetRefList rawBase + refListTail = ddcCompactRegionGetTail refList + (case eq# refListTail refList of + True# -> () + False# -> ddcScanCompactRegionObjectRoot aaBackTop (ddcCompactRegionGetNext refList) refListTail) + ddcScanCompactRegionTable_iter aaBackTop (plusAddr# curr 8#) max + + + +ddcScanCompactRegionObjectRoot + (aaBackTop : Addr#) + (refListCurr : Addr#) + (refListTail : Addr#) + : Unit + = do refObj = ddcCompactRegionGetData refListCurr + -- actualObjAddr = ddcBoxedGetField refObj 0# + objInCR = (read# refObj 0#) + -- (case ddcCompactRegionDebug () of + -- True# -> do ddcCompactRegionDebugPrint "GC| Ref| Found "# + -- ddcCompactRegionDebugPrint "| objInRefList: "# + -- ddcPrimStderrPutAddr refObj + -- ddcCompactRegionDebugPrint "| Ref to "# + -- ddcPrimStderrPutAddr objInCR + -- ddcCompactRegionDebugPrint "\n"# + -- () + -- False# -> ()) + + ddcScanObject aaBackTop objInCR + (case eq# refListCurr refListTail of + True# -> () + False# -> do ddcScanCompactRegionObjectRoot aaBackTop (ddcCompactRegionGetNext refListCurr) refListTail + () + ) + + + + -- | Evacuate a single object and update the to-space -- to point to the word _after_ the new copy. ddcEvacuateObject @@ -239,6 +344,7 @@ ddcEvacuateObject -- This is a real object in the from-space, -- so evacuate it to the to-space. False# -> case ddcObjectIsInCompactRegion aObj of + True# -> aObj False# -> ddcEvacuateCopy aaBackTop aObj @@ -250,14 +356,26 @@ ddcEvacuateCopy : Addr# -- ^ Address that the object has been copied to. = do -- Get the size of the whole object. + -- ddcPrimStderrPutAddr aObj + -- ddcCompactRegionDebugPrint " "# + + -- a = ddcObjectFormat aObj + -- ddcPrimStderrPutNat a + size = ddcObjectSize aObj -- Where we're going to copy it to in the to-space. aObjNew = read# aaBackTop 0# + -- ddcCompactRegionDebugPrint " ->"# + -- ddcPrimStderrPutAddr aObjNew + -- Copy the sucker. copy# aObjNew aObj size + -- ddcCompactRegionDebugPrint " :"# + -- ddcPrimStderrPutNat size + -- Advance the to-pointer to point to the first byte of -- where the next object could be copied to. write# aaBackTop 0# (plusAddr# aObjNew size) @@ -267,6 +385,8 @@ ddcEvacuateCopy -- so if we come back here again we'll know where it's gone. ddcForwardWrite aObj aObjNew + -- ddcCompactRegionDebugPrint "\n"# + aObjNew ddcCollectCompactRegionTable @@ -285,8 +405,11 @@ ddcCollectCompactRegionTableIter case gt# (plusAddr# tableBase acc) tableMax of True# -> () False# -> do - ddcCollectCompactRegion rawBase (plusAddr# tableBase acc) + (case eq# rawBase (promote# [Addr#] 0#) of + True# -> () + False# -> ddcCollectCompactRegion rawBase (plusAddr# tableBase acc)) ddcCollectCompactRegionTableIter tableBase tableMax (add# acc 8#) + () @@ -297,8 +420,11 @@ ddcCollectCompactRegion = do case (ddcCompactRegionIsLive rawBase) of True# -> do () - False#-> do -- free the actual memory - free rawBase + False#-> do + ddcCompactRegionDebugPrint "GC| CR| deadCR: "# + ddcPrintCompactRegionHeader rawBase + -- free the CR + ddcCompactRegionDestroy rawBase -- delete it from the table write# tableEntryAddr 0# 0# () @@ -324,8 +450,14 @@ ddcScanHeap -- Scan an object in the to-space and copy any object that -- it refers to from the from-space to the to-space. + -- ddcCompactRegionDebugPrint "Scan To|"# + -- ddcPrimStderrPutAddr aObjScan + -- ddcCompactRegionDebugPrint "["# + ddcScanObject aaToSpaceTop aObjScan + -- ddcCompactRegionDebugPrint "]\n"# + -- Go to the next object to scan. size = ddcObjectSize aObjScan aObjNext = plusAddr# aObjScan size @@ -418,7 +550,6 @@ ddcScanBoxed_arg False# -> do -- Address where the object argument is in the from-space. aArgFrom = ddcBoxedGetField aObjScan iArg - -- Skip over null pointer arguments in the boxed object. -- When the object is initially allocated the argument pointers are -- set to null so that if a GC cycle runs before the thunk is diff --git a/src/s2/ddc-runtime/salt/runtime64/Object.dcs b/src/s2/ddc-runtime/salt/runtime64/Object.dcs index 29c0e6eac..370d3caf6 100644 --- a/src/s2/ddc-runtime/salt/runtime64/Object.dcs +++ b/src/s2/ddc-runtime/salt/runtime64/Object.dcs @@ -137,6 +137,7 @@ export foreign c value import foreign c value ddcAllocCollect : Nat# -> Unit + ddcPrimStderrPutAddr : Addr# -> Void# ddcPrimStderrPutString : TextLit# -> Void# ddcPrimStderrPutNat : Nat# -> Void# ddcPrimShowNat : Nat# -> TextLit# @@ -211,9 +212,12 @@ ddcObjectSetCompactRegionFlag [r: Region] (obj : Ptr# r Obj) (flag: Bool#) : Uni True# -> do write# (takePtr# obj) 0# (bor# fmt (promote# [Word64#] 0b0100w8#)) () - False# -> do - write# (takePtr# obj) 0# (band# fmt (promote# [Word64#] 0b1011w8#)) + False# -> do + write# (takePtr# obj) 0# (bxor# (bor# fmt (promote# [Word64#] 0b0100w8#)) (promote# [Word64#] 0b0100w8#)) () + -- False# -> do + -- write# (takePtr# obj) 0# (band# fmt (promote# [Word64#] 0b1011w8#)) + -- () --| Get the size of an object. ddcObjectSize [r: Region] (obj: Ptr# r Obj): Nat# diff --git a/src/s2/ddc-runtime/salt/runtime64/debug/Check.dcs b/src/s2/ddc-runtime/salt/runtime64/debug/Check.dcs index 9cb9d89af..51bdb331b 100644 --- a/src/s2/ddc-runtime/salt/runtime64/debug/Check.dcs +++ b/src/s2/ddc-runtime/salt/runtime64/debug/Check.dcs @@ -26,7 +26,7 @@ ddcCheckObjHeader [r: Region] (obj: Ptr# r Obj): Word64# valid = mul# (ge# objA pHeapBaseA) (lt# objA (minusAddr# pHeapTopA 4#)) - case valid of + case True# of True# -> peek# (castPtr# obj) @@ -62,7 +62,7 @@ ddcCheckObjExtent [r: Region] (obj: Ptr# r Obj) (len: Nat#): Unit valid = mul# (ge# objFirstA pHeapBaseA) (lt# objLastA pHeapTopA) - case valid of + case True# of True# -> () diff --git a/src/s2/ddc-runtime/salt/runtime64/primitive/CRegion.dcs b/src/s2/ddc-runtime/salt/runtime64/primitive/CRegion.dcs index 8662e104a..ad03aae1d 100644 --- a/src/s2/ddc-runtime/salt/runtime64/primitive/CRegion.dcs +++ b/src/s2/ddc-runtime/salt/runtime64/primitive/CRegion.dcs @@ -1,28 +1,50 @@ module Runtime.Prim.CRegion export foreign c value - ddcPrimCompactRegionAlloc : Nat# -> Nat# - ddcPrimCompactRegionStore : [r1 r2: Region]. Nat# -> Ptr# r1 Obj -> Ptr# r2 Obj - ddcPrimCompactRegionMarkDead : Nat# -> Unit + ddcPrimCompactRegionAlloc : [r1 :Region]. Unit -> Nat# + ddcPrimCompactRegionStore : [r1 r2: Region]. Nat# -> Ptr# r1 Obj -> Bool# -> Ptr# r2 Obj + ddcPrimCompactRegionMarkDead : [r1 : Region]. Nat# -> Unit + + ddcCompactRegionDestroy : Addr# -> Unit + ddcCompactRegionGetNext : Addr# -> Addr# + ddcCompactRegionGetRefList : Addr# -> Addr# + ddcCompactRegionGetTail : Addr# -> Addr# + ddcCompactRegionGetData : Addr# -> Addr# + ddcCompactRegionIsLive : Addr# -> Bool# + ddcCompactRegionDebugPrint : TextLit# -> Unit + ddcPrintCompactRegionHeader : Addr# -> Unit + ddcCompactRegionDebug : Unit -> Bool# + + traceCR : Addr# -> Unit + ddcTraceCRByHandle : Nat# -> Unit + ddcAllocTestRaw : [r1: Region]. Nat# -> Ptr# r1 Obj import foreign c value malloc : Nat# -> Addr# free : Addr# -> Void# ddcBoxedAlloc : [r1 : Region]. Tag# -> Word32# -> Nat# -> Ptr# r1 Obj - ddcBoxedGetField : [r1 r2 : Region]. Ptr# r1 Obj -> Nat# -> Ptr# r2 Obj + ddcBoxedGetField : Addr# -> Nat# -> Addr# ddcBoxedSetField : [r1 r2 : Region]. Ptr# r1 Obj -> Nat# -> Ptr# r2 Obj -> Void# - ddcObjectSize : [r1 : Region]. Ptr# r1 Obj -> Nat# - ddcObjectSetCompactRegionFlag : [r: Region]. Ptr# r Obj -> Bool# -> Unit - + ddcBoxedFields : [r1: Region]. Ptr# r1 Obj -> Nat# + ddcObjectSize : Addr# -> Nat# + ddcObjectFormat : Addr# -> Nat# + ddcObjectSetCompactRegionFlag : [r: Region]. Ptr# r Obj -> Bool# -> Unit + + ddcObjectIsInCompactRegion : [r: Region]. Ptr# r Obj -> Bool# ddcPrimStdoutPutNat : Nat# -> Void# ddcPrimStderrPutNat : Nat# -> Void# ddcPrimStdoutPutAddr : Addr# -> Void# ddcPrimStderrPutAddr : Addr# -> Void# ddcPrimStdoutPutTextLit : TextLit# -> Void# ddcPrimStderrPutTextLit : TextLit# -> Void# + ddcPrimShowNat : Nat# -> TextLit# + ddcTraceObj : [r: Region]. Bool# -> Bool# -> Ptr# r Obj -> Ptr# r Obj + + ddcRawAlloc : [r1: Region]. Word32# -> Nat# -> Ptr# r1 Obj + with letrec @@ -30,6 +52,80 @@ ddcCompactRegionDebug (u : Unit) : Bool# = do False# +crLength (node: Addr#) : Nat# + = do next = ddcCompactRegionGetNext node + case eq# next node of + True# -> 1# + False# -> add# 1# (crLength next) + +ddcTraceCRByHandle ( handle : Nat# ) : Unit + = do tableBase = read# [Addr#] (global# [Addr#] "ddcCRTableBase"#) 0# + slot = plusAddr# tableBase handle + traceCR (read# slot 0#) + +traceCR (head : Addr#) : Unit + = do + case True# of + True# -> do ddcPrimStderrPutTextLit "Trace CR @ "# + ddcPrimStderrPutAddr head + ddcPrimStderrPutTextLit " "# + ddcPrintCompactRegionHeader head + ddcPrimStderrPutTextLit "[ \n"# + (case eq# head (ddcCompactRegionGetTail head) of + True# -> () + False# -> do traceCR_iter (ddcCompactRegionGetNext head) (ddcCompactRegionGetTail head) + () + ) + ddcPrimStderrPutTextLit "]"# + ddcPrimStderrPutTextLit "\n"# + refList = (ddcCompactRegionGetRefList head) + ddcPrimStderrPutTextLit "[ \n"# + (case eq# refList (ddcCompactRegionGetTail refList) of + True# -> () + False# -> do traceRefList_iter (ddcCompactRegionGetNext refList) (ddcCompactRegionGetTail refList) + () + ) + ddcPrimStderrPutTextLit "]"# + ddcPrimStderrPutTextLit "\n"# + + () + _ -> () + +traceRefList_iter (curr : Addr#) (tail: Addr#): Unit + = do + ddcPrimStderrPutTextLit " R: "# + ddcPrimStderrPutAddr curr + ddcPrimStderrPutTextLit "| Data: "# + ddcPrimStderrPutAddr (ddcCompactRegionGetData curr) + ddcPrimStderrPutTextLit " ->: "# + real = (read# (ddcCompactRegionGetData curr) 0#) + ddcPrimStderrPutAddr real + ddcPrimStderrPutTextLit "| Format: "# + ddcPrimStderrPutNat (ddcObjectFormat real) + ddcPrimStderrPutTextLit "| Size: "# + ddcPrimStderrPutNat (ddcObjectSize real) + ddcPrimStderrPutTextLit "\n"# + case eq# curr tail of + True# -> () + False# -> traceRefList_iter (ddcCompactRegionGetNext curr) tail + + +traceCR_iter (curr : Addr#) (tail: Addr#): Unit + = do + ddcPrimStderrPutTextLit " N: "# + ddcPrimStderrPutAddr curr + ddcPrimStderrPutTextLit "| Data: "# + ddcPrimStderrPutAddr (ddcCompactRegionGetData curr) + ddcPrimStderrPutTextLit "| Format: "# + ddcPrimStderrPutNat (ddcObjectFormat (ddcCompactRegionGetData curr)) + ddcPrimStderrPutTextLit "| Size: "# + ddcPrimStderrPutNat (ddcObjectSize (ddcCompactRegionGetData curr)) + ddcPrimStderrPutTextLit "\n"# + case eq# curr tail of + True# -> () + False# -> traceCR_iter (ddcCompactRegionGetNext curr) tail + + ddcCompactRegionDebugPrint (msg : TextLit#) : Unit = do case ddcCompactRegionDebug () of @@ -42,35 +138,120 @@ ddcPrintCompactRegionHeader (rawBase : Addr#) : Unit case ddcCompactRegionDebug () of True# -> do ddcPrimStderrPutTextLit "CR-> Base: "# ddcPrimStderrPutAddr rawBase - ddcPrimStderrPutTextLit "| Top: "# + ddcPrimStderrPutTextLit "| Next: "# ddcPrimStderrPutAddr (read# [Addr#] rawBase 0#) - ddcPrimStderrPutTextLit "| Max: "# + ddcPrimStderrPutTextLit "| Tail: "# ddcPrimStderrPutAddr (read# [Addr#] rawBase 8#) - ddcPrimStderrPutTextLit "| Size: "# - ddcPrimStderrPutNat (promote# [Nat#] (sub# (read# [Addr#] rawBase 8#) (read# [Addr#] rawBase 0#))) ddcPrimStderrPutTextLit "| Flag: "# - ddcPrimStderrPutAddr (read# [Addr#] rawBase 16#) + ddcPrimStderrPutAddr (promote# [Addr#] (truncate# [Word8#] (read# [Addr#] rawBase 16#))) + ddcPrimStderrPutTextLit "| RefList: "# + ddcPrimStderrPutAddr (read# [Addr#] rawBase 17#) + ddcPrimStderrPutTextLit "| Length: "# + ddcPrimStderrPutNat (crLength rawBase) + (case eq# (truncate# [Nat#] (read# [Addr#] rawBase 17#)) 0# of + True# -> () + False# -> do ddcPrimStderrPutTextLit "| RefList Length: "# + ddcPrimStderrPutNat (crLength (read# [Addr#] rawBase 17#)) + () + ) ddcPrimStderrPutTextLit "\n"# () _ -> () - + + +-- Ref List is the list of object compact region keeps live on the heap. --| Compact Region Allocation -ddcPrimCompactRegionAlloc (initSize : Nat#) : Nat# - = do - -- claim chunk of memory - rawBase = malloc initSize - -- construct header - ddcCompactRegionConstructHeader - rawBase - (plusAddr# rawBase 32#) -- top - (plusAddr# rawBase initSize) -- max - 0b0000001w8# -- flags +ddcPrimCompactRegionAlloc [r1 : Region] (u : Unit) : Nat# + = do + regionRawBase = ddcCompactRegionAllocHead () + refListBase = ddcCompactRegionAllocHead () + ddcCompactRegionSetRefList regionRawBase refListBase + + ddcCompactRegionDebugPrint "Alloc| "# + ddcPrintCompactRegionHeader regionRawBase + + ddcCompactRegionDebugPrint "Alloc RefList| "# + ddcPrintCompactRegionHeader refListBase + ddcCompactRegionInsertTable regionRawBase + +-- head: |next|tail|flags(live|x|x|x|x|x|x|x|)|RefList| +-- data: |next|xxxx|xxxx|xxxx| +-- size: 8 8 1 8 +-- offset: 0 8 16 17 +ddcCompactRegionAllocHead (u : Unit) : Addr# + = do + headBase = malloc 32# + ddcCompactRegionSetNext headBase headBase + ddcCompactRegionSetTail headBase headBase + ddcCompactRegionSetLive headBase True# + headBase + +-- setters +ddcCompactRegionSetNext (node : Addr#) (next : Addr#): Unit + = do write# node 0# next + () - -- insert into the global table - ddcCompactRegionInsertTable rawBase +ddcCompactRegionSetTail (node : Addr#) (tail : Addr#): Unit + = do write# node 8# tail + () + +ddcCompactRegionSetLive (head : Addr#) (isLive : Bool#): Unit + = do (case isLive of + True# -> do write# head 16# 0b11111111w8# + () + False# -> do write# head 16# 0b11111110w8# + () + ) + () + +ddcCompactRegionSetRefList (head : Addr#) (refList : Addr#) : Unit + = do write# head 17# refList + () + +-- getters +ddcCompactRegionGetNext (node : Addr#) : Addr# + = do r = read# node 0# + r + +ddcCompactRegionGetTail (node : Addr#) : Addr# + = do r = read# node 8# + r + +ddcCompactRegionIsLive (head : Addr#) : Bool# + = do case eq# (truncate# [Nat#] head) 0# of + True# -> do False# + False# -> do + flag8 = truncate# [Word8#] (read# [Addr#] head 16#) + case band# flag8 0b0000001w8# of + 0b00000001w8# -> True# + _ -> False# + +ddcCompactRegionGetRefList (head : Addr#) : Addr# + = do r = read# head 17# + r + +ddcCompactRegionGetData (node : Addr#) : Addr# + = do r = plusAddr# node 32# + r + +-- free compact region list +ddcCompactRegionDestroy (head : Addr#) : Unit + = do refList = ddcCompactRegionGetRefList head + ddcCompactRegionDestroyPrim refList (ddcCompactRegionGetTail refList) + ddcCompactRegionDestroyPrim head (ddcCompactRegionGetTail head) + () + +ddcCompactRegionDestroyPrim (curr : Addr#) (max : Addr#) : Unit + = do case eq# curr max of + True# -> do free curr + () + False# -> do next = ddcCompactRegionGetNext curr + ddcCompactRegionDestroyPrim next max + free curr + () -- procedure to insert into global table, should be inlined. ddcCompactRegionInsertTable (rawBase : Addr#): Nat# @@ -101,15 +282,13 @@ ddcCompactRegionExtendsTable (u : Unit): Void# newSize = add# oldSize (read# (global# [Nat#] "ddcCRTableSize"#) 0#) tableBaseNew = malloc newSize tableMaxNew = plusAddr# tableBaseNew (sub# newSize 1#) - -- copy and destory old one + -- copy and Destroy old one copy# tableBaseNew tableBaseOld oldSize free tableBaseOld -- update globals write# (global# [Addr#] "ddcCRTableBase"#) 0# tableBaseNew write# (global# [Addr#] "ddcCRTableMax"#) 0# tableMaxNew - - -- return 0# when table is full -- otherwise return the address of the slot @@ -124,7 +303,7 @@ ddcCompactRegionFindFreeRegionTableSlot (acc : Addr#) (max : Addr#) : Addr# False# -> ddcCompactRegionFindFreeRegionTableSlot (plusAddr# acc 8#) max --| Store object into the compact region (append) -ddcPrimCompactRegionStore [r1 r2: Region] (handle : Nat#) (pVal : Ptr# r1 Obj) : Ptr# r2 Obj +ddcPrimCompactRegionStore [r1 r2: Region] (handle : Nat#) (pVal : Ptr# r1 Obj) (ignoreRef : Bool#): Ptr# r2 Obj = do -- handle validation handleValid = ddcCompactRegionHandleValidation handle @@ -134,115 +313,181 @@ ddcPrimCompactRegionStore [r1 r2: Region] (handle : Nat#) (pVal : Ptr# r1 Obj) : fail# --invalid handle True# -> do tableBase = read# [Addr#] (global# [Addr#] "ddcCRTableBase"#) 0# - regionRawBase = read# [Addr#] tableBase handle - ddcPrintCompactRegionHeader regionRawBase - -- check if region is live. - isLive = ddcCompactRegionIsLive regionRawBase - case isLive of - False# -> do ddcCompactRegionDebugPrint "Access dead region\n"# - fail# - True# -> do -- now attempt to store object into the compact region - regionMax = read# [Addr#] regionRawBase 8# - regionTop = read# [Addr#] regionRawBase 0# - makePtr# (ddcCompactRegionResizeStore handle regionRawBase regionMax regionTop pVal) - --- store object into the compact region and --- extends compact region when necessary -ddcCompactRegionResizeStore [r1 : Region] - (handle : Nat#) - (rawBase : Addr#) - (top : Addr#) - (max : Addr#) - (pVal : Ptr# r1 Obj ) - : Addr# - = do freeSize = sub# max top - case lt# (ddcObjectSize pVal) (promote# [Nat#] freeSize) of - False# - -> do newSize = mul# (truncate# [Nat#] (sub# max rawBase)) 2# --TODO: a better strategy - rawBaseNew = malloc newSize - - -- copy old data and old header - usedSize = truncate# [Nat#] (sub# top rawBase) - copy# rawBaseNew rawBase usedSize - -- update header - topNew = plusAddr# rawBaseNew usedSize - maxNew = plusAddr# rawBaseNew newSize - write# rawBaseNew 0# topNew - write# rawBaseNew 8# maxNew - free rawBase - -- trick, find another solution to this if possible. - ddcCompactRegionResizeStore handle rawBaseNew topNew maxNew pVal - True# - -> do -- store the object to the compact region - objAddrNew = ddcCompactRegionUnsafeDirectStore rawBase pVal - -- update the address in the compact region table - tableBase = read# [Addr#] (global# [Addr#] "ddcCRTableBase"#) 0# - write# tableBase handle rawBase - -- return the addr of object in the compact region - objAddrNew - --- the inline function foc the "store" part. -ddcCompactRegionUnsafeDirectStore [r1 : Region] - (rawBase : Addr#) - (pVal : Ptr# r1 Obj) - : Addr# - = do - -- make it addr - rawObjAddr = takePtr# pVal - -- get curr top - top = read# rawBase 0# + slot = plusAddr# tableBase handle + obj = ddcCompactRegionStore (read# slot 0#) pVal ignoreRef + -- traceCR (read# slot 0#) + obj + + + +ddcCompactRegionStore [r1 r2 : Region] (head : Addr#) (pVal : Ptr# r1 Obj) (ignoreRef : Bool#) : Ptr# r2 Obj + = do + tail = ddcCompactRegionGetTail head + isLive = ddcCompactRegionIsLive head + + (case isLive of + False# -> do ddcCompactRegionDebugPrint "Access dead region\n"# + fail# + True# -> ()) + -- store the obj into next node + node = ddcCompactRegionCreateDataNode pVal + ddcCompactRegionSetNext tail node + ddcCompactRegionSetTail head node + objInRegion = makePtr# (ddcCompactRegionGetData node) + -- store obj with ref on the heap to refList + (case ignoreRef of + True# -> () + False# -> do ddcCompactRegionUpdateRefList head objInRegion + () + ) + + -- ddcTraceObj True# True# objInRegion + + + + -- ddcCompactRegionDebugPrint "objInRegion: "# + -- ddcPrimStderrPutAddr (ddcCompactRegionGetData node) + -- ddcCompactRegionDebugPrint "\n "# + + ddcCompactRegionDebugPrint "Post Store| "# + ddcPrintCompactRegionHeader head + + objInRegion + +ddcCompactRegionCreateDataNode [r1 : Region] (pVal : Ptr# r1 Obj) : Addr# + = do size = ddcObjectSize (takePtr# pVal) + node = malloc (add# size 32#) + ddcCompactRegionSetNext node node + ddcCompactRegionSetTail node node + top = plusAddr# node 32# + -- ddcCompactRegionDebugPrint "dataNodeTop: "# + -- ddcPrimStderrPutAddr top + -- ddcCompactRegionDebugPrint "Size: "# + -- ddcPrimStderrPutNat size + -- ddcCompactRegionDebugPrint "\n"# + -- do the copy - copy# top rawObjAddr (ddcObjectSize pVal) + copy# top (takePtr# pVal) size -- set the CR flag ddcObjectSetCompactRegionFlag [r1] (makePtr# top) True# - -- update top - write# rawBase 0# (plusAddr# top (ddcObjectSize pVal)) - - top + node + +-- check object type +ddcCompactRegionUpdateRefList [r1 : Region] + (head : Addr#) + (pVal : Ptr# r1 Obj) + : Unit + = do case ddcObjectFormat (takePtr# pVal) of + 2# -> do ddcCompactRegionUpdateReflistPrim head pVal --thunk + () + 3# -> do ddcCompactRegionUpdateReflistPrim head pVal --boxed + () + 4# -> do () --raw + 5# -> do () --array TODO: what to do? + _ -> do () --mhm... + + +-- optimization attempts to only put object with ref to heap +-- to the ref list +-- need a write barrier to keep the ref safe. +ddcCompactRegionBoxed_opt [r1 : Region] + (head : Addr#) + (pVal : Ptr# r1 Obj) -- original object + (iArg : Nat#) + (nArgs : Nat#) + : Unit + = case ge# iArg nArgs of + True# -> () + False# -> do + aArgFrom = ddcBoxedGetField (takePtr# pVal) iArg + case eq# (truncate# aArgFrom) 0# of + True# -> ddcCompactRegionBoxed_opt head pVal (add# iArg 1#) nArgs + False# -> do + case (ddcObjectIsInCompactRegion [r1] (makePtr# aArgFrom)) of + True# -> do ddcCompactRegionBoxed_opt head pVal (add# iArg 1#) nArgs + False# -> do ddcCompactRegionUpdateReflistPrim [r1] head (makePtr# aArgFrom) + ddcCompactRegionBoxed_opt head pVal (add# iArg 1#) nArgs + + +ddcCompactRegionUpdateReflistPrim [r1 : Region] + (head : Addr#) + (pVal : Ptr# r1 Obj) + : Unit + = do + objBase = takePtr# pVal + + refList = ddcCompactRegionGetRefList head + refListTail = ddcCompactRegionGetTail refList + case eq# (promote# [Nat#] refList) 0# of + False# -> do node = malloc (add# 8# 32#) -- pointer size + header size + ddcCompactRegionSetNext node node + ddcCompactRegionSetTail node node + + ddcCompactRegionSetNext refListTail node + ddcCompactRegionSetTail refList node + write# node 32# objBase + () + True# -> do () + + --| set the flag to mark compact region dead -ddcPrimCompactRegionMarkDead (handle : Nat#) : Unit +ddcPrimCompactRegionMarkDead [r1 : Region] (handle : Nat#) : Unit = do handleValid = ddcCompactRegionHandleValidation handle case handleValid of False# - -> do fail# --invalid handle + -> do ddcCompactRegionDebugPrint "invalid handle!"# + fail# --invalid handle True# -> do tableBase = read# [Addr#] (global# [Addr#] "ddcCRTableBase"#) 0# regionRawBase = read# [Addr#] tableBase handle + + flag8 = truncate# [Word8#] (read# [Addr#] regionRawBase 16#) --TODO: - flag8 = truncate# [Word8#] (read# [Addr#] regionRawBase 0#) -- mark compact region dead by set the flag - write# regionRawBase 0# (band# flag8 0b11111110w8#) + write# regionRawBase 16# (band# flag8 0b11111110w8#) + -- mark each object 'free' from life cycle constraints + + (case eq# regionRawBase (ddcCompactRegionGetTail regionRawBase) of + True# -> () + False# -> ddcCompactRegionMarkObjectFree [r1] (ddcCompactRegionGetNext regionRawBase) (ddcCompactRegionGetTail regionRawBase) + ) + ddcCompactRegionDebugPrint "MarkDead| "# + ddcPrintCompactRegionHeader regionRawBase () - --- inline function to write a header -ddcCompactRegionConstructHeader - (rawBase : Addr#) - (top : Addr#) - (max : Addr#) - (flags : Word8#) - : Void# - = do write# rawBase 0# top - write# rawBase 8# max - write# rawBase 16# flags - -ddcCompactRegionRawBaseToBase (rawBase : Addr#) : Addr# - = do - -- HEADER SIZE - plusAddr# rawBase 32# +ddcCompactRegionMarkObjectFree [r1 : Region] (curr : Addr#) (last : Addr#) : Unit + = do currData = ddcCompactRegionGetData curr + -- ddcCompactRegionDebugPrint "Free Obj from CR| "# + -- ddcPrimStderrPutAddr currData + -- ddcCompactRegionDebugPrint " | flag before "# + -- (case (ddcObjectIsInCompactRegion [r1] (makePtr# currData)) of + -- True# -> do ddcPrimStderrPutNat 1# + -- () + -- False# -> do ddcPrimStderrPutNat 0# + -- () + -- ) + -- ddcPrimStderrPutAddr (read# currData 0#) --- return true if the compact region is live --- otherwise false -ddcCompactRegionIsLive (regionBase : Addr#) : Bool# - = do case eq# (truncate# [Nat#] regionBase) 0# of - True# -> do False# - False# -> do - flag8 = truncate# [Word8#] (read# [Addr#] regionBase 16#) - case band# flag8 0b0000001w8# of - 0b00000001w8# -> True# - _ -> False# + -- mark current obj free + ddcObjectSetCompactRegionFlag [r1] (makePtr# currData) False# + + -- ddcCompactRegionDebugPrint " | flag "# + -- (case (ddcObjectIsInCompactRegion [r1] (makePtr# currData)) of + -- True# -> do ddcPrimStderrPutNat 1# + -- () + -- False# -> do ddcPrimStderrPutNat 0# + -- () + -- ) + -- ddcPrimStderrPutAddr (read# currData 0#) + + -- ddcCompactRegionDebugPrint "\n"# + + case eq# curr last of + True# -> do () + False# -> do ddcCompactRegionMarkObjectFree [r1] (ddcCompactRegionGetNext curr) last + -- return true if handle is valid -- otherwise, false @@ -251,4 +496,10 @@ ddcCompactRegionHandleValidation (handle : Nat#) : Bool# tableBase = read# [Addr#] (global# [Addr#] "ddcCRTableBase"#) 0# tableMax = read# [Addr#] (global# [Addr#] "ddcCRTableMax"#) 0# tableSize = truncate# [Nat#] (sub# tableMax tableBase) - lt# handle tableSize \ No newline at end of file + lt# handle tableSize + + + +ddcAllocTestRaw [r1: Region] (size : Nat#) : Ptr# r1 Obj + = do + ddcRawAlloc [r1] (truncate# 2#) size diff --git a/src/s2/ddc-runtime/sea/runtime/Stats.c b/src/s2/ddc-runtime/sea/runtime/Stats.c index 165fa6746..3216dd044 100644 --- a/src/s2/ddc-runtime/sea/runtime/Stats.c +++ b/src/s2/ddc-runtime/sea/runtime/Stats.c @@ -1,10 +1,10 @@ #include #include -#include +#include typedef struct TimeDiff{ - struct timeval start; - struct timeval end; + clock_t start; + clock_t end; } TimeDiff; typedef struct Node { @@ -49,18 +49,19 @@ void append(Node* node, void* data){ void ddcSeaStatsGCStart(){ if(cache != NULL){ - fprintf(stderr,"Erro on Cache. start\n"); + fprintf(stdout,"Erro on Cache. start\n"); } cache = (TimeDiff*)malloc(sizeof(TimeDiff)); - gettimeofday(&cache->start, NULL); + cache->start = clock(); + } void ddcSeaStatsGCEnd(){ if(cache == NULL){ - fprintf(stderr,"Erro on Cache. end \n"); + fprintf(stdout,"Erro on Cache. end \n"); return; } - gettimeofday(&cache->end, NULL); + cache->end = clock(); if(timeList == NULL){ timeList = (Node*)malloc(sizeof(Node)); @@ -68,6 +69,8 @@ void ddcSeaStatsGCEnd(){ timeList->data = cache; }else{ append(timeList, cache); + double timeTaken = (((double)(cache->end - cache->start))/CLOCKS_PER_SEC) * 1000; + fprintf(stderr,",%f", timeTaken); } cache = NULL; } @@ -77,7 +80,9 @@ void ddcSeaStatsShowTimeDiff(){ Node* node = timeList; while(node != NULL){ TimeDiff* diff = (TimeDiff*)(node->data); - fprintf(stderr,",%lu", (unsigned long)(diff->end.tv_usec - diff->start.tv_usec)); + double timeTaken = (((double)(diff->end - diff->start))/CLOCKS_PER_SEC) * 1000; + fprintf(stderr,",%f", timeTaken); + node = node->next; } fprintf(stderr, "\n"); diff --git a/test/ddc-demo/core/Salt/03-CRHello/Main.dcs b/test/ddc-broken/99-skip/03-CRHello/Main.dcs similarity index 100% rename from test/ddc-demo/core/Salt/03-CRHello/Main.dcs rename to test/ddc-broken/99-skip/03-CRHello/Main.dcs diff --git a/test/ddc-demo/core/Salt/03-CRHello/Main.stdout.check b/test/ddc-broken/99-skip/03-CRHello/Main.stdout.check similarity index 100% rename from test/ddc-demo/core/Salt/03-CRHello/Main.stdout.check rename to test/ddc-broken/99-skip/03-CRHello/Main.stdout.check diff --git a/test/ddc-broken/99-skip/04-CRTableMax/Main.dcs b/test/ddc-broken/99-skip/04-CRTableMax/Main.dcs index f5948c8e2..759b391bf 100644 --- a/test/ddc-broken/99-skip/04-CRTableMax/Main.dcs +++ b/test/ddc-broken/99-skip/04-CRTableMax/Main.dcs @@ -114,17 +114,15 @@ compactRegionTableMax [r1: Region] (original : Ptr# r1 Obj) (acc : Nat#) : Unit ddcPrimStdoutPutVector str ddcPrimStdoutPutTextLit "\n"# - ddcPrimCompactRegionMarkDead handle case gt# acc 1024# of True# -> do ddcPrimStdoutPutTextLit "pass\n"#; () False# -> do compactRegionTableMax [r1] x2 (add# acc 1#) - _ -> do ddcPrimStdoutPutTextLit "try\n"#; () main [r1 : Region] (argc: Nat#) (argv: Ptr# r1 Word8#): Int# = do -- Initialize the runtime system. - ddcInit 1024# 0# + ddcInit 409600# 0# original = boxWord32 [r1] 0w32# diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/01-Base/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/01-Base/Main.ds index 6e11d7e16..e75f43847 100644 --- a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/01-Base/Main.ds +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/01-Base/Main.ds @@ -5,29 +5,54 @@ import Class.Show import Data.Numeric.Nat import Data.Function import Data.CompactRegion + +import foreign c value + ddcPerformGC : Unit -> Unit + ddcTraceObj : [r: Region]. Bool# -> Bool# -> Text-> Unit + where -- basic demo of how compact region works. +-- Compact Region is a "region" provides safe manually memory management +-- Object in the compact region never gets freed by GC, until deleteCR is called. +-- The implementation of compact region eliminates dangling pointers, you may safely +-- having references to compact region and mark it dead and still be able to use it. +-- A typical use case is to store long-live objects and avoid tracking/copying costs main () - = private r with { Alloc r; Read r; Write r } in + = mutable r in do -- create compact region at @r with size 1024 bytes - cr = allocCR {@r} 1024 + cr = allocCR {@r} () -- store a number 2048 at compact region, the myVal is the value -- on the compact region. It won't be garbage collected until the region is dead. + writel $ "- Store one value" myVal = storeCR cr 2048 - writel $ "value = " % (show myVal) - -- append another value to the CR + ddcPerformGC () + writel $ "value = " % show myVal + + -- -- append another value to the CR + writel $ "- Store two value" myVal2 = storeCR cr 4096 - writel $ "value = " % (show myVal) - writel $ "value = " % (show myVal2) + ddcPerformGC () + writel $ "value = " % show myVal + writel $ "value = " % show myVal2 -- the CR is polymorphic, i.e. it does not care what is in the CR -- however, the return value is typed. + writel $ "- Store three value and being polymorphic" myVal3 = storeCR cr "poly" - writel $ "value = " % (show myVal) - writel $ "value = " % (show myVal2) - writel $ "value = " % (show myVal3) + ddcPerformGC () + writel $ "value = " % show myVal + writel $ "value = " % show myVal2 + writel $ "value = " % show myVal3 -- declear CR is dead, it will be GC in next GC cycle. deleteCR cr + ddcPerformGC () + writel $ "value = " % show myVal + writel $ "value = " % show myVal2 + writel $ "value = " % show myVal3 + + -- ddcTraceObj {@r} True True myVal3 + () + diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/01-Base/Main.stdout.check b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/01-Base/Main.stdout.check new file mode 100644 index 000000000..495b0501f --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/01-Base/Main.stdout.check @@ -0,0 +1,12 @@ +- Store one value +value = 2048 +- Store two value +value = 2048 +value = 4096 +- Store three value and being polymorphic +value = 2048 +value = 4096 +value = "poly" +value = 2048 +value = 4096 +value = "poly" diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/02-HitLimit/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/02-HitLimit/Main.ds index 359087fbc..822c9ae90 100644 --- a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/02-HitLimit/Main.ds +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/02-HitLimit/Main.ds @@ -5,6 +5,7 @@ import Class.Show import Data.Numeric import Data.Function import Data.CompactRegion + where -- The compact region will automatically @@ -14,15 +15,15 @@ hitLimit {@r: Region} (cr: CR r) (acc: Nat): S (Write r + Console) Nat = case (acc < 2048) of True -> do val = storeCR cr acc - writel (show val) hitLimit cr (acc + 1) False -> acc main () - = private r with { Alloc r; Read r; Write r } in - do - cr = allocCR {@r} 1024 + = mutable r in + do + cr = allocCR {@r} () acc = hitLimit cr 0 deleteCR cr + writel $ show acc diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/02-HitLimit/Main.stdout.check b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/02-HitLimit/Main.stdout.check new file mode 100644 index 000000000..c873496a2 --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/02-HitLimit/Main.stdout.check @@ -0,0 +1 @@ +2048 diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/03-GC/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/03-GC/Main.ds new file mode 100644 index 000000000..8b8180a02 --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/03-GC/Main.ds @@ -0,0 +1,60 @@ + +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +import foreign c value + ddcPerformGC : Unit -> Unit + ddcTraceObj : [r: Region]. Bool# -> Bool# -> Ref r Text -> Unit + ddcTraceCRByHandle : [r: Region]. CR r -> Unit + +where + +-- basic demo of how compact region works. +main () + = mutable r1 r2 in + do cr = allocCR {@r1} () + + refOnCR = storeCR cr (allocRef {@r2} "hello") + + -- ddcTraceCRByHandle cr + -- ddcTraceObj True True refOnCR + + ddcPerformGC () + writel $ show (readRef refOnCR) + + -- ddcTraceCRByHandle cr + -- ddcTraceObj True True refOnCR + + ddcPerformGC () + writel $ show (readRef refOnCR) + + -- ddcTraceCRByHandle cr + -- ddcTraceObj True True refOnCR + + + ddcPerformGC () + writel $ show (readRef refOnCR) + + + deleteCR cr + ddcPerformGC () + + -- ddcTraceCRByHandle cr + -- ddcTraceObj True True refOnCR + + writel $ show (readRef refOnCR) + + -- if you uncomment this below, it should print proper + -- box(ref)->box(textLit)->raw(binary) on the heap + -- ddcTraceObj {@r2} True True refOnCR + + + () + diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/03-GC/Main.stdout.check b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/03-GC/Main.stdout.check new file mode 100644 index 000000000..85f5947bd --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/03-GC/Main.stdout.check @@ -0,0 +1,4 @@ +"hello" +"hello" +"hello" +"hello" diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/-BinaryTreeAndLargeRaw/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/-BinaryTreeAndLargeRaw/Main.ds new file mode 100644 index 000000000..9b3d39cab --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/-BinaryTreeAndLargeRaw/Main.ds @@ -0,0 +1,64 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +where + +data BinaryTree + = Branch BinaryTree Nat BinaryTree + |Leaf + +-- operations +sumOfTree (t:BinaryTree) : Nat + = case t of + Leaf -> 0 + Branch l v r -> sumOfTree l + sumOfTree r + v + +headOfTree (t:BinaryTree) : Nat + = case t of + Leaf -> 0 + Branch _ v _ -> v + +-- slow Fib +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + +-- allocation functions +allocTree {@r: Region} (cr: CR r) : S (Write r + Console) BinaryTree + = do allocTreePrim {@r} cr 0 15 + +allocTreePrim {@r: Region} (cr: CR r) (currLevel : Nat) (maxLevel : Nat) : S (Write r + Console) BinaryTree + = do case currLevel == maxLevel of + True -> Leaf + False -> do newL = storeCR cr (allocTreePrim cr (currLevel + 1) maxLevel) + newR = storeCR cr (allocTreePrim cr (currLevel + 1) maxLevel) + Branch newL 1 newR + + +runCompute ( t : BinaryTree) (curr: Nat) (max : Nat) : S Console Unit + = do case max == curr of + True -> () + False -> do sumOfTree t + writel $" " + runCompute t (curr+1) max + +main () + = mutable r1 in + do cr = allocCR {@r1} () + t = allocTree cr + writel $" " + writel $ "========== Alloc done! Now compute the Sum =========== " + runCompute t 0 100 + + + deleteCR cr + writel $ "done" diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/-SumOfBinaryTree/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/-SumOfBinaryTree/Main.ds new file mode 100644 index 000000000..27234e377 --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/-SumOfBinaryTree/Main.ds @@ -0,0 +1,62 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +where + +data BinaryTree + = Branch BinaryTree Nat BinaryTree + |Leaf + +-- operations +sumOfTree (t:BinaryTree) : Nat + = case t of + Leaf -> 0 + Branch l v r -> sumOfTree l + sumOfTree r + v + +headOfTree (t:BinaryTree) : Nat + = case t of + Leaf -> 0 + Branch _ v _ -> v + +-- slow Fib +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + +-- allocation functions +allocHeap : BinaryTree + = do allocHeapPrim 0 15 + +allocHeapPrim (currLevel : Nat) (maxLevel : Nat) : BinaryTree + = do case currLevel == maxLevel of + True -> Leaf + False -> Branch (allocHeapPrim (currLevel + 1) maxLevel) 1 (allocHeapPrim (currLevel + 1) maxLevel) + +runCompute ( t : BinaryTree) (curr: Nat) (max : Nat) : S Console Unit + = do case max == curr of + True -> () + False -> do sumOfTree t + writel $" " + runCompute t (curr+1) max + +main () + = do a = allocHeap + writel $" " + writel $" " + writel $ "========== Alloc done! Now compute the Sum =========== " + runCompute a 0 100 + + + writel $" " + writel $ "done! " + + diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/-SumOfBinaryTreeCR/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/-SumOfBinaryTreeCR/Main.ds new file mode 100644 index 000000000..9b3d39cab --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/-SumOfBinaryTreeCR/Main.ds @@ -0,0 +1,64 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +where + +data BinaryTree + = Branch BinaryTree Nat BinaryTree + |Leaf + +-- operations +sumOfTree (t:BinaryTree) : Nat + = case t of + Leaf -> 0 + Branch l v r -> sumOfTree l + sumOfTree r + v + +headOfTree (t:BinaryTree) : Nat + = case t of + Leaf -> 0 + Branch _ v _ -> v + +-- slow Fib +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + +-- allocation functions +allocTree {@r: Region} (cr: CR r) : S (Write r + Console) BinaryTree + = do allocTreePrim {@r} cr 0 15 + +allocTreePrim {@r: Region} (cr: CR r) (currLevel : Nat) (maxLevel : Nat) : S (Write r + Console) BinaryTree + = do case currLevel == maxLevel of + True -> Leaf + False -> do newL = storeCR cr (allocTreePrim cr (currLevel + 1) maxLevel) + newR = storeCR cr (allocTreePrim cr (currLevel + 1) maxLevel) + Branch newL 1 newR + + +runCompute ( t : BinaryTree) (curr: Nat) (max : Nat) : S Console Unit + = do case max == curr of + True -> () + False -> do sumOfTree t + writel $" " + runCompute t (curr+1) max + +main () + = mutable r1 in + do cr = allocCR {@r1} () + t = allocTree cr + writel $" " + writel $ "========== Alloc done! Now compute the Sum =========== " + runCompute t 0 100 + + + deleteCR cr + writel $ "done" diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/00-Raws10M/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/00-Raws10M/Main.ds new file mode 100644 index 000000000..54b16b304 --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/00-Raws10M/Main.ds @@ -0,0 +1,33 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +where + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + + +main () + = mutable r1 in + do obj = allocTestRaw {@r1} (oneMb * 10) + fib 40 + writel $" " + writel $ "done! " + + diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/01-Raws100MB/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/01-Raws100MB/Main.ds new file mode 100644 index 000000000..d4461c5f1 --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/01-Raws100MB/Main.ds @@ -0,0 +1,33 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +where + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + + +main () + = mutable r1 in + do obj = allocTestRaw {@r1} (oneMb * 100) + fib 40 + writel $" " + writel $ "done! " + + diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/02-Raws1GB/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/02-Raws1GB/Main.ds new file mode 100644 index 000000000..f0b6d610d --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/02-Raws1GB/Main.ds @@ -0,0 +1,33 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +where + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + + +main () + = mutable r1 in + do obj = allocTestRaw {@r1} oneGb + fib 40 + writel $" " + writel $ "done! " + + diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/03-Raws2GB/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/03-Raws2GB/Main.ds new file mode 100644 index 000000000..af56a8efa --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/03-Raws2GB/Main.ds @@ -0,0 +1,33 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +where + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + + +main () + = mutable r1 in + do obj = allocTestRaw {@r1} (oneGb * 2) + fib 40 + writel $" " + writel $ "done! " + + diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/04-Raws4GB/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/04-Raws4GB/Main.ds new file mode 100644 index 000000000..a93f6650a --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/04-Raws4GB/Main.ds @@ -0,0 +1,33 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +where + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + + +main () + = mutable r1 in + do obj = allocTestRaw {@r1} (oneGb * 4) + fib 40 + writel $" " + writel $ "done! " + + diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/05-RawsCR10M/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/05-RawsCR10M/Main.ds new file mode 100644 index 000000000..5df168047 --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/05-RawsCR10M/Main.ds @@ -0,0 +1,40 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +where + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + +allocTestRawToCR {@r : Region} (cr : CR r): S (Write r + Alloc r) (Vector# r Word8#) + = do storeCR cr (allocTestRaw {@r} (oneMb * 10)) + +main () + = mutable r1 r2 in + do + cr = allocCR {@r2} () + obj = allocTestRawToCR cr + + writel $ "Start compute Fib Numbers. " + fib 40 + + writel $" " + writel $ "done! " + + diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/06-RawsCR100M/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/06-RawsCR100M/Main.ds new file mode 100644 index 000000000..b258e41ae --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/06-RawsCR100M/Main.ds @@ -0,0 +1,40 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +where + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + +allocTestRawToCR {@r : Region} (cr : CR r): S (Write r + Alloc r) (Vector# r Word8#) + = do storeCR cr (allocTestRaw {@r} (oneMb * 100)) + +main () + = mutable r1 r2 in + do + cr = allocCR {@r2} () + obj = allocTestRawToCR cr + + writel $ "Start compute Fib Numbers. " + fib 40 + + writel $" " + writel $ "done! " + + diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/07-RawsCR1GB/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/07-RawsCR1GB/Main.ds new file mode 100644 index 000000000..bc12860e1 --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/07-RawsCR1GB/Main.ds @@ -0,0 +1,40 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +where + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + +allocTestRawToCR {@r : Region} (cr : CR r): S (Write r + Alloc r) (Vector# r Word8#) + = do storeCR cr (allocTestRaw {@r} (oneGb)) + +main () + = mutable r1 r2 in + do + cr = allocCR {@r2} () + obj = allocTestRawToCR cr + + writel $ "Start compute Fib Numbers. " + fib 40 + + writel $" " + writel $ "done! " + + diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/08-RawsCR2GB/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/08-RawsCR2GB/Main.ds new file mode 100644 index 000000000..c75d629e2 --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/08-RawsCR2GB/Main.ds @@ -0,0 +1,40 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +where + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + +allocTestRawToCR {@r : Region} (cr : CR r): S (Write r + Alloc r) (Vector# r Word8#) + = do storeCR cr (allocTestRaw {@r} (oneGb * 2)) + +main () + = mutable r1 r2 in + do + cr = allocCR {@r2} () + obj = allocTestRawToCR cr + + writel $ "Start compute Fib Numbers. " + fib 40 + + writel $" " + writel $ "done! " + + diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/09-RawsCR4GB/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/09-RawsCR4GB/Main.ds new file mode 100644 index 000000000..f6cb20968 --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/09-RawsCR4GB/Main.ds @@ -0,0 +1,40 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +where + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + +allocTestRawToCR {@r : Region} (cr : CR r): S (Write r + Alloc r) (Vector# r Word8#) + = do storeCR cr (allocTestRaw {@r} (oneGb * 4)) + +main () + = mutable r1 r2 in + do + cr = allocCR {@r2} () + obj = allocTestRawToCR cr + + writel $ "Start compute Fib Numbers. " + fib 40 + + writel $" " + writel $ "done! " + + diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/20-AllRef/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/20-AllRef/Main.ds new file mode 100644 index 000000000..417581579 --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/20-AllRef/Main.ds @@ -0,0 +1,46 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +import foreign c value + + ddcTraceObj : [r: Region]. Bool# -> Bool# -> DList -> Unit + ddcTraceCRByHandle : [r: Region]. CR r -> Unit + + +where + +data DList = DNil | DCons DList DList + +countListPure (curr : Nat) (max : Nat) (secondMax : Nat): DList + = do case curr == max of + True -> DNil + False -> do v = (countListPurePrim 0 secondMax) + DCons v (countListPure (curr+1) max secondMax) + +countListPurePrim (curr : Nat) (max : Nat) : DList + = do case curr == max of + True -> DNil + False -> DCons DNil (countListPurePrim (curr+1) max) + +-- slow Fib +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + + +-- 10000*2600 boxded object with single field is roughly 1GB +main () + = do a = countListPure 0 10000 2600 + writel $ "" + writel $ "Start calculating Fib." + fib 40 + writel $ "done" diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/21-75Ref/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/21-75Ref/Main.ds new file mode 100644 index 000000000..10db7a3ce --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/21-75Ref/Main.ds @@ -0,0 +1,55 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +import foreign c value + + ddcTraceObj : [r: Region]. Bool# -> Bool# -> DList -> Unit + ddcTraceCRByHandle : [r: Region]. CR r -> Unit + + +where + +data DList = DNil | DCons DList DList + +countListPure (curr : Nat) (max : Nat) (secondMax : Nat): DList + = do case curr == max of + True -> DNil + False -> do v = (countListPurePrim 0 secondMax) + DCons v (countListPure (curr+1) max secondMax) + +countListPurePrim (curr : Nat) (max : Nat) : DList + = do case curr == max of + True -> DNil + False -> DCons DNil (countListPurePrim (curr+1) max) + +-- slow Fib +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + +-- 10000*2600 boxded object with single field is roughly 1GB +-- 75% is 10000*1950, need 250MB more raw data. + +main () + = mutable r in + do a = countListPure 0 10000 1950 + b = allocTestRaw {@r} (oneMb * 250) + writel $ "" + writel $ "Start calculating Fib." + fib 40 + writel $ "done" diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/22-50Ref/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/22-50Ref/Main.ds new file mode 100644 index 000000000..5d0a22fce --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/22-50Ref/Main.ds @@ -0,0 +1,55 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +import foreign c value + + ddcTraceObj : [r: Region]. Bool# -> Bool# -> DList -> Unit + ddcTraceCRByHandle : [r: Region]. CR r -> Unit + + +where + +data DList = DNil | DCons DList DList + +countListPure (curr : Nat) (max : Nat) (secondMax : Nat): DList + = do case curr == max of + True -> DNil + False -> do v = (countListPurePrim 0 secondMax) + DCons v (countListPure (curr+1) max secondMax) + +countListPurePrim (curr : Nat) (max : Nat) : DList + = do case curr == max of + True -> DNil + False -> DCons DNil (countListPurePrim (curr+1) max) + +-- slow Fib +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + +-- 10000*2600 boxded object with single field is roughly 1GB +-- 50% is 10000*1300, need 500MB more raw data. + +main () + = mutable r in + do a = countListPure 0 10000 1300 + b = allocTestRaw {@r} (oneMb * 500) + writel $ "" + writel $ "Start calculating Fib." + fib 40 + writel $ "done" diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/23-25Ref/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/23-25Ref/Main.ds new file mode 100644 index 000000000..3ecc573d9 --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/23-25Ref/Main.ds @@ -0,0 +1,55 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +import foreign c value + + ddcTraceObj : [r: Region]. Bool# -> Bool# -> DList -> Unit + ddcTraceCRByHandle : [r: Region]. CR r -> Unit + + +where + +data DList = DNil | DCons DList DList + +countListPure (curr : Nat) (max : Nat) (secondMax : Nat): DList + = do case curr == max of + True -> DNil + False -> do v = (countListPurePrim 0 secondMax) + DCons v (countListPure (curr+1) max secondMax) + +countListPurePrim (curr : Nat) (max : Nat) : DList + = do case curr == max of + True -> DNil + False -> DCons DNil (countListPurePrim (curr+1) max) + +-- slow Fib +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + +-- 10000*2600 boxded object with single field is roughly 1GB +-- 25% is 10000*750, need 750MB more raw data. + +main () + = mutable r in + do a = countListPure 0 10000 750 + b = allocTestRaw {@r} (oneMb * 750) + writel $ "" + writel $ "Start calculating Fib." + fib 40 + writel $ "done" diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/24-AllRefCR/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/24-AllRefCR/Main.ds new file mode 100644 index 000000000..3fcece330 --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/24-AllRefCR/Main.ds @@ -0,0 +1,46 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +import foreign c value + + ddcTraceObj : [r: Region]. Bool# -> Bool# -> DList -> Unit + ddcTraceCRByHandle : [r: Region]. CR r -> Unit + +where + +data DList = DNil | DCons DList DList + +countList {@r: Region} (cr : CR r) (curr : Nat ) (max : Nat) (secondMax : Nat) : S (Write r) DList + = do case curr == max of + True -> storeCRIgnoreRef cr DNil + False -> storeCRIgnoreRef cr $ DCons (countListPrim cr 0 secondMax) (countList cr (curr+1) max secondMax) + + +countListPrim {@r: Region} (cr : CR r) (curr : Nat) (max : Nat) : S (Write r) DList + = do case curr == max of + True -> DNil + False -> DCons DNil (countListPrim cr (curr+1) max) + +-- slow Fib +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + +main () + = mutable r1 in + do + cr = allocCR {@r1} () + a = countList cr 0 10000 2600 + writel $ "" + writel $ "OK, now caulculate the fib." + fib 100 + writel $ "done" \ No newline at end of file diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/25-75RefCR/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/25-75RefCR/Main.ds new file mode 100644 index 000000000..5ffaf2755 --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/25-75RefCR/Main.ds @@ -0,0 +1,58 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +import foreign c value + + ddcTraceObj : [r: Region]. Bool# -> Bool# -> DList -> Unit + ddcTraceCRByHandle : [r: Region]. CR r -> Unit + +where + +data DList = DNil | DCons DList DList + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + + +countList {@r: Region} (cr : CR r) (curr : Nat ) (max : Nat) (secondMax : Nat) : S (Write r) DList + = do case curr == max of + True -> storeCRIgnoreRef cr DNil + False -> storeCRIgnoreRef cr $ DCons (countListPrim cr 0 secondMax) (countList cr (curr+1) max secondMax) + + +countListPrim {@r: Region} (cr : CR r) (curr : Nat) (max : Nat) : S (Write r) DList + = do case curr == max of + True -> DNil + False -> DCons DNil (countListPrim cr (curr+1) max) + +allocTestRawToCR {@r : Region} (cr : CR r): S (Write r + Alloc r) (Vector# r Word8#) + = do storeCR cr (allocTestRaw {@r} (oneMb * 250)) + +-- slow Fib +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + + +main () + = mutable r1 in + do + cr = allocCR {@r1} () + a = countList cr 0 10000 1950 + b = allocTestRawToCR cr + writel $ "" + writel $ "OK, now caulculate the fib." + fib 40 + writel $ "done" \ No newline at end of file diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/26-50RefCR/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/26-50RefCR/Main.ds new file mode 100644 index 000000000..6c7b5c4cb --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/26-50RefCR/Main.ds @@ -0,0 +1,58 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +import foreign c value + + ddcTraceObj : [r: Region]. Bool# -> Bool# -> DList -> Unit + ddcTraceCRByHandle : [r: Region]. CR r -> Unit + +where + +data DList = DNil | DCons DList DList + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + + +countList {@r: Region} (cr : CR r) (curr : Nat ) (max : Nat) (secondMax : Nat) : S (Write r) DList + = do case curr == max of + True -> storeCRIgnoreRef cr DNil + False -> storeCRIgnoreRef cr $ DCons (countListPrim cr 0 secondMax) (countList cr (curr+1) max secondMax) + + +countListPrim {@r: Region} (cr : CR r) (curr : Nat) (max : Nat) : S (Write r) DList + = do case curr == max of + True -> DNil + False -> DCons DNil (countListPrim cr (curr+1) max) + +allocTestRawToCR {@r : Region} (cr : CR r): S (Write r + Alloc r) (Vector# r Word8#) + = do storeCR cr (allocTestRaw {@r} (oneMb * 750)) + +-- slow Fib +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + + +main () + = mutable r1 in + do + cr = allocCR {@r1} () + a = countList cr 0 10000 750 + b = allocTestRawToCR cr + writel $ "" + writel $ "OK, now caulculate the fib." + fib 40 + writel $ "done" \ No newline at end of file diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/27-25RefCR/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/27-25RefCR/Main.ds new file mode 100644 index 000000000..accc4566c --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/27-25RefCR/Main.ds @@ -0,0 +1,58 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +import foreign c value + + ddcTraceObj : [r: Region]. Bool# -> Bool# -> DList -> Unit + ddcTraceCRByHandle : [r: Region]. CR r -> Unit + +where + +data DList = DNil | DCons DList DList + +oneGb : Nat + = 1073741824 + +oneMb : Nat + = 1048576 + + +countList {@r: Region} (cr : CR r) (curr : Nat ) (max : Nat) (secondMax : Nat) : S (Write r) DList + = do case curr == max of + True -> storeCRIgnoreRef cr DNil + False -> storeCRIgnoreRef cr $ DCons (countListPrim cr 0 secondMax) (countList cr (curr+1) max secondMax) + + +countListPrim {@r: Region} (cr : CR r) (curr : Nat) (max : Nat) : S (Write r) DList + = do case curr == max of + True -> DNil + False -> DCons DNil (countListPrim cr (curr+1) max) + +allocTestRawToCR {@r : Region} (cr : CR r): S (Write r + Alloc r) (Vector# r Word8#) + = do storeCR cr (allocTestRaw {@r} (oneMb * 500)) + +-- slow Fib +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + + +main () + = mutable r1 in + do + cr = allocCR {@r1} () + a = countList cr 0 10000 1300 + b = allocTestRawToCR cr + writel $ "" + writel $ "OK, now caulculate the fib." + fib 40 + writel $ "done" \ No newline at end of file diff --git a/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/32-AllRefCRToHeap/Main.ds b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/32-AllRefCRToHeap/Main.ds new file mode 100644 index 000000000..3e00574b1 --- /dev/null +++ b/test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/99-skip/32-AllRefCRToHeap/Main.ds @@ -0,0 +1,58 @@ +module Main +import System.IO.Console +import Class.Show +import Class.Numeric +import Class.Ord +import Data.Numeric.Nat +import Data.Function +import Data.Ref +import Data.CompactRegion + +import foreign c value + + ddcTraceObj : [r: Region]. Bool# -> Bool# -> DList -> Unit + ddcTraceCRByHandle : [r: Region]. CR r -> Unit + +where + +data DList = DNil | DCons DList DList + +countList {@r: Region} (cr : CR r) (curr : Nat ) (max : Nat) (secondMax : Nat) : S (Write r) DList + = do case curr == max of + True -> storeCRIgnoreRef cr (countListPure 0 10000 1300) + False -> storeCRIgnoreRef cr $ DCons (countListPrim cr 0 secondMax) (countList cr (curr+1) max secondMax) + + +countListPrim {@r: Region} (cr : CR r) (curr : Nat) (max : Nat) : S (Write r) DList + = do case curr == max of + True -> DNil + False -> DCons DNil (countListPrim cr (curr+1) max) + +countListPure (curr : Nat) (max : Nat) (secondMax : Nat): DList + = do case curr == max of + True -> DNil + False -> do v = (countListPurePrim 0 secondMax) + DCons v (countListPure (curr+1) max secondMax) + +countListPurePrim (curr : Nat) (max : Nat) : DList + = do case curr == max of + True -> DNil + False -> DCons DNil (countListPurePrim (curr+1) max) + + +-- slow Fib +fib (a: Nat) : Nat + = case a of + 0 -> 1 + 1 -> 1 + _ -> (fib (a-1)) + (fib (a-2)) + +main () + = mutable r1 in + do + cr = allocCR {@r1} () + a = countList cr 0 10000 1300 + writel $ "" + writel $ "OK, now caulculate the fib." + fib 40 + writel $ "done" \ No newline at end of file