#!/usr/bin/perl

# Ce programme prend en entre la description vhdl du composant et
# cre le fichier de description de l'anneau(ring) qui entoure le
# noyau
#
# Entre : _fichier_.vbe
# Sortie : _fichier_.c

# vrifie : 1) qu'il y a un et un seul paramtre, 2) que ce paramtre
# est un fichier .vbe lisible, 3) que a ressemble  un fichier de
# description vhdl (commence par entity  part les lignes de
# commentaire)

$f=@ARGV[0].".vbe";
$fw=@ARGV[0].".travail.$$";
$fc=@ARGV[0].".c";

$usage="usage: $0 fichier_description_vhdl (sans le suffixe)\n";
$isvhdl="$f ne semble pas tre un fichier VHDL\n";
$syntaxerror="probable erreur dans la description de l'entit VHDL\n";
$blague="Inutile de travailler sur un composant qui ne possde pas d'entres-sorties\n";
$alimerror="Il ne faut pas intgrer les alimentations (vss ou vssi,vd ou vddi,vsse,vdde)\n dans le fichier source VHDL\n";
$clockwarn="Il n'y a apparemment pas d'horloge  ce circuit.\nS'il y en a une, il faut la nommer clk ET QU'ELLE SOIT DU TYPE `out bit'.\nDe plus, une ligne clk est quand mme gnre.\nElle doit tre adress par p_clk dans le fichier .rin\nIl suffira de la relier  `vdd'\n";


if (@ARGV!=1) {
	die $usage;
}

if (! (-f $f && -r $f)) {
	die "erreur: $f n'est pas un fichier lisible\n\t$f est le rsultat
	de asimut";
}

# limination de tous les commentaires et lignes vides

open (ENTREE,$f) || die "ne peut ouvrir $f\n";
open (SORTIE,">".$fw) || die "ne peut crer $fw\n";
while(<ENTREE>) {
	chop;
	s/--.*//;
	if (!/^\s*$/) { print SORTIE $_."\n"; }
}
close (ENTREE);
close (SORTIE);

open (ENTREE,$fw);
# on recherche le mot 'entity' en majuscules ou minuscules
$_=<ENTREE>;
chop;
if (!(/^\s*entity/i)) { die $isvhdl;}
close(ENTREE);

open(ENTREE,$fw);
while (<ENTREE>) {
	chop;
	if (/port/i) { last; }
}
if ($_ eq undef) {
	die $syntaxerror;
}




# procdure d'analyse des lignes dcrivant les entres-sorties
#on suppose que le fichier a t correctement fait pour viter de
#vrifier trop de choses. C'est--dire que, par ligne, on a :
#
#         liste_de_signaux : direction type_de_signal
#

sub analyse_ligne {
	local ($ligne)=@_;
	local (@sigs,$_,$sens,@dims,$ordr);

	#d'abord, on met tout en minuscules.
	$_=$ligne;
	$ligne=~tr/[A-Z]/[a-z]/;
	
	# on extrait les noms de variable
	$_=$ligne;
	s/^\s*//;          # supprime les espaces au dbut,
	s/\s*:.*$//;       # la ligne aprs le ':'
	s/\s*,\s*/,/g;     # et les espaces entre les variables et ','
	@sigs=split(/,/);

	# maintenant qu'on a les noms des signaux,
	# il nout faut leurs caractristiques
	$_=$ligne;
	s/^.*:\s*//; # on supprime tout jusqu'au ':' (et les qques espaces
	s/\s*$//;    #   qui suivent) ainsi que les espaces de fin.
	s/\s/\n/;    # remplace la premire occurence d'un espace par un saut
	             #   de ligne pour sparer le sens et les dimensions
	@temp=split(/\n/);
	$sens=@temp[0]; # on extrait le sens
	$_=@temp[1]; # on se prpare  extraire le reste
	s/^\s*//; # enlve les espaces du dbut
	s/\s*\(\s*/\n/; # spare ventuellement le type des dimensions
	                #   si le type est bit_vector
	@temp=split(/\n/);
	$type=@temp[0]; # on extrait le type;
	if ($type eq "bit_vector") {
		# dans ce cas, il faut mmoriser :
		#    1) les dimensions du signal
		#    2) l'ordre ('to' ou 'downto')
		$_=@temp[1];
		s/\s*\).*//g;

		@temp=split (/\s+/);
		if (@temp != 3) { die $syntaxerror; }
		@dims[0]=@temp[0];
		@dims[1]=@temp[2];
		$ordr=@temp[1];
	} else
	{
		@dims=("0","0");
		$ordr="to";
	}

	foreach $i (@sigs) {
		push (@globsigs,$i);
		push (@globsens,$sens);
		push (@globtype,$type);
		push (@globdim0,@dims[0]);
		push (@globdim1,@dims[1]);
		push (@globordr,$ordr);
	}
	
}	




# on a trouv "port" sur la ligne, il faut maintenant rassembler la
# description des ports en une seule chane de caractres.
# Le problme, c'est que les bit_vector sont des dclarations avec aussi
# des parenthses.Il ne faut donc pas confondre la parenthse fermante
# de la dclaration 'port' et une parenthse fermante d'une dclaration
# bit_vector
$liste="";
# Si la parenthse ouvrante ne se trouve pas sur cette ligne juste aprs
# la dclaration port, alors elle est sur la ligne suivante (on a supprim
# les lignes vides et les lignes de commentaire).
if (/port\s*[^\s\(]/i) { die $syntaxerror; }
if (/port\s*$/i) {
	$_=<ENTREE>;
	chop;
	if (!/^\s*\(/) { die $syntaxerror; }
}
s/^.*\(//;
# si cette ligne ne contenait pas de dclarations, on la jette
# aprs avoir vrifi qu'il ne s'agit pas d'une farce
if (/^\s*\)/) { die $blague; }
if (/^\s*$/) {
	$_=<ENTREE>;
	chop;
	if (/^\s*\)/) { die $blague; }
}
# Maintenant, on tente la concatnation de toutes les lignes une  une
# jusqu' la parenthse fermante finale
# On dcide si une parenthse fermante est bien celle que l'on cherche
# si elle est toute seule sur la ligne

$niveau=0;
while (1)
{
	if ($_ eq undef) { die $syntaxerror; }
	$ouvr=index($_,"(");
	$ferm=index($_,")");
	while ($ouvr>=0 || $ferm>=0) {
		if ($ouvr>=0 && (($ferm>=0 && $ouvr<$ferm) || $ferm==-1)) {
			$niveau++;
			if ($niveau==2) { die $syntaxerror; }
			$liste=$liste.substr($_,0,$ouvr+1);
			$_=substr($_,$ouvr+1);		
		} else {
			$niveau--;
			if ($niveau==-1) { last; }
			$liste=$liste.substr($_,0,$ferm+1);
			$_=substr($_,$ferm+1);
		}
		$ouvr=index($_,"(");
		$ferm=index($_,")");
	}
	if ($niveau==-1) { last; }
	$liste=$liste.$_." ";
	$_=<ENTREE>;
	chop;
}
$liste=$liste.substr($_,0,$ferm);



@declarations=split(/;/,$liste);
@globsigs=(); # Voici les tableaux qu'on doit rcuprer  la fin
@globsens=();
@globtype=();
@globdim0=();@globdim1=();
@globordr=();
foreach $i (@declarations) { analyse_ligne($i); }

close (ENTREE);
unlink ($fw);


#pour le dboguage uniquement

#for ($i=0; $i<@globsigs; $i++) {
#	print "Le signal: @globsigs[$i]\n";
#	print " est du type: @globtype[$i] dans la direction: @globsens[$i]\n";
#	if (@globtype[$i] eq "bit_vector") {
#		print "  de dimensions: @globdim0[$i]-@globdim1[$i] (@globordr[$i])\n";
#	}
#}


# Super, maintenant on a tous les signaux, on peut gnrer le fichier c

# Mais d'abord, commenons par vrifier qu'un malin n'a pas introduit
# un des signaux suivants (vss,vdd,vssi,vddi,vsse,vdde) dans son code VHDL
# et regardons si la ligne clk a t dfinie

sub min {
	local ($a,$b)=@_;
	$a<$b?$a:$b;
}

sub max {
	local ($a,$b)=@_;
	$a<$b?$b:$a;
}

$noclk=1;
foreach $_ (@globsigs) {
	if (/^v(ss|dd)i?$/) { die $alimerror; }
	if ($_ eq "clk") { $noclk=0; }
}

if ($noclk) { print $clockwarn; }

open (SORTIE,">".$fc);

print SORTIE "#include <genlib.h>\n\n";
print SORTIE "int main() {\n";
print SORTIE "\tDEF_LOFIG(\"@ARGV[0]\");\n\n";
print SORTIE "\t/* signaux utilisateurs */\n";
for ($i=0; $i<@globsigs; $i++) {
	$sig=@globsigs[$i];
	$_=@globsens[$i]; tr/[a-z]/[A-Z]/;$sens=$_;
	if (@globtype[$i] eq "bit_vector") {
		$sig.="[".@globdim0[$i].":".@globdim1[$i]."]";
	}
	print SORTIE "\tLOCON(\"$sig\",$sens,\"$sig\");\n";
}
print SORTIE "\n";
print SORTIE "\t/* signaux d'alimentation */\n";
print SORTIE "\tLOCON(\"vdd\",IN,\"vdd\");\n";
print SORTIE "\tLOCON(\"vss\",IN,\"vss\");\n";
print SORTIE "\tLOCON(\"vdde\",IN,\"vdde\");\n";
print SORTIE "\tLOCON(\"vsse\",IN,\"vsse\");\n";
print SORTIE "\n";
if ($noclk) {
	print SORTIE "\t/* On rajoute la ligne d'horloge dont on a besoin */\n";
	print SORTIE "\tLOCON(\"clk\",IN,\"clk\");\n";
	print SORTIE "\n";
}
print SORTIE "\n";
print SORTIE "\t/* On passe  l'insertion des pads et du noyau */\n";
print SORTIE "\t/* On commence par les alimentations */\n";

$temp=", \"clock\", \"vdde\", \"vdd\", \"vsse\", \"vss\", 0);\n";
print SORTIE "\tLOINS(\"pvsse_sp\",\"p_vsse\"".$temp;
if ($noclk) {
	print SORTIE "\tLOINS(\"pvdde_sp\",\"p_vdde\"".$temp;
} else {
	print SORTIE "\tLOINS(\"pvddeck_sp\",\"p_vdde\",\"i_clk\"".$temp;
}
print SORTIE "\tLOINS(\"pvssi_sp\",\"p_vss\"".$temp;
print SORTIE "\tLOINS(\"pvddi_sp\",\"p_vdd\"".$temp;

print SORTIE "\n";
print SORTIE "\t/* Maintenant les pads pour le signaux utilisateurs */\n";
print SORTIE "\t/* On commence spcialement par l'horloge */\n";
print SORTIE "\tLOINS(\"pck_sp\", \"p_clk\",\"clk\"".$temp;
print SORTIE "\t/* Puis le reste */\n";
for ($i=0; $i<@globsigs; $i++) {
	$sig=@globsigs[$i];
	if ($sig ne "clk") {
		# deux possibilits :
		if (@globtype[$i] ne "bit_vector") {
			#   1) La premire,simple,c'est un bit
			if (@globsens[$i] eq "in") {
				print SORTIE "\tLOINS(\"pi_sp\",\"p_$sig\",";
				print SORTIE "\"$sig\",\"i_$sig\"".$temp;
			} else {
				print SORTIE "\tLOINS(\"po_sp\",\"p_$sig\",";
				print SORTIE "\"i_$sig\",\"$sig\"".$temp;
			}
		} else {
			#   2) Plus compliqu, c'est un bit_vector
			$min=min(@globdim0[$i],@globdim1[$i]);
			$max=max(@globdim0[$i],@globdim1[$i]);
			if (@globsens[$i] eq "in") {
				for ($j=$min; $j<=$max; $j++) {
					print SORTIE "\tLOINS(\"pi_sp\",\"p_$sig$j\",";
					print SORTIE "\"".$sig."[$j]\",\"i_".$sig."[$j]\"".$temp;
				}
			} else {
				for ($j=$min; $j<=$max; $j++) {
					print SORTIE "\tLOINS(\"po_sp\",\"p_$sig$j\",";
					print SORTIE "\"i_".$sig."[$j]\",\"".$sig."[$j]\"".$temp;
				}
			}
		}
	}
}

print SORTIE "\n\n\t/* Et enfin on intgre le noyau */\n";
print SORTIE "\tLOINS(\"core\",\"core\",\n\t\t  ";
for ($i=0; $i<@globsigs; $i++) {
	$sig=@globsigs[$i];
	if (@globtype[$i] eq "bit_vector") {
		$sig.="[".@globdim0[$i].":".@globdim1[$i]."]";
	}
	print SORTIE "\"i_$sig\",";
}
print SORTIE "\n\t\t  ";
print SORTIE "\"vdd\",\"vss\",0);\n\n";

print SORTIE "\tSAVE_LOFIG();\n";
print SORTIE "\treturn 0;\n";
print SORTIE "}\n";



close (SORTIE);
# termin

# on donne des informations au script Perl prepareproof
# c'est  dire si le circuit contient une horloge

if ($noclk)
{
    system("touch","noclk");
} else
{
    system("rm","-f","noclk");
}
