1 /* Copyright (C) 1990, 1992, 1993, 1999 artofcode LLC. All rights reserved.
2
3 This program is free software; you can redistribute it and/or modify it
4 under the terms of the GNU General Public License as published by the
5 Free Software Foundation; either version 2 of the License, or (at your
6 option) any later version.
7
8 This program is distributed in the hope that it will be useful, but
9 WITHOUT ANY WARRANTY; without even the implied warranty of
10 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 General Public License for more details.
12
13 You should have received a copy of the GNU General Public License along
14 with this program; if not, write to the Free Software Foundation, Inc.,
15 59 Temple Place, Suite 330, Boston, MA, 02111-1307.
16
17 */
18
19 /*$Id: zpacked.c,v 1.2.6.1.2.1 2003/01/17 00:49:06 giles Exp $ */
20 /* Packed array operators */
21 #include "ghost.h"
22 #include "ialloc.h"
23 #include "idict.h"
24 #include "iname.h"
25 #include "istack.h" /* for iparray.h */
26 #include "ipacked.h"
27 #include "iparray.h"
28 #include "ivmspace.h"
29 #include "oper.h"
30 #include "store.h"
31
32 /* - currentpacking <bool> */
33 private int
zcurrentpacking(i_ctx_t * i_ctx_p)34 zcurrentpacking(i_ctx_t *i_ctx_p)
35 {
36 os_ptr op = osp;
37
38 push(1);
39 ref_assign(op, &ref_array_packing);
40 return 0;
41 }
42
43 /* <obj_0> ... <obj_n-1> <n> packedarray <packedarray> */
44 int
zpackedarray(i_ctx_t * i_ctx_p)45 zpackedarray(i_ctx_t *i_ctx_p)
46 {
47 os_ptr op = osp;
48 int code;
49 ref parr;
50
51 check_type(*op, t_integer);
52 if (op->value.intval < 0 ||
53 (op->value.intval > op - osbot &&
54 op->value.intval >= ref_stack_count(&o_stack))
55 )
56 return_error(e_rangecheck);
57 osp--;
58 code = make_packed_array(&parr, &o_stack, (uint) op->value.intval,
59 idmemory, "packedarray");
60 osp++;
61 if (code >= 0)
62 *osp = parr;
63 return code;
64 }
65
66 /* <bool> setpacking - */
67 private int
zsetpacking(i_ctx_t * i_ctx_p)68 zsetpacking(i_ctx_t *i_ctx_p)
69 {
70 os_ptr op = osp;
71 ref cont;
72
73 check_type(*op, t_boolean);
74 make_struct(&cont, avm_local, ref_array_packing_container);
75 ref_assign_old(&cont, &ref_array_packing, op, "setpacking");
76 pop(1);
77 return 0;
78 }
79
80 /* ------ Non-operator routines ------ */
81
82 /* Make a packed array. See the comment in packed.h about */
83 /* ensuring that refs in mixed arrays are properly aligned. */
84 #undef idmemory /****** NOTA BENE ******/
85 int
make_packed_array(ref * parr,ref_stack_t * pstack,uint size,gs_dual_memory_t * idmemory,client_name_t cname)86 make_packed_array(ref * parr, ref_stack_t * pstack, uint size,
87 gs_dual_memory_t *idmemory, client_name_t cname)
88 {
89 uint i;
90 const ref *pref;
91 uint idest = 0, ishort = 0;
92 ref_packed *pbody;
93 ref_packed *pdest;
94 ref_packed *pshort; /* points to start of */
95 /* last run of short elements */
96 gs_ref_memory_t *imem = idmemory->current;
97 uint space = imemory_space(imem);
98 int skip = 0, pad;
99 ref rtemp;
100 int code;
101
102 /* Do a first pass to calculate the size of the array, */
103 /* and to detect local-into-global stores. */
104
105 for (i = size; i != 0; i--) {
106 pref = ref_stack_index(pstack, i - 1);
107 switch (r_btype(pref)) { /* not r_type, opers are special */
108 case t_name:
109 if (name_index(pref) >= packed_name_max_index)
110 break; /* can't pack */
111 idest++;
112 continue;
113 case t_integer:
114 if (pref->value.intval < packed_min_intval ||
115 pref->value.intval > packed_max_intval
116 )
117 break;
118 idest++;
119 continue;
120 case t_oparray:
121 /* Check for local-into-global store. */
122 store_check_space(space, pref);
123 /* falls through */
124 case t_operator:
125 {
126 uint oidx;
127
128 if (!r_has_attr(pref, a_executable))
129 break;
130 oidx = op_index(pref);
131 if (oidx == 0 || oidx > packed_int_mask)
132 break;
133 }
134 idest++;
135 continue;
136 default:
137 /* Check for local-into-global store. */
138 store_check_space(space, pref);
139 }
140 /* Can't pack this element, use a full ref. */
141 /* We may have to unpack up to align_packed_per_ref - 1 */
142 /* preceding short elements. */
143 /* If we are at the beginning of the array, however, */
144 /* we can just move the elements up. */
145 {
146 int i = (idest - ishort) & (align_packed_per_ref - 1);
147
148 if (ishort == 0) /* first time */
149 idest += skip = -i & (align_packed_per_ref - 1);
150 else
151 idest += (packed_per_ref - 1) * i;
152 }
153 ishort = idest += packed_per_ref;
154 }
155 pad = -idest & (packed_per_ref - 1); /* padding at end */
156
157 /* Now we can allocate the array. */
158
159 code = gs_alloc_ref_array(imem, &rtemp, 0, (idest + pad) / packed_per_ref,
160 cname);
161 if (code < 0)
162 return code;
163 pbody = (ref_packed *) rtemp.value.refs;
164
165 /* Make sure any initial skipped elements contain legal packed */
166 /* refs, so that the garbage collector can scan storage. */
167
168 pshort = pbody;
169 for (; skip; skip--)
170 *pbody++ = pt_tag(pt_integer);
171 pdest = pbody;
172
173 for (i = size; i != 0; i--) {
174 pref = ref_stack_index(pstack, i - 1);
175 switch (r_btype(pref)) { /* not r_type, opers are special */
176 case t_name:
177 {
178 uint nidx = name_index(pref);
179
180 if (nidx >= packed_name_max_index)
181 break; /* can't pack */
182 *pdest++ = nidx +
183 (r_has_attr(pref, a_executable) ?
184 pt_tag(pt_executable_name) :
185 pt_tag(pt_literal_name));
186 }
187 continue;
188 case t_integer:
189 if (pref->value.intval < packed_min_intval ||
190 pref->value.intval > packed_max_intval
191 )
192 break;
193 *pdest++ = pt_tag(pt_integer) +
194 ((short)pref->value.intval - packed_min_intval);
195 continue;
196 case t_oparray:
197 case t_operator:
198 {
199 uint oidx;
200
201 if (!r_has_attr(pref, a_executable))
202 break;
203 oidx = op_index(pref);
204 if (oidx == 0 || oidx > packed_int_mask)
205 break;
206 *pdest++ = pt_tag(pt_executable_operator) + oidx;
207 }
208 continue;
209 }
210 /* Can't pack this element, use a full ref. */
211 /* We may have to unpack up to align_packed_per_ref - 1 */
212 /* preceding short elements. */
213 /* Note that if we are at the beginning of the array, */
214 /* 'skip' already ensures that we don't need to do this. */
215 {
216 int i = (pdest - pshort) & (align_packed_per_ref - 1);
217 const ref_packed *psrc = pdest;
218 ref *pmove =
219 (ref *) (pdest += (packed_per_ref - 1) * i);
220
221 ref_assign_new(pmove, pref);
222 while (--i >= 0) {
223 --psrc;
224 --pmove;
225 packed_get(psrc, pmove);
226 }
227 }
228 pshort = pdest += packed_per_ref;
229 }
230
231 {
232 int atype =
233 (pdest == pbody + size ? t_shortarray : t_mixedarray);
234
235 /* Pad with legal packed refs so that the garbage collector */
236 /* can scan storage. */
237
238 for (; pad; pad--)
239 *pdest++ = pt_tag(pt_integer);
240
241 /* Finally, make the array. */
242
243 ref_stack_pop(pstack, size);
244 make_tasv_new(parr, atype, a_readonly | space, size,
245 packed, pbody + skip);
246 }
247 return 0;
248 }
249
250 /* ------ Initialization procedure ------ */
251
252 const op_def zpacked_op_defs[] =
253 {
254 {"0currentpacking", zcurrentpacking},
255 {"1packedarray", zpackedarray},
256 {"1setpacking", zsetpacking},
257 op_def_end(0)
258 };
259