DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / dsw-obn.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
JVM: исправлен конфлик имён локальных и глобальных процедур
[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 break;
334 case OBERON_CLASS_PROC:
335 return new_string("%s/%s", x -> module -> name, jvm_get_name(x));
336 break;
337 case OBERON_CLASS_FIELD:
338 parent = jvm_get_class_full_name(x -> parent_type);
339 return new_string("%s/%s", parent, jvm_get_name(x));
340 break;
341 case OBERON_CLASS_MODULE:
342 return new_string(x -> module -> name);
343 break;
344 default:
345 gen_error("jvm_get_field_full_name: wat");
346 break;
347 }
348
349 return NULL;
350 }
351
352 char *
353 jvm_get_field_full_name_safe(oberon_object_t * x)
354 {
355 switch(x -> class)
356 {
357 case OBERON_CLASS_VAR:
358 return new_string("%s$%s", x -> module -> name, x -> name);
359 break;
360 case OBERON_CLASS_PROC:
361 return new_string("%s$%s", x -> module -> name, jvm_get_name(x));
362 break;
363 case OBERON_CLASS_FIELD:;
364 char * rec_name = jvm_get_class_full_name(x -> parent_type);
365 return new_string("%s$%s", rec_name, x -> name);
366 break;
367 case OBERON_CLASS_MODULE:
368 return new_string(x -> module -> name);
369 break;
370 default:
371 gen_error("jvm_get_field_full_name: wat");
372 break;
373 }
374
375 return NULL;
376 }
377
378 char *
379 jvm_get_class_full_name(oberon_type_t * type)
380 {
381 int rec_id;
382 char * name = NULL;
383
384 switch(type -> class)
385 {
386 case OBERON_TYPE_POINTER:
387 name = jvm_get_class_full_name(type -> base);
388 break;
389 case OBERON_TYPE_PROCEDURE:
390 name = new_string("SYSTEM$PROCEDURE");
391
392 char * desc;
393 char * spec;
394 desc = jvm_get_descriptor_safe(type -> base);
395 name = new_string("%s$%s", name, desc);
396
397 int num = type -> num_decl;
398 oberon_object_t * arg = type -> decl;
399
400 for(int i = 0; i < num; i++)
401 {
402 spec = "";
403 if(arg -> class == OBERON_CLASS_VAR_PARAM)
404 {
405 spec = "VAR";
406 }
407 desc = jvm_get_descriptor_safe(arg -> type);
408 name = new_string("%s%s%s", name, spec, desc);
409 arg = arg -> next;
410 }
411
412 break;
413 case OBERON_TYPE_RECORD:
414 rec_id = type -> gen_type -> rec_id;
415 name = new_string("%s$RECORD%i", type -> module -> name, rec_id);
416 break;
417 case OBERON_TYPE_SYSTEM_PTR:
418 name = new_string("java/lang/Object");
419 break;
420 default:
421 gen_error("jvm_get_class_full_name: unk type class %i", type -> class);
422 break;
423 }
424
425 return name;
426 }
427
428 int
429 jvm_cell_size_for_type(oberon_type_t * type)
430 {
431 if(type -> class == OBERON_TYPE_INTEGER
432 || type -> class == OBERON_TYPE_REAL
433 || type -> class == OBERON_TYPE_CHAR
434 || type -> class == OBERON_TYPE_SET)
435 {
436 if(type -> size > 4)
437 {
438 return 2;
439 }
440 }
441 else if(type -> class == OBERON_TYPE_NOTYPE)
442 {
443 return 0;
444 }
445
446 return 1;
447 }
448
449 int
450 jvm_cell_size_for_postfix(char postfix)
451 {
452 switch(postfix)
453 {
454 case ' ':
455 return 0;
456 case 'a':
457 case 'b':
458 case 's':
459 case 'i':
460 case 'f':
461 return 1;
462 case 'l':
463 case 'd':
464 return 2;
465 default:
466 gen_error("jvm_cell_size_for_postfix: unk postfix %c (%i)", postfix, postfix);
467 }
468
469 return -666;
470 }
471
472 bool
473 jvm_is_wide_type(oberon_type_t * type)
474 {
475 int cell;
476 cell = jvm_cell_size_for_type(type);
477 assert(cell <= 2);
478 return (cell == 2);
479 }
480
481 bool
482 jvm_is_free_register(struct gen_register_file * rf, int i, bool wide)
483 {
484 if(wide)
485 {
486 assert(i + 1 < MAX_REGISTERS);
487 return !(rf -> reg[i].used || rf -> reg[i + 1].used);
488 }
489 else
490 {
491 assert(i < MAX_REGISTERS);
492 return !(rf -> reg[i].used);
493 }
494 }
495
496 int
497 jvm_alloc_register_untyped(struct gen_register_file * rf, bool wide)
498 {
499 int i = 0;
500 while(i < MAX_REGISTERS && !jvm_is_free_register(rf, i, wide))
501 {
502 i += 1;
503 }
504
505 if(wide)
506 {
507 assert(i + 1 <= MAX_REGISTERS);
508 rf -> num_used += 2;
509 rf -> reg[i].used = true;
510 rf -> reg[i + 1].used = true;
511 rf -> reg[i].used = true;
512 rf -> reg[i + 1].wide = false;
513 }
514 else
515 {
516 assert(i <= MAX_REGISTERS);
517 rf -> num_used += 1;
518 rf -> reg[i].used = true;
519 rf -> reg[i].wide = false;
520 }
521
522 if(rf -> num_used > rf -> max_used)
523 {
524 rf -> max_used = rf -> num_used;
525 }
526
527 return i;
528 }
529
530 int
531 jvm_alloc_register(struct gen_register_file * rf, oberon_type_t * type)
532 {
533 bool wide;
534 wide = jvm_is_wide_type(type);
535 return jvm_alloc_register_untyped(rf, wide);
536 }
537
538 char
539 jvm_get_type_of_prefix(char prefix)
540 {
541 switch(prefix)
542 {
543 case ' ':
544 return 'V';
545 case 'b':
546 return 'B';
547 case 'c':
548 return 'C';
549 case 'd':
550 return 'D';
551 case 'f':
552 return 'F';
553 case 'i':
554 return 'I';
555 case 'l':
556 return 'J';
557 }
558
559 assert(0);
560 }
Another attempt to make Oberon compiler
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024