admin/LithosAnanake
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

word_source: add LSHIFT/RSHIFT bitwise-shift primitives

Browse Source 
No shift primitive existed anywhere in the vendored VM word set. Adds
both as FORTH-83-extension words next to INVERT, guarded against stack
underflow and out-of-range shift counts (u >= 64).

Their absence was masking a real bug: capsules/hermes/init.4th's
CH-MINT-ID (item 4.2) calls LSHIFT to pack a 64-bit channel ID, which
was silently tripping the capsule loader's forward-reference retry
logic and splicing CH-REQUEST's body into CH-MINT-ID's definition.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
This commit is contained in:
Robert Allan James
2026-08-06 14:50:05 -04:00
co-authored by Claude Sonnet 5
parent 11cd6c8574
commit 56ad128e2e
1 changed files with 50 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/word_source/logical_words.c
+50
View File
@@ -136,6 +136,54 @@ static void logical_word_invert(VM *vm) {
vm_push(vm, ~n1);
}
/* LSHIFT ( x1 u -- x2 ) Logical left shift, u bits (FORTH-83 extension) */
static void logical_word_lshift(VM *vm) {
if (vm->dsp < 1) {
log_message(LOG_ERROR, "LSHIFT: Stack underflow");
vm->error = 1;
return;
}
ucell_t u = (ucell_t) vm_pop(vm);
ucell_t x1 = (ucell_t) vm_pop(vm);
if (u >= (ucell_t)(sizeof(cell_t) * 8)) {
log_message(LOG_ERROR, "LSHIFT: shift count %lu out of range", (unsigned long) u);
vm->error = 1;
return;
}
cell_t result = (cell_t)(x1 << u);
vm_push(vm, result);
log_message(LOG_DEBUG, "LSHIFT: %lu << %lu = %ld", (unsigned long) x1, (unsigned long) u, (long) result);
}
/* RSHIFT ( x1 u -- x2 ) Logical right shift, u bits (FORTH-83 extension) */
static void logical_word_rshift(VM *vm) {
if (vm->dsp < 1) {
log_message(LOG_ERROR, "RSHIFT: Stack underflow");
vm->error = 1;
return;
}
ucell_t u = (ucell_t) vm_pop(vm);
ucell_t x1 = (ucell_t) vm_pop(vm);
if (u >= (ucell_t)(sizeof(cell_t) * 8)) {
log_message(LOG_ERROR, "RSHIFT: shift count %lu out of range", (unsigned long) u);
vm->error = 1;
return;
}
cell_t result = (cell_t)(x1 >> u);
vm_push(vm, result);
log_message(LOG_DEBUG, "RSHIFT: %lu >> %lu = %ld", (unsigned long) x1, (unsigned long) u, (long) result);
}
/* 0= - Test for zero ( n -- flag ) */
static void logical_word_zero_equals(VM *vm) {
if (vm->dsp < 0) {
@@ -376,6 +424,8 @@ void register_logical_words(VM *vm) {
register_word(vm, "XOR", logical_word_xor);
register_word(vm, "NOT", logical_word_not);
register_word(vm, "INVERT", logical_word_invert);
register_word(vm, "LSHIFT", logical_word_lshift);
register_word(vm, "RSHIFT", logical_word_rshift);
/* Zero comparisons */
register_word(vm, "0=", logical_word_zero_equals);