sdcc/support/scripts/cinc2h.pl

   1 #!/usr/bin/perl -w
   2
   3 =back
   4
   5   Copyright (C) 2012-2015, Molnar Karoly <molnarkaroly@users.sf.net>
   6
   7     This file is part of SDCC.
   8
   9     This software is provided 'as-is', without any express or implied
  10     warranty.  In no event will the authors be held liable for any damages
  11     arising from the use of this software.
  12
  13     Permission is granted to anyone to use this software for any purpose,
  14     including commercial applications, and to alter it and redistribute it
  15     freely, subject to the following restrictions:
  16
  17     1. The origin of this software must not be misrepresented; you must not
  18        claim that you wrote the original software. If you use this software
  19        in a product, an acknowledgment in the product documentation would be
  20        appreciated but is not required.
  21
  22     2. Altered source versions must be plainly marked as such, and must not be
  23        misrepresented as being the original software.
  24
  25     3. This notice may not be removed or altered from any source distribution.
  26
  27 ================================================================================
  28
  29   cinc2h.pl (common-inc2h.pl)
  30
  31   This program parse the gpasm header (p1xxx.inc) files and creates
  32   from them the SDCC header and device library files. In addition it
  33   needs the gpprocessor.c file also. These is included in the source
  34   package of gputils. Mode of download of the latest source:
  35
  36         http://gputils.sourceforge.net/#Download
  37
  38   The program is available on request provide assistance: cinc2h.pl -h
  39
  40   -------------------------------------------------
  41
  42   Steps to add a new target device to SDCC/PIC16:
  43   (Following Raphael Neider <rneider AT web.de>)
  44
  45    1. Create the picDEVICE.c and picDEVICE.h from pDEVICE.inc using
  46       ./cinc2h.pl -p 18f4520 -cb -cp -gp "path/to/gputils_source" -o "path/to/output"
  47
  48    2. mv picDEVICE.h $SDCC/device/non-free/include/pic16
  49    3. mv picDEVICE.c $SDCC/device/non-free/lib/pic16/libdev
  50    4. either
  51
  52       (a) adjust $SDCC/device/lib/pic16/libio/*.ignore
  53           if the device does not support ADC, I2C, or USART
  54           --- OR ---
  55       (b) adjust
  56           * SDCC/scripts/pic18fam-h-gen.pl
  57           * SDCC/device/include/pic16/adc.h (if required)
  58           * SDCC/device/include/pic16/usart.h (if required)
  59           * SDCC/device/lib/pic16/libio/*/* (if required)
  60           to add the new device to the appropriate I/O style
  61           and implement new styles (if required).
  62
  63           Having modified pic18fam-h-gen.pl, you need to run the
  64           script to generate pic18fam.h.gen, which in turn must
  65           then replace your .../include/pic16/pic18fam.h to take
  66           effect; see pic18fam-h-gen.pl for usage information.
  67    6. edit $SDCC/device/include/pic16/pic18fregs.h
  68    7. edit $SDCC/device/include/pic16/pic16devices.txt
  69    8. run cd $SDCC/device/non-free/lib/pic16 && sh update.sh
  70       to regenerate .../libdev/Makefile.am and processors.ac
  71
  72    The file format of steps 6 and 7 is self explanatory, in most
  73    if not all cases you can copy and paste another device's records
  74    and adjust them to the newly added device.
  75
  76   -------------------------------------------------
  77
  78   Steps to add a new target device to SDCC/PIC14:
  79
  80    1. Create the picDEVICE.c and picDEVICE.h from pDEVICE.inc using
  81       ./cinc2h.pl -p 16f1503 -cb -cp -gp "path/to/gputils_source" -o "path/to/output"
  82
  83    2. mv picDEVICE.h $SDCC/device/non-free/include/pic14
  84    3. mv picDEVICE.c $SDCC/device/non-free/lib/pic14/libdev
  85    4. add DEVICE to $SDCC/device/non-free/lib/pic14/libdev/devices.txt
  86       (The names of the enhanced devices the "# enhanced cores" line
  87        after follow.)
  88
  89    5. edit $SDCC/device/include/pic14/pic14devices.txt
  90
  91    The file format of step 5 is self explanatory, in most if not all
  92    cases you can copy and paste another device's records and adjust
  93    them to the newly added device.
  94
  95   $Id$
  96 =cut
  97
  98 use strict;
  99 use warnings;
 100 no if $] >= 5.018, warnings => "experimental::smartmatch";        # perl 5.16
 101 use 5.12.0;                     # when (regex)
 102 use File::Path 'make_path';
 103 use feature 'switch';           # Starting from 5.10.1.
 104 use POSIX qw(strftime);
 105
 106 use constant FALSE => 0;
 107 use constant TRUE  => 1;
 108
 109 use constant ST_NONE       => 0;
 110 use constant ST_REG_ADDR   => 1;
 111 use constant ST_REG1_DEF   => 2;
 112 use constant ST_REG2_DEF   => 3;
 113 use constant ST_RAM_DEF    => 4;
 114 use constant ST_CONFIG_DEF => 5;
 115 use constant ST_DEVID_DEF  => 6;
 116 use constant ST_IDLOC_DEF  => 7;
 117
 118 use constant DIST_ADDRSIZE => 32;
 119 use constant DIST_BITSIZE  => 32;
 120 use constant DIST_DEFSIZE  => 32;
 121 use constant DIST_COMSIZE  => 32;
 122
 123 my $PROGRAM  = 'cinc2h.pl';
 124 my $time_str = '';
 125 my $year     = '';
 126
 127 my $gputils_path   = "$ENV{HOME}/svn_snapshots/gputils/gputils";
 128 my $gp_header_path = '';
 129 my $gpprocessor_c  = 'gpprocessor.c';
 130 my $gpproc_path;
 131
 132 my $name_filter = qr/10l?f\d+[a-z]*|1[26]((c(e|r)?)|hv)\d+[a-z]*|1[268]l?f\d+([a-z]*|[a-z]+\d+[a-z]*)/;
 133 my $header_name_filter = 'p${name_filter}.inc';
 134
 135 my $p14_out_path = 'pic14';
 136 my $p16_out_path = 'pic16';
 137
 138 my $mcu;
 139 my $short_mcu_name;
 140 my $is_pic16   = FALSE;
 141 my $conf_size  = 4;
 142 my $caddr_size = 4;
 143 my $conf_head  = '_';
 144 my $verbose    = 0;
 145
 146 my $create_bitfields  = FALSE;
 147 my $emit_legacy_names = FALSE;
 148 my $no_timestamp      = FALSE;
 149
 150 my $section = '//' . ('=' x 78);
 151 my $btail = 'bits';
 152 my $btype_t = "${btail}_t";
 153
 154         # Here those names to be entered that are defective.
 155         # BAD => 'GOOD'  or
 156         # 'BAD' => 'GOOD'
 157
 158 my %correction_of_names =
 159   (
 160   OPTION => 'OPTION_REG'
 161   );
 162
 163         # At some processors there is such register name, that is different
 164         # from what the other processors in used. This is a replacement table.
 165
 166 my %register_aliases =
 167   (
 168   BAUDCTL => 'BAUDCON'
 169   );
 170
 171 #-----------------------------------------------
 172
 173 =back
 174         The structure of one element of the @registers array:
 175
 176         {
 177         NAME        => '',      The name of register.
 178         ADDRESS     => 0,       The address of register.
 179         NEED_PREFIX => 0,       Indicates if in front the name of bits necessary an prefix.
 180         BITNAMES    => [        The bits of register.
 181                          [],      The names of 0th bit.
 182                          [],
 183                          [],
 184                          [],
 185                          [],
 186                          [],
 187                          [],
 188                          []       The names of 7th bit.
 189                        ],
 190
 191                        ...
 192
 193                        []
 194
 195         BITFIELDS   => {
 196                        'ADCS' => {           This the descriptor of the ADCS field.
 197                                  ADDRESSES => [],  Physical start addresses of bits of the field.
 198                                  INDEXES   => [],  Bit indexes of bits of the field (ADCS2 -> '2').
 199                                  WIDTH     => 0    So many bit the width of the bit-field.
 200                                  },
 201
 202                        'ANS'  => {}
 203
 204                        ...
 205
 206                        }
 207         }
 208 =cut
 209
 210 my @registers = ();
 211
 212 #-----------------------------------------------
 213
 214         # References of registers according to name of registers.
 215 my %reg_refs_by_names = ();
 216
 217         # References of registers according to name of bits of registers.
 218         # With help of recognizable the repetitive bit names.
 219 my %reg_refs_by_bits = ();
 220
 221 #-----------------------------------------------
 222
 223 =back
 224         The structure of one element of the @configs array:
 225
 226         {
 227         NAME    => '',      The name of config.
 228         ADDRESS => 0,       The address of config.
 229         OPTIONS => [        The options of config.
 230                      {
 231                      NAME        => '',
 232                      VALUE       => 0,
 233                      EXPLANATION => ''
 234                      },
 235
 236                      ...
 237
 238                      {
 239                      }
 240                    ]
 241         }
 242 =cut
 243
 244 my @configs = ();
 245
 246 #-----------------------------------------------
 247
 248 my %conf_names = ();
 249
 250 my @devids = ();
 251 my @idlocs = ();
 252
 253 my $header_name;
 254 my $device_name;
 255 my $out_path = './';
 256 my $out_handler;
 257
 258 my $device_registers = '';
 259 my $full_bitdefs     = '';
 260 my $legacy_names     = '';
 261
 262 ################################################################################
 263 ################################################################################
 264 ################################################################################
 265 ################################################################################
 266
 267 sub basename($)
 268   {
 269   return ($_[0] =~ /([^\/]+)$/) ? $1 : '';
 270   }
 271
 272 #-------------------------------------------------------------------------------
 273
 274 sub param_exist($$)
 275   {
 276   die "This option \"$_[0]\" requires a parameter.\n" if ($_[1] > $#ARGV);
 277   }
 278
 279 #-------------------------------------------------------------------------------
 280
 281 sub str2int($)
 282   {
 283   my $Str = $_[0];
 284
 285   return hex($1)   if ($Str =~ /^H'([[:xdigit:]]+)'$/io);
 286   return hex($1)   if ($Str =~ /^0x([[:xdigit:]]+)$/io);
 287   return int($Str) if ($Str =~ /^-?\d+$/o);
 288
 289   die "str2int(): This string not integer: \"$Str\"";
 290   }
 291
 292 #-------------------------------------------------------------------------------
 293
 294 sub align($$)
 295   {
 296   my $text = $_[0];
 297   my $al   = $_[1] - length($text);
 298
 299         # One space will surely becomes behind it.
 300   $al = 1 if ($al < 1);
 301
 302   return ($text . ' ' x $al);
 303   }
 304
 305 #-------------------------------------------------------------------------------
 306
 307 sub Log
 308   {
 309   return if (pop(@_) > $verbose);
 310   foreach (@_) { print $_; }
 311   print "\n";
 312   }
 313
 314 #-------------------------------------------------------------------------------
 315
 316 sub Out
 317   {
 318   foreach (@_) { print $out_handler $_; }
 319   }
 320
 321 #-------------------------------------------------------------------------------
 322
 323 sub Outl
 324   {
 325   Out(@_);
 326   print $out_handler "\n";
 327   }
 328
 329 #-------------------------------------------------------------------------------
 330
 331 sub versionCompare($$)
 332   {
 333   my ($Str1, $Str2) = @_;
 334
 335   if ((${$Str1} =~ /^\d/o) && (${$Str2} =~ /^\d/o))
 336     {
 337         # $Str1 number and $Str2 number
 338     return (int(${$Str1}) <=> int(${$Str2}));
 339     }
 340
 341   return (${$Str1} cmp ${$Str2});
 342   }
 343
 344 #-------------------------------------------------------------------------------
 345
 346 sub versionSort($$)
 347   {
 348   my @a_s = ($_[0] =~ /(\d+|\D+)/go);
 349   my @b_s = ($_[1] =~ /(\d+|\D+)/go);
 350   my ($i, $k, $end, $ret);
 351
 352   $i = scalar(@a_s);
 353   $k = scalar(@b_s);
 354
 355   if ($i < $k)
 356     {
 357     $end = $i;
 358     $ret = -1;
 359     }
 360   elsif ($i == $k)
 361     {
 362     $end = $i;
 363     $ret = 0;
 364     }
 365   else
 366     {
 367     $end = $k;
 368     $ret = 1;
 369     }
 370
 371   for ($i = 0; $i < $end; ++$i)
 372     {
 373     $k = versionCompare(\$a_s[$i], \$b_s[$i]);
 374
 375     return $k if ($k != 0);
 376     }
 377
 378   return $ret;
 379   }
 380
 381 #   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 382 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 383 #@@@@@@@@@@@@@                                                      @@@@@@@@@@@@
 384 #@@@@@@@@@@@@  Load all definitions, which will find in the header.  @@@@@@@@@@@
 385 #@@@@@@@@@@@@@                                                      @@@@@@@@@@@@
 386 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 387 #   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 388
 389         # If the $Word included in a list then it will replace.
 390
 391 sub correct_name($)
 392   {
 393   my $Word = $_[0];
 394   my $corr = $correction_of_names{$Word};
 395
 396   if (defined($corr))
 397     {
 398     Log("$Word --> $corr ($mcu)", 7);
 399     return $corr;
 400     }
 401
 402   return $Word;
 403   }
 404
 405 #-------------------------------------------------------------------------------
 406
 407         # Adds to the list the $Name register.
 408
 409 sub new_register($$)
 410   {
 411   my ($Name, $Address) = @_;
 412
 413   if (defined($reg_refs_by_names{$Name}))
 414     {
 415     die "The \"$Name\" register has been included on the list. ($mcu)\n";
 416     }
 417
 418   my $reg = {
 419             NAME        => correct_name($Name),
 420             ADDRESS     => $Address,
 421             NEED_PREFIX => FALSE,
 422             BITNAMES    => undef,
 423             BITFIELDS   => undef
 424             };
 425
 426   push(@registers, $reg);
 427   $reg_refs_by_names{$Name} = $reg;
 428   return $reg;
 429   }
 430
 431 #-------------------------------------------------------------------------------
 432
 433         # Cuts the unnecessary prefix or suffix.
 434
 435 sub bit_filtration($$)
 436   {
 437   my ($Regname, $Bits) = @_;
 438
 439   for (my $i = 0; $i < 8; ++$i)
 440     {
 441     my $array = $Bits->[$i];
 442
 443     next if (! defined($array));
 444
 445     my $changed = 0;
 446     my $new_bits = [];
 447
 448     foreach (@{$array})
 449       {
 450         # $Regname : 'CMCON'
 451         # $_       : 'C1OUT_CMCON'
 452         # Operation: 'C1OUT_CMCON' --> 'C1OUT'
 453         #
 454
 455       $changed += ($_ =~ s/^${Regname}_|_${Regname}$//);
 456       $changed += ($_ =~ s/^(\d+)$/bit_$1/o);
 457       push(@{$new_bits}, $_);
 458       }
 459
 460     $Bits->[$i] = $new_bits if ($changed);
 461     }
 462   }
 463
 464 #-------------------------------------------------------------------------------
 465
 466         # Tries the $Bit insert into a bitfield of the $Register.
 467
 468 sub bitfield_preparation($$$)
 469   {
 470   my ($Register, $Bit, $Address) = @_;
 471   my $fields = $Register->{BITFIELDS};
 472
 473   $fields = $Register->{BITFIELDS} = {} if (! defined($fields));
 474
 475   Log("BIT: $Bit", 7);
 476
 477   if ($Bit =~ /(\d+)$/op)
 478     {
 479     my $flname = ${^PREMATCH};
 480     my $flidx  = $1;
 481
 482     if (! defined($fields->{$flname}))
 483       {
 484         # Creates a new field.
 485
 486       Log("BIT first    : $flname\[$Address\] = '$flidx'", 7);
 487       $fields->{$flname} = {
 488                            ADDRESSES => [ $Address ],
 489                            INDEXES   => [],
 490                            WIDTH     => 0
 491                            };
 492       }
 493     else
 494       {
 495         # The bit inserts into an existing field.
 496
 497       Log("BIT remaining: $flname\[$Address\] = '$flidx'", 7);
 498       push(@{$fields->{$flname}->{ADDRESSES}}, $Address);
 499       }
 500
 501     $fields->{$flname}->{INDEXES}->[$Address] = $flidx;
 502     }
 503   }
 504
 505 #-------------------------------------------------------------------------------
 506
 507         # If can, classifies the $Bits into a field.
 508
 509 sub bitfield_registration($$)
 510   {
 511   my ($Register, $Bits) = @_;
 512
 513   for (my $i = 0; $i < 8; ++$i)
 514     {
 515     my $array = $Bits->[$i];
 516
 517     next if (! defined($array));
 518
 519     Log("bitfield_registration() -- $i", 8);
 520     foreach (@{$array})
 521       {
 522       bitfield_preparation($Register, $_, $i);
 523       }
 524     }
 525   }
 526
 527 #-------------------------------------------------------------------------------
 528
 529         # In the $Queue are in register's names.
 530         # Assigns to these the contents of $Bits.
 531
 532 sub add_reg_bits($$)
 533   {
 534   my ($Queue, $Bits) = @_;
 535
 536   return if ((scalar(@{$Queue}) == 0) || (scalar(@{$Bits}) == 0));
 537
 538   foreach (@{$Queue})
 539     {
 540     next if ($_ eq 'and');      # This here easiest to filter out.
 541
 542     my $name = correct_name($_);
 543     my $reg = $reg_refs_by_names{$name};
 544
 545     if (! defined($reg))
 546       {
 547       Log("The $name register is not directly be reached or does not exist. ($mcu)", 2);
 548       $reg = new_register($name, -1);
 549       }
 550
 551     bit_filtration($name, $Bits);
 552     bitfield_registration($reg, $Bits);
 553     $reg->{BITNAMES} = [ @{$Bits} ];
 554     }
 555
 556   @{$Queue} = ();
 557   @{$Bits}  = ();
 558   }
 559
 560 #-------------------------------------------------------------------------------
 561
 562         # Finds the $Name in the $Bits.
 563
 564 sub find_bit($$)
 565   {
 566   my ($Bits, $Name) = @_;
 567
 568   return FALSE if (! defined($Bits));
 569
 570   for (my $i = 0; $i < 8; ++$i)
 571     {
 572     my $array = $Bits->[$i];
 573
 574     next if (! defined($array));
 575
 576     foreach (@{$array})
 577       {
 578       return TRUE if ($_ eq $Name);
 579       }
 580     }
 581
 582   return FALSE;
 583   }
 584
 585 #-------------------------------------------------------------------------------
 586
 587         # Adds to the list the $Name config byte/word.
 588
 589 sub add_conf_word($$)
 590   {
 591   my ($Name, $Address) = @_;
 592
 593   my $conf = $conf_names{$Name};
 594
 595   if (defined($conf))
 596     {
 597         # The $Name config byte/word still unknown, but there are related words.
 598
 599         # If the $Name config byte/word are defined later than
 600         # the associated bits, then this section is executed.
 601         #
 602
 603     $conf->{ADDRESS} = $Address if ($conf->{ADDRESS} < 0 && $Address >= 0);
 604     }
 605   else
 606     {
 607         # The $Name config byte/word still unknown and there are no related words.
 608
 609     $conf = {
 610             NAME    => $Name,
 611             ADDRESS => $Address,
 612             OPTIONS => []
 613             };
 614
 615     push(@configs, $conf);
 616     $conf_names{$Name} = $conf;
 617     }
 618   }
 619
 620 #-------------------------------------------------------------------------------
 621
 622 sub add_conf_options($$)
 623   {
 624   my ($Queue, $Options) = @_;
 625
 626   return if ((scalar(@{$Queue}) == 0) || (scalar(@{$Options}) == 0));
 627
 628   foreach (@{$Queue})
 629     {
 630     my $conf = $conf_names{$_};
 631
 632     die "This config unknown: \"$_\" ($mcu)\n" if (! defined($conf));
 633
 634     $conf->{OPTIONS} = [ @{$Options} ];
 635     }
 636
 637   @{$Queue}   = ();
 638   @{$Options} = ();
 639   }
 640
 641 #-------------------------------------------------------------------------------
 642
 643         # Reads the entire content of the $File.
 644
 645 sub read_content_from_header($)
 646   {
 647   my $File = $_[0];
 648   my ($state, $name, $addr);
 649   my @queue;
 650   my @array;
 651
 652   open(IN, '<', $File) || die "Can not open the $File header file!\n";
 653
 654   $state = ST_NONE;
 655   @queue = ();
 656   @array = ();
 657
 658   foreach (grep(! /^\s*$/o, <IN>))
 659     {
 660     chomp;
 661     s/\r$//o;
 662     s/^\s*|\s*$//go;
 663
 664     my $line = $_;
 665
 666     Log("#### \"$line\"", 8);
 667
 668     given ($state)
 669       {
 670       when (ST_NONE)
 671         {
 672         Log(":::: ST_NONE ($line) ($mcu)", 4);
 673
 674         $state = ST_REG_ADDR if ($line =~ /^;-+\s*Register\s+Files\s*-+$/io);
 675         }
 676
 677      when (ST_REG_ADDR)
 678         {
 679         Log(":::: ST_REG_ADDR ($line) ($mcu)", 4);
 680
 681         if ($line =~ /^;-+\s*(.+)Bits\s*-+$/io)
 682           {
 683         # ;----- STKPTR Bits --------------------------------------------------------
 684         # ;----- UIR/UIE Bits -------------------------------------------------------
 685         # ;----- TXSTA, TXSTA1 and TXSTA2 Bits --------------------------------------
 686         #
 687
 688         # Therefore need the queue because more register names can be on one line.
 689
 690           @queue = ($1 =~ /([^\s,\/]+)/go);
 691           $state = ST_REG1_DEF;
 692           }
 693         elsif ($line =~ /^(\w+)\s+EQU\s+([\w']+)$/io)  #'
 694           {
 695         # PORTC     EQU  H'0007'
 696         #
 697
 698           new_register($1, str2int($2));
 699           }
 700         } # when (ST_REG_ADDR)
 701
 702       when (ST_REG1_DEF)
 703         {
 704         Log(":::: ST_REG1_DEF ($line) ($mcu)", 4);
 705
 706         if ($line =~ /^;\s*I\/O\s+Pin\s+Name\s+Definitions?$/io)
 707           {
 708         # ;       I/O Pin Name Definitions
 709         #
 710
 711           Log("1 +++ add_reg_bits()", 6);
 712           add_reg_bits(\@queue, \@array);
 713           $state = ST_REG2_DEF;
 714           }
 715         elsif ($line =~ /^;\s*RAM\s+Definitions?$/io)
 716           {
 717         # ;       RAM Definition
 718         # ;       RAM Definitions
 719         #
 720
 721           Log("2 +++ add_reg_bits()", 6);
 722           add_reg_bits(\@queue, \@array);
 723           $state = ST_RAM_DEF;
 724           }
 725         elsif ($line =~ /^;-+\s*(.+)Bits\s*-+$/io)
 726           {
 727           my $name = $1;
 728
 729           Log("3 +++ add_reg_bits()", 6);
 730           add_reg_bits(\@queue, \@array);
 731
 732         # Therefore need the queue because more register names can be on one line.
 733
 734           @queue = ($name =~ /([^\s,\/]+)/go);
 735           }
 736         elsif ($line =~ /^(\w+)\s+EQU\s+([\w']+)$/io)  #'
 737           {
 738         # VR2       EQU  H'0002'
 739         #
 740
 741           push(@{$array[str2int($2)]}, $1);
 742           }
 743         } # when (ST_REG1_DEF)
 744
 745       when (ST_REG2_DEF)
 746         {
 747         Log(":::: ST_REG2_DEF ($line) ($mcu)", 4);
 748
 749         if ($line =~ /^;\s*RAM\s+Definitions?$/io)
 750           {
 751         # ;       RAM Definition
 752         # ;       RAM Definitions
 753         #
 754
 755           Log("4 +++ add_reg_bits()", 6);
 756           add_reg_bits(\@queue, \@array);
 757           $state = ST_RAM_DEF;
 758           }
 759         elsif ($line =~ /^;-+\s*([^-]+)\s*-+$/io)
 760           {
 761           my $name = $1;
 762
 763           Log("5 +++ add_reg_bits()", 6);
 764           add_reg_bits(\@queue, \@array);
 765
 766         # Therefore need the queue because more register names can be on one line.
 767
 768           @queue = ($name =~ /([^\s,\/]+)/go);
 769           }
 770         elsif ($line =~ /^(\w+)\s+EQU\s+([\w']+)$/io)  #'
 771           {
 772         # RE3      EQU  3
 773         #
 774
 775           push(@{$array[int($2)]}, $1);
 776           }
 777         } # when (ST_REG2_DEF)
 778
 779       when (ST_RAM_DEF)
 780         {
 781         Log(":::: ST_RAM_DEF ($line) ($mcu)", 4);
 782
 783         $state = ST_CONFIG_DEF if ($line =~ /^;\s*Configuration\s+Bits$/io);
 784         }
 785
 786       when (ST_CONFIG_DEF)
 787         {
 788         Log(":::: ST_CONFIG_DEF ($line) ($mcu)", 4);
 789
 790         if ($line =~ /^_(DEVID\d*)\s+EQU\s+([\w']+)$/io)  #'
 791           {
 792           add_conf_options(\@queue, \@array);
 793
 794           Log("DEVID: $line", 6);
 795           push(@devids, { NAME => $1, ADDRESS => str2int($2) });
 796           $state = ST_DEVID_DEF;
 797           }
 798         elsif ($line =~ /^_(IDLOC\d*)\s+EQU\s+([\w']+)$/io)  #'
 799           {
 800           add_conf_options(\@queue, \@array);
 801
 802           Log("IDLOC: $line", 6);
 803           push(@idlocs, { NAME => $1, ADDRESS => str2int($2) });
 804           $state = ST_IDLOC_DEF;
 805           }
 806         elsif ($line =~ /^_(CONFIG\d*\w*)\s+EQU\s+([\w']+)$/io)  #'
 807           {
 808           Log("CONFIG: $line", 6);
 809           add_conf_word(uc($1), str2int($2));
 810           }
 811         elsif ($line =~ /^;\s*-+\s*(Config\d*\w*)\s+Options\s*-+$/io)
 812           {
 813           my $name = uc($1);
 814
 815           Log("1. Config: $line", 6);
 816           add_conf_options(\@queue, \@array);
 817           add_conf_word($name, -1);
 818           push(@queue, $name);
 819           }
 820         elsif ($line =~ /^;\s*-+\s*Config\s+Word(\d+)\s+Options\s*-+$/io ||
 821                $line =~ /^;\s*Configuration\s+Byte\s+(\d+[HL])\s+Options$/io)
 822           {
 823           my $name = "CONFIG$1";
 824
 825           Log("2. Config: $line", 6);
 826           add_conf_options(\@queue, \@array);
 827           add_conf_word($name, 0);
 828           push(@queue, $name);
 829           }
 830         elsif ($line =~ /^(\w+)\s+EQU\s+([\w']+)(.+)?$/io)  #'
 831           {
 832           my ($name, $value) = ($1, str2int($2));
 833           my $expl = '';
 834
 835           if (defined($3))
 836             {
 837             $expl = $3;
 838             $expl =~ s/\s*;\s*//;
 839             }
 840
 841           Log("Config option: $line", 6);
 842           push(@array, { NAME => $name, VALUE => $value, EXPLANATION => $expl });
 843           }
 844         } # when (ST_CONFIG_DEF)
 845
 846       when (ST_DEVID_DEF)
 847         {
 848         Log(":::: ST_DEVID_DEF ($line) ($mcu)", 4);
 849
 850         if ($line =~ /^_(IDLOC\d*)\s+EQU\s+([\w']+)$/io)  #'
 851           {
 852           Log("IDLOC: $line", 6);
 853           push(@idlocs, { NAME => $1, ADDRESS => str2int($2) });
 854           $state = ST_IDLOC_DEF;
 855           }
 856         elsif ($line =~ /^_(DEVID\d*)\s+EQU\s+([\w']+)$/io)  #'
 857           {
 858           Log("DEVID: $line", 6);
 859           push(@devids, { NAME => $1, ADDRESS => str2int($2) });
 860           }
 861         }
 862
 863       when (ST_IDLOC_DEF)
 864         {
 865         Log(":::: ST_IDLOC_DEF ($line) ($mcu)", 4);
 866
 867         if ($line =~ /^_(IDLOC\d*)\s+EQU\s+([\w']+)$/io)  #'
 868           {
 869           Log("IDLOC: $line", 6);
 870           push(@idlocs, { NAME => $1, ADDRESS => str2int($2) });
 871           }
 872         }
 873       } # given ($state)
 874     } # foreach (grep(! /^\s*$/o, <IN>))
 875
 876   add_conf_options(\@queue, \@array);
 877
 878   close(IN);
 879
 880   return if (! scalar(@registers));
 881
 882         # Within the array sorts by address the registers.
 883
 884   @registers = sort {$a->{ADDRESS} <=> $b->{ADDRESS}} @registers;
 885   }
 886
 887 #-------------------------------------------------------------------------------
 888
 889         # Reads the bounds of config area from the gpprocesor.c file.
 890
 891 sub extract_config_area($$)
 892   {
 893   my ($Conf_start, $Conf_end) = @_;
 894
 895   open(LIB, '<', $gpproc_path) || die "extract_config_area(): Can not open. -> \"$gpproc_path\"\n";
 896
 897         # static struct px pics[] = {
 898         #   { PROC_CLASS_PIC12E   , "__12F529T39A"  , { "pic12f529t39a"  , "p12f529t39a"    , "12f529t39a"      }, 0xE529,  3,    8, 0x00E0, { 0x07, 0x0F }, 0x06F, {     -1,     -1 }, 0x00FF, 0x0005FF, 0x000600, {       -1,       -1 }, { 0x000640, 0x000643 }, { 0x000FFF, 0x000FFF }, { 0x000600, 0x00063F }, 0x0FF0, "p12f529t39a.inc"  , "12f529t39a_g.lkr"  , 0 },
 899         #   { PROC_CLASS_PIC14E   , "__16LF1517"    , { "pic16lf1517"    , "p16lf1517"      , "16lf1517"        }, 0xA517,  4,   32, 0x0F80, { 0x70, 0x7F },    -1, { 0x2000, 0x21EF }, 0x0FFF, 0x001FFF, 0x002000, {       -1,       -1 }, { 0x008000, 0x008003 }, { 0x008007, 0x008008 }, {       -1,       -1 }, 0x3F80, "p16lf1517.inc"    , "16lf1517_g.lkr"    , 0 },
 900
 901   my $in_table = FALSE;
 902
 903   while (<LIB>)
 904     {
 905     chomp;
 906
 907     if (! $in_table)
 908       {
 909       $in_table = TRUE if (/^\s*static\s+struct\s+px\s+pics\[\s*\]\s*=\s*\{\s*$/io);
 910       }
 911     elsif (/\{\s*PROC_CLASS_\w+\s*,\s*"\w+"\s*,\s*\{\s*"\w+"\s*,\s*"\w+"\s*,\s*"(\w+)"\s*}\s*,\s*[\w-]+\s*,\s*[\w-]+\s*,\s*[\w-]+\s*,\s*[\w-]+\s*,\s*\{\s*\S+\s*,\s*\S+\s*\}\s*,\s*\S+\s*,\s*\{\s*\S+\s*,\s*\S+\s*\}\s*,\s*\S+\s*,\s*\S+\s*,\s*\S+\s*,\s*\{\s*\S+\s*,\s*\S+\s*\}\s*,\s*{\s*\S+\s*,\s*\S+\s*\}\s*,\s*{\s*(\S+)\s*,\s*(\S+)\s*\}\s*,\s*{\s*\S+\s*,\s*\S+\s*\}\s*,\s*\w+\s*,\s*\"?[\.\w]+\"?\s*,\s*\"?[\.\w]+\"?\s*,\s*\d+\s*\}/iop)
 912       {
 913       my ($name, $c_start, $c_end) = ($1, $2, $3);
 914
 915       if ($short_mcu_name eq $name)
 916         {
 917         ${$Conf_start} = str2int($c_start);
 918         ${$Conf_end}   = str2int($c_end);
 919         last;
 920         }
 921       }
 922     else
 923       {
 924       last;
 925       }
 926     }
 927
 928   close(LIB);
 929   }
 930
 931 #   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 932 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 933 #@@@@@@@@@@@@@@@@@@@@@                                  @@@@@@@@@@@@@@@@@@@@@@@@
 934 #@@@@@@@@@@@@@@@@@@@@  Prints the register definitions.  @@@@@@@@@@@@@@@@@@@@@@@
 935 #@@@@@@@@@@@@@@@@@@@@@                                  @@@@@@@@@@@@@@@@@@@@@@@@
 936 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 937 #   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 938
 939         # A bit may be more than one name. This procedure counts that how
 940         # many the most of name.
 941
 942 sub max_count_of_names_of_bit($)
 943   {
 944   my $Bits = $_[0];
 945   my $num = 0;
 946
 947   for (my $i = 0; $i < 8; ++$i)
 948     {
 949     my $array = $Bits->[$i];
 950
 951     next if (! defined($array));
 952
 953     my $l = scalar(@{$array});
 954
 955     $num = $l if ($num < $l);
 956     }
 957
 958   return $num;
 959   }
 960
 961 #-------------------------------------------------------------------------------
 962
 963         # There are certain bits that have the same name in other registers
 964         # also. In this case, in the definitions of bit names need apply
 965         # a prefix, that allows the bits to distinguish from each other.
 966         # This function this need is recorded in the affected registers.
 967
 968 sub set_bit_prefix()
 969   {
 970   foreach my $register (sort {versionSort($a->{NAME}, $b->{NAME})} @registers)
 971     {
 972     my $bits = $register->{BITNAMES};
 973
 974     next if (! defined($bits));
 975
 976     for (my $i = 0; $i < 8; ++$i)
 977       {
 978       my $array = $bits->[$i];
 979
 980       next if (! defined($array));
 981
 982       foreach (@{$array})
 983         {
 984         my $reg = $reg_refs_by_bits{$_};
 985
 986         if (defined($reg))
 987           {
 988           Log("The $_ bit of the $register->{NAME} register is occupied in $reg->{NAME} register. ($mcu)", 3);
 989           $register->{NEED_PREFIX} = TRUE;
 990           }
 991         else
 992           {
 993           $reg_refs_by_bits{$_} = $register;
 994           }
 995         }
 996       }
 997     }
 998   }
 999
1000 #-------------------------------------------------------------------------------
1001
1002         # Prints the $Index numbered $Bits of a register.
1003
1004 sub print_bits($$$)
1005   {
1006   my ($Bits, $Index, $Align) = @_;
1007   my $al = ' ' x $Align;
1008
1009   for (my $i = 0; $i < 8; ++$i)
1010     {
1011     my $array = $Bits->[$i];
1012     my $str;
1013     my $bit = (defined($array) && defined($str = $array->[$Index])) ? " $str" : '';
1014
1015     Outl(align("${al}unsigned$bit", DIST_BITSIZE), ': 1;');
1016     }
1017   }
1018
1019 #-------------------------------------------------------------------------------
1020
1021         # Prints all bits of a register.
1022
1023 sub print_local_bitdefs($)
1024   {
1025   my $Register = $_[0];
1026   my $bits = $Register->{BITNAMES};
1027   my $head = ($Register->{NEED_PREFIX}) ? "$Register->{NAME}_" : '';
1028
1029   for (my $i = 0; $i < 8; ++$i)
1030     {
1031     my $array = $bits->[$i];
1032
1033     next if (! defined($array));
1034
1035     foreach (@{$array})
1036       {
1037       Outl(align("#define _${head}$_", DIST_DEFSIZE), sprintf('0x%02X', 1 << $i));
1038       }
1039     }
1040   }
1041
1042 #-------------------------------------------------------------------------------
1043
1044         # Deletes the false or fragmentary bitfields.
1045
1046 sub bitfield_filtration($)
1047   {
1048   my ($bits, $fields) = ($_[0]->{BITNAMES}, $_[0]->{BITFIELDS});
1049
1050         # Does not have a bitfields.
1051
1052   return if (! defined($fields));
1053
1054   foreach my $field_name (keys(%{$fields}))
1055     {
1056     my ($first_addr, $last_addr, $last_index);
1057     my $gr = $fields->{$field_name};
1058
1059     Log("bitfield_filtration() -- $field_name", 8);
1060
1061     if (find_bit($bits, $field_name))
1062       {
1063         # The $field_name already exists in the $bits array.
1064         # Name conflict.
1065
1066       delete($fields->{$field_name});
1067       next;
1068       }
1069
1070     @{$gr->{ADDRESSES}} = sort {$a <=> $b} @{$gr->{ADDRESSES}};
1071
1072     my ($addresses, $indexes) = ($gr->{ADDRESSES}, $gr->{INDEXES});
1073
1074     $first_addr = $addresses->[0];
1075
1076     if ((scalar(@{$addresses}) < 2) || ($indexes->[$first_addr] != 0))
1077       {
1078         # This is not field, for only one member of there is. The other
1079         # possibility is that the index of the first member is not zero.
1080
1081       delete($fields->{$field_name});
1082       next;
1083       }
1084
1085     $last_addr  = -1;
1086     $last_index = -1;
1087
1088     foreach (@{$addresses})
1089       {
1090       my $idx = $indexes->[$_];
1091
1092       if ($last_addr >= 0)
1093         {
1094         if ((($last_addr + 1) != $_) || (($last_index + 1) != $idx))
1095           {
1096         # This bitfield is fragmented (not uniform).
1097
1098           $last_addr = -1;
1099           last;
1100           }
1101         }
1102
1103       $last_addr  = $_;
1104       $last_index = $idx;
1105       }
1106
1107         # This is the width of the bitfield.
1108
1109     my $width = $last_addr - $first_addr + 1;
1110
1111     if (($width > 0) && ($width < 8))
1112       {
1113       $gr->{WIDTH} = $width;
1114       }
1115     else
1116       {
1117       delete($fields->{$field_name});
1118       }
1119     } # foreach my $field_name (keys(%{$fields}))
1120   }
1121
1122 #-------------------------------------------------------------------------------
1123
1124 sub print_bitfield($$$)
1125   {
1126   my ($Name, $Group, $Align) = @_;
1127   my ($addr, $width) = ($Group->{ADDRESSES}->[0], $Group->{WIDTH});
1128   my $al = ' ' x $Align;
1129
1130   Outl(align("${al}unsigned", DIST_BITSIZE), ": $addr;") if ($addr > 0);
1131   Outl(align("${al}unsigned $Name", DIST_BITSIZE), ": $width;");
1132   $width = 8 - ($addr + $width);
1133   Outl(align("${al}unsigned", DIST_BITSIZE), ": $width;") if ($width > 0);
1134   }
1135
1136 #-------------------------------------------------------------------------------
1137
1138         # Prints all bits of all registers.
1139
1140 sub print_all_registers()
1141   {
1142   my $fields;
1143   my @field_names;
1144   my ($bit_struct_num, $field_struct_num, $all_struct_num);
1145   my ($alias, $i, $r, $text, $type, $v);
1146
1147   $v = @registers;
1148   for ($r = 0; $r < $v;)
1149     {
1150     my $reg = $registers[$r];
1151     ++$r;
1152
1153     my ($name, $addr, $bits) = ($reg->{NAME}, $reg->{ADDRESS}, $reg->{BITNAMES});
1154
1155     if ($addr >= 0)
1156       {
1157       bitfield_filtration($reg) if ($create_bitfields);
1158
1159       $text = sprintf("__at(0x%04X)", $addr);
1160       $device_registers .= "$text __sfr $name;\n";
1161
1162       $alias = $register_aliases{$name};
1163       $alias = undef if (defined($alias) && defined($reg_refs_by_names{$alias}));
1164
1165       if (defined($bits) && (scalar(@{$bits}) > 0))
1166         {
1167         $type = "__$name$btype_t";
1168         Outl("\n$section\n//", (' ' x 8), "$name Bits\n\nextern $text __sfr $name;");
1169         Outl("\n#define $alias $name") if (defined($alias));
1170
1171         $bit_struct_num = max_count_of_names_of_bit($bits);
1172
1173         if ($create_bitfields)
1174           {
1175           $fields = $reg->{BITFIELDS};
1176           @field_names = sort {$fields->{$a}->{ADDRESSES}->[0] <=> $fields->{$b}->{ADDRESSES}->[0]} keys(%{$fields});
1177           $field_struct_num = @field_names;
1178           $all_struct_num = $bit_struct_num + $field_struct_num - 1;
1179           }
1180         else
1181           {
1182           $all_struct_num = $bit_struct_num - 1;
1183           }
1184
1185         if ($all_struct_num > 0)
1186           {
1187           Outl("\ntypedef union\n  {");
1188
1189           for ($i = 0; $i < $bit_struct_num; ++$i)
1190             {
1191             Outl("  struct\n    {");
1192             print_bits($bits, $i, 4);
1193             Outl('    };');
1194             Outl() if ($all_struct_num);
1195             --$all_struct_num;
1196             }
1197
1198           if ($create_bitfields)
1199             {
1200             for ($i = 0; $i < $field_struct_num; ++$i)
1201               {
1202               my $flname = $field_names[$i];
1203
1204               Outl("  struct\n    {");
1205               print_bitfield($flname, $fields->{$flname}, 4);
1206               Outl('    };');
1207               Outl() if ($all_struct_num);
1208               --$all_struct_num;
1209               }
1210             }
1211           }
1212         else
1213           {
1214           Outl("\ntypedef struct\n  {");
1215           print_bits($bits, 0, 2);
1216           }
1217
1218         Outl("  } $type;");
1219         Outl("\nextern $text volatile $type $name$btail;");
1220         Outl("\n#define $alias$btail $name$btail") if (defined($alias));
1221         Outl();
1222         print_local_bitdefs($reg);
1223         Outl("\n$section\n");
1224
1225         $device_registers .= "$text volatile $type $name$btail;\n";
1226         } # if (defined($bits) && (scalar(@{$bits}) > 0))
1227       else
1228         {
1229         Outl("extern $text __sfr $name;");
1230         Outl("#define $alias $name") if (defined($alias));
1231         }
1232
1233       $device_registers .= "\n" if ($r < $v);
1234       } # if ($addr >= 0)
1235     elsif (defined($bits) && (scalar(@{$bits}) > 0))
1236       {
1237         # This is a register which can not be achieved directly, but the bits has name.
1238
1239       Outl("\n$section\n//", (' ' x 8), "$name Bits\n");
1240       print_local_bitdefs($reg);
1241       Outl("\n$section\n");
1242       }
1243     } # for ($r = 0; $r < $v;)
1244   }
1245
1246 #-------------------------------------------------------------------------------
1247
1248 sub print_configuration_words()
1249   {
1250   if (! scalar(@configs))
1251     {
1252         # PIC18FxxJ
1253
1254     my ($start, $end) = (-1, -1);
1255
1256     extract_config_area(\$start, \$end);
1257     return if (($start < 0) || ($end < 0));
1258
1259     Outl("\n$section\n//\n//", (' ' x 8), "Configuration Addresses\n//\n$section\n");
1260
1261     my $i = 0;
1262     while ($start <= $end)
1263       {
1264       my $n = int($i / 2) + 1;
1265       my $h = ($i & 1) ? 'H' : 'L';
1266
1267       Out(align("#define ${conf_head}CONFIG$n$h", DIST_BITSIZE));
1268       Outl(sprintf("0x%0${caddr_size}X", $start));
1269       ++$i;
1270       ++$start;
1271       }
1272
1273     Outl("\n$section\n");
1274     return;
1275     }
1276
1277   Outl("\n$section\n//\n//", (' ' x 8), "Configuration Bits\n//\n$section\n");
1278
1279   foreach (@configs)
1280     {
1281     Out(align("#define $conf_head$_->{NAME}", DIST_BITSIZE));
1282     Outl(sprintf("0x%0${caddr_size}X", $_->{ADDRESS}));
1283     }
1284
1285   foreach (@configs)
1286     {
1287     next if (! @{$_->{OPTIONS}});
1288
1289     Outl("\n//", ('-' x 29), " $_->{NAME} Options ", ('-' x 31), "\n");
1290
1291     foreach (@{$_->{OPTIONS}})
1292       {
1293       my $expl = $_->{EXPLANATION};
1294
1295         # Improve a spelling error: On the end of a sentence a point must be.
1296       $expl .= '.' if (($expl ne '') && ($expl !~ /\.$/o));
1297
1298       Out(align("#define $_->{NAME}", DIST_BITSIZE));
1299       Out(align(sprintf("0x%0${conf_size}X", $_->{VALUE}), 8));
1300       Out("// $expl") if (defined($expl) && ($expl ne ''));
1301       Outl();
1302       }
1303     }
1304
1305   Outl("\n$section\n");
1306   }
1307
1308 #-------------------------------------------------------------------------------
1309
1310 sub print_devids_and_idlocs()
1311   {
1312   foreach (\@devids, \@idlocs)
1313     {
1314     if (scalar(@{$_}) > 0)
1315       {
1316       foreach (@{$_})
1317         {
1318         Out(align("#define $conf_head$_->{NAME}", DIST_BITSIZE));
1319         Outl(sprintf("0x%0${caddr_size}X", $_->{ADDRESS}));
1320         }
1321
1322       Outl();
1323       }
1324     }
1325   }
1326
1327 #-------------------------------------------------------------------------------
1328
1329 sub print_license($)
1330   {
1331   print $out_handler <<EOT
1332 /*
1333  * This $_[0] of the $mcu MCU.
1334  *
1335  * This file is part of the GNU PIC library for SDCC, originally
1336  * created by Molnar Karoly <molnarkaroly\@users.sf.net> $year.
1337  *
1338  * This file is generated automatically by the $PROGRAM${time_str}.
1339  *
1340  * SDCC is licensed under the GNU Public license (GPL) v2. Note that
1341  * this license covers the code to the compiler and other executables,
1342  * but explicitly does not cover any code or objects generated by sdcc.
1343  *
1344  * For pic device libraries and header files which are derived from
1345  * Microchip header (.inc) and linker script (.lkr) files Microchip
1346  * requires that "The header files should state that they are only to be
1347  * used with authentic Microchip devices" which makes them incompatible
1348  * with the GPL. Pic device libraries and header files are located at
1349  * non-free/lib and non-free/include directories respectively.
1350  * Sdcc should be run with the --use-non-free command line option in
1351  * order to include non-free header files and libraries.
1352  *
1353  * See http://sdcc.sourceforge.net/ for the latest information on sdcc.
1354  */
1355
1356 EOT
1357 ;
1358   }
1359
1360 #-------------------------------------------------------------------------------
1361
1362         # This procedure generates the pic14-specific information.
1363
1364 sub make_pic14_dependent_defs()
1365   {
1366   foreach (sort {versionSort($a->{NAME}, $b->{NAME})} @registers)
1367     {
1368     my ($name, $bits) = ($_->{NAME}, $_->{BITNAMES});
1369     my $prefix = "$name$btail";
1370
1371     if ($emit_legacy_names)
1372       {
1373       $legacy_names .= align("#define ${name}_$btail", DIST_DEFSIZE);
1374       $legacy_names .= "$prefix\n";
1375       }
1376
1377     next if ($_->{NEED_PREFIX} || ! defined($bits));
1378
1379     for (my $i = 0; $i < 8; ++$i)
1380       {
1381       my $array = $bits->[$i];
1382
1383       next if (! defined($array));
1384
1385       my $shadow = (scalar(@{$array}) > 1) ? ", shadows bit in $prefix" : '';
1386
1387       foreach (@{$array})
1388         {
1389         $full_bitdefs .= align("#define $_", DIST_DEFSIZE);
1390         $full_bitdefs .= align("$prefix.$_", DIST_COMSIZE);
1391         $full_bitdefs .= "// bit $i$shadow\n";
1392         }
1393       }
1394
1395     $full_bitdefs .= "\n";
1396     }
1397
1398   $legacy_names .= "\n";
1399   }
1400
1401 #-------------------------------------------------------------------------------
1402
1403         # Prints all informations to the header file.
1404
1405 sub print_to_header_file()
1406   {
1407   my ($text, $name, $address, $str);
1408
1409   print_license('declarations');
1410   Outl("#ifndef __${mcu}_H__\n#define __${mcu}_H__\n\n$section");
1411
1412   if (! $is_pic16)
1413     {
1414     $text = '#ifndef NO_ADDR_DEFINES';
1415
1416     Outl("//\n//\tRegister Addresses\n//\n$section\n\n$text\n");
1417
1418     foreach (sort { $a->{ADDRESS} <=> $b->{ADDRESS} } @registers)
1419       {
1420       ($name, $address) = ($_->{NAME}, $_->{ADDRESS});
1421       next if ($address < 0);
1422
1423       $str = sprintf('0x%04X', $address);
1424       Outl(align("#define ${name}_ADDR", DIST_ADDRSIZE), $str);
1425       }
1426
1427     Outl("\n#endif // $text");
1428     }
1429
1430   Outl("\n$section\n//\n//\tRegister Definitions\n//\n$section\n");
1431   set_bit_prefix();
1432   print_all_registers();
1433   print_configuration_words();
1434   print_devids_and_idlocs();
1435
1436   if (! $is_pic16)
1437     {
1438     make_pic14_dependent_defs();
1439     Outl("$section\n");
1440
1441     if ($full_bitdefs ne '')
1442       {
1443       $text = '#ifndef NO_BIT_DEFINES';
1444       Outl("$text\n\n", $full_bitdefs, "#endif // $text\n");
1445       }
1446
1447     if ($emit_legacy_names)
1448       {
1449       $text = '#ifndef NO_LEGACY_NAMES';
1450       Outl("$text\n\n", $legacy_names, "#endif // $text\n");
1451       }
1452     }
1453
1454   Outl("#endif // #ifndef __${mcu}_H__");
1455   }
1456
1457 #-------------------------------------------------------------------------------
1458
1459         # Prints name of all registers to the device file.
1460
1461 sub print_to_device_file()
1462   {
1463   print_license('definitions');
1464   Outl("#include <$header_name>\n\n$section\n");
1465   Out($device_registers) if ($device_registers ne '');
1466   }
1467
1468 #-------------------------------------------------------------------------------
1469
1470 sub usage()
1471   {
1472   print <<EOT
1473 Usage: $PROGRAM [options]
1474
1475     Options are:
1476
1477         -gp <path> or --gputils-path <path>
1478
1479             The program on this path looks for the gputils source package.
1480
1481         -I <path> or --include <path>
1482
1483             The program on this path looks for the headers (inc files). If this
1484             not specified, then the "header" directory in the local repository
1485             will be the default.
1486
1487         -p <p12f1822> or --processor <p12f1822>
1488
1489             The name of MCU. The prefix of name can be: 'p', 'pic' or nothing
1490
1491         -o <path> or --out-path <path>
1492
1493             Here to writes the output files. (default: "./")
1494             Attention! The program overwrites the existing files without asking.
1495
1496         -v <level> or --verbose <level>
1497
1498             It provides information on from the own operation.
1499             Possible value of the level between 0 and 10. (default: 0)
1500
1501         -cb or --create-bitfields
1502
1503             Create bit fields. In some register, can be found such bits which
1504             belong together. For example: CVR0, CVR1, CVR2, CVR3
1505             These may be useful, to merge during a common field name: CVR
1506             The compiler helps handle these bit fields. (default: no)
1507
1508         -e or --emit-legacy-names
1509
1510             Creates the legacy names also. (default: no)
1511
1512         -nt or --no-timestamp
1513
1514             There will be no timestamp in the header and device files. (default: yes)
1515
1516         -h or --help
1517
1518             This text.
1519
1520     For example: $PROGRAM -p 12f1840 -cb
1521 EOT
1522 ;
1523   }
1524
1525 #   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1526 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1527 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@                   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1528 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@  The main program.  @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1529 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@                   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1530 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1531 #   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1532
1533 $PROGRAM = basename($0);
1534 $gp_header_path = '';
1535 $mcu = '';
1536
1537 for (my $i = 0; $i < scalar(@ARGV); )
1538   {
1539   my $opt = $ARGV[$i++];
1540
1541   given ($opt)
1542     {
1543     when (/^-(gp|-gputils-path)$/o)
1544       {
1545       param_exist($opt, $i);
1546       $gputils_path = $ARGV[$i++];
1547       }
1548
1549     when (/^-(I|-include)$/o)
1550       {
1551       param_exist($opt, $i);
1552       $gp_header_path = $ARGV[$i++];
1553       }
1554
1555     when (/^-(p|-processor)$/o)
1556       {
1557       param_exist($opt, $i);
1558       $mcu = $ARGV[$i++];
1559       }
1560
1561     when (/^-(o|-out-path)$/o)
1562       {
1563       param_exist($opt, $i);
1564       $out_path = $ARGV[$i++];
1565       }
1566
1567     when (/^-(v|-verbose)$/o)
1568       {
1569       param_exist($opt, $i);
1570       $verbose = int($ARGV[$i++]);
1571       $verbose = 0 if (! defined($verbose) || ($verbose < 0));
1572       $verbose = 10 if ($verbose > 10);
1573       }
1574
1575     when (/^-(cb|-create-bitfields)$/o)
1576       {
1577       $create_bitfields = TRUE;
1578       }
1579
1580     when (/^-(e|-emit-legacy-names)$/o)
1581       {
1582       $emit_legacy_names = TRUE;
1583       }
1584
1585     when (/^-(nt|-no-timestamp)$/o)
1586       {
1587       $no_timestamp = TRUE;
1588       }
1589
1590     when (/^-(h|-help)$/o)
1591       {
1592       usage();
1593       exit(0);
1594       } # when ('-h' || '--help')
1595     } # given ($opt)
1596   }
1597
1598 die "Miss the name of MCU!\n" if ($mcu eq '');
1599 die "This name is wrong: \"$mcu\"\n" if ($mcu !~ /^(p(ic)?)?$name_filter$/io);
1600
1601 die "This directory - $gputils_path - not exist!" if (! -d $gputils_path);
1602
1603 $gp_header_path = "$gputils_path/header" if ($gp_header_path eq '');    # The default value.
1604 $gpproc_path    = "$gputils_path/libgputils/$gpprocessor_c";
1605
1606 $mcu = lc($mcu);
1607 $mcu =~ s/^p(ic)?//o;
1608
1609 if ($mcu =~ /^18/)
1610   {
1611   $is_pic16   = TRUE;
1612   $conf_size  = 2;
1613   $caddr_size = 6;
1614   $conf_head  = '__';
1615   }
1616
1617 $short_mcu_name = $mcu;
1618 my $fname = "p${mcu}.inc";
1619
1620 die "The MCU: $mcu unknown!\n" if (! -f "$gp_header_path/$fname");
1621
1622 $mcu = 'PIC' . uc($mcu);
1623 $header_name = lc($mcu) . '.h';
1624 $device_name = lc($mcu) . '.c';
1625
1626 read_content_from_header("$gp_header_path/$fname");
1627
1628 $year     = strftime('%Y', gmtime);
1629 $time_str = strftime(', %F %T UTC', gmtime) if (! $no_timestamp);
1630
1631         # Creates the directory structure.
1632
1633 my $path = ($is_pic16) ? "$out_path/$p16_out_path" : "$out_path/$p14_out_path";
1634 my $head_dir = "$path/header";
1635
1636 if (! -e $head_dir)
1637   {
1638   Log("Creates the \"$head_dir\" dir.", 4);
1639   make_path($head_dir) || die "Could not create the \"$head_dir\" dir!";
1640   }
1641
1642 my $dev_dir = "$path/device";
1643
1644 if (! -e $dev_dir)
1645   {
1646   Log("Creates the \"$dev_dir\" dir.", 4);
1647   make_path($dev_dir) || die "Could not create the \"$dev_dir\" dir!";
1648   }
1649
1650         # Creates the pic1xxxx.h file.
1651
1652 my $fpath = "$head_dir/$header_name";
1653 open($out_handler, '>', $fpath) || die "Could not create the \"$fpath\" file!\n";
1654 Log("Creates the $header_name", 1);
1655 print_to_header_file();
1656 close($out_handler);
1657
1658         # Creates the pic1xxxx.c file.
1659
1660 $fpath = "$dev_dir/$device_name";
1661 open($out_handler, '>', $fpath) || die "Could not create the \"$fpath\" file!\n";
1662 Log("Creates the $device_name", 1);
1663 print_to_device_file();
1664 close($out_handler);