DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / dsw-obn.git / blob


9cade33f431a92b3db20095545b259c69f93c588
[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 p -> ret_prefix = jvm_get_prefix(proc -> type -> base);
1064 jvm_generate_function_header(p, "public static", name, signature);
1065
1066 if(proc -> local)
1067 {
1068 jvm_generate_staticlinks(proc);
1069 }
1070
1071 jvm_generate_procedure_frame(proc);
1072
1073 /* Создание параметров и переменных */
1074 var = proc -> scope -> list -> next;
1075 while(var)
1076 {
1077 jvm_generate_local_object(p, var);
1078 var = var -> next;
1079 }
1080
1081 jvm_generate_frame_initialization(p);
1082
1083 /* Инициализация парамеров и переменных */
1084 var = proc -> scope -> list -> next;
1085 while(var)
1086 {
1087 jvm_generate_local_initialization(p, var);
1088 var = var -> next;
1089 }
1090 }
1091
1092 void
1093 oberon_generate_end_proc(oberon_context_t * ctx)
1094 {
1095 gen_module_t * m;
1096 gen_proc_t * p;
1097
1098 m = ctx -> mod -> gen_mod;
1099 p = m -> class -> p;
1100
1101 oberon_generate_trap(ctx, -4);
1102
1103 if(p -> ret_prefix == ' ')
1104 {
1105 jvm_generate(p, 0, 0, "return");
1106 }
1107 else
1108 {
1109 int sz = jvm_cell_size_for_postfix(p -> ret_prefix);
1110 switch(p -> ret_prefix)
1111 {
1112 case 'a':
1113 jvm_generate(p, 0, 1, "aconst_null");
1114 break;
1115 case 'l':
1116 jvm_generate_push_int_size(p, 0, 8);
1117 break;
1118 case 'f':
1119 jvm_generate_push_float(p, 0, 4);
1120 break;
1121 case 'd':
1122 jvm_generate_push_float(p, 0, 8);
1123 break;
1124 default:
1125 jvm_generate_push_int(p, 0);
1126 break;
1127 }
1128 jvm_generate(p, sz, 0, "%creturn", p -> ret_prefix);
1129 }
1130
1131 jvm_generate_function_end(p);
1132 }
1133
1134 gen_label_t *
1135 oberon_generator_reserve_label(oberon_context_t * ctx)
1136 {
1137 gen_module_t * m;
1138 gen_proc_t * p;
1139 gen_label_t * l;
1140
1141 m = ctx -> mod -> gen_mod;
1142 p = m -> class -> p;
1143
1144 l = GC_MALLOC(sizeof *l);
1145 memset(l, 0, sizeof *l);
1146
1147 l -> id = jvm_new_label_id(p);
1148 return l;
1149 }
1150
1151 void
1152 oberon_generate_label(oberon_context_t * ctx, gen_label_t * l)
1153 {
1154 gen_module_t * m;
1155 gen_proc_t * p;
1156
1157 m = ctx -> mod -> gen_mod;
1158 p = m -> class -> p;
1159
1160 jvm_generate_label(p, l -> id);
1161 }
1162
1163 void
1164 oberon_generate_goto(oberon_context_t * ctx, gen_label_t * l)
1165 {
1166 gen_module_t * m;
1167 gen_proc_t * p;
1168
1169 m = ctx -> mod -> gen_mod;
1170 p = m -> class -> p;
1171
1172 jvm_generate(p, 0, 0, "goto L%i", l -> id);
1173 }
1174
1175 void
1176 oberon_generate_branch(oberon_context_t * ctx, oberon_expr_t * cond, bool gotoif, gen_label_t * l)
1177 {
1178 gen_module_t * m;
1179 gen_proc_t * p;
1180
1181 m = ctx -> mod -> gen_mod;
1182 p = m -> class -> p;
1183
1184 push_expr(p, cond);
1185
1186 if(gotoif == false)
1187 {
1188 /* переход если false */
1189 jvm_generate(p, 1, 0, "ifeq L%i", l -> id);
1190 }
1191 else
1192 {
1193 /* переход если true */
1194 jvm_generate(p, 1, 0, "ifne L%i", l -> id);
1195 }
1196 }
1197
1198 static void
1199 push_varptr(gen_proc_t * p, oberon_expr_t * expr)
1200 {
1201 assert(expr -> is_item);
1202
1203 switch(expr -> item.mode)
1204 {
1205 case MODE_VAR:
1206 jvm_generate_ldst_prepare(p, expr -> item.var -> gen_var);
1207 break;
1208 case MODE_INDEX:
1209 push_item(p, expr -> item.parent);
1210 push_expr(p, expr -> item.args);
1211 check_index(p, expr -> item.args -> result);
1212 break;
1213 case MODE_FIELD:
1214 push_item(p, expr -> item.parent);
1215 jvm_generate_ldst_prepare(p, expr -> item.var -> gen_var);
1216 break;
1217 case MODE_DEREF:
1218 push_varptr(p, (oberon_expr_t *) expr -> item.parent);
1219 break;
1220 default:
1221 gen_error("push_varptr: wat %i", expr -> item.mode);
1222 break;
1223 }
1224 }
1225
1226 static void
1227 jvm_generate_call_proc(gen_proc_t * p, oberon_item_t * desig)
1228 {
1229 assert(desig -> var == NULL);
1230 assert(desig -> mode == MODE_CALL);
1231
1232 bool direct_call = false;
1233 if(desig -> parent -> mode == MODE_VAR)
1234 {
1235 if(desig -> parent -> var -> class == OBERON_CLASS_PROC)
1236 {
1237 direct_call = true;
1238 }
1239 }
1240
1241 oberon_type_t * procsig;
1242 procsig = desig -> parent -> result;
1243
1244 if(direct_call == false)
1245 {
1246 /* Загружаем указатель на процедуру */
1247 push_item(p, desig -> parent);
1248 }
1249
1250 if(direct_call)
1251 {
1252 jvm_generate_push_static_links(p, desig -> parent -> var);
1253 }
1254
1255 int args_cells = 0;
1256 int result_cells = jvm_cell_size_for_type(procsig -> base);
1257
1258 int num = desig -> num_args;
1259 oberon_expr_t * arg = desig -> args;
1260 oberon_object_t * param = procsig -> decl;
1261 for(int i = 0; i < num; i++)
1262 {
1263 if(param -> class == OBERON_CLASS_VAR_PARAM)
1264 {
1265 args_cells += 2;
1266 push_varptr(p, arg);
1267 }
1268 else
1269 {
1270 args_cells += jvm_cell_size_for_type(arg -> result);
1271 push_expr(p, arg);
1272 }
1273 arg = arg -> next;
1274 param = param -> next;
1275 }
1276
1277 if(direct_call)
1278 {
1279 char * full_name = jvm_get_field_full_name(desig -> parent -> var);
1280 char * signature = jvm_get_local_procedure_signature(desig -> parent -> var);
1281 jvm_generate(p, args_cells, result_cells, "invokestatic %s%s", full_name, signature);
1282 }
1283 else
1284 {
1285 char * cname = jvm_get_class_full_name(procsig);
1286 char * signature = jvm_get_procedure_signature(procsig);
1287 jvm_generate(p, 1 + args_cells, result_cells, "invokevirtual %s/invoke%s", cname, signature);
1288 }
1289 }
1290
1291 void
1292 oberon_generate_call_proc(oberon_context_t * ctx, oberon_expr_t * desig)
1293 {
1294 assert(desig -> is_item);
1295 jvm_generate_call_proc(ctx -> mod -> gen_mod -> class -> p, (oberon_item_t *) desig);
1296 }
1297
1298 void
1299 oberon_generate_return(oberon_context_t * ctx, oberon_expr_t * expr)
1300 {
1301 gen_module_t * m;
1302 gen_proc_t * p;
1303 char prefix;
1304 int cell_size;
1305
1306 m = ctx -> mod -> gen_mod;
1307 p = m -> class -> p;
1308
1309 if(expr)
1310 {
1311 push_expr(p, expr);
1312 prefix = jvm_get_prefix(expr -> result);
1313 cell_size = jvm_cell_size_for_type(expr -> result);
1314 jvm_generate(p, cell_size, 0, "%creturn", prefix);
1315 }
1316 else
1317 {
1318 jvm_generate(p, 0, 0, "return");
1319 }
1320 }
1321
1322 static void
1323 jvm_generate_expr_new_pointer(gen_proc_t * p, oberon_type_t * type, int num, oberon_expr_t * arg)
1324 {
1325 assert(type -> class == OBERON_TYPE_POINTER);
1326
1327 for(int i = 0; i < num; i++)
1328 {
1329 push_expr(p, arg);
1330 check_index(p, arg -> result);
1331 arg = arg -> next;
1332 }
1333
1334 jvm_generate_new(p, type -> base, num);
1335 }
1336
1337 static void
1338 push_item(gen_proc_t * p, oberon_item_t * item)
1339 {
1340 switch(item -> mode)
1341 {
1342 case MODE_VAR:
1343 if(item -> var -> class == OBERON_CLASS_PROC)
1344 {
1345 jvm_generate_push_procedure_pointer(p, item -> var);
1346 }
1347 else
1348 {
1349 jvm_generate_load(p, item -> var -> gen_var);
1350 }
1351 break;
1352 case MODE_INTEGER:
1353 case MODE_BOOLEAN:
1354 case MODE_CHAR:
1355 case MODE_SET:
1356 jvm_generate_push_int_size(p, item -> integer, item -> result -> size);
1357 break;
1358 case MODE_CALL:
1359 jvm_generate_call_proc(p, item);
1360 break;
1361 case MODE_INDEX:
1362 ;
1363 char postfix = jvm_get_postfix(item -> result);
1364 int cell_size = jvm_cell_size_for_postfix(postfix);
1365 push_item(p, item -> parent);
1366 push_expr(p, item -> args);
1367 check_index(p, item -> args -> result);
1368 jvm_generate(p, 1 + 1, cell_size, "%caload", postfix);
1369 break;
1370 case MODE_FIELD:
1371 push_item(p, item -> parent);
1372 jvm_generate_load(p, item -> var -> gen_var);
1373 break;
1374 case MODE_DEREF:
1375 /* Все объекты в jvm представляются как указатели */
1376 push_item(p, item -> parent);
1377 break;
1378 case MODE_NIL:
1379 jvm_generate(p, 0, 1, "aconst_null");
1380 break;
1381 case MODE_NEW:
1382 jvm_generate_expr_new_pointer(p, item -> result, item -> num_args, item -> args);
1383 break;
1384 case MODE_REAL:
1385 jvm_generate_push_float(p, item -> real, item -> result -> size);
1386 break;
1387 case MODE_STRING:
1388 jvm_generate_push_string(p, item -> string, item -> result -> size);
1389 break;
1390 case MODE_LEN:
1391 push_item(p, item -> parent);
1392 jvm_generate_array_len(p, item -> integer);
1393 jvm_generate_cast_prefix(p, 'i', jvm_get_postfix(item -> result));
1394 break;
1395 case MODE_AS:
1396 push_item(p, item -> parent);
1397 jvm_generate_cast_type(p, item -> parent -> result, item -> result);
1398 break;
1399 default:
1400 gen_error("push_item: unk mode %i", item -> mode);
1401 break;
1402 }
1403 }
1404
1405 static void
1406 jvm_generate_logical_not(gen_proc_t * p)
1407 {
1408 int label_done = jvm_new_label_id(p);
1409 int label_false = jvm_new_label_id(p);
1410
1411 jvm_generate(p, 1, 0, "ifne L%i", label_false);
1412 jvm_generate(p, 0, 1, "iconst_1");
1413 jvm_generate(p, 0, 0, "goto L%i", label_done);
1414 jvm_generate_label(p, label_false);
1415 jvm_generate(p, 0, 1, "iconst_0");
1416 jvm_generate_label(p, label_done);
1417 }
1418
1419 static void
1420 jvm_generate_abs(gen_proc_t * p, char prefix)
1421 {
1422 char t = jvm_get_type_of_prefix(prefix);
1423 int cell_size = jvm_cell_size_for_postfix(prefix);
1424 jvm_generate(p, cell_size, cell_size, "invokestatic java/lang/Math/abs(%c)%c", t, t);
1425 }
1426
1427 static char *
1428 jvm_get_compare_postfix(int op)
1429 {
1430 char * cmpop = "";
1431 switch(op)
1432 {
1433 case OP_EQ:
1434 cmpop = "eq";
1435 break;
1436 case OP_NEQ:
1437 cmpop = "ne";
1438 break;
1439 case OP_LSS:
1440 cmpop = "lt";
1441 break;
1442 case OP_LEQ:
1443 cmpop = "le";
1444 break;
1445 case OP_GRT:
1446 cmpop = "gt";
1447 break;
1448 case OP_GEQ:
1449 cmpop = "ge";
1450 break;
1451 default:
1452 gen_error("jvm_generate_compare_op: wat");
1453 break;
1454 }
1455 return cmpop;
1456 }
1457
1458 static void
1459 jvm_generate_compare_op(gen_proc_t * p, oberon_type_t * t, int op)
1460 {
1461 char prefix = jvm_get_prefix(t);
1462 int label_true = jvm_new_label_id(p);
1463 int label_done = jvm_new_label_id(p);
1464 int cell_size = jvm_cell_size_for_type(t);
1465 char * cmpop = jvm_get_compare_postfix(op);
1466
1467 if(prefix == 'l')
1468 {
1469 jvm_generate(p, 2 * cell_size, 1, "lcmp");
1470 jvm_generate(p, 1, 1, "if%s L%i", cmpop, label_true);
1471 }
1472 else if(prefix == 'f' || prefix == 'd')
1473 {
1474 char fop;
1475 if(op == OP_EQ || op == OP_NEQ || op == OP_GRT || op == OP_GEQ)
1476 {
1477 fop = 'l';
1478 }
1479 else
1480 {
1481 fop = 'g';
1482 }
1483 jvm_generate(p, 2 * cell_size, 1, "%ccmp%c", prefix, fop);
1484 jvm_generate(p, 1, 1, "if%s L%i", cmpop, label_true);
1485 }
1486 else if(prefix == 'a')
1487 {
1488 if(oberon_is_array_of_char_type(t) || oberon_is_string_type(t))
1489 {
1490 jvm_generate(p, 2, 1, "invokestatic SYSTEM/STRCMP([B[B)I");
1491 jvm_generate(p, 1, 0, "if%s L%i", cmpop, label_true);
1492 }
1493 else
1494 {
1495 jvm_generate(p, 1, 0, "if_acmp%s L%i", cmpop, label_true);
1496 }
1497 }
1498 else
1499 {
1500 jvm_generate(p, 2 * cell_size, 0, "if_%ccmp%s L%i", prefix, cmpop, label_true);
1501 }
1502
1503 jvm_generate(p, 0, 1, "iconst_0");
1504 jvm_generate(p, 0, 0, "goto L%i", label_done);
1505 jvm_generate_label(p, label_true);
1506 jvm_generate(p, 0, 1, "iconst_1");
1507 jvm_generate_label(p, label_done);
1508 }
1509
1510 static void
1511 jvm_generate_operator(gen_proc_t * p, oberon_type_t * t, int op)
1512 {
1513 char prefix = jvm_get_prefix(t);
1514 int cell_size = jvm_cell_size_for_type(t);
1515 switch(op)
1516 {
1517 case OP_UNARY_MINUS:
1518 jvm_generate(p, cell_size, cell_size, "%cneg", prefix);
1519 break;
1520 case OP_COMPLEMENTATION:
1521 jvm_generate_push_int_size(p, -1, t -> size);
1522 jvm_generate(p, 2 * cell_size, cell_size, "%cxor", prefix);
1523 break;
1524 case OP_LOGIC_NOT:
1525 jvm_generate_logical_not(p);
1526 break;
1527 case OP_ABS:
1528 jvm_generate_abs(p, prefix);
1529 break;
1530 case OP_CAP:
1531 jvm_generate(p, cell_size, cell_size, "invokestatic java/lang/Character/toUpperCase(I)I");
1532 break;
1533
1534 case OP_ADD:
1535 jvm_generate(p, 2 * cell_size, cell_size, "%cadd", prefix);
1536 break;
1537 case OP_SUB:
1538 jvm_generate(p, 2 * cell_size, cell_size, "%csub", prefix);
1539 break;
1540 case OP_MUL:
1541 jvm_generate(p, 2 * cell_size, cell_size, "%cmul", prefix);
1542 break;
1543 case OP_DIV:
1544 jvm_generate(p, 2 * cell_size, cell_size, "%cdiv", prefix);
1545 break;
1546 case OP_MOD:
1547 jvm_generate(p, 2 * cell_size, cell_size, "%crem", prefix);
1548 break;
1549 case OP_UNION:
1550 jvm_generate(p, 2 * cell_size, cell_size, "%cor", prefix);
1551 break;
1552 case OP_INTERSECTION:
1553 jvm_generate(p, 2 * cell_size, cell_size, "%cand", prefix);
1554 break;
1555 case OP_DIFFERENCE:
1556 /* (a - b) == a & ~b */
1557 jvm_generate_push_int_size(p, -1, t -> size);
1558 jvm_generate(p, 2 * cell_size, cell_size, "%cxor", prefix);
1559 jvm_generate(p, 2 * cell_size, cell_size, "%cand", prefix);
1560 break;
1561 case OP_SYM_DIFFERENCE:
1562 jvm_generate(p, 2 * cell_size, cell_size, "%cxor", prefix);
1563 break;
1564
1565 case OP_EQ:
1566 case OP_NEQ:
1567 case OP_LSS:
1568 case OP_LEQ:
1569 case OP_GRT:
1570 case OP_GEQ:
1571 jvm_generate_compare_op(p, t, op);
1572 break;
1573 default:
1574 gen_error("jvm_generate_operator: unk op %i", op);
1575 break;
1576 }
1577 }
1578
1579 static void
1580 jvm_generate_logical_or(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b)
1581 {
1582 int label_calc_b = jvm_new_label_id(p);
1583 int label_done = jvm_new_label_id(p);
1584
1585 /* a OR b -- если a, то TRUE, иначе b */
1586
1587 push_expr(p, a);
1588 jvm_generate(p, 1, 0, "ifeq L%i", label_calc_b);
1589 jvm_generate(p, 0, 1, "iconst_1");
1590 jvm_generate(p, 0, 0, "goto L%i", label_done);
1591 jvm_generate_label(p, label_calc_b);
1592 push_expr(p, b);
1593 jvm_generate_label(p, label_done);
1594 }
1595
1596 static void
1597 jvm_generate_logical_and(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b)
1598 {
1599 int label_false = jvm_new_label_id(p);
1600 int label_done = jvm_new_label_id(p);
1601
1602 /* a AND b -- если a, то b, иначе FALSE */
1603
1604 push_expr(p, a);
1605 jvm_generate(p, 1, 0, "ifeq L%i", label_false);
1606 push_expr(p, b);
1607 jvm_generate(p, 0, 0, "goto L%i", label_done);
1608 jvm_generate_label(p, label_false);
1609 jvm_generate(p, 0, 1, "iconst_0");
1610 jvm_generate_label(p, label_done);
1611 }
1612
1613 static void
1614 jvm_generate_range(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b)
1615 {
1616 /* { a } == 1 << a */
1617 /* { a..b } == (a <= b) ? ((2 << b) - (1 << a)) : (0); */
1618
1619 char prefix;
1620 int cell_size;
1621 oberon_type_t * type;
1622 gen_var_t * ra;
1623 gen_var_t * rb;
1624 int label_else;
1625 int label_end;
1626
1627 type = a -> result;
1628 cell_size = jvm_cell_size_for_type(type);
1629 prefix = jvm_get_prefix(type);
1630
1631 if(b == NULL)
1632 {
1633 jvm_generate_push_int_size(p, 1, type -> size);
1634 push_expr(p, a);
1635 jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix);
1636 }
1637 else
1638 {
1639 ra = jvm_create_function_temp_var(p, type -> gen_type);
1640 rb = jvm_create_function_temp_var(p, type -> gen_type);
1641 jvm_generate_var(ra);
1642 jvm_generate_var(rb);
1643 jvm_generate_var_initialization(p, ra);
1644 jvm_generate_var_initialization(p, rb);
1645 label_else = jvm_new_label_id(p);
1646 label_end = jvm_new_label_id(p);
1647
1648 push_expr(p, a);
1649 jvm_generate_store(p, ra);
1650 push_expr(p, b);
1651 jvm_generate_store(p, rb);
1652
1653 jvm_generate_load(p, ra);
1654 jvm_generate_load(p, rb);
1655 jvm_generate(p, 2 * cell_size, 0, "if_%ccmpgt L%i", prefix, label_else);
1656
1657 jvm_generate_push_int_size(p, 2, type -> size);
1658 jvm_generate_load(p, rb);
1659 jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix);
1660 jvm_generate_push_int_size(p, 2, type -> size);
1661 jvm_generate_load(p, ra);
1662 jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix);
1663 jvm_generate(p, 2 * cell_size, cell_size, "%csub", prefix);
1664 jvm_generate(p, 0, 0, "goto L%i", label_end);
1665
1666 jvm_generate_label(p, label_else);
1667 jvm_generate_push_int_size(p, 0, type -> size);
1668 jvm_generate_label(p, label_end);
1669 }
1670
1671 /* TODO free registers */
1672 }
1673
1674 static void
1675 jvm_generate_in(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b)
1676 {
1677 oberon_type_t * t = a -> result;
1678 int cell_size = jvm_cell_size_for_type(t);
1679 char prefix = jvm_get_prefix(t);
1680 int label_else = jvm_new_label_id(p);
1681 int label_end = jvm_new_label_id(p);
1682
1683 /* (a IN b) == (1 << a) & b */
1684 jvm_generate_push_int_size(p, 1, t -> size);
1685 push_expr(p, a);
1686 jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix);
1687 push_expr(p, b);
1688 jvm_generate(p, 2 * cell_size, cell_size, "%cand", prefix);
1689
1690 if(cell_size > 1)
1691 {
1692 jvm_generate(p, cell_size, 0, "lcmp");
1693 }
1694
1695 jvm_generate(p, 1, 0, "ifeq L%i", label_else);
1696 jvm_generate(p, 0, 1, "iconst_1");
1697 jvm_generate(p, 0, 0, "goto L%i", label_end);
1698 jvm_generate_label(p, label_else);
1699 jvm_generate(p, 0, 1, "iconst_0");
1700 jvm_generate_label(p, label_end);
1701 }
1702
1703 static void
1704 jvm_generate_shift(gen_proc_t * p, int op, oberon_expr_t * a, oberon_expr_t * b)
1705 {
1706 oberon_type_t * t = a -> result;
1707 int cell_size = jvm_cell_size_for_type(t);
1708 char prefix = jvm_get_prefix(t);
1709 char dt = jvm_get_type_of_prefix(prefix);
1710
1711 push_expr(p, a);
1712 jvm_generate_cast_type(p, a -> result, t);
1713 push_expr(p, b);
1714 jvm_generate_cast_type(p, b -> result, t);
1715
1716 char * opname;
1717 switch(op)
1718 {
1719 case OP_ASH:
1720 opname = "ASH";
1721 break;
1722 case OP_LSH:
1723 opname = "LSH";
1724 break;
1725 case OP_ROT:
1726 opname = "ROT";
1727 break;
1728 default:
1729 gen_error("jvm_generate_shift: invalid op %i", op);
1730 }
1731
1732 jvm_generate(p, 2 * cell_size, cell_size, "invokestatic SYSTEM/%s(%c%c)%c", opname, dt, dt, dt);
1733 }
1734
1735 static void
1736 jvm_generate_entier(gen_proc_t * p, oberon_expr_t * x, oberon_type_t * res)
1737 {
1738 char prefix = jvm_get_prefix(x -> result);
1739 char postfix = jvm_get_postfix(res);
1740
1741 push_expr(p, x);
1742 jvm_generate_cast_prefix(p, prefix, 'd');
1743 jvm_generate(p, 2, 2, "invokestatic java/lang/Math/floor(D)D");
1744 jvm_generate_cast_prefix(p, 'd', postfix);
1745 }
1746
1747 static void
1748 push_operator(gen_proc_t * p, oberon_oper_t * oper)
1749 {
1750 oberon_type_t * preq = oper -> left -> result;
1751 int op = oper -> op;
1752 switch(op)
1753 {
1754 case OP_CAST:
1755 push_expr(p, oper -> left);
1756 jvm_generate_cast_type(p, oper -> left -> result, oper -> result);
1757 break;
1758 case OP_HARDCAST:
1759 push_expr(p, oper -> left);
1760 jvm_generate_hard_cast_type(p, oper -> left -> result, oper -> result);
1761 break;
1762 case OP_COMPLEMENTATION:
1763 case OP_UNARY_MINUS:
1764 case OP_LOGIC_NOT:
1765 case OP_ABS:
1766 case OP_CAP:
1767 push_expr(p, oper -> left);
1768 jvm_generate_operator(p, preq, op);
1769 break;
1770 case OP_ENTIER:
1771 jvm_generate_entier(p, oper -> left, oper -> result);
1772 break;
1773
1774 case OP_ADD:
1775 case OP_SUB:
1776 case OP_MUL:
1777 case OP_DIV:
1778 case OP_MOD:
1779
1780 case OP_UNION:
1781 case OP_INTERSECTION:
1782 case OP_DIFFERENCE:
1783 case OP_SYM_DIFFERENCE:
1784
1785 case OP_EQ:
1786 case OP_NEQ:
1787 case OP_LSS:
1788 case OP_LEQ:
1789 case OP_GRT:
1790 case OP_GEQ:
1791 push_expr(p, oper -> left);
1792 push_expr(p, oper -> right);
1793 jvm_generate_operator(p, preq, op);
1794 break;
1795
1796 case OP_LOGIC_OR:
1797 jvm_generate_logical_or(p, oper -> left, oper -> right);
1798 break;
1799 case OP_LOGIC_AND:
1800 jvm_generate_logical_and(p, oper -> left, oper -> right);
1801 break;
1802
1803 case OP_IS:
1804 preq = oper -> right -> result;
1805 char * cname = jvm_get_class_full_name(preq);
1806 push_expr(p, oper -> left);
1807 jvm_generate(p, 1, 1, "instanceof %s", cname);
1808 break;
1809 case OP_RANGE:
1810 jvm_generate_range(p, oper -> left, oper -> right);
1811 break;
1812 case OP_IN:
1813 jvm_generate_in(p, oper -> left, oper -> right);
1814 break;
1815
1816 case OP_ASH:
1817 case OP_LSH:
1818 case OP_ROT:
1819 jvm_generate_shift(p, op, oper -> left, oper -> right);
1820 break;
1821 default:
1822 gen_error("push_oper: unk op %i", op);
1823 break;
1824 }
1825 }
1826
1827 static void
1828 push_expr(gen_proc_t * p, oberon_expr_t * expr)
1829 {
1830 if(expr -> is_item)
1831 {
1832 push_item(p, (oberon_item_t *) expr);
1833 }
1834 else
1835 {
1836 push_operator(p, (oberon_oper_t *) expr);
1837 }
1838 }
1839
1840 static void
1841 store_expr(gen_proc_t * p, oberon_expr_t * dst, oberon_expr_t * src)
1842 {
1843 assert(dst -> is_item);
1844 oberon_item_t * item = (oberon_item_t *) dst;
1845
1846 if(dst -> result -> class == OBERON_TYPE_ARRAY
1847 || src -> result -> class == OBERON_TYPE_ARRAY)
1848 {
1849 push_expr(p, dst);
1850 push_expr(p, src);
1851 jvm_generate_copy_array(p, dst -> result);
1852 }
1853 else if(dst -> result -> class == OBERON_TYPE_RECORD
1854 || src -> result -> class == OBERON_TYPE_RECORD)
1855 {
1856 push_expr(p, dst);
1857 push_expr(p, src);
1858 jvm_generate_copy_record(p, dst -> result);
1859 }
1860 else switch(item -> mode)
1861 {
1862 case MODE_VAR:
1863 jvm_generate_ldst_prepare(p, item -> var -> gen_var);
1864 push_expr(p, src);
1865 jvm_generate_store(p, item -> var -> gen_var);
1866 break;
1867 case MODE_INDEX:
1868 ;
1869 char postfix = jvm_get_postfix(src -> result);
1870 int cell_size = jvm_cell_size_for_postfix(postfix);
1871 assert(item -> parent -> is_item);
1872 push_item(p, (oberon_item_t *) item -> parent);
1873 push_expr(p, item -> args);
1874 check_index(p, item -> args -> result);
1875 push_expr(p, src);
1876 jvm_generate(p, 1 + 1 + cell_size, 0, "%castore", postfix);
1877 break;
1878 case MODE_FIELD:
1879 assert(item -> parent -> is_item);
1880 push_item(p, (oberon_item_t *) item -> parent);
1881 jvm_generate_ldst_prepare(p, item -> var -> gen_var);
1882 push_expr(p, src);
1883 jvm_generate_store(p, item -> var -> gen_var);
1884 break;
1885 default:
1886 gen_error("store_expr: unk mode %i", item -> mode);
1887 break;
1888 }
1889 }
1890
1891 void
1892 oberon_generate_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
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 store_expr(p, dst, src);
1901 }
1902
1903 void
1904 oberon_generate_copy(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
1905 {
1906 gen_module_t * m;
1907 gen_proc_t * p;
1908 char * desc;
1909
1910 m = ctx -> mod -> gen_mod;
1911 p = m -> class -> p;
1912
1913 push_expr(p, src);
1914 push_expr(p, dst);
1915
1916 desc = jvm_get_descriptor(dst -> result);
1917
1918 jvm_generate(p, 2, 0, "invokestatic SYSTEM/COPY(%s%s)V", desc, desc);
1919 }
1920
1921 void
1922 oberon_generate_assert(oberon_context_t * ctx, oberon_expr_t * cond)
1923 {
1924 gen_module_t * m;
1925 gen_proc_t * p;
1926
1927 m = ctx -> mod -> gen_mod;
1928 p = m -> class -> p;
1929
1930 push_expr(p, cond);
1931 jvm_generate(p, 1, 0, "invokestatic SYSTEM/ASSERT(Z)V");
1932 }
1933
1934 void
1935 oberon_generate_assert_n(oberon_context_t * ctx, oberon_expr_t * cond, int64_t n)
1936 {
1937 gen_module_t * m;
1938 gen_proc_t * p;
1939
1940 m = ctx -> mod -> gen_mod;
1941 p = m -> class -> p;
1942
1943 push_expr(p, cond);
1944 jvm_generate_push_int_size(p, n, 8);
1945 jvm_generate(p, 1 + 2, 0, "invokestatic SYSTEM/ASSERT(ZJ)V");
1946 }
1947
1948 void
1949 oberon_generate_trap(oberon_context_t * ctx, int64_t n)
1950 {
1951 gen_module_t * m;
1952 gen_proc_t * p;
1953
1954 m = ctx -> mod -> gen_mod;
1955 p = m -> class -> p;
1956
1957 jvm_generate_push_int_size(p, n, 8);
1958 jvm_generate(p, 2, 0, "invokestatic SYSTEM/TRAP(J)V");
1959 }
1960
1961 void
1962 oberon_generate_halt(oberon_context_t * ctx, int64_t n)
1963 {
1964 gen_module_t * m;
1965 gen_proc_t * p;
1966
1967 m = ctx -> mod -> gen_mod;
1968 p = m -> class -> p;
1969
1970 jvm_generate_push_int_size(p, n, 8);
1971 jvm_generate(p, 2, 0, "invokestatic SYSTEM/HALT(J)V");
1972 }
1973
1974 void
1975 oberon_set_out_directory(oberon_context_t * ctx, const char * path)
1976 {
1977 gen_context_t * c;
1978
1979 c = ctx -> gen_context;
1980
1981 c -> dir = new_string(path);
1982 }
1983
1984 void
1985 oberon_set_typecheck(oberon_object_t * var, bool enable)
1986 {
1987 var -> gen_var -> typecheck = enable;
1988 var -> gen_var -> forcetype = (enable) ? (var -> type -> gen_type) : (NULL);
1989 }
1990
Another attempt to make Oberon compiler
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024