diff options
Diffstat (limited to 'pez.c')
| -rw-r--r-- | pez.c | 146 |
1 files changed, 145 insertions, 1 deletions
@@ -1,7 +1,6 @@ #include "pez.h" #include <assert.h> -#include <errno.h> #include <limits.h> #include <stdarg.h> #include <stdbool.h> @@ -107,6 +106,12 @@ typedef struct Dilambda { Fn *getf, *setf; } Dilambda; +typedef struct UserObj { + OBJHEADER; + const PezUserType *typeid; + char data[]; +} UserObj; + enum { NAMEMAX = 80 }; struct local { @@ -229,6 +234,7 @@ enum { #define unbox_obj(v) ((void *)(intptr_t)(v).r) #define unbox_bool(v) ((bool)((v).r >> 32)) #define unbox_cfn(v) ((PezCFn *)((intptr_t)(v).r >> 2)) +#define unbox_userobj(v) ((UserObj *)unbox_obj(v)) #define objtag(v) (((Obj *)unbox_obj(v))->t) #define isobj_of(v, tag) (isobj(v) && objtag(v) == (tag)) #define box_obj(x) ((Val){(intptr_t)(x)}) @@ -260,6 +266,7 @@ typeof1(Val v) static const char * typestr(Val v) { + const PezUserType *typeid; if (isvoid(v)) return "void"; if (isobj(v)) { @@ -272,6 +279,9 @@ typestr(Val v) case PEZ_TFnProto: return "(function prototype)"; case PEZ_TUpval: return "(upvalue)"; case PEZ_TDilambda: return "dilambda"; + case PEZ_TUserObj: + typeid = unbox_userobj(v)->typeid; + return typeid->name ? typeid->name : "(unknown obj)"; } } if (isnum(v)) @@ -811,6 +821,12 @@ sizeofrecord(Record *rc) return sizeof *rc + sizeof(struct KV) * (1 << rc->exp); } +static size_t +sizeofuserobj(UserObj *o) +{ + return sizeof *o + o->typeid->size; +} + static Record * newrecord(PezContext *cx, uint n, Val *kvs) { @@ -858,6 +874,14 @@ delstring(PezContext *cx, Str *str) --cx->strpool.count; } +static void +deluserobj(PezContext *cx, UserObj *obj) +{ + const PezUserType *typeid = obj->typeid; + if (typeid->dtor) + typeid->dtor(obj->data); +} + static Dilambda * newdilambda(PezContext *cx, Fn *getf, Fn *setf) { @@ -870,6 +894,18 @@ newdilambda(PezContext *cx, Fn *getf, Fn *setf) return dl; } +static bool +box_userobj(PezContext *cx, Val *ret, const PezUserType *typ, void *data) +{ + UserObj *o = newobj(cx, PEZ_TUserObj, sizeof *o + typ->size); + if (!o) return 0; + o->typeid = typ; + memcpy(o->data, data, typ->size); + *ret = box_obj(o); + return 1; +} + + /******/ /* GC */ /******/ @@ -904,6 +940,10 @@ delobj(PezContext *cx, Obj *o) case PEZ_TRecord: sz = sizeofrecord((Record *)o); break; + case PEZ_TUserObj: + sz = sizeofuserobj((UserObj *)o); + deluserobj(cx, (UserObj *)o); + break; } assert(sz); cxfree(cx, o, sz); @@ -2075,6 +2115,12 @@ xprint1(PezContext *cx, struct vals *seen, } ok &= cb(cx, u, "}", 1); TRY(ok); + } else if (isobj_of(v, PEZ_TUserObj)) { + char tmp[100]; + int n; + tmp[99] = 0; + n = snprintf(tmp, sizeof tmp - 1, "#<%s %p>", typestr(v), unbox_obj(v)); + TRY(cb(cx, u, tmp, n)); } else { TRY(cb(cx, u, "#<?\?\?>", 6)); } @@ -2236,6 +2282,79 @@ f_assert(PezContext *cx, int argc) return pez_pushvoid(cx); } +static void +file_dtor(void *d) +{ + FILE **pf = d; + if (*pf) fclose(*pf); + *pf = NULL; +} + +static const PezUserType file_ctype = { + "FILE", + sizeof(FILE *), + file_dtor, +}; + +static bool +f_ioopen(PezContext *cx, int argc) +{ + char buf[9]; + FILE *f; + const char *mode = "r"; + TRY(pez_checksig(cx, argc, "io#open", "string, ?string")); + if (argc == 2) { + mode = pez_getstring(cx, buf, -1); + } + f = fopen(pez_getstring(cx, buf, -argc), mode); + + return f ? pez_pushuserobj(cx, &file_ctype, &f) : pez_pushvoid(cx); +} + +static bool +f_ioread(PezContext *cx, int argc) +{ + FILE *f; + size_t capty, n = 0; + enum { CHUNK = 4096 }; + char *buf; + + if (argc != 1 || !pez_isuserobj(cx, &file_ctype, -1)) { + pez_error(cx, "io#read", "expected FILE"); + return 0; + } + f = *(FILE **)pez_getuserobj(cx, &file_ctype, -1); + buf = malloc(capty = CHUNK); + while (!feof(f) && !ferror(f)) { + if (n + CHUNK >= capty) + buf = realloc(buf, capty <<= 1); + n += fread(buf + n, 1, CHUNK, f); + } + + if (!pez_pushstring(cx, buf, n)) { + free(buf); + return 0; + } + free(buf); + return 1; +} + +static bool +f_ioclose(PezContext *cx, int argc) +{ + FILE **pf; + + if (argc != 1 || !pez_isuserobj(cx, &file_ctype, -1)) { + pez_error(cx, "io#read", "expected FILE"); + return 0; + } + pf = pez_getuserobj(cx, &file_ctype, -1); + fclose(*pf); + *pf = NULL; + + return 1; +} + static const struct coredef { const char *n; PezCFn *f; } core[] = { { "printf", f_printf }, { "sprintf", f_sprintf }, @@ -2244,6 +2363,9 @@ static const struct coredef { const char *n; PezCFn *f; } core[] = { { "array#new", f_arraynew }, { "array#push", f_arraypush }, { "assert", f_assert }, + { "io#open", f_ioopen }, + { "io#read", f_ioread }, + { "io#close", f_ioclose }, }; static bool @@ -4282,6 +4404,15 @@ pez_pushglobal(PezContext *cx, const char *name) } bool +pez_pushuserobj(PezContext *cx, const PezUserType *typeid, void *data) +{ + Val o; + assert(typeid); + TRY(box_userobj(cx, &o, typeid, data)); + return push(cx, o); +} + +bool pez_isvoid(PezContext *cx, int idx) { return isvoid(*iget(cx, idx)); @@ -4325,6 +4456,12 @@ pez_isarray(PezContext *cx, int idx) } bool +pez_isuserobj(PezContext *cx, const PezUserType *typeid, int idx) +{ + return isobj_of1(cx, idx, PEZ_TUserObj) && (!typeid || unbox_userobj(*iget(cx, idx))->typeid == typeid); +} + +bool pez_truthy(PezContext *cx, int idx) { return truthy(*iget(cx, idx)); @@ -4465,6 +4602,13 @@ pez_getstring(PezContext *cx, char buf[8], int idx) return NULL; } +void * +pez_getuserobj(PezContext *cx, const PezUserType *typeid, int idx) +{ + assert(typeid && pez_isuserobj(cx, typeid, idx)); + return unbox_userobj(*iget(cx, idx))->data; +} + const char * pez_fnname(PezContext *cx, int idx) { |