tools/dev/pbc_to_exe_gen.pl

   1 #! perl
   2
   3 # Copyright (C) 2008, The Perl Foundation.
   4 # $Id$
   5
   6 use strict;
   7 use warnings;
   8
   9 print do { local $/; <DATA> };
  10
  11 __END__
  12 #! parrot
  13
  14 .include 'library/config.pir'
  15
  16 .sub 'main' :main
  17     .param pmc    argv
  18     .local string infile
  19     .local string cfile
  20     .local string objfile
  21     .local string exefile
  22     .local string out
  23
  24     (infile, cfile, objfile, exefile) = 'handle_args'(argv)
  25     $I0                               = length infile
  26     if $I0 goto open_outfile
  27     die "infile not specified"
  28
  29   open_outfile:
  30     .local pmc outfh
  31     outfh = open cfile, '>'
  32     if outfh goto args_handled
  33     die "infile not specified"
  34
  35   args_handled:
  36     .local pmc data
  37     data = 'generate_data'(infile)
  38     out  = 'program_code'(data)
  39     print outfh, out
  40     close outfh
  41
  42     'compile_file'(cfile, objfile)
  43     'link_file'(objfile, exefile)
  44 .end
  45
  46
  47 .sub 'handle_args'
  48     .param pmc argv
  49
  50     .local pmc args
  51     args   = argv
  52
  53     .local int argc
  54     argc = args
  55
  56     if argc == 2 goto proper_args
  57     .return ()
  58
  59 proper_args:
  60     .local string infile, cfile, objfile, obj, exefile, exe
  61
  62     $P0    = '_config'()
  63     obj    = $P0['o']
  64     exe    = $P0['exe']
  65
  66     $P0    = shift args
  67     infile = shift args
  68
  69     .local int infile_len
  70     infile_len  = length infile
  71     infile_len -= 3
  72
  73     cfile       = substr infile, 0, infile_len
  74     cfile      .= 'c'
  75
  76     dec infile_len
  77     objfile     = substr infile, 0, infile_len
  78     objfile    .= obj
  79     exefile     = substr infile, 0, infile_len
  80     exefile    .= exe
  81
  82     # substitute .c for .pbc
  83     # remove .c for executable
  84
  85     # TODO this should complain about results/returns mismatch
  86     .return(infile, cfile, objfile, exefile)
  87 .end
  88
  89
  90 .sub 'generate_data'
  91     .param string infile
  92
  93     .local pmc infh
  94                infh = open infile, '<'
  95
  96     if infh goto file_open
  97     die "cannot open infile"
  98
  99   file_open:
 100     # read the file one opcode at a time -- for simplicity. optimize later
 101     .local int buffer_size
 102     $P0 = _config()
 103     buffer_size = $P0['longsize']  # sizeof (opcode_t)
 104
 105     .local string bytecode
 106                   bytecode = ''
 107     .local int    size
 108                   size = 0
 109     .local pmc    data
 110                   data = new 'Hash'
 111     .local pmc    all_bytes
 112                   all_bytes = new 'ResizablePMCArray'
 113     .local int    at_eof
 114     .local int    string_length
 115     .local string byte_string
 116     .local int    byte
 117     .local int    bytes_per_line
 118                   bytes_per_line=64
 119
 120
 121   loop:
 122     at_eof = infh.'eof'()
 123     if at_eof goto end_loop
 124
 125     # read one byte at a time
 126     byte_string = read infh, 1
 127     string_length = length byte_string
 128     unless string_length goto end_loop
 129
 130     # convert byte to integer
 131     byte = ord byte_string
 132     # convert integer to string
 133     $S0 = byte
 134     # add string for the byte
 135     bytecode .= $S0
 136     bytecode .= ','
 137     size += 1
 138     $I0 = size % bytes_per_line
 139     if $I0 != 0 goto loop
 140     bytecode .= "\n"
 141     goto loop
 142   end_loop:
 143
 144     data['BYTECODE'] = bytecode
 145     data['SIZE']     = size
 146
 147     .return (data)
 148 .end
 149
 150
 151 .sub 'program_code'
 152     .param pmc    data
 153     .local string template, out
 154
 155     template = 'pc_template'()
 156     out = 'merge_data'(template, data)
 157
 158     .return (out)
 159 .end
 160
 161
 162 # template data functions
 163 .sub 'pc_template'
 164     .local string out
 165
 166     out = 'header'()
 167
 168     $S0 = <<'END_PC'
 169 const Parrot_UInt1 program_code[] = {
 170 @BYTECODE@
 171 };
 172
 173 const int bytecode_size = @SIZE@;
 174
 175 END_PC
 176
 177     out .= $S0
 178     $S0  = 'body'()
 179     out .= $S0
 180
 181     .return (out)
 182 .end
 183
 184
 185 .sub 'header'
 186     $S0 = <<'END_HEADER'
 187 #include "parrot/parrot.h"
 188 #include "parrot/embed.h"
 189
 190 END_HEADER
 191     .return ($S0)
 192 .end
 193
 194
 195 .sub 'body'
 196     $S0 = <<'END_BODY'
 197 int main(int argc, char *argv[])
 198 {
 199     PackFile     *pf;
 200     Parrot_Interp interp;
 201
 202     Parrot_set_config_hash();
 203
 204     interp = Parrot_new( NULL );
 205
 206     if (!interp)
 207         return 1;
 208
 209     Parrot_set_executable_name(interp, string_from_cstring(interp, argv[0], 0));
 210     Parrot_set_flag(interp, PARROT_DESTROY_FLAG);
 211
 212     pf = PackFile_new(interp, 0);
 213
 214     if (!PackFile_unpack(interp, pf, (const opcode_t *)program_code, bytecode_size))
 215         return 1;
 216
 217     do_sub_pragmas(interp, pf->cur_cs, PBC_PBC, NULL);
 218
 219     Parrot_loadbc(interp, pf);
 220
 221     PackFile_fixup_subs(interp, PBC_MAIN, NULL);
 222     Parrot_runcode(interp, argc, argv);
 223     Parrot_destroy(interp);
 224     Parrot_exit(interp, 0);
 225 }
 226 END_BODY
 227     .return ($S0)
 228 .end
 229
 230
 231 # template merging functions
 232 .sub 'merge_data'
 233     .param string template
 234     .param pmc    data
 235
 236     .local pmc    iter
 237     iter = new 'Iterator', data
 238
 239     .local string symbol, value
 240
 241   it_loop:
 242     unless iter goto it_done
 243     $P0 = shift iter
 244     symbol = 'get_symbol'($P0)
 245     value  = iter[$P0]
 246       repl_loop:
 247         $I0 = index template, symbol
 248         if -1 == $I0 goto repl_done
 249         $I1 = length symbol
 250         substr template, $I0, $I1, value
 251         goto repl_loop
 252       repl_done:
 253     goto it_loop
 254
 255   it_done:
 256     .return (template)
 257 .end
 258
 259
 260 .sub 'get_symbol'
 261     .param string var
 262     $S0 = '@'
 263     $S1 = concat $S0, var
 264     $S1 = concat $S1, $S0
 265     .return ($S1)
 266 .end
 267
 268
 269 # util functions
 270 .sub 'compile_file'
 271     .param string cfile
 272     .param string objfile
 273
 274     $P0 = '_config'()
 275     .local string cc, ccflags, cc_o_out, osname, build_dir, slash
 276     cc        = $P0['cc']
 277     ccflags   = $P0['ccflags']
 278     cc_o_out  = $P0['cc_o_out']
 279     osname    = $P0['osname']
 280     build_dir = $P0['build_dir']
 281     slash     = $P0['slash']
 282
 283     .local string includedir, pathquote
 284     includedir = concat build_dir, slash
 285     includedir = concat includedir, 'include'
 286     pathquote  = ''
 287     unless osname == 'MSWin32' goto not_windows
 288     pathquote  = '"'
 289   not_windows:
 290
 291     .local string compile
 292     compile  = cc
 293     compile .= ' '
 294     compile .= cc_o_out
 295     compile .= objfile
 296     compile .= ' -I'
 297     compile .= pathquote
 298     compile .= includedir
 299     compile .= pathquote
 300     compile .= ' '
 301     compile .= ccflags
 302     compile .= ' -c '
 303     compile .= cfile
 304
 305     say compile
 306     .local int status
 307     status = spawnw compile
 308     unless status goto compiled
 309
 310     die "compilation failed"
 311
 312   compiled:
 313     print "Compiled: "
 314     say objfile
 315     .return()
 316 .end
 317
 318 .sub 'link_file'
 319     .param string objfile
 320     .param string exefile
 321
 322     $P0 = '_config'()
 323     .local string cc, ld, link_dynamic, linkflags, ld_out, libparrot, libs, o
 324     .local string rpath, osname, build_dir, slash, icushared
 325     cc           = $P0['cc']
 326     ld           = $P0['ld']
 327     link_dynamic = $P0['link_dynamic']
 328     linkflags    = $P0['linkflags']
 329     ld_out       = $P0['ld_out']
 330     libparrot    = $P0['libparrot_ldflags']
 331     libs         = $P0['libs']
 332     o            = $P0['o']
 333     rpath        = $P0['rpath_blib']
 334     osname       = $P0['osname']
 335     build_dir    = $P0['build_dir']
 336     slash        = $P0['slash']
 337     icushared    = $P0['icu_shared']
 338
 339     .local string config, pathquote
 340     config     = concat build_dir, slash
 341     config    .= 'src'
 342     config    .= slash
 343     config    .= 'parrot_config'
 344     config    .= o
 345     pathquote  = ''
 346     unless osname == 'MSWin32' goto not_windows
 347     pathquote  = '"'
 348     $I0 = index cc, 'gcc'
 349     if $I0 > -1 goto not_windows
 350     libparrot  = concat slash, libparrot
 351     libparrot  = concat build_dir, libparrot
 352   not_windows:
 353
 354     .local string link
 355     link  = ld
 356     link .= ' '
 357     link .= ld_out
 358     link .= exefile
 359     link .= ' '
 360     link .= pathquote
 361     link .= objfile
 362     link .= pathquote
 363     link .= ' '
 364     link .= rpath
 365     link .= ' '
 366     link .= libparrot
 367     link .= ' '
 368     link .= link_dynamic
 369     link .= ' '
 370     link .= linkflags
 371     link .= ' '
 372     link .= libs
 373     link .= ' '
 374     link .= icushared
 375     link .= ' '
 376     link .= config
 377
 378     say link
 379     .local int status
 380     status = spawnw link
 381     unless status goto linked
 382
 383     die "linking failed"
 384
 385   linked:
 386     print "Linked: "
 387     say exefile
 388     .return()
 389 .end
 390
 391
 392 # Local Variables:
 393 #   mode: cperl
 394 #   cperl-indent-level: 4
 395 #   fill-column: 100
 396 # End:
 397 # vim: expandtab shiftwidth=4: