view src/parallel_execution/generate_stub.pl @ 258:4fe19a06d666

generate next args
author mir3636
date Sat, 28 Jan 2017 12:25:35 +0900
parents 79bbe2c63fb0
children 0cd43e22aee1
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 %type;
my %code;
my %dataGearVar;
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} = $_;
                $code{$name} = [];
            } elsif (/^(\w+)\* create(\w+)\(/) {
                if (defined $interface) {
                   die "duplicate interface $interface\n"; 
                }
                $interface = $1;
                $implementation = $2;
                if ( -f "$interface.cbc") {
                    &getDataGear("$interface.cbc");
                }
            }
            next;
        }
        # gather type name and type
        $dataGear{$name} .= $_;
	if (/(\w+);$/ and !/^} (\w+)/) {
	    my $tmp = $1 . "\n";
	    if (/{/) {
	            $tmp = "{" . $';
	            $tmp =~ s/;$//;
	    }
	    $var{$name} .= $tmp;
	    $tmp = $`;
	    $tmp =~ s/^\s*//;
	    $type{$name} .= $tmp . "\n";
	} elsif (/\_\_code (\w+)\(/) {
            push $code{$name}, $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) = @_;
    push @{$dataGearVar{$codeGearName}},$varName; 
    if ($typeField ne $varName) {
        $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $interface, $varName);\n";
        # print STDOUT "$codeGearName   \t$typeName* $varName = ($typeName*)GearImpl(context, $typeName, $varName);\n";
    } else {
        for my $ivar ($var{$interface}) {
            if ($varName eq $ivar) {
                $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $interface)->$varName;\n";
                # print STDOUT "$codeGearName   \t$typeName* $varName = Gearef(context, $interface)->$varName;\n";
                return;
            }
        }
        $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $typeName);\n";
        # print STDOUT "$codeGearName   \t$typeName* $varName = Gearef(context, $typeName)->$typeField;\n";
    }
}

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++;
        }
    }
    open my $fd,">",$fn or die("can't write $fn $!");

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

    while (<$in>) {
        if (! $inTypedef) {
            if (/^typedef struct (\w+) {/) {
                $inTypedef = 1;
            # get __code name
            } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) {
                $codeGearName = $1;
                my $args = $2;
                my $tail = $3;
                if ($codeGearName =~ /_stub$/) {
                    $stub{$codeGearName} = 1;
                    print $fd $_;
                    next;
                }
                if (defined $prevCodeGearName) {
                    if (defined $stub{$prevCodeGearName."_stub"}) {
                        undef $prevCodeGearName;
                        print $fd $_;
                        next;
                    }
                    $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName});
                }
                $prevCodeGearName = $codeGearName;
                $dataGearVar{$codeGearName} = [];
                my $newArgs = "";
                while($args) {
                    if ($args =~ s/(^\s*,\s*)//) {
                        $newArgs .= $1;
                    }
                    # replace __code next
                    if ($args =~ s/^\_\_code\s(\w+)\(([^)]*)\)//) {
                        my $next = $1;
                        my @args = split(/,/,$3);
                        my $nextArg = $2;
                        # generate stub args of next args
                        while ($nextArg =~ s/union (\w+)(\*)+\s([^,]*)//) {
                            my $typeName = $1.$2;
                            my $varName = $3;
                            my $typeField = lcfirst($1);
                            $newArgs .= "union $typeName\* $3, ";
                            &generateStubArgs($codeGearName, $varName, $1, $typeField, $interface);
                        }
                        $newArgs .= "enum Code $next";
                        for my $arg (@args) {
                            $arg =~ s/^\s*//;
                            $arg =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//;
                            my $structType = $1;
                            my $typeName = $2;
                            my $varName = $4;
                            my $typeField = lcfirst($typeName);
                            &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface);
                        }
                    } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) {
                        my $structType = $1;
                        my $typeName = $2;
                        my $varName = $4;
                        my $typeField = lcfirst($typeName);
                        $newArgs .= $&;
                        &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface);
                    } elsif ($args =~ s/(.*,)//) {
                        $newArgs .= $1; 
                    } else {
                        $newArgs .= $args;
                        last;
                    }
                }
                $dataGearName{$codeGearName} .= "\tgoto $codeGearName(context";
                for my $arg ( @{$dataGearVar{$codeGearName}}) {
                    $dataGearName{$codeGearName} .= ", $arg";
                }
                $dataGearName{$codeGearName} .= ");";
                print $fd "__code $codeGearName($newArgs)$tail\n";
                next;
            } elsif (/^(.*)goto\s(\w+)\((.*)\.\.\.\);/) {
                #print STDOUT "$3\n";
                my $prev = $1;
                my $args = $3;
                print $fd "${prev}goto meta(context, $2);\n";
                next;
            }
            print $fd $_;
            next;
        }
        # gather type name and type
        if (/^}/) {
            $inTypedef = 0;
        }
        print $fd $_;
    }
    if (defined $prevCodeGearName) {
        if (!defined $stub{$prevCodeGearName."_stub"}) {
            $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName});
        }
    }
}

# end