view cbctools/change_OPS_h_to_cbc.pl @ 28:fa930a3213fc

forget minilua
author anatofuz
date Sat, 03 Nov 2018 23:24:33 +0900
parents f4636c3adb79
children
line wrap: on
line source

#!/usr/bin/env perl
use strict;
use warnings;
#
# Input file is dispatc.cbc 
#

print << 'EOFEOF';
typedef struct interp {
     MVMuint16 op;
     /* Points to the place in the bytecode right after the current opcode. */
     /* See the NEXT_OP macro for making sense of this */
     MVMuint8 *cur_op;

     /* The current frame's bytecode start. */
     MVMuint8 *bytecode_start;

     /* Points to the base of the current register set for the frame we
      * are presently in. */
     MVMRegister *reg_base;

     /* Points to the current compilation unit. */
     MVMCompUnit *cu;

     /* The current call site we're constructing. */
     MVMCallsite *cur_callsite;

     MVMThreadContext *tc;
 } INTER,*INTERP;
EOFEOF

my %codesegs = ();
my $file;

{
    $file = shift or die "require .cbc file";
    open my $fh, '<',$file;

    while (my $line = <$fh>){
        if ($line =~ /__code cbc_(.*)\(INTERP i\)/){
            my $codesegment = $1;
            $codesegs{$codesegment} = 1;
        }
    }

    close $fh;
}

$file = shift or die "require .cbc file";
open my $fh, '<',$file;
my @out = ();

while(my $line = <$fh>){
    if ($line =~ /^\s+&&OP_(.*),/){
        if (exists($codesegs{$1})){
            push @out,"    cbc_$1,\n";
            next;
        }
    }
}

close $fh;


for my $code_gear (@out){
    $code_gear =~ s/^\s+(\w+),\n/$1/g;
    print "__code $code_gear(INTERP);\n";
}

print "\n";
print " __code (* CODES[])(INTERP) = {\n";
map {print "   $_,\n";} @out;
print "};\n";