view src/parallel_execution/generate_stub.pl @ 251:0ab52d6e2fd9

fix sub generateStub
author mir3636
date Thu, 26 Jan 2017 09:38:09 +0900
parents 8a8963ce9858
children 682b1195e604
line wrap: on
line source

#!/usr/bin/perl

use strict;

# 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;

while (<*.cbc>) {
    my $fn = $_;
    &getDataGear($fn);
    &generateDataGear($fn);
}

my %var;
my %type;
my %code;
my %dataGearVar;
my %dataGear;
my %dataGearName;

sub getDataGear {
    my ($filename) = @_;
    my ($interface, $implementation, $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} = $_;
            } elsif (/^(\w+)\* create(\w+)\(/) {
                if (defined $interface) {
                   die "duplicate interface $interface\n"; 
                }
                $interface = $1;
                $implementation = $2;
                if ( -f "$interface.cbc") {
                    &getDataGear("$interface.cbc");
                }
            } elsif (/^\_\_code (\w+)/) {
                $codeGearName = $1;
                $dataGearVar{$codeGearName} = [];
                args:while (/(struct|union) (\w+)\*\s(\w+)/g) {
                    my $structType = $1;
                    my $typeName = $2;
                    my $varName = $3;
                    my $typeField = lcfirst($typeName);
                    push @{$dataGearVar{$codeGearName}},$varName; 
                    if ($typeField ne $varName) {
                        $dataGearName{$codeGearName} .= "\t$typeName* $varName = (" . $typeName . "*)GearImpl(context, " . $varName . ", " . $varName . ");\n";
                    } else {
                        for my $ivar ( $var{$interface}) {
                            if ($varName eq $ivar) {
                                $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $interface)->$varName;\n";
                                next args;
                            }
                        }
                        $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, " . $typeName . ")->$typeField;\n";
                    }
                }
                $dataGearName{$codeGearName} .= "\tgoto $codeGearName(context";
                for my $arg ( @{$dataGearVar{$codeGearName}}) {
                    $dataGearName{$codeGearName} .= ", $arg";
                }
                $dataGearName{$codeGearName} .= ");";
            }
            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 generateDataGear {
    my ($filename) = @_;
    my $fn1 = $filename;
    $fn1 =~ s/\.cbc/.c/;
    open my $in,"<",$filename or die("can't open $filename $!");
    my $i = 1;
    my $fn = $fn1;
    while ( -f $fn) {
        $fn = "$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;
            } elsif (/^\_\_code (\w+)/) {
                $codeGearName = $1;
                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{$codeGearName});
                }
                $prevCodeGearName = $codeGearName;
            } elsif (/^(.*)goto next\(\.\.\.(.*)\);/) {
                my $prev = $1;
                my $args = $2;
                print $fd "${prev}goto meta(context, next);\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