1#! /usr/bin/env perl -w
2
3# Script to read in the Siemens header files ds_head_acr_groups_types.h and
4# ds_head_shadow_groups_types.h and create a table of elements to be
5# created.
6
7use strict;
8
9# Routine for converting to a hex string
10sub hexstring {
11   my(@result) = ();
12
13   my($input);
14   foreach $input (@_) {
15      push(@result, sprintf("0x%04x", hex($input)));
16   }
17
18   return @result;
19}
20
21# Routine to compare fields by group and element number
22sub group_element_cmp {
23   my($entry1, $entry2) = @_;
24   my($result) = $entry1->{Group} cmp $entry2->{Group};
25   if ($result == 0) {
26      $result = $entry1->{Element} cmp $entry2->{Element};
27   }
28   return $result;
29}
30
31# Routine to read in list of valid ids and return a list
32sub read_valid_element_ids {
33   my($filename) = @_;
34
35   my(@ids);
36   open(IDS, $filename) || die "Error opening $filename: $!\n";
37   while (<IDS>) {
38      if (/^\s*(0x[\da-fA-F]{4})\s+(0x[\da-fA-F]{4})\s/) {
39         push(@ids, $1.$2);
40      }
41   }
42   return @ids;
43}
44
45############################ MAIN PROGRAM ################################
46
47# Make a hash of valid ids
48my(%valid_ids, $id);
49foreach $id (read_valid_element_ids("valid_element_ids")) {
50   $valid_ids{$id} = 1;
51}
52
53# Hash for keeping track of fields
54my(%fields);
55
56# Loop over input lines
57while (<>) {
58
59   # Check for structure entry
60   if (/^\s*(\w+)\s+(\w+)(\s*\[([^\]]+)\])?\s*;\s*\/\*\s*\(([\da-fA-F]+)\s*,\s*([\da-fA-F]+)/) {
61      # Save the information about the field - use group and field name
62      # to identify fields to avoid naming problems
63      my($type) = $1;
64      my($length) = (defined($4) ? $4 : 1);
65      my($group) = hexstring($5);
66      my($element) = hexstring($6);
67      my($field) = "$group.$2";
68      if (defined($fields{$field})) {
69         warn "Field $field already defined\n";
70      }
71      else {
72         $fields{$field} = {Type => $type,
73                            Length => $length,
74                            Group => $group,
75                            Element => $element};
76      }
77   }
78
79   # Look for full variable names
80   elsif (/^\s*"(G(\d+)\.[\w\.]+)"/) {
81      my($variable) = $1;
82      my($group) = hexstring($2);
83      my(@parts) = split(/\./, $variable);
84      if ($#parts < 0) {
85         warn "Weird variable $variable\n".$_;
86      }
87      else {
88         my($field, $part);
89         my($newvar) = "";
90         foreach $part (@parts) {
91            if (length($newvar) > 0) {
92               $newvar .= ".";
93            }
94            $newvar .= $part;
95            my($tempfield) = "$group.$part";
96            if (defined($fields{$tempfield})) {
97               $field = $tempfield;
98               last;
99            }
100         }
101         if (defined($field) && defined($fields{$field})) {
102            $fields{$field}->{Variable} = $newvar;
103         }
104         else {
105            warn "Fields for variable $variable not previously defined\n";
106         }
107      }
108   }
109
110
111}
112
113# Warn about fields that don't have a variable defined and get data types
114my($key);
115my(%data_types);
116foreach $key (keys(%fields)) {
117   if (!defined($fields{$key}->{Variable})) {
118      warn "Variable not found for field $key\n";
119   }
120   else {
121      $data_types{$fields{$key}->{Type}} = 1;
122   }
123}
124
125# Sort the fields
126my(@keys) = sort({group_element_cmp($fields{$a}, $fields{$b});}
127                 keys(%fields));
128
129# Write out the results
130print "Siemens_header_entry Siemens_header_table[] = {\n";
131foreach $key (@keys) {
132   my($entry) = $fields{$key};
133
134   # Check for a valid id
135   if (!defined($valid_ids{$entry->{Group}.$entry->{Element}})) {
136      next;
137   }
138
139   # Check for an undefined variable
140   if (!defined($entry->{Variable})) {
141      next;
142   }
143
144   # Print out the entry
145   print "{$entry->{Group}, $entry->{Element}, &" .
146      "Siemens_header.$entry->{Variable}, create_$entry->{Type}_element, " .
147      "$entry->{Length}},\n";
148
149}
150print "{0, 0, NULL, NULL, 0}\n";
151print "};\n";
152
153# Write out data types
154print "\n\n/* Functions needed for this table:\n\n";
155my($type);
156foreach $type (sort(keys(%data_types))) {
157   print "      create_" . $type . "_element\n";
158}
159print "\n */\n\n";
160