?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Imported Upstream version 6.33.1~b2+dfsg.1
[debian_inform6.git] / src / expressc.c
blobebaa1abc0cbe18c5ad5a5435c7008cc32d572fc5
1 /* ------------------------------------------------------------------------- */
2 /* "expressc" : The expression code generator */
3 /* */
4 /* Part of Inform 6.33 */
5 /* copyright (c) Graham Nelson 1993 - 2014 */
6 /* */
7 /* ------------------------------------------------------------------------- */
8
9 #include "header.h"
10
11 int vivc_flag; /* TRUE if the last code-generated
12 expression produced a "value in void
13 context" error: used to help the syntax
14 analyser recover from unknown-keyword
15 errors, since unknown keywords are
16 treated as yet-to-be-defined constants
17 and thus as values in void context */
18
19 /* These data structures are global, because they're too useful to be
20 static. */
21 assembly_operand stack_pointer, temp_var1, temp_var2, temp_var3,
22 temp_var4, zero_operand, one_operand, two_operand, three_operand,
23 four_operand, valueless_operand;
24
25 static void make_operands(void)
26 {
27 if (!glulx_mode) {
28 stack_pointer.type = VARIABLE_OT;
29 stack_pointer.value = 0;
30 stack_pointer.marker = 0;
31 temp_var1.type = VARIABLE_OT;
32 temp_var1.value = 255;
33 temp_var1.marker = 0;
34 temp_var2.type = VARIABLE_OT;
35 temp_var2.value = 254;
36 temp_var2.marker = 0;
37 temp_var3.type = VARIABLE_OT;
38 temp_var3.value = 253;
39 temp_var3.marker = 0;
40 temp_var4.type = VARIABLE_OT;
41 temp_var4.value = 252;
42 temp_var4.marker = 0;
43 zero_operand.type = SHORT_CONSTANT_OT;
44 zero_operand.value = 0;
45 zero_operand.marker = 0;
46 one_operand.type = SHORT_CONSTANT_OT;
47 one_operand.value = 1;
48 one_operand.marker = 0;
49 two_operand.type = SHORT_CONSTANT_OT;
50 two_operand.value = 2;
51 two_operand.marker = 0;
52 three_operand.type = SHORT_CONSTANT_OT;
53 three_operand.value = 3;
54 three_operand.marker = 0;
55 four_operand.type = SHORT_CONSTANT_OT;
56 four_operand.value = 4;
57 four_operand.marker = 0;
58 valueless_operand.type = OMITTED_OT;
59 valueless_operand.value = 0;
60 valueless_operand.marker = 0;
61 }
62 else {
63 stack_pointer.type = LOCALVAR_OT;
64 stack_pointer.value = 0;
65 stack_pointer.marker = 0;
66 temp_var1.type = GLOBALVAR_OT;
67 temp_var1.value = MAX_LOCAL_VARIABLES+0;
68 temp_var1.marker = 0;
69 temp_var2.type = GLOBALVAR_OT;
70 temp_var2.value = MAX_LOCAL_VARIABLES+1;
71 temp_var2.marker = 0;
72 temp_var3.type = GLOBALVAR_OT;
73 temp_var3.value = MAX_LOCAL_VARIABLES+2;
74 temp_var3.marker = 0;
75 temp_var4.type = GLOBALVAR_OT;
76 temp_var4.value = MAX_LOCAL_VARIABLES+3;
77 temp_var4.marker = 0;
78 zero_operand.type = ZEROCONSTANT_OT;
79 zero_operand.value = 0;
80 zero_operand.marker = 0;
81 one_operand.type = BYTECONSTANT_OT;
82 one_operand.value = 1;
83 one_operand.marker = 0;
84 two_operand.type = BYTECONSTANT_OT;
85 two_operand.value = 2;
86 two_operand.marker = 0;
87 three_operand.type = BYTECONSTANT_OT;
88 three_operand.value = 3;
89 three_operand.marker = 0;
90 four_operand.type = BYTECONSTANT_OT;
91 four_operand.value = 4;
92 four_operand.marker = 0;
93 valueless_operand.type = OMITTED_OT;
94 valueless_operand.value = 0;
95 valueless_operand.marker = 0;
96 }
97 }
98
99 /* ------------------------------------------------------------------------- */
100 /* The table of conditionals. (Only used in Glulx) */
101
102 #define ZERO_CC (500)
103 #define EQUAL_CC (502)
104 #define LT_CC (504)
105 #define GT_CC (506)
106 #define HAS_CC (508)
107 #define IN_CC (510)
108 #define OFCLASS_CC (512)
109 #define PROVIDES_CC (514)
110
111 #define FIRST_CC (500)
112 #define LAST_CC (515)
113
114 typedef struct condclass_s {
115 int32 posform; /* Opcode for the conditional in its positive form. */
116 int32 negform; /* Opcode for the conditional in its negated form. */
117 } condclass;
118
119 condclass condclasses[] = {
120 { jz_gc, jnz_gc },
121 { jeq_gc, jne_gc },
122 { jlt_gc, jge_gc },
123 { jgt_gc, jle_gc },
124 { -1, -1 },
125 { -1, -1 },
126 { -1, -1 },
127 { -1, -1 }
128 };
129
130 /* ------------------------------------------------------------------------- */
131 /* The table of operators.
132
133 The ordering in this table is not significant except that it must match
134 the #define's in "header.h" */
135
136 operator operators[NUM_OPERATORS] =
137 {
138 /* ------------------------ */
139 /* Level 0: , */
140 /* ------------------------ */
141
142 { 0, SEP_TT, COMMA_SEP, IN_U, L_A, 0, -1, -1, 0, 0, "comma" },
143
144 /* ------------------------ */
145 /* Level 1: = */
146 /* ------------------------ */
147
148 { 1, SEP_TT, SETEQUALS_SEP, IN_U, R_A, 1, -1, -1, 1, 0,
149 "assignment operator '='" },
150
151 /* ------------------------ */
152 /* Level 2: ~~ && || */
153 /* ------------------------ */
154
155 { 2, SEP_TT, LOGAND_SEP, IN_U, L_A, 0, -1, -1, 0, LOGOR_OP,
156 "logical conjunction '&&'" },
157 { 2, SEP_TT, LOGOR_SEP, IN_U, L_A, 0, -1, -1, 0, LOGAND_OP,
158 "logical disjunction '||'" },
159 { 2, SEP_TT, LOGNOT_SEP, PRE_U, R_A, 0, -1, -1, 0, LOGNOT_OP,
160 "logical negation '~~'" },
161
162 /* ------------------------ */
163 /* Level 3: == ~= */
164 /* > >= < <= */
165 /* has hasnt */
166 /* in notin */
167 /* provides */
168 /* ofclass */
169 /* ------------------------ */
170
171 { 3, -1, -1, -1, 0, 0, 400 + jz_zc, ZERO_CC+0, 0, NONZERO_OP,
172 "expression used as condition then negated" },
173 { 3, -1, -1, -1, 0, 0, 800 + jz_zc, ZERO_CC+1, 0, ZERO_OP,
174 "expression used as condition" },
175 { 3, SEP_TT, CONDEQUALS_SEP, IN_U, 0, 0, 400 + je_zc, EQUAL_CC+0, 0, NOTEQUAL_OP,
176 "'==' condition" },
177 { 3, SEP_TT, NOTEQUAL_SEP, IN_U, 0, 0, 800 + je_zc, EQUAL_CC+1, 0, CONDEQUALS_OP,
178 "'~=' condition" },
179 { 3, SEP_TT, GE_SEP, IN_U, 0, 0, 800 + jl_zc, LT_CC+1, 0, LESS_OP,
180 "'>=' condition" },
181 { 3, SEP_TT, GREATER_SEP, IN_U, 0, 0, 400 + jg_zc, GT_CC+0, 0, LE_OP,
182 "'>' condition" },
183 { 3, SEP_TT, LE_SEP, IN_U, 0, 0, 800 + jg_zc, GT_CC+1, 0, GREATER_OP,
184 "'<=' condition" },
185 { 3, SEP_TT, LESS_SEP, IN_U, 0, 0, 400 + jl_zc, LT_CC+0, 0, GE_OP,
186 "'<' condition" },
187 { 3, CND_TT, HAS_COND, IN_U, 0, 0, 400 + test_attr_zc, HAS_CC+0, 0, HASNT_OP,
188 "'has' condition" },
189 { 3, CND_TT, HASNT_COND, IN_U, 0, 0, 800 + test_attr_zc, HAS_CC+1, 0, HAS_OP,
190 "'hasnt' condition" },
191 { 3, CND_TT, IN_COND, IN_U, 0, 0, 400 + jin_zc, IN_CC+0, 0, NOTIN_OP,
192 "'in' condition" },
193 { 3, CND_TT, NOTIN_COND, IN_U, 0, 0, 800 + jin_zc, IN_CC+1, 0, IN_OP,
194 "'notin' condition" },
195 { 3, CND_TT, OFCLASS_COND, IN_U, 0, 0, 600, OFCLASS_CC+0, 0, NOTOFCLASS_OP,
196 "'ofclass' condition" },
197 { 3, CND_TT, PROVIDES_COND, IN_U, 0, 0, 601, PROVIDES_CC+0, 0, NOTPROVIDES_OP,
198 "'provides' condition" },
199 { 3, -1, -1, -1, 0, 0, 1000, OFCLASS_CC+1, 0, OFCLASS_OP,
200 "negated 'ofclass' condition" },
201 { 3, -1, -1, -1, 0, 0, 1001, PROVIDES_CC+1, 0, PROVIDES_OP,
202 "negated 'provides' condition" },
203
204 /* ------------------------ */
205 /* Level 4: or */
206 /* ------------------------ */
207
208 { 4, CND_TT, OR_COND, IN_U, L_A, 0, -1, -1, 0, 0, "'or'" },
209
210 /* ------------------------ */
211 /* Level 5: + binary - */
212 /* ------------------------ */
213
214 { 5, SEP_TT, PLUS_SEP, IN_U, L_A, 0, add_zc, add_gc, 0, 0, "'+'" },
215 { 5, SEP_TT, MINUS_SEP, IN_U, L_A, 0, sub_zc, sub_gc, 0, 0, "'-'" },
216
217 /* ------------------------ */
218 /* Level 6: * / % */
219 /* & | ~ */
220 /* ------------------------ */
221
222 { 6, SEP_TT, TIMES_SEP, IN_U, L_A, 0, mul_zc, mul_gc, 0, 0, "'*'" },
223 { 6, SEP_TT, DIVIDE_SEP, IN_U, L_A, 0, div_zc, div_gc, 0, 0, "'/'" },
224 { 6, SEP_TT, REMAINDER_SEP, IN_U, L_A, 0, mod_zc, mod_gc, 0, 0,
225 "remainder after division '%'" },
226 { 6, SEP_TT, ARTAND_SEP, IN_U, L_A, 0, and_zc, bitand_gc, 0, 0,
227 "bitwise AND '&'" },
228 { 6, SEP_TT, ARTOR_SEP, IN_U, L_A, 0, or_zc, bitor_gc, 0, 0,
229 "bitwise OR '|'" },
230 { 6, SEP_TT, ARTNOT_SEP, PRE_U, R_A, 0, -1, bitnot_gc, 0, 0,
231 "bitwise NOT '~'" },
232
233 /* ------------------------ */
234 /* Level 7: -> --> */
235 /* ------------------------ */
236
237 { 7, SEP_TT, ARROW_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
238 "byte array operator '->'" },
239 { 7, SEP_TT, DARROW_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
240 "word array operator '-->'" },
241
242 /* ------------------------ */
243 /* Level 8: unary - */
244 /* ------------------------ */
245
246 { 8, SEP_TT, UNARY_MINUS_SEP, PRE_U, R_A, 0, -1, neg_gc, 0, 0,
247 "unary minus" },
248
249 /* ------------------------ */
250 /* Level 9: ++ -- */
251 /* (prefix or postfix) */
252 /* ------------------------ */
253
254 { 9, SEP_TT, INC_SEP, PRE_U, R_A, 2, -1, -1, 1, 0,
255 "pre-increment operator '++'" },
256 { 9, SEP_TT, POST_INC_SEP, POST_U, R_A, 3, -1, -1, 1, 0,
257 "post-increment operator '++'" },
258 { 9, SEP_TT, DEC_SEP, PRE_U, R_A, 4, -1, -1, 1, 0,
259 "pre-decrement operator '--'" },
260 { 9, SEP_TT, POST_DEC_SEP, POST_U, R_A, 5, -1, -1, 1, 0,
261 "post-decrement operator '--'" },
262
263 /* ------------------------ */
264 /* Level 10: .& .# */
265 /* ..& ..# */
266 /* ------------------------ */
267
268 {10, SEP_TT, PROPADD_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
269 "property address operator '.&'" },
270 {10, SEP_TT, PROPNUM_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
271 "property length operator '.#'" },
272 {10, SEP_TT, MPROPADD_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
273 "individual property address operator '..&'" },
274 {10, SEP_TT, MPROPNUM_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
275 "individual property length operator '..#'" },
276
277 /* ------------------------ */
278 /* Level 11: function ( */
279 /* ------------------------ */
280
281 {11, SEP_TT, OPENB_SEP, IN_U, L_A, 0, -1, -1, 1, 0,
282 "function call" },
283
284 /* ------------------------ */
285 /* Level 12: . .. */
286 /* ------------------------ */
287
288 {12, SEP_TT, MESSAGE_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
289 "individual property selector '..'" },
290 {12, SEP_TT, PROPERTY_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
291 "property selector '.'" },
292
293 /* ------------------------ */
294 /* Level 13: :: */
295 /* ------------------------ */
296
297 {13, SEP_TT, SUPERCLASS_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
298 "superclass operator '::'" },
299
300 /* ------------------------ */
301 /* Miscellaneous operators */
302 /* generated at lvalue */
303 /* checking time */
304 /* ------------------------ */
305
306 { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> = */
307 "byte array entry assignment" },
308 { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> = */
309 "word array entry assignment" },
310 { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. = */
311 "individual property assignment" },
312 { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . = */
313 "common property assignment" },
314
315 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ -> */
316 "byte array entry preincrement" },
317 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ --> */
318 "word array entry preincrement" },
319 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ .. */
320 "individual property preincrement" },
321 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ . */
322 "common property preincrement" },
323
324 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- -> */
325 "byte array entry predecrement" },
326 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- --> */
327 "word array entry predecrement" },
328 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- .. */
329 "individual property predecrement" },
330 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- . */
331 "common property predecrement" },
332
333 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> ++ */
334 "byte array entry postincrement" },
335 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> ++ */
336 "word array entry postincrement" },
337 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. ++ */
338 "individual property postincrement" },
339 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . ++ */
340 "common property postincrement" },
341
342 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> -- */
343 "byte array entry postdecrement" },
344 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> -- */
345 "word array entry postdecrement" },
346 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. -- */
347 "individual property postdecrement" },
348 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . -- */
349 "common property postdecrement" },
350
351 {11, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* x.y(args) */
352 "call to common property" },
353 {11, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* x..y(args) */
354 "call to individual property" },
355
356 /* ------------------------ */
357 /* And one Glulx-only op */
358 /* which just pushes its */
359 /* argument on the stack, */
360 /* unchanged. */
361 /* ------------------------ */
362
363 {14, -1, -1, -1, -1, 0, -1, -1, 1, 0,
364 "push on stack" }
365 };
366
367 /* --- Condition annotater ------------------------------------------------- */
368
369 static void annotate_for_conditions(int n, int a, int b)
370 { int i, opnum = ET[n].operator_number;
371
372 ET[n].label_after = -1;
373 ET[n].to_expression = FALSE;
374 ET[n].true_label = a;
375 ET[n].false_label = b;
376
377 if (ET[n].down == -1) return;
378
379 if ((operators[opnum].precedence == 2)
380 || (operators[opnum].precedence == 3))
381 { if ((a == -1) && (b == -1))
382 { if (opnum == LOGAND_OP)
383 { b = next_label++;
384 ET[n].false_label = b;
385 ET[n].to_expression = TRUE;
386 }
387 else
388 { a = next_label++;
389 ET[n].true_label = a;
390 ET[n].to_expression = TRUE;
391 }
392 }
393 }
394
395 switch(opnum)
396 { case LOGAND_OP:
397 if (b == -1)
398 { b = next_label++;
399 ET[n].false_label = b;
400 ET[n].label_after = b;
401 }
402 annotate_for_conditions(ET[n].down, -1, b);
403 if (b == ET[n].label_after)
404 annotate_for_conditions(ET[ET[n].down].right, a, -1);
405 else annotate_for_conditions(ET[ET[n].down].right, a, b);
406 return;
407 case LOGOR_OP:
408 if (a == -1)
409 { a = next_label++;
410 ET[n].true_label = a;
411 ET[n].label_after = a;
412 }
413 annotate_for_conditions(ET[n].down, a, -1);
414 if (a == ET[n].label_after)
415 annotate_for_conditions(ET[ET[n].down].right, -1, b);
416 else annotate_for_conditions(ET[ET[n].down].right, a, b);
417 return;
418 }
419
420 i = ET[n].down;
421 while (i != -1)
422 { annotate_for_conditions(i, -1, -1); i = ET[i].right; }
423 }
424
425 /* --- Code generator ------------------------------------------------------ */
426
427 static void value_in_void_context_z(assembly_operand AO)
428 { char *t;
429
430 ASSERT_ZCODE();
431
432 switch(AO.type)
433 { case LONG_CONSTANT_OT:
434 case SHORT_CONSTANT_OT:
435 t = "<constant>";
436 if (AO.marker == SYMBOL_MV)
437 t = (char *) (symbs[AO.value]);
438 break;
439 case VARIABLE_OT:
440 t = variable_name(AO.value);
441 break;
442 default:
443 compiler_error("Unable to print value in void context");
444 t = "<expression>";
445 break;
446 }
447 vivc_flag = TRUE;
448
449 if (strcmp(t, "print_paddr") == 0)
450 obsolete_warning("ignoring 'print_paddr': use 'print (string)' instead");
451 else
452 if (strcmp(t, "print_addr") == 0)
453 obsolete_warning("ignoring 'print_addr': use 'print (address)' instead");
454 else
455 if (strcmp(t, "print_char") == 0)
456 obsolete_warning("ignoring 'print_char': use 'print (char)' instead");
457 else
458 ebf_error("expression with side-effects", t);
459 }
460
461 static void write_result_z(assembly_operand to, assembly_operand from)
462 { if (to.value == from.value) return;
463 if (to.value == 0) assemblez_1(push_zc, from);
464 else assemblez_store(to, from);
465 }
466
467 static void pop_zm_stack(void)
468 { assembly_operand st;
469 if (version_number < 5) assemblez_0(pop_zc);
470 else
471 { st.marker = 0; st.type = VARIABLE_OT; st.value = 0;
472 assemblez_1_branch(jz_zc, st, -2, TRUE);
473 }
474 }
475
476 static void access_memory_z(int oc, assembly_operand AO1, assembly_operand AO2,
477 assembly_operand AO3)
478 { int vr;
479
480 assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
481 index_ao;
482 int x, y, byte_flag, read_flag, from_module;
483
484 if (AO1.marker == ARRAY_MV)
485 {
486 if ((oc == loadb_zc) || (oc == storeb_zc)) byte_flag=TRUE;
487 else byte_flag = FALSE;
488 if ((oc == loadb_zc) || (oc == loadw_zc)) read_flag=TRUE;
489 else read_flag = FALSE;
490
491 zero_ao.type = SHORT_CONSTANT_OT;
492 zero_ao.value = 0; zero_ao.marker = 0;
493
494 size_ao = zero_ao; size_ao.value = -1;
495 for (x=0; x<no_arrays; x++)
496 { if (AO1.value == svals[array_symbols[x]])
497 { size_ao.value = array_sizes[x]; y=x;
498 }
499 }
500 if (size_ao.value==-1)
501 from_module=TRUE;
502 else {
503 from_module=FALSE;
504 type_ao = zero_ao; type_ao.value = array_types[y];
505
506 if ((!is_systemfile()))
507 { if (byte_flag)
508 {
509 if ((array_types[y] == WORD_ARRAY)
510 || (array_types[y] == TABLE_ARRAY))
511 warning("Using '->' to access a --> or table array");
512 }
513 else
514 {
515 if ((array_types[y] == BYTE_ARRAY)
516 || (array_types[y] == STRING_ARRAY))
517 warning("Using '-->' to access a -> or string array");
518 }
519 }
520 }
521 }
522
523
524 if ((!runtime_error_checking_switch) || (veneer_mode))
525 { if ((oc == loadb_zc) || (oc == loadw_zc))
526 assemblez_2_to(oc, AO1, AO2, AO3);
527 else
528 assemblez_3(oc, AO1, AO2, AO3);
529 return;
530 }
531
532 /* If we recognise AO1 as arising textually from a declared
533 array, we can check bounds explicitly. */
534
535 if ((AO1.marker == ARRAY_MV) && (!from_module))
536 {
537 int passed_label = next_label++, failed_label = next_label++,
538 final_label = next_label++;
539 /* Calculate the largest permitted array entry + 1
540 Here "size_ao.value" = largest permitted entry of its own kind */
541 max_ao = size_ao;
542
543 if (byte_flag
544 && ((array_types[y] == WORD_ARRAY)
545 || (array_types[y] == TABLE_ARRAY)))
546 { max_ao.value = size_ao.value*2 + 1;
547 type_ao.value += 8;
548 }
549 if ((!byte_flag)
550 && ((array_types[y] == BYTE_ARRAY)
551 || (array_types[y] == STRING_ARRAY)
552 || (array_types[y] == BUFFER_ARRAY)))
553 { if ((size_ao.value % 2) == 0)
554 max_ao.value = size_ao.value/2 - 1;
555 else max_ao.value = (size_ao.value-1)/2;
556 type_ao.value += 16;
557 }
558 max_ao.value++;
559
560 if (size_ao.value >= 256) size_ao.type = LONG_CONSTANT_OT;
561 if (max_ao.value >= 256) max_ao.type = LONG_CONSTANT_OT;
562
563 /* Can't write to the size entry in a string or table */
564 if (((array_types[y] == STRING_ARRAY)
565 || (array_types[y] == TABLE_ARRAY))
566 && (!read_flag))
567 { if ((array_types[y] == TABLE_ARRAY) && byte_flag)
568 zero_ao.value = 2;
569 else zero_ao.value = 1;
570 }
571
572 en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
573 switch(oc) { case loadb_zc: en_ao.value = ABOUNDS_RTE; break;
574 case loadw_zc: en_ao.value = ABOUNDS_RTE+1; break;
575 case storeb_zc: en_ao.value = ABOUNDS_RTE+2; break;
576 case storew_zc: en_ao.value = ABOUNDS_RTE+3; break; }
577
578 index_ao = AO2;
579 if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
580 { assemblez_store(temp_var2, AO2);
581 assemblez_store(AO2, temp_var2);
582 index_ao = temp_var2;
583 }
584 assemblez_2_branch(jl_zc, index_ao, zero_ao, failed_label, TRUE);
585 assemblez_2_branch(jl_zc, index_ao, max_ao, passed_label, TRUE);
586 assemble_label_no(failed_label);
587 an_ao = zero_ao; an_ao.value = y;
588 assemblez_6(call_vn2_zc, veneer_routine(RT__Err_VR), en_ao,
589 index_ao, size_ao, type_ao, an_ao);
590
591 /* We have to clear any of AO1, AO2, AO3 off the stack if
592 present, so that we can achieve the same effect on the stack
593 that executing the opcode would have had */
594
595 if ((AO1.type == VARIABLE_OT) && (AO1.value == 0)) pop_zm_stack();
596 if ((AO2.type == VARIABLE_OT) && (AO2.value == 0)) pop_zm_stack();
597 if ((AO3.type == VARIABLE_OT) && (AO3.value == 0))
598 { if ((oc == loadb_zc) || (oc == loadw_zc))
599 { assemblez_store(AO3, zero_ao);
600 }
601 else pop_zm_stack();
602 }
603 assemblez_jump(final_label);
604
605 assemble_label_no(passed_label);
606 if ((oc == loadb_zc) || (oc == loadw_zc))
607 assemblez_2_to(oc, AO1, AO2, AO3);
608 else
609 assemblez_3(oc, AO1, AO2, AO3);
610 assemble_label_no(final_label);
611 return;
612 }
613
614 /* Otherwise, compile a call to the veneer which verifies that
615 the proposed read/write is within dynamic Z-machine memory. */
616
617 switch(oc) { case loadb_zc: vr = RT__ChLDB_VR; break;
618 case loadw_zc: vr = RT__ChLDW_VR; break;
619 case storeb_zc: vr = RT__ChSTB_VR; break;
620 case storew_zc: vr = RT__ChSTW_VR; break; }
621
622 if ((oc == loadb_zc) || (oc == loadw_zc))
623 assemblez_3_to(call_vs_zc, veneer_routine(vr), AO1, AO2, AO3);
624 else
625 assemblez_4(call_vn_zc, veneer_routine(vr), AO1, AO2, AO3);
626 }
627
628 static assembly_operand check_nonzero_at_runtime_z(assembly_operand AO1,
629 int error_label, int rte_number)
630 { assembly_operand AO2, AO3;
631 int check_sp = FALSE, passed_label, failed_label, last_label;
632 if (veneer_mode) return AO1;
633
634 /* Assemble to code to check that the operand AO1 is ofclass Object:
635 if it is, execution should continue and the stack should be
636 unchanged. Otherwise, call the veneer's run-time-error routine
637 with the given error number, and then: if the label isn't -1,
638 switch execution to this label, with the value popped from
639 the stack if it was on the stack in the first place;
640 if the label is -1, either replace the top of the stack with
641 the constant 2, or return the operand (short constant) 2.
642
643 The point of 2 is that object 2 is the class-object Object
644 and therefore has no parent, child or sibling, so that the
645 built-in tree functions will safely return 0 on this object. */
646
647 /* Sometimes we can already see that the object number is valid. */
648 if (((AO1.type == LONG_CONSTANT_OT) || (AO1.type == SHORT_CONSTANT_OT))
649 && (AO1.marker == 0) && (AO1.value >= 1) && (AO1.value < no_objects))
650 return AO1;
651
652 passed_label = next_label++;
653 failed_label = next_label++;
654 AO2.type = LONG_CONSTANT_OT;
655 AO2.value = actual_largest_object_SC;
656 AO2.marker = INCON_MV;
657 AO3.value = 5; AO3.type = SHORT_CONSTANT_OT; AO3.marker = 0;
658
659 if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
660 || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
661 || (rte_number == PROP_ADD_RTE))
662 { /* Allow classes */
663 AO3.value = 1;
664 if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
665 { /* That is, if AO1 is the stack pointer */
666 check_sp = TRUE;
667 assemblez_store(temp_var2, AO1);
668 assemblez_store(AO1, temp_var2);
669 assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
670 assemblez_2_branch(jg_zc, temp_var2, AO2, passed_label, FALSE);
671 }
672 else
673 { assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
674 assemblez_2_branch(jg_zc, AO1, AO2, passed_label, FALSE);
675 }
676 }
677 else
678 { if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
679 { /* That is, if AO1 is the stack pointer */
680 check_sp = TRUE;
681 assemblez_store(temp_var2, AO1);
682 assemblez_store(AO1, temp_var2);
683 assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
684 assemblez_2_branch(jg_zc, temp_var2, AO2, failed_label, TRUE);
685 AO3.value = 1;
686 assemblez_2_branch(jin_zc, temp_var2, AO3, passed_label, FALSE);
687 }
688 else
689 { assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
690 assemblez_2_branch(jg_zc, AO1, AO2, failed_label, TRUE);
691 AO3.value = 1;
692 assemblez_2_branch(jin_zc, AO1, AO3, passed_label, FALSE);
693 }
694 }
695
696 assemble_label_no(failed_label);
697 AO2.type = SHORT_CONSTANT_OT; AO2.value = rte_number; AO2.marker = 0;
698 if (version_number >= 5)
699 assemblez_3(call_vn_zc, veneer_routine(RT__Err_VR), AO2, AO1);
700 else
701 assemblez_3_to(call_zc, veneer_routine(RT__Err_VR), AO2, AO1, temp_var2);
702
703 if (error_label != -1)
704 { /* Jump to the error label */
705 if (error_label == -3) assemblez_0(rfalse_zc);
706 else if (error_label == -4) assemblez_0(rtrue_zc);
707 else assemblez_jump(error_label);
708 }
709 else
710 { if (check_sp)
711 { /* Push the short constant 2 */
712 AO2.type = SHORT_CONSTANT_OT; AO2.value = 2; AO2.marker = 0;
713 assemblez_store(AO1, AO2);
714 }
715 else
716 { /* Store either short constant 2 or the operand's value in
717 the temporary variable */
718 AO2.type = SHORT_CONSTANT_OT; AO2.value = 2; AO2.marker = 0;
719 AO3 = temp_var2; assemblez_store(AO3, AO2);
720 last_label = next_label++;
721 assemblez_jump(last_label);
722 assemble_label_no(passed_label);
723 assemblez_store(AO3, AO1);
724 assemble_label_no(last_label);
725 return AO3;
726 }
727 }
728 assemble_label_no(passed_label);
729 return AO1;
730 }
731
732 static void compile_conditional_z(int oc,
733 assembly_operand AO1, assembly_operand AO2, int label, int flag)
734 { assembly_operand AO3; int the_zc, error_label = label,
735 va_flag = FALSE, va_label;
736
737 ASSERT_ZCODE();
738
739 if (oc<200)
740 { if ((runtime_error_checking_switch) && (oc == jin_zc))
741 { if (flag) error_label = next_label++;
742 AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
743 }
744 if ((runtime_error_checking_switch) && (oc == test_attr_zc))
745 { if (flag) error_label = next_label++;
746 AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
747 switch(AO2.type)
748 { case SHORT_CONSTANT_OT:
749 case LONG_CONSTANT_OT:
750 if (AO2.marker == 0)
751 { if ((AO2.value < 0) || (AO2.value > 47))
752 error("'has'/'hasnt' applied to illegal attribute number");
753 break;
754 }
755 case VARIABLE_OT:
756 { int pa_label = next_label++, fa_label = next_label++;
757 assembly_operand en_ao, zero_ao, max_ao;
758 assemblez_store(temp_var1, AO1);
759 if ((AO1.type == VARIABLE_OT)&&(AO1.value == 0))
760 assemblez_store(AO1, temp_var1);
761 assemblez_store(temp_var2, AO2);
762 if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
763 assemblez_store(AO2, temp_var2);
764 zero_ao.type = SHORT_CONSTANT_OT; zero_ao.marker = 0;
765 zero_ao.value = 0; max_ao = zero_ao; max_ao.value = 48;
766 assemblez_2_branch(jl_zc,temp_var2,zero_ao,fa_label,TRUE);
767 assemblez_2_branch(jl_zc,temp_var2,max_ao,pa_label,TRUE);
768 assemble_label_no(fa_label);
769 en_ao = zero_ao; en_ao.value = 19;
770 assemblez_4(call_vn_zc, veneer_routine(RT__Err_VR),
771 en_ao, temp_var1, temp_var2);
772 va_flag = TRUE; va_label = next_label++;
773 assemblez_jump(va_label);
774 assemble_label_no(pa_label);
775 }
776 }
777 }
778 assemblez_2_branch(oc, AO1, AO2, label, flag);
779 if (error_label != label) assemble_label_no(error_label);
780 if (va_flag) assemble_label_no(va_label);
781 return;
782 }
783
784 AO3.type = VARIABLE_OT; AO3.value = 0; AO3.marker = 0;
785
786 the_zc = (version_number == 3)?call_zc:call_vs_zc;
787 if (oc == 201)
788 assemblez_3_to(the_zc, veneer_routine(OP__Pr_VR), AO1, AO2, AO3);
789 else
790 assemblez_3_to(the_zc, veneer_routine(OC__Cl_VR), AO1, AO2, AO3);
791
792 assemblez_1_branch(jz_zc, AO3, label, !flag);
793 }
794
795 static void value_in_void_context_g(assembly_operand AO)
796 { char *t;
797
798 ASSERT_GLULX();
799
800 switch(AO.type)
801 { case CONSTANT_OT:
802 case HALFCONSTANT_OT:
803 case BYTECONSTANT_OT:
804 case ZEROCONSTANT_OT:
805 t = "<constant>";
806 if (AO.marker == SYMBOL_MV)
807 t = (char *) (symbs[AO.value]);
808 break;
809 case GLOBALVAR_OT:
810 case LOCALVAR_OT:
811 t = variable_name(AO.value);
812 break;
813 default:
814 compiler_error("Unable to print value in void context");
815 t = "<expression>";
816 break;
817 }
818 vivc_flag = TRUE;
819
820 ebf_error("expression with side-effects", t);
821 }
822
823 static void write_result_g(assembly_operand to, assembly_operand from)
824 { if (to.value == from.value && to.type == from.type) return;
825 assembleg_store(to, from);
826 }
827
828 static void access_memory_g(int oc, assembly_operand AO1, assembly_operand AO2,
829 assembly_operand AO3)
830 { int vr;
831 int data_len, read_flag;
832 assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
833 index_ao, five_ao;
834 int passed_label, failed_label, final_label, x, y;
835
836 if ((oc == aloadb_gc) || (oc == astoreb_gc)) data_len = 1;
837 else if ((oc == aloads_gc) || (oc == astores_gc)) data_len = 2;
838 else data_len = 4;
839
840 if ((oc == aloadb_gc) || (oc == aloads_gc) || (oc == aload_gc))
841 read_flag = TRUE;
842 else
843 read_flag = FALSE;
844
845 if (AO1.marker == ARRAY_MV)
846 {
847 zero_ao.value = 0; zero_ao.marker = 0;
848
849 size_ao = zero_ao; size_ao.value = -1;
850 for (x=0; x<no_arrays; x++)
851 { if (AO1.value == svals[array_symbols[x]])
852 { size_ao.value = array_sizes[x]; y=x;
853 }
854 }
855 if (size_ao.value==-1) compiler_error("Array size can't be found");
856
857 type_ao = zero_ao; type_ao.value = array_types[y];
858
859 if ((!is_systemfile()))
860 { if (data_len == 1)
861 {
862 if ((array_types[y] == WORD_ARRAY)
863 || (array_types[y] == TABLE_ARRAY))
864 warning("Using '->' to access a --> or table array");
865 }
866 else
867 {
868 if ((array_types[y] == BYTE_ARRAY)
869 || (array_types[y] == STRING_ARRAY))
870 warning("Using '-->' to access a -> or string array");
871 }
872 }
873 }
874
875
876 if ((!runtime_error_checking_switch) || (veneer_mode))
877 {
878 assembleg_3(oc, AO1, AO2, AO3);
879 return;
880 }
881
882 /* If we recognise AO1 as arising textually from a declared
883 array, we can check bounds explicitly. */
884
885 if (AO1.marker == ARRAY_MV)
886 {
887 /* Calculate the largest permitted array entry + 1
888 Here "size_ao.value" = largest permitted entry of its own kind */
889 max_ao = size_ao;
890 if (data_len == 1
891 && ((array_types[y] == WORD_ARRAY)
892 || (array_types[y] == TABLE_ARRAY)))
893 { max_ao.value = size_ao.value*4 + 3;
894 type_ao.value += 8;
895 }
896 if (data_len == 4
897 && ((array_types[y] == BYTE_ARRAY)
898 || (array_types[y] == STRING_ARRAY)
899 || (array_types[y] == BUFFER_ARRAY)))
900 { max_ao.value = (size_ao.value-3)/4;
901 type_ao.value += 16;
902 }
903 max_ao.value++;
904
905 /* Can't write to the size entry in a string or table */
906 if (((array_types[y] == STRING_ARRAY)
907 || (array_types[y] == TABLE_ARRAY))
908 && (!read_flag))
909 { if ((array_types[y] == TABLE_ARRAY) && data_len == 1)
910 zero_ao.value = 4;
911 else zero_ao.value = 1;
912 }
913
914 en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
915
916 switch(oc) { case aloadb_gc: en_ao.value = ABOUNDS_RTE; break;
917 case aload_gc: en_ao.value = ABOUNDS_RTE+1; break;
918 case astoreb_gc: en_ao.value = ABOUNDS_RTE+2; break;
919 case astore_gc: en_ao.value = ABOUNDS_RTE+3; break; }
920
921 set_constant_ot(&zero_ao);
922 set_constant_ot(&size_ao);
923 set_constant_ot(&max_ao);
924 set_constant_ot(&type_ao);
925 set_constant_ot(&en_ao);
926
927 /* If we recognize A02 as a constant, we can do the test right
928 now. */
929 if (is_constant_ot(AO2.type) && AO2.marker == 0) {
930 if (AO2.value < zero_ao.value || AO2.value >= max_ao.value) {
931 error("Array reference is out-of-bounds");
932 }
933 assembleg_3(oc, AO1, AO2, AO3);
934 return;
935 }
936
937 passed_label = next_label++;
938 failed_label = next_label++;
939 final_label = next_label++;
940
941 index_ao = AO2;
942 if ((AO2.type == LOCALVAR_OT)&&(AO2.value == 0))
943 { assembleg_store(temp_var2, AO2); /* ### could peek */
944 assembleg_store(AO2, temp_var2);
945 index_ao = temp_var2;
946 }
947 assembleg_2_branch(jlt_gc, index_ao, zero_ao, failed_label);
948 assembleg_2_branch(jlt_gc, index_ao, max_ao, passed_label);
949 assemble_label_no(failed_label);
950
951 an_ao = zero_ao; an_ao.value = y;
952 set_constant_ot(&an_ao);
953 five_ao = zero_ao; five_ao.value = 5;
954 set_constant_ot(&five_ao);
955
956 /* Call the error veneer routine. */
957 assembleg_store(stack_pointer, an_ao);
958 assembleg_store(stack_pointer, type_ao);
959 assembleg_store(stack_pointer, size_ao);
960 assembleg_store(stack_pointer, index_ao);
961 assembleg_store(stack_pointer, en_ao);
962 assembleg_3(call_gc, veneer_routine(RT__Err_VR),
963 five_ao, zero_operand);
964
965 /* We have to clear any of AO1, AO2, AO3 off the stack if
966 present, so that we can achieve the same effect on the stack
967 that executing the opcode would have had */
968
969 if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0))
970 assembleg_2(copy_gc, stack_pointer, zero_operand);
971 if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
972 assembleg_2(copy_gc, stack_pointer, zero_operand);
973 if ((AO3.type == LOCALVAR_OT) && (AO3.value == 0))
974 { if ((oc == aloadb_gc) || (oc == aload_gc))
975 { assembleg_store(AO3, zero_ao);
976 }
977 else assembleg_2(copy_gc, stack_pointer, zero_operand);
978 }
979 assembleg_jump(final_label);
980
981 assemble_label_no(passed_label);
982 assembleg_3(oc, AO1, AO2, AO3);
983 assemble_label_no(final_label);
984 return;
985 }
986
987 /* Otherwise, compile a call to the veneer which verifies that
988 the proposed read/write is within dynamic Z-machine memory. */
989
990 switch(oc) {
991 case aloadb_gc: vr = RT__ChLDB_VR; break;
992 case aload_gc: vr = RT__ChLDW_VR; break;
993 case astoreb_gc: vr = RT__ChSTB_VR; break;
994 case astore_gc: vr = RT__ChSTW_VR; break;
995 }
996
997 if ((oc == aloadb_gc) || (oc == aload_gc))
998 assembleg_call_2(veneer_routine(vr), AO1, AO2, AO3);
999 else
1000 assembleg_call_3(veneer_routine(vr), AO1, AO2, AO3, zero_operand);
1001 }
1002
1003 static assembly_operand check_nonzero_at_runtime_g(assembly_operand AO1,
1004 int error_label, int rte_number)
1005 {
1006 assembly_operand AO, AO2, AO3;
1007 int ln;
1008 int check_sp = FALSE, passed_label, failed_label, last_label;
1009
1010 if (veneer_mode)
1011 return AO1;
1012
1013 /* Assemble to code to check that the operand AO1 is ofclass Object:
1014 if it is, execution should continue and the stack should be
1015 unchanged. Otherwise, call the veneer's run-time-error routine
1016 with the given error number, and then: if the label isn't -1,
1017 switch execution to this label, with the value popped from
1018 the stack if it was on the stack in the first place;
1019 if the label is -1, either replace the top of the stack with
1020 the constant symbol (class-object) Object.
1021
1022 The Object has no parent, child or sibling, so that the
1023 built-in tree functions will safely return 0 on this object. */
1024
1025 /* Sometimes we can already see that the object number is valid. */
1026 if (AO1.marker == OBJECT_MV &&
1027 ((AO1.value >= 1) && (AO1.value <= no_objects))) {
1028 return AO1;
1029 }
1030
1031 passed_label = next_label++;
1032 failed_label = next_label++;
1033
1034 if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0) && (AO1.marker == 0)) {
1035 /* That is, if AO1 is the stack pointer */
1036 check_sp = TRUE;
1037 assembleg_store(temp_var2, stack_pointer);
1038 assembleg_store(stack_pointer, temp_var2);
1039 AO = temp_var2;
1040 }
1041 else {
1042 AO = AO1;
1043 }
1044
1045 if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
1046 || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
1047 || (rte_number == PROP_ADD_RTE)) {
1048 /* Allow classes */
1049 /* Test if zero... */
1050 assembleg_1_branch(jz_gc, AO, failed_label);
1051 /* Test if first byte is 0x70... */
1052 assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
1053 AO3.marker = 0;
1054 AO3.value = 0x70; /* type byte -- object */
1055 set_constant_ot(&AO3);
1056 assembleg_2_branch(jeq_gc, stack_pointer, AO3, passed_label);
1057 }
1058 else {
1059 /* Test if zero... */
1060 assembleg_1_branch(jz_gc, AO, failed_label);
1061 /* Test if first byte is 0x70... */
1062 assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
1063 AO3.marker = 0;
1064 AO3.value = 0x70; /* type byte -- object */
1065 set_constant_ot(&AO3);
1066 assembleg_2_branch(jne_gc, stack_pointer, AO3, failed_label);
1067 /* Test if inside the "Class" object... */
1068 AO3.type = BYTECONSTANT_OT;
1069 AO3.value = GOBJFIELD_PARENT();
1070 AO3.marker = 0;
1071 assembleg_3(aload_gc, AO, AO3, stack_pointer);
1072 ln = symbol_index("Class", -1);
1073 AO3.value = svals[ln];
1074 AO3.marker = OBJECT_MV;
1075 AO3.type = CONSTANT_OT;
1076 assembleg_2_branch(jne_gc, stack_pointer, AO3, passed_label);
1077 }
1078
1079 assemble_label_no(failed_label);
1080 AO2.marker = 0;
1081 AO2.value = rte_number;
1082 set_constant_ot(&AO2);
1083 assembleg_call_2(veneer_routine(RT__Err_VR), AO2, AO1, zero_operand);
1084
1085 if (error_label != -1) {
1086 /* Jump to the error label */
1087 if (error_label == -3) assembleg_1(return_gc, zero_operand);
1088 else if (error_label == -4) assembleg_1(return_gc, one_operand);
1089 else assembleg_jump(error_label);
1090 }
1091 else {
1092 /* Build the symbol for "Object" */
1093 ln = symbol_index("Object", -1);
1094 AO2.value = svals[ln];
1095 AO2.marker = OBJECT_MV;
1096 AO2.type = CONSTANT_OT;
1097 if (check_sp) {
1098 /* Push "Object" */
1099 assembleg_store(AO1, AO2);
1100 }
1101 else {
1102 /* Store either "Object" or the operand's value in the temporary
1103 variable. */
1104 assembleg_store(temp_var2, AO2);
1105 last_label = next_label++;
1106 assembleg_jump(last_label);
1107 assemble_label_no(passed_label);
1108 assembleg_store(temp_var2, AO1);
1109 assemble_label_no(last_label);
1110 return temp_var2;
1111 }
1112 }
1113
1114 assemble_label_no(passed_label);
1115 return AO1;
1116 }
1117
1118 static void compile_conditional_g(condclass *cc,
1119 assembly_operand AO1, assembly_operand AO2, int label, int flag)
1120 { assembly_operand AO4;
1121 int the_zc, error_label = label,
1122 va_flag = FALSE, va_label;
1123
1124 ASSERT_GLULX();
1125
1126 the_zc = (flag ? cc->posform : cc->negform);
1127
1128 if (the_zc == -1) {
1129 switch ((cc-condclasses)*2 + 500) {
1130
1131 case HAS_CC:
1132 if (runtime_error_checking_switch) {
1133 if (flag)
1134 error_label = next_label++;
1135 AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
1136 if (is_constant_ot(AO2.type) && AO2.marker == 0) {
1137 if ((AO2.value < 0) || (AO2.value >= NUM_ATTR_BYTES*8)) {
1138 error("'has'/'hasnt' applied to illegal attribute number");
1139 }
1140 }
1141 else {
1142 int pa_label = next_label++, fa_label = next_label++;
1143 assembly_operand en_ao, max_ao;
1144
1145 if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
1146 if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
1147 assembleg_2(stkpeek_gc, zero_operand, temp_var1);
1148 assembleg_2(stkpeek_gc, one_operand, temp_var2);
1149 }
1150 else {
1151 assembleg_2(stkpeek_gc, zero_operand, temp_var1);
1152 assembleg_store(temp_var2, AO2);
1153 }
1154 }
1155 else {
1156 assembleg_store(temp_var1, AO1);
1157 if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
1158 assembleg_2(stkpeek_gc, zero_operand, temp_var2);
1159 }
1160 else {
1161 assembleg_store(temp_var2, AO2);
1162 }
1163 }
1164
1165 max_ao.marker = 0;
1166 max_ao.value = NUM_ATTR_BYTES*8;
1167 set_constant_ot(&max_ao);
1168 assembleg_2_branch(jlt_gc, temp_var2, zero_operand, fa_label);
1169 assembleg_2_branch(jlt_gc, temp_var2, max_ao, pa_label);
1170 assemble_label_no(fa_label);
1171 en_ao.marker = 0;
1172 en_ao.value = 19; /* INVALIDATTR_RTE */
1173 set_constant_ot(&en_ao);
1174 assembleg_store(stack_pointer, temp_var2);
1175 assembleg_store(stack_pointer, temp_var1);
1176 assembleg_store(stack_pointer, en_ao);
1177 assembleg_3(call_gc, veneer_routine(RT__Err_VR),
1178 three_operand, zero_operand);
1179 va_flag = TRUE;
1180 va_label = next_label++;
1181 assembleg_jump(va_label);
1182 assemble_label_no(pa_label);
1183 }
1184 }
1185 if (is_constant_ot(AO2.type) && AO2.marker == 0) {
1186 AO2.value += 8;
1187 set_constant_ot(&AO2);
1188 }
1189 else {
1190 AO4.value = 8;
1191 AO4.marker = 0;
1192 AO4.type = BYTECONSTANT_OT;
1193 if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
1194 if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
1195 assembleg_0(stkswap_gc);
1196 assembleg_3(add_gc, AO2, AO4, stack_pointer);
1197 assembleg_0(stkswap_gc);
1198 }
1199 else {
1200 assembleg_3(add_gc, AO2, AO4, stack_pointer);
1201 }
1202 AO2 = stack_pointer;
1203 }
1204 assembleg_3(aloadbit_gc, AO1, AO2, stack_pointer);
1205 the_zc = (flag ? jnz_gc : jz_gc);
1206 AO1 = stack_pointer;
1207 break;
1208
1209 case IN_CC:
1210 if (runtime_error_checking_switch) {
1211 if (flag)
1212 error_label = next_label++;
1213 AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
1214 }
1215 AO4.value = GOBJFIELD_PARENT();
1216 AO4.marker = 0;
1217 AO4.type = BYTECONSTANT_OT;
1218 assembleg_3(aload_gc, AO1, AO4, stack_pointer);
1219 AO1 = stack_pointer;
1220 the_zc = (flag ? jeq_gc : jne_gc);
1221 break;
1222
1223 case OFCLASS_CC:
1224 assembleg_call_2(veneer_routine(OC__Cl_VR), AO1, AO2, stack_pointer);
1225 the_zc = (flag ? jnz_gc : jz_gc);
1226 AO1 = stack_pointer;
1227 break;
1228
1229 case PROVIDES_CC:
1230 assembleg_call_2(veneer_routine(OP__Pr_VR), AO1, AO2, stack_pointer);
1231 the_zc = (flag ? jnz_gc : jz_gc);
1232 AO1 = stack_pointer;
1233 break;
1234
1235 default:
1236 error("condition not yet supported in Glulx");
1237 return;
1238 }
1239 }
1240
1241 if (the_zc == jnz_gc || the_zc == jz_gc)
1242 assembleg_1_branch(the_zc, AO1, label);
1243 else
1244 assembleg_2_branch(the_zc, AO1, AO2, label);
1245 if (error_label != label) assemble_label_no(error_label);
1246 if (va_flag) assemble_label_no(va_label);
1247 }
1248
1249 static void value_in_void_context(assembly_operand AO)
1250 {
1251 if (!glulx_mode)
1252 value_in_void_context_z(AO);
1253 else
1254 value_in_void_context_g(AO);
1255 }
1256
1257
1258 extern assembly_operand check_nonzero_at_runtime(assembly_operand AO1,
1259 int error_label, int rte_number)
1260 {
1261 if (!glulx_mode)
1262 return check_nonzero_at_runtime_z(AO1, error_label, rte_number);
1263 else
1264 return check_nonzero_at_runtime_g(AO1, error_label, rte_number);
1265 }
1266
1267 static void generate_code_from(int n, int void_flag)
1268 {
1269 /* When void, this must not leave anything on the stack. */
1270
1271 int i, j, below, above, opnum, arity; assembly_operand Result;
1272
1273 below = ET[n].down; above = ET[n].up;
1274 if (below == -1)
1275 { if ((void_flag) && (ET[n].value.type != OMITTED_OT))
1276 value_in_void_context(ET[n].value);
1277 return;
1278 }
1279
1280 opnum = ET[n].operator_number;
1281
1282 if (opnum == COMMA_OP)
1283 { generate_code_from(below, TRUE);
1284 generate_code_from(ET[below].right, void_flag);
1285 ET[n].value = ET[ET[below].right].value;
1286 goto OperatorGenerated;
1287 }
1288
1289 if ((opnum == LOGAND_OP) || (opnum == LOGOR_OP))
1290 { generate_code_from(below, FALSE);
1291 generate_code_from(ET[below].right, FALSE);
1292 goto OperatorGenerated;
1293 }
1294
1295 if (opnum == -1)
1296 {
1297 /* Signifies a SETEQUALS_OP which has already been done */
1298
1299 ET[n].down = -1; return;
1300 }
1301
1302 /* Note that (except in the cases of comma and logical and/or) it
1303 is essential to code generate the operands right to left, because
1304 of the peculiar way the Z-machine's stack works:
1305
1306 @sub sp sp -> a;
1307
1308 (for instance) pulls to the first operand, then the second. So
1309
1310 @mul a 2 -> sp;
1311 @add b 7 -> sp;
1312 @sub sp sp -> a;
1313
1314 calculates (b+7)-(a*2), not the other way around (as would be more
1315 usual in stack machines evaluating expressions written in reverse
1316 Polish notation). (Basically this is because the Z-machine was
1317 designed to implement a LISP-like language naturally expressed
1318 in forward Polish notation: (PLUS 3 4), for instance.) */
1319
1320 /* And the Glulx machine follows the Z-machine in this respect. */
1321
1322 i=below; arity = 0;
1323 while (i != -1)
1324 { i = ET[i].right; arity++;
1325 }
1326 for (j=arity;j>0;j--)
1327 { int k = 1;
1328 i = below;
1329 while (k<j)
1330 { k++; i = ET[i].right;
1331 }
1332 generate_code_from(i, FALSE);
1333 }
1334
1335
1336 /* Check this again, because code generation lower down may have
1337 stubbed it into -1 */
1338
1339 if (ET[n].operator_number == -1)
1340 { ET[n].down = -1; return;
1341 }
1342
1343 if (!glulx_mode) {
1344
1345 if (operators[opnum].opcode_number_z >= 400)
1346 {
1347 /* Conditional terms such as '==': */
1348
1349 int a = ET[n].true_label, b = ET[n].false_label,
1350 branch_away, branch_other,
1351 make_jump_away = FALSE, make_branch_label = FALSE;
1352 int oc = operators[opnum].opcode_number_z-400, flag = TRUE;
1353
1354 if (oc >= 400) { oc = oc - 400; flag = FALSE; }
1355
1356 if ((oc == je_zc) && (arity == 2))
1357 { i = ET[ET[n].down].right;
1358 if ((ET[i].value.value == zero_operand.value)
1359 && (ET[i].value.type == zero_operand.type))
1360 oc = jz_zc;
1361 }
1362
1363 /* If the condition has truth state flag, branch to
1364 label a, and if not, to label b. Possibly one of a, b
1365 equals -1, meaning "continue from this instruction".
1366
1367 branch_away is the label which is a branch away (the one
1368 which isn't immediately after) and flag is the truth
1369 state to branch there.
1370
1371 Note that when multiple instructions are needed (because
1372 of the use of the 'or' operator) the branch_other label
1373 is created if need be.
1374 */
1375
1376 /* Reduce to the case where the branch_away label does exist: */
1377
1378 if (a == -1) { a = b; b = -1; flag = !flag; }
1379
1380 branch_away = a; branch_other = b;
1381 if (branch_other != -1) make_jump_away = TRUE;
1382
1383 if ((((oc != je_zc)&&(arity > 2)) || (arity > 4)) && (flag == FALSE))
1384 {
1385 /* In this case, we have an 'or' situation where multiple
1386 instructions are needed and where the overall condition
1387 is negated. That is, we have, e.g.
1388
1389 if not (A cond B or C or D) then branch_away
1390
1391 which we transform into
1392
1393 if (A cond B) then branch_other
1394 if (A cond C) then branch_other
1395 if not (A cond D) then branch_away
1396 .branch_other */
1397
1398 if (branch_other == -1)
1399 { branch_other = next_label++; make_branch_label = TRUE;
1400 }
1401 }
1402
1403 if (oc == jz_zc)
1404 assemblez_1_branch(jz_zc, ET[below].value, branch_away, flag);
1405 else
1406 { assembly_operand left_operand;
1407
1408 if (arity == 2)
1409 compile_conditional_z(oc, ET[below].value,
1410 ET[ET[below].right].value, branch_away, flag);
1411 else
1412 { /* The case of a condition using "or".
1413 First: if the condition tests the stack pointer,
1414 and it can't always be done in a single test, move
1415 the value off the stack and into temporary variable
1416 storage. */
1417
1418 if (((ET[below].value.type == VARIABLE_OT)
1419 && (ET[below].value.value == 0))
1420 && ((oc != je_zc) || (arity>4)) )
1421 { left_operand.type = VARIABLE_OT;
1422 left_operand.value = 255;
1423 left_operand.marker = 0;
1424 assemblez_store(left_operand, ET[below].value);
1425 }
1426 else left_operand = ET[below].value;
1427 i = ET[below].right; arity--;
1428
1429 /* "left_operand" now holds the quantity to be tested;
1430 "i" holds the right operand reached so far;
1431 "arity" the number of right operands. */
1432
1433 while (i != -1)
1434 { if ((oc == je_zc) && (arity>1))
1435 {
1436 /* je_zc is an especially good case since the
1437 Z-machine implements "or" for up to three
1438 right operands automatically, though it's an
1439 especially bad case to generate code for! */
1440
1441 if (arity == 2)
1442 { assemblez_3_branch(je_zc,
1443 left_operand, ET[i].value,
1444 ET[ET[i].right].value, branch_away, flag);
1445 i = ET[i].right; arity--;
1446 }
1447 else
1448 { if ((arity == 3) || flag)
1449 assemblez_4_branch(je_zc, left_operand,
1450 ET[i].value,
1451 ET[ET[i].right].value,
1452 ET[ET[ET[i].right].right].value,
1453 branch_away, flag);
1454 else
1455 assemblez_4_branch(je_zc, left_operand,
1456 ET[i].value,
1457 ET[ET[i].right].value,
1458 ET[ET[ET[i].right].right].value,
1459 branch_other, !flag);
1460 i = ET[ET[i].right].right; arity -= 2;
1461 }
1462 }
1463 else
1464 { /* Otherwise we can compare the left_operand with
1465 only one right operand at the time. There are
1466 two cases: it's the last right operand, or it
1467 isn't. */
1468
1469 if ((arity == 1) || flag)
1470 compile_conditional_z(oc, left_operand,
1471 ET[i].value, branch_away, flag);
1472 else
1473 compile_conditional_z(oc, left_operand,
1474 ET[i].value, branch_other, !flag);
1475 }
1476 i = ET[i].right; arity--;
1477 }
1478
1479 }
1480 }
1481
1482 /* NB: These two conditions cannot both occur, fortunately! */
1483
1484 if (make_branch_label) assemble_label_no(branch_other);
1485 if (make_jump_away) assemblez_jump(branch_other);
1486
1487 goto OperatorGenerated;
1488 }
1489
1490 }
1491 else {
1492 if (operators[opnum].opcode_number_g >= FIRST_CC
1493 && operators[opnum].opcode_number_g <= LAST_CC) {
1494 /* Conditional terms such as '==': */
1495
1496 int a = ET[n].true_label, b = ET[n].false_label;
1497 int branch_away, branch_other, flag,
1498 make_jump_away = FALSE, make_branch_label = FALSE;
1499 int ccode = operators[opnum].opcode_number_g;
1500 condclass *cc = &condclasses[(ccode-FIRST_CC) / 2];
1501 flag = (ccode & 1) ? 0 : 1;
1502
1503 /* If the comparison is "equal to (constant) 0", change it
1504 to the simple "zero" test. Unfortunately, this doesn't
1505 work for the commutative form "(constant) 0 is equal to".
1506 At least I don't think it does. */
1507
1508 if ((cc == &condclasses[1]) && (arity == 2)) {
1509 i = ET[ET[n].down].right;
1510 if ((ET[i].value.value == 0)
1511 && (ET[i].value.marker == 0)
1512 && is_constant_ot(ET[i].value.type)) {
1513 cc = &condclasses[0];
1514 }
1515 }
1516
1517 /* If the condition has truth state flag, branch to
1518 label a, and if not, to label b. Possibly one of a, b
1519 equals -1, meaning "continue from this instruction".
1520
1521 branch_away is the label which is a branch away (the one
1522 which isn't immediately after) and flag is the truth
1523 state to branch there.
1524
1525 Note that when multiple instructions are needed (because
1526 of the use of the 'or' operator) the branch_other label
1527 is created if need be.
1528 */
1529
1530 /* Reduce to the case where the branch_away label does exist: */
1531
1532 if (a == -1) { a = b; b = -1; flag = !flag; }
1533
1534 branch_away = a; branch_other = b;
1535 if (branch_other != -1) make_jump_away = TRUE;
1536
1537 if ((arity > 2) && (flag == FALSE)) {
1538 /* In this case, we have an 'or' situation where multiple
1539 instructions are needed and where the overall condition
1540 is negated. That is, we have, e.g.
1541
1542 if not (A cond B or C or D) then branch_away
1543
1544 which we transform into
1545
1546 if (A cond B) then branch_other
1547 if (A cond C) then branch_other
1548 if not (A cond D) then branch_away
1549 .branch_other */
1550
1551 if (branch_other == -1) {
1552 branch_other = next_label++; make_branch_label = TRUE;
1553 }
1554 }
1555
1556 if (cc == &condclasses[0]) {
1557 assembleg_1_branch((flag ? cc->posform : cc->negform),
1558 ET[below].value, branch_away);
1559 }
1560 else {
1561 if (arity == 2) {
1562 compile_conditional_g(cc, ET[below].value,
1563 ET[ET[below].right].value, branch_away, flag);
1564 }
1565 else {
1566 /* The case of a condition using "or".
1567 First: if the condition tests the stack pointer,
1568 and it can't always be done in a single test, move
1569 the value off the stack and into temporary variable
1570 storage. */
1571
1572 assembly_operand left_operand;
1573 if (((ET[below].value.type == LOCALVAR_OT)
1574 && (ET[below].value.value == 0))) {
1575 assembleg_store(temp_var1, ET[below].value);
1576 left_operand = temp_var1;
1577 }
1578 else {
1579 left_operand = ET[below].value;
1580 }
1581 i = ET[below].right;
1582 arity--;
1583
1584 /* "left_operand" now holds the quantity to be tested;
1585 "i" holds the right operand reached so far;
1586 "arity" the number of right operands. */
1587
1588 while (i != -1) {
1589 /* We can compare the left_operand with
1590 only one right operand at the time. There are
1591 two cases: it's the last right operand, or it
1592 isn't. */
1593
1594 if ((arity == 1) || flag)
1595 compile_conditional_g(cc, left_operand,
1596 ET[i].value, branch_away, flag);
1597 else
1598 compile_conditional_g(cc, left_operand,
1599 ET[i].value, branch_other, !flag);
1600
1601 i = ET[i].right;
1602 arity--;
1603 }
1604 }
1605 }
1606
1607 /* NB: These two conditions cannot both occur, fortunately! */
1608
1609 if (make_branch_label) assemble_label_no(branch_other);
1610 if (make_jump_away) assembleg_jump(branch_other);
1611
1612 goto OperatorGenerated;
1613 }
1614
1615 }
1616
1617 /* The operator is now definitely one which produces a value */
1618
1619 if (void_flag && (!(operators[opnum].side_effect)))
1620 error_named("Evaluating this has no effect:",
1621 operators[opnum].description);
1622
1623 /* Where shall we put the resulting value? (In Glulx, this could
1624 be smarter, and peg the result into ZEROCONSTANT.) */
1625
1626 if (void_flag) Result = temp_var1; /* Throw it away */
1627 else
1628 { if ((above != -1) && (ET[above].operator_number == SETEQUALS_OP))
1629 {
1630 /* If the node above is "set variable equal to", then
1631 make that variable the place to put the result, and
1632 delete the SETEQUALS_OP node since its effect has already
1633 been accomplished. */
1634
1635 ET[above].operator_number = -1;
1636 Result = ET[ET[above].down].value;
1637 ET[above].value = Result;
1638 }
1639 else Result = stack_pointer; /* Otherwise, put it on the stack */
1640 }
1641
1642 if (!glulx_mode) {
1643
1644 if (operators[opnum].opcode_number_z != -1)
1645 {
1646 /* Operators directly translatable into Z-code opcodes: infix ops
1647 take two operands whereas pre/postfix operators take only one */
1648
1649 if (operators[opnum].usage == IN_U)
1650 { int o_n = operators[opnum].opcode_number_z;
1651 if (runtime_error_checking_switch && (!veneer_mode)
1652 && ((o_n == div_zc) || (o_n == mod_zc)))
1653 { assembly_operand by_ao, error_ao; int ln;
1654 by_ao = ET[ET[below].right].value;
1655 if ((by_ao.value != 0) && (by_ao.marker == 0)
1656 && ((by_ao.type == SHORT_CONSTANT_OT)
1657 || (by_ao.type == LONG_CONSTANT_OT)))
1658 assemblez_2_to(o_n, ET[below].value,
1659 by_ao, Result);
1660 else
1661 {
1662 assemblez_store(temp_var1, ET[below].value);
1663 assemblez_store(temp_var2, by_ao);
1664 ln = next_label++;
1665 assemblez_1_branch(jz_zc, temp_var2, ln, FALSE);
1666 error_ao.type = SHORT_CONSTANT_OT; error_ao.marker = 0;
1667 error_ao.value = DBYZERO_RTE;
1668 assemblez_2(call_vn_zc, veneer_routine(RT__Err_VR),
1669 error_ao);
1670 assemblez_inc(temp_var2);
1671 assemble_label_no(ln);
1672 assemblez_2_to(o_n, temp_var1, temp_var2, Result);
1673 }
1674 }
1675 else {
1676 assemblez_2_to(o_n, ET[below].value,
1677 ET[ET[below].right].value, Result);
1678 }
1679 }
1680 else
1681 assemblez_1_to(operators[opnum].opcode_number_z, ET[below].value,
1682 Result);
1683 }
1684 else
1685 switch(opnum)
1686 { case ARROW_OP:
1687 access_memory_z(loadb_zc, ET[below].value,
1688 ET[ET[below].right].value, Result);
1689 break;
1690 case DARROW_OP:
1691 access_memory_z(loadw_zc, ET[below].value,
1692 ET[ET[below].right].value, Result);
1693 break;
1694 case UNARY_MINUS_OP:
1695 assemblez_2_to(sub_zc, zero_operand, ET[below].value, Result);
1696 break;
1697 case ARTNOT_OP:
1698 assemblez_1_to(not_zc, ET[below].value, Result);
1699 break;
1700
1701 case PROP_ADD_OP:
1702 { assembly_operand AO = ET[below].value;
1703 if (runtime_error_checking_switch && (!veneer_mode))
1704 AO = check_nonzero_at_runtime(AO, -1, PROP_ADD_RTE);
1705 assemblez_2_to(get_prop_addr_zc, AO,
1706 ET[ET[below].right].value, temp_var1);
1707 if (!void_flag) write_result_z(Result, temp_var1);
1708 }
1709 break;
1710
1711 case PROP_NUM_OP:
1712 { assembly_operand AO = ET[below].value;
1713 if (runtime_error_checking_switch && (!veneer_mode))
1714 AO = check_nonzero_at_runtime(AO, -1, PROP_NUM_RTE);
1715 assemblez_2_to(get_prop_addr_zc, AO,
1716 ET[ET[below].right].value, temp_var1);
1717 assemblez_1_branch(jz_zc, temp_var1, next_label++, TRUE);
1718 assemblez_1_to(get_prop_len_zc, temp_var1, temp_var1);
1719 assemble_label_no(next_label-1);
1720 if (!void_flag) write_result_z(Result, temp_var1);
1721 }
1722 break;
1723
1724 case PROPERTY_OP:
1725 { assembly_operand AO = ET[below].value;
1726
1727 if (runtime_error_checking_switch && (!veneer_mode))
1728 assemblez_3_to(call_vs_zc, veneer_routine(RT__ChPR_VR),
1729 AO, ET[ET[below].right].value, temp_var1);
1730 else
1731 assemblez_2_to(get_prop_zc, AO,
1732 ET[ET[below].right].value, temp_var1);
1733 if (!void_flag) write_result_z(Result, temp_var1);
1734 }
1735 break;
1736
1737 case MESSAGE_OP:
1738 j=1; AI.operand[0] = veneer_routine(RV__Pr_VR);
1739 goto GenFunctionCallZ;
1740 case MPROP_ADD_OP:
1741 j=1; AI.operand[0] = veneer_routine(RA__Pr_VR);
1742 goto GenFunctionCallZ;
1743 case MPROP_NUM_OP:
1744 j=1; AI.operand[0] = veneer_routine(RL__Pr_VR);
1745 goto GenFunctionCallZ;
1746 case MESSAGE_SETEQUALS_OP:
1747 j=1; AI.operand[0] = veneer_routine(WV__Pr_VR);
1748 goto GenFunctionCallZ;
1749 case MESSAGE_INC_OP:
1750 j=1; AI.operand[0] = veneer_routine(IB__Pr_VR);
1751 goto GenFunctionCallZ;
1752 case MESSAGE_DEC_OP:
1753 j=1; AI.operand[0] = veneer_routine(DB__Pr_VR);
1754 goto GenFunctionCallZ;
1755 case MESSAGE_POST_INC_OP:
1756 j=1; AI.operand[0] = veneer_routine(IA__Pr_VR);
1757 goto GenFunctionCallZ;
1758 case MESSAGE_POST_DEC_OP:
1759 j=1; AI.operand[0] = veneer_routine(DA__Pr_VR);
1760 goto GenFunctionCallZ;
1761 case SUPERCLASS_OP:
1762 j=1; AI.operand[0] = veneer_routine(RA__Sc_VR);
1763 goto GenFunctionCallZ;
1764 case PROP_CALL_OP:
1765 j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
1766 goto GenFunctionCallZ;
1767 case MESSAGE_CALL_OP:
1768 j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
1769 goto GenFunctionCallZ;
1770
1771
1772 case FCALL_OP:
1773 j = 0;
1774
1775 if ((ET[below].value.type == VARIABLE_OT)
1776 && (ET[below].value.value >= 256))
1777 { int sf_number = ET[below].value.value - 256;
1778
1779 i = ET[below].right;
1780 if (i == -1)
1781 { error("Argument to system function missing");
1782 AI.operand[0] = one_operand;
1783 AI.operand_count = 1;
1784 }
1785 else
1786 { j=0;
1787 while (i != -1) { j++; i = ET[i].right; }
1788
1789 if (((sf_number != INDIRECT_SYSF) &&
1790 (sf_number != RANDOM_SYSF) && (j > 1))
1791 || ((sf_number == INDIRECT_SYSF) && (j>7)))
1792 { j=1;
1793 error("System function given with too many arguments");
1794 }
1795 if (sf_number != RANDOM_SYSF)
1796 { int jcount;
1797 i = ET[below].right;
1798 for (jcount = 0; jcount < j; jcount++)
1799 { AI.operand[jcount] = ET[i].value;
1800 i = ET[i].right;
1801 }
1802 AI.operand_count = j;
1803 }
1804 }
1805 AI.store_variable_number = Result.value;
1806 AI.branch_label_number = -1;
1807
1808 switch(sf_number)
1809 { case RANDOM_SYSF:
1810 if (j>1)
1811 { assembly_operand AO, AO2; int arg_c, arg_et;
1812 AO.value = j; AO.marker = 0;
1813 AO.type = SHORT_CONSTANT_OT;
1814 AO2.type = LONG_CONSTANT_OT;
1815 AO2.value = begin_word_array();
1816 AO2.marker = ARRAY_MV;
1817
1818 for (arg_c=0, arg_et = ET[below].right;arg_c<j;
1819 arg_c++, arg_et = ET[arg_et].right)
1820 { if (ET[arg_et].value.type == VARIABLE_OT)
1821 error("Only constants can be used as possible 'random' results");
1822 array_entry(arg_c, ET[arg_et].value);
1823 }
1824 finish_array(arg_c);
1825
1826 assemblez_1_to(random_zc, AO, temp_var1);
1827 assemblez_dec(temp_var1);
1828 assemblez_2_to(loadw_zc, AO2, temp_var1, Result);
1829 }
1830 else
1831 assemblez_1_to(random_zc,
1832 ET[ET[below].right].value, Result);
1833 break;
1834
1835 case PARENT_SYSF:
1836 { assembly_operand AO;
1837 AO = ET[ET[below].right].value;
1838 if (runtime_error_checking_switch)
1839 AO = check_nonzero_at_runtime(AO, -1,
1840 PARENT_RTE);
1841 assemblez_1_to(get_parent_zc, AO, Result);
1842 }
1843 break;
1844
1845 case ELDEST_SYSF:
1846 case CHILD_SYSF:
1847 { assembly_operand AO;
1848 AO = ET[ET[below].right].value;
1849 if (runtime_error_checking_switch)
1850 AO = check_nonzero_at_runtime(AO, -1,
1851 (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
1852 assemblez_objcode(get_child_zc,
1853 AO, Result, -2, TRUE);
1854 }
1855 break;
1856
1857 case YOUNGER_SYSF:
1858 case SIBLING_SYSF:
1859 { assembly_operand AO;
1860 AO = ET[ET[below].right].value;
1861 if (runtime_error_checking_switch)
1862 AO = check_nonzero_at_runtime(AO, -1,
1863 (sf_number==SIBLING_SYSF)
1864 ?SIBLING_RTE:YOUNGER_RTE);
1865 assemblez_objcode(get_sibling_zc,
1866 AO, Result, -2, TRUE);
1867 }
1868 break;
1869
1870 case INDIRECT_SYSF:
1871 j=0; i = ET[below].right;
1872 goto IndirectFunctionCallZ;
1873
1874 case CHILDREN_SYSF:
1875 { assembly_operand AO;
1876 AO = ET[ET[below].right].value;
1877 if (runtime_error_checking_switch)
1878 AO = check_nonzero_at_runtime(AO, -1,
1879 CHILDREN_RTE);
1880 assemblez_store(temp_var1, zero_operand);
1881 assemblez_objcode(get_child_zc,
1882 AO, stack_pointer, next_label+1, FALSE);
1883 assemble_label_no(next_label);
1884 assemblez_inc(temp_var1);
1885 assemblez_objcode(get_sibling_zc,
1886 stack_pointer, stack_pointer,
1887 next_label, TRUE);
1888 assemble_label_no(next_label+1);
1889 assemblez_store(temp_var2, stack_pointer);
1890 if (!void_flag) write_result_z(Result, temp_var1);
1891 next_label += 2;
1892 }
1893 break;
1894
1895 case YOUNGEST_SYSF:
1896 { assembly_operand AO;
1897 AO = ET[ET[below].right].value;
1898 if (runtime_error_checking_switch)
1899 AO = check_nonzero_at_runtime(AO, -1,
1900 YOUNGEST_RTE);
1901 assemblez_objcode(get_child_zc,
1902 AO, temp_var1, next_label+1, FALSE);
1903 assemblez_1(push_zc, temp_var1);
1904 assemble_label_no(next_label);
1905 assemblez_store(temp_var1, stack_pointer);
1906 assemblez_objcode(get_sibling_zc,
1907 temp_var1, stack_pointer, next_label, TRUE);
1908 assemble_label_no(next_label+1);
1909 if (!void_flag) write_result_z(Result, temp_var1);
1910 next_label += 2;
1911 }
1912 break;
1913
1914 case ELDER_SYSF:
1915 assemblez_store(temp_var1, ET[ET[below].right].value);
1916 if (runtime_error_checking_switch)
1917 check_nonzero_at_runtime(temp_var1, -1,
1918 ELDER_RTE);
1919 assemblez_1_to(get_parent_zc, temp_var1, temp_var3);
1920 assemblez_1_branch(jz_zc, temp_var3,next_label+1,TRUE);
1921 assemblez_store(temp_var2, temp_var3);
1922 assemblez_store(temp_var3, zero_operand);
1923 assemblez_objcode(get_child_zc,
1924 temp_var2, temp_var2, next_label, TRUE);
1925 assemble_label_no(next_label++);
1926 assemblez_2_branch(je_zc, temp_var1, temp_var2,
1927 next_label, TRUE);
1928 assemblez_store(temp_var3, temp_var2);
1929 assemblez_objcode(get_sibling_zc,
1930 temp_var2, temp_var2, next_label - 1, TRUE);
1931 assemble_label_no(next_label++);
1932 if (!void_flag) write_result_z(Result, temp_var3);
1933 break;
1934
1935 case METACLASS_SYSF:
1936 assemblez_2_to((version_number==3)?call_zc:call_vs_zc,
1937 veneer_routine(Metaclass_VR),
1938 ET[ET[below].right].value, Result);
1939 break;
1940
1941 case GLK_SYSF:
1942 error("The glk() system function does not exist in Z-code");
1943 break;
1944 }
1945 break;
1946 }
1947
1948 GenFunctionCallZ:
1949
1950 i = below;
1951
1952 IndirectFunctionCallZ:
1953
1954 while ((i != -1) && (j<8))
1955 { AI.operand[j++] = ET[i].value;
1956 i = ET[i].right;
1957 }
1958
1959 if ((j > 4) && (version_number == 3))
1960 { error("A function may be called with at most 3 arguments");
1961 j = 4;
1962 }
1963 if ((j==8) && (i != -1))
1964 { error("A function may be called with at most 7 arguments");
1965 }
1966
1967 AI.operand_count = j;
1968
1969 if ((void_flag) && (version_number >= 5))
1970 { AI.store_variable_number = -1;
1971 switch(j)
1972 { case 1: AI.internal_number = call_1n_zc; break;
1973 case 2: AI.internal_number = call_2n_zc; break;
1974 case 3: case 4: AI.internal_number = call_vn_zc; break;
1975 case 5: case 6: case 7: case 8:
1976 AI.internal_number = call_vn2_zc; break;
1977 }
1978 }
1979 else
1980 { AI.store_variable_number = Result.value;
1981 if (version_number == 3)
1982 AI.internal_number = call_zc;
1983 else
1984 switch(j)
1985 { case 1: AI.internal_number = call_1s_zc; break;
1986 case 2: AI.internal_number = call_2s_zc; break;
1987 case 3: case 4: AI.internal_number = call_vs_zc; break;
1988 case 5: case 6: case 7: case 8:
1989 AI.internal_number = call_vs2_zc; break;
1990 }
1991 }
1992
1993 AI.branch_label_number = -1;
1994 assemblez_instruction(&AI);
1995 break;
1996
1997 case SETEQUALS_OP:
1998 assemblez_store(ET[below].value,
1999 ET[ET[below].right].value);
2000 if (!void_flag) write_result_z(Result, ET[below].value);
2001 break;
2002
2003 case PROPERTY_SETEQUALS_OP:
2004 if (!void_flag)
2005 { if (runtime_error_checking_switch)
2006 assemblez_4_to(call_zc, veneer_routine(RT__ChPS_VR),
2007 ET[below].value, ET[ET[below].right].value,
2008 ET[ET[ET[below].right].right].value, Result);
2009 else
2010 { assemblez_store(temp_var1,
2011 ET[ET[ET[below].right].right].value);
2012 assemblez_3(put_prop_zc, ET[below].value,
2013 ET[ET[below].right].value,
2014 temp_var1);
2015 write_result_z(Result, temp_var1);
2016 }
2017 }
2018 else
2019 { if (runtime_error_checking_switch && (!veneer_mode))
2020 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2021 ET[below].value, ET[ET[below].right].value,
2022 ET[ET[ET[below].right].right].value);
2023 else assemblez_3(put_prop_zc, ET[below].value,
2024 ET[ET[below].right].value,
2025 ET[ET[ET[below].right].right].value);
2026 }
2027 break;
2028 case ARROW_SETEQUALS_OP:
2029 if (!void_flag)
2030 { assemblez_store(temp_var1,
2031 ET[ET[ET[below].right].right].value);
2032 access_memory_z(storeb_zc, ET[below].value,
2033 ET[ET[below].right].value,
2034 temp_var1);
2035 write_result_z(Result, temp_var1);
2036 }
2037 else access_memory_z(storeb_zc, ET[below].value,
2038 ET[ET[below].right].value,
2039 ET[ET[ET[below].right].right].value);
2040 break;
2041
2042 case DARROW_SETEQUALS_OP:
2043 if (!void_flag)
2044 { assemblez_store(temp_var1,
2045 ET[ET[ET[below].right].right].value);
2046 access_memory_z(storew_zc, ET[below].value,
2047 ET[ET[below].right].value,
2048 temp_var1);
2049 write_result_z(Result, temp_var1);
2050 }
2051 else
2052 access_memory_z(storew_zc, ET[below].value,
2053 ET[ET[below].right].value,
2054 ET[ET[ET[below].right].right].value);
2055 break;
2056
2057 case INC_OP:
2058 assemblez_inc(ET[below].value);
2059 if (!void_flag) write_result_z(Result, ET[below].value);
2060 break;
2061 case DEC_OP:
2062 assemblez_dec(ET[below].value);
2063 if (!void_flag) write_result_z(Result, ET[below].value);
2064 break;
2065 case POST_INC_OP:
2066 if (!void_flag) write_result_z(Result, ET[below].value);
2067 assemblez_inc(ET[below].value);
2068 break;
2069 case POST_DEC_OP:
2070 if (!void_flag) write_result_z(Result, ET[below].value);
2071 assemblez_dec(ET[below].value);
2072 break;
2073
2074 case ARROW_INC_OP:
2075 assemblez_store(temp_var1, ET[below].value);
2076 assemblez_store(temp_var2, ET[ET[below].right].value);
2077 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2078 assemblez_inc(temp_var3);
2079 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2080 if (!void_flag) write_result_z(Result, temp_var3);
2081 break;
2082
2083 case ARROW_DEC_OP:
2084 assemblez_store(temp_var1, ET[below].value);
2085 assemblez_store(temp_var2, ET[ET[below].right].value);
2086 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2087 assemblez_dec(temp_var3);
2088 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2089 if (!void_flag) write_result_z(Result, temp_var3);
2090 break;
2091
2092 case ARROW_POST_INC_OP:
2093 assemblez_store(temp_var1, ET[below].value);
2094 assemblez_store(temp_var2, ET[ET[below].right].value);
2095 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2096 if (!void_flag) write_result_z(Result, temp_var3);
2097 assemblez_inc(temp_var3);
2098 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2099 break;
2100
2101 case ARROW_POST_DEC_OP:
2102 assemblez_store(temp_var1, ET[below].value);
2103 assemblez_store(temp_var2, ET[ET[below].right].value);
2104 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2105 if (!void_flag) write_result_z(Result, temp_var3);
2106 assemblez_dec(temp_var3);
2107 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2108 break;
2109
2110 case DARROW_INC_OP:
2111 assemblez_store(temp_var1, ET[below].value);
2112 assemblez_store(temp_var2, ET[ET[below].right].value);
2113 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2114 assemblez_inc(temp_var3);
2115 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2116 if (!void_flag) write_result_z(Result, temp_var3);
2117 break;
2118
2119 case DARROW_DEC_OP:
2120 assemblez_store(temp_var1, ET[below].value);
2121 assemblez_store(temp_var2, ET[ET[below].right].value);
2122 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2123 assemblez_dec(temp_var3);
2124 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2125 if (!void_flag) write_result_z(Result, temp_var3);
2126 break;
2127
2128 case DARROW_POST_INC_OP:
2129 assemblez_store(temp_var1, ET[below].value);
2130 assemblez_store(temp_var2, ET[ET[below].right].value);
2131 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2132 if (!void_flag) write_result_z(Result, temp_var3);
2133 assemblez_inc(temp_var3);
2134 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2135 break;
2136
2137 case DARROW_POST_DEC_OP:
2138 assemblez_store(temp_var1, ET[below].value);
2139 assemblez_store(temp_var2, ET[ET[below].right].value);
2140 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2141 if (!void_flag) write_result_z(Result, temp_var3);
2142 assemblez_dec(temp_var3);
2143 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2144 break;
2145
2146 case PROPERTY_INC_OP:
2147 assemblez_store(temp_var1, ET[below].value);
2148 assemblez_store(temp_var2, ET[ET[below].right].value);
2149 assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2150 assemblez_inc(temp_var3);
2151 if (runtime_error_checking_switch && (!veneer_mode))
2152 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2153 temp_var1, temp_var2, temp_var3);
2154 else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2155 if (!void_flag) write_result_z(Result, temp_var3);
2156 break;
2157
2158 case PROPERTY_DEC_OP:
2159 assemblez_store(temp_var1, ET[below].value);
2160 assemblez_store(temp_var2, ET[ET[below].right].value);
2161 assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2162 assemblez_dec(temp_var3);
2163 if (runtime_error_checking_switch && (!veneer_mode))
2164 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2165 temp_var1, temp_var2, temp_var3);
2166 else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2167 if (!void_flag) write_result_z(Result, temp_var3);
2168 break;
2169
2170 case PROPERTY_POST_INC_OP:
2171 assemblez_store(temp_var1, ET[below].value);
2172 assemblez_store(temp_var2, ET[ET[below].right].value);
2173 assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2174 if (!void_flag) write_result_z(Result, temp_var3);
2175 assemblez_inc(temp_var3);
2176 if (runtime_error_checking_switch && (!veneer_mode))
2177 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2178 temp_var1, temp_var2, temp_var3);
2179 else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2180 break;
2181
2182 case PROPERTY_POST_DEC_OP:
2183 assemblez_store(temp_var1, ET[below].value);
2184 assemblez_store(temp_var2, ET[ET[below].right].value);
2185 assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2186 if (!void_flag) write_result_z(Result, temp_var3);
2187 assemblez_dec(temp_var3);
2188 if (runtime_error_checking_switch && (!veneer_mode))
2189 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2190 temp_var1, temp_var2, temp_var3);
2191 else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2192 break;
2193
2194 default:
2195 printf("** Trouble op = %d i.e. '%s' **\n",
2196 opnum, operators[opnum].description);
2197 compiler_error("Expr code gen: Can't generate yet");
2198 }
2199 }
2200 else {
2201 assembly_operand AO, AO2;
2202 if (operators[opnum].opcode_number_g != -1)
2203 {
2204 /* Operators directly translatable into opcodes: infix ops
2205 take two operands whereas pre/postfix operators take only one */
2206
2207 if (operators[opnum].usage == IN_U)
2208 { int o_n = operators[opnum].opcode_number_g;
2209 if (runtime_error_checking_switch && (!veneer_mode)
2210 && ((o_n == div_gc) || (o_n == mod_gc)))
2211 { assembly_operand by_ao, error_ao; int ln;
2212 by_ao = ET[ET[below].right].value;
2213 if ((by_ao.value != 0) && (by_ao.marker == 0)
2214 && is_constant_ot(by_ao.type))
2215 assembleg_3(o_n, ET[below].value,
2216 by_ao, Result);
2217 else
2218 { assembleg_store(temp_var1, ET[below].value);
2219 assembleg_store(temp_var2, by_ao);
2220 ln = next_label++;
2221 assembleg_1_branch(jnz_gc, temp_var2, ln);
2222 error_ao.marker = 0;
2223 error_ao.value = DBYZERO_RTE;
2224 set_constant_ot(&error_ao);
2225 assembleg_call_1(veneer_routine(RT__Err_VR),
2226 error_ao, zero_operand);
2227 assembleg_store(temp_var2, one_operand);
2228 assemble_label_no(ln);
2229 assembleg_3(o_n, temp_var1, temp_var2, Result);
2230 }
2231 }
2232 else
2233 assembleg_3(o_n, ET[below].value,
2234 ET[ET[below].right].value, Result);
2235 }
2236 else
2237 assembleg_2(operators[opnum].opcode_number_g, ET[below].value,
2238 Result);
2239 }
2240 else
2241 switch(opnum)
2242 {
2243
2244 case PUSH_OP:
2245 if (ET[below].value.type == Result.type
2246 && ET[below].value.value == Result.value
2247 && ET[below].value.marker == Result.marker)
2248 break;
2249 assembleg_2(copy_gc, ET[below].value, Result);
2250 break;
2251
2252 case UNARY_MINUS_OP:
2253 assembleg_2(neg_gc, ET[below].value, Result);
2254 break;
2255 case ARTNOT_OP:
2256 assembleg_2(bitnot_gc, ET[below].value, Result);
2257 break;
2258
2259 case ARROW_OP:
2260 access_memory_g(aloadb_gc, ET[below].value,
2261 ET[ET[below].right].value, Result);
2262 break;
2263 case DARROW_OP:
2264 access_memory_g(aload_gc, ET[below].value,
2265 ET[ET[below].right].value, Result);
2266 break;
2267
2268 case SETEQUALS_OP:
2269 assembleg_store(ET[below].value,
2270 ET[ET[below].right].value);
2271 if (!void_flag) write_result_g(Result, ET[below].value);
2272 break;
2273
2274 case ARROW_SETEQUALS_OP:
2275 if (!void_flag)
2276 { assembleg_store(temp_var1,
2277 ET[ET[ET[below].right].right].value);
2278 access_memory_g(astoreb_gc, ET[below].value,
2279 ET[ET[below].right].value,
2280 temp_var1);
2281 write_result_g(Result, temp_var1);
2282 }
2283 else access_memory_g(astoreb_gc, ET[below].value,
2284 ET[ET[below].right].value,
2285 ET[ET[ET[below].right].right].value);
2286 break;
2287
2288 case DARROW_SETEQUALS_OP:
2289 if (!void_flag)
2290 { assembleg_store(temp_var1,
2291 ET[ET[ET[below].right].right].value);
2292 access_memory_g(astore_gc, ET[below].value,
2293 ET[ET[below].right].value,
2294 temp_var1);
2295 write_result_g(Result, temp_var1);
2296 }
2297 else
2298 access_memory_g(astore_gc, ET[below].value,
2299 ET[ET[below].right].value,
2300 ET[ET[ET[below].right].right].value);
2301 break;
2302
2303 case INC_OP:
2304 assembleg_inc(ET[below].value);
2305 if (!void_flag) write_result_g(Result, ET[below].value);
2306 break;
2307 case DEC_OP:
2308 assembleg_dec(ET[below].value);
2309 if (!void_flag) write_result_g(Result, ET[below].value);
2310 break;
2311 case POST_INC_OP:
2312 if (!void_flag) write_result_g(Result, ET[below].value);
2313 assembleg_inc(ET[below].value);
2314 break;
2315 case POST_DEC_OP:
2316 if (!void_flag) write_result_g(Result, ET[below].value);
2317 assembleg_dec(ET[below].value);
2318 break;
2319
2320 case ARROW_INC_OP:
2321 assembleg_store(temp_var1, ET[below].value);
2322 assembleg_store(temp_var2, ET[ET[below].right].value);
2323 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2324 assembleg_inc(temp_var3);
2325 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2326 if (!void_flag) write_result_g(Result, temp_var3);
2327 break;
2328
2329 case ARROW_DEC_OP:
2330 assembleg_store(temp_var1, ET[below].value);
2331 assembleg_store(temp_var2, ET[ET[below].right].value);
2332 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2333 assembleg_dec(temp_var3);
2334 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2335 if (!void_flag) write_result_g(Result, temp_var3);
2336 break;
2337
2338 case ARROW_POST_INC_OP:
2339 assembleg_store(temp_var1, ET[below].value);
2340 assembleg_store(temp_var2, ET[ET[below].right].value);
2341 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2342 if (!void_flag) write_result_g(Result, temp_var3);
2343 assembleg_inc(temp_var3);
2344 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2345 break;
2346
2347 case ARROW_POST_DEC_OP:
2348 assembleg_store(temp_var1, ET[below].value);
2349 assembleg_store(temp_var2, ET[ET[below].right].value);
2350 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2351 if (!void_flag) write_result_g(Result, temp_var3);
2352 assembleg_dec(temp_var3);
2353 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2354 break;
2355
2356 case DARROW_INC_OP:
2357 assembleg_store(temp_var1, ET[below].value);
2358 assembleg_store(temp_var2, ET[ET[below].right].value);
2359 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2360 assembleg_inc(temp_var3);
2361 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2362 if (!void_flag) write_result_g(Result, temp_var3);
2363 break;
2364
2365 case DARROW_DEC_OP:
2366 assembleg_store(temp_var1, ET[below].value);
2367 assembleg_store(temp_var2, ET[ET[below].right].value);
2368 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2369 assembleg_dec(temp_var3);
2370 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2371 if (!void_flag) write_result_g(Result, temp_var3);
2372 break;
2373
2374 case DARROW_POST_INC_OP:
2375 assembleg_store(temp_var1, ET[below].value);
2376 assembleg_store(temp_var2, ET[ET[below].right].value);
2377 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2378 if (!void_flag) write_result_g(Result, temp_var3);
2379 assembleg_inc(temp_var3);
2380 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2381 break;
2382
2383 case DARROW_POST_DEC_OP:
2384 assembleg_store(temp_var1, ET[below].value);
2385 assembleg_store(temp_var2, ET[ET[below].right].value);
2386 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2387 if (!void_flag) write_result_g(Result, temp_var3);
2388 assembleg_dec(temp_var3);
2389 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2390 break;
2391
2392 case PROPERTY_OP:
2393 case MESSAGE_OP:
2394 AO = veneer_routine(RV__Pr_VR);
2395 goto TwoArgFunctionCall;
2396 case MPROP_ADD_OP:
2397 case PROP_ADD_OP:
2398 AO = veneer_routine(RA__Pr_VR);
2399 goto TwoArgFunctionCall;
2400 case MPROP_NUM_OP:
2401 case PROP_NUM_OP:
2402 AO = veneer_routine(RL__Pr_VR);
2403 goto TwoArgFunctionCall;
2404
2405 case PROP_CALL_OP:
2406 case MESSAGE_CALL_OP:
2407 AO2 = veneer_routine(CA__Pr_VR);
2408 i = below;
2409 goto DoFunctionCall;
2410
2411 case MESSAGE_INC_OP:
2412 case PROPERTY_INC_OP:
2413 AO = veneer_routine(IB__Pr_VR);
2414 goto TwoArgFunctionCall;
2415 case MESSAGE_DEC_OP:
2416 case PROPERTY_DEC_OP:
2417 AO = veneer_routine(DB__Pr_VR);
2418 goto TwoArgFunctionCall;
2419 case MESSAGE_POST_INC_OP:
2420 case PROPERTY_POST_INC_OP:
2421 AO = veneer_routine(IA__Pr_VR);
2422 goto TwoArgFunctionCall;
2423 case MESSAGE_POST_DEC_OP:
2424 case PROPERTY_POST_DEC_OP:
2425 AO = veneer_routine(DA__Pr_VR);
2426 goto TwoArgFunctionCall;
2427 case SUPERCLASS_OP:
2428 AO = veneer_routine(RA__Sc_VR);
2429 goto TwoArgFunctionCall;
2430
2431 TwoArgFunctionCall:
2432 {
2433 assembly_operand AO2 = ET[below].value;
2434 assembly_operand AO3 = ET[ET[below].right].value;
2435 if (void_flag)
2436 assembleg_call_2(AO, AO2, AO3, zero_operand);
2437 else
2438 assembleg_call_2(AO, AO2, AO3, Result);
2439 }
2440 break;
2441
2442 case PROPERTY_SETEQUALS_OP:
2443 case MESSAGE_SETEQUALS_OP:
2444 if (runtime_error_checking_switch && (!veneer_mode))
2445 AO = veneer_routine(RT__ChPS_VR);
2446 else
2447 AO = veneer_routine(WV__Pr_VR);
2448
2449 {
2450 assembly_operand AO2 = ET[below].value;
2451 assembly_operand AO3 = ET[ET[below].right].value;
2452 assembly_operand AO4 = ET[ET[ET[below].right].right].value;
2453 if (AO4.type == LOCALVAR_OT && AO4.value == 0) {
2454 /* Rightmost is on the stack; reduce to previous case. */
2455 if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2456 if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2457 /* both already on stack. */
2458 }
2459 else {
2460 assembleg_store(stack_pointer, AO3);
2461 assembleg_0(stkswap_gc);
2462 }
2463 }
2464 else {
2465 if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2466 assembleg_store(stack_pointer, AO2);
2467 }
2468 else {
2469 assembleg_store(stack_pointer, AO3);
2470 assembleg_store(stack_pointer, AO2);
2471 }
2472 }
2473 }
2474 else {
2475 /* We have to get the rightmost on the stack, below the
2476 others. */
2477 if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2478 if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2479 assembleg_store(stack_pointer, AO4);
2480 assembleg_2(stkroll_gc, three_operand, one_operand);
2481 }
2482 else {
2483 assembleg_store(stack_pointer, AO4);
2484 assembleg_0(stkswap_gc);
2485 assembleg_store(stack_pointer, AO2);
2486 }
2487 }
2488 else {
2489 if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2490 assembleg_store(stack_pointer, AO4);
2491 assembleg_store(stack_pointer, AO3);
2492 assembleg_2(stkroll_gc, three_operand, two_operand);
2493 }
2494 else {
2495 assembleg_store(stack_pointer, AO4);
2496 assembleg_store(stack_pointer, AO3);
2497 assembleg_store(stack_pointer, AO2);
2498 }
2499 }
2500 }
2501 if (void_flag)
2502 assembleg_3(call_gc, AO, three_operand, zero_operand);
2503 else
2504 assembleg_3(call_gc, AO, three_operand, Result);
2505 }
2506 break;
2507
2508 case FCALL_OP:
2509 j = 0;
2510
2511 if (ET[below].value.type == SYSFUN_OT)
2512 { int sf_number = ET[below].value.value;
2513
2514 i = ET[below].right;
2515 if (i == -1)
2516 { error("Argument to system function missing");
2517 AI.operand[0] = one_operand;
2518 AI.operand_count = 1;
2519 }
2520 else
2521 { j=0;
2522 while (i != -1) { j++; i = ET[i].right; }
2523
2524 if (((sf_number != INDIRECT_SYSF) &&
2525 (sf_number != GLK_SYSF) &&
2526 (sf_number != RANDOM_SYSF) && (j > 1)))
2527 { j=1;
2528 error("System function given with too many arguments");
2529 }
2530 if (sf_number != RANDOM_SYSF)
2531 { int jcount;
2532 i = ET[below].right;
2533 for (jcount = 0; jcount < j; jcount++)
2534 { AI.operand[jcount] = ET[i].value;
2535 i = ET[i].right;
2536 }
2537 AI.operand_count = j;
2538 }
2539 }
2540
2541 switch(sf_number)
2542 {
2543 case RANDOM_SYSF:
2544 if (j>1)
2545 { assembly_operand AO, AO2;
2546 int arg_c, arg_et;
2547 AO.value = j;
2548 AO.marker = 0;
2549 set_constant_ot(&AO);
2550 AO2.type = CONSTANT_OT;
2551 AO2.value = begin_word_array();
2552 AO2.marker = ARRAY_MV;
2553
2554 for (arg_c=0, arg_et = ET[below].right;arg_c<j;
2555 arg_c++, arg_et = ET[arg_et].right)
2556 { if (ET[arg_et].value.type == LOCALVAR_OT
2557 || ET[arg_et].value.type == GLOBALVAR_OT)
2558 error("Only constants can be used as possible 'random' results");
2559 array_entry(arg_c, ET[arg_et].value);
2560 }
2561 finish_array(arg_c);
2562
2563 assembleg_2(random_gc, AO, stack_pointer);
2564 assembleg_3(aload_gc, AO2, stack_pointer, Result);
2565 }
2566 else {
2567 assembleg_2(random_gc,
2568 ET[ET[below].right].value, stack_pointer);
2569 assembleg_3(add_gc, stack_pointer, one_operand,
2570 Result);
2571 }
2572 break;
2573
2574 case PARENT_SYSF:
2575 { assembly_operand AO;
2576 AO = ET[ET[below].right].value;
2577 if (runtime_error_checking_switch)
2578 AO = check_nonzero_at_runtime(AO, -1,
2579 PARENT_RTE);
2580 AO2.type = BYTECONSTANT_OT;
2581 AO2.value = GOBJFIELD_PARENT();
2582 AO2.marker = 0;
2583 assembleg_3(aload_gc, AO, AO2, Result);
2584 }
2585 break;
2586
2587 case ELDEST_SYSF:
2588 case CHILD_SYSF:
2589 { assembly_operand AO;
2590 AO = ET[ET[below].right].value;
2591 if (runtime_error_checking_switch)
2592 AO = check_nonzero_at_runtime(AO, -1,
2593 (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
2594 AO2.type = BYTECONSTANT_OT;
2595 AO2.value = GOBJFIELD_CHILD();
2596 AO2.marker = 0;
2597 assembleg_3(aload_gc, AO, AO2, Result);
2598 }
2599 break;
2600
2601 case YOUNGER_SYSF:
2602 case SIBLING_SYSF:
2603 { assembly_operand AO;
2604 AO = ET[ET[below].right].value;
2605 if (runtime_error_checking_switch)
2606 AO = check_nonzero_at_runtime(AO, -1,
2607 (sf_number==SIBLING_SYSF)
2608 ?SIBLING_RTE:YOUNGER_RTE);
2609 AO2.type = BYTECONSTANT_OT;
2610 AO2.value = GOBJFIELD_SIBLING();
2611 AO2.marker = 0;
2612 assembleg_3(aload_gc, AO, AO2, Result);
2613 }
2614 break;
2615
2616 case CHILDREN_SYSF:
2617 { assembly_operand AO;
2618 AO = ET[ET[below].right].value;
2619 if (runtime_error_checking_switch)
2620 AO = check_nonzero_at_runtime(AO, -1,
2621 CHILDREN_RTE);
2622 AO2.type = BYTECONSTANT_OT;
2623 AO2.value = GOBJFIELD_CHILD();
2624 AO2.marker = 0;
2625 assembleg_store(temp_var1, zero_operand);
2626 assembleg_3(aload_gc, AO, AO2, temp_var2);
2627 AO2.value = GOBJFIELD_SIBLING();
2628 assemble_label_no(next_label);
2629 assembleg_1_branch(jz_gc, temp_var2, next_label+1);
2630 assembleg_3(add_gc, temp_var1, one_operand,
2631 temp_var1);
2632 assembleg_3(aload_gc, temp_var2, AO2, temp_var2);
2633 assembleg_0_branch(jump_gc, next_label);
2634 assemble_label_no(next_label+1);
2635 next_label += 2;
2636 if (!void_flag)
2637 write_result_g(Result, temp_var1);
2638 }
2639 break;
2640
2641 case INDIRECT_SYSF:
2642 i = ET[below].right;
2643 goto IndirectFunctionCallG;
2644
2645 case GLK_SYSF:
2646 AO2 = veneer_routine(Glk__Wrap_VR);
2647 i = ET[below].right;
2648 goto DoFunctionCall;
2649
2650 case METACLASS_SYSF:
2651 assembleg_call_1(veneer_routine(Metaclass_VR),
2652 ET[ET[below].right].value, Result);
2653 break;
2654
2655 case YOUNGEST_SYSF:
2656 AO = ET[ET[below].right].value;
2657 if (runtime_error_checking_switch)
2658 AO = check_nonzero_at_runtime(AO, -1,
2659 YOUNGEST_RTE);
2660 AO2.marker = 0;
2661 AO2.value = GOBJFIELD_CHILD();
2662 AO2.type = BYTECONSTANT_OT;
2663 assembleg_3(aload_gc, AO, AO2, temp_var1);
2664 AO2.value = GOBJFIELD_SIBLING();
2665 assembleg_1_branch(jz_gc, temp_var1, next_label+1);
2666 assemble_label_no(next_label);
2667 assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
2668 assembleg_1_branch(jz_gc, temp_var2, next_label+1);
2669 assembleg_store(temp_var1, temp_var2);
2670 assembleg_0_branch(jump_gc, next_label);
2671 assemble_label_no(next_label+1);
2672 if (!void_flag)
2673 write_result_g(Result, temp_var1);
2674 next_label += 2;
2675 break;
2676
2677 case ELDER_SYSF:
2678 AO = ET[ET[below].right].value;
2679 if (runtime_error_checking_switch)
2680 AO = check_nonzero_at_runtime(AO, -1,
2681 YOUNGEST_RTE);
2682 assembleg_store(temp_var3, AO);
2683 AO2.marker = 0;
2684 AO2.value = GOBJFIELD_PARENT();
2685 AO2.type = BYTECONSTANT_OT;
2686 assembleg_3(aload_gc, temp_var3, AO2, temp_var1);
2687 assembleg_1_branch(jz_gc, temp_var1, next_label+2);
2688 AO2.value = GOBJFIELD_CHILD();
2689 assembleg_3(aload_gc, temp_var1, AO2, temp_var1);
2690 assembleg_1_branch(jz_gc, temp_var1, next_label+2);
2691 assembleg_2_branch(jeq_gc, temp_var3, temp_var1,
2692 next_label+1);
2693 assemble_label_no(next_label);
2694 AO2.value = GOBJFIELD_SIBLING();
2695 assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
2696 assembleg_2_branch(jeq_gc, temp_var3, temp_var2,
2697 next_label+2);
2698 assembleg_store(temp_var1, temp_var2);
2699 assembleg_0_branch(jump_gc, next_label);
2700 assemble_label_no(next_label+1);
2701 assembleg_store(temp_var1, zero_operand);
2702 assemble_label_no(next_label+2);
2703 if (!void_flag)
2704 write_result_g(Result, temp_var1);
2705 next_label += 3;
2706 break;
2707
2708 default:
2709 error("*** system function not implemented ***");
2710 break;
2711
2712 }
2713 break;
2714 }
2715
2716 i = below;
2717
2718 IndirectFunctionCallG:
2719
2720 /* Get the function address. */
2721 AO2 = ET[i].value;
2722 i = ET[i].right;
2723
2724 DoFunctionCall:
2725
2726 {
2727 /* If all the function arguments are in local/global
2728 variables, we have to push them all on the stack.
2729 If all of them are on the stack, we have to do nothing.
2730 If some are and some aren't, we have a hopeless mess,
2731 and we should throw a compiler error.
2732 */
2733
2734 int onstack = 0;
2735 int offstack = 0;
2736
2737 /* begin part of patch G03701 */
2738 int nargs = 0;
2739 j = i;
2740 while (j != -1) {
2741 nargs++;
2742 j = ET[j].right;
2743 }
2744
2745 if (nargs==0) {
2746 assembleg_2(callf_gc, AO2, void_flag ? zero_operand : Result);
2747 } else if (nargs==1) {
2748 assembleg_call_1(AO2, ET[i].value, void_flag ? zero_operand : Result);
2749 } else if (nargs==2) {
2750 assembly_operand o1 = ET[i].value;
2751 assembly_operand o2 = ET[ET[i].right].value;
2752 assembleg_call_2(AO2, o1, o2, void_flag ? zero_operand : Result);
2753 } else if (nargs==3) {
2754 assembly_operand o1 = ET[i].value;
2755 assembly_operand o2 = ET[ET[i].right].value;
2756 assembly_operand o3 = ET[ET[ET[i].right].right].value;
2757 assembleg_call_3(AO2, o1, o2, o3, void_flag ? zero_operand : Result);
2758 } else {
2759
2760 j = 0;
2761 while (i != -1) {
2762 if (ET[i].value.type == LOCALVAR_OT
2763 && ET[i].value.value == 0) {
2764 onstack++;
2765 }
2766 else {
2767 assembleg_store(stack_pointer, ET[i].value);
2768 offstack++;
2769 }
2770 i = ET[i].right;
2771 j++;
2772 }
2773
2774 if (onstack && offstack)
2775 error("*** Function call cannot be generated with mixed arguments ***");
2776 if (offstack > 1)
2777 error("*** Function call cannot be generated with more than one nonstack argument ***");
2778
2779 AO.value = j;
2780 AO.marker = 0;
2781 set_constant_ot(&AO);
2782
2783 if (void_flag)
2784 assembleg_3(call_gc, AO2, AO, zero_operand);
2785 else
2786 assembleg_3(call_gc, AO2, AO, Result);
2787
2788 } /* else nargs>=4 */
2789 } /* DoFunctionCall: */
2790
2791 break;
2792
2793 default:
2794 printf("** Trouble op = %d i.e. '%s' **\n",
2795 opnum, operators[opnum].description);
2796 compiler_error("Expr code gen: Can't generate yet");
2797 }
2798 }
2799
2800 ET[n].value = Result;
2801
2802 OperatorGenerated:
2803
2804 if (!glulx_mode) {
2805
2806 if (ET[n].to_expression)
2807 { if (ET[n].true_label != -1)
2808 { assemblez_1(push_zc, zero_operand);
2809 assemblez_jump(next_label++);
2810 assemble_label_no(ET[n].true_label);
2811 assemblez_1(push_zc, one_operand);
2812 assemble_label_no(next_label-1);
2813 }
2814 else
2815 { assemblez_1(push_zc, one_operand);
2816 assemblez_jump(next_label++);
2817 assemble_label_no(ET[n].false_label);
2818 assemblez_1(push_zc, zero_operand);
2819 assemble_label_no(next_label-1);
2820 }
2821 ET[n].value = stack_pointer;
2822 }
2823 else
2824 if (ET[n].label_after != -1)
2825 assemble_label_no(ET[n].label_after);
2826
2827 }
2828 else {
2829
2830 if (ET[n].to_expression)
2831 { if (ET[n].true_label != -1)
2832 { assembleg_store(stack_pointer, zero_operand);
2833 assembleg_jump(next_label++);
2834 assemble_label_no(ET[n].true_label);
2835 assembleg_store(stack_pointer, one_operand);
2836 assemble_label_no(next_label-1);
2837 }
2838 else
2839 { assembleg_store(stack_pointer, one_operand);
2840 assembleg_jump(next_label++);
2841 assemble_label_no(ET[n].false_label);
2842 assembleg_store(stack_pointer, zero_operand);
2843 assemble_label_no(next_label-1);
2844 }
2845 ET[n].value = stack_pointer;
2846 }
2847 else
2848 if (ET[n].label_after != -1)
2849 assemble_label_no(ET[n].label_after);
2850
2851 }
2852
2853 ET[n].down = -1;
2854 }
2855
2856 assembly_operand code_generate(assembly_operand AO, int context, int label)
2857 {
2858 /* Used in three contexts: VOID_CONTEXT, CONDITION_CONTEXT and
2859 QUANTITY_CONTEXT.
2860
2861 If CONDITION_CONTEXT, then compile code branching to label number
2862 "label" if the condition is false: there's no return value.
2863 (Except that if label is -3 or -4 (internal codes for rfalse and
2864 rtrue rather than branch) then this is for branching when the
2865 condition is true. This is used for optimising code generation
2866 for "if" statements.)
2867
2868 Otherwise return the assembly operand containing the result
2869 (probably the stack pointer variable but not necessarily:
2870 e.g. is would be short constant 2 from the expression "j++, 2") */
2871
2872 vivc_flag = FALSE;
2873
2874 if (AO.type != EXPRESSION_OT)
2875 { switch(context)
2876 { case VOID_CONTEXT:
2877 value_in_void_context(AO);
2878 AO.type = OMITTED_OT;
2879 AO.value = 0;
2880 break;
2881 case CONDITION_CONTEXT:
2882 if (!glulx_mode) {
2883 if (label < -2) assemblez_1_branch(jz_zc, AO, label, FALSE);
2884 else assemblez_1_branch(jz_zc, AO, label, TRUE);
2885 }
2886 else {
2887 if (label < -2)
2888 assembleg_1_branch(jnz_gc, AO, label);
2889 else
2890 assembleg_1_branch(jz_gc, AO, label);
2891 }
2892 AO.type = OMITTED_OT;
2893 AO.value = 0;
2894 break;
2895 }
2896 return AO;
2897 }
2898
2899 if (expr_trace_level >= 2)
2900 { printf("Raw parse tree:\n"); show_tree(AO, FALSE);
2901 }
2902
2903 if (context == CONDITION_CONTEXT)
2904 { if (label < -2) annotate_for_conditions(AO.value, label, -1);
2905 else annotate_for_conditions(AO.value, -1, label);
2906 }
2907 else annotate_for_conditions(AO.value, -1, -1);
2908
2909 if (expr_trace_level >= 1)
2910 { printf("Code generation for expression in ");
2911 switch(context)
2912 { case VOID_CONTEXT: printf("void"); break;
2913 case CONDITION_CONTEXT: printf("condition"); break;
2914 case QUANTITY_CONTEXT: printf("quantity"); break;
2915 case ASSEMBLY_CONTEXT: printf("assembly"); break;
2916 case ARRAY_CONTEXT: printf("array initialisation"); break;
2917 default: printf("* ILLEGAL *"); break;
2918 }
2919 printf(" context with annotated tree:\n");
2920 show_tree(AO, TRUE);
2921 }
2922
2923 generate_code_from(AO.value, (context==VOID_CONTEXT));
2924 return ET[AO.value].value;
2925 }
2926
2927 /* ========================================================================= */
2928 /* Data structure management routines */
2929 /* ------------------------------------------------------------------------- */
2930
2931 extern void init_expressc_vars(void)
2932 { make_operands();
2933 }
2934
2935 extern void expressc_begin_pass(void)
2936 {
2937 }
2938
2939 extern void expressc_allocate_arrays(void)
2940 {
2941 }
2942
2943 extern void expressc_free_arrays(void)
2944 {
2945 }
2946
2947 /* ========================================================================= */
Debian packaging for ‘inform6’