First code for StarForth v4 (JUSTIFICATION.md section 10, step 1): one node of the 32-instruction core as a C99 model, with cell width as a build parameter. - Node: P, A, B, F18 circular stacks (10 and 9 deep, D-2), word-addressed memory (D-1), 5% guard bands on every bounded list. - Instruction word: six 5-bit slots in 32 bits at every cell width. - Executor: all 32 opcodes of DECOMPOSITION.md 1.3. Cell arithmetic wraps explicitly; no signed overflow or implementation-defined shift. - Heat: per-opcode and per-call-target counters and the anti-clock, driven by instruction retirement (1.4, D-6 interim). - Slot packer and runner for tests, and a reference unsigned multiply in plain C99 with no 128-bit type. Tests run at 32- and 64-bit cells, and under ASan and UBSan. They cover every opcode and execute the first section 4 definitions (NIP SWAP OR NEGATE ROT 0< 0= 2DUP - U<) against the C operation each stands for. UM* as written in section 4 is exact only while u1 <= 2^(n-2). Two known failing cases are pinned in test_foundation.c until it is rewritten. DECOMPOSITION.md: record D-9, the instruction word is 32 bits at every cell width (ruled 2026-10-02). Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
90 lines
2.9 KiB
C
90 lines
2.9 KiB
C
/* heat.c -- heat and anti-clock. See heat.h. */
|
|
#include "v4/heat.h"
|
|
#include <string.h>
|
|
|
|
void v4_heat_reset(v4_heat *h)
|
|
{
|
|
memset(h->op, 0, sizeof(h->op));
|
|
memset(h->call, 0, sizeof(h->call));
|
|
memset(h->call_freeze_mask, 0, sizeof(h->call_freeze_mask));
|
|
}
|
|
|
|
void v4_heat_on_retire(v4_heat *h, unsigned op, v4_uheat_t *anticlock)
|
|
{
|
|
if (op < V4_OPCODE_COUNT) {
|
|
h->op[op]++;
|
|
}
|
|
if (anticlock) (*anticlock)++;
|
|
}
|
|
|
|
static unsigned call_index(v4_cell target)
|
|
{
|
|
/* Index by target address. The table is a fixed-size cache for the model.
|
|
* A real hardware table is deferred; here we hash-mod or just take low bits?
|
|
* Or simply if in range use it. The spec says "per-call-target heat table"
|
|
* indexed by target. For golden model, targets are small (node memory). */
|
|
unsigned idx = (unsigned)(v4_ucell)target;
|
|
if (idx >= V4_HEAT_MAX_CALL_TARGETS) {
|
|
/* Out of range: ignore for now? Or clamp? D-6 deferred; but heat must
|
|
* be recorded for actual call targets exercised. Many tests will have
|
|
* targets < 4096. This is a conservative model choice: if target is
|
|
* outside the modeled table, we do not increment a modeled slot (and
|
|
* we could log, but not specified). The boundary philosophy says detect
|
|
* rather than corrupt: for the model, we just don't record in the fixed
|
|
* table -- acceptable until D-4/D-6 pin sizes. */
|
|
return (unsigned)-1; /* invalid */
|
|
}
|
|
return idx;
|
|
}
|
|
|
|
void v4_heat_on_call(v4_heat *h, v4_cell target)
|
|
{
|
|
unsigned idx = call_index(target);
|
|
if (idx == (unsigned)-1) return;
|
|
if (v4_heat_call_is_frozen(h, target)) return;
|
|
h->call[idx]++;
|
|
}
|
|
|
|
v4_uheat_t v4_heat_call_get(const v4_heat *h, v4_cell target)
|
|
{
|
|
unsigned idx = call_index(target);
|
|
if (idx == (unsigned)-1) return 0;
|
|
return h->call[idx];
|
|
}
|
|
|
|
int v4_heat_call_set(v4_heat *h, v4_cell target, v4_uheat_t val)
|
|
{
|
|
unsigned idx = call_index(target);
|
|
if (idx == (unsigned)-1) return 0;
|
|
if (v4_heat_call_is_frozen(h, target)) return 0;
|
|
h->call[idx] = val;
|
|
return 1;
|
|
}
|
|
|
|
void v4_heat_call_freeze(v4_heat *h, v4_cell target)
|
|
{
|
|
unsigned idx = call_index(target);
|
|
if (idx == (unsigned)-1) return;
|
|
unsigned word = idx / (8u * sizeof(v4_ucell));
|
|
unsigned bit = idx % (8u * sizeof(v4_ucell));
|
|
h->call_freeze_mask[word] |= ((v4_ucell)1u << bit);
|
|
}
|
|
|
|
void v4_heat_call_unfreeze(v4_heat *h, v4_cell target)
|
|
{
|
|
unsigned idx = call_index(target);
|
|
if (idx == (unsigned)-1) return;
|
|
unsigned word = idx / (8u * sizeof(v4_ucell));
|
|
unsigned bit = idx % (8u * sizeof(v4_ucell));
|
|
h->call_freeze_mask[word] &= ~((v4_ucell)1u << bit);
|
|
}
|
|
|
|
int v4_heat_call_is_frozen(const v4_heat *h, v4_cell target)
|
|
{
|
|
unsigned idx = call_index(target);
|
|
if (idx == (unsigned)-1) return 0;
|
|
unsigned word = idx / (8u * sizeof(v4_ucell));
|
|
unsigned bit = idx % (8u * sizeof(v4_ucell));
|
|
return (h->call_freeze_mask[word] & ((v4_ucell)1u << bit)) != 0;
|
|
}
|