GearsTemplate: src/parallel_execution/generate

annotate src/parallel_execution/generate_stub.pl @ 388:8940d1451a0d

handle local continuation

author	masataka
date	Sat, 29 Jul 2017 19:08:25 +0900
parents	590f03af1a2c
children	d9a7620a1106

rev	line source
194 081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	1 #!/usr/bin/perl
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	2
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	3 use strict;
254 edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	4 use Getopt::Std;
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	5
194 081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	6 # interface.cbc
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	7 # typedef struct Worker {
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	8 # int id;
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	9 # struct Context* contexts;
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	10 # enum Code execute;
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	11 # enum Code taskSend;
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	12 # enum Code taskRecive;
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	13 # enum Code shutdown;
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	14 # struct Queue* tasks;
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	15 # } Worker;
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	16
255 79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	17 our($opt_o,$opt_d,$opt_h);
79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	18 getopts('o:d:h');
79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	19
79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	20 my $dir = ".";
79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	21 if ($opt_d) {
79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	22 $dir = $opt_d;
79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	23 if (! -d $dir) {
79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	24 mkdir $dir;
79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	25 }
79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	26 }
254 edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	27
edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	28 for my $fn (@ARGV) {
255 79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	29 next if ($fn !~ /\.cbc$/);
249 afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	30 &getDataGear($fn);
afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	31 &generateDataGear($fn);
194 081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	32 }
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	33
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	34 my %var;
8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	35 my %code;
8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	36 my %dataGearVar;
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	37 my %outputVar; # output var initializer
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	38 my %outputArgs; # continuation's output variables
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	39 my %dataGear;
8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	40 my %dataGearName;
384 ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	41 my %generic;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	42 my %dataGearVarType;
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	43 my $implementation;
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	44 my $interface;
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	45
384 ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	46 # interface definision
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	47 #
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	48 # typedef struct Stack<Type, Impl>{
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	49 # Type* stack;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	50 # Type* data;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	51 # Type* data1;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	52 # __code whenEmpty(...);
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	53 # __code clear(Impl* stack,__code next(...));
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	54 # __code push(Impl* stack,Type* data, __code next(...));
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	55 # __code pop(Impl* stack, __code next(Type*, ...));
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	56 # __code pop2(Impl* stack, Type data, Type data1, __code next(Type, Type, ...));
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	57 # __code isEmpty(Impl* stack, __code next(...), __code whenEmpty(...));
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	58 # __code get(Impl* stack, Type** data, __code next(...));
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	59 # __code get2(Impl* stack,..., __code next(...));
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	60 # __code next(...);
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	61 # } Stack;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	62 #
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	63 # calling example
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	64 #
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	65 # goto nodeStack->push((union Data*)node, stackTest3);
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	66 #
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	67 # generated meta level code
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	68 #
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	69 # Gearef(context, Stack)->stack = nodeStack->stack;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	70 # Gearef(context, Stack)->data = (union Data*)node;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	71 # Gearef(context, Stack)->next = C_stackTest3;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	72 # goto meta(context, nodeStack->push);
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	73
194 081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	74 sub getDataGear {
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	75 my ($filename) = @_;
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	76 my ($codeGearName, $name, $inTypedef);
194 081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	77 open my $fd,"<",$filename or die("can't open $filename $!");
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	78 while (<$fd>) {
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	79 if (! $inTypedef) {
384 ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	80 if (/^typedef struct (\w+)\s<(.)>/) {
194 081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	81 $inTypedef = 1;
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	82 $name = $1;
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	83 $dataGear{$name} = $_;
259 195518ab62fc fix type gathering pattern match in generate_stub.pl Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 255 diff changeset	84 $var{$name} = {};
195518ab62fc fix type gathering pattern match in generate_stub.pl Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 255 diff changeset	85 $code{$name} = {};
384 ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	86 $generic{$name} = \split(/,/,$2);
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	87 } elsif (/^typedef struct (\w+)/) {
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	88 $inTypedef = 1;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	89 $name = $1;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	90 $dataGear{$name} = $_;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	91 $var{$name} = {};
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	92 $code{$name} = {};
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	93 $generic{$name} = [];
269 5170539348ec rename TaskManagerImpl.cbc mir3636 parents: 268 diff changeset	94 } elsif (/^(\w+)(\*)+ create(\w+)\(/) {
249 afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	95 if (defined $interface) {
afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	96 die "duplicate interface $interface\n";
afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	97 }
afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	98 $interface = $1;
269 5170539348ec rename TaskManagerImpl.cbc mir3636 parents: 268 diff changeset	99 $implementation = $3;
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	100 if ( -f "$interface.cbc") {
8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	101 &getDataGear("$interface.cbc");
8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	102 }
385 c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	103 } elsif (/^(\s)(\w+)\-\>(\w+)\s\=\s$(.)$create(\w+)$(\w+)$;$/) {
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	104 #my $intfn = ucfirst($2);
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	105 my $impln = $5;
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	106 if ( -f "$impln.cbc") {
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	107 &getCodeGear("$impln.cbc");
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	108 }
226 68c03e7057d9 get arg mir3636 parents: 201 diff changeset	109 }
194 081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	110 next;
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	111 }
249 afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	112 # gather type name and type
194 081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	113 $dataGear{$name} .= $_;
385 c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	114 if (/^\s(.)\s+(\w+);$/ ) {
280 2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	115 my $ttype = $1;
2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	116 my $tname = $2;
2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	117 if ($ttype =~ /^(union\|struct) (\w+)/) {
2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	118 $ttype = $2;
2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	119 }
2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	120 $var{$name}->{$tname} = $ttype;
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	121 }
194 081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	122 if (/^}/) {
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	123 $inTypedef = 0;
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	124 }
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	125 }
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	126 }
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	127
385 c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	128 sub getCodeGear {
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	129 my ($filename) = @_;
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	130 open my $fd,"<",$filename or die("can't open $filename $!");
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	131 my ($name,$impln);
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	132 while (<$fd>) {
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	133 if (/^(\w+)(\*)+ create(\w+)\(/) {
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	134 $name = $1;
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	135 $impln = $3;
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	136 }
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	137 if (defined $name) {
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	138 if (/^\_\_code (\w+)$impln$(.)$(.)/) {
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	139 my $args = $2;
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	140 my $method = $1;
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	141 $code{$name}->{$method} = [];
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	142 while($args) {
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	143 if ($args =~ s/(^\s,\s)//) {
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	144 }
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	145 # continuation case
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	146 if ($args =~ s/^(\s)\_\_code\s+(\w+)$([^)])$//) {
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	147 my $next = $2;
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	148 my @args = split(/,/,$3);
387 590f03af1a2c fix getCodeGear mir3636 parents: 385 diff changeset	149 push(@{$code{$name}->{$method}},"\_\_code $next");
385 c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	150 } elsif ($args =~ s/^(struct\|union) (\w+)(\*)+\s(\w+)//) {
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	151 my $structType = $1;
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	152 my $typeName = $2;
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	153 my $varName = $4;
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	154 my $typeField = lcfirst($typeName);
387 590f03af1a2c fix getCodeGear mir3636 parents: 385 diff changeset	155 push(@{$code{$name}->{$method}},"$typeName $varName");
385 c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	156 } elsif ($args =~ s/(.*,)//) {
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	157 } else {
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	158 last;
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	159 }
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	160 }
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	161 }
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	162 }
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	163 }
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	164 }
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	165
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	166 sub generateStub {
251 0ab52d6e2fd9 fix sub generateStub mir3636 parents: 250 diff changeset	167 my($fd,$prevCodeGearName,$dataGearName) = @_;
274 d14eb393023d fix generate_stub mir3636 parents: 269 diff changeset	168 print $fd "__code ", $prevCodeGearName ,"_stub(struct Context* context) {\n";
251 0ab52d6e2fd9 fix sub generateStub mir3636 parents: 250 diff changeset	169 print $fd $dataGearName;
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	170 print $fd "\n} \n\n";
251 0ab52d6e2fd9 fix sub generateStub mir3636 parents: 250 diff changeset	171 return 1;
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	172 }
8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	173
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	174 sub generateStubArgs {
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	175 my($codeGearName, $varName, $typeName, $typeField, $interface,$output) = @_;
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	176 my $varname1 = $output?"O_$varName":$varName;
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	177 for my $n ( @{$dataGearVar{$codeGearName}} ) {
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	178 # we already have it
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	179 return 0 if ( $n eq $varname1);
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	180 }
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	181 push @{$dataGearVar{$codeGearName}}, $varname1;
384 ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	182 push @{$dataGearVarType{$codeGearName}}, $typeName;
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	183 if ($typeName eq $implementation) {
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	184 # get implementation
258 4fe19a06d666 generate next args mir3636 parents: 255 diff changeset	185 $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $interface, $varName);\n";
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	186 } else {
259 195518ab62fc fix type gathering pattern match in generate_stub.pl Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 255 diff changeset	187 for my $ivar (keys %{$var{$interface}}) {
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	188 # input data gear field
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	189 if ($varName eq $ivar) {
280 2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	190 if ($typeName eq $var{$interface}->{$ivar}) {
2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	191 if ($output) {
2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	192 $dataGearName{$codeGearName} .= "\t$typeName** O_$varName = &Gearef(context, $interface)->$varName;\n";
2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	193 $outputVar{$codeGearName} .= "\t$typeName* $varName;\n";
2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	194 return 1;
2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	195 }
2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	196
2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	197 $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $interface)->$varName;\n";
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	198 return 1;
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	199 }
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	200 }
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	201 }
259 195518ab62fc fix type gathering pattern match in generate_stub.pl Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 255 diff changeset	202 for my $cName (keys %{$code{$interface}}) {
195518ab62fc fix type gathering pattern match in generate_stub.pl Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 255 diff changeset	203 if ($varName eq $cName) {
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	204 # continuation field
259 195518ab62fc fix type gathering pattern match in generate_stub.pl Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 255 diff changeset	205 $dataGearName{$codeGearName} .= "\tenum Code $varName = Gearef(context, $interface)->$varName;\n";
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	206 return 1;
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	207 }
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	208 }
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	209 # global variable case
268 378ce6f74f4b fix generate_stub mir3636 parents: 262 diff changeset	210 $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $typeName);\n";
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	211 return 1;
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	212 }
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	213 }
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	214
194 081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	215 sub generateDataGear {
249 afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	216 my ($filename) = @_;
afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	217 open my $in,"<",$filename or die("can't open $filename $!");
254 edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	218
edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	219 my $fn;
edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	220 if ($opt_o) {
edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	221 $fn = $opt_o;
edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	222 } else {
edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	223 my $fn1 = $filename;
edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	224 $fn1 =~ s/\.cbc/.c/;
edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	225 my $i = 1;
255 79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	226 $fn = "$dir/$fn1";
254 edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	227 while ( -f $fn) {
255 79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	228 $fn = "$dir/$fn1.$i";
254 edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	229 $i++;
edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	230 }
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	231 }
259 195518ab62fc fix type gathering pattern match in generate_stub.pl Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 255 diff changeset	232 if ( $fn =~ m=(.*)/[^/]+$= ) {
195518ab62fc fix type gathering pattern match in generate_stub.pl Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 255 diff changeset	233 if (! -d $1) {
195518ab62fc fix type gathering pattern match in generate_stub.pl Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 255 diff changeset	234 mkdir $1;
195518ab62fc fix type gathering pattern match in generate_stub.pl Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 255 diff changeset	235 }
195518ab62fc fix type gathering pattern match in generate_stub.pl Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 255 diff changeset	236 }
249 afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	237 open my $fd,">",$fn or die("can't write $fn $!");
254 edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	238
249 afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	239 my $prevCodeGearName;
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	240 my $inTypedef = 0;
278 23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	241 my $inStub = 0;
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	242 my %stub;
251 0ab52d6e2fd9 fix sub generateStub mir3636 parents: 250 diff changeset	243 my $codeGearName;
254 edb3aff688d0 fix generator CLI Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 253 diff changeset	244
249 afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	245 while (<$in>) {
278 23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	246 if (! $inTypedef && ! $inStub) {
249 afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	247 if (/^typedef struct (\w+) {/) {
afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	248 $inTypedef = 1;
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	249 } elsif (/^\_\_code (\w+)$(.)$(.)/) {
251 0ab52d6e2fd9 fix sub generateStub mir3636 parents: 250 diff changeset	250 $codeGearName = $1;
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	251 my $args = $2;
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	252 my $tail = $3;
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	253 if ($codeGearName =~ /_stub$/) {
262 2c56a9536c0d add comments Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 261 diff changeset	254 # don't touch already existing stub
278 23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	255 $inStub = 1;
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	256 $stub{$codeGearName} = 1;
8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	257 print $fd $_;
8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	258 next;
8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	259 }
249 afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	260 if (defined $prevCodeGearName) {
262 2c56a9536c0d add comments Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 261 diff changeset	261 # stub is generated just before next CodeGear
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	262 if (defined $stub{$prevCodeGearName."_stub"}) {
8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	263 undef $prevCodeGearName;
278 23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	264 } else {
23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	265 &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName});
23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	266 $stub{$prevCodeGearName."_stub"} = 1;
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	267 }
249 afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	268 }
262 2c56a9536c0d add comments Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 261 diff changeset	269 # analyzing CodeGear argument
2c56a9536c0d add comments Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 261 diff changeset	270 # these arguments are extract from current context's arugment DataGear Interface
2c56a9536c0d add comments Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 261 diff changeset	271 # and passed to the CodeGear
2c56a9536c0d add comments Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 261 diff changeset	272 # struct Implementaion needs special handling
2c56a9536c0d add comments Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 261 diff changeset	273 # __code next(...) ---> enum Code next
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	274 $prevCodeGearName = $codeGearName;
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	275 $dataGearVar{$codeGearName} = [];
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	276 $outputVar{$codeGearName} = "";
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	277 $outputArgs{$codeGearName} = {};
259 195518ab62fc fix type gathering pattern match in generate_stub.pl Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 255 diff changeset	278 my $newArgs = "struct Context *context,";
305 ec0a5b4fba05 CUDAWorker Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 280 diff changeset	279 if ($args=~/^struct Context\s\\s*context/) {
ec0a5b4fba05 CUDAWorker Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 280 diff changeset	280 $newArgs = "";
ec0a5b4fba05 CUDAWorker Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 280 diff changeset	281 }
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	282 while($args) {
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	283 if ($args =~ s/(^\s,\s)//) {
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	284 $newArgs .= $1;
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	285 }
262 2c56a9536c0d add comments Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 261 diff changeset	286 # continuation case
280 2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	287 if ($args =~ s/^(\s)\_\_code\s+(\w+)$([^)])$//) {
2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	288 my $next = $2;
2c2e4e597eb0 generate no compile errors mir3636 parents: 278 diff changeset	289 my @args = split(/,/,$3);
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	290 if ( &generateStubArgs($codeGearName, $next, "Code", $next, $interface,0) ) {
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	291 $newArgs .= "enum Code $next";
258 4fe19a06d666 generate next args mir3636 parents: 255 diff changeset	292 }
262 2c56a9536c0d add comments Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 261 diff changeset	293 # analyze continuation arguments
2c56a9536c0d add comments Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 261 diff changeset	294 # output arguments are defined in the Interface take the pointer of these
2c56a9536c0d add comments Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 261 diff changeset	295 # output arguments are put into the Interface DataGear just before the goto
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	296 for my $arg (@args) {
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	297 $arg =~ s/^\s*//;
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	298 last if ($arg =~ /\.\.\./);
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	299 $arg =~ s/^(struct\|union) (\w+)(\*)+\s(\w+)//;
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	300 my $structType = $1;
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	301 my $typeName = $2;
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	302 my $varName = $4;
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	303 my $typeField = lcfirst($typeName);
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	304 push(@{$outputArgs{$codeGearName}->{$next}}, $varName);
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	305 if (&generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface,1)) {
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	306 $newArgs .= ",$structType $typeName **O_$varName";
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	307 }
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	308 }
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	309 } elsif ($args =~ s/^(struct\|union) (\w+)(\*)+\s(\w+)//) {
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	310 my $structType = $1;
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	311 my $typeName = $2;
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	312 my $varName = $4;
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	313 my $typeField = lcfirst($typeName);
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	314 $newArgs .= $&; # assuming no duplicate
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	315 &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface,0);
255 79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	316 } elsif ($args =~ s/(.*,)//) {
79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	317 $newArgs .= $1;
79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	318 } else {
79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	319 $newArgs .= $args;
79bbe2c63fb0 cmake generate c from cbc mir3636 parents: 254 diff changeset	320 last;
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	321 }
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	322 }
262 2c56a9536c0d add comments Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 261 diff changeset	323 # generate goto statement from stub to the CodeGear in the buffer
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	324 $dataGearName{$codeGearName} .= "\tgoto $codeGearName(context";
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	325 for my $arg ( @{$dataGearVar{$codeGearName}}) {
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	326 $dataGearName{$codeGearName} .= ", $arg";
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	327 }
ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	328 $dataGearName{$codeGearName} .= ");";
262 2c56a9536c0d add comments Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 261 diff changeset	329 # generate CodeGear header with new arguments
253 ebc13549394c generate stubArgs mir3636 parents: 252 diff changeset	330 print $fd "__code $codeGearName($newArgs)$tail\n";
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	331 if ($outputVar{$codeGearName} ne "") {
324 d9887056ae5b Update Todo and Add comment to perl script one parents: 305 diff changeset	332 # output data var can be use before write
d9887056ae5b Update Todo and Add comment to perl script one parents: 305 diff changeset	333 # it should be initialze by gearef
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	334 print $fd $outputVar{$codeGearName};
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	335 }
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	336 next;
384 ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	337 } elsif (/^(.)goto (\w+)\-\>(\w+)$(.)$;/) {
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	338 # handling goto statement
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	339 # convert it to the meta call form with two arugments, that is context and enum Code
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	340 my $prev = $1;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	341 my $next = $2;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	342 my $method = $3;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	343 my @args = split(/,/,$4);
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	344 my @types = @{$dataGearVarType{$codeGearName}};
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	345 my $ntype;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	346 for my $v (@{$dataGearVar{$codeGearName}}) {
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	347 my $t = shift @types;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	348 if ($v eq $next) {
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	349 $ntype = $t;
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	350 }
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	351 }
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	352 print $fd "\tGearef(context, $ntype)->$next = $next->$next;\n";
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	353 # Put interface argument
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	354 my $prot = $code{$ntype}->{$method};
385 c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	355 my $i = 1;
384 ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	356 for my $arg (@args) {
385 c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	357 my $p = @$prot[$i];
c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	358 next if ( $p eq $arg);
387 590f03af1a2c fix getCodeGear mir3636 parents: 385 diff changeset	359 $p =~ s/^(.*)\s(\w+)//;
590f03af1a2c fix getCodeGear mir3636 parents: 385 diff changeset	360 my $pType = $1;
590f03af1a2c fix getCodeGear mir3636 parents: 385 diff changeset	361 my $pName = $2;
590f03af1a2c fix getCodeGear mir3636 parents: 385 diff changeset	362 $arg =~ s/^(\s)*(\w+)/$2/;
590f03af1a2c fix getCodeGear mir3636 parents: 385 diff changeset	363 if ($pType =~ s/\_\_code$//) {
590f03af1a2c fix getCodeGear mir3636 parents: 385 diff changeset	364 print $fd "\tGearef(context, $ntype)->$pName = C_$arg;\n";
590f03af1a2c fix getCodeGear mir3636 parents: 385 diff changeset	365 } else {
590f03af1a2c fix getCodeGear mir3636 parents: 385 diff changeset	366 print $fd "\tGearef(context, $ntype)->$pName = $arg;\n";
590f03af1a2c fix getCodeGear mir3636 parents: 385 diff changeset	367 }
385 c1512f358c37 add getCodeGear to generate_stub.pl mir3636 parents: 384 diff changeset	368 $i++;
384 ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	369 }
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	370 print $fd "${prev}goto meta(context, $next->$next->$ntype.$method);\n";
ee5d2b1685d7 Fix perlscript Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> parents: 383 diff changeset	371 next;
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	372 } elsif (/^(.)goto (\w+)$(.)$;/) {
278 23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	373 # handling goto statement
262 2c56a9536c0d add comments Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 261 diff changeset	374 # convert it to the meta call form with two arugments, that is context and enum Code
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	375 my $prev = $1;
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	376 my $next = $2;
6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	377 my @args = split(/,/,$3);
388 8940d1451a0d handle local continuation masataka parents: 387 diff changeset	378 my $v = 0;
8940d1451a0d handle local continuation masataka parents: 387 diff changeset	379 for my $n ( @{$dataGearVar{$codeGearName}} ) {
8940d1451a0d handle local continuation masataka parents: 387 diff changeset	380 # continuation arguments
8940d1451a0d handle local continuation masataka parents: 387 diff changeset	381 $v = 1 if ( $n eq $next);
8940d1451a0d handle local continuation masataka parents: 387 diff changeset	382 }
8940d1451a0d handle local continuation masataka parents: 387 diff changeset	383 if ($v \|\| defined $code{$interface}->{$next}) {
278 23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	384 # write continuation's arguments into the interface arguments
23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	385 # we may need a commit for a shared DataGear
23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	386 for my $arg ( @{$outputArgs{$codeGearName}->{$next}} ) {
23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	387 my $v = shift(@args);
23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	388 print $fd "\t*O_$arg = $v;\n";
23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	389 }
23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	390 print $fd "${prev}goto meta(context, $next);\n";
23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	391 next;
260 6b5444bbea8a generated stub no comiple errors Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 259 diff changeset	392 }
259 195518ab62fc fix type gathering pattern match in generate_stub.pl Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 255 diff changeset	393 } else {
195518ab62fc fix type gathering pattern match in generate_stub.pl Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 255 diff changeset	394 s/new\s+(\w+)/\&ALLOCATE(context, \1)->\1/g; # replacing new
249 afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	395 }
afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	396 # gather type name and type
259 195518ab62fc fix type gathering pattern match in generate_stub.pl Shinji KONO <kono@ie.u-ryukyu.ac.jp> parents: 255 diff changeset	397 } elsif (/^}/) {
278 23767f714f4a fix generate_stub mir3636 parents: 274 diff changeset	398 $inStub = 0;
249 afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	399 $inTypedef = 0;
afa1e02e4386 fix generate stub mir3636 parents: 243 diff changeset	400 }
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	401 print $fd $_;
194 081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	402 }
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	403 if (defined $prevCodeGearName) {
8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	404 if (!defined $stub{$prevCodeGearName."_stub"}) {
251 0ab52d6e2fd9 fix sub generateStub mir3636 parents: 250 diff changeset	405 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName});
250 8a8963ce9858 fix generate_stub mir3636 parents: 249 diff changeset	406 }
228 55260ff44c8c generate stub mir3636 parents: 226 diff changeset	407 }
194 081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	408 }
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	409
081607dcf893 create generate_stub.pl mir3636 parents: diff changeset	410 # end

Mercurial > hg > GearsTemplate

annotate src/parallel_execution/generate_stub.pl @ 388:8940d1451a0d