Files
LithosAnanake/v4/src/heat.c
T
rajamesandClaude Opus 5.5 067f317c47 feat(v4.0.0): hosted golden model, single node
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>
2026-10-02 14:38:27 -04:00

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;
}