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
:
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_REAL
:
83 return new_string("F");
86 return new_string("D");
89 gen_error("jvm_get_descriptor: unsupported float size %i", type
-> size
);
93 case OBERON_TYPE_CHAR
:
97 return new_string("B");
100 return new_string("C");
103 return new_string("I");
106 return new_string("J");
109 gen_error("jvm_get_descriptor: unsupported char size %i", type
-> size
);
113 case OBERON_TYPE_BOOLEAN
:
114 return new_string("Z");
116 case OBERON_TYPE_POINTER
:
117 return jvm_get_descriptor(type
-> base
);
119 case OBERON_TYPE_PROCEDURE
:
120 case OBERON_TYPE_RECORD
:
121 desc
= jvm_get_class_full_name(type
);
122 return new_string("L%s;", desc
);
124 case OBERON_TYPE_ARRAY
:
125 desc
= jvm_get_descriptor(type
-> base
);
126 return new_string("[%s", desc
);
129 gen_error("jvm_get_descriptor: unsupported type class %i", type
-> class);
137 jvm_get_prefix(oberon_type_t
* type
)
139 int size
= type
-> size
;
140 switch(type
-> class)
142 case OBERON_TYPE_BOOLEAN
:
143 case OBERON_TYPE_INTEGER
:
144 case OBERON_TYPE_CHAR
:
145 return (size
<= 4) ? ('i') : ('l');
147 case OBERON_TYPE_PROCEDURE
:
148 case OBERON_TYPE_ARRAY
:
149 case OBERON_TYPE_RECORD
:
150 case OBERON_TYPE_POINTER
:
153 case OBERON_TYPE_REAL
:
154 return (size
<= 4) ? ('f') : ('d');
157 gen_error("jvm_get_prefix: wat");
164 jvm_get_postfix(oberon_type_t
* type
)
166 int size
= type
-> size
;
167 switch(type
-> class)
169 case OBERON_TYPE_BOOLEAN
:
172 case OBERON_TYPE_INTEGER
:
188 gen_error("jvm_get_postfix: int wat");
192 case OBERON_TYPE_CHAR
:
208 gen_error("jvm_get_postfix: char wat");
212 case OBERON_TYPE_PROCEDURE
:
213 case OBERON_TYPE_ARRAY
:
214 case OBERON_TYPE_RECORD
:
215 case OBERON_TYPE_POINTER
:
218 case OBERON_TYPE_REAL
:
219 return (size
<= 4) ? ('f') : ('d');
222 gen_error("jvm_get_postfix: wat");
230 jvm_get_field_full_name(oberon_object_t
* x
)
234 case OBERON_CLASS_VAR
:
235 case OBERON_CLASS_PROC
:
236 return new_string("%s/%s", x
-> module
-> name
, x
-> name
);
237 case OBERON_CLASS_FIELD
:;
238 char * rec_name
= jvm_get_class_full_name(x
-> parent_type
);
239 return new_string("%s/%s", rec_name
, x
-> name
);
240 case OBERON_CLASS_MODULE
:
241 return new_string(x
-> module
-> name
);
243 gen_error("jvm_get_field_full_name: wat");
251 jvm_get_field_full_name_safe(oberon_object_t
* x
)
255 case OBERON_CLASS_VAR
:
256 case OBERON_CLASS_PROC
:
257 return new_string("%s$%s", x
-> module
-> name
, x
-> name
);
258 case OBERON_CLASS_FIELD
:;
259 char * rec_name
= jvm_get_class_full_name(x
-> parent_type
);
260 return new_string("%s$%s", rec_name
, x
-> name
);
261 case OBERON_CLASS_MODULE
:
262 return new_string(x
-> module
-> name
);
264 gen_error("jvm_get_field_full_name: wat");
272 jvm_get_class_full_name(oberon_type_t
* type
)
277 switch(type
-> class)
279 case OBERON_TYPE_POINTER
:
280 name
= jvm_get_class_full_name(type
-> base
);
282 case OBERON_TYPE_PROCEDURE
:
283 name
= new_string("SYSTEM$PROCEDURE");
286 desc
= jvm_get_descriptor(type
-> base
);
287 name
= new_string("%s$%s", name
, desc
);
289 int num
= type
-> num_decl
;
290 oberon_object_t
* arg
= type
-> decl
;
291 for(int i
= 0; i
< num
; i
++)
293 desc
= jvm_get_descriptor(arg
-> type
);
294 name
= new_string("%s%s", name
, desc
);
299 case OBERON_TYPE_RECORD
:
300 rec_id
= type
-> gen_type
-> rec_id
;
301 name
= new_string("%s$RECORD%i", type
-> module
-> name
, rec_id
);
304 gen_error("jvm_get_class_full_name: unk type class %i", type
-> class);
312 jvm_get_procedure_signature(oberon_type_t
* proc
)
317 signature
= new_string("(");
319 int num
= proc
-> num_decl
;
320 oberon_object_t
* arg
= proc
-> decl
;
321 for(int i
= 0; i
< num
; i
++)
323 desc
= jvm_get_descriptor(arg
-> type
);
324 signature
= new_string("%s%s", signature
, desc
);
328 desc
= jvm_get_descriptor(proc
-> base
);
329 signature
= new_string("%s)%s", signature
, desc
);
335 jvm_cell_size_for_type(oberon_type_t
* type
)
337 if(type
-> class == OBERON_TYPE_INTEGER
338 || type
-> class == OBERON_TYPE_REAL
)
350 jvm_cell_size_for_postfix(char postfix
)
364 gen_error("jvm_cell_size_for_postfix: unk postfix %c", postfix
);
371 jvm_is_wide_type(oberon_type_t
* type
)
374 cell
= jvm_cell_size_for_type(type
);
380 jvm_is_free_register(struct gen_register_file
* rf
, int i
, bool wide
)
384 assert(i
+ 1 < MAX_REGISTERS
);
385 return !(rf
-> reg
[i
].used
|| rf
-> reg
[i
+ 1].used
);
389 assert(i
< MAX_REGISTERS
);
390 return !(rf
-> reg
[i
].used
);
395 jvm_alloc_register_untyped(struct gen_register_file
* rf
, bool wide
)
398 while(i
< MAX_REGISTERS
&& !jvm_is_free_register(rf
, i
, wide
))
405 assert(i
+ 1 <= MAX_REGISTERS
);
407 rf
-> reg
[i
].used
= true;
408 rf
-> reg
[i
+ 1].used
= true;
409 rf
-> reg
[i
].used
= true;
410 rf
-> reg
[i
+ 1].wide
= false;
414 assert(i
<= MAX_REGISTERS
);
416 rf
-> reg
[i
].used
= true;
417 rf
-> reg
[i
].wide
= false;
420 if(rf
-> num_used
> rf
-> max_used
)
422 rf
-> max_used
= rf
-> num_used
;
429 jvm_alloc_register(struct gen_register_file
* rf
, oberon_type_t
* type
)
432 wide
= jvm_is_wide_type(type
);
433 return jvm_alloc_register_untyped(rf
, wide
);
437 jvm_get_type_of_prefix(char prefix
)