LithosAnanake/v4/tools/mkimage.c

/* mkimage.c -- build the capsule image (include/v4/image.h).
 *
 *     mkimage OUTPUT.c
 *
 * Runs on the build machine.  It assembles capsule/ *.v4 -- the nucleus,
 * docs/v4.0.0/NUCLEUS.md -- onto a host node with the memory map of
 * tests/host_map.h and starts the node at its prompt.  Then it writes every
 * word of the node's memory that is not zero, and the addresses a loader
 * needs, as a C file.  No FORTH source is compiled here: what is not in the
 * nucleus is loaded from capsules when the system boots (v4/system/boot.c).
 *
 * The image is the same on every machine it is built on: nothing in it
 * depends on the build machine but the cell width this tool was compiled
 * for.
 */
#include "v4/image.h"
#include "v4/text.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include "../tests/host_map.h"

static v4_node       n;
static v4_exec_state es;
static v4_heat       h;
static v4_text       tx;
static v4_cell       w_key, w_key_end;
static unsigned char disk[4 * V4_BLOCK_BYTES];

static void die(const char *what, const char *detail)
{
    fprintf(stderr, "mkimage: %s%s%s\n", what, detail ? ": " : "", detail ? detail : "");
    exit(1);
}

/* run until the node has taken all its input and is waiting in KEY */
static void run_until_waiting(void)
{
    long steps = 0;
    unsigned idle = 0;
    while (idle < 64) {
        if (++steps > 200000000L) die("the node did not come back to its prompt", NULL);
        if (n.stopped) die("the node stopped on a fault", NULL);
        (void)v4_exec_step_word(&n, &es, &h);
        if (n.input_pos == n.input_len && n.p >= w_key && n.p < w_key_end) idle++; else idle = 0;
    }
}

/* every entry from xt back: no access control fields set */
static void clear_acl(v4_cell xt)
{
    for (; xt != 0; xt = n.mem[xt - 1]) n.mem[xt - 3] &= 31;
}

int main(int argc, char **argv)
{
    static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4",
                                         "numout.v4", "words.v4", "system.v4", "qmath.v4", "blocks.v4", "log.v4", "acl.v4" };
    FILE *out;
    v4_cell k, entry, faults, voc;
    unsigned count = 0;

    if (argc != 2) die("usage: mkimage OUTPUT.c", NULL);

    if (!host_load(&tx, &n, files, (unsigned)(sizeof files / sizeof files[0]))) die("the capsule does not assemble", NULL);
    if (!v4_text_finish(&tx)) die("not everything is defined", v4_text_error(&tx));
    if (v4_text_here(&tx) >= DICT_W) die("the capsule's code runs into the dictionary space", NULL);
    entry = v4_text_word(&tx, "QUIT");
    faults = v4_text_word(&tx, "(FAULTS)");
    w_key = v4_text_word(&tx, "KEY");
    w_key_end = v4_text_word(&tx, "CR");

    /* the variables, as at switch-on */
    n.mem[DP] = DICT_W * 4;
    n.mem[LATEST] = v4_text_latest(&tx);
    n.mem[STATE] = 0;
    n.mem[CFP] = CFS_W;
    n.mem[BASE] = 10;
    n.mem[FENCE] = DICT_W;
    n.mem[LOG_LEVEL] = 2;
    n.mem[CONTEXT] = LATEST;
    n.mem[CURRENT] = LATEST;
    n.mem[SRC] = TIB;

    v4_exec_reset(&es);
    v4_heat_reset(&h);
    v4_node_console_attach(&n, CONSOLE_TX);
    v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST);
    v4_node_error_attach(&n, NODE_ERROR);
    v4_node_fault_attach(&n, faults);
    v4_node_storage_attach(&n, STORAGE_REG, disk, 4);
    n.p = entry;
    run_until_waiting();

    /* The nucleus is the system as COLD finds it: COLD comes back to here,
     * and FORGET will not go below it.  What the capsules add at boot
     * (v4/system/boot.c) is above it. */
    n.mem[BOOT_CELLS] = n.mem[DP];
    n.mem[BOOT_CELLS + 1] = n.mem[LATEST];
    n.mem[FENCE] = (n.mem[DP] + 3) / 4;
    /* and nothing of the building is left behind: the terminal is the input,
     * no block is in a buffer, no word has an access control field set */
    n.mem[NODE_ERROR] = 0;
    n.mem[BLK] = 0; n.mem[SCR] = 0; n.mem[SRC] = TIB; n.mem[SRC_HOOK] = 0;
    for (k = BVARS; k < BVARS + 6; k++) n.mem[k] = 0;
    for (k = STORAGE_REG; k < STORAGE_REG + 4; k++) n.mem[k] = 0;
    for (k = BUF0_W; k < BUF0_W + 2 * 256; k++) n.mem[k] = 0;
    for (k = TIB_W; k < TIB_W + 260; k++) n.mem[k] = 0;
    for (k = WBUF_W; k < WBUF_W + WBUF_CELLS; k++) n.mem[k] = 0;
    for (k = PAD_W; k < PAD_W + 21; k++) n.mem[k] = 0;
    n.mem[TO_IN] = 0; n.mem[SPAN] = 0;
    clear_acl(n.mem[LATEST]);
    for (voc = n.mem[VOC_LINK]; voc != 0; voc = n.mem[voc + 1]) clear_acl(n.mem[voc]);
    if (!v4_node_guards_intact(&n)) die("the node's guards are damaged", NULL);

    out = fopen(argv[1], "w");
    if (!out) die("cannot write", argv[1]);
    fprintf(out, "/* Generated by v4/tools/mkimage.c from v4/capsule -- do not edit. */\n#include \"v4/image.h\"\n\n");
    fprintf(out, "static const v4_image_cell cells[] = {\n");
    for (k = 0; k < (v4_cell)V4_NODE_WORDS; k++)
        if (n.mem[k] != 0) {
            fprintf(out, "    { %ld, (v4_cell)0x%llxULL },\n", (long)k, (unsigned long long)(v4_ucell)n.mem[k]);
            count++;
        }
    fprintf(out, "};\n\nconst v4_image v4_capsule_image = {\n    cells, %uu,\n    %uu, %uu, %uu, %uu,\n", count,
            (unsigned)V4_CELL_BITS, (unsigned)V4_NODE_WORDS, (unsigned)V4_DATA_RING, (unsigned)V4_RET_RING);
    fprintf(out, "    %ld, %ld,\n    %ld, %ld,\n", (long)entry, (long)faults, (long)w_key, (long)w_key_end);
    fprintf(out, "    %ld, %ld, %ld,\n    %ld, %ld,\n    %ld,\n    %ld,\n    %ld, %ld\n};\n", (long)CONSOLE_TX, (long)CONSOLE_RX, (long)CONSOLE_ST,
            (long)DSTACK_REG, (long)RSTACK_REG, (long)NODE_ERROR, (long)STORAGE_REG, (long)DP, (long)LATEST);
    if (fclose(out) != 0) die("cannot write", argv[1]);
    fprintf(stderr, "mkimage: %u words of memory, dictionary to word %ld, %d-bit cells -> %s\n", count, (long)((n.mem[DP] + 3) / 4), V4_CELL_BITS, argv[1]);
    return 0;
}