/*
 * Execute an outline defined by a PostScript procedure.
 * The top elements of the stack are:
 *      <font> <code|name> <name> <outline_id>
 */
int
zchar_exec_char_proc(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
        /*
         * The definition is a PostScript procedure.  Execute
         *      <code|name> proc
         * within a systemdict begin/end and a font begin/end.
         */
    es_ptr ep;

    check_estack(5);
    ep = esp += 5;
    make_op_estack(ep - 4, zend);
    make_op_estack(ep - 3, zend);
    ref_assign(ep - 2, op);
    make_op_estack(ep - 1, zbegin);
    make_op_estack(ep, zbegin);
    ref_assign(op - 1, systemdict);
    {
        ref rfont;

        ref_assign(&rfont, op - 3);
        ref_assign(op - 3, op - 2);
        ref_assign(op - 2, &rfont);
    }
    pop(1);
    return o_push_estack;
}

static int
zrunandhide(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    es_ptr ep;

    check_op(2);
    if (!r_is_array(op - 1))
        return_op_typecheck(op);
    if (!r_has_attr(op, a_executable))
        return 0;		/* literal object just gets pushed back */
    check_estack(5);
    ep = esp += 5;
    make_mark_estack(ep - 4, es_other, err_end_runandhide); /* error case */
    make_op_estack(ep - 1,  end_runandhide); /* normal case */
    ref_assign(ep, op);
    /* Store the object we are hiding  and it's current tas.type_attrs */
    /* on the exec stack then change to 'noaccess' */
    make_int(ep - 3, (int)op[-1].tas.type_attrs);
    ref_assign(ep - 2, op - 1);
    r_clear_attrs(ep - 2, a_all);
    /* replace the array with a special kind of mark that has a_read access */
    esfile_check_cache();
    pop(2);
    return o_push_estack;
}

static int
zcurrentfile(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    ref *fp;

    push(1);
    /* Check the cache first */
    if (esfile != 0) {
#ifdef DEBUG
        /* Check that esfile is valid. */
        ref *efp = zget_current_file(i_ctx_p);

        if (esfile != efp) {
            lprintf2("currentfile: esfile=0x%lx, efp=0x%lx\n",
                     (ulong) esfile, (ulong) efp);
            ref_assign(op, efp);
        } else
#endif
            ref_assign(op, esfile);
    } else if ((fp = zget_current_file(i_ctx_p)) == 0) {	/* Return an invalid file object. */
        /* This doesn't make a lot of sense to me, */
        /* but it's what the PostScript manual specifies. */
        make_invalid_file(i_ctx_p, op);
    } else {
        ref_assign(op, fp);
        esfile_set_cache(fp);
    }
    /* Make the returned value literal. */
    r_clear_attrs(op, a_executable);
    return 0;
}

/* <obj1> ... <objn> <n> .execn - */
static int
zexecn(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    uint n, i;
    es_ptr esp_orig;

    check_int_leu(*op, max_uint - 1);
    n = (uint) op->value.intval;
    check_op(n + 1);
    check_estack(n);
    esp_orig = esp;
    for (i = 0; i < n; ++i) {
        const ref *rp = ref_stack_index(&o_stack, (long)(i + 1));

        /* Make sure this object is legal to execute. */
        if (ref_type_uses_access(r_type(rp))) {
            if (!r_has_attr(rp, a_execute) &&
                r_has_attr(rp, a_executable)
                ) {
                esp = esp_orig;
                return_error(e_invalidaccess);
            }
        }
        /* Executable nulls have a special meaning on the e-stack, */
        /* so since they are no-ops, don't push them. */
        if (!r_has_type_attrs(rp, t_null, a_executable)) {
            ++esp;
            ref_assign(esp, rp);
        }
    }
    esfile_check_cache();
    pop(n + 1);
    return o_push_estack;
}

/* Continuation operator for enumerating files */
static int
file_continue(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    es_ptr pscratch = esp - 2;
    file_enum *pfen = r_ptr(esp - 1, file_enum);
    long devlen = esp[-3].value.intval;
    gx_io_device *iodev = r_ptr(esp - 4, gx_io_device);
    uint len = r_size(pscratch);
    uint code;

    if (len < devlen)
	return_error(e_rangecheck);	/* not even room for device len */
    memcpy((char *)pscratch->value.bytes, iodev->dname, devlen);
    code = iodev->procs.enumerate_next(pfen, (char *)pscratch->value.bytes + devlen,
    		len - devlen);
    if (code == ~(uint) 0) {	/* all done */
	esp -= 5;		/* pop proc, pfen, devlen, iodev , mark */
	return o_pop_estack;
    } else if (code > len)	/* overran string */
	return_error(e_rangecheck);
    else {
	push(1);
	ref_assign(op, pscratch);
	r_set_size(op, code + devlen);
	push_op_estack(file_continue);	/* come again */
	*++esp = pscratch[2];	/* proc */
	return o_push_estack;
    }
}

/*
 * We have collected all of the sample data.  Create a type 0 function stucture.
 */
static int
sampled_data_finish(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    gs_sampled_data_enum *penum = senum;
    /* Build a type 0 function using the given parameters */
    gs_function_Sd_params_t * params =
        (gs_function_Sd_params_t *)&penum->pfn->params;
    gs_function_t * pfn;
    ref cref;			/* closure */
    int code = gs_function_Sd_init(&pfn, params, imemory);

    if (code < 0)
        return code;

    code = ialloc_ref_array(&cref, a_executable | a_execute, 2,
                            "sampled_data_finish(cref)");
    if (code < 0)
        return code;

    make_istruct_new(cref.value.refs, a_executable | a_execute, pfn);
    make_oper_new(cref.value.refs + 1, 0, zexecfunction);
    ref_assign(op, &cref);

    esp -= estack_storage;
    ifree_object(penum->pfn, "sampled_data_finish(pfn)");
    ifree_object(penum, "sampled_data_finish(enum)");
    return o_pop_estack;
}

/* or if they are identical. */
void
packed_get(const gs_memory_t *mem, const ref_packed * packed, ref * pref)
{
    const ref_packed elt = *packed;
    uint value = elt & packed_value_mask;

    switch (elt >> r_packed_type_shift) {
	default:		/* (shouldn't happen) */
	    make_null(pref);
	    break;
	case pt_executable_operator:
	    op_index_ref(value, pref);
	    break;
	case pt_integer:
	    make_int(pref, (int)value + packed_min_intval);
	    break;
	case pt_literal_name:
	    name_index_ref(mem, value, pref);
	    break;
	case pt_executable_name:
	    name_index_ref(mem, value, pref);
	    r_set_attrs(pref, a_executable);
	    break;
	case pt_full_ref:
	case pt_full_ref + 1:
	    ref_assign(pref, (const ref *)packed);
    }
}

/* the error name vector, etc. */
int
array_get(const gs_memory_t *mem, const ref * aref, long index_long, ref * pref)
{
    if ((ulong)index_long >= r_size(aref))
	return_error(e_rangecheck);
    switch (r_type(aref)) {
	case t_array:
	    {
		const ref *pvalue = aref->value.refs + index_long;

		ref_assign(pref, pvalue);
	    }
	    break;
	case t_mixedarray:
	    {
		const ref_packed *packed = aref->value.packed;
		uint index = (uint)index_long;

		for (; index--;)
		    packed = packed_next(packed);
		packed_get(mem, packed, pref);
	    }
	    break;
	case t_shortarray:
	    {
		const ref_packed *packed = aref->value.packed + index_long;

		packed_get(mem, packed, pref);
	    }
	    break;
	default:
	    return_error(e_typecheck);
    }
    return 0;
}

/* - .wrapfont - */
static int
zwrapfont(i_ctx_t *i_ctx_p)
{
    gs_font *font = gs_currentfont(igs);
    gs_font_type0 *font0;
    int wmode = 0;
    int code;

    switch (font->FontType) {
    case ft_TrueType:
	code = gs_font_type0_from_type42(&font0, (gs_font_type42 *)font, wmode,
					 true, font->memory);
	if (code < 0)
	    return code;
	/*
	 * Patch up BuildChar and CIDMap.  This isn't necessary for
	 * TrueType fonts in general, only for Type 42 fonts whose
	 * BuildChar is implemented in PostScript code.
	 */
	{
	    font_data *pdata = pfont_data(font);
	    const char *bgstr = "%Type11BuildGlyph";
	    ref temp;

	    make_int(&temp, 0);
	    ref_assign(&pdata->u.type42.CIDMap, &temp);
	    code = name_ref((const byte *)bgstr, strlen(bgstr), &temp, 1);
	    if (code < 0)
		return code;
	    r_set_attrs(&temp, a_executable);
	    ref_assign(&pdata->BuildGlyph, &temp);
	}
	break;
    case ft_CID_encrypted:
    case ft_CID_user_defined:
    case ft_CID_TrueType:
	code = gs_font_type0_from_cidfont(&font0, font, wmode, NULL,
					  font->memory);
	break;
    default:
	return_error(e_rangecheck);
    }
    if (code < 0)
	return code;
    gs_setfont(igs, (gs_font *)font0);
    return 0;
}

/* <string> .libfile <string> false */
int                             /* exported for zsysvm.c */
zlibfile(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    int code;
    byte cname[DEFAULT_BUFFER_SIZE];
    uint clen;
    gs_parsed_file_name_t pname;
    stream *s;
    gx_io_device *iodev_dflt;

    check_ostack(2);
    code = parse_file_name(op, &pname, i_ctx_p->LockFilePermissions, imemory);
    if (code < 0)
        return code;
    iodev_dflt = iodev_default(imemory);
    if (pname.iodev == NULL)
        pname.iodev = iodev_dflt;
    if (pname.iodev != iodev_dflt) { /* Non-OS devices don't have search paths (yet). */
        code = zopen_file(i_ctx_p, &pname, "r", &s, imemory);
        if (code >= 0) {
            code = ssetfilename(s, op->value.const_bytes, r_size(op));
            if (code < 0) {
                sclose(s);
                return_error(e_VMerror);
            }
        }
        if (code < 0) {
            push(1);
            make_false(op);
            return 0;
        }
        make_stream_file(op, s, "r");
    } else {
        ref fref;

        code = lib_file_open(i_ctx_p->lib_path, imemory, i_ctx_p, pname.fname, pname.len,
                             (char *)cname, sizeof(cname), &clen, &fref);
        if (code >= 0) {
            s = fptr(&fref);
            code = ssetfilename(s, cname, clen);
            if (code < 0) {
                sclose(s);
                return_error(e_VMerror);
            }
        }
        if (code < 0) {
            if (code == e_VMerror || code == e_invalidfileaccess)
                return code;
            push(1);
            make_false(op);
            return 0;
        }
        ref_assign(op, &fref);
    }
    push(1);
    make_true(op);
    return 0;
}

/* The caller guarantees that *op is a dictionary. */
int
build_gs_primitive_font(i_ctx_t *i_ctx_p, os_ptr op, gs_font_base ** ppfont,
                        font_type ftype, gs_memory_type_ptr_t pstype,
                        const build_proc_refs * pbuild,
                        build_font_options_t options)
{
    ref *pcharstrings = 0;
    ref CharStrings;
    gs_font_base *pfont;
    font_data *pdata;
    int code;

    if (dict_find_string(op, "CharStrings", &pcharstrings) <= 0) {
        if (!(options & bf_CharStrings_optional))
            return_error(e_invalidfont);
    } else {
        ref *ignore;

        if (!r_has_type(pcharstrings, t_dictionary))
            return_error(e_invalidfont);
        if ((options & bf_notdef_required) != 0 &&
            dict_find_string(pcharstrings, ".notdef", &ignore) <= 0
            )
            return_error(e_invalidfont);
        /*
         * Since build_gs_simple_font may resize the dictionary and cause
         * pointers to become invalid, save CharStrings.
         */
        CharStrings = *pcharstrings;
    }
    code = build_gs_outline_font(i_ctx_p, op, ppfont, ftype, pstype, pbuild,
                                 options, build_gs_simple_font);
    if (code != 0)
        return code;
    pfont = *ppfont;
    pdata = pfont_data(pfont);
    if (pcharstrings)
        ref_assign(&pdata->CharStrings, &CharStrings);
    else
        make_null(&pdata->CharStrings);
    /* Check that the UniqueIDs match.  This is part of the */
    /* Adobe protection scheme, but we may as well emulate it. */
    if (uid_is_valid(&pfont->UID) &&
        !dict_check_uid_param(op, &pfont->UID)
        )
        uid_set_invalid(&pfont->UID);
    if (uid_is_valid(&pfont->UID)) {
        const gs_font *pfont0 = (const gs_font *)pfont;

        code = gs_font_find_similar(ifont_dir, &pfont0,
                       font_with_same_UID_and_another_metrics);
        if (code < 0)
            return code; /* Must not happen. */
        if (code)
            uid_set_invalid(&pfont->UID);
    }
    return 0;
}

/* Continuation operator for loop */
static int
loop_continue(i_ctx_t *i_ctx_p)
{
    register es_ptr ep = esp;	/* saved proc */

    ref_assign(ep + 2, ep);
    esp = ep + 2;
    return o_push_estack;
}

/* <bool> <proc_true> <proc_false> ifelse - */
int
zifelse(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;

    check_proc(*op);
    check_proc(op[-1]);
    check_type(op[-2], t_boolean);
    check_estack(1);
    ++esp;
    if (op[-2].value.boolval) {
        ref_assign(esp, op - 1);
    } else {
        ref_assign(esp, op);
    }
    esfile_check_cache();
    pop(3);
    return o_push_estack;
}

/* Make a transformed font (common code for makefont/scalefont). */
static int
make_font(i_ctx_t *i_ctx_p, const gs_matrix * pmat)
{
    os_ptr op = osp;
    os_ptr fp = op - 1;
    gs_font *oldfont, *newfont;
    int code;
    ref *pencoding = 0;

    code = font_param(fp, &oldfont);
    if (code < 0)
        return code;
    {
        uint space = ialloc_space(idmemory);

        ialloc_set_space(idmemory, r_space(fp));
        if (dict_find_string(fp, "Encoding", &pencoding) > 0 &&
            !r_is_array(pencoding)
            )
            code = gs_note_error(e_invalidfont);
        else {
                /*
                 * Temporarily substitute the new dictionary
                 * for the old one, in case the Encoding changed.
                 */
            ref olddict;

            olddict = *pfont_dict(oldfont);
            *pfont_dict(oldfont) = *fp;
            code = gs_makefont(ifont_dir, oldfont, pmat, &newfont);
            *pfont_dict(oldfont) = olddict;
        }
        ialloc_set_space(idmemory, space);
    }
    if (code < 0)
        return code;
    /*
     * We have to allow for the possibility that the font's Encoding
     * is different from that of the base font.  Note that the
     * font_data of the new font was simply copied from the old one.
     */
    if (pencoding != 0 &&
        !obj_eq(imemory, pencoding, &pfont_data(newfont)->Encoding)
        ) {
        if (newfont->FontType == ft_composite)
            return_error(e_rangecheck);
        /* We should really do validity checking here.... */
        ref_assign(&pfont_data(newfont)->Encoding, pencoding);
        lookup_gs_simple_font_encoding((gs_font_base *) newfont);
    }
    *fp = *pfont_dict(newfont);
    pop(1);
    return 0;
}

int
zfor(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    register es_ptr ep;
    int code;
    float params[3];

        /* Mostly undocumented, and somewhat bizarre Adobe behavior discovered	*/
        /* with the CET (28-05) and FTS (124-01) is that the proc is not run	*/
        /* if BOTH the initial value and increment are zero.			*/
    if ((code = float_params(op - 1, 3, params)) < 0)
        return code;
    if ( params[0] == 0.0 && params[1] == 0.0 ) {
        pop(4);		/* don't run the proc */
        return 0;
    }
    check_estack(7);
    ep = esp + 6;
    check_proc(*op);
    /* Push a mark, the control variable set to the initial value, */
    /* the increment, the limit, and the procedure, */
    /* and invoke the continuation operator. */
    if (r_has_type(op - 3, t_integer) &&
        r_has_type(op - 2, t_integer)
        ) {
        make_int(ep - 4, op[-3].value.intval);
        make_int(ep - 3, op[-2].value.intval);
        switch (r_type(op - 1)) {
            case t_integer:
                make_int(ep - 2, op[-1].value.intval);
                break;
            case t_real:
                make_int(ep - 2, (long)op[-1].value.realval);
                break;
            default:
                return_op_typecheck(op - 1);
        }
        if (ep[-3].value.intval >= 0)
            make_op_estack(ep, for_pos_int_continue);
        else
            make_op_estack(ep, for_neg_int_continue);
    } else {
        make_real(ep - 4, params[0]);
        make_real(ep - 3, params[1]);
        make_real(ep - 2, params[2]);
        make_op_estack(ep, for_real_continue);
    }
    make_mark_estack(ep - 5, es_for, no_cleanup);
    ref_assign(ep - 1, op);
    esp = ep;
    pop(4);
    return o_push_estack;
}

static int
runandhide_restore_hidden(i_ctx_t *i_ctx_p, ref *obj, ref *attrs)
{
    os_ptr op = osp;

    push(1);
    /* restore the hidden_object and its type_attrs */
    ref_assign(op, obj);
    r_clear_attrs(op, a_all);
    r_set_attrs(op, attrs->value.intval);
    return 0;
}

/* Continuation operator for reals. */
static int
for_real_continue(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    es_ptr ep = esp;
    float var = ep[-3].value.realval;
    float incr = ep[-2].value.realval;

    if (incr >= 0 ? (var > ep[-1].value.realval) :
        (var < ep[-1].value.realval)
        ) {
        esp -= 5;		/* pop everything */
        return o_pop_estack;
    }
    push(1);
    ref_assign(op, ep - 3);
    ep[-3].value.realval = var + incr;
    esp = ep + 2;
    ref_assign(ep + 2, ep);	/* saved proc */
    return o_push_estack;
}

/* <array> aload <obj_0> ... <obj_n-1> <array> */
static int
zaload(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    ref aref;
    uint asize;

    ref_assign(&aref, op);
    if (!r_is_array(&aref))
        return_op_typecheck(op);
    check_read(aref);
    asize = r_size(&aref);
    if (asize > ostop - op) {	/* Use the slow, general algorithm. */
        int code = ref_stack_push(&o_stack, asize);
        uint i;
        const ref_packed *packed = aref.value.packed;

        if (code < 0)
            return code;
        for (i = asize; i > 0; i--, packed = packed_next(packed))
            packed_get(imemory, packed, ref_stack_index(&o_stack, i));
        *osp = aref;
        return 0;
    }
    if (r_has_type(&aref, t_array))
        memcpy(op, aref.value.refs, asize * sizeof(ref));
    else {
        uint i;
        const ref_packed *packed = aref.value.packed;
        os_ptr pdest = op;

        for (i = 0; i < asize; i++, pdest++, packed = packed_next(packed))
            packed_get(imemory, packed, pdest);
    }
    push(asize);
    ref_assign(op, &aref);
    return 0;
}

/* Continuation operator for repeat */
static int
repeat_continue(i_ctx_t *i_ctx_p)
{
    es_ptr ep = esp;		/* saved proc */

    if (--(ep[-1].value.intval) >= 0) {		/* continue */
        esp += 2;
        ref_assign(esp, ep);
        return o_push_estack;
    } else {			/* done */
        esp -= 3;		/* pop mark, count, proc */
        return o_pop_estack;
    }
}

/* <str1> <str2> .min <str> */
static int
zmin(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    int code = obj_le(op - 1, op);

    if (code < 0)
	return code;
    if (!code) {
	ref_assign(op - 1, op);
    }
    pop(1);
    return 0;
}