mirror of
https://github.com/ra3xdh/qucs_s
synced 2025-03-28 21:13:26 +00:00
4021 lines
162 KiB
Perl
Executable File
4021 lines
162 KiB
Perl
Executable File
#! /usr/bin/perl
|
||
#
|
||
# Copyright 2003/2004/2005/2006/2007 by Friedrich Schmidt <frie.schmidt@aon.at>
|
||
# Copyright 2000 by John Sheahan <john@reptechnic.com.au>
|
||
# Copyright 1996 by Andrew J. Borsa
|
||
#
|
||
# This is free software; you can redistribute it and/or modify
|
||
# it under the terms of the GNU General Public License as published by
|
||
# the Free Software Foundation; either version 2, or (at your option)
|
||
# any later version.
|
||
#
|
||
# This software 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 more details.
|
||
#
|
||
# You should have received a copy of the GNU General Public License
|
||
# along with this package; see the file COPYING. If not, write to
|
||
# the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
|
||
# Boston, MA 02110-1301, USA.
|
||
#
|
||
# derived from modified sources of :
|
||
# Spiceprm version 0.11, Copyright (C) 1996 Andrew J. Borsa";
|
||
# spicepp version 1.5 2000/11/20 22:37:56 john Exp john $ ';
|
||
#######################################################################
|
||
# ps2sp version 4.14 , Copyright(C) F.S. 2003/2004/2005/2006/2007
|
||
# License: Terms of GNU-License
|
||
# ( special thanks to the work of John and Andrew )
|
||
#######################################################################
|
||
# tested with Perl V 5.6.1 / Perl 5.8.8 / Tinyperl 2.0 with ps2sp.pl as perlscript and as binary file tinyperl -bin option
|
||
# Debugger: Perl Debugger Ptkdb V1.1.0.91 TK V 800.023
|
||
# last edited: 18.03.2007
|
||
|
||
# Changelog: since 1.1.2005
|
||
#
|
||
# 03.01.2005 -h command line option added ( for help usage: ...)
|
||
# 07.01.2005 Variables in .pfunc expressions now all with paranthesis e.g. __1 to (__1) -> now some problems with
|
||
# eval() are corrected;
|
||
# 08.01.2005 in func expand_parameters add lines to prevent .control till .endc to be expanded
|
||
# 14.01.2005 kill blanks in @(p)funcname, now search also for global .func in includefiles
|
||
# 17.01.2005 make the nested func algorithm more save ( check - differently - for : to much opened OR! to much
|
||
# closed paranethesis )
|
||
# 31.01.2005 more paranthesis for all functions to make it save
|
||
# 01.02.2005 line 1902 in b-lines ** to ^ ( compatibility to ltspice )
|
||
# 01.02.2005 change predefined .funcs f(u()) instead of f(sgn())
|
||
# 02.02.2005 small changes in step parameter function oct, dec to handle better end-values
|
||
# 29.07.2005 support for relational operators in pspice syntax for b-sources,
|
||
# (sub b_device_relational_op)
|
||
# <,>,<=,>=,==,!=,&&,||,! -> converted to lt,gt,le,ge,eq,ne,and,or and not
|
||
# binding of relop is strong ! -> 3+2<5 -> 3+(2<5)
|
||
# if you want it other you can give paranthesis to the expr. (3+2)<5
|
||
# 31.07.2005 support for local funclines in subckt's
|
||
# synchronization of .func to .pfunc to be compatible to pspice
|
||
# (all .func defined lines are also automatically written as .pfunc lines !!)
|
||
# 01.08.2005 support for relational operators in pspice syntax for .funclines
|
||
# (sub funcline_paramline_relational_op)
|
||
# hint: relop in .paramlines are managed by perl itself
|
||
# 02.08.2005 support for multiple parameterstepping
|
||
# 04.08.2005 support for a<b?c:d op
|
||
# 06.08.2005 support for .probe expressions e.g. .probe 3*v(2)+5 -> convert to spice3 plot 3*v(2)+5
|
||
# 20.12.2005 use Math::Trig included for trigonometric pfunc expressions
|
||
# line 489 added in load_deck() s/^\*\$//; # *$ should be interpreted as a nutmeg commandline -> remove
|
||
# *$ to enable it
|
||
# 24.12.2005 $param{"pi"}="3.1415"; $param{"e"}="2.718282";
|
||
# $param{"echarge"}="1.602190e-019";$param{"kelvin"}="-2.73150e+002";
|
||
# $param{"planck"}="6.626200e-034"; added
|
||
# 25.12.2005 if($anz!=$anz_pm[$i]) -> if($anz!=$panz_pm[$i]) in func eval_pfuncs();
|
||
# support for *$ as nutmeg-command line prefix -> if detected at linestart -> deleted to enable
|
||
# nutmeg cmd
|
||
# 26.12.2005 line 2635 changed from "foreach (@line)" to "foreach (@_=@line)"
|
||
# Some month ago I unfortunately deleted "@_=" from the expression above
|
||
# Without "@_" the .param .func and .pfunc statements in @line are deleted
|
||
# and therefore no local parameter or funclines for subcircuits worked any more !!!!
|
||
# SORRY !!!
|
||
# 27.12.2005 modify function libinclude() to allow inline comments with ";" in continuation liblines ( lines
|
||
# starting with + )
|
||
# "$" for comment lines disabled !! (compatibility to nutmeg variables)
|
||
# line 2260 changed to : if ($_[0] =~ /^([0-9e\+\-\.]+)(t|g|meg|k|mil|m|u|n|p|f)?(v|a|s|f|ohm|h|w)?$/) {
|
||
# 12.01.2006 to allow xf xh xohm xw as additional unit x = m,u,meg ....
|
||
# 15.05.2006 corrected a small bug in the code for relational operators ">,<,>=,..." in b-device-relational-op
|
||
# changed the value2b-device to allow "VALUE {}" statements in EFGH devices in additon to "VALUE = {}"
|
||
# 22.05.2006 r_device_tc=0,_0 added -> .model xxxxx R/RES (tc1=0 tc2=0 ) LINE 1448
|
||
# or alternatively r1 1 2 {R*(1+tc1*({temp}-tnom)+tc2*({temp}-tnom)*({temp}-tnom))}
|
||
# 22.05.2006 pspice S,W device_device_.model xxx (I)VSWITCH to compatible xspice/spice3 device
|
||
|
||
# 25.05.2006 EXP()->e^() in b-lines
|
||
# 22.05.2006 STP(x) -> u(x) predefined function / (x>0?1:0) predefined pfunctions LINE 301/397
|
||
|
||
# 22.05.2006 eat blancs in .model-lines (XX = YY -> XX=YY) after parameterextraction
|
||
# 22.05.2006 TEMP in b-lines ($param{"temp"}="25"; ) LINE 204 .TEMP=Val OK ?
|
||
# 22.05.2006 15V -> 15 in b-lines LINE1423
|
||
|
||
# 22.05.2006 small bug in expand_paralell -> corrected
|
||
# 01.06.2006 support for .tran TEND
|
||
# 01.06.2006 support for polynomial efgh-devices ( pspice and spice2 like )
|
||
|
||
# 02.06.2006 support for I/SDT() and DDT() pspice function ( integrate and differentiate ) in b-lines
|
||
|
||
# 03.06.2006 support for polynomial c and l bdevice
|
||
#
|
||
# 03.06.2006 { operator NOT as ~(x) and XOR as (x)^(y) } -> b_device relational ( works only with command line switch -xornot )
|
||
#
|
||
# 04.06-2006 better handling of commandlineswitches
|
||
# 09.06.2006 UNuse of math.trig again -> pi( ok) see 20.12.2005
|
||
# 10.06.2006 support for .dc PARAM name [OCT,DEC,LIST](LIN) 0 10 1 PARAM name [OCT,DEC,LIST](LIN) 0 1 0.1
|
||
# (if no option is given defaults to LIN)
|
||
# 17.06.2006 support for C 1 0 q=val and L 1 0 flux=val expressions
|
||
# 21.06.2006 test under Linux -> done
|
||
# 23 06.2006 add paranthesis checker with command line switch
|
||
# -check for b-lines and expressions
|
||
# 29.06.2006 user choosable subckt-postfix default = '_' ( global var = $spf )
|
||
# e^() -> EXP() in b-lines to be pspice/ltspice compatible ( ^ -> **)
|
||
# 30.06.2006 testsuite to avoid new errors
|
||
# 14.08.2006 added ln(x) and log10(x) to pfunctions
|
||
# 16.08.2006 debugmodus added : sub output_debug
|
||
# commandlineswitch -debug to output
|
||
# parameter , function and pfunction definitions to the cirfile
|
||
# 22.08.2006 added new function pwl_file and add_pwl_line to convert
|
||
# asciifiles to spice-pwllines
|
||
# syntax: v1 1 0 pwl file='c:\usbsich\out2' var='v(2)'
|
||
# fileformat: like generated by nutmeg with print col v(2) > out2
|
||
# or print col v(1) v(2) .... > out2
|
||
# 23.08.2006 changes in some functions -> expand_parameters , process , skipnumber , expand_eqns
|
||
# value2bdevice , prm_wr
|
||
# 24.08.2006 added support for resistor expressions
|
||
# syntax: e.g. r1 1 0 value={expr}
|
||
# 03.09.2006 changed function neq(x) to ne(x) according to nutmeg syntax
|
||
# some small bugfixes for special cases in skipnumber , value_2_bdevice , table2bh , table2bh_spice3 , poly_2_bdevic main_ctrl
|
||
# redesign of functions process,expand_parameter and expand_eqn -> now faster and more readable
|
||
# 05.09.2006 corrected default values for VSWITCH/ISWITCH device if not given on .model line
|
||
# 07.09.2006 new predefined functions buf,inv for compatibility to ltspice
|
||
# also new pfunctions u,buf,inv,uramp
|
||
# corrected a bug synchronizing func and pfunc lines which only worked if count
|
||
# of func and pfunc lines was equal -> now works like expected
|
||
# changed some predefined function definition to be compatible to winspice, ltspice and nutmeg
|
||
# 08.09.2006 more errorchecking : sub process() -> if expression evaluation fails -> warning and exit
|
||
# but perl unfortunately is very error tolerant
|
||
# 12.09.2006 user manual for the gui ( preprocessor_gui.pl )
|
||
# 17.09.2006 corrected a bug in table2bh code ( no space between first and second and last and before last value )
|
||
# 01.10.2006 now .lib also includes devicemodels ( not only subcircuits like before ) and blanks in filenames work now
|
||
# .inc or .include also work with blanks in the filename
|
||
# 02.10.2006 tool to generate .nodeset lines from transient,dc or op ascii-ouputfile
|
||
# .savebias (-op|-tran) (-timepoint=val) infile outfile
|
||
# .loadbias infile (like include)
|
||
# 26.10.2006 changes in prm_scan , prm_wr to allow parametrized x-line calling in subcircuits for more than one level
|
||
# changes in prm_scan , prm_wr to allow
|
||
# all subcktparamters , local parameters,function,pfunctions now have the suffix _xname
|
||
# xname is the name of the subcircuit where the variables are defined !!!
|
||
# 31.10.2006 correct a big BUG in the parameter evaluation subroutine "process" s/\b$key\b/$val/g -> s/\b$key\b/\($val\)/g
|
||
# now all expressions are substituted with implicit paranthesis around
|
||
# 05.11.2006 NEW ps2sp.pl V4.0 : now the subcircuit parameter code is completely rewritten to allow parametrized
|
||
# subcircuits of any level (new file )
|
||
# add support for functions as subcircuit parameters :params a={2*fu(p1,p2*3)}
|
||
# change of join,split(',') to join,split(';') since ',' is a parameter delimiter in functions f(,,)
|
||
# 07.11.2006 add debug information for all unique parameterized subcircuits to the intermediate file "sub.tmp"
|
||
# to check the parameter substitution and unique subcircuit generation
|
||
# 11.11.2006 adapt .lib code to handle nested parametrized subcircuits
|
||
# correct a bug in .inc code to handle correctly nested inc's
|
||
# 16.11.2006 some enhancements in the nested function and parameterexpansioncode and the libexpansioncode
|
||
# extensive testing with various pspice source files with .lib and nested subcircuits
|
||
# copyright message , date , time , filename and used options added to second line of converted cirfile
|
||
# bugfix in function table2bh_spice3 , new commandlineoptions : -tosub -tolib -fromsub -fromlib
|
||
# 19.11.2006 enhance pspice compatibility ( delete surplus + for continuation lines in value2bdevice ),
|
||
# rewrite of .global node expansion code -> virtual node 'times' always global ,
|
||
# enhance paranthesis checker ( called now 3 times )
|
||
# small changes in V/ISWITCH model ($lm=log(($ron*$roff)**0.5);) ,
|
||
# changes in function &process
|
||
# 21.11.2006 some cosmetic ( rearranging of functions )
|
||
#
|
||
# 24.02.2007 handle a bug (about line 2889) in xline params code if cidx=-1 (called from main):
|
||
# e.g. xline ... params: m={m} should not give variable recursion error message and quit the program
|
||
# and also rhs version of 'm' should not be changed to 'm_nbr'
|
||
# because rhs 'm' is a global parameter !
|
||
# therefore the correspondent codelines are added to the if(cidx>=0) {..} part
|
||
# 15.03.2007 new function atan2(y,x) added (4 quadrant phase output -pi...pi )
|
||
# this function is present in perl (.funcline) but not in standard spice3 (b-line)
|
||
|
||
# ?? ?? ???? conversion of .step param SPICEPARAM .. to equivalent nutmeg script ( parameter-analysis loop )
|
||
# SPICEPARAM maybe: @devicename[param]=val or @@modelname[param]=val @@@global=val
|
||
|
||
# still to do :
|
||
|
||
# ??.??.2006 usermanual
|
||
# ??.?.2006 software-documentation
|
||
# ??.?.2006 better outputformat handling with more switches
|
||
# ( -winspice -superspice -vspice -spoV203 -spoV222 -ltspice -sp3 -ngspice
|
||
# which contains each a certain amount of their own subswitches )
|
||
#
|
||
#######################################################################################################################################
|
||
# HINT: if you suspect the preprocessor to give erroneous results -> check the intermediate preprocess files
|
||
# "sub.tmp" and "lib.tmp"
|
||
# HINT: if the converter never returns check the equivalence of opened and closed paranthesis in expressions ( -check command line option )
|
||
# HINT: to check if the parameterevaluation and the function expansion is correct use command line switch -debug
|
||
#######################################################################################################################################
|
||
# usage: ps2sp (options) inputfile.cir > outputfile (with the compiled version -> tinyperl -bin )
|
||
# or perl ps2sp.pl (options) inputfile.cir > outputfile (with perl installed)
|
||
# or tinyperl ps2sp (options) inputfile.cir > outputfile (with tinyperl installed)
|
||
#
|
||
# options:
|
||
# -h displays the help screen
|
||
# -sp3 switch means conversion of pspice table to spice 3 b-source instead of xspice core model ( default ) #
|
||
# -ltspice switch means conversion of ^ spice 3 power to ** ltspice power and addition of tripdv=1 tripdt=1 in b-lines #
|
||
# -notinylines produces longer b-lines for some functions ( default is tinylines = shorter b-lines )
|
||
# -check determine the same count of open and closed paranthesis in b-lines ( default is nocheck )
|
||
# -xornot allows ^ and ~ operators in the netfile (don't mix with ^ as power operator)
|
||
# use the ** operator as power instead
|
||
# -debug for debugging all .param .func and .pfunc defintions ( default is nodebug )
|
||
# -tosub only output subckt expansions
|
||
# -tolib only output lib expansions
|
||
# -fromsub inputfile is a sub.tmp file
|
||
# -fromlib inputfile is a lib.tmp file
|
||
#######################################################################################################################################
|
||
|
||
$MAXLEN = 100; # Max output line length for output.
|
||
$DMAXLEN = 10; # Amount to increment of $MAXLEN if necessary.
|
||
$wrap=100; # if more than 150 chars -> wrap lines
|
||
|
||
|
||
# ps2sp.pl command line switches
|
||
$tinylines=1; # cmdlineswitch notinylines to disable tinylineexpansion
|
||
$spice3=0; # default pspice table model to xspice core model conversion
|
||
$ltspice=0; # default
|
||
$xornot=0; # default ( command line switch -xornot -> enables ~ and ^ expressions )
|
||
$check=0; # default ( paranthesis checker enabled with -check command line switch )
|
||
$debug=0; # output all parameters and functions
|
||
$fromsub=0; # continue from sub.tmp
|
||
$fromlib=0; # continue from lib.tmp
|
||
$tosub=0; # stops after generation of lib.tmp and sub.tmp
|
||
$tolib=0; # stops after generation of lib.tmp
|
||
# command line switches
|
||
|
||
$tnom=27; # spice nominal temperature
|
||
|
||
# parameterpostifx for unique parameternames ( var1 -> var1_1 .. _2 _3 _4 .... )
|
||
$parampostfix='_';
|
||
# subnamepostfix for unique subnames ( subname -> subname_1 .. _2 _3 _4 ..... )
|
||
$spf='_';
|
||
# note: ( postfix should not be a perl wordlimiter in order to perl regex \b - option works fine
|
||
|
||
# variables for .probe lines and .step parameterstepping lines
|
||
@vec=(); # stores all traces to plot (.probe lines)
|
||
$step=0; # default no parameterstepping found
|
||
@steparray=(); # all stepped values
|
||
@stepparams=(); # name of the stepparam
|
||
@stepparamcnt=(); # cnt of param values of each stepparam
|
||
$probelines=0; # how much .probe lines detected
|
||
@probe=(); # where to store probelines
|
||
@analtype=("op","dc","ac","tran"); # which analtype is used in the .step line
|
||
$anal=0; # default is op
|
||
|
||
@control=(); # where to store controllines
|
||
|
||
@deck=(); # where to hold all lines of the actual inputfile
|
||
|
||
$infile; # the actual inputfile ( xxx.cir or lib.tmp or sub.tmp )
|
||
$inputcirfile; # the name of the original cirfile from the commandline
|
||
|
||
# spice units
|
||
%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');
|
||
$MULTILINE_MATCHING = 1; # perl parameter Pattern match with multi-line strings. ---------- deprecated
|
||
|
||
# global vars for user defined pspice functions , pfunctions , parameters
|
||
%param=(); # global Parameter hash for .param and params: lines
|
||
$fidx=(); # index of user defined .func lines @funcname, @anz_pm , @expr
|
||
$pfix=(); # index of user defined .pfunc lines @pfuncname, @panz_pm , @pexpr
|
||
@funcname=(); # names of user defined function names
|
||
@pfuncname=(); # names of user defined pfunction names
|
||
@anz_pm=(); # parametercount of user defined functions
|
||
@panz_pm=(); # parametercount of user defined pfunctions
|
||
@expr=(); # rhs of function = expression
|
||
@pexpr=(); # rhs of pfunction = expression
|
||
%globals=(); # hash for .global lines ( global nodes )
|
||
|
||
################################### M A I N #############################################
|
||
#########################################################################################
|
||
|
||
&initialize_predefined_parameter_functions; # initialize global parameters , functions
|
||
&getargs(); # get switches from the ps2sp.pl command line
|
||
&first_stage; # subcircuit expansion , savebias , loadbias , .lib , .inc
|
||
|
||
open (INFILE,$infile) || die "Can't open source file sub.tmp : $infile\n";
|
||
$_=<INFILE>;chop;@deck="" . $_; # heading/comment line passthrough
|
||
|
||
&second_stage; # controllines , .step line , global nodes , expand variable TIME , manage pwl_file
|
||
# normally one loop , more loops if .step present
|
||
# convert all other lines , expand parameters , expand functions
|
||
&main_ctrl;
|
||
close(INFILE);
|
||
|
||
################################### M A I N #############################################
|
||
#########################################################################################
|
||
|
||
#
|
||
sub first_stage {
|
||
|
||
local(%sub,%subcall_all,%subcall_sub,%subcall_root,%subcall,%sub_prm,%subckt);
|
||
local(%sub_lprm,%sub_lfunc,%sub_lpfunc);
|
||
local($ref_prmval,$ref_pprmval,$ref_funcprmval,$ref_pfuncprmval);
|
||
local($max,$linenum);
|
||
|
||
# %sub; # all x-lines with parameters from the original deck and their parameters (%subcall and %subcall_root)
|
||
# %subcall_all; # all unique subckts with parameters to be generated (generated from %subcall and %subcall_root)
|
||
# %subcall_sub; # x-lines called from inside subckts
|
||
# %subcall_root; # x-lines called from the root level
|
||
# %subcall; # %subcall_sub + %subcall_root
|
||
# %sub_prm; # all .subckt parameters from the original deck
|
||
# %subckt; # all .subckt lines (only if parametrized) from the original deck
|
||
|
||
# %sub_lprm; # all local .param statementes from all entries in %subckt
|
||
# %sub_lfunc; # all local .func statementes from all entries in %subckt
|
||
# %sub_lpfunc; # all local .pfunc statementes from all entries in %subckt
|
||
|
||
# $ref_prmval; # reference to .subckt parameter from a specific entry in %subckt
|
||
# $ref_pprmval; # reference to local .param statements from a specific entry in %subckt
|
||
# $ref_funcprmval; # reference to local .func statements from a specific entry in %subckt
|
||
# $ref_pfuncprmval; # reference to local .pfunc statements from a specific entry in %subckt
|
||
|
||
# local $max; # global unique identifier counter for all x-lines with parameters in the circuit
|
||
# local $linenum;
|
||
|
||
if(!$fromsub) {
|
||
if(!$fromlib) {
|
||
$inputcirfile=$infile=$ARGV[0]; # infile = $ARGV[0] outfile = lib.tmp
|
||
open(INFILE, $infile) || die "Can't open input source file: $infile\n";
|
||
$_=<INFILE>;chop;@deck="" . $_; # heading/comment line passthrough
|
||
&read_deck;
|
||
$deck[0]=~s/(^[^\*].*)/\*$1/; # first line should be with *
|
||
if($ltspice) {&do_ltspice;}
|
||
############
|
||
&savebias; # new for saving op or transient data to .nodeset file
|
||
&loadbias; # new for loading .nodeset files to the deck
|
||
##############
|
||
&expand_incs;#
|
||
&expand_libs;#
|
||
##############
|
||
$dateiname="lib.tmp";
|
||
&fprintdeck; # prints to lib.tmp
|
||
close(INFILE);
|
||
if($tolib) {exit;}
|
||
# local .param = , default .subckt params , xline params
|
||
$infile="lib.tmp";
|
||
}
|
||
else {
|
||
$infile=$inputcirfile=$ARGV[0];
|
||
}
|
||
$outfile="sub.tmp";
|
||
open(INFILE, $infile) || die "Can't open lib.tmp source file: $infile\n";
|
||
############ handles of subckt's parameters and subckt modelfiles
|
||
&prm_scan; #
|
||
############
|
||
close(INFILE);
|
||
open(INFILE, $infile) || die "Can't open lib.tmp source file: $infile\n";
|
||
#unlink $outfile if $#ARGV;
|
||
open(OUTFILE,"+>$outfile") || die "Can't open sub.tmp output file: $outfile\n";
|
||
##########
|
||
&prm_wr; #
|
||
##########
|
||
close(INFILE);
|
||
close(OUTFILE);
|
||
if($tosub) {exit;}
|
||
$infile = "sub.tmp"; # outfile = STDOUT
|
||
}
|
||
else { # from_sub
|
||
$inputcirfile=$infile=$ARGV[0];
|
||
}
|
||
}
|
||
sub second_stage {
|
||
my($options,$infoline,$date,$copyright);
|
||
|
||
&read_deck; # whole deck read in @deck variable
|
||
$date=localtime;
|
||
$infoline="* infile=$inputcirfile date=$date Converted with ps2sp V4.14 ";
|
||
$options="* options: -sp3=$spice3 -ltspice=$ltspice -fromsub=$fromsub -fromlib=$fromlib -check=$check (tinylines=$tinylines)";
|
||
$copyright="* copyright 2007 by Friedrich Schmidt - terms of Gnu Licence ";
|
||
splice(@deck,1,0,$infoline,$options,$copyright);
|
||
&read_stepparams; # if .step detected -> $step=1 .step param paramname (lin,oct,dec,list) ......
|
||
&read_controllines; # read all controllines into @control;
|
||
if($check) {✓}
|
||
# new what can be done only once also for multiruns
|
||
&pwl_file; # new command for pwl source line loaded from a file
|
||
&time2vtime; # if .tran analysis -> add a pwl source with a node v(times) -> (compatibility with pspice TIME )
|
||
&read_globals; # read in global node lines .global in %globals
|
||
&expand_globals; # add global nodes in every (because of nested subckts) .subckt and x-line
|
||
}
|
||
sub main_ctrl { # is there one run or are there multiple runs - this main routine calls all other routines
|
||
my ($done,@copydeck,$i);
|
||
local (@aktstepparam,$runs);
|
||
#$memidx=0; # for synchronization of func lines with pfunc
|
||
#$memidx2=0;
|
||
if($step >= 1) { # parameterstep found -> one .step xxx line is present in deck
|
||
$runs=0;
|
||
$step--; # now as idx for arrays
|
||
@copydeck = @deck; # save it for reinit
|
||
$done=0;
|
||
#@aktidx=(0,0,-1);
|
||
for($i=$step;$i>=0;$i--) {$aktidx[$i]=0;} # set zero
|
||
$aktidx[($step)]=-1; # lsb
|
||
while(!$done) {
|
||
# compute aktidx[$i]
|
||
$aktidx[($step)]++; # now (0,0,0)
|
||
for($i=$step;$i>=0;$i--) {
|
||
if($aktidx[$i]>=$stepparamcnt[$i]) {
|
||
if($i>0) {
|
||
$aktidx[$i]=0; # reset and
|
||
$aktidx[$i-1]++; # carry
|
||
}
|
||
if($aktidx[0]==$stepparamcnt[0]) {$done=1;goto leave;} # overflow
|
||
}
|
||
}
|
||
# compute aktstepparam[$i]
|
||
for($i=$step;$i>=0;$i--) {
|
||
$aktstepparam[$i]=$stepmat[$i][$aktidx[$i]]; # actual stepparam values
|
||
}
|
||
@deck = @copydeck;
|
||
$runs++; # number of run
|
||
#################################
|
||
&manage_all_devicelines($step);
|
||
#################################
|
||
$dateiname = &pp_("x".$runs,$inputcirfile);
|
||
&fprintdeck; # save
|
||
}
|
||
leave:
|
||
# now output of the main controlling file to stdout
|
||
# this file with its .control .. .endc statements starts all genearted cirfiles
|
||
&output_controlfile_stdout;
|
||
} # ende if step
|
||
else { # only one RUN ( normal case ) nothing to plot or ltspice mode
|
||
###########################
|
||
&manage_all_devicelines(-1);
|
||
###########################
|
||
&printdeck;
|
||
}
|
||
}
|
||
sub output_controlfile_stdout {
|
||
my($n,$i,$k,$tmp,$tp,$cnt,@temp,$trace,$w,$scalevec,$steps,@plotlines,@crosslines);
|
||
|
||
print "* this ist the main control file for parameterstepped circuits";
|
||
print "\n.control";
|
||
print "\ndestroy all";
|
||
for ($n=1;$n<=$runs;$n++) {
|
||
# source in each file with a unique stepparam
|
||
$tmp=&pp_("x".$n,$inputcirfile);
|
||
$tmp="es($tmp);
|
||
print "\nsource $tmp";
|
||
}
|
||
print "\n.endc\n";
|
||
# plot vectors analysis for all runs
|
||
# only plot for .tran analysis !!
|
||
# .probe v(1) v(2) -> plot tran1.v(1) tran2.v(1) tran3.v(1) tran1.v(2) tran2.v(2) tran3.v(2)
|
||
if($anal>0) { # tran and ac-dc
|
||
$tp=$analtype[$anal];
|
||
print "\n.control";
|
||
for ($i=0;$i<$probelines;$i++) { # for all probelines
|
||
$cnt=@temp=split(/\s+/,$vec[$i]); # for all traces in actual probeline
|
||
$plotlines[$i]="plot ";
|
||
foreach $trace (@temp) {
|
||
for($k=1;$k<=$runs;$k++) {
|
||
$plotlines[$i]=$plotlines[$i].$tp.$k.".".$trace." ";
|
||
}
|
||
}
|
||
print "\n$plotlines[$i]";
|
||
}
|
||
print "\n.endc";
|
||
}
|
||
else { # ($anal==0) # = op parameterstepping
|
||
# first collect all crosslines for the .control ... .endc statements
|
||
$w=-1;@crosslines=();
|
||
for ($i=0;$i<$probelines;$i++) { # for all probelines
|
||
$cnt = @temp = split(/\s+/,$vec[$i]); # for all traces in actual probline
|
||
for ($j=0;$j<$cnt;$j++) {
|
||
$w++; # tracecounter -> one crossline per trace
|
||
$crosslines[$w]="cross ".$temp[$j]." 0 ";
|
||
for ($k=1;$k<=$runs;$k++) { # for all runs
|
||
$crosslines[$w]=$crosslines[$w]."op".$k.".".$temp[$j]." ";
|
||
}
|
||
}
|
||
}
|
||
# now prepare all plotlines for the .control .endc statements
|
||
@plotlines=();
|
||
for ($i=0;$i<$probelines;$i++) { # for all probelines
|
||
$plotlines[$i]="plot ";
|
||
$cnt = @temp = split(/\s+/,$vec[$i]); # for all traces in actual probline
|
||
foreach $trace (@temp) {
|
||
$plotlines[$i]=$plotlines[$i].$trace." ";
|
||
}
|
||
}
|
||
# now prepare new scalevector = parametervector
|
||
$scalevec="cross step 0 ";
|
||
foreach $steps (@steparray) {
|
||
$scalevec=$scalevec.$steps." ";
|
||
}
|
||
# now put all together
|
||
print "\n.control";
|
||
print "\nsetplot const";
|
||
for ($i=0;$i<=$w;$i++) { # for all traces
|
||
print "\n$crosslines[$i]";
|
||
}
|
||
print "\n$scalevec";
|
||
print "\nsetscale step";
|
||
for ($i=0;$i<$probelines;$i++) { # for all traces
|
||
print "\n$plotlines[$i]";
|
||
}
|
||
print "\n.endc\n";
|
||
}
|
||
print "\n.end\n";
|
||
}
|
||
sub read_deck {
|
||
my ($lnr);
|
||
|
||
while (<INFILE>) {
|
||
chomp; # chomp is better than chop -> last line .end -> .en error
|
||
# dont lowercase stuff in quotes
|
||
$lnr = $.; # act. linenumber
|
||
if( not $lnr eq 1 ) { # let the first line unchanged
|
||
if (/(.*)([\'\"])(.*)([\"\'])(.*)/) {
|
||
$_=lc($1) . $2 . $3 . $4 . lc($5);
|
||
}
|
||
else { $_ = lc($_); }
|
||
s/^\*\$//; # *$ should be interpreted as a nutmeg commandline -> remove *$ to enable it
|
||
s/\;.*//; # no inline comments with ;
|
||
s/^\*.*//; # no comments starting with *
|
||
s/\s\s+/ /g; # shrink multiple whitespaces
|
||
s/^\s*//; # trim leading whitespaces and delete blanc lines
|
||
if (/^\s*\+(.+)/) {$_ = pop (@deck) . " " . $1;} # continuation line
|
||
}
|
||
push @deck,$_ if (length($_) >0);
|
||
}
|
||
}
|
||
sub manage_all_devicelines {
|
||
my($mystep)=$_[0]; # the actual step 0,1,2 (-1 if no .step command present)
|
||
my $i;
|
||
local ($memidx,$memidx2);
|
||
|
||
$memidx=0; # for synchronization of func lines with pfunc
|
||
$memidx2=0;
|
||
|
||
if(!$ltspice) {&poly_2_bdevice;}
|
||
&value2bdevice;
|
||
&r_expressions;
|
||
&cl_expressions;
|
||
&b_device_sdt_idt;
|
||
&b_device_relational_op;
|
||
&funcline_paramline_relational_op;
|
||
&fix_temp; # .temp=25 instead of .options temp=25
|
||
if($spice3) { &model_r_spice3; }
|
||
elsif(not $ltspice) {&model_r;}
|
||
if(not $ltspice) {&model_switch;}
|
||
if($spice3) {&table2bh_spice3;} # if pspice like efgh TABLE source is present convert it to spice b-source models
|
||
else {&table2bh;} # not spice3 - if pspice like efgh TABLE source is present convert it to xspice core model
|
||
&read_funcs;
|
||
&read_pfuncs;
|
||
if($check) {✓}
|
||
&eval_funcs;
|
||
&eval_pfuncs;
|
||
&expand_funclines;
|
||
&expand_pfunclines;
|
||
&read_probelines;
|
||
&read_parameters;
|
||
for($i=$mystep;$i>=0;$i--) {
|
||
$param{$stepparams[$i]}=$aktstepparam[$i]; # update parameterlist with actual .step param value
|
||
}
|
||
if($check) {✓}
|
||
&eval_parameters;
|
||
if($debug) {&output_debug;}
|
||
&expand_parameters;
|
||
&expand_parallel;
|
||
if(not $ltspice) {&expand_control;}
|
||
}
|
||
sub read_stepparams {
|
||
my ($n,$cnt,$stepstart,$stepstop,$stepsize,$val,$rest);
|
||
local ($i); # parameter i also available for the subroutines dec,lin,log,list,oct
|
||
|
||
$step=0;
|
||
for ($i=0;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
if(m/^\.op\b/i || m/^op\b/i) {$anal=0;} # .op or op and not .op(tions)
|
||
elsif(m/^\.ac\b/i || m/^ac\b/i) {$anal=2;} # .ac or ac
|
||
elsif(m/^\.tran\b/i || m/^tran\b/i) {$anal=3;} # .tran or tran
|
||
# .step param paramname [oct|lin|dec|list] values
|
||
elsif(m/^\.step/i) {
|
||
$step++;
|
||
@steparray=();
|
||
if (m/oct/i) {($stepparam,$cnt)=&step_oct;}
|
||
elsif (m/dec/i) {($stepparam,$cnt)=&step_dec;}
|
||
elsif (m/list/i) {($stepparam,$cnt)=&step_list;}
|
||
else {($stepparam,$cnt)=&step_lin;} # must be lin !
|
||
splice(@deck,$i,1,"* Parameterstepping variable=$stepparam detected");
|
||
eval('@temp'."$step".'=@steparray;');
|
||
eval('$stepmat[($step-1)]=\@temp'."$step;");
|
||
push(@stepparams,$stepparam);
|
||
push(@stepparamcnt,$cnt);
|
||
}
|
||
# .dc { param paramname [oct,lin,dec,list] values } {param paramname [oct,lin,dec,list] values } ........
|
||
# translated to on .op line and multiple .step lines
|
||
# .op
|
||
# .step { param paramname [oct,lin,dec,list] values }
|
||
# .step { param paramname [oct,lin,dec,list] values }
|
||
# ........................
|
||
elsif(m/^\.dc/i && m/param/i) { # parameterstepping as .dc command
|
||
$anal=0; # from { param paramname [oct,lin,dec,list] values } { param paramname [oct,lin,dec,list] values }
|
||
s/param/#/g; # to { # paramname [oct,lin,dec,list] values } { # paramname [oct,lin,dec,list] values }
|
||
while(s/\#([^\#]+)//) { # cut one statement from # to # and substitute it with one .step line
|
||
splice(@deck,$i+1,0,".step param $1"); #
|
||
}
|
||
splice(@deck,$i,1,".op"); # substitute the original .dc .. param ... line with .op line
|
||
}
|
||
elsif(m/^\.dc/i || m/^\bdc\b/i) {$anal=1;} # .dc or dc -> have to be after .dc + param
|
||
else {}
|
||
}
|
||
}
|
||
# param paramname oct start stop size
|
||
sub step_oct {
|
||
my($n,$m,$stepparam,$stepstart,$stepstop,$stepsize);
|
||
|
||
if($deck[$i]=~s/param\s+(\S+)\s+\boct\b\s+(\S+)\s+(\S+)\s+(\S+)//i) {
|
||
$stepparam = $1; # global defined
|
||
$stepstart = &unit($2);
|
||
$stepstop = &unit($3);
|
||
$stepsize = &unit($4);
|
||
}
|
||
if($stepstart<=0) {$stepstart=1e-9;}
|
||
$n=$stepstart;
|
||
$m=0;
|
||
while($n<$stepstop) {
|
||
if($n eq $stepstop) {last;}
|
||
$steparray[$m]=$n;
|
||
$n=$stepstart*(2**(1/$stepsize))**($m+1);
|
||
$m++;
|
||
}
|
||
$steparray[$m]=$stepstop; # last element
|
||
return ($stepparam,$m+1);
|
||
}
|
||
# param paramname oct start stop size
|
||
sub step_dec {
|
||
my($n,$m,$stepparam,$stepstart,$stepstop,$stepsize);
|
||
|
||
if($deck[$i]=~s/param\s+(\S+)\s+\bdec\b\s+(\S+)\s+(\S+)\s+(\S+)//i) {
|
||
$stepparam = $1;
|
||
$stepstart = &unit($2);
|
||
$stepstop = &unit($3);
|
||
$stepsize = &unit($4);
|
||
}
|
||
if($stepstart<=0) {$stepstart=1e-9;}
|
||
$n=$stepstart;
|
||
$m=0;
|
||
while($n<$stepstop) {
|
||
if($n eq $stepstop) {last;}
|
||
$steparray[$m]=$n;
|
||
$n=$stepstart*(10**(1/$stepsize))**($m+1);
|
||
$m++;
|
||
}
|
||
$steparray[$m]=$stepstop; # last element
|
||
return ($stepparam,$m+1);
|
||
}
|
||
# param paramname [lin] start stop size
|
||
sub step_lin {
|
||
my($n,$m,$stepparam,$stepstart,$stepstop,$stepsize);
|
||
|
||
$deck[$i]=~s/lin//;
|
||
if($deck[$i]=~s/param\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)//i) {
|
||
$stepparam = &unit($1);
|
||
$stepstart = &unit($2);
|
||
$stepstop = &unit($3);
|
||
$stepsize = &unit($4);
|
||
}
|
||
$m=0;
|
||
for($n=$stepstart;$n<$stepstop;$n+=$stepsize) {
|
||
if($n eq $stepstop) {last;}
|
||
$steparray[$m]=$n;
|
||
$m++;
|
||
}
|
||
$steparray[$m]=$stepstop; # last element
|
||
return ($stepparam,$m+1);
|
||
}
|
||
# param paramname list 1 2 3 4 5 .....
|
||
sub step_list {
|
||
my($n,$m,$val,$stepparam);
|
||
|
||
$deck[$i]=~s/param\s+(\S+)\s+\blist\b\s+(.*)//i;
|
||
$stepparam=$1;
|
||
@steparray=split(/ /,$2);
|
||
$m=0;
|
||
foreach $val (@steparray) {
|
||
$steparray[$m]=&unit($val); ##############################
|
||
$m++;
|
||
}
|
||
return ($stepparam,$m);
|
||
}
|
||
sub read_controllines {
|
||
my($contrl,$i,@kill);
|
||
|
||
$contrl=0;
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
if (m/^\.control/i) {push @kill,$i;$contrl=1;next;}
|
||
if (m/^\.endc/i ) {push @kill,$i;$contrl=0;next;}
|
||
if ($contrl) {
|
||
push @control,$_; # save controllines
|
||
push @kill,$i;
|
||
}
|
||
}
|
||
&zapdeck(@kill);
|
||
}
|
||
sub read_probelines {
|
||
my ($i,$n);
|
||
my ($temp,$found,$tmp,@kill);
|
||
$n=-1;
|
||
$found=0;
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
if ( m/^\.probe\s+(.*)/i ) {
|
||
$n++;
|
||
$vec[$n]="";
|
||
$probelines=$n+1;
|
||
$found=1;
|
||
$temp = $1 ; # rest as String
|
||
$vec[$n] = $temp;
|
||
push @kill,$i; # prep. lines for deletion
|
||
}
|
||
}
|
||
&zapdeck(@kill); # now delete lines
|
||
if ($found==1 && !$step) { # if no parameterstepping = single run we can yet deal with plotlines
|
||
push(@probe,".control");
|
||
for($i=0;$i<$probelines;$i++) {
|
||
$_=$vec[$i];
|
||
if(m/\S+/) {push(@probe,"plot ".$vec[$i]);}
|
||
else {push(@probe,"plot v(0)"); } # if only .probe
|
||
}
|
||
push(@probe,".endc");
|
||
}
|
||
}
|
||
sub read_funcs {
|
||
my($i,$m,$n,$found,$pm,$nr_pm,$parm,$ex);
|
||
my(@pmvec);
|
||
my(@kill);
|
||
#============================================================================#
|
||
#search, collect funcname, parametercount, subs parameter with x1,x2 in expr.#
|
||
#============================================================================#
|
||
$found=0;
|
||
$memidx=$m=$fidx-1; # startidx of user defined .func lines
|
||
$n=$pfidx-1; # startidx of user defined .pfunc lines
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
if ( m/^\.func/i ) { # .func
|
||
$found=1;
|
||
$m++;$n++; # synchronize .func with .pfunc
|
||
m/\s+([^\(]+)\(([^\)]+)\)\s+(.*)/i; # fname, parameter , expr
|
||
# how many params in $2 ? neg(x)=((x)*(x)) -> $1=neg $2=x $3=((x)*(x))
|
||
$funcname[$m]=$1;
|
||
$parm=$2;
|
||
$ex=$3;$ex=~s/\s//g; # delete blanks NEW 31.07.05
|
||
$funcname[$m]=~s/\s//g; # delete blanks NEW NEW NEW 31.07.05
|
||
$pfuncname[$n]=$funcname[$m]; # NEW NEW NEW NEW 31.07.05 synchronize pfunc with func
|
||
$parm=~s/\s//g; # delete blanks
|
||
@pmvec=split(/,/,$parm); # x
|
||
$anz_pm[$m]=@pmvec; # 1
|
||
$panz_pm[$n]=$anz_pm[$m]; # NEW NEW NEW NEW 25.12.05 synchronize pfunc with func
|
||
$_=$ex; #expr ((x)*(x))
|
||
$nr_pm=0;
|
||
foreach $pm (@pmvec) { # subs with xx1 , xx2 ...
|
||
$nr_pm++;
|
||
s/\b$pm\b/"__".$nr_pm/eg; # exact search (full name) on $pm (not part of name)
|
||
}
|
||
$expr[$m]=$_; # expr with $1,$2,$3 as paramvars
|
||
$pexpr[$n]=$_; # expr with $1,$2,$3 as paramvars NEW NEW 31.07.05 for comp with pspice
|
||
push @kill,$i; # prep. lines for deletion
|
||
$memidx=$m; # NEW NEW NEW
|
||
}
|
||
}
|
||
&zapdeck(@kill); # now delete line
|
||
}
|
||
sub read_pfuncs {
|
||
my($i,$m,$found,$pm,$nr_pm,$parm,$ex);
|
||
my(@pmvec);
|
||
my(@kill);
|
||
#============================================================================#
|
||
#search, collect funcname, parametercount, subs parameter with x1,x2 in expr.#
|
||
#============================================================================#
|
||
$found=0;$m=$memidx2=$pfidx+$memidx-$fidx; #$pfidx-1; # startidx of user defined .pfunc lines NEW NEW NEW
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
if ( m/^\.pfunc/i ) { # .pfunc
|
||
$found=1;$m++;
|
||
m/\s+([^\(]+)\(([^\)]+)\)\s+(.*)/i; # fname, parameter , expr
|
||
$pfuncname[$m]=$1;
|
||
# how many params in $2 ? neg(x)=((x)*(x)) -> $1=neg $2=x $3=((x)*(x))
|
||
$parm=$2;
|
||
$ex=$3;$ex=~s/\s//g; # delete blanks NEW 31.07.05
|
||
$pfuncname[$m]=~s/\s//g; # delete blanks
|
||
$parm=~s/\s//g;
|
||
@pmvec=split(/,/,$parm); # x
|
||
$panz_pm[$m]=@pmvec; # 1
|
||
$_=$ex; #expr ((x)*(x))
|
||
$nr_pm=0;
|
||
foreach $pm (@pmvec) { # subs with x1 , x2 ...
|
||
$nr_pm++;
|
||
s/\b$pm\b/"__".$nr_pm/eg; # exact search (full name) on $pm (not part of name)
|
||
}
|
||
$pexpr[$m]=$_; # expr with $1,$2,$3 as paramvars
|
||
push @kill,$i; # prep. lines for deletion
|
||
$memidx2=$m; # NEW NEW NEW
|
||
}
|
||
}
|
||
&zapdeck(@kill); # now delete line
|
||
}
|
||
#===========================================================================#
|
||
#substitute all (p)func on rhs of .(p)funclines (func is defined by func(s))#
|
||
#===========================================================================#
|
||
sub eval_funcs {
|
||
my($i,$anz,$fnr,$pm,$parm,$subexpr,$fname,$par_on,$par_off,$rest,$fexpr);
|
||
my($nr_pm,$tmp,$se,$sex,$n,$search_ahead,$text);
|
||
local(@pm_neu);
|
||
|
||
$fnr=0;
|
||
foreach $fname (@funcname) { # for all .func fname definitions
|
||
if ($fnr == 0) {goto marke; }
|
||
$_=$expr[$fnr];
|
||
for ($i=0;$i<$fnr;$i++) {
|
||
$fexpr="";$_=$expr[$fnr];
|
||
# OLD while ( m/$funcname[$i]/ig ) # isol. funcname( , , ) and store in $fexpr.
|
||
while ( m/\b$funcname[$i]\b/ig ) { # isol. funcname( , , ) and store in $fexpr.
|
||
$fexpr=$fexpr.$funcname[$i];
|
||
$par_off=0;$par_on=0;$rest="";$search_ahead=1;
|
||
while ($search_ahead) {
|
||
if ( m/([^\)]*)/ig) { # store everything till paranthesis closed in $1
|
||
$rest=$rest.$1;
|
||
$par_off++;
|
||
}
|
||
$text=$1;
|
||
$par_on += $text =~ tr/\(//;
|
||
if ( ($par_on-$par_off)>= 1 ) {
|
||
m/\)/ig;
|
||
$rest = $rest.")"; # add )
|
||
}
|
||
else {$search_ahead=0;}
|
||
}
|
||
m/\)/ig; # read last ) - prepare for ( possible ) next loop
|
||
$fexpr=$fexpr.$rest.")";
|
||
$_ = $fexpr;
|
||
m/\s*([^\(]+)\((.*)/i; # search for funcname = $1 rest = $2
|
||
$parm=$2;
|
||
$parm=~s/\s//g; # eats all spaces
|
||
$anz=@pm_neu = split(/,/,$parm); # store new parameter(expressions) in array
|
||
chop($pm_neu[$anz-1]); # delete last ) in last parameter
|
||
##########################################################################################################
|
||
if($anz!=$anz_pm[$i]) { # special treatment if functions are nested ( argument of function is a function )
|
||
# because of additional "," commas in expression !
|
||
@pm_neu=&resolve_nested_funcs($i,$anz);
|
||
}
|
||
if($anz_pm[$i]!=@pm_neu) { print"Error: function: $fname expr:($fexpr) in b-line $i : nr. of open/closed paranthesis or nr. of parameters not ok!"; exit(1);}
|
||
##########################################################################################################
|
||
$subexpr=$expr[$i];
|
||
$n=0;
|
||
foreach $pm (@pm_neu) {
|
||
$n++;$se="__".$n;$sex=$se.$n;
|
||
$subexpr =~ s/\b$se\b/$sex/g; # global one or more times
|
||
}
|
||
$n=0;
|
||
foreach $pm (@pm_neu) {
|
||
$n++;$se="__".$n.$n;
|
||
$subexpr =~ s/\b$se\b/$pm/g; # global one or more times
|
||
# for more security $subexpr could be also with additional paranthesis "$subexpr=~s/\b$se\b/\($pm\)/g;"
|
||
}
|
||
# write back subs expr in $expr
|
||
$expr[$fnr] =~ s/\s*//g; # eats all spaces before
|
||
$fexpr =~ s/\s*//g; # eats all spaces before
|
||
$fexpr=quotemeta($fexpr); # all special characters get a backslash in front
|
||
$expr[$fnr] =~ s/$fexpr/$subexpr/g; # new /g option
|
||
$fexpr=""; # clean up for new loop;
|
||
$_=$expr[$fnr];
|
||
}
|
||
}
|
||
marke: $fnr++;
|
||
}
|
||
}
|
||
sub eval_pfuncs {
|
||
my($i,$anz,$fnr,$pm,$parm,$par_off,$par_on,$rest,$subexpr,$fname,$fexpr);
|
||
my($nr_pm,$tmp,$se,$sex,$n,$search_ahead,$text);
|
||
local(@pm_neu);
|
||
|
||
$fnr=0;
|
||
foreach $fname (@pfuncname) { # for all .func fname definitions
|
||
if ($fnr == 0) {goto marke; }
|
||
$_=$pexpr[$fnr];
|
||
for ($i=0;$i<$fnr;$i++) {
|
||
$fexpr="";$_=$pexpr[$fnr];
|
||
while ( m/\b$pfuncname[$i]\b/ig ) { # isol. funcname( , , ) and store in $fexpr.
|
||
$fexpr=$fexpr.$pfuncname[$i];
|
||
$par_off=0;$par_on=0;$rest="";$search_ahead=1;
|
||
while ($search_ahead) {
|
||
if ( m/([^\)]*)/ig) { # store everything till paranthesis closed in $1
|
||
$rest=$rest.$1;
|
||
$par_off++;
|
||
}
|
||
$text=$1;
|
||
$par_on += $text =~ tr/\(//;
|
||
if ( ($par_on-$par_off)>= 1 ) {
|
||
m/\)/ig;
|
||
$rest = $rest.")"; # add )
|
||
}
|
||
else {$search_ahead=0;}
|
||
}
|
||
m/\)/ig; # read last ) - prepare for ( possible ) next loop
|
||
$fexpr=$fexpr.$rest.")";
|
||
$_ = $fexpr;
|
||
m/\s*([^\(]+)\((.*)/i; # search for funcname = $1 rest = $2
|
||
$parm=$2;
|
||
$parm=~s/\s//g; # eats all spaces
|
||
$anz=@pm_neu = split(/,/,$parm); # store new parameter(expressions) in array
|
||
chop($pm_neu[$anz-1]); # delete last ) in last parameter
|
||
##########################################################################################################
|
||
if($anz!=$panz_pm[$i]) { # special treatment if functions are nested ( argument of function is a function )
|
||
# because of additional "," commas in expression !
|
||
@pm_neu=&resolve_nested_funcs($i,$anz);
|
||
}
|
||
if($panz_pm[$i]!=@pm_neu) { print"Error: function: $fname expr:($fexpr) in b-line $i : nr. of open/closed paranthesis or nr. of parameters not ok!"; exit(1);}
|
||
#########################################################################################################
|
||
$subexpr=$pexpr[$i];
|
||
$n=0;
|
||
foreach $pm (@pm_neu) {
|
||
$n++;$se="__".$n;$sex=$se.$n; # make parameter unique xx1 xx2 -> xx11 xx22 before substitution
|
||
$subexpr =~ s/\b$se\b/$sex/g; # global one or more times
|
||
}
|
||
$n=0;
|
||
foreach $pm (@pm_neu) {
|
||
$n++;$se="__".$n.$n; # now substitute unique parameter xx11 xx22 ... with xx1 xx2 ...
|
||
$subexpr =~ s/\b$se\b/$pm/g; # global one or more times
|
||
# for more security $subexpr could be also with additional paranthesis "$subexpr=~s/\b$se\b/\($pm\)/g;"
|
||
}
|
||
# write back subs expr in $expr
|
||
$pexpr[$fnr] =~ s/\s//g; # eats all spaces before ?
|
||
$fexpr =~ s/\s//g; # eats all spaces before ?
|
||
$fexpr=quotemeta($fexpr); # all special characters get a backslah in front
|
||
$pexpr[$fnr] =~ s/$fexpr/$subexpr/g;
|
||
$fexpr=""; # clean up for new loop;
|
||
$_=$pexpr[$fnr];
|
||
}
|
||
}
|
||
marke: $fnr++;
|
||
}
|
||
}
|
||
#================================================================================================#
|
||
# substitute all pfunc expressions on rhs of .paramlines or in expressions on devicelines { xxx } #
|
||
#================================================================================================#
|
||
#===================================================#
|
||
# substitute all func expressions on b-devicelines #
|
||
#===================================================#
|
||
sub expand_funclines { # only for b-sources ( b-source syntax )
|
||
my($i,$n,$m,$j,$anz,$par_on,$par_off,$pm,$parm,$head,$tail,$fexpr);
|
||
my($parcnt,$pcnt,$rest,$subexpr,$temp,$fname,$text,$sexp,$rexp);
|
||
local($search_ahead,$se,$sex,@pm_neu);
|
||
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
if ( m/(^b\S+[^\=]*\=)(.*)/i ) { # search for bxxx bla bla v= or i= expr $2 = expr
|
||
$head=$1; # everything till including =
|
||
$tail=$2; # expr
|
||
$m=-1;
|
||
foreach $fname (@funcname) {
|
||
$m++; $_=$tail;
|
||
while(m/(\b$fname\b\s*\()/ig) { # while(m/$fname/ig)
|
||
$fexpr=$fexpr.$funcname[$m];
|
||
$par_off=0;$par_on=1;$rest="(";$search_ahead=1;
|
||
while ($search_ahead) {
|
||
if ( m/([^\)]*)/ig) { # store everything till paranthesis closed in $1
|
||
$rest=$rest.$1;
|
||
$par_off++;
|
||
}
|
||
$text=$1;
|
||
$par_on += $text =~ tr/\(//;
|
||
if ( ($par_on-$par_off)>= 1 ) {
|
||
m/\)/ig;
|
||
$rest = $rest.")"; # add )
|
||
}
|
||
else {$search_ahead=0;}
|
||
}
|
||
m/\)/ig; # read last ) - prepare for ( possible ) next loop
|
||
$fexpr=$fexpr.$rest.")";
|
||
$_ = $fexpr;
|
||
m/\s*([^\(]+)\((.*)/i; # search for funcname = $1 rest = $2
|
||
@pm_neu=();
|
||
$parm=$2;
|
||
$parm=~s/\s//g; # eats all spaces
|
||
# v(1,2) -> v(1:2) translation for correct parameter count
|
||
$_=$parm;
|
||
while( m/\bv\s*\(([^\)]*)\)/g) { # new to handle differential voltages (don't see v(1,2) as a functions)
|
||
$sexp=$rexp=$1;
|
||
$rexp=~s/,/:/;
|
||
$parm=~s/$sexp/$rexp/;
|
||
}
|
||
$anz=@pm_neu = split(/,/,$parm); # store new parameter(expressions) in array
|
||
chop($pm_neu[$anz-1]); # delete last ) in last parameter
|
||
##########################################################################################################
|
||
if($anz!=$anz_pm[$m]) { # special treatment if functions are nested ( argument of function is a function )
|
||
# because of additional "," commas in expression !
|
||
@pm_neu=&resolve_nested_funcs($m,$anz);
|
||
}
|
||
if($anz_pm[$m]!=@pm_neu) { print"Error: function: $fname expr:($fexpr) in b-line $i : nr. of open/closed paranthesis or nr. of parameters not ok!"; exit(1);}
|
||
#########################################################################################################
|
||
$subexpr=$expr[$m];
|
||
$n=0;
|
||
foreach $pm (@pm_neu) {
|
||
$pm=~s/:/,/g; # v(1:2) -> v(1,2) re-translation ++
|
||
$n++;$se="__".$n;$sex=$se.$n; # make parameter unique xx1 xx2 -> xx11 xx22 before substitution
|
||
$subexpr =~ s/\b$se\b/$sex/g; # global one or more times
|
||
}
|
||
$n=0;
|
||
foreach $pm (@pm_neu) {
|
||
$n++;$se="__".$n.$n; # now substitute unique parameter xx11 xx22 ... with xx1 xx2 ...
|
||
$subexpr =~ s/\b$se\b/$pm/g; # global one or more times
|
||
# for more security $subexpr could be also with additional paranthesis "$subexpr=~s/\b$se\b/\($pm\)/g;"
|
||
}
|
||
$tail =~ s/\s*//g; # eats all spaces before
|
||
$fexpr =~ s/\s*//g; # eats all spaces before
|
||
$fexpr=quotemeta($fexpr); # all special characters get a backslah in front
|
||
$tail =~ s/$fexpr/$subexpr/g;
|
||
$fexpr=""; # clean up for new loop;
|
||
$_=$tail;
|
||
}
|
||
}
|
||
$deck[$i]=$head.$tail; # writeback
|
||
}
|
||
}
|
||
}
|
||
|
||
sub expand_pfunclines { # for all {} expressions ( perl syntax )
|
||
my($i,$n,$m,$j,$anz,$pm,$parm,$head,$tail,$fexpr,$parcnt,$pcnt,$rest,$subexpr,$found,$temp,$fname,$text);
|
||
local($search_ahead,$se,$sex,@pm_neu);
|
||
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];$head=();$found=0; #
|
||
while ( /([^\{]*)\{([^\}]*)\}(.*)/ ) { # search for {} expressions
|
||
$found=1;
|
||
$head=$head.$1; $tail=$3;
|
||
$temp = $2; # actual expression to deal with ( e.g. .param b = {2*neg(a)*neg(a)*pos(a)} )
|
||
$temp =~ s/\*\s+\*/\*\*/g;
|
||
$m=-1;
|
||
foreach $fname (@pfuncname) {
|
||
$m++; $_=$temp;
|
||
while(m/(\b$fname\b\s*\()/ig) {
|
||
$fexpr=$fexpr.$pfuncname[$m];
|
||
$par_off=0;$par_on=1;$rest="(";$search_ahead=1;
|
||
while ($search_ahead) {
|
||
if ( m/([^\)]*)/ig) { # store everything till paranthesis closed in $1
|
||
$rest=$rest.$1;
|
||
$par_off++;
|
||
}
|
||
$text=$1;
|
||
$par_on += $text =~ tr/\(//;
|
||
if ( ($par_on-$par_off)>= 1 ) {
|
||
m/\)/ig;
|
||
$rest = $rest.")"; # add )
|
||
}
|
||
else {$search_ahead=0;}
|
||
}
|
||
m/\)/ig; # read last ) - prepare for ( possible ) next loop
|
||
$fexpr=$fexpr.$rest.")";
|
||
$_ = $fexpr;
|
||
m/\s*([^\(]+)\((.*)/i; # search for funcname = $1 rest = $2
|
||
@pm_neu=();
|
||
$parm=$2;
|
||
$parm=~s/\s//g; # eats all spaces
|
||
$anz=@pm_neu = split(/,/,$parm); # store new parameter(expressions) in array
|
||
chop($pm_neu[$anz-1]); # delete last ) in last parameter
|
||
##########################################################################################################
|
||
if($anz!=$panz_pm[$m]) { # special treatment if functions are nested ( argument of function is a function )
|
||
# because of additional "," commas in expression !
|
||
@pm_neu=&resolve_nested_funcs($m,$anz);
|
||
}
|
||
if($panz_pm[$m]!=@pm_neu) { print"Error: function: $fname expr:($fexpr) in b-line $i : nr. of open/closed paranthesis or nr. of parameters not ok!"; exit(1);}
|
||
#########################################################################################################
|
||
$subexpr=$pexpr[$m];
|
||
$n=0;
|
||
foreach $pm (@pm_neu) {
|
||
$n++;$se="__".$n;$sex=$se.$n; # make parameter unique xx1 xx2 -> xx11 xx22 before substitution
|
||
$subexpr =~ s/\b$se\b/$sex/g; # global one or more times
|
||
}
|
||
$n=0;
|
||
foreach $pm (@pm_neu) {
|
||
$n++;$se="__".$n.$n; # now substitute unique parameter xx11 xx22 ... with xx1 xx2 ...
|
||
$subexpr =~ s/\b$se\b/$pm/g; # global one or more times
|
||
}
|
||
# write back subs expr in $expr
|
||
$temp =~ s/\s*//g; # eats all spaces before
|
||
$fexpr =~ s/\s*//g; # eats all spaces before
|
||
$fexpr=quotemeta($fexpr); # all special characters get a backslash in front
|
||
$temp =~ s/$fexpr/$subexpr/g; # new /g option
|
||
$fexpr=""; # clean up for new loop;
|
||
$_=$temp; # perhaps another param in line ?
|
||
}
|
||
}
|
||
$head=$head."{".$temp."}"; # append
|
||
$_=$tail;
|
||
}
|
||
if($found) { # if {} expression found and therefore -> $head evaluated
|
||
$deck[$i]=$head.$tail; # writeback
|
||
}
|
||
}
|
||
}
|
||
|
||
sub resolve_nested_funcs {
|
||
my($fnr,$cnt)=@_;
|
||
my($anz,$mm,$k,@tmp,$par_on,$par_off,$pm_ok);
|
||
|
||
# ( local @pmneu )
|
||
|
||
@tmp=();$mm=0;
|
||
$pm_ok=$pm_neu[0];
|
||
for($k=0;$k<($cnt-1);$k++) {
|
||
$_=$pm_ok;
|
||
$par_on = tr/\(//; # count of open paranthesis
|
||
$par_off = tr/\)//; # count of closed paranthesis
|
||
if($par_on!=$par_off) { # nested ! -> additional paranthesis -> because of function as argument of function
|
||
$pm_ok=$pm_ok.",".$pm_neu[$k+1];
|
||
}
|
||
else { # now the parameter is perfect
|
||
$tmp[$mm++]=$pm_ok;
|
||
$pm_ok=$pm_neu[$k+1];
|
||
}
|
||
}
|
||
$tmp[$mm]=$pm_ok; # manage last element
|
||
return(@tmp);
|
||
}
|
||
|
||
sub check {
|
||
my($i,$par_on,$par_off);
|
||
|
||
foreach $key (keys %param) { # for all parameters
|
||
$_=$param{$key};
|
||
$par_on = tr/\(//; # count of open paranthesis
|
||
$par_off = tr/\)//; # count of closed paranthesis
|
||
if(not($par_on eq $par_off)) {
|
||
print "Nr of opened and closed paranthesis differs -> please check param $key = $val";
|
||
&hint;
|
||
exit;
|
||
}
|
||
$par_on = tr/\{//; # count of open paranthesis
|
||
$par_off = tr/\}//; # count of closed paranthesis
|
||
if(not($par_on eq $par_off)) {
|
||
print "Nr of opened and closed paranthesis differs -> please check param $key = $val";
|
||
&hint;
|
||
exit;
|
||
}
|
||
if(m/\{[^\}]*?\{/g) { # not greedy
|
||
print "Nested curly braces found -> please check param $key = $val";
|
||
&hint;
|
||
exit;
|
||
}
|
||
if(m/\{[^\}]*?\{/g) { # not greedy
|
||
print "Nested curly braces found -> please check param $key = $val";
|
||
&hint;
|
||
exit;
|
||
}
|
||
}
|
||
for ($i=0;$i<@expr;$i++) { # for all functions
|
||
$_=$expr[$i];
|
||
# @funcname @expr
|
||
# @pfuncname @pexpr
|
||
$par_on = tr/\(//; # count of open paranthesis
|
||
$par_off = tr/\)//; # count of closed paranthesis
|
||
if(not($par_on eq $par_off)) {
|
||
print "Nr of opened and closed paranthesis differs -> please check func nr: $i ";
|
||
print "\n\funcname: $funcname[$i] expr: $expr[$i]\n";
|
||
&hint;
|
||
exit;
|
||
}
|
||
$par_on = tr/\{//; # count of open paranthesis
|
||
$par_off = tr/\}//; # count of closed paranthesis
|
||
if(not($par_on eq $par_off)) {
|
||
print "Nr of opened and closed paranthesis differs -> please check func nr: $i ";
|
||
print "\n\funcname: $funcname[$i] expr: $expr[$i]\n";
|
||
&hint;
|
||
exit;
|
||
}
|
||
if(m/\{[^\}]*?\{/g) { # not greedy
|
||
print "Nested curly braces found -> please check func nr: $i ";
|
||
print "\n\funcname: $funcname[$i] expr: $expr[$i]\n";
|
||
&hint;
|
||
exit;
|
||
}
|
||
if(m/\{[^\}]*?\{/g) { # not greedy
|
||
print "Nested curly braces found -> please check func nr: $i ";
|
||
print "\n\funcname: $funcname[$i] expr: $expr[$i]\n";
|
||
&hint;
|
||
exit;
|
||
}
|
||
}
|
||
for ($i=0;$i<@pexpr;$i++) { # for all pfunctions
|
||
$_=$pexpr[$i];
|
||
$par_on = tr/\(//; # count of open paranthesis
|
||
$par_off = tr/\)//; # count of closed paranthesis
|
||
if(not($par_on eq $par_off)) {
|
||
print "Nr of opened and closed paranthesis differs -> please check pfunc nr: $i ";
|
||
print "\n\funcname: $pfuncname[$i] expr: $pexpr[$i]\n";
|
||
&hint;
|
||
exit;
|
||
}
|
||
$par_on = tr/\{//; # count of open paranthesis
|
||
$par_off = tr/\}//; # count of closed paranthesis
|
||
if(not($par_on eq $par_off)) {
|
||
print "Nr of opened and closed paranthesis differs -> please check pfunc nr: $i ";
|
||
print "\n\funcname: $pfuncname[$i] expr: $pexpr[$i]\n";
|
||
&hint;
|
||
exit;
|
||
}
|
||
if(m/\{[^\}]*?\{/g) { # not greedy
|
||
print "Nested curly braces found -> please check pfunc nr: $i ";
|
||
print "\n\funcname: $pfuncname[$i] expr: $pexpr[$i]\n";
|
||
&hint;
|
||
exit;
|
||
}
|
||
if(m/\{[^\}]*?\{/g) { # not greedy
|
||
print "Nested curly braces found -> please check pfunc nr: $i ";
|
||
print "\n\funcname: $pfuncname[$i] expr: $pexpr[$i]\n";
|
||
&hint;
|
||
exit;
|
||
}
|
||
}
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
$par_on = tr/\(//; # count of open paranthesis
|
||
$par_off = tr/\)//; # count of closed paranthesis
|
||
if(not($par_on eq $par_off)) {
|
||
print "Nr of opened and closed paranthesis differs -> please check about line $i in sub.tmp";
|
||
print "\n\n.... $deck[$i-1]\n";
|
||
print "error: -> $deck[$i]\n";
|
||
print ".... $deck[$i+1]\n";
|
||
&hint;
|
||
exit;
|
||
}
|
||
$par_on = tr/\{//; # count of open paranthesis
|
||
$par_off = tr/\}//; # count of closed paranthesis
|
||
if(not($par_on eq $par_off)) {
|
||
print "Nr of opened and closed paranthesis differs -> please check about line $i in sub.tmp";
|
||
print "\n\n.... $deck[$i-1]\n";
|
||
print "error: -> $deck[$i]\n";
|
||
print ".... $deck[$i+1]\n";
|
||
&hint;
|
||
exit;
|
||
}
|
||
if(m/^[efgh]/i && m/value/i) {next;} # nested curly braces are managed by value2bdevice itself
|
||
if(m/\{[^\}]*?\{/g) { # not greedy
|
||
print "Nested curly braces found -> please check about line $i in sub.tmp";
|
||
print "\n\n.... $deck[$i-1]\n";
|
||
print "error: -> $deck[$i]\n";
|
||
print ".... $deck[$i+1]\n";
|
||
&hint;
|
||
exit;
|
||
}
|
||
if(m/\}[^\{]*?\}/g) { # not greedy
|
||
print "Nested curly braces found -> please check about line $i in sub.tmp";
|
||
print "\n\n.... $deck[$i-1]\n";
|
||
print "error: -> $deck[$i]\n";
|
||
print ".... $deck[$i+1]\n";
|
||
&hint;
|
||
exit;
|
||
}
|
||
}
|
||
}
|
||
sub value2bdevice { # new search for pspice efgh value lines and convert to b v= or b i=
|
||
my ($i,$templine);
|
||
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
if(m/^([efgh])/i && m/value/i) { # pspice value line detected
|
||
s/tripdv(.*)//; # to deal with ltspice tripdt , tripdv
|
||
s/tripdt(.*)//;
|
||
s/value\s*\=\s*\{/v=/i; # subs "value = {" with "v="
|
||
s/value\s*\{\s*/v=/i; # NEW subs "value { " with "v="
|
||
$deck[$i]=$_; # write back
|
||
s/(v\=.*)\}/$1/; # search for rhs expression without (last closed) paranthesis (greedy)
|
||
$templine=$1;
|
||
$templine=~tr/\{\}/\(\)/; # sometimes pspice users use 2nd order {} inside {}'s
|
||
$templine=~s/\s*//g; # NEW delete all blanks in rhs expression
|
||
$templine=~s/(\d)V/$1/ig; # NEW 10v -> 10
|
||
$templine =~ s/([\+\-\*\/\&\|\=\^])\+/$1/; # sometimes pspice adds a "surplus +" at the end of a continuation line -> delete it
|
||
$_=$deck[$i];
|
||
s/v=.*/$templine/;
|
||
if ( m/^[GF]/i) { # G or F at first -> v= -> i=
|
||
s/v=/i=/; # currrentsources
|
||
}
|
||
s/^([GFEH])/b$1/i; # subs G,F,E or. H with b(EFGH)
|
||
$deck[$i]=$_; #."+v(0)"; #DONE IN &expand_parameters
|
||
}
|
||
}
|
||
}
|
||
sub model_r { # search for r1 1 0 10 tc=0,0 and delete tc=0,0 add .model rmodel R modelline
|
||
my ($i,$tc,$tc1,$tc2,$rsh,$rmodname);
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
if(m/^r(\w+)/i) { # r1
|
||
$rmodname="mod_r".$1; #s/tc.*$/tc=0,0/; # r .... tc=0,0 line detected
|
||
if(s/tc\s*=\s*(.*)$//) { # $1 = tc=tc1,tc2 or tc=(tc1,tc2) or tc=tc1 or tc=(tc1)
|
||
$deck[$i]=$_; # r1 1 0 rval
|
||
$tc=$_=$1; # tc=tc1,tc2 or tc=tc1
|
||
s/[\)\(]//g; # deletes ( ) if present
|
||
if(m/(\S+)\s*\,\s*(\S+)/) { # first form tc=tc1,tc2
|
||
$tc1=$1;
|
||
$tc2=$2;
|
||
$deck[$i]=~s/(\S+)\s*$/$1 $rmodname/; # change r-line -> cut rvalue and add modelname
|
||
# rvalue = $1
|
||
#insert .model-line and increase index i
|
||
splice(@deck,$i+1,0,".model $rmodname R ( tc1=$tc1 tc2=$tc2 tnom=$tnom )");
|
||
$i++;
|
||
}
|
||
else { # 2nd form tc=tc1
|
||
$deck[$i]=~s/(\S+)\s*$/$rmodname/; # change r-line -> cut rvalue and add modelname
|
||
# rvalue = $1
|
||
#insert .model-line and increase index i
|
||
splice(@deck,$i+1,0,".model $rmodname R ( tc1=$tc tnom=$tnom )");
|
||
$i++;
|
||
}
|
||
}
|
||
}
|
||
$_=$deck[$i];
|
||
if(m/^.model\s+(\w+)\s+(\w+)/) { # search for .model rmodel RES -> change to .model rmodel R
|
||
$_=$2;
|
||
if(m/RES/i) { # is it a pspice - resistormodel
|
||
$deck[$i]=~s/RES/R/i; # change modelname to R
|
||
}
|
||
|
||
}
|
||
}
|
||
}
|
||
sub model_r_spice3 { # search for r1 1 0 rval tc=0,0 and convert to r1 1 0 rvaltc1tc2 = rval + rval*tc1 + rval*tc2
|
||
|
||
my ($i,$tc,$tc1,$tc2,$rsh,$rvaltc1tc2);
|
||
|
||
for ($i=1;$i<@deck;$i++){ # for the whole deck
|
||
$_=$deck[$i];
|
||
if(m/^r/i) { # e.g r1 1 0 rval tc=tc1,tc2
|
||
if(s/tc\s*=\s*(.*)$//) { # $1 = tc=tc1,tc2 or tc=(tc1,tc2) or tc=tc1 or tc=(tc1)
|
||
$deck[$i]=$_; # now r1 1 0 rvalue (tc=val,val cutted)
|
||
$tc=$_=$1; # tc=tc1,tc2 or tc=tc1
|
||
s/[\)\(]//g; # deletes ( ) if present
|
||
if(m/(\S+)\s*\,\s*(\S+)/) { # first form tc=tc1,tc2
|
||
$tc1=$1;
|
||
$tc2=$2;
|
||
}
|
||
else { # 2nd form tc=tc1
|
||
$tc1=$tc;
|
||
$tc2=0;
|
||
}
|
||
$deck[$i]=~s/(\S+)\s*$//; # cut rvalue
|
||
$rsh=&unit($1); # rvalue
|
||
$rvaltc1tc2 = "{$rsh*(1+($tc1)*(temp-27)+($tc2)*(temp-27)*(temp-27))}";
|
||
$deck[$i]=$deck[$i]." ".$rvaltc1tc2; # r1 1 0 { rvalue*(1+tc1*(temp-27)+tc2*(temp-27)*(temp-27)) }
|
||
# rvalue and tc1 and tc2 are constants , temp = parameter
|
||
}
|
||
}
|
||
if(m/^.model\s+(\w+)\s+(\w+)/) { # search for .model rmodel RES -> change to .model rmodel R
|
||
$_=$2;
|
||
if(m/RES/i) { # is it a pspice - resistormodel
|
||
$deck[$i]=~s/RES/R/i; # change modelname to R
|
||
}
|
||
}
|
||
}
|
||
}
|
||
sub model_switch {
|
||
my ($i,$k,$cnt);
|
||
my (%swmodel,$modelnm,$kindofmodel,$vctrllim,$vswitch,$found);
|
||
my ($xon,$xoff,$von,$voff,$ion,$ioff,$ron,$roff,$par); # model parameters
|
||
my ($node1,$node2,$ctrlnode1,$ctrlnode2,$ctrlsrc,$xtmp);
|
||
my ($mline,$lline,$hline); # converted modellines (PSPICE s-device + .modelline) in two spice3 b-lines
|
||
my ($lm,$lr,$um,$ud,$c2,$c3); # pspice switcher model
|
||
my $optline=".options trtol=1 chgtol=1e-16"; # add this for better convergence
|
||
|
||
%swmodel=();
|
||
$von=1;$voff=0.0;$ion=0.001;$ioff=0.0; # default for pspice !
|
||
$xon=1;$xoff=0;$ron=1;$roff=1e6;
|
||
$k=0;$found=0;
|
||
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
$von=$voff=0;
|
||
if(s/^.model\s+(\w+)\s+(\w+)//i) { # search for .model modelname ISWITCH/VSWITCH and delete it
|
||
$modelnm=$1;
|
||
$kindofmodel=$2;
|
||
if($kindofmodel eq 'vswitch' || $kindofmodel eq 'iswitch' ) {
|
||
# now only present -> (von=xx voff=xx ron=xx roff=xx)
|
||
s/[\=\)\(]/ /g;
|
||
$swmodel{$modelnm}=$kindofmodel." ".$_;
|
||
if($found==1) {
|
||
splice(@deck,$i,1); # just delete line
|
||
$i--;
|
||
}
|
||
else { # first time .model VSWITCH || ISWITCH -> add optline
|
||
splice(@deck,$i,1,$optline); # $optline instead of .modelline ($i--)
|
||
$found=1;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
$cnt=0;
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
if(/^([sw])/) {
|
||
$cnt++;
|
||
if($1 eq 's') {
|
||
/^s(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(\w+)/; # search for -> s1 out1 out2 ctrl1 ctrl2 modelname
|
||
$node1=$2;
|
||
$node2=$3;
|
||
$ctrlnode1=$4;
|
||
$ctrlnode2=$5;
|
||
$modelnm=$6;
|
||
}
|
||
else { # must be w
|
||
/^w(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(\w+)/; # search for -> w1 out1 out2 vname modelname
|
||
$node1=$2;
|
||
$node2=$3;
|
||
$ctrlsrc=$4;
|
||
$modelnm=$5;
|
||
$ctrlnode1="0";
|
||
$ctrlnode2="visw$cnt";
|
||
}
|
||
#extract parameters for mline
|
||
if(exists $swmodel{$modelnm}) {
|
||
@mpar = split(' ',$swmodel{$modelnm}) if(exists $swmodel{$modelnm});
|
||
}
|
||
else {
|
||
print("\nError: S-deviceline line: $i with undefined model ! \n");
|
||
exit(1);
|
||
}
|
||
if(shift(@mpar) eq 'vswitch') {$vswitch=1;$xon=$von;$xoff=$voff;} # default values for VSWITCH
|
||
else {$vswitch=0;$xon=$ion;$xoff=$ioff;} # default values for ISWITCH
|
||
while($par=shift(@mpar)) {
|
||
if($vswitch) {
|
||
if($par eq 'von') {$xon=$von=&unit(shift(@mpar));next;}
|
||
if($par eq 'voff') {$xoff=$voff=&unit(shift(@mpar));next;}
|
||
}
|
||
else { # iswitch
|
||
if($par eq 'ion') { $xon=$ion=&unit(shift(@mpar));next;}
|
||
if($par eq 'ioff') {$xoff=$ioff=&unit(shift(@mpar));next;}
|
||
}
|
||
if($par eq 'ron') {$ron=&unit(shift(@mpar));next;}
|
||
if($par eq 'roff') {$roff=&unit(shift(@mpar));next;}
|
||
}
|
||
if($xon<$xoff) {
|
||
$ron=-$ron;
|
||
$roff=-$roff;
|
||
}
|
||
################################
|
||
$lm=log(($ron*$roff)**0.5);
|
||
$lr=log($ron/$roff);
|
||
################################
|
||
$um=($xon+$xoff)/2;
|
||
$ud=($xon-$xoff);
|
||
$c2=3*$lr/(2*$ud);
|
||
$c3=-2*$lr/($ud**3);
|
||
$mline="bsw$cnt $node2 $node1 i=";
|
||
if($xon<$xoff){$xtmp=$xon;$xon=$xoff;$xoff=$xtmp;}
|
||
# because of my limit function definition: LIMIT(x,lowerlim,uperlim)
|
||
# in ltspice the definition is LIMIT(x,MIN(lowerlim,uperlim),MAX(lowerlim,uperlim))
|
||
# where LIMIT means my limit function definition
|
||
$lline="bswlim$cnt vlim$cnt 0 v=limit((v($ctrlnode1)-v($ctrlnode2)),$xoff,$xon)"; $mline=$mline."v($node2,$node1)/(e^($lm+$c2*(v(vlim$cnt)-$um)+$c3*(v(vlim$cnt)-$um)^3))";
|
||
#$lline="bswlim$cnt vlim$cnt 0 v=limit((v($ctrlnode1)-v($ctrlnode2)),$xoff,$xon)"; $mline=$mline."v($node2,$node1)/(exp($lm+$c2*(v(vlim$cnt)-$um)+$c3*(v(vlim$cnt)-$um)^3))";
|
||
if ($vswitch) { # sline -vswitch
|
||
splice(@deck,$i,1,$mline,$lline);$i++;
|
||
}
|
||
else { # wline - iswitch
|
||
$hline="hisw$cnt visw$cnt 0 $ctrlsrc 1";
|
||
splice(@deck,$i,1,$hline,$mline,$lline);$i=$i+2;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
# only for b-lines = funclines expansion
|
||
# e1 1 0 value={idt(v(1))} was converted to b1 1 0 v=idt(v(1)) and now processed to get a spice3 convenient expression
|
||
sub b_device_sdt_idt {
|
||
my($bline,$lline,$rline,$fexpr,$replaceexpr,$cnt,$bname,$node1,$node2);
|
||
my($fname,@funcname);
|
||
my($head,$tail,$rest,$search_ahead,$par_off,$par_on,$text,$m,$i);
|
||
|
||
$cnt=0;
|
||
$m=0;
|
||
$funcname[0]="idt";
|
||
$funcname[1]="ddt";
|
||
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
if (m/[sid]dt\s*\(/i && m/^b/i ) {s/sdt/idt/g;} # this is a function "s[i]dt("
|
||
else {next;}
|
||
if(m/(^b\S+[^\=]*\=)(.*)/i ) { # $1 = "b1 1 0 v/i=" $2=rest of line
|
||
$head=$1; # everything till =
|
||
$tail=$2; # expr
|
||
$m=-1; # indexcounter for @funcname
|
||
foreach $fname (@funcname) {
|
||
$m++;$_=$tail;
|
||
while(m/(\b$fname\b\s*\()/ig) { # one or more times fname present
|
||
$fexpr=$fexpr.$funcname[$m];
|
||
$par_off=0;$par_on=1;$rest="(";$search_ahead=1;
|
||
while ($search_ahead){
|
||
if ( m/([^\)]*)/ig) { # store everything till paranthesis closed in $1
|
||
$rest=$rest.$1;
|
||
$par_off++;
|
||
}
|
||
$text=$1;
|
||
$par_on += $text =~ tr/\(//;
|
||
if ( ($par_on-$par_off)>= 1 ) {
|
||
m/\)/ig;
|
||
$rest = $rest.")"; # add )
|
||
}
|
||
else {$search_ahead=0;}
|
||
}
|
||
m/\)/ig; # read last ) - prepare for ( possible ) next loop
|
||
$fexpr=$fexpr.$rest.")";
|
||
&idt_ddt_addlines($fname,$fexpr,$cnt,$i); # add lines for fname found in line
|
||
$tail =~ s/\s*//g; # eats all spaces before
|
||
$fexpr =~ s/\s*//g; # eats all spaces before
|
||
$fexpr=quotemeta($fexpr);
|
||
if($fname eq 'idt') {
|
||
$replaceexpr="v(vidt$cnt)";
|
||
}
|
||
else { # ddt
|
||
$replaceexpr="v(vddt$cnt)";
|
||
}
|
||
$tail =~ s/$fexpr/$replaceexpr/;
|
||
$fexpr=""; # clean up for new loop;
|
||
$_=$tail; # starting again from begin of line
|
||
$cnt++;
|
||
}
|
||
}
|
||
$deck[$i]=$head.$tail; # writeback
|
||
}
|
||
}
|
||
}
|
||
sub idt_ddt_addlines {
|
||
($fname,$fexpr,$cnt,$i)=@_;
|
||
|
||
my($name,$lline,$bline,$rline);
|
||
|
||
if($fname eq 'idt') { # test if nested (sdt#..{ddt#.. <20>}.. <20>) (sdt()....sdt) should be ok!
|
||
$fexpr=~s/idt\(//;
|
||
$fexpr=~s/\)$//;
|
||
$name="idt$cnt"; # prevent the expression to go to long-> if nested sdt(sdt(sdt())) !!!
|
||
$lline="c$name v$name 0 1"; # this is integrated
|
||
$bline ="b$name 0 v$name i=$fexpr"; # this is to integrate
|
||
$rline="r$name 0 v$name 1e6"; # for dc,operating point
|
||
splice(@deck,$i+1,0,$lline,$bline,$rline); # only insert after actual line $i -> 3rd param = 0
|
||
}
|
||
else { # ddt
|
||
$fexpr=~s/ddt\(//;
|
||
$fexpr=~s/\)$//;
|
||
$name="ddt$cnt"; # prevent the expression to go to long if nested sdt(sdt(sdt())) !!!
|
||
$lline="l$name v$name 0 1"; # this is differentiated
|
||
$bline="b$name 0 v$name i=$fexpr"; # this to differentiate
|
||
$rline="r$name 0 v$name 1e6"; # for dc,operating point
|
||
splice(@deck,$i+1,0,$lline,$bline,$rline); # only insert after actual line $i -> 3rd param = 0
|
||
# if 2nd param is $i -> actual line moves 4 lines down = appended to the inserted lines
|
||
# if 2nd param is $i+1 -> actual line don't move
|
||
}
|
||
}
|
||
sub r_expressions {
|
||
my($i,$rexpr,$rname,$node1,$node2,$bline);
|
||
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
if(m/^r/i && m/value\s*=\s*\{(.*?)\}/i) { # r and value
|
||
$rexpr=$1; # {rexpr}
|
||
s/^(\S+)\s+(\S+)\s+(\S+)//;
|
||
$rname=$1;
|
||
$node1=$2;
|
||
$node2=$3;
|
||
# now convert to equivalent b-source
|
||
$bline="brvalue_$rname $node1 $node2 i=v($node1,$node2)/($rexpr)";
|
||
splice(@deck,$i,1,$bline);
|
||
}
|
||
}
|
||
}
|
||
sub cl_expressions {
|
||
my ($i,$qexpr,$fluxexpr,$cnt);
|
||
my ($node1,$node2,$cc,$bline1,$bline2,$cline,$lline,$gline,$eline);
|
||
# l1 1 0 flux=expr
|
||
# c1 1 0 q=expr
|
||
$cnt=0;
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
if(m/^[cl]/i) {
|
||
if(s/\bflux\b\s*\=(.*)//i) { # search for flux = expr
|
||
$cc=0;$cnt++;
|
||
$fluxexpr=$1;
|
||
s/(^[l])(\S+)\s+(\S+)\s+(\S+)//;
|
||
$node1=$3;
|
||
$node2=$4;
|
||
$fluxexpr=~s/ic\=(.*)$//;
|
||
$cc=$1;
|
||
if(not$cc) {$cc=0;}
|
||
$eline="eflux$cnt $node1 $node2 vflux$cnt 0 1";
|
||
$bline1="bfluxa$cnt 0 vflux$cnt i=v(flux$cnt)";
|
||
$lline="lflux$cnt vflux$cnt 0 1";
|
||
$bline2="bfluxb$cnt flux$cnt 0 v=$fluxexpr";
|
||
splice(@deck,$i,1,$eline,$bline1,$lline,$bline2);
|
||
$i=$i+3;
|
||
}
|
||
elsif(s/\bq\b\s*\=(.*)//i) { # search for flux = expr
|
||
$cc=0;$cnt++;
|
||
$qexpr=$1;
|
||
s/(^[c])(\S+)\s+(\S+)\s+(\S+)//;
|
||
$node1=$3;
|
||
$node2=$4;
|
||
$qexpr=~s/ic\=(.*)$//;
|
||
$cc=$1;
|
||
if(not$cc) {$cc=0;}
|
||
$gline="gqexpr$cnt $node1 $node2 vqexpr$cnt 0 1";
|
||
$bline1="bqexpra$cnt 0 vqexpr$cnt i=v(qexpr$cnt)";
|
||
$lline="lqexpr$cnt vqexpr$cnt 0 1";
|
||
$bline2="bqexprb$cnt qexpr$cnt 0 v=$qexpr";
|
||
splice(@deck,$i,1,$gline,$bline1,$lline,$bline2);
|
||
$i=$i+3;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
|
||
sub poly_2_bdevice {
|
||
|
||
my ($i,$j,$k,$found,$firstsum,$firstproduct,@w,$controls,$polydegree);
|
||
my (@exp,@coeff,@inputs,$exp2,$num_coeffs,$num_inputs,$product,$sum);
|
||
my ($cnt,$what,$node1,$node2,$cc,$bline1,$bline2,$cline,$lline,$gline,$eline,$icline,@pms);
|
||
my ($first,$params,$tmpparams);
|
||
# for eg 1 0 poly(2) (xa+,xa-) (xb+,xb-) p0 p1 p2 p3 ...
|
||
# for fh 1 0 poly(2) vnama vnamb p0 p1 p2 p3 ...
|
||
# for c/l 1 0 poly p0 p1 p2 p3 ... ic=val
|
||
$cnt=0;
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];$found=0;@coeff=();@inputs=();
|
||
if(m/\bpoly/i) { # search for poly
|
||
if(m/^[eg]/) { # e1 1 0 poly(2) (xa+,xa-) (xb+,xb-) p0 p1 p2 p3 ...
|
||
# be1 1 0 v=f(v(xa),v(xb))
|
||
# bg1 1 0 i=f(v(xa),v(xb))
|
||
$found=1;
|
||
s/\bpoly\((\d+)\)//i; # get num_inputs and delete poly(n)
|
||
$num_inputs=$1; # now line is like : e1 1 0 xa+ xa- xb+ xb- p0 p1 .....
|
||
s/[\(\)\,]/ /g; # search for ( , ) and replace with blanc
|
||
@w = split(' ');
|
||
$num_coeffs = $#w-$num_inputs*2-2; # $#w = last index of @w
|
||
for ($j=0;$j<$num_coeffs;$j++) { # for all p's
|
||
$coeff[$j]=$w[$j+$num_inputs*2+3]; # get the p's p0 p1 p2 ....
|
||
}
|
||
for ($j=0;$j<$num_inputs;$j++) { # for all controlling nodes
|
||
# w [3 5 7 .. ] w [4 6 8 .. ]
|
||
$inputs[$j]="v($w[3+2*$j],$w[4+2*$j])"; # get the next 2 pins = one differential port
|
||
}
|
||
}
|
||
elsif(m/^[fh]/) { # f1 1 0 poly(2) vnama vnamb p0 p1 p2 p3 ......idx=9 degree=3 controls=2
|
||
# bf1 1 0 i=f(i(vnama),i(vnamb))
|
||
# bh1 1 0 v=f(i(vnama,i(vnamb))
|
||
$found=1;
|
||
s/\bpoly\((\d+)\)//i; # get num_inputs and delete poly(n)
|
||
$num_inputs=$1; # now line is like : f1 1 0 vnam1 vnam2 p0 p1 .....
|
||
@w = split(' ');
|
||
$num_coeffs = $#w-$num_inputs-2; # $#w = last index of @w
|
||
for ($j=0;$j<$num_coeffs;$j++) { # for all p's
|
||
$coeff[$j]=$w[$j+$num_inputs+3]; # get the p's p0 p1 p2 ....
|
||
}
|
||
for ($j=0;$j<$num_inputs;$j++) { # for all controlling nodes
|
||
$inputs[$j]="i($w[3+$j])"; # i(vnam)
|
||
}
|
||
}
|
||
elsif (s/(^[cl])(\S+)\s+(\S+)\s+(\S+)\s+\bpoly\b//i) { # c/l poly detected c1 1 2 poly 1 1 1 0 ic=val -> 1 1 1 0 ic=val
|
||
$cnt++;
|
||
$what=$1; # c or l
|
||
$node1=$3;
|
||
$node2=$4;
|
||
s/ic\=(.*)$//; # now only 1 1 1 0
|
||
$cc=$1;
|
||
@pms=split(); # 1 1 1 0 coeffs
|
||
if($what eq 'c') { # c-device
|
||
$first=1;
|
||
$gline="gcpoly$cnt $node1 $node2 vcpoly$cnt 0 1";
|
||
$bline1="bcpolya$cnt 0 vcpoly$cnt i=v(cpoly$cnt)";
|
||
$lline="lcpoly$cnt vcpoly$cnt 0 1";
|
||
$bline2="bcpolyb$cnt cpoly$cnt 0 v=";
|
||
$j=1;
|
||
foreach $params (@pms) {
|
||
if(not $first) { $bline2.="+"; }
|
||
$first=0;
|
||
if(not $params eq 0) {
|
||
$tmpparams=$params/$j; # if the name is $params it is evaluated in place !!!!! ( @pms is changed )
|
||
if ($j eq 1) {$bline2.="$tmpparams*v($node1,$node2)";}
|
||
else {
|
||
$bline2.="$tmpparams*v($node1,$node2)^$j";
|
||
}
|
||
}
|
||
$j++;
|
||
}
|
||
if($cc) { # initial conditions present
|
||
$bline2.="+v(vic$cnt)";
|
||
$icline="bic$cnt vic$cnt 0 v=";
|
||
$j=1;
|
||
foreach $params (@pms) {
|
||
if(not $params eq 0) {
|
||
$tmpparams=$params/$j; # if the name is $params it is evaluated in place !!!!! ( @pms is changed )
|
||
if ($j eq 1) {$icline.="-($tmpparams)*$cc";}
|
||
else {
|
||
$icline.="-($tmpparams)*($cc)^$j";
|
||
}
|
||
}
|
||
$j++;
|
||
}
|
||
splice(@deck,$i,1,$gline,$bline1,$lline,$bline2,$icline);
|
||
$i=$i+4;
|
||
}
|
||
else {
|
||
splice(@deck,$i,1,$gline,$bline1,$lline,$bline2);
|
||
$i=$i+3;
|
||
}
|
||
}
|
||
else { # l-device
|
||
$first=1;
|
||
$eline="elpoly$cnt $node1 $node2 vlpoly$cnt 0 1";
|
||
$bline1="blpolya$cnt 0 vlpoly$cnt i=v(lpoly$cnt)";
|
||
$lline="llpoly$cnt vlpoly$cnt 0 1";
|
||
$bline2="blpolyb$cnt lpoly$cnt 0 v=";
|
||
$j=1;
|
||
foreach $params (@pms) {
|
||
if(not $first) { $bline2.="+";}
|
||
$first=0;
|
||
if(not $params eq 0) {
|
||
$tmpparams=$params/$j; # if the name is $params it is evaluated in place !!!!! ( @pms is changed )
|
||
if ($j eq 1) {$bline2.="$tmpparams*i(elpoly$cnt)";}
|
||
else {
|
||
$bline2.="$tmpparams*i(elpoly$cnt)^$j";
|
||
}
|
||
}
|
||
$j++;
|
||
}
|
||
|
||
if($cc) { # initial conditions present
|
||
$bline2.="+v(vic$cnt)";
|
||
$icline="bic$cnt vic$cnt 0 v=";
|
||
$j=1;
|
||
foreach $params (@pms) {
|
||
if(not $params eq 0) {
|
||
$tmpparams=$params/$j; # if the name is $params it is evaluated in place !!!!! ( @pms is changed )
|
||
if ($j eq 1) {$icline.="-($tmpparams)*($cc)";}
|
||
else {
|
||
$icline.="-($tmpparams)*($cc)^$j";
|
||
}
|
||
}
|
||
$j++;
|
||
}
|
||
splice(@deck,$i,1,$eline,$bline1,$lline,$bline2,$icline);
|
||
$i=$i+4;
|
||
}
|
||
else {
|
||
splice(@deck,$i,1,$eline,$bline1,$lline,$bline2);
|
||
$i=$i+3;
|
||
}
|
||
}
|
||
}
|
||
else { # no l-device no c-device -> cannot be true
|
||
print "\nSyntax error on poly line; line must start with literal e,f,g,h or l,c \n" ;exit(1);
|
||
}
|
||
|
||
if($found) { # now generate the b-line from efgh polyline
|
||
$sum="";$product="";$firstsum=1;$firstproduct=1;
|
||
@exp=();
|
||
# zero out all exponentials , element 0 is not touched at all
|
||
for($j = 1 ; $j <= $num_inputs; $j++) {
|
||
$exp[$j]=0;
|
||
}
|
||
if ( $w[0]=~/^[eh]/i) {$sum=$sum."b$w[0] $w[1] $w[2] v=";}
|
||
else {$sum=$sum."b$w[0] $w[1] $w[2] i=";}
|
||
#/* Compute the output of the source by summing the required products */
|
||
########################################################################
|
||
if($coeff[0]) {$sum.="$coeff[0]";$firstsum=0;}
|
||
for($j = 1 ; $j <= $num_coeffs; $j++) {
|
||
# /* Get the list of powers for the product terms in this term of the sum */
|
||
&nxtpwr(\@exp,$num_inputs);
|
||
$firstproduct=1;
|
||
if($coeff[$j]) {# if related p is not zero
|
||
# /* Form the product of the inputs taken to the required powers */
|
||
for($k = 0; $k < $num_inputs; $k++) {
|
||
if($exp[$k+1]) { # if not zero a^0 = 1 not used
|
||
if(not $firstproduct) {$product=$product."*";}
|
||
$firstproduct=0;
|
||
$exp2="";
|
||
if($exp[$k+1]>1) {$exp2="^$exp[$k+1]";} # a^1 = a
|
||
$product.="$inputs[$k]$exp2";
|
||
}
|
||
}
|
||
#/* Add the product times the appropriate coefficient into the sum */
|
||
if(not $firstsum) {$sum=$sum."+";}
|
||
$firstsum=0;
|
||
$firstproduct=1;
|
||
$sum=$sum."$coeff[$j]*$product";
|
||
$product="";
|
||
}
|
||
}
|
||
#########################################################################
|
||
$deck[$i]=$sum; # now replace polyline with equivalent b-line
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
sub nxtpwr # translated from the original spice2 fortran code
|
||
{ # NOTE: pwrseq is a variable by reference
|
||
|
||
local (*pwrseq,$pdim)=@_;
|
||
|
||
my($i,$k,$km1,$psum);
|
||
|
||
if($pdim == 1) {goto stmt80;}
|
||
$k = $pdim;
|
||
stmt10: if($pwrseq[$k]!= 0) {goto stmt20;}
|
||
$k = $k - 1;
|
||
if($k != 0) {goto stmt10;}
|
||
goto stmt80;
|
||
stmt20: if($k == $pdim) {goto stmt30;}
|
||
$pwrseq[$k] = $pwrseq[$k] - 1;
|
||
$pwrseq[$k+1] = $pwrseq[$k+1] + 1;
|
||
return;
|
||
stmt30: $km1 = $k - 1;
|
||
for($i = 1; $i <= $km1; $i++)
|
||
{
|
||
if($pwrseq[$i] != 0) {goto stmt50;}
|
||
}
|
||
$pwrseq[1] = $pwrseq[$pdim] + 1;
|
||
$pwrseq[$pdim] = 0;
|
||
return;
|
||
stmt50: $psum = 1;
|
||
$k = $pdim;
|
||
stmt60: if($pwrseq[$k-1] >= 1) {goto stmt70;}
|
||
$psum = $psum + $pwrseq[$k];
|
||
$pwrseq[$k] = 0;
|
||
$k = $k - 1;
|
||
goto stmt60;
|
||
stmt70: $pwrseq[$k] = $pwrseq[$k] + $psum;
|
||
$pwrseq[$k-1] = $pwrseq[$k-1] - 1;
|
||
return;
|
||
stmt80: $pwrseq[1] = $pwrseq[1] + 1;
|
||
|
||
stmt100: return;
|
||
|
||
}
|
||
|
||
sub funcline_paramline_relational_op {
|
||
my ($i,$j,$found,$relpat,$relpat2,$pat,$left,$right,$leftexpr,$rightexpr,$temp,$searchexp,$replaceexp,$replaceexp2,$lex);
|
||
my ($openp,$closep);
|
||
my @relpats=('<=','>=','<','>','==','!=','&&','||','!'); # never let '<' '>' be before '<=' or '>=' !!!
|
||
my %convert=('<','lt','>','gt','<=','le','>=','ge','==','eq','!=','ne','&&','and','||','or','!','not');
|
||
# $tinylines; if set to 0 every replacing is done to the same b-line
|
||
# if set to 1 splitting each relational op expression into a own b-line
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i]; # current line
|
||
if ( /^\.func/ ) { # search for .funclines , paramlines handled by perl itself
|
||
$j=0;
|
||
foreach $relpat (@relpats) {
|
||
$pat=quotemeta($relpat);
|
||
if($relpat eq '||') {$relpat2='(.*?)'.'(\|\|)'.'(.*)';} # special treatment for ||
|
||
else {
|
||
$relpat2='(.*?)'."($pat)".'(.*)'; # $1=before,$2,$3=behind
|
||
}
|
||
while(/$relpat2/) {
|
||
$right=$3;
|
||
$found=$2;
|
||
$left=$1;
|
||
$j++; # another expression detected
|
||
if($relpat eq '!') {
|
||
$left='';
|
||
}
|
||
else {
|
||
$left=reverse($1);
|
||
}
|
||
$leftexpr='';$rightexpr='';
|
||
if($left) { # the left side is managed first
|
||
# expression may be a numeric , parametername , function , paranthesis exor
|
||
# 0) 3.44>= , 1) par1< , 2) myf(a,b)< , 3) 2*((a)<
|
||
$_=$left;
|
||
s/^\s*//; # no leading blanks
|
||
if(/^([0-9]*\.?[0-9]+(?:[eE][-+]?[0-9]+)?)\b/) { # 0)
|
||
#if(/^([0-9]*\.?[0-9]+(?:[eE][-+]?[0-9]+)?)/) { # 0)
|
||
#if(/^(\d+\.\d+|\d+)/) { # 0)
|
||
$leftexpr=$leftexpr.$1;
|
||
}
|
||
else {
|
||
if(/^(\))/g) { # 2)3)
|
||
$openp=0;$closep=1;
|
||
$leftexpr=$leftexpr.')';
|
||
while($closep>$openp) {
|
||
/(.*?)([\(\)])/g; # search for opend or closed paranthesis
|
||
$leftexpr=$leftexpr.$1.$2;
|
||
if($2 eq ')') {$closep++;}
|
||
else {$openp++;}
|
||
}
|
||
$lex=quotemeta($leftexpr);
|
||
s/$lex//;
|
||
}
|
||
if(/^\s*(\w+)/) { # 1)
|
||
$leftexpr=$leftexpr.$1; # append it
|
||
}
|
||
}
|
||
$leftexpr=reverse($leftexpr);
|
||
}
|
||
$_=$right; # the right side is now managed
|
||
# 0) <=3.444 1) >par1 , 2) <myf(a,b) , 3) >=(2*(a))
|
||
s/^\s*//; # no leading blanks
|
||
if(/^([0-9]*\.?[0-9]+(?:[eE][-+]?[0-9]+)?)\b/) { # 0)
|
||
$rightexpr=$rightexpr.$1;
|
||
}
|
||
else {
|
||
if(s/^(\w+)\s*//g) {$rightexpr=$rightexpr.$1;} # 1)
|
||
if(/^(\()/g) { # 2)3)
|
||
$openp=1;$closep=0;
|
||
$rightexpr=$rightexpr.'(';
|
||
while($openp>$closep) {
|
||
/(.*?)([\(\)])/g; # search for opend or closed paranthesis
|
||
$rightexpr=$rightexpr.$1.$2;
|
||
if($2 eq ')') {$closep++;}
|
||
else {$openp++;}
|
||
}
|
||
}
|
||
}
|
||
$temp=$convert{$relpat};
|
||
if($left) {
|
||
$searchexp=quotemeta($leftexpr.$relpat.$rightexpr);
|
||
$replaceexp=$temp.'('.$leftexpr.','.$rightexpr.')';
|
||
}
|
||
else {
|
||
$searchexp=quotemeta($relpat.$rightexpr);
|
||
$replaceexp=$temp.'('.$rightexpr.')';
|
||
}
|
||
$deck[$i] =~ s/$searchexp/$replaceexp/; # writeback to the same line !!!!!
|
||
$_=$deck[$i]; # reinit it
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
sub b_device_relational_op { # new new new new new new
|
||
my ($i,$j,$bname,$found,$relpat,$relpat2,$pat,$left,$right,$leftexpr,$rightexpr,$temp,$searchexp,$replaceexp,$replaceexp2,$lex);
|
||
my ($openp,$closep);
|
||
my @relpats=('<=','>=','<','>','==','!=','&&','||','!'); # never let '<' '>' be before '<=' or '>=' !!!
|
||
my %convert=('<','lt','>','gt','<=','le','>=','ge','==','eq','!=','ne','&&','and','||','or','!','not');
|
||
# $tinylines; if set to 0 every replacing is done to the same b-line
|
||
# if set to 1 splitting each relational op expression into a own b-line
|
||
if($xornot) {
|
||
$relpats[9]='~'; # ~
|
||
$relpats[10]='^'; # ^
|
||
$convert{'~'}='not';
|
||
$convert{'^'}='xor';
|
||
}
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i]; # current line
|
||
if ( /^b(\w*)/ ) { # search for b[name]
|
||
$bname=$1;
|
||
if($ltspice) {
|
||
s/\^/\*\*/g;
|
||
}
|
||
else {
|
||
$deck[$i]=~s/\*\s*\*/\^/g; # a**b or a * *b
|
||
}
|
||
$j=0;
|
||
foreach $relpat (@relpats) {
|
||
$pat=quotemeta($relpat);
|
||
if($relpat eq '||') {$relpat2='(.*?)'.'(\|\|)'.'(.*)';} # special treatment for ||
|
||
else {
|
||
$relpat2='(.*?)'."($pat)".'(.*)'; # $1=before,$2,$3=behind
|
||
}
|
||
while(/$relpat2/) {
|
||
$right=$3;
|
||
$found=$2;
|
||
$left=$1;
|
||
$j++; # another expression detected
|
||
if($relpat eq '!' || $relpat eq '~') {
|
||
$left='';
|
||
}
|
||
else {
|
||
$left=reverse($left);
|
||
}
|
||
$leftexpr='';$rightexpr='';
|
||
if($left) { # expression may be a numeric , parametername , function , voltage or current , paranthesis
|
||
# 0) 4.224e12>= 1) par1< , 2) myf(a,b)< , 3) v(a,b)> , 4) 2*((a)<
|
||
$_=$left; # the left side is managed
|
||
s/^\s*//; # no leading blanks
|
||
if(/^([0-9]*\.?[0-9]+(?:[eE][-+]?[0-9]+)?)\b/) { # 0)
|
||
$leftexpr=$leftexpr.$1;
|
||
}
|
||
else {
|
||
if(/^(\))/g) { # 2)3)4)
|
||
$openp=0;$closep=1;
|
||
$leftexpr=$leftexpr.')';
|
||
while($closep>$openp) {
|
||
/(.*?)([\(\)])/g; # search for opend or closed paranthesis
|
||
$leftexpr=$leftexpr.$1.$2;
|
||
if($2 eq ')') {$closep++;}
|
||
else {$openp++;}
|
||
}
|
||
$lex=quotemeta($leftexpr);
|
||
s/$lex//;
|
||
}
|
||
if(/^\s*(\w+)/) { # 1)
|
||
$leftexpr=$leftexpr.$1; # append it
|
||
}
|
||
}
|
||
$leftexpr=reverse($leftexpr);
|
||
}
|
||
$_=$right; # the right side is now managed
|
||
# 1) >par1 , 2) <myf(a,b) , 3) <v(a,b) , 4) <(2*(a))
|
||
s/^\s*//; # no leading blanks
|
||
if(/^([0-9]*\.?[0-9]+(?:[eE][-+]?[0-9]+)?)\b/) { # 0)
|
||
$rightexpr=$rightexpr.$1;
|
||
}
|
||
else {
|
||
if(s/^(\w+)\s*//) {$rightexpr=$rightexpr.$1;} # 1)
|
||
if(/^(\()/g) { # 2)3)4)
|
||
$openp=1;$closep=0;
|
||
$rightexpr=$rightexpr.'(';
|
||
while($openp>$closep) {
|
||
/(.*?)([\(\)])/g; # search for opend or closed paranthesis
|
||
$rightexpr=$rightexpr.$1.$2;
|
||
if($2 eq ')') {$closep++;}
|
||
else {$openp++;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
$temp=$convert{$relpat};
|
||
if($left) {
|
||
$searchexp=quotemeta($leftexpr.$relpat.$rightexpr);
|
||
$replaceexp=$temp.'('.$leftexpr.','.$rightexpr.')';
|
||
# if tinylines
|
||
$replaceexp2 = 'v(b'.$bname."_".$temp.$j.')';
|
||
}
|
||
else {
|
||
$searchexp=quotemeta($relpat.$rightexpr);
|
||
$replaceexp=$temp.'('.$rightexpr.')';
|
||
# if tinylines
|
||
$replaceexp2 = 'v(b'.$bname."_".$temp.$j.')';
|
||
}
|
||
if($tinylines) {
|
||
$deck[$i] =~ s/$searchexp/$replaceexp2/; # split into another b-line !!!!!
|
||
splice(@deck,$i+1,0,"b$bname"."_"."$temp$j b$bname"."_"."$temp$j 0 v=$replaceexp");
|
||
}
|
||
else {
|
||
$deck[$i] =~ s/$searchexp/$replaceexp/; # writeback to the same line !!!!!
|
||
}
|
||
$_=$deck[$i]; # reinit it
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
sub table2bh {
|
||
my ($i,$n,$m,$lenbh,$name,$type,$pos,$neg,$expr);
|
||
my (@x,@y,@bh,@kill);
|
||
|
||
for ($i=1;$i<@deck;$i++) { # for whole deck
|
||
$_=$deck[$i];
|
||
if (m/^([efgh])/i ) { # efgh-source
|
||
if(m/table/i) { # efgh-table source
|
||
$m=-1;@bh=();@x=();@y=();
|
||
@kill=(); # reset it
|
||
m/^([efgh])([^\s]+)\s+([^\s]+)\s+([^\s]+)\s+table[^\{]*\{([^\}]+)\}\s*\=(.*)/i; # name pos neg table {expr} = (,) (,)
|
||
$type = $1;$name = $2;$pos = $3;$neg = $4;$expr = $5;
|
||
$_ = $6;
|
||
while ( m/\(([^,]+),([^\)]+)\)(.*)/i ) {
|
||
$m++;
|
||
$x[$m]=$1;
|
||
$y[$m]=$2;
|
||
$_ = $3; # rest
|
||
}
|
||
# shure is shure last table value extended 100 times
|
||
#$m++;
|
||
#$x[$m]=$x[$m-1]+$x[$m-1]*100;
|
||
#$y[$m]=$y[$m-1];
|
||
# now everything is extracted and the vars are stored
|
||
# ================ generate new lines for b-table
|
||
$bh[0]= "* conversion of pspice table to xspice - core model";
|
||
$bh[1]= "b1g"."$type$name "." xg"."$type$name"." 0 v=".$expr;
|
||
$bh[2]= "a1g"."$type$name "." xg"."$type$name"." yg"."$type$name"." table_g"."$type$name";
|
||
$bh[3]= "v1g"."$type$name "." yg"."$type$name"." 0 0";
|
||
if($type eq "e" || $type eq "h") {
|
||
$bh[4]= "h1g"."$type$name "." ".$pos." ".$neg." v1g"."$type$name"." 1";
|
||
}
|
||
else {
|
||
$bh[4]= "f1g"."$type$name "." ".$pos." ".$neg." v1g"."$type$name"." 1";
|
||
}
|
||
$bh[5]= ".model table_g"."$type$name "." core area=1 length=1 h_array=[ ";
|
||
#first value is special
|
||
$bh[5].="-1.0e12 ";
|
||
for ($n=0;$n<=$m;$n++) {
|
||
$bh[5] .= $x[$n]." ";
|
||
#if (n<m) {$bh[5] .= ","; }
|
||
}
|
||
# last value is special
|
||
$bh[5].=" 1e12";
|
||
$bh[5] .= " ] b_array=[ ";
|
||
#first value is special
|
||
$bh[5].=$y[0]." ";
|
||
for ($n=0;$n<=$m;$n++) {
|
||
$bh[5] .= $y[$n]." ";
|
||
#if (n<m) {$bh[5] .= ","; }
|
||
}
|
||
# last value is special
|
||
$bh[5].=" ".$y[$m];
|
||
$bh[5] .= " ]";
|
||
$bh[6] = "* conversion end";
|
||
# ================ ende generiere neue Zeile f<>r b-table
|
||
push @kill,$i;
|
||
splice(@deck,$i+1,0,@bh); # insert new lines forb-table started with act. i
|
||
&zapdeck(@kill); # delete line gname pos neg ....
|
||
$lenbh=@bh;
|
||
$i=$i+$lenbh-1;
|
||
} # no table
|
||
} #no efgh-source
|
||
} #next i
|
||
}
|
||
sub table2bh_spice3 {
|
||
my ($i,$n,$m,$p,$q,$lasti,$name,$type,$pos,$neg,$expr,$lenall);
|
||
my (@x,@y,@all,@bh,@pmx,@pmy,@pmk,@pmd,@kill,$cntxy,$cntex);
|
||
|
||
# reset conter for spice3-table sources
|
||
$cntxy=0;$cntex=0;
|
||
@kill=();
|
||
|
||
for ($i=1;$i<@deck;$i++) { # for whole deck
|
||
$_=$deck[$i];
|
||
if (m/^(g|f|h|e)/i ) { # g-source
|
||
if(m/table/i) { # new gfhe-table detected
|
||
#init
|
||
$lasti=$i; # position of the last table source
|
||
@kill=();@all=();$m=-1;@bh=();@x=();@y=();@pmx=();@pmy=();@pmk=();@pmd=();
|
||
m/^(g|f|h|e)([^\s]+)\s+([^\s]+)\s+([^\s]+)\s+table[^\{]*\{([^\}]+)\}\s*\=(.*)/i; # name pos neg table {expr} = (,) (,)
|
||
$type = $1;$name = $2;$pos = $3;$neg = $4;$expr = $5;
|
||
$_ = $6;
|
||
while ( m/\(([^,]+),([^\)]+)\)(.*)/i ) { # reads in x,y pairs
|
||
$m++;
|
||
$x[$m]=$1;
|
||
$y[$m]=$2;
|
||
$_ = $3; # rest
|
||
}
|
||
# now everything is extracted and the vars are stored
|
||
# ================ generate new lines for b-table
|
||
$q=0;
|
||
for ($n=$cntxy;$n<=($m+$cntxy);$n++) { # x,y pairs as parameters
|
||
$pmx[$q]=".param x".$n."="."$x[$q]";
|
||
$pmy[$q]=".param y".$n."="."$y[$q]";
|
||
$q++;
|
||
}
|
||
$q=0;
|
||
for ($n=$cntxy;$n<($m+$cntxy);$n++) { # k,d formula as parameter ( nr. of x,y-pairs - 1 )
|
||
$pmk[$q]=".param k".$n."={(y".($n+1)."-y".$n.")/(x".($n+1)."-x".$n.")}";
|
||
$pmd[$q]=".param d".$n."={y".$n."-k".$n."*x".$n."}";
|
||
$q++;
|
||
}
|
||
$bh[0]= "* conversion of pspice table to spice3 bsource model start ... ";
|
||
# all parameters !!!!!!
|
||
$bh[1]= "b$type"."ex".$name." ex".$cntex." 0 v=".$expr; # one expression line
|
||
$q=2;
|
||
# first line is special
|
||
# bx0y0 x0y0 0 v=LT(v(ex1),x0)*d0
|
||
$n=$cntxy;
|
||
$bh[$q]="b$type"."x".$n."y".$n." x".$n."y".$n." 0 v=lt(v(ex".$cntex."),x".($n).")*".$y[0];
|
||
$q=3;
|
||
for ($n=($cntxy);$n<=($m+$cntxy-1);$n++){ # one b-source line for one x,y pair !!!
|
||
# bx1y1 x1y1 0 v=GE(v(ex1),x0)*LT(v(ex1),x1)*(k0*v(ex1)+d0)
|
||
# bx2y2 x2y2 0 v=GE(v(ex1),x1)*LT(v(ex1),x2)*(k1*v(ex1)+d1)
|
||
# .....
|
||
$bh[$q]="b$type"."x".($n+1)."y".($n+1)." x".($n+1)."y".($n+1)." 0 v=ge(v(ex".$cntex."),x".$n.")*lt(v(ex".$cntex."),x".($n+1).")*(k".$n."*v(ex".$cntex.")+d".$n.")";
|
||
$q++;
|
||
}
|
||
# last line is special
|
||
# bx8y8 x8y8 0 v=GE(v(ex1),x8)*d7
|
||
$n=$m+$cntxy+1;
|
||
$bh[$q]="b$type"."x".$n."y".$n." x".$n."y".$n." 0 v=ge(v(ex".$cntex."),x".($n-1).")*".$y[$m];
|
||
$q++;
|
||
if($type eq "e" || $type eq "h") { # ouputline prefix = v or i
|
||
$bh[$q]= "b$type".$name." ".$pos." ".$neg." v=";
|
||
}
|
||
else { # f and g source -> ouput = i
|
||
$bh[$q]= "b$type".$name." ".$pos." ".$neg." i=";
|
||
}
|
||
for ($n=$cntxy;$n<=($m+$cntxy+1);$n++) { # one output line = sum of all ouputs
|
||
$bh[$q].="v(x".$n."y".$n.") +"; # append v(xn,yn) + .....
|
||
}
|
||
chop($bh[$q]); # eats last +
|
||
$bh[($q+1)] = "* table conversion end.";
|
||
# ================ ende generiere neue Zeile f<>r b-table
|
||
push(@all,@pmx);push(@all,@pmy);push(@all,@pmk);push(@all,@pmd);push(@all,@bh);
|
||
push @kill,$i;
|
||
if(@kill) {
|
||
&zapdeck(@kill); # delete line gname pos neg ....
|
||
splice(@deck,$lasti,0,@all); # insert new lines for b-table(s) started with act. i
|
||
}
|
||
$cntxy+=$m+2; # update counter for nr. of x,y pairs to handle another table model
|
||
$cntex++; # update counter for nr. of table models
|
||
$lenall=@all;
|
||
$i=$i+$lenall-1;
|
||
} # end if table
|
||
} # end if efgh-source
|
||
} #end for i
|
||
}
|
||
sub time2vtime {
|
||
my ($i,$tmp,$x3,$x2,$uic,$steptime);
|
||
my (@time,@tranline);
|
||
|
||
@time=();
|
||
$x3=0; # starttime=0 default
|
||
for ($i=1;$i<@deck;$i++) { # for whole deck
|
||
$_=$deck[$i];
|
||
if (m/^\.tran/i) { # .tran tstep tstop tstart minstep [uic]
|
||
if(s/\buic\b//) {$uic="uic";}
|
||
else {$uic="";} # delete additional "uic" statement if present
|
||
@tranline=split( /\s+/,$_);
|
||
if($#tranline<2) { # only endtime given .tran tstop
|
||
$x2= &unit($tranline[1]); # stoptime
|
||
$steptime = $x2/20; # default
|
||
$deck[$i]=".tran $steptime $x2 $uic"
|
||
}
|
||
else { # .tran tstep tstop
|
||
$x2 = &unit($tranline[2]); # stoptime
|
||
if($#tranline>2) { # .tran tstep tstop tstart ...
|
||
$x3 = &unit($tranline[3]); } # starttime given (default=0s)
|
||
}
|
||
$time[0]="vtime times 0 pwl ".$x3."s ".$x3."v ".$x2."s ".$x2."v dc 0";
|
||
splice(@deck,$i,0,@time);
|
||
return; # we are now done
|
||
}
|
||
}
|
||
}
|
||
|
||
#read_parameters ( read in parameter defined lines e.g: .param a=4 b={a*3} c=3*myfunc(2*3) .... and delete them)
|
||
sub read_parameters {
|
||
my ($i,$j,@kill,$temp1,$temp2);
|
||
#################### new ###################
|
||
#%param=(); # is a global variable !!!!
|
||
for ($i=1;$i<@deck;$i++) { # whole inputdeck $deck [0] [1] ... a.s.o all Inputlines
|
||
if ($deck[$i] =~/\.param\s+(.*)/) { # record param/value pairs ; search for .param statement $1 = rest
|
||
push @kill,$i;
|
||
$_=$1;
|
||
$done=0;
|
||
until ($done) {
|
||
if (/^\s*(\S+)\s*\=\s*\{([^\}]*)\}(.*)/) { # search for VAR = { Expression }
|
||
# $1 = Variable $2 = { .... } $3 = Rest
|
||
$_=$2;
|
||
$temp1 = $1;
|
||
$temp2 = $3;
|
||
# now all parameternames should be space delimited
|
||
$param{$temp1}=$_; # stores param to hash
|
||
$_=$temp2; # is another param present ?
|
||
}
|
||
elsif (/^\s*(\S+)\s*\=\s*(\S+)(.*)/) { # search for Var = value ( $1 = Var , $2 = num. Value, $3 is rest )
|
||
$param{$1} = &unit($2); # stores param to hash , convert m,u,p,f,k,MEG,t, ....
|
||
$_=$3; # is another param present ?
|
||
}
|
||
else { $done=1; }
|
||
}
|
||
}
|
||
}
|
||
&zapdeck(@kill);
|
||
}
|
||
|
||
# evaluates RHS (right hand side) of parameter definitions to a pure numerical value
|
||
# .param b = {a/4} -> subs a with numerical value and eval b
|
||
sub eval_parameters {
|
||
my ($val, $nval, $paramkeys);
|
||
|
||
$param{"time"}="0"; # only param with notnumerical val
|
||
|
||
for $paramkeys (keys %param) { # for all param in list do
|
||
$val=$param{$paramkeys}; # paramval e.g. 3 * a + 5 * b + c
|
||
if(&isnumber($val)) {}
|
||
else
|
||
{
|
||
$nval=&process($val); # eval the expression now
|
||
if(!defined($nval)) {
|
||
print "\n\nerror -> paramname: $paramkeys value: $val\n";
|
||
&hint;
|
||
exit(1);
|
||
}
|
||
$param{$paramkeys}=$nval; # write back pure numerical to parameterhash
|
||
}
|
||
}
|
||
$param{"time"}="V(TIMES)"; # only param with notnumerical val
|
||
}
|
||
|
||
# search for parameternames in all lines of the deck
|
||
# b - lines -> search/replace parameternames -> eval is done by spice itself
|
||
# all other lines -> search/replace/eval if parameterexpression with paranthesis present e.g. { p1+2*p2+5 } -> val
|
||
sub expand_parameters {
|
||
|
||
my ($i,$j,$start,$nline,@line,@start,$val,$key,$nstart);
|
||
my ($head,$temp,$nval,$tail);
|
||
|
||
for ($i=1;$i<@deck;$i++) { # for whole deck
|
||
$_=$deck[$i];
|
||
if(m/^b/) { # b-line
|
||
@line=split(/\s+/,$deck[$i]);
|
||
@start=splice(@line,0,3); # @start = "b1 1 0 " = the first 3 items are not parametersubstituted
|
||
# @line->$nline -> ready for parametersubstitution
|
||
$nstart=join " ",@start;
|
||
$nline=join " ",@line;
|
||
# search and replace parameters in b-lines ( dont replace nodenames and vsrcnames v(name[,name]),i(vsrcname) )
|
||
foreach $key (keys %param) {
|
||
$val=$param{$key};
|
||
$key=quotemeta($key);
|
||
# if v(node1,(node2)) or i(vnam) -> convert to upper case
|
||
$nline=~s/(\b[vi]\s*\([^\)]+\))/uc($1)/eg; #search v(x) or i(x) and replace with upper case letters
|
||
$nline=~s/\b$key\b/$val/g; # case sensitive substitiution -> only lowercase
|
||
#$nline=lc($nline); # for better appearance no lower case again
|
||
}
|
||
# do some hacks for b-lines
|
||
$nline =~ s/\s+//g; # delete blanks in expression from subcktexpansion
|
||
$nline =~ s/\*\*/\^/g; # search for ** and subs with ^
|
||
$nline.="+v(0)"; # add v(0) will prevent some simulators to come away with fixvalued b-sources
|
||
$deck[$i]=$nstart." ".$nline; # write back
|
||
}
|
||
elsif (m/\{/) { # r,l,c,... one expr
|
||
# .model .tran .dc ... maybe one or more {expr} present in line
|
||
$nline="";
|
||
while (/([^\{]*)\{([^\}]*)\}(.*)/) {
|
||
# parameterexpr with { } present in deviceline
|
||
$head=$1; $tail=$3;
|
||
$temp=$2;
|
||
$nval=&process($temp);
|
||
if(!defined($nval)) {
|
||
print "\n\n..... $deck[$i-1]\n";
|
||
print "error -> line: $i -> $deck[$i]\n";
|
||
print "..... $deck[$i+1]\n";
|
||
&hint;
|
||
exit(1);
|
||
}
|
||
$nline .= $head.$nval;
|
||
$_=$tail; # perhaps another param in line ?
|
||
}
|
||
$nline .= $_; # rest
|
||
$deck[$i]=$nline; # write back
|
||
}
|
||
else {} # do nothing -> this line has no parameters
|
||
}
|
||
}
|
||
# process rhs of .param expressions to a pure numerical values
|
||
# e.g. rhs = 3*a+5/b replace a,b with their numerical value (or other expression->recursively) unitl
|
||
# rhs is a expression with pure numerical values -> then eval the expression
|
||
# The detection is done by always make one additonal loop with all parameternames
|
||
# If a whole loop's search/replace count is zero ($found=0) -> the line should now be a pure numerical value or expression
|
||
# e.g. rhs = 3*(2*(4+5)+5/(2*(3+5)))
|
||
sub process {
|
||
my ($nline,$r,$i,$n,$found);
|
||
|
||
$nline = $_[0];
|
||
$found=1;
|
||
|
||
while ($found>=1)
|
||
{ # while another parameter present - nested
|
||
$found=0;
|
||
foreach $key (keys %param)
|
||
{
|
||
$val=$param{$key};
|
||
$key=quotemeta($key);
|
||
$found+=$nline=~s/\b$key\b/\($val\)/g; #search and replace it "NOTE: set $val in paranthesis !!!!!!!!"
|
||
}
|
||
}
|
||
$nline =~ s/\s+//g; # perl eval dont like blanks in expressions -> delete them
|
||
$nline =~ s/--/+/g; # perl eval dont want -- in expressions -> substitute it by +
|
||
# sometimes pspice users use spiceunits in expressions {frequ1/n2*1u}->{50/2*1u}->{50*2*1e-006}
|
||
$nline =~ s/\b([0-9\.]+(t|g|meg|k|mil|m|u|n|p|f)(v|a|s|f|ohm|h|w|hz|va)?)\b/unit($1)/eg;
|
||
# sometimes pspice users use nested {} inside {}'s -> error
|
||
$nline = "1.0*(".$nline.")"; # helps perl to treat it as numeric !!!!
|
||
$r=eval($nline); # TEST: Evaluates pure numerical expression ( e.g. a is "2*3" and b is "3*a+2" -> b=3*(2*3)+2 -> b=20 )
|
||
if($@) {
|
||
print "\nerror evaluating expression expr: \n\n$nline : $@ -> please check\n\n";
|
||
}
|
||
return ($r); # returns only numerical val. or undef
|
||
}
|
||
|
||
sub hint {
|
||
print "\nHINTs: If you detect curly braces in the expression: -> because of nested curly braces in the cirfile ";
|
||
print "\n find and substitute all inner curly braces through round braces\n";
|
||
print "\n If the error says : Division by zero:";
|
||
print "\n This may occur in .param lines in conjunction with the if() function ";
|
||
print "\n e.g: .param b=10 a={IF(b,0,bn)} c={1/a}";
|
||
print "\n Search the bad term and add a very small value to it (1/a) -> (1/(a+eps))";
|
||
print "\n Add the line .param eps=1e-20 to the cirfile\n";
|
||
print "\n Try the ps2sp command line option -check -debug";
|
||
print "\n to check the equal nr. of open and closed paranthesis per line and";
|
||
print "\n to output the values of all parameters and functions\n";
|
||
print "\n Check also the intermediate outputfiles lib.tmp and sub.tmp";
|
||
print "\n lib.tmp shows the original file and the additional external subcircuits included from .lib lines";
|
||
print "\n sub.tmp shows the subcircuitexpansion with unique parameter and function names";
|
||
}
|
||
|
||
############## read globals ############
|
||
# record a hash of all global signals. kill the line.
|
||
sub read_globals {
|
||
my ($i,$file,$model,@kill);
|
||
for ($i=0;$i<@deck;$i++) {
|
||
if ($deck[$i] =~ /^\.globals?\s+(.*)/) {
|
||
for (split(' ',$1)) { $globals{$_}=1 }
|
||
push @kill,$i;
|
||
}
|
||
}
|
||
&zapdeck(@kill);
|
||
}
|
||
############## kill line(s) in deck ################
|
||
sub zapdeck {
|
||
# give it a list of lines to remove in increasing order!!!
|
||
# @_ = e.g. 0 1 2 3 -> $_=pop(@_)=3 now @_= 0 1 2
|
||
while ($_=pop(@_)) {
|
||
splice @deck,$_,1;
|
||
}
|
||
}
|
||
################## 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_globals{
|
||
my ($i,$extras,$subckt);
|
||
|
||
$extras=join(" ", keys %globals);
|
||
|
||
for ($i=1;$i<@deck;$i++) {
|
||
$_=$deck[$i];
|
||
if (/^\.subckt\s+(\S+)/) {
|
||
$deck[$i] =~ s/^(.subckt.*)$/$1 $extras/;
|
||
}
|
||
elsif (/^(x.*)\s+(\S+)\s*$/) {
|
||
$deck[$i]="$1 $extras $2\n";
|
||
}
|
||
}
|
||
}
|
||
|
||
|
||
####################### control codes #########################
|
||
# .tran xxx -> .control tran xxx .endc
|
||
# .op xxx -> .control op xxx .endc
|
||
# .dc , four , endi , plot , print detto !!!!
|
||
sub expand_control {
|
||
my ($i,@xtra);
|
||
for ($i=1;$i<@deck;$i++) {
|
||
$deck[$i]=~s/^\.backanno/\*\.backanno/i; # new for ltspice
|
||
#$deck[$i]=~s/^\!//; # new for allowing conversion of *$ -> ! controllines
|
||
$_=$deck[$i];
|
||
if (/^\.(plot|print|tran|ac|dc|op|four|endi)\b/) { # this things will be put under .control .... .endc
|
||
$cmd=$1;
|
||
s/^\.//; # drop initial dot
|
||
s/\stran\s/ /; # "print tran " -> "print "
|
||
s/start=\S+//; # "hspice syntax ? in tranline ? "
|
||
s/([vi])\s*\(\s*(\S+)\s*\)/$1($2)/ig; # i ( vx ) -> i(vx) and v ( 1 ) -> v(1)
|
||
push(@xtra, ".control");
|
||
if ($cmd eq "endi") {
|
||
push(@xtra, "destroy all" ) unless ($interactive);
|
||
push(@xtra, "quit") unless ($interactive);
|
||
}
|
||
else {
|
||
push(@xtra, $_); # this is the line
|
||
}
|
||
push(@xtra, ".endc");
|
||
splice(@deck,$i,1,@xtra);
|
||
@xtra=();
|
||
}
|
||
}
|
||
}
|
||
|
||
sub fix_temp {
|
||
for ($i=1;$i<@deck;$i++) {
|
||
if ($deck[$i] =~ /^\.tempe?r?a?t?u?r?e?\s*\=\s*(\S+)/)
|
||
{
|
||
$deck[$i] = ".options temp=$1";
|
||
splice(@deck,$i+1,0,".param temp=$1");
|
||
$i++;
|
||
}
|
||
if ($deck[$i] =~ /^\.options\s+temp\s*\=\s*(\S+)/)
|
||
{
|
||
splice(@deck,$i+1,0,".param temp=$1");$i++;
|
||
}
|
||
|
||
}
|
||
}
|
||
################# translate model level #######
|
||
# bsim3 (v3)
|
||
sub xlat_level {
|
||
for ($i=1;$i<@deck;$i++) {
|
||
$deck[$i] =~ s/(.*)\blevel\s*=\s*49\b(.*)/$1level=8$2/;
|
||
}
|
||
}
|
||
sub printdeck {
|
||
my ($last);
|
||
$last=pop(@deck); # last element remembered
|
||
push @deck,@probe; # add probelines
|
||
if(@control) {
|
||
push @deck,".control";
|
||
push @deck,@control; # add controllines
|
||
push @deck,".endc";
|
||
}
|
||
push @deck,$last; # now last again
|
||
for (@deck) {
|
||
if($_=~/^\*/) { # if the line is a commentline start wraped line with *
|
||
print &wrapline($wrap,"","*","\n"," ",split(' ',$_));
|
||
}
|
||
else {
|
||
print &wrapline($wrap,"","+","\n"," ",split(' ',$_));
|
||
}
|
||
}
|
||
}
|
||
sub fprintdeck {
|
||
my $first;
|
||
open (DATEI,"+>$dateiname") || die "Fehler beim Schreiben auf DATEI $dateiname";
|
||
$first=1;
|
||
for (@deck) {
|
||
if($_=~/^\*/) { # if the line is a commentline start wraped line with *
|
||
print DATEI &wrapline($wrap,"","*","\n"," ",split(' ',$_));
|
||
}
|
||
else {
|
||
print DATEI &wrapline($wrap,"","+","\n"," ",split(' ',$_));
|
||
}
|
||
}
|
||
close (DATEI);
|
||
}
|
||
######################### 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 {
|
||
my($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;
|
||
}
|
||
# search for integer , float or exponential number
|
||
sub isnumber {
|
||
#if ($_[0] =~ /^\s*[\+\-]?[0-9\.]+\s*$/)
|
||
if ($_[0] =~ /^\s*[\+\-]?[0-9\.]+(t|g|meg|k|mil|m|u|n|p|f)?(v|a|s|f|ohm|h|w|hz|va)?\s*$/)
|
||
{return 1;}
|
||
elsif ($_[0] =~ /^\s*[\+\-]?[0-9\.]+e[\+\-]?\d+$/)
|
||
{return 1;}
|
||
else
|
||
{return 0;}
|
||
}
|
||
# search for expression in paranthesis -> { ... }
|
||
sub isexpression {
|
||
if ($_[0] =~ /^\s*\{.*?\}\s*$/)
|
||
#if ($_[0] =~ /[\{\}]/)
|
||
{return 1;}
|
||
else
|
||
{return 0;}
|
||
}
|
||
# 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 {
|
||
my ($i,$n,$orig,$iname,$dname,$j);
|
||
for ($i=1;$i<@deck;$i++) {
|
||
if ($deck[$i] =~ /\s*m\s*\=\s*(\d+)\s*$/) {
|
||
$n=$1;
|
||
$_=$deck[$i];
|
||
s/ m\s*=\s*($n)//; # remove the m=xx
|
||
/^(\S+)\s/;
|
||
$iname=$1;
|
||
$deck[$i]=$_;
|
||
$orig=$_;
|
||
for ($j=2;$j<=$n;$j++) {
|
||
$_=$orig;
|
||
$dname=$iname . "__" . $j;
|
||
s/$iname/$dname/;
|
||
splice(@deck,$i+$j-1,0,$_);
|
||
}
|
||
}
|
||
}
|
||
}
|
||
# unit to number
|
||
# expressions may have suffix v,a,s,f,ohm,h,w,hz,va
|
||
sub unit {
|
||
if ($_[0] =~ /^([0-9e\+\-\.]+)(t|g|meg|k|mil|m|u|n|p|f)?(v|a|s|f|ohm|h|w|hz|va)?$/) {
|
||
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 }
|
||
return $1 * $mult;
|
||
}
|
||
return $_[0]; # maybe perl does it better??
|
||
}
|
||
# FOR SUBCIRCUIT expansion:
|
||
# when substituting parameters , skip this number from the start
|
||
# e.g. r1 1 0 {R} skipnr = 3 param is in field nbr. 3 ( three fields skipped )
|
||
sub skipnumber {
|
||
my ($line,$f,$n,$len,@words);
|
||
$line=$_[0];
|
||
$_=substr($line,0,1); # get the first char in the line
|
||
$n=tr/bcdefghijklmoqrstuvw/22222222322443244323/; # element nodes list of skipped fields-1
|
||
if ($n == 1) { # found one of the devices above
|
||
return $_+1; # add the name of the instance to the number of nodes
|
||
}
|
||
$len=@words=split(' ',$line);
|
||
$first=shift(@words);
|
||
if ($first =~ /^x/) { return 2 } # process this line starting at second element
|
||
if ($first =~ /^\+/) { return 0 } # full process of continuation lines
|
||
if ($first =~ /^\.model/) { return 3 } # process this line .. -> only process {expressions}
|
||
{ return $len } # all other lines are not processed
|
||
}
|
||
# Get a line from the input file, combining any continuation lines into
|
||
# one long line. Skip comment and blank lines.
|
||
# first line is not skipped
|
||
sub prm_getline {
|
||
my($line);
|
||
my($firstline);
|
||
# local($nxtline);
|
||
# $linenum is used for debugging
|
||
# $line = if not defined $nxtline -> first invocation ($linenum=1) $line=<INFILE> else $line=$nxtline
|
||
chop($line = defined($nxtline) ? $nxtline : <INFILE>);
|
||
$linenum = $.; # act. linenumber
|
||
if( not $linenum eq 1 )# new detect first line !! )
|
||
{
|
||
while ($nxtline = <INFILE>) {
|
||
if ($line =~ /^\*|^\s/) { $line = ''; } # documentation line * TEXT
|
||
$_ = $line; # NEW ########################## use of ";" for inline comment
|
||
s/\;.*//;
|
||
$line = $_;
|
||
if ($line eq '' || $nxtline =~ s/^(\+)/ /) { # blanc line deleted , continuation with +
|
||
chop($nxtline); # Cr deleted
|
||
$line .= $nxtline; # and concatanated again at the end
|
||
}
|
||
else { last; }
|
||
}
|
||
}
|
||
$line;
|
||
}
|
||
# Scan the input file looking for x-calls with parameters , remove and store the parameters
|
||
# Also look for subcircuits with defined parameters , store it
|
||
# inside a subckt store parameters and .param .func .pfunc -lines
|
||
sub prm_scan {
|
||
my(@w, @tmp, @list);
|
||
my($xnm, $subnm, $psubnm,$i, $m, $s, $n, $tmp,$tmp2, $start,$linestart,$tmpline,$hasprm,$prmline);
|
||
my($sublist) = '';
|
||
|
||
$max = 0; # global unique identifier for all x-lines with parameters in the circuit
|
||
$depth=0; # global deepth counter
|
||
|
||
PRM_SCAN:
|
||
while ($_ = &prm_getline) { # get new inputline, + lines are flattend
|
||
if (/^\.control/i) { # skip from .control to .endc
|
||
while ($_ = &prm_getline) { next PRM_SCAN if (/^\.endc/i); } # till .endc
|
||
}
|
||
tr/A-Z/a-z/; # convert line $_ to lowercase
|
||
PRM_TST:{
|
||
if (/^x/ && s/params:(.*)//) { # test if "x..." Line with parameter subs /params: ..../ with //
|
||
$prmline=$1; # NOTE: $_ = xname 0 1 subname $1 -> a=5 b={3*a} ...
|
||
$max++; # increase unique identifier for this x-line
|
||
$ref_prmval=0;
|
||
@w = split(' '); # conversion of $_ ( xname 0 1 subname ) to array - delimiter is blanc by default
|
||
$linestart = join(' ',@w[0 .. $#w-1]); # ( xname 0 1 )
|
||
|
||
$subnm = $w[$#w]; # subname is last Index
|
||
$subnm = $subnm.$spf.$max; # subname_N
|
||
|
||
$xnm = $w[0].$sublist; # xname is first index ( add $sublist if x-line is a call from inside a subckt )
|
||
if($depth) {$subcall_sub{$xnm} = $subnm;}
|
||
else {$subcall_root{$xnm} = $subnm;}
|
||
|
||
|
||
$tmpline=$_; # memorize $_
|
||
$ref_prmval=read_subckt_params($ref_prmval,$prmline); # get params and store it in %prmval
|
||
$sub{$subnm} = $ref_prmval; # unique params for this x-line saved here
|
||
if($depth) {
|
||
push(@list,$linestart." ".$subnm); # if x-line inside subckt -> add it to the actual subcktlist
|
||
}
|
||
last PRM_TST;
|
||
}
|
||
if (/^\.subckt\s+(\w+)/) {
|
||
$ref_prmval=0;$ref_pprmval=0;$ref_funcprmval=0;$ref_pfuncprmval=0; # reset references
|
||
$psubnm=$1; # .subckt subname 0 1 params: a1=2 b={2*a1} ...
|
||
$depth++; # augment deepthcounter till not .ends reached -> if depth > 0 all lines are recorded in $line
|
||
$sublist .= $spf.$psubnm; # sublist -> sublist + _subname for nested subckt
|
||
if (s/params:(.*)//) { # $_ is now ".subckt subname 0 1" $1 = 1=2 b={2*a1} ...
|
||
$tmpline=$_;
|
||
$ref_prmval=read_subckt_params($ref_prmval,$1);
|
||
if ($hasprm) { # parametrized subcircuit in subcircuit not allowed
|
||
print "Line $linenum: ","Nested parameterized subckt definitions not permitted\n\n";
|
||
}
|
||
else {
|
||
$hasprm = 1; $start_nbr = $.; # remember starting linenumber of the .subckt-Line in the cirfile
|
||
$subprm{$psubnm} = $ref_prmval; # stores paramlist - Var1=Val1 Var2=Val2 ........
|
||
}
|
||
}
|
||
push(@list, $tmpline); # With parameter defs removed. .subckt 1 2 subname
|
||
last PRM_TST;
|
||
}
|
||
if (/^\.ends/) { # if .ends - Line found
|
||
$sublist =~ s/($spf\w+)$//; # sublist minus _N - one level higher , "" if level 0
|
||
if (--$depth == 0) { # level-Subckthierarchycounter
|
||
if ($hasprm) {
|
||
$subckt{$psubnm} = join("\n",join(' ',$start_nbr,$.),@list,$_); # $. = linenbr of .ends in cirfile
|
||
$sub_lprm{$psubnm} = $ref_pprmval;
|
||
$sub_lfunc{$psubnm} = $ref_funcprmval;
|
||
$sub_lpfunc{$psubnm} = $ref_pfuncprmval;
|
||
}
|
||
$hasprm = 0;
|
||
undef @list; $sublist = ''; # $list not longer used -> free for new .subckt
|
||
}
|
||
last PRM_TST;
|
||
}
|
||
if ($depth) { # if .subckt - Line found - > deepth > 0 till not .ends found
|
||
# copy all devicelines in var @list, remove/store .param , .func , .pfunc lines before
|
||
$tmpline=$_;
|
||
if(s/^\.param//) {
|
||
$ref_pprmval = read_subckt_params($ref_pprmval,$_); # dont add this lines to @list
|
||
}
|
||
elsif(s/^\.func//) {
|
||
$ref_funcprmval = read_subckt_funcline($ref_funcprmval,$_); # add this lines to @list
|
||
#push(@list, $tmpline);
|
||
}
|
||
elsif(s/^\.pfunc//) {
|
||
$ref_pfuncprmval = read_subckt_funcline($ref_pfuncprmval,$_); # dont add this lines to @list
|
||
#push(@list, $tmpline);
|
||
}
|
||
else {push(@list, $tmpline)}; # add this line to @list e.g. a deviceline like "r1 1 0 1m"
|
||
last PRM_TST;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
sub write_sub_table {
|
||
local ($idx_n,$idx_m);
|
||
my($key,$run,$ui_start,$val,$pattern);
|
||
|
||
$idx_n=0;$idx_m=0;
|
||
$ui_start=$max; # unique identifier start number
|
||
foreach $val (values %subcall_root) {
|
||
$idx_m=$idx_n; # synchronize
|
||
&write_sub_table_entry($val,0);
|
||
$run=1;
|
||
while($run) {
|
||
$pattern=$ui_subname[$idx_m];
|
||
foreach $key (keys %subcall_sub) {
|
||
if($key=~m/$spf$pattern$/) {write_sub_table_entry($subcall_sub{$key},1);}
|
||
}
|
||
if($idx_m<$idx_n-1) {$idx_m++;} else { $run=0;}
|
||
}
|
||
}
|
||
}
|
||
sub write_sub_table_entry {
|
||
($name,$caller)=@_;
|
||
my ($nbr,$oldname);
|
||
|
||
$oldname=$name; # oneinch_4
|
||
$name=~s/(.*?)$spf(\d+)$/$1/; # oneinch
|
||
$nbr=$2; #4
|
||
if($caller>0) {$nbr=++$max;} # if called from main $nbr is not changed , if not -> $uistart++
|
||
$ui_subname[$idx_n]=$name;
|
||
$ui_number[$idx_n]=$nbr;
|
||
$ui_xname[$idx_n]=$oldname;
|
||
$ui_calleridx[$idx_n]= ($caller>0) ? ($idx_m): (-1);
|
||
$idx_n++;
|
||
}
|
||
# Write the output file.
|
||
sub prm_wr {
|
||
my (@w,@pnms,@list,@line);
|
||
my($xnm,$subnm,$n,$i,$s,$nbr);
|
||
local($sublist) = '';
|
||
# unique_sub_table variables
|
||
local @ui_subname=();
|
||
local @ui_number=();
|
||
local @ui_xname=();
|
||
local @ui_calleridx=();
|
||
|
||
&write_sub_table;
|
||
%subcall = (%subcall_root,%subcall_sub); # hash with all subcalls
|
||
$depth=0; # subcircuit level deepth counter
|
||
|
||
PRMWR_SCAN: while ($_ = &prm_getline) {
|
||
# write .control - .endc blocks
|
||
if (/^\.control/i) {
|
||
print OUTFILE "$_\n";
|
||
while ($_ = &prm_getline) {
|
||
prm_wrline($_); # write everything between .control and .endc unchanged to the OUTFILE
|
||
next PRMWR_SCAN if (/^\.endc/i);
|
||
}
|
||
}
|
||
tr/A-Z/a-z/; # to lower case
|
||
if (/^x/ && s/params:(.*)//) { # (affects only xlines with params outside of subcircuits)
|
||
@w = split(' '); $subnm = pop(@w); # store result of subst in array - split relates to $_
|
||
$xnm = $w[0] . $sublist;
|
||
prm_wrline(join(' ', @w, $subcall{$xnm})); # write "xsubckt 1 2 subname_N"
|
||
print OUTFILE "* $1\n"; # subckt parameters as comment in next line * { ..... }
|
||
if (!defined($subprm{$subnm})) {
|
||
print "Line $linenum: Subckt \"$subnm\" has no defined parameters\n\n";
|
||
next PRMWR_SCAN;
|
||
}
|
||
next PRMWR_SCAN;
|
||
}
|
||
if (/^\.subckt\s+(\w+)/) { # if .subckt found $1 = subname 1 2 { .... }
|
||
if ($s = $subckt{$1}) { # In $s is the whole subckt (from line) (to line) + startline,listing,endline e.g.
|
||
$s =~ /\d+\s+(\d+)/; # $s = "8 13"
|
||
$n = $1;
|
||
&prm_getline until $. == $n; # skip e.g. Line 8 - 11 in the Inputfile ( this lines are yet recorded from first loop )
|
||
}
|
||
else {
|
||
$depth++; $sublist .= $spf.$1; # increase deepth
|
||
prm_wrline($_);
|
||
}
|
||
next PRMWR_SCAN;
|
||
}
|
||
if (/^\.end\b/) { # end of cirfile detected , much work to do
|
||
&uc_efghb_lines;
|
||
&write_all_subckts;
|
||
print OUTFILE ".end\n";
|
||
last PRMWR_SCAN;
|
||
}
|
||
if (/^\.ends/) { # .ends line found
|
||
if (--$depth == 0) { $sublist = ''; } # depth --
|
||
else { $sublist =~ s/($spf\w+)$//; }
|
||
}
|
||
prm_wrline($_); # all other lines which are not .subckt ... .ends, x-lines copy 1:1 unchanged
|
||
} # while getline of inputfile
|
||
} # prm_write end
|
||
# search for v(node1,[node2]) or i(vname) expressions and uppercase it
|
||
# prevents for substitution with functionnames
|
||
sub uc_efghb_lines {
|
||
my($key,$linenbr,@lines);
|
||
|
||
foreach $key (keys %subckt) {
|
||
@lines = split(/\n/,$subckt{$key});
|
||
$linenbr=0;
|
||
foreach (@lines) {
|
||
if(/^[efghb]/) { #search for v(name) or i(vname) and replace with upper case letters V(NAME) I(VNAME)
|
||
$lines[$linenbr]=~s/(\b[vi]\s*\([^\)]+\))/uc($1)/eg;
|
||
}
|
||
$linenbr++;
|
||
}
|
||
$subckt{$key} = join("\n",@lines); # write back
|
||
}
|
||
}
|
||
sub write_all_subckts {
|
||
my($idx_n,$nbr,$xname,$cidx,$cnbr,$csubname,$key,$ckey,$keymod,$val,$search);
|
||
my(@cprm,@localprm,@line);
|
||
my(%paramval,%newparam,%newfunc,%newpfunc);
|
||
# while(@line) ....
|
||
my(@splitline,$val,$key,@start,$nstart,$nline,$skip);
|
||
my($oldxname,$oldsubname,$newxname);
|
||
my($head,$tail,$expr,$copyline,$templine);
|
||
|
||
# for all indexes of the sub_table
|
||
$idx_n=0;
|
||
foreach $subname (@ui_subname) {
|
||
$nbr=$ui_number[$idx_n];
|
||
$xname=$ui_xname[$idx_n];
|
||
$cidx=$ui_calleridx[$idx_n];
|
||
############ xline and .subckt params ############
|
||
*xprmval=$sub{$xname}; # get params from xline
|
||
*subprmval=$subprm{$subname}; # get params from .subckt line
|
||
# build sum of xline and .subckt params
|
||
%paramval=%subprmval;
|
||
foreach $key (keys %xprmval) {$paramval{$key}=$xprmval{$key};}
|
||
# get the caller variablenames : params: .param .func .pfunc
|
||
if($cidx>=0) {# if not called from root
|
||
$cnbr=$ui_number[$cidx];
|
||
$csubname = $ui_subname[$cidx];
|
||
@cprm=();
|
||
# params:
|
||
*sub_lprms_al=$subprm{$csubname};
|
||
@cprm = keys %sub_lprms_al;
|
||
# .param
|
||
if($sub_lprm{$csubname}) {
|
||
*sub_lprm_al=$sub_lprm{$csubname};
|
||
push(@cprm,keys %sub_lprm_al);
|
||
}
|
||
# .func
|
||
if($sub_lfunc{$csubname}) {
|
||
*sub_lfunc_al=$sub_lfunc{$csubname};
|
||
push(@cprm,keys %sub_lfunc_al);
|
||
}
|
||
# .pfunc
|
||
if($sub_lpfunc{$csubname}) {
|
||
*sub_lpfunc_al=$sub_lpfunc{$csubname};
|
||
push(@cprm,keys %sub_lpfunc_al);
|
||
}
|
||
# search all vals (RHS) of paramval for "caller" variables and append the caller uid to their names
|
||
foreach $ckey (@cprm) {
|
||
foreach $key (keys %paramval) {
|
||
$val=$paramval{$key};
|
||
$val=~s/\b$ckey\b/$ckey$spf$cnbr/g;
|
||
$paramval{$key}=$val; # update
|
||
}
|
||
}
|
||
#} from line 2889 to line 2903 changed
|
||
############ xline and .subckt params END ############
|
||
# search for params: variablenames in RHS of params: append the subckt uid to their names
|
||
foreach $key1 (keys %paramval) {
|
||
foreach $key2 (keys %paramval) {
|
||
$val = $paramval{$key2};
|
||
if($val=~s/\b$key1\b/$key1$spf$nbr/g) { # if something is replaced
|
||
if($key1 eq $key2) { # recursion
|
||
print "PANIC: variable recursion detected -> varname: %paramval{$key1} value:$val";exit(1);
|
||
}
|
||
else {$paramval{$key}=$val;} # update
|
||
}
|
||
}
|
||
}
|
||
}
|
||
# collect all variablenames of params: .param .func .pfunc in a hash (LHS)
|
||
@localprm=();
|
||
@localprm = keys %{$sub_lprm{$subname}};
|
||
push (@localprm,keys %{$sub_lfunc{$subname}});
|
||
push (@localprm, keys %{$sub_lpfunc{$subname}});
|
||
push (@localprm, keys %paramval);
|
||
# search for the sumhash variablenames in .param .func .pfunc (RHS)
|
||
# and append the subckt uid to their names (RHS)
|
||
%newparam = %{$sub_lprm{$subname}};
|
||
%newfunc = %{$sub_lfunc{$subname}};
|
||
%newpfunc = %{$sub_lpfunc{$subname}};
|
||
foreach $search (@localprm) {
|
||
foreach $key (keys %newparam) {
|
||
$val=$newparam{$key};
|
||
$val=~s/\b$search\b/$search$spf$nbr/g;
|
||
$newparam{$key}=$val;
|
||
}
|
||
foreach $key (keys %newfunc) {
|
||
$val=$newfunc{$key};
|
||
$val=~s/\b$search\b/$search$spf$nbr/g;
|
||
$newfunc{$key}=$val;
|
||
}
|
||
foreach $key (keys %newpfunc) {
|
||
$val=$newpfunc{$key};
|
||
$val=~s/\b$search\b/$search$spf$nbr/g;
|
||
$newpfunc{$key}=$val;
|
||
}
|
||
}
|
||
########### generate unique subckt #############
|
||
# append subckt uid to all variablenames (key) in %paramval and
|
||
# store all params: and .param variables to the global parmeter hash
|
||
foreach $key (keys %paramval) {
|
||
$keymod=$key.$spf.$nbr;
|
||
#$param{$keymod}=$paramval{$key};
|
||
}
|
||
foreach $key (keys %newparam) {
|
||
$keymod=$key.$spf.$nbr;
|
||
#$param{$keymod}=$newparam{$key};
|
||
}
|
||
# get the subcktcode template from %subckt
|
||
@line = split(/\n/,$subckt{$subname});
|
||
shift(@line); # delete first entry with linenumberinfo from .. too
|
||
#change .subckt NAME -> NAME_UID
|
||
$line[0]=~s/$subname/$subname$spf$nbr/;
|
||
prm_wrline("*");
|
||
prm_wrline($line[0]);
|
||
# add a comment line with caller name and perhaps params: .param line
|
||
if($cidx>=0) { prm_wrline("* caller: $ui_subname[$cidx]$spf$ui_number[$cidx]"); }
|
||
else { prm_wrline("* caller: root");}
|
||
# append subckt uid to all variablenames (key) in %newfunc and %newpfunc
|
||
# write this lines to the unique subcircuit
|
||
prm_wrline("* params: converted to .param:");
|
||
foreach $key (keys %paramval) {
|
||
prm_wrline(".param $key$spf$nbr={$paramval{$key}}");
|
||
}
|
||
prm_wrline("* .param:");
|
||
foreach $key (keys %newparam) {
|
||
prm_wrline(".param $key$spf$nbr={$newparam{$key}}");
|
||
}
|
||
foreach $key (keys %newfunc) {
|
||
prm_wrline(".func $key$spf$nbr$newfunc{$key}");
|
||
}
|
||
foreach $key (keys %newpfunc) {
|
||
prm_wrline(".pfunc $key$spf$nbr$newpfunc{$key}");
|
||
}
|
||
# write the other subcircuit lines to OUTPUT
|
||
foreach (@line) {
|
||
@splitline=split;
|
||
$skip = &skipnumber($splitline[0]);
|
||
if($splitline[0] eq ".subckt") { # for nested .subckt's
|
||
prm_wrline($_[0]);next;
|
||
}
|
||
@start=splice(@splitline,0,$skip); # @start = "R1 1 0 " @line=rest
|
||
$nstart=join " ",@start;
|
||
$nline=join " ",@splitline;
|
||
# if x-line change the x-name to the uid-xnames
|
||
if($nstart=~m/(^x\w+)/i) { # for x-calls with params inside subcircuits -> change the unique id
|
||
#$nline=$nstart.$nline; # now the whole line again ( we don't know the count of ports )
|
||
$nline=~m/((\w+)$spf\d+)$/i; # search starting from the end
|
||
$oldxname=$1; # lump_7
|
||
$oldsubname=$2; # lump
|
||
if(defined($oldsubname)) { # if not _123.. -> x-line without parameter !!!
|
||
$newxname=new_uid($idx_n,$oldxname,$oldsubname);
|
||
if($newxname) {
|
||
$nline=~s/$oldxname$/$newxname/;
|
||
}
|
||
}
|
||
$nline=$nstart." ".$nline; # compose back
|
||
}
|
||
else { # no x-line
|
||
# search for the sumhash variablenames in the actual line and append the subckt uid to their names
|
||
foreach (@localprm) { # sum of variablenames from -> params: .param .func .pfunc
|
||
$search=$_;
|
||
if($nstart=~m/^[befgh]/) { # b-efgh-line
|
||
$nline=~s/\b$search\b/$search$spf$nbr/g; # exact search and replace
|
||
}
|
||
else { # all other lines , devicelines, .modellines , analysislines ......
|
||
# be more specific -> only search in {expr}
|
||
$copyline="";
|
||
$templine=$nline;
|
||
while ($templine=~m/([^\{]*)\{([^\}]*)\}(.*)/) {
|
||
# parameterexpr with { $expr } present in deviceline
|
||
$head=$1; $tail=$3;$expr=$2;
|
||
$expr=~s/\b$search\b/$search$spf$nbr/g;
|
||
$copyline .= $head."{".$expr."}"; # reconstruct it with sourrounding paranthesis {}
|
||
$templine=$tail; # perhaps another param in line ?
|
||
}
|
||
$nline=$copyline.$templine;
|
||
}
|
||
}
|
||
$nline=$nstart." ".$nline; # write back
|
||
}
|
||
prm_wrline($nline); # write with parameter = parameter#k substituted line to outfile
|
||
}
|
||
prm_wrline(" ");
|
||
$idx_n++; # generate next unique subcircuit
|
||
}
|
||
}
|
||
sub new_uid {
|
||
my ($aktidx,$xname,$subname)=@_;
|
||
my ($ui,$i,$c,$k);
|
||
|
||
# search starts from $aktidx -> with ui_calleridx[$i] has the same value
|
||
$k=$i=$aktidx;
|
||
while(($c=$ui_calleridx[$i])!=$aktidx) {
|
||
$i++;
|
||
if($i>=@ui_calleridx) {return(-1)}; # no index found -> perhaps subcircuit with _123 but no params
|
||
}
|
||
$ui="Error -> no uid found for this x-line !!";
|
||
while ($c==$k) {
|
||
if($ui_xname[$i] eq $xname) {$ui=$subname.$spf.$ui_number[$i];last;}
|
||
else
|
||
{ $i++;$c=$ui_calleridx[$i];}
|
||
}
|
||
return $ui;
|
||
}
|
||
# Translate a possible unit into a multiplier factor.
|
||
# Parameter is the unit letter string assumed lower case.
|
||
sub unit2mult {
|
||
my($u) = shift;
|
||
$u = ($u =~ /^(mil|meg)/ ? $1 : substr($u, 0, 1));
|
||
$u = defined($units{$u}) ? $units{$u} : 1;
|
||
}
|
||
# 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 {
|
||
my($line) = shift;
|
||
my($max, $s, $m);
|
||
$max = $MAXLEN;
|
||
until ($line eq '') {
|
||
if (length($line) > $max) {
|
||
$m = substr($line, 0, $max);
|
||
if ($m=~/((\s|\=)[^(\s|\=)]*)$/) { # seperate on = or Blank
|
||
$s = $` . $2;
|
||
$line = '+' . substr($line, length($s)); # seperate with spice +
|
||
}
|
||
else { $max += $DMAXLEN; next; }
|
||
}
|
||
else { $s = $line; $line = ''; }
|
||
print OUTFILE "$s\n"; # write line to outfile
|
||
$max = $MAXLEN;
|
||
}
|
||
}
|
||
# reads subckt params to a hash and returns a ref to this hash : param1->val1 param2->val2 .....
|
||
sub read_subckt_params {
|
||
my ($line,$done,$i,$j,$temp1,$temp2);
|
||
$hashptr=$_[0];
|
||
$line=$_[1]; # e.g. a=3 b={2*a+5.0}
|
||
$_=$line;
|
||
|
||
if(!($hashptr)) {$hashptr={};} # generates new anonymous hash if first call ($hashptr=0)
|
||
*hash=$hashptr; # alias for $hashptr to facilitate access to anonymous hash
|
||
|
||
$done=0;
|
||
until ($done) {
|
||
if (/^\s*(\S+)\s*\=\s*\{([^\}]*)\}(.*)/) { # search for var={ }
|
||
# $1 = Variable $2 = { .... } without paranthesis $3 = Rest
|
||
$_=$2;
|
||
$temp1 = $1;
|
||
$temp2 = $3;
|
||
# s/([\(\)\*\+\-\/])/ $1 /g; # space delimit operators
|
||
$hash{$temp1}=$_; # stores param to hash
|
||
$_=$temp2; # perhaps another param present ?
|
||
}
|
||
elsif (/^\s*(\S+)\s*\=\s*(\S+)(.*)/) { # search for Var=value
|
||
# $1 = varname $2 = num. value $3 is the possible remainder
|
||
$hash{$1} = &unit($2);
|
||
$_=$3; # perhaps another param present ?
|
||
}
|
||
else { $done=1; }
|
||
} # done
|
||
return $hashptr;
|
||
}
|
||
# reads .func or .pfunc line to a hash and returns a ref to this hash : funcname(a,b) (2*a+b)
|
||
sub read_subckt_funcline {
|
||
my ($line,$i,$j,$fname,$parm,$ex);
|
||
$hashptr=$_[0];
|
||
$line=$_[1]; # e.g. pythag(a,b) (a*a+b*b)
|
||
$_=$line;
|
||
|
||
if(!($hashptr)) {$hashptr={};} # generates new anonymous hash if first call ($hashptr=0)
|
||
*hash=$hashptr; # alias for $hashptr to facilitate access to anonymous hash
|
||
|
||
m/\s+([^\(]+)(\([^\)]+\))\s+(.*)/i; # $1=fname, $2=parameter , $3=expr
|
||
# how many params in $2 ? .func neg(x) ((x)*(x)) -> $1=neg $2=x $3=((x)*(x))
|
||
$fname=$1;
|
||
$parm=$2;
|
||
$ex=$3;
|
||
$fname=~s/\s+//g; # delete blanks
|
||
$parm=~s/\s+//g; # delete blanks
|
||
$ex=~s/\s+//g; # delete blanks
|
||
$hash{$1}=$2." ".$3;
|
||
return $hashptr;
|
||
}
|
||
sub expand_incs {
|
||
my ($i,$file,$cnt,@inc);
|
||
|
||
for ($i=1;$i<@deck;$i++) {
|
||
$_=$deck[$i];
|
||
@inc=();
|
||
if ( /^\.inc\s+(.*)/ || /^\.include\s+(.*)/ ) { # another inc to search for
|
||
$file=$1;
|
||
$file=~s/[\'\"]//g;
|
||
@inc=&read_includefile($file); # include this
|
||
if(@inc) {
|
||
splice(@deck,$i,1,@inc); # put tmpdeck in deck starting (and deleting) with .inc line
|
||
# if another .inc line in this file manage this
|
||
}
|
||
}
|
||
}
|
||
}
|
||
sub read_includefile {
|
||
my ($file,$model,$found,@inc );
|
||
$file=$_[0];
|
||
@inc=();
|
||
open (INCLUDE, "$file") || die "include file $file cannot be opened";
|
||
$found=0;
|
||
while (<INCLUDE>) {
|
||
chop;
|
||
# dont lowercase stuff in quotes
|
||
if (/(.*)([\'\"])(.*)([\"\'])(.*)/) {
|
||
$_=lc($1) . $2 . $3 . $4 . lc($5);
|
||
}
|
||
else { $_ = lc($_); }
|
||
s/^\*\$//; # *$ should be interpreted as a nutmeg commandline -> remove *$ to enable it
|
||
s/\;.*//; # no inline comments with ;
|
||
s/^\*.*//; # no comments starting with *
|
||
s/\s\s+/ /g; # shrink multiple whitespaces
|
||
s/^\s*//; # trim leading whitespaces and delete blanc lines
|
||
# s/([^\s\=]+)\s*=\s*([^\s\=]+)/$1=$2/g; # compress around =
|
||
if (/^\s*\+(.*)/) { # continuation
|
||
$_ = pop (@inc) . " " . $1;
|
||
}
|
||
push @inc,$_ if (length($_)>0);
|
||
}
|
||
close(INCLUDE);
|
||
return @inc;
|
||
}
|
||
#returns global parameters and funclines of libfile
|
||
#search this lib for models defined in %xmodels or %devicemodels
|
||
#if found returns all ".subckt modelname ... .. .ends" or ".model modelname ... " lines
|
||
sub read_libfile {
|
||
my ($i,$file,$modelnm,@lib,@add,$found,$go);
|
||
|
||
$file=$_[0];
|
||
@lib=(); # place for whole libfile
|
||
@add=(); # place for all .model and .subcktlines
|
||
# source in libfile
|
||
open (LIB, "$file") || die "libfile $file cannot be opened";
|
||
while (<LIB>) {
|
||
chop;
|
||
# dont lowercase stuff in quotes
|
||
if (/(.*)([\'\"])(.*)([\"\'])(.*)/) {
|
||
$_=lc($1) . $2 . $3 . $4 . lc($5);
|
||
}
|
||
else { $_ = lc($_); }
|
||
#s/^\*\$//; # *$ should be interpreted as a nutmeg commandline -> remove *$ to enable it
|
||
s/\;.*//; # no inline comments with ;
|
||
s/^\*.*//; # no comments starting with *
|
||
s/\s\s+/ /g; # shrink multiple whitespaces
|
||
s/^\s*//; # trim leading whitespaces and delete blanc lines
|
||
# s/([^\s\=]+)\s*=\s*([^\s\=]+)/$1=$2/g; # compress around =
|
||
if (/^\s*\+(.*)/) { # continuation
|
||
$_ = pop (@lib) . " " . $1;
|
||
}
|
||
push @lib,$_ if (length($_)>0);
|
||
}
|
||
close(LIB);
|
||
#collect all global .param .func .pfunc statements of the libfile and store it to @add
|
||
#collect all global .lib statements and store it to %libfiles
|
||
$go=1;
|
||
for ($i=0;$i<@lib;$i++) {
|
||
$_=$lib[$i];
|
||
if(/^\.subckt/) {$go=0;}
|
||
if(/^\.ends/) {$go=1;}
|
||
if($go) {
|
||
if(/^\.param/i) {
|
||
push @add,$_ ;
|
||
}
|
||
elsif(/^\.func/i) {
|
||
push @add,$_ ;
|
||
}
|
||
elsif(/^\.pfunc/i) {
|
||
push @add,$_ ;
|
||
}
|
||
elsif(/^\.lib\s+(.*)/i) { # global .lib outside of .subckt's
|
||
$file=$1;
|
||
$file=~s/[\'\"]//g; # libfilename without quotes
|
||
if(!defined($libfiles{$file})) {
|
||
$libfiles{$file}=1;$flag=1;
|
||
# indicates that a NEW global .lib is found -> don't give up before this lib is searched for
|
||
# unresolved models
|
||
}
|
||
}
|
||
}
|
||
}
|
||
#search @lib for all .model lines defined in %devicemodels , if found remove it from %devicemodels
|
||
#search @lib for all .subckt lines defined in %xmodels , if found remove it from %xmodels
|
||
#store all modellines found so far to @add
|
||
for ($i=0;$i<@lib;$i++) {
|
||
$_=$lib[$i];
|
||
if (/^\.model/i) {
|
||
foreach $modelnm (keys(%devicemodels)) { #for all models in hash
|
||
if (/^\.model\s+$modelnm\b/i) {
|
||
push (@add,$_); # put it all together in tmpdeck
|
||
while($lib[$i+1]=~m/^\+/) { # if continuation lines
|
||
push(@add,$lib[$i]); # add it
|
||
$i++;
|
||
}
|
||
delete($devicemodels{$modelnm});$flag=1;
|
||
if((!%devicemodels) && (!%xmodels)) {return(@add);} # we are done before end of lib reached
|
||
}
|
||
}
|
||
}
|
||
if(/^\.subckt/i) {
|
||
$found=0;
|
||
foreach $modelnm (keys(%xmodels)) { #for all models in hash
|
||
if (/^\.subckt\s+$modelnm\b/i) {$found=1;delete($xmodels{$modelnm});}
|
||
while($found) { # not .ends
|
||
if(/^\.ends/i) {
|
||
push (@add,$_); # .ends
|
||
$found=0;$flag=1;
|
||
if((!%devicemodels) && (!%xmodels)) {return(@add);} # we are done before end of lib reached
|
||
}
|
||
else {
|
||
push (@add,$_); # put it all together from .subckt till .ends in @add
|
||
$i++;$_=$lib[$i];
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
return(@add);
|
||
}
|
||
|
||
sub store_modellines {
|
||
my $mod;
|
||
# store all xmodels in hash %xmodels
|
||
for ($i=0;$i<@tmp;$i++) {
|
||
$_=$tmp[$i];
|
||
if ( /^x/ ) { # search for modelnames in x-lines
|
||
if( /(\w+)\s+params:/i ) {$mod=$1;} # xname params: pm1=val1 ....
|
||
elsif( /(\w+)\s+\S+\s*\=/ ) { # parameters present but no params: keyword
|
||
#insert params: keyword in between
|
||
s/(\w+)(\s+\S+\s*\=)/$1 params:$2/;
|
||
$mod=$1;
|
||
$tmp[$i]=$_; # write back
|
||
}
|
||
else { # no parameters -> xname must be last name in line
|
||
m/(\w+)\s*$/i;
|
||
$mod=$1;
|
||
}
|
||
if(!defined($xmodels{$mod})) {
|
||
$xmodels{$mod}=1;$flag=1;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
sub store_devicemodellines {
|
||
my($i,$control,$mod,$n,@line);
|
||
# store all devicemodels in hash %devicemodels
|
||
$control=0;
|
||
for ($i=0;$i<@tmp;$i++) {
|
||
if ($tmp[$i]=~m/^\.control/i) {$control=1;}
|
||
if ($tmp[$i]=~m/^\.endc/i) {$control=0;}
|
||
if (!$control) {
|
||
$_=substr($tmp[$i],0,1);
|
||
$n=tr/cdjmoqrsuw/2234432433/; # these devices can have models
|
||
if($n) {
|
||
$n=$_;$_=$tmp[$i];
|
||
@line=split;
|
||
$mod=$line[$n+1];
|
||
if(isnumber($mod) || isexpression($mod)) {next;}
|
||
if($mod=~/^\s*(q=|flux=|value|poly)/i) {next;}
|
||
if(!defined($devicemodels{$mod})) {
|
||
$devicemodels{$mod}=1;$flag=1;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
sub remove_modellines {
|
||
my $i;
|
||
# now search .subckt and .model lines and delete models from hash
|
||
for ($i=0;$i<@tmp;$i++) {
|
||
$_=$tmp[$i];
|
||
if(/^.subckt\s+(\w+)/) { #search for .subckt lines in actual file if found delete model from $xmodels
|
||
if(defined($xmodels{$1})) {
|
||
delete($xmodels{$1});$flag=1;
|
||
}
|
||
}
|
||
if(/^.model\s+(\w+)/) { #search for .model lines in actual file if found delete model from $devicemodels
|
||
if(defined($devicemodels{$1})) {
|
||
delete($devicemodels{$1});$flag=1;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
sub store_lib {
|
||
my ($i,$file);
|
||
|
||
for($i=0;$i<@tmp;$i++) {
|
||
if ($tmp[$i]=~m/^\.lib\s+(.*)/) { # another library to search for ( one or more or all ) models
|
||
$file=$1;
|
||
$file=~s/[\'\"]//g; # libfilename without quotes
|
||
if(!defined($libfiles{$file}))
|
||
{ $flag=1;$libfile{$file}=1; }
|
||
splice(@tmp,$i,1);$i--; # delete line
|
||
}
|
||
}
|
||
}
|
||
# search all x lines and stores modelnames to %xmodels
|
||
# search all m,r,c,s,w,o,u,d,q,j-devicelines and stores modelnames ( if present ) to %devicemodels
|
||
# search for .subckt lines and delete these already defined modelnames from %xmodels
|
||
# search for .model lines and delete these already defined modelnames form %devicemodels
|
||
# search for .lib lines , delete it and add modellines needed (%xmodels,%devicemodels) from the external .lib-files
|
||
sub expand_libs {
|
||
my ($i,$file,$flidx,$cnt);
|
||
local (@addlib,%libfiles,@tmp,%xmodels,%devicemodels,$flag);
|
||
|
||
$lidx=1;
|
||
for ($i=1;$i<@deck;$i++) { # while .lib lines present
|
||
$_=$deck[$i];
|
||
if (/^\.lib\s+(.*)/) { # another library to search for ( one or more or all ) models
|
||
$lidx=$i;
|
||
$file=$1;
|
||
$file=~s/[\'\"]//g; # libfilename without quotes
|
||
$libfiles{$file}=1;
|
||
splice(@deck,$i,1);$i--; # delete line
|
||
}
|
||
}
|
||
@tmp=@deck;
|
||
@addlib=();
|
||
&store_modellines(@tmp); # search tmp for x-subckt-calls and store to hash
|
||
&store_devicemodellines(@tmp); # search tmp for devicelines with models and store to hash
|
||
&remove_modellines(@tmp); # search tmp for already defined .subcktlines and .modellines and remove from hash
|
||
|
||
if(!(%xmodels) && !(%devicemodels)) { # are we done now
|
||
return; # no models to search for !!!!!!
|
||
}
|
||
|
||
while(!0) {
|
||
$flag=0;
|
||
foreach $libfile (keys %libfiles) { # all libfiles found so far
|
||
@tmp=&read_libfile($libfile); # search the lib for models defined in %xmodels or %devicemodels
|
||
# if found delete it from x- and device - models hash and add code to @tmp
|
||
# search this lib for additional global .lib lines -> store it to %libfiles
|
||
# and set flag to 1
|
||
# search this lib for global .param .func .pfunc lines and add code to @tmp
|
||
&store_modellines; # search @tmp for new x-subckt-calls , if found store it to hash
|
||
&store_devicemodellines; # search @tmp for new devicelines with models , if found store it to hash
|
||
&remove_modellines; # search @tmp for already defined .subcktlines and .modellines and remove them from hash
|
||
&store_lib; # search @tmp for new local .lib lines and add it to %libfiles
|
||
if(@tmp) {push(@addlib,@tmp);}
|
||
if(!(%xmodels) && !(%devicemodels)) { # are we done now
|
||
splice(@deck,$lidx,0,@addlib); # we are done -> put addmodels in deck
|
||
return; # normal return
|
||
}
|
||
}
|
||
if(!$flag) {&debug_models;} # if no more change and no normal return -> must be error
|
||
}
|
||
}
|
||
|
||
|
||
sub debug_models {
|
||
my $modelnm;
|
||
foreach $modelnm (keys(%xmodels)) #for all models in hash
|
||
{ print "\nsubcktmodelname not defined : $modelnm\n"; }
|
||
foreach $modelnm (keys(%devicemodels)) #for all models in hash
|
||
{ print "\ndevicemodelname not defined : $modelnm\n"; }
|
||
exit(1);
|
||
}
|
||
|
||
sub loadbias {
|
||
my ($i,$found,$filename);
|
||
|
||
$found=0;
|
||
for ($i=1;$i<@deck;$i++) {
|
||
$_=$deck[$i];
|
||
if(/^.loadbias\s+(.*)/) { #search for .loadbias filename
|
||
$filename=$1;
|
||
$found=1;
|
||
last;
|
||
}
|
||
}
|
||
if($found) {
|
||
splice(@deck,$i,1,".include $filename"); # add includeline .include filename to deck !!!
|
||
}
|
||
}
|
||
#.savebias options infile outfile
|
||
# options: -tran -timepoint=val (val=nr of the timepoint in the rawfile)
|
||
# this can easily be changed to the timevalue -> see documentation at the sourcecode
|
||
sub savebias {
|
||
my ($i,$j,$found,$timevar,$infile,$outfile,$cnt,@rest,$part,$analysis);
|
||
my ($vargo,$valgo,$varcnt,$valcnt,$dc,$tran,$first,@vars,@vals,@line);
|
||
$dc=0;
|
||
$tran=0;
|
||
$found=0;
|
||
$timevar=0;
|
||
# cirfile = $infile
|
||
for ($i=1;$i<@deck;$i++) {
|
||
$_=$deck[$i];
|
||
if(/^.savebias\s+(.*)/) {
|
||
$found=1;
|
||
$cnt=@rest=split('\s+',$1);
|
||
for ($j=0;$j<$cnt;$j++) { # default is "op"
|
||
if($rest[$j] eq "-tran") {$tran=1;}
|
||
elsif ($rest[$j]=~m/-timepoint=(.*)/) { $timevar=$1;next;}
|
||
else { # must be filename
|
||
$infile=$rest[$j];
|
||
$outfile=$rest[$j+1];
|
||
last;
|
||
}
|
||
}
|
||
$deck[$i]="*".$deck[$i];
|
||
last;
|
||
}
|
||
}
|
||
$vargo=0;$valgo=0;$varcnt=0;$valcnt=0;$first=0;
|
||
$points=1; # default is op
|
||
if($found) {
|
||
open (INFILE, "$infile") || die "include file $infile cannot be opened";
|
||
while (<INFILE>) {
|
||
if(m/^values:/i) {
|
||
$vargo=0;$valgo=1; # now the values are managed
|
||
}
|
||
elsif(m/^variables:/i) {$vargo=1;} # first the variables
|
||
elsif($valgo) {
|
||
if($timevar>0) { # we have to search for the right timepoint
|
||
if((@line=split())>1) { # new timepoint has two entries
|
||
if($line[0]>=$timevar) {$timevar=0;} # AS TIMEPOINT (Integer)
|
||
else {next;}
|
||
}
|
||
else {next;}
|
||
}
|
||
if($first) {$first=0;next;}
|
||
else { # now the values
|
||
$valcnt++;
|
||
if($valcnt>$varcnt) {last;} # leave while loop !!!!!!!!!!!!!!!
|
||
if((@line=split())>1) {push(@vals,$line[1]);} # new timepoint has two entries
|
||
else {push(@vals,$line[0]);}
|
||
}
|
||
}
|
||
elsif($vargo) {
|
||
@line=split; # $_
|
||
if($line[1] eq 'time') {$first=1;next;}
|
||
else { # should be op and normal var
|
||
if($line[2] eq 'voltage') { # this is a .nodeset candidate
|
||
push(@vars,$line[1]);
|
||
$varcnt++;
|
||
}
|
||
else {last;} # we are done now -> no more voltages
|
||
}
|
||
}
|
||
elsif(m/points:\s+(.*)/i) {$points=$1;}
|
||
elsif(m/binary/i) {return;} # giving up -> no outfile is written
|
||
}
|
||
close(INFILE);
|
||
|
||
open (OUTFILE, "+>$outfile") || die "bias file $outfile cannot be generated";
|
||
print OUTFILE "* SAVEBIAS from $infile :\n ";
|
||
print OUTFILE ".nodeset ";
|
||
for($i=1;$i<$varcnt+1;$i++) {
|
||
if(($i%5)==0) {print OUTFILE "\n+ ";} # max 5 values per line -> if more add +
|
||
print OUTFILE "$vars[$i-1]"."="."$vals[$i-1] ";
|
||
}
|
||
print OUTFILE "\n";
|
||
close(OUTFILE);
|
||
}
|
||
}
|
||
sub pwl_file {
|
||
my ($i,$filename,$varname);
|
||
###########################################################################
|
||
# fileformat: generated with nutmeg : print col v(1) v(2) v(3) > outfile
|
||
###########################################################################
|
||
# ** third order elliptic active filter **
|
||
# Transient Analysis Mon Aug 21 22:48:43 2006
|
||
#--------------------------------------------------------------------------
|
||
#Index time v(1) v(2) v(3)
|
||
#--------------------------------------------------------------------------
|
||
#0 0.000000e+00 -5.000000e-01 2.003981e-03 1.399462e-01
|
||
#1 1.000000e-06 -5.000000e-01 2.003981e-03 1.399462e-01
|
||
#2 2.000000e-06 -5.000000e-01 2.003981e-03 1.399462e-01
|
||
############################################################################
|
||
for ($i=1;$i<@deck;$i++) {
|
||
$_=$deck[$i];
|
||
if(/^[vi].*?pwl.*?\bfile=\s*'(.*?)'\s+var=\s*'(.*?)'/) { #v or i ... pwl ... file=filename...var=varname
|
||
$filename=$1;
|
||
$varname=$2;
|
||
&add_pwl_line($filename,$varname,$i);
|
||
}
|
||
}
|
||
}
|
||
|
||
sub add_pwl_line {
|
||
my($filename,$varname,$i)=@_;
|
||
my($j,$k,$col,@cols,$idx,$found,@pwldata,$pwlline);
|
||
|
||
$found=0;
|
||
open (PWLDATA, "$filename") || die "Error on pwlline at $i : filenamme $filename cannot be opened";
|
||
|
||
@pwldata=<PWLDATA>;
|
||
$varname=quotemeta($varname);
|
||
for ($j=0;$j<@pwldata;$j++) {
|
||
$_=$pwldata[$j];
|
||
if(m/\b$varname/) {
|
||
$found=$j;
|
||
last;
|
||
}
|
||
}
|
||
if($found) {
|
||
$deck[$i]=~s/\bfile\=.*//; # delete from file= to end
|
||
$pwlline=$deck[$i];
|
||
# v1 1 0 pwl 0s 0v 1s 1v
|
||
@cols=split(/\s+/,$pwldata[$found]);
|
||
$idx=0;
|
||
$k=0;
|
||
foreach $col (@cols) {
|
||
if($col=~m/$varname/) {last;}
|
||
else {$idx++};
|
||
}
|
||
for($j=0;$j<@pwldata-$found-1;$j++) {
|
||
if($pwldata[$j+$found+1]=~m/^index/i) {$k++;next;} # no varnames line
|
||
if($pwldata[$j+$found+1]=~m/^\s+/) {$k++;next;} # no blanc line
|
||
if($pwldata[$j+$found+1]=~m/^[-_]/) {$k++;next;} # no -------- line
|
||
@cols=split(/\s+/,$pwldata[$j+$found+1]); # start at next line after the varname-line
|
||
$pwlline.=" ($cols[1]s $cols[$idx]v) "; # add time var pair to pwlline
|
||
}
|
||
splice(@deck,$i,1,$pwlline);
|
||
}
|
||
else { die "Error on pwlline at $i : varname $var not found"; }
|
||
close(PWLDATA);
|
||
}
|
||
sub pp_{
|
||
my $tmp;
|
||
my $filename_path; # windows specific , uncomment in unix
|
||
my $filename_wo_path;
|
||
|
||
$filename_path=$_[1];
|
||
$filename_wo_path=$filename_path;
|
||
$filename_path =~ s/([^\\])*$//; # windows specific use in unix s/([^\/])*$//;
|
||
$tmp=$filename_path;
|
||
$filename_path = quotemeta($filename_path); # windows specific , uncomment in unix
|
||
if($filename_path)
|
||
{ $filename_wo_path =~ s/$filename_path//};
|
||
return($tmp.$_[0]."_".$filename_wo_path);
|
||
}
|
||
sub output_debug {
|
||
my($i,$name,$value);
|
||
|
||
print "* DEBUG of deck: $deck[0]\n";
|
||
$deck[0]=~ s/(^[^\*].*)/*$1/; # if not asterisk as first character - insert it
|
||
print "\n* ouput of all parameters";
|
||
print "\n* =======================\n\n";
|
||
foreach $name (sort keys %param) {
|
||
print "* $name: $param{$name}\n";
|
||
}
|
||
print "\n* ouput of all functions";
|
||
print "\n* ======================\n\n";
|
||
for($i=0;$i<=$memidx;$i++) {
|
||
print "* $funcname[$i] -> $expr[$i] $anz_pm[$i] parameter\n";
|
||
}
|
||
print "\n* ouput of all pfunctions";
|
||
print "\n* =======================\n\n";
|
||
for($i=0;$i<=$memidx2;$i++) {
|
||
print "* $pfuncname[$i] -> $pexpr[$i] $panz_pm[$i] parameter\n";
|
||
}
|
||
print "\n";
|
||
}
|
||
sub do_ltspice {
|
||
my($addpm,$i,@kill,@addctrl);
|
||
|
||
$addpm = ".param tripv=1 tript=1";
|
||
splice(@deck,1,0,$addpm); # insert new line for tripv and tript parameter
|
||
#value or bsrc + tripdv={tripv} tripdt={tript}
|
||
for ($i=0;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
if ( s/value\s*\=\s*/v=/i ) # subs value= with v=
|
||
{ $deck[$i]=$deck[$i]." tripdv={tripv} tripdt={tript}"; } #
|
||
if( substr($_,0,1) eq "b" ) { # b-source like
|
||
$deck[$i]=$deck[$i]." tripdv={tripv} tripdt={tript}";
|
||
$deck[$i]=~ s/e\^/exp/g; # e^() to exp()
|
||
$deck[$i]=~ s/\^/\*\*/g; # raise to power in ltspice is ** instead of ^ standardspice
|
||
}
|
||
}
|
||
#################################################
|
||
# .control till .endc lines -> delete
|
||
# add . before tran,dc,op,ac....lines and store it
|
||
#################################################
|
||
@addctrl=();
|
||
@kill=();
|
||
for ($i=1;$i<@deck;$i++) { # for the whole deck
|
||
$_=$deck[$i];
|
||
if ( s/^tran\b/\.tran/ ) {push @addctrl,$_;}
|
||
if ( s/^ac\b/\.ac/ ) {push @addctrl,$_;}
|
||
if ( s/^dc\b/\.dc/ ) {push @addctrl,$_;}
|
||
if ( s/^options\b/\.options/ ) {push @addctrl,$_;}
|
||
if ( s/^op\b/\.op/ ) {push @addctrl,$_;}
|
||
#delete from .control till .endc
|
||
if( m/^\.control/i ) {$ctrl_found=1;}
|
||
if( m/^\.endc/i ) {$ctrl_found=0;push @kill,$i;}
|
||
if($ctrl_found) {push @kill,$i;}
|
||
}
|
||
&zapdeck(@kill);
|
||
@probe=@addctrl; # is added by printdeck
|
||
&printdeck; # prints to outfile
|
||
# other things are better managed by ltspice itself
|
||
exit(0);
|
||
}
|
||
sub getargs {
|
||
my($arg);
|
||
|
||
while(@ARGV) { # handles all command line switches
|
||
$arg=shift @ARGV;
|
||
last if substr($arg,0,1) ne '-'; # no option if not started with -
|
||
$spice3=1 if $arg eq '-sp3';
|
||
$ltspice=1 if $arg eq '-ltspice';
|
||
$tinylines=0 if $arg eq '-notinylines';
|
||
$check=1 if $arg eq '-check';
|
||
$xornot=1 if $arg eq '-xornot';
|
||
$debug=1 if $arg eq '-debug';
|
||
$tosub=1 if $arg eq '-tosub';
|
||
$tolib=1 if $arg eq '-tolib';
|
||
$fromsub=1 if $arg eq '-fromsub';
|
||
$fromlib=1 if $arg eq '-fromlib';
|
||
# insert other options if necessary
|
||
if ($arg eq '-v' || $arg eq '--version')
|
||
{ print "ps2sp version 4.14\n".
|
||
"Copyright (C) 2003/2004/2005/2006/2007 Friedrich Schmidt <frie.schmidt\@aon.at>\n\n".
|
||
"This is free software; see the source for copying conditions. There is NO\n".
|
||
"warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
|
||
exit;
|
||
}
|
||
|
||
if ($arg eq '-h' || $arg eq '--help')
|
||
{ print "Usage: perl ps2sp [OPTION] infile > outfile\n\n".
|
||
" -h, --help displays the help screen\n".
|
||
" -v, --version display version information and exit\n".
|
||
" -sp3 switch means conversion of pspice table to spice 3 b-source\n".
|
||
" instead of xspice core model ( default )\n".
|
||
" -ltspice switch means conversion of ^ spice 3 power to ** ltspice\n".
|
||
" power and addition of tripdv=1 tripdt=1 in b-lines\n".
|
||
" -debug for debugging all .param .func and .pfunc definitions\n".
|
||
" ( default is nodebug )\n".
|
||
" -tosub only output subckt expansions\n".
|
||
" -fromsub inputfile is a sub.tmp file\n".
|
||
" -tolib only output lib expansions\n".
|
||
" -fromlib inputfile is a lib.tmp file\n".
|
||
" -check determine the same count of open and closed paranthesis\n".
|
||
" in b-lines ( default is nocheck )\n".
|
||
" -notinylines produces longer b-lines for some functions ( default is\n".
|
||
" tinylines = shorter b-lines )\n".
|
||
" -xornot allows ^ and ~ operators in the netfile (don't mix with ^ as\n".
|
||
" power operator) use the ** operator as power instead\n".
|
||
"\nReport bugs to Friedrich Schmidt <frie.schmidt\@aon.at>\n";
|
||
exit; }
|
||
}
|
||
# this arg must be a filename since no "-" before the name
|
||
unshift @ARGV,$arg; # back to the roots
|
||
}
|
||
|
||
sub quotes { # c:\xx\filename -> "c:\xx\filename"
|
||
return("'$_[0]'");
|
||
}
|
||
|
||
sub initialize_predefined_parameter_functions {
|
||
# predefined global Parameter
|
||
$param{"pi"}="3.1415926535898";
|
||
$param{"echarge"}="1.602190e-019";
|
||
$param{"kelvin"}="-2.73150e+002";
|
||
$param{"planck"}="6.626200e-034";
|
||
$param{"temp"}=$tnom;
|
||
# ............. add user defined parameter here !!!!
|
||
|
||
# predefined global nodes
|
||
$globals{'times'}=1; # global node
|
||
|
||
# predefined functions
|
||
$fidx=0; # startindex of user defined .func lines
|
||
# .func definitions are used for b-sources ( syntax: must always be spice syntax )
|
||
# whereas .pfunc definitions are used for all other lines
|
||
# for compatibility to pspice all .func definitions are copied to .pfunc equivalents
|
||
# and can therefore be also used for other than b-lines ( all other devicelines and .param , .model , .tran .... )
|
||
# parameter placeholders used are __1 , __2 , __3 .....
|
||
$funcname[0]="pwrs";
|
||
$anz_pm[0]=2;
|
||
$expr[0]="sgn(__1)*abs(__1)^(__2)";
|
||
$fidx=1;
|
||
# 5.9.2006 added *(abs(sgn(__1))) -> compatibility to nutmeg
|
||
$funcname[1]="pos";
|
||
$anz_pm[1]=1;
|
||
$expr[1]="(u(__1)*(abs(sgn(__1))))";
|
||
$fidx=2;
|
||
$funcname[2]="neg";
|
||
$anz_pm[2]=1;
|
||
$expr[2]="(pos(-(__1)))";
|
||
$fidx=3;
|
||
$funcname[3]="if";
|
||
$anz_pm[3]=3;
|
||
$expr[3]="(u((__1)-0.5)*(__2)+u(0.5-(__1))*(__3))";
|
||
$fidx=4;
|
||
$funcname[4]="pwr";
|
||
$anz_pm[4]=2;
|
||
$expr[4]="(abs(__1)^(__2))";
|
||
$fidx=5;
|
||
$funcname[5]="pow";
|
||
$anz_pm[5]=2;
|
||
if($ltspice) {
|
||
$expr[5]="((__1)**(__2))";
|
||
}
|
||
else # spice3/xspice
|
||
{
|
||
$expr[5]="((__1)^(__2))";
|
||
}
|
||
$fidx=6;
|
||
# only binary parameter !!
|
||
$funcname[6]="not";
|
||
$anz_pm[6]=1;
|
||
$expr[6]="1-(abs(sgn(__1)))";
|
||
|
||
$fidx=7;
|
||
$funcname[7]="eq";
|
||
$anz_pm[7]=2;
|
||
$expr[7]="(not((__1)-(__2)))";
|
||
$fidx=8;
|
||
# or (1-eq((__1),(__2)))
|
||
$funcname[8]="ne";
|
||
$anz_pm[8]=2;
|
||
$expr[8]="(abs(sgn((__1)-(__2))))";
|
||
$fidx=9;
|
||
$funcname[9]="gt";
|
||
$anz_pm[9]=2;
|
||
$expr[9]="(u((__1)-(__2))*(abs(sgn((__1)-(__2)))))";
|
||
$fidx=10;
|
||
$funcname[10]="lt";
|
||
$anz_pm[10]=2;
|
||
$expr[10]="(u((__2)-(__1))*(abs(sgn((__2)-(__1)))))";
|
||
$fidx=11;
|
||
$funcname[11]="ge";
|
||
$anz_pm[11]=2;
|
||
$expr[11]="(gt((__1),(__2))+(eq((__1),(__2))))";
|
||
$fidx=12;
|
||
# 1-pos(x-y)
|
||
$funcname[12]="le";
|
||
$anz_pm[12]=2;
|
||
$expr[12]="(lt((__1),(__2))+(eq((__1),(__2))))";
|
||
$fidx=13;
|
||
$funcname[13]="max";
|
||
$anz_pm[13]=2;
|
||
#$expr[13]="(gt((__1),(__2))*(__1)+le((__1),(__2))*(__2))";
|
||
$expr[13]="((__1)*u((__1)-(__2))+(__2)*u((__2)-(__1)))";
|
||
$fidx=14;
|
||
$funcname[14]="min";
|
||
$anz_pm[14]=2;
|
||
$expr[14]="((__2)*u((__1)-(__2))+(__1)*u((__2)-(__1)))";
|
||
$fidx=15;
|
||
$funcname[15]="limit";
|
||
$anz_pm[15]=3;
|
||
#$expr[15]="((__1)+gt((__1),(__3))*((__3)-(__1))+lt((__1),(__2))*((__2)-(__1)))";
|
||
#$expr[15]="(max(min((__1),(__3)),(__2)))";
|
||
# u(x-hi)*hi + u(hi-x)*u(x-lo)*x + u(lo-x)*lo
|
||
$expr[15]="((u((__1)-(__3))*(__3))+(u((__3)-(__1))*u((__1)-(__2))*(__1))+(u((__2)-(__1))*(__2)))";
|
||
#equal LIMIT(x,lolim,uplim) = MAX(MIN(x,uplim),lowlim)
|
||
$fidx=16;
|
||
$funcname[16]="and";
|
||
$anz_pm[16]=2;
|
||
$expr[16]="(sgn(__1)*sgn(__2))";
|
||
$fidx=17;
|
||
$funcname[17]="or";
|
||
$anz_pm[17]=2;
|
||
$expr[17]="(sgn((__1)+(__2)))";
|
||
$fidx=18;
|
||
$funcname[18]="xor";
|
||
$anz_pm[18]=2;
|
||
$expr[18]="(abs(sgn((__1)-(__2))))";
|
||
$fidx=19;
|
||
$funcname[19]="stp"; # new
|
||
$anz_pm[19]=1;
|
||
$expr[19]="(u(__1))";
|
||
$fidx=20;
|
||
$funcname[20]="exp"; # new
|
||
$anz_pm[20]=1;
|
||
$expr[20]="(e^(__1))";
|
||
$fidx=21; #
|
||
$funcname[21]="buf"; #
|
||
$anz_pm[21]=1;
|
||
$expr[21]="(pos((__1)-0.5))";
|
||
$fidx=22;
|
||
$funcname[22]="inv";
|
||
$anz_pm[22]=1;
|
||
$expr[22]="(1-(pos((__1)-0.5)))";
|
||
$fidx=23;
|
||
$funcname[23]="atan2";
|
||
$anz_pm[23]=2;
|
||
$expr[23]="((sgn(__2)+1-abs(sgn(__2)))*acos((__1)/sqrt((__1)*(__1)+(__2)*(__2))))";
|
||
$fidx=24;
|
||
# .......... begin inserting new predefined function here
|
||
|
||
|
||
# predefined pfunctions:
|
||
# .pfunc definitions are used for all lines other than b-lines ( other devicelines , .param , .model , .tran .... )
|
||
# syntax: always perl syntax !!!
|
||
$pfidx=0; # startindex of user defined .pfunc lines
|
||
# parameters placeholders are defined with __1 , __2 , __3 .....
|
||
$pfuncname[0]="sgn";
|
||
$panz_pm[0]=1;
|
||
$pexpr[0]="((__1)<=>0)";
|
||
$pfidx=1;
|
||
$pfuncname[1]="neg";
|
||
$panz_pm[1]=1;
|
||
$pexpr[1]="(sgn(__1)*(sgn(__1)-1)/2)";
|
||
$pfidx=2;
|
||
$pfuncname[2]="pos";
|
||
$panz_pm[2]=1;
|
||
$pexpr[2]="(1-neg(__1))";
|
||
$pfidx=3;
|
||
$pfuncname[3]="pwrs";
|
||
$panz_pm[3]=2;
|
||
$pexpr[3]="(sgn(__1)*abs(__1)**(__2))";
|
||
$pfidx=4;
|
||
$pfuncname[4]="pwr";
|
||
$panz_pm[4]=2;
|
||
$pexpr[4]="(abs(__1)**(__2))";
|
||
$pfidx=5;
|
||
$pfuncname[5]="if";
|
||
$panz_pm[5]=3;
|
||
#$pexpr[5]="(pos((__1)-1)*(__2)+neg((__1)-1)*(__3))";
|
||
$pexpr[5]="((__1)>0.5?(__2):(__3))";
|
||
$pfidx=6;
|
||
$pfuncname[6]="gt";
|
||
$panz_pm[6]=2;
|
||
$pexpr[6]="((__1)>(__2))";
|
||
$pfidx=7;
|
||
$pfuncname[7]="lt";
|
||
$panz_pm[7]=2;
|
||
$pexpr[7]="((__1)<(__2))";
|
||
$pfidx=8;
|
||
$pfuncname[8]="ge";
|
||
$panz_pm[8]=2;
|
||
$pexpr[8]="((__1)>=(__2))";
|
||
$pfidx=9;
|
||
$pfuncname[9]="le";
|
||
$panz_pm[9]=2;
|
||
$pexpr[9]="((__1)<=(__2))";
|
||
$pfidx=10;
|
||
$pfuncname[10]="not";
|
||
$panz_pm[10]=1;
|
||
$pexpr[10]="1-(abs(sgn(__1)))";
|
||
$pfidx=11;
|
||
$pfuncname[11]="eq";
|
||
$panz_pm[11]=2;
|
||
$pexpr[11]="((__1)==(__2))";
|
||
$pfidx=12;
|
||
$pfuncname[12]="ne";
|
||
$panz_pm[12]=2;
|
||
$pexpr[12]="((__1)!=(__2))";
|
||
$pfidx=13;
|
||
$pfuncname[13]="max";
|
||
$panz_pm[13]=2;
|
||
$pexpr[13]="((__1)>(__2)?(__1):(__2))";
|
||
$pfidx=14;
|
||
$pfuncname[14]="min";
|
||
$panz_pm[14]=2;
|
||
$pexpr[14]="((__1)<(__2)?(__1):(__2))";
|
||
$pfidx=15;
|
||
# special LIMIT2(v(vc),min(voff,von),max(voff,von))
|
||
$pfuncname[15]="limit";
|
||
$panz_pm[15]=3;
|
||
$pexpr[15]="((__1)+gt((__1),(__3))*((__3)-(__1))+lt((__1),(__2))*((__2)-(__1)))";
|
||
$pfidx=16;
|
||
$pfuncname[16]="and";
|
||
$panz_pm[16]=2;
|
||
$pexpr[16]="((__1)&&(__2))";
|
||
$pfidx=17;
|
||
$pfuncname[17]="or";
|
||
$panz_pm[17]=2;
|
||
$pexpr[17]="((__1)||(__2))";
|
||
$pfidx=18;
|
||
$pfuncname[18]="xor";
|
||
$panz_pm[18]=2;
|
||
$pexpr[18]="(abs(sgn((__1)-(__2))))";
|
||
$pfidx=19;
|
||
$pfuncname[19]="pow";
|
||
$panz_pm[19]=2;
|
||
$pexpr[19]="((__1)**(__2))";
|
||
$pfidx=20;
|
||
$pfuncname[20]="stp"; # new
|
||
$panz_pm[20]=1;
|
||
$pexpr[20]="(0.5*(sgn(__1)+1))"; # stp(-0.1)=0 stp(0)=0.5 stp(0.1)=1
|
||
$pfidx=21;
|
||
$pfuncname[21]="tan"; # new
|
||
$panz_pm[21]=1;
|
||
$pexpr[21]="((sin(__1))/(cos(__1)))";
|
||
$pfidx=22;
|
||
$pfuncname[22]="cot"; # new
|
||
$panz_pm[22]=1;
|
||
$pexpr[22]="((cos(__1))/(sin(__1)))";
|
||
$pfidx=23;
|
||
$pfuncname[23]="atan"; # new
|
||
$panz_pm[23]=1;
|
||
$pexpr[23]="(atan2((__1),1))";
|
||
$pfidx=24;
|
||
$pfuncname[24]="asin"; # new
|
||
$panz_pm[24]=1;
|
||
$pexpr[24]="(atan((__1)/(sqrt(1-(__1)**2))))";
|
||
$pfidx=25;
|
||
$pfuncname[25]="acos"; # new
|
||
$panz_pm[25]=1;
|
||
$pexpr[25]="(pi/2-(asin((__1))))";
|
||
$pfidx=26;
|
||
$pfuncname[26]="sinh"; # new
|
||
$panz_pm[26]=1;
|
||
$pexpr[26]="(0.5*(exp(__1)-exp(-(__1))))";
|
||
$pfidx=27;
|
||
$pfuncname[27]="cosh"; # new
|
||
$panz_pm[27]=1;
|
||
$pexpr[27]="(0.5*(exp(__1)+exp(-(__1))))";
|
||
$pfidx=28; #
|
||
$pfuncname[28]="log10"; # in perl log means ln , log(10) is not defined
|
||
$panz_pm[28]=1;
|
||
$pexpr[28]="ln(__1)/ln(10)"; # conversion ln to log with ln
|
||
$pfidx=29;
|
||
$pfuncname[29]="ln"; # perl log(x) is ln(x) !!!!
|
||
$panz_pm[29]=1;
|
||
$pexpr[29]="(log(__1))";
|
||
$pfidx=30; #
|
||
$pfuncname[30]="u"; #
|
||
$panz_pm[30]=1;
|
||
$pexpr[30]="(stp(__1))";
|
||
$pfidx=31; #
|
||
$pfuncname[31]="uramp"; #
|
||
$panz_pm[31]=1;
|
||
$pexpr[31]="((__1)*pos(__1))";
|
||
$pfidx=32; #
|
||
$pfuncname[32]="buf"; #
|
||
$panz_pm[32]=1;
|
||
$pexpr[32]="(pos((__1)-0.5))";
|
||
$pfidx=33;
|
||
$pfuncname[33]="inv"; # perl log(x) is ln(x) !!!!
|
||
$panz_pm[33]=1;
|
||
$pexpr[33]="(1-(pos((__1)-0.5)))";
|
||
$pfidx=34; # begin inserting new predefined function here
|
||
|
||
# predefined in perl are :
|
||
# int, rand(int) , srand(int) , log ( natural log = base e )
|
||
# sqrt, abs , cos , sin , atan2(x,y) = 4 quadrant atan(x/y) (x,y in radiant)
|
||
# bitright is >> , bitleft is << , bitand & ,bitor |, bitnot ^,
|
||
# modulus is % , power is **
|
||
# equal ==, notequal !=
|
||
# logical not is not or !
|
||
# logical xor is xor
|
||
# logical and means if-then XandY or X&&Y
|
||
# logical or means ifnot then XorY or X||Y
|
||
# if-then-else X?Y:Z ,
|
||
# if lower then -1 elseif greater then 1 else 0 A<=>B (compare) -1,1,0
|
||
|
||
# some other fuctions possible to add ..
|
||
###############################
|
||
# sec(x) = 1/cos(x)
|
||
# csc(x) = 1/sin(x)
|
||
# tanh(x) = sinh(x)/cosh(x)
|
||
# cothx(x) = cosh(x)/sinh(x)
|
||
# sech(x) = 1/cosh(x)
|
||
# csch(x) = 1/sinh(x)
|
||
###############################
|
||
}
|
||
|