1 /* ------------------------------------------------------------------------- */
2 /* "expressc" : The expression code generator */
4 /* Part of Inform 6.41 */
5 /* copyright (c) Graham Nelson 1993 - 2022 */
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 = symbol_index("Class", -1);
1088 AO3.value = symbols[ln].value;
1089 AO3.marker = OBJECT_MV;
1090 AO3.type = CONSTANT_OT;
1091 assembleg_2_branch(jne_gc, stack_pointer, AO3, passed_label);
1094 assemble_label_no(failed_label);
1096 AO2.value = rte_number;
1097 set_constant_ot(&AO2);
1098 assembleg_call_2(veneer_routine(RT__Err_VR), AO2, AO1, zero_operand);
1100 if (error_label != -1) {
1101 /* Jump to the error label */
1102 if (error_label == -3) assembleg_1(return_gc, zero_operand);
1103 else if (error_label == -4) assembleg_1(return_gc, one_operand);
1104 else assembleg_jump(error_label);
1107 /* Build the symbol for "Object" */
1108 ln = symbol_index("Object", -1);
1109 AO2.value = symbols[ln].value;
1110 AO2.marker = OBJECT_MV;
1111 AO2.type = CONSTANT_OT;
1114 assembleg_store(AO1, AO2);
1117 /* Store either "Object" or the operand's value in the temporary
1119 assembleg_store(temp_var2, AO2);
1120 last_label = next_label++;
1121 assembleg_jump(last_label);
1122 assemble_label_no(passed_label);
1123 assembleg_store(temp_var2, AO1);
1124 assemble_label_no(last_label);
1129 assemble_label_no(passed_label);
1133 static void compile_conditional_g(condclass *cc,
1134 assembly_operand AO1, assembly_operand AO2, int label, int flag)
1135 { assembly_operand AO4;
1136 int the_zc, error_label = label,
1137 va_flag = FALSE, va_label = 0;
1141 the_zc = (flag ? cc->posform : cc->negform);
1144 switch ((cc-condclasses)*2 + 500) {
1147 check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"has/hasnt\" expression");
1148 check_warn_symbol_type(&AO2, ATTRIBUTE_T, 0, "\"has/hasnt\" expression");
1149 if (runtime_error_checking_switch) {
1151 error_label = next_label++;
1152 AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
1153 if (is_constant_ot(AO2.type) && AO2.marker == 0) {
1154 if ((AO2.value < 0) || (AO2.value >= NUM_ATTR_BYTES*8)) {
1155 error("'has'/'hasnt' applied to illegal attribute number");
1159 int pa_label = next_label++, fa_label = next_label++;
1160 assembly_operand en_ao, max_ao;
1162 if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
1163 if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
1164 assembleg_2(stkpeek_gc, zero_operand, temp_var1);
1165 assembleg_2(stkpeek_gc, one_operand, temp_var2);
1168 assembleg_2(stkpeek_gc, zero_operand, temp_var1);
1169 assembleg_store(temp_var2, AO2);
1173 assembleg_store(temp_var1, AO1);
1174 if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
1175 assembleg_2(stkpeek_gc, zero_operand, temp_var2);
1178 assembleg_store(temp_var2, AO2);
1183 max_ao.value = NUM_ATTR_BYTES*8;
1184 set_constant_ot(&max_ao);
1185 assembleg_2_branch(jlt_gc, temp_var2, zero_operand, fa_label);
1186 assembleg_2_branch(jlt_gc, temp_var2, max_ao, pa_label);
1187 assemble_label_no(fa_label);
1189 en_ao.value = 19; /* INVALIDATTR_RTE */
1190 set_constant_ot(&en_ao);
1191 assembleg_store(stack_pointer, temp_var2);
1192 assembleg_store(stack_pointer, temp_var1);
1193 assembleg_store(stack_pointer, en_ao);
1194 assembleg_3(call_gc, veneer_routine(RT__Err_VR),
1195 three_operand, zero_operand);
1197 va_label = next_label++;
1198 assembleg_jump(va_label);
1199 assemble_label_no(pa_label);
1202 if (is_constant_ot(AO2.type) && AO2.marker == 0) {
1204 set_constant_ot(&AO2);
1209 AO4.type = BYTECONSTANT_OT;
1210 if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
1211 if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
1212 assembleg_0(stkswap_gc);
1213 assembleg_3(add_gc, AO2, AO4, stack_pointer);
1214 assembleg_0(stkswap_gc);
1217 assembleg_3(add_gc, AO2, AO4, stack_pointer);
1219 AO2 = stack_pointer;
1221 assembleg_3(aloadbit_gc, AO1, AO2, stack_pointer);
1222 the_zc = (flag ? jnz_gc : jz_gc);
1223 AO1 = stack_pointer;
1227 check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"in/notin\" expression");
1228 check_warn_symbol_type(&AO2, OBJECT_T, CLASS_T, "\"in/notin\" expression");
1229 if (runtime_error_checking_switch) {
1231 error_label = next_label++;
1232 AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
1235 AO4.value = GOBJFIELD_PARENT();
1236 AO4.type = BYTECONSTANT_OT;
1237 assembleg_3(aload_gc, AO1, AO4, stack_pointer);
1238 AO1 = stack_pointer;
1239 the_zc = (flag ? jeq_gc : jne_gc);
1243 /* first argument can be anything */
1244 check_warn_symbol_type(&AO2, CLASS_T, 0, "\"ofclass\" expression");
1245 assembleg_call_2(veneer_routine(OC__Cl_VR), AO1, AO2, stack_pointer);
1246 the_zc = (flag ? jnz_gc : jz_gc);
1247 AO1 = stack_pointer;
1251 /* first argument can be anything */
1252 check_warn_symbol_type(&AO2, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"provides\" expression");
1253 assembleg_call_2(veneer_routine(OP__Pr_VR), AO1, AO2, stack_pointer);
1254 the_zc = (flag ? jnz_gc : jz_gc);
1255 AO1 = stack_pointer;
1259 error("condition not yet supported in Glulx");
1264 if (the_zc == jnz_gc || the_zc == jz_gc)
1265 assembleg_1_branch(the_zc, AO1, label);
1267 assembleg_2_branch(the_zc, AO1, AO2, label);
1268 if (error_label != label) assemble_label_no(error_label);
1269 if (va_flag) assemble_label_no(va_label);
1272 static void value_in_void_context(assembly_operand AO)
1275 value_in_void_context_z(AO);
1277 value_in_void_context_g(AO);
1281 extern assembly_operand check_nonzero_at_runtime(assembly_operand AO1,
1282 int error_label, int rte_number)
1285 return check_nonzero_at_runtime_z(AO1, error_label, rte_number);
1287 return check_nonzero_at_runtime_g(AO1, error_label, rte_number);
1290 static void generate_code_from(int n, int void_flag)
1292 /* When void, this must not leave anything on the stack. */
1294 int i, j, below, above, opnum, arity; assembly_operand Result;
1296 below = ET[n].down; above = ET[n].up;
1298 { if ((void_flag) && (ET[n].value.type != OMITTED_OT))
1299 value_in_void_context(ET[n].value);
1303 opnum = ET[n].operator_number;
1305 if (opnum == COMMA_OP)
1306 { generate_code_from(below, TRUE);
1307 generate_code_from(ET[below].right, void_flag);
1308 ET[n].value = ET[ET[below].right].value;
1309 goto OperatorGenerated;
1312 if ((opnum == LOGAND_OP) || (opnum == LOGOR_OP))
1313 { generate_code_from(below, FALSE);
1314 if (execution_never_reaches_here) {
1315 /* If the condition never falls through to here, then it
1316 was an "... && 0 && ..." test. Our convention is to skip
1317 the "not reached" warnings for this case. */
1318 execution_never_reaches_here |= EXECSTATE_NOWARN;
1320 generate_code_from(ET[below].right, FALSE);
1321 goto OperatorGenerated;
1326 /* Signifies a SETEQUALS_OP which has already been done */
1328 ET[n].down = -1; return;
1331 /* Note that (except in the cases of comma and logical and/or) it
1332 is essential to code generate the operands right to left, because
1333 of the peculiar way the Z-machine's stack works:
1337 (for instance) pulls to the first operand, then the second. So
1343 calculates (b+7)-(a*2), not the other way around (as would be more
1344 usual in stack machines evaluating expressions written in reverse
1345 Polish notation). (Basically this is because the Z-machine was
1346 designed to implement a LISP-like language naturally expressed
1347 in forward Polish notation: (PLUS 3 4), for instance.) */
1349 /* And the Glulx machine follows the Z-machine in this respect. */
1353 { i = ET[i].right; arity++;
1355 for (j=arity;j>0;j--)
1359 { k++; i = ET[i].right;
1361 generate_code_from(i, FALSE);
1365 /* Check this again, because code generation lower down may have
1366 stubbed it into -1 */
1368 if (ET[n].operator_number == -1)
1369 { ET[n].down = -1; return;
1374 if (operators[opnum].opcode_number_z >= 400)
1376 /* Conditional terms such as '==': */
1378 int a = ET[n].true_label, b = ET[n].false_label,
1379 branch_away, branch_other,
1380 make_jump_away = FALSE, make_branch_label = FALSE;
1381 int oc = operators[opnum].opcode_number_z-400, flag = TRUE;
1383 if (oc >= 400) { oc = oc - 400; flag = FALSE; }
1385 if ((oc == je_zc) && (arity == 2))
1386 { i = ET[ET[n].down].right;
1387 if ((ET[i].value.value == zero_operand.value)
1388 && (ET[i].value.type == zero_operand.type))
1392 /* If the condition has truth state flag, branch to
1393 label a, and if not, to label b. Possibly one of a, b
1394 equals -1, meaning "continue from this instruction".
1396 branch_away is the label which is a branch away (the one
1397 which isn't immediately after) and flag is the truth
1398 state to branch there.
1400 Note that when multiple instructions are needed (because
1401 of the use of the 'or' operator) the branch_other label
1402 is created if need be.
1405 /* Reduce to the case where the branch_away label does exist: */
1407 if (a == -1) { a = b; b = -1; flag = !flag; }
1409 branch_away = a; branch_other = b;
1410 if (branch_other != -1) make_jump_away = TRUE;
1412 if ((((oc != je_zc)&&(arity > 2)) || (arity > 4)) && (flag == FALSE))
1414 /* In this case, we have an 'or' situation where multiple
1415 instructions are needed and where the overall condition
1416 is negated. That is, we have, e.g.
1418 if not (A cond B or C or D) then branch_away
1420 which we transform into
1422 if (A cond B) then branch_other
1423 if (A cond C) then branch_other
1424 if not (A cond D) then branch_away
1427 if (branch_other == -1)
1428 { branch_other = next_label++; make_branch_label = TRUE;
1433 assemblez_1_branch(jz_zc, ET[below].value, branch_away, flag);
1435 { assembly_operand left_operand;
1438 compile_conditional_z(oc, ET[below].value,
1439 ET[ET[below].right].value, branch_away, flag);
1441 { /* The case of a condition using "or".
1442 First: if the condition tests the stack pointer,
1443 and it can't always be done in a single test, move
1444 the value off the stack and into temporary variable
1447 if (((ET[below].value.type == VARIABLE_OT)
1448 && (ET[below].value.value == 0))
1449 && ((oc != je_zc) || (arity>4)) )
1450 { INITAOTV(&left_operand, VARIABLE_OT, 255);
1451 assemblez_store(left_operand, ET[below].value);
1453 else left_operand = ET[below].value;
1454 i = ET[below].right; arity--;
1456 /* "left_operand" now holds the quantity to be tested;
1457 "i" holds the right operand reached so far;
1458 "arity" the number of right operands. */
1461 { if ((oc == je_zc) && (arity>1))
1463 /* je_zc is an especially good case since the
1464 Z-machine implements "or" for up to three
1465 right operands automatically, though it's an
1466 especially bad case to generate code for! */
1469 { assemblez_3_branch(je_zc,
1470 left_operand, ET[i].value,
1471 ET[ET[i].right].value, branch_away, flag);
1472 i = ET[i].right; arity--;
1475 { if ((arity == 3) || flag)
1476 assemblez_4_branch(je_zc, left_operand,
1478 ET[ET[i].right].value,
1479 ET[ET[ET[i].right].right].value,
1482 assemblez_4_branch(je_zc, left_operand,
1484 ET[ET[i].right].value,
1485 ET[ET[ET[i].right].right].value,
1486 branch_other, !flag);
1487 i = ET[ET[i].right].right; arity -= 2;
1491 { /* Otherwise we can compare the left_operand with
1492 only one right operand at the time. There are
1493 two cases: it's the last right operand, or it
1496 if ((arity == 1) || flag)
1497 compile_conditional_z(oc, left_operand,
1498 ET[i].value, branch_away, flag);
1500 compile_conditional_z(oc, left_operand,
1501 ET[i].value, branch_other, !flag);
1503 i = ET[i].right; arity--;
1509 /* NB: These two conditions cannot both occur, fortunately! */
1511 if (make_branch_label) assemble_label_no(branch_other);
1512 if (make_jump_away) assemblez_jump(branch_other);
1514 goto OperatorGenerated;
1519 if (operators[opnum].opcode_number_g >= FIRST_CC
1520 && operators[opnum].opcode_number_g <= LAST_CC) {
1521 /* Conditional terms such as '==': */
1523 int a = ET[n].true_label, b = ET[n].false_label;
1524 int branch_away, branch_other, flag,
1525 make_jump_away = FALSE, make_branch_label = FALSE;
1526 int ccode = operators[opnum].opcode_number_g;
1527 condclass *cc = &condclasses[(ccode-FIRST_CC) / 2];
1528 flag = (ccode & 1) ? 0 : 1;
1530 /* If the comparison is "equal to (constant) 0", change it
1531 to the simple "zero" test. Unfortunately, this doesn't
1532 work for the commutative form "(constant) 0 is equal to".
1533 At least I don't think it does. */
1535 if ((cc == &condclasses[1]) && (arity == 2)) {
1536 i = ET[ET[n].down].right;
1537 if ((ET[i].value.value == 0)
1538 && (ET[i].value.marker == 0)
1539 && is_constant_ot(ET[i].value.type)) {
1540 cc = &condclasses[0];
1544 /* If the condition has truth state flag, branch to
1545 label a, and if not, to label b. Possibly one of a, b
1546 equals -1, meaning "continue from this instruction".
1548 branch_away is the label which is a branch away (the one
1549 which isn't immediately after) and flag is the truth
1550 state to branch there.
1552 Note that when multiple instructions are needed (because
1553 of the use of the 'or' operator) the branch_other label
1554 is created if need be.
1557 /* Reduce to the case where the branch_away label does exist: */
1559 if (a == -1) { a = b; b = -1; flag = !flag; }
1561 branch_away = a; branch_other = b;
1562 if (branch_other != -1) make_jump_away = TRUE;
1564 if ((arity > 2) && (flag == FALSE)) {
1565 /* In this case, we have an 'or' situation where multiple
1566 instructions are needed and where the overall condition
1567 is negated. That is, we have, e.g.
1569 if not (A cond B or C or D) then branch_away
1571 which we transform into
1573 if (A cond B) then branch_other
1574 if (A cond C) then branch_other
1575 if not (A cond D) then branch_away
1578 if (branch_other == -1) {
1579 branch_other = next_label++; make_branch_label = TRUE;
1583 if (cc == &condclasses[0]) {
1584 assembleg_1_branch((flag ? cc->posform : cc->negform),
1585 ET[below].value, branch_away);
1589 compile_conditional_g(cc, ET[below].value,
1590 ET[ET[below].right].value, branch_away, flag);
1593 /* The case of a condition using "or".
1594 First: if the condition tests the stack pointer,
1595 and it can't always be done in a single test, move
1596 the value off the stack and into temporary variable
1599 assembly_operand left_operand;
1600 if (((ET[below].value.type == LOCALVAR_OT)
1601 && (ET[below].value.value == 0))) {
1602 assembleg_store(temp_var1, ET[below].value);
1603 left_operand = temp_var1;
1606 left_operand = ET[below].value;
1608 i = ET[below].right;
1611 /* "left_operand" now holds the quantity to be tested;
1612 "i" holds the right operand reached so far;
1613 "arity" the number of right operands. */
1616 /* We can compare the left_operand with
1617 only one right operand at the time. There are
1618 two cases: it's the last right operand, or it
1621 if ((arity == 1) || flag)
1622 compile_conditional_g(cc, left_operand,
1623 ET[i].value, branch_away, flag);
1625 compile_conditional_g(cc, left_operand,
1626 ET[i].value, branch_other, !flag);
1634 /* NB: These two conditions cannot both occur, fortunately! */
1636 if (make_branch_label) assemble_label_no(branch_other);
1637 if (make_jump_away) assembleg_jump(branch_other);
1639 goto OperatorGenerated;
1644 /* The operator is now definitely one which produces a value */
1646 if (void_flag && (!(operators[opnum].side_effect)))
1647 error_named("Evaluating this has no effect:",
1648 operators[opnum].description);
1650 /* Where shall we put the resulting value? (In Glulx, this could
1651 be smarter, and peg the result into ZEROCONSTANT.) */
1653 if (void_flag) Result = temp_var1; /* Throw it away */
1655 { if ((above != -1) && (ET[above].operator_number == SETEQUALS_OP))
1657 /* If the node above is "set variable equal to", then
1658 make that variable the place to put the result, and
1659 delete the SETEQUALS_OP node since its effect has already
1660 been accomplished. */
1662 ET[above].operator_number = -1;
1663 Result = ET[ET[above].down].value;
1664 ET[above].value = Result;
1666 else Result = stack_pointer; /* Otherwise, put it on the stack */
1671 if (operators[opnum].opcode_number_z != -1)
1673 /* Operators directly translatable into Z-code opcodes: infix ops
1674 take two operands whereas pre/postfix operators take only one */
1676 if (operators[opnum].usage == IN_U)
1677 { int o_n = operators[opnum].opcode_number_z;
1678 if (runtime_error_checking_switch && (!veneer_mode)
1679 && ((o_n == div_zc) || (o_n == mod_zc)))
1680 { assembly_operand by_ao, error_ao; int ln;
1681 by_ao = ET[ET[below].right].value;
1682 if ((by_ao.value != 0) && (by_ao.marker == 0)
1683 && ((by_ao.type == SHORT_CONSTANT_OT)
1684 || (by_ao.type == LONG_CONSTANT_OT)))
1685 assemblez_2_to(o_n, ET[below].value,
1689 assemblez_store(temp_var1, ET[below].value);
1690 assemblez_store(temp_var2, by_ao);
1692 assemblez_1_branch(jz_zc, temp_var2, ln, FALSE);
1693 INITAOT(&error_ao, SHORT_CONSTANT_OT);
1694 error_ao.value = DBYZERO_RTE;
1695 assemblez_2(call_vn_zc, veneer_routine(RT__Err_VR),
1697 assemblez_inc(temp_var2);
1698 assemble_label_no(ln);
1699 assemblez_2_to(o_n, temp_var1, temp_var2, Result);
1703 assemblez_2_to(o_n, ET[below].value,
1704 ET[ET[below].right].value, Result);
1708 assemblez_1_to(operators[opnum].opcode_number_z, ET[below].value,
1714 access_memory_z(loadb_zc, ET[below].value,
1715 ET[ET[below].right].value, Result);
1718 access_memory_z(loadw_zc, ET[below].value,
1719 ET[ET[below].right].value, Result);
1721 case UNARY_MINUS_OP:
1722 assemblez_2_to(sub_zc, zero_operand, ET[below].value, Result);
1725 assemblez_1_to(not_zc, ET[below].value, Result);
1729 { assembly_operand AO = ET[below].value;
1730 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".&\" expression");
1731 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".&\" expression");
1732 if (runtime_error_checking_switch && (!veneer_mode))
1733 AO = check_nonzero_at_runtime(AO, -1, PROP_ADD_RTE);
1734 assemblez_2_to(get_prop_addr_zc, AO,
1735 ET[ET[below].right].value, temp_var1);
1736 if (!void_flag) write_result_z(Result, temp_var1);
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_NUM_RTE);
1746 assemblez_2_to(get_prop_addr_zc, AO,
1747 ET[ET[below].right].value, temp_var1);
1748 assemblez_1_branch(jz_zc, temp_var1, next_label++, TRUE);
1749 assemblez_1_to(get_prop_len_zc, temp_var1, temp_var1);
1750 assemble_label_no(next_label-1);
1751 if (!void_flag) write_result_z(Result, temp_var1);
1757 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
1758 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
1759 if (runtime_error_checking_switch && (!veneer_mode))
1760 assemblez_3_to(call_vs_zc, veneer_routine(RT__ChPR_VR),
1761 ET[below].value, ET[ET[below].right].value, temp_var1);
1763 assemblez_2_to(get_prop_zc, ET[below].value,
1764 ET[ET[below].right].value, temp_var1);
1765 if (!void_flag) write_result_z(Result, temp_var1);
1770 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
1771 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
1772 j=1; AI.operand[0] = veneer_routine(RV__Pr_VR);
1773 goto GenFunctionCallZ;
1775 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".&\" expression");
1776 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".&\" expression");
1777 j=1; AI.operand[0] = veneer_routine(RA__Pr_VR);
1778 goto GenFunctionCallZ;
1780 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".#\" expression");
1781 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".#\" expression");
1782 j=1; AI.operand[0] = veneer_routine(RL__Pr_VR);
1783 goto GenFunctionCallZ;
1784 case MESSAGE_SETEQUALS_OP:
1785 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
1786 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
1787 j=1; AI.operand[0] = veneer_routine(WV__Pr_VR);
1788 goto GenFunctionCallZ;
1789 case MESSAGE_INC_OP:
1790 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"++.\" expression");
1791 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"++.\" expression");
1792 j=1; AI.operand[0] = veneer_routine(IB__Pr_VR);
1793 goto GenFunctionCallZ;
1794 case MESSAGE_DEC_OP:
1795 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"--.\" expression");
1796 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"--.\" expression");
1797 j=1; AI.operand[0] = veneer_routine(DB__Pr_VR);
1798 goto GenFunctionCallZ;
1799 case MESSAGE_POST_INC_OP:
1800 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".++\" expression");
1801 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".++\" expression");
1802 j=1; AI.operand[0] = veneer_routine(IA__Pr_VR);
1803 goto GenFunctionCallZ;
1804 case MESSAGE_POST_DEC_OP:
1805 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".--\" expression");
1806 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".--\" expression");
1807 j=1; AI.operand[0] = veneer_routine(DA__Pr_VR);
1808 goto GenFunctionCallZ;
1810 j=1; AI.operand[0] = veneer_routine(RA__Sc_VR);
1811 goto GenFunctionCallZ;
1813 check_warn_symbol_has_metaclass(&ET[below].value, "\".()\" expression");
1814 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".()\" expression");
1815 j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
1816 goto GenFunctionCallZ;
1817 case MESSAGE_CALL_OP:
1818 check_warn_symbol_has_metaclass(&ET[below].value, "\".()\" expression");
1819 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".()\" expression");
1820 j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
1821 goto GenFunctionCallZ;
1827 if ((ET[below].value.type == VARIABLE_OT)
1828 && (ET[below].value.value >= 256))
1829 { int sf_number = ET[below].value.value - 256;
1831 i = ET[below].right;
1833 { error("Argument to system function missing");
1834 AI.operand[0] = one_operand;
1835 AI.operand_count = 1;
1839 while (i != -1) { j++; i = ET[i].right; }
1841 if (((sf_number != INDIRECT_SYSF) &&
1842 (sf_number != RANDOM_SYSF) && (j > 1))
1843 || ((sf_number == INDIRECT_SYSF) && (j>7)))
1845 error("System function given with too many arguments");
1847 if (sf_number != RANDOM_SYSF)
1849 i = ET[below].right;
1850 for (jcount = 0; jcount < j; jcount++)
1851 { AI.operand[jcount] = ET[i].value;
1854 AI.operand_count = j;
1857 AI.store_variable_number = Result.value;
1858 AI.branch_label_number = -1;
1863 { assembly_operand AO, AO2; int arg_c, arg_et;
1864 INITAOTV(&AO, SHORT_CONSTANT_OT, j);
1865 INITAOT(&AO2, LONG_CONSTANT_OT);
1866 AO2.value = begin_word_array();
1867 AO2.marker = ARRAY_MV;
1869 for (arg_c=0, arg_et = ET[below].right;arg_c<j;
1870 arg_c++, arg_et = ET[arg_et].right)
1871 { if (ET[arg_et].value.type == VARIABLE_OT)
1872 error("Only constants can be used as possible 'random' results");
1873 array_entry(arg_c, FALSE, ET[arg_et].value);
1875 finish_array(arg_c, FALSE);
1877 assemblez_1_to(random_zc, AO, temp_var1);
1878 assemblez_dec(temp_var1);
1879 assemblez_2_to(loadw_zc, AO2, temp_var1, Result);
1882 assemblez_1_to(random_zc,
1883 ET[ET[below].right].value, Result);
1887 { assembly_operand AO;
1888 AO = ET[ET[below].right].value;
1889 if (runtime_error_checking_switch)
1890 AO = check_nonzero_at_runtime(AO, -1,
1892 assemblez_1_to(get_parent_zc, AO, Result);
1898 { assembly_operand AO;
1899 AO = ET[ET[below].right].value;
1900 if (runtime_error_checking_switch)
1901 AO = check_nonzero_at_runtime(AO, -1,
1902 (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
1903 assemblez_objcode(get_child_zc,
1904 AO, Result, -2, TRUE);
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==SIBLING_SYSF)
1915 ?SIBLING_RTE:YOUNGER_RTE);
1916 assemblez_objcode(get_sibling_zc,
1917 AO, Result, -2, TRUE);
1922 j=0; i = ET[below].right;
1923 check_warn_symbol_type(&ET[i].value, ROUTINE_T, 0, "indirect function call");
1924 goto IndirectFunctionCallZ;
1927 { assembly_operand AO;
1928 AO = ET[ET[below].right].value;
1929 if (runtime_error_checking_switch)
1930 AO = check_nonzero_at_runtime(AO, -1,
1932 assemblez_store(temp_var1, zero_operand);
1933 assemblez_objcode(get_child_zc,
1934 AO, stack_pointer, next_label+1, FALSE);
1935 assemble_label_no(next_label);
1936 assemblez_inc(temp_var1);
1937 assemblez_objcode(get_sibling_zc,
1938 stack_pointer, stack_pointer,
1940 assemble_label_no(next_label+1);
1941 assemblez_store(temp_var2, stack_pointer);
1942 if (!void_flag) write_result_z(Result, temp_var1);
1948 { assembly_operand AO;
1949 AO = ET[ET[below].right].value;
1950 if (runtime_error_checking_switch)
1951 AO = check_nonzero_at_runtime(AO, -1,
1953 assemblez_objcode(get_child_zc,
1954 AO, temp_var1, next_label+1, FALSE);
1955 assemblez_1(push_zc, temp_var1);
1956 assemble_label_no(next_label);
1957 assemblez_store(temp_var1, stack_pointer);
1958 assemblez_objcode(get_sibling_zc,
1959 temp_var1, stack_pointer, next_label, TRUE);
1960 assemble_label_no(next_label+1);
1961 if (!void_flag) write_result_z(Result, temp_var1);
1967 assemblez_store(temp_var1, ET[ET[below].right].value);
1968 if (runtime_error_checking_switch)
1969 check_nonzero_at_runtime(temp_var1, -1,
1971 assemblez_1_to(get_parent_zc, temp_var1, temp_var3);
1972 assemblez_1_branch(jz_zc, temp_var3,next_label+1,TRUE);
1973 assemblez_store(temp_var2, temp_var3);
1974 assemblez_store(temp_var3, zero_operand);
1975 assemblez_objcode(get_child_zc,
1976 temp_var2, temp_var2, next_label, TRUE);
1977 assemble_label_no(next_label++);
1978 assemblez_2_branch(je_zc, temp_var1, temp_var2,
1980 assemblez_store(temp_var3, temp_var2);
1981 assemblez_objcode(get_sibling_zc,
1982 temp_var2, temp_var2, next_label - 1, TRUE);
1983 assemble_label_no(next_label++);
1984 if (!void_flag) write_result_z(Result, temp_var3);
1987 case METACLASS_SYSF:
1988 assemblez_2_to((version_number==3)?call_zc:call_vs_zc,
1989 veneer_routine(Metaclass_VR),
1990 ET[ET[below].right].value, Result);
1994 error("The glk() system function does not exist in Z-code");
1999 check_warn_symbol_type(&ET[below].value, ROUTINE_T, 0, "function call");
2005 IndirectFunctionCallZ:
2007 while ((i != -1) && (j<8))
2008 { AI.operand[j++] = ET[i].value;
2012 if ((j > 4) && (version_number == 3))
2013 { error("A function may be called with at most 3 arguments");
2016 if ((j==8) && (i != -1))
2017 { error("A function may be called with at most 7 arguments");
2020 AI.operand_count = j;
2022 if ((void_flag) && (version_number >= 5))
2023 { AI.store_variable_number = -1;
2025 { case 1: AI.internal_number = call_1n_zc; break;
2026 case 2: AI.internal_number = call_2n_zc; break;
2027 case 3: case 4: AI.internal_number = call_vn_zc; break;
2028 case 5: case 6: case 7: case 8:
2029 AI.internal_number = call_vn2_zc; break;
2033 { AI.store_variable_number = Result.value;
2034 if (version_number == 3)
2035 AI.internal_number = call_zc;
2038 { case 1: AI.internal_number = call_1s_zc; break;
2039 case 2: AI.internal_number = call_2s_zc; break;
2040 case 3: case 4: AI.internal_number = call_vs_zc; break;
2041 case 5: case 6: case 7: case 8:
2042 AI.internal_number = call_vs2_zc; break;
2046 AI.branch_label_number = -1;
2047 assemblez_instruction(&AI);
2051 assemblez_store(ET[below].value,
2052 ET[ET[below].right].value);
2053 if (!void_flag) write_result_z(Result, ET[below].value);
2056 case PROPERTY_SETEQUALS_OP:
2057 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
2058 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
2060 { if (runtime_error_checking_switch)
2061 assemblez_4_to(call_zc, veneer_routine(RT__ChPS_VR),
2062 ET[below].value, ET[ET[below].right].value,
2063 ET[ET[ET[below].right].right].value, Result);
2065 { assemblez_store(temp_var1,
2066 ET[ET[ET[below].right].right].value);
2067 assemblez_3(put_prop_zc, ET[below].value,
2068 ET[ET[below].right].value,
2070 write_result_z(Result, temp_var1);
2074 { if (runtime_error_checking_switch && (!veneer_mode))
2075 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2076 ET[below].value, ET[ET[below].right].value,
2077 ET[ET[ET[below].right].right].value);
2078 else assemblez_3(put_prop_zc, ET[below].value,
2079 ET[ET[below].right].value,
2080 ET[ET[ET[below].right].right].value);
2083 case ARROW_SETEQUALS_OP:
2085 { assemblez_store(temp_var1,
2086 ET[ET[ET[below].right].right].value);
2087 access_memory_z(storeb_zc, ET[below].value,
2088 ET[ET[below].right].value,
2090 write_result_z(Result, temp_var1);
2092 else access_memory_z(storeb_zc, ET[below].value,
2093 ET[ET[below].right].value,
2094 ET[ET[ET[below].right].right].value);
2097 case DARROW_SETEQUALS_OP:
2099 { assemblez_store(temp_var1,
2100 ET[ET[ET[below].right].right].value);
2101 access_memory_z(storew_zc, ET[below].value,
2102 ET[ET[below].right].value,
2104 write_result_z(Result, temp_var1);
2107 access_memory_z(storew_zc, ET[below].value,
2108 ET[ET[below].right].value,
2109 ET[ET[ET[below].right].right].value);
2113 assemblez_inc(ET[below].value);
2114 if (!void_flag) write_result_z(Result, ET[below].value);
2117 assemblez_dec(ET[below].value);
2118 if (!void_flag) write_result_z(Result, ET[below].value);
2121 if (!void_flag) write_result_z(Result, ET[below].value);
2122 assemblez_inc(ET[below].value);
2125 if (!void_flag) write_result_z(Result, ET[below].value);
2126 assemblez_dec(ET[below].value);
2130 assemblez_store(temp_var1, ET[below].value);
2131 assemblez_store(temp_var2, ET[ET[below].right].value);
2132 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2133 assemblez_inc(temp_var3);
2134 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2135 if (!void_flag) write_result_z(Result, temp_var3);
2139 assemblez_store(temp_var1, ET[below].value);
2140 assemblez_store(temp_var2, ET[ET[below].right].value);
2141 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2142 assemblez_dec(temp_var3);
2143 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2144 if (!void_flag) write_result_z(Result, temp_var3);
2147 case ARROW_POST_INC_OP:
2148 assemblez_store(temp_var1, ET[below].value);
2149 assemblez_store(temp_var2, ET[ET[below].right].value);
2150 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2151 if (!void_flag) write_result_z(Result, temp_var3);
2152 assemblez_inc(temp_var3);
2153 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2156 case ARROW_POST_DEC_OP:
2157 assemblez_store(temp_var1, ET[below].value);
2158 assemblez_store(temp_var2, ET[ET[below].right].value);
2159 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2160 if (!void_flag) write_result_z(Result, temp_var3);
2161 assemblez_dec(temp_var3);
2162 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2166 assemblez_store(temp_var1, ET[below].value);
2167 assemblez_store(temp_var2, ET[ET[below].right].value);
2168 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2169 assemblez_inc(temp_var3);
2170 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2171 if (!void_flag) write_result_z(Result, temp_var3);
2175 assemblez_store(temp_var1, ET[below].value);
2176 assemblez_store(temp_var2, ET[ET[below].right].value);
2177 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2178 assemblez_dec(temp_var3);
2179 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2180 if (!void_flag) write_result_z(Result, temp_var3);
2183 case DARROW_POST_INC_OP:
2184 assemblez_store(temp_var1, ET[below].value);
2185 assemblez_store(temp_var2, ET[ET[below].right].value);
2186 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2187 if (!void_flag) write_result_z(Result, temp_var3);
2188 assemblez_inc(temp_var3);
2189 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2192 case DARROW_POST_DEC_OP:
2193 assemblez_store(temp_var1, ET[below].value);
2194 assemblez_store(temp_var2, ET[ET[below].right].value);
2195 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2196 if (!void_flag) write_result_z(Result, temp_var3);
2197 assemblez_dec(temp_var3);
2198 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2201 case PROPERTY_INC_OP:
2202 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"++.\" expression");
2203 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"++.\" expression");
2204 assemblez_store(temp_var1, ET[below].value);
2205 assemblez_store(temp_var2, ET[ET[below].right].value);
2206 assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2207 assemblez_inc(temp_var3);
2208 if (runtime_error_checking_switch && (!veneer_mode))
2209 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2210 temp_var1, temp_var2, temp_var3);
2211 else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2212 if (!void_flag) write_result_z(Result, temp_var3);
2215 case PROPERTY_DEC_OP:
2216 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"--.\" expression");
2217 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"--.\" expression");
2218 assemblez_store(temp_var1, ET[below].value);
2219 assemblez_store(temp_var2, ET[ET[below].right].value);
2220 assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2221 assemblez_dec(temp_var3);
2222 if (runtime_error_checking_switch && (!veneer_mode))
2223 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2224 temp_var1, temp_var2, temp_var3);
2225 else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2226 if (!void_flag) write_result_z(Result, temp_var3);
2229 case PROPERTY_POST_INC_OP:
2230 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".++\" expression");
2231 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".++\" expression");
2232 assemblez_store(temp_var1, ET[below].value);
2233 assemblez_store(temp_var2, ET[ET[below].right].value);
2234 assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2235 if (!void_flag) write_result_z(Result, temp_var3);
2236 assemblez_inc(temp_var3);
2237 if (runtime_error_checking_switch && (!veneer_mode))
2238 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2239 temp_var1, temp_var2, temp_var3);
2240 else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2243 case PROPERTY_POST_DEC_OP:
2244 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".--\" expression");
2245 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".--\" expression");
2246 assemblez_store(temp_var1, ET[below].value);
2247 assemblez_store(temp_var2, ET[ET[below].right].value);
2248 assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2249 if (!void_flag) write_result_z(Result, temp_var3);
2250 assemblez_dec(temp_var3);
2251 if (runtime_error_checking_switch && (!veneer_mode))
2252 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2253 temp_var1, temp_var2, temp_var3);
2254 else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2258 printf("** Trouble op = %d i.e. '%s' **\n",
2259 opnum, operators[opnum].description);
2260 compiler_error("Expr code gen: Can't generate yet");
2264 assembly_operand AO, AO2;
2265 if (operators[opnum].opcode_number_g != -1)
2267 /* Operators directly translatable into opcodes: infix ops
2268 take two operands whereas pre/postfix operators take only one */
2270 if (operators[opnum].usage == IN_U)
2271 { int o_n = operators[opnum].opcode_number_g;
2272 if (runtime_error_checking_switch && (!veneer_mode)
2273 && ((o_n == div_gc) || (o_n == mod_gc)))
2274 { assembly_operand by_ao, error_ao; int ln;
2275 by_ao = ET[ET[below].right].value;
2276 if ((by_ao.value != 0) && (by_ao.marker == 0)
2277 && is_constant_ot(by_ao.type))
2278 assembleg_3(o_n, ET[below].value,
2281 { assembleg_store(temp_var1, ET[below].value);
2282 assembleg_store(temp_var2, by_ao);
2284 assembleg_1_branch(jnz_gc, temp_var2, ln);
2286 error_ao.value = DBYZERO_RTE;
2287 set_constant_ot(&error_ao);
2288 assembleg_call_1(veneer_routine(RT__Err_VR),
2289 error_ao, zero_operand);
2290 assembleg_store(temp_var2, one_operand);
2291 assemble_label_no(ln);
2292 assembleg_3(o_n, temp_var1, temp_var2, Result);
2296 assembleg_3(o_n, ET[below].value,
2297 ET[ET[below].right].value, Result);
2300 assembleg_2(operators[opnum].opcode_number_g, ET[below].value,
2308 if (ET[below].value.type == Result.type
2309 && ET[below].value.value == Result.value
2310 && ET[below].value.marker == Result.marker)
2312 assembleg_2(copy_gc, ET[below].value, Result);
2315 case UNARY_MINUS_OP:
2316 assembleg_2(neg_gc, ET[below].value, Result);
2319 assembleg_2(bitnot_gc, ET[below].value, Result);
2323 access_memory_g(aloadb_gc, ET[below].value,
2324 ET[ET[below].right].value, Result);
2327 access_memory_g(aload_gc, ET[below].value,
2328 ET[ET[below].right].value, Result);
2332 assembleg_store(ET[below].value,
2333 ET[ET[below].right].value);
2334 if (!void_flag) write_result_g(Result, ET[below].value);
2337 case ARROW_SETEQUALS_OP:
2339 { assembleg_store(temp_var1,
2340 ET[ET[ET[below].right].right].value);
2341 access_memory_g(astoreb_gc, ET[below].value,
2342 ET[ET[below].right].value,
2344 write_result_g(Result, temp_var1);
2346 else access_memory_g(astoreb_gc, ET[below].value,
2347 ET[ET[below].right].value,
2348 ET[ET[ET[below].right].right].value);
2351 case DARROW_SETEQUALS_OP:
2353 { assembleg_store(temp_var1,
2354 ET[ET[ET[below].right].right].value);
2355 access_memory_g(astore_gc, ET[below].value,
2356 ET[ET[below].right].value,
2358 write_result_g(Result, temp_var1);
2361 access_memory_g(astore_gc, ET[below].value,
2362 ET[ET[below].right].value,
2363 ET[ET[ET[below].right].right].value);
2367 assembleg_inc(ET[below].value);
2368 if (!void_flag) write_result_g(Result, ET[below].value);
2371 assembleg_dec(ET[below].value);
2372 if (!void_flag) write_result_g(Result, ET[below].value);
2375 if (!void_flag) write_result_g(Result, ET[below].value);
2376 assembleg_inc(ET[below].value);
2379 if (!void_flag) write_result_g(Result, ET[below].value);
2380 assembleg_dec(ET[below].value);
2384 assembleg_store(temp_var1, ET[below].value);
2385 assembleg_store(temp_var2, ET[ET[below].right].value);
2386 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2387 assembleg_inc(temp_var3);
2388 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2389 if (!void_flag) write_result_g(Result, temp_var3);
2393 assembleg_store(temp_var1, ET[below].value);
2394 assembleg_store(temp_var2, ET[ET[below].right].value);
2395 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2396 assembleg_dec(temp_var3);
2397 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2398 if (!void_flag) write_result_g(Result, temp_var3);
2401 case ARROW_POST_INC_OP:
2402 assembleg_store(temp_var1, ET[below].value);
2403 assembleg_store(temp_var2, ET[ET[below].right].value);
2404 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2405 if (!void_flag) write_result_g(Result, temp_var3);
2406 assembleg_inc(temp_var3);
2407 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2410 case ARROW_POST_DEC_OP:
2411 assembleg_store(temp_var1, ET[below].value);
2412 assembleg_store(temp_var2, ET[ET[below].right].value);
2413 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2414 if (!void_flag) write_result_g(Result, temp_var3);
2415 assembleg_dec(temp_var3);
2416 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2420 assembleg_store(temp_var1, ET[below].value);
2421 assembleg_store(temp_var2, ET[ET[below].right].value);
2422 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2423 assembleg_inc(temp_var3);
2424 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2425 if (!void_flag) write_result_g(Result, temp_var3);
2429 assembleg_store(temp_var1, ET[below].value);
2430 assembleg_store(temp_var2, ET[ET[below].right].value);
2431 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2432 assembleg_dec(temp_var3);
2433 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2434 if (!void_flag) write_result_g(Result, temp_var3);
2437 case DARROW_POST_INC_OP:
2438 assembleg_store(temp_var1, ET[below].value);
2439 assembleg_store(temp_var2, ET[ET[below].right].value);
2440 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2441 if (!void_flag) write_result_g(Result, temp_var3);
2442 assembleg_inc(temp_var3);
2443 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2446 case DARROW_POST_DEC_OP:
2447 assembleg_store(temp_var1, ET[below].value);
2448 assembleg_store(temp_var2, ET[ET[below].right].value);
2449 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2450 if (!void_flag) write_result_g(Result, temp_var3);
2451 assembleg_dec(temp_var3);
2452 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2457 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
2458 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
2459 AO = veneer_routine(RV__Pr_VR);
2460 goto TwoArgFunctionCall;
2463 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".&\" expression");
2464 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".&\" expression");
2465 AO = veneer_routine(RA__Pr_VR);
2466 goto TwoArgFunctionCall;
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(RL__Pr_VR);
2472 goto TwoArgFunctionCall;
2475 case MESSAGE_CALL_OP:
2476 check_warn_symbol_has_metaclass(&ET[below].value, "\".()\" expression");
2477 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".()\" expression");
2478 AO2 = veneer_routine(CA__Pr_VR);
2480 goto DoFunctionCall;
2482 case MESSAGE_INC_OP:
2483 case PROPERTY_INC_OP:
2484 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"++.\" expression");
2485 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"++.\" expression");
2486 AO = veneer_routine(IB__Pr_VR);
2487 goto TwoArgFunctionCall;
2488 case MESSAGE_DEC_OP:
2489 case PROPERTY_DEC_OP:
2490 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"--.\" expression");
2491 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"--.\" expression");
2492 AO = veneer_routine(DB__Pr_VR);
2493 goto TwoArgFunctionCall;
2494 case MESSAGE_POST_INC_OP:
2495 case PROPERTY_POST_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(IA__Pr_VR);
2499 goto TwoArgFunctionCall;
2500 case MESSAGE_POST_DEC_OP:
2501 case PROPERTY_POST_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(DA__Pr_VR);
2505 goto TwoArgFunctionCall;
2507 AO = veneer_routine(RA__Sc_VR);
2508 goto TwoArgFunctionCall;
2512 assembly_operand AO2 = ET[below].value;
2513 assembly_operand AO3 = ET[ET[below].right].value;
2515 assembleg_call_2(AO, AO2, AO3, zero_operand);
2517 assembleg_call_2(AO, AO2, AO3, Result);
2521 case PROPERTY_SETEQUALS_OP:
2522 case MESSAGE_SETEQUALS_OP:
2523 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
2524 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
2525 if (runtime_error_checking_switch && (!veneer_mode))
2526 AO = veneer_routine(RT__ChPS_VR);
2528 AO = veneer_routine(WV__Pr_VR);
2531 assembly_operand AO2 = ET[below].value;
2532 assembly_operand AO3 = ET[ET[below].right].value;
2533 assembly_operand AO4 = ET[ET[ET[below].right].right].value;
2534 if (AO4.type == LOCALVAR_OT && AO4.value == 0) {
2535 /* Rightmost is on the stack; reduce to previous case. */
2536 if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2537 if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2538 /* both already on stack. */
2541 assembleg_store(stack_pointer, AO3);
2542 assembleg_0(stkswap_gc);
2546 if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2547 assembleg_store(stack_pointer, AO2);
2550 assembleg_store(stack_pointer, AO3);
2551 assembleg_store(stack_pointer, AO2);
2556 /* We have to get the rightmost on the stack, below the
2558 if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2559 if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2560 assembleg_store(stack_pointer, AO4);
2561 assembleg_2(stkroll_gc, three_operand, one_operand);
2564 assembleg_store(stack_pointer, AO4);
2565 assembleg_0(stkswap_gc);
2566 assembleg_store(stack_pointer, AO2);
2570 if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2571 assembleg_store(stack_pointer, AO4);
2572 assembleg_store(stack_pointer, AO3);
2573 assembleg_2(stkroll_gc, three_operand, two_operand);
2576 assembleg_store(stack_pointer, AO4);
2577 assembleg_store(stack_pointer, AO3);
2578 assembleg_store(stack_pointer, AO2);
2583 assembleg_3(call_gc, AO, three_operand, zero_operand);
2585 assembleg_3(call_gc, AO, three_operand, Result);
2592 if (ET[below].value.type == SYSFUN_OT)
2593 { int sf_number = ET[below].value.value;
2595 i = ET[below].right;
2597 { error("Argument to system function missing");
2598 AI.operand[0] = one_operand;
2599 AI.operand_count = 1;
2603 while (i != -1) { j++; i = ET[i].right; }
2605 if (((sf_number != INDIRECT_SYSF) &&
2606 (sf_number != GLK_SYSF) &&
2607 (sf_number != RANDOM_SYSF) && (j > 1)))
2609 error("System function given with too many arguments");
2611 if (sf_number != RANDOM_SYSF)
2613 i = ET[below].right;
2614 for (jcount = 0; jcount < j; jcount++)
2615 { AI.operand[jcount] = ET[i].value;
2618 AI.operand_count = j;
2626 { assembly_operand AO, AO2;
2630 set_constant_ot(&AO);
2631 INITAOTV(&AO2, CONSTANT_OT, begin_word_array());
2632 AO2.marker = ARRAY_MV;
2634 for (arg_c=0, arg_et = ET[below].right;arg_c<j;
2635 arg_c++, arg_et = ET[arg_et].right)
2636 { if (ET[arg_et].value.type == LOCALVAR_OT
2637 || ET[arg_et].value.type == GLOBALVAR_OT)
2638 error("Only constants can be used as possible 'random' results");
2639 array_entry(arg_c, FALSE, ET[arg_et].value);
2641 finish_array(arg_c, FALSE);
2643 assembleg_2(random_gc, AO, stack_pointer);
2644 assembleg_3(aload_gc, AO2, stack_pointer, Result);
2647 assembleg_2(random_gc,
2648 ET[ET[below].right].value, stack_pointer);
2649 assembleg_3(add_gc, stack_pointer, one_operand,
2655 { assembly_operand AO;
2656 AO = ET[ET[below].right].value;
2657 if (runtime_error_checking_switch)
2658 AO = check_nonzero_at_runtime(AO, -1,
2660 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
2661 assembleg_3(aload_gc, AO, AO2, Result);
2667 { assembly_operand AO;
2668 AO = ET[ET[below].right].value;
2669 if (runtime_error_checking_switch)
2670 AO = check_nonzero_at_runtime(AO, -1,
2671 (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
2672 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
2673 assembleg_3(aload_gc, AO, AO2, Result);
2679 { assembly_operand AO;
2680 AO = ET[ET[below].right].value;
2681 if (runtime_error_checking_switch)
2682 AO = check_nonzero_at_runtime(AO, -1,
2683 (sf_number==SIBLING_SYSF)
2684 ?SIBLING_RTE:YOUNGER_RTE);
2685 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_SIBLING());
2686 assembleg_3(aload_gc, AO, AO2, Result);
2691 { assembly_operand AO;
2692 AO = ET[ET[below].right].value;
2693 if (runtime_error_checking_switch)
2694 AO = check_nonzero_at_runtime(AO, -1,
2696 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
2697 assembleg_store(temp_var1, zero_operand);
2698 assembleg_3(aload_gc, AO, AO2, temp_var2);
2699 AO2.value = GOBJFIELD_SIBLING();
2700 assemble_label_no(next_label);
2701 assembleg_1_branch(jz_gc, temp_var2, next_label+1);
2702 assembleg_3(add_gc, temp_var1, one_operand,
2704 assembleg_3(aload_gc, temp_var2, AO2, temp_var2);
2705 assembleg_0_branch(jump_gc, next_label);
2706 assemble_label_no(next_label+1);
2709 write_result_g(Result, temp_var1);
2714 i = ET[below].right;
2715 check_warn_symbol_type(&ET[i].value, ROUTINE_T, 0, "indirect function call");
2716 goto IndirectFunctionCallG;
2719 AO2 = veneer_routine(Glk__Wrap_VR);
2720 i = ET[below].right;
2721 goto DoFunctionCall;
2723 case METACLASS_SYSF:
2724 assembleg_call_1(veneer_routine(Metaclass_VR),
2725 ET[ET[below].right].value, Result);
2729 AO = ET[ET[below].right].value;
2730 if (runtime_error_checking_switch)
2731 AO = check_nonzero_at_runtime(AO, -1,
2733 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
2734 assembleg_3(aload_gc, AO, AO2, temp_var1);
2735 AO2.value = GOBJFIELD_SIBLING();
2736 assembleg_1_branch(jz_gc, temp_var1, next_label+1);
2737 assemble_label_no(next_label);
2738 assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
2739 assembleg_1_branch(jz_gc, temp_var2, next_label+1);
2740 assembleg_store(temp_var1, temp_var2);
2741 assembleg_0_branch(jump_gc, next_label);
2742 assemble_label_no(next_label+1);
2744 write_result_g(Result, temp_var1);
2749 AO = ET[ET[below].right].value;
2750 if (runtime_error_checking_switch)
2751 AO = check_nonzero_at_runtime(AO, -1,
2753 assembleg_store(temp_var3, AO);
2754 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
2755 assembleg_3(aload_gc, temp_var3, AO2, temp_var1);
2756 assembleg_1_branch(jz_gc, temp_var1, next_label+2);
2757 AO2.value = GOBJFIELD_CHILD();
2758 assembleg_3(aload_gc, temp_var1, AO2, temp_var1);
2759 assembleg_1_branch(jz_gc, temp_var1, next_label+2);
2760 assembleg_2_branch(jeq_gc, temp_var3, temp_var1,
2762 assemble_label_no(next_label);
2763 AO2.value = GOBJFIELD_SIBLING();
2764 assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
2765 assembleg_2_branch(jeq_gc, temp_var3, temp_var2,
2767 assembleg_store(temp_var1, temp_var2);
2768 assembleg_0_branch(jump_gc, next_label);
2769 assemble_label_no(next_label+1);
2770 assembleg_store(temp_var1, zero_operand);
2771 assemble_label_no(next_label+2);
2773 write_result_g(Result, temp_var1);
2778 error("*** system function not implemented ***");
2785 check_warn_symbol_type(&ET[below].value, ROUTINE_T, 0, "function call");
2788 IndirectFunctionCallG:
2790 /* Get the function address. */
2797 /* If all the function arguments are in local/global
2798 variables, we have to push them all on the stack.
2799 If all of them are on the stack, we have to do nothing.
2800 If some are and some aren't, we have a hopeless mess,
2801 and we should throw a compiler error.
2807 /* begin part of patch G03701 */
2816 assembleg_2(callf_gc, AO2, void_flag ? zero_operand : Result);
2817 } else if (nargs==1) {
2818 assembleg_call_1(AO2, ET[i].value, void_flag ? zero_operand : Result);
2819 } else if (nargs==2) {
2820 assembly_operand o1 = ET[i].value;
2821 assembly_operand o2 = ET[ET[i].right].value;
2822 assembleg_call_2(AO2, o1, o2, void_flag ? zero_operand : Result);
2823 } else if (nargs==3) {
2824 assembly_operand o1 = ET[i].value;
2825 assembly_operand o2 = ET[ET[i].right].value;
2826 assembly_operand o3 = ET[ET[ET[i].right].right].value;
2827 assembleg_call_3(AO2, o1, o2, o3, void_flag ? zero_operand : Result);
2832 if (ET[i].value.type == LOCALVAR_OT
2833 && ET[i].value.value == 0) {
2837 assembleg_store(stack_pointer, ET[i].value);
2844 if (onstack && offstack)
2845 error("*** Function call cannot be generated with mixed arguments ***");
2847 error("*** Function call cannot be generated with more than one nonstack argument ***");
2851 set_constant_ot(&AO);
2854 assembleg_3(call_gc, AO2, AO, zero_operand);
2856 assembleg_3(call_gc, AO2, AO, Result);
2858 } /* else nargs>=4 */
2859 } /* DoFunctionCall: */
2864 printf("** Trouble op = %d i.e. '%s' **\n",
2865 opnum, operators[opnum].description);
2866 compiler_error("Expr code gen: Can't generate yet");
2870 ET[n].value = Result;
2876 if (ET[n].to_expression)
2880 warning("Logical expression has no side-effects");
2881 if (ET[n].true_label != -1)
2882 assemble_label_no(ET[n].true_label);
2884 assemble_label_no(ET[n].false_label);
2886 else if (ET[n].true_label != -1)
2888 donelabel = next_label++;
2889 if (!execution_never_reaches_here) {
2890 assemblez_1(push_zc, zero_operand);
2891 assemblez_jump(donelabel);
2893 assemble_label_no(ET[n].true_label);
2894 assemblez_1(push_zc, one_operand);
2895 assemble_forward_label_no(donelabel);
2899 donelabel = next_label++;
2900 if (!execution_never_reaches_here) {
2901 assemblez_1(push_zc, one_operand);
2902 assemblez_jump(donelabel);
2904 assemble_label_no(ET[n].false_label);
2905 assemblez_1(push_zc, zero_operand);
2906 assemble_forward_label_no(donelabel);
2908 ET[n].value = stack_pointer;
2911 if (ET[n].label_after != -1)
2912 assemble_label_no(ET[n].label_after);
2917 if (ET[n].to_expression)
2921 warning("Logical expression has no side-effects");
2922 if (ET[n].true_label != -1)
2923 assemble_label_no(ET[n].true_label);
2925 assemble_label_no(ET[n].false_label);
2927 else if (ET[n].true_label != -1)
2929 donelabel = next_label++;
2930 if (!execution_never_reaches_here) {
2931 assembleg_store(stack_pointer, zero_operand);
2932 assembleg_jump(donelabel);
2934 assemble_label_no(ET[n].true_label);
2935 assembleg_store(stack_pointer, one_operand);
2936 assemble_forward_label_no(donelabel);
2940 donelabel = next_label++;
2941 if (!execution_never_reaches_here) {
2942 assembleg_store(stack_pointer, one_operand);
2943 assembleg_jump(donelabel);
2945 assemble_label_no(ET[n].false_label);
2946 assembleg_store(stack_pointer, zero_operand);
2947 assemble_forward_label_no(donelabel);
2949 ET[n].value = stack_pointer;
2952 if (ET[n].label_after != -1)
2953 assemble_label_no(ET[n].label_after);
2960 assembly_operand code_generate(assembly_operand AO, int context, int label)
2962 /* Used in three contexts: VOID_CONTEXT, CONDITION_CONTEXT and
2965 If CONDITION_CONTEXT, then compile code branching to label number
2966 "label" if the condition is false: there's no return value.
2967 (Except that if label is -3 or -4 (internal codes for rfalse and
2968 rtrue rather than branch) then this is for branching when the
2969 condition is true. This is used for optimising code generation
2970 for "if" statements.)
2972 Otherwise return the assembly operand containing the result
2973 (probably the stack pointer variable but not necessarily:
2974 e.g. is would be short constant 2 from the expression "j++, 2") */
2978 if (AO.type != EXPRESSION_OT)
2980 { case VOID_CONTEXT:
2981 value_in_void_context(AO);
2982 AO.type = OMITTED_OT;
2985 case CONDITION_CONTEXT:
2987 if (label < -2) assemblez_1_branch(jz_zc, AO, label, FALSE);
2988 else assemblez_1_branch(jz_zc, AO, label, TRUE);
2992 assembleg_1_branch(jnz_gc, AO, label);
2994 assembleg_1_branch(jz_gc, AO, label);
2996 AO.type = OMITTED_OT;
3003 if (expr_trace_level >= 2)
3004 { printf("Raw parse tree:\n"); show_tree(AO, FALSE);
3007 if (context == CONDITION_CONTEXT)
3008 { if (label < -2) annotate_for_conditions(AO.value, label, -1);
3009 else annotate_for_conditions(AO.value, -1, label);
3011 else annotate_for_conditions(AO.value, -1, -1);
3013 if (expr_trace_level >= 1)
3014 { printf("Code generation for expression in ");
3016 { case VOID_CONTEXT: printf("void"); break;
3017 case CONDITION_CONTEXT: printf("condition"); break;
3018 case QUANTITY_CONTEXT: printf("quantity"); break;
3019 case ASSEMBLY_CONTEXT: printf("assembly"); break;
3020 case ARRAY_CONTEXT: printf("array initialisation"); break;
3021 default: printf("* ILLEGAL *"); break;
3023 printf(" context with annotated tree:\n");
3024 show_tree(AO, TRUE);
3027 generate_code_from(AO.value, (context==VOID_CONTEXT));
3028 return ET[AO.value].value;
3031 /* ========================================================================= */
3032 /* Data structure management routines */
3033 /* ------------------------------------------------------------------------- */
3035 extern void init_expressc_vars(void)
3039 extern void expressc_begin_pass(void)
3043 extern void expressc_allocate_arrays(void)
3047 extern void expressc_free_arrays(void)
3051 /* ========================================================================= */