mirror of
https://github.com/nasa/trick.git
synced 2024-12-19 05:07:54 +00:00
19025d77ad
Reorganized. Created a new top level include directory that will hold all of Trick's header files. Moved all of the Trick headers to this directory. Created a libexec directory that holds all of the executables that users don't need to execute directly. Changed all of the executables remaining in bin to start with "trick-". In the sim_services directories changed all source files to find the Trick headers in their new location. Since all of the include files are gone in sim_services, removed the src directories as well, moving all of the source files up a level. Moved the makefiles, docs, man, and other architecture independent files into a top level share directory. Renamed lib_${TRICK_HOST_CPU} to lib64 or lib depending on the platform we're currently on.
refs #63
722 lines
32 KiB
Perl
Executable File
722 lines
32 KiB
Perl
Executable File
#!/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 ;
|
|
|
|
|