int main(void)
{
if (!xpost_init())
{
fprintf(stderr, "Fail to initialize xpost dict test\n");
return -1;
}
init();
printf("\n^test gc.c\n");
ctx = &itpdata->ctab[0];
mem = ctx->lo;
stac = ctx->os;
xpost_stack_push(mem, stac, xpost_int_cons(5));
xpost_stack_push(mem, stac, xpost_int_cons(6));
xpost_stack_push(mem, stac, xpost_real_cons(7.0));
Xpost_Object ar;
ar = xpost_array_cons_memory(mem, 3);
int i;
for (i=0; i < 3; i++)
xpost_array_put_memory(mem, ar, i, xpost_stack_pop(mem, stac));
xpost_stack_push(mem, stac, ar); /* array on stack */
xpost_stack_push(mem, stac, xpost_int_cons(1));
xpost_stack_push(mem, stac, xpost_int_cons(2));
xpost_stack_push(mem, stac, xpost_int_cons(3));
ar = xpost_array_cons_memory(mem, 3);
for (i=0; i < 3; i++)
xpost_array_put_memory(mem, ar, i, xpost_stack_pop(mem, stac));
xpost_object_dump(ar);
/* array not on stack */
#define CNT_STR(x) sizeof(x), x
xpost_stack_push(mem, stac, xpost_string_cons_memory(mem, CNT_STR("string on stack")));
xpost_object_dump(xpost_string_cons_memory(mem, CNT_STR("string not on stack")));
collect(mem);
xpost_stack_push(mem, stac, xpost_string_cons_memory(mem, CNT_STR("string on stack")));
xpost_object_dump(xpost_string_cons_memory(mem, CNT_STR("string not on stack")));
collect(mem);
xpost_memory_file_dump(mem);
printf("stackaedr: %04x\n", stac);
dumpmtab(mem, 0);
/* ^ent 8 (8): adr 3404 0x0d4c, sz [24], mark _ */
/* ^ 06 00 00 00 6en 67g 20 6en 6fo 74t 20 */
printf("gc: look at the mark field . . . . . . . .^\n");
printf("also, see that the first 4 bytes of strings not on stack\n"
"have been obliterated to link-up the free list.\n");
xpost_quit();
}
/*
one iteration of the central loop
called repeatedly by mainloop()
*/
int eval(Xpost_Context *ctx)
{
int ret;
Xpost_Object t = xpost_stack_topdown_fetch(ctx->lo, ctx->es, 0);
ctx->currentobject = t; /* for _onerror to determine if hold stack contents are restoreable.
if opexec(opcode) discovers opcode != ctx->currentobject.mark_.padw
it sets a flag indicating the hold stack does not contain
ctx->currentobject's arguments.
if an error is encountered, currentobject is reported as the
errant object since it is the "entry point" to the interpreter.
*/
if (!validate_context(ctx))
return unregistered;
if (_xpost_interpreter_is_tracing)
{
XPOST_LOG_DUMP("eval(): Executing: ");
xpost_object_dump(t);
XPOST_LOG_DUMP("Stack: ");
xpost_stack_dump(ctx->lo, ctx->os);
XPOST_LOG_DUMP("Dict Stack: ");
xpost_stack_dump(ctx->lo, ctx->ds);
XPOST_LOG_DUMP("Exec Stack: ");
xpost_stack_dump(ctx->lo, ctx->es);
}
ret = idleproc(ctx); /* periodically process asynchronous events */
if (ret)
return ret;
{ /* check object for sanity before using jump table */
Xpost_Object_Type type = xpost_object_get_type(t);
if (type == invalidtype || type >= XPOST_OBJECT_NTYPES)
return unregistered;
}
if ( xpost_object_is_exe(t) ) /* if executable */
ret = evaltype[xpost_object_get_type(t)](ctx);
else
ret = evalpush(ctx);
return ret;
}
int main(void)
{
if (!xpost_init())
{
fprintf(stderr, "Fail to initialize xpost name test\n");
return -1;
}
printf("\n^test nm\n");
//init(&ctx);
init();
ctx->vmmode = LOCAL;
printf("pop ");
xpost_object_dump(xpost_name_cons(ctx, "pop"));
printf("NAMES at %u\n", xpost_memory_table_get_addr(ctx->gl, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK));
//xpost_stack_dump(ctx->gl, xpost_memory_table_get_addr(ctx->gl, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK)); puts("");
printf("apple ");
xpost_object_dump(xpost_name_cons(ctx, "apple"));
xpost_object_dump(xpost_name_cons(ctx, "apple"));
//printf("NAMES at %u\n", xpost_memory_table_get_addr(ctx->gl, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK));
//xpost_stack_dump(ctx->gl, xpost_memory_table_get_addr(ctx->gl, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK)); puts("");
printf("banana ");
xpost_object_dump(xpost_name_cons(ctx, "banana"));
xpost_object_dump(xpost_name_cons(ctx, "banana"));
//printf("NAMES at %u\n", xpost_memory_table_get_addr(ctx->gl, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK));
//xpost_stack_dump(ctx->gl, xpost_memory_table_get_addr(ctx->gl, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK)); puts("");
printf("currant ");
xpost_object_dump(xpost_name_cons(ctx, "currant"));
xpost_object_dump(xpost_name_cons(ctx, "currant"));
//printf("NAMES at %u\n", xpost_memory_table_get_addr(ctx->gl, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK));
//xpost_stack_dump(ctx->gl, xpost_memory_table_get_addr(ctx->gl, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK)); puts("");
printf("apple ");
xpost_object_dump(xpost_name_cons(ctx, "apple"));
printf("banana ");
xpost_object_dump(xpost_name_cons(ctx, "banana"));
printf("currant ");
xpost_object_dump(xpost_name_cons(ctx, "currant"));
printf("date ");
//printf("NAMES at %u\n", xpost_memory_table_get_addr(ctx->gl, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK));
xpost_object_dump(xpost_name_cons(ctx, "date"));
//printf("NAMES at %u\n", xpost_memory_table_get_addr(ctx->gl, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK));
xpost_stack_dump(ctx->gl, xpost_memory_table_get_addr(ctx->gl, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK)); puts("");
//printf("NAMES at %u\n", xpost_memory_table_get_addr(ctx->gl, XPOST_MEMORY_TABLE_SPECIAL_NAME_STACK));
printf("elderberry ");
xpost_object_dump(xpost_name_cons(ctx, "elderberry"));
printf("pop ");
xpost_object_dump(xpost_name_cons(ctx, "pop"));
//xpost_memory_file_dump(ctx->gl);
//dumpmtab(ctx->gl, 0);
puts("");
xpost_quit();
return 0;
}
