#! /usr/bin/perl # # Copyright 2003/2004/2005/2006/2007 by Friedrich Schmidt # Copyright 2000 by John Sheahan # 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 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'); $* = 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"; $_=;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"; $_=;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.pl 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 () { 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#.. §}.. §) (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) =(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) $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 (n2) { # .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.pl 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= else $line=$nxtline chop($line = defined($nxtline) ? $nxtline : ); $linenum = $.; # act. linenumber if( not $linenum eq 1 )# new detect first line !! ) { while ($nxtline = ) { 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 () { 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 () { 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 () { 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=; $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 \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.pl [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 \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) ############################### }