/* initialize the C-level data
and define in the device instance */
static
int _create_cont (Xpost_Context *ctx,
Xpost_Object w,
Xpost_Object h,
Xpost_Object devdic)
{
Xpost_Object privatestr;
PrivateData private;
xcb_screen_iterator_t iter;
xcb_get_geometry_reply_t *geom;
integer width = w.int_.val;
integer height = h.int_.val;
int scrno;
unsigned char depth;
/* create a string to contain device data structure */
privatestr = xpost_string_cons(ctx, sizeof(PrivateData), NULL);
if (xpost_object_get_type(privatestr) == invalidtype)
{
XPOST_LOG_ERR("cannot allocat private data structure");
return unregistered;
}
xpost_dict_put(ctx, devdic, namePrivate, privatestr);
private.width = width;
/* load executable name */
static
int evalload(Xpost_Context *ctx)
{
int ret;
if (_xpost_interpreter_is_tracing)
{
Xpost_Object s = xpost_name_get_string(ctx, xpost_stack_topdown_fetch(ctx->lo, ctx->es, 0));
XPOST_LOG_DUMP("evalload <name \"%*s\">", s.comp_.sz, xpost_string_get_pointer(ctx, s));
}
if (!xpost_stack_push(ctx->lo, ctx->os,
xpost_stack_pop(ctx->lo, ctx->es)))
return stackoverflow;
assert(ctx->gl->base);
/*xpost_operator_exec(ctx, xpost_operator_cons(ctx, "load", NULL,0,0).mark_.padw); */
ret = xpost_operator_exec(ctx, ctx->opcode_shortcuts.load);
if (ret)
return ret;
if (xpost_object_is_exe(xpost_stack_topdown_fetch(ctx->lo, ctx->os, 0)))
{
Xpost_Object q;
q = xpost_stack_pop(ctx->lo, ctx->os);
if (xpost_object_get_type(q) == invalidtype)
return undefined;
if (!xpost_stack_push(ctx->lo, ctx->es, q))
return ret;
}
return 0;
}
/* 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;
}
/* pop the execution stack */
static
int evalpop(Xpost_Context *ctx)
{
if (!xpost_object_get_type(xpost_stack_pop(ctx->lo, ctx->es)) == invalidtype)
return stackunderflow;
return 0;
}
static
int _event_handler (Xpost_Context *ctx,
Xpost_Object devdic)
{
Xpost_Object privatestr;
PrivateData private;
xcb_generic_event_t *event;
/* load private data struct from string */
privatestr = xpost_dict_get(ctx, devdic, namePrivate);
if (xpost_object_get_type(privatestr) == invalidtype)
return undefined;
xpost_memory_get(xpost_context_select_memory(ctx, privatestr),
xpost_object_get_ent(privatestr), 0, sizeof private, &private);
event = xcb_poll_for_event(private.c);
if (event)
{
switch(event->response_type & ~0x80)
{
case XCB_EXPOSE:
_flush(ctx, devdic);
break;
default:
break;
}
free(event);
}
else if (xcb_connection_has_error(private.c))
return unregistered;
return 0;
}
/* copy userdict names to systemdict
Problem: This is clearly an invalidaccess,
and yet is required by the PLRM. Discussion:
https://groups.google.com/d/msg/comp.lang.postscript/VjCI0qxkGY4/y0urjqRA1IoJ
The ignoreinvalidaccess exception has been isolated to this one case.
*/
static int copyudtosd(Xpost_Context *ctx, Xpost_Object ud, Xpost_Object sd)
{
Xpost_Object ed, de;
ctx->ignoreinvalidaccess = 1;
xpost_dict_put(ctx, sd, xpost_name_cons(ctx, "userdict"), ud);
ed = xpost_dict_get(ctx, ud, xpost_name_cons(ctx, "errordict"));
if (xpost_object_get_type(ed) == invalidtype)
return undefined;
xpost_dict_put(ctx, sd, xpost_name_cons(ctx, "errordict"), ed);
de = xpost_dict_get(ctx, ud, xpost_name_cons(ctx, "$error"));
if (xpost_object_get_type(de) == invalidtype)
return undefined;
xpost_dict_put(ctx, sd, xpost_name_cons(ctx, "$error"), de);
ctx->ignoreinvalidaccess = 0;
return 0;
}
/* number cvi int
convert number to integer */
static
int Ncvi(Xpost_Context *ctx,
Xpost_Object n)
{
if (xpost_object_get_type(n) == realtype)
n = xpost_int_cons((integer)n.real_.val);
xpost_stack_push(ctx->lo, ctx->os, n);
return 0;
}
/* number cvr real
convert number to real */
static
int Ncvr(Xpost_Context *ctx,
Xpost_Object n)
{
if (xpost_object_get_type(n) == integertype)
n = xpost_real_cons((real)n.int_.val);
xpost_stack_push(ctx->lo, ctx->os, n);
return 0;
}
/*
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;
}
/* mark obj1..objN cleartomark -
discard elements down through mark */
int xpost_op_cleartomark (Xpost_Context *ctx)
{
Xpost_Object o;
do {
o = xpost_stack_pop(ctx->lo, ctx->os);
if (xpost_object_get_type(o) == invalidtype)
return unmatchedmark;
} while (o.tag != marktype);
return 0;
}
/* any type name
return type of any as a nametype object */
static
int Atype(Xpost_Context *ctx,
Xpost_Object o)
{
if (xpost_object_get_type(o) >= XPOST_OBJECT_NTYPES)
//return unregistered;
o = invalid; /* normalize to the all-zero invalid object */
xpost_stack_push(ctx->lo, ctx->os, xpost_object_cvx(xpost_name_cons(ctx, xpost_object_type_names[xpost_object_get_type(o)])));
return 0;
}
static
int packedarray (Xpost_Context *ctx,
Xpost_Object n)
{
int i;
Xpost_Object a, v;
a = xpost_array_cons(ctx, n.int_.val);
if (xpost_object_get_type(a) == nulltype)
return VMerror;
for (i=n.int_.val; i > 0; i--) {
v = xpost_stack_pop(ctx->lo, ctx->os);
if (xpost_object_get_type(v) == invalidtype)
return stackunderflow;
xpost_array_put(ctx, a, i-1, v);
}
a = xpost_object_set_access(ctx, xpost_object_cvlit(a), XPOST_OBJECT_TAG_ACCESS_READ_ONLY);
xpost_stack_push(ctx->lo, ctx->os, a);
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;
}
/* a(n-1)..a(0) n j roll a((j-1)mod n)..a(0) a(n-1)..a(j mod n)
roll n elements j times */
static
int IIroll (Xpost_Context *ctx,
Xpost_Object N,
Xpost_Object J)
{
Xpost_Object *t;
Xpost_Object r;
int i;
int n = N.int_.val;
int j = J.int_.val;
if (n < 0)
return rangecheck;
if (n == 0) return 0;
if (j < 0) j = n - ( (- j) % n);
j %= n;
if (j == 0) return 0;
t = alloca((n-j) * sizeof(Xpost_Object));
for (i = 0; i < n-j; i++)
{
r = xpost_stack_topdown_fetch(ctx->lo, ctx->os, n - 1 - i);
if (xpost_object_get_type(r) == invalidtype)
return stackunderflow;
t[i] = r;
}
for (i = 0; i < j; i++)
{
r = xpost_stack_topdown_fetch(ctx->lo, ctx->os, j - 1 - i);
if (xpost_object_get_type(r) == invalidtype)
return stackunderflow;
if (!xpost_stack_topdown_replace(ctx->lo, ctx->os, n - 1 - i, r))
return stackunderflow;
}
for (i = 0; i < n-j; i++)
{
if (!xpost_stack_topdown_replace(ctx->lo, ctx->os, n - j - 1 - i, t[i]))
return stackunderflow;
}
return 0;
}
/* extract token from string */
static
int evalstring(Xpost_Context *ctx)
{
Xpost_Object b,t,s;
int ret;
s = xpost_stack_pop(ctx->lo, ctx->es);
if (!xpost_stack_push(ctx->lo, ctx->os, s))
return stackoverflow;
assert(ctx->gl->base);
/*xpost_operator_exec(ctx, xpost_operator_cons(ctx, "token",NULL,0,0).mark_.padw); */
ret = xpost_operator_exec(ctx, ctx->opcode_shortcuts.token);
if (ret)
return ret;
b = xpost_stack_pop(ctx->lo, ctx->os);
if (xpost_object_get_type(b) == invalidtype)
return stackunderflow;
if (b.int_.val)
{
t = xpost_stack_pop(ctx->lo, ctx->os);
if (xpost_object_get_type(t) == invalidtype)
return stackunderflow;
s = xpost_stack_pop(ctx->lo, ctx->os);
if (xpost_object_get_type(s) == invalidtype)
return stackunderflow;
if (!xpost_stack_push(ctx->lo, ctx->es, s))
return execstackoverflow;
if (xpost_object_get_type(t)==arraytype)
{
if (!xpost_stack_push(ctx->lo, ctx->os , t))
return stackoverflow;
}
else
{
if (!xpost_stack_push(ctx->lo, ctx->es , t))
return execstackoverflow;
}
}
return 0;
}
/*
call window device's event_handler function
which should check for Events or Messages from the
underlying Window System, process one or more of them,
and then return 0.
it should leave all stacks undisturbed.
*/
int idleproc (Xpost_Context *ctx)
{
int ret;
if ((xpost_object_get_type(ctx->event_handler) == operatortype) &&
(xpost_object_get_type(ctx->window_device) == dicttype))
{
if (!xpost_stack_push(ctx->lo, ctx->os, ctx->window_device))
{
return stackoverflow;
}
ret = xpost_operator_exec(ctx, ctx->event_handler.mark_.padw);
if (ret)
{
XPOST_LOG_ERR("event_handler returned %d (%s)",
ret, errorname[ret]);
XPOST_LOG_ERR("disabling event_handler");
ctx->event_handler = null;
return ret;
}
}
return 0;
}
/* extract head (&tail) of array */
static
int evalarray(Xpost_Context *ctx)
{
Xpost_Object a = xpost_stack_pop(ctx->lo, ctx->es);
Xpost_Object b;
if (xpost_object_get_type(a) == invalidtype)
return stackunderflow;
switch (a.comp_.sz)
{
default /* > 1 */:
{
Xpost_Object interval;
interval = xpost_object_get_interval(a, 1, a.comp_.sz - 1);
if (xpost_object_get_type(interval) == invalidtype)
return rangecheck;
xpost_stack_push(ctx->lo, ctx->es, interval);
}
/*@fallthrough@*/
case 1:
b = xpost_array_get(ctx, a, 0);
if (xpost_object_get_type(b) == arraytype)
{
if (!xpost_stack_push(ctx->lo, ctx->os, b))
return stackoverflow;
}
else
{
if (!xpost_stack_push(ctx->lo, ctx->es, b))
return execstackoverflow;
}
/*@fallthrough@*/
case 0: /* drop */;
}
return 0;
}
/* execute operator */
static
int evaloperator(Xpost_Context *ctx)
{
int ret;
Xpost_Object op = xpost_stack_pop(ctx->lo, ctx->es);
if (xpost_object_get_type(op) == invalidtype)
return stackunderflow;
if (_xpost_interpreter_is_tracing)
xpost_operator_dump(ctx, op.mark_.padw);
ret = xpost_operator_exec(ctx, op.mark_.padw);
if (ret)
return ret;
return 0;
}
/* any gcheck bool
check whether value is a legal element of a global compound object */
static
int Agcheck (Xpost_Context *ctx,
Xpost_Object A)
{
Xpost_Object r;
switch(xpost_object_get_type(A)) {
default:
r = xpost_bool_cons(0); break;
case stringtype:
case nametype:
case dicttype:
case arraytype:
r = xpost_bool_cons((A.tag&XPOST_OBJECT_TAG_DATA_FLAG_BANK)!=0);
}
xpost_stack_push(ctx->lo, ctx->os, r);
return 0;
}
/* number radix string cvrs string
convert number to a radix representation in string */
static
int NRScvrs (Xpost_Context *ctx,
Xpost_Object num,
Xpost_Object rad,
Xpost_Object str)
{
int r, n;
if (xpost_object_get_type(num) == realtype) num = xpost_int_cons((integer)num.real_.val);
r = rad.int_.val;
if (r < 2 || r > 36)
return rangecheck;
n = conv_rad(num.int_.val, r, xpost_string_get_pointer(ctx, str), str.comp_.sz);
if (n == -1)
return rangecheck;
if (n < str.comp_.sz) str.comp_.sz = n;
xpost_stack_push(ctx->lo, ctx->os, str);
return 0;
}
/* internal continuation operator for filenameforall */
static
int xpost_op_contfilenameforall (Xpost_Context *ctx,
Xpost_Object oglob,
Xpost_Object Proc,
Xpost_Object Scr)
{
glob_t *globbuf;
char *str;
char *src;
int len;
Xpost_Object interval;
globbuf = oglob.glob_.ptr;
if (oglob.glob_.off < globbuf->gl_pathc)
{
/* xpost_stack_push(ctx->lo, ctx->es, xpost_operator_cons(ctx, "contfilenameforall", NULL,0,0)); */
xpost_stack_push(ctx->lo, ctx->es, xpost_operator_cons_opcode(ctx->opcode_shortcuts.contfilenameforall));
xpost_stack_push(ctx->lo, ctx->es, Scr);
/* xpost_stack_push(ctx->lo, ctx->es, xpost_operator_cons(ctx, "cvx", NULL,0,0)); */
xpost_stack_push(ctx->lo, ctx->es, xpost_operator_cons_opcode(ctx->opcode_shortcuts.cvx));
xpost_stack_push(ctx->lo, ctx->es, xpost_object_cvlit(Proc));
++oglob.glob_.off;
xpost_stack_push(ctx->lo, ctx->es, oglob);
str = xpost_string_get_pointer(ctx, Scr);
src = globbuf->gl_pathv[ oglob.glob_.off-1 ];
len = strlen(src);
if (len > Scr.comp_.sz)
return rangecheck;
memcpy(str, src, len);
interval = xpost_object_get_interval(Scr, 0, len);
if (xpost_object_get_type(interval) == invalidtype)
return rangecheck;
xpost_stack_push(ctx->lo, ctx->os, interval);
xpost_stack_push(ctx->lo, ctx->es, Proc);
}
else
{
xpost_glob_free(globbuf); /* reference has already been popped */
}
return 0;
}
/* string cvn name
convert string to name */
static
int Scvn(Xpost_Context *ctx,
Xpost_Object s)
{
char *t;
Xpost_Object name;
t = alloca(s.comp_.sz+1);
memcpy(t, xpost_string_get_pointer(ctx, s), s.comp_.sz);
t[s.comp_.sz] = '\0';
name = xpost_name_cons(ctx, t);
if (xpost_object_get_type(name) == invalidtype)
return VMerror;
if (xpost_object_is_exe(s))
name = xpost_object_cvx(name);
else
name = xpost_object_cvlit(name);
xpost_stack_push(ctx->lo, ctx->os, name);
return 0;
}
/* file read int true
false
read a byte from file */
static
int xpost_op_file_read(Xpost_Context *ctx,
Xpost_Object f)
{
Xpost_Object b;
if (!xpost_object_is_readable(ctx,f))
return invalidaccess;
b = xpost_file_read_byte(ctx->lo, f);
if (xpost_object_get_type(b) == invalidtype)
return ioerror;
if (b.int_.val != EOF)
{
xpost_stack_push(ctx->lo, ctx->os, b);
xpost_stack_push(ctx->lo, ctx->os, xpost_bool_cons(1));
}
else
{
xpost_stack_push(ctx->lo, ctx->os, xpost_bool_cons(0));
}
return 0;
}
/* extract token from file */
static
int evalfile(Xpost_Context *ctx)
{
Xpost_Object b,f,t;
int ret;
f = xpost_stack_pop(ctx->lo, ctx->es);
if (!xpost_stack_push(ctx->lo, ctx->os, f))
return stackoverflow;
assert(ctx->gl->base);
/*xpost_operator_exec(ctx, xpost_operator_cons(ctx, "token",NULL,0,0).mark_.padw); */
ret = xpost_operator_exec(ctx, ctx->opcode_shortcuts.token);
if (ret)
return ret;
b = xpost_stack_pop(ctx->lo, ctx->os);
if (b.int_.val)
{
t = xpost_stack_pop(ctx->lo, ctx->os);
if (!xpost_stack_push(ctx->lo, ctx->es, f))
return execstackoverflow;
if (xpost_object_get_type(t)==arraytype)
{
if (!xpost_stack_push(ctx->lo, ctx->os, t))
return stackoverflow;
}
else
{
if (!xpost_stack_push(ctx->lo, ctx->es, t))
return execstackoverflow;
}
}
else
{
ret = xpost_file_object_close(ctx->lo, f);
if (ret)
XPOST_LOG_ERR("%s error closing file", errorname[ret]);
}
return 0;
}
/* called by mainloop() after propagated error codes.
pushes postscript-level error procedures
and resumes normal execution.
*/
static
void _onerror(Xpost_Context *ctx,
unsigned int err)
{
Xpost_Object sd;
Xpost_Object ed;
Xpost_Object dollarerror;
if (err > unknownerror) err = unknownerror;
if (!validate_context(ctx))
XPOST_LOG_ERR("context not valid");
if (itpdata->in_onerror > 5)
{
fprintf(stderr, "LOOP in error handler\nabort\n");
++ctx->quit;
/*exit(undefinedresult); */
}
++itpdata->in_onerror;
#ifdef EMITONERROR
fprintf(stderr, "err: %s\n", errorname[err]);
#endif
/* reset stack */
if ((xpost_object_get_type(ctx->currentobject) == operatortype) &&
(ctx->currentobject.tag & XPOST_OBJECT_TAG_DATA_FLAG_OPARGSINHOLD))
{
int n = ctx->currentobject.mark_.pad0;
int i;
for (i = 0; i < n; i++)
{
xpost_stack_push(ctx->lo, ctx->os,
xpost_stack_bottomup_fetch(ctx->lo, ctx->hold, i));
}
}
/* printf("1\n"); */
sd = xpost_stack_bottomup_fetch(ctx->lo, ctx->ds, 0);
/* printf("2\n"); */
dollarerror = xpost_dict_get(ctx, sd, namedollarerror);
if (xpost_object_get_type(dollarerror) == invalidtype)
{
XPOST_LOG_ERR("cannot load $error dict for error: %s",
errorname[err]);
xpost_stack_push(ctx->lo, ctx->es,
xpost_object_cvx(xpost_name_cons(ctx, "stop")));
/*itpdata->in_onerror = 0; */
return;
}
/* printf("3\n"); */
/* printf("4\n"); */
/* printf("5\n"); */
xpost_stack_push(ctx->lo, ctx->os, ctx->currentobject);
#if 0
/* printf("6\n"); */
xpost_stack_push(ctx->lo, ctx->os, xpost_object_cvlit(xpost_name_cons(ctx, errorname[err])));
/* printf("7\n"); */
xpost_stack_push(ctx->lo, ctx->es, xpost_object_cvx(xpost_name_cons(ctx, "signalerror")));
#endif
ed = xpost_dict_get(ctx, sd, nameerrordict);
xpost_stack_push(ctx->lo, ctx->es,
xpost_dict_get(ctx, ed,
xpost_name_cons(ctx, errorname[err])));
/* printf("8\n"); */
itpdata->in_onerror = 0;
}
/* any string cvs string
convert any object to string representation */
static
int AScvs (Xpost_Context *ctx,
Xpost_Object any,
Xpost_Object str)
{
char nostringval[] = "-nostringval-";
char strue[] = "true";
char sfalse[] = "false";
char smark[] = "-mark-";
char ssave[] = "-save-";
int n;
int ret;
switch(xpost_object_get_type(any)) {
default:
if (str.comp_.sz < sizeof(nostringval)-1)
return rangecheck;
memcpy(xpost_string_get_pointer(ctx, str), nostringval, sizeof(nostringval)-1);
str.comp_.sz = sizeof(nostringval)-1;
break;
case savetype:
if (str.comp_.sz < sizeof(ssave)-1)
return rangecheck;
memcpy(xpost_string_get_pointer(ctx, str), ssave, sizeof(ssave)-1);
str.comp_.sz = sizeof(ssave)-1;
break;
case marktype:
if (str.comp_.sz < sizeof(smark)-1)
return rangecheck;
memcpy(xpost_string_get_pointer(ctx, str), smark, sizeof(smark)-1);
str.comp_.sz = sizeof(smark)-1;
break;
case booleantype:
{
if (any.int_.val) {
if (str.comp_.sz < sizeof(strue)-1)
return rangecheck;
memcpy(xpost_string_get_pointer(ctx, str), strue, sizeof(strue)-1);
str.comp_.sz = sizeof(strue)-1;
} else {
if (str.comp_.sz < sizeof(sfalse)-1)
return rangecheck;
memcpy(xpost_string_get_pointer(ctx, str), sfalse, sizeof(sfalse)-1);
str.comp_.sz = sizeof(sfalse)-1;
}
}
break;
case integertype:
{
//n = conv_rad(any.int_.val, 10, xpost_string_get_pointer(ctx, str), str.comp_.sz);
char *s = xpost_string_get_pointer(ctx, str);
int sz = str.comp_.sz;
n = 0;
if (any.int_.val < 0) {
s[n++] = '-';
any.int_.val = abs(any.int_.val);
--sz;
}
n += conv_integ((real)any.int_.val, s + n, sz);
if (n == -1)
return rangecheck;
if (n < str.comp_.sz) str.comp_.sz = n;
break;
}
case realtype:
n = conv_real(any.real_.val, xpost_string_get_pointer(ctx, str), str.comp_.sz);
if (n == -1)
return rangecheck;
if (n < str.comp_.sz) str.comp_.sz = n;
break;
case operatortype:
{
unsigned int optadr;
Xpost_Operator *optab;
Xpost_Operator op;
Xpost_Object_Mark nm;
ret = xpost_memory_table_get_addr(ctx->gl,
XPOST_MEMORY_TABLE_SPECIAL_OPERATOR_TABLE, &optadr);
if (!ret)
{
XPOST_LOG_ERR("cannot load optab!");
return VMerror;
}
optab = (void *)(ctx->gl->base + optadr);
op = optab[any.mark_.padw];
nm.tag = nametype | XPOST_OBJECT_TAG_DATA_FLAG_BANK;
nm.pad0 = 0;
nm.padw = op.name;
any.mark_ = nm;
}
/*@fallthrough@*/
case nametype:
any = xpost_name_get_string(ctx, any);
/*@fallthrough@*/
case stringtype:
if (any.comp_.sz > str.comp_.sz)
return rangecheck;
if (any.comp_.sz < str.comp_.sz) str.comp_.sz = any.comp_.sz;
memcpy(xpost_string_get_pointer(ctx, str), xpost_string_get_pointer(ctx, any), any.comp_.sz);
break;
}
xpost_stack_push(ctx->lo, ctx->os, str);
return 0;
}
/* traverse the contents of composite objects
if markall is true, this is a collection of global vm,
so we must mark objects and recurse
even if it means switching memory files
*/
static
int _xpost_garbage_mark_object(Xpost_Context *ctx,
Xpost_Memory_File *mem,
Xpost_Object o,
int markall)
{
unsigned int ad;
int ret;
if (!mem) return 0;
switch(xpost_object_get_type(o)) {
default: break;
case arraytype:
#ifdef DEBUG_GC
printf("markobject: %d, %s (size %d)\n",
xpost_object_get_ent(o),
xpost_object_type_names[xpost_object_get_type(o)],
o.comp_.sz);
#endif
if (xpost_context_select_memory(ctx, o) != mem) {
if (markall)
mem = xpost_context_select_memory(ctx, o);
else
break;
}
if (!mem) return 0;
if (!_xpost_garbage_ent_is_marked(mem, xpost_object_get_ent(o), &ret))
return 0;
if (!ret) {
ret = _xpost_garbage_mark_ent(mem, xpost_object_get_ent(o));
if (!ret)
{
XPOST_LOG_ERR("cannot mark array");
return 0;
}
ret = xpost_memory_table_get_addr(mem, xpost_object_get_ent(o), &ad);
if (!ret)
{
XPOST_LOG_ERR("cannot retrieve address for array ent %u", xpost_object_get_ent(o));
return 0;
}
if (!_xpost_garbage_mark_array(ctx, mem, ad, o.comp_.sz, markall))
return 0;
}
break;
case dicttype:
#ifdef DEBUG_GC
printf("markobject: %d, %s (size %d)\n",
xpost_object_get_ent(o),
xpost_object_type_names[xpost_object_get_type(o)],
o.comp_.sz);
#endif
if (xpost_context_select_memory(ctx, o) != mem) {
if (markall)
mem = xpost_context_select_memory(ctx, o);
else
break;
}
if (!_xpost_garbage_ent_is_marked(mem, xpost_object_get_ent(o), &ret))
return 0;
if (!ret) {
ret = _xpost_garbage_mark_ent(mem, xpost_object_get_ent(o));
if (!ret)
{
XPOST_LOG_ERR("cannot mark dict");
return 0;
}
ret = xpost_memory_table_get_addr(mem, xpost_object_get_ent(o), &ad);
if (!ret)
{
XPOST_LOG_ERR("cannot retrieve address for dict ent %u", xpost_object_get_ent(o));
return 0;
}
if (!_xpost_garbage_mark_dict(ctx, mem, ad, markall))
return 0;
}
break;
case stringtype:
#ifdef DEBUG_GC
printf("markobject: %d, %s (size %d)\n",
xpost_object_get_ent(o),
xpost_object_type_names[xpost_object_get_type(o)],
o.comp_.sz);
#endif
if (xpost_context_select_memory(ctx, o) != mem) {
if (markall)
mem = xpost_context_select_memory(ctx, o);
else
break;
}
ret = _xpost_garbage_mark_ent(mem, xpost_object_get_ent(o));
if (!ret)
{
XPOST_LOG_ERR("cannot mark string");
return 0;
}
break;
case filetype:
if (mem == ctx->gl) {
printf("file found in global vm\n");
} else {
ret = _xpost_garbage_mark_ent(mem, o.mark_.padw);
if (!ret)
{
XPOST_LOG_ERR("cannot mark file");
return 0;
}
}
break;
}
return 1;
}
/*
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;
}
/* initialize the name string stacks and name search trees (per memory file).
seed the search trees.
initialize and populate the optab and systemdict (global memory file).
push systemdict on dict stack.
allocate and push globaldict on dict stack.
allocate and push userdict on dict stack.
return 1 on success, 0 on failure
*/
static
int _xpost_interpreter_extra_context_init(Xpost_Context *ctx, const char *device)
{
int ret;
ret = xpost_name_init(ctx); /* NAMES NAMET */
if (!ret)
{
xpost_memory_file_exit(ctx->lo);
xpost_memory_file_exit(ctx->gl);
return 0;
}
ctx->vmmode = GLOBAL;
ret = xpost_operator_init_optab(ctx); /* allocate and zero the optab structure */
if (!ret)
{
xpost_memory_file_exit(ctx->lo);
xpost_memory_file_exit(ctx->gl);
return 0;
}
/* seed the tree with a word from the middle of the alphabet */
/* middle of the start */
/* middle of the end */
if (xpost_object_get_type(xpost_name_cons(ctx, "maxlength")) == invalidtype)
return 0;
if (xpost_object_get_type(xpost_name_cons(ctx, "getinterval")) == invalidtype)
return 0;
if (xpost_object_get_type(xpost_name_cons(ctx, "setmiterlimit")) == invalidtype)
return 0;
if (xpost_object_get_type((namedollarerror = xpost_name_cons(ctx, "$error"))) == invalidtype)
return 0;
if (xpost_object_get_type((nameerrordict = xpost_name_cons(ctx, "errordict"))) == invalidtype)
return 0;
xpost_oplib_init_ops(ctx); /* populate the optab (and systemdict) with operators */
{
Xpost_Object gd; /*globaldict */
gd = xpost_dict_cons (ctx, 100);
if (xpost_object_get_type(gd) == nulltype)
{
XPOST_LOG_ERR("cannot allocate globaldict");
return 0;
}
ret = xpost_dict_put(ctx, xpost_stack_bottomup_fetch(ctx->lo, ctx->ds, 0), xpost_name_cons(ctx, "globaldict"), gd);
if (ret)
return 0;
xpost_stack_push(ctx->lo, ctx->ds, gd);
}
ctx->vmmode = LOCAL;
/* seed the tree with a word from the middle of the alphabet */
/* middle of the start */
/* middle of the end */
if (xpost_object_get_type(xpost_name_cons(ctx, "minimal")) == invalidtype)
return 0;
if (xpost_object_get_type(xpost_name_cons(ctx, "interest")) == invalidtype)
return 0;
if (xpost_object_get_type(xpost_name_cons(ctx, "solitaire")) == invalidtype)
return 0;
{
Xpost_Object ud; /*userdict */
ud = xpost_dict_cons (ctx, 100);
if (xpost_object_get_type(ud) == nulltype)
{
XPOST_LOG_ERR("cannot allocate userdict");
return 0;
}
ret = xpost_dict_put(ctx, ud, xpost_name_cons(ctx, "userdict"), ud);
if (ret)
return 0;
xpost_stack_push(ctx->lo, ctx->ds, ud);
}
ctx->device_str = device;
return 1;
}
