tools/mtidl/mtidl_ini.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # MTIDL to .ini compiler
   4 #
   5 # Usage: perl mtidl_ini.pl ...
   6 #
   7 # $Id$
   8 #
   9
  10 use English;
  11 my $debug=0;
  12
  13 sub dbg_print($)
  14 {
  15   printf(STDERR shift) if($debug);
  16 }
  17
  18 sub error_exit($)
  19 {
  20   printf(STDERR "\n\nERROR: ".(shift)."\n\n");
  21   exit(123);
  22 }
  23
  24 sub add_definition_to_dictionary
  25 {
  26   my $dictionary_ref = shift;
  27   my $key = shift;
  28   my $value = shift;
  29
  30   ${$dictionary_ref}{$key} = $value;
  31 }
  32
  33 my $word_re = '[A-Za-z_0-9][A-Za-z_0-9]*';
  34 my $int_re = '[\-\+]{0,1}(?: 0x){0,1}[0-9A-Fa-f][0-9A-Fa-f]*';
  35
  36 my $mtidl_arg_tuple_re = '\((.*?)\)';
  37 my $mtidl_enum_arg_tuple_re = '\(\s*('.$word_re.')\s*,\s*('.$int_re.')\s*,\s*\"(.*?)\"\s*\)';
  38 my $mtidl_fract_arg_tuple_re = '\(\s*('.$word_re.')\s*,\s*('.$int_re.')\s*,\s*\"(.*?)\"\s*\)';
  39 my $mtidl_fract_array_arg_tuple_re = '\(\s*('.$word_re.')\s*,\s*('.$int_re.')\s*,\s*('.$int_re.')\s*,\s*\"(.*?)\"\s*\)';
  40
  41 my $mtidl_item_id_re        = 'MTIDL_ID'.$mtidl_arg_tuple_re;
  42 my $mtidl_item_type_re      = 'MTIDL_TYPE'.$mtidl_arg_tuple_re;
  43 my $mtidl_item_level_re     = 'MTIDL_LEVEL'.$mtidl_arg_tuple_re;
  44 my $mtidl_item_source_re    = 'MTIDL_SOURCE'.$mtidl_arg_tuple_re;
  45 my $mtidl_item_constant_re  = 'MTIDL_CONST'.$mtidl_arg_tuple_re;
  46 my $mtidl_enum_entry_re     = 'MTIDL_ENUM_ENTRY'.$mtidl_enum_arg_tuple_re;
  47 my $mtidl_bitfield_entry_re = 'MTIDL_BITFIELD_ENTRY'.$mtidl_enum_arg_tuple_re;
  48
  49 my $mtidl_val_arg_tuple_re       = '\((?: \s*'.$word_re.'\s*,\s*)*\"(.*?)\"\s*\)';
  50 my $mtidl_item_val_arg_tuple_re  = '\(\s*('.$word_re.')\s*,(?: \s*'.$word_re.'\s*,\s*)*\"(.*?)\"\s*\)';
  51 my $mtidl_enum_val_arg_tuple_re       = '\(\s*('.$word_re.')\s*,\s*('.$word_re.')\s*,\s*\"(.*?)\"\s*\)';
  52
  53 my $mtidl_val_long_re = 'MTIDL_LONGVAL'.$mtidl_val_arg_tuple_re;
  54 my $mtidl_val_slong_re = 'MTIDL_SLONGVAL'.$mtidl_val_arg_tuple_re;
  55 my $mtidl_val_huge_re = 'MTIDL_HUGEVAL'.$mtidl_val_arg_tuple_re;
  56 my $mtidl_val_shuge_re = 'MTIDL_SHUGEVAL'.$mtidl_val_arg_tuple_re;
  57 my $mtidl_val_time_re = 'MTIDL_TIMESTAMP'.$mtidl_val_arg_tuple_re;
  58 my $mtidl_val_flag_re = 'MTIDL_FLAG'.$mtidl_val_arg_tuple_re;
  59 my $mtidl_val_item_re = 'MTIDL_ITEM'.$mtidl_item_val_arg_tuple_re;
  60 my $mtidl_val_enum_re = 'MTIDL_ENUM'.$mtidl_enum_val_arg_tuple_re;
  61 my $mtidl_val_bitfield_re = 'MTIDL_BITFIELD'.$mtidl_enum_val_arg_tuple_re;
  62 my $mtidl_val_macaddr_re = 'MTIDL_MACADDR'.$mtidl_val_arg_tuple_re;
  63 my $mtidl_val_long_fract_re = 'MTIDL_LONGFRACT'.$mtidl_fract_arg_tuple_re;
  64 my $mtidl_val_slong_fract_re = 'MTIDL_SLONGFRACT'.$mtidl_fract_arg_tuple_re;
  65 my $mtidl_val_long_fract_array_re = 'MTIDL_LONGFRACT_ARRAY'.$mtidl_fract_array_arg_tuple_re;
  66 my $mtidl_val_slong_fract_array_re = 'MTIDL_SLONGFRACT_ARRAY'.$mtidl_fract_array_arg_tuple_re;
  67
  68 my $mtidl_array_arg_tuple_re = '\((?: \s*'.$word_re.'\s*,\s*)*(.*?)\s*,\s*\"(.*?)\"\s*\)';
  69 my $mtidl_array_item_arg_tuple_re  = '\(\s*('.$word_re.')\s*,(?: \s*'.$word_re.'\s*,\s*)*(.*?)\s*,\s*\"(.*?)\"\s*\)';
  70 my $mtidl_enum_array_arg_tuple_re = '\(\s*('.$word_re.')\s*,\s*('.$word_re.')\s*,\s*('.$word_re.')\s*,\s*\"(.*?)\"\s*\)';
  71
  72 my $mtidl_array_long_re = 'MTIDL_LONGVAL_ARRAY'.$mtidl_array_arg_tuple_re;
  73 my $mtidl_array_slong_re = 'MTIDL_SLONGVAL_ARRAY'.$mtidl_array_arg_tuple_re;
  74 my $mtidl_array_huge_re = 'MTIDL_HUGEVAL_ARRAY'.$mtidl_array_arg_tuple_re;
  75 my $mtidl_array_time_re = 'MTIDL_TIMESTAMP_ARRAY'.$mtidl_array_arg_tuple_re;
  76 my $mtidl_array_flag_re = 'MTIDL_FLAG_ARRAY'.$mtidl_array_arg_tuple_re;
  77 my $mtidl_array_item_re = 'MTIDL_ITEM_ARRAY'.$mtidl_array_item_arg_tuple_re;
  78 my $mtidl_array_enum_re = 'MTIDL_ENUM_ARRAY'.$mtidl_enum_array_arg_tuple_re;
  79 my $mtidl_array_bitfield_re = 'MTIDL_BITFIELD_ARRAY'.$mtidl_enum_array_arg_tuple_re;
  80 my $mtidl_array_macaddr_re = 'MTIDL_MACADDR_ARRAY'.$mtidl_array_arg_tuple_re;
  81
  82 sub process_definition
  83 {
  84   my $args_string = shift;
  85   my $dictionary_ref = shift;
  86
  87   dbg_print("process_definition($args_string)\n");
  88
  89   my $args_list_re = '^\s*('.$word_re.')\s*\,\s*(\d\d*)\s*$';
  90
  91   if($args_string !~ s/$args_list_re/add_definition_to_dictionary($dictionary_ref, $1, $2)/xemg)
  92   {
  93     error_exit("Failed to parse definition arguments \"$args_string\"");
  94   }
  95 }
  96
  97 sub fill_item_properties
  98 {
  99   my $dictionary_ref = shift;
 100   ${$dictionary_ref}{"friendly_name"} = shift;
 101   ${$dictionary_ref}{"type"} = shift;
 102   ${$dictionary_ref}{"level"} = shift;
 103   ${$dictionary_ref}{"source"} = shift;
 104   ${$dictionary_ref}{"id"} = shift;
 105
 106   ${$dictionary_ref}{"description"} = "\"".(shift)."\"";
 107   ${$dictionary_ref}{"binary_type"} = shift;
 108
 109   dbg_print("\nfill_item_properties(".${$dictionary_ref}{"friendly_name"}.","
 110                                      .${$dictionary_ref}{"type"}.","
 111                                      .${$dictionary_ref}{"level"}.","
 112                                      .${$dictionary_ref}{"source"}.","
 113                                      .${$dictionary_ref}{"id"}.","
 114                                      .${$dictionary_ref}{"description"}.","
 115                                      .${$dictionary_ref}{"binary_type"}.")\n\n");
 116
 117   return "";
 118 }
 119
 120 sub process_item_field
 121 {
 122   my $dictionary_ref = shift;
 123   my $num_elements = shift;
 124   my $element_size = shift;
 125   my $fract_size = shift;
 126   my $description = shift;
 127   my $binary_type = shift;
 128   my $binary_subtype = shift;
 129
 130   if((($binary_type eq "fract") || ($binary_type eq "sfract")) && ($fract_size == 0))
 131   {
 132     error_exit("fract_size should not be equal zero for \"$description\"");
 133   }
 134
 135   my %field_properties;
 136   $field_properties{"num_elements"} = $num_elements;
 137   $field_properties{"fract_size"} = $fract_size;
 138   $field_properties{"element_size"} = lookup_constant($element_size);
 139   $field_properties{"description"} = "\"".$description."\"";
 140   $field_properties{"binary_type"} = $binary_type;
 141   $field_properties{"binary_subtype"} = $binary_subtype;
 142
 143   push(@{${$dictionary_ref}{"fields"}}, \%field_properties);
 144
 145   return "";
 146 }
 147
 148 my %mtidl_ids;
 149 my %mtidl_types;
 150 my %mtidl_levels;
 151 my %mtidl_sources;
 152 my %mtidl_constants;
 153
 154 sub lookup_identifier
 155 {
 156   my $hash_ref = shift;
 157   my $key = shift;
 158   my $entity = shift;
 159
 160   error_exit("Failed to parse $entity \"$key\"") unless defined ${$hash_ref}{$key};
 161   return ${$hash_ref}{$key};
 162
 163 }
 164
 165 sub lookup_type { return lookup_identifier(\%mtidl_types, shift, "type"); }
 166 sub lookup_level { return lookup_identifier(\%mtidl_levels, shift, "level"); }
 167 sub lookup_source { return lookup_identifier(\%mtidl_sources, shift, "source"); }
 168 sub lookup_id { return lookup_identifier(\%mtidl_ids, shift, "id"); }
 169 sub lookup_constant
 170 {
 171   my $value=shift;
 172
 173   return $value if($value =~ /$int_re/);
 174   return lookup_identifier(\%mtidl_constants, $value, "constant");
 175 }
 176
 177 sub process_item_line
 178 {
 179   my $items_dictionary = shift;
 180   my $line = shift;
 181   my $orig_line = $line;
 182
 183   # Skip empty lines
 184   return "" if($line =~ /^[\s\n\r]*$/);
 185
 186   dbg_print("\tprocess_item_line($line)\n");
 187
 188   $line =~ s/$mtidl_val_long_re/process_item_field($items_dictionary, 1, 4, "", $1, "long", "")/xemg;
 189   $line =~ s/$mtidl_val_slong_re/process_item_field($items_dictionary, 1, 4, "", $1, "slong", "")/xemg;
 190   $line =~ s/$mtidl_val_macaddr_re/process_item_field($items_dictionary, 1, 8, "", $1, "macaddr", "")/xemg;
 191   $line =~ s/$mtidl_val_huge_re/process_item_field($items_dictionary, 1, 8, "", $1, "huge", "")/xemg;
 192   $line =~ s/$mtidl_val_shuge_re/process_item_field($items_dictionary, 1, 8, "", $1, "shuge", "")/xemg;
 193   $line =~ s/$mtidl_val_time_re/process_item_field($items_dictionary, 1, 4, "", $1, "time", "")/xemg;
 194   $line =~ s/$mtidl_val_flag_re/process_item_field($items_dictionary, 1, 4, "", $1, "flag", "")/xemg;
 195   $line =~ s/$mtidl_val_item_re/process_item_field($items_dictionary, 1, 0, "", $2, $1, "")/xemg;
 196   $line =~ s/$mtidl_val_bitfield_re/process_item_field($items_dictionary, 1, 4, "", $3, "bitfield", $2)/xemg;
 197   $line =~ s/$mtidl_val_enum_re/process_item_field($items_dictionary, 1, 4, "", $3, "enum", $2)/xemg;
 198   $line =~ s/$mtidl_val_long_fract_re/process_item_field($items_dictionary, 1, 4, $2, $3, "fract", "")/xemg;
 199   $line =~ s/$mtidl_val_slong_fract_re/process_item_field($items_dictionary, 1, 4, $2, $3, "sfract", "")/xemg;
 200
 201   $line =~ s/$mtidl_array_long_re/process_item_field($items_dictionary, $1, 4, "", $2, "long", "")/xemg;
 202   $line =~ s/$mtidl_array_slong_re/process_item_field($items_dictionary, $1, 4, "", $2, "slong", "")/xemg;
 203   $line =~ s/$mtidl_array_macaddr_re/process_item_field($items_dictionary, $1, 8, "", $2, "macaddr", "")/xemg;
 204   $line =~ s/$mtidl_array_huge_re/process_item_field($items_dictionary, $1, 8, "", $2, "huge", "")/xemg;
 205   $line =~ s/$mtidl_array_time_re/process_item_field($items_dictionary, $1, 4, "", $2, "time", "")/xemg;
 206   $line =~ s/$mtidl_array_flag_re/process_item_field($items_dictionary, $1, 4, "", $2, "flag", "")/xemg;
 207   $line =~ s/$mtidl_array_item_re/process_item_field($items_dictionary, $2, 0, "", $3, $1, "")/xemg;
 208   $line =~ s/$mtidl_array_bitfield_re/process_item_field($items_dictionary, $2, 4, "", $4, "bitfield", $3)/xemg;
 209   $line =~ s/$mtidl_array_enum_re/process_item_field($items_dictionary, $2, 4, "", $4, "enum", $3)/xemg;
 210   $line =~ s/$mtidl_val_long_fract_array_re/process_item_field($items_dictionary, $2, 4, $3, $4, "fract", "")/xemg;
 211   $line =~ s/$mtidl_val_slong_fract_array_re/process_item_field($items_dictionary, $2, 4, $3, $4, "sfract", "")/xemg;
 212
 213   if($line eq $orig_line)
 214   {
 215     # Drop carriage returns for more readable output
 216     $orig_line =~ s/[\n\r]//mg;
 217     error_exit("Unprocessed line found: \"$orig_line\"");
 218   }
 219 }
 220
 221 sub process_item
 222 {
 223   my $items_array_ref=shift;
 224   my $text = shift;
 225   my $binary_type=shift;
 226
 227   dbg_print("\nprocess_item($text, $binary_type)\n\n");
 228
 229   my %item_dictionary;
 230
 231   $text =~ s/
 232              ^\s*\(\s*
 233              ($word_re)                                     #Friendly name
 234              \s*,\s*
 235              ($word_re)                                     #Type
 236              \s*,\s*
 237              ($word_re)                                     #Level
 238              \s*,\s*
 239              ($word_re)                                     #Source
 240              \s*,\s*
 241              ($word_re)                                     #ID
 242              \s*,\s*
 243              \"(.*?)\"\s*\)                                 #Description
 244             /fill_item_properties(\%item_dictionary,
 245                                   $1,
 246                                   lookup_type($2),
 247                                   lookup_level($3),
 248                                   lookup_source($4),
 249                                   lookup_id($5),
 250                                   $6,
 251                                   $binary_type)/xemg;
 252
 253   $text =~ s/^(.*)$/process_item_line(\%item_dictionary, $1)/xemg;
 254
 255   push(@{$items_array_ref}, \%item_dictionary);
 256
 257   return "";
 258 }
 259
 260 sub process_enum_entry
 261 {
 262   my $dictionary_ref = shift;
 263   my $id = shift;
 264   my $value = shift;
 265   my $name = shift;
 266
 267   my %entry_properties;
 268   $entry_properties{"value"} = $value;
 269   $entry_properties{"name"} = "\"".$name."\"";
 270
 271   push(@{${$dictionary_ref}{"fields"}}, \%entry_properties);
 272
 273   return "";
 274 }
 275
 276 sub process_enum_line
 277 {
 278   my $enum_dictionary = shift;
 279   my $entry_re = shift;
 280   my $line = shift;
 281   my $orig_line = $line;
 282
 283   # Skip empty lines
 284   return "" if($line =~ /^[\s\n\r]*$/);
 285
 286   dbg_print("\nprocess_enum_line($line, $entry_re)\n");
 287
 288   $line =~ s/$entry_re/process_enum_entry($enum_dictionary, $1, $2, $3)/xemg;
 289
 290   if($line eq $orig_line)
 291   {
 292     # Drop carriage returns for more readable output
 293     $orig_line =~ s/[\n\r]//mg;
 294     error_exit("Unprocessed line found: \"$orig_line\"");
 295   }
 296 }
 297
 298 sub process_enum
 299 {
 300   my $enums_array_ref=shift;
 301   my $enum_entry_re = shift;
 302   my $text = shift;
 303   my $binary_type=shift;
 304
 305   dbg_print("\nprocess_enum($text, $binary_type)\n\n");
 306
 307   my %enum_dictionary;
 308
 309   $enum_dictionary{"binary_type"} = $binary_type;
 310
 311   $text =~ s/^(.*)$/process_enum_line(\%enum_dictionary, $enum_entry_re, $1)/xemg;
 312
 313   push(@{$enums_array_ref}, \%enum_dictionary);
 314
 315   return "";
 316 }
 317
 318 sub print_hash_to_ini
 319 {
 320   my $hash_name = shift;
 321   my $field_name_prefix = shift;
 322   my $fhMTIDLC = shift;
 323   my $dictionary_ref = shift;
 324
 325   print $fhMTIDLC "[$hash_name]\n" if($hash_name);
 326
 327   for my $key ( sort keys %{$dictionary_ref} )
 328   {
 329     if($key eq "fields")
 330     {
 331       my $i;
 332       foreach (@{${$dictionary_ref}{$key}})
 333       {
 334         print_hash_to_ini("", "field_".$i++."_", $fhMTIDLC, $_);
 335       }
 336     }
 337     else
 338     {
 339       my $value = ${$dictionary_ref}{$key};
 340       print $fhMTIDLC $field_name_prefix.$key."=$value\n";
 341     }
 342   }
 343
 344   print $fhMTIDLC "\n" if($hash_name);
 345 }
 346
 347 print("MTIDL to INI compiler started...\n");
 348
 349 my $usage_text = <<USAGE_END;
 350 The command line is incorrect.
 351 Usage:
 352     perl mtidl_ini.pl <Output file name> <Input file name 1> <Input file name 2> ... <Input file name N>
 353 USAGE_END
 354
 355 ($#ARGV + 1) > 1 or error_exit($usage_text);
 356
 357 my $MTIDLCFile = shift(@ARGV);
 358
 359 my $mtidl_item_re = 'MTIDL_ITEM_START((?: .|\n)*?)MTIDL_ITEM_END\s*\(\s*('.$word_re.')\s*\)';
 360 my $mtidl_enum_re = 'MTIDL_ENUM_START((?: .|\n)*?)MTIDL_ENUM_END\s*\(\s*('.$word_re.')\s*\)';
 361 my $mtidl_bitfield_re = 'MTIDL_BITFIELD_START((?: .|\n)*?)MTIDL_BITFIELD_END\s*\(\s*('.$word_re.')\s*\)';
 362 my @items_array;
 363 my @enums_array;
 364 my @bitfields_array;
 365
 366 my $text;
 367
 368 foreach (@ARGV)
 369 {
 370   my $fname = $_;
 371   print("\tReading file $fname... ");
 372
 373   open my $fh, '<', $fname or die "ERROR: failed to open file $fname for reading: $!";
 374   my $fcontents = do { local $/; <$fh> };
 375   $text = $text.$fcontents;
 376
 377   print("DONE.\n");
 378 }
 379
 380 print("\tCollecting definitions... ");
 381 $text =~ s/$mtidl_item_id_re/process_definition($1, \%mtidl_ids)/xemg;
 382 $text =~ s/$mtidl_item_type_re/process_definition($1, \%mtidl_types)/xemg;
 383 $text =~ s/$mtidl_item_level_re/process_definition($1, \%mtidl_levels)/xemg;
 384 $text =~ s/$mtidl_item_source_re/process_definition($1, \%mtidl_sources)/xemg;
 385 $text =~ s/$mtidl_item_constant_re/process_definition($1, \%mtidl_constants)/xemg;
 386 print("DONE.\n");
 387
 388 print("\tParsing enums... ");
 389 $text =~ s/$mtidl_enum_re/process_enum(\@enums_array, $mtidl_enum_entry_re, $1, $2)/xemg;
 390 print("DONE.\n");
 391
 392 print("\tParsing bitfields... ");
 393 $text =~ s/$mtidl_bitfield_re/process_enum(\@bitfields_array, $mtidl_bitfield_entry_re, $1, $2)/xemg;
 394 print("DONE.\n");
 395
 396 print("\tParsing items... ");
 397 $text =~ s/$mtidl_item_re/process_item(\@items_array, $1, $2)/xemg;
 398 print("DONE.\n");
 399
 400 print("\tSaving output to $MTIDLCFile... ");
 401
 402 open my $fhMTIDLC, '>', $MTIDLCFile.".mtidlc" or error_exit("failed to open $MTIDLCFile for writing: $!");
 403
 404 print_hash_to_ini("ID", "", $fhMTIDLC, \%mtidl_ids) if($debug);
 405 print_hash_to_ini("Type", "", $fhMTIDLC, \%mtidl_types) if($debug);
 406 print_hash_to_ini("Level", "", $fhMTIDLC, \%mtidl_levels) if($debug);
 407 print_hash_to_ini("Sources", "", $fhMTIDLC, \%mtidl_sources) if($debug);
 408 print_hash_to_ini("Constants", "", $fhMTIDLC, \%mtidl_constants) if($debug);
 409
 410 my $i=0;
 411 foreach (@enums_array)
 412 {
 413   print_hash_to_ini("mtidl_enum_".$i++, "", $fhMTIDLC, $_);
 414 }
 415
 416 $i=0;
 417 foreach (@bitfields_array)
 418 {
 419   print_hash_to_ini("mtidl_bitfield_".$i++, "", $fhMTIDLC, $_);
 420 }
 421
 422 $i=0;
 423 foreach (@items_array)
 424 {
 425   print_hash_to_ini("mtidl_item_".$i++, "", $fhMTIDLC, $_);
 426 }
 427
 428 print("DONE.\n");
 429
 430 exit 0;