DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / dsw-obn.git / blob


033b84227d1eebfb4bbda213e94e19e889229f78
[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>
7
8 #include <gc.h>
9
10 #include "../../oberon-internals.h"
11 #include "generator-jvm.h"
12 #include "generator-jvm-basic.h"
13
14 char *
15 new_string(const char * format, ...)
16 {
17 va_list ptr;
18 va_start(ptr, format);
19
20 char buf[1024];
21 vsnprintf(buf, 1024, format, ptr);
22
23 va_end(ptr);
24
25 char * result;
26 int size;
27
28 size = strlen(buf);
29 result = GC_MALLOC(size + 1);
30 memset(result, 0, size);
31 strncpy(result, buf, size);
32
33 return result;
34 }
35
36 void
37 gen_error(const char * fmt, ...)
38 {
39 va_list ptr;
40 va_start(ptr, fmt);
41 fprintf(stderr, "generator: ");
42 vfprintf(stderr, fmt, ptr);
43 fprintf(stderr, "\n");
44 va_end(ptr);
45 exit(1);
46 }
47
48 char *
49 jvm_get_descriptor(oberon_type_t * type)
50 {
51 char * desc;
52
53 switch(type -> class)
54 {
55 case OBERON_TYPE_NOTYPE:
56 return new_string("V");
57 break;
58 case OBERON_TYPE_INTEGER:
59 case OBERON_TYPE_SET:
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_SYSTEM_BYTE:
80 return new_string("B");
81 break;
82 case OBERON_TYPE_REAL:
83 switch(type -> size)
84 {
85 case 4:
86 return new_string("F");
87 break;
88 case 8:
89 return new_string("D");
90 break;
91 default:
92 gen_error("jvm_get_descriptor: unsupported float size %i", type -> size);
93 break;
94 }
95 break;
96 case OBERON_TYPE_CHAR:
97 switch(type -> size)
98 {
99 case 1:
100 return new_string("B");
101 break;
102 case 2:
103 return new_string("C");
104 break;
105 case 4:
106 return new_string("I");
107 break;
108 case 8:
109 return new_string("J");
110 break;
111 default:
112 gen_error("jvm_get_descriptor: unsupported char size %i", type -> size);
113 break;
114 }
115 break;
116 case OBERON_TYPE_BOOLEAN:
117 return new_string("Z");
118 break;
119 case OBERON_TYPE_POINTER:
120 return jvm_get_descriptor(type -> base);
121 break;
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);
126 break;
127 case OBERON_TYPE_ARRAY:
128 desc = jvm_get_descriptor(type -> base);
129 return new_string("[%s", desc);
130 break;
131 case OBERON_TYPE_STRING:
132 switch(type -> size)
133 {
134 case 1:
135 return new_string("[B");
136 break;
137 case 2:
138 return new_string("[C");
139 break;
140 case 4:
141 return new_string("[I");
142 break;
143 case 8:
144 return new_string("[J");
145 break;
146 default:
147 gen_error("jvm_get_descriptor: unsupported string size %i", type -> size);
148 break;
149 }
150 break;
151 case OBERON_TYPE_SYSTEM_PTR:
152 return new_string("Ljava/lang/Object;");
153 break;
154 default:
155 gen_error("jvm_get_descriptor: unsupported type class %i", type -> class);
156 break;
157 }
158
159 return NULL;
160 }
161
162 char *
163 jvm_get_descriptor_safe(oberon_type_t * type)
164 {
165 switch(type -> class)
166 {
167 case OBERON_TYPE_POINTER:
168 return new_string("PTR%s", jvm_get_descriptor_safe(type -> base));
169 break;
170 case OBERON_TYPE_PROCEDURE:
171 case OBERON_TYPE_RECORD:
172 return jvm_get_class_full_name(type);
173 break;
174 case OBERON_TYPE_ARRAY:
175 return new_string("A%s", jvm_get_descriptor_safe(type -> base));
176 break;
177 case OBERON_TYPE_SYSTEM_PTR:
178 return new_string("SYSPTR");
179 break;
180 default:
181 return jvm_get_descriptor(type);
182 break;
183 }
184
185 return NULL;
186 }
187
188 char
189 jvm_get_prefix(oberon_type_t * type)
190 {
191 int size = type -> size;
192 switch(type -> class)
193 {
194 case OBERON_TYPE_NOTYPE:
195 return ' ';
196 break;
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');
203 break;
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:
211 return 'a';
212 break;
213 case OBERON_TYPE_REAL:
214 return (size <= 4) ? ('f') : ('d');
215 break;
216 default:
217 gen_error("jvm_get_prefix: wat %i", type -> class);
218 return '!';
219 break;
220 }
221 }
222
223 char
224 jvm_get_postfix(oberon_type_t * type)
225 {
226 int size = type -> size;
227 switch(type -> class)
228 {
229 case OBERON_TYPE_NOTYPE:
230 return ' ';
231 break;
232 case OBERON_TYPE_BOOLEAN:
233 return 'b';
234 break;
235 case OBERON_TYPE_INTEGER:
236 case OBERON_TYPE_SET:
237 switch(size)
238 {
239 case 1:
240 return 'b';
241 break;
242 case 2:
243 return 's';
244 break;
245 case 4:
246 return 'i';
247 break;
248 case 8:
249 return 'l';
250 break;
251 default:
252 gen_error("jvm_get_postfix: int wat");
253 break;
254 }
255 break;
256 case OBERON_TYPE_SYSTEM_BYTE:
257 return 'b';
258 break;
259 case OBERON_TYPE_CHAR:
260 switch(size)
261 {
262 case 1:
263 return 'b';
264 break;
265 case 2:
266 return 'c';
267 break;
268 case 4:
269 return 'i';
270 break;
271 case 8:
272 return 'l';
273 break;
274 default:
275 gen_error("jvm_get_postfix: char wat");
276 break;
277 }
278 break;
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:
286 return 'a';
287 break;
288 case OBERON_TYPE_REAL:
289 return (size <= 4) ? ('f') : ('d');
290 break;
291 default:
292 gen_error("jvm_get_postfix: wat");
293 break;
294 }
295
296 return '!';
297 }
298
299 char *
300 jvm_get_name(oberon_object_t * x)
301 {
302 switch(x -> class)
303 {
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:
310 if(x -> parent)
311 {
312 return new_string("%s$%s", jvm_get_name(x -> parent), x -> name);
313 }
314 else
315 {
316 return new_string(x -> name);
317 }
318 default:
319 gen_error("jvm_get_name: wat");
320 }
321
322 return NULL;
323 }
324
325 char *
326 jvm_get_field_full_name(oberon_object_t * x)
327 {
328 char * parent;
329 switch(x -> class)
330 {
331 case OBERON_CLASS_VAR:
332 return new_string("%s/%s", x -> module -> name, jvm_get_name(x));
333 case OBERON_CLASS_PROC:
334 return new_string("%s/%s", x -> module -> name, jvm_get_name(x));
335 case OBERON_CLASS_FIELD:
336 parent = jvm_get_class_full_name(x -> parent_type);
337 return new_string("%s/%s", parent, jvm_get_name(x));
338 case OBERON_CLASS_MODULE:
339 return new_string(x -> module -> name);
340 default:
341 gen_error("jvm_get_field_full_name: wat");
342 break;
343 }
344
345 return NULL;
346 }
347
348 char *
349 jvm_get_field_full_name_safe(oberon_object_t * x)
350 {
351 switch(x -> class)
352 {
353 case OBERON_CLASS_VAR:
354 case OBERON_CLASS_PROC:
355 return new_string("%s$%s", x -> module -> name, x -> name);
356 case OBERON_CLASS_FIELD:;
357 char * rec_name = jvm_get_class_full_name(x -> parent_type);
358 return new_string("%s$%s", rec_name, x -> name);
359 case OBERON_CLASS_MODULE:
360 return new_string(x -> module -> name);
361 default:
362 gen_error("jvm_get_field_full_name: wat");
363 break;
364 }
365
366 return NULL;
367 }
368
369 char *
370 jvm_get_class_full_name(oberon_type_t * type)
371 {
372 int rec_id;
373 char * name = NULL;
374
375 switch(type -> class)
376 {
377 case OBERON_TYPE_POINTER:
378 name = jvm_get_class_full_name(type -> base);
379 break;
380 case OBERON_TYPE_PROCEDURE:
381 name = new_string("SYSTEM$PROCEDURE");
382
383 char * desc;
384 char * spec;
385 desc = jvm_get_descriptor_safe(type -> base);
386 name = new_string("%s$%s", name, desc);
387
388 int num = type -> num_decl;
389 oberon_object_t * arg = type -> decl;
390
391 for(int i = 0; i < num; i++)
392 {
393 spec = "";
394 if(arg -> class == OBERON_CLASS_VAR_PARAM)
395 {
396 spec = "VAR";
397 }
398 desc = jvm_get_descriptor_safe(arg -> type);
399 name = new_string("%s%s%s", name, spec, desc);
400 arg = arg -> next;
401 }
402
403 break;
404 case OBERON_TYPE_RECORD:
405 rec_id = type -> gen_type -> rec_id;
406 name = new_string("%s$RECORD%i", type -> module -> name, rec_id);
407 break;
408 case OBERON_TYPE_SYSTEM_PTR:
409 name = new_string("java/lang/Object");
410 break;
411 default:
412 gen_error("jvm_get_class_full_name: unk type class %i", type -> class);
413 break;
414 }
415
416 return name;
417 }
418
419 int
420 jvm_cell_size_for_type(oberon_type_t * type)
421 {
422 if(type -> class == OBERON_TYPE_INTEGER
423 || type -> class == OBERON_TYPE_REAL
424 || type -> class == OBERON_TYPE_CHAR
425 || type -> class == OBERON_TYPE_SET)
426 {
427 if(type -> size > 4)
428 {
429 return 2;
430 }
431 }
432 else if(type -> class == OBERON_TYPE_NOTYPE)
433 {
434 return 0;
435 }
436
437 return 1;
438 }
439
440 int
441 jvm_cell_size_for_postfix(char postfix)
442 {
443 switch(postfix)
444 {
445 case ' ':
446 return 0;
447 case 'a':
448 case 'b':
449 case 's':
450 case 'i':
451 case 'f':
452 return 1;
453 case 'l':
454 case 'd':
455 return 2;
456 default:
457 gen_error("jvm_cell_size_for_postfix: unk postfix %c (%i)", postfix, postfix);
458 }
459
460 return -666;
461 }
462
463 bool
464 jvm_is_wide_type(oberon_type_t * type)
465 {
466 int cell;
467 cell = jvm_cell_size_for_type(type);
468 assert(cell <= 2);
469 return (cell == 2);
470 }
471
472 bool
473 jvm_is_free_register(struct gen_register_file * rf, int i, bool wide)
474 {
475 if(wide)
476 {
477 assert(i + 1 < MAX_REGISTERS);
478 return !(rf -> reg[i].used || rf -> reg[i + 1].used);
479 }
480 else
481 {
482 assert(i < MAX_REGISTERS);
483 return !(rf -> reg[i].used);
484 }
485 }
486
487 int
488 jvm_alloc_register_untyped(struct gen_register_file * rf, bool wide)
489 {
490 int i = 0;
491 while(i < MAX_REGISTERS && !jvm_is_free_register(rf, i, wide))
492 {
493 i += 1;
494 }
495
496 if(wide)
497 {
498 assert(i + 1 <= MAX_REGISTERS);
499 rf -> num_used += 2;
500 rf -> reg[i].used = true;
501 rf -> reg[i + 1].used = true;
502 rf -> reg[i].used = true;
503 rf -> reg[i + 1].wide = false;
504 }
505 else
506 {
507 assert(i <= MAX_REGISTERS);
508 rf -> num_used += 1;
509 rf -> reg[i].used = true;
510 rf -> reg[i].wide = false;
511 }
512
513 if(rf -> num_used > rf -> max_used)
514 {
515 rf -> max_used = rf -> num_used;
516 }
517
518 return i;
519 }
520
521 int
522 jvm_alloc_register(struct gen_register_file * rf, oberon_type_t * type)
523 {
524 bool wide;
525 wide = jvm_is_wide_type(type);
526 return jvm_alloc_register_untyped(rf, wide);
527 }
528
529 char
530 jvm_get_type_of_prefix(char prefix)
531 {
532 switch(prefix)
533 {
534 case ' ':
535 return 'V';
536 case 'b':
537 return 'B';
538 case 'c':
539 return 'C';
540 case 'd':
541 return 'D';
542 case 'f':
543 return 'F';
544 case 'i':
545 return 'I';
546 case 'l':
547 return 'J';
548 }
549
550 assert(0);
551 }
Another attempt to make Oberon compiler
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024