mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-09-29 07:20:41 +00:00
Code Issues 1 Releases Wiki Activity
600bed9f6d
janet/src/core/marsh.c
Calvin Rose a8afc5b81f Sourcemapping uses line, column instead of offsets. 
This should be friendlier to most users. It does, however, mean
we lose range information. However, range information could be
recovered by re-parsing, as janet's grammar is simple enough to do this.
2019-09-22 17:18:28 -05:00

1312 lines
44 KiB
C
Raw Blame History

/*
* Copyright (c) 2019 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.
*/
#ifndef JANET_AMALG
#include <janet.h>
#include "state.h"
#include "vector.h"
#include "gc.h"
#include "fiber.h"
#include "util.h"
#endif
typedef struct {
JanetBuffer *buf;
JanetTable seen;
JanetTable *rreg;
JanetFuncEnv **seen_envs;
JanetFuncDef **seen_defs;
int32_t nextid;
} MarshalState;
/* Lead bytes in marshaling protocol */
enum {
LB_REAL = 200,
LB_NIL,
LB_FALSE,
LB_TRUE,
LB_FIBER,
LB_INTEGER,
LB_STRING,
LB_SYMBOL,
LB_KEYWORD,
LB_ARRAY,
LB_TUPLE,
LB_TABLE,
LB_TABLE_PROTO,
LB_STRUCT,
LB_BUFFER,
LB_FUNCTION,
LB_REGISTRY,
LB_ABSTRACT,
LB_REFERENCE,
LB_FUNCENV_REF,
LB_FUNCDEF_REF
} LeadBytes;
/* Helper to look inside an entry in an environment */
static Janet entry_getval(Janet env_entry) {
if (janet_checktype(env_entry, JANET_TABLE)) {
JanetTable *entry = janet_unwrap_table(env_entry);
Janet checkval = janet_table_get(entry, janet_ckeywordv("value"));
if (janet_checktype(checkval, JANET_NIL)) {
checkval = janet_table_get(entry, janet_ckeywordv("ref"));
}
return checkval;
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
const JanetKV *entry = janet_unwrap_struct(env_entry);
Janet checkval = janet_struct_get(entry, janet_ckeywordv("value"));
if (janet_checktype(checkval, JANET_NIL)) {
checkval = janet_struct_get(entry, janet_ckeywordv("ref"));
}
return checkval;
} else {
return janet_wrap_nil();
}
}
/* Merge values from an environment into an existing lookup table. */
void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix, int recurse) {
while (env) {
for (int32_t i = 0; i < env->capacity; i++) {
if (janet_checktype(env->data[i].key, JANET_SYMBOL)) {
if (prefix) {
int32_t prelen = (int32_t) strlen(prefix);
const uint8_t *oldsym = janet_unwrap_symbol(env->data[i].key);
int32_t oldlen = janet_string_length(oldsym);
uint8_t *symbuf = janet_smalloc(prelen + oldlen);
memcpy(symbuf, prefix, prelen);
memcpy(symbuf + prelen, oldsym, oldlen);
Janet s = janet_symbolv(symbuf, prelen + oldlen);
janet_sfree(symbuf);
janet_table_put(renv, s, entry_getval(env->data[i].value));
} else {
janet_table_put(renv,
env->data[i].key,
entry_getval(env->data[i].value));
}
}
}
env = recurse ? env->proto : NULL;
}
}
/* Make a forward lookup table from an environment (for unmarshaling) */
JanetTable *janet_env_lookup(JanetTable *env) {
JanetTable *renv = janet_table(env->count);
janet_env_lookup_into(renv, env, NULL, 1);
return renv;
}
/* Marshal an integer onto the buffer */
static void pushint(MarshalState *st, int32_t x) {
if (x >= 0 && x < 128) {
janet_buffer_push_u8(st->buf, x);
} else if (x <= 8191 && x >= -8192) {
uint8_t intbuf[2];
intbuf[0] = ((x >> 8) & 0x3F) | 0x80;
intbuf[1] = x & 0xFF;
janet_buffer_push_bytes(st->buf, intbuf, 2);
} else {
uint8_t intbuf[5];
intbuf[0] = LB_INTEGER;
intbuf[1] = (x >> 24) & 0xFF;
intbuf[2] = (x >> 16) & 0xFF;
intbuf[3] = (x >> 8) & 0xFF;
intbuf[4] = x & 0xFF;
janet_buffer_push_bytes(st->buf, intbuf, 5);
}
}
static void pushbyte(MarshalState *st, uint8_t b) {
janet_buffer_push_u8(st->buf, b);
}
static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
janet_buffer_push_bytes(st->buf, bytes, len);
}
/* Marshal a size_t onto the buffer */
static void push64(MarshalState *st, uint64_t x) {
if (x <= 0xF0) {
/* Single byte */
pushbyte(st, (uint8_t) x);
} else {
/* Multibyte, little endian */
uint8_t bytes[9];
int nbytes = 0;
while (x) {
bytes[++nbytes] = x & 0xFF;
x >>= 8;
}
bytes[0] = 0xF0 + nbytes;
pushbytes(st, bytes, nbytes + 1);
}
}
/* Forward declaration to enable mutual recursion. */
static void marshal_one(MarshalState *st, Janet x, int flags);
static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags);
static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags);
static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags);
/* Prevent stack overflows */
#define MARSH_STACKCHECK if ((flags & 0xFFFF) > JANET_RECURSION_GUARD) janet_panic("stack overflow")
/* Marshal a function env */
static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
MARSH_STACKCHECK;
for (int32_t i = 0; i < janet_v_count(st->seen_envs); i++) {
if (st->seen_envs[i] == env) {
pushbyte(st, LB_FUNCENV_REF);
pushint(st, i);
return;
}
}
janet_v_push(st->seen_envs, env);
pushint(st, env->offset);
pushint(st, env->length);
if (env->offset) {
/* On stack variant */
marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
} else {
/* Off stack variant */
for (int32_t i = 0; i < env->length; i++)
marshal_one(st, env->as.values[i], flags + 1);
}
}
/* Add function flags to janet functions */
static void janet_func_addflags(JanetFuncDef *def) {
if (def->name) def->flags |= JANET_FUNCDEF_FLAG_HASNAME;
if (def->source) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
if (def->defs) def->flags |= JANET_FUNCDEF_FLAG_HASDEFS;
if (def->environments) def->flags |= JANET_FUNCDEF_FLAG_HASENVS;
if (def->sourcemap) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
}
/* Marshal a function def */
static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
MARSH_STACKCHECK;
for (int32_t i = 0; i < janet_v_count(st->seen_defs); i++) {
if (st->seen_defs[i] == def) {
pushbyte(st, LB_FUNCDEF_REF);
pushint(st, i);
return;
}
}
janet_func_addflags(def);
/* Add to lookup */
janet_v_push(st->seen_defs, def);
pushint(st, def->flags);
pushint(st, def->slotcount);
pushint(st, def->arity);
pushint(st, def->min_arity);
pushint(st, def->max_arity);
pushint(st, def->constants_length);
pushint(st, def->bytecode_length);
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
pushint(st, def->environments_length);
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
pushint(st, def->defs_length);
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME)
marshal_one(st, janet_wrap_string(def->name), flags);
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE)
marshal_one(st, janet_wrap_string(def->source), flags);
/* marshal constants */
for (int32_t i = 0; i < def->constants_length; i++)
marshal_one(st, def->constants[i], flags);
/* marshal the bytecode */
for (int32_t i = 0; i < def->bytecode_length; i++) {
pushbyte(st, def->bytecode[i] & 0xFF);
pushbyte(st, (def->bytecode[i] >> 8) & 0xFF);
pushbyte(st, (def->bytecode[i] >> 16) & 0xFF);
pushbyte(st, (def->bytecode[i] >> 24) & 0xFF);
}
/* marshal the environments if needed */
for (int32_t i = 0; i < def->environments_length; i++)
pushint(st, def->environments[i]);
/* marshal the sub funcdefs if needed */
for (int32_t i = 0; i < def->defs_length; i++)
marshal_one_def(st, def->defs[i], flags);
/* marshal source maps if needed */
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
int32_t current = 0;
for (int32_t i = 0; i < def->bytecode_length; i++) {
JanetSourceMapping map = def->sourcemap[i];
pushint(st, map.line - current);
pushint(st, map.column);
current = map.line;
}
}
}
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
#define JANET_FIBER_FLAG_HASENV (1 << 28)
#define JANET_STACKFRAME_HASENV (1 << 30)
/* Marshal a fiber */
static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
MARSH_STACKCHECK;
int32_t fflags = fiber->flags;
if (fiber->child) fflags |= JANET_FIBER_FLAG_HASCHILD;
if (fiber->env) fflags |= JANET_FIBER_FLAG_HASENV;
if (janet_fiber_status(fiber) == JANET_STATUS_ALIVE)
janet_panic("cannot marshal alive fiber");
pushint(st, fflags);
pushint(st, fiber->frame);
pushint(st, fiber->stackstart);
pushint(st, fiber->stacktop);
pushint(st, fiber->maxstack);
/* Do frames */
int32_t i = fiber->frame;
int32_t j = fiber->stackstart - JANET_FRAME_SIZE;
while (i > 0) {
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
if (frame->env) frame->flags |= JANET_STACKFRAME_HASENV;
if (!frame->func) janet_panic("cannot marshal fiber with c stackframe");
pushint(st, frame->flags);
pushint(st, frame->prevframe);
int32_t pcdiff = (int32_t)(frame->pc - frame->func->def->bytecode);
pushint(st, pcdiff);
marshal_one(st, janet_wrap_function(frame->func), flags + 1);
if (frame->env) marshal_one_env(st, frame->env, flags + 1);
/* Marshal all values in the stack frame */
for (int32_t k = i; k < j; k++)
marshal_one(st, fiber->data[k], flags + 1);
j = i - JANET_FRAME_SIZE;
i = frame->prevframe;
}
if (fiber->env) {
marshal_one(st, janet_wrap_table(fiber->env), flags + 1);
}
if (fiber->child)
marshal_one(st, janet_wrap_fiber(fiber->child), flags + 1);
}
void janet_marshal_size(JanetMarshalContext *ctx, size_t value) {
janet_marshal_int64(ctx, (int64_t) value);
}
void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value) {
MarshalState *st = (MarshalState *)(ctx->m_state);
push64(st, (uint64_t) value);
}
void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
MarshalState *st = (MarshalState *)(ctx->m_state);
pushint(st, value);
}
void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
MarshalState *st = (MarshalState *)(ctx->m_state);
pushbyte(st, value);
}
void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len) {
MarshalState *st = (MarshalState *)(ctx->m_state);
if (len > INT32_MAX) janet_panic("size_t too large to fit in buffer");
pushbytes(st, bytes, (int32_t) len);
}
void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
MarshalState *st = (MarshalState *)(ctx->m_state);
marshal_one(st, x, ctx->flags + 1);
}
#define MARK_SEEN() \
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++))
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
void *abstract = janet_unwrap_abstract(x);
const JanetAbstractType *at = janet_abstract_type(abstract);
if (at->marshal) {
JanetMarshalContext context = {st, NULL, flags, NULL};
pushbyte(st, LB_ABSTRACT);
marshal_one(st, janet_csymbolv(at->name), flags + 1);
push64(st, (uint64_t) janet_abstract_size(abstract));
MARK_SEEN();
at->marshal(abstract, &context);
} else {
janet_panicf("try to marshal unregistered abstract type, cannot marshal %p", x);
}
}
/* The main body of the marshaling function. Is the main
* entry point for the mutually recursive functions. */
static void marshal_one(MarshalState *st, Janet x, int flags) {
MARSH_STACKCHECK;
JanetType type = janet_type(x);
/* Check simple primitives (non reference types, no benefit from memoization) */
switch (type) {
default:
break;
case JANET_NIL:
pushbyte(st, LB_NIL);
return;
case JANET_BOOLEAN:
pushbyte(st, janet_unwrap_boolean(x) ? LB_TRUE : LB_FALSE);
return;
case JANET_NUMBER: {
double xval = janet_unwrap_number(x);
if (janet_checkintrange(xval)) {
pushint(st, (int32_t) xval);
return;
}
break;
}
}
/* Check reference and registry value */
{
Janet check = janet_table_get(&st->seen, x);
if (janet_checkint(check)) {
pushbyte(st, LB_REFERENCE);
pushint(st, janet_unwrap_integer(check));
return;
}
if (st->rreg) {
check = janet_table_get(st->rreg, x);
if (janet_checktype(check, JANET_SYMBOL)) {
MARK_SEEN();
const uint8_t *regname = janet_unwrap_symbol(check);
pushbyte(st, LB_REGISTRY);
pushint(st, janet_string_length(regname));
pushbytes(st, regname, janet_string_length(regname));
return;
}
}
}
/* Reference types */
switch (type) {
case JANET_NUMBER: {
union {
double d;
uint8_t bytes[8];
} u;
u.d = janet_unwrap_number(x);
#ifdef JANET_BIG_ENDIAN
/* Swap byte order */
uint8_t temp;
temp = u.bytes[7];
u.bytes[7] = u.bytes[0];
u.bytes[0] = temp;
temp = u.bytes[6];
u.bytes[6] = u.bytes[1];
u.bytes[1] = temp;
temp = u.bytes[5];
u.bytes[5] = u.bytes[2];
u.bytes[2] = temp;
temp = u.bytes[4];
u.bytes[4] = u.bytes[3];
u.bytes[3] = temp;
#endif
pushbyte(st, LB_REAL);
pushbytes(st, u.bytes, 8);
MARK_SEEN();
return;
}
case JANET_STRING:
case JANET_SYMBOL:
case JANET_KEYWORD: {
const uint8_t *str = janet_unwrap_string(x);
int32_t length = janet_string_length(str);
/* Record reference */
MARK_SEEN();
uint8_t lb = (type == JANET_STRING) ? LB_STRING :
(type == JANET_SYMBOL) ? LB_SYMBOL :
LB_KEYWORD;
pushbyte(st, lb);
pushint(st, length);
pushbytes(st, str, length);
return;
}
case JANET_BUFFER: {
JanetBuffer *buffer = janet_unwrap_buffer(x);
/* Record reference */
MARK_SEEN();
pushbyte(st, LB_BUFFER);
pushint(st, buffer->count);
pushbytes(st, buffer->data, buffer->count);
return;
}
case JANET_ARRAY: {
int32_t i;
JanetArray *a = janet_unwrap_array(x);
MARK_SEEN();
pushbyte(st, LB_ARRAY);
pushint(st, a->count);
for (i = 0; i < a->count; i++)
marshal_one(st, a->data[i], flags + 1);
return;
}
case JANET_TUPLE: {
int32_t i, count, flag;
const Janet *tup = janet_unwrap_tuple(x);
count = janet_tuple_length(tup);
flag = janet_tuple_flag(tup) >> 16;
pushbyte(st, LB_TUPLE);
pushint(st, count);
pushint(st, flag);
for (i = 0; i < count; i++)
marshal_one(st, tup[i], flags + 1);
/* Mark as seen AFTER marshaling */
MARK_SEEN();
return;
}
case JANET_TABLE: {
JanetTable *t = janet_unwrap_table(x);
MARK_SEEN();
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
pushint(st, t->count);
if (t->proto)
marshal_one(st, janet_wrap_table(t->proto), flags + 1);
for (int32_t i = 0; i < t->capacity; i++) {
if (janet_checktype(t->data[i].key, JANET_NIL))
continue;
marshal_one(st, t->data[i].key, flags + 1);
marshal_one(st, t->data[i].value, flags + 1);
}
return;
}
case JANET_STRUCT: {
int32_t count;
const JanetKV *struct_ = janet_unwrap_struct(x);
count = janet_struct_length(struct_);
pushbyte(st, LB_STRUCT);
pushint(st, count);
for (int32_t i = 0; i < janet_struct_capacity(struct_); i++) {
if (janet_checktype(struct_[i].key, JANET_NIL))
continue;
marshal_one(st, struct_[i].key, flags + 1);
marshal_one(st, struct_[i].value, flags + 1);
}
/* Mark as seen AFTER marshaling */
MARK_SEEN();
return;
}
case JANET_ABSTRACT: {
marshal_one_abstract(st, x, flags);
return;
}
case JANET_FUNCTION: {
pushbyte(st, LB_FUNCTION);
JanetFunction *func = janet_unwrap_function(x);
marshal_one_def(st, func->def, flags);
/* Mark seen after reading def, but before envs */
MARK_SEEN();
for (int32_t i = 0; i < func->def->environments_length; i++)
marshal_one_env(st, func->envs[i], flags + 1);
return;
}
case JANET_FIBER: {
MARK_SEEN();
pushbyte(st, LB_FIBER);
marshal_one_fiber(st, janet_unwrap_fiber(x), flags + 1);
return;
}
default: {
janet_panicf("no registry value and cannot marshal %p", x);
return;
}
}
#undef MARK_SEEN
}
void janet_marshal(
JanetBuffer *buf,
Janet x,
JanetTable *rreg,
int flags) {
MarshalState st;
st.buf = buf;
st.nextid = 0;
st.seen_defs = NULL;
st.seen_envs = NULL;
st.rreg = rreg;
janet_table_init(&st.seen, 0);
marshal_one(&st, x, flags);
janet_table_deinit(&st.seen);
janet_v_free(st.seen_envs);
janet_v_free(st.seen_defs);
}
typedef struct {
jmp_buf err;
Janet *lookup;
JanetTable *reg;
JanetFuncEnv **lookup_envs;
JanetFuncDef **lookup_defs;
const uint8_t *start;
const uint8_t *end;
} UnmarshalState;
#define MARSH_EOS(st, data) do { \
if ((data) >= (st)->end) janet_panic("unexpected end of source");\
} while (0)
/* Helper to read a 32 bit integer from an unmarshal state */
static int32_t readint(UnmarshalState *st, const uint8_t **atdata) {
const uint8_t *data = *atdata;
int32_t ret;
MARSH_EOS(st, data);
if (*data < 128) {
ret = *data++;
} else if (*data < 192) {
MARSH_EOS(st, data + 1);
uint32_t uret = ((data[0] & 0x3F) << 8) + data[1];
/* Sign extend 18 MSBs */
uret |= (uret >> 13) ? 0xFFFFC000 : 0;
ret = (int32_t)uret;
data += 2;
} else if (*data == LB_INTEGER) {
MARSH_EOS(st, data + 4);
uint32_t ui = ((uint32_t)(data[1]) << 24) |
((uint32_t)(data[2]) << 16) |
((uint32_t)(data[3]) << 8) |
(uint32_t)(data[4]);
ret = (int32_t)ui;
data += 5;
} else {
janet_panicf("expected integer, got byte %x at index %d",
*data,
data - st->start);
ret = 0;
}
*atdata = data;
return ret;
}
/* Helper to read a size_t (up to 8 bytes unsigned). */
static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
uint64_t ret;
const uint8_t *data = *atdata;
MARSH_EOS(st, data);
if (*data <= 0xF0) {
/* Single byte */
ret = *data;
*atdata = data + 1;
} else {
/* Multibyte, little endian */
int nbytes = *data - 0xF0;
ret = 0;
if (nbytes > 8) janet_panic("invalid 64 bit integer");
MARSH_EOS(st, data + nbytes);
for (int i = nbytes; i > 0; i--)
ret = (ret << 8) + data[i];
*atdata = data + nbytes + 1;
}
return ret;
}
/* Assert a janet type */
static void janet_asserttype(Janet x, JanetType t) {
if (!janet_checktype(x, t)) {
janet_panicf("expected type %T, got %v", 1 << t, x);
}
}
/* Forward declarations for mutual recursion */
static const uint8_t *unmarshal_one(
UnmarshalState *st,
const uint8_t *data,
Janet *out,
int flags);
static const uint8_t *unmarshal_one_env(
UnmarshalState *st,
const uint8_t *data,
JanetFuncEnv **out,
int flags);
static const uint8_t *unmarshal_one_def(
UnmarshalState *st,
const uint8_t *data,
JanetFuncDef **out,
int flags);
static const uint8_t *unmarshal_one_fiber(
UnmarshalState *st,
const uint8_t *data,
JanetFiber **out,
int flags);
/* Unmarshal a funcenv */
static const uint8_t *unmarshal_one_env(
UnmarshalState *st,
const uint8_t *data,
JanetFuncEnv **out,
int flags) {
MARSH_EOS(st, data);
if (*data == LB_FUNCENV_REF) {
data++;
int32_t index = readint(st, &data);
if (index < 0 || index >= janet_v_count(st->lookup_envs))
janet_panicf("invalid funcenv reference %d", index);
*out = st->lookup_envs[index];
} else {
JanetFuncEnv *env = janet_gcalloc(JANET_MEMORY_FUNCENV, sizeof(JanetFuncEnv));
env->length = 0;
env->offset = 0;
janet_v_push(st->lookup_envs, env);
int32_t offset = readint(st, &data);
int32_t length = readint(st, &data);
if (offset) {
Janet fiberv;
/* On stack variant */
data = unmarshal_one(st, data, &fiberv, flags);
janet_asserttype(fiberv, JANET_FIBER);
env->as.fiber = janet_unwrap_fiber(fiberv);
/* Unmarshalling fiber may set values */
if (env->offset != 0 && env->offset != offset)
janet_panic("invalid funcenv offset");
if (env->length != 0 && env->length != length)
janet_panic("invalid funcenv length");
} else {
/* Off stack variant */
env->as.values = malloc(sizeof(Janet) * length);
if (!env->as.values) {
JANET_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < length; i++)
data = unmarshal_one(st, data, env->as.values + i, flags);
}
env->offset = offset;
env->length = length;
*out = env;
}
return data;
}
/* Unmarshal a funcdef */
static const uint8_t *unmarshal_one_def(
UnmarshalState *st,
const uint8_t *data,
JanetFuncDef **out,
int flags) {
MARSH_EOS(st, data);
if (*data == LB_FUNCDEF_REF) {
data++;
int32_t index = readint(st, &data);
if (index < 0 || index >= janet_v_count(st->lookup_defs))
janet_panicf("invalid funcdef reference %d", index);
*out = st->lookup_defs[index];
} else {
/* Initialize with values that will not break garbage collection
* if unmarshalling fails. */
JanetFuncDef *def = janet_gcalloc(JANET_MEMORY_FUNCDEF, sizeof(JanetFuncDef));
def->environments_length = 0;
def->defs_length = 0;
def->constants_length = 0;
def->bytecode_length = 0;
def->name = NULL;
def->source = NULL;
janet_v_push(st->lookup_defs, def);
/* Set default lengths to zero */
int32_t bytecode_length = 0;
int32_t constants_length = 0;
int32_t environments_length = 0;
int32_t defs_length = 0;
/* Read flags and other fixed values */
def->flags = readint(st, &data);
def->slotcount = readint(st, &data);
def->arity = readint(st, &data);
def->min_arity = readint(st, &data);
def->max_arity = readint(st, &data);
/* Read some lengths */
constants_length = readint(st, &data);
bytecode_length = readint(st, &data);
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
environments_length = readint(st, &data);
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
defs_length = readint(st, &data);
/* Check name and source (optional) */
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
Janet x;
data = unmarshal_one(st, data, &x, flags + 1);
janet_asserttype(x, JANET_STRING);
def->name = janet_unwrap_string(x);
}
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE) {
Janet x;
data = unmarshal_one(st, data, &x, flags + 1);
janet_asserttype(x, JANET_STRING);
def->source = janet_unwrap_string(x);
}
/* Unmarshal constants */
if (constants_length) {
def->constants = malloc(sizeof(Janet) * constants_length);
if (!def->constants) {
JANET_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < constants_length; i++)
data = unmarshal_one(st, data, def->constants + i, flags + 1);
} else {
def->constants = NULL;
}
def->constants_length = constants_length;
/* Unmarshal bytecode */
def->bytecode = malloc(sizeof(uint32_t) * bytecode_length);
if (!def->bytecode) {
JANET_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < bytecode_length; i++) {
MARSH_EOS(st, data + 3);
def->bytecode[i] =
(uint32_t)(data[0]) |
((uint32_t)(data[1]) << 8) |
((uint32_t)(data[2]) << 16) |
((uint32_t)(data[3]) << 24);
data += 4;
}
def->bytecode_length = bytecode_length;
/* Unmarshal environments */
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS) {
def->environments = calloc(1, sizeof(int32_t) * environments_length);
if (!def->environments) {
JANET_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < environments_length; i++) {
def->environments[i] = readint(st, &data);
}
} else {
def->environments = NULL;
}
def->environments_length = environments_length;
/* Unmarshal sub funcdefs */
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS) {
def->defs = calloc(1, sizeof(JanetFuncDef *) * defs_length);
if (!def->defs) {
JANET_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < defs_length; i++) {
data = unmarshal_one_def(st, data, def->defs + i, flags + 1);
}
} else {
def->defs = NULL;
}
def->defs_length = defs_length;
/* Unmarshal source maps if needed */
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
int32_t current = 0;
def->sourcemap = malloc(sizeof(JanetSourceMapping) * bytecode_length);
if (!def->sourcemap) {
JANET_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < bytecode_length; i++) {
current += readint(st, &data);
def->sourcemap[i].line = current;
def->sourcemap[i].column = readint(st, &data);
}
} else {
def->sourcemap = NULL;
}
/* Validate */
if (janet_verify(def))
janet_panic("funcdef has invalid bytecode");
/* Set def */
*out = def;
}
return data;
}
/* Unmarshal a fiber */
static const uint8_t *unmarshal_one_fiber(
UnmarshalState *st,
const uint8_t *data,
JanetFiber **out,
int flags) {
/* Initialize a new fiber */
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
fiber->flags = 0;
fiber->frame = 0;
fiber->stackstart = 0;
fiber->stacktop = 0;
fiber->capacity = 0;
fiber->maxstack = 0;
fiber->data = NULL;
fiber->child = NULL;
fiber->env = NULL;
/* Push fiber to seen stack */
janet_v_push(st->lookup, janet_wrap_fiber(fiber));
/* Set frame later so fiber can be GCed at anytime if unmarshalling fails */
int32_t frame = 0;
int32_t stack = 0;
int32_t stacktop = 0;
/* Read ints */
fiber->flags = readint(st, &data);
frame = readint(st, &data);
fiber->stackstart = readint(st, &data);
fiber->stacktop = readint(st, &data);
fiber->maxstack = readint(st, &data);
/* Check for bad flags and ints */
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber->stackstart ||
fiber->stackstart > fiber->stacktop ||
fiber->stacktop > fiber->maxstack) {
janet_panic("fiber has incorrect stack setup");
}
/* Allocate stack memory */
fiber->capacity = fiber->stacktop + 10;
fiber->data = malloc(sizeof(Janet) * fiber->capacity);
if (!fiber->data) {
JANET_OUT_OF_MEMORY;
}
/* get frames */
stack = frame;
stacktop = fiber->stackstart - JANET_FRAME_SIZE;
while (stack > 0) {
JanetFunction *func = NULL;
JanetFuncDef *def = NULL;
JanetFuncEnv *env = NULL;
int32_t frameflags = readint(st, &data);
int32_t prevframe = readint(st, &data);
int32_t pcdiff = readint(st, &data);
/* Get frame items */
Janet *framestack = fiber->data + stack;
JanetStackFrame *framep = janet_stack_frame(framestack);
/* Get function */
Janet funcv;
data = unmarshal_one(st, data, &funcv, flags + 1);
janet_asserttype(funcv, JANET_FUNCTION);
func = janet_unwrap_function(funcv);
def = func->def;
/* Check env */
if (frameflags & JANET_STACKFRAME_HASENV) {
frameflags &= ~JANET_STACKFRAME_HASENV;
int32_t offset = stack;
int32_t length = stacktop - stack;
data = unmarshal_one_env(st, data, &env, flags + 1);
if (env->offset != 0 && env->offset != offset)
janet_panic("funcenv offset does not match fiber frame");
if (env->length != 0 && env->length != length)
janet_panic("funcenv length does not match fiber frame");
env->offset = offset;
env->length = length;
}
/* Error checking */
int32_t expected_framesize = def->slotcount;
if (expected_framesize != stacktop - stack) {
janet_panic("fiber stackframe size mismatch");
}
if (pcdiff < 0 || pcdiff >= def->bytecode_length) {
janet_panic("fiber stackframe has invalid pc");
}
if ((int32_t)(prevframe + JANET_FRAME_SIZE) > stack) {
janet_panic("fibre stackframe does not align with previous frame");
}
/* Get stack items */
for (int32_t i = stack; i < stacktop; i++)
data = unmarshal_one(st, data, fiber->data + i, flags + 1);
/* Set frame */
framep->env = env;
framep->pc = def->bytecode + pcdiff;
framep->prevframe = prevframe;
framep->flags = frameflags;
framep->func = func;
/* Goto previous frame */
stacktop = stack - JANET_FRAME_SIZE;
stack = prevframe;
}
if (stack < 0) {
janet_panic("fiber has too many stackframes");
}
/* Check for fiber env */
if (fiber->flags & JANET_FIBER_FLAG_HASENV) {
Janet envv;
fiber->flags &= ~JANET_FIBER_FLAG_HASENV;
data = unmarshal_one(st, data, &envv, flags + 1);
janet_asserttype(envv, JANET_TABLE);
fiber->env = janet_unwrap_table(envv);
}
/* Check for child fiber */
if (fiber->flags & JANET_FIBER_FLAG_HASCHILD) {
Janet fiberv;
fiber->flags &= ~JANET_FIBER_FLAG_HASCHILD;
data = unmarshal_one(st, data, &fiberv, flags + 1);
janet_asserttype(fiberv, JANET_FIBER);
fiber->child = janet_unwrap_fiber(fiberv);
}
/* Return data */
fiber->frame = frame;
*out = fiber;
return data;
}
int32_t janet_unmarshal_int(JanetMarshalContext *ctx) {
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
return readint(st, &(ctx->data));
}
size_t janet_unmarshal_size(JanetMarshalContext *ctx) {
return (size_t) janet_unmarshal_int64(ctx);
}
int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) {
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
return read64(st, &(ctx->data));
}
uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
MARSH_EOS(st, ctx->data);
return *(ctx->data++);
}
void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len) {
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
MARSH_EOS(st, ctx->data + len - 1);
memcpy(dest, ctx->data, len);
ctx->data += len;
}
Janet janet_unmarshal_janet(JanetMarshalContext *ctx) {
Janet ret;
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
ctx->data = unmarshal_one(st, ctx->data, &ret, ctx->flags);
return ret;
}
static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
Janet key;
data = unmarshal_one(st, data, &key, flags + 1);
const JanetAbstractType *at = janet_get_abstract_type(key);
if (at == NULL) return NULL;
if (at->unmarshal) {
void *p = janet_abstract(at, (size_t) read64(st, &data));
*out = janet_wrap_abstract(p);
JanetMarshalContext context = {NULL, st, flags, data};
janet_v_push(st->lookup, *out);
at->unmarshal(p, &context);
return context.data;
}
return NULL;
}
static const uint8_t *unmarshal_one(
UnmarshalState *st,
const uint8_t *data,
Janet *out,
int flags) {
uint8_t lead;
MARSH_STACKCHECK;
MARSH_EOS(st, data);
lead = data[0];
if (lead < 200) {
*out = janet_wrap_integer(readint(st, &data));
return data;
}
switch (lead) {
case LB_NIL:
*out = janet_wrap_nil();
return data + 1;
case LB_FALSE:
*out = janet_wrap_false();
return data + 1;
case LB_TRUE:
*out = janet_wrap_true();
return data + 1;
case LB_INTEGER:
/* Long integer */
MARSH_EOS(st, data + 4);
uint32_t ui = ((uint32_t)(data[4])) |
((uint32_t)(data[3]) << 8) |
((uint32_t)(data[2]) << 16) |
((uint32_t)(data[1]) << 24);
int32_t si = (int32_t)ui;
*out = janet_wrap_integer(si);
return data + 5;
case LB_REAL:
/* Real */
{
union {
double d;
uint8_t bytes[8];
} u;
MARSH_EOS(st, data + 8);
#ifdef JANET_BIG_ENDIAN
u.bytes[0] = data[8];
u.bytes[1] = data[7];
u.bytes[2] = data[6];
u.bytes[5] = data[5];
u.bytes[4] = data[4];
u.bytes[5] = data[3];
u.bytes[6] = data[2];
u.bytes[7] = data[1];
#else
memcpy(&u.bytes, data + 1, sizeof(double));
#endif
*out = janet_wrap_number_safe(u.d);
janet_v_push(st->lookup, *out);
return data + 9;
}
case LB_STRING:
case LB_SYMBOL:
case LB_BUFFER:
case LB_KEYWORD:
case LB_REGISTRY: {
data++;
int32_t len = readint(st, &data);
MARSH_EOS(st, data - 1 + len);
if (lead == LB_STRING) {
const uint8_t *str = janet_string(data, len);
*out = janet_wrap_string(str);
} else if (lead == LB_SYMBOL) {
const uint8_t *str = janet_symbol(data, len);
*out = janet_wrap_symbol(str);
} else if (lead == LB_KEYWORD) {
const uint8_t *str = janet_keyword(data, len);
*out = janet_wrap_keyword(str);
} else if (lead == LB_REGISTRY) {
if (st->reg) {
Janet regkey = janet_symbolv(data, len);
*out = janet_table_get(st->reg, regkey);
} else {
*out = janet_wrap_nil();
}
} else { /* (lead == LB_BUFFER) */
JanetBuffer *buffer = janet_buffer(len);
buffer->count = len;
memcpy(buffer->data, data, len);
*out = janet_wrap_buffer(buffer);
}
janet_v_push(st->lookup, *out);
return data + len;
}
case LB_FIBER: {
JanetFiber *fiber;
data = unmarshal_one_fiber(st, data + 1, &fiber, flags);
*out = janet_wrap_fiber(fiber);
return data;
}
case LB_FUNCTION: {
JanetFunction *func;
JanetFuncDef *def;
data = unmarshal_one_def(st, data + 1, &def, flags + 1);
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
def->environments_length * sizeof(JanetFuncEnv));
func->def = def;
*out = janet_wrap_function(func);
janet_v_push(st->lookup, *out);
for (int32_t i = 0; i < def->environments_length; i++) {
data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
}
return data;
}
case LB_ABSTRACT: {
data++;
return unmarshal_one_abstract(st, data, out, flags);
}
case LB_REFERENCE:
case LB_ARRAY:
case LB_TUPLE:
case LB_STRUCT:
case LB_TABLE:
case LB_TABLE_PROTO:
/* Things that open with integers */
{
data++;
int32_t len = readint(st, &data);
if (lead == LB_ARRAY) {
/* Array */
JanetArray *array = janet_array(len);
array->count = len;
*out = janet_wrap_array(array);
janet_v_push(st->lookup, *out);
for (int32_t i = 0; i < len; i++) {
data = unmarshal_one(st, data, array->data + i, flags + 1);
}
} else if (lead == LB_TUPLE) {
/* Tuple */
Janet *tup = janet_tuple_begin(len);
int32_t flag = readint(st, &data);
janet_tuple_flag(tup) |= flag << 16;
for (int32_t i = 0; i < len; i++) {
data = unmarshal_one(st, data, tup + i, flags + 1);
}
*out = janet_wrap_tuple(janet_tuple_end(tup));
janet_v_push(st->lookup, *out);
} else if (lead == LB_STRUCT) {
/* Struct */
JanetKV *struct_ = janet_struct_begin(len);
for (int32_t i = 0; i < len; i++) {
Janet key, value;
data = unmarshal_one(st, data, &key, flags + 1);
data = unmarshal_one(st, data, &value, flags + 1);
janet_struct_put(struct_, key, value);
}
*out = janet_wrap_struct(janet_struct_end(struct_));
janet_v_push(st->lookup, *out);
} else if (lead == LB_REFERENCE) {
if (len < 0 || len >= janet_v_count(st->lookup))
janet_panicf("invalid reference %d", len);
*out = st->lookup[len];
} else {
/* Table */
JanetTable *t = janet_table(len);
*out = janet_wrap_table(t);
janet_v_push(st->lookup, *out);
if (lead == LB_TABLE_PROTO) {
Janet proto;
data = unmarshal_one(st, data, &proto, flags + 1);
janet_asserttype(proto, JANET_TABLE);
t->proto = janet_unwrap_table(proto);
}
for (int32_t i = 0; i < len; i++) {
Janet key, value;
data = unmarshal_one(st, data, &key, flags + 1);
data = unmarshal_one(st, data, &value, flags + 1);
janet_table_put(t, key, value);
}
}
return data;
}
default: {
janet_panicf("unknown byte %x at index %d",
*data,
(int)(data - st->start));
return NULL;
}
}
#undef EXTRA
}
Janet janet_unmarshal(
const uint8_t *bytes,
size_t len,
int flags,
JanetTable *reg,
const uint8_t **next) {
UnmarshalState st;
st.start = bytes;
st.end = bytes + len;
st.lookup_defs = NULL;
st.lookup_envs = NULL;
st.lookup = NULL;
st.reg = reg;
Janet out;
const uint8_t *nextbytes = unmarshal_one(&st, bytes, &out, flags);
if (next) *next = nextbytes;
janet_v_free(st.lookup_defs);
janet_v_free(st.lookup_envs);
janet_v_free(st.lookup);
return out;
}
/* C functions */
static Janet cfun_env_lookup(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetTable *env = janet_gettable(argv, 0);
return janet_wrap_table(janet_env_lookup(env));
}
static Janet cfun_marshal(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
JanetBuffer *buffer;
JanetTable *rreg = NULL;
if (argc > 1) {
rreg = janet_gettable(argv, 1);
}
if (argc > 2) {
buffer = janet_getbuffer(argv, 2);
} else {
buffer = janet_buffer(10);
}
janet_marshal(buffer, argv[0], rreg, 0);
return janet_wrap_buffer(buffer);
}
static Janet cfun_unmarshal(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
JanetByteView view = janet_getbytes(argv, 0);
JanetTable *reg = NULL;
if (argc > 1) {
reg = janet_gettable(argv, 1);
}
return janet_unmarshal(view.bytes, (size_t) view.len, 0, reg, NULL);
}
static const JanetReg marsh_cfuns[] = {
{
"marshal", cfun_marshal,
JDOC("(marshal x &opt reverse-lookup buffer)\n\n"
"Marshal a janet value into a buffer and return the buffer. The buffer "
"can the later be unmarshalled to reconstruct the initial value. "
"Optionally, one can pass in a reverse lookup table to not marshal "
"aliased values that are found in the table. Then a forward"
"lookup table can be used to recover the original janet value when "
"unmarshalling.")
},
{
"unmarshal", cfun_unmarshal,
JDOC("(unmarshal buffer &opt lookup)\n\n"
"Unmarshal a janet value from a buffer. An optional lookup table "
"can be provided to allow for aliases to be resolved. Returns the value "
"unmarshalled from the buffer.")
},
{
"env-lookup", cfun_env_lookup,
JDOC("(env-lookup env)\n\n"
"Creates a forward lookup table for unmarshalling from an environment. "
"To create a reverse lookup table, use the invert function to swap keys "
"and values in the returned table.")
},
{NULL, NULL, NULL}
};
/* Module entry point */
void janet_lib_marsh(JanetTable *env) {
janet_core_cfuns(env, NULL, marsh_cfuns);
}
Reference in New Issue View Git Blame Copy Permalink