JanetSlot janetc_value(JanetFopts opts, Janet x) {
JanetSlot ret;
JanetCompiler *c = opts.compiler;
// ...
/* Special forms */
if (spec) {
const Janet *tup = janet_unwrap_tuple(x);
ret = spec->compile(opts, janet_tuple_length(tup) - 1, tup + 1);
static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *argv) {
if (argn != 1) {
janetc_cerror(opts.compiler, "expected 1 argument to quasiquote");
return janetc_cslot(janet_wrap_nil());
}
return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0);
}
static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
if (depth == 0) {
janetc_cerror(opts.compiler, "quasiquote too deeply nested");
return janetc_cslot(janet_wrap_nil());
}
JanetSlot *slots = NULL;
JanetFopts subopts = opts;
subopts.flags &= ~JANET_FOPTS_HINT;
switch (janet_type(x)) {
default:
return janetc_cslot(x);
case JANET_TUPLE: {
int32_t i, len;
const Janet *tup = janet_unwrap_tuple(x);
len = janet_tuple_length(tup);
if (len > 1 && janet_checktype(tup[0], JANET_SYMBOL)) {
const uint8_t *head = janet_unwrap_symbol(tup[0]);
if (!janet_cstrcmp(head, "unquote")) {
if (level == 0) {
JanetFopts subopts = janetc_fopts_default(opts.compiler);
subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
return janetc_value(subopts, tup[1]);
} else {
level--;
}
} else if (!janet_cstrcmp(head, "quasiquote")) {
level++;
}
}
for (i = 0; i < len; i++)
janet_v_push(slots, quasiquote(subopts, tup[i], depth - 1, level));
return qq_slots(opts, slots, (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR)
? JOP_MAKE_BRACKET_TUPLE
: JOP_MAKE_TUPLE);
}
case JANET_ARRAY: {
int32_t i;
JanetArray *array = janet_unwrap_array(x);
for (i = 0; i < array->count; i++)
janet_v_push(slots, quasiquote(subopts, array->data[i], depth - 1, level));
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
}
static JanetSlot qq_slots(JanetFopts opts, JanetSlot *slots, int makeop) {
JanetSlot target = janetc_gettarget(opts);
janetc_pushslots(opts.compiler, slots);
janetc_freeslots(opts.compiler, slots);
janetc_emit_s(opts.compiler, makeop, target, 1);
return target;
}
int32_t janetc_emit_s(JanetCompiler *c, uint8_t op, JanetSlot s, int wr) {
int32_t reg = janetc_regfar(c, s, JANETC_REGTEMP_0);
int32_t label = janet_v_count(c->buffer);
janetc_emit(c, op | (reg << 8));
if (wr)
janetc_moveback(c, s, reg);
janetc_free_regnear(c, s, reg, JANETC_REGTEMP_0);
return label;
}
static int32_t janetc_regfar(JanetCompiler *c, JanetSlot s, JanetcRegisterTemp tag) {
/* check if already near register */
if (s.envindex < 0 && s.index >= 0) {
return s.index;
}
int32_t reg;
int32_t nearreg = janetc_regalloc_temp(&c->scope->ra, tag);
janetc_movenear(c, nearreg, s);
if (nearreg >= 0xF0) {
reg = janetc_allocfar(c);
janetc_emit(c, JOP_MOVE_FAR | (nearreg << 8) | (reg << 16));
janetc_regalloc_freetemp(&c->scope->ra, nearreg, tag);
} else {
reg = nearreg;
janetc_regalloc_freetemp(&c->scope->ra, nearreg, tag);
janetc_regalloc_touch(&c->scope->ra, reg);
}
return reg;
}
static void janetc_moveback(JanetCompiler *c,
JanetSlot dest,
int32_t src) {
if (dest.flags & JANET_SLOT_REF) {
int32_t refreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_5);
janetc_loadconst(c, dest.constant, refreg);
janetc_emit(c,
(src << 16) |
(refreg << 8) |
JOP_PUT_INDEX);
janetc_regalloc_freetemp(&c->scope->ra, refreg, JANETC_REGTEMP_5);
} else if (dest.envindex >= 0) {
/* Convert src to near reg */
if (src > 255) {
janetc_emit(c, JOP_MOVE_NEAR | ((uint32_t)(src) << 16) | (JANETC_REGTEMP_5 << 8));
src = JANETC_REGTEMP_5;
}
janetc_emit(c,
((uint32_t)(dest.index) << 24) |
((uint32_t)(dest.envindex) << 16) |
((uint32_t)(src) << 8) |
JOP_SET_UPVALUE);
} else if (dest.index != src) {
janet_assert(dest.index >= 0, "bad slot");
/* Convert src to near reg */
if (src > 255) {
janetc_emit(c, JOP_MOVE_NEAR | ((uint32_t)(src) << 16) | (JANETC_REGTEMP_5 << 8));
src = JANETC_REGTEMP_5;
}
janetc_emit(c,
((uint32_t)(dest.index) << 16) |
((uint32_t)(src) << 8) |
JOP_MOVE_FAR);
}
}how to influence opts before calling janetc_gettarget?
/* Options for compiling a single form */
struct JanetFopts {
JanetCompiler *compiler;
JanetSlot hint;
uint32_t flags; /* bit set of accepted primitive types */
};need opts.flags to not have JANET_FOPTS_HINT be set so that the first branch below is avoided (and thus the second branch taken):
JanetSlot slot;
if ((opts.flags & JANET_FOPTS_HINT) &&
(opts.hint.envindex < 0) &&
(opts.hint.index >= 0 && opts.hint.index <= 0xFF)) {
slot = opts.hint;
} else {
slot.envindex = -1;
slot.constant = janet_wrap_nil();
slot.flags = 0;
slot.index = janetc_allocfar(opts.compiler);
}
return slot;#define JANET_FOPTS_TAIL 0x10000
#define JANET_FOPTS_HINT 0x20000
#define JANET_FOPTS_DROP 0x40000
#define JANET_FOPTS_ACCEPT_SPLICE 0x80000quasiquote has *opts.flags &= ~JANET_FOPTS_HINT try to use that in some way?
static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
// ...
JanetFopts subopts = opts;
subopts.flags &= ~JANET_FOPTS_HINT;
// ...
switch (janet_type(x)) {
// ...
case JANET_ARRAY: {
int32_t i;
JanetArray *array = janet_unwrap_array(x);
for (i = 0; i < array->count; i++)
janet_v_push(slots, quasiquote(subopts, array->data[i], depth - 1, level));
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
}qq_slots also calls janetc_emit_s:
static JanetSlot qq_slots(JanetFopts opts, JanetSlot *slots, int makeop) {
JanetSlot target = janetc_gettarget(opts);
janetc_pushslots(opts.compiler, slots);
janetc_freeslots(opts.compiler, slots);
janetc_emit_s(opts.compiler, makeop, target, 1);
return target;
}