DEADSOFTWARE

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


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