From 56ad128e2e0196c55c0bf91c001e0ac951d72ade Mon Sep 17 00:00:00 2001 From: Robert Allan James Date: Thu, 6 Aug 2026 14:50:05 -0400 Subject: [PATCH] word_source: add LSHIFT/RSHIFT bitwise-shift primitives 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 --- src/word_source/logical_words.c | 50 +++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) diff --git a/src/word_source/logical_words.c b/src/word_source/logical_words.c index 07886ee..fcebf21 100644 --- a/src/word_source/logical_words.c +++ b/src/word_source/logical_words.c @@ -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);