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 (my $compile  = shift) =~ s/\\\n/ /gm;
  10
  11 $compile = `$^X tools/dev/cc_flags.pl --return-only $compile`;
  12 my $template = do { local $/; <DATA> };
  13
  14 printf( $template, $compile );
  15
  16 __END__
  17 #! parrot
  18
  19 .include 'library/config.pir'
  20
  21 .sub 'main' :main
  22     .param pmc    argv
  23     .local string infile
  24     .local string cfile
  25     .local string exefile
  26     .local string out
  27
  28     (infile, cfile, exefile) = 'handle_args'(argv)
  29     $I0                      = length infile
  30     if $I0 goto open_outfile
  31     die "infile not specified"
  32
  33   open_outfile:
  34     .local pmc outfh
  35     outfh = open cfile, '>'
  36     if outfh goto args_handled
  37     die "infile not specified"
  38
  39   args_handled:
  40     .local pmc data
  41     data = 'generate_data'(infile)
  42     out  = 'program_code'(data)
  43     print outfh, out
  44     close outfh
  45
  46     compile_file(cfile, exefile)
  47 .end
  48
  49
  50 .sub 'handle_args'
  51     .param pmc argv
  52
  53     .local pmc args
  54     args   = argv
  55
  56     .local int argc
  57     argc = args
  58
  59     if argc == 2 goto proper_args
  60     .return ()
  61
  62 proper_args:
  63     .local string infile, cfile, exefile, exe
  64
  65     $P0    = '_config'()
  66     exe    = $P0['exe']
  67
  68     $P0    = shift args
  69     infile = shift args
  70
  71     .local int infile_len
  72     infile_len  = length infile
  73     infile_len -= 3
  74
  75     cfile       = substr infile, 0, infile_len
  76     cfile      .= 'c'
  77
  78     dec infile_len
  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, 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
 118   loop:
 119     at_eof = infh.'eof'()
 120     if at_eof goto end_loop
 121
 122     # read one byte at a time
 123     byte_string = read infh, 1
 124     string_length = length byte_string
 125     unless string_length goto end_loop
 126
 127     # convert byte to integer
 128     byte = ord byte_string
 129     # convert integer to string
 130     $S0 = byte
 131     # add string for the byte
 132     bytecode .= $S0
 133     bytecode .= ",\n    "
 134     size += 1
 135     goto loop
 136   end_loop:
 137
 138     data['BYTECODE'] = bytecode
 139     data['SIZE']     = size
 140
 141     .return (data)
 142 .end
 143
 144
 145 .sub 'program_code'
 146     .param pmc    data
 147     .local string template, out
 148
 149     template = 'pc_template'()
 150     out = 'merge_data'(template, data)
 151
 152     .return (out)
 153 .end
 154
 155
 156 # template data functions
 157 .sub 'pc_template'
 158     .local string out
 159
 160     out = 'header'()
 161
 162     $S0 = <<'END_PC'
 163 int8_t program_code[] = {
 164 @BYTECODE@
 165 };
 166
 167 int bytecode_size = @SIZE@;
 168
 169 END_PC
 170
 171     out .= $S0
 172     $S0  = 'body'()
 173     out .= $S0
 174
 175     .return (out)
 176 .end
 177
 178
 179 .sub 'header'
 180     $S0 = <<'END_HEADER'
 181 #include "parrot/parrot.h"
 182 #include "parrot/embed.h"
 183
 184 #ifdef _MSC_VER
 185 #   define int8_t signed__int8
 186 #endif
 187
 188 END_HEADER
 189     .return ($S0)
 190 .end
 191
 192
 193 .sub 'body'
 194     $S0 = <<'END_BODY'
 195 int main(int argc, const char *argv[])
 196 {
 197     PackFile *pf;
 198
 199     Parrot_Interp interp = Parrot_new( NULL );
 200
 201     if (!interp)
 202         return 1;
 203
 204     pf = PackFile_new(interp, 0);
 205
 206     if (!PackFile_unpack(interp, pf, (opcode_t *)program_code, bytecode_size))
 207         return 1;
 208
 209     do_sub_pragmas(interp, pf->cur_cs, PBC_PBC, NULL);
 210
 211     Parrot_loadbc(interp, pf);
 212
 213     PackFile_fixup_subs(interp, PBC_MAIN, NULL);
 214     Parrot_runcode(interp, argc, argv);
 215     Parrot_destroy(interp);
 216     Parrot_exit(interp, 0);
 217
 218     return 0;
 219 }
 220 END_BODY
 221     .return ($S0)
 222 .end
 223
 224
 225 # template merging functions
 226 .sub 'merge_data'
 227     .param string template
 228     .param pmc    data
 229
 230     .local pmc    iter
 231     iter = new 'Iterator', data
 232
 233     .local string symbol, value
 234
 235   it_loop:
 236     unless iter goto it_done
 237     $P0 = shift iter
 238     symbol = 'get_symbol'($P0)
 239     value  = iter[$P0]
 240       repl_loop:
 241         $I0 = index template, symbol
 242         if -1 == $I0 goto repl_done
 243         $I1 = length symbol
 244         substr template, $I0, $I1, value
 245         goto repl_loop
 246       repl_done:
 247     goto it_loop
 248
 249   it_done:
 250     .return (template)
 251 .end
 252
 253
 254 .sub 'get_symbol'
 255     .param string var
 256     $S0 = '@'
 257     $S1 = concat $S0, var
 258     $S1 = concat $S1, $S0
 259     .return ($S1)
 260 .end
 261
 262
 263 # util functions
 264 .sub 'compile_file'
 265     .param string cfile
 266     .param string exefile
 267
 268     .local string compile
 269     compile  = '%s '
 270     compile .= cfile
 271     compile .= ' -o '
 272     compile .= exefile
 273
 274     .local int status
 275     status = spawnw compile
 276     unless status goto compiled
 277
 278     say compile
 279     die "compilation failed"
 280
 281   compiled:
 282     print "Compiled: "
 283     say exefile
 284     .return()
 285 .end
 286
 287 # Local Variables:
 288 #   mode: cperl
 289 #   cperl-indent-level: 4
 290 #   fill-column: 100
 291 # End:
 292 # vim: expandtab shiftwidth=4: