/* Copyright (C) 2001-2024 Artifex Software, Inc.

   All Rights Reserved.

   This software is provided AS-IS with no warranty, either express or

   implied.

   This software is distributed under license and may not be copied,

   modified or distributed except as expressly authorized under the terms

   of the license contained in the file LICENSE in this distribution.

   Refer to licensing information at http://www.artifex.com or contact

   Artifex Software, Inc.,  39 Mesa Street, Suite 108A, San Francisco,

   CA 94129, USA, for further information.

*/

/* Ghostscript language interpreter */

#include "memory_.h"

#include "string_.h"

#include "ghost.h"

#include "gsstruct.h"           /* for iastruct.h */

#include "gserrors.h"           /* for gpcheck.h */

#include "stream.h"

#include "ierrors.h"

#include "estack.h"

#include "ialloc.h"

#include "iastruct.h"

#include "icontext.h"

#include "icremap.h"

#include "idebug.h"

#include "igstate.h"            /* for handling gs_error_Remap_Color */

#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 "iinit.h"

#include "dstack.h"

#include "files.h"              /* for file_check_read */

#include "oper.h"

#include "store.h"

#include "gpcheck.h"

#define FORCE_ASSERT_CHECKING 1

#define DEBUG_TRACE_PS_OPERATORS 1

#include "assert_.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();

/*

 * Apply an operator.  When debugging, we route all operator calls

 * through a procedure.

 */

#if defined(DEBUG_TRACE_PS_OPERATORS) || defined(DEBUG)

#define call_operator(proc, p) (*call_operator_fn)(proc, p)

static int

do_call_operator(op_proc_t op_proc, i_ctx_t *i_ctx_p)

{

    int code;

    assert(e_stack.p >= e_stack.bot - 1 && e_stack.p < e_stack.top + 1);

    assert(o_stack.p >= o_stack.bot - 1 && o_stack.p < o_stack.top + 1);

    code = op_proc(i_ctx_p);

    if (gs_debug_c(gs_debug_flag_validate_clumps))

        ivalidate_clean_spaces(i_ctx_p);

    assert(e_stack.p >= e_stack.bot - 1 && e_stack.p < e_stack.top + 1);

    assert(o_stack.p >= o_stack.bot - 1 && o_stack.p < o_stack.top + 1);

    return code; /* A good place for a conditional breakpoint. */

}

static int

do_call_operator_verbose(op_proc_t op_proc, i_ctx_t *i_ctx_p)

{

    int code;

#ifndef SHOW_STACK_DEPTHS

    if_debug1m('!', imemory, "[!]operator %s\n", op_get_name_string(op_proc));

#else

    if_debug3m('!', imemory, "[!][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));

#endif

    code = do_call_operator(op_proc, i_ctx_p);

    if (code < 0)

        if_debug1m('!', imemory, "[!]   error: %d\n", code);

#if defined(SHOW_STACK_DEPTHS)

    if_debug2m('!', imemory, "[!][es=%d os=%d]\n",

            esp-i_ctx_p->exec_stack.stack.bot,

            osp-i_ctx_p->op_stack.stack.bot);

#endif

    if (gs_debug_c(gs_debug_flag_validate_clumps))

        ivalidate_clean_spaces(i_ctx_p);

    return code; /* A good place for a conditional breakpoint. */

}

#else

#  define call_operator(proc, p) ((*(proc))(p))

#endif

/* Define debugging statistics (not threadsafe as uses globals) */

/* #define COLLECT_STATS_IDSTACK */

#ifdef COLLECT_STATS_INTERP

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 */

static int estack_underflow(i_ctx_t *);

static int interp(i_ctx_t **, const ref *, ref *);

static int interp_exit(i_ctx_t *);

static int zforceinterp_exit(i_ctx_t *i_ctx_p);

static void set_gc_signal(i_ctx_t *, int);

static int copy_stack(i_ctx_t *, const ref_stack_t *, int skip, ref *);

static int oparray_pop(i_ctx_t *);

static int oparray_cleanup(i_ctx_t *);

static int zerrorexec(i_ctx_t *);

static int zfinderrorobject(i_ctx_t *);

static int errorexec_pop(i_ctx_t *);

static int errorexec_cleanup(i_ctx_t *);

static int zsetstackprotect(i_ctx_t *);

static int zcurrentstackprotect(i_ctx_t *);

static int zactonuel(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;

/*

 * NOTE: if the size of either table below ever exceeds 15 real entries, it

 * will have to be split.

 */

/* Define the extended-type operators per the list above. */

const op_def interp1_op_defs[] = {

    /*

     * The very first entry, which corresponds to operator index 0,

     * must not contain an actual operator.

     */

    op_def_begin_dict("systemdict"),

    {"2add", zadd},

    {"2def", zdef},

    {"1dup", zdup},

    {"2exch", zexch},

    {"2if", zif},

    {"3ifelse", zifelse},

    {"1index", zindex},

    {"1pop", zpop},

    {"2roll", zroll},

    {"2sub", zsub},

    op_def_end(0)

};

/* Define the internal interpreter operators. */

const op_def interp2_op_defs[] = {

    {"0.currentstackprotect", zcurrentstackprotect},

    {"1.setstackprotect", zsetstackprotect},

    {"2.errorexec", zerrorexec},

    {"0.finderrorobject", zfinderrorobject},

    {"0%interp_exit", interp_exit},

    {"0.forceinterp_exit", zforceinterp_exit},

    {"0%oparray_pop", oparray_pop},

    {"0%errorexec_pop", errorexec_pop},

    {"0.actonuel", zactonuel},

    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) {

            context_state_free(pcst);

            pcst = NULL;

        }

    }

    if (code < 0)

        lprintf1("Fatal error %d in gs_interp_init!\n", 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)

{

    int code;

    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)

    code = gs_alloc_ref_array(smem, &stk, 0,

                       REFS_SIZE_OSTACK + REFS_SIZE_ESTACK +

                       REFS_SIZE_DSTACK, "gs_interp_alloc_stacks");

    if (code < 0)

        return code;

    {

        ref_stack_t *pos = &pcst->op_stack.stack;

        r_set_size(&stk, REFS_SIZE_OSTACK);

        code = ref_stack_init(pos, &stk, OS_GUARD_UNDER, OS_GUARD_OVER, NULL,

                              smem, NULL);

  if (code < 0)

            return code;

        ref_stack_set_error_codes(pos, gs_error_stackunderflow, gs_error_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);

        code = ref_stack_init(pes, &stk, ES_GUARD_UNDER, ES_GUARD_OVER, &euop,

                       smem, NULL);

  if (code < 0)

            return code;

        ref_stack_set_error_codes(pes, gs_error_ExecStackUnderflow,

                                  gs_error_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);

        code = ref_stack_init(pds, &stk, 0, 0, NULL, smem, NULL);

        if (code < 0)

            return code;

        ref_stack_set_error_codes(pds, gs_error_dictstackunderflow,

                                  gs_error_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. */

static int

estack_underflow(i_ctx_t *i_ctx_p)

{

    return gs_error_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 != interp1_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.

 */

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, *r = &ctx_root;

    int code;

#ifdef DEBUG

    if (gs_debug_c(gs_debug_flag_gc_disable))

        return 0;

#endif

    gs_register_struct_root(imemory_system, &r,

                            (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, r, "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.

 */

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)

{

    i_ctx_t *i_ctx_p = *pi_ctx_p;

    gs_gc_root_t error_root, *r = &error_root;

    int code;

    gs_register_ref_root(imemory_system, &r,

                         (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 the lib context GC signal. */

    set_gc_signal(i_ctx_p, 0);

    return code;

}

static 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;

    i_ctx_t *i_ctx_p = *pi_ctx_p;

    int *gc_signal = &imemory_system->gs_lib_ctx->gcsignal;

    *pexit_code = 0;

    *gc_signal = 0;

    /* This avoids a valgrind error */

    doref.tas.type_attrs = error_name.tas.type_attrs = saref.tas.type_attrs = 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, *r = &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, &r,

                             (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);

    }

    /* 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. */

    *gc_signal = 0;

    set_gc_signal(i_ctx_p, 1);

    if (esp < esbot)            /* popped guard entry */

        esp = esbot;

    switch (code) {

        case gs_error_Fatal:

            *pexit_code = 255;

            return code;

        case gs_error_Quit:

            *perror_object = osp[-1];

            *pexit_code = code = osp->value.intval;

            osp -= 2;

            return

                (code == 0 ? gs_error_Quit :

                 code < 0 && code > -100 ? code : gs_error_Fatal);

        case gs_error_InterpreterExit:

            return 0;

        case gs_error_ExecStackUnderflow:

/****** WRONG -- must keep mark blocks intact ******/

            ref_stack_pop_block(&e_stack);

            doref = *perror_object;

            epref = &doref;

            goto again;

        case gs_error_VMreclaim:

            /* Do the GC and continue. */

            /* We ignore the return value here, if it fails here

             * we'll call it again having jumped to the "again" label.

             * Where, assuming it fails again, we'll handle the error.

             */

            (void)interp_reclaim(pi_ctx_p,

                                  (osp->value.intval == 2 ?

                                   avm_global : avm_local));

            i_ctx_p = *pi_ctx_p;

            make_oper(&doref, 0, zpop);

            epref = &doref;

            goto again;

        case gs_error_NeedInput:

        case gs_error_interrupt:

            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 gs_error_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 gs_error_dictstackunderflow:

            if (ref_stack_pop_block(&d_stack) >= 0) {

                dict_set_top();

                doref = *perror_object;

                epref = &doref;

                goto again;

            }

            break;

        case gs_error_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 (ep == NULL)

                            continue;

                        if (r_has_type_attrs(ep, t_null, a_executable)) {

                            skip = i + 1;

                            break;

                        }

                    }

                    pop_estack(i_ctx_p, skip);

                }

            }

            *++osp = saref;

            break;

        case gs_error_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 gs_error_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! */

    /*  We refer to gserrordict first, which is not accessible to Postcript jobs

     *  If we're running with SAFERERRORS all the handlers are copied to gserrordict

     *  so we'll always find the default one. If not SAFERERRORS, only gs specific

     *  errors are in gserrordict.

     */

    if ((dict_find_string(systemdict, "gserrordict", &perrordict) <= 0 ||

        !r_has_type(perrordict, t_dictionary)                          ||

        dict_find(perrordict, &error_name, &epref) <= 0)               &&

       (dict_find_string(systemdict, "errordict", &perrordict) <= 0    ||

        !r_has_type(perrordict, t_dictionary)                          ||

        dict_find(perrordict, &error_name, &epref) <= 0))

        return code;            /* error name not in errordict??? */

    if (code == gs_error_execstackoverflow

        && obj_eq(imemory, &doref, epref)) {

        /* This strongly suggests we're in an error handler that

           calls itself infinitely, so Postscript is done, return

           to the caller.

         */

         ref_stack_clear(&e_stack);

         *pexit_code = gs_error_execstackoverflow;

         return_error(gs_error_execstackoverflow);

    }

    if (!r_is_proc(epref)){

        *pexit_code = gs_error_Fatal;

        return_error(gs_error_Fatal);

    }

    doref = *epref;

    epref = &doref;

    /* Push the error object on the operand stack if appropriate. */

    if (!GS_ERROR_IS_INTERRUPT(code)) {

        byte buf[260], *bufptr;

        uint rlen;

        /* Replace the error object if within an oparray or .errorexec. */

        osp++;

        if (osp >= ostop) {

            *pexit_code = gs_error_Fatal;

            return_error(gs_error_Fatal);

        }

        *osp = *perror_object;

        errorexec_find(i_ctx_p, osp);

        if (!r_has_type(osp, t_string) && !r_has_type(osp, t_name)) {

            code = obj_cvs(imemory, osp, buf + 2, 256, &rlen, (const byte **)&bufptr);

            if (code < 0) {

                const char *unknownstr = "--unknown--";

                rlen = strlen(unknownstr);

                memcpy(buf, unknownstr, rlen);

                bufptr = buf;

            }

            else {

                ref *tobj;

                bufptr[rlen] = '\0';

                /* Only pass a name object if the operator doesn't exist in systemdict

                 * i.e. it's an internal operator we have hidden

                 */

                code = dict_find_string(systemdict, (const char *)bufptr, &tobj);

                if (code <= 0) {

                    buf[0] = buf[1] = buf[rlen + 2] = buf[rlen + 3] = '-';

                    rlen += 4;

                    bufptr = buf;

                }

                else {

                    bufptr = NULL;

                }

            }

            if (bufptr) {

                code = name_ref(imemory, buf, rlen, osp, 1);

                if (code < 0)

                    make_null(osp);

            }

        }

    }

    goto again;

}

static int

interp_exit(i_ctx_t *i_ctx_p)

{

    return gs_error_InterpreterExit;

}

/* Only used (currently) with language switching:

 * allows the PS interpreter to co-exist with the

 * PJL interpreter.

 */

static int

zforceinterp_exit(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    check_file(s, op);

    i_ctx_p->uel_position = stell(s)-1;

    /* resetfile */

    if (file_is_valid(s, op))

        sreset(s);

    if (!gs_lib_ctx_get_act_on_uel((gs_memory_t *)(i_ctx_p->memory.current)))

        return 0;

    gs_interp_reset(i_ctx_p);

    /* gs_interp_reset() actually leaves the op stack one entry below

     * the bottom of the stack, and that can cause problems depending

     * on the interpreter state at the end of the job.

     * So push a null object, and the return code before continuing.

     */

    push(2);

    op = osp;

    make_null(op - 1);

    make_int(op, gs_error_InterpreterExit);

    return_error(gs_error_Quit);

}

/* Set the GC signal for all VMs. */

static void

set_gc_signal(i_ctx_t *i_ctx_p, 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.signal_value = value;

            gs_memory_set_gc_status(mem, &stat);

            if (mem_stable == mem)

                break;

        }

    }

}

/* Create a printable string ref (or null) from an arbitrary ref.

 * For the purpose this is used here, it cannot fail, any

 * error in the process results in a null object, instead

 * of the string.

 */

static void obj_cvs_ref(i_ctx_t *i_ctx_p, const ref *in, ref *out)

{

    uint rlen;

    int code;

    byte sbuf[65], *buf = sbuf;

    uint len = sizeof(sbuf) - 1;

    code = obj_cvs(imemory, in, buf, len, &rlen, NULL);

    if (code == gs_error_rangecheck) {

        len = rlen;

        buf = gs_alloc_bytes(imemory, len + 1, "obj_cvs_ref");

        if (!buf)

            code = -1;

        else

            code = obj_cvs(imemory, in, buf, len, &rlen, NULL);

    }

    if (code < 0) {

        make_null(out);

    }

    else {

        buf[rlen] = '\0';

        code = string_to_ref((const char *)buf, out, iimemory, "obj_cvs_ref");

        if (code < 0)

            make_null(out);

    }

    if (buf != sbuf)

        gs_free_object(imemory, buf, "obj_cvs_ref");

    return;

}

/* Copy top elements of an overflowed stack into a (local) array. */

/* Adobe copies only 500 top elements, we copy up to 65535 top elements */

/* for better debugging, PLRM compliance, and backward compatibility. */

static int

copy_stack(i_ctx_t *i_ctx_p, const ref_stack_t * pstack, int skip, ref * arr)

{

    uint size = ref_stack_count(pstack) - skip;

    uint save_space = ialloc_space(idmemory);

    int code, i;

    ref *safety, *safe;

    if (size > 65535)

        size = 65535;

    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");

    /* If we are copying the exec stack, try to replace any oparrays with

     * the operator that references them

     * We also replace any internal objects (t_struct and t_astruct) with

     * string representations, since these can contain references to objects

     * with uncertain lifespans, it is safer not to risk them persisting.

     * Since we basically did this later on for the error handler, it isn't

     * a significant speed hit.

     */

    if (pstack == &e_stack) {

        for (i = 0; i < size; i++) {

            if (errorexec_find(i_ctx_p, &arr->value.refs[i]) < 0)

                make_null(&arr->value.refs[i]);

            else if (r_has_type(&arr->value.refs[i], t_struct)

                  || r_has_type(&arr->value.refs[i], t_astruct)) {

                ref r;

                obj_cvs_ref(i_ctx_p, (const ref *)&arr->value.refs[i], &r);

                ref_assign(&arr->value.refs[i], &r);

            }

        }

    }

    if (pstack == &o_stack && dict_find_string(systemdict, "SAFETY", &safety) > 0 &&

        dict_find_string(safety, "safe", &safe) > 0 && r_has_type(safe, t_boolean) &&

        safe->value.boolval == true) {

        code = ref_stack_array_sanitize(i_ctx_p, arr, arr, 0);

        if (code < 0)

            return code;

    }

    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(gs_error_undefined);      /* errordict or ErrorNames not found?! */

    return array_get(imemory, 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(gs_error_Fatal);

    return 0;

}

/* Main interpreter. */

/* If execution terminates normally, return gs_error_InterpreterExit. */

/* If an error occurs, leave the current object in *perror_object */

/* and return a (negative) error code. */

static int

interp(/* lgtm [cpp/use-of-goto] */

       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 */

    ref *pvalue;

    ref refnull;

    uint opindex;               /* needed for oparrays */

    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 = imemory->gs_lib_ctx->gs_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_stackoverflow(objp)\

  { o_stack.requested = 1; return_with_error(gs_error_stackoverflow, objp); }

#define return_with_stackoverflow_iref()\

  { o_stack.requested = 1; return_with_error_iref(gs_error_stackoverflow); }

/*

 * If control reaches the special operators (x_add, etc.) as a result of

 * interpreting an executable name, iref points to the name, not the