1 /*
2 * Copyright (c) 2021 Calvin Rose
3 *
4 * Permission is hereby granted, free of charge, to any person obtaining a copy
5 * of this software and associated documentation files (the "Software"), to
6 * deal in the Software without restriction, including without limitation the
7 * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
8 * sell copies of the Software, and to permit persons to whom the Software is
9 * furnished to do so, subject to the following conditions:
10 *
11 * The above copyright notice and this permission notice shall be included in
12 * all copies or substantial portions of the Software.
13 *
14 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
17 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19 * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20 * IN THE SOFTWARE.
21 */
22
23 #ifndef JANET_AMALG
24 #include "features.h"
25 #include <janet.h>
26 #include "state.h"
27 #include "vector.h"
28 #include "gc.h"
29 #include "fiber.h"
30 #include "util.h"
31 #endif
32
33 typedef struct {
34 JanetBuffer *buf;
35 JanetTable seen;
36 JanetTable *rreg;
37 JanetFuncEnv **seen_envs;
38 JanetFuncDef **seen_defs;
39 int32_t nextid;
40 } MarshalState;
41
42 /* Lead bytes in marshaling protocol */
43 enum {
44 LB_REAL = 200,
45 LB_NIL, /* 201 */
46 LB_FALSE, /* 202 */
47 LB_TRUE, /* 203 */
48 LB_FIBER, /* 204 */
49 LB_INTEGER, /* 205 */
50 LB_STRING, /* 206 */
51 LB_SYMBOL, /* 207 */
52 LB_KEYWORD, /* 208 */
53 LB_ARRAY, /* 209 */
54 LB_TUPLE, /* 210 */
55 LB_TABLE, /* 211 */
56 LB_TABLE_PROTO, /* 212 */
57 LB_STRUCT, /* 213 */
58 LB_BUFFER, /* 214 */
59 LB_FUNCTION, /* 215 */
60 LB_REGISTRY, /* 216 */
61 LB_ABSTRACT, /* 217 */
62 LB_REFERENCE, /* 218 */
63 LB_FUNCENV_REF, /* 219 */
64 LB_FUNCDEF_REF, /* 220 */
65 LB_UNSAFE_CFUNCTION, /* 221 */
66 LB_UNSAFE_POINTER, /* 222 */
67 LB_STRUCT_PROTO, /* 223 */
68 #ifdef JANET_EV
69 LB_THREADED_ABSTRACT/* 224 */
70 #endif
71 } LeadBytes;
72
73 /* Helper to look inside an entry in an environment */
entry_getval(Janet env_entry)74 static Janet entry_getval(Janet env_entry) {
75 if (janet_checktype(env_entry, JANET_TABLE)) {
76 JanetTable *entry = janet_unwrap_table(env_entry);
77 Janet checkval = janet_table_get(entry, janet_ckeywordv("value"));
78 if (janet_checktype(checkval, JANET_NIL)) {
79 checkval = janet_table_get(entry, janet_ckeywordv("ref"));
80 }
81 return checkval;
82 } else if (janet_checktype(env_entry, JANET_STRUCT)) {
83 const JanetKV *entry = janet_unwrap_struct(env_entry);
84 Janet checkval = janet_struct_get(entry, janet_ckeywordv("value"));
85 if (janet_checktype(checkval, JANET_NIL)) {
86 checkval = janet_struct_get(entry, janet_ckeywordv("ref"));
87 }
88 return checkval;
89 } else {
90 return janet_wrap_nil();
91 }
92 }
93
94 /* Merge values from an environment into an existing lookup table. */
janet_env_lookup_into(JanetTable * renv,JanetTable * env,const char * prefix,int recurse)95 void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix, int recurse) {
96 while (env) {
97 for (int32_t i = 0; i < env->capacity; i++) {
98 if (janet_checktype(env->data[i].key, JANET_SYMBOL)) {
99 if (prefix) {
100 int32_t prelen = (int32_t) strlen(prefix);
101 const uint8_t *oldsym = janet_unwrap_symbol(env->data[i].key);
102 int32_t oldlen = janet_string_length(oldsym);
103 uint8_t *symbuf = janet_smalloc(prelen + oldlen);
104 safe_memcpy(symbuf, prefix, prelen);
105 safe_memcpy(symbuf + prelen, oldsym, oldlen);
106 Janet s = janet_symbolv(symbuf, prelen + oldlen);
107 janet_sfree(symbuf);
108 janet_table_put(renv, s, entry_getval(env->data[i].value));
109 } else {
110 janet_table_put(renv,
111 env->data[i].key,
112 entry_getval(env->data[i].value));
113 }
114 }
115 }
116 env = recurse ? env->proto : NULL;
117 }
118 }
119
120 /* Make a forward lookup table from an environment (for unmarshaling) */
janet_env_lookup(JanetTable * env)121 JanetTable *janet_env_lookup(JanetTable *env) {
122 JanetTable *renv = janet_table(env->count);
123 janet_env_lookup_into(renv, env, NULL, 1);
124 return renv;
125 }
126
127 /* Marshal an integer onto the buffer */
pushint(MarshalState * st,int32_t x)128 static void pushint(MarshalState *st, int32_t x) {
129 if (x >= 0 && x < 128) {
130 janet_buffer_push_u8(st->buf, x);
131 } else if (x <= 8191 && x >= -8192) {
132 uint8_t intbuf[2];
133 intbuf[0] = ((x >> 8) & 0x3F) | 0x80;
134 intbuf[1] = x & 0xFF;
135 janet_buffer_push_bytes(st->buf, intbuf, 2);
136 } else {
137 uint8_t intbuf[5];
138 intbuf[0] = LB_INTEGER;
139 intbuf[1] = (x >> 24) & 0xFF;
140 intbuf[2] = (x >> 16) & 0xFF;
141 intbuf[3] = (x >> 8) & 0xFF;
142 intbuf[4] = x & 0xFF;
143 janet_buffer_push_bytes(st->buf, intbuf, 5);
144 }
145 }
146
pushbyte(MarshalState * st,uint8_t b)147 static void pushbyte(MarshalState *st, uint8_t b) {
148 janet_buffer_push_u8(st->buf, b);
149 }
150
pushbytes(MarshalState * st,const uint8_t * bytes,int32_t len)151 static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
152 janet_buffer_push_bytes(st->buf, bytes, len);
153 }
154
155 /* Marshal a size_t onto the buffer */
push64(MarshalState * st,uint64_t x)156 static void push64(MarshalState *st, uint64_t x) {
157 if (x <= 0xF0) {
158 /* Single byte */
159 pushbyte(st, (uint8_t) x);
160 } else {
161 /* Multibyte, little endian */
162 uint8_t bytes[9];
163 int nbytes = 0;
164 while (x) {
165 bytes[++nbytes] = x & 0xFF;
166 x >>= 8;
167 }
168 bytes[0] = 0xF0 + nbytes;
169 pushbytes(st, bytes, nbytes + 1);
170 }
171 }
172
173 /* Forward declaration to enable mutual recursion. */
174 static void marshal_one(MarshalState *st, Janet x, int flags);
175 static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags);
176 static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags);
177 static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags);
178
179 /* Prevent stack overflows */
180 #define MARSH_STACKCHECK if ((flags & 0xFFFF) > JANET_RECURSION_GUARD) janet_panic("stack overflow")
181
182 /* Marshal a function env */
marshal_one_env(MarshalState * st,JanetFuncEnv * env,int flags)183 static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
184 MARSH_STACKCHECK;
185 for (int32_t i = 0; i < janet_v_count(st->seen_envs); i++) {
186 if (st->seen_envs[i] == env) {
187 pushbyte(st, LB_FUNCENV_REF);
188 pushint(st, i);
189 return;
190 }
191 }
192 janet_env_valid(env);
193 janet_v_push(st->seen_envs, env);
194 if (env->offset > 0 && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
195 pushint(st, 0);
196 pushint(st, env->length);
197 Janet *values = env->as.fiber->data + env->offset;
198 uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset;
199 for (int32_t i = 0; i < env->length; i++) {
200 if (1 & (bitset[i >> 5] >> (i & 0x1F))) {
201 marshal_one(st, values[i], flags + 1);
202 } else {
203 pushbyte(st, LB_NIL);
204 }
205 }
206 } else {
207 janet_env_maybe_detach(env);
208 pushint(st, env->offset);
209 pushint(st, env->length);
210 if (env->offset > 0) {
211 /* On stack variant */
212 marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
213 } else {
214 /* Off stack variant */
215 for (int32_t i = 0; i < env->length; i++)
216 marshal_one(st, env->as.values[i], flags + 1);
217 }
218 }
219 }
220
221 /* Marshal a sequence of u32s */
janet_marshal_u32s(MarshalState * st,const uint32_t * u32s,int32_t n)222 static void janet_marshal_u32s(MarshalState *st, const uint32_t *u32s, int32_t n) {
223 for (int32_t i = 0; i < n; i++) {
224 pushbyte(st, u32s[i] & 0xFF);
225 pushbyte(st, (u32s[i] >> 8) & 0xFF);
226 pushbyte(st, (u32s[i] >> 16) & 0xFF);
227 pushbyte(st, (u32s[i] >> 24) & 0xFF);
228 }
229 }
230
231 /* Marshal a function def */
marshal_one_def(MarshalState * st,JanetFuncDef * def,int flags)232 static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
233 MARSH_STACKCHECK;
234 for (int32_t i = 0; i < janet_v_count(st->seen_defs); i++) {
235 if (st->seen_defs[i] == def) {
236 pushbyte(st, LB_FUNCDEF_REF);
237 pushint(st, i);
238 return;
239 }
240 }
241 /* Add to lookup */
242 janet_v_push(st->seen_defs, def);
243 pushint(st, def->flags);
244 pushint(st, def->slotcount);
245 pushint(st, def->arity);
246 pushint(st, def->min_arity);
247 pushint(st, def->max_arity);
248 pushint(st, def->constants_length);
249 pushint(st, def->bytecode_length);
250 if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
251 pushint(st, def->environments_length);
252 if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
253 pushint(st, def->defs_length);
254 if (def->flags & JANET_FUNCDEF_FLAG_HASNAME)
255 marshal_one(st, janet_wrap_string(def->name), flags);
256 if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE)
257 marshal_one(st, janet_wrap_string(def->source), flags);
258
259 /* marshal constants */
260 for (int32_t i = 0; i < def->constants_length; i++)
261 marshal_one(st, def->constants[i], flags);
262
263 /* marshal the bytecode */
264 janet_marshal_u32s(st, def->bytecode, def->bytecode_length);
265
266 /* marshal the environments if needed */
267 for (int32_t i = 0; i < def->environments_length; i++)
268 pushint(st, def->environments[i]);
269
270 /* marshal the sub funcdefs if needed */
271 for (int32_t i = 0; i < def->defs_length; i++)
272 marshal_one_def(st, def->defs[i], flags);
273
274 /* marshal source maps if needed */
275 if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
276 int32_t current = 0;
277 for (int32_t i = 0; i < def->bytecode_length; i++) {
278 JanetSourceMapping map = def->sourcemap[i];
279 pushint(st, map.line - current);
280 pushint(st, map.column);
281 current = map.line;
282 }
283 }
284
285 /* Marshal closure bitset, if needed */
286 if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
287 janet_marshal_u32s(st, def->closure_bitset, ((def->slotcount + 31) >> 5));
288 }
289 }
290
291 #define JANET_FIBER_FLAG_HASCHILD (1 << 29)
292 #define JANET_FIBER_FLAG_HASENV (1 << 30)
293 #define JANET_STACKFRAME_HASENV (INT32_MIN)
294
295 /* Marshal a fiber */
marshal_one_fiber(MarshalState * st,JanetFiber * fiber,int flags)296 static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
297 MARSH_STACKCHECK;
298 int32_t fflags = fiber->flags;
299 if (fiber->child) fflags |= JANET_FIBER_FLAG_HASCHILD;
300 if (fiber->env) fflags |= JANET_FIBER_FLAG_HASENV;
301 if (janet_fiber_status(fiber) == JANET_STATUS_ALIVE)
302 janet_panic("cannot marshal alive fiber");
303 pushint(st, fflags);
304 pushint(st, fiber->frame);
305 pushint(st, fiber->stackstart);
306 pushint(st, fiber->stacktop);
307 pushint(st, fiber->maxstack);
308 /* Do frames */
309 int32_t i = fiber->frame;
310 int32_t j = fiber->stackstart - JANET_FRAME_SIZE;
311 while (i > 0) {
312 JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
313 if (frame->env) frame->flags |= JANET_STACKFRAME_HASENV;
314 if (!frame->func) janet_panic("cannot marshal fiber with c stackframe");
315 pushint(st, frame->flags);
316 pushint(st, frame->prevframe);
317 int32_t pcdiff = (int32_t)(frame->pc - frame->func->def->bytecode);
318 pushint(st, pcdiff);
319 marshal_one(st, janet_wrap_function(frame->func), flags + 1);
320 if (frame->env) marshal_one_env(st, frame->env, flags + 1);
321 /* Marshal all values in the stack frame */
322 for (int32_t k = i; k < j; k++)
323 marshal_one(st, fiber->data[k], flags + 1);
324 j = i - JANET_FRAME_SIZE;
325 i = frame->prevframe;
326 }
327 if (fiber->env) {
328 marshal_one(st, janet_wrap_table(fiber->env), flags + 1);
329 }
330 if (fiber->child)
331 marshal_one(st, janet_wrap_fiber(fiber->child), flags + 1);
332 marshal_one(st, fiber->last_value, flags + 1);
333 }
334
janet_marshal_size(JanetMarshalContext * ctx,size_t value)335 void janet_marshal_size(JanetMarshalContext *ctx, size_t value) {
336 janet_marshal_int64(ctx, (int64_t) value);
337 }
338
janet_marshal_int64(JanetMarshalContext * ctx,int64_t value)339 void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value) {
340 MarshalState *st = (MarshalState *)(ctx->m_state);
341 push64(st, (uint64_t) value);
342 }
343
janet_marshal_int(JanetMarshalContext * ctx,int32_t value)344 void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
345 MarshalState *st = (MarshalState *)(ctx->m_state);
346 pushint(st, value);
347 }
348
janet_marshal_byte(JanetMarshalContext * ctx,uint8_t value)349 void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
350 MarshalState *st = (MarshalState *)(ctx->m_state);
351 pushbyte(st, value);
352 }
353
janet_marshal_bytes(JanetMarshalContext * ctx,const uint8_t * bytes,size_t len)354 void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len) {
355 MarshalState *st = (MarshalState *)(ctx->m_state);
356 if (len > INT32_MAX) janet_panic("size_t too large to fit in buffer");
357 pushbytes(st, bytes, (int32_t) len);
358 }
359
janet_marshal_janet(JanetMarshalContext * ctx,Janet x)360 void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
361 MarshalState *st = (MarshalState *)(ctx->m_state);
362 marshal_one(st, x, ctx->flags + 1);
363 }
364
janet_marshal_abstract(JanetMarshalContext * ctx,void * abstract)365 void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
366 MarshalState *st = (MarshalState *)(ctx->m_state);
367 janet_table_put(&st->seen,
368 janet_wrap_abstract(abstract),
369 janet_wrap_integer(st->nextid++));
370 }
371
372 #define MARK_SEEN() \
373 janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++))
374
marshal_one_abstract(MarshalState * st,Janet x,int flags)375 static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
376 void *abstract = janet_unwrap_abstract(x);
377 #ifdef JANET_EV
378 /* Threaded abstract types get passed through as pointers in the unsafe mode */
379 if ((flags & JANET_MARSHAL_UNSAFE) &&
380 (JANET_MEMORY_THREADED_ABSTRACT == (janet_abstract_head(abstract)->gc.flags & JANET_MEM_TYPEBITS))) {
381
382 /* Increment refcount before sending message. This prevents a "death in transit" problem
383 * where a message is garbage collected while in transit between two threads - i.e., the sending threads
384 * loses the reference and runs a garbage collection before the receiving thread gets the message. */
385 janet_abstract_incref(abstract);
386 pushbyte(st, LB_THREADED_ABSTRACT);
387 pushbytes(st, (uint8_t *) &abstract, sizeof(abstract));
388 MARK_SEEN();
389 return;
390 }
391 #endif
392 const JanetAbstractType *at = janet_abstract_type(abstract);
393 if (at->marshal) {
394 pushbyte(st, LB_ABSTRACT);
395 marshal_one(st, janet_csymbolv(at->name), flags + 1);
396 JanetMarshalContext context = {st, NULL, flags, NULL, at};
397 at->marshal(abstract, &context);
398 } else {
399 janet_panicf("cannot marshal %p", x);
400 }
401 }
402
403 /* The main body of the marshaling function. Is the main
404 * entry point for the mutually recursive functions. */
marshal_one(MarshalState * st,Janet x,int flags)405 static void marshal_one(MarshalState *st, Janet x, int flags) {
406 MARSH_STACKCHECK;
407 JanetType type = janet_type(x);
408
409 /* Check simple primitives (non reference types, no benefit from memoization) */
410 switch (type) {
411 default:
412 break;
413 case JANET_NIL:
414 pushbyte(st, LB_NIL);
415 return;
416 case JANET_BOOLEAN:
417 pushbyte(st, janet_unwrap_boolean(x) ? LB_TRUE : LB_FALSE);
418 return;
419 case JANET_NUMBER: {
420 double xval = janet_unwrap_number(x);
421 if (janet_checkintrange(xval)) {
422 pushint(st, (int32_t) xval);
423 return;
424 }
425 break;
426 }
427 }
428
429 /* Check reference and registry value */
430 {
431 Janet check = janet_table_get(&st->seen, x);
432 if (janet_checkint(check)) {
433 pushbyte(st, LB_REFERENCE);
434 pushint(st, janet_unwrap_integer(check));
435 return;
436 }
437 if (st->rreg) {
438 check = janet_table_get(st->rreg, x);
439 if (janet_checktype(check, JANET_SYMBOL)) {
440 MARK_SEEN();
441 const uint8_t *regname = janet_unwrap_symbol(check);
442 pushbyte(st, LB_REGISTRY);
443 pushint(st, janet_string_length(regname));
444 pushbytes(st, regname, janet_string_length(regname));
445 return;
446 }
447 }
448 }
449
450 /* Reference types */
451 switch (type) {
452 case JANET_NUMBER: {
453 union {
454 double d;
455 uint8_t bytes[8];
456 } u;
457 u.d = janet_unwrap_number(x);
458 #ifdef JANET_BIG_ENDIAN
459 /* Swap byte order */
460 uint8_t temp;
461 temp = u.bytes[7];
462 u.bytes[7] = u.bytes[0];
463 u.bytes[0] = temp;
464 temp = u.bytes[6];
465 u.bytes[6] = u.bytes[1];
466 u.bytes[1] = temp;
467 temp = u.bytes[5];
468 u.bytes[5] = u.bytes[2];
469 u.bytes[2] = temp;
470 temp = u.bytes[4];
471 u.bytes[4] = u.bytes[3];
472 u.bytes[3] = temp;
473 #endif
474 pushbyte(st, LB_REAL);
475 pushbytes(st, u.bytes, 8);
476 MARK_SEEN();
477 return;
478 }
479 case JANET_STRING:
480 case JANET_SYMBOL:
481 case JANET_KEYWORD: {
482 const uint8_t *str = janet_unwrap_string(x);
483 int32_t length = janet_string_length(str);
484 /* Record reference */
485 MARK_SEEN();
486 uint8_t lb = (type == JANET_STRING) ? LB_STRING :
487 (type == JANET_SYMBOL) ? LB_SYMBOL :
488 LB_KEYWORD;
489 pushbyte(st, lb);
490 pushint(st, length);
491 pushbytes(st, str, length);
492 return;
493 }
494 case JANET_BUFFER: {
495 JanetBuffer *buffer = janet_unwrap_buffer(x);
496 /* Record reference */
497 MARK_SEEN();
498 pushbyte(st, LB_BUFFER);
499 pushint(st, buffer->count);
500 pushbytes(st, buffer->data, buffer->count);
501 return;
502 }
503 case JANET_ARRAY: {
504 int32_t i;
505 JanetArray *a = janet_unwrap_array(x);
506 MARK_SEEN();
507 pushbyte(st, LB_ARRAY);
508 pushint(st, a->count);
509 for (i = 0; i < a->count; i++)
510 marshal_one(st, a->data[i], flags + 1);
511 return;
512 }
513 case JANET_TUPLE: {
514 int32_t i, count, flag;
515 const Janet *tup = janet_unwrap_tuple(x);
516 count = janet_tuple_length(tup);
517 flag = janet_tuple_flag(tup) >> 16;
518 pushbyte(st, LB_TUPLE);
519 pushint(st, count);
520 pushint(st, flag);
521 for (i = 0; i < count; i++)
522 marshal_one(st, tup[i], flags + 1);
523 /* Mark as seen AFTER marshaling */
524 MARK_SEEN();
525 return;
526 }
527 case JANET_TABLE: {
528 JanetTable *t = janet_unwrap_table(x);
529 MARK_SEEN();
530 pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
531 pushint(st, t->count);
532 if (t->proto)
533 marshal_one(st, janet_wrap_table(t->proto), flags + 1);
534 for (int32_t i = 0; i < t->capacity; i++) {
535 if (janet_checktype(t->data[i].key, JANET_NIL))
536 continue;
537 marshal_one(st, t->data[i].key, flags + 1);
538 marshal_one(st, t->data[i].value, flags + 1);
539 }
540 return;
541 }
542 case JANET_STRUCT: {
543 int32_t count;
544 const JanetKV *struct_ = janet_unwrap_struct(x);
545 count = janet_struct_length(struct_);
546 pushbyte(st, janet_struct_proto(struct_) ? LB_STRUCT_PROTO : LB_STRUCT);
547 pushint(st, count);
548 if (janet_struct_proto(struct_))
549 marshal_one(st, janet_wrap_struct(janet_struct_proto(struct_)), flags + 1);
550 for (int32_t i = 0; i < janet_struct_capacity(struct_); i++) {
551 if (janet_checktype(struct_[i].key, JANET_NIL))
552 continue;
553 marshal_one(st, struct_[i].key, flags + 1);
554 marshal_one(st, struct_[i].value, flags + 1);
555 }
556 /* Mark as seen AFTER marshaling */
557 MARK_SEEN();
558 return;
559 }
560 case JANET_ABSTRACT: {
561 marshal_one_abstract(st, x, flags);
562 return;
563 }
564 case JANET_FUNCTION: {
565 pushbyte(st, LB_FUNCTION);
566 JanetFunction *func = janet_unwrap_function(x);
567 pushint(st, func->def->environments_length);
568 /* Mark seen before reading def */
569 MARK_SEEN();
570 marshal_one_def(st, func->def, flags);
571 for (int32_t i = 0; i < func->def->environments_length; i++)
572 marshal_one_env(st, func->envs[i], flags + 1);
573 return;
574 }
575 case JANET_FIBER: {
576 MARK_SEEN();
577 pushbyte(st, LB_FIBER);
578 marshal_one_fiber(st, janet_unwrap_fiber(x), flags + 1);
579 return;
580 }
581 case JANET_CFUNCTION: {
582 if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
583 MARK_SEEN();
584 pushbyte(st, LB_UNSAFE_CFUNCTION);
585 JanetCFunction cfn = janet_unwrap_cfunction(x);
586 pushbytes(st, (uint8_t *) &cfn, sizeof(JanetCFunction));
587 return;
588 }
589 case JANET_POINTER: {
590 if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
591 MARK_SEEN();
592 pushbyte(st, LB_UNSAFE_POINTER);
593 void *ptr = janet_unwrap_pointer(x);
594 pushbytes(st, (uint8_t *) &ptr, sizeof(void *));
595 return;
596 }
597 no_registry:
598 default: {
599 janet_panicf("no registry value and cannot marshal %p", x);
600 }
601 }
602 #undef MARK_SEEN
603 }
604
janet_marshal(JanetBuffer * buf,Janet x,JanetTable * rreg,int flags)605 void janet_marshal(
606 JanetBuffer *buf,
607 Janet x,
608 JanetTable *rreg,
609 int flags) {
610 MarshalState st;
611 st.buf = buf;
612 st.nextid = 0;
613 st.seen_defs = NULL;
614 st.seen_envs = NULL;
615 st.rreg = rreg;
616 janet_table_init(&st.seen, 0);
617 marshal_one(&st, x, flags);
618 janet_table_deinit(&st.seen);
619 janet_v_free(st.seen_envs);
620 janet_v_free(st.seen_defs);
621 }
622
623 typedef struct {
624 jmp_buf err;
625 Janet *lookup;
626 JanetTable *reg;
627 JanetFuncEnv **lookup_envs;
628 JanetFuncDef **lookup_defs;
629 const uint8_t *start;
630 const uint8_t *end;
631 } UnmarshalState;
632
633 #define MARSH_EOS(st, data) do { \
634 if ((data) >= (st)->end) janet_panic("unexpected end of source");\
635 } while (0)
636
637 /* Helper to read a 32 bit integer from an unmarshal state */
readint(UnmarshalState * st,const uint8_t ** atdata)638 static int32_t readint(UnmarshalState *st, const uint8_t **atdata) {
639 const uint8_t *data = *atdata;
640 int32_t ret;
641 MARSH_EOS(st, data);
642 if (*data < 128) {
643 ret = *data++;
644 } else if (*data < 192) {
645 MARSH_EOS(st, data + 1);
646 uint32_t uret = ((data[0] & 0x3F) << 8) + data[1];
647 /* Sign extend 18 MSBs */
648 uret |= (uret >> 13) ? 0xFFFFC000 : 0;
649 ret = (int32_t)uret;
650 data += 2;
651 } else if (*data == LB_INTEGER) {
652 MARSH_EOS(st, data + 4);
653 uint32_t ui = ((uint32_t)(data[1]) << 24) |
654 ((uint32_t)(data[2]) << 16) |
655 ((uint32_t)(data[3]) << 8) |
656 (uint32_t)(data[4]);
657 ret = (int32_t)ui;
658 data += 5;
659 } else {
660 janet_panicf("expected integer, got byte %x at index %d",
661 *data,
662 data - st->start);
663 ret = 0;
664 }
665 *atdata = data;
666 return ret;
667 }
668
669 /* Helper to read a natural number (int >= 0). */
readnat(UnmarshalState * st,const uint8_t ** atdata)670 static int32_t readnat(UnmarshalState *st, const uint8_t **atdata) {
671 int32_t ret = readint(st, atdata);
672 if (ret < 0) {
673 janet_panicf("expected integer >= 0, got %d", ret);
674 }
675 return ret;
676 }
677
678 /* Helper to read a size_t (up to 8 bytes unsigned). */
read64(UnmarshalState * st,const uint8_t ** atdata)679 static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
680 uint64_t ret;
681 const uint8_t *data = *atdata;
682 MARSH_EOS(st, data);
683 if (*data <= 0xF0) {
684 /* Single byte */
685 ret = *data;
686 *atdata = data + 1;
687 } else {
688 /* Multibyte, little endian */
689 int nbytes = *data - 0xF0;
690 ret = 0;
691 if (nbytes > 8) janet_panic("invalid 64 bit integer");
692 MARSH_EOS(st, data + nbytes);
693 for (int i = nbytes; i > 0; i--)
694 ret = (ret << 8) + data[i];
695 *atdata = data + nbytes + 1;
696 }
697 return ret;
698 }
699
700 /* Assert a janet type */
janet_asserttype(Janet x,JanetType t)701 static void janet_asserttype(Janet x, JanetType t) {
702 if (!janet_checktype(x, t)) {
703 janet_panicf("expected type %T, got %v", 1 << t, x);
704 }
705 }
706
707 /* Forward declarations for mutual recursion */
708 static const uint8_t *unmarshal_one(
709 UnmarshalState *st,
710 const uint8_t *data,
711 Janet *out,
712 int flags);
713 static const uint8_t *unmarshal_one_env(
714 UnmarshalState *st,
715 const uint8_t *data,
716 JanetFuncEnv **out,
717 int flags);
718 static const uint8_t *unmarshal_one_def(
719 UnmarshalState *st,
720 const uint8_t *data,
721 JanetFuncDef **out,
722 int flags);
723 static const uint8_t *unmarshal_one_fiber(
724 UnmarshalState *st,
725 const uint8_t *data,
726 JanetFiber **out,
727 int flags);
728
729 /* Unmarshal a funcenv */
unmarshal_one_env(UnmarshalState * st,const uint8_t * data,JanetFuncEnv ** out,int flags)730 static const uint8_t *unmarshal_one_env(
731 UnmarshalState *st,
732 const uint8_t *data,
733 JanetFuncEnv **out,
734 int flags) {
735 MARSH_EOS(st, data);
736 if (*data == LB_FUNCENV_REF) {
737 data++;
738 int32_t index = readint(st, &data);
739 if (index < 0 || index >= janet_v_count(st->lookup_envs))
740 janet_panicf("invalid funcenv reference %d", index);
741 *out = st->lookup_envs[index];
742 } else {
743 JanetFuncEnv *env = janet_gcalloc(JANET_MEMORY_FUNCENV, sizeof(JanetFuncEnv));
744 env->length = 0;
745 env->offset = 0;
746 env->as.values = NULL;
747 janet_v_push(st->lookup_envs, env);
748 int32_t offset = readnat(st, &data);
749 int32_t length = readnat(st, &data);
750 if (offset > 0) {
751 Janet fiberv;
752 /* On stack variant */
753 data = unmarshal_one(st, data, &fiberv, flags);
754 janet_asserttype(fiberv, JANET_FIBER);
755 env->as.fiber = janet_unwrap_fiber(fiberv);
756 /* Negative offset indicates untrusted input */
757 env->offset = -offset;
758 } else {
759 /* Off stack variant */
760 if (length == 0) {
761 janet_panic("invalid funcenv length");
762 }
763 env->as.values = janet_malloc(sizeof(Janet) * (size_t) length);
764 if (!env->as.values) {
765 JANET_OUT_OF_MEMORY;
766 }
767 env->offset = 0;
768 for (int32_t i = 0; i < length; i++)
769 data = unmarshal_one(st, data, env->as.values + i, flags);
770 }
771 env->length = length;
772 *out = env;
773 }
774 return data;
775 }
776
777 /* Unmarshal a series of u32s */
janet_unmarshal_u32s(UnmarshalState * st,const uint8_t * data,uint32_t * into,int32_t n)778 static const uint8_t *janet_unmarshal_u32s(UnmarshalState *st, const uint8_t *data, uint32_t *into, int32_t n) {
779 for (int32_t i = 0; i < n; i++) {
780 MARSH_EOS(st, data + 3);
781 into[i] =
782 (uint32_t)(data[0]) |
783 ((uint32_t)(data[1]) << 8) |
784 ((uint32_t)(data[2]) << 16) |
785 ((uint32_t)(data[3]) << 24);
786 data += 4;
787 }
788 return data;
789 }
790
791 /* Unmarshal a funcdef */
unmarshal_one_def(UnmarshalState * st,const uint8_t * data,JanetFuncDef ** out,int flags)792 static const uint8_t *unmarshal_one_def(
793 UnmarshalState *st,
794 const uint8_t *data,
795 JanetFuncDef **out,
796 int flags) {
797 MARSH_EOS(st, data);
798 if (*data == LB_FUNCDEF_REF) {
799 data++;
800 int32_t index = readint(st, &data);
801 if (index < 0 || index >= janet_v_count(st->lookup_defs))
802 janet_panicf("invalid funcdef reference %d", index);
803 *out = st->lookup_defs[index];
804 } else {
805 /* Initialize with values that will not break garbage collection
806 * if unmarshalling fails. */
807 JanetFuncDef *def = janet_gcalloc(JANET_MEMORY_FUNCDEF, sizeof(JanetFuncDef));
808 def->environments_length = 0;
809 def->defs_length = 0;
810 def->constants_length = 0;
811 def->bytecode_length = 0;
812 def->name = NULL;
813 def->source = NULL;
814 def->closure_bitset = NULL;
815 def->defs = NULL;
816 def->environments = NULL;
817 def->constants = NULL;
818 def->bytecode = NULL;
819 def->sourcemap = NULL;
820 janet_v_push(st->lookup_defs, def);
821
822 /* Set default lengths to zero */
823 int32_t bytecode_length = 0;
824 int32_t constants_length = 0;
825 int32_t environments_length = 0;
826 int32_t defs_length = 0;
827
828 /* Read flags and other fixed values */
829 def->flags = readint(st, &data);
830 def->slotcount = readnat(st, &data);
831 def->arity = readnat(st, &data);
832 def->min_arity = readnat(st, &data);
833 def->max_arity = readnat(st, &data);
834
835 /* Read some lengths */
836 constants_length = readnat(st, &data);
837 bytecode_length = readnat(st, &data);
838 if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
839 environments_length = readnat(st, &data);
840 if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
841 defs_length = readnat(st, &data);
842
843 /* Check name and source (optional) */
844 if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
845 Janet x;
846 data = unmarshal_one(st, data, &x, flags + 1);
847 janet_asserttype(x, JANET_STRING);
848 def->name = janet_unwrap_string(x);
849 }
850 if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE) {
851 Janet x;
852 data = unmarshal_one(st, data, &x, flags + 1);
853 janet_asserttype(x, JANET_STRING);
854 def->source = janet_unwrap_string(x);
855 }
856
857 /* Unmarshal constants */
858 if (constants_length) {
859 def->constants = janet_malloc(sizeof(Janet) * constants_length);
860 if (!def->constants) {
861 JANET_OUT_OF_MEMORY;
862 }
863 for (int32_t i = 0; i < constants_length; i++)
864 data = unmarshal_one(st, data, def->constants + i, flags + 1);
865 } else {
866 def->constants = NULL;
867 }
868 def->constants_length = constants_length;
869
870 /* Unmarshal bytecode */
871 def->bytecode = janet_malloc(sizeof(uint32_t) * bytecode_length);
872 if (!def->bytecode) {
873 JANET_OUT_OF_MEMORY;
874 }
875 data = janet_unmarshal_u32s(st, data, def->bytecode, bytecode_length);
876 def->bytecode_length = bytecode_length;
877
878 /* Unmarshal environments */
879 if (def->flags & JANET_FUNCDEF_FLAG_HASENVS) {
880 def->environments = janet_calloc(1, sizeof(int32_t) * (size_t) environments_length);
881 if (!def->environments) {
882 JANET_OUT_OF_MEMORY;
883 }
884 for (int32_t i = 0; i < environments_length; i++) {
885 def->environments[i] = readint(st, &data);
886 }
887 } else {
888 def->environments = NULL;
889 }
890 def->environments_length = environments_length;
891
892 /* Unmarshal sub funcdefs */
893 if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS) {
894 def->defs = janet_calloc(1, sizeof(JanetFuncDef *) * (size_t) defs_length);
895 if (!def->defs) {
896 JANET_OUT_OF_MEMORY;
897 }
898 for (int32_t i = 0; i < defs_length; i++) {
899 data = unmarshal_one_def(st, data, def->defs + i, flags + 1);
900 }
901 } else {
902 def->defs = NULL;
903 }
904 def->defs_length = defs_length;
905
906 /* Unmarshal source maps if needed */
907 if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
908 int32_t current = 0;
909 def->sourcemap = janet_malloc(sizeof(JanetSourceMapping) * (size_t) bytecode_length);
910 if (!def->sourcemap) {
911 JANET_OUT_OF_MEMORY;
912 }
913 for (int32_t i = 0; i < bytecode_length; i++) {
914 current += readint(st, &data);
915 def->sourcemap[i].line = current;
916 def->sourcemap[i].column = readint(st, &data);
917 }
918 } else {
919 def->sourcemap = NULL;
920 }
921
922 /* Unmarshal closure bitset if needed */
923 if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
924 int32_t n = (def->slotcount + 31) >> 5;
925 def->closure_bitset = janet_malloc(sizeof(uint32_t) * (size_t) n);
926 if (NULL == def->closure_bitset) {
927 JANET_OUT_OF_MEMORY;
928 }
929 data = janet_unmarshal_u32s(st, data, def->closure_bitset, n);
930 }
931
932 /* Validate */
933 if (janet_verify(def))
934 janet_panic("funcdef has invalid bytecode");
935
936 /* Set def */
937 *out = def;
938 }
939 return data;
940 }
941
942 /* Unmarshal a fiber */
unmarshal_one_fiber(UnmarshalState * st,const uint8_t * data,JanetFiber ** out,int flags)943 static const uint8_t *unmarshal_one_fiber(
944 UnmarshalState *st,
945 const uint8_t *data,
946 JanetFiber **out,
947 int flags) {
948
949 /* Initialize a new fiber with gc friendly defaults */
950 JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
951 fiber->flags = 0;
952 fiber->frame = 0;
953 fiber->stackstart = 0;
954 fiber->stacktop = 0;
955 fiber->capacity = 0;
956 fiber->maxstack = 0;
957 fiber->data = NULL;
958 fiber->child = NULL;
959 fiber->env = NULL;
960 fiber->last_value = janet_wrap_nil();
961 #ifdef JANET_EV
962 fiber->waiting = NULL;
963 fiber->sched_id = 0;
964 fiber->supervisor_channel = NULL;
965 #endif
966
967 /* Push fiber to seen stack */
968 janet_v_push(st->lookup, janet_wrap_fiber(fiber));
969
970 /* Read ints */
971 int32_t fiber_flags = readint(st, &data);
972 int32_t frame = readnat(st, &data);
973 int32_t fiber_stackstart = readnat(st, &data);
974 int32_t fiber_stacktop = readnat(st, &data);
975 int32_t fiber_maxstack = readnat(st, &data);
976 JanetTable *fiber_env = NULL;
977
978 /* Check for bad flags and ints */
979 if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber_stackstart ||
980 fiber_stackstart > fiber_stacktop ||
981 fiber_stacktop > fiber_maxstack) {
982 janet_panic("fiber has incorrect stack setup");
983 }
984
985 /* Allocate stack memory */
986 fiber->capacity = fiber_stacktop + 10;
987 fiber->data = janet_malloc(sizeof(Janet) * fiber->capacity);
988 if (!fiber->data) {
989 JANET_OUT_OF_MEMORY;
990 }
991 for (int32_t i = 0; i < fiber->capacity; i++) {
992 fiber->data[i] = janet_wrap_nil();
993 }
994
995 /* get frames */
996 int32_t stack = frame;
997 int32_t stacktop = fiber_stackstart - JANET_FRAME_SIZE;
998 while (stack > 0) {
999 JanetFunction *func = NULL;
1000 JanetFuncDef *def = NULL;
1001 JanetFuncEnv *env = NULL;
1002 int32_t frameflags = readint(st, &data);
1003 int32_t prevframe = readnat(st, &data);
1004 int32_t pcdiff = readnat(st, &data);
1005
1006 /* Get frame items */
1007 Janet *framestack = fiber->data + stack;
1008 JanetStackFrame *framep = janet_stack_frame(framestack);
1009
1010 /* Get function */
1011 Janet funcv;
1012 data = unmarshal_one(st, data, &funcv, flags + 1);
1013 janet_asserttype(funcv, JANET_FUNCTION);
1014 func = janet_unwrap_function(funcv);
1015 def = func->def;
1016
1017 /* Check env */
1018 if (frameflags & JANET_STACKFRAME_HASENV) {
1019 frameflags &= ~JANET_STACKFRAME_HASENV;
1020 data = unmarshal_one_env(st, data, &env, flags + 1);
1021 }
1022
1023 /* Error checking */
1024 int32_t expected_framesize = def->slotcount;
1025 if (expected_framesize != stacktop - stack) {
1026 janet_panic("fiber stackframe size mismatch");
1027 }
1028 if (pcdiff >= def->bytecode_length) {
1029 janet_panic("fiber stackframe has invalid pc");
1030 }
1031 if ((int32_t)(prevframe + JANET_FRAME_SIZE) > stack) {
1032 janet_panic("fiber stackframe does not align with previous frame");
1033 }
1034
1035 /* Get stack items */
1036 for (int32_t i = stack; i < stacktop; i++)
1037 data = unmarshal_one(st, data, fiber->data + i, flags + 1);
1038
1039 /* Set frame */
1040 framep->env = env;
1041 framep->pc = def->bytecode + pcdiff;
1042 framep->prevframe = prevframe;
1043 framep->flags = frameflags;
1044 framep->func = func;
1045
1046 /* Goto previous frame */
1047 stacktop = stack - JANET_FRAME_SIZE;
1048 stack = prevframe;
1049 }
1050 if (stack < 0) {
1051 janet_panic("fiber has too many stackframes");
1052 }
1053
1054 /* Check for fiber env */
1055 if (fiber_flags & JANET_FIBER_FLAG_HASENV) {
1056 Janet envv;
1057 fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
1058 data = unmarshal_one(st, data, &envv, flags + 1);
1059 janet_asserttype(envv, JANET_TABLE);
1060 fiber_env = janet_unwrap_table(envv);
1061 }
1062
1063 /* Check for child fiber */
1064 if (fiber_flags & JANET_FIBER_FLAG_HASCHILD) {
1065 Janet fiberv;
1066 fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
1067 data = unmarshal_one(st, data, &fiberv, flags + 1);
1068 janet_asserttype(fiberv, JANET_FIBER);
1069 fiber->child = janet_unwrap_fiber(fiberv);
1070 }
1071
1072 /* Get the fiber last value */
1073 data = unmarshal_one(st, data, &fiber->last_value, flags + 1);
1074
1075 /* We have valid fiber, finally construct remaining fields. */
1076 fiber->frame = frame;
1077 fiber->flags = fiber_flags;
1078 fiber->stackstart = fiber_stackstart;
1079 fiber->stacktop = fiber_stacktop;
1080 fiber->maxstack = fiber_maxstack;
1081 fiber->env = fiber_env;
1082
1083 int status = janet_fiber_status(fiber);
1084 if (status < 0 || status > JANET_STATUS_ALIVE) {
1085 janet_panic("invalid fiber status");
1086 }
1087
1088 /* Return data */
1089 *out = fiber;
1090 return data;
1091 }
1092
janet_unmarshal_ensure(JanetMarshalContext * ctx,size_t size)1093 void janet_unmarshal_ensure(JanetMarshalContext *ctx, size_t size) {
1094 UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
1095 MARSH_EOS(st, ctx->data + size);
1096 }
1097
janet_unmarshal_int(JanetMarshalContext * ctx)1098 int32_t janet_unmarshal_int(JanetMarshalContext *ctx) {
1099 UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
1100 return readint(st, &(ctx->data));
1101 }
1102
janet_unmarshal_size(JanetMarshalContext * ctx)1103 size_t janet_unmarshal_size(JanetMarshalContext *ctx) {
1104 return (size_t) janet_unmarshal_int64(ctx);
1105 }
1106
janet_unmarshal_int64(JanetMarshalContext * ctx)1107 int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) {
1108 UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
1109 return read64(st, &(ctx->data));
1110 }
1111
janet_unmarshal_byte(JanetMarshalContext * ctx)1112 uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
1113 UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
1114 MARSH_EOS(st, ctx->data);
1115 return *(ctx->data++);
1116 }
1117
janet_unmarshal_bytes(JanetMarshalContext * ctx,uint8_t * dest,size_t len)1118 void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len) {
1119 UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
1120 MARSH_EOS(st, ctx->data + len - 1);
1121 safe_memcpy(dest, ctx->data, len);
1122 ctx->data += len;
1123 }
1124
janet_unmarshal_janet(JanetMarshalContext * ctx)1125 Janet janet_unmarshal_janet(JanetMarshalContext *ctx) {
1126 Janet ret;
1127 UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
1128 ctx->data = unmarshal_one(st, ctx->data, &ret, ctx->flags);
1129 return ret;
1130 }
1131
janet_unmarshal_abstract_reuse(JanetMarshalContext * ctx,void * p)1132 void janet_unmarshal_abstract_reuse(JanetMarshalContext *ctx, void *p) {
1133 UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
1134 if (ctx->at == NULL) {
1135 janet_panicf("janet_unmarshal_abstract called more than once");
1136 }
1137 janet_v_push(st->lookup, janet_wrap_abstract(p));
1138 ctx->at = NULL;
1139 }
1140
janet_unmarshal_abstract(JanetMarshalContext * ctx,size_t size)1141 void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) {
1142 void *p = janet_abstract(ctx->at, size);
1143 janet_unmarshal_abstract_reuse(ctx, p);
1144 return p;
1145 }
1146
unmarshal_one_abstract(UnmarshalState * st,const uint8_t * data,Janet * out,int flags)1147 static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
1148 Janet key;
1149 data = unmarshal_one(st, data, &key, flags + 1);
1150 const JanetAbstractType *at = janet_get_abstract_type(key);
1151 if (at == NULL) janet_panic("unknown abstract type");
1152 if (at->unmarshal) {
1153 JanetMarshalContext context = {NULL, st, flags, data, at};
1154 *out = janet_wrap_abstract(at->unmarshal(&context));
1155 if (context.at != NULL) {
1156 janet_panic("janet_unmarshal_abstract not called");
1157 }
1158 return context.data;
1159 }
1160 janet_panic("invalid abstract type - no unmarshal function pointer");
1161 }
1162
unmarshal_one(UnmarshalState * st,const uint8_t * data,Janet * out,int flags)1163 static const uint8_t *unmarshal_one(
1164 UnmarshalState *st,
1165 const uint8_t *data,
1166 Janet *out,
1167 int flags) {
1168 uint8_t lead;
1169 MARSH_STACKCHECK;
1170 MARSH_EOS(st, data);
1171 lead = data[0];
1172 if (lead < LB_REAL) {
1173 *out = janet_wrap_integer(readint(st, &data));
1174 return data;
1175 }
1176 switch (lead) {
1177 case LB_NIL:
1178 *out = janet_wrap_nil();
1179 return data + 1;
1180 case LB_FALSE:
1181 *out = janet_wrap_false();
1182 return data + 1;
1183 case LB_TRUE:
1184 *out = janet_wrap_true();
1185 return data + 1;
1186 case LB_INTEGER:
1187 /* Long integer */
1188 MARSH_EOS(st, data + 4);
1189 uint32_t ui = ((uint32_t)(data[4])) |
1190 ((uint32_t)(data[3]) << 8) |
1191 ((uint32_t)(data[2]) << 16) |
1192 ((uint32_t)(data[1]) << 24);
1193 int32_t si = (int32_t)ui;
1194 *out = janet_wrap_integer(si);
1195 return data + 5;
1196 case LB_REAL:
1197 /* Real */
1198 {
1199 union {
1200 double d;
1201 uint8_t bytes[8];
1202 } u;
1203 MARSH_EOS(st, data + 8);
1204 #ifdef JANET_BIG_ENDIAN
1205 u.bytes[0] = data[8];
1206 u.bytes[1] = data[7];
1207 u.bytes[2] = data[6];
1208 u.bytes[3] = data[5];
1209 u.bytes[4] = data[4];
1210 u.bytes[5] = data[3];
1211 u.bytes[6] = data[2];
1212 u.bytes[7] = data[1];
1213 #else
1214 memcpy(&u.bytes, data + 1, sizeof(double));
1215 #endif
1216 *out = janet_wrap_number_safe(u.d);
1217 janet_v_push(st->lookup, *out);
1218 return data + 9;
1219 }
1220 case LB_STRING:
1221 case LB_SYMBOL:
1222 case LB_BUFFER:
1223 case LB_KEYWORD:
1224 case LB_REGISTRY: {
1225 data++;
1226 int32_t len = readnat(st, &data);
1227 MARSH_EOS(st, data - 1 + len);
1228 if (lead == LB_STRING) {
1229 const uint8_t *str = janet_string(data, len);
1230 *out = janet_wrap_string(str);
1231 } else if (lead == LB_SYMBOL) {
1232 const uint8_t *str = janet_symbol(data, len);
1233 *out = janet_wrap_symbol(str);
1234 } else if (lead == LB_KEYWORD) {
1235 const uint8_t *str = janet_keyword(data, len);
1236 *out = janet_wrap_keyword(str);
1237 } else if (lead == LB_REGISTRY) {
1238 if (st->reg) {
1239 Janet regkey = janet_symbolv(data, len);
1240 *out = janet_table_get(st->reg, regkey);
1241 } else {
1242 *out = janet_wrap_nil();
1243 }
1244 } else { /* (lead == LB_BUFFER) */
1245 JanetBuffer *buffer = janet_buffer(len);
1246 buffer->count = len;
1247 safe_memcpy(buffer->data, data, len);
1248 *out = janet_wrap_buffer(buffer);
1249 }
1250 janet_v_push(st->lookup, *out);
1251 return data + len;
1252 }
1253 case LB_FIBER: {
1254 JanetFiber *fiber;
1255 data = unmarshal_one_fiber(st, data + 1, &fiber, flags);
1256 *out = janet_wrap_fiber(fiber);
1257 return data;
1258 }
1259 case LB_FUNCTION: {
1260 JanetFunction *func;
1261 JanetFuncDef *def;
1262 data++;
1263 int32_t len = readnat(st, &data);
1264 if (len > 255) {
1265 janet_panicf("invalid function - too many environments (%d)", len);
1266 }
1267 func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
1268 len * sizeof(JanetFuncEnv));
1269 func->def = NULL;
1270 *out = janet_wrap_function(func);
1271 janet_v_push(st->lookup, *out);
1272 data = unmarshal_one_def(st, data, &def, flags + 1);
1273 func->def = def;
1274 for (int32_t i = 0; i < len; i++) {
1275 data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
1276 }
1277 return data;
1278 }
1279 case LB_ABSTRACT: {
1280 data++;
1281 return unmarshal_one_abstract(st, data, out, flags);
1282 }
1283 case LB_REFERENCE:
1284 case LB_ARRAY:
1285 case LB_TUPLE:
1286 case LB_STRUCT:
1287 case LB_STRUCT_PROTO:
1288 case LB_TABLE:
1289 case LB_TABLE_PROTO:
1290 /* Things that open with integers */
1291 {
1292 data++;
1293 int32_t len = readnat(st, &data);
1294 /* DOS check */
1295 if (lead != LB_REFERENCE) {
1296 MARSH_EOS(st, data - 1 + len);
1297 }
1298 if (lead == LB_ARRAY) {
1299 /* Array */
1300 JanetArray *array = janet_array(len);
1301 array->count = len;
1302 *out = janet_wrap_array(array);
1303 janet_v_push(st->lookup, *out);
1304 for (int32_t i = 0; i < len; i++) {
1305 data = unmarshal_one(st, data, array->data + i, flags + 1);
1306 }
1307 } else if (lead == LB_TUPLE) {
1308 /* Tuple */
1309 Janet *tup = janet_tuple_begin(len);
1310 int32_t flag = readint(st, &data);
1311 janet_tuple_flag(tup) |= flag << 16;
1312 for (int32_t i = 0; i < len; i++) {
1313 data = unmarshal_one(st, data, tup + i, flags + 1);
1314 }
1315 *out = janet_wrap_tuple(janet_tuple_end(tup));
1316 janet_v_push(st->lookup, *out);
1317 } else if (lead == LB_STRUCT || lead == LB_STRUCT_PROTO) {
1318 /* Struct */
1319 JanetKV *struct_ = janet_struct_begin(len);
1320 if (lead == LB_STRUCT_PROTO) {
1321 Janet proto;
1322 data = unmarshal_one(st, data, &proto, flags + 1);
1323 janet_asserttype(proto, JANET_STRUCT);
1324 janet_struct_proto(struct_) = janet_unwrap_struct(proto);
1325 }
1326 for (int32_t i = 0; i < len; i++) {
1327 Janet key, value;
1328 data = unmarshal_one(st, data, &key, flags + 1);
1329 data = unmarshal_one(st, data, &value, flags + 1);
1330 janet_struct_put(struct_, key, value);
1331 }
1332 *out = janet_wrap_struct(janet_struct_end(struct_));
1333 janet_v_push(st->lookup, *out);
1334 } else if (lead == LB_REFERENCE) {
1335 if (len >= janet_v_count(st->lookup))
1336 janet_panicf("invalid reference %d", len);
1337 *out = st->lookup[len];
1338 } else {
1339 /* Table */
1340 JanetTable *t = janet_table(len);
1341 *out = janet_wrap_table(t);
1342 janet_v_push(st->lookup, *out);
1343 if (lead == LB_TABLE_PROTO) {
1344 Janet proto;
1345 data = unmarshal_one(st, data, &proto, flags + 1);
1346 janet_asserttype(proto, JANET_TABLE);
1347 t->proto = janet_unwrap_table(proto);
1348 }
1349 for (int32_t i = 0; i < len; i++) {
1350 Janet key, value;
1351 data = unmarshal_one(st, data, &key, flags + 1);
1352 data = unmarshal_one(st, data, &value, flags + 1);
1353 janet_table_put(t, key, value);
1354 }
1355 }
1356 return data;
1357 }
1358 case LB_UNSAFE_POINTER: {
1359 MARSH_EOS(st, data + sizeof(void *));
1360 data++;
1361 if (!(flags & JANET_MARSHAL_UNSAFE)) {
1362 janet_panicf("unsafe flag not given, "
1363 "will not unmarshal raw pointer at index %d",
1364 (int)(data - st->start));
1365 }
1366 union {
1367 void *ptr;
1368 uint8_t bytes[sizeof(void *)];
1369 } u;
1370 memcpy(u.bytes, data, sizeof(void *));
1371 data += sizeof(void *);
1372 *out = janet_wrap_pointer(u.ptr);
1373 janet_v_push(st->lookup, *out);
1374 return data;
1375 }
1376 case LB_UNSAFE_CFUNCTION: {
1377 MARSH_EOS(st, data + sizeof(JanetCFunction));
1378 data++;
1379 if (!(flags & JANET_MARSHAL_UNSAFE)) {
1380 janet_panicf("unsafe flag not given, "
1381 "will not unmarshal function pointer at index %d",
1382 (int)(data - st->start));
1383 }
1384 union {
1385 JanetCFunction ptr;
1386 uint8_t bytes[sizeof(JanetCFunction)];
1387 } u;
1388 memcpy(u.bytes, data, sizeof(JanetCFunction));
1389 data += sizeof(JanetCFunction);
1390 *out = janet_wrap_cfunction(u.ptr);
1391 janet_v_push(st->lookup, *out);
1392 return data;
1393 }
1394 #ifdef JANET_EV
1395 case LB_THREADED_ABSTRACT: {
1396 MARSH_EOS(st, data + sizeof(void *));
1397 data++;
1398 if (!(flags & JANET_MARSHAL_UNSAFE)) {
1399 janet_panicf("unsafe flag not given, "
1400 "will not unmarshal threaded abstract pointer at index %d",
1401 (int)(data - st->start));
1402 }
1403 union {
1404 void *ptr;
1405 uint8_t bytes[sizeof(void *)];
1406 } u;
1407 memcpy(u.bytes, data, sizeof(void *));
1408 data += sizeof(void *);
1409
1410 if (flags & JANET_MARSHAL_DECREF) {
1411 /* Decrement immediately and don't bother putting into heap */
1412 janet_abstract_decref(u.ptr);
1413 *out = janet_wrap_nil();
1414 } else {
1415 *out = janet_wrap_abstract(u.ptr);
1416 Janet check = janet_table_get(&janet_vm.threaded_abstracts, *out);
1417 if (janet_checktype(check, JANET_NIL)) {
1418 /* Transfers reference from threaded channel buffer to current heap */
1419 janet_table_put(&janet_vm.threaded_abstracts, *out, janet_wrap_false());
1420 } else {
1421 /* Heap reference already accounted for, remove threaded channel reference. */
1422 janet_abstract_decref(u.ptr);
1423 }
1424 }
1425
1426 janet_v_push(st->lookup, *out);
1427 return data;
1428 }
1429 #endif
1430 default: {
1431 janet_panicf("unknown byte %x at index %d",
1432 *data,
1433 (int)(data - st->start));
1434 return NULL;
1435 }
1436 }
1437 }
1438
janet_unmarshal(const uint8_t * bytes,size_t len,int flags,JanetTable * reg,const uint8_t ** next)1439 Janet janet_unmarshal(
1440 const uint8_t *bytes,
1441 size_t len,
1442 int flags,
1443 JanetTable *reg,
1444 const uint8_t **next) {
1445 UnmarshalState st;
1446 st.start = bytes;
1447 st.end = bytes + len;
1448 st.lookup_defs = NULL;
1449 st.lookup_envs = NULL;
1450 st.lookup = NULL;
1451 st.reg = reg;
1452 Janet out;
1453 const uint8_t *nextbytes = unmarshal_one(&st, bytes, &out, flags);
1454 if (next) *next = nextbytes;
1455 janet_v_free(st.lookup_defs);
1456 janet_v_free(st.lookup_envs);
1457 janet_v_free(st.lookup);
1458 return out;
1459 }
1460
1461 /* C functions */
1462
1463 JANET_CORE_FN(cfun_env_lookup,
1464 "(env-lookup env)",
1465 "Creates a forward lookup table for unmarshalling from an environment. "
1466 "To create a reverse lookup table, use the invert function to swap keys "
1467 "and values in the returned table.") {
1468 janet_fixarity(argc, 1);
1469 JanetTable *env = janet_gettable(argv, 0);
1470 return janet_wrap_table(janet_env_lookup(env));
1471 }
1472
1473 JANET_CORE_FN(cfun_marshal,
1474 "(marshal x &opt reverse-lookup buffer)",
1475 "Marshal a value into a buffer and return the buffer. The buffer "
1476 "can then later be unmarshalled to reconstruct the initial value. "
1477 "Optionally, one can pass in a reverse lookup table to not marshal "
1478 "aliased values that are found in the table. Then a forward "
1479 "lookup table can be used to recover the original value when "
1480 "unmarshalling.") {
1481 janet_arity(argc, 1, 3);
1482 JanetBuffer *buffer;
1483 JanetTable *rreg = NULL;
1484 if (argc > 1) {
1485 rreg = janet_gettable(argv, 1);
1486 }
1487 if (argc > 2) {
1488 buffer = janet_getbuffer(argv, 2);
1489 } else {
1490 buffer = janet_buffer(10);
1491 }
1492 janet_marshal(buffer, argv[0], rreg, 0);
1493 return janet_wrap_buffer(buffer);
1494 }
1495
1496 JANET_CORE_FN(cfun_unmarshal,
1497 "(unmarshal buffer &opt lookup)",
1498 "Unmarshal a value from a buffer. An optional lookup table "
1499 "can be provided to allow for aliases to be resolved. Returns the value "
1500 "unmarshalled from the buffer.") {
1501 janet_arity(argc, 1, 2);
1502 JanetByteView view = janet_getbytes(argv, 0);
1503 JanetTable *reg = NULL;
1504 if (argc > 1) {
1505 reg = janet_gettable(argv, 1);
1506 }
1507 return janet_unmarshal(view.bytes, (size_t) view.len, 0, reg, NULL);
1508 }
1509
1510 /* Module entry point */
janet_lib_marsh(JanetTable * env)1511 void janet_lib_marsh(JanetTable *env) {
1512 JanetRegExt marsh_cfuns[] = {
1513 JANET_CORE_REG("marshal", cfun_marshal),
1514 JANET_CORE_REG("unmarshal", cfun_unmarshal),
1515 JANET_CORE_REG("env-lookup", cfun_env_lookup),
1516 JANET_REG_END
1517 };
1518 janet_core_cfuns_ext(env, NULL, marsh_cfuns);
1519 }
1520