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