xref: /plan9-contrib/sys/src/cmd/gs/src/zgeneric.c (revision 593dc095aefb2a85c828727bbfa9da139a49bdf4)
13ff48bf5SDavid du Colombier /* Copyright (C) 1989, 2000 Aladdin Enterprises.  All rights reserved.
27dd7cddfSDavid du Colombier 
3*593dc095SDavid du Colombier   This software is provided AS-IS with no warranty, either express or
4*593dc095SDavid du Colombier   implied.
57dd7cddfSDavid du Colombier 
6*593dc095SDavid du Colombier   This software is distributed under license and may not be copied,
7*593dc095SDavid du Colombier   modified or distributed except as expressly authorized under the terms
8*593dc095SDavid du Colombier   of the license contained in the file LICENSE in this distribution.
97dd7cddfSDavid du Colombier 
10*593dc095SDavid du Colombier   For more information about licensing, please refer to
11*593dc095SDavid du Colombier   http://www.ghostscript.com/licensing/. For information on
12*593dc095SDavid du Colombier   commercial licensing, go to http://www.artifex.com/licensing/ or
13*593dc095SDavid du Colombier   contact Artifex Software, Inc., 101 Lucas Valley Road #110,
14*593dc095SDavid du Colombier   San Rafael, CA  94903, U.S.A., +1(415)492-9861.
157dd7cddfSDavid du Colombier */
167dd7cddfSDavid du Colombier 
17*593dc095SDavid du Colombier /* $Id: zgeneric.c,v 1.8 2004/08/04 19:36:13 stefan Exp $ */
187dd7cddfSDavid du Colombier /* Array/string/dictionary generic operators for PostScript */
197dd7cddfSDavid du Colombier #include "memory_.h"
207dd7cddfSDavid du Colombier #include "ghost.h"
217dd7cddfSDavid du Colombier #include "gsstruct.h"		/* for st_bytes */
227dd7cddfSDavid du Colombier #include "oper.h"
233ff48bf5SDavid du Colombier #include "dstack.h"		/* for systemdict */
247dd7cddfSDavid du Colombier #include "estack.h"		/* for forall */
257dd7cddfSDavid du Colombier #include "iddict.h"
267dd7cddfSDavid du Colombier #include "iname.h"
277dd7cddfSDavid du Colombier #include "ipacked.h"
287dd7cddfSDavid du Colombier #include "ivmspace.h"
297dd7cddfSDavid du Colombier #include "store.h"
307dd7cddfSDavid du Colombier 
317dd7cddfSDavid du Colombier /* This file implements copy, get, put, getinterval, putinterval, */
327dd7cddfSDavid du Colombier /* length, and forall, which apply generically to */
337dd7cddfSDavid du Colombier /* arrays, strings, and dictionaries.  (Copy also has a special */
347dd7cddfSDavid du Colombier /* meaning for copying the top N elements of the stack.) */
357dd7cddfSDavid du Colombier 
367dd7cddfSDavid du Colombier /* See the comment in opdef.h for an invariant which allows */
377dd7cddfSDavid du Colombier /* more efficient implementation of forall. */
387dd7cddfSDavid du Colombier 
397dd7cddfSDavid du Colombier /* Forward references */
40*593dc095SDavid du Colombier private int zcopy_integer(i_ctx_t *);
41*593dc095SDavid du Colombier private int zcopy_interval(i_ctx_t *);
42*593dc095SDavid du Colombier private int copy_interval(i_ctx_t *, os_ptr, uint, os_ptr, client_name_t);
437dd7cddfSDavid du Colombier 
447dd7cddfSDavid du Colombier /* <various1> <various2> copy <various> */
457dd7cddfSDavid du Colombier /* <obj1> ... <objn> <int> copy <obj1> ... <objn> <obj1> ... <objn> */
467dd7cddfSDavid du Colombier /* Note that this implements copy for arrays and strings, */
477dd7cddfSDavid du Colombier /* but not for dictionaries (see zcopy_dict in zdict.c). */
487dd7cddfSDavid du Colombier int
zcopy(i_ctx_t * i_ctx_p)497dd7cddfSDavid du Colombier zcopy(i_ctx_t *i_ctx_p)
507dd7cddfSDavid du Colombier {
517dd7cddfSDavid du Colombier     os_ptr op = osp;
527dd7cddfSDavid du Colombier     int type = r_type(op);
537dd7cddfSDavid du Colombier 
547dd7cddfSDavid du Colombier     if (type == t_integer)
557dd7cddfSDavid du Colombier 	return zcopy_integer(i_ctx_p);
567dd7cddfSDavid du Colombier     check_op(2);
577dd7cddfSDavid du Colombier     switch (type) {
587dd7cddfSDavid du Colombier 	case t_array:
597dd7cddfSDavid du Colombier 	case t_string:
607dd7cddfSDavid du Colombier 	    return zcopy_interval(i_ctx_p);
617dd7cddfSDavid du Colombier 	case t_dictionary:
627dd7cddfSDavid du Colombier 	    return zcopy_dict(i_ctx_p);
637dd7cddfSDavid du Colombier 	default:
647dd7cddfSDavid du Colombier 	    return_op_typecheck(op);
657dd7cddfSDavid du Colombier     }
667dd7cddfSDavid du Colombier }
677dd7cddfSDavid du Colombier 
687dd7cddfSDavid du Colombier /* <obj1> ... <objn> <int> copy <obj1> ... <objn> <obj1> ... <objn> */
697dd7cddfSDavid du Colombier private int
zcopy_integer(i_ctx_t * i_ctx_p)707dd7cddfSDavid du Colombier zcopy_integer(i_ctx_t *i_ctx_p)
717dd7cddfSDavid du Colombier {
727dd7cddfSDavid du Colombier     os_ptr op = osp;
737dd7cddfSDavid du Colombier     os_ptr op1 = op - 1;
747dd7cddfSDavid du Colombier     int count, i;
757dd7cddfSDavid du Colombier     int code;
767dd7cddfSDavid du Colombier 
777dd7cddfSDavid du Colombier     if ((ulong) op->value.intval > op - osbot) {
787dd7cddfSDavid du Colombier 	/* There might be enough elements in other blocks. */
797dd7cddfSDavid du Colombier 	check_int_ltu(*op, ref_stack_count(&o_stack));
807dd7cddfSDavid du Colombier 	count = op->value.intval;
817dd7cddfSDavid du Colombier     } else if (op1 + (count = op->value.intval) <= ostop) {
827dd7cddfSDavid du Colombier 	/* Fast case. */
837dd7cddfSDavid du Colombier 	memcpy((char *)op, (char *)(op - count), count * sizeof(ref));
847dd7cddfSDavid du Colombier 	push(count - 1);
857dd7cddfSDavid du Colombier 	return 0;
867dd7cddfSDavid du Colombier     }
877dd7cddfSDavid du Colombier     /* Do it the slow, general way. */
887dd7cddfSDavid du Colombier     code = ref_stack_push(&o_stack, count - 1);
897dd7cddfSDavid du Colombier     if (code < 0)
907dd7cddfSDavid du Colombier 	return code;
917dd7cddfSDavid du Colombier     for (i = 0; i < count; i++)
927dd7cddfSDavid du Colombier 	*ref_stack_index(&o_stack, i) =
937dd7cddfSDavid du Colombier 	    *ref_stack_index(&o_stack, i + count);
947dd7cddfSDavid du Colombier     return 0;
957dd7cddfSDavid du Colombier }
967dd7cddfSDavid du Colombier 
977dd7cddfSDavid du Colombier /* <array1> <array2> copy <subarray2> */
987dd7cddfSDavid du Colombier /* <string1> <string2> copy <substring2> */
997dd7cddfSDavid du Colombier private int
zcopy_interval(i_ctx_t * i_ctx_p)1007dd7cddfSDavid du Colombier zcopy_interval(i_ctx_t *i_ctx_p)
1017dd7cddfSDavid du Colombier {
1027dd7cddfSDavid du Colombier     os_ptr op = osp;
1037dd7cddfSDavid du Colombier     os_ptr op1 = op - 1;
1047dd7cddfSDavid du Colombier     int code = copy_interval(i_ctx_p, op, 0, op1, "copy");
1057dd7cddfSDavid du Colombier 
1067dd7cddfSDavid du Colombier     if (code < 0)
1077dd7cddfSDavid du Colombier 	return code;
1087dd7cddfSDavid du Colombier     r_set_size(op, r_size(op1));
1097dd7cddfSDavid du Colombier     *op1 = *op;
1107dd7cddfSDavid du Colombier     pop(1);
1117dd7cddfSDavid du Colombier     return 0;
1127dd7cddfSDavid du Colombier }
1137dd7cddfSDavid du Colombier 
1147dd7cddfSDavid du Colombier /* <array|dict|name|packedarray|string> length <int> */
1157dd7cddfSDavid du Colombier private int
zlength(i_ctx_t * i_ctx_p)1167dd7cddfSDavid du Colombier zlength(i_ctx_t *i_ctx_p)
1177dd7cddfSDavid du Colombier {
1187dd7cddfSDavid du Colombier     os_ptr op = osp;
1197dd7cddfSDavid du Colombier     switch (r_type(op)) {
1207dd7cddfSDavid du Colombier 	case t_array:
1217dd7cddfSDavid du Colombier 	case t_string:
1227dd7cddfSDavid du Colombier 	case t_mixedarray:
1237dd7cddfSDavid du Colombier 	case t_shortarray:
1247dd7cddfSDavid du Colombier 	    check_read(*op);
1257dd7cddfSDavid du Colombier 	    make_int(op, r_size(op));
1267dd7cddfSDavid du Colombier 	    return 0;
1277dd7cddfSDavid du Colombier 	case t_dictionary:
1287dd7cddfSDavid du Colombier 	    check_dict_read(*op);
1297dd7cddfSDavid du Colombier 	    make_int(op, dict_length(op));
1307dd7cddfSDavid du Colombier 	    return 0;
1317dd7cddfSDavid du Colombier 	case t_name: {
1327dd7cddfSDavid du Colombier 	    ref str;
1337dd7cddfSDavid du Colombier 
134*593dc095SDavid du Colombier 	    name_string_ref(imemory, op, &str);
1357dd7cddfSDavid du Colombier 	    make_int(op, r_size(&str));
1367dd7cddfSDavid du Colombier 	    return 0;
1377dd7cddfSDavid du Colombier 	}
1387dd7cddfSDavid du Colombier 	case t_astruct:
1397dd7cddfSDavid du Colombier 	    if (gs_object_type(imemory, op->value.pstruct) != &st_bytes)
1407dd7cddfSDavid du Colombier 		return_error(e_typecheck);
1417dd7cddfSDavid du Colombier 	    check_read(*op);
1427dd7cddfSDavid du Colombier 	    make_int(op, gs_object_size(imemory, op->value.pstruct));
1437dd7cddfSDavid du Colombier 	    return 0;
1447dd7cddfSDavid du Colombier 	default:
1457dd7cddfSDavid du Colombier 	    return_op_typecheck(op);
1467dd7cddfSDavid du Colombier     }
1477dd7cddfSDavid du Colombier }
1487dd7cddfSDavid du Colombier 
1497dd7cddfSDavid du Colombier /* <array|packedarray|string> <index> get <obj> */
1507dd7cddfSDavid du Colombier /* <dict> <key> get <obj> */
1517dd7cddfSDavid du Colombier private int
zget(i_ctx_t * i_ctx_p)1527dd7cddfSDavid du Colombier zget(i_ctx_t *i_ctx_p)
1537dd7cddfSDavid du Colombier {
1547dd7cddfSDavid du Colombier     os_ptr op = osp;
1557dd7cddfSDavid du Colombier     os_ptr op1 = op - 1;
1567dd7cddfSDavid du Colombier     ref *pvalue;
1577dd7cddfSDavid du Colombier 
1587dd7cddfSDavid du Colombier     switch (r_type(op1)) {
1597dd7cddfSDavid du Colombier 	case t_dictionary:
1607dd7cddfSDavid du Colombier 	    check_dict_read(*op1);
1617dd7cddfSDavid du Colombier 	    if (dict_find(op1, op, &pvalue) <= 0)
1627dd7cddfSDavid du Colombier 		return_error(e_undefined);
1637dd7cddfSDavid du Colombier 	    op[-1] = *pvalue;
1647dd7cddfSDavid du Colombier 	    break;
1657dd7cddfSDavid du Colombier 	case t_string:
1667dd7cddfSDavid du Colombier 	    check_read(*op1);
1677dd7cddfSDavid du Colombier 	    check_int_ltu(*op, r_size(op1));
1687dd7cddfSDavid du Colombier 	    make_int(op1, op1->value.bytes[(uint) op->value.intval]);
1697dd7cddfSDavid du Colombier 	    break;
1707dd7cddfSDavid du Colombier 	default: {
1717dd7cddfSDavid du Colombier 	    int code;
1727dd7cddfSDavid du Colombier 
1737dd7cddfSDavid du Colombier 	    check_type(*op, t_integer);
1747dd7cddfSDavid du Colombier 	    check_read(*op1);
175*593dc095SDavid du Colombier 	    code = array_get(imemory, op1, op->value.intval, op1);
1767dd7cddfSDavid du Colombier 	    if (code < 0) {	/* Might be a stackunderflow reported as typecheck. */
1777dd7cddfSDavid du Colombier 		if (code == e_typecheck)
1787dd7cddfSDavid du Colombier 		    return_op_typecheck(op1);
1797dd7cddfSDavid du Colombier 		else
1807dd7cddfSDavid du Colombier 		    return code;
1817dd7cddfSDavid du Colombier 	    }
1827dd7cddfSDavid du Colombier 	}
1837dd7cddfSDavid du Colombier     }
1847dd7cddfSDavid du Colombier     pop(1);
1857dd7cddfSDavid du Colombier     return 0;
1867dd7cddfSDavid du Colombier }
1877dd7cddfSDavid du Colombier 
1887dd7cddfSDavid du Colombier /* <array> <index> <obj> put - */
1897dd7cddfSDavid du Colombier /* <dict> <key> <value> put - */
1907dd7cddfSDavid du Colombier /* <string> <index> <int> put - */
1917dd7cddfSDavid du Colombier private int
zput(i_ctx_t * i_ctx_p)1927dd7cddfSDavid du Colombier zput(i_ctx_t *i_ctx_p)
1937dd7cddfSDavid du Colombier {
1947dd7cddfSDavid du Colombier     os_ptr op = osp;
1957dd7cddfSDavid du Colombier     os_ptr op1 = op - 1;
1967dd7cddfSDavid du Colombier     os_ptr op2 = op1 - 1;
1977dd7cddfSDavid du Colombier     byte *sdata;
1987dd7cddfSDavid du Colombier     uint ssize;
1997dd7cddfSDavid du Colombier 
2007dd7cddfSDavid du Colombier     switch (r_type(op2)) {
2017dd7cddfSDavid du Colombier 	case t_dictionary:
202*593dc095SDavid du Colombier 	    if (i_ctx_p->in_superexec == 0)
2037dd7cddfSDavid du Colombier 	    check_dict_write(*op2);
2047dd7cddfSDavid du Colombier 	    {
2057dd7cddfSDavid du Colombier 		int code = idict_put(op2, op1, op);
2067dd7cddfSDavid du Colombier 
2077dd7cddfSDavid du Colombier 		if (code < 0)
2087dd7cddfSDavid du Colombier 		    return code;	/* error */
2097dd7cddfSDavid du Colombier 	    }
2107dd7cddfSDavid du Colombier 	    break;
2117dd7cddfSDavid du Colombier 	case t_array:
2127dd7cddfSDavid du Colombier 	    check_write(*op2);
2137dd7cddfSDavid du Colombier 	    check_int_ltu(*op1, r_size(op2));
2147dd7cddfSDavid du Colombier 	    store_check_dest(op2, op);
2157dd7cddfSDavid du Colombier 	    {
2167dd7cddfSDavid du Colombier 		ref *eltp = op2->value.refs + (uint) op1->value.intval;
2177dd7cddfSDavid du Colombier 
2187dd7cddfSDavid du Colombier 		ref_assign_old(op2, eltp, op, "put");
2197dd7cddfSDavid du Colombier 	    }
2207dd7cddfSDavid du Colombier 	    break;
2217dd7cddfSDavid du Colombier 	case t_mixedarray:	/* packed arrays are read-only */
2227dd7cddfSDavid du Colombier 	case t_shortarray:
2237dd7cddfSDavid du Colombier 	    return_error(e_invalidaccess);
2247dd7cddfSDavid du Colombier 	case t_string:
2257dd7cddfSDavid du Colombier 	    sdata = op2->value.bytes;
2267dd7cddfSDavid du Colombier 	    ssize = r_size(op2);
2277dd7cddfSDavid du Colombier str:	    check_write(*op2);
2287dd7cddfSDavid du Colombier 	    check_int_ltu(*op1, ssize);
2297dd7cddfSDavid du Colombier 	    check_int_leu(*op, 0xff);
2307dd7cddfSDavid du Colombier 	    sdata[(uint)op1->value.intval] = (byte)op->value.intval;
2317dd7cddfSDavid du Colombier 	    break;
2327dd7cddfSDavid du Colombier 	case t_astruct:
2337dd7cddfSDavid du Colombier 	    if (gs_object_type(imemory, op2->value.pstruct) != &st_bytes)
2347dd7cddfSDavid du Colombier 		return_error(e_typecheck);
2357dd7cddfSDavid du Colombier 	    sdata = r_ptr(op2, byte);
2367dd7cddfSDavid du Colombier 	    ssize = gs_object_size(imemory, op2->value.pstruct);
2377dd7cddfSDavid du Colombier 	    goto str;
2387dd7cddfSDavid du Colombier 	default:
2397dd7cddfSDavid du Colombier 	    return_op_typecheck(op2);
2407dd7cddfSDavid du Colombier     }
2417dd7cddfSDavid du Colombier     pop(3);
2427dd7cddfSDavid du Colombier     return 0;
2437dd7cddfSDavid du Colombier }
2447dd7cddfSDavid du Colombier 
2453ff48bf5SDavid du Colombier /* <array> <index> <obj> .forceput - */
2463ff48bf5SDavid du Colombier /* <dict> <key> <value> .forceput - */
2473ff48bf5SDavid du Colombier /*
2483ff48bf5SDavid du Colombier  * This forces a "put" even if the object is not writable, and (if the
2493ff48bf5SDavid du Colombier  * object is systemdict or the save level is 0) even if the value is in
2503ff48bf5SDavid du Colombier  * local VM.  It is meant to be used only for replacing the value of
2513ff48bf5SDavid du Colombier  * FontDirectory in systemdict when switching between local and global VM,
2523ff48bf5SDavid du Colombier  * and a few similar applications.  After initialization, this operator
2533ff48bf5SDavid du Colombier  * should no longer be accessible by name.
2543ff48bf5SDavid du Colombier  */
2553ff48bf5SDavid du Colombier private int
zforceput(i_ctx_t * i_ctx_p)2563ff48bf5SDavid du Colombier zforceput(i_ctx_t *i_ctx_p)
2573ff48bf5SDavid du Colombier {
2583ff48bf5SDavid du Colombier     os_ptr op = osp;
2593ff48bf5SDavid du Colombier     os_ptr op1 = op - 1;
2603ff48bf5SDavid du Colombier     os_ptr op2 = op - 2;
2613ff48bf5SDavid du Colombier     int code;
2623ff48bf5SDavid du Colombier 
2633ff48bf5SDavid du Colombier     switch (r_type(op2)) {
2643ff48bf5SDavid du Colombier     case t_array:
2653ff48bf5SDavid du Colombier 	check_int_ltu(*op1, r_size(op2));
2663ff48bf5SDavid du Colombier 	if (r_space(op2) > r_space(op)) {
2673ff48bf5SDavid du Colombier 	    if (imemory_save_level(iimemory))
2683ff48bf5SDavid du Colombier 		return_error(e_invalidaccess);
2693ff48bf5SDavid du Colombier 	}
2703ff48bf5SDavid du Colombier 	{
2713ff48bf5SDavid du Colombier 	    ref *eltp = op2->value.refs + (uint) op1->value.intval;
2723ff48bf5SDavid du Colombier 
2733ff48bf5SDavid du Colombier 	    ref_assign_old(op2, eltp, op, "put");
2743ff48bf5SDavid du Colombier 	}
2753ff48bf5SDavid du Colombier 	break;
2763ff48bf5SDavid du Colombier     case t_dictionary:
2773ff48bf5SDavid du Colombier 	if (op2->value.pdict == systemdict->value.pdict ||
2783ff48bf5SDavid du Colombier 	    !imemory_save_level(iimemory)
2793ff48bf5SDavid du Colombier 	    ) {
2803ff48bf5SDavid du Colombier 	    uint space = r_space(op2);
2813ff48bf5SDavid du Colombier 
2823ff48bf5SDavid du Colombier 	    r_set_space(op2, avm_local);
2833ff48bf5SDavid du Colombier 	    code = idict_put(op2, op1, op);
2843ff48bf5SDavid du Colombier 	    r_set_space(op2, space);
2853ff48bf5SDavid du Colombier 	} else
2863ff48bf5SDavid du Colombier 	    code = idict_put(op2, op1, op);
2873ff48bf5SDavid du Colombier 	if (code < 0)
2883ff48bf5SDavid du Colombier 	    return code;
2893ff48bf5SDavid du Colombier 	break;
2903ff48bf5SDavid du Colombier     default:
2913ff48bf5SDavid du Colombier 	return_error(e_typecheck);
2923ff48bf5SDavid du Colombier     }
2933ff48bf5SDavid du Colombier     pop(3);
2943ff48bf5SDavid du Colombier     return 0;
2953ff48bf5SDavid du Colombier }
2963ff48bf5SDavid du Colombier 
2977dd7cddfSDavid du Colombier /* <seq:array|packedarray|string> <index> <count> getinterval <subseq> */
2987dd7cddfSDavid du Colombier private int
zgetinterval(i_ctx_t * i_ctx_p)2997dd7cddfSDavid du Colombier zgetinterval(i_ctx_t *i_ctx_p)
3007dd7cddfSDavid du Colombier {
3017dd7cddfSDavid du Colombier     os_ptr op = osp;
3027dd7cddfSDavid du Colombier     os_ptr op1 = op - 1;
3037dd7cddfSDavid du Colombier     os_ptr op2 = op1 - 1;
3047dd7cddfSDavid du Colombier     uint index;
3057dd7cddfSDavid du Colombier     uint count;
3067dd7cddfSDavid du Colombier 
3077dd7cddfSDavid du Colombier     switch (r_type(op2)) {
3087dd7cddfSDavid du Colombier 	default:
3097dd7cddfSDavid du Colombier 	    return_op_typecheck(op2);
3107dd7cddfSDavid du Colombier 	case t_array:
3117dd7cddfSDavid du Colombier 	case t_string:
3127dd7cddfSDavid du Colombier 	case t_mixedarray:
3137dd7cddfSDavid du Colombier 	case t_shortarray:;
3147dd7cddfSDavid du Colombier     }
3157dd7cddfSDavid du Colombier     check_read(*op2);
3167dd7cddfSDavid du Colombier     check_int_leu(*op1, r_size(op2));
3177dd7cddfSDavid du Colombier     index = op1->value.intval;
3187dd7cddfSDavid du Colombier     check_int_leu(*op, r_size(op2) - index);
3197dd7cddfSDavid du Colombier     count = op->value.intval;
3207dd7cddfSDavid du Colombier     switch (r_type(op2)) {
3217dd7cddfSDavid du Colombier 	case t_array:
3227dd7cddfSDavid du Colombier 	    op2->value.refs += index;
3237dd7cddfSDavid du Colombier 	    break;
3247dd7cddfSDavid du Colombier 	case t_string:
3257dd7cddfSDavid du Colombier 	    op2->value.bytes += index;
3267dd7cddfSDavid du Colombier 	    break;
3277dd7cddfSDavid du Colombier 	case t_mixedarray: {
3287dd7cddfSDavid du Colombier 	    const ref_packed *packed = op2->value.packed;
3297dd7cddfSDavid du Colombier 
3307dd7cddfSDavid du Colombier 	    for (; index--;)
3317dd7cddfSDavid du Colombier 		packed = packed_next(packed);
3327dd7cddfSDavid du Colombier 	    op2->value.packed = packed;
3337dd7cddfSDavid du Colombier 	    break;
3347dd7cddfSDavid du Colombier 	}
3357dd7cddfSDavid du Colombier 	case t_shortarray:
3367dd7cddfSDavid du Colombier 	    op2->value.packed += index;
3377dd7cddfSDavid du Colombier 	    break;
3387dd7cddfSDavid du Colombier     }
3397dd7cddfSDavid du Colombier     r_set_size(op2, count);
3407dd7cddfSDavid du Colombier     pop(2);
3417dd7cddfSDavid du Colombier     return 0;
3427dd7cddfSDavid du Colombier }
3437dd7cddfSDavid du Colombier 
3447dd7cddfSDavid du Colombier /* <array1> <index> <array2|packedarray2> putinterval - */
3457dd7cddfSDavid du Colombier /* <string1> <index> <string2> putinterval - */
3467dd7cddfSDavid du Colombier /* <bytestring1> <index> <string2> putinterval - */
3477dd7cddfSDavid du Colombier private int
zputinterval(i_ctx_t * i_ctx_p)3487dd7cddfSDavid du Colombier zputinterval(i_ctx_t *i_ctx_p)
3497dd7cddfSDavid du Colombier {
3507dd7cddfSDavid du Colombier     os_ptr op = osp;
3517dd7cddfSDavid du Colombier     os_ptr opindex = op - 1;
3527dd7cddfSDavid du Colombier     os_ptr opto = opindex - 1;
3537dd7cddfSDavid du Colombier     int code;
3547dd7cddfSDavid du Colombier 
3557dd7cddfSDavid du Colombier     switch (r_type(opto)) {
3567dd7cddfSDavid du Colombier 	default:
3577dd7cddfSDavid du Colombier 	    return_op_typecheck(opto);
3587dd7cddfSDavid du Colombier 	case t_mixedarray:
3597dd7cddfSDavid du Colombier 	case t_shortarray:
3607dd7cddfSDavid du Colombier 	    return_error(e_invalidaccess);
3617dd7cddfSDavid du Colombier 	case t_array:
3627dd7cddfSDavid du Colombier 	case t_string:
3637dd7cddfSDavid du Colombier 	    check_write(*opto);
3647dd7cddfSDavid du Colombier 	    check_int_leu(*opindex, r_size(opto));
3657dd7cddfSDavid du Colombier 	    code = copy_interval(i_ctx_p, opto, (uint)(opindex->value.intval),
3667dd7cddfSDavid du Colombier 				 op, "putinterval");
3677dd7cddfSDavid du Colombier 	    break;
3687dd7cddfSDavid du Colombier 	case t_astruct: {
3697dd7cddfSDavid du Colombier 	    uint dsize, ssize, index;
3707dd7cddfSDavid du Colombier 
3717dd7cddfSDavid du Colombier 	    check_write(*opto);
3727dd7cddfSDavid du Colombier 	    if (gs_object_type(imemory, opto->value.pstruct) != &st_bytes)
3737dd7cddfSDavid du Colombier 		return_error(e_typecheck);
3747dd7cddfSDavid du Colombier 	    dsize = gs_object_size(imemory, opto->value.pstruct);
3757dd7cddfSDavid du Colombier 	    check_int_leu(*opindex, dsize);
3767dd7cddfSDavid du Colombier 	    index = (uint)opindex->value.intval;
3777dd7cddfSDavid du Colombier 	    check_read_type(*op, t_string);
3787dd7cddfSDavid du Colombier 	    ssize = r_size(op);
3797dd7cddfSDavid du Colombier 	    if (ssize > dsize - index)
3807dd7cddfSDavid du Colombier 		return_error(e_rangecheck);
3817dd7cddfSDavid du Colombier 	    memcpy(r_ptr(opto, byte) + index, op->value.const_bytes, ssize);
3827dd7cddfSDavid du Colombier 	    code = 0;
3837dd7cddfSDavid du Colombier 	    break;
3847dd7cddfSDavid du Colombier 	}
3857dd7cddfSDavid du Colombier     }
3867dd7cddfSDavid du Colombier     if (code >= 0)
3877dd7cddfSDavid du Colombier 	pop(3);
3887dd7cddfSDavid du Colombier     return code;
3897dd7cddfSDavid du Colombier }
3907dd7cddfSDavid du Colombier 
3917dd7cddfSDavid du Colombier /* <array|packedarray|string> <<element> proc> forall - */
3927dd7cddfSDavid du Colombier /* <dict> <<key> <value> proc> forall - */
3937dd7cddfSDavid du Colombier private int
394*593dc095SDavid du Colombier     array_continue(i_ctx_t *),
395*593dc095SDavid du Colombier     dict_continue(i_ctx_t *),
396*593dc095SDavid du Colombier     string_continue(i_ctx_t *),
397*593dc095SDavid du Colombier     packedarray_continue(i_ctx_t *);
398*593dc095SDavid du Colombier private int forall_cleanup(i_ctx_t *);
3997dd7cddfSDavid du Colombier private int
zforall(i_ctx_t * i_ctx_p)4007dd7cddfSDavid du Colombier zforall(i_ctx_t *i_ctx_p)
4017dd7cddfSDavid du Colombier {
4027dd7cddfSDavid du Colombier     os_ptr op = osp;
4037dd7cddfSDavid du Colombier     os_ptr obj = op - 1;
4047dd7cddfSDavid du Colombier     es_ptr ep = esp;
4057dd7cddfSDavid du Colombier     es_ptr cproc = ep + 4;
4067dd7cddfSDavid du Colombier 
4077dd7cddfSDavid du Colombier     check_estack(6);
4087dd7cddfSDavid du Colombier     switch (r_type(obj)) {
4097dd7cddfSDavid du Colombier 	default:
4107dd7cddfSDavid du Colombier 	    return_op_typecheck(obj);
4117dd7cddfSDavid du Colombier 	case t_array:
4127dd7cddfSDavid du Colombier 	    check_read(*obj);
4137dd7cddfSDavid du Colombier 	    make_op_estack(cproc, array_continue);
4147dd7cddfSDavid du Colombier 	    break;
4157dd7cddfSDavid du Colombier 	case t_dictionary:
4167dd7cddfSDavid du Colombier 	    check_dict_read(*obj);
4177dd7cddfSDavid du Colombier 	    make_int(cproc, dict_first(obj));
4187dd7cddfSDavid du Colombier 	    ++cproc;
4197dd7cddfSDavid du Colombier 	    make_op_estack(cproc, dict_continue);
4207dd7cddfSDavid du Colombier 	    break;
4217dd7cddfSDavid du Colombier 	case t_string:
4227dd7cddfSDavid du Colombier 	    check_read(*obj);
4237dd7cddfSDavid du Colombier 	    make_op_estack(cproc, string_continue);
4247dd7cddfSDavid du Colombier 	    break;
4257dd7cddfSDavid du Colombier 	case t_mixedarray:
4267dd7cddfSDavid du Colombier 	case t_shortarray:
4277dd7cddfSDavid du Colombier 	    check_read(*obj);
4287dd7cddfSDavid du Colombier 	    make_op_estack(cproc, packedarray_continue);
4297dd7cddfSDavid du Colombier 	    break;
4307dd7cddfSDavid du Colombier     }
4317dd7cddfSDavid du Colombier     check_proc(*op);
4327dd7cddfSDavid du Colombier     /*
4337dd7cddfSDavid du Colombier      * Push:
4347dd7cddfSDavid du Colombier      *   - a mark;
4357dd7cddfSDavid du Colombier      *   - the composite object;
4367dd7cddfSDavid du Colombier      *   - the procedure;
4377dd7cddfSDavid du Colombier      *   - the iteration index (only for dictionaries, done above);
4387dd7cddfSDavid du Colombier      * and invoke the continuation operator.
4397dd7cddfSDavid du Colombier      */
4407dd7cddfSDavid du Colombier     make_mark_estack(ep + 1, es_for, forall_cleanup);
4417dd7cddfSDavid du Colombier     ep[2] = *obj;
4427dd7cddfSDavid du Colombier     ep[3] = *op;
4437dd7cddfSDavid du Colombier     esp = cproc - 1;
4447dd7cddfSDavid du Colombier     pop(2);
4457dd7cddfSDavid du Colombier     return (*real_opproc(cproc))(i_ctx_p);
4467dd7cddfSDavid du Colombier }
4477dd7cddfSDavid du Colombier /* Continuation operator for arrays */
4487dd7cddfSDavid du Colombier private int
array_continue(i_ctx_t * i_ctx_p)4497dd7cddfSDavid du Colombier array_continue(i_ctx_t *i_ctx_p)
4507dd7cddfSDavid du Colombier {
4517dd7cddfSDavid du Colombier     os_ptr op = osp;
4527dd7cddfSDavid du Colombier     es_ptr obj = esp - 1;
4537dd7cddfSDavid du Colombier 
4547dd7cddfSDavid du Colombier     if (r_size(obj)) {		/* continue */
4557dd7cddfSDavid du Colombier 	push(1);
4567dd7cddfSDavid du Colombier 	r_dec_size(obj, 1);
4577dd7cddfSDavid du Colombier 	*op = *obj->value.refs;
4587dd7cddfSDavid du Colombier 	obj->value.refs++;
4597dd7cddfSDavid du Colombier 	esp += 2;
4607dd7cddfSDavid du Colombier 	*esp = obj[1];
4617dd7cddfSDavid du Colombier 	return o_push_estack;
4627dd7cddfSDavid du Colombier     } else {			/* done */
4637dd7cddfSDavid du Colombier 	esp -= 3;		/* pop mark, object, proc */
4647dd7cddfSDavid du Colombier 	return o_pop_estack;
4657dd7cddfSDavid du Colombier     }
4667dd7cddfSDavid du Colombier }
4677dd7cddfSDavid du Colombier /* Continuation operator for dictionaries */
4687dd7cddfSDavid du Colombier private int
dict_continue(i_ctx_t * i_ctx_p)4697dd7cddfSDavid du Colombier dict_continue(i_ctx_t *i_ctx_p)
4707dd7cddfSDavid du Colombier {
4717dd7cddfSDavid du Colombier     os_ptr op = osp;
4727dd7cddfSDavid du Colombier     es_ptr obj = esp - 2;
4737dd7cddfSDavid du Colombier     int index = (int)esp->value.intval;
4747dd7cddfSDavid du Colombier 
4757dd7cddfSDavid du Colombier     push(2);			/* make room for key and value */
4767dd7cddfSDavid du Colombier     if ((index = dict_next(obj, index, op - 1)) >= 0) {	/* continue */
4777dd7cddfSDavid du Colombier 	esp->value.intval = index;
4787dd7cddfSDavid du Colombier 	esp += 2;
4797dd7cddfSDavid du Colombier 	*esp = obj[1];
4807dd7cddfSDavid du Colombier 	return o_push_estack;
4817dd7cddfSDavid du Colombier     } else {			/* done */
4827dd7cddfSDavid du Colombier 	pop(2);			/* undo push */
4837dd7cddfSDavid du Colombier 	esp -= 4;		/* pop mark, object, proc, index */
4847dd7cddfSDavid du Colombier 	return o_pop_estack;
4857dd7cddfSDavid du Colombier     }
4867dd7cddfSDavid du Colombier }
4877dd7cddfSDavid du Colombier /* Continuation operator for strings */
4887dd7cddfSDavid du Colombier private int
string_continue(i_ctx_t * i_ctx_p)4897dd7cddfSDavid du Colombier string_continue(i_ctx_t *i_ctx_p)
4907dd7cddfSDavid du Colombier {
4917dd7cddfSDavid du Colombier     os_ptr op = osp;
4927dd7cddfSDavid du Colombier     es_ptr obj = esp - 1;
4937dd7cddfSDavid du Colombier 
4947dd7cddfSDavid du Colombier     if (r_size(obj)) {		/* continue */
4957dd7cddfSDavid du Colombier 	r_dec_size(obj, 1);
4967dd7cddfSDavid du Colombier 	push(1);
4977dd7cddfSDavid du Colombier 	make_int(op, *obj->value.bytes);
4987dd7cddfSDavid du Colombier 	obj->value.bytes++;
4997dd7cddfSDavid du Colombier 	esp += 2;
5007dd7cddfSDavid du Colombier 	*esp = obj[1];
5017dd7cddfSDavid du Colombier 	return o_push_estack;
5027dd7cddfSDavid du Colombier     } else {			/* done */
5037dd7cddfSDavid du Colombier 	esp -= 3;		/* pop mark, object, proc */
5047dd7cddfSDavid du Colombier 	return o_pop_estack;
5057dd7cddfSDavid du Colombier     }
5067dd7cddfSDavid du Colombier }
5077dd7cddfSDavid du Colombier /* Continuation operator for packed arrays */
5087dd7cddfSDavid du Colombier private int
packedarray_continue(i_ctx_t * i_ctx_p)5097dd7cddfSDavid du Colombier packedarray_continue(i_ctx_t *i_ctx_p)
5107dd7cddfSDavid du Colombier {
5117dd7cddfSDavid du Colombier     os_ptr op = osp;
5127dd7cddfSDavid du Colombier     es_ptr obj = esp - 1;
5137dd7cddfSDavid du Colombier 
5147dd7cddfSDavid du Colombier     if (r_size(obj)) {		/* continue */
5157dd7cddfSDavid du Colombier 	const ref_packed *packed = obj->value.packed;
5167dd7cddfSDavid du Colombier 
5177dd7cddfSDavid du Colombier 	r_dec_size(obj, 1);
5187dd7cddfSDavid du Colombier 	push(1);
519*593dc095SDavid du Colombier 	packed_get(imemory, packed, op);
5207dd7cddfSDavid du Colombier 	obj->value.packed = packed_next(packed);
5217dd7cddfSDavid du Colombier 	esp += 2;
5227dd7cddfSDavid du Colombier 	*esp = obj[1];
5237dd7cddfSDavid du Colombier 	return o_push_estack;
5247dd7cddfSDavid du Colombier     } else {			/* done */
5257dd7cddfSDavid du Colombier 	esp -= 3;		/* pop mark, object, proc */
5267dd7cddfSDavid du Colombier 	return o_pop_estack;
5277dd7cddfSDavid du Colombier     }
5287dd7cddfSDavid du Colombier }
5297dd7cddfSDavid du Colombier /* Vacuous cleanup procedure */
5307dd7cddfSDavid du Colombier private int
forall_cleanup(i_ctx_t * i_ctx_p)5317dd7cddfSDavid du Colombier forall_cleanup(i_ctx_t *i_ctx_p)
5327dd7cddfSDavid du Colombier {
5337dd7cddfSDavid du Colombier     return 0;
5347dd7cddfSDavid du Colombier }
5357dd7cddfSDavid du Colombier 
5367dd7cddfSDavid du Colombier /* ------ Initialization procedure ------ */
5377dd7cddfSDavid du Colombier 
5387dd7cddfSDavid du Colombier const op_def zgeneric_op_defs[] =
5397dd7cddfSDavid du Colombier {
5407dd7cddfSDavid du Colombier     {"1copy", zcopy},
5417dd7cddfSDavid du Colombier     {"2forall", zforall},
5423ff48bf5SDavid du Colombier     {"3.forceput", zforceput},
5437dd7cddfSDavid du Colombier     {"2get", zget},
5447dd7cddfSDavid du Colombier     {"3getinterval", zgetinterval},
5457dd7cddfSDavid du Colombier     {"1length", zlength},
5467dd7cddfSDavid du Colombier     {"3put", zput},
5477dd7cddfSDavid du Colombier     {"3putinterval", zputinterval},
5487dd7cddfSDavid du Colombier 		/* Internal operators */
5497dd7cddfSDavid du Colombier     {"0%array_continue", array_continue},
5507dd7cddfSDavid du Colombier     {"0%dict_continue", dict_continue},
5517dd7cddfSDavid du Colombier     {"0%packedarray_continue", packedarray_continue},
5527dd7cddfSDavid du Colombier     {"0%string_continue", string_continue},
5537dd7cddfSDavid du Colombier     op_def_end(0)
5547dd7cddfSDavid du Colombier };
5557dd7cddfSDavid du Colombier 
5567dd7cddfSDavid du Colombier /* ------ Shared routines ------ */
5577dd7cddfSDavid du Colombier 
5587dd7cddfSDavid du Colombier /* Copy an interval from one operand to another. */
5597dd7cddfSDavid du Colombier /* This is used by both putinterval and string/array copy. */
5607dd7cddfSDavid du Colombier /* The destination is known to be an array or string, */
5617dd7cddfSDavid du Colombier /* and the starting index is known to be less than or equal to */
5627dd7cddfSDavid du Colombier /* its length; nothing else has been checked. */
5637dd7cddfSDavid du Colombier private int
copy_interval(i_ctx_t * i_ctx_p,os_ptr prto,uint index,os_ptr prfrom,client_name_t cname)5647dd7cddfSDavid du Colombier copy_interval(i_ctx_t *i_ctx_p /* for ref_assign_old */, os_ptr prto,
5657dd7cddfSDavid du Colombier 	      uint index, os_ptr prfrom, client_name_t cname)
5667dd7cddfSDavid du Colombier {
5677dd7cddfSDavid du Colombier     int fromtype = r_type(prfrom);
5687dd7cddfSDavid du Colombier     uint fromsize = r_size(prfrom);
5697dd7cddfSDavid du Colombier 
5707dd7cddfSDavid du Colombier     if (!(fromtype == r_type(prto) ||
5717dd7cddfSDavid du Colombier 	  ((fromtype == t_shortarray || fromtype == t_mixedarray) &&
5727dd7cddfSDavid du Colombier 	   r_type(prto) == t_array))
5737dd7cddfSDavid du Colombier 	)
5747dd7cddfSDavid du Colombier 	return_op_typecheck(prfrom);
5757dd7cddfSDavid du Colombier     check_read(*prfrom);
5767dd7cddfSDavid du Colombier     check_write(*prto);
5777dd7cddfSDavid du Colombier     if (fromsize > r_size(prto) - index)
5787dd7cddfSDavid du Colombier 	return_error(e_rangecheck);
5797dd7cddfSDavid du Colombier     switch (fromtype) {
5807dd7cddfSDavid du Colombier 	case t_array:
5817dd7cddfSDavid du Colombier 	    {			/* We have to worry about aliasing, */
5827dd7cddfSDavid du Colombier 		/* but refcpy_to_old takes care of it for us. */
5837dd7cddfSDavid du Colombier 		return refcpy_to_old(prto, index, prfrom->value.refs,
5847dd7cddfSDavid du Colombier 				     fromsize, idmemory, cname);
5857dd7cddfSDavid du Colombier 	    }
5867dd7cddfSDavid du Colombier 	case t_string:
5877dd7cddfSDavid du Colombier 	    {	/* memmove takes care of aliasing. */
5887dd7cddfSDavid du Colombier 		memmove(prto->value.bytes + index, prfrom->value.bytes,
5897dd7cddfSDavid du Colombier 			fromsize);
5907dd7cddfSDavid du Colombier 	    }
5917dd7cddfSDavid du Colombier 	    break;
5927dd7cddfSDavid du Colombier 	case t_mixedarray:
5937dd7cddfSDavid du Colombier 	case t_shortarray:
5947dd7cddfSDavid du Colombier 	    {	/* We don't have to worry about aliasing, because */
5957dd7cddfSDavid du Colombier 		/* packed arrays are read-only and hence the destination */
5967dd7cddfSDavid du Colombier 		/* can't be a packed array. */
5977dd7cddfSDavid du Colombier 		int i;
5987dd7cddfSDavid du Colombier 		const ref_packed *packed = prfrom->value.packed;
5997dd7cddfSDavid du Colombier 		ref *pdest = prto->value.refs + index;
6007dd7cddfSDavid du Colombier 		ref elt;
6017dd7cddfSDavid du Colombier 
6027dd7cddfSDavid du Colombier 		for (i = 0; i < fromsize; i++, pdest++) {
603*593dc095SDavid du Colombier 		    packed_get(imemory, packed, &elt);
6047dd7cddfSDavid du Colombier 		    ref_assign_old(prto, pdest, &elt, cname);
6057dd7cddfSDavid du Colombier 		    packed = packed_next(packed);
6067dd7cddfSDavid du Colombier 		}
6077dd7cddfSDavid du Colombier 	    }
6087dd7cddfSDavid du Colombier 	    break;
6097dd7cddfSDavid du Colombier     }
6107dd7cddfSDavid du Colombier     return 0;
6117dd7cddfSDavid du Colombier }
612