Ticket #688: pbc_to_exe_win32_msvc_fix.patch

File pbc_to_exe_win32_msvc_fix.patch, 10.2 KB (added by Util, 5 years ago)
  • tools/dev/pbc_to_exe.pir

     
    2020 
    2121.sub 'main' :main 
    2222    .param pmc    argv 
     23 
     24    load_bytecode 'config.pbc' 
     25 
    2326    .local string infile 
    2427    .local string cfile 
    2528    .local string objfile 
    2629    .local string exefile 
    27     .local string out 
    28     .local int    closeresult 
    2930 
    30     .local string gcc 
    31     .local int    is_gcc 
    32     load_bytecode 'config.pbc' 
    33     $P0 = '_config'() 
    34     gcc    = $P0['gccversion'] 
    35     $I0    = length gcc 
    36     is_gcc = $I0 > 0 
    37  
    3831    (infile, cfile, objfile, exefile) = 'handle_args'(argv) 
    3932    unless infile > '' goto err_infile 
    4033 
     34 
     35    .local string code_type 
     36    code_type = 'determine_code_type'() 
     37 
    4138    .local string codestring 
    42     unless is_gcc goto code_for_non_gcc 
     39    if code_type == 'gcc'  goto code_for_gcc 
     40    if code_type == 'msvc' goto code_for_msvc 
     41    goto code_for_default 
    4342  code_for_gcc: 
    4443    codestring = 'generate_code_gcc'(infile) 
    4544    goto code_end 
    46   code_for_non_gcc: 
     45  code_for_msvc: 
     46    codestring = 'generate_code_msvc'(infile) 
     47    goto code_end 
     48  code_for_default: 
    4749    codestring = 'generate_code'(infile) 
    4850  code_end: 
    4951 
     52 
    5053  open_outfile: 
    5154    .local pmc outfh 
    5255    outfh = open cfile, 'w' 
     
    5457    print outfh, <<'HEADER' 
    5558#include "parrot/parrot.h" 
    5659#include "parrot/embed.h" 
     60void * get_program_code(void); 
    5761HEADER 
    5862 
    5963    print outfh, codestring 
     
    6367        { 
    6468            PackFile     *pf; 
    6569            Parrot_Interp interp; 
     70            unsigned char *program_code_addr; 
    6671 
     72            program_code_addr = get_program_code(); 
     73            if (!program_code_addr) 
     74                return 1; 
     75 
    6776            Parrot_set_config_hash(); 
    6877 
    6978            interp = Parrot_new( NULL ); 
    70  
    7179            if (!interp) 
    7280                return 1; 
    7381 
     
    7684            Parrot_set_flag(interp, PARROT_DESTROY_FLAG); 
    7785 
    7886            pf = PackFile_new(interp, 0); 
     87            if (!pf) 
     88                return 1; 
    7989 
    8090            if (!PackFile_unpack(interp, pf, 
    81                     (const opcode_t *)program_code, bytecode_size)) 
     91                    (const opcode_t *)program_code_addr, bytecode_size)) 
    8292                return 1; 
    8393 
    8494            do_sub_pragmas(interp, pf->cur_cs, PBC_PBC, NULL); 
     
    92102        } 
    93103MAIN 
    94104 
     105 
    95106    # The close opcode does not return a result code, 
    96107    # use the method instead. 
     108    .local int    closeresult 
    97109    closeresult = outfh.'close'() 
    98110    unless closeresult == 0 goto err_close 
    99111 
     112 
     113    .local string extra_obj 
     114    extra_obj = '' 
     115    if code_type != 'msvc' goto no_extra 
     116    extra_obj  = 'replace_pbc_extension'(infile, '.RES') 
     117  no_extra: 
     118 
     119 
    100120    'compile_file'(cfile, objfile) 
    101     'link_file'(objfile, exefile) 
     121    'link_file'(objfile, exefile, extra_obj) 
    102122    .return () 
    103123 
    104124  err_infile: 
     
    113133.sub 'handle_args' 
    114134    .param pmc argv 
    115135 
     136    .local string obj, exe 
     137    $P0    = '_config'() 
     138    obj    = $P0['o'] 
     139    exe    = $P0['exe'] 
     140 
    116141    .local pmc args 
    117142    args   = argv 
    118143 
     
    133158    .return () 
    134159 
    135160  proper_install: 
    136     .local string cfile, objfile, obj, exefile, exe 
     161    .local string cfile, objfile, exefile 
    137162 
    138     $P0    = '_config'() 
    139     obj    = $P0['o'] 
    140     exe    = $P0['exe'] 
     163    cfile   = 'replace_pbc_extension'(infile, '.c') 
     164    objfile = 'replace_pbc_extension'(infile, obj) 
     165    $S0     = 'replace_pbc_extension'(infile, exe) 
     166    exefile = concat 'installable_', $S0 
    141167 
    142     .local int infile_len 
    143     infile_len  = length infile 
    144     infile_len -= 3 
    145  
    146     cfile       = substr infile, 0, infile_len 
    147     cfile      .= 'c' 
    148  
    149     dec infile_len 
    150     objfile     = substr infile, 0, infile_len 
    151     exefile     = 'installable_' 
    152     exefile    .= objfile 
    153     exefile    .= exe 
    154     objfile    .= obj 
    155168    .return(infile, cfile, objfile, exefile) 
    156169 
    157170  proper_args: 
    158     .local string infile, cfile, objfile, obj, exefile, exe 
     171    .local string infile, cfile, objfile, exefile 
    159172 
    160     $P0    = '_config'() 
    161     obj    = $P0['o'] 
    162     exe    = $P0['exe'] 
    163  
    164173    $P0    = shift args 
    165174    infile = shift args 
    166175 
    167     .local int infile_len 
    168     infile_len  = length infile 
    169     infile_len -= 3 
     176    cfile   = 'replace_pbc_extension'(infile, '.c') 
     177    objfile = 'replace_pbc_extension'(infile, obj) 
     178    exefile = 'replace_pbc_extension'(infile, exe) 
    170179 
    171     cfile       = substr infile, 0, infile_len 
    172     cfile      .= 'c' 
    173  
    174     dec infile_len 
    175     objfile     = substr infile, 0, infile_len 
    176     objfile    .= obj 
    177     exefile     = substr infile, 0, infile_len 
    178     exefile    .= exe 
    179  
    180180    # substitute .c for .pbc 
    181181    # remove .c for executable 
    182182 
     
    184184    .return(infile, cfile, objfile, exefile) 
    185185.end 
    186186 
     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 
    187212.sub 'generate_code' 
    188213    .param string infile 
    189214    .local pmc ifh 
     
    227252    $S0 = size 
    228253    codestring .= $S0 
    229254    codestring .= ";\n" 
     255    codestring .= <<'END_OF_FUNCTION' 
     256        void * get_program_code(void) 
     257        { 
     258            return program_code; 
     259        } 
     260END_OF_FUNCTION 
     261 
    230262    .return (codestring) 
    231263 
    232264  err_infile: 
    233265    die "cannot open infile" 
    234266.end 
    235267 
     268 
    236269# The PBC will be represented as a C string, so this sub builds a table 
    237270# of the C representation of each ASCII character, for lookup by ordinal value. 
    238271.sub 'generate_encoding_table' 
     
    312345    $S0 = size 
    313346    codestring .= $S0 
    314347    codestring .= ";\n" 
     348 
     349    codestring .= <<'END_OF_FUNCTION' 
     350        void * get_program_code(void) 
     351        { 
     352            return program_code; 
     353        } 
     354END_OF_FUNCTION 
     355 
    315356    .return (codestring) 
    316357 
    317358  err_infile: 
    318359    die "cannot open infile" 
    319360.end 
    320361 
     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 
     413END_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        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        } 
     477END_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 
    321503# util functions 
    322504.sub 'compile_file' 
    323505    .param string cfile 
     
    371553.sub 'link_file' 
    372554    .param string objfile 
    373555    .param string exefile 
     556    .param string extra_obj 
    374557    .param int install :optional 
    375558 
    376559    $P0 = '_config'() 
     
    415598    link .= pathquote 
    416599    link .= objfile 
    417600    link .= pathquote 
     601    unless extra_obj > '' goto skip_extra_obj 
    418602    link .= ' ' 
     603    link .= pathquote 
     604    link .= extra_obj 
     605    link .= pathquote 
     606  skip_extra_obj: 
     607    link .= ' ' 
    419608    link .= config 
    420609    link .= ' ' 
    421610    link .= rpath