# HG changeset patch # User anatofuz # Date 1583474399 -32400 # Node ID 9a4279c88aa782082e3e9ca544684922323d9bdf # Parent 720e9c0936e0339e3ffe2723ae05c392d56c331e copy from xv6 repository diff -r 720e9c0936e0 -r 9a4279c88aa7 check_convert_context_struct.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/check_convert_context_struct.pl Fri Mar 06 14:59:59 2020 +0900 @@ -0,0 +1,16 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/lib"; +use Gears::Util; +use Gears::Context; + + +my $interface_file = shift or die "require itnerface file"; +my $h2context = Gears::Util->parse_interface($interface_file); +my $context = Gears::Context->h2context_str($h2context); + +print "$context"; + diff -r 720e9c0936e0 -r 9a4279c88aa7 gen_Stub.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gen_Stub.pl Fri Mar 06 14:59:59 2020 +0900 @@ -0,0 +1,19 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/lib"; +use Gears::Util; +use Gears::Stub; + +use Getopt::Std; +use File::Spec; + +use DDP {deparse => 1}; + +my $target_cbc_file = shift; +my $stubManager = Gears::Stub->new(file_name => File::Spec->rel2abs($target_cbc_file)); + +my $interface_w_impl = $stubManager->findInterfacewImpl(File::Spec->rel2abs($target_cbc_file)); + diff -r 720e9c0936e0 -r 9a4279c88aa7 generate_context.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/generate_context.pl Fri Mar 06 14:59:59 2020 +0900 @@ -0,0 +1,257 @@ +#!/usr/bin/perl + +use Getopt::Std; +use strict; + +# +# generrate Gears OS context heaader and initializer from CbC sources +# +# CodeGear +# +# get stub information from # *.c +# __code taskManager_stub(struct Context* cbc_context) { +# +# generate CodeGear indexn in context.h +# C_taskManager, +# +# generate CodeGear stub reference in context.h +# extern __code taskManager_stub(struct Context*); +# +# generate CodeGear stub reference in $name-context.h for each module +# cbc_context->code[C_taskManager] = taskManager_stub; +# +# DataGear +# +# get DataGear information from context.h +# struct Worker { +# int id; +# struct Context* contexts; +# enum Code execute; +# enum Code taskSend; +# enum Code taskRecive; +# enum Code shutdown; +# struct Queue* tasks; +# } Worker; +# +# generate typedefs and DataGear index in context.h +# typedef struct Worker Worker; +# D_Worker, +# +# generate DataGear allocator in context.h +# ALLOC_DATA(context, Worker); +# + +my $ddir = "c"; + +our($opt_o,$opt_d,$opt_h,$opt_w); +getopts('o:d:hw'); + +my $name = $opt_o?$opt_o:"gears"; + +if ($opt_d) { + $ddir = $opt_d; +} + +if ( ! -d $ddir) { + mkdir $ddir; +} + +if ($opt_h) { + print "$0 [-d distdir] [-h]\n"; + exit; +} + +my %codeGear; +my %dataGear; +my %constructor; + +{ + use FindBin; + use lib "$FindBin::Bin/lib"; + + use File::Spec; + use Cwd 'getcwd'; + + use Gears::Context; + use Getopt::Std; + + my $output = $opt_w ? "context.h" : "stdout"; + + use Data::Dumper; + my @cbc_files; + map { push(@cbc_files,File::Spec->rel2abs($_)); } @ARGV; + my $gears = Gears::Context->new(compile_sources => \@cbc_files, find_root => "$FindBin::Bin/../", output => $output); + my $data_gears = $gears->extraction_dg_compile_sources($gears->{compile_sources}); + my $g = $gears->set_data_gear_header_path(keys %{$data_gears->{impl}},keys %{$data_gears->{interfaces}}); + + my $dg2path = $gears->update_dg_each_header_path($data_gears,$g); + my $tree = $gears->createImplTree_from_header($dg2path); + $gears->tree2create_context_h($tree); +} + +# gather module Information for code table initialization +for (@ARGV) { + next if (/context.c/); + &getStubInfo($_); +} + +my (%mCodeGear) = (%codeGear); + +# anyway we gather all Gears Information +while (<*.c test/*.c>) { + next if (/context.c/); + &getStubInfo($_); +} + +&generateContext(); + +sub getStubInfo { + my ($filename) = @_; + open my $fd,"<",$filename or die("can't open $filename $!"); + while (<$fd>) { + if (/^__code (\w+)_stub\(struct *Context *\* *cbc_context\)/) { + $codeGear{$1} = $filename; + } elsif (/^(\w+)(\*)+ *create(\w+)\(([^]]*)\)/) { + my $interface = $1; + my $implementation = $3; + my $constructorArgs = $4; + $constructor{$implementation} = [$interface, $constructorArgs]; + } + } + + open my $cx,"<","context.h" or die("can't open context.h $!"); + my $inUnionData = 0; + while (<$cx>) { + if (! $inUnionData) { + if ( /^union Data/) { + $inUnionData = 1; + } + next; + } + last if (/union Data end/); + if (/struct (\w+) \{/) { + $dataGear{$1} = 'struct'; + } elsif (/^\s{4}(\w+) (\w+);/) { # primitive type + my $vtype = $1; + my $vname = $2; + if (exists $dataGear{$vname}) { + next; + } + $dataGear{$vtype} = 'primitive'; + } + $dataGear{"Context"} = "struct"; + } +} + +sub generateContext { + $codeGear{"start_code"} = "$ddir/$name-context.c"; + $codeGear{"exit_code"} = "$ddir/$name-context.c"; + $mCodeGear{"start_code"} = "$ddir/$name-context.c"; + $mCodeGear{"exit_code"} = "$ddir/$name-context.c"; + open my $fd,">","$ddir/extern.h" or die("can't open $ddir/extern.h $!"); + for my $code ( sort keys %codeGear ) { + print $fd "extern __code ${code}_stub(struct Context*);\n"; + } + for my $impl ( sort keys %constructor ) { + my ($interface, $constructorArgs) = @{$constructor{$impl}}; + print $fd "extern ${interface}* create${impl}($constructorArgs);\n"; + } + print $fd "\n"; + + open my $fd,">","$ddir/enumCode.h" or die("can't open $ddir/enumCode.h $!"); + print $fd "enum Code {\n"; + for my $code ( sort keys %codeGear ) { + print $fd " C_${code},\n"; + } + print $fd "};\n"; + + my $code_init = ''; + for my $code ( sort keys %mCodeGear ) { + $code_init .= " cbc_context->code[C_${code}] = ${code}_stub;\n"; + } + + my $data_num = keys(%dataGear); + $data_num++; +my $context_c = << "EOFEOF"; +#ifndef CBCXV6 +#include +#endif + +#include "../context.h" + +void initContext(struct Context* cbc_context) { + cbc_context->heapLimit = sizeof(union Data)*ALLOCATE_SIZE; + cbc_context->code = (__code(**) (struct Context*)) NEWN(ALLOCATE_SIZE, void*); + cbc_context->data = NEWN(ALLOCATE_SIZE, union Data*); + cbc_context->heapStart = NEWN(cbc_context->heapLimit, char); + cbc_context->heap = cbc_context->heapStart; + // cbc_context->codeNum = Exit; + +$code_init + +#include "dataGearInit.c" + cbc_context->dataNum = $data_num; +} +EOFEOF + + open my $fd,">","$ddir/$name-context.c" or die("can't open $ddir/$name-context.c $!"); + print $fd $context_c; + +my $meta_call = <<"EOFEOF"; +__code meta(struct Context* cbc_context, enum Code next) { + // printf("meta %d\\n",next); + goto (cbc_context->code[next])(cbc_context); +} + +__code parGotoMeta(struct Context* cbc_context, enum Code next) { + cbc_context->task = NULL; + cbc_context->taskList = NULL; + goto (cbc_context->code[Gearef(cbc_context, TaskManager)->taskManager->TaskManager.spawnTasks])(cbc_context); +} + +__code start_code(struct Context* cbc_context) { + goto meta(cbc_context, cbc_context->next); +} + +__code start_code_stub(struct Context* cbc_context) { + goto start_code(cbc_context); +} + +__code exit_code(struct Context* cbc_context) { + // free(cbc_context->code); + // free(cbc_context->data); + // free(cbc_context->heapStart); + goto exit_code(cbc_context); +} + +__code exit_code_stub(struct Context* cbc_context) { + goto exit_code(cbc_context); +} + +// end context_c +EOFEOF + +print $fd $meta_call; + +open my $fd,">","$ddir/enumData.h" or die("can't open $ddir/enumData.h $!"); +print $fd "enum DataType {\n"; +print $fd " D_Code,\n"; +for my $data ( sort keys %dataGear ) { + print $fd " D_${data},\n"; +} +print $fd "};\n\n"; + +open my $fd,">","$ddir/typedefData.h" or die("can't open $ddir/typedefData.h $!"); +for my $data ( sort keys %dataGear ) { + if ($dataGear{$data} eq 'struct') { + print $fd "typedef struct ${data} ${data};\n"; + } +} + +open my $fd,">","$ddir/dataGearInit.c" or die("can't open $ddir/dataGearInit.c $!"); +for my $data ( sort keys %dataGear ) { + print $fd " ALLOC_DATA(cbc_context, ${data});\n"; +} +} + +# end diff -r 720e9c0936e0 -r 9a4279c88aa7 generate_stub.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/generate_stub.pl Fri Mar 06 14:59:59 2020 +0900 @@ -0,0 +1,693 @@ +#!/usr/bin/perl + +use strict; +use Getopt::Std; +use File::Path qw(make_path); + +# interface.h +# typedef struct Worker { +# int id; +# struct Context* contexts; +# enum Code execute; +# enum Code taskSend; +# enum Code taskRecive; +# enum Code shutdown; +# struct Queue* tasks; +# } Worker; + +our($opt_o,$opt_d,$opt_h); +getopts('o:d:h'); + +my $dir = "."; +if ($opt_d) { + $dir = $opt_d; + if (! -d $dir) { + make_path $dir; + } +} + +for my $fn (@ARGV) { + next if ($fn !~ /\.cbc$/); + &getDataGear($fn); + &generateDataGear($fn); +} + +my %var; +my %code; +my %dataGearVar; +my %outputVar; # output var initializer +my %outputArgs; # continuation's output variables +my %dataGear; +my %dataGearName; +my %generic; +my %dataGearVarType; +my %codeGear; +my $implementation; +my $interface; + +# interface definision +# +# typedef struct Stack{ +# Type* stack; +# Type* data; +# Type* data1; +# __code whenEmpty(...); +# __code clear(Impl* stack,__code next(...)); +# __code push(Impl* stack,Type* data, __code next(...)); +# __code pop(Impl* stack, __code next(Type*, ...)); +# __code pop2(Impl* stack, Type** data, Type** data1, __code next(Type**, Type**, ...)); +# __code isEmpty(Impl* stack, __code next(...), __code whenEmpty(...)); +# __code get(Impl* stack, Type** data, __code next(...)); +# __code get2(Impl* stack,..., __code next(...)); +# __code next(...); +# } Stack; +# +# calling example +# +# goto nodeStack->push((union Data*)node, stackTest3); +# +# generated meta level code +# +# Gearef(cbc_context, Stack)->stack = (union Data*)nodeStack; +# Gearef(cbc_context, Stack)->data = (union Data*)node; +# Gearef(cbc_context, Stack)->next = C_stackTest3; +# goto meta(cbc_context, nodeStack->push); + +sub getDataGear { + my ($filename) = @_; + my ($codeGearName, $name, $inTypedef,$described_data_gear); + open my $fd,"<",$filename or die("can't open $filename $!"); + while (<$fd>) { + if (! $inTypedef) { + if (/^typedef struct (\w+)\s*<(.*)>/) { + $inTypedef = 1; + $name = $1; + $dataGear{$name} = $_; + $var{$name} = {}; + $code{$name} = {}; + $generic{$name} = \split(/,/,$2); + } elsif (/^typedef struct (\w+)/) { + $inTypedef = 1; + $name = $1; + $dataGear{$name} = $_; + $var{$name} = {}; + $code{$name} = {}; + $generic{$name} = []; + } elsif (/^(\w+)(\*)+ create(\w+)\(/) { + if (defined $interface) { + die "duplicate interface $interface\n"; + } + $interface = $1; + $implementation = $3; + if ( -f "$interface.cbc") { + &getDataGear("$interface.cbc"); + } + } elsif(/^(.*)par goto (\w+)\((.*)\)/) { + my $codeGearName = $2; + if ($filename =~ /^(.*)\/(.*)/) { + $codeGearName = "$1/$codeGearName"; + } + if ( -f "$codeGearName.cbc") { + &getCodeGear("$codeGearName.cbc"); + } + } elsif(/^#interface "(.*)"/) { + # use interface + my $interfaceHeader = $1; + next if ($interfaceHeader =~ /context.h/); + if (-f $interfaceHeader) { + &getDataGear("$interfaceHeader"); + &getCodeGear("$interfaceHeader"); + } + } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { + my $codeGearName = $1; + if ($filename =~ /^(.*)\/(.*)/) { + $codeGearName = "$1/$codeGearName"; + } + if ( -f "$codeGearName.cbc") { + &getCodeGear("$codeGearName.cbc"); + } + } + next; + } + # gather type name and type + $dataGear{$name} .= $_; + if (/^\s*(.*)\s+(\w+);$/ ) { + my $ttype = $1; + my $tname = $2; + if ($ttype =~ /^(union|struct|const)?\s*(\w+)/) { + if ($1 ne 'const') { + $ttype = $2; + } else { + $ttype = "const $2"; + } + } + $described_data_gear = 1; + $var{$name}->{$tname} = $ttype; + } + if (/__code (\w+)/) { + next if $described_data_gear; + my $args = $'; + while ($args =~ /\s*(struct|union|const)?\s*([\w\[\]_]+)\*?\s*(\w+),?/g) { + #$args eq (Impl* vm, pde_t* pgdir, char* init, uint sz, __code next(...)); + my $const_type = $1; + my $ttype = $2; + my $tname = $3; + + $ttype =~ s/(Impl|Isa|Type)/Data/; + if ($const_type eq 'const') { + $ttype = "const $ttype"; + } + $var{$name}->{$tname} = $ttype; + } + } + if (/^}/) { + $inTypedef = 0; + } + } + +} + +sub getCodeGear { + my ($filename) = @_; + open my $fd,"<",$filename or die("can't open $filename $!"); + my ($name,$impln); + while (<$fd>) { + if (/^(\w+)(\*)+ create(\w+)\(/) { + $name = $1; + $impln = $3; + } elsif(/^typedef struct (.*)<.*>\s*{/) { + $name = $1; + } + if (defined $name) { + if (/^\s*\_\_code (\w+)\((.*)\);/) { + my $args = $2; + my $method = $1; + $code{$name}->{$method} = []; + while($args) { + # replace comma + $args =~ s/(^\s*,\s*)//; + # continuation case + if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) { + my $next = $2; + my @args = split(/,/,$3); + push(@{$code{$name}->{$method}},"\_\_code $next"); + } elsif ($args =~ s/^(struct|union|const)?\s*(\w+)(\**)\s+(\w+)//) { + my $structType = $1; + my $typeName = $2; + my $ptrType = $3; + my $varName = $4; + my $typeField = lcfirst($typeName); + if ($structType =~ /const/) { + $typeName = "$structType $typeName"; + } + push(@{$code{$name}->{$method}},"$typeName$ptrType $varName"); + } elsif ($args =~ s/(.*,)//) { + } else { + last; + } + } + } + } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { + my $codeGearName = $1; + my $args = $2; + my $inputCount = 0; + my $outputCount = 0; + my $inputIncFlag = 1; + while($args) { + if ($args =~ s/(^\s*,\s*)//) { + } + if ($args =~ s/^(\s)*\_\_code\s+(\w+)\((.*?)\)//) { + $codeGear{$codeGearName}->{"code"}->{$2} = "\_\_code"; + $inputIncFlag = 0; + my @outputs = split(/,/,$3); + for my $output (@outputs) { + if ($output =~ /\s*(struct|union|const)?\s*(\w+)(\*)?+\s(\w+)/) { + my $structType = $1; + my $type = $2; + my $varName = $4; + if ($structType =~ /const/) { + $type = "$structType $type"; + } + $codeGear{$codeGearName}->{"var"}->{$varName} = "$type $outputCount"; + $outputCount++; + } + } + } elsif ($args =~ s/^(struct|union|const)?\s*(\w+)(\*)?+\s(\w+)// && $inputIncFlag) { + my $structType = $1; + my $type = $2; + my $varName = $4; + if ($structType =~ /const/) { + $type = "$structType $type"; + } + $codeGear{$codeGearName}->{"var"}->{$varName} = "$type $inputCount"; + $inputCount++; + } elsif ($args =~ s/(.*,)//) { + } else { + last; + } + } + $codeGear{$codeGearName}->{"input"} = $inputCount; + $codeGear{$codeGearName}->{"output"} = $outputCount; + } + } +} + +sub generateStub { + my($fd,$prevCodeGearName,$dataGearName) = @_; + print $fd "__code ", $prevCodeGearName ,"_stub(struct Context* cbc_context) {\n"; + print $fd $dataGearName; + print $fd "\n} \n\n"; + return 1; +} + +sub generateStubArgs { + my($codeGearName, $varName, $typeName, $ptrType, $typeField, $interface,$output) = @_; + my $varname1 = $output?"O_$varName":$varName; + for my $n ( @{$dataGearVar{$codeGearName}} ) { + # we already have it + return 0 if ( $n eq $varname1); + } + push @{$dataGearVar{$codeGearName}}, $varname1; + push @{$dataGearVarType{$codeGearName}}, $typeName; + if ($typeName eq $implementation) { + # get implementation + $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(cbc_context, $interface, $varName);\n"; + } else { + # interface var + for my $ivar (keys %{$var{$interface}}) { + # input data gear field + if ($varName eq $ivar) { + if ($typeName eq $var{$interface}->{$ivar}) { + if ($output) { + $dataGearName{$codeGearName} .= "\t$typeName$ptrType* O_$varName = &Gearef(cbc_context, $interface)->$varName;\n"; + $outputVar{$codeGearName} .= "\t$typeName$ptrType $varName __attribute__((unused)) = *O_$varName;\n"; + return 1; + } + $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = Gearef(cbc_context, $interface)->$varName;\n"; + return 1; + } + } + } + + # interface continuation + for my $cName (keys %{$code{$interface}}) { + if ($varName eq $cName) { + # continuation field + $dataGearName{$codeGearName} .= "\tenum Code $varName = Gearef(cbc_context, $interface)->$varName;\n"; + return 1; + } + } + # par goto var + for my $var (keys %{$codeGear{$codeGearName}->{"var"}}) { + # input data gear field + if ($varName eq $var) { + my ($type, $count) = split(/\s/, $codeGear{$codeGearName}->{"var"}->{$var}); + if ($typeName eq $type) { + if ($output) { + $dataGearName{$codeGearName} .= "\t$typeName$ptrType* O_$varName = ($typeName $ptrType*)&cbc_context->data[cbc_context->odg + $count];\n"; + $outputVar{$codeGearName} .= "\t$typeName$ptrType $varName = *O_$varName;\n"; + return 1; + } + $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = &cbc_context->data[cbc_context->idg + $count]->$typeName;\n"; + return 1; + } + } + } + + # par goto continuation + for my $cName (keys %{$codeGear{$codeGearName}->{"code"}}) { + if ($varName eq $cName) { + # continuation field + $dataGearName{$codeGearName} .= "\tenum Code $varName = cbc_context->next;\n"; + return 1; + } + } + + # par goto continuation + # global or local variable case + if ($typeName eq "Code") { + $dataGearName{$codeGearName} .= "\tenum $typeName$ptrType $varName = Gearef(cbc_context, $interface)->$varName;\n"; + return 1; + } + $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = Gearef(cbc_context, $typeName);\n"; + return 1; + } +} + +sub generateDataGear { + my ($filename) = @_; + open my $in,"<",$filename or die("can't open $filename $!"); + + my $fn; + if ($opt_o) { + $fn = $opt_o; + } else { + my $fn1 = $filename; + $fn1 =~ s/\.cbc/.c/; + my $i = 1; + $fn = "$dir/$fn1"; + while ( -f $fn) { + $fn = "$dir/$fn1.$i"; + $i++; + } + } + if ( $fn =~ m=(.*)/[^/]+$= ) { + if (! -d $1) { + make_path $1; + } + } + open my $fd,">",$fn or die("can't write $fn $!"); + + my $prevCodeGearName; + my $inTypedef = 0; + my $inStub = 0; + my $hasParGoto = 0; + my $inMain = 0 ; + my $inCode = 0 ; + my %stub; + my $codeGearName; + my %localVarType; + my %localCode; + + while (<$in>) { + if (! $inTypedef && ! $inStub && ! $inMain) { + if (/^typedef struct (\w+) \{/) { + $inTypedef = 1; + } elsif (/^int main\((.*)\) \{/) { + $inMain = 1; + } elsif(/^#interface "(.*)"/) { + my $interfaceHeader = $1; + # #interface not write + next unless ($interfaceHeader =~ /context.h/); + } elsif (/^\s\s*_\_code (\w+)\((.*)\)(.*)/) { + $localCode{$1} = 1; + } elsif (/^\s\s*_\_code *\(\s*\*\s*(\w+)\)\((.*)\)(.*)/) { + $localCode{$1} = 1; + } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { + $inCode = 1; + %localCode = {}; + %localVarType = {}; + $codeGearName = $1; + my $args = $2; + my $tail = $3; + if ($codeGearName =~ /_stub$/) { + # don't touch already existing stub + $inStub = 1; + $stub{$codeGearName} = 1; + print $fd $_; + next; + } + if (defined $prevCodeGearName) { + # stub is generated just before next CodeGear + if (defined $stub{$prevCodeGearName."_stub"}) { + undef $prevCodeGearName; + } else { + &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName}); + $stub{$prevCodeGearName."_stub"} = 1; + } + } + # analyzing CodeGear argument + # these arguments are extract from current context's arugment DataGear Interface + # and passed to the CodeGear + # struct Implementaion needs special handling + # __code next(...) ---> enum Code next + $prevCodeGearName = $codeGearName; + $dataGearVar{$codeGearName} = []; + $outputVar{$codeGearName} = ""; + $outputArgs{$codeGearName} = {}; + my $newArgs = "struct Context *cbc_context,"; + if ($args=~/^struct Context\s*\*\s*cbc_context/) { + $newArgs = ""; + } + if (!$args){ + $newArgs = "struct Context *cbc_context"; + } + while($args) { + if ($args =~ s/(^\s*,\s*)//) { + $newArgs .= $1; + } + # continuation case + if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) { + my $next = $2; + my @args = split(/,/,$3); + if (&generateStubArgs($codeGearName, $next, "Code", "", $next, $interface,0) ) { + $newArgs .= "enum Code $next"; + } + # analyze continuation arguments + # output arguments are defined in the Interface take the pointer of these + # output arguments are put into the Interface DataGear just before the goto + for my $arg (@args) { + $arg =~ s/^\s*//; + last if ($arg =~ /\.\.\./); + $arg =~ s/^(struct|union|const)?\s*(\w+)(\**)\s(\w+)//; + my $structType = $1; + my $typeName = $2; + my $ptrType = $3; + my $varName = $4; + if ($structType =~ /const/) { + $typeName = "$structType $typeName"; + } + my $typeField = lcfirst($typeName); + push(@{$outputArgs{$codeGearName}->{$next}}, $varName); + if (&generateStubArgs($codeGearName, $varName, $typeName, $ptrType, $typeField, $interface,1)) { + $newArgs .= ",$structType $typeName **O_$varName"; + } + } + } elsif ($args =~ s/^(struct|union|const)?\s*(\w+)(\**)\s(\w+)//) { + my $structType = $1; + my $typeName = $2; + my $ptrType = $3; + my $varName = $4; + $newArgs .= $&; # assuming no duplicate + if ($structType =~ /const/) { + $typeName = "$structType $typeName"; + } + my $typeField = lcfirst($typeName); + &generateStubArgs($codeGearName, $varName, $typeName, $ptrType, $typeField, $interface,0); + } elsif ($args =~ s/(.*,)//) { + $newArgs .= $1; + } else { + $newArgs .= $args; + last; + } + } + # generate goto statement from stub to the CodeGear in the buffer + $dataGearName{$codeGearName} .= "\tgoto $codeGearName(cbc_context"; + for my $arg ( @{$dataGearVar{$codeGearName}}) { + $dataGearName{$codeGearName} .= ", $arg"; + } + $dataGearName{$codeGearName} .= ");"; + # generate CodeGear header with new arguments + print $fd "__code $codeGearName($newArgs)$tail\n"; + if ($outputVar{$codeGearName} ne "") { + # output data var can be use before write + # it should be initialze by gearef + print $fd $outputVar{$codeGearName}; + } + next; + } elsif (! $inCode) { + s/new\s+(\w+)\(\)/\&ALLOCATE(cbc_context, \1)->\1/g; # replacing new + print $fd $_; + next; + } elsif (/^(.*)goto (\w+)\-\>(\w+)\((.*)\);/) { + # handling goto statement + # convert it to the meta call form with two arugments, that is context and enum Code + my $prev = $1; + my $next = $2; + my $method = $3; + my $tmpArgs = $4; + #$tmpArgs =~ s/\(.*\)/\(\)/; + my @args = split(/,/,$tmpArgs); + if (! defined $dataGearVarType{$codeGearName}) { + print $fd $_ ; + next ; + } + my @types = @{$dataGearVarType{$codeGearName}}; + my $ntype; + my $ftype; + for my $v (@{$dataGearVar{$codeGearName}}) { + my $t = shift @types; + if ($v eq $next || $v eq "O_$next") { + $ntype = $t; + $ftype = lcfirst($ntype); + } + } + if (!defined $ntype) { + $ntype = $localVarType{$next}; + $ftype = lcfirst($ntype); + } + print $fd "\tGearef(cbc_context, $ntype)->$ftype = (union Data*) $next;\n"; + # Put interface argument + my $prot = $code{$ntype}->{$method}; + my $i = 1; + for my $arg (@args) { + my $pType; + my $pName; + my $p = @$prot[$i]; + next if ($p eq $arg); + $p =~ s/^(.*)\s(\w+)//; + $pType = $1; + $pName = $2; + $arg =~ s/^(\s)*(\w+)/$2/; + if ($pType =~ s/\_\_code$//) { + if ($arg =~ /(\w+)\(.*\)/) { + print $fd "\tGearef(cbc_context, $ntype)->$pName = $1;\n"; + } else { + print $fd "\tGearef(cbc_context, $ntype)->$pName = C_$arg;\n"; + } + } elsif ($pType =~ /Data\**$/){ + print $fd "\tGearef(cbc_context, $ntype)->$pName = (union $pType) $arg;\n"; + } else { + print $fd "\tGearef(cbc_context, $ntype)->$pName = $arg;\n"; + } + $i++; + } + # print $fd "${prev}cbc_context->before = C_$codeGearName;\n"; + print $fd "${prev}goto meta(cbc_context, $next->$method);\n"; + next; + } elsif(/^(.*)par goto (\w+)\((.*)\);/) { + # handling par goto statement + # convert it to the parallel + my $prev = $1; + my $codeGearName = $2; + my $args = $3; + my $inputCount = $codeGear{$codeGearName}->{'input'}; + my $outputCount = $codeGear{$codeGearName}->{'output'}; + my @iterateCounts; + # parse examples 'par goto(.., iterate(10), exit);' + if ($args =~ /iterate\((.*)?\),/) { + @iterateCounts = split(/,/,$1);; + $inputCount--; + } + # replace iterate keyword + $args =~ s/iterate\((.*)?\),//; + my @dataGears = split(/,\s*/, $args); + my $nextCodeGear = pop(@dataGears); + if (! $hasParGoto) { + $hasParGoto = 1; + print $fd "${prev}struct Element* element;\n"; + } + my $initTask = << "EOFEOF"; + ${prev}cbc_context->task = NEW(struct Context); + ${prev}initContext(cbc_context->task); + ${prev}cbc_context->task->next = C_$codeGearName; + ${prev}cbc_context->task->idgCount = $inputCount; + ${prev}cbc_context->task->idg = cbc_context->task->dataNum; + ${prev}cbc_context->task->maxIdg = cbc_context->task->idg + $inputCount; + ${prev}cbc_context->task->odg = cbc_context->task->maxIdg; + ${prev}cbc_context->task->maxOdg = cbc_context->task->odg + $outputCount; +EOFEOF + print $fd $initTask; + if (@iterateCounts) { + print $fd "${prev}cbc_context->task->iterate = 0;\n"; + my $len = @iterateCounts; + if ($len == 1) { + print $fd "${prev}cbc_context->task->iterator = createMultiDimIterator(cbc_context, $iterateCounts[0], 1, 1);\n"; + } elsif ($len == 2) { + print $fd "${prev}cbc_context->task->iterator = createMultiDimIterator(cbc_context, $iterateCounts[0], $iterateCounts[1], 1);\n"; + } elsif ($len == 3) { + print $fd "${prev}cbc_context->task->iterator = createMultiDimIterator(cbc_context, $iterateCounts[0], $iterateCounts[1], $iterateCounts[2]);\n"; + } + } + for my $dataGear (@dataGears) { + print $fd "${prev}GET_META($dataGear)->wait = createSynchronizedQueue(cbc_context);\n"; + } + for my $i (0..$inputCount-1) { + print $fd "${prev}cbc_context->task->data[cbc_context->task->idg+$i] = (union Data*)@dataGears[$i];\n"; + } + for my $i (0..$outputCount-1) { + print $fd "${prev}cbc_context->task->data[cbc_context->task->odg+$i] = (union Data*)@dataGears[$inputCount+$i];\n"; + } + my $putTask = << "EOFEOF"; + ${prev}element = &ALLOCATE(cbc_context, Element)->Element; + ${prev}element->data = (union Data*)cbc_context->task; + ${prev}element->next = cbc_context->taskList; + ${prev}cbc_context->taskList = element; +EOFEOF + print $fd $putTask; + next; + } elsif (/^(.*)goto (\w+)\((.*)\);/) { + # handling goto statement + # convert it to the meta call form with two arugments, that is context and enum Code + my $prev = $1; + my $next = $2; + my @args = split(/,/, $3); + my $v = 0; + if (defined $localCode{$next}) { + print $fd $_; next; + } + for my $n ( @{$dataGearVar{$codeGearName}} ) { + # continuation arguments + $v = 1 if ( $n eq $next); + } + if ($v || defined $code{$interface}->{$next}) { + # write continuation's arguments into the interface arguments + # we may need a commit for a shared DataGear + for my $arg ( @{$outputArgs{$codeGearName}->{$next}} ) { + my $v = shift(@args); + print $fd "\t*O_$arg = $v;\n"; + } + if ($hasParGoto) { + print $fd "${prev}Gearef(cbc_context, TaskManager)->taskList = cbc_context->taskList;\n"; + print $fd "${prev}Gearef(cbc_context, TaskManager)->next1 = C_$next;\n"; + print $fd "${prev}goto meta(cbc_context, C_$next);\n"; + } else { + # print $fd "${prev}cbc_context->before = C_$codeGearName;\n"; + print $fd "${prev}goto meta(cbc_context, $next);\n"; + } + next; + } + if ($hasParGoto) { + print $fd "${prev}Gearef(cbc_context, TaskManager)->taskList = cbc_context->taskList;\n"; + print $fd "${prev}Gearef(cbc_context, TaskManager)->next1 = C_$next;\n"; + print $fd "${prev}goto parGotoMeta(cbc_context, C_$next);\n"; + next; + } elsif ($next eq "meta") { + print $fd $_; + next; + } else { + # print $fd "${prev}cbc_context->before = C_$codeGearName;\n"; + print $fd "${prev}goto meta(cbc_context, C_$next);\n"; + next; + } + } elsif(/^.*(struct|union)?\s(\w+)\*\s(\w+)\s?[=;]/) { + my $type = $2; + my $varName = $3; + $localVarType{$varName} = $type; + s/new\s+(\w+)\(\)/\&ALLOCATE(cbc_context, \1)->\1/g; # replacing new + } elsif(/^}/) { + $hasParGoto = 0; + } else { + s/new\s+(\w+)\(\)/\&ALLOCATE(cbc_context, \1)->\1/g; # replacing new + } + # gather type name and type + } elsif ($inMain) { + if (/^(.*)goto start_code\(main_context\);/) { + print $fd $_; + next; + } elsif (/^(.*)goto (\w+)\((.*)\);/) { + my $prev = $1; + my $next = $2; + print $fd "${prev}struct Context* main_context = NEW(struct Context);\n"; + print $fd "${prev}initContext(main_context);\n"; + print $fd "${prev}main_cbc_context->next = C_$next;\n"; + print $fd "${prev}goto start_code(main_context);\n"; + next; + } + } + if (/^}/) { + $inStub = 0; + $inTypedef = 0; + $inMain = 0; + $inCode = 0; + } + print $fd $_; + } + if (defined $prevCodeGearName) { + if (!defined $stub{$prevCodeGearName."_stub"}) { + $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName}); + } + } +} + +# end diff -r 720e9c0936e0 -r 9a4279c88aa7 lib/Gears/Context.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/Gears/Context.pm Fri Mar 06 14:59:59 2020 +0900 @@ -0,0 +1,181 @@ +package Gears::Context; + +use strict; +use warnings; + +use Gears::Util; +use Gears::Context::Template::XV6; +use Carp qw/croak carp/; + +sub new { + my ($class, %args) = @_; + my $self = { + data_gears_with_count => {}, + find_root => $args{find_root} // ".", + output => $args{output}, + }; + + if ($args{compile_sources}) { + $self->{compile_sources} = $args{compile_sources}; + map { Gears::Util->file_checking($_); } @{$self->{compile_sources}}; + } + + return bless $self, $class; +} + + +sub extraction_dg_compile_sources { + my ($self, $compile_sources) = @_; + return Gears::Util->extraction_dg_compile_sources($compile_sources); +} + +sub set_data_gear_header_path { + my $self = shift; + my @data_gears_name; + map { push (@data_gears_name,$_) if $_ ne "Context" } @_; + return Gears::Util->docking_header_name_to_path($self->{find_root},\@data_gears_name); +} + +sub update_dg_each_header_path { + my ($self, $dgs, $dg2path) = @_; + my $new_dgs; + for my $kind (keys %$dgs) { + for my $dg_name (keys %{$dgs->{$kind}}) { + if ($dg2path->{$dg_name}) { + $new_dgs->{$kind}->{$dg_name} = $dg2path->{$dg_name}; + } else { + croak "failed trans header $dg_name\n"; + } + } + } + + for my $kind (keys %$dgs) { + map { + if ($new_dgs->{$kind}->{$_} =~ /^\d+$/) { + carp "failed: not found $_.(h|dg)\n"; + delete $new_dgs->{$kind}->{$_}; + } + } keys %{$new_dgs->{$kind}}; + } + return $new_dgs; +} + +sub tree2create_context_h { + my ($self, $dg2path) = @_; + + my $data_struct_str = $dg2path ? $self->tree2data_struct_str($dg2path) : "\n"; + + my $output = $self->_select_output(); + Gears::Context::Template::XV6->emit_top_header($output); + Gears::Context::Template::XV6->emit_data_gears($output,$data_struct_str); + Gears::Context::Template::XV6->emit_last_header($output); + close $output; +} + +sub _select_output { + my $self = shift; + print "$self->{output}\n"; + if ($self->{output} eq 'stdout') { + return *STDOUT; + } + open my $fh, '>', $self->{output}; + return $fh; +} + +sub tree2data_struct_str { + my ($self, $dg_str) = @_; + my $data_struct_str = ""; + for my $interface (sort keys %$dg_str) { + $data_struct_str .= $self->h2context_str_w_macro($dg_str->{$interface}->{elem}); + next unless ($dg_str->{$interface}->{impl}); + for my $impl (sort keys %{$dg_str->{$interface}->{impl}}) { + $data_struct_str .= $self->h2context_str_w_macro($dg_str->{$interface}->{impl}->{$impl}); + } + } + return $data_struct_str; +} + +sub createImplTree_from_header { + my ($self, $dg2path) = @_; + my %dg_str = (); + + my $inters = $dg2path->{interfaces}; + my $impls = $dg2path->{impl}; + + use Data::Dumper; + print Dumper $dg2path; + print Dumper $self; + + map { my $ir = Gears::Util->parse_interface($inters->{$_}); $dg_str{$_}->{elem} = $ir if $ir} keys %$inters; + + map { + my $res = Gears::Util->parse($impls->{$_}); + if ($res) { + if ($res->{isa}) { + $dg_str{$res->{isa}}->{impl}->{$_} = $res; + } else { + $dg_str{$_}->{elem} = $res; + } + } + } keys %$impls; + return \%dg_str; +} + +sub h2context_str_w_macro { + my ($self, $h2context) = @_; + my $space = ' '; + my $context = "${space}//$h2context->{file_name}\n"; + $context .= "#ifndef ". uc($h2context->{name}) ."_STRUCT \n"; + $context .= $self->h2context_str($h2context); + $context .= "#define ". uc($h2context->{name}) ."_STRUCT \n"; + $context .= "#else\n"; + $context .= "${space}struct $h2context->{name};\n"; + $context .= "#endif\n"; + return $context; +} + +sub h2context_str { + my ($self, $h2context) = @_; + my $space = ' '; + + my $context = "${space}struct $h2context->{name} {\n"; + my $content_space; + + my @enumCodes; + my @var; + + for my $c (@{$h2context->{content}}) { + if ($c =~ /\A\s*enum Code/) { + push(@enumCodes,$c); + } else { + push(@var,$c); + } + } + + if (@var){ + my @chars = split //, $var[0]; + for my $w (@chars) { + last if ($w !~ /\s/); + $content_space .= $w; + } + } + + unless (defined $content_space) { + $content_space = ""; + } + + for my $c (@var) { + $c =~ s/$content_space//; + $context .= "${space}${space}$c"; + } + + for my $c (@enumCodes) { + $c =~ s/$content_space//; + $context .= "${space}${space}$c"; + } + + $context .= "${space}} $h2context->{name};\n"; + return $context; +} + +1; diff -r 720e9c0936e0 -r 9a4279c88aa7 lib/Gears/Context/Template/XV6.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/Gears/Context/Template/XV6.pm Fri Mar 06 14:59:59 2020 +0900 @@ -0,0 +1,215 @@ +package Gears::Context::Template::XV6; +use strict; +use warnings; + +sub emit_top_header { + my ($class, $out) = @_; +my $str = << 'EOFEOF'; +/* Context definition for llrb example */ +// #ifdef CBC_CONTEXT_H does not work well +#define CBC_CONTEXT_H +// #include +// #include +#ifdef USE_CUDAWorker +#include +#include +#include +#include "helper_cuda.h" +#endif + +#ifndef NULL +# if defined __GNUG__ && \ + (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 8)) +# define NULL (__null) +# else +# if !defined(__cplusplus) +# define NULL ((void*)0) +# else +# define NULL (0) +# endif +# endif +#endif + +#include "ln.h" +#ifdef XV6KERNEL +extern void* kmalloc (int order); +#define calloc(a,b) kmalloc(ln((a)*(b))) +#define free(a) kfree(a) +#else +extern void* malloc(unsigned int sz); +#define calloc(a,b) malloc((a)*(b)) +#define free(a) free(a) +#endif + +#define ALLOCATE_SIZE 20000 +#define NEW(type) (type*)(calloc(1, sizeof(type))) +#define NEWN(n, type) (type*)(calloc(n, sizeof(type))) + +#define ALLOC_DATA(cbc_context, dseg) ({\ + Meta* meta = (Meta*)cbc_context->heap;\ + meta->type = D_##dseg;\ + meta->size = sizeof(dseg);\ + meta->len = 1;\ + cbc_context->heap += sizeof(Meta);\ + cbc_context->data[D_##dseg] = cbc_context->heap; cbc_context->heap += sizeof(dseg); (dseg *)cbc_context->data[D_##dseg]; }) + +#define ALLOC_DATA_TYPE(cbc_context, dseg, t) ({\ + Meta* meta = (Meta*)cbc_context->heap;\ + meta->type = D_##t;\ + meta->size = sizeof(t);\ + meta->len = 1;\ + cbc_context->heap += sizeof(Meta);\ + cbc_context->data[D_##dseg] = cbc_context->heap; cbc_context->heap += sizeof(t); (t *)cbc_context->data[D_##dseg]; }) + +#define ALLOCATE(cbc_context, t) ({ \ + Meta* meta = (Meta*)cbc_context->heap;\ + cbc_context->heap += sizeof(Meta);\ + union Data* data = cbc_context->heap; \ + cbc_context->heap += sizeof(t); \ + meta->type = D_##t; \ + meta->size = sizeof(t); \ + meta->len = 1;\ + data; }) + +#define ALLOCATE_ARRAY(cbc_context, t, length) ({ \ + Meta* meta = (Meta*)cbc_context->heap;\ + cbc_context->heap += sizeof(Meta);\ + union Data* data = cbc_context->heap; \ + cbc_context->heap += sizeof(t)*length; \ + meta->type = D_##t; \ + meta->size = sizeof(t)*length; \ + meta->len = length; \ + data; }) + +#define ALLOCATE_PTR_ARRAY(cbc_context, dseg, length) ({\ + Meta* meta = (Meta*)cbc_context->heap;\ + cbc_context->heap += sizeof(Meta);\ + union Data* data = cbc_context->heap; \ + cbc_context->heap += sizeof(dseg *)*length; \ + meta->type = D_##dseg; \ + meta->size = sizeof(dseg *)*length; \ + meta->len = length; \ + data; }) + +#define ALLOCATE_DATA_GEAR(cbc_context, t) ({ \ + union Data* data = ALLOCATE(cbc_context, t); \ + Meta* meta = GET_META(data); \ + meta->wait = createSynchronizedQueue(cbc_context); \ + data; }) + +#define ALLOC(cbc_context, t) (&ALLOCATE(cbc_context, t)->t) + +#define GET_META(dseg) ((Meta*)(((void*)dseg) - sizeof(Meta))) +#define GET_TYPE(dseg) (GET_META(dseg)->type) +#define GET_SIZE(dseg) (GET_META(dseg)->size) +#define GET_LEN(dseg) (GET_META(dseg)->len) +#define GET_WAIT_LIST(dseg) (GET_META(dseg)->wait) + +#define Gearef(cbc_context, t) (&(cbc_context)->data[D_##t]->t) + +// (SingleLinkedStack *)cbc_context->data[D_Stack]->Stack.stack->Stack.stack + +#define GearImpl(cbc_context, intf, name) (Gearef(cbc_context, intf)->name->intf.name) + +#include "c/enumCode.h" + +#include "types.h" + +enum Relational { + EQ, + GT, + LT, +}; + +#include "c/enumData.h" +#define NDIRECT 12 //fs.h + + +struct Context { + enum Code next; + struct Worker* worker; + struct TaskManager* taskManager; + int codeNum; + __code (**code) (struct Context*); + union Data **data; + void* heapStart; + void* heap; + long heapLimit; + int dataNum; + + // task parameter + int idgCount; //number of waiting dataGear + int idg; + int maxIdg; + int odg; + int maxOdg; + int gpu; // GPU task + struct Context* task; + struct Element* taskList; +#ifdef USE_CUDAWorker + int num_exec; + CUmodule module; + CUfunction function; +#endif + /* multi dimension parameter */ + int iterate; + struct Iterator* iterator; + enum Code before; +}; + +#include "spinlock.h" +typedef int Int; +#ifndef USE_CUDAWorker +typedef unsigned long long CUdeviceptr; +#endif +typedef struct proc proc_struct; +typedef uint32 pte_t; +typedef uint32 pde_t; +typedef struct stat stat; +typedef struct superblock superblock; +typedef struct buf buf; +typedef struct dinode dinode; +typedef struct dirent dirent; +EOFEOF + print $out $str; +} + +sub emit_data_gears { + my ($class, $out, $dgs) = @_; + +print $out "union Data {\n"; +print $out $dgs; +print $out <<'EOF'; + +#ifndef CbC_XV6_CONTEXT + struct Context Context; +}; // union Data end this is necessary for context generator +typedef union Data Data; +#endif +EOF +} + + +sub emit_last_header { + my($class, $out) = @_; + print $out <<'EOF'; + + + +#include "c/typedefData.h" + +#include "c/extern.h" + +#define CbC_XV6_CONTEXT 1 +extern __code start_code(struct Context* cbc_context); +extern __code exit_code(struct Context* cbc_context); +extern __code meta(struct Context* cbc_context, enum Code next); +//extern __code par_meta(struct Context* cbc_context, enum Code spawns, enum Code next); +extern __code parGotoMeta(struct Context* cbc_context, enum Code next); +extern void initContext(struct Context* cbc_context); + +// #endif +EOF +} + +1; diff -r 720e9c0936e0 -r 9a4279c88aa7 lib/Gears/Stub.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/Gears/Stub.pm Fri Mar 06 14:59:59 2020 +0900 @@ -0,0 +1,39 @@ +package Gears::Stub; +use strict; +use warnings; +use Carp qw/croak/; +use File::Find; +use Gears::Util; + +use DDP {deparse => 1}; + +sub new { + my ($class, %args) = @_; + + my $self = {}; + $self->{file_name} = $args{file_name} || croak 'invalid file_name!'; + + return bless $self, $class; +} + + + +sub findInterfacewImpl { + my $self = shift; + my $cbc_file = shift // $self->{file_name}; + my $findInterfaces = Gears::Util->extraction_dg_compile_sources([$cbc_file]); + my $edgcs = Gears::Util->extraction_dg_compile_sources([$cbc_file]); + my $findInterfaces = {}; + + my %ifs = (); + map { $ifs{$_}++ } keys %{$edgcs->{interfaces}}; + delete $ifs{Meta}; + delete $ifs{TaskManager}; + + push(@{$findInterfaces->{interfaces}}, keys %ifs); + push(@{$findInterfaces->{impls}}, keys %{$edgcs->{impl}}); + + return $findInterfaces; +} + +1; diff -r 720e9c0936e0 -r 9a4279c88aa7 lib/Gears/Util.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/Gears/Util.pm Fri Mar 06 14:59:59 2020 +0900 @@ -0,0 +1,305 @@ +package Gears::Util; +use strict; +use warnings; +use Carp qw/croak/; +use File::Find; + +sub parse { + my ($class, $file_name) = @_; + my $ir = _parse_base($file_name); + return $ir; +} + + +sub parse_interface { + my ($class, $file_name) = @_; + my $ir = _parse_base($file_name); + + unless ($ir->{name}) { + croak 'invalid struct name'; + } + return $ir; +} + + +sub _parse_base { + my ($file,$code_verbose) = @_; + my $ir = {}; + $ir->{file_name} = $file; + + Gears::Util->file_checking($file); + open my $fh, '<', $file; + my $line = <$fh>; + my $static_data_gear_write_mode = 0; + + if ($line =~ /typedef struct (\w+)\s?<.*>([\s\w{]+)/) { + die "invalied struct name $1" unless $1; + $ir->{name} = $1; + + if ($2 =~ m|\s*impl\s*([\w+]+)\s*{|) { + $ir->{isa} = $1; + } + } + + unless ($ir->{name}) { + return undef; + } + + my @tmp_args; + while ($line = <$fh>) { + if ($line =~ m|\s*/\*|) { + while ( $line !~ m|\*/|) { + $line = <$fh>; + next; + } + next; + } + next if ($line =~ /^\s+$/); + next if ($line =~ m[^\s*//]); + next if ($line =~ m[^\}\s*$ir->{name};]); + + if ($line =~ m|__code (\w+)|) { + push(@tmp_args,"enum Code $1;\n"); + next if $static_data_gear_write_mode; + my $args = $'; + #$args eq (Impl* vm, pde_t* pgdir, char* init, uint sz, __code next(...)); + while ($args =~ /\s*(struct|union|const)?\s*([\w*\[\]_]+)\s*(\w+),?/g) { + my $const_type = $1; + my $type = $2; + my $vname = $3; + next if ($type eq '__code'); + $type =~ s/(?:Impl|Type|Isa)/union Data/; + my $val = "$type $vname;\n"; + push(@tmp_args, $const_type ? "$const_type $val" : $val); + } + next; + } + + $line =~ s/^\s+//; + push(@tmp_args,$line); + $static_data_gear_write_mode = 1; + } + + push(@{$ir->{content}}, _uniq(@tmp_args)); + return $ir; +} + +sub _uniq { + my %seen; + return grep { !$seen{$_}++ } @_; +} + +sub parse_with_separate_code_data_gears{ + my ($class, $file) = @_; + my $ir = _parse_base($file); + + my @data_gears; + my @code_gears; + map { push (@data_gears, $_) unless ($_ =~ /enum Code/);} @{$ir->{content}}; + map { push (@code_gears, $1) if ($_ =~ /enum Code (\w+);/);} @{$ir->{content}}; + + open my $fh , '<', $file; + my $i = 0; + while (($i < scalar @code_gears) && (my $line = <$fh>)) { + my $cg = $code_gears[$i]; + if ($line =~ m|__code $cg\(([()\.\*\s\w,_]+)\)|) { + $code_gears[$i] = { + name => $cg, + args => $1, + }; + $i++; + } + } + $ir->{codes} = \@code_gears; + $ir->{data} = \@data_gears; + return $ir; +} + +sub file_checking { + my ($class, $file_name) = @_; + unless (-f $file_name) { + croak "invalid filepath :$file_name\n"; + } +} + +sub slup { + my ($class,$file) = @_; + open my $fh, '<', $file; + local $/; + my $f = <$fh>; + return $f; +} + +sub find_using_interface_header { + my $class = shift; + my $header_name = shift; + + my $find_path = shift // "."; + my @header_list = (); + + find( + { + wanted => sub { + if ($_ =~ /\/$header_name\.(h|dg)$/) { + push(@header_list,$_); + } + }, + no_chdir => 1, + }, + $find_path); + my @find_headers = grep { $_ =~ /\/$header_name\.(h|dg)/} @header_list; + if (@find_headers > 1) { + @find_headers = grep { $_ =~ /\/$header_name\.dg/} @find_headers; + } + return shift @find_headers; +} + +sub find_headers_path { + my $class = shift; + my $find_path = shift // "."; + + my @files; + find( { wanted => sub { push @files, $_ if /\.(?:h|dg)/ }, no_chdir => 1 }, $find_path); + + return \@files; +} + +sub extraction_dg_compile_sources { + my ($class, $compile_sources) = @_; + my %counter; + my %include_pool = (); + for my $cbc_file (@{$compile_sources}) { + open my $fh , '<', $cbc_file; + while (my $line = <$fh>) { + if ($line =~ m|//\s*:skip|) { + next; + } + + if ($line =~ /#interface\s*"(.*)\.h"/) { + push(@{$counter{interfaces}->{$1}->{$cbc_file}},$.); + next; + } + + if ($line =~ /^\/\/\s*data_gear\s*"(.*)\.(?:h|dg)?"/) { + push(@{$include_pool{$1}->{$cbc_file}},$.); + next; + } + + if ($line =~ m|//\s*Skip:\s*generate_context|) { + $line = <$fh>; + next; + } + + + if ($line =~ /^(\w+)\*\s*create(\w+)\(([*\w\s]+)\)/) { + my $interface = $1; + my $implementation = $2; + my $arg = $3; + if ($arg eq "") { + next; + } + push(@{$counter{interfaces}->{$interface}->{$cbc_file}},$.); + push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); + next; + } + + if ($line =~ /Gearef\(context,\s*(\w+)\)/) { + my $implementation = $1; + push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); + next; + } + + #Element* element = &ALLOCATE(cbc_context, Element)->Element; + if ($line =~ /ALLOCATE\w*\((?:cbc_)?context,\s*(\w+)\)/) { + my $implementation = $1; + push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); + next; + } + + if ($line =~ /ALLOCATE_(?:PTR_)?ARRAY\((?:cbc_)?context,\s*(\w+),[\s\w]+\)/) { + my $implementation = $1; + push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); + next; + } + + if ($line =~ /new\s+(\w+?)\([\w\s]*\);/) { + my $implementation = $1; + push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); + next; + } + + if ($line =~ /ALLOCATE_DATA_GEAR\((\w+),\s*(\w+)\)/) { + my $implementation = $2; + push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); + next; + } + + #TaskManagerImpl* taskManager = (TaskManagerImpl*)GearImpl(context, TaskManager, taskManager); + if ($line =~ /\((\w+)\*\)GearImpl\(context,\s*(\w+),\s*(\w+)\)/) { + my $interface = $2; + my $implementation = $1; + push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); + push(@{$counter{interfaces}->{$interface}->{$cbc_file}},$.); + next; + } + + if ($line =~ /^__code/) { + while ($line =~ /struct (\w+)\s*\*/g) { + next if $1 eq "Context"; + next if (exists $counter{interfaces}->{$1}); + push(@{$counter{impl}->{$1}->{$cbc_file}},$.); + } + } + } + close $fh; + } + use Data::Dumper; + + for my $cg_name (keys %include_pool) { + my @tmp_cbc_file_names = keys %{$include_pool{$cg_name}}; + my $tmp_cbc_file_name = shift @tmp_cbc_file_names; + if (exists $counter{interfaces}->{$cg_name}){ + push(@{$counter{interfaces}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name}); + delete $include_pool{$cg_name}; + next; + } + + if (exists $counter{impl}->{$cg_name}){ + push(@{$counter{impl}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name}); + delete $include_pool{$cg_name}; + next; + } + push(@{$counter{interfaces}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name}); + delete $include_pool{$cg_name}; + } + + $counter{interfaces}->{Meta}++; + $counter{interfaces}->{TaskManager}++; + print "-----------\n"; + print Dumper \%counter; + print "-----------\n"; + return \%counter; +} + +sub docking_header_name_to_path { + my ($class, $search_bash_path, $targets) = @_; + my %res; + map { $res{$_}++ } @$targets; + + my $header_paths = Gears::Util->find_headers_path($search_bash_path); + map { + if (/(\w+)\.(?:h|dg)$/) { + my $header_file = $1; + if (exists $res{$header_file}) { + if ($res{$header_file} =~ /^\d+$/){ + $res{$header_file} = $_; + } elsif (($_ =~ /\.dg$/) && ($res{$header_file} =~ /\.h$/)) { + $res{$header_file} = $_; + } + } + } + } sort @$header_paths; + return \%res; +} + +1; diff -r 720e9c0936e0 -r 9a4279c88aa7 pmake.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/pmake.pl Fri Mar 06 14:59:59 2020 +0900 @@ -0,0 +1,181 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use FindBin; +use Cwd 'getcwd'; +use File::Path 'rmtree'; + +my ($cc,$cflags,$asm,$ld,$ldflags,$libgcc,$cmake,$kernel_cflags,$kernel_ld_flags,$kernel_ld_command, $initcode_cflags, $initcode_ld_command); + +my $curdir = getcwd; + +if (@ARGV) { + if ($ARGV[0] =~ /--del/) { + my @current_dir_file = glob "*"; + map { print "$_\n";} @current_dir_file; + print "delete all files? > [y/n]\n"; + my $ans = ; + if ($ans =~ /y/) { + print "delete ...\n"; + map { rmtree $_ } @current_dir_file; + } + } +} + +$cmake = 'cmake'; +my @cmake_arg = (); +my $xv6_src_dir = $FindBin::Bin; +$xv6_src_dir =~ s|(.*)/gearsTools(.*)|$1|; + +my $objcopy; +if ($^O =~ /darwin/){ + $objcopy = "/usr/local/opt/llvm/bin/llvm-objcopy"; + my $arm_library = $ENV{ARM_LIBRARY}; + $cc = $ENV{CBC_COMPILER}; + $asm = $ENV{CBC_COMPILER}; + $cflags = qq|-Wall -g --target=armv6-linux-gnueabihf -fno-pic -static -fno-builtin -fno-strict-aliasing -Wall -DCBCXV6=1 -g -O0 -nodefaultlibs + -Wno-macro-redefined -Wno-gnu-designator -Wno-sometimes-uninitialized -Wno-tautological-compare + -Wno-nullability-completeness -Wno-expansion-to-defined |; + $cflags .= ' -B' . $ENV{HOME} .'/workspace/cr/arm_library/usr/lib/gcc/arm-linux-gnueabihf/6.3.0'; + $cflags .= ' --gcc-toolchain=arm-linux-gnueabihf-raspbian'; + # $ld = '/usr/local/linaro/arm-linux-gnueabihf-raspbian/bin/arm-linux-gnueabihf-ld'; + $ld = "/usr/local/opt/llvm/bin/ld.lld"; + + # $libgcc = '/usr/local/lib/gcc/arm-none-eabi/7.3.1/libgcc.a'; + $libgcc = "$arm_library/usr/lib/gcc/arm-linux-gnueabihf/6.3.0/libgcc.a"; + #chomp($libgcc = `$cc --print-libgcc-file-name`); + $ldflags = " -L. -T kernel-cmake.ld"; + $kernel_cflags = '--target=armv6-linux-gnueabihf -fno-pic -static -fno-builtin -fno-strict-aliasing -Wall -Werror -g -O0 -iquote ../ -c'; + # -DX_CMAKE_C_LINK_EXECUTABLE=\"$ld $ldflags -o kernel.elf $libgcc -b binary initcode usr/fs.img\" + $kernel_ld_flags = ' -L. -N -e main -Ttext 0 -o -L ../ ' . $libgcc; + #$kernel_ld_flags = ' -L. -N -e main -Ttext 0 -o ' ; + $kernel_ld_command = "$ld $kernel_ld_flags"; + $initcode_cflags = '--target=armv6-linux-gnueabihf -nostdinc -c'; + $initcode_ld_command = "$ld -L. -N -e start -Ttext 0 -o "; + + + push(@cmake_arg, + "-DCBC_XV6_SYSROOT=\"$arm_library\"", + # "-DCMAKE_OSX_SYSROOT=\"$arm_library\"", + #"-DCMAKE_RANLIB=\"/Users/anatofuz/workspace/compiler/llvm/llvm-project/build/bin/llvm-ar\"", + "-DCMAKE_AR=\"/usr/local/opt/llvm/bin/llvm-ar\"", + "-DCMAKE_RANLIB=\"/usr/local/opt/llvm/bin/llvm-ranlib\"", + # "-DCMAKE_AR=\"/usr/local/linaro/arm-linux-gnueabihf-raspbian/bin/arm-linux-gnueabihf-ar\"", + # "-DCMAKE_RANLIB=\"/usr/local/linaro/arm-linux-gnueabihf-raspbian/bin/arm-linux-gnueabihf-ranlib\"", + # "-DCMAKE_OSX_XV6_INCLUDE_DIR=\"$arm_library/usr/include\"", + ); + +} else { + $objcopy = "arm-none-eabi-objcopy"; + $cc = '/mnt/dalmore-home/one/src/armgcc/cross/bin/arm-none-eabi-gcc'; + $asm = $cc; + $cflags = qq|-B/mnt/dalmore-home/one/src/armgcc/cross/bin/arm-none-eabi- + -DCBCXV6=1 -fno-pic -static -fno-builtin -fno-strict-aliasing -Wall -g -O0|; + $ld = '/mnt/dalmore-home/one/src/armgcc/cross/bin/arm-none-eabi-ld'; + chomp($libgcc = `$cc --print-libgcc-file-name`); + $cmake .= 3; + $ldflags = " -L. -T kernel-cmake.ld"; + $kernel_cflags = '-march=armv6 -fno-pic -static -fno-builtin -fno-strict-aliasing -Wall -Werror -g -O0 -iquote ../ -c'; + # -DX_CMAKE_C_LINK_EXECUTABLE=\"$ld $ldflags -o kernel.elf $libgcc -b binary initcode usr/fs.img\" + $kernel_ld_flags = ' -L. -N -e main -Ttext 0 -o -L ../ /mnt/dalmore-home/one/src/gcc-arm-none-eabi-6-2017-q2-update/bin/../lib/gcc/arm-none-eabi/6.3.1/libgcc.a'; + $kernel_ld_command = "$ld $kernel_ld_flags"; + $initcode_cflags = '-march=armv6 -nostdinc -c'; + $initcode_ld_command = "$ld -L. -N -e start -Ttext 0 -o "; + + $cflags =~ s/\n//g; +} + +push(@cmake_arg, + "-DCBC_COM=$cc", + "-DPMAKE_ARGS=\"$cflags\"", + "-DCBC_ASM_COMPILER=$cc", + "-DX_CMAKE_LINKER=$ld", + "-DX_CMAKE_C_LINK_EXECUTABLE=\"$ld $ldflags -o kernel.elf $libgcc -b binary initcode fs.img\"", + "-DKERNEL_LINK_EXECUTABLE=\"$kernel_ld_command\"", + "-DCMAKE_INSTALL_RPATH_USE_LINK_PATH=TRUE", + "-DINITOCDE_CFLAGS=\"$initcode_cflags\"", + "-DINITOCDE_LINK_EXECUTABLE=\"$initcode_ld_command\"", + "-S $xv6_src_dir", + "-DXV6_OBJCOPY=\"$objcopy\"", + $curdir); + +unshift(@cmake_arg, $cmake); + +create_link_script(); +print_exec_system(@cmake_arg); + +system("make"); +#system("sh","link.sh"); + +sub create_link_script { + my @link_script; + while (my $line = ){ + $line =~ s/LD/$ld/; + $line =~ s/LIBGCC/$libgcc/; + push @link_script,$line; + } + if ($^O =~ /darwin/){ + for (@link_script){ + s/CMakeFiles/build/; + s|kernel\.dir/||; + } + } + open my $fh, '>', 'link.sh'; + print $fh "@link_script"; +} + +sub print_exec_system { + my @query = @_; + print(join(' ',@query), "\n"); + system(join(' ',@query)); +} + + + +__DATA__ +cp initcode ./CMakeFiles/kernel.dir/initcode +cp fs.img ./CMakeFiles/kernel.dir/fs.img + +LD \ +-L. \ +-T \ +kernel-cmake.ld \ +-o \ +kernel.elf \ + \ +CMakeFiles/kernel.dir/lib/string.c.o \ +CMakeFiles/kernel.dir/arm.c.o \ +CMakeFiles/kernel.dir/asm.S.o \ +CMakeFiles/kernel.dir/bio.c.o \ +CMakeFiles/kernel.dir/buddy.c.o \ +CMakeFiles/kernel.dir/c/console.c.o \ +CMakeFiles/kernel.dir/exec.c.o \ +CMakeFiles/kernel.dir/c/file.c.o \ +CMakeFiles/kernel.dir/fs.c.o \ +CMakeFiles/kernel.dir/log.c.o \ +CMakeFiles/kernel.dir/main.c.o \ +CMakeFiles/kernel.dir/memide.c.o \ +CMakeFiles/kernel.dir/c/pipe.c.o \ +CMakeFiles/kernel.dir/c/proc.c.o \ +CMakeFiles/kernel.dir/c/spinlock.c.o \ +CMakeFiles/kernel.dir/start.c.o \ +CMakeFiles/kernel.dir/swtch.S.o \ +CMakeFiles/kernel.dir/c/syscall.c.o \ +CMakeFiles/kernel.dir/c/sysfile.c.o \ +CMakeFiles/kernel.dir/sysproc.c.o \ +CMakeFiles/kernel.dir/trap_asm.S.o \ +CMakeFiles/kernel.dir/trap.c.o \ +CMakeFiles/kernel.dir/vm.c.o \ +CMakeFiles/kernel.dir/device/picirq.c.o \ +CMakeFiles/kernel.dir/device/timer.c.o \ +CMakeFiles/kernel.dir/device/uart.c.o \ +CMakeFiles/kernel.dir/entry.S.o \ +CMakeFiles/kernel.dir/c/kernel-context.c.o \ + \ + \ +LIBGCC \ + \ +-b \ +binary \ +initcode \ +fs.img diff -r 720e9c0936e0 -r 9a4279c88aa7 static_gen_header.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/static_gen_header.pl Fri Mar 06 14:59:59 2020 +0900 @@ -0,0 +1,79 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +=head1 DESCRIPTION + +emit Gears header files + +=head1 SYNOPSIS + + % sample.pl --interface list + % sample.pl --impl single_linked_list --interface list + % sample.pl -w --interface list + +=cut + +use Getopt::Long qw/:config posix_default no_ignore_case bundling auto_help/; + +use Pod::Usage qw/pod2usage/; + +GetOptions( + \my %opt, qw/ + interface=s + impl=s + o=s + w +/) or pod2usage(1); + + +unless ($opt{interface}) { + pod2usage(1); +} + +my ($type, $msg); + +if ($opt{impl}) { + $msg = emit_impl_header($opt{interface}, $opt{impl}); + $type = $opt{impl}; +} else { + $msg = emit_interface_header($opt{interface}); + $type = $opt{interface}; +} + +$msg .= emit_last($type); + +unless ($opt{w} || $opt{o}) { + print $msg; + exit 0; +} + +my $emit_file; + +if ($opt{o}) { + $emit_file = $opt{o}; +} else { + $emit_file = "$type.h" +} + + +open my $fh, '>', $emit_file; +print $fh $msg; +close $fh; + +sub emit_interface_header { + my $interface_name = shift; + return "typedef struct $interface_name {\n"; +} + +sub emit_impl_header { + my ($interface_name, $impl_name) = @_; + return "typedef struct $impl_name impl $interface_name {\n"; +} + +sub emit_last { + my $type = shift; + my $msg = " __code next(....);\n"; + $msg .= "} $type;\n"; + return $msg; +} diff -r 720e9c0936e0 -r 9a4279c88aa7 trans_impl.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/trans_impl.pl Fri Mar 06 14:59:59 2020 +0900 @@ -0,0 +1,244 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/lib"; +use Gears::Util; + +use Getopt::Std; +use File::Spec; + +my %opt; +getopts("wo:" => \%opt); + +my $impl_file = shift or die 'require impl file'; +my $impl_ir = Gears::Util->parse_with_separate_code_data_gears(File::Spec->rel2abs($impl_file)); +my $interface_file = Gears::Util->find_using_interface_header($impl_ir->{isa},"$FindBin::Bin/.."); + +my $inter_ir = Gears::Util->parse_with_separate_code_data_gears($interface_file); + +my $interface_var_name = shift @{$inter_ir->{data}}; + +if ($interface_var_name =~ /union\s*Data\*\s*(\w+)/) { + $interface_var_name = $1; +} + +my $impl_var_name = decamelize($impl_ir->{name}); + +my $interface = {ir => $inter_ir, var_name => $interface_var_name}; +my $impl = {ir => $impl_ir, var_name => $impl_var_name}; + +my $output_file = $impl_file; +$output_file =~ s/\.h/.cbc/; +my $stdout = *STDOUT; + +if ($opt{w}) { + if(-f $output_file) { + update_file($output_file, $interface, $impl, $impl_file); + exit 0; + } + open $stdout, '>', $output_file; +} elsif ($opt{o}) { + if(-f $opt{o}) { + update_file($opt{o}, $interface, $impl, $impl_file); + exit 0; + } + open $stdout, '>', $opt{o}; +} + +emit_include_part($stdout, $inter_ir->{name}); +emit_impl_header_in_comment($stdout, $impl_file); +emit_constracutor($stdout,$impl,$interface); +emit_code_gears($stdout,$impl,$interface); +close $stdout; + +sub emit_include_part { + my ($out, $interface) = @_; + print $out <<"EOF" +#include "../context.h" +#interface "$interface.h" + +EOF +} + +sub emit_impl_header_in_comment { + my ($out, $impl_file) = @_; + my $line = Gears::Util->slup($impl_file); + print $out "// ----\n"; + map { print $out "// $_\n" } split /\n/, $line; + print $out "// ----\n\n"; +} + + +sub emit_constracutor { + my ($out, $impl, $interface) = @_; + + my $impl_ir = $impl->{ir}; + my $inter_ir = $interface->{ir}; + my $impl_var_name = $impl->{var_name}; + my $interface_var_name = $interface->{var_name}; + + my @inter_data = @{$inter_ir->{data}}; + my @impl_data = @{$impl_ir->{data}}; + + print $out <<"EOF"; +$impl_ir->{isa}* create$impl_ir->{name}(struct Context* cbc_context) { + struct $impl_ir->{isa}* $interface_var_name = new $impl_ir->{isa}(); + struct $impl_ir->{name}* $impl_var_name = new $impl_ir->{name}(); + $interface_var_name->$interface_var_name = (union Data*)$impl_var_name; +EOF + + for my $datum (@impl_data) { + $datum =~ s|//[\s\w]+||; + if ($datum =~ /^\s+#/) { + next; + } + + if ($datum =~ /\w+\s\w+\*\s(\w+)/) { + print $out " ${impl_var_name}->$1 = NULL;\n"; + next; + } + if ($datum =~ /\w+\s\w+\s(\w+)/) { + print $out " ${impl_var_name}->$1 = 0;\n"; + } + + if ($datum =~ /\w+(\*)?\s(\w+)/) { + my $is_pointer = $1; + my $var_name = $2; + if ($1) { + print $out " ${impl_var_name}->$var_name = NULL;\n"; + } else { + print $out " ${impl_var_name}->$var_name = 0;\n"; + } + } + } + + + for my $code (@{$impl_ir->{codes}}) { + my $code_gear = $code->{name}; + next if $code_gear eq 'next'; + print $out " ${impl_var_name}->$code_gear = C_$code_gear;\n" + } + + for my $code (@{$inter_ir->{codes}}) { + my $code_gear = $code->{name}; + next if $code_gear eq 'next'; + print $out " ${interface_var_name}->$code_gear = C_$code_gear$impl_ir->{name};\n" + } + +print $out " return $interface_var_name;\n"; +print $out "}\n"; +} + + +sub emit_code_gears { + my ($out, $impl, $interface) = @_; + + my $inter_ir = $interface->{ir}; + my $impl_ir = $impl->{ir}; + + my $impl_name = $impl_ir->{name}; + my $interface_name = $inter_ir->{name}; + + my $impl_var_name = $impl->{var_name}; + my $interface_var_name = $interface->{var_name}; + + my @inter_data = @{$inter_ir->{data}}; + + my $data_gear_types = {}; + + if (defined $impl_ir->{codes}) { + replace_code_gears($impl_ir,$impl_name,$interface_name,1,$out); + } + replace_code_gears($inter_ir,$impl_name,$interface_name,0,$out); +} + +sub replace_code_gears { + my ($ir, $impl, $interface_name, $is_impl, $out) = @_; + + my $replace_impl = $is_impl ? $impl : $interface_name; + + for my $cg (@{$ir->{codes}}) { + next if ($cg->{name} eq 'next'); + my $data_gears = $cg->{args}; + while ($data_gears =~ /Type\*\s*(\w+),/g) { + $data_gears =~ s/Type\*/struct $replace_impl*/; + } + + if ($is_impl) { + while ($data_gears =~ /Isa\*\s*(\w+),/g) { + $data_gears =~ s/Isa\*/struct $interface_name*/; + } + } else { + $data_gears =~ s/Impl/struct $impl/g; + } + print $out "__code $cg->{name}"; + unless ($is_impl) { + print $out $impl; + } + print $out "("; + print $out "$data_gears) {\n\n"; + _emit_cg($out,$data_gears); + } +} + + +sub _emit_cg { + my ($out, $data_gears) = @_; + my @cg = (); + while ($data_gears =~ /__code ([\w(\.)\*\s,]+?\)),?/g) { + push(@cg, $1); + } + if (@cg) { + if (@cg == 2) { + print $out " if (:TODO:) {\n"; + print $out " goto ",shift(@cg),";\n"; + print $out " }\n"; + print $out " goto ",shift(@cg),";\n"; + } else { + print $out " goto ",shift(@cg),";\n"; + } + } + print $out "}\n\n"; +} + +sub update_file { + my ($output_file, $interface, $impl, $impl_file) = @_; + my $under_code = collection_save_code_gears($output_file,$interface->{var_name}); + open my $fh, '>', $output_file; + emit_include_part($fh, $interface->{ir}->{name}); + emit_impl_header_in_comment($fh, $impl_file); + emit_constracutor($fh,$impl,$interface); + map { print $fh $_ } @{$under_code}; + close $fh; +} + +sub collection_save_code_gears { + my ($output_file,$interface_name) = @_; + open my $fh, '<', $output_file; + while (my $line = <$fh>) { + if ($line =~ /\s*return $interface_name;\s*/) { + $line = <$fh>; # } skip... + last; + } + } + + my @res; + push(@res, <$fh>); + return \@res; +} + +#https://metacpan.org/pod/String::CamelCase +sub decamelize +{ + my $s = shift; + $s =~ s{([^a-zA-Z]?)([A-Z]*)([A-Z])([a-z]?)}{ + my $fc = pos($s)==0; + my ($p0,$p1,$p2,$p3) = ($1,lc$2,lc$3,$4); + my $t = $p0 || $fc ? $p0 : '_'; + $t .= $p3 ? $p1 ? "${p1}_$p2$p3" : "$p2$p3" : "$p1$p2"; + $t; + }ge; + $s; +} diff -r 720e9c0936e0 -r 9a4279c88aa7 update_implheader.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/update_implheader.pl Fri Mar 06 14:59:59 2020 +0900 @@ -0,0 +1,104 @@ +#!/usr/bibn/env perl +use strict; +use warnings; + +use Carp qw/croak/; + +my $header_file = shift // croak 'require header file!'; +my ($header_con,$interface_name) = search_slurp_header_file($header_file); + +my %cbc_code_names = ( order => 0, codes => {}); + +while (@ARGV) { + find_codes_from_cbc(shift @ARGV, $interface_name, \%cbc_code_names); +} + +map { push(@{$cbc_code_names{order_list}}, $_)} + sort { $cbc_code_names{codes}->{$a}->{order} <=> $cbc_code_names{codes}->{$b}->{order} } keys %{$cbc_code_names{codes}}; + +my $write_codes = create_new_header_codes($header_con,\%cbc_code_names); +exit unless $write_codes; +update_header($header_file,$write_codes); + +sub search_slurp_header_file { + my $header_file = shift; + + my %contents; + my %order; + my $i = 0; + my $interface_name; + + open my $fh, '<', $header_file; + + if (<$fh> =~ /struct (\w+)\s*) { + chomp $line; + if ($line =~ /\A\s*__code (\w+)\(/) { + $contents{$1} = $line; + $order{$1} = $i; + $i++; + } + } + close $fh; + my @order_code_names; + map { push(@order_code_names, $_)} sort { $order{$a} <=> $order{$b} } keys %order; + return { codes => \%contents, order => \@order_code_names }, $interface_name; +} + +sub find_codes_from_cbc { + my ($cbc_file, $inter_name, $ccn) = @_; + + open my $fh, '<', $cbc_file; + while (my $line = <$fh>) { + chomp $line; + if ($line =~ /\A\s*__code (\w+)\(/) { + my $cg_name = $1; + $line =~ s/\s*{\s*[\w\/\:]*/;/; + $line =~ s/struct $inter_name/Type/g; + $ccn->{codes}->{$cg_name} = { line =>$line, file => $cbc_file, order => $ccn->{order} }; + $ccn->{order}++; + } + } + close $fh; +} + +sub create_new_header_codes { + my ($header_con, $cbc_con) = @_; + return 0 if (@{$header_con->{order}} == $cbc_con->{order}); + + my @res; + my @hcodes = @{$header_con->{order}}; + my %cbc_codes = %{$cbc_con->{codes}}; + for my $hc (@hcodes) { + if (exists $cbc_codes{$hc}) { + push(@res, $cbc_codes{$hc}->{line}); + delete $cbc_codes{$hc}; + } + } + + push(@res, ""); + if (%cbc_codes) { + map { push(@res, $cbc_codes{$_}->{line})} sort { $cbc_codes{$a}->{order} <=> $cbc_codes{$b}->{order}} keys %cbc_codes; + } + return \@res; +} + +sub update_header { + my ($header_file,$write_codes) = @_; + open my $fh, '<', $header_file; + my $def_impl = <$fh>; + my ($impl, $interface); + if ($def_impl =~ /typedef\s*struct\s*(\w+)\s*<[\w\s,]+>\s*impl\s*(\w+)\s*{/) { + $impl = $1; + $interface = $2; + } + close $fh; + open $fh, '>', $header_file; + print $fh "typedef struct $impl impl $interface {\n"; + map { print $fh " $_\n"} @$write_codes; + print $fh " __code next(...);\n"; + print $fh "} $impl;\n"; + close $fh; +}