#!/usr/bin/perl

# Copyright 2003 by John Sheahan <john@taudelta.com.au>
#
#  This program is free software; you may redistribute and/or modify it under
#  the terms of the GNU General Public License Version 2 as published by the
#  Free Software Foundation.
#
#  This program is distributed in the hope that it will be useful, but
#  WITHOUT ANY WARRANTY, without even the implied warranty of MERCHANTABILITY
#  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
#  for complete details.
#

require "getopts.pl";
&Getopts("cdekhKCs");
$ver='$Id: v2vhd2,v 1.1 2003/02/02 00:35:26 john Exp john $ ';

# -d debug
# -e generate entity
# -c print isolated code
# -k print isolated comments
if (defined($opt_h)) {
  print "$0 $ver\n";
  print " translate synthesizeable verilog to vhdl\n";
  print " $0 [flags] infile.v > outfile.vhd\n";
  print "   -e   generate entity definition <else architecture>\n";
  print "   -c   <a debug option> dump extracted verilog code\n";  
  print "   -k   <a debug option> dump extracted comments\n";  
  print "   -d   debugging information\n";
  print "   -C   don't preserve /*..*/ comments\n";
  print "   -s   turn constants associated with state variables to types\n";
  die;
}

$debug=1 if defined($opt_d);

# another cut at a parser for RTL verilog to vhdl 
# with a different spin on grammar.
# john@taudelta.com.au
# orig Wed Jan 22 19:09:44 EST 2003
# $Id: v2vhd2,v 1.1 2003/02/02 00:35:26 john Exp john $
#

# break the file into line number indexed code and comment lists 
# but note that line numbers incorporate any included files,so are 
# not genarally useable eg for locating an error in an editor.

# indent
$w='  ';  $dw = '  ';
$strlen = 32;

&init_arrays;
&split_input;

if (defined($opt_c) || defined($opt_k)) {
  for ($i=0; $i< $lineno; $i++) {
    print "$i ";
    print "C: $code[$i] "  if (defined($opt_c));
    print "K: $comment[$i]" if defined(($opt_k));
    print "\n";
  }
}

$_=&identify_signals();
print "identified $_ signals\n" if ($debug);


if (defined($opt_e)) { # generate entity
  &entity;
}
else {
  &print_arch_header();
  &identify_states();
  &print_components();
  &print_signals();
  &print_constants();
  &print_types() if (defined($opt_s));
  &print_logic();
}

# read all code. memorize IO, wires, registers in %signals

sub identify_signals {
  &reset;
  $signals=0;
  while ($stuff) {
    $token=&get_next_token();
    print "read token $token ($cline, $column)\n" if ($debug);
    if (defined($signal_kwd{$token})) {
      $sentance=&get_to_semi();
      # now parse the sentance and remember the wires/ins/outs/bidis
      #      print "now I have to analyze this..$sentance\n";
      # first see if its bussed
      $min=0;
      $max=0;
      if ($sentance =~ /\[\s*(.*):(.*)\](.*)/) {
	print "is bussed  " if ($debug);
	$max=$1;
	$min=$2;
	$sentance=$3;
      }
      # now spin thru the remaining names
      @_=split(" ",$sentance);
      while (@_) {
	$_=shift(@_);
	unless ($_ =~ /[,;]/) {
	  $_ =~ /^\s*(\S*)/s*$/;
	  if (length($1)> 0){
	    print "signal $1 is an $token [$max:$min]  $code[$cline]\n" if ($debug); 
	    if (defined($port_kwd{$token})) {
	      $port{$1} = $token;
	      $port_min{$1}=$min;
	      $port_max{$1}=$max;
	    } 
	    else {
	      $signal{$1} = $token;
	      $signal_min{$1}=$min;
	      $signal_max{$1}=$max;
	    }
	    $signals++;
	  }
	}
      }
    }
    elsif ($token eq 'always') {
      $c=&get_to_closebracket;
      $_=&get_next_block;
      print "skipped (always)   $token $c $_\n" if ($debug);
   }
    elsif ($token eq 'initial') {
      $_=&get_next_block;
      print "skipped (begin)  $token $_\n" if ($debug);
    }
    elsif ($token eq 'begin') {
      $_=&get_matching('begin','end');
      print "skipped (begin)  $token $_\n" if ($debug);
    }
    elsif ( defined($colon_kwd{$token}) || defined($signal{&debus($token)})
	  || defined($port{&debus($token)})) {
      $_=&get_to_semi;
      print "skipped (semi)  $token $_\n" if ($debug);
    }
    elsif ( defined($nothing_kwd{$token})) {
      print "skipped (nothing)  $token\n" if ($debug);
      # nothing..
    }
    else {
      # hmm - better be an instantiation
      $type = $token;
      if (defined($signal{$type}) || defined($port{$type})) { 
	print "LOST PARSING why is signal $type here. expecting instantiation??\n";
      }
      $name = &get_next_token;
      if (defined($signal{$type}) || defined($port{$type})) { 
	print "LOST PARSING why is signal $name here?? expecting name\n";
      }
      $_ = &get_to_semi();
      print "skipping (instance) $type $name $_\n" if ($debug);
      $component{$name}=$type; # remember
    }
  }
  return $signals;
}

# return the next token in the code stream
sub get_next_token {
  local ($c,$next);
  $next = '';
  $c=' ';
  until ( $c ne ' ' || ($stuff==0)) {
    $c=&getnextchar();
  }
  until ( $c eq ' ' || ($stuff==0)) {
    #    print "got $c\n";
    $next .= $c;
    $c=&getnextchar();
  }
  return $next;
}

# return the next character in the code stream
sub getnextchar {
  while ($cline < @code) {
    if ($column < length($code[$cline])){
      return &getlegalchar;
    }
    else {
      $column=0;
      $cline++;
      return " "; # this is a legal space..
    }
  }
  $stuff=0;
  return '';
}

# local use only - get the next char with no limit checking
sub getlegalchar {
  local ($c);
  $c = substr($code[$cline],$column,1);
  $column++;
  return $c;
}

# return code to the next ';'
sub get_to_semi {
  local ($string,$next);
  #  print "doing get to semi\n";
  $string='';
  $next='';
  while( (!($next =~ /;/)) && ($stuff == 1)) {
    $next = &get_next_token;
    #    print "get-semi got a $next\n";
    if (length($string) > 0) { $string .= ' ' . $next}
    else {$string = $next}
  }
  #  print "get tosemi got $string\n";
  return $string;
}

# read to matching  ')'. enter this one BEFORE the '('
sub get_to_closebracket {
  local ($string,$count);
  $string='';
  $count=0;
  while ($stuff && ($count == 0)) {
    $_ = &getnextchar;
    $string .= $_;
    $count++ if ( $_ eq '(' );
  }
#  print "closebracket = read $string (up to openbracket)\n";
  while ($stuff && ($count != 0)) {
    $_ = &getnextchar;
    $string .= $_;
    $count++ if ( $_ eq '(' );
    $count-- if ( $_ eq ')' );
  }
#  print "closebracket = read $string (up to closebracket)\n";
  return $string;
}

# assuming the last token was 'begin', read code to the matching end
sub get_matching {
  local ($string,$next,$count,$first_token,$first,$last);
  $first=$_[0];
  $last=$_[1];
  # print "doing get-matching ($first,$last)\n" if ($debug);
  $string='';
  $next='';
  $count=1;
  $first_token=1;
  while(($count != 0) && $stuff) {
    $next = &get_next_token;
    # print "get-matching token $next depth $count first $first_token\n" if ($debug);
    if (length($string) > 0) { $string .= ' ' . $next}
    else {$string = $next}
    # allow this routine to work if invoked after or before the 'begin'
    if ($next eq $first) {$count++ unless ($first_token)}
    elsif ($next eq $last) {$count--}
    $first_token=0;
  }
  return $string;
}

#checks next token, acts accordingly

sub get_next_block {
  local ($s);
  $s =&get_next_token();
  if    ($s eq 'begin') {$s .= " " . &get_matching('begin','end'); }
  elsif ($s eq ';')     { }
  elsif ($s eq 'case')  {$s .= " " . &get_matching('case','endcase')}
  elsif ($s eq 'casex')  {$s .= " " . &get_matching('casex','endcase')}
  elsif ($s eq 'casez')  {$s .= " " . &get_matching('casez','endcase')}
  elsif ($s eq 'if')    {$s .= " " . &get_next_if()}
  else                  {$s .= " " . &get_to_semi()}
  return $s;
}

# quite recursive. 'if' can be single line , or following a code block,
# with apparently differing behaviour when followed with an 'else'

sub get_next_if {
  local ($s);
  $s = &get_to_closebracket();
  # print "if ()- read $s\n";
  $s .= " " . &get_next_block();
  # print "if - read $s\n";
  if (&peek_next_token() eq 'else') {
  #  print "if - peeked an \'else\'\n";
    $s .= " " . &get_next_token . " " . &get_next_block();
  }
  return $s;
}


# reset the read-code pointers
sub reset {
  $cline = 0;
  $column = 0;
  $stuff = 1;
  $commented=0;
}

# get the next token, without updating the pointers.
sub peek_next_token {
  local ($l_cline,  $l_column,  $l_stuff,  $l_commented);
  $l_cline    =$cline;
  $l_column   =$column;
  $l_stuff    =$stuff;
  $l_commented=$commented;
  $_=&get_next_token;
  $cline    =$l_cline;
  $column   =$l_column;
  $stuff    =$l_stuff;
  $commented=$l_commented;
  return $_;
}

# get the next-but-one token, without updating the pointers.
sub peek_second_token {
  local ($l_cline,  $l_column,  $l_stuff,  $l_commented);
  $l_cline    =$cline;
  $l_column   =$column;
  $l_stuff    =$stuff;
  $l_commented=$commented;
  $_=&get_next_token;
  $_=&get_next_token;
  $cline    =$l_cline;
  $column   =$l_column;
  $stuff    =$l_stuff;
  $commented=$l_commented;
  return $_;
}


# expand out any preprocessor directives
sub expand_line {
  local ($line, $cmd, $leading, $trailing);
  $line = $_[0];
  while ($line =~ /^(.*)\`([\w\d_]+)([^\w\d_].*)$/) {  # a tick-something
    $leading = $1;
    $cmd=$2;
    $trailing = $3;
    if (defined($preprocessor{$cmd})) {
      $line = $leading . $preprocessor{$cmd} . $trailing;
#      print "substituted preprocessor directive for $cmd, now $line\n" if ($debug);
    }
    elsif ($2 eq 'timescale') {
      $line = '';
    }
    elsif ($2 eq 'define') {
      $trailing =~ /^\s*(\S+)\s+(\S+)/;
      $preprocessor{$1} = $2;
      print "added $1 = $2 to preprocessor table\n" if ($debug);
      $line = '';
    }
    elsif ($2 eq 'include') {
      $trailing =~ /\"(\S+)\"/;
#      print "about to include $1\n";
      $line=&include($1);
#      print "got back $line\n"
    }
    else {
      print STDERR "ERROR cannot recognise preprocessor directive $cmd at $filename $lineno\n";
      print "ERROR cannot recognise preprocessor directive $cmd at $filename $lineno\n";
      $line = $leading . $preprocessor{$cmd} . $trailing;
    }
  }
  return $line ;
}

# recursive, for included files. Includes a file 
sub include {
  my ($file, $line);
  #my FILE;
  #  print "Running include of $_[0]\n";
  $file = $_[0];
  open FILE, $file || die "cannot open included file $file\n";
  $line = '';
  while (<FILE>) {
    chomp;
    #    print "including line $_ from file $file\n";
    $line .=  &expand_line($_) . "\n";
  }
  return $line;
}

sub split_input {
  # break the input into a list of comments
  # and a list of decommented code.
  # note - this also implements expansion of 
  # preprocessor directives.
  $lineno=0;
  while (<>) {
    chomp;
    $line=&expand_line($_);
    #    print "split called expand and got $line\n";
    # and if there were nested includes, need to resplit these lines.
    @_=split(/\n/, $line);
#    if (@_ > 1) { print "got $@_ lines back from split\n";}
    while (@_) {
      $line = shift @_;
      chomp($line);
      if (length $line >0 ) {
	@code[$lineno]=&decomment($line);
	@comment[$lineno]=&decode($line);
	#print "LINE was $line\n";
	#print "CODE is $code[$lineno]\n";
	#print "COMM is $comment[$lineno]\n";
	$lineno++;
      }
    }
  }
}

# remove comments, and add whitespace around tokens.
sub decomment {
  $l = $_[0];
  $in = $l;
  # remove // stuff. 
  if ($l =~ /^(.*?)\/\//) {   $l = $1; }
  while ($l =~ /^(.*)\/\*(.*?)\*\/(.*)$/) { 
    # FIXME this handles a /* .. */ on a single line only..
    $l = $1 . $3;
  }
  #remove leading + trailing spaces
  if ($l =~ /^\s+(.*?)\s*$/) { $l = $1 }
  #  print "decomment got $1 and returned $l";

  # its now important to separate tokens with whitespace
  $l =~ s/;/ ; /g;
  $l =~ s/\)/ \) /g;
  $l =~ s/\(/ \( /g;
#  $l =~ s/\]/ \] /g;
  $l =~ s/\^/ ^ /g;
  $l =~ s/\}/ \} /g;
  $l =~ s/\{/ \{ /g;
  $l =~ s/,/ , /g;
  # single &,|
  $l =~ s/\|\|/ \$\$ /g;
  $l =~ s/\|([^|])/ | $1/g;
  $l =~ s/\$\$/ \|\| /g;
  $l =~ s/&&/ \$\$ /g;
  $l =~ s/&/ & /g;
  $l =~ s/\$\$/ && /g;
  #print "PRE == xpn $l\n";
  # =, <=, :=, ==, ===
  $l =~ s/\<=/ \<= /g;
  $l =~ s/:=/ := /g;
  $l =~ s/([^=])==([^=])/$1 == $2/g;
  $l =~ s/===/ === /g;
  $l =~ s/([^:\<=])=([^=])/$1 = $2/g;
#  $l =~ s/:([^=])/ : $1/g;
  # print "POS == xpn $l\n";
  # finally remove repeated whitespace
  $l =~ s/\s/ /g; # tab to space
  $l =~ s/\s\s/ /g;
  return $l;
}

# remove the non-comment stuff, leaving only comment
sub decode {
  $l = $_[0];
  $c = '';
  # isolate // stuff 
  if ($l =~ /^(.*?)\/\/(.*)/) {   $c .= $2; }
  while ($l =~ /^(.*)\/\*(.*?)\*\/(.*)$/) { # single line /* only..
    $c .= " " . $2 if (defined ($opt_K));
    $l = $1 . $3;
  }
  # not obvious quite where this should go..
  # fix emacs buffer mode hinter if it exists in a comment
  $c =~ s/Mode: Verilog/Mode: VHDL/;
  return $c;
}

# print the comment lines from last-comment-printed to current
sub print_comments {
  local ($i,$any);
  $any=0;
  for ($i=$commented;$i<$cline;$i++) {
    if (length($comment[$i]) > 0) {
      print "-- ", $comment[$i], "\n";
      $any=1;
    }
  }
  print "\n" if ($any);
  $commented = $cline;
}

# generate a vector type line, given the upper and lower limits
sub vector {
  if (($_[0] == 0 ) && ($_[1] == 0) ) {
    return "std_logic";
  }
  else { 
    $_= "std_logic_vector ($_[0] downto $_[1])";
    return $_;
  }
}

# strip any potential bus params off a token
sub debus {
  if ($_[0] =~ /(^.*)\[/) {
    return $1;
  }
  else {
    return $_[0];
  }
}

# print the library list
sub print_libraries {
 print "library ieee;\n";
 print "use ieee.std_logic_1164.all;\n";
 print "use ieee.std_logic_unsigned.all;\n";
}



# generate the entity definition.
sub entity {
  local ($i, $term);
  &reset;
  # read code to the module defn, updates pointers
  while ($stuff && (&get_next_token ne 'module')) { };
  &print_comments;
  print  "\n";
  &print_libraries();
  $entity=&get_next_token;
  print "\nentity $entity is\n";
  print "  port (";
  $term="\n";
  for $i (sort keys %port) {
    if ($port{$i} eq 'input') {
      $vector=&vector($port_max{$i},$port_min{$i});
      printf("%s    %-20s : in %s", $term, $i, $vector);
      $term=";\n";
    } 
  }
  for $i (sort keys %port) {
    if ($port{$i} eq 'inout') {
      $vector=&vector($port_max{$i},$port_min{$i});
      printf("%s    %-20s : inout %s", $term, $i, $vector);
      $term=";\n";
    } 
  }
  for $i (sort keys %port) {
    if ($port{$i} eq 'output') {
      $vector=&vector($port_max{$i},$port_min{$i});
      printf("%s    %-20s : out %s", $term, $i, $vector);
      $term=";\n";
    } 
  }
  print "\n   );\n";
  print "end $entity;\n";
}

# this is just a quick way of testing keywords
sub init_arrays {
  $port_kwd{'input'}=1;
  $port_kwd{'output'}=1;
  $port_kwd{'inout'}=1;

  $signal_kwd{'wire'}=1;
  $signal_kwd{'reg'}=1;
  $signal_kwd{'input'}=1;
  $signal_kwd{'output'}=1;
  $signal_kwd{'inout'}=1;
  $signal_kwd{'function'} = 1;

  $colon_kwd{'assign'} = 1;
  $colon_kwd{'module'} = 1;
  $colon_kwd{'parameter'} = 1;

  $nothing_kwd{'end'}=1;
  $nothing_kwd{'endfunction'}=1;
  $nothing_kwd{'endmodule'}=1;
  $nothing_kwd{''}=1;
  }

# print the comments for an architecture
sub print_arch_header {
  &reset();
  while ($stuff && (&get_next_token ne 'module')) {}
  $entity=&get_next_token;
  &print_comments;
  print  "\n";
  &print_libraries();
  print "\narchitecture ${entity}_rtl of $entity is\n";
  $_=get_to_semi;
}

# print the component list (with ports) for an architecture
# done by reading entity files with a heurisitic extension.
# This does mean that modules should be converted bottom up.
# or perhaps entitity prior to architecture
 
sub print_components {
  for $i (sort keys %component) {
    # print "trying compoent definition for $i which is a $component{$i}\n";
    unless (defined($done_component{$component{$i}})) {
      $open=0;
      if (open FILE, $component{$i} . ".vhd")     {$open = 1  }
      elsif (open FILE, $component{$i} . ".vhdl") {$open = 1}
      else {
	print "ERROR cannot find entity for $i for component description\n";
	print STDERR "cannot find entity for $i for component description\n";
      }
      if ($open) {
	$copying=0;
	$string = '';
	while (<FILE>) {
	  if (/^\s*end\s/) {$copying=0}
	  $string .= $_ if ($copying);
	  if (/^\s*port/) { $copying=1}
	}
	close FILE;
	printf("\n%scomponent %s\n",$dw,$component{$i});
	printf("%s%sport (\n",$dw,$dw);
	printf("%s",$string);
	printf("%send component;\n",$dw);
      }
    }
    $done_component{$component{$i}}=1;
  }
}


# run through the previously extracted arrays, printing out a formatted
# vhdl arch list of signals.

sub print_signals {
  print "\n";
  for $i (sort keys %signal) {
    unless (defined($port{$i}) || (defined$state_var{$i} && defined($opt_s))) {
      $vector=&vector($signal_max{$i},$signal_min{$i});
      printf("  signal %-20s : %s;\n", $i, $vector);
    }
  }
  print "\n";
}

sub print_types {
  local (@type,$type,$state_var,$state);
  foreach $state_var (sort keys %state_var) {
    @type=();
    foreach $state (sort keys %state) {
      push(@type,$state) if ($state{$state} eq $state_var);
    }
    $type=join(',',@type);
    printf("%stype %s_t is (%s,%s);\n\n",$dw,$state_var,$state_var,$type);
  }
}

sub identify_states {
  # spin through looking for variables used in FSM
  # remember the state name and the state variable so associated
  local ($i,@state_var);
  print "looking for state variables\n" if ($debug);
  for ($i=0;$i<@code;$i++) {
    if ($code[$i] =~ /^\s*casex?z?\s*\(\s*([\w\d_]+)\s*\)/) {
      unshift(@state_var,$1);
      $state_var{$state_var[0]}=1;
      print "found state variable $state_var[0]\n" if ($debug);
    }
    if ($code[$i] =~ /^\s*endcase\b/) {
      # for nested case statements..
      shift(@state_var);
    }
      
    if ($code[$i] =~ /^\s*([\w\d_]+)\s*:/) {
      $state{$1}=$state_var[0] unless ($1 eq 'default');
      print "found state $1 (for $state_var[0])\n" if ($debug);
    }
  }

  # now, try to vet what I just discovered for sanity
  for ($i=0;$i<@code;$i++) {
    if ($code[$i] =~ /^\s*(\S+)\s*\<=\s*(\S+)\s*\;/) {
#      print "$code[$i] is an equate\n";
      # this seems to be a equate
      if (defined($state_var{$1})) {
	# print "$code[$i] is an equate for a state variable $1 $2\n";
	# and its an equate to what I think is a state variable
	unless (defined($state{$2}) && ($state{$2} eq $1)) {
	  delete($state_var{$1});
	  print "$1 is NOT a state variable as $1 ne $state{$2}\n" if ($debug);
	}
      }
    }
  }
}

sub print_constants {
  local ($i,@constants,$line,$target,$expr,$size);
  # load these into a list, then print. I may choose to 
  # make state variables into their own type..
  for ($i=0;$i<@code;$i++) {
    if ($code[$i] =~ /\bparameter\b/) {
      # print "found parameter on line $i $code[$i]\n";
      $line ='';
      until ($code[$i] =~ /;/) {
	$line .= " " . $code[$i];
	$code[$i]='';
	$i++;
      }
      $line .= " " . $code[$i];
      $code[$i]='';

      # print "pieced together $line\n";

      if ($line =~ /^\s*parameter\s*(\S+)\s*=\s*(.*?)\s*;/) {
	$target=$1;
	$expr = $2;
	if ($expr =~ /\'/) { # is it a string
	  $_=&format_as_string($expr);
	  push(@constant,sprintf("%sconstant %-18s : %s;\n",$dw,$target,$_));
	}
	else {
	  push(@constant,sprintf("%sconstant %-18s : integer := %s;\n",$dw,$target,$expr));
	}
      }
      elsif ($line =~ /^\s*parameter\s*(\[.*\])\s*(\S+)\s*=\s*(.*?)\s*;/) {
	$target=$2;
	$size = $1; # unused?
	$expr = $3;
	if ($expr =~ /\'/) { # is it a string
	  $_=&format_as_string($expr);
	  push(@constant,sprintf("%sconstant %-18s : %s;\n",$dw,$target,$_));
	}
      }
      else {
	print "ERROR dont recognise parameter $_\n";
      }
    }
  }
  if (defined($opt_s)) {
    # delete states from constant array
    for ($i=0;$i<@constant;$i++) {
      $constant[$i] =~ /(\S+)\s*:/; 
      if (defined($state{$1})) {
	$constant[$i]='';
      }
    }
    print @constant;
  }
  else {
    print @constant;
  }
  print "\n";
}




# top wrapper attempting to translate the logic portion for the architecture
sub print_logic {
  print "begin\n";
  &translate;
  print "\nend ${entity}_rtl;\n";
}



# turn 8'h0e to "00001100";
# I just included this from an older script - surely there are better ways.. 
# Yuck.

sub format_as_string {
  return sprintf("std_logic_vector := %s", &format_constant($_[0]));
}

sub format_constant {
  local ($bits,$val,$str,$bin,$t,$xtnd);

  # binary fixed length
  # print "translating >$_[0]<\n";
  if ($_[0] =~ /^\s*(\d+)\'[bB]([01xXzZ_\s]+)\s*$/) {
    $bits=$1;
    if ($bits == 1) {$t="\'"} else {$t="\""}
    $val = uc($2);
    # no _ or space
    $val =~ s/_//g;
    $val =~ s/ //g;
    # create a base string thats too long
    # integers get 0 extended, unless the lh-most char is x or z in which 
    # case you extend with that character.
    $xtnd='0'; 
    $str='';
    if (substr($val,0,1) =~ /([zZxX])/) { $xtnd = uc($1)}
    for ($i=0;$i<$strlen;$i++) { $str .= $xtnd }
    # now replace the rh end
    $str=substr($str,0,$bits);
    # truncate the given string iff too long. Choose ther right hand end.
    if (length($val) > $bits) {
      $val = substr ($val, length($val) - $bits  , $bits);
    }
    # load the given string into the RH end of the constructed string
    substr($str, $bits - length($val)  ,length($val)) = $val;
    return sprintf("%s%s%s",$t,$str,$t);
  }
  # hex fixed length
  elsif ($_[0] =~ /^\s*(\d+)\'[hH]([a-fA-F0-9_xX\s]+)\s*$/) {
    $bits=$1;
    if ($bits == 1) {$t="\'"} else {$t="\""}
    $comment = "-- " . $bits . "\'h" . $2;
    # no _ or space
    $val = $2;
    $val =~ s/_//g;
    $val =~ s/ //g;
    $val = hex($val); # now decimal
    $str = '';
    vec($str,0,$strlen) = $val;  # this does not work for all lengths, try 22 say.
    $bin = unpack("B*", $str);
    # now trim
    $bin = substr($bin, $strlen-$bits, $bits);
    return sprintf("%s%s%s",$t,$bin,$t);
  }
  # decimal
  elsif ($_[0] =~ /^\s*(\d+)\'[dD]([a-fA-F0-9_xX\s]+)\s*$/) {
    $bits=$1;
    if ($bits == 1) {$t="\'"} else {$t="\""}
    # no _ or space
    $val = $2;
    $val =~ s/_//g;
    $val =~ s/ //g;
    #      $val = hex($val); # now decimal
    $str = '';
    vec($str,0,$strlen) = $val;  # this does not work for all lengths, try 22 say.
    $bin = unpack("B*", $str);
    # now trim
    $bin = substr($bin, $strlen-$bits, $bits);
    return sprintf("%s%s%s",$t,$bin,$t);
  }
  else {
    print "ERROR don't recognise the format of >$_[0]<\n";
    print STDERR "don't recognise the format of >$_[0]<\n";
    $str = $_[0];
    $str=~s/\'/_tick_/;  # used in a loop..
    return "ERROR don't recognise the format of >$str<\n";
  }
}

# main body of code attempting to translate the logic part of the architecture
sub translate {
  local ($a,$b,$c,$d);
  #  &reset;
  while ($stuff) {
    $token=&get_next_token();
    &print_comments;
    print "read token $token ($cline, $column)\n" if ($debug);
    if (defined($signal_kwd{$token})) {
      &get_to_semi();
    }
    elsif ($token eq 'always') {
      $c=&get_to_closebracket;
      &translate_always($c);
    }
    elsif ($token eq 'initial') {
      $_=&get_next_block;
      print "ERROR dont recognise initial $_\n";
      # hopefully this will not be an immediate issue for synthesizeable code.
      # FIXME
    }
    elsif ($token eq 'begin') {
      $_=&get_matching('begin','end');
      print "ERROR dont recognise begin $_\n";
      # FIXME
    }
    elsif ($token eq 'assign') {
      $_=get_to_semi;
      
      if (/^\s*(\S+)\s*=\s*([^\?:]+)\s*;/) {
	$a = $1;
	$b = $2;
	#	print "  $1 <= $2;\n";
	$_=sprintf("%s <= %s;",&clean_line($a),&clean_line($b,$a));
	printf("%s%s\n", $dw,&clean_assign($_));
      }
      # look for ? operators here..
      elsif (/^(.*)=\s*\((.*)\)\s*\?(.*):(.*);/) {
	$a = $1;
	$b = $2;
	$c = $3;
	$d = $4;
	$d =  &clean_line($d);
	printf("%s%s <= %s when %s else %s;\n",
	       $dw,&clean_line($a),&clean_line($c),
	       &clean_condition($b),$d);
      }
      elsif (/^(.*)=\s*\{(.*)\}\s*;/) {
	$a = $1;
	$b = &clean_line(&rebracket($2));
	$b=join("&", split(",",$b));
	printf("%s%s <= %s\n", $dw,&clean_line($a),$b);
      }
      else {
	print "ERROR dont recognise assign format $_\n";
      }
    }
    elsif ( defined($colon_kwd{$token}) || defined($signal{&debus($token)})
	    || defined($port{&debus($token)})) {
      $_=&get_to_semi;
      print "ERROR dont recognise $token $_\n";
      # FIXME
    }
    elsif ( defined($nothing_kwd{$token})) {
      # print "ERROR dont recognise $token $_\n";
      # FIXME
    }
    else {
      # hmm - better be an instantiation. no more clues.
      # suppose I could check the component list.
      $type = $token;
      $name = &get_next_token;
      $_ = &get_to_semi();
      &print_comments();
      print "\n";
      print "  $name : $type\n";
      print "    port map(\n";
      @_=split(",", $_);
      $term = "";
      while (@_) {
	$_=shift(@_);
	if ($_ =~ /^\s*\(?\s*\.(\S+)\s*\(\s*(.*?)\s*\)\s*\)?\s*\;?\s*$/) {
	  $a=$1;
	  $b=$2;
	  printf("%s      %-10s => %s",$term,$a,&rebracket($b));
	  $term=",\n";
	}
	else {
	  print STDERR "translate : $_ missed template\n";
	  print "ERROR translate : $_ missed template\n";
	}
      }
      print "\n      );\n\n";
    }
  }
}

# turn blah[a:b] to blah(a downto b)
sub rebracket {
  local ($r);
  if ($_[0] =~ /^(.*)\[(.*):(.*)\](.*)/) {
    $r = "$1($2 downto $3)$4";
    $r =~ s/\s\s/ /g;
    return $r;
  }
  else {
    return $_[0];
  }
}

      


# translaye a complete always clause. This does not nest.
sub translate_always {
  local ($sensitivity);
  $sensitivity = $_[0];
  undef %sensitivity; # I need to be able to insert a clk'event later
  $done_sensitivity=0;
  
  # now parse the sensitivity list
  @_=split("or",$sensitivity);
  while (@_) {
    $_=shift(@_);
    # looking here for (say) posedge clk. note brackets and @ gets in the road
    # I'll just remember the signal and the qualifying word
    if ($_ =~ /^\s*\@?\s*\(?\s*([^\(\s]+)\s+([^\)\s]+)\s*\)?\s*$/) {
      # do I have 2 terms?
      $sensitivity{$2} = $1;
      print "sensitivity $2 = $1\n" if ($debug);
    }
    elsif ($_ =~ /^\s*\@?\s*\(?\s*(\S+)\s*\)?\s*$/) {
      # do I have a sngle term between the 'or's
      $s=&rebracket($1);
      $sensitivity{$s}='both';
    }
    else {
      print "ERROR cannot parse sensitivity  $_\n";
    }
  }
  $w=$dw;
  printf ("%sprocess (%s)\n",$w,join (",", (sort keys %sensitivity)));
  printf ("%sbegin\n",$w);
#  printf ("INFO - first token is >%s<\n", &peek_next_token);
  &indent;
  &translate_next_statement();
  &unindent;
  printf ("%send process;\n\n",$w);
}


# process the body of the always.
# this is recursive, it can call itself rather a lot.

sub translate_next_statement {
  local($s,$c,$sentance, $sens_items,$token);
  &print_comments;
  $token=&peek_next_token();
#  printf ("INFO - translate working on token >%s<\n",$token);
  
  
  # extract signal rootname
  if ($token=~/([^\[]+)\[/) { $c=$1} # may be a bussed signal
  else {$c = $token }

  # perhaps a signal, perhaps bussed. Which makes it an assignment.
  if (defined($signal{$c}) || defined($port{$c})) {
    printf("%s%s\n",$w,&clean_assign(&get_to_semi()));
    printf("INFO found assignment\n") if ($debug);
  }

  # perhaps a begin
  elsif ($token eq 'begin') {
    &get_next_token(); # discard the begin
    while (&peek_next_token() ne 'end') {
      &translate_next_statement();
    }
    &get_next_token(); # discard the end
  }
  # perhaps a case
  elsif ($token =~ /^case|casex|casez$/) {
    &get_next_token(); # discard the case
    $done_sensitivity=1;  # no clk`events any more
    $c = &get_condition();
    # strip off outer brackets if redundant
    if ($c =~ /^\s*\(([^\(]+)\)\s*$/) {
      $c = $1;
    }
    $c = &clean_line(&rebracket($c));
    printf ("%scase %s is\n",$w,$c);
    &indent;
    &indent;
    while (&peek_next_token() ne 'endcase') {
      # the case may also have multple lines, so loop
      &translate_next_statement();
    }
    &get_next_token(); # discard the endcase
    &unindent;
    &unindent;
    printf ("%send case;\n",$w);
  }
  
  # perhaps a case line, check whether this term ends in :
  elsif ( $token =~ /^(.*):$/) {
    $_=$1;
#    printf("INFO case item is %s\n", $_); 
    &get_next_token; 
    if ($_ =~ /^default$/) { $_ = 'others'}
    &unindent;
    printf("%swhen %s =>\n",$w,&clean_line($_));
    &indent;
  }

  # perhaps a case line, check whether the NEXT term is :
  elsif (&peek_second_token eq ':')  {
    &get_next_token;   # I have already peeked this
    &get_next_token;   # discard the :
    if ($_ =~ /^default$/) { $_ = 'others'} 
    &unindent;
    printf("%swhen %s =>\n",$w,&clean_line($_));
    &indent;
  }
  
  # perhaps an if
  elsif ($token eq 'if'){
#    printf("INFO - its an IF\n") if ($debug);
    &get_next_token();     # zap the if
#    printf("INFO - got token\n") if ($debug);
    printf ("%sif %s then\n",$w,&clean_condition(&get_condition()));
#    printf("INFO - was an IF\n") if ($debug);
    &indent();
    &translate_next_statement();
    &unindent();
    while ( &peek_next_token() eq 'else') {
      &get_next_token; # the else
      if ($done_sensitivity == 0)  {
	$sens_items=0;
	foreach $i (keys %sensitivity) {
	  if ($sensitivity{$i} eq 'posedge') {
	    $sens = "$i\'event and $i = \'1\'";
	    $sens_items++;
	  }
	  elsif ($sensitivity{$i} eq 'negedge') {
	    $sens = "$i\'event and $i = \'0\'";
	    $sens_items++;
	  }
	}
	if ($sens_items > 1 ) {$sens = "FIXME"}
	printf("%selsif %s then\n",$w,$sens);
	$done_sensitivity=1;
      }

      elsif (&peek_next_token eq 'if') {
	# this is not a nested if - it becomes an elsif
	&get_next_token; # the if
	printf ("%selsif %s then\n",$w,&clean_condition(&get_condition));
      }
      else {
	# the very first else gets promoted with clk`event
	printf("%selse\n",$w);
      }
      &indent();
      &translate_next_statement;
      &unindent;
    }

    # every if gets exactly one end if.
    printf ("%send if;\n",$w); # this should be the only end if printer
  }
  # perhaps I'm in trouble..
  else {
    &get_next_token;
    printf ("ERROR - no idea what to do with the token %s in the always\n", $token);
  }  
  return ;
}


sub get_condition {
  local ($s,$count);
  $s='';
  $count=0;
  # extract the condition code for the if, look for (
  $_ = &get_next_token; # hopefully the (
  $s .= " " . $_;
  $count++ if ($_ eq '(');
  
  # now search for matching ')'
  while ($count!=0) {
    $_ = &get_next_token;
    # for inserting clocking templates, sensitivity terms that 
    # have appeared in prior if's get ignored in the next else.
    if (defined($sensitivity{$_})) {
      $sensitivity{$_} = 'used';
    }
    $s .= " " . $_;
    $count++ if ($_ eq '(');
    $count-- if ($_ eq ')');
  }
  return $s;
}



# clean up an assignment within a process;
sub clean_constants {
  local ($l,$begin, $end);
  $l = $_[0];
  while ($l =~ /(.*?)(\d+\'[dhb]\s*[\d_\sa-fA-FxXzZ]+)(\s*.*)/) {
    $begin=$1;
    $end=$3;
    $l = $begin . &format_constant($2) . $end;
  }
  return $l;
}
sub clean_line {
  local ($l,$dest,$size);
  $l = $_[0];
#  printf("INFO in clean_line %s\n",$l);
  $dest = $_[1] if (defined($_[1]));
  $l =~ s/\[/\(/g;
  $l =~ s/\]/\)/g;
  $l =~ s/\&\&/ and /g;
  $l =~ s/\|\|/ or /g;
  $l =~ s/\&/ and /g;
  $l =~ s/\|/ or /g;
  $l =~ s/\~/ not /g;
#  printf("INFO out clean_line %s\n",$l);
  $l =  &clean_constants($l);
#  printf("INFO out clean_line %s\n",$l);
  while ($l =~ /  /) {
    $l =~ s/  / /;
  }
#  printf("INFO out clean_line %s\n",$l);
  return  $l;
}

sub clean_assign {
  local ($l);
  $l=&clean_line($_[0]);
  if ($l =~ /^\s*(\S+)\s+<=\s+\(\s+(.+)\s+==\s+(.+)\s*\)\s*;$/) {
    $l="$1 <= '1' when $2 = $3 else '0' ;";
  }
  elsif ($l =~ /^\s*(\S+)\s+<=\s+not\s*\(\s+(.+)\s+\=\=\s+(.+)\s*\)\s*;$/) {
    $l="$1 <= '0' when $2 = $3 else '1' ;";
  }
  return  $l;
}

sub clean_condition {
  local ($l,$t,$pre,$post); 
  $l = $_[0];
  if (/$l =~ ^\s*\(([^\(]+)\)\s*$/) {
    #print "matched first\n";
    # only one bracket set? delete them
    $l = $1;
  }
  elsif ($l =~/^\s*if\s*\(\s*([^\(]+?)\s*\)\s*$/) {
    #print "matched second\n";
    # only one bracket set? delete them
    $l = "if $1";
  }
  $l =~ s/([^=])==([^=])/$1=$2/g; # == > = 
#  print "INFO condition  in is >$l<\n";
  $l = &clean_constants($l);
  $l =~ s/\|\|/ or /g;
  $l =~ s/\&\&/ and /g;
  $l =~ s/\~/ not /g;
  $l =~ s/  / /g;
  # fix variables used as booleans.
  while ($l =~ /(.*)(\(|and|or)\s(\S+)(\sand|\sor|\s\))(.*)/) {
    $pre = $1 . $2;
    $post = $4 . $5;
    $t = $3;
    if ($t =~ /^[~!](.+)$/) {
      $l = "$pre $1 = \'0\' $post";
    }
    else  {
      $l = "$pre $t = \'1\' $post";
    }
    $l =~ s/  / /g;
  }
  while ($l =~ /(.*)(not)\s(\S+)(\sand|\sor|\s\))(.*)/) {
    $pre = $1 ;
    $post = $4 . $5;
    $t = $3;
    if ($t =~ /^[~!](.+)$/) {
      $l = "$pre $1 = \'1\' $post";
    }
    else  {
      $l = "$pre $t = \'0\' $post";
    }
    $l =~ s/  / /g;
  }
#  $l =~ s/~/ not /g; 
#  if ($l =~ /^\s*\(\s+not\s+(\S+)\s+\)\s*$/) {
#     $l = "( $1 = '0' )";
#  }
#  if ($l =~ /^\s*\(\s+(\S+)\s+\)\s*$/) {
#     $l = "( $1 = '1' )";
#  }
#  print "INFO condition out is $l\n";
  return $l;
}


# these two manage whitespace indentation
sub indent {
  $w .= $dw;
}
sub unindent {
  $w=substr($w,0,length($w)-length($dw));
}