void potion_test_int1(CuTest *T) { PN zero = PN_ZERO; CuAssert(T, "zero isn't zero", PN_INT(zero) == 0); CuAssert(T, "zero isn't a number", PN_IS_INT(zero)); CuAssert(T, "zero is a ref", !PN_IS_PTR(zero)); CuAssert(T, "zero bad add", 490 == PN_INT(potion_send(zero, potion_str(P, "+"), num))); }
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)); }
void potion_test_int3(CuTest *T) { PN neg = PN_NUM(-4343); CuAssert(T, "negative numbers invalid", PN_INT(neg) == -4343); CuAssert(T, "negative not a number", PN_IS_INT(neg)); CuAssert(T, "negative is a ref", !PN_IS_PTR(neg)); CuAssert(T, "negative bad add", -3853 == PN_INT(potion_send(neg, potion_str(P, "+"), num))); }
void potion_test_int2(CuTest *T) { PN pos = PN_NUM(10891); CuAssert(T, "positive numbers invalid", PN_INT(pos) == 10891); CuAssert(T, "positive not a number", PN_IS_INT(pos)); CuAssert(T, "positive is a ref", !PN_IS_PTR(pos)); CuAssert(T, "positive bad add", 11381 == PN_INT(potion_send(pos, potion_str(P, "+"), num))); }
static void potion_cmd_stats(void *sp) { Potion *P = potion_create(sp); printf("sizeof(PN=%d, PNObject=%d, PNTuple=%d, PNTuple+1=%d, PNTable=%d)\n", (int)sizeof(PN), (int)sizeof(struct PNObject), (int)sizeof(struct PNTuple), (int)(sizeof(PN) + sizeof(struct PNTuple)), (int)sizeof(struct PNTable)); printf("GC (fixed=%ld, actual=%ld, reserved=%ld)\n", PN_INT(potion_gc_fixed(P, 0, 0)), PN_INT(potion_gc_actual(P, 0, 0)), PN_INT(potion_gc_reserved(P, 0, 0))); potion_destroy(P); }
void potion_test_sig(CuTest *T) { // test the simple parser entry point yy_sig, not the compiler transformation potion_sig_compile PN sig = potion_sig(P, "num1=N,num2=N"); CuAssert(T, "signature isn't a tuple", PN_IS_TUPLE(sig)); CuAssertIntEquals(T, "len=2", 2, PN_INT(PN_TUPLE_LEN(sig))); CuAssertIntEquals(T, "arity=2", 2, potion_sig_arity(P, sig)); CuAssertStrEquals(T, "num1=N,num2=N", //roundtrip PN_STR_PTR(potion_sig_string(P,0,sig))); CuAssertStrEquals(T, "(num1, 78, num2, 78)", PN_STR_PTR(potion_send(sig, PN_string))); CuAssertStrEquals(T, "num1", PN_STR_PTR(potion_send(PN_TUPLE_AT(sig,0), PN_string))); CuAssertIntEquals(T, "num1=N", 'N', PN_INT(PN_TUPLE_AT(sig,1))); CuAssertStrEquals(T, "num2", PN_STR_PTR(potion_send(PN_TUPLE_AT(sig,2), PN_string))); CuAssertIntEquals(T, "num2=N", 'N', PN_INT(PN_TUPLE_AT(sig,3))); sig = potion_sig(P, "x=N|y=N"); CuAssertStrEquals(T, "(x, 78, 124, y, 78)", PN_STR_PTR(potion_send(sig, PN_string))); CuAssertIntEquals(T, "arity=2", 2, potion_sig_arity(P, sig)); sig = potion_sig(P, "x=N,y=N|r=N"); CuAssert(T, "signature isn't a tuple", PN_IS_TUPLE(sig)); CuAssertStrEquals(T, "(x, 78, y, 78, 124, r, 78)", PN_STR_PTR(potion_send(sig, PN_string))); CuAssertStrEquals(T, "x=N,y=N|r=N", PN_STR_PTR(potion_sig_string(P,0,sig))); CuAssertIntEquals(T, "arity=3", 3, potion_sig_arity(P, sig)); { // roundtrips char *sigs[] = { "", "x,y", "x", "x=N", "x,y", "x=N,y=o", "x|y", "x|y,z", "x=o|y,z", "x|y=o", "x=N,y=N|r=N", /*optional */ "x:=1", "|x:=1", "x|y:=0", /* defaults */ "x,y.z", /* the dot */ }; int size = sizeof(sigs)/sizeof(char *); int i; for (i=0; i< size; i++) { CuAssertStrEquals(T, sigs[i], PN_STR_PTR(potion_sig_string(P,0,potion_sig(P, sigs[i])))); } } CuAssertIntEquals(T, "arity nil", 0, potion_sig_arity(P, PN_NIL)); // sig "" returns PN_FALSE, which throws an error //CuAssertIntEquals(T, "arity ''", 0, potion_sig_arity(P, potion_sig(P, ""))); CuAssertIntEquals(T, "arity x:=1", 1, potion_sig_arity(P, potion_sig(P, "x:=1"))); CuAssertIntEquals(T, "arity |x:=1", 1, potion_sig_arity(P, potion_sig(P, "|x:=1"))); CuAssertIntEquals(T, "arity x|y:=1", 2, potion_sig_arity(P, potion_sig(P, "x|y:=1"))); }
void potion_test_empty(CuTest *T) { PN empty = PN_TUP0(); CuAssert(T, "empty isn't a tuple", PN_IS_TUPLE(empty)); CuAssert(T, "empty isn't a ref", PN_IS_PTR(empty)); CuAssertIntEquals(T, "tuple length is off", 0, PN_INT(potion_send(empty, potion_str(P, "length")))); }
///\return string of the sig tuple. "arg1=o,arg2=o" PN potion_sig_string(Potion *P, PN cl, PN sig) { PN out = potion_byte_str(P, ""); if (PN_IS_TUPLE(sig)) { int nextdef = 0; struct PNTuple * volatile t = ((struct PNTuple *)potion_fwd(sig)); if (t->len != 0) { PN_SIZE i, comma=0; for (i = 0; i < t->len; i++) { PN v = (PN)t->set[i]; if (PN_IS_NUM(v)) { // currently types are still encoded as NUM, TODO: support VTABLE also int c = PN_INT(v); comma=0; if (c == '.') // is end pn_printf(P, out, "."); else if (c == '|') // is optional pn_printf(P, out, "|"); else if (c == ':') { nextdef = 1; pn_printf(P, out, ":"); // is default } else { if (comma++) pn_printf(P, out, ","); if (nextdef) { nextdef = 0; pn_printf(P, out, "="); potion_bytes_obj_string(P, out, v); } else pn_printf(P, out, "=%c", c); } } else { if (comma++) pn_printf(P, out, ","); if (nextdef) { nextdef = 0; pn_printf(P, out, "="); } potion_bytes_obj_string(P, out, v); }}}} return PN_STR_B(out); }
void potion_test_eval(CuTest *T) { PN add, num; PN_F addfn; #if POTION_JIT long flags = P->flags; if (P->flags & EXEC_JIT) P->flags = (Potion_Flags)((int)P->flags - EXEC_JIT); #endif add = potion_eval(P, potion_str(P, "(x, y): x + y.")); addfn = PN_CLOSURE_F(add); // c callback CuAssertPtrNotNull(T, addfn); num = addfn(P, add, 0, PN_NUM(3), PN_NUM(5)); CuAssertIntEquals(T, "calling closure as c func", 8, PN_INT(num)); add = potion_eval(P, potion_str(P, "(x=N|y=N): x + y.")); addfn = PN_CLOSURE_F(add); num = addfn(P, add, 0, PN_NUM(3), PN_NUM(5)); CuAssertIntEquals(T, "calling closure as c func (opt)", 8, PN_INT(num)); num = addfn(P, add, 1, PN_NUM(3)); CuAssertIntEquals(T, "optional num = 0", 3, PN_INT(num)); add = potion_eval(P, potion_str(P, "(x=N,y:=1): x + y.")); addfn = PN_CLOSURE_F(add); num = addfn(P, add, 2, PN_NUM(3), PN_NUM(5)); CuAssertIntEquals(T, "calling closure as c func (default)", 8, PN_INT(num)); num = addfn(P, add, 1, PN_NUM(3)); CuAssertIntEquals(T, "default num = 1", 4, PN_INT(num)); #if POTION_JIT P->flags = (Potion_Flags)flags; //restore JIT add = potion_eval(P, potion_str(P, "(x, y): x + y.")); addfn = PN_CLOSURE_F(add); // c callback CuAssertPtrNotNull(T, addfn); num = addfn(P, add, 0, PN_NUM(3), PN_NUM(5)); CuAssertIntEquals(T, "calling closure as c func (jit)", 8, PN_INT(num)); #ifdef DEBUG //P->flags += DEBUG_COMPILE + DEBUG_JIT; #endif add = potion_eval(P, potion_str(P, "(x=N|y=N): x + y.")); addfn = PN_CLOSURE_F(add); num = addfn(P, add, 0, PN_NUM(3), PN_NUM(5)); CuAssertIntEquals(T, "calling closure as c func (jit+opt)", 8, PN_INT(num)); //hard to make this work, would slow it down //num = addfn(P, add, 0, PN_NUM(3)); //CuAssertIntEquals(T, "optional num = 0 (jit)", 3, PN_INT(num)); add = potion_eval(P, potion_str(P, "(x=N|y:=1): x + y.")); addfn = PN_CLOSURE_F(add); num = addfn(P, add, 0, PN_NUM(3), PN_NUM(5)); CuAssertIntEquals(T, "calling closure as c func (jit+default)", 8, PN_INT(num)); //num = addfn(P, add, 0, PN_NUM(3)); //CuAssertIntEquals(T, "default num = 1 (jit)", 4, PN_INT(num)); #endif }
void potion_test_tuple(CuTest *T) { PN tup = potion_tuple_with_size(P, 3); PN_TUPLE_AT(tup, 0) = PN_NIL; PN_TUPLE_AT(tup, 1) = PN_string; PN_TUPLE_AT(tup, 2) = tup; CuAssert(T, "tuple isn't a tuple", PN_IS_TUPLE(tup)); CuAssert(T, "tuple isn't a ref", PN_IS_PTR(tup)); CuAssertIntEquals(T, "tuple length is off", 3, PN_INT(potion_send(tup, potion_str(P, "length")))); }
PN potion_file_read(Potion *P, PN cl, pn_file self, PN n) { n = PN_INT(n); char buf[n]; int r = read(self->fd, buf, n); if (r == -1) { perror("read"); // TODO: error return PN_NUM(-1); } else if (r == 0) { return PN_NIL; } return potion_byte_str2(P, buf, r); }
PN potion_file_with_fd(Potion *P, PN cl, PN self, PN fd) { struct PNFile *file = (struct PNFile *)potion_object_new(P, PN_NIL, PN_VTABLE(PN_TFILE)); file->fd = PN_INT(fd); file->path = PN_NIL; #ifdef F_GETFL file->mode = fcntl(file->fd, F_GETFL) | O_ACCMODE; #else struct stat st; if (fstat(file->fd, &st) == -1) perror("fstat"); file->mode = st.st_mode; #endif return (PN)file; }
///\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_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))); }
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); });
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++; } }
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); }); 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); }); PN_TUPLE_EACH(t->locals, i, v, { pn_printf(P, out, ".local "); potion_bytes_obj_string(P, out, v); pn_printf(P, out, " ; %u\n", i); }); PN_TUPLE_EACH(t->upvals, i, v, { pn_printf(P, out, ".upval "); potion_bytes_obj_string(P, out, v); pn_printf(P, out, " ; %u\n", i);
void potion_test_str(CuTest *T) { CuAssert(T, "string isn't a string", PN_IS_STR(PN_string)); CuAssert(T, "string isn't a ref", PN_IS_PTR(PN_string)); CuAssert(T, "string length isn't working", 6 == PN_INT(potion_send(PN_string, potion_str(P, "length")))); }
static void potion_cmd_compile ( char *filename, int exec, int verbose, void *sp ) { PN buf, code; int fd = -1; struct stat stats; Potion *P = potion_create(sp); if (stat(filename, &stats) == -1) { potion_warn("** %s does not exist.\n", filename); goto done; } fd = open(filename, O_RDONLY | O_BINARY); if (fd == -1) { potion_warn("** could not open %s. check permissions.\n", filename); goto done; } buf = potion_bytes(P, stats.st_size); if (read(fd, PN_STR_PTR(buf), stats.st_size) == stats.st_size) { PN_STR_PTR(buf)[stats.st_size] = '\0'; code = potion_source_load(P, PN_NIL, buf); if (PN_IS_PROTO(code)) { if (verbose > 1) printf("\n\n-- loaded --\n"); } else { code = potion_parse(P, buf); if (PN_TYPE(code) == PN_TERROR) { potion_send(potion_send(code, PN_string), PN_print); goto done; } if (verbose > 1) { printf("\n-- parsed --\n"); potion_send(potion_send(code, PN_string), PN_print); printf("\n"); } code = potion_send(code, PN_compile, potion_str(P, filename), PN_NIL); if (verbose > 1) printf("\n-- compiled --\n"); } if (verbose > 1) { potion_send(potion_send(code, PN_string), PN_print); printf("\n"); } if (exec == 1) { code = potion_vm(P, code, P->lobby, PN_NIL, 0, NULL ); if (verbose > 1) printf( "\n-- vm returned %p (fixed=%ld, actual=%ld, reserved=%ld) --\n", (void *) code, PN_INT(potion_gc_fixed(P, 0, 0)), PN_INT(potion_gc_actual(P, 0, 0)), PN_INT(potion_gc_reserved(P, 0, 0))); if (verbose) { potion_send(potion_send(code, PN_string), PN_print); printf("\n"); } } else if (exec == 2) { #if POTION_JIT == 1 PN val; PN cl = potion_closure_new(P, (PN_F)potion_jit_proto(P, code, POTION_JIT_TARGET), PN_NIL, 1); PN_CLOSURE(cl)->data[0] = code; val = PN_PROTO(code)->jit(P, cl, P->lobby); if (verbose > 1) printf("\n-- jit returned %p (fixed=%ld, actual=%ld, reserved=%ld) --\n", PN_PROTO(code)->jit, PN_INT(potion_gc_fixed(P, 0, 0)), PN_INT(potion_gc_actual(P, 0, 0)), PN_INT(potion_gc_reserved(P, 0, 0))); if (verbose) { potion_send(potion_send(val, PN_string), PN_print); printf("\n"); } #else potion_warn("** potion built without JIT support\n"); #endif } else { char pnbpath[255]; FILE *pnb; sprintf(pnbpath, "%sb", filename); pnb = fopen(pnbpath, "wb"); if (!pnb) { potion_warn("** could not open %s for writing. check permissions.\n",pnbpath); goto done; } code = potion_source_dump(P, PN_NIL, code); if (fwrite(PN_STR_PTR(code), 1, PN_STR_LEN(code), pnb) == PN_STR_LEN(code)) { potion_notice("** compiled code saved to %s\n", pnbpath); potion_notice("** run it with: potion %s\n", pnbpath); fclose(pnb); } else { potion_warn("** could not write all bytecode.\n"); } } #if 0 void *scanptr = (void *)((char *)P->mem->old_lo + (sizeof(PN) * 2)); while ((PN)scanptr < (PN)P->mem->old_cur) { printf("%p.vt = %lx (%u)\n", scanptr, ((struct PNObject *)scanptr)->vt, potion_type_size(P, scanptr)); if (((struct PNFwd *)scanptr)->fwd != POTION_FWD && ((struct PNFwd *)scanptr)->fwd != POTION_COPIED) { if (((struct PNObject *)scanptr)->vt < 0 || ((struct PNObject *)scanptr)->vt > PN_TUSER) { printf("wrong type for allocated object: %p.vt = %lx\n", scanptr, ((struct PNObject *)scanptr)->vt); break; } } scanptr = (void *)((char *)scanptr + potion_type_size(P, scanptr)); if ((PN)scanptr > (PN)P->mem->old_cur) { printf("allocated object goes beyond GC pointer\n"); break; } } #endif } else { potion_warn("** could not read entire file."); } done: if (fd != -1) close(fd); if (P != NULL ) potion_destroy(P); }