view src/parallel_execution/generate_stub.pl @ 324:d9887056ae5b

Update Todo and Add comment to perl script
author one
date Fri, 14 Apr 2017 19:52:26 +0900
parents ec0a5b4fba05
children 3529c7e93c4f
line wrap: on
line source

#!/usr/bin/perl

use strict;
use Getopt::Std;

# interface.cbc
# typedef struct Worker {
#         int id;
#         struct Context* contexts;
#         enum Code execute;
#         enum Code taskSend;
#         enum Code taskRecive;
#         enum Code shutdown;
#         struct Queue* tasks;
#     } Worker;

our($opt_o,$opt_d,$opt_h);
getopts('o:d:h');

my $dir = ".";
if ($opt_d) {
    $dir = $opt_d;
    if (! -d $dir) {
        mkdir $dir;
    }
}

for my $fn (@ARGV) { 
    next if ($fn !~ /\.cbc$/);
    &getDataGear($fn);
    &generateDataGear($fn);
}

my %var;
my %code;
my %dataGearVar;
my %outputVar;       # output var initializer
my %outputArgs;      # continuation's output variables
my %dataGear;
my %dataGearName;
my $implementation;
my $interface;

sub getDataGear {
    my ($filename) = @_;
    my ($codeGearName, $name, $inTypedef);
    open my $fd,"<",$filename or die("can't open $filename $!");
    while (<$fd>) {
        if (! $inTypedef) {
            if (/^typedef struct (\w+)/) {
                $inTypedef = 1;
                $name = $1;
                $dataGear{$name} = $_;
                $var{$name} = {};
                $code{$name} = {};
            } elsif (/^(\w+)(\*)+ create(\w+)\(/) {
                if (defined $interface) {
                   die "duplicate interface $interface\n"; 
                }
                $interface = $1;
                $implementation = $3;
                if ( -f "$interface.cbc") {
                    &getDataGear("$interface.cbc");
                }
            }
            next;
        }
        # gather type name and type
        $dataGear{$name} .= $_;
	if (/^\s*(.*)\s+(\w+);$/ ) {
            my $ttype = $1;
            my $tname = $2;
            if ($ttype =~ /^(union|struct) (\w+)/) {
                $ttype = $2;
            }
            $var{$name}->{$tname} = $ttype;
	} elsif (/\_\_code (\w+)\(/) {
            $code{$name}->{$1} = 1;
        }
        if (/^}/) {
            $inTypedef = 0;
        }
    }
}

sub generateStub {
    my($fd,$prevCodeGearName,$dataGearName) = @_;
    print $fd "__code ", $prevCodeGearName ,"_stub(struct Context* context) {\n";
    print $fd $dataGearName;
    print $fd "\n} \n\n";
    return 1;
}

sub generateStubArgs {
    my($codeGearName, $varName, $typeName, $typeField, $interface,$output) = @_;
    my $varname1 = $output?"O_$varName":$varName; 
    for my $n ( @{$dataGearVar{$codeGearName}} ) {
        # we already have it
        return 0 if ( $n eq $varname1);
    }
    push @{$dataGearVar{$codeGearName}}, $varname1;
    if ($typeName eq $implementation) {
        # get implementation
        $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $interface, $varName);\n";
    } else {
        for my $ivar (keys %{$var{$interface}}) {
            #  input data gear field 
            if ($varName eq $ivar) {
                if ($typeName eq $var{$interface}->{$ivar}) {
                    if ($output) {
                        $dataGearName{$codeGearName} .= "\t$typeName** O_$varName = &Gearef(context, $interface)->$varName;\n";
                        $outputVar{$codeGearName} .= "\t$typeName* $varName;\n";
                        return 1;
                    }
                
                    $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $interface)->$varName;\n";
                    return 1;
                }
            }
        }
        for my $cName (keys %{$code{$interface}}) {
            if ($varName eq $cName) {
                # continuation field
                $dataGearName{$codeGearName} .= "\tenum Code $varName = Gearef(context, $interface)->$varName;\n";
                return 1;
            }
        }
        # global variable case
        $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $typeName);\n";
        return 1;
    }
}

sub generateDataGear {
    my ($filename) = @_;
    open my $in,"<",$filename or die("can't open $filename $!");

    my $fn;
    if ($opt_o) {
       $fn = $opt_o;
    } else {
        my $fn1 = $filename;
        $fn1 =~ s/\.cbc/.c/;
        my $i = 1;
        $fn = "$dir/$fn1";
        while ( -f $fn) {
            $fn = "$dir/$fn1.$i";
            $i++;
        }
    }
    if ( $fn =~ m=(.*)/[^/]+$= ) {
        if (! -d $1) {
            mkdir $1;
        }
    }
    open my $fd,">",$fn or die("can't write $fn $!");

    my $prevCodeGearName;
    my $inTypedef = 0;
    my $inStub = 0;
    my %stub;
    my $codeGearName;

    while (<$in>) {
        if (! $inTypedef && ! $inStub) {
            if (/^typedef struct (\w+) {/) {
                $inTypedef = 1;
            } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) {
                $codeGearName = $1;
                my $args = $2;
                my $tail = $3;
                if ($codeGearName =~ /_stub$/) {
                    # don't touch already existing stub
                    $inStub = 1;
                    $stub{$codeGearName} = 1;
                    print $fd $_;
                    next;
                }
                if (defined $prevCodeGearName) {
                    # stub is generated just before next CodeGear
                    if (defined $stub{$prevCodeGearName."_stub"}) {
                        undef $prevCodeGearName;
                    } else {
                        &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName});
                        $stub{$prevCodeGearName."_stub"} = 1;
                    }
                }
                # analyzing CodeGear argument
                #      these arguments are extract from current context's arugment DataGear Interface
                #      and passed to the CodeGear
                #      struct Implementaion needs special handling
                #      __code next(...)   --->   enum Code next
                $prevCodeGearName = $codeGearName;
                $dataGearVar{$codeGearName} = [];
                $outputVar{$codeGearName} = "";
                $outputArgs{$codeGearName} = {};
                my $newArgs = "struct Context *context,";
                if ($args=~/^struct Context\s*\*\s*context/) {
                    $newArgs = "";
                }
                while($args) {
                    if ($args =~ s/(^\s*,\s*)//) {
                        $newArgs .= $1;
                    }
                    # continuation case
                    if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) {
                        my $next = $2;
                        my @args = split(/,/,$3);
                        if ( &generateStubArgs($codeGearName, $next, "Code", $next, $interface,0) ) {
                            $newArgs .= "enum Code $next";
                        }
                        # analyze continuation arguments
                        #    output arguments are defined in the Interface take the pointer of these
                        #    output arguments are put into the Interface DataGear just before the goto
                        for my $arg (@args) {
                            $arg =~ s/^\s*//;
                            last if ($arg =~ /\.\.\./);
                            $arg =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//;
                            my $structType = $1;
                            my $typeName = $2;
                            my $varName = $4;
                            my $typeField = lcfirst($typeName);
                            push(@{$outputArgs{$codeGearName}->{$next}}, $varName);
                            if (&generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface,1)) {
                                $newArgs .= ",$structType $typeName **O_$varName";
                            }
                        }
                    } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) {
                        my $structType = $1;
                        my $typeName = $2;
                        my $varName = $4;
                        my $typeField = lcfirst($typeName);
                        $newArgs .= $&;    # assuming no duplicate
                        &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface,0);
                    } elsif ($args =~ s/(.*,)//) {
                        $newArgs .= $1; 
                    } else {
                        $newArgs .= $args;
                        last;
                    }
                }
                # generate goto statement from stub to the CodeGear in the buffer
                $dataGearName{$codeGearName} .= "\tgoto $codeGearName(context";
                for my $arg ( @{$dataGearVar{$codeGearName}}) {
                    $dataGearName{$codeGearName} .= ", $arg";
                }
                $dataGearName{$codeGearName} .= ");";
                # generate CodeGear header with new arguments
                print $fd "__code $codeGearName($newArgs)$tail\n";
                if ($outputVar{$codeGearName} ne "") {
                    # output data var can be use before write
                    # it should be initialze by gearef
                    print $fd $outputVar{$codeGearName};
                }
                next;
            } elsif (/^(.*)goto (\w+)\((.*)\);/) {
                # handling goto statement  
                # convert it to the meta call form with two arugments, that is context and enum Code
                my $prev = $1;
                my $next = $2;
                my @args = split(/,/,$3);
                if (defined $code{$interface}->{$next}) { 
                    # write continuation's arguments into the interface arguments
                    # we may need a commit for a shared DataGear
                    for my $arg ( @{$outputArgs{$codeGearName}->{$next}} ) {
                        my $v = shift(@args);
                        print $fd "\t*O_$arg = $v;\n";
                    }
                    print $fd "${prev}goto meta(context, $next);\n";
                    next;
                }
            } else {
                s/new\s+(\w+)\(\)/\&ALLOCATE(context, \1)->\1/g;   # replacing new
            }
        # gather type name and type
        } elsif (/^}/) {
            $inStub = 0;
            $inTypedef = 0;
        }
        print $fd $_;
    }
    if (defined $prevCodeGearName) {
        if (!defined $stub{$prevCodeGearName."_stub"}) {
            $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName});
        }
    }
}

# end