luke
/
ngspice
mirror of https://git.code.sf.net/p/ngspice/ngspice
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Improvements in numparam from Phil Barker

This commit is contained in:
pnenzi 2007-10-08 14:52:25 +00:00
parent c729c6f353
commit 3097c4e04b
9 changed files with 631 additions and 359 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
ChangeLog
View File

@ -1,3 +1,13 @@
2207-10-8 Paolo Nenzi <p.nenzi@ieee.org>
* src/frontend/numparam/{general.h, mystring.c, numpaif.h, numparam.h,
nupatest.c, spicenum.c, washprog.c, xpressn.c}: Applied patch from Phil
Barker that improves the capabilites of numparam library. Now numparam
supports fully parametrized netlists and can handle a larger set of
parameters than the previous implementation. Added 'nupa_add_param' routine
and ability to reevaluate parameter set using 'nupa_eval' by keeping parameter
value set. Added support for 'ternary' operators in parameters as well as 'max'
and 'min'.
2007-09-17 Paolo Nenzi <p.nenzi@ieee.org>
* src/frontend/com_let.c: Applied patch from Friedrich Schmidt to fix
the big in let command that prevented the following command to be

56
src/frontend/numparam/general.h
View File

@ -9,7 +9,7 @@
#define Proc void
#define Begin {
#define EndProc ;}
/* Func short ...(...) Begin...EndFunc */
/* Func int ...(...) Begin...EndFunc */
#define Func
#define EndFunc ;}
/* If ... Then...ElsIf..Then...Else...EndIf */
@ -94,7 +94,7 @@ Type(Byte, unsigned char)
#ifndef Bool
Type(Bool, unsigned char)
#endif
Type(Word, unsigned short)
Type(Word, unsigned int)
Type(Pchar, char AT)
#define Intern static
@ -103,7 +103,7 @@ Type(Pchar, char AT)
#define Tarray2(a,d,n,m) typedef d a[n][m];
#define Darray(a,d,n) d a[n];
#define Const(x,y) const short x=y;
#define Const(x,y) const int x=y;
#define Cconst(x,y) typedef enum {x=y} _n ## x;
#define Aconst(a,tp,sze) tp a[sze] ={
@ -136,7 +136,7 @@ Type(Pchar, char AT)
#define Str(n,a) char a[n+3]={0,0,(char)n} /* n<255 ! */
#define Sini(s) sini(s,sizeof(s)-4)
Cconst(Maxstr,2004) /* was 255, string maxlen, may be up to 32000 or so */
Cconst(Maxstr,15000) /* was 255, string maxlen, may be up to 32000 or so */
typedef char string[258];
@ -146,37 +146,39 @@ Cconst(Bs, 8)
Cconst(Lf, 10)
Cconst(Cr, 13)
Proc sini( Pchar s, short i);
Proc sfix(Pchar s, short i, short max);
Func short maxlen(Pchar s);
Func Pchar pscopy( Pchar s, Pchar a, short i,short j);
Proc sini( Pchar s, int i);
Proc sfix(Pchar s, int i, int max);
Func int maxlen(Pchar s);
Func Pchar pscopy( Pchar s, Pchar a, int i,int j);
Func Pchar pscopy_up( Pchar s, Pchar a, int i,int j);
Func Bool scopy( Pchar a, Pchar b);
Func Bool scopy_up( Pchar a, Pchar b);
Func Bool ccopy( Pchar a, char c);
Func Bool sadd( Pchar s, Pchar t);
Func Bool nadd( Pchar s, long n);
Func Bool cadd( Pchar s, char c);
Func Bool sins( Pchar s, Pchar t);
Func Bool cins( Pchar s, char c);
Func short cpos( char c, Pchar s);
Func short spos( Pchar sub, Pchar s);
Func short length(Pchar s);
Func int cpos( char c, Pchar s);
Func int spos( Pchar sub, Pchar s);
int ci_prefix( register char *p, register char *s );
Func int length(Pchar s);
Func Bool steq(Pchar s, Pchar t);
Func Bool stne(Pchar s, Pchar t);
Func short scompare(Pchar a, Pchar b);
Func short ord(char c);
Func short pred(short i);
Func short succ(short i);
Func int scompare(Pchar a, Pchar b);
Func int ord(char c);
Func int pred(int i);
Func int succ(int i);
Proc stri(long n, Pchar s);
Proc strif(long n, short f, Pchar s);
Proc strf(double x, short a, short b, Pchar s); /* float -> string */
Func long ival(Pchar s, short *err);
Func double rval(Pchar s, short *err);
Proc strif(long n, int f, Pchar s);
Proc strf(double x, int a, int b, Pchar s); /* float -> string */
Func long ival(Pchar s, int *err);
Func double rval(Pchar s, int *err);
Func char upcase(char c);
Func char lowcase(char c);
Func short hi(long w);
Func short lo(long w);
Func int hi(long w);
Func int lo(long w);
Func Bool odd(long x);
Func Bool alfa(char c);
Func Bool num(char c);
@ -191,12 +193,12 @@ Proc wi(long i);
Proc rs( Pchar s);
Func char rc(void);
Func short freadstr(Pfile f, Pchar s, short max);
Func int freadstr(Pfile f, Pchar s, int max);
Func char freadc(Pfile f);
Func long freadi(Pfile f);
Func long np_round(double d); /* sjb to avoid clash with round() in math.h */
Func long np_trunc(double x); /* sjb to avoid clash with trunc() in math.h */
Func long np_round(double d); // sjb to avoid clash with round() in math.h
Func long np_trunc(double x); // sjb to avoid clash with trunc() in math.h
Func double sqr(double x);
Func double absf(double x); /* abs */
Func long absi( long i);
@ -204,8 +206,8 @@ Func double frac(double x);
Func Bool reset(Pfile f);
Func Bool rewrite(Pfile f);
Proc rawcopy(Pointer a, Pointer b, short la, short lb);
Proc rawcopy(Pointer a, Pointer b, int la, int lb);
Func Pointer new(long sz);
Proc dispose(Pointer p);
Func Pchar newstring(short n);
Func Pchar newstring(int n);

210
src/frontend/numparam/mystring.c
View File

@ -11,6 +11,8 @@ extern unsigned _stklen= 32000; /* Turbo C default was only 4 K */
#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include <string.h>
/* #include <math.h> -- ceil floor */
#include "config.h"
#ifdef HAS_WINDOWS
@ -23,6 +25,19 @@ extern unsigned _stklen= 32000; /* Turbo C default was only 4 K */
/***** primitive input-output ***/
int
ci_prefix(register char *p, register char *s)
{
while (*p) {
if ((isupper(*p) ? tolower(*p) : *p) !=
(isupper(*s) ? tolower(*s) : *s))
return(0);
p++;
s++;
}
return (1);
}
Proc wc(char c)
Begin
fputc(c, stdout)
@ -33,7 +48,7 @@ Begin wc('\n') EndProc
Proc ws( Pchar s)
Begin
short k=0;
int k=0;
While s[k] !=0 Do
wc(s[k]); Inc(k)
Done
@ -48,8 +63,9 @@ EndProc
Proc rs( Pchar s)
Begin /*basic line input, limit= 80 chars */
short max,i;
int max,i;
char c;
exit(-1);
max=maxlen(s);
i=0; sini(s,max);
If max>80 Then max=80 EndIf
@ -64,7 +80,7 @@ EndFunc
Func char rc(void)
Begin
short ls;
int ls;
Str(80,s);
rs(s); ls=length(s);
If ls>0 Then
@ -95,23 +111,22 @@ Proc stringbug(Pchar op, Pchar s, Pchar t, char c)
/* we brutally stop the program on string overflow */
Begin
char rep=' ';
ws(" STRING overflow ");
ws(op); wln();
ws(" Operand1: ");
ws(s); wln();
fprintf( stderr, " STRING overflow %s\n", op );
fprintf( stderr, " Operand1: %s\n", s );
If t != Null Then
ws(" Operand2: ");
ws(t); wln();
fprintf( stderr, " Operand2: %s\n", t );
EndIf
If c != 0 Then
wc('{'); wc(c); wc('}')
fprintf( stderr, "{%c}\n", c );
EndIf
fprintf( stderr, "Aborting...\n" );
exit(1);
ws(" [A]bort [I]gnore ? ");
rep=rc();
If upcase(rep)=='A' Then exit(1) EndIf
EndProc
Proc sini(Pchar s, short max) /* suppose s is allocated */
Proc sini(Pchar s, int max) /* suppose s is allocated */
Begin
If max<1 Then
max=1
@ -122,10 +137,10 @@ Begin
s[1]= Hi(max); s[2]= Lo(max);
EndProc
Proc sfix(Pchar s, short i, short max)
Proc sfix(Pchar s, int i, int max)
/* suppose s is allocated and filled with non-zero stuff */
Begin
short j;
int j;
If max<1 Then
max=1
ElsIf max>Maxstr Then
@ -144,10 +159,10 @@ Begin
EndProc
Intern
Proc inistring(Pchar s, char c, short max)
Proc inistring(Pchar s, char c, int max)
/* suppose s is allocated. empty it if c is zero ! */
Begin
short i=0;
int i=0;
s[i]=c;
If c!=0 Then
Inc(i); s[i]=0
@ -160,23 +175,23 @@ Begin
s[i+1]= Hi(max); s[i+2]= Lo(max);
EndProc
Func short length(Pchar s)
Func int length(Pchar s)
Begin
short lg=0;
int lg=0;
While NotZ(s[lg]) Do Inc(lg) Done
return lg
EndFunc
Func short maxlen(Pchar s)
Func int maxlen(Pchar s)
Begin
short ls= length(s);
int ls= length(s);
return Getmax(s,ls)
EndFunc
Func Bool sadd( Pchar s, Pchar t)
Begin
Bool ok;
short i=0, max, ls= length(s);
int i=0, max, ls= length(s);
max= Getmax(s,ls);
While (t[i] !=0) And (ls<max) Do
s[ls]= t[i];
@ -193,7 +208,7 @@ EndProc
Func Bool cadd( Pchar s, char c)
Begin
short max, ls= length(s);
int max, ls= length(s);
Bool ok;
max= Getmax(s,ls);
ok= (ls<max);
@ -209,7 +224,7 @@ EndProc
Func Bool cins( Pchar s, char c)
Begin
short i, max, ls= length(s);
int i, max, ls= length(s);
Bool ok;
max= Getmax(s,ls);
ok= (ls<max);
@ -225,7 +240,7 @@ EndProc
Func Bool sins( Pchar s, Pchar t)
Begin
short i, max, ls= length(s), lt=length(t);
int i, max, ls= length(s), lt=length(t);
Bool ok;
max= Getmax(s,ls);
ok= ((ls+lt) < max);
@ -239,12 +254,12 @@ Begin
return ok
EndProc
Func short cpos(char c, Pchar s)
Func int cpos(char c, Pchar s)
/* return position of c in s, or 0 if not found.
* BUG, Pascal inherited: first char is at 1, not 0 !
*/
Begin
short i=0;
int i=0;
While (s[i] !=c) And (s[i] !=0) Do Inc(i) Done
If s[i]==c Then
return (i+1)
@ -265,7 +280,7 @@ EndFunc
Func Bool scopy(Pchar s, Pchar t) /* returns success flag */
Begin
Bool ok;
short i,max, ls= length(s);
int i,max, ls= length(s);
max= Getmax(s,ls);
i=0;
While (t[i] !=0) And (i<max) Do
@ -280,9 +295,27 @@ Begin
return ok
EndProc
Func Bool scopy_up(Pchar s, Pchar t) /* returns success flag */
Begin
Bool ok;
int i,max, ls= length(s);
max= Getmax(s,ls);
i=0;
While (t[i] !=0) And (i<max) Do
s[i]= upcase(t[i]); Inc(i);
Done
s[i]=0;
s[i+1]= Hi(max); s[i+2]= Lo(max);
ok= (t[i]==0); /* end of t is reached */
If Not ok Then
stringbug("scopy_up",s, t,0)
EndIf
return ok
EndProc
Func Bool ccopy(Pchar s, char c) /* returns success flag */
Begin
short max, ls= length(s);
int max, ls= length(s);
Bool ok=False;
max= Getmax(s,ls);
If max>0 Then
@ -295,13 +328,13 @@ Begin
return ok
EndProc
Func Pchar pscopy(Pchar s, Pchar t, short start, short leng)
Func Pchar pscopy(Pchar s, Pchar t, int start, int leng)
/* partial string copy, with Turbo Pascal convention for "start" */
/* BUG: position count starts at 1, not 0 ! */
Begin
short max= maxlen(s); /* keep it for later */
short stop= length(t);
short i;
int max= maxlen(s); /* keep it for later */
int stop= length(t);
int i;
Bool ok= (max>=0) And (max<=Maxstr);
If Not ok Then
stringbug("copy target non-init", s, t, 0)
@ -327,17 +360,49 @@ Begin
return s
EndProc
Func short ord(char c)
Func Pchar pscopy_up(Pchar s, Pchar t, int start, int leng)
/* partial string copy, with Turbo Pascal convention for "start" */
/* BUG: position count starts at 1, not 0 ! */
Begin
int max= maxlen(s); /* keep it for later */
int stop= length(t);
int i;
Bool ok= (max>=0) And (max<=Maxstr);
If Not ok Then
stringbug("copy target non-init", s, t, 0)
EndIf
If leng>max Then
leng=max; ok=False
EndIf
If start>stop Then /* nothing! */
ok=False;
inistring(s,0,max)
Else
If (start+leng-1)>stop Then
leng = stop-start+1;
ok=False
EndIf
For i=0; i<leng; Inc(i) Do s[i]= upcase(t[start+i -1]) Done
i=leng; s[i]=0;
s[i+1]= Hi(max); s[i+2]= Lo(max);
EndIf
/* If Not ok Then stringbug("copy",s, t, 0) EndIf */
/* If ok Then return s Else return Null EndIf */
ok=ok;
return s
EndProc
Func int ord(char c)
Begin
return c AND 0xff
EndFunc /* strip high byte */
Func short pred(short i)
Func int pred(int i)
Begin
return (--i)
EndFunc
Func short succ(short i)
Func int succ(int i)
Begin
return (++i)
EndFunc
@ -345,8 +410,8 @@ EndFunc
Func Bool nadd( Pchar s, long n)
/* append a decimal integer to a string */
Begin
short d[25];
short j,k,ls,len;
int d[25];
int j,k,ls,len;
char sg; /* the sign */
Bool ok;
k=0;
@ -388,10 +453,10 @@ Begin
nadd(s,n)
EndProc
Proc rawcopy(Pointer a, Pointer b, short la, short lb)
Proc rawcopy(Pointer a, Pointer b, int la, int lb)
/* dirty binary copy */
Begin
short j,n;
int j,n;
If lb<la Then
n=lb
Else
@ -402,10 +467,10 @@ Begin
Done
EndProc
Func short scompare(Pchar a, Pchar b)
Func int scompare(Pchar a, Pchar b)
Begin
Word j=0;
short k=0;
int k=0;
While (a[j]==b[j]) And (a[j]!=0) And (b[j]!=0) Do Inc(j) Done;
If a[j]<b[j] Then
k= -1
@ -427,12 +492,12 @@ Begin
return scompare(s,t) !=0
EndFunc
Func short hi(long w)
Func int hi(long w)
Begin
return (w AND 0xff00) Shr 8
EndFunc
Func short lo(long w)
Func int lo(long w)
Begin
return (w AND 0xff)
EndFunc
@ -448,7 +513,7 @@ EndFunc
Func Bool alfa( char c)
Begin
return ((c>='a') And (c<='z')) Or ((c>='A') And (c<='Z'));
return ((c>='a') And (c<='z')) Or ((c>='A') And (c<='Z')) || c == '_' || c == '[' || c == ']';
EndFunc
Func Bool num( char c)
@ -459,18 +524,17 @@ EndFunc
Func Bool alfanum(char c)
Begin
return
((c>='a') And (c<='z')) Or ((c>='A')And(c<='Z'))
alfa(c)
Or ((c>='0')And(c<='9'))
Or (c=='_')
EndFunc
Func short freadstr(Pfile f, Pchar s, short max)
Func int freadstr(Pfile f, Pchar s, int max)
/* read a line from a file.
BUG: long lines truncated without warning, ctrl chars are dumped.
*/
Begin
char c;
short i=0, mxlen=maxlen(s);
int i=0, mxlen=maxlen(s);
If mxlen<max Then max=mxlen EndIf
Repeat
c=fgetc(f); /* tab is the only control char accepted */
@ -509,7 +573,7 @@ EndFunc
Func Pchar stupcase( Pchar s)
Begin
short i=0;
int i=0;
While s[i] !=0 Do
s[i]= upcase(s[i]); Inc(i)
Done
@ -544,7 +608,7 @@ Begin
EndIf
EndFunc
Func Pchar newstring(short n)
Func Pchar newstring(int n)
Begin
Pchar s= (Pchar)new(n+4);
sini(s, n);
@ -576,10 +640,10 @@ Begin
EndIf
EndFunc
Proc strif(long i, short f, Pchar s)
Proc strif(long i, int f, Pchar s)
/* formatting like str(i:f,s) in Turbo Pascal */
Begin
short j,k,n,max;
int j,k,n,max;
char cs;
char t[32];
k=0;
@ -590,7 +654,7 @@ Begin
cs=' '
EndIf;
While i>0 Do
j=(short)(i Mod 10);
j=(int)(i Mod 10);
i=(long)(i Div 10);
t[k]=chr('0'+j); Inc(k)
Done
@ -621,11 +685,11 @@ Begin
return NotZ(x AND 1)
EndFunc
Func short vali(Pchar s, long * i)
Func int vali(Pchar s, long * i)
/* convert s to integer i. returns error code 0 if Ok */
/* BUG: almost identical to ival() with arg/return value swapped ... */
Begin
short k=0, digit=0, ls;
int k=0, digit=0, ls;
long z=0;
Bool minus=False, ok=True;
char c;
@ -654,11 +718,11 @@ EndFunc
Intern
Func Bool match
(Pchar s, Pchar t, short n, short tstart, Bool testcase)
(Pchar s, Pchar t, int n, int tstart, Bool testcase)
Begin
/* returns 0 If tstart is out of range. But n may be 0 ? */
/* True if s matches t[tstart...tstart+n] */
short i,j,lt;
int i,j,lt;
Bool ok;
char a,b;
i=0; j=tstart;
@ -676,13 +740,13 @@ Begin
EndFunc
Intern
Func short posi(Pchar sub, Pchar s, short opt)
Func int posi(Pchar sub, Pchar s, int opt)
/* find position of substring in s */
Begin
/* opt=0: like Turbo Pascal */
/* opt=1: like Turbo Pascal Pos, but case insensitive */
/* opt=2: position in space separated wordlist for scanners */
short a,b,k,j;
int a,b,k,j;
Bool ok, tstcase;
Str(250,t);
ok=False;
@ -693,7 +757,7 @@ Begin
cadd(t,' '); sadd(t,sub); cadd(t,' ');
EndIf
a= length(t);
b= (short)(length(s)-a);
b= (int)(length(s)-a);
k=0; j=1;
If a>0 Then /*Else return 0*/
While (k<=b) And (Not ok) Do
@ -710,20 +774,24 @@ Begin
EndIf
EndFunc
Func short spos(Pchar sub, Pchar s)
Func int spos(Pchar sub, Pchar s)
/* equivalent to Turbo Pascal pos().
BUG: counts 1 ... length(s), not from 0 like C
*/
Begin
return posi( sub, s, 0)
char *ptr;
if ( ( ptr = strstr( s, sub ) ) ) return strlen(s) - strlen(ptr) + 1;
else return 0;
EndFunc
/**** float formatting with printf/scanf ******/
Func short valr(Pchar s, double *r)
Func int valr(Pchar s, double *r)
/* returns 0 if ok, else length of partial string ? */
Begin
short n=sscanf(s, "%lG", r);
int n=sscanf(s, "%lG", r);
If n==1 Then
return(0)
Else
@ -731,12 +799,12 @@ Begin
EndIf
EndFunc
Proc strf( double x, short f1, short f2, Pchar t)
Proc strf( double x, int f1, int f2, Pchar t)
/* e-format if f2<0, else f2 digits after the point, total width=f1 */
/* if f1=0, also e-format with f2 digits */
Begin /*default f1=17, f2=-1*/
Str(30,fmt);
short n,mlt;
int n,mlt;
mlt=maxlen(t);
cadd(fmt,'%');
If f1>0 Then
@ -746,7 +814,7 @@ Begin /*default f1=17, f2=-1*/
Else
cadd(fmt,'.');
nadd(fmt,f2);
sadd(fmt,"lf")
sadd(fmt,"lg")
EndIf
Else
cadd(fmt,'.');
@ -757,11 +825,11 @@ Begin /*default f1=17, f2=-1*/
sfix(t,n, mlt);
EndProc
Func double rval(Pchar s, short *err)
Func double rval(Pchar s, int *err)
/* returns err=0 if ok, else length of partial string ? */
Begin
double r= 0.0;
short n=sscanf(s, "%lG", &r);
int n=sscanf(s, "%lG", &r);
If n==1 Then
(*err)=0
Else
@ -770,10 +838,10 @@ Begin
return r;
EndFunc
Func long ival(Pchar s, short *err)
Func long ival(Pchar s, int *err)
/* value of s as integer string. error code err= 0 if Ok */
Begin
short k=0, digit=0, ls;
int k=0, digit=0, ls;
long z=0;
Bool minus=False, ok=True;
char c;
@ -807,7 +875,7 @@ Func long np_round(double x)
Begin
double u;
long z;
short n;
int n;
Str(40,s);
u=2e9;
If x>u Then

7
src/frontend/numparam/numpaif.h
View File

@ -15,6 +15,11 @@
extern char * nupa_copy(char *s, int linenum);
extern int nupa_eval(char *s, int linenum);
extern int nupa_signal(int sig, char *info);
extern void nupa_scan(char * s, int linenum);
extern void nupa_scan(char * s, int linenum, int is_subckt);
extern void nupa_list_params();
extern double nupa_get_param(char *param_name, int *found);
extern void nupa_add_param(char *param_name, double value);
extern void nupa_add_inst_param(char *param_name, double value);
extern void nupa_copy_inst_dico();
#endif /* NUMPAIF_H */

36
src/frontend/numparam/numparam.h
View File

@ -17,27 +17,27 @@ Cconst(Nodekey,'#') /*introduces node symbol*/
Cconst(Intro ,'&') /*introduces preprocessor tokens*/
Cconst(Comment,'*') /*Spice Comment lines*/
Cconst(Pspice,'{') /*Pspice expression */
Cconst(Maxdico,200) /*size of symbol table*/
Cconst(Maxdico,40000) /*size of symbol table*/
/* Composite line length
This used to be 250 characters, but this is too easy to exceed with a
.model line, especially when spread over several continuation
lines with much white space. I hope 1000 will be enough. */
Cconst(Llen,1000)
Cconst(Llen,15000)
typedef char str20 [24];
typedef char str50 [54];
typedef char str80 [84];
Cconst(Maxline, 1000) /* size of initial unexpanded circuit code */
Cconst(Maxckt, 5000) /* size of expanded circuit code */
Cconst(Maxline, 40000) /* size of initial unexpanded circuit code */
Cconst(Maxckt, 40000) /* size of expanded circuit code */
typedef Pchar auxtable; /* dummy */
Record(entry)
char tp; /* type: I)nt R)eal S)tring F)unction M)acro P)ointer */
str20 nom;
short level; /* subckt nesting level */
char nom[100];
int level; /* subckt nesting level */
double vl; /* float value if defined */
Word ivl; /*int value or string buffer index*/
Pchar sbbase; /* string buffer base address if any */
@ -50,28 +50,32 @@ EndRec(fumas)
Record(tdico)
/* the input scanner data structure */
str80 srcfile; /* last piece of source file name */
short srcline;
short errcount;
int srcline;
int errcount;
entry dat[Maxdico+1];
short nbd; /* number of data entries */
int nbd; /* number of data entries */
fumas fms[101];
short nfms; /* number of functions & macros */
short stack[20];
short tos; /* top of stack index for symbol mark/release mechanics */
str20 option; /* one-character translator options */
int nfms; /* number of functions & macros */
int stack[20];
char *inst_name[20];
int tos; /* top of stack index for symbol mark/release mechanics */
str80 option; /* one-character translator options */
auxtable nodetab;
Darray(refptr, Pchar, Maxline) /* pointers to source code lines */
Darray(category, char, Maxline) /* category of each line */
EndRec(tdico)
Proc initdico(tdico * dico);
Func short donedico(tdico * dico);
Func int donedico(tdico * dico);
Func Bool defsubckt( tdico *dico, Pchar s, Word w, char categ);
Func short findsubckt( tdico *dico, Pchar s, Pchar subname);
Func int findsubckt( tdico *dico, Pchar s, Pchar subname);
Func Bool nupa_substitute( tdico *dico, Pchar s, Pchar r, Bool err);
Func Bool nupa_assignment( tdico *dico, Pchar s, char mode);
Func Bool nupa_subcktcall( tdico *dico, Pchar s, Pchar x, Bool err);
Proc nupa_subcktexit( tdico *dico);
Func tdico * nupa_fetchinstance(void);
Func char getidtype( tdico *d, Pchar s);
Func int attrib( tdico *dico, Pchar t, char op );
char *nupa_inst_name;
tdico *inst_dico;

58
src/frontend/numparam/nupatest.c
View File

@ -18,10 +18,10 @@ Cconst(pfxsep,'_') /* official prefix separator is ':' not '_' ! */
Darray(buff, Pchar, Maxline) /* input lines */
Darray(buf2, Pchar, Maxline) /* stripped lines */
Darray(pxbuf, Pchar, Maxline) /* prefix for subnodes */
Darray(runbuf, short, Maxckt) /* index list of expanded circuit */
Darray(pindex, short, Maxckt) /* prefix index list */
short irunbuf= 0; /* count lines of runbuf */
short ipx=0; /* count prefixes in pxbuf */
Darray(runbuf, int, Maxckt) /* index list of expanded circuit */
Darray(pindex, int, Maxckt) /* prefix index list */
int irunbuf= 0; /* count lines of runbuf */
int ipx=0; /* count prefixes in pxbuf */
/*
this toy imitates the Spice subcircuit expansion.
@ -49,15 +49,15 @@ and substitute node/device name arguments.
*/
Func short runscript( tdico *dico, Pchar prefix,
short istart, short istop, short maxnest)
Func int runscript( tdico *dico, Pchar prefix,
int istart, int istop, int maxnest)
/* recursive top-down expansion: circuit --> list of line numbers */
/* keep it simple,stupid compared to Spice's code */
/* prefix: inherited string for node & device prefixing */
/* istart, istop: allowed interval in table buf[], buf2[]. */
/* return value: number of lines included */
Begin
short i,j, idef, nnest, nline, dn, myipx;
int i,j, idef, nnest, nline, dn, myipx;
Strbig(Llen, subpfx); /* subckt prefix */
Str(80, subname);
char c;
@ -113,10 +113,10 @@ Begin
return nline
EndProc
Proc gluepluslines( short imax)
Proc gluepluslines( int imax)
/* general sweep to eliminate continuation lines */
Begin
short i,j,k, ls, p;
int i,j,k, ls, p;
Strbig(Llen,s);
i=1;
While i<= imax Do
@ -145,10 +145,10 @@ EndProc
#if 0 /* sjb - this is in mystring.c */
Proc rs(Pchar s) /* 78 coumn limit */
Begin
short i;
int i;
Bool done;
char c;
short max=maxlen(s);
int max=maxlen(s);
If max>78 Then max=78 EndIf
i=0; done=False;
scopy(s,"");
@ -173,9 +173,9 @@ Begin
EndProc
Intern
Proc freadln(Pfile f, Pchar s, short max)
Proc freadln(Pfile f, Pchar s, int max)
Begin
short ls;
int ls;
freadstr(f,s,max);
ls=length(s);
If feof(f) And (ls>0) Then
@ -183,21 +183,21 @@ Begin
EndIf /* kill EOF character */
EndProc
Proc wordinsert(Pchar s, Pchar w, short i)
Proc wordinsert(Pchar s, Pchar w, int i)
/* insert w before s[i] */
Begin
Strbig(Llen,t);
short ls=length(s);
int ls=length(s);
pscopy(t,s,i+1,ls); pscopy(s,s,1,i);
sadd(s,w); sadd(s,t);
EndProc
Func short worddelete(Pchar s, short i)
Func int worddelete(Pchar s, int i)
/* delete word starting at s[i] */
Begin
Strbig(Llen,t);
short ls= length(s);
short j=i;
int ls= length(s);
int j=i;
While (j<ls) And (s[j]>' ') Do Inc(j) Done
pscopy(t,s,j+1,ls);
pscopy(s,s,1,i);
@ -205,9 +205,9 @@ Begin
return j-i /* nb of chars deleted */
EndProc
Func short getnextword(Pchar s, Pchar u, short j)
Func int getnextword(Pchar s, Pchar u, int j)
Begin
short ls,k;
int ls,k;
ls= length(s);
k=j;
While (j<ls) And (s[j] > ' ') Do Inc(j) Done /* skip current word */
@ -216,10 +216,10 @@ Begin
return j
EndFunc
Func short inwordlist(Pchar u, Pchar wl)
Func int inwordlist(Pchar u, Pchar wl)
/* suppose wl is single-space separated, plus 1 space at start and end. */
Begin
short n,p,k;
int n,p,k;
Str(80,t);
n=0;
ccopy(t,' '); sadd(t,u); cadd(t,' ');
@ -232,9 +232,9 @@ Begin
return n
EndFunc
Proc takewordlist(Pchar u, short k, Pchar wl)
Proc takewordlist(Pchar u, int k, Pchar wl)
Begin
short i,j,lwl;
int i,j,lwl;
lwl= length(wl);
i=0; j=0;
scopy(u,"");
@ -268,8 +268,8 @@ Reminder on Numparam symbols:
cannot re-use a model name as a param name elsewhere, for example.
*/
Begin
short i,j,k,ls, jnext, dsize;
short dtype, nodes, subdv;
int i,j,k,ls, jnext, dsize;
int dtype, nodes, subdv;
Bool done;
char leadchar;
Str(80,u); Str(80,v); Str(80,pfx);
@ -324,10 +324,10 @@ Begin
EndIf
EndProc
Proc getnodelist(Pchar form, Pchar act, Pchar s, tdico *dic, short k)
Proc getnodelist(Pchar form, Pchar act, Pchar s, tdico *dic, int k)
/* the line s contains the actual node parameters, between 1st & last word */
Begin
short j,ls, idef;
int j,ls, idef;
Str(80,u); Strbig(Llen,t);
ccopy(act,' '); ccopy(form,' ');
j=0; ls= length(s);
@ -364,7 +364,7 @@ Begin
/* Strbig(Llen, formals); Strbig(Llen,actuals); */
Darray(formals, Pchar, 10)
Darray(actuals, Pchar, 10)
short i, j, k, nline, parstack;
int i, j, k, nline, parstack;
For i=0; i<Maxline; Inc(i) Do /* allocate string storage */
buff[i]= newstring(80);
buf2[i]= Null;

207
src/frontend/numparam/spicenum.c
View File

@ -23,15 +23,20 @@ Todo:
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#ifdef __TURBOC__
#include <process.h> /* exit() */
#endif
#include "general.h"
#include "numparam.h"
#include "ngspice.h"
extern void txfree(void *ptr);
/* Uncomment this line to allow debug tracing */
/* #define TRACE_NUMPARAMS */
/*#define TRACE_NUMPARAMS*/
/* the nupa_signal arguments sent from Spice:
@ -58,10 +63,10 @@ Intern long placeholder= 0;
#ifdef NOT_REQUIRED /* SJB - not required as front-end now does stripping */
Intern
Func short stripcomment( Pchar s)
Func int stripcomment( Pchar s)
/* allow end-of-line comments in Spice, like C++ */
Begin
short i,ls;
int i,ls;
char c,d;
Bool stop;
ls=length(s);
@ -91,7 +96,7 @@ Proc stripsomespace(Pchar s, Bool incontrol)
Begin
/* iff s starts with one of some markers, strip leading space */
Str(12,markers);
short i,ls;
int i,ls;
scopy(markers,"*.&+#$");
If Not incontrol Then
sadd(markers,"xX")
@ -110,7 +115,7 @@ Proc partition(Pchar t)
/* bug: strip trailing spaces */
Begin
Strbig(Llen,u);
short i,lt,state;
int i,lt,state;
char c;
cadd(u,Intro);
state=0; /* a trivial 3-state machine */
@ -139,10 +144,10 @@ EndProc
#endif
Intern
Func short stripbraces( Pchar s)
Func int stripbraces( Pchar s)
/* puts the funny placeholders. returns the number of {...} substitutions */
Begin
short n,i,nest,ls,j;
int n,i,nest,ls,j;
Strbig(Llen,t);
n=0; ls=length(s);
i=0;
@ -162,6 +167,13 @@ Begin
Inc(placeholder);
If t[i-1]>' ' Then cadd(t,' ') EndIf
nadd(t, PlaceHold + placeholder);
cadd(t,' '); // add extra character to increase number significant digits for evaluated numbers
cadd(t,' ');
cadd(t,' ');
cadd(t,' ');
cadd(t,' ');
cadd(t,' ');
cadd(t,' ');
If s[j]>=' ' Then cadd(t,' ') EndIf
i=length(t);
pscopy(s,s, j+1, ls);
@ -170,19 +182,19 @@ Begin
Else
Inc(i)
EndIf
ls=length(s)
ls=length(s);
Done
return n
EndFunc
Intern
Func short findsubname(tdico * dico, Pchar s)
Func int findsubname(tdico * dico, Pchar s)
/* truncate the parameterized subckt call to regular old Spice */
/* scan a string from the end, skipping non-idents and {expressions} */
/* then truncate s after the last subckt(?) identifier */
Begin
Str(80, name);
short h,j,k,nest,ls;
int h,j,k,nest,ls;
Bool found;
h=0;
ls=length(s);
@ -207,7 +219,7 @@ Begin
Dec(k)
EndIf;
Done
found = (k>=0) And alfa(s[k+1]); /* suppose an identifier */
found = (k>=0) And alfanum(s[k+1]); /* suppose an identifier */
If found Then /* check for known subckt name */
scopy(name,""); j= k+1;
While alfanum(s[j]) Do
@ -227,7 +239,7 @@ Proc modernizeex( Pchar s)
/* old style expressions &(..) and &id --> new style with braces. */
Begin
Strbig(Llen,t);
short i,state, ls;
int i,state, ls;
char c,d;
i=0; state=0;
ls= length(s);
@ -287,32 +299,31 @@ Func char transform(tdico * dico, Pchar s, Bool nostripping, Pchar u)
Begin
Strbig(Llen,t);
char category;
short i,k, a,n;
/* i=stripcomment(s); sjb - not required now that front-end does stripping */
int i,k, a,n;
stripsomespace(s, nostripping);
modernizeex(s); /* required for stripbraces count */
scopy(u,"");
If s[0]=='.' Then /* check Pspice parameter format */
scopy(t,s);
stupcase(t);
scopy_up(t,s);
k=1;
While t[k]>' ' Do
cadd(u, t[k]); Inc(k)
Done
If spos(".PARAM",t) ==1 Then /* comment it out */
s[0]='*';
If ci_prefix(".PARAM",t) ==1 Then /* comment it out */
/*s[0]='*';*/
category='P';
ElsIf spos(".SUBCKT",t) ==1 Then /* split off any "params" tail */
ElsIf ci_prefix(".SUBCKT",t) ==1 Then /* split off any "params" tail */
a= spos("PARAMS:",t);
If a>0 Then
pscopy(s,s,1,a-1);
EndIf
category='S';
ElsIf spos(".CONTROL",t) ==1 Then
ElsIf ci_prefix(".CONTROL",t) ==1 Then
category='C'
ElsIf spos(".ENDC",t) ==1 Then
ElsIf ci_prefix(".ENDC",t) ==1 Then
category='E'
ElsIf spos(".ENDS",t) ==1 Then
ElsIf ci_prefix(".ENDS",t) ==1 Then
category='U'
Else
category='.';
@ -324,8 +335,7 @@ Begin
category='P';
ElsIf upcase(s[0])=='X' Then /* strip actual parameters */
i=findsubname(dico, s); /* i= index following last identifier in s */
/* pscopy(s,s,1,i); sjb - this is already done by findsubname() */
category='X'
category='X';
ElsIf s[0]=='+' Then /* continuation line */
category='+'
ElsIf cpos(s[0],"*$#")<=0 Then /* not a comment line! */
@ -352,7 +362,7 @@ Intern int evalcount= 0; /* number of lines through nupa_eval() */
Intern int nblog=0; /* serial number of (debug) logfile */
Intern Bool inexpansion= False; /* flag subckt expansion phase */
Intern Bool incontrol= False; /* flag control code sections */
Intern Bool dologfile= True; /* for debugging */
Intern Bool dologfile= False; /* for debugging */
Intern Bool firstsignal=True;
Intern Pfile logfile= Null;
Intern tdico * dico=Null;
@ -390,14 +400,16 @@ EndProc
Intern
Proc nupa_init( Pchar srcfile)
Begin
short i;
int i;
/* init the symbol table and so on, before the first nupa_copy. */
evalcount=0;
linecount= 0;
incontrol=False;
placeholder= 0;
dico= New(tdico);
inst_dico = New(tdico);
initdico(dico);
initdico(inst_dico);
For i=0; i<Maxline; Inc(i) Do
dico->refptr[i]= Null;
dico->category[i]='?';
@ -409,9 +421,9 @@ EndProc
Intern
Proc nupa_done(void)
Begin
short i;
int i;
Str(80,rep);
short dictsize, nerrors;
int dictsize, nerrors;
If logfile != Null Then
fclose(logfile);
logfile=Null;
@ -442,13 +454,102 @@ Begin
EndProc
/* SJB - Scan the line for subcircuits */
Proc nupa_scan(Pchar s, int linenum)
Proc nupa_scan(Pchar s, int linenum, int is_subckt)
Begin
If spos(".SUBCKT",s) ==1 Then
defsubckt( dico, s, linenum, 'U' );
EndIf
if ( is_subckt ) defsubckt( dico, s, linenum, 'U' );
else defsubckt( dico, s, linenum, 'O' );
EndProc
static char*
lower_str( char *str ) {
char *s;
for ( s = str; *s; s++ ) *s = tolower(*s);
return str;
}
static char*
upper_str( char *str ) {
char *s;
for ( s = str; *s; s++ ) *s = toupper(*s);
return str;
}
void
nupa_list_params(FILE *cp_out) {
char *name;
int i;
fprintf( cp_out, "\n\n" );
for ( i = 1; i <= dico->nbd+1; i++ ) {
if ( dico->dat[i].tp == 'R' ) {
name = lower_str( strdup( dico->dat[i].nom ) );
fprintf( cp_out, " ---> %s = %g\n", name, dico->dat[i].vl );
txfree(name);
}
}
}
double
nupa_get_param( char *param_name, int *found ) {
char *name = upper_str(strdup(param_name));
double result = 0;
int i;
*found = 0;
for ( i = 1; i <= dico->nbd+1; i++ ) {
if ( strcmp( dico->dat[i].nom, name ) == 0 ) {
result = dico->dat[i].vl;
*found = 1;
break;
}
}
txfree(name);
return result;
}
void
nupa_add_param( char *param_name, double value ) {
char *up_name = upper_str( strdup( param_name ) );
int i = attrib( dico, up_name, 'N' );
dico->dat[i].vl = value;
dico->dat[i].tp = 'R';
dico->dat[i].ivl = 0;
dico->dat[i].sbbase = NULL;
txfree(up_name);
}
void
nupa_add_inst_param( char *param_name, double value ) {
char *up_name = upper_str( strdup( param_name ) );
int i = attrib( inst_dico, up_name, 'N' );
inst_dico->dat[i].vl = value;
inst_dico->dat[i].tp = 'R';
inst_dico->dat[i].ivl = 0;
inst_dico->dat[i].sbbase = NULL;
txfree( up_name );
}
void
nupa_copy_inst_dico() {
int i;
for ( i = 1; i <= inst_dico->nbd; i++ ) {
nupa_add_param( inst_dico->dat[i].nom, inst_dico->dat[i].vl );
}
}
Func Pchar nupa_copy(Pchar s, int linenum)
/* returns a copy (not quite) of s in freshly allocated memory.
linenum, for info only, is the source line number.
@ -466,8 +567,9 @@ Begin
Strbig(Llen,u);
Strbig(Llen,keywd);
Pchar t;
short i,ls;
int ls;
char c,d;
ls= length(s);
While (ls>0) And (s[ls-1]<=' ') Do Dec(ls) Done
pscopy(u,s, 1,ls); /* strip trailing space, CrLf and so on */
@ -484,24 +586,16 @@ Begin
If incontrol Then c='C' EndIf /* force it */
d= dico->category[linenum]; /* warning if already some strategic line! */
If (d=='P') Or (d=='S') Or (d=='X') Then
fputs(" Numparam warning: overwriting P,S or X line.\n",stderr);
fprintf(stderr," Numparam warning: overwriting P,S or X line (linenum == %d).\n", linenum);
EndIf
If c=='S' Then
defsubckt( dico, s, linenum, 'U' )
ElsIf steq(keywd,"MODEL") Then
defsubckt( dico, s, linenum, 'O' )
EndIf; /* feed symbol table */
dico->category[linenum]= c;
EndIf /* keep a local copy and mangle the string */
ls=length(u);
t= NewArr( char, ls+1); /* == (Pchar)malloc(ls+1); */
t = strdup(u);
If t==NULL Then
fputs("Fatal: String malloc crash in nupa_copy()\n", stderr);
exit(-1)
Else
For i=0;i<=ls; Inc(i) Do
t[i]=u[i]
Done
If Not inexpansion Then
putlogfile(dico->category[linenum],linenum,t)
EndIf;
@ -517,21 +611,29 @@ Func int nupa_eval(Pchar s, int linenum)
All the X lines are preserved (commented out) in the expanded circuit.
*/
Begin
short idef; /* subckt definition line */
char c;
int idef; /* subckt definition line */
char c, keep, *ptr;
int i;
Str(80,subname);
Bool err = True;
dico->srcline= linenum;
c= dico->category[linenum];
#ifdef TRACE_NUMPARAMS
printf("** SJB - in nupa_eval()\n");
printf("** SJB - processing line %3d: %s\n",linenum,s);
printf("** SJB - category '%c'\n",c);
fprintf(stderr,"** SJB - in nupa_eval()\n");
fprintf(stderr,"** SJB - processing line %3d: %s\n",linenum,s);
fprintf(stderr,"** SJB - category '%c'\n",c);
#endif /* TRACE_NUMPARAMS */
If c=='P' Then /* evaluate parameters */
nupa_assignment( dico, dico->refptr[linenum] , 'N');
ElsIf c=='B' Then /* substitute braces line */
nupa_substitute( dico, dico->refptr[linenum], s, False);
err = nupa_substitute( dico, dico->refptr[linenum], s, False);
ElsIf c=='X' Then /* compute args of subcircuit, if required */
ptr = s;
while ( !isspace(*ptr) ) ptr++; keep = *ptr; *ptr = '\0';
nupa_inst_name = strdup(s); *nupa_inst_name = 'x'; *ptr = keep;
for ( i = 0; i < strlen(nupa_inst_name); i++ ) nupa_inst_name[i] = toupper(nupa_inst_name[i]);
idef = findsubckt( dico, s, subname);
If idef>0 Then
nupa_subcktcall( dico,
@ -545,10 +647,12 @@ Begin
putlogfile('e',linenum,s);
Inc(evalcount);
#ifdef TRACE_NUMPARAMS
fprintf(stderr,"** SJB - leaving nupa_eval(): %s %d\n", s, err);
ws("** SJB - --> "); ws(s); wln();
ws("** SJB - leaving nupa_eval()"); wln(); wln();
#endif /* TRACE_NUMPARAMS */
return 1
if ( err ) return 0;
else return 1;
EndFunc
Func int nupa_signal(int sig, Pchar info)
@ -564,7 +668,8 @@ Begin
ElsIf sig == NUPASUBSTART Then
inexpansion=True
ElsIf sig == NUPASUBDONE Then
inexpansion=False
inexpansion=False;
nupa_inst_name = NULL;
ElsIf sig == NUPAEVALDONE Then
nupa_done();
firstsignal=True

130
src/frontend/numparam/washprog.c
View File

@ -59,9 +59,9 @@ Cconst( Recursion, True) /* 20 % slower, re-substitute inside macro args */
Tarray(macargs, string, nargs) /* 0..9 macro copy args, 10: a wildcard */
/* global vars */
short isr; /* nb of substitution rules */
int isr; /* nb of substitution rules */
Bool cMode; /* a scanning options: c language mode */
short lookmax; /* input lookahead max size */
int lookmax; /* input lookahead max size */
Pfile fout; /* file filled by: echoOut macroOut translate traduire */
Tarray(str40, char, 44)
@ -73,25 +73,25 @@ Str(nsub, wildcard);
/********* trivial io ***/
Proc wsf( Pchar s, short fmt)
Proc wsf( Pchar s, int fmt)
Begin
short k;
int k;
For k=1; k<=fmt-length(s); Inc(k) Do
wc(' ')
Done
ws(s)
EndProc
Proc wcf(char c, short fmt)
Proc wcf(char c, int fmt)
Begin
short k;
int k;
For k=1; k<=fmt-1; Inc(k) Do
wc(' ')
Done
wc(c)
EndProc
Proc wif(long i, short fmt)
Proc wif(long i, int fmt)
Begin /*default fmt=1*/
Str(30, s);
nadd(s,i);
@ -100,8 +100,8 @@ EndProc
Proc rln(Pchar s) /* 78 column limit */
Begin
short i; Bool done; char c;
short max=maxlen(s);
int i; Bool done; char c;
int max=maxlen(s);
If max>78 Then max=78 EndIf
i=0; done=False;
scopy(s,"");
@ -116,10 +116,10 @@ EndProc
/*****************/
Proc saddn( Pchar s, Pchar t, short n)
Proc saddn( Pchar s, Pchar t, int n)
Begin
Strbig(Llen,u);
short lt= length(t);
int lt= length(t);
If lt<= n Then
sadd(s,t)
Else
@ -130,7 +130,7 @@ EndProc
Proc allocdata(void)
Begin /* prevent any string overflow */
short i;
int i;
For i=0; i<nsub; Inc(i) Do
Sini(search[i]);
Sini(replace[i])
@ -140,9 +140,9 @@ EndProc
Proc setOptions(Pchar s)
/* command-line options c-mode and/or lookahead buffer size */
Begin
short j,k;
int j,k;
Bool num;
short z;
int z;
char c;
/*-StartProc-*/
ws("Options: ");
@ -152,11 +152,11 @@ Begin
EndIf
If s[j]=='L' Then /*redefine max lookahead length */
z=0;
k= (short)(j+1);
k= (int)(j+1);
Repeat
Inc(k); c=s[k];
num= (c>='0') And (c<='9');
If num Then z= (short)( 10*z+ c - '0') EndIf
If num Then z= (int)( 10*z+ c - '0') EndIf
Until Not num EndRep
If (z>lookmax) And (z<255) Then
lookmax= z
@ -169,10 +169,10 @@ EndProc
/******** matching routines *******/
Proc copySpace(Pchar s, Pchar t, short a, short b) /* a,b>0 ! Pascal indexing */
Proc copySpace(Pchar s, Pchar t, int a, int b) /* a,b>0 ! Pascal indexing */
Begin
/*echo any "nontrivial" whitespace t-->s */
short lt,i,k, comment;
int lt,i,k, comment;
Bool leader;
char c;
/*-StartProc-*/
@ -182,7 +182,7 @@ Begin
comment=0; /* for C type whitespaces 1 And 2*/
lt= length(t);
If b>lt Then b=lt EndIf
For i=(short)(a-1); i<b; Inc(i) Do
For i=(int)(a-1); i<b; Inc(i) Do
c=t[i];
If (c>0) And (c<' ') Then leader=True EndIf
If cMode And (c=='/') And (t[i+1]=='*') Then comment=1 EndIf
@ -193,12 +193,12 @@ Begin
Done
EndProc
Func short skipCwhite(Pchar t, short j, short lt) /* assume C indexing */
Func int skipCwhite(Pchar t, int j, int lt) /* assume C indexing */
Begin
/* skip any C And C++ type whitespace in t, from j to lt */
/* returns j-1 If current char is no white at all! */
char c;
short comment; /*types 1 And 2! */
int comment; /*types 1 And 2! */
/*t[j] may already be '/' ? */ comment=0;
c=t[j]; /*If c>' ', we are done! */
If (c>0) And (c<=' ') Then
@ -217,13 +217,13 @@ Begin
Inc(j); c=t[j];
Until (j>lt) Or ((comment==0) And (c>' ')) EndRep
EndIf
return (short)(j-1); /* return last white-matching char position */
return (int)(j-1); /* return last white-matching char position */
EndProc
Func Bool simple(Pchar s)
Begin /* check if no strange punctuations inside s */
char c;
short i,ls;
int i,ls;
Bool found;
/*-StartProc-*/
ls=length(s);
@ -235,13 +235,13 @@ Begin /* check if no strange punctuations inside s */
return Not found;
EndFunc
Func Bool match(Pchar s, Pchar t, short n, short tstart)
Func Bool match(Pchar s, Pchar t, int n, int tstart)
Begin
/* test if t starts with substring s.
returns 0 If tstart is out of range. But n may be 0 ?
options: Singlechar wildcards "?"
*/
short i,j,lt;
int i,j,lt;
Bool ok;
/*-StartProc-*/
i=0; j=tstart;
@ -254,14 +254,14 @@ Begin
return ok
EndFunc
Func short posi(Pchar sub, Pchar s)
Func int posi(Pchar sub, Pchar s)
Begin /*re-defines Turbo Pos, result Pascal compatible */
short a,b,k;
int a,b,k;
Bool ok;
/*-StartProc-*/
ok=False;
a=length(sub);
b=(short)(length(s)-a);
b=(int)(length(s)-a);
k=0;
If a>0 Then /*Else return 0*/
While (k<=b) And (Not ok) Do
@ -276,10 +276,10 @@ Begin /*re-defines Turbo Pos, result Pascal compatible */
EndIf
EndFunc
Func short matchwhite(Pchar s, Pchar t, short n, short tstart)
Func int matchwhite(Pchar s, Pchar t, int n, int tstart)
Begin
/* like match, but any whitespace in t matches space in s*/
short i,j,lt; Bool ok;
int i,j,lt; Bool ok;
/*-StartProc-*/
i=0; j=tstart;
lt= length(t);
@ -302,23 +302,23 @@ Begin
Inc(i); Inc(j);
Done
If ok Then
return (short)(j-tstart)
return (int)(j-tstart)
Else
return (short)0
return (int)0
EndIf
EndFunc
Func short posizero(Pchar sub, Pchar s)
Func int posizero(Pchar sub, Pchar s)
Begin /*another Pos */
/* substring search. like posi, but reject quotes & bracketed stuff */
short a,b,k;
int a,b,k;
Bool ok;
short blevel;
int blevel;
char c;
/*-StartProc-*/
ok=False;
a=length(sub);
b=(short)(length(s)-a);
b=(int)(length(s)-a);
k=0; blevel=0;
If a>0 Then /*Else return 0*/
While (k<=b) And (Not ok) Do
@ -353,7 +353,7 @@ Begin /*another Pos */
EndIf
EndFunc
Func short isMacro(Pchar s, char option, Pchar t, short tstart,
Func int isMacro(Pchar s, char option, Pchar t, int tstart,
string maccopy[] )
/* s= macro template, t=buffer, maccopy = arg Array
return value: number of characters matched,
@ -363,7 +363,7 @@ Func short isMacro(Pchar s, char option, Pchar t, short tstart,
substitute 1 by maccopy[1] etc
*/
Begin
Darray(ps, short, nargs+1)
Darray(ps, int, nargs+1)
Word j,k,dk,ls, lst, lmt, jmax, pj;
Bool ok;
char arg;
@ -371,7 +371,7 @@ Begin
Str(40,st);
/* returns >0 If comparison Ok == length of compared Pchar */
/*-StartProc-*/ k=0;
ok= (s[0]==t[tstart]); /* shortcut: how much does it accelerate ? some % */
ok= (s[0]==t[tstart]); /* intcut: how much does it accelerate ? some % */
If ok Then
ps[0]=0;
ps[nargs]=0; /*only 1..9 are valid data, 10 filler templates*/
@ -381,7 +381,7 @@ Begin
ps[j]= cpos(arg,s);
Until (j>=nargs) Or (ps[j]==0) EndRep
ls= length(s);
ps[j]=(short)(ls+1); /*For last template chunk*/
ps[j]=(int)(ls+1); /*For last template chunk*/
jmax=j; j=1;
k=0; lmt=0;
Repeat
@ -403,7 +403,7 @@ Begin
Else
If option=='u' Then
pj= posizero(st,u);
If pj>0 Then lmt= matchwhite(st,u, lst, (short)(pj-1)) EndIf
If pj>0 Then lmt= matchwhite(st,u, lst, (int)(pj-1)) EndIf
Else
pj= posi(st,u)
EndIf /* qs[j]= k+pj; is position in t*/
@ -432,8 +432,8 @@ Begin
return k
EndFunc
Func short similar(Pchar s, char wilds, Pchar t,
short tstart, string maccopy[] )
Func int similar(Pchar s, char wilds, Pchar t,
int tstart, string maccopy[] )
/* try to match s with t, then save the wildcard parts ins maccopy[] */
/* s=template, t=buffer, wilds= number of wildcards, maccopy=substitute */
/* return value: number of characters matched */
@ -466,7 +466,7 @@ Begin
k= (Word)(ps-1);
While s[k]==wild Do Inc(k) Done
endc=s[k]; /*End char to detect, at length */
ok= match(s,t, (short)(ps-1), tstart);
ok= match(s,t, (int)(ps-1), tstart);
If ok Then
pscopy(u,t, (Word)(ps+tstart), (Word)255);
j= cpos(endc, u);
@ -481,10 +481,10 @@ Begin
return k
EndProc
Func short addSubList(Pchar s, short isr)
Func int addSubList(Pchar s, int isr)
/* add the rule s to the Rule list at isr */
Begin
short j,ls;
int j,ls;
char c,d,endc;
Bool start,stop;
/*-StartProc-*/
@ -592,7 +592,7 @@ Begin
done= (f == Null);
ok= Not done;
While Not done Do
fgets(s,(short)80,f);
fgets(s,(int)80,f);
isr=addSubList(s,isr);
done= feof(f)
Done
@ -630,8 +630,8 @@ EndFunc
Bool washmore= True; /* flag that activates the postprocessor */
Strbig(Llen,obf); /* output buffer */
short iobf=0; /* its index */
short wstate=0; /* output state machine */
int iobf=0; /* its index */
int wstate=0; /* output state machine */
Proc washinit(void)
Begin
@ -641,7 +641,7 @@ EndProc
Proc washchar(char c)
Begin /* state machine receives one character */
short i;
int i;
If Not washmore Then /* never leave state 0 */
fputc(c, fout)
ElsIf wstate==0 Then /* buffer empty */
@ -698,7 +698,7 @@ EndProc
Proc washflush(void)
Begin
short i;
int i;
If NotZ(wstate) Then
For i=0; i<iobf; Inc(i) Do
fputc(obf[i], fout)
@ -710,7 +710,7 @@ EndProc
Proc washstring( Pchar s)
Begin
short i;
int i;
For i=0; i<length(s); Inc(i) Do
washchar(s[i])
Done
@ -722,7 +722,7 @@ Proc translate(Pchar bf); /* recursion */
Proc echoOut(Pchar r, char isWild, string mac[] )
Begin
short u;
int u;
Strbig(Llen,s);
/*-StartProc-*/
If isWild !=0 Then
@ -751,13 +751,13 @@ Proc macroOut(Pchar r, string mac[] )
Begin
/* substitutes "1"..."9", uses "0" as escape character*/
char c;
short i,j;
int i,j;
Bool escape;
/*-StartProc-*/
escape=False;
For i=0; i<length(r); Inc(i) Do
c=r[i];
j= (short)(c-'0');
j= (int)(c-'0');
If j==0 Then
escape=True /*And skip*/
ElsIf ((j>0) And (j<nargs)) And (Not escape) Then
@ -777,14 +777,14 @@ Proc makeNewRule(Pchar r, string mac[] )
Begin
/* substitutes "1"..."9", uses "0" as escape character*/
char c;
short i,j;
int i,j;
Bool escape;
Strbig(Llen,s);
/*-StartProc-*/
escape=False;
For i=0; i<length(r); Inc(i) Do
c=r[i];
j= (short)(c-'0');
j= (int)(c-'0');
If j==0 Then
escape=True /*And skip*/
ElsIf ((j>0) And (j<nargs)) And (Not escape) Then
@ -802,7 +802,7 @@ Begin /*light version, inside recursion only */
Strbig(Llen,bf);
Darray(mac, string, nargs)
Bool ok;
short i,sm;
int i,sm;
char lastBf1;
Word nbrep;
/*-StartProc-*/
@ -821,10 +821,10 @@ Begin /*light version, inside recursion only */
If alfa(lastBf1) And (alfa(search[i][0])) Then
sm=0 /*inside word*/
Else
sm= isMacro(search[i], srule[i], bf, (short)0,mac)
sm= isMacro(search[i], srule[i], bf, (int)0,mac)
EndIf
Else
sm=similar(search[i],wildcard[i],bf, (short)0, mac)
sm=similar(search[i],wildcard[i],bf, (int)0, mac)
EndIf
ok=sm>0;
If ok And (srule[i]=='w') Then
@ -860,7 +860,7 @@ Begin
Darray( mac, string, nargs)
Pfile fin;
Bool ok;
short i,sm, exclusion, idot;
int i,sm, exclusion, idot;
char c,lastBf1;
Word nbrep,nline;
/*-StartProc-*/
@ -906,7 +906,7 @@ Begin
sm=0; i=0;
If exclusion>0 Then
i=exclusion;
sm=similar(replace[i], (char)0, bf, (short)0, mac);
sm=similar(replace[i], (char)0, bf, (int)0, mac);
ok= sm>0
EndIf
If Zero(exclusion) Then
@ -916,10 +916,10 @@ Begin
If alfa(lastBf1) And (alfa(search[i][0])) Then
sm=0 /*inside word*/
Else
sm= isMacro(search[i], srule[i], bf, (short)0,mac)
sm= isMacro(search[i], srule[i], bf, (int)0,mac)
EndIf
Else
sm=similar(search[i],wildcard[i],bf, (short)0, mac)
sm=similar(search[i],wildcard[i],bf, (int)0, mac)
EndIf
ok=sm>0;
If ok And (srule[i]=='w') Then
@ -966,7 +966,7 @@ EndProc
Func int main( int argc, Pchar argv[])
Begin
Str(80,dico);
short istart= 1;
int istart= 1;
Bool ok= True;
/*-StartProc-*/
allocdata();

276
src/frontend/numparam/xpressn.c
View File

@ -6,30 +6,48 @@
#include <stdio.h> /* for function message() only. */
#include <math.h>
#include <string.h>
#include "general.h"
#include "numparam.h"
#include "ngspice.h"
/************ keywords ************/
/* SJB - 150 chars is ample for this - see initkeys() */
Intern Str(150, keys); /*all my keywords*/
Intern Str(150, fmath); /* all math functions */
static double
max( double x, double y )
{
return ( x > y ) ? x : y;
}
static double
min( double x, double y )
{
return ( x < y ) ? x : y;
}
static double
ternary_fcn( int conditional, double if_value, double else_value )
{
if ( conditional ) return if_value;
else return else_value;
}
Intern
Proc initkeys(void)
/* the list of reserved words */
Begin
scopy(keys,
scopy_up(keys,
"and or not div mod if else end while macro funct defined"
" include for to downto is var");
stupcase(keys);
scopy(fmath, "sqr sqrt sin cos exp ln arctan abs pwr");
stupcase(fmath);
scopy_up(fmath, "sqr sqrt sin cos exp ln arctan abs pwr max min int log ternary_fcn");
EndProc
Intern
Func double mathfunction(short f, double z, double x)
Func double mathfunction(int f, double z, double x)
/* the list of built-in functions. Patch 'fmath' and here to get more ...*/
Begin
double y;
@ -42,8 +60,12 @@ Begin
Case 6 Is y= ln(x)
Case 7 Is y= atan(x)
Case 8 Is y= fabs(x)
Case 9 Is y= exp( x* ln(fabs(z)))
Case 9 Is y= exp( x* ln(fabs(z)))
/* pwr(,): the only one with 2 args */
Case 10 Is y= max( x, z )
Case 11 Is y= min( x, z )
Case 12 Is y= trunc( x )
Case 13 Is y= log(x)
Default y=x EndSw
return y
EndFunc
@ -88,7 +110,7 @@ Begin
EndProc
/* Intern
Func short parsenode(auxtable *n, Pchar s)
Func int parsenode(auxtable *n, Pchar s)
Begin
return 0
EndFunc
@ -98,14 +120,14 @@ EndFunc
Proc initdico(tdico * dico)
Begin
short i;
int i;
dico->nbd=0;
Sini(dico->option);
Sini(dico->srcfile);
dico->srcline= -1;
dico->errcount= 0;
For i=0; i<=Maxdico; Inc(i) Do
sini(dico->dat[i].nom,20)
sini(dico->dat[i].nom,100)
Done
dico->tos= 0;
dico->stack[dico->tos]= 0; /* global data beneath */
@ -127,12 +149,15 @@ Intern
Proc dicostack(tdico *dico, char op)
/* push or pop operation for nested subcircuit locals */
Begin
char *param_name, *inst_name;
int i, current_stack_size, old_stack_size;
If op==Push Then
If dico->tos < (20-1) Then Inc(dico->tos)
Else message(dico, " Subckt Stack overflow")
EndIf
dico->stack [dico->tos]= dico->nbd;
dico->inst_name[dico->tos] = nupa_inst_name;
ElsIf op==Pop Then
/* obsolete: undefine all data items of level dico->tos
For i=dico->nbd; i>0; Dec(i) Do
@ -143,29 +168,44 @@ Begin
Done
*/
If dico->tos >0 Then
// keep instance parameters around
current_stack_size = dico->nbd;
old_stack_size = dico->stack[dico->tos];
inst_name = dico->inst_name[dico->tos];
for ( i = old_stack_size+1; i <= current_stack_size; i++ ) {
param_name = tmalloc( strlen(inst_name) + strlen(dico->dat[i].nom) + 2 );
sprintf( param_name, "%s.%s", inst_name, dico->dat[i].nom );
nupa_add_inst_param( param_name, dico->dat[i].vl );
tfree(param_name);
}
tfree(inst_name);
dico->nbd= dico->stack[dico->tos]; /* simply kill all local items */
Dec(dico->tos)
Dec(dico->tos);
Else message(dico," Subckt Stack underflow.")
EndIf
EndIf
EndProc
Func short donedico(tdico * dico)
Func int donedico(tdico * dico)
Begin
short sze= dico->nbd;
int sze= dico->nbd;
donesymbols(Addr(dico->nodetab));
return sze;
EndProc
Intern
Func short entrynb( tdico * d, Pchar s)
Func int entrynb( tdico * d, Pchar s)
/* symbol lookup from end to start, for stacked local symbols .*/
/* bug: sometimes we need access to same-name symbol, at lower level? */
Begin
short i;
int i;
Bool ok;
ok=False;
i=d->nbd+1;
While (Not ok) And (i>1) Do
Dec(i);
ok= steq(d->dat[i].nom, s);
@ -181,7 +221,7 @@ Func char getidtype( tdico *d, Pchar s)
/* test if identifier s is known. Answer its type, or '?' if not in list */
Begin
char itp='?'; /* assume unknown */
short i= entrynb(d, s);
int i= entrynb(d, s);
If i >0 Then itp= d->dat[i].tp EndIf
return itp
EndFunc
@ -209,7 +249,8 @@ Begin
Else
u=0.0;
scopy(s,"Undefined number ["); sadd(s,t); cadd(s,']');
err=message( dico, s)
err=message( dico, s);
EndIf
*perr= err;
return u
@ -217,13 +258,12 @@ EndFunc
/******* writing dictionary entries *********/
Intern
Func short attrib( tdico * dico, Pchar t, char op)
Func int attrib( tdico * dico, Pchar t, char op)
Begin
/* seek or attribute dico entry number for string t.
Option op='N' : force a new entry, if tos>level and old is valid.
*/
short i;
int i;
Bool ok;
i=dico->nbd+1;
ok=False;
@ -267,7 +307,7 @@ Begin
we already make symbol entries which are dummy globals !
we mark each id with its subckt level, and warn if write at higher one.
*/
short i;
int i;
char c;
Bool err, warn;
Strbig(Llen,v);
@ -275,7 +315,7 @@ Begin
err=False;
If i<=0 Then
err=message( dico," Symbol table overflow")
Else
Else
If dico->dat[i].tp=='P' Then
i= dico->dat[i].ivl
EndIf; /*pointer indirection*/
@ -284,6 +324,7 @@ Begin
Else
c=' '
EndIf
If (c=='R') Or (c=='S') Or (c=='?') Then
dico->dat[i].vl=z;
dico->dat[i].tp=tpe;
@ -316,7 +357,7 @@ Func Bool defsubckt(tdico *dico, Pchar s, Word w, char categ)
Begin
Str(80,u);
Bool err;
short i,j,ls;
int i,j,ls;
ls=length(s);
i=0;
While (i<ls) And (s[i] !='.') Do Inc(i) Done /* skip 1st dotword */
@ -324,9 +365,8 @@ Begin
While (i<ls) And (s[i]<=' ') Do Inc(i) Done /* skip blank */
j=i;
While (j<ls) And (s[j]>' ') Do Inc(j) Done
If (j>i) And alfa(s[i]) Then
pscopy(u,s, i+1, j-i);
stupcase(u);
If (j>i) Then
pscopy_up(u,s, i+1, j-i);
err= define( dico, u, ' ',categ, 0.0, w, Null);
Else
err= message( dico,"Subcircuit or Model without name.");
@ -334,23 +374,22 @@ Begin
return err
EndFunc
Func short findsubckt( tdico *dico, Pchar s, Pchar subname)
Func int findsubckt( tdico *dico, Pchar s, Pchar subname)
/* input: s is a subcircuit invocation line.
returns 0 if not found, else the stored definition line number value
and the name in string subname */
Begin
Str(80,u); /* u= subckt name is last token in string s */
short i,j,k;
int i,j,k;
k=length(s);
While (k>=0) And (s[k]<=' ') Do Dec(k) Done
j=k;
While (k>=0) And (s[k]>' ') Do Dec(k) Done
pscopy(u,s, k+2, j-k);
stupcase(u);
pscopy_up(u,s, k+2, j-k);
i= entrynb(dico,u);
If (i>0) And (dico->dat[i].tp == 'U') Then
i= dico->dat[i].ivl;
scopy(subname,u)
scopy(subname,u);
Else
i= 0;
scopy(subname,"");
@ -361,7 +400,7 @@ EndFunc
#if 0 /* unused, from the full macro language... */
Intern
Func short deffuma( /* define function or macro entry. */
Func int deffuma( /* define function or macro entry. */
tdico * dico, Pchar t, char tpe, Word bufstart,
Bool * pjumped, Bool * perr)
Begin
@ -369,7 +408,7 @@ Begin
/* if not jumped, define new function or macro, returns index to buffferstart
if jumped, return index to existing function
*/
short i,j;
int i,j;
Strbig(Llen, v);
i=attrib(dico,t,' '); j=0;
If i<=0 Then
@ -402,7 +441,7 @@ Func Byte keyword( Pchar keys, Pchar t)
Begin
/* return 0 if t not found in list keys, else the ordinal number */
Byte i,j,k;
short lt,lk;
int lt,lk;
Bool ok;
lt=length(t);
lk=length(keys);
@ -432,7 +471,7 @@ Intern
Func double parseunit( double x, Pchar s)
/* the Spice suffixes */
Begin
double u;
double u = 0;
Str(20, t);
Bool isunit;
isunit=True;
@ -461,9 +500,9 @@ Begin
EndFunc
Intern
Func short fetchid(
Func int fetchid(
Pchar s, Pchar t,
short ls, short i)
int ls, int i)
/* copy next identifier from s into t, advance and return scan index i */
Begin
char c;
@ -482,7 +521,7 @@ Begin
c=Nul
EndIf
c= upcase(c);
ok= ((c>='0') And (c<='9')) Or ((c>='A') And (c<='Z'));
ok= alfanum(c) || c == '.';
If ok Then cadd(t,c) EndIf
Until Not ok EndRep
return i /*return updated i */
@ -492,14 +531,14 @@ Intern
Func double exists(
tdico * d,
Pchar s,
short * pi,
int * pi,
Bool * perror)
/* check if s in smboltable 'defined': expect (ident) and return 0 or 1 */
Begin
Bool error= *perror;
short i= *pi;
int i= *pi;
double x;
short ls;
int ls;
char c;
Bool ok;
Strbig(Llen, t);
@ -537,14 +576,14 @@ EndFunc
Intern
Func double fetchnumber( tdico *dico,
Pchar s, short ls,
short * pi,
Pchar s, int ls,
int * pi,
Bool * perror)
/* parse a Spice number in string s */
Begin
Bool error= *perror;
short i= *pi;
short k,err;
int i= *pi;
int k,err;
char d;
Str(20, t);
Strbig(Llen, v);
@ -602,15 +641,15 @@ EndFunc
Intern
Func char fetchoperator( tdico *dico,
Pchar s, short ls,
short * pi,
Pchar s, int ls,
int * pi,
Byte * pstate, Byte * plevel,
Bool * perror)
/* grab an operator from string s and advance scan index pi.
each operator has: one-char alias, precedence level, new interpreter state.
*/
Begin
short i= *pi;
int i= *pi;
Byte state= *pstate;
Byte level= *plevel;
Bool error= *perror;
@ -729,7 +768,7 @@ Begin
If t<epsi Then
x=z
Else
x=exp(y*ln(t))
x=exp(y*ln(t));
EndIf
Case '&' Is /*And*/
If y<x Then x=y EndIf; /*=Min*/
@ -775,15 +814,17 @@ Begin
*/
Cconst(nprece,9) /*maximal nb of precedence levels*/
Bool error= *perror;
Bool negate = False;
Byte state,oldstate, topop,ustack, level, kw, fu;
double u=0.0,v;
double u=0.0,v,w=0.0;
double accu[nprece+1];
char oper[nprece+1];
char uop[nprece+1];
short i,k,ls,natom, arg2;
int i,k,ls,natom, arg2, arg3;
char c,d;
Strbig(Llen, t);
Bool ok;
For i=0; i<=nprece; Inc(i) Do
accu[i]=0.0; oper[i]=' '
Done
@ -799,7 +840,7 @@ Begin
level=1;
/* new: must support multi-arg functions */
k=i;
arg2=0; v=1.0;
arg2=0; v=1.0; arg3 = 0;
Repeat
Inc(k);
If k>ls Then
@ -812,7 +853,10 @@ Begin
ElsIf d==')' Then
Dec(level)
EndIf
If (d==',') And (level==1) Then arg2=k EndIf /* comma list? */
If (d==',') And (level==1) Then
if ( arg2 == 0 ) { arg2 = k; }
else { arg3 = k; } // kludge for more than 2 args (ternary expression)
EndIf /* comma list? */
Until (k>ls) Or ((d==')') And (level<=0)) EndRep
If k>ls Then
error=message( dico,"Closing \")\" not found.");
@ -823,11 +867,17 @@ Begin
v=formula( dico, t, Addr(error));
i=arg2;
EndIf
if ( arg3 > i ) {
pscopy(t,s,i+1, arg3-i-1);
w=formula( dico, t, Addr(error));
i = arg3;
}
pscopy(t,s,i+1, k-i-1);
u=formula( dico, t, Addr(error));
u=formula( dico, t, Addr(error));
state=1; /*atom*/
If fu>0 Then
u= mathfunction(fu,v,u)
if ( fu == 14 ) u= ternary_fcn(v,w,u);
else u= mathfunction(fu,v,u);
EndIf
EndIf
i=k; fu=0;
@ -839,18 +889,22 @@ Begin
If kw==0 Then
fu= keyword(fmath,t); /* numeric function? */
If fu==0 Then
u=fetchnumentry( dico, t, Addr(error))
u=fetchnumentry( dico, t, Addr(error));
Else
state=0
state=0;
EndIf /* state==0 means: ignore for the moment */
Else
c=opfunctkey( dico, kw,c, Addr(state), Addr(level) ,Addr(error))
c=opfunctkey( dico, kw,c, Addr(state), Addr(level) ,Addr(error));
EndIf
If kw==Defd Then
u=exists( dico, s, Addr(i), Addr(error))
u=exists( dico, s, Addr(i), Addr(error));
EndIf
ElsIf ((c=='.') Or ((c>='0') And (c<='9'))) Then
u=fetchnumber( dico, s,ls, Addr(i), Addr(error));
if ( negate ) {
u = -1*u;
negate = False;
}
state=1;
Else
c=fetchoperator(dico, s,ls,
@ -859,6 +913,11 @@ Begin
EndIf /* control chars <' ' ignored*/
ok= (oldstate==0) Or (state==0) Or
((oldstate==1) And (state==2)) Or ((oldstate!=1)And(state!=2));
if ( oldstate == 2 && state == 2 && c == '-' ) {
ok = 1;
negate = True;
continue;
}
If Not ok Then
error=message( dico," Misplaced operator")
EndIf
@ -870,7 +929,7 @@ Begin
state=4; level=topop
EndIf /*close all ops below*/
For k=ustack; k>=1; Dec(k) Do
u=operate(uop[k],u,u)
u=operate(uop[k],u,u);
Done
ustack=0;
accu[0]=u; /* done: all pending unary operators */
@ -892,11 +951,16 @@ Begin
sadd(t,s);
error=message( dico,t)
EndIf
if ( negate == True ) {
error = message( dico, " Problem with formula eval -- wrongly determined negation!" );
}
*perror= error;
If error Then
return 1.0
return 1.0;
Else
return accu[topop]
return accu[topop];
EndIf
EndFunc /*formula*/
@ -906,7 +970,7 @@ Begin
/* I=integer, P=fixedpoint F=floatpoint*/
/* find out the "natural" type of format for number x*/
double ax,dx;
short rx;
int rx;
Bool isint,astronomic;
ax=absf(x);
isint=False;
@ -938,7 +1002,7 @@ Func Bool evaluate(
Begin
/* transform t to result q. mode 0: expression, mode 1: simple variable */
double u=0.0;
short k,j,lq;
int k,j,lq;
char dt,fmt;
Bool numeric, done, nolookup;
Bool err;
@ -990,7 +1054,8 @@ Begin
If fmt=='I' Then
stri(np_round(u), q)
Else
strf(u,6,-1,q)
//strf(u,6,-1,q);
strf(u,17,10,q);
EndIf /* strf() arg 2 doesnt work: always >10 significant digits ! */
EndIf
return err;
@ -1004,7 +1069,7 @@ Func Bool scanline(
Bool err)
/* scan host code line s for macro substitution. r=result line */
Begin
short i,k,ls,level,nd, nnest;
int i,k,ls,level,nd, nnest;
Bool spice3;
char c,d;
Strbig(Llen, q);
@ -1120,7 +1185,7 @@ Proc compactfloatnb(Pchar v)
/* erase superfluous 000 digit streams before E */
/* bug: truncating, no rounding */
Begin
short n,k, lex;
int n,k, lex;
Str(20,expo);
n=cpos('E',v); /* if too long, try to delete digits */
If n >3 Then
@ -1128,28 +1193,28 @@ Begin
lex= length(expo);
k=n-2; /* mantissa is 0...k */
While (v[k]=='0') And (v[k-1]=='0') Do Dec(k) Done
If (k+1+lex) > 10 Then k= 9-lex EndIf
If (k+1+lex) > 17 Then k= 17-lex EndIf
pscopy(v,v, 1,k+1);
sadd(v,expo);
EndIf
EndProc
Intern
Func short insertnumber(tdico *dico, short i, Pchar s, Pchar u)
Func int insertnumber(tdico *dico, int i, Pchar s, Pchar u)
/* insert u in string s in place of the next placeholder number */
Begin
Str(40,v);
Str(80,msg);
Bool found;
short ls, k;
int ls, k;
long accu;
ls= length(s);
scopy(v,u);
compactfloatnb(v);
While length(v)<10 Do
While length(v)<17 Do
cadd(v,' ')
Done
If length(v)>10 Then
If length(v)>17 Then
scopy(msg," insertnumber fails: ");
sadd(msg,u);
message( dico, msg)
@ -1167,16 +1232,17 @@ Begin
Done
If found Then
accu=accu - 1000000000L; /* plausibility test */
found= (accu>0) And (accu<2000)
found= (accu>0) And (accu<40000)
EndIf
Inc(i)
Done
If found Then /* substitute at i-1 */
Dec(i);
For k=0; k<10; Inc(k) Do s[i+k]= v[k] Done
i= i+10;
For k=0; k<17; Inc(k) Do s[i+k]= v[k] Done
i= i+17;
Else
i= ls;
fprintf(stderr,"xpressn.c--insertnumber: i=%d s=%s u=%s\n",i,s,u);
message( dico,"insertnumber: missing slot ");
EndIf
return i
@ -1189,7 +1255,7 @@ Func Bool nupa_substitute( tdico *dico, Pchar s, Pchar r, Bool err)
bug: wont flag overflow!
*/
Begin
short i,k,ls,level, nnest, ir;
int i,k,ls,level, nnest, ir;
char c,d;
Strbig(Llen, q);
Strbig(Llen, t);
@ -1261,7 +1327,7 @@ Begin
i= k-1;
EndIf
If Not err Then
ir= insertnumber(dico, ir, r,q)
ir= insertnumber(dico, ir, r,q);
Else
message( dico, "Cannot compute &(expression)")
EndIf
@ -1273,12 +1339,12 @@ EndFunc
Intern
Func Byte getword(
Pchar s, Pchar t,
Byte after,
short * pi)
int after,
int * pi)
/* isolate a word from s after position "after". return i= last read+1 */
Begin
short i= *pi;
short ls;
int i= *pi;
int ls;
Byte key;
i=after;
ls=length(s);
@ -1300,14 +1366,14 @@ Begin
EndFunc
Intern
Func char getexpress( Pchar s, Pchar t, short * pi)
Func char getexpress( Pchar s, Pchar t, int * pi)
/* returns expression-like string until next separator
Input i=position before expr, output i=just after expr, on separator.
returns tpe=='R' If numeric, 'S' If string only
*/
Begin
short i= *pi;
short ia,ls,level;
int i= *pi;
int ia,ls,level;
char c,d, tpe;
Bool comment= False;
ls=length(s);
@ -1315,10 +1381,10 @@ Begin
While (ia<ls) And (s[ia-1]<=' ') Do
Inc(ia)
Done /*white space ? */
If s[ia-1]=='\"' Then /*string constant*/
If s[ia-1]=='"' Then /*string constant*/
Inc(ia);
i=ia;
While (i<ls) And (s[i-1]!='\"') Do Inc(i) Done
While (i<ls) And (s[i-1]!='"') Do Inc(i) Done
tpe='S';
Repeat
Inc(i)
@ -1370,7 +1436,7 @@ Begin
/* s has the format: ident = expression; ident= expression ... */
Strbig(Llen, t);
Strbig(Llen,u);
short i,j, ls;
int i,j, ls;
Byte key;
Bool error, err;
char dtype;
@ -1402,7 +1468,8 @@ Begin
If dtype=='R' Then
rval=formula( dico, u, Addr(error));
If error Then
message( dico," Formula() error.")
message( dico," Formula() error.");
fprintf(stderr," %s\n",s);
EndIf
ElsIf dtype=='S' Then
wval= i
@ -1423,26 +1490,32 @@ Func Bool nupa_subcktcall( tdico *dico, Pchar s, Pchar x, Bool err)
x= a matching subckt call line, with actual params
*/
Begin
short n,m,i,j,k,g,h, narg=0, ls, nest;
int n,m,i,j,k,g,h, narg=0, ls, nest;
Strbig(Llen,t);
Strbig(Llen,u);
Strbig(Llen,v);
Strbig(Llen,idlist);
Str(80,subname);
/*
skip over instance name -- fixes bug where instance 'x1' is
same name as subckt 'x1'
*/
while ( *x != ' ' ) x++;
/***** first, analyze the subckt definition line */
n=0; /* number of parameters if any */
ls=length(s);
j=spos("//",s);
If j>0 Then pscopy(t,s,1,j-1) Else scopy(t,s) EndIf
stupcase(t);
If j>0 Then pscopy_up(t,s,1,j-1) Else scopy_up(t,s) EndIf
j= spos("SUBCKT", t);
If j>0 Then
j= j +6; /* fetch its name */
While (j<ls) And (t[j]<=' ') Do Inc(j) Done
While alfanum(t[j]) Do
cadd(subname,t[j]); Inc(j)
Done
while ( t[j] != ' ' ) {
cadd(subname,t[j]); Inc(j);
}
Else
err=message( dico," Not a subckt line!")
EndIf;
@ -1470,10 +1543,15 @@ Begin
If Not err Then
narg=0;
j=spos("//",x);
If j>0 Then pscopy(t,x,1,j-1) Else scopy(t,x) EndIf
stupcase(t);
If j>0 Then pscopy_up(t,x,1,j-1) Else scopy_up(t,x) EndIf
ls=length(t);
j= spos(subname,t);
j= spos(subname,t);
/* make sure that subname followed by space */
while ( j > 0 && *(t+j+length(subname)-1) > ' ' ) {
j = j+length(subname)-1 + spos( subname, t+j+length(subname)-1 );
}
If j>0 Then
j=j + length(subname) -1; /* 1st position of arglist: j */
While (j<ls) And ((t[j]<=' ') Or (t[j]==',')) Do Inc(j) Done
@ -1495,7 +1573,7 @@ Begin
If (g<ls) And (nest==0) Then t[g]='}' EndIf
EndIf
EndIf
If alfanum(t[k]) Then /* number, identifier */
If alfanum(t[k]) || t[k] == '.' Then /* number, identifier */
h=k;
While t[k] > ' ' Do Inc(k) Done
pscopy(u,t, h+1, k-h);