306 lines
10 KiB
Perl
Executable File
306 lines
10 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
# spiceprm
|
|
# Pass parameters to spice subcircuits.
|
|
# Usage: spiceprm infile [outfile]
|
|
# infile and outfile must be different.
|
|
# Output written to STDOUT if outfile not given.
|
|
|
|
$BANNER = "Spiceprm version 0.11, Copyright (C) 1996 Andrew J. Borsa";
|
|
|
|
# NOTES:
|
|
# 1. Units not recognized inside .subckt {} expressions.
|
|
# 2. Perl exponent operator: "**", Spice exp op: "^".
|
|
# 3. "-" as part of subckt name doesn't work but "_" does.
|
|
|
|
# Netlist convention
|
|
# Xname n1 n2 n3 ... ni subname {p1 = val1 ... pj = valj}
|
|
# p1 thru pj are the parameters to be passed to the subcircuit.
|
|
# val is any valid spice value.
|
|
#
|
|
# .subckt name n1 n2 ... ni {p1 p2 ... pj}
|
|
# parameter expressions must be enclosed in {}.
|
|
|
|
# After substitution -
|
|
# Xname n1 n2 n3 ... ni subname#k
|
|
# *{p1 = val1 ... pj = valj}
|
|
# .subckt subname#k n1 n2 n3 ... ni
|
|
# ... listing with parameters substituted
|
|
# .ends
|
|
|
|
# %subckt: key = subname
|
|
# value = startline, endline, listing(.subckt ... .ends)
|
|
# Only for .subckts with parameters.
|
|
# %subprm: key = subname
|
|
# value = parameter name list
|
|
# %subcall: key = Xname[#subname0#subname1...]
|
|
# value = subname#k
|
|
# NOTE: IF Xname is called from within a .subckt, it will have calling
|
|
# .subckt names appended, delimited by #'s.
|
|
# %sub: key = subname#k
|
|
# value = p1 val1 ... pj valj, where val is a pure
|
|
# numeric with no units.
|
|
|
|
$MAXLEN = 70; # Max output file line length.
|
|
$DMAXLEN = 10; # Amount to increment if necessary.
|
|
$linenum = 0;
|
|
|
|
%units = ('f','1e-15','p','1e-12','n','1e-9','u','1e-6','mil','25.4e-6',
|
|
'm','1e-3','k','1e3','meg','1e6','g','1e9','t','1e12');
|
|
|
|
$* = 1; # Pattern match with multi-line strings.
|
|
|
|
($infile, $outfile) = @ARGV;
|
|
print "\n$BANNER\ninfile: $infile\noutfile: $outfile\n\n";
|
|
$#ARGV && ($infile eq $outfile)
|
|
&& die "Input and Output filenames must be different\n";
|
|
open(INFILE, $infile) || die "Can't open source file: $infile\n";
|
|
$hasprm = $depth = 0;
|
|
&prm_scan;
|
|
close(INFILE);
|
|
|
|
open(INFILE, $infile) || die "Can't open source file: $infile\n";
|
|
unlink $outfile if $#ARGV;
|
|
open(OUTFILE, $#ARGV ? ">$outfile" : ">-")
|
|
|| die "Can't open output file: $outfile\n";
|
|
$depth = 0;
|
|
&prm_wr;
|
|
close(INFILE);
|
|
close(OUTFILE);
|
|
|
|
# Get a line from the input file, combining any continuation lines into
|
|
# one long line. Skip comment and blank lines.
|
|
sub prm_getline {
|
|
local($line);
|
|
|
|
chop($line = defined($nxtline) ? $nxtline : <INFILE>);
|
|
$linenum = $.;
|
|
while ($nxtline = <INFILE>) {
|
|
if ($line =~ /^\*|^\s/) { $line = ''; }
|
|
if ($line eq '' || $nxtline =~ s/^(\+)/ /) {
|
|
chop($nxtline);
|
|
$line .= $nxtline;
|
|
}
|
|
else { last; }
|
|
}
|
|
$line;
|
|
}
|
|
|
|
# Scan the input file looking for subcircuit calls with parameter list and
|
|
# any subcircuits with defined parameters.
|
|
sub prm_scan {
|
|
local(@w, @tmp, @list);
|
|
local($xnm, $subnm, $i, $max, $m, $s, $n, $tmp, $start);
|
|
local($sublist) = '';
|
|
|
|
PRM_SCAN: while ($_ = &prm_getline) {
|
|
# skip .control - .endc blocks
|
|
if (/^\.control/i) {
|
|
while ($_ = &prm_getline) { next PRM_SCAN if (/^\.endc/i); }
|
|
}
|
|
tr/A-Z/a-z/;
|
|
PRM_TST: {
|
|
if (/^x/ && s/(\{([^\}]+)\})//) {
|
|
@w = split(' ');
|
|
@tmp = @w[0 .. $#w-1];
|
|
$xnm = $w[0] . $sublist; $subnm = $w[$#w];
|
|
$_ = $2; $i = 0;
|
|
while (/(\w+)\s*\=\s*([+-]?\d*(\.\d*)?([Ee][+-]?\d+)?)([a-z]\w*)?/) {
|
|
# 1 2 3 4 5
|
|
$prmval{$1} = $2*($5 ? &unit2mult($5) : 1);
|
|
$_ = $';
|
|
$i += 2;
|
|
}
|
|
$max = -1; $m = '';
|
|
CHKDUP: foreach $s (keys %sub) {
|
|
$s =~ /(\w+)\#(\d+)/;
|
|
if ($subnm eq $1) {
|
|
if ($max < $2) { $max = $2; }
|
|
$n = (@w = split(' ', $sub{$s}));
|
|
if ($n == $i) {
|
|
for ($i = 0; $i < $n; $i += 2) {
|
|
last if $w[$i+1] ne $prmval{$w[$i]};
|
|
}
|
|
if ($i >= $n) {
|
|
$m = 1;
|
|
$subcall{$xnm} = $s;
|
|
last CHKDUP;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if ($m eq '') {
|
|
foreach $n (keys %prmval) {
|
|
$m = join(' ', $m, $n, $prmval{$n});
|
|
}
|
|
$sub{($s = join('', $subnm, '#', $max+1))} = $m;
|
|
$subcall{$xnm} = $s;
|
|
}
|
|
push(@list, join(' ', @tmp, $subcall{$xnm})) if $depth;
|
|
undef %prmval;
|
|
last PRM_TST;
|
|
}
|
|
if (/^\.subckt\s+(\w+)/) {
|
|
$depth++; $tmp = $1;
|
|
$sublist .= '#' . $1;
|
|
if (s/(\{([^\}]+)\})//) {
|
|
if ($hasprm) {
|
|
print "Line $linenum: ",
|
|
"Nested parameterized subckt definitions not permitted\n\n";
|
|
}
|
|
else {
|
|
$hasprm = 1; $start = $.;
|
|
$subprm{$psubnm = $tmp} = $2;
|
|
}
|
|
}
|
|
push(@list, $_); # With {} parameter defs removed.
|
|
last PRM_TST;
|
|
}
|
|
if (/^\.ends/) {
|
|
$sublist =~ s/(\#\w+)$//;
|
|
if (--$depth == 0) {
|
|
if ($hasprm) {
|
|
$subckt{$psubnm} = join("\n",join(' ',$start,$.),@list,$_);
|
|
}
|
|
$hasprm = 0;
|
|
undef @list; $sublist = '';
|
|
last PRM_TST;
|
|
}
|
|
# MW. 'last PRM_TST' should be inside 'if' loop to allow nestle subckts.
|
|
}
|
|
if ($depth) {
|
|
push(@list, $_);
|
|
last PRM_TST;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Write the output file.
|
|
sub prm_wr {
|
|
local(@w, @pnms, @list, @line);
|
|
local($xnm, $subnm, $n, $m, $i, $s);
|
|
local($sublist) = '';
|
|
|
|
PRMWR_SCAN: while ($_ = &prm_getline) {
|
|
# write .control - .endc blocks
|
|
if (/^\.control/i) {
|
|
print OUTFILE "$_\n";
|
|
while ($_ = &prm_getline) {
|
|
prm_wrline($_);
|
|
next PRMWR_SCAN if (/^\.endc/i);
|
|
}
|
|
}
|
|
tr/A-Z/a-z/;
|
|
if (/^x/ && s/(\{([^\}]+)\})//) {
|
|
@w = split(' '); $subnm = pop(@w);
|
|
$xnm = $w[0] . $sublist;
|
|
prm_wrline(join(' ', @w, $subcall{$xnm}));
|
|
print OUTFILE "* $1\n";
|
|
if (!defined($subprm{$subnm})) {
|
|
print "Line $linenum: Subckt \"$subnm\" has no defined parameters\n\n";
|
|
next PRMWR_SCAN;
|
|
}
|
|
$n = @pnms = sort(split(' ', $subprm{$subnm}));
|
|
$m = (@w = split(' ', $sub{$subcall{$xnm}}));
|
|
if ($n == $m/2) {
|
|
for ($i = 0, undef(@list); $i < $m; $i += 2) {
|
|
push(@list, $w[$i]);
|
|
}
|
|
for ($i = 0, @w = sort(@list); $i < $n; ++$i) {
|
|
if ($pnms[$i] ne $w[$i]) {
|
|
print "Line $linenum: ",
|
|
"Undefined parameter \"$w[$i]\"",
|
|
"in subckt \"$subnm\" call\n\n";
|
|
next PRMWR_SCAN;
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
print "Line $linenum: ",
|
|
"Incorrect number of parameters in subckt \"$subnm\" call\n\n";
|
|
}
|
|
next PRMWR_SCAN;
|
|
}
|
|
if (/^\.subckt\s+(\w+)/) {
|
|
if ($s = $subckt{$1}) {
|
|
$s =~ /\d+\s+(\d+)/;
|
|
$n = $1;
|
|
&prm_getline until $. == $n;
|
|
}
|
|
else {
|
|
$depth++; $sublist .= '#' . $1;
|
|
prm_wrline($_);
|
|
}
|
|
next PRMWR_SCAN;
|
|
}
|
|
if (/^\.end\b/) {
|
|
foreach $s (keys %sub) {
|
|
($subnm = $s) =~ s/\#\d+//;
|
|
@line = split(/\n/, $subckt{$subnm});
|
|
shift(@line);
|
|
$line[0] =~ s/$subnm/$s/;
|
|
%prmval = split(' ', $sub{$s});
|
|
foreach (@line) {
|
|
s/\{([^\}]+)\}/&prm_eval($1, %prmval)/eg;
|
|
prm_wrline($_);
|
|
}
|
|
}
|
|
print OUTFILE ".end\n";
|
|
last PRMWR_SCAN;
|
|
}
|
|
if (/^\.ends/) {
|
|
if (--$depth == 0) { $sublist = ''; }
|
|
else { $sublist =~ s/(\#\w+)$//; }
|
|
}
|
|
prm_wrline($_);
|
|
}
|
|
}
|
|
|
|
# Translate a possible unit into a multiplier factor.
|
|
# Parameter is the unit letter string assumed lower case.
|
|
sub unit2mult {
|
|
local($u) = shift;
|
|
|
|
$u = ($u =~ /^(mil|meg)/ ? $1 : substr($u, 0, 1));
|
|
$u = defined($units{$u}) ? $units{$u} : 1;
|
|
}
|
|
|
|
# Evaluate a parameter expression.
|
|
# Arguments: expression, parameter & value assoc. array.
|
|
sub prm_eval {
|
|
local($x,%prm) = @_;
|
|
|
|
foreach $key (keys %prm) {
|
|
$x =~ s/\b$key\b/$prm{$key}/eg;
|
|
}
|
|
eval($x . ';');
|
|
}
|
|
|
|
# Write an output file line with a max length. The line is split on
|
|
# whitespace or '=' at a point less than or equal to the max length
|
|
# and output as a spice continuation line.
|
|
# If a splitting delimiter is not found within $MAXLEN, then allowable
|
|
# length is increased, potentially up to the actual line length.
|
|
# NOTE: outputs '\n'.
|
|
# $MAXLEN sets the max value, $DMAXLEN the increment.
|
|
# File handle = OUTFILE.
|
|
sub prm_wrline {
|
|
local($line) = shift;
|
|
local($max, $s, $m);
|
|
|
|
$max = $MAXLEN;
|
|
until ($line eq '') {
|
|
if (length($line) > $max) {
|
|
$m = substr($line, 0, $max);
|
|
if ($m =~ /((\s|\=)[^(\s|\=)]*)$/) {
|
|
$s = $` . $2;
|
|
$line = '+' . substr($line, length($s));
|
|
}
|
|
else { $max += $DMAXLEN; next; }
|
|
}
|
|
else { $s = $line; $line = ''; }
|
|
print OUTFILE "$s\n";
|
|
$max = $MAXLEN;
|
|
}
|
|
}
|