DEADSOFTWARE

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