DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / dsw-obn.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Исправлено обращение к полям при использовании каста. Процедуры INC/DEC больше не...
[dsw-obn.git] / src / backends / jvm / generator-jvm.c
1 #include <stdio.h>
2 #include <stdlib.h>
3 #include <stdarg.h>
4 #include <stdint.h>
5 #include <stdbool.h>
6 #include <string.h>
7 #include <assert.h>
8
9 #include <gc.h>
10
11 #include "../../oberon-internals.h"
12 #include "../../generator.h"
13 #include "generator-jvm.h"
14 #include "generator-jvm-abi.h"
15 #include "generator-jvm-asm.h"
16 #include "generator-jvm-basic.h"
17
18 static void
19 push_item(gen_proc_t * p, oberon_item_t * item);
20
21 static void
22 jvm_generate_new(gen_proc_t * p, oberon_type_t * type, int num);
23
24 static void
25 jvm_generate_cast_prefix(gen_proc_t * p, char prefix, char postfix)
26 {
27 if((prefix == 'b' || prefix == 's') && (postfix = 'l' || postfix == 'd'))
28 {
29 prefix = 'i';
30 }
31
32 if(prefix == postfix)
33 {
34 return;
35 }
36
37 if((prefix == 'l' || prefix == 'd') && (postfix == 'b' || postfix == 's'))
38 {
39 jvm_generate(p, 2, 1, "%c2i", prefix);
40 prefix = 'i';
41 }
42
43 int from_cell_size = jvm_cell_size_for_postfix(prefix);
44 int to_cell_size = jvm_cell_size_for_postfix(postfix);
45 jvm_generate(p, from_cell_size, to_cell_size, "%c2%c", prefix, postfix);
46 }
47
48 static void
49 jvm_generate_cast_type(gen_proc_t * p, oberon_type_t * from, oberon_type_t * to)
50 {
51 if(to -> class == OBERON_TYPE_RECORD || to -> class == OBERON_TYPE_POINTER)
52 {
53 if(to -> class == OBERON_TYPE_POINTER && to -> base -> class == OBERON_TYPE_RECORD)
54 {
55 char * full_name = jvm_get_class_full_name(to);
56 jvm_generate(p, 1, 1, "checkcast %s", full_name);
57 }
58 }
59 else
60 {
61 char prefix = jvm_get_prefix(from);
62 char postfix = jvm_get_postfix(to);
63 jvm_generate_cast_prefix(p, prefix, postfix);
64 }
65 }
66
67 static void
68 jvm_generate_hard_cast_type(gen_proc_t * p, oberon_type_t * from, oberon_type_t * to)
69 {
70 if(from -> class == OBERON_TYPE_REAL
71 && (to -> class == OBERON_TYPE_INTEGER || to -> class == OBERON_TYPE_SYSTEM_BYTE))
72 {
73 char postfix = jvm_get_postfix(to);
74 if(from -> size <= 4)
75 {
76 jvm_generate(p, 1, 1, "invokestatic java/lang/Float/floatToRawIntBits(F)I");
77 jvm_generate_cast_prefix(p, 'i', postfix);
78 }
79 else
80 {
81 jvm_generate(p, 2, 2, "invokestatic java/lang/Double/doubleToRawIntBits(D)J");
82 jvm_generate_cast_prefix(p, 'l', postfix);
83 }
84 }
85 else if((from -> class == OBERON_TYPE_INTEGER || from -> class == OBERON_TYPE_SYSTEM_BYTE)
86 && to -> class == OBERON_TYPE_REAL)
87 {
88 char prefix = jvm_get_prefix(from);
89 if(to -> size <= 4)
90 {
91 jvm_generate_cast_prefix(p, prefix, 'i');
92 jvm_generate(p, 1, 1, "invokestatic java/lang/Float/intBitsToFloat(I)F");
93 }
94 else
95 {
96 jvm_generate_cast_prefix(p, prefix, 'l');
97 jvm_generate(p, 2, 2, "invokestatic java/lang/Double/longBitsToDouble(J)D");
98 }
99 }
100 else
101 {
102 jvm_generate_cast_type(p, from, to);
103 }
104 }
105
106 static void
107 check_index(gen_proc_t * p, oberon_type_t * index_type)
108 {
109 // TODO проверка валидности границ
110 char prefix = jvm_get_prefix(index_type);
111 jvm_generate_cast_prefix(p, prefix, 'i');
112 }
113
114 /*
115 * Генерирует код для инициализации массива со статическим базовым типом
116 * ( aref -- )
117 */
118
119 static void
120 jvm_generate_array_initialization(gen_proc_t * p, oberon_type_t * arr)
121 {
122 int dim = 0;
123 oberon_type_t * base = arr;
124 while(base -> class == OBERON_TYPE_ARRAY)
125 {
126 dim += 1;
127 base = base -> base;
128 }
129
130 if(base -> class != OBERON_TYPE_RECORD)
131 {
132 jvm_generate(p, 1, 0, "pop");
133 return;
134 }
135
136 struct {
137 int reg_index;
138 int reg_length;
139 int start;
140 int end;
141 } loop[dim];
142
143 int reg_dst;
144 reg_dst = jvm_alloc_register_untyped(p -> rf, false);
145 jvm_generate(p, 1, 0, "astore %i", reg_dst);
146
147 /*
148 * Входящие параметры заграблены.
149 * Теперь генерируем эквивалентный код:
150 * int i = 0;
151 * int len = dst.length
152 * while(i < len)
153 * {
154 * ...
155 * {
156 * dst[i, ...] = new record;
157 * }
158 * ...
159 * i += 1;
160 * }
161 * Где "..." такой же код (начало и конец) для следующей размерности.
162 */
163
164 for(int i = 0; i < dim; i++)
165 {
166 loop[i].reg_index = jvm_alloc_register_untyped(p -> rf, false);
167 loop[i].reg_length = jvm_alloc_register_untyped(p -> rf, false);
168 loop[i].start = jvm_new_label_id(p);
169 loop[i].end = jvm_new_label_id(p);
170
171 jvm_generate(p, 0, 1, "iconst_0");
172 jvm_generate(p, 1, 0, "istore %i", loop[i].reg_index);
173
174 jvm_generate(p, 0, 1, "aload %i", reg_dst);
175 jvm_generate(p, 1, 1, "arraylength");
176 jvm_generate(p, 1, 0, "istore %i", loop[i].reg_length);
177
178 /* if(i >= len) goto end; */
179 jvm_generate_label(p, loop[i].start);
180 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_index);
181 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_length);
182 jvm_generate(p, 2, 0, "if_icmpge L%i", loop[i].end);
183 }
184
185 jvm_generate(p, 0, 1, "aload %i", reg_dst);
186 jvm_generate(p, 0, 1, "iload %i", loop[0].reg_index);
187 for(int i = 1; i < dim; i++)
188 {
189 jvm_generate(p, 2, 1, "aaload");
190 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_index);
191 }
192 jvm_generate_new(p, base, 0);
193 jvm_generate(p, 3, 0, "aastore");
194
195 for(int i = dim - 1; i >= 0; i--)
196 {
197 jvm_generate(p, 0, 0, "iinc %i 1", loop[i].reg_index);
198 jvm_generate(p, 0, 0, "goto L%i", loop[i].start);
199 jvm_generate_label(p, loop[i].end);
200 }
201 }
202
203 static void
204 jvm_generate_new(gen_proc_t * p, oberon_type_t * type, int num)
205 {
206 int dim;
207 char * cname;
208 char * desc;
209 oberon_type_t * base;
210
211 switch(type -> class)
212 {
213 case OBERON_TYPE_INTEGER:
214 case OBERON_TYPE_BOOLEAN:
215 case OBERON_TYPE_PROCEDURE:
216 case OBERON_TYPE_REAL:
217 case OBERON_TYPE_POINTER:
218 gen_error("jvm_generate_new_static: static alocation not allowed");
219 break;
220 case OBERON_TYPE_RECORD:
221 assert(num == 0);
222 cname = jvm_get_class_full_name(type);
223 jvm_generate(p, 0, 1, "new %s", cname);
224 jvm_generate(p, 1, 2, "dup");
225 jvm_generate(p, 1, 0, "invokespecial %s/<init>()V", cname);
226 break;
227 case OBERON_TYPE_ARRAY:
228 dim = 0;
229 base = type;
230 desc = jvm_get_descriptor(type);
231 while(base -> class == OBERON_TYPE_ARRAY)
232 {
233 if(num > 0)
234 {
235 assert(base -> size == 0);
236 num -= 1;
237 }
238 else
239 {
240 assert(base -> size > 0);
241 jvm_generate_push_int(p, base -> size);
242 }
243 dim += 1;
244 base = base -> base;
245 }
246
247 assert(num == 0);
248 jvm_generate(p, dim, 1, "multianewarray %s %i", desc, dim);
249 jvm_generate(p, 1, 2, "dup");
250 jvm_generate_array_initialization(p, type);
251 break;
252 default:
253 gen_error("jvm_generate_new_static: unk type class %i", type -> class);
254 break;
255 }
256 }
257
258 /*
259 * Генерирует код для копирования полей из первой записи во вторую.
260 * ( aref_dst aref_src -- )
261 * dst := src;
262 */
263
264 static void
265 jvm_generate_copy_record(gen_proc_t * p, oberon_type_t * rec)
266 {
267 assert(rec -> class == OBERON_TYPE_RECORD);
268 char * desc = jvm_get_descriptor(rec);
269 char * cname = jvm_get_class_full_name(rec);
270 jvm_generate(p, 1 + 1, 0, "invokestatic %s/$COPY$(%s%s)V", cname, desc, desc);
271 }
272
273 /*
274 * Генерирует кода для копирования массивов.
275 * ( aref_dst aref_src -- )
276 * dst := src;
277 */
278
279 static void
280 jvm_generate_copy_array(gen_proc_t * p, oberon_type_t * arr)
281 {
282 int dim = 0;
283 oberon_type_t * base = arr;
284 while(base -> class == OBERON_TYPE_ARRAY)
285 {
286 dim += 1;
287 base = base -> base;
288 }
289
290 struct {
291 int reg_index;
292 int reg_length;
293 int start;
294 int end;
295 } loop[dim];
296
297 int reg_dst = jvm_alloc_register_untyped(p -> rf, false);
298 int reg_src = jvm_alloc_register_untyped(p -> rf, false);
299 jvm_generate(p, 1, 0, "astore %i", reg_src);
300 jvm_generate(p, 1, 0, "astore %i", reg_dst);
301
302 /*
303 * Входящие параметры заграблены.
304 * Теперь генерируем эквивалентный код:
305 * int i = 0;
306 * int len = src.length
307 * while(i < len)
308 * {
309 * ...
310 * {
311 * copy from src[i, ...] to dst[i, ...];
312 * }
313 * ...
314 * i += 1;
315 * }
316 * Где "..." такой же код (начало и конец) для следующей размерности.
317 */
318
319 for(int i = 0; i < dim; i++)
320 {
321 loop[i].reg_index = jvm_alloc_register_untyped(p -> rf, false);
322 loop[i].reg_length = jvm_alloc_register_untyped(p -> rf, false);
323 loop[i].start = jvm_new_label_id(p);
324 loop[i].end = jvm_new_label_id(p);
325
326 jvm_generate(p, 0, 1, "iconst_0");
327 jvm_generate(p, 1, 0, "istore %i", loop[i].reg_index);
328
329 jvm_generate(p, 0, 1, "aload %i", reg_src);
330 jvm_generate(p, 1, 1, "arraylength");
331 jvm_generate(p, 1, 0, "istore %i", loop[i].reg_length);
332
333 /* if(i >= len) goto end; */
334 jvm_generate_label(p, loop[i].start);
335 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_index);
336 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_length);
337 jvm_generate(p, 2, 0, "if_icmpge L%i", loop[i].end);
338 }
339
340 if(base -> class == OBERON_TYPE_RECORD)
341 {
342 /* Получаем записи по индексам ( -- dst src ) */
343
344 jvm_generate(p, 0, 1, "aload %i", reg_dst);
345 for(int i = 0; i < dim; i++)
346 {
347 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_index);
348 jvm_generate(p, 2, 1, "aaload");
349 }
350
351 jvm_generate(p, 0, 1, "aload %i", reg_src);
352 for(int i = 0; i < dim; i++)
353 {
354 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_index);
355 jvm_generate(p, 2, 1, "aaload");
356 }
357
358 /* Копируем записи ( dst src -- ) */
359 jvm_generate_copy_record(p, base);
360 }
361 else
362 {
363 char postfix = jvm_get_postfix(base);
364 int cell_size = jvm_cell_size_for_postfix(postfix);
365
366 /* Получаем массивы и индексы ( -- dst i src i ) */
367
368 jvm_generate(p, 0, 1, "aload %i", reg_dst);
369 jvm_generate(p, 0, 1, "iload %i", loop[0].reg_index);
370 for(int i = 1; i < dim; i++)
371 {
372 jvm_generate(p, 2, 1, "aaload");
373 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_index);
374 }
375
376 jvm_generate(p, 0, 1, "aload %i", reg_src);
377 jvm_generate(p, 0, 1, "iload %i", loop[0].reg_index);
378 for(int i = 1; i < dim; i++)
379 {
380 jvm_generate(p, 2, 1, "aaload");
381 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_index);
382 }
383
384 /* Копируем значения ( dst i src i -- ) */
385 jvm_generate(p, 2, cell_size, "%caload", postfix);
386 jvm_generate(p, 2 + cell_size, 0, "%castore", postfix);
387 }
388
389 for(int i = dim - 1; i >= 0; i--)
390 {
391 jvm_generate(p, 0, 0, "iinc %i 1", loop[i].reg_index);
392 jvm_generate(p, 0, 0, "goto L%i", loop[i].start);
393 jvm_generate_label(p, loop[i].end);
394 }
395 }
396
397 static void
398 jvm_generate_push_procedure_pointer(gen_proc_t * p, oberon_object_t * proc)
399 {
400 char * full_name = jvm_get_field_full_name_safe(proc);
401 char * desc = jvm_get_descriptor(proc -> type);
402 jvm_generate(p, 0, 1, "getstatic %s/pointer %s", full_name, desc);
403 }
404
405 void
406 oberon_generator_init_context(oberon_context_t * ctx)
407 {
408 gen_context_t * gen_context = GC_MALLOC(sizeof *gen_context);
409 memset(gen_context, 0, sizeof *gen_context);
410
411 ctx -> gen_context = gen_context;
412 gen_context -> dir = ".";
413 }
414
415 void
416 oberon_generator_destroy_context(oberon_context_t * ctx)
417 {
418 }
419
420 static void
421 oberon_generate_procedure_class(const char * dir, oberon_type_t * proc)
422 {
423 FILE * fp;
424 char * cname;
425 char * signature;
426 struct gen_class * class;
427
428 cname = jvm_get_class_full_name(proc);
429 class = jvm_create_class(dir, cname);
430 fp = class -> fp;
431
432 fprintf(fp, ".source SYSTEM\n");
433 fprintf(fp, ".class public abstract %s\n", cname);
434 fprintf(fp, ".super java/lang/Object\n\n");
435
436 fprintf(fp, ".method <init>()V\n");
437 fprintf(fp, " aload_0\n");
438 fprintf(fp, " invokespecial java/lang/Object/<init>()V\n");
439 fprintf(fp, " return\n");
440 fprintf(fp, ".end method\n\n");
441
442 signature = jvm_get_procedure_signature(proc);
443
444 fprintf(fp, ".method public abstract invoke%s\n", signature);
445 fprintf(fp, ".end method\n\n");
446
447 jvm_destroy_class(class);
448 }
449
450 static void
451 oberon_generate_procedure_pointer_class(const char * dir, oberon_object_t * proc)
452 {
453 FILE * fp;
454 char * cname;
455 char * abscname;
456 char * absdesc;
457 char * signature;
458 struct gen_class * class;
459
460 cname = jvm_get_field_full_name_safe(proc);
461 class = jvm_create_class(dir, cname);
462 abscname = jvm_get_class_full_name(proc -> type);
463 absdesc = jvm_get_descriptor(proc -> type);
464 fp = class -> fp;
465
466 fprintf(fp, ".source %s\n", proc -> module -> name);
467 fprintf(fp, ".class public %s\n", cname);
468 fprintf(fp, ".super %s\n\n", abscname);
469
470 fprintf(fp, ".field public static pointer %s\n\n", absdesc);
471
472 fprintf(fp, ".method private <init>()V\n");
473 fprintf(fp, " aload_0\n");
474 fprintf(fp, " invokespecial %s/<init>()V\n", abscname);
475 fprintf(fp, " return\n");
476 fprintf(fp, ".end method\n\n");
477
478 fprintf(fp, ".method static <clinit>()V\n");
479 fprintf(fp, " .limit stack 2\n");
480 fprintf(fp, " new %s\n", cname);
481 fprintf(fp, " dup\n");
482 fprintf(fp, " invokespecial %s/<init>()V\n", cname);
483 fprintf(fp, " putstatic %s/pointer %s\n", cname, absdesc);
484 fprintf(fp, " return\n");
485 fprintf(fp, ".end method\n\n");
486
487 signature = jvm_get_procedure_signature(proc -> type);
488
489 gen_proc_t * p = jvm_create_proc(class);
490 jvm_generate_function_header(p, "public", "invoke", signature);
491 jvm_alloc_register_untyped(p -> rf, false);
492
493 int use_size = 0;
494 int num = proc -> type -> num_decl;
495 oberon_object_t * param = proc -> type -> decl;
496 for(int i = 0; i < num; i++)
497 {
498 gen_type_t * t = param -> type -> gen_type;
499 if(param -> class == OBERON_CLASS_VAR_PARAM)
500 {
501 int reg = jvm_alloc_register_untyped(p -> rf, true);
502 jvm_generate(p, 0, 1, "aload %i", reg);
503 jvm_generate(p, 0, 1, "iload %i", reg + 1);
504 }
505 else
506 {
507 int reg = jvm_alloc_register_untyped(p -> rf, t -> wide);
508 jvm_generate(p, 0, t -> cell_size, "%cload %i", t -> prefix, reg);
509 }
510 use_size += t -> cell_size;
511 param = param -> next;
512 }
513
514 char * full_name = jvm_get_field_full_name(proc);
515 int cell_size = jvm_cell_size_for_type(proc -> type -> base);
516 jvm_generate(p, use_size, cell_size, "invokestatic %s%s", full_name, signature);
517
518 if(proc -> type -> base -> class == OBERON_TYPE_NOTYPE)
519 {
520 jvm_generate(p, 0, 0, "return");
521 }
522 else
523 {
524 char prefix = jvm_get_prefix(proc -> type -> base);
525 jvm_generate(p, cell_size, 0, "%creturn", prefix);
526 }
527
528 jvm_generate_function_end(p);
529
530 jvm_destroy_class(class);
531 }
532
533 static void
534 oberon_generate_record_class(const char * dir, gen_module_t * m, oberon_type_t * rec)
535 {
536 char * cname;
537 struct gen_class * class;
538
539 /* Устанавливаем новоый id */
540 rec -> gen_type -> rec_id = m -> rec_id;
541 m -> rec_id += 1;
542
543 cname = jvm_get_class_full_name(rec);
544 class = jvm_create_class(dir, cname);
545
546 fprintf(class -> fp, ".source %s\n", rec -> module -> name);
547 fprintf(class -> fp, ".class public %s\n", cname);
548
549 if(rec -> base == NULL)
550 {
551 fprintf(class -> fp, ".super java/lang/Object\n\n");
552 }
553 else
554 {
555 class -> base = rec -> base -> gen_type -> class;
556 fprintf(class -> fp, ".super %s\n\n", class -> base -> full_name);
557 }
558
559 rec -> gen_type -> class = class;
560 }
561
562 void
563 oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type)
564 {
565 gen_type_t * t = GC_MALLOC(sizeof *t);
566 memset(t, 0, sizeof *t);
567 type -> gen_type = t;
568
569 gen_context_t * c;
570 c = ctx -> gen_context;
571
572 gen_module_t * m;
573 switch(type -> class)
574 {
575 case OBERON_TYPE_NOTYPE:
576 case OBERON_TYPE_INTEGER:
577 case OBERON_TYPE_BOOLEAN:
578 case OBERON_TYPE_ARRAY:
579 case OBERON_TYPE_POINTER:
580 case OBERON_TYPE_REAL:
581 case OBERON_TYPE_CHAR:
582 case OBERON_TYPE_STRING:
583 case OBERON_TYPE_SET:
584 case OBERON_TYPE_NIL:
585 case OBERON_TYPE_SYSTEM_BYTE:
586 case OBERON_TYPE_SYSTEM_PTR:
587 break;
588 case OBERON_TYPE_RECORD:
589 m = type -> module -> gen_mod;
590 oberon_generate_record_class(c -> dir, m, type);
591 break;
592 case OBERON_TYPE_PROCEDURE:
593 oberon_generate_procedure_class(c -> dir, type);
594 break;
595 default:
596 gen_error("oberon_generator_init_type: unk calss %i", type -> class);
597 break;
598 }
599
600 if(type -> class != OBERON_TYPE_NOTYPE)
601 {
602 t -> wide = jvm_is_wide_type(type);
603 t -> prefix = jvm_get_prefix(type);
604 t -> postfix = jvm_get_postfix(type);
605 }
606
607 t -> cell_size = jvm_cell_size_for_type(type);
608
609 if(type -> class != OBERON_TYPE_NIL)
610 {
611 t -> desc = jvm_get_descriptor(type);
612 }
613 }
614
615 void
616 oberon_generator_init_record(oberon_context_t * ctx, oberon_type_t * rec)
617 {
618 struct gen_class * class;
619 class = rec -> gen_type -> class;
620
621 int num = rec -> num_decl;
622 oberon_object_t * field = rec -> decl;
623 for(int i = 0; i < num; i++)
624 {
625 jvm_generate_var(field -> gen_var);
626 field = field -> next;
627 }
628
629 /* Стандартный конструктор класса */
630 /* Инициализирует внутренние статические записи и массивы */
631 gen_proc_t * p = jvm_create_proc(class);
632 jvm_generate_function_header(p, "public", "<init>", "()V");
633 jvm_alloc_register_untyped(p -> rf, false);
634 jvm_generate(p, 0, 1, "aload_0");
635 if(class -> base)
636 {
637 jvm_generate(p, 1, 0, "invokespecial %s/<init>()V", class -> base -> full_name);
638 }
639 else
640 {
641 jvm_generate(p, 1, 0, "invokespecial java/lang/Object/<init>()V");
642 }
643 num = rec -> num_decl;
644 field = rec -> decl;
645 for(int i = 0; i < num; i++)
646 {
647 jvm_generate(p, 0, 1, "aload_0");
648 jvm_generate_var_initialization(p, field -> gen_var);
649
650 if(field -> type -> class == OBERON_TYPE_RECORD
651 || field -> type -> class == OBERON_TYPE_ARRAY)
652 {
653 jvm_generate(p, 0, 1, "aload_0");
654 jvm_generate_ldst_prepare(p, field -> gen_var);
655 jvm_generate_new(p, field -> type, 0);
656 jvm_generate_store(p, field -> gen_var);
657 }
658 field = field -> next;
659 }
660 jvm_generate(p, 0, 0, "return");
661 jvm_generate_function_end(p);
662
663 /* Метод для копирования полей класса */
664 /* reg0 == src -> reg1 == dst */
665 p = jvm_create_proc(class);
666 char * signature = new_string("(%s%s)V", rec -> gen_type -> desc, rec -> gen_type -> desc);
667 jvm_generate_function_header(p, "public static", "$COPY$", signature);
668
669 gen_var_t * copy_dst = jvm_create_function_var(p, JVM_STORAGE_REGISTER, "dst", rec -> gen_type);
670 gen_var_t * copy_src = jvm_create_function_var(p, JVM_STORAGE_REGISTER, "src", rec -> gen_type);
671 jvm_generate_var(copy_dst);
672 jvm_generate_var(copy_src);
673 jvm_generate_var_initialization(p, copy_dst);
674 jvm_generate_var_initialization(p, copy_src);
675
676 if(rec -> base)
677 {
678 jvm_generate_load(p, copy_dst);
679 jvm_generate_load(p, copy_src);
680 jvm_generate_copy_record(p, rec -> base);
681 }
682
683 num = rec -> num_decl;
684 field = rec -> decl;
685 for(int i = 0; i < num; i++)
686 {
687 if(field -> type -> class == OBERON_TYPE_RECORD)
688 {
689 jvm_generate_load(p, copy_dst);
690 jvm_generate_load(p, field -> gen_var);
691 jvm_generate_load(p, copy_src);
692 jvm_generate_load(p, field -> gen_var);
693 jvm_generate_copy_record(p, field -> type);
694 }
695 else if(field -> type -> class == OBERON_TYPE_ARRAY)
696 {
697 jvm_generate_load(p, copy_dst);
698 jvm_generate_load(p, field -> gen_var);
699 jvm_generate_load(p, copy_src);
700 jvm_generate_load(p, field -> gen_var);
701 jvm_generate_copy_array(p, field -> type);
702 }
703 else
704 {
705 jvm_generate_load(p, copy_dst);
706 jvm_generate_ldst_prepare(p, field -> gen_var);
707 jvm_generate_load(p, copy_src);
708 jvm_generate_load(p, field -> gen_var);
709 jvm_generate_store(p, field -> gen_var);
710 }
711 field = field -> next;
712 }
713 jvm_generate(p, 0, 0, "return");
714 jvm_generate_function_end(p);
715
716 jvm_destroy_class(class);
717 }
718
719 void
720 oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var)
721 {
722 gen_module_t * m;
723 m = ctx -> mod -> gen_mod;
724
725 struct gen_class * class;
726 class = m -> class;
727
728 gen_proc_t * p;
729 struct gen_class * c;
730 char * name = var -> name;
731 gen_type_t * t = var -> type -> gen_type;
732
733 assert(name);
734 if(t == NULL)
735 {
736 gen_error("uninitialized type class %i", var -> type -> class);
737 }
738
739 switch(var -> class)
740 {
741 case OBERON_CLASS_VAR_PARAM:
742 p = var -> parent -> gen_proc;
743 var -> gen_var = jvm_create_function_var(p, JVM_STORAGE_FRAME_PARAM_VARPTR, name, t);
744 break;
745 case OBERON_CLASS_PARAM:
746 p = var -> parent -> gen_proc;
747 var -> gen_var = jvm_create_function_var(p, JVM_STORAGE_FRAME_PARAM_VAR, name, t);
748 break;
749 case OBERON_CLASS_FIELD:
750 c = var -> parent_type -> gen_type -> class;
751 var -> gen_var = jvm_create_class_var(c, JVM_STORAGE_FIELD_VAR, name, t);
752 break;
753 case OBERON_CLASS_VAR:
754 if(var -> local)
755 {
756 p = var -> parent -> gen_proc;
757 var -> gen_var = jvm_create_function_var(p, JVM_STORAGE_FRAME_VAR, name, t);
758 }
759 else
760 {
761 var -> gen_var = jvm_create_class_var(class, JVM_STORAGE_STATIC_VAR, name, t);
762 jvm_generate_var(var -> gen_var);
763 }
764 break;
765 default:
766 gen_error("oberon_generator_init_var: unk var class %i", var -> class);
767 break;
768 }
769 }
770
771 void
772 oberon_generator_init_temp_var(oberon_context_t * ctx, oberon_object_t * var)
773 {
774 assert(var -> class == OBERON_CLASS_VAR);
775
776 gen_module_t * m;
777 m = ctx -> mod -> gen_mod;
778
779 gen_proc_t * p;
780 p = m -> class -> p;
781
782 gen_type_t * t;
783 t = var -> type -> gen_type;
784
785 var -> gen_var = jvm_create_function_temp_var(p, t);
786 jvm_generate_var(var -> gen_var);
787 jvm_generate_var_initialization(p, var -> gen_var);
788 }
789
790 void
791 oberon_generator_init_proc(oberon_context_t * ctx, oberon_object_t * proc)
792 {
793 struct gen_class * class = proc -> module -> gen_mod -> class;
794 proc -> gen_proc = jvm_create_proc(class);
795 proc -> gen_proc -> full_name = jvm_get_field_full_name_safe(proc);
796 jvm_create_static_links(proc);
797 }
798
799 void
800 oberon_generator_init_module(oberon_context_t * ctx, oberon_module_t * mod)
801 {
802 gen_module_t * m = GC_MALLOC(sizeof *m);
803 memset(m, 0, sizeof *m);
804 mod -> gen_mod = m;
805
806 gen_context_t * c;
807 c = ctx -> gen_context;
808
809 struct gen_class * class;
810 class = jvm_create_class(c -> dir, mod -> name);
811
812 fprintf(class -> fp, ".source %s\n", mod -> name);
813 fprintf(class -> fp, ".class %s\n", mod -> name);
814 fprintf(class -> fp, ".super java/lang/Object\n\n");
815
816 fprintf(class -> fp, ".field private static $INITIALIZED$ Z\n\n");
817
818 m -> class = class;
819
820 c -> current_m = m;
821 }
822
823 void
824 oberon_generator_fini_module(oberon_module_t * mod)
825 {
826 jvm_destroy_class(mod -> gen_mod -> class);
827 }
828
829 static void
830 push_expr(gen_proc_t * p, oberon_expr_t * expr);
831
832 static void
833 oberon_generate_static_initialization(gen_proc_t * p, oberon_object_t * x)
834 {
835 if(x -> type -> class == OBERON_TYPE_ARRAY
836 || x -> type -> class == OBERON_TYPE_RECORD)
837 {
838 jvm_generate_ldst_prepare(p, x -> gen_var);
839 jvm_generate_new(p, x -> type, 0);
840 jvm_generate_store(p, x -> gen_var);
841 }
842 }
843
844 void
845 oberon_generate_begin_module(oberon_context_t * ctx)
846 {
847 gen_proc_t * p;
848 int label_cont;
849 struct gen_class * class;
850
851 class = ctx -> mod -> gen_mod -> class;
852
853 p = jvm_create_proc(class);
854 jvm_generate_function_header(p, "public static", "BEGIN", "()V");
855
856 label_cont = jvm_new_label_id(p);
857 jvm_generate(p, 0, 1, "getstatic %s/$INITIALIZED$ Z", class -> full_name);
858 jvm_generate(p, 1, 0, "ifeq L%i", label_cont);
859 jvm_generate(p, 0, 0, "return");
860 jvm_generate_label(p, label_cont);
861
862 jvm_generate(p, 0, 1, "iconst_1");
863 jvm_generate(p, 1, 0, "putstatic %s/$INITIALIZED$ Z", class -> full_name);
864
865 /* Инициализация переменных объявленных в модуле */
866 oberon_object_t * x = ctx -> mod -> decl -> list -> next;
867 while(x != NULL)
868 {
869 if(x -> class == OBERON_CLASS_MODULE)
870 {
871 if(!x -> module -> intrinsic)
872 {
873 jvm_generate(p, 0, 0, "invokestatic %s/BEGIN()V", x -> module -> gen_mod -> class -> full_name);
874 }
875 }
876 else if(x -> class == OBERON_CLASS_VAR)
877 {
878 jvm_generate_var_initialization(p, x -> gen_var);
879 oberon_generate_static_initialization(p, x);
880 }
881
882 x = x -> next;
883 }
884 }
885
886 void
887 oberon_generate_end_module(oberon_context_t * ctx)
888 {
889 struct gen_class * class = ctx -> mod -> gen_mod -> class;
890 gen_proc_t * p = class -> p;
891
892 jvm_generate(p, 0, 0, "return");
893 jvm_generate_function_end(class -> p);
894
895 p = jvm_create_proc(class);
896 jvm_generate_function_header(p, "private", "<init>", "()V");
897 jvm_alloc_register_untyped(p -> rf, false);
898 jvm_generate(p, 0, 1, "aload_0");
899 jvm_generate(p, 1, 0, "invokespecial java/lang/Object/<init>()V");
900 jvm_generate(p, 0, 0, "return");
901 jvm_generate_function_end(class -> p);
902 }
903
904 /*
905 * Генерирует код для получения размера измерения массива
906 * Аналог Обероновского LEN(v, n); где n = 0 - первое измерение.
907 * ( aref -- int )
908 */
909
910 static void
911 jvm_generate_array_len(gen_proc_t * p, int dim)
912 {
913 while(dim > 0)
914 {
915 jvm_generate(p, 0, 1, "iconst_0");
916 jvm_generate(p, 2, 1, "aaload");
917 dim -= 1;
918 }
919 jvm_generate(p, 1, 1, "arraylength");
920 }
921
922 static void
923 jvm_generate_array_duplicate_and_replace(gen_proc_t * p, gen_var_t * v, oberon_type_t * arr)
924 {
925 jvm_generate_ldst_prepare(p, v);
926
927 int dim = 0;
928 oberon_type_t * base = arr;
929 while(base -> class == OBERON_TYPE_ARRAY)
930 {
931 if(base -> size == 0)
932 {
933 jvm_generate_load(p, v);
934 jvm_generate_array_len(p, dim);
935 dim += 1;
936 }
937 base = base -> base;
938 }
939
940 jvm_generate_new(p, arr, dim);
941 jvm_generate(p, 1, 2, "dup");
942 jvm_generate_load(p, v);
943 jvm_generate_copy_array(p, arr);
944 jvm_generate_store(p, v);
945 }
946
947 static void
948 jvm_generate_record_duplicate_and_replace(gen_proc_t * p, gen_var_t * v, oberon_type_t * rec)
949 {
950 jvm_generate_ldst_prepare(p, v);
951 jvm_generate_new(p, rec, 0);
952 jvm_generate(p, 1, 2, "dup");
953 jvm_generate_load(p, v);
954 jvm_generate_copy_record(p, rec);
955 jvm_generate_store(p, v);
956 }
957
958 static void
959 jvm_generate_local_object(gen_proc_t * p, oberon_object_t * x)
960 {
961 gen_var_t * v;
962 struct gen_class * class;
963
964 v = x -> gen_var;
965 class = p -> class;
966
967 // Убеждаемся что сейчас находимся в функции
968 assert(class -> p);
969 assert(x -> local);
970
971 switch(x -> class)
972 {
973 case OBERON_CLASS_VAR_PARAM:
974 case OBERON_CLASS_PARAM:
975 case OBERON_CLASS_VAR:
976 jvm_generate_var(v);
977 break;
978 case OBERON_CLASS_CONST:
979 case OBERON_CLASS_TYPE:
980 case OBERON_CLASS_PROC:
981 break;
982 default:
983 gen_error("jvm_generate_local_initialization: wat class %i", x -> class);
984 break;
985 }
986 }
987
988 static void
989 jvm_generate_local_initialization(gen_proc_t * p, oberon_object_t * x)
990 {
991 gen_var_t * v;
992 struct gen_class * class;
993
994 v = x -> gen_var;
995 class = p -> class;
996
997 // Убеждаемся что сейчас находимся в функции
998 assert(class -> p);
999 assert(x -> local);
1000
1001 switch(x -> class)
1002 {
1003 case OBERON_CLASS_VAR_PARAM:
1004 jvm_generate_var_initialization(p, v);
1005 break;
1006 case OBERON_CLASS_PARAM:
1007 jvm_generate_var_initialization(p, v);
1008 if(x -> type -> class == OBERON_TYPE_ARRAY)
1009 {
1010 jvm_generate_array_duplicate_and_replace(p, v, x -> type);
1011 }
1012 else if(x -> type -> class == OBERON_TYPE_RECORD)
1013 {
1014 jvm_generate_record_duplicate_and_replace(p, v, x -> type);
1015 }
1016 break;
1017 case OBERON_CLASS_VAR:
1018 jvm_generate_var_initialization(p, v);
1019 oberon_generate_static_initialization(p, x);
1020 break;
1021 case OBERON_CLASS_CONST:
1022 case OBERON_CLASS_TYPE:
1023 case OBERON_CLASS_PROC:
1024 break;
1025 default:
1026 gen_error("jvm_generate_local_initialization: wat class %i", x -> class);
1027 break;
1028 }
1029 }
1030
1031 void
1032 oberon_generate_begin_proc(oberon_context_t * ctx, oberon_object_t * proc)
1033 {
1034 gen_proc_t * p;
1035 char * name;
1036 char * signature;
1037 oberon_object_t * var;
1038
1039 p = proc -> gen_proc;
1040
1041 if(proc -> local)
1042 {
1043 signature = jvm_get_local_procedure_signature(proc);
1044 }
1045 else
1046 {
1047 oberon_generate_procedure_pointer_class(p -> class -> dir, proc);
1048 signature = jvm_get_procedure_signature(proc -> type);
1049 }
1050
1051 name = jvm_get_name(proc);
1052 jvm_generate_function_header(p, "public static", name, signature);
1053
1054 if(proc -> local)
1055 {
1056 jvm_generate_staticlinks(proc);
1057 }
1058
1059 jvm_generate_procedure_frame(proc);
1060
1061 /* Создание параметров и переменных */
1062 var = proc -> scope -> list -> next;
1063 while(var)
1064 {
1065 jvm_generate_local_object(p, var);
1066 var = var -> next;
1067 }
1068
1069 jvm_generate_frame_initialization(p);
1070
1071 /* Инициализация парамеров и переменных */
1072 var = proc -> scope -> list -> next;
1073 while(var)
1074 {
1075 jvm_generate_local_initialization(p, var);
1076 var = var -> next;
1077 }
1078 }
1079
1080 void
1081 oberon_generate_end_proc(oberon_context_t * ctx)
1082 {
1083 gen_module_t * m;
1084 gen_proc_t * p;
1085
1086 m = ctx -> mod -> gen_mod;
1087 p = m -> class -> p;
1088
1089 oberon_generate_trap(ctx, -4);
1090 jvm_generate_function_end(p);
1091 }
1092
1093 gen_label_t *
1094 oberon_generator_reserve_label(oberon_context_t * ctx)
1095 {
1096 gen_module_t * m;
1097 gen_proc_t * p;
1098 gen_label_t * l;
1099
1100 m = ctx -> mod -> gen_mod;
1101 p = m -> class -> p;
1102
1103 l = GC_MALLOC(sizeof *l);
1104 memset(l, 0, sizeof *l);
1105
1106 l -> id = jvm_new_label_id(p);
1107 return l;
1108 }
1109
1110 void
1111 oberon_generate_label(oberon_context_t * ctx, gen_label_t * l)
1112 {
1113 gen_module_t * m;
1114 gen_proc_t * p;
1115
1116 m = ctx -> mod -> gen_mod;
1117 p = m -> class -> p;
1118
1119 jvm_generate_label(p, l -> id);
1120 }
1121
1122 void
1123 oberon_generate_goto(oberon_context_t * ctx, gen_label_t * l)
1124 {
1125 gen_module_t * m;
1126 gen_proc_t * p;
1127
1128 m = ctx -> mod -> gen_mod;
1129 p = m -> class -> p;
1130
1131 jvm_generate(p, 0, 0, "goto L%i", l -> id);
1132 }
1133
1134 void
1135 oberon_generate_branch(oberon_context_t * ctx, oberon_expr_t * cond, bool gotoif, gen_label_t * l)
1136 {
1137 gen_module_t * m;
1138 gen_proc_t * p;
1139
1140 m = ctx -> mod -> gen_mod;
1141 p = m -> class -> p;
1142
1143 push_expr(p, cond);
1144
1145 if(gotoif == false)
1146 {
1147 /* переход если false */
1148 jvm_generate(p, 1, 0, "ifeq L%i", l -> id);
1149 }
1150 else
1151 {
1152 /* переход если true */
1153 jvm_generate(p, 1, 0, "ifne L%i", l -> id);
1154 }
1155 }
1156
1157 static void
1158 push_varptr(gen_proc_t * p, oberon_expr_t * expr)
1159 {
1160 assert(expr -> is_item);
1161
1162 switch(expr -> item.mode)
1163 {
1164 case MODE_VAR:
1165 jvm_generate_ldst_prepare(p, expr -> item.var -> gen_var);
1166 break;
1167 case MODE_INDEX:
1168 push_item(p, expr -> item.parent);
1169 push_expr(p, expr -> item.args);
1170 check_index(p, expr -> item.args -> result);
1171 break;
1172 case MODE_FIELD:
1173 push_item(p, expr -> item.parent);
1174 jvm_generate_ldst_prepare(p, expr -> item.var -> gen_var);
1175 break;
1176 case MODE_DEREF:
1177 push_varptr(p, (oberon_expr_t *) expr -> item.parent);
1178 break;
1179 default:
1180 gen_error("push_varptr: wat %i", expr -> item.mode);
1181 break;
1182 }
1183 }
1184
1185 static void
1186 jvm_generate_call_proc(gen_proc_t * p, oberon_item_t * desig)
1187 {
1188 assert(desig -> var == NULL);
1189 assert(desig -> mode == MODE_CALL);
1190
1191 bool direct_call = false;
1192 if(desig -> parent -> mode == MODE_VAR)
1193 {
1194 if(desig -> parent -> var -> class == OBERON_CLASS_PROC)
1195 {
1196 direct_call = true;
1197 }
1198 }
1199
1200 oberon_type_t * procsig;
1201 procsig = desig -> parent -> result;
1202
1203 if(direct_call == false)
1204 {
1205 /* Загружаем указатель на процедуру */
1206 push_item(p, desig -> parent);
1207 }
1208
1209 if(direct_call)
1210 {
1211 jvm_generate_push_static_links(p, desig -> parent -> var);
1212 }
1213
1214 int args_cells = 0;
1215 int result_cells = jvm_cell_size_for_type(procsig -> base);
1216
1217 int num = desig -> num_args;
1218 oberon_expr_t * arg = desig -> args;
1219 oberon_object_t * param = procsig -> decl;
1220 for(int i = 0; i < num; i++)
1221 {
1222 if(param -> class == OBERON_CLASS_VAR_PARAM)
1223 {
1224 args_cells += 2;
1225 push_varptr(p, arg);
1226 }
1227 else
1228 {
1229 args_cells += jvm_cell_size_for_type(arg -> result);
1230 push_expr(p, arg);
1231 }
1232 arg = arg -> next;
1233 param = param -> next;
1234 }
1235
1236 if(direct_call)
1237 {
1238 char * full_name = jvm_get_field_full_name(desig -> parent -> var);
1239 char * signature = jvm_get_local_procedure_signature(desig -> parent -> var);
1240 jvm_generate(p, args_cells, result_cells, "invokestatic %s%s", full_name, signature);
1241 }
1242 else
1243 {
1244 char * cname = jvm_get_class_full_name(procsig);
1245 char * signature = jvm_get_procedure_signature(procsig);
1246 jvm_generate(p, 1 + args_cells, result_cells, "invokevirtual %s/invoke%s", cname, signature);
1247 }
1248 }
1249
1250 void
1251 oberon_generate_call_proc(oberon_context_t * ctx, oberon_expr_t * desig)
1252 {
1253 assert(desig -> is_item);
1254 jvm_generate_call_proc(ctx -> mod -> gen_mod -> class -> p, (oberon_item_t *) desig);
1255 }
1256
1257 void
1258 oberon_generate_return(oberon_context_t * ctx, oberon_expr_t * expr)
1259 {
1260 gen_module_t * m;
1261 gen_proc_t * p;
1262 char prefix;
1263 int cell_size;
1264
1265 m = ctx -> mod -> gen_mod;
1266 p = m -> class -> p;
1267
1268 if(expr)
1269 {
1270 push_expr(p, expr);
1271 prefix = jvm_get_prefix(expr -> result);
1272 cell_size = jvm_cell_size_for_type(expr -> result);
1273 jvm_generate(p, cell_size, 0, "%creturn", prefix);
1274 }
1275 else
1276 {
1277 jvm_generate(p, 0, 0, "return");
1278 }
1279 }
1280
1281 static void
1282 jvm_generate_expr_new_pointer(gen_proc_t * p, oberon_type_t * type, int num, oberon_expr_t * arg)
1283 {
1284 assert(type -> class == OBERON_TYPE_POINTER);
1285
1286 for(int i = 0; i < num; i++)
1287 {
1288 push_expr(p, arg);
1289 check_index(p, arg -> result);
1290 arg = arg -> next;
1291 }
1292
1293 jvm_generate_new(p, type -> base, num);
1294 }
1295
1296 static void
1297 push_item(gen_proc_t * p, oberon_item_t * item)
1298 {
1299 switch(item -> mode)
1300 {
1301 case MODE_VAR:
1302 if(item -> var -> class == OBERON_CLASS_PROC)
1303 {
1304 jvm_generate_push_procedure_pointer(p, item -> var);
1305 }
1306 else
1307 {
1308 jvm_generate_load(p, item -> var -> gen_var);
1309 }
1310 break;
1311 case MODE_INTEGER:
1312 case MODE_BOOLEAN:
1313 case MODE_CHAR:
1314 case MODE_SET:
1315 jvm_generate_push_int_size(p, item -> integer, item -> result -> size);
1316 break;
1317 case MODE_CALL:
1318 jvm_generate_call_proc(p, item);
1319 break;
1320 case MODE_INDEX:
1321 ;
1322 char postfix = jvm_get_postfix(item -> result);
1323 int cell_size = jvm_cell_size_for_postfix(postfix);
1324 push_item(p, item -> parent);
1325 push_expr(p, item -> args);
1326 check_index(p, item -> args -> result);
1327 jvm_generate(p, 1 + 1, cell_size, "%caload", postfix);
1328 break;
1329 case MODE_FIELD:
1330 push_item(p, item -> parent);
1331 jvm_generate_load(p, item -> var -> gen_var);
1332 break;
1333 case MODE_DEREF:
1334 /* Все объекты в jvm представляются как указатели */
1335 push_item(p, item -> parent);
1336 break;
1337 case MODE_NIL:
1338 jvm_generate(p, 0, 1, "aconst_null");
1339 break;
1340 case MODE_NEW:
1341 jvm_generate_expr_new_pointer(p, item -> result, item -> num_args, item -> args);
1342 break;
1343 case MODE_REAL:
1344 jvm_generate_push_float(p, item -> real, item -> result -> size);
1345 break;
1346 case MODE_STRING:
1347 jvm_generate_push_string(p, item -> string, item -> result -> size);
1348 break;
1349 case MODE_LEN:
1350 push_item(p, item -> parent);
1351 jvm_generate_array_len(p, item -> integer);
1352 jvm_generate_cast_prefix(p, 'i', jvm_get_postfix(item -> result));
1353 break;
1354 case MODE_AS:
1355 push_item(p, item -> parent);
1356 jvm_generate_cast_type(p, item -> parent -> result, item -> result);
1357 break;
1358 default:
1359 gen_error("push_item: unk mode %i", item -> mode);
1360 break;
1361 }
1362 }
1363
1364 static void
1365 jvm_generate_logical_not(gen_proc_t * p)
1366 {
1367 int label_done = jvm_new_label_id(p);
1368 int label_false = jvm_new_label_id(p);
1369
1370 jvm_generate(p, 1, 0, "ifne L%i", label_false);
1371 jvm_generate(p, 0, 1, "iconst_1");
1372 jvm_generate(p, 0, 0, "goto L%i", label_done);
1373 jvm_generate_label(p, label_false);
1374 jvm_generate(p, 0, 1, "iconst_0");
1375 jvm_generate_label(p, label_done);
1376 }
1377
1378 static void
1379 jvm_generate_abs(gen_proc_t * p, char prefix)
1380 {
1381 char t = jvm_get_type_of_prefix(prefix);
1382 int cell_size = jvm_cell_size_for_postfix(prefix);
1383 jvm_generate(p, cell_size, cell_size, "invokestatic java/lang/Math/abs(%c)%c", t, t);
1384 }
1385
1386 static char *
1387 jvm_get_compare_postfix(int op)
1388 {
1389 char * cmpop = "";
1390 switch(op)
1391 {
1392 case OP_EQ:
1393 cmpop = "eq";
1394 break;
1395 case OP_NEQ:
1396 cmpop = "ne";
1397 break;
1398 case OP_LSS:
1399 cmpop = "lt";
1400 break;
1401 case OP_LEQ:
1402 cmpop = "le";
1403 break;
1404 case OP_GRT:
1405 cmpop = "gt";
1406 break;
1407 case OP_GEQ:
1408 cmpop = "ge";
1409 break;
1410 default:
1411 gen_error("jvm_generate_compare_op: wat");
1412 break;
1413 }
1414 return cmpop;
1415 }
1416
1417 static void
1418 jvm_generate_compare_op(gen_proc_t * p, oberon_type_t * t, int op)
1419 {
1420 char prefix = jvm_get_prefix(t);
1421 int label_true = jvm_new_label_id(p);
1422 int label_done = jvm_new_label_id(p);
1423 int cell_size = jvm_cell_size_for_type(t);
1424 char * cmpop = jvm_get_compare_postfix(op);
1425
1426 if(prefix == 'l')
1427 {
1428 jvm_generate(p, 2 * cell_size, 1, "lcmp");
1429 jvm_generate(p, 1, 1, "if%s L%i", cmpop, label_true);
1430 }
1431 else if(prefix == 'f' || prefix == 'd')
1432 {
1433 char fop;
1434 if(op == OP_EQ || op == OP_NEQ || op == OP_GRT || op == OP_GEQ)
1435 {
1436 fop = 'l';
1437 }
1438 else
1439 {
1440 fop = 'g';
1441 }
1442 jvm_generate(p, 2 * cell_size, 1, "%ccmp%c", prefix, fop);
1443 jvm_generate(p, 1, 1, "if%s L%i", cmpop, label_true);
1444 }
1445 else if(prefix == 'a')
1446 {
1447 if(t -> class == OBERON_TYPE_STRING
1448 || (t -> class == OBERON_TYPE_POINTER && t -> base -> class == OBERON_TYPE_CHAR))
1449 {
1450 jvm_generate(p, 2, 1, "invokestatic SYSTEM/STRCMP([B[B)I");
1451 jvm_generate(p, 1, 0, "if%s L%i", cmpop, label_true);
1452 }
1453 else
1454 {
1455 jvm_generate(p, 1, 0, "if_acmp%s L%i", cmpop, label_true);
1456 }
1457 }
1458 else
1459 {
1460 jvm_generate(p, 2 * cell_size, 0, "if_%ccmp%s L%i", prefix, cmpop, label_true);
1461 }
1462
1463 jvm_generate(p, 0, 1, "iconst_0");
1464 jvm_generate(p, 0, 0, "goto L%i", label_done);
1465 jvm_generate_label(p, label_true);
1466 jvm_generate(p, 0, 1, "iconst_1");
1467 jvm_generate_label(p, label_done);
1468 }
1469
1470 static void
1471 jvm_generate_operator(gen_proc_t * p, oberon_type_t * t, int op)
1472 {
1473 char prefix = jvm_get_prefix(t);
1474 int cell_size = jvm_cell_size_for_type(t);
1475 switch(op)
1476 {
1477 case OP_UNARY_MINUS:
1478 jvm_generate(p, cell_size, cell_size, "%cneg", prefix);
1479 break;
1480 case OP_COMPLEMENTATION:
1481 jvm_generate_push_int_size(p, -1, t -> size);
1482 jvm_generate(p, 2 * cell_size, cell_size, "%cxor", prefix);
1483 break;
1484 case OP_LOGIC_NOT:
1485 jvm_generate_logical_not(p);
1486 break;
1487 case OP_ABS:
1488 jvm_generate_abs(p, prefix);
1489 break;
1490 case OP_CAP:
1491 jvm_generate(p, cell_size, cell_size, "invokestatic java/lang/Character/toUpperCase(I)I");
1492 break;
1493
1494 case OP_ADD:
1495 jvm_generate(p, 2 * cell_size, cell_size, "%cadd", prefix);
1496 break;
1497 case OP_SUB:
1498 jvm_generate(p, 2 * cell_size, cell_size, "%csub", prefix);
1499 break;
1500 case OP_MUL:
1501 jvm_generate(p, 2 * cell_size, cell_size, "%cmul", prefix);
1502 break;
1503 case OP_DIV:
1504 jvm_generate(p, 2 * cell_size, cell_size, "%cdiv", prefix);
1505 break;
1506 case OP_MOD:
1507 jvm_generate(p, 2 * cell_size, cell_size, "%crem", prefix);
1508 break;
1509 case OP_UNION:
1510 jvm_generate(p, 2 * cell_size, cell_size, "%cor", prefix);
1511 break;
1512 case OP_INTERSECTION:
1513 jvm_generate(p, 2 * cell_size, cell_size, "%cand", prefix);
1514 break;
1515 case OP_DIFFERENCE:
1516 /* (a - b) == a & ~b */
1517 jvm_generate_push_int_size(p, -1, t -> size);
1518 jvm_generate(p, 2 * cell_size, cell_size, "%cxor", prefix);
1519 jvm_generate(p, 2 * cell_size, cell_size, "%cand", prefix);
1520 break;
1521 case OP_SYM_DIFFERENCE:
1522 jvm_generate(p, 2 * cell_size, cell_size, "%cxor", prefix);
1523 break;
1524
1525 case OP_EQ:
1526 case OP_NEQ:
1527 case OP_LSS:
1528 case OP_LEQ:
1529 case OP_GRT:
1530 case OP_GEQ:
1531 jvm_generate_compare_op(p, t, op);
1532 break;
1533 default:
1534 gen_error("jvm_generate_operator: unk op %i", op);
1535 break;
1536 }
1537 }
1538
1539 static void
1540 jvm_generate_logical_or(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b)
1541 {
1542 int label_calc_b = jvm_new_label_id(p);
1543 int label_done = jvm_new_label_id(p);
1544
1545 /* a OR b -- если a, то TRUE, иначе b */
1546
1547 push_expr(p, a);
1548 jvm_generate(p, 1, 0, "ifeq L%i", label_calc_b);
1549 jvm_generate(p, 0, 1, "iconst_1");
1550 jvm_generate(p, 0, 0, "goto L%i", label_done);
1551 jvm_generate_label(p, label_calc_b);
1552 push_expr(p, b);
1553 jvm_generate_label(p, label_done);
1554 }
1555
1556 static void
1557 jvm_generate_logical_and(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b)
1558 {
1559 int label_false = jvm_new_label_id(p);
1560 int label_done = jvm_new_label_id(p);
1561
1562 /* a AND b -- если a, то b, иначе FALSE */
1563
1564 push_expr(p, a);
1565 jvm_generate(p, 1, 0, "ifeq L%i", label_false);
1566 push_expr(p, b);
1567 jvm_generate(p, 0, 0, "goto L%i", label_done);
1568 jvm_generate_label(p, label_false);
1569 jvm_generate(p, 0, 1, "iconst_0");
1570 jvm_generate_label(p, label_done);
1571 }
1572
1573 static void
1574 jvm_generate_range(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b)
1575 {
1576 /* { a } == 1 << a */
1577 /* { a..b } == (a <= b) ? ((2 << b) - (1 << a)) : (0); */
1578
1579 char prefix;
1580 int cell_size;
1581 oberon_type_t * type;
1582 gen_var_t * ra;
1583 gen_var_t * rb;
1584 int label_else;
1585 int label_end;
1586
1587 type = a -> result;
1588 cell_size = jvm_cell_size_for_type(type);
1589 prefix = jvm_get_prefix(type);
1590
1591 if(b == NULL)
1592 {
1593 jvm_generate_push_int_size(p, 1, type -> size);
1594 push_expr(p, a);
1595 jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix);
1596 }
1597 else
1598 {
1599 ra = jvm_create_function_temp_var(p, type -> gen_type);
1600 rb = jvm_create_function_temp_var(p, type -> gen_type);
1601 jvm_generate_var(ra);
1602 jvm_generate_var(rb);
1603 jvm_generate_var_initialization(p, ra);
1604 jvm_generate_var_initialization(p, rb);
1605 label_else = jvm_new_label_id(p);
1606 label_end = jvm_new_label_id(p);
1607
1608 push_expr(p, a);
1609 jvm_generate_store(p, ra);
1610 push_expr(p, b);
1611 jvm_generate_store(p, rb);
1612
1613 jvm_generate_load(p, ra);
1614 jvm_generate_load(p, rb);
1615 jvm_generate(p, 2 * cell_size, 0, "if_%ccmpgt L%i", prefix, label_else);
1616
1617 jvm_generate_push_int_size(p, 2, type -> size);
1618 jvm_generate_load(p, rb);
1619 jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix);
1620 jvm_generate_push_int_size(p, 2, type -> size);
1621 jvm_generate_load(p, ra);
1622 jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix);
1623 jvm_generate(p, 2 * cell_size, cell_size, "%csub", prefix);
1624 jvm_generate(p, 0, 0, "goto L%i", label_end);
1625
1626 jvm_generate_label(p, label_else);
1627 jvm_generate_push_int_size(p, 0, type -> size);
1628 jvm_generate_label(p, label_end);
1629 }
1630
1631 /* TODO free registers */
1632 }
1633
1634 static void
1635 jvm_generate_in(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b)
1636 {
1637 oberon_type_t * t = a -> result;
1638 int cell_size = jvm_cell_size_for_type(t);
1639 char prefix = jvm_get_prefix(t);
1640 int label_else = jvm_new_label_id(p);
1641 int label_end = jvm_new_label_id(p);
1642
1643 /* (a IN b) == (1 << a) & b */
1644 jvm_generate_push_int_size(p, 1, t -> size);
1645 push_expr(p, a);
1646 jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix);
1647 push_expr(p, b);
1648 jvm_generate(p, 2 * cell_size, cell_size, "%cand", prefix);
1649
1650 if(cell_size > 1)
1651 {
1652 jvm_generate(p, cell_size, 0, "lcmp");
1653 }
1654
1655 jvm_generate(p, 1, 0, "ifeq L%i", label_else);
1656 jvm_generate(p, 0, 1, "iconst_1");
1657 jvm_generate(p, 0, 0, "goto L%i", label_end);
1658 jvm_generate_label(p, label_else);
1659 jvm_generate(p, 0, 1, "iconst_0");
1660 jvm_generate_label(p, label_end);
1661 }
1662
1663 static void
1664 jvm_generate_shift(gen_proc_t * p, int op, oberon_expr_t * a, oberon_expr_t * b)
1665 {
1666 oberon_type_t * t = a -> result;
1667 int cell_size = jvm_cell_size_for_type(t);
1668 char prefix = jvm_get_prefix(t);
1669 char dt = jvm_get_type_of_prefix(prefix);
1670
1671 push_expr(p, a);
1672 jvm_generate_cast_type(p, a -> result, t);
1673 push_expr(p, b);
1674 jvm_generate_cast_type(p, b -> result, t);
1675
1676 char * opname;
1677 switch(op)
1678 {
1679 case OP_ASH:
1680 opname = "ASH";
1681 break;
1682 case OP_LSH:
1683 opname = "LSH";
1684 break;
1685 case OP_ROT:
1686 opname = "ROT";
1687 break;
1688 default:
1689 gen_error("jvm_generate_shift: invalid op %i", op);
1690 }
1691
1692 jvm_generate(p, 2 * cell_size, cell_size, "invokestatic SYSTEM/%s(%c%c)%c", opname, dt, dt, dt);
1693 }
1694
1695 static void
1696 jvm_generate_entier(gen_proc_t * p, oberon_expr_t * x, oberon_type_t * res)
1697 {
1698 char prefix = jvm_get_prefix(x -> result);
1699 char postfix = jvm_get_postfix(res);
1700
1701 push_expr(p, x);
1702 jvm_generate_cast_prefix(p, prefix, 'd');
1703 jvm_generate(p, 2, 2, "invokestatic java/lang/Math/floor(D)D");
1704 jvm_generate_cast_prefix(p, 'd', postfix);
1705 }
1706
1707 static void
1708 push_operator(gen_proc_t * p, oberon_oper_t * oper)
1709 {
1710 oberon_type_t * preq = oper -> left -> result;
1711 int op = oper -> op;
1712 switch(op)
1713 {
1714 case OP_CAST:
1715 push_expr(p, oper -> left);
1716 jvm_generate_cast_type(p, oper -> left -> result, oper -> result);
1717 break;
1718 case OP_HARDCAST:
1719 push_expr(p, oper -> left);
1720 jvm_generate_hard_cast_type(p, oper -> left -> result, oper -> result);
1721 break;
1722 case OP_COMPLEMENTATION:
1723 case OP_UNARY_MINUS:
1724 case OP_LOGIC_NOT:
1725 case OP_ABS:
1726 case OP_CAP:
1727 push_expr(p, oper -> left);
1728 jvm_generate_operator(p, preq, op);
1729 break;
1730 case OP_ENTIER:
1731 jvm_generate_entier(p, oper -> left, oper -> result);
1732 break;
1733
1734 case OP_ADD:
1735 case OP_SUB:
1736 case OP_MUL:
1737 case OP_DIV:
1738 case OP_MOD:
1739
1740 case OP_UNION:
1741 case OP_INTERSECTION:
1742 case OP_DIFFERENCE:
1743 case OP_SYM_DIFFERENCE:
1744
1745 case OP_EQ:
1746 case OP_NEQ:
1747 case OP_LSS:
1748 case OP_LEQ:
1749 case OP_GRT:
1750 case OP_GEQ:
1751 push_expr(p, oper -> left);
1752 push_expr(p, oper -> right);
1753 jvm_generate_operator(p, preq, op);
1754 break;
1755
1756 case OP_LOGIC_OR:
1757 jvm_generate_logical_or(p, oper -> left, oper -> right);
1758 break;
1759 case OP_LOGIC_AND:
1760 jvm_generate_logical_and(p, oper -> left, oper -> right);
1761 break;
1762
1763 case OP_IS:
1764 preq = oper -> right -> result;
1765 char * cname = jvm_get_class_full_name(preq);
1766 push_expr(p, oper -> left);
1767 jvm_generate(p, 1, 1, "instanceof %s", cname);
1768 break;
1769 case OP_RANGE:
1770 jvm_generate_range(p, oper -> left, oper -> right);
1771 break;
1772 case OP_IN:
1773 jvm_generate_in(p, oper -> left, oper -> right);
1774 break;
1775
1776 case OP_ASH:
1777 case OP_LSH:
1778 case OP_ROT:
1779 jvm_generate_shift(p, op, oper -> left, oper -> right);
1780 break;
1781 default:
1782 gen_error("push_oper: unk op %i", op);
1783 break;
1784 }
1785 }
1786
1787 static void
1788 push_expr(gen_proc_t * p, oberon_expr_t * expr)
1789 {
1790 if(expr -> is_item)
1791 {
1792 push_item(p, (oberon_item_t *) expr);
1793 }
1794 else
1795 {
1796 push_operator(p, (oberon_oper_t *) expr);
1797 }
1798 }
1799
1800 static void
1801 store_expr(gen_proc_t * p, oberon_expr_t * dst, oberon_expr_t * src)
1802 {
1803 assert(dst -> is_item);
1804 oberon_item_t * item = (oberon_item_t *) dst;
1805
1806 if(dst -> result -> class == OBERON_TYPE_ARRAY
1807 || src -> result -> class == OBERON_TYPE_ARRAY)
1808 {
1809 push_expr(p, dst);
1810 push_expr(p, src);
1811 jvm_generate_copy_array(p, dst -> result);
1812 }
1813 else if(dst -> result -> class == OBERON_TYPE_RECORD
1814 || src -> result -> class == OBERON_TYPE_RECORD)
1815 {
1816 push_expr(p, dst);
1817 push_expr(p, src);
1818 jvm_generate_copy_record(p, dst -> result);
1819 }
1820 else switch(item -> mode)
1821 {
1822 case MODE_VAR:
1823 jvm_generate_ldst_prepare(p, item -> var -> gen_var);
1824 push_expr(p, src);
1825 jvm_generate_store(p, item -> var -> gen_var);
1826 break;
1827 case MODE_INDEX:
1828 ;
1829 char postfix = jvm_get_postfix(src -> result);
1830 int cell_size = jvm_cell_size_for_postfix(postfix);
1831 assert(item -> parent -> is_item);
1832 push_item(p, (oberon_item_t *) item -> parent);
1833 push_expr(p, item -> args);
1834 check_index(p, item -> args -> result);
1835 push_expr(p, src);
1836 jvm_generate(p, 1 + 1 + cell_size, 0, "%castore", postfix);
1837 break;
1838 case MODE_FIELD:
1839 assert(item -> parent -> is_item);
1840 push_item(p, (oberon_item_t *) item -> parent);
1841 jvm_generate_ldst_prepare(p, item -> var -> gen_var);
1842 push_expr(p, src);
1843 jvm_generate_store(p, item -> var -> gen_var);
1844 break;
1845 default:
1846 gen_error("store_expr: unk mode %i", item -> mode);
1847 break;
1848 }
1849 }
1850
1851 void
1852 oberon_generate_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
1853 {
1854 gen_module_t * m;
1855 gen_proc_t * p;
1856
1857 m = ctx -> mod -> gen_mod;
1858 p = m -> class -> p;
1859
1860 store_expr(p, dst, src);
1861 }
1862
1863 void
1864 oberon_generate_copy(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
1865 {
1866 gen_module_t * m;
1867 gen_proc_t * p;
1868 char * desc;
1869
1870 m = ctx -> mod -> gen_mod;
1871 p = m -> class -> p;
1872
1873 push_expr(p, src);
1874 push_expr(p, dst);
1875
1876 desc = jvm_get_descriptor(dst -> result);
1877
1878 jvm_generate(p, 2, 0, "invokestatic SYSTEM/COPY(%s%s)V", desc, desc);
1879 }
1880
1881 void
1882 oberon_generate_assert(oberon_context_t * ctx, oberon_expr_t * cond)
1883 {
1884 gen_module_t * m;
1885 gen_proc_t * p;
1886
1887 m = ctx -> mod -> gen_mod;
1888 p = m -> class -> p;
1889
1890 push_expr(p, cond);
1891 jvm_generate(p, 1, 0, "invokestatic SYSTEM/ASSERT(Z)V");
1892 }
1893
1894 void
1895 oberon_generate_assert_n(oberon_context_t * ctx, oberon_expr_t * cond, int64_t n)
1896 {
1897 gen_module_t * m;
1898 gen_proc_t * p;
1899
1900 m = ctx -> mod -> gen_mod;
1901 p = m -> class -> p;
1902
1903 push_expr(p, cond);
1904 jvm_generate_push_int_size(p, n, 8);
1905 jvm_generate(p, 1 + 2, 0, "invokestatic SYSTEM/ASSERT(ZJ)V");
1906 }
1907
1908 void
1909 oberon_generate_trap(oberon_context_t * ctx, int64_t n)
1910 {
1911 gen_module_t * m;
1912 gen_proc_t * p;
1913
1914 m = ctx -> mod -> gen_mod;
1915 p = m -> class -> p;
1916
1917 jvm_generate_push_int_size(p, n, 8);
1918 jvm_generate(p, 2, 0, "invokestatic SYSTEM/TRAP(J)V");
1919 }
1920
1921 void
1922 oberon_generate_halt(oberon_context_t * ctx, int64_t n)
1923 {
1924 gen_module_t * m;
1925 gen_proc_t * p;
1926
1927 m = ctx -> mod -> gen_mod;
1928 p = m -> class -> p;
1929
1930 jvm_generate_push_int_size(p, n, 8);
1931 jvm_generate(p, 2, 0, "invokestatic SYSTEM/HALT(J)V");
1932 }
1933
1934 void
1935 oberon_set_out_directory(oberon_context_t * ctx, const char * path)
1936 {
1937 gen_context_t * c;
1938
1939 c = ctx -> gen_context;
1940
1941 c -> dir = new_string(path);
1942 }
Another attempt to make Oberon compiler
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024