2baed6556849dc01aa1d61d9fda6836cccf7642c
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_NOTYPE
:
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_SYSTEM_BYTE
:
81 return new_string("B");
83 case OBERON_TYPE_REAL
:
87 return new_string("F");
90 return new_string("D");
93 gen_error("jvm_get_descriptor: unsupported float size %i", type
-> size
);
97 case OBERON_TYPE_CHAR
:
101 return new_string("B");
104 return new_string("C");
107 return new_string("I");
110 return new_string("J");
113 gen_error("jvm_get_descriptor: unsupported char size %i", type
-> size
);
117 case OBERON_TYPE_BOOLEAN
:
118 return new_string("Z");
120 case OBERON_TYPE_POINTER
:
121 return jvm_get_descriptor(type
-> base
);
123 case OBERON_TYPE_PROCEDURE
:
124 case OBERON_TYPE_RECORD
:
125 desc
= jvm_get_class_full_name(type
);
126 return new_string("L%s;", desc
);
128 case OBERON_TYPE_ARRAY
:
129 desc
= jvm_get_descriptor(type
-> base
);
130 return new_string("[%s", desc
);
132 case OBERON_TYPE_STRING
:
136 return new_string("[B");
139 return new_string("[C");
142 return new_string("[I");
145 return new_string("[J");
148 gen_error("jvm_get_descriptor: unsupported string size %i", type
-> size
);
152 case OBERON_TYPE_SYSTEM_PTR
:
153 return new_string("Ljava/lang/Object;");
156 gen_error("jvm_get_descriptor: unsupported type class %i", type
-> class);
164 jvm_get_descriptor_safe(oberon_type_t
* type
)
166 switch(type
-> class)
168 case OBERON_TYPE_POINTER
:
169 return new_string("PTR%s", jvm_get_descriptor_safe(type
-> base
));
171 case OBERON_TYPE_PROCEDURE
:
172 case OBERON_TYPE_RECORD
:
173 return jvm_get_class_full_name(type
);
175 case OBERON_TYPE_ARRAY
:
176 return new_string("A%s", jvm_get_descriptor_safe(type
-> base
));
178 case OBERON_TYPE_SYSTEM_PTR
:
179 return new_string("SYSPTR");
182 return jvm_get_descriptor(type
);
190 jvm_get_prefix(oberon_type_t
* type
)
192 int size
= type
-> size
;
193 switch(type
-> class)
195 case OBERON_TYPE_BOOLEAN
:
196 case OBERON_TYPE_INTEGER
:
197 case OBERON_TYPE_CHAR
:
198 case OBERON_TYPE_SET
:
199 case OBERON_TYPE_SYSTEM_BYTE
:
200 return (size
<= 4) ? ('i') : ('l');
202 case OBERON_TYPE_PROCEDURE
:
203 case OBERON_TYPE_ARRAY
:
204 case OBERON_TYPE_RECORD
:
205 case OBERON_TYPE_POINTER
:
206 case OBERON_TYPE_STRING
:
207 case OBERON_TYPE_NIL
:
208 case OBERON_TYPE_SYSTEM_PTR
:
211 case OBERON_TYPE_REAL
:
212 return (size
<= 4) ? ('f') : ('d');
215 gen_error("jvm_get_prefix: wat %i", type
-> class);
222 jvm_get_postfix(oberon_type_t
* type
)
224 int size
= type
-> size
;
225 switch(type
-> class)
227 case OBERON_TYPE_BOOLEAN
:
230 case OBERON_TYPE_INTEGER
:
231 case OBERON_TYPE_SET
:
247 gen_error("jvm_get_postfix: int wat");
251 case OBERON_TYPE_SYSTEM_BYTE
:
254 case OBERON_TYPE_CHAR
:
270 gen_error("jvm_get_postfix: char wat");
274 case OBERON_TYPE_PROCEDURE
:
275 case OBERON_TYPE_ARRAY
:
276 case OBERON_TYPE_RECORD
:
277 case OBERON_TYPE_POINTER
:
278 case OBERON_TYPE_STRING
:
279 case OBERON_TYPE_NIL
:
280 case OBERON_TYPE_SYSTEM_PTR
:
283 case OBERON_TYPE_REAL
:
284 return (size
<= 4) ? ('f') : ('d');
287 gen_error("jvm_get_postfix: wat");
295 jvm_get_name(oberon_object_t
* x
)
299 case OBERON_CLASS_VAR
:
300 case OBERON_CLASS_VAR_PARAM
:
301 case OBERON_CLASS_PARAM
:
302 case OBERON_CLASS_FIELD
:
303 return new_string(x
-> name
);
304 case OBERON_CLASS_PROC
:
307 return new_string("%s$%s", jvm_get_name(x
-> parent
), x
-> name
);
311 return new_string(x
-> name
);
314 gen_error("jvm_get_name: wat");
321 jvm_get_field_full_name(oberon_object_t
* x
)
326 case OBERON_CLASS_VAR
:
327 return new_string("%s/%s", x
-> module
-> name
, jvm_get_name(x
));
328 case OBERON_CLASS_PROC
:
329 return new_string("%s/%s", x
-> module
-> name
, jvm_get_name(x
));
330 case OBERON_CLASS_FIELD
:
331 parent
= jvm_get_class_full_name(x
-> parent_type
);
332 return new_string("%s/%s", parent
, jvm_get_name(x
));
333 case OBERON_CLASS_MODULE
:
334 return new_string(x
-> module
-> name
);
336 gen_error("jvm_get_field_full_name: wat");
344 jvm_get_field_full_name_safe(oberon_object_t
* x
)
348 case OBERON_CLASS_VAR
:
349 case OBERON_CLASS_PROC
:
350 return new_string("%s$%s", x
-> module
-> name
, x
-> name
);
351 case OBERON_CLASS_FIELD
:;
352 char * rec_name
= jvm_get_class_full_name(x
-> parent_type
);
353 return new_string("%s$%s", rec_name
, x
-> name
);
354 case OBERON_CLASS_MODULE
:
355 return new_string(x
-> module
-> name
);
357 gen_error("jvm_get_field_full_name: wat");
365 jvm_get_class_full_name(oberon_type_t
* type
)
370 switch(type
-> class)
372 case OBERON_TYPE_POINTER
:
373 name
= jvm_get_class_full_name(type
-> base
);
375 case OBERON_TYPE_PROCEDURE
:
376 name
= new_string("SYSTEM$PROCEDURE");
379 desc
= jvm_get_descriptor_safe(type
-> base
);
380 name
= new_string("%s$%s", name
, desc
);
382 int num
= type
-> num_decl
;
383 oberon_object_t
* arg
= type
-> decl
;
385 for(int i
= 0; i
< num
; i
++)
387 desc
= jvm_get_descriptor_safe(arg
-> type
);
388 name
= new_string("%s%s", name
, desc
);
393 case OBERON_TYPE_RECORD
:
394 rec_id
= type
-> gen_type
-> rec_id
;
395 name
= new_string("%s$RECORD%i", type
-> module
-> name
, rec_id
);
397 case OBERON_TYPE_SYSTEM_PTR
:
398 name
= new_string("java/lang/Object");
401 gen_error("jvm_get_class_full_name: unk type class %i", type
-> class);
409 jvm_cell_size_for_type(oberon_type_t
* type
)
411 if(type
-> class == OBERON_TYPE_INTEGER
412 || type
-> class == OBERON_TYPE_REAL
413 || type
-> class == OBERON_TYPE_CHAR
414 || type
-> class == OBERON_TYPE_SET
)
421 else if(type
-> class == OBERON_TYPE_NOTYPE
)
430 jvm_cell_size_for_postfix(char postfix
)
444 gen_error("jvm_cell_size_for_postfix: unk postfix %c", postfix
);
451 jvm_is_wide_type(oberon_type_t
* type
)
454 cell
= jvm_cell_size_for_type(type
);
460 jvm_is_free_register(struct gen_register_file
* rf
, int i
, bool wide
)
464 assert(i
+ 1 < MAX_REGISTERS
);
465 return !(rf
-> reg
[i
].used
|| rf
-> reg
[i
+ 1].used
);
469 assert(i
< MAX_REGISTERS
);
470 return !(rf
-> reg
[i
].used
);
475 jvm_alloc_register_untyped(struct gen_register_file
* rf
, bool wide
)
478 while(i
< MAX_REGISTERS
&& !jvm_is_free_register(rf
, i
, wide
))
485 assert(i
+ 1 <= MAX_REGISTERS
);
487 rf
-> reg
[i
].used
= true;
488 rf
-> reg
[i
+ 1].used
= true;
489 rf
-> reg
[i
].used
= true;
490 rf
-> reg
[i
+ 1].wide
= false;
494 assert(i
<= MAX_REGISTERS
);
496 rf
-> reg
[i
].used
= true;
497 rf
-> reg
[i
].wide
= false;
500 if(rf
-> num_used
> rf
-> max_used
)
502 rf
-> max_used
= rf
-> num_used
;
509 jvm_alloc_register(struct gen_register_file
* rf
, oberon_type_t
* type
)
512 wide
= jvm_is_wide_type(type
);
513 return jvm_alloc_register_untyped(rf
, wide
);
517 jvm_get_type_of_prefix(char prefix
)