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