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

/* D-14: an address outside memory is a fault, and the opcode does nothing. */
static int faulted(v4_node *n, v4_cell addr)
{
    if (v4_node_addr_ok(addr)) return 0;
    v4_node_fault(n, V4_FAULT_ADDRESS, addr);
    return 1;
}

/* D-16: what each opcode takes from the stacks and leaves on them.  If the
 * data stack holds fewer than `dneed`, or the return stack fewer than
 * `rneed`, or a stack the opcode leaves one more on is full, it is a fault
 * and the opcode does nothing.  An opcode that only looks at T (`if`) or at
 * T and S (`+*`) needs them to be there. */
static int stack_faulted(v4_node *n, unsigned op)
{
    unsigned dneed = 0, rneed = 0, dgrow = 0, rgrow = 0;

    switch (op) {
    case V4_OP_SEMI: case V4_OP_EX: case V4_OP_UNEXT: case V4_OP_NEXT:
        rneed = 1; break;
    case V4_OP_CALL:
        rgrow = 1; break;
    case V4_OP_FETCH_P: case V4_OP_FETCH_INC: case V4_OP_FETCH_B: case V4_OP_FETCH_A: case V4_OP_PUSH_A:
        dgrow = 1; break;
    case V4_OP_IF: case V4_OP_MINUS_IF:
    case V4_OP_STORE_P: case V4_OP_STORE_INC: case V4_OP_STORE_B: case V4_OP_STORE_A:
    case V4_OP_TWO_STAR: case V4_OP_TWO_SLASH: case V4_OP_INV: case V4_OP_DROP:
    case V4_OP_BANG_B: case V4_OP_BANG_A:
        dneed = 1; break;
    case V4_OP_MUL_STEP: case V4_OP_ADD: case V4_OP_AND: case V4_OP_XOR:
        dneed = 2; break;
    case V4_OP_DUP:
        dneed = 1; dgrow = 1; break;
    case V4_OP_OVER:
        dneed = 2; dgrow = 1; break;
    case V4_OP_RPOP:
        rneed = 1; dgrow = 1; break;
    case V4_OP_PUSH:
        dneed = 1; rgrow = 1; break;
    default:
        break;                          /* jump, nop */
    }
    if (n->ds.depth < dneed)                         { v4_node_fault(n, V4_FAULT_DATA_UNDER, 0); return 1; }
    if (n->rs.depth < rneed)                         { v4_node_fault(n, V4_FAULT_RET_UNDER, 0);  return 1; }
    if (dgrow && n->ds.depth >= V4_DATA_DEPTH)       { v4_node_fault(n, V4_FAULT_DATA_OVER, 0);  return 1; }
    if (rgrow && n->rs.depth >= V4_RET_DEPTH)        { v4_node_fault(n, V4_FAULT_RET_OVER, 0);   return 1; }
    return 0;
}

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;

    if (op <= V4_OP_BANG_A && stack_faulted(n, op)) return;

    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:
        if (faulted(n, n->p)) return;
        v4_dstack_push(ds, v4_node_load(n, n->p));
        n->p = add_wrap(n->p, 1);
        break;
    case V4_OP_FETCH_INC:
        if (faulted(n, n->a)) return;
        v4_dstack_push(ds, v4_node_fetch(n, n->a));
        n->a = add_wrap(n->a, 1);
        break;
    case V4_OP_FETCH_B:
        if (faulted(n, n->b)) return;
        v4_dstack_push(ds, v4_node_fetch(n, n->b));
        break;
    case V4_OP_FETCH_A:
        if (faulted(n, n->a)) return;
        v4_dstack_push(ds, v4_node_fetch(n, n->a));
        break;
    case V4_OP_STORE_P:
        if (faulted(n, n->p)) return;
        v4_node_store(n, n->p, v4_dstack_pop(ds));
        n->p = add_wrap(n->p, 1);
        break;
    case V4_OP_STORE_INC:
        if (faulted(n, n->a)) return;
        v4_node_store(n, n->a, v4_dstack_pop(ds));
        n->a = add_wrap(n->a, 1);
        break;
    case V4_OP_STORE_B:
        if (faulted(n, n->b)) return;
        v4_node_store(n, n->b, v4_dstack_pop(ds));
        break;
    case V4_OP_STORE_A:
        if (faulted(n, n->a)) return;
        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;
    unsigned executed = 0;
    unsigned slot = 0;

    /* D-14: a node that faulted with no handler has stopped; and P itself
     * may be what is outside memory. */
    if (n->stopped || faulted(n, n->p)) return 0;
    iw = fetch_iword(n, n->p);
    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);
        unsigned faults = n->faults;

        v4_exec_op(n, es, h, op, iw, slot);
        if (n->faults != faults) {              /* P is the handler now, or the node has stopped */
            /* a store that raised an error (D-18) did execute; any other fault means the opcode did not */
            if (n->fault_kind == V4_FAULT_RAISED) executed++;
            break;
        }
        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;
}