1 /* ------------------------------------------------------------------------- */
2 /* "expressc" : The expression code generator */
4 /* Part of Inform 6.42 */
5 /* copyright (c) Graham Nelson 1993 - 2024 */
7 /* Inform is free software: you can redistribute it and/or modify */
8 /* it under the terms of the GNU General Public License as published by */
9 /* the Free Software Foundation, either version 3 of the License, or */
10 /* (at your option) any later version. */
12 /* Inform is distributed in the hope that it will be useful, */
13 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
14 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
15 /* GNU General Public License for more details. */
17 /* You should have received a copy of the GNU General Public License */
18 /* along with Inform. If not, see https://gnu.org/licenses/ */
20 /* ------------------------------------------------------------------------- */
24 int vivc_flag; /* TRUE if the last code-generated
25 expression produced a "value in void
26 context" error: used to help the syntax
27 analyser recover from unknown-keyword
28 errors, since unknown keywords are
29 treated as yet-to-be-defined constants
30 and thus as values in void context */
32 /* These data structures are global, because they're too useful to be
34 assembly_operand stack_pointer, temp_var1, temp_var2, temp_var3,
35 temp_var4, zero_operand, one_operand, two_operand, three_operand,
36 four_operand, valueless_operand;
38 static void make_operands(void)
41 INITAOTV(&stack_pointer, VARIABLE_OT, 0);
42 INITAOTV(&temp_var1, VARIABLE_OT, 255);
43 INITAOTV(&temp_var2, VARIABLE_OT, 254);
44 INITAOTV(&temp_var3, VARIABLE_OT, 253);
45 INITAOTV(&temp_var4, VARIABLE_OT, 252);
46 INITAOTV(&zero_operand, SHORT_CONSTANT_OT, 0);
47 INITAOTV(&one_operand, SHORT_CONSTANT_OT, 1);
48 INITAOTV(&two_operand, SHORT_CONSTANT_OT, 2);
49 INITAOTV(&three_operand, SHORT_CONSTANT_OT, 3);
50 INITAOTV(&four_operand, SHORT_CONSTANT_OT, 4);
51 INITAOTV(&valueless_operand, OMITTED_OT, 0);
54 INITAOTV(&stack_pointer, LOCALVAR_OT, 0);
55 INITAOTV(&temp_var1, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+0);
56 INITAOTV(&temp_var2, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+1);
57 INITAOTV(&temp_var3, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+2);
58 INITAOTV(&temp_var4, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+3);
59 INITAOTV(&zero_operand, ZEROCONSTANT_OT, 0);
60 INITAOTV(&one_operand, BYTECONSTANT_OT, 1);
61 INITAOTV(&two_operand, BYTECONSTANT_OT, 2);
62 INITAOTV(&three_operand, BYTECONSTANT_OT, 3);
63 INITAOTV(&four_operand, BYTECONSTANT_OT, 4);
64 INITAOTV(&valueless_operand, OMITTED_OT, 0);
68 /* ------------------------------------------------------------------------- */
69 /* The table of conditionals. (Only used in Glulx) */
72 #define EQUAL_CC (502)
77 #define OFCLASS_CC (512)
78 #define PROVIDES_CC (514)
80 #define FIRST_CC (500)
83 typedef struct condclass_s {
84 int32 posform; /* Opcode for the conditional in its positive form. */
85 int32 negform; /* Opcode for the conditional in its negated form. */
88 condclass condclasses[] = {
99 /* ------------------------------------------------------------------------- */
100 /* The table of operators.
102 The ordering in this table is not significant except that it must match
103 the #define's in "header.h" */
105 operator operators[NUM_OPERATORS] =
107 /* ------------------------ */
109 /* ------------------------ */
111 { 0, SEP_TT, COMMA_SEP, IN_U, L_A, 0, -1, -1, 0, 0, "comma" },
113 /* ------------------------ */
115 /* ------------------------ */
117 { 1, SEP_TT, SETEQUALS_SEP, IN_U, R_A, 1, -1, -1, 1, 0,
118 "assignment operator '='" },
120 /* ------------------------ */
121 /* Level 2: ~~ && || */
122 /* ------------------------ */
124 { 2, SEP_TT, LOGAND_SEP, IN_U, L_A, 0, -1, -1, 0, LOGOR_OP,
125 "logical conjunction '&&'" },
126 { 2, SEP_TT, LOGOR_SEP, IN_U, L_A, 0, -1, -1, 0, LOGAND_OP,
127 "logical disjunction '||'" },
128 { 2, SEP_TT, LOGNOT_SEP, PRE_U, R_A, 0, -1, -1, 0, LOGNOT_OP,
129 "logical negation '~~'" },
131 /* ------------------------ */
138 /* ------------------------ */
140 { 3, -1, -1, -1, 0, 0, 400 + jz_zc, ZERO_CC+0, 0, NONZERO_OP,
141 "expression used as condition then negated" },
142 { 3, -1, -1, -1, 0, 0, 800 + jz_zc, ZERO_CC+1, 0, ZERO_OP,
143 "expression used as condition" },
144 { 3, SEP_TT, CONDEQUALS_SEP, IN_U, 0, 0, 400 + je_zc, EQUAL_CC+0, 0, NOTEQUAL_OP,
146 { 3, SEP_TT, NOTEQUAL_SEP, IN_U, 0, 0, 800 + je_zc, EQUAL_CC+1, 0, CONDEQUALS_OP,
148 { 3, SEP_TT, GE_SEP, IN_U, 0, 0, 800 + jl_zc, LT_CC+1, 0, LESS_OP,
150 { 3, SEP_TT, GREATER_SEP, IN_U, 0, 0, 400 + jg_zc, GT_CC+0, 0, LE_OP,
152 { 3, SEP_TT, LE_SEP, IN_U, 0, 0, 800 + jg_zc, GT_CC+1, 0, GREATER_OP,
154 { 3, SEP_TT, LESS_SEP, IN_U, 0, 0, 400 + jl_zc, LT_CC+0, 0, GE_OP,
156 { 3, CND_TT, HAS_COND, IN_U, 0, 0, 400 + test_attr_zc, HAS_CC+0, 0, HASNT_OP,
158 { 3, CND_TT, HASNT_COND, IN_U, 0, 0, 800 + test_attr_zc, HAS_CC+1, 0, HAS_OP,
159 "'hasnt' condition" },
160 { 3, CND_TT, IN_COND, IN_U, 0, 0, 400 + jin_zc, IN_CC+0, 0, NOTIN_OP,
162 { 3, CND_TT, NOTIN_COND, IN_U, 0, 0, 800 + jin_zc, IN_CC+1, 0, IN_OP,
163 "'notin' condition" },
164 { 3, CND_TT, OFCLASS_COND, IN_U, 0, 0, 600, OFCLASS_CC+0, 0, NOTOFCLASS_OP,
165 "'ofclass' condition" },
166 { 3, CND_TT, PROVIDES_COND, IN_U, 0, 0, 601, PROVIDES_CC+0, 0, NOTPROVIDES_OP,
167 "'provides' condition" },
168 { 3, -1, -1, -1, 0, 0, 1000, OFCLASS_CC+1, 0, OFCLASS_OP,
169 "negated 'ofclass' condition" },
170 { 3, -1, -1, -1, 0, 0, 1001, PROVIDES_CC+1, 0, PROVIDES_OP,
171 "negated 'provides' condition" },
173 /* ------------------------ */
175 /* ------------------------ */
177 { 4, CND_TT, OR_COND, IN_U, L_A, 0, -1, -1, 0, 0, "'or'" },
179 /* ------------------------ */
180 /* Level 5: + binary - */
181 /* ------------------------ */
183 { 5, SEP_TT, PLUS_SEP, IN_U, L_A, 0, add_zc, add_gc, 0, 0, "'+'" },
184 { 5, SEP_TT, MINUS_SEP, IN_U, L_A, 0, sub_zc, sub_gc, 0, 0, "'-'" },
186 /* ------------------------ */
189 /* ------------------------ */
191 { 6, SEP_TT, TIMES_SEP, IN_U, L_A, 0, mul_zc, mul_gc, 0, 0, "'*'" },
192 { 6, SEP_TT, DIVIDE_SEP, IN_U, L_A, 0, div_zc, div_gc, 0, 0, "'/'" },
193 { 6, SEP_TT, REMAINDER_SEP, IN_U, L_A, 0, mod_zc, mod_gc, 0, 0,
194 "remainder after division '%'" },
195 { 6, SEP_TT, ARTAND_SEP, IN_U, L_A, 0, and_zc, bitand_gc, 0, 0,
197 { 6, SEP_TT, ARTOR_SEP, IN_U, L_A, 0, or_zc, bitor_gc, 0, 0,
199 { 6, SEP_TT, ARTNOT_SEP, PRE_U, R_A, 0, -1, bitnot_gc, 0, 0,
202 /* ------------------------ */
203 /* Level 7: -> --> */
204 /* ------------------------ */
206 { 7, SEP_TT, ARROW_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
207 "byte array operator '->'" },
208 { 7, SEP_TT, DARROW_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
209 "word array operator '-->'" },
211 /* ------------------------ */
212 /* Level 8: unary - */
213 /* ------------------------ */
215 { 8, SEP_TT, UNARY_MINUS_SEP, PRE_U, R_A, 0, -1, neg_gc, 0, 0,
218 /* ------------------------ */
220 /* (prefix or postfix) */
221 /* ------------------------ */
223 { 9, SEP_TT, INC_SEP, PRE_U, R_A, 2, -1, -1, 1, 0,
224 "pre-increment operator '++'" },
225 { 9, SEP_TT, POST_INC_SEP, POST_U, R_A, 3, -1, -1, 1, 0,
226 "post-increment operator '++'" },
227 { 9, SEP_TT, DEC_SEP, PRE_U, R_A, 4, -1, -1, 1, 0,
228 "pre-decrement operator '--'" },
229 { 9, SEP_TT, POST_DEC_SEP, POST_U, R_A, 5, -1, -1, 1, 0,
230 "post-decrement operator '--'" },
232 /* ------------------------ */
233 /* Level 10: .& .# */
235 /* ------------------------ */
237 {10, SEP_TT, PROPADD_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
238 "property address operator '.&'" },
239 {10, SEP_TT, PROPNUM_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
240 "property length operator '.#'" },
241 {10, SEP_TT, MPROPADD_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
242 "individual property address operator '..&'" },
243 {10, SEP_TT, MPROPNUM_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
244 "individual property length operator '..#'" },
246 /* ------------------------ */
247 /* Level 11: function ( */
248 /* ------------------------ */
250 {11, SEP_TT, OPENB_SEP, IN_U, L_A, 0, -1, -1, 1, 0,
253 /* ------------------------ */
255 /* ------------------------ */
257 {12, SEP_TT, MESSAGE_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
258 "individual property selector '..'" },
259 {12, SEP_TT, PROPERTY_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
260 "property selector '.'" },
262 /* ------------------------ */
264 /* ------------------------ */
266 {13, SEP_TT, SUPERCLASS_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
267 "superclass operator '::'" },
269 /* ------------------------ */
270 /* Miscellaneous operators */
271 /* generated at lvalue */
273 /* ------------------------ */
275 { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> = */
276 "byte array entry assignment" },
277 { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> = */
278 "word array entry assignment" },
279 { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. = */
280 "individual property assignment" },
281 { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . = */
282 "common property assignment" },
284 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ -> */
285 "byte array entry preincrement" },
286 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ --> */
287 "word array entry preincrement" },
288 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ .. */
289 "individual property preincrement" },
290 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ . */
291 "common property preincrement" },
293 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- -> */
294 "byte array entry predecrement" },
295 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- --> */
296 "word array entry predecrement" },
297 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- .. */
298 "individual property predecrement" },
299 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- . */
300 "common property predecrement" },
302 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> ++ */
303 "byte array entry postincrement" },
304 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> ++ */
305 "word array entry postincrement" },
306 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. ++ */
307 "individual property postincrement" },
308 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . ++ */
309 "common property postincrement" },
311 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> -- */
312 "byte array entry postdecrement" },
313 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> -- */
314 "word array entry postdecrement" },
315 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. -- */
316 "individual property postdecrement" },
317 { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . -- */
318 "common property postdecrement" },
320 {11, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* x.y(args) */
321 "call to common property" },
322 {11, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* x..y(args) */
323 "call to individual property" },
325 /* ------------------------ */
326 /* And one Glulx-only op */
327 /* which just pushes its */
328 /* argument on the stack, */
330 /* ------------------------ */
332 {14, -1, -1, -1, -1, 0, -1, -1, 1, 0,
336 /* --- Condition annotater ------------------------------------------------- */
338 static void annotate_for_conditions(int n, int a, int b)
339 { int i, opnum = ET[n].operator_number;
341 ET[n].label_after = -1;
342 ET[n].to_expression = FALSE;
343 ET[n].true_label = a;
344 ET[n].false_label = b;
346 if (ET[n].down == -1) return;
348 if ((operators[opnum].precedence == 2)
349 || (operators[opnum].precedence == 3))
350 { if ((a == -1) && (b == -1))
351 { if (opnum == LOGAND_OP)
353 ET[n].false_label = b;
354 ET[n].to_expression = TRUE;
358 ET[n].true_label = a;
359 ET[n].to_expression = TRUE;
368 ET[n].false_label = b;
369 ET[n].label_after = b;
371 annotate_for_conditions(ET[n].down, -1, b);
372 if (b == ET[n].label_after)
373 annotate_for_conditions(ET[ET[n].down].right, a, -1);
374 else annotate_for_conditions(ET[ET[n].down].right, a, b);
379 ET[n].true_label = a;
380 ET[n].label_after = a;
382 annotate_for_conditions(ET[n].down, a, -1);
383 if (a == ET[n].label_after)
384 annotate_for_conditions(ET[ET[n].down].right, -1, b);
385 else annotate_for_conditions(ET[ET[n].down].right, a, b);
391 { annotate_for_conditions(i, -1, -1); i = ET[i].right; }
394 /* --- Code generator ------------------------------------------------------ */
396 static void value_in_void_context_z(assembly_operand AO)
402 { case LONG_CONSTANT_OT:
403 case SHORT_CONSTANT_OT:
405 if (AO.marker == SYMBOL_MV)
406 t = (symbols[AO.value].name);
409 t = variable_name(AO.value);
412 compiler_error("Unable to print value in void context");
418 if (strcmp(t, "print_paddr") == 0)
419 obsolete_warning("ignoring 'print_paddr': use 'print (string)' instead");
421 if (strcmp(t, "print_addr") == 0)
422 obsolete_warning("ignoring 'print_addr': use 'print (address)' instead");
424 if (strcmp(t, "print_char") == 0)
425 obsolete_warning("ignoring 'print_char': use 'print (char)' instead");
427 ebf_error("expression with side-effects", t);
430 static void write_result_z(assembly_operand to, assembly_operand from)
431 { if (to.value == from.value) return;
432 if (to.value == 0) assemblez_1(push_zc, from);
433 else assemblez_store(to, from);
436 static void pop_zm_stack(void)
437 { assembly_operand st;
438 if (version_number < 5) assemblez_0(pop_zc);
440 { INITAOTV(&st, VARIABLE_OT, 0);
441 assemblez_1_branch(jz_zc, st, -2, TRUE);
445 static void access_memory_z(int oc, assembly_operand AO1, assembly_operand AO2,
446 assembly_operand AO3)
449 assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
451 int x = 0, y = 0, byte_flag = FALSE, read_flag = FALSE;
457 if (AO1.marker == ARRAY_MV || AO1.marker == STATIC_ARRAY_MV)
459 if ((oc == loadb_zc) || (oc == storeb_zc)) byte_flag=TRUE;
460 else byte_flag = FALSE;
461 if ((oc == loadb_zc) || (oc == loadw_zc)) read_flag=TRUE;
462 else read_flag = FALSE;
464 zero_ao.type = SHORT_CONSTANT_OT;
467 size_ao = zero_ao; size_ao.value = -1;
468 for (x=0; x<no_arrays; x++)
469 { if (((AO1.marker == ARRAY_MV) == (!arrays[x].loc))
470 && (AO1.value == symbols[arrays[x].symbol].value))
471 { size_ao.value = arrays[x].size; y=x;
475 if (arrays[y].loc && !read_flag) {
476 error("Cannot write to a static array");
479 if (size_ao.value==-1) {
480 /* This case was originally meant for module linking.
481 It should no longer be possible. */
482 compiler_error("Array size cannot be negative");
485 type_ao = zero_ao; type_ao.value = arrays[y].type;
487 if ((!is_systemfile()))
490 if ((arrays[y].type == WORD_ARRAY)
491 || (arrays[y].type == TABLE_ARRAY))
492 warning("Using '->' to access a --> or table array");
496 if ((arrays[y].type == BYTE_ARRAY)
497 || (arrays[y].type == STRING_ARRAY))
498 warning("Using '-->' to access a -> or string array");
505 if ((!runtime_error_checking_switch) || (veneer_mode))
506 { if ((oc == loadb_zc) || (oc == loadw_zc))
507 assemblez_2_to(oc, AO1, AO2, AO3);
509 assemblez_3(oc, AO1, AO2, AO3);
513 /* If we recognise AO1 as arising textually from a declared
514 array, we can check bounds explicitly. */
516 if ((AO1.marker == ARRAY_MV || AO1.marker == STATIC_ARRAY_MV))
518 int passed_label = next_label++, failed_label = next_label++,
519 final_label = next_label++;
520 /* Calculate the largest permitted array entry + 1
521 Here "size_ao.value" = largest permitted entry of its own kind */
525 && ((arrays[y].type == WORD_ARRAY)
526 || (arrays[y].type == TABLE_ARRAY)))
527 { max_ao.value = size_ao.value*2 + 1;
531 && ((arrays[y].type == BYTE_ARRAY)
532 || (arrays[y].type == STRING_ARRAY)
533 || (arrays[y].type == BUFFER_ARRAY)))
534 { if ((size_ao.value % 2) == 0)
535 max_ao.value = size_ao.value/2 - 1;
536 else max_ao.value = (size_ao.value-1)/2;
541 if (size_ao.value >= 256) size_ao.type = LONG_CONSTANT_OT;
542 if (max_ao.value >= 256) max_ao.type = LONG_CONSTANT_OT;
544 /* Can't write to the size entry in a string or table */
545 if (((arrays[y].type == STRING_ARRAY)
546 || (arrays[y].type == TABLE_ARRAY))
548 { if ((arrays[y].type == TABLE_ARRAY) && byte_flag)
550 else zero_ao.value = 1;
553 en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
554 switch(oc) { case loadb_zc: en_ao.value = ABOUNDS_RTE; break;
555 case loadw_zc: en_ao.value = ABOUNDS_RTE+1; break;
556 case storeb_zc: en_ao.value = ABOUNDS_RTE+2; break;
557 case storew_zc: en_ao.value = ABOUNDS_RTE+3; break; }
560 if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
561 { assemblez_store(temp_var2, AO2);
562 assemblez_store(AO2, temp_var2);
563 index_ao = temp_var2;
565 assemblez_2_branch(jl_zc, index_ao, zero_ao, failed_label, TRUE);
566 assemblez_2_branch(jl_zc, index_ao, max_ao, passed_label, TRUE);
567 assemble_label_no(failed_label);
568 an_ao = zero_ao; an_ao.value = y;
569 assemblez_6(call_vn2_zc, veneer_routine(RT__Err_VR), en_ao,
570 index_ao, size_ao, type_ao, an_ao);
572 /* We have to clear any of AO1, AO2, AO3 off the stack if
573 present, so that we can achieve the same effect on the stack
574 that executing the opcode would have had */
576 if ((AO1.type == VARIABLE_OT) && (AO1.value == 0)) pop_zm_stack();
577 if ((AO2.type == VARIABLE_OT) && (AO2.value == 0)) pop_zm_stack();
578 if ((AO3.type == VARIABLE_OT) && (AO3.value == 0))
579 { if ((oc == loadb_zc) || (oc == loadw_zc))
580 { assemblez_store(AO3, zero_ao);
584 assemblez_jump(final_label);
586 assemble_label_no(passed_label);
587 if ((oc == loadb_zc) || (oc == loadw_zc))
588 assemblez_2_to(oc, AO1, AO2, AO3);
590 assemblez_3(oc, AO1, AO2, AO3);
591 assemble_label_no(final_label);
595 /* Otherwise, compile a call to the veneer which verifies that
596 the proposed read/write is within dynamic Z-machine memory. */
598 switch(oc) { case loadb_zc: vr = RT__ChLDB_VR; break;
599 case loadw_zc: vr = RT__ChLDW_VR; break;
600 case storeb_zc: vr = RT__ChSTB_VR; break;
601 case storew_zc: vr = RT__ChSTW_VR; break;
602 default: compiler_error("unknown array opcode");
605 if ((oc == loadb_zc) || (oc == loadw_zc))
606 assemblez_3_to(call_vs_zc, veneer_routine(vr), AO1, AO2, AO3);
608 assemblez_4(call_vn_zc, veneer_routine(vr), AO1, AO2, AO3);
611 static assembly_operand check_nonzero_at_runtime_z(assembly_operand AO1,
612 int error_label, int rte_number)
613 { assembly_operand AO2, AO3;
614 int check_sp = FALSE, passed_label, failed_label, last_label;
615 if (veneer_mode) return AO1;
617 /* Assemble to code to check that the operand AO1 is ofclass Object:
618 if it is, execution should continue and the stack should be
619 unchanged. Otherwise, call the veneer's run-time-error routine
620 with the given error number, and then: if the label isn't -1,
621 switch execution to this label, with the value popped from
622 the stack if it was on the stack in the first place;
623 if the label is -1, either replace the top of the stack with
624 the constant 2, or return the operand (short constant) 2.
626 The point of 2 is that object 2 is the class-object Object
627 and therefore has no parent, child or sibling, so that the
628 built-in tree functions will safely return 0 on this object. */
630 /* Sometimes we can already see that the object number is valid. */
631 if (((AO1.type == LONG_CONSTANT_OT) || (AO1.type == SHORT_CONSTANT_OT))
632 && (AO1.marker == 0) && (AO1.value >= 1) && (AO1.value < no_objects))
635 passed_label = next_label++;
636 failed_label = next_label++;
637 INITAOTV(&AO2, LONG_CONSTANT_OT, actual_largest_object_SC);
638 AO2.marker = INCON_MV;
639 INITAOTV(&AO3, SHORT_CONSTANT_OT, 5);
641 if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
642 || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
643 || (rte_number == PROP_ADD_RTE))
644 { /* Allow classes */
646 if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
647 { /* That is, if AO1 is the stack pointer */
649 assemblez_store(temp_var2, AO1);
650 assemblez_store(AO1, temp_var2);
651 assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
652 assemblez_2_branch(jg_zc, temp_var2, AO2, passed_label, FALSE);
655 { assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
656 assemblez_2_branch(jg_zc, AO1, AO2, passed_label, FALSE);
660 { if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
661 { /* That is, if AO1 is the stack pointer */
663 assemblez_store(temp_var2, AO1);
664 assemblez_store(AO1, temp_var2);
665 assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
666 assemblez_2_branch(jg_zc, temp_var2, AO2, failed_label, TRUE);
668 assemblez_2_branch(jin_zc, temp_var2, AO3, passed_label, FALSE);
671 { assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
672 assemblez_2_branch(jg_zc, AO1, AO2, failed_label, TRUE);
674 assemblez_2_branch(jin_zc, AO1, AO3, passed_label, FALSE);
678 assemble_label_no(failed_label);
679 INITAOTV(&AO2, SHORT_CONSTANT_OT, rte_number);
680 if (version_number >= 5)
681 assemblez_3(call_vn_zc, veneer_routine(RT__Err_VR), AO2, AO1);
683 assemblez_3_to(call_zc, veneer_routine(RT__Err_VR), AO2, AO1, temp_var2);
685 if (error_label != -1)
686 { /* Jump to the error label */
687 if (error_label == -3) assemblez_0(rfalse_zc);
688 else if (error_label == -4) assemblez_0(rtrue_zc);
689 else assemblez_jump(error_label);
693 { /* Push the short constant 2 */
694 INITAOTV(&AO2, SHORT_CONSTANT_OT, 2);
695 assemblez_store(AO1, AO2);
698 { /* Store either short constant 2 or the operand's value in
699 the temporary variable */
700 INITAOTV(&AO2, SHORT_CONSTANT_OT, 2);
701 AO3 = temp_var2; assemblez_store(AO3, AO2);
702 last_label = next_label++;
703 assemblez_jump(last_label);
704 assemble_label_no(passed_label);
705 assemblez_store(AO3, AO1);
706 assemble_label_no(last_label);
710 assemble_label_no(passed_label);
714 static void compile_conditional_z(int oc,
715 assembly_operand AO1, assembly_operand AO2, int label, int flag)
716 { assembly_operand AO3; int the_zc, error_label = label,
717 va_flag = FALSE, va_label = 0;
723 check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"has/hasnt\" expression");
724 check_warn_symbol_type(&AO2, ATTRIBUTE_T, 0, "\"has/hasnt\" expression");
727 check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"in/notin\" expression");
728 check_warn_symbol_type(&AO2, OBJECT_T, CLASS_T, "\"in/notin\" expression");
731 /* first argument can be anything */
732 check_warn_symbol_type(&AO2, CLASS_T, 0, "\"ofclass\" expression");
735 /* first argument can be anything */
736 check_warn_symbol_type(&AO2, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"provides\" expression");
741 { if ((runtime_error_checking_switch) && (oc == jin_zc))
742 { if (flag) error_label = next_label++;
743 AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
745 if ((runtime_error_checking_switch) && (oc == test_attr_zc))
746 { if (flag) error_label = next_label++;
747 AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
749 { case SHORT_CONSTANT_OT:
750 case LONG_CONSTANT_OT:
752 { if ((AO2.value < 0) || (AO2.value > 47))
753 error("'has'/'hasnt' applied to illegal attribute number");
757 { int pa_label = next_label++, fa_label = next_label++;
758 assembly_operand en_ao, zero_ao, max_ao;
759 assemblez_store(temp_var1, AO1);
760 if ((AO1.type == VARIABLE_OT)&&(AO1.value == 0))
761 assemblez_store(AO1, temp_var1);
762 assemblez_store(temp_var2, AO2);
763 if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
764 assemblez_store(AO2, temp_var2);
765 INITAOT(&zero_ao, SHORT_CONSTANT_OT);
767 max_ao = zero_ao; max_ao.value = 48;
768 assemblez_2_branch(jl_zc,temp_var2,zero_ao,fa_label,TRUE);
769 assemblez_2_branch(jl_zc,temp_var2,max_ao,pa_label,TRUE);
770 assemble_label_no(fa_label);
771 en_ao = zero_ao; en_ao.value = 19;
772 assemblez_4(call_vn_zc, veneer_routine(RT__Err_VR),
773 en_ao, temp_var1, temp_var2);
774 va_flag = TRUE; va_label = next_label++;
775 assemblez_jump(va_label);
776 assemble_label_no(pa_label);
780 assemblez_2_branch(oc, AO1, AO2, label, flag);
781 if (error_label != label) assemble_label_no(error_label);
782 if (va_flag) assemble_label_no(va_label);
786 INITAOTV(&AO3, VARIABLE_OT, 0);
788 the_zc = (version_number == 3)?call_zc:call_vs_zc;
790 assemblez_3_to(the_zc, veneer_routine(OP__Pr_VR), AO1, AO2, AO3);
792 assemblez_3_to(the_zc, veneer_routine(OC__Cl_VR), AO1, AO2, AO3);
794 assemblez_1_branch(jz_zc, AO3, label, !flag);
797 static void value_in_void_context_g(assembly_operand AO)
804 case HALFCONSTANT_OT:
805 case BYTECONSTANT_OT:
806 case ZEROCONSTANT_OT:
808 if (AO.marker == SYMBOL_MV)
809 t = (symbols[AO.value].name);
813 t = variable_name(AO.value);
816 compiler_error("Unable to print value in void context");
822 ebf_error("expression with side-effects", t);
825 static void write_result_g(assembly_operand to, assembly_operand from)
826 { if (to.value == from.value && to.type == from.type) return;
827 assembleg_store(to, from);
830 static void access_memory_g(int oc, assembly_operand AO1, assembly_operand AO2,
831 assembly_operand AO3)
833 int data_len, read_flag;
834 assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
836 int passed_label, failed_label, final_label, x = 0, y = 0;
838 if ((oc == aloadb_gc) || (oc == astoreb_gc)) data_len = 1;
839 else if ((oc == aloads_gc) || (oc == astores_gc)) data_len = 2;
842 if ((oc == aloadb_gc) || (oc == aloads_gc) || (oc == aload_gc))
851 if (AO1.marker == ARRAY_MV || AO1.marker == STATIC_ARRAY_MV)
853 size_ao = zero_ao; size_ao.value = -1;
854 for (x=0; x<no_arrays; x++)
855 { if (((AO1.marker == ARRAY_MV) == (!arrays[x].loc))
856 && (AO1.value == symbols[arrays[x].symbol].value))
857 { size_ao.value = arrays[x].size; y=x;
860 if (size_ao.value==-1) compiler_error("Array size can't be found");
862 type_ao = zero_ao; type_ao.value = arrays[y].type;
864 if (arrays[y].loc && !read_flag) {
865 error("Cannot write to a static array");
868 if ((!is_systemfile()))
871 if ((arrays[y].type == WORD_ARRAY)
872 || (arrays[y].type == TABLE_ARRAY))
873 warning("Using '->' to access a --> or table array");
877 if ((arrays[y].type == BYTE_ARRAY)
878 || (arrays[y].type == STRING_ARRAY))
879 warning("Using '-->' to access a -> or string array");
885 if ((!runtime_error_checking_switch) || (veneer_mode))
887 assembleg_3(oc, AO1, AO2, AO3);
891 /* If we recognise AO1 as arising textually from a declared
892 array, we can check bounds explicitly. */
894 if (AO1.marker == ARRAY_MV || AO1.marker == STATIC_ARRAY_MV)
896 /* Calculate the largest permitted array entry + 1
897 Here "size_ao.value" = largest permitted entry of its own kind */
900 && ((arrays[y].type == WORD_ARRAY)
901 || (arrays[y].type == TABLE_ARRAY)))
902 { max_ao.value = size_ao.value*4 + 3;
906 && ((arrays[y].type == BYTE_ARRAY)
907 || (arrays[y].type == STRING_ARRAY)
908 || (arrays[y].type == BUFFER_ARRAY)))
909 { max_ao.value = (size_ao.value-3)/4;
914 /* Can't write to the size entry in a string or table */
915 if (((arrays[y].type == STRING_ARRAY)
916 || (arrays[y].type == TABLE_ARRAY))
918 { if ((arrays[y].type == TABLE_ARRAY) && data_len == 1)
920 else zero_ao.value = 1;
923 en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
925 switch(oc) { case aloadb_gc: en_ao.value = ABOUNDS_RTE; break;
926 case aload_gc: en_ao.value = ABOUNDS_RTE+1; break;
927 case astoreb_gc: en_ao.value = ABOUNDS_RTE+2; break;
928 case astore_gc: en_ao.value = ABOUNDS_RTE+3; break; }
930 set_constant_ot(&zero_ao);
931 set_constant_ot(&size_ao);
932 set_constant_ot(&max_ao);
933 set_constant_ot(&type_ao);
934 set_constant_ot(&en_ao);
936 /* If we recognize A02 as a constant, we can do the test right
938 if (is_constant_ot(AO2.type) && AO2.marker == 0) {
939 if (AO2.value < zero_ao.value || AO2.value >= max_ao.value) {
940 error("Array reference is out-of-bounds");
942 assembleg_3(oc, AO1, AO2, AO3);
946 passed_label = next_label++;
947 failed_label = next_label++;
948 final_label = next_label++;
951 if ((AO2.type == LOCALVAR_OT)&&(AO2.value == 0))
952 { assembleg_store(temp_var2, AO2); /* ### could peek */
953 assembleg_store(AO2, temp_var2);
954 index_ao = temp_var2;
956 assembleg_2_branch(jlt_gc, index_ao, zero_ao, failed_label);
957 assembleg_2_branch(jlt_gc, index_ao, max_ao, passed_label);
958 assemble_label_no(failed_label);
960 an_ao = zero_ao; an_ao.value = y;
961 set_constant_ot(&an_ao);
962 five_ao = zero_ao; five_ao.value = 5;
963 set_constant_ot(&five_ao);
965 /* Call the error veneer routine. */
966 assembleg_store(stack_pointer, an_ao);
967 assembleg_store(stack_pointer, type_ao);
968 assembleg_store(stack_pointer, size_ao);
969 assembleg_store(stack_pointer, index_ao);
970 assembleg_store(stack_pointer, en_ao);
971 assembleg_3(call_gc, veneer_routine(RT__Err_VR),
972 five_ao, zero_operand);
974 /* We have to clear any of AO1, AO2, AO3 off the stack if
975 present, so that we can achieve the same effect on the stack
976 that executing the opcode would have had */
978 if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0))
979 assembleg_2(copy_gc, stack_pointer, zero_operand);
980 if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
981 assembleg_2(copy_gc, stack_pointer, zero_operand);
982 if ((AO3.type == LOCALVAR_OT) && (AO3.value == 0))
983 { if ((oc == aloadb_gc) || (oc == aload_gc))
984 { assembleg_store(AO3, zero_ao);
986 else assembleg_2(copy_gc, stack_pointer, zero_operand);
988 assembleg_jump(final_label);
990 assemble_label_no(passed_label);
991 assembleg_3(oc, AO1, AO2, AO3);
992 assemble_label_no(final_label);
996 /* Otherwise, compile a call to the veneer which verifies that
997 the proposed read/write is within dynamic Z-machine memory. */
1000 case aloadb_gc: vr = RT__ChLDB_VR; break;
1001 case aload_gc: vr = RT__ChLDW_VR; break;
1002 case astoreb_gc: vr = RT__ChSTB_VR; break;
1003 case astore_gc: vr = RT__ChSTW_VR; break;
1004 default: compiler_error("unknown array opcode");
1007 if ((oc == aloadb_gc) || (oc == aload_gc))
1008 assembleg_call_2(veneer_routine(vr), AO1, AO2, AO3);
1010 assembleg_call_3(veneer_routine(vr), AO1, AO2, AO3, zero_operand);
1013 static assembly_operand check_nonzero_at_runtime_g(assembly_operand AO1,
1014 int error_label, int rte_number)
1016 assembly_operand AO, AO2, AO3;
1018 int check_sp = FALSE, passed_label, failed_label, last_label;
1024 /* Assemble to code to check that the operand AO1 is ofclass Object:
1025 if it is, execution should continue and the stack should be
1026 unchanged. Otherwise, call the veneer's run-time-error routine
1027 with the given error number, and then: if the label isn't -1,
1028 switch execution to this label, with the value popped from
1029 the stack if it was on the stack in the first place;
1030 if the label is -1, either replace the top of the stack with
1031 the constant symbol (class-object) Object.
1033 The Object has no parent, child or sibling, so that the
1034 built-in tree functions will safely return 0 on this object. */
1036 /* Sometimes we can already see that the object number is valid. */
1037 if (AO1.marker == OBJECT_MV &&
1038 ((AO1.value >= 1) && (AO1.value <= no_objects))) {
1042 pre_unreach = execution_never_reaches_here;
1044 passed_label = next_label++;
1045 failed_label = next_label++;
1047 if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0) && (AO1.marker == 0)) {
1048 /* That is, if AO1 is the stack pointer */
1050 assembleg_store(temp_var2, stack_pointer);
1051 assembleg_store(stack_pointer, temp_var2);
1058 if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
1059 || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
1060 || (rte_number == PROP_ADD_RTE)) {
1062 /* Test if zero... */
1063 assembleg_1_branch(jz_gc, AO, failed_label);
1064 if (!pre_unreach && execution_never_reaches_here)
1065 execution_never_reaches_here |= EXECSTATE_NOWARN;
1066 /* Test if first byte is 0x70... */
1067 assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
1069 AO3.value = 0x70; /* type byte -- object */
1070 set_constant_ot(&AO3);
1071 assembleg_2_branch(jeq_gc, stack_pointer, AO3, passed_label);
1074 /* Test if zero... */
1075 assembleg_1_branch(jz_gc, AO, failed_label);
1076 if (!pre_unreach && execution_never_reaches_here)
1077 execution_never_reaches_here |= EXECSTATE_NOWARN;
1078 /* Test if first byte is 0x70... */
1079 assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
1081 AO3.value = 0x70; /* type byte -- object */
1082 set_constant_ot(&AO3);
1083 assembleg_2_branch(jne_gc, stack_pointer, AO3, failed_label);
1084 /* Test if inside the "Class" object... */
1085 INITAOTV(&AO3, BYTECONSTANT_OT, GOBJFIELD_PARENT());
1086 assembleg_3(aload_gc, AO, AO3, stack_pointer);
1087 ln = get_symbol_index("Class");
1089 error("No 'Class' object found");
1093 AO3.value = symbols[ln].value;
1094 AO3.marker = OBJECT_MV;
1095 AO3.type = CONSTANT_OT;
1097 assembleg_2_branch(jne_gc, stack_pointer, AO3, passed_label);
1100 assemble_label_no(failed_label);
1102 AO2.value = rte_number;
1103 set_constant_ot(&AO2);
1104 assembleg_call_2(veneer_routine(RT__Err_VR), AO2, AO1, zero_operand);
1106 if (error_label != -1) {
1107 /* Jump to the error label */
1108 if (error_label == -3) assembleg_1(return_gc, zero_operand);
1109 else if (error_label == -4) assembleg_1(return_gc, one_operand);
1110 else assembleg_jump(error_label);
1113 /* Build the symbol for "Object" */
1114 ln = get_symbol_index("Object");
1116 error("No 'Object' object found");
1120 AO2.value = symbols[ln].value;
1121 AO2.marker = OBJECT_MV;
1122 AO2.type = CONSTANT_OT;
1126 assembleg_store(AO1, AO2);
1129 /* Store either "Object" or the operand's value in the temporary
1131 assembleg_store(temp_var2, AO2);
1132 last_label = next_label++;
1133 assembleg_jump(last_label);
1134 assemble_label_no(passed_label);
1135 assembleg_store(temp_var2, AO1);
1136 assemble_label_no(last_label);
1141 assemble_label_no(passed_label);
1145 static void compile_conditional_g(condclass *cc,
1146 assembly_operand AO1, assembly_operand AO2, int label, int flag)
1147 { assembly_operand AO4;
1148 int the_zc, error_label = label,
1149 va_flag = FALSE, va_label = 0;
1153 the_zc = (flag ? cc->posform : cc->negform);
1156 switch ((cc-condclasses)*2 + 500) {
1159 check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"has/hasnt\" expression");
1160 check_warn_symbol_type(&AO2, ATTRIBUTE_T, 0, "\"has/hasnt\" expression");
1161 if (runtime_error_checking_switch) {
1163 error_label = next_label++;
1164 AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
1165 if (is_constant_ot(AO2.type) && AO2.marker == 0) {
1166 if ((AO2.value < 0) || (AO2.value >= NUM_ATTR_BYTES*8)) {
1167 error("'has'/'hasnt' applied to illegal attribute number");
1171 int pa_label = next_label++, fa_label = next_label++;
1172 assembly_operand en_ao, max_ao;
1174 if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
1175 if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
1176 assembleg_2(stkpeek_gc, zero_operand, temp_var1);
1177 assembleg_2(stkpeek_gc, one_operand, temp_var2);
1180 assembleg_2(stkpeek_gc, zero_operand, temp_var1);
1181 assembleg_store(temp_var2, AO2);
1185 assembleg_store(temp_var1, AO1);
1186 if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
1187 assembleg_2(stkpeek_gc, zero_operand, temp_var2);
1190 assembleg_store(temp_var2, AO2);
1195 max_ao.value = NUM_ATTR_BYTES*8;
1196 set_constant_ot(&max_ao);
1197 assembleg_2_branch(jlt_gc, temp_var2, zero_operand, fa_label);
1198 assembleg_2_branch(jlt_gc, temp_var2, max_ao, pa_label);
1199 assemble_label_no(fa_label);
1201 en_ao.value = 19; /* INVALIDATTR_RTE */
1202 set_constant_ot(&en_ao);
1203 assembleg_store(stack_pointer, temp_var2);
1204 assembleg_store(stack_pointer, temp_var1);
1205 assembleg_store(stack_pointer, en_ao);
1206 assembleg_3(call_gc, veneer_routine(RT__Err_VR),
1207 three_operand, zero_operand);
1209 va_label = next_label++;
1210 assembleg_jump(va_label);
1211 assemble_label_no(pa_label);
1214 if (is_constant_ot(AO2.type) && AO2.marker == 0) {
1216 set_constant_ot(&AO2);
1221 AO4.type = BYTECONSTANT_OT;
1222 if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
1223 if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
1224 assembleg_0(stkswap_gc);
1225 assembleg_3(add_gc, AO2, AO4, stack_pointer);
1226 assembleg_0(stkswap_gc);
1229 assembleg_3(add_gc, AO2, AO4, stack_pointer);
1231 AO2 = stack_pointer;
1233 assembleg_3(aloadbit_gc, AO1, AO2, stack_pointer);
1234 the_zc = (flag ? jnz_gc : jz_gc);
1235 AO1 = stack_pointer;
1239 check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"in/notin\" expression");
1240 check_warn_symbol_type(&AO2, OBJECT_T, CLASS_T, "\"in/notin\" expression");
1241 if (runtime_error_checking_switch) {
1243 error_label = next_label++;
1244 AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
1247 AO4.value = GOBJFIELD_PARENT();
1248 AO4.type = BYTECONSTANT_OT;
1249 assembleg_3(aload_gc, AO1, AO4, stack_pointer);
1250 AO1 = stack_pointer;
1251 the_zc = (flag ? jeq_gc : jne_gc);
1255 /* first argument can be anything */
1256 check_warn_symbol_type(&AO2, CLASS_T, 0, "\"ofclass\" expression");
1257 assembleg_call_2(veneer_routine(OC__Cl_VR), AO1, AO2, stack_pointer);
1258 the_zc = (flag ? jnz_gc : jz_gc);
1259 AO1 = stack_pointer;
1263 /* first argument can be anything */
1264 check_warn_symbol_type(&AO2, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"provides\" expression");
1265 assembleg_call_2(veneer_routine(OP__Pr_VR), AO1, AO2, stack_pointer);
1266 the_zc = (flag ? jnz_gc : jz_gc);
1267 AO1 = stack_pointer;
1271 error("condition not yet supported in Glulx");
1276 if (the_zc == jnz_gc || the_zc == jz_gc)
1277 assembleg_1_branch(the_zc, AO1, label);
1279 assembleg_2_branch(the_zc, AO1, AO2, label);
1280 if (error_label != label) assemble_label_no(error_label);
1281 if (va_flag) assemble_label_no(va_label);
1284 static void value_in_void_context(assembly_operand AO)
1287 value_in_void_context_z(AO);
1289 value_in_void_context_g(AO);
1293 extern assembly_operand check_nonzero_at_runtime(assembly_operand AO1,
1294 int error_label, int rte_number)
1297 return check_nonzero_at_runtime_z(AO1, error_label, rte_number);
1299 return check_nonzero_at_runtime_g(AO1, error_label, rte_number);
1302 static void generate_code_from(int n, int void_flag)
1304 /* When void, this must not leave anything on the stack. */
1306 int i, j, below, above, opnum, arity; assembly_operand Result;
1308 below = ET[n].down; above = ET[n].up;
1310 { if ((void_flag) && (ET[n].value.type != OMITTED_OT))
1311 value_in_void_context(ET[n].value);
1315 opnum = ET[n].operator_number;
1317 if (opnum == COMMA_OP)
1318 { generate_code_from(below, TRUE);
1319 generate_code_from(ET[below].right, void_flag);
1320 ET[n].value = ET[ET[below].right].value;
1321 goto OperatorGenerated;
1324 if ((opnum == LOGAND_OP) || (opnum == LOGOR_OP))
1325 { generate_code_from(below, FALSE);
1326 if (execution_never_reaches_here) {
1327 /* If the condition never falls through to here, then it
1328 was an "... && 0 && ..." test. Our convention is to skip
1329 the "not reached" warnings for this case. */
1330 execution_never_reaches_here |= EXECSTATE_NOWARN;
1332 generate_code_from(ET[below].right, FALSE);
1333 goto OperatorGenerated;
1338 /* Signifies a SETEQUALS_OP which has already been done */
1340 ET[n].down = -1; return;
1343 /* Note that (except in the cases of comma and logical and/or) it
1344 is essential to code generate the operands right to left, because
1345 of the peculiar way the Z-machine's stack works:
1349 (for instance) pulls to the first operand, then the second. So
1355 calculates (b+7)-(a*2), not the other way around (as would be more
1356 usual in stack machines evaluating expressions written in reverse
1357 Polish notation). (Basically this is because the Z-machine was
1358 designed to implement a LISP-like language naturally expressed
1359 in forward Polish notation: (PLUS 3 4), for instance.) */
1361 /* And the Glulx machine follows the Z-machine in this respect. */
1365 { i = ET[i].right; arity++;
1367 for (j=arity;j>0;j--)
1371 { k++; i = ET[i].right;
1373 generate_code_from(i, FALSE);
1377 /* Check this again, because code generation lower down may have
1378 stubbed it into -1 */
1380 if (ET[n].operator_number == -1)
1381 { ET[n].down = -1; return;
1386 if (operators[opnum].opcode_number_z >= 400)
1388 /* Conditional terms such as '==': */
1390 int a = ET[n].true_label, b = ET[n].false_label,
1391 branch_away, branch_other,
1392 make_jump_away = FALSE, make_branch_label = FALSE;
1393 int oc = operators[opnum].opcode_number_z-400, flag = TRUE;
1395 if (oc >= 400) { oc = oc - 400; flag = FALSE; }
1397 if ((oc == je_zc) && (arity == 2))
1398 { i = ET[ET[n].down].right;
1399 if ((ET[i].value.value == zero_operand.value)
1400 && (ET[i].value.type == zero_operand.type))
1404 /* If the condition has truth state flag, branch to
1405 label a, and if not, to label b. Possibly one of a, b
1406 equals -1, meaning "continue from this instruction".
1408 branch_away is the label which is a branch away (the one
1409 which isn't immediately after) and flag is the truth
1410 state to branch there.
1412 Note that when multiple instructions are needed (because
1413 of the use of the 'or' operator) the branch_other label
1414 is created if need be.
1417 /* Reduce to the case where the branch_away label does exist: */
1419 if (a == -1) { a = b; b = -1; flag = !flag; }
1421 branch_away = a; branch_other = b;
1422 if (branch_other != -1) make_jump_away = TRUE;
1424 if ((((oc != je_zc)&&(arity > 2)) || (arity > 4)) && (flag == FALSE))
1426 /* In this case, we have an 'or' situation where multiple
1427 instructions are needed and where the overall condition
1428 is negated. That is, we have, e.g.
1430 if not (A cond B or C or D) then branch_away
1432 which we transform into
1434 if (A cond B) then branch_other
1435 if (A cond C) then branch_other
1436 if not (A cond D) then branch_away
1439 if (branch_other == -1)
1440 { branch_other = next_label++; make_branch_label = TRUE;
1445 assemblez_1_branch(jz_zc, ET[below].value, branch_away, flag);
1447 { assembly_operand left_operand;
1450 compile_conditional_z(oc, ET[below].value,
1451 ET[ET[below].right].value, branch_away, flag);
1453 { /* The case of a condition using "or".
1454 First: if the condition tests the stack pointer,
1455 and it can't always be done in a single test, move
1456 the value off the stack and into temporary variable
1459 if (((ET[below].value.type == VARIABLE_OT)
1460 && (ET[below].value.value == 0))
1461 && ((oc != je_zc) || (arity>4)) )
1462 { INITAOTV(&left_operand, VARIABLE_OT, 255);
1463 assemblez_store(left_operand, ET[below].value);
1465 else left_operand = ET[below].value;
1466 i = ET[below].right; arity--;
1468 /* "left_operand" now holds the quantity to be tested;
1469 "i" holds the right operand reached so far;
1470 "arity" the number of right operands. */
1473 { if ((oc == je_zc) && (arity>1))
1475 /* je_zc is an especially good case since the
1476 Z-machine implements "or" for up to three
1477 right operands automatically, though it's an
1478 especially bad case to generate code for! */
1481 { assemblez_3_branch(je_zc,
1482 left_operand, ET[i].value,
1483 ET[ET[i].right].value, branch_away, flag);
1484 i = ET[i].right; arity--;
1487 { if ((arity == 3) || flag)
1488 assemblez_4_branch(je_zc, left_operand,
1490 ET[ET[i].right].value,
1491 ET[ET[ET[i].right].right].value,
1494 assemblez_4_branch(je_zc, left_operand,
1496 ET[ET[i].right].value,
1497 ET[ET[ET[i].right].right].value,
1498 branch_other, !flag);
1499 i = ET[ET[i].right].right; arity -= 2;
1503 { /* Otherwise we can compare the left_operand with
1504 only one right operand at the time. There are
1505 two cases: it's the last right operand, or it
1508 if ((arity == 1) || flag)
1509 compile_conditional_z(oc, left_operand,
1510 ET[i].value, branch_away, flag);
1512 compile_conditional_z(oc, left_operand,
1513 ET[i].value, branch_other, !flag);
1515 i = ET[i].right; arity--;
1521 /* NB: These two conditions cannot both occur, fortunately! */
1523 if (make_branch_label) assemble_label_no(branch_other);
1524 if (make_jump_away) assemblez_jump(branch_other);
1526 goto OperatorGenerated;
1531 if (operators[opnum].opcode_number_g >= FIRST_CC
1532 && operators[opnum].opcode_number_g <= LAST_CC) {
1533 /* Conditional terms such as '==': */
1535 int a = ET[n].true_label, b = ET[n].false_label;
1536 int branch_away, branch_other, flag,
1537 make_jump_away = FALSE, make_branch_label = FALSE;
1538 int ccode = operators[opnum].opcode_number_g;
1539 condclass *cc = &condclasses[(ccode-FIRST_CC) / 2];
1540 flag = (ccode & 1) ? 0 : 1;
1542 /* If the comparison is "equal to (constant) 0", change it
1543 to the simple "zero" test. Unfortunately, this doesn't
1544 work for the commutative form "(constant) 0 is equal to".
1545 At least I don't think it does. */
1547 if ((cc == &condclasses[1]) && (arity == 2)) {
1548 i = ET[ET[n].down].right;
1549 if ((ET[i].value.value == 0)
1550 && (ET[i].value.marker == 0)
1551 && is_constant_ot(ET[i].value.type)) {
1552 cc = &condclasses[0];
1556 /* If the condition has truth state flag, branch to
1557 label a, and if not, to label b. Possibly one of a, b
1558 equals -1, meaning "continue from this instruction".
1560 branch_away is the label which is a branch away (the one
1561 which isn't immediately after) and flag is the truth
1562 state to branch there.
1564 Note that when multiple instructions are needed (because
1565 of the use of the 'or' operator) the branch_other label
1566 is created if need be.
1569 /* Reduce to the case where the branch_away label does exist: */
1571 if (a == -1) { a = b; b = -1; flag = !flag; }
1573 branch_away = a; branch_other = b;
1574 if (branch_other != -1) make_jump_away = TRUE;
1576 if ((arity > 2) && (flag == FALSE)) {
1577 /* In this case, we have an 'or' situation where multiple
1578 instructions are needed and where the overall condition
1579 is negated. That is, we have, e.g.
1581 if not (A cond B or C or D) then branch_away
1583 which we transform into
1585 if (A cond B) then branch_other
1586 if (A cond C) then branch_other
1587 if not (A cond D) then branch_away
1590 if (branch_other == -1) {
1591 branch_other = next_label++; make_branch_label = TRUE;
1595 if (cc == &condclasses[0]) {
1596 assembleg_1_branch((flag ? cc->posform : cc->negform),
1597 ET[below].value, branch_away);
1601 compile_conditional_g(cc, ET[below].value,
1602 ET[ET[below].right].value, branch_away, flag);
1605 /* The case of a condition using "or".
1606 First: if the condition tests the stack pointer,
1607 and it can't always be done in a single test, move
1608 the value off the stack and into temporary variable
1611 assembly_operand left_operand;
1612 if (((ET[below].value.type == LOCALVAR_OT)
1613 && (ET[below].value.value == 0))) {
1614 assembleg_store(temp_var1, ET[below].value);
1615 left_operand = temp_var1;
1618 left_operand = ET[below].value;
1620 i = ET[below].right;
1623 /* "left_operand" now holds the quantity to be tested;
1624 "i" holds the right operand reached so far;
1625 "arity" the number of right operands. */
1628 /* We can compare the left_operand with
1629 only one right operand at the time. There are
1630 two cases: it's the last right operand, or it
1633 if ((arity == 1) || flag)
1634 compile_conditional_g(cc, left_operand,
1635 ET[i].value, branch_away, flag);
1637 compile_conditional_g(cc, left_operand,
1638 ET[i].value, branch_other, !flag);
1646 /* NB: These two conditions cannot both occur, fortunately! */
1648 if (make_branch_label) assemble_label_no(branch_other);
1649 if (make_jump_away) assembleg_jump(branch_other);
1651 goto OperatorGenerated;
1656 /* The operator is now definitely one which produces a value */
1658 if (void_flag && (!(operators[opnum].side_effect)))
1659 error_named("Evaluating this has no effect:",
1660 operators[opnum].description);
1662 /* Where shall we put the resulting value? (In Glulx, this could
1663 be smarter, and peg the result into ZEROCONSTANT.) */
1665 if (void_flag) Result = temp_var1; /* Throw it away */
1667 { if ((above != -1) && (ET[above].operator_number == SETEQUALS_OP))
1669 /* If the node above is "set variable equal to", then
1670 make that variable the place to put the result, and
1671 delete the SETEQUALS_OP node since its effect has already
1672 been accomplished. */
1674 ET[above].operator_number = -1;
1675 Result = ET[ET[above].down].value;
1676 ET[above].value = Result;
1678 else Result = stack_pointer; /* Otherwise, put it on the stack */
1683 if (operators[opnum].opcode_number_z != -1)
1685 /* Operators directly translatable into Z-code opcodes: infix ops
1686 take two operands whereas pre/postfix operators take only one */
1688 if (operators[opnum].usage == IN_U)
1689 { int o_n = operators[opnum].opcode_number_z;
1690 if (runtime_error_checking_switch && (!veneer_mode)
1691 && ((o_n == div_zc) || (o_n == mod_zc)))
1692 { assembly_operand by_ao, error_ao; int ln;
1693 by_ao = ET[ET[below].right].value;
1694 if ((by_ao.value != 0) && (by_ao.marker == 0)
1695 && ((by_ao.type == SHORT_CONSTANT_OT)
1696 || (by_ao.type == LONG_CONSTANT_OT)))
1697 assemblez_2_to(o_n, ET[below].value,
1701 assemblez_store(temp_var1, ET[below].value);
1702 assemblez_store(temp_var2, by_ao);
1704 assemblez_1_branch(jz_zc, temp_var2, ln, FALSE);
1705 INITAOT(&error_ao, SHORT_CONSTANT_OT);
1706 error_ao.value = DBYZERO_RTE;
1707 assemblez_2(call_vn_zc, veneer_routine(RT__Err_VR),
1709 assemblez_inc(temp_var2);
1710 assemble_label_no(ln);
1711 assemblez_2_to(o_n, temp_var1, temp_var2, Result);
1715 assemblez_2_to(o_n, ET[below].value,
1716 ET[ET[below].right].value, Result);
1720 assemblez_1_to(operators[opnum].opcode_number_z, ET[below].value,
1726 access_memory_z(loadb_zc, ET[below].value,
1727 ET[ET[below].right].value, Result);
1730 access_memory_z(loadw_zc, ET[below].value,
1731 ET[ET[below].right].value, Result);
1733 case UNARY_MINUS_OP:
1734 assemblez_2_to(sub_zc, zero_operand, ET[below].value, Result);
1737 assemblez_1_to(not_zc, ET[below].value, Result);
1741 { assembly_operand AO = ET[below].value;
1742 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".&\" expression");
1743 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".&\" expression");
1744 if (runtime_error_checking_switch && (!veneer_mode))
1745 AO = check_nonzero_at_runtime(AO, -1, PROP_ADD_RTE);
1746 assemblez_2_to(get_prop_addr_zc, AO,
1747 ET[ET[below].right].value, temp_var1);
1748 if (!void_flag) write_result_z(Result, temp_var1);
1753 { assembly_operand AO = ET[below].value;
1754 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".#\" expression");
1755 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".#\" expression");
1756 if (runtime_error_checking_switch && (!veneer_mode))
1757 AO = check_nonzero_at_runtime(AO, -1, PROP_NUM_RTE);
1758 assemblez_2_to(get_prop_addr_zc, AO,
1759 ET[ET[below].right].value, temp_var1);
1760 assemblez_1_branch(jz_zc, temp_var1, next_label++, TRUE);
1761 assemblez_1_to(get_prop_len_zc, temp_var1, temp_var1);
1762 assemble_label_no(next_label-1);
1763 if (!void_flag) write_result_z(Result, temp_var1);
1769 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
1770 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
1771 if (runtime_error_checking_switch && (!veneer_mode))
1772 assemblez_3_to(call_vs_zc, veneer_routine(RT__ChPR_VR),
1773 ET[below].value, ET[ET[below].right].value, temp_var1);
1775 assemblez_2_to(get_prop_zc, ET[below].value,
1776 ET[ET[below].right].value, temp_var1);
1777 if (!void_flag) write_result_z(Result, temp_var1);
1782 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
1783 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
1784 j=1; AI.operand[0] = veneer_routine(RV__Pr_VR);
1785 goto GenFunctionCallZ;
1787 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".&\" expression");
1788 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".&\" expression");
1789 j=1; AI.operand[0] = veneer_routine(RA__Pr_VR);
1790 goto GenFunctionCallZ;
1792 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".#\" expression");
1793 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".#\" expression");
1794 j=1; AI.operand[0] = veneer_routine(RL__Pr_VR);
1795 goto GenFunctionCallZ;
1796 case MESSAGE_SETEQUALS_OP:
1797 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
1798 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
1799 j=1; AI.operand[0] = veneer_routine(WV__Pr_VR);
1800 goto GenFunctionCallZ;
1801 case MESSAGE_INC_OP:
1802 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"++.\" expression");
1803 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"++.\" expression");
1804 j=1; AI.operand[0] = veneer_routine(IB__Pr_VR);
1805 goto GenFunctionCallZ;
1806 case MESSAGE_DEC_OP:
1807 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"--.\" expression");
1808 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"--.\" expression");
1809 j=1; AI.operand[0] = veneer_routine(DB__Pr_VR);
1810 goto GenFunctionCallZ;
1811 case MESSAGE_POST_INC_OP:
1812 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".++\" expression");
1813 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".++\" expression");
1814 j=1; AI.operand[0] = veneer_routine(IA__Pr_VR);
1815 goto GenFunctionCallZ;
1816 case MESSAGE_POST_DEC_OP:
1817 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".--\" expression");
1818 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".--\" expression");
1819 j=1; AI.operand[0] = veneer_routine(DA__Pr_VR);
1820 goto GenFunctionCallZ;
1822 j=1; AI.operand[0] = veneer_routine(RA__Sc_VR);
1823 goto GenFunctionCallZ;
1825 check_warn_symbol_has_metaclass(&ET[below].value, "\".()\" expression");
1826 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".()\" expression");
1827 j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
1828 goto GenFunctionCallZ;
1829 case MESSAGE_CALL_OP:
1830 check_warn_symbol_has_metaclass(&ET[below].value, "\".()\" expression");
1831 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".()\" expression");
1832 j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
1833 goto GenFunctionCallZ;
1839 if ((ET[below].value.type == VARIABLE_OT)
1840 && (ET[below].value.value >= 256))
1841 { int sf_number = ET[below].value.value - 256;
1843 i = ET[below].right;
1845 { error("Argument to system function missing");
1846 AI.operand[0] = one_operand;
1847 AI.operand_count = 1;
1851 while (i != -1) { j++; i = ET[i].right; }
1853 if (((sf_number != INDIRECT_SYSF) &&
1854 (sf_number != RANDOM_SYSF) && (j > 1))
1855 || ((sf_number == INDIRECT_SYSF) && (j>7)))
1857 error("System function given with too many arguments");
1859 if (sf_number != RANDOM_SYSF)
1861 i = ET[below].right;
1862 for (jcount = 0; jcount < j; jcount++)
1863 { AI.operand[jcount] = ET[i].value;
1866 AI.operand_count = j;
1869 AI.store_variable_number = Result.value;
1870 AI.branch_label_number = -1;
1875 { assembly_operand AO, AO2; int arg_c, arg_et;
1876 INITAOTV(&AO, SHORT_CONSTANT_OT, j);
1877 INITAOT(&AO2, LONG_CONSTANT_OT);
1878 AO2.value = begin_word_array();
1879 AO2.marker = ARRAY_MV;
1881 for (arg_c=0, arg_et = ET[below].right;arg_c<j;
1882 arg_c++, arg_et = ET[arg_et].right)
1883 { if (ET[arg_et].value.type == VARIABLE_OT)
1884 error("Only constants can be used as possible 'random' results");
1885 array_entry(arg_c, FALSE, ET[arg_et].value);
1887 finish_array(arg_c, FALSE);
1889 assemblez_1_to(random_zc, AO, temp_var1);
1890 assemblez_dec(temp_var1);
1891 assemblez_2_to(loadw_zc, AO2, temp_var1, Result);
1894 assemblez_1_to(random_zc,
1895 ET[ET[below].right].value, Result);
1899 { assembly_operand AO;
1900 AO = ET[ET[below].right].value;
1901 if (runtime_error_checking_switch)
1902 AO = check_nonzero_at_runtime(AO, -1,
1904 assemblez_1_to(get_parent_zc, AO, Result);
1910 { assembly_operand AO;
1911 AO = ET[ET[below].right].value;
1912 if (runtime_error_checking_switch)
1913 AO = check_nonzero_at_runtime(AO, -1,
1914 (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
1915 assemblez_objcode(get_child_zc,
1916 AO, Result, -2, TRUE);
1922 { assembly_operand AO;
1923 AO = ET[ET[below].right].value;
1924 if (runtime_error_checking_switch)
1925 AO = check_nonzero_at_runtime(AO, -1,
1926 (sf_number==SIBLING_SYSF)
1927 ?SIBLING_RTE:YOUNGER_RTE);
1928 assemblez_objcode(get_sibling_zc,
1929 AO, Result, -2, TRUE);
1934 j=0; i = ET[below].right;
1935 check_warn_symbol_type(&ET[i].value, ROUTINE_T, 0, "indirect function call");
1936 goto IndirectFunctionCallZ;
1939 { assembly_operand AO;
1940 AO = ET[ET[below].right].value;
1941 if (runtime_error_checking_switch)
1942 AO = check_nonzero_at_runtime(AO, -1,
1944 assemblez_store(temp_var1, zero_operand);
1945 assemblez_objcode(get_child_zc,
1946 AO, stack_pointer, next_label+1, FALSE);
1947 assemble_label_no(next_label);
1948 assemblez_inc(temp_var1);
1949 assemblez_objcode(get_sibling_zc,
1950 stack_pointer, stack_pointer,
1952 assemble_label_no(next_label+1);
1953 assemblez_store(temp_var2, stack_pointer);
1954 if (!void_flag) write_result_z(Result, temp_var1);
1960 { assembly_operand AO;
1961 AO = ET[ET[below].right].value;
1962 if (runtime_error_checking_switch)
1963 AO = check_nonzero_at_runtime(AO, -1,
1965 assemblez_objcode(get_child_zc,
1966 AO, temp_var1, next_label+1, FALSE);
1967 assemblez_1(push_zc, temp_var1);
1968 assemble_label_no(next_label);
1969 assemblez_store(temp_var1, stack_pointer);
1970 assemblez_objcode(get_sibling_zc,
1971 temp_var1, stack_pointer, next_label, TRUE);
1972 assemble_label_no(next_label+1);
1973 if (!void_flag) write_result_z(Result, temp_var1);
1979 assemblez_store(temp_var1, ET[ET[below].right].value);
1980 if (runtime_error_checking_switch)
1981 check_nonzero_at_runtime(temp_var1, -1,
1983 assemblez_1_to(get_parent_zc, temp_var1, temp_var3);
1984 assemblez_1_branch(jz_zc, temp_var3,next_label+1,TRUE);
1985 assemblez_store(temp_var2, temp_var3);
1986 assemblez_store(temp_var3, zero_operand);
1987 assemblez_objcode(get_child_zc,
1988 temp_var2, temp_var2, next_label, TRUE);
1989 assemble_label_no(next_label++);
1990 assemblez_2_branch(je_zc, temp_var1, temp_var2,
1992 assemblez_store(temp_var3, temp_var2);
1993 assemblez_objcode(get_sibling_zc,
1994 temp_var2, temp_var2, next_label - 1, TRUE);
1995 assemble_label_no(next_label++);
1996 if (!void_flag) write_result_z(Result, temp_var3);
1999 case METACLASS_SYSF:
2000 assemblez_2_to((version_number==3)?call_zc:call_vs_zc,
2001 veneer_routine(Metaclass_VR),
2002 ET[ET[below].right].value, Result);
2006 error("The glk() system function does not exist in Z-code");
2011 check_warn_symbol_type(&ET[below].value, ROUTINE_T, 0, "function call");
2017 IndirectFunctionCallZ:
2019 while ((i != -1) && (j<8))
2020 { AI.operand[j++] = ET[i].value;
2024 if ((j > 4) && (version_number == 3))
2025 { error("A function may be called with at most 3 arguments");
2028 if ((j==8) && (i != -1))
2029 { error("A function may be called with at most 7 arguments");
2032 AI.operand_count = j;
2034 if ((void_flag) && (version_number >= 5))
2035 { AI.store_variable_number = -1;
2037 { case 1: AI.internal_number = call_1n_zc; break;
2038 case 2: AI.internal_number = call_2n_zc; break;
2039 case 3: case 4: AI.internal_number = call_vn_zc; break;
2040 case 5: case 6: case 7: case 8:
2041 AI.internal_number = call_vn2_zc; break;
2045 { AI.store_variable_number = Result.value;
2046 if (version_number == 3)
2047 AI.internal_number = call_zc;
2050 { case 1: AI.internal_number = call_1s_zc; break;
2051 case 2: AI.internal_number = call_2s_zc; break;
2052 case 3: case 4: AI.internal_number = call_vs_zc; break;
2053 case 5: case 6: case 7: case 8:
2054 AI.internal_number = call_vs2_zc; break;
2058 AI.branch_label_number = -1;
2059 assemblez_instruction(&AI);
2063 assemblez_store(ET[below].value,
2064 ET[ET[below].right].value);
2065 if (!void_flag) write_result_z(Result, ET[below].value);
2068 case PROPERTY_SETEQUALS_OP:
2069 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
2070 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
2072 { if (runtime_error_checking_switch)
2073 assemblez_4_to(call_zc, veneer_routine(RT__ChPS_VR),
2074 ET[below].value, ET[ET[below].right].value,
2075 ET[ET[ET[below].right].right].value, Result);
2077 { assemblez_store(temp_var1,
2078 ET[ET[ET[below].right].right].value);
2079 assemblez_3(put_prop_zc, ET[below].value,
2080 ET[ET[below].right].value,
2082 write_result_z(Result, temp_var1);
2086 { if (runtime_error_checking_switch && (!veneer_mode))
2087 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2088 ET[below].value, ET[ET[below].right].value,
2089 ET[ET[ET[below].right].right].value);
2090 else assemblez_3(put_prop_zc, ET[below].value,
2091 ET[ET[below].right].value,
2092 ET[ET[ET[below].right].right].value);
2095 case ARROW_SETEQUALS_OP:
2097 { assemblez_store(temp_var1,
2098 ET[ET[ET[below].right].right].value);
2099 access_memory_z(storeb_zc, ET[below].value,
2100 ET[ET[below].right].value,
2102 write_result_z(Result, temp_var1);
2104 else access_memory_z(storeb_zc, ET[below].value,
2105 ET[ET[below].right].value,
2106 ET[ET[ET[below].right].right].value);
2109 case DARROW_SETEQUALS_OP:
2111 { assemblez_store(temp_var1,
2112 ET[ET[ET[below].right].right].value);
2113 access_memory_z(storew_zc, ET[below].value,
2114 ET[ET[below].right].value,
2116 write_result_z(Result, temp_var1);
2119 access_memory_z(storew_zc, ET[below].value,
2120 ET[ET[below].right].value,
2121 ET[ET[ET[below].right].right].value);
2125 assemblez_inc(ET[below].value);
2126 if (!void_flag) write_result_z(Result, ET[below].value);
2129 assemblez_dec(ET[below].value);
2130 if (!void_flag) write_result_z(Result, ET[below].value);
2133 if (!void_flag) write_result_z(Result, ET[below].value);
2134 assemblez_inc(ET[below].value);
2137 if (!void_flag) write_result_z(Result, ET[below].value);
2138 assemblez_dec(ET[below].value);
2142 assemblez_store(temp_var1, ET[below].value);
2143 assemblez_store(temp_var2, ET[ET[below].right].value);
2144 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2145 assemblez_inc(temp_var3);
2146 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2147 if (!void_flag) write_result_z(Result, temp_var3);
2151 assemblez_store(temp_var1, ET[below].value);
2152 assemblez_store(temp_var2, ET[ET[below].right].value);
2153 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2154 assemblez_dec(temp_var3);
2155 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2156 if (!void_flag) write_result_z(Result, temp_var3);
2159 case ARROW_POST_INC_OP:
2160 assemblez_store(temp_var1, ET[below].value);
2161 assemblez_store(temp_var2, ET[ET[below].right].value);
2162 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2163 if (!void_flag) write_result_z(Result, temp_var3);
2164 assemblez_inc(temp_var3);
2165 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2168 case ARROW_POST_DEC_OP:
2169 assemblez_store(temp_var1, ET[below].value);
2170 assemblez_store(temp_var2, ET[ET[below].right].value);
2171 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2172 if (!void_flag) write_result_z(Result, temp_var3);
2173 assemblez_dec(temp_var3);
2174 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2178 assemblez_store(temp_var1, ET[below].value);
2179 assemblez_store(temp_var2, ET[ET[below].right].value);
2180 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2181 assemblez_inc(temp_var3);
2182 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2183 if (!void_flag) write_result_z(Result, temp_var3);
2187 assemblez_store(temp_var1, ET[below].value);
2188 assemblez_store(temp_var2, ET[ET[below].right].value);
2189 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2190 assemblez_dec(temp_var3);
2191 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2192 if (!void_flag) write_result_z(Result, temp_var3);
2195 case DARROW_POST_INC_OP:
2196 assemblez_store(temp_var1, ET[below].value);
2197 assemblez_store(temp_var2, ET[ET[below].right].value);
2198 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2199 if (!void_flag) write_result_z(Result, temp_var3);
2200 assemblez_inc(temp_var3);
2201 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2204 case DARROW_POST_DEC_OP:
2205 assemblez_store(temp_var1, ET[below].value);
2206 assemblez_store(temp_var2, ET[ET[below].right].value);
2207 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2208 if (!void_flag) write_result_z(Result, temp_var3);
2209 assemblez_dec(temp_var3);
2210 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2213 case PROPERTY_INC_OP:
2214 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"++.\" expression");
2215 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"++.\" expression");
2216 assemblez_store(temp_var1, ET[below].value);
2217 assemblez_store(temp_var2, ET[ET[below].right].value);
2218 assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2219 assemblez_inc(temp_var3);
2220 if (runtime_error_checking_switch && (!veneer_mode))
2221 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2222 temp_var1, temp_var2, temp_var3);
2223 else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2224 if (!void_flag) write_result_z(Result, temp_var3);
2227 case PROPERTY_DEC_OP:
2228 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"--.\" expression");
2229 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"--.\" expression");
2230 assemblez_store(temp_var1, ET[below].value);
2231 assemblez_store(temp_var2, ET[ET[below].right].value);
2232 assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2233 assemblez_dec(temp_var3);
2234 if (runtime_error_checking_switch && (!veneer_mode))
2235 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2236 temp_var1, temp_var2, temp_var3);
2237 else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2238 if (!void_flag) write_result_z(Result, temp_var3);
2241 case PROPERTY_POST_INC_OP:
2242 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".++\" expression");
2243 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".++\" expression");
2244 assemblez_store(temp_var1, ET[below].value);
2245 assemblez_store(temp_var2, ET[ET[below].right].value);
2246 assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2247 if (!void_flag) write_result_z(Result, temp_var3);
2248 assemblez_inc(temp_var3);
2249 if (runtime_error_checking_switch && (!veneer_mode))
2250 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2251 temp_var1, temp_var2, temp_var3);
2252 else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2255 case PROPERTY_POST_DEC_OP:
2256 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".--\" expression");
2257 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".--\" expression");
2258 assemblez_store(temp_var1, ET[below].value);
2259 assemblez_store(temp_var2, ET[ET[below].right].value);
2260 assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2261 if (!void_flag) write_result_z(Result, temp_var3);
2262 assemblez_dec(temp_var3);
2263 if (runtime_error_checking_switch && (!veneer_mode))
2264 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2265 temp_var1, temp_var2, temp_var3);
2266 else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2270 printf("** Trouble op = %d i.e. '%s' **\n",
2271 opnum, operators[opnum].description);
2272 compiler_error("Expr code gen: Can't generate yet");
2276 assembly_operand AO, AO2;
2277 if (operators[opnum].opcode_number_g != -1)
2279 /* Operators directly translatable into opcodes: infix ops
2280 take two operands whereas pre/postfix operators take only one */
2282 if (operators[opnum].usage == IN_U)
2283 { int o_n = operators[opnum].opcode_number_g;
2284 if (runtime_error_checking_switch && (!veneer_mode)
2285 && ((o_n == div_gc) || (o_n == mod_gc)))
2286 { assembly_operand by_ao, error_ao; int ln;
2287 by_ao = ET[ET[below].right].value;
2288 if ((by_ao.value != 0) && (by_ao.marker == 0)
2289 && is_constant_ot(by_ao.type))
2290 assembleg_3(o_n, ET[below].value,
2293 { assembleg_store(temp_var1, ET[below].value);
2294 assembleg_store(temp_var2, by_ao);
2296 assembleg_1_branch(jnz_gc, temp_var2, ln);
2298 error_ao.value = DBYZERO_RTE;
2299 set_constant_ot(&error_ao);
2300 assembleg_call_1(veneer_routine(RT__Err_VR),
2301 error_ao, zero_operand);
2302 assembleg_store(temp_var2, one_operand);
2303 assemble_label_no(ln);
2304 assembleg_3(o_n, temp_var1, temp_var2, Result);
2308 assembleg_3(o_n, ET[below].value,
2309 ET[ET[below].right].value, Result);
2312 assembleg_2(operators[opnum].opcode_number_g, ET[below].value,
2320 if (ET[below].value.type == Result.type
2321 && ET[below].value.value == Result.value
2322 && ET[below].value.marker == Result.marker)
2324 assembleg_2(copy_gc, ET[below].value, Result);
2327 case UNARY_MINUS_OP:
2328 assembleg_2(neg_gc, ET[below].value, Result);
2331 assembleg_2(bitnot_gc, ET[below].value, Result);
2335 access_memory_g(aloadb_gc, ET[below].value,
2336 ET[ET[below].right].value, Result);
2339 access_memory_g(aload_gc, ET[below].value,
2340 ET[ET[below].right].value, Result);
2344 assembleg_store(ET[below].value,
2345 ET[ET[below].right].value);
2346 if (!void_flag) write_result_g(Result, ET[below].value);
2349 case ARROW_SETEQUALS_OP:
2351 { assembleg_store(temp_var1,
2352 ET[ET[ET[below].right].right].value);
2353 access_memory_g(astoreb_gc, ET[below].value,
2354 ET[ET[below].right].value,
2356 write_result_g(Result, temp_var1);
2358 else access_memory_g(astoreb_gc, ET[below].value,
2359 ET[ET[below].right].value,
2360 ET[ET[ET[below].right].right].value);
2363 case DARROW_SETEQUALS_OP:
2365 { assembleg_store(temp_var1,
2366 ET[ET[ET[below].right].right].value);
2367 access_memory_g(astore_gc, ET[below].value,
2368 ET[ET[below].right].value,
2370 write_result_g(Result, temp_var1);
2373 access_memory_g(astore_gc, ET[below].value,
2374 ET[ET[below].right].value,
2375 ET[ET[ET[below].right].right].value);
2379 assembleg_inc(ET[below].value);
2380 if (!void_flag) write_result_g(Result, ET[below].value);
2383 assembleg_dec(ET[below].value);
2384 if (!void_flag) write_result_g(Result, ET[below].value);
2387 if (!void_flag) write_result_g(Result, ET[below].value);
2388 assembleg_inc(ET[below].value);
2391 if (!void_flag) write_result_g(Result, ET[below].value);
2392 assembleg_dec(ET[below].value);
2396 assembleg_store(temp_var1, ET[below].value);
2397 assembleg_store(temp_var2, ET[ET[below].right].value);
2398 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2399 assembleg_inc(temp_var3);
2400 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2401 if (!void_flag) write_result_g(Result, temp_var3);
2405 assembleg_store(temp_var1, ET[below].value);
2406 assembleg_store(temp_var2, ET[ET[below].right].value);
2407 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2408 assembleg_dec(temp_var3);
2409 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2410 if (!void_flag) write_result_g(Result, temp_var3);
2413 case ARROW_POST_INC_OP:
2414 assembleg_store(temp_var1, ET[below].value);
2415 assembleg_store(temp_var2, ET[ET[below].right].value);
2416 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2417 if (!void_flag) write_result_g(Result, temp_var3);
2418 assembleg_inc(temp_var3);
2419 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2422 case ARROW_POST_DEC_OP:
2423 assembleg_store(temp_var1, ET[below].value);
2424 assembleg_store(temp_var2, ET[ET[below].right].value);
2425 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2426 if (!void_flag) write_result_g(Result, temp_var3);
2427 assembleg_dec(temp_var3);
2428 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2432 assembleg_store(temp_var1, ET[below].value);
2433 assembleg_store(temp_var2, ET[ET[below].right].value);
2434 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2435 assembleg_inc(temp_var3);
2436 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2437 if (!void_flag) write_result_g(Result, temp_var3);
2441 assembleg_store(temp_var1, ET[below].value);
2442 assembleg_store(temp_var2, ET[ET[below].right].value);
2443 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2444 assembleg_dec(temp_var3);
2445 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2446 if (!void_flag) write_result_g(Result, temp_var3);
2449 case DARROW_POST_INC_OP:
2450 assembleg_store(temp_var1, ET[below].value);
2451 assembleg_store(temp_var2, ET[ET[below].right].value);
2452 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2453 if (!void_flag) write_result_g(Result, temp_var3);
2454 assembleg_inc(temp_var3);
2455 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2458 case DARROW_POST_DEC_OP:
2459 assembleg_store(temp_var1, ET[below].value);
2460 assembleg_store(temp_var2, ET[ET[below].right].value);
2461 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2462 if (!void_flag) write_result_g(Result, temp_var3);
2463 assembleg_dec(temp_var3);
2464 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2469 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
2470 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
2471 AO = veneer_routine(RV__Pr_VR);
2472 goto TwoArgFunctionCall;
2475 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".&\" expression");
2476 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".&\" expression");
2477 AO = veneer_routine(RA__Pr_VR);
2478 goto TwoArgFunctionCall;
2481 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".#\" expression");
2482 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".#\" expression");
2483 AO = veneer_routine(RL__Pr_VR);
2484 goto TwoArgFunctionCall;
2487 case MESSAGE_CALL_OP:
2488 check_warn_symbol_has_metaclass(&ET[below].value, "\".()\" expression");
2489 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".()\" expression");
2490 AO2 = veneer_routine(CA__Pr_VR);
2492 goto DoFunctionCall;
2494 case MESSAGE_INC_OP:
2495 case PROPERTY_INC_OP:
2496 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"++.\" expression");
2497 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"++.\" expression");
2498 AO = veneer_routine(IB__Pr_VR);
2499 goto TwoArgFunctionCall;
2500 case MESSAGE_DEC_OP:
2501 case PROPERTY_DEC_OP:
2502 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"--.\" expression");
2503 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"--.\" expression");
2504 AO = veneer_routine(DB__Pr_VR);
2505 goto TwoArgFunctionCall;
2506 case MESSAGE_POST_INC_OP:
2507 case PROPERTY_POST_INC_OP:
2508 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".++\" expression");
2509 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".++\" expression");
2510 AO = veneer_routine(IA__Pr_VR);
2511 goto TwoArgFunctionCall;
2512 case MESSAGE_POST_DEC_OP:
2513 case PROPERTY_POST_DEC_OP:
2514 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".--\" expression");
2515 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".--\" expression");
2516 AO = veneer_routine(DA__Pr_VR);
2517 goto TwoArgFunctionCall;
2519 AO = veneer_routine(RA__Sc_VR);
2520 goto TwoArgFunctionCall;
2524 assembly_operand AO2 = ET[below].value;
2525 assembly_operand AO3 = ET[ET[below].right].value;
2527 assembleg_call_2(AO, AO2, AO3, zero_operand);
2529 assembleg_call_2(AO, AO2, AO3, Result);
2533 case PROPERTY_SETEQUALS_OP:
2534 case MESSAGE_SETEQUALS_OP:
2535 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
2536 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
2537 if (runtime_error_checking_switch && (!veneer_mode))
2538 AO = veneer_routine(RT__ChPS_VR);
2540 AO = veneer_routine(WV__Pr_VR);
2543 assembly_operand AO2 = ET[below].value;
2544 assembly_operand AO3 = ET[ET[below].right].value;
2545 assembly_operand AO4 = ET[ET[ET[below].right].right].value;
2546 if (AO4.type == LOCALVAR_OT && AO4.value == 0) {
2547 /* Rightmost is on the stack; reduce to previous case. */
2548 if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2549 if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2550 /* both already on stack. */
2553 assembleg_store(stack_pointer, AO3);
2554 assembleg_0(stkswap_gc);
2558 if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2559 assembleg_store(stack_pointer, AO2);
2562 assembleg_store(stack_pointer, AO3);
2563 assembleg_store(stack_pointer, AO2);
2568 /* We have to get the rightmost on the stack, below the
2570 if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2571 if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2572 assembleg_store(stack_pointer, AO4);
2573 assembleg_2(stkroll_gc, three_operand, one_operand);
2576 assembleg_store(stack_pointer, AO4);
2577 assembleg_0(stkswap_gc);
2578 assembleg_store(stack_pointer, AO2);
2582 if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2583 assembleg_store(stack_pointer, AO4);
2584 assembleg_store(stack_pointer, AO3);
2585 assembleg_2(stkroll_gc, three_operand, two_operand);
2588 assembleg_store(stack_pointer, AO4);
2589 assembleg_store(stack_pointer, AO3);
2590 assembleg_store(stack_pointer, AO2);
2595 assembleg_3(call_gc, AO, three_operand, zero_operand);
2597 assembleg_3(call_gc, AO, three_operand, Result);
2604 if (ET[below].value.type == SYSFUN_OT)
2605 { int sf_number = ET[below].value.value;
2607 i = ET[below].right;
2609 { error("Argument to system function missing");
2610 AI.operand[0] = one_operand;
2611 AI.operand_count = 1;
2615 while (i != -1) { j++; i = ET[i].right; }
2617 if (((sf_number != INDIRECT_SYSF) &&
2618 (sf_number != GLK_SYSF) &&
2619 (sf_number != RANDOM_SYSF) && (j > 1)))
2621 error("System function given with too many arguments");
2623 if (sf_number != RANDOM_SYSF)
2625 i = ET[below].right;
2626 for (jcount = 0; jcount < j; jcount++)
2627 { AI.operand[jcount] = ET[i].value;
2630 AI.operand_count = j;
2638 { assembly_operand AO, AO2;
2642 set_constant_ot(&AO);
2643 INITAOTV(&AO2, CONSTANT_OT, begin_word_array());
2644 AO2.marker = ARRAY_MV;
2646 for (arg_c=0, arg_et = ET[below].right;arg_c<j;
2647 arg_c++, arg_et = ET[arg_et].right)
2648 { if (ET[arg_et].value.type == LOCALVAR_OT
2649 || ET[arg_et].value.type == GLOBALVAR_OT)
2650 error("Only constants can be used as possible 'random' results");
2651 array_entry(arg_c, FALSE, ET[arg_et].value);
2653 finish_array(arg_c, FALSE);
2655 assembleg_2(random_gc, AO, stack_pointer);
2656 assembleg_3(aload_gc, AO2, stack_pointer, Result);
2658 else if (is_constant_ot(ET[ET[below].right].value.type) && ET[ET[below].right].value.marker == 0) {
2659 /* One argument, value known at compile time */
2660 int32 arg = ET[ET[below].right].value.value; /* signed */
2662 assembly_operand AO;
2665 set_constant_ot(&AO);
2666 assembleg_2(random_gc,
2668 assembleg_3(add_gc, stack_pointer, one_operand,
2672 /* This handles zero or negative */
2673 assembly_operand AO;
2676 set_constant_ot(&AO);
2677 assembleg_1(setrandom_gc,
2679 assembleg_store(Result, zero_operand);
2683 /* One argument, not known at compile time */
2685 assembleg_store(temp_var1, ET[ET[below].right].value);
2688 assembleg_2_branch(jle_gc, temp_var1, zero_operand, ln);
2689 assembleg_2(random_gc,
2690 temp_var1, stack_pointer);
2691 assembleg_3(add_gc, stack_pointer, one_operand,
2693 assembleg_0_branch(jump_gc, ln2);
2694 assemble_label_no(ln);
2695 assembleg_2(neg_gc, temp_var1, stack_pointer);
2696 assembleg_1(setrandom_gc,
2698 assembleg_store(Result, zero_operand);
2699 assemble_label_no(ln2);
2704 { assembly_operand AO;
2705 AO = ET[ET[below].right].value;
2706 if (runtime_error_checking_switch)
2707 AO = check_nonzero_at_runtime(AO, -1,
2709 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
2710 assembleg_3(aload_gc, AO, AO2, Result);
2716 { assembly_operand AO;
2717 AO = ET[ET[below].right].value;
2718 if (runtime_error_checking_switch)
2719 AO = check_nonzero_at_runtime(AO, -1,
2720 (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
2721 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
2722 assembleg_3(aload_gc, AO, AO2, Result);
2728 { assembly_operand AO;
2729 AO = ET[ET[below].right].value;
2730 if (runtime_error_checking_switch)
2731 AO = check_nonzero_at_runtime(AO, -1,
2732 (sf_number==SIBLING_SYSF)
2733 ?SIBLING_RTE:YOUNGER_RTE);
2734 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_SIBLING());
2735 assembleg_3(aload_gc, AO, AO2, Result);
2740 { assembly_operand AO;
2741 AO = ET[ET[below].right].value;
2742 if (runtime_error_checking_switch)
2743 AO = check_nonzero_at_runtime(AO, -1,
2745 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
2746 assembleg_store(temp_var1, zero_operand);
2747 assembleg_3(aload_gc, AO, AO2, temp_var2);
2748 AO2.value = GOBJFIELD_SIBLING();
2749 assemble_label_no(next_label);
2750 assembleg_1_branch(jz_gc, temp_var2, next_label+1);
2751 assembleg_3(add_gc, temp_var1, one_operand,
2753 assembleg_3(aload_gc, temp_var2, AO2, temp_var2);
2754 assembleg_0_branch(jump_gc, next_label);
2755 assemble_label_no(next_label+1);
2758 write_result_g(Result, temp_var1);
2763 i = ET[below].right;
2764 check_warn_symbol_type(&ET[i].value, ROUTINE_T, 0, "indirect function call");
2765 goto IndirectFunctionCallG;
2768 AO2 = veneer_routine(Glk__Wrap_VR);
2769 i = ET[below].right;
2770 goto DoFunctionCall;
2772 case METACLASS_SYSF:
2773 assembleg_call_1(veneer_routine(Metaclass_VR),
2774 ET[ET[below].right].value, Result);
2778 AO = ET[ET[below].right].value;
2779 if (runtime_error_checking_switch)
2780 AO = check_nonzero_at_runtime(AO, -1,
2782 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
2783 assembleg_3(aload_gc, AO, AO2, temp_var1);
2784 AO2.value = GOBJFIELD_SIBLING();
2785 assembleg_1_branch(jz_gc, temp_var1, next_label+1);
2786 assemble_label_no(next_label);
2787 assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
2788 assembleg_1_branch(jz_gc, temp_var2, next_label+1);
2789 assembleg_store(temp_var1, temp_var2);
2790 assembleg_0_branch(jump_gc, next_label);
2791 assemble_label_no(next_label+1);
2793 write_result_g(Result, temp_var1);
2798 AO = ET[ET[below].right].value;
2799 if (runtime_error_checking_switch)
2800 AO = check_nonzero_at_runtime(AO, -1,
2802 assembleg_store(temp_var3, AO);
2803 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
2804 assembleg_3(aload_gc, temp_var3, AO2, temp_var1);
2805 assembleg_1_branch(jz_gc, temp_var1, next_label+2);
2806 AO2.value = GOBJFIELD_CHILD();
2807 assembleg_3(aload_gc, temp_var1, AO2, temp_var1);
2808 assembleg_1_branch(jz_gc, temp_var1, next_label+2);
2809 assembleg_2_branch(jeq_gc, temp_var3, temp_var1,
2811 assemble_label_no(next_label);
2812 AO2.value = GOBJFIELD_SIBLING();
2813 assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
2814 assembleg_2_branch(jeq_gc, temp_var3, temp_var2,
2816 assembleg_store(temp_var1, temp_var2);
2817 assembleg_0_branch(jump_gc, next_label);
2818 assemble_label_no(next_label+1);
2819 assembleg_store(temp_var1, zero_operand);
2820 assemble_label_no(next_label+2);
2822 write_result_g(Result, temp_var1);
2827 error("*** system function not implemented ***");
2834 check_warn_symbol_type(&ET[below].value, ROUTINE_T, 0, "function call");
2837 IndirectFunctionCallG:
2839 /* Get the function address. */
2846 /* If all the function arguments are in local/global
2847 variables, we have to push them all on the stack.
2848 If all of them are on the stack, we have to do nothing.
2849 If some are and some aren't, we have a hopeless mess,
2850 and we should throw a compiler error.
2856 /* begin part of patch G03701 */
2865 assembleg_2(callf_gc, AO2, void_flag ? zero_operand : Result);
2866 } else if (nargs==1) {
2867 assembleg_call_1(AO2, ET[i].value, void_flag ? zero_operand : Result);
2868 } else if (nargs==2) {
2869 assembly_operand o1 = ET[i].value;
2870 assembly_operand o2 = ET[ET[i].right].value;
2871 assembleg_call_2(AO2, o1, o2, void_flag ? zero_operand : Result);
2872 } else if (nargs==3) {
2873 assembly_operand o1 = ET[i].value;
2874 assembly_operand o2 = ET[ET[i].right].value;
2875 assembly_operand o3 = ET[ET[ET[i].right].right].value;
2876 assembleg_call_3(AO2, o1, o2, o3, void_flag ? zero_operand : Result);
2881 if (ET[i].value.type == LOCALVAR_OT
2882 && ET[i].value.value == 0) {
2886 assembleg_store(stack_pointer, ET[i].value);
2893 if (onstack && offstack)
2894 error("*** Function call cannot be generated with mixed arguments ***");
2896 error("*** Function call cannot be generated with more than one nonstack argument ***");
2900 set_constant_ot(&AO);
2903 assembleg_3(call_gc, AO2, AO, zero_operand);
2905 assembleg_3(call_gc, AO2, AO, Result);
2907 } /* else nargs>=4 */
2908 } /* DoFunctionCall: */
2913 printf("** Trouble op = %d i.e. '%s' **\n",
2914 opnum, operators[opnum].description);
2915 compiler_error("Expr code gen: Can't generate yet");
2919 ET[n].value = Result;
2925 if (ET[n].to_expression)
2929 warning("Logical expression has no side-effects");
2930 if (ET[n].true_label != -1)
2931 assemble_label_no(ET[n].true_label);
2933 assemble_label_no(ET[n].false_label);
2935 else if (ET[n].true_label != -1)
2937 donelabel = next_label++;
2938 if (!execution_never_reaches_here) {
2939 assemblez_1(push_zc, zero_operand);
2940 assemblez_jump(donelabel);
2942 assemble_label_no(ET[n].true_label);
2943 assemblez_1(push_zc, one_operand);
2944 assemble_forward_label_no(donelabel);
2948 donelabel = next_label++;
2949 if (!execution_never_reaches_here) {
2950 assemblez_1(push_zc, one_operand);
2951 assemblez_jump(donelabel);
2953 assemble_label_no(ET[n].false_label);
2954 assemblez_1(push_zc, zero_operand);
2955 assemble_forward_label_no(donelabel);
2957 ET[n].value = stack_pointer;
2960 if (ET[n].label_after != -1)
2961 assemble_label_no(ET[n].label_after);
2966 if (ET[n].to_expression)
2970 warning("Logical expression has no side-effects");
2971 if (ET[n].true_label != -1)
2972 assemble_label_no(ET[n].true_label);
2974 assemble_label_no(ET[n].false_label);
2976 else if (ET[n].true_label != -1)
2978 donelabel = next_label++;
2979 if (!execution_never_reaches_here) {
2980 assembleg_store(stack_pointer, zero_operand);
2981 assembleg_jump(donelabel);
2983 assemble_label_no(ET[n].true_label);
2984 assembleg_store(stack_pointer, one_operand);
2985 assemble_forward_label_no(donelabel);
2989 donelabel = next_label++;
2990 if (!execution_never_reaches_here) {
2991 assembleg_store(stack_pointer, one_operand);
2992 assembleg_jump(donelabel);
2994 assemble_label_no(ET[n].false_label);
2995 assembleg_store(stack_pointer, zero_operand);
2996 assemble_forward_label_no(donelabel);
2998 ET[n].value = stack_pointer;
3001 if (ET[n].label_after != -1)
3002 assemble_label_no(ET[n].label_after);
3009 assembly_operand code_generate(assembly_operand AO, int context, int label)
3011 /* Used in three contexts: VOID_CONTEXT, CONDITION_CONTEXT and
3014 If CONDITION_CONTEXT, then compile code branching to label number
3015 "label" if the condition is false: there's no return value.
3016 (Except that if label is -3 or -4 (internal codes for rfalse and
3017 rtrue rather than branch) then this is for branching when the
3018 condition is true. This is used for optimising code generation
3019 for "if" statements.)
3021 Otherwise return the assembly operand containing the result
3022 (probably the stack pointer variable but not necessarily:
3023 e.g. is would be short constant 2 from the expression "j++, 2") */
3027 if (AO.type != EXPRESSION_OT)
3029 { case VOID_CONTEXT:
3030 value_in_void_context(AO);
3031 AO.type = OMITTED_OT;
3034 case CONDITION_CONTEXT:
3036 if (label < -2) assemblez_1_branch(jz_zc, AO, label, FALSE);
3037 else assemblez_1_branch(jz_zc, AO, label, TRUE);
3041 assembleg_1_branch(jnz_gc, AO, label);
3043 assembleg_1_branch(jz_gc, AO, label);
3045 AO.type = OMITTED_OT;
3052 if (expr_trace_level >= 2)
3053 { printf("Raw parse tree:\n"); show_tree(&AO, FALSE);
3056 if (context == CONDITION_CONTEXT)
3057 { if (label < -2) annotate_for_conditions(AO.value, label, -1);
3058 else annotate_for_conditions(AO.value, -1, label);
3060 else annotate_for_conditions(AO.value, -1, -1);
3062 if (expr_trace_level >= 1)
3063 { printf("Code generation for expression in ");
3065 { case VOID_CONTEXT: printf("void"); break;
3066 case CONDITION_CONTEXT: printf("condition"); break;
3067 case QUANTITY_CONTEXT: printf("quantity"); break;
3068 case ASSEMBLY_CONTEXT: printf("assembly"); break;
3069 case ARRAY_CONTEXT: printf("array initialisation"); break;
3070 default: printf("* ILLEGAL *"); break;
3072 printf(" context with annotated tree:\n");
3073 show_tree(&AO, TRUE);
3076 generate_code_from(AO.value, (context==VOID_CONTEXT));
3077 return ET[AO.value].value;
3080 /* ========================================================================= */
3081 /* Data structure management routines */
3082 /* ------------------------------------------------------------------------- */
3084 extern void init_expressc_vars(void)
3088 extern void expressc_begin_pass(void)
3092 extern void expressc_allocate_arrays(void)
3096 extern void expressc_free_arrays(void)
3100 /* ========================================================================= */