From b378806f5ea9f6eac389cf8bd81a5f06ff2db12b Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 4 Sep 2023 20:45:45 -0400 Subject: Operation log for perf testing --- lib/evaluator.tcl | 38 ++++++++++++++++++++++++++++++++------ 1 file changed, 32 insertions(+), 6 deletions(-) (limited to 'lib') diff --git a/lib/evaluator.tcl b/lib/evaluator.tcl index 73c6a353..5f958d84 100644 --- a/lib/evaluator.tcl +++ b/lib/evaluator.tcl @@ -780,6 +780,28 @@ namespace eval Evaluator { variable cc $::statement::cc namespace import ::statement::$cc + $cc code { + #include + char operationLog[10000][1000]; + int operationLogIdx = 0; + void op(const char *format, ...) { + if (operationLogIdx >= 10000) return; + + va_list args; + va_start(args, format); + vsnprintf(operationLog[operationLogIdx++], 1000, format, args); + va_end(args); + } + } + $cc proc getOperationLog {} Tcl_Obj* { + Tcl_Obj* entries[10000]; + int i; + for (i = 0; i < 10000 && operationLog[i][0] != '\0'; i++) { + entries[i] = Tcl_NewStringObj(operationLog[i], -1); + } + return Tcl_NewListObj(i, entries); + } + $cc code { // Given a StatementPattern, tells you all the reactions to run // when a matching statement is added to / removed from the @@ -1142,13 +1164,14 @@ namespace eval Evaluator { int evaluatorLogWriteIndex = 0; } $cc proc Evaluate {Tcl_Interp* interp} void { - /* printf("Evaluate==========\n"); */ + op("Evaluate\n"); + while (evaluatorLogReadIndex != evaluatorLogWriteIndex) { log_entry_t entry = evaluatorLog[evaluatorLogReadIndex]; evaluatorLogReadIndex = (evaluatorLogReadIndex + 1) % EVALUATOR_LOG_CAPACITY; if (entry.op == ASSERT) { - /* printf("Assert (%s)\n", Tcl_GetString(entry.assert.clause)); */ + op("Assert (%s)\n", Tcl_GetString(entry.assert.clause)); statement_handle_t id; bool isNewStatement; addImpl(interp, entry.assert.clause, 0, NULL, &id, &isNewStatement); @@ -1158,7 +1181,7 @@ namespace eval Evaluator { Tcl_DecrRefCount(entry.assert.clause); } else if (entry.op == RETRACT) { - /* printf("Retract (%s)\n", Tcl_GetString(entry.retract.pattern)); */ + op("Retract (%s)\n", Tcl_GetString(entry.retract.pattern)); environment_t* results[1000]; int resultsCount = searchByPattern(entry.retract.pattern, 1000, results); @@ -1171,7 +1194,7 @@ namespace eval Evaluator { Tcl_DecrRefCount(entry.retract.pattern); } else if (entry.op == SAY) { - /* printf("Say (%s)\n", Tcl_GetString(entry.say.clause)); */ + op("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, @@ -1183,16 +1206,19 @@ 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); */ + op("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)) { + op("Recollect (s%d:%d) (%s)\n", entry.recollect.collectId.idx, entry.recollect.collectId.gen, Tcl_GetString(get(entry.recollect.collectId)->clause)); recollect(interp, entry.recollect.collectId); + } else { + op("Recollect (s%d:%d) (DEAD)\n", entry.recollect.collectId.idx, entry.recollect.collectId.gen); } } } -- cgit v1.2.3 From 9ebac6f7ca740f916abd9ca457fe4dca55016417 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Wed, 6 Sep 2023 05:44:09 -0400 Subject: WIP: Start work on pqueue-based evaluator Need to fix ordering of entries with same priority. --- lib/evaluator.tcl | 94 ++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 59 insertions(+), 35 deletions(-) (limited to 'lib') diff --git a/lib/evaluator.tcl b/lib/evaluator.tcl index 5f958d84..ceae108f 100644 --- a/lib/evaluator.tcl +++ b/lib/evaluator.tcl @@ -789,6 +789,7 @@ namespace eval Evaluator { va_list args; va_start(args, format); + // vprintf(format, args); printf("\n"); vsnprintf(operationLog[operationLogIdx++], 1000, format, args); va_end(args); } @@ -1140,12 +1141,14 @@ namespace eval Evaluator { } } + $cc cflags -I./vendor/libpqueue vendor/libpqueue/pqueue.c + $cc include "pqueue.h" $cc code { typedef enum { NONE, ASSERT, RETRACT, SAY, UNMATCH, RECOLLECT - } log_entry_op_t; - typedef struct log_entry_t { - log_entry_op_t op; + } queue_op_t; + typedef struct queue_entry_t { + queue_op_t op; union { struct { Tcl_Obj* clause; } assert; struct { Tcl_Obj* pattern; } retract; @@ -1156,22 +1159,47 @@ namespace eval Evaluator { struct { match_handle_t matchId; } unmatch; struct { statement_handle_t collectId; } recollect; }; - } log_entry_t; + } queue_entry_t; - log_entry_t evaluatorLog[4096] = {0}; - #define EVALUATOR_LOG_CAPACITY (sizeof(evaluatorLog)/sizeof(evaluatorLog[1])) - int evaluatorLogReadIndex = EVALUATOR_LOG_CAPACITY - 1; - int evaluatorLogWriteIndex = 0; + pqueue_t* queue; + + int queueEntryCompare(pqueue_pri_t next, pqueue_pri_t curr) { + return next < curr; + } + pqueue_pri_t queueEntryGetPriority(void* a) { + switch (((queue_entry_t *)a)->op) { + case NONE: return 0; + + case ASSERT: + case RETRACT: return 999; + + case SAY: return 999; + + case UNMATCH: return 1; + case RECOLLECT: return 0; + } + return 0; + } + void queueEntrySetPriority(void* a, pqueue_pri_t pri) {} + size_t queueEntryGetPosition(void* a) { return 0; } + void queueEntrySetPosition(void* a, size_t pos) {} + } + $cc proc init {} void { + queue = pqueue_init(16384, + queueEntryCompare, + queueEntryGetPriority, + queueEntrySetPriority, + queueEntryGetPosition, + queueEntrySetPosition); } $cc proc Evaluate {Tcl_Interp* interp} void { - op("Evaluate\n"); - - while (evaluatorLogReadIndex != evaluatorLogWriteIndex) { - log_entry_t entry = evaluatorLog[evaluatorLogReadIndex]; - evaluatorLogReadIndex = (evaluatorLogReadIndex + 1) % EVALUATOR_LOG_CAPACITY; + op("Evaluate"); + queue_entry_t* entryPtr; + while ((entryPtr = pqueue_pop(queue)) != NULL) { + queue_entry_t entry = *entryPtr; ckfree(entryPtr); if (entry.op == ASSERT) { - op("Assert (%s)\n", Tcl_GetString(entry.assert.clause)); + op("Assert (%s)", Tcl_GetString(entry.assert.clause)); statement_handle_t id; bool isNewStatement; addImpl(interp, entry.assert.clause, 0, NULL, &id, &isNewStatement); @@ -1181,7 +1209,7 @@ namespace eval Evaluator { Tcl_DecrRefCount(entry.assert.clause); } else if (entry.op == RETRACT) { - op("Retract (%s)\n", Tcl_GetString(entry.retract.pattern)); + op("Retract (%s)", Tcl_GetString(entry.retract.pattern)); environment_t* results[1000]; int resultsCount = searchByPattern(entry.retract.pattern, 1000, results); @@ -1194,7 +1222,7 @@ namespace eval Evaluator { Tcl_DecrRefCount(entry.retract.pattern); } else if (entry.op == SAY) { - op("Say (%s)\n", Tcl_GetString(entry.say.clause)); + op("Say (%s)", 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, @@ -1206,58 +1234,54 @@ namespace eval Evaluator { Tcl_DecrRefCount(entry.say.clause); } else if (entry.op == UNMATCH) { - op("Unmatch (m%d:%d)\n", entry.unmatch.matchId.idx, entry.unmatch.matchId.gen); + op("Unmatch (m%d:%d)", 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) { - if (exists(entry.recollect.collectId)) { - op("Recollect (s%d:%d) (%s)\n", entry.recollect.collectId.idx, entry.recollect.collectId.gen, Tcl_GetString(get(entry.recollect.collectId)->clause)); + op("Recollect (s%d:%d) (%s)", entry.recollect.collectId.idx, entry.recollect.collectId.gen, Tcl_GetString(get(entry.recollect.collectId)->clause)); recollect(interp, entry.recollect.collectId); } else { - op("Recollect (s%d:%d) (DEAD)\n", entry.recollect.collectId.idx, entry.recollect.collectId.gen); + op("Recollect (s%d:%d) (DEAD)", entry.recollect.collectId.idx, entry.recollect.collectId.gen); } } } } $cc code { - void LogWriteFront(log_entry_t entry) { - if ((evaluatorLogReadIndex - 1) % EVALUATOR_LOG_CAPACITY == evaluatorLogWriteIndex) { exit(100); } - evaluatorLogReadIndex = (evaluatorLogReadIndex - 1) % EVALUATOR_LOG_CAPACITY; - evaluatorLog[evaluatorLogReadIndex] = entry; - } - void LogWriteBack(log_entry_t entry) { - if ((evaluatorLogWriteIndex + 1) % EVALUATOR_LOG_CAPACITY == evaluatorLogReadIndex) { exit(100); } - evaluatorLog[evaluatorLogWriteIndex] = entry; - evaluatorLogWriteIndex = (evaluatorLogWriteIndex + 1) % EVALUATOR_LOG_CAPACITY; + void queueInsert(queue_entry_t entry) { + queue_entry_t* ptr = ckalloc(sizeof(entry)); + *ptr = entry; + pqueue_insert(queue, ptr); } } $cc proc LogWriteAssert {Tcl_Obj* clause} void { Tcl_IncrRefCount(clause); - LogWriteBack((log_entry_t) { .op = ASSERT, .assert = {.clause=clause} }); + queueInsert((queue_entry_t) { .op = ASSERT, .assert = {.clause=clause} }); } $cc proc LogWriteRetract {Tcl_Obj* pattern} void { Tcl_IncrRefCount(pattern); - LogWriteBack((log_entry_t) { .op = RETRACT, .retract = {.pattern=pattern} }); + queueInsert((queue_entry_t) { .op = RETRACT, .retract = {.pattern=pattern} }); } $cc proc LogWriteSay {match_handle_t parentMatchId Tcl_Obj* clause} void { Tcl_IncrRefCount(clause); - LogWriteFront((log_entry_t) { .op = SAY, .say = {.parentMatchId=parentMatchId, .clause=clause} }); + queueInsert((queue_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} }); + // TODO: These should probably precede a recollect. + queueInsert((queue_entry_t) { .op = UNMATCH, .unmatch = {.matchId=matchId} }); } $cc proc LogWriteRecollect {statement_handle_t collectId} void { - LogWriteFront((log_entry_t) { .op = RECOLLECT, .recollect = {.collectId=collectId} }); + queueInsert((queue_entry_t) { .op = RECOLLECT, .recollect = {.collectId=collectId} }); } $cc proc LogIsEmpty {} bool { - return evaluatorLogReadIndex == evaluatorLogWriteIndex; + return pqueue_peek(queue) == NULL; } $cc compile + init } namespace eval Statements { -- cgit v1.2.3 From b4d9326bd339e28a4ffa2252eacc81f6824fd09e Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Wed, 6 Sep 2023 05:59:55 -0400 Subject: Finish pqueue usage -- performs ok (300 operations/frame) --- lib/evaluator.tcl | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) (limited to 'lib') diff --git a/lib/evaluator.tcl b/lib/evaluator.tcl index ceae108f..329e14c5 100644 --- a/lib/evaluator.tcl +++ b/lib/evaluator.tcl @@ -1149,6 +1149,8 @@ namespace eval Evaluator { } queue_op_t; typedef struct queue_entry_t { queue_op_t op; + int seq; + union { struct { Tcl_Obj* clause; } assert; struct { Tcl_Obj* pattern; } retract; @@ -1162,21 +1164,22 @@ namespace eval Evaluator { } queue_entry_t; pqueue_t* queue; + int seq; int queueEntryCompare(pqueue_pri_t next, pqueue_pri_t curr) { return next < curr; } pqueue_pri_t queueEntryGetPriority(void* a) { - switch (((queue_entry_t *)a)->op) { + queue_entry_t* entry = a; + switch (entry->op) { case NONE: return 0; case ASSERT: - case RETRACT: return 999; - - case SAY: return 999; + case RETRACT: return 80000 - entry->seq; + case SAY: return 80000 + entry->seq; - case UNMATCH: return 1; - case RECOLLECT: return 0; + case UNMATCH: return 5000 - entry->seq; + case RECOLLECT: return 1000 - entry->seq; } return 0; } @@ -1195,6 +1198,8 @@ namespace eval Evaluator { $cc proc Evaluate {Tcl_Interp* interp} void { op("Evaluate"); + seq = 0; + queue_entry_t* entryPtr; while ((entryPtr = pqueue_pop(queue)) != NULL) { queue_entry_t entry = *entryPtr; ckfree(entryPtr); @@ -1254,6 +1259,7 @@ namespace eval Evaluator { void queueInsert(queue_entry_t entry) { queue_entry_t* ptr = ckalloc(sizeof(entry)); *ptr = entry; + ptr->seq = seq++; pqueue_insert(queue, ptr); } } -- cgit v1.2.3 From 0f0bf7133437277dd80205682d2cff21009eb19f Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Thu, 14 Sep 2023 00:11:59 -0400 Subject: Make metrics non-reactive + put recollect before unmatch We'll take the interim states for now to avoid having to recreate all tags. --- lib/evaluator.tcl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lib') diff --git a/lib/evaluator.tcl b/lib/evaluator.tcl index 329e14c5..380486ca 100644 --- a/lib/evaluator.tcl +++ b/lib/evaluator.tcl @@ -1178,8 +1178,8 @@ namespace eval Evaluator { case RETRACT: return 80000 - entry->seq; case SAY: return 80000 + entry->seq; - case UNMATCH: return 5000 - entry->seq; - case RECOLLECT: return 1000 - entry->seq; + case UNMATCH: return 1000 - entry->seq; + case RECOLLECT: return 5000 - entry->seq; } return 0; } -- cgit v1.2.3 From 74070a489a57c3747223ca74d8be828d5f23414c Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Wed, 20 Sep 2023 09:37:38 -0400 Subject: evaluator: Dedupe recollects --- lib/evaluator.tcl | 56 +++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 38 insertions(+), 18 deletions(-) (limited to 'lib') diff --git a/lib/evaluator.tcl b/lib/evaluator.tcl index 380486ca..f15c2445 100644 --- a/lib/evaluator.tcl +++ b/lib/evaluator.tcl @@ -59,8 +59,8 @@ namespace eval statement { int32_t gen; bool alive; - bool recollectOnDestruction; - statement_handle_t recollectCollectId; + bool isFromCollect; + statement_handle_t collectId; match_destructor_t destructors[8]; @@ -77,6 +77,7 @@ namespace eval statement { int32_t gen; Tcl_Obj* clause; + bool collectNeedsRecollect; // Dirty flag size_t capacity_edges; size_t n_edges; // This is an estimate. @@ -267,7 +268,7 @@ namespace eval Statements { ;# singleton Statement store } matches[nextMatchIdx].capacity_edges = 16; matches[nextMatchIdx].edges = (edge_to_statement_t*)ckalloc(16 * sizeof(edge_to_statement_t)); - matches[nextMatchIdx].recollectOnDestruction = false; + matches[nextMatchIdx].isFromCollect = false; matches[nextMatchIdx].alive = true; return (match_handle_t) { .idx = nextMatchIdx, @@ -304,9 +305,6 @@ namespace eval Statements { ;# singleton Statement store match->destructors[i].env = NULL; } } - if (match->recollectOnDestruction) { - LogWriteRecollect(match->recollectCollectId); - } match->alive = false; match->gen++; match->n_edges = 0; @@ -920,6 +918,7 @@ namespace eval Evaluator { statement_handle_t collectId, Tcl_Obj* collectPattern, statement_handle_t statementId) { + get(collectId)->collectNeedsRecollect = true; LogWriteRecollect(collectId); } } @@ -950,6 +949,7 @@ namespace eval Evaluator { addReaction(claimizePattern(subpattern), id, reactToStatementAdditionThatMatchesCollect); } + get(id)->collectNeedsRecollect = true; LogWriteRecollect(id); } else if (strcmp(Tcl_GetString(clauseWords[0]), "when") == 0) { @@ -1041,7 +1041,21 @@ namespace eval Evaluator { match_handle_t matchId = edge->match; if (!matchExists(matchId)) continue; // if was removed earlier - LogWriteUnmatch(matchId); + // Test if this child-match is a Collect-match (and + // the statement being removed is _not_ its collector) + match_t* match = matchGet(matchId); + if (match->isFromCollect && !statementHandleIsEqual(match->collectId, id)) { + // If so, then it should be marked as dirty and + // recollected later, rather than it and its + // transitive dependents immediately getting + // yanked out. + get(match->collectId)->collectNeedsRecollect = true; + LogWriteRecollect(match->collectId); + } else { + reactToMatchRemoval(interp, matchId); + matchRemove(matchId); + // LogWriteUnmatch(matchId); + } } } } @@ -1078,6 +1092,8 @@ namespace eval Evaluator { // collecting has been added or removed. statement_t* collect = get(collectId); + if (!collect->collectNeedsRecollect) { return; } + collect->collectNeedsRecollect = false; Tcl_Obj* clause = collect->clause; int clauseLength; Tcl_Obj** clauseWords; @@ -1117,8 +1133,8 @@ namespace eval Evaluator { // Create a new match for the new collection. match_handle_t matchId = addMatchImpl(parentsCount, parents); match_t* match = matchGet(matchId); - match->recollectOnDestruction = true; - match->recollectCollectId = collectId; + match->isFromCollect = true; + match->collectId = collectId; // Run the When body within this new match. env = Tcl_DuplicateObj(env); @@ -1128,15 +1144,19 @@ namespace eval Evaluator { // Finally, delete the old match child if any. // (We do this last, _after_ adding the new match, because it helps with incrementality.) - { - for (size_t i = 0; i < collect->n_edges; i++) { - edge_to_match_t* edge = statementEdgeAt(collect, i); - if (edge->type == CHILD && !matchHandleIsEqual(edge->match, matchId)) { - match_handle_t childMatchId = edge->match; - matchGet(childMatchId)->recollectOnDestruction = false; - LogWriteUnmatch(childMatchId); - break; - } + for (size_t i = 0; i < collect->n_edges; i++) { + edge_to_match_t* edge = statementEdgeAt(collect, i); + if (edge->type == CHILD && !matchHandleIsEqual(edge->match, matchId)) { + match_handle_t childMatchId = edge->match; + // We don't want to fire a new recollect on + // destruction. (because we just fired one) + matchGet(childMatchId)->isFromCollect = false; + + // This Unmatch has to be trampolined back up to + // the operation log so it happens after Saying + // any new statements. + LogWriteUnmatch(childMatchId); + break; } } } -- cgit v1.2.3 From 13b3194b976c18a6aa071fbdd4ce18026711a693 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Thu, 21 Sep 2023 14:29:37 -0400 Subject: evaluator: Defend against null reference to collect --- lib/evaluator.tcl | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lib') diff --git a/lib/evaluator.tcl b/lib/evaluator.tcl index f15c2445..edfee377 100644 --- a/lib/evaluator.tcl +++ b/lib/evaluator.tcl @@ -1049,8 +1049,10 @@ namespace eval Evaluator { // recollected later, rather than it and its // transitive dependents immediately getting // yanked out. - get(match->collectId)->collectNeedsRecollect = true; - LogWriteRecollect(match->collectId); + if (exists(match->collectId)) { + get(match->collectId)->collectNeedsRecollect = true; + LogWriteRecollect(match->collectId); + } } else { reactToMatchRemoval(interp, matchId); matchRemove(matchId); -- cgit v1.2.3 From a37789e443218f1b0307d61b8bcf434428fdca83 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Thu, 21 Sep 2023 15:47:22 -0400 Subject: Hack: Avoid infinite loop if we deplete matches (but why are we depleting matches?) TODO: Dump on this abort? --- lib/evaluator.tcl | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lib') diff --git a/lib/evaluator.tcl b/lib/evaluator.tcl index edfee377..1678220b 100644 --- a/lib/evaluator.tcl +++ b/lib/evaluator.tcl @@ -263,8 +263,12 @@ namespace eval Statements { ;# singleton Statement store return statementClauseToId; } $cc proc matchNew {} match_handle_t { + uint16_t origNextMatchIdx = nextMatchIdx; while (matches[nextMatchIdx].alive) { nextMatchIdx = (nextMatchIdx + 1) % (sizeof(matches)/sizeof(matches[0])); + if (nextMatchIdx == origNextMatchIdx) { + fprintf(stderr, "Ran out of space for new match\n"); exit(1); + } } matches[nextMatchIdx].capacity_edges = 16; matches[nextMatchIdx].edges = (edge_to_statement_t*)ckalloc(16 * sizeof(edge_to_statement_t)); -- cgit v1.2.3 From 961788513bfaad8f6fa4a391d6e7646f506d6741 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 22 Sep 2023 02:19:57 -0400 Subject: evaluator: Handle case where collect is gone --- lib/evaluator.tcl | 3 +++ 1 file changed, 3 insertions(+) (limited to 'lib') diff --git a/lib/evaluator.tcl b/lib/evaluator.tcl index 1678220b..6f70c2a4 100644 --- a/lib/evaluator.tcl +++ b/lib/evaluator.tcl @@ -1056,6 +1056,9 @@ namespace eval Evaluator { if (exists(match->collectId)) { get(match->collectId)->collectNeedsRecollect = true; LogWriteRecollect(match->collectId); + } else { + reactToMatchRemoval(interp, matchId); + matchRemove(matchId); } } else { reactToMatchRemoval(interp, matchId); -- cgit v1.2.3