#! /usr/bin/env perl -w

# Script to read in the Siemens header files ds_head_acr_groups_types.h and
# ds_head_shadow_groups_types.h and create a table of elements to be
# created.

use strict;

# Routine for converting to a hex string
sub hexstring {
   my(@result) = ();

   my($input);
   foreach $input (@_) {
      push(@result, sprintf("0x%04x", hex($input)));
   }

   return @result;
}

# Routine to compare fields by group and element number
sub group_element_cmp {
   my($entry1, $entry2) = @_;
   my($result) = $entry1->{Group} cmp $entry2->{Group};
   if ($result == 0) {
      $result = $entry1->{Element} cmp $entry2->{Element};
   }
   return $result;
}

# Routine to read in list of valid ids and return a list
sub read_valid_element_ids {
   my($filename) = @_;

   my(@ids);
   open(IDS, $filename) || die "Error opening $filename: $!\n";
   while (<IDS>) {
      if (/^\s*(0x[\da-fA-F]{4})\s+(0x[\da-fA-F]{4})\s/) {
         push(@ids, $1.$2);
      }
   }
   return @ids;
}

############################ MAIN PROGRAM ################################

# Make a hash of valid ids
my(%valid_ids, $id);
foreach $id (read_valid_element_ids("valid_element_ids")) {
   $valid_ids{$id} = 1;
}

# Hash for keeping track of fields
my(%fields);

# Loop over input lines
while (<>) {

   # Check for structure entry
   if (/^\s*(\w+)\s+(\w+)(\s*\[([^\]]+)\])?\s*;\s*\/\*\s*\(([\da-fA-F]+)\s*,\s*([\da-fA-F]+)/) {
      # Save the information about the field - use group and field name
      # to identify fields to avoid naming problems
      my($type) = $1;
      my($length) = (defined($4) ? $4 : 1);
      my($group) = hexstring($5);
      my($element) = hexstring($6);
      my($field) = "$group.$2";
      if (defined($fields{$field})) {
         warn "Field $field already defined\n";
      }
      else {
         $fields{$field} = {Type => $type,
                            Length => $length,
                            Group => $group,
                            Element => $element};
      }
   }

   # Look for full variable names
   elsif (/^\s*"(G(\d+)\.[\w\.]+)"/) {
      my($variable) = $1;
      my($group) = hexstring($2);
      my(@parts) = split(/\./, $variable);
      if ($#parts < 0) {
         warn "Weird variable $variable\n".$_;
      }
      else {
         my($field, $part);
         my($newvar) = "";
         foreach $part (@parts) {
            if (length($newvar) > 0) {
               $newvar .= ".";
            }
            $newvar .= $part;
            my($tempfield) = "$group.$part";
            if (defined($fields{$tempfield})) {
               $field = $tempfield;
               last;
            }
         }
         if (defined($field) && defined($fields{$field})) {
            $fields{$field}->{Variable} = $newvar;
         }
         else {
            warn "Fields for variable $variable not previously defined\n";
         }
      }
   }


}

# Warn about fields that don't have a variable defined and get data types
my($key);
my(%data_types);
foreach $key (keys(%fields)) {
   if (!defined($fields{$key}->{Variable})) {
      warn "Variable not found for field $key\n";
   }
   else {
      $data_types{$fields{$key}->{Type}} = 1;
   }
}

# Sort the fields
my(@keys) = sort({group_element_cmp($fields{$a}, $fields{$b});} 
                 keys(%fields));

# Write out the results
print "Siemens_header_entry Siemens_header_table[] = {\n";
foreach $key (@keys) {
   my($entry) = $fields{$key};

   # Check for a valid id
   if (!defined($valid_ids{$entry->{Group}.$entry->{Element}})) {
      next;
   }

   # Check for an undefined variable
   if (!defined($entry->{Variable})) {
      next;
   }

   # Print out the entry
   print "{$entry->{Group}, $entry->{Element}, &" .
      "Siemens_header.$entry->{Variable}, create_$entry->{Type}_element, " .
      "$entry->{Length}},\n";

}
print "{0, 0, NULL, NULL, 0}\n";
print "};\n";

# Write out data types
print "\n\n/* Functions needed for this table:\n\n";
my($type);
foreach $type (sort(keys(%data_types))) {
   print "      create_" . $type . "_element\n";
}
print "\n */\n\n";
