/*
* Execute an outline defined by a PostScript procedure.
* The top elements of the stack are:
* <font> <code|name> <name> <outline_id>
*/
int
zchar_exec_char_proc(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
/*
* The definition is a PostScript procedure. Execute
* <code|name> proc
* within a systemdict begin/end and a font begin/end.
*/
es_ptr ep;
check_estack(5);
ep = esp += 5;
make_op_estack(ep - 4, zend);
make_op_estack(ep - 3, zend);
ref_assign(ep - 2, op);
make_op_estack(ep - 1, zbegin);
make_op_estack(ep, zbegin);
ref_assign(op - 1, systemdict);
{
ref rfont;
ref_assign(&rfont, op - 3);
ref_assign(op - 3, op - 2);
ref_assign(op - 2, &rfont);
}
pop(1);
return o_push_estack;
}
static int
push_execstack(i_ctx_t *i_ctx_p, os_ptr op1, bool include_marks,
op_proc_t cont)
{
uint size;
/*
* We can't do this directly, because the interpreter
* might have cached some state. To force the interpreter
* to update the stored state, we push a continuation on
* the exec stack; the continuation is executed immediately,
* and does the actual transfer.
*/
uint depth;
if (!r_is_array(op1))
return_op_typecheck(op1);
/* Check the length before the write access per CET 28-03 */
size = r_size(op1);
depth = count_exec_stack(i_ctx_p, include_marks);
if (depth > size)
return_error(e_rangecheck);
check_write(*op1);
{
int code = ref_stack_store_check(&e_stack, op1, size, 0);
if (code < 0)
return code;
}
check_estack(1);
r_set_size(op1, depth);
push_op_estack(cont);
return o_push_estack;
}
/* <obj1> ... <objn> <n> .execn - */
static int
zexecn(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
uint n, i;
es_ptr esp_orig;
check_int_leu(*op, max_uint - 1);
n = (uint) op->value.intval;
check_op(n + 1);
check_estack(n);
esp_orig = esp;
for (i = 0; i < n; ++i) {
const ref *rp = ref_stack_index(&o_stack, (long)(i + 1));
/* Make sure this object is legal to execute. */
if (ref_type_uses_access(r_type(rp))) {
if (!r_has_attr(rp, a_execute) &&
r_has_attr(rp, a_executable)
) {
esp = esp_orig;
return_error(e_invalidaccess);
}
}
/* Executable nulls have a special meaning on the e-stack, */
/* so since they are no-ops, don't push them. */
if (!r_has_type_attrs(rp, t_null, a_executable)) {
++esp;
ref_assign(esp, rp);
}
}
esfile_check_cache();
pop(n + 1);
return o_push_estack;
}
static int
zpathforall(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
gs_path_enum *penum;
int code;
check_proc(op[-3]);
check_proc(op[-2]);
check_proc(op[-1]);
check_proc(*op);
check_estack(8);
if ((penum = gs_path_enum_alloc(imemory, "pathforall")) == 0)
return_error(e_VMerror);
code = gs_path_enum_init(penum, igs);
if (code < 0) {
ifree_object(penum, "path_cleanup");
return code;
}
/* Push a mark, the four procedures, and the path enumerator. */
push_mark_estack(es_for, path_cleanup); /* iterator */
memcpy(esp + 1, op - 3, 4 * sizeof(ref)); /* 4 procs */
esp += 5;
make_istruct(esp, 0, penum);
push_op_estack(path_continue);
pop(4);
op -= 4;
return o_push_estack;
}
/* the code for Type 1 halftones in sethalftone. */
int
zscreen_enum_init(i_ctx_t *i_ctx_p, const gx_ht_order * porder,
gs_screen_halftone * psp, ref * pproc, int npop,
int (*finish_proc)(i_ctx_t *), int space_index)
{
gs_screen_enum *penum;
gs_memory_t * mem = (gs_memory_t *)idmemory->spaces_indexed[space_index];
int code;
check_estack(snumpush + 1);
penum = gs_screen_enum_alloc(mem, "setscreen");
if (penum == 0)
return_error(e_VMerror);
make_struct(esp + snumpush, space_index << r_space_shift, penum); /* do early for screen_cleanup in case of error */
code = gs_screen_enum_init_memory(penum, porder, igs, psp, mem);
if (code < 0) {
screen_cleanup(i_ctx_p);
return code;
}
/* Push everything on the estack */
make_mark_estack(esp + 1, es_other, screen_cleanup);
esp += snumpush;
make_op_estack(esp - 2, finish_proc);
sproc = *pproc;
push_op_estack(screen_sample);
pop(npop);
return o_push_estack;
}
static int
zrunandhide(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
es_ptr ep;
check_op(2);
if (!r_is_array(op - 1))
return_op_typecheck(op);
if (!r_has_attr(op, a_executable))
return 0; /* literal object just gets pushed back */
check_estack(5);
ep = esp += 5;
make_mark_estack(ep - 4, es_other, err_end_runandhide); /* error case */
make_op_estack(ep - 1, end_runandhide); /* normal case */
ref_assign(ep, op);
/* Store the object we are hiding and it's current tas.type_attrs */
/* on the exec stack then change to 'noaccess' */
make_int(ep - 3, (int)op[-1].tas.type_attrs);
ref_assign(ep - 2, op - 1);
r_clear_attrs(ep - 2, a_all);
/* replace the array with a special kind of mark that has a_read access */
esfile_check_cache();
pop(2);
return o_push_estack;
}
/* Allocate, and prepare to load, the index or tint map. */
int
zcs_begin_map(i_ctx_t *i_ctx_p, gs_indexed_map ** pmap, const ref * pproc,
int num_entries, const gs_color_space * base_space,
op_proc_t map1)
{
gs_memory_t *mem = gs_state_memory(igs);
int space = imemory_space((gs_ref_memory_t *)mem);
int num_components = cs_num_components(base_space);
int num_values = num_entries * num_components;
gs_indexed_map *map;
int code = alloc_indexed_map(&map, num_values, mem,
"setcolorspace(mapped)");
es_ptr ep;
if (code < 0)
return code;
*pmap = map;
/* Map the entire set of color indices. Since the */
/* o-stack may not be able to hold N*4096 values, we have */
/* to load them into the cache as they are generated. */
check_estack(num_csme + 1); /* 1 extra for map1 proc */
ep = esp += num_csme;
make_int(ep + csme_num_components, num_components);
make_struct(ep + csme_map, space, map);
ep[csme_proc] = *pproc;
make_int(ep + csme_hival, num_entries - 1);
make_int(ep + csme_index, -1);
push_op_estack(map1);
return o_push_estack;
}
int
zfor(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
register es_ptr ep;
int code;
float params[3];
/* Mostly undocumented, and somewhat bizarre Adobe behavior discovered */
/* with the CET (28-05) and FTS (124-01) is that the proc is not run */
/* if BOTH the initial value and increment are zero. */
if ((code = float_params(op - 1, 3, params)) < 0)
return code;
if ( params[0] == 0.0 && params[1] == 0.0 ) {
pop(4); /* don't run the proc */
return 0;
}
check_estack(7);
ep = esp + 6;
check_proc(*op);
/* Push a mark, the control variable set to the initial value, */
/* the increment, the limit, and the procedure, */
/* and invoke the continuation operator. */
if (r_has_type(op - 3, t_integer) &&
r_has_type(op - 2, t_integer)
) {
make_int(ep - 4, op[-3].value.intval);
make_int(ep - 3, op[-2].value.intval);
switch (r_type(op - 1)) {
case t_integer:
make_int(ep - 2, op[-1].value.intval);
break;
case t_real:
make_int(ep - 2, (long)op[-1].value.realval);
break;
default:
return_op_typecheck(op - 1);
}
if (ep[-3].value.intval >= 0)
make_op_estack(ep, for_pos_int_continue);
else
make_op_estack(ep, for_neg_int_continue);
} else {
make_real(ep - 4, params[0]);
make_real(ep - 3, params[1]);
make_real(ep - 2, params[2]);
make_op_estack(ep, for_real_continue);
}
make_mark_estack(ep - 5, es_for, no_cleanup);
ref_assign(ep - 1, op);
esp = ep;
pop(4);
return o_push_estack;
}
int
ztokenexec(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
stream *s;
scanner_state state;
check_read_file(i_ctx_p, s, op);
check_estack(1);
gs_scanner_init(&state, op);
return tokenexec_continue(i_ctx_p, &state, true);
}
/* <executable_file> .execfile - */
static int
zexecfile(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
check_type_access(*op, t_file, a_executable | a_read | a_execute);
check_estack(4); /* cleanup, file, finish, file */
push_mark_estack(es_other, execfile_cleanup);
*++esp = *op;
push_op_estack(execfile_finish);
return zexec(i_ctx_p);
}
int
cie_cache_joint(i_ctx_t *i_ctx_p, const ref_cie_render_procs * pcrprocs,
const gs_cie_common *pcie, gs_state * pgs)
{
const gs_cie_render *pcrd = gs_currentcolorrendering(pgs);
gx_cie_joint_caches *pjc = gx_unshare_cie_caches(pgs);
gs_ref_memory_t *imem = (gs_ref_memory_t *) gs_state_memory(pgs);
ref pqr_procs;
uint space;
int code;
int i;
if (pcrd == 0) /* cache is not set up yet */
return 0;
if (pjc == 0) /* must already be allocated */
return_error(e_VMerror);
if (r_has_type(&pcrprocs->TransformPQR, t_null)) {
/*
* This CRD came from a driver, not from a PostScript dictionary.
* Resample TransformPQR in C code.
*/
return gs_cie_cs_complete(pgs, true);
}
gs_cie_compute_points_sd(pjc, pcie, pcrd);
code = ialloc_ref_array(&pqr_procs, a_readonly, 3 * (1 + 4 + 4 * 6),
"cie_cache_common");
if (code < 0)
return code;
/* When we're done, deallocate the procs and complete the caches. */
check_estack(3);
cie_cache_push_finish(i_ctx_p, cie_tpqr_finish, imem, pgs);
*++esp = pqr_procs;
space = r_space(&pqr_procs);
for (i = 0; i < 3; i++) {
ref *p = pqr_procs.value.refs + 3 + (4 + 4 * 6) * i;
const float *ppt = (float *)&pjc->points_sd;
int j;
make_array(pqr_procs.value.refs + i, a_readonly | a_executable | space,
4, p);
make_array(p, a_readonly | space, 4 * 6, p + 4);
p[1] = pcrprocs->TransformPQR.value.refs[i];
make_oper(p + 2, 0, cie_exec_tpqr);
make_oper(p + 3, 0, cie_post_exec_tpqr);
for (j = 0, p += 4; j < 4 * 6; j++, p++, ppt++)
make_real(p, *ppt);
}
return cie_prepare_cache3(i_ctx_p, &pcrd->RangePQR,
pqr_procs.value.const_refs,
pjc->TransformPQR.caches,
pjc, imem, "Transform.PQR");
}
/* Call out to a PostScript procedure. */
static int
push_callout(i_ctx_t *i_ctx_p, const char *callout_name)
{
int code;
check_estack(1);
code = name_enter_string(imemory, callout_name, esp + 1);
if (code < 0)
return code;
++esp;
r_set_attrs(esp, a_executable);
return o_push_estack;
}
/* Common code for token reading + execution. */
static int
tokenexec_continue(i_ctx_t *i_ctx_p, scanner_state * pstate, bool save)
{
os_ptr op;
int code;
/* Note that gs_scan_token may change osp! */
pop(1);
again:
check_estack(1);
code = gs_scan_token(i_ctx_p, (ref *) (esp + 1), pstate);
op = osp;
switch (code) {
case 0:
if (r_is_proc(esp + 1)) { /* Treat procedure as a literal. */
push(1);
ref_assign(op, esp + 1);
code = 0;
break;
}
/* falls through */
case scan_BOS:
++esp;
code = o_push_estack;
break;
case scan_EOF: /* no tokens */
code = 0;
break;
case scan_Refill: /* need more data */
code = gs_scan_handle_refill(i_ctx_p, pstate, save,
ztokenexec_continue);
switch (code) {
case 0: /* state is not copied to the heap */
goto again;
case o_push_estack:
return code;
}
break; /* error */
case scan_Comment:
case scan_DSC_Comment:
return ztoken_handle_comment(i_ctx_p, pstate, esp + 1, code,
save, true, ztokenexec_continue);
default: /* error */
gs_scanner_error_object(i_ctx_p, pstate, &i_ctx_p->error_object);
break;
}
if (!save) { /* Deallocate the scanner state record. */
gs_free_object(((scanner_state_dynamic *)pstate)->mem, pstate, "token_continue");
}
return code;
}
/*
* Set up to collect the data for the sampled function. This is used for
* those alternate tint transforms that cannot be converted into a
* type 4 function.
*/
static int
sampled_data_setup(i_ctx_t *i_ctx_p, gs_function_t *pfn,
const ref * pproc, int (*finish_proc)(i_ctx_t *), gs_memory_t * mem)
{
os_ptr op = osp;
gs_sampled_data_enum *penum;
int i;
gs_function_Sd_params_t * params = (gs_function_Sd_params_t *)&pfn->params;
check_estack(estack_storage + 1); /* Verify space on estack */
check_ostack(params->m + O_STACK_PAD); /* and the operand stack */
check_ostack(params->n + O_STACK_PAD);
/*
* Allocate space for the enumerator data structure.
*/
penum = gs_sampled_data_enum_alloc(imemory, "zbuildsampledfuntion(params)");
if (penum == NULL)
return_error(e_VMerror);
/* Initialize data in the enumeration structure */
penum->pfn = pfn;
for(i=0; i< params->m; i++)
penum->indexes[i] = 0;
/*
* Save stack depth for checking the correct number of values on stack
* after the function, which is being sampled, is called.
*/
penum->o_stack_depth = ref_stack_count(&o_stack);
/*
* Note: As previously mentioned, we are putting some spare (unused) stack
* space under the input values in case the function unbalances the stack.
* It is possible for the function to pop or change values on the stack
* outside of the input values. (This has been found to happen with some
* proc sets from Adobe.)
*/
push(O_STACK_PAD);
for (i = 0; i < O_STACK_PAD; i++) /* Set space = null */
make_null(op - i);
/* Push everything on the estack */
esp += estack_storage;
make_op_estack(esp - 2, finish_proc); /* Finish proc onto estack */
sample_proc = *pproc; /* Save function to be sampled */
make_istruct(esp, 0, penum); /* Color cube enumeration structure */
push_op_estack(sampled_data_sample); /* Start sampling data */
return o_push_estack;
}
static int
zloop(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
check_proc(*op);
check_estack(4);
/* Push a mark and the procedure, and invoke */
/* the continuation operator. */
push_mark_estack(es_for, no_cleanup);
*++esp = *op;
make_op_estack(esp + 1, loop_continue);
pop(1);
return loop_continue(i_ctx_p);
}
static int
zforall(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
os_ptr obj = op - 1;
es_ptr ep = esp;
es_ptr cproc = ep + 4;
check_estack(6);
check_proc(*op);
switch (r_type(obj)) {
default:
return_op_typecheck(obj);
case t_array:
check_read(*obj);
make_op_estack(cproc, array_continue);
break;
case t_dictionary:
check_dict_read(*obj);
make_int(cproc, dict_first(obj));
++cproc;
make_op_estack(cproc, dict_continue);
break;
case t_string:
check_read(*obj);
make_op_estack(cproc, string_continue);
break;
case t_mixedarray:
case t_shortarray:
check_read(*obj);
make_op_estack(cproc, packedarray_continue);
break;
}
/*
* Push:
* - a mark;
* - the composite object;
* - the procedure;
* - the iteration index (only for dictionaries, done above);
* and invoke the continuation operator.
*/
make_mark_estack(ep + 1, es_for, forall_cleanup);
ep[2] = *obj;
ep[3] = *op;
esp = cproc - 1;
pop(2);
return (*real_opproc(cproc))(i_ctx_p);
}
/* <bool> <proc> if - */
int
zif(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
check_proc(*op);
check_type(op[-1], t_boolean);
if (op[-1].value.boolval) {
check_estack(1);
++esp;
ref_assign(esp, op);
esfile_check_cache();
}
pop(2);
return o_push_estack;
}
/* <obj> <result> <mask> .stopped <result> */
static int
zzstopped(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
check_type(*op, t_integer);
check_op(3);
/* Mark the execution stack, and push the default result */
/* in case control returns normally. */
check_estack(5);
push_mark_estack(es_stopped, no_cleanup);
*++esp = op[-1]; /* save the result */
*++esp = *op; /* save the signal mask */
push_op_estack(stopped_push);
push_op_estack(zexec); /* execute the operand */
pop(2);
return o_push_estack;
}
/* the stacks would get restored in case of an error. */
static int
zstopped(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
check_op(1);
/* Mark the execution stack, and push the default result */
/* in case control returns normally. */
check_estack(5);
push_mark_estack(es_stopped, no_cleanup);
++esp;
make_false(esp); /* save the result */
++esp;
make_int(esp, 1); /* save the signal mask */
push_op_estack(stopped_push);
push_op_estack(zexec); /* execute the operand */
return o_push_estack;
}
int
zrepeat(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
check_proc(*op);
check_type(op[-1], t_integer);
if (op[-1].value.intval < 0)
return_error(e_rangecheck);
check_estack(5);
/* Push a mark, the count, and the procedure, and invoke */
/* the continuation operator. */
push_mark_estack(es_for, no_cleanup);
*++esp = op[-1];
*++esp = *op;
make_op_estack(esp + 1, repeat_continue);
pop(2);
return repeat_continue(i_ctx_p);
}
/* <redproc> <greenproc> <blueproc> <grayproc> setcolortransfer - */
static int
zsetcolortransfer(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
int code;
check_proc(op[-3]);
check_proc(op[-2]);
check_proc(op[-1]);
check_proc(*op);
check_ostack(zcolor_remap_one_ostack * 4 - 4);
check_estack(1 + zcolor_remap_one_estack * 4);
istate->transfer_procs.red = op[-3];
istate->transfer_procs.green = op[-2];
istate->transfer_procs.blue = op[-1];
istate->transfer_procs.gray = *op;
if ((code = gs_setcolortransfer_remap(igs,
gs_mapped_transfer, gs_mapped_transfer,
gs_mapped_transfer, gs_mapped_transfer,
false)) < 0
)
return code;
/* Use osp rather than op here, because zcolor_remap_one pushes. */
pop(4);
push_op_estack(zcolor_reset_transfer);
if ((code = zcolor_remap_one(i_ctx_p,
&istate->transfer_procs.red,
igs->set_transfer.red, igs,
zcolor_remap_one_finish)) < 0 ||
(code = zcolor_remap_one(i_ctx_p,
&istate->transfer_procs.green,
igs->set_transfer.green, igs,
zcolor_remap_one_finish)) < 0 ||
(code = zcolor_remap_one(i_ctx_p,
&istate->transfer_procs.blue,
igs->set_transfer.blue, igs,
zcolor_remap_one_finish)) < 0 ||
(code = zcolor_remap_one(i_ctx_p, &istate->transfer_procs.gray,
igs->set_transfer.gray, igs,
zcolor_remap_one_finish)) < 0
)
return code;
return o_push_estack;
}
static int
zfilenameforall(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
file_enum *pfen;
gx_io_device *iodev = NULL;
gs_parsed_file_name_t pname;
int code = 0;
check_write_type(*op, t_string);
check_proc(op[-1]);
check_read_type(op[-2], t_string);
/* Push a mark, the iodev, devicenamelen, the scratch string, the enumerator, */
/* and the procedure, and invoke the continuation. */
check_estack(7);
/* Get the iodevice */
code = parse_file_name(op - 2, &pname, i_ctx_p->LockFilePermissions);
if (code < 0)
return code;
iodev = (pname.iodev == NULL) ? iodev_default : pname.iodev;
/* Check for several conditions that just cause us to return success */
if (pname.len == 0 || iodev->procs.enumerate_files == iodev_no_enumerate_files) {
pop(3);
return 0; /* no pattern, or device not found -- just return */
}
pfen = iodev->procs.enumerate_files(iodev, (const char *)pname.fname,
pname.len, imemory);
if (pfen == 0)
return_error(e_VMerror);
push_mark_estack(es_for, file_cleanup);
++esp;
make_istruct(esp, 0, iodev);
++esp;
make_int(esp, r_size(op-2) - pname.len);
*++esp = *op;
++esp;
make_istruct(esp, 0, pfen);
*++esp = op[-1];
pop(3);
code = file_continue(i_ctx_p);
return (code == o_pop_estack ? o_push_estack : code);
}
/* <proc> setblackgeneration - */
static int
zsetblackgeneration(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
int code;
check_proc(*op);
check_ostack(zcolor_remap_one_ostack - 1);
check_estack(1 + zcolor_remap_one_estack);
code = gs_setblackgeneration_remap(igs, gs_mapped_transfer, false);
if (code < 0)
return code;
istate->black_generation = *op;
pop(1);
push_op_estack(zcolor_remap_color);
return zcolor_remap_one(i_ctx_p, &istate->black_generation,
igs->black_generation, igs,
zcolor_remap_one_finish);
}
/* <proc> setundercolorremoval - */
static int
zsetundercolorremoval(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
int code;
check_proc(*op);
check_ostack(zcolor_remap_one_ostack - 1);
check_estack(1 + zcolor_remap_one_estack);
code = gs_setundercolorremoval_remap(igs, gs_mapped_transfer, false);
if (code < 0)
return code;
istate->undercolor_removal = *op;
pop(1);
push_op_estack(zcolor_remap_color);
return zcolor_remap_one(i_ctx_p, &istate->undercolor_removal,
igs->undercolor_removal, igs,
zcolor_remap_one_signed_finish);
}
static int
zsuperexec(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
es_ptr ep;
check_op(1);
if (!r_has_attr(op, a_executable))
return 0; /* literal object just gets pushed back */
check_estack(2);
ep = esp += 3;
make_mark_estack(ep - 2, es_other, end_superexec); /* error case */
make_op_estack(ep - 1, end_superexec); /* normal case */
ref_assign(ep, op);
esfile_check_cache();
pop(1);
i_ctx_p->in_superexec++;
return o_push_estack;
}
/* <bool> <proc_true> <proc_false> ifelse - */
int
zifelse(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
check_proc(*op);
check_proc(op[-1]);
check_type(op[-2], t_boolean);
check_estack(1);
++esp;
if (op[-2].value.boolval) {
ref_assign(esp, op - 1);
} else {
ref_assign(esp, op);
}
esfile_check_cache();
pop(3);
return o_push_estack;
}
/* <first> <count> <last> <proc> %for_samples - */
int
zfor_samples(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
es_ptr ep;
check_type(op[-3], t_real);
check_type(op[-2], t_integer);
check_type(op[-1], t_real);
check_proc(*op);
check_estack(8);
ep = esp + 7;
make_mark_estack(ep - 6, es_for, no_cleanup);
make_int(ep - 5, 0);
memcpy(ep - 4, op - 3, 3 * sizeof(ref));
ref_assign(ep - 1, op);
make_op_estack(ep, for_samples_continue);
esp = ep;
pop(4);
return o_push_estack;
}
/* <obj> exec - */
int
zexec(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
int code;
check_op(1);
code = check_for_exec(op);
if (code < 0) {
return code;
}
if (!r_has_attr(op, a_executable)) {
return 0; /* shortcut, literal object just gets pushed back */
}
check_estack(1);
++esp;
ref_assign(esp, op);
esfile_check_cache();
pop(1);
return o_push_estack;
}
static int
zcond(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
es_ptr ep = esp;
/* Push the array on the e-stack and call the continuation. */
if (!r_is_array(op))
return_op_typecheck(op);
check_execute(*op);
if ((r_size(op) & 1) != 0)
return_error(e_rangecheck);
if (r_size(op) == 0)
return zpop(i_ctx_p);
check_estack(3);
esp = ep += 3;
ref_assign(ep - 2, op); /* the cond body */
make_op_estack(ep - 1, cond_continue);
array_get(imemory, op, 0L, ep);
esfile_check_cache();
pop(1);
return o_push_estack;
}
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;
}
