From 25ca25946df5fca30de60d477301f750d5394db7 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 14 Aug 2023 20:48:05 -0400 Subject: c: Use the Tcl error in __ENSURE_OK --- lib/c.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/c.tcl b/lib/c.tcl index 165ab723..82b1cfce 100644 --- a/lib/c.tcl +++ b/lib/c.tcl @@ -45,7 +45,7 @@ namespace eval c { #include #define __ENSURE(EXPR) if (!(EXPR)) { Tcl_SetResult(interp, "failed to convert argument from Tcl to C in: " #EXPR, NULL); return TCL_ERROR; } - #define __ENSURE_OK(EXPR) if ((EXPR) != TCL_OK) { Tcl_SetResult(interp, "failed to convert argument from Tcl to C in: " #EXPR, NULL); return TCL_ERROR; } + #define __ENSURE_OK(EXPR) if ((EXPR) != TCL_OK) { return TCL_ERROR; } } variable code [list] variable objtypes [list] -- cgit v1.2.3 From b9ceecfd47988d11952c34d40b63d16494fc8070 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 14 Aug 2023 20:48:17 -0400 Subject: evaluator: Add dot and print helpers --- lib/evaluator.tcl | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'lib') diff --git a/lib/evaluator.tcl b/lib/evaluator.tcl index 0554c189..feded645 100644 --- a/lib/evaluator.tcl +++ b/lib/evaluator.tcl @@ -757,6 +757,15 @@ namespace eval Statements { ;# singleton Statement store } return "digraph { rankdir=LR; [join $dot "\n"] }" } + proc saveDotToPdf {filename} { + exec dot -Tpdf >$filename <<[Statements::dot] + } + + proc print {} { + dict for {id stmt} [Statements::all] { + puts [statement short $stmt] + } + } # these are kind of arbitrary/temporary bridge $cc proc matchRemoveFirstDestructor {match_handle_t matchId} void { -- cgit v1.2.3 From 5f08c1da793d98ce1269d7a9a47ec191024f9356 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 14 Aug 2023 20:48:50 -0400 Subject: Evaluator: better incrementalize collect --- lib/evaluator.tcl | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) (limited to 'lib') diff --git a/lib/evaluator.tcl b/lib/evaluator.tcl index feded645..7a529666 100644 --- a/lib/evaluator.tcl +++ b/lib/evaluator.tcl @@ -892,6 +892,7 @@ namespace eval Evaluator { } } static void LogWriteRecollect(statement_handle_t collectId); + static void LogWriteUnmatch(match_handle_t matchId); void reactToStatementAdditionThatMatchesCollect(Tcl_Interp* interp, statement_handle_t collectId, Tcl_Obj* collectPattern, @@ -1017,8 +1018,7 @@ namespace eval Evaluator { match_handle_t matchId = edge->match; if (!matchExists(matchId)) continue; // if was removed earlier - reactToMatchRemoval(interp, matchId); - matchRemove(matchId); + LogWriteUnmatch(matchId); } } } @@ -1110,8 +1110,7 @@ namespace eval Evaluator { if (edge->type == CHILD && !matchHandleIsEqual(edge->match, matchId)) { match_handle_t childMatchId = edge->match; matchGet(childMatchId)->recollectOnDestruction = false; - reactToMatchRemoval(interp, childMatchId); - matchRemove(childMatchId); + LogWriteUnmatch(childMatchId); break; } } @@ -1120,7 +1119,7 @@ namespace eval Evaluator { $cc code { typedef enum { - NONE, ASSERT, RETRACT, SAY, RECOLLECT + NONE, ASSERT, RETRACT, SAY, UNMATCH, RECOLLECT } log_entry_op_t; typedef struct log_entry_t { log_entry_op_t op; @@ -1131,6 +1130,7 @@ namespace eval Evaluator { match_handle_t parentMatchId; Tcl_Obj* clause; } say; + struct { match_handle_t matchId; } unmatch; struct { statement_handle_t collectId; } recollect; }; } log_entry_t; @@ -1146,6 +1146,7 @@ namespace eval Evaluator { evaluatorLogReadIndex = (evaluatorLogReadIndex + 1) % EVALUATOR_LOG_CAPACITY; if (entry.op == ASSERT) { + /* printf("Assert (%s)\n", Tcl_GetString(entry.assert.clause)); */ statement_handle_t id; bool isNewStatement; addImpl(interp, entry.assert.clause, 0, NULL, &id, &isNewStatement); @@ -1155,6 +1156,7 @@ namespace eval Evaluator { Tcl_DecrRefCount(entry.assert.clause); } else if (entry.op == RETRACT) { + /* printf("Retract (%s)\n", Tcl_GetString(entry.retract.pattern)); */ environment_t* results[1000]; int resultsCount = searchByPattern(entry.retract.pattern, 1000, results); @@ -1167,6 +1169,7 @@ namespace eval Evaluator { Tcl_DecrRefCount(entry.retract.pattern); } else if (entry.op == SAY) { + /* printf("Say (%s)\n", Tcl_GetString(entry.say.clause)); */ if (matchExists(entry.say.parentMatchId)) { statement_handle_t id; bool isNewStatement; addImpl(interp, entry.say.clause, 1, &entry.say.parentMatchId, @@ -1177,7 +1180,15 @@ namespace eval Evaluator { } Tcl_DecrRefCount(entry.say.clause); + } else if (entry.op == UNMATCH) { + /* printf("Unmatch (m%d:%d)\n", entry.unmatch.matchId.idx, entry.unmatch.matchId.gen); */ + if (matchExists(entry.unmatch.matchId)) { + reactToMatchRemoval(interp, entry.unmatch.matchId); + matchRemove(entry.unmatch.matchId); + } + } else if (entry.op == RECOLLECT) { + /* printf("Recollect (s%d:%d)\n", entry.recollect.collectId.idx, entry.recollect.collectId.gen); */ if (exists(entry.recollect.collectId)) { recollect(interp, entry.recollect.collectId); } @@ -1208,6 +1219,9 @@ namespace eval Evaluator { Tcl_IncrRefCount(clause); LogWriteFront((log_entry_t) { .op = SAY, .say = {.parentMatchId=parentMatchId, .clause=clause} }); } + $cc proc LogWriteUnmatch {match_handle_t matchId} void { + LogWriteBack((log_entry_t) { .op = UNMATCH, .unmatch = {.matchId=matchId} }); + } $cc proc LogWriteRecollect {statement_handle_t collectId} void { LogWriteBack((log_entry_t) { .op = RECOLLECT, .recollect = {.collectId=collectId} }); } -- cgit v1.2.3 From cf16ae229066352c3194e8b225bdf9b996a40738 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 14 Aug 2023 22:56:16 -0400 Subject: Try to fix collect incremental --- lib/evaluator.tcl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/evaluator.tcl b/lib/evaluator.tcl index 7a529666..02d87faa 100644 --- a/lib/evaluator.tcl +++ b/lib/evaluator.tcl @@ -1141,6 +1141,7 @@ namespace eval Evaluator { int evaluatorLogWriteIndex = 0; } $cc proc Evaluate {Tcl_Interp* interp} void { + /* printf("Evaluate==========\n"); */ while (evaluatorLogReadIndex != evaluatorLogWriteIndex) { log_entry_t entry = evaluatorLog[evaluatorLogReadIndex]; evaluatorLogReadIndex = (evaluatorLogReadIndex + 1) % EVALUATOR_LOG_CAPACITY; @@ -1223,7 +1224,7 @@ namespace eval Evaluator { LogWriteBack((log_entry_t) { .op = UNMATCH, .unmatch = {.matchId=matchId} }); } $cc proc LogWriteRecollect {statement_handle_t collectId} void { - LogWriteBack((log_entry_t) { .op = RECOLLECT, .recollect = {.collectId=collectId} }); + LogWriteFront((log_entry_t) { .op = RECOLLECT, .recollect = {.collectId=collectId} }); } $cc proc LogIsEmpty {} bool { return evaluatorLogReadIndex == evaluatorLogWriteIndex; -- cgit v1.2.3 From f42902b4cf694a4ec3f4f345699384ab53e32ece Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Tue, 15 Aug 2023 17:14:19 -0400 Subject: WIP: Rewrite peering to use shm instead of websockets Huge performance increases, but crashy. --- lib/peer.tcl | 65 +++++++++++---------------------------------------------- lib/process.tcl | 13 +++++++----- 2 files changed, 20 insertions(+), 58 deletions(-) (limited to 'lib') diff --git a/lib/peer.tcl b/lib/peer.tcl index 274f9f07..0a1aef0d 100644 --- a/lib/peer.tcl +++ b/lib/peer.tcl @@ -25,72 +25,31 @@ namespace eval ::Peers {} set ::peersBlacklist [dict create] proc ::peer {process {dieOnDisconnect false}} { - package require websocket namespace eval ::Peers::$process { - variable connected false + variable connected true proc log {s} { variable process puts "$::thisProcess -> $process: $s" } - proc setupSock {} { - variable process - log "Trying to connect to: ws://$process:4273/ws" - variable chan [::websocket::open "ws://$process:4273/ws" [namespace code handleWs]] - } - proc handleWs {chan type msg} { - if {$type eq "connect"} { - log "Connected" - variable connected true - - # Establish a peering on their end, in the reverse - # direction, so they can send stuff back to us. - # It'll implicitly run in a ::Peers::X namespace on their end - # (because of how `run` is implemented below) - run { - set name [namespace tail [namespace current]] - variable chan [uplevel {set chan}] - - # First, check if this side has us blacklisted. - if {[dict exists $::peersBlacklist $name]} { - ::websocket::close $chan - return - } - - variable connected true - proc run {msg} { - variable chan - ::websocket::send $chan text $msg - } - } - } elseif {$type eq "disconnect"} { - log "Disconnected" - variable dieOnDisconnect - if {$dieOnDisconnect} { exit 0 } + # TODO: Handle die on disconnect (?) - variable connected false - after 2000 [namespace code setupSock] - } elseif {$type eq "error"} { - log "WebSocket error: $type $msg" - after 2000 [namespace code setupSock] - } elseif {$type eq "text"} { - eval $msg - } elseif {$type eq "ping" || $type eq "pong"} { - } else { - error "Unknown WebSocket event: $type $msg" - } + proc share {statements} { + variable process + Mailbox::share $::thisProcess $process $statements } - - proc run {msg} { - variable chan - ::websocket::send $chan text [list namespace eval ::Peers::$::thisProcess $msg] + proc receive {} { + variable process + Mailbox::receive $process $::thisProcess } proc init {n shouldDieOnDisconnect} { - variable process $n; setupSock + variable process $n variable dieOnDisconnect $shouldDieOnDisconnect - vwait ::Peers::${n}::connected + + Mailbox::create $::thisProcess $process + Mailbox::create $process $::thisProcess } init } $process $dieOnDisconnect diff --git a/lib/process.tcl b/lib/process.tcl index a4b8ed48..059c0b89 100644 --- a/lib/process.tcl +++ b/lib/process.tcl @@ -58,19 +58,22 @@ namespace eval ::Zygote { proc On-process {name body} { set this [uplevel {expr {[info exists this] ? $this : ""}}] - set processCode [list apply {{__name __body} { + set processCode [list apply {{__parentProcess __name __body} { set ::thisProcess $__name Assert wishes $::thisProcess shares all wishes Assert wishes $::thisProcess shares all claims - ::peer "localhost" true + ::peer $__parentProcess true Assert claims $::thisProcess has pid [pid] Assert when $::thisProcess has pid /something/ [list {} $__body] - Step - vwait forever - }} $name $body] + while true { + Step + } + }} $::thisProcess $name $body] + + ::peer $name false Zygote::spawn [list apply {{processCode} { # A supervisor that wraps the subprocess. -- cgit v1.2.3 From b1c0ef9a2f5e412cda8a21b1efc1930101b088a0 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Wed, 16 Aug 2023 09:50:32 -0400 Subject: Increase log size + some unmatch hacking --- lib/evaluator.tcl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/evaluator.tcl b/lib/evaluator.tcl index 02d87faa..73c6a353 100644 --- a/lib/evaluator.tcl +++ b/lib/evaluator.tcl @@ -1031,6 +1031,7 @@ namespace eval Evaluator { if (unmatch->edges[j].type == PARENT) { statement_handle_t unmatchWhenId = unmatch->edges[j].statement; statement_t* unmatchWhen = get(unmatchWhenId); + if (unmatchWhen == NULL) continue; for (int k = 0; k < unmatchWhen->n_edges; k++) { if (unmatchWhen->edges[k].type == PARENT) { unmatchId = unmatchWhen->edges[k].match; @@ -1135,7 +1136,7 @@ namespace eval Evaluator { }; } log_entry_t; - log_entry_t evaluatorLog[1024] = {0}; + log_entry_t evaluatorLog[4096] = {0}; #define EVALUATOR_LOG_CAPACITY (sizeof(evaluatorLog)/sizeof(evaluatorLog[1])) int evaluatorLogReadIndex = EVALUATOR_LOG_CAPACITY - 1; int evaluatorLogWriteIndex = 0; -- cgit v1.2.3