9 #include "../../../include/oberon.h"
10 #include "../../oberon-internals.h"
11 #include "generator-jvm.h"
14 new_string(const char * format
, ...)
17 va_start(ptr
, format
);
20 vsnprintf(buf
, 1024, format
, ptr
);
28 result
= GC_MALLOC(size
+ 1);
29 memset(result
, 0, size
);
30 strncpy(result
, buf
, size
);
36 oberon_generator_init_context(oberon_context_t
* ctx
)
38 gen_context_t
* gen_context
= GC_MALLOC(sizeof *gen_context
);
39 memset(gen_context
, 0, sizeof *gen_context
);
41 ctx
-> gen_context
= gen_context
;
45 oberon_generator_destroy_context(oberon_context_t
* ctx
)
47 ctx
-> gen_context
= NULL
;
50 static char * get_class_full_name(oberon_context_t
* ctx
, oberon_type_t
* type
);
53 get_descriptor(oberon_context_t
* ctx
, oberon_type_t
* type
)
59 case OBERON_TYPE_VOID
:
60 return new_string("V");
62 case OBERON_TYPE_INTEGER
:
66 return new_string("B");
69 return new_string("S");
72 return new_string("I");
75 return new_string("J");
78 oberon_error(ctx
, "get_descriptor: unsupported int size %i", type
-> size
);
82 case OBERON_TYPE_REAL
:
86 return new_string("F");
89 return new_string("D");
92 oberon_error(ctx
, "get_descriptor: unsupported float size %i", type
-> size
);
96 case OBERON_TYPE_BOOLEAN
:
97 return new_string("Z");
99 case OBERON_TYPE_PROCEDURE
:
100 case OBERON_TYPE_RECORD
:
101 desc
= get_class_full_name(ctx
, type
);
102 return new_string("L%s;", desc
);
104 case OBERON_TYPE_ARRAY
:
105 desc
= get_descriptor(ctx
, type
-> base
);
106 return new_string("[%s", desc
);
109 oberon_error(ctx
, "print_descriptor: unsupported type class %i", type
-> class);
117 get_prefix(oberon_context_t
* ctx
, oberon_type_t
* type
)
119 int size
= type
-> size
;
120 switch(type
-> class)
122 case OBERON_TYPE_BOOLEAN
:
123 case OBERON_TYPE_INTEGER
:
124 return (size
<= 4) ? ('i') : ('l');
126 case OBERON_TYPE_PROCEDURE
:
127 case OBERON_TYPE_ARRAY
:
128 case OBERON_TYPE_RECORD
:
129 case OBERON_TYPE_POINTER
:
132 case OBERON_TYPE_REAL
:
133 return (size
<= 4) ? ('f') : ('d');
137 oberon_error(ctx
, "get_prefix: wat");
142 get_field_full_name(oberon_context_t
* ctx
, oberon_object_t
* x
)
144 return new_string("%s/%s", x
-> module
-> name
, x
-> name
);
148 get_class_full_name(oberon_context_t
* ctx
, oberon_type_t
* type
)
153 switch(type
-> class)
155 case OBERON_TYPE_PROCEDURE
:
156 name
= new_string("SYSTEM$PROCEDURE");
159 desc
= get_descriptor(ctx
, type
-> base
);
160 name
= new_string("%s$%s", name
, desc
);
162 int num
= type
-> num_decl
;
163 oberon_object_t
* arg
= type
-> decl
;
164 for(int i
= 0; i
< num
; i
++)
166 desc
= get_descriptor(ctx
, arg
-> type
);
167 name
= new_string("%s%s", name
, desc
);
172 case OBERON_TYPE_RECORD
:
173 assert(type
-> module
);
174 assert(type
-> module
-> gen_mod
);
175 rec_id
= type
-> gen_type
-> rec_id
;
176 name
= new_string("%s$RECORD%i", type
-> module
-> name
, rec_id
);
179 oberon_error(ctx
, "get_record_full_name: unk type class %i", type
-> class);
187 get_procedure_signature(oberon_context_t
* ctx
, oberon_type_t
* proc
)
192 signature
= new_string("(");
194 int num
= proc
-> num_decl
;
195 oberon_object_t
* arg
= proc
-> decl
;
196 for(int i
= 0; i
< num
; i
++)
198 desc
= get_descriptor(ctx
, arg
-> type
);
199 signature
= new_string("%s%s", signature
, desc
);
203 desc
= get_descriptor(ctx
, proc
-> base
);
204 signature
= new_string("%s)%s", signature
, desc
);
210 oberon_generate_procedure_class(oberon_context_t
* ctx
, oberon_type_t
* proc
)
217 cname
= get_class_full_name(ctx
, proc
);
218 fname
= new_string("%s.j", cname
);
220 fp
= fopen(fname
, "w");
222 fprintf(fp
, ".source SYSTEM\n");
223 fprintf(fp
, ".class public abstract %s\n", cname
);
224 fprintf(fp
, ".super java/lang/Object\n\n");
226 signature
= get_procedure_signature(ctx
, proc
);
228 fprintf(fp
, ".method public <init>()V\n");
229 fprintf(fp
, " aload_0\n");
230 fprintf(fp
, " invokespecial java/lang/Object/<init>()V\n");
231 fprintf(fp
, " return\n");
232 fprintf(fp
, ".end method\n\n");
234 fprintf(fp
, ".method public abstract invoke%s\n", signature
);
235 fprintf(fp
, ".end method\n\n");
241 oberon_generate_record_class(oberon_context_t
* ctx
, oberon_type_t
* rec
)
247 /* Устанавливаем новоый id */
248 rec
-> gen_type
-> rec_id
= rec
-> module
-> gen_mod
-> rec_id
;
249 rec
-> module
-> gen_mod
-> rec_id
+= 1;
251 cname
= get_class_full_name(ctx
, rec
);
252 fname
= new_string("%s.j", cname
);
254 fp
= fopen(fname
, "w");
256 fprintf(fp
, ".source %s\n", rec
-> module
-> name
);
257 fprintf(fp
, ".class public %s\n", cname
);
258 fprintf(fp
, ".super java/lang/Object\n\n");
260 rec
-> gen_type
-> fp
= fp
;
264 oberon_generator_init_type(oberon_context_t
* ctx
, oberon_type_t
* type
)
266 gen_type_t
* t
= GC_MALLOC(sizeof *t
);
267 memset(t
, 0, sizeof *t
);
268 type
-> gen_type
= t
;
270 switch(type
-> class)
272 case OBERON_TYPE_VOID
:
273 case OBERON_TYPE_INTEGER
:
274 case OBERON_TYPE_BOOLEAN
:
275 case OBERON_TYPE_ARRAY
:
276 case OBERON_TYPE_REAL
:
278 case OBERON_TYPE_RECORD
:
279 oberon_generate_record_class(ctx
, type
);
281 case OBERON_TYPE_PROCEDURE
:
282 oberon_generate_procedure_class(ctx
, type
);
284 case OBERON_TYPE_POINTER
:
285 assert(type
-> base
-> class == OBERON_TYPE_VOID
);
288 oberon_error(ctx
, "oberon_generator_init_type: unk calss %i", type
-> class);
294 oberon_generate_object(oberon_context_t
* ctx
, FILE * fp
, oberon_object_t
* x
)
300 desc
= get_descriptor(ctx
, x
-> type
);
303 case OBERON_CLASS_VAR
:
304 fprintf(fp
, ".field public static %s %s\n\n", name
, desc
);
306 case OBERON_CLASS_FIELD
:
307 fprintf(fp
, ".field public %s %s\n\n", name
, desc
);
310 oberon_error(ctx
, "oberon_generate_object: unk class %i", x
-> class);
316 oberon_generator_init_record(oberon_context_t
* ctx
, oberon_type_t
* rec
)
320 fp
= rec
-> gen_type
-> fp
;
322 int num
= rec
-> num_decl
;
323 oberon_object_t
* field
= rec
-> decl
;
324 for(int i
= 0; i
< num
; i
++)
326 oberon_generate_object(ctx
, fp
, field
);
327 field
= field
-> next
;
330 fprintf(fp
, ".method public <init>()V\n");
331 fprintf(fp
, " aload_0\n");
332 fprintf(fp
, " invokespecial java/lang/Object/<init>()V\n");
333 fprintf(fp
, " return\n");
334 fprintf(fp
, ".end method\n");
340 oberon_generator_init_var(oberon_context_t
* ctx
, oberon_object_t
* var
)
342 gen_var_t
* v
= GC_MALLOC(sizeof *v
);
343 memset(v
, 0, sizeof *v
);
346 gen_module_t
* m
= ctx
-> mod
-> gen_mod
;
350 case OBERON_CLASS_VAR_PARAM
:
351 oberon_error(ctx
, "generator: VAR-parameters not implemented");
353 case OBERON_CLASS_PARAM
:
354 case OBERON_CLASS_FIELD
:
356 case OBERON_CLASS_VAR
:
357 oberon_generate_object(ctx
, m
-> fp
, var
);
360 oberon_error(ctx
, "oberon_generator_init_var: unk var class %i", var
-> class);
366 oberon_generator_init_proc(oberon_context_t
* ctx
, oberon_object_t
* proc
)
368 gen_proc_t
* p
= GC_MALLOC(sizeof *p
);
369 memset(p
, 0, sizeof *p
);
370 proc
-> gen_proc
= p
;
374 oberon_error(ctx
, "generator: local procedures not implemented");
379 oberon_generator_init_module(oberon_context_t
* ctx
, oberon_module_t
* mod
)
381 gen_module_t
* m
= GC_MALLOC(sizeof *m
);
382 memset(m
, 0, sizeof *m
);
385 int fnamesz
= strlen(mod
-> name
) + 3;
386 char fname
[fnamesz
+ 1];
387 snprintf(fname
, fnamesz
, "%s.j", mod
-> name
);
390 fp
= fopen(fname
, "w");
393 fprintf(fp
, ".source %s\n", mod
-> name
);
394 fprintf(fp
, ".class %s\n", mod
-> name
);
395 fprintf(fp
, ".super java/lang/Object\n\n");
400 // =======================================================================
402 // =======================================================================
405 push_expr(oberon_context_t
* ctx
, FILE * fp
, oberon_expr_t
* expr
);
408 oberon_generate_begin_module(oberon_context_t
* ctx
)
410 gen_module_t
* m
= ctx
-> mod
-> gen_mod
;
411 fprintf(m
-> fp
, ".method public <init>()V\n");
412 fprintf(m
-> fp
, " aload_0\n");
413 fprintf(m
-> fp
, " invokespecial java/lang/Object/<init>()V\n");
417 oberon_generate_end_module(oberon_context_t
* ctx
)
419 gen_module_t
* m
= ctx
-> mod
-> gen_mod
;
421 fprintf(m
-> fp
, " .limit stack 32\n");
422 fprintf(m
-> fp
, " .limit locals 32\n");
423 fprintf(m
-> fp
, " return\n");
424 fprintf(m
-> fp
, ".end method\n");
428 oberon_generate_begin_proc(oberon_context_t
* ctx
, oberon_object_t
* proc
)
433 m
= ctx
-> mod
-> gen_mod
;
434 signature
= get_procedure_signature(ctx
, proc
-> type
);
436 fprintf(m
-> fp
, ".method public static %s%s\n", proc
-> name
, signature
);
440 oberon_generate_call_proc(oberon_context_t
* ctx
, oberon_expr_t
* desig
)
442 oberon_object_t
* proc
;
447 assert(desig
-> is_item
);
448 assert(desig
-> item
.mode
== MODE_CALL
);
450 m
= ctx
-> mod
-> gen_mod
;
451 proc
= desig
-> item
.var
;
452 fullname
= get_field_full_name(ctx
, proc
);
453 signature
= get_procedure_signature(ctx
, proc
-> type
);
455 int num
= desig
-> item
.num_args
;
456 oberon_expr_t
* arg
= desig
-> item
.args
;
457 for(int i
= 0; i
< num
; i
++)
459 push_expr(ctx
, m
-> fp
, arg
);
463 fprintf(m
-> fp
, "invokestatic %s%s\n", fullname
, signature
);
467 oberon_generate_end_proc(oberon_context_t
* ctx
)
470 m
= ctx
-> mod
-> gen_mod
;
472 fprintf(m
-> fp
, " .limit stack 32\n");
473 fprintf(m
-> fp
, " .limit locals 32\n");
474 fprintf(m
-> fp
, ".end method\n\n");
478 oberon_generate_return(oberon_context_t
* ctx
, oberon_expr_t
* expr
)
483 m
= ctx
-> mod
-> gen_mod
;
487 push_expr(ctx
, m
-> fp
, expr
);
488 prefix
= get_prefix(ctx
, expr
-> result
);
489 fprintf(m
-> fp
, " %creturn\n", prefix
);
493 fprintf(m
-> fp
, " return\n");
498 push_int(FILE * fp
, long i
)
502 fprintf(fp
, "iconst_m1\n");
504 else if(i
>= 0 && i
<= 5)
506 fprintf(fp
, "iconst_%li\n", i
);
508 else if(i
>= -128 && i
<= 127)
510 fprintf(fp
, "bipush %li\n", i
);
512 else if(i
>= -32768 && i
<= 32767)
514 fprintf(fp
, "sipush %li\n", i
);
516 else if(i
>= -2147483648 && i
<= 2147483647)
518 fprintf(fp
, "ldc %li\n", i
);
522 fprintf(fp
, "ldc2 %li\n", i
);
527 push_float(FILE * fp
, double f
, int size
)
533 fprintf(fp
, "fconst_0\n");
537 fprintf(fp
, "fconst_1\n");
541 fprintf(fp
, "fconst_2\n");
545 fprintf(fp
, "ldc %lf\n", f
);
552 fprintf(fp
, "dconst_0\n");
556 fprintf(fp
, "dconst_1\n");
560 fprintf(fp
, "ldc2 %lf\n", f
);
566 push_var(oberon_context_t
* ctx
, FILE * fp
, oberon_object_t
* var
)
570 int reg
= var
-> gen_var
-> reg
;
571 char prefix
= get_prefix(ctx
, var
-> type
);
572 fprintf(fp
, "%cload %i\n", prefix
, reg
);
576 char * fullname
= get_field_full_name(ctx
, var
);
577 char * desc
= get_descriptor(ctx
, var
-> type
);
578 fprintf(fp
, "getstatic %s %s\n", fullname
, desc
);
583 push_item(oberon_context_t
* ctx
, FILE * fp
, oberon_item_t
* item
)
588 push_var(ctx
, fp
, item
-> var
);
591 push_int(fp
, item
-> integer
);
594 push_int(fp
, item
-> boolean
);
597 oberon_generate_call_proc(ctx
, (oberon_expr_t
*) item
);
600 oberon_error(ctx
, "push_item: TODO index");
603 oberon_error(ctx
, "push_item: TODO field");
606 oberon_error(ctx
, "push_item: TODO deref");
609 fprintf(fp
, "aconst_null\n");
612 oberon_error(ctx
, "push_item: TODO new");
615 push_float(fp
, item
-> real
, item
-> result
-> size
);
618 oberon_error(ctx
, "push_item: unk mode %i", item
-> mode
);
624 push_operator(oberon_context_t
* ctx
, FILE * fp
, oberon_oper_t
* oper
)
626 char prefix
= get_prefix(ctx
, oper
-> result
);
630 push_expr(ctx
, fp
, oper
-> left
);
631 fprintf(fp
, "%cneg\n", prefix
);
634 push_expr(ctx
, fp
, oper
-> left
);
636 fprintf(fp
, "%cxor\n", prefix
);
640 push_expr(ctx
, fp
, oper
-> left
);
641 push_expr(ctx
, fp
, oper
-> right
);
642 fprintf(fp
, "%cadd\n", prefix
);
645 push_expr(ctx
, fp
, oper
-> left
);
646 push_expr(ctx
, fp
, oper
-> right
);
647 fprintf(fp
, "%csub\n", prefix
);
650 push_expr(ctx
, fp
, oper
-> left
);
651 push_expr(ctx
, fp
, oper
-> right
);
652 fprintf(fp
, "%cmul\n", prefix
);
655 push_expr(ctx
, fp
, oper
-> left
);
656 push_expr(ctx
, fp
, oper
-> right
);
657 fprintf(fp
, "%cdiv\n", prefix
);
660 push_expr(ctx
, fp
, oper
-> left
);
661 push_expr(ctx
, fp
, oper
-> right
);
662 fprintf(fp
, "%crem\n", prefix
);
665 push_expr(ctx
, fp
, oper
-> left
);
666 push_expr(ctx
, fp
, oper
-> right
);
667 fprintf(fp
, "%cand\n", prefix
);
670 push_expr(ctx
, fp
, oper
-> left
);
671 push_expr(ctx
, fp
, oper
-> right
);
672 fprintf(fp
, "%cxor\n", prefix
);
675 push_expr(ctx
, fp
, oper
-> left
);
676 push_expr(ctx
, fp
, oper
-> right
);
677 fprintf(fp
, "%cor\n", prefix
);
688 oberon_error(ctx
, "push_oper: TODO op %i", oper
-> op
);
691 oberon_error(ctx
, "push_oper: unk op %i", oper
-> op
);
697 push_expr(oberon_context_t
* ctx
, FILE * fp
, oberon_expr_t
* expr
)
701 push_item(ctx
, fp
, (oberon_item_t
*) expr
);
705 push_operator(ctx
, fp
, (oberon_oper_t
*) expr
);
710 store_expr(oberon_context_t
* ctx
, FILE * fp
, oberon_expr_t
* expr
)
712 assert(expr
-> is_item
);
713 oberon_item_t
* item
= (oberon_item_t
*) expr
;
719 if(item
-> var
-> local
)
721 int reg
= item
-> var
-> gen_var
-> reg
;
722 prefix
= get_prefix(ctx
, item
-> result
);
723 fprintf(fp
, "%cstore %i\n", prefix
, reg
);
727 char * fullname
= get_field_full_name(ctx
, item
-> var
);
728 char * desc
= get_descriptor(ctx
, item
-> result
);
729 fprintf(fp
, "putstatic %s %s\n", fullname
, desc
);
733 oberon_error(ctx
, "store_expr: unk mode %i", item
-> mode
);
739 oberon_generate_assign(oberon_context_t
* ctx
, oberon_expr_t
* src
, oberon_expr_t
* dst
)
742 m
= ctx
-> mod
-> gen_mod
;
744 push_expr(ctx
, m
-> fp
, src
);
745 store_expr(ctx
, m
-> fp
, dst
);
749 oberon_generate_code(oberon_context_t
* ctx
)
751 printf("generate code\n");
755 oberon_generator_dump(oberon_context_t
* ctx
, char * path
)
757 printf("jit: dump code\n");
761 oberon_generator_get_procedure(oberon_context_t
* ctx
, const char * name
)
763 printf("jit: get pointer to procedure %s\n", name
);
768 oberon_generator_get_var(oberon_context_t
* ctx
, const char * name
)
770 printf("jit: get pointer to var %s\n", name
);