[Tinyos-commits] CVS: tinyos-1.x/tools/scripts/codeGeneration
AtTags.pm, NONE, 1.1 AtTagsFromXML.pm, NONE,
1.1 FindInclude.pm, NONE, 1.1 NescParser.pm, NONE,
1.1 NescProgramFiles.pm, NONE, 1.1 README, NONE,
1.1 SlurpFile.pm, NONE, 1.1 generateHood.pl, NONE,
1.1 generateNescDecls.pl, NONE, 1.1 generateRegistry.pl, NONE,
1.1 generateRpc.pl, NONE, 1.1
Kamin Whitehouse
kaminw at users.sourceforge.net
Fri Sep 23 03:16:43 PDT 2005
- Previous message: [Tinyos-commits]
CVS: tinyos-1.x/tos/lib/Rpc README, NONE, 1.1 Rpc.h,
NONE, 1.1 RpcC.nc, NONE, 1.1 RpcM.nc, NONE, 1.1
- Next message: [Tinyos-commits] CVS: tinyos-1.x/tools/make hood.extra, NONE,
1.1 nescDecls.extra, NONE, 1.1 registry.extra, NONE,
1.1 rpc.extra, NONE, 1.1
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
Update of /cvsroot/tinyos/tinyos-1.x/tools/scripts/codeGeneration
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5083
Added Files:
AtTags.pm AtTagsFromXML.pm FindInclude.pm NescParser.pm
NescProgramFiles.pm README SlurpFile.pm generateHood.pl
generateNescDecls.pl generateRegistry.pl generateRpc.pl
Log Message:
Most of these code generation scripts are for use with the tinyos-1.x/tos/lib/Hood,Registry, and Rpc libraries. The generateNescDecls.pl script generates a nescDecls.xml file, which contains all nesc declarations including types, enums, modules, module variables, rpc functions, etc. This xml file can be used for introspective pc-side tools such as pytos.
--- NEW FILE: AtTags.pm ---
# "Copyright (c) 2000-2003 The Regents of the University of California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose, without fee, and without written agreement
# is hereby granted, provided that the above copyright notice, the following
# two paragraphs and the author appear in all copies of this software.
#
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY
# OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS."
#
# @author Kamin Whitehouse
#
package AtTags;
use FindBin;
use lib $FindBin::Bin;
use SlurpFile;
use NescProgramFiles;
use FindInclude;
use NescParser;
my $tagName;
my @tagFields;
##############################
# Parse the program files and generate a @interfaces array of hashrefs,
# where each hashref represents some tagged interface.
#
# This takes four arguments:
# $includes are the set of compiler include directives
# $file is the top-level nesC application file
# $tagName is the name of the @tag
# @tagFields is an array of the fieldnames of the @$tagName struct
#
# The function returns an arrayref of hashrefs, where each hashref
# represents the data about a different instance of an interface with
# that @tag
#
# example usage:
#AtTags::getTaggedInterfaces("-I../contrib/hood/tos/lib/Registry", "TestRegistryC.nc", "attr",("attrName","attrNum");
# will return all interfaces in the "TestRegistryC" app, including
#files in contrib/hood/tos/lib/Registry, with @attr("name", 10) tags,
#if @attr is defined as struct {char* attrName; uint16_t attrNum;}
##############################
sub getTaggedInterfaces {
##############################
# The return type of this function is an array of hashrefs:
# (We also return a list of files included where interfaces were tagged)
#
# @interfaces--->%interface1--->componentName
# |->interfaceType eg. the name declared in interfaceType.nc
# |->interfaceName eg. the alias " as interfaceName"
# |->@gparams
# |->provided (==1 if provided, 0 if used)
# |->tagField1 (the name/values of the tag params)
# |->tagField2
##############################
@_ = &FindInclude::parse_include_opts( @_ ); #get rid of includes
my $file = shift @_;
($tagName, @tagFields) = @_;
#convert the tagFields array to a hashTable
my %tagFields;
for $t (@tagFields){
$tagFields{"$t"} = 1;
}
#get names of all application files in include path
my %files = NescProgramFiles::getProgramFiles($file);
#the hash table of interfaces
my @interfaces = ();
#the hash table of include files
my %includeFiles = ();
#go through each application file and find the desired @tags and
#parse the line
for $file (keys %files){
($component) = ($file =~ m|/(\w+?)\.nc$|);
my $text = &SlurpFile::scrub_c_comments( &SlurpFile::slurp_file( $file ) );
my @includes = $text =~ m/^\s*(includes\s+\w+;)/mg;
while ( $text =~
m/interface\s+(\w+)(?:<(\w+)>)?(?:\s+as\s+(\w+))?\s+\@$tagName\((.*?)\)/sg
) {
$prelude = $`;
#define an interface with these properties
my %interface;
$interface{'componentName'} = $component;
$interface{'interfaceType'} = $1;
if ($3) {
$interface{'interfaceName'} = $3;
}
else{
$interface{'interfaceName'} = $1;
}
$gparamStr = "";
if ($2){
$gparamStr = $2.",";
}
$tagFieldValues = $4;
#parse the abstract interface gparams:
my @gparams = ();
while ( $gparamStr =~ m/\s*(\w+)\s*,/g ) {
push(@gparams, $1);
}
$interface{'gparams'} = \@gparams;
#parse the @tags args:
$tagFieldValues =~ s/"//g; #get rid of "
$tagField = 0;
while ($tagFieldValues =~ m/\s*([^,\s]+)/g) {
# print $tagFieldValues.",".scalar @tagFields.",".$tagField;
if (scalar @tagFields > $tagField){
$interface{$tagFields[$tagField++]} = $1;
}
else{
die ("Error: too many arguments to \@$tagName in $interface{'componentName'}.\n");
}
}
# if (scalar @tagFields != $tagField){
# die ("Error: not enough arguments to \@$tagName in $interface{'componentName'}.\n");
# }
#figure out if this was used or provided
while ($prelude =~ m/(uses|provides)/sg ) {
if ($1 eq "provides") {
$interface{'provided'} = 1;
}
else{
$interface{'provided'} = 0;
}
}
#now add the properties of this interface to the attribute list
$interfaces[scalar @interfaces] = \%interface;
#and add any includes in this $text to the includeFiles
for my $include (@includes) {
$includeFiles{$include} = 1;
}
}
}
return (\@interfaces, \%includeFiles);
}
##############################
# Parse the program files and generate a @functions array of hashrefs,
# where each hashref represents some tagged functions.
#
# This takes four arguments:
# $includes are the set of compiler include directives
# $file is the top-level nesC application file
# $tagName is the name of the @tag
# @tagFields is an array of the fieldnames of the @$tagName struct
#
# The function returns an arrayref of hashrefs, where each hashref
# represents the data about a different instance of a functions with
# that @tag
#
# example usage:
#AtTags::getTaggedFunctions("-I../contrib/hood/tos/lib/Registry", "TestRegistryC.nc", "rpc",("rpcArgs");
# will return all interfaces in the "TestRegistryC" app, including
#files in contrib/hood/tos/lib/Registry, with @rpc("arg") tags,
#if @rpc is defined as struct {char* rpcArgs;}
##############################
sub getTaggedFunctions {
##############################
# The return type of this function is an array of hashrefs:
#
# @functions--->%function1--->componentName
# |->functionName
# |->functionType eg (command|event)
# |->returnType
# |->%paramNum--->name
# |->type
# |->size
# |->provided (==1 if provided, 0 if used)
# |->tagField1 (the name/values of the tag params)
# |->tagField2
##############################
@_ = &FindInclude::parse_include_opts( @_ ); #get rid of includes
my $file = shift @_;
($tagName, @tagFields) = @_;
#convert the tagFields array to a hashTable
my %tagFields;
for $t (@tagFields){
$tagFields{"$t"} = 1;
}
#get names of all application files in include path
my %files = NescProgramFiles::getProgramFiles($file);
#the hash table of attributes
my @functions = ();
#the hash table of include files
my %includeFiles = ();
#go through each application file and find the desired @tags and
#parse the line
for $file (keys %files){
($component) = ($file =~ m|/(\w+?)\.nc$|);
my $text = &SlurpFile::scrub_c_comments( &SlurpFile::slurp_file( $file ) );
my @includes = $text =~ m/^\s*(includes\s+\w+;)/mg;
while ( $text =~
m/(command|event)\s+([\w\s]+?\*?\s+\*?)(\w+)(\(.*?\))\s+\@$tagName\((.*?)\)/sg
) {
$prelude = $`;
#define a function with these properties
my %function;
my $type = &NescParser::parseType($2);
$function{'componentName'} = $component;
$function{'functionType'} = $1;
$function{'returnType'} = $type;
$function{'functionName'} = $3;
#parse the arguments
my $args = $4;
my %params = ();
my $paramNum = 0;
while ( $args =~ m/[\(,]\s*([\w\s]+?\*?\s+\*?)(\w+)\s*(?=[,\)])/g ) {
my %param;
my $type = &NescParser::parseType($1);
$param{'name'} = $2;
$param{'type'} = $type;
$params{"param".$paramNum++} = \%param;
}
$function{'params'} = \%params;
$function{'numParams'} = $paramNum;
#parse the @tags args:
$tagFieldValues = $5;
$tagFieldValues =~ s/"//g; #get rid of "
$tagField = 0;
while ($tagFieldValues =~ m/\s*([^,\s]+)/g) {
# print $tagFieldValues.",".scalar @tagFields.",".$tagField;
if (scalar @tagFields > $tagField){
$function{$tagFields[$tagField++]} = $1;
}
else{
die ("Error: too many arguments to \@$tagName in $function{'componentName'}.\n");
}
}
# if (scalar @tagFields != $tagField){
# die ("Error: not enough arguments to \@$tagName in $function{'componentName'}.\n");
# }
#figure out if this was used or provided
while ($prelude =~ m/(uses|provides)/sg ) {
if ($1 eq "provides") {
$function{'provided'} = 1;
}
else{
$function{'provided'} = 0;
}
}
#now add the properties of this interface to the attribute list
$functions[scalar @functions] = \%function;
#and add any includes in this $text to the includeFiles
for my $include (@includes) {
$includeFiles{$include} = 1;
}
}
}
return (\@functions, \%includeFiles);
}
##############################
# Go through all interfaces that provide the $tagName @tag and find
# all unique sets of values.
# Assume no module or only a single module may provide such an
# interface, and if a module does provide the interface, return the
# component name with the interface.
#
# example usage:
# AtTags::getUniqueTags("../nesc.xml","attr",("attrName","attrNum"));
#
# will return 3 values if there are 5 interfaces in nesc.xml with
# @attr("name", 10) tags, but only 3 of them have unique params. If any
# modules provide those interfaces, those providing modules will be
# listed as "componentName". Otherwise, the component name will be arbitrary.
##############################
sub getUniqueTags{
##############################
# The return type of this function is a hash of hashrefs, where the
#keys of the first hash is a concatenation of all tagField values.
#Thus, this return type is the same as the two above, except that all
#tagfield values are unique.
#
# %object--->tagField1tagField2--->componentName
# |->functionName
# |->provided (==1 if provided, 0 if used)
# |->tagField1 (the name/values of the tag params)
# |->tagField2
##############################
my ($interfaces, $includes) = AtTags::getTaggedInterfaces (@_);
my %tags;
# if this tagValue already exists, check for consistency with
# previous definition
for my $interface (@$interfaces){
#make the key a concatenated string of the param vals
my $key = "";
for my $field (@tagFields){
if ($interface->{$field}){
$key = sprintf "%s$interface->{$field}", $key;
}
}
#if this $key already exists, check for disparities
if ($tags{"$key"}){
my $prevDef = $tags{"$key"};
#make sure the types are the same
my $oops = 0;
if (scalar @{$interface->{'gparams'}} ne scalar @{$prevDef->{'gparams'}}){
$oops = 1;
}
my $i = 0;
while ($i < scalar @{$interface->{'gparams'}} ) {
if ($interface->{'gparams'}->[$i] ne $prevDef->{'gparams'}->[$i] || ($oops==1) ){
die "ERROR: Two components use the same \@$tagName tag with different types: $prevDef->{'componentName'}.$prevDef->{'interfaceName'} and $interface{'componentName'}.$interface{'interfaceName'}";
}
$i++;
}
#if this tagValue is provided by some module, continue to use that
if ($prevDef->{'provided'} == 1){
if($interface->{'provided'} == 1){
die "ERROR: Only one component can provide the tag \@$tagName in: $prevDef->{'componentName'}.$prevDef->{'interfaceName'} and $interface{'componentName'}.$interface{'interfaceName'}";
}
else{
$interface->{'provided'} = 1;
$interface->{'componentName'} = $prevDef->{'componentName'};
}
}
}
#now add the properties of this interface to the tagValue list
$tags{"$key"} = $interface;
}
return (\%tags, $includes);
}
1;
--- NEW FILE: AtTagsFromXML.pm ---
package AtTagsFromXML;
##############################
# Parse the nesc.xml file and generate a %reflections hash of hashrefs,
# where each hashref represents some reflection.
#
# This takes three arguments:
# $file is the nesc.xml file to be parsed
# $tagName is the name of the @tag
# %tagFields is a hash of the fieldnames of the @$tagName struct
#
# The function returns an arrayref of hashrefs, where each hashref
# represents the data about a different instance of an interface with
# that @tag
#
# example usage: AtTags::getTaggedInterfaces("../nesc.xml","attr",("attrName","attrNum");
# will return all interfaces in nesc.xml with @attr("name", 10) tags, if
# @attr is defined as struct {char* attrName; uint16_t attrNum;}
##############################
use FindBin;
use lib $FindBin::Bin;
use FindInclude;
my $tagName;
my @tagFields;
sub getTaggedInterfaces {
@_ = &FindInclude::parse_include_opts( @_ ); #get rid of includes
my $file = shift @_;
($tagName, @tagFields) = @_;
#convert the tagFields array to a hashTable
my %tagFields;
for $t (@tagFields){
$tagFields{"$t"} = 1;
}
#load the xml file into memory
open (NESCXML, $file) || die "couldn't open $file!";
undef $/;
my $xmlText = <NESCXML>;
close(NESCXML);
#create a new xml parser
my $xs1 = XML::Simple->new();
#the hash table of attributes
my @interfaces = ();
#parsing the entire xml file is broken and slow anyway...
# ...let's manually find and parse only necessary pieces
while ( $xmlText =~ m|(<interface .*?</interface>)|sg ){
my $interfaceXML = $1;
# find all interfaces that are tagged as "registry" entries
if ( ( $interfaceXML =~ /<attribute-value>/ ) &&
( $interfaceXML =~ /<attribute-ref name="$tagName"/ ) ) {
# parse the XML entry into a hashref
my $interfaceHash = $xs1->XMLin($interfaceXML, ForceArray=>['attribute-value','structured-element']);
#print Dumper($interfaceHash);
my %interface;
$interface{'componentName'} = $interfaceHash->{'component-ref'}->{'qname'};
$interface{'interfaceName'} = $interfaceHash->{'name'};
# find the @$tagName tag and store the params (may be multiple other tags)
foreach my $atTag (@{$interfaceHash->{'attribute-value'}}) {
if ( $atTag->{'attribute-ref'}->{'name'} eq "$tagName" ) {
foreach my $param (@{$atTag->{'value-structured'}->{'structured-element'}}){
if ($tagFields{$param->{'field'}}){
$interface{"$param->{'field'}"} = $param->{'value'}->{'cst'};
$interface{"$param->{'field'}"} =~ s/^\w://;
}
else{
die "ERROR: $tagName tag with undefined field $param->{'field'} at $interface{'componentName'}.$interface{'interfaceName'}.\n";
}
}
}
}
for $fieldName (keys %fieldNames){
if (!$interface{"$fieldName"}) {
die "ERROR: @$tagName tag with no field $fieldName at $interface{'componentName'}.$interface{'interfaceName'}.\n";
}
}
$interface{'interfaceType'} = $interfaceHash->{'instance'}->{'interfacedef-ref'}->{'qname'};
$interface{'provided'} = $interfaceHash->{'provided'};
# get the interface parameter (assume a single param of type typedef)
if ($interfaceHash->{'instance'}->{'arguments'}->{'type-int'}) {
$interface{'param'} = $interfaceHash->{'instance'}->{'arguments'}->{'type-int'}->{'cname'};
} elsif ($interfaceHash->{'instance'}->{'arguments'}->{'type-tag'}) {
$interface{'param'} = $interfaceHash->{'instance'}->{'arguments'}->{'type-tag'}->{'struct-ref'}->{'name'};
}
#now add the properties of this interface to the attribute list
$interfaces[scalar @interfaces] = \%interface;
}
}
return \@interfaces;
}
##############################
# Go through all interfaces that provide the $tagName @tag and find
# all unique sets of values.
# Assume no module or only a single module may provide such an
# interface, and if a module does provide the interface, return the
# component name with the interface.
#
# example usage:
# AtTags::getUniqueTags("../nesc.xml","attr",("attrName","attrNum"));
#
# will return 3 values if there are 5 interfaces in nesc.xml with
# @attr("name", 10) tags, but only 3 of them have unique params. If any
# modules provide those interfaces, those providing modules will be
# listed as "componentName". Otherwise, the component name will be arbitrary.
##############################
sub getUniqueTags{
my $interfaces = AtTags::getTaggedInterfaces (@_);
my %tags;
# if this tagValue already exists, check for consistency with
# previous definition
for my $interface (@$interfaces){
#make the key a concatenated string of the param vals
my $key = "";
for my $field (@tagFields){
$key = sprintf "%s$interface->{$field}", $key;
}
#if this $key already exists, check for disparities
if ($tags{"$key"}){
my %prevDef = $tags{"$key"};
#make sure the types are the same
if ($interface->{'param'} ne $prevDef{'param'}){
die "ERROR: Two components use the same \@$tagName tag with different types: $prevDef{'componentName'}.$prevDef{'interfaceName'} and $prevDef{'componentName'}.$prevDef{'interfaceName'}";
}
#if this tagValue is provided by some module, continue to use that
if ($prevDef{'provided'} == 1){
if($interface->{'provided'} == 1){
die "ERROR: Only on component can provide the tag \@$tagName in: $prevDef{'componentName'}.$prevDef{'interfaceName'} and $prevDef{'componentName'}.$prevDef{'interfaceName'}";
}
else{
$interface->{'provided'} = 1;
$interface->{'componentName'} = $prevDef{'componentName'};
}
}
}
#now add the properties of this interface to the tagValue list
$tags{"$key"} = $interface;
}
return \%tags;
}
1;
--- NEW FILE: FindInclude.pm ---
package FindInclude;
use strict;
my @dirs = ();
my %found = ();
sub parse_include_opts {
my @args_in = @_;
my @args_out = ();
for my $arg (@args_in) {
if( $arg =~ /-I(.*)/ ) {
my $dir = $1;
#print "DIR = $1\n";
$dir =~ s/^\%T/$ENV{TOSDIR}/ if defined $ENV{TOSDIR};
push( @dirs, $dir );
} else {
push( @args_out, $arg );
}
}
for (@dirs) { $_ .= "/" unless /\/$/; }
#print "OUT DIRS = " . join(" ", at dirs) . "\n";
return @args_out;
}
sub find_file {
my $file = shift;
return $found{$file} if defined $found{$file};
#print "IN DIRS = " . join(" ", at dirs) . "\n";
for my $dir (@dirs ? @dirs : "") {
my $full = "$dir$file";
#print "FULL = $full\n";
return $found{$file}=$full if -f $full;
}
return undef;
}
1;
--- NEW FILE: NescParser.pm ---
# "Copyright (c) 2000-2003 The Regents of the University of California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose, without fee, and without written agreement
# is hereby granted, provided that the above copyright notice, the following
# two paragraphs and the author appear in all copies of this software.
#
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY
# OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS."
#
# @author Kamin Whitehouse
#
package NescParser;
use FindBin;
use lib $FindBin::Bin;
use SlurpFile;
use NescProgramFiles;
use FindInclude;
use XML::Simple;
use Data::Dumper;
##############################
#
##############################
sub getStructs {
##############################
# The return type of this function is an hashref of hashrefs:
#
# @structs--->
#
##############################
my $nescXml = shift @_;
if (scalar @_) {
die "ERROR: too many arguments to NescParse::getStructs";
}
#load the xml file into memory
open (NESCXML, $nescXml) || die "couldn't open $file!";
undef $/;
my $xmlText = <NESCXML>;
close(NESCXML);
#create a new xml parser
my $xs1 = XML::Simple->new();
#create the array of structs
my @structs = ();
#parsing the entire xml file is broken and slow anyway...
# ...let's manually find and parse only necessary pieces
while ( $xmlText =~ m|<struct .*?</struct>|sg ){
my $structXML = $&;
# hack, remove nesc mangling prefixing
$structXML =~ s/__nesc_keyword_//g;
my $struct = $xs1->XMLin($structXML, KeyAttr=>['key','id'], ForceArray=>['attribute-value','structured-element','function']);
if ( (exists($struct->{'name'})) && (exists($struct->{'size'})) && ($struct->{'size'} =~ m/^\w:\d+$/ )) {
push(@structs, $struct);
}
}
# print "there are %d structs\n\n",scalar @structs;
return \@structs;
}
##############################
# The following functions parse the nesc.xml and program files and generate arrays
# that represent nesC interfaces, modules, and configurations. Each
#such object is stored in a hashref.
#
# This code needs to use both the nesc.xml file and parse the actual
#program files because nesc.xml is yet incomplete: it does not provide
#function argument names, nor does it describe provided or used functions.
# example usage:
# NescParser::getInterfaces("-I../contrib/hood/tos/lib/Registry", "TestRegistryC.nc");
##############################
sub getInterfaces {
##############################
# The return type of this function is an array of hashrefs:
#
# %interfaces--->interfaceName--->interfaceName
# |->abstract
# |->@gparams
# |->functions--->function1Name--->functionType
# | |->returnType
# | |->functionName
# | |->%paramNum
# |->name
# | |->type
# | |->size
# |
# -->function2Name...
#
##############################
my $nescXml = shift @_;
if (scalar @_) {
die "ERROR: too many arguments to NescParse::getInterfaces";
}
#load the xml file into memory
open (NESCXML, $nescXml) || die "couldn't open $file!";
undef $/;
my $xmlText = <NESCXML>;
close(NESCXML);
#create a new xml parser
my $xs1 = XML::Simple->new();
#create the array of interfaces
my %interfaces = ();
#parsing the entire xml file is broken and slow anyway...
# ...let's manually find and parse only necessary pieces
while ( $xmlText =~ m|<interfacedef .*?</interfacedef>|sg ){
my $interfaceXML = $&;
my $interfaceHash = $xs1->XMLin($interfaceXML, ForceArray=>['attribute-value','structured-element','function']);
#print Dumper($interfaceHash);
#now add the parsed data to the interface
my %interface;
$interface{'interfaceName'} = $interfaceHash->{'qname'};
# print "parsing interface: $interface{'interfaceName'}\n";
#get the entire text of the file into memory
my $fileLocation = $interfaceHash->{'loc'};
$fileLocation =~ s/^.*?://;
my $text = &SlurpFile::scrub_c_comments( &SlurpFile::slurp_file( $fileLocation ) );
if ( $text !~ m/interface $interface{'interfaceName'}(<.*?>)?\s*{[^}]/ ){
#the last [^}] is there for emacs tabbing purposes
print $text;
die "ERROR: NescParser.pm found interface $interface{'interfaceName'} in xml file with no .nc file.";
}
#determine whether this is abstract and what the type param is
if ($1){
$interface{'abstract'} = 1;
my @gparams = ();
my $gparamStr = $1;
$gparamStr =~ s/<//;
$gparamStr =~ s/>/,/;
while ( $gparamStr =~ m/\s*(\w+)\s*,/g ) {
push(@gparams, $1);
}
$interface{'gparams'} = \@gparams;
}
else{
$interface{'abstract'} = 0;
}
my %functions;
while ( my ($functionName, $functionXML) = each (%{$interfaceHash->{'function'}})){
if ($text =~ m/(command|event)\s+([^();,]+\s+\*?)$functionName\s*(\(.*?\));/s ) {
$functionText = $&;
}
else{
print $text;
die "ERROR: found function $interface{'interfaceName'}.$functionName in .nc file that is not in xml file.";
}
my %function;
$function{'functionName'} = $functionName;
# print "parsing function: $interface{'interfaceName'}.$functionName\n";
#determine the function type (command|event)
$function{'functionType'} = $1;
#determine the return value
my $returnType = parseType($2);
$function{'returnType'} = $returnType;
# my $returnType = parseXmlType($functionXML->{'type-function'});
# my $returnDecl = $2;
# if ( $3 eq "*" or $4 eq "*" ) {
# $returnDecl = $returnDecl.'*';
# }
# $returnType->{'typeDecl'} = $returnDecl;
# $function{'returnType'} = $returnType;
#parse the arguments
my $args = $3;
my %params = ();
my $paramNum=0;
while ( $args =~ m/[\(,]\s*([\w\s]+?\*?\s+\*?)(\w+)\s*(?=[,\)])/g ) {
my %param;
my $type = parseType ($1);
$param{'type'} = $type;
$param{'name'} = $2;
$params{"param".$paramNum++} = \%param;
}
$function{'params'} = \%params;
$function{'numParams'} = $paramNum;
#add the function to the function hash
$functions{$functionName} = \%function;
}
#add the function hash to the interface
$interface{'functions'} = \%functions;
#now add this interface to the interface list
$interfaces{$interface{'interfaceName'}} = \%interface;
}
return \%interfaces;
}
sub getConfigurations {
%configurations = ();
return \%configurations;
}
sub getModules{
%modules = ();
return \%modules;
}
sub parseType{
###########
# this function should no be used, except that nesc.xml does not
# generate the right kind of information yet, ie this is temporary code.
#
# this function returns a hashref with four keys:
# typeClass, eg. int, pointer, struct, etc
# typeName, eg. unsigned char, TOS_Msg, etc.
# typeDecl, eg. result_t*, etc
# size
###########
$text = shift(@_);
my %type;
if ($text =~ m/^(\w+(?:\s+\w+)?)/ ){
$type{'typeName'} = $1;
}
else{
die "unable to parse type: $text\n";
}
if ($text =~ m/\*/ ){
$type{'typeClass'} = 'pointer';
$type{'typeDecl'} = $type{'typeName'}."*";
}
else{
$type{'typeClass'} = "unknown";
$type{'typeDecl'} = $type{'typeName'};
}
return \%type;
}
sub parseXmlType{
###########
# this function returns a hashref with three keys:
# typeClass, eg. int, pointer, struct, etc
# typeName, eg. unsigned char, TOS_Msg, etc.
# typeDecl, eg. result_t*, etc
# size
###########
$hash = shift(@_);
my %type;
##void type
if ( $hash->{'type-void'} ){
$type{'typeClass'} = 'void';
$type{'typeName'} = 'void';
$type{'size'} = 0;
}
##simple type
elsif ( $hash->{'type-int'} ){
$type{'typeClass'} = 'int';
$type{'typeName'} = $hash->{'type-int'}->{'cname'};
$type{'size'} = $hash->{'type-int'}->{'size'};
}
##float type
elsif ( $hash->{'type-float'} ){
$type{'typeClass'} = 'float';
$type{'typeName'} = $hash->{'type-float'}->{'cname'};
$type{'size'} = $hash->{'type-float'}->{'size'};
}
##struct type
elsif( $hash->{'type-tag'}->{'struct-ref'}){
$type{'typeClass'} = 'struct';
$type{'typeName'} = $hash->{'type-tag'}->{'struct-ref'}->{'name'};
$type{'size'} = $hash->{'type-tag'}->{'size'};
}
##pointer type
elsif( $hash->{'type-pointer'}){
$type{'typeClass'} = 'pointer';
##pointer to simple
if( $hash->{'type-pointer'}->{'type-int'}){
$type{'typeName'} = $hash->{'type-pointer'}->{'type-int'}->{'cname'};
$type{'size'} = $hash->{'type-pointer'}->{'struct-int'}->{'size'};
}
##pointer to struct
elsif( $hash->{'type-pointer'}->{'type-tag'}){
$type{'typeName'} = $hash->{'type-pointer'}->{'type-tag'}->{'struct-ref'}->{'name'};
$type{'size'} = $hash->{'type-pointer'}->{'type-tag'}->{'size'};
}
##pointer to void
elsif( $hash->{'type-pointer'}->{'type-void'}){
$type{'typeName'} = 'void';
$type{'size'} = 0;
}
}
if (! exists $type{'typeName'}){
print "ERROR did not properly parse the type of this hashref:\n";
while ( my ($key,$val) = each (%$hash) ) { print " $key => $val\n"; }
die;
}
$type{'size'} =~ s/^.://;
return \%type;
}
1;
--- NEW FILE: NescProgramFiles.pm ---
#!/usr/bin/perl -w
package NescProgramFiles;
use strict;
use FindBin;
use lib $FindBin::Bin;
use FindInclude;
use SlurpFile;
my %Opts = ( verbose => 0 );
my %deps = ();
my $depnum = 1;
sub getProgramFiles{
my $fileName = $_[0];
my $file = &FindInclude::find_file( $fileName );
$deps{$file} = $depnum++ if defined($file);
my $text = "";
my %unparsed = %deps;
while( (keys %unparsed) > 0 ) {
my @files = sort {$unparsed{$a} <=> $unparsed{$b}} keys %unparsed;
%unparsed = ();
for my $file (@files) {
my @ff = parse_file( $file );
map { $unparsed{$_} = $depnum++ } @ff;
$text .= join("\n", $file, grep {$_ ne $file} @ff) . "\n\n" if $Opts{verbose};
}
for my $dep (keys %deps) {
delete $unparsed{$dep};
}
for my $unp (keys %unparsed) {
$deps{$unp} = $unparsed{$unp};
}
}
return %deps;
#$text = join("\n",sort {$deps{$a} <=> $deps{$b}} keys %deps) . "\n" unless $Opts{verbose};
#print $text;
}
sub parse_file {
my $file = shift;
my $text = &SlurpFile::scrub_c_comments( &SlurpFile::slurp_file( $file ) );
my @files = ();
while( $text =~ m/
(?: \b interface \s+ (\w+) ) # $1 interface
| (?: \b components \s+ ([^;]+) ) # $2 components
| (?: \b includes \s+ (\w+) ) # $3 includes
| (?: \b \#include \s+ [<"] ([^>"]+) [>"] ) # $4 #include
/xg ) {
if( defined $1 ) {
push( @files, "$1.nc" );
} elsif( defined $2 ) {
my $tt = $2;
push( @files, map { "$_.nc" } ($tt =~ /(\w+)/g) );
} elsif( defined $3 ) {
push( @files, "$3.h" );
} elsif( defined $4 ) {
push( @files, $4 );
}
}
my %once = ();
return
grep { defined $_ }
map { &FindInclude::find_file($_) }
grep { my $o=$once{$_}; $once{$_}=1; !$o }
@files;
}
--- NEW FILE: README ---
directory: tinyos-1.x/tools/scripts/codeGeneration
author: kamin whitehouse
date: 9/23/05
This directory holds the generateNescDecls.pl file, which generates
the nescDecls.xml file. This file holds all nesc declarations such as
types, enums, rpc functions, modules, module variables, etc. that a
set of pc-side tools might want to use (e.g. python).
This directory also holds scripts that automatically generate files from @tags in your code:
generateRegistry.pl:
tags: @registry
files: RegistryC.nc, Registry.h
generateHood.pl:
tags: @reflection, @scribble, @hood
files: XxxHoodC.nc, Hood.h
generateRpc.pl:
tags: @rpc
files: RpcC.nc, RpcM.nc
These scripts are called by placing this directory in the
TOSMAKE_PATH, and indicating that the makefile should use the
registry.extra, hood.extra, and rpc.extra targets when the user calls
"make pc registry", "make pc hood", or "make pc rpc". hood.extra
automatically includes registry.extra because hood relies on registry.
The files FindInclude.pm, NescProgramFiles.pm, and SlurpFile.pm are
derived from the contrib/SystemC/scripts. These are only necessary
because nesC XML generation is currently underdeveloped:
1. it does not give any XML output when the missing yet
to-be-generated file causes compiler errors, even though only a
superficial parse should be required, not a full compilation.
(necessary for registry and hood).
2. it does not provide any info about tagged functions, only
interfaces (this is necessary for rpc).
3. it does not provide any info about the names of function
parameters, only parameter types (this is necessary for rpc).
4. it does not support abstract interfaces (necessary for rpc)
When nesC XML generation is completed, the AtTags.pm module can be
removed and the AtTagsFromXML.pm module can be used instead, and the 3
files mentioned above can be removed permanently.
The NescParser.pm file is currently based on perl scripts actually
parsing the nesc files, but should later be adapted to the xml files
(ie. it will not be removed like the other files above)
KNOWN LIMITATIONS:
1. The parser that I wrote may not support full nesC syntax. For
example, if you declare @tags with anything other than the expected
syntax, eg.
uses interface Interface<type> as MyInterface @registry("AttributeName");
or
uses{
interface Interface<type> as MyInterface @registry("AttributeName");
...
}
the parser may not detect it. This will be fixed once the code
generation is based on nesC-generated XML files, because the
acceptable syntax will be the same by definition. Until then, please
limit your syntax to that described above.
2. The parser does not search the complete search path for program
files. The directories it searches must be passed as -I directives
from the *.extra file. Current default is the compiler PFLAGS
variable, plus a few standard directories such as tos/types,
tos/interfaces, tos/system, and pwd. All directories that are
searched by the temporary perl parser are printed to the screen during
compilation.
3. There is a maximum number of "required" attributes that a hood can
declare, because the @hood struct must be statically defined for
parsing. That number is currently 8, and can be changed by going into
the Hood.h file (if AtTagsFromXML.pm is used) or the generateHood.pl
file (if AtTags.pm is used).
--- NEW FILE: SlurpFile.pm ---
package SlurpFile;
sub slurp_file {
my ($file) = @_;
return "" unless defined $file;
my $fh;
open $fh, "< $file" or die "ERROR, module file $file, $!, aborting.\n";
my $text = do { local $/; <$fh> };
close $fh;
return $text;
}
sub dump_file {
my ($file,$text) = @_;
my $fh;
open $fh, "> $file" or die "ERROR, writing file $file, $!, aborting.\n";
print $fh $text;
close $fh;
1;
}
sub scrub_c_comments {
my $text = shift;
$text =~ s{/\*.*?\*/}{}gs;
$text =~ s{//.*?\n}{}g;
return $text;
}
1;
--- NEW FILE: generateHood.pl ---
#!/usr/bin/perl -w
# "Copyright (c) 2000-2003 The Regents of the University of California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose, without fee, and without written agreement
# is hereby granted, provided that the above copyright notice, the following
# two paragraphs and the author appear in all copies of this software.
#
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY
# OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS."
#
# @author Kamin Whitehouse
#
use strict;
use FindBin;
use lib $FindBin::Bin;
use AtTags;
my $DestDir = "";
#get rid of extraneous arguments
my @args = @ARGV;
@ARGV = ();
while (@args){
my $arg = shift @args;
if ($arg eq "-d") {
$DestDir = shift @args;
$DestDir .= "/" unless $arg =~ m{/$};
} elsif ($arg !~ m/^-[^I]/) {
push @ARGV, $arg;
}
}
#add a few more directories that should always be on the search path
unshift ( @ARGV, "-I".$ENV{'TOSDIR'}."/types/" );
unshift ( @ARGV, "-I".$ENV{'TOSDIR'}."/interfaces/" );
unshift ( @ARGV, "-I".$ENV{'TOSDIR'}."/system/" );
unshift ( @ARGV, "-I".$ENV{'PWD'}."/" );
#make sure the user knows what's going on:
print "generateHood.pl @ARGV\n";
##############################
# look through the @registry tags to find all unique Attributes, and
#count them
##############################
my ($attributeDefs, $includes) = AtTags::getUniqueTags(@ARGV, "registry", ("attrName"));
my $count = scalar keys %$attributeDefs;
##############################
# look through the @reflection tags to find all unique Reflections
# Numbers come by default by including the Registry.h file.
##############################
my ($reflectionDefs, $includesB) = AtTags::getUniqueTags(@ARGV, "reflection", ("hoodName","reflName"));
for my $include (keys %$includesB){
$includes->{$include} = 1;
}
##############################
# look through the @scribble tags to find all unique Scribbles.
##############################
my ($scribbleDefs, $includesC) = AtTags::getUniqueTags(@ARGV, "scribble", ("hoodName","scribbleName"));
for my $include (keys %$includesC){
$includes->{$include} = 1;
}
##############################
# Continue numbering the scribbles where the attributes left off
##############################
for my $name (sort keys %$scribbleDefs ) {
my $scribble = $scribbleDefs->{$name};
$scribble->{'scribbleNum'} = $count++;
}
##############################
# look through the @hood tags to find all unique neighborhoods.
##############################
my ($hoodDefs, $includesD) = AtTags::getUniqueTags(@ARGV, "hood", ("hoodName", "numNeighbors", "requiredAttr1", "requiredAttr2", "requiredAttr3", "requiredAttr4", "requiredAttr5", "requiredAttr6", "requiredAttr7", "requiredAttr8"));
for my $include (keys %$includesD){
$includes->{$include} = 1;
}
##############################
# go through all reflections and scribbles and create a new hash of
# them for each hood. Simultaneously, crosscheck all refls vs attribute
# names and all hoodNames against actual hood defs for undefined
#names;
#
# The desired structure is:
# hoods--->Hood1--->reflections--->Refl1
# | | |
# | | |->Refl2...
# | |
# | |
# | |->scribbles----->Scribble1
# | |
# | |->Scribble2...
# |
# |
# |->Hood2...
##############################
my %hoods;
while ( my ($hoodkey, $hood) = each ( %$hoodDefs) ){
my %reflections;
my %scribbles;
my $hoodName = $hood->{'hoodName'};
$hood->{'reflections'} = \%reflections;
$hood->{'scribbles'} = \%scribbles;
my @required = ();
if ($hood->{"requiredAttr1"}) { push(@required, $hood->{"requiredAttr1"});}
if ($hood->{"requiredAttr2"}) { push(@required, $hood->{"requiredAttr2"});}
if ($hood->{"requiredAttr3"}) { push(@required, $hood->{"requiredAttr3"});}
if ($hood->{"requiredAttr4"}) { push(@required, $hood->{"requiredAttr4"});}
if ($hood->{"requiredAttr5"}) { push(@required, $hood->{"requiredAttr5"});}
if ($hood->{"requiredAttr6"}) { push(@required, $hood->{"requiredAttr6"});}
if ($hood->{"requiredAttr7"}) { push(@required, $hood->{"requiredAttr7"});}
if ($hood->{"requiredAttr8"}) { push(@required, $hood->{"requiredAttr8"});}
for my $attr (@required){
if (! $attributeDefs->{$attr} ){
die("ERROR: $hoodName requires attribute $attr, which doesn't exist.");
}
}
$hood->{'required'} = \@required;
$hoods{$hoodName} = $hood;
}
while ( my ($key, $reflDef) = each( %$reflectionDefs) ){
my $reflName = $reflDef->{'reflName'};
if (! $attributeDefs->{$reflName} ){
die ("$reflDef->{'componentName'}: ERROR: reflection \"$reflName\" defined with no corresponding attribute.\n\n");
}
my $hoodName = $reflDef->{'hoodName'};
if (! $hoods{$hoodName} ){
die ("$reflDef->{'componentName'}: ERROR: reflection \"$reflName\" defined in undefined hood \"$hoodName\".\n\n");
}
$hoods{$hoodName}->{'reflections'}->{$reflName} = $reflDef;
}
while ( my ($key, $scribbleDef) = each( %$scribbleDefs) ){
my $scribbleName = $scribbleDef->{'scribbleName'};
if ( $attributeDefs->{$scribbleName} ){
die ("$scribbleDef->{'componentName'}: ERROR: scribble \"$scribbleName\" has conflict with attribute of same name.\n\n");
}
my $hoodName = $scribbleDef->{'hoodName'};
if (! $hoods{$hoodName} ){
die ("$scribbleDef->{'componentName'}: ERROR: scribble \"$scribbleName\" defined in undefined hood \"$hoodName\".\n\n");
}
$hoods{$hoodName}->{'scribbles'}->{$scribbleName} = $scribbleDef;
}
##############################
# Number the hoods alphabetically
##############################
my $firstHoodNum = 100;
$count = 0;
for my $name (sort keys %hoods ) {
my $hood = $hoods{$name};
$hood->{'hoodNum'} = $count++;
}
##############################
# discover the number of attributes, max reflections per hood, attr
# groups, etc in order to create the Hood.h file
##############################
#total number of attributes
my $numAttributes = scalar keys %$attributeDefs;
my $numHoods = scalar keys %$hoodDefs;
my $maxReflectionsPerHood=0;
my $maxRequiredPerHood=0;
my $maxAttributeGroupSize=1;
while ( my ($hoodName, $hood) = each (%hoods) ) {
$hood->{'totalRefls'} = scalar keys(%{$hood->{'reflections'}})
+ scalar keys (%{$hood->{'scribbles'}});
if ($hood->{'totalRefls'} > $maxReflectionsPerHood ){
#max reflections per hood
$maxReflectionsPerHood = $hood->{'totalRefls'};
}
my $required = $hood->{'required'};
if (scalar @$required > $maxRequiredPerHood ){
#max required attributes per hood
$maxRequiredPerHood = scalar @$required;
}
# create attribute groups, ie. groups of attrs that are "pushed" together (one for each attribute)
if (scalar @$required > 1){
for my $attr (@$required){
my %groupHash; #use hash table to avoid duplicates in group
my $group = \%groupHash;
if ($attributeDefs->{$attr}->{'group'}) {
$group = $attributeDefs->{$attr}->{'group'};
}
for my $subAttr (@$required){
if ($attr ne $subAttr ){
$group->{$subAttr} = 1;
}
}
if (1 + scalar keys %$group > $maxAttributeGroupSize){
$maxAttributeGroupSize = 1+ scalar keys %$group;
}
$attributeDefs->{$attr}->{'group'} = $group;
}
}
}
##############################
# print out the parsed info for debugging/user knowledge
##############################
my $s;
if (keys %hoods){
while ( my ($hoodName, $hood) = each ( %hoods) ){
$s = "Adding reflections to $hoodName:\n";
my $reflections = $hood->{'reflections'};
while ( my ($reflName, $reflection) = each %$reflections ) {
if ($reflection->{'provided'}==1){
$s = sprintf "%s%30s : %s\n", $s, $reflection->{'gparams'}->[0],"$reflection->{'componentName'}.$reflName";
}
else{
$s = sprintf "%s%30s : %s\n", $s, $reflection->{'gparams'}->[0],$reflName;
}
}
print "$s\n";
$s = "Adding scribbles to $hoodName:\n";
my $scribbles = $hood->{'scribbles'};
while ( my ($scribbleName, $scribble) = each %$scribbles ) {
if ($scribble->{'provided'}==1){
$s = sprintf "%s%30s:\t\t$scribble->{'gparams'}->[0]\n", $s, "$scribble->{'componentName'}.$scribbleName";
}
else{
$s = sprintf "%s%30s:\t\t$scribble->{'gparams'}->[0]\n", $s, $scribbleName;
}
}
print "$s\n";
}
}
else{
print "** Warning: no hoods defined.\n\n";
}
##############################
# Create a warning at the top of each generated file
##############################
my $G_warning =<< 'EOF';
// *** WARNING ****** WARNING ****** WARNING ****** WARNING ****** WARNING ***
// *** ***
// *** This file was automatically generated by generateHood.pl. ***
// *** Any and all changes made to this file WILL BE LOST! ***
// *** ***
// *** WARNING ****** WARNING ****** WARNING ****** WARNING ****** WARNING ***
EOF
if (keys %hoods) {
##############################
# Generate the Hood.h file
##############################
$s = sprintf "#ifndef __HOOD_H__\n";
$s = sprintf "%s#define __HOOD_H__\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%s#include \"Registry.h\"\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%s/*********************************\n", $s;
$s = sprintf "%s* The following are the definitions of the \@tags that hood uses. \n", $s;
$s = sprintf "%s* These definitions are needed by the compiler to parse the tag parameters. \n", $s;
$s = sprintf "%s*********************************/\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%sstruct \@reflection {\n", $s;
$s = sprintf "%s char *reflName;\n", $s;
$s = sprintf "%s char *hoodName;\n", $s;
$s = sprintf "%s};\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%sstruct \@scribble {\n", $s;
$s = sprintf "%s char *scribbleName;\n", $s;
$s = sprintf "%s char *hoodName;\n", $s;
$s = sprintf "%s};\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%sstruct \@hood {\n", $s;
$s = sprintf "%s char *hoodName;\n", $s;
$s = sprintf "%s uint8_t numNeighbors;\n", $s;
$s = sprintf "%s char *requiredAttr1;\n", $s;
$s = sprintf "%s char *requiredAttr2;\n", $s;
$s = sprintf "%s char *requiredAttr3;\n", $s;
$s = sprintf "%s char *requiredAttr4;\n", $s;
$s = sprintf "%s char *requiredAttr5;\n", $s;
$s = sprintf "%s char *requiredAttr6;\n", $s;
$s = sprintf "%s char *requiredAttr7;\n", $s;
$s = sprintf "%s char *requiredAttr8;\n", $s;
$s = sprintf "%s};\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%s/*********************************\n", $s;
$s = sprintf "%s* The following typedefs are the IDs of each type entity,\n", $s;
$s = sprintf "%s* eg, attributes, reflections, hoods, etc.\n", $s;
$s = sprintf "%s* These IDs are used to identify what is being\n", $s;
$s = sprintf "%s* packed/unpacked by the data marshaller. Eg. a refl is Identified\n", $s;
$s = sprintf "%s* by the reflID and the nodeID. Typedefs are used to be\n", $s;
$s = sprintf "%s* able to change the way we identify data in the future.. \n", $s;
$s = sprintf "%s*********************************/\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%stypedef struct ReflBackend_t {\n", $s;
$s = sprintf "%s uint8_t reflID;\n", $s;
$s = sprintf "%s uint16_t nodeID;\n", $s;
$s = sprintf "%s} ReflBackend_t;\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%stypedef uint8_t ReflID_t;\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%stypedef uint8_t HoodID_t;\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%s/*********************************\n", $s;
$s = sprintf "%s* The following constants are the actual IDs of \n", $s;
$s = sprintf "%s* each hood and scribble. Hood IDs are offset by HOOD_ID_OFFSET in \n", $s;
$s = sprintf "%s* order to allow IDs for the registry, memset/memget, etc. \n", $s;
$s = sprintf "%s* Reflection IDs are the same as the attribute IDs by definition.\n", $s;
$s = sprintf "%s*********************************/\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%senum {\n", $s;
$s = sprintf "%s HOOD_ID_OFFSET = $firstHoodNum\n", $s;
$s = sprintf "%s};\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%senum {\n", $s;
$s = sprintf "%s //1 is the registry\n", $s;
$s = sprintf "%s //2 is ram query\n", $s;
$s = sprintf "%s //3 is hood query\n", $s;
$s = sprintf "%s //4 is hood transport\n", $s;
$s = sprintf "%s ALL_HOODS = 5,", $s;
while ( my ($hoodName, $hood) = each %hoods ) {
$s = sprintf "%s\n %s = %d,", $s, uc $hoodName, $hood->{'hoodNum'}+$firstHoodNum;
}
$s = sprintf "%s\b\n};\n", $s;
if (scalar keys %$scribbleDefs > 0){
$s = sprintf "%s\n", $s;
$s = sprintf "%senum {", $s;
while ( my ($scribbleKey, $scribble) = each %$scribbleDefs ) {
$s = sprintf "%s\n %s = %d,", $s, "ATTRIBUTE_".uc $scribble->{'scribbleName'}, $scribble->{'scribbleNum'};;
}
$s = sprintf "%s\b\n};\n", $s;
}
$s = sprintf "%s\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%s/*********************************\n", $s;
$s = sprintf "%s* The following constants are not currently used, but may be useful to others\n", $s;
$s = sprintf "%s*********************************/\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%senum {", $s;
while ( my ($hoodName, $hood) = each %hoods ) {
$s = sprintf "%s\n %s_NUM_NEIGHBORS = %d,", $s, uc $hoodName, $hood->{'numNeighbors'};
}
$s = sprintf "%s\b\n};\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%senum {\n", $s;
$s = sprintf "%s MAX_REFLECTIONS_PER_HOOD = $maxReflectionsPerHood,\n", $s;
$s = sprintf "%s MAX_REQUIRED_PER_HOOD = $maxRequiredPerHood,\n", $s;
$s = sprintf "%s NUM_ATTRIBUTES = $numAttributes,\n", $s;
$s = sprintf "%s MAX_ATTRIBUTES_GROUP_SIZE = $maxAttributeGroupSize\n", $s;
$s = sprintf "%s};\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%s/*********************************\n", $s;
$s = sprintf "%s* The following constants are used by HoodM.nc and HoodTransportM.nc\n", $s;
$s = sprintf "%s* This is way for the code generation mechanism to pass array parameters \n", $s;
$s = sprintf "%s* to the code, which NesC does not allow\n", $s;
$s = sprintf "%s* \n", $s;
$s = sprintf "%s* \"reflections\" is used by HoodM to know which reflections it has so\n", $s;
$s = sprintf "%s* it can clear them all when a node is removed from the hood.\n", $s;
$s = sprintf "%s* \n", $s;
$s = sprintf "%s* \n", $s;
$s = sprintf "%s* \"requiredAttrs\" is used by HoodM to know which reflections it requires so\n", $s;
$s = sprintf "%s* it can signal a new candidate when all required refls become filled.\n", $s;
$s = sprintf "%s* \n", $s;
$s = sprintf "%s* \n", $s;
$s = sprintf "%s* \"attrGroup\" is used by HoodTransportM to know which attributes are grouped\n", $s;
$s = sprintf "%s* so it can \"push\" them all simultaneously if one is pushed.\n", $s;
$s = sprintf "%s* \n", $s;
$s = sprintf "%s*********************************/\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%sconst uint8_t numReflections[$numHoods] = {", $s;
for my $name (sort keys %hoods ) {
my $hood = $hoods{$name};
$s = sprintf "%s %d,", $s, $hood->{'totalRefls'};
}
$s = sprintf "%s\b };\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%sconst uint8_t reflections[$numHoods][$maxReflectionsPerHood] = {", $s;
for my $hoodName (sort keys %hoods ) {
my $hood = $hoods{$hoodName};
$s = sprintf "%s\n%33s { ", $s, "/*$hoodName*/";
for my $name (keys %{$hood->{'reflections'}}) {
$s = sprintf "%s %s,", $s, "ATTRIBUTE_".uc $name;
}
for my $name (keys %{$hood->{'scribbles'}}) {
$s = sprintf "%s %s,", $s, "ATTRIBUTE_".uc $name;
}
$s = sprintf "%s\b },", $s;
}
$s = sprintf "%s\b\n%36s\n", $s, "};";
$s = sprintf "%s\n", $s;
$s = sprintf "%sconst uint8_t numRequired[$numHoods] = {", $s;
for my $name (sort keys %hoods ) {
my $hood = $hoods{$name};
$s = sprintf "%s %d,", $s, scalar @{$hood->{'required'}};
}
$s = sprintf "%s\b };\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%sconst uint8_t requiredAttrs[$numHoods][$maxRequiredPerHood] = {", $s;
for my $hoodName (sort keys %hoods ) {
$s = sprintf "%s\n%33s { ", $s, "/*$hoodName*/";
for my $requiredAttrName (@{$hoods{$hoodName}->{'required'}}) {
$s = sprintf "%s %s,", $s, "ATTRIBUTE_".uc $requiredAttrName;
}
$s = sprintf "%s\b },", $s;
}
$s = sprintf "%s\b\n%36s\n", $s, "};";
$s = sprintf "%s\n", $s;
$s = sprintf "%sconst uint8_t groupSize[$numAttributes] = {", $s;
for my $name (sort keys %$attributeDefs ) {
$s = sprintf "%s %d,", $s, 1 + scalar keys %{$attributeDefs->{$name}->{'group'}};
}
$s = sprintf "%s\b };\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%sconst uint8_t attrGroup[$numAttributes][$maxAttributeGroupSize] = {", $s;
for my $attrName (sort keys %$attributeDefs ) {
$s = sprintf "%s\n%33s { ", $s, "/*$attrName*/";
$s = sprintf "%s %s,", $s, "ATTRIBUTE_".uc $attrName; #the attr itself is always the first in the list
for my $attrName (keys %{$attributeDefs->{$attrName}->{'group'}}) {
$s = sprintf "%s %s,", $s, "ATTRIBUTE_".uc $attrName; #now add the rest
}
$s = sprintf "%s\b },", $s;
}
$s = sprintf "%s\b\n%36s\n", $s, "};";
$s = sprintf "%s\n", $s;
$s = sprintf "%s#endif //__HOOD_H__\n", $s;
#send the generated code out to a file
SlurpFile::dump_file( "${DestDir}Hood.h", "$G_warning$s" );
##############################
# For each hood, generate the XxxHoodC.nc file
##############################
while (my ($hoodName, $hood) = each ( %hoods) ){
my $name;
my$item;
$includes->{'includes Registry;'}=1;
$includes->{'includes Hood;'}=1;
$s = "";
for my $include (keys %$includes){
$s .= "$include\n";
}
$s = sprintf "%s\n", $s;
$s = sprintf "%sconfiguration ${hoodName}C {\n", $s;
$s = sprintf "%s provides {\n", $s;
$s = sprintf "%s interface StdControl;\n", $s;
$s = sprintf "%s interface Hood;\n", $s;
$s = sprintf "%s interface HoodManager;\n", $s;
$s = sprintf "%s\n", $s;
while ( ($name, $item) = each ( %{$hood->{'reflections'}}) ){
$s = sprintf "%s interface Reflection<$item->{'gparams'}->[0]> as $item->{'interfaceName'};\n", $s;
}
while( ($name, $item) = each ( %{$hood->{'scribbles'}}) ){
$s = sprintf "%s interface Reflection<$item->{'gparams'}->[0]> as $item->{'interfaceName'};\n", $s;
}
$s = sprintf "%s }\n", $s;
$s = sprintf "%s}\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%simplementation {\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%s components HoodTransportC;\n", $s;
$s = sprintf "%s components new HoodM ( %s, %s_NUM_NEIGHBORS+1 ) as HoodM;\n", $s, uc $hoodName, uc $hoodName;
while( ($name, $item) = each ( %{$hood->{'reflections'}}) ){
$s = sprintf "%s components new ReflectionM ( $item->{'gparams'}->[0], %s_NUM_NEIGHBORS+1 ) as $item->{'interfaceName'}M;\n", $s, uc $hoodName;
}
while( ($name, $item) = each ( %{$hood->{'scribbles'}}) ){
$s = sprintf "%s components new ReflectionM ( $item->{'gparams'}->[0], %s_NUM_NEIGHBORS+1 ) as $item->{'interfaceName'}M;\n", $s, uc $hoodName;
}
$s = sprintf "%s\n", $s;
$s = sprintf "%s StdControl = HoodTransportC;\n", $s;
$s = sprintf "%s StdControl = HoodM;\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%s Hood = HoodM.Hood;\n", $s;
$s = sprintf "%s HoodManager = HoodM.HoodManager;\n", $s;
$s = sprintf "%s\n", $s;
$s = sprintf "%s //setup hood communication\n", $s;
$s = sprintf "%s HoodM.HoodTransport -> HoodTransportC;\n", $s;
$s = sprintf "%s HoodTransportC.GenericBackend[ALL_HOODS] -> HoodM;\n", $s;
$s = sprintf "%s HoodTransportC.GenericBackend[%s] -> HoodM;\n", $s, uc $hoodName;
$s = sprintf "%s\n", $s;
while( ($name, $item) = each ( %{$hood->{'reflections'}}) ){
$s = sprintf "%s HoodM.ReflBackend[%s] -> $item->{'interfaceName'}M;\n", $s, "ATTRIBUTE_".uc $name;
}
while( ($name, $item) = each ( %{$hood->{'scribbles'}}) ){
$s = sprintf "%s HoodM.ReflBackend[%s] -> $item->{'interfaceName'}M;\n", $s, "ATTRIBUTE_".uc $name;
}
$s = sprintf "%s\n", $s;
$s = sprintf "%s //expose interfaces of reflections and scribbles\n", $s;
while( ($name, $item) = each ( %{$hood->{'reflections'}}) ){
$s = sprintf "%s StdControl = $item->{'interfaceName'}M;\n", $s, "ATTRIBUTE_".uc $name;
}
while( ($name, $item) = each ( %{$hood->{'scribbles'}}) ){
$s = sprintf "%s StdControl = $item->{'interfaceName'}M;\n", $s, "ATTRIBUTE_".uc $name;
}
$s = sprintf "%s\n", $s;
while( ($name, $item) = each ( %{$hood->{'reflections'}}) ){
$s = sprintf "%s $item->{'interfaceName'} = $item->{'interfaceName'}M;\n", $s, "ATTRIBUTE_".uc $name;
}
while( ($name, $item) = each ( %{$hood->{'scribbles'}}) ){
$s = sprintf "%s $item->{'interfaceName'} = $item->{'interfaceName'}M;\n", $s, "ATTRIBUTE_".uc $name;
}
$s = sprintf "%s}\n", $s;
#send the generated code out to a file
SlurpFile::dump_file( "${DestDir}${hoodName}C.nc", "$G_warning$s" );
}
}
--- NEW FILE: generateNescDecls.pl ---
#!/usr/bin/perl -w
# "Copyright (c) 2000-2003 The Regents of the University of California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose, without fee, and without written agreement
# is hereby granted, provided that the above copyright notice, the following
# two paragraphs and the author appear in all copies of this software.
#
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY
# OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS."
#
# @author Kamin Whitehouse
#
# this file creates an xml file with all of an applications enums and
# structs. Usage:
#
# generateNescDecls -d build/platform build/platform/app.c build/platform/nesc.xml
use XML::Simple;
use strict;
use FindBin;
use lib $FindBin::Bin;
use AtTags;
use NescParser;
my $DestDir = "";
my $mainExe = pop(@ARGV);
my $nescXml = pop(@ARGV);
my $appC = pop(@ARGV);
#get rid of extraneous arguments
my @args = @ARGV;
@ARGV = ();
while (@args){
my $arg = shift @args;
if ($arg eq "-d") {
$DestDir = shift @args;
$DestDir .= "/" unless $arg =~ m|/$|;
}
}
#make sure the user knows what's going on:
my $s = "generateNescDecls.pl -d $DestDir $appC $nescXml $mainExe";
for my $arg (@ARGV) {
$s = sprintf "%s %s", $s, $arg;
}
print $s, "\n";
##############################
# load the struct definitions
##############################
#my $structs;
my $structs = NescParser::getStructs($nescXml);
#print "there are %d structs\n\n",scalar keys %$structs;
##############################
# load the enums
##############################
#load the app.c file into memory
open (APPC, $appC) || die "couldn't open $appC!";
undef $/;
my $appText = <APPC>;
close(APPC);
my %enums = ();
my @enumArray = ();
my @namedEnums = ();
#first, find each enum declaration
while ( $appText =~ m|enum\s+(\w+)\s+{(.+?)}|sg ){ #}
my $enumName = $1;
my $enumDecls = $2.",";
my @newEnums = ();
#print "found enum $enumName: $enumDecls\n";
#then, find each enum within that declaration
while ( $enumDecls =~ m|([^,]+),|g ) {
my $enumStr = $1;
#print "parsing $enumStr\n";
#choose only those that have an assigned value and have valid names
if ($enumStr =~ m/\s*(\w+)\s*=\s*(.+?)(\s*)$/){
my %enumHash = ();
$enumHash{name} = $1;
$enumHash{value} = $2;
#be consistent with nesc generator and print I: before ints
if ( $enumHash{value} =~ m/^\d+$/ ){
$enumHash{value} = "I:".$enumHash{value};
}
#print "adding $enumHash{name} = $enumHash{value}\n";
push(@newEnums, \%enumHash);
}
}
#add these enums to the global list
for my $e (@newEnums) {
push(@enumArray, $e);
}
#if this is a named enum, also add it as such
if ( ($enumName !~ m/__nesc_unnamed/) && (scalar @newEnums > 0) ) {
#print "adding named enum: $enumName\n";
my %tmpHash = ();
$tmpHash{name} = $enumName;
$tmpHash{enum} = \@newEnums;
push(@namedEnums, \%tmpHash);
}
}
$enums{enum} =\@enumArray;
$enums{namedEnum} =\@namedEnums;
##############################
# load the typedefs
##############################
my %typedefs = ();
my @typedefArray = ();
#find all single line typedefs
while ( $appText =~ m|typedef\s+([\w\s]*?)\s+(\w+);|g ) {
my %typedef;
$typedef{name} = $2;
$typedef{value} = $1;
if ( $typedef{value} !~ m/__nesc_unnamed/){
push(@typedefArray, \%typedef);
}
}
#find all struct typedefs
while ( $appText =~ m|typedef\s+struct\s+(\w+)\s+{.*?}[^;]*?(\w+);|sg ){
my %typedef;
$typedef{name} = $2;
$typedef{value} = $1;
if ( $typedef{value} !~ m/__nesc_unnamed/){
push(@typedefArray, \%typedef);
}
}
$typedefs{typedef} =\@typedefArray;
##############################
# load the ram symbols
##############################
my %ramsymbols = ();
my @ramsymbolArray = ();
#make this a little faster by reducing the size of app.c
my $brief = '';
my @lines = $appText =~ m|^\s*(\w[\w\s]+?\*?\s+\*?[\w\$]+(\[.*?\])?(?:\s*=.*?)?;)\s*$|mg;
for my $line (@lines) {
if (!$line || $line =~ m/^\s*return\s+/){
next;
}
$brief .= sprintf("%s\n",$line);
}
my $objdump = "avr-objdump";
my $symtab = `$objdump -t $mainExe`;
if ($? == 0) {
while ($symtab =~ m/^\s*(\S+)\s+[\w\s]+\s+\.(?:data|bss)\s+(\S+)\s+(\S+)\s*$/mg ) {
my ($addr,$size,$sym) = ($1,$2,$3);
my $name = $sym;
if ($name =~ m/\$/ && hex($size) > 0){
my $nameRegexp = $name;
$nameRegexp =~ s/\$/\\\$/;
if ( $brief =~ m|^\s*(\w[\w\s]+?\*?\s+\*?)$nameRegexp(\[.*?\])?(?:\s*=.*?)?;\s*$|m){
my $arraySize = $2;
my $type = $1;
if ($type =~ m/static/ || $type =~ m/const /) {
next;
}
$type =~ s/volatile //;
if ($type){
$type = &NescParser::parseType($type);
$name =~ s/\$/./;
my %ramsymbol = ();
$addr =~ s/^00800/00000/;
$ramsymbol{'name'} = $name;
$ramsymbol{'address'} = hex($addr);
$ramsymbol{'length'} = hex($size);
$ramsymbol{'type'} = $type;
if ($arraySize) {
$ramsymbol{'array'} = "true";
}
push(@ramsymbolArray, \%ramsymbol);
}
}
}
}
}
$ramsymbols{ramSymbol} =\@ramsymbolArray;
##############################
# print out in XML format for the PC-side tools
##############################
open(SCHEMA, ">${DestDir}nescDecls.xml");
my $xs1 = XML::Simple->new();
my %xmlOutHash = ();
my %tmpHash = ();
$tmpHash{'struct'} = $structs;
$xmlOutHash{'structs'} = \%tmpHash;
$xmlOutHash{'enums'} = \%enums;
$xmlOutHash{'typedefs'} = \%typedefs;
$xmlOutHash{'ramSymbols'} = \%ramsymbols;
my $str = $xs1->XMLout(\%xmlOutHash, RootName=>"nescDecls", KeyAttr=>{'attribute'=>'name', 'event'=>'name', 'symbol'=>'name'}, XMLDecl=>1);
print SCHEMA $str;
close(SCHEMA);
--- NEW FILE: generateRegistry.pl ---
#!/usr/bin/perl -w
# "Copyright (c) 2000-2003 The Regents of the University of California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose, without fee, and without written agreement
# is hereby granted, provided that the above copyright notice, the following
# two paragraphs and the author appear in all copies of this software.
#
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY
# OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS."
#
# @author Kamin Whitehouse
# @author Cory Sharp
use strict;
use FindBin;
use lib $FindBin::Bin;
use AtTags;
use SlurpFile;
my $DestDir = "";
my $useRpc = 1;
#get rid of extraneous arguments
my @args = @ARGV;
@ARGV = ();
while (@args){
my $arg = shift @args;
if (($arg eq "-DNO_RPC") || ($arg eq "-DNO_RPC_FOR_REGISTRY")) {
$useRpc = 0;
}
elsif ($arg eq "-d") {
$DestDir = shift @args;
$DestDir .= "/" unless $arg =~ m{/$};
} elsif ($arg !~ m/^-[^I]/) {
push @ARGV, $arg;
}
}
#add a few more directories that should always be on the search path
unshift ( @ARGV, "-I".$ENV{'TOSDIR'}."/types/" );
unshift ( @ARGV, "-I".$ENV{'TOSDIR'}."/interfaces/" );
unshift ( @ARGV, "-I".$ENV{'TOSDIR'}."/system/" );
unshift ( @ARGV, "-I".$ENV{'PWD'}."/" );
#make sure the user knows what's going on:
print "generateRegistry.pl @ARGV\n";
##############################
# look through the @registry tags to find all unique Attributes
##############################
my ($attributes, $includes) = AtTags::getUniqueTags(@ARGV, "registry", ("attrName"));
for my $attr (keys %$attributes) {
}
##############################
# Number the attributes alphabetically
##############################
my $count = 0;
for my $attr (sort {$a->{attrName} cmp $b->{attrName}} values %$attributes) {
$attr->{attrNum} = $count++;
$attr->{attrEnum} = "ATTRIBUTE_" . uc($attr->{attrName});
}
##############################
# print out the parsed info for debugging/user knowledge
##############################
if (keys %$attributes){
my $s = "Adding attributes to the RegistryC:\n";
while ( my ($name, $attribute) = each %$attributes ) {
if ($attribute->{'provided'}==1){
$s .= sprintf "%30s : %s\n", "$attribute->{'gparams'}->[0]", "$attribute->{'componentName'}.$name";
}
else{
$s .= sprintf "%30s : %s\n", $attribute->{'gparams'}->[0], $name;
}
}
print "$s\n";
}
else{
print "** Warning: no attributes added to the Registry.\n\n";
}
my $text;
##############################
# Generate blocks of text for Registry.h and RegistryC.nc
##############################
my $enum = "";
my $provides = "";
my $components = "";
my $wiring = "";
my $nucleus_provides = "";
my $nucleus_components = "";
my $nucleus_wiring = "";
my $rpc;
if ($useRpc) {
$rpc = '@rpc()';
}
else {
$rpc = '';
}
for my $attr (sort { $a->{attrName} cmp $b->{attrName} } values %$attributes) {
my $gparams = "";
for my $param (@{$attr->{gparams}}){
$gparams .= $param.",";
}
$gparams .= "\b";
$enum .= " $attr->{attrEnum} = $attr->{attrNum},\n";
$provides .= " provides interface Attribute<$gparams> as $attr->{attrName} $rpc;\n";
$wiring .= "\n";
if ($attr->{provided} == 1) {
$components .= " components $attr->{componentName};\n";
}
else{
$attr->{componentName} = "$attr->{attrName}C";
$components .= " components new AttributeM($gparams) as $attr->{componentName};\n";
$wiring .= " StdControl = $attr->{attrName}C;\n";
}
$wiring .= " $attr->{attrName} = $attr->{componentName};\n";
$wiring .= " AttrBackend[$attr->{attrEnum}] = $attr->{componentName};\n",
$wiring .= " RegistryM.AttrBackend[$attr->{attrEnum}] -> $attr->{componentName};\n";
$attr->{nucleusComponentName} = "$attr->{componentName}";
$attr->{nucleusInterfaceName} = "$attr->{attrName}";
$attr->{nucleusSetInterfaceName} = "$attr->{attrName}Set";
$nucleus_provides .= " provides interface Attr<$gparams> as $attr->{nucleusInterfaceName} \@nucleusAttr(\"$attr->{attrName}\");\n";
$nucleus_provides .= " provides interface AttrSet<$gparams> as $attr->{nucleusSetInterfaceName} \@nucleusAttr(\"$attr->{attrName}\");\n";
$nucleus_components .= " components new NucleusAttrWrapperC($gparams) as $attr->{nucleusComponentName};\n";
$nucleus_wiring .= "\n";
$nucleus_wiring .= " $attr->{nucleusInterfaceName} = $attr->{nucleusComponentName}.Attr;\n";
$nucleus_wiring .= " $attr->{nucleusSetInterfaceName} = $attr->{nucleusComponentName}.AttrSet;\n";
$nucleus_wiring .= " $attr->{nucleusComponentName}.Attribute -> RegistryC.$attr->{attrName};\n";
}
if( $wiring eq "" ) {
$wiring .=<<"EOF";
// There are no attributes, so wire in StdControl and AttrBackend stubs
StdControl = RegistryM;
AttrBackend[0] = RegistryM;
EOF
}
##############################
# Create a warning at the top of each generated file
##############################
my $G_warning =<< 'EOF';
// *** WARNING ****** WARNING ****** WARNING ****** WARNING ****** WARNING ***
// *** ***
// *** This file was automatically generated by generateRegistry.pl. ***
// *** Any and all changes made to this file WILL BE LOST! ***
// *** ***
// *** WARNING ****** WARNING ****** WARNING ****** WARNING ****** WARNING ***
EOF
##############################
# Generate the Registry.h file
##############################
$text = <<"EOF";
#ifndef __REGISTRY_H__
#define __REGISTRY_H__
struct \@registry {
char *attrName;
};
enum attributes {
MARSHALL_REGISTRY = 1, //marshaller data source id for the registry
$enum
};
typedef uint8_t AttrID_t;
#endif //__REGISTRY_H__
EOF
#send the generated code out to a file
SlurpFile::dump_file( "${DestDir}Registry.h", "$G_warning$text" );
##############################
# Generate the RegistryC.nc file
##############################
#$includes->{'includes Registry;'}=1;
#if ($useRpc) {
# $includes->{'includes Rpc;'}=1;
#}
my $includeStr = "";
for my $include (keys %$includes){
$includeStr .= "$include\n";
}
$text =<<"EOF";
includes Registry;
includes Rpc;
$includeStr
configuration RegistryC {
provides interface StdControl;
provides interface GenericBackend;
provides interface AttrBackend[AttrID_t];
$provides
}
implementation {
components RegistryM;
components NucleusRegistryC;
$components
GenericBackend = RegistryM;
$wiring}
EOF
#send the generated code out to a file
my $backsp = sprintf("\b");
$text =~ s/.$backsp//g;
SlurpFile::dump_file( "${DestDir}RegistryC.nc", "$G_warning$text" );
##############################
# Generate the NucleusRegistryC.nc file
##############################
$text =<<"EOF";
includes Attrs;
includes Registry;
includes Rpc;
$includeStr
configuration NucleusRegistryC {
$nucleus_provides
}
implementation {
components RegistryC;
$nucleus_components$nucleus_wiring}
EOF
#send the generated code out to a file
$backsp = sprintf("\b");
$text =~ s/.$backsp//g;
SlurpFile::dump_file( "${DestDir}NucleusRegistryC.nc", "$G_warning$text" );
--- NEW FILE: generateRpc.pl ---
#!/usr/bin/perl -w
# "Copyright (c) 2000-2003 The Regents of the University of California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose, without fee, and without written agreement
# is hereby granted, provided that the above copyright notice, the following
# two paragraphs and the author appear in all copies of this software.
#
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY
# OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS."
#
# @author Kamin Whitehouse
#
use XML::Simple;
use strict;
use FindBin;
use lib $FindBin::Bin;
use AtTags;
use NescParser;
my $DestDir = "";
my $useLeds = 0;
#get rid of extraneous arguments
my @args = @ARGV;
@ARGV = ();
while (@args){
my $arg = shift @args;
if ($arg eq "-DRPC_LEDS"){
$useLeds = 1;
}
elsif ($arg eq "-d") {
$DestDir = shift @args;
$DestDir .= "/" unless $arg =~ m{/$};
} elsif ($arg !~ m/^-[^I]/) {
push @ARGV, $arg;
}
}
#}
#add a few more directories that should always be on the search path
unshift ( @ARGV, "-I".$ENV{'TOSDIR'}."/types/" );
unshift ( @ARGV, "-I".$ENV{'TOSDIR'}."/interfaces/" );
unshift ( @ARGV, "-I".$ENV{'TOSDIR'}."/system/" );
unshift ( @ARGV, "-I".$ENV{'PWD'}."/" );
#make sure the user knows what's going on:
my $s = "generateRpc.pl ";
for my $arg (@ARGV) {
$s = sprintf "%s %s", $s, $arg;
}
print $s, "\n";
my $nescXml = pop(@ARGV);
##############################
# look through the @rpc tags to find all unique rpc instances
##############################
my ($taggedInterfaces, $includes) = AtTags::getTaggedInterfaces(@ARGV, "rpc", ());
my ($taggedFunctions, $includesB) = AtTags::getTaggedFunctions(@ARGV, "rpc", ());
for my $include (keys %$includesB){
$includes->{$include} = 1;
}
##############################
# look through the code and get definitions of all interfaces
##############################
my $interfaces = NescParser::getInterfaces($nescXml);
##############################
# load the struct definitions
##############################
#my $structs = NescParser::getStructs($nescXml);
#print "there are %d structs\n\n",scalar keys %$structs;
##############################
# go through all tagged interfaces and functions and come up with
# complete list of rpc functions
#
# The desired structure is the following, and will be used to create
# rpc.schema
#
# %rpcFunctions--->fullName--->commandNumber
# |->componentName
# |->interfaceName
# |->functionName
# |->provided
# |->functionType
# |->returnType
# |->%params
#
# where "fullName" is either moduleM.interface.func or moduleM.func.
#
# while creating this structure, we also check the validity criteria below:
##############################
my %rpcFunctions;
my %requiredFunctions;
my $fullName;
my $shouldDie=0;
# add each tagged function
for my $taggedFunction (@$taggedFunctions){
$fullName = $taggedFunction->{'componentName'}.".".$taggedFunction->{'functionName'};
checkRpcFunction($taggedFunction, $fullName);
$rpcFunctions{$fullName} = $taggedFunction;
}
# add each function in each tagged interface
for my $taggedInterface (@$taggedInterfaces){
my $interface;
my $functions;
if ($interfaces->{$taggedInterface->{'interfaceType'}}){
$interface = $interfaces->{$taggedInterface->{'interfaceType'}};
$functions = $interface->{'functions'};
}
else{
print "WARNING: rpc interface $taggedInterface->{'interfaceType'} not found.";
}
while (my ($functionName, $function) = each (%$functions) ){
my %rpc;
$rpc{'componentName'} = $taggedInterface->{'componentName'};
$rpc{'interfaceType'} = $taggedInterface->{'interfaceType'};
$rpc{'interfaceName'} = $taggedInterface->{'interfaceName'};
$rpc{'functionName'} = $functionName;
$rpc{'provided'} = $taggedInterface->{'provided'};
$rpc{'functionType'} = $function->{'functionType'};
$rpc{'returnType'} = $function->{'returnType'};
$rpc{'params'} = $function->{'params'};
if ($interface->{'abstract'}==1){
$rpc{'gparams'} = $taggedInterface->{'gparams'};
$rpc{'returnType'} = &substituteAbstractTypes($rpc{'returnType'},
$interface->{'gparams'},
$taggedInterface->{'gparams'});
$rpc{'params'} = &substituteAbstractParams($rpc{'params'},
$interface->{'gparams'},
$taggedInterface->{'gparams'});
}
$rpc{'numParams'} = $function->{'numParams'};
$fullName = $rpc{'componentName'}.".".$rpc{'interfaceName'}.".".$rpc{'functionName'};
if (checkRpcFunction(\%rpc, $fullName)){
$requiredFunctions{$fullName} = \%rpc;
}
else{
$rpcFunctions{$fullName} = \%rpc;
}
}
}
#The following variable is set in the checkRpcFunction subroutine.
#We wait until after all functions are checked before dieing so that
#we can get all error messages at once
if ($shouldDie == 1) { die "Too many errors.";}
##############################
# Number the rpc functions alphabetically
##############################
my $count = 0;
my $rpc;
for $fullName (sort keys %rpcFunctions ) {
$rpc = $rpcFunctions{$fullName};
$rpc->{'commandID'} = $count++;
}
##############################
# print out the parsed info for debugging/user knowledge.
# Simultaneously, generate each rpc function signature.
##############################
my $params;
my $bspace = sprintf "\b";
if (keys %rpcFunctions){
$s = "Adding rpc functions:\n";
for $fullName (sort keys %rpcFunctions ) {
$rpc = $rpcFunctions{$fullName};
my $signature = sprintf "%25s %s ( ", "$rpc->{'functionType'} $rpc->{'returnType'}->{'typeDecl'}", $fullName;
my $sigLength = length($signature);
$params = $rpc->{'params'};
for ($count=0; $count < $rpc->{'numParams'} ; $count++,)
{
if ($count>0){
$signature .= sprintf "\n%${sigLength}s%s,","",
$params->{"param$count"}->{'type'}->{'typeDecl'}." ".$params->{"param$count"}->{'name'};
}
else{
$signature .= sprintf "%s %s,",
$params->{"param$count"}->{'type'}->{'typeDecl'},
$params->{"param$count"}->{'name'};
}
}
$signature .= sprintf "\b )\n";
$s .= $signature;
$signature =~ s/\s+/ /g;
$signature =~ s/.$bspace/ /g;
$rpc->{'signature'} = $signature;
}
print "$s\n";
}
else{
print "** Warning: no RPC functions found.\n\n";
}
##############################
# print out in XML format for the PC-side tools
##############################
my $xs1 = XML::Simple->new();
my %xmlOutHash = ();
$xmlOutHash{'rpcFunctions'} = \%rpcFunctions;
my %tmpHash = ();
#$tmpHash{'struct'} = $structs;
#$xmlOutHash{'structs'} = \%tmpHash;
my $str = $xs1->XMLout(\%xmlOutHash, RootName=>"rpcSchema", KeyAttr=>{'attribute'=>'name', 'event'=>'name', 'symbol'=>'name'}, XMLDecl=>1);
SlurpFile::dump_file( "${DestDir}rpcSchema.xml", "$str" );
##############################
# Create a warning at the top of each generated file
##############################
my $G_warning =<< 'EOF';
// *** WARNING ****** WARNING ****** WARNING ****** WARNING ****** WARNING ***
// *** ***
// *** This file was automatically generated by generateRpc.pl. ***
// *** Any and all changes made to this file WILL BE LOST! ***
// *** ***
// *** WARNING ****** WARNING ****** WARNING ****** WARNING ****** WARNING ***
EOF
my $yellowToggle = "";
my $greenToggle = "";
my $redToggle = "";
my $Leds = "";
my $LedsC = "";
my $ledsWiring = "";
if ($useLeds) {
$yellowToggle = "call Leds.yellowToggle();";
$greenToggle = "call Leds.greenToggle();";
$redToggle = "call Leds.redToggle();";
$Leds = "interface Leds;";
$LedsC = "LedsC,";
$ledsWiring = "RpcM.Leds -> LedsC;"
}
##############################
# Generate the RpcM.nc file
##############################
$includes->{'includes Drain;'}=1;
$includes->{'includes Rpc;'}=1;
$s = "";
for my $include (keys %$includes){
$s .= "$include\n";
}
$s .= "
module RpcM {
provides {
interface StdControl;
/*** events that are rpc-able ***/
";
my $componentName="";
my $interfaceName="";
my $gparams = "";
# generate the "provides" declarations of rpc-able events
for $fullName (sort keys %rpcFunctions ) {
$rpc = $rpcFunctions{$fullName};
if ($rpc->{'provided'} == 1){
next;
}
if ($rpc->{'interfaceName'}){
if ( $componentName ne $rpc->{'componentName'} ||
$interfaceName ne $rpc->{'interfaceName'} ) {
$componentName = $rpc->{'componentName'};
$interfaceName = $rpc->{'interfaceName'};
$gparams = "";
if ($rpc->{'gparams'}){
$gparams = "<";
for my $gparam (@{$rpc->{'gparams'}}) {
$gparams .= $gparam;
}
$gparams .= ">";
}
$s = sprintf "%s interface $rpc->{'interfaceType'}$gparams as $componentName\_$interfaceName;\n", $s;
}
}
else{
print keys %$rpc;
$params = $rpc->{'params'};
$s = sprintf "%s $rpc->{'functionType'} $rpc->{'returnType'}->{'typeDecl'} $rpc->{'componentName'}_$rpc->{'functionName'} ( ", $s;
for ($count=0; $count < $rpc->{'numParams'} ; $count++)
{
$s = sprintf "%s %s %s,", $s, $params->{"param$count"}->{'type'}->{'typeDecl'}, $params->{"param$count"}->{'name'};
}
$s = sprintf "%s\b );\n", $s;
}
}
$s = sprintf "%s }
uses {
interface StdControl as SubControl;
$Leds
interface ReceiveMsg as CommandReceiveLocal;
interface SendMsg as ResponseSendMsgDrain;
// interface SendMsg as ErrorSendMsgDrain;
interface Send as DrainSend;
interface Receive as CommandReceiveDrip;
interface Drip as CommandDrip;
interface Dest;
/*** commands that are rpc-able ***/
", $s;
# generate the "uses" declarations of rpc-able commands
for $fullName (sort keys %rpcFunctions ) {
$rpc = $rpcFunctions{$fullName};
if ($rpc->{'provided'} == 0){
next;
}
if ($rpc->{'interfaceName'}){
if ( $componentName ne $rpc->{'componentName'} ||
$interfaceName ne $rpc->{'interfaceName'} ) {
$gparams = "";
if ($rpc->{'gparams'}){
$gparams = "<";
for my $gparam (@{$rpc->{'gparams'}}) {
$gparams .= $gparam;
}
$gparams .= ">";
}
$componentName = $rpc->{'componentName'};
$interfaceName = $rpc->{'interfaceName'};
$s = sprintf "%s interface $rpc->{'interfaceType'}$gparams as $componentName\_$interfaceName;\n", $s;
}
}
else{
$params = $rpc->{'params'};
$s = sprintf "%s $rpc->{'functionType'} $rpc->{'returnType'}->{'typeDecl'} $rpc->{'componentName'}_$rpc->{'functionName'} ( ", $s;
for ($count=0; $count < $rpc->{'numParams'} ; $count++)
{
$s = sprintf "%s %s %s,", $s, $params->{"param$count"}->{'type'}->{'typeDecl'}, $params->{"param$count"}->{'name'};
}
$s = sprintf "%s\b );\n", $s;
}
}
# build lists of the arguments and return sizes
my $num_rpcs = keys %rpcFunctions;
my @rpc_args_sizes = ();
my @rpc_return_sizes = ();
for $fullName (sort keys %rpcFunctions) {
$rpc = $rpcFunctions{$fullName};
my @as = ();
for( my $n=0; $n < $rpc->{numParams} ; $n++ ) {
my $p = $rpc->{params}{"param$n"}{type}{typeName};
push( @as, "sizeof($p)" );
}
push( @rpc_args_sizes, join("+", at as) || "0" );
push( @rpc_return_sizes, "sizeof($rpc->{returnType}{typeName})" );
}
my $rpc_args_elems = " " . join( ",\n ", @rpc_args_sizes );
my $rpc_return_elems = " " . join( ",\n ", @rpc_return_sizes );
my $d = '%d';
$s .=<<"EOF";
}
}
implementation {
TOS_Msg dripStore;
TOS_Msg cmdStore;
TOS_Msg responseMsgBuf;
TOS_MsgPtr responseMsgPtr;
uint16_t dripStoreLength;
uint16_t cmdStoreLength;
uint16_t queryID;
uint16_t returnAddress;
bool processingCommand;
bool sendingResponse;
static const uint8_t args_sizes[$num_rpcs] = {
$rpc_args_elems
};
static const uint8_t return_sizes[$num_rpcs] = {
$rpc_return_elems
};
command result_t StdControl.init() {
responseMsgPtr = &responseMsgBuf;
processingCommand=FALSE;
sendingResponse=FALSE;
call SubControl.init();
return SUCCESS;
}
command result_t StdControl.start() {
call SubControl.start();
call CommandDrip.init();
return SUCCESS;
}
command result_t StdControl.stop() {
return SUCCESS;
}
task void processCommand(){
RpcCommandMsg* msg = (RpcCommandMsg*)cmdStore.data;
uint8_t* byteSrc = msg->data;
uint16_t maxLength;
uint16_t id = msg->commandID;
RpcResponseMsg *responseMsg = (RpcResponseMsg*)call DrainSend.getBuffer(responseMsgPtr, &maxLength);
dbg(DBG_USR2, "processing command id %d, transaction %d\\n", msg->commandID, msg->transactionID);
$greenToggle
if ( sendingResponse == TRUE ) {
dbg(DBG_USR2, "stopped processing because sending\\n");
post processCommand();
$yellowToggle
return;
}
if ( processingCommand == TRUE ) {
dbg(DBG_USR2, "stopped processing because already processing\\n");
$yellowToggle
return;
}
else {
processingCommand = TRUE;
}
/*fill in the response message headers*/
responseMsg->transactionID = msg->transactionID;
responseMsg->commandID = msg->commandID;
responseMsg->sourceAddress = TOS_LOCAL_ADDRESS;
responseMsg->errorCode = RPC_SUCCESS;
responseMsg->dataLength = 0;
if( (id < $num_rpcs) && (msg->dataLength != args_sizes[id]) ) {
responseMsg->errorCode = RPC_GARBAGE_ARGS;
dbg(DBG_USR2, "param size doesn't match\\n");
} else if( (id < $num_rpcs) && (return_sizes[id] + sizeof(RpcResponseMsg) > maxLength) ) {
responseMsg->errorCode = RPC_RESPONSE_TOO_LARGE;
dbg(DBG_USR2,"Return type is too large for the response packet");
} else switch( id ) {
EOF
#this is the heart of rpc: parse the args, call the func, pack the return
for $fullName (sort keys %rpcFunctions ) {
$rpc = $rpcFunctions{$fullName};
$params = $rpc->{'params'};
$s = sprintf "%s\n /*** $fullName ***/\n", $s;
$s = sprintf "%s case $rpc->{'commandID'}: {\n", $s;
#get ready with a returnVal decl if necessary
if ( $rpc->{'returnType'}->{'typeName'} ne 'void') {
my $ptr = $rpc->{returnType}{typeClass} eq 'pointer' ? "*" : "";
$s .= " $rpc->{returnType}{typeName}$ptr RPC_returnVal;\n";
}
#setup the parameters
for ( $count=0 ; $count < $rpc->{'numParams'} ; $count++)
{
$s = sprintf "%s %s RPC_%s;\n", $s,
$params->{"param$count"}->{'type'}->{'typeName'}, $params->{"param$count"}->{'name'};
}
$s = sprintf "%s dbg(DBG_USR2, \"handling commandId $rpc->{'commandID'}\\n\");\n",$s;
for ( $count=0 ; $count < $rpc->{"numParams"} ; $count++)
{
my $name = "RPC_" . $params->{"param$count"}{name};
my $type = $params->{"param$count"}{type}{typeName};
$s .= " memcpy( &$name, byteSrc, sizeof($type) );\n";
$s .= " byteSrc += sizeof($type);\n" if $count != ($rpc->{numParams}-1);
}
#store the return value appropriately
$s = sprintf "%s ", $s;
if ( $rpc->{'returnType'}->{'typeName'} ne 'void') {
$s .= "RPC_returnVal = ";
}
#"call" commands or "signal" events
if ($rpc->{'functionType'} eq "command"){
$s = sprintf "%scall", $s;
}
elsif ($rpc->{'functionType'} eq "event"){
$s = sprintf "%ssignal", $s;
}
#actually invoke the function with arguments
$s = sprintf "%s $rpc->{'componentName'}_",$s;
if ( $rpc->{'interfaceName'} ){
$s = sprintf "%s$rpc->{'interfaceName'}.", $s;
}
$s = sprintf "%s$rpc->{'functionName'}( ", $s;
for ( $count=0; $count < $rpc->{'numParams'} ; $count++)
{
my $str = "RPC_".$params->{"param$count"}->{'name'};
$str = "&$str" if $params->{"param$count"}{type}{typeClass} eq "pointer";
$s .= " $str,";
}
$s = sprintf "%s\b );\n", $s;
#store the return value, if necessary
if ( $rpc->{returnType}{typeName} ne 'void') {
my $rvArg = ($rpc->{returnType}{typeClass} eq 'pointer' ? "" : "&") . "RPC_returnVal";
$s .= " memcpy( &responseMsg->data[0], $rvArg, sizeof($rpc->{returnType}{typeName}) );\n";
}
$s = sprintf "%s dbg(DBG_USR2, \"done calling the functions\\n\");\n",$s;
#mark the size of the return value
if ( $rpc->{'returnType'}->{'typeName'} ne 'void' ){
$s = sprintf "%s responseMsg->dataLength = sizeof ( %s );
dbg(DBG_USR2, \"responseMsg->dataLength = %s\\n\", responseMsg->dataLength);
dbg(DBG_USR2, \" sizeof ( %s )= %s\\n\", sizeof ( %s ));
} break;
", $s, $rpc->{'returnType'}->{'typeName'}, $d,
$rpc->{'returnType'}->{'typeName'}, $d,
$rpc->{'returnType'}->{'typeName'};
}
else {
$s = sprintf "%s dbg(DBG_USR2, \"not packing void return value\\n\");
} break;
", $s;
}
}
#phew!
$s = sprintf "%s
default:
dbg(DBG_USR2, \"found no rpc function\\n\");
responseMsg->errorCode = RPC_PROCEDURE_UNAVAIL;
}
/*** now send the response message off if necessary ***/
dbg(DBG_USR2, \"errorCode=%s,dataLength=%s\\n\",responseMsg->errorCode, responseMsg->dataLength);
dbg(DBG_USR2, \"sizeof( RpcResponseMsg ) = %s, data-transactionID= %s\\n\",sizeof (RpcResponseMsg),((uint32_t)&(responseMsg->data[0]) - (uint32_t)&(responseMsg->transactionID)));
/* if (responseMsg->errorCode == RPC_SUCCESS && responseMsg->dataLength==0){
dbg(DBG_USR2, \"done processing, no return args\\n\");
processingCommand=FALSE;
}
else if (responseMsg->errorCode == RPC_SUCCESS){
//calculate the size to be the size of the data I just added
//plus the size of the responseMsg less the data array (the data array
//can sometimes take space due to compiler packing)
if (call ResponseSendMsgDrain.send(msg->returnAddress,
responseMsg->dataLength + ( (uint32_t)&(responseMsg->data[0]) - (uint32_t)&(responseMsg->transactionID)),
responseMsgPtr) ){
dbg(DBG_USR2, \"sending response\\n\");
sendingResponse=TRUE;
}
else{
dbg(DBG_USR2, \"sending response failed\\n\");
processingCommand=FALSE;
}
}
else{*/
if (msg->responseDesired == 0){
dbg(DBG_USR2, \"no response desired; not sending response message\");
processingCommand=FALSE;
}
else if (call ResponseSendMsgDrain.send(msg->returnAddress,
responseMsg->dataLength + sizeof(RpcResponseMsg),
responseMsgPtr) ){
dbg(DBG_USR2, \"sending response\\n\");
sendingResponse=TRUE;
$redToggle
}
else{
dbg(DBG_USR2, \"sending response failed\\n\");
processingCommand=FALSE;
$yellowToggle
}
// }
dbg(DBG_USR2, \"done processing.\\n\");
}
event TOS_MsgPtr CommandReceiveDrip.receive(TOS_MsgPtr pMsg, void* payload, uint16_t payloadLength) {
RpcCommandMsg* msg = (RpcCommandMsg*)payload;
dbg(DBG_USR2, \"received drip command message\\n\");
//store the drip message for later drip rebroadcasting
memcpy(dripStore.data, payload, payloadLength);
dripStoreLength = payloadLength;
//if it is destined to us, post a task to process it
if (msg->address == TOS_LOCAL_ADDRESS || msg->address == TOS_BCAST_ADDR ) {
//store another copy for later processing
memcpy(cmdStore.data, payload, payloadLength);
cmdStoreLength = payloadLength;
if (post processCommand() == SUCCESS){
dbg(DBG_USR2, \"posted task\\n\");
}
else{
dbg(DBG_USR2, \"failed to post task\\n\");
}
}
else {
dbg(DBG_USR2, \"not posting task because not for me\\n\");
}
return pMsg;
}
event TOS_MsgPtr CommandReceiveLocal.receive(TOS_MsgPtr pMsg) {
//store the drip message for later processing
dbg(DBG_USR2, \"received local command message, len=%s\\n\",pMsg->length);
memcpy(cmdStore.data, pMsg->data, pMsg->length);
cmdStoreLength = pMsg->length;
if (post processCommand() == SUCCESS){
dbg(DBG_USR2, \"posted task\\n\");
}
else{
dbg(DBG_USR2, \"failed to post task\\n\");
}
return pMsg;
}
event result_t CommandDrip.rebroadcastRequest(TOS_MsgPtr msg, void *payload) {
dbg(DBG_USR2, \"drip rebroadcast request\\n\");
memcpy(payload, dripStore.data, dripStoreLength);
call CommandDrip.rebroadcast(msg, payload, dripStoreLength);
return SUCCESS;
}
event result_t DrainSend.sendDone(TOS_MsgPtr pMsg, result_t success) {
dbg(DBG_USR2, \"wtf!! drainSend send done\\n\");
return SUCCESS;
}
event result_t ResponseSendMsgDrain.sendDone(TOS_MsgPtr pMsg, result_t success) {
if (success == SUCCESS) {
dbg(DBG_USR2, \"drain send done: SUCCESS\\n\");
}
else{
dbg(DBG_USR2, \"drain send done: FAIL\\n\");
}
processingCommand = FALSE;
sendingResponse = FALSE;
return SUCCESS;
}
/* event result_t ErrorSendMsgDrain.sendDone(TOS_MsgPtr pMsg, result_t success) {
if (success == SUCCESS) {
dbg(DBG_USR2, \"drain error send done: SUCCESS\\n\");
}
else{
dbg(DBG_USR2, \"drain error send done: FAIL\\n\");
}
processingCommand = FALSE;
sendingResponse = FALSE;
return SUCCESS;
}*/
", $s, $d, $d, $d, $d, $d;
#now, print out all the provided events or uses commands that are required
for my $requiredFunc (values %requiredFunctions) {
$s .= sprintf(" %s %s %s.%s( ", $requiredFunc->{functionType},
$requiredFunc->{returnType}->{typeDecl},
$requiredFunc->{componentName}."_".$requiredFunc->{interfaceName},
$requiredFunc->{functionName});
for my $param (values %{$requiredFunc->{params}}) {
$s .= " $param->{type}->{typeDecl} $param->{name},";
}
$s .= "\b) { }\n";
}
$s .= "\n}
";
#send the generated code out to a file
my $backsp = sprintf "\b";
$s =~ s/.$backsp//g;
open(RPCM, ">${DestDir}RpcM.nc");
print RPCM "$G_warning$s";
close(RPCM);
##############################
# Generate the RpcC.nc file
##############################
$s = "includes Rpc;
configuration RpcC {
provides {
interface StdControl;
}
}
implementation {
components
RpcM,
GenericComm,
DrainC,
DestC,
DripC,
$LedsC
DripStateC;
";
# generate the declarations of each rpc interface or function:
my %components;
for $fullName (sort keys %rpcFunctions ) {
$rpc = $rpcFunctions{$fullName};
if (! $components{$rpc->{'componentName'}}){
$components{$rpc->{'componentName'}} = 1;
$s = sprintf "%s\n components $rpc->{'componentName'};", $s;
}
}
my %componentInterfaces;
for $fullName (sort keys %rpcFunctions ) {
my $rpc = $rpcFunctions{$fullName};
if ( $rpc->{'interfaceName'} ){
if (! $componentInterfaces{$rpc->{'componentName'}.$rpc->{'interfaceName'}}){
$componentInterfaces{$rpc->{'componentName'}.$rpc->{'interfaceName'}} = 1;
$s = sprintf "%s\n RpcM.$rpc->{'componentName'}_$rpc->{'interfaceName'}", $s;
if ($rpc->{'provided'}==1){
$s = sprintf "%s -> ", $s;
}
else{
$s = sprintf "%s <- ", $s;
}
$s = sprintf "%s$rpc->{'componentName'}.$rpc->{'interfaceName'};", $s;
}
}
else{
$s = sprintf "%s\n RpcM.$rpc->{'componentName'}_$rpc->{'functionName'}", $s;
if ($rpc->{'provided'}==1){
$s = sprintf "%s -> ", $s;
}
else{
$s = sprintf "%s <- ", $s;
}
$s = sprintf "%s$rpc->{'componentName'}.$rpc->{'functionName'};", $s;
}
}
$s = sprintf "%s
//now do all the wiring for the rpc communication:
StdControl = RpcM;
$ledsWiring
RpcM.SubControl -> GenericComm;
RpcM.SubControl -> DrainC;
RpcM.SubControl -> DripC;
//genericComm wiring
RpcM.CommandReceiveLocal -> GenericComm.ReceiveMsg[AM_RPCCOMMANDMSG];
//drip wiring
RpcM.CommandReceiveDrip -> DripC.Receive[AM_RPCCOMMANDMSG];
RpcM.CommandDrip -> DripC.Drip[AM_RPCCOMMANDMSG];
DripC.DripState[AM_RPCCOMMANDMSG] -> DripStateC.DripState[unique(\"DripState\")];
RpcM.Dest -> DestC;
//drain wiring
RpcM.ResponseSendMsgDrain -> DrainC.SendMsg[AM_RPCRESPONSEMSG];
// RpcM.ErrorSendMsgDrain -> DrainC.SendMsg[AM_RPCERRORMSG];
RpcM.DrainSend -> DrainC.Send[AM_RPCRESPONSEMSG];
}
", $s;
#send the generated code out to a file
$s =~ s/.$backsp//g;
open(RPCC, ">${DestDir}RpcC.nc");
print RPCC "$G_warning$s";
close(RPCC);
############################
# Substitute abstract params
# This function is only here to pass a hashref by value
############################
sub substituteAbstractParams{
my ($params, $typeNames, $typeVals) = @_;
my %newParams = ();
my $i = 0;
for my $name (keys %{$params}) {
my $param = $params->{$name};
my %newParam = ();
$newParam{'name'} = $param->{'name'};
$newParam{'type'} = &substituteAbstractTypes($param->{'type'},
$typeNames,
$typeVals);
$newParams{$name} = \%newParam;
$i++;
}
return \%newParams;
}
############################
# Match a type with an abstract type definition and, if it matches
# substitute the type parameter used when the interface was declared
############################
sub substituteAbstractTypes{
my ($type, $typeNames, $typeVals) = @_;
my $i = 0;
for my $typeName (@{$typeNames}) {
if ( $type->{typeName} eq $typeName ) {
return &NescParser::parseType($typeVals->[$i]);
}
$i++;
}
return $type
}
#############################
# check the following criteria of any rpc function:
# 1. any provided rpc interface has only commands
# 2. any used rpc interface has only events
# 3. all rpc commands and events are provided
# 4. no rpc function has void* param or return types
# 5. no rpc function defined in generic modules
##############################
sub checkRpcFunction {
my ($rpc, $fullName) = @_;
#if this is an interface function, provided/used depends on command/event
if ( $rpc->{'interfaceName'}){
if ($rpc->{'provided'}==1 &&
$rpc->{'functionType'} eq 'event'){
print "WARNING: rpc function $fullName is an event in a provided interface; it is now being handled by RpcM.\n";
return 1;
}
elsif ( $rpc->{'provided'}==0 &&
$rpc->{'functionType'} eq 'command'){
print "WARNING: rpc function $fullName is a command in a used interface; it is now being handled by RpcM.\n";
return 1;
}
}
#if this is a function not in an interface, it must be provided
else{
if ($rpc->{'provided'}==0 ){
print "ERROR: rpc function $fullName is used; it cannot be tagged \@rpc.\n";
$shouldDie = 1;
}
}
if ( $rpc->{'returnType'}->{'typeName'} eq 'void' &&
$rpc->{'returnType'}->{'typeClass'} eq 'pointer'){
print "ERROR: rpc function $fullName returns a void*.\n";
$shouldDie = 1;
}
for my $param (values %{$rpc->{'params'}}){
if ($param->{'type'}->{'typeName'} eq 'void' &&
$param->{'type'}->{'typeClass'} eq 'pointer'){
print "ERROR: rpc function $fullName has a void* parameter.\n";
$shouldDie = 1;
}
}
}
- Previous message: [Tinyos-commits]
CVS: tinyos-1.x/tos/lib/Rpc README, NONE, 1.1 Rpc.h,
NONE, 1.1 RpcC.nc, NONE, 1.1 RpcM.nc, NONE, 1.1
- Next message: [Tinyos-commits] CVS: tinyos-1.x/tools/make hood.extra, NONE,
1.1 nescDecls.extra, NONE, 1.1 registry.extra, NONE,
1.1 rpc.extra, NONE, 1.1
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the Tinyos-commits
mailing list