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