DEADSOFTWARE

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


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