view src/gearsTools/generate_stub.pl @ 46:9647d79fe97e

merge
author one
date Sun, 03 Mar 2019 17:39:45 +0900
parents 5f19e9554c30 94ca6db2ee9c
children 214d21c891c7
line wrap: on
line source

#!/usr/bin/perl

use strict;
use Getopt::Std;
use File::Path qw(make_path);

# interface.h
# 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) {
        make_path $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 %generic;
my %dataGearVarType;
my %codeGear;
my $implementation;
my $interface;

# interface definision
#
# typedef struct Stack<Type, Impl>{
#         Type* stack;
#         Type* data;
#         Type* data1;
#         __code whenEmpty(...);
#         __code clear(Impl* stack,__code next(...));
#         __code push(Impl* stack,Type* data, __code next(...));
#         __code pop(Impl* stack, __code next(Type*, ...));
#         __code pop2(Impl* stack, Type** data, Type** data1, __code next(Type**, Type**, ...));
#         __code isEmpty(Impl* stack, __code next(...), __code whenEmpty(...));
#         __code get(Impl* stack, Type** data, __code next(...));
#         __code get2(Impl* stack,..., __code next(...));
#         __code next(...);
# } Stack;
#
# calling example
#
# goto nodeStack->push((union Data*)node, stackTest3);
#
# generated meta level code
#
# Gearef(context, Stack)->stack = (union Data*)nodeStack;
# Gearef(context, Stack)->data = (union Data*)node;
# Gearef(context, Stack)->next = C_stackTest3;
# goto meta(context, nodeStack->push);

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+)\s*<(.*)>/) {
                $inTypedef = 1;
                $name = $1;
                $dataGear{$name} = $_;
                $var{$name} = {};
                $code{$name} = {};
                $generic{$name} = \split(/,/,$2);
            } elsif (/^typedef struct (\w+)/) {
                $inTypedef = 1;
                $name = $1;
                $dataGear{$name} = $_;
                $var{$name} = {};
                $code{$name} = {};
                $generic{$name} = [];
            } elsif (/^(\w+)(\*)+ create(\w+)\(/) {
                if (defined $interface) {
                   die "duplicate interface $interface\n";
                }
                $interface = $1;
                $implementation = $3;
                if ( -f "$interface.cbc") {
                    &getDataGear("$interface.cbc");
                }
            } elsif(/^(.*)par goto (\w+)\((.*)\)/) {
                my $codeGearName = $2;
                if ($filename =~ /^(.*)\/(.*)/) {
                    $codeGearName = "$1/$codeGearName";
                }
                if ( -f "$codeGearName.cbc") {
                    &getCodeGear("$codeGearName.cbc");
                }
			} elsif(/^#interface "(.*)"/) {
                # use interface
                my $interfaceHeader = $1;
                next if ($interfaceHeader =~ /context.h/);
                if (-f $interfaceHeader) {
                    &getDataGear("$interfaceHeader");
                    &getCodeGear("$interfaceHeader");
                }
            } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) {
                my $codeGearName = $1;
                if ($filename =~ /^(.*)\/(.*)/) {
                    $codeGearName = "$1/$codeGearName";
                }
                if ( -f "$codeGearName.cbc") {
                    &getCodeGear("$codeGearName.cbc");
                }
            }
            next;
        }
        # gather type name and type
        $dataGear{$name} .= $_;
        if (/^\s*(.*)\s+(\w+);$/ ) {
            my $ttype = $1;
            my $tname = $2;
            if ($ttype =~ /^(union|struct)?\s*(\w+)/) {
                $ttype = $2;
            }
            $var{$name}->{$tname} = $ttype;
        }
        if (/^}/) {
            $inTypedef = 0;
        }
    }

}

sub getCodeGear {
    my ($filename) = @_;
    open my $fd,"<",$filename or die("can't open $filename $!");
    my ($name,$impln);
    while (<$fd>) {
        if (/^(\w+)(\*)+ create(\w+)\(/) {
            $name = $1;
            $impln = $3;
        } elsif(/^typedef struct (.*)<.*>\s*{/) {
            $name = $1;
        }
        if (defined $name) {
            if (/^\s*\_\_code (\w+)\((.*)\);/) {
                my $args = $2;
                my $method = $1;
                $code{$name}->{$method} = [];
                while($args) {
                    # replace comma
                    $args =~ s/(^\s*,\s*)//;
                    # continuation case
                    if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) {
                        my $next = $2;
                        my @args = split(/,/,$3);
                        push(@{$code{$name}->{$method}},"\_\_code $next");
                    } elsif ($args =~ s/^(struct|union)?\s*(\w+)(\**)\s+(\w+)//) {
                        my $structType = $1;
                        my $typeName = $2;
                        my $ptrType = $3;
                        my $varName = $4;
                        my $typeField = lcfirst($typeName);
                        push(@{$code{$name}->{$method}},"$typeName$ptrType $varName");
                    } elsif ($args =~ s/(.*,)//) {
                    } else {
                        last;
                    }
                }
            }
        } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) {
            my $codeGearName = $1;
            my $args = $2;
            my $inputCount = 0;
            my $outputCount = 0;
            my $inputIncFlag = 1;
            while($args) {
                if ($args =~ s/(^\s*,\s*)//) {
                }
                if ($args =~ s/^(\s)*\_\_code\s+(\w+)\((.*?)\)//) {
                    $codeGear{$codeGearName}->{"code"}->{$2} = "\_\_code";
                    $inputIncFlag = 0;
                    my @outputs = split(/,/,$3);
                    for my $output (@outputs) {
                        if ($output =~ /\s*(struct|union)?\s*(\w+)(\*)?+\s(\w+)/) {
                            my $type = $2;
                            my $varName = $4;
                            $codeGear{$codeGearName}->{"var"}->{$varName} = "$type $outputCount";
                            $outputCount++;
                        }
                    }
                } elsif ($args =~ s/^(struct|union)?\s*(\w+)(\*)?+\s(\w+)// && $inputIncFlag) {
                    my $type = $2;
                    my $varName = $4;
                    $codeGear{$codeGearName}->{"var"}->{$varName} = "$type $inputCount";
                    $inputCount++;
                } elsif ($args =~ s/(.*,)//) {
                } else {
                    last;
                }
            }
            $codeGear{$codeGearName}->{"input"} = $inputCount;
            $codeGear{$codeGearName}->{"output"} = $outputCount;
        }
    }
}

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, $ptrType, $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;
    push @{$dataGearVarType{$codeGearName}}, $typeName;
    if ($typeName eq $implementation) {
        # get implementation
        $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $interface, $varName);\n";
    } else {
        # interface var
        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$ptrType* O_$varName = &Gearef(context, $interface)->$varName;\n";
                        $outputVar{$codeGearName} .= "\t$typeName$ptrType $varName = *O_$varName;\n";
                        return 1;
                    }
                    $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = Gearef(context, $interface)->$varName;\n";
                    return 1;
                }
            }
        }

        # interface continuation
        for my $cName (keys %{$code{$interface}}) {
            if ($varName eq $cName) {
                # continuation field
                $dataGearName{$codeGearName} .= "\tenum Code $varName = Gearef(context, $interface)->$varName;\n";
                return 1;
            }
        }

        # par goto  var
        for my $var (keys %{$codeGear{$codeGearName}->{"var"}}) {
            #  input data gear field
            if ($varName eq $var) {
                my ($type, $count) = split(/\s/, $codeGear{$codeGearName}->{"var"}->{$var});
                if ($typeName eq $type) {
                    if ($output) {
                        $dataGearName{$codeGearName} .= "\t$typeName$ptrType* O_$varName = ($typeName $ptrType*)&context->data[context->odg + $count];\n";
                        $outputVar{$codeGearName} .= "\t$typeName$ptrType $varName = *O_$varName;\n";
                        return 1;
                    }
                    $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = &context->data[context->idg + $count]->$typeName;\n";
                    return 1;
                }
            }
        }

        # par goto continuation
        for my $cName (keys %{$codeGear{$codeGearName}->{"code"}}) {
            if ($varName eq $cName) {
                # continuation field
                $dataGearName{$codeGearName} .= "\tenum Code $varName = context->next;\n";
                return 1;
            }
        }

        # par goto continuation
        # global or local variable case
        if ($typeName eq "Code") {
            $dataGearName{$codeGearName} .= "\tenum $typeName$ptrType $varName = Gearef(context, $interface)->$varName;\n";
            return 1;
        }
        $dataGearName{$codeGearName} .= "\t$typeName$ptrType $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) {
            make_path $1;
        }
    }
    open my $fd,">",$fn or die("can't write $fn $!");

    my $prevCodeGearName;
    my $inTypedef = 0;
    my $inStub = 0;
    my $hasParGoto = 0;
    my $inMain = 0 ;
    my %stub;
    my $codeGearName;
    my %localVarType;

    while (<$in>) {
        if (! $inTypedef && ! $inStub && ! $inMain) {
            if (/^typedef struct (\w+) \{/) {
                $inTypedef = 1;
            } elsif (/^int main\((.*)\) \{/) {
                $inMain = 1;
            } elsif(/^#interface "(.*)"/) {
                my $interfaceHeader = $1;
                # #interface not write
                next unless ($interfaceHeader =~ /context.h/);
            } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) {
                %localVarType = {};
                $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 = "";
                }
                if (!$args){
                    $newArgs = "struct Context *context";
                }
                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)?\s*(\w+)(\**)\s(\w+)//;
                            my $structType = $1;
                            my $typeName = $2;
                            my $ptrType = $3;
                            my $varName = $4;
                            my $typeField = lcfirst($typeName);
                            push(@{$outputArgs{$codeGearName}->{$next}}, $varName);
                            if (&generateStubArgs($codeGearName, $varName, $typeName, $ptrType, $typeField, $interface,1)) {
                                $newArgs .= ",$structType $typeName **O_$varName";
                            }
                        }
                    } elsif ($args =~ s/^(struct|union)?\s*(\w+)(\**)\s(\w+)//) {
                        my $structType = $1;
                        my $typeName = $2;
                        my $ptrType = $3;
                        my $varName = $4;
                        my $typeField = lcfirst($typeName);
                        $newArgs .= $&;    # assuming no duplicate
                        &generateStubArgs($codeGearName, $varName, $typeName, $ptrType, $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+)\-\>(\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 $method = $3;
                my $tmpArgs = $4;
                $tmpArgs =~ s/\(.*\)/\(\)/;
                my @args = split(/,/,$tmpArgs);
                my @types = @{$dataGearVarType{$codeGearName}};
                my $ntype;
                my $ftype;
                for my $v (@{$dataGearVar{$codeGearName}}) {
                    my $t = shift @types;
                    if ($v eq $next || $v eq "O_$next") {
                        $ntype = $t;
                        $ftype = lcfirst($ntype);
                    }
                }
                if (!defined $ntype) {
                    $ntype = $localVarType{$next};
                    $ftype = lcfirst($ntype);
                }
                print $fd "\tGearef(context, $ntype)->$ftype = (union Data*) $next;\n";
                # Put interface argument
                my $prot = $code{$ntype}->{$method};
                my $i = 1;
                for my $arg (@args) {
                    my $pType;
                    my $pName;
                    my $p = @$prot[$i];
                    next if ($p eq $arg);
                    $p =~ s/^(.*)\s(\w+)//;
                    $pType = $1;
                    $pName = $2;
                    $arg =~ s/^(\s)*(\w+)/$2/;
                    if ($pType =~ s/\_\_code$//) {
                        if ($arg =~ /(\w+)\(.*\)/) {
                            print $fd "\tGearef(context, $ntype)->$pName = $1;\n";
                        } else {
                            print $fd "\tGearef(context, $ntype)->$pName = C_$arg;\n";
                        }
                    } elsif ($pType =~ /Data\**$/){
                        print $fd "\tGearef(context, $ntype)->$pName = (union $pType) $arg;\n";
                    } else {
                        print $fd "\tGearef(context, $ntype)->$pName = $arg;\n";
                    }
                    $i++;
                }
                print $fd "${prev}context->before = C_$codeGearName;\n";
                print $fd "${prev}goto meta(context, $next->$method);\n";
                next;
            } elsif(/^(.*)par goto (\w+)\((.*)\);/) {
                # handling par goto statement
                # convert it to the parallel
                my $prev = $1;
                my $codeGearName = $2;
                my $args = $3;
                my $inputCount = $codeGear{$codeGearName}->{'input'};
                my $outputCount = $codeGear{$codeGearName}->{'output'};
                my @iterateCounts;
                # parse examples 'par goto(.., iterate(10), exit);'
                if ($args =~ /iterate\((.*)?\),/) {
                    @iterateCounts = split(/,/,$1);;
                    $inputCount--;
                }
                # replace iterate keyword
                $args =~ s/iterate\((.*)?\),//;
                my @dataGears = split(/,\s*/, $args);
                my $nextCodeGear = pop(@dataGears);
                if (! $hasParGoto) {
                    $hasParGoto = 1;
                    print $fd "${prev}struct Element* element;\n";
                }
                my $initTask = << "EOFEOF";
                ${prev}context->task = NEW(struct Context);
                ${prev}initContext(context->task);
                ${prev}context->task->next = C_$codeGearName;
                ${prev}context->task->idgCount = $inputCount;
                ${prev}context->task->idg = context->task->dataNum;
                ${prev}context->task->maxIdg = context->task->idg + $inputCount;
                ${prev}context->task->odg = context->task->maxIdg;
                ${prev}context->task->maxOdg = context->task->odg + $outputCount;
EOFEOF
                print $fd $initTask;
                if (@iterateCounts) {
                    print $fd "${prev}context->task->iterate = 0;\n";
                    my $len = @iterateCounts;
                    if ($len == 1) {
                        print $fd "${prev}context->task->iterator = createMultiDimIterator(context, $iterateCounts[0], 1, 1);\n";
                    } elsif ($len == 2) {
                        print $fd "${prev}context->task->iterator = createMultiDimIterator(context, $iterateCounts[0], $iterateCounts[1], 1);\n";
                    } elsif ($len == 3) {
                        print $fd "${prev}context->task->iterator = createMultiDimIterator(context, $iterateCounts[0], $iterateCounts[1], $iterateCounts[2]);\n";
                    }
                }
                for my $dataGear (@dataGears) {
                    print $fd "${prev}GET_META($dataGear)->wait = createSynchronizedQueue(context);\n";
                }
                for my $i (0..$inputCount-1) {
                    print $fd "${prev}context->task->data[context->task->idg+$i] = (union Data*)@dataGears[$i];\n";
                }
                for my $i (0..$outputCount-1) {
                    print $fd "${prev}context->task->data[context->task->odg+$i] = (union Data*)@dataGears[$inputCount+$i];\n";
                }
                my $putTask = << "EOFEOF";
                ${prev}element = &ALLOCATE(context, Element)->Element;
                ${prev}element->data = (union Data*)context->task;
                ${prev}element->next = context->taskList;
                ${prev}context->taskList = element;
EOFEOF
                print $fd $putTask;
                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);
                my $v = 0;
                for my $n ( @{$dataGearVar{$codeGearName}} ) {
                    # continuation arguments
                    $v = 1  if ( $n eq $next);
                }
                if ($v || 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";
                    }
                    if ($hasParGoto) {
                        print $fd "${prev}Gearef(context, TaskManager)->taskList = context->taskList;\n";
                        print $fd "${prev}Gearef(context, TaskManager)->next1 = C_$next;\n";
                        print $fd "${prev}goto meta(context, C_$next);\n";
                    } else {
                        print $fd "${prev}context->before = C_$codeGearName;\n";
                        print $fd "${prev}goto meta(context, $next);\n";
                    }
                    next;
                }
                if ($hasParGoto) {
                    print $fd "${prev}Gearef(context, TaskManager)->taskList = context->taskList;\n";
                    print $fd "${prev}Gearef(context, TaskManager)->next1 = C_$next;\n";
                    print $fd "${prev}goto parGotoMeta(context, C_$next);\n";
                    next;
                } elsif ($next eq "meta") {
                    print $fd $_;
                    next;
                } else {
                    print $fd "${prev}context->before = C_$codeGearName;\n";
                    print $fd "${prev}goto meta(context, C_$next);\n";
                    next;
                }
            } elsif(/^.*(struct|union)?\s(\w+)\*\s(\w+)\s?[=;]/) {
                my $type    = $2;
                my $varName = $3;
                $localVarType{$varName} = $type;
                s/new\s+(\w+)\(\)/\&ALLOCATE(context, \1)->\1/g;   # replacing new
            } elsif(/^}/) {
                $hasParGoto = 0;
            } else {
                s/new\s+(\w+)\(\)/\&ALLOCATE(context, \1)->\1/g;   # replacing new
            }
            # gather type name and type
        } elsif ($inMain) {
            if (/^(.*)goto start_code\(main_context\);/) {
                print $fd $_;
                next;
            } elsif (/^(.*)goto (\w+)\((.*)\);/) {
                my $prev = $1;
                my $next = $2;
                print $fd "${prev}struct Context* main_context = NEW(struct Context);\n";
                print $fd "${prev}initContext(main_context);\n";
                print $fd "${prev}main_context->next = C_$next;\n";
                print $fd "${prev}goto start_code(main_context);\n";
                next;
            }
        }
        if (/^}/) {
            $inStub = 0;
            $inTypedef = 0;
            $inMain = 0;
        }
        print $fd $_;
    }
    if (defined $prevCodeGearName) {
        if (!defined $stub{$prevCodeGearName."_stub"}) {
            $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName});
        }
    }
}

# end