DEADSOFTWARE

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


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