From 55f9cd4cc30e4fe157419315945d083184ecb871 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 11 Aug 2023 19:47:04 -0400 Subject: Measure display fps --- lib/language.tcl | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lib') diff --git a/lib/language.tcl b/lib/language.tcl index b265b5a6..2b9fbc01 100644 --- a/lib/language.tcl +++ b/lib/language.tcl @@ -70,6 +70,8 @@ proc assert condition { } } +proc baretime body { string map {" microseconds per iteration" ""} [uplevel [list time $body]] } + # forever { ... } is sort of like while true { ... }, but it yields to # the event loop after each iteration. proc forever {body} { -- cgit v1.2.3 From d31bb78a7d6c2b49aaaf280266412465915eb06b Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Sat, 12 Aug 2023 18:10:19 -0400 Subject: Don't use value == 0 in trie, so 0:0 can actually match Keep a separate hasValue flag instead. Fixes #63 (previously, you could never remove statement 0:0 because you could never get that as a trie query result because value == 0 was invalid) --- lib/trie.tcl | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'lib') diff --git a/lib/trie.tcl b/lib/trie.tcl index 467631b7..dc89dc3d 100644 --- a/lib/trie.tcl +++ b/lib/trie.tcl @@ -33,8 +33,8 @@ namespace eval ctrie { // We generally store a pointer (for example, to a // reaction thunk) or a generational handle (for example, - // for a statement) in this 64-bit value slot. Only used - // in leaf nodes of the trie. + // for a statement) in this 64-bit value slot. + bool hasValue; uint64_t value; size_t nbranches; @@ -47,6 +47,7 @@ namespace eval ctrie { trie_t* ret = (trie_t *) ckalloc(size); memset(ret, 0, size); *ret = (trie_t) { .key = NULL, + .hasValue = false, .value = 0, .nbranches = 10 }; @@ -83,6 +84,7 @@ namespace eval ctrie { $cc proc addImpl {trie_t** trie int wordc Tcl_Obj** wordv uint64_t value} void { if (wordc == 0) { (*trie)->value = value; + (*trie)->hasValue = true; return; } @@ -116,6 +118,7 @@ namespace eval ctrie { branch->key = word; Tcl_IncrRefCount(branch->key); branch->value = 0; + branch->hasValue = false; branch->nbranches = 10; (*trie)->branches[j] = branch; @@ -178,7 +181,7 @@ namespace eval ctrie { uint64_t* results int* resultsidx size_t maxresults trie_t* trie int wordc Tcl_Obj** wordv} void { if (wordc == 0) { - if (trie->value != 0) { + if (trie->hasValue) { if (*resultsidx < maxresults) { results[(*resultsidx)++] = trie->value; } -- cgit v1.2.3 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 From 43cd75eff9be56a6ca4e6286b9031ed4670be391 Mon Sep 17 00:00:00 2001 From: Charles Chamberlain Date: Wed, 16 Aug 2023 14:45:33 -0400 Subject: Add bottomright, topleft, region functions etc --- lib/math.tcl | 12 ++++++++++++ 1 file changed, 12 insertions(+) (limited to 'lib') diff --git a/lib/math.tcl b/lib/math.tcl index 9fc6839a..f688a465 100644 --- a/lib/math.tcl +++ b/lib/math.tcl @@ -139,6 +139,18 @@ namespace eval ::region { set bottomEdgeIndex [lindex [lsort -indices -real -index 1 $edgeMidpoints] end] vec2 midpoint {*}[edgeToLineSegment $r [lindex [edges $r] $bottomEdgeIndex]] } + proc bottomleft {r} { + lindex [vertices $r] 0 + } + proc bottomright {r} { + lindex [vertices $r] 1 + } + proc topright {r} { + lindex [vertices $r] 2 + } + proc topleft {r} { + lindex [vertices $r] 3 + } proc mapVertices {varname r body} { lreplace $r 0 0 [uplevel [list lmap $varname [vertices $r] $body]] -- cgit v1.2.3 From e0cc89c5fc5f2423ba87a69b900b939eb06c8c66 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Wed, 16 Aug 2023 18:10:46 -0400 Subject: Fix region move distance bug --- lib/math.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/math.tcl b/lib/math.tcl index f688a465..23efc57b 100644 --- a/lib/math.tcl +++ b/lib/math.tcl @@ -274,7 +274,7 @@ namespace eval ::region { error "region move: Invalid distance $distance" } if {$unit eq "%"} { - set distance [* distance 0.01] + set distance [* $distance 0.01] set unit "" } if {$unit eq ""} { -- cgit v1.2.3 From 18a9be88eea6ee48232ab89f1ef7b12c5e0f817b Mon Sep 17 00:00:00 2001 From: Zach Potter Date: Mon, 21 Aug 2023 21:10:40 -0700 Subject: Move virtual terminal to lib/terminal.tcl --- lib/terminal.tcl | 179 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 179 insertions(+) create mode 100644 lib/terminal.tcl (limited to 'lib') diff --git a/lib/terminal.tcl b/lib/terminal.tcl new file mode 100644 index 00000000..cd27eea5 --- /dev/null +++ b/lib/terminal.tcl @@ -0,0 +1,179 @@ +# terminal.tcl -- +# +# Implements a virtual terminal with basic read/write procs. +# + +set cc [c create] +$cc cflags -I./vendor/libtmt ./vendor/libtmt/tmt.c + +# TODO: find the right libutil.so for the system +c loadlib /lib/aarch64-linux-gnu/libutil.so +$cc cflags -lutil + +$cc include +$cc include +$cc include +$cc include +$cc include +$cc include +$cc include +$cc include ;# For gettimeofday() + +$cc code { + #include "tmt.h" + + #define SHELL "/bin/bash" + + #define ROWS 12 + #define COLS 43 + + typedef struct { + TMT *tmt; + pid_t pty_fd; + + char screen[ROWS][COLS + 1]; + int curs_r; + int curs_c; + } VTerminal; + + VTerminal *vt = NULL; + + #define PTYBUF 4096 + char iobuf[PTYBUF]; + + void tmt_callback(tmt_msg_t m, TMT *tmt, const void *a, void *p) { + const TMTSCREEN *s = tmt_screen(tmt); + + if (m == TMT_MSG_UPDATE) { + for (size_t r = 0; r < s->nline; r++){ + if (s->lines[r]->dirty){ + for (size_t c = 0; c < s->ncol; c++){ + vt->screen[r][c] = s->lines[r]->chars[c].c; + } + } + } + tmt_clean(tmt); + } + } + + void updateCursor() { + // Restore char under old cursor + const TMTSCREEN *s = tmt_screen(vt->tmt); + vt->screen[vt->curs_r][vt->curs_c] = s->lines[vt->curs_r]->chars[vt->curs_c].c; + + // Update new cursor + const TMTPOINT *c = tmt_cursor(vt->tmt); + vt->curs_r = c->r; + vt->curs_c = c->c; + + // Replace char with cursor every other second + struct timeval tv; + gettimeofday(&tv, NULL); + if (tv.tv_sec % 2 == 0) { + vt->screen[vt->curs_r][vt->curs_c] = 0xDB; // block char: █ + } + } +} + +$cc proc termCreate {} void { + if (vt != NULL) { + return; + } + + vt = malloc(sizeof(VTerminal)); + vt->curs_r = 0; + vt->curs_c = 0; + + for (int r = 0; r < ROWS - 1; r++) vt->screen[r][COLS] = '\n'; + vt->screen[ROWS - 1][COLS] = '\0'; + + vt->tmt = tmt_open(ROWS, COLS, tmt_callback, NULL, NULL); + + struct winsize ws = {.ws_row = ROWS, .ws_col = COLS}; + pid_t pid = forkpty(&vt->pty_fd, NULL, NULL, &ws); + if (pid < 0){ + return; + } else if (pid == 0){ + setenv("TERM", "ansi", 1); + execl(SHELL, SHELL, NULL); + return; + } + + fcntl(vt->pty_fd, F_SETFL, O_NONBLOCK); + return; +} + +$cc proc termRead {} char* { + ssize_t r = read(vt->pty_fd, iobuf, PTYBUF); + if (r > 0) { + tmt_write(vt->tmt, iobuf, r); + } + + updateCursor(vt); + return (char*)vt->screen; +} + +$cc proc termWrite {char* key} void { + write(vt->pty_fd, key, strlen(key)); +} + +$cc compile + +# Folk stuff... + +namespace eval Terminal { + # From `man console_codes` + variable keymap [dict create \ + ENTER "\x0d" \ + TAB "\x09" \ + BACKSPACE "\x08" \ + DELETE "\x7f" \ + ESC "\x1b" \ + UP "\x1b\[A" \ + DOWN "\x1b\[B" \ + RIGHT "\x1b\[C" \ + LEFT "\x1b\[D" \ + ] + + proc remap {key ctrlPressed} { + variable keymap + if {[string length $key] == 1} { + # Convert ctrl-A through ctrl-Z and others to terminal control characters + if {$ctrlPressed} { + set charCode [scan [string toupper $key] %c] + if {$charCode >= 64 && $charCode <= 95} { + set charCode [expr {$charCode - 64}] + return [format %c $charCode] + } + } + # All other single char keys can be passed through + return $key + } + if {[dict exists $keymap $key]} { + return [dict get $keymap $key] + } + return "" + } + + # Creates a new virtual terminal and returns its ID + proc create {} { + return [termCreate] + } + + proc destroy {} { + # TODO + } + + # Writes a keyboard key to the terminal, handling control codes + proc write {key ctrlPressed} { + set key [remap $key $ctrlPressed] + if {[string length $key] > 0} { + termWrite $key + } + } + + # Returns a newline separated string of terminal lines + proc read {} { + return [termRead] + } +} -- cgit v1.2.3 From 00fe52037991e4a3747791518bc4968247a2c079 Mon Sep 17 00:00:00 2001 From: Zach Potter Date: Mon, 21 Aug 2023 22:05:23 -0700 Subject: multiple terminal instances --- lib/terminal.tcl | 82 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 42 insertions(+), 40 deletions(-) (limited to 'lib') diff --git a/lib/terminal.tcl b/lib/terminal.tcl index cd27eea5..fc5f8b87 100644 --- a/lib/terminal.tcl +++ b/lib/terminal.tcl @@ -18,37 +18,38 @@ $cc include $cc include $cc include $cc include ;# For gettimeofday() +$cc include "tmt.h" -$cc code { - #include "tmt.h" +$cc struct VTerminal { + TMT* tmt; + int pty_fd; - #define SHELL "/bin/bash" + char* screen; + int curs_r; + int curs_c; +}; +$cc code { + #define SHELL "/bin/bash" #define ROWS 12 #define COLS 43 - - typedef struct { - TMT *tmt; - pid_t pty_fd; - - char screen[ROWS][COLS + 1]; - int curs_r; - int curs_c; - } VTerminal; - - VTerminal *vt = NULL; - #define PTYBUF 4096 char iobuf[PTYBUF]; + char* char_at(VTerminal *vt, int r, int c) { + int i = r * (COLS + 1) + c; + return &vt->screen[i]; + } + void tmt_callback(tmt_msg_t m, TMT *tmt, const void *a, void *p) { + VTerminal *vt = (VTerminal*)p; const TMTSCREEN *s = tmt_screen(tmt); if (m == TMT_MSG_UPDATE) { for (size_t r = 0; r < s->nline; r++){ if (s->lines[r]->dirty){ for (size_t c = 0; c < s->ncol; c++){ - vt->screen[r][c] = s->lines[r]->chars[c].c; + *char_at(vt, r, c) = s->lines[r]->chars[c].c; } } } @@ -56,10 +57,10 @@ $cc code { } } - void updateCursor() { + void updateCursor(VTerminal *vt) { // Restore char under old cursor const TMTSCREEN *s = tmt_screen(vt->tmt); - vt->screen[vt->curs_r][vt->curs_c] = s->lines[vt->curs_r]->chars[vt->curs_c].c; + *char_at(vt, vt->curs_r, vt->curs_c) = s->lines[vt->curs_r]->chars[vt->curs_c].c; // Update new cursor const TMTPOINT *c = tmt_cursor(vt->tmt); @@ -70,50 +71,51 @@ $cc code { struct timeval tv; gettimeofday(&tv, NULL); if (tv.tv_sec % 2 == 0) { - vt->screen[vt->curs_r][vt->curs_c] = 0xDB; // block char: █ + *char_at(vt, vt->curs_r, vt->curs_c) = 0xDB; // block char: █ } } } -$cc proc termCreate {} void { - if (vt != NULL) { - return; - } - - vt = malloc(sizeof(VTerminal)); +$cc proc termCreate {} VTerminal* { + VTerminal *vt = malloc(sizeof(VTerminal)); vt->curs_r = 0; vt->curs_c = 0; - for (int r = 0; r < ROWS - 1; r++) vt->screen[r][COLS] = '\n'; - vt->screen[ROWS - 1][COLS] = '\0'; + vt->screen = malloc(sizeof(char[ROWS][COLS + 1])); + for (int r = 0; r < ROWS - 1; r++) *char_at(vt, r, COLS) = '\n'; + *char_at(vt, ROWS - 1, COLS) = '\0'; - vt->tmt = tmt_open(ROWS, COLS, tmt_callback, NULL, NULL); + vt->tmt = tmt_open(ROWS, COLS, tmt_callback, vt, NULL); struct winsize ws = {.ws_row = ROWS, .ws_col = COLS}; pid_t pid = forkpty(&vt->pty_fd, NULL, NULL, &ws); if (pid < 0){ - return; + return NULL; } else if (pid == 0){ setenv("TERM", "ansi", 1); execl(SHELL, SHELL, NULL); - return; + return NULL; } fcntl(vt->pty_fd, F_SETFL, O_NONBLOCK); - return; + return vt; +} + +$cc proc termDestory {VTerminal* vt} void { + // TODO... } -$cc proc termRead {} char* { +$cc proc termRead {VTerminal* vt} char* { ssize_t r = read(vt->pty_fd, iobuf, PTYBUF); if (r > 0) { tmt_write(vt->tmt, iobuf, r); } updateCursor(vt); - return (char*)vt->screen; + return vt->screen; } -$cc proc termWrite {char* key} void { +$cc proc termWrite {VTerminal* vt char* key} void { write(vt->pty_fd, key, strlen(key)); } @@ -160,20 +162,20 @@ namespace eval Terminal { return [termCreate] } - proc destroy {} { - # TODO + proc destroy {term} { + termDestroy $term } # Writes a keyboard key to the terminal, handling control codes - proc write {key ctrlPressed} { + proc write {term key ctrlPressed} { set key [remap $key $ctrlPressed] if {[string length $key] > 0} { - termWrite $key + termWrite $term $key } } # Returns a newline separated string of terminal lines - proc read {} { - return [termRead] + proc read {term} { + return [termRead $term] } } -- cgit v1.2.3 From 7590f4424917e34c01caac722bd97ac28587bcbc Mon Sep 17 00:00:00 2001 From: Zach Potter Date: Thu, 24 Aug 2023 22:33:57 -0700 Subject: cleanup and todos --- lib/terminal.tcl | 144 ++++++++++++++++++++++++++----------------------------- 1 file changed, 67 insertions(+), 77 deletions(-) (limited to 'lib') diff --git a/lib/terminal.tcl b/lib/terminal.tcl index fc5f8b87..6276d149 100644 --- a/lib/terminal.tcl +++ b/lib/terminal.tcl @@ -3,27 +3,78 @@ # Implements a virtual terminal with basic read/write procs. # +namespace eval Terminal { + # From `man console_codes` + variable keymap [dict create \ + BACKSPACE "\x08" \ + TAB "\x09" \ + ENTER "\x0d" \ + DELETE "\x7f" \ + ESC "\x1b" \ + UP "\x1b\[A" \ + DOWN "\x1b\[B" \ + RIGHT "\x1b\[C" \ + LEFT "\x1b\[D" \ + ] + + proc _remap {key ctrlPressed} { + variable keymap + if {[string length $key] == 1} { + # Convert ctrl-A through ctrl-Z and others to terminal control characters + if {$ctrlPressed} { + set charCode [scan [string toupper $key] %c] + if {$charCode >= 64 && $charCode <= 95} { + set charCode [expr {$charCode - 64}] + return [format %c $charCode] + } + } + # All other single char keys can be passed through + return $key + } + if {[dict exists $keymap $key]} { + return [dict get $keymap $key] + } + return "" + } + + proc create {} { + return [termCreate] + } + + # Writes a keyboard key to the terminal, handling control codes + proc write {term key ctrlPressed} { + set key [_remap $key $ctrlPressed] + if {[string length $key] > 0} { + termWrite $term $key + } + } + + # Returns a newline separated string of terminal lines + proc read {term} { + return [termRead $term] + } +} + set cc [c create] $cc cflags -I./vendor/libtmt ./vendor/libtmt/tmt.c -# TODO: find the right libutil.so for the system -c loadlib /lib/aarch64-linux-gnu/libutil.so +c loadlib [lindex [exec /usr/sbin/ldconfig -p | grep libutil.so] end] $cc cflags -lutil $cc include -$cc include $cc include $cc include $cc include $cc include $cc include -$cc include ;# For gettimeofday() +$cc include $cc include "tmt.h" $cc struct VTerminal { TMT* tmt; int pty_fd; + // Note the screen has 1 more column than the terminal, for newlines char* screen; int curs_r; int curs_c; @@ -36,12 +87,12 @@ $cc code { #define PTYBUF 4096 char iobuf[PTYBUF]; - char* char_at(VTerminal *vt, int r, int c) { + char* charAt(VTerminal *vt, int r, int c) { int i = r * (COLS + 1) + c; return &vt->screen[i]; } - void tmt_callback(tmt_msg_t m, TMT *tmt, const void *a, void *p) { + void tmtEvent(tmt_msg_t m, TMT *tmt, const void *a, void *p) { VTerminal *vt = (VTerminal*)p; const TMTSCREEN *s = tmt_screen(tmt); @@ -49,7 +100,7 @@ $cc code { for (size_t r = 0; r < s->nline; r++){ if (s->lines[r]->dirty){ for (size_t c = 0; c < s->ncol; c++){ - *char_at(vt, r, c) = s->lines[r]->chars[c].c; + *charAt(vt, r, c) = s->lines[r]->chars[c].c; } } } @@ -57,10 +108,10 @@ $cc code { } } - void updateCursor(VTerminal *vt) { + void blinkCursor(VTerminal *vt) { // Restore char under old cursor const TMTSCREEN *s = tmt_screen(vt->tmt); - *char_at(vt, vt->curs_r, vt->curs_c) = s->lines[vt->curs_r]->chars[vt->curs_c].c; + *charAt(vt, vt->curs_r, vt->curs_c) = s->lines[vt->curs_r]->chars[vt->curs_c].c; // Update new cursor const TMTPOINT *c = tmt_cursor(vt->tmt); @@ -71,7 +122,7 @@ $cc code { struct timeval tv; gettimeofday(&tv, NULL); if (tv.tv_sec % 2 == 0) { - *char_at(vt, vt->curs_r, vt->curs_c) = 0xDB; // block char: █ + *charAt(vt, vt->curs_r, vt->curs_c) = 0xDB; // block char: █ } } } @@ -82,10 +133,12 @@ $cc proc termCreate {} VTerminal* { vt->curs_c = 0; vt->screen = malloc(sizeof(char[ROWS][COLS + 1])); - for (int r = 0; r < ROWS - 1; r++) *char_at(vt, r, COLS) = '\n'; - *char_at(vt, ROWS - 1, COLS) = '\0'; + for (int r = 0; r < ROWS - 1; r++) { + *charAt(vt, r, COLS) = '\n'; + } + *charAt(vt, ROWS - 1, COLS) = '\0'; - vt->tmt = tmt_open(ROWS, COLS, tmt_callback, vt, NULL); + vt->tmt = tmt_open(ROWS, COLS, tmtEvent, vt, NULL); struct winsize ws = {.ws_row = ROWS, .ws_col = COLS}; pid_t pid = forkpty(&vt->pty_fd, NULL, NULL, &ws); @@ -101,17 +154,13 @@ $cc proc termCreate {} VTerminal* { return vt; } -$cc proc termDestory {VTerminal* vt} void { - // TODO... -} - $cc proc termRead {VTerminal* vt} char* { ssize_t r = read(vt->pty_fd, iobuf, PTYBUF); if (r > 0) { tmt_write(vt->tmt, iobuf, r); } - updateCursor(vt); + blinkCursor(vt); return vt->screen; } @@ -120,62 +169,3 @@ $cc proc termWrite {VTerminal* vt char* key} void { } $cc compile - -# Folk stuff... - -namespace eval Terminal { - # From `man console_codes` - variable keymap [dict create \ - ENTER "\x0d" \ - TAB "\x09" \ - BACKSPACE "\x08" \ - DELETE "\x7f" \ - ESC "\x1b" \ - UP "\x1b\[A" \ - DOWN "\x1b\[B" \ - RIGHT "\x1b\[C" \ - LEFT "\x1b\[D" \ - ] - - proc remap {key ctrlPressed} { - variable keymap - if {[string length $key] == 1} { - # Convert ctrl-A through ctrl-Z and others to terminal control characters - if {$ctrlPressed} { - set charCode [scan [string toupper $key] %c] - if {$charCode >= 64 && $charCode <= 95} { - set charCode [expr {$charCode - 64}] - return [format %c $charCode] - } - } - # All other single char keys can be passed through - return $key - } - if {[dict exists $keymap $key]} { - return [dict get $keymap $key] - } - return "" - } - - # Creates a new virtual terminal and returns its ID - proc create {} { - return [termCreate] - } - - proc destroy {term} { - termDestroy $term - } - - # Writes a keyboard key to the terminal, handling control codes - proc write {term key ctrlPressed} { - set key [remap $key $ctrlPressed] - if {[string length $key] > 0} { - termWrite $term $key - } - } - - # Returns a newline separated string of terminal lines - proc read {term} { - return [termRead $term] - } -} -- cgit v1.2.3 From 3229e5b0551e9c8789d66027023c75fca7b678a6 Mon Sep 17 00:00:00 2001 From: Zach Potter Date: Thu, 24 Aug 2023 22:43:11 -0700 Subject: tweak --- lib/terminal.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/terminal.tcl b/lib/terminal.tcl index 6276d149..4118881e 100644 --- a/lib/terminal.tcl +++ b/lib/terminal.tcl @@ -74,7 +74,7 @@ $cc struct VTerminal { TMT* tmt; int pty_fd; - // Note the screen has 1 more column than the terminal, for newlines + // Note: screen has 1 more column than terminal for newlines at the end of each row char* screen; int curs_r; int curs_c; -- cgit v1.2.3 From d74bb861ffb37a1ff51438d78c0a33214b914c05 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 1 Sep 2023 17:15:12 -0400 Subject: terminal: fix on folk0 (it was trying to load 32-bit libutil as well as 64-bit libutil) --- lib/terminal.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/terminal.tcl b/lib/terminal.tcl index 4118881e..e6363326 100644 --- a/lib/terminal.tcl +++ b/lib/terminal.tcl @@ -58,7 +58,7 @@ namespace eval Terminal { set cc [c create] $cc cflags -I./vendor/libtmt ./vendor/libtmt/tmt.c -c loadlib [lindex [exec /usr/sbin/ldconfig -p | grep libutil.so] end] +c loadlib [lindex [exec /usr/sbin/ldconfig -p | grep libutil.so | head -1] end] $cc cflags -lutil $cc include -- cgit v1.2.3 From f48405e4fb02e31282e75b37c23d6669e0a57373 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 4 Sep 2023 03:08:15 -0400 Subject: Measure run time --- lib/environment.tcl | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'lib') diff --git a/lib/environment.tcl b/lib/environment.tcl index 28dd33fb..6a83802e 100644 --- a/lib/environment.tcl +++ b/lib/environment.tcl @@ -19,20 +19,21 @@ proc runInSerializedEnvironment {lambda env} { if {![dict exists $::Evaluator::totalTimesMap $lambda]} { dict set ::Evaluator::totalTimesMap $lambda [dict create loadTime 0 runTime 0 unloadTime 0] } - set loadTime_ [time {}] + set loadTime_ [baretime {}] try { - set runTime_ [time {set ret [apply $lambda {*}$env]}] + set runTime_ [baretime {set ret [apply $lambda {*}$env]}] + set ::stepRunTime [+ $::stepRunTime $runTime_] set ret } finally { - set unloadTime_ [time {}] + set unloadTime_ [baretime {}] dict with ::Evaluator::totalTimesMap $lambda { - incr loadTime [string map {" microseconds per iteration" ""} $loadTime_] + incr loadTime $loadTime_ if {[info exists runTime_]} { - incr runTime [string map {" microseconds per iteration" ""} $runTime_] + incr runTime $runTime_ } - incr unloadTime [string map {" microseconds per iteration" ""} $unloadTime_] + incr unloadTime $unloadTime_ } } } -- cgit v1.2.3 From 472646ef451f29032a14edbc6aad94754f70589f Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 4 Sep 2023 03:54:18 -0400 Subject: Precompile peering logic --- lib/peer.tcl | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) (limited to 'lib') diff --git a/lib/peer.tcl b/lib/peer.tcl index 0a1aef0d..9789266f 100644 --- a/lib/peer.tcl +++ b/lib/peer.tcl @@ -24,6 +24,18 @@ namespace eval clauseset { namespace eval ::Peers {} set ::peersBlacklist [dict create] +proc ::addMatchesToShareStatements {shareStatementsVar matches} { + upvar $shareStatementsVar shareStatements + foreach m $matches { + set pattern [dict get $m pattern] + foreach match [Statements::findMatches $pattern] { + set id [lindex [dict get $match __matcheeIds] 0] + set clause [statement clause [Statements::get $id]] + clauseset add shareStatements $clause + } + } +} + proc ::peer {process {dieOnDisconnect false}} { namespace eval ::Peers::$process { variable connected true @@ -44,6 +56,29 @@ proc ::peer {process {dieOnDisconnect false}} { Mailbox::receive $process $::thisProcess } + proc exchange {shareStatements} { + variable process + variable prevShareStatements + + variable connected + if {!$connected} { return } + + # Receive. + Commit $process [list Say $process is sharing statements [receive]] + + # Share. + ::addMatchesToShareStatements shareStatements \ + [Statements::findMatches [list /someone/ wishes $process receives statements like /pattern/]] + if {![info exists prevShareStatements] || + ([clauseset size $prevShareStatements] > 0 || + [clauseset size $shareStatements] > 0)} { + + share [clauseset clauses $shareStatements] + + set prevShareStatements $shareStatements + } + } + proc init {n shouldDieOnDisconnect} { variable process $n variable dieOnDisconnect $shouldDieOnDisconnect -- cgit v1.2.3 From 2d3b518e8db13b6cc534836d8a4125e9d49b7a25 Mon Sep 17 00:00:00 2001 From: Zach Potter Date: Sat, 2 Sep 2023 22:00:30 -0700 Subject: A more reactive terminal The terminal can now - spawn with specific commands - kill their children and clean up resources - have dynamic rows/cols - draw text on any region And I added some docs, with a simple editor program! --- lib/terminal.tcl | 52 +++++++++++++++++++++++++++++++++------------------- 1 file changed, 33 insertions(+), 19 deletions(-) (limited to 'lib') diff --git a/lib/terminal.tcl b/lib/terminal.tcl index e6363326..04d054ff 100644 --- a/lib/terminal.tcl +++ b/lib/terminal.tcl @@ -37,8 +37,13 @@ namespace eval Terminal { return "" } - proc create {} { - return [termCreate] + proc create {rows cols cmd} { + # End arguments with null string + termCreate $rows $cols [list bash -c $cmd ""] + } + + proc destroy {term} { + termDestroy $term } # Writes a keyboard key to the terminal, handling control codes @@ -51,7 +56,7 @@ namespace eval Terminal { # Returns a newline separated string of terminal lines proc read {term} { - return [termRead $term] + termRead $term } } @@ -68,28 +73,28 @@ $cc include $cc include $cc include $cc include +$cc include $cc include "tmt.h" $cc struct VTerminal { TMT* tmt; int pty_fd; + int pid; - // Note: screen has 1 more column than terminal for newlines at the end of each row - char* screen; + // Note: display has 1 more column than tmt screen to hold newlines between each line + char* display; int curs_r; int curs_c; + int ncols; }; $cc code { - #define SHELL "/bin/bash" - #define ROWS 12 - #define COLS 43 #define PTYBUF 4096 char iobuf[PTYBUF]; char* charAt(VTerminal *vt, int r, int c) { - int i = r * (COLS + 1) + c; - return &vt->screen[i]; + int i = r * (vt->ncols + 1) + c; + return &vt->display[i]; } void tmtEvent(tmt_msg_t m, TMT *tmt, const void *a, void *p) { @@ -127,33 +132,42 @@ $cc code { } } -$cc proc termCreate {} VTerminal* { +$cc proc termCreate {int rows int cols char* cmd[]} VTerminal* { VTerminal *vt = malloc(sizeof(VTerminal)); vt->curs_r = 0; vt->curs_c = 0; + vt->ncols = cols; - vt->screen = malloc(sizeof(char[ROWS][COLS + 1])); - for (int r = 0; r < ROWS - 1; r++) { - *charAt(vt, r, COLS) = '\n'; + vt->display = malloc(sizeof(char[rows][cols + 1])); + for (int r = 0; r < rows - 1; r++) { + *charAt(vt, r, cols) = '\n'; } - *charAt(vt, ROWS - 1, COLS) = '\0'; + *charAt(vt, rows - 1, cols) = '\0'; - vt->tmt = tmt_open(ROWS, COLS, tmtEvent, vt, NULL); + vt->tmt = tmt_open(rows, cols, tmtEvent, vt, NULL); - struct winsize ws = {.ws_row = ROWS, .ws_col = COLS}; + struct winsize ws = {.ws_row = rows, .ws_col = cols}; pid_t pid = forkpty(&vt->pty_fd, NULL, NULL, &ws); if (pid < 0){ return NULL; } else if (pid == 0){ setenv("TERM", "ansi", 1); - execl(SHELL, SHELL, NULL); + execvp(cmd[0], cmd); return NULL; } + vt->pid = pid; fcntl(vt->pty_fd, F_SETFL, O_NONBLOCK); return vt; } +$cc proc termDestroy {VTerminal* vt} void { + kill(vt->pid, SIGTERM); + close(vt->pty_fd); + free(vt->display); + free(vt); +} + $cc proc termRead {VTerminal* vt} char* { ssize_t r = read(vt->pty_fd, iobuf, PTYBUF); if (r > 0) { @@ -161,7 +175,7 @@ $cc proc termRead {VTerminal* vt} char* { } blinkCursor(vt); - return vt->screen; + return vt->display; } $cc proc termWrite {VTerminal* vt char* key} void { -- cgit v1.2.3 From c6a1fcee99df646eadfd800e7ddb691f92733ca2 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Wed, 6 Sep 2023 00:46:58 -0400 Subject: terminal: slight hack to fix execvp --- lib/terminal.tcl | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) (limited to 'lib') diff --git a/lib/terminal.tcl b/lib/terminal.tcl index 04d054ff..16e553ca 100644 --- a/lib/terminal.tcl +++ b/lib/terminal.tcl @@ -38,7 +38,6 @@ namespace eval Terminal { } proc create {rows cols cmd} { - # End arguments with null string termCreate $rows $cols [list bash -c $cmd ""] } @@ -133,6 +132,13 @@ $cc code { } $cc proc termCreate {int rows int cols char* cmd[]} VTerminal* { + int i = 0; + while (true) { + // execvp requires cmd array to be terminated by null pointer + if (strlen(cmd[i]) == 0) { cmd[i] = NULL; break; } + i++; + } + VTerminal *vt = malloc(sizeof(VTerminal)); vt->curs_r = 0; vt->curs_c = 0; @@ -152,7 +158,9 @@ $cc proc termCreate {int rows int cols char* cmd[]} VTerminal* { return NULL; } else if (pid == 0){ setenv("TERM", "ansi", 1); - execvp(cmd[0], cmd); + if (execvp(cmd[0], cmd) == -1) { + fprintf(stderr, "execvp(%s, ...) failed: %m\n", cmd[0]); + } return NULL; } -- cgit v1.2.3 From 6b426aa5853d8aa4d389a36f076a8cf416a3c91c Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Wed, 6 Sep 2023 02:11:46 -0400 Subject: Some peering cleanup (receive before Step); build in FPS counting --- lib/peer.tcl | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) (limited to 'lib') diff --git a/lib/peer.tcl b/lib/peer.tcl index 9789266f..ef8e1e1c 100644 --- a/lib/peer.tcl +++ b/lib/peer.tcl @@ -47,7 +47,7 @@ proc ::peer {process {dieOnDisconnect false}} { # TODO: Handle die on disconnect (?) - proc share {statements} { + proc send {statements} { variable process Mailbox::share $::thisProcess $process $statements } @@ -56,16 +56,13 @@ proc ::peer {process {dieOnDisconnect false}} { Mailbox::receive $process $::thisProcess } - proc exchange {shareStatements} { + proc share {shareStatements} { variable process variable prevShareStatements variable connected if {!$connected} { return } - # Receive. - Commit $process [list Say $process is sharing statements [receive]] - # Share. ::addMatchesToShareStatements shareStatements \ [Statements::findMatches [list /someone/ wishes $process receives statements like /pattern/]] @@ -73,7 +70,7 @@ proc ::peer {process {dieOnDisconnect false}} { ([clauseset size $prevShareStatements] > 0 || [clauseset size $shareStatements] > 0)} { - share [clauseset clauses $shareStatements] + send [clauseset clauses $shareStatements] set prevShareStatements $shareStatements } -- cgit v1.2.3