/* print a dump of the name string stacks, global and local */ void xpost_name_dump_names(Xpost_Context *ctx) { unsigned int stk; unsigned int cnt, i; Xpost_Object str; char *s; xpost_memory_table_get_addr(ctx->gl, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK, &stk); cnt = xpost_stack_count(ctx->gl, stk); printf("global names:\n"); for (i=0; i < cnt; i++){ str = xpost_stack_bottomup_fetch(ctx->gl, stk, i); s = xpost_string_get_pointer(ctx, str); printf("%u: %*s\n", i, str.comp_.sz, s); } xpost_memory_table_get_addr(ctx->lo, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK, &stk); cnt = xpost_stack_count(ctx->lo, stk); printf("local names:\n"); for (i=0; i < cnt; i++) { str = xpost_stack_bottomup_fetch(ctx->lo, stk, i); s = xpost_string_get_pointer(ctx, str); printf("%u: %*s\n", i, str.comp_.sz, s); } }
/* add the name to the name stack, return index */ static unsigned int addname(Xpost_Context *ctx, const char *s) { Xpost_Memory_File *mem = ctx->vmmode==GLOBAL?ctx->gl:ctx->lo; unsigned int names; unsigned int u; Xpost_Object str; xpost_memory_table_get_addr(mem, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK, &names); u = xpost_stack_count(mem, names); //xpost_memory_file_dump(ctx->gl); //dumpmtab(ctx->gl, 0); //unsigned int vmmode = ctx->vmmode; //ctx->vmmode = GLOBAL; str = xpost_string_cons(ctx, strlen(s), s); if (xpost_object_get_type(str) == nulltype) { XPOST_LOG_ERR("cannot allocate name string"); return 0; } xpost_stack_push(mem, names, str); //ctx->vmmode = vmmode; return u; }
/* |- any1..anyN count |- any1..anyN N count elements on stack */ static int Zcount (Xpost_Context *ctx) { if (!xpost_stack_push(ctx->lo, ctx->os, xpost_int_cons(xpost_stack_count(ctx->lo, ctx->os)))) return stackoverflow; return 0; }
/* mark all allocations referred to by objects in save stack */ static int _xpost_garbage_mark_save(Xpost_Context *ctx, Xpost_Memory_File *mem, unsigned int stackadr) { if (!mem) return 0; { Xpost_Stack *s = (Xpost_Stack *)(mem->base + stackadr); unsigned int i; #ifdef DEBUG_GC printf("marking save stack of size %u\n", xpost_stack_count(mem, stackadr)); #endif next: for (i=0; i < s->top; i++) { /* _xpost_garbage_mark_object(ctx, mem, s->data[i]); */ if (!_xpost_garbage_mark_save_stack(ctx, mem, s->data[i].save_.stk)) return 0; } if (i==XPOST_STACK_SEGMENT_SIZE) { /* ie. s->top == XPOST_STACK_SEGMENT_SIZE */ s = (void *)(mem->base + s->nextseg); goto next; } } return 1; }
/* mark all allocations referred to by objects in stack */ static int _xpost_garbage_mark_stack(Xpost_Context *ctx, Xpost_Memory_File *mem, unsigned int stackadr, int markall) { if (!mem) return 0; { Xpost_Stack *s = (Xpost_Stack *)(mem->base + stackadr); unsigned int i; #ifdef DEBUG_GC printf("marking stack of size %u\n", xpost_stack_count(mem, stackadr)); #endif next: for (i=0; i < s->top; i++) { if (!_xpost_garbage_mark_object(ctx, mem, s->data[i], markall)) return 0; } if (i==XPOST_STACK_SEGMENT_SIZE) { /* ie. s->top == XPOST_STACK_SEGMENT_SIZE */ if (s->nextseg == 0) return 0; s = (Xpost_Stack *)(mem->base + s->nextseg); goto next; } /* if (s->nextseg) { /\* maybe not. this is a MARK phase, after all *\/ */ /* xpost_stack_free(mem, s->nextseg); */ /* s->nextseg = 0; */ /* } */ } return 1; }
/* - vmstatus level used max return size information for (local) vm */ static int Zvmstatus (Xpost_Context *ctx) { unsigned int vs; xpost_memory_table_get_addr(ctx->lo, XPOST_MEMORY_TABLE_SPECIAL_SAVE_STACK, &vs); xpost_stack_push(ctx->lo, ctx->os, xpost_int_cons(xpost_stack_count(ctx->lo, vs))); xpost_stack_push(ctx->lo, ctx->os, xpost_int_cons(ctx->lo->used)); xpost_stack_push(ctx->lo, ctx->os, xpost_int_cons(ctx->lo->max)); return 0; }
/* mark obj1..objN counttomark N count elements down to mark */ int xpost_op_counttomark (Xpost_Context *ctx) { unsigned i; unsigned z; z = xpost_stack_count(ctx->lo, ctx->os); for (i = 0; i < z; i++) { if (xpost_stack_topdown_fetch(ctx->lo, ctx->os, i).tag == marktype) { xpost_stack_push(ctx->lo, ctx->os, xpost_int_cons(i)); return 0; } } return unmatchedmark; }
/* add a string to the ternary search tree */ static int tstinsert(Xpost_Memory_File *mem, unsigned int tadr, const char *s, unsigned int *retval) { tst *p; unsigned int t; //temporary unsigned int nstk; int ret; if (!tadr) { if (!xpost_memory_file_alloc(mem, sizeof(tst), &tadr)) { XPOST_LOG_ERR("cannot allocate tree node"); return VMerror; } p = (void *)(mem->base + tadr); p->val = *s; p->lo = p->eq = p->hi = 0; } p = (void *)(mem->base + tadr); if ((unsigned int)*s < p->val) { ret = tstinsert(mem, p->lo, s, &t); if (ret) return ret; p = (void *)(mem->base + tadr); //recalc pointer p->lo = t; } else if ((unsigned int)*s == p->val) { if (*s) { ret = tstinsert(mem, p->eq, ++s, &t); if (ret) return ret; p = (void *)(mem->base + tadr); //recalc pointer p->eq = t; }else { xpost_memory_table_get_addr(mem, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK, &nstk); p->eq = xpost_stack_count(mem, nstk); /* payload when val == '\0' */ } } else { ret = tstinsert(mem, p->hi, s, &t); if (ret) return ret; p = (void *)(mem->base + tadr); //recalc pointer p->hi = t; } //return tadr; *retval = tadr; return 0; }
/* anyN..any0 N index anyN..any0 anyN duplicate arbitrary element */ static int Iindex (Xpost_Context *ctx, Xpost_Object n) { if (n.int_.val < 0) return rangecheck; if (n.int_.val >= xpost_stack_count(ctx->lo, ctx->os)) return stackunderflow; //printf("index %d\n", n.int_.val); if (!xpost_stack_push(ctx->lo, ctx->os, xpost_stack_topdown_fetch(ctx->lo, ctx->os, n.int_.val))) return stackoverflow; return 0; }
/* any1..anyN N copy any1..anyN any1..anyN duplicate top n elements */ static int Icopy (Xpost_Context *ctx, Xpost_Object n) { int i; if (n.int_.val < 0) return rangecheck; if (n.int_.val > xpost_stack_count(ctx->lo, ctx->os)) return stackunderflow; for (i=0; i < n.int_.val; i++) if (!xpost_stack_push(ctx->lo, ctx->os, xpost_stack_topdown_fetch(ctx->lo, ctx->os, n.int_.val - 1))) return stackoverflow; return 0; }
/* - currentfile file return topmost file from the exec stack */ static int xpost_op_currentfile (Xpost_Context *ctx) { int z = xpost_stack_count(ctx->lo, ctx->es); int i; Xpost_Object o; for (i = 0; i<z; i++) { o = xpost_stack_topdown_fetch(ctx->lo, ctx->es, i); if (xpost_object_get_type(o) == filetype) { xpost_stack_push(ctx->lo, ctx->os, o); return 0; } } o = xpost_file_cons(ctx->lo, NULL); if (xpost_object_get_type(o) == invalidtype) return VMerror; xpost_stack_push(ctx->lo, ctx->os, o); return 0; }
/* save restore - rewind vm to saved state */ static int Vrestore (Xpost_Context *ctx, Xpost_Object V) { int z; unsigned int vs; int ret; ret = xpost_memory_table_get_addr(ctx->lo, XPOST_MEMORY_TABLE_SPECIAL_SAVE_STACK, &vs); if (!ret) { XPOST_LOG_ERR("cannot retrieve address for save stack"); return VMerror; } z = xpost_stack_count(ctx->lo, vs); while(z > V.save_.lev) { xpost_save_restore_snapshot(ctx->lo); z--; } printf("restore\n"); return 0; }
/* execute ps program until quit, fall-through to quit, SHOWPAGE_RETURN semantic, or error (default action: message, purge and quit). */ XPAPI int xpost_run(Xpost_Context *ctx, Xpost_Input_Type input_type, const void *inputptr, size_t set_size) { Xpost_Object lsav = null; int llev = 0; unsigned int vs; const char *ps_str = NULL; const char *ps_file = NULL; const FILE *ps_file_ptr = NULL; int ret; Xpost_Object device; Xpost_Object semantic; switch(input_type) { case XPOST_INPUT_FILENAME: ps_file = inputptr; break; case XPOST_INPUT_STRING: ps_str = inputptr; ps_file_ptr = tmpfile(); if (set_size) fwrite(ps_str, 1, set_size, (FILE*)ps_file_ptr); else fwrite(ps_str, 1, strlen(ps_str), (FILE*)ps_file_ptr); rewind((FILE*)ps_file_ptr); break; case XPOST_INPUT_FILEPTR: ps_file_ptr = inputptr; break; case XPOST_INPUT_RESUME: /* resuming a returned session, skip startup */ goto run; } /* prime the exec stack so it starts with a 'start*' procedure, and if it ever gets to the bottom, it quits. These procedures are all defined in data/init.ps */ xpost_stack_push(ctx->lo, ctx->es, xpost_operator_cons(ctx, "quit", NULL,0,0)); /* if ps_file is NULL: if stdin is a tty `start` proc defined in init.ps runs `executive` which prompts for user input else 'startstdin' executes stdin but does not prompt if ps_file is not NULL: 'startfile' executes a named file wrapped in a stopped context with handleerror */ if (ps_file) { /*printf("ps_file\n"); */ xpost_stack_push(ctx->lo, ctx->os, xpost_object_cvlit(xpost_string_cons(ctx, strlen(ps_file), ps_file))); xpost_stack_push(ctx->lo, ctx->es, xpost_object_cvx(xpost_name_cons(ctx, "startfilename"))); } else if (ps_file_ptr) { xpost_stack_push(ctx->lo, ctx->os, xpost_object_cvlit(xpost_file_cons(ctx->lo, ps_file_ptr))); xpost_stack_push(ctx->lo, ctx->es, xpost_object_cvx(xpost_name_cons(ctx, "startfile"))); } else { if (xpost_isatty(fileno(stdin))) xpost_stack_push(ctx->lo, ctx->es, xpost_object_cvx(xpost_name_cons(ctx, "start"))); else xpost_stack_push(ctx->lo, ctx->es, xpost_object_cvx(xpost_name_cons(ctx, "startstdin"))); } (void) xpost_save_create_snapshot_object(ctx->gl); lsav = xpost_save_create_snapshot_object(ctx->lo); /* Run! */ run: ctx->quit = 0; ctx->state = C_RUN; ret = mainloop(ctx); semantic = xpost_dict_get(ctx, xpost_stack_bottomup_fetch(ctx->lo, ctx->ds, 0), xpost_name_cons(ctx, "ShowpageSemantics")); if (semantic.int_.val == XPOST_SHOWPAGE_RETURN) return ret == 1 ? yieldtocaller : 0; XPOST_LOG_INFO("destroying device"); device = xpost_dict_get(ctx, xpost_stack_bottomup_fetch(ctx->lo, ctx->ds, 2), xpost_name_cons(ctx, "DEVICE")); XPOST_LOG_INFO("device type=%s", xpost_object_type_names[xpost_object_get_type(device)]); /*xpost_operator_dump(ctx, 1); // is this pointer value constant? */ if (xpost_object_get_type(device) == arraytype){ XPOST_LOG_INFO("running proc"); xpost_stack_push(ctx->lo, ctx->es, xpost_operator_cons(ctx, "quit", NULL,0,0)); xpost_stack_push(ctx->lo, ctx->es, device); ctx->quit = 0; mainloop(ctx); device = xpost_stack_pop(ctx->lo, ctx->os); } if (xpost_object_get_type(device) == dicttype) { Xpost_Object Destroy; XPOST_LOG_INFO("destroying device dict"); Destroy = xpost_dict_get(ctx, device, xpost_name_cons(ctx, "Destroy")); if (xpost_object_get_type(Destroy) == operatortype) { int res; xpost_stack_push(ctx->lo, ctx->os, device); res = xpost_operator_exec(ctx, Destroy.mark_.padw); if (res) XPOST_LOG_ERR("%s error destroying device", errorname[res]); else XPOST_LOG_INFO("destroyed device"); } } xpost_save_restore_snapshot(ctx->gl); xpost_memory_table_get_addr(ctx->lo, XPOST_MEMORY_TABLE_SPECIAL_SAVE_STACK, &vs); if (xpost_object_get_type(lsav) == savetype) { for ( llev = xpost_stack_count(ctx->lo, vs); llev > lsav.save_.lev; llev-- ) { xpost_save_restore_snapshot(ctx->lo); } } return noerror; }
/* mark all allocations referred to by objects in save object's stack of saverec_'s */ static int _xpost_garbage_mark_save_stack(Xpost_Context *ctx, Xpost_Memory_File *mem, unsigned int stackadr) { if (!mem) return 0; { Xpost_Stack *s = (Xpost_Stack *)(mem->base + stackadr); unsigned int i; unsigned int ad; int ret; (void)ctx; #ifdef DEBUG_GC printf("marking save stack of size %u\n", xpost_stack_count(mem, stackadr)); #endif next: for (i=0; i < s->top; i++) { /* _xpost_garbage_mark_object(ctx, mem, s->data[i]); */ /* _xpost_garbage_mark_save_stack(ctx, mem, s->data[i].save_.stk); */ ret = _xpost_garbage_mark_ent(mem, s->data[i].saverec_.src); if (!ret) { XPOST_LOG_ERR("cannot mark array"); return 0; } ret = _xpost_garbage_mark_ent(mem, s->data[i].saverec_.cpy); if (!ret) { XPOST_LOG_ERR("cannot mark array"); return 0; } if (s->data[i].saverec_.tag == dicttype) { ret = xpost_memory_table_get_addr(mem, s->data[i].saverec_.src, &ad); if (!ret) { XPOST_LOG_ERR("cannot retrieve address for ent %u", s->data[i].saverec_.src); return 0; } if (!_xpost_garbage_mark_dict(ctx, mem, ad, 0)) return 0; ret = xpost_memory_table_get_addr(mem, s->data[i].saverec_.cpy, &ad); if (!ret) { XPOST_LOG_ERR("cannot retrieve address for ent %u", s->data[i].saverec_.cpy); return 0; } if (!_xpost_garbage_mark_dict(ctx, mem, ad, 0)) return 0; } if (s->data[i].saverec_.tag == arraytype) { unsigned int sz = s->data[i].saverec_.pad; ret = xpost_memory_table_get_addr(mem, s->data[i].saverec_.src, &ad); if (!ret) { XPOST_LOG_ERR("cannot retrieve address for array ent %u", s->data[i].saverec_.src); return 0; } if (!_xpost_garbage_mark_array(ctx, mem, ad, sz, 0)) return 0; ret = xpost_memory_table_get_addr(mem, s->data[i].saverec_.cpy, &ad); if (!ret) { XPOST_LOG_ERR("cannot retrieve address for array ent %u", s->data[i].saverec_.cpy); return 0; } if (!_xpost_garbage_mark_array(ctx, mem, ad, sz, 0)) return 0; } } if (i==XPOST_STACK_SEGMENT_SIZE) { /* ie. s->top == XPOST_STACK_SEGMENT_SIZE */ s = (Xpost_Stack *)(mem->base + s->nextseg); goto next; } if (s->nextseg) { xpost_stack_free(mem, s->nextseg); s->nextseg = 0; } } return 1; }