languages/dotnet/src/translator.pir

   1 # This file contains some of the code that drives the .NET EXE/DLL to PIR
   2 # translation process.
   3
   4 .HLL '_dotnet', ''
   5
   6 # This sub is the way translation from .NET to PIR is started.
   7 .sub dotnet_to_pir
   8     .param string filename
   9     .param int continue
  10     .param int standalone
  11     .param int trace
  12     .local string pir_output, src, summary, tmp, emsg
  13     .local pmc assembly, classes, class_order, type, e, entry_meth, entry_class
  14     .local int is_dll, i, max_class, class_id, total_types, done_types
  15
  16     # Instantiate a new assembly class.
  17     loadlib $P0, "dotnet"
  18     assembly = new "DotNetAssembly"
  19
  20     # Set filename and attempt to load.
  21     assembly = filename
  22     assembly.load()
  23
  24     # Load the escaper library, which we will be using.
  25     load_bytecode "library/Data/Escape.pir"
  26
  27     # Initialize PIR output string.
  28     pir_output = ""
  29
  30     # Output HLL directive.
  31     pir_output = concat ".HLL 'dotnet', ''\n"
  32
  33     # Put in ops loader code.
  34     pir_output = concat <<"PIR"
  35 .loadlib "dotnet_ops"
  36 .sub __LOAD_DOTNET_OPS :load
  37     loadlib $P0, "dotnet_runtime"
  38 .end
  39 PIR
  40
  41     # If standalone flag is set, jump over adding import code.
  42     if standalone == 1 goto NO_IMPORTS
  43     src = assembly_imports_sub(assembly)
  44     pir_output = concat src
  45 NO_IMPORTS:
  46
  47     # Insert code to make call-boxing classes used to make MMD work on the
  48     # non-reference types Parrot doesn't recognize.
  49     pir_output = concat <<"PIR"
  50 .sub __CREATE_DOTNET_MMDBOXES :load
  51     .local pmc class
  52
  53     $P0 = get_class "Integer"
  54     class = get_class "@@DOTNET_MMDBOX_I1"
  55     unless null class goto EXISTS_I1
  56     subclass $P1, $P0, "@@DOTNET_MMDBOX_I1"
  57 EXISTS_I1:
  58     class = get_class "@@DOTNET_MMDBOX_I2"
  59     unless null class goto EXISTS_I2
  60     subclass $P1, $P0, "@@DOTNET_MMDBOX_I2"
  61 EXISTS_I2:
  62     class = get_class "@@DOTNET_MMDBOX_U1"
  63     unless null class goto EXISTS_U1
  64     subclass $P1, $P0, "@@DOTNET_MMDBOX_U1"
  65 EXISTS_U1:
  66     class = get_class "@@DOTNET_MMDBOX_U2"
  67     unless null class goto EXISTS_U2
  68     subclass $P1, $P0, "@@DOTNET_MMDBOX_U2"
  69 EXISTS_U2:
  70     class = get_class "@@DOTNET_MMDBOX_U4"
  71     unless null class goto EXISTS_U4
  72     subclass $P1, $P0, "@@DOTNET_MMDBOX_U4"
  73 EXISTS_U4:
  74     $P0 = get_class "Float"
  75     class = get_class "@@DOTNET_MMDBOX_R4"
  76     unless null class goto EXISTS_R4
  77     subclass $P1, $P0, "@@DOTNET_MMDBOX_R4"
  78 EXISTS_R4:
  79 .end
  80 PIR
  81
  82     # We'll only put fake System.Object in when we're in standalone mode.
  83     if standalone == 0 goto NO_STANDALONE_CLASSES
  84     pir_output = concat <<"PIR"
  85 .namespace [ "System"; "Object" ]
  86 .sub __FAKE_SYSTEM_OBJECT :load
  87     $P0 = get_class [ "System" ; "Object" ]
  88     unless null $P0 goto EXISTS
  89     $P0 = newclass [ "System" ; "Object" ]
  90 EXISTS:
  91 .end
  92 .sub ".ctor" :method
  93 .end
  94 PIR
  95 NO_STANDALONE_CLASSES:
  96
  97     # Put in fake temporary System.Exception and System.String.
  98     pir_output = concat <<"PIR"
  99 .namespace [ "System" ; "Exception" ]
 100 .sub __FAKE_SYSTEM_EXCEPTION :load
 101     $P0 = get_class [ "System" ; "Exception" ]
 102     unless null $P0 goto EXISTS
 103     $P0 = newclass [ "System" ; "Exception" ]
 104 EXISTS:
 105 .end
 106 .sub ".ctor" :method
 107 .end
 108 .namespace [ "System" ; "String" ]
 109 .sub __FAKE_SYSTEM_STRING :load
 110     $P0 = get_class [ "System" ; "String" ]
 111     unless null $P0 goto EXISTS
 112     $P0 = newclass [ "System" ; "String" ]
 113     addattribute $P0, "Chars"
 114 EXISTS:
 115 .end
 116 .sub ".ctor" :method :multi("System.String", string)
 117     .param string s
 118     $P0 = new .String
 119     $P0 = s
 120     setattribute self, "Chars", $P0
 121 .end
 122 .sub __get_string :method
 123     $P0 = getattribute self, "Chars"
 124     $S0 = $P0
 125     .return($S0)
 126 .end
 127 .namespace [ "System" ; "ValueType" ]
 128 .sub __FAKE_SYSTEM_VALUETYPE :load
 129     $P0 = get_class [ "System" ; "ValueType" ]
 130     unless null $P0 goto EXISTS
 131     $P0 = newclass [ "System" ; "ValueType" ]
 132 EXISTS:
 133 .end
 134 .namespace [ "System" ; "Enum" ]
 135 .sub __FAKE_SYSTEM_ENUM :load
 136     $P0 = get_class [ "System" ; "Enum" ]
 137     unless null $P0 goto EXISTS
 138     $P0 = newclass [ "System" ; "Enum" ]
 139 EXISTS:
 140 .end
 141 PIR
 142
 143     # Translate global stuff.
 144     # XXX TODO: Translate globals.
 145
 146     # Translate each class according to the ordering.
 147     classes = assembly.get_classes()
 148     class_order = assembly.get_class_order()
 149     max_class = elements classes
 150     i = 0
 151     total_types = 0
 152     done_types = 0
 153 CLOOP:
 154     if i >= max_class goto CEND
 155     inc total_types
 156     class_id = class_order[i]
 157     type = classes[class_id]
 158     if continue == 0 goto NO_EH
 159     push_eh trans_failure_handler
 160 NO_EH:
 161     src = trans_class(assembly, type, trace)
 162     pir_output = concat src
 163     inc done_types
 164     if continue == 0 goto RESUME
 165     pop_eh
 166 RESUME:
 167     inc i
 168     goto CLOOP
 169 trans_failure_handler:
 170     .get_results (e, emsg)
 171     # Emit trace message.
 172     unless trace goto NOTRACE
 173     printerr "  **FAILED** ("
 174     printerr emsg
 175     emsg = ""
 176     printerr ")\n"
 177 NOTRACE:
 178     goto RESUME
 179 CEND:
 180
 181     # If it's an EXE, do entry point stuff.
 182     is_dll = assembly."is_dll"()
 183     if is_dll > 0 goto ISEXE
 184     src = pir_output
 185     entry_meth = assembly.get_entry_method()
 186     entry_class = entry_meth.get_class()
 187     pir_output = ".sub __ENTRY_POINT\n__DO_IMPORTS()\n$P0 = get_hll_global \""
 188     tmp = entry_class.get_fullname()
 189     pir_output = concat tmp
 190     pir_output = concat "\", \""
 191     tmp = entry_meth
 192     pir_output = concat tmp
 193     pir_output = concat "\"\n$P0()\n.end\n"
 194     pir_output = concat src
 195 ISEXE:
 196
 197     # Generate summary.
 198     summary = "Translated "
 199     tmp = done_types
 200     summary = concat tmp
 201     summary = concat " types out of "
 202     tmp = total_types
 203     summary = concat tmp
 204     summary = concat " from "
 205     summary = concat filename
 206     summary = concat "\n"
 207
 208     # Return output.
 209     .return (pir_output, summary)
 210 .end
 211
 212
 213 # This produces a sub that loads libraries that we need to import for this one
 214 # to work.
 215 .sub assembly_imports_sub
 216     .param pmc assembly
 217     .local pmc assrefs, assref
 218     .local int assref_count, i
 219     .local string name, pir_output
 220
 221     # Emit start of load sub.
 222     pir_output = ".sub __DO_IMPORTS :load\n"
 223
 224     # Loop over assembly refs.
 225     assrefs = assembly.get_assemblyrefs()
 226     assref_count = elements assrefs
 227     i = 0
 228 AR_LOOP:
 229     if i == assref_count goto AR_LOOP_END
 230     assref = assrefs[i]
 231     inc i
 232
 233     # Get name and emit load code.
 234     name = assref
 235     pir_output = concat "load_bytecode \""
 236     pir_output = concat name
 237     pir_output = concat ".pbc\"\n"
 238 AR_LOOP_END:
 239
 240     # Do end and return.
 241     pir_output = concat ".end\n"
 242     .return(pir_output)
 243 .end
 244
 245
 246 # This sub translates an individual class.
 247 .sub trans_class
 248     .param pmc assembly
 249     .param pmc class
 250     .param int trace
 251     .local string pir_output, name, namespace, internal_name, tmp, p_name, name_key
 252     .local pmc fields, field, methods, meth, ex, int_types, int_ids
 253     .local int i, max_field, max_method, parent_id, parent_type
 254     .local int flags, is_interface, is_abstract, num_interfaces, done_init
 255
 256     done_init = 0
 257
 258     # Get class name and namespace and build combo of them.
 259     name = class
 260     namespace = class.get_namespace()
 261     internal_name = class.get_fullname()
 262
 263     # Emit trace message.
 264     unless trace goto NOTRACE
 265     printerr "Type "
 266     printerr internal_name
 267     printerr "\n"
 268 NOTRACE:
 269
 270     # Emit a namespace directive.
 271     name_key = namespace_to_key(internal_name)
 272     pir_output = concat ".namespace "
 273     pir_output = concat name_key
 274     pir_output = concat "\n\n"
 275
 276     # Emit start of on load type setup.
 277     pir_output = concat ".sub \"__onload\" :load\n"
 278     pir_output = concat "    .local pmc type, parent\n"
 279     pir_output = concat "     push_eh FAILED\n" # XXX Ignoring missing parents
 280     pir_output = concat "    type = newclass "
 281     pir_output = concat name_key
 282     pir_output = concat "\n"
 283
 284     # Add any interfaces that this class implements.
 285     int_types = class.get_interface_types()
 286     int_ids = class.get_interface_ids()
 287     num_interfaces = elements int_types
 288     i = 0
 289 INT_LOOP:
 290     if i == num_interfaces goto END_INT_LOOP
 291     parent_type = int_types[i]
 292     parent_id = int_ids[i]
 293     dec parent_id
 294     (tmp, p_name) = add_parent(assembly, parent_type, parent_id)
 295     pir_output = concat tmp
 296     inc i
 297 END_INT_LOOP:
 298
 299     # Inherit the parent class. Note System.Object has ID 0, and jump over this stuff.
 300     parent_id = class.get_parent_id()
 301     if parent_id == 0 goto NO_PARENT
 302     dec parent_id
 303     parent_type = class.get_parent_type()
 304     (tmp, p_name) = add_parent(assembly, parent_type, parent_id)
 305     pir_output = concat tmp
 306 NO_PARENT:
 307
 308     # Emit field list.
 309     fields = class.get_fields()
 310     max_field = elements fields
 311     i = 0
 312 FLOOP:
 313     if i >= max_field goto FEND
 314     field = fields[i]
 315     tmp = trans_field(assembly, class, field)
 316     pir_output = concat tmp
 317     inc i
 318     goto FLOOP
 319 FEND:
 320
 321     # Add code to run constructor.
 322     pir_output = concat "push_eh FAILED\n"
 323     pir_output = concat "$P0 = get_hll_global "
 324     tmp = namespace_to_key(internal_name)
 325     pir_output = concat tmp
 326     pir_output = concat ", \".cctor\"\n$P0()\n"
 327
 328     # This is the end of the on load type setup sub.
 329     pir_output = concat "FAILED:\n.end\n\n"
 330
 331     # If it's an interface, emit code to prevent it being instantiated.
 332     flags = class.get_flags()
 333     is_interface = band flags, 0x20
 334     if is_interface == 0 goto NOT_INTERFACE
 335     pir_output = concat <<"PIR"
 336 .sub __init :method
 337     $P0 = class self
 338     $S0 = classname $P0
 339 PIR
 340     pir_output = concat "    if $S0 != \""
 341     pir_output = concat internal_name
 342     pir_output = concat "\" goto INIT_OK\n"
 343     pir_output = concat <<"PIR"
 344     $P1 = new 'Exception'
 345     $P1 = "You can not instantiate an interface"
 346     throw $P1
 347 INIT_OK:
 348 .end
 349 PIR
 350     done_init = 1
 351     goto NOT_ABSTRACT
 352 NOT_INTERFACE:
 353
 354     # If it's an abstract class, emit code to prevent it being instantiated.
 355     is_abstract = band flags, 0x80
 356     if is_abstract == 0 goto NOT_ABSTRACT
 357     pir_output = concat <<"PIR"
 358 .sub __init :method
 359     $P0 = class self
 360     $S0 = classname $P0
 361 PIR
 362     pir_output = concat "    if $S0 != \""
 363     pir_output = concat internal_name
 364     pir_output = concat "\" goto INIT_OK\n"
 365     pir_output = concat <<"PIR"
 366     $P1 = new 'Exception'
 367     $P1 = "You can not instantiate an abstract class"
 368     throw $P1
 369 INIT_OK:
 370 .end
 371 PIR
 372     done_init = 1
 373 NOT_ABSTRACT:
 374
 375     # If it is a value type, add the __init and __clone v-table methods.
 376     if p_name == "[ \"System\" ; \"ValueType\" ]" goto VAL_TYPE
 377     if p_name == "[ \"System\" ; \"Enum\" ]" goto VAL_TYPE
 378     goto NOT_VAL_TYPE
 379 VAL_TYPE:
 380     tmp = value_type_methods(assembly, class, p_name)
 381     pir_output = concat tmp
 382     done_init = 1
 383 NOT_VAL_TYPE:
 384
 385     # Emit methods.
 386     methods = class.get_methods()
 387     max_method = elements methods
 388     i = 0
 389 MLOOP:
 390     if i >= max_method goto MEND
 391     meth = methods[i]
 392     tmp = trans_method(assembly, class, meth, 1, trace)
 393     pir_output = concat tmp
 394     inc i
 395     goto MLOOP
 396 MEND:
 397
 398     # Return PIR that was generated.
 399     .return (pir_output)
 400 .end
 401
 402
 403 # This emits the code to add a parent to a class.
 404 .sub add_parent
 405     .param pmc assembly
 406     .param int parent_type
 407     .param int parent_id
 408     .local pmc ex, classes, pclass
 409     .local string pclass_ns, pir_output, tmp
 410
 411     # Find out what type of parent we have.
 412     pir_output = "    parent = get_class "
 413     if parent_type == 0 goto PARENT_DEF
 414     if parent_type == 1 goto PARENT_REF
 415     ex = new 'Exception'
 416     ex = "Can not subclass a TypeSpec parent."
 417     throw ex
 418
 419     # Parent may be a type in this file.
 420 PARENT_DEF:
 421     dec parent_id # Because row 2 = element 0 here, thanks to the global class
 422     classes = assembly.get_classes()
 423     pclass = classes[parent_id]
 424     pclass_ns = pclass.get_fullname()
 425     pclass_ns = namespace_to_key(pclass_ns)
 426     pir_output = concat pclass_ns
 427     goto PARENT_DONE
 428
 429     # Parent may be a type in another file.
 430 PARENT_REF:
 431     classes = assembly.get_typerefs()
 432     pclass = classes[parent_id]
 433     pclass_ns = pclass.get_namespace()
 434     pclass_ns = clone pclass_ns
 435     if pclass_ns == "" goto PARENT_NO_NS
 436     pclass_ns = concat "."
 437 PARENT_NO_NS:
 438     tmp = pclass
 439     pclass_ns = concat tmp
 440     pclass_ns = namespace_to_key(pclass_ns)
 441     pir_output = concat pclass_ns
 442
 443     # Finally, do code to add parent to the class and return.
 444 PARENT_DONE:
 445     pir_output = concat "\n    addparent type, parent\n"
 446     .return (pir_output, pclass_ns)
 447 .end
 448
 449
 450 # This translates a field into an addattribute op.
 451 .sub trans_field
 452     .param pmc assembly
 453     .param pmc class
 454     .param pmc field
 455     .local int flags, static
 456     .local string pir_output, name
 457
 458     # Check it's an instance field.
 459     flags = field.get_flags()
 460     static = band flags, 0x10
 461     if static != 0 goto STATIC
 462
 463     # Generate add attribute instruction provided it's an instance field.
 464     name = field
 465     pir_output = "    addattribute type, \""
 466     pir_output = concat name
 467     pir_output = concat "\"\n"
 468
 469     # Return generated string.
 470 STATIC:
 471     .return (pir_output)
 472 .end
 473
 474
 475 # Generate the special __init and __clone v-table methods for value types.
 476 .sub value_type_methods
 477     .param pmc assembly
 478     .param pmc class
 479     .param string parent
 480     .local pmc fields, field, sig, sig_info
 481     .local int i, sig_id, type, flags, static
 482     .local string pir_output, init_body, clone_body, name, sig_data
 483     .const int ELEMENT_TYPE_I1 = 0x04
 484     .const int ELEMENT_TYPE_U1 = 0x05
 485     .const int ELEMENT_TYPE_I2 = 0x06
 486     .const int ELEMENT_TYPE_U2 = 0x07
 487     .const int ELEMENT_TYPE_I4 = 0x08
 488     .const int ELEMENT_TYPE_U4 = 0x09
 489     .const int ELEMENT_TYPE_R4 = 0x0C
 490     .const int ELEMENT_TYPE_R8 = 0x0D
 491     .const int ELEMENT_TYPE_I = 0x18
 492     .const int ELEMENT_TYPE_U = 0x19
 493     .const int ELEMENT_TYPE_VALUETYPE = 0x11
 494
 495     # The __init method needs to zero or null out any attributes.
 496     # The __clone method needs to clone each attribute.
 497     fields = class.get_fields()
 498     i = elements fields
 499     init_body = ""
 500     clone_body = ""
 501 ILOOP:
 502     if i == 0 goto ILOOP_END
 503     dec i
 504     field = fields[i]
 505
 506     # Skip if field is static.
 507     flags = field.get_flags()
 508     static = band flags, 0x10
 509     if static != 0 goto ILOOP
 510
 511     # For clone, emit code to just copy the attribute.
 512     name = field
 513     clone_body = concat "$P0 = getattribute self, \""
 514     clone_body = concat name
 515     clone_body = concat "\"\n$P0 = clone $P0\nsetattribute cpy, \""
 516     clone_body = concat name
 517     clone_body = concat "\", $P0\n"
 518
 519     # Need to look at signature to initialize attributes by type.
 520     sig_id = field.get_signature()
 521     sig_data = assembly.get_blob(sig_id)
 522     sig = new "DotNetSignature"
 523     sig = sig_data
 524     sig_info = get_signature_Field(sig)
 525     type = sig_info["type"]
 526     if type == ELEMENT_TYPE_I4 goto INT_TYPE
 527     if type == ELEMENT_TYPE_U4 goto INT_TYPE
 528     if type == ELEMENT_TYPE_I2 goto INT_TYPE
 529     if type == ELEMENT_TYPE_U2 goto INT_TYPE
 530     if type == ELEMENT_TYPE_I1 goto INT_TYPE
 531     if type == ELEMENT_TYPE_U1 goto INT_TYPE
 532     if type == ELEMENT_TYPE_I goto INT_TYPE
 533     if type == ELEMENT_TYPE_U goto INT_TYPE
 534     if type == ELEMENT_TYPE_R4 goto FLOAT_TYPE
 535     if type == ELEMENT_TYPE_R8 goto FLOAT_TYPE
 536     if type == ELEMENT_TYPE_VALUETYPE goto VALUE_TYPE
 537     goto OBJ_TYPE
 538
 539 INT_TYPE:
 540     init_body = concat "$P0 = new 'Integer'\n$P0 = 0\nsetattribute self, \""
 541     init_body = concat name
 542     init_body = concat "\", $P0\n"
 543     goto DONE_INIT
 544
 545 FLOAT_TYPE:
 546     init_body = concat "$P0 = new .Float\n$P0 = 0.0\nsetattribute self, \""
 547     init_body = concat name
 548     init_body = concat "\", $P0\n"
 549     goto DONE_INIT
 550
 551 OBJ_TYPE:
 552     init_body = concat "$P0 = null\nsetattribute self, \""
 553     init_body = concat name
 554     init_body = concat "\", $P0\n"
 555     goto DONE_INIT
 556
 557 VALUE_TYPE:
 558     $P0 = new 'Exception'
 559     $P0 = "Not doing nested value types yet!"
 560     throw $P0
 561     goto DONE_INIT
 562
 563     # Next.
 564 DONE_INIT:
 565     goto ILOOP
 566 ILOOP_END:
 567
 568     # Build the code.
 569     pir_output = ".sub __init :method\n"
 570     pir_output = concat init_body
 571     pir_output = concat <<"PIR"
 572 .end
 573 .sub __clone :method
 574 .local pmc cpy
 575 $P0 = class self
 576 $P1 = classname $P0
 577 cpy = new $P1
 578 PIR
 579     pir_output = concat clone_body
 580     pir_output = concat ".return(cpy)\n.end\n"
 581
 582     # If we have an enum, provide get and set integer and float v-table
 583     # methods to provide or hand back first field. This is for supporting
 584     # enums.
 585     if parent != "[ \"System\" ; \"Enum\" ]" goto NOT_ENUM
 586     pir_output = concat <<"PIR"
 587 .sub __get_integer
 588     .param pmc s
 589     $P0 = getattribute s, "value__"
 590     $I0 = $P0
 591     .return($I0)
 592 .end
 593 .sub __set_integer_native
 594     .param pmc s
 595     .param int i
 596     $P0 = new 'Integer'
 597     $P0 = i
 598     setattribute s, "value__", $P0
 599 .end
 600 .sub __get_number
 601     .param pmc s
 602     $P0 = getattribute s, "value__"
 603     $N0 = $P0
 604     .return($N0)
 605 .end
 606 .sub __set_number_native
 607     .param pmc s
 608     .param num i
 609     $P0 = new Float
 610     $P0 = i
 611     setattribute s, "value__", $P0
 612 .end
 613 PIR
 614 NOT_ENUM:
 615
 616     # Return generated code.
 617     .return(pir_output)
 618 .end
 619
 620
 621 # Takes a .Net namespace separated by dots and makes a Parrot namespace key.
 622 .sub namespace_to_key
 623     .param string in_ns
 624     .local string ns_key, tmp
 625     .local pmc keys
 626     .local int i, max
 627
 628     # Initial bracket of key.
 629     ns_key = "[ "
 630
 631     # Split up and make key sequence.
 632     keys = split ".", in_ns
 633     max = elements keys
 634     i = 0
 635 LOOP:
 636     if i == max goto LOOP_END
 637     if i == 0 goto NO_SC
 638     ns_key = concat "; "
 639 NO_SC:
 640     tmp = keys[i]
 641     ns_key = concat "\""
 642     ns_key = concat tmp
 643     ns_key = concat "\" "
 644     inc i
 645     goto LOOP
 646 LOOP_END:
 647
 648     # End and return key.
 649     ns_key = concat "]"
 650     .return(ns_key)
 651 .end
 652
 653 # Local Variables:
 654 #   mode: pir
 655 #   fill-column: 100
 656 # End:
 657 # vim: expandtab shiftwidth=4 ft=pir: