1 /* Copyright (C) 1989, 2000 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: zdict.c,v 1.3.6.1.2.1 2003/01/17 00:49:05 giles Exp $ */
20 /* Dictionary operators */
21 #include "ghost.h"
22 #include "oper.h"
23 #include "iddict.h"
24 #include "dstack.h"
25 #include "ilevel.h" /* for [count]dictstack */
26 #include "iname.h" /* for dict_find_name */
27 #include "ipacked.h" /* for inline dict lookup */
28 #include "ivmspace.h"
29 #include "store.h"
30
31 /* <int> dict <dict> */
32 int
zdict(i_ctx_t * i_ctx_p)33 zdict(i_ctx_t *i_ctx_p)
34 {
35 os_ptr op = osp;
36
37 check_type(*op, t_integer);
38 if (op->value.intval < 0)
39 return_error(e_rangecheck);
40
41 return dict_create((uint) op->value.intval, op);
42 }
43
44 /* <dict> maxlength <int> */
45 private int
zmaxlength(i_ctx_t * i_ctx_p)46 zmaxlength(i_ctx_t *i_ctx_p)
47 {
48 os_ptr op = osp;
49
50 check_type(*op, t_dictionary);
51 check_dict_read(*op);
52 make_int(op, dict_maxlength(op));
53 return 0;
54 }
55
56 /* <dict> begin - */
57 int
zbegin(i_ctx_t * i_ctx_p)58 zbegin(i_ctx_t *i_ctx_p)
59 {
60 os_ptr op = osp;
61
62 check_type(*op, t_dictionary);
63 check_dict_read(*op);
64 if (dsp == dstop)
65 return_error(e_dictstackoverflow);
66 ++dsp;
67 ref_assign(dsp, op);
68 dict_set_top();
69 pop(1);
70 return 0;
71 }
72
73 /* - end - */
74 int
zend(i_ctx_t * i_ctx_p)75 zend(i_ctx_t *i_ctx_p)
76 {
77 if (ref_stack_count_inline(&d_stack) == min_dstack_size) {
78 /* We would underflow the d-stack. */
79 return_error(e_dictstackunderflow);
80 }
81 while (dsp == dsbot) {
82 /* We would underflow the current block. */
83 ref_stack_pop_block(&d_stack);
84 }
85 dsp--;
86 dict_set_top();
87 return 0;
88 }
89
90 /* <key> <value> def - */
91 /*
92 * We make this into a separate procedure because
93 * the interpreter will almost always call it directly.
94 */
95 int
zop_def(i_ctx_t * i_ctx_p)96 zop_def(i_ctx_t *i_ctx_p)
97 {
98 os_ptr op = osp;
99 os_ptr op1 = op - 1;
100 ref *pvslot;
101
102 /* The following combines a check_op(2) with a type check. */
103 switch (r_type(op1)) {
104 case t_name: {
105 /* We can use the fast single-probe lookup here. */
106 uint nidx = name_index(op1);
107 uint htemp;
108
109 if_dict_find_name_by_index_top(nidx, htemp, pvslot) {
110 if (dtop_can_store(op))
111 goto ra;
112 }
113 break; /* handle all slower cases */
114 }
115 case t_null:
116 return_error(e_typecheck);
117 case t__invalid:
118 return_error(e_stackunderflow);
119 }
120 /*
121 * Combine the check for a writable top dictionary with
122 * the global/local store check. See dstack.h for details.
123 */
124 if (!dtop_can_store(op)) {
125 check_dict_write(*dsp);
126 /*
127 * If the dictionary is writable, the problem must be
128 * an invalid store.
129 */
130 return_error(e_invalidaccess);
131 }
132 /*
133 * Save a level of procedure call in the common (redefinition)
134 * case. With the current interfaces, we pay a double lookup
135 * in the uncommon case.
136 */
137 if (dict_find(dsp, op1, &pvslot) <= 0)
138 return idict_put(dsp, op1, op);
139 ra:
140 ref_assign_old_inline(&dsp->value.pdict->values, pvslot, op,
141 "dict_put(value)");
142 return 0;
143 }
144 int
zdef(i_ctx_t * i_ctx_p)145 zdef(i_ctx_t *i_ctx_p)
146 {
147 int code = zop_def(i_ctx_p);
148
149 if (code >= 0) {
150 pop(2);
151 }
152 return code;
153 }
154
155 /* <key> load <value> */
156 private int
zload(i_ctx_t * i_ctx_p)157 zload(i_ctx_t *i_ctx_p)
158 {
159 os_ptr op = osp;
160 ref *pvalue;
161
162 switch (r_type(op)) {
163 case t_name:
164 /* Use the fast lookup. */
165 if ((pvalue = dict_find_name(op)) == 0)
166 return_error(e_undefined);
167 ref_assign(op, pvalue);
168 return 0;
169 case t_null:
170 return_error(e_typecheck);
171 case t__invalid:
172 return_error(e_stackunderflow);
173 default: {
174 /* Use an explicit loop. */
175 uint size = ref_stack_count(&d_stack);
176 uint i;
177
178 for (i = 0; i < size; i++) {
179 ref *dp = ref_stack_index(&d_stack, i);
180
181 check_dict_read(*dp);
182 if (dict_find(dp, op, &pvalue) > 0) {
183 ref_assign(op, pvalue);
184 return 0;
185 }
186 }
187 return_error(e_undefined);
188 }
189 }
190 }
191
192 /* get - implemented in zgeneric.c */
193
194 /* put - implemented in zgeneric.c */
195
196 /* <dict> <key> .undef - */
197 /* <dict> <key> undef - */
198 private int
zundef(i_ctx_t * i_ctx_p)199 zundef(i_ctx_t *i_ctx_p)
200 {
201 os_ptr op = osp;
202
203 check_type(op[-1], t_dictionary);
204 check_dict_write(op[-1]);
205 idict_undef(op - 1, op); /* ignore undefined error */
206 pop(2);
207 return 0;
208 }
209
210 /* <dict> <key> known <bool> */
211 private int
zknown(i_ctx_t * i_ctx_p)212 zknown(i_ctx_t *i_ctx_p)
213 {
214 os_ptr op = osp;
215 register os_ptr op1 = op - 1;
216 ref *pvalue;
217
218 check_type(*op1, t_dictionary);
219 check_dict_read(*op1);
220 make_bool(op1, (dict_find(op1, op, &pvalue) > 0 ? 1 : 0));
221 pop(1);
222 return 0;
223 }
224
225 /* <key> where <dict> true */
226 /* <key> where false */
227 int
zwhere(i_ctx_t * i_ctx_p)228 zwhere(i_ctx_t *i_ctx_p)
229 {
230 os_ptr op = osp;
231 ref_stack_enum_t rsenum;
232
233 check_op(1);
234 ref_stack_enum_begin(&rsenum, &d_stack);
235 do {
236 const ref *const bot = rsenum.ptr;
237 const ref *pdref = bot + rsenum.size;
238 ref *pvalue;
239
240 while (pdref-- > bot) {
241 check_dict_read(*pdref);
242 if (dict_find(pdref, op, &pvalue) > 0) {
243 push(1);
244 ref_assign(op - 1, pdref);
245 make_true(op);
246 return 0;
247 }
248 }
249 } while (ref_stack_enum_next(&rsenum));
250 make_false(op);
251 return 0;
252 }
253
254 /* copy for dictionaries -- called from zcopy in zgeneric.c. */
255 /* Only the type of *op has been checked. */
256 int
zcopy_dict(i_ctx_t * i_ctx_p)257 zcopy_dict(i_ctx_t *i_ctx_p)
258 {
259 os_ptr op = osp;
260 os_ptr op1 = op - 1;
261 int code;
262
263 check_type(*op1, t_dictionary);
264 check_dict_read(*op1);
265 check_dict_write(*op);
266 if (!dict_auto_expand &&
267 (dict_length(op) != 0 || dict_maxlength(op) < dict_length(op1))
268 )
269 return_error(e_rangecheck);
270 code = idict_copy(op1, op);
271 if (code < 0)
272 return code;
273 /*
274 * In Level 1 systems, we must copy the access attributes too.
275 * The only possible effect this can have is to make the
276 * copy read-only if the original dictionary is read-only.
277 */
278 if (!level2_enabled)
279 r_copy_attrs(dict_access_ref(op), a_write, dict_access_ref(op1));
280 ref_assign(op1, op);
281 pop(1);
282 return 0;
283 }
284
285 /* - currentdict <dict> */
286 private int
zcurrentdict(i_ctx_t * i_ctx_p)287 zcurrentdict(i_ctx_t *i_ctx_p)
288 {
289 os_ptr op = osp;
290
291 push(1);
292 ref_assign(op, dsp);
293 return 0;
294 }
295
296 /* - countdictstack <int> */
297 private int
zcountdictstack(i_ctx_t * i_ctx_p)298 zcountdictstack(i_ctx_t *i_ctx_p)
299 {
300 os_ptr op = osp;
301 uint count = ref_stack_count(&d_stack);
302
303 push(1);
304 if (!level2_enabled)
305 count--; /* see dstack.h */
306 make_int(op, count);
307 return 0;
308 }
309
310 /* <array> dictstack <subarray> */
311 private int
zdictstack(i_ctx_t * i_ctx_p)312 zdictstack(i_ctx_t *i_ctx_p)
313 {
314 os_ptr op = osp;
315 uint count = ref_stack_count(&d_stack);
316
317 check_write_type(*op, t_array);
318 if (!level2_enabled)
319 count--; /* see dstack.h */
320 return ref_stack_store(&d_stack, op, count, 0, 0, true, idmemory,
321 "dictstack");
322 }
323
324 /* - cleardictstack - */
325 private int
zcleardictstack(i_ctx_t * i_ctx_p)326 zcleardictstack(i_ctx_t *i_ctx_p)
327 {
328 while (zend(i_ctx_p) >= 0)
329 DO_NOTHING;
330 return 0;
331 }
332
333 /* ------ Extensions ------ */
334
335 /* <dict1> <dict2> .dictcopynew <dict2> */
336 private int
zdictcopynew(i_ctx_t * i_ctx_p)337 zdictcopynew(i_ctx_t *i_ctx_p)
338 {
339 os_ptr op = osp;
340 os_ptr op1 = op - 1;
341 int code;
342
343 check_type(*op1, t_dictionary);
344 check_dict_read(*op1);
345 check_type(*op, t_dictionary);
346 check_dict_write(*op);
347 /* This is only recognized in Level 2 mode. */
348 if (!dict_auto_expand)
349 return_error(e_undefined);
350 code = idict_copy_new(op1, op);
351 if (code < 0)
352 return code;
353 ref_assign(op1, op);
354 pop(1);
355 return 0;
356 }
357
358 /* -mark- <key0> <value0> <key1> <value1> ... .dicttomark <dict> */
359 /* This is the Level 2 >> operator. */
360 private int
zdicttomark(i_ctx_t * i_ctx_p)361 zdicttomark(i_ctx_t *i_ctx_p)
362 {
363 uint count2 = ref_stack_counttomark(&o_stack);
364 ref rdict;
365 int code;
366 uint idx;
367
368 if (count2 == 0)
369 return_error(e_unmatchedmark);
370 count2--;
371 if ((count2 & 1) != 0)
372 return_error(e_rangecheck);
373 code = dict_create(count2 >> 1, &rdict);
374 if (code < 0)
375 return code;
376 /* << /a 1 /a 2 >> => << /a 1 >>, i.e., */
377 /* we must enter the keys in top-to-bottom order. */
378 for (idx = 0; idx < count2; idx += 2) {
379 code = idict_put(&rdict,
380 ref_stack_index(&o_stack, idx + 1),
381 ref_stack_index(&o_stack, idx));
382 if (code < 0) { /* There's no way to free the dictionary -- too bad. */
383 return code;
384 }
385 }
386 ref_stack_pop(&o_stack, count2);
387 ref_assign(osp, &rdict);
388 return code;
389 }
390
391 /* <dict> <key> .forceundef - */
392 /*
393 * This forces an "undef" even if the dictionary is not writable.
394 * Like .forceput, it is meant to be used only in a few special situations,
395 * and should not be accessible by name after initialization.
396 */
397 private int
zforceundef(i_ctx_t * i_ctx_p)398 zforceundef(i_ctx_t *i_ctx_p)
399 {
400 os_ptr op = osp;
401
402 check_type(op[-1], t_dictionary);
403 /* Don't check_dict_write */
404 idict_undef(op - 1, op); /* ignore undefined error */
405 pop(2);
406 return 0;
407 }
408
409 /* <dict> <key> .knownget <value> true */
410 /* <dict> <key> .knownget false */
411 private int
zknownget(i_ctx_t * i_ctx_p)412 zknownget(i_ctx_t *i_ctx_p)
413 {
414 os_ptr op = osp;
415 register os_ptr op1 = op - 1;
416 ref *pvalue;
417
418 check_type(*op1, t_dictionary);
419 check_dict_read(*op1);
420 if (dict_find(op1, op, &pvalue) <= 0) {
421 make_false(op1);
422 pop(1);
423 } else {
424 ref_assign(op1, pvalue);
425 make_true(op);
426 }
427 return 0;
428 }
429
430 /* <dict> <key> .knownundef <bool> */
431 private int
zknownundef(i_ctx_t * i_ctx_p)432 zknownundef(i_ctx_t *i_ctx_p)
433 {
434 os_ptr op = osp;
435 os_ptr op1 = op - 1;
436 int code;
437
438 check_type(*op1, t_dictionary);
439 check_dict_write(*op1);
440 code = idict_undef(op1, op);
441 make_bool(op1, code == 0);
442 pop(1);
443 return 0;
444 }
445
446 /* <dict> <int> .setmaxlength - */
447 private int
zsetmaxlength(i_ctx_t * i_ctx_p)448 zsetmaxlength(i_ctx_t *i_ctx_p)
449 {
450 os_ptr op = osp;
451 os_ptr op1 = op - 1;
452 uint new_size;
453 int code;
454
455 check_type(*op1, t_dictionary);
456 check_dict_write(*op1);
457 check_type(*op, t_integer);
458 if (op->value.intval < 0)
459 return_error(e_rangecheck);
460 new_size = (uint) op->value.intval;
461 if (dict_length(op - 1) > new_size)
462 return_error(e_dictfull);
463 code = idict_resize(op - 1, new_size);
464 if (code >= 0)
465 pop(2);
466 return code;
467 }
468
469 /* ------ Initialization procedure ------ */
470
471 /* We need to split the table because of the 16-element limit. */
472 const op_def zdict1_op_defs[] = {
473 {"0cleardictstack", zcleardictstack},
474 {"1begin", zbegin},
475 {"0countdictstack", zcountdictstack},
476 {"0currentdict", zcurrentdict},
477 {"2def", zdef},
478 {"1dict", zdict},
479 {"0dictstack", zdictstack},
480 {"0end", zend},
481 {"2known", zknown},
482 {"1load", zload},
483 {"1maxlength", zmaxlength},
484 {"2.undef", zundef}, /* we need this even in Level 1 */
485 {"1where", zwhere},
486 op_def_end(0)
487 };
488 const op_def zdict2_op_defs[] = {
489 /* Extensions */
490 {"2.dictcopynew", zdictcopynew},
491 {"1.dicttomark", zdicttomark},
492 {"2.forceundef", zforceundef},
493 {"2.knownget", zknownget},
494 {"1.knownundef", zknownundef},
495 {"2.setmaxlength", zsetmaxlength},
496 op_def_end(0)
497 };
498