diff options
Diffstat (limited to 'gs/psi/interp.c')
| -rw-r--r-- | gs/psi/interp.c | 2018 |
1 files changed, 1009 insertions, 1009 deletions
diff --git a/gs/psi/interp.c b/gs/psi/interp.c index ddfe3f7ae..44ae93212 100644 --- a/gs/psi/interp.c +++ b/gs/psi/interp.c @@ -16,8 +16,8 @@ #include "memory_.h" #include "string_.h" #include "ghost.h" -#include "gsstruct.h" /* for iastruct.h */ -#include "gserrors.h" /* for gpcheck.h */ +#include "gsstruct.h" /* for iastruct.h */ +#include "gserrors.h" /* for gpcheck.h */ #include "stream.h" #include "ierrors.h" #include "estack.h" @@ -26,24 +26,24 @@ #include "icontext.h" #include "icremap.h" #include "idebug.h" -#include "igstate.h" /* for handling e_RemapColor */ +#include "igstate.h" /* for handling e_RemapColor */ #include "inamedef.h" -#include "iname.h" /* for the_name_table */ +#include "iname.h" /* for the_name_table */ #include "interp.h" #include "ipacked.h" -#include "ostack.h" /* must precede iscan.h */ -#include "strimpl.h" /* for sfilter.h */ -#include "sfilter.h" /* for iscan.h */ +#include "ostack.h" /* must precede iscan.h */ +#include "strimpl.h" /* for sfilter.h */ +#include "sfilter.h" /* for iscan.h */ #include "iscan.h" #include "iddict.h" #include "isave.h" #include "istack.h" #include "itoken.h" -#include "iutil.h" /* for array_get */ +#include "iutil.h" /* for array_get */ #include "ivmspace.h" #include "iinit.h" #include "dstack.h" -#include "files.h" /* for file_check_read */ +#include "files.h" /* for file_check_read */ #include "oper.h" #include "store.h" #include "gpcheck.h" @@ -86,16 +86,16 @@ call_operator(op_proc_t op_proc, i_ctx_t *i_ctx_p) if_debug1('!', "[!]operator %s\n", op_get_name_string(op_proc)); # else if_debug3('!', "[!][es=%d os=%d]operator %s\n", - esp-i_ctx_p->exec_stack.stack.bot, - osp-i_ctx_p->op_stack.stack.bot, - op_get_name_string(op_proc)); + esp-i_ctx_p->exec_stack.stack.bot, + osp-i_ctx_p->op_stack.stack.bot, + op_get_name_string(op_proc)); # endif # endif code = op_proc(i_ctx_p); # if defined(DEBUG_TRACE_PS_OPERATORS) && defined(SHOW_STACK_DEPTHS) if_debug2('!', "[!][es=%d os=%d]\n", - esp-i_ctx_p->exec_stack.stack.bot, - osp-i_ctx_p->op_stack.stack.bot); + esp-i_ctx_p->exec_stack.stack.bot, + osp-i_ctx_p->op_stack.stack.bot); # endif return code; /* A good place for a conditional breakpoint. */ } @@ -109,10 +109,10 @@ struct stats_interp_s { long top; long lit, lit_array, exec_array, exec_operator, exec_name; long x_add, x_def, x_dup, x_exch, x_if, x_ifelse, - x_index, x_pop, x_roll, x_sub; + x_index, x_pop, x_roll, x_sub; long find_name, name_lit, name_proc, name_oparray, name_operator; long p_full, p_exec_operator, p_exec_oparray, p_exec_non_x_operator, - p_integer, p_lit_name, p_exec_name; + p_integer, p_lit_name, p_exec_name; long p_find_name, p_name_lit, p_name_proc; } stats_interp; # define INCR(v) (++(stats_interp.v)) @@ -156,7 +156,7 @@ static int zcurrentstackprotect(i_ctx_t *); * and therefore pushes 16 values). */ #define MIN_BLOCK_OSTACK 16 -const int gs_interp_max_op_num_args = MIN_BLOCK_OSTACK; /* for iinit.c */ +const int gs_interp_max_op_num_args = MIN_BLOCK_OSTACK; /* for iinit.c */ /* * Define the initial maximum size of the execution stack (MaxExecStack @@ -235,7 +235,7 @@ typedef enum { } special_op_types; #define num_special_ops ((int)tx_next_op - tx_op) -const int gs_interp_num_special_ops = num_special_ops; /* for iinit.c */ +const int gs_interp_num_special_ops = num_special_ops; /* for iinit.c */ const int tx_next_index = tx_next_op; /* @@ -279,16 +279,16 @@ const op_def interp2_op_defs[] = { /* Initialize the interpreter. */ int gs_interp_init(i_ctx_t **pi_ctx_p, const ref *psystem_dict, - gs_dual_memory_t *dmem) + gs_dual_memory_t *dmem) { /* Create and initialize a context state. */ gs_context_state_t *pcst = 0; int code = context_state_alloc(&pcst, psystem_dict, dmem); if (code >= 0) - code = context_state_load(pcst); + code = context_state_load(pcst); if (code < 0) - lprintf1("Fatal error %d in gs_interp_init!", code); + lprintf1("Fatal error %d in gs_interp_init!", code); *pi_ctx_p = pcst; return code; } @@ -300,51 +300,51 @@ int gs_interp_alloc_stacks(gs_ref_memory_t *mem, gs_context_state_t * pcst) { gs_ref_memory_t *smem = - (gs_ref_memory_t *)gs_memory_stable((gs_memory_t *)mem); + (gs_ref_memory_t *)gs_memory_stable((gs_memory_t *)mem); ref stk; #define REFS_SIZE_OSTACK OS_REFS_SIZE(MAX_OSTACK) #define REFS_SIZE_ESTACK ES_REFS_SIZE(MAX_ESTACK) #define REFS_SIZE_DSTACK DS_REFS_SIZE(MAX_DSTACK) gs_alloc_ref_array(smem, &stk, 0, - REFS_SIZE_OSTACK + REFS_SIZE_ESTACK + - REFS_SIZE_DSTACK, "gs_interp_alloc_stacks"); + REFS_SIZE_OSTACK + REFS_SIZE_ESTACK + + REFS_SIZE_DSTACK, "gs_interp_alloc_stacks"); { - ref_stack_t *pos = &pcst->op_stack.stack; - - r_set_size(&stk, REFS_SIZE_OSTACK); - ref_stack_init(pos, &stk, OS_GUARD_UNDER, OS_GUARD_OVER, NULL, - smem, NULL); - ref_stack_set_error_codes(pos, e_stackunderflow, e_stackoverflow); - ref_stack_set_max_count(pos, MAX_OSTACK); - stk.value.refs += REFS_SIZE_OSTACK; + ref_stack_t *pos = &pcst->op_stack.stack; + + r_set_size(&stk, REFS_SIZE_OSTACK); + ref_stack_init(pos, &stk, OS_GUARD_UNDER, OS_GUARD_OVER, NULL, + smem, NULL); + ref_stack_set_error_codes(pos, e_stackunderflow, e_stackoverflow); + ref_stack_set_max_count(pos, MAX_OSTACK); + stk.value.refs += REFS_SIZE_OSTACK; } { - ref_stack_t *pes = &pcst->exec_stack.stack; - ref euop; - - r_set_size(&stk, REFS_SIZE_ESTACK); - make_oper(&euop, 0, estack_underflow); - ref_stack_init(pes, &stk, ES_GUARD_UNDER, ES_GUARD_OVER, &euop, - smem, NULL); - ref_stack_set_error_codes(pes, e_ExecStackUnderflow, - e_execstackoverflow); - /**************** E-STACK EXPANSION IS NYI. ****************/ - ref_stack_allow_expansion(pes, false); - ref_stack_set_max_count(pes, MAX_ESTACK); - stk.value.refs += REFS_SIZE_ESTACK; + ref_stack_t *pes = &pcst->exec_stack.stack; + ref euop; + + r_set_size(&stk, REFS_SIZE_ESTACK); + make_oper(&euop, 0, estack_underflow); + ref_stack_init(pes, &stk, ES_GUARD_UNDER, ES_GUARD_OVER, &euop, + smem, NULL); + ref_stack_set_error_codes(pes, e_ExecStackUnderflow, + e_execstackoverflow); + /**************** E-STACK EXPANSION IS NYI. ****************/ + ref_stack_allow_expansion(pes, false); + ref_stack_set_max_count(pes, MAX_ESTACK); + stk.value.refs += REFS_SIZE_ESTACK; } { - ref_stack_t *pds = &pcst->dict_stack.stack; + ref_stack_t *pds = &pcst->dict_stack.stack; - r_set_size(&stk, REFS_SIZE_DSTACK); - ref_stack_init(pds, &stk, 0, 0, NULL, smem, NULL); - ref_stack_set_error_codes(pds, e_dictstackunderflow, - e_dictstackoverflow); - ref_stack_set_max_count(pds, MAX_DSTACK); + r_set_size(&stk, REFS_SIZE_DSTACK); + ref_stack_init(pds, &stk, 0, 0, NULL, smem, NULL); + ref_stack_set_error_codes(pds, e_dictstackunderflow, + e_dictstackoverflow); + ref_stack_set_max_count(pds, MAX_DSTACK); } #undef REFS_SIZE_OSTACK @@ -393,11 +393,11 @@ gs_interp_make_oper(ref * opref, op_proc_t proc, int idx) int i; for (i = num_special_ops; i > 0 && proc != interp1_op_defs[i].proc; --i) - DO_NOTHING; + DO_NOTHING; if (i > 0) - make_tasv(opref, tx_op + (i - 1), a_executable, i, opproc, proc); + make_tasv(opref, tx_op + (i - 1), a_executable, i, opproc, proc); else - make_tasv(opref, t_operator, a_executable, idx, opproc, proc); + make_tasv(opref, t_operator, a_executable, idx, opproc, proc); } /* @@ -411,9 +411,9 @@ interp_reclaim(i_ctx_t **pi_ctx_p, int space) int code; gs_register_struct_root(imemory_system, &ctx_root, - (void **)pi_ctx_p, "interp_reclaim(pi_ctx_p)"); + (void **)pi_ctx_p, "interp_reclaim(pi_ctx_p)"); code = (*idmemory->reclaim)(idmemory, space); - i_ctx_p = *pi_ctx_p; /* may have moved */ + i_ctx_p = *pi_ctx_p; /* may have moved */ gs_unregister_root(imemory_system, &ctx_root, "interp_reclaim(pi_ctx_p)"); return code; } @@ -431,16 +431,16 @@ interp_reclaim(i_ctx_t **pi_ctx_p, int space) static int gs_call_interp(i_ctx_t **, ref *, int, int *, ref *); int gs_interpret(i_ctx_t **pi_ctx_p, ref * pref, int user_errors, int *pexit_code, - ref * perror_object) + ref * perror_object) { i_ctx_t *i_ctx_p = *pi_ctx_p; gs_gc_root_t error_root; int code; gs_register_ref_root(imemory_system, &error_root, - (void **)&perror_object, "gs_interpret"); + (void **)&perror_object, "gs_interpret"); code = gs_call_interp(pi_ctx_p, pref, user_errors, pexit_code, - perror_object); + perror_object); i_ctx_p = *pi_ctx_p; gs_unregister_root(imemory_system, &error_root, "gs_interpret"); /* Avoid a dangling reference to a stack-allocated GC signal. */ @@ -449,7 +449,7 @@ gs_interpret(i_ctx_t **pi_ctx_p, ref * pref, int user_errors, int *pexit_code, } static int gs_call_interp(i_ctx_t **pi_ctx_p, ref * pref, int user_errors, - int *pexit_code, ref * perror_object) + int *pexit_code, ref * perror_object) { ref *epref = pref; ref doref; @@ -466,181 +466,181 @@ again: /* Avoid a dangling error object that might get traced by a future GC. */ make_null(perror_object); o_stack.requested = e_stack.requested = d_stack.requested = 0; - while (gc_signal) { /* Some routine below triggered a GC. */ - gs_gc_root_t epref_root; - - gc_signal = 0; - /* Make sure that doref will get relocated properly if */ - /* a garbage collection happens with epref == &doref. */ - gs_register_ref_root(imemory_system, &epref_root, - (void **)&epref, "gs_call_interp(epref)"); - code = interp_reclaim(pi_ctx_p, -1); - i_ctx_p = *pi_ctx_p; - gs_unregister_root(imemory_system, &epref_root, - "gs_call_interp(epref)"); - if (code < 0) - return code; + while (gc_signal) { /* Some routine below triggered a GC. */ + gs_gc_root_t epref_root; + + gc_signal = 0; + /* Make sure that doref will get relocated properly if */ + /* a garbage collection happens with epref == &doref. */ + gs_register_ref_root(imemory_system, &epref_root, + (void **)&epref, "gs_call_interp(epref)"); + code = interp_reclaim(pi_ctx_p, -1); + i_ctx_p = *pi_ctx_p; + gs_unregister_root(imemory_system, &epref_root, + "gs_call_interp(epref)"); + if (code < 0) + return code; } code = interp(pi_ctx_p, epref, perror_object); i_ctx_p = *pi_ctx_p; if (!r_has_type(&i_ctx_p->error_object, t__invalid)) { - *perror_object = i_ctx_p->error_object; - make_t(&i_ctx_p->error_object, t__invalid); + *perror_object = i_ctx_p->error_object; + make_t(&i_ctx_p->error_object, t__invalid); } /* Prevent a dangling reference to the GC signal in ticks_left */ /* in the frame of interp, but be prepared to do a GC if */ /* an allocation in this routine asks for it. */ set_gc_signal(i_ctx_p, &gc_signal, 1); - if (esp < esbot) /* popped guard entry */ - esp = esbot; + if (esp < esbot) /* popped guard entry */ + esp = esbot; switch (code) { - case e_Fatal: - *pexit_code = 255; - return code; - case e_Quit: - *perror_object = osp[-1]; - *pexit_code = code = osp->value.intval; - osp -= 2; - return - (code == 0 ? e_Quit : - code < 0 && code > -100 ? code : e_Fatal); - case e_InterpreterExit: - return 0; - case e_ExecStackUnderflow: + case e_Fatal: + *pexit_code = 255; + return code; + case e_Quit: + *perror_object = osp[-1]; + *pexit_code = code = osp->value.intval; + osp -= 2; + return + (code == 0 ? e_Quit : + code < 0 && code > -100 ? code : e_Fatal); + case e_InterpreterExit: + return 0; + case e_ExecStackUnderflow: /****** WRONG -- must keep mark blocks intact ******/ - ref_stack_pop_block(&e_stack); - doref = *perror_object; - epref = &doref; - goto again; - case e_VMreclaim: - /* Do the GC and continue. */ - code = interp_reclaim(pi_ctx_p, - (osp->value.intval == 2 ? - avm_global : avm_local)); - i_ctx_p = *pi_ctx_p; - /****** What if code < 0? ******/ - make_oper(&doref, 0, zpop); - epref = &doref; - goto again; - case e_NeedInput: - case e_interrupt: - return code; + ref_stack_pop_block(&e_stack); + doref = *perror_object; + epref = &doref; + goto again; + case e_VMreclaim: + /* Do the GC and continue. */ + code = interp_reclaim(pi_ctx_p, + (osp->value.intval == 2 ? + avm_global : avm_local)); + i_ctx_p = *pi_ctx_p; + /****** What if code < 0? ******/ + make_oper(&doref, 0, zpop); + epref = &doref; + goto again; + case e_NeedInput: + case e_interrupt: + return code; } /* Adjust osp in case of operand stack underflow */ if (osp < osbot - 1) - osp = osbot - 1; + osp = osbot - 1; /* We have to handle stack over/underflow specially, because */ /* we might be able to recover by adding or removing a block. */ switch (code) { - case e_dictstackoverflow: - /* We don't have to handle this specially: */ - /* The only places that could generate it */ - /* use check_dstack, which does a ref_stack_extend, */ - /* so if` we get this error, it's a real one. */ - if (osp >= ostop) { - if ((ccode = ref_stack_extend(&o_stack, 1)) < 0) - return ccode; - } + case e_dictstackoverflow: + /* We don't have to handle this specially: */ + /* The only places that could generate it */ + /* use check_dstack, which does a ref_stack_extend, */ + /* so if` we get this error, it's a real one. */ + if (osp >= ostop) { + if ((ccode = ref_stack_extend(&o_stack, 1)) < 0) + return ccode; + } /* Skip system dictionaries for CET 20-02-02 */ - ccode = copy_stack(i_ctx_p, &d_stack, min_dstack_size, &saref); - if (ccode < 0) - return ccode; - ref_stack_pop_to(&d_stack, min_dstack_size); - dict_set_top(); - *++osp = saref; - break; - case e_dictstackunderflow: - if (ref_stack_pop_block(&d_stack) >= 0) { - dict_set_top(); - doref = *perror_object; - epref = &doref; - goto again; - } - break; - case e_execstackoverflow: - /* We don't have to handle this specially: */ - /* The only places that could generate it */ - /* use check_estack, which does a ref_stack_extend, */ - /* so if we get this error, it's a real one. */ - if (osp >= ostop) { - if ((ccode = ref_stack_extend(&o_stack, 1)) < 0) - return ccode; - } - ccode = copy_stack(i_ctx_p, &e_stack, 0, &saref); - if (ccode < 0) - return ccode; - { - uint count = ref_stack_count(&e_stack); - uint limit = ref_stack_max_count(&e_stack) - ES_HEADROOM; - - if (count > limit) { - /* - * If there is an e-stack mark within MIN_BLOCK_ESTACK of - * the new top, cut the stack back to remove the mark. - */ - int skip = count - limit; - int i; - - for (i = skip; i < skip + MIN_BLOCK_ESTACK; ++i) { - const ref *ep = ref_stack_index(&e_stack, i); - - if (r_has_type_attrs(ep, t_null, a_executable)) { - skip = i + 1; - break; - } - } - pop_estack(i_ctx_p, skip); - } - } - *++osp = saref; - break; - case e_stackoverflow: - if (ref_stack_extend(&o_stack, o_stack.requested) >= 0) { /* We can't just re-execute the object, because */ - /* it might be a procedure being pushed as a */ - /* literal. We check for this case specially. */ - doref = *perror_object; - if (r_is_proc(&doref)) { - *++osp = doref; - make_null_proc(&doref); - } - epref = &doref; - goto again; - } - ccode = copy_stack(i_ctx_p, &o_stack, 0, &saref); - if (ccode < 0) - return ccode; - ref_stack_clear(&o_stack); - *++osp = saref; - break; - case e_stackunderflow: - if (ref_stack_pop_block(&o_stack) >= 0) { - doref = *perror_object; - epref = &doref; - goto again; - } - break; + ccode = copy_stack(i_ctx_p, &d_stack, min_dstack_size, &saref); + if (ccode < 0) + return ccode; + ref_stack_pop_to(&d_stack, min_dstack_size); + dict_set_top(); + *++osp = saref; + break; + case e_dictstackunderflow: + if (ref_stack_pop_block(&d_stack) >= 0) { + dict_set_top(); + doref = *perror_object; + epref = &doref; + goto again; + } + break; + case e_execstackoverflow: + /* We don't have to handle this specially: */ + /* The only places that could generate it */ + /* use check_estack, which does a ref_stack_extend, */ + /* so if we get this error, it's a real one. */ + if (osp >= ostop) { + if ((ccode = ref_stack_extend(&o_stack, 1)) < 0) + return ccode; + } + ccode = copy_stack(i_ctx_p, &e_stack, 0, &saref); + if (ccode < 0) + return ccode; + { + uint count = ref_stack_count(&e_stack); + uint limit = ref_stack_max_count(&e_stack) - ES_HEADROOM; + + if (count > limit) { + /* + * If there is an e-stack mark within MIN_BLOCK_ESTACK of + * the new top, cut the stack back to remove the mark. + */ + int skip = count - limit; + int i; + + for (i = skip; i < skip + MIN_BLOCK_ESTACK; ++i) { + const ref *ep = ref_stack_index(&e_stack, i); + + if (r_has_type_attrs(ep, t_null, a_executable)) { + skip = i + 1; + break; + } + } + pop_estack(i_ctx_p, skip); + } + } + *++osp = saref; + break; + case e_stackoverflow: + if (ref_stack_extend(&o_stack, o_stack.requested) >= 0) { /* We can't just re-execute the object, because */ + /* it might be a procedure being pushed as a */ + /* literal. We check for this case specially. */ + doref = *perror_object; + if (r_is_proc(&doref)) { + *++osp = doref; + make_null_proc(&doref); + } + epref = &doref; + goto again; + } + ccode = copy_stack(i_ctx_p, &o_stack, 0, &saref); + if (ccode < 0) + return ccode; + ref_stack_clear(&o_stack); + *++osp = saref; + break; + case e_stackunderflow: + if (ref_stack_pop_block(&o_stack) >= 0) { + doref = *perror_object; + epref = &doref; + goto again; + } + break; } if (user_errors < 0) - return code; + return code; if (gs_errorname(i_ctx_p, code, &error_name) < 0) - return code; /* out-of-range error code! */ + return code; /* out-of-range error code! */ /* * For greater Adobe compatibility, only the standard PostScript errors * are defined in errordict; the rest are in gserrordict. */ if (dict_find_string(systemdict, "errordict", &perrordict) <= 0 || - (dict_find(perrordict, &error_name, &epref) <= 0 && - (dict_find_string(systemdict, "gserrordict", &perrordict) <= 0 || - dict_find(perrordict, &error_name, &epref) <= 0)) - ) - return code; /* error name not in errordict??? */ + (dict_find(perrordict, &error_name, &epref) <= 0 && + (dict_find_string(systemdict, "gserrordict", &perrordict) <= 0 || + dict_find(perrordict, &error_name, &epref) <= 0)) + ) + return code; /* error name not in errordict??? */ doref = *epref; epref = &doref; /* Push the error object on the operand stack if appropriate. */ if (!ERROR_IS_INTERRUPT(code)) { - /* Replace the error object if within an oparray or .errorexec. */ - *++osp = *perror_object; - errorexec_find(i_ctx_p, osp); + /* Replace the error object if within an oparray or .errorexec. */ + *++osp = *perror_object; + errorexec_find(i_ctx_p, osp); } goto again; } @@ -658,21 +658,21 @@ set_gc_signal(i_ctx_t *i_ctx_p, int *psignal, int value) int i; for (i = 0; i < countof(idmemory->spaces_indexed); i++) { - gs_ref_memory_t *mem = idmemory->spaces_indexed[i]; - gs_ref_memory_t *mem_stable; - - if (mem == 0) - continue; - for (;; mem = mem_stable) { - mem_stable = (gs_ref_memory_t *) - gs_memory_stable((gs_memory_t *)mem); - gs_memory_gc_status(mem, &stat); - stat.psignal = psignal; - stat.signal_value = value; - gs_memory_set_gc_status(mem, &stat); - if (mem_stable == mem) - break; - } + gs_ref_memory_t *mem = idmemory->spaces_indexed[i]; + gs_ref_memory_t *mem_stable; + + if (mem == 0) + continue; + for (;; mem = mem_stable) { + mem_stable = (gs_ref_memory_t *) + gs_memory_stable((gs_memory_t *)mem); + gs_memory_gc_status(mem, &stat); + stat.psignal = psignal; + stat.signal_value = value; + gs_memory_set_gc_status(mem, &stat); + if (mem_stable == mem) + break; + } } } @@ -691,8 +691,8 @@ copy_stack(i_ctx_t *i_ctx_p, const ref_stack_t * pstack, int skip, ref * arr) ialloc_set_space(idmemory, avm_local); code = ialloc_ref_array(arr, a_all, size, "copy_stack"); if (code >= 0) - code = ref_stack_store(pstack, arr, size, 0, 1, true, idmemory, - "copy_stack"); + code = ref_stack_store(pstack, arr, size, 0, 1, true, idmemory, + "copy_stack"); ialloc_set_space(idmemory, save_space); return code; } @@ -704,9 +704,9 @@ gs_errorname(i_ctx_t *i_ctx_p, int code, ref * perror_name) ref *perrordict, *pErrorNames; if (dict_find_string(systemdict, "errordict", &perrordict) <= 0 || - dict_find_string(systemdict, "ErrorNames", &pErrorNames) <= 0 - ) - return_error(e_undefined); /* errordict or ErrorNames not found?! */ + dict_find_string(systemdict, "ErrorNames", &pErrorNames) <= 0 + ) + return_error(e_undefined); /* errordict or ErrorNames not found?! */ return array_get(imemory, pErrorNames, (long)(-code - 1), perror_name); } @@ -720,12 +720,12 @@ gs_errorinfo_put_string(i_ctx_t *i_ctx_p, const char *str) int code = string_to_ref(str, &rstr, iimemory, "gs_errorinfo_put_string"); if (code < 0) - return code; + return code; if (dict_find_string(systemdict, "$error", &pderror) <= 0 || - !r_has_type(pderror, t_dictionary) || - idict_put_string(pderror, "errorinfo", &rstr) < 0 - ) - return_error(e_Fatal); + !r_has_type(pderror, t_dictionary) || + idict_put_string(pderror, "errorinfo", &rstr) < 0 + ) + return_error(e_Fatal); return 0; } @@ -764,14 +764,14 @@ interp(i_ctx_t **pi_ctx_p /* context for execution, updated if resched */, # define IREF ((const ref *)iref_packed) #endif #define SET_IREF(rp) (iref_packed = (const ref_packed *)(rp)) - register int icount = 0; /* # of consecutive tokens at iref */ - register os_ptr iosp = osp; /* private copy of osp */ - register es_ptr iesp = esp; /* private copy of esp */ + register int icount = 0; /* # of consecutive tokens at iref */ + register os_ptr iosp = osp; /* private copy of osp */ + register es_ptr iesp = esp; /* private copy of esp */ int code; - ref token; /* token read from file or string, */ - /* must be declared in this scope */ + ref token; /* token read from file or string, */ + /* must be declared in this scope */ register const ref *pvalue = 0; - uint opindex; /* needed for oparrays */ + uint opindex; /* needed for oparrays */ os_ptr whichp; /* @@ -783,10 +783,10 @@ interp(i_ctx_t **pi_ctx_p /* context for execution, updated if resched */, * will remain available on Intel processors. */ struct interp_error_s { - int code; - int line; - const ref *obj; - ref full; + int code; + int line; + const ref *obj; + ref full; } ierror; /* @@ -866,51 +866,51 @@ interp(i_ctx_t **pi_ctx_p /* context for execution, updated if resched */, /* so we push the argument on the estack and enter */ /* the loop at the bottom. */ if (iesp >= estop) - return_with_error(e_execstackoverflow, pref); + return_with_error(e_execstackoverflow, pref); ++iesp; ref_assign_inline(iesp, pref); goto bot; top: - /* - * This is the top of the interpreter loop. - * iref points to the ref being interpreted. - * Note that this might be an element of a packed array, - * not a real ref: we carefully arranged the first 16 bits of - * a ref and of a packed array element so they could be distinguished - * from each other. (See ghost.h and packed.h for more detail.) - */ + /* + * This is the top of the interpreter loop. + * iref points to the ref being interpreted. + * Note that this might be an element of a packed array, + * not a real ref: we carefully arranged the first 16 bits of + * a ref and of a packed array element so they could be distinguished + * from each other. (See ghost.h and packed.h for more detail.) + */ INCR(top); #ifdef DEBUG /* Do a little validation on the top o-stack entry. */ if (iosp >= osbot && - (r_type(iosp) == t__invalid || r_type(iosp) >= tx_next_op) - ) { - lprintf("Invalid value on o-stack!\n"); - return_with_error_iref(e_Fatal); + (r_type(iosp) == t__invalid || r_type(iosp) >= tx_next_op) + ) { + lprintf("Invalid value on o-stack!\n"); + return_with_error_iref(e_Fatal); } if (gs_debug['I'] || - (gs_debug['i'] && - (r_is_packed(iref_packed) ? - r_packed_is_name(iref_packed) : - r_has_type(IREF, t_name))) - ) { - os_ptr save_osp = osp; /* avoid side-effects */ - es_ptr save_esp = esp; - - osp = iosp; - esp = iesp; - dlprintf5("d%u,e%u<%u>0x%lx(%d): ", - ref_stack_count(&d_stack), ref_stack_count(&e_stack), - ref_stack_count(&o_stack), (ulong)IREF, icount); - debug_print_ref(imemory, IREF); - if (iosp >= osbot) { - dputs(" // "); - debug_print_ref(imemory, iosp); - } - dputc('\n'); - osp = save_osp; - esp = save_esp; - dflush(); + (gs_debug['i'] && + (r_is_packed(iref_packed) ? + r_packed_is_name(iref_packed) : + r_has_type(IREF, t_name))) + ) { + os_ptr save_osp = osp; /* avoid side-effects */ + es_ptr save_esp = esp; + + osp = iosp; + esp = iesp; + dlprintf5("d%u,e%u<%u>0x%lx(%d): ", + ref_stack_count(&d_stack), ref_stack_count(&e_stack), + ref_stack_count(&o_stack), (ulong)IREF, icount); + debug_print_ref(imemory, IREF); + if (iosp >= osbot) { + dputs(" // "); + debug_print_ref(imemory, iosp); + } + dputc('\n'); + osp = save_osp; + esp = save_esp; + dflush(); } #endif /* Objects that have attributes (arrays, dictionaries, files, and strings) */ @@ -927,23 +927,23 @@ interp(i_ctx_t **pi_ctx_p /* context for execution, updated if resched */, * What a nuisance! */ switch (r_type_xe(iref_packed)) { - /* Access errors. */ + /* Access errors. */ #define cases_invalid()\ case plain(t__invalid): case plain_exec(t__invalid) - cases_invalid(): - return_with_error_iref(e_Fatal); + cases_invalid(): + return_with_error_iref(e_Fatal); #define cases_nox()\ case nox_exec(t_array): case nox_exec(t_dictionary):\ case nox_exec(t_file): case nox_exec(t_string):\ case nox_exec(t_mixedarray): case nox_exec(t_shortarray) - cases_nox(): - return_with_error_iref(e_invalidaccess); - /* - * Literal objects. We have to enumerate all the types. - * In fact, we have to include some extra plain_exec entries - * just to populate the switch. We break them up into groups - * to avoid overflowing some preprocessors. - */ + cases_nox(): + return_with_error_iref(e_invalidaccess); + /* + * Literal objects. We have to enumerate all the types. + * In fact, we have to include some extra plain_exec entries + * just to populate the switch. We break them up into groups + * to avoid overflowing some preprocessors. + */ #define cases_lit_1()\ case lit(t_array): case nox(t_array):\ case plain(t_boolean): case plain_exec(t_boolean):\ @@ -968,673 +968,673 @@ interp(i_ctx_t **pi_ctx_p /* context for execution, updated if resched */, case plain(t_device): case plain_exec(t_device):\ case plain(t_struct): case plain_exec(t_struct):\ case plain(t_astruct): case plain_exec(t_astruct) - /* Executable arrays are treated as literals in direct execution. */ + /* Executable arrays are treated as literals in direct execution. */ #define cases_lit_array()\ case exec(t_array): case exec(t_mixedarray): case exec(t_shortarray) - cases_lit_1(): - cases_lit_2(): - cases_lit_3(): - cases_lit_4(): - cases_lit_5(): - INCR(lit); - break; - cases_lit_array(): - INCR(lit_array); - break; - /* Special operators. */ - case plain_exec(tx_op_add): -x_add: INCR(x_add); - if ((code = zop_add(iosp)) < 0) - return_with_error_tx_op(code); - iosp--; - next_either(); - case plain_exec(tx_op_def): -x_def: INCR(x_def); - osp = iosp; /* sync o_stack */ - if ((code = zop_def(i_ctx_p)) < 0) - return_with_error_tx_op(code); - iosp -= 2; - next_either(); - case plain_exec(tx_op_dup): -x_dup: INCR(x_dup); - if (iosp < osbot) - return_with_error_tx_op(e_stackunderflow); - if (iosp >= ostop) { - o_stack.requested = 1; + cases_lit_1(): + cases_lit_2(): + cases_lit_3(): + cases_lit_4(): + cases_lit_5(): + INCR(lit); + break; + cases_lit_array(): + INCR(lit_array); + break; + /* Special operators. */ + case plain_exec(tx_op_add): +x_add: INCR(x_add); + if ((code = zop_add(iosp)) < 0) + return_with_error_tx_op(code); + iosp--; + next_either(); + case plain_exec(tx_op_def): +x_def: INCR(x_def); + osp = iosp; /* sync o_stack */ + if ((code = zop_def(i_ctx_p)) < 0) + return_with_error_tx_op(code); + iosp -= 2; + next_either(); + case plain_exec(tx_op_dup): +x_dup: INCR(x_dup); + if (iosp < osbot) + return_with_error_tx_op(e_stackunderflow); + if (iosp >= ostop) { + o_stack.requested = 1; return_with_error_tx_op(e_stackoverflow); } - iosp++; - ref_assign_inline(iosp, iosp - 1); - next_either(); - case plain_exec(tx_op_exch): -x_exch: INCR(x_exch); - if (iosp <= osbot) - return_with_error_tx_op(e_stackunderflow); - ref_assign_inline(&token, iosp); - ref_assign_inline(iosp, iosp - 1); - ref_assign_inline(iosp - 1, &token); - next_either(); - case plain_exec(tx_op_if): -x_if: INCR(x_if); - if (!r_is_proc(iosp)) - return_with_error_tx_op(check_proc_failed(iosp)); - if (!r_has_type(iosp - 1, t_boolean)) - return_with_error_tx_op((iosp <= osbot ? - e_stackunderflow : e_typecheck)); - if (!iosp[-1].value.boolval) { - iosp -= 2; - next_either(); - } - if (iesp >= estop) - return_with_error_tx_op(e_execstackoverflow); - store_state_either(iesp); - whichp = iosp; - iosp -= 2; - goto ifup; - case plain_exec(tx_op_ifelse): + iosp++; + ref_assign_inline(iosp, iosp - 1); + next_either(); + case plain_exec(tx_op_exch): +x_exch: INCR(x_exch); + if (iosp <= osbot) + return_with_error_tx_op(e_stackunderflow); + ref_assign_inline(&token, iosp); + ref_assign_inline(iosp, iosp - 1); + ref_assign_inline(iosp - 1, &token); + next_either(); + case plain_exec(tx_op_if): +x_if: INCR(x_if); + if (!r_is_proc(iosp)) + return_with_error_tx_op(check_proc_failed(iosp)); + if (!r_has_type(iosp - 1, t_boolean)) + return_with_error_tx_op((iosp <= osbot ? + e_stackunderflow : e_typecheck)); + if (!iosp[-1].value.boolval) { + iosp -= 2; + next_either(); + } + if (iesp >= estop) + return_with_error_tx_op(e_execstackoverflow); + store_state_either(iesp); + whichp = iosp; + iosp -= 2; + goto ifup; + case plain_exec(tx_op_ifelse): x_ifelse: INCR(x_ifelse); - if (!r_is_proc(iosp)) - return_with_error_tx_op(check_proc_failed(iosp)); - if (!r_is_proc(iosp - 1)) - return_with_error_tx_op(check_proc_failed(iosp - 1)); - if (!r_has_type(iosp - 2, t_boolean)) - return_with_error_tx_op((iosp < osbot + 2 ? - e_stackunderflow : e_typecheck)); - if (iesp >= estop) - return_with_error_tx_op(e_execstackoverflow); - store_state_either(iesp); - whichp = (iosp[-2].value.boolval ? iosp - 1 : iosp); - iosp -= 3; - /* Open code "up" for the array case(s) */ - ifup:if ((icount = r_size(whichp) - 1) <= 0) { - if (icount < 0) - goto up; /* 0-element proc */ - SET_IREF(whichp->value.refs); /* 1-element proc */ - if (--ticks_left > 0) - goto top; - } - ++iesp; - /* Do a ref_assign, but also set iref. */ - iesp->tas = whichp->tas; - SET_IREF(iesp->value.refs = whichp->value.refs); - if (--ticks_left > 0) - goto top; - goto slice; - case plain_exec(tx_op_index): + if (!r_is_proc(iosp)) + return_with_error_tx_op(check_proc_failed(iosp)); + if (!r_is_proc(iosp - 1)) + return_with_error_tx_op(check_proc_failed(iosp - 1)); + if (!r_has_type(iosp - 2, t_boolean)) + return_with_error_tx_op((iosp < osbot + 2 ? + e_stackunderflow : e_typecheck)); + if (iesp >= estop) + return_with_error_tx_op(e_execstackoverflow); + store_state_either(iesp); + whichp = (iosp[-2].value.boolval ? iosp - 1 : iosp); + iosp -= 3; + /* Open code "up" for the array case(s) */ + ifup:if ((icount = r_size(whichp) - 1) <= 0) { + if (icount < 0) + goto up; /* 0-element proc */ + SET_IREF(whichp->value.refs); /* 1-element proc */ + if (--ticks_left > 0) + goto top; + } + ++iesp; + /* Do a ref_assign, but also set iref. */ + iesp->tas = whichp->tas; + SET_IREF(iesp->value.refs = whichp->value.refs); + if (--ticks_left > 0) + goto top; + goto slice; + case plain_exec(tx_op_index): x_index: INCR(x_index); - osp = iosp; /* zindex references o_stack */ - if ((code = zindex(i_ctx_p)) < 0) - return_with_error_tx_op(code); - next_either(); - case plain_exec(tx_op_pop): -x_pop: INCR(x_pop); - if (iosp < osbot) - return_with_error_tx_op(e_stackunderflow); - iosp--; - next_either(); - case plain_exec(tx_op_roll): -x_roll: INCR(x_roll); - osp = iosp; /* zroll references o_stack */ - if ((code = zroll(i_ctx_p)) < 0) - return_with_error_tx_op(code); - iosp -= 2; - next_either(); - case plain_exec(tx_op_sub): -x_sub: INCR(x_sub); - if ((code = zop_sub(iosp)) < 0) - return_with_error_tx_op(code); - iosp--; - next_either(); - /* Executable types. */ - case plain_exec(t_null): - goto bot; - case plain_exec(t_oparray): - /* Replace with the definition and go again. */ - INCR(exec_array); - opindex = op_index(IREF); - pvalue = IREF->value.const_refs; - opst: /* Prepare to call a t_oparray procedure in *pvalue. */ - store_state(iesp); - oppr: /* Record the stack depths in case of failure. */ - if (iesp >= estop - 4) - return_with_error_iref(e_execstackoverflow); - iesp += 5; - osp = iosp; /* ref_stack_count_inline needs this */ - make_mark_estack(iesp - 4, es_other, oparray_cleanup); - make_int(iesp - 3, opindex); /* for .errorexec effect */ - make_int(iesp - 2, ref_stack_count_inline(&o_stack)); - make_int(iesp - 1, ref_stack_count_inline(&d_stack)); - make_op_estack(iesp, oparray_pop); - goto pr; - prst: /* Prepare to call the procedure (array) in *pvalue. */ - store_state(iesp); - pr: /* Call the array in *pvalue. State has been stored. */ - if ((icount = r_size(pvalue) - 1) <= 0) { - if (icount < 0) - goto up; /* 0-element proc */ - SET_IREF(pvalue->value.refs); /* 1-element proc */ - if (--ticks_left > 0) - goto top; - } - if (iesp >= estop) - return_with_error_iref(e_execstackoverflow); - ++iesp; - /* Do a ref_assign, but also set iref. */ - iesp->tas = pvalue->tas; - SET_IREF(iesp->value.refs = pvalue->value.refs); - if (--ticks_left > 0) - goto top; - goto slice; - case plain_exec(t_operator): - INCR(exec_operator); - if (--ticks_left <= 0) { /* The following doesn't work, */ - /* and I can't figure out why. */ + osp = iosp; /* zindex references o_stack */ + if ((code = zindex(i_ctx_p)) < 0) + return_with_error_tx_op(code); + next_either(); + case plain_exec(tx_op_pop): +x_pop: INCR(x_pop); + if (iosp < osbot) + return_with_error_tx_op(e_stackunderflow); + iosp--; + next_either(); + case plain_exec(tx_op_roll): +x_roll: INCR(x_roll); + osp = iosp; /* zroll references o_stack */ + if ((code = zroll(i_ctx_p)) < 0) + return_with_error_tx_op(code); + iosp -= 2; + next_either(); + case plain_exec(tx_op_sub): +x_sub: INCR(x_sub); + if ((code = zop_sub(iosp)) < 0) + return_with_error_tx_op(code); + iosp--; + next_either(); + /* Executable types. */ + case plain_exec(t_null): + goto bot; + case plain_exec(t_oparray): + /* Replace with the definition and go again. */ + INCR(exec_array); + opindex = op_index(IREF); + pvalue = IREF->value.const_refs; + opst: /* Prepare to call a t_oparray procedure in *pvalue. */ + store_state(iesp); + oppr: /* Record the stack depths in case of failure. */ + if (iesp >= estop - 4) + return_with_error_iref(e_execstackoverflow); + iesp += 5; + osp = iosp; /* ref_stack_count_inline needs this */ + make_mark_estack(iesp - 4, es_other, oparray_cleanup); + make_int(iesp - 3, opindex); /* for .errorexec effect */ + make_int(iesp - 2, ref_stack_count_inline(&o_stack)); + make_int(iesp - 1, ref_stack_count_inline(&d_stack)); + make_op_estack(iesp, oparray_pop); + goto pr; + prst: /* Prepare to call the procedure (array) in *pvalue. */ + store_state(iesp); + pr: /* Call the array in *pvalue. State has been stored. */ + if ((icount = r_size(pvalue) - 1) <= 0) { + if (icount < 0) + goto up; /* 0-element proc */ + SET_IREF(pvalue->value.refs); /* 1-element proc */ + if (--ticks_left > 0) + goto top; + } + if (iesp >= estop) + return_with_error_iref(e_execstackoverflow); + ++iesp; + /* Do a ref_assign, but also set iref. */ + iesp->tas = pvalue->tas; + SET_IREF(iesp->value.refs = pvalue->value.refs); + if (--ticks_left > 0) + goto top; + goto slice; + case plain_exec(t_operator): + INCR(exec_operator); + if (--ticks_left <= 0) { /* The following doesn't work, */ + /* and I can't figure out why. */ /****** goto sst; ******/ - } - esp = iesp; /* save for operator */ - osp = iosp; /* ditto */ - /* Operator routines take osp as an argument. */ - /* This is just a convenience, since they adjust */ - /* osp themselves to reflect the results. */ - /* Operators that (net) push information on the */ - /* operand stack must check for overflow: */ - /* this normally happens automatically through */ - /* the push macro (in oper.h). */ - /* Operators that do not typecheck their operands, */ - /* or take a variable number of arguments, */ - /* must check explicitly for stack underflow. */ - /* (See oper.h for more detail.) */ - /* Note that each case must set iosp = osp: */ - /* this is so we can switch on code without having to */ - /* store it and reload it (for dumb compilers). */ - switch (code = call_operator(real_opproc(IREF), i_ctx_p)) { - case 0: /* normal case */ - case 1: /* alternative success case */ - iosp = osp; - next(); - case o_push_estack: /* store the state and go to up */ - store_state(iesp); - opush:iosp = osp; - iesp = esp; - if (--ticks_left > 0) - goto up; - goto slice; - case o_pop_estack: /* just go to up */ - opop:iosp = osp; - if (esp == iesp) - goto bot; - iesp = esp; - goto up; - case o_reschedule: - store_state(iesp); - goto res; - case e_RemapColor: -oe_remap: store_state(iesp); -remap: if (iesp + 2 >= estop) { - esp = iesp; - code = ref_stack_extend(&e_stack, 2); - if (code < 0) - return_with_error_iref(code); - iesp = esp; - } - packed_get(imemory, iref_packed, iesp + 1); - make_oper(iesp + 2, 0, - r_ptr(&istate->remap_color_info, - int_remap_color_info_t)->proc); - iesp += 2; - goto up; - } - iosp = osp; - iesp = esp; - return_with_code_iref(); - case plain_exec(t_name): - INCR(exec_name); - pvalue = IREF->value.pname->pvalue; - if (!pv_valid(pvalue)) { - uint nidx = names_index(int_nt, IREF); - uint htemp; - - INCR(find_name); - if ((pvalue = dict_find_name_by_index_inline(nidx, htemp)) == 0) - return_with_error_iref(e_undefined); - } - /* Dispatch on the type of the value. */ - /* Again, we have to over-populate the switch. */ - switch (r_type_xe(pvalue)) { - cases_invalid(): - return_with_error_iref(e_Fatal); - cases_nox(): /* access errors */ - return_with_error_iref(e_invalidaccess); - cases_lit_1(): - cases_lit_2(): - cases_lit_3(): - cases_lit_4(): - cases_lit_5(): - INCR(name_lit); - /* Just push the value */ - if (iosp >= ostop) - return_with_stackoverflow(pvalue); - ++iosp; - ref_assign_inline(iosp, pvalue); - next(); - case exec(t_array): - case exec(t_mixedarray): - case exec(t_shortarray): - INCR(name_proc); - /* This is an executable procedure, execute it. */ - goto prst; - case plain_exec(tx_op_add): - goto x_add; - case plain_exec(tx_op_def): - goto x_def; - case plain_exec(tx_op_dup): - goto x_dup; - case plain_exec(tx_op_exch): - goto x_exch; - case plain_exec(tx_op_if): - goto x_if; - case plain_exec(tx_op_ifelse): - goto x_ifelse; - case plain_exec(tx_op_index): - goto x_index; - case plain_exec(tx_op_pop): - goto x_pop; - case plain_exec(tx_op_roll): - goto x_roll; - case plain_exec(tx_op_sub): - goto x_sub; - case plain_exec(t_null): - goto bot; - case plain_exec(t_oparray): - INCR(name_oparray); - opindex = op_index(pvalue); - pvalue = (const ref *)pvalue->value.const_refs; - goto opst; - case plain_exec(t_operator): - INCR(name_operator); - { /* Shortcut for operators. */ - /* See above for the logic. */ - if (--ticks_left <= 0) { /* The following doesn't work, */ - /* and I can't figure out why. */ + } + esp = iesp; /* save for operator */ + osp = iosp; /* ditto */ + /* Operator routines take osp as an argument. */ + /* This is just a convenience, since they adjust */ + /* osp themselves to reflect the results. */ + /* Operators that (net) push information on the */ + /* operand stack must check for overflow: */ + /* this normally happens automatically through */ + /* the push macro (in oper.h). */ + /* Operators that do not typecheck their operands, */ + /* or take a variable number of arguments, */ + /* must check explicitly for stack underflow. */ + /* (See oper.h for more detail.) */ + /* Note that each case must set iosp = osp: */ + /* this is so we can switch on code without having to */ + /* store it and reload it (for dumb compilers). */ + switch (code = call_operator(real_opproc(IREF), i_ctx_p)) { + case 0: /* normal case */ + case 1: /* alternative success case */ + iosp = osp; + next(); + case o_push_estack: /* store the state and go to up */ + store_state(iesp); + opush:iosp = osp; + iesp = esp; + if (--ticks_left > 0) + goto up; + goto slice; + case o_pop_estack: /* just go to up */ + opop:iosp = osp; + if (esp == iesp) + goto bot; + iesp = esp; + goto up; + case o_reschedule: + store_state(iesp); + goto res; + case e_RemapColor: +oe_remap: store_state(iesp); +remap: if (iesp + 2 >= estop) { + esp = iesp; + code = ref_stack_extend(&e_stack, 2); + if (code < 0) + return_with_error_iref(code); + iesp = esp; + } + packed_get(imemory, iref_packed, iesp + 1); + make_oper(iesp + 2, 0, + r_ptr(&istate->remap_color_info, + int_remap_color_info_t)->proc); + iesp += 2; + goto up; + } + iosp = osp; + iesp = esp; + return_with_code_iref(); + case plain_exec(t_name): + INCR(exec_name); + pvalue = IREF->value.pname->pvalue; + if (!pv_valid(pvalue)) { + uint nidx = names_index(int_nt, IREF); + uint htemp; + + INCR(find_name); + if ((pvalue = dict_find_name_by_index_inline(nidx, htemp)) == 0) + return_with_error_iref(e_undefined); + } + /* Dispatch on the type of the value. */ + /* Again, we have to over-populate the switch. */ + switch (r_type_xe(pvalue)) { + cases_invalid(): + return_with_error_iref(e_Fatal); + cases_nox(): /* access errors */ + return_with_error_iref(e_invalidaccess); + cases_lit_1(): + cases_lit_2(): + cases_lit_3(): + cases_lit_4(): + cases_lit_5(): + INCR(name_lit); + /* Just push the value */ + if (iosp >= ostop) + return_with_stackoverflow(pvalue); + ++iosp; + ref_assign_inline(iosp, pvalue); + next(); + case exec(t_array): + case exec(t_mixedarray): + case exec(t_shortarray): + INCR(name_proc); + /* This is an executable procedure, execute it. */ + goto prst; + case plain_exec(tx_op_add): + goto x_add; + case plain_exec(tx_op_def): + goto x_def; + case plain_exec(tx_op_dup): + goto x_dup; + case plain_exec(tx_op_exch): + goto x_exch; + case plain_exec(tx_op_if): + goto x_if; + case plain_exec(tx_op_ifelse): + goto x_ifelse; + case plain_exec(tx_op_index): + goto x_index; + case plain_exec(tx_op_pop): + goto x_pop; + case plain_exec(tx_op_roll): + goto x_roll; + case plain_exec(tx_op_sub): + goto x_sub; + case plain_exec(t_null): + goto bot; + case plain_exec(t_oparray): + INCR(name_oparray); + opindex = op_index(pvalue); + pvalue = (const ref *)pvalue->value.const_refs; + goto opst; + case plain_exec(t_operator): + INCR(name_operator); + { /* Shortcut for operators. */ + /* See above for the logic. */ + if (--ticks_left <= 0) { /* The following doesn't work, */ + /* and I can't figure out why. */ /****** goto sst; ******/ - } - esp = iesp; - osp = iosp; - switch (code = call_operator(real_opproc(pvalue), - i_ctx_p) - ) { - case 0: /* normal case */ - case 1: /* alternative success case */ - iosp = osp; - next(); - case o_push_estack: - store_state(iesp); - goto opush; - case o_pop_estack: - goto opop; - case o_reschedule: - store_state(iesp); - goto res; - case e_RemapColor: - goto oe_remap; - } - iosp = osp; - iesp = esp; - return_with_error(code, pvalue); - } - case plain_exec(t_name): - case exec(t_file): - case exec(t_string): - default: - /* Not a procedure, reinterpret it. */ - store_state(iesp); - icount = 0; - SET_IREF(pvalue); - goto top; - } - case exec(t_file): - { /* Executable file. Read the next token and interpret it. */ - stream *s; - scanner_state sstate; - - check_read_known_file(i_ctx_p, s, IREF, return_with_error_iref); - rt: - if (iosp >= ostop) /* check early */ - return_with_stackoverflow_iref(); - osp = iosp; /* scan_token uses ostack */ - scanner_init_options(&sstate, IREF, i_ctx_p->scanner_options); - again: - code = scan_token(i_ctx_p, &token, &sstate); - iosp = osp; /* ditto */ - switch (code) { - case 0: /* read a token */ - /* It's worth checking for literals, which make up */ - /* the majority of input tokens, before storing the */ - /* state on the e-stack. Note that because of //, */ - /* the token may have *any* type and attributes. */ - /* Note also that executable arrays aren't executed */ - /* at the top level -- they're treated as literals. */ - if (!r_has_attr(&token, a_executable) || - r_is_array(&token) - ) { /* If scan_token used the o-stack, */ - /* we know we can do a push now; if not, */ - /* the pre-check is still valid. */ - iosp++; - ref_assign_inline(iosp, &token); - goto rt; - } - store_state(iesp); - /* Push the file on the e-stack */ - if (iesp >= estop) - return_with_error_iref(e_execstackoverflow); - esfile_set_cache(++iesp); - ref_assign_inline(iesp, IREF); - SET_IREF(&token); - icount = 0; - goto top; - case e_undefined: /* //name undefined */ - scanner_error_object(i_ctx_p, &sstate, &token); - return_with_error(code, &token); - case scan_EOF: /* end of file */ - esfile_clear_cache(); - goto bot; - case scan_BOS: - /* Binary object sequences */ - /* ARE executed at the top level. */ - store_state(iesp); - /* Push the file on the e-stack */ - if (iesp >= estop) - return_with_error_iref(e_execstackoverflow); - esfile_set_cache(++iesp); - ref_assign_inline(iesp, IREF); - pvalue = &token; - goto pr; - case scan_Refill: - store_state(iesp); - /* iref may point into the exec stack; */ - /* save its referent now. */ - ref_assign_inline(&token, IREF); - /* Push the file on the e-stack */ - if (iesp >= estop) - return_with_error_iref(e_execstackoverflow); - ++iesp; - ref_assign_inline(iesp, &token); - esp = iesp; - osp = iosp; - code = scan_handle_refill(i_ctx_p, &sstate, true, - ztokenexec_continue); - scan_cont: - iosp = osp; - iesp = esp; - switch (code) { - case 0: - iesp--; /* don't push the file */ - goto again; /* stacks are unchanged */ - case o_push_estack: - esfile_clear_cache(); - if (--ticks_left > 0) - goto up; - goto slice; - } - /* must be an error */ - iesp--; /* don't push the file */ - return_with_code_iref(); - case scan_Comment: - case scan_DSC_Comment: { - /* See scan_Refill above for comments. */ - ref file_token; - - store_state(iesp); - ref_assign_inline(&file_token, IREF); - if (iesp >= estop) - return_with_error_iref(e_execstackoverflow); - ++iesp; - ref_assign_inline(iesp, &file_token); - esp = iesp; - osp = iosp; - code = ztoken_handle_comment(i_ctx_p, - &sstate, &token, - code, true, true, - ztokenexec_continue); - } - goto scan_cont; - default: /* error */ - ref_assign_inline(&token, IREF); - scanner_error_object(i_ctx_p, &sstate, &token); - return_with_error(code, &token); - } - } - case exec(t_string): - { /* Executable string. Read a token and interpret it. */ - stream ss; - scanner_state sstate; - - s_init(&ss, NULL); - sread_string(&ss, IREF->value.bytes, r_size(IREF)); - scanner_init_stream_options(&sstate, &ss, SCAN_FROM_STRING); - osp = iosp; /* scan_token uses ostack */ - code = scan_token(i_ctx_p, &token, &sstate); - iosp = osp; /* ditto */ - switch (code) { - case 0: /* read a token */ - case scan_BOS: /* binary object sequence */ - store_state(iesp); - /* If the updated string isn't empty, push it back */ - /* on the e-stack. */ - { - uint size = sbufavailable(&ss); - - if (size) { - if (iesp >= estop) - return_with_error_iref(e_execstackoverflow); - ++iesp; - iesp->tas.type_attrs = IREF->tas.type_attrs; - iesp->value.const_bytes = sbufptr(&ss); - r_set_size(iesp, size); - } - } - if (code == 0) { - SET_IREF(&token); - icount = 0; - goto top; - } - /* Handle BOS specially */ - pvalue = &token; - goto pr; - case scan_EOF: /* end of string */ - goto bot; - case scan_Refill: /* error */ - code = gs_note_error(e_syntaxerror); - default: /* error */ - ref_assign_inline(&token, IREF); - scanner_error_object(i_ctx_p, &sstate, &token); - return_with_error(code, &token); - } - } - /* Handle packed arrays here by re-dispatching. */ - /* This also picks up some anomalous cases of non-packed arrays. */ - default: - { - uint index; - - switch (*iref_packed >> r_packed_type_shift) { - case pt_full_ref: - case pt_full_ref + 1: - INCR(p_full); - if (iosp >= ostop) - return_with_stackoverflow_iref(); - /* We know this can't be an executable object */ - /* requiring special handling, so we just push it. */ - ++iosp; - /* We know that refs are properly aligned: */ - /* see packed.h for details. */ - ref_assign_inline(iosp, IREF); - next(); - case pt_executable_operator: - index = *iref_packed & packed_value_mask; - if (--ticks_left <= 0) { /* The following doesn't work, */ - /* and I can't figure out why. */ + } + esp = iesp; + osp = iosp; + switch (code = call_operator(real_opproc(pvalue), + i_ctx_p) + ) { + case 0: /* normal case */ + case 1: /* alternative success case */ + iosp = osp; + next(); + case o_push_estack: + store_state(iesp); + goto opush; + case o_pop_estack: + goto opop; + case o_reschedule: + store_state(iesp); + goto res; + case e_RemapColor: + goto oe_remap; + } + iosp = osp; + iesp = esp; + return_with_error(code, pvalue); + } + case plain_exec(t_name): + case exec(t_file): + case exec(t_string): + default: + /* Not a procedure, reinterpret it. */ + store_state(iesp); + icount = 0; + SET_IREF(pvalue); + goto top; + } + case exec(t_file): + { /* Executable file. Read the next token and interpret it. */ + stream *s; + scanner_state sstate; + + check_read_known_file(i_ctx_p, s, IREF, return_with_error_iref); + rt: + if (iosp >= ostop) /* check early */ + return_with_stackoverflow_iref(); + osp = iosp; /* gs_scan_token uses ostack */ + gs_scanner_init_options(&sstate, IREF, i_ctx_p->scanner_options); + again: + code = gs_scan_token(i_ctx_p, &token, &sstate); + iosp = osp; /* ditto */ + switch (code) { + case 0: /* read a token */ + /* It's worth checking for literals, which make up */ + /* the majority of input tokens, before storing the */ + /* state on the e-stack. Note that because of //, */ + /* the token may have *any* type and attributes. */ + /* Note also that executable arrays aren't executed */ + /* at the top level -- they're treated as literals. */ + if (!r_has_attr(&token, a_executable) || + r_is_array(&token) + ) { /* If gs_scan_token used the o-stack, */ + /* we know we can do a push now; if not, */ + /* the pre-check is still valid. */ + iosp++; + ref_assign_inline(iosp, &token); + goto rt; + } + store_state(iesp); + /* Push the file on the e-stack */ + if (iesp >= estop) + return_with_error_iref(e_execstackoverflow); + esfile_set_cache(++iesp); + ref_assign_inline(iesp, IREF); + SET_IREF(&token); + icount = 0; + goto top; + case e_undefined: /* //name undefined */ + gs_scanner_error_object(i_ctx_p, &sstate, &token); + return_with_error(code, &token); + case scan_EOF: /* end of file */ + esfile_clear_cache(); + goto bot; + case scan_BOS: + /* Binary object sequences */ + /* ARE executed at the top level. */ + store_state(iesp); + /* Push the file on the e-stack */ + if (iesp >= estop) + return_with_error_iref(e_execstackoverflow); + esfile_set_cache(++iesp); + ref_assign_inline(iesp, IREF); + pvalue = &token; + goto pr; + case scan_Refill: + store_state(iesp); + /* iref may point into the exec stack; */ + /* save its referent now. */ + ref_assign_inline(&token, IREF); + /* Push the file on the e-stack */ + if (iesp >= estop) + return_with_error_iref(e_execstackoverflow); + ++iesp; + ref_assign_inline(iesp, &token); + esp = iesp; + osp = iosp; + code = gs_scan_handle_refill(i_ctx_p, &sstate, true, + ztokenexec_continue); + scan_cont: + iosp = osp; + iesp = esp; + switch (code) { + case 0: + iesp--; /* don't push the file */ + goto again; /* stacks are unchanged */ + case o_push_estack: + esfile_clear_cache(); + if (--ticks_left > 0) + goto up; + goto slice; + } + /* must be an error */ + iesp--; /* don't push the file */ + return_with_code_iref(); + case scan_Comment: + case scan_DSC_Comment: { + /* See scan_Refill above for comments. */ + ref file_token; + + store_state(iesp); + ref_assign_inline(&file_token, IREF); + if (iesp >= estop) + return_with_error_iref(e_execstackoverflow); + ++iesp; + ref_assign_inline(iesp, &file_token); + esp = iesp; + osp = iosp; + code = ztoken_handle_comment(i_ctx_p, + &sstate, &token, + code, true, true, + ztokenexec_continue); + } + goto scan_cont; + default: /* error */ + ref_assign_inline(&token, IREF); + gs_scanner_error_object(i_ctx_p, &sstate, &token); + return_with_error(code, &token); + } + } + case exec(t_string): + { /* Executable string. Read a token and interpret it. */ + stream ss; + scanner_state sstate; + + s_init(&ss, NULL); + sread_string(&ss, IREF->value.bytes, r_size(IREF)); + gs_scanner_init_stream_options(&sstate, &ss, SCAN_FROM_STRING); + osp = iosp; /* gs_scan_token uses ostack */ + code = gs_scan_token(i_ctx_p, &token, &sstate); + iosp = osp; /* ditto */ + switch (code) { + case 0: /* read a token */ + case scan_BOS: /* binary object sequence */ + store_state(iesp); + /* If the updated string isn't empty, push it back */ + /* on the e-stack. */ + { + uint size = sbufavailable(&ss); + + if (size) { + if (iesp >= estop) + return_with_error_iref(e_execstackoverflow); + ++iesp; + iesp->tas.type_attrs = IREF->tas.type_attrs; + iesp->value.const_bytes = sbufptr(&ss); + r_set_size(iesp, size); + } + } + if (code == 0) { + SET_IREF(&token); + icount = 0; + goto top; + } + /* Handle BOS specially */ + pvalue = &token; + goto pr; + case scan_EOF: /* end of string */ + goto bot; + case scan_Refill: /* error */ + code = gs_note_error(e_syntaxerror); + default: /* error */ + ref_assign_inline(&token, IREF); + gs_scanner_error_object(i_ctx_p, &sstate, &token); + return_with_error(code, &token); + } + } + /* Handle packed arrays here by re-dispatching. */ + /* This also picks up some anomalous cases of non-packed arrays. */ + default: + { + uint index; + + switch (*iref_packed >> r_packed_type_shift) { + case pt_full_ref: + case pt_full_ref + 1: + INCR(p_full); + if (iosp >= ostop) + return_with_stackoverflow_iref(); + /* We know this can't be an executable object */ + /* requiring special handling, so we just push it. */ + ++iosp; + /* We know that refs are properly aligned: */ + /* see packed.h for details. */ + ref_assign_inline(iosp, IREF); + next(); + case pt_executable_operator: + index = *iref_packed & packed_value_mask; + if (--ticks_left <= 0) { /* The following doesn't work, */ + /* and I can't figure out why. */ /****** goto sst_short; ******/ - } - if (!op_index_is_operator(index)) { - INCR(p_exec_oparray); - store_state_short(iesp); - opindex = index; - /* Call the operator procedure. */ - index -= op_def_count; - pvalue = (const ref *) - (index < r_size(&i_ctx_p->op_array_table_global.table) ? - i_ctx_p->op_array_table_global.table.value.const_refs + - index : - i_ctx_p->op_array_table_local.table.value.const_refs + - (index - r_size(&i_ctx_p->op_array_table_global.table))); - goto oppr; - } - INCR(p_exec_operator); - /* See the main plain_exec(t_operator) case */ - /* for details of what happens here. */ + } + if (!op_index_is_operator(index)) { + INCR(p_exec_oparray); + store_state_short(iesp); + opindex = index; + /* Call the operator procedure. */ + index -= op_def_count; + pvalue = (const ref *) + (index < r_size(&i_ctx_p->op_array_table_global.table) ? + i_ctx_p->op_array_table_global.table.value.const_refs + + index : + i_ctx_p->op_array_table_local.table.value.const_refs + + (index - r_size(&i_ctx_p->op_array_table_global.table))); + goto oppr; + } + INCR(p_exec_operator); + /* See the main plain_exec(t_operator) case */ + /* for details of what happens here. */ #if PACKED_SPECIAL_OPS - /* - * We arranged in iinit.c that the special ops - * have operator indices starting at 1. - * - * The (int) cast in the next line is required - * because some compilers don't allow arithmetic - * involving two different enumerated types. - */ + /* + * We arranged in iinit.c that the special ops + * have operator indices starting at 1. + * + * The (int) cast in the next line is required + * because some compilers don't allow arithmetic + * involving two different enumerated types. + */ # define case_xop(xop) case xop - (int)tx_op + 1 - switch (index) { - case_xop(tx_op_add):goto x_add; - case_xop(tx_op_def):goto x_def; - case_xop(tx_op_dup):goto x_dup; - case_xop(tx_op_exch):goto x_exch; - case_xop(tx_op_if):goto x_if; - case_xop(tx_op_ifelse):goto x_ifelse; - case_xop(tx_op_index):goto x_index; - case_xop(tx_op_pop):goto x_pop; - case_xop(tx_op_roll):goto x_roll; - case_xop(tx_op_sub):goto x_sub; - case 0: /* for dumb compilers */ - default: - ; - } + switch (index) { + case_xop(tx_op_add):goto x_add; + case_xop(tx_op_def):goto x_def; + case_xop(tx_op_dup):goto x_dup; + case_xop(tx_op_exch):goto x_exch; + case_xop(tx_op_if):goto x_if; + case_xop(tx_op_ifelse):goto x_ifelse; + case_xop(tx_op_index):goto x_index; + case_xop(tx_op_pop):goto x_pop; + case_xop(tx_op_roll):goto x_roll; + case_xop(tx_op_sub):goto x_sub; + case 0: /* for dumb compilers */ + default: + ; + } # undef case_xop #endif - INCR(p_exec_non_x_operator); - esp = iesp; - osp = iosp; - switch (code = call_operator(op_index_proc(index), i_ctx_p)) { - case 0: - case 1: - iosp = osp; - next_short(); - case o_push_estack: - store_state_short(iesp); - goto opush; - case o_pop_estack: - iosp = osp; - if (esp == iesp) { - next_short(); - } - iesp = esp; - goto up; - case o_reschedule: - store_state_short(iesp); - goto res; - case e_RemapColor: - store_state_short(iesp); - goto remap; - } - iosp = osp; - iesp = esp; - return_with_code_iref(); - case pt_integer: - INCR(p_integer); - if (iosp >= ostop) - return_with_stackoverflow_iref(); - ++iosp; - make_int(iosp, - ((int)*iref_packed & packed_int_mask) + - packed_min_intval); - next_short(); - case pt_literal_name: - INCR(p_lit_name); - { - uint nidx = *iref_packed & packed_value_mask; - - if (iosp >= ostop) - return_with_stackoverflow_iref(); - ++iosp; - name_index_ref_inline(int_nt, nidx, iosp); - next_short(); - } - case pt_executable_name: - INCR(p_exec_name); - { - uint nidx = *iref_packed & packed_value_mask; - - pvalue = name_index_ptr_inline(int_nt, nidx)->pvalue; - if (!pv_valid(pvalue)) { - uint htemp; - - INCR(p_find_name); - if ((pvalue = dict_find_name_by_index_inline(nidx, htemp)) == 0) { - names_index_ref(int_nt, nidx, &token); - return_with_error(e_undefined, &token); - } - } - if (r_has_masked_attrs(pvalue, a_execute, a_execute + a_executable)) { /* Literal, push it. */ - INCR(p_name_lit); - if (iosp >= ostop) - return_with_stackoverflow_iref(); - ++iosp; - ref_assign_inline(iosp, pvalue); - next_short(); - } - if (r_is_proc(pvalue)) { /* This is an executable procedure, */ - /* execute it. */ - INCR(p_name_proc); - store_state_short(iesp); - goto pr; - } - /* Not a literal or procedure, reinterpret it. */ - store_state_short(iesp); - icount = 0; - SET_IREF(pvalue); - goto top; - } - /* default can't happen here */ - } - } + INCR(p_exec_non_x_operator); + esp = iesp; + osp = iosp; + switch (code = call_operator(op_index_proc(index), i_ctx_p)) { + case 0: + case 1: + iosp = osp; + next_short(); + case o_push_estack: + store_state_short(iesp); + goto opush; + case o_pop_estack: + iosp = osp; + if (esp == iesp) { + next_short(); + } + iesp = esp; + goto up; + case o_reschedule: + store_state_short(iesp); + goto res; + case e_RemapColor: + store_state_short(iesp); + goto remap; + } + iosp = osp; + iesp = esp; + return_with_code_iref(); + case pt_integer: + INCR(p_integer); + if (iosp >= ostop) + return_with_stackoverflow_iref(); + ++iosp; + make_int(iosp, + ((int)*iref_packed & packed_int_mask) + + packed_min_intval); + next_short(); + case pt_literal_name: + INCR(p_lit_name); + { + uint nidx = *iref_packed & packed_value_mask; + + if (iosp >= ostop) + return_with_stackoverflow_iref(); + ++iosp; + name_index_ref_inline(int_nt, nidx, iosp); + next_short(); + } + case pt_executable_name: + INCR(p_exec_name); + { + uint nidx = *iref_packed & packed_value_mask; + + pvalue = name_index_ptr_inline(int_nt, nidx)->pvalue; + if (!pv_valid(pvalue)) { + uint htemp; + + INCR(p_find_name); + if ((pvalue = dict_find_name_by_index_inline(nidx, htemp)) == 0) { + names_index_ref(int_nt, nidx, &token); + return_with_error(e_undefined, &token); + } + } + if (r_has_masked_attrs(pvalue, a_execute, a_execute + a_executable)) { /* Literal, push it. */ + INCR(p_name_lit); + if (iosp >= ostop) + return_with_stackoverflow_iref(); + ++iosp; + ref_assign_inline(iosp, pvalue); + next_short(); + } + if (r_is_proc(pvalue)) { /* This is an executable procedure, */ + /* execute it. */ + INCR(p_name_proc); + store_state_short(iesp); + goto pr; + } + /* Not a literal or procedure, reinterpret it. */ + store_state_short(iesp); + icount = 0; + SET_IREF(pvalue); + goto top; + } + /* default can't happen here */ + } + } } /* Literal type, just push it. */ if (iosp >= ostop) - return_with_stackoverflow_iref(); + return_with_stackoverflow_iref(); ++iosp; ref_assign_inline(iosp, IREF); bot:next(); - out: /* At most 1 more token in the current procedure. */ + out: /* At most 1 more token in the current procedure. */ /* (We already decremented icount.) */ if (!icount) { - /* Pop the execution stack for tail recursion. */ - iesp--; - iref_packed = IREF_NEXT(iref_packed); - goto top; + /* Pop the execution stack for tail recursion. */ + iesp--; + iref_packed = IREF_NEXT(iref_packed); + goto top; } up:if (--ticks_left < 0) - goto slice; + goto slice; /* See if there is anything left on the execution stack. */ if (!r_is_proc(iesp)) { - SET_IREF(iesp--); - icount = 0; - goto top; + SET_IREF(iesp--); + icount = 0; + goto top; } - SET_IREF(iesp->value.refs); /* next element of array */ + SET_IREF(iesp->value.refs); /* next element of array */ icount = r_size(iesp) - 1; - if (icount <= 0) { /* <= 1 more elements */ - iesp--; /* pop, or tail recursion */ - if (icount < 0) - goto up; + if (icount <= 0) { /* <= 1 more elements */ + iesp--; /* pop, or tail recursion */ + if (icount < 0) + goto up; } goto top; res: @@ -1643,46 +1643,46 @@ res: *pi_ctx_p = i_ctx_p; code = (*i_ctx_p->reschedule_proc)(pi_ctx_p); i_ctx_p = *pi_ctx_p; - sched: /* We've just called a scheduling procedure. */ + sched: /* We've just called a scheduling procedure. */ /* The interpreter state is in memory; iref is not current. */ if (code < 0) { - set_error(code); - /* - * We need a real object to return as the error object. - * (It only has to last long enough to store in - * *perror_object.) - */ - make_null_proc(&ierror.full); - SET_IREF(ierror.obj = &ierror.full); - goto error_exit; + set_error(code); + /* + * We need a real object to return as the error object. + * (It only has to last long enough to store in + * *perror_object.) + */ + make_null_proc(&ierror.full); + SET_IREF(ierror.obj = &ierror.full); + goto error_exit; } /* Reload state information from memory. */ iosp = osp; iesp = esp; goto up; -#if 0 /****** ****** ***** */ - sst: /* Time-slice, but push the current object first. */ +#if 0 /****** ****** ***** */ + sst: /* Time-slice, but push the current object first. */ store_state(iesp); if (iesp >= estop) - return_with_error_iref(e_execstackoverflow); + return_with_error_iref(e_execstackoverflow); iesp++; ref_assign_inline(iesp, iref); #endif /****** ****** ***** */ - slice: /* It's time to time-slice or garbage collect. */ + slice: /* It's time to time-slice or garbage collect. */ /* iref is not live, so we don't need to do a store_state. */ osp = iosp; esp = iesp; /* If ticks_left <= -100, we need to GC now. */ - if (ticks_left <= -100) { /* We need to garbage collect now. */ - *pi_ctx_p = i_ctx_p; - code = interp_reclaim(pi_ctx_p, -1); - i_ctx_p = *pi_ctx_p; + if (ticks_left <= -100) { /* We need to garbage collect now. */ + *pi_ctx_p = i_ctx_p; + code = interp_reclaim(pi_ctx_p, -1); + i_ctx_p = *pi_ctx_p; } else if (i_ctx_p->time_slice_proc != NULL) { - *pi_ctx_p = i_ctx_p; - code = (*i_ctx_p->time_slice_proc)(pi_ctx_p); - i_ctx_p = *pi_ctx_p; + *pi_ctx_p = i_ctx_p; + code = (*i_ctx_p->time_slice_proc)(pi_ctx_p); + i_ctx_p = *pi_ctx_p; } else - code = 0; + code = 0; ticks_left = i_ctx_p->time_slice_ticks; set_code_on_interrupt(imemory, &code); goto sched; @@ -1695,38 +1695,38 @@ res: ierror.obj = IREF; rwe: if (!r_is_packed(iref_packed)) - store_state(iesp); + store_state(iesp); else { - /* - * We need a real object to return as the error object. - * (It only has to last long enough to store in *perror_object.) - */ - packed_get(imemory, (const ref_packed *)ierror.obj, &ierror.full); - store_state_short(iesp); - if (IREF == ierror.obj) - SET_IREF(&ierror.full); - ierror.obj = &ierror.full; + /* + * We need a real object to return as the error object. + * (It only has to last long enough to store in *perror_object.) + */ + packed_get(imemory, (const ref_packed *)ierror.obj, &ierror.full); + store_state_short(iesp); + if (IREF == ierror.obj) + SET_IREF(&ierror.full); + ierror.obj = &ierror.full; } error_exit: - if (ERROR_IS_INTERRUPT(ierror.code)) { /* We must push the current object being interpreted */ - /* back on the e-stack so it will be re-executed. */ - /* Currently, this is always an executable operator, */ - /* but it might be something else someday if we check */ - /* for interrupts in the interpreter loop itself. */ - if (iesp >= estop) - code = e_execstackoverflow; - else { - iesp++; - ref_assign_inline(iesp, IREF); - } + if (ERROR_IS_INTERRUPT(ierror.code)) { /* We must push the current object being interpreted */ + /* back on the e-stack so it will be re-executed. */ + /* Currently, this is always an executable operator, */ + /* but it might be something else someday if we check */ + /* for interrupts in the interpreter loop itself. */ + if (iesp >= estop) + code = e_execstackoverflow; + else { + iesp++; + ref_assign_inline(iesp, IREF); + } } esp = iesp; osp = iosp; ref_assign_inline(perror_object, ierror.obj); #ifdef DEBUG if (ierror.code == e_InterpreterExit) { - /* Do not call gs_log_error to reduce the noise. */ - return e_InterpreterExit; + /* Do not call gs_log_error to reduce the noise. */ + return e_InterpreterExit; } #endif return gs_log_error(ierror.code, __FILE__, ierror.line); @@ -1744,7 +1744,7 @@ oparray_pop(i_ctx_t *i_ctx_p) /* This procedure is called only from pop_estack. */ static int oparray_cleanup(i_ctx_t *i_ctx_p) -{ /* esp points just below the cleanup procedure. */ +{ /* esp points just below the cleanup procedure. */ es_ptr ep = esp; uint ocount_old = (uint) ep[3].value.intval; uint dcount_old = (uint) ep[4].value.intval; @@ -1752,10 +1752,10 @@ oparray_cleanup(i_ctx_t *i_ctx_p) uint dcount = ref_stack_count(&d_stack); if (ocount > ocount_old) - ref_stack_pop(&o_stack, ocount - ocount_old); + ref_stack_pop(&o_stack, ocount - ocount_old); if (dcount > dcount_old) { - ref_stack_pop(&d_stack, dcount - dcount_old); - dict_set_top(); + ref_stack_pop(&d_stack, dcount - dcount_old); + dict_set_top(); } return 0; } @@ -1775,11 +1775,11 @@ oparray_find(i_ctx_t *i_ctx_p) ref *ep; for (i = 0; (ep = ref_stack_index(&e_stack, i)) != 0; ++i) { - if (r_is_estack_mark(ep) && - (ep->value.opproc == oparray_cleanup || - ep->value.opproc == oparray_no_cleanup) - ) - return ep; + if (r_is_estack_mark(ep) && + (ep->value.opproc == oparray_cleanup || + ep->value.opproc == oparray_no_cleanup) + ) + return ep; } return 0; } @@ -1794,15 +1794,15 @@ zerrorexec(i_ctx_t *i_ctx_p) int code; check_op(2); - check_estack(4); /* mark/cleanup, errobj, pop, obj */ + check_estack(4); /* mark/cleanup, errobj, pop, obj */ push_mark_estack(es_other, errorexec_cleanup); *++esp = op[-1]; push_op_estack(errorexec_pop); code = zexec(i_ctx_p); if (code >= 0) - pop(1); + pop(1); else - esp -= 3; /* undo our additions to estack */ + esp -= 3; /* undo our additions to estack */ return code; } @@ -1817,12 +1817,12 @@ zfinderrorobject(i_ctx_t *i_ctx_p) ref errobj; if (errorexec_find(i_ctx_p, &errobj)) { - push(2); - op[-1] = errobj; - make_true(op); + push(2); + op[-1] = errobj; + make_true(op); } else { - push(1); - make_false(op); + push(1); + make_false(op); } return 0; } @@ -1839,24 +1839,24 @@ errorexec_find(i_ctx_t *i_ctx_p, ref *perror_object) const ref *ep; for (i = 0; (ep = ref_stack_index(&e_stack, i)) != 0; ++i) { - if (r_is_estack_mark(ep)) { - if (ep->value.opproc == oparray_cleanup) { - /* See oppr: above. */ - uint opindex = (uint)ep[1].value.intval; - if (opindex == 0) /* internal operator, ignore */ - continue; - op_index_ref(imemory, opindex, perror_object); - return 1; - } - if (ep->value.opproc == oparray_no_cleanup) - return 0; /* protection disabled */ - if (ep->value.opproc == errorexec_cleanup) { - if (r_has_type(ep + 1, t_null)) - return 0; - *perror_object = ep[1]; /* see .errorexec above */ - return 1; - } - } + if (r_is_estack_mark(ep)) { + if (ep->value.opproc == oparray_cleanup) { + /* See oppr: above. */ + uint opindex = (uint)ep[1].value.intval; + if (opindex == 0) /* internal operator, ignore */ + continue; + op_index_ref(imemory, opindex, perror_object); + return 1; + } + if (ep->value.opproc == oparray_no_cleanup) + return 0; /* protection disabled */ + if (ep->value.opproc == errorexec_cleanup) { + if (r_has_type(ep + 1, t_null)) + return 0; + *perror_object = ep[1]; /* see .errorexec above */ + return 1; + } + } } return 0; } @@ -1886,9 +1886,9 @@ zsetstackprotect(i_ctx_t *i_ctx_p) check_type(*op, t_boolean); if (ep == 0) - return_error(e_rangecheck); + return_error(e_rangecheck); ep->value.opproc = - (op->value.boolval ? oparray_cleanup : oparray_no_cleanup); + (op->value.boolval ? oparray_cleanup : oparray_no_cleanup); pop(1); return 0; } @@ -1902,7 +1902,7 @@ zcurrentstackprotect(i_ctx_t *i_ctx_p) ref *ep = oparray_find(i_ctx_p); if (ep == 0) - return_error(e_rangecheck); + return_error(e_rangecheck); push(1); make_bool(op, ep->value.opproc == oparray_cleanup); return 0; |