src/backends/jvm/generator-jvm.c

   1 #include <stdio.h>
   2 #include <stdarg.h>
   3 #include <stdbool.h>
   4 #include <string.h>
   5 #include <assert.h>
   6
   7 #include <gc.h>
   8
   9 #include "../../../include/oberon.h"
  10 #include "../../oberon-internals.h"
  11 #include "generator-jvm.h"
  12
  13 char *
  14 new_string(const char * format, ...)
  15 {
  16         va_list ptr;
  17         va_start(ptr, format);
  18
  19         char buf[1024];
  20         vsnprintf(buf, 1024, format, ptr);
  21
  22         va_end(ptr);
  23
  24         char * result;
  25         int size;
  26
  27         size = strlen(buf);
  28         result = GC_MALLOC(size + 1);
  29         memset(result, 0, size);
  30         strncpy(result, buf, size);
  31
  32         return result;
  33 }
  34
  35 void
  36 oberon_generator_init_context(oberon_context_t * ctx)
  37 {
  38         gen_context_t * gen_context = GC_MALLOC(sizeof *gen_context);
  39         memset(gen_context, 0, sizeof *gen_context);
  40
  41         ctx -> gen_context = gen_context;
  42 }
  43
  44 void
  45 oberon_generator_destroy_context(oberon_context_t * ctx)
  46 {
  47         ctx -> gen_context = NULL;
  48 }
  49
  50 static char * get_class_full_name(oberon_context_t * ctx, oberon_type_t * type);
  51
  52 static char *
  53 get_descriptor(oberon_context_t * ctx, oberon_type_t * type)
  54 {
  55         char * desc;
  56
  57         switch(type -> class)
  58         {
  59                 case OBERON_TYPE_VOID:
  60                         return new_string("V");
  61                         break;
  62                 case OBERON_TYPE_INTEGER:
  63                         switch(type -> size)
  64                         {
  65                                 case 1:
  66                                         return new_string("B");
  67                                         break;
  68                                 case 2:
  69                                         return new_string("S");
  70                                         break;
  71                                 case 4:
  72                                         return new_string("I");
  73                                         break;
  74                                 case 8:
  75                                         return new_string("J");
  76                                         break;
  77                                 default:
  78                                         oberon_error(ctx, "get_descriptor: unsupported int size %i", type -> size);
  79                                         break;
  80                         }
  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                                         oberon_error(ctx, "get_descriptor: unsupported float size %i", type -> size);
  93                                         break;
  94                         }
  95                         break;
  96                 case OBERON_TYPE_BOOLEAN:
  97                         return new_string("Z");
  98                         break;
  99                 case OBERON_TYPE_PROCEDURE:
 100                 case OBERON_TYPE_RECORD:
 101                         desc = get_class_full_name(ctx, type);
 102                         return new_string("L%s;", desc);
 103                         break;
 104                 case OBERON_TYPE_ARRAY:
 105                         desc = get_descriptor(ctx, type -> base);
 106                         return new_string("[%s", desc);
 107                         break;
 108                 default:
 109                         oberon_error(ctx, "print_descriptor: unsupported type class %i", type -> class);
 110                         break;
 111         }
 112
 113         return NULL;
 114 }
 115
 116 static char
 117 get_prefix(oberon_context_t * ctx, oberon_type_t * type)
 118 {
 119         int size = type -> size;
 120         switch(type -> class)
 121         {
 122                 case OBERON_TYPE_BOOLEAN:
 123                 case OBERON_TYPE_INTEGER:
 124                         return (size <= 4) ? ('i') : ('l');
 125                         break;
 126                 case OBERON_TYPE_PROCEDURE:
 127                 case OBERON_TYPE_ARRAY:
 128                 case OBERON_TYPE_RECORD:
 129                 case OBERON_TYPE_POINTER:
 130                         return 'a';
 131                         break;
 132                 case OBERON_TYPE_REAL:
 133                         return (size <= 4) ? ('f') : ('d');
 134                         break;
 135         }
 136
 137         oberon_error(ctx, "get_prefix: wat");
 138         return '!';
 139 }
 140
 141 static char *
 142 get_field_full_name(oberon_context_t * ctx, oberon_object_t * x)
 143 {
 144         return new_string("%s/%s", x -> module -> name, x -> name);
 145 }
 146
 147 static char *
 148 get_class_full_name(oberon_context_t * ctx, oberon_type_t * type)
 149 {
 150         int rec_id;
 151         char * name = NULL;
 152
 153         switch(type -> class)
 154         {
 155                 case OBERON_TYPE_PROCEDURE:
 156                         name = new_string("SYSTEM$PROCEDURE");
 157
 158                         char * desc;
 159                         desc = get_descriptor(ctx, type -> base);
 160                         name = new_string("%s$%s", name, desc);
 161
 162                         int num = type -> num_decl;
 163                         oberon_object_t * arg = type -> decl;
 164                         for(int i = 0; i < num; i++)
 165                         {
 166                                 desc = get_descriptor(ctx, arg -> type);
 167                                 name = new_string("%s%s", name, desc);
 168                                 arg = arg -> next;
 169                         }
 170
 171                         break;
 172                 case OBERON_TYPE_RECORD:
 173                         assert(type -> module);
 174                         assert(type -> module -> gen_mod);
 175                         rec_id = type -> gen_type -> rec_id;
 176                         name = new_string("%s$RECORD%i", type -> module -> name, rec_id);
 177                         break;
 178                 default:
 179                         oberon_error(ctx, "get_record_full_name: unk type class %i", type -> class);
 180                         break;
 181         }
 182
 183         return name;
 184 }
 185
 186 static char *
 187 get_procedure_signature(oberon_context_t * ctx, oberon_type_t * proc)
 188 {
 189         char * signature;
 190         char * desc;
 191
 192         signature = new_string("(");
 193
 194         int num = proc -> num_decl;
 195         oberon_object_t * arg = proc -> decl;
 196         for(int i = 0; i < num; i++)
 197         {
 198                 desc = get_descriptor(ctx, arg -> type);
 199                 signature = new_string("%s%s", signature, desc);
 200                 arg = arg -> next;
 201         }
 202
 203         desc = get_descriptor(ctx, proc -> base);
 204         signature = new_string("%s)%s", signature, desc);
 205
 206         return signature;
 207 }
 208
 209 static void
 210 oberon_generate_procedure_class(oberon_context_t * ctx, oberon_type_t * proc)
 211 {
 212         FILE * fp;
 213         char * cname;
 214         char * fname;
 215         char * signature;
 216
 217         cname = get_class_full_name(ctx, proc);
 218         fname = new_string("%s.j", cname);
 219
 220         fp = fopen(fname, "w");
 221
 222         fprintf(fp, ".source SYSTEM\n");
 223         fprintf(fp, ".class  public abstract %s\n", cname);
 224         fprintf(fp, ".super  java/lang/Object\n\n");
 225
 226         signature = get_procedure_signature(ctx, proc);
 227
 228         fprintf(fp, ".method public <init>()V\n");
 229         fprintf(fp, "  aload_0\n");
 230         fprintf(fp, "  invokespecial java/lang/Object/<init>()V\n");
 231         fprintf(fp, "  return\n");
 232         fprintf(fp, ".end method\n");
 233
 234         fprintf(fp, ".method public abstract invoke%s\n", signature);
 235         fprintf(fp, ".end method\n\n");
 236
 237         fclose(fp);
 238 }
 239
 240 static void
 241 oberon_generate_record_class(oberon_context_t * ctx, oberon_type_t * rec)
 242 {
 243         FILE * fp;
 244         char * cname;
 245         char * fname;
 246
 247         /* Устанавливаем новоый id */
 248         rec -> gen_type -> rec_id = rec -> module -> gen_mod -> rec_id;
 249         rec -> module -> gen_mod -> rec_id += 1;
 250
 251         cname = get_class_full_name(ctx, rec);
 252         fname = new_string("%s.j", cname);
 253
 254         fp = fopen(fname, "w");
 255
 256         fprintf(fp, ".source %s\n", rec -> module -> name);
 257         fprintf(fp, ".class  public %s\n", cname);
 258         fprintf(fp, ".super  java/lang/Object\n\n");
 259
 260         rec -> gen_type -> fp = fp;
 261 }
 262
 263 void
 264 oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type)
 265 {
 266         gen_type_t * t = GC_MALLOC(sizeof *t);
 267         memset(t, 0, sizeof *t);
 268         type -> gen_type = t;
 269
 270         switch(type -> class)
 271         {
 272                 case OBERON_TYPE_VOID:
 273                 case OBERON_TYPE_INTEGER:
 274                 case OBERON_TYPE_BOOLEAN:
 275                 case OBERON_TYPE_ARRAY:
 276                 case OBERON_TYPE_REAL:
 277                         break;
 278                 case OBERON_TYPE_RECORD:
 279                         oberon_generate_record_class(ctx, type);
 280                         break;
 281                 case OBERON_TYPE_PROCEDURE:
 282                         oberon_generate_procedure_class(ctx, type);
 283                         break;
 284                 case OBERON_TYPE_POINTER:
 285                         assert(type -> base -> class == OBERON_TYPE_VOID);
 286                         break;
 287                 default:
 288                         oberon_error(ctx, "oberon_generator_init_type: unk calss %i", type -> class);
 289                         break;
 290         }
 291 }
 292
 293 static void
 294 oberon_generate_object(oberon_context_t * ctx, FILE * fp, oberon_object_t * x)
 295 {
 296         char * name;
 297         char * desc;
 298
 299         name = x -> name;
 300         desc = get_descriptor(ctx, x -> type);
 301         switch(x -> class)
 302         {
 303                 case OBERON_CLASS_VAR:
 304                         fprintf(fp, ".field public static %s %s\n\n", name, desc);
 305                         break;
 306                 case OBERON_CLASS_FIELD:
 307                         fprintf(fp, ".field public %s %s\n\n", name, desc);
 308                         break;
 309                 default:
 310                         oberon_error(ctx, "oberon_generate_object: unk class %i", x -> class);
 311                         break;
 312         }
 313 }
 314
 315 void
 316 oberon_generator_init_record(oberon_context_t * ctx, oberon_type_t * rec)
 317 {
 318         FILE * fp;
 319
 320         fp = rec -> gen_type -> fp;
 321
 322         int num = rec -> num_decl;
 323         oberon_object_t * field = rec -> decl;
 324         for(int i = 0; i < num; i++)
 325         {
 326                 oberon_generate_object(ctx, fp, field);
 327                 field = field -> next;
 328         }
 329
 330         fprintf(fp, ".method public <init>()V\n");
 331         fprintf(fp, "  aload_0\n");
 332         fprintf(fp, "  invokespecial java/lang/Object/<init>()V\n");
 333         fprintf(fp, "  return\n");
 334         fprintf(fp, ".end method\n");
 335
 336         fclose(fp);
 337 }
 338
 339 void
 340 oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var)
 341 {
 342         gen_var_t * v = GC_MALLOC(sizeof *v);
 343         memset(v, 0, sizeof *v);
 344         var -> gen_var = v;
 345
 346         gen_module_t * m = ctx -> mod -> gen_mod;
 347
 348         switch(var -> class)
 349         {
 350                 case OBERON_CLASS_PARAM:
 351                 case OBERON_CLASS_FIELD:
 352                         break;
 353                 case OBERON_CLASS_VAR:
 354                         oberon_generate_object(ctx, m -> fp, var);
 355                         break;
 356                 default:
 357                         oberon_error(ctx, "oberon_generator_init_var: unk var class %i", var -> class);
 358                         break;
 359         }
 360 }
 361
 362 void
 363 oberon_generator_init_proc(oberon_context_t * ctx, oberon_object_t * proc)
 364 {
 365         gen_proc_t * p = GC_MALLOC(sizeof *p);
 366         memset(p, 0, sizeof *p);
 367         proc -> gen_proc = p;
 368
 369         if(proc -> local)
 370         {
 371                 oberon_error(ctx, "generator: local procedures not implemented");
 372         }
 373 }
 374
 375 void
 376 oberon_generator_init_module(oberon_context_t * ctx, oberon_module_t * mod)
 377 {
 378         gen_module_t * m = GC_MALLOC(sizeof *m);
 379         memset(m, 0, sizeof *m);
 380         mod -> gen_mod = m;
 381
 382         int fnamesz = strlen(mod -> name) + 3;
 383         char fname[fnamesz + 1];
 384         snprintf(fname, fnamesz, "%s.j", mod -> name);
 385
 386         FILE * fp;
 387         fp = fopen(fname, "w");
 388         assert(fp != NULL);
 389
 390         fprintf(fp, ".source %s\n", mod -> name);
 391         fprintf(fp, ".class %s\n", mod -> name);
 392         fprintf(fp, ".super java/lang/Object\n\n");
 393
 394         m -> fp = fp;
 395 }
 396
 397 // =======================================================================
 398 //   GENERATOR
 399 // =======================================================================
 400
 401 void
 402 oberon_generate_begin_module(oberon_context_t * ctx)
 403 {
 404         gen_module_t * m = ctx -> mod -> gen_mod;
 405         fprintf(m -> fp, ".method public <init>()V\n");
 406         fprintf(m -> fp, "  aload_0\n");
 407         fprintf(m -> fp, "  invokespecial java/lang/Object/<init>()V\n");
 408 }
 409
 410 void
 411 oberon_generate_end_module(oberon_context_t * ctx)
 412 {
 413         gen_module_t * m = ctx -> mod -> gen_mod;
 414
 415         fprintf(m -> fp, "  .limit stack 32\n");
 416         fprintf(m -> fp, "  .limit locals 32\n");
 417         fprintf(m -> fp, "  return\n");
 418         fprintf(m -> fp, ".end method\n");
 419 }
 420
 421 void
 422 oberon_generate_begin_proc(oberon_context_t * ctx, oberon_object_t * proc)
 423 {
 424         gen_module_t * m;
 425         char * signature;
 426
 427         m = ctx -> mod -> gen_mod;
 428         signature = get_procedure_signature(ctx, proc -> type);
 429
 430         fprintf(m -> fp, ".method public static %s%s\n", proc -> name, signature);
 431 }
 432
 433 void
 434 oberon_generate_call_proc(oberon_context_t * ctx, oberon_expr_t * desig)
 435 {
 436         printf("call proc\n");
 437 }
 438
 439 void
 440 oberon_generate_end_proc(oberon_context_t * ctx)
 441 {
 442         gen_module_t * m;
 443         m = ctx -> mod -> gen_mod;
 444
 445         fprintf(m -> fp, "  .limit stack 32\n");
 446         fprintf(m -> fp, "  .limit locals 32\n");
 447         fprintf(m -> fp, ".end method\n\n");
 448 }
 449
 450 void
 451 oberon_generate_return(oberon_context_t * ctx, oberon_expr_t * expr)
 452 {
 453         gen_module_t * m;
 454
 455         m = ctx -> mod -> gen_mod;
 456
 457         if(expr)
 458         {
 459                 oberon_error(ctx, "oberon_generate_return: TODO return expr");
 460         }
 461         else
 462         {
 463                 fprintf(m -> fp, "  return\n");
 464         }
 465 }
 466
 467 static void
 468 push_int(FILE * fp, long i)
 469 {
 470         if(i == -1)
 471         {
 472                 fprintf(fp, "iconst_m1\n");
 473         }
 474         else if(i >= 0 && i <= 5)
 475         {
 476                 fprintf(fp, "iconst_%li\n", i);
 477         }
 478         else if(i >= -128 && i <= 127)
 479         {
 480                 fprintf(fp, "bipush %li\n", i);
 481         }
 482         else if(i >= -32768 && i <= 32767)
 483         {
 484                 fprintf(fp, "sipush %li\n", i);
 485         }
 486         else if(i >= -2147483648 && i <= 2147483647)
 487         {
 488                 fprintf(fp, "ldc %li\n", i);
 489         }
 490         else
 491         {
 492                 fprintf(fp, "ldc2 %li\n", i);
 493         }
 494 }
 495
 496 static void
 497 push_float(FILE * fp, double f, int size)
 498 {
 499         if(size <= 4)
 500         {
 501                 if(f == 0.0)
 502                 {
 503                         fprintf(fp, "fconst_0\n");
 504                 }
 505                 if(f == 1.0)
 506                 {
 507                         fprintf(fp, "fconst_1\n");
 508                 }
 509                 if(f == 2.0)
 510                 {
 511                         fprintf(fp, "fconst_2\n");
 512                 }
 513                 else
 514                 {
 515                         fprintf(fp, "ldc %lf\n", f);
 516                 }
 517         }
 518         else
 519         {
 520                 if(f == 0.0)
 521                 {
 522                         fprintf(fp, "dconst_0\n");
 523                 }
 524                 if(f == 1.0)
 525                 {
 526                         fprintf(fp, "dconst_1\n");
 527                 }
 528                 else
 529                 {
 530                         fprintf(fp, "ldc2 %lf\n", f);
 531                 }
 532         }
 533 }
 534
 535 static void push_expr(oberon_context_t * ctx, FILE * fp, oberon_expr_t * expr);
 536
 537 static void
 538 push_var(oberon_context_t * ctx, FILE * fp, oberon_object_t * var)
 539 {
 540         if(var -> local)
 541         {
 542                 int reg = var -> gen_var -> reg;
 543                 char prefix = get_prefix(ctx, var -> type);
 544                 fprintf(fp, "%cload %i\n", prefix, reg);
 545         }
 546         else
 547         {
 548                 char * fullname = get_field_full_name(ctx, var);
 549                 char * desc = get_descriptor(ctx, var -> type);
 550                 fprintf(fp, "getstatic %s %s\n", fullname, desc);
 551         }
 552 }
 553
 554 static void
 555 push_item(oberon_context_t * ctx, FILE * fp, oberon_item_t * item)
 556 {
 557         switch(item -> mode)
 558         {
 559                 case MODE_VAR:
 560                         push_var(ctx, fp, item -> var);
 561                         break;
 562                 case MODE_INTEGER:
 563                         push_int(fp, item -> integer);
 564                         break;
 565                 case MODE_BOOLEAN:
 566                         push_int(fp, item -> boolean);
 567                         break;
 568                 case MODE_CALL:
 569                         oberon_error(ctx, "push_item: TODO call");
 570                         break;
 571                 case MODE_INDEX:
 572                         oberon_error(ctx, "push_item: TODO index");
 573                         break;
 574                 case MODE_FIELD:
 575                         oberon_error(ctx, "push_item: TODO field");
 576                         break;
 577                 case MODE_DEREF:
 578                         oberon_error(ctx, "push_item: TODO deref");
 579                         break;
 580                 case MODE_NIL:
 581                         fprintf(fp, "aconst_null\n");
 582                         break;
 583                 case MODE_NEW:
 584                         oberon_error(ctx, "push_item: TODO new");
 585                         break;
 586                 case MODE_REAL:
 587                         push_float(fp, item -> real, item -> result -> size);
 588                         break;
 589                 default:
 590                         oberon_error(ctx, "push_item: unk mode %i", item -> mode);
 591                         break;
 592         }
 593 }
 594
 595 static void
 596 push_operator(oberon_context_t * ctx, FILE * fp, oberon_oper_t * oper)
 597 {
 598         char prefix = get_prefix(ctx, oper -> result);
 599         switch(oper -> op)
 600         {
 601                 case OP_UNARY_MINUS:
 602                         push_expr(ctx, fp, oper -> left);
 603                         fprintf(fp, "%cneg\n", prefix);
 604                         break;
 605                 case OP_BITWISE_NOT:
 606                         push_expr(ctx, fp, oper -> left);
 607                         push_int(fp, -1);
 608                         fprintf(fp, "%cxor\n", prefix);
 609                         break;
 610
 611                 case OP_ADD:
 612                         push_expr(ctx, fp, oper -> left);
 613                         push_expr(ctx, fp, oper -> right);
 614                         fprintf(fp, "%cadd\n", prefix);
 615                         break;
 616                 case OP_SUB:
 617                         push_expr(ctx, fp, oper -> left);
 618                         push_expr(ctx, fp, oper -> right);
 619                         fprintf(fp, "%csub\n", prefix);
 620                         break;
 621                 case OP_MUL:
 622                         push_expr(ctx, fp, oper -> left);
 623                         push_expr(ctx, fp, oper -> right);
 624                         fprintf(fp, "%cmul\n", prefix);
 625                         break;
 626                 case OP_DIV:
 627                         push_expr(ctx, fp, oper -> left);
 628                         push_expr(ctx, fp, oper -> right);
 629                         fprintf(fp, "%cdiv\n", prefix);
 630                         break;
 631                 case OP_MOD:
 632                         push_expr(ctx, fp, oper -> left);
 633                         push_expr(ctx, fp, oper -> right);
 634                         fprintf(fp, "%crem\n", prefix);
 635                         break;
 636                 case OP_BITWISE_AND:
 637                         push_expr(ctx, fp, oper -> left);
 638                         push_expr(ctx, fp, oper -> right);
 639                         fprintf(fp, "%cand\n", prefix);
 640                         break;
 641                 case OP_BITWISE_XOR:
 642                         push_expr(ctx, fp, oper -> left);
 643                         push_expr(ctx, fp, oper -> right);
 644                         fprintf(fp, "%cxor\n", prefix);
 645                         break;
 646                 case OP_BITWISE_OR:
 647                         push_expr(ctx, fp, oper -> left);
 648                         push_expr(ctx, fp, oper -> right);
 649                         fprintf(fp, "%cor\n", prefix);
 650                         break;
 651
 652                 case OP_EQ:
 653                 case OP_NEQ:
 654                 case OP_LSS:
 655                 case OP_LEQ:
 656                 case OP_GRT:
 657                 case OP_GEQ:
 658                 case OP_LOGIC_NOT:
 659                 case OP_ABS:
 660                         oberon_error(ctx, "push_oper: TODO op %i", oper -> op);
 661                         break;
 662                 default:
 663                         oberon_error(ctx, "push_oper: unk op %i", oper -> op);
 664                         break;
 665         }
 666 }
 667
 668 static void
 669 push_expr(oberon_context_t * ctx, FILE * fp, oberon_expr_t * expr)
 670 {
 671         if(expr -> is_item)
 672         {
 673                 push_item(ctx, fp, (oberon_item_t *) expr);
 674         }
 675         else
 676         {
 677                 push_operator(ctx, fp, (oberon_oper_t *) expr);
 678         }
 679 }
 680
 681 static void
 682 store_expr(oberon_context_t * ctx, FILE * fp, oberon_expr_t * expr)
 683 {
 684         assert(expr -> is_item);
 685         oberon_item_t * item = (oberon_item_t *) expr;
 686
 687         char prefix;
 688         switch(item -> mode)
 689         {
 690                 case MODE_VAR:
 691                         if(item -> var -> local)
 692                         {
 693                                 int reg = item -> var -> gen_var -> reg;
 694                                 prefix = get_prefix(ctx, item -> result);
 695                                 fprintf(fp, "%cstore %i\n", prefix, reg);
 696                         }
 697                         else
 698                         {
 699                                 char * fullname = get_field_full_name(ctx, item -> var);
 700                                 char * desc = get_descriptor(ctx, item -> result);
 701                                 fprintf(fp, "putstatic %s %s\n", fullname, desc);
 702                         }
 703                         break;
 704                 default:
 705                         oberon_error(ctx, "store_expr: unk mode %i", item -> mode);
 706                         break;
 707         }
 708 }
 709
 710 void
 711 oberon_generate_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
 712 {
 713         gen_module_t * m;
 714         m = ctx -> mod -> gen_mod;
 715
 716         push_expr(ctx, m -> fp, src);
 717         store_expr(ctx, m -> fp, dst);
 718 }
 719
 720 void
 721 oberon_generate_code(oberon_context_t * ctx)
 722 {
 723         printf("generate code\n");
 724 }
 725
 726 void
 727 oberon_generator_dump(oberon_context_t * ctx, char * path)
 728 {
 729         printf("jit: dump code\n");
 730 }
 731
 732 void *
 733 oberon_generator_get_procedure(oberon_context_t * ctx, const char * name)
 734 {
 735         printf("jit: get pointer to procedure %s\n", name);
 736         return NULL;
 737 }
 738
 739 void *
 740 oberon_generator_get_var(oberon_context_t * ctx, const char * name)
 741 {
 742         printf("jit: get pointer to var %s\n", name);
 743         return NULL;
 744 }