/* Copyright (C) 1989, 2000, 2001 artofcode LLC. All rights reserved. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA, 02111-1307. */ /*$Id: interp.c,v 1.8.2.3.2.1 2003/01/17 00:49:04 giles Exp $ */ /* Ghostscript language interpreter */ #include "memory_.h" #include "string_.h" #include "ghost.h" #include "gsstruct.h" /* for iastruct.h */ #include "stream.h" #include "errors.h" #include "estack.h" #include "ialloc.h" #include "iastruct.h" #include "icontext.h" #include "icremap.h" #include "igstate.h" /* for handling e_RemapColor */ #include "inamedef.h" #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 "iscan.h" #include "iddict.h" #include "isave.h" #include "istack.h" #include "itoken.h" #include "iutil.h" /* for array_get */ #include "ivmspace.h" #include "dstack.h" #include "files.h" /* for file_check_read */ #include "oper.h" #include "store.h" /* * We may or may not optimize the handling of the special fast operators * in packed arrays. If we do this, they run much faster when packed, but * slightly slower when not packed. */ #define PACKED_SPECIAL_OPS 1 /* * Pseudo-operators (procedures of type t_oparray) record * the operand and dictionary stack pointers, and restore them if an error * occurs during the execution of the procedure and if the procedure hasn't * (net) decreased the depth of the stack. While this obviously doesn't * do all the work of restoring the state if a pseudo-operator gets an * error, it's a big help. The only downside is that pseudo-operators run * a little slower. */ /* GC descriptors for stacks */ extern_st(st_ref_stack); public_st_dict_stack(); public_st_exec_stack(); public_st_op_stack(); /* * The procedure to call if an operator requests rescheduling. * This causes an error unless the context machinery has been installed. */ private int no_reschedule(i_ctx_t **pi_ctx_p) { return_error(e_invalidcontext); } int (*gs_interp_reschedule_proc)(P1(i_ctx_t **)) = no_reschedule; /* * The procedure to call for time-slicing. * This is a no-op unless the context machinery has been installed. */ int (*gs_interp_time_slice_proc)(P1(i_ctx_t **)) = 0; /* * The number of interpreter "ticks" between calls on the time_slice_proc. * Currently, the clock ticks before each operator, and at each * procedure return. */ int gs_interp_time_slice_ticks = 0x7fff; /* * Apply an operator. When debugging, we route all operator calls * through a procedure. */ #ifdef DEBUG private int call_operator(op_proc_t op_proc, i_ctx_t *i_ctx_p) { int code = op_proc(i_ctx_p); return code; } #else # define call_operator(proc, p) ((*(proc))(p)) #endif /* Define debugging statistics. */ #ifdef DEBUG 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; 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; long p_find_name, p_name_lit, p_name_proc; } stats_interp; # define INCR(v) (++(stats_interp.v)) #else # define INCR(v) DO_NOTHING #endif /* Forward references */ private int estack_underflow(P1(i_ctx_t *)); private int interp(P3(i_ctx_t **, const ref *, ref *)); private int interp_exit(P1(i_ctx_t *)); private void set_gc_signal(P3(i_ctx_t *, int *, int)); private int copy_stack(P3(i_ctx_t *, const ref_stack_t *, ref *)); private int oparray_pop(P1(i_ctx_t *)); private int oparray_cleanup(P1(i_ctx_t *)); private int zsetstackprotect(P1(i_ctx_t *)); private int zcurrentstackprotect(P1(i_ctx_t *)); /* Stack sizes */ /* The maximum stack sizes may all be set in the makefile. */ /* * Define the initial maximum size of the operand stack (MaxOpStack * user parameter). */ #ifndef MAX_OSTACK # define MAX_OSTACK 800 #endif /* * The minimum block size for extending the operand stack is the larger of: * - the maximum number of parameters to an operator * (currently setcolorscreen, with 12 parameters); * - the maximum number of values pushed by an operator * (currently setcolortransfer, which calls zcolor_remap_one 4 times * and therefore pushes 16 values). */ #define MIN_BLOCK_OSTACK 16 const int gs_interp_max_op_num_args = MIN_BLOCK_OSTACK; /* for iinit.c */ /* * Define the initial maximum size of the execution stack (MaxExecStack * user parameter). */ #ifndef MAX_ESTACK # define MAX_ESTACK 5000 #endif /* * The minimum block size for extending the execution stack is the largest * size of a contiguous block surrounding an e-stack mark. (At least, * that's what the minimum value would be if we supported multi-block * estacks, which we currently don't.) Currently, the largest such block is * the one created for text processing, which is 8 (snumpush) slots. */ #define MIN_BLOCK_ESTACK 8 /* * If we get an e-stack overflow, we need to cut it back far enough to * have some headroom for executing the error procedure. */ #define ES_HEADROOM 20 /* * Define the initial maximum size of the dictionary stack (MaxDictStack * user parameter). Again, this is also currently the block size for * extending the d-stack. */ #ifndef MAX_DSTACK # define MAX_DSTACK 20 #endif /* * The minimum block size for extending the dictionary stack is the number * of permanent entries on the dictionary stack, currently 3. */ #define MIN_BLOCK_DSTACK 3 /* See estack.h for a description of the execution stack. */ /* The logic for managing icount and iref below assumes that */ /* there are no control operators which pop and then push */ /* information on the execution stack. */ /* Stacks */ extern_st(st_ref_stack); #define OS_GUARD_UNDER 10 #define OS_GUARD_OVER 10 #define OS_REFS_SIZE(body_size)\ (stack_block_refs + OS_GUARD_UNDER + (body_size) + OS_GUARD_OVER) #define ES_GUARD_UNDER 1 #define ES_GUARD_OVER 10 #define ES_REFS_SIZE(body_size)\ (stack_block_refs + ES_GUARD_UNDER + (body_size) + ES_GUARD_OVER) #define DS_REFS_SIZE(body_size)\ (stack_block_refs + (body_size)) /* Extended types. The interpreter may replace the type of operators */ /* in procedures with these, to speed up the interpretation loop. */ /****** NOTE: If you add or change entries in this list, */ /****** you must change the three dispatches in the interpreter loop. */ /* The operator procedures are declared in opextern.h. */ #define tx_op t_next_index typedef enum { tx_op_add = tx_op, tx_op_def, tx_op_dup, tx_op_exch, tx_op_if, tx_op_ifelse, tx_op_index, tx_op_pop, tx_op_roll, tx_op_sub, tx_next_op } 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 tx_next_index = tx_next_op; /* * Define the interpreter operators, which include the extended-type * operators defined in the list above. NOTE: if the size of this table * ever exceeds 15 real entries, it will have to be split. */ const op_def interp_op_defs[] = { /* * The very first entry, which corresponds to operator index 0, * must not contain an actual operator. */ op_def_begin_dict("systemdict"), /* * The next entries must be the extended-type operators, in the * correct order. */ {"2add", zadd}, {"2def", zdef}, {"1dup", zdup}, {"2exch", zexch}, {"2if", zif}, {"3ifelse", zifelse}, {"1index", zindex}, {"1pop", zpop}, {"2roll", zroll}, {"2sub", zsub}, /* * The remaining entries are internal operators. */ {"0.currentstackprotect", zcurrentstackprotect}, {"1.setstackprotect", zsetstackprotect}, {"0%interp_exit", interp_exit}, {"0%oparray_pop", oparray_pop}, op_def_end(0) }; #define make_null_proc(pref)\ make_empty_const_array(pref, a_executable + a_readonly) /* Initialize the interpreter. */ int gs_interp_init(i_ctx_t **pi_ctx_p, const ref *psystem_dict, 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); if (code < 0) lprintf1("Fatal error %d in gs_interp_init!", code); *pi_ctx_p = pcst; return code; } /* * Create initial stacks for the interpreter. * We export this for creating new contexts. */ 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); 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"); { 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 *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); } #undef REFS_SIZE_OSTACK #undef REFS_SIZE_ESTACK #undef REFS_SIZE_DSTACK return 0; } /* * Free the stacks when destroying a context. This is the inverse of * create_stacks. */ void gs_interp_free_stacks(gs_ref_memory_t * smem, gs_context_state_t * pcst) { /* Free the stacks in inverse order of allocation. */ ref_stack_release(&pcst->dict_stack.stack); ref_stack_release(&pcst->exec_stack.stack); ref_stack_release(&pcst->op_stack.stack); } void gs_interp_reset(i_ctx_t *i_ctx_p) { /* Reset the stacks. */ ref_stack_clear(&o_stack); ref_stack_clear(&e_stack); esp++; make_oper(esp, 0, interp_exit); ref_stack_pop_to(&d_stack, min_dstack_size); dict_set_top(); } /* Report an e-stack block underflow. The bottom guard slots of */ /* e-stack blocks contain a pointer to this procedure. */ private int estack_underflow(i_ctx_t *i_ctx_p) { return e_ExecStackUnderflow; } /* * Create an operator during initialization. * If operator is hard-coded into the interpreter, * assign it a special type and index. */ void gs_interp_make_oper(ref * opref, op_proc_t proc, int idx) { int i; for (i = num_special_ops; i > 0 && proc != interp_op_defs[i].proc; --i) DO_NOTHING; if (i > 0) make_tasv(opref, tx_op + (i - 1), a_executable, i, opproc, proc); else make_tasv(opref, t_operator, a_executable, idx, opproc, proc); } /* * Call the garbage collector, updating the context pointer properly. */ private int interp_reclaim(i_ctx_t **pi_ctx_p, int space) { i_ctx_t *i_ctx_p = *pi_ctx_p; gs_gc_root_t ctx_root; int code; gs_register_struct_root(imemory_system, &ctx_root, (void **)pi_ctx_p, "interp_reclaim(pi_ctx_p)"); code = (*idmemory->reclaim)(idmemory, space); i_ctx_p = *pi_ctx_p; /* may have moved */ gs_unregister_root(imemory_system, &ctx_root, "interp_reclaim(pi_ctx_p)"); return code; } /* * Invoke the interpreter. If execution completes normally, return 0. * If an error occurs, the action depends on user_errors as follows: * user_errors < 0: always return an error code. * user_errors >= 0: let the PostScript machinery handle all errors. * (This will eventually result in a fatal error if no 'stopped' * is active.) * In case of a quit or a fatal error, also store the exit code. * Set *perror_object to null or the error object. */ private int gs_call_interp(P5(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) { 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"); code = gs_call_interp(pi_ctx_p, pref, user_errors, pexit_code, 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. */ set_gc_signal(i_ctx_p, NULL, 0); return code; } private int gs_call_interp(i_ctx_t **pi_ctx_p, ref * pref, int user_errors, int *pexit_code, ref * perror_object) { ref *epref = pref; ref doref; ref *perrordict; ref error_name; int code, ccode; ref saref; int gc_signal = 0; i_ctx_t *i_ctx_p = *pi_ctx_p; *pexit_code = 0; ialloc_reset_requested(idmemory); 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; } code = interp(pi_ctx_p, epref, perror_object); i_ctx_p = *pi_ctx_p; /* 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; 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: /****** 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_NeedStdin: case e_NeedStdout: case e_NeedStderr: return code; } /* Adjust osp in case of operand stack underflow */ if (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: if (ref_stack_extend(&d_stack, d_stack.requested) >= 0) { dict_set_top(); doref = *perror_object; epref = &doref; goto again; } if (osp >= ostop) { if ((ccode = ref_stack_extend(&o_stack, 1)) < 0) return ccode; } ccode = copy_stack(i_ctx_p, &d_stack, &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, &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, &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; if (gs_errorname(i_ctx_p, code, &error_name) < 0) return code; /* out-of-range error code! */ if (dict_find_string(systemdict, "errordict", &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)) *++osp = *perror_object; goto again; } private int interp_exit(i_ctx_t *i_ctx_p) { return e_InterpreterExit; } /* Set the GC signal for all VMs. */ private void set_gc_signal(i_ctx_t *i_ctx_p, int *psignal, int value) { gs_memory_gc_status_t stat; 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; } } } /* Copy the contents of an overflowed stack into a (local) array. */ private int copy_stack(i_ctx_t *i_ctx_p, const ref_stack_t * pstack, ref * arr) { uint size = ref_stack_count(pstack); uint save_space = ialloc_space(idmemory); int code; 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"); ialloc_set_space(idmemory, save_space); return code; } /* Get the name corresponding to an error number. */ int 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?! */ return array_get(pErrorNames, (long)(-code - 1), perror_name); } /* Store an error string in $error.errorinfo. */ /* This routine is here because of the proximity to the error handler. */ int gs_errorinfo_put_string(i_ctx_t *i_ctx_p, const char *str) { ref rstr; ref *pderror; int code = string_to_ref(str, &rstr, iimemory, "gs_errorinfo_put_string"); if (code < 0) 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); return 0; } /* Main interpreter. */ /* If execution terminates normally, return e_InterpreterExit. */ /* If an error occurs, leave the current object in *perror_object */ /* and return a (negative) error code. */ private int interp(i_ctx_t **pi_ctx_p /* context for execution, updated if resched */, const ref * pref /* object to interpret */, ref * perror_object) { i_ctx_t *i_ctx_p = *pi_ctx_p; /* * Note that iref may actually be either a ref * or a ref_packed *. * Certain DEC compilers assume that a ref * is ref-aligned even if it * is cast to a short *, and generate code on this assumption, leading * to "unaligned access" errors. For this reason, we declare * iref_packed, and use a macro to cast it to the more aligned type * where necessary (which is almost everywhere it is used). This may * lead to compiler warnings about "cast increases alignment * requirements", but this is less harmful than expensive traps at run * time. */ register const ref_packed *iref_packed = (const ref_packed *)pref; /* * To make matters worse, some versions of gcc/egcs have a bug that * leads them to assume that if iref_packed is EVER cast to a ref *, * it is ALWAYS ref-aligned. We detect this in stdpre.h and provide * the following workaround: */ #ifdef ALIGNMENT_ALIASING_BUG const ref *iref_temp; # define IREF (iref_temp = (const ref *)iref_packed, iref_temp) #else # 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 */ int code; ref token; /* token read from file or string, */ /* must be declared in this scope */ register const ref *pvalue; os_ptr whichp; /* * We have to make the error information into a struct; * otherwise, the Watcom compiler will assign it to registers * strictly on the basis of textual frequency. * We also have to use ref_assign_inline everywhere, and * avoid direct assignments of refs, so that esi and edi * will remain available on Intel processors. */ struct interp_error_s { int code; int line; const ref *obj; ref full; } ierror; /* * Get a pointer to the name table so that we can use the * inline version of name_index_ref. */ const name_table *const int_nt = the_name_table(); #define set_error(ecode)\ { ierror.code = ecode; ierror.line = __LINE__; } #define return_with_error(ecode, objp)\ { set_error(ecode); ierror.obj = objp; goto rwe; } #define return_with_error_iref(ecode)\ { set_error(ecode); goto rwei; } #define return_with_code_iref()\ { ierror.line = __LINE__; goto rweci; } #define return_with_error_code_op(nargs)\ return_with_code_iref() #define return_with_stackoverflow(objp)\ { o_stack.requested = 1; return_with_error(e_stackoverflow, objp); } #define return_with_stackoverflow_iref()\ { o_stack.requested = 1; return_with_error_iref(e_stackoverflow); } int ticks_left = gs_interp_time_slice_ticks; /* * If we exceed the VMThreshold, set ticks_left to -1 * to alert the interpreter that we need to garbage collect. */ set_gc_signal(i_ctx_p, &ticks_left, -100); esfile_clear_cache(); /* * From here on, if icount > 0, iref and icount correspond * to the top entry on the execution stack: icount is the count * of sequential entries remaining AFTER the current one. */ #define IREF_NEXT(ip)\ ((const ref_packed *)((const ref *)(ip) + 1)) #define IREF_NEXT_EITHER(ip)\ ( r_is_packed(ip) ? (ip) + 1 : IREF_NEXT(ip) ) #define store_state(ep)\ ( icount > 0 ? (ep->value.const_refs = IREF + 1, r_set_size(ep, icount)) : 0 ) #define store_state_short(ep)\ ( icount > 0 ? (ep->value.packed = iref_packed + 1, r_set_size(ep, icount)) : 0 ) #define store_state_either(ep)\ ( icount > 0 ? (ep->value.packed = IREF_NEXT_EITHER(iref_packed), r_set_size(ep, icount)) : 0 ) #define next()\ if ( --icount > 0 ) { iref_packed = IREF_NEXT(iref_packed); goto top; } else goto out #define next_short()\ if ( --icount <= 0 ) { if ( icount < 0 ) goto up; iesp--; }\ ++iref_packed; goto top #define next_either()\ if ( --icount <= 0 ) { if ( icount < 0 ) goto up; iesp--; }\ iref_packed = IREF_NEXT_EITHER(iref_packed); goto top #if !PACKED_SPECIAL_OPS # undef next_either # define next_either() next() # undef store_state_either # define store_state_either(ep) store_state(ep) #endif /* We want to recognize executable arrays here, */ /* so we push the argument on the estack and enter */ /* the loop at the bottom. */ if (iesp >= estop) 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.) */ 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); } if (gs_debug['I'] || (gs_debug['i'] && (r_is_packed(iref_packed) ? r_packed_is_name(iref_packed) : r_has_type(IREF, t_name))) ) { void debug_print_ref(P1(const ref *)); 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(IREF); if (iosp >= osbot) { dputs(" // "); debug_print_ref(iosp); } dputc('\n'); osp = save_osp; esp = save_esp; fflush(dstderr); } #endif /* Objects that have attributes (arrays, dictionaries, files, and strings) */ /* use lit and exec; other objects use plain and plain_exec. */ #define lit(t) type_xe_value(t, a_execute) #define exec(t) type_xe_value(t, a_execute + a_executable) #define nox(t) type_xe_value(t, 0) #define nox_exec(t) type_xe_value(t, a_executable) #define plain(t) type_xe_value(t, 0) #define plain_exec(t) type_xe_value(t, a_executable) /* * We have to populate enough cases of the switch statement to force * some compilers to use a dispatch rather than a testing loop. * What a nuisance! */ switch (r_type_xe(iref_packed)) { /* Access errors. */ #define cases_invalid()\ case plain(t__invalid): case plain_exec(t__invalid) 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. */ #define cases_lit_1()\ case lit(t_array): case nox(t_array):\ case plain(t_boolean): case plain_exec(t_boolean):\ case lit(t_dictionary): case nox(t_dictionary) #define cases_lit_2()\ case lit(t_file): case nox(t_file):\ case plain(t_fontID): case plain_exec(t_fontID):\ case plain(t_integer): case plain_exec(t_integer):\ case plain(t_mark): case plain_exec(t_mark) #define cases_lit_3()\ case plain(t_name):\ case plain(t_null):\ case plain(t_oparray):\ case plain(t_operator) #define cases_lit_4()\ case plain(t_real): case plain_exec(t_real):\ case plain(t_save): case plain_exec(t_save):\ case lit(t_string): case nox(t_string) #define cases_lit_5()\ case lit(t_mixedarray): case nox(t_mixedarray):\ case lit(t_shortarray): case nox(t_shortarray):\ 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. */ #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_code_op(2); 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_code_op(2); iosp -= 2; next_either(); case plain_exec(tx_op_dup): x_dup: INCR(x_dup); if (iosp < osbot) return_with_error_iref(e_stackunderflow); if (iosp >= ostop) return_with_stackoverflow_iref(); 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_iref(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_has_type(iosp - 1, t_boolean)) return_with_error_iref((iosp <= osbot ? e_stackunderflow : e_typecheck)); if (!r_is_proc(iosp)) return_with_error_iref(check_proc_failed(iosp)); if (!iosp[-1].value.boolval) { iosp -= 2; next_either(); } if (iesp >= estop) return_with_error_iref(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_has_type(iosp - 2, t_boolean)) return_with_error_iref((iosp < osbot + 2 ? e_stackunderflow : e_typecheck)); if (!r_is_proc(iosp - 1)) return_with_error_iref(check_proc_failed(iosp - 1)); if (!r_is_proc(iosp)) return_with_error_iref(check_proc_failed(iosp)); if (iesp >= estop) return_with_error_iref(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_code_op(1); next_either(); case plain_exec(tx_op_pop): x_pop: INCR(x_pop); if (iosp < osbot) return_with_error_iref(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_code_op(2); iosp -= 2; next_either(); case plain_exec(tx_op_sub): x_sub: INCR(x_sub); if ((code = zop_sub(iosp)) < 0) return_with_error_code_op(2); 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); 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 - 3) return_with_error_iref(e_execstackoverflow); iesp += 4; osp = iosp; /* ref_stack_count_inline needs this */ make_mark_estack(iesp - 3, es_other, oparray_cleanup); 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(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); 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(s, IREF, return_with_error_iref); rt: if (iosp >= ostop) /* check early */ return_with_stackoverflow_iref(); osp = iosp; /* scan_token uses ostack */ scanner_state_init_options(&sstate, i_ctx_p->scanner_options); again: code = scan_token(i_ctx_p, s, &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 */ 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, &token, &sstate, true, 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, &file_token, &sstate, &token, code, true, true, ztokenexec_continue); } goto scan_cont; default: /* error */ return_with_code_iref(); } } case exec(t_string): { /* Executable string. Read a token and interpret it. */ stream ss; scanner_state sstate; scanner_state_init_options(&sstate, SCAN_FROM_STRING); s_init(&ss, NULL); sread_string(&ss, IREF->value.bytes, r_size(IREF)); osp = iosp; /* scan_token uses ostack */ code = scan_token(i_ctx_p, &ss, &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 */ return_with_code_iref(); } } /* 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); /* Call the operator procedure. */ index -= op_def_count; pvalue = (const ref *) (index < r_size(&op_array_table_global.table) ? op_array_table_global.table.value.const_refs + index : op_array_table_local.table.value.const_refs + (index - r_size(&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. */ # 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: ; } # 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 */ } } } /* Literal type, just push it. */ if (iosp >= ostop) return_with_stackoverflow_iref(); ++iosp; ref_assign_inline(iosp, IREF); bot:next(); 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; } up:if (--ticks_left < 0) 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->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; } goto top; res: /* Some operator has asked for context rescheduling. */ /* We've done a store_state. */ *pi_ctx_p = i_ctx_p; code = (*gs_interp_reschedule_proc)(pi_ctx_p); i_ctx_p = *pi_ctx_p; 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; } /* Reload state information from memory. */ iosp = osp; iesp = esp; goto up; #if 0 /****** ****** ***** */ sst: /* Time-slice, but push the current object first. */ store_state(iesp); if (iesp >= estop) return_with_error_iref(e_execstackoverflow); iesp++; ref_assign_inline(iesp, iref); #endif /****** ****** ***** */ 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; } else if (gs_interp_time_slice_proc) { *pi_ctx_p = i_ctx_p; code = (*gs_interp_time_slice_proc)(pi_ctx_p); i_ctx_p = *pi_ctx_p; } else code = 0; ticks_left = gs_interp_time_slice_ticks; goto sched; /* Error exits. */ rweci: ierror.code = code; rwei: ierror.obj = IREF; rwe: if (!r_is_packed(iref_packed)) 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((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); } } esp = iesp; osp = iosp; ref_assign_inline(perror_object, ierror.obj); return gs_log_error(ierror.code, __FILE__, ierror.line); } /* Pop the bookkeeping information for a normal exit from a t_oparray. */ private int oparray_pop(i_ctx_t *i_ctx_p) { esp -= 3; return o_pop_estack; } /* Restore the stack pointers after an error inside a t_oparray procedure. */ /* This procedure is called only from pop_estack. */ private int oparray_cleanup(i_ctx_t *i_ctx_p) { /* esp points just below the cleanup procedure. */ es_ptr ep = esp; uint ocount_old = (uint) ep[2].value.intval; uint dcount_old = (uint) ep[3].value.intval; uint ocount = ref_stack_count(&o_stack); uint dcount = ref_stack_count(&d_stack); if (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(); } return 0; } /* Don't restore the stack pointers. */ private int oparray_no_cleanup(i_ctx_t *i_ctx_p) { return 0; } /* Find the innermost oparray. */ private ref * oparray_find(i_ctx_t *i_ctx_p) { long i; 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; } return 0; } /* .setstackprotect - */ /* Set whether to protect the stack for the innermost oparray. */ private int zsetstackprotect(i_ctx_t *i_ctx_p) { os_ptr op = osp; ref *ep = oparray_find(i_ctx_p); check_type(*op, t_boolean); if (ep == 0) return_error(e_rangecheck); ep->value.opproc = (op->value.boolval ? oparray_cleanup : oparray_no_cleanup); pop(1); return 0; } /* - .currentstackprotect */ /* Return the stack protection status. */ private int zcurrentstackprotect(i_ctx_t *i_ctx_p) { os_ptr op = osp; ref *ep = oparray_find(i_ctx_p); if (ep == 0) return_error(e_rangecheck); push(1); make_bool(op, ep->value.opproc == oparray_cleanup); return 0; }