From 171fa5a66333890f077f4d9e35f324cfe503d1c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Thu, 25 Sep 2025 14:01:24 +0200 Subject: [PATCH 01/47] Rename 'Call' to 'StackExpand` in IR, Raw, and Stack This brings the name closer to the actual meaning of this construction. --- compiler/src/ClosureConv.hs | 2 +- compiler/src/IR.hs | 13 +++++++------ compiler/src/IR2Raw.hs | 4 ++-- compiler/src/IROpt.hs | 6 +++--- compiler/src/Raw.hs | 4 ++-- compiler/src/Raw2Stack.hs | 4 ++-- compiler/src/RawDefUse.hs | 2 +- compiler/src/RawOpt.hs | 23 ++++++++++++----------- compiler/src/Stack.hs | 4 ++-- compiler/src/Stack2JS.hs | 2 +- compiler/test/ir2raw-test/testcases/TR.hs | 4 ++-- 11 files changed, 35 insertions(+), 33 deletions(-) diff --git a/compiler/src/ClosureConv.hs b/compiler/src/ClosureConv.hs index d92d4024..4b212f1c 100644 --- a/compiler/src/ClosureConv.hs +++ b/compiler/src/ClosureConv.hs @@ -201,7 +201,7 @@ cpsToIR (CPS.LetSimple vname@(VN ident) st kt) = do cpsToIR (CPS.LetRet (CPS.Cont arg kt') kt) = do t <- cpsToIR kt t' <- local (insVar arg) (cpsToIR kt') - return $ CCIR.BB [] $ Call arg t t' + return $ CCIR.BB [] $ StackExpand arg t t' cpsToIR (CPS.LetFun fdefs kt) = do let vnames_orig = map (\(CPS.Fun fname _) -> fname) fdefs let localExt = local (insVars vnames_orig) diff --git a/compiler/src/IR.hs b/compiler/src/IR.hs index 8621c088..c4836153 100644 --- a/compiler/src/IR.hs +++ b/compiler/src/IR.hs @@ -91,7 +91,7 @@ data IRTerminator -- and then execute the second BB, which can refer to this variable and -- where PC is reset to the level before entering the first BB. -- Represents a "let x = ... in ..." format. - | Call VarName IRBBTree IRBBTree + | StackExpand VarName IRBBTree IRBBTree deriving (Eq,Show,Generic) @@ -147,7 +147,7 @@ instance ComputesDependencies IRBBTree where instance ComputesDependencies IRTerminator where dependencies (If _ bb1 bb2) = mapM_ dependencies [bb1, bb2] dependencies (AssertElseError _ bb1 _ _) = dependencies bb1 - dependencies (Call _ t1 t2) = dependencies t1 >> dependencies t2 + dependencies (StackExpand _ t1 t2) = dependencies t1 >> dependencies t2 dependencies _ = return () instance ComputesDependencies FunDef where @@ -231,15 +231,15 @@ instance WellFormedIRCheck IRInst where wfir (Assign (VN x) e) = do checkId x wfir e wfir (MkFunClosures _ fdefs) = mapM_ (\((VN x), _) -> checkId x) fdefs - + instance WellFormedIRCheck IRTerminator where wfir (If _ bb1 bb2) = do wfir bb1 wfir bb2 wfir (AssertElseError _ bb _ _) = wfir bb - wfir (Call (VN x) bb1 bb2 ) = do - checkId x + wfir (StackExpand (VN x) bb1 bb2 ) = do + checkId x wfir bb1 wfir bb2 @@ -442,7 +442,8 @@ ppIR (MkFunClosures varmap fdefs) = -ppTr (Call vn bb1 bb2) = (ppId vn <+> text "= call" $$ nest 2 (ppBB bb1)) $$ (ppBB bb2) + +ppTr (StackExpand vn bb1 bb2) = (ppId vn <+> text "= call" $$ nest 2 (ppBB bb1)) $$ (ppBB bb2) ppTr (AssertElseError va ir va2 _) diff --git a/compiler/src/IR2Raw.hs b/compiler/src/IR2Raw.hs index 7f663c17..6bc633c9 100644 --- a/compiler/src/IR2Raw.hs +++ b/compiler/src/IR2Raw.hs @@ -699,7 +699,7 @@ tr2raw = \case return $ If r bb1' bb2' -- Revision 2023-08: Equivalent, only way of modifying bb2 changed. - IR.Call v irBB1 irBB2 -> do + IR.StackExpand v irBB1 irBB2 -> do bb1 <- tree2raw irBB1 BB insts2 tr2 <- tree2raw irBB2 -- Prepend before insts2 instructions to store in variable v the result @@ -711,7 +711,7 @@ tr2raw = \case -- generally using Sequence (faster concatenation) for instructions -- might improve performance let bb2 = BB insts2' tr2 - return $ Call bb1 bb2 + return $ StackExpand bb1 bb2 -- Note: This is translated into branching and Error for throwing RT exception -- Revision 2023-08: More fine-grained raising of blocking label, see below. diff --git a/compiler/src/IROpt.hs b/compiler/src/IROpt.hs index 610c1f24..f0676ef2 100644 --- a/compiler/src/IROpt.hs +++ b/compiler/src/IROpt.hs @@ -67,7 +67,7 @@ instance Substitutable IRTerminator where AssertElseError (apply subst x) (apply subst bb) (apply subst y) pos LibExport x -> LibExport (apply subst x) Error x pos -> Error (apply subst x) pos - Call decVar bb1 bb2 -> Call decVar (apply subst bb1) (apply subst bb2) + StackExpand decVar bb1 bb2 -> StackExpand decVar (apply subst bb1) (apply subst bb2) instance Substitutable IRBBTree where apply subst (BB insts tr) = @@ -462,7 +462,7 @@ trPeval (AssertElseError x bb y_err pos) = do return $ BB [] (AssertElseError x bb' y_err pos) -trPeval (Call x bb1 bb2) = do +trPeval (StackExpand x bb1 bb2) = do bb1' <- peval bb1 bb2' <- peval bb2 @@ -473,7 +473,7 @@ trPeval (Call x bb1 bb2) = do setChangeFlag return $ BB (insts1 ++ insts2) tr2 _ -> - return $ BB [] (Call x bb1' bb2') + return $ BB [] (StackExpand x bb1' bb2') trPeval tr@(Ret x) = do markUsed' x diff --git a/compiler/src/Raw.hs b/compiler/src/Raw.hs index a9a17046..2f7a5ff9 100644 --- a/compiler/src/Raw.hs +++ b/compiler/src/Raw.hs @@ -158,7 +158,7 @@ data RawTerminator | Error RawVar PosInf -- | Execute the first BB and then execute the second BB where -- PC is reset to the level before entering the first BB. - | Call RawBBTree RawBBTree + | StackExpand RawBBTree RawBBTree deriving (Eq, Show) @@ -341,7 +341,7 @@ ppIR (MkFunClosures varmap fdefs) = -- ppIR (LevelOperations _ insts) = -- text "level operation" $$ nest 2 (vcat (map ppIR insts)) -ppTr (Call bb1 bb2) = (text "call" $$ nest 4 (ppBB bb1)) $$ (ppBB bb2) +ppTr (StackExpand bb1 bb2) = (text "call" $$ nest 4 (ppBB bb1)) $$ (ppBB bb2) -- ppTr (AssertElseError va ir va2 _) diff --git a/compiler/src/Raw2Stack.hs b/compiler/src/Raw2Stack.hs index caf87c3b..b4e892a7 100644 --- a/compiler/src/Raw2Stack.hs +++ b/compiler/src/Raw2Stack.hs @@ -188,7 +188,7 @@ trTr (Raw.LibExport v) = do return $ Stack.LibExport v trTr (Raw.Error r1 p) = do return $ Stack.Error r1 p -trTr (Raw.Call bb1 bb2) = do +trTr (Raw.StackExpand bb1 bb2) = do __callDepth <- localCallDepth <$> ask bb1' <- local (\tenv -> tenv { localCallDepth = __callDepth + 1 } ) $ trBB bb1 n <- getBlockNumber @@ -205,7 +205,7 @@ trTr (Raw.Call bb1 bb2) = do | x <- filter filterConsts (Set.elems varsToLoad) ] bb2'@(Stack.BB inst_2 tr_2) <- trBB bb2 - return $ Stack.Call bb1' (Stack.BB (loads ++ inst_2) tr_2) + return $ Stack.StackExpand bb1' (Stack.BB (loads ++ inst_2) tr_2) trBB :: Raw.RawBBTree -> Tr Stack.StackBBTree diff --git a/compiler/src/RawDefUse.hs b/compiler/src/RawDefUse.hs index c6b7314f..e987b917 100644 --- a/compiler/src/RawDefUse.hs +++ b/compiler/src/RawDefUse.hs @@ -233,7 +233,7 @@ instance Trav RawTerminator where trav bb2 LibExport v -> use v Error r _ -> use r - Call bb1 bb2 -> do + StackExpand bb1 bb2 -> do trav bb1 modify (\s -> let (c, _) = locInfo s diff --git a/compiler/src/RawOpt.hs b/compiler/src/RawOpt.hs index 937dc8be..e7253b77 100644 --- a/compiler/src/RawOpt.hs +++ b/compiler/src/RawOpt.hs @@ -78,7 +78,7 @@ instance Substitutable RawTerminator where If r bb1 bb2 -> If (apply subst r) (apply subst bb1) (apply subst bb2) Error r p -> Error (apply subst r) p - Call bb1 bb2 -> Call (apply subst bb1) (apply subst bb2) + StackExpand bb1 bb2 -> StackExpand (apply subst bb1) (apply subst bb2) _ -> tr instance Substitutable RawBBTree where @@ -420,7 +420,7 @@ instance PEval RawTerminator where } bb2' <- peval bb2 return $ If x bb1' bb2' - Call bb1 bb2 -> do + StackExpand bb1 bb2 -> do s <- get bb1' <- peval bb1 put $ s { stateMon = Map.empty @@ -428,7 +428,7 @@ instance PEval RawTerminator where , stateJoins = stateJoins s } -- reset the monitor state bb2' <- peval bb2 - return $ Call bb1' bb2' + return $ StackExpand bb1' bb2' Ret -> do return tr' TailCall x -> do @@ -470,14 +470,15 @@ filterInstBwd ls = f (Nothing, Nothing) (reverse ls) [] --- | This optimization for 'Call' moves instructions from the continuation to before the 'Call'. --- This can result in a 'Call' which just contains a 'Ret', which is then optimized away. --- The optimization compensates for redundant assignments introduced by the translation. -hoistCalls :: RawBBTree -> RawBBTree -hoistCalls bb@(BB insts tr) = +-- | This optimization for 'StackExpand' moves instructions from the continuation to before the +-- 'StackExpand'. This can result in a 'StackExpand' which just contains a 'Ret', which is then +-- optimized away. The optimization compensates for redundant assignments introduced by the +-- translation. +hoistStackExpand :: RawBBTree -> RawBBTree +hoistStackExpand bb@(BB insts tr) = case tr of -- Here we check which instructions from ii_1 can be moved to before the call - Call (BB ii_1 tr_1) bb2 -> + StackExpand (BB ii_1 tr_1) bb2 -> let isFrameSpecific i = case i of SetBranchFlag -> True @@ -487,7 +488,7 @@ hoistCalls bb@(BB insts tr) = -- jx_1: non-frame-specific instructions, are moved to before the call -- jx_2: frame-specific instructions, stay under the call's instructions (jx_1, jx_2) = Data.List.break isFrameSpecific ii_1 - in BB (insts ++ jx_1) (Call (BB jx_2 tr_1) bb2) + in BB (insts ++ jx_1) (StackExpand (BB jx_2 tr_1) bb2) -- If returning, the current frame will be removed, and thus all PC set instructions -- are redundant and can be removed. Ret -> @@ -537,7 +538,7 @@ instance PEval RawBBTree where If x (BB (set_pc_bl ++ i_then) tr_then) (BB (set_pc_bl ++ i_else) tr_else) - _ -> hoistCalls $ BB (insts_no_ret ++ set_pc_bl) tr'' + _ -> hoistStackExpand $ BB (insts_no_ret ++ set_pc_bl) tr'' let insts_sorted = instOrder insts_ return $ BB insts_sorted bb_ diff --git a/compiler/src/Stack.hs b/compiler/src/Stack.hs index 6427a452..91f3e4f9 100644 --- a/compiler/src/Stack.hs +++ b/compiler/src/Stack.hs @@ -47,7 +47,7 @@ data StackTerminator | If RawVar StackBBTree StackBBTree | LibExport VarAccess | Error RawVar PosInf - | Call StackBBTree StackBBTree + | StackExpand StackBBTree StackBBTree deriving (Eq, Show) @@ -150,7 +150,7 @@ ppIR (MkFunClosures varmap fdefs) = ppIR (LabelGroup insts) = text "group" $$ nest 2 (vcat (map ppIR insts)) -ppTr (Call bb1 bb2) = (text "= call" $$ nest 2 (ppBB bb1)) $$ (ppBB bb2) +ppTr (StackExpand bb1 bb2) = (text "= call" $$ nest 2 (ppBB bb1)) $$ (ppBB bb2) -- ppTr (AssertElseError va ir va2 _) diff --git a/compiler/src/Stack2JS.hs b/compiler/src/Stack2JS.hs index 5717b99f..0a11bedd 100644 --- a/compiler/src/Stack2JS.hs +++ b/compiler/src/Stack2JS.hs @@ -452,7 +452,7 @@ ir2js InvalidateSparseBit = return $ {-- TERMINATORS --} -tr2js (Call bb bb2) = do +tr2js (StackExpand bb bb2) = do _frameSize <- gets frameSize _sparseSlot <- gets sparseSlot _consts <- gets consts diff --git a/compiler/test/ir2raw-test/testcases/TR.hs b/compiler/test/ir2raw-test/testcases/TR.hs index 4800b478..f330a8e0 100644 --- a/compiler/test/ir2raw-test/testcases/TR.hs +++ b/compiler/test/ir2raw-test/testcases/TR.hs @@ -30,8 +30,8 @@ tcs = map (second mkP) (BB [Assign (VN "b1") (Base "v1") ] (LibExport (mkV "b1"))) (BB [Assign (VN "b2") (Base "v2") ] (LibExport (mkV "b2"))) ), - ( "Call" - , Call (VN "x") + ( "StackExpand" + , StackExpand (VN "x") (BB [Assign (VN "b1") (Base "v1") ] (LibExport (mkV "b1"))) (BB [Assign (VN "b2") (Base "v2") ] (LibExport (mkV "b2"))) ), From d635b6019e41585f48b72175877489709213fa7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Thu, 25 Sep 2025 16:33:27 +0200 Subject: [PATCH 02/47] Improve lib record export syntax This way, is is less likely one by accident exports the wrong function under a different name --- lib/Hash.trp | 16 +++++++-------- lib/HashMap.trp | 32 +++++++++++++---------------- lib/HashSet.trp | 26 ++++++++++-------------- lib/List.trp | 47 ++++++++++++++++++------------------------- lib/ListPair.trp | 31 +++++++++++++--------------- lib/Number.trp | 39 ++++++++++++++++++----------------- lib/StencilVector.trp | 38 +++++++++++++++++----------------- lib/String.trp | 23 +++++++++++---------- lib/Unit.trp | 14 ++++++------- 9 files changed, 123 insertions(+), 143 deletions(-) diff --git a/lib/Hash.trp b/lib/Hash.trp index 5a4b0d90..f10ec7b0 100644 --- a/lib/Hash.trp +++ b/lib/Hash.trp @@ -68,15 +68,13 @@ let (*--- Module ---*) val Hash = { - hashString = hashString, - hashMultiplyShift = hashMultiplyShift, - hashInt = hashInt, - hashNumber = hashNumber, - hashList = hashList, - hash = hash + hashString, + hashMultiplyShift, + hashInt, + hashNumber, + hashList, + hash } -in [ ("Hash", Hash) - , ("hash", hash) - ] +in [ ("Hash", Hash), ("hash", hash) ] end diff --git a/lib/HashMap.trp b/lib/HashMap.trp index 43358544..a8e25072 100644 --- a/lib/HashMap.trp +++ b/lib/HashMap.trp @@ -202,24 +202,20 @@ let (* NOTE: The map is implemented as a Hash Array Mapped Trie (HAMT), i.e. a p (*--- Module ---*) val HashMap = { - (* Construction *) - empty = empty, - singleton = singleton, - insert = insert, - remove = remove, - (* Queries *) - null = null, - size = size, - findOpt = findOpt, - find = find, - mem = mem, - (* Manipulation *) - fold = fold, - (* List Conversion*) - keys = keys, - values = values, - toList = toList, - fromList = fromList + empty, + singleton, + insert, + remove, + null, + size, + findOpt, + find, + mem, + fold, + keys, + values, + toList, + fromList } in [ ("HashMap", HashMap) ] diff --git a/lib/HashSet.trp b/lib/HashSet.trp index 0ffccbc5..ccad42d0 100644 --- a/lib/HashSet.trp +++ b/lib/HashSet.trp @@ -47,21 +47,17 @@ let (* NOTE: The set is implemented as a HashMap with dummy values, `()`. This i (*--- Module ---*) val HashSet = { - (* Construction *) - empty = empty, - singleton = singleton, - insert = insert, - remove = remove, - (* Queries *) - null = null, - size = size, - mem = mem, - (* Manipulation *) - fold = fold, - (* List Conversion*) - elems = elems, - toList = toList, - fromList = fromList + empty, + singleton, + insert, + remove, + null, + size, + mem, + fold, + elems, + toList, + fromList } in [ ("HashSet", HashSet) ] diff --git a/lib/List.trp b/lib/List.trp index 872936e9..775007e3 100644 --- a/lib/List.trp +++ b/lib/List.trp @@ -169,33 +169,26 @@ let (* -- List Access -- *) (*--- Module ---*) val List = { - head = head, - tail = tail, - nth = nth, - - null = null, - elem = elem, - length = length, - - reverse = reverse, - append = append, - revAppend = revAppend, - appendAt = appendAt, - sublist = sublist, - - map = map, - mapi = mapi, - foldl = foldl, - filter = filter, - filteri = filteri, - partition = partition, - - range = range, - - sort = sort + head, + tail, + nth, + null, + elem, + length, + reverse, + append, + revAppend, + appendAt, + sublist, + map, + mapi, + foldl, + filter, + filteri, + partition, + range, + sort } -in [ ("List", List), - ("length", length) - ] +in [ ("List", List), ("length", length) ] end diff --git a/lib/ListPair.trp b/lib/ListPair.trp index 20d03ca6..94b54eed 100644 --- a/lib/ListPair.trp +++ b/lib/ListPair.trp @@ -64,22 +64,19 @@ let (* -- ListPair Generation -- *) (*--- Module ---*) val ListPair = { - zip = zip, - unzip = unzip, - - null = null, - length = length, - - reverse = reverse, - append = append, - revAppend = revAppend, - - findOpt = findOpt, - find = find, - mem = mem, - - map = map, - foldl = foldl + zip, + unzip, + null, + length, + reverse, + append, + revAppend, + findOpt, + find, + mem, + map, + foldl } -in [ ("ListPair", ListPair) ] end +in [ ("ListPair", ListPair) ] +end diff --git a/lib/Number.trp b/lib/Number.trp index ad9b7527..a8867220 100644 --- a/lib/Number.trp +++ b/lib/Number.trp @@ -93,25 +93,26 @@ let (** Largest (safe) possible integral value. Anything larger than this cannot (*--- Module ---*) val Number = { - maxInt = maxInt, - minInt = minInt, - precision = precision, - maxInt32 = maxInt32, - minInt32 = minInt32, - maxNum = maxNum, - minNum = minNum, - abs = abs, - min = min, - max = max, - ceil = ceil, - floor = floor, - round = round, - sqrt = sqrt, - isInt = isInt, - toInt = toInt, - toInt32 = toInt32, - toString = toString, - fromString = fromString + maxInt, + minInt, + precision, + maxInt32, + minInt32, + maxNum, + minNum, + abs, + min, + max, + ceil, + floor, + round, + sqrt, + isInt, + toInt, + toInt32, + toString, + fromString } + in [("Number", Number)] end diff --git a/lib/StencilVector.trp b/lib/StencilVector.trp index a272bc91..f73701cc 100644 --- a/lib/StencilVector.trp +++ b/lib/StencilVector.trp @@ -146,26 +146,24 @@ let (*--- Constants ---*) (* TODO: Lift list functions `mapi`, `find` and `filter`? *) + (*--- Module ---*) val StencilVector = { - (* Constants *) - maskBits = maskBits, - maskMax = maskMax, - (* Functions *) - empty = empty, - singleton = singleton, - get = get, - getOrDefault = getOrDefault, - set = set, - unset = unset, - mem = mem, - valid = valid, - null = null, - mask = mask, - length = length, - map = map, - fold = fold + maskBits, + maskMax, + empty, + singleton, + get, + getOrDefault, + set, + unset, + mem, + valid, + null, + mask, + length, + map, + fold } -in (* Export public functions *) - [ ("StencilVector", StencilVector) - ] + +in [ ("StencilVector", StencilVector) ] end diff --git a/lib/String.trp b/lib/String.trp index b275f776..2dfe068e 100644 --- a/lib/String.trp +++ b/lib/String.trp @@ -70,17 +70,18 @@ let (** The maximum length of a string. (*--- Module ---*) val String = { - maxSize = maxSize, - size = size, - sub = sub, - subCode = subCode, - substring = substring, - concat = concat, - concatWith = concatWith, - implode = implode, - explode = explode, - map = map, - translate = translate + maxSize, + size, + sub, + subCode, + substring, + concat, + concatWith, + implode, + explode, + map, + translate } + in [("String", String)] end diff --git a/lib/Unit.trp b/lib/Unit.trp index 483d32ac..f4b49eba 100644 --- a/lib/Unit.trp +++ b/lib/Unit.trp @@ -112,13 +112,13 @@ let (*--- Module ---*) val Unit = { - group = group, - it = it, - isEq = isEq, - isTrue = isTrue, - isFalse = isFalse, - isNeq = isNeq, - run = run + group, + it, + isEq, + isTrue, + isFalse, + isNeq, + run } in [ ("Unit", Unit) ] From ff4de5c5a6ab5f59bab3f70f454f20d0b634a0f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Fri, 26 Sep 2025 10:30:43 +0200 Subject: [PATCH 03/47] Manifest design of the Standard Library in its README --- lib/README.md | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/lib/README.md b/lib/README.md index ea43f188..44119947 100644 --- a/lib/README.md +++ b/lib/README.md @@ -21,13 +21,19 @@ reviewed rigorously rather than depend on the monitor. To compile a module as part of the standard library, add it to the list of files in the `lib` target of the *makefile*. +## Design Principles + +- File names are written in `CamelCase`. This makes them conform to the Standard ML Basis Library. +- It is more important to match the function names and signatures in the Standard ML library than to + improve on them. For example, `String.sub` would make more sense with the type `[Char] -> Int -> + Char` but to match the SML library, we will stick with `[Char] * Int -> Char`. +- Each module exports a single *record* with the same name as the file. This (1) makes it closer to + the SML module system and (2) allows for name resolution, e.g. `HashMap.findOpt` and + `ListPair.findOpt` can be used in the same file. +- Each function that is exported has to be documented (`(** *)`). In the long run, we will + auto-generate documentation for the Standard Library. + ## TODO -- To conform with the Standard ML Basis Library, we should have the files conform to a `CamelCase` - style. -- To fake namespaced import, e.g. `List.length`, the library should export a struct instead. Only - certain functions should "pollute" the global namespace. -- Quite a lot of the standard library is not documented in any way. What is the purpose of each - function and each module? The [modules](#modules) above are the ones that have been updated and - documented. -- There are a lot of things in here - some of it dead. Can we merge/remove some things? +The [modules](#modules) mentioned above already follow the [design principles](#design-principles). +The remaining files either need to be updated or to be removed. From 26bc60d436c1d256ed51d53ef669cdeaa2e06c0a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 29 Sep 2025 16:36:16 +0200 Subject: [PATCH 04/47] Set up Dependabot to keep an eye on Action dependencies --- .github/dependabot.yml | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 .github/dependabot.yml diff --git a/.github/dependabot.yml b/.github/dependabot.yml new file mode 100644 index 00000000..5ace4600 --- /dev/null +++ b/.github/dependabot.yml @@ -0,0 +1,6 @@ +version: 2 +updates: + - package-ecosystem: "github-actions" + directory: "/" + schedule: + interval: "weekly" From 62cfb2bd397559dfba2288506fb4c69043e0b80c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 29 Sep 2025 16:45:46 +0200 Subject: [PATCH 05/47] Fix 'Data.ByteString.getLine' is deprecated --- compiler/app/Main.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index fd007e2b..400fa6f5 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs @@ -21,9 +21,8 @@ import qualified Raw2Stack import qualified Stack2JS import qualified RawOpt -- import System.IO (isEOF) -import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS import Data.ByteString.Base64 (decode) -import qualified Data.ByteString.Char8 as BSChar8 import qualified Data.ByteString.Lazy.Char8 as BSLazyChar8 import System.IO import System.Exit @@ -220,7 +219,7 @@ fromStdinIR = do input <- BS.getLine if BS.isPrefixOf "!ECHO " input then let response = BS.drop 6 input - in do BSChar8.putStrLn response + in do BS.putStrLn response -- debugOut "echo" else case decode input of @@ -244,7 +243,7 @@ fromStdinIRJson = do input <- BS.getLine if BS.isPrefixOf "!ECHO " input then let response = BS.drop 6 input - in BSChar8.putStrLn response + in BS.putStrLn response else case decode input of Right bs -> From a0b2945560a9034984929afe2feb141630c4d52c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 29 Sep 2025 16:54:32 +0200 Subject: [PATCH 06/47] Rename 'make all' to 'make build' to match conventions --- Makefile | 2 +- compiler/Makefile | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index 0012dafc..ebcdc384 100644 --- a/Makefile +++ b/Makefile @@ -12,7 +12,7 @@ rt: COMPILER=./bin/troupec compiler: - cd compiler; $(MAKE) all + cd compiler; $(MAKE) build p2p-tools: cd p2p-tools; tsc diff --git a/compiler/Makefile b/compiler/Makefile index 216554ec..4bacb78d 100644 --- a/compiler/Makefile +++ b/compiler/Makefile @@ -1,6 +1,6 @@ .PHONY: test -all: +build: stack -v build $(STACK_OPTS) mkdir -p ./../bin stack -v install $(STACK_OPTS) --local-bin-path ./../bin/ From 5cadeb6d382962fa6381b2941dbc7f21aca2219c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 29 Sep 2025 16:55:42 +0200 Subject: [PATCH 07/47] Remove verbosity if not otherwise requested --- compiler/Makefile | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/Makefile b/compiler/Makefile index 4bacb78d..2ef4c261 100644 --- a/compiler/Makefile +++ b/compiler/Makefile @@ -1,9 +1,12 @@ .PHONY: test +build: VERBOSITY_FLAG = build: - stack -v build $(STACK_OPTS) + stack $(VERBOSITY_FLAG) build $(STACK_OPTS) mkdir -p ./../bin - stack -v install $(STACK_OPTS) --local-bin-path ./../bin/ + stack $(VERBOSITY_FLAG) install $(STACK_OPTS) --local-bin-path ./../bin/ +build/verbose: + $(MAKE) $(MAKE_FLAGS) build VERBOSITY_FLAG="-v" clean: rm *.cabal From 98406948fa32c5ee9256df09b9bc93de57444b6e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 29 Sep 2025 17:04:19 +0200 Subject: [PATCH 08/47] Separate build step from installation (readding 'all' target) --- Makefile | 2 +- compiler/Makefile | 12 ++++++++++-- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index ebcdc384..0012dafc 100644 --- a/Makefile +++ b/Makefile @@ -12,7 +12,7 @@ rt: COMPILER=./bin/troupec compiler: - cd compiler; $(MAKE) build + cd compiler; $(MAKE) all p2p-tools: cd p2p-tools; tsc diff --git a/compiler/Makefile b/compiler/Makefile index 2ef4c261..be9ca64e 100644 --- a/compiler/Makefile +++ b/compiler/Makefile @@ -1,13 +1,21 @@ .PHONY: test +all: build install + build: VERBOSITY_FLAG = build: stack $(VERBOSITY_FLAG) build $(STACK_OPTS) - mkdir -p ./../bin - stack $(VERBOSITY_FLAG) install $(STACK_OPTS) --local-bin-path ./../bin/ build/verbose: $(MAKE) $(MAKE_FLAGS) build VERBOSITY_FLAG="-v" +install: VERBOSITY_FLAG = +install: + $(MAKE) $(MAKE_FLAGS) build + mkdir -p ./../bin + stack $(VERBOSITY_FLAG) install $(STACK_OPTS) --local-bin-path ./../bin/ +install/verbose: + $(MAKE) $(MAKE_FLAGS) install VERBOSITY_FLAG="-v" + clean: rm *.cabal stack clean --full From c5565fae71aaa5d0f0bca562aee96cdbda3a7844 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Tue, 30 Sep 2025 11:00:45 +0200 Subject: [PATCH 09/47] Move 'ghci' targets to the end and differentiate with '/' rather than '-' --- compiler/Makefile | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/Makefile b/compiler/Makefile index be9ca64e..47df99ca 100644 --- a/compiler/Makefile +++ b/compiler/Makefile @@ -22,14 +22,14 @@ clean: rm -rf ../bin # If problems still persist after this, remove all GHC compilers in ~/.stack/programs/**/ -ghci-irtester: - stack ghci --main-is Troupe-compiler:exe:irtester --no-load - -ghci-troupec: - stack ghci --main-is Troupe-compiler:exe:troupec --no-load - test: stack test $(STACK_OPTS) parser-info: stack exec happy -- -i src/Parser.y + +ghci/irtester: + stack ghci --main-is Troupe-compiler:exe:irtester --no-load + +ghci/troupec: + stack ghci --main-is Troupe-compiler:exe:troupec --no-load From c9526326b3029b0c2af19fba0687b32b15376fa5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 6 Oct 2025 10:21:29 +0200 Subject: [PATCH 10/47] Remove dead and deprecated code 'loadLibs.mts' --- rt/src/loadLibs.mts | 101 -------------------------------------------- 1 file changed, 101 deletions(-) delete mode 100644 rt/src/loadLibs.mts diff --git a/rt/src/loadLibs.mts b/rt/src/loadLibs.mts deleted file mode 100644 index 9ba07192..00000000 --- a/rt/src/loadLibs.mts +++ /dev/null @@ -1,101 +0,0 @@ -/* 2020-05-19: AA This code is deprecated */ - -'use strict' - -import * as fs from 'node:fs' - -import { mkLogger } from './logger.mjs' -const logger = mkLogger('lib') - -const info = x => logger.info(x) -const debug = x => logger.debug(x) - -const __libcache = {} - -export function loadLibsAsync(obj, rtObj, cb) { - let libs = obj.libs - obj.libs = {} - function iterateAsync(n) { - if (n < libs.length) { - let lib = libs[n].lib; - let decl = libs[n].decl; - - const key = lib +"." + decl - if (__libcache[key]) { - debug ('lib cache hit on: ' + key) - obj.libs[key]=__libcache[key]; - setImmediate(iterateAsync, n + 1); - return; - } - - // 1. Find the file -- note that we load all the libs from a default - // location - - let filename = process.env.TROUPE + "/lib/out/" + lib + ".js" - - - - // 2. Load the file -- note that this is an asynchronous operation - fs.readFile(filename, 'utf8', (err, input) => { - - // File read operation finished; we are now in the callbacak that has - // been asynchronously called by the node runtime - - // TODO: check for error! 2018-07-03: aa - - // 3. Create a JS class (function) from it - let Lib:any = new Function('rt', input); - - // 4. We create a "new" instance of the resulting class - - let libinstance = new Lib(rtObj); - - - // load dependent libraries?? - - // libinstance.loadlibs (() => - loadLibsAsync(libinstance, rtObj, () => { - // 5. Execute .export() function to obtain the table note - this is a - // regular JS function (generated by the compiler) that we just call - // here - - rtObj.setLibloadMode(); // 2019-01-03: AA; Hack - let table = libinstance.export().val.toArray(); - rtObj.setNormalMode(); // 2019-01-03: AA; EOH - - // 6. Lookup in the resulting table - - for (let i = 0; i < table.length; i++) { - let name = table[i].val[0].val; - let libf = table[i].val[1].val - if (name == decl) { - // We store the resulting function in the object that was provided - // to us as an argument - obj.libs[key] = libf; - __libcache [key] = libf; - break; - } - } - - // Next iteration - iterateAsync (n + 1); - }) - }) - - } else { - // We are done processing the lib files. Transferring control back to the - // callback. The callback is either - // - // a. The next thing in the initialization, if this is the first time we - // are loading libraries -- typically scheduler init, etc (see `start` - // function in the runtime), OR - // - // b. The next iteration in deserialization, which is more library loading - // when we have several namespaces, or whatever is the deserialization - // callback (see `mkValue` function in the serialize module). - - cb(); - } - } - iterateAsync (0); -} From 859ae6b03505a920b45282cfc1d225ecc6c719a4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 6 Oct 2025 11:03:23 +0200 Subject: [PATCH 11/47] Remove dead code and clean up string with JS preamble during deserialization --- rt/src/deserialize.mts | 26 ++++++++++---------------- 1 file changed, 10 insertions(+), 16 deletions(-) diff --git a/rt/src/deserialize.mts b/rt/src/deserialize.mts index 2c194875..f2567f4a 100644 --- a/rt/src/deserialize.mts +++ b/rt/src/deserialize.mts @@ -30,13 +30,16 @@ export function setRuntimeObj(rt: RuntimeInterface) { __rtObj = rt; } -const HEADER:string = - "this.libSet = new Set () \n\ - this.libs = [] \n\ - this.addLib = function (lib, decl)\ - { if (!this.libSet.has (lib +'.'+decl)) { \ - this.libSet.add (lib +'.'+decl);\ - this.libs.push ({lib:lib, decl:decl})} }\n" +const HEADER : string = ``` +this.libSet = new Set () \n\ +this.libs = [] \n\ +this.addLib = function (lib, decl) { + if (!this.libSet.has (lib +'.'+decl)) { + this.libSet.add (lib +'.'+decl);\ + this.libs.push ({lib:lib, decl:decl}) + } +} +``` function startCompiler() { __compilerOsProcess = spawn(process.env.TROUPE + '/bin/troupec', ['--json']); @@ -123,15 +126,6 @@ function constructCurrent(compilerOutput: string) { let atomSet = new Set() - // nsFun += "this.libSet = new Set () \n" - // nsFun += "this.libs = [] \n" - // nsFun += "this.addLib = function (lib, decl) " + - // " { if (!this.libSet.has (lib +'.'+decl)) { " + - // " this.libSet.add (lib +'.'+decl); " + - // " this.libs.push ({lib:lib, decl:decl})} } \n" - // nsFun += "this.loadlibs = function (cb) { rt.linkLibs (this.libs, this, cb) } \n" - - for (let j = 0; j < ns.length; j++) { if (j > 0) { nsFun += "\n\n" // looks neater this way From 92f3282f4e7d8ee4a692da68cc0f0c9af151af04 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 6 Oct 2025 12:00:18 +0200 Subject: [PATCH 12/47] Cleanup in 'deserialize.mts' Trailing whitespaces, missing semi colons, missing trailing comma on objects, odd comment structur, outcommented dead code, odd order of functions, ... --- rt/src/deserialize.mts | 267 +++++++++++++++++++---------------------- 1 file changed, 123 insertions(+), 144 deletions(-) diff --git a/rt/src/deserialize.mts b/rt/src/deserialize.mts index f2567f4a..8c9f296e 100644 --- a/rt/src/deserialize.mts +++ b/rt/src/deserialize.mts @@ -15,31 +15,37 @@ import { Record } from './Record.mjs'; import { RawClosure } from './RawClosure.mjs'; import * as levels from './Level.mjs'; +// OBS: The variables below are all global! This is because the callback and deserializedJson +// changes all the time while the compiler process has been started. + +/** We spawn an instance of the Troupe compiler in its interactive IR mode. Through this, we + * pass the IR provided by other nodes. + * + * Since there is only one compiler process which is accessed via the lock below, we can guarantee + * a FIFO ordering on the compilation input/output pairs. + */ let __compilerOsProcess = null; -let __rtObj = null; - -// obs: these are global... -let __isCurrentlyUsingCompiler = false; // simple flag to make sure we handle one deserialization at a time -let __currentCallback = null; // a callback for synchronizing with the caller -let __currentDeserializedJson = null; -let __trustLevel = null; +/** Simple flag to make sure we handle one deserialization at a time. */ +let __isCurrentlyUsingCompiler = false; +/** The runtime object to which we should be deserializing. */ +let __rtObj = null; export function setRuntimeObj(rt: RuntimeInterface) { - __rtObj = rt; + __rtObj = rt; } -const HEADER : string = ``` -this.libSet = new Set () \n\ -this.libs = [] \n\ -this.addLib = function (lib, decl) { - if (!this.libSet.has (lib +'.'+decl)) { - this.libSet.add (lib +'.'+decl);\ - this.libs.push ({lib:lib, decl:decl}) - } -} -``` +/** A callback for synchronizing with the caller. */ +let __currentCallback = null; + +/** The JSON with the context for deserialization. */ +let __currentDeserializedJson = null; + +/** The trust level of the sender, i.e. implicit declassification based on the (lack of) trust. */ +let __trustLevel = null; + +const MARKER = "/*-----*/"; function startCompiler() { __compilerOsProcess = spawn(process.env.TROUPE + '/bin/troupec', ['--json']); @@ -47,12 +53,14 @@ function startCompiler() { process.exit(code); }); - let marker = "/*-----*/\n\n" + let marker = MARKER + "\n\n"; // accumulator of communication with the compiler; reset after // each deserialization; needed because we have no guarantees about // how the data coming back from the compiler is chunked - + // + // TODO: Switch to an array of strings which are `join`ed at the end. + // This is ~4-10x faster. let accum = ""; __compilerOsProcess.stdout.on('data', (data: string) => { @@ -64,65 +72,72 @@ function startCompiler() { } }); } - startCompiler(); export function stopCompiler() { __compilerOsProcess.stdin.end(); } - -// -------------------------------------------------- +// ------------------------------------------------------------------------------------------------- // some rudimentary debugging mechanisms; probably should be rewritten -function debuglog(...s) { - let spaces = ""; - for (let j = 0; j < indentcounter; j++) { - spaces = " " + spaces; - } - - s.unshift("DEBUG:" + spaces) - console.log.apply(null, s) -} - -var indentcounter = 0; +var indentCounter = 0; function indent() { - indentcounter++; + indentCounter++; } function unindent() { - indentcounter--; + indentCounter--; } +function debuglog(...s) { + let spaces = ""; + for (let j = 0; j < indentCounter; j++) { + spaces = " " + spaces; + } + s.unshift("DEBUG:" + spaces); + console.log.apply(null, s); +} + +// ------------------------------------------------------------------------------------------------- function deserializationError() { console.log("DESERIALIZATION ERROR HANDLING IS NOT IMPLEMENTED") process.exit(1); } -function constructCurrent(compilerOutput: string) { - // debuglog (deserializationObject) +// ------------------------------------------------------------------------------------------------- + +const HEADER : string = ` +this.libSet = new Set () +this.libs = [] +this.addLib = function (lib, decl) { + if (!this.libSet.has (lib +'.'+decl)) { + this.libSet.add (lib +'.'+decl); + this.libs.push ({lib:lib, decl:decl}); + } +} +`; +function constructCurrent(compilerOutput: string | null) { __isCurrentlyUsingCompiler = false; - let serobj = __currentDeserializedJson; - let desercb = __currentCallback; + const serobj = __currentDeserializedJson; + const desercb = __currentCallback; // 1. reconstruct the namespaces - let snippets = compilerOutput.split("\n\n"); - let k = 0; - - - let ctxt = { // deserialization context + let ctxt = { // deserialization context namespaces : new Array (serobj.namespaces.length), closures : new Array (serobj.closures.length), - envs : new Array (serobj.envs.length) + envs : new Array (serobj.envs.length), } + const snippets = compilerOutput ? compilerOutput.split("\n\n") : []; + let k = 0; for (let i = 0; i < serobj.namespaces.length; i++) { - let ns = serobj.namespaces[i] - let nsFun = HEADER + let ns = serobj.namespaces[i] + let nsFun = HEADER; let atomSet = new Set() @@ -131,65 +146,54 @@ function constructCurrent(compilerOutput: string) { nsFun += "\n\n" // looks neater this way } let snippetJson = JSON.parse(snippets[k++]); - // console.log (snippetJson.libs); - // console.log (snippetJson.fname); nsFun += snippetJson.code; for (let atom of snippetJson.atoms) { - atomSet.add(atom) + atomSet.add(atom); } - // console.log (snippetJson.atoms) } - let argNames = Array.from(atomSet); - let argValues = argNames.map( argName => {return new Atom(argName)}) - argNames.unshift('rt') - argNames.push(nsFun) - // Observe that there is some serious level of - // reflection going on in here - // Arguments to Function are - // 'rt', ATOM1, ..., ATOMk, nsFun - // - // - let NS: any = Reflect.construct (Function, argNames) + let argNames = Array.from(atomSet); + let argValues = argNames.map(argName => {return new Atom(argName)}) + argNames.unshift('rt'); + argNames.push(nsFun); + // Observe that there is some serious level of reflection going on in here. + // The arguments to `Function` are: 'rt', ATOM1, ..., ATOMk, nsFun + const NS: any = Reflect.construct (Function, argNames); // We now construct an instance of the newly constructed object // that takes the runtime object + atoms as its arguments - - // console.log (NS.toString()); // debugging - argValues.unshift(__rtObj) - ctxt.namespaces[i] = Reflect.construct (NS, argValues) - + argValues.unshift(__rtObj); + ctxt.namespaces[i] = Reflect.construct (NS, argValues); } // 2. reconstruct the closures and environments - let sercloss = serobj.closures; - - let serenvs = serobj.envs; + const sercloss = serobj.closures; + const serenvs = serobj.envs; function mkClosure(i: number) { - if (!ctxt.closures[i]) { - let nm = ctxt.namespaces[sercloss[i].namespacePtr.NamespaceID] - let fn = nm[sercloss[i].fun]; - let env = mkEnv(sercloss[i].envptr.EnvID, (env) => { + if (!ctxt.closures[i]) { + const nm = ctxt.namespaces[sercloss[i].namespacePtr.NamespaceID] + const fn = nm[sercloss[i].fun]; + const env = mkEnv(sercloss[i].envptr.EnvID, (env) => { ctxt.closures[i] = RawClosure(env, nm, fn); - }) - ctxt.closures[i].__dataLevel = env.__dataLevel; + }) + ctxt.closures[i].__dataLevel = env.__dataLevel; } return ctxt.closures[i]; } function mkEnv(i: number, post_init?: (any)=>void ) { - if (!ctxt.envs[i]) { + if (!ctxt.envs[i]) { let env = {__dataLevel : levels.BOT}; if (post_init) { - post_init (env) + post_init (env); } ctxt.envs[i] = env; for (var field in serenvs[i]) { - let v = mkValue(serenvs[i][field]); - env[field] = v + const v = mkValue(serenvs[i][field]); + env[field] = v; env.__dataLevel = levels.lub (env.__dataLevel, v.dataLevel) - } + } } else { if (post_init) { post_init (ctxt.envs[i]); @@ -204,68 +208,53 @@ function constructCurrent(compilerOutput: string) { for (let i = 0; i < x.length; i++) { a.push(mkValue(x[i])); } - return a + return a; } - /* - # # - # # # # # # ## # # # ###### - ## ## # # # # # # # # # # - # ## # #### # # # # # # # ##### - # # # # # # ###### # # # # - # # # # # # # # # # # # - # # # # # # # ###### #### ###### - - */ - function mkValue(arg: { val: any; lev: any; tlev: any; troupeType: Ty.TroupeType; }) { - // debuglog ("*** mkValue", arg); assert(Ty.isLVal(arg)); - let obj = arg.val; - let lev = mkLevel(arg.lev); - let tlev = mkLevel(arg.tlev); + const obj = arg.val; + const lev = mkLevel(arg.lev); + const tlev = mkLevel(arg.tlev); function _trustGLB(x: Level) { - return (glb(x, __trustLevel)) + return glb(x, __trustLevel); } - let _tt = arg.troupeType - - - function value() { - switch (_tt) { + function value() { + switch (arg.troupeType) { case Ty.TroupeType.RECORD: - // for reords, the serialization format is [[key, value_json], ...] + // for records, the serialization format is [[key, value_json], ...] let a = []; for (let i = 0; i < obj.length; i++) { - a.push ([ obj[i][0], mkValue(obj[i][1]) ]) + a.push ([ obj[i][0], mkValue(obj[i][1]) ]); } return Record.mkRecord(a); case Ty.TroupeType.LIST: - return mkList(deserializeArray(obj)) + return mkList(deserializeArray(obj)); case Ty.TroupeType.TUPLE: - return mkTuple(deserializeArray(obj)) + return mkTuple(deserializeArray(obj)); case Ty.TroupeType.CLOSURE: - return mkClosure(obj.ClosureID) - case Ty.TroupeType.NUMBER: - case Ty.TroupeType.BOOLEAN: + return mkClosure(obj.ClosureID); + case Ty.TroupeType.NUMBER: + case Ty.TroupeType.BOOLEAN: case Ty.TroupeType.STRING: return obj; case Ty.TroupeType.PROCESS_ID: return new ProcessID(obj.uuid, obj.pid, obj.node) case Ty.TroupeType.AUTHORITY: - // 2018-10-18: AA: authority attenuation based on the trust level of the sender - return new Authority(_trustGLB(mkLevel(obj.authorityLevel))) + // Attenuate authority based on the trust level of the sender + return new Authority(_trustGLB(mkLevel(obj.authorityLevel))); case Ty.TroupeType.LEVEL: - return mkLevel(obj.lev) + return mkLevel(obj.lev); case Ty.TroupeType.LVAL: - return mkValue(obj) + return mkValue(obj); case Ty.TroupeType.ATOM: - return new Atom(obj.atom, obj.creation_uuid) + return new Atom(obj.atom, obj.creation_uuid); case Ty.TroupeType.UNIT: - return __unitbase + return __unitbase; default: - return obj; + return obj; } } @@ -282,12 +271,10 @@ function constructCurrent(compilerOutput: string) { let v = mkValue(serobj.value); - // go over the namespaces we have generated - // and load all libraries before calling the last callback - + // For each namespace we have generated, load all libraries before calling the last callback. function loadLib(i: number, cb) { if (i < ctxt.namespaces.length) { - __rtObj.linkLibs(ctxt.namespaces[i]).then(() => loadLib(i + 1, cb)) + __rtObj.linkLibs(ctxt.namespaces[i]).then(() => loadLib(i + 1, cb)); } else { cb(); } @@ -296,46 +283,38 @@ function constructCurrent(compilerOutput: string) { loadLib(0, () => desercb(v)); } -// 2018-11-30: AA: TODO: implement a proper deserialization queue instead of -// the coarse-grained piggybacking on the event loop - +// TODO: Implement a proper deserialization queue instead of the coarse-grained piggybacking on the +// event loop below. function deserializeCb(lev: Level, jsonObj: any, cb: (body: LVal) => void) { if (__isCurrentlyUsingCompiler) { - setImmediate(deserializeCb, lev, jsonObj, cb) // postpone; 2018-03-04;aa + // Other thread is currently deserializing, postpone execution. + setImmediate(deserializeCb, lev, jsonObj, cb); } else { - __isCurrentlyUsingCompiler = true // prevent parallel deserialization attempts; important! -- leads to nasty - // race conditions otherwise; 2018-11-30; AA + // Prevent parallel deserialization attempts (abuses that JavaScript is a singly threaded + // language). Be wary when messing with the variables below, they are all global! + __isCurrentlyUsingCompiler = true; __trustLevel = lev; - __currentCallback = cb; // obs: this is a global for this module; - // the access to it should be carefully controlled - - // we need to share this object with the callbacks - - __currentDeserializedJson = jsonObj; // obs: another global that we must be careful with + __currentCallback = cb; + __currentDeserializedJson = jsonObj; if (jsonObj.namespaces.length > 0) { for (let i = 0; i < jsonObj.namespaces.length; i++) { let ns = jsonObj.namespaces[i]; for (let j = 0; j < ns.length; j++) { - // debuglog("*s deserialize", ns[j]); __compilerOsProcess.stdin.write(ns[j][1]); - __compilerOsProcess.stdin.write("\n") - // debuglog ("data out") + __compilerOsProcess.stdin.write("\n"); } } - __compilerOsProcess.stdin.write("!ECHO /*-----*/\n") + __compilerOsProcess.stdin.write("!ECHO " + MARKER + "\n"); } else { - // shortcutting the unnecessary interaction with the compiler - // 2018-09-20: AA - constructCurrent(""); + // Unnecessary interaction with the compiler: skip it! + constructCurrent(null); } } } export function deserialize(lev: Level, jsonObj: any): Promise { return new Promise((resolve, reject) => { - deserializeCb(lev, jsonObj, (body: LVal) => { - resolve(body) - }) + deserializeCb(lev, jsonObj, (body: LVal) => resolve(body)); }); } From 99ca6b21179a4191b022f7efbb76ca3ac5942b01 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 6 Oct 2025 14:43:01 +0200 Subject: [PATCH 13/47] Remove dead code in 'deserialize.mts' --- rt/src/deserialize.mts | 7 ------- 1 file changed, 7 deletions(-) diff --git a/rt/src/deserialize.mts b/rt/src/deserialize.mts index 8c9f296e..8ea8a6e2 100644 --- a/rt/src/deserialize.mts +++ b/rt/src/deserialize.mts @@ -103,13 +103,6 @@ function debuglog(...s) { // ------------------------------------------------------------------------------------------------- -function deserializationError() { - console.log("DESERIALIZATION ERROR HANDLING IS NOT IMPLEMENTED") - process.exit(1); -} - -// ------------------------------------------------------------------------------------------------- - const HEADER : string = ` this.libSet = new Set () this.libs = [] From 94e712e51f83d1efd028107db9c96e99c5667c3a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 6 Oct 2025 13:56:57 +0200 Subject: [PATCH 14/47] Cleanup in 'loadLibsAsync.mts' Trailing whitespace, missing semi colons, hard to understand comments, ... --- rt/src/loadLibsAsync.mts | 67 ++++++++++++++++++++-------------------- 1 file changed, 33 insertions(+), 34 deletions(-) diff --git a/rt/src/loadLibsAsync.mts b/rt/src/loadLibsAsync.mts index 12adc2ca..54616a4b 100644 --- a/rt/src/loadLibsAsync.mts +++ b/rt/src/loadLibsAsync.mts @@ -1,72 +1,71 @@ 'use strict' import * as fs from 'node:fs' import * as levels from './Level.mjs'; -const { readFile } = fs.promises +const { readFile } = fs.promises; -import { mkLogger } from './logger.mjs' -const logger = mkLogger('lib') +import { mkLogger } from './logger.mjs'; +const logger = mkLogger('lib'); -const info = x => logger.info(x) -const debug = x => logger.debug(x) +const info = x => logger.info(x); +const debug = x => logger.debug(x); -const __libcache = {} +const __libcache = {}; export async function loadLibsAsync(obj, rtObj) { - let libs = obj.libs - obj.libs = {} + let libs = obj.libs; + obj.libs = {}; for (let n = 0; n < libs.length; n++) { let lib = libs[n].lib; let decl = libs[n].decl; - const key = lib + "." + decl + const key = lib + "." + decl; if (__libcache[key]) { - debug('lib cache hit on: ' + key) + debug('lib cache hit on: ' + key); obj.libs[key] = __libcache[key]; - continue + continue; } - // 1. Find the file -- note that we load all the libs from a default - // location + // 1. Find the file. Note, that we load all the libs from a default + // location. + let filename = process.env.TROUPE + "/lib/out/" + lib + ".js"; - let filename = process.env.TROUPE + "/lib/out/" + lib + ".js" - - // 2. Load the file -- note that this is an asynchronous operation - let input = await readFile(filename, 'utf8') + // 2. Load the file. Note, this is an asynchronous operation + let input = await readFile(filename, 'utf8'); // File read operation finished; we are now in the callbacak that has - // been asynchronously called by the node runtime + // been asynchronously called by the node runtime. - // TODO: check for error! 2018-07-03: aa + // TODO: check for error! 2018-07-03: AA // 3. Create a JS class (function) from it let Lib: any = new Function('rt', input); // 4. We create a "new" instance of the resulting class - let libinstance = new Lib(rtObj); + // load dependent libraries + await loadLibsAsync(libinstance, rtObj); - // load dependent libraries?? - - // libinstance.loadlibs (() => - await loadLibsAsync(libinstance, rtObj) - - // 5. Execute .export() function to obtain the table note - this is a + // 5. Execute `.export()` function to obtain the table note - this is a // regular JS function (generated by the compiler) that we just call - // here - - rtObj.setLibloadMode(); // 2019-01-03: AA; Hack + // here. + // + // 2019-01-03: AA; HACK + // We assume that the library merely exports values that require no + // computations. Hence, there are no continuations to be resolved and + // we can immediately extract the list of functions/values returned + // from the given function. + rtObj.setLibloadMode(); let table = libinstance.export({__dataLevel:levels.BOT}).val.toArray(); - rtObj.setNormalMode(); // 2019-01-03: AA; EOH - - // 6. Lookup in the resulting table + rtObj.setNormalMode(); + // 6. Lookup the desired value in the resulting table for (let i = 0; i < table.length; i++) { let name = table[i].val[0].val; - let libf = table[i].val[1].val + let libf = table[i].val[1].val; if (name == decl) { // We store the resulting function in the object that was provided - // to us as an argument + // to us as an argument. obj.libs[key] = libf; __libcache[key] = libf; break; From 585afb7abb34eebb3242b2dc42492ac925e87b9e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Tue, 7 Oct 2025 11:00:35 +0200 Subject: [PATCH 15/47] Cleanup in 'runtimeMonitored.mts' Trailing whitespace, missing semi colons, odd comments, dead code, ... --- rt/src/runId.mts | 4 +- rt/src/runtimeMonitored.mts | 271 +++++++++++++----------------------- 2 files changed, 101 insertions(+), 174 deletions(-) diff --git a/rt/src/runId.mts b/rt/src/runId.mts index 0dbb125f..40c1f5f6 100644 --- a/rt/src/runId.mts +++ b/rt/src/runId.mts @@ -1,3 +1,3 @@ -import { v4 as uuidv4} from 'uuid' -let runId = uuidv4() +import { v4 as uuidv4 } from 'uuid' +const runId = uuidv4() export default runId diff --git a/rt/src/runtimeMonitored.mts b/rt/src/runtimeMonitored.mts index 1c54578c..225dab39 100644 --- a/rt/src/runtimeMonitored.mts +++ b/rt/src/runtimeMonitored.mts @@ -11,6 +11,7 @@ import { LVal, MbVal } from './Lval.mjs' import { ProcessID } from './process.mjs'; import { UserRuntime } from './UserRuntime.mjs' import * as levels from './Level.mjs' +const { flowsTo, lub, glb } = levels import * as DS from './deserialize.mjs' import { p2p } from './p2p/p2p.mjs' import { closeReadline } from './builtins/stdio.mjs'; @@ -22,10 +23,7 @@ import { setRuntimeObject } from './SysState.mjs'; import { initTrustMap, nodeTrustLevel, _trustMap } from './TrustManager.mjs'; import { serialize } from './serialize.mjs'; import { Thread } from './Thread.mjs'; - import { Console } from 'node:console' - -const { flowsTo, lub, glb } = levels import { getCliArgs, TroupeCliArg } from './TroupeCliArgs.mjs'; import { configureColors, isColorEnabled } from './colorConfig.mjs'; import { mkLogger } from './logger.mjs' @@ -33,38 +31,32 @@ import { Record } from './Record.mjs'; import { level } from 'winston'; const readFile = fs.promises.readFile -const rt_uuid = runId const argv = getCliArgs(); // Configure colors before any chalk or logger usage configureColors(); -let logLevel = argv[TroupeCliArg.Debug] ? 'debug': 'info' +const logLevel = argv[TroupeCliArg.Debug] ? 'debug': 'info' const logger = mkLogger('RTM', logLevel); -const info = x => logger.info(x) -const debug = x => logger.debug(x) -const error = x => logger.error(x) - let __p2pRunning = false; - -let rt_xconsole = +const rt_xconsole = new Console({ stdout: process.stdout , stderr: process.stderr , colorMode: isColorEnabled() }); -function $t():Thread { return __sched.__currentThread }; // returns the current thread +/** Returns the current thread */ +function $t():Thread { return __sched.__currentThread }; // -------------------------------------------------- async function spawnAtNode(nodeid, f) { - debug (`* rt spawnAtNode ${nodeid}`); + logger.debug(`* rt spawnAtNode ${nodeid}`); let node = __nodeManager.getNode(nodeid.val); - // debug ("XX", node); - // TODO: 2018-09-24: AA: do the information flow check + // TODO (2018-09-24: AA): do the information flow check let { data, level } = serialize(f, lub($t().pc, nodeid.lev)); @@ -74,27 +66,24 @@ async function spawnAtNode(nodeid, f) { if (!flowsTo(level, trustLevel)) { theThread.throwInSuspended("Illegal trust flow when spawning on a remote node\n" + ` | the trust level of the recepient node: ${trustLevel.stringRep()}\n` + - ` | the level of the information in spawn: ${level.stringRep()}`) + ` | the level of the information in spawn: ${level.stringRep()}`); __sched.scheduleThread(theThread); - __sched.resumeLoopAsync(); + __sched.resumeLoopAsync(); return; } // 0. we assume that the node is different from // the local node - // 1. we make a connection to the remote node // 2. we send the serialized version of f // 3. we wait for the reply (should be a pid) // 4. we return the obtained pid //-------------------------------------------------- - - try { let body1 = await p2p.spawnp2p(node.nodeId, data); - let body = await DS.deserialize(nodeTrustLevel(node.nodeId), body1) + let body = await DS.deserialize(nodeTrustLevel(node.nodeId), body1); let pid = new ProcessID(body.val.uuid, body.val.pid, body.val.node); theThread.returnSuspended(new LVal(pid, body.lev)); @@ -102,13 +91,13 @@ async function spawnAtNode(nodeid, f) { __sched.resumeLoopAsync(); } catch (err) { - error("error spawning remotely; this blocks current thread") + logger.error("error spawning remotely; this blocks current thread") if (err instanceof AggregateError) { for (let ie in err) { - error(`${ie}`) + logger.error(`${ie}`); } } else { - error(`${err}`) + logger.error(`${err}`); } } } @@ -136,15 +125,15 @@ function remoteSpawnOK() { * The identity of the node that initiates the spawning. */ async function spawnFromRemote(jsonObj, fromNode) { - debug ("spawn from remote") + logger.debug("spawn from remote"); // 2018-05-17: AA; note that this _only_ uses the lf.lev and // is completely independent of the current thread's pc; - let nodeLev = nodeTrustLevel(fromNode); + const nodeLev = nodeTrustLevel(fromNode); - let lf = await DS.deserialize(nodeLev, jsonObj) - let f = lf.val; - let newPid = + const lf = await DS.deserialize(nodeLev, jsonObj); + const f = lf.val; + const newPid = __sched.scheduleNewThreadAtLevel( f , __unit //[f.env, __unit] @@ -156,9 +145,9 @@ async function spawnFromRemote(jsonObj, fromNode) { // 2018-09-19: AA: because we need to send some info back, we have to invoke // serialization. - let serObj = serialize(newPid, levels.BOT).data + const serObj = serialize(newPid, levels.BOT).data __sched.resumeLoopAsync(); - return (serObj); + return serObj; } @@ -173,18 +162,18 @@ async function spawnFromRemote(jsonObj, fromNode) { * The node identity of the sender node */ async function receiveFromRemote(pid, jsonObj, fromNode) { - debug(`* rt receiveFromremote * ${JSON.stringify(jsonObj)}`) - let data = await DS.deserialize(nodeTrustLevel(fromNode), jsonObj) - debug(`* rt receiveFromremote * ${fromNode} ${data.stringRep()}`); + // Deserialize the data to runtime values, either directly or via the `troupec` compiler + logger.debug(`* rt receiveFromRemote * ${JSON.stringify(jsonObj)}`); + const data = await DS.deserialize(nodeTrustLevel(fromNode), jsonObj); + logger.debug(`* rt receiveFromRemote * ${fromNode} ${data.stringRep()}`); - // TODO: 2018-07-23: do we need to do some more raising - // about the level of the fromNode?; AA + // TODO (AA; 2018-07-23): do we need to do some more reasoning about the level of the fromNode? - let fromNodeId = __sched.mkVal(fromNode); - let toPid = new LVal(new ProcessID(rt_uuid, pid, __nodeManager.getLocalNode()), data.lev); + // If successful, add the deserialized message to the mailbox of said process. + const fromNodeId = __sched.mkVal(fromNode); + const toPid = new LVal(new ProcessID(runId, pid, __nodeManager.getLocalNode()), data.lev); __theMailbox.addMessage(fromNodeId, toPid, data.val, data.lev); __sched.resumeLoopAsync(); - } @@ -198,33 +187,39 @@ async function receiveFromRemote(pid, jsonObj, fromNode) { * */ function sendMessageToRemote(toPid, message) { - let node = toPid.node.nodeId; - let pid = toPid.pid; - // debug (`* rt * ${toPid} ${message.stringRep()}`); + const node = toPid.node.nodeId; + const pid = toPid.pid; - let { data, level } = serialize(new MbVal(message, $t().pc), $t().pc); + const { data, level } = serialize(new MbVal(message, $t().pc), $t().pc); - // debug (`* rt * ${JSON.stringify(data)}`); - let trustLevel = nodeTrustLevel(node); - - // debug ("data level: " + level.stringRep()); - // debug ("remote trust level: " + trustLevel.stringRep()); + const trustLevel = nodeTrustLevel(node); if (!flowsTo(level, trustLevel)) { - threadError("Illegal trust flow when sending information to a remote node\n" + - ` | the trust level of the recepient node: ${trustLevel.stringRep()}\n` + - ` | the level of the information to send: ${level.stringRep()}`); + $t().threadError("Illegal trust flow when sending information to a remote node\n" + + ` | the trust level of the recepient node: ${trustLevel.stringRep()}\n` + + ` | the level of the information to send: ${level.stringRep()}`, + false); } else { + // we return unit to the call site at the thread level p2p.sendp2p(node, pid, data) - return $t().returnImmediateLValue(__unit); // we return unit to the call site at the thread level + return $t().returnImmediateLValue(__unit); + } +} + + +async function whereisFromRemote(k) { + __sched.resumeLoopAsync() + // TODO (AA; 2018-10-20): Make use of the levels as they were + // recorded during the registration (instead of the bottom here) + if (__theRegister[k]) { + return serialize(__theRegister[k], levels.BOT).data; } } -// TODO: AA; 2020-05-19; consider moving these two functions somewhere else +// TODO (AA; 2020-05-19): consider moving these two functions somewhere else function isLocalPid(pid) { - let x = pid.uuid.toString() == rt_uuid.toString(); - return (x); + return pid.uuid.toString() == runId.toString();; } function rt_mkuuid() { @@ -235,25 +230,22 @@ function rt_mkuuid() { function rt_sendMessageNochecks(lRecipientPid, message, ret = true) { let recipientPid = lRecipientPid.val; - // debug (`rt_sendMessageNoChecks ${message.stringRep()}`) if (isLocalPid(recipientPid)) { let nodeId = __sched.mkVal(__nodeManager.getNodeId()); __theMailbox.addMessage(nodeId, lRecipientPid, message, $t().pc); if (ret) { - return $t().returnImmediateLValue(__unit); + return $t().returnImmediateLValue(__unit); } } else { - debug ("* rt rt_send remote *"/*, recipientPid, message*/); + logger.debug ("* rt rt_send remote *"/*, recipientPid, message*/); return sendMessageToRemote(recipientPid, message) } } - - -let rt_debug = function (s) { +function rt_debug (s) { function formatToN(s, n) { if (s.length < n) { let j = s.length; @@ -264,168 +256,106 @@ let rt_debug = function (s) { return s; } - let tid = $t().tidErrorStringRep() - let pc = $t().pc.stringRep() - let bl = $t().bl.stringRep() - let handler_state = __sched.handlerState.toString() + const tid = $t().tidErrorStringRep(); + const pc = $t().pc.stringRep(); + const bl = $t().bl.stringRep(); + const handler_state = __sched.handlerState.toString(); rt_xconsole.log( chalk.red(formatToN("PID:" + tid, 50)), chalk.red(formatToN("PC:" + pc, 20)), chalk.red(formatToN("BL:" + bl, 20)), chalk.red(formatToN("HN" + handler_state, 20)), chalk.red(formatToN("_sp:" + $t()._sp, 20)), - s + s ); } - - -async function whereisFromRemote(k) { - __sched.resumeLoopAsync() - // TODO: 2018-10-20: make use of the levels as they were - // recorded during the registration (instead of the bottom here ) - if (__theRegister[k]) { - let serObj = serialize(__theRegister[k], levels.BOT).data - return serObj - } -} - - - function rt_mkLabel(x) { - // debug ("mkLabel", x, x === "secret"); - - return new LVal(levels.fromSingleTag(x), $t().pc); - } - - - -function threadError(s, internal = false) { - return $t().threadError(s, internal); +function rt_ret (arg) { + return $t().returnImmediateLValue(arg); } -let rt_threadError = threadError; - -function rt_error(x) { - threadError(x.val); -} - -function rt_errorPos(x, pos) { - if (pos != '') { - threadError(x.val + " at " + pos); - } else { - threadError(x.val); - } -} - - -let rt_ret = (arg) => { return $t().returnImmediateLValue(arg); } -// let rt_ret_raw = () => __sched.returnInThread_raw(); - -// function tailcall(lff, arg) { -// assertIsFunction(lff); -// $t().raiseCurrentThreadPC(lff.lev); -// __sched.tailToTroupeFun(lff.val, arg); -// } - let __sched: Scheduler let __theMailbox: MailboxProcessor let __userRuntime: any let __service:any = {} class RuntimeObject implements RuntimeInterface { - // tailcall = tailcall - xconsole = rt_xconsole - ret = rt_ret - // ret_raw = rt_ret_raw - debug = rt_debug - spawnAtNode = spawnAtNode - rt_mkuuid = rt_mkuuid - mkLabel = rt_mkLabel + xconsole = rt_xconsole; + ret = rt_ret; + debug = rt_debug; + spawnAtNode = spawnAtNode; + rt_mkuuid = rt_mkuuid; + mkLabel = rt_mkLabel; sendMessageNoChecks = rt_sendMessageNochecks; - cleanup = cleanupAsync + cleanup = cleanupAsync; persist(obj, path) { let jsonObj = serialize(obj, $t().pc).data; fs.writeFileSync(path, JSON.stringify(jsonObj)); } get $service () { - return __service + return __service; } - + get $t() { - return $t() + return $t(); } get __sched() { - return __sched + return __sched; } get __mbox() { - return __theMailbox + return __theMailbox; } get __userRuntime() { - return __userRuntime + return __userRuntime; } constructor() { - __sched = new Scheduler(this) - __theMailbox = new MailboxProcessor(this) - __userRuntime = new UserRuntime(this) + __sched = new Scheduler(this); + __theMailbox = new MailboxProcessor(this); + __userRuntime = new UserRuntime(this); } - } - let __rtObj = new RuntimeObject(); DS.setRuntimeObj(__rtObj.__userRuntime); setRuntimeObject(__rtObj) - - async function cleanupAsync() { closeReadline() DS.stopCompiler(); if (__p2pRunning) { try { - debug("stopping p2p") + logger.debug("stopping p2p") await p2p.stopp2p() - debug("p2p stop OK") + logger.debug("p2p stop OK") } catch (err) { - debug(`p2p stop failed ${err}`) + logger.debug(`p2p stop failed ${err}`) } } } - // 2020-02-09; AA; ugly ugly hack function bulletProofSigint() { - let listeners = process.listeners("SIGINT"); - // console.log (util.inspect(listeners)) - // for (let i = 0; i < listeners.length; i ++ ) { - // console.log (listeners[i].toString()); - // } - - // process.stdin.removeAllListeners("on"); process.removeAllListeners("SIGINT"); - // console.log ("sigint bulletproofing") process.on('SIGINT', () => { - debug("SIGINT"); + logger.debug("SIGINT"); (async () => { await cleanupAsync() process.exit(0); })() }) - // setTimeout (bulletProofSigint, 1000) } bulletProofSigint(); - async function loadServiceCode() { let input = await fs.promises.readFile(process.env.TROUPE + '/trp-rt/out/service.js', 'utf8') let S: any = new Function('rt', input) @@ -445,15 +375,12 @@ async function loadServiceCode() { } - async function getNetworkPeerId(rtHandlers) { const nodeIdFile = argv[TroupeCliArg.Id] as string; if (nodeIdFile) { try { let nodeIdObj = await readFile(nodeIdFile, 'utf-8') process.on('unhandledRejection', (e) => p2p.processExpectedNetworkErrors(e, "unhandledRejection")) - // process.on ('unhandledRejection', up => {console.log ("Unhandled rejection"); console.error (up)}) - // process.on ('uncaughtException', up => {console.log ("Uncaught exception"); console.error (up)}) process.on('uncaughtException', (e) => p2p.processExpectedNetworkErrors(e, "uncaughtException")) return await p2p.startp2p(JSON.parse(nodeIdObj), rtHandlers); } catch (err) { @@ -463,37 +390,39 @@ async function getNetworkPeerId(rtHandlers) { } else { try { if (argv[TroupeCliArg.LocalOnly] || argv[TroupeCliArg.Persist]) { - info("Skipping network creation. Observe that all external IO operations will yield a runtime error.") + logger.info("Skipping network creation. Observe that all external IO operations will yield a runtime error."); if (argv[TroupeCliArg.Persist]) { - info("Running with persist flag.") + logger.info("Running with persist flag."); } - return null// OBS: 2018-07-22: we are jumping over the network creation + // OBS: 2018-07-22: we are jumping over the network creation + return null; } else { return await p2p.startp2p(null, rtHandlers); } } catch (err) { - logger.error("uncaught exception in the runtime") - console.error(err.stack);; + logger.error("uncaught exception in the runtime"); + console.error(err.stack); process.exit(1); } } } + export async function start(f) { - await initTrustMap() + await initTrustMap(); let peerid = await getNetworkPeerId({ remoteSpawnOK, spawnFromRemote, receiveFromRemote, whereisFromRemote - }) + }); if (peerid) { - __p2pRunning = true - debug("network ready") + __p2pRunning = true; + logger.debug("network ready"); } else { - debug("network not initialized") + logger.debug("network not initialized"); } __nodeManager.setLocalPeerId(peerid); @@ -504,13 +433,13 @@ export async function start(f) { , cleanupAsync); await loadServiceCode() - await __userRuntime.linkLibs(f) + await __userRuntime.linkLibs(f); let mainAuthority = new LVal(new Authority(levels.ROOT), levels.BOT); if (__p2pRunning) { - let service_arg = - new LVal ( new Record([ ["authority", mainAuthority], - ["options", __unit]]), + let service_arg = + new LVal ( new Record([ ["authority", mainAuthority], + ["options", __unit]]), levels.BOT); __sched.scheduleNewThreadAtLevel(__service['service'] , service_arg @@ -522,14 +451,12 @@ export async function start(f) { } __sched.scheduleNewThreadAtLevel( - () => f.main ({__dataLevel:levels.BOT}) + () => f.main({__dataLevel:levels.BOT}) , mainAuthority - // , f , levels.BOT , levels.BOT , true , argv[TroupeCliArg.Persist] - ) - __sched.loop() + ); + __sched.loop(); } - From dcb870a42bd28c97cf072713b43c920a2b0f5a2d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Tue, 14 Oct 2025 15:03:59 +0200 Subject: [PATCH 16/47] Fix very odd inline import --- rt/src/RuntimeInterface.mts | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rt/src/RuntimeInterface.mts b/rt/src/RuntimeInterface.mts index f212b8a2..a2f2f022 100644 --- a/rt/src/RuntimeInterface.mts +++ b/rt/src/RuntimeInterface.mts @@ -13,7 +13,7 @@ export interface RuntimeInterface { debug(arg0: string); __sched: SchedulerInterface __mbox : MailboxInterface - sendMessageNoChecks(toPid: any, message: import("./Lval.mjs").LVal, arg2?: boolean): any; + sendMessageNoChecks(toPid: any, message: LVal, arg2?: boolean): any; ret(arg0: any); // ret_raw () // tailcall(funclos: any, __unit: any); From f2e1c6dbb6a2f4c6613e5869080815837c60d509 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Tue, 14 Oct 2025 15:23:52 +0200 Subject: [PATCH 17/47] Improve naming and documentation for thread epilogues --- rt/src/Scheduler.mts | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index e580e714..ff62946f 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -74,14 +74,8 @@ export class Scheduler implements SchedulerInterface { // console.log (`The number of blocked threads is ${this.__blocked.length}`) } - done () { - this.notifyMonitors(); - // console.log (this.__currentThread.processDebuggingName, this.currentThreadId.val.toString(), "done") - delete this.__alive [this.currentThreadId.val.toString()]; - } - - - halt (persist=null) { + /** Epilogue for `main` thread: notify monitors, print and persist the final value */ + haltMain (persist=null) { this.raiseCurrentThreadPCToBlockingLev(); let retVal = new LVal (this.__currentThread.r0_val, lub(this.__currentThread.bl, this.__currentThread.r0_lev), @@ -89,7 +83,7 @@ export class Scheduler implements SchedulerInterface { this.notifyMonitors (); - delete this.__alive[this.currentThreadId.val.toString()]; + delete this.__alive[this.currentThreadId.val.toString()]; console.log(">>> Main thread finished with value:", retVal.stringRep()); if (persist) { this.rtObj.persist (retVal, persist ) @@ -97,7 +91,14 @@ export class Scheduler implements SchedulerInterface { } return null; } - + + /** Epilogue for non-`main` threads: notify monitors */ + haltOther () { + this.notifyMonitors(); + // console.log (this.__currentThread.processDebuggingName, this.currentThreadId.val.toString(), "done") + delete this.__alive [this.currentThreadId.val.toString()]; + } + notifyMonitors (status = TerminationStatus.OK, errstr = null) { let mkVal = this.__currentThread.mkVal let ids = Object.keys (this.__currentThread.monitors); @@ -191,8 +192,8 @@ export class Scheduler implements SchedulerInterface { scheduleNewThreadAtLevel (thefun, arg, levpc, levblock, ismain = false, persist=null, isSystem = false) { let newPid = this.createNewProcessIDAtLevel(levpc, isSystem); - let halt = ismain ? ()=> { this.halt (persist) } : - () => { this.done () }; + let halt = ismain ? () => { this.haltMain (persist) } : + () => { this.haltOther () }; let t = new Thread From f6fa679de02c60043c50dd91f96e0c1ad88aab5d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 09:27:53 +0200 Subject: [PATCH 18/47] Remove dead(ish) code in 'Scheduler.mts' There is no reason to have an inconsistent access to `scheduer.__currentThread`; one may as well just access it directly (as is done in the Runtime Monitor). Furthermore, why the `__` when the variable is treated as public anyways? --- rt/src/Scheduler.mts | 61 +++---------------------------------- rt/src/runtimeMonitored.mts | 6 ++-- 2 files changed, 8 insertions(+), 59 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index ff62946f..04bb5d7e 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -61,7 +61,7 @@ export class Scheduler implements SchedulerInterface { // console.log (`The current length of __funloop is ${this.__funloop.length}`) // console.log (`The number of active threads is ${Object.keys(this.__alive).length}`) for (let x in this.__alive) { - if (this.currentThreadId.val.toString() == x) { + if (this.__currentThread.tid.val.toString() == x) { // console.log (x, "ACTIVE") } else { // console.log (x, "KILLING"); @@ -76,14 +76,14 @@ export class Scheduler implements SchedulerInterface { /** Epilogue for `main` thread: notify monitors, print and persist the final value */ haltMain (persist=null) { - this.raiseCurrentThreadPCToBlockingLev(); + this.__currentThread.raiseCurrentThreadPCToBlockingLev() let retVal = new LVal (this.__currentThread.r0_val, lub(this.__currentThread.bl, this.__currentThread.r0_lev), lub(this.__currentThread.bl, this.__currentThread.r0_tlev)) this.notifyMonitors (); - delete this.__alive[this.currentThreadId.val.toString()]; + delete this.__alive[this.__currentThread.tid.val.toString()]; console.log(">>> Main thread finished with value:", retVal.stringRep()); if (persist) { this.rtObj.persist (retVal, persist ) @@ -95,8 +95,8 @@ export class Scheduler implements SchedulerInterface { /** Epilogue for non-`main` threads: notify monitors */ haltOther () { this.notifyMonitors(); - // console.log (this.__currentThread.processDebuggingName, this.currentThreadId.val.toString(), "done") - delete this.__alive [this.currentThreadId.val.toString()]; + // console.log (this.__currentThread.processDebuggingName, this.__currentThread.tid.val.toString(), "done") + delete this.__alive [this.__currentThread.tid.val.toString()]; } notifyMonitors (status = TerminationStatus.OK, errstr = null) { @@ -115,67 +115,16 @@ export class Scheduler implements SchedulerInterface { } } - raiseCurrentThreadPC (l) { - this.__currentThread.raiseCurrentThreadPC(l); - } - - raiseCurrentThreadPCToBlockingLev () { - this.__currentThread.raiseCurrentThreadPCToBlockingLev() - } - - - raiseBlockingThreadLev (l) { - this.__currentThread.raiseBlockingThreadLev(l); - } - - - pinipush (l, cap) { - this.__currentThread.pcpinipush(l, cap) - } - - pinipop (cap) { - return this.__currentThread.pinipop(cap); - } - - mkVal(x) { - return this.__currentThread.mkVal (x); - } - - mkValPos (x,p) { - return this.__currentThread.mkValPos (x,p); - } - - mkCopy (x) { - return this.__currentThread.mkCopy (x); - } - - initScheduler(node, stopWhenAllThreadsAreDone = false, stopRuntime = () => {}) { this.__node = node; this.__stopWhenAllThreadsAreDone = stopWhenAllThreadsAreDone; this.__stopRuntime = stopRuntime } - - - get currentThreadId() { - return this.__currentThread.tid; - } - - set handlerState (st) { - this.__currentThread.handlerState = st; - } - - get handlerState () { - return this.__currentThread.handlerState; - } - resumeLoopAsync() { setImmediate(() => {this.loop()}); } - - scheduleThread(t) { this.__funloop.push(t) } diff --git a/rt/src/runtimeMonitored.mts b/rt/src/runtimeMonitored.mts index 225dab39..9fcc56d3 100644 --- a/rt/src/runtimeMonitored.mts +++ b/rt/src/runtimeMonitored.mts @@ -170,7 +170,7 @@ async function receiveFromRemote(pid, jsonObj, fromNode) { // TODO (AA; 2018-07-23): do we need to do some more reasoning about the level of the fromNode? // If successful, add the deserialized message to the mailbox of said process. - const fromNodeId = __sched.mkVal(fromNode); + const fromNodeId = $t().mkVal(fromNode); const toPid = new LVal(new ProcessID(runId, pid, __nodeManager.getLocalNode()), data.lev); __theMailbox.addMessage(fromNodeId, toPid, data.val, data.lev); __sched.resumeLoopAsync(); @@ -232,7 +232,7 @@ function rt_sendMessageNochecks(lRecipientPid, message, ret = true) { let recipientPid = lRecipientPid.val; if (isLocalPid(recipientPid)) { - let nodeId = __sched.mkVal(__nodeManager.getNodeId()); + let nodeId = $t().mkVal(__nodeManager.getNodeId()); __theMailbox.addMessage(nodeId, lRecipientPid, message, $t().pc); if (ret) { @@ -259,7 +259,7 @@ function rt_debug (s) { const tid = $t().tidErrorStringRep(); const pc = $t().pc.stringRep(); const bl = $t().bl.stringRep(); - const handler_state = __sched.handlerState.toString(); + const handler_state = $t().handlerState.toString(); rt_xconsole.log( chalk.red(formatToN("PID:" + tid, 50)), chalk.red(formatToN("PC:" + pc, 20)), From 2d277d4d9f8f3c9a63372064290d1a180105c1f2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 10:13:44 +0200 Subject: [PATCH 19/47] Reorder and add some documentation to Scheduler --- rt/src/Scheduler.mts | 199 +++++++++++++++++++++++++------------------ 1 file changed, 114 insertions(+), 85 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 04bb5d7e..14b4fcc8 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -41,22 +41,36 @@ export class Scheduler implements SchedulerInterface { __node: any; __stopWhenAllThreadsAreDone: boolean; __stopRuntime: () => void; - constructor(rtObj:RuntimeInterface) { + + /*************************************************************************************************\ + Scheduler state + \*************************************************************************************************/ + + /** */ + constructor(rtObj: RuntimeInterface) { this.rt_uuid = runId; this.rtObj = rtObj this.__funloop = new Array() this.__blocked = new Array() this.__alive = {} // new Set(); - this.__currentThread = null; // current thread object this.stackcounter = 0; - - // the unit value - this.__unit = __unit + + // the unit value + this.__unit = __unit } + /** Initialisation of the scheduler based on the p2p layer, e.g. the `node` identifier and + * the scheduler should proceed despite all threads being done. */ + initScheduler(node, stopWhenAllThreadsAreDone = false, stopRuntime = () => {}) { + this.__node = node; + this.__stopWhenAllThreadsAreDone = stopWhenAllThreadsAreDone; + this.__stopRuntime = stopRuntime + } + /** Kill all current threads (without notifying any monitors), staying ready for spawning new + * threads. */ resetScheduler() { // console.log (`The current length of __funloop is ${this.__funloop.length}`) // console.log (`The number of active threads is ${Object.keys(this.__alive).length}`) @@ -74,70 +88,22 @@ export class Scheduler implements SchedulerInterface { // console.log (`The number of blocked threads is ${this.__blocked.length}`) } - /** Epilogue for `main` thread: notify monitors, print and persist the final value */ - haltMain (persist=null) { - this.__currentThread.raiseCurrentThreadPCToBlockingLev() - let retVal = new LVal (this.__currentThread.r0_val, - lub(this.__currentThread.bl, this.__currentThread.r0_lev), - lub(this.__currentThread.bl, this.__currentThread.r0_tlev)) - - this.notifyMonitors (); - - delete this.__alive[this.__currentThread.tid.val.toString()]; - console.log(">>> Main thread finished with value:", retVal.stringRep()); - if (persist) { - this.rtObj.persist (retVal, persist ) - console.log ("Saved the result value in file", persist) - } - return null; - } - - /** Epilogue for non-`main` threads: notify monitors */ - haltOther () { - this.notifyMonitors(); - // console.log (this.__currentThread.processDebuggingName, this.__currentThread.tid.val.toString(), "done") - delete this.__alive [this.__currentThread.tid.val.toString()]; - } - - notifyMonitors (status = TerminationStatus.OK, errstr = null) { - let mkVal = this.__currentThread.mkVal - let ids = Object.keys (this.__currentThread.monitors); - for ( let i = 0; i < ids.length; i ++ ) { - let id = ids[i]; - let toPid = this.__currentThread.monitors[id].pid; - let refUUID = this.__currentThread.monitors[id].uuid; - let thisPid = this.__currentThread.tid; - let statusVal = this.__currentThread.mkVal ( status ) ; - let reason = TerminationStatus.OK == status ? statusVal : - mkTuple ( [statusVal, mkVal (errstr)] ); - let message = mkVal (mkTuple ([ mkVal("DONE"), refUUID, thisPid, reason])) - this.rtObj.sendMessageNoChecks ( toPid, message , false) // false flag means no need to return in the process - } - } - - initScheduler(node, stopWhenAllThreadsAreDone = false, stopRuntime = () => {}) { - this.__node = node; - this.__stopWhenAllThreadsAreDone = stopWhenAllThreadsAreDone; - this.__stopRuntime = stopRuntime - } - - resumeLoopAsync() { - setImmediate(() => {this.loop()}); - } + /*************************************************************************************************\ + Thread creation + \*************************************************************************************************/ + /** Add a thread `t` to the active function loop. */ scheduleThread(t) { this.__funloop.push(t) } - createNewProcessIDAtLevel(pcArg, isSystem = false) { let pid = isSystem ? SYSTEM_PROCESS_STRING : uuidv4(); let pidObj = new ProcessID(this.rt_uuid, pid, this.__node); return new LVal(pidObj, pcArg); } - - + /** Create a new thread `t` for the given function to be evaluated and schedule it. */ scheduleNewThreadAtLevel (thefun, arg, levpc, levblock, ismain = false, persist=null, isSystem = false) { let newPid = this.createNewProcessIDAtLevel(levpc, isSystem); @@ -162,17 +128,36 @@ export class Scheduler implements SchedulerInterface { return newPid; } + /** Schedule the given function as the very next thing to be run. */ schedule(thefun, args, nm) { this.__currentThread.runNext (thefun, args, nm); this.scheduleThread(this.__currentThread) } + /*************************************************************************************************\ + Thread access + \*************************************************************************************************/ + + /** Whether the thread with identifier, `tid`, is alive. */ + isAlive(tid) { + return (this.__alive[tid.val.toString()] != null); + } + + /** The thread object with the given identifier, `tid`. */ + getThread (tid) { + return this.__alive[tid.val.toString()]; + } + /*************************************************************************************************\ + Thread blocking/unblocking + \*************************************************************************************************/ + + /** Block thread object `t`. */ blockThread(t) { this.__blocked.push(t) } - + /** Unblock the thread with the given identifier, `pid`. */ unblockThread(pid) { for (let i = 0; i < this.__blocked.length; i++) { if (pid_equals(this.__blocked[i].tid, pid)) { @@ -183,38 +168,76 @@ export class Scheduler implements SchedulerInterface { } } + /*************************************************************************************************\ + Thread Termination + \*************************************************************************************************/ - isAlive(tid) { - return (this.__alive[tid.val.toString()] != null); + /** Notify monitors about thread termination. */ + notifyMonitors (status = TerminationStatus.OK, errstr = null) { + let mkVal = this.__currentThread.mkVal + let ids = Object.keys (this.__currentThread.monitors); + for ( let i = 0; i < ids.length; i ++ ) { + let id = ids[i]; + let toPid = this.__currentThread.monitors[id].pid; + let refUUID = this.__currentThread.monitors[id].uuid; + let thisPid = this.__currentThread.tid; + let statusVal = this.__currentThread.mkVal ( status ) ; + let reason = TerminationStatus.OK == status ? statusVal : + mkTuple ( [statusVal, mkVal (errstr)] ); + let message = mkVal (mkTuple ([ mkVal("DONE"), refUUID, thisPid, reason])) + this.rtObj.sendMessageNoChecks ( toPid, message , false) // false flag means no need to return in the process + } } - getThread (tid) { - return this.__alive[tid.val.toString()]; + /** Epilogue for `main` thread: notify monitors, print and persist the final value */ + haltMain (persist=null) { + this.__currentThread.raiseCurrentThreadPCToBlockingLev() + let retVal = new LVal (this.__currentThread.r0_val, + lub(this.__currentThread.bl, this.__currentThread.r0_lev), + lub(this.__currentThread.bl, this.__currentThread.r0_tlev)) + + this.notifyMonitors (); + + delete this.__alive[this.__currentThread.tid.val.toString()]; + console.log(">>> Main thread finished with value:", retVal.stringRep()); + if (persist) { + this.rtObj.persist (retVal, persist ) + console.log ("Saved the result value in file", persist) + } + return null; } + /** Epilogue for non-`main` threads: notify monitors */ + haltOther () { + this.notifyMonitors(); + // console.log (this.__currentThread.processDebuggingName, this.__currentThread.tid.val.toString(), "done") + delete this.__alive [this.__currentThread.tid.val.toString()]; + } - stopThreadWithErrorMessage (t:Thread, s:string ) { + /** Kill thread `t` with the error message `s` sent to its monitors. */ + stopThreadWithErrorMessage (t: Thread, s: string) { this.notifyMonitors(TerminationStatus.ERR, s) ; delete this.__alive [t.tid.val.toString()]; } - /*****************************************************************************\ - - 2018-02-18: AA: a hypothesis about memory management in V8 - - It appears that V8's memory management is not very well suited for infinitely - running functions. In other words, functions are expected to eventually - terminate, and all long-running computations are expected to run through the - event loop. This is not surprising given the application where V8 is used. - This is why we periodically yield to the event loop; this hack appears to let - GC claim the objects allocated throughout the runtime of this function. Note - that without this hack, we are observing memory leaks for many "server"-like - programs; with the hack, we get a waivy memory consumption profile that reaches - around 50M on the low points of the wave. - - \*****************************************************************************/ - - + /*************************************************************************************************\ + Scheduler loop + \*************************************************************************************************/ + + /** Start the main scheduler loop. + * + * HACK (2018-02-18: AA): a hypothesis about memory management in V8 + * + * It appears that V8's memory management is not very well suited for infinitely + * running functions. In other words, functions are expected to eventually + * terminate, and all long-running computations are expected to run through the + * event loop. This is not surprising given the application where V8 is used. + * This is why we periodically yield to the event loop; this hack appears to let + * GC claim the objects allocated throughout the runtime of this function. Note + * that without this hack, we are observing memory leaks for many "server"-like + * programs; with the hack, we get a waivy memory consumption profile that reaches + * around 50M on the low points of the wave. + */ loop() { const $$LOOPBOUND = 500000; let _FUNLOOP = this.__funloop @@ -227,7 +250,8 @@ export class Scheduler implements SchedulerInterface { dest = _curThread.next let ttl = 1000; // magic constant; 2021-04-29 while (dest && ttl -- ) { - // if (showStack) { // 2021-04-24; AA; TODO: profile the addition of this conditional in this tight loop + // 2021-04-24; AA; TODO: profile the addition of this conditional in this tight loop + // if (showStack) { // this.__currentThread.showStack() // } // console.log (">>>>>>>>>>") @@ -262,10 +286,15 @@ export class Scheduler implements SchedulerInterface { // we are not really done, but are just hacking around the V8's memory management this.resumeLoopAsync(); } - + if (this.__stopWhenAllThreadsAreDone && Object.keys(this.__alive).length == 0 ) { this.__stopRuntime(); } } - -} \ No newline at end of file + + /** Add continuation of the main Troupe execution loop to the Javascript queue. In the meantime + * other code, e.g. the p2p and deserialization layers can run. */ + resumeLoopAsync() { + setImmediate(() => { this.loop(); }); + } +} From f02b7cb8235c237b1b6b84cc0c8859b5e1846eb9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 10:20:29 +0200 Subject: [PATCH 20/47] Remove unused default arguments This function is only called in one placed with these arguments given. This is essentially dead code. --- rt/src/Scheduler.mts | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 14b4fcc8..ac2c0ad2 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -63,7 +63,7 @@ export class Scheduler implements SchedulerInterface { /** Initialisation of the scheduler based on the p2p layer, e.g. the `node` identifier and * the scheduler should proceed despite all threads being done. */ - initScheduler(node, stopWhenAllThreadsAreDone = false, stopRuntime = () => {}) { + initScheduler(node, stopWhenAllThreadsAreDone, stopRuntime) { this.__node = node; this.__stopWhenAllThreadsAreDone = stopWhenAllThreadsAreDone; this.__stopRuntime = stopRuntime From a4c5210179f127f2d6e40b2399f825c91c22ed01 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 10:21:18 +0200 Subject: [PATCH 21/47] Add types to more Scheduler functions --- rt/src/Scheduler.mts | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index ac2c0ad2..7404fc53 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -93,7 +93,7 @@ export class Scheduler implements SchedulerInterface { \*************************************************************************************************/ /** Add a thread `t` to the active function loop. */ - scheduleThread(t) { + scheduleThread(t: Thread) { this.__funloop.push(t) } @@ -139,12 +139,12 @@ export class Scheduler implements SchedulerInterface { \*************************************************************************************************/ /** Whether the thread with identifier, `tid`, is alive. */ - isAlive(tid) { + isAlive(tid: LVal) { return (this.__alive[tid.val.toString()] != null); } /** The thread object with the given identifier, `tid`. */ - getThread (tid) { + getThread (tid: LVal) { return this.__alive[tid.val.toString()]; } @@ -153,16 +153,16 @@ export class Scheduler implements SchedulerInterface { \*************************************************************************************************/ /** Block thread object `t`. */ - blockThread(t) { + blockThread(t: Thread) { this.__blocked.push(t) } /** Unblock the thread with the given identifier, `pid`. */ - unblockThread(pid) { - for (let i = 0; i < this.__blocked.length; i++) { - if (pid_equals(this.__blocked[i].tid, pid)) { + unblockThread(tid: LVal) { + for (let i = 0; i < this.__blocked.length; i++) { + if (pid_equals(this.__blocked[i].tid, tid)) { this.scheduleThread(this.__blocked[i]); - this.__blocked.splice(i, 1); + this.__blocked.splice(i, 1); break; } } From e5b43c1cc4bea6aa36c250055a8bc396f28bb27c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 10:22:34 +0200 Subject: [PATCH 22/47] Remove dead code '__unit' variable --- rt/src/Scheduler.mts | 5 ----- 1 file changed, 5 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 7404fc53..5cd47c5d 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -2,7 +2,6 @@ import { v4 as uuidv4} from 'uuid' import { Thread } from './Thread.mjs'; import runId from './runId.mjs'; -import { __unit } from './UnitVal.mjs'; import { mkTuple } from './ValuesUtil.mjs'; import { SchedulerInterface } from './SchedulerInterface.mjs'; import { RuntimeInterface } from './RuntimeInterface.mjs'; @@ -36,7 +35,6 @@ export class Scheduler implements SchedulerInterface { __alive: {}; __currentThread: Thread; stackcounter: number; - __unit: any; rtObj : RuntimeInterface __node: any; __stopWhenAllThreadsAreDone: boolean; @@ -56,9 +54,6 @@ export class Scheduler implements SchedulerInterface { this.__currentThread = null; // current thread object this.stackcounter = 0; - - // the unit value - this.__unit = __unit } /** Initialisation of the scheduler based on the p2p layer, e.g. the `node` identifier and From d13bd5ca54721b0ea912dc27b74e29eee58891f4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 10:24:07 +0200 Subject: [PATCH 23/47] Remove dead code 'stackcounter' --- rt/src/Scheduler.mts | 3 --- 1 file changed, 3 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 5cd47c5d..8aa86570 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -34,7 +34,6 @@ export class Scheduler implements SchedulerInterface { __blocked: any[]; __alive: {}; __currentThread: Thread; - stackcounter: number; rtObj : RuntimeInterface __node: any; __stopWhenAllThreadsAreDone: boolean; @@ -52,8 +51,6 @@ export class Scheduler implements SchedulerInterface { this.__blocked = new Array() this.__alive = {} // new Set(); this.__currentThread = null; // current thread object - - this.stackcounter = 0; } /** Initialisation of the scheduler based on the p2p layer, e.g. the `node` identifier and From 00fbc01a6636ea066c316a0bd0d85436ee5d5a4c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 10:26:15 +0200 Subject: [PATCH 24/47] Reorder imports for Scheduler --- rt/src/Scheduler.mts | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 8aa86570..f5c77301 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -1,4 +1,5 @@ 'use strict'; + import { v4 as uuidv4} from 'uuid' import { Thread } from './Thread.mjs'; import runId from './runId.mjs'; @@ -10,12 +11,13 @@ import {ProcessID, pid_equals} from './process.mjs' import SandboxStatus from './SandboxStatus.mjs' import {ThreadError, TroupeError} from './TroupeError.mjs' import {lub} from './Level.mjs' -import { getCliArgs, TroupeCliArg } from './TroupeCliArgs.mjs'; import {SYSTEM_PROCESS_STRING} from './Constants.mjs' -const argv = getCliArgs(); +import { getCliArgs, TroupeCliArg } from './TroupeCliArgs.mjs'; +const argv = getCliArgs(); const showStack = argv[TroupeCliArg.ShowStack] + import { mkLogger } from './logger.mjs' const logger = mkLogger('scheduler'); const info = x => logger.info(x) From 5732bc88377c75edd22936cd09cd89d42420e920 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 10:27:03 +0200 Subject: [PATCH 25/47] Simplify 'scheduleNewThreadAtLevel' --- rt/src/Scheduler.mts | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index f5c77301..24ec81c7 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -91,21 +91,19 @@ export class Scheduler implements SchedulerInterface { this.__funloop.push(t) } - createNewProcessIDAtLevel(pcArg, isSystem = false) { - let pid = isSystem ? SYSTEM_PROCESS_STRING : uuidv4(); - let pidObj = new ProcessID(this.rt_uuid, pid, this.__node); - return new LVal(pidObj, pcArg); - } - /** Create a new thread `t` for the given function to be evaluated and schedule it. */ scheduleNewThreadAtLevel (thefun, arg, levpc, levblock, ismain = false, persist=null, isSystem = false) { - let newPid = this.createNewProcessIDAtLevel(levpc, isSystem); + // Create a new process ID at the given level. + const pid = isSystem ? SYSTEM_PROCESS_STRING : uuidv4(); + const pidObj = new ProcessID(this.rt_uuid, pid, this.__node); + const newPid = new LVal(pidObj, levpc); + + // Epilogue for thread. + const halt = ismain ? () => { this.haltMain (persist) } : + () => { this.haltOther () }; - let halt = ismain ? () => { this.haltMain (persist) } : - () => { this.haltOther () }; - - - let t = new Thread + // New thread + const t = new Thread ( newPid , halt , thefun From e2f977e7cd3859b75168d87a4595fc7196eefc59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 10:29:45 +0200 Subject: [PATCH 26/47] Remove unused variable 'STACKDEPTH' --- rt/src/Scheduler.mts | 2 -- 1 file changed, 2 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 24ec81c7..aa775505 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -23,8 +23,6 @@ const logger = mkLogger('scheduler'); const info = x => logger.info(x) const debug = x => logger.debug(x) -const STACKDEPTH = 150; - let TerminationStatus = { OK: 0, ERR: 1 From 38c89638e7953d3be34efe75827fbb690e5f37b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 10:32:13 +0200 Subject: [PATCH 27/47] Use typescript enum for 'TerminationStatus' --- rt/src/Scheduler.mts | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index aa775505..34d561a9 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -23,9 +23,12 @@ const logger = mkLogger('scheduler'); const info = x => logger.info(x) const debug = x => logger.debug(x) -let TerminationStatus = { - OK: 0, - ERR: 1 +/** Enum for termination statuses. */ +enum TerminationStatus { + /** Thread finished its computation. */ + OK = 0, + /** Thread stopped early due to an error. */ + ERR = 1 } export class Scheduler implements SchedulerInterface { From 67c274e2e193d400fea139e09ea69a99065290b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 10:50:29 +0200 Subject: [PATCH 28/47] Sort through Scheduler state --- rt/src/Scheduler.mts | 25 +++++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 34d561a9..8b84e371 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -32,15 +32,28 @@ enum TerminationStatus { } export class Scheduler implements SchedulerInterface { - rt_uuid: any; - __funloop: Thread[]; - __blocked: any[]; - __alive: {}; + // Current thread state + + /** Current thread alive */ __currentThread: Thread; - rtObj : RuntimeInterface + + /** FIFO queue of all threads to evaluate */ + __funloop: Thread[]; + + /** Queue of blocked threads. */ + __blocked: Thread[]; + + /** Map of alive threads from their stringified identifier, `tid`. */ + __alive: { [tid in string]: Thread }; + + // Dependencies for unique thread identifier creation. + rt_uuid: any; __node: any; + + // Runtime dependencies + rtObj : RuntimeInterface __stopWhenAllThreadsAreDone: boolean; - __stopRuntime: () => void; + __stopRuntime: () => void; /*************************************************************************************************\ Scheduler state From 96e34c0ae8d31bc784e336bf2f0a9fdd30afc96c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 10:54:23 +0200 Subject: [PATCH 29/47] Initialise arrays consistently --- rt/src/Scheduler.mts | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 8b84e371..8d3685a3 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -60,13 +60,13 @@ export class Scheduler implements SchedulerInterface { \*************************************************************************************************/ /** */ - constructor(rtObj: RuntimeInterface) { + constructor(rtObj: RuntimeInterface) { this.rt_uuid = runId; - this.rtObj = rtObj - this.__funloop = new Array() - this.__blocked = new Array() - this.__alive = {} // new Set(); - this.__currentThread = null; // current thread object + this.rtObj = rtObj; + this.__funloop = []; + this.__blocked = []; + this.__alive = {}; + this.__currentThread = null; } /** Initialisation of the scheduler based on the p2p layer, e.g. the `node` identifier and @@ -90,8 +90,8 @@ export class Scheduler implements SchedulerInterface { delete this.__alive[x] } } - this.__blocked = [] - this.__funloop = [] + this.__blocked = []; + this.__funloop = []; // console.log (`The number of active threads is ${Object.keys(this.__alive).length}`) // console.log (`The number of blocked threads is ${this.__blocked.length}`) } From b3c2a293ab2a70d306ac2e708a073e6f4f7a62f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 10:58:56 +0200 Subject: [PATCH 30/47] Fix whitespace and missing semicolons in Scheduler --- rt/src/Scheduler.mts | 86 ++++++++++++++++++++++---------------------- 1 file changed, 44 insertions(+), 42 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 8d3685a3..9b2f762a 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -74,7 +74,7 @@ export class Scheduler implements SchedulerInterface { initScheduler(node, stopWhenAllThreadsAreDone, stopRuntime) { this.__node = node; this.__stopWhenAllThreadsAreDone = stopWhenAllThreadsAreDone; - this.__stopRuntime = stopRuntime + this.__stopRuntime = stopRuntime; } /** Kill all current threads (without notifying any monitors), staying ready for spawning new @@ -82,12 +82,12 @@ export class Scheduler implements SchedulerInterface { resetScheduler() { // console.log (`The current length of __funloop is ${this.__funloop.length}`) // console.log (`The number of active threads is ${Object.keys(this.__alive).length}`) - for (let x in this.__alive) { + for (let x in this.__alive) { if (this.__currentThread.tid.val.toString() == x) { // console.log (x, "ACTIVE") } else { // console.log (x, "KILLING"); - delete this.__alive[x] + delete this.__alive[x]; } } this.__blocked = []; @@ -102,7 +102,7 @@ export class Scheduler implements SchedulerInterface { /** Add a thread `t` to the active function loop. */ scheduleThread(t: Thread) { - this.__funloop.push(t) + this.__funloop.push(t); } /** Create a new thread `t` for the given function to be evaluated and schedule it. */ @@ -130,14 +130,14 @@ export class Scheduler implements SchedulerInterface { this.__alive[newPid.val.toString()] = t; - this.scheduleThread (t) + this.scheduleThread(t); return newPid; } /** Schedule the given function as the very next thing to be run. */ schedule(thefun, args, nm) { - this.__currentThread.runNext (thefun, args, nm); - this.scheduleThread(this.__currentThread) + this.__currentThread.runNext(thefun, args, nm); + this.scheduleThread(this.__currentThread); } /*************************************************************************************************\ @@ -160,7 +160,7 @@ export class Scheduler implements SchedulerInterface { /** Block thread object `t`. */ blockThread(t: Thread) { - this.__blocked.push(t) + this.__blocked.push(t); } /** Unblock the thread with the given identifier, `pid`. */ @@ -180,35 +180,37 @@ export class Scheduler implements SchedulerInterface { /** Notify monitors about thread termination. */ notifyMonitors (status = TerminationStatus.OK, errstr = null) { - let mkVal = this.__currentThread.mkVal - let ids = Object.keys (this.__currentThread.monitors); - for ( let i = 0; i < ids.length; i ++ ) { - let id = ids[i]; - let toPid = this.__currentThread.monitors[id].pid; - let refUUID = this.__currentThread.monitors[id].uuid; - let thisPid = this.__currentThread.tid; - let statusVal = this.__currentThread.mkVal ( status ) ; - let reason = TerminationStatus.OK == status ? statusVal : - mkTuple ( [statusVal, mkVal (errstr)] ); - let message = mkVal (mkTuple ([ mkVal("DONE"), refUUID, thisPid, reason])) - this.rtObj.sendMessageNoChecks ( toPid, message , false) // false flag means no need to return in the process - } + let mkVal = this.__currentThread.mkVal; + let ids = Object.keys(this.__currentThread.monitors); + for (let i = 0; i < ids.length; i++) { + let id = ids[i]; + let toPid = this.__currentThread.monitors[id].pid; + let refUUID = this.__currentThread.monitors[id].uuid; + let thisPid = this.__currentThread.tid; + let statusVal = this.__currentThread.mkVal( status ); + let reason = TerminationStatus.OK == status + ? statusVal + : mkTuple ([statusVal, mkVal (errstr)]); + let message = mkVal (mkTuple([ mkVal("DONE"), refUUID, thisPid, reason])); + // false flag means no need to return in the process + this.rtObj.sendMessageNoChecks( toPid, message, false); + } } /** Epilogue for `main` thread: notify monitors, print and persist the final value */ haltMain (persist=null) { this.__currentThread.raiseCurrentThreadPCToBlockingLev() - let retVal = new LVal (this.__currentThread.r0_val, + let retVal = new LVal (this.__currentThread.r0_val, lub(this.__currentThread.bl, this.__currentThread.r0_lev), lub(this.__currentThread.bl, this.__currentThread.r0_tlev)) - this.notifyMonitors (); + this.notifyMonitors(); delete this.__alive[this.__currentThread.tid.val.toString()]; console.log(">>> Main thread finished with value:", retVal.stringRep()); if (persist) { - this.rtObj.persist (retVal, persist ) - console.log ("Saved the result value in file", persist) + this.rtObj.persist(retVal, persist ) + console.log("Saved the result value in file", persist) } return null; } @@ -217,12 +219,12 @@ export class Scheduler implements SchedulerInterface { haltOther () { this.notifyMonitors(); // console.log (this.__currentThread.processDebuggingName, this.__currentThread.tid.val.toString(), "done") - delete this.__alive [this.__currentThread.tid.val.toString()]; + delete this.__alive[this.__currentThread.tid.val.toString()]; } /** Kill thread `t` with the error message `s` sent to its monitors. */ stopThreadWithErrorMessage (t: Thread, s: string) { - this.notifyMonitors(TerminationStatus.ERR, s) ; + this.notifyMonitors(TerminationStatus.ERR, s); delete this.__alive [t.tid.val.toString()]; } @@ -247,15 +249,15 @@ export class Scheduler implements SchedulerInterface { loop() { const $$LOOPBOUND = 500000; let _FUNLOOP = this.__funloop - let _curThread: Thread; - let dest; + let _curThread: Thread; + let dest; try { - for (let $$loopiter = 0; $$loopiter < $$LOOPBOUND && _FUNLOOP.length > 0; $$loopiter ++ ) { + for (let $$loopiter = 0; $$loopiter < $$LOOPBOUND && _FUNLOOP.length > 0; $$loopiter++) { _curThread = _FUNLOOP.shift(); this.__currentThread = _curThread; - dest = _curThread.next + dest = _curThread.next; let ttl = 1000; // magic constant; 2021-04-29 - while (dest && ttl -- ) { + while (dest && ttl--) { // 2021-04-24; AA; TODO: profile the addition of this conditional in this tight loop // if (showStack) { // this.__currentThread.showStack() @@ -266,24 +268,24 @@ export class Scheduler implements SchedulerInterface { // if (dest.debugname ) { // console.log (" -- ", dest.debugname) // } - dest = dest () + dest = dest(); } if (dest) { - _curThread.handlerState.checkGuard() + _curThread.handlerState.checkGuard(); - _curThread.next = dest ; - _FUNLOOP.push (_curThread); + _curThread.next = dest; + _FUNLOOP.push(_curThread); } - } + } } catch (e) { if (e instanceof TroupeError) { e.handleError(this); } else { - console.log ("--- Schedule module caught an internal exception ---") - console.log ("--- The following output may help identify a bug in the runtime ---") - console.log ("Destination function\n" , dest) - this.__currentThread.showStack() + console.log("--- Schedule module caught an internal exception ---"); + console.log("--- The following output may help identify a bug in the runtime ---"); + console.log("Destination function\n", dest); + this.__currentThread.showStack(); throw e; } } @@ -293,7 +295,7 @@ export class Scheduler implements SchedulerInterface { this.resumeLoopAsync(); } - if (this.__stopWhenAllThreadsAreDone && Object.keys(this.__alive).length == 0 ) { + if (this.__stopWhenAllThreadsAreDone && Object.keys(this.__alive).length == 0) { this.__stopRuntime(); } } From 4cd77aac4162f8bdf6b3275f142691847bd75f60 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 11:25:01 +0200 Subject: [PATCH 31/47] Replace thread blocking queue with a map There seems to be no reason why we have to have an O(n) unblocking logic. Furthermore, this is much cleaner. --- rt/src/Scheduler.mts | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 9b2f762a..d4c4c96c 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -41,7 +41,7 @@ export class Scheduler implements SchedulerInterface { __funloop: Thread[]; /** Queue of blocked threads. */ - __blocked: Thread[]; + __blocked: { [tid in string]: Thread }; /** Map of alive threads from their stringified identifier, `tid`. */ __alive: { [tid in string]: Thread }; @@ -64,7 +64,7 @@ export class Scheduler implements SchedulerInterface { this.rt_uuid = runId; this.rtObj = rtObj; this.__funloop = []; - this.__blocked = []; + this.__blocked = {}; this.__alive = {}; this.__currentThread = null; } @@ -90,7 +90,7 @@ export class Scheduler implements SchedulerInterface { delete this.__alive[x]; } } - this.__blocked = []; + this.__blocked = {}; this.__funloop = []; // console.log (`The number of active threads is ${Object.keys(this.__alive).length}`) // console.log (`The number of blocked threads is ${this.__blocked.length}`) @@ -160,18 +160,15 @@ export class Scheduler implements SchedulerInterface { /** Block thread object `t`. */ blockThread(t: Thread) { - this.__blocked.push(t); + this.__blocked[t.tid.val.toString()] = t; } /** Unblock the thread with the given identifier, `pid`. */ unblockThread(tid: LVal) { - for (let i = 0; i < this.__blocked.length; i++) { - if (pid_equals(this.__blocked[i].tid, tid)) { - this.scheduleThread(this.__blocked[i]); - this.__blocked.splice(i, 1); - break; - } - } + if (!this.__blocked[tid.val.toString()]) { return; } + + this.scheduleThread(this.__blocked[tid.val.toString()]); + delete this.__blocked[tid.val.toString()]; } /*************************************************************************************************\ From 6f883c84a991997e09c158432d56faaf78cda91e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 11:37:17 +0200 Subject: [PATCH 32/47] Remove '__alive' from public Scheduler interface --- rt/src/SchedulerInterface.mts | 3 +-- rt/src/builtins/monitor.mts | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/rt/src/SchedulerInterface.mts b/rt/src/SchedulerInterface.mts index 742f3b81..8d29a61e 100644 --- a/rt/src/SchedulerInterface.mts +++ b/rt/src/SchedulerInterface.mts @@ -5,8 +5,7 @@ export interface SchedulerInterface { // tailToTroupeFun_raw(f: any) // stepThread(); resetScheduler(); - __alive: any; - scheduleNewThreadAtLevel(fun: any, arg: any, pc: any, blockingTopLev: any); + scheduleNewThreadAtLevel(fun: any, arg: any, pc: any, blockingTopLev: any); scheduleThread(theThread: any); resumeLoopAsync(); blockThread(__currentThread: Thread); diff --git a/rt/src/builtins/monitor.mts b/rt/src/builtins/monitor.mts index 2daf5d4a..f551cc64 100644 --- a/rt/src/builtins/monitor.mts +++ b/rt/src/builtins/monitor.mts @@ -14,7 +14,7 @@ export function BuiltinMonitors > (Ba // 1. find the thread corresponding to that tid - let t = this.runtime.__sched.__alive[tid.toString()]; + let t = this.runtime.__sched.getThread(tid); // 2. update the monitor state of that thread let r = this.runtime.rt_mkuuid(); From ad383a36db6a025f005db3d094ea56951cb33ec0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 11:40:26 +0200 Subject: [PATCH 33/47] Sort through and add some types for SchedulerInterface --- rt/src/Scheduler.mts | 30 +++++++++++++++++++----------- rt/src/SchedulerInterface.mts | 34 +++++++++++++++++++--------------- 2 files changed, 38 insertions(+), 26 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index d4c4c96c..de081a54 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -7,6 +7,7 @@ import { mkTuple } from './ValuesUtil.mjs'; import { SchedulerInterface } from './SchedulerInterface.mjs'; import { RuntimeInterface } from './RuntimeInterface.mjs'; import { LVal } from './Lval.mjs' +import { Level } from "./Level.mjs"; import {ProcessID, pid_equals} from './process.mjs' import SandboxStatus from './SandboxStatus.mjs' import {ThreadError, TroupeError} from './TroupeError.mjs' @@ -106,11 +107,18 @@ export class Scheduler implements SchedulerInterface { } /** Create a new thread `t` for the given function to be evaluated and schedule it. */ - scheduleNewThreadAtLevel (thefun, arg, levpc, levblock, ismain = false, persist=null, isSystem = false) { + scheduleNewThreadAtLevel (f: () => any, + arg: any, + pc: Level, + block: Level, + ismain: boolean = false, + persist: boolean | null = null, + isSystem: boolean = false) + { // Create a new process ID at the given level. const pid = isSystem ? SYSTEM_PROCESS_STRING : uuidv4(); const pidObj = new ProcessID(this.rt_uuid, pid, this.__node); - const newPid = new LVal(pidObj, levpc); + const newPid = new LVal(pidObj, pc); // Epilogue for thread. const halt = ismain ? () => { this.haltMain (persist) } : @@ -120,10 +128,10 @@ export class Scheduler implements SchedulerInterface { const t = new Thread ( newPid , halt - , thefun + , f , arg - , levpc - , levblock + , pc + , block , new SandboxStatus.NORMAL() , this.rtObj , this ); @@ -134,9 +142,9 @@ export class Scheduler implements SchedulerInterface { return newPid; } - /** Schedule the given function as the very next thing to be run. */ - schedule(thefun, args, nm) { - this.__currentThread.runNext(thefun, args, nm); + /** Schedule the given function as the very next thing to be run on the current thread. */ + schedule(f: () => any, args: any, namespace: any) { + this.__currentThread.runNext(f, args, namespace); this.scheduleThread(this.__currentThread); } @@ -206,7 +214,7 @@ export class Scheduler implements SchedulerInterface { delete this.__alive[this.__currentThread.tid.val.toString()]; console.log(">>> Main thread finished with value:", retVal.stringRep()); if (persist) { - this.rtObj.persist(retVal, persist ) + this.rtObj.persist(retVal, persist) console.log("Saved the result value in file", persist) } return null; @@ -220,8 +228,8 @@ export class Scheduler implements SchedulerInterface { } /** Kill thread `t` with the error message `s` sent to its monitors. */ - stopThreadWithErrorMessage (t: Thread, s: string) { - this.notifyMonitors(TerminationStatus.ERR, s); + stopThreadWithErrorMessage (t: Thread, errMsg: string) { + this.notifyMonitors(TerminationStatus.ERR, errMsg); delete this.__alive [t.tid.val.toString()]; } diff --git a/rt/src/SchedulerInterface.mts b/rt/src/SchedulerInterface.mts index 8d29a61e..458ec9d9 100644 --- a/rt/src/SchedulerInterface.mts +++ b/rt/src/SchedulerInterface.mts @@ -1,19 +1,23 @@ import { Thread } from "./Thread.mjs"; +import { LVal } from './Lval.mjs' +import { Level } from "./Level.mjs"; export interface SchedulerInterface { - // tailToTroupeFun(f: any, arg:any) - // tailToTroupeFun_raw(f: any) - // stepThread(); - resetScheduler(); - scheduleNewThreadAtLevel(fun: any, arg: any, pc: any, blockingTopLev: any); - scheduleThread(theThread: any); - resumeLoopAsync(); - blockThread(__currentThread: Thread); - isAlive(toPid: any); - getThread(toPid: any); - unblockThread(toPid: any); - schedule(fun: any, args: any[], namespace: any); __currentThread: Thread; - stopThreadWithErrorMessage (t:Thread, s:string) - -} \ No newline at end of file + + resetScheduler(): void; + + scheduleNewThreadAtLevel(fun: () => any, arg: any, pc: Level, block: Level): LVal; + scheduleThread(t: Thread): void; + schedule(fun: () => any, args: any[], namespace: any): void; + + blockThread(t: Thread): void; + unblockThread(tid: LVal): void; + + isAlive(tid: LVal): boolean; + getThread(tid: LVal): Thread; + + stopThreadWithErrorMessage (t: Thread, errMsg: string): void + + resumeLoopAsync(): void; +} From c6b368f9536fe513bdc370f993c0fb217f90d2ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 12:01:24 +0200 Subject: [PATCH 34/47] Remove unused logger --- rt/src/Scheduler.mts | 5 ----- 1 file changed, 5 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index de081a54..f24ef88a 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -19,11 +19,6 @@ import { getCliArgs, TroupeCliArg } from './TroupeCliArgs.mjs'; const argv = getCliArgs(); const showStack = argv[TroupeCliArg.ShowStack] -import { mkLogger } from './logger.mjs' -const logger = mkLogger('scheduler'); -const info = x => logger.info(x) -const debug = x => logger.debug(x) - /** Enum for termination statuses. */ enum TerminationStatus { /** Thread finished its computation. */ From d45d123f75953eb5256a54f36d33230409a46887 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 12:06:32 +0200 Subject: [PATCH 35/47] Only show stack if flag is set (as is documented) --- rt/src/Scheduler.mts | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index f24ef88a..ee43a82e 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -285,7 +285,10 @@ export class Scheduler implements SchedulerInterface { console.log("--- Schedule module caught an internal exception ---"); console.log("--- The following output may help identify a bug in the runtime ---"); console.log("Destination function\n", dest); - this.__currentThread.showStack(); + + if (showStack) { + this.__currentThread.showStack(); + } throw e; } } From 6d0dce45b87eaa74f16c61a83d9461deba65bf7f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 12:07:08 +0200 Subject: [PATCH 36/47] Remove dead code in tight scheduling loop --- rt/src/Scheduler.mts | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index ee43a82e..062c16a0 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -258,16 +258,6 @@ export class Scheduler implements SchedulerInterface { dest = _curThread.next; let ttl = 1000; // magic constant; 2021-04-29 while (dest && ttl--) { - // 2021-04-24; AA; TODO: profile the addition of this conditional in this tight loop - // if (showStack) { - // this.__currentThread.showStack() - // } - // console.log (">>>>>>>>>>") - // console.log (dest.toString()) - // console.log ("<<<<<<<<<<") - // if (dest.debugname ) { - // console.log (" -- ", dest.debugname) - // } dest = dest(); } From 06f20026ff03e3478298afb742cb00e416e69123 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 12:24:04 +0200 Subject: [PATCH 37/47] Clean up 'Scheduler.loop()' --- rt/src/Scheduler.mts | 38 ++++++++++++++++++++------------------ 1 file changed, 20 insertions(+), 18 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 062c16a0..59d51dcb 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -17,7 +17,6 @@ import {SYSTEM_PROCESS_STRING} from './Constants.mjs' import { getCliArgs, TroupeCliArg } from './TroupeCliArgs.mjs'; const argv = getCliArgs(); -const showStack = argv[TroupeCliArg.ShowStack] /** Enum for termination statuses. */ enum TerminationStatus { @@ -247,25 +246,26 @@ export class Scheduler implements SchedulerInterface { * around 50M on the low points of the wave. */ loop() { - const $$LOOPBOUND = 500000; - let _FUNLOOP = this.__funloop - let _curThread: Thread; - let dest; + const maxThreadsPerLoop = 500000; + const maxKontsPerThread = 1000; + + let dest: () => any; try { - for (let $$loopiter = 0; $$loopiter < $$LOOPBOUND && _FUNLOOP.length > 0; $$loopiter++) { - _curThread = _FUNLOOP.shift(); - this.__currentThread = _curThread; - dest = _curThread.next; - let ttl = 1000; // magic constant; 2021-04-29 - while (dest && ttl--) { + for (let i = 0; i < maxThreadsPerLoop && this.__funloop.length > 0; ++i) { + // Pop front of function queue and set it to be the next thread. + this.__currentThread = this.__funloop.shift(); + dest = this.__currentThread.next; + + // Run thread for `maxKontsPerThread` continuations. + for (let j = 0; dest && j < maxKontsPerThread; ++j) { dest = dest(); } + // If not done, push it back into the queue. if (dest) { - _curThread.handlerState.checkGuard(); - - _curThread.next = dest; - _FUNLOOP.push(_curThread); + this.__currentThread.handlerState.checkGuard(); + this.__currentThread.next = dest; + this.__funloop.push(this.__currentThread); } } } catch (e) { @@ -276,18 +276,20 @@ export class Scheduler implements SchedulerInterface { console.log("--- The following output may help identify a bug in the runtime ---"); console.log("Destination function\n", dest); - if (showStack) { + if (argv[TroupeCliArg.ShowStack]) { this.__currentThread.showStack(); } throw e; } } - if (_FUNLOOP.length > 0) { - // we are not really done, but are just hacking around the V8's memory management + // If more work is to be done, then resume `loop` after the Javascript runtime has been able + // to run other tasks, e.g. garbage collection. + if (this.__funloop.length > 0) { this.resumeLoopAsync(); } + // If everything is done, and the node should not persist, then terminate. if (this.__stopWhenAllThreadsAreDone && Object.keys(this.__alive).length == 0) { this.__stopRuntime(); } From 7df5a2961664ee55392e447528c7bef4f5bc030b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 12:40:21 +0200 Subject: [PATCH 38/47] Replace optional arguments for newly scheduled threads with an enum This much better conveys the meaning of this argument, especially from the call site --- rt/src/Scheduler.mts | 25 +++++++++++++++++-------- rt/src/runtimeMonitored.mts | 9 +++------ 2 files changed, 20 insertions(+), 14 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 59d51dcb..2d0cd4ef 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -18,6 +18,16 @@ import {SYSTEM_PROCESS_STRING} from './Constants.mjs' import { getCliArgs, TroupeCliArg } from './TroupeCliArgs.mjs'; const argv = getCliArgs(); +/** Enum for termination statuses. */ +export enum ThreadType { + /** System service thread. */ + System = -1, + /** Main thread. */ + Main = 0, + /** Other threads, spawned from 'Main' or 'System'. */ + Other = 1 +} + /** Enum for termination statuses. */ enum TerminationStatus { /** Thread finished its computation. */ @@ -105,18 +115,16 @@ export class Scheduler implements SchedulerInterface { arg: any, pc: Level, block: Level, - ismain: boolean = false, - persist: boolean | null = null, - isSystem: boolean = false) + tType: ThreadType = ThreadType.Other) { // Create a new process ID at the given level. - const pid = isSystem ? SYSTEM_PROCESS_STRING : uuidv4(); + const pid = tType === ThreadType.System ? SYSTEM_PROCESS_STRING : uuidv4(); const pidObj = new ProcessID(this.rt_uuid, pid, this.__node); - const newPid = new LVal(pidObj, pc); + const newPid = new LVal(pidObj, pc); // Epilogue for thread. - const halt = ismain ? () => { this.haltMain (persist) } : - () => { this.haltOther () }; + const halt = tType === ThreadType.Main ? () => { this.haltMain() } + : () => { this.haltOther() }; // New thread const t = new Thread @@ -197,7 +205,7 @@ export class Scheduler implements SchedulerInterface { } /** Epilogue for `main` thread: notify monitors, print and persist the final value */ - haltMain (persist=null) { + haltMain () { this.__currentThread.raiseCurrentThreadPCToBlockingLev() let retVal = new LVal (this.__currentThread.r0_val, lub(this.__currentThread.bl, this.__currentThread.r0_lev), @@ -207,6 +215,7 @@ export class Scheduler implements SchedulerInterface { delete this.__alive[this.__currentThread.tid.val.toString()]; console.log(">>> Main thread finished with value:", retVal.stringRep()); + const persist = argv[TroupeCliArg.Persist]; if (persist) { this.rtObj.persist(retVal, persist) console.log("Saved the result value in file", persist) diff --git a/rt/src/runtimeMonitored.mts b/rt/src/runtimeMonitored.mts index 9fcc56d3..ae1517db 100644 --- a/rt/src/runtimeMonitored.mts +++ b/rt/src/runtimeMonitored.mts @@ -4,7 +4,7 @@ import { v4 as uuidv4 } from 'uuid' import AggregateError from 'aggregate-error'; import { __unit } from './UnitVal.mjs' import { Authority } from './Authority.mjs' -import { Scheduler } from './Scheduler.mjs' +import { Scheduler, ThreadType } from './Scheduler.mjs' import { MailboxProcessor } from './MailboxProcessor.mjs' import { RuntimeInterface } from './RuntimeInterface.mjs' import { LVal, MbVal } from './Lval.mjs' @@ -445,9 +445,7 @@ export async function start(f) { , service_arg , levels.TOP , levels.BOT - , false - , null - , true); + , ThreadType.System); } __sched.scheduleNewThreadAtLevel( @@ -455,8 +453,7 @@ export async function start(f) { , mainAuthority , levels.BOT , levels.BOT - , true - , argv[TroupeCliArg.Persist] + , ThreadType.Main ); __sched.loop(); } From 891edb6d300a2d60f6245fd87530afd3b786be67 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 14:02:27 +0200 Subject: [PATCH 39/47] Remove dead code 'schedule(...)' --- rt/src/Scheduler.mts | 6 ------ rt/src/SchedulerInterface.mts | 1 - 2 files changed, 7 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 2d0cd4ef..39a97ad1 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -144,12 +144,6 @@ export class Scheduler implements SchedulerInterface { return newPid; } - /** Schedule the given function as the very next thing to be run on the current thread. */ - schedule(f: () => any, args: any, namespace: any) { - this.__currentThread.runNext(f, args, namespace); - this.scheduleThread(this.__currentThread); - } - /*************************************************************************************************\ Thread access \*************************************************************************************************/ diff --git a/rt/src/SchedulerInterface.mts b/rt/src/SchedulerInterface.mts index 458ec9d9..18da12f9 100644 --- a/rt/src/SchedulerInterface.mts +++ b/rt/src/SchedulerInterface.mts @@ -9,7 +9,6 @@ export interface SchedulerInterface { scheduleNewThreadAtLevel(fun: () => any, arg: any, pc: Level, block: Level): LVal; scheduleThread(t: Thread): void; - schedule(fun: () => any, args: any[], namespace: any): void; blockThread(t: Thread): void; unblockThread(tid: LVal): void; From b0e597e0be2c451b8b427764cac941f3bca6a65a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 14:05:15 +0200 Subject: [PATCH 40/47] Simplify name of 'scheduleNewThread...' --- rt/src/Scheduler.mts | 10 +++++----- rt/src/SchedulerInterface.mts | 2 +- rt/src/builtins/spawn.mts | 2 +- rt/src/runtimeMonitored.mts | 6 +++--- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 39a97ad1..a50df759 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -111,11 +111,11 @@ export class Scheduler implements SchedulerInterface { } /** Create a new thread `t` for the given function to be evaluated and schedule it. */ - scheduleNewThreadAtLevel (f: () => any, - arg: any, - pc: Level, - block: Level, - tType: ThreadType = ThreadType.Other) + scheduleNewThread(f: () => any, + arg: any, + pc: Level, + block: Level, + tType: ThreadType = ThreadType.Other) { // Create a new process ID at the given level. const pid = tType === ThreadType.System ? SYSTEM_PROCESS_STRING : uuidv4(); diff --git a/rt/src/SchedulerInterface.mts b/rt/src/SchedulerInterface.mts index 18da12f9..bb69b944 100644 --- a/rt/src/SchedulerInterface.mts +++ b/rt/src/SchedulerInterface.mts @@ -7,7 +7,7 @@ export interface SchedulerInterface { resetScheduler(): void; - scheduleNewThreadAtLevel(fun: () => any, arg: any, pc: Level, block: Level): LVal; + scheduleNewThread(fun: () => any, arg: any, pc: Level, block: Level): LVal; scheduleThread(t: Thread): void; blockThread(t: Thread): void; diff --git a/rt/src/builtins/spawn.mts b/rt/src/builtins/spawn.mts index 930b5244..35261fa7 100644 --- a/rt/src/builtins/spawn.mts +++ b/rt/src/builtins/spawn.mts @@ -27,7 +27,7 @@ export function BuiltinSpawn>(Base: T let spawnLocal = (arg) => { // debug ("scheduled rt_spawn ", arg.fun); - let newPid = __sched.scheduleNewThreadAtLevel( + let newPid = __sched.scheduleNewThread( arg, __unit, // [arg.env, __unit], // arg.namespace, diff --git a/rt/src/runtimeMonitored.mts b/rt/src/runtimeMonitored.mts index ae1517db..9175ef09 100644 --- a/rt/src/runtimeMonitored.mts +++ b/rt/src/runtimeMonitored.mts @@ -134,7 +134,7 @@ async function spawnFromRemote(jsonObj, fromNode) { const lf = await DS.deserialize(nodeLev, jsonObj); const f = lf.val; const newPid = - __sched.scheduleNewThreadAtLevel( + __sched.scheduleNewThread( f , __unit //[f.env, __unit] // , f.namespace @@ -441,14 +441,14 @@ export async function start(f) { new LVal ( new Record([ ["authority", mainAuthority], ["options", __unit]]), levels.BOT); - __sched.scheduleNewThreadAtLevel(__service['service'] + __sched.scheduleNewThread(__service['service'] , service_arg , levels.TOP , levels.BOT , ThreadType.System); } - __sched.scheduleNewThreadAtLevel( + __sched.scheduleNewThread( () => f.main({__dataLevel:levels.BOT}) , mainAuthority , levels.BOT From 4dbfc9d9e3f3f85237660d3245df48283a721aa4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 14:20:02 +0200 Subject: [PATCH 41/47] Stop exposing/using internal (private) variable within Scheduler --- rt/src/Asserts.mts | 2 +- rt/src/MailboxProcessor.mts | 4 ++-- rt/src/Scheduler.mts | 12 ++++++++++++ rt/src/SchedulerInterface.mts | 4 ++-- rt/src/builtins/UserRuntimeZero.mts | 7 +++---- rt/src/builtins/monitor.mts | 2 +- rt/src/builtins/receive.mts | 2 +- rt/src/builtins/self.mts | 2 +- rt/src/runtimeMonitored.mts | 2 +- 9 files changed, 24 insertions(+), 13 deletions(-) diff --git a/rt/src/Asserts.mts b/rt/src/Asserts.mts index 88ed0081..a72df5f3 100644 --- a/rt/src/Asserts.mts +++ b/rt/src/Asserts.mts @@ -16,7 +16,7 @@ import { TroupeAggregateRawValue, TroupeRawValue } from './TroupeRawValue.mjs'; // import { LVal } from './Lval'; function _thread() { - return getRuntimeObject().__sched.__currentThread + return getRuntimeObject().__sched.getCurrentThread() } function __stringRep (v) { diff --git a/rt/src/MailboxProcessor.mts b/rt/src/MailboxProcessor.mts index 8c7bd239..65a7f152 100644 --- a/rt/src/MailboxProcessor.mts +++ b/rt/src/MailboxProcessor.mts @@ -105,7 +105,7 @@ export class MailboxProcessor implements MailboxInterface { peek(lev: Level, index: number, lowb: Level, highb: Level) { - let theThread = this.sched.__currentThread + let theThread = this.sched.getCurrentThread() let mb = theThread.mailbox; debug (`peek index: ${index}`) debug (`peek interval: [${lowb.stringRep()}, ${highb.stringRep()}]`) @@ -138,7 +138,7 @@ export class MailboxProcessor implements MailboxInterface { } consume(lev: Level, index: number, lowb: Level, highb: Level) { - let theThread = this.sched.__currentThread + let theThread = this.sched.getCurrentThread() let mb = theThread.mailbox; debug (`consume index: ${index}`) debug (`consume interval: [${lowb.stringRep()} to ${highb.stringRep()}]`) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index a50df759..7f32f4f7 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -158,6 +158,18 @@ export class Scheduler implements SchedulerInterface { return this.__alive[tid.val.toString()]; } + /** The currently scheduled thread */ + getCurrentThread() { + return this.__currentThread; + } + + /** Overwrites the current thread; the previously current thread is returned. */ + setCurrentThread(t: Thread) { + const prev = this.__currentThread + this.__currentThread = t; + return prev; + } + /*************************************************************************************************\ Thread blocking/unblocking \*************************************************************************************************/ diff --git a/rt/src/SchedulerInterface.mts b/rt/src/SchedulerInterface.mts index bb69b944..b1f7475f 100644 --- a/rt/src/SchedulerInterface.mts +++ b/rt/src/SchedulerInterface.mts @@ -3,8 +3,6 @@ import { LVal } from './Lval.mjs' import { Level } from "./Level.mjs"; export interface SchedulerInterface { - __currentThread: Thread; - resetScheduler(): void; scheduleNewThread(fun: () => any, arg: any, pc: Level, block: Level): LVal; @@ -15,6 +13,8 @@ export interface SchedulerInterface { isAlive(tid: LVal): boolean; getThread(tid: LVal): Thread; + getCurrentThread(): Thread; + setCurrentThread(t: Thread): Thread; stopThreadWithErrorMessage (t: Thread, errMsg: string): void diff --git a/rt/src/builtins/UserRuntimeZero.mts b/rt/src/builtins/UserRuntimeZero.mts index 1f34839c..001888bf 100644 --- a/rt/src/builtins/UserRuntimeZero.mts +++ b/rt/src/builtins/UserRuntimeZero.mts @@ -259,13 +259,12 @@ export class UserRuntimeZero { libLoadingPseudoThread = new Thread(null, null, null, __unit, levels.BOT, levels.BOT, null, this, null); - savedThread = null ;// this.runtime.__sched.__currentThread; + savedThread = null ;// this.runtime.__sched.getCurrentThread(); setLibloadMode() { this.mkVal = (x) => new LVal(x, levels.BOT); this.mkValPos = (x, pos) => new LVal(x, levels.BOT, levels.BOT, pos); this.Env = LibEnv; - this.savedThread = this.runtime.__sched.__currentThread; - this.runtime.__sched.__currentThread = this.libLoadingPseudoThread; + this.savedThread = this.runtime.__sched.setCurrentThread(this.libLoadingPseudoThread); } @@ -273,7 +272,7 @@ export class UserRuntimeZero { this.mkVal = this.default_mkVal; this.mkValPos = this.default_mkValPos this.Env = RtEnv; - this.runtime.__sched.__currentThread = this.savedThread; + this.runtime.__sched.setCurrentThread(this.savedThread); } // tailcall(lff, arg) { diff --git a/rt/src/builtins/monitor.mts b/rt/src/builtins/monitor.mts index f551cc64..9a0ff26d 100644 --- a/rt/src/builtins/monitor.mts +++ b/rt/src/builtins/monitor.mts @@ -19,7 +19,7 @@ export function BuiltinMonitors > (Ba let r = this.runtime.rt_mkuuid(); if (t) { - t.addMonitor(this.runtime.__sched.__currentThread.tid, r); + t.addMonitor(this.runtime.__sched.getCurrentThread().tid, r); } return this.runtime.ret(r); diff --git a/rt/src/builtins/receive.mts b/rt/src/builtins/receive.mts index 0bbbc459..39796d89 100644 --- a/rt/src/builtins/receive.mts +++ b/rt/src/builtins/receive.mts @@ -133,7 +133,7 @@ export function BuiltinReceive>(Base: _blockThread = mkBase ((arg) => { assertIsUnit(arg) - this.runtime.__sched.blockThread(this.runtime.__sched.__currentThread); + this.runtime.__sched.blockThread(this.runtime.__sched.getCurrentThread()); return null; }) diff --git a/rt/src/builtins/self.mts b/rt/src/builtins/self.mts index 6b098337..5ff6d8b9 100644 --- a/rt/src/builtins/self.mts +++ b/rt/src/builtins/self.mts @@ -8,7 +8,7 @@ import { UserRuntimeZero, Constructor, mkBase } from './UserRuntimeZero.mjs' export function BuiltinSelf>(Base: TBase) { return class extends Base { self = mkBase((arg) => { - return this.runtime.ret(this.runtime.__sched.__currentThread.tid); + return this.runtime.ret(this.runtime.__sched.getCurrentThread().tid); }, "self"); } } \ No newline at end of file diff --git a/rt/src/runtimeMonitored.mts b/rt/src/runtimeMonitored.mts index 9175ef09..c0b6029e 100644 --- a/rt/src/runtimeMonitored.mts +++ b/rt/src/runtimeMonitored.mts @@ -48,7 +48,7 @@ const rt_xconsole = }); /** Returns the current thread */ -function $t():Thread { return __sched.__currentThread }; +function $t():Thread { return __sched.getCurrentThread() }; // -------------------------------------------------- From 52708bbfe5edbd9d2687a6191c5582362941e67e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Wed, 15 Oct 2025 16:45:40 +0200 Subject: [PATCH 42/47] Skip execution of dead threads --- rt/src/Scheduler.mts | 2 ++ 1 file changed, 2 insertions(+) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 7f32f4f7..e38b14e5 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -269,6 +269,8 @@ export class Scheduler implements SchedulerInterface { for (let i = 0; i < maxThreadsPerLoop && this.__funloop.length > 0; ++i) { // Pop front of function queue and set it to be the next thread. this.__currentThread = this.__funloop.shift(); + if (!this.__alive[this.__currentThread.tid.val.toString()]) { continue; } + dest = this.__currentThread.next; // Run thread for `maxKontsPerThread` continuations. From 1e4b0ef6e9e67e7b36f989749feb2a4318627621 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Thu, 16 Oct 2025 14:31:22 +0200 Subject: [PATCH 43/47] Comment and reorder 'start(..)' --- rt/src/runtimeMonitored.mts | 32 ++++++++++++++++++++++++-------- 1 file changed, 24 insertions(+), 8 deletions(-) diff --git a/rt/src/runtimeMonitored.mts b/rt/src/runtimeMonitored.mts index c0b6029e..c76b8ca8 100644 --- a/rt/src/runtimeMonitored.mts +++ b/rt/src/runtimeMonitored.mts @@ -409,6 +409,7 @@ async function getNetworkPeerId(rtHandlers) { export async function start(f) { + // Set up p2p network await initTrustMap(); let peerid = await getNetworkPeerId({ @@ -427,18 +428,25 @@ export async function start(f) { __nodeManager.setLocalPeerId(peerid); - let stopWhenAllThreadsAreDone = !__p2pRunning - __sched.initScheduler(__nodeManager.getLocalNode() - , stopWhenAllThreadsAreDone - , cleanupAsync); + // --------------------------------------------------------------------------- + // Initialise 'scheduler' for Troupe code execution + __sched.initScheduler(__nodeManager.getLocalNode() , !__p2pRunning, cleanupAsync); - await loadServiceCode() - await __userRuntime.linkLibs(f); - let mainAuthority = new LVal(new Authority(levels.ROOT), levels.BOT); + // --------------------------------------------------------------------------- + // Set up 'service' thread + + // HACK: Despite the fact that service code is only spawned, if `__p2pRunning`, + // we need to populate the runtime.$service object. + // + // TODO: Instead, treat these fields as nullable in `builtins/receive.mts` and + // elsewhere. Best is to also put this into the typesystem. + await loadServiceCode(); if (__p2pRunning) { + const serviceAuthority = new LVal(new Authority(levels.ROOT), levels.BOT); + let service_arg = - new LVal ( new Record([ ["authority", mainAuthority], + new LVal ( new Record([ ["authority", serviceAuthority], ["options", __unit]]), levels.BOT); __sched.scheduleNewThread(__service['service'] @@ -448,6 +456,11 @@ export async function start(f) { , ThreadType.System); } + // Set up 'main' thread + const mainAuthority = new LVal(new Authority(levels.ROOT), levels.BOT); + + await __userRuntime.linkLibs(f); + __sched.scheduleNewThread( () => f.main({__dataLevel:levels.BOT}) , mainAuthority @@ -455,5 +468,8 @@ export async function start(f) { , levels.BOT , ThreadType.Main ); + + // --------------------------------------------------------------------------- + // Start code execution __sched.loop(); } From 15a0458fd9164d5a41cd3fb7cc3728d4cbce4562 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 20 Oct 2025 09:06:23 +0200 Subject: [PATCH 44/47] Turn thread termination resolution into a callback This allows us later to store an initialised module. For now, it cleans up the scheduler by decreasing the number of responsibilities. --- rt/src/Scheduler.mts | 76 ++++++++++++++----------------------- rt/src/builtins/spawn.mts | 19 +++------- rt/src/runtimeMonitored.mts | 16 ++++++-- 3 files changed, 47 insertions(+), 64 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index e38b14e5..831e900a 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -110,38 +110,46 @@ export class Scheduler implements SchedulerInterface { this.__funloop.push(t); } - /** Create a new thread `t` for the given function to be evaluated and schedule it. */ + /** Create a new thread `t` for the given function to be evaluated and schedule it. + * + * NOTE (20-10-2025; SS): A hypothesis about the Javascript event loop: + * + * It would be a more clean design to return the thread identifier of type `LVal`, as we + * do right now, together with a `Promise` of the final returned value. But, since + * the Javascript event loop is a LIFO queue, i.e. a stack, this would bury resolving the + * termination of each thread (especially the *main* thread) beneath everything else. + */ scheduleNewThread(f: () => any, arg: any, pc: Level, block: Level, - tType: ThreadType = ThreadType.Other) + tType: ThreadType = ThreadType.Other, + cb: (LVal) => void = (_) => {}) { // Create a new process ID at the given level. const pid = tType === ThreadType.System ? SYSTEM_PROCESS_STRING : uuidv4(); - const pidObj = new ProcessID(this.rt_uuid, pid, this.__node); - const newPid = new LVal(pidObj, pc); + const tid = new LVal(new ProcessID(this.rt_uuid, pid, this.__node), pc); + + const halt = () => { + this.__currentThread.raiseCurrentThreadPCToBlockingLev(); + this.notifyMonitors(); - // Epilogue for thread. - const halt = tType === ThreadType.Main ? () => { this.haltMain() } - : () => { this.haltOther() }; + const currT = this.__currentThread; + const retVal = new LVal (currT.r0_val, lub(currT.bl, currT.r0_lev), lub(currT.bl, currT.r0_tlev)); + + delete this.__alive[this.__currentThread.tid.val.toString()]; + + cb(retVal); + } // New thread - const t = new Thread - ( newPid - , halt - , f - , arg - , pc - , block - , new SandboxStatus.NORMAL() - , this.rtObj - , this ); - - - this.__alive[newPid.val.toString()] = t; + const sStatus = new SandboxStatus.NORMAL(); + const t = new Thread(tid, halt, f, arg, pc, block, sStatus, this.rtObj, this); + + this.__alive[tid.val.toString()] = t; this.scheduleThread(t); - return newPid; + + return tid as LVal; } /*************************************************************************************************\ @@ -210,32 +218,6 @@ export class Scheduler implements SchedulerInterface { } } - /** Epilogue for `main` thread: notify monitors, print and persist the final value */ - haltMain () { - this.__currentThread.raiseCurrentThreadPCToBlockingLev() - let retVal = new LVal (this.__currentThread.r0_val, - lub(this.__currentThread.bl, this.__currentThread.r0_lev), - lub(this.__currentThread.bl, this.__currentThread.r0_tlev)) - - this.notifyMonitors(); - - delete this.__alive[this.__currentThread.tid.val.toString()]; - console.log(">>> Main thread finished with value:", retVal.stringRep()); - const persist = argv[TroupeCliArg.Persist]; - if (persist) { - this.rtObj.persist(retVal, persist) - console.log("Saved the result value in file", persist) - } - return null; - } - - /** Epilogue for non-`main` threads: notify monitors */ - haltOther () { - this.notifyMonitors(); - // console.log (this.__currentThread.processDebuggingName, this.__currentThread.tid.val.toString(), "done") - delete this.__alive[this.__currentThread.tid.val.toString()]; - } - /** Kill thread `t` with the error message `s` sent to its monitors. */ stopThreadWithErrorMessage (t: Thread, errMsg: string) { this.notifyMonitors(TerminationStatus.ERR, errMsg); diff --git a/rt/src/builtins/spawn.mts b/rt/src/builtins/spawn.mts index 35261fa7..b5750015 100644 --- a/rt/src/builtins/spawn.mts +++ b/rt/src/builtins/spawn.mts @@ -21,22 +21,13 @@ export function BuiltinSpawn>(Base: T // console.log ("SPAWN ARGS", larg) this.runtime.$t.raiseCurrentThreadPC(larg.lev); let arg = larg.val; - let __sched = this.runtime.__sched - - let spawnLocal = (arg) => { - // debug ("scheduled rt_spawn ", arg.fun); - - let newPid = __sched.scheduleNewThread( - arg, - __unit, // [arg.env, __unit], - // arg.namespace, - this.runtime.$t.pc, - this.runtime.$t.bl) - return this.runtime.$t.returnImmediateLValue(newPid) ; + const spawnLocal = (func) => { + const tid = this.runtime.__sched.scheduleNewThread( + func, __unit, this.runtime.$t.pc, this.runtime.$t.bl); + return this.runtime.$t.returnImmediateLValue(tid); } - if (Array.isArray(arg)) { if (__nodeManager.isLocalNode(arg[0].val)) { // check if we are at the same node or note // debug ("SAME NODE") @@ -55,4 +46,4 @@ export function BuiltinSpawn>(Base: T } }, "spawn"); } -} \ No newline at end of file +} diff --git a/rt/src/runtimeMonitored.mts b/rt/src/runtimeMonitored.mts index c76b8ca8..bed187ff 100644 --- a/rt/src/runtimeMonitored.mts +++ b/rt/src/runtimeMonitored.mts @@ -133,7 +133,7 @@ async function spawnFromRemote(jsonObj, fromNode) { const lf = await DS.deserialize(nodeLev, jsonObj); const f = lf.val; - const newPid = + const tid = __sched.scheduleNewThread( f , __unit //[f.env, __unit] @@ -145,7 +145,7 @@ async function spawnFromRemote(jsonObj, fromNode) { // 2018-09-19: AA: because we need to send some info back, we have to invoke // serialization. - const serObj = serialize(newPid, levels.BOT).data + const serObj = serialize(tid, levels.BOT).data __sched.resumeLoopAsync(); return serObj; } @@ -278,6 +278,7 @@ function rt_ret (arg) { return $t().returnImmediateLValue(arg); } +// TODO: Clean up the mess below... let __sched: Scheduler let __theMailbox: MailboxProcessor let __userRuntime: any @@ -461,15 +462,24 @@ export async function start(f) { await __userRuntime.linkLibs(f); + const onTerminate = (retVal: LVal) => { + console.log(`>>> Main thread finished with value: ${retVal.stringRep()}`); + if (argv[TroupeCliArg.Persist]) { + this.rtObj.persist(retVal, argv[TroupeCliArg.Persist]) + console.log("Saved the result value in file", argv[TroupeCliArg.Persist]) + } + }; + __sched.scheduleNewThread( () => f.main({__dataLevel:levels.BOT}) , mainAuthority , levels.BOT , levels.BOT , ThreadType.Main + , onTerminate ); // --------------------------------------------------------------------------- // Start code execution - __sched.loop(); + __sched.resumeLoopAsync(); } From 9b668f89699359f37e2b54c04f6319f116f8a513 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 20 Oct 2025 09:07:14 +0200 Subject: [PATCH 45/47] Fix indentation to better convey how the paragraphs fit together --- rt/src/Scheduler.mts | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 831e900a..8bca105d 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -230,17 +230,16 @@ export class Scheduler implements SchedulerInterface { /** Start the main scheduler loop. * - * HACK (2018-02-18: AA): a hypothesis about memory management in V8 + * HACK (2018-02-18: AA): a hypothesis about memory management in V8: * - * It appears that V8's memory management is not very well suited for infinitely - * running functions. In other words, functions are expected to eventually - * terminate, and all long-running computations are expected to run through the - * event loop. This is not surprising given the application where V8 is used. - * This is why we periodically yield to the event loop; this hack appears to let - * GC claim the objects allocated throughout the runtime of this function. Note - * that without this hack, we are observing memory leaks for many "server"-like - * programs; with the hack, we get a waivy memory consumption profile that reaches - * around 50M on the low points of the wave. + * It appears that V8's memory management is not very well suited for infinitely running + * functions. In other words, functions are expected to eventually terminate, and all + * long-running computations are expected to run through the event loop. This is not + * surprising given the application where V8 is used. This is why we periodically yield to + * the event loop; this hack appears to let GC claim the objects allocated throughout the + * runtime of this function. Note that without this hack, we are observing memory leaks for + * many "server"-like programs; with the hack, we get a waivy memory consumption profile + * that reaches around 50M on the low points of the wave. */ loop() { const maxThreadsPerLoop = 500000; From b7cf32a73038568010d9c005b706b8d8ea0c8795 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 20 Oct 2025 09:09:46 +0200 Subject: [PATCH 46/47] Clean up comments for 'resetScheduler' --- rt/src/Scheduler.mts | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/rt/src/Scheduler.mts b/rt/src/Scheduler.mts index 8bca105d..8e089f96 100644 --- a/rt/src/Scheduler.mts +++ b/rt/src/Scheduler.mts @@ -82,23 +82,17 @@ export class Scheduler implements SchedulerInterface { this.__stopRuntime = stopRuntime; } - /** Kill all current threads (without notifying any monitors), staying ready for spawning new - * threads. */ + /** Kill all threads except the current one, staying ready for spawning new threads. + * + * @note This does not notify the monitors. */ resetScheduler() { - // console.log (`The current length of __funloop is ${this.__funloop.length}`) - // console.log (`The number of active threads is ${Object.keys(this.__alive).length}`) for (let x in this.__alive) { - if (this.__currentThread.tid.val.toString() == x) { - // console.log (x, "ACTIVE") - } else { - // console.log (x, "KILLING"); + if (this.__currentThread.tid.val.toString() !== x) { delete this.__alive[x]; } } this.__blocked = {}; this.__funloop = []; - // console.log (`The number of active threads is ${Object.keys(this.__alive).length}`) - // console.log (`The number of blocked threads is ${this.__blocked.length}`) } /*************************************************************************************************\ From c68f75a809775fd0c86445b311b28e8fe03e8664 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Steffan=20S=C3=B8lvsten?= Date: Mon, 20 Oct 2025 09:20:12 +0200 Subject: [PATCH 47/47] Add '__userRuntime' to interface since it is not kept private --- rt/src/RuntimeInterface.mts | 1 + rt/src/troupe.mts | 5 ++--- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/rt/src/RuntimeInterface.mts b/rt/src/RuntimeInterface.mts index a2f2f022..c7b559c2 100644 --- a/rt/src/RuntimeInterface.mts +++ b/rt/src/RuntimeInterface.mts @@ -11,6 +11,7 @@ export interface RuntimeInterface { $t: Thread; $service: any; // todo 2021-06-13; identify what the right interface here should be debug(arg0: string); + __userRuntime: any __sched: SchedulerInterface __mbox : MailboxInterface sendMessageNoChecks(toPid: any, message: LVal, arg2?: boolean): any; diff --git a/rt/src/troupe.mts b/rt/src/troupe.mts index 981ac8c6..82079eee 100644 --- a/rt/src/troupe.mts +++ b/rt/src/troupe.mts @@ -19,9 +19,8 @@ if (!fs.existsSync(p)) { } (async () => { let d = await import (p); - let Top = d.default - let __userRuntime = (getRuntimeObject() as any).__userRuntime; - let top = new Top(__userRuntime); + let Top = d.default; + let top = new Top(getRuntimeObject().__userRuntime); start(top); }) ()