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