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