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