1 /* ------------------------------------------------------------------------- */
2 /* "expressc" : The expression code generator */
4 /* Part of Inform 6.40 */
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, from_module = 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)
483 type_ao = zero_ao; type_ao.value = arrays[y].type;
485 if ((!is_systemfile()))
488 if ((arrays[y].type == WORD_ARRAY)
489 || (arrays[y].type == TABLE_ARRAY))
490 warning("Using '->' to access a --> or table array");
494 if ((arrays[y].type == BYTE_ARRAY)
495 || (arrays[y].type == STRING_ARRAY))
496 warning("Using '-->' to access a -> or string array");
503 if ((!runtime_error_checking_switch) || (veneer_mode))
504 { if ((oc == loadb_zc) || (oc == loadw_zc))
505 assemblez_2_to(oc, AO1, AO2, AO3);
507 assemblez_3(oc, AO1, AO2, AO3);
511 /* If we recognise AO1 as arising textually from a declared
512 array, we can check bounds explicitly. */
514 if ((AO1.marker == ARRAY_MV || AO1.marker == STATIC_ARRAY_MV) && (!from_module))
516 int passed_label = next_label++, failed_label = next_label++,
517 final_label = next_label++;
518 /* Calculate the largest permitted array entry + 1
519 Here "size_ao.value" = largest permitted entry of its own kind */
523 && ((arrays[y].type == WORD_ARRAY)
524 || (arrays[y].type == TABLE_ARRAY)))
525 { max_ao.value = size_ao.value*2 + 1;
529 && ((arrays[y].type == BYTE_ARRAY)
530 || (arrays[y].type == STRING_ARRAY)
531 || (arrays[y].type == BUFFER_ARRAY)))
532 { if ((size_ao.value % 2) == 0)
533 max_ao.value = size_ao.value/2 - 1;
534 else max_ao.value = (size_ao.value-1)/2;
539 if (size_ao.value >= 256) size_ao.type = LONG_CONSTANT_OT;
540 if (max_ao.value >= 256) max_ao.type = LONG_CONSTANT_OT;
542 /* Can't write to the size entry in a string or table */
543 if (((arrays[y].type == STRING_ARRAY)
544 || (arrays[y].type == TABLE_ARRAY))
546 { if ((arrays[y].type == TABLE_ARRAY) && byte_flag)
548 else zero_ao.value = 1;
551 en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
552 switch(oc) { case loadb_zc: en_ao.value = ABOUNDS_RTE; break;
553 case loadw_zc: en_ao.value = ABOUNDS_RTE+1; break;
554 case storeb_zc: en_ao.value = ABOUNDS_RTE+2; break;
555 case storew_zc: en_ao.value = ABOUNDS_RTE+3; break; }
558 if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
559 { assemblez_store(temp_var2, AO2);
560 assemblez_store(AO2, temp_var2);
561 index_ao = temp_var2;
563 assemblez_2_branch(jl_zc, index_ao, zero_ao, failed_label, TRUE);
564 assemblez_2_branch(jl_zc, index_ao, max_ao, passed_label, TRUE);
565 assemble_label_no(failed_label);
566 an_ao = zero_ao; an_ao.value = y;
567 assemblez_6(call_vn2_zc, veneer_routine(RT__Err_VR), en_ao,
568 index_ao, size_ao, type_ao, an_ao);
570 /* We have to clear any of AO1, AO2, AO3 off the stack if
571 present, so that we can achieve the same effect on the stack
572 that executing the opcode would have had */
574 if ((AO1.type == VARIABLE_OT) && (AO1.value == 0)) pop_zm_stack();
575 if ((AO2.type == VARIABLE_OT) && (AO2.value == 0)) pop_zm_stack();
576 if ((AO3.type == VARIABLE_OT) && (AO3.value == 0))
577 { if ((oc == loadb_zc) || (oc == loadw_zc))
578 { assemblez_store(AO3, zero_ao);
582 assemblez_jump(final_label);
584 assemble_label_no(passed_label);
585 if ((oc == loadb_zc) || (oc == loadw_zc))
586 assemblez_2_to(oc, AO1, AO2, AO3);
588 assemblez_3(oc, AO1, AO2, AO3);
589 assemble_label_no(final_label);
593 /* Otherwise, compile a call to the veneer which verifies that
594 the proposed read/write is within dynamic Z-machine memory. */
596 switch(oc) { case loadb_zc: vr = RT__ChLDB_VR; break;
597 case loadw_zc: vr = RT__ChLDW_VR; break;
598 case storeb_zc: vr = RT__ChSTB_VR; break;
599 case storew_zc: vr = RT__ChSTW_VR; break;
600 default: compiler_error("unknown array opcode");
603 if ((oc == loadb_zc) || (oc == loadw_zc))
604 assemblez_3_to(call_vs_zc, veneer_routine(vr), AO1, AO2, AO3);
606 assemblez_4(call_vn_zc, veneer_routine(vr), AO1, AO2, AO3);
609 static assembly_operand check_nonzero_at_runtime_z(assembly_operand AO1,
610 int error_label, int rte_number)
611 { assembly_operand AO2, AO3;
612 int check_sp = FALSE, passed_label, failed_label, last_label;
613 if (veneer_mode) return AO1;
615 /* Assemble to code to check that the operand AO1 is ofclass Object:
616 if it is, execution should continue and the stack should be
617 unchanged. Otherwise, call the veneer's run-time-error routine
618 with the given error number, and then: if the label isn't -1,
619 switch execution to this label, with the value popped from
620 the stack if it was on the stack in the first place;
621 if the label is -1, either replace the top of the stack with
622 the constant 2, or return the operand (short constant) 2.
624 The point of 2 is that object 2 is the class-object Object
625 and therefore has no parent, child or sibling, so that the
626 built-in tree functions will safely return 0 on this object. */
628 /* Sometimes we can already see that the object number is valid. */
629 if (((AO1.type == LONG_CONSTANT_OT) || (AO1.type == SHORT_CONSTANT_OT))
630 && (AO1.marker == 0) && (AO1.value >= 1) && (AO1.value < no_objects))
633 passed_label = next_label++;
634 failed_label = next_label++;
635 INITAOTV(&AO2, LONG_CONSTANT_OT, actual_largest_object_SC);
636 AO2.marker = INCON_MV;
637 INITAOTV(&AO3, SHORT_CONSTANT_OT, 5);
639 if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
640 || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
641 || (rte_number == PROP_ADD_RTE))
642 { /* Allow classes */
644 if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
645 { /* That is, if AO1 is the stack pointer */
647 assemblez_store(temp_var2, AO1);
648 assemblez_store(AO1, temp_var2);
649 assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
650 assemblez_2_branch(jg_zc, temp_var2, AO2, passed_label, FALSE);
653 { assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
654 assemblez_2_branch(jg_zc, AO1, AO2, passed_label, FALSE);
658 { if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
659 { /* That is, if AO1 is the stack pointer */
661 assemblez_store(temp_var2, AO1);
662 assemblez_store(AO1, temp_var2);
663 assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
664 assemblez_2_branch(jg_zc, temp_var2, AO2, failed_label, TRUE);
666 assemblez_2_branch(jin_zc, temp_var2, AO3, passed_label, FALSE);
669 { assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
670 assemblez_2_branch(jg_zc, AO1, AO2, failed_label, TRUE);
672 assemblez_2_branch(jin_zc, AO1, AO3, passed_label, FALSE);
676 assemble_label_no(failed_label);
677 INITAOTV(&AO2, SHORT_CONSTANT_OT, rte_number);
678 if (version_number >= 5)
679 assemblez_3(call_vn_zc, veneer_routine(RT__Err_VR), AO2, AO1);
681 assemblez_3_to(call_zc, veneer_routine(RT__Err_VR), AO2, AO1, temp_var2);
683 if (error_label != -1)
684 { /* Jump to the error label */
685 if (error_label == -3) assemblez_0(rfalse_zc);
686 else if (error_label == -4) assemblez_0(rtrue_zc);
687 else assemblez_jump(error_label);
691 { /* Push the short constant 2 */
692 INITAOTV(&AO2, SHORT_CONSTANT_OT, 2);
693 assemblez_store(AO1, AO2);
696 { /* Store either short constant 2 or the operand's value in
697 the temporary variable */
698 INITAOTV(&AO2, SHORT_CONSTANT_OT, 2);
699 AO3 = temp_var2; assemblez_store(AO3, AO2);
700 last_label = next_label++;
701 assemblez_jump(last_label);
702 assemble_label_no(passed_label);
703 assemblez_store(AO3, AO1);
704 assemble_label_no(last_label);
708 assemble_label_no(passed_label);
712 static void compile_conditional_z(int oc,
713 assembly_operand AO1, assembly_operand AO2, int label, int flag)
714 { assembly_operand AO3; int the_zc, error_label = label,
715 va_flag = FALSE, va_label = 0;
721 check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"has/hasnt\" expression");
722 check_warn_symbol_type(&AO2, ATTRIBUTE_T, 0, "\"has/hasnt\" expression");
725 check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"in/notin\" expression");
726 check_warn_symbol_type(&AO2, OBJECT_T, CLASS_T, "\"in/notin\" expression");
729 /* first argument can be anything */
730 check_warn_symbol_type(&AO2, CLASS_T, 0, "\"ofclass\" expression");
733 /* first argument can be anything */
734 check_warn_symbol_type(&AO2, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"provides\" expression");
739 { if ((runtime_error_checking_switch) && (oc == jin_zc))
740 { if (flag) error_label = next_label++;
741 AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
743 if ((runtime_error_checking_switch) && (oc == test_attr_zc))
744 { if (flag) error_label = next_label++;
745 AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
747 { case SHORT_CONSTANT_OT:
748 case LONG_CONSTANT_OT:
750 { if ((AO2.value < 0) || (AO2.value > 47))
751 error("'has'/'hasnt' applied to illegal attribute number");
755 { int pa_label = next_label++, fa_label = next_label++;
756 assembly_operand en_ao, zero_ao, max_ao;
757 assemblez_store(temp_var1, AO1);
758 if ((AO1.type == VARIABLE_OT)&&(AO1.value == 0))
759 assemblez_store(AO1, temp_var1);
760 assemblez_store(temp_var2, AO2);
761 if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
762 assemblez_store(AO2, temp_var2);
763 INITAOT(&zero_ao, SHORT_CONSTANT_OT);
765 max_ao = zero_ao; max_ao.value = 48;
766 assemblez_2_branch(jl_zc,temp_var2,zero_ao,fa_label,TRUE);
767 assemblez_2_branch(jl_zc,temp_var2,max_ao,pa_label,TRUE);
768 assemble_label_no(fa_label);
769 en_ao = zero_ao; en_ao.value = 19;
770 assemblez_4(call_vn_zc, veneer_routine(RT__Err_VR),
771 en_ao, temp_var1, temp_var2);
772 va_flag = TRUE; va_label = next_label++;
773 assemblez_jump(va_label);
774 assemble_label_no(pa_label);
778 assemblez_2_branch(oc, AO1, AO2, label, flag);
779 if (error_label != label) assemble_label_no(error_label);
780 if (va_flag) assemble_label_no(va_label);
784 INITAOTV(&AO3, VARIABLE_OT, 0);
786 the_zc = (version_number == 3)?call_zc:call_vs_zc;
788 assemblez_3_to(the_zc, veneer_routine(OP__Pr_VR), AO1, AO2, AO3);
790 assemblez_3_to(the_zc, veneer_routine(OC__Cl_VR), AO1, AO2, AO3);
792 assemblez_1_branch(jz_zc, AO3, label, !flag);
795 static void value_in_void_context_g(assembly_operand AO)
802 case HALFCONSTANT_OT:
803 case BYTECONSTANT_OT:
804 case ZEROCONSTANT_OT:
806 if (AO.marker == SYMBOL_MV)
807 t = (symbols[AO.value].name);
811 t = variable_name(AO.value);
814 compiler_error("Unable to print value in void context");
820 ebf_error("expression with side-effects", t);
823 static void write_result_g(assembly_operand to, assembly_operand from)
824 { if (to.value == from.value && to.type == from.type) return;
825 assembleg_store(to, from);
828 static void access_memory_g(int oc, assembly_operand AO1, assembly_operand AO2,
829 assembly_operand AO3)
831 int data_len, read_flag;
832 assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
834 int passed_label, failed_label, final_label, x = 0, y = 0;
836 if ((oc == aloadb_gc) || (oc == astoreb_gc)) data_len = 1;
837 else if ((oc == aloads_gc) || (oc == astores_gc)) data_len = 2;
840 if ((oc == aloadb_gc) || (oc == aloads_gc) || (oc == aload_gc))
849 if (AO1.marker == ARRAY_MV || AO1.marker == STATIC_ARRAY_MV)
851 size_ao = zero_ao; size_ao.value = -1;
852 for (x=0; x<no_arrays; x++)
853 { if (((AO1.marker == ARRAY_MV) == (!arrays[x].loc))
854 && (AO1.value == symbols[arrays[x].symbol].value))
855 { size_ao.value = arrays[x].size; y=x;
858 if (size_ao.value==-1) compiler_error("Array size can't be found");
860 type_ao = zero_ao; type_ao.value = arrays[y].type;
862 if (arrays[y].loc && !read_flag) {
863 error("Cannot write to a static array");
866 if ((!is_systemfile()))
869 if ((arrays[y].type == WORD_ARRAY)
870 || (arrays[y].type == TABLE_ARRAY))
871 warning("Using '->' to access a --> or table array");
875 if ((arrays[y].type == BYTE_ARRAY)
876 || (arrays[y].type == STRING_ARRAY))
877 warning("Using '-->' to access a -> or string array");
883 if ((!runtime_error_checking_switch) || (veneer_mode))
885 assembleg_3(oc, AO1, AO2, AO3);
889 /* If we recognise AO1 as arising textually from a declared
890 array, we can check bounds explicitly. */
892 if (AO1.marker == ARRAY_MV || AO1.marker == STATIC_ARRAY_MV)
894 /* Calculate the largest permitted array entry + 1
895 Here "size_ao.value" = largest permitted entry of its own kind */
898 && ((arrays[y].type == WORD_ARRAY)
899 || (arrays[y].type == TABLE_ARRAY)))
900 { max_ao.value = size_ao.value*4 + 3;
904 && ((arrays[y].type == BYTE_ARRAY)
905 || (arrays[y].type == STRING_ARRAY)
906 || (arrays[y].type == BUFFER_ARRAY)))
907 { max_ao.value = (size_ao.value-3)/4;
912 /* Can't write to the size entry in a string or table */
913 if (((arrays[y].type == STRING_ARRAY)
914 || (arrays[y].type == TABLE_ARRAY))
916 { if ((arrays[y].type == TABLE_ARRAY) && data_len == 1)
918 else zero_ao.value = 1;
921 en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
923 switch(oc) { case aloadb_gc: en_ao.value = ABOUNDS_RTE; break;
924 case aload_gc: en_ao.value = ABOUNDS_RTE+1; break;
925 case astoreb_gc: en_ao.value = ABOUNDS_RTE+2; break;
926 case astore_gc: en_ao.value = ABOUNDS_RTE+3; break; }
928 set_constant_ot(&zero_ao);
929 set_constant_ot(&size_ao);
930 set_constant_ot(&max_ao);
931 set_constant_ot(&type_ao);
932 set_constant_ot(&en_ao);
934 /* If we recognize A02 as a constant, we can do the test right
936 if (is_constant_ot(AO2.type) && AO2.marker == 0) {
937 if (AO2.value < zero_ao.value || AO2.value >= max_ao.value) {
938 error("Array reference is out-of-bounds");
940 assembleg_3(oc, AO1, AO2, AO3);
944 passed_label = next_label++;
945 failed_label = next_label++;
946 final_label = next_label++;
949 if ((AO2.type == LOCALVAR_OT)&&(AO2.value == 0))
950 { assembleg_store(temp_var2, AO2); /* ### could peek */
951 assembleg_store(AO2, temp_var2);
952 index_ao = temp_var2;
954 assembleg_2_branch(jlt_gc, index_ao, zero_ao, failed_label);
955 assembleg_2_branch(jlt_gc, index_ao, max_ao, passed_label);
956 assemble_label_no(failed_label);
958 an_ao = zero_ao; an_ao.value = y;
959 set_constant_ot(&an_ao);
960 five_ao = zero_ao; five_ao.value = 5;
961 set_constant_ot(&five_ao);
963 /* Call the error veneer routine. */
964 assembleg_store(stack_pointer, an_ao);
965 assembleg_store(stack_pointer, type_ao);
966 assembleg_store(stack_pointer, size_ao);
967 assembleg_store(stack_pointer, index_ao);
968 assembleg_store(stack_pointer, en_ao);
969 assembleg_3(call_gc, veneer_routine(RT__Err_VR),
970 five_ao, zero_operand);
972 /* We have to clear any of AO1, AO2, AO3 off the stack if
973 present, so that we can achieve the same effect on the stack
974 that executing the opcode would have had */
976 if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0))
977 assembleg_2(copy_gc, stack_pointer, zero_operand);
978 if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
979 assembleg_2(copy_gc, stack_pointer, zero_operand);
980 if ((AO3.type == LOCALVAR_OT) && (AO3.value == 0))
981 { if ((oc == aloadb_gc) || (oc == aload_gc))
982 { assembleg_store(AO3, zero_ao);
984 else assembleg_2(copy_gc, stack_pointer, zero_operand);
986 assembleg_jump(final_label);
988 assemble_label_no(passed_label);
989 assembleg_3(oc, AO1, AO2, AO3);
990 assemble_label_no(final_label);
994 /* Otherwise, compile a call to the veneer which verifies that
995 the proposed read/write is within dynamic Z-machine memory. */
998 case aloadb_gc: vr = RT__ChLDB_VR; break;
999 case aload_gc: vr = RT__ChLDW_VR; break;
1000 case astoreb_gc: vr = RT__ChSTB_VR; break;
1001 case astore_gc: vr = RT__ChSTW_VR; break;
1002 default: compiler_error("unknown array opcode");
1005 if ((oc == aloadb_gc) || (oc == aload_gc))
1006 assembleg_call_2(veneer_routine(vr), AO1, AO2, AO3);
1008 assembleg_call_3(veneer_routine(vr), AO1, AO2, AO3, zero_operand);
1011 static assembly_operand check_nonzero_at_runtime_g(assembly_operand AO1,
1012 int error_label, int rte_number)
1014 assembly_operand AO, AO2, AO3;
1016 int check_sp = FALSE, passed_label, failed_label, last_label;
1022 /* Assemble to code to check that the operand AO1 is ofclass Object:
1023 if it is, execution should continue and the stack should be
1024 unchanged. Otherwise, call the veneer's run-time-error routine
1025 with the given error number, and then: if the label isn't -1,
1026 switch execution to this label, with the value popped from
1027 the stack if it was on the stack in the first place;
1028 if the label is -1, either replace the top of the stack with
1029 the constant symbol (class-object) Object.
1031 The Object has no parent, child or sibling, so that the
1032 built-in tree functions will safely return 0 on this object. */
1034 /* Sometimes we can already see that the object number is valid. */
1035 if (AO1.marker == OBJECT_MV &&
1036 ((AO1.value >= 1) && (AO1.value <= no_objects))) {
1040 pre_unreach = execution_never_reaches_here;
1042 passed_label = next_label++;
1043 failed_label = next_label++;
1045 if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0) && (AO1.marker == 0)) {
1046 /* That is, if AO1 is the stack pointer */
1048 assembleg_store(temp_var2, stack_pointer);
1049 assembleg_store(stack_pointer, temp_var2);
1056 if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
1057 || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
1058 || (rte_number == PROP_ADD_RTE)) {
1060 /* Test if zero... */
1061 assembleg_1_branch(jz_gc, AO, failed_label);
1062 if (!pre_unreach && execution_never_reaches_here)
1063 execution_never_reaches_here |= EXECSTATE_NOWARN;
1064 /* Test if first byte is 0x70... */
1065 assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
1067 AO3.value = 0x70; /* type byte -- object */
1068 set_constant_ot(&AO3);
1069 assembleg_2_branch(jeq_gc, stack_pointer, AO3, passed_label);
1072 /* Test if zero... */
1073 assembleg_1_branch(jz_gc, AO, failed_label);
1074 if (!pre_unreach && execution_never_reaches_here)
1075 execution_never_reaches_here |= EXECSTATE_NOWARN;
1076 /* Test if first byte is 0x70... */
1077 assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
1079 AO3.value = 0x70; /* type byte -- object */
1080 set_constant_ot(&AO3);
1081 assembleg_2_branch(jne_gc, stack_pointer, AO3, failed_label);
1082 /* Test if inside the "Class" object... */
1083 INITAOTV(&AO3, BYTECONSTANT_OT, GOBJFIELD_PARENT());
1084 assembleg_3(aload_gc, AO, AO3, stack_pointer);
1085 ln = symbol_index("Class", -1);
1086 AO3.value = symbols[ln].value;
1087 AO3.marker = OBJECT_MV;
1088 AO3.type = CONSTANT_OT;
1089 assembleg_2_branch(jne_gc, stack_pointer, AO3, passed_label);
1092 assemble_label_no(failed_label);
1094 AO2.value = rte_number;
1095 set_constant_ot(&AO2);
1096 assembleg_call_2(veneer_routine(RT__Err_VR), AO2, AO1, zero_operand);
1098 if (error_label != -1) {
1099 /* Jump to the error label */
1100 if (error_label == -3) assembleg_1(return_gc, zero_operand);
1101 else if (error_label == -4) assembleg_1(return_gc, one_operand);
1102 else assembleg_jump(error_label);
1105 /* Build the symbol for "Object" */
1106 ln = symbol_index("Object", -1);
1107 AO2.value = symbols[ln].value;
1108 AO2.marker = OBJECT_MV;
1109 AO2.type = CONSTANT_OT;
1112 assembleg_store(AO1, AO2);
1115 /* Store either "Object" or the operand's value in the temporary
1117 assembleg_store(temp_var2, AO2);
1118 last_label = next_label++;
1119 assembleg_jump(last_label);
1120 assemble_label_no(passed_label);
1121 assembleg_store(temp_var2, AO1);
1122 assemble_label_no(last_label);
1127 assemble_label_no(passed_label);
1131 static void compile_conditional_g(condclass *cc,
1132 assembly_operand AO1, assembly_operand AO2, int label, int flag)
1133 { assembly_operand AO4;
1134 int the_zc, error_label = label,
1135 va_flag = FALSE, va_label = 0;
1139 the_zc = (flag ? cc->posform : cc->negform);
1142 switch ((cc-condclasses)*2 + 500) {
1145 check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"has/hasnt\" expression");
1146 check_warn_symbol_type(&AO2, ATTRIBUTE_T, 0, "\"has/hasnt\" expression");
1147 if (runtime_error_checking_switch) {
1149 error_label = next_label++;
1150 AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
1151 if (is_constant_ot(AO2.type) && AO2.marker == 0) {
1152 if ((AO2.value < 0) || (AO2.value >= NUM_ATTR_BYTES*8)) {
1153 error("'has'/'hasnt' applied to illegal attribute number");
1157 int pa_label = next_label++, fa_label = next_label++;
1158 assembly_operand en_ao, max_ao;
1160 if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
1161 if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
1162 assembleg_2(stkpeek_gc, zero_operand, temp_var1);
1163 assembleg_2(stkpeek_gc, one_operand, temp_var2);
1166 assembleg_2(stkpeek_gc, zero_operand, temp_var1);
1167 assembleg_store(temp_var2, AO2);
1171 assembleg_store(temp_var1, AO1);
1172 if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
1173 assembleg_2(stkpeek_gc, zero_operand, temp_var2);
1176 assembleg_store(temp_var2, AO2);
1181 max_ao.value = NUM_ATTR_BYTES*8;
1182 set_constant_ot(&max_ao);
1183 assembleg_2_branch(jlt_gc, temp_var2, zero_operand, fa_label);
1184 assembleg_2_branch(jlt_gc, temp_var2, max_ao, pa_label);
1185 assemble_label_no(fa_label);
1187 en_ao.value = 19; /* INVALIDATTR_RTE */
1188 set_constant_ot(&en_ao);
1189 assembleg_store(stack_pointer, temp_var2);
1190 assembleg_store(stack_pointer, temp_var1);
1191 assembleg_store(stack_pointer, en_ao);
1192 assembleg_3(call_gc, veneer_routine(RT__Err_VR),
1193 three_operand, zero_operand);
1195 va_label = next_label++;
1196 assembleg_jump(va_label);
1197 assemble_label_no(pa_label);
1200 if (is_constant_ot(AO2.type) && AO2.marker == 0) {
1202 set_constant_ot(&AO2);
1207 AO4.type = BYTECONSTANT_OT;
1208 if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
1209 if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
1210 assembleg_0(stkswap_gc);
1211 assembleg_3(add_gc, AO2, AO4, stack_pointer);
1212 assembleg_0(stkswap_gc);
1215 assembleg_3(add_gc, AO2, AO4, stack_pointer);
1217 AO2 = stack_pointer;
1219 assembleg_3(aloadbit_gc, AO1, AO2, stack_pointer);
1220 the_zc = (flag ? jnz_gc : jz_gc);
1221 AO1 = stack_pointer;
1225 check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"in/notin\" expression");
1226 check_warn_symbol_type(&AO2, OBJECT_T, CLASS_T, "\"in/notin\" expression");
1227 if (runtime_error_checking_switch) {
1229 error_label = next_label++;
1230 AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
1233 AO4.value = GOBJFIELD_PARENT();
1234 AO4.type = BYTECONSTANT_OT;
1235 assembleg_3(aload_gc, AO1, AO4, stack_pointer);
1236 AO1 = stack_pointer;
1237 the_zc = (flag ? jeq_gc : jne_gc);
1241 /* first argument can be anything */
1242 check_warn_symbol_type(&AO2, CLASS_T, 0, "\"ofclass\" expression");
1243 assembleg_call_2(veneer_routine(OC__Cl_VR), AO1, AO2, stack_pointer);
1244 the_zc = (flag ? jnz_gc : jz_gc);
1245 AO1 = stack_pointer;
1249 /* first argument can be anything */
1250 check_warn_symbol_type(&AO2, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"provides\" expression");
1251 assembleg_call_2(veneer_routine(OP__Pr_VR), AO1, AO2, stack_pointer);
1252 the_zc = (flag ? jnz_gc : jz_gc);
1253 AO1 = stack_pointer;
1257 error("condition not yet supported in Glulx");
1262 if (the_zc == jnz_gc || the_zc == jz_gc)
1263 assembleg_1_branch(the_zc, AO1, label);
1265 assembleg_2_branch(the_zc, AO1, AO2, label);
1266 if (error_label != label) assemble_label_no(error_label);
1267 if (va_flag) assemble_label_no(va_label);
1270 static void value_in_void_context(assembly_operand AO)
1273 value_in_void_context_z(AO);
1275 value_in_void_context_g(AO);
1279 extern assembly_operand check_nonzero_at_runtime(assembly_operand AO1,
1280 int error_label, int rte_number)
1283 return check_nonzero_at_runtime_z(AO1, error_label, rte_number);
1285 return check_nonzero_at_runtime_g(AO1, error_label, rte_number);
1288 static void generate_code_from(int n, int void_flag)
1290 /* When void, this must not leave anything on the stack. */
1292 int i, j, below, above, opnum, arity; assembly_operand Result;
1294 below = ET[n].down; above = ET[n].up;
1296 { if ((void_flag) && (ET[n].value.type != OMITTED_OT))
1297 value_in_void_context(ET[n].value);
1301 opnum = ET[n].operator_number;
1303 if (opnum == COMMA_OP)
1304 { generate_code_from(below, TRUE);
1305 generate_code_from(ET[below].right, void_flag);
1306 ET[n].value = ET[ET[below].right].value;
1307 goto OperatorGenerated;
1310 if ((opnum == LOGAND_OP) || (opnum == LOGOR_OP))
1311 { generate_code_from(below, FALSE);
1312 if (execution_never_reaches_here) {
1313 /* If the condition never falls through to here, then it
1314 was an "... && 0 && ..." test. Our convention is to skip
1315 the "not reached" warnings for this case. */
1316 execution_never_reaches_here |= EXECSTATE_NOWARN;
1318 generate_code_from(ET[below].right, FALSE);
1319 goto OperatorGenerated;
1324 /* Signifies a SETEQUALS_OP which has already been done */
1326 ET[n].down = -1; return;
1329 /* Note that (except in the cases of comma and logical and/or) it
1330 is essential to code generate the operands right to left, because
1331 of the peculiar way the Z-machine's stack works:
1335 (for instance) pulls to the first operand, then the second. So
1341 calculates (b+7)-(a*2), not the other way around (as would be more
1342 usual in stack machines evaluating expressions written in reverse
1343 Polish notation). (Basically this is because the Z-machine was
1344 designed to implement a LISP-like language naturally expressed
1345 in forward Polish notation: (PLUS 3 4), for instance.) */
1347 /* And the Glulx machine follows the Z-machine in this respect. */
1351 { i = ET[i].right; arity++;
1353 for (j=arity;j>0;j--)
1357 { k++; i = ET[i].right;
1359 generate_code_from(i, FALSE);
1363 /* Check this again, because code generation lower down may have
1364 stubbed it into -1 */
1366 if (ET[n].operator_number == -1)
1367 { ET[n].down = -1; return;
1372 if (operators[opnum].opcode_number_z >= 400)
1374 /* Conditional terms such as '==': */
1376 int a = ET[n].true_label, b = ET[n].false_label,
1377 branch_away, branch_other,
1378 make_jump_away = FALSE, make_branch_label = FALSE;
1379 int oc = operators[opnum].opcode_number_z-400, flag = TRUE;
1381 if (oc >= 400) { oc = oc - 400; flag = FALSE; }
1383 if ((oc == je_zc) && (arity == 2))
1384 { i = ET[ET[n].down].right;
1385 if ((ET[i].value.value == zero_operand.value)
1386 && (ET[i].value.type == zero_operand.type))
1390 /* If the condition has truth state flag, branch to
1391 label a, and if not, to label b. Possibly one of a, b
1392 equals -1, meaning "continue from this instruction".
1394 branch_away is the label which is a branch away (the one
1395 which isn't immediately after) and flag is the truth
1396 state to branch there.
1398 Note that when multiple instructions are needed (because
1399 of the use of the 'or' operator) the branch_other label
1400 is created if need be.
1403 /* Reduce to the case where the branch_away label does exist: */
1405 if (a == -1) { a = b; b = -1; flag = !flag; }
1407 branch_away = a; branch_other = b;
1408 if (branch_other != -1) make_jump_away = TRUE;
1410 if ((((oc != je_zc)&&(arity > 2)) || (arity > 4)) && (flag == FALSE))
1412 /* In this case, we have an 'or' situation where multiple
1413 instructions are needed and where the overall condition
1414 is negated. That is, we have, e.g.
1416 if not (A cond B or C or D) then branch_away
1418 which we transform into
1420 if (A cond B) then branch_other
1421 if (A cond C) then branch_other
1422 if not (A cond D) then branch_away
1425 if (branch_other == -1)
1426 { branch_other = next_label++; make_branch_label = TRUE;
1431 assemblez_1_branch(jz_zc, ET[below].value, branch_away, flag);
1433 { assembly_operand left_operand;
1436 compile_conditional_z(oc, ET[below].value,
1437 ET[ET[below].right].value, branch_away, flag);
1439 { /* The case of a condition using "or".
1440 First: if the condition tests the stack pointer,
1441 and it can't always be done in a single test, move
1442 the value off the stack and into temporary variable
1445 if (((ET[below].value.type == VARIABLE_OT)
1446 && (ET[below].value.value == 0))
1447 && ((oc != je_zc) || (arity>4)) )
1448 { INITAOTV(&left_operand, VARIABLE_OT, 255);
1449 assemblez_store(left_operand, ET[below].value);
1451 else left_operand = ET[below].value;
1452 i = ET[below].right; arity--;
1454 /* "left_operand" now holds the quantity to be tested;
1455 "i" holds the right operand reached so far;
1456 "arity" the number of right operands. */
1459 { if ((oc == je_zc) && (arity>1))
1461 /* je_zc is an especially good case since the
1462 Z-machine implements "or" for up to three
1463 right operands automatically, though it's an
1464 especially bad case to generate code for! */
1467 { assemblez_3_branch(je_zc,
1468 left_operand, ET[i].value,
1469 ET[ET[i].right].value, branch_away, flag);
1470 i = ET[i].right; arity--;
1473 { if ((arity == 3) || flag)
1474 assemblez_4_branch(je_zc, left_operand,
1476 ET[ET[i].right].value,
1477 ET[ET[ET[i].right].right].value,
1480 assemblez_4_branch(je_zc, left_operand,
1482 ET[ET[i].right].value,
1483 ET[ET[ET[i].right].right].value,
1484 branch_other, !flag);
1485 i = ET[ET[i].right].right; arity -= 2;
1489 { /* Otherwise we can compare the left_operand with
1490 only one right operand at the time. There are
1491 two cases: it's the last right operand, or it
1494 if ((arity == 1) || flag)
1495 compile_conditional_z(oc, left_operand,
1496 ET[i].value, branch_away, flag);
1498 compile_conditional_z(oc, left_operand,
1499 ET[i].value, branch_other, !flag);
1501 i = ET[i].right; arity--;
1507 /* NB: These two conditions cannot both occur, fortunately! */
1509 if (make_branch_label) assemble_label_no(branch_other);
1510 if (make_jump_away) assemblez_jump(branch_other);
1512 goto OperatorGenerated;
1517 if (operators[opnum].opcode_number_g >= FIRST_CC
1518 && operators[opnum].opcode_number_g <= LAST_CC) {
1519 /* Conditional terms such as '==': */
1521 int a = ET[n].true_label, b = ET[n].false_label;
1522 int branch_away, branch_other, flag,
1523 make_jump_away = FALSE, make_branch_label = FALSE;
1524 int ccode = operators[opnum].opcode_number_g;
1525 condclass *cc = &condclasses[(ccode-FIRST_CC) / 2];
1526 flag = (ccode & 1) ? 0 : 1;
1528 /* If the comparison is "equal to (constant) 0", change it
1529 to the simple "zero" test. Unfortunately, this doesn't
1530 work for the commutative form "(constant) 0 is equal to".
1531 At least I don't think it does. */
1533 if ((cc == &condclasses[1]) && (arity == 2)) {
1534 i = ET[ET[n].down].right;
1535 if ((ET[i].value.value == 0)
1536 && (ET[i].value.marker == 0)
1537 && is_constant_ot(ET[i].value.type)) {
1538 cc = &condclasses[0];
1542 /* If the condition has truth state flag, branch to
1543 label a, and if not, to label b. Possibly one of a, b
1544 equals -1, meaning "continue from this instruction".
1546 branch_away is the label which is a branch away (the one
1547 which isn't immediately after) and flag is the truth
1548 state to branch there.
1550 Note that when multiple instructions are needed (because
1551 of the use of the 'or' operator) the branch_other label
1552 is created if need be.
1555 /* Reduce to the case where the branch_away label does exist: */
1557 if (a == -1) { a = b; b = -1; flag = !flag; }
1559 branch_away = a; branch_other = b;
1560 if (branch_other != -1) make_jump_away = TRUE;
1562 if ((arity > 2) && (flag == FALSE)) {
1563 /* In this case, we have an 'or' situation where multiple
1564 instructions are needed and where the overall condition
1565 is negated. That is, we have, e.g.
1567 if not (A cond B or C or D) then branch_away
1569 which we transform into
1571 if (A cond B) then branch_other
1572 if (A cond C) then branch_other
1573 if not (A cond D) then branch_away
1576 if (branch_other == -1) {
1577 branch_other = next_label++; make_branch_label = TRUE;
1581 if (cc == &condclasses[0]) {
1582 assembleg_1_branch((flag ? cc->posform : cc->negform),
1583 ET[below].value, branch_away);
1587 compile_conditional_g(cc, ET[below].value,
1588 ET[ET[below].right].value, branch_away, flag);
1591 /* The case of a condition using "or".
1592 First: if the condition tests the stack pointer,
1593 and it can't always be done in a single test, move
1594 the value off the stack and into temporary variable
1597 assembly_operand left_operand;
1598 if (((ET[below].value.type == LOCALVAR_OT)
1599 && (ET[below].value.value == 0))) {
1600 assembleg_store(temp_var1, ET[below].value);
1601 left_operand = temp_var1;
1604 left_operand = ET[below].value;
1606 i = ET[below].right;
1609 /* "left_operand" now holds the quantity to be tested;
1610 "i" holds the right operand reached so far;
1611 "arity" the number of right operands. */
1614 /* We can compare the left_operand with
1615 only one right operand at the time. There are
1616 two cases: it's the last right operand, or it
1619 if ((arity == 1) || flag)
1620 compile_conditional_g(cc, left_operand,
1621 ET[i].value, branch_away, flag);
1623 compile_conditional_g(cc, left_operand,
1624 ET[i].value, branch_other, !flag);
1632 /* NB: These two conditions cannot both occur, fortunately! */
1634 if (make_branch_label) assemble_label_no(branch_other);
1635 if (make_jump_away) assembleg_jump(branch_other);
1637 goto OperatorGenerated;
1642 /* The operator is now definitely one which produces a value */
1644 if (void_flag && (!(operators[opnum].side_effect)))
1645 error_named("Evaluating this has no effect:",
1646 operators[opnum].description);
1648 /* Where shall we put the resulting value? (In Glulx, this could
1649 be smarter, and peg the result into ZEROCONSTANT.) */
1651 if (void_flag) Result = temp_var1; /* Throw it away */
1653 { if ((above != -1) && (ET[above].operator_number == SETEQUALS_OP))
1655 /* If the node above is "set variable equal to", then
1656 make that variable the place to put the result, and
1657 delete the SETEQUALS_OP node since its effect has already
1658 been accomplished. */
1660 ET[above].operator_number = -1;
1661 Result = ET[ET[above].down].value;
1662 ET[above].value = Result;
1664 else Result = stack_pointer; /* Otherwise, put it on the stack */
1669 if (operators[opnum].opcode_number_z != -1)
1671 /* Operators directly translatable into Z-code opcodes: infix ops
1672 take two operands whereas pre/postfix operators take only one */
1674 if (operators[opnum].usage == IN_U)
1675 { int o_n = operators[opnum].opcode_number_z;
1676 if (runtime_error_checking_switch && (!veneer_mode)
1677 && ((o_n == div_zc) || (o_n == mod_zc)))
1678 { assembly_operand by_ao, error_ao; int ln;
1679 by_ao = ET[ET[below].right].value;
1680 if ((by_ao.value != 0) && (by_ao.marker == 0)
1681 && ((by_ao.type == SHORT_CONSTANT_OT)
1682 || (by_ao.type == LONG_CONSTANT_OT)))
1683 assemblez_2_to(o_n, ET[below].value,
1687 assemblez_store(temp_var1, ET[below].value);
1688 assemblez_store(temp_var2, by_ao);
1690 assemblez_1_branch(jz_zc, temp_var2, ln, FALSE);
1691 INITAOT(&error_ao, SHORT_CONSTANT_OT);
1692 error_ao.value = DBYZERO_RTE;
1693 assemblez_2(call_vn_zc, veneer_routine(RT__Err_VR),
1695 assemblez_inc(temp_var2);
1696 assemble_label_no(ln);
1697 assemblez_2_to(o_n, temp_var1, temp_var2, Result);
1701 assemblez_2_to(o_n, ET[below].value,
1702 ET[ET[below].right].value, Result);
1706 assemblez_1_to(operators[opnum].opcode_number_z, ET[below].value,
1712 access_memory_z(loadb_zc, ET[below].value,
1713 ET[ET[below].right].value, Result);
1716 access_memory_z(loadw_zc, ET[below].value,
1717 ET[ET[below].right].value, Result);
1719 case UNARY_MINUS_OP:
1720 assemblez_2_to(sub_zc, zero_operand, ET[below].value, Result);
1723 assemblez_1_to(not_zc, ET[below].value, Result);
1727 { assembly_operand AO = ET[below].value;
1728 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".&\" expression");
1729 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".&\" expression");
1730 if (runtime_error_checking_switch && (!veneer_mode))
1731 AO = check_nonzero_at_runtime(AO, -1, PROP_ADD_RTE);
1732 assemblez_2_to(get_prop_addr_zc, AO,
1733 ET[ET[below].right].value, temp_var1);
1734 if (!void_flag) write_result_z(Result, temp_var1);
1739 { assembly_operand AO = ET[below].value;
1740 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".#\" expression");
1741 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".#\" expression");
1742 if (runtime_error_checking_switch && (!veneer_mode))
1743 AO = check_nonzero_at_runtime(AO, -1, PROP_NUM_RTE);
1744 assemblez_2_to(get_prop_addr_zc, AO,
1745 ET[ET[below].right].value, temp_var1);
1746 assemblez_1_branch(jz_zc, temp_var1, next_label++, TRUE);
1747 assemblez_1_to(get_prop_len_zc, temp_var1, temp_var1);
1748 assemble_label_no(next_label-1);
1749 if (!void_flag) write_result_z(Result, temp_var1);
1755 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
1756 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
1757 if (runtime_error_checking_switch && (!veneer_mode))
1758 assemblez_3_to(call_vs_zc, veneer_routine(RT__ChPR_VR),
1759 ET[below].value, ET[ET[below].right].value, temp_var1);
1761 assemblez_2_to(get_prop_zc, ET[below].value,
1762 ET[ET[below].right].value, temp_var1);
1763 if (!void_flag) write_result_z(Result, temp_var1);
1768 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
1769 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
1770 j=1; AI.operand[0] = veneer_routine(RV__Pr_VR);
1771 goto GenFunctionCallZ;
1773 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".&\" expression");
1774 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".&\" expression");
1775 j=1; AI.operand[0] = veneer_routine(RA__Pr_VR);
1776 goto GenFunctionCallZ;
1778 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".#\" expression");
1779 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".#\" expression");
1780 j=1; AI.operand[0] = veneer_routine(RL__Pr_VR);
1781 goto GenFunctionCallZ;
1782 case MESSAGE_SETEQUALS_OP:
1783 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
1784 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
1785 j=1; AI.operand[0] = veneer_routine(WV__Pr_VR);
1786 goto GenFunctionCallZ;
1787 case MESSAGE_INC_OP:
1788 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"++.\" expression");
1789 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"++.\" expression");
1790 j=1; AI.operand[0] = veneer_routine(IB__Pr_VR);
1791 goto GenFunctionCallZ;
1792 case MESSAGE_DEC_OP:
1793 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"--.\" expression");
1794 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"--.\" expression");
1795 j=1; AI.operand[0] = veneer_routine(DB__Pr_VR);
1796 goto GenFunctionCallZ;
1797 case MESSAGE_POST_INC_OP:
1798 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".++\" expression");
1799 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".++\" expression");
1800 j=1; AI.operand[0] = veneer_routine(IA__Pr_VR);
1801 goto GenFunctionCallZ;
1802 case MESSAGE_POST_DEC_OP:
1803 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".--\" expression");
1804 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".--\" expression");
1805 j=1; AI.operand[0] = veneer_routine(DA__Pr_VR);
1806 goto GenFunctionCallZ;
1808 j=1; AI.operand[0] = veneer_routine(RA__Sc_VR);
1809 goto GenFunctionCallZ;
1811 check_warn_symbol_has_metaclass(&ET[below].value, "\".()\" expression");
1812 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".()\" expression");
1813 j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
1814 goto GenFunctionCallZ;
1815 case MESSAGE_CALL_OP:
1816 check_warn_symbol_has_metaclass(&ET[below].value, "\".()\" expression");
1817 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".()\" expression");
1818 j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
1819 goto GenFunctionCallZ;
1825 if ((ET[below].value.type == VARIABLE_OT)
1826 && (ET[below].value.value >= 256))
1827 { int sf_number = ET[below].value.value - 256;
1829 i = ET[below].right;
1831 { error("Argument to system function missing");
1832 AI.operand[0] = one_operand;
1833 AI.operand_count = 1;
1837 while (i != -1) { j++; i = ET[i].right; }
1839 if (((sf_number != INDIRECT_SYSF) &&
1840 (sf_number != RANDOM_SYSF) && (j > 1))
1841 || ((sf_number == INDIRECT_SYSF) && (j>7)))
1843 error("System function given with too many arguments");
1845 if (sf_number != RANDOM_SYSF)
1847 i = ET[below].right;
1848 for (jcount = 0; jcount < j; jcount++)
1849 { AI.operand[jcount] = ET[i].value;
1852 AI.operand_count = j;
1855 AI.store_variable_number = Result.value;
1856 AI.branch_label_number = -1;
1861 { assembly_operand AO, AO2; int arg_c, arg_et;
1862 INITAOTV(&AO, SHORT_CONSTANT_OT, j);
1863 INITAOT(&AO2, LONG_CONSTANT_OT);
1864 AO2.value = begin_word_array();
1865 AO2.marker = ARRAY_MV;
1867 for (arg_c=0, arg_et = ET[below].right;arg_c<j;
1868 arg_c++, arg_et = ET[arg_et].right)
1869 { if (ET[arg_et].value.type == VARIABLE_OT)
1870 error("Only constants can be used as possible 'random' results");
1871 array_entry(arg_c, FALSE, ET[arg_et].value);
1873 finish_array(arg_c, FALSE);
1875 assemblez_1_to(random_zc, AO, temp_var1);
1876 assemblez_dec(temp_var1);
1877 assemblez_2_to(loadw_zc, AO2, temp_var1, Result);
1880 assemblez_1_to(random_zc,
1881 ET[ET[below].right].value, Result);
1885 { assembly_operand AO;
1886 AO = ET[ET[below].right].value;
1887 if (runtime_error_checking_switch)
1888 AO = check_nonzero_at_runtime(AO, -1,
1890 assemblez_1_to(get_parent_zc, AO, Result);
1896 { assembly_operand AO;
1897 AO = ET[ET[below].right].value;
1898 if (runtime_error_checking_switch)
1899 AO = check_nonzero_at_runtime(AO, -1,
1900 (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
1901 assemblez_objcode(get_child_zc,
1902 AO, Result, -2, TRUE);
1908 { assembly_operand AO;
1909 AO = ET[ET[below].right].value;
1910 if (runtime_error_checking_switch)
1911 AO = check_nonzero_at_runtime(AO, -1,
1912 (sf_number==SIBLING_SYSF)
1913 ?SIBLING_RTE:YOUNGER_RTE);
1914 assemblez_objcode(get_sibling_zc,
1915 AO, Result, -2, TRUE);
1920 j=0; i = ET[below].right;
1921 check_warn_symbol_type(&ET[i].value, ROUTINE_T, 0, "indirect function call");
1922 goto IndirectFunctionCallZ;
1925 { assembly_operand AO;
1926 AO = ET[ET[below].right].value;
1927 if (runtime_error_checking_switch)
1928 AO = check_nonzero_at_runtime(AO, -1,
1930 assemblez_store(temp_var1, zero_operand);
1931 assemblez_objcode(get_child_zc,
1932 AO, stack_pointer, next_label+1, FALSE);
1933 assemble_label_no(next_label);
1934 assemblez_inc(temp_var1);
1935 assemblez_objcode(get_sibling_zc,
1936 stack_pointer, stack_pointer,
1938 assemble_label_no(next_label+1);
1939 assemblez_store(temp_var2, stack_pointer);
1940 if (!void_flag) write_result_z(Result, temp_var1);
1946 { assembly_operand AO;
1947 AO = ET[ET[below].right].value;
1948 if (runtime_error_checking_switch)
1949 AO = check_nonzero_at_runtime(AO, -1,
1951 assemblez_objcode(get_child_zc,
1952 AO, temp_var1, next_label+1, FALSE);
1953 assemblez_1(push_zc, temp_var1);
1954 assemble_label_no(next_label);
1955 assemblez_store(temp_var1, stack_pointer);
1956 assemblez_objcode(get_sibling_zc,
1957 temp_var1, stack_pointer, next_label, TRUE);
1958 assemble_label_no(next_label+1);
1959 if (!void_flag) write_result_z(Result, temp_var1);
1965 assemblez_store(temp_var1, ET[ET[below].right].value);
1966 if (runtime_error_checking_switch)
1967 check_nonzero_at_runtime(temp_var1, -1,
1969 assemblez_1_to(get_parent_zc, temp_var1, temp_var3);
1970 assemblez_1_branch(jz_zc, temp_var3,next_label+1,TRUE);
1971 assemblez_store(temp_var2, temp_var3);
1972 assemblez_store(temp_var3, zero_operand);
1973 assemblez_objcode(get_child_zc,
1974 temp_var2, temp_var2, next_label, TRUE);
1975 assemble_label_no(next_label++);
1976 assemblez_2_branch(je_zc, temp_var1, temp_var2,
1978 assemblez_store(temp_var3, temp_var2);
1979 assemblez_objcode(get_sibling_zc,
1980 temp_var2, temp_var2, next_label - 1, TRUE);
1981 assemble_label_no(next_label++);
1982 if (!void_flag) write_result_z(Result, temp_var3);
1985 case METACLASS_SYSF:
1986 assemblez_2_to((version_number==3)?call_zc:call_vs_zc,
1987 veneer_routine(Metaclass_VR),
1988 ET[ET[below].right].value, Result);
1992 error("The glk() system function does not exist in Z-code");
1997 check_warn_symbol_type(&ET[below].value, ROUTINE_T, 0, "function call");
2003 IndirectFunctionCallZ:
2005 while ((i != -1) && (j<8))
2006 { AI.operand[j++] = ET[i].value;
2010 if ((j > 4) && (version_number == 3))
2011 { error("A function may be called with at most 3 arguments");
2014 if ((j==8) && (i != -1))
2015 { error("A function may be called with at most 7 arguments");
2018 AI.operand_count = j;
2020 if ((void_flag) && (version_number >= 5))
2021 { AI.store_variable_number = -1;
2023 { case 1: AI.internal_number = call_1n_zc; break;
2024 case 2: AI.internal_number = call_2n_zc; break;
2025 case 3: case 4: AI.internal_number = call_vn_zc; break;
2026 case 5: case 6: case 7: case 8:
2027 AI.internal_number = call_vn2_zc; break;
2031 { AI.store_variable_number = Result.value;
2032 if (version_number == 3)
2033 AI.internal_number = call_zc;
2036 { case 1: AI.internal_number = call_1s_zc; break;
2037 case 2: AI.internal_number = call_2s_zc; break;
2038 case 3: case 4: AI.internal_number = call_vs_zc; break;
2039 case 5: case 6: case 7: case 8:
2040 AI.internal_number = call_vs2_zc; break;
2044 AI.branch_label_number = -1;
2045 assemblez_instruction(&AI);
2049 assemblez_store(ET[below].value,
2050 ET[ET[below].right].value);
2051 if (!void_flag) write_result_z(Result, ET[below].value);
2054 case PROPERTY_SETEQUALS_OP:
2055 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
2056 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
2058 { if (runtime_error_checking_switch)
2059 assemblez_4_to(call_zc, veneer_routine(RT__ChPS_VR),
2060 ET[below].value, ET[ET[below].right].value,
2061 ET[ET[ET[below].right].right].value, Result);
2063 { assemblez_store(temp_var1,
2064 ET[ET[ET[below].right].right].value);
2065 assemblez_3(put_prop_zc, ET[below].value,
2066 ET[ET[below].right].value,
2068 write_result_z(Result, temp_var1);
2072 { if (runtime_error_checking_switch && (!veneer_mode))
2073 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2074 ET[below].value, ET[ET[below].right].value,
2075 ET[ET[ET[below].right].right].value);
2076 else assemblez_3(put_prop_zc, ET[below].value,
2077 ET[ET[below].right].value,
2078 ET[ET[ET[below].right].right].value);
2081 case ARROW_SETEQUALS_OP:
2083 { assemblez_store(temp_var1,
2084 ET[ET[ET[below].right].right].value);
2085 access_memory_z(storeb_zc, ET[below].value,
2086 ET[ET[below].right].value,
2088 write_result_z(Result, temp_var1);
2090 else access_memory_z(storeb_zc, ET[below].value,
2091 ET[ET[below].right].value,
2092 ET[ET[ET[below].right].right].value);
2095 case DARROW_SETEQUALS_OP:
2097 { assemblez_store(temp_var1,
2098 ET[ET[ET[below].right].right].value);
2099 access_memory_z(storew_zc, ET[below].value,
2100 ET[ET[below].right].value,
2102 write_result_z(Result, temp_var1);
2105 access_memory_z(storew_zc, ET[below].value,
2106 ET[ET[below].right].value,
2107 ET[ET[ET[below].right].right].value);
2111 assemblez_inc(ET[below].value);
2112 if (!void_flag) write_result_z(Result, ET[below].value);
2115 assemblez_dec(ET[below].value);
2116 if (!void_flag) write_result_z(Result, ET[below].value);
2119 if (!void_flag) write_result_z(Result, ET[below].value);
2120 assemblez_inc(ET[below].value);
2123 if (!void_flag) write_result_z(Result, ET[below].value);
2124 assemblez_dec(ET[below].value);
2128 assemblez_store(temp_var1, ET[below].value);
2129 assemblez_store(temp_var2, ET[ET[below].right].value);
2130 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2131 assemblez_inc(temp_var3);
2132 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2133 if (!void_flag) write_result_z(Result, temp_var3);
2137 assemblez_store(temp_var1, ET[below].value);
2138 assemblez_store(temp_var2, ET[ET[below].right].value);
2139 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2140 assemblez_dec(temp_var3);
2141 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2142 if (!void_flag) write_result_z(Result, temp_var3);
2145 case ARROW_POST_INC_OP:
2146 assemblez_store(temp_var1, ET[below].value);
2147 assemblez_store(temp_var2, ET[ET[below].right].value);
2148 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2149 if (!void_flag) write_result_z(Result, temp_var3);
2150 assemblez_inc(temp_var3);
2151 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2154 case ARROW_POST_DEC_OP:
2155 assemblez_store(temp_var1, ET[below].value);
2156 assemblez_store(temp_var2, ET[ET[below].right].value);
2157 access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2158 if (!void_flag) write_result_z(Result, temp_var3);
2159 assemblez_dec(temp_var3);
2160 access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2164 assemblez_store(temp_var1, ET[below].value);
2165 assemblez_store(temp_var2, ET[ET[below].right].value);
2166 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2167 assemblez_inc(temp_var3);
2168 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2169 if (!void_flag) write_result_z(Result, temp_var3);
2173 assemblez_store(temp_var1, ET[below].value);
2174 assemblez_store(temp_var2, ET[ET[below].right].value);
2175 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2176 assemblez_dec(temp_var3);
2177 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2178 if (!void_flag) write_result_z(Result, temp_var3);
2181 case DARROW_POST_INC_OP:
2182 assemblez_store(temp_var1, ET[below].value);
2183 assemblez_store(temp_var2, ET[ET[below].right].value);
2184 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2185 if (!void_flag) write_result_z(Result, temp_var3);
2186 assemblez_inc(temp_var3);
2187 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2190 case DARROW_POST_DEC_OP:
2191 assemblez_store(temp_var1, ET[below].value);
2192 assemblez_store(temp_var2, ET[ET[below].right].value);
2193 access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2194 if (!void_flag) write_result_z(Result, temp_var3);
2195 assemblez_dec(temp_var3);
2196 access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2199 case PROPERTY_INC_OP:
2200 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"++.\" expression");
2201 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"++.\" expression");
2202 assemblez_store(temp_var1, ET[below].value);
2203 assemblez_store(temp_var2, ET[ET[below].right].value);
2204 assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2205 assemblez_inc(temp_var3);
2206 if (runtime_error_checking_switch && (!veneer_mode))
2207 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2208 temp_var1, temp_var2, temp_var3);
2209 else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2210 if (!void_flag) write_result_z(Result, temp_var3);
2213 case PROPERTY_DEC_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_dec(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_POST_INC_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 if (!void_flag) write_result_z(Result, temp_var3);
2234 assemblez_inc(temp_var3);
2235 if (runtime_error_checking_switch && (!veneer_mode))
2236 assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2237 temp_var1, temp_var2, temp_var3);
2238 else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2241 case PROPERTY_POST_DEC_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_dec(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);
2256 printf("** Trouble op = %d i.e. '%s' **\n",
2257 opnum, operators[opnum].description);
2258 compiler_error("Expr code gen: Can't generate yet");
2262 assembly_operand AO, AO2;
2263 if (operators[opnum].opcode_number_g != -1)
2265 /* Operators directly translatable into opcodes: infix ops
2266 take two operands whereas pre/postfix operators take only one */
2268 if (operators[opnum].usage == IN_U)
2269 { int o_n = operators[opnum].opcode_number_g;
2270 if (runtime_error_checking_switch && (!veneer_mode)
2271 && ((o_n == div_gc) || (o_n == mod_gc)))
2272 { assembly_operand by_ao, error_ao; int ln;
2273 by_ao = ET[ET[below].right].value;
2274 if ((by_ao.value != 0) && (by_ao.marker == 0)
2275 && is_constant_ot(by_ao.type))
2276 assembleg_3(o_n, ET[below].value,
2279 { assembleg_store(temp_var1, ET[below].value);
2280 assembleg_store(temp_var2, by_ao);
2282 assembleg_1_branch(jnz_gc, temp_var2, ln);
2284 error_ao.value = DBYZERO_RTE;
2285 set_constant_ot(&error_ao);
2286 assembleg_call_1(veneer_routine(RT__Err_VR),
2287 error_ao, zero_operand);
2288 assembleg_store(temp_var2, one_operand);
2289 assemble_label_no(ln);
2290 assembleg_3(o_n, temp_var1, temp_var2, Result);
2294 assembleg_3(o_n, ET[below].value,
2295 ET[ET[below].right].value, Result);
2298 assembleg_2(operators[opnum].opcode_number_g, ET[below].value,
2306 if (ET[below].value.type == Result.type
2307 && ET[below].value.value == Result.value
2308 && ET[below].value.marker == Result.marker)
2310 assembleg_2(copy_gc, ET[below].value, Result);
2313 case UNARY_MINUS_OP:
2314 assembleg_2(neg_gc, ET[below].value, Result);
2317 assembleg_2(bitnot_gc, ET[below].value, Result);
2321 access_memory_g(aloadb_gc, ET[below].value,
2322 ET[ET[below].right].value, Result);
2325 access_memory_g(aload_gc, ET[below].value,
2326 ET[ET[below].right].value, Result);
2330 assembleg_store(ET[below].value,
2331 ET[ET[below].right].value);
2332 if (!void_flag) write_result_g(Result, ET[below].value);
2335 case ARROW_SETEQUALS_OP:
2337 { assembleg_store(temp_var1,
2338 ET[ET[ET[below].right].right].value);
2339 access_memory_g(astoreb_gc, ET[below].value,
2340 ET[ET[below].right].value,
2342 write_result_g(Result, temp_var1);
2344 else access_memory_g(astoreb_gc, ET[below].value,
2345 ET[ET[below].right].value,
2346 ET[ET[ET[below].right].right].value);
2349 case DARROW_SETEQUALS_OP:
2351 { assembleg_store(temp_var1,
2352 ET[ET[ET[below].right].right].value);
2353 access_memory_g(astore_gc, ET[below].value,
2354 ET[ET[below].right].value,
2356 write_result_g(Result, temp_var1);
2359 access_memory_g(astore_gc, ET[below].value,
2360 ET[ET[below].right].value,
2361 ET[ET[ET[below].right].right].value);
2365 assembleg_inc(ET[below].value);
2366 if (!void_flag) write_result_g(Result, ET[below].value);
2369 assembleg_dec(ET[below].value);
2370 if (!void_flag) write_result_g(Result, ET[below].value);
2373 if (!void_flag) write_result_g(Result, ET[below].value);
2374 assembleg_inc(ET[below].value);
2377 if (!void_flag) write_result_g(Result, ET[below].value);
2378 assembleg_dec(ET[below].value);
2382 assembleg_store(temp_var1, ET[below].value);
2383 assembleg_store(temp_var2, ET[ET[below].right].value);
2384 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2385 assembleg_inc(temp_var3);
2386 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2387 if (!void_flag) write_result_g(Result, temp_var3);
2391 assembleg_store(temp_var1, ET[below].value);
2392 assembleg_store(temp_var2, ET[ET[below].right].value);
2393 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2394 assembleg_dec(temp_var3);
2395 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2396 if (!void_flag) write_result_g(Result, temp_var3);
2399 case ARROW_POST_INC_OP:
2400 assembleg_store(temp_var1, ET[below].value);
2401 assembleg_store(temp_var2, ET[ET[below].right].value);
2402 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2403 if (!void_flag) write_result_g(Result, temp_var3);
2404 assembleg_inc(temp_var3);
2405 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2408 case ARROW_POST_DEC_OP:
2409 assembleg_store(temp_var1, ET[below].value);
2410 assembleg_store(temp_var2, ET[ET[below].right].value);
2411 access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2412 if (!void_flag) write_result_g(Result, temp_var3);
2413 assembleg_dec(temp_var3);
2414 access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2418 assembleg_store(temp_var1, ET[below].value);
2419 assembleg_store(temp_var2, ET[ET[below].right].value);
2420 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2421 assembleg_inc(temp_var3);
2422 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2423 if (!void_flag) write_result_g(Result, temp_var3);
2427 assembleg_store(temp_var1, ET[below].value);
2428 assembleg_store(temp_var2, ET[ET[below].right].value);
2429 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2430 assembleg_dec(temp_var3);
2431 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2432 if (!void_flag) write_result_g(Result, temp_var3);
2435 case DARROW_POST_INC_OP:
2436 assembleg_store(temp_var1, ET[below].value);
2437 assembleg_store(temp_var2, ET[ET[below].right].value);
2438 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2439 if (!void_flag) write_result_g(Result, temp_var3);
2440 assembleg_inc(temp_var3);
2441 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2444 case DARROW_POST_DEC_OP:
2445 assembleg_store(temp_var1, ET[below].value);
2446 assembleg_store(temp_var2, ET[ET[below].right].value);
2447 access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2448 if (!void_flag) write_result_g(Result, temp_var3);
2449 assembleg_dec(temp_var3);
2450 access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2455 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
2456 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
2457 AO = veneer_routine(RV__Pr_VR);
2458 goto TwoArgFunctionCall;
2461 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".&\" expression");
2462 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".&\" expression");
2463 AO = veneer_routine(RA__Pr_VR);
2464 goto TwoArgFunctionCall;
2467 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".#\" expression");
2468 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".#\" expression");
2469 AO = veneer_routine(RL__Pr_VR);
2470 goto TwoArgFunctionCall;
2473 case MESSAGE_CALL_OP:
2474 check_warn_symbol_has_metaclass(&ET[below].value, "\".()\" expression");
2475 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".()\" expression");
2476 AO2 = veneer_routine(CA__Pr_VR);
2478 goto DoFunctionCall;
2480 case MESSAGE_INC_OP:
2481 case PROPERTY_INC_OP:
2482 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"++.\" expression");
2483 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"++.\" expression");
2484 AO = veneer_routine(IB__Pr_VR);
2485 goto TwoArgFunctionCall;
2486 case MESSAGE_DEC_OP:
2487 case PROPERTY_DEC_OP:
2488 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"--.\" expression");
2489 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"--.\" expression");
2490 AO = veneer_routine(DB__Pr_VR);
2491 goto TwoArgFunctionCall;
2492 case MESSAGE_POST_INC_OP:
2493 case PROPERTY_POST_INC_OP:
2494 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".++\" expression");
2495 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".++\" expression");
2496 AO = veneer_routine(IA__Pr_VR);
2497 goto TwoArgFunctionCall;
2498 case MESSAGE_POST_DEC_OP:
2499 case PROPERTY_POST_DEC_OP:
2500 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".--\" expression");
2501 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".--\" expression");
2502 AO = veneer_routine(DA__Pr_VR);
2503 goto TwoArgFunctionCall;
2505 AO = veneer_routine(RA__Sc_VR);
2506 goto TwoArgFunctionCall;
2510 assembly_operand AO2 = ET[below].value;
2511 assembly_operand AO3 = ET[ET[below].right].value;
2513 assembleg_call_2(AO, AO2, AO3, zero_operand);
2515 assembleg_call_2(AO, AO2, AO3, Result);
2519 case PROPERTY_SETEQUALS_OP:
2520 case MESSAGE_SETEQUALS_OP:
2521 check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
2522 check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
2523 if (runtime_error_checking_switch && (!veneer_mode))
2524 AO = veneer_routine(RT__ChPS_VR);
2526 AO = veneer_routine(WV__Pr_VR);
2529 assembly_operand AO2 = ET[below].value;
2530 assembly_operand AO3 = ET[ET[below].right].value;
2531 assembly_operand AO4 = ET[ET[ET[below].right].right].value;
2532 if (AO4.type == LOCALVAR_OT && AO4.value == 0) {
2533 /* Rightmost is on the stack; reduce to previous case. */
2534 if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2535 if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2536 /* both already on stack. */
2539 assembleg_store(stack_pointer, AO3);
2540 assembleg_0(stkswap_gc);
2544 if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2545 assembleg_store(stack_pointer, AO2);
2548 assembleg_store(stack_pointer, AO3);
2549 assembleg_store(stack_pointer, AO2);
2554 /* We have to get the rightmost on the stack, below the
2556 if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2557 if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2558 assembleg_store(stack_pointer, AO4);
2559 assembleg_2(stkroll_gc, three_operand, one_operand);
2562 assembleg_store(stack_pointer, AO4);
2563 assembleg_0(stkswap_gc);
2564 assembleg_store(stack_pointer, AO2);
2568 if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2569 assembleg_store(stack_pointer, AO4);
2570 assembleg_store(stack_pointer, AO3);
2571 assembleg_2(stkroll_gc, three_operand, two_operand);
2574 assembleg_store(stack_pointer, AO4);
2575 assembleg_store(stack_pointer, AO3);
2576 assembleg_store(stack_pointer, AO2);
2581 assembleg_3(call_gc, AO, three_operand, zero_operand);
2583 assembleg_3(call_gc, AO, three_operand, Result);
2590 if (ET[below].value.type == SYSFUN_OT)
2591 { int sf_number = ET[below].value.value;
2593 i = ET[below].right;
2595 { error("Argument to system function missing");
2596 AI.operand[0] = one_operand;
2597 AI.operand_count = 1;
2601 while (i != -1) { j++; i = ET[i].right; }
2603 if (((sf_number != INDIRECT_SYSF) &&
2604 (sf_number != GLK_SYSF) &&
2605 (sf_number != RANDOM_SYSF) && (j > 1)))
2607 error("System function given with too many arguments");
2609 if (sf_number != RANDOM_SYSF)
2611 i = ET[below].right;
2612 for (jcount = 0; jcount < j; jcount++)
2613 { AI.operand[jcount] = ET[i].value;
2616 AI.operand_count = j;
2624 { assembly_operand AO, AO2;
2628 set_constant_ot(&AO);
2629 INITAOTV(&AO2, CONSTANT_OT, begin_word_array());
2630 AO2.marker = ARRAY_MV;
2632 for (arg_c=0, arg_et = ET[below].right;arg_c<j;
2633 arg_c++, arg_et = ET[arg_et].right)
2634 { if (ET[arg_et].value.type == LOCALVAR_OT
2635 || ET[arg_et].value.type == GLOBALVAR_OT)
2636 error("Only constants can be used as possible 'random' results");
2637 array_entry(arg_c, FALSE, ET[arg_et].value);
2639 finish_array(arg_c, FALSE);
2641 assembleg_2(random_gc, AO, stack_pointer);
2642 assembleg_3(aload_gc, AO2, stack_pointer, Result);
2645 assembleg_2(random_gc,
2646 ET[ET[below].right].value, stack_pointer);
2647 assembleg_3(add_gc, stack_pointer, one_operand,
2653 { assembly_operand AO;
2654 AO = ET[ET[below].right].value;
2655 if (runtime_error_checking_switch)
2656 AO = check_nonzero_at_runtime(AO, -1,
2658 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
2659 assembleg_3(aload_gc, AO, AO2, Result);
2665 { assembly_operand AO;
2666 AO = ET[ET[below].right].value;
2667 if (runtime_error_checking_switch)
2668 AO = check_nonzero_at_runtime(AO, -1,
2669 (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
2670 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
2671 assembleg_3(aload_gc, AO, AO2, Result);
2677 { assembly_operand AO;
2678 AO = ET[ET[below].right].value;
2679 if (runtime_error_checking_switch)
2680 AO = check_nonzero_at_runtime(AO, -1,
2681 (sf_number==SIBLING_SYSF)
2682 ?SIBLING_RTE:YOUNGER_RTE);
2683 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_SIBLING());
2684 assembleg_3(aload_gc, AO, AO2, Result);
2689 { assembly_operand AO;
2690 AO = ET[ET[below].right].value;
2691 if (runtime_error_checking_switch)
2692 AO = check_nonzero_at_runtime(AO, -1,
2694 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
2695 assembleg_store(temp_var1, zero_operand);
2696 assembleg_3(aload_gc, AO, AO2, temp_var2);
2697 AO2.value = GOBJFIELD_SIBLING();
2698 assemble_label_no(next_label);
2699 assembleg_1_branch(jz_gc, temp_var2, next_label+1);
2700 assembleg_3(add_gc, temp_var1, one_operand,
2702 assembleg_3(aload_gc, temp_var2, AO2, temp_var2);
2703 assembleg_0_branch(jump_gc, next_label);
2704 assemble_label_no(next_label+1);
2707 write_result_g(Result, temp_var1);
2712 i = ET[below].right;
2713 check_warn_symbol_type(&ET[i].value, ROUTINE_T, 0, "indirect function call");
2714 goto IndirectFunctionCallG;
2717 AO2 = veneer_routine(Glk__Wrap_VR);
2718 i = ET[below].right;
2719 goto DoFunctionCall;
2721 case METACLASS_SYSF:
2722 assembleg_call_1(veneer_routine(Metaclass_VR),
2723 ET[ET[below].right].value, Result);
2727 AO = ET[ET[below].right].value;
2728 if (runtime_error_checking_switch)
2729 AO = check_nonzero_at_runtime(AO, -1,
2731 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
2732 assembleg_3(aload_gc, AO, AO2, temp_var1);
2733 AO2.value = GOBJFIELD_SIBLING();
2734 assembleg_1_branch(jz_gc, temp_var1, next_label+1);
2735 assemble_label_no(next_label);
2736 assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
2737 assembleg_1_branch(jz_gc, temp_var2, next_label+1);
2738 assembleg_store(temp_var1, temp_var2);
2739 assembleg_0_branch(jump_gc, next_label);
2740 assemble_label_no(next_label+1);
2742 write_result_g(Result, temp_var1);
2747 AO = ET[ET[below].right].value;
2748 if (runtime_error_checking_switch)
2749 AO = check_nonzero_at_runtime(AO, -1,
2751 assembleg_store(temp_var3, AO);
2752 INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
2753 assembleg_3(aload_gc, temp_var3, AO2, temp_var1);
2754 assembleg_1_branch(jz_gc, temp_var1, next_label+2);
2755 AO2.value = GOBJFIELD_CHILD();
2756 assembleg_3(aload_gc, temp_var1, AO2, temp_var1);
2757 assembleg_1_branch(jz_gc, temp_var1, next_label+2);
2758 assembleg_2_branch(jeq_gc, temp_var3, temp_var1,
2760 assemble_label_no(next_label);
2761 AO2.value = GOBJFIELD_SIBLING();
2762 assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
2763 assembleg_2_branch(jeq_gc, temp_var3, temp_var2,
2765 assembleg_store(temp_var1, temp_var2);
2766 assembleg_0_branch(jump_gc, next_label);
2767 assemble_label_no(next_label+1);
2768 assembleg_store(temp_var1, zero_operand);
2769 assemble_label_no(next_label+2);
2771 write_result_g(Result, temp_var1);
2776 error("*** system function not implemented ***");
2783 check_warn_symbol_type(&ET[below].value, ROUTINE_T, 0, "function call");
2786 IndirectFunctionCallG:
2788 /* Get the function address. */
2795 /* If all the function arguments are in local/global
2796 variables, we have to push them all on the stack.
2797 If all of them are on the stack, we have to do nothing.
2798 If some are and some aren't, we have a hopeless mess,
2799 and we should throw a compiler error.
2805 /* begin part of patch G03701 */
2814 assembleg_2(callf_gc, AO2, void_flag ? zero_operand : Result);
2815 } else if (nargs==1) {
2816 assembleg_call_1(AO2, ET[i].value, void_flag ? zero_operand : Result);
2817 } else if (nargs==2) {
2818 assembly_operand o1 = ET[i].value;
2819 assembly_operand o2 = ET[ET[i].right].value;
2820 assembleg_call_2(AO2, o1, o2, void_flag ? zero_operand : Result);
2821 } else if (nargs==3) {
2822 assembly_operand o1 = ET[i].value;
2823 assembly_operand o2 = ET[ET[i].right].value;
2824 assembly_operand o3 = ET[ET[ET[i].right].right].value;
2825 assembleg_call_3(AO2, o1, o2, o3, void_flag ? zero_operand : Result);
2830 if (ET[i].value.type == LOCALVAR_OT
2831 && ET[i].value.value == 0) {
2835 assembleg_store(stack_pointer, ET[i].value);
2842 if (onstack && offstack)
2843 error("*** Function call cannot be generated with mixed arguments ***");
2845 error("*** Function call cannot be generated with more than one nonstack argument ***");
2849 set_constant_ot(&AO);
2852 assembleg_3(call_gc, AO2, AO, zero_operand);
2854 assembleg_3(call_gc, AO2, AO, Result);
2856 } /* else nargs>=4 */
2857 } /* DoFunctionCall: */
2862 printf("** Trouble op = %d i.e. '%s' **\n",
2863 opnum, operators[opnum].description);
2864 compiler_error("Expr code gen: Can't generate yet");
2868 ET[n].value = Result;
2874 if (ET[n].to_expression)
2878 warning("Logical expression has no side-effects");
2879 if (ET[n].true_label != -1)
2880 assemble_label_no(ET[n].true_label);
2882 assemble_label_no(ET[n].false_label);
2884 else if (ET[n].true_label != -1)
2886 donelabel = next_label++;
2887 if (!execution_never_reaches_here) {
2888 assemblez_1(push_zc, zero_operand);
2889 assemblez_jump(donelabel);
2891 assemble_label_no(ET[n].true_label);
2892 assemblez_1(push_zc, one_operand);
2893 assemble_forward_label_no(donelabel);
2897 donelabel = next_label++;
2898 if (!execution_never_reaches_here) {
2899 assemblez_1(push_zc, one_operand);
2900 assemblez_jump(donelabel);
2902 assemble_label_no(ET[n].false_label);
2903 assemblez_1(push_zc, zero_operand);
2904 assemble_forward_label_no(donelabel);
2906 ET[n].value = stack_pointer;
2909 if (ET[n].label_after != -1)
2910 assemble_label_no(ET[n].label_after);
2915 if (ET[n].to_expression)
2919 warning("Logical expression has no side-effects");
2920 if (ET[n].true_label != -1)
2921 assemble_label_no(ET[n].true_label);
2923 assemble_label_no(ET[n].false_label);
2925 else if (ET[n].true_label != -1)
2927 donelabel = next_label++;
2928 if (!execution_never_reaches_here) {
2929 assembleg_store(stack_pointer, zero_operand);
2930 assembleg_jump(donelabel);
2932 assemble_label_no(ET[n].true_label);
2933 assembleg_store(stack_pointer, one_operand);
2934 assemble_forward_label_no(donelabel);
2938 donelabel = next_label++;
2939 if (!execution_never_reaches_here) {
2940 assembleg_store(stack_pointer, one_operand);
2941 assembleg_jump(donelabel);
2943 assemble_label_no(ET[n].false_label);
2944 assembleg_store(stack_pointer, zero_operand);
2945 assemble_forward_label_no(donelabel);
2947 ET[n].value = stack_pointer;
2950 if (ET[n].label_after != -1)
2951 assemble_label_no(ET[n].label_after);
2958 assembly_operand code_generate(assembly_operand AO, int context, int label)
2960 /* Used in three contexts: VOID_CONTEXT, CONDITION_CONTEXT and
2963 If CONDITION_CONTEXT, then compile code branching to label number
2964 "label" if the condition is false: there's no return value.
2965 (Except that if label is -3 or -4 (internal codes for rfalse and
2966 rtrue rather than branch) then this is for branching when the
2967 condition is true. This is used for optimising code generation
2968 for "if" statements.)
2970 Otherwise return the assembly operand containing the result
2971 (probably the stack pointer variable but not necessarily:
2972 e.g. is would be short constant 2 from the expression "j++, 2") */
2976 if (AO.type != EXPRESSION_OT)
2978 { case VOID_CONTEXT:
2979 value_in_void_context(AO);
2980 AO.type = OMITTED_OT;
2983 case CONDITION_CONTEXT:
2985 if (label < -2) assemblez_1_branch(jz_zc, AO, label, FALSE);
2986 else assemblez_1_branch(jz_zc, AO, label, TRUE);
2990 assembleg_1_branch(jnz_gc, AO, label);
2992 assembleg_1_branch(jz_gc, AO, label);
2994 AO.type = OMITTED_OT;
3001 if (expr_trace_level >= 2)
3002 { printf("Raw parse tree:\n"); show_tree(AO, FALSE);
3005 if (context == CONDITION_CONTEXT)
3006 { if (label < -2) annotate_for_conditions(AO.value, label, -1);
3007 else annotate_for_conditions(AO.value, -1, label);
3009 else annotate_for_conditions(AO.value, -1, -1);
3011 if (expr_trace_level >= 1)
3012 { printf("Code generation for expression in ");
3014 { case VOID_CONTEXT: printf("void"); break;
3015 case CONDITION_CONTEXT: printf("condition"); break;
3016 case QUANTITY_CONTEXT: printf("quantity"); break;
3017 case ASSEMBLY_CONTEXT: printf("assembly"); break;
3018 case ARRAY_CONTEXT: printf("array initialisation"); break;
3019 default: printf("* ILLEGAL *"); break;
3021 printf(" context with annotated tree:\n");
3022 show_tree(AO, TRUE);
3025 generate_code_from(AO.value, (context==VOID_CONTEXT));
3026 return ET[AO.value].value;
3029 /* ========================================================================= */
3030 /* Data structure management routines */
3031 /* ------------------------------------------------------------------------- */
3033 extern void init_expressc_vars(void)
3037 extern void expressc_begin_pass(void)
3041 extern void expressc_allocate_arrays(void)
3045 extern void expressc_free_arrays(void)
3049 /* ========================================================================= */