#!/users/tfm/packbin/perl

sub infor
	{
	$varname=shift(@_);
	$rangestart=shift(@_);
	$rangeend=shift(@_);
	$code="";

	
	while(<>)
		{
		$line=$_;
		$lineno++;
		if(/^ *#endfor *$/)
			{
			#print STDERR "found endfor\n";
			last;
			}
		$code=$code.$_;

		#print STDERR "code= $code\n";
		}
	for($z=$rangestart;$z<=$rangeend;$z++)
		{
		my($block)=$code;
		$block=~s/$varname/$z/g;
		print $block;
		}
	}

sub instruct
	{
	$structname=shift;

	$sizesofar=0;


	print ("//START OF STRUCTURE DEFINITION FOR $structname\n\n");

	while(<>)
		{
		$line=$_;
		$lineno++;
		print("\n//FROM $line");
		if(/^\s*ENDSTRUCT\s*$/)
			{
			last;
			}
		elsif(/^\s*(.*)\s+([a-zA-Z_][a-zA-Z0-9_]*)\s*;\s*$/)
			{
				#simple type
			$typestr=$1;
			$name=$2;
			($type,$size)=findtype($typestr);
			if(!defined($size)) { printerror("Failed to get type for '$typestr'\n"); next;}
			
			
			print("  macro expr ${structname}_get_$name(obj) = (($type)(\n");
			print("    BITSELECT(obj,$sizesofar+$size-1,$sizesofar)));\n");
			print("  macro expr ${structname}_set_$name(obj,val) = \n");
			print("    BITSELECT(obj,width(obj)-1,$sizesofar+$size) @ ((unsigned $size)val) @ BITSELECT(obj,$sizesofar-1,0);\n");

			$sizesofar+=$size;
			}
		elsif(/^\s*(.*)\s+([a-zA-Z_][a-zA-Z0-9_]*)\[([a-zA-Z0-9_\+\*\- ]+)\]\s*;\s*$/)
			{
				#array type
			$typestr=$1;
			$name=$2;
			$arraysizestr=$3;
			($type,$size)=findtype($typestr);
			$arraysize=reduce($arraysizestr);
		
			if($arraysize==0) { printerror("Tried to create zero size array - or could not get size for $arraysizestr"); }	

			if(!($arraysize=~/^[0-9]+$/))	{ printerror("Failed to get array size for '$arraysizestr' best attempt: $arraysize");}
			if(!defined($size)) { printerror("Failed to get type for '$typestr'\n"); next;}

				#Calculate the width in bits of the offset into this array
			$offsetwidth=1;
			while((1<<$offsetwidth) < $arraysize)		{	$offsetwidth++;	}

				#First macros to get/set the whole array in one go
			print("  macro expr ${structname}_get_${name}_all(obj) = ((unsigned)(\n");
			print("    BITSELECT(obj,$sizesofar+$size*$arraysize-1,$sizesofar)));\n");
			print("  macro expr ${structname}_set_${name}_all(obj,val) = \n");
			print("    BITSELECT(obj,width(obj)-1,$sizesofar+$size*$arraysize) @ ((unsigned $size)val) @ BITSELECT(obj,$sizesofar-1,0);\n");

				#Next macros to get/set constant indexes into the array
			for($i=0;$i<$arraysize;$i++)
				{
				print("  macro expr ${structname}_get_${name}_$i(obj) = (($type)(BITSELECT(obj,$sizesofar+($i+1)*$size-1,$sizesofar+$i*$size)));\n");
				print("  macro expr ${structname}_set_${name}_$i(obj,val) = BITSELECT(obj,width(obj)-1,$sizesofar+($i+1)*$size) @ ((unsigned $size) val) @ BITSELECT(obj,$sizesofar+$i*$size-1,0);\n");
				}

				#Finally the macros to get/set non constant indexes
			print("  macro expr ${structname}_get_$name(obj,offset) = (($type)(\n");
			$closes="";
			for($i=0;$i<$arraysize-1;$i++)
				{
				print("    ($i==((unsigned $offsetwidth)offset))?BITSELECT(obj,$sizesofar+($i+1)*$size-1,$sizesofar+$i*$size):(\n");
				$closes.=")";
				}
			print("                BITSELECT(obj,$sizesofar+($i+1)*$size-1,$sizesofar+$i*$size)$closes));\n");
			print("  macro expr ${structname}_set_$name(obj,offset,val) = \n");
			$closes="";
			for($i=0;$i<$arraysize-1;$i++)
				{
				print("    ($i==((unsigned $offsetwidth)offset))?BITSELECT(obj,width(obj)-1,$sizesofar+($i+1)*$size) @ ((unsigned $size) val) @ BITSELECT(obj,$sizesofar+$i*$size-1,0):(\n");
				$closes.=")";
				}
			print("                BITSELECT(obj,width(obj)-1,$sizesofar+($i+1)*$size) @ ((unsigned $size) val) @ BITSELECT(obj,$sizesofar+$i*$size-1,0) $closes;\n");



			$sizesofar+=$size*$arraysize;
			}
		elsif(/^\s*\/\// || /^\s*$/)
			{		# A C++ style comment or blank line - ignore it
			}
		else
			{
			printerror("Failed to underdtand line\n"); 
			next;
			}
		}
	

	print("#define ${structname}_BITS $sizesofar\n");
	print("#define $structname unsigned ${structname}_BITS\n");
	print ("\n//END OF STRUCTURE DEFINITION FOR $structname\n");

	$dict{$structname}="unsigned $sizesofar";
	$definedict{$structname}="unsigned $sizesofar";
	#print STDERR "STRUCT DEFINED $structname as 'unsigned $sizesofar'\n";

	}

sub findtype
	{
	$expr=shift(@_);
	$expr=~s/^\s*(.*?)\s*$/$1/m;
	$expr=reduce($expr);
	$expr=~s/^\s*(.*?)\s*$/$1/m;
	#print STDERR "'$expr'\n";
	if($expr=~/^int\s*([0-9]+)$/)
		{
		return ("int",$1);
		}
	elsif($expr=~/^unsigned\s+([0-9]+)$/)
		{
		return ("unsigned",$1);
		}
	elsif($expr=~/^unsigned\s+int\s+([0-9]+)$/)
		{
		return ("unsigned",$1);
		}
    else                            
		{   
	print STDERR "NO MATCH '$expr'\n";
		return ("",undef);                   
		}
	}

sub reduce
	{
	$string=shift(@_);
	$expr=~s/^\s*(.*?)\s*$/$1/m;
	#print STDERR "Reducing '$string'\n";

	if($string=~/^\((.*)\)$/)
		{
		return reduce($1);
		}
	elsif($string=~/^([^\(\)]+)\*([^\(\)]+)$/)
		{
		$a=$1;	$b=$2;
		return reduce($a) * reduce($b);
		}
	elsif($string=~/^([^\(\)\*]+)\+([^\(\)\*]+)$/)
		{
		$a=$1;	$b=$2;
		return reduce($a) + reduce($b);
		}
	elsif($string=~/^([^\(\)\*]+)<<([^\(\)\*]+)$/)
		{
		#print STDERR "matched << in $line";
		$a=$1;	$b=$2;
		return reduce($a) << reduce($b);
		}
	elsif($string=~/^([^\(\)\*]+)>>([^\(\)\*]+)$/)
		{
		#print STDERR "matched >> in $line";
		$a=$1;	$b=$2;
		return reduce($a) >> reduce($b);
		}
	elsif(!($string=~/\s/))
		{
	#	print STDERR "here\n";
		if(defined($definedict{$string}))	{	return $definedict{$string};	}
		else								{	return $string;					}
		}
	else
		{
		@list=split /\s+/,$string;
		$newstring="";
		foreach $word (@list)
			{
			$word=reduce($word);
			if(defined($definedict{$string}))	{$newstring.=$definedict{$string}." ";}
			else								{$newstring.=$string." ";}
			}
		return $newstring;
		}
	}

sub addtotypedict
	{
	$name=shift(@_);
	$val=shift(@_);
	#print STDERR "ASKED TO DEFINE $name as '$val'\n";
	$val=reduce($val);
	$val=~s/^\s*(.*?)\s*$/$1/m;
	#print STDERR "DEFINED $name as '$val'\n";
	$definedict{$name}=reduce($val);
	}

sub findval
	{
	$expr=shift(@_);
	$expr=~s/^\s*(.*?)\s*$/$1/m;

	#print STDERR "findval($expr)";

	if($expr=~/^-?[0-9]+$/)			{	return $expr;					}
	elsif($expr=~/\((.*)\)/)		{	return findval($1);				}
	elsif($expr=~/([^()]*)\*([^()]*)/)		{	return findval($1)*findval($2);}
	elsif($expr=~/([^()]*)\+([^()]*)/)		{	return findval($1)+findval($2);}
	elsif($expr=~/([^()]*)-([^()]*)/)		{	return findval($1)-findval($2);}
	elsif(defined($dict{$expr}))	{	$expr=findval($dict{$expr});	}
	else							{	return undef;					}
	}

sub printerror
	{
	$msg=shift;
	print STDERR "Error on line $lineno: $line";
	print STDERR $msg."\n";
	$error++;
	}

print STDERR "Running TFM's preprocessor\n\n";

print "macro expr BITSELECT(val,high,low)=select(low<high,val[high:low],0);\n\n\n";


$lineno=0;
$error=0;
while(<>)
	{
	$line=$_;
	$lineno++;
	if(/^\s*#for\s+([a-zA-Z_]+)\s*=\s*([a-z0-9A-Z\-\+\* ]+)\s+to\s+([a-z0-9A-Z\-\+\* ]+)\s*$/)
		{
		$varname=$1;
		$rangestart=$2;
		$rangeend=$3;

		$start=findval($rangestart);
		$end=findval($rangeend);
		if(defined($start) && defined($end))
			{
			infor($varname,$start,$end);
			}
		else
			{
			$error++;
			$message="";
			if(!defined($start)){	$message="Don't know what $rangestart means\n";	}
			if(!defined($end))	{	$message="Don't know what $rangeend means\n";	}
			if($message eq "")	{	$message="Internal error in #for\n";			}
			printerror($message);
			}
		}
	elsif(/^\s*#define\s+([0-9a-zA-Z_]+)\s*(.*)$/)
		{
		$name=$1;
		$val=$2;
		addtotypedict($1,$2);
		$val=findval($val);
		if(defined($val))
			{
			$dict{$name}=$val;
			#print STDERR "Added defn: '$name' = '$val'";
			}
		else
			{
			#print STDERR "failed to reduce $2";
			}
		print $line;
		}
	elsif(/^\s*STRUCT\s+([a-zA-Z_][a-zA-Z0-9_]*)\s*$/)
		{
		instruct($1);
		}
	else
		{
		print;
		}
	}

if($error==0)	{	print STDERR "TFM's preprocessing completed with no errors!\n\n";}
else			{	print STDERR "$error errors found while preprocessing\n\n";		 }
exit($error);