10 #include "../../oberon-internals.h"
11 #include "generator-jvm.h"
12 #include "generator-jvm-basic.h"
15 new_string(const char * format
, ...)
18 va_start(ptr
, format
);
21 vsnprintf(buf
, 1024, format
, ptr
);
29 result
= GC_MALLOC(size
+ 1);
30 memset(result
, 0, size
);
31 strncpy(result
, buf
, size
);
37 gen_error(const char * fmt
, ...)
41 fprintf(stderr
, "generator: ");
42 vfprintf(stderr
, fmt
, ptr
);
43 fprintf(stderr
, "\n");
49 jvm_get_descriptor(oberon_type_t
* type
)
55 case OBERON_TYPE_NOTYPE
:
56 return new_string("V");
58 case OBERON_TYPE_INTEGER
:
63 return new_string("B");
66 return new_string("S");
69 return new_string("I");
72 return new_string("J");
75 gen_error("jvm_get_descriptor: unsupported int size %i", type
-> size
);
79 case OBERON_TYPE_SYSTEM_BYTE
:
80 return new_string("B");
82 case OBERON_TYPE_REAL
:
86 return new_string("F");
89 return new_string("D");
92 gen_error("jvm_get_descriptor: unsupported float size %i", type
-> size
);
96 case OBERON_TYPE_CHAR
:
100 return new_string("B");
103 return new_string("C");
106 return new_string("I");
109 return new_string("J");
112 gen_error("jvm_get_descriptor: unsupported char size %i", type
-> size
);
116 case OBERON_TYPE_BOOLEAN
:
117 return new_string("Z");
119 case OBERON_TYPE_POINTER
:
120 return jvm_get_descriptor(type
-> base
);
122 case OBERON_TYPE_PROCEDURE
:
123 case OBERON_TYPE_RECORD
:
124 desc
= jvm_get_class_full_name(type
);
125 return new_string("L%s;", desc
);
127 case OBERON_TYPE_ARRAY
:
128 desc
= jvm_get_descriptor(type
-> base
);
129 return new_string("[%s", desc
);
131 case OBERON_TYPE_STRING
:
135 return new_string("[B");
138 return new_string("[C");
141 return new_string("[I");
144 return new_string("[J");
147 gen_error("jvm_get_descriptor: unsupported string size %i", type
-> size
);
151 case OBERON_TYPE_SYSTEM_PTR
:
152 return new_string("Ljava/lang/Object;");
155 gen_error("jvm_get_descriptor: unsupported type class %i", type
-> class);
163 jvm_get_descriptor_safe(oberon_type_t
* type
)
165 switch(type
-> class)
167 case OBERON_TYPE_POINTER
:
168 return new_string("PTR%s", jvm_get_descriptor_safe(type
-> base
));
170 case OBERON_TYPE_PROCEDURE
:
171 case OBERON_TYPE_RECORD
:
172 return jvm_get_class_full_name(type
);
174 case OBERON_TYPE_ARRAY
:
175 return new_string("A%s", jvm_get_descriptor_safe(type
-> base
));
177 case OBERON_TYPE_SYSTEM_PTR
:
178 return new_string("SYSPTR");
181 return jvm_get_descriptor(type
);
189 jvm_get_prefix(oberon_type_t
* type
)
191 int size
= type
-> size
;
192 switch(type
-> class)
194 case OBERON_TYPE_NOTYPE
:
197 case OBERON_TYPE_BOOLEAN
:
198 case OBERON_TYPE_INTEGER
:
199 case OBERON_TYPE_CHAR
:
200 case OBERON_TYPE_SET
:
201 case OBERON_TYPE_SYSTEM_BYTE
:
202 return (size
<= 4) ? ('i') : ('l');
204 case OBERON_TYPE_PROCEDURE
:
205 case OBERON_TYPE_ARRAY
:
206 case OBERON_TYPE_RECORD
:
207 case OBERON_TYPE_POINTER
:
208 case OBERON_TYPE_STRING
:
209 case OBERON_TYPE_NIL
:
210 case OBERON_TYPE_SYSTEM_PTR
:
213 case OBERON_TYPE_REAL
:
214 return (size
<= 4) ? ('f') : ('d');
217 gen_error("jvm_get_prefix: wat %i", type
-> class);
224 jvm_get_postfix(oberon_type_t
* type
)
226 int size
= type
-> size
;
227 switch(type
-> class)
229 case OBERON_TYPE_NOTYPE
:
232 case OBERON_TYPE_BOOLEAN
:
235 case OBERON_TYPE_INTEGER
:
236 case OBERON_TYPE_SET
:
252 gen_error("jvm_get_postfix: int wat");
256 case OBERON_TYPE_SYSTEM_BYTE
:
259 case OBERON_TYPE_CHAR
:
275 gen_error("jvm_get_postfix: char wat");
279 case OBERON_TYPE_PROCEDURE
:
280 case OBERON_TYPE_ARRAY
:
281 case OBERON_TYPE_RECORD
:
282 case OBERON_TYPE_POINTER
:
283 case OBERON_TYPE_STRING
:
284 case OBERON_TYPE_NIL
:
285 case OBERON_TYPE_SYSTEM_PTR
:
288 case OBERON_TYPE_REAL
:
289 return (size
<= 4) ? ('f') : ('d');
292 gen_error("jvm_get_postfix: wat");
300 jvm_get_name(oberon_object_t
* x
)
304 case OBERON_CLASS_VAR
:
305 case OBERON_CLASS_VAR_PARAM
:
306 case OBERON_CLASS_PARAM
:
307 case OBERON_CLASS_FIELD
:
308 return new_string(x
-> name
);
309 case OBERON_CLASS_PROC
:
312 return new_string("%s$%s", jvm_get_name(x
-> parent
), x
-> name
);
316 return new_string(x
-> name
);
319 gen_error("jvm_get_name: wat");
326 jvm_get_field_full_name(oberon_object_t
* x
)
331 case OBERON_CLASS_VAR
:
332 return new_string("%s/%s", x
-> module
-> name
, jvm_get_name(x
));
334 case OBERON_CLASS_PROC
:
335 return new_string("%s/%s", x
-> module
-> name
, jvm_get_name(x
));
337 case OBERON_CLASS_FIELD
:
338 parent
= jvm_get_class_full_name(x
-> parent_type
);
339 return new_string("%s/%s", parent
, jvm_get_name(x
));
341 case OBERON_CLASS_MODULE
:
342 return new_string(x
-> module
-> name
);
345 gen_error("jvm_get_field_full_name: wat");
353 jvm_get_field_full_name_safe(oberon_object_t
* x
)
357 case OBERON_CLASS_VAR
:
358 return new_string("%s$%s", x
-> module
-> name
, x
-> name
);
360 case OBERON_CLASS_PROC
:
361 return new_string("%s$%s", x
-> module
-> name
, jvm_get_name(x
));
363 case OBERON_CLASS_FIELD
:;
364 char * rec_name
= jvm_get_class_full_name(x
-> parent_type
);
365 return new_string("%s$%s", rec_name
, x
-> name
);
367 case OBERON_CLASS_MODULE
:
368 return new_string(x
-> module
-> name
);
371 gen_error("jvm_get_field_full_name: wat");
379 jvm_get_class_full_name(oberon_type_t
* type
)
384 switch(type
-> class)
386 case OBERON_TYPE_POINTER
:
387 name
= jvm_get_class_full_name(type
-> base
);
389 case OBERON_TYPE_PROCEDURE
:
390 name
= new_string("SYSTEM$PROCEDURE");
394 desc
= jvm_get_descriptor_safe(type
-> base
);
395 name
= new_string("%s$%s", name
, desc
);
397 int num
= type
-> num_decl
;
398 oberon_object_t
* arg
= type
-> decl
;
400 for(int i
= 0; i
< num
; i
++)
403 if(arg
-> class == OBERON_CLASS_VAR_PARAM
)
407 desc
= jvm_get_descriptor_safe(arg
-> type
);
408 name
= new_string("%s%s%s", name
, spec
, desc
);
413 case OBERON_TYPE_RECORD
:
414 rec_id
= type
-> gen_type
-> rec_id
;
415 name
= new_string("%s$RECORD%i", type
-> module
-> name
, rec_id
);
417 case OBERON_TYPE_SYSTEM_PTR
:
418 name
= new_string("java/lang/Object");
421 gen_error("jvm_get_class_full_name: unk type class %i", type
-> class);
429 jvm_cell_size_for_type(oberon_type_t
* type
)
431 if(type
-> class == OBERON_TYPE_INTEGER
432 || type
-> class == OBERON_TYPE_REAL
433 || type
-> class == OBERON_TYPE_CHAR
434 || type
-> class == OBERON_TYPE_SET
)
441 else if(type
-> class == OBERON_TYPE_NOTYPE
)
450 jvm_cell_size_for_postfix(char postfix
)
466 gen_error("jvm_cell_size_for_postfix: unk postfix %c (%i)", postfix
, postfix
);
473 jvm_is_wide_type(oberon_type_t
* type
)
476 cell
= jvm_cell_size_for_type(type
);
482 jvm_is_free_register(struct gen_register_file
* rf
, int i
, bool wide
)
486 assert(i
+ 1 < MAX_REGISTERS
);
487 return !(rf
-> reg
[i
].used
|| rf
-> reg
[i
+ 1].used
);
491 assert(i
< MAX_REGISTERS
);
492 return !(rf
-> reg
[i
].used
);
497 jvm_alloc_register_untyped(struct gen_register_file
* rf
, bool wide
)
500 while(i
< MAX_REGISTERS
&& !jvm_is_free_register(rf
, i
, wide
))
507 assert(i
+ 1 <= MAX_REGISTERS
);
509 rf
-> reg
[i
].used
= true;
510 rf
-> reg
[i
+ 1].used
= true;
511 rf
-> reg
[i
].used
= true;
512 rf
-> reg
[i
+ 1].wide
= false;
516 assert(i
<= MAX_REGISTERS
);
518 rf
-> reg
[i
].used
= true;
519 rf
-> reg
[i
].wide
= false;
522 if(rf
-> num_used
> rf
-> max_used
)
524 rf
-> max_used
= rf
-> num_used
;
531 jvm_alloc_register(struct gen_register_file
* rf
, oberon_type_t
* type
)
534 wide
= jvm_is_wide_type(type
);
535 return jvm_alloc_register_untyped(rf
, wide
);
539 jvm_get_type_of_prefix(char prefix
)