#!/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