LithosAnanake/v4/tests/test_host_codegen.c

/* test_host_codegen.c -- the code generator, executed on the host node.
 *
 * capsule/codegen.v4 packs opcodes, literals and branches into instruction
 * words at HERE; it is what the compiling words will be built on.  It is the
 * third thing in this tree that does that job -- after the slot packer in C
 * (asm.h) and the text assembler on top of it (text.h) -- and the first that
 * is itself v4 code.  So the test is a comparison: the same programme is laid
 * down twice, once by the text assembler on one node and once by the code
 * generator running on another, at the same address, and the two memories
 * must be the same word for word.  Then what the generator made is run.
 */
#include "v4/text.h"
#include "v4/testcode.h"
#include <stdint.h>
#include <stdio.h>
#include <string.h>

static int failures = 0, checks = 0;
#define CHECK(c,...) do{checks++; if(!(c)){failures++; printf("FAIL %s:%d: ",__FILE__,__LINE__); printf(__VA_ARGS__); printf("\n");}}while(0)

#define CANARY ((v4_cell)0x0C0FFEE5)
#define MAXU   ((v4_ucell)~(v4_ucell)0)

#define DICT_W       ((v4_cell)8192)            /* dictionary space: words 8192 .. 12287 */
#define DICT_END_W   ((v4_cell)12288)
#include "host_map.h"

static v4_node       n, ref;           /* the generator's node; the text assembler's */
static v4_exec_state es;
static v4_heat       h;
static v4_text       tx, rtx;          /* the capsule on n; the reference programme on ref */

static const char *const mnemonic[V4_OPCODE_COUNT] = {
    ";", "ex", "jump", "call", "unext", "next", "if", "-if", "@p", "@+", "@b", "@", "!p", "!+", "!b", "!",
    "+*", "2*", "2/", "inv", "+", "and", "xor", "drop", "dup", "pop", "over", "a", "nop", "push", "b!", "a!" };

static v4_cell W(const char *name)
{
    v4_cell w = v4_text_word(&tx, name);
    if (w < 0) { failures++; printf("FAIL: no word %s\n", name); }
    return w;
}
static int run(const char *name, unsigned argc, v4_cell a, v4_cell b)
{
    v4_dstack_reset(&n.ds);
    v4_rstack_reset(&n.rs);
    v4_exec_reset(&es);
    v4_heat_reset(&h);
    v4_dstack_push(&n.ds, CANARY);
    if (argc > 0) v4_dstack_push(&n.ds, a);
    if (argc > 1) v4_dstack_push(&n.ds, b);
    return v4_test_call(&n, &es, &h, W(name), 100000) > 0;
}
static v4_cell pop(void) { return v4_dstack_pop(&n.ds); }
static int clean(void)   { return pop() == CANARY; }
/* a word that takes its arguments and leaves nothing */
static int did(const char *name, unsigned argc, v4_cell a, v4_cell b) { return run(name, argc, a, b) && clean(); }
/* a word that leaves one cell */
static v4_cell get(const char *name, unsigned argc, v4_cell a, v4_cell b)
{
    v4_cell r;
    if (!run(name, argc, a, b)) return (v4_cell)0x0BADBAD;
    r = pop();
    return clean() ? r : (v4_cell)0x0BADBAD;
}

/* ---- a programme, described once and laid down twice --------------------- */

enum { K_OP, K_LIT, K_LABEL, K_BACK, K_FWD, K_HERE };   /* K_HERE resolves a K_FWD */
typedef struct { int kind; unsigned op; v4_cell value; int label; } item;

#define MAX_ITEMS 400
static item     prog[MAX_ITEMS];
static unsigned nprog;

static void p_op(unsigned op)             { prog[nprog].kind = K_OP; prog[nprog].op = op; nprog++; }
static void p_lit(v4_cell v)              { prog[nprog].kind = K_LIT; prog[nprog].value = v; nprog++; }
static void p_label(int l)                { prog[nprog].kind = K_LABEL; prog[nprog].label = l; nprog++; }
static void p_back(unsigned op, int l)    { prog[nprog].kind = K_BACK; prog[nprog].op = op; prog[nprog].label = l; nprog++; }
static void p_fwd(unsigned op, int l)     { prog[nprog].kind = K_FWD; prog[nprog].op = op; prog[nprog].label = l; nprog++; }
static void p_here(int l)                 { prog[nprog].kind = K_HERE; prog[nprog].label = l; nprog++; }

/* By the text assembler, on `ref`, at the dictionary's first word. */
static int lay_by_text(void)
{
    static char src[MAX_ITEMS * 40];
    size_t at = 0;
    unsigned i;
    at += (size_t)sprintf(src + at, ": PROG ");
    for (i = 0; i < nprog; i++) {
        const item *it = &prog[i];
        switch (it->kind) {
        case K_OP:    at += (size_t)sprintf(src + at, "%s ", mnemonic[it->op]); break;
#if V4_CELL_BITS == 32
        case K_LIT:   at += (size_t)sprintf(src + at, "%ld ", (long)it->value); break;
#else
        case K_LIT:   at += (size_t)sprintf(src + at, "%lld ", (long long)it->value); break;
#endif
        case K_LABEL: at += (size_t)sprintf(src + at, "B%d: ", it->label); break;
        case K_BACK:  at += (size_t)sprintf(src + at, "%s B%d ", mnemonic[it->op], it->label); break;
        case K_FWD:   at += (size_t)sprintf(src + at, "%s F%d ", mnemonic[it->op], it->label); break;
        case K_HERE:  at += (size_t)sprintf(src + at, "F%d: ", it->label); break;
        }
    }
    v4_node_reset(&ref);
    v4_text_begin(&rtx, &ref, DICT_W);
    return v4_text_assemble(&rtx, src) && v4_text_finish(&rtx);
}

/* By the code generator, on `n`: one call to a word of codegen.v4 for each
 * item, as the compiling words will make them. */
static int lay_by_generator(void)
{
    static v4_cell back[64], fwd[64];
    unsigned i;
    for (v4_cell k = DICT_W; k < DICT_END_W; k++) n.mem[k] = 0;
    n.mem[DP] = DICT_W * 4;
    n.mem[NODE_ERROR] = 0;
    if (!did("(CG-RESET)", 0, 0, 0)) return 0;
    for (i = 0; i < nprog; i++) {
        const item *it = &prog[i];
        switch (it->kind) {
        case K_OP:    if (!did("(OP,)", 1, (v4_cell)it->op, 0)) return 0; break;
        case K_LIT:   if (!did("(LIT,)", 1, it->value, 0)) return 0; break;
        case K_LABEL: back[it->label] = get("(LABEL)", 0, 0, 0); break;
        case K_BACK:  if (!did("(BRANCH,)", 2, back[it->label], (v4_cell)it->op)) return 0; break;
        case K_FWD:   fwd[it->label] = get("(BRANCH>)", 1, (v4_cell)it->op, 0); break;
        case K_HERE:  { v4_cell here = get("(LABEL)", 0, 0, 0); if (!did("(RESOLVE)", 2, here, fwd[it->label])) return 0; } break;
        }
    }
    return did("(FLUSH)", 0, 0, 0) && n.mem[NODE_ERROR] == 0;
}

/* Lay the programme down both ways; 1 if the two are the same. */
static int same(const char *what)
{
    v4_cell end_ref, end_gen, k;
    if (!lay_by_text()) { printf("    %s: the text assembler refused it: %s\n", what, v4_text_error(&rtx)); return 0; }
    if (!lay_by_generator()) { printf("    %s: the generator did not finish\n", what); return 0; }
    end_ref = v4_text_here(&rtx);
    end_gen = (n.mem[DP] + 3) / 4;
    if (end_ref != end_gen) { printf("    %s: lengths differ: %ld by text, %ld by the generator\n", what, (long)(end_ref - DICT_W), (long)(end_gen - DICT_W)); return 0; }
    for (k = DICT_W; k < end_ref + 8; k++)
        if (n.mem[k] != ref.mem[k]) {
            printf("    %s: word %ld differs: %llx by text, %llx by the generator\n", what, (long)(k - DICT_W),
                   (unsigned long long)(v4_ucell)ref.mem[k], (unsigned long long)(v4_ucell)n.mem[k]);
            return 0;
        }
    return 1;
}

static uint32_t rng = 0x7F4A7C15u;
static uint32_t rnd(void) { rng ^= rng << 13; rng ^= rng >> 17; rng ^= rng << 5; return rng; }

static const unsigned plain_ops[] = {               /* every opcode but the branches and @p */
    0, 1, 4, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31 };
static const unsigned branch_ops[] = { 2, 3, 5, 6, 7 };
static const v4_cell lits[] = { 0, 1, -1, 2, 255, 65536, -65536, 12345678, (v4_cell)V4_MSB, (v4_cell)(V4_MSB - 1u), (v4_cell)(MAXU / 3u) };

/* Run the programme the generator laid down, as a word. */
static int exec_prog(unsigned argc, v4_cell a, v4_cell b)
{
    v4_dstack_reset(&n.ds);
    v4_rstack_reset(&n.rs);
    v4_exec_reset(&es);
    v4_dstack_push(&n.ds, CANARY);
    if (argc > 0) v4_dstack_push(&n.ds, a);
    if (argc > 1) v4_dstack_push(&n.ds, b);
    return v4_test_call(&n, &es, &h, DICT_W, 100000) > 0;
}

int main(void)
{
    unsigned i, t, bslots = 0;

    printf("v4 host code generator tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);

    for (i = 0; i < 4; i++) if ((v4_ucell)v4_iword_slot_mask(i) >= (v4_ucell)(V4_NODE_WORDS - 1u)) bslots = i + 1;
    CHECK(bslots == 3, "at this node size a branch may sit in slots 0 .. 2: %u", bslots);

    {
        static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4" };
        CHECK(host_load(&tx, &n, files, 4), "the capsule assembles");
    }
    CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx));
    CHECK(v4_text_here(&tx) < DICT_W, "code stays below the dictionary space");
    printf("  code: %ld words\n", (long)v4_text_here(&tx) - 16);
    if (failures) { printf("  %d checks, %d failures\n", checks, failures); return 1; }

    /* ---- the arithmetic it rests on ---- */
    for (i = 0; i <= 31; i++)
        CHECK(get("(LSHIFT)", 2, 1, (v4_cell)i) == (v4_cell)((v4_ucell)1 << i) && get("(LSHIFT)", 2, 5, (v4_cell)i) == (v4_cell)((v4_ucell)5 << i),
              "(LSHIFT) by %u", i);
    for (i = 0; i < 6; i++) {
        CHECK(get("(LOWBIT)", 1, (v4_cell)i, 0) == (v4_cell)V4_SLOT_LOW_BIT(i), "slot %u's lowest bit is %u", i, V4_SLOT_LOW_BIT(i));
        CHECK(get("(MASK)", 1, (v4_cell)i, 0) == (v4_cell)v4_iword_slot_mask(i), "slot %u's address mask", i);
    }

    /* ---- one thing at a time ---- */
    nprog = 0;
    CHECK(same("nothing"), "nothing lays nothing");
    CHECK((n.mem[DP] + 3) / 4 == DICT_W, "and HERE does not move");

    for (i = 0; i < sizeof plain_ops / sizeof plain_ops[0]; i++) {
        nprog = 0; p_op(plain_ops[i]);
        CHECK(same(mnemonic[plain_ops[i]]), "the opcode %s alone", mnemonic[plain_ops[i]]);
        nprog = 0; p_op(28); p_op(28); p_op(plain_ops[i]); p_op(24);
        CHECK(same(mnemonic[plain_ops[i]]), "the opcode %s in slot 2, something after it", mnemonic[plain_ops[i]]);
    }
    for (t = 1; t <= 14; t++) {
        nprog = 0; for (i = 0; i < t; i++) p_op(24);
        CHECK(same("dups"), "%u opcodes: a word every six", t);
    }
    for (i = 0; i < sizeof lits / sizeof lits[0]; i++) {
        nprog = 0; p_lit(lits[i]); p_op(0);
        CHECK(same("a literal"), "the literal [%u]", i);
    }
    for (t = 1; t <= 14; t++) {
        nprog = 0; for (i = 0; i < t; i++) p_lit((v4_cell)(100 + i));
        CHECK(same("literals"), "%u literals in a row: each word's follow it in order", t);
    }
    for (t = 0; t <= 6; t++) {                                  /* a literal in each slot, then more code */
        nprog = 0; for (i = 0; i < t; i++) p_op(24);
        p_lit(77); p_op(20); p_lit(-88); p_op(0);
        CHECK(same("mixed"), "a literal after %u opcodes", t);
    }

    /* a branch after 0 .. 6 opcodes, backward and forward, each of the five */
    for (i = 0; i < 5; i++)
        for (t = 0; t <= 6; t++) {
            unsigned k;
            nprog = 0; p_label(0); p_op(28); p_op(28); p_op(28); p_op(28); p_op(28); p_op(28);
            for (k = 0; k < t; k++) p_op(24);
            p_back(branch_ops[i], 0); p_op(23); p_op(0);
            CHECK(same("back"), "%s backward after %u opcodes", mnemonic[branch_ops[i]], t);
            nprog = 0;
            for (k = 0; k < t; k++) p_op(24);
            p_fwd(branch_ops[i], 0); p_op(23); p_op(23); p_op(0); p_here(0); p_op(0);
            CHECK(same("forward"), "%s forward after %u opcodes", mnemonic[branch_ops[i]], t);
            nprog = 0;                                              /* with literals owed by the branch's word */
            p_lit(5); p_lit(6);
            for (k = 0; k < t; k++) p_op(24);
            p_fwd(branch_ops[i], 0); p_lit(7); p_op(0); p_here(0); p_op(0);
            CHECK(same("forward with literals"), "%s forward after two literals and %u opcodes", mnemonic[branch_ops[i]], t);
        }

    /* a label after 0 .. 6 opcodes closes the word */
    for (t = 0; t <= 6; t++) {
        nprog = 0; for (i = 0; i < t; i++) p_op(24);
        p_label(0); p_op(23); p_back(2, 0);
        CHECK(same("label"), "a label after %u opcodes", t);
    }

    /* ---- random programmes ---- */
    for (t = 0; t < 600; t++) {
        unsigned len = 5 + rnd() % 120, nback = 0, nfwd = 0, open[8], nopen = 0;
        nprog = 0;
        for (i = 0; i < len && nprog < MAX_ITEMS - 20; i++) {
            unsigned r = rnd() % 100;
            if (r < 55)       p_op(plain_ops[rnd() % (sizeof plain_ops / sizeof plain_ops[0])]);
            else if (r < 75)  p_lit(rnd() % 3 ? (v4_cell)(int32_t)rnd() : lits[rnd() % (sizeof lits / sizeof lits[0])]);
            else if (r < 82 && nback < 40) p_label((int)nback++);
            else if (r < 90 && nback > 0)  p_back(branch_ops[rnd() % 5], (int)(rnd() % nback));
            else if (r < 95 && nopen < 8 && nfwd < 40) { open[nopen++] = nfwd; p_fwd(branch_ops[rnd() % 5], (int)nfwd++); }
            else if (nopen > 0) { unsigned k = rnd() % nopen; p_here((int)open[k]); open[k] = open[--nopen]; }
        }
        while (nopen > 0) p_here((int)open[--nopen]);
        CHECK(same("random"), "random programme %u of %u items", t, nprog);
    }

    /* ---- what it lays down runs ---- */

    /* ( a b -- b a )   over push push drop pop pop ; */
    nprog = 0; p_op(26); p_op(29); p_op(29); p_op(23); p_op(25); p_op(25); p_op(0);
    CHECK(same("SWAP") && exec_prog(2, 3, 4) && pop() == 3 && pop() == 4 && clean(), "SWAP, generated, swaps");

    /* ( n -- n*8+5 )   2 push L: 2* next L  5 + ;      a backward branch and a literal */
    nprog = 0; p_lit(2); p_op(29); p_label(0); p_op(17); p_back(5, 0); p_lit(5); p_op(20); p_op(0);
    CHECK(same("loop") && exec_prog(1, 3, 0) && pop() == 29 && clean(), "a counted loop, generated, counts");

    /* ( n -- 10 | 20 )   if Z  drop 10 ;  Z: drop 20 ;   a forward branch */
    nprog = 0; p_fwd(6, 0); p_op(23); p_lit(10); p_op(0); p_here(0); p_op(23); p_lit(20); p_op(0);
    CHECK(same("if") && exec_prog(1, 7, 0) && pop() == 10 && clean() && exec_prog(1, 0, 0) && pop() == 20 && clean(), "a conditional, generated, chooses");

    /* a call to a word of the capsule, and a jump to one: ( c baddr -- c' )  dup push C! pop jump C@ */
    CHECK(lay_by_generator() == 1, "reset");
    nprog = 0;
    for (v4_cell k = DICT_W; k < DICT_W + 16; k++) n.mem[k] = 0;
    n.mem[DP] = DICT_W * 4;
    CHECK(did("(CG-RESET)", 0, 0, 0) && did("(OP,)", 1, 24, 0) && did("(OP,)", 1, 29, 0)
          && did("(CALL,)", 1, W("C!"), 0) && did("(OP,)", 1, 25, 0) && did("(JUMP,)", 1, W("C@"), 0) && did("(FLUSH)", 0, 0, 0),
          "a call and a jump to capsule words are generated");
    for (i = 0; i < 8; i++)
        CHECK(exec_prog(2, (v4_cell)(0x500 + 'A' + i), PAD_W * 4 + (v4_cell)i) && pop() == (v4_cell)('A' + i) && clean(), "and they run [%u]", i);
    /* dup push call | pop jump : the call is in slot 2 of the first word, the jump in slot 1 of the second */
    CHECK(v4_iword_op((v4_iword)(v4_ucell)n.mem[DICT_W], 2) == V4_OP_CALL
          && v4_iword_target((v4_iword)(v4_ucell)n.mem[DICT_W], 2) == (v4_iword)W("C!"), "(CALL,) lays a call to its address");
    CHECK(v4_iword_op((v4_iword)(v4_ucell)n.mem[DICT_W + 1], 1) == V4_OP_JUMP
          && v4_iword_target((v4_iword)(v4_ucell)n.mem[DICT_W + 1], 1) == (v4_iword)W("C@"), "(JUMP,) lays a jump to its address");

    /* (RESOLVE) writes only the address bits of its slot: a target with
     * higher bits set leaves the opcodes of the word as they were */
    for (i = 0; i < 3; i++) {
        v4_cell r, before;
        unsigned k;
        n.mem[DP] = DICT_W * 4;
        CHECK(did("(CG-RESET)", 0, 0, 0), "reset");
        for (k = 0; k < i; k++) CHECK(did("(OP,)", 1, 24, 0), "dup");
        r = get("(BRANCH>)", 1, 6, 0);
        before = n.mem[DICT_W];
        CHECK(r == DICT_W * 8 + (v4_cell)i, "the reference names the word and slot %u", i);
        CHECK(did("(RESOLVE)", 2, (v4_cell)-1, r), "resolved to all ones");
        CHECK((v4_ucell)n.mem[DICT_W] == ((v4_ucell)before | (v4_ucell)v4_iword_slot_mask(i)),
              "only the %u address bits of slot %u are written", V4_SLOT_LOW_BIT(i), i);
        CHECK(did("(RESOLVE)", 2, 0, r) && n.mem[DICT_W] == before, "and resolving again to 0 clears them, and nothing else");
    }

    /* (CG-RESET) forgets a word half built */
    n.mem[DP] = DICT_W * 4;
    CHECK(did("(OP,)", 1, 24, 0) && did("(LIT,)", 1, 9, 0) && did("(CG-RESET)", 0, 0, 0) && did("(FLUSH)", 0, 0, 0)
          && n.mem[DP] == DICT_W * 4, "(CG-RESET) forgets a half-built word");

    /* a full dictionary: nothing is written past it, and NODE-ERROR is set */
    n.mem[DP] = (DICT_END_W - 1) * 4;
    n.mem[DICT_END_W] = 0x5EED;
    n.mem[NODE_ERROR] = 0;
    CHECK(did("(LIT,)", 1, 1, 0) && did("(LIT,)", 1, 2, 0) && did("(FLUSH)", 0, 0, 0)
          && n.mem[NODE_ERROR] != 0 && n.mem[DICT_END_W] == 0x5EED, "code that does not fit sets NODE-ERROR and writes nothing past the end");

    CHECK(v4_node_guards_intact(&n) && v4_node_guards_intact(&ref), "guards intact");

    printf("  %d checks, %d failures\n", checks, failures);
    return failures ? 1 : 0;
}