LithosAnanake/v4/src/exec.c

/* exec.c -- instruction execution.  See exec.h.
 *
 * All cell arithmetic is done in v4_ucell and converted back.  Signed overflow
 * is undefined behaviour in C99 and a right shift of a negative value is
 * implementation-defined, and a golden model cannot have either: the hardware
 * wraps, so the model wraps, on every host and at every optimisation level.
 */
#include "v4/exec.h"

static v4_cell add_wrap(v4_cell x, v4_cell y)
{
    return (v4_cell)((v4_ucell)x + (v4_ucell)y);
}

/* Arithmetic shift right by one: the sign bit is kept. */
static v4_cell asr1(v4_cell x)
{
    v4_ucell u = (v4_ucell)x;
    return (v4_cell)((u >> 1) | (u & V4_MSB));
}

/* An instruction word occupies the low 32 bits of a cell at every cell width
 * (DECOMPOSITION.md D-9). */
static v4_iword fetch_iword(const v4_node *n, v4_cell addr)
{
    return (v4_iword)((v4_ucell)v4_node_load(n, addr) & 0xFFFFFFFFu);
}

/* Opcodes after which no further slot of the word executes.  The five branch
 * opcodes end it because everything to their right is address, taken or not.
 * `;` and `ex` end it because P has been replaced, as on the F18.  `unext` is
 * not in this set: when its loop finishes it falls through to the next slot. */
static int ends_word(unsigned op)
{
    return v4_op_is_branch(op) || op == V4_OP_SEMI || op == V4_OP_EX;
}

void v4_exec_reset(v4_exec_state *es)
{
    es->anticlock = 0;
}

void v4_exec_op(v4_node *n, v4_exec_state *es, v4_heat *h,
                unsigned op, v4_iword w, unsigned slot)
{
    v4_dstack *ds = &n->ds;
    v4_rstack *rs = &n->rs;
    v4_cell x;

    switch (op) {
    case V4_OP_SEMI:
        n->p = v4_rstack_pop(rs);
        break;
    case V4_OP_EX:
        x = rs->r;
        rs->r = n->p;
        n->p = x;
        break;
    case V4_OP_JUMP:
        n->p = v4_iword_branch(n->p, w, slot);
        break;
    case V4_OP_CALL:
        x = v4_iword_branch(n->p, w, slot);
        v4_rstack_push(rs, n->p);
        v4_heat_on_call(h, x);
        n->p = x;
        break;
    case V4_OP_UNEXT:
        /* The restart at slot 0 is v4_exec_step_word's business; this is only
         * the effect on R. */
        if (rs->r != 0) rs->r = add_wrap(rs->r, -1);
        else (void)v4_rstack_pop(rs);
        break;
    case V4_OP_NEXT:
        if (rs->r != 0) {
            rs->r = add_wrap(rs->r, -1);
            n->p = v4_iword_branch(n->p, w, slot);
        } else {
            (void)v4_rstack_pop(rs);
        }
        break;
    case V4_OP_IF:                      /* does not pop T */
        if (ds->t == 0) n->p = v4_iword_branch(n->p, w, slot);
        break;
    case V4_OP_MINUS_IF:                /* does not pop T */
        if (((v4_ucell)ds->t & V4_MSB) == 0) n->p = v4_iword_branch(n->p, w, slot);
        break;

    case V4_OP_FETCH_P:
        v4_dstack_push(ds, v4_node_load(n, n->p));
        n->p = add_wrap(n->p, 1);
        break;
    case V4_OP_FETCH_INC:
        v4_dstack_push(ds, v4_node_load(n, n->a));
        n->a = add_wrap(n->a, 1);
        break;
    case V4_OP_FETCH_B:
        v4_dstack_push(ds, v4_node_load(n, n->b));
        break;
    case V4_OP_FETCH_A:
        v4_dstack_push(ds, v4_node_load(n, n->a));
        break;
    case V4_OP_STORE_P:
        v4_node_store(n, n->p, v4_dstack_pop(ds));
        n->p = add_wrap(n->p, 1);
        break;
    case V4_OP_STORE_INC:
        v4_node_store(n, n->a, v4_dstack_pop(ds));
        n->a = add_wrap(n->a, 1);
        break;
    case V4_OP_STORE_B:
        v4_node_store(n, n->b, v4_dstack_pop(ds));
        break;
    case V4_OP_STORE_A:
        v4_node_store(n, n->a, v4_dstack_pop(ds));
        break;

    case V4_OP_MUL_STEP:
        /* D-3, plain F18: the carry out of T+S is not kept.  T:A then shifts
         * right one bit, T keeping its sign bit and T's bit 0 entering the top
         * of A.  S is not consumed. */
        x = ds->t;
        if ((v4_ucell)n->a & 1u) x = add_wrap(x, ds->s);
        n->a = (v4_cell)(((v4_ucell)n->a >> 1)
                         | (((v4_ucell)x & 1u) << (V4_CELL_BITS - 1)));
        ds->t = asr1(x);
        break;
    case V4_OP_TWO_STAR:
        ds->t = (v4_cell)((v4_ucell)ds->t << 1);
        break;
    case V4_OP_TWO_SLASH:
        ds->t = asr1(ds->t);
        break;
    case V4_OP_INV:
        ds->t = (v4_cell)~(v4_ucell)ds->t;
        break;
    case V4_OP_ADD:
        x = v4_dstack_pop(ds);          /* old T; T is now old S */
        ds->t = add_wrap(ds->t, x);
        break;
    case V4_OP_AND:
        x = v4_dstack_pop(ds);
        ds->t = (v4_cell)((v4_ucell)ds->t & (v4_ucell)x);
        break;
    case V4_OP_XOR:
        x = v4_dstack_pop(ds);
        ds->t = (v4_cell)((v4_ucell)ds->t ^ (v4_ucell)x);
        break;
    case V4_OP_DROP:
        (void)v4_dstack_pop(ds);
        break;
    case V4_OP_DUP:
        v4_dstack_push(ds, ds->t);
        break;
    case V4_OP_RPOP:
        v4_dstack_push(ds, v4_rstack_pop(rs));
        break;
    case V4_OP_OVER:
        v4_dstack_push(ds, ds->s);
        break;
    case V4_OP_PUSH_A:
        v4_dstack_push(ds, n->a);
        break;
    case V4_OP_NOP:
        break;
    case V4_OP_PUSH:
        v4_rstack_push(rs, v4_dstack_pop(ds));
        break;
    case V4_OP_BANG_B:
        n->b = v4_dstack_pop(ds);
        break;
    case V4_OP_BANG_A:
        n->a = v4_dstack_pop(ds);
        break;
    default:
        return;                         /* not an opcode: nothing retires */
    }

    v4_heat_on_retire(h, op, &es->anticlock);
}

unsigned v4_exec_step_word(v4_node *n, v4_exec_state *es, v4_heat *h)
{
    v4_iword iw = fetch_iword(n, n->p);
    unsigned executed = 0;
    unsigned slot = 0;

    n->p = add_wrap(n->p, 1);

    while (slot < V4_SLOT_COUNT) {
        unsigned op = v4_iword_op(iw, slot);
        /* Decided before the opcode runs, because running it changes R. */
        int again = (op == V4_OP_UNEXT) && (n->rs.r != 0);

        v4_exec_op(n, es, h, op, iw, slot);
        executed++;

        if (again) {
            /* Same word, slot 0, no refetch and P untouched: an `@p` or `!p`
             * inside a unext loop therefore walks the words that follow, as
             * it does on the F18. */
            slot = 0;
            continue;
        }
        if (ends_word(op)) break;
        slot++;
    }
    return executed;
}