spiceprm

ngspice又一个电子CAD仿真软件代码.功能更全

#! /usr/bin/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;
    }
}