DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / dsw-obn.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Исправлено действие конструкции WITH
[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/doubleToRawLongBits(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 t -> full_name = jvm_get_class_full_name(type);
591 oberon_generate_record_class(c -> dir, m, type);
592 break;
593 case OBERON_TYPE_PROCEDURE:
594 oberon_generate_procedure_class(c -> dir, type);
595 break;
596 default:
597 gen_error("oberon_generator_init_type: unk calss %i", type -> class);
598 break;
599 }
600
601 if(type -> class != OBERON_TYPE_NOTYPE)
602 {
603 t -> wide = jvm_is_wide_type(type);
604 t -> prefix = jvm_get_prefix(type);
605 t -> postfix = jvm_get_postfix(type);
606 }
607
608 if(type -> class == OBERON_TYPE_POINTER ||
609 type -> class == OBERON_TYPE_PROCEDURE ||
610 type -> class == OBERON_TYPE_RECORD ||
611 type -> class == OBERON_TYPE_SYSTEM_PTR)
612 {
613 t -> full_name = jvm_get_class_full_name(type);
614 }
615
616 t -> cell_size = jvm_cell_size_for_type(type);
617
618 if(type -> class != OBERON_TYPE_NIL)
619 {
620 t -> desc = jvm_get_descriptor(type);
621 }
622 }
623
624 void
625 oberon_generator_init_record(oberon_context_t * ctx, oberon_type_t * rec)
626 {
627 struct gen_class * class;
628 class = rec -> gen_type -> class;
629
630 int num = rec -> num_decl;
631 oberon_object_t * field = rec -> decl;
632 for(int i = 0; i < num; i++)
633 {
634 jvm_generate_var(field -> gen_var);
635 field = field -> next;
636 }
637
638 /* Стандартный конструктор класса */
639 /* Инициализирует внутренние статические записи и массивы */
640 gen_proc_t * p = jvm_create_proc(class);
641 jvm_generate_function_header(p, "public", "<init>", "()V");
642 jvm_alloc_register_untyped(p -> rf, false);
643 jvm_generate(p, 0, 1, "aload_0");
644 if(class -> base)
645 {
646 jvm_generate(p, 1, 0, "invokespecial %s/<init>()V", class -> base -> full_name);
647 }
648 else
649 {
650 jvm_generate(p, 1, 0, "invokespecial java/lang/Object/<init>()V");
651 }
652 num = rec -> num_decl;
653 field = rec -> decl;
654 for(int i = 0; i < num; i++)
655 {
656 jvm_generate(p, 0, 1, "aload_0");
657 jvm_generate_var_initialization(p, field -> gen_var);
658
659 if(field -> type -> class == OBERON_TYPE_RECORD
660 || field -> type -> class == OBERON_TYPE_ARRAY)
661 {
662 jvm_generate(p, 0, 1, "aload_0");
663 jvm_generate_ldst_prepare(p, field -> gen_var);
664 jvm_generate_new(p, field -> type, 0);
665 jvm_generate_store(p, field -> gen_var);
666 }
667 field = field -> next;
668 }
669 jvm_generate(p, 0, 0, "return");
670 jvm_generate_function_end(p);
671
672 /* Метод для копирования полей класса */
673 /* reg0 == src -> reg1 == dst */
674 p = jvm_create_proc(class);
675 char * signature = new_string("(%s%s)V", rec -> gen_type -> desc, rec -> gen_type -> desc);
676 jvm_generate_function_header(p, "public static", "$COPY$", signature);
677
678 gen_var_t * copy_dst = jvm_create_function_var(p, JVM_STORAGE_REGISTER, "dst", rec -> gen_type);
679 gen_var_t * copy_src = jvm_create_function_var(p, JVM_STORAGE_REGISTER, "src", rec -> gen_type);
680 jvm_generate_var(copy_dst);
681 jvm_generate_var(copy_src);
682 jvm_generate_var_initialization(p, copy_dst);
683 jvm_generate_var_initialization(p, copy_src);
684
685 if(rec -> base)
686 {
687 jvm_generate_load(p, copy_dst);
688 jvm_generate_load(p, copy_src);
689 jvm_generate_copy_record(p, rec -> base);
690 }
691
692 num = rec -> num_decl;
693 field = rec -> decl;
694 for(int i = 0; i < num; i++)
695 {
696 if(field -> type -> class == OBERON_TYPE_RECORD)
697 {
698 jvm_generate_load(p, copy_dst);
699 jvm_generate_load(p, field -> gen_var);
700 jvm_generate_load(p, copy_src);
701 jvm_generate_load(p, field -> gen_var);
702 jvm_generate_copy_record(p, field -> type);
703 }
704 else if(field -> type -> class == OBERON_TYPE_ARRAY)
705 {
706 jvm_generate_load(p, copy_dst);
707 jvm_generate_load(p, field -> gen_var);
708 jvm_generate_load(p, copy_src);
709 jvm_generate_load(p, field -> gen_var);
710 jvm_generate_copy_array(p, field -> type);
711 }
712 else
713 {
714 jvm_generate_load(p, copy_dst);
715 jvm_generate_ldst_prepare(p, field -> gen_var);
716 jvm_generate_load(p, copy_src);
717 jvm_generate_load(p, field -> gen_var);
718 jvm_generate_store(p, field -> gen_var);
719 }
720 field = field -> next;
721 }
722 jvm_generate(p, 0, 0, "return");
723 jvm_generate_function_end(p);
724
725 jvm_destroy_class(class);
726 }
727
728 void
729 oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var)
730 {
731 gen_module_t * m;
732 m = ctx -> mod -> gen_mod;
733
734 struct gen_class * class;
735 class = m -> class;
736
737 gen_proc_t * p;
738 struct gen_class * c;
739 char * name = var -> name;
740 gen_type_t * t = var -> type -> gen_type;
741
742 assert(name);
743 if(t == NULL)
744 {
745 gen_error("uninitialized type class %i", var -> type -> class);
746 }
747
748 switch(var -> class)
749 {
750 case OBERON_CLASS_VAR_PARAM:
751 p = var -> parent -> gen_proc;
752 var -> gen_var = jvm_create_function_var(p, JVM_STORAGE_FRAME_PARAM_VARPTR, name, t);
753 break;
754 case OBERON_CLASS_PARAM:
755 p = var -> parent -> gen_proc;
756 var -> gen_var = jvm_create_function_var(p, JVM_STORAGE_FRAME_PARAM_VAR, name, t);
757 break;
758 case OBERON_CLASS_FIELD:
759 c = var -> parent_type -> gen_type -> class;
760 var -> gen_var = jvm_create_class_var(c, JVM_STORAGE_FIELD_VAR, name, t);
761 break;
762 case OBERON_CLASS_VAR:
763 if(var -> local)
764 {
765 p = var -> parent -> gen_proc;
766 var -> gen_var = jvm_create_function_var(p, JVM_STORAGE_FRAME_VAR, name, t);
767 }
768 else
769 {
770 var -> gen_var = jvm_create_class_var(class, JVM_STORAGE_STATIC_VAR, name, t);
771 jvm_generate_var(var -> gen_var);
772 }
773 break;
774 default:
775 gen_error("oberon_generator_init_var: unk var class %i", var -> class);
776 break;
777 }
778 }
779
780 static void
781 oberon_generate_static_initialization(gen_proc_t * p, oberon_object_t * x)
782 {
783 if(x -> type -> class == OBERON_TYPE_ARRAY
784 || x -> type -> class == OBERON_TYPE_RECORD)
785 {
786 jvm_generate_ldst_prepare(p, x -> gen_var);
787 jvm_generate_new(p, x -> type, 0);
788 jvm_generate_store(p, x -> gen_var);
789 }
790 }
791
792 void
793 oberon_generator_init_temp_var(oberon_context_t * ctx, oberon_object_t * var)
794 {
795 assert(var -> class == OBERON_CLASS_VAR);
796
797 gen_module_t * m;
798 m = ctx -> mod -> gen_mod;
799
800 gen_proc_t * p;
801 p = m -> class -> p;
802
803 gen_type_t * t;
804 t = var -> type -> gen_type;
805
806 var -> gen_var = jvm_create_function_temp_var(p, t);
807 jvm_generate_var(var -> gen_var);
808 jvm_generate_var_initialization(p, var -> gen_var);
809 oberon_generate_static_initialization(p, var);
810 }
811
812 void
813 oberon_generator_init_proc(oberon_context_t * ctx, oberon_object_t * proc)
814 {
815 struct gen_class * class = proc -> module -> gen_mod -> class;
816 proc -> gen_proc = jvm_create_proc(class);
817 proc -> gen_proc -> full_name = jvm_get_field_full_name_safe(proc);
818 jvm_create_static_links(proc);
819 }
820
821 void
822 oberon_generator_init_module(oberon_context_t * ctx, oberon_module_t * mod)
823 {
824 gen_module_t * m = GC_MALLOC(sizeof *m);
825 memset(m, 0, sizeof *m);
826 mod -> gen_mod = m;
827
828 gen_context_t * c;
829 c = ctx -> gen_context;
830
831 struct gen_class * class;
832 class = jvm_create_class(c -> dir, mod -> name);
833
834 fprintf(class -> fp, ".source %s\n", mod -> name);
835 fprintf(class -> fp, ".class %s\n", mod -> name);
836 fprintf(class -> fp, ".super java/lang/Object\n\n");
837
838 fprintf(class -> fp, ".field private static $INITIALIZED$ Z\n\n");
839
840 m -> class = class;
841
842 c -> current_m = m;
843 }
844
845 void
846 oberon_generator_fini_module(oberon_module_t * mod)
847 {
848 jvm_destroy_class(mod -> gen_mod -> class);
849 }
850
851 static void
852 push_expr(gen_proc_t * p, oberon_expr_t * expr);
853
854 void
855 oberon_generate_begin_module(oberon_context_t * ctx)
856 {
857 gen_proc_t * p;
858 int label_cont;
859 struct gen_class * class;
860
861 class = ctx -> mod -> gen_mod -> class;
862
863 p = jvm_create_proc(class);
864 jvm_generate_function_header(p, "public static", "BEGIN", "()V");
865
866 label_cont = jvm_new_label_id(p);
867 jvm_generate(p, 0, 1, "getstatic %s/$INITIALIZED$ Z", class -> full_name);
868 jvm_generate(p, 1, 0, "ifeq L%i", label_cont);
869 jvm_generate(p, 0, 0, "return");
870 jvm_generate_label(p, label_cont);
871
872 jvm_generate(p, 0, 1, "iconst_1");
873 jvm_generate(p, 1, 0, "putstatic %s/$INITIALIZED$ Z", class -> full_name);
874
875 /* Инициализация переменных объявленных в модуле */
876 oberon_object_t * x = ctx -> mod -> decl -> list -> next;
877 while(x != NULL)
878 {
879 if(x -> class == OBERON_CLASS_MODULE)
880 {
881 if(!x -> module -> intrinsic)
882 {
883 jvm_generate(p, 0, 0, "invokestatic %s/BEGIN()V", x -> module -> gen_mod -> class -> full_name);
884 }
885 }
886 else if(x -> class == OBERON_CLASS_VAR)
887 {
888 jvm_generate_var_initialization(p, x -> gen_var);
889 oberon_generate_static_initialization(p, x);
890 }
891
892 x = x -> next;
893 }
894 }
895
896 void
897 oberon_generate_end_module(oberon_context_t * ctx)
898 {
899 struct gen_class * class = ctx -> mod -> gen_mod -> class;
900 gen_proc_t * p = class -> p;
901
902 jvm_generate(p, 0, 0, "return");
903 jvm_generate_function_end(class -> p);
904
905 p = jvm_create_proc(class);
906 jvm_generate_function_header(p, "private", "<init>", "()V");
907 jvm_alloc_register_untyped(p -> rf, false);
908 jvm_generate(p, 0, 1, "aload_0");
909 jvm_generate(p, 1, 0, "invokespecial java/lang/Object/<init>()V");
910 jvm_generate(p, 0, 0, "return");
911 jvm_generate_function_end(class -> p);
912 }
913
914 /*
915 * Генерирует код для получения размера измерения массива
916 * Аналог Обероновского LEN(v, n); где n = 0 - первое измерение.
917 * ( aref -- int )
918 */
919
920 static void
921 jvm_generate_array_len(gen_proc_t * p, int dim)
922 {
923 while(dim > 0)
924 {
925 jvm_generate(p, 0, 1, "iconst_0");
926 jvm_generate(p, 2, 1, "aaload");
927 dim -= 1;
928 }
929 jvm_generate(p, 1, 1, "arraylength");
930 }
931
932 static void
933 jvm_generate_array_duplicate_and_replace(gen_proc_t * p, gen_var_t * v, oberon_type_t * arr)
934 {
935 jvm_generate_ldst_prepare(p, v);
936
937 int dim = 0;
938 oberon_type_t * base = arr;
939 while(base -> class == OBERON_TYPE_ARRAY)
940 {
941 if(base -> size == 0)
942 {
943 jvm_generate_load(p, v);
944 jvm_generate_array_len(p, dim);
945 dim += 1;
946 }
947 base = base -> base;
948 }
949
950 jvm_generate_new(p, arr, dim);
951 jvm_generate(p, 1, 2, "dup");
952 jvm_generate_load(p, v);
953 jvm_generate_copy_array(p, arr);
954 jvm_generate_store(p, v);
955 }
956
957 static void
958 jvm_generate_record_duplicate_and_replace(gen_proc_t * p, gen_var_t * v, oberon_type_t * rec)
959 {
960 jvm_generate_ldst_prepare(p, v);
961 jvm_generate_new(p, rec, 0);
962 jvm_generate(p, 1, 2, "dup");
963 jvm_generate_load(p, v);
964 jvm_generate_copy_record(p, rec);
965 jvm_generate_store(p, v);
966 }
967
968 static void
969 jvm_generate_local_object(gen_proc_t * p, oberon_object_t * x)
970 {
971 gen_var_t * v;
972 struct gen_class * class;
973
974 v = x -> gen_var;
975 class = p -> class;
976
977 // Убеждаемся что сейчас находимся в функции
978 assert(class -> p);
979 assert(x -> local);
980
981 switch(x -> class)
982 {
983 case OBERON_CLASS_VAR_PARAM:
984 case OBERON_CLASS_PARAM:
985 case OBERON_CLASS_VAR:
986 jvm_generate_var(v);
987 break;
988 case OBERON_CLASS_CONST:
989 case OBERON_CLASS_TYPE:
990 case OBERON_CLASS_PROC:
991 break;
992 default:
993 gen_error("jvm_generate_local_initialization: wat class %i", x -> class);
994 break;
995 }
996 }
997
998 static void
999 jvm_generate_local_initialization(gen_proc_t * p, oberon_object_t * x)
1000 {
1001 gen_var_t * v;
1002 struct gen_class * class;
1003
1004 v = x -> gen_var;
1005 class = p -> class;
1006
1007 // Убеждаемся что сейчас находимся в функции
1008 assert(class -> p);
1009 assert(x -> local);
1010
1011 switch(x -> class)
1012 {
1013 case OBERON_CLASS_VAR_PARAM:
1014 jvm_generate_var_initialization(p, v);
1015 break;
1016 case OBERON_CLASS_PARAM:
1017 jvm_generate_var_initialization(p, v);
1018 if(x -> type -> class == OBERON_TYPE_ARRAY)
1019 {
1020 jvm_generate_array_duplicate_and_replace(p, v, x -> type);
1021 }
1022 else if(x -> type -> class == OBERON_TYPE_RECORD)
1023 {
1024 jvm_generate_record_duplicate_and_replace(p, v, x -> type);
1025 }
1026 break;
1027 case OBERON_CLASS_VAR:
1028 jvm_generate_var_initialization(p, v);
1029 oberon_generate_static_initialization(p, x);
1030 break;
1031 case OBERON_CLASS_CONST:
1032 case OBERON_CLASS_TYPE:
1033 case OBERON_CLASS_PROC:
1034 break;
1035 default:
1036 gen_error("jvm_generate_local_initialization: wat class %i", x -> class);
1037 break;
1038 }
1039 }
1040
1041 void
1042 oberon_generate_begin_proc(oberon_context_t * ctx, oberon_object_t * proc)
1043 {
1044 gen_proc_t * p;
1045 char * name;
1046 char * signature;
1047 oberon_object_t * var;
1048
1049 p = proc -> gen_proc;
1050
1051 if(proc -> local)
1052 {
1053 signature = jvm_get_local_procedure_signature(proc);
1054 }
1055 else
1056 {
1057 oberon_generate_procedure_pointer_class(p -> class -> dir, proc);
1058 signature = jvm_get_procedure_signature(proc -> type);
1059 }
1060
1061 name = jvm_get_name(proc);
1062 jvm_generate_function_header(p, "public static", name, signature);
1063
1064 if(proc -> local)
1065 {
1066 jvm_generate_staticlinks(proc);
1067 }
1068
1069 jvm_generate_procedure_frame(proc);
1070
1071 /* Создание параметров и переменных */
1072 var = proc -> scope -> list -> next;
1073 while(var)
1074 {
1075 jvm_generate_local_object(p, var);
1076 var = var -> next;
1077 }
1078
1079 jvm_generate_frame_initialization(p);
1080
1081 /* Инициализация парамеров и переменных */
1082 var = proc -> scope -> list -> next;
1083 while(var)
1084 {
1085 jvm_generate_local_initialization(p, var);
1086 var = var -> next;
1087 }
1088 }
1089
1090 void
1091 oberon_generate_end_proc(oberon_context_t * ctx)
1092 {
1093 gen_module_t * m;
1094 gen_proc_t * p;
1095
1096 m = ctx -> mod -> gen_mod;
1097 p = m -> class -> p;
1098
1099 oberon_generate_trap(ctx, -4);
1100 jvm_generate_function_end(p);
1101 }
1102
1103 gen_label_t *
1104 oberon_generator_reserve_label(oberon_context_t * ctx)
1105 {
1106 gen_module_t * m;
1107 gen_proc_t * p;
1108 gen_label_t * l;
1109
1110 m = ctx -> mod -> gen_mod;
1111 p = m -> class -> p;
1112
1113 l = GC_MALLOC(sizeof *l);
1114 memset(l, 0, sizeof *l);
1115
1116 l -> id = jvm_new_label_id(p);
1117 return l;
1118 }
1119
1120 void
1121 oberon_generate_label(oberon_context_t * ctx, gen_label_t * l)
1122 {
1123 gen_module_t * m;
1124 gen_proc_t * p;
1125
1126 m = ctx -> mod -> gen_mod;
1127 p = m -> class -> p;
1128
1129 jvm_generate_label(p, l -> id);
1130 }
1131
1132 void
1133 oberon_generate_goto(oberon_context_t * ctx, gen_label_t * l)
1134 {
1135 gen_module_t * m;
1136 gen_proc_t * p;
1137
1138 m = ctx -> mod -> gen_mod;
1139 p = m -> class -> p;
1140
1141 jvm_generate(p, 0, 0, "goto L%i", l -> id);
1142 }
1143
1144 void
1145 oberon_generate_branch(oberon_context_t * ctx, oberon_expr_t * cond, bool gotoif, gen_label_t * l)
1146 {
1147 gen_module_t * m;
1148 gen_proc_t * p;
1149
1150 m = ctx -> mod -> gen_mod;
1151 p = m -> class -> p;
1152
1153 push_expr(p, cond);
1154
1155 if(gotoif == false)
1156 {
1157 /* переход если false */
1158 jvm_generate(p, 1, 0, "ifeq L%i", l -> id);
1159 }
1160 else
1161 {
1162 /* переход если true */
1163 jvm_generate(p, 1, 0, "ifne L%i", l -> id);
1164 }
1165 }
1166
1167 static void
1168 push_varptr(gen_proc_t * p, oberon_expr_t * expr)
1169 {
1170 assert(expr -> is_item);
1171
1172 switch(expr -> item.mode)
1173 {
1174 case MODE_VAR:
1175 jvm_generate_ldst_prepare(p, expr -> item.var -> gen_var);
1176 break;
1177 case MODE_INDEX:
1178 push_item(p, expr -> item.parent);
1179 push_expr(p, expr -> item.args);
1180 check_index(p, expr -> item.args -> result);
1181 break;
1182 case MODE_FIELD:
1183 push_item(p, expr -> item.parent);
1184 jvm_generate_ldst_prepare(p, expr -> item.var -> gen_var);
1185 break;
1186 case MODE_DEREF:
1187 push_varptr(p, (oberon_expr_t *) expr -> item.parent);
1188 break;
1189 default:
1190 gen_error("push_varptr: wat %i", expr -> item.mode);
1191 break;
1192 }
1193 }
1194
1195 static void
1196 jvm_generate_call_proc(gen_proc_t * p, oberon_item_t * desig)
1197 {
1198 assert(desig -> var == NULL);
1199 assert(desig -> mode == MODE_CALL);
1200
1201 bool direct_call = false;
1202 if(desig -> parent -> mode == MODE_VAR)
1203 {
1204 if(desig -> parent -> var -> class == OBERON_CLASS_PROC)
1205 {
1206 direct_call = true;
1207 }
1208 }
1209
1210 oberon_type_t * procsig;
1211 procsig = desig -> parent -> result;
1212
1213 if(direct_call == false)
1214 {
1215 /* Загружаем указатель на процедуру */
1216 push_item(p, desig -> parent);
1217 }
1218
1219 if(direct_call)
1220 {
1221 jvm_generate_push_static_links(p, desig -> parent -> var);
1222 }
1223
1224 int args_cells = 0;
1225 int result_cells = jvm_cell_size_for_type(procsig -> base);
1226
1227 int num = desig -> num_args;
1228 oberon_expr_t * arg = desig -> args;
1229 oberon_object_t * param = procsig -> decl;
1230 for(int i = 0; i < num; i++)
1231 {
1232 if(param -> class == OBERON_CLASS_VAR_PARAM)
1233 {
1234 args_cells += 2;
1235 push_varptr(p, arg);
1236 }
1237 else
1238 {
1239 args_cells += jvm_cell_size_for_type(arg -> result);
1240 push_expr(p, arg);
1241 }
1242 arg = arg -> next;
1243 param = param -> next;
1244 }
1245
1246 if(direct_call)
1247 {
1248 char * full_name = jvm_get_field_full_name(desig -> parent -> var);
1249 char * signature = jvm_get_local_procedure_signature(desig -> parent -> var);
1250 jvm_generate(p, args_cells, result_cells, "invokestatic %s%s", full_name, signature);
1251 }
1252 else
1253 {
1254 char * cname = jvm_get_class_full_name(procsig);
1255 char * signature = jvm_get_procedure_signature(procsig);
1256 jvm_generate(p, 1 + args_cells, result_cells, "invokevirtual %s/invoke%s", cname, signature);
1257 }
1258 }
1259
1260 void
1261 oberon_generate_call_proc(oberon_context_t * ctx, oberon_expr_t * desig)
1262 {
1263 assert(desig -> is_item);
1264 jvm_generate_call_proc(ctx -> mod -> gen_mod -> class -> p, (oberon_item_t *) desig);
1265 }
1266
1267 void
1268 oberon_generate_return(oberon_context_t * ctx, oberon_expr_t * expr)
1269 {
1270 gen_module_t * m;
1271 gen_proc_t * p;
1272 char prefix;
1273 int cell_size;
1274
1275 m = ctx -> mod -> gen_mod;
1276 p = m -> class -> p;
1277
1278 if(expr)
1279 {
1280 push_expr(p, expr);
1281 prefix = jvm_get_prefix(expr -> result);
1282 cell_size = jvm_cell_size_for_type(expr -> result);
1283 jvm_generate(p, cell_size, 0, "%creturn", prefix);
1284 }
1285 else
1286 {
1287 jvm_generate(p, 0, 0, "return");
1288 }
1289 }
1290
1291 static void
1292 jvm_generate_expr_new_pointer(gen_proc_t * p, oberon_type_t * type, int num, oberon_expr_t * arg)
1293 {
1294 assert(type -> class == OBERON_TYPE_POINTER);
1295
1296 for(int i = 0; i < num; i++)
1297 {
1298 push_expr(p, arg);
1299 check_index(p, arg -> result);
1300 arg = arg -> next;
1301 }
1302
1303 jvm_generate_new(p, type -> base, num);
1304 }
1305
1306 static void
1307 push_item(gen_proc_t * p, oberon_item_t * item)
1308 {
1309 switch(item -> mode)
1310 {
1311 case MODE_VAR:
1312 if(item -> var -> class == OBERON_CLASS_PROC)
1313 {
1314 jvm_generate_push_procedure_pointer(p, item -> var);
1315 }
1316 else
1317 {
1318 jvm_generate_load(p, item -> var -> gen_var);
1319 }
1320 break;
1321 case MODE_INTEGER:
1322 case MODE_BOOLEAN:
1323 case MODE_CHAR:
1324 case MODE_SET:
1325 jvm_generate_push_int_size(p, item -> integer, item -> result -> size);
1326 break;
1327 case MODE_CALL:
1328 jvm_generate_call_proc(p, item);
1329 break;
1330 case MODE_INDEX:
1331 ;
1332 char postfix = jvm_get_postfix(item -> result);
1333 int cell_size = jvm_cell_size_for_postfix(postfix);
1334 push_item(p, item -> parent);
1335 push_expr(p, item -> args);
1336 check_index(p, item -> args -> result);
1337 jvm_generate(p, 1 + 1, cell_size, "%caload", postfix);
1338 break;
1339 case MODE_FIELD:
1340 push_item(p, item -> parent);
1341 jvm_generate_load(p, item -> var -> gen_var);
1342 break;
1343 case MODE_DEREF:
1344 /* Все объекты в jvm представляются как указатели */
1345 push_item(p, item -> parent);
1346 break;
1347 case MODE_NIL:
1348 jvm_generate(p, 0, 1, "aconst_null");
1349 break;
1350 case MODE_NEW:
1351 jvm_generate_expr_new_pointer(p, item -> result, item -> num_args, item -> args);
1352 break;
1353 case MODE_REAL:
1354 jvm_generate_push_float(p, item -> real, item -> result -> size);
1355 break;
1356 case MODE_STRING:
1357 jvm_generate_push_string(p, item -> string, item -> result -> size);
1358 break;
1359 case MODE_LEN:
1360 push_item(p, item -> parent);
1361 jvm_generate_array_len(p, item -> integer);
1362 jvm_generate_cast_prefix(p, 'i', jvm_get_postfix(item -> result));
1363 break;
1364 case MODE_AS:
1365 push_item(p, item -> parent);
1366 jvm_generate_cast_type(p, item -> parent -> result, item -> result);
1367 break;
1368 default:
1369 gen_error("push_item: unk mode %i", item -> mode);
1370 break;
1371 }
1372 }
1373
1374 static void
1375 jvm_generate_logical_not(gen_proc_t * p)
1376 {
1377 int label_done = jvm_new_label_id(p);
1378 int label_false = jvm_new_label_id(p);
1379
1380 jvm_generate(p, 1, 0, "ifne L%i", label_false);
1381 jvm_generate(p, 0, 1, "iconst_1");
1382 jvm_generate(p, 0, 0, "goto L%i", label_done);
1383 jvm_generate_label(p, label_false);
1384 jvm_generate(p, 0, 1, "iconst_0");
1385 jvm_generate_label(p, label_done);
1386 }
1387
1388 static void
1389 jvm_generate_abs(gen_proc_t * p, char prefix)
1390 {
1391 char t = jvm_get_type_of_prefix(prefix);
1392 int cell_size = jvm_cell_size_for_postfix(prefix);
1393 jvm_generate(p, cell_size, cell_size, "invokestatic java/lang/Math/abs(%c)%c", t, t);
1394 }
1395
1396 static char *
1397 jvm_get_compare_postfix(int op)
1398 {
1399 char * cmpop = "";
1400 switch(op)
1401 {
1402 case OP_EQ:
1403 cmpop = "eq";
1404 break;
1405 case OP_NEQ:
1406 cmpop = "ne";
1407 break;
1408 case OP_LSS:
1409 cmpop = "lt";
1410 break;
1411 case OP_LEQ:
1412 cmpop = "le";
1413 break;
1414 case OP_GRT:
1415 cmpop = "gt";
1416 break;
1417 case OP_GEQ:
1418 cmpop = "ge";
1419 break;
1420 default:
1421 gen_error("jvm_generate_compare_op: wat");
1422 break;
1423 }
1424 return cmpop;
1425 }
1426
1427 static void
1428 jvm_generate_compare_op(gen_proc_t * p, oberon_type_t * t, int op)
1429 {
1430 char prefix = jvm_get_prefix(t);
1431 int label_true = jvm_new_label_id(p);
1432 int label_done = jvm_new_label_id(p);
1433 int cell_size = jvm_cell_size_for_type(t);
1434 char * cmpop = jvm_get_compare_postfix(op);
1435
1436 if(prefix == 'l')
1437 {
1438 jvm_generate(p, 2 * cell_size, 1, "lcmp");
1439 jvm_generate(p, 1, 1, "if%s L%i", cmpop, label_true);
1440 }
1441 else if(prefix == 'f' || prefix == 'd')
1442 {
1443 char fop;
1444 if(op == OP_EQ || op == OP_NEQ || op == OP_GRT || op == OP_GEQ)
1445 {
1446 fop = 'l';
1447 }
1448 else
1449 {
1450 fop = 'g';
1451 }
1452 jvm_generate(p, 2 * cell_size, 1, "%ccmp%c", prefix, fop);
1453 jvm_generate(p, 1, 1, "if%s L%i", cmpop, label_true);
1454 }
1455 else if(prefix == 'a')
1456 {
1457 if(t -> class == OBERON_TYPE_STRING
1458 || (t -> class == OBERON_TYPE_POINTER && t -> base -> class == OBERON_TYPE_CHAR))
1459 {
1460 jvm_generate(p, 2, 1, "invokestatic SYSTEM/STRCMP([B[B)I");
1461 jvm_generate(p, 1, 0, "if%s L%i", cmpop, label_true);
1462 }
1463 else
1464 {
1465 jvm_generate(p, 1, 0, "if_acmp%s L%i", cmpop, label_true);
1466 }
1467 }
1468 else
1469 {
1470 jvm_generate(p, 2 * cell_size, 0, "if_%ccmp%s L%i", prefix, cmpop, label_true);
1471 }
1472
1473 jvm_generate(p, 0, 1, "iconst_0");
1474 jvm_generate(p, 0, 0, "goto L%i", label_done);
1475 jvm_generate_label(p, label_true);
1476 jvm_generate(p, 0, 1, "iconst_1");
1477 jvm_generate_label(p, label_done);
1478 }
1479
1480 static void
1481 jvm_generate_operator(gen_proc_t * p, oberon_type_t * t, int op)
1482 {
1483 char prefix = jvm_get_prefix(t);
1484 int cell_size = jvm_cell_size_for_type(t);
1485 switch(op)
1486 {
1487 case OP_UNARY_MINUS:
1488 jvm_generate(p, cell_size, cell_size, "%cneg", prefix);
1489 break;
1490 case OP_COMPLEMENTATION:
1491 jvm_generate_push_int_size(p, -1, t -> size);
1492 jvm_generate(p, 2 * cell_size, cell_size, "%cxor", prefix);
1493 break;
1494 case OP_LOGIC_NOT:
1495 jvm_generate_logical_not(p);
1496 break;
1497 case OP_ABS:
1498 jvm_generate_abs(p, prefix);
1499 break;
1500 case OP_CAP:
1501 jvm_generate(p, cell_size, cell_size, "invokestatic java/lang/Character/toUpperCase(I)I");
1502 break;
1503
1504 case OP_ADD:
1505 jvm_generate(p, 2 * cell_size, cell_size, "%cadd", prefix);
1506 break;
1507 case OP_SUB:
1508 jvm_generate(p, 2 * cell_size, cell_size, "%csub", prefix);
1509 break;
1510 case OP_MUL:
1511 jvm_generate(p, 2 * cell_size, cell_size, "%cmul", prefix);
1512 break;
1513 case OP_DIV:
1514 jvm_generate(p, 2 * cell_size, cell_size, "%cdiv", prefix);
1515 break;
1516 case OP_MOD:
1517 jvm_generate(p, 2 * cell_size, cell_size, "%crem", prefix);
1518 break;
1519 case OP_UNION:
1520 jvm_generate(p, 2 * cell_size, cell_size, "%cor", prefix);
1521 break;
1522 case OP_INTERSECTION:
1523 jvm_generate(p, 2 * cell_size, cell_size, "%cand", prefix);
1524 break;
1525 case OP_DIFFERENCE:
1526 /* (a - b) == a & ~b */
1527 jvm_generate_push_int_size(p, -1, t -> size);
1528 jvm_generate(p, 2 * cell_size, cell_size, "%cxor", prefix);
1529 jvm_generate(p, 2 * cell_size, cell_size, "%cand", prefix);
1530 break;
1531 case OP_SYM_DIFFERENCE:
1532 jvm_generate(p, 2 * cell_size, cell_size, "%cxor", prefix);
1533 break;
1534
1535 case OP_EQ:
1536 case OP_NEQ:
1537 case OP_LSS:
1538 case OP_LEQ:
1539 case OP_GRT:
1540 case OP_GEQ:
1541 jvm_generate_compare_op(p, t, op);
1542 break;
1543 default:
1544 gen_error("jvm_generate_operator: unk op %i", op);
1545 break;
1546 }
1547 }
1548
1549 static void
1550 jvm_generate_logical_or(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b)
1551 {
1552 int label_calc_b = jvm_new_label_id(p);
1553 int label_done = jvm_new_label_id(p);
1554
1555 /* a OR b -- если a, то TRUE, иначе b */
1556
1557 push_expr(p, a);
1558 jvm_generate(p, 1, 0, "ifeq L%i", label_calc_b);
1559 jvm_generate(p, 0, 1, "iconst_1");
1560 jvm_generate(p, 0, 0, "goto L%i", label_done);
1561 jvm_generate_label(p, label_calc_b);
1562 push_expr(p, b);
1563 jvm_generate_label(p, label_done);
1564 }
1565
1566 static void
1567 jvm_generate_logical_and(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b)
1568 {
1569 int label_false = jvm_new_label_id(p);
1570 int label_done = jvm_new_label_id(p);
1571
1572 /* a AND b -- если a, то b, иначе FALSE */
1573
1574 push_expr(p, a);
1575 jvm_generate(p, 1, 0, "ifeq L%i", label_false);
1576 push_expr(p, b);
1577 jvm_generate(p, 0, 0, "goto L%i", label_done);
1578 jvm_generate_label(p, label_false);
1579 jvm_generate(p, 0, 1, "iconst_0");
1580 jvm_generate_label(p, label_done);
1581 }
1582
1583 static void
1584 jvm_generate_range(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b)
1585 {
1586 /* { a } == 1 << a */
1587 /* { a..b } == (a <= b) ? ((2 << b) - (1 << a)) : (0); */
1588
1589 char prefix;
1590 int cell_size;
1591 oberon_type_t * type;
1592 gen_var_t * ra;
1593 gen_var_t * rb;
1594 int label_else;
1595 int label_end;
1596
1597 type = a -> result;
1598 cell_size = jvm_cell_size_for_type(type);
1599 prefix = jvm_get_prefix(type);
1600
1601 if(b == NULL)
1602 {
1603 jvm_generate_push_int_size(p, 1, type -> size);
1604 push_expr(p, a);
1605 jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix);
1606 }
1607 else
1608 {
1609 ra = jvm_create_function_temp_var(p, type -> gen_type);
1610 rb = jvm_create_function_temp_var(p, type -> gen_type);
1611 jvm_generate_var(ra);
1612 jvm_generate_var(rb);
1613 jvm_generate_var_initialization(p, ra);
1614 jvm_generate_var_initialization(p, rb);
1615 label_else = jvm_new_label_id(p);
1616 label_end = jvm_new_label_id(p);
1617
1618 push_expr(p, a);
1619 jvm_generate_store(p, ra);
1620 push_expr(p, b);
1621 jvm_generate_store(p, rb);
1622
1623 jvm_generate_load(p, ra);
1624 jvm_generate_load(p, rb);
1625 jvm_generate(p, 2 * cell_size, 0, "if_%ccmpgt L%i", prefix, label_else);
1626
1627 jvm_generate_push_int_size(p, 2, type -> size);
1628 jvm_generate_load(p, rb);
1629 jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix);
1630 jvm_generate_push_int_size(p, 2, type -> size);
1631 jvm_generate_load(p, ra);
1632 jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix);
1633 jvm_generate(p, 2 * cell_size, cell_size, "%csub", prefix);
1634 jvm_generate(p, 0, 0, "goto L%i", label_end);
1635
1636 jvm_generate_label(p, label_else);
1637 jvm_generate_push_int_size(p, 0, type -> size);
1638 jvm_generate_label(p, label_end);
1639 }
1640
1641 /* TODO free registers */
1642 }
1643
1644 static void
1645 jvm_generate_in(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b)
1646 {
1647 oberon_type_t * t = a -> result;
1648 int cell_size = jvm_cell_size_for_type(t);
1649 char prefix = jvm_get_prefix(t);
1650 int label_else = jvm_new_label_id(p);
1651 int label_end = jvm_new_label_id(p);
1652
1653 /* (a IN b) == (1 << a) & b */
1654 jvm_generate_push_int_size(p, 1, t -> size);
1655 push_expr(p, a);
1656 jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix);
1657 push_expr(p, b);
1658 jvm_generate(p, 2 * cell_size, cell_size, "%cand", prefix);
1659
1660 if(cell_size > 1)
1661 {
1662 jvm_generate(p, cell_size, 0, "lcmp");
1663 }
1664
1665 jvm_generate(p, 1, 0, "ifeq L%i", label_else);
1666 jvm_generate(p, 0, 1, "iconst_1");
1667 jvm_generate(p, 0, 0, "goto L%i", label_end);
1668 jvm_generate_label(p, label_else);
1669 jvm_generate(p, 0, 1, "iconst_0");
1670 jvm_generate_label(p, label_end);
1671 }
1672
1673 static void
1674 jvm_generate_shift(gen_proc_t * p, int op, oberon_expr_t * a, oberon_expr_t * b)
1675 {
1676 oberon_type_t * t = a -> result;
1677 int cell_size = jvm_cell_size_for_type(t);
1678 char prefix = jvm_get_prefix(t);
1679 char dt = jvm_get_type_of_prefix(prefix);
1680
1681 push_expr(p, a);
1682 jvm_generate_cast_type(p, a -> result, t);
1683 push_expr(p, b);
1684 jvm_generate_cast_type(p, b -> result, t);
1685
1686 char * opname;
1687 switch(op)
1688 {
1689 case OP_ASH:
1690 opname = "ASH";
1691 break;
1692 case OP_LSH:
1693 opname = "LSH";
1694 break;
1695 case OP_ROT:
1696 opname = "ROT";
1697 break;
1698 default:
1699 gen_error("jvm_generate_shift: invalid op %i", op);
1700 }
1701
1702 jvm_generate(p, 2 * cell_size, cell_size, "invokestatic SYSTEM/%s(%c%c)%c", opname, dt, dt, dt);
1703 }
1704
1705 static void
1706 jvm_generate_entier(gen_proc_t * p, oberon_expr_t * x, oberon_type_t * res)
1707 {
1708 char prefix = jvm_get_prefix(x -> result);
1709 char postfix = jvm_get_postfix(res);
1710
1711 push_expr(p, x);
1712 jvm_generate_cast_prefix(p, prefix, 'd');
1713 jvm_generate(p, 2, 2, "invokestatic java/lang/Math/floor(D)D");
1714 jvm_generate_cast_prefix(p, 'd', postfix);
1715 }
1716
1717 static void
1718 push_operator(gen_proc_t * p, oberon_oper_t * oper)
1719 {
1720 oberon_type_t * preq = oper -> left -> result;
1721 int op = oper -> op;
1722 switch(op)
1723 {
1724 case OP_CAST:
1725 push_expr(p, oper -> left);
1726 jvm_generate_cast_type(p, oper -> left -> result, oper -> result);
1727 break;
1728 case OP_HARDCAST:
1729 push_expr(p, oper -> left);
1730 jvm_generate_hard_cast_type(p, oper -> left -> result, oper -> result);
1731 break;
1732 case OP_COMPLEMENTATION:
1733 case OP_UNARY_MINUS:
1734 case OP_LOGIC_NOT:
1735 case OP_ABS:
1736 case OP_CAP:
1737 push_expr(p, oper -> left);
1738 jvm_generate_operator(p, preq, op);
1739 break;
1740 case OP_ENTIER:
1741 jvm_generate_entier(p, oper -> left, oper -> result);
1742 break;
1743
1744 case OP_ADD:
1745 case OP_SUB:
1746 case OP_MUL:
1747 case OP_DIV:
1748 case OP_MOD:
1749
1750 case OP_UNION:
1751 case OP_INTERSECTION:
1752 case OP_DIFFERENCE:
1753 case OP_SYM_DIFFERENCE:
1754
1755 case OP_EQ:
1756 case OP_NEQ:
1757 case OP_LSS:
1758 case OP_LEQ:
1759 case OP_GRT:
1760 case OP_GEQ:
1761 push_expr(p, oper -> left);
1762 push_expr(p, oper -> right);
1763 jvm_generate_operator(p, preq, op);
1764 break;
1765
1766 case OP_LOGIC_OR:
1767 jvm_generate_logical_or(p, oper -> left, oper -> right);
1768 break;
1769 case OP_LOGIC_AND:
1770 jvm_generate_logical_and(p, oper -> left, oper -> right);
1771 break;
1772
1773 case OP_IS:
1774 preq = oper -> right -> result;
1775 char * cname = jvm_get_class_full_name(preq);
1776 push_expr(p, oper -> left);
1777 jvm_generate(p, 1, 1, "instanceof %s", cname);
1778 break;
1779 case OP_RANGE:
1780 jvm_generate_range(p, oper -> left, oper -> right);
1781 break;
1782 case OP_IN:
1783 jvm_generate_in(p, oper -> left, oper -> right);
1784 break;
1785
1786 case OP_ASH:
1787 case OP_LSH:
1788 case OP_ROT:
1789 jvm_generate_shift(p, op, oper -> left, oper -> right);
1790 break;
1791 default:
1792 gen_error("push_oper: unk op %i", op);
1793 break;
1794 }
1795 }
1796
1797 static void
1798 push_expr(gen_proc_t * p, oberon_expr_t * expr)
1799 {
1800 if(expr -> is_item)
1801 {
1802 push_item(p, (oberon_item_t *) expr);
1803 }
1804 else
1805 {
1806 push_operator(p, (oberon_oper_t *) expr);
1807 }
1808 }
1809
1810 static void
1811 store_expr(gen_proc_t * p, oberon_expr_t * dst, oberon_expr_t * src)
1812 {
1813 assert(dst -> is_item);
1814 oberon_item_t * item = (oberon_item_t *) dst;
1815
1816 if(dst -> result -> class == OBERON_TYPE_ARRAY
1817 || src -> result -> class == OBERON_TYPE_ARRAY)
1818 {
1819 push_expr(p, dst);
1820 push_expr(p, src);
1821 jvm_generate_copy_array(p, dst -> result);
1822 }
1823 else if(dst -> result -> class == OBERON_TYPE_RECORD
1824 || src -> result -> class == OBERON_TYPE_RECORD)
1825 {
1826 push_expr(p, dst);
1827 push_expr(p, src);
1828 jvm_generate_copy_record(p, dst -> result);
1829 }
1830 else switch(item -> mode)
1831 {
1832 case MODE_VAR:
1833 jvm_generate_ldst_prepare(p, item -> var -> gen_var);
1834 push_expr(p, src);
1835 jvm_generate_store(p, item -> var -> gen_var);
1836 break;
1837 case MODE_INDEX:
1838 ;
1839 char postfix = jvm_get_postfix(src -> result);
1840 int cell_size = jvm_cell_size_for_postfix(postfix);
1841 assert(item -> parent -> is_item);
1842 push_item(p, (oberon_item_t *) item -> parent);
1843 push_expr(p, item -> args);
1844 check_index(p, item -> args -> result);
1845 push_expr(p, src);
1846 jvm_generate(p, 1 + 1 + cell_size, 0, "%castore", postfix);
1847 break;
1848 case MODE_FIELD:
1849 assert(item -> parent -> is_item);
1850 push_item(p, (oberon_item_t *) item -> parent);
1851 jvm_generate_ldst_prepare(p, item -> var -> gen_var);
1852 push_expr(p, src);
1853 jvm_generate_store(p, item -> var -> gen_var);
1854 break;
1855 default:
1856 gen_error("store_expr: unk mode %i", item -> mode);
1857 break;
1858 }
1859 }
1860
1861 void
1862 oberon_generate_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
1863 {
1864 gen_module_t * m;
1865 gen_proc_t * p;
1866
1867 m = ctx -> mod -> gen_mod;
1868 p = m -> class -> p;
1869
1870 store_expr(p, dst, src);
1871 }
1872
1873 void
1874 oberon_generate_copy(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
1875 {
1876 gen_module_t * m;
1877 gen_proc_t * p;
1878 char * desc;
1879
1880 m = ctx -> mod -> gen_mod;
1881 p = m -> class -> p;
1882
1883 push_expr(p, src);
1884 push_expr(p, dst);
1885
1886 desc = jvm_get_descriptor(dst -> result);
1887
1888 jvm_generate(p, 2, 0, "invokestatic SYSTEM/COPY(%s%s)V", desc, desc);
1889 }
1890
1891 void
1892 oberon_generate_assert(oberon_context_t * ctx, oberon_expr_t * cond)
1893 {
1894 gen_module_t * m;
1895 gen_proc_t * p;
1896
1897 m = ctx -> mod -> gen_mod;
1898 p = m -> class -> p;
1899
1900 push_expr(p, cond);
1901 jvm_generate(p, 1, 0, "invokestatic SYSTEM/ASSERT(Z)V");
1902 }
1903
1904 void
1905 oberon_generate_assert_n(oberon_context_t * ctx, oberon_expr_t * cond, int64_t n)
1906 {
1907 gen_module_t * m;
1908 gen_proc_t * p;
1909
1910 m = ctx -> mod -> gen_mod;
1911 p = m -> class -> p;
1912
1913 push_expr(p, cond);
1914 jvm_generate_push_int_size(p, n, 8);
1915 jvm_generate(p, 1 + 2, 0, "invokestatic SYSTEM/ASSERT(ZJ)V");
1916 }
1917
1918 void
1919 oberon_generate_trap(oberon_context_t * ctx, int64_t n)
1920 {
1921 gen_module_t * m;
1922 gen_proc_t * p;
1923
1924 m = ctx -> mod -> gen_mod;
1925 p = m -> class -> p;
1926
1927 jvm_generate_push_int_size(p, n, 8);
1928 jvm_generate(p, 2, 0, "invokestatic SYSTEM/TRAP(J)V");
1929 }
1930
1931 void
1932 oberon_generate_halt(oberon_context_t * ctx, int64_t n)
1933 {
1934 gen_module_t * m;
1935 gen_proc_t * p;
1936
1937 m = ctx -> mod -> gen_mod;
1938 p = m -> class -> p;
1939
1940 jvm_generate_push_int_size(p, n, 8);
1941 jvm_generate(p, 2, 0, "invokestatic SYSTEM/HALT(J)V");
1942 }
1943
1944 void
1945 oberon_set_out_directory(oberon_context_t * ctx, const char * path)
1946 {
1947 gen_context_t * c;
1948
1949 c = ctx -> gen_context;
1950
1951 c -> dir = new_string(path);
1952 }
1953
1954 void
1955 oberon_set_typecheck(oberon_object_t * var, bool enable)
1956 {
1957 var -> gen_var -> typecheck = enable;
1958 var -> gen_var -> forcetype = (enable) ? (var -> type -> gen_type) : (NULL);
1959 }
1960
Another attempt to make Oberon compiler
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024