DEADSOFTWARE

24c28b057429313018bf1529c64154c1e2a27825
[dsw-obn.git] / src / backends / jvm / generator-jvm-basic.c
1 #include <stdio.h>
2 #include <stdlib.h>
3 #include <stdarg.h>
4 #include <stdbool.h>
5 #include <string.h>
6 #include <assert.h>
8 #include <gc.h>
10 #include "../../../include/oberon.h"
11 #include "../../oberon-internals.h"
12 #include "generator-jvm.h"
13 #include "generator-jvm-basic.h"
15 char *
16 new_string(const char * format, ...)
17 {
18 va_list ptr;
19 va_start(ptr, format);
21 char buf[1024];
22 vsnprintf(buf, 1024, format, ptr);
24 va_end(ptr);
26 char * result;
27 int size;
29 size = strlen(buf);
30 result = GC_MALLOC(size + 1);
31 memset(result, 0, size);
32 strncpy(result, buf, size);
34 return result;
35 }
37 void
38 gen_error(const char * fmt, ...)
39 {
40 va_list ptr;
41 va_start(ptr, fmt);
42 fprintf(stderr, "generator: ");
43 vfprintf(stderr, fmt, ptr);
44 fprintf(stderr, "\n");
45 va_end(ptr);
46 exit(1);
47 }
49 char *
50 jvm_get_descriptor(oberon_type_t * type)
51 {
52 char * desc;
54 switch(type -> class)
55 {
56 case OBERON_TYPE_VOID:
57 return new_string("V");
58 break;
59 case OBERON_TYPE_INTEGER:
60 switch(type -> size)
61 {
62 case 1:
63 return new_string("B");
64 break;
65 case 2:
66 return new_string("S");
67 break;
68 case 4:
69 return new_string("I");
70 break;
71 case 8:
72 return new_string("J");
73 break;
74 default:
75 gen_error("jvm_get_descriptor: unsupported int size %i", type -> size);
76 break;
77 }
78 break;
79 case OBERON_TYPE_REAL:
80 switch(type -> size)
81 {
82 case 4:
83 return new_string("F");
84 break;
85 case 8:
86 return new_string("D");
87 break;
88 default:
89 gen_error("jvm_get_descriptor: unsupported float size %i", type -> size);
90 break;
91 }
92 break;
93 case OBERON_TYPE_CHAR:
94 switch(type -> size)
95 {
96 case 1:
97 return new_string("B");
98 break;
99 case 2:
100 return new_string("C");
101 break;
102 case 4:
103 return new_string("I");
104 break;
105 case 8:
106 return new_string("J");
107 break;
108 default:
109 gen_error("jvm_get_descriptor: unsupported char size %i", type -> size);
110 break;
112 break;
113 case OBERON_TYPE_BOOLEAN:
114 return new_string("Z");
115 break;
116 case OBERON_TYPE_POINTER:
117 return jvm_get_descriptor(type -> base);
118 break;
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);
123 break;
124 case OBERON_TYPE_ARRAY:
125 desc = jvm_get_descriptor(type -> base);
126 return new_string("[%s", desc);
127 break;
128 default:
129 gen_error("jvm_get_descriptor: unsupported type class %i", type -> class);
130 break;
133 return NULL;
136 char *
137 jvm_get_descriptor_safe(oberon_type_t * type)
139 switch(type -> class)
141 case OBERON_TYPE_POINTER:
142 return new_string("PTR%s", jvm_get_descriptor_safe(type -> base));
143 break;
144 case OBERON_TYPE_PROCEDURE:
145 case OBERON_TYPE_RECORD:
146 return jvm_get_class_full_name(type);
147 break;
148 case OBERON_TYPE_ARRAY:
149 return new_string("A%sX", jvm_get_descriptor_safe(type -> base));
150 break;
151 default:
152 return jvm_get_descriptor(type);
153 break;
156 return NULL;
159 char
160 jvm_get_prefix(oberon_type_t * type)
162 int size = type -> size;
163 switch(type -> class)
165 case OBERON_TYPE_BOOLEAN:
166 case OBERON_TYPE_INTEGER:
167 case OBERON_TYPE_CHAR:
168 return (size <= 4) ? ('i') : ('l');
169 break;
170 case OBERON_TYPE_PROCEDURE:
171 case OBERON_TYPE_ARRAY:
172 case OBERON_TYPE_RECORD:
173 case OBERON_TYPE_POINTER:
174 return 'a';
175 break;
176 case OBERON_TYPE_REAL:
177 return (size <= 4) ? ('f') : ('d');
178 break;
179 default:
180 gen_error("jvm_get_prefix: wat");
181 return '!';
182 break;
186 char
187 jvm_get_postfix(oberon_type_t * type)
189 int size = type -> size;
190 switch(type -> class)
192 case OBERON_TYPE_BOOLEAN:
193 return 'b';
194 break;
195 case OBERON_TYPE_INTEGER:
196 switch(size)
198 case 1:
199 return 'b';
200 break;
201 case 2:
202 return 's';
203 break;
204 case 4:
205 return 'i';
206 break;
207 case 8:
208 return 'l';
209 break;
210 default:
211 gen_error("jvm_get_postfix: int wat");
212 break;
214 break;
215 case OBERON_TYPE_CHAR:
216 switch(size)
218 case 1:
219 return 'b';
220 break;
221 case 2:
222 return 'c';
223 break;
224 case 4:
225 return 'i';
226 break;
227 case 8:
228 return 'l';
229 break;
230 default:
231 gen_error("jvm_get_postfix: char wat");
232 break;
234 break;
235 case OBERON_TYPE_PROCEDURE:
236 case OBERON_TYPE_ARRAY:
237 case OBERON_TYPE_RECORD:
238 case OBERON_TYPE_POINTER:
239 return 'a';
240 break;
241 case OBERON_TYPE_REAL:
242 return (size <= 4) ? ('f') : ('d');
243 break;
244 default:
245 gen_error("jvm_get_postfix: wat");
246 break;
249 return '!';
252 char *
253 jvm_get_field_full_name(oberon_object_t * x)
255 switch(x -> class)
257 case OBERON_CLASS_VAR:
258 case OBERON_CLASS_PROC:
259 return new_string("%s/%s", x -> module -> name, x -> name);
260 case OBERON_CLASS_FIELD:;
261 char * rec_name = jvm_get_class_full_name(x -> parent_type);
262 return new_string("%s/%s", rec_name, x -> name);
263 case OBERON_CLASS_MODULE:
264 return new_string(x -> module -> name);
265 default:
266 gen_error("jvm_get_field_full_name: wat");
267 break;
270 return NULL;
273 char *
274 jvm_get_field_full_name_safe(oberon_object_t * x)
276 switch(x -> class)
278 case OBERON_CLASS_VAR:
279 case OBERON_CLASS_PROC:
280 return new_string("%s$%s", x -> module -> name, x -> name);
281 case OBERON_CLASS_FIELD:;
282 char * rec_name = jvm_get_class_full_name(x -> parent_type);
283 return new_string("%s$%s", rec_name, x -> name);
284 case OBERON_CLASS_MODULE:
285 return new_string(x -> module -> name);
286 default:
287 gen_error("jvm_get_field_full_name: wat");
288 break;
291 return NULL;
294 char *
295 jvm_get_class_full_name(oberon_type_t * type)
297 int rec_id;
298 char * name = NULL;
300 switch(type -> class)
302 case OBERON_TYPE_POINTER:
303 name = jvm_get_class_full_name(type -> base);
304 break;
305 case OBERON_TYPE_PROCEDURE:
306 name = new_string("SYSTEM$PROCEDURE");
308 char * desc;
309 desc = jvm_get_descriptor_safe(type -> base);
310 name = new_string("%s$%s", name, desc);
312 int num = type -> num_decl;
313 oberon_object_t * arg = type -> decl;
314 for(int i = 0; i < num; i++)
316 desc = jvm_get_descriptor_safe(arg -> type);
317 name = new_string("%s%s", name, desc);
318 arg = arg -> next;
321 break;
322 case OBERON_TYPE_RECORD:
323 rec_id = type -> gen_type -> rec_id;
324 name = new_string("%s$RECORD%i", type -> module -> name, rec_id);
325 break;
326 default:
327 gen_error("jvm_get_class_full_name: unk type class %i", type -> class);
328 break;
331 return name;
334 char *
335 jvm_get_procedure_signature(oberon_type_t * proc)
337 char * signature;
338 char * desc;
340 signature = new_string("(");
342 int num = proc -> num_decl;
343 oberon_object_t * arg = proc -> decl;
344 for(int i = 0; i < num; i++)
346 desc = jvm_get_descriptor(arg -> type);
347 signature = new_string("%s%s", signature, desc);
348 arg = arg -> next;
351 desc = jvm_get_descriptor(proc -> base);
352 signature = new_string("%s)%s", signature, desc);
354 return signature;
357 int
358 jvm_cell_size_for_type(oberon_type_t * type)
360 if(type -> class == OBERON_TYPE_INTEGER
361 || type -> class == OBERON_TYPE_REAL)
363 if(type -> size > 4)
365 return 2;
369 return 1;
372 int
373 jvm_cell_size_for_postfix(char postfix)
375 switch(postfix)
377 case 'a':
378 case 'b':
379 case 's':
380 case 'i':
381 case 'f':
382 return 1;
383 case 'l':
384 case 'd':
385 return 2;
386 default:
387 gen_error("jvm_cell_size_for_postfix: unk postfix %c", postfix);
390 return -666;
393 bool
394 jvm_is_wide_type(oberon_type_t * type)
396 int cell;
397 cell = jvm_cell_size_for_type(type);
398 assert(cell <= 2);
399 return (cell == 2);
402 bool
403 jvm_is_free_register(struct gen_register_file * rf, int i, bool wide)
405 if(wide)
407 assert(i + 1 < MAX_REGISTERS);
408 return !(rf -> reg[i].used || rf -> reg[i + 1].used);
410 else
412 assert(i < MAX_REGISTERS);
413 return !(rf -> reg[i].used);
417 int
418 jvm_alloc_register_untyped(struct gen_register_file * rf, bool wide)
420 int i = 0;
421 while(i < MAX_REGISTERS && !jvm_is_free_register(rf, i, wide))
423 i += 1;
426 if(wide)
428 assert(i + 1 <= MAX_REGISTERS);
429 rf -> num_used += 2;
430 rf -> reg[i].used = true;
431 rf -> reg[i + 1].used = true;
432 rf -> reg[i].used = true;
433 rf -> reg[i + 1].wide = false;
435 else
437 assert(i <= MAX_REGISTERS);
438 rf -> num_used += 1;
439 rf -> reg[i].used = true;
440 rf -> reg[i].wide = false;
443 if(rf -> num_used > rf -> max_used)
445 rf -> max_used = rf -> num_used;
448 return i;
451 int
452 jvm_alloc_register(struct gen_register_file * rf, oberon_type_t * type)
454 bool wide;
455 wide = jvm_is_wide_type(type);
456 return jvm_alloc_register_untyped(rf, wide);
459 char
460 jvm_get_type_of_prefix(char prefix)
462 switch(prefix)
464 case 'b':
465 return 'B';
466 case 'c':
467 return 'C';
468 case 'd':
469 return 'D';
470 case 'f':
471 return 'F';
472 case 'i':
473 return 'I';
474 case 'l':
475 return 'J';
478 assert(0);