DEADSOFTWARE

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