From 3bb868679fdeb6f0c2fa1b024ea3fc37cea4febd Mon Sep 17 00:00:00 2001 From: Guilherme Brondani Torri Date: Tue, 26 Jan 2016 22:46:01 +0100 Subject: [PATCH] Move back files that belong with qucs/contrib. --- contrib/CMakeLists.txt | 5 + contrib/Makefile.am | 30 + contrib/ps2sp | 4020 ++++++++++++++++++++++++++++++++++++++++ contrib/ps2sp.1 | 88 + 4 files changed, 4143 insertions(+) create mode 100644 contrib/CMakeLists.txt create mode 100644 contrib/Makefile.am create mode 100755 contrib/ps2sp create mode 100644 contrib/ps2sp.1 diff --git a/contrib/CMakeLists.txt b/contrib/CMakeLists.txt new file mode 100644 index 00000000..9b9d417e --- /dev/null +++ b/contrib/CMakeLists.txt @@ -0,0 +1,5 @@ + +# Netlist preprocessor script and man page +INSTALL( FILES ps2sp DESTINATION bin/ ) + +INSTALL( FILES ps2sp.1 DESTINATION share/man/man1 ) diff --git a/contrib/Makefile.am b/contrib/Makefile.am new file mode 100644 index 00000000..3b78f25e --- /dev/null +++ b/contrib/Makefile.am @@ -0,0 +1,30 @@ +## Process this file with automake to produce Makefile.in +# +# qucs/contrib/Makefile.am +# +# Automake input file. +# +# Copyright (C) 2007, 2008 Stefan Jahn +# +# 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. +# + +dist_bin_SCRIPTS = ps2sp + +dist_man_MANS = ps2sp.1 + +CLEANFILES = *~ *.rej *.orig +MAINTAINERCLEANFILES = Makefile.in diff --git a/contrib/ps2sp b/contrib/ps2sp new file mode 100755 index 00000000..91c604fb --- /dev/null +++ b/contrib/ps2sp @@ -0,0 +1,4020 @@ +#! /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'); +$MULTILINE_MATCHING = 1; # perl parameter Pattern match with multi-line strings. ---------- deprecated + +# global vars for user defined pspice functions , pfunctions , parameters +%param=(); # global Parameter hash for .param and params: lines +$fidx=(); # index of user defined .func lines @funcname, @anz_pm , @expr +$pfix=(); # index of user defined .pfunc lines @pfuncname, @panz_pm , @pexpr +@funcname=(); # names of user defined function names +@pfuncname=(); # names of user defined pfunction names +@anz_pm=(); # parametercount of user defined functions +@panz_pm=(); # parametercount of user defined pfunctions +@expr=(); # rhs of function = expression +@pexpr=(); # rhs of pfunction = expression +%globals=(); # hash for .global lines ( global nodes ) + +################################### M A I N ############################################# +######################################################################################### + +&initialize_predefined_parameter_functions; # initialize global parameters , functions +&getargs(); # get switches from the ps2sp.pl command line +&first_stage; # subcircuit expansion , savebias , loadbias , .lib , .inc + +open (INFILE,$infile) || die "Can't open source file sub.tmp : $infile\n"; + $_=;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 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 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 [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) + ############################### +} + diff --git a/contrib/ps2sp.1 b/contrib/ps2sp.1 new file mode 100644 index 00000000..d3170535 --- /dev/null +++ b/contrib/ps2sp.1 @@ -0,0 +1,88 @@ +.\" DO NOT MODIFY THIS FILE! It was generated by help2man 1.36. +.TH PS2SP "1" "June 2007" "ps2sp version 4.14" "User Commands" +.SH NAME +ps2sp \- manual page for ps2sp version 4.14 +.SH SYNOPSIS +.B ps2sp +\fR[\fIOPTION\fR] \fIinfile > outfile\fR +.SH DESCRIPTION +.TP +This utility is a SPICE netlist preprocessor. +.TP +It converts netlists in PSPICE syntax to an equivalent SPICE3/XSPICE netlist syntax. +.TP +Recognized are nearly all PSPICE features like: +.IP "*" 4 +local and global parameter (expression) definition (.PARAM) +.IP "*" 4 +parameter (expression) passing to subcircuits (PARAMS:) +.IP "*" 4 +local and global function definition (.FUNC) +.IP "*" 4 +E and G-device VALUE=f(V,I), TABLE and POLY lines +.IP "*" 4 +E and G-device functions like IDT(), DDT(), LIMIT(), PWRS(), PWR(), IF(), +MAX(), MIN(), relational ops, ... +.IP "*" 4 +R-device VALUE=f(V,I), L-device FLUX=f(V,I) and C-device Q=f(V,I) +.IP "*" 4 +spice2 like C and L-device POLY expressions +.IP "*" 4 +pspice VSWITCH and ISWITCH models +.IP "*" 4 +pspice .PROBE lines (also with expressions) +.IP "*" 4 +R-device lines with temperature coefficients like TC=tc1,tc2 +.IP "*" 4 +pspice .STEP PARAM lines (not yet tested on GNU/Linux) +.IP "*" 4 +pspice .LIB and .INC(lude) lines (not yet tested on GNU/Linux) +.SH OPTIONS +\fB\-h\fR, \fB\-\-help\fR +displays the help screen +.TP +\fB\-v\fR, \fB\-\-version\fR +display version information and exit +.TP +\fB\-sp3\fR +switch means conversion of pspice table to spice 3 b\-source +instead of xspice core model (default) +.TP +\fB\-ltspice\fR +switch means conversion of ^ spice 3 power to ** ltspice +power and addition of tripdv=1 tripdt=1 in b\-lines +.TP +\fB\-debug\fR +for debugging all .param .func and .pfunc definitions +(default is nodebug) +.TP +\fB\-tosub\fR +only output subckt expansions +.TP +\fB\-fromsub\fR +inputfile is a sub.tmp file +.TP +\fB\-tolib\fR +only output lib expansions +.TP +\fB\-fromlib\fR +inputfile is a lib.tmp file +.TP +\fB\-check\fR +determine the same count of open and closed paranthesis +in b\-lines (default is nocheck) +.TP +\fB\-notinylines\fR +produces longer b\-lines for some functions (default is +tinylines = shorter b\-lines) +.TP +\fB\-xornot\fR +allows ^ and ~ operators in the netfile (don't mix with ^ as +power operator) use the ** operator as power instead +.SH "REPORTING BUGS" +Report bugs to Friedrich Schmidt +.SH COPYRIGHT +Copyright \(co 2003, 2004, 2005, 2006, 2007 Friedrich Schmidt +.PP +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.