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