]>
Commit | Line | Data |
---|---|---|
caddbb58 | 1 | /* |
efb2f309 | 2 | Copyright 1993-2002 by Easy Software Products. |
caddbb58 | 3 | Copyright 1989, 1996, 1997, 1998 Aladdin Enterprises. All rights reserved. |
4 | ||
8e4ff0ae | 5 | This file is part of GNU Ghostscript. |
caddbb58 | 6 | |
8e4ff0ae | 7 | GNU Ghostscript is distributed in the hope that it will be useful, but |
caddbb58 | 8 | WITHOUT ANY WARRANTY. No author or distributor accepts responsibility |
9 | to anyone for the consequences of using it or for whether it serves any | |
10 | particular purpose or works at all, unless he says so in writing. Refer | |
11 | to the GNU General Public License for full details. | |
12 | ||
8e4ff0ae | 13 | Everyone is granted permission to copy, modify and redistribute GNU |
14 | Ghostscript, but only under the conditions described in the GNU General | |
caddbb58 | 15 | Public License. A copy of this license is supposed to have been given |
16 | to you along with GNU Ghostscript so you can know your rights and | |
8e4ff0ae | 17 | responsibilities. It should be in a file named COPYING. Among other |
18 | things, the copyright notice and this notice must be preserved on all | |
19 | copies. | |
caddbb58 | 20 | |
21 | Aladdin Enterprises supports the work of the GNU Project, but is not | |
22 | affiliated with the Free Software Foundation or the GNU Project. GNU | |
23 | Ghostscript, as distributed by Aladdin Enterprises, does not require any | |
24 | GNU software to build or run it. | |
8e4ff0ae | 25 | */ |
26 | ||
efb2f309 | 27 | /*$Id: zcontrol.c,v 1.4 2002/01/02 17:59:12 mike Exp $ */ |
8e4ff0ae | 28 | /* Control operators */ |
29 | #include "string_.h" | |
30 | #include "ghost.h" | |
caddbb58 | 31 | #include "stream.h" |
8e4ff0ae | 32 | #include "oper.h" |
33 | #include "estack.h" | |
caddbb58 | 34 | #include "files.h" |
8e4ff0ae | 35 | #include "ipacked.h" |
36 | #include "iutil.h" | |
37 | #include "store.h" | |
38 | ||
39 | /* Make an invalid file object. */ | |
caddbb58 | 40 | extern void make_invalid_file(P1(ref *)); /* in zfile.c */ |
8e4ff0ae | 41 | |
42 | /* Forward references */ | |
caddbb58 | 43 | private int no_cleanup(P1(os_ptr)); |
44 | private uint count_exec_stack(P1(bool)); | |
45 | private uint count_to_stopped(P1(long)); | |
46 | private int unmatched_exit(P2(os_ptr, op_proc_p)); | |
8e4ff0ae | 47 | |
48 | /* See the comment in opdef.h for an invariant which allows */ | |
49 | /* more efficient implementation of for, loop, and repeat. */ | |
50 | ||
51 | /* <[test0 body0 ...]> .cond - */ | |
52 | private int cond_continue(P1(os_ptr)); | |
53 | private int | |
54 | zcond(register os_ptr op) | |
caddbb58 | 55 | { |
56 | es_ptr ep = esp; | |
57 | ||
58 | /* Push the array on the e-stack and call the continuation. */ | |
59 | if (!r_is_array(op)) | |
60 | return_op_typecheck(op); | |
61 | check_execute(*op); | |
62 | if ((r_size(op) & 1) != 0) | |
63 | return_error(e_rangecheck); | |
64 | if (r_size(op) == 0) | |
65 | return zpop(op); | |
66 | check_estack(3); | |
67 | esp = ep += 3; | |
68 | ref_assign(ep - 2, op); /* the cond body */ | |
69 | make_op_estack(ep - 1, cond_continue); | |
70 | array_get(op, 0L, ep); | |
71 | esfile_check_cache(); | |
72 | pop(1); | |
73 | return o_push_estack; | |
8e4ff0ae | 74 | } |
75 | private int | |
76 | cond_continue(register os_ptr op) | |
caddbb58 | 77 | { |
78 | es_ptr ep = esp; | |
79 | int code; | |
80 | ||
81 | /* The top element of the e-stack is the remaining tail of */ | |
82 | /* the cond body. The top element of the o-stack should be */ | |
83 | /* the (boolean) result of the test that is the first element */ | |
84 | /* of the tail. */ | |
85 | check_type(*op, t_boolean); | |
86 | if (op->value.boolval) { /* true */ | |
87 | array_get(ep, 1L, ep); | |
88 | esfile_check_cache(); | |
89 | code = o_pop_estack; | |
90 | } else if (r_size(ep) > 2) { /* false */ | |
91 | const ref_packed *elts = ep->value.packed; | |
92 | ||
93 | check_estack(2); | |
94 | r_dec_size(ep, 2); | |
95 | elts = packed_next(elts); | |
96 | elts = packed_next(elts); | |
97 | ep->value.packed = elts; | |
98 | array_get(ep, 0L, ep + 2); | |
99 | make_op_estack(ep + 1, cond_continue); | |
100 | esp = ep + 2; | |
101 | esfile_check_cache(); | |
102 | code = o_push_estack; | |
103 | } else { /* fall off end of cond */ | |
104 | esp = ep - 1; | |
105 | code = o_pop_estack; | |
106 | } | |
107 | pop(1); /* get rid of the boolean */ | |
108 | return code; | |
8e4ff0ae | 109 | } |
110 | ||
111 | /* <obj> exec - */ | |
112 | int | |
113 | zexec(register os_ptr op) | |
caddbb58 | 114 | { |
115 | check_op(1); | |
116 | if (!r_has_attr(op, a_executable)) | |
117 | return 0; /* literal object just gets pushed back */ | |
118 | check_estack(1); | |
119 | ++esp; | |
120 | ref_assign(esp, op); | |
121 | esfile_check_cache(); | |
122 | pop(1); | |
123 | return o_push_estack; | |
124 | } | |
125 | ||
126 | /* <obj1> ... <objn> <n> .execn - */ | |
127 | int | |
128 | zexecn(register os_ptr op) | |
129 | { | |
130 | uint n, i; | |
131 | es_ptr esp_orig; | |
132 | ||
133 | check_int_leu(*op, max_uint - 1); | |
134 | n = (uint) op->value.intval; | |
135 | check_op(n + 1); | |
136 | check_estack(n); | |
137 | esp_orig = esp; | |
138 | for (i = 0; i < n; ++i) { | |
139 | const ref *rp = ref_stack_index(&o_stack, (long)(i + 1)); | |
140 | ||
141 | /* Make sure this object is legal to execute. */ | |
142 | if (ref_type_uses_access(r_type(rp))) { | |
143 | if (!r_has_attr(rp, a_execute) && | |
144 | r_has_attr(rp, a_executable) | |
145 | ) { | |
146 | esp = esp_orig; | |
147 | return_error(e_invalidaccess); | |
148 | } | |
149 | } | |
150 | /* Executable nulls have a special meaning on the e-stack, */ | |
151 | /* so since they are no-ops, don't push them. */ | |
152 | if (!r_has_type_attrs(rp, t_null, a_executable)) { | |
153 | ++esp; | |
154 | ref_assign(esp, rp); | |
155 | } | |
156 | } | |
157 | esfile_check_cache(); | |
158 | pop(n + 1); | |
159 | return o_push_estack; | |
8e4ff0ae | 160 | } |
161 | ||
162 | /* <obj> superexec - */ | |
163 | /* THIS IS NOT REALLY IMPLEMENTED YET. */ | |
164 | private int | |
165 | zsuperexec(os_ptr op) | |
caddbb58 | 166 | { |
167 | return zexec(op); | |
8e4ff0ae | 168 | } |
169 | ||
170 | /* <bool> <proc> if - */ | |
171 | int | |
172 | zif(register os_ptr op) | |
caddbb58 | 173 | { |
174 | check_type(op[-1], t_boolean); | |
175 | check_proc(*op); | |
176 | if (op[-1].value.boolval) { | |
177 | check_estack(1); | |
178 | ++esp; | |
179 | ref_assign(esp, op); | |
180 | esfile_check_cache(); | |
181 | } | |
182 | pop(2); | |
183 | return o_push_estack; | |
8e4ff0ae | 184 | } |
185 | ||
186 | /* <bool> <proc_true> <proc_false> ifelse - */ | |
187 | int | |
188 | zifelse(register os_ptr op) | |
caddbb58 | 189 | { |
190 | check_type(op[-2], t_boolean); | |
191 | check_proc(op[-1]); | |
192 | check_proc(*op); | |
193 | check_estack(1); | |
194 | ++esp; | |
195 | if (op[-2].value.boolval) { | |
196 | ref_assign(esp, op - 1); | |
197 | } else { | |
198 | ref_assign(esp, op); | |
199 | } | |
200 | esfile_check_cache(); | |
201 | pop(3); | |
202 | return o_push_estack; | |
8e4ff0ae | 203 | } |
204 | ||
205 | /* <init> <step> <limit> <proc> for - */ | |
206 | private int | |
caddbb58 | 207 | for_pos_int_continue(P1(os_ptr)), for_neg_int_continue(P1(os_ptr)), |
208 | for_real_continue(P1(os_ptr)); | |
8e4ff0ae | 209 | int |
210 | zfor(register os_ptr op) | |
caddbb58 | 211 | { |
212 | register es_ptr ep; | |
213 | ||
214 | check_estack(7); | |
215 | ep = esp + 6; | |
216 | check_proc(*op); | |
217 | /* Push a mark, the control variable, the initial value, */ | |
218 | /* the increment, the limit, and the procedure, */ | |
219 | /* and invoke the continuation operator. */ | |
220 | if (r_has_type(op - 3, t_integer) && | |
221 | r_has_type(op - 2, t_integer) | |
222 | ) { | |
223 | make_int(ep - 4, op[-3].value.intval); | |
224 | make_int(ep - 3, op[-2].value.intval); | |
225 | switch (r_type(op - 1)) { | |
226 | case t_integer: | |
227 | make_int(ep - 2, op[-1].value.intval); | |
228 | break; | |
229 | case t_real: | |
230 | make_int(ep - 2, (long)op[-1].value.realval); | |
231 | break; | |
232 | default: | |
233 | return_op_typecheck(op - 1); | |
234 | } | |
235 | if (ep[-3].value.intval >= 0) | |
236 | make_op_estack(ep, for_pos_int_continue); | |
8e4ff0ae | 237 | else |
caddbb58 | 238 | make_op_estack(ep, for_neg_int_continue); |
239 | } else { | |
240 | float params[3]; | |
241 | int code; | |
242 | ||
243 | if ((code = float_params(op - 1, 3, params)) < 0) | |
244 | return code; | |
245 | make_real(ep - 4, params[0]); | |
246 | make_real(ep - 3, params[1]); | |
247 | make_real(ep - 2, params[2]); | |
248 | make_op_estack(ep, for_real_continue); | |
249 | } | |
250 | make_mark_estack(ep - 5, es_for, no_cleanup); | |
251 | ref_assign(ep - 1, op); | |
252 | esp = ep; | |
253 | pop(4); | |
254 | return o_push_estack; | |
8e4ff0ae | 255 | } |
256 | /* Continuation operators for for, separate for positive integer, */ | |
257 | /* negative integer, and real. */ | |
258 | /* Execution stack contains mark, control variable, increment, */ | |
259 | /* limit, and procedure (procedure is topmost.) */ | |
260 | /* Continuation operator for positive integers. */ | |
261 | private int | |
262 | for_pos_int_continue(register os_ptr op) | |
caddbb58 | 263 | { |
264 | register es_ptr ep = esp; | |
265 | long var = ep[-3].value.intval; | |
266 | ||
267 | if (var > ep[-1].value.intval) { | |
268 | esp -= 5; /* pop everything */ | |
269 | return o_pop_estack; | |
270 | } | |
271 | push(1); | |
272 | make_int(op, var); | |
273 | ep[-3].value.intval = var + ep[-2].value.intval; | |
274 | ref_assign_inline(ep + 2, ep); /* saved proc */ | |
275 | esp = ep + 2; | |
276 | return o_push_estack; | |
8e4ff0ae | 277 | } |
278 | /* Continuation operator for negative integers. */ | |
279 | private int | |
280 | for_neg_int_continue(register os_ptr op) | |
caddbb58 | 281 | { |
282 | register es_ptr ep = esp; | |
283 | long var = ep[-3].value.intval; | |
284 | ||
285 | if (var < ep[-1].value.intval) { | |
286 | esp -= 5; /* pop everything */ | |
287 | return o_pop_estack; | |
288 | } | |
289 | push(1); | |
290 | make_int(op, var); | |
291 | ep[-3].value.intval = var + ep[-2].value.intval; | |
292 | ref_assign(ep + 2, ep); /* saved proc */ | |
293 | esp = ep + 2; | |
294 | return o_push_estack; | |
8e4ff0ae | 295 | } |
296 | /* Continuation operator for reals. */ | |
297 | private int | |
298 | for_real_continue(register os_ptr op) | |
caddbb58 | 299 | { |
300 | es_ptr ep = esp; | |
301 | float var = ep[-3].value.realval; | |
302 | float incr = ep[-2].value.realval; | |
303 | ||
304 | if (incr >= 0 ? (var > ep[-1].value.realval) : | |
305 | (var < ep[-1].value.realval) | |
306 | ) { | |
307 | esp -= 5; /* pop everything */ | |
308 | return o_pop_estack; | |
309 | } | |
310 | push(1); | |
311 | ref_assign(op, ep - 3); | |
312 | ep[-3].value.realval = var + incr; | |
313 | esp = ep + 2; | |
314 | ref_assign(ep + 2, ep); /* saved proc */ | |
315 | return o_push_estack; | |
8e4ff0ae | 316 | } |
317 | ||
318 | /* Here we provide an internal variant of 'for' that enumerates the */ | |
319 | /* values 0, 1/N, 2/N, ..., 1 precisely. The arguments must be */ | |
320 | /* the integers 0, 1, and N. We need this for */ | |
321 | /* loading caches such as the transfer function cache. */ | |
322 | private int for_fraction_continue(P1(os_ptr)); | |
323 | int | |
324 | zfor_fraction(register os_ptr op) | |
caddbb58 | 325 | { |
326 | int code = zfor(op); | |
327 | ||
328 | if (code < 0) | |
329 | return code; /* shouldn't ever happen! */ | |
330 | make_op_estack(esp, for_fraction_continue); | |
331 | return code; | |
8e4ff0ae | 332 | } |
333 | /* Continuation procedure */ | |
334 | private int | |
335 | for_fraction_continue(register os_ptr op) | |
caddbb58 | 336 | { |
337 | register es_ptr ep = esp; | |
338 | int code = for_pos_int_continue(op); | |
339 | ||
340 | if (code != o_push_estack) | |
8e4ff0ae | 341 | return code; |
caddbb58 | 342 | /* We must use osp instead of op here, because */ |
343 | /* for_pos_int_continue pushes a value on the o-stack. */ | |
344 | make_real(osp, (float)osp->value.intval / ep[-1].value.intval); | |
345 | return code; | |
8e4ff0ae | 346 | } |
347 | ||
348 | /* <int> <proc> repeat - */ | |
349 | private int repeat_continue(P1(os_ptr)); | |
350 | private int | |
351 | zrepeat(register os_ptr op) | |
caddbb58 | 352 | { |
353 | check_type(op[-1], t_integer); | |
354 | check_proc(*op); | |
355 | if (op[-1].value.intval < 0) | |
356 | return_error(e_rangecheck); | |
357 | check_estack(5); | |
358 | /* Push a mark, the count, and the procedure, and invoke */ | |
359 | /* the continuation operator. */ | |
360 | push_mark_estack(es_for, no_cleanup); | |
361 | *++esp = op[-1]; | |
362 | *++esp = *op; | |
363 | make_op_estack(esp + 1, repeat_continue); | |
364 | pop(2); | |
365 | return repeat_continue(op - 2); | |
8e4ff0ae | 366 | } |
367 | /* Continuation operator for repeat */ | |
368 | private int | |
369 | repeat_continue(register os_ptr op) | |
caddbb58 | 370 | { |
371 | es_ptr ep = esp; /* saved proc */ | |
372 | ||
373 | if (--(ep[-1].value.intval) >= 0) { /* continue */ | |
374 | esp += 2; | |
375 | ref_assign(esp, ep); | |
376 | return o_push_estack; | |
377 | } else { /* done */ | |
378 | esp -= 3; /* pop mark, count, proc */ | |
379 | return o_pop_estack; | |
380 | } | |
8e4ff0ae | 381 | } |
382 | ||
383 | /* <proc> loop */ | |
384 | private int loop_continue(P1(os_ptr)); | |
385 | private int | |
386 | zloop(register os_ptr op) | |
caddbb58 | 387 | { |
388 | check_proc(*op); | |
389 | check_estack(4); | |
390 | /* Push a mark and the procedure, and invoke */ | |
391 | /* the continuation operator. */ | |
392 | push_mark_estack(es_for, no_cleanup); | |
393 | *++esp = *op; | |
394 | make_op_estack(esp + 1, loop_continue); | |
395 | pop(1); | |
396 | return loop_continue(op - 1); | |
8e4ff0ae | 397 | } |
398 | /* Continuation operator for loop */ | |
399 | private int | |
400 | loop_continue(register os_ptr op) | |
caddbb58 | 401 | { |
402 | register es_ptr ep = esp; /* saved proc */ | |
403 | ||
404 | ref_assign(ep + 2, ep); | |
405 | esp = ep + 2; | |
406 | return o_push_estack; | |
8e4ff0ae | 407 | } |
408 | ||
409 | /* - exit - */ | |
410 | private int | |
411 | zexit(register os_ptr op) | |
caddbb58 | 412 | { |
413 | ref_stack_enum_t rsenum; | |
414 | uint scanned = 0; | |
415 | ||
416 | ref_stack_enum_begin(&rsenum, &e_stack); | |
417 | do { | |
418 | uint used = rsenum.size; | |
419 | es_ptr ep = rsenum.ptr + used - 1; | |
420 | uint count = used; | |
421 | ||
422 | for (; count; count--, ep--) | |
423 | if (r_is_estack_mark(ep)) | |
424 | switch (estack_mark_index(ep)) { | |
425 | case es_for: | |
426 | pop_estack(scanned + (used - count + 1)); | |
427 | return o_pop_estack; | |
428 | case es_stopped: | |
429 | return_error(e_invalidexit); /* not a loop */ | |
430 | } | |
431 | scanned += used; | |
432 | } while (ref_stack_enum_next(&rsenum)); | |
433 | /* No mark, quit. (per Adobe documentation) */ | |
434 | push(2); | |
435 | return unmatched_exit(op, zexit); | |
436 | } | |
437 | ||
438 | /* | |
439 | * .stopped pushes the following on the e-stack: | |
440 | * - A mark with type = es_stopped and procedure = no_cleanup. | |
441 | * - The result to be pushed on a normal return. | |
442 | * - The signal mask for .stop. | |
443 | * - The procedure %stopped_push, to handle the normal return case. | |
444 | */ | |
445 | ||
446 | /* In the normal (no-error) case, pop the mask from the e-stack, */ | |
447 | /* and move the result to the o-stack. */ | |
448 | private int | |
449 | stopped_push(register os_ptr op) | |
450 | { | |
451 | push(1); | |
452 | *op = esp[-1]; | |
453 | esp -= 3; | |
454 | return o_pop_estack; | |
8e4ff0ae | 455 | } |
456 | ||
caddbb58 | 457 | /* - stop - */ |
458 | /* Equivalent to true 1 .stop. */ | |
459 | /* This is implemented in C because if were a pseudo-operator, */ | |
460 | /* the stacks would get restored in case of an error. */ | |
8e4ff0ae | 461 | private int |
462 | zstop(register os_ptr op) | |
caddbb58 | 463 | { |
464 | uint count = count_to_stopped(1L); | |
465 | ||
466 | if (count) { | |
467 | /* | |
468 | * If there are any t_oparrays on the e-stack, they will pop | |
469 | * any new items from the o-stack. Wait to push the 'true' | |
470 | * until we have run all the unwind procedures. | |
471 | */ | |
472 | check_ostack(2); | |
473 | pop_estack(count); | |
474 | op = osp; | |
475 | push(1); | |
476 | make_true(op); | |
477 | return o_pop_estack; | |
478 | } | |
479 | /* No mark, quit. (per Adobe documentation) */ | |
480 | push(2); | |
481 | return unmatched_exit(op, zstop); | |
8e4ff0ae | 482 | } |
483 | ||
caddbb58 | 484 | /* <result> <mask> .stop - */ |
8e4ff0ae | 485 | private int |
caddbb58 | 486 | zzstop(register os_ptr op) |
487 | { | |
488 | uint count; | |
489 | ||
490 | check_type(*op, t_integer); | |
491 | count = count_to_stopped(op->value.intval); | |
492 | if (count) { | |
493 | /* | |
494 | * If there are any t_oparrays on the e-stack, they will pop | |
495 | * any new items from the o-stack. Wait to push the result | |
496 | * until we have run all the unwind procedures. | |
497 | */ | |
498 | ref save_result; | |
499 | ||
500 | check_op(2); | |
501 | save_result = op[-1]; | |
8e4ff0ae | 502 | pop(2); |
caddbb58 | 503 | pop_estack(count); |
504 | op = osp; | |
505 | push(1); | |
506 | *op = save_result; | |
507 | return o_pop_estack; | |
508 | } | |
509 | /* No mark, quit. (per Adobe documentation) */ | |
510 | return unmatched_exit(op, zzstop); | |
511 | } | |
512 | ||
513 | /* <obj> stopped <stopped> */ | |
514 | /* Equivalent to false 1 .stopped. */ | |
515 | /* This is implemented in C because if were a pseudo-operator, */ | |
516 | /* the stacks would get restored in case of an error. */ | |
517 | private int | |
518 | zstopped(register os_ptr op) | |
519 | { | |
520 | check_op(1); | |
521 | /* Mark the execution stack, and push the default result */ | |
522 | /* in case control returns normally. */ | |
523 | check_estack(5); | |
524 | push_mark_estack(es_stopped, no_cleanup); | |
525 | ++esp; | |
526 | make_false(esp); /* save the result */ | |
527 | ++esp; | |
528 | make_int(esp, 1); /* save the signal mask */ | |
529 | push_op_estack(stopped_push); | |
530 | *++esp = *op; /* execute the operand */ | |
531 | esfile_check_cache(); | |
532 | pop(1); | |
533 | return o_push_estack; | |
534 | } | |
535 | ||
536 | /* <obj> <result> <mask> .stopped <result> */ | |
537 | private int | |
538 | zzstopped(register os_ptr op) | |
539 | { | |
540 | check_type(*op, t_integer); | |
541 | check_op(3); | |
542 | /* Mark the execution stack, and push the default result */ | |
543 | /* in case control returns normally. */ | |
544 | check_estack(5); | |
545 | push_mark_estack(es_stopped, no_cleanup); | |
546 | *++esp = op[-1]; /* save the result */ | |
547 | *++esp = *op; /* save the signal mask */ | |
548 | push_op_estack(stopped_push); | |
549 | *++esp = op[-2]; /* execute the operand */ | |
550 | esfile_check_cache(); | |
551 | pop(3); | |
552 | return o_push_estack; | |
8e4ff0ae | 553 | } |
554 | ||
caddbb58 | 555 | /* <mask> .instopped false */ |
556 | /* <mask> .instopped <result> true */ | |
8e4ff0ae | 557 | private int |
558 | zinstopped(register os_ptr op) | |
caddbb58 | 559 | { |
560 | uint count; | |
561 | ||
562 | check_type(*op, t_integer); | |
563 | count = count_to_stopped(op->value.intval); | |
564 | if (count) { | |
565 | push(1); | |
566 | op[-1] = *ref_stack_index(&e_stack, count - 2); /* default result */ | |
567 | make_true(op); | |
568 | } else | |
569 | make_false(op); | |
570 | return 0; | |
8e4ff0ae | 571 | } |
572 | ||
caddbb58 | 573 | /* <include_marks> .countexecstack <int> */ |
8e4ff0ae | 574 | /* - countexecstack <int> */ |
caddbb58 | 575 | /* countexecstack is an operator solely for the sake of the Genoa tests. */ |
8e4ff0ae | 576 | private int |
577 | zcountexecstack(register os_ptr op) | |
caddbb58 | 578 | { |
579 | push(1); | |
580 | make_int(op, count_exec_stack(false)); | |
581 | return 0; | |
582 | } | |
583 | private int | |
584 | zcountexecstack1(register os_ptr op) | |
585 | { | |
586 | check_type(*op, t_boolean); | |
587 | make_int(op, count_exec_stack(op->value.boolval)); | |
588 | return 0; | |
8e4ff0ae | 589 | } |
590 | ||
caddbb58 | 591 | /* <array> <include_marks> .execstack <subarray> */ |
8e4ff0ae | 592 | /* <array> execstack <subarray> */ |
caddbb58 | 593 | /* execstack is an operator solely for the sake of the Genoa tests. */ |
8e4ff0ae | 594 | private int execstack_continue(P1(os_ptr)); |
caddbb58 | 595 | private int execstack2_continue(P1(os_ptr)); |
596 | private int | |
597 | push_execstack(os_ptr op1, bool include_marks, int (*cont)(P1(os_ptr))) | |
598 | { | |
599 | uint size; | |
600 | /* | |
601 | * We can't do this directly, because the interpreter | |
602 | * might have cached some state. To force the interpreter | |
603 | * to update the stored state, we push a continuation on | |
604 | * the exec stack; the continuation is executed immediately, | |
605 | * and does the actual transfer. | |
606 | */ | |
607 | uint depth; | |
608 | ||
609 | check_write_type(*op1, t_array); | |
610 | size = r_size(op1); | |
611 | depth = count_exec_stack(include_marks); | |
612 | if (depth > size) | |
613 | return_error(e_rangecheck); | |
614 | { | |
615 | int code = ref_stack_store_check(&e_stack, op1, size, 0); | |
616 | ||
617 | if (code < 0) | |
618 | return code; | |
619 | } | |
620 | check_estack(1); | |
621 | r_set_size(op1, depth); | |
622 | push_op_estack(cont); | |
623 | return o_push_estack; | |
624 | } | |
8e4ff0ae | 625 | private int |
626 | zexecstack(register os_ptr op) | |
caddbb58 | 627 | { |
628 | return push_execstack(op, false, execstack_continue); | |
629 | } | |
630 | private int | |
631 | zexecstack2(register os_ptr op) | |
632 | { | |
633 | check_type(*op, t_boolean); | |
634 | return push_execstack(op - 1, op->value.boolval, execstack2_continue); | |
8e4ff0ae | 635 | } |
636 | /* Continuation operator to do the actual transfer. */ | |
caddbb58 | 637 | /* r_size(op1) was set just above. */ |
8e4ff0ae | 638 | private int |
caddbb58 | 639 | do_execstack(os_ptr op, bool include_marks, os_ptr op1) |
640 | { | |
641 | ref *arefs = op1->value.refs; | |
642 | uint asize = r_size(op1); | |
643 | uint i; | |
644 | ref *rq; | |
645 | ||
646 | /* | |
647 | * Copy elements from the stack to the array, | |
648 | * optionally skipping executable nulls. | |
649 | * Clear the executable bit in any internal operators, and | |
650 | * convert t_structs and t_astructs (which can only appear | |
651 | * in connection with stack marks, which means that they will | |
652 | * probably be freed when unwinding) to something harmless. | |
653 | */ | |
654 | for (i = 0, rq = arefs + asize; rq != arefs; ++i) { | |
655 | const ref *rp = ref_stack_index(&e_stack, (long)i); | |
656 | ||
657 | if (r_has_type_attrs(rp, t_null, a_executable) && !include_marks) | |
658 | continue; | |
659 | --rq; | |
660 | ref_assign_old(op1, rq, rp, "execstack"); | |
661 | switch (r_type(rq)) { | |
662 | case t_operator: { | |
663 | uint opidx = op_index(rq); | |
664 | ||
665 | if (opidx == 0 || op_def_is_internal(op_def_table[opidx])) | |
666 | r_clear_attrs(rq, a_executable); | |
8e4ff0ae | 667 | break; |
caddbb58 | 668 | } |
8e4ff0ae | 669 | case t_struct: |
caddbb58 | 670 | case t_astruct: { |
671 | const char *tname = | |
672 | gs_struct_type_name_string( | |
673 | gs_object_type(imemory, rq->value.pstruct)); | |
674 | ||
675 | make_const_string(rq, a_readonly | avm_foreign, | |
8e4ff0ae | 676 | strlen(tname), (const byte *)tname); |
677 | break; | |
8e4ff0ae | 678 | } |
caddbb58 | 679 | default: |
680 | ; | |
681 | } | |
682 | } | |
683 | pop(op - op1); | |
684 | return 0; | |
685 | } | |
686 | private int | |
687 | execstack_continue(os_ptr op) | |
688 | { | |
689 | return do_execstack(op, false, op); | |
690 | } | |
691 | private int | |
692 | execstack2_continue(os_ptr op) | |
693 | { | |
694 | return do_execstack(op, op->value.boolval, op - 1); | |
8e4ff0ae | 695 | } |
696 | ||
697 | /* - .needinput - */ | |
698 | private int | |
699 | zneedinput(register os_ptr op) | |
caddbb58 | 700 | { |
701 | return e_NeedInput; /* interpreter will exit to caller */ | |
8e4ff0ae | 702 | } |
703 | ||
704 | /* <obj> <int> .quit - */ | |
705 | private int | |
706 | zquit(register os_ptr op) | |
caddbb58 | 707 | { |
708 | check_op(2); | |
709 | check_type(*op, t_integer); | |
710 | return_error(e_Quit); /* Interpreter will do the exit */ | |
8e4ff0ae | 711 | } |
712 | ||
713 | /* - currentfile <file> */ | |
714 | private ref *zget_current_file(P0()); | |
715 | private int | |
716 | zcurrentfile(register os_ptr op) | |
caddbb58 | 717 | { |
718 | ref *fp; | |
719 | ||
720 | push(1); | |
721 | /* Check the cache first */ | |
722 | if (esfile != 0) { | |
8e4ff0ae | 723 | #ifdef DEBUG |
caddbb58 | 724 | /* Check that esfile is valid. */ |
725 | ref *efp = zget_current_file(); | |
726 | ||
727 | if (esfile != efp) { | |
728 | lprintf2("currentfile: esfile=0x%lx, efp=0x%lx\n", | |
729 | (ulong) esfile, (ulong) efp); | |
730 | ref_assign(op, efp); | |
731 | } else | |
8e4ff0ae | 732 | #endif |
caddbb58 | 733 | ref_assign(op, esfile); |
734 | } else if ((fp = zget_current_file()) == 0) { /* Return an invalid file object. */ | |
735 | /* This doesn't make a lot of sense to me, */ | |
736 | /* but it's what the PostScript manual specifies. */ | |
737 | make_invalid_file(op); | |
738 | } else { | |
739 | ref_assign(op, fp); | |
740 | esfile_set_cache(fp); | |
741 | } | |
742 | /* Make the returned value literal. */ | |
743 | r_clear_attrs(op, a_executable); | |
744 | return 0; | |
8e4ff0ae | 745 | } |
746 | /* Get the current file from which the interpreter is reading. */ | |
747 | private ref * | |
748 | zget_current_file(void) | |
caddbb58 | 749 | { |
750 | ref_stack_enum_t rsenum; | |
751 | ||
752 | ref_stack_enum_begin(&rsenum, &e_stack); | |
753 | do { | |
754 | uint count = rsenum.size; | |
755 | es_ptr ep = rsenum.ptr + count - 1; | |
756 | ||
757 | for (; count; count--, ep--) | |
758 | if (r_has_type_attrs(ep, t_file, a_executable)) | |
759 | return ep; | |
760 | } while (ref_stack_enum_next(&rsenum)); | |
761 | return 0; | |
8e4ff0ae | 762 | } |
763 | ||
764 | /* ------ Initialization procedure ------ */ | |
765 | ||
caddbb58 | 766 | const op_def zcontrol_op_defs[] = |
767 | { | |
768 | {"1.cond", zcond}, | |
769 | {"0countexecstack", zcountexecstack}, | |
770 | {"1.countexecstack", zcountexecstack1}, | |
771 | {"0currentfile", zcurrentfile}, | |
772 | {"1exec", zexec}, | |
773 | {"1.execn", zexecn}, | |
774 | {"1execstack", zexecstack}, | |
775 | {"2.execstack", zexecstack2}, | |
776 | {"0exit", zexit}, | |
777 | {"2if", zif}, | |
778 | {"3ifelse", zifelse}, | |
779 | {"0.instopped", zinstopped}, | |
780 | {"0.needinput", zneedinput}, | |
781 | {"4for", zfor}, | |
782 | {"1loop", zloop}, | |
783 | {"2.quit", zquit}, | |
784 | {"2repeat", zrepeat}, | |
785 | {"0stop", zstop}, | |
786 | {"1.stop", zzstop}, | |
787 | {"1stopped", zstopped}, | |
788 | {"2.stopped", zzstopped}, | |
8e4ff0ae | 789 | /* Internal operators */ |
caddbb58 | 790 | {"1%cond_continue", cond_continue}, |
791 | {"1%execstack_continue", execstack_continue}, | |
792 | {"2%execstack2_continue", execstack2_continue}, | |
793 | {"0%for_pos_int_continue", for_pos_int_continue}, | |
794 | {"0%for_neg_int_continue", for_neg_int_continue}, | |
795 | {"0%for_real_continue", for_real_continue}, | |
796 | {"4%for_fraction", zfor_fraction}, | |
797 | {"0%for_fraction_continue", for_fraction_continue}, | |
798 | {"0%loop_continue", loop_continue}, | |
799 | {"0%repeat_continue", repeat_continue}, | |
800 | {"0%stopped_push", stopped_push}, | |
801 | {"1superexec", zsuperexec}, | |
802 | op_def_end(0) | |
803 | }; | |
8e4ff0ae | 804 | |
805 | /* ------ Internal routines ------ */ | |
806 | ||
807 | /* Vacuous cleanup routine */ | |
caddbb58 | 808 | private int |
8e4ff0ae | 809 | no_cleanup(os_ptr op) |
caddbb58 | 810 | { |
811 | return 0; | |
8e4ff0ae | 812 | } |
813 | ||
caddbb58 | 814 | /* |
815 | * Count the number of elements on the exec stack, with or without | |
816 | * the normally invisible elements (*op is a Boolean that indicates this). | |
817 | */ | |
8e4ff0ae | 818 | private uint |
caddbb58 | 819 | count_exec_stack(bool include_marks) |
820 | { | |
821 | uint count = ref_stack_count(&e_stack); | |
822 | ||
823 | if (!include_marks) { | |
824 | uint i; | |
825 | ||
826 | for (i = count; i--;) | |
827 | if (r_has_type_attrs(ref_stack_index(&e_stack, (long)i), | |
828 | t_null, a_executable)) | |
829 | --count; | |
830 | } | |
831 | return count; | |
832 | } | |
833 | ||
834 | /* | |
835 | * Count the number of elements down to and including the first 'stopped' | |
836 | * mark on the e-stack with a given mask. Return 0 if there is no 'stopped' | |
837 | * mark. | |
838 | */ | |
839 | private uint | |
840 | count_to_stopped(long mask) | |
841 | { | |
842 | ref_stack_enum_t rsenum; | |
843 | uint scanned = 0; | |
844 | ||
845 | ref_stack_enum_begin(&rsenum, &e_stack); | |
846 | do { | |
847 | uint used = rsenum.size; | |
848 | es_ptr ep = rsenum.ptr + used - 1; | |
849 | uint count = used; | |
850 | ||
851 | for (; count; count--, ep--) | |
852 | if (r_is_estack_mark(ep) && | |
853 | estack_mark_index(ep) == es_stopped && | |
854 | (ep[2].value.intval & mask) != 0 | |
855 | ) | |
856 | return scanned + (used - count + 1); | |
857 | scanned += used; | |
858 | } while (ref_stack_enum_next(&rsenum)); | |
859 | return 0; | |
8e4ff0ae | 860 | } |
861 | ||
caddbb58 | 862 | /* |
863 | * Pop the e-stack, executing cleanup procedures as needed. | |
864 | * We could make this more efficient using ref_stack_enum_*, | |
865 | * but it isn't used enough to make this worthwhile. | |
866 | */ | |
8e4ff0ae | 867 | void |
868 | pop_estack(uint count) | |
caddbb58 | 869 | { |
870 | uint idx = 0; | |
871 | uint popped = 0; | |
872 | ||
873 | esfile_clear_cache(); | |
874 | for (; idx < count; idx++) { | |
875 | ref *ep = ref_stack_index(&e_stack, idx - popped); | |
876 | ||
877 | if (r_is_estack_mark(ep)) { | |
878 | ref_stack_pop(&e_stack, idx + 1 - popped); | |
879 | popped = idx + 1; | |
880 | (*real_opproc(ep)) (osp); | |
8e4ff0ae | 881 | } |
caddbb58 | 882 | } |
883 | ref_stack_pop(&e_stack, count - popped); | |
884 | } | |
885 | ||
886 | /* | |
887 | * Execute a quit in the case of an exit or stop with no appropriate | |
888 | * enclosing control scope (loop or stopped). The caller has already | |
889 | * ensured two free slots on the top of the o-stack. | |
890 | */ | |
891 | private int | |
892 | unmatched_exit(os_ptr op, op_proc_p opproc) | |
893 | { | |
894 | make_oper(op - 1, 0, opproc); | |
895 | make_int(op, e_invalidexit); | |
896 | return_error(e_Quit); | |
8e4ff0ae | 897 | } |