void potion_test_proto(CuTest *T) {
// test compiler transformation potion_sig_compile, not just yy_sig
PN p2;
vPN(Closure) f2;
vPN(Closure) f1 = PN_CLOSURE(potion_eval(P, potion_str(P, "(x,y):x+y.")));
CuAssertIntEquals(T, "arity f1", 2, potion_sig_arity(P, f1->sig));
CuAssertStrEquals(T, "x,y", PN_STR_PTR(potion_sig_string(P,0,f1->sig)));
p2 = PN_FUNC(PN_CLOSURE_F(f1), "x=N,y=N");
f2 = PN_CLOSURE(p2);
CuAssertIntEquals(T, "sig arity f2", 2, potion_sig_arity(P, f2->sig));
CuAssertStrEquals(T, "x=N,y=N", PN_STR_PTR(potion_sig_string(P,0,f2->sig)));
CuAssertIntEquals(T, "cl arity f2", 2, PN_INT(potion_closure_arity(P,0,p2)));
}
void potion_test_allocated(CuTest *T) {
struct PNMemory *M = P->mem;
void *prev = NULL;
void *scanptr = (void *)((char *)M->birth_lo + PN_ALIGN(sizeof(struct PNMemory), 8));
while ((PN)scanptr < (PN)M->birth_cur) {
if (((struct PNFwd *)scanptr)->fwd != POTION_FWD && ((struct PNFwd *)scanptr)->fwd != POTION_COPIED) {
if (((struct PNObject *)scanptr)->vt > PN_TUSER) {
vPN(Object) o = (struct PNObject *)scanptr;
fprintf(stderr, "error: scanning heap from %p to %p\n",
M->birth_lo, M->birth_cur);
fprintf(stderr, "%p in %s region\n", scanptr,
IS_GC_PROTECTED(scanptr) ? "protected"
: IN_BIRTH_REGION(scanptr) ? "birth"
: IN_OLDER_REGION(scanptr) ? "older"
: "gc");
fprintf(stderr, "%p { uniq:0x%08x vt:0x%08x ivars[0]:0x%08lx type:0x%x}\n",
scanptr, o->uniq, o->vt, o->ivars[0],
potion_type((PN)scanptr));
fprintf(stderr, "prev %p: size=%d, type:0x%x (%s)\n",
prev, potion_type_size(P, prev),
potion_type((PN)prev), AS_STR(PN_VTABLE(PN_TYPE((PN)prev))));
#ifdef DEBUG
//potion_dump_stack(P);
#endif
}
CuAssert(T, "wrong type for allocated object", ((struct PNObject *)scanptr)->vt <= PN_TUSER);
}
prev = scanptr;
scanptr = (void *)((char *)scanptr + potion_type_size(P, scanptr));
CuAssert(T, "allocated object goes beyond GC pointer", (PN)scanptr <= (PN)M->birth_cur);
}
}
PN potion_error_string(Potion *P, PN cl, PN self) {
vPN(Error) e = (struct PNError *)self;
if (e->excerpt == PN_NIL)
return potion_str_format(P, "** %s\n", PN_STR_PTR(e->message));
return potion_str_format(P, "** %s\n"
"** Where: (line %ld, character %ld) %s\n", PN_STR_PTR(e->message),
PN_INT(e->line), PN_INT(e->chr), PN_STR_PTR(e->excerpt));
}
PN potion_call(Potion *P, PN cl, PN_SIZE argc, PN * volatile argv) {
vPN(Closure) c = PN_CLOSURE(cl);
switch (argc) {
case 0:
return c->method(P, cl, cl);
case 1:
return c->method(P, cl, argv[0]);
case 2:
return c->method(P, cl, argv[0], argv[1]);
case 3:
return c->method(P, cl, argv[0], argv[1], argv[2]);
case 4:
return c->method(P, cl, argv[0], argv[1], argv[2], argv[3]);
case 5:
return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4]);
case 6:
return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4],
argv[5]);
case 7:
return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4],
argv[5], argv[6]);
case 8:
return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4],
argv[5], argv[6], argv[7]);
case 9:
return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4],
argv[5], argv[6], argv[7], argv[8]);
case 10:
return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4],
argv[5], argv[6], argv[7], argv[8], argv[9]);
case 11:
return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4],
argv[5], argv[6], argv[7], argv[8], argv[9], argv[10]);
case 12:
return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4],
argv[5], argv[6], argv[7], argv[8], argv[9], argv[10], argv[11]);
case 13:
return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4],
argv[5], argv[6], argv[7], argv[8], argv[9], argv[10], argv[11],
argv[12]);
case 14:
return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4],
argv[5], argv[6], argv[7], argv[8], argv[9], argv[10], argv[11],
argv[12], argv[13]);
case 15:
return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4],
argv[5], argv[6], argv[7], argv[8], argv[9], argv[10], argv[11],
argv[12], argv[13], argv[14]);
}
return PN_NIL; // TODO: error "too many arguments"
}
PN potion_proto_string(Potion *P, PN cl, PN self) {
vPN(Proto) t = (struct PNProto *)self;
int x = 0;
PN_SIZE num = 1;
PN_SIZE numcols;
PN out = potion_byte_str(P, "; function definition");
pn_printf(P, out, ": %p ; %u bytes\n", t, PN_FLEX_SIZE(t->asmb));
pn_printf(P, out, "; (");
PN_TUPLE_EACH(t->sig, i, v, {
if (PN_IS_NUM(v)) {
if (v == '.')
pn_printf(P, out, ". ");
else if (v == '|')
pn_printf(P, out, "| ");
else
pn_printf(P, out, "=%c, ", (int)PN_INT(v));
} else
potion_bytes_obj_string(P, out, v);
});
static int
potion_database_callback(void *callback, int argc, char **argv, char **azColName) {
struct PNCallback * cbp = (struct PNCallback *)callback;
if (cbp != NULL) {
vPN(Closure) cb = PN_IS_CLOSURE(cbp->cb) ? PN_CLOSURE(cbp->cb) : NULL;
if (cb) {
Potion *P = cbp->P;
PN table = potion_table_empty(P);
int i;
for (i = 0; i < argc; i++) {
potion_table_put(P, PN_NIL, table, PN_STR(azColName[i]),
argv[i] ? PN_STR(argv[i]) : PN_NIL);
}
// Now call the callback with the table
cb->method(P, (PN)cb, (PN)cb, (PN)table);
}
}
return 0;
}
///\memberof PNProto
/// string method of PNProto. ascii dump of a function definition
PN potion_proto_string(Potion *P, PN cl, PN self) {
vPN(Proto) t = (struct PNProto *)self;
int x = 0;
PN_SIZE num = 1;
PN_SIZE numcols;
PN out = potion_byte_str(P, "; function definition");
#ifdef JIT_DEBUG
pn_printf(P, out, ": %p; %u bytes\n", t, PN_FLEX_SIZE(t->asmb));
#else
pn_printf(P, out, ": %u bytes\n", PN_FLEX_SIZE(t->asmb));
#endif
if (t->name)
pn_printf(P, out, "; %s(", PN_STR_PTR(t->name));
else
pn_printf(P, out, "; (");
potion_bytes_obj_string(P, out, potion_sig_string(P, cl, t->sig));
pn_printf(P, out, ") %ld registers\n", PN_INT(t->stack));
PN_TUPLE_EACH(t->paths, i, v, {
pn_printf(P, out, ".path /");
v = PN_TUPLE_AT(t->values, PN_INT(v));
potion_bytes_obj_string(P, out, v);
pn_printf(P, out, " ; %u\n", i);
});
void potion_dump_stack(Potion *P) {
long n;
PN *end, *ebp, *start = P->mem->cstack;
struct PNMemory *M = P->mem;
POTION_ESP(&end);
POTION_EBP(&ebp);
#if POTION_STACK_DIR > 0
n = end - start;
#else
n = start - end + 1;
start = end;
end = M->cstack;
#endif
printf("-- dumping %ld stack from %p to %p --\n", n, start, end);
printf(" ebp = %p, *ebp = %lx\n", ebp, *ebp);
while (n--) {
vPN(Object) o = (struct PNObject*)*start;
printf(" stack(%ld) = %p: %lx", n, start, *start);
if (IS_GC_PROTECTED(*start))
printf(" vt=%x gc", PN_TYPE(o));
else if (IN_BIRTH_REGION(*start))
printf(" vt=%x gc(0)", PN_TYPE(o));
else if (IN_OLDER_REGION(*start))
printf(" vt=%x gc(1)", PN_TYPE(o));
if (*start == 0)
printf(" nil\n");
else if (*start & 1)
printf(" %ld INT\n", PN_INT(*start));
else if (*start & 2)
printf(" %s BOOL\n", *start == 2 ? "false" : "true");
else
printf(" \n");
start++;
}
}
