#!/usr/bin/perl -w

use strict;

# Copyright (c) 2002 Kevin L. Pauba


# License:
#
# SDCC is licensed under the GNU Public license (GPL) v2.  Note that
# this license covers the code to the compiler and other executables,
# but explicitly does not cover any code or objects generated by sdcc.
# We have not yet decided on a license for the run time libraries, but
# it will not put any requirements on code linked against it. See:
#
# http://www.gnu.org/copyleft/gpl.html
#
# See http://sdcc.sourceforge.net/ for the latest information on sdcc.

#####################################################################
# >>> How to add a new device to SDCC PIC14 port?
#
# This description assumes that you have a copy of SDCC's sources
# in /path/to/sdcc and a (source or installed) version of gputils
# in /path/to/gputils (the only important point here is that
# /path/to/gputils/headers must exist and contain "p<DEVICE>.inc").
# Furthermore, I assume you want to add support for the 16f887 device
# (note: no 'pic' or 'p' prefix!), change this as desired.
# inc2h.pl can only deal with one single device at a time; repeat the
# ../inc2h.pl-step as often as required.
#
# The proposed sequence of commands is then:
#
# $ cd /path/to/sdcc/support/scripts
# $ mkdir build && cd build
# $ ../inc2h.pl 16f887 /path/to/gputils
# $ mv pic16f887.c /path/to/sdcc/device/lib/pic/libdev
# $ mv pic16f887.h /path/to/sdcc/device/include/pic
# $ vim /path/to/sdcc/device/include/pic/pic14devices.inc
# 
# # Use any pure text editor you like (`[Esc]:q![Enter]' quits Vim ;-)).
# # Add a record for the new device to the file; usually you can copy
# # the record of a similar device and adjust the values using the
# # datasheet. The format of pic14devices.txt is explained in the file
# # itself. Please keep the file sorted.
# # When you are done:
#
# $ cd /path/to/sdcc/device/lib
# $ make model-pic14
# $ make install 
#
# Congratulations, you have just added support for a new device to
# the port. You may consider posting your (changes to)
# pic14devices.txt and the generated files (picDEVICE.[ch]) to
# have them included into the official source tree.
# Some testing beforehand would be appreciated, though.
#####################################################################

my $rcsid = q~$Id$~;
my ($junk, $file, $version, $date, $time, $programmer, $status)
    = split(/\s+/, $rcsid);
my ($programName) = ($file =~ /(\S+)/);

if ($#ARGV < 0 || $#ARGV > 1 ) {
    Usage();
}
my $processor = uc(shift);
my $path = shift;
my %sfrs = ();
my %alias = ();
my %bits = ();
my %bitmasks = ();
my %addr = ();
my %ram = ();
my $path_delim = "/";
my $devices = "";
my %types = ();
my $type = "";

# just in time fixes for some register names
sub fixname {
    my $name = shift;
    $name =~ s/COMCON/CMCON/ig;
    # use OPTION_REG instead of OPTION as OPTION is a assembler directive
    $name =~ s/OPTION(_REG)?/OPTION_REG/ig;
    # often declared as LCDDATn, but bits defined for LCDDATAn, 0 <= n <= 10
    $name =~ s/LCDDAT([^A])/LCDDATA$1/ig;
    # LCDSE2 is missing in some headers, but LCDSE3 is declared...
    $name =~ s/LCDSE3/LCDSE2/ig;
    # XXX: should this be named LININTF or LINPRT?
    $name =~ s/LININTF/LINPRT/ig;
    # FIXME: duplicate declarations for n in {0,1,2}
    $name =~ s/UEPn/UEP0/ig;

    return $name;
}

sub checkname {
    my $name = shift;
    if (not exists $sfrs{$name}) {
	print "SFR $name not defined (yet).\n";
	# Find similar ones.
	if (exists $sfrs{$name."0"}) {
	    print "  but ".$name."0 exists---using that instead.\n";
	    return $name."0";
	}
	my $try = $name;
	$try =~ s/[0-9]$//;
	if (exists $sfrs{$try}) {
	    print "  but $try exists---using that instead.\n";
	    return $try;
	}
	die "Not found a similar SFR---aborting.\n";
    }
    return $name;
}

# exists clone for arrays---does this not exist in Perl?!?
sub contained {
    my $name = shift;
    my $arr = shift;

    foreach my $item (@$arr) {
	return 1 if ($name eq $item); 
    }
    return 0;
}


$path = "" if (!defined $path);
if ($^O eq 'MSWin32') {
    if ($path eq '') {
	if (defined($path = $ENV{'GPUTILS_HEADER_PATH'}) || defined($path = $ENV{'GPUTILS_LKR_PATH'})) {
	    $path .= '\\..';
	}
	else {
	    die "Could not find gpasm includes.\n";
	}
    }
    $path_delim = '\\';
}
else {
    # Nathan Hurst <njh@mail.csse.monash.edu.au>: find gputils on Debian
    if ($path eq '') {
	if ( -x "/usr/share/gputils") {
	    $path = "/usr/share/gputils";
	} elsif ( -x "/usr/share/gpasm") {
	    $path = "/usr/share/gpasm";
	} elsif ( -x "/usr/local/share/gputils") {
	    $path = "/usr/local/share/gputils";
	} else {
	    die "Could not find gpasm includes.\n";
	}
    }
    $path_delim = '/';
}

#
# Read the symbols at the end of this file.
#
while (<DATA>) {
    next if /^\s*#/;

    if (/^\s*alias\s+(\S+)\s+(\S+)/) {
	#
	# Set an alias for a special function register.
	# Some MPASM include files are not entirely consistent
	# with sfr names.
	#
	$alias{fixname($2)} = fixname($1);
    } elsif (/^\s*address\s+(\S+)\s+(\S+)/) {
	#
	# Set a default address for a special function register.
	# Some MPASM include files don't specify the address
	# of all registers.
	# 
	# $addr{"$1"} = $2;
	foreach my $device (split(/[,\s]+/, $devices)) {
	    $addr{"p$device", "$1"} = $2;
	}
    } elsif (/^\s*bitmask\s+(\S+)\s+/) {
	#
	# Set the bitmask that will be used in the 'memmap' pragma.
	#
	my $bitmask = "$1";
	foreach my $register (split(/\s+/, $')) {
	    $bitmasks{"$register"} = $bitmask;
	}
    } elsif (/^\s*ram\s+(\S+)\s+(\S+)\s+(\S+)/) {
	# This info is now provided in "include/pic/pic14devices.txt".
	#$lo = $1;
	#$hi = $2;
	#my $bitmask = $3;
	#foreach $device (split(/[,\s]+/, $devices)) {
	#    $ram{"p$device"} .= "#pragma memmap $lo $hi RAM $bitmask$'";
	#}
    } elsif (/^\s*processor\s+/) {
	$devices = $';
	$type = '';
    } elsif (/^\s*(\S+)/) {
	$type = $1;
	$_ = $';
	foreach my $key (split) {
	    eval "\$types{'$key'} = $type;";
	}
    } else {
	foreach my $key (split) {
	    eval "\$types{'$key'} = $type;";
	}
    }
}

#
# Read the linker file.
#
#  $linkFile = "$path/lkr/" . lc $processor . ".lkr";
#  open(LINK, "<$linkFile")
#      || die "$programName: Error: Cannot open linker file $linkFile ($!)\n";
#  while (<LINK>) {
#      if (/^(\S+)\s+NAME=(\S+)\s+START=(\S+)\s+END=(\S+)\s+(PROTECTED)?/) {
#  	$type = $1;
#  	$name = $2;
#  	$start = $3;
#  	$end = $4;
#  	$protected = 1 if ($5 =~ /protected/i);

#  	if ($type =~ /(SHAREBANK)|(DATABANK)/i) {
#  	    $ram{"p$processor"} .=
#  		sprintf("#pragma memmap %7s %7s RAM 0x000\t// $name\n",
#  			$start, $end);
#  	}
#      } elsif (/^SECTION\s+NAME=(\S+)\s+ROM=(\S+)\s+/) {
#      }
#  }

# Create header for pic${processor}.c file
my $lcproc = "pic" . lc($processor);
my $c_head = <<EOT;
/* Register definitions for $lcproc.
 * This file was automatically generated by:
 *   $programName V$version
 *   Copyright (c) 2002, Kevin L. Pauba, All Rights Reserved
 */
#include <${lcproc}.h>

EOT

#
# Convert the file.
#
my $defaultType = 'other';
my $includeFile = $path.$path_delim.'header'.$path_delim.'p'.lc($processor).'.inc';
my $headFile = "pic" . lc($processor) . ".h";
my $defsFile = "pic" . lc($processor) . ".c";

my $body = "";
my $header = "";
my $addresses = "";
my $pragmas = "";

open(HEADER, "<$includeFile")
    || die "$programName: Error: Cannot open include file $includeFile ($!)\n";

while (<HEADER>) {
    
    if (/^;-+ Register Files/i) {
	$defaultType = 'sfr';
	s/;/\/\//;
	$body .= "$_";
    } elsif (/^;-+\s*(\S+)\s+Bits/i || /^;-+\s*(\S+)\s+-+/i) {
	# The second case is usually bits, but the word Bits is missing
        # also accept "UIE/UIR Bits"
	foreach my $name (split(/\//, $1)) {
	    $name = fixname($name);
	    $name = checkname($name);

	    if (defined($alias{$name})) {
		$defaultType = "bits $alias{$name}";
	    } else {
		$defaultType = "bits $name";
	    }
	}
	s/;/\/\//;
	$body .= "$_";
    } elsif (/^;=+/i) {
	$defaultType = '';
	s/;/\/\//;
	$body .= "$_";
    } elsif (/^\s*;/) {
	#
	# Convert ASM comments to C style.
	#
	$body .= "//$'";
    } elsif (/^\s*IFNDEF\s+__(\S+)/) {
	#
	# Processor type.
	#
	$processor = $1;
	$body .= "//$_";
    } elsif (/^\s*(\S+)\s+EQU\s+H'(.+)'/) {
	#
	# Useful bit of information.
	#
	my $name = $1;
	my $value = $2;
	my $rest = $';
	my $bitmask = "0x0000";

	$rest =~ s/;/\/\//;
	chomp($rest);

	if (defined($types{"p$processor", "$name"})) {
	    $type = $types{"p$processor", "$name"};
	} elsif (defined($types{"$name"})) {
	    $type = $types{"$name"};
	} else {
	    $type = $defaultType;
	}
	#print "$name --> $type\n"; ## DEBUG

	if (defined($bitmasks{"p$processor", "$name"})) {
	    $bitmask = $bitmasks{"p$processor", "$name"};
#	} elsif (defined($bitmasks{"$name"})) {
#	    $bitmask = $bitmasks{"$name"};
	}

	if ($type eq 'sfr') {
	    #
	    # A special function register.
	    #
#	    $pragmas .= sprintf("#pragma memmap %s_ADDR %s_ADDR "
#				. "SFR %s\t// %s\n",
#				$name, $name, $bitmask, $name);
	    $name = fixname($name);
	    if (defined $addr{"p$processor", "$name"}) {
		$addresses .= sprintf("#define %s_ADDR\t0x%s\n", $name, $addr{"p$processor", "$name"});
	    } else {
		$addresses .= sprintf("#define %s_ADDR\t0x%s\n", $name, $value);
	    }
	    $body .= sprintf("extern __sfr  __at %-30s $name;$rest\n", "(${name}_ADDR)" );
	    $c_head .= sprintf("__sfr  __at %-30s $name;\n", "(${name}_ADDR)");
	    $addr{"p$processor", "$name"} = "0x$value";
	    $sfrs{$name}=1;
	} elsif ($type eq 'volatile') {
	    #
	    # A location that can change without 
	    # direct program manipulation.
	    #
	    $name = fixname($name);
#	    $pragmas .= sprintf("#pragma memmap %s_ADDR %s_ADDR "
#				. "SFR %s\t// %s\n",
#				$name, $name, $bitmask, $name);
	    $body .= sprintf("extern __data __at %-30s $name;$rest\n", "(${name}_ADDR) volatile char");
	    $c_head .= sprintf("__data __at %-30s $name;\n", "(${name}_ADDR) volatile char");
	    if (defined $addr{"p$processor", "$name"}) {
		$addresses .= sprintf("#define %s_ADDR\t0x%s\n", $name, $addr{"p$processor", "$name"});
	    } else {
		$addresses .= sprintf("#define %s_ADDR\t0x%s\n", $name, $value);
	    }
	} elsif ($type =~ /^bits/) {
	    my ($junk, $register) = split(/\s/, $type);
	    my $bit = hex($value);
	    my $addr = $addr{"$register"};

	    # prepare struct declaration
	    if (0) { # DEBUG
		foreach my $key (keys %bits) {
		    print "   $key\n";
		}
		print "$register // $bit // ".$bits{"$register"}."\n";
	    }
	    if (!defined $bits{"$register"}) {
		$bits{"$register"} = {}; # reference to empty hash
	    }
	    if (!defined $bits{"$register"}->{oct($bit)}) {
		$bits{"$register"}->{oct($bit)} = []; # reference to empty array
	    }
	    for (my $k=0; $k < scalar @{$bits{"$register"}->{oct($bit)}}; $k++) {
	      $name = "" if ($bits{"$register"}->{oct($bit)} eq $name)
	    }
	    if (($name ne "")
		and (1 != contained($name, \@{$bits{"$register"}->{oct($bit)}}))
	    ) {
	      push @{$bits{"$register"}->{oct($bit)}}, $name;
	    }
	} else {
	    #
	    # Other registers, bits and/or configurations.
	    #
	    $name = fixname($name);
	    if ($type eq 'other') {
		#
		# A known symbol.
		#
		$body .= sprintf("#define %-20s 0x%s$rest\n", $name, $value);
	    } else {
		#
		# A symbol that isn't defined in the data
		# section at the end of the file.  Let's 
		# add a comment so that we can add it later.
		#
		$body .= sprintf("#define %-20s 0x%s$rest\n",
				 $name, $value);
	    }
	}
    } elsif (/^\s*$/) {
	#
	# Blank line.
	#
	$body .= "\n";
    } elsif (/__MAXRAM\s+H'([0-9a-fA-F]+)'/) {
	my $maxram .= "//\n// Memory organization.\n//\n";
	if (!defined $ram{"p$processor"}) {
	    $ram{"p$processor"} = "";
	}
	$pragmas = $maxram
	    . $ram{"p$processor"} . "\n"
		. $pragmas;
	$body .= "// $_";
    } else {
	#
	# Anything else we'll just comment out.
	#
	$body .= "// $_";
    }
}
$header .= <<EOT;
//
// Register Declarations for Microchip $processor Processor
//
//
// This header file was automatically generated by:
//
//\t$programName V$version
//
//\tCopyright (c) 2002, Kevin L. Pauba, All Rights Reserved
//
//\tSDCC is licensed under the GNU Public license (GPL) v2.  Note that
//\tthis license covers the code to the compiler and other executables,
//\tbut explicitly does not cover any code or objects generated by sdcc.
//\tWe have not yet decided on a license for the run time libraries, but
//\tit will not put any requirements on code linked against it. See:
// 
//\thttp://www.gnu.org/copyleft/gpl/html
//
//\tSee http://sdcc.sourceforge.net/ for the latest information on sdcc.
//
// 
#ifndef P${processor}_H
#define P${processor}_H

//
// Register addresses.
//
EOT

$c_head .= <<EOT;

// 
// bitfield definitions
// 
EOT

# Add PORT* and TRIS* bit entries
# file format is:
#    16f84   A0-4,B0-7
#    *       A0-5,B0-7,C0-7,D0-7,E0-2
{
  my $pinfo = undef;
  my $defpinfo = undef;
  open(P14PORTS, "< pic14ports.txt") && do {
    while(<P14PORTS>) {
	s/\r//g; chomp;
	if(/^\s*(\*|\w*)\s*([ABCDE0-7,-]+)\s*$/) {
	    if(lc($1) eq lc($processor)) {
		die if defined $pinfo;
		$pinfo = $2;
	    } elsif($1 eq "*") {
		die if defined $defpinfo;
		$defpinfo = $2;
	    }
	} elsif(/^\s*#/ || /^\s*$/) {
	    # ignore blanks, comments
	} else {
	    die "bad line in pic14ports '$_'";
	}
    }
    close P14PORTS;
  };
  $defpinfo = "A0-5,B0-7,C0-7,D0-7,E0-2" unless defined $defpinfo;
  $pinfo = $defpinfo unless defined $pinfo;

  if(defined $pinfo) {
    foreach  (split /,/, $pinfo) {
	if(/^([ABCDE])([0-7])-([0-7])$/) {
	    my($prt, $low, $high) = ($1, $2, $3);
	    next unless defined $sfrs{"PORT$prt"} && defined $sfrs{"TRIS$prt"};
	    next if     defined $bits{"PORT$prt"};
	    for(my $i = $low; $i <= $high; $i++) {
		push @{$bits{"PORT$prt"}->{oct($i)}}, "R$prt".$i;
	    }
	    next if     defined $bits{"TRIS$prt"};
	    for(my $i = $low; $i <= $high; $i++) {
		push @{$bits{"TRIS$prt"}->{oct($i)}}, "TRIS$prt".$i;
	    }
	} else { die }
    }
  }
}

my $structs = "";
## create struct declarations
foreach my $reg (sort keys %bits)
{
  $structs .= "// ----- $reg bits --------------------\n";
  $structs .= "typedef union {\n";
  my $idx = 0;
  my $max = 1;
  do {
    $structs .= "  struct {\n";
    for (my $i=0; $i < 8; $i++)
    {
      if (!defined $bits{$reg}) {
	  #print "bits{$reg} undefined\n";
      }
      if (!defined $bits{$reg}->{oct($i)}) {
	  #print "bits{$reg}->{".oct($i)."} undefined\n";
	  $bits{$reg}->{oct($i)} = []; # empty array reference
      }
      my @names = @{$bits{$reg}->{oct($i)}};
      if ($max < scalar @names) { $max = scalar @names; }
      if ($idx >= scalar @names) {
	$structs .= "    unsigned char :1;\n";
      } else { # (1 == scalar @names) {
	$structs .= "    unsigned char " . $names[$idx] . ":1;\n";
#      } else {
#	$structs .= "  union {\n";
#	foreach $name (@names) {
#	  $structs .= "    unsigned char " . $name . ":1;\n";
#	} # foreach
#	$structs .= "  };\n";
      }
    } # for
    $structs .= "  };\n";
    $idx++;
  } while ($idx < $max);
  $structs .= "} __${reg}_bits_t;\n";
  #if(defined $sfrs{$reg}) {
    $structs .= "extern volatile __${reg}_bits_t __at(${reg}_ADDR) ${reg}_bits;\n\n";
    $c_head .= "volatile __${reg}_bits_t __at(${reg}_ADDR) ${reg}_bits;\n";
  #}
  
  # emit defines for individual bits
  $structs .= "#ifndef NO_BIT_DEFINES\n";
  for (my $i=0; $i < 8; $i++)
  {
    my @names = @{$bits{$reg}->{oct($i)}};
    foreach my $field (@names) {
      $structs .= sprintf("#define %-20s ${reg}_bits.$field\n", $field);
    } # foreach
  }
  $structs .= "#endif /* NO_BIT_DEFINES */\n";
  $structs .= "\n";
} # foreach

open(HEAD, ">$headFile") or die "Could not open $headFile for writing.";
print HEAD $header
    . $addresses . "\n"
    . $pragmas . "\n\n"
    . $body . "\n"
    . $structs
    . "#endif\n";
close(HEAD);

open(DEFS, ">$defsFile") or die "Could not open $defsFile for writing.";
print DEFS $c_head . "\n";
close DEFS;

sub Usage {
	print STDERR <<EOT;

inc2h.pl - A utility to convert MPASM include files to header files
           suitable for the SDCC compiler.

License: Copyright (c) 2002 Kevin L. Pauba

	 SDCC is licensed under the GNU Public license (GPL) v2; see
	 http://www.gnu.org/copyleft/gpl.html See http://sdcc.sourceforge.net/
	 for the latest information on sdcc.

Usage:   $programName processor [path]

	 where:

         processor	The name of the processor (16f84, 16f877, etc.)

         path           The path to the parent of the "header" and "lkr"
                        directories.  The default is "/usr/share/gpasm".

	 The header file will be written to the standard output.

	 $#ARGV
EOT
	exit;
}

__END__

#
# processor <processor_name>
# address <register_name> <hex_address>
# bitmask <bitmask> <register_list>
# ram <lo_address> <hi_address> <bitmask>
# sfr <register_list>
# volatile <address_list>
# bit <address_list>
#

alias OPTION_REG OPTION
volatile INDF PCL
