janet/core/asm.c

/*
* Copyright (c) 2017 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/

#include <setjmp.h>

#include <dst/dst.h>
#include "opcodes.h"

/* Bytecode op argument types */

/* s - a slot */
/* c - a constant */
/* i - a small integer */
/* t - a type (have a simple type for non unions) */
/* l - a label */

typedef enum DstOpArgType DstOpArgType;
enum DstOpArgType {
    DST_OAT_SLOT,
    DST_OAT_ENVIRONMENT,
    DST_OAT_CONSTANT,
    DST_OAT_INTEGER,
    DST_OAT_TYPE,
    DST_OAT_SIMPLETYPE,
    DST_OAT_LABEL
};

/* Convert a slot to to an integer for bytecode */

/* Types of instructions */
/* _0arg - op.---.--.-- (return-nil, noop, vararg arguments) 
 * _s - op.src.--.-- (push1)
 * _l - op.XX.XX.XX (jump)
 * _ss - op.dest.XX.XX (move, swap)
 * _sl - op.check.XX.XX (jump-if)
 * _st - op.check.TT.TT (typecheck)
 * _si - op.dest.XX.XX (load-integer)
 * _sss - op.dest.op1.op2 (add, subtract, arithmetic, comparison)
 * _ses - op.dest.up.which (load-upvalue, save-upvalue)
 * _sc - op.dest.CC.CC (load-constant, closure)
 */

/* Various types of instructions */
typedef enum DstInstructionType DstInstructionType;
enum DstInstructionType {
    DIT_0, /* No args */
    DIT_S, /* One slot */
    DIT_L, /* One label */
    DIT_SS, /* Two slots */
    DIT_SL,
    DIT_ST,
    DIT_SI,
    DIT_SU, /* Unsigned */
    DIT_SSS,
    DIT_SSI,
    DIT_SSU,
    DIT_SES,
    DIT_SC
};

/* Definition for an instruction in the assembler */
typedef struct DstInstructionDef DstInstructionDef;
struct DstInstructionDef {
    const char *name;
    DstInstructionType type;
    DstOpCode opcode;
};

/* Hold all state needed during assembly */
typedef struct DstAssembler DstAssembler;
struct DstAssembler {
    DstAssembler *parent;
    DstFuncDef *def;
    jmp_buf on_error;
    const uint8_t *errmessage;
    const DstValue *errmap;

    int32_t environments_capacity;
    int32_t bytecode_count; /* Used for calculating labels */

    DstTable labels; /* symbol -> bytecode index */
    DstTable constants; /* symbol -> constant index */
    DstTable slots; /* symbol -> slot index */
    DstTable envs; /* symbol -> environment index */
};

/* Dst opcode descriptions in lexographic order. This
 * allows a binary search over the elements to find the
 * correct opcode given a name. This works in reasonable
 * time and is easier to setup statically than a hash table or
 * prefix tree. */
static const DstInstructionDef dst_ops[] = {
    {"add", DIT_SSS, DOP_ADD},
    {"add-immediate", DIT_SSI, DOP_ADD_IMMEDIATE},
    {"add-integer", DIT_SSS, DOP_ADD_INTEGER},
    {"add-real", DIT_SSS, DOP_ADD_REAL},
    {"bitand", DIT_SSS, DOP_BAND},
    {"bitnot", DIT_SS, DOP_BNOT},
    {"bitor", DIT_SSS, DOP_BOR},
    {"bitxor", DIT_SSS, DOP_BXOR},
    {"call", DIT_SS, DOP_CALL},
    {"closure", DIT_SC, DOP_CLOSURE},
    {"compare", DIT_SSS, DOP_COMPARE},
    {"divide", DIT_SSS, DOP_DIVIDE},
    {"divide-immediate", DIT_SSI, DOP_DIVIDE_IMMEDIATE},
    {"divide-integer", DIT_SSS, DOP_DIVIDE_INTEGER},
    {"divide-real", DIT_SSS, DOP_DIVIDE_REAL},
    {"equals", DIT_SSS, DOP_EQUALS},
    {"error", DIT_S, DOP_ERROR},
    {"get", DIT_SSS, DOP_GET},
    {"get-index", DIT_SSU, DOP_GET_INDEX},
    {"greater-than", DIT_SSS, DOP_GREATER_THAN},
    {"jump", DIT_L, DOP_JUMP},
    {"jump-if", DIT_SL, DOP_JUMP_IF},
    {"jump-if-not", DIT_SL, DOP_JUMP_IF_NOT},
    {"less-than", DIT_SSS, DOP_LESS_THAN},
    {"load-constant", DIT_SC, DOP_LOAD_CONSTANT},
    {"load-false", DIT_S, DOP_LOAD_FALSE},
    {"load-integer", DIT_SI, DOP_LOAD_INTEGER},
    {"load-nil", DIT_S, DOP_LOAD_NIL},
    {"load-self", DIT_S, DOP_LOAD_SELF},
    {"load-syscall", DIT_SU, DOP_LOAD_SYSCALL},
    {"load-true", DIT_S, DOP_LOAD_TRUE},
    {"load-upvalue", DIT_SES, DOP_LOAD_UPVALUE},
    {"move-far", DIT_SS, DOP_MOVE_FAR},
    {"move-near", DIT_SS, DOP_MOVE_NEAR},
    {"multiply", DIT_SSS, DOP_MULTIPLY},
    {"multiply-immediate", DIT_SSI, DOP_MULTIPLY_IMMEDIATE},
    {"multiply-integer", DIT_SSS, DOP_MULTIPLY_INTEGER},
    {"multiply-real", DIT_SSS, DOP_MULTIPLY_REAL},
    {"noop", DIT_0, DOP_NOOP},
    {"push", DIT_S, DOP_PUSH},
    {"push-array", DIT_S, DOP_PUSH_ARRAY},
    {"push2", DIT_SS, DOP_PUSH_2},
    {"push3", DIT_SSS, DOP_PUSH_3},
    {"put", DIT_SSS, DOP_PUT},
    {"put-index", DIT_SSU, DOP_PUT_INDEX},
    {"return", DIT_S, DOP_RETURN},
    {"return-nil", DIT_0, DOP_RETURN_NIL},
    {"set-upvalue", DIT_SES, DOP_SET_UPVALUE},
    {"shift-left", DIT_SSS, DOP_SHIFT_LEFT},
    {"shift-left-immediate", DIT_SSI, DOP_SHIFT_LEFT_IMMEDIATE},
    {"shift-right", DIT_SSS, DOP_SHIFT_RIGHT},
    {"shift-right-immediate", DIT_SSI, DOP_SHIFT_RIGHT_IMMEDIATE},
    {"shift-right-unsigned", DIT_SSS, DOP_SHIFT_RIGHT_UNSIGNED},
    {"shift-right-unsigned-immediate", DIT_SSS, DOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE},
    {"subtract", DIT_SSS, 0x1F},
    {"syscall", DIT_SU, DOP_SYSCALL},
    {"tailcall", DIT_S, DOP_TAILCALL},
    {"transfer", DIT_SSS, DOP_TRANSFER},
    {"typecheck", DIT_ST, DOP_TYPECHECK},
};

/* Compare a DST string to a native 0 terminated c string. Used in the 
 * binary search for the instruction definition. */
static int dst_strcompare(const uint8_t *str, const char *other) {
    int32_t len = dst_string_length(str);
    int32_t index;
    for (index = 0; index < len; index++) {
        uint8_t c = str[index];
        uint8_t k = ((const uint8_t *)other)[index];
        if (c < k) return -1;
        if (c > k) return 1;
        if (k == '\0') break;
    }
    return (other[index] == '\0') ? 0 : -1;
}

/* Find an instruction definition given its name */
static const DstInstructionDef *dst_findi(const uint8_t *key) {
    const DstInstructionDef *low = dst_ops;
    const DstInstructionDef *hi = dst_ops + (sizeof(dst_ops) / sizeof(DstInstructionDef));
    while (low < hi) {
        const DstInstructionDef *mid = low + ((hi - low) / 2);
        int comp = dst_strcompare(key, mid->name);
        if (comp < 0) {
            hi = mid;
        } else if (comp > 0) {
            low = mid + 1;
        } else {
            return mid;
        }
    }
    return NULL;
}

/* Check a dst string against a bunch of test_strings. Return the 
 * index of the matching test_string, or -1 if not found. */
static int32_t strsearch(const uint8_t *str, const char **test_strings) {
    int32_t len = dst_string_length(str);
    int index;
    for (index = 0; ; index++) {
        int32_t i;
        const char *testword = test_strings[index];
        if (NULL == testword)
            break;
        for (i = 0; i < len; i++) {
            if (testword[i] != str[i])
                goto nextword;
        }
        return index;
        nextword:
            continue;
    }
    return -1;
}

/* Deinitialize an Assembler. Does not deinitialize the parents. */
static void dst_asm_deinit(DstAssembler *a) {
    dst_table_deinit(&a->slots);
    dst_table_deinit(&a->labels);
    dst_table_deinit(&a->envs);
    dst_table_deinit(&a->constants);
}

/* Throw some kind of assembly error */
static void dst_asm_error(DstAssembler *a, const DstValue *map, const char *message) {
    a->errmessage = dst_cstring(message);
    a->errmap = map;
    longjmp(a->on_error, 1);
}
#define dst_asm_assert(a, c, map, m) do { if (!(c)) dst_asm_error((a), (map), (m)); } while (0)

/* Throw some kind of assembly error */
static void dst_asm_errorv(DstAssembler *a, const DstValue *map, const uint8_t *m) {
    a->errmessage = m;
    a->errmap = map;
    longjmp(a->on_error, 1);
}

/* Parse an argument to an assembly instruction, and return the result as an
 * integer. This integer will need to be trimmed and bound checked. */
static int32_t doarg_1(
        DstAssembler *a,
        const DstValue *map,
        DstOpArgType argtype,
        DstValue x) {
    int32_t ret = -1;
    DstTable *c;
    switch (argtype) {
        case DST_OAT_SLOT:
            c = &a->slots;
            break;
        case DST_OAT_ENVIRONMENT:
            c = &a->envs;
            break;
        case DST_OAT_CONSTANT:
            c = &a->constants;
            break;
        case DST_OAT_INTEGER:
            c = NULL;
            break;
        case DST_OAT_TYPE:
        case DST_OAT_SIMPLETYPE:
            c = NULL;
            break;
        case DST_OAT_LABEL:
            c = &a->labels;
            break;
    }
    switch (dst_type(x)) {
        default:
            goto error;
            break;
        case DST_INTEGER:
            ret = dst_unwrap_integer(x);
            break;
        case DST_TUPLE:
        {
            const DstValue *t = dst_unwrap_tuple(x);
            if (argtype == DST_OAT_TYPE) {
                int32_t i = 0;
                ret = 0;
                for (i = 0; i < dst_tuple_length(t); i++) {
                    ret |= doarg_1(a, map, DST_OAT_SIMPLETYPE, t[i]);
                }
            } else {
                goto error;
            }
            break;
        }
        case DST_SYMBOL:
        {
            if (NULL != c) {
                DstValue result = dst_table_get(c, x);
                if (dst_checktype(result, DST_INTEGER)) {
                    if (argtype == DST_OAT_LABEL) {
                        ret = dst_unwrap_integer(result) - a->bytecode_count;
                    } else {
                        ret = dst_unwrap_integer(result);
                    }
                } else {
                    dst_asm_errorv(a, map, dst_formatc("unknown name %q", x));
                }
            } else if (argtype == DST_OAT_TYPE || argtype == DST_OAT_SIMPLETYPE) {
                int32_t index = strsearch(dst_unwrap_symbol(x), dst_type_names);
                if (index != -1) {
                    ret = index;
                } else {
                    dst_asm_errorv(a, map, dst_formatc("unknown type %q", x));
                }
            } else {
                goto error;
            }
            break;
        }
    }
    if (argtype == DST_OAT_SLOT && ret >= a->def->slotcount)
        a->def->slotcount = (int32_t) ret + 1;
    return ret;

    error:
    dst_asm_errorv(a, map, dst_formatc("error parsing instruction argument %v", x));
    return 0;
}

/* Parse a single argument to an instruction. Trims it as well as
 * try to convert arguments to bit patterns */
static uint32_t doarg(
        DstAssembler *a,
        const DstValue *map,
        DstOpArgType argtype,
        int nth,
        int nbytes,
        int hassign,
        DstValue x) {
    int32_t arg = doarg_1(a, map, argtype, x);
    /* Calculate the min and max values that can be stored given
     * nbytes, and whether or not the storage is signed */
    int32_t min = (-hassign) << ((nbytes << 3) - 1);
    int32_t max = ~((-1) << ((nbytes << 3) - hassign));
    if (arg < min)
        dst_asm_errorv(a, map, dst_formatc("instruction argument %v is too small, must be %d byte%s",
                    x, nbytes, nbytes > 1 ? "s" : ""));
    if (arg > max)
        dst_asm_errorv(a, map, dst_formatc("instruction argument %v is too large, must be %d byte%s",
                    x, nbytes, nbytes > 1 ? "s" : ""));
    return ((uint32_t) arg) << (nth << 3);
}

/* Provide parsing methods for the different kinds of arguments */
static uint32_t read_instruction(
        DstAssembler *a, 
        const DstValue *map,
        const DstInstructionDef *idef,
        const DstValue *argt) {
    uint32_t instr = idef->opcode;
    switch (idef->type) {
        case DIT_0:
        {
            if (dst_tuple_length(argt) != 1)
                dst_asm_error(a, map, "expected 0 arguments: (op)");
            break;
        }
        case DIT_S:
        {
            if (dst_tuple_length(argt) != 2)
                dst_asm_error(a, map, "expected 1 argument: (op, slot)");
            instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 3, 0, argt[1]);
            break;
        }
        case DIT_L:
        {
            if (dst_tuple_length(argt) != 2)
                dst_asm_error(a, map, "expected 1 argument: (op, label)");
            instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_LABEL, 1, 3, 1, argt[1]);
            break;
        }
        case DIT_SS:
        {
            if (dst_tuple_length(argt) != 3)
                dst_asm_error(a, map, "expected 2 arguments: (op, slot, slot)");
            instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
            instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_SLOT, 2, 2, 0, argt[2]);
            break;
        }
        case DIT_SL:
        {
            if (dst_tuple_length(argt) != 3)
                dst_asm_error(a, map, "expected 2 arguments: (op, slot, label)");
            instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
            instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_LABEL, 2, 2, 1, argt[2]);
            break;
        }
        case DIT_ST:
        {
            if (dst_tuple_length(argt) != 3)
                dst_asm_error(a, map, "expected 2 arguments: (op, slot, type)");
            instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
            instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_TYPE, 2, 2, 0, argt[2]);
            break;
        }
        case DIT_SI:
        case DIT_SU:
        {
            if (dst_tuple_length(argt) != 3)
                dst_asm_error(a, map, "expected 2 arguments: (op, slot, integer)");
            instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
            instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_INTEGER, 2, 2, idef->type == DIT_SI, argt[2]);
            break;
        }
        case DIT_SSS:
        {
            if (dst_tuple_length(argt) != 4)
                dst_asm_error(a, map, "expected 3 arguments: (op, slot, slot, slot)");
            instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
            instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_SLOT, 2, 1, 0, argt[2]);
            instr |= doarg(a, dst_parse_submap_index(map, 3), DST_OAT_SLOT, 3, 1, 0, argt[3]);
            break;
        }
        case DIT_SSI:
        case DIT_SSU:
        {
            if (dst_tuple_length(argt) != 4)
                dst_asm_error(a, map, "expected 3 arguments: (op, slot, slot, integer)");
            instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
            instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_SLOT, 2, 1, 0, argt[2]);
            instr |= doarg(a, dst_parse_submap_index(map, 3), DST_OAT_INTEGER, 3, 1, idef->type == DIT_SSI, argt[3]);
            break;
        }
        case DIT_SES:
        {
            DstAssembler *b = a;
            uint32_t env;
            if (dst_tuple_length(argt) != 4)
                dst_asm_error(a, map, "expected 3 arguments: (op, slot, environment, envslot)");
            instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
            env = doarg(a, dst_parse_submap_index(map, 2), DST_OAT_ENVIRONMENT, 0, 1, 0, argt[2]);
            instr |= env << 16;
            for (env += 1; env > 0; env--) {
                b = b->parent;
                if (NULL == b)
                    dst_asm_error(a, dst_parse_submap_index(map, 2), "invalid environment index");
            }
            instr |= doarg(b, dst_parse_submap_index(map, 3), DST_OAT_SLOT, 3, 1, 0, argt[3]);
            break;
        }
        case DIT_SC:
        {
            if (dst_tuple_length(argt) != 3)
                dst_asm_error(a, map, "expected 2 arguments: (op, slot, constant)");
            instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
            instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_CONSTANT, 2, 2, 0, argt[2]);
            break;
        }
    }
    return instr;
}

/* Add a closure environment to the assembler. Sub funcdefs may need
 * to reference outer function environments, and may change the outer environment. 
 * Returns the index of the environment in the assembler's environments, or -1
 * if not found.  */
static int32_t dst_asm_addenv(DstAssembler *a, DstValue envname) {
    DstValue check;
    DstFuncDef *def = a->def;
    int32_t oldlen;
    int64_t res;
    /* Check for memoized value */
    check = dst_table_get(&a->envs, envname);
    if (!dst_checktype(check, DST_NIL)) {
        return dst_unwrap_integer(check);
    }
    if (NULL == a->parent) {
        return -1;
    }
    res = dst_asm_addenv(a->parent, envname);
    if (res < 0)
        return res;
    oldlen = def->environments_length;
    dst_table_put(&a->envs, envname, dst_wrap_integer(def->environments_length));
    if (oldlen >= a->environments_capacity) {
        int32_t newcap = 2 + 2 * oldlen;
        def->environments = realloc(def->environments, newcap * sizeof(int32_t));
        if (NULL == def->environments) {
            DST_OUT_OF_MEMORY;
        }
        a->environments_capacity = newcap;
    }
    def->environments[def->environments_length++] = (int32_t) res;
    return (int32_t) oldlen;
}

/* Helper to assembly. Return the assembly result */
static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts) {
    DstAssembleResult result;
    DstAssembler a;
    const DstValue *st = dst_unwrap_struct(opts.source);
    DstFuncDef *def;
    int32_t count, i;
    const DstValue *arr;
    DstValue x;

    /* Initialize funcdef */
    def = dst_alloc(DST_MEMORY_FUNCDEF, sizeof(DstFuncDef));
    def->environments = NULL;
    def->constants = NULL;
    def->bytecode = NULL;
    def->flags = 0;
    def->slotcount = 0;
    def->arity = 0;
    def->source = NULL;
    def->sourcepath = NULL;
    def->sourcemap = NULL;
    def->constants_length = 0;
    def->bytecode_length = 0;
    def->environments_length = 1;

    /* Initialize Assembler */
    a.def = def;
    a.parent = parent;
    a.errmessage = NULL;
    a.environments_capacity = 0;
    a.bytecode_count = 0;
    a.errmap = NULL;
    dst_table_init(&a.labels, 10);
    dst_table_init(&a.constants, 10);
    dst_table_init(&a.slots, 10);
    dst_table_init(&a.envs, 10);

    /* Initialize result */
    result.error_start = -1;
    result.error_end = -1;

    /* Set error jump */
    if (setjmp(a.on_error)) {
        if (NULL != a.parent) {
            dst_asm_deinit(&a);
            longjmp(a.parent->on_error, 1);
        }
        result.error = a.errmessage;
        result.status = DST_ASSEMBLE_ERROR;
        if (a.errmap != NULL) {
            result.error_start = dst_unwrap_integer(a.errmap[0]);
            result.error_end = dst_unwrap_integer(a.errmap[1]);
        }
        dst_asm_deinit(&a);
        return result;
    }

    dst_asm_assert(&a, dst_checktype(opts.source, DST_STRUCT), opts.sourcemap, "expected struct for assembly source");

    /* Set function arity */
    x = dst_struct_get(st, dst_csymbolv("arity"));
    def->arity = dst_checktype(x, DST_INTEGER) ? dst_unwrap_integer(x) : 0;

    /* Check vararg */
    x = dst_struct_get(st, dst_csymbolv("vararg"));
    if (dst_truthy(x))
        def->flags |= DST_FUNCDEF_FLAG_VARARG;

    /* Check source */
    x = dst_struct_get(st, dst_csymbolv("source"));
    if (dst_checktype(x, DST_STRING)) {
        def->source = dst_unwrap_string(x);
    }

    /* Check source path */
    x = dst_struct_get(st, dst_csymbolv("sourcepath"));
    if (dst_checktype(x, DST_STRING)) {
        def->sourcepath = dst_unwrap_string(x);
    }

    /* Create slot aliases */
    x = dst_struct_get(st, dst_csymbolv("slots"));
    if (dst_seq_view(x, &arr, &count)) {
        const DstValue *slotmap = 
            dst_parse_submap_value(opts.sourcemap, dst_csymbolv("slots"));
        for (i = 0; i < count; i++) {
            const DstValue *imap = dst_parse_submap_index(slotmap, i);
            DstValue v = arr[i];
            if (dst_checktype(v, DST_TUPLE)) {
                const DstValue *t = dst_unwrap_tuple(v);
                int32_t j; 
                for (j = 0; j < dst_tuple_length(t); j++) {
                    const DstValue *tjmap = dst_parse_submap_index(imap, j);
                    if (!dst_checktype(t[j], DST_SYMBOL))
                        dst_asm_error(&a, tjmap, "slot names must be symbols");
                    dst_table_put(&a.slots, t[j], dst_wrap_integer(i));
                }
            } else if (dst_checktype(v, DST_SYMBOL)) {
                dst_table_put(&a.slots, v, dst_wrap_integer(i));
            } else {
                dst_asm_error(&a, imap, "slot names must be symbols or tuple of symbols");
            }
        }
    }

    /* Create environment aliases */
    x = dst_struct_get(st, dst_csymbolv("captures"));
    if (dst_seq_view(x, &arr, &count)) {
        const DstValue *emap =
            dst_parse_submap_value(opts.sourcemap, dst_csymbolv("captures"));
        for (i = 0; i < count; i++) {
            const DstValue *imap = dst_parse_submap_index(emap, i);
            dst_asm_assert(&a, dst_checktype(arr[i], DST_SYMBOL), imap, "environment must be a symbol");
            if (dst_asm_addenv(&a, arr[i]) < 0) {
                dst_asm_error(&a, imap, "environment not found");
            }
        }
    }

    /* Parse constants */
    x = dst_struct_get(st, dst_csymbolv("constants"));
    if (dst_seq_view(x, &arr, &count)) {
        const DstValue *cmap =
            dst_parse_submap_value(opts.sourcemap, dst_csymbolv("constants"));
        def->constants_length = count;
        def->constants = malloc(sizeof(DstValue) * count);
        if (NULL == def->constants) {
            DST_OUT_OF_MEMORY;
        }
        for (i = 0; i < count; i++) {
            const DstValue *imap = dst_parse_submap_index(cmap, i);
            DstValue ct = arr[i];
            if (dst_checktype(ct, DST_TUPLE) &&
                dst_tuple_length(dst_unwrap_tuple(ct)) > 1 &&
                dst_checktype(dst_unwrap_tuple(ct)[0], DST_SYMBOL)) {
                const DstValue *t = dst_unwrap_tuple(ct);
                int32_t tcount = dst_tuple_length(t);
                const uint8_t *macro = dst_unwrap_symbol(t[0]);
                if (0 == dst_strcompare(macro, "quote")) {
                    def->constants[i] = t[1];
                } else if (tcount == 3 &&
                        dst_checktype(t[1], DST_SYMBOL) &&
                        0 == dst_strcompare(macro, "def")) {
                    def->constants[i] = t[2];
                    dst_table_put(&a.constants, t[1], dst_wrap_integer(i));
                } else {
                    dst_asm_errorv(&a, imap, dst_formatc("could not parse constant \"%v\"", ct));
                }
                /* Todo - parse nested funcdefs */
            } else {
                def->constants[i] = ct;
            }
        }
    } else {
        def->constants = NULL;
        def->constants_length = 0;
    }

    /* Parse bytecode and labels */
    x = dst_struct_get(st, dst_csymbolv("bytecode"));
    if (dst_seq_view(x, &arr, &count)) {
        const DstValue *bmap =
            dst_parse_submap_value(opts.sourcemap, dst_csymbolv("bytecode"));
        /* Do labels and find length */
        int32_t blength = 0;
        for (i = 0; i < count; ++i) {
            const DstValue *imap = dst_parse_submap_index(bmap, i);
            DstValue instr = arr[i];
            if (dst_checktype(instr, DST_SYMBOL)) {
                dst_table_put(&a.labels, instr, dst_wrap_integer(blength));
            } else if (dst_checktype(instr, DST_TUPLE)) {
                blength++;
            } else {
                dst_asm_error(&a, imap, "expected assembly instruction");
            }
        }
        /* Allocate bytecode array */
        def->bytecode_length = blength;
        def->bytecode = malloc(sizeof(int32_t) * blength);
        if (NULL == def->bytecode) {
            DST_OUT_OF_MEMORY;
        }
        /* Do bytecode */
        for (i = 0; i < count; ++i) {
            const DstValue *imap = dst_parse_submap_index(bmap, i);
            DstValue instr = arr[i];
            if (dst_checktype(instr, DST_SYMBOL)) {
                continue;
            } else {
                uint32_t op;
                const DstInstructionDef *idef;
                const DstValue *t;
                dst_asm_assert(&a, dst_checktype(instr, DST_TUPLE), imap, "expected tuple");
                t = dst_unwrap_tuple(instr);
                if (dst_tuple_length(t) == 0) {
                    op = 0;
                } else {
                    dst_asm_assert(&a, dst_checktype(t[0], DST_SYMBOL), imap,
                            "expected symbol in assembly instruction");
                    idef = dst_findi(dst_unwrap_symbol(t[0]));
                    if (NULL == idef)
                        dst_asm_errorv(&a, imap, dst_formatc("unknown instruction %v", instr));
                    op = read_instruction(&a, imap, idef, t);
                }
                def->bytecode[a.bytecode_count++] = op;
            }
        }
    } else {
        dst_asm_error(&a, opts.sourcemap, "bytecode expected");
    }
    
    /* Check for source mapping */
    x = dst_struct_get(st, dst_csymbolv("sourcemap"));
    if (dst_seq_view(x, &arr, &count)) {
        const DstValue *bmap =
            dst_parse_submap_value(opts.sourcemap, dst_csymbolv("sourcemap"));
        dst_asm_assert(&a, count != 2 * def->bytecode_length, bmap, "sourcemap must have twice the length of the bytecode");
        def->sourcemap = malloc(sizeof(int32_t) * 2 * count);
        for (i = 0; i < count; i += 2) {
            DstValue start = arr[i];
            DstValue end = arr[i + 1];
            if (!(dst_checktype(start, DST_INTEGER) ||
                dst_unwrap_integer(start) < 0)) {
                const DstValue *submap = dst_parse_submap_index(bmap, i);
                dst_asm_error(&a, submap, "expected positive integer");
            }
            if (!(dst_checktype(end, DST_INTEGER) ||
                dst_unwrap_integer(end) < 0)) {
                const DstValue *submap = dst_parse_submap_index(bmap, i + 1);
                dst_asm_error(&a, submap, "expected positive integer");
            }
            def->sourcemap[i] = dst_unwrap_integer(start);
            def->sourcemap[i+1] = dst_unwrap_integer(end);
        }

    }

    /* Finish everything and return funcdef */
    dst_asm_deinit(&a);
    def->environments =
        realloc(def->environments, def->environments_length * sizeof(int32_t));
    result.funcdef = def;
    result.status = DST_ASSEMBLE_OK;
    return result;
}

/* Assemble a function */
DstAssembleResult dst_asm(DstAssembleOptions opts) {
    return dst_asm1(NULL, opts);
}

/* Build a function from the result */
DstFunction *dst_asm_func(DstAssembleResult result) {
    if (result.status != DST_ASSEMBLE_OK) {
        return NULL;
    }
    DstFunction *func = dst_alloc(DST_MEMORY_FUNCTION, sizeof(DstFunction));
    func->def = result.funcdef;
    func->envs = NULL;
    return func;
}

/* Disassembly */

/* Find the deinfintion of an instruction given the instruction word. Return
 * NULL if not found. */
static const DstInstructionDef *dst_asm_reverse_lookup(uint32_t instr) {
    size_t i;
    uint32_t opcode = instr & 0xFF;
    for (i = 0; i < sizeof(dst_ops)/sizeof(DstInstructionDef); i++) {
        const DstInstructionDef *def = dst_ops + i;
        if (def->opcode == opcode) 
            return def;
    }
    return NULL;
}

/* Create some constant sized tuples */
static DstValue tup1(DstValue x) {
    DstValue *tup = dst_tuple_begin(1);
    tup[0] = x;
    return dst_wrap_tuple(dst_tuple_end(tup));
}
static DstValue tup2(DstValue x, DstValue y) {
    DstValue *tup = dst_tuple_begin(2);
    tup[0] = x;
    tup[1] = y;
    return dst_wrap_tuple(dst_tuple_end(tup));
}
static DstValue tup3(DstValue x, DstValue y, DstValue z) {
    DstValue *tup = dst_tuple_begin(3);
    tup[0] = x;
    tup[1] = y;
    tup[2] = z;
    return dst_wrap_tuple(dst_tuple_end(tup));
}
static DstValue tup4(DstValue w, DstValue x, DstValue y, DstValue z) {
    DstValue *tup = dst_tuple_begin(4);
    tup[0] = w;
    tup[1] = x;
    tup[2] = y;
    tup[3] = z;
    return dst_wrap_tuple(dst_tuple_end(tup));
}

/* Given an argument, convert it to the appriate integer or symbol */
static DstValue dst_asm_decode_instruction(uint32_t instr) {
    const DstInstructionDef *def = dst_asm_reverse_lookup(instr);
    DstValue name;
    if (NULL == def) {
        return dst_wrap_integer((int32_t)instr);
    }
    name = dst_csymbolv(def->name);
#define oparg(shift, mask) ((instr >> ((shift) << 3)) & (mask))
    switch (def->type) {
        case DIT_0:
            return tup1(name);
        case DIT_S:
            return tup2(name, dst_wrap_integer(oparg(1, 0xFFFFFF)));
        case DIT_L:
            return tup2(name, dst_wrap_integer((int32_t)instr >> 8));
        case DIT_SS:
        case DIT_ST:
        case DIT_SC:
        case DIT_SU:
            return tup3(name, 
                    dst_wrap_integer(oparg(1, 0xFF)),
                    dst_wrap_integer(oparg(2, 0xFFFF)));
        case DIT_SI:
        case DIT_SL:
            return tup3(name, 
                    dst_wrap_integer(oparg(1, 0xFF)),
                    dst_wrap_integer((int32_t)instr >> 16));
        case DIT_SSS:
        case DIT_SES:
        case DIT_SSU:
            return tup4(name, 
                    dst_wrap_integer(oparg(1, 0xFF)),
                    dst_wrap_integer(oparg(2, 0xFF)),
                    dst_wrap_integer(oparg(3, 0xFF)));
        case DIT_SSI:
            return tup4(name, 
                    dst_wrap_integer(oparg(1, 0xFF)),
                    dst_wrap_integer(oparg(2, 0xFF)),
                    dst_wrap_integer((int32_t)instr >> 24));
    }
#undef oparg
}

DstValue dst_disasm(DstFuncDef *def) {
    int32_t i;
    DstArray *bcode = dst_array(def->bytecode_length);
    DstArray *constants = dst_array(def->constants_length);
    DstTable *ret = dst_table(10);
    dst_table_put(ret, dst_csymbolv("arity"), dst_wrap_integer(def->arity));
    dst_table_put(ret, dst_csymbolv("bytecode"), dst_wrap_array(bcode));
    dst_table_put(ret, dst_csymbolv("constants"), dst_wrap_array(constants));
    if (def->sourcepath) {
        dst_table_put(ret, dst_csymbolv("sourcepath"), dst_wrap_string(def->sourcepath));
    }
    if (def->source) {
        dst_table_put(ret, dst_csymbolv("source"), dst_wrap_string(def->source));
    }
    if (def->flags & DST_FUNCDEF_FLAG_VARARG) {
        dst_table_put(ret, dst_csymbolv("vararg"), dst_wrap_true());
    }

    /* Add constants */
    for (i = 0; i < def->constants_length; i++) {
        DstValue src = def->constants[i];
        DstValue dest;
        if (dst_checktype(src, DST_TUPLE)) {
            dest = tup2(dst_csymbolv("quote"), src);
        } else {
            dest = src;
        }
        constants->data[i] = dest;
    }
    constants->count = def->constants_length;

    /* Add bytecode */
    for (i = 0; i < def->bytecode_length; i++) {
        bcode->data[i] = dst_asm_decode_instruction(def->bytecode[i]);
    }
    bcode->count = def->bytecode_length;

    /* Add source map */
    if (def->sourcemap) {
        DstArray *sourcemap = dst_array(def->bytecode_length * 2);
        for (i = 0; i < def->bytecode_length * 2; i++) {
            sourcemap->data[i] = dst_wrap_integer(def->sourcemap[i]);
        }
        sourcemap->count = def->bytecode_length * 2;
        dst_table_put(ret, dst_csymbolv("sourcemap"), dst_wrap_array(sourcemap));
    }

    /* Add environments */
    if (def->environments) {
        DstArray *envs = dst_array(def->environments_length);
        for (i = 0; i < def->environments_length; i++) {
            envs->data[i] = dst_wrap_integer(def->environments[i]);
        }
        envs->count = def->environments_length;
        dst_table_put(ret, dst_csymbolv("environments"), dst_wrap_array(envs));
    }

    return dst_wrap_struct(dst_table_to_struct(ret));
}