void potion_load_code(Potion *P, const char *filename)
{
PN buf, code;
struct stat stats;
int fd = -1;
if (stat(filename, &stats) == -1)
{
potion_notice("** %s does not exist.\n", filename);
return;
}
fd = open(filename, O_RDONLY | O_BINARY);
if (fd == -1)
{
potion_notice("** could not open %s. check permissions.\n", filename);
return;
}
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))
{
potion_run(P,
potion_send(
potion_parse(P, buf), PN_compile, potion_str(P, filename), PN_NIL),
POTION_JIT);
}
}
else
{
potion_notice("** could not read entire file: %s.\n", filename);
}
close(fd);
}
void potion_dump(Potion *P, PN data) {
PN pd = potion_send(data, PN_string);
PN pt = potion_send(PN_VTABLE(PN_TYPE(data)), PN_string);
char *d = pd ? PN_STR_PTR(pd) : "nil";
char *t = pt ? PN_STR_PTR(pt) : "NilKind";
printf("%s (%s)\n", d, t);
}
/**\memberof PNFile
\c "write" a binary representation of obj to the file handle.
\param obj PNString, PNBytes, PNInteger (long or double), PNBoolean (char 0 or 1)
\return PNInteger written bytes or PN_NIL */
PN potion_file_write(Potion *P, PN cl, pn_file self, PN obj) {
long len = 0;
char *ptr = NULL;
union { double d; long l; char c; } tmp;
//TODO: maybe extract ptr+len to seperate function
if (!PN_IS_PTR(obj)) {
if (!obj) return PN_NIL; //silent
else if (PN_IS_INT(obj)) {
tmp.l = PN_NUM(obj); len = sizeof(tmp); ptr = (char *)&tmp.l;
}
else if (PN_IS_BOOL(obj)) {
tmp.c = (obj == PN_TRUE) ? 1 : 0; len = 1; ptr = (char *)&tmp.c;
}
else {
assert(0 && "Invalid primitive type");
}
} else {
switch (PN_TYPE(obj)) {
case PN_TSTRING: len = PN_STR_LEN(obj); ptr = PN_STR_PTR(obj); break;
case PN_TBYTES: len = potion_send(obj, PN_STR("length")); ptr = PN_STR_PTR(obj); break;
case PN_TNUMBER: {
tmp.d = PN_DBL(obj); len = sizeof(tmp); ptr = (char *)&tmp.d;
break;
}
default: return potion_type_error(P, obj);
}
}
int r = write(self->fd, ptr, len);
if (r == -1)
return potion_io_error(P, "write");
return PN_NUM(r);
}
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_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_file_new(Potion *P, PN cl, PN self, PN path, PN modestr) {
int fd;
mode_t mode;
if (strcmp(PN_STR_PTR(modestr), "r") == 0) {
mode = O_RDONLY;
} else if (strcmp(PN_STR_PTR(modestr), "r+") == 0) {
mode = O_RDWR;
} else if (strcmp(PN_STR_PTR(modestr), "w") == 0) {
mode = O_WRONLY | O_TRUNC | O_CREAT;
} else if (strcmp(PN_STR_PTR(modestr), "w+") == 0) {
mode = O_RDWR | O_TRUNC | O_CREAT;
} else if (strcmp(PN_STR_PTR(modestr), "a") == 0) {
mode = O_WRONLY | O_CREAT | O_APPEND;
} else if (strcmp(PN_STR_PTR(modestr), "a+") == 0) {
mode = O_RDWR | O_CREAT | O_APPEND;
} else {
// invalid mode
return PN_NIL;
}
if ((fd = open(PN_STR_PTR(path), mode, 0755)) == -1) {
perror("open");
// TODO: error
return PN_NIL;
}
((struct PNFile *)self)->fd = fd;
((struct PNFile *)self)->path = path;
((struct PNFile *)self)->mode = mode;
return self;
}
/**\memberof PNFile
constructor method. opens a file with 0755 and returns the created PNFile
\param path PNString
\param modestr PNString r,r+,w,w+,a,a+
\return self or PN_NIL */
PN potion_file_new(Potion *P, PN cl, PN self, PN path, PN modestr) {
struct PNFile * file = PN_ALLOC(PN_TFILE, struct PNFile);
int fd;
mode_t mode;
if (strcmp(PN_STR_PTR(modestr), "r") == 0) {
mode = O_RDONLY;
} else if (strcmp(PN_STR_PTR(modestr), "r+") == 0) {
mode = O_RDWR;
} else if (strcmp(PN_STR_PTR(modestr), "w") == 0) {
mode = O_WRONLY | O_TRUNC | O_CREAT;
} else if (strcmp(PN_STR_PTR(modestr), "w+") == 0) {
mode = O_RDWR | O_TRUNC | O_CREAT;
} else if (strcmp(PN_STR_PTR(modestr), "a") == 0) {
mode = O_WRONLY | O_CREAT | O_APPEND;
} else if (strcmp(PN_STR_PTR(modestr), "a+") == 0) {
mode = O_RDWR | O_CREAT | O_APPEND;
} else {
// invalid mode
return PN_NIL;
}
if ((fd = open(PN_STR_PTR(path), mode, 0755)) == -1)
return potion_io_error(P, "open");
file->fd = fd;
file->path = path;
file->mode = mode;
return (PN)file;
}
PN potion_file_write(Potion *P, PN cl, pn_file self, PN str) {
int r = write(self->fd, PN_STR_PTR(str), PN_STR_LEN(str));
if (r == -1) {
perror("write");
// TODO: error
return PN_NIL;
}
return PN_NUM(r);
}
void potion_syntax_error(Potion *P, const char *fmt, ...) {
va_list args;
PN out = potion_bytes(P, 36);
((struct PNBytes * volatile)out)->len = 0;
va_start(args, fmt);
pn_printf(P, out, fmt, args);
va_end(args);
fprintf(stderr, "** Syntax error %s\n", PN_STR_PTR(out));
exit(PN_EXIT_FATAL);
}
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")));
}
PN potion_file_string(Potion *P, PN cl, pn_file self) {
int fd = self->fd, rv;
char *buf;
PN str;
if (self->path != PN_NIL && fd != -1) {
rv = asprintf(&buf, "<file %s fd: %d>", PN_STR_PTR(self->path), fd);
} else if (fd != -1) {
rv = asprintf(&buf, "<file fd: %d>", fd);
} else {
rv = asprintf(&buf, "<closed file>");
}
if (rv == -1) potion_allocation_error();
str = potion_str(P, buf);
free(buf);
return str;
}
PN potion_sqlite_open(Potion *P, PN cl, PN self, PN path) {
struct PNDatabase *db = (struct PNDatabase *)self;
//TODO: Proper error checking
if (!PN_IS_STR(path)) {
return PN_NIL;
}
if (db->db) {
potion_sqlite_close(P, cl, self);
}
sqlite3 *sdb;
int rc = sqlite3_open(PN_STR_PTR(path), &sdb);
if (rc)
return potion_io_error(P, "open");
db->db = sdb;
return self;
}
///\memberof Database
///\param query PNString a select statement
///\return a tuple of all tables (rows)
PN potion_sqlite_gettable(Potion *P, PN cl, PN self, PN query) {
//TODO: Proper error checking
if (!PN_IS_STR(query)) {
return PN_NIL;
}
char *q = PN_STR_PTR(query);
struct PNDatabase *db = PN_GET_DATABASE(self);
if (!db->db) {
return PN_NIL;
}
char **pazResult; /* Results of the query */
int pnRow; /* Number of result rows written here */
int pnColumn; /* Number of result columns written here */
char *pzErrmsg; /* Error msg written here */
int rc = sqlite3_get_table(db->db, q, &pazResult,
&pnRow, &pnColumn, &pzErrmsg);
// Check for error
if (rc != SQLITE_OK) {
// Convert to potion string and return it as an error
fprintf(stderr, "SQL error: %s\n", pzErrmsg);
PN e = potion_io_error(P, pzErrmsg);
sqlite3_free(pzErrmsg);
return e;
}
// Process the table
int i, j;
PN tuple = potion_tuple_empty(P);
// Loop over each row
for (i = 1; i <= pnRow; i++) {
PN table = potion_table_empty(P);
for (j = 0; j < pnColumn; j++) {
char *value = pazResult[i*pnColumn + j];
potion_table_put(P, PN_NIL, table, PN_STR(pazResult[j]),
value ? PN_STR(value) : PN_NIL);
}
PN_PUSH(tuple, table);
}
sqlite3_free_table(pazResult);
return tuple;
}
///\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);
});
///\memberof Database
/// Executes the query statement and optionally calls the callback with the result.
///\param query PNString a SQL statement
///\param callback optional PNClosure with a PNTable row argument
///\return self or nil or an error
PN potion_sqlite_exec(Potion *P, PN cl, PN self, PN query, PN callback) {
//TODO: Proper error checking
if (!PN_IS_STR(query)) {
return PN_NIL;
}
char *zErrMsg = 0;
int rc;
struct PNDatabase *db = (struct PNDatabase *)self;
struct PNCallback *cb = (struct PNCallback*)potion_callback(P, callback);
if (db->db == NULL) {
//FIXME: Return a proper error
return potion_io_error(P, "exec");
}
rc = sqlite3_exec(db->db, PN_STR_PTR(query),
potion_database_callback, cb, &zErrMsg);
if (rc != SQLITE_OK) {
// Convert to potion string and return it as an error
fprintf(stderr, "SQL error: %s\n", zErrMsg);
PN e = potion_io_error(P, zErrMsg);
sqlite3_free(zErrMsg);
return e;
}
return self;
}
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);
}
char *potion_find_file(char *str, PN_SIZE str_len)
{
char *r = NULL;
struct stat st;
PN_TUPLE_EACH(pn_loader_path, i, prefix,
{ PN_SIZE prefix_len = PN_STR_LEN(prefix); char dirname[prefix_len + 1 + str_len + 1]; char *str_pos = dirname + prefix_len + 1; char *dot; const char *ext; memcpy(str_pos, str, str_len); dot = memchr(str, '.', str_len); if (dot == NULL) dirname[sizeof(dirname) - 1] = '\0'; else *dot = '\0'; memcpy(dirname, PN_STR_PTR(prefix), prefix_len); dirname[prefix_len] = '/'; if (stat(dirname, &st) == 0 && S_ISREG(st.st_mode)) { if (asprintf(&r, "%s", dirname) == -1) potion_allocation_error(); break; } else if ((ext = find_extension(dirname)) != NULL) { if (asprintf(&r, "%s%s", dirname, ext) == -1) potion_allocation_error(); break; } else { char *file; if ((file = strrchr(str, '/')) == NULL) file = str; else file++; if (asprintf(&r, "%s/%s", dirname, file) == -1) potion_allocation_error(); if (stat(r, &st) != 0 || !S_ISREG(st.st_mode)) { int r_len = prefix_len + 1 + str_len * 2 + 1; if ((ext = find_extension(r)) == NULL) { free(r); r = NULL; continue; } r = realloc(r, r_len + strlen(ext)); if (r == NULL) potion_allocation_error(); strcpy(r + r_len, ext); } break; } });
