tools/dev/pbc_to_exe.pir

   1 #! parrot
   2 # Copyright (C) 2009, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 pbc_to_exe - compile bytecode to executable
   8
   9 =head2 SYNOPSIS
  10
  11   pbc_to_exe my.pbc
  12   => my.exe
  13
  14   pbc_to_exe my.pbc --install
  15   => installable_my.exe
  16
  17 Warning! With --install there must be no directory prefix in the first arg yet.
  18
  19 =cut
  20
  21 .sub 'main' :main
  22     .param pmc    argv
  23
  24     load_bytecode 'config.pbc'
  25
  26     .local string infile
  27     .local string cfile
  28     .local string objfile
  29     .local string exefile
  30
  31     (infile, cfile, objfile, exefile) = 'handle_args'(argv)
  32     unless infile > '' goto err_infile
  33
  34
  35     .local string code_type
  36     code_type = 'determine_code_type'()
  37
  38     .local string codestring
  39     if code_type == 'gcc'  goto code_for_gcc
  40     if code_type == 'msvc' goto code_for_msvc
  41     goto code_for_default
  42   code_for_gcc:
  43     codestring = 'generate_code_gcc'(infile)
  44     goto code_end
  45   code_for_msvc:
  46     codestring = 'generate_code_msvc'(infile)
  47     goto code_end
  48   code_for_default:
  49     codestring = 'generate_code'(infile)
  50   code_end:
  51
  52
  53   open_outfile:
  54     .local pmc outfh
  55     outfh = open cfile, 'w'
  56     unless outfh goto err_outfh
  57     print outfh, <<'HEADER'
  58 #include "parrot/parrot.h"
  59 #include "parrot/embed.h"
  60 const void * get_program_code(void);
  61 HEADER
  62
  63     print outfh, codestring
  64
  65     print outfh, <<'MAIN'
  66         int main(int argc, char *argv[])
  67         {
  68             PackFile     *pf;
  69             Parrot_Interp interp;
  70             const unsigned char *program_code_addr;
  71
  72             program_code_addr = (const unsigned char *)get_program_code();
  73             if (!program_code_addr)
  74                 return 1;
  75
  76             Parrot_set_config_hash();
  77
  78             interp = Parrot_new( NULL );
  79             if (!interp)
  80                 return 1;
  81
  82             Parrot_init_stacktop(interp, &interp);
  83             Parrot_set_executable_name(interp,
  84                 Parrot_str_new(interp, argv[0], 0));
  85             Parrot_set_flag(interp, PARROT_DESTROY_FLAG);
  86
  87             pf = PackFile_new(interp, 0);
  88             if (!pf)
  89                 return 1;
  90
  91             if (!PackFile_unpack(interp, pf,
  92                     (const opcode_t *)program_code_addr, bytecode_size))
  93                 return 1;
  94
  95             do_sub_pragmas(interp, pf->cur_cs, PBC_PBC, NULL);
  96
  97             Parrot_pbc_load(interp, pf);
  98
  99             PackFile_fixup_subs(interp, PBC_MAIN, NULL);
 100             Parrot_runcode(interp, argc, argv);
 101             Parrot_destroy(interp);
 102             Parrot_exit(interp, 0);
 103         }
 104 MAIN
 105
 106
 107     # The close opcode does not return a result code,
 108     # use the method instead.
 109     .local int    closeresult
 110     closeresult = outfh.'close'()
 111     unless closeresult == 0 goto err_close
 112
 113
 114     .local string extra_obj
 115     extra_obj = ''
 116     if code_type != 'msvc' goto no_extra
 117     extra_obj  = 'replace_pbc_extension'(infile, '.RES')
 118   no_extra:
 119
 120
 121     'compile_file'(cfile, objfile)
 122     'link_file'(objfile, exefile, extra_obj)
 123     .return ()
 124
 125   err_infile:
 126     die "cannot read infile"
 127   err_outfh:
 128     die "cannot write outfile"
 129   err_close:
 130     die "cannot close outfile"
 131 .end
 132
 133
 134 .sub 'handle_args'
 135     .param pmc argv
 136
 137     .local string obj, exe
 138     $P0    = '_config'()
 139     obj    = $P0['o']
 140     exe    = $P0['exe']
 141
 142     .local pmc args
 143     args   = argv
 144
 145     .local int argc
 146     argc = args
 147
 148     if argc == 2 goto proper_args
 149     if argc == 3 goto check_install
 150     .return ()
 151
 152   check_install:
 153     .local string infile, install
 154
 155     $P0    = shift args
 156     infile = shift args
 157     install = shift args
 158     if install == '--install' goto proper_install
 159     .return ()
 160
 161   proper_install:
 162     .local string cfile, objfile, exefile
 163
 164     cfile   = 'replace_pbc_extension'(infile, '.c')
 165     objfile = 'replace_pbc_extension'(infile, obj)
 166     $S0     = 'replace_pbc_extension'(infile, exe)
 167     exefile = concat 'installable_', $S0
 168
 169     .return(infile, cfile, objfile, exefile)
 170
 171   proper_args:
 172
 173     $P0    = shift args
 174     infile = shift args
 175
 176     cfile   = 'replace_pbc_extension'(infile, '.c')
 177     objfile = 'replace_pbc_extension'(infile, obj)
 178     exefile = 'replace_pbc_extension'(infile, exe)
 179
 180     # substitute .c for .pbc
 181     # remove .c for executable
 182
 183     # TODO this should complain about results/returns mismatch
 184     .return(infile, cfile, objfile, exefile)
 185 .end
 186
 187 .sub 'determine_code_type'
 188     .local pmc    config
 189     .local string gcc_ver
 190     .local string cc
 191     .local string os_name
 192
 193     config = '_config'()
 194
 195     gcc_ver = config['gccversion']
 196     unless gcc_ver > '' goto not_gcc
 197     .return ('gcc')
 198   not_gcc:
 199
 200     cc      = config['cc']
 201     os_name = config['osname']
 202
 203     if os_name != 'MSWin32' goto not_msvc
 204     if cc      != 'cl'      goto not_msvc
 205     .return ('msvc')
 206   not_msvc:
 207
 208     .return ('default')
 209 .end
 210
 211
 212 .sub 'generate_code'
 213     .param string infile
 214     .local pmc ifh
 215     ifh = open infile, 'r'
 216     unless ifh goto err_infile
 217     .local string codestring
 218     .local int size
 219     codestring = "const Parrot_UInt1 program_code[] = {"
 220     size = 0
 221
 222   read_loop:
 223     .local string pbcstring
 224     .local int pbclength
 225
 226     pbcstring = read ifh, 16384
 227     pbclength = length pbcstring
 228     unless pbclength > 0 goto read_done
 229
 230     .local int pos
 231     pos = 0
 232   code_loop:
 233     unless pos < pbclength goto code_done
 234     $I0 = ord pbcstring, pos
 235     $S0 = $I0
 236     codestring .= $S0
 237     codestring .= ','
 238     inc pos
 239     inc size
 240     $I0 = size % 32
 241     unless $I0 == 0 goto code_loop
 242     codestring .= "\n"
 243     goto code_loop
 244   code_done:
 245     goto read_loop
 246
 247   read_done:
 248     close ifh
 249
 250     codestring .= "\n};\n\n"
 251     codestring .= "const int bytecode_size = "
 252     $S0 = size
 253     codestring .= $S0
 254     codestring .= ";\n"
 255     codestring .= <<'END_OF_FUNCTION'
 256         const void * get_program_code(void)
 257         {
 258             return program_code;
 259         }
 260 END_OF_FUNCTION
 261
 262     .return (codestring)
 263
 264   err_infile:
 265     die "cannot open infile"
 266 .end
 267
 268
 269 # The PBC will be represented as a C string, so this sub builds a table
 270 # of the C representation of each ASCII character, for lookup by ordinal value.
 271 .sub 'generate_encoding_table'
 272     # Use '\%o' for speed, or '\x%02x' for readability
 273     .const string encoding_format = '\%o'
 274
 275     # The 'sprintf' op requires the arglist to be in an array, even when
 276     # there is only one arg.
 277     .local pmc one_number
 278     one_number    = new 'FixedIntegerArray'
 279     set one_number, 1
 280
 281     .local pmc coded_strings
 282     coded_strings = new 'FixedStringArray'
 283     set coded_strings, 256
 284
 285     .local int index
 286     index = 0
 287
 288   next_index:
 289     one_number[0] = index
 290     $S0 = sprintf encoding_format, one_number
 291     coded_strings[index] = $S0
 292     inc index
 293     if index < 256 goto next_index
 294
 295     .return (coded_strings)
 296 .end
 297
 298 .sub 'generate_code_gcc'
 299     .param string infile
 300     .local pmc ifh
 301     ifh = open infile, 'r'
 302     unless ifh goto err_infile
 303
 304     .local pmc encoding_table
 305     encoding_table = 'generate_encoding_table'()
 306
 307     .local string codestring
 308     .local int size
 309     codestring = "const char * program_code =\n"
 310     codestring .= '"'
 311     size = 0
 312
 313   read_loop:
 314     .local string pbcstring
 315     .local int pbclength
 316
 317     pbcstring = read ifh, 16384
 318     pbclength = length pbcstring
 319     unless pbclength > 0 goto read_done
 320
 321     .local int pos
 322     pos = 0
 323   code_loop:
 324     unless pos < pbclength goto code_done
 325     $I0 = ord pbcstring, pos
 326     $S0 = encoding_table[$I0]
 327     codestring .= $S0
 328     inc pos
 329     inc size
 330     $I0 = size % 32
 331     unless $I0 == 0 goto code_loop
 332     codestring .= '"'
 333     codestring .= "\n"
 334     codestring .= '"'
 335     goto code_loop
 336   code_done:
 337     goto read_loop
 338
 339   read_done:
 340     close ifh
 341
 342     codestring .= '"'
 343     codestring .= "\n;\n\n"
 344     codestring .= "const int bytecode_size = "
 345     $S0 = size
 346     codestring .= $S0
 347     codestring .= ";\n"
 348
 349     codestring .= <<'END_OF_FUNCTION'
 350         const void * get_program_code(void)
 351         {
 352             return program_code;
 353         }
 354 END_OF_FUNCTION
 355
 356     .return (codestring)
 357
 358   err_infile:
 359     die "cannot open infile"
 360 .end
 361
 362
 363 # Transforms the .pbc path into one with a different extension.
 364 # Passing '' means no extension.
 365 # Extensions without leading dots will have a dot pre-pended.
 366 .sub 'replace_pbc_extension'
 367     .param string pbc_path
 368     .param string new_extension
 369
 370     $S0 = substr pbc_path, -4
 371     downcase $S0
 372     if $S0 != '.pbc' goto err_pbc_path_not_pbc
 373     .local string base_path
 374      base_path = substr pbc_path, 0
 375      substr base_path, -4, 4, ''
 376
 377     .local string new_path
 378     new_path = substr base_path, 0
 379
 380     unless new_extension > '' goto ext_null
 381
 382     $S1 = substr new_extension, 0, 1
 383     if $S1 == '.' goto has_dot
 384     new_path .= '.'
 385
 386   has_dot:
 387     new_path .= new_extension
 388
 389   ext_null:
 390     .return (new_path)
 391
 392   err_pbc_path_not_pbc:
 393     die "input pbc file name does not end in '.pbc'"
 394 .end
 395
 396
 397 # In addition to generating the code for inclusion in the C file,
 398 # this sub creates supplemental .rc and .RES files.
 399 .sub 'generate_code_msvc'
 400     .param string pbc_path
 401
 402     .local string rc_path
 403     .local string res_path
 404     rc_path  = 'replace_pbc_extension'(pbc_path, '.rc' )
 405     res_path = 'replace_pbc_extension'(pbc_path, '.res')
 406
 407     # The exact numbers are not relevant;
 408     # they are used to identify the resource within the final executable.
 409     .local string rc_constant_defines
 410     rc_constant_defines = <<'END_OF_DEFINES'
 411 #define RESOURCE_NAME_ID_WHOLE_PBC 333
 412 #define RESOURCE_TYPE_ID_WHOLE_PBC 444
 413 END_OF_DEFINES
 414
 415
 416     .local string rc_contents
 417     rc_contents  = ''
 418     rc_contents .= rc_constant_defines
 419     rc_contents .= 'RESOURCE_NAME_ID_WHOLE_PBC RESOURCE_TYPE_ID_WHOLE_PBC '
 420     rc_contents .= pbc_path
 421     rc_contents .= "\n"
 422
 423     .local pmc rc_fh
 424     rc_fh = open rc_path, 'w'
 425     unless rc_fh goto err_rc_open
 426     print rc_fh, rc_contents
 427     $I0 = rc_fh.'close'()
 428     unless $I0 == 0 goto err_rc_close
 429
 430
 431     .local int pbc_size
 432     $P1 = new ['OS']
 433     $P2 = $P1.'stat'(pbc_path)
 434     pbc_size = $P2[7]
 435
 436
 437     .local string codestring
 438     codestring  = ''
 439     codestring .= '#include <windows.h>'
 440     codestring .= "\n"
 441     codestring .= rc_constant_defines
 442     codestring .= "const unsigned int bytecode_size = "
 443     $S0 = pbc_size
 444     codestring .= $S0
 445     codestring .= ";\n"
 446
 447     codestring .= <<'END_OF_FUNCTION'
 448         const void * get_program_code(void)
 449         {
 450             HRSRC   hResource;
 451             DWORD   size;
 452             HGLOBAL hPBC;
 453             LPVOID  actual_pointer_to_pbc_in_memory;
 454
 455             hResource = FindResource(
 456                 NULL,
 457                 MAKEINTRESOURCE(RESOURCE_NAME_ID_WHOLE_PBC),
 458                 MAKEINTRESOURCE(RESOURCE_TYPE_ID_WHOLE_PBC)
 459             );
 460             if (!hResource)
 461                 return NULL;
 462
 463             size = SizeofResource( NULL, hResource );
 464             if (size != bytecode_size)
 465                 return NULL;
 466
 467             hPBC = LoadResource( NULL, hResource );
 468             if (!hPBC)
 469                 return NULL;
 470
 471             actual_pointer_to_pbc_in_memory = LockResource( hPBC );
 472             if (!actual_pointer_to_pbc_in_memory)
 473                 return NULL;
 474
 475             return actual_pointer_to_pbc_in_memory;
 476         }
 477 END_OF_FUNCTION
 478
 479     .local string rc_cmd
 480     rc_cmd  = 'rc '
 481     rc_cmd .= rc_path
 482
 483     say rc_cmd
 484     .local int status
 485     status = spawnw rc_cmd
 486     unless status goto rc_ok
 487
 488     die "RC command failed"
 489   rc_ok:
 490
 491     .return (codestring)
 492
 493   err_h_open:
 494     die "cannot open .h file"
 495   err_rc_open:
 496     die "cannot open .rc file"
 497   err_h_close:
 498     die "cannot close .h file"
 499   err_rc_close:
 500     die "cannot close .rc file"
 501 .end
 502
 503 # util functions
 504 .sub 'compile_file'
 505     .param string cfile
 506     .param string objfile
 507     .param int install :optional
 508
 509     $P0 = '_config'()
 510     .local string cc, ccflags, cc_o_out, osname, build_dir, slash
 511     .local string installed, includepath, versiondir
 512     cc        = $P0['cc']
 513     ccflags   = $P0['ccflags']
 514     cc_o_out  = $P0['cc_o_out']
 515     osname    = $P0['osname']
 516     build_dir = $P0['build_dir']
 517     slash     = $P0['slash']
 518     installed = $P0['installed']
 519     includepath = $P0['includedir']
 520     versiondir = $P0['versiondir']
 521
 522     .local string includedir, pathquote
 523     if installed == '1' goto installed_includedir
 524     includedir = concat build_dir, slash
 525     includedir = concat includedir, 'include'
 526     goto done_includedir
 527   installed_includedir:
 528     includedir = concat includepath, versiondir
 529   done_includedir:
 530
 531     pathquote  = ''
 532     unless osname == 'MSWin32' goto not_windows
 533     pathquote  = '"'
 534   not_windows:
 535
 536     .local string compile
 537     compile  = cc
 538     compile .= ' '
 539     compile .= cc_o_out
 540     compile .= objfile
 541     compile .= ' -I'
 542     compile .= pathquote
 543     compile .= includedir
 544     compile .= pathquote
 545     compile .= ' '
 546     compile .= ccflags
 547     compile .= ' -c '
 548     compile .= cfile
 549
 550     say compile
 551     .local int status
 552     status = spawnw compile
 553     unless status goto compiled
 554
 555     die "compilation failed"
 556
 557   compiled:
 558     print "Compiled: "
 559     say objfile
 560     .return()
 561 .end
 562
 563 .sub 'link_file'
 564     .param string objfile
 565     .param string exefile
 566     .param string extra_obj
 567     .param int install :optional
 568
 569     $P0 = '_config'()
 570     .local string cc, link, link_dynamic, linkflags, ld_out, libparrot, libs, o
 571     .local string rpath, osname, build_dir, slash, icushared
 572     .local string installed, libdir, versiondir
 573     cc           = $P0['cc']
 574     link         = $P0['link']
 575     link_dynamic = $P0['link_dynamic']
 576     linkflags    = $P0['linkflags']
 577     ld_out       = $P0['ld_out']
 578     libparrot    = $P0['libparrot_linkflags']
 579     libs         = $P0['libs']
 580     o            = $P0['o']
 581     rpath        = $P0['rpath_blib']
 582     osname       = $P0['osname']
 583     build_dir    = $P0['build_dir']
 584     slash        = $P0['slash']
 585     icushared    = $P0['icu_shared']
 586     installed    = $P0['installed']
 587     libdir       = $P0['libdir']
 588     versiondir   = $P0['versiondir']
 589
 590     .local string config, pathquote, exeprefix
 591     if installed == '1' goto config_installed
 592     exeprefix = substr exefile, 0, 12
 593     config     = concat build_dir, slash
 594     config    .= 'src'
 595     config    .= slash
 596     if exeprefix == 'installable_' goto config_to_install
 597     config    .= 'parrot_config'
 598     goto config_cont
 599  config_to_install:
 600     config    .= 'install_config'
 601     rpath     = $P0['rpath_lib']
 602     goto config_cont
 603  config_installed:
 604     rpath      = $P0['rpath_lib']
 605     libparrot  = $P0['inst_libparrot_linkflags']
 606     config     = concat libdir, versiondir
 607     config    .= slash
 608     config    .= 'parrot_config'
 609  config_cont:
 610     config    .= o
 611     pathquote  = ''
 612     unless osname == 'MSWin32' goto not_windows
 613     pathquote  = '"'
 614   not_windows:
 615
 616     link .= ' '
 617     link .= ld_out
 618     link .= exefile
 619     link .= ' '
 620     link .= pathquote
 621     link .= objfile
 622     link .= pathquote
 623     unless extra_obj > '' goto skip_extra_obj
 624     link .= ' '
 625     link .= pathquote
 626     link .= extra_obj
 627     link .= pathquote
 628   skip_extra_obj:
 629     link .= ' '
 630     link .= config
 631     link .= ' '
 632     link .= rpath
 633     link .= ' '
 634     link .= libparrot
 635     link .= ' '
 636     link .= link_dynamic
 637     link .= ' '
 638     link .= linkflags
 639     link .= ' '
 640     link .= libs
 641     link .= ' '
 642     link .= icushared
 643
 644     say link
 645     .local int status
 646     status = spawnw link
 647     unless status goto check_manifest
 648
 649     die "linking failed"
 650
 651   check_manifest:
 652     # Check if there is a MSVC app manifest
 653     .local pmc file
 654     file = new 'File'
 655     .local string manifest_file_name
 656     manifest_file_name  = exefile
 657     manifest_file_name .= '.manifest'
 658     .local pmc manifest_exists
 659     manifest_exists = file.'exists'( manifest_file_name )
 660     unless manifest_exists goto linked
 661
 662   embed_manifest:
 663     # MSVC app manifest exists, embed it
 664     .local string embed_manifest_str
 665     embed_manifest_str  = 'mt.exe -nologo -manifest '
 666     embed_manifest_str .= manifest_file_name
 667     embed_manifest_str .= ' -outputresource:'
 668     embed_manifest_str .= exefile
 669     embed_manifest_str .= ';1'
 670
 671     say embed_manifest_str
 672     .local int embed_manifest_status
 673     embed_manifest_status = spawnw embed_manifest_str
 674     unless embed_manifest_status goto linked
 675     die 'manifest embedding failed'
 676
 677   linked:
 678     print "Linked: "
 679     say exefile
 680     .return()
 681 .end
 682
 683
 684 # Local Variables:
 685 #   mode: pir
 686 #   fill-column: 100
 687 # End:
 688 # vim: expandtab shiftwidth=4 ft=pir: