Mercurial > hg > Members > Moririn
annotate src/parallel_execution/generate_stub.pl @ 259:195518ab62fc
fix type gathering pattern match in generate_stub.pl
| author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
|---|---|
| date | Sat, 28 Jan 2017 12:37:22 +0900 |
| parents | 79bbe2c63fb0 |
| children | 6b5444bbea8a |
| rev | line source |
|---|---|
| 194 | 1 #!/usr/bin/perl |
| 2 | |
| 250 | 3 use strict; |
| 254 | 4 use Getopt::Std; |
| 250 | 5 |
| 194 | 6 # interface.cbc |
| 7 # typedef struct Worker { | |
| 8 # int id; | |
| 9 # struct Context* contexts; | |
| 10 # enum Code execute; | |
| 11 # enum Code taskSend; | |
| 12 # enum Code taskRecive; | |
| 13 # enum Code shutdown; | |
| 14 # struct Queue* tasks; | |
| 15 # } Worker; | |
| 16 | |
| 255 | 17 our($opt_o,$opt_d,$opt_h); |
| 18 getopts('o:d:h'); | |
| 19 | |
| 20 my $dir = "."; | |
| 21 if ($opt_d) { | |
| 22 $dir = $opt_d; | |
| 23 if (! -d $dir) { | |
| 24 mkdir $dir; | |
| 25 } | |
| 26 } | |
| 254 | 27 |
| 28 for my $fn (@ARGV) { | |
| 255 | 29 next if ($fn !~ /\.cbc$/); |
| 249 | 30 &getDataGear($fn); |
| 31 &generateDataGear($fn); | |
| 194 | 32 } |
| 33 | |
| 250 | 34 my %var; |
| 35 my %code; | |
| 36 my %dataGearVar; | |
| 37 my %dataGear; | |
| 38 my %dataGearName; | |
| 253 | 39 my $implementation; |
| 40 my $interface; | |
| 250 | 41 |
| 194 | 42 sub getDataGear { |
| 43 my ($filename) = @_; | |
| 253 | 44 my ($codeGearName, $name, $inTypedef); |
| 194 | 45 open my $fd,"<",$filename or die("can't open $filename $!"); |
| 46 while (<$fd>) { | |
| 47 if (! $inTypedef) { | |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
48 if (/^typedef struct (\w+)/) { |
| 194 | 49 $inTypedef = 1; |
| 50 $name = $1; | |
| 51 $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
|
52 $var{$name} = {}; |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
53 $code{$name} = {}; |
| 249 | 54 } elsif (/^(\w+)\* create(\w+)\(/) { |
| 55 if (defined $interface) { | |
| 56 die "duplicate interface $interface\n"; | |
| 57 } | |
| 58 $interface = $1; | |
| 250 | 59 $implementation = $2; |
| 60 if ( -f "$interface.cbc") { | |
| 61 &getDataGear("$interface.cbc"); | |
| 62 } | |
| 226 | 63 } |
| 194 | 64 next; |
| 65 } | |
| 249 | 66 # gather type name and type |
| 194 | 67 $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
|
68 if (/^\s*(.*)\s+(\w+);$/ ) { |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
69 $var{$name}->{$2} = $1; |
| 250 | 70 } elsif (/\_\_code (\w+)\(/) { |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
71 $code{$name}->{$1} = 1; |
| 250 | 72 } |
| 194 | 73 if (/^}/) { |
| 74 $inTypedef = 0; | |
| 75 } | |
| 76 } | |
| 77 } | |
| 78 | |
| 250 | 79 sub generateStub { |
| 251 | 80 my($fd,$prevCodeGearName,$dataGearName) = @_; |
| 250 | 81 print $fd "__code ", $prevCodeGearName ,"_stub (struct Context* context) {\n"; |
| 251 | 82 print $fd $dataGearName; |
| 250 | 83 print $fd "\n} \n\n"; |
| 251 | 84 return 1; |
| 250 | 85 } |
| 86 | |
| 253 | 87 sub generateStubArgs { |
| 88 my($codeGearName, $varName, $typeName, $typeField, $interface) = @_; | |
| 89 push @{$dataGearVar{$codeGearName}},$varName; | |
| 90 if ($typeField ne $varName) { | |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
91 $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $interface, $varName);\n"; |
| 253 | 92 } else { |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
93 for my $ivar (keys %{$var{$interface}}) { |
| 253 | 94 if ($varName eq $ivar) { |
| 95 $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $interface)->$varName;\n"; | |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
96 return; |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
97 } |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
98 } |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
99 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
|
100 if ($varName eq $cName) { |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
101 $dataGearName{$codeGearName} .= "\tenum Code $varName = Gearef(context, $interface)->$varName;\n"; |
| 253 | 102 return; |
| 103 } | |
| 104 } | |
| 105 $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $typeName)->$typeField;\n"; | |
| 106 } | |
| 107 } | |
| 108 | |
| 194 | 109 sub generateDataGear { |
| 249 | 110 my ($filename) = @_; |
| 111 open my $in,"<",$filename or die("can't open $filename $!"); | |
| 254 | 112 |
| 113 my $fn; | |
| 114 if ($opt_o) { | |
| 115 $fn = $opt_o; | |
| 116 } else { | |
| 117 my $fn1 = $filename; | |
| 118 $fn1 =~ s/\.cbc/.c/; | |
| 119 my $i = 1; | |
| 255 | 120 $fn = "$dir/$fn1"; |
| 254 | 121 while ( -f $fn) { |
| 255 | 122 $fn = "$dir/$fn1.$i"; |
| 254 | 123 $i++; |
| 124 } | |
| 250 | 125 } |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
126 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
|
127 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
|
128 mkdir $1; |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
129 } |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
130 } |
| 249 | 131 open my $fd,">",$fn or die("can't write $fn $!"); |
| 254 | 132 |
| 249 | 133 my $prevCodeGearName; |
| 250 | 134 my $inTypedef = 0; |
| 135 my %stub; | |
| 251 | 136 my $codeGearName; |
| 254 | 137 |
| 249 | 138 while (<$in>) { |
| 139 if (! $inTypedef) { | |
| 140 if (/^typedef struct (\w+) {/) { | |
| 141 $inTypedef = 1; | |
| 253 | 142 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { |
| 251 | 143 $codeGearName = $1; |
| 253 | 144 my $args = $2; |
| 145 my $tail = $3; | |
| 250 | 146 if ($codeGearName =~ /_stub$/) { |
| 147 $stub{$codeGearName} = 1; | |
| 148 print $fd $_; | |
| 149 next; | |
| 150 } | |
| 249 | 151 if (defined $prevCodeGearName) { |
| 250 | 152 if (defined $stub{$prevCodeGearName."_stub"}) { |
| 153 undef $prevCodeGearName; | |
| 154 print $fd $_; | |
| 155 next; | |
| 156 } | |
| 253 | 157 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName}); |
| 249 | 158 } |
| 253 | 159 $prevCodeGearName = $codeGearName; |
| 160 $dataGearVar{$codeGearName} = []; | |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
161 my $newArgs = "struct Context *context,"; |
| 253 | 162 while($args) { |
| 163 if ($args =~ s/(^\s*,\s*)//) { | |
| 164 $newArgs .= $1; | |
| 165 } | |
| 166 # replace __code next | |
| 167 if ($args =~ s/^\_\_code\s(\w+)\([^)]*\)//) { | |
| 168 my $next = $1; | |
| 169 my @args = split(/,/,$2); | |
| 170 $newArgs .= "enum Code $next"; | |
| 171 for my $arg (@args) { | |
| 172 $arg =~ s/^\s*//; | |
| 173 $arg =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//; | |
| 174 my $structType = $1; | |
| 175 my $typeName = $2; | |
| 176 my $varName = $4; | |
| 177 my $typeField = lcfirst($typeName); | |
| 178 &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface); | |
| 179 } | |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
180 &generateStubArgs($codeGearName, $next, "Code", $next, $interface); |
| 253 | 181 } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) { |
| 182 my $structType = $1; | |
| 183 my $typeName = $2; | |
| 184 my $varName = $4; | |
| 185 my $typeField = lcfirst($typeName); | |
| 186 $newArgs .= $&; | |
| 187 &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface); | |
| 255 | 188 } elsif ($args =~ s/(.*,)//) { |
| 189 $newArgs .= $1; | |
| 190 } else { | |
| 191 $newArgs .= $args; | |
| 192 last; | |
| 253 | 193 } |
| 194 } | |
| 195 $dataGearName{$codeGearName} .= "\tgoto $codeGearName(context"; | |
| 196 for my $arg ( @{$dataGearVar{$codeGearName}}) { | |
| 197 $dataGearName{$codeGearName} .= ", $arg"; | |
| 198 } | |
| 199 $dataGearName{$codeGearName} .= ");"; | |
| 200 print $fd "__code $codeGearName($newArgs)$tail\n"; | |
| 201 next; | |
| 250 | 202 } elsif (/^(.*)goto next\(\.\.\.(.*)\);/) { |
| 203 my $prev = $1; | |
| 204 my $args = $2; | |
| 205 print $fd "${prev}goto meta(context, next);\n"; | |
| 206 next; | |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
207 } else { |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
208 s/new\s+(\w+)\(\)/\&ALLOCATE(context, \1)->\1/g; # replacing new |
| 249 | 209 } |
| 210 # 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
|
211 } elsif (/^}/) { |
| 249 | 212 $inTypedef = 0; |
| 213 } | |
| 250 | 214 print $fd $_; |
| 194 | 215 } |
| 250 | 216 if (defined $prevCodeGearName) { |
| 217 if (!defined $stub{$prevCodeGearName."_stub"}) { | |
| 251 | 218 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName}); |
| 250 | 219 } |
| 228 | 220 } |
| 194 | 221 } |
| 222 | |
| 223 # end |