ExternalVendorCode/trick
1
0
Fork 0
mirror of https://github.com/nasa/trick.git synced 2024-12-18 20:57:55 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity
e649692e89
trick/bin/dd_convert
Alex Lin f0c594f841 Initial commit of everything.
2015-02-26 09:02:31 -06:00

722 lines
32 KiB
Perl
Executable File
Raw Blame History

#!/usr/bin/perl
use strict ;
use English ;
use File::Basename ;
my ($language) ;
# catalog stuff
our (%attr_type) ; # key=<attribute.variable> val=<type>
our (%attr_unit) ; # key=<attribute.variable> val=<unit>
our (%attr_size) ; # key=<attribute.variable> val=<size>
our (%attr_dims) ; # key=<attribute.variable> val=<dims>
# save a mapping of what is produced
my (%result_map) ; # key=<original .d filename + Default_data .d filename> val=<source filename + type + object>
$OUTPUT_AUTOFLUSH = 1 ; # always flush when printing to console
#-----------------------------------------------------------
# print help text if -h or --help is 1st arg
if (($ARGV[0] eq "-h") || ($ARGV[0] eq "--help")) {
print "-------------------------------------------------------------------------------------\n" ;
print " dd_convert\n" ;
print " A perl script to convert .d file(s) to C or C++ source code.\n" ;
print "-------------------------------------------------------------------------------------\n" ;
print "\n" ;
print " INPUT: the Trick 07.22.x (where x>0) CP generated .d file(s) contained in a directory\n" ;
print " (These files are located in the Default_data directory under the SIM directory,\n" ;
print " but a different default data directory can be specified.)\n" ;
print "\n" ;
print " OUTPUT: all output is placed in the directory used for input (the default is Default_data)...\n" ;
print " 1. C (<name>.c) or C++ (<name>.cpp) source code file in new src subdirectory\n" ;
print " <name> has the form dd___<datatype>___<simobject>___<variable>\n" ;
print " language is determined by header file (.h or .hh) containing the data type\n" ;
print " 2. dd_catalog file used by dd_convert that contains all of sim's data type info\n" ;
print " generated by reading S_library_list and all relevant io_src files\n" ;
print " 3. dd_result_map.csv file that shows mapping of .d file to source file\n" ;
print " column1 : original user .d file name\n" ;
print " column2 : Trick generated Default_data .d file name\n" ;
print " column3 : new source file name\n" ;
print " column4 : data type name of the variable\n" ;
print " column5 : the variable name from the S_define (<simobject>.<variable>)\n" ;
print "\n" ;
print " USAGE: Specify the default data directory or one or more .d file name(s) as\n" ;
print " arguments on the command line.\n" ;
print " Run this command in your SIM directory after successful CP with Trick 07.22.x.\n" ;
print " to convert one or more .d files:\n" ;
print " dd_convert [-h|--help] [7|10] [<data_dir_name>/]<file1>[, <file2>[,...<filen>]]\n" ;
print " to convert all .d files:\n" ;
print " dd_convert [-h|--help] [7|10] [<data_dir_name>]\n" ;
print " where:\n" ;
print " -h | --help = print this text and exit\n" ;
print " 7 | 10 = generate source for use in Trick 7, or Trick 10 (default)\n" ;
print " <data_dir_name> = directory containing Trick generated .d files\n" ;
print " (when not specified, Default_data is assumed)\n" ;
print " <file1>...<filen> = Trick generated .d file name(s)\n";
print "\n" ;
print " EXAMPLES:\n" ;
print " to convert one .d file for Trick 7:\n" ;
print " dd_convert 7 S_orion_sm_eclss_hw_ws_ECLSS_ws.d\n" ;
print " to convert two .d files for Trick 10 from a different directory:\n" ;
print " dd_convert my_dd_dir/S_env_ares_us_ic_icopt.d S_env_iss_ic_icopt.d\n" ;
print " to convert all .d files for Trick 10 from Default_data directory:\n" ;
print " dd_convert\n" ;
print "\n" ;
print " NOTE: The only difference between Trick 7 vs. 10 generated source code\n" ;
print " is the data allocation method (ip_alloc vs. TMM_declare_var_1d).\n" ;
print "-------------------------------------------------------------------------------------\n" ;
exit ;
}
#-----------------------------------------------------------
# determine the target Trick version (7 or 10) from 1st arg
my ($trick_version) = 10 ; # default is 10
$ARGV[0] =~ /\d+/ ;
if ($MATCH eq $ARGV[0]) {
$trick_version = shift @ARGV ;
if ($trick_version ne 7) {
$trick_version = 10 ;
}
}
#-----------------------------------------------------------
# determine the directory we are using (assume its Default_data)
my ($default_data_dir) = "Default_data";
my $ARGC = scalar @ARGV ;
if ($ARGC eq 0) {
# no args just use Default_data directory
push @ARGV , $default_data_dir ;
}
my @dfiles = @ARGV ;
if (-d $ARGV[0]) {
# directory specified on command line - use it as default data dir
$default_data_dir = $ARGV[0] ;
$default_data_dir =~ s/\/$// ; # remove ending slash
opendir my $DIR, $default_data_dir or die "XXX dd_convert: Can't open dir on command line: \"$default_data_dir\"\n";
@dfiles = readdir $DIR ;
} else {
# file(s) specified on command line - get default dir from its path
$ARGV[0] =~ /(.*)\/(.*)/ ;
if ($1 ne "") {
$default_data_dir = $1 ;
}
}
print "Getting data files from this directory: $default_data_dir\n" ;
#-----------------------------------------------------------
# parse all io_src code files so we can handle units and allocs
# and put into a catalog file
parse_io_src() ;
#-----------------------------------------------------------
# parse the .d file contents for each .d file specified on command line
my ($file_contents) ;
my (%dfile_cfile) ; # key=<original .d filename + repeat_num> val=<new source filename>
my $argcount = 0 ;
foreach my $arg ( sort @dfiles ) {
my (@lines) ;
my $new_file_name ;
my ($c_param_name ) = "test" ;
my ($dfile, $hfile) ;
my ($main_type, $instance_name) ;
# ignore any files not ending with .d or .dd, and any Trick .d files
if (($arg !~ /\.[d]+$/) || ($arg =~ /^S_sys_/)) {
if (($arg ne ".") && ($arg ne "..")) {
print "\nIgnoring $arg\n\n";
}
next ;
# prepend default_data_dir onto filename if it's not there
} else {
if ($arg !~ /\//) {
$arg = $default_data_dir . "/" . $arg ;
}
}
print "--------------------------------------------------------------------\n" ;
print "$arg\n" ;
#-----------------------------------------------------------
# PASS 1 : parse comments from the .d file
open ( FILE, $arg ) ;
my $comment = 0 ;
my $comment_end = 0 ;
while ( <FILE> ) {
my $prevline ;
$prevline = join "", @lines[-1] ;
if ($prevline =~ /\s\*\sThis default data file was taken from:\n/) {
/\s\*\s(.*)\n/ ;
$dfile = $1 ;
print "DFILE= $dfile\n" ;
}
if ($prevline =~ /\s\*\sThe header file is:\n/) {
/\s\*\s(.*)\n/ ;
$hfile = $1 ;
print "HFILE= $hfile\n" ;
if ($hfile =~ /$\.hh/) {
$language = "cpp";
} else {
$language = "c";
}
print "LANG = $language\n" ;
}
if ($prevline =~ /\s\*\sThe type substitution is:\n/) {
/\s\*\s(.*)\s\-\>\s(.*)\n/ ;
$main_type = $1 ;
$main_type =~ s/\:\:/__/g ; # replace class colons with underscores
$instance_name = $2 ;
print "TYPE = $main_type\n" ;
print "INST = $instance_name\n" ;
}
# massage some comments to make them be processed properly in PASS2-
my $last_open = rindex $_, "\/\*";
my $last_close = rindex $_, "\*\/";
# keep track of when a comment begins and ends
if ($last_open ne -1) {
$comment = 1 ;
}
if ($last_close > $last_open) {
$comment_end = 1 ;
}
# 1) put a space between back to back C comments *//* -> */ /*
s/\*\/\/\*/\*\/ \/\*/g ;
# 2) convert // style comments to /* */ style
my $slash_slash = rindex $_, "\/\/";
if ( (($comment) && ($comment_end) && ($slash_slash > $last_open) && ($slash_slash < $last_close)) ||
(($comment) && (!$comment_end) && ($slash_slash > $last_open)) ) {
# if // occurs within /* */ comment, leave it alone
} else {
if (s/^\/\/(.*)\n/\/\* \/\/$1 \*\/\n/) { # whole line
$comment_end = 1 ;
s/\*\/\s*\*\//\*\// ; # in case it ended with /* */ comment, remove extra */
#print "NEW // WHOLE LINE\n";
} else {
if (s/\/\/(.*)\n$/\n/) { # end of line
my $eol_comment = "\/\* //" . $1 . " \*\/\n";
$eol_comment =~ s/\*\/ \*\//\*\// ; # in case it ended with /* */ comment, remove extra */
#print "NEW // END LINE\n";
#print "<$eol_comment>";
push @lines , $eol_comment ;
$comment_end = 1 ;
}
}
}
if ($comment_end) {
$comment = 0 ;
$comment_end = 0 ;
}
# change unit braces {} to <> so PASS2 can distinguish from code block braces
s/\{(.*?)\}\s*=/\<$1\> =/g ;
#print "<$_>";
push @lines , $_ ;
} # end while <FILE>
$file_contents = join "" , @lines ;
#-----------------------------------------------------------
# if no header file comment was found, then probably not built with Trick 07.22.x
if ($hfile eq "") {
print "XXX dd_convert: Expected header comments not found in \"$arg\".\n" ;
print "XXX Input must be a Trick 07.22.1 or later generated .d file (in Default_data dir), b-bye.\n" ;
exit ;
}
#-----------------------------------------------------------
# create new source file name and function name
# if this class has more than one .d file, add its repetition number to function name
# the generated .d file we are processing ($arg) has this form: S_<instance name><repetition num>_<.d filename>
# where the repetition number will only be there if there is more than one .d file for this class
# (the instance name is <sim_object>.<variable>)
$dfile =~ /(.*)\/(.*)/ ;
my $dfile_dir = $1 ;
my $dfile_name = $2 ;
$arg =~ /(.*)\/(.*)/ ;
my $arg_name = $2 ;
$arg =~ /S_$instance_name([0-9]*)_$dfile_name/ ;
my $repeat_num = $1 ;
#print "DFILE NAME($repeat_num) = $dfile_name\n" ;
my $function_name = "dd___" . "$main_type$repeat_num" . "___" . $instance_name ;
$function_name =~ s/\./___/g ; # change dot in instance name to ___
# put the new source file in src directory in same directory as .d file we are processing (presumably Default_data)
mkdir "$default_data_dir/src", 0777 unless -d "$default_data_dir/src" ;
$new_file_name = "$default_data_dir/src/$function_name" . "." . $language ;
$argcount++ ;
print "$argcount new_file_name = $new_file_name\n" ;
# result map: key=<original .d filename + Default_data .d filename> val=<source filename + type + object>
$result_map{$dfile . "," . $arg_name} = $function_name . "." .$language . "," . $main_type . "," . $instance_name ;
# no need to process this .d file if we already processed a .d file that was produced from the same (original) .d file
if (exists $dfile_cfile{$dfile . $repeat_num}) {
print "*** SKIP DFILE $dfile -> $dfile_cfile{$dfile . $repeat_num}\n";
# add a comment to the end of the source file
open ( CFILE, ">>" . $dfile_cfile{$dfile . $repeat_num} );
print CFILE "/* $main_type -> $instance_name : $new_file_name */\n" ;
close CFILE ;
next ;
}
$dfile_cfile{$dfile . $repeat_num} = $new_file_name ;
#-----------------------------------------------------------
# PASS 2 : process all statements in .d file
my @source_code ; # save all source code to print here
my @declared_local_vars = (); # save all needed local declares here
my $include_trick_alloc = 0 ; # true if an alloc() statement is present
my $include_trick_convert = 0 ; # true if a unit conversion is needed
my $indent = 4 ;
my $spaces = " " x $indent ;
while ( $file_contents =~ s/^(.*?)([;\{])//s ) {
my ($key, $type, $from_unit, $to_unit, $dims) ;
my ($left_side, $right_side) ;
my (@right_list) ;
my ($need_index) = 0 ;
my ($need_unit_conversion) = 0 ;
my $statement = $MATCH ; # $&
#-------------------------------------------------------
# print any /* */ comments and # directives
#print "\nSTMT=$statement";
# 1) comment only: a semicolon or brace occuring inside a comment made us stop there-
# find end of comment, print it, and go back to top of loop
my $last_open = rindex $statement, "\/\*";
my $last_close = rindex $statement, "\*\/";
if ($last_open > $last_close) {
$file_contents =~ s/.*?\*\///s;
push @source_code, "$statement" . "$MATCH\n";
next ;
}
# 2) comment occuring prepended to statement-
# print it and continue processing statement
while ($statement =~ s/\/\*.*?\*\///s ) {
my $comment = $MATCH ;
#print "\nCMNT=<$comment>";
push @source_code, "$comment\n";
}
# 3) preprocessor "#" directive occuring prepended to statement-
# print it and continue processing statement
while ($statement =~ s/\#.*\n?// ) {
my $comment = $MATCH ;
#print "\n####=<$comment>";
push @source_code, "$comment";
}
#-------------------------------------------------------
# if a semicolon or brace occuring inside a string made us stop there-
# go get end of statement and add it on
my $num_quotes = 0 ;
$num_quotes++ while ($statement =~ /\"/g) ;
if ($num_quotes % 2) { # odd number of quotes
$file_contents =~ s/.*?;//s;
$statement = $statement . "$MATCH\n";
}
#-------------------------------------------------------
# get any unit specification (remember we changed {} to <> in PASS1)
$from_unit = "";
if ($statement =~ s/\s*\<(.*)\>//) {
$from_unit = $1 ;
}
#-------------------------------------------------------
# handle closing brace(s) from previous if/for statement(s)-
# print each brace on its own line
my $closing_brace = 0 ;
if ($statement =~ /\}/) {
$closing_brace = 1 ;
# if this brace is in a quoted string, leave it alone
if ($num_quotes % 2) {
$closing_brace = 0 ;
}
}
if ($closing_brace) {
while ($statement =~ s/\}//) {
$indent -= 4 ;
$spaces = " " x $indent ;
push @source_code, $spaces . "}\n";
}
}
#-------------------------------------------------------
# remove any newlines or leading spaces from statement
$statement =~ s/\n//g ;
$statement =~ s/^\s*//g ;
my $original_stmt = $statement ;
#########push @source_code, "/* ORIGINAL: $original_stmt */\n" ;
#-------------------------------------------------------
# handle for/if/else statements-
# process & print up to opening brace
if ( ($statement =~ /.*(for|if)\s*\(/) || ($statement =~ /.*(else)\s*\{/) ) {
# declare the for loop variable if this is its first use
if ($statement =~ s/(.*for\s*\()(.*int\s+)(\w+)(.*)/$1$3$4/) {
my $found_var = grep(/$3/, @declared_local_vars) ;
if (! $found_var) {
#push @source_code, "\n$spaces" . "int $3 ;" ;
push @declared_local_vars, "int $3" ;
}
# get rest of for stmt
$file_contents =~ s/.*?\{//s;
push @source_code, "\n$spaces$statement" . "$MATCH\n";
# if/else statement, print as is
} else {
push @source_code, "\n$spaces$statement\n" ;
}
$indent += 4 ;
$spaces = " " x $indent ;
next ;
}
#-------------------------------------------------------
# substitute out the instance name
my $substitution_done = 0 ;
if ($language eq "cpp") {
if ($statement =~ s/$instance_name\.\s*(\.|\[)?//g) {
$substitution_done = 1 ;
}
# also substitute for address of the main_type
$statement =~ s/\&$instance_name/this/g ;
} else {
# instance has array index, do not precede it with *
if ($statement =~ s/$instance_name\s*\[/($c_param_name)\[/g) {
$substitution_done = 1 ;
}
# instance has no array index, precede it with *
if ($statement =~ s/$instance_name\s*\./(\*$c_param_name)\./g) {
$substitution_done = 1 ;
}
# also substitute for address of the main_type
$statement =~ s/\&$instance_name/$c_param_name/g ;
}
#$statement =~ /(.*)=\s*?(.*)/ ;
$statement =~ /([^=]+)=\s*(.*)/ ;
$left_side = $1;
$right_side = $2;
$left_side =~ s/\s$//;
#push @source_code, "/* LEFT: $left_side */\n" ;
#push @source_code, "/* RITE: $right_side */\n" ;
# if this is not an assignment stmt, print it and go back to top of loop
if (($left_side eq "") && ($right_side eq "")) {
push @source_code, "$spaces$statement\n" ;
next ;
}
#-------------------------------------------------------
# look up this variable's attributes if a substitution was done
if ($substitution_done) {
############push @source_code, "/* ATTRS :" ; ####################
my @left_list = split /\./, $left_side ;
#push @source_code, " split=<@left_list>";
$type = $main_type ;
foreach my $var ( @left_list ) {
$var =~ s/\s//g ; # remove spaces from var
$var =~ s/\[.*\]//g ; # remove array index from var
if ($var =~ /\(\*$c_param_name\)/) { next ;} # ignore the c name we subbed in
if ($var =~ /\($c_param_name\)/) { next ;} # ignore the c name we subbed in
$key = $type . "." . $var ;
#push @source_code, " <$key>";
$type = $attr_type{$key} ;
$to_unit = $attr_unit{$key} ;
$dims = $attr_dims{$key} ;
################push @source_code, " (type=$type, unit=$to_unit, dims=$dims)" ; ######################
}
############push @source_code, " */\n" ; #####################
}
#-------------------------------------------------------
# handle unit conversion if unit was specified (convert to lowercase so M == m)
if ( ($from_unit ne "") && (lc($from_unit) ne lc($to_unit)) ) {
############push @source_code, "/* CONVERT FROM {$from_unit} TO {$to_unit} */\n" ; ###################
push @source_code, $spaces . "conv_fn_s(\"$from_unit\" , \"$to_unit\" , &my_convert) ;\n";
$need_unit_conversion = 1 ;
}
$right_side =~ s/;//g ;
#-------------------------------------------------------
# print string assignment statement, substituting strdup() or strcpy() for the assignment
if ( $right_side =~ /\".*\"/ ) {
my $string_const = $MATCH ;
if ($dims eq 0) {
# assign into a char pointer
$right_side = "strdup(" . $string_const . ")" ;
push @source_code, "$spaces$left_side = $right_side ;\n";
} else {
# assign into a char array
$left_side = "strcpy(" . $left_side;
push @source_code, "$spaces$left_side, $right_side );\n";
}
} else {
#-------------------------------------------------------
# print alloc statement, substitute out any alloc() for:
# TMM_declare_var_1d (Trick 10) or ip_alloc (Trick 7)
if ( $right_side =~ /alloc/ ) {
# note: should have gotten $dims attribute above when substitution_done
my $temp_left = $left_side ;
my ($num_dim_specified, $cast_star, $type_star) ;
$num_dim_specified = 0 ;
while ($temp_left =~ s/\s*\[.*?\]\s*$//) {
$num_dim_specified++ ;
}
$cast_star = "*" x ($dims - $num_dim_specified) ;
$type_star = "*" x ($dims - $num_dim_specified - 1) ;
my $size = $attr_size{$key} ; # = sizeof(<type>)
if ($trick_version eq 10) {
my $type_decl = $size ;
$type_decl =~ s/sizeof\((.*)\)/$1$type_star/ ; # = <type> + any asterisks
$right_side =~ s/alloc\s*\((.*)\)/($type $cast_star)TMM_declare_var_1d\(\"$type_decl\", $1\)/ ;
} else { # trick 7
$size =~ s/sizeof\((.*)\)/sizeof\($1$type_star\)/ ; # = sizeof(<type> + any asterisks)
# for a basic C type pointer (int, double, etc) call ip_alloc
my $found_type = grep(/$type\..*/, keys %attr_type) ;
if (! $found_type) {
$right_side =~ s/alloc\s*\((.*)\)/($type $cast_star)ip_alloc\($1, $size\)/ ;
# for a pointer to user data (struct, class, etc) call ip_alloc_type
} else {
my $attr_var = "attr" . $type ;
$right_side =~ s/alloc\s*\((.*)\)/($type $cast_star)ip_alloc_type\($1, $size, $attr_var, \"$type\"\)/ ;
#@right_list[0] = $right_side ;
# first must declare an extern to the trick attributes to pass to ip_alloc_type
my $found_var = grep(/$attr_var/, @declared_local_vars) ;
if (! $found_var) {
#push @source_code, "\n$spaces" . "extern ATTRIBUTES $attr_var\[\] ;\n" ;
push @declared_local_vars, "extern ATTRIBUTES $attr_var\[\]" ;
}
}
}
push @source_code, "$spaces$left_side = $right_side ;\n";
$include_trick_alloc = 1;
} else {
#-------------------------------------------------------
# print assignment statement, and handle multiple assignment like x[0] = 1, 2, 3;
my ($index_is_integer) = 0 ;
my ($index, $offset) ;
@right_list = split /,/, $right_side ;
if ( $left_side =~ s/\[([^\]]+)\]\s*$// ) {
($index) = $1 ;
$need_index = 1 ;
$index =~ s/(^\s+|\s+$)//g ;
#push @source_code, "/* index = $index */\n" ;
if ( $index =~ /^\d+$/ ) {
$index_is_integer = 1 ;
}
}
$offset = 0 ;
foreach my $r ( @right_list ) {
$r =~ s/^\s*// ; # remove leading spaces
my ($index_print) ;
if ( $need_index ) {
if ( $index_is_integer == 1 ) {
$index_print = "\[" . ($index + $offset++) . "\]" ;
} else {
$index_print = "\[$index + " . $offset++ . "\]" ;
}
}
push @source_code, "$spaces$left_side$index_print = " ;
if ( $need_unit_conversion ) {
push @source_code, "convert_units( $r , \&my_convert ) ;\n" ;
$include_trick_convert = 1;
} else {
push @source_code, "$r ;\n" ;
}
}
}
}
} # end while file contents
# properly indent any ending braces at end of file
while ($file_contents =~ s/(.*?)\}//s) {
$indent -= 4 ;
$spaces = " " x $indent ;
push @source_code, "$1$spaces\}" ;
}
push @source_code, "$file_contents" ;
push @source_code, "\n}\n" ;
# print out source code
open ( NEWFILE, ">$new_file_name" );
print NEWFILE "/* dd_convert $arg */\n\n" ;
# includes
if ($include_trick_alloc) {
if ($trick_version eq 10) {
print NEWFILE "#include \"sim_services/MemoryManager/include/memorymanager_c_intf.h\" /* for TMM_declare_var */\n";
} else { # trick 7
print NEWFILE "#include \"sim_services/include/exec_proto.h\" /* for ip_alloc */\n";
}
}
if ($include_trick_convert) {
print NEWFILE "#include \"trick_utils/units/include/units_conv.h\" /* for unit conversion */\n";
}
print NEWFILE "#include \"$hfile\"\n\n" ; # relevant model header file
# function beginning
if ($language eq "cpp") {
print NEWFILE "void $main_type\:\:$function_name() {\n\n" ;
} else {
print NEWFILE "void $function_name( $main_type * $c_param_name ) ;\n\n" ;
print NEWFILE "void $function_name( $main_type * $c_param_name ) {\n\n" ;
}
if ($include_trick_convert) {
print NEWFILE " UnitsConvFn_t my_convert ; /* for unit conversion */\n";
}
# local variables
foreach my $v (@declared_local_vars) {
print NEWFILE " $v ;\n" ;
}
# code
print NEWFILE "\n" ;
foreach my $code (@source_code) {
print NEWFILE $code ;
}
} # end for each arg
# sort and print result_map:
# original .d file name, trick generated .d file name, dd_convert generated source file name, data type, sim object instance
my @list_map ;
while ( my ($key, $val) = each %result_map ) {
push @list_map, $key . "," . $val ;
}
open ( MAPFILE, ">$default_data_dir/dd_result_map.csv" ) ;
foreach my $item ( sort @list_map ) {
print MAPFILE "$item\n" ;
}
print "--------------------------------------------------------------------\n" ;
#-------------------------------------------------------
# parse all relevant io_src code files to get attributes and save in catalog file
# store in hashes:
# (%attr_type) # key=<attribute.variable> val=<type>
# (%attr_unit) # key=<attribute.variable> val=<unit>
# (%attr_size) # key=<attribute.variable> val=<size>
# (%attr_dims) # key=<attribute.variable> val=<dims>
sub parse_io_src() {
my ($name, $path, $suffix) ;
# catalog is built, read it and return
if (-e "$default_data_dir/dd_catalog") {
print "Reading attributes from catalog..." ;
require "$default_data_dir/dd_catalog" ;
print "done\n" ;
return 1 ;
}
# otherwise must build catalog...
# 1) determine where the io_src directories are by reading S_library_list
if (! -e "S_library_list") {
print "XXX dd_convert: S_library_list file not found - it's needed to build catalog, b-bye.\n" ;
exit ;
}
if (! -d "$default_data_dir") {
print "XXX dd_convert: Directory \"$default_data_dir\" not found - it's needed to store catalog in, b-bye.\n" ;
exit ;
}
print "Reading S_library_list to determine io_src dirs for catalog..." ;
open ( SLIBFILE, "S_library_list" ) ;
my @idir_list ;
while ( <SLIBFILE> ) {
s/\s1// ; # some files in S_library_list have a "1" after them
($name, $path, $suffix) = fileparse($_, "(.h|.hh|.c|.cc|.cpp|.d|.dd)");
if (($suffix eq ".h") || ($suffix eq ".hh")) {
my $innermost_dir = basename($path);
if ($innermost_dir eq "include") {
# if innermost dir name is include, chop it off
$path = dirname($path) ;
}
my $idir = $path . "/io_src" ;
if (! -d $idir) {
print ("XXX dd_convert: Could not find io_src directory \"$idir\"\n");
}
my $prevdir = join "", @idir_list[-1] ;
if ($idir ne $prevdir) {
push @idir_list, $idir ;
}
}
}
# add the trick io_src directories
push @idir_list, $ENV{TRICK_HOME} . "/trick_source/trick_utils/comm/io_src" ;
push @idir_list, $ENV{TRICK_HOME} . "/trick_source/trick_utils/math/io_src" ;
push @idir_list, $ENV{TRICK_HOME} . "/trick_source/sim_services/include/io_src" ;
print "done\n" ;
# 2) read attributes from each io_src file in all io_src directories
# the catalog of attributes will go in "dd_catalog" file in Default_data directory
print "Building catalog...\n" ;
open ( ATTRFILE, ">$default_data_dir/dd_catalog" );
foreach my $idir ( @idir_list ) {
opendir my $DIR, $idir or die "XXX dd_convert: Can't open io_src dir: \"$idir\"\n";
my @ls_ifiles = readdir $DIR ;
foreach my $ifilename ( @ls_ifiles ) {
# readdir returns . and .. which we ignore
if (($ifilename eq ".") || ($ifilename eq "..")) {
next ;
}
my $ifile = $idir . "/" . $ifilename ;
print "Get attributes in $ifile\n";
print ATTRFILE "#================ $ifile\n";
open ( FILE, $ifile ) ;
my ($attr, $key, $type, $var, $unit, $size, $dims) ;
# each attribute is 4 lines in the io_src file- pick out stuff we need...
my $lineno = 0 ;
while ( <FILE> ) {
if (/ATTRIBUTES attr(.*)\[\]\s=/) {
$attr = $1 ;
#print "ATTR=$attr\n" ;
$lineno = 1 ;
next ;
}
# LINE1: "varname", "type", "unit", "alias", "userdefined",
if (($lineno eq 1) && (/\{\s\"(.+)\",\s\"(.*)\",\s\"(.*)\",\s\".*\",\s\".*\",\n/)) {
$var = $1 ;
$type = $2 ;
$type =~ s/\:\:/__/g ; # replace class colons with underscores
$unit = $3 ;
$key = $attr . "." . $var ;
# note that derived classes will also have base class variables listed,
# so if a variable occurs twice, use the 1st one and ignore the base variable
if (exists $attr_type{$key}) {
print ATTRFILE "# SKIPPING BASE CLASS VARIABLE $key\n";
next ;
}
$attr_type{$key} = $type ;
$attr_unit{$key} = $unit ;
print ATTRFILE "\$attr_type{'$key'} = \"$type\" ;\n";
print ATTRFILE "\$attr_unit{'$key'} = \"$unit\" ;\n";
#print " key=$key : $attr_type{$key} $attr_unit{$key}\n";
$lineno++ ;
next ;
}
# LINE2: "description",
if (($lineno eq 2) && (/\s\"(.*)\",\n/)) {
#print " desc= $1\n";
$lineno++ ;
next ;
}
# LINE3: iospec, tricktype, size, rangemin, rangemax, language, mods,
if (($lineno eq 3) && (/\s(0|1|2|3),(.*),(.*),\d,\d,.*,.*,\n/)) {
$size = $3 ;
$attr_size{$key} = $size ;
print ATTRFILE "\$attr_size{'$key'} = \"$size\" ;\n";
#print " size= $size\n" ;
$lineno++ ;
next ;
}
# LINE4: offset, *attr, dims, index0, index1, index2, index3, index4, index5, index6, index7
if (($lineno eq 4) && (/\s[0-9]+,\(char\*\).*,\s([0-9]),\{\{.*\}\}\s\}\s,/)) {
$dims = $1 ;
$attr_dims{$key} = $dims ;
print ATTRFILE "\$attr_dims{'$key'} = \"$dims\" ;\n";
#print " dims= $dims\n" ;
$lineno = 1 ;
next ;
}
}
} # end foreach ifile
} # end foreach idir
print ATTRFILE "return 1;\n" ;
print "done\n" ;
}
print "dd_convert complete.\n" ;
exit ;
Reference in New Issue View Git Blame Copy Permalink