mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-11-15 21:24:48 +00:00
Code Issues 1 Releases Wiki Activity
5baf70f4c6
janet/src/core/asm.c
Calvin Rose c8ef2a0d88 Rename to janet
2018-09-05 22:18:42 -04:00

937 lines
32 KiB
C
Raw Blame History

/*
* Copyright (c) 2018 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 <janet/janet.h>
#include "util.h"
/* Definition for an instruction in the assembler */
typedef struct JanetInstructionDef JanetInstructionDef;
struct JanetInstructionDef {
const char *name;
enum JanetOpCode opcode;
};
/* Hold all state needed during assembly */
typedef struct JanetAssembler JanetAssembler;
struct JanetAssembler {
JanetAssembler *parent;
JanetFuncDef *def;
jmp_buf on_error;
const uint8_t *errmessage;
int32_t errindex;
int32_t environments_capacity;
int32_t defs_capacity;
int32_t bytecode_count; /* Used for calculating labels */
Janet name;
JanetTable labels; /* symbol -> bytecode index */
JanetTable constants; /* symbol -> constant index */
JanetTable slots; /* symbol -> slot index */
JanetTable envs; /* symbol -> environment index */
JanetTable defs; /* symbol -> funcdefs index */
};
/* Janet 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 JanetInstructionDef janet_ops[] = {
{"add", JOP_ADD},
{"addi", JOP_ADD_INTEGER},
{"addim", JOP_ADD_IMMEDIATE},
{"addr", JOP_ADD_REAL},
{"band", JOP_BAND},
{"bnot", JOP_BNOT},
{"bor", JOP_BOR},
{"bxor", JOP_BXOR},
{"call", JOP_CALL},
{"clo", JOP_CLOSURE},
{"cmp", JOP_COMPARE},
{"div", JOP_DIVIDE},
{"divi", JOP_DIVIDE_INTEGER},
{"divim", JOP_DIVIDE_IMMEDIATE},
{"divr", JOP_DIVIDE_REAL},
{"eq", JOP_EQUALS},
{"eqi", JOP_EQUALS_INTEGER},
{"eqim", JOP_EQUALS_IMMEDIATE},
{"eqn", JOP_NUMERIC_EQUAL},
{"eqr", JOP_EQUALS_REAL},
{"err", JOP_ERROR},
{"get", JOP_GET},
{"geti", JOP_GET_INDEX},
{"gt", JOP_GREATER_THAN},
{"gti", JOP_GREATER_THAN_INTEGER},
{"gtim", JOP_GREATER_THAN_IMMEDIATE},
{"gtn", JOP_NUMERIC_GREATER_THAN},
{"gtr", JOP_GREATER_THAN_REAL},
{"gten", JOP_NUMERIC_GREATER_THAN_EQUAL},
{"gter", JOP_GREATER_THAN_EQUAL_REAL},
{"jmp", JOP_JUMP},
{"jmpif", JOP_JUMP_IF},
{"jmpno", JOP_JUMP_IF_NOT},
{"ldc", JOP_LOAD_CONSTANT},
{"ldf", JOP_LOAD_FALSE},
{"ldi", JOP_LOAD_INTEGER},
{"ldn", JOP_LOAD_NIL},
{"lds", JOP_LOAD_SELF},
{"ldt", JOP_LOAD_TRUE},
{"ldu", JOP_LOAD_UPVALUE},
{"len", JOP_LENGTH},
{"lt", JOP_LESS_THAN},
{"lten", JOP_NUMERIC_LESS_THAN_EQUAL},
{"lter", JOP_LESS_THAN_EQUAL_REAL},
{"lti", JOP_LESS_THAN_INTEGER},
{"ltim", JOP_LESS_THAN_IMMEDIATE},
{"ltn", JOP_NUMERIC_LESS_THAN},
{"ltr", JOP_LESS_THAN_REAL},
{"mkarr", JOP_MAKE_ARRAY},
{"mkbuf", JOP_MAKE_BUFFER},
{"mkstr", JOP_MAKE_STRING},
{"mkstu", JOP_MAKE_STRUCT},
{"mktab", JOP_MAKE_TABLE},
{"mktup", JOP_MAKE_TUPLE},
{"movf", JOP_MOVE_FAR},
{"movn", JOP_MOVE_NEAR},
{"mul", JOP_MULTIPLY},
{"muli", JOP_MULTIPLY_INTEGER},
{"mulim", JOP_MULTIPLY_IMMEDIATE},
{"mulr", JOP_MULTIPLY_REAL},
{"noop", JOP_NOOP},
{"push", JOP_PUSH},
{"push2", JOP_PUSH_2},
{"push3", JOP_PUSH_3},
{"pusha", JOP_PUSH_ARRAY},
{"put", JOP_PUT},
{"puti", JOP_PUT_INDEX},
{"res", JOP_RESUME},
{"ret", JOP_RETURN},
{"retn", JOP_RETURN_NIL},
{"setu", JOP_SET_UPVALUE},
{"sig", JOP_SIGNAL},
{"sl", JOP_SHIFT_LEFT},
{"slim", JOP_SHIFT_LEFT_IMMEDIATE},
{"sr", JOP_SHIFT_RIGHT},
{"srim", JOP_SHIFT_RIGHT_IMMEDIATE},
{"sru", JOP_SHIFT_RIGHT_UNSIGNED},
{"sruim", JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE},
{"sub", JOP_SUBTRACT},
{"tcall", JOP_TAILCALL},
{"tchck", JOP_TYPECHECK}
};
/* Typename aliases for tchck instruction */
typedef struct TypeAlias {
const char *name;
int32_t mask;
} TypeAlias;
static const TypeAlias type_aliases[] = {
{":abstract", JANET_TFLAG_ABSTRACT},
{":array", JANET_TFLAG_ARRAY},
{":boolean", JANET_TFLAG_BOOLEAN},
{":buffer", JANET_TFLAG_BUFFER},
{":callable", JANET_TFLAG_CALLABLE},
{":cfunction", JANET_TFLAG_CFUNCTION},
{":dictionary", JANET_TFLAG_DICTIONARY},
{":false", JANET_TFLAG_FALSE},
{":fiber", JANET_TFLAG_FIBER},
{":function", JANET_TFLAG_FUNCTION},
{":indexed", JANET_TFLAG_INDEXED},
{":integer", JANET_TFLAG_INTEGER},
{":nil", JANET_TFLAG_NIL},
{":number", JANET_TFLAG_NUMBER},
{":real", JANET_TFLAG_REAL},
{":string", JANET_TFLAG_STRING},
{":struct", JANET_TFLAG_STRUCT},
{":symbol", JANET_TFLAG_SYMBOL},
{":table", JANET_TFLAG_BOOLEAN},
{":true", JANET_TFLAG_TRUE},
{":tuple", JANET_TFLAG_BOOLEAN}
};
/* Deinitialize an Assembler. Does not deinitialize the parents. */
static void janet_asm_deinit(JanetAssembler *a) {
janet_table_deinit(&a->slots);
janet_table_deinit(&a->labels);
janet_table_deinit(&a->envs);
janet_table_deinit(&a->constants);
janet_table_deinit(&a->defs);
}
/* Throw some kind of assembly error */
static void janet_asm_error(JanetAssembler *a, const char *message) {
a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex);
longjmp(a->on_error, 1);
}
#define janet_asm_assert(a, c, m) do { if (!(c)) janet_asm_error((a), (m)); } while (0)
/* Throw some kind of assembly error */
static void janet_asm_errorv(JanetAssembler *a, const uint8_t *m) {
a->errmessage = m;
longjmp(a->on_error, 1);
}
/* 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 janet_asm_addenv(JanetAssembler *a, Janet envname) {
Janet check;
JanetFuncDef *def = a->def;
int32_t envindex;
int32_t res;
if (janet_equals(a->name, envname)) {
return -1;
}
/* Check for memoized value */
check = janet_table_get(&a->envs, envname);
if (janet_checktype(check, JANET_INTEGER)) {
return janet_unwrap_integer(check);
}
if (NULL == a->parent) return -2;
res = janet_asm_addenv(a->parent, envname);
if (res < -1) {
return res;
}
envindex = def->environments_length;
janet_table_put(&a->envs, envname, janet_wrap_integer(envindex));
if (envindex >= a->environments_capacity) {
int32_t newcap = 2 * envindex;
def->environments = realloc(def->environments, newcap * sizeof(int32_t));
if (NULL == def->environments) {
JANET_OUT_OF_MEMORY;
}
a->environments_capacity = newcap;
}
def->environments[envindex] = (int32_t) res;
def->environments_length = envindex + 1;
return envindex;
}
/* Parse an argument to an assembly instruction, and return the result as an
* integer. This integer will need to be bounds checked. */
static int32_t doarg_1(
JanetAssembler *a,
enum JanetOpArgType argtype,
Janet x) {
int32_t ret = -1;
JanetTable *c;
switch (argtype) {
case JANET_OAT_SLOT:
c = &a->slots;
break;
case JANET_OAT_ENVIRONMENT:
c = &a->envs;
break;
case JANET_OAT_CONSTANT:
c = &a->constants;
break;
case JANET_OAT_INTEGER:
c = NULL;
break;
case JANET_OAT_TYPE:
case JANET_OAT_SIMPLETYPE:
c = NULL;
break;
case JANET_OAT_LABEL:
c = &a->labels;
break;
case JANET_OAT_FUNCDEF:
c = &a->defs;
break;
}
switch (janet_type(x)) {
default:
goto error;
break;
case JANET_INTEGER:
ret = janet_unwrap_integer(x);
break;
case JANET_TUPLE:
{
const Janet *t = janet_unwrap_tuple(x);
if (argtype == JANET_OAT_TYPE) {
int32_t i = 0;
ret = 0;
for (i = 0; i < janet_tuple_length(t); i++) {
ret |= doarg_1(a, JANET_OAT_SIMPLETYPE, t[i]);
}
} else {
goto error;
}
break;
}
case JANET_SYMBOL:
{
if (NULL != c) {
Janet result = janet_table_get(c, x);
if (janet_checktype(result, JANET_INTEGER)) {
if (argtype == JANET_OAT_LABEL) {
ret = janet_unwrap_integer(result) - a->bytecode_count;
} else {
ret = janet_unwrap_integer(result);
}
} else {
janet_asm_errorv(a, janet_formatc("unknown name %v", x));
}
} else if (argtype == JANET_OAT_TYPE || argtype == JANET_OAT_SIMPLETYPE) {
const TypeAlias *alias = janet_strbinsearch(
&type_aliases,
sizeof(type_aliases)/sizeof(TypeAlias),
sizeof(TypeAlias),
janet_unwrap_symbol(x));
if (alias) {
ret = alias->mask;
} else {
janet_asm_errorv(a, janet_formatc("unknown type %v", x));
}
} else {
goto error;
}
if (argtype == JANET_OAT_ENVIRONMENT && ret == -1) {
/* Add a new env */
ret = janet_asm_addenv(a, x);
if (ret < -1) {
janet_asm_errorv(a, janet_formatc("unknown environment %v", x));
}
}
break;
}
}
if (argtype == JANET_OAT_SLOT && ret >= a->def->slotcount)
a->def->slotcount = (int32_t) ret + 1;
return ret;
error:
janet_asm_errorv(a, janet_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(
JanetAssembler *a,
enum JanetOpArgType argtype,
int nth,
int nbytes,
int hassign,
Janet x) {
int32_t arg = doarg_1(a, argtype, x);
/* Calculate the min and max values that can be stored given
* nbytes, and whether or not the storage is signed */
int32_t max = (1 << ((nbytes << 3) - hassign)) - 1;
int32_t min = hassign ? -max - 1 : 0;
if (arg < min)
janet_asm_errorv(a, janet_formatc("instruction argument %v is too small, must be %d byte%s",
x, nbytes, nbytes > 1 ? "s" : ""));
if (arg > max)
janet_asm_errorv(a, janet_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(
JanetAssembler *a,
const JanetInstructionDef *idef,
const Janet *argt) {
uint32_t instr = idef->opcode;
enum JanetInstructionType type = janet_instructions[idef->opcode];
switch (type) {
case JINT_0:
{
if (janet_tuple_length(argt) != 1)
janet_asm_error(a, "expected 0 arguments: (op)");
break;
}
case JINT_S:
{
if (janet_tuple_length(argt) != 2)
janet_asm_error(a, "expected 1 argument: (op, slot)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 2, 0, argt[1]);
break;
}
case JINT_L:
{
if (janet_tuple_length(argt) != 2)
janet_asm_error(a, "expected 1 argument: (op, label)");
instr |= doarg(a, JANET_OAT_LABEL, 1, 3, 1, argt[1]);
break;
}
case JINT_SS:
{
if (janet_tuple_length(argt) != 3)
janet_asm_error(a, "expected 2 arguments: (op, slot, slot)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, JANET_OAT_SLOT, 2, 2, 0, argt[2]);
break;
}
case JINT_SL:
{
if (janet_tuple_length(argt) != 3)
janet_asm_error(a, "expected 2 arguments: (op, slot, label)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, JANET_OAT_LABEL, 2, 2, 1, argt[2]);
break;
}
case JINT_ST:
{
if (janet_tuple_length(argt) != 3)
janet_asm_error(a, "expected 2 arguments: (op, slot, type)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, JANET_OAT_TYPE, 2, 2, 0, argt[2]);
break;
}
case JINT_SI:
case JINT_SU:
{
if (janet_tuple_length(argt) != 3)
janet_asm_error(a, "expected 2 arguments: (op, slot, integer)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, JANET_OAT_INTEGER, 2, 2, type == JINT_SI, argt[2]);
break;
}
case JINT_SD:
{
if (janet_tuple_length(argt) != 3)
janet_asm_error(a, "expected 2 arguments: (op, slot, funcdef)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, JANET_OAT_FUNCDEF, 2, 2, 0, argt[2]);
break;
}
case JINT_SSS:
{
if (janet_tuple_length(argt) != 4)
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, slot)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, JANET_OAT_SLOT, 2, 1, 0, argt[2]);
instr |= doarg(a, JANET_OAT_SLOT, 3, 1, 0, argt[3]);
break;
}
case JINT_SSI:
case JINT_SSU:
{
if (janet_tuple_length(argt) != 4)
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, integer)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, JANET_OAT_SLOT, 2, 1, 0, argt[2]);
instr |= doarg(a, JANET_OAT_INTEGER, 3, 1, type == JINT_SSI, argt[3]);
break;
}
case JINT_SES:
{
JanetAssembler *b = a;
uint32_t env;
if (janet_tuple_length(argt) != 4)
janet_asm_error(a, "expected 3 arguments: (op, slot, environment, envslot)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
env = doarg(a, JANET_OAT_ENVIRONMENT, 0, 1, 0, argt[2]);
instr |= env << 16;
for (env += 1; env > 0; env--) {
b = b->parent;
if (NULL == b)
janet_asm_error(a, "invalid environment index");
}
instr |= doarg(b, JANET_OAT_SLOT, 3, 1, 0, argt[3]);
break;
}
case JINT_SC:
{
if (janet_tuple_length(argt) != 3)
janet_asm_error(a, "expected 2 arguments: (op, slot, constant)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, JANET_OAT_CONSTANT, 2, 2, 0, argt[2]);
break;
}
}
return instr;
}
/* Helper to get from a structure */
static Janet janet_get(Janet ds, Janet key) {
switch (janet_type(ds)) {
default:
return janet_wrap_nil();
case JANET_TABLE:
return janet_table_get(janet_unwrap_table(ds), key);
case JANET_STRUCT:
return janet_struct_get(janet_unwrap_struct(ds), key);
}
}
/* Helper to assembly. Return the assembly result */
static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int flags) {
JanetAssembleResult result;
JanetAssembler a;
Janet s = source;
JanetFuncDef *def;
int32_t count, i;
const Janet *arr;
Janet x;
(void) flags;
/* Initialize funcdef */
def = janet_funcdef_alloc();
/* Initialize Assembler */
a.def = def;
a.parent = parent;
a.errmessage = NULL;
a.errindex = 0;
a.environments_capacity = 0;
a.bytecode_count = 0;
a.defs_capacity = 0;
a.name = janet_wrap_nil();
janet_table_init(&a.labels, 0);
janet_table_init(&a.constants, 0);
janet_table_init(&a.slots, 0);
janet_table_init(&a.envs, 0);
janet_table_init(&a.defs, 0);
/* Set error jump */
if (setjmp(a.on_error)) {
if (NULL != a.parent) {
janet_asm_deinit(&a);
longjmp(a.parent->on_error, 1);
}
result.error = a.errmessage;
result.status = JANET_ASSEMBLE_ERROR;
janet_asm_deinit(&a);
return result;
}
janet_asm_assert(&a,
janet_checktype(s, JANET_STRUCT) ||
janet_checktype(s, JANET_TABLE),
"expected struct or table for assembly source");
/* Check for function name */
a.name = janet_get(s, janet_csymbolv("name"));
if (!janet_checktype(a.name, JANET_NIL)) {
def->name = janet_to_string(a.name);
}
/* Set function arity */
x = janet_get(s, janet_csymbolv("arity"));
def->arity = janet_checktype(x, JANET_INTEGER) ? janet_unwrap_integer(x) : 0;
/* Check vararg */
x = janet_get(s, janet_csymbolv("vararg"));
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
/* Check source */
x = janet_get(s, janet_csymbolv("source"));
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
/* Create slot aliases */
x = janet_get(s, janet_csymbolv("slots"));
if (janet_indexed_view(x, &arr, &count)) {
for (i = 0; i < count; i++) {
Janet v = arr[i];
if (janet_checktype(v, JANET_TUPLE)) {
const Janet *t = janet_unwrap_tuple(v);
int32_t j;
for (j = 0; j < janet_tuple_length(t); j++) {
if (!janet_checktype(t[j], JANET_SYMBOL))
janet_asm_error(&a, "slot names must be symbols");
janet_table_put(&a.slots, t[j], janet_wrap_integer(i));
}
} else if (janet_checktype(v, JANET_SYMBOL)) {
janet_table_put(&a.slots, v, janet_wrap_integer(i));
} else {
janet_asm_error(&a, "slot names must be symbols or tuple of symbols");
}
}
}
/* Parse constants */
x = janet_get(s, janet_csymbolv("constants"));
if (janet_indexed_view(x, &arr, &count)) {
def->constants_length = count;
def->constants = malloc(sizeof(Janet) * count);
if (NULL == def->constants) {
JANET_OUT_OF_MEMORY;
}
for (i = 0; i < count; i++) {
Janet ct = arr[i];
if (janet_checktype(ct, JANET_TUPLE) &&
janet_tuple_length(janet_unwrap_tuple(ct)) > 1 &&
janet_checktype(janet_unwrap_tuple(ct)[0], JANET_SYMBOL)) {
const Janet *t = janet_unwrap_tuple(ct);
int32_t tcount = janet_tuple_length(t);
const uint8_t *macro = janet_unwrap_symbol(t[0]);
if (0 == janet_cstrcmp(macro, "quote")) {
def->constants[i] = t[1];
} else if (tcount == 3 &&
janet_checktype(t[1], JANET_SYMBOL) &&
0 == janet_cstrcmp(macro, "def")) {
def->constants[i] = t[2];
janet_table_put(&a.constants, t[1], janet_wrap_integer(i));
} else {
janet_asm_errorv(&a, janet_formatc("could not parse constant \"%v\"", ct));
}
} else {
def->constants[i] = ct;
}
}
} else {
def->constants = NULL;
def->constants_length = 0;
}
/* Parse sub funcdefs */
x = janet_get(s, janet_csymbolv("closures"));
if (janet_indexed_view(x, &arr, &count)) {
int32_t i;
for (i = 0; i < count; i++) {
JanetAssembleResult subres;
Janet subname;
int32_t newlen;
subres = janet_asm1(&a, arr[i], flags);
if (subres.status != JANET_ASSEMBLE_OK) {
janet_asm_errorv(&a, subres.error);
}
subname = janet_get(arr[i], janet_csymbolv("name"));
if (!janet_checktype(subname, JANET_NIL)) {
janet_table_put(&a.defs, subname, janet_wrap_integer(def->defs_length));
}
newlen = def->defs_length + 1;
if (a.defs_capacity < newlen) {
int32_t newcap = newlen;
def->defs = realloc(def->defs, newcap * sizeof(JanetFuncDef *));
if (NULL == def->defs) {
JANET_OUT_OF_MEMORY;
}
a.defs_capacity = newcap;
}
def->defs[def->defs_length] = subres.funcdef;
def->defs_length = newlen;
}
}
/* Parse bytecode and labels */
x = janet_get(s, janet_csymbolv("bytecode"));
if (janet_indexed_view(x, &arr, &count)) {
/* Do labels and find length */
int32_t blength = 0;
for (i = 0; i < count; ++i) {
Janet instr = arr[i];
if (janet_checktype(instr, JANET_SYMBOL)) {
janet_table_put(&a.labels, instr, janet_wrap_integer(blength));
} else if (janet_checktype(instr, JANET_TUPLE)) {
blength++;
} else {
a.errindex = i;
janet_asm_error(&a, "expected assembly instruction");
}
}
/* Allocate bytecode array */
def->bytecode_length = blength;
def->bytecode = malloc(sizeof(int32_t) * blength);
if (NULL == def->bytecode) {
JANET_OUT_OF_MEMORY;
}
/* Do bytecode */
for (i = 0; i < count; ++i) {
Janet instr = arr[i];
if (janet_checktype(instr, JANET_SYMBOL)) {
continue;
} else {
uint32_t op;
const JanetInstructionDef *idef;
const Janet *t;
a.errindex = i;
janet_asm_assert(&a, janet_checktype(instr, JANET_TUPLE), "expected tuple");
t = janet_unwrap_tuple(instr);
if (janet_tuple_length(t) == 0) {
op = 0;
} else {
janet_asm_assert(&a, janet_checktype(t[0], JANET_SYMBOL),
"expected symbol in assembly instruction");
idef = janet_strbinsearch(
&janet_ops,
sizeof(janet_ops)/sizeof(JanetInstructionDef),
sizeof(JanetInstructionDef),
janet_unwrap_symbol(t[0]));
if (NULL == idef)
janet_asm_errorv(&a, janet_formatc("unknown instruction %v", t[0]));
op = read_instruction(&a, idef, t);
}
def->bytecode[a.bytecode_count++] = op;
}
}
} else {
janet_asm_error(&a, "bytecode expected");
}
a.errindex = -1;
/* Check for source mapping */
x = janet_get(s, janet_csymbolv("sourcemap"));
if (janet_indexed_view(x, &arr, &count)) {
janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
def->sourcemap = malloc(sizeof(JanetSourceMapping) * count);
for (i = 0; i < count; i++) {
const Janet *tup;
Janet entry = arr[i];
JanetSourceMapping mapping;
if (!janet_checktype(entry, JANET_TUPLE)) {
janet_asm_error(&a, "expected tuple");
}
tup = janet_unwrap_tuple(entry);
if (!janet_checktype(tup[0], JANET_INTEGER)) {
janet_asm_error(&a, "expected integer");
}
if (!janet_checktype(tup[1], JANET_INTEGER)) {
janet_asm_error(&a, "expected integer");
}
mapping.line = janet_unwrap_integer(tup[0]);
mapping.column = janet_unwrap_integer(tup[1]);
def->sourcemap[i] = mapping;
}
}
/* Set environments */
def->environments =
realloc(def->environments, def->environments_length * sizeof(int32_t));
/* Verify the func def */
if (janet_verify(def)) {
janet_asm_error(&a, "invalid assembly");
}
/* Finish everything and return funcdef */
janet_asm_deinit(&a);
result.funcdef = def;
result.status = JANET_ASSEMBLE_OK;
return result;
}
/* Assemble a function */
JanetAssembleResult janet_asm(Janet source, int flags) {
return janet_asm1(NULL, source, flags);
}
/* Disassembly */
/* Find the deinfintion of an instruction given the instruction word. Return
* NULL if not found. */
static const JanetInstructionDef *janet_asm_reverse_lookup(uint32_t instr) {
size_t i;
uint32_t opcode = instr & 0x7F;
for (i = 0; i < sizeof(janet_ops)/sizeof(JanetInstructionDef); i++) {
const JanetInstructionDef *def = janet_ops + i;
if (def->opcode == opcode)
return def;
}
return NULL;
}
/* Create some constant sized tuples */
static Janet tup1(Janet x) {
Janet *tup = janet_tuple_begin(1);
tup[0] = x;
return janet_wrap_tuple(janet_tuple_end(tup));
}
static Janet tup2(Janet x, Janet y) {
Janet *tup = janet_tuple_begin(2);
tup[0] = x;
tup[1] = y;
return janet_wrap_tuple(janet_tuple_end(tup));
}
static Janet tup3(Janet x, Janet y, Janet z) {
Janet *tup = janet_tuple_begin(3);
tup[0] = x;
tup[1] = y;
tup[2] = z;
return janet_wrap_tuple(janet_tuple_end(tup));
}
static Janet tup4(Janet w, Janet x, Janet y, Janet z) {
Janet *tup = janet_tuple_begin(4);
tup[0] = w;
tup[1] = x;
tup[2] = y;
tup[3] = z;
return janet_wrap_tuple(janet_tuple_end(tup));
}
/* Given an argument, convert it to the appriate integer or symbol */
Janet janet_asm_decode_instruction(uint32_t instr) {
const JanetInstructionDef *def = janet_asm_reverse_lookup(instr);
Janet name;
if (NULL == def) {
return janet_wrap_integer((int32_t)instr);
}
name = janet_csymbolv(def->name);
#define oparg(shift, mask) ((instr >> ((shift) << 3)) & (mask))
switch (janet_instructions[def->opcode]) {
case JINT_0:
return tup1(name);
case JINT_S:
return tup2(name, janet_wrap_integer(oparg(1, 0xFFFFFF)));
case JINT_L:
return tup2(name, janet_wrap_integer((int32_t)instr >> 8));
case JINT_SS:
case JINT_ST:
case JINT_SC:
case JINT_SU:
case JINT_SD:
return tup3(name,
janet_wrap_integer(oparg(1, 0xFF)),
janet_wrap_integer(oparg(2, 0xFFFF)));
case JINT_SI:
case JINT_SL:
return tup3(name,
janet_wrap_integer(oparg(1, 0xFF)),
janet_wrap_integer((int32_t)instr >> 16));
case JINT_SSS:
case JINT_SES:
case JINT_SSU:
return tup4(name,
janet_wrap_integer(oparg(1, 0xFF)),
janet_wrap_integer(oparg(2, 0xFF)),
janet_wrap_integer(oparg(3, 0xFF)));
case JINT_SSI:
return tup4(name,
janet_wrap_integer(oparg(1, 0xFF)),
janet_wrap_integer(oparg(2, 0xFF)),
janet_wrap_integer((int32_t)instr >> 24));
}
#undef oparg
return janet_wrap_nil();
}
Janet janet_disasm(JanetFuncDef *def) {
int32_t i;
JanetArray *bcode = janet_array(def->bytecode_length);
JanetArray *constants;
JanetTable *ret = janet_table(10);
janet_table_put(ret, janet_csymbolv("arity"), janet_wrap_integer(def->arity));
janet_table_put(ret, janet_csymbolv("bytecode"), janet_wrap_array(bcode));
if (NULL != def->source) {
janet_table_put(ret, janet_csymbolv("source"), janet_wrap_string(def->source));
}
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
janet_table_put(ret, janet_csymbolv("vararg"), janet_wrap_true());
}
if (NULL != def->name) {
janet_table_put(ret, janet_csymbolv("name"), janet_wrap_string(def->name));
}
/* Add constants */
if (def->constants_length > 0) {
constants = janet_array(def->constants_length);
janet_table_put(ret, janet_csymbolv("constants"), janet_wrap_array(constants));
for (i = 0; i < def->constants_length; i++) {
Janet src = def->constants[i];
Janet dest;
if (janet_checktype(src, JANET_TUPLE)) {
dest = tup2(janet_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] = janet_asm_decode_instruction(def->bytecode[i]);
}
bcode->count = def->bytecode_length;
/* Add source map */
if (NULL != def->sourcemap) {
JanetArray *sourcemap = janet_array(def->bytecode_length);
for (i = 0; i < def->bytecode_length; i++) {
Janet *t = janet_tuple_begin(2);
JanetSourceMapping mapping = def->sourcemap[i];
t[0] = janet_wrap_integer(mapping.line);
t[1] = janet_wrap_integer(mapping.column);
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
}
sourcemap->count = def->bytecode_length;
janet_table_put(ret, janet_csymbolv("sourcemap"), janet_wrap_array(sourcemap));
}
/* Add environments */
if (NULL != def->environments) {
JanetArray *envs = janet_array(def->environments_length);
for (i = 0; i < def->environments_length; i++) {
envs->data[i] = janet_wrap_integer(def->environments[i]);
}
envs->count = def->environments_length;
janet_table_put(ret, janet_csymbolv("environments"), janet_wrap_array(envs));
}
/* Add closures */
/* Funcdefs cannot be recursive */
if (NULL != def->defs) {
JanetArray *defs = janet_array(def->defs_length);
for (i = 0; i < def->defs_length; i++) {
defs->data[i] = janet_disasm(def->defs[i]);
}
defs->count = def->defs_length;
janet_table_put(ret, janet_csymbolv("defs"), janet_wrap_array(defs));
}
/* Add slotcount */
janet_table_put(ret, janet_csymbolv("slotcount"), janet_wrap_integer(def->slotcount));
return janet_wrap_struct(janet_table_to_struct(ret));
}
/* C Function for assembly */
static int cfun_asm(JanetArgs args) {
JanetAssembleResult res;
JANET_FIXARITY(args, 1);
res = janet_asm(args.v[0], 0);
if (res.status == JANET_ASSEMBLE_OK) {
JANET_RETURN_FUNCTION(args, janet_thunk(res.funcdef));
} else {
JANET_THROWV(args, janet_wrap_string(res.error));
}
}
static int cfun_disasm(JanetArgs args) {
JanetFunction *f;
JANET_FIXARITY(args, 1);
JANET_ARG_FUNCTION(f, args, 0);
JANET_RETURN(args, janet_disasm(f->def));
}
static const JanetReg cfuns[] = {
{"asm", cfun_asm},
{"disasm", cfun_disasm},
{NULL, NULL}
};
/* Load the library */
int janet_lib_asm(JanetArgs args) {
JanetTable *env = janet_env(args);
janet_cfuns(env, NULL, cfuns);
return 0;
}
Reference in New Issue View Git Blame Copy Permalink