/* <int> .oserrorstring false */
static int
zoserrorstring(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
const char *str;
int code;
uint len;
byte ch;
check_type(*op, t_integer);
str = gp_strerror((int)op->value.intval);
if (str == 0 || (len = strlen(str)) == 0) {
make_false(op);
return 0;
}
check_ostack(1);
code = string_to_ref(str, op, iimemory, ".oserrorstring");
if (code < 0)
return code;
/* Strip trailing end-of-line characters. */
while ((len = r_size(op)) != 0 &&
((ch = op->value.bytes[--len]) == '\r' || ch == '\n')
)
r_dec_size(op, 1);
push(1);
make_true(op);
return 0;
}
/*
* Continuation for procedure data source. We use the topmost aliasing slot
* to remember whether we've just called the procedure (1) or whether we're
* returning from a RemapColor callout (0).
*/
static int
image_proc_continue(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
gs_image_enum *penum = r_ptr(esp, gs_image_enum);
int px = ETOP_PLANE_INDEX(esp)->value.intval;
int num_sources = ETOP_NUM_SOURCES(esp)->value.intval;
uint size, used[gs_image_max_planes];
gs_const_string plane_data[gs_image_max_planes];
const byte *wanted;
int i, code;
if (!r_has_type_attrs(op, t_string, a_read)) {
check_op(1);
/* Procedure didn't return a (readable) string. Quit. */
esp = zimage_pop_estack(esp);
image_cleanup(i_ctx_p);
return_error(!r_has_type(op, t_string) ? e_typecheck : e_invalidaccess);
}
size = r_size(op);
if (size == 0 && ETOP_SOURCE(esp, 0)[1].value.intval == 0)
code = 1;
else {
for (i = 0; i < num_sources; i++)
plane_data[i].size = 0;
plane_data[px].data = op->value.bytes;
plane_data[px].size = size;
code = gs_image_next_planes(penum, plane_data, used);
if (code == e_RemapColor) {
op->value.bytes += used[px]; /* skip used data */
r_dec_size(op, used[px]);
ETOP_SOURCE(esp, 0)[1].value.intval = 0; /* RemapColor callout */
return code;
}
}
if (code) { /* Stop now. */
esp = zimage_pop_estack(esp);
pop(1);
image_cleanup(i_ctx_p);
return (code < 0 ? code : o_pop_estack);
}
pop(1);
wanted = gs_image_planes_wanted(penum);
do {
if (++px == num_sources)
px = 0;
} while (!wanted[px]);
ETOP_PLANE_INDEX(esp)->value.intval = px;
return image_proc_process(i_ctx_p);
}
/* Continuation operator for strings */
static int
string_continue(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
es_ptr obj = esp - 1;
if (r_size(obj)) { /* continue */
r_dec_size(obj, 1);
push(1);
make_int(op, *obj->value.bytes);
obj->value.bytes++;
esp += 2;
*esp = obj[1];
return o_push_estack;
} else { /* done */
esp -= 3; /* pop mark, object, proc */
return o_pop_estack;
}
}
/* Continuation operator for arrays */
static int
array_continue(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
es_ptr obj = esp - 1;
if (r_size(obj)) { /* continue */
push(1);
r_dec_size(obj, 1);
*op = *obj->value.refs;
obj->value.refs++;
esp += 2;
*esp = obj[1];
return o_push_estack;
} else { /* done */
esp -= 3; /* pop mark, object, proc */
return o_pop_estack;
}
}
/* Continuation operator for packed arrays */
static int
packedarray_continue(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
es_ptr obj = esp - 1;
if (r_size(obj)) { /* continue */
const ref_packed *packed = obj->value.packed;
r_dec_size(obj, 1);
push(1);
packed_get(imemory, packed, op);
obj->value.packed = packed_next(packed);
esp += 2;
*esp = obj[1];
return o_push_estack;
} else { /* done */
esp -= 3; /* pop mark, object, proc */
return o_pop_estack;
}
}
/* <string> <pattern> anchorsearch <string> -false- */
static int
zanchorsearch(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
os_ptr op1 = op - 1;
uint size = r_size(op);
check_read_type(*op, t_string);
check_read_type(*op1, t_string);
if (size <= r_size(op1) && !memcmp(op1->value.bytes, op->value.bytes, size)) {
os_ptr op0 = op;
push(1);
*op0 = *op1;
r_set_size(op0, size);
op1->value.bytes += size;
r_dec_size(op1, size);
make_true(op);
} else
make_false(op);
return 0;
}
static int
cond_continue(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
es_ptr ep = esp;
int code;
/* The top element of the e-stack is the remaining tail of */
/* the cond body. The top element of the o-stack should be */
/* the (boolean) result of the test that is the first element */
/* of the tail. */
check_type(*op, t_boolean);
if (op->value.boolval) { /* true */
array_get(imemory, ep, 1L, ep);
esfile_check_cache();
code = o_pop_estack;
} else if (r_size(ep) > 2) { /* false */
const ref_packed *elts = ep->value.packed;
check_estack(2);
r_dec_size(ep, 2);
elts = packed_next(elts);
elts = packed_next(elts);
ep->value.packed = elts;
array_get(imemory, ep, 0L, ep + 2);
make_op_estack(ep + 1, cond_continue);
esp = ep + 2;
esfile_check_cache();
code = o_push_estack;
} else { /* fall off end of cond */
esp = ep - 1;
code = o_pop_estack;
}
pop(1); /* get rid of the boolean */
return code;
}
static int
zeqproc(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
ref2_t stack[MAX_DEPTH + 1];
ref2_t *top = stack;
make_array(&stack[0].proc1, 0, 1, op - 1);
make_array(&stack[0].proc2, 0, 1, op);
for (;;) {
long i;
if (r_size(&top->proc1) == 0) {
/* Finished these arrays, go up to next level. */
if (top == stack) {
/* We're done matching: it succeeded. */
make_true(op - 1);
pop(1);
return 0;
}
--top;
continue;
}
/* Look at the next elements of the arrays. */
i = r_size(&top->proc1) - 1;
array_get(imemory, &top->proc1, i, &top[1].proc1);
array_get(imemory, &top->proc2, i, &top[1].proc2);
r_dec_size(&top->proc1, 1);
++top;
/*
* Amazingly enough, the objects' executable attributes are not
* required to match. This means { x load } will match { /x load },
* even though this is clearly wrong.
*/
#if 0
if (r_has_attr(&top->proc1, a_executable) !=
r_has_attr(&top->proc2, a_executable)
)
break;
#endif
if (obj_eq(imemory, &top->proc1, &top->proc2)) {
/* Names don't match strings. */
if (r_type(&top->proc1) != r_type(&top->proc2) &&
(r_type(&top->proc1) == t_name ||
r_type(&top->proc2) == t_name)
)
break;
--top; /* no recursion */
continue;
}
if (r_is_array(&top->proc1) && r_is_array(&top->proc2) &&
r_size(&top->proc1) == r_size(&top->proc2) &&
top < stack + (MAX_DEPTH - 1)
) {
/* Descend into the arrays. */
continue;
}
break;
}
/* An exit from the loop indicates that matching failed. */
make_false(op - 1);
pop(1);
return 0;
}
static int
zbind(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
uint depth = 1;
ref defn;
register os_ptr bsp;
switch (r_type(op)) {
case t_array:
if (!r_has_attr(op, a_write)) {
return 0; /* per PLRM3 */
}
case t_mixedarray:
case t_shortarray:
defn = *op;
break;
case t_oparray:
defn = *op->value.const_refs;
break;
default:
return_op_typecheck(op);
}
push(1);
*op = defn;
bsp = op;
/*
* We must not make the top-level procedure read-only,
* but we must bind it even if it is read-only already.
*
* Here are the invariants for the following loop:
* `depth' elements have been pushed on the ostack;
* For i < depth, p = ref_stack_index(&o_stack, i):
* *p is an array (or packedarray) ref.
*/
while (depth) {
while (r_size(bsp)) {
ref_packed *const tpp = (ref_packed *)bsp->value.packed; /* break const */
r_dec_size(bsp, 1);
if (r_is_packed(tpp)) {
/* Check for a packed executable name */
ushort elt = *tpp;
if (r_packed_is_exec_name(&elt)) {
ref nref;
ref *pvalue;
name_index_ref(imemory, packed_name_index(&elt),
&nref);
if ((pvalue = dict_find_name(&nref)) != 0 &&
r_is_ex_oper(pvalue)
) {
store_check_dest(bsp, pvalue);
/*
* Always save the change, since this can only
* happen once.
*/
ref_do_save(bsp, tpp, "bind");
*tpp = pt_tag(pt_executable_operator) +
op_index(pvalue);
}
}
bsp->value.packed = tpp + 1;
} else {
ref *const tp = bsp->value.refs++;
switch (r_type(tp)) {
case t_name: /* bind the name if an operator */
if (r_has_attr(tp, a_executable)) {
ref *pvalue;
if ((pvalue = dict_find_name(tp)) != 0 &&
r_is_ex_oper(pvalue)
) {
store_check_dest(bsp, pvalue);
ref_assign_old(bsp, tp, pvalue, "bind");
}
}
break;
case t_array: /* push into array if writable */
if (!r_has_attr(tp, a_write))
break;
case t_mixedarray:
case t_shortarray:
if (r_has_attr(tp, a_executable)) {
/* Make reference read-only */
r_clear_attrs(tp, a_write);
if (bsp >= ostop) {
/* Push a new stack block. */
ref temp;
int code;
temp = *tp;
osp = bsp;
code = ref_stack_push(&o_stack, 1);
if (code < 0) {
ref_stack_pop(&o_stack, depth);
return_error(code);
}
bsp = osp;
*bsp = temp;
} else
*++bsp = *tp;
depth++;
}
}
}
}
bsp--;
depth--;
if (bsp < osbot) { /* Pop back to the previous stack block. */
osp = bsp;
ref_stack_pop_block(&o_stack);
bsp = osp;
}
}
osp = bsp;
return 0;
}