DEADSOFTWARE

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