int xpost_oper_init_stack_ops (Xpost_Context *ctx,
Xpost_Object sd)
{
Xpost_Operator *optab;
Xpost_Object n,op;
unsigned int optadr;
assert(ctx->gl->base);
xpost_memory_table_get_addr(ctx->gl,
XPOST_MEMORY_TABLE_SPECIAL_OPERATOR_TABLE, &optadr);
optab = (void *)(ctx->gl->base + optadr);
op = xpost_operator_cons(ctx, "pop", (Xpost_Op_Func)Apop, 0, 1, anytype);
INSTALL;
op = xpost_operator_cons(ctx, "exch", (Xpost_Op_Func)AAexch, 2, 2, anytype, anytype);
INSTALL;
op = xpost_operator_cons(ctx, "dup", (Xpost_Op_Func)Adup, 2, 1, anytype);
INSTALL;
op = xpost_operator_cons(ctx, "copy", (Xpost_Op_Func)Icopy, 0, 1, integertype);
INSTALL;
op = xpost_operator_cons(ctx, "index", (Xpost_Op_Func)Iindex, 1, 1, integertype);
INSTALL;
//xpost_dict_dump_memory (ctx->gl, sd); fflush(NULL);
op = xpost_operator_cons(ctx, "roll", (Xpost_Op_Func)IIroll, 0, 2, integertype, integertype);
INSTALL;
op = xpost_operator_cons(ctx, "clear", (Xpost_Op_Func)Zclear, 0, 0);
INSTALL;
op = xpost_operator_cons(ctx, "count", (Xpost_Op_Func)Zcount, 1, 0);
INSTALL;
xpost_dict_put(ctx, sd, xpost_name_cons(ctx, "mark"), mark);
op = xpost_operator_cons(ctx, "cleartomark", (Xpost_Op_Func)xpost_op_cleartomark, 0, 0);
INSTALL;
op = xpost_operator_cons(ctx, "counttomark", (Xpost_Op_Func)xpost_op_counttomark, 1, 0);
INSTALL;
return 0;
}
int xpost_oper_init_save_ops (Xpost_Context *ctx,
Xpost_Object sd)
{
Xpost_Operator *optab;
Xpost_Object n,op;
unsigned int optadr;
assert(ctx->gl->base);
xpost_memory_table_get_addr(ctx->gl,
XPOST_MEMORY_TABLE_SPECIAL_OPERATOR_TABLE, &optadr);
optab = (void *)(ctx->gl->base + optadr);
op = xpost_operator_cons(ctx, "save", (Xpost_Op_Func)Zsave, 1, 0);
INSTALL;
op = xpost_operator_cons(ctx, "restore", (Xpost_Op_Func)Vrestore, 0, 1, savetype);
INSTALL;
op = xpost_operator_cons(ctx, "setglobal", (Xpost_Op_Func)Bsetglobal, 0, 1, booleantype);
INSTALL;
op = xpost_operator_cons(ctx, "currentglobal", (Xpost_Op_Func)Zcurrentglobal, 1, 0);
INSTALL;
op = xpost_operator_cons(ctx, "gcheck", (Xpost_Op_Func)Agcheck, 1, 1, anytype);
INSTALL;
#if 0
op = xpost_operator_cons(ctx, "vmstatus", (Xpost_Op_Func)Zvmstatus, 3, 0);
INSTALL;
#endif
/* xpost_dict_dump_memory (ctx->gl, sd); fflush(NULL);
xpost_dict_put(ctx, sd, xpost_name_cons(ctx, "mark"), mark); */
return 0;
}
static
Xpost_Object get_token(Xpost_Context *ctx, char *str){
Xpost_Object o;
xpost_stack_push(ctx->lo, ctx->os, xpost_string_cons(ctx, strlen(str), str));
xpost_operator_exec(ctx, xpost_operator_cons(ctx, "token",NULL,0,0).mark_.padw);
if (xpost_stack_pop(ctx->lo, ctx->os).int_.val){
o = xpost_stack_pop(ctx->lo, ctx->os);
xpost_stack_pop(ctx->lo, ctx->os);
} else {
o = null;
}
return o;
}
int xpost_oper_init_packedarray_ops (Xpost_Context *ctx,
Xpost_Object sd)
{
Xpost_Operator *optab;
Xpost_Object n,op;
unsigned int optadr;
assert(ctx->gl->base);
xpost_memory_table_get_addr(ctx->gl,
XPOST_MEMORY_TABLE_SPECIAL_OPERATOR_TABLE, &optadr);
optab = (void *)(ctx->gl->base + optadr);
op = xpost_operator_cons(ctx, "packedarray", (Xpost_Op_Func)packedarray, 1, 1, integertype);
INSTALL;
xpost_dict_put(ctx, sd, xpost_name_cons(ctx, "currentpacking"), xpost_bool_cons(0));
op = xpost_operator_cons(ctx, "setpacking", (Xpost_Op_Func)setpacking, 0, 1, booleantype);
INSTALL;
/* xpost_dict_dump_memory (ctx->gl, sd); fflush(NULL);
xpost_dict_put(ctx, sd, xpost_name_cons(ctx, "mark"), mark); */
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;
}
/*
load init.ps (which also loads err.ps) while systemdict is writeable
ignore invalidaccess errors.
*/
static
void loadinitps(Xpost_Context *ctx)
{
char buf[1024];
char path_init_ps[XPOST_PATH_MAX];
struct stat statbuf;
char *path_init;
char *path;
int n;
assert(ctx->gl->base);
xpost_stack_push(ctx->lo, ctx->es, xpost_operator_cons(ctx, "quit", NULL,0,0));
ctx->ignoreinvalidaccess = 1;
#define XPOST_PATH_INIT \
do \
{ \
snprintf(path_init_ps, sizeof(path_init_ps), "%s/init.ps", path); \
if (stat(path_init_ps, &statbuf) == 0) \
{ \
path_init = path; \
goto load_init_ps; \
} \
else \
XPOST_LOG_DBG("init.ps not present in", path_init_ps); \
} while (0)
/* environment variable XPOST_DATA_DIR */
if ((path = getenv("XPOST_DATA_DIR")))
XPOST_PATH_INIT;
/* directory of the shared library */
path = (char *)xpost_data_dir_get(); /* always well-defined */
XPOST_PATH_INIT;
#ifdef PACKAGE_DATA_DIR
{
static char x[] = PACKAGE_DATA_DIR;
path = x;
}
XPOST_PATH_INIT;
#endif
XPOST_LOG_ERR("init.ps can not be found");
return;
load_init_ps:
/* backslashes are not supported in path because they are inserted in
* PostScript files, and PostScript */
#ifdef _WIN32
path = path_init_ps;
while (*path++) if (*path == '\\') *path = '/';
path = path_init;
while (*path++) if (*path == '\\') *path = '/';
#endif
n = snprintf(buf, sizeof(buf),
"(%s) (r) file cvx "
"/DATA_DIR (%s) def exec ", path_init_ps, path_init);
xpost_stack_push(ctx->lo, ctx->es,
xpost_object_cvx(xpost_string_cons(ctx, n, buf)));
ctx->quit = 0;
mainloop(ctx);
ctx->ignoreinvalidaccess = 0;
}
int xpost_oper_init_file_ops (Xpost_Context *ctx,
Xpost_Object sd)
{
Xpost_Operator *optab;
Xpost_Object n,op;
unsigned int optadr;
assert(ctx->gl->base);
//xpost_memory_table_get_addr(ctx->gl, XPOST_MEMORY_TABLE_SPECIAL_OPERATOR_TABLE, &optadr);
//optab = (void *)(ctx->gl->base + optadr);
op = xpost_operator_cons(ctx, "file", (Xpost_Op_Func)xpost_op_string_mode_file, 1, 2, stringtype, stringtype);
INSTALL;
/* filter */
op = xpost_operator_cons(ctx, "closefile", (Xpost_Op_Func)xpost_op_file_closefile, 0, 1, filetype);
INSTALL;
op = xpost_operator_cons(ctx, "read", (Xpost_Op_Func)xpost_op_file_read, 1, 1, filetype);
INSTALL;
op = xpost_operator_cons(ctx, "write", (Xpost_Op_Func)xpost_op_file_write, 0, 2, filetype, integertype);
INSTALL;
op = xpost_operator_cons(ctx, "readhexstring", (Xpost_Op_Func)xpost_op_file_readhexstring, 2, 2, filetype, stringtype);
INSTALL;
op = xpost_operator_cons(ctx, "writehexstring", (Xpost_Op_Func)xpost_op_file_writehexstring, 0, 2, filetype, stringtype);
INSTALL;
op = xpost_operator_cons(ctx, "readstring", (Xpost_Op_Func)xpost_op_file_readstring, 2, 2, filetype, stringtype);
INSTALL;
op = xpost_operator_cons(ctx, "writestring", (Xpost_Op_Func)xpost_op_file_writestring, 0, 2, filetype, stringtype);
INSTALL;
op = xpost_operator_cons(ctx, "readline", (Xpost_Op_Func)xpost_op_file_readline, 2, 2, filetype, stringtype);
INSTALL;
/* token: see optok.c */
op = xpost_operator_cons(ctx, "bytesavailable", (Xpost_Op_Func)xpost_op_file_bytesavailable, 1, 1, filetype);
INSTALL;
op = xpost_operator_cons(ctx, "flush", (Xpost_Op_Func)xpost_op_flush, 0, 0);
INSTALL;
op = xpost_operator_cons(ctx, "flushfile", (Xpost_Op_Func)xpost_op_file_flushfile, 0, 1, filetype);
INSTALL;
#ifndef _WIN32
op = xpost_operator_cons(ctx, "resetfile", (Xpost_Op_Func)xpost_op_file_resetfile, 0, 1, filetype);
INSTALL;
#endif
op = xpost_operator_cons(ctx, "status", (Xpost_Op_Func)xpost_op_file_status, 1, 1, filetype);
INSTALL;
/* string status */
/* run: see init.ps */
op = xpost_operator_cons(ctx, "currentfile", (Xpost_Op_Func)xpost_op_currentfile, 1, 0);
INSTALL;
op = xpost_operator_cons(ctx, "deletefile", (Xpost_Op_Func)xpost_op_string_deletefile, 0, 1, stringtype);
INSTALL;
op = xpost_operator_cons(ctx, "renamefile", (Xpost_Op_Func)xpost_op_string_renamefile, 0, 2, stringtype, stringtype);
INSTALL;
//#ifndef _WIN32
op = xpost_operator_cons(ctx, "contfilenameforall", (Xpost_Op_Func)xpost_op_contfilenameforall, 0, 3, globtype, proctype, stringtype);
ctx->opcode_shortcuts.contfilenameforall = op.mark_.padw;
op = xpost_operator_cons(ctx, "filenameforall", (Xpost_Op_Func)xpost_op_filenameforall, 0, 3, stringtype, proctype, stringtype);
INSTALL;
//#endif
op = xpost_operator_cons(ctx, "setfileposition", (Xpost_Op_Func)xpost_op_setfileposition, 0, 2, filetype, integertype);
INSTALL;
op = xpost_operator_cons(ctx, "fileposition", (Xpost_Op_Func)xpost_op_fileposition, 1, 1, filetype);
INSTALL;
op = xpost_operator_cons(ctx, "print", (Xpost_Op_Func)xpost_op_string_print, 0, 1, stringtype);
INSTALL;
/* =: see init.ps
* ==: see init.ps
* stack: see init.ps
* pstack: see init.ps
* printobject
* writeobject
* setobjectformat
* currentobjectformat */
op = xpost_operator_cons(ctx, "echo", (Xpost_Op_Func)xpost_op_bool_echo, 0, 1, booleantype);
INSTALL;
/* xpost_dict_dump_memory (ctx->gl, sd); fflush(NULL);
xpost_dict_put(ctx, sd, xpost_name_cons(ctx, "mark"), mark); */
return 0;
}
int xpost_oper_init_type_ops (Xpost_Context *ctx,
Xpost_Object sd)
{
Xpost_Operator *optab;
Xpost_Object n,op;
unsigned int optadr;
assert(ctx->gl->base);
xpost_memory_table_get_addr(ctx->gl,
XPOST_MEMORY_TABLE_SPECIAL_OPERATOR_TABLE, &optadr);
optab = (void *)(ctx->gl->base + optadr);
op = xpost_operator_cons(ctx, "type", (Xpost_Op_Func)Atype, 1, 1, anytype);
INSTALL;
op = xpost_operator_cons(ctx, "cvlit", (Xpost_Op_Func)Acvlit, 1, 1, anytype);
INSTALL;
op = xpost_operator_cons(ctx, "cvx", (Xpost_Op_Func)Acvx, 1, 1, anytype);
INSTALL;
ctx->opcode_shortcuts.cvx = op.mark_.padw;
op = xpost_operator_cons(ctx, "xcheck", (Xpost_Op_Func)Axcheck, 1, 1, anytype);
INSTALL;
op = xpost_operator_cons(ctx, "executeonly", (Xpost_Op_Func)Aexecuteonly, 1, 1, anytype);
INSTALL;
op = xpost_operator_cons(ctx, "noaccess", (Xpost_Op_Func)Anoaccess, 1, 1, anytype);
INSTALL;
op = xpost_operator_cons(ctx, "readonly", (Xpost_Op_Func)Areadonly, 1, 1, anytype);
INSTALL;
op = xpost_operator_cons(ctx, "rcheck", (Xpost_Op_Func)Archeck, 1, 1, anytype);
INSTALL;
op = xpost_operator_cons(ctx, "wcheck", (Xpost_Op_Func)Awcheck, 1, 1, anytype);
INSTALL;
op = xpost_operator_cons(ctx, "cvi", (Xpost_Op_Func)Ncvi, 1, 1, numbertype);
INSTALL;
op = xpost_operator_cons(ctx, "cvi", (Xpost_Op_Func)Scvi, 1, 1, stringtype);
INSTALL;
op = xpost_operator_cons(ctx, "cvn", (Xpost_Op_Func)Scvn, 1, 1, stringtype);
INSTALL;
op = xpost_operator_cons(ctx, "cvn", (Xpost_Op_Func)Ncvn, 1, 1, nametype);
INSTALL;
op = xpost_operator_cons(ctx, "cvr", (Xpost_Op_Func)Ncvr, 1, 1, numbertype);
INSTALL;
op = xpost_operator_cons(ctx, "cvr", (Xpost_Op_Func)Scvr, 1, 1, stringtype);
INSTALL;
op = xpost_operator_cons(ctx, "cvrs", (Xpost_Op_Func)NRScvrs, 1, 3, numbertype, integertype, stringtype);
INSTALL;
op = xpost_operator_cons(ctx, "cvs", (Xpost_Op_Func)AScvs, 1, 2, anytype, stringtype);
INSTALL;
/* xpost_dict_dump_memory (ctx->gl, sd); fflush(NULL);
*/
return 0;
}
