DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / dsw-obn.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Разрешено повторно объявлять блоки CONST TYPE VAR, поправлено сравнение массивов...
[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 "../../oberon-type-compat.h"
13 #include "../../generator.h"
14 #include "generator-jvm.h"
15 #include "generator-jvm-abi.h"
16 #include "generator-jvm-asm.h"
17 #include "generator-jvm-basic.h"
18
19 static void
20 push_item(gen_proc_t * p, oberon_item_t * item);
21
22 static void
23 jvm_generate_new(gen_proc_t * p, oberon_type_t * type, int num);
24
25 static void
26 jvm_generate_cast_prefix(gen_proc_t * p, char prefix, char postfix)
27 {
28 if((prefix == 'b' || prefix == 's') && (postfix = 'l' || postfix == 'd'))
29 {
30 prefix = 'i';
31 }
32
33 if(prefix == postfix)
34 {
35 return;
36 }
37
38 if((prefix == 'l' || prefix == 'd') && (postfix == 'b' || postfix == 's'))
39 {
40 jvm_generate(p, 2, 1, "%c2i", prefix);
41 prefix = 'i';
42 }
43
44 int from_cell_size = jvm_cell_size_for_postfix(prefix);
45 int to_cell_size = jvm_cell_size_for_postfix(postfix);
46 jvm_generate(p, from_cell_size, to_cell_size, "%c2%c", prefix, postfix);
47 }
48
49 static void
50 jvm_generate_cast_type(gen_proc_t * p, oberon_type_t * from, oberon_type_t * to)
51 {
52 if(to -> class == OBERON_TYPE_RECORD || to -> class == OBERON_TYPE_POINTER)
53 {
54 if(to -> class == OBERON_TYPE_POINTER && to -> base -> class == OBERON_TYPE_RECORD)
55 {
56 char * full_name = jvm_get_class_full_name(to);
57 jvm_generate(p, 1, 1, "checkcast %s", full_name);
58 }
59 }
60 else
61 {
62 char prefix = jvm_get_prefix(from);
63 char postfix = jvm_get_postfix(to);
64 jvm_generate_cast_prefix(p, prefix, postfix);
65 }
66 }
67
68 static void
69 jvm_generate_hard_cast_type(gen_proc_t * p, oberon_type_t * from, oberon_type_t * to)
70 {
71 if(from -> class == OBERON_TYPE_REAL
72 && (to -> class == OBERON_TYPE_INTEGER || to -> class == OBERON_TYPE_SYSTEM_BYTE))
73 {
74 char postfix = jvm_get_postfix(to);
75 if(from -> size <= 4)
76 {
77 jvm_generate(p, 1, 1, "invokestatic java/lang/Float/floatToRawIntBits(F)I");
78 jvm_generate_cast_prefix(p, 'i', postfix);
79 }
80 else
81 {
82 jvm_generate(p, 2, 2, "invokestatic java/lang/Double/doubleToRawLongBits(D)J");
83 jvm_generate_cast_prefix(p, 'l', postfix);
84 }
85 }
86 else if((from -> class == OBERON_TYPE_INTEGER || from -> class == OBERON_TYPE_SYSTEM_BYTE)
87 && to -> class == OBERON_TYPE_REAL)
88 {
89 char prefix = jvm_get_prefix(from);
90 if(to -> size <= 4)
91 {
92 jvm_generate_cast_prefix(p, prefix, 'i');
93 jvm_generate(p, 1, 1, "invokestatic java/lang/Float/intBitsToFloat(I)F");
94 }
95 else
96 {
97 jvm_generate_cast_prefix(p, prefix, 'l');
98 jvm_generate(p, 2, 2, "invokestatic java/lang/Double/longBitsToDouble(J)D");
99 }
100 }
101 else
102 {
103 jvm_generate_cast_type(p, from, to);
104 }
105 }
106
107 static void
108 check_index(gen_proc_t * p, oberon_type_t * index_type)
109 {
110 // TODO проверка валидности границ
111 char prefix = jvm_get_prefix(index_type);
112 jvm_generate_cast_prefix(p, prefix, 'i');
113 }
114
115 /*
116 * Генерирует код для инициализации массива со статическим базовым типом
117 * ( aref -- )
118 */
119
120 static void
121 jvm_generate_array_initialization(gen_proc_t * p, oberon_type_t * arr)
122 {
123 int dim = 0;
124 oberon_type_t * base = arr;
125 while(base -> class == OBERON_TYPE_ARRAY)
126 {
127 dim += 1;
128 base = base -> base;
129 }
130
131 if(base -> class != OBERON_TYPE_RECORD)
132 {
133 jvm_generate(p, 1, 0, "pop");
134 return;
135 }
136
137 struct {
138 int reg_index;
139 int reg_length;
140 int start;
141 int end;
142 } loop[dim];
143
144 int reg_dst;
145 reg_dst = jvm_alloc_register_untyped(p -> rf, false);
146 jvm_generate(p, 1, 0, "astore %i", reg_dst);
147
148 /*
149 * Входящие параметры заграблены.
150 * Теперь генерируем эквивалентный код:
151 * int i = 0;
152 * int len = dst.length
153 * while(i < len)
154 * {
155 * ...
156 * {
157 * dst[i, ...] = new record;
158 * }
159 * ...
160 * i += 1;
161 * }
162 * Где "..." такой же код (начало и конец) для следующей размерности.
163 */
164
165 for(int i = 0; i < dim; i++)
166 {
167 loop[i].reg_index = jvm_alloc_register_untyped(p -> rf, false);
168 loop[i].reg_length = jvm_alloc_register_untyped(p -> rf, false);
169 loop[i].start = jvm_new_label_id(p);
170 loop[i].end = jvm_new_label_id(p);
171
172 jvm_generate(p, 0, 1, "iconst_0");
173 jvm_generate(p, 1, 0, "istore %i", loop[i].reg_index);
174
175 jvm_generate(p, 0, 1, "aload %i", reg_dst);
176 jvm_generate(p, 1, 1, "arraylength");
177 jvm_generate(p, 1, 0, "istore %i", loop[i].reg_length);
178
179 /* if(i >= len) goto end; */
180 jvm_generate_label(p, loop[i].start);
181 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_index);
182 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_length);
183 jvm_generate(p, 2, 0, "if_icmpge L%i", loop[i].end);
184 }
185
186 jvm_generate(p, 0, 1, "aload %i", reg_dst);
187 jvm_generate(p, 0, 1, "iload %i", loop[0].reg_index);
188 for(int i = 1; i < dim; i++)
189 {
190 jvm_generate(p, 2, 1, "aaload");
191 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_index);
192 }
193 jvm_generate_new(p, base, 0);
194 jvm_generate(p, 3, 0, "aastore");
195
196 for(int i = dim - 1; i >= 0; i--)
197 {
198 jvm_generate(p, 0, 0, "iinc %i 1", loop[i].reg_index);
199 jvm_generate(p, 0, 0, "goto L%i", loop[i].start);
200 jvm_generate_label(p, loop[i].end);
201 }
202 }
203
204 static void
205 jvm_generate_new(gen_proc_t * p, oberon_type_t * type, int num)
206 {
207 int dim;
208 char * cname;
209 char * desc;
210 oberon_type_t * base;
211
212 switch(type -> class)
213 {
214 case OBERON_TYPE_INTEGER:
215 case OBERON_TYPE_BOOLEAN:
216 case OBERON_TYPE_PROCEDURE:
217 case OBERON_TYPE_REAL:
218 case OBERON_TYPE_POINTER:
219 gen_error("jvm_generate_new_static: static alocation not allowed");
220 break;
221 case OBERON_TYPE_RECORD:
222 assert(num == 0);
223 cname = jvm_get_class_full_name(type);
224 jvm_generate(p, 0, 1, "new %s", cname);
225 jvm_generate(p, 1, 2, "dup");
226 jvm_generate(p, 1, 0, "invokespecial %s/<init>()V", cname);
227 break;
228 case OBERON_TYPE_ARRAY:
229 dim = 0;
230 base = type;
231 desc = jvm_get_descriptor(type);
232 while(base -> class == OBERON_TYPE_ARRAY)
233 {
234 if(num > 0)
235 {
236 assert(base -> size == 0);
237 num -= 1;
238 }
239 else
240 {
241 assert(base -> size > 0);
242 jvm_generate_push_int(p, base -> size);
243 }
244 dim += 1;
245 base = base -> base;
246 }
247
248 assert(num == 0);
249 jvm_generate(p, dim, 1, "multianewarray %s %i", desc, dim);
250 jvm_generate(p, 1, 2, "dup");
251 jvm_generate_array_initialization(p, type);
252 break;
253 default:
254 gen_error("jvm_generate_new_static: unk type class %i", type -> class);
255 break;
256 }
257 }
258
259 /*
260 * Генерирует код для копирования полей из первой записи во вторую.
261 * ( aref_dst aref_src -- )
262 * dst := src;
263 */
264
265 static void
266 jvm_generate_copy_record(gen_proc_t * p, oberon_type_t * rec)
267 {
268 assert(rec -> class == OBERON_TYPE_RECORD);
269 char * desc = jvm_get_descriptor(rec);
270 char * cname = jvm_get_class_full_name(rec);
271 jvm_generate(p, 1 + 1, 0, "invokestatic %s/$COPY$(%s%s)V", cname, desc, desc);
272 }
273
274 /*
275 * Генерирует кода для копирования массивов.
276 * ( aref_dst aref_src -- )
277 * dst := src;
278 */
279
280 static void
281 jvm_generate_copy_array(gen_proc_t * p, oberon_type_t * arr)
282 {
283 int dim = 0;
284 oberon_type_t * base = arr;
285 while(base -> class == OBERON_TYPE_ARRAY)
286 {
287 dim += 1;
288 base = base -> base;
289 }
290
291 struct {
292 int reg_index;
293 int reg_length;
294 int start;
295 int end;
296 } loop[dim];
297
298 int reg_dst = jvm_alloc_register_untyped(p -> rf, false);
299 int reg_src = jvm_alloc_register_untyped(p -> rf, false);
300 jvm_generate(p, 1, 0, "astore %i", reg_src);
301 jvm_generate(p, 1, 0, "astore %i", reg_dst);
302
303 /*
304 * Входящие параметры заграблены.
305 * Теперь генерируем эквивалентный код:
306 * int i = 0;
307 * int len = src.length
308 * while(i < len)
309 * {
310 * ...
311 * {
312 * copy from src[i, ...] to dst[i, ...];
313 * }
314 * ...
315 * i += 1;
316 * }
317 * Где "..." такой же код (начало и конец) для следующей размерности.
318 */
319
320 for(int i = 0; i < dim; i++)
321 {
322 loop[i].reg_index = jvm_alloc_register_untyped(p -> rf, false);
323 loop[i].reg_length = jvm_alloc_register_untyped(p -> rf, false);
324 loop[i].start = jvm_new_label_id(p);
325 loop[i].end = jvm_new_label_id(p);
326
327 jvm_generate(p, 0, 1, "iconst_0");
328 jvm_generate(p, 1, 0, "istore %i", loop[i].reg_index);
329
330 jvm_generate(p, 0, 1, "aload %i", reg_src);
331 jvm_generate(p, 1, 1, "arraylength");
332 jvm_generate(p, 1, 0, "istore %i", loop[i].reg_length);
333
334 /* if(i >= len) goto end; */
335 jvm_generate_label(p, loop[i].start);
336 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_index);
337 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_length);
338 jvm_generate(p, 2, 0, "if_icmpge L%i", loop[i].end);
339 }
340
341 if(base -> class == OBERON_TYPE_RECORD)
342 {
343 /* Получаем записи по индексам ( -- dst src ) */
344
345 jvm_generate(p, 0, 1, "aload %i", reg_dst);
346 for(int i = 0; i < dim; i++)
347 {
348 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_index);
349 jvm_generate(p, 2, 1, "aaload");
350 }
351
352 jvm_generate(p, 0, 1, "aload %i", reg_src);
353 for(int i = 0; i < dim; i++)
354 {
355 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_index);
356 jvm_generate(p, 2, 1, "aaload");
357 }
358
359 /* Копируем записи ( dst src -- ) */
360 jvm_generate_copy_record(p, base);
361 }
362 else
363 {
364 char postfix = jvm_get_postfix(base);
365 int cell_size = jvm_cell_size_for_postfix(postfix);
366
367 /* Получаем массивы и индексы ( -- dst i src i ) */
368
369 jvm_generate(p, 0, 1, "aload %i", reg_dst);
370 jvm_generate(p, 0, 1, "iload %i", loop[0].reg_index);
371 for(int i = 1; i < dim; i++)
372 {
373 jvm_generate(p, 2, 1, "aaload");
374 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_index);
375 }
376
377 jvm_generate(p, 0, 1, "aload %i", reg_src);
378 jvm_generate(p, 0, 1, "iload %i", loop[0].reg_index);
379 for(int i = 1; i < dim; i++)
380 {
381 jvm_generate(p, 2, 1, "aaload");
382 jvm_generate(p, 0, 1, "iload %i", loop[i].reg_index);
383 }
384
385 /* Копируем значения ( dst i src i -- ) */
386 jvm_generate(p, 2, cell_size, "%caload", postfix);
387 jvm_generate(p, 2 + cell_size, 0, "%castore", postfix);
388 }
389
390 for(int i = dim - 1; i >= 0; i--)
391 {
392 jvm_generate(p, 0, 0, "iinc %i 1", loop[i].reg_index);
393 jvm_generate(p, 0, 0, "goto L%i", loop[i].start);
394 jvm_generate_label(p, loop[i].end);
395 }
396 }
397
398 static void
399 jvm_generate_push_procedure_pointer(gen_proc_t * p, oberon_object_t * proc)
400 {
401 char * full_name = jvm_get_field_full_name_safe(proc);
402 char * desc = jvm_get_descriptor(proc -> type);
403 jvm_generate(p, 0, 1, "getstatic %s/pointer %s", full_name, desc);
404 }
405
406 void
407 oberon_generator_init_context(oberon_context_t * ctx)
408 {
409 gen_context_t * gen_context = GC_MALLOC(sizeof *gen_context);
410 memset(gen_context, 0, sizeof *gen_context);
411
412 ctx -> gen_context = gen_context;
413 gen_context -> dir = ".";
414 }
415
416 void
417 oberon_generator_destroy_context(oberon_context_t * ctx)
418 {
419 }
420
421 static void
422 oberon_generate_procedure_class(const char * dir, oberon_type_t * proc)
423 {
424 FILE * fp;
425 char * cname;
426 char * signature;
427 struct gen_class * class;
428
429 cname = jvm_get_class_full_name(proc);
430 class = jvm_create_class(dir, cname);
431 fp = class -> fp;
432
433 fprintf(fp, ".source SYSTEM\n");
434 fprintf(fp, ".class public abstract %s\n", cname);
435 fprintf(fp, ".super java/lang/Object\n\n");
436
437 fprintf(fp, ".method <init>()V\n");
438 fprintf(fp, " aload_0\n");
439 fprintf(fp, " invokespecial java/lang/Object/<init>()V\n");
440 fprintf(fp, " return\n");
441 fprintf(fp, ".end method\n\n");
442
443 signature = jvm_get_procedure_signature(proc);
444
445 fprintf(fp, ".method public abstract invoke%s\n", signature);
446 fprintf(fp, ".end method\n\n");
447
448 jvm_destroy_class(class);
449 }
450
451 static void
452 oberon_generate_procedure_pointer_class(const char * dir, oberon_object_t * proc)
453 {
454 FILE * fp;
455 char * cname;
456 char * abscname;
457 char * absdesc;
458 char * signature;
459 struct gen_class * class;
460
461 cname = jvm_get_field_full_name_safe(proc);
462 class = jvm_create_class(dir, cname);
463 abscname = jvm_get_class_full_name(proc -> type);
464 absdesc = jvm_get_descriptor(proc -> type);
465 fp = class -> fp;
466
467 fprintf(fp, ".source %s\n", proc -> module -> name);
468 fprintf(fp, ".class public %s\n", cname);
469 fprintf(fp, ".super %s\n\n", abscname);
470
471 fprintf(fp, ".field public static pointer %s\n\n", absdesc);
472
473 fprintf(fp, ".method private <init>()V\n");
474 fprintf(fp, " aload_0\n");
475 fprintf(fp, " invokespecial %s/<init>()V\n", abscname);
476 fprintf(fp, " return\n");
477 fprintf(fp, ".end method\n\n");
478
479 fprintf(fp, ".method static <clinit>()V\n");
480 fprintf(fp, " .limit stack 2\n");
481 fprintf(fp, " new %s\n", cname);
482 fprintf(fp, " dup\n");
483 fprintf(fp, " invokespecial %s/<init>()V\n", cname);
484 fprintf(fp, " putstatic %s/pointer %s\n", cname, absdesc);
485 fprintf(fp, " return\n");
486 fprintf(fp, ".end method\n\n");
487
488 signature = jvm_get_procedure_signature(proc -> type);
489
490 gen_proc_t * p = jvm_create_proc(class);
491 jvm_generate_function_header(p, "public", "invoke", signature);
492 jvm_alloc_register_untyped(p -> rf, false);
493
494 int use_size = 0;
495 int num = proc -> type -> num_decl;
496 oberon_object_t * param = proc -> type -> decl;
497 for(int i = 0; i < num; i++)
498 {
499 gen_type_t * t = param -> type -> gen_type;
500 if(param -> class == OBERON_CLASS_VAR_PARAM)
501 {
502 int reg = jvm_alloc_register_untyped(p -> rf, true);
503 jvm_generate(p, 0, 1, "aload %i", reg);
504 jvm_generate(p, 0, 1, "iload %i", reg + 1);
505 }
506 else
507 {
508 int reg = jvm_alloc_register_untyped(p -> rf, t -> wide);
509 jvm_generate(p, 0, t -> cell_size, "%cload %i", t -> prefix, reg);
510 }
511 use_size += t -> cell_size;
512 param = param -> next;
513 }
514
515 char * full_name = jvm_get_field_full_name(proc);
516 int cell_size = jvm_cell_size_for_type(proc -> type -> base);
517 jvm_generate(p, use_size, cell_size, "invokestatic %s%s", full_name, signature);
518
519 if(proc -> type -> base -> class == OBERON_TYPE_NOTYPE)
520 {
521 jvm_generate(p, 0, 0, "return");
522 }
523 else
524 {
525 char prefix = jvm_get_prefix(proc -> type -> base);
526 jvm_generate(p, cell_size, 0, "%creturn", prefix);
527 }
528
529 jvm_generate_function_end(p);
530
531 jvm_destroy_class(class);
532 }
533
534 static void
535 oberon_generate_record_class(const char * dir, gen_module_t * m, oberon_type_t * rec)
536 {
537 char * cname;
538 struct gen_class * class;
539
540 /* Устанавливаем новоый id */
541 rec -> gen_type -> rec_id = m -> rec_id;
542 m -> rec_id += 1;
543
544 cname = jvm_get_class_full_name(rec);
545 class = jvm_create_class(dir, cname);
546
547 fprintf(class -> fp, ".source %s\n", rec -> module -> name);
548 fprintf(class -> fp, ".class public %s\n", cname);
549
550 if(rec -> base == NULL)
551 {
552 fprintf(class -> fp, ".super java/lang/Object\n\n");
553 }
554 else
555 {
556 class -> base = rec -> base -> gen_type -> class;
557 fprintf(class -> fp, ".super %s\n\n", class -> base -> full_name);
558 }
559
560 rec -> gen_type -> class = class;
561 }
562
563 void
564 oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type)
565 {
566 gen_type_t * t = GC_MALLOC(sizeof *t);
567 memset(t, 0, sizeof *t);
568 type -> gen_type = t;
569
570 gen_context_t * c;
571 c = ctx -> gen_context;
572
573 gen_module_t * m;
574 switch(type -> class)
575 {
576 case OBERON_TYPE_NOTYPE:
577 case OBERON_TYPE_INTEGER:
578 case OBERON_TYPE_BOOLEAN:
579 case OBERON_TYPE_ARRAY:
580 case OBERON_TYPE_POINTER:
581 case OBERON_TYPE_REAL:
582 case OBERON_TYPE_CHAR:
583 case OBERON_TYPE_STRING:
584 case OBERON_TYPE_SET:
585 case OBERON_TYPE_NIL:
586 case OBERON_TYPE_SYSTEM_BYTE:
587 case OBERON_TYPE_SYSTEM_PTR:
588 break;
589 case OBERON_TYPE_RECORD:
590 m = type -> module -> gen_mod;
591 t -> full_name = jvm_get_class_full_name(type);
592 oberon_generate_record_class(c -> dir, m, type);
593 break;
594 case OBERON_TYPE_PROCEDURE:
595 oberon_generate_procedure_class(c -> dir, type);
596 break;
597 default:
598 gen_error("oberon_generator_init_type: unk calss %i", type -> class);
599 break;
600 }
601
602 if(type -> class != OBERON_TYPE_NOTYPE)
603 {
604 t -> wide = jvm_is_wide_type(type);
605 t -> prefix = jvm_get_prefix(type);
606 t -> postfix = jvm_get_postfix(type);
607 }
608
609 if((type -> class == OBERON_TYPE_POINTER && type -> base -> class == OBERON_TYPE_RECORD) ||
610 type -> class == OBERON_TYPE_PROCEDURE ||
611 type -> class == OBERON_TYPE_RECORD ||
612 type -> class == OBERON_TYPE_SYSTEM_PTR)
613 {
614 t -> full_name = jvm_get_class_full_name(type);
615 }
616
617 t -> cell_size = jvm_cell_size_for_type(type);
618
619 if(type -> class != OBERON_TYPE_NIL)
620 {
621 t -> desc = jvm_get_descriptor(type);
622 }
623 }
624
625 void
626 oberon_generator_init_record(oberon_context_t * ctx, oberon_type_t * rec)
627 {
628 struct gen_class * class;
629 class = rec -> gen_type -> class;
630
631 int num = rec -> num_decl;
632 oberon_object_t * field = rec -> decl;
633 for(int i = 0; i < num; i++)
634 {
635 jvm_generate_var(field -> gen_var);
636 field = field -> next;
637 }
638
639 /* Стандартный конструктор класса */
640 /* Инициализирует внутренние статические записи и массивы */
641 gen_proc_t * p = jvm_create_proc(class);
642 jvm_generate_function_header(p, "public", "<init>", "()V");
643 jvm_alloc_register_untyped(p -> rf, false);
644 jvm_generate(p, 0, 1, "aload_0");
645 if(class -> base)
646 {
647 jvm_generate(p, 1, 0, "invokespecial %s/<init>()V", class -> base -> full_name);
648 }
649 else
650 {
651 jvm_generate(p, 1, 0, "invokespecial java/lang/Object/<init>()V");
652 }
653 num = rec -> num_decl;
654 field = rec -> decl;
655 for(int i = 0; i < num; i++)
656 {
657 jvm_generate(p, 0, 1, "aload_0");
658 jvm_generate_var_initialization(p, field -> gen_var);
659
660 if(field -> type -> class == OBERON_TYPE_RECORD
661 || field -> type -> class == OBERON_TYPE_ARRAY)
662 {
663 jvm_generate(p, 0, 1, "aload_0");
664 jvm_generate_ldst_prepare(p, field -> gen_var);
665 jvm_generate_new(p, field -> type, 0);
666 jvm_generate_store(p, field -> gen_var);
667 }
668 field = field -> next;
669 }
670 jvm_generate(p, 0, 0, "return");
671 jvm_generate_function_end(p);
672
673 /* Метод для копирования полей класса */
674 /* reg0 == src -> reg1 == dst */
675 p = jvm_create_proc(class);
676 char * signature = new_string("(%s%s)V", rec -> gen_type -> desc, rec -> gen_type -> desc);
677 jvm_generate_function_header(p, "public static", "$COPY$", signature);
678
679 gen_var_t * copy_dst = jvm_create_function_var(p, JVM_STORAGE_REGISTER, "dst", rec -> gen_type);
680 gen_var_t * copy_src = jvm_create_function_var(p, JVM_STORAGE_REGISTER, "src", rec -> gen_type);
681 jvm_generate_var(copy_dst);
682 jvm_generate_var(copy_src);
683 jvm_generate_var_initialization(p, copy_dst);
684 jvm_generate_var_initialization(p, copy_src);
685
686 if(rec -> base)
687 {
688 jvm_generate_load(p, copy_dst);
689 jvm_generate_load(p, copy_src);
690 jvm_generate_copy_record(p, rec -> base);
691 }
692
693 num = rec -> num_decl;
694 field = rec -> decl;
695 for(int i = 0; i < num; i++)
696 {
697 if(field -> type -> class == OBERON_TYPE_RECORD)
698 {
699 jvm_generate_load(p, copy_dst);
700 jvm_generate_load(p, field -> gen_var);
701 jvm_generate_load(p, copy_src);
702 jvm_generate_load(p, field -> gen_var);
703 jvm_generate_copy_record(p, field -> type);
704 }
705 else if(field -> type -> class == OBERON_TYPE_ARRAY)
706 {
707 jvm_generate_load(p, copy_dst);
708 jvm_generate_load(p, field -> gen_var);
709 jvm_generate_load(p, copy_src);
710 jvm_generate_load(p, field -> gen_var);
711 jvm_generate_copy_array(p, field -> type);
712 }
713 else
714 {
715 jvm_generate_load(p, copy_dst);
716 jvm_generate_ldst_prepare(p, field -> gen_var);
717 jvm_generate_load(p, copy_src);
718 jvm_generate_load(p, field -> gen_var);
719 jvm_generate_store(p, field -> gen_var);
720 }
721 field = field -> next;
722 }
723 jvm_generate(p, 0, 0, "return");
724 jvm_generate_function_end(p);
725
726 jvm_destroy_class(class);
727 }
728
729 void
730 oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var)
731 {
732 gen_module_t * m;
733 m = ctx -> mod -> gen_mod;
734
735 struct gen_class * class;
736 class = m -> class;
737
738 gen_proc_t * p;
739 struct gen_class * c;
740 char * name = var -> name;
741 gen_type_t * t = var -> type -> gen_type;
742
743 assert(name);
744 if(t == NULL)
745 {
746 gen_error("uninitialized type class %i", var -> type -> class);
747 }
748
749 switch(var -> class)
750 {
751 case OBERON_CLASS_VAR_PARAM:
752 p = var -> parent -> gen_proc;
753 var -> gen_var = jvm_create_function_var(p, JVM_STORAGE_FRAME_PARAM_VARPTR, name, t);
754 break;
755 case OBERON_CLASS_PARAM:
756 p = var -> parent -> gen_proc;
757 var -> gen_var = jvm_create_function_var(p, JVM_STORAGE_FRAME_PARAM_VAR, name, t);
758 break;
759 case OBERON_CLASS_FIELD:
760 c = var -> parent_type -> gen_type -> class;
761 var -> gen_var = jvm_create_class_var(c, JVM_STORAGE_FIELD_VAR, name, t);
762 break;
763 case OBERON_CLASS_VAR:
764 if(var -> local)
765 {
766 p = var -> parent -> gen_proc;
767 var -> gen_var = jvm_create_function_var(p, JVM_STORAGE_FRAME_VAR, name, t);
768 }
769 else
770 {
771 var -> gen_var = jvm_create_class_var(class, JVM_STORAGE_STATIC_VAR, name, t);
772 jvm_generate_var(var -> gen_var);
773 }
774 break;
775 default:
776 gen_error("oberon_generator_init_var: unk var class %i", var -> class);
777 break;
778 }
779 }
780
781 static void
782 oberon_generate_static_initialization(gen_proc_t * p, oberon_object_t * x)
783 {
784 if(x -> type -> class == OBERON_TYPE_ARRAY
785 || x -> type -> class == OBERON_TYPE_RECORD)
786 {
787 jvm_generate_ldst_prepare(p, x -> gen_var);
788 jvm_generate_new(p, x -> type, 0);
789 jvm_generate_store(p, x -> gen_var);
790 }
791 }
792
793 void
794 oberon_generator_init_temp_var(oberon_context_t * ctx, oberon_object_t * var)
795 {
796 assert(var -> class == OBERON_CLASS_VAR);
797
798 gen_module_t * m;
799 m = ctx -> mod -> gen_mod;
800
801 gen_proc_t * p;
802 p = m -> class -> p;
803
804 gen_type_t * t;
805 t = var -> type -> gen_type;
806
807 var -> gen_var = jvm_create_function_temp_var(p, t);
808 jvm_generate_var(var -> gen_var);
809 jvm_generate_var_initialization(p, var -> gen_var);
810 oberon_generate_static_initialization(p, var);
811 }
812
813 void
814 oberon_generator_init_proc(oberon_context_t * ctx, oberon_object_t * proc)
815 {
816 struct gen_class * class = proc -> module -> gen_mod -> class;
817 proc -> gen_proc = jvm_create_proc(class);
818 proc -> gen_proc -> full_name = jvm_get_field_full_name_safe(proc);
819 jvm_create_static_links(proc);
820 }
821
822 void
823 oberon_generator_init_module(oberon_context_t * ctx, oberon_module_t * mod)
824 {
825 gen_module_t * m = GC_MALLOC(sizeof *m);
826 memset(m, 0, sizeof *m);
827 mod -> gen_mod = m;
828
829 gen_context_t * c;
830 c = ctx -> gen_context;
831
832 struct gen_class * class;
833 class = jvm_create_class(c -> dir, mod -> name);
834
835 fprintf(class -> fp, ".source %s\n", mod -> name);
836 fprintf(class -> fp, ".class %s\n", mod -> name);
837 fprintf(class -> fp, ".super java/lang/Object\n\n");
838
839 fprintf(class -> fp, ".field private static $INITIALIZED$ Z\n\n");
840
841 m -> class = class;
842
843 c -> current_m = m;
844 }
845
846 void
847 oberon_generator_fini_module(oberon_module_t * mod)
848 {
849 jvm_destroy_class(mod -> gen_mod -> class);
850 }
851
852 static void
853 push_expr(gen_proc_t * p, oberon_expr_t * expr);
854
855 void
856 oberon_generate_begin_module(oberon_context_t * ctx)
857 {
858 gen_proc_t * p;
859 int label_cont;
860 struct gen_class * class;
861
862 class = ctx -> mod -> gen_mod -> class;
863
864 p = jvm_create_proc(class);
865 jvm_generate_function_header(p, "public static", "BEGIN", "()V");
866
867 label_cont = jvm_new_label_id(p);
868 jvm_generate(p, 0, 1, "getstatic %s/$INITIALIZED$ Z", class -> full_name);
869 jvm_generate(p, 1, 0, "ifeq L%i", label_cont);
870 jvm_generate(p, 0, 0, "return");
871 jvm_generate_label(p, label_cont);
872
873 jvm_generate(p, 0, 1, "iconst_1");
874 jvm_generate(p, 1, 0, "putstatic %s/$INITIALIZED$ Z", class -> full_name);
875
876 /* Инициализация переменных объявленных в модуле */
877 oberon_object_t * x = ctx -> mod -> decl -> list -> next;
878 while(x != NULL)
879 {
880 if(x -> class == OBERON_CLASS_MODULE)
881 {
882 if(!x -> module -> intrinsic)
883 {
884 jvm_generate(p, 0, 0, "invokestatic %s/BEGIN()V", x -> module -> gen_mod -> class -> full_name);
885 }
886 }
887 else if(x -> class == OBERON_CLASS_VAR)
888 {
889 jvm_generate_var_initialization(p, x -> gen_var);
890 oberon_generate_static_initialization(p, x);
891 }
892
893 x = x -> next;
894 }
895 }
896
897 void
898 oberon_generate_end_module(oberon_context_t * ctx)
899 {
900 struct gen_class * class = ctx -> mod -> gen_mod -> class;
901 gen_proc_t * p = class -> p;
902
903 jvm_generate(p, 0, 0, "return");
904 jvm_generate_function_end(class -> p);
905
906 p = jvm_create_proc(class);
907 jvm_generate_function_header(p, "private", "<init>", "()V");
908 jvm_alloc_register_untyped(p -> rf, false);
909 jvm_generate(p, 0, 1, "aload_0");
910 jvm_generate(p, 1, 0, "invokespecial java/lang/Object/<init>()V");
911 jvm_generate(p, 0, 0, "return");
912 jvm_generate_function_end(class -> p);
913 }
914
915 /*
916 * Генерирует код для получения размера измерения массива
917 * Аналог Обероновского LEN(v, n); где n = 0 - первое измерение.
918 * ( aref -- int )
919 */
920
921 static void
922 jvm_generate_array_len(gen_proc_t * p, int dim)
923 {
924 while(dim > 0)
925 {
926 jvm_generate(p, 0, 1, "iconst_0");
927 jvm_generate(p, 2, 1, "aaload");
928 dim -= 1;
929 }
930 jvm_generate(p, 1, 1, "arraylength");
931 }
932
933 static void
934 jvm_generate_array_duplicate_and_replace(gen_proc_t * p, gen_var_t * v, oberon_type_t * arr)
935 {
936 jvm_generate_ldst_prepare(p, v);
937
938 int dim = 0;
939 oberon_type_t * base = arr;
940 while(base -> class == OBERON_TYPE_ARRAY)
941 {
942 if(base -> size == 0)
943 {
944 jvm_generate_load(p, v);
945 jvm_generate_array_len(p, dim);
946 dim += 1;
947 }
948 base = base -> base;
949 }
950
951 jvm_generate_new(p, arr, dim);
952 jvm_generate(p, 1, 2, "dup");
953 jvm_generate_load(p, v);
954 jvm_generate_copy_array(p, arr);
955 jvm_generate_store(p, v);
956 }
957
958 static void
959 jvm_generate_record_duplicate_and_replace(gen_proc_t * p, gen_var_t * v, oberon_type_t * rec)
960 {
961 jvm_generate_ldst_prepare(p, v);
962 jvm_generate_new(p, rec, 0);
963 jvm_generate(p, 1, 2, "dup");
964 jvm_generate_load(p, v);
965 jvm_generate_copy_record(p, rec);
966 jvm_generate_store(p, v);
967 }
968
969 static void
970 jvm_generate_local_object(gen_proc_t * p, oberon_object_t * x)
971 {
972 gen_var_t * v;
973 struct gen_class * class;
974
975 v = x -> gen_var;
976 class = p -> class;
977
978 // Убеждаемся что сейчас находимся в функции
979 assert(class -> p);
980 assert(x -> local);
981
982 switch(x -> class)
983 {
984 case OBERON_CLASS_VAR_PARAM:
985 case OBERON_CLASS_PARAM:
986 case OBERON_CLASS_VAR:
987 jvm_generate_var(v);
988 break;
989 case OBERON_CLASS_CONST:
990 case OBERON_CLASS_TYPE:
991 case OBERON_CLASS_PROC:
992 break;
993 default:
994 gen_error("jvm_generate_local_initialization: wat class %i", x -> class);
995 break;
996 }
997 }
998
999 static void
1000 jvm_generate_local_initialization(gen_proc_t * p, oberon_object_t * x)
1001 {
1002 gen_var_t * v;
1003 struct gen_class * class;
1004
1005 v = x -> gen_var;
1006 class = p -> class;
1007
1008 // Убеждаемся что сейчас находимся в функции
1009 assert(class -> p);
1010 assert(x -> local);
1011
1012 switch(x -> class)
1013 {
1014 case OBERON_CLASS_VAR_PARAM:
1015 jvm_generate_var_initialization(p, v);
1016 break;
1017 case OBERON_CLASS_PARAM:
1018 jvm_generate_var_initialization(p, v);
1019 if(x -> type -> class == OBERON_TYPE_ARRAY)
1020 {
1021 jvm_generate_array_duplicate_and_replace(p, v, x -> type);
1022 }
1023 else if(x -> type -> class == OBERON_TYPE_RECORD)
1024 {
1025 jvm_generate_record_duplicate_and_replace(p, v, x -> type);
1026 }
1027 break;
1028 case OBERON_CLASS_VAR:
1029 jvm_generate_var_initialization(p, v);
1030 oberon_generate_static_initialization(p, x);
1031 break;
1032 case OBERON_CLASS_CONST:
1033 case OBERON_CLASS_TYPE:
1034 case OBERON_CLASS_PROC:
1035 break;
1036 default:
1037 gen_error("jvm_generate_local_initialization: wat class %i", x -> class);
1038 break;
1039 }
1040 }
1041
1042 void
1043 oberon_generate_begin_proc(oberon_context_t * ctx, oberon_object_t * proc)
1044 {
1045 gen_proc_t * p;
1046 char * name;
1047 char * signature;
1048 oberon_object_t * var;
1049
1050 p = proc -> gen_proc;
1051
1052 if(proc -> local)
1053 {
1054 signature = jvm_get_local_procedure_signature(proc);
1055 }
1056 else
1057 {
1058 oberon_generate_procedure_pointer_class(p -> class -> dir, proc);
1059 signature = jvm_get_procedure_signature(proc -> type);
1060 }
1061
1062 name = jvm_get_name(proc);
1063 jvm_generate_function_header(p, "public static", name, signature);
1064
1065 if(proc -> local)
1066 {
1067 jvm_generate_staticlinks(proc);
1068 }
1069
1070 jvm_generate_procedure_frame(proc);
1071
1072 /* Создание параметров и переменных */
1073 var = proc -> scope -> list -> next;
1074 while(var)
1075 {
1076 jvm_generate_local_object(p, var);
1077 var = var -> next;
1078 }
1079
1080 jvm_generate_frame_initialization(p);
1081
1082 /* Инициализация парамеров и переменных */
1083 var = proc -> scope -> list -> next;
1084 while(var)
1085 {
1086 jvm_generate_local_initialization(p, var);
1087 var = var -> next;
1088 }
1089 }
1090
1091 void
1092 oberon_generate_end_proc(oberon_context_t * ctx)
1093 {
1094 gen_module_t * m;
1095 gen_proc_t * p;
1096
1097 m = ctx -> mod -> gen_mod;
1098 p = m -> class -> p;
1099
1100 oberon_generate_trap(ctx, -4);
1101 jvm_generate_function_end(p);
1102 }
1103
1104 gen_label_t *
1105 oberon_generator_reserve_label(oberon_context_t * ctx)
1106 {
1107 gen_module_t * m;
1108 gen_proc_t * p;
1109 gen_label_t * l;
1110
1111 m = ctx -> mod -> gen_mod;
1112 p = m -> class -> p;
1113
1114 l = GC_MALLOC(sizeof *l);
1115 memset(l, 0, sizeof *l);
1116
1117 l -> id = jvm_new_label_id(p);
1118 return l;
1119 }
1120
1121 void
1122 oberon_generate_label(oberon_context_t * ctx, gen_label_t * l)
1123 {
1124 gen_module_t * m;
1125 gen_proc_t * p;
1126
1127 m = ctx -> mod -> gen_mod;
1128 p = m -> class -> p;
1129
1130 jvm_generate_label(p, l -> id);
1131 }
1132
1133 void
1134 oberon_generate_goto(oberon_context_t * ctx, gen_label_t * l)
1135 {
1136 gen_module_t * m;
1137 gen_proc_t * p;
1138
1139 m = ctx -> mod -> gen_mod;
1140 p = m -> class -> p;
1141
1142 jvm_generate(p, 0, 0, "goto L%i", l -> id);
1143 }
1144
1145 void
1146 oberon_generate_branch(oberon_context_t * ctx, oberon_expr_t * cond, bool gotoif, gen_label_t * l)
1147 {
1148 gen_module_t * m;
1149 gen_proc_t * p;
1150
1151 m = ctx -> mod -> gen_mod;
1152 p = m -> class -> p;
1153
1154 push_expr(p, cond);
1155
1156 if(gotoif == false)
1157 {
1158 /* переход если false */
1159 jvm_generate(p, 1, 0, "ifeq L%i", l -> id);
1160 }
1161 else
1162 {
1163 /* переход если true */
1164 jvm_generate(p, 1, 0, "ifne L%i", l -> id);
1165 }
1166 }
1167
1168 static void
1169 push_varptr(gen_proc_t * p, oberon_expr_t * expr)
1170 {
1171 assert(expr -> is_item);
1172
1173 switch(expr -> item.mode)
1174 {
1175 case MODE_VAR:
1176 jvm_generate_ldst_prepare(p, expr -> item.var -> gen_var);
1177 break;
1178 case MODE_INDEX:
1179 push_item(p, expr -> item.parent);
1180 push_expr(p, expr -> item.args);
1181 check_index(p, expr -> item.args -> result);
1182 break;
1183 case MODE_FIELD:
1184 push_item(p, expr -> item.parent);
1185 jvm_generate_ldst_prepare(p, expr -> item.var -> gen_var);
1186 break;
1187 case MODE_DEREF:
1188 push_varptr(p, (oberon_expr_t *) expr -> item.parent);
1189 break;
1190 default:
1191 gen_error("push_varptr: wat %i", expr -> item.mode);
1192 break;
1193 }
1194 }
1195
1196 static void
1197 jvm_generate_call_proc(gen_proc_t * p, oberon_item_t * desig)
1198 {
1199 assert(desig -> var == NULL);
1200 assert(desig -> mode == MODE_CALL);
1201
1202 bool direct_call = false;
1203 if(desig -> parent -> mode == MODE_VAR)
1204 {
1205 if(desig -> parent -> var -> class == OBERON_CLASS_PROC)
1206 {
1207 direct_call = true;
1208 }
1209 }
1210
1211 oberon_type_t * procsig;
1212 procsig = desig -> parent -> result;
1213
1214 if(direct_call == false)
1215 {
1216 /* Загружаем указатель на процедуру */
1217 push_item(p, desig -> parent);
1218 }
1219
1220 if(direct_call)
1221 {
1222 jvm_generate_push_static_links(p, desig -> parent -> var);
1223 }
1224
1225 int args_cells = 0;
1226 int result_cells = jvm_cell_size_for_type(procsig -> base);
1227
1228 int num = desig -> num_args;
1229 oberon_expr_t * arg = desig -> args;
1230 oberon_object_t * param = procsig -> decl;
1231 for(int i = 0; i < num; i++)
1232 {
1233 if(param -> class == OBERON_CLASS_VAR_PARAM)
1234 {
1235 args_cells += 2;
1236 push_varptr(p, arg);
1237 }
1238 else
1239 {
1240 args_cells += jvm_cell_size_for_type(arg -> result);
1241 push_expr(p, arg);
1242 }
1243 arg = arg -> next;
1244 param = param -> next;
1245 }
1246
1247 if(direct_call)
1248 {
1249 char * full_name = jvm_get_field_full_name(desig -> parent -> var);
1250 char * signature = jvm_get_local_procedure_signature(desig -> parent -> var);
1251 jvm_generate(p, args_cells, result_cells, "invokestatic %s%s", full_name, signature);
1252 }
1253 else
1254 {
1255 char * cname = jvm_get_class_full_name(procsig);
1256 char * signature = jvm_get_procedure_signature(procsig);
1257 jvm_generate(p, 1 + args_cells, result_cells, "invokevirtual %s/invoke%s", cname, signature);
1258 }
1259 }
1260
1261 void
1262 oberon_generate_call_proc(oberon_context_t * ctx, oberon_expr_t * desig)
1263 {
1264 assert(desig -> is_item);
1265 jvm_generate_call_proc(ctx -> mod -> gen_mod -> class -> p, (oberon_item_t *) desig);
1266 }
1267
1268 void
1269 oberon_generate_return(oberon_context_t * ctx, oberon_expr_t * expr)
1270 {
1271 gen_module_t * m;
1272 gen_proc_t * p;
1273 char prefix;
1274 int cell_size;
1275
1276 m = ctx -> mod -> gen_mod;
1277 p = m -> class -> p;
1278
1279 if(expr)
1280 {
1281 push_expr(p, expr);
1282 prefix = jvm_get_prefix(expr -> result);
1283 cell_size = jvm_cell_size_for_type(expr -> result);
1284 jvm_generate(p, cell_size, 0, "%creturn", prefix);
1285 }
1286 else
1287 {
1288 jvm_generate(p, 0, 0, "return");
1289 }
1290 }
1291
1292 static void
1293 jvm_generate_expr_new_pointer(gen_proc_t * p, oberon_type_t * type, int num, oberon_expr_t * arg)
1294 {
1295 assert(type -> class == OBERON_TYPE_POINTER);
1296
1297 for(int i = 0; i < num; i++)
1298 {
1299 push_expr(p, arg);
1300 check_index(p, arg -> result);
1301 arg = arg -> next;
1302 }
1303
1304 jvm_generate_new(p, type -> base, num);
1305 }
1306
1307 static void
1308 push_item(gen_proc_t * p, oberon_item_t * item)
1309 {
1310 switch(item -> mode)
1311 {
1312 case MODE_VAR:
1313 if(item -> var -> class == OBERON_CLASS_PROC)
1314 {
1315 jvm_generate_push_procedure_pointer(p, item -> var);
1316 }
1317 else
1318 {
1319 jvm_generate_load(p, item -> var -> gen_var);
1320 }
1321 break;
1322 case MODE_INTEGER:
1323 case MODE_BOOLEAN:
1324 case MODE_CHAR:
1325 case MODE_SET:
1326 jvm_generate_push_int_size(p, item -> integer, item -> result -> size);
1327 break;
1328 case MODE_CALL:
1329 jvm_generate_call_proc(p, item);
1330 break;
1331 case MODE_INDEX:
1332 ;
1333 char postfix = jvm_get_postfix(item -> result);
1334 int cell_size = jvm_cell_size_for_postfix(postfix);
1335 push_item(p, item -> parent);
1336 push_expr(p, item -> args);
1337 check_index(p, item -> args -> result);
1338 jvm_generate(p, 1 + 1, cell_size, "%caload", postfix);
1339 break;
1340 case MODE_FIELD:
1341 push_item(p, item -> parent);
1342 jvm_generate_load(p, item -> var -> gen_var);
1343 break;
1344 case MODE_DEREF:
1345 /* Все объекты в jvm представляются как указатели */
1346 push_item(p, item -> parent);
1347 break;
1348 case MODE_NIL:
1349 jvm_generate(p, 0, 1, "aconst_null");
1350 break;
1351 case MODE_NEW:
1352 jvm_generate_expr_new_pointer(p, item -> result, item -> num_args, item -> args);
1353 break;
1354 case MODE_REAL:
1355 jvm_generate_push_float(p, item -> real, item -> result -> size);
1356 break;
1357 case MODE_STRING:
1358 jvm_generate_push_string(p, item -> string, item -> result -> size);
1359 break;
1360 case MODE_LEN:
1361 push_item(p, item -> parent);
1362 jvm_generate_array_len(p, item -> integer);
1363 jvm_generate_cast_prefix(p, 'i', jvm_get_postfix(item -> result));
1364 break;
1365 case MODE_AS:
1366 push_item(p, item -> parent);
1367 jvm_generate_cast_type(p, item -> parent -> result, item -> result);
1368 break;
1369 default:
1370 gen_error("push_item: unk mode %i", item -> mode);
1371 break;
1372 }
1373 }
1374
1375 static void
1376 jvm_generate_logical_not(gen_proc_t * p)
1377 {
1378 int label_done = jvm_new_label_id(p);
1379 int label_false = jvm_new_label_id(p);
1380
1381 jvm_generate(p, 1, 0, "ifne L%i", label_false);
1382 jvm_generate(p, 0, 1, "iconst_1");
1383 jvm_generate(p, 0, 0, "goto L%i", label_done);
1384 jvm_generate_label(p, label_false);
1385 jvm_generate(p, 0, 1, "iconst_0");
1386 jvm_generate_label(p, label_done);
1387 }
1388
1389 static void
1390 jvm_generate_abs(gen_proc_t * p, char prefix)
1391 {
1392 char t = jvm_get_type_of_prefix(prefix);
1393 int cell_size = jvm_cell_size_for_postfix(prefix);
1394 jvm_generate(p, cell_size, cell_size, "invokestatic java/lang/Math/abs(%c)%c", t, t);
1395 }
1396
1397 static char *
1398 jvm_get_compare_postfix(int op)
1399 {
1400 char * cmpop = "";
1401 switch(op)
1402 {
1403 case OP_EQ:
1404 cmpop = "eq";
1405 break;
1406 case OP_NEQ:
1407 cmpop = "ne";
1408 break;
1409 case OP_LSS:
1410 cmpop = "lt";
1411 break;
1412 case OP_LEQ:
1413 cmpop = "le";
1414 break;
1415 case OP_GRT:
1416 cmpop = "gt";
1417 break;
1418 case OP_GEQ:
1419 cmpop = "ge";
1420 break;
1421 default:
1422 gen_error("jvm_generate_compare_op: wat");
1423 break;
1424 }
1425 return cmpop;
1426 }
1427
1428 static void
1429 jvm_generate_compare_op(gen_proc_t * p, oberon_type_t * t, int op)
1430 {
1431 char prefix = jvm_get_prefix(t);
1432 int label_true = jvm_new_label_id(p);
1433 int label_done = jvm_new_label_id(p);
1434 int cell_size = jvm_cell_size_for_type(t);
1435 char * cmpop = jvm_get_compare_postfix(op);
1436
1437 if(prefix == 'l')
1438 {
1439 jvm_generate(p, 2 * cell_size, 1, "lcmp");
1440 jvm_generate(p, 1, 1, "if%s L%i", cmpop, label_true);
1441 }
1442 else if(prefix == 'f' || prefix == 'd')
1443 {
1444 char fop;
1445 if(op == OP_EQ || op == OP_NEQ || op == OP_GRT || op == OP_GEQ)
1446 {
1447 fop = 'l';
1448 }
1449 else
1450 {
1451 fop = 'g';
1452 }
1453 jvm_generate(p, 2 * cell_size, 1, "%ccmp%c", prefix, fop);
1454 jvm_generate(p, 1, 1, "if%s L%i", cmpop, label_true);
1455 }
1456 else if(prefix == 'a')
1457 {
1458 if(oberon_is_array_of_char_type(t) || oberon_is_string_type(t))
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