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