/* <key> load <value> */
static int
zload(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
ref *pvalue;
switch (r_type(op)) {
case t_name:
/* Use the fast lookup. */
if ((pvalue = dict_find_name(op)) == 0)
return_error(e_undefined);
ref_assign(op, pvalue);
return 0;
case t_null:
return_error(e_typecheck);
case t__invalid:
return_error(e_stackunderflow);
default: {
/* Use an explicit loop. */
uint size = ref_stack_count(&d_stack);
uint i;
for (i = 0; i < size; i++) {
ref *dp = ref_stack_index(&d_stack, i);
check_dict_read(*dp);
if (dict_find(dp, op, &pvalue) > 0) {
ref_assign(op, pvalue);
return 0;
}
}
return_error(e_undefined);
}
}
}
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;
}
/*
* Handle a scan_Comment or scan_DSC_Comment return from gs_scan_token
* (scan_code) by calling out to %Process[DSC]Comment. The continuation
* procedure expects the scanner state on the o-stack.
*/
int
ztoken_handle_comment(i_ctx_t *i_ctx_p, scanner_state *sstate,
const ref *ptoken, int scan_code,
bool save, bool push_file, op_proc_t cont)
{
const char *proc_name;
scanner_state *pstate;
os_ptr op;
ref *ppcproc;
int code;
switch (scan_code) {
case scan_Comment:
proc_name = "%ProcessComment";
break;
case scan_DSC_Comment:
proc_name = "%ProcessDSCComment";
break;
default:
return_error(e_Fatal); /* can't happen */
}
/*
* We can't use check_ostack here, because it returns on overflow.
*/
/*check_ostack(2);*/
if (ostop - osp < 2) {
code = ref_stack_extend(&o_stack, 2);
if (code < 0)
return code;
}
check_estack(3);
code = name_enter_string(imemory, proc_name, esp + 3);
if (code < 0)
return code;
if (save) {
pstate = (scanner_state *)ialloc_struct(scanner_state_dynamic, &st_scanner_state_dynamic,
"ztoken_handle_comment");
if (pstate == 0)
return_error(e_VMerror);
((scanner_state_dynamic *)pstate)->mem = imemory;
*pstate = *sstate;
} else
pstate = sstate;
/* Save the token now -- it might be on the e-stack. */
if (!pstate->s_pstack)
osp[2] = *ptoken;
/*
* Push the continuation, scanner state, file, and callout procedure
* on the e-stack.
*/
make_op_estack(esp + 1, cont);
make_istruct(esp + 2, 0, pstate);
ppcproc = dict_find_name(esp + 3);
if (ppcproc == 0) {
/*
* This can only happen during initialization.
* Pop the comment string from the o-stack if needed (see below).
*/
if (pstate->s_pstack)
--osp;
esp += 2; /* do run the continuation */
} else {
/*
* Push the file and comment string on the o-stack.
* If we were inside { }, the comment string is already on the stack.
*/
if (pstate->s_pstack) {
op = ++osp;
*op = op[-1];
} else {
op = osp += 2;
/* *op = *ptoken; */ /* saved above */
}
op[-1] = pstate->s_file;
esp[3] = *ppcproc;
esp += 3;
}
return o_push_estack;
}
