sdcc/support/scripts/optimize_pic16devices.pl

   1 #!/usr/bin/perl -w
   2
   3 =back
   4
   5   Copyright (C) 2012-2015 Molnar Karoly <molnarkaroly@users.sf.net>
   6
   7   This library is free software; you can redistribute it and/or modify it
   8   under the terms of the GNU General Public License as published by the
   9   Free Software Foundation; either version 2, or (at your option) any
  10   later version.
  11
  12   This library is distributed in the hope that it will be useful,
  13   but WITHOUT ANY WARRANTY; without even the implied warranty of
  14   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15   GNU General Public License for more details.
  16
  17   You should have received a copy of the GNU General Public License
  18   along with this library; see the file COPYING. If not, write to the
  19   Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,
  20   MA 02110-1301, USA.
  21
  22 ================================================================================
  23
  24     This program optimizes or unoptimizes the pic16devices.txt file.
  25     For more explanation: optimize_pic16devices.pl -h
  26
  27   $Id$
  28 =cut
  29
  30 use strict;
  31 use warnings;
  32 no if $] >= 5.018, warnings => "experimental::smartmatch";        # perl 5.16
  33 use 5.12.0;                     # when (regex)
  34 use POSIX 'ULONG_MAX';
  35
  36 use constant FALSE => 0;
  37 use constant TRUE  => 1;
  38
  39 use constant FNV1A32_INIT  => 0x811C9DC5;
  40 use constant FNV1A32_PRIME => 0x01000193;
  41
  42 my $PROGRAM = '';
  43 my $verbose = 0;
  44 my $file = '';
  45
  46 use constant OP_NULL       => 0;
  47 use constant OP_OPTIMIZE   => 1;
  48 use constant OP_UNOPTIMIZE => 2;
  49
  50 my $operation = OP_NULL;
  51
  52 my @devices_header = ();
  53 my @device_names = ();
  54
  55 #-----------------------------------------------
  56
  57 =back
  58         The structure of one element of the %devices_by_name:
  59
  60         {
  61         NAME     => '',
  62         COMMENTS => '',
  63         RAM      => {
  64                     SIZE      => 0,
  65                     SPLIT     => 0,
  66                     HASH      => 0,
  67                     DIFF      => 0
  68                     },
  69         CONFIG   => {
  70                     FIRST     => 0,
  71                     LAST      => 0,
  72                     WORDS     => {},
  73                     ORD_WORDS => [],
  74                     HASH      => 0,
  75                     DIFF      => 0
  76                     },
  77         ID       => {
  78                     FIRST     => 0,
  79                     LAST      => 0,
  80                     WORDS     => {},
  81                     ORD_WORDS => [],
  82                     HASH      => 0,
  83                     DIFF      => 0
  84                     },
  85         XINST    => 0
  86         CHILD    => 0
  87         }
  88 =cut
  89
  90 use constant RELEVANCE_RAM      => 2;
  91 use constant RELEVANCE_CONFWORD => 4;
  92 use constant RELEVANCE_IDWORD   => 2;
  93 use constant RELEVANCE_FATAL    => 1000;
  94
  95 my %devices_by_name = ();
  96
  97 #   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
  98 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
  99 #@@@@@@@@@@@@@@@@@@@@@@@@@                          @@@@@@@@@@@@@@@@@@@@@@@@@@@@
 100 #@@@@@@@@@@@@@@@@@@@@@@@@  Some auxiliary function.  @@@@@@@@@@@@@@@@@@@@@@@@@@@
 101 #@@@@@@@@@@@@@@@@@@@@@@@@@                          @@@@@@@@@@@@@@@@@@@@@@@@@@@@
 102 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 103 #   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 104
 105 sub basename($)
 106   {
 107   return ($_[0] =~ /([^\/]+)$/) ? $1 : '';
 108   }
 109
 110 #---------------------------------------------------------------------------------------------------
 111
 112 sub param_exist($$)
 113   {
 114   die "This option \"$_[0]\" requires a parameter.\n" if ($_[1] > $#ARGV);
 115   }
 116
 117 #---------------------------------------------------------------------------------------------------
 118
 119 sub str2int($)
 120   {
 121   my $Str = $_[0];
 122
 123   return hex($1)   if ($Str =~ /^0x([[:xdigit:]]+)$/io);
 124   return oct($1)   if ($Str =~ /^(0[0-7]+)$/o);
 125   return int($Str) if ($Str =~ /^-?\d+$/o);
 126
 127   die "This string not integer: \"$Str\"";
 128   }
 129
 130 #---------------------------------------------------------------------------------------------------
 131
 132 sub Log
 133   {
 134   return if (pop(@_) > $verbose);
 135   foreach (@_) { print STDERR $_; }
 136   print STDERR "\n";
 137   }
 138
 139 #---------------------------------------------------------------------------------------------------
 140
 141 sub Open($$)
 142   {
 143   my ($File, $Function) = @_;
 144   my $handle;
 145
 146   open($handle, '<', $File) || die "${Function}(): Could not open the \"$File\" file.\n";
 147   return $handle;
 148   }
 149
 150 #---------------------------------------------------------------------------------------------------
 151
 152 sub fnv1a32_str($$)
 153   {
 154   my ($String, $Hash) = @_;
 155
 156   foreach (unpack('C*', $String))
 157     {
 158     $Hash ^= $_;
 159     $Hash *= FNV1A32_PRIME;
 160     $Hash &= 0xFFFFFFFF;
 161     }
 162
 163   return $Hash;
 164   }
 165
 166 #---------------------------------------------------------------------------------------------------
 167
 168 sub fnv1a32_int32($$)
 169   {
 170   my ($Int, $Hash) = @_;
 171   my $i;
 172
 173   for ($i = 4; $i; --$i)
 174     {
 175     $Hash ^= $Int & 0xFF;
 176     $Hash *= FNV1A32_PRIME;
 177     $Hash &= 0xFFFFFFFF;
 178     $Int >>= 8;
 179     }
 180
 181   return $Hash;
 182   }
 183
 184 #---------------------------------------------------------------------------------------------------
 185
 186 sub versionCompare($$)
 187   {
 188   my ($Str1, $Str2) = @_;
 189
 190   if ((${$Str1} =~ /^\d/o) && (${$Str2} =~ /^\d/o))
 191     {
 192         # $Str1 number and $Str2 number
 193     return (int(${$Str1}) <=> int(${$Str2}));
 194     }
 195
 196   return (${$Str1} cmp ${$Str2});
 197   }
 198
 199 #---------------------------------------------------------------------------------------------------
 200
 201 sub versionSort($$)
 202   {
 203   my @a_s = ($_[0] =~ /(\d+|\D+)/go);
 204   my @b_s = ($_[1] =~ /(\d+|\D+)/go);
 205   my ($i, $k, $end, $ret);
 206
 207   $i = scalar(@a_s);
 208   $k = scalar(@b_s);
 209
 210   if ($i < $k)
 211     {
 212     $end = $i;
 213     $ret = -1;
 214     }
 215   elsif ($i == $k)
 216     {
 217     $end = $i;
 218     $ret = 0;
 219     }
 220   else
 221     {
 222     $end = $k;
 223     $ret = 1;
 224     }
 225
 226   for ($i = 0; $i < $end; ++$i)
 227     {
 228     $k = versionCompare(\$a_s[$i], \$b_s[$i]);
 229
 230     return $k if ($k != 0);
 231     }
 232
 233   return $ret;
 234   }
 235
 236 #   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 237 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 238 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@                             @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 239 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@   The important procedures.   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 240 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@                             @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 241 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 242 #   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 243
 244         #
 245         # Reads the entire pic16devices.txt file.
 246         #
 247
 248 sub read_pic16devices_txt($)
 249   {
 250   my $File = $_[0];
 251   my ($parent, $first, $last, $txt, $ref, $is_using);
 252   my $in = Open($File, 'read_pic16devices_txt');
 253   my $header = TRUE;
 254   my $device = undef;
 255
 256   Log("Reads the $File file.", 4);
 257
 258   while (<$in>)
 259     {
 260     chomp;
 261     s/\r$//o;
 262     s/\s+$//o;
 263
 264     $header = FALSE if (/^\s*name\b/io);
 265
 266     if ($header)
 267       {
 268       push(@devices_header, $_);
 269       next;
 270       }
 271
 272     given ($_)
 273       {
 274       when (/^\s*name\s+(\w+)$/io)
 275         {
 276         $device = {
 277                   NAME      => $1,
 278                   COMMENTS  => undef,
 279                   RAM       => {
 280                                SIZE  => -1,
 281                                SPLIT => -1,
 282                                HASH  => 0,
 283                                DIFF  => 0
 284                                },
 285                   CONFIG    => {
 286                                FIRST     => -1,
 287                                LAST      => -1,
 288                                WORDS     => {},
 289                                ORD_WORDS => [],
 290                                HASH      => 0,
 291                                DIFF      => 0
 292                                },
 293                   ID        => {
 294                                FIRST     => -1,
 295                                LAST      => -1,
 296                                WORDS     => {},
 297                                ORD_WORDS => [],
 298                                HASH      => 0,
 299                                DIFF      => 0
 300                                },
 301                   XINST     => -1,
 302                   CHILD     => FALSE
 303                   };
 304
 305         Log("name       : $1", 7);
 306         $devices_by_name{$1} = $device;
 307         $is_using = FALSE;
 308         }
 309
 310       when (/^\s*using\s+(\w+)$/io)
 311         {
 312         die "Device not exists." if (! defined($device));
 313
 314         $parent = $devices_by_name{$1};
 315
 316         die "In device - \"$device->{NAME}\" - not exists the parent: \"$1\"\n" if (! defined($parent));
 317
 318         # Unlock the "using" keyword.
 319
 320         Log("using      : $1", 7);
 321         %{$device->{RAM}}             = %{$parent->{RAM}};
 322         $device->{CONFIG}->{FIRST}    = $parent->{CONFIG}->{FIRST};
 323         $device->{CONFIG}->{LAST}     = $parent->{CONFIG}->{LAST};
 324         %{$device->{CONFIG}->{WORDS}} = %{$parent->{CONFIG}->{WORDS}};
 325         $device->{ID}->{FIRST}        = $parent->{ID}->{FIRST};
 326         $device->{ID}->{LAST}         = $parent->{ID}->{LAST};
 327         %{$device->{ID}->{WORDS}}     = %{$parent->{ID}->{WORDS}};
 328         $device->{XINST}              = $parent->{XINST};
 329         $is_using = TRUE;
 330         }
 331
 332       when (/^\s*ramsize\s+(\w+)$/io)
 333         {
 334         die "Device not exists." if (! defined($device));
 335
 336         Log("ramsize    : $1", 7);
 337         $device->{RAM}->{SIZE} = str2int($1);
 338         }
 339
 340       when (/^\s*split\s+(\w+)$/io)
 341         {
 342         die "Device not exists." if (! defined($device));
 343
 344         Log("split      : $1", 7);
 345         $device->{RAM}->{SPLIT} = str2int($1);
 346         }
 347
 348       when (/^\s*configrange\s+(\w+)\s+(\w+)$/io)
 349         {
 350         die "Device not exists." if (! defined($device));
 351
 352         ($first, $last) = (str2int($1), str2int($2));
 353         Log("configrange: $first, $last", 7);
 354
 355         if (($device->{CONFIG}->{FIRST} >= 0) || ($device->{CONFIG}->{LAST} >= 0))
 356           {
 357           Log("The configrange already exists in the \"$device->{NAME}\".", 0);
 358
 359           if (($device->{CONFIG}->{FIRST} != $first) || ($device->{CONFIG}->{LAST} != $last))
 360             {
 361             Log("  In addition the previous values different from the new values.", 0);
 362             Log(sprintf("  previous: 0x%06X - 0x%06X, new: 0x%06X - 0x%06X",
 363                          $device->{CONFIG}->{FIRST}, $device->{CONFIG}->{LAST},
 364                          $first, $last), 0);
 365             }
 366
 367         # The previous values invalid.
 368
 369           $device->{CONFIG}->{WORDS} = {};
 370           }
 371
 372         $device->{CONFIG}->{FIRST} = $first;
 373         $device->{CONFIG}->{LAST}  = $last;
 374         }
 375
 376       when (/^\s*configword\s+(\w+)\s+(\w+)\s+(\w+)(?:\s+(\w+))?$/io)
 377         {
 378         my ($addr, $mask, $val, $amask, $hash);
 379
 380         die "Device not exists." if (! defined($device));
 381
 382         ($addr, $mask, $val) = (str2int($1), str2int($2), str2int($3));
 383
 384         if (defined($4))
 385           {
 386           $amask = str2int($4);
 387           Log("configword : $addr, $mask, $val, $amask", 7);
 388           }
 389         else
 390           {
 391           $amask = -1;
 392           Log("configword : $addr, $mask, $val", 7);
 393           }
 394
 395         $hash = fnv1a32_int32($addr, FNV1A32_INIT);
 396         $hash = fnv1a32_int32($mask, $hash);
 397         $hash = fnv1a32_int32($val, $hash);
 398         $hash = fnv1a32_int32($amask, $hash);
 399         $ref  = {
 400                 ADDRESS  => $addr,
 401                 MASK     => $mask,
 402                 VALUE    => $val,
 403                 AND_MASK => $amask,
 404                 HASH     => $hash
 405                 };
 406
 407         if ($is_using && ! defined($device->{CONFIG}->{WORDS}->{$addr}))
 408           {
 409           printf STDERR "Database error: The 0x%06X config word not exist in the ancestor MCU!\n", $addr;
 410           exit(1);
 411           }
 412
 413         $device->{CONFIG}->{WORDS}->{$addr} = $ref;
 414         }
 415
 416       when (/^\s*XINST\s+(\w+)\s*$/io)
 417         {
 418         die "Device not exists." if (! defined($device));
 419
 420         Log("XINST    : $1", 7);
 421         $device->{XINST} = str2int($1);
 422         }
 423
 424       when (/^\s*idlocrange\s+(\w+)\s+(\w+)$/io)
 425         {
 426         die "Device not exists." if (! defined($device));
 427
 428         Log("idlocrange : $1 $2", 7);
 429         $device->{ID}->{FIRST} = str2int($1);
 430         $device->{ID}->{LAST}  = str2int($2);
 431         }
 432
 433       when (/^\s*idword\s+(\w+)\s+(\w+)$/io)
 434         {
 435         my ($addr, $val, $hash);
 436
 437         die "Device not exists." if (! defined($device));
 438
 439         ($addr, $val) = (str2int($1), str2int($2));
 440         Log("idword     : $1 $2", 7);
 441         $hash = fnv1a32_int32($addr, FNV1A32_INIT);
 442         $hash = fnv1a32_int32($val, $hash);
 443         $ref  = {
 444                 ADDRESS  => $addr,
 445                 VALUE    => $val,
 446                 HASH     => $hash
 447                 };
 448
 449         if ($is_using && ! defined($device->{ID}->{WORDS}->{$addr}))
 450           {
 451           printf STDERR "Database error: The 0x%06X id word not exist in the ancestor MCU!\n", $addr;
 452           exit(1);
 453           }
 454
 455         $device->{ID}->{WORDS}->{$addr} = $ref;
 456         }
 457
 458       when (/^\s*#/o)
 459         {
 460         die "Device not exists." if (! defined($device));
 461
 462         Log("comment    : \"$_\"", 7);
 463         push(@{$device->{COMMENTS}}, $_);
 464         }
 465
 466       default
 467         {
 468         Log("unrecognized line: \"$_\"", 7);
 469         }
 470       } # given ($_)
 471     }
 472
 473   close($in);
 474   }
 475
 476 #---------------------------------------------------------------------------------------------------
 477
 478 sub make_hashes($)
 479   {
 480   my $DevRef = $_[0];
 481   my ($ref1, $ref2, $hash);
 482
 483   $ref1 = $DevRef->{RAM};
 484   $hash = fnv1a32_int32($ref1->{SIZE}, FNV1A32_INIT);
 485   $ref1->{HASH} = fnv1a32_int32($ref1->{SPLIT}, $hash);
 486
 487   #.................
 488
 489   $ref1 = $DevRef->{CONFIG};
 490   $hash = fnv1a32_int32($ref1->{FIRST}, FNV1A32_INIT);
 491   $hash = fnv1a32_int32($ref1->{LAST}, $hash);
 492
 493   @{$ref1->{ORD_WORDS}} = sort {$a->{ADDRESS} <=> $b->{ADDRESS}} values %{$ref1->{WORDS}};
 494
 495   foreach $ref2 (@{$ref1->{ORD_WORDS}})
 496     {
 497     $hash = fnv1a32_int32($ref2->{ADDRESS}, $hash);
 498     $hash = fnv1a32_int32($ref2->{MASK}, $hash);
 499     $hash = fnv1a32_int32($ref2->{VALUE}, $hash);
 500     $hash = fnv1a32_int32($ref2->{AND_MASK}, $hash);
 501     }
 502
 503   $ref1->{HASH} = $hash;
 504
 505   #.................
 506
 507   $ref1 = $DevRef->{ID};
 508
 509   if (defined($ref1))
 510     {
 511     $hash = fnv1a32_int32($ref1->{FIRST}, FNV1A32_INIT);
 512     $hash = fnv1a32_int32($ref1->{LAST}, $hash);
 513
 514     if (defined($ref1->{WORDS}))
 515       {
 516       @{$ref1->{ORD_WORDS}} = sort {$a->{ADDRESS} <=> $b->{ADDRESS}} values %{$ref1->{WORDS}};
 517
 518       foreach $ref2 (@{$ref1->{ORD_WORDS}})
 519         {
 520         $hash = fnv1a32_int32($ref2->{ADDRESS}, $hash);
 521         $hash = fnv1a32_int32($ref2->{VALUE}, $hash);
 522         }
 523       }
 524
 525     $ref1->{HASH} = $hash;
 526     }
 527   }
 528
 529 #---------------------------------------------------------------------------------------------------
 530
 531 sub difference_of_arrays($$)
 532   {
 533   my ($ArrayRef1, $ArrayRef2) = @_;
 534   my ($diff, $len, $i);
 535
 536   $len = @{$ArrayRef1};
 537   # The lenght of two arrays must be of equal.
 538   return RELEVANCE_FATAL if ($len != scalar(@{$ArrayRef2}));
 539
 540   $diff = 0;
 541   for ($i = 0; $i < $len; ++$i)
 542     {
 543     if ($ArrayRef1->[$i]->{ADDRESS} != $ArrayRef2->[$i]->{ADDRESS})
 544       {
 545       $diff += RELEVANCE_FATAL;
 546       $ArrayRef1->[$i]->{DIFF} = TRUE;
 547       }
 548     elsif ($ArrayRef1->[$i]->{HASH} != $ArrayRef2->[$i]->{HASH})
 549       {
 550       $diff += RELEVANCE_CONFWORD;
 551       $ArrayRef1->[$i]->{DIFF} = TRUE;
 552       }
 553     else
 554       {
 555       $ArrayRef1->[$i]->{DIFF} = FALSE;
 556       }
 557     }
 558
 559   return $diff;
 560   }
 561
 562 #---------------------------------------------------------------------------------------------------
 563
 564         #
 565         # Compares the $Dev1 and the $Dev2.
 566         #
 567
 568 sub difference_of_devices($$)
 569   {
 570   my ($DevRef1, $DevRef2) = @_;
 571   my ($diff, $r1, $r2, $aref1, $aref2, $len1, $len2, $min, $i);
 572
 573   $i = defined($DevRef1) + defined($DevRef2);
 574
 575   return RELEVANCE_FATAL if ($i != 2);
 576
 577   $diff  = 0;
 578   $r1 = $DevRef1->{RAM};
 579   $r2 = $DevRef2->{RAM};
 580
 581   if ($r1->{HASH} != $r2->{HASH})
 582     {
 583     $diff += RELEVANCE_RAM;
 584     $r1->{DIFF} = TRUE;
 585     }
 586   else
 587     {
 588     $r1->{DIFF} = FALSE;
 589     }
 590
 591   $r1 = $DevRef1->{CONFIG};
 592   $r2 = $DevRef2->{CONFIG};
 593
 594   if ($r1->{HASH} != $r2->{HASH})
 595     {
 596     $diff += RELEVANCE_FATAL if ($r1->{FIRST} != $r2->{FIRST});
 597     $diff += RELEVANCE_FATAL if ($r1->{LAST}  != $r2->{LAST});
 598     $diff += difference_of_arrays($r1->{ORD_WORDS}, $r2->{ORD_WORDS});
 599     $r1->{DIFF} = TRUE;
 600     }
 601   else
 602     {
 603     $r1->{DIFF} = FALSE;
 604     }
 605
 606   $r1 = $DevRef1->{ID};
 607   $r2 = $DevRef2->{ID};
 608
 609   if ($r1->{HASH} != $r2->{HASH})
 610     {
 611     $diff += RELEVANCE_FATAL if ($r1->{FIRST} != $r2->{FIRST});
 612     $diff += RELEVANCE_FATAL if ($r1->{LAST}  != $r2->{LAST});
 613     $diff += difference_of_arrays($r1->{ORD_WORDS}, $r2->{ORD_WORDS});
 614     $r1->{DIFF} = TRUE;
 615     }
 616   else
 617     {
 618     $r1->{DIFF} = FALSE;
 619     }
 620
 621   # The value of two XINST elements must be of equal.
 622   $diff += RELEVANCE_FATAL if ($DevRef1->{XINST} != $DevRef1->{XINST});
 623   return $diff;
 624   }
 625
 626 #---------------------------------------------------------------------------------------------------
 627
 628 sub print_config_words($)
 629   {
 630   my $Words = $_[0];
 631
 632   return if (! defined($Words));
 633
 634   foreach (@{$Words})
 635     {
 636     printf "configword  0x%06X 0x%02X 0x%02X", $_->{ADDRESS}, $_->{MASK}, $_->{VALUE};
 637     printf " 0x%02X", $_->{AND_MASK} if ($_->{AND_MASK} > 0);
 638     print  "\n";
 639     }
 640   }
 641
 642 #---------------------------------------------------------------------------------------------------
 643
 644 sub print_id_words($)
 645   {
 646   my $Words = $_[0];
 647
 648   return if (! defined($Words));
 649
 650   foreach (@{$Words})
 651     {
 652     printf "idword      0x%06X 0x%02X\n", $_->{ADDRESS}, $_->{VALUE};
 653     }
 654   }
 655
 656 #---------------------------------------------------------------------------------------------------
 657
 658 sub print_diff_config_words($)
 659   {
 660   my $ArrayRef = $_[0];
 661
 662   foreach (@{$ArrayRef})
 663     {
 664     next if (! $_->{DIFF});
 665
 666     printf "configword  0x%06X 0x%02X 0x%02X", $_->{ADDRESS}, $_->{MASK}, $_->{VALUE};
 667     printf " 0x%02X", $_->{AND_MASK} if ($_->{AND_MASK} > 0);
 668     print  "\n";
 669     }
 670   }
 671
 672 #---------------------------------------------------------------------------------------------------
 673
 674 sub print_diff_id_words($)
 675   {
 676   my $ArrayRef = $_[0];
 677
 678   foreach (@{$ArrayRef})
 679     {
 680     next if (! $_->{DIFF});
 681
 682     printf "idword      0x%06X 0x%02X\n", $_->{ADDRESS}, $_->{VALUE};
 683     }
 684   }
 685
 686 #---------------------------------------------------------------------------------------------------
 687
 688 sub print_device($)
 689   {
 690   my $Index = $_[0];
 691   my $mcu = $device_names[$Index];
 692   my $dev = $devices_by_name{$mcu};
 693   my ($min_diff, $diff);
 694   my ($ac, $ancestor, $i, $ref1, $ref2);
 695
 696   return if (! defined($dev));
 697
 698   Log("Prints the $mcu MCU.", 4);
 699
 700   $ancestor = undef;
 701
 702   if ($operation == OP_OPTIMIZE)
 703     {
 704         # Optimized writing is required.
 705
 706     $min_diff = ULONG_MAX;
 707     for ($i = 0; $i < scalar(@device_names); ++$i)
 708       {
 709       $ac = $devices_by_name{$device_names[$i]};
 710
 711       last if ($Index == $i);
 712       next if ($ac->{CHILD});
 713
 714       $diff = difference_of_devices($dev, $ac);
 715
 716       if ($min_diff > $diff)
 717         {
 718         $min_diff = $diff;
 719         $ancestor = $ac;
 720         }
 721       }
 722
 723     $ancestor = undef if ($min_diff > 15);
 724     }
 725
 726   print "name        $dev->{NAME}\n";
 727
 728   if ($dev->{COMMENTS})
 729     {
 730     foreach (@{$dev->{COMMENTS}})
 731       {
 732       print "$_\n";
 733       }
 734     }
 735
 736   $ref1 = $dev->{RAM};
 737
 738   if (defined($ancestor))
 739     {
 740     $dev->{CHILD} = TRUE;
 741
 742     print  "using       $ancestor->{NAME}\n";
 743     difference_of_devices($dev, $ancestor);
 744
 745     if ($ref1->{DIFF})
 746       {
 747       $ref2 = $ancestor->{RAM};
 748
 749       if ($ref1->{SIZE} != $ref2->{SIZE})
 750         {
 751         print  "ramsize     $ref1->{SIZE}\n";
 752         }
 753
 754       if ($ref1->{SPLIT} != $ref2->{SPLIT})
 755         {
 756         printf "split       0x%02X\n", $ref1->{SPLIT};
 757         }
 758       }
 759
 760     $ref1 = $dev->{CONFIG};
 761
 762     if ($ref1->{DIFF})
 763       {
 764       print_diff_config_words($ref1->{ORD_WORDS});
 765       }
 766
 767     printf "XINST       $dev->{XINST}\n" if (($ancestor->{XINST} < 0) && ($dev->{XINST} > 0));
 768
 769     $ref1 = $dev->{ID};
 770
 771     if ($ref1->{DIFF})
 772       {
 773       print_diff_id_words($ref1->{ORD_WORDS});
 774       }
 775     }
 776   else
 777     {
 778     print  "ramsize     $ref1->{SIZE}\n";
 779     printf "split       0x%02X\n", $ref1->{SPLIT};
 780
 781     $ref1 = $dev->{CONFIG};
 782     printf "configrange 0x%06X 0x%06X\n", $ref1->{FIRST}, $ref1->{LAST};
 783     print_config_words($ref1->{ORD_WORDS});
 784
 785     printf "XINST       $dev->{XINST}\n" if ($dev->{XINST} > 0);
 786
 787     $ref1 = $dev->{ID};
 788
 789     if (($ref1->{FIRST} > 0) && ($ref1->{LAST} > 0))
 790       {
 791       printf "idlocrange  0x%06X 0x%06X\n", $ref1->{FIRST}, $ref1->{LAST};
 792       print_id_words($ref1->{ORD_WORDS});
 793       }
 794     }
 795   }
 796
 797 #---------------------------------------------------------------------------------------------------
 798
 799 sub usage()
 800   {
 801   print <<EOT
 802 Usage: $PROGRAM <option> path/to/pic16devices.txt > output.txt
 803
 804     Options are:
 805
 806         -o or --optimize
 807
 808             If a MCU features matches with an earlier listed MCU features,
 809             then use the "using" keyword and with this method significantly
 810             reduces the file size.
 811
 812         -u or --unoptimize
 813
 814             Unlocks the "using" keywords and displays the full original
 815             content.
 816
 817         -v <level> or --verbose <level>
 818
 819             It provides information on from the own operation.
 820             Possible value of the level between 0 and 10. (default: 0)
 821
 822         -h or --help
 823
 824             This text.
 825 EOT
 826 ;
 827   }
 828
 829 #   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 830 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 831 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@                     @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 832 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@   The main program.   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 833 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@                     @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 834 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 835 #   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 836
 837 $PROGRAM = basename($0);
 838
 839 for (my $i = 0; $i < @ARGV; )
 840   {
 841   my $opt = $ARGV[$i++];
 842
 843   given ($opt)
 844     {
 845     when (/^-(o|-optimize)$/o)   { $operation = OP_OPTIMIZE; }
 846
 847     when (/^-(u|-unoptimize)$/o) { $operation = OP_UNOPTIMIZE; }
 848
 849     when (/^-(v|-verbose)$/o)
 850       {
 851       param_exist($opt, $i);
 852       $verbose = int($ARGV[$i++]);
 853       $verbose = 0 if (! defined($verbose) || $verbose < 0);
 854       $verbose = 10 if ($verbose > 10);
 855       }
 856
 857     when (/^-(h|-help)$/o)
 858       {
 859       usage();
 860       exit(0);
 861       }
 862
 863     default
 864       {
 865       $file = $opt;
 866       }
 867     } # given ($opt)
 868   } # for (my $i = 0; $i < @ARGV; )
 869
 870 if (($file eq '') || ($operation == OP_NULL))
 871   {
 872   usage();
 873   exit(0);
 874   }
 875
 876 (-f $file) || die "This file - \"$file\" - not exist!";
 877
 878 read_pic16devices_txt($file);
 879
 880 @device_names = sort {versionSort($a, $b)} keys(%devices_by_name);
 881
 882 foreach (@device_names)
 883   {
 884   make_hashes($devices_by_name{$_});
 885   }
 886
 887 print join("\n", @devices_header) . "\n";
 888
 889 my $i = 0;
 890 my $v = @device_names;
 891 while (TRUE)
 892   {
 893   print_device($i);
 894   ++$i;
 895   last if ($i == $v);
 896   print "\n";
 897   }