view src/parallel_execution/generate_stub.pl @ 249:afa1e02e4386

fix generate stub
author mir3636
date Wed, 25 Jan 2017 18:41:50 +0900
parents 6a80ab36181c
children 8a8963ce9858
line wrap: on
line source

#!/usr/bin/perl

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

system "rm -rf d";
system "mkdir d";

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

sub getDataGear {
    my ($filename) = @_;
    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;
                $implimentation = $2;
            } elsif (/^\_\_code (\w+)/) {
                $codeGearName = $1;
                $dataGearVar{$codeGearName} = [];
                while (/(struct|union) (\w+)\*\s(\w+)/g) {
                    $tmp = lcfirst($2);
                    if ($tmp ne $3) {
                        $tmp = ucfirst($3);
                        push @$dataGearVar{$codeGearName},$tmp; 
                        $dataGearName{$codeGearName} .= "\t$2* $tmp = (" . $2 . "*)GearImpl(context, " . $tmp . ", " . $3 . ")";
                        $dataGearName{$codeGearName} .= ",\n";
                    } else {
                        push @$dataGearVar{$codeGearName},$3; 
                        $dataGearName{$codeGearName} .= "\t$2* $3 = Gearef(context, " . $2 . ")->$3;\n";
                    }
                }
            }
            next;
        }
        # gather type name and type
        $dataGear{$name} .= $_;
	if (/(\w+);$/ and !/^} (\w+)/) {
	    $tmp = $1 . "\n";
	    if (/{/) {
	            $tmp = "{" . $';
	            $tmp =~ s/;$//;
	    }
	    $var{$name} .= $tmp;
	    $tmp = $`;
	    $tmp =~ s/^\s*//;
	    $type{$name} .= $tmp . "\n";
	}
        if (/^}/) {
            $inTypedef = 0;
        }
    }
}

sub generateDataGear {
    my ($filename) = @_;
    my $fn = $filename;
    $fn =~ s/\.cbc/.c/;
    open my $in,"<",$filename or die("can't open $filename $!");
    open my $fd,">",$fn or die("can't write $fn $!");
    my $prevCodeGearName;
    while (<$in>) {
        if (! $inTypedef) {
            if (/^typedef struct (\w+) {/) {
                $inTypedef = 1;
            } elsif (/^\_\_code (\w+)/) {
                my $codeGearName = $1;
                if (defined $prevCodeGearName) {
                    print $fd "__code ", $prevCodeGearName ,"_stub (struct Context* context) {\n";
    	            print $fd "\tgoto " . $prevcodeGearName . "(";
                    #print $fd "\tgoto " . $prevcodeGearName . "(context,\n";
                    print $fd substr($dataGearName{$codeGearName},2,-2);
                    print $fd "); \n} \n\n";
                }
                $prevCodeGearName = $codeGearName;
                while (s/\_\_code next\(\.\.\.([^)]*)/enum Code next/) {
                }
                while (/(struct|union) (\w+)\*\s(\w+)/g) {
                    my $tmp = lcfirst($2);
                    if ($tmp ne $3) {
                        $tmp = ucfirst($3);
                    } else {
                    }
                }
            }
            next;
        }
        # gather type name and type
        if (/^}/) {
            $inTypedef = 0;
        }
    }
#    open my $fd,">","d/extern.h" or die("can't open d/extern.h $!");
#    for my $name ( sort keys %dataGear ) {
#        print $fd $dataGear{$name},"\n";
#    }
#    print $fd "\n";
#
#    open my $fd,">","d/type.h" or die("can't open d/stub.h $!");
#    for my $name ( sort keys %dataGear ) {
#        print $fd $var{$name},"\n";
#    }
#    for my $name ( sort keys %dataGear ) {
#        print $fd $type{$name},"\n";
#    }
    
    for my $codeGearName ( sort keys %dataGearName ) {
        print $fd "__code ", $codeGearName ,"_stub (struct Context* context) {\n";
	print $fd "\tgoto " . $codeGearName . "(";
        #print $fd "\tgoto " . $codeGearName . "(context,\n";
        print $fd substr($dataGearName{$codeGearName},2,-2);
        print $fd "); \n} \n\n";
    }
    print $fd "\n";
}

# end