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_BOOLEAN:
 195                 case OBERON_TYPE_INTEGER:
 196                 case OBERON_TYPE_CHAR:
 197                 case OBERON_TYPE_SET:
 198                 case OBERON_TYPE_SYSTEM_BYTE:
 199                         return (size <= 4) ? ('i') : ('l');
 200                         break;
 201                 case OBERON_TYPE_PROCEDURE:
 202                 case OBERON_TYPE_ARRAY:
 203                 case OBERON_TYPE_RECORD:
 204                 case OBERON_TYPE_POINTER:
 205                 case OBERON_TYPE_STRING:
 206                 case OBERON_TYPE_NIL:
 207                 case OBERON_TYPE_SYSTEM_PTR:
 208                         return 'a';
 209                         break;
 210                 case OBERON_TYPE_REAL:
 211                         return (size <= 4) ? ('f') : ('d');
 212                         break;
 213                 default:
 214                         gen_error("jvm_get_prefix: wat %i", type -> class);
 215                         return '!';
 216                         break;
 217         }
 218 }
 219
 220 char
 221 jvm_get_postfix(oberon_type_t * type)
 222 {
 223         int size = type -> size;
 224         switch(type -> class)
 225         {
 226                 case OBERON_TYPE_BOOLEAN:
 227                         return 'b';
 228                         break;
 229                 case OBERON_TYPE_INTEGER:
 230                 case OBERON_TYPE_SET:
 231                         switch(size)
 232                         {
 233                                 case 1:
 234                                         return 'b';
 235                                         break;
 236                                 case 2:
 237                                         return 's';
 238                                         break;
 239                                 case 4:
 240                                         return 'i';
 241                                         break;
 242                                 case 8:
 243                                         return 'l';
 244                                         break;
 245                                 default:
 246                                         gen_error("jvm_get_postfix: int wat");
 247                                         break;
 248                         }
 249                         break;
 250                 case OBERON_TYPE_SYSTEM_BYTE:
 251                         return 'b';
 252                         break;
 253                 case OBERON_TYPE_CHAR:
 254                         switch(size)
 255                         {
 256                                 case 1:
 257                                         return 'b';
 258                                         break;
 259                                 case 2:
 260                                         return 'c';
 261                                         break;
 262                                 case 4:
 263                                         return 'i';
 264                                         break;
 265                                 case 8:
 266                                         return 'l';
 267                                         break;
 268                                 default:
 269                                         gen_error("jvm_get_postfix: char wat");
 270                                         break;
 271                         }
 272                         break;
 273                 case OBERON_TYPE_PROCEDURE:
 274                 case OBERON_TYPE_ARRAY:
 275                 case OBERON_TYPE_RECORD:
 276                 case OBERON_TYPE_POINTER:
 277                 case OBERON_TYPE_STRING:
 278                 case OBERON_TYPE_NIL:
 279                 case OBERON_TYPE_SYSTEM_PTR:
 280                         return 'a';
 281                         break;
 282                 case OBERON_TYPE_REAL:
 283                         return (size <= 4) ? ('f') : ('d');
 284                         break;
 285                 default:
 286                         gen_error("jvm_get_postfix: wat");
 287                         break;
 288         }
 289
 290         return '!';
 291 }
 292
 293 char *
 294 jvm_get_name(oberon_object_t * x)
 295 {
 296         switch(x -> class)
 297         {
 298                 case OBERON_CLASS_VAR:
 299                 case OBERON_CLASS_VAR_PARAM:
 300                 case OBERON_CLASS_PARAM:
 301                 case OBERON_CLASS_FIELD:
 302                         return new_string(x -> name);
 303                 case OBERON_CLASS_PROC:
 304                         if(x -> parent)
 305                         {
 306                                 return new_string("%s$%s", jvm_get_name(x -> parent), x -> name);
 307                         }
 308                         else
 309                         {
 310                                 return new_string(x -> name);
 311                         }
 312                 default:
 313                         gen_error("jvm_get_name: wat");
 314         }
 315
 316         return NULL;
 317 }
 318
 319 char *
 320 jvm_get_field_full_name(oberon_object_t * x)
 321 {
 322         char * parent;
 323         switch(x -> class)
 324         {
 325                 case OBERON_CLASS_VAR:
 326                         return new_string("%s/%s", x -> module -> name, jvm_get_name(x));
 327                 case OBERON_CLASS_PROC:
 328                         return new_string("%s/%s", x -> module -> name, jvm_get_name(x));
 329                 case OBERON_CLASS_FIELD:
 330                         parent = jvm_get_class_full_name(x -> parent_type);
 331                         return new_string("%s/%s", parent, jvm_get_name(x));
 332                 case OBERON_CLASS_MODULE:
 333                         return new_string(x -> module -> name);
 334                 default:
 335                         gen_error("jvm_get_field_full_name: wat");
 336                         break;
 337         }
 338
 339         return NULL;
 340 }
 341
 342 char *
 343 jvm_get_field_full_name_safe(oberon_object_t * x)
 344 {
 345         switch(x -> class)
 346         {
 347                 case OBERON_CLASS_VAR:
 348                 case OBERON_CLASS_PROC:
 349                         return new_string("%s$%s", x -> module -> name, x -> name);
 350                 case OBERON_CLASS_FIELD:;
 351                         char * rec_name = jvm_get_class_full_name(x -> parent_type);
 352                         return new_string("%s$%s", rec_name, x -> name);
 353                 case OBERON_CLASS_MODULE:
 354                         return new_string(x -> module -> name);
 355                 default:
 356                         gen_error("jvm_get_field_full_name: wat");
 357                         break;
 358         }
 359
 360         return NULL;
 361 }
 362
 363 char *
 364 jvm_get_class_full_name(oberon_type_t * type)
 365 {
 366         int rec_id;
 367         char * name = NULL;
 368
 369         switch(type -> class)
 370         {
 371                 case OBERON_TYPE_POINTER:
 372                         name = jvm_get_class_full_name(type -> base);
 373                         break;
 374                 case OBERON_TYPE_PROCEDURE:
 375                         name = new_string("SYSTEM$PROCEDURE");
 376
 377                         char * desc;
 378                         desc = jvm_get_descriptor_safe(type -> base);
 379                         name = new_string("%s$%s", name, desc);
 380
 381                         int num = type -> num_decl;
 382                         oberon_object_t * arg = type -> decl;
 383
 384                         for(int i = 0; i < num; i++)
 385                         {
 386                                 desc = jvm_get_descriptor_safe(arg -> type);
 387                                 name = new_string("%s%s", name, desc);
 388                                 arg = arg -> next;
 389                         }
 390
 391                         break;
 392                 case OBERON_TYPE_RECORD:
 393                         rec_id = type -> gen_type -> rec_id;
 394                         name = new_string("%s$RECORD%i", type -> module -> name, rec_id);
 395                         break;
 396                 case OBERON_TYPE_SYSTEM_PTR:
 397                         name = new_string("java/lang/Object");
 398                         break;
 399                 default:
 400                         gen_error("jvm_get_class_full_name: unk type class %i", type -> class);
 401                         break;
 402         }
 403
 404         return name;
 405 }
 406
 407 int
 408 jvm_cell_size_for_type(oberon_type_t * type)
 409 {
 410         if(type -> class == OBERON_TYPE_INTEGER
 411                 || type -> class == OBERON_TYPE_REAL
 412                 || type -> class == OBERON_TYPE_CHAR
 413                 || type -> class == OBERON_TYPE_SET)
 414         {
 415                 if(type -> size > 4)
 416                 {
 417                         return 2;
 418                 }
 419         }
 420         else if(type -> class == OBERON_TYPE_NOTYPE)
 421         {
 422                 return 0;
 423         }
 424
 425         return 1;
 426 }
 427
 428 int
 429 jvm_cell_size_for_postfix(char postfix)
 430 {
 431         switch(postfix)
 432         {
 433                 case 'a':
 434                 case 'b':
 435                 case 's':
 436                 case 'i':
 437                 case 'f':
 438                         return 1;
 439                 case 'l':
 440                 case 'd':
 441                         return 2;
 442                 default:
 443                         gen_error("jvm_cell_size_for_postfix: unk postfix %c", postfix);
 444         }
 445
 446         return -666;
 447 }
 448
 449 bool
 450 jvm_is_wide_type(oberon_type_t * type)
 451 {
 452         int cell;
 453         cell = jvm_cell_size_for_type(type);
 454         assert(cell <= 2);
 455         return (cell == 2);
 456 }
 457
 458 bool
 459 jvm_is_free_register(struct gen_register_file * rf, int i, bool wide)
 460 {
 461         if(wide)
 462         {
 463                 assert(i + 1 < MAX_REGISTERS);
 464                 return !(rf -> reg[i].used || rf -> reg[i + 1].used);
 465         }
 466         else
 467         {
 468                 assert(i < MAX_REGISTERS);
 469                 return !(rf -> reg[i].used);
 470         }
 471 }
 472
 473 int
 474 jvm_alloc_register_untyped(struct gen_register_file * rf, bool wide)
 475 {
 476         int i = 0;
 477         while(i < MAX_REGISTERS && !jvm_is_free_register(rf, i, wide))
 478         {
 479                 i += 1;
 480         }
 481
 482         if(wide)
 483         {
 484                 assert(i + 1 <= MAX_REGISTERS);
 485                 rf -> num_used += 2;
 486                 rf -> reg[i].used = true;
 487                 rf -> reg[i + 1].used = true;
 488                 rf -> reg[i].used = true;
 489                 rf -> reg[i + 1].wide = false;
 490         }
 491         else
 492         {
 493                 assert(i <= MAX_REGISTERS);
 494                 rf -> num_used += 1;
 495                 rf -> reg[i].used = true;
 496                 rf -> reg[i].wide = false;
 497         }
 498
 499         if(rf -> num_used > rf -> max_used)
 500         {
 501                 rf -> max_used = rf -> num_used;
 502         }
 503
 504         return i;
 505 }
 506
 507 int
 508 jvm_alloc_register(struct gen_register_file * rf, oberon_type_t * type)
 509 {
 510         bool wide;
 511         wide = jvm_is_wide_type(type);
 512         return jvm_alloc_register_untyped(rf, wide);
 513 }
 514
 515 char
 516 jvm_get_type_of_prefix(char prefix)
 517 {
 518         switch(prefix)
 519         {
 520                 case 'b':
 521                         return 'B';
 522                 case 'c':
 523                         return 'C';
 524                 case 'd':
 525                         return 'D';
 526                 case 'f':
 527                         return 'F';
 528                 case 'i':
 529                         return 'I';
 530                 case 'l':
 531                         return 'J';
 532         }
 533
 534         assert(0);
 535 }