/* *op is of type t_astruct(igstate_obj). */ static int gstate_unshare(i_ctx_t *i_ctx_p) { os_ptr op = osp; ref *pgsref = &r_ptr(op, igstate_obj)->gstate; gs_state *pgs = r_ptr(pgsref, gs_state); gs_state *pnew; int_gstate *isp; if (!ref_must_save(pgsref)) return 0; /* Copy the gstate. */ pnew = gs_gstate(pgs); if (pnew == 0) return_error(e_VMerror); isp = gs_int_gstate(pnew); int_gstate_map_refs(isp, ref_mark_new); ref_do_save(op, pgsref, "gstate_unshare"); make_istruct_new(pgsref, 0, pnew); 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; }