10 #include "../../../include/oberon.h"
11 #include "../../oberon-internals.h"
12 #include "generator-jvm.h"
13 #include "generator-jvm-basic.h"
16 new_string(const char * format
, ...)
19 va_start(ptr
, format
);
22 vsnprintf(buf
, 1024, format
, ptr
);
30 result
= GC_MALLOC(size
+ 1);
31 memset(result
, 0, size
);
32 strncpy(result
, buf
, size
);
38 gen_error(const char * fmt
, ...)
42 fprintf(stderr
, "generator: ");
43 vfprintf(stderr
, fmt
, ptr
);
44 fprintf(stderr
, "\n");
50 jvm_get_descriptor(oberon_type_t
* type
)
56 case OBERON_TYPE_VOID
:
57 return new_string("V");
59 case OBERON_TYPE_INTEGER
:
64 return new_string("B");
67 return new_string("S");
70 return new_string("I");
73 return new_string("J");
76 gen_error("jvm_get_descriptor: unsupported int size %i", type
-> size
);
80 case OBERON_TYPE_REAL
:
84 return new_string("F");
87 return new_string("D");
90 gen_error("jvm_get_descriptor: unsupported float size %i", type
-> size
);
94 case OBERON_TYPE_CHAR
:
98 return new_string("B");
101 return new_string("C");
104 return new_string("I");
107 return new_string("J");
110 gen_error("jvm_get_descriptor: unsupported char size %i", type
-> size
);
114 case OBERON_TYPE_BOOLEAN
:
115 return new_string("Z");
117 case OBERON_TYPE_POINTER
:
118 return jvm_get_descriptor(type
-> base
);
120 case OBERON_TYPE_PROCEDURE
:
121 case OBERON_TYPE_RECORD
:
122 desc
= jvm_get_class_full_name(type
);
123 return new_string("L%s;", desc
);
125 case OBERON_TYPE_ARRAY
:
126 desc
= jvm_get_descriptor(type
-> base
);
127 return new_string("[%s", desc
);
129 case OBERON_TYPE_STRING
:
133 return new_string("[B");
136 return new_string("[C");
139 return new_string("[I");
142 return new_string("[J");
145 gen_error("jvm_get_descriptor: unsupported string size %i", type
-> size
);
150 gen_error("jvm_get_descriptor: unsupported type class %i", type
-> class);
158 jvm_get_descriptor_safe(oberon_type_t
* type
)
160 switch(type
-> class)
162 case OBERON_TYPE_POINTER
:
163 return new_string("PTR%s", jvm_get_descriptor_safe(type
-> base
));
165 case OBERON_TYPE_PROCEDURE
:
166 case OBERON_TYPE_RECORD
:
167 return jvm_get_class_full_name(type
);
169 case OBERON_TYPE_ARRAY
:
170 return new_string("A%s", jvm_get_descriptor_safe(type
-> base
));
173 return jvm_get_descriptor(type
);
181 jvm_get_prefix(oberon_type_t
* type
)
183 int size
= type
-> size
;
184 switch(type
-> class)
186 case OBERON_TYPE_BOOLEAN
:
187 case OBERON_TYPE_INTEGER
:
188 case OBERON_TYPE_CHAR
:
189 case OBERON_TYPE_SET
:
190 return (size
<= 4) ? ('i') : ('l');
192 case OBERON_TYPE_PROCEDURE
:
193 case OBERON_TYPE_ARRAY
:
194 case OBERON_TYPE_RECORD
:
195 case OBERON_TYPE_POINTER
:
196 case OBERON_TYPE_STRING
:
199 case OBERON_TYPE_REAL
:
200 return (size
<= 4) ? ('f') : ('d');
203 gen_error("jvm_get_prefix: wat %i", type
-> class);
210 jvm_get_postfix(oberon_type_t
* type
)
212 int size
= type
-> size
;
213 switch(type
-> class)
215 case OBERON_TYPE_BOOLEAN
:
218 case OBERON_TYPE_INTEGER
:
219 case OBERON_TYPE_SET
:
235 gen_error("jvm_get_postfix: int wat");
239 case OBERON_TYPE_CHAR
:
255 gen_error("jvm_get_postfix: char wat");
259 case OBERON_TYPE_PROCEDURE
:
260 case OBERON_TYPE_ARRAY
:
261 case OBERON_TYPE_RECORD
:
262 case OBERON_TYPE_POINTER
:
263 case OBERON_TYPE_STRING
:
266 case OBERON_TYPE_REAL
:
267 return (size
<= 4) ? ('f') : ('d');
270 gen_error("jvm_get_postfix: wat");
278 jvm_get_field_full_name(oberon_object_t
* x
)
282 case OBERON_CLASS_VAR
:
283 case OBERON_CLASS_PROC
:
284 return new_string("%s/%s", x
-> module
-> name
, x
-> name
);
285 case OBERON_CLASS_FIELD
:;
286 char * rec_name
= jvm_get_class_full_name(x
-> parent_type
);
287 return new_string("%s/%s", rec_name
, x
-> name
);
288 case OBERON_CLASS_MODULE
:
289 return new_string(x
-> module
-> name
);
291 gen_error("jvm_get_field_full_name: wat");
299 jvm_get_field_full_name_safe(oberon_object_t
* x
)
303 case OBERON_CLASS_VAR
:
304 case OBERON_CLASS_PROC
:
305 return new_string("%s$%s", x
-> module
-> name
, x
-> name
);
306 case OBERON_CLASS_FIELD
:;
307 char * rec_name
= jvm_get_class_full_name(x
-> parent_type
);
308 return new_string("%s$%s", rec_name
, x
-> name
);
309 case OBERON_CLASS_MODULE
:
310 return new_string(x
-> module
-> name
);
312 gen_error("jvm_get_field_full_name: wat");
320 jvm_get_class_full_name(oberon_type_t
* type
)
325 switch(type
-> class)
327 case OBERON_TYPE_POINTER
:
328 name
= jvm_get_class_full_name(type
-> base
);
330 case OBERON_TYPE_PROCEDURE
:
331 name
= new_string("SYSTEM$PROCEDURE");
334 desc
= jvm_get_descriptor_safe(type
-> base
);
335 name
= new_string("%s$%s", name
, desc
);
337 int num
= type
-> num_decl
;
338 oberon_object_t
* arg
= type
-> decl
;
339 for(int i
= 0; i
< num
; i
++)
341 desc
= jvm_get_descriptor_safe(arg
-> type
);
342 name
= new_string("%s%s", name
, desc
);
347 case OBERON_TYPE_RECORD
:
348 rec_id
= type
-> gen_type
-> rec_id
;
349 name
= new_string("%s$RECORD%i", type
-> module
-> name
, rec_id
);
352 gen_error("jvm_get_class_full_name: unk type class %i", type
-> class);
360 jvm_get_procedure_signature(oberon_type_t
* proc
)
365 signature
= new_string("(");
367 int num
= proc
-> num_decl
;
368 oberon_object_t
* arg
= proc
-> decl
;
369 for(int i
= 0; i
< num
; i
++)
371 desc
= jvm_get_descriptor(arg
-> type
);
372 if(arg
-> class == OBERON_CLASS_VAR_PARAM
)
374 signature
= new_string("%s[%sI", signature
, desc
);
378 signature
= new_string("%s%s", signature
, desc
);
383 desc
= jvm_get_descriptor(proc
-> base
);
384 signature
= new_string("%s)%s", signature
, desc
);
390 jvm_cell_size_for_type(oberon_type_t
* type
)
392 if(type
-> class == OBERON_TYPE_INTEGER
393 || type
-> class == OBERON_TYPE_REAL
394 || type
-> class == OBERON_TYPE_CHAR
395 || type
-> class == OBERON_TYPE_SET
)
402 else if(type
-> class == OBERON_TYPE_VOID
)
411 jvm_cell_size_for_postfix(char postfix
)
425 gen_error("jvm_cell_size_for_postfix: unk postfix %c", postfix
);
432 jvm_is_wide_type(oberon_type_t
* type
)
435 cell
= jvm_cell_size_for_type(type
);
441 jvm_is_free_register(struct gen_register_file
* rf
, int i
, bool wide
)
445 assert(i
+ 1 < MAX_REGISTERS
);
446 return !(rf
-> reg
[i
].used
|| rf
-> reg
[i
+ 1].used
);
450 assert(i
< MAX_REGISTERS
);
451 return !(rf
-> reg
[i
].used
);
456 jvm_alloc_register_untyped(struct gen_register_file
* rf
, bool wide
)
459 while(i
< MAX_REGISTERS
&& !jvm_is_free_register(rf
, i
, wide
))
466 assert(i
+ 1 <= MAX_REGISTERS
);
468 rf
-> reg
[i
].used
= true;
469 rf
-> reg
[i
+ 1].used
= true;
470 rf
-> reg
[i
].used
= true;
471 rf
-> reg
[i
+ 1].wide
= false;
475 assert(i
<= MAX_REGISTERS
);
477 rf
-> reg
[i
].used
= true;
478 rf
-> reg
[i
].wide
= false;
481 if(rf
-> num_used
> rf
-> max_used
)
483 rf
-> max_used
= rf
-> num_used
;
490 jvm_alloc_register(struct gen_register_file
* rf
, oberon_type_t
* type
)
493 wide
= jvm_is_wide_type(type
);
494 return jvm_alloc_register_untyped(rf
, wide
);
498 jvm_get_type_of_prefix(char prefix
)