void
debug_print_packed_ref(const ref_packed *pref)
{ ushort elt = *pref;
ref nref;
switch ( elt >> packed_type_shift )
{
case pt_executable_operator:
dprintf("<op_name>");
elt &= packed_int_mask;
op_index_ref(elt, &nref);
debug_print_ref(&nref);
break;
case pt_integer:
dprintf1("<int> %d", (int)(elt & packed_int_mask) + packed_min_intval);
break;
case pt_literal_name: case pt_literal_name+1:
dprintf("<lit_name>"); elt &= packed_max_name_index; goto ptn;
case pt_executable_name: case pt_executable_name+1:
dprintf("<exec_name>"); elt &= packed_max_name_index;
ptn: name_index_ref(elt, &nref);
dprintf2("(0x%lx#%x)", (ulong)nref.value.pname, elt);
debug_print_name(&nref);
break;
}
}
/* or if they are identical. */
void
packed_get(const gs_memory_t *mem, const ref_packed * packed, ref * pref)
{
const ref_packed elt = *packed;
uint value = elt & packed_value_mask;
switch (elt >> r_packed_type_shift) {
default: /* (shouldn't happen) */
make_null(pref);
break;
case pt_executable_operator:
op_index_ref(value, pref);
break;
case pt_integer:
make_int(pref, (int)value + packed_min_intval);
break;
case pt_literal_name:
name_index_ref(mem, value, pref);
break;
case pt_executable_name:
name_index_ref(mem, value, pref);
r_set_attrs(pref, a_executable);
break;
case pt_full_ref:
case pt_full_ref + 1:
ref_assign(pref, (const ref *)packed);
}
}
/* <name> <proc> .makeoperator <oper> */
static int
zmakeoperator(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
op_array_table *opt;
uint count;
ref *tab;
check_type(op[-1], t_name);
check_proc(*op);
switch (r_space(op)) {
case avm_global:
opt = &i_ctx_p->op_array_table_global;
break;
case avm_local:
opt = &i_ctx_p->op_array_table_local;
break;
default:
return_error(e_invalidaccess);
}
count = opt->count;
tab = opt->table.value.refs;
/*
* restore doesn't reset op_array_table.count, but it does
* remove entries from op_array_table.table. Since we fill
* the table in order, we can detect that a restore has occurred
* by checking whether what should be the most recent entry
* is occupied. If not, we scan backwards over the vacated entries
* to find the true end of the table.
*/
while (count > 0 && r_has_type(&tab[count - 1], t_null))
--count;
if (count == r_size(&opt->table))
return_error(e_limitcheck);
ref_assign_old(&opt->table, &tab[count], op, "makeoperator");
opt->nx_table[count] = name_index(imemory, op - 1);
op_index_ref(imemory, opt->base_index + count, op - 1);
opt->count = count + 1;
pop(1);
return 0;
}
