eval '(exit $?0)' && 
  eval 'exec perl -S $0 ${1+"$@"}' && 
  eval 'exec perl -S $0 $argv:q'
  if 0;
# Copyright 2000 by John Sheahan <john@reptechnic.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.
#

$ver= '$Id: spicepp,v 1.5 2000/11/20 22:37:56 john Exp john $ ';
require "getopts.pl";
&Getopts("hi");
(defined($opt_i)) ? ($interactive=1) : ($interactive=0) ;
 if (defined($opt_h)) {
   print "$0 $ver\n";
   print "  -i interactive\n";
   print "  hspice-like spice preprocessor for berkeley spice\n";
   die;
} 
# preprocess a hspice-like deck for berkeley spice 3f5
# expand .lib   .param  .temp  .global 
# expoand .meas  
# support $ for comment to lineend

# $debug=1;

# first pass read in deck, 
# inline continuation lines, remove comment lines

$_=<>;chop;@deck=" " . $_;   # heading/comment line passthrough 

while (<>) {
  chop;
  # dont lowercase stuff in quotes
  if (/(.*)([\'\"])(.*)([\"\'])(.*)/) {
    $_=lc($1) . $2 . $3 . $4 . lc($5);
  }
  else { $_ = lc($_); }
  s/\$.*//; # no trailing comments;
  s/^\*.*//;  # no comments;
  s/^\s*$//;  # no bl lines
  if (/^\s*\+(.+)/) { # continuation
    $_ = pop (@deck) . " " . $1;
  }
  push @deck,$_ if (length($_) >0);  
}
&read_parameters;
&eval_parameters;
&expand_parameters;
&read_libs;
&expand_parallel;
&expand_eqns;
&remove_vbracket;
&read_globals;
&expand_global_subs;
&expand_global_calls;
&fix_temp;
&xlat_level;
&expand_linearize;
&expand_meas;
&expand_control;
&printdeck;


if ($debug) {
  foreach $param (sort keys %param) {
    print STDERR  "param $param = $param{$param}\n";
  }
  foreach $global (sort keys %global) {
    print STDERR " global $global\n";
  }
}



################# subroutines #############

# include the specified model from the library. complain if not found.
sub libinclude {
  local ($file,$model,$found,@lib );
  $file=$_[0];
  $model=$_[1];
  @lib=();
  open (INCLUDE, "$file") || die "include file $file cannot be opened";
  $found=0;
  while (<INCLUDE>) {
    last if ($found && /^\.endl/i);
    if ($found) {
      chop;
      # dont lowercase stuff in quotes
      if (/(.*)([\'\"])(.*)([\"\'])(.*)/) {
	$_=lc($1) . $2 . $3 . $4 . lc($5);
      }
      else { $_ = lc($_); }
      s/\$.*//; # no trailing comments;
      s/^\*.*//;  # no comments;
      s/\s\s+/ /g; # shrink multiple whitespaces 
      s/^\s*$//;  # no bl lines
      s/([^\s\=]+)\s*=\s*([^\s\=]+)/$1=$2/g; # compress around =
      if (/^\s*\+(.*)/) { # continuation
	$_ = pop (@lib) . " " . $1;
      }
      push @lib,$_ if (length($_)>0);  
    }
    if (/^\.lib\s+$model\b/i) { $found=1}
  }
  print STDERR "did not find model $model in library $file\n" unless ($found);
  return @lib;
}
################## &read_libs ############
sub read_libs {
  local ($i,$file,$model);
  for ($i=0;$i<@deck;$i++) {
    $_=$deck[$i];
    if (/^\.lib\s+[\'\"](.*)[\'\"]\s+(\S+)/i) {
      $file=$1;
      $model=$2;
      @lib=&libinclude($file,$model);
      $_=@lib;
      splice(@deck,$i,1,@lib);
} } }


############## read globals ############ 
# record a hash of all global signals. kill the line.
sub read_globals {
  local ($i,$file,$model,@kill);
  for ($i=0;$i<@deck;$i++) {
    if ($deck[$i] =~ /^\.globals?\s+(.*)/) {
      for (split(" ",$1)) { $global{$_}=1 }
      push @kill,$i;
    }
  }
  &zapdeck(@kill);
}

############## kill line(s) in deck ################
sub zapdeck {
  # give it a list of lines to remove in increasing order!!!
  while ($_=pop(@_)) {
    splice @deck,$_,1;
  }
}
######### parameters #################
# find parameter define lines, remeber and delete them
sub read_parameters {
  local ($i,$j,@kill);
  for ($i=0;$i<@deck;$i++) {
    if ($deck[$i] =~/^\.param\s+(.*)/) {  # record param/value pairs
#      print STDERR "found param line $1\n";
      push @kill,$i;
      $_=$1;
      $done=0;
      until ($done) {
	if (/^\s*(\S+)\s*\=\s*\'([^\']*)\'(.*)/) {
#	  print STDERR "PARAM $1 = $2\n";
	  $param{$1}=&unit($2);
	  $_=$3;
	}
	elsif (/^\s*(\S+)\s*\=\s*(\S+)(.*)/) {
#	  print STDERR "PARAM(2) $1 = $2\n";
	  $param{$1}=&unit($2);
#	  print STDERR "PARAM(2) $1 = $param{$1}\n";
	  $_=$3;
	}
	else { $done=1; }
      }
#	  @param=split(" ",$1);
#      for ($j=0;$j<@param;$j++) {
#	if ($param[$j] =~ /(\S*)\s*=\s*(\S+)/) {
#	  $param{$1}=$2;
#	}
#	else {
#	  print STDERR "parameter parse error in line $_\n";
  } } # } 	}
  &zapdeck(@kill);
}
# replace parameters with defined string
# if the line starts with . - sub most places
# if not ., sub only last item
sub expand_parameters {
  local ($i,$j,$nline,$skip);
  for ($i=0;$i<@deck;$i++) {
    $skip=&skipnumber($deck[$i]);
    if ($i==0) {$skip=0} # replace the first line
# print STDERR "skipping $skip fields $i $deck[$i]\n";
    $nline='';
    $_=$deck[$i];
    s/\(/ \( /g; # delimit openbracket
    s/\)/ \) /g; # delimit closebracket
    s/=/ = /g;
    @_=split;
    for ($j=0;$j<$skip;$j++) {
      $nline .= $_[$j]  . " ";
    }
    for ($j=$skip;$j<@_;$j++) {
      if (defined($param{$_[$j]})) {
	$nline .= $param{$_[$j]} . " ";	
      }
      else {
	$nline .= $_[$j]  . " ";
      }
#      print STDERR "first $_[$j]\n" if ($j == $skip);
      
    }
#    print STDERR "$nline \n" if ($nline =~ /pwl/);
    $_=$nline;
    s/ \( /\(/g; # undelimit openbracket
    s/ \)/\)/g; # undelimit closebracket
    s/ = /=/g; # 
    s/ $//;      # trailing space
    $deck[$i]=$_;
}  }

################## add globals to subckt IO line  ######################

# accept subroutine data 
# add used global signals to the io defn line
# remember them in $globalsub{sub} to fix other instantiate lines 
sub expand_global_subs {
  local ($i,$subroutine,$extras,%nodes,$subckt);
  for ($i=0;$i<@deck;$i++) {
    $_=$deck[$i];
    if (defined($subckt)) { # remember nodes if in a subckt
      @_=split;
      for ($j=1;$j<@_-1;$j++) { # not first or last
	$nodes{$_[$j]}++ if (defined($global{$_[$j]}));
      }
    }
    if (/^\.subckt\s+(\S+)/) {
      $subckt=$1;
      $line=$i;
    }
    elsif (/^\.ends/) {
      $extras=join(" ", keys %nodes);
      $deck[$line] =~ s/^(.subckt.*)$/$1 $extras/;
      $globalsub{$subckt}=$extras;
      undef $subckt;
} } }

sub expand_global_calls {
  local ($i);
  for ($i=0;$i<@deck;$i++) {
    $_=$deck[$i];
    if (/^(x.*)\s+(\S+)\s*$/ && defined($globalsub{$2})) {
      $deck[$i]="$1 $globalsub{$2} $2\n";
} } }
############ measure ####################
# appears you have to linearize it all the first time
sub expand_linearize  {
  local ($i,@xtra,$first);
  for ($i=0;$i<@deck;$i++) {
    $_=$deck[$i];
    if (/^\.(tran|ac|dc)/) {
      $analysis=$1;
    }
    elsif (/^\.measu?r?e?\s+(\S+)\s+trig(.*)/) {
      $_=".meas $analysis $1 trig$2"; 
      $deck[$i]=$_;
      # fill in the missing type so I don't have to think later
    }
    if (/^\.measu?r?e? (tran|dc|ac)\s+(\S+)\s+trig\s+(\S+) .* targ\s+(\S+) .*/) {
      $first=$i unless (defined($first));
      $linearize{$3}=1;
      $linearize{$4}=1;
    }
  }
  if (defined($first)) {
    push(@xtra, ".control");
    $list=join(" ", keys %linearize);
    push(@xtra, "linearize time $list");
    push(@xtra, ".endc");
    splice(@deck,$first,0,@xtra);
    @xtra=();
  }
}
sub expand_meas  {
  local ($i,@xtra);
  for ($i=0;$i<@deck;$i++) {
    $_=$deck[$i];
    if (/^\.measu?r?e? (tran|dc|ac)\s+(\S+)\s+trig\s+(\S+) .* targ\s+(\S+) .*/) {
      $name=$2;
      $trig=$3;
      $targ=$4;
      push(@xtra, ".control");
      push(@xtra, "print time $trig $targ > meas.data");
      push(@xtra, "echo $_ > meas.ctl");
      push(@xtra, "shell measure_spice $name");
      push(@xtra, ".endc");
      splice(@deck,$i,1,@xtra);
      @xtra=();
    }
  }
}
####################### control codes #############
sub expand_control  {
  local ($i,@xtra);
  for ($i=0;$i<@deck;$i++) {
    $_=$deck[$i];
    if (/^\.(plot|print|tran|end)\b/) {
      $cmd=$1;
      s/^\.//; # drop initial dot
      s/\stran\s/ /;
      s/start=\S+//; # starts annow it
      push(@xtra, ".control");
      if ($cmd eq "end") {
	push(@xtra, "destroy all" ) unless ($interactive);
	push(@xtra, "quit") unless ($interactive);
      }
      else {
	push(@xtra, $_);
      }
      push(@xtra, ".endc");
      splice(@deck,$i,1,@xtra);
      @xtra=();
    }
  }
}

################# translate model level #######
# bsim3 (v3)
sub fix_temp {
  for ($i=0;$i<@deck;$i++) {
    if ($deck[$i] =~ /^\.tempe?r?a?t?u?r?e?\s*\=\s*(\S+)/) {
      $deck[$i] = ".options temp=$1";
} } }

sub xlat_level {
  for ($i=0;$i<@deck;$i++) {
    $deck[$i] =~ s/(.*)\blevel\s*=\s*49\b(.*)/$1level=8$2/;
} }

sub printdeck {
  for (@deck) {
    print &wrapline(70,"","+","\n"," ",split(" ",$_)); 
  }
}

######################### wrapline ###############

# wrapline( linelen, header, header2, trailer, 
#           separator, list )
# where 
#  linelen max number of chars per line   eg 70
#  header   is a string stuck on to the beginning
#  header2  is a string to add to the second and all subsequent lines,
#           {if they exist]
#  trailer is a string to tack on to the end of the structure
#  separator is put between multiple elements in the list (NOT last)
#  list     
# returns string

sub wrapline {
    local($maxlen, $header, $header2, $trailer, 
          $separator, $linelen, @list, $output, $term, $last_term);

    ($maxlen, $header, $header2, $trailer, $separator, @list)=@_;
     $output=$header;
     $linelen=length($output);
     $last_term=pop(@list);
     foreach $term (@list) {
         if ((length($term)+$linelen+length($separator))>$maxlen) {
             $output .= "\n$header2" ;
             $linelen = length($header2);
         }
         $output .= "$term$separator";
         $linelen += length($term)+ length($separator);
     }
         if ((length($last_term)+$linelen+length($trailer))>$maxlen) {
             $output .= "\n$header2" ;
         }
         $output .= "$last_term$trailer";
return $output;
}

######################### equation support ########
sub isnumber {
  if (($_[0] =~ /\s*[\+\-]?[0-9\.]+\s*/) ||
      ($_[0] =~ /\s*[\+\-]?[0-9\.]+e[\+\-]?\d+/)) {
    return 1;
  }
  else {
    return 0;
  }
}
  
sub process {
#  print STDERR "mapped $_[0] ";
  local ($nline,$r,$i);
  $_=$_[0];
  s/([\(\)\*\+\-\/])/ $1 /g; # space delimit operators
  s/\^\^/ ^^ /g; # space delimit exponent
#  print STDERR " delim $_ ";
  @_=split;
  for ($i=0;$i<@_;$i++) {
    if (defined($param{$_[$i]})) {
      $nline .= $param{$_[$i]}  . " ";
    }
    else {
      $nline .= $_[$i]  . " ";
    }
  }
# print STDERR " $nline " ;
 $r=eval($nline);
  print STDERR $@ if ($@ ne '');
#  print STDERR "to $r\n";
  return $r;
}

# probably only one level deep..
sub eval_parameters {
  local ($val, $nval, $param);
  for $param (keys %param) {
#    print STDERR "checking param $param \n";
    $val=$param{$param};
    if ($val =~ /\'(.*)\'/) {
      $nval=&process($val);
#      print STDERR "eval: processed $val to $nval\n";
      $param{$param}=$nval;
    }
    else {
      $nval = &unit($val);
#      print STDERR "eval: united $val to $nval\n";
      $param{$param}=$nval;
    }
  }
}
sub expand_eqns  {
  local ($i,$head,$tail,$p);
  for ($i=0;$i<@deck;$i++) {
    $_=$deck[$i];
    while (/(.*)\'([^\']*)\'(.*)/) {
      $head=$1; $tail=$3;
      $p=&process($2);
      $_=$head . " $p " . $tail;
      s/= /=/g;
#      print STDERR "translated $deck[$i]\n        to $_\n";
    }
    $deck[$i]=$_;
  }
}
# if it looks like v(pin) replace with pin
sub remove_vbracket  {
  local ($i,$nline);
  for ($i=0;$i<@deck;$i++) {
    $_=$deck[$i];
    $nline='';
    for (split) {
      if (/^v\((.*)\)$/) { 
#      print STDERR "found vbracket $_ to $1 line $i\n";
	$_=$1;
}
      $nline .=  $_  . " ";
    }
    $deck[$i]=$nline;
}  }
# m=3 can be used to insert 3 parallel instances into the netfile
# need to delete the m= and increment the instance name while copying 
# strings
sub expand_parallel  {
  local ($i,$n,$orig,$iname,$dname,$j);
  for ($i=0;$i<@deck;$i++) {
    if ($deck[$i] =~ /\sm=(\d+)\b/) {
#      print STDERR "$i : $deck[$i]\n";
      $n=$1;
      $_=$deck[$i];
      s/ m=$n//; # remove the m=xx
      /^(\S+)\s/;
      $iname=$1;
      $deck[$i]=$_;
      $orig=$_;
#      print STDERR "$i : n = $n iname = $iname \n";
#      print STDERR "parallel in line $i\n $n copies of $iname\n";
      for ($j=2;$j<=$n;$j++) {
	$_=$orig;
	$dname=$iname . "__" . $j;
	s/$iname/$dname/;
#	print STDERR "add $_\n";
	splice(@deck,$i+$j-1,0,$_);
      }
    }
  }
}


sub unit {
  if ($_[0] =~ /^([0-9e\+\-\.]+)(t|g|meg|k|mil|m|u|n|p|f)?(v|a|s)?$/) {
    if    ($2 eq 't')   { $mult = 1e12 } 
    elsif ($2 eq 'g')   { $mult = 1e9  } 
    elsif ($2 eq 'meg') { $mult = 1e6  } 
    elsif ($2 eq 'k')   { $mult = 1e3  } 
    elsif ($2 eq 'm')   { $mult = 1e-3   } 
    elsif ($2 eq 'u')   { $mult = 1e-6   } 
    elsif ($2 eq 'n')   { $mult = 1e-9   } 
    elsif ($2 eq 'p')   { $mult = 1e-12  } 
    elsif ($2 eq 'f')   { $mult = 1e-15  } 
    elsif ($2 eq 'mil') { $mult = 25.4e-6} 
    else                { $mult = 1  } 
#    print STDERR "unit $_[0] mult $mult val $1 letter $2 unit $3\n";
    return $1 * $mult;
  }
  return $_[0];  # maybe perl does it better??
}


# when substituting parameters , skip this number from the start
sub skipnumber {
  local ($in,$f);
  $in=$_[0];
  $_=substr($in,0,1); # get the first char in the line
  $f=$_;
  # apart from the bjt - which I treat as a 3node device - all these 
  # have a fixed number of nodes
  $n=tr/cdefghijklmoqrstuvw/2244442322443244424/; # element nodes
# print STDERR "first char $f matched $_ skip $_ \n";
  if ($n == 1) { 
    return $_+1;   # add the name of the instance to the number of nodes
  }
  @_=split(" ",$in);
  $_=@_;
  if ($f eq 'x') { # only the last on ein a subckt call
    return $_-1;
  }
  $first=shift(@_);
  if ($first =~ /^\.meas/) { return 1 }   # process this line
  elsif ($first =~ /^\.tran/) { return 1 }   # process this line
  elsif ($first =~ /^\.lib/) { return 2 }   # process last one
  else { return $_ }                      # skip the line
}