DEADSOFTWARE

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