diff --git a/ChangeLog b/ChangeLog index ea260de83..e3798e34e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2007-12-26 Paolo Nenzi + * src/frontend/numparam/*: downgraded all files to standard C syntax with + the included washprog.c tool. + 2007-12-14 Dietmar Warning * configure.in, src/spicelib/devices/dev.c: allow mingw build w/o GUI diff --git a/src/frontend/numparam/downgrad.txt b/src/frontend/numparam/downgrad.txt index 24b13b8bb..4294bfc82 100644 --- a/src/frontend/numparam/downgrad.txt +++ b/src/frontend/numparam/downgrad.txt @@ -76,7 +76,7 @@ m Tarray(1,2,3) "typedef 2 1[3];" m Tarray\2(1,2,3,4) "typedef 2 1[3][4];" m Darray(1,2,3) "2 1[3];" -!m Cconst(1,2) "typedef enum {1 = 2} _n1;" +m Cconst(1,2) "typedef enum {1 = 2} _n1;" !m Str(1,2) "char 2[1+03]={00,00,(char)1}" !m Strbig(1,2) "char 2[1+04]={00, (char)Hi(1), (char)Lo(1)}" diff --git a/src/frontend/numparam/general.h b/src/frontend/numparam/general.h index e449bffc4..8a9830e8c 100644 --- a/src/frontend/numparam/general.h +++ b/src/frontend/numparam/general.h @@ -1,124 +1,4 @@ /* general.h */ - -/*** Part 1: the C language redefined for quiche eaters **** - * - * Real Hackers: undo all these macros with the 'washprog.c' utility ! - */ - - /* Proc ...... Begin .... EndProc */ -#define Proc void -#define Begin { -#define EndProc ;} - /* Func int ...(...) Begin...EndFunc */ -#define Func -#define EndFunc ;} - /* If ... Then...ElsIf..Then...Else...EndIf */ -#define If if( -#define Then ){ -#define Else ;}else{ -#define ElsIf ;}else if( -#define EndIf ;} - /* While...Do...Done */ -#define While while( -#define Do ){ -#define Done ;} - /* Repeat...Until...EndRep */ -#define Repeat do{ -#define Until ;}while(!( -#define EndRep )); - /* For i=1;i<=10; Inc(i) Do...Done */ -#define For for( - /* Switch...CaseOne...Is...Case..Is...Default...EndSw */ -#define Switch switch( -#define CaseOne ){ case -#define Case ;break;}case -#define AndCase :; case -#define Is :{ -#define Default ;break;}default:{ -#define EndSw ;break;}} - -#define Record(x) typedef struct _t ## x { -#define RecPtr(x) typedef struct _t ## x * -#define EndRec(x) } x; -#define Addr(x) &x - -#define False 0 -#define True 1 -#define Not ! -#define And && -#define Or || -#define Div / -#define Mod % - -#define Shl << -#define Shr >> -#define AND & -#define OR | -#define XOR ^ -#define NOT ~ -#define AT * - -#define Inc(p) (p)++ -#define Dec(p) (p)-- - -/* see screened versions below: -#define New(t) (t*)malloc(sizeof(t)) -#define Dispose(p) free((void*)p) -*/ - -#ifdef NULL -#define Null NULL -#else -#define Null (void *)0L -#endif - -#define chr(x) (char)(x) -#define Zero(x) (!(x)) -#define NotZ(x) (x) - -typedef void* Pointer; -#define Type(a,b) typedef b a; - -#ifdef _STDIO_H /* somebody pulled stdio */ -Type(Pfile, FILE AT) -#else -#ifdef __STDIO_H /* Turbo C */ - Type(Pfile, FILE AT) -#else - Type(Pfile, FILE*) /* sjb - was Pointer, now FILE* */ -#endif -#endif - -Type(Char, unsigned char) -Type(Byte, unsigned char) -#ifndef Bool -Type(Bool, unsigned char) -#endif -Type(Word, unsigned int) -Type(Pchar, char AT) - -#define Intern static -#define Extern extern -#define Tarray(a,d,n) typedef d a[n]; -#define Tarray2(a,d,n,m) typedef d a[n][m]; -#define Darray(a,d,n) d a[n]; - -#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] ={ -#define EndAco }; - -/* the following require the 'mystring' mini-library */ - -#define Mcopy(a,b) rawcopy((Pchar)a, (Pchar)b, sizeof(a),sizeof(b)) -#define Rcopy(a,b) rawcopy((Pchar)(&a), (Pchar)(&b), sizeof(&a),sizeof(&b)) -#define New(tp) (tp *)new(sizeof(tp)) -#define Dispose(p) dispose((void *)p) -#define NewArr(t,n) (t *)new(sizeof(t)*n) - - -/*** Part 2: common 'foolproof' string library ******/ /* include beforehand the following: #include // NULL FILE fopen feof fgets fclose fputs fputc gets @@ -129,85 +9,87 @@ Type(Pchar, char AT) #define Use(x) x=0;x=x #define Uses(s) s=s #define Usep(x) x=x -#define Hi(x) (((x) Shr 8) AND 0xff) -#define Lo(x) ((x) AND 0xff) +#define Hi(x) (((x) >> 8) & 0xff) +#define Lo(x) ((x) & 0xff) #define Strbig(n,a) char a[n+4]={0, (char)Hi(n), (char)Lo(n)} #define Str(n,a) char a[n+3]={0,0,(char)n} /* n<255 ! */ #define Sini(s) sini(s,sizeof(s)-4) -Cconst(Maxstr,25004) /* was 255, string maxlen, may be up to 32000 or so */ + +typedef enum {Maxstr=25004} _nMaxstr; /* was 255, string maxlen, may be up to 32000 or so */ +typedef enum {Esc=27} _nEsc; +typedef enum {Tab=9} _nTab; +typedef enum {Bs=8} _nBs; +typedef enum {Lf=10} _nLf; +typedef enum {Cr=13} _nCr; typedef char string[258]; -Cconst(Esc, 27) -Cconst(Tab, 9) -Cconst(Bs, 8) -Cconst(Lf, 10) -Cconst(Cr, 13) -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 int cpos( char c, Pchar s); -Func int spos( Pchar sub, Pchar s); +void sini( char * s, int i); +void sfix(char * s, int i, int max); + int maxlen(char * s); + char * pscopy( char * s, char * a, int i,int j); + char * pscopy_up( char * s, char * a, int i,int j); + unsigned char scopy( char * a, char * b); + unsigned char scopy_up( char * a, char * b); + unsigned char ccopy( char * a, char c); + unsigned char sadd( char * s, char * t); + unsigned char nadd( char * s, long n); + unsigned char cadd( char * s, char c); + unsigned char sins( char * s, char * t); + unsigned char cins( char * s, char c); + int cpos( char c, char * s); + int spos( char * sub, char * 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 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, 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); + int length(char * s); + unsigned char steq(char * s, char * t); + unsigned char stne(char * s, char * t); + int scompare(char * a, char * b); + int ord(char c); + int pred(int i); + int succ(int i); +void stri(long n, char * s); +void strif(long n, int f, char * s); +void strf(double x, int a, int b, char * s); /* float -> string */ + long ival(char * s, int *err); + double rval(char * s, int *err); -Func char upcase(char c); -Func char lowcase(char c); -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); -Func Bool alfanum(char c); -Func Pchar stupcase( Pchar s); + char upcase(char c); + char lowcase(char c); + int hi(long w); + int lo(long w); + unsigned char odd(long x); + unsigned char alfa(char c); + unsigned char num(char c); + unsigned char alfanum(char c); + char * stupcase( char * s); /***** primitive input-output ***/ -Proc wc(char c); -Proc wln(void); -Proc ws( Pchar s); -Proc wi(long i); -Proc rs( Pchar s); -Func char rc(void); +void wc(char c); +void wln(void); +void ws( char * s); +void wi(long i); +void rs( char * s); + char rc(void); -Func int freadstr(Pfile f, Pchar s, int max); -Func char freadc(Pfile f); -Func long freadi(Pfile f); + int freadstr(FILE * f, char * s, int max); + char freadc(FILE * f); + long freadi(FILE * 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 double sqr(double x); -Func double absf(double x); /* abs */ -Func long absi( long i); -Func double frac(double x); + long np_round(double d); // sjb to avoid clash with round() in math.h + long np_trunc(double x); // sjb to avoid clash with trunc() in math.h + double sqr(double x); + double absf(double x); /* abs */ + long absi( long i); + double frac(double x); -Func Bool reset(Pfile f); -Func Bool rewrite(Pfile f); -Proc rawcopy(Pointer a, Pointer b, int la, int lb); -Func Pointer new(long sz); -Proc dispose(Pointer p); -Func Pchar newstring(int n); + unsigned char reset(FILE * f); + unsigned char rewrite(FILE * f); +void rawcopy(void * a, void * b, int la, int lb); + void * new(long sz); +void dispose(void * p); + char * newstring(int n); + diff --git a/src/frontend/numparam/mystring.c b/src/frontend/numparam/mystring.c index 5da3fb641..f67b6c88e 100644 --- a/src/frontend/numparam/mystring.c +++ b/src/frontend/numparam/mystring.c @@ -9,7 +9,7 @@ #include #include #include -#include /* -- ceil floor */ +#include /* -- ceil floor */ #include "config.h" #ifdef HAS_WINDOWS #include "wstdio.h" @@ -17,74 +17,94 @@ #include "general.h" -#define Getmax(s,ls) (((Byte)(s[ls+1])) Shl 8) + (Byte)(s[ls+2]) +#define Getmax(s,ls) (((unsigned char)(s[ls+1])) << 8) + (unsigned char)(s[ls+2]) /***** primitive input-output ***/ int -ci_prefix(register char *p, register char *s) +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++; + while (*p) + { + if ((isupper (*p) ? tolower (*p) : *p) != + (isupper (*s) ? tolower (*s) : *s)) + return (0); + p++; + s++; } - return (1); + return (1); } -Proc wc(char c) -Begin - fputc(c, stdout) -EndProc +void +wc (char c) +{ + fputc (c, stdout); +} -Proc wln(void) -Begin wc('\n') EndProc +void +wln (void) +{ + wc ('\n'); +} -Proc ws( Pchar s) -Begin - int k=0; - While s[k] !=0 Do - wc(s[k]); Inc(k) - Done -EndProc +void +ws (char *s) +{ + int k = 0; -Proc wi(long i) -Begin - Str(16,s); - nadd(s,i); - ws(s) -EndProc + while (s[k] != 0) + { + wc (s[k]); + k++; + } +} -Proc rs( Pchar s) -Begin /*basic line input, limit= 80 chars */ - int max,i; +void +wi (long i) +{ + Str (16, s); + nadd (s, i); + ws (s); +} + +void +rs (char *s) +{ /*basic line input, limit= 80 chars */ + int max, i; char c; - exit(-1); - max=maxlen(s); - i=0; sini(s,max); - If max>80 Then max=80 EndIf - Repeat - c=fgetc(stdin); - If (i=' ') Then - cadd(s,c); Inc(i) - EndIf - Until (c==Cr) Or (c=='\n') EndRep - /* return i */ -EndFunc + exit (-1); + max = maxlen (s); + i = 0; + sini (s, max); + if (max > 80) + max = 80; -Func char rc(void) -Begin + do + { + c = fgetc (stdin); + if ((i < max) && (c >= ' ')) + { + cadd (s, c); + i++; + } + } + while (!((c == Cr) || (c == '\n'))); + /* return i */ ; +} + +char +rc (void) +{ int ls; - Str(80,s); - rs(s); ls=length(s); - If ls>0 Then - return s[ls-1] - Else - return 0 - EndIf -EndProc + Str (80, s); + rs (s); + ls = length (s); + if (ls > 0) + return s[ls - 1]; + else + return 0; + +} /******* Strings ************ * are 0-terminated char arrays with a 2-byte trailer: max length. @@ -102,842 +122,1084 @@ EndProc * MUST die. */ -Intern -Proc stringbug(Pchar op, Pchar s, Pchar t, char c) +static void +stringbug (char *op, char *s, char *t, char c) /* we brutally stop the program on string overflow */ -Begin - char rep=' '; - fprintf( stderr, " STRING overflow %s\n", op ); - fprintf( stderr, " Operand1: %s\n", s ); - If t != Null Then - fprintf( stderr, " Operand2: %s\n", t ); - EndIf - If c != 0 Then - 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 +{ + char rep = ' '; + fprintf (stderr, " STRING overflow %s\n", op); + fprintf (stderr, " Operand1: %s\n", s); + if (t != NULL) + fprintf (stderr, " Operand2: %s\n", t); -Proc sini(Pchar s, int max) /* suppose s is allocated */ -Begin - If max<1 Then - max=1 - ElsIf max>Maxstr Then - max=Maxstr - EndIf - s[0]=0; - s[1]= Hi(max); s[2]= Lo(max); -EndProc + if (c != 0) + fprintf (stderr, "{%c}\n", c); -Proc sfix(Pchar s, int i, int max) + fprintf (stderr, "Aborting...\n"); + exit (1); + +/* The code below cannot be reached */ +/* Remnants of old interface ?*/ + + ws (" [A]bort [I]gnore ? "); + rep = rc (); + if (upcase (rep) == 'A') + exit (1); +} + +void +sini (char *s, int max) /* suppose s is allocated */ +{ + if (max < 1) + max = 1; + else if (max > Maxstr) + max = Maxstr; + + s[0] = 0; + s[1] = Hi (max); + s[2] = Lo (max); +} + +void +sfix (char *s, int i, int max) /* suppose s is allocated and filled with non-zero stuff */ -Begin +{ int j; - If max<1 Then - max=1 - ElsIf max>Maxstr Then - max=Maxstr - EndIf - If i>max Then - i=max - ElsIf i<0 Then - i=0 - EndIf - s[i]=0; - s[i+1]= Hi(max); s[i+2]= Lo(max); - For j=0;j Maxstr) + max = Maxstr; -Intern -Proc inistring(Pchar s, char c, int max) + if (i > max) + i = max; + else if (i < 0) + i = 0; + + s[i] = 0; + s[i + 1] = Hi (max); + s[i + 2] = Lo (max); + + for (j = 0; j < i; j++) /* eliminate null characters ! */ + if (s[j] == 0) + s[j] = 1; + +} + +static void +inistring (char *s, char c, int max) /* suppose s is allocated. empty it if c is zero ! */ -Begin - int i=0; - s[i]=c; - If c!=0 Then - Inc(i); s[i]=0 - EndIf - If max<1 Then - max=1 - ElsIf max>Maxstr Then - max=Maxstr - EndIf - s[i+1]= Hi(max); s[i+2]= Lo(max); -EndProc +{ + int i = 0; + s[i] = c; + if (c != 0) + { + i++; + s[i] = 0; + } -Func int length(Pchar s) -Begin - int lg=0; - While NotZ(s[lg]) Do Inc(lg) Done - return lg -EndFunc + if (max < 1) + max = 1; + else if (max > Maxstr) + max = Maxstr; -Func int maxlen(Pchar s) -Begin - int ls= length(s); - return Getmax(s,ls) -EndFunc + s[i + 1] = Hi (max); + s[i + 2] = Lo (max); +} -Func Bool sadd( Pchar s, Pchar t) -Begin - Bool ok; - int i=0, max, ls= length(s); - max= Getmax(s,ls); - While (t[i] !=0) And (ls=0; Dec(i) Do s[i+1]=s[i] Done; - s[0]=c; - EndIf - If Not ok Then - stringbug("cins",s, Null,c) - EndIf - return ok -EndProc + return lg; +} -Func Bool sins( Pchar s, Pchar t) -Begin - int i, max, ls= length(s), lt=length(t); - Bool ok; - max= Getmax(s,ls); - ok= ((ls+lt) < max); - If ok Then - For i=ls+2; i>=0; Dec(i) Do s[i+lt]=s[i] Done; - For i=0; i= 0; i--) + s[i + 1] = s[i]; + s[0] = c; + } + + if (!ok) + stringbug ("cins", s, NULL, c); + + return ok; +} + +unsigned char +sins (char *s, char *t) +{ + int i, max, ls = length (s), lt = length (t); + unsigned char ok; + max = Getmax (s, ls); + ok = ((ls + lt) < max); + + if (ok) + { + for (i = ls + 2; i >= 0; i--) + s[i + lt] = s[i]; + + for (i = 0; i < lt; i++) + s[i] = t[i]; + } + + if (!ok) + stringbug ("sins", s, t, 0); + + return ok; +} + +int +cpos (char c, char *s) /* return position of c in s, or 0 if not found. * BUG, Pascal inherited: first char is at 1, not 0 ! */ -Begin - int i=0; - While (s[i] !=c) And (s[i] !=0) Do Inc(i) Done - If s[i]==c Then - return (i+1) - Else - return 0 - EndIf -EndFunc +{ + int i = 0; + while ((s[i] != c) && (s[i] != 0)) + i++; -Func char upcase(char c) -Begin - If (c>='a')And(c<='z') Then - return c+'A'-'a' - Else - return c - EndIf -EndFunc + if (s[i] == c) + return (i + 1); + else + return 0; +} -Func Bool scopy(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= 'a') && (c <= 'z')) + return c + 'A' - 'a'; + else + return c; +} -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 (i0 Then - s[0]=c; sfix(s,1,max); - ok=True - EndIf - If Not ok Then - stringbug("ccopy",s, Null,c) - EndIf - return ok -EndProc + while ((t[i] != 0) && (i < max)) + { + s[i] = t[i]; + i++; + } -Func Pchar pscopy(Pchar s, Pchar t, int start, int leng) + s[i] = 0; + s[i + 1] = Hi (max); + s[i + 2] = Lo (max); + ok = (t[i] == 0); /* end of t is reached */ + + if (!ok) + stringbug ("scopy", s, t, 0); + + return ok; +} + +unsigned char +scopy_up (char *s, char *t) /* returns success flag */ +{ + unsigned char ok; + int i, max, ls = length (s); + max = Getmax (s, ls); + i = 0; + while ((t[i] != 0) && (i < max)) + { + s[i] = upcase (t[i]); + i++; + } + + s[i] = 0; + s[i + 1] = Hi (max); + s[i + 2] = Lo (max); + ok = (t[i] == 0); /* end of t is reached */ + + if (!ok) + stringbug ("scopy_up", s, t, 0); + + return ok; +} + +unsigned char +ccopy (char *s, char c) /* returns success flag */ +{ + int max, ls = length (s); + unsigned char ok = 0; + max = Getmax (s, ls); + + if (max > 0) + { + s[0] = c; + sfix (s, 1, max); + ok = 1; + } + + if (!ok) + stringbug ("ccopy", s, NULL, c); + + return ok; +} + +char * +pscopy (char *s, char *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 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= 0) && (max <= Maxstr); -Func Pchar pscopy_up(Pchar s, Pchar t, int start, int leng) + if (!ok) + stringbug ("copy target non-init", s, t, 0); + + if (leng > max) + { + leng = max; + ok = 0; + } + + if (start > stop) + { /* nothing! */ + ok = 0; + inistring (s, 0, max); + } + else + { + if ((start + leng - 1) > stop) + { + leng = stop - start + 1; + ok = 0; + } + for (i = 0; i < leng; i++) + s[i] = t[start + i - 1]; + + i = leng; + s[i] = 0; + s[i + 1] = Hi (max); + s[i + 2] = Lo (max); + } + /* if ( ! ok ) { stringbug("copy",s, t, 0) ;} */ + /* if ( ok ) { return s ;} else { return NULL ;} */ + ok = ok; + return s; +} + +char * +pscopy_up (char *s, char *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 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= 0) && (max <= Maxstr); -Func int ord(char c) -Begin - return c AND 0xff -EndFunc /* strip high byte */ + if (!ok) + stringbug ("copy target non-init", s, t, 0); -Func int pred(int i) -Begin - return (--i) -EndFunc + if (leng > max) + { + leng = max; + ok = 0; + } -Func int succ(int i) -Begin - return (++i) -EndFunc + if (start > stop) + { /* nothing! */ + ok = 0; + inistring (s, 0, max); + } + else + { + if ((start + leng - 1) > stop) + { + leng = stop - start + 1; + ok = 0; + } + for (i = 0; i < leng; i++) + s[i] = upcase (t[start + i - 1]); -Func Bool nadd( Pchar s, long n) + i = leng; + s[i] = 0; + s[i + 1] = Hi (max); + s[i + 2] = Lo (max); + } + /* if ( ! ok ) { stringbug("copy",s, t, 0) ;} */ + /* if ( ok ) { return s ;} else { return NULL ;} */ + ok = ok; + return s; +} + +int +ord (char c) +{ + return (c & 0xff); +} /* strip high byte */ + +int +pred (int i) +{ + return (--i); +} + +int +succ (int i) +{ + return (++i); +} + +unsigned char +nadd (char *s, long n) /* append a decimal integer to a string */ -Begin +{ int d[25]; - int j,k,ls,len; - char sg; /* the sign */ - Bool ok; - k=0; - len=maxlen(s); - If n<0 Then - n= -n; sg='-' - Else - sg='+' - EndIf - While n>0 Do - d[k]=n Mod 10; Inc(k); - n= n Div 10 - Done - If k==0 Then - ok=cadd(s,'0') - Else - ls=length(s); - ok= (len-ls)>k; - If ok Then - If sg=='-' Then - s[ls]=sg; Inc(ls) - EndIf - For j=k-1; j>=0; Dec(j) Do - s[ls]=d[j]+'0'; Inc(ls) - Done - sfix(s,ls,len); - EndIf - EndIf - If Not ok Then - stringbug("nadd",s, Null,sg) - EndIf - return ok -EndProc + int j, k, ls, len; + char sg; /* the sign */ + unsigned char ok; + k = 0; + len = maxlen (s); -Proc stri( long n, Pchar s) + if (n < 0) + { + n = -n; + sg = '-'; + } + else + sg = '+'; + + while (n > 0) + { + d[k] = n % 10; + k++; + n = n / 10; + } + + if (k == 0) + ok = cadd (s, '0'); + else + { + ls = length (s); + ok = (len - ls) > k; + if (ok) + { + if (sg == '-') + { + s[ls] = sg; + ls++; + } + for (j = k - 1; j >= 0; j--) + { + s[ls] = d[j] + '0'; + ls++; + } + sfix (s, ls, len); + } + } + + if (!ok) + stringbug ("nadd", s, NULL, sg); + + return ok; +} + +void +stri (long n, char *s) /* convert integer to string */ -Begin - sini(s, maxlen(s)); - nadd(s,n) -EndProc +{ + sini (s, maxlen (s)); + nadd (s, n); +} -Proc rawcopy(Pointer a, Pointer b, int la, int lb) +void +rawcopy (void *a, void *b, int la, int lb) /* dirty binary copy */ -Begin - int j,n; - If lbb[j] Then - k=1 - EndIf - return k -EndFunc + for (j = 0; j < n; j++) + ((char *) a)[j] = ((char *) b)[j]; +} -Func Bool steq(Pchar a, Pchar b) /* string a==b test */ -Begin - Word j=0; - While (a[j]==b[j]) And (a[j]!=0) And (b[j]!=0) Do Inc(j) Done; - return ((a[j]==0) And (b[j]==0)) /* string equality test */ -EndFunc +int +scompare (char *a, char *b) +{ + unsigned short j = 0; + int k = 0; + while ((a[j] == b[j]) && (a[j] != 0) && (b[j] != 0)) + j++; -Func Bool stne(Pchar s, Pchar t) -Begin - return scompare(s,t) !=0 -EndFunc + if (a[j] < b[j]) + k = -1; + else if (a[j] > b[j]) + k = 1; -Func int hi(long w) -Begin - return (w AND 0xff00) Shr 8 -EndFunc + return k; +} -Func int lo(long w) -Begin - return (w AND 0xff) -EndFunc +unsigned char +steq (char *a, char *b) /* string a==b test */ +{ + unsigned short j = 0; + while ((a[j] == b[j]) && (a[j] != 0) && (b[j] != 0)) + j++; -Func char lowcase(char c) -Begin - If (c>='A')And(c<='Z') Then - return (char)(c-'A' +'a') - Else - return c - EndIf -EndFunc + return ((a[j] == 0) && (b[j] == 0)) /* string equality test */ ; +} -Func Bool alfa( char c) -Begin - return ((c>='a') And (c<='z')) Or ((c>='A') And (c<='Z')) || c == '_' || c == '[' || c == ']'; -EndFunc +unsigned char +stne (char *s, char *t) +{ + return scompare (s, t) != 0; +} -Func Bool num( char c) -Begin - return (c>='0') And (c<='9'); -EndFunc +int +hi (long w) +{ + return (w & 0xff00) >> 8; +} -Func Bool alfanum(char c) -Begin - return - alfa(c) - Or ((c>='0')And(c<='9')) -EndFunc +int +lo (long w) +{ + return (w & 0xff); +} -Func int freadstr(Pfile f, Pchar s, int max) +char +lowcase (char c) +{ + if ((c >= 'A') && (c <= 'Z')) + return (char) (c - 'A' + 'a'); + else + return c; +} + +unsigned char +alfa (char c) +{ + return ((c >= 'a') && (c <= 'z')) || ((c >= 'A') && (c <= 'Z')) || c == '_' + || c == '[' || c == ']'; +} + +unsigned char +num (char c) +{ + return (c >= '0') && (c <= '9'); +} + +unsigned char +alfanum (char c) +{ + return alfa (c) || ((c >= '0') && (c <= '9')); +} + +int +freadstr (FILE * f, char *s, int max) /* read a line from a file. BUG: long lines truncated without warning, ctrl chars are dumped. */ -Begin - char c; - int i=0, mxlen=maxlen(s); - If mxlen=' ') Or (c<0) Or (c==Tab)) And (i0) And (c<=' ')) EndRep /* skip space */ - If c=='-' Then - minus=True; c=fgetc(f) - EndIf - While num(c) Do - z= 10*z + c-'0'; c=fgetc(f) - Done - ungetc(c,f) ; /* re-push character lookahead */ - If minus Then z= -z EndIf; - return z -EndFunc + int i = 0, mxlen = maxlen (s); -Func Pchar stupcase( Pchar s) -Begin - int i=0; - While s[i] !=0 Do - s[i]= upcase(s[i]); Inc(i) - Done - return s -EndFunc + if (mxlen < max) + max = mxlen; + + do + { + c = fgetc (f); /* tab is the only control char accepted */ + if (((c >= ' ') || (c < 0) || (c == Tab)) && (i < max)) + { + s[i] = c; + i++; + } + } + while (!(feof (f) || (c == '\n'))); + + s[i] = 0; + s[i + 1] = Hi (mxlen); + s[i + 2] = Lo (mxlen); + + return i; +} + +char +freadc (FILE * f) +{ + return fgetc (f); +} + +long +freadi (FILE * f) +/* reads next integer, but returns 0 if none found. */ +{ + long z = 0; + unsigned char minus = 0; + char c; + + do + { + c = fgetc (f); + } + while (!(feof (f) || !((c > 0) && (c <= ' ')))); /* skip space */ + + if (c == '-') + { + minus = 1; + c = fgetc (f); + } + + while (num (c)) + { + z = 10 * z + c - '0'; + c = fgetc (f); + } + + ungetc (c, f); /* re-push character lookahead */ + + if (minus) + z = -z; + + return z; +} + +char * +stupcase (char *s) +{ + int i = 0; + + while (s[i] != 0) + { + s[i] = upcase (s[i]); + i++; + } + + return s; +} /***** pointer tricks: app won't use naked malloc(), free() ****/ -Proc dispose(Pointer p) -Begin - If p != Null Then free(p) EndIf -EndProc +void +dispose (void *p) +{ + if (p != NULL) + free (p); +} -Func Pointer new(long sz) -Begin - Pointer p; - If sz<=0 Then - return Null - Else - p= malloc(sz); - If p==Null Then /* fatal error */ - ws(" new() failure. Program halted.\n"); - exit(1); - EndIf - return p - EndIf -EndFunc +void * +new (long sz) +{ + void *p; + if (sz <= 0) + return NULL; + else + { + p = malloc (sz); + if (p == NULL) + { /* fatal error */ + ws (" new() failure. Program halted.\n"); + exit (1); + } + return p; + } +} -Func Pchar newstring(int n) -Begin - Pchar s= (Pchar)new(n+4); - sini(s, n); - return s -EndFunc +char * +newstring (int n) +{ + char *s = (char *) new (n + 4); + + sini (s, n); + return s; +} /***** elementary math *******/ -Func double sqr(double x) -Begin - return x*x -EndFunc +double +sqr (double x) +{ + return x * x; +} -Func double absf(double x) -Begin - If x<0.0 Then - return -x - Else - return x - EndIf -EndFunc +double +absf (double x) +{ + if (x < 0.0) + return -x; + else + return x; +} -Func long absi(long i) -Begin - If i>=0 Then - return(i) - Else - return(-i) - EndIf -EndFunc +long +absi (long i) +{ + if (i >= 0) + return (i); + else + return (-i); +} -Proc strif(long i, int f, Pchar s) +void +strif (long i, int f, char *s) /* formatting like str(i:f,s) in Turbo Pascal */ -Begin - int j,k,n,max; +{ + int j, k, n, max; char cs; char t[32]; - k=0; - max=maxlen(s); - If i<0 Then - i= -i; cs='-' - Else - cs=' ' - EndIf; - While i>0 Do - j=(int)(i Mod 10); - i=(long)(i Div 10); - t[k]=chr('0'+j); Inc(k) - Done - If k==0 Then - t[k]='0'; Inc(k) - EndIf - If cs=='-' Then - t[k]=cs - Else - Dec(k) - EndIf; - /* now the string is in 0...k in reverse order */ - For j=1; j<=k; Inc(j) Do t[k+j]=t[k-j] Done /* mirror image */ - t[2*k+1]=0; /* null termination */ - n=0; - If (f>k) And (f<40) Then /* reasonable format */ - For j=k+2; j<=f; Inc(j) Do - s[n]=' '; Inc(n) - Done - EndIf - For j=0; j<=k+1; Inc(j) Do s[n+j]=t[k+j] Done; /* shift t down */ - k=length(s); - sfix(s,k,max); -EndProc + k = 0; + max = maxlen (s); -Func Bool odd(long x) -Begin - return NotZ(x AND 1) -EndFunc + if (i < 0) + { + i = -i; + cs = '-'; + } + else + { + cs = ' '; + } -Func int vali(Pchar s, long * i) + while (i > 0) + { + j = (int) (i % 10); + i = (long) (i / 10); + t[k] = (char)('0' + j); + k++; + } + + if (k == 0) + { + t[k] = '0'; + k++; + } + + if (cs == '-') + t[k] = cs; + else + k--; + + /* now the string is in 0...k in reverse order */ + for (j = 1; j <= k; j++) + t[k + j] = t[k - j]; /* mirror image */ + + t[2 * k + 1] = 0; /* null termination */ + n = 0; + + if ((f > k) && (f < 40)) + { /* reasonable format */ + for (j = k + 2; j <= f; j++) + { + s[n] = ' '; + n++; + } + } + + for (j = 0; j <= k + 1; j++) + s[n + j] = t[k + j]; /* shift t down */ + + k = length (s); + sfix (s, k, max); +} + +unsigned char +odd (long x) +{ + return (x & 1); +} + +int +vali (char *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 - int k=0, digit=0, ls; - long z=0; - Bool minus=False, ok=True; +{ + int k = 0, digit = 0, ls; + long z = 0; + unsigned char minus = 0, ok = 1; char c; - ls=length(s); - Repeat - c=s[k]; Inc(k) - Until (k>=ls) Or Not ((c>0) And (c<=' ')) EndRep /* skip space */ - If c=='-' Then - minus=True; - c=s[k]; Inc(k) - EndIf - While num(c) Do - z= 10*z + c-'0'; - c=s[k]; Inc(k); - Inc(digit) - Done - If minus Then z= -z EndIf; - *i= z; - ok= (digit>0) And (c==0); /* successful end of string */ - If ok Then - return 0 - Else - return k /* one beyond error position */ - EndIf -EndFunc + ls = length (s); -Intern -Func Bool match - (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] */ - int i,j,lt; - Bool ok; - char a,b; - i=0; j=tstart; - lt= length(t); - ok=(tstart= ls) || !((c > 0) && (c <= ' ')))); /* skip space */ + + if (c == '-') + { + minus = 1; + c = s[k]; + k++; + } + + while (num (c)) + { + z = 10 * z + c - '0'; + c = s[k]; + k++; + digit++; + } + + if (minus) + z = -z; + + *i = z; + ok = (digit > 0) && (c == 0); /* successful end of string */ + + if (ok) + return 0; + else + return k; /* one beyond error position */ +} + +static unsigned char +match (char *s, char *t, int n, int tstart, unsigned char testcase) +{ +/* returns 0 if ( tstart is out of range. But n may be 0 ? */ +/* 1 if s matches t[tstart...tstart+n] */ + int i, j, lt; + unsigned char ok; + char a, b; + i = 0; + j = tstart; + lt = length (t); + ok = (tstart < lt); + + while (ok && (i < n)) + { + a = s[i]; + b = t[j]; + if (!testcase) + { + a = upcase (a); + b = upcase (b); + } + ok = (j < lt) && (a == b); + i++; + j++; + } + return ok; +} + +int +posi (char *sub, char *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 */ - int a,b,k,j; - Bool ok, tstcase; - Str(250,t); - ok=False; - tstcase=( opt==0); - If opt<=1 Then - scopy(t,sub) - Else - cadd(t,' '); sadd(t,sub); cadd(t,' '); - EndIf - a= length(t); - b= (int)(length(s)-a); - k=0; j=1; - If a>0 Then /*Else return 0*/ - While (k<=b) And (Not ok) Do - ok=match(t,s, a,k, tstcase); /* we must start at k=0 ! */ - Inc(k); - If s[k]==' ' Then Inc(j) EndIf /* word counter */ - Done - EndIf - If opt==2 Then k=j EndIf - If ok Then - return k - Else - return 0 - EndIf -EndFunc + /* opt=1: like Turbo Pascal Pos, but case insensitive */ + /* opt=2: position in space separated wordlist for scanners */ + int a, b, k, j; + unsigned char ok, tstcase; + Str (250, t); + ok = 0; + tstcase = (opt == 0); -Func int spos(Pchar sub, Pchar s) + if (opt <= 1) + scopy (t, sub); + else + { + cadd (t, ' '); + sadd (t, sub); + cadd (t, ' '); + } + + a = length (t); + b = (int) (length (s) - a); + k = 0; + j = 1; + + if (a > 0) /*;} else { return 0 */ + while ((k <= b) && (!ok)) + { + ok = match (t, s, a, k, tstcase); /* we must start at k=0 ! */ + k++; + if (s[k] == ' ') + j++; /* word counter */ ; + } + + if (opt == 2) + k = j; + + if (ok) + return k; + else + return 0; + +} + +int +spos (char *sub, char *s) /* equivalent to Turbo Pascal pos(). BUG: counts 1 ... length(s), not from 0 like C */ -Begin - char *ptr; +{ + char *ptr; - if ( ( ptr = strstr( s, sub ) ) ) return strlen(s) - strlen(ptr) + 1; - else return 0; + if ((ptr = strstr (s, sub))) + return strlen (s) - strlen (ptr) + 1; + else + return 0; -EndFunc +} /**** float formatting with printf/scanf ******/ -Func int valr(Pchar s, double *r) +int +valr (char *s, double *r) /* returns 0 if ok, else length of partial string ? */ -Begin - int n=sscanf(s, "%lG", r); - If n==1 Then - return(0) - Else - return(1) - EndIf -EndFunc +{ + int n = sscanf (s, "%lG", r); + if (n == 1) + return (0); + else + return (1); +} -Proc strf( double x, int f1, int f2, Pchar t) +void +strf (double x, int f1, int f2, char *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); - int n,mlt; - mlt=maxlen(t); - cadd(fmt,'%'); - If f1>0 Then - nadd(fmt , f1); /* f1 is the total width */ - If f2<0 Then - sadd(fmt,"lE") /* exponent format */ - Else - cadd(fmt,'.'); - nadd(fmt,f2); - sadd(fmt,"lg") - EndIf - Else - cadd(fmt,'.'); - nadd(fmt, absi(f2-6)); /* note the 6 surplus positions */ - cadd(fmt,'e'); - EndIf - n=sprintf(t, fmt, x); - sfix(t,n, mlt); -EndProc +{ /*default f1=17, f2=-1 */ + Str (30, fmt); + int n, mlt; + mlt = maxlen (t); + cadd (fmt, '%'); + if (f1 > 0) + { + nadd (fmt, f1); /* f1 is the total width */ + if (f2 < 0) + sadd (fmt, "lE"); /* exponent format */ + else + { + cadd (fmt, '.'); + nadd (fmt, f2); + sadd (fmt, "lg"); + } + } + else + { + cadd (fmt, '.'); + nadd (fmt, absi (f2 - 6)); /* note the 6 surplus positions */ + cadd (fmt, 'e'); + } + n = sprintf (t, fmt, x); + sfix (t, n, mlt); +} -Func double rval(Pchar s, int *err) +double +rval (char *s, int *err) /* returns err=0 if ok, else length of partial string ? */ -Begin - double r= 0.0; - int n=sscanf(s, "%lG", &r); - If n==1 Then - (*err)=0 - Else - (*err)=1 - EndIf - return r; -EndFunc +{ + double r = 0.0; + int n = sscanf (s, "%lG", &r); -Func long ival(Pchar s, int *err) + if (n == 1) + (*err) = 0; + else + (*err) = 1; + + return r; +} + +long +ival (char *s, int *err) /* value of s as integer string. error code err= 0 if Ok */ -Begin - int k=0, digit=0, ls; - long z=0; - Bool minus=False, ok=True; +{ + int k = 0, digit = 0, ls; + long z = 0; + unsigned char minus = 0, ok = 1; char c; - ls=length(s); - Repeat - c=s[k]; Inc(k) - Until (k>=ls) Or Not ((c>0) And (c<=' ')) EndRep /* skip space */ - If c=='-' Then - minus=True; - c=s[k]; Inc(k) - EndIf - While num(c) Do - z= 10*z + c-'0'; - c=s[k]; Inc(k); - Inc(digit) - Done - If minus Then z= -z EndIf; - ok= (digit>0) And (c==0); /* successful end of string */ - If ok Then - (*err)= 0 - Else - (*err)= k /* one beyond error position */ - EndIf - return z -EndFunc + ls = length (s); + + do + { + c = s[k]; + k++; + } + while (!((k >= ls) || !((c > 0) && (c <= ' ')))); /* skip space */ + + if (c == '-') + { + minus = 1; + c = s[k]; + k++; + } + + while (num (c)) + { + z = 10 * z + c - '0'; + c = s[k]; + k++; + digit++; + } + + if (minus) + z = -z; + + ok = (digit > 0) && (c == 0); /* successful end of string */ + + if (ok) + (*err) = 0; + else + (*err) = k; /* one beyond error position */ + + return z; +} #ifndef _MATH_H -Func long np_round(double x) +long +np_round (double x) /* using , it would be simpler: floor(x+0.5) */ -Begin - double u; - long z; +{ + double u; + long z; int n; - Str(40,s); - u=2e9; - If x>u Then - x=u - ElsIf x< -u Then - x= -u - EndIf - n=sprintf(s,"%-12.0f", x); - s[n]=0; - sscanf(s,"%ld", Addr(z)); - return z -EndFunc + Str (40, s); + u = 2e9; + if (x > u) + x = u; + else if (x < -u) + x = -u; -Func long np_trunc(double x) -Begin - long n=np_round(x); - If (n>x) And (x>=0.0) Then - Dec(n) - ElsIf (n x) && (x >= 0.0)) + n--; + else if ((n < x) && (x < 0.0)) + n++; -Func double intp(double x) -Begin - double u=2e9; - If (x>u) Or (x< -u) Then - return x - Else - return np_trunc(x) - EndIf -EndFunc + return n; +} -#else /* use floor() and ceil() */ +double +frac (double x) +{ + return x - np_trunc (x); +} -Func long np_round(double r) -Begin - return (long)floor(r+0.5) -EndFunc +double +intp (double x) +{ + double u = 2e9; + if ((x > u) || (x < -u)) + return x; + else + return np_trunc (x); +} -Func long np_trunc(double r) -Begin - If r>=0.0 Then - return (long)floor(r) - Else - return (long)ceil(r) - EndIf -EndFunc +#else /* use floor() and ceil() */ -Func double frac(double x) -Begin - If x>=0.0 Then - return(x - floor(x)) - Else - return(x - ceil(x)) - EndIf -EndFunc +long +np_round (double r) +{ + return (long) floor (r + 0.5); +} -Func double intp(double x) /* integral part */ -Begin - If x>=0.0 Then - return floor(x) - Else - return ceil(x) - EndIf -EndFunc +long +np_trunc (double r) +{ + if (r >= 0.0) + return (long) floor (r); + else + return (long) ceil (r); +} -#endif /* _MATH_H */ +double +frac (double x) +{ + if (x >= 0.0) + return (x - floor (x)); + else + return (x - ceil (x)); +} +double +intp (double x) /* integral part */ +{ + if (x >= 0.0) + return floor (x); + else + return ceil (x); +} +#endif /* _MATH_H */ diff --git a/src/frontend/numparam/numparam.h b/src/frontend/numparam/numparam.h index a720973ee..ee2c4f1a8 100644 --- a/src/frontend/numparam/numparam.h +++ b/src/frontend/numparam/numparam.h @@ -12,42 +12,42 @@ #define ln(x) log(x) #define trunc(x) floor(x) -Cconst(Nul, 0) -Cconst(Nodekey,'#') /*introduces node symbol*/ -Cconst(Intro ,'&') /*introduces preprocessor tokens*/ -Cconst(Comment,'*') /*Spice Comment lines*/ -Cconst(Pspice,'{') /*Pspice expression */ -Cconst(Maxdico,40000) /*size of symbol table*/ +typedef enum {Nul=0} _nNul; +typedef enum {Nodekey='#'} _nNodekey; /* Introduces node symbol */ +typedef enum {Intro='&'} _nIntro; /* Introduces preprocessor tokens */ +typedef enum {Comment='*'} _nComment; /* Spice Comment lines*/ +typedef enum {Pspice='{'} _nPspice; /* Pspice expression */ +typedef enum {Maxdico=40000} _nMaxdico; /* 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,15000) +typedef enum {Llen=15000} _nLlen; typedef char str50 [54]; typedef char str80 [84]; -Cconst(Maxline, 20000) /* size of initial unexpanded circuit code */ -Cconst(Maxckt, 40000) /* size of expanded circuit code */ +typedef enum {Maxline=20000} _nMaxline; /* Size of initial unexpanded circuit code */ +typedef enum {Maxckt=40000} _nMaxckt; /* Size of expanded circuit code */ -typedef Pchar auxtable; /* dummy */ +typedef char * auxtable; /* dummy */ -Record(entry) +typedef struct _tentry { char tp; /* type: I)nt R)eal S)tring F)unction M)acro P)ointer */ 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 */ -EndRec(entry) + unsigned short ivl; /*int value or string buffer index*/ + char * sbbase; /* string buffer base address if any */ +} entry; -Record(fumas) /*function,macro,string*/ - Word start /*,stop*/ ; /*buffer index or location */ -EndRec(fumas) +typedef struct _tfumas { /*function,macro,string*/ + unsigned short start /*,stop*/ ; /*buffer index or location */ +} fumas; -Record(tdico) +typedef struct _ttdico { /* the input scanner data structure */ str80 srcfile; /* last piece of source file name */ int srcline; @@ -61,21 +61,22 @@ Record(tdico) 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) + char * refptr[Maxline]; /* pointers to source code lines */ + char category[Maxline]; /* category of each line */ +} tdico; -Proc initdico(tdico * dico); -Func int donedico(tdico * dico); -Func Bool defsubckt( tdico *dico, Pchar s, Word w, char categ); -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 ); +void initdico(tdico * dico); + int donedico(tdico * dico); + unsigned char defsubckt( tdico *dico, char * s, unsigned short w, char categ); + int findsubckt( tdico *dico, char * s, char * subname); + unsigned char nupa_substitute( tdico *dico, char * s, char * r, unsigned char err); + unsigned char nupa_assignment( tdico *dico, char * s, char mode); + unsigned char nupa_subcktcall( tdico *dico, char * s, char * x, unsigned char err); +void nupa_subcktexit( tdico *dico); + tdico * nupa_fetchinstance(void); + char getidtype( tdico *d, char * s); + int attrib( tdico *dico, char * t, char op ); char *nupa_inst_name; tdico *inst_dico; + diff --git a/src/frontend/numparam/nupatest.c b/src/frontend/numparam/nupatest.c index 858b58aac..dfb5ecc73 100644 --- a/src/frontend/numparam/nupatest.c +++ b/src/frontend/numparam/nupatest.c @@ -15,9 +15,9 @@ 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(buff, char *, Maxline) /* input lines */ +Darray(buf2, char *, Maxline) /* stripped lines */ +Darray(pxbuf, char *, Maxline) /* prefix for subnodes */ Darray(runbuf, int, Maxckt) /* index list of expanded circuit */ Darray(pindex, int, Maxckt) /* prefix index list */ int irunbuf= 0; /* count lines of runbuf */ @@ -49,211 +49,211 @@ and substitute node/device name arguments. */ -Func int runscript( tdico *dico, Pchar prefix, + int runscript( tdico *dico, char * 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 +{ int i,j, idef, nnest, nline, dn, myipx; Strbig(Llen, subpfx); /* subckt prefix */ Str(80, subname); char c; - Bool done= False; + unsigned char done= 0; i=istart; nline=0; Inc(ipx); myipx= ipx; /* local copy */ pxbuf[ipx]= newstring( length(prefix)); scopy( pxbuf[ipx], prefix); - While (maxnest>0) And (i0) && (icategory[i]; - If c=='U' Then - done=True; /* subcircuit end. Keep as a comment? */ + if ( c=='U' ) { + done=1; /* subcircuit end. Keep as a comment? */ buf2[i][0]='#'; - EndIf - If c=='S' Then /* skip nested subcircuits */ + } + if ( c=='S' ) { /* skip nested subcircuits */ nnest=1; - Repeat + do { Inc(i); c= dico->category[i]; - If c=='S' Then - Inc(nnest) - ElsIf c=='U' Then - Dec(nnest) - EndIf - Until (nnest<=0) Or (i>=istop) EndRep - ElsIf c=='X' Then /* recursion here ! */ + if ( c=='S' ) { + Inc(nnest); + } else if ( c=='U' ) { + Dec(nnest); + } + } while ( !( (nnest<=0) || (i>=istop) )); + } else if ( c=='X' ) { /* recursion here ! */ runbuf[irunbuf]= i; pindex[irunbuf]= myipx; Inc(irunbuf); Inc(nline); /* keep out-commented X line for parameter passing */ idef = findsubckt( dico, buf2[i], subname); buf2[i][0]= '*'; - If idef>0 Then + if ( idef>0 ) { scopy(subpfx, prefix); cadd(subpfx, pfxsep); j=1; /* add the instance name from buf2[i] */ - While buf2[i][j] > ' ' Do - cadd( subpfx, buf2[i][j]); Inc(j) - Done + while ( buf2[i][j] > ' ' ) { + cadd( subpfx, buf2[i][j]); Inc(j); + } dn= runscript(dico, subpfx, idef+1, istop, maxnest-1); nline= nline+dn; - Else /* FIXME: error message here! */ + } else { /* FIXME: error message here! */ ws("cannot find subckt "); ws(buf2[i]); wln(); - EndIf - ElsIf (c != '?') And NotZ(buf2[i][0]) Then + } + } else if ( (c != '?') && NotZ(buf2[i][0]) ) { /* keep any other valid non-empty line, and its prefix pointer */ runbuf[irunbuf]= i; pindex[irunbuf]= myipx; Inc(irunbuf); Inc(nline); - EndIf + } Inc(i); - Done - return nline -EndProc + } + return nline; +} -Proc gluepluslines( int imax) +void gluepluslines( int imax) /* general sweep to eliminate continuation lines */ -Begin +{ int i,j,k, ls, p; Strbig(Llen,s); i=1; - While i<= imax Do - If (buff[i][0]=='+') And (i>1) Then + while ( i<= imax ) { + if ( (buff[i][0]=='+') && (i>1) ) { j= i-1; - While (i < imax) And (buff[i+1][0]=='+') Do Inc(i) Done + while ( (i < imax) && (buff[i+1][0]=='+') ) { Inc(i) ;} /* the lines j+1 ... i are continuation lines to j */ - For k=j; k<=i; Inc(k) Do + for ( k=j; k<=i; Inc(k) ) { ls=length(s); sadd(s, buff[k]); p= spos("//",s); - If p>0 Then pscopy(s,s, 1,p-1) EndIf - If ls>0 Then s[ls]=' ' EndIf /* erase the + */ - Done + if ( p>0 ) { pscopy(s,s, 1,p-1) ;} + if ( ls>0 ) { s[ls]=' ' ;} /* erase the + */; + } ls= length(s); - If ls> 80 Then + if ( ls> 80 ) { Dispose(buff[j]); - buff[j]=newstring(ls) - EndIf - scopy(buff[j], s) - EndIf - Inc(i) - Done -EndProc + buff[j]=newstring(ls); + } + scopy(buff[j], s); + } + Inc(i); + } +} #if 0 /* sjb - this is in mystring.c */ -Proc rs(Pchar s) /* 78 coumn limit */ -Begin +void rs(char * s) /* 78 coumn limit */ +{ int i; - Bool done; + unsigned char done; char c; int max=maxlen(s); - If max>78 Then max=78 EndIf - i=0; done=False; + if ( max>78 ) { max=78 ;} + i=0; done=0; scopy(s,""); - While Not done Do + while ( ! done ) { c=fgetc(stdin); - If (c>=' ')And(c<='~') And (i=' ')&&(c<='~') && (i0) Then - pscopy(s,s,1,ls-1) - EndIf /* kill EOF character */ -EndProc + if ( feof(f) && (ls>0) ) { + pscopy(s,s,1,ls-1); + } /* kill EOF character */; +} -Proc wordinsert(Pchar s, Pchar w, int i) +void wordinsert(char * s, char * w, int i) /* insert w before s[i] */ -Begin +{ Strbig(Llen,t); int ls=length(s); pscopy(t,s,i+1,ls); pscopy(s,s,1,i); sadd(s,w); sadd(s,t); -EndProc +} -Func int worddelete(Pchar s, int i) + int worddelete(char * s, int i) /* delete word starting at s[i] */ -Begin +{ Strbig(Llen,t); int ls= length(s); int j=i; - While (j' ') Do Inc(j) Done + while ( (j' ') ) { Inc(j) ;} pscopy(t,s,j+1,ls); pscopy(s,s,1,i); sadd(s,t); - return j-i /* nb of chars deleted */ -EndProc + return j-i /* nb of chars deleted */; +} -Func int getnextword(Pchar s, Pchar u, int j) -Begin + int getnextword(char * s, char * u, int j) +{ int ls,k; ls= length(s); k=j; - While (j ' ') Do Inc(j) Done /* skip current word */ + while ( (j ' ') ) { Inc(j) ;} /* skip current word */ pscopy(u, s, k+1, j-k); - While (j0 Then - For k=0; k0 ) { + for ( k=0; k' ' Do - cadd(u,wl[i]); Inc(i) - Done - EndIf -EndProc + while ( (i' ' ) { + cadd(u,wl[i]); Inc(i); + } + } +} -Pchar deviceletter= "RLCVIBSGETOUWFHDQKJZM"; -Pchar nbofnodes = "222222444443222240334"; -Pchar nbsubdevice = "000000000000111002000"; +char * deviceletter= "RLCVIBSGETOUWFHDQKJZM"; +char * nbofnodes = "222222444443222240334"; +char * nbsubdevice = "000000000000111002000"; -Proc prefixing(Pchar s, Pchar p, Pchar formals, Pchar actuals, +void prefixing(char * s, char * p, char * formals, char * actuals, char categ, tdico *dic) /* s is a line in expanded subcircuit. p is the prefix to be glued anywhere . @@ -267,188 +267,189 @@ Reminder on Numparam symbols: naming convention: subckt,model,numparam and node names must be unique. cannot re-use a model name as a param name elsewhere, for example. */ -Begin +{ int i,j,k,ls, jnext, dsize; int dtype, nodes, subdv; - Bool done; + unsigned char done; char leadchar; Str(80,u); Str(80,v); Str(80,pfx); i=0; ls=length(s); - While (i= 0 Then + if ( dtype >= 0 ) { nodes= nbofnodes[dtype] - '0'; subdv= nbsubdevice[dtype] - '0'; - Else + } else { nodes=999; subdv=0; - EndIf - While Not done Do + } + while ( ! done ) { jnext= getnextword(s,u,j); done=(jnext >= length(s)); /* was the last one, do not transform */ /* bug: are there semilocal nodes ? in nested subckt declarations ? */ - If (leadchar=='Q') And (Not done) Then /* BJT: watch non-node name */ + if ( (leadchar=='Q') && (! done) ) { /* BJT: watch non-node name */ scopy(v,u); stupcase(v); - done= getidtype(dic, v) == 'O'; /* a model name stops the node list */ - EndIf - If (Not done) And (nodes>0) Then /* transform a node name */ + done= getidtype(dic, v) == 'O'; /* a model name stops the node list */; + } + if ( (! done) && (nodes>0) ) { /* transform a node name */ k= inwordlist(u, formals); - If (k>0) Then /* parameter node */ + if ( (k>0) ) { /* parameter node */ dsize= - worddelete(s,j); takewordlist(u,k, actuals); wordinsert(s,u,j); dsize= dsize + length(u); - ElsIf stne(u,"0") Then /* local node */ + } else if ( stne(u,"0") ) { /* local node */ wordinsert(s,pfx,j); dsize= length(pfx); - Else dsize=0 EndIf - ElsIf (Not done) And (subdv >0) Then /* splice a subdevice name */ + } else { dsize=0 ;} + } else if ( (! done) && (subdv >0) ) { /* splice a subdevice name */ wordinsert(s,p,j+1); dsize= length(p); - EndIf + } j= jnext + dsize; /* jnext did shift ...*/ - If nodes >0 Then Dec(nodes) - ElsIf subdv >0 Then Dec(subdv) - EndIf - done= done Or (Zero(nodes) And Zero(subdv)); - Done - EndIf -EndProc + if ( nodes >0 ) { Dec(nodes); + } else if ( subdv >0 ) { Dec(subdv); + } + done= done || (Zero(nodes) && Zero(subdv)); + } + } +} -Proc getnodelist(Pchar form, Pchar act, Pchar s, tdico *dic, int k) +void getnodelist(char * form, char * act, char * s, tdico *dic, int k) /* the line s contains the actual node parameters, between 1st & last word */ -Begin +{ int j,ls, idef; Str(80,u); Strbig(Llen,t); ccopy(act,' '); ccopy(form,' '); j=0; ls= length(s); j= getnextword(s,u,j); - While j */ - If idef>0 Then - scopy(t, buf2[idef]) - Else + if ( idef>0 ) { + scopy(t, buf2[idef]); + } else { ws("Subckt call error: "); ws(s); wln(); - EndIf + } j=0; ls= length(t); j= getnextword(t,u,j); j= getnextword(t,u,j); - While jcategory[k], dic); - If dic->category[k] == 'X' Then - If parstack< (10-1) Then Inc(parstack) EndIf + if ( dic->category[k] == 'X' ) { + if ( parstack< (10-1) ) { Inc(parstack) ;} getnodelist(formals[parstack], actuals[parstack], s, dic,k); /*dbg: ws("Form: "); ws(formals[parstack] ); wln(); */ - /*dbg: ws("Actu: "); ws(actuals[parstack]); wln(); */ - ElsIf dic->category[k]=='U' Then /* return from subckt */ - If parstack>0 Then Dec(parstack) EndIf - EndIf - If fout != Null Then - fwrites(fout, s); fwriteln(fout) - EndIf - EndIf - Done - If fout != Null Then fclose(fout) EndIf - nupa_signal(NUPAEVALDONE, Null); /* frees the buff[i] */ - For i= 10-1; i>=0; Dec(i) Do + /*dbg: ws("Actu: "); ws(actuals[parstack]); wln(); */; + } else if ( dic->category[k]=='U' ) { /* return from subckt */ + if ( parstack>0 ) { Dec(parstack) ;} + } + if ( fout != NULL ) { + fwrites(fout, s); fwriteln(fout); + } + } + } + if ( fout != NULL ) { fclose(fout) ;} + nupa_signal(NUPAEVALDONE, NULL); /* frees the buff[i] */ + for ( i= 10-1; i>=0; Dec(i) ) { Dispose(actuals[i]); Dispose(formals[i]); - Done - For i= Maxline -1; i>=0; Dec(i) Do + } + for ( i= Maxline -1; i>=0; Dec(i) ) { Dispose(pxbuf[i]); Dispose(buf2[i]); - /* Dispose(buff[i]) done elsewhere */ - Done -EndProc + /* Dispose(buff[i]) done elsewhere */; + } +} -Func int main(int argc, Pchar argv[]) -Begin + int main(int argc, char * argv[]) +{ Str(80,fname); - If argc>1 Then - scopy(fname, argv[1]) - Else - scopy(fname,"testfile.nup") - EndIf + if ( argc>1 ) { + scopy(fname, argv[1]); + } else { + scopy(fname,"testfile.nup"); + } nupa_test(fname, 'w'); - return 0 -EndFunc + return 0; +} + diff --git a/src/frontend/numparam/spicenum.c b/src/frontend/numparam/spicenum.c index dea0188f4..9d9123315 100644 --- a/src/frontend/numparam/spicenum.c +++ b/src/frontend/numparam/spicenum.c @@ -29,7 +29,7 @@ Todo: #include "numparam.h" #include "ngspice.h" -extern void txfree(void *ptr); +extern void txfree (void *ptr); /* Uncomment this line to allow debug tracing */ /* #define TRACE_NUMPARAMS */ @@ -55,220 +55,290 @@ extern void txfree(void *ptr); /********** string handling ***********/ #define PlaceHold 1000000000L -Intern long placeholder= 0; +static long placeholder = 0; -#ifdef NOT_REQUIRED /* SJB - not required as front-end now does stripping */ -Intern -Func int stripcomment( Pchar s) +#ifdef NOT_REQUIRED /* SJB - not required as front-end now does stripping */ +static int +stripcomment (char *s) /* allow end-of-line comments in Spice, like C++ */ -Begin - int i,ls; - char c,d; - Bool stop; - ls=length(s); - c=' '; i=0; stop=False; - While (i0)And (s[i-1]<=' ') Do Dec(i) Done; /*strip blank space*/ - If i<=0 Then - scopy(s,"") - Else - pscopy(s,s,1,i) - EndIf - Else - i= -1 - EndIf - return i /* i>=0 if comment stripped at that position */ -EndFunc +{ + int i, ls; + char c, d; + unsigned char stop; + ls = length (s); + c = ' '; + i = 0; + stop = 0; + + while ((i < ls) && !stop) + { + d = c; + i++; + c = s[i - 1]; + stop = (c == d) && ((c == '/') || (c == '-')); + /* comments after // or -- */ ; + } + if (stop) + { + i = i - 2; /*last valid character before Comment */ + while ((i > 0) && (s[i - 1] <= ' ')) + i--; /*strip blank space */ + + if (i <= 0) + scopy (s, ""); + else + pscopy (s, s, 1, i); + } + else + i = -1; + + return i /* i>=0 if comment stripped at that position */ ; +} #endif /* NOT_REQUIRED */ -Intern -Proc stripsomespace(Pchar s, Bool incontrol) -Begin +static void +stripsomespace (char *s, unsigned char incontrol) +{ /* iff s starts with one of some markers, strip leading space */ - Str(12,markers); - int i,ls; - scopy(markers,"*.&+#$"); - If Not incontrol Then - sadd(markers,"xX") - EndIf - ls=length(s); i=0; - While (i0) And (i0) Then - pscopy(s,s,i+1,ls) - EndIf -EndProc + Str (12, markers); + int i, ls; + scopy (markers, "*.&+#$"); -#if 0 /* unused? */ -Proc partition(Pchar t) + if (!incontrol) + sadd (markers, "xX"); + + ls = length (s); + i = 0; + while ((i < ls) && (s[i] <= ' ')) + i++; + + if ((i > 0) && (i < ls) && (cpos (s[i], markers) > 0)) + pscopy (s, s, i + 1, ls); + +} + +#if 0 /* unused? */ +void +partition (char *t) /* t is a list val=expr val=expr .... Insert Lf-& before any val= */ /* the Basic preprocessor doesnt understand multiple cmd/line */ /* bug: strip trailing spaces */ -Begin - Strbig(Llen,u); - int i,lt,state; +{ + Strbig (Llen, u); + int i, lt, state; char c; - cadd(u,Intro); - state=0; /* a trivial 3-state machine */ - lt=length(t); - While t[lt-1] <= ' ' Do Dec(lt) Done - For i=0; i0) And (j' ' 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); - sadd(t,s); - scopy(s,t); - Else - Inc(i) - EndIf - ls=length(s); - Done - return n -EndFunc +{ + int n, i, nest, ls, j; + Strbig (Llen, t); + n = 0; + ls = length (s); + i = 0; -Intern -Func int findsubname(tdico * dico, Pchar s) + while (i < ls) + { + if (s[i] == '{') + { /* something to strip */ + j = i + 1; + nest = 1; + n++; + + while ((nest > 0) && (j < ls)) + { + if (s[j] == '{') + nest++; + else if (s[j] == '}') + nest--; + j++; + } + pscopy (t, s, 1, i); + placeholder++; + + if (t[i - 1] > ' ') + cadd (t, ' '); + + 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] >= ' ') + cadd (t, ' '); + + i = length (t); + pscopy (s, s, j + 1, ls); + sadd (t, s); + scopy (s, t); + } + else + i++; + + ls = length (s); + } + + return n; +} + +static int +findsubname (tdico * dico, char *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); - int h,j,k,nest,ls; - Bool found; - h=0; - ls=length(s); - k=ls; found=False; - While (k>=0) And (Not found) Do /* skip space, then non-space */ - While (k>=0) And (s[k]<=' ') Do Dec(k) Done; - h=k+1; /* at h: space */ - While (k>=0) And (s[k]>' ') Do - If s[k]=='}' Then - nest=1; - Dec(k); - While (nest>0) And (k>=0) Do - If s[k]=='{' Then - Dec(nest) - ElsIf s[k]=='}' Then - Inc(nest) - EndIf - Dec(k) - Done - h=k+1; /* h points to '{' */ - Else - Dec(k) - EndIf; - Done - 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 - cadd(name, upcase(s[j])); Inc(j) - Done - found = (getidtype(dico, name) == 'U'); - EndIf - Done - If found And (h= 0) && (!found)) + { /* skip space, then non-space */ + while ((k >= 0) && (s[k] <= ' ')) + k--; + + h = k + 1; /* at h: space */ + while ((k >= 0) && (s[k] > ' ')) + { + + if (s[k] == '}') + { + nest = 1; + k--; + + while ((nest > 0) && (k >= 0)) + { + if (s[k] == '{') + nest--; + else if (s[k] == '}') + nest++; + + k--; + } + h = k + 1; /* h points to '{' */ ; + } + else + k--; + } + + found = (k >= 0) && alfanum (s[k + 1]); /* suppose an identifier */ + if (found) + { /* check for known subckt name */ + scopy (name, ""); + j = k + 1; + while (alfanum (s[j])) + { + cadd (name, upcase (s[j])); + j++; + } + found = (getidtype (dico, name) == 'U'); + } + } + if (found && (h < ls)) + pscopy (s, s, 1, h); + return h; -EndFunc +} -Intern -Proc modernizeex( Pchar s) +static void +modernizeex (char *s) /* old style expressions &(..) and &id --> new style with braces. */ -Begin - Strbig(Llen,t); - int i,state, ls; - char c,d; - i=0; state=0; - ls= length(s); - While i0) Then - If d=='(' Then - state=1; Inc(i); c='{' - ElsIf alfa(d) Then - cadd(t,'{'); Inc(i); - While alfanum(s[i]) Do - cadd(t,s[i]); Inc(i) - Done - c='}'; Dec(i); - EndIf - ElsIf NotZ(state) Then - If c=='(' Then - Inc(state) - ElsIf c==')' Then - Dec(state) - EndIf - If Zero(state) Then /* replace ) by terminator */ - c='}'; - EndIf - EndIf - cadd(t,c); - Inc(i) - Done - scopy(s,t); -EndProc +{ + Strbig (Llen, t); + int i, state, ls; + char c, d; + i = 0; + state = 0; + ls = length (s); -Intern -Func char transform(tdico * dico, Pchar s, Bool nostripping, Pchar u) + while (i < ls) + { + c = s[i]; + d = s[i + 1]; + if ((!state) && (c == Intro) && (i > 0)) + { + if (d == '(') + { + state = 1; + i++; + c = '{'; + } + else if (alfa (d)) + { + cadd (t, '{'); + i++; + while (alfanum (s[i])) + { + cadd (t, s[i]); + i++; + } + c = '}'; + i--; + } + } + else if (state) + { + if (c == '(') + state++; + else if (c == ')') + state--; + + if (!state) /* replace--) by terminator */ + c = '}'; + + } + + cadd (t, c); + i++; + } + scopy (s, t); +} + +static char +transform (tdico * dico, char *s, unsigned char nostripping, char *u) /* line s is categorized and crippled down to basic Spice * returns in u control word following dot, if any * @@ -292,60 +362,78 @@ Func char transform(tdico * dico, Pchar s, Bool nostripping, Pchar u) * '.' any other dot line * 'B' netlist (or .model ?) line that had Braces killed */ -Begin - Strbig(Llen,t); - char category; - int i,k, a,n; +{ + Strbig (Llen, t); + char category; + 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_up(t,s); - k=1; - While t[k]>' ' Do - cadd(u, t[k]); Inc(k) - Done - If ci_prefix(".PARAM",t) ==1 Then /* comment it out */ - /*s[0]='*';*/ - category='P'; - 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 ci_prefix(".CONTROL",t) ==1 Then - category='C' - ElsIf ci_prefix(".ENDC",t) ==1 Then - category='E' - ElsIf ci_prefix(".ENDS",t) ==1 Then - category='U' - Else - category='.'; - n= stripbraces(s); - If n>0 Then category='B' EndIf /* priority category ! */ - EndIf - ElsIf s[0]==Intro Then /* private style preprocessor line */ - s[0]='*'; - category='P'; - ElsIf upcase(s[0])=='X' Then /* strip actual parameters */ - i=findsubname(dico, s); /* i= index following last identifier in s */ - category='X'; - ElsIf s[0]=='+' Then /* continuation line */ - category='+' - ElsIf cpos(s[0],"*$#")<=0 Then /* not a comment line! */ - n= stripbraces(s); - If n>0 Then - category='B' /* line that uses braces */ - Else - category=' ' - EndIf; /* ordinary code line*/ - Else - category='*' - EndIf - return category -EndFunc + stripsomespace (s, nostripping); + modernizeex (s); /* required for stripbraces count */ + scopy (u, ""); + + if (s[0] == '.') + { /* check Pspice parameter format */ + scopy_up (t, s); + k = 1; + + while (t[k] > ' ') + { + cadd (u, t[k]); + k++; + } + + if (ci_prefix (".PARAM", t) == 1) + { /* comment it out */ + /*s[0]='*'; */ + category = 'P'; + } + else if (ci_prefix (".SUBCKT", t) == 1) + { /* split off any "params" tail */ + a = spos ("PARAMS:", t); + if (a > 0) + pscopy (s, s, 1, a - 1); + + category = 'S'; + } + else if (ci_prefix (".CONTROL", t) == 1) + category = 'C'; + else if (ci_prefix (".ENDC", t) == 1) + category = 'E'; + else if (ci_prefix (".ENDS", t) == 1) + category = 'U'; + else + { + category = '.'; + n = stripbraces (s); + if (n > 0) + category = 'B'; /* priority category ! */ + } + } + else if (s[0] == Intro) + { /* private style preprocessor line */ + s[0] = '*'; + category = 'P'; + } + else if (upcase (s[0]) == 'X') + { /* strip actual parameters */ + i = findsubname (dico, s); /* i= index following last identifier in s */ + category = 'X'; + } + else if (s[0] == '+') /* continuation line */ + category = '+'; + else if (cpos (s[0], "*$#") <= 0) + { /* not a comment line! */ + n = stripbraces (s); + if (n > 0) + category = 'B'; /* line that uses braces */ + else + category = ' '; /* ordinary code line */ + } + else + category = '*'; + + return category; +} /************ core of numparam **************/ @@ -353,19 +441,19 @@ EndFunc and everything will get hidden behind some "handle" ... */ -Intern int linecount= 0; /* global: number of lines received via nupa_copy */ -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= False; /* for debugging */ -Intern Bool firstsignal=True; -Intern Pfile logfile= Null; -Intern tdico * dico=Null; +static int linecount = 0; /* global: number of lines received via nupa_copy */ +static int evalcount = 0; /* number of lines through nupa_eval() */ +static int nblog = 0; /* serial number of (debug) logfile */ +static unsigned char inexpansion = 0; /* flag subckt expansion phase */ +static unsigned char incontrol = 0; /* flag control code sections */ +static unsigned char dologfile = 0; /* for debugging */ +static unsigned char firstsignal = 1; +static FILE *logfile = NULL; +static tdico *dico = NULL; /* already part of dico : */ /* Str(80, srcfile); source file */ -/* Darray(refptr, Pchar, Maxline) pointers to source code lines */ +/* Darray(refptr, char *, Maxline) pointers to source code lines */ /* Darray(category, char, Maxline) category of each line */ /* @@ -373,310 +461,388 @@ Intern tdico * dico=Null; takes no action if logging is disabled. Open the log if not already open. */ -Intern -Proc putlogfile(char c, int num, Pchar t) -Begin - Strbig(Llen, u); - Str(20,fname); - If dologfile Then - If(logfile == Null) Then - scopy(fname,"logfile."); - Inc(nblog); nadd(fname,nblog); - logfile=fopen(fname, "w"); - EndIf - If(logfile != Null) Then - cadd(u,c); nadd(u,num); - cadd(u,':'); cadd(u,' '); - sadd(u,t); cadd(u,'\n'); - fputs(u,logfile); - EndIf - EndIf -EndProc +static void +putlogfile (char c, int num, char *t) +{ + Strbig (Llen, u); + Str (20, fname); -Intern -Proc nupa_init( Pchar srcfile) -Begin - 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; irefptr[i]= Null; - dico->category[i]='?'; - Done - Sini(dico->srcfile); - If srcfile != Null Then scopy(dico->srcfile, srcfile) EndIf -EndProc + if (dologfile) + { + if ((logfile == NULL)) + { + scopy (fname, "logfile."); + nblog++; + nadd (fname, nblog); + logfile = fopen (fname, "w"); + } -Intern -Proc nupa_done(void) -Begin + if ((logfile != NULL)) + { + cadd (u, c); + nadd (u, num); + cadd (u, ':'); + cadd (u, ' '); + sadd (u, t); + cadd (u, '\n'); + fputs (u, logfile); + } + } +} + +static void +nupa_init (char *srcfile) +{ int i; - Str(80,rep); + /* init the symbol table and so on, before the first nupa_copy. */ + evalcount = 0; + linecount = 0; + incontrol = 0; + placeholder = 0; + dico = (tdico *)new(sizeof(tdico)); + inst_dico = (tdico *)new(sizeof(tdico)); + initdico (dico); + initdico (inst_dico); + + for (i = 0; i < Maxline; i++) + { + dico->refptr[i] = NULL; + dico->category[i] = '?'; + } + sini (dico->srcfile, sizeof (dico->srcfile) - 4); + + if (srcfile != NULL) + scopy (dico->srcfile, srcfile); +} + +static void +nupa_done (void) +{ + int i; + Str (80, rep); int dictsize, nerrors; - If logfile != Null Then - fclose(logfile); - logfile=Null; - EndIf - nerrors= dico->errcount; - dictsize= donedico(dico); - For i=Maxline-1; i>=0; Dec(i) Do - Dispose( dico->refptr[i]) - Done - Dispose(dico); - dico= Null; - If NotZ(nerrors) Then - /* debug: ask if spice run really wanted */ - scopy(rep," Copies="); nadd(rep,linecount); - sadd(rep," Evals="); nadd(rep,evalcount); - sadd(rep," Placeholders="); nadd(rep,placeholder); - sadd(rep," Symbols="); nadd(rep,dictsize); - sadd(rep," Errors="); nadd(rep,nerrors); - cadd(rep,'\n'); ws(rep); - ws("Numparam expansion errors: Run Spice anyway? y/n ? \n"); - rs(rep); - If upcase(rep[0]) != 'Y' Then exit(-1) EndIf - EndIf - linecount= 0; - evalcount= 0; - placeholder= 0; - /* release symbol table data */ -EndProc - + + if (logfile != NULL) + { + fclose (logfile); + logfile = NULL; + } + nerrors = dico->errcount; + dictsize = donedico (dico); + + for (i = Maxline - 1; i >= 0; i--) + dispose ((void *) dico->refptr[i]); + + dispose ((void *) dico); + dico = NULL; + if (nerrors) + { + /* debug: ask if spice run really wanted */ + scopy (rep, " Copies="); + nadd (rep, linecount); + sadd (rep, " Evals="); + nadd (rep, evalcount); + sadd (rep, " Placeholders="); + nadd (rep, placeholder); + sadd (rep, " Symbols="); + nadd (rep, dictsize); + sadd (rep, " Errors="); + nadd (rep, nerrors); + cadd (rep, '\n'); + ws (rep); + ws ("Numparam expansion errors: Run Spice anyway? y/n ? \n"); + rs (rep); + if (upcase (rep[0]) != 'Y') + exit (-1); + } + + linecount = 0; + evalcount = 0; + placeholder = 0; + /* release symbol table data */ ; +} + /* SJB - Scan the line for subcircuits */ -Proc nupa_scan(Pchar s, int linenum, int is_subckt) -Begin +void +nupa_scan (char *s, int linenum, int is_subckt) +{ - if ( is_subckt ) defsubckt( dico, s, linenum, 'U' ); - else defsubckt( dico, s, linenum, 'O' ); + if (is_subckt) + defsubckt (dico, s, linenum, 'U'); + else + defsubckt (dico, s, linenum, 'O'); -EndProc +} -static char* -lower_str( char *str ) { +static char * +lower_str (char *str) +{ char *s; - for ( s = str; *s; s++ ) *s = tolower(*s); + for (s = str; *s; s++) + *s = tolower (*s); return str; } -static char* -upper_str( char *str ) { +static char * +upper_str (char *str) +{ char *s; - for ( s = str; *s; s++ ) *s = toupper(*s); + for (s = str; *s; s++) + *s = toupper (*s); return str; } void -nupa_list_params(FILE *cp_out) { +nupa_list_params (FILE * cp_out) +{ char *name; - int i; + 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); + 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)); +nupa_get_param (char *param_name, int *found) +{ + char *name = upper_str (strdup (param_name)); double result = 0; - int i; + 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; + 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); + 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' ); +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].vl = value; + dico->dat[i].tp = 'R'; + dico->dat[i].ivl = 0; dico->dat[i].sbbase = NULL; - txfree(up_name); + 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' ); +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].vl = value; + inst_dico->dat[i].tp = 'R'; + inst_dico->dat[i].ivl = 0; inst_dico->dat[i].sbbase = NULL; - txfree( up_name ); + txfree (up_name); } void -nupa_copy_inst_dico() { +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 ); - } + 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) +char * +nupa_copy (char *s, int linenum) /* returns a copy (not quite) of s in freshly allocated memory. linenum, for info only, is the source line number. origin pointer s is kept, memory is freed later in nupa_done. must abort all Spice if malloc() fails. - Is called for the first time sequentially for all spice deck lines. - Is then called again for all X invocation lines, top-down for + :{ called for the first time sequentially for all spice deck lines. + :{ then called again for all X invocation lines, top-down for subckts defined at the outer level, but bottom-up for local subcircuit expansion, but has no effect in that phase. we steal a copy of the source line pointer. - comment-out a .param or & line - substitute placeholders for all {..} --> 10-digit numeric values. */ -Begin - Strbig(Llen,u); - Strbig(Llen,keywd); - Pchar t; - int ls; - char c,d; +{ + Strbig (Llen, u); + Strbig (Llen, keywd); + char *t; + int ls; + char c, d; + ls = length (s); - 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 */ - dico->srcline= linenum; - If (Not inexpansion) And (linenum >=0) And (linenumrefptr[linenum]= s; - c= transform(dico, u, incontrol, keywd); - If c=='C' Then - incontrol=True - ElsIf c=='E' Then - incontrol=False - EndIf - 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 - fprintf(stderr," Numparam warning: overwriting P,S or X line (linenum == %d).\n", linenum); - EndIf - dico->category[linenum]= c; - EndIf /* keep a local copy and mangle the string */ - ls=length(u); - t = strdup(u); - If t==NULL Then - fputs("Fatal: String malloc crash in nupa_copy()\n", stderr); - exit(-1) - Else - If Not inexpansion Then - putlogfile(dico->category[linenum],linenum,t) - EndIf; - EndIf - return t -EndFunc + while ((ls > 0) && (s[ls - 1] <= ' ')) + ls--; -Func int nupa_eval(Pchar s, int linenum) + pscopy (u, s, 1, ls); /* strip trailing space, CrLf and so on */ + dico->srcline = linenum; + + if ((!inexpansion) && (linenum >= 0) && (linenum < Maxline)) + { + linecount++; + dico->refptr[linenum] = s; + c = transform (dico, u, incontrol, keywd); + if (c == 'C') + incontrol = 1; + else if (c == 'E') + incontrol = 0; + + if (incontrol) + c = 'C'; /* force it */ + + d = dico->category[linenum]; /* warning if already some strategic line! */ + + if ((d == 'P') || (d == 'S') || (d == 'X')) + fprintf (stderr, + " Numparam warning: overwriting P,S or X line (linenum == %d).\n", + linenum); + + dico->category[linenum] = c; + } /* keep a local copy and mangle the string */ + + ls = length (u); + t = strdup (u); + + if (t == NULL) + { + fputs ("Fatal: String malloc crash in nupa_copy()\n", stderr); + exit (-1); + } + else + { + if (!inexpansion) + { + putlogfile (dico->category[linenum], linenum, t); + }; + } + return t; +} + +int +nupa_eval (char *s, int linenum) /* s points to a partially transformed line. compute variables if linenum points to a & or .param line. - If the original is an X line, compute actual params. - Else substitute any &(expr) with the current values. + if ( the original is an X line, compute actual params.; + } else { substitute any &(expr) with the current values. All the X lines are preserved (commented out) in the expanded circuit. */ -Begin - int idef; /* subckt definition line */ - char c, keep, *ptr; - int i; - Str(80,subname); - Bool err = True; +{ + int idef; /* subckt definition line */ + char c, keep, *ptr; + int i; + Str (80, subname); + unsigned char err = 1; - dico->srcline= linenum; - c= dico->category[linenum]; + dico->srcline = linenum; + c = dico->category[linenum]; #ifdef TRACE_NUMPARAMS - 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 */ - 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, - dico->refptr[idef], dico->refptr[linenum], False); - Else - putlogfile('?',linenum, " illegal subckt call."); - EndIf - ElsIf c=='U' Then /* release local symbols = parameters */ - nupa_subcktexit( dico); - EndIf - 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(); + 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 ( err ) return 0; - else return 1; -EndFunc + if (c == 'P') /* evaluate parameters */ + nupa_assignment (dico, dico->refptr[linenum], 'N'); + else if (c == 'B') /* substitute braces line */ + err = nupa_substitute (dico, dico->refptr[linenum], s, 0); + else if (c == 'X') + { /* 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; -Func int nupa_signal(int sig, Pchar info) + 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) + nupa_subcktcall (dico, dico->refptr[idef], dico->refptr[linenum], 0); + else + putlogfile ('?', linenum, " illegal subckt call."); + } + else if (c == 'U') /* release local symbols = parameters */ + nupa_subcktexit (dico); + + putlogfile ('e', linenum, s); + 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 */ + if (err) + return 0; + else + return 1; +} + +int +nupa_signal (int sig, char *info) /* warning: deckcopy may come inside a recursion ! substart no! */ /* info is context-dependent string data */ -Begin - putlogfile('!',sig, " Nupa Signal"); - If sig == NUPADECKCOPY Then - If firstsignal Then - nupa_init(info); - firstsignal=False; - EndIf - ElsIf sig == NUPASUBSTART Then - inexpansion=True - ElsIf sig == NUPASUBDONE Then - inexpansion=False; - nupa_inst_name = NULL; - ElsIf sig == NUPAEVALDONE Then - nupa_done(); - firstsignal=True - EndIf - return 1 -EndFunc +{ + putlogfile ('!', sig, " Nupa Signal"); + if (sig == NUPADECKCOPY) + { + if (firstsignal) + { + nupa_init (info); + firstsignal = 0; + } + } + else if (sig == NUPASUBSTART) + inexpansion = 1; + else if (sig == NUPASUBDONE) + { + inexpansion = 0; + nupa_inst_name = NULL; + } + else if (sig == NUPAEVALDONE) + { + nupa_done (); + firstsignal = 1; + } + return 1; +} #ifdef USING_NUPATEST /* This is use only by the nupatest program */ -Func tdico * nupa_fetchinstance(void) -Begin - return dico -EndFunc +tdico * +nupa_fetchinstance (void) +{ + return dico; +} #endif /* USING_NUPATEST */ diff --git a/src/frontend/numparam/washprog.c b/src/frontend/numparam/washprog.c index 832a9bd0b..455fffd4e 100644 --- a/src/frontend/numparam/washprog.c +++ b/src/frontend/numparam/washprog.c @@ -49,7 +49,7 @@ Format of substitution rules: #include /* NULL FILE fopen feof fgets fclose fputs fputc gets */ #include "general.h" - +Cconst(Llen, 15000) Cconst(nsub, 100+1) /*max nbr of substitution rules */ Cconst(nargs, 11) /*max number of macro args + 1*/ Cconst(wild,'æ') /* wildcard character in patterns */ @@ -254,18 +254,18 @@ Begin return ok EndFunc -Func int posi(Pchar sub, Pchar s) -Begin /*re-defines Turbo Pos, result Pascal compatible */ +/* Func int posi(Pchar sub, Pchar s) +Begin re-defines Turbo Pos, result Pascal compatible int a,b,k; Bool ok; -/*-StartProc-*/ + -StartProc- ok=False; a=length(sub); b=(int)(length(s)-a); k=0; - If a>0 Then /*Else return 0*/ + If a>0 Then Else return 0 While (k<=b) And (Not ok) Do - ok=match(sub,s, a,k); /*remark we must start at k=0 ! */ + ok=match(sub,s, a,k); remark we must start at k=0 ! Inc(k); Done EndIf @@ -274,7 +274,7 @@ Begin /*re-defines Turbo Pos, result Pascal compatible */ Else return 0 EndIf -EndFunc +EndFunc */ Func int matchwhite(Pchar s, Pchar t, int n, int tstart) Begin diff --git a/src/frontend/numparam/xpressn.c b/src/frontend/numparam/xpressn.c index 53d58f2d8..2bb765b73 100644 --- a/src/frontend/numparam/xpressn.c +++ b/src/frontend/numparam/xpressn.c @@ -4,7 +4,7 @@ * Free software under the terms of the GNU Lesser General Public License */ -#include /* for function message() only. */ +#include /* for function message() only. */ #include #include @@ -14,298 +14,364 @@ /************ 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 Str (150, keys); /* all my keywords */ +static Str (150, fmath); /* all math functions */ static double -max( double x, double y ) +max (double x, double y) { - return ( x > y ) ? x : y; + return (x > y) ? x : y; } static double -min( double x, double y ) +min (double x, double y) { - return ( x < y ) ? x : y; + return (x < y) ? x : y; } static double -ternary_fcn( int conditional, double if_value, double else_value ) +ternary_fcn (int conditional, double if_value, double else_value) { - if ( conditional ) return if_value; - else return else_value; + if (conditional) + return if_value; + else + return else_value; } static double -agauss( double nominal_val, double variation, double sigma ) +agauss (double nominal_val, double variation, double sigma) { /* just a placeholder */ return nominal_val; } -Intern -Proc initkeys(void) +static void +initkeys (void) /* the list of reserved words */ -Begin - scopy_up(keys, - "and or not div mod if else end while macro funct defined" - " include for to downto is var"); - scopy_up(fmath, "sqr sqrt sin cos exp ln arctan abs pow pwr max min int log ternary_fcn agauss"); -EndProc +{ + scopy_up (keys, + "and or not div mod if else end while macro funct defined" + " include for to downto is var"); + scopy_up (fmath, + "sqr sqrt sin cos exp ln arctan abs pow pwr max min int log ternary_fcn agauss"); +} -Intern -Func double mathfunction(int f, double z, double x) +static double +mathfunction (int f, double z, double x) /* the list of built-in functions. Patch 'fmath', here and near line 888 to get more ...*/ -Begin +{ double y; - Switch f - CaseOne 1 Is y = x*x - Case 2 Is y = sqrt(x) - Case 3 Is y = sin(x) - Case 4 Is y = cos(x) - Case 5 Is y = exp(x) - Case 6 Is y = ln(x) - Case 7 Is y = atan(x) - Case 8 Is y = fabs(x) - Case 9 Is y = pow(z,x) - Case 10 Is y = exp(x*ln(fabs(z))) - Case 11 Is y = max(x,z) - Case 12 Is y = min(x,z) - Case 13 Is y = trunc(x) - Case 14 Is y = log(x) - Default y=x EndSw - return y -EndFunc + switch (f) { + case 1: + y = x * x; + break; + case 2: + y = sqrt (x); + break; + case 3: + y = sin (x); + break; + case 4: + y = cos (x); + break; + case 5: + y = exp (x); + break; + case 6: + y = ln (x); + break; + case 7: + y = atan (x); + break; + case 8: + y = fabs (x); + break; + case 9: + y = pow (z, x); + break; + case 10: + y = exp (x * ln (fabs (z))); + break; + case 11: + y = max (x, z); + break; + case 12: + y = min (x, z); + break; + case 13: + y = trunc (x); + break; + case 14: + y = log (x); + break; + default: + y = x; + break; + } + return y; +} -Cconst(Defd,12) +typedef enum {Defd=12} _nDefd; /* serial numb. of 'defined' keyword. The others are not used (yet) */ - -Intern -Func Bool message( tdico * dic, Pchar s) + static unsigned char message (tdico * dic, char *s) /* record 'dic' should know about source file and line */ -Begin - Strbig(Llen,t); - Inc( dic->errcount); - If (dic->srcfile != Null) And NotZ(dic->srcfile[0]) Then - scopy(t, dic->srcfile); cadd(t,':') - EndIf - If dic->srcline >=0 Then - nadd(t,dic->srcline); sadd(t,": "); - EndIf - sadd(t,s); cadd(t,'\n'); - fputs(t,stderr); - return True /*error!*/ -EndFunc +{ + Strbig (Llen, t); + dic->errcount++; + if ((dic->srcfile != NULL) && dic->srcfile[0]) + { + scopy (t, dic->srcfile); + cadd (t, ':'); + } + if (dic->srcline >= 0) + { + nadd (t, dic->srcline); + sadd (t, ": "); + } + sadd (t, s); + cadd (t, '\n'); + fputs (t, stderr); -Proc debugwarn( tdico *d, Pchar s) -Begin - message(d,s); - Dec( d->errcount) -EndProc + return 1 /*error! */ ; +} + +void +debugwarn (tdico * d, char *s) +{ + message (d, s); + d->errcount--; +} /************* historical: stubs for nodetable manager ************/ /* in the full preprocessor version there was a node translator for spice2 */ -Intern -Proc initsymbols(auxtable * n) -Begin -EndProc +static void +initsymbols (auxtable * n) +{; +} -Intern -Proc donesymbols(auxtable * n) -Begin -EndProc +static void +donesymbols (auxtable * n) +{; +} -/* Intern -Func int parsenode(auxtable *n, Pchar s) -Begin - return 0 -EndFunc +/* static + int parsenode(auxtable *n, char * s) +{ + return 0; +} */ /************ the input text symbol table (dictionary) *************/ -Proc initdico(tdico * dico) -Begin +void +initdico (tdico * dico) +{ 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,100) - Done - dico->tos= 0; - dico->stack[dico->tos]= 0; /* global data beneath */ - initsymbols(Addr(dico->nodetab)); - initkeys(); -EndProc + dico->nbd = 0; + sini(dico->option,sizeof(dico->option)-4); + sini(dico->srcfile,sizeof(dico->srcfile)-4); + dico->srcline = -1; + dico->errcount = 0; + + for (i = 0; i <= Maxdico; i++) + sini (dico->dat[i].nom, 100); + + dico->tos = 0; + dico->stack[dico->tos] = 0; /* global data beneath */ + initsymbols (&dico->nodetab); + initkeys (); +} /* local semantics for parameters inside a subckt */ -/* arguments as wll as .param expressions */ +/* arguments as wll as .param expressions */ /* to do: scope semantics ? "params:" and all new symbols should have local scope inside subcircuits. redefinition of old symbols gives a warning message. */ -Cconst(Push,'u') -Cconst(Pop, 'o') +typedef enum {Push='u'} _nPush; +typedef enum {Pop='o'} _nPop; -Intern -Proc dicostack(tdico *dico, char op) + static void + 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; + 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 - c= dico->dat[i].tp; - If ((c=='R') Or (c=='S')) And (dico->dat[i].level == dico->tos) Then - dico->dat[i].tp= '?' - EndIf - 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]; + if (op == Push) + { + if (dico->tos < (20 - 1)) + dico->tos++; + else + message (dico, " Subckt Stack overflow"); - 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->stack[dico->tos] = dico->nbd; + dico->inst_name[dico->tos] = nupa_inst_name; + } + else if (op == Pop) + { + /* obsolete: undefine all data items of level dico->tos + for ( i=dico->nbd; i>0; i--) ) { + c= dico->dat[i].tp; + if ( ((c=='R') || (c=='S')) && (dico->dat[i].level == dico->tos) ) { + dico->dat[i].tp= '?'; + } + } + */ + if (dico->tos > 0) + { + // keep instance parameters around + current_stack_size = dico->nbd; + old_stack_size = dico->stack[dico->tos]; + inst_name = dico->inst_name[dico->tos]; - dico->nbd= dico->stack[dico->tos]; /* simply kill all local items */ - Dec(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); - Else message(dico," Subckt Stack underflow.") - EndIf - EndIf -EndProc + dico->nbd = dico->stack[dico->tos]; /* simply kill all local items */ + dico->tos--; -Func int donedico(tdico * dico) -Begin - int sze= dico->nbd; - donesymbols(Addr(dico->nodetab)); + } + else + { + message (dico, " Subckt Stack underflow."); + } + } +} + +int +donedico (tdico * dico) +{ + int sze = dico->nbd; + donesymbols (&dico->nodetab); return sze; -EndProc +} -Intern -Func int entrynb( tdico * d, Pchar s) +static int +entrynb (tdico * d, char *s) /* symbol lookup from end to start, for stacked local symbols .*/ /* bug: sometimes we need access to same-name symbol, at lower level? */ -Begin +{ int i; - Bool ok; - ok=False; - i=d->nbd+1; + unsigned char ok; + ok = 0; + i = d->nbd + 1; - While (Not ok) And (i>1) Do - Dec(i); - ok= steq(d->dat[i].nom, s); - Done - If Not ok Then - return 0 - Else - return i - EndIf -EndFunc + while ((!ok) && (i > 1)) + { + i--; + ok = steq (d->dat[i].nom, s); + } + if (!ok) + return 0; + else + return i; +} -Func char getidtype( tdico *d, Pchar s) +char +getidtype (tdico * d, char *s) /* test if identifier s is known. Answer its type, or '?' if not in list */ -Begin - char itp='?'; /* assume unknown */ - int i= entrynb(d, s); - If i >0 Then itp= d->dat[i].tp EndIf - return itp -EndFunc +{ + char itp = '?'; /* assume unknown */ + int i = entrynb (d, s); -Intern -Func double fetchnumentry( - tdico * dico, - Pchar t, - Bool * perr) -Begin - Bool err= *perr; - Word k; + if (i > 0) + itp = d->dat[i].tp; + + return itp; +} + +static double +fetchnumentry (tdico * dico, char *t, unsigned char *perr) +{ + unsigned char err = *perr; + unsigned short k; double u; - Strbig(Llen, s); - k=entrynb(dico,t); /*no keyword*/ - /*dbg -- If k<=0 Then ws("Dico num lookup fails. ") EndIf */ - While (k>0) And (dico->dat[k].tp=='P') Do - k= dico->dat[k].ivl - Done /*pointer chain*/ - If k>0 Then - If dico->dat[k].tp!='R' Then k=0 EndIf - EndIf - If k>0 Then - u=dico->dat[k].vl - Else - u=0.0; - scopy(s,"Undefined number ["); sadd(s,t); cadd(s,']'); - err=message( dico, s); + Strbig (Llen, s); + k = entrynb (dico, t); /*no keyword */ + /*dbg -- if ( k<=0 ) { ws("Dico num lookup fails. ") ;} */ - EndIf - *perr= err; - return u -EndFunc + while ((k > 0) && (dico->dat[k].tp == 'P')) + k = dico->dat[k].ivl; /*pointer chain */ + + if (k > 0) + if (dico->dat[k].tp != 'R') + k = 0; + + if (k > 0) + u = dico->dat[k].vl; + else + { + u = 0.0; + scopy (s, "Undefined number ["); + sadd (s, t); + cadd (s, ']'); + err = message (dico, s); + } + + *perr = err; + + return u; +} /******* writing dictionary entries *********/ -Func int attrib( tdico * dico, Pchar t, char op) -Begin +int +attrib (tdico * dico, char *t, char op) +{ /* seek or attribute dico entry number for string t. Option op='N' : force a new entry, if tos>level and old is valid. */ int i; - Bool ok; - i=dico->nbd+1; - ok=False; - While (Not ok) And (i>1) Do /*search old*/ - Dec(i); - ok= steq(dico->dat[i].nom,t); - Done - If ok And (op=='N') - And ( dico->dat[i].level < dico->tos) - And ( dico->dat[i].tp != '?') - Then ok=False EndIf - If Not ok Then - Inc(dico->nbd); - i= dico->nbd; - If dico->nbd > Maxdico Then - i=0 - Else - scopy(dico->dat[i].nom,t); - dico->dat[i].tp='?'; /*signal Unknown*/ - dico->dat[i].level= dico->tos; - EndIf - EndIf - return i -EndFunc + unsigned char ok; + i = dico->nbd + 1; + ok = 0; + while ((!ok) && (i > 1)) + { /*search old */ + i--; + ok = steq (dico->dat[i].nom, t); + } -Intern -Func Bool define( - tdico * dico, - Pchar t, /* identifier to define */ - char op, /* option */ - char tpe, /* type marker */ - double z, /* float value if any */ - Word w, /* integer value if any */ - Pchar base) /* string pointer if any */ -Begin + if (ok && (op == 'N') + && (dico->dat[i].level < dico->tos) && (dico->dat[i].tp != '?')) + { + ok = 0; + } + + if (!ok) + { + dico->nbd++; + i = dico->nbd; + + if (dico->nbd > Maxdico) + i = 0; + else + { + scopy (dico->dat[i].nom, t); + dico->dat[i].tp = '?'; /*signal Unknown */ + dico->dat[i].level = dico->tos; + } + } + return i; +} + +static unsigned char +define (tdico * dico, char *t, /* identifier to define */ + char op, /* option */ + char tpe, /* type marker */ + double z, /* float value if any */ + unsigned short w, /* integer value if any */ + char *base) /* string pointer if any */ +{ /*define t as real or integer, opcode= 'N' impose a new item under local conditions. check for pointers, too, in full macrolanguage version: @@ -316,1327 +382,1781 @@ Begin */ int i; char c; - Bool err, warn; - Strbig(Llen,v); - i=attrib(dico,t,op); - err=False; - If i<=0 Then - err=message( dico," Symbol table overflow") - Else - If dico->dat[i].tp=='P' Then - i= dico->dat[i].ivl - EndIf; /*pointer indirection*/ - If i>0 Then - c=dico->dat[i].tp - Else - c=' ' - EndIf + unsigned char err, warn; + Strbig (Llen, v); + i = attrib (dico, t, op); + err = 0; + if (i <= 0) + err = message (dico, " Symbol table overflow"); + else + { + if (dico->dat[i].tp == 'P') + i = dico->dat[i].ivl; /*pointer indirection */ - If (c=='R') Or (c=='S') Or (c=='?') Then - dico->dat[i].vl=z; - dico->dat[i].tp=tpe; - dico->dat[i].ivl=w; - dico->dat[i].sbbase= base; - /* If (c !='?') And (i<= dico->stack[dico->tos]) Then */ - If c=='?' Then - dico->dat[i].level= dico->tos - EndIf /* promote! */ - If dico->dat[i].level < dico->tos Then - /* warn about re-write to a global scope! */ - scopy(v,t); cadd(v,':'); - nadd(v,dico->dat[i].level); - sadd(v," overwritten."); - warn=message( dico,v); - EndIf - Else - scopy(v,t); - sadd(v,": cannot redefine"); - err=message( dico,v); - EndIf - EndIf + if (i > 0) + c = dico->dat[i].tp; + else + c = ' '; + + if ((c == 'R') || (c == 'S') || (c == '?')) + { + dico->dat[i].vl = z; + dico->dat[i].tp = tpe; + dico->dat[i].ivl = w; + dico->dat[i].sbbase = base; + /* if ( (c !='?') && (i<= dico->stack[dico->tos]) ) { */ + + if (c == '?') + dico->dat[i].level = dico->tos; /* promote! */ + + if (dico->dat[i].level < dico->tos) + { + /* warn about re-write to a global scope! */ + scopy (v, t); + cadd (v, ':'); + nadd (v, dico->dat[i].level); + sadd (v, " overwritten."); + warn = message (dico, v); + } + } + else + { + scopy (v, t); + sadd (v, ": cannot redefine"); + err = message (dico, v); + } + } return err; -EndFunc +} -Func Bool defsubckt(tdico *dico, Pchar s, Word w, char categ) +unsigned char +defsubckt (tdico * dico, char *s, unsigned short w, char categ) /* called on 1st pass of spice source code, to enter subcircuit (categ=U) and model (categ=O) names */ -Begin - Str(80,u); - Bool err; - int i,j,ls; - ls=length(s); - i=0; - While (i' ') Do Inc(i) Done - While (i' ') Do Inc(j) Done - 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."); - EndIf - return err -EndFunc +{ + Str (80, u); + unsigned char err; + int i, j, ls; + ls = length (s); + i = 0; -Func int findsubckt( tdico *dico, Pchar s, Pchar subname) + while ((i < ls) && (s[i] != '.')) + i++; /* skip 1st dotword */ + + while ((i < ls) && (s[i] > ' ')) + i++; + + while ((i < ls) && (s[i] <= ' ')) + i++; /* skip blank */ + + j = i; + + while ((j < ls) && (s[j] > ' ')) + j++; + + if ((j > i)) + { + 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."); + + return err; +} + +int +findsubckt (tdico * dico, char *s, char *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 */ - 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_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); - Else - i= 0; - scopy(subname,""); - message(dico, "Cannot find subcircuit."); - EndIf - return i -EndFunc +{ + Str (80, u); /* u= subckt name is last token in string s */ + int i, j, k; + k = length (s); -#if 0 /* unused, from the full macro language... */ -Intern -Func int deffuma( /* define function or macro entry. */ - tdico * dico, Pchar t, char tpe, Word bufstart, - Bool * pjumped, Bool * perr) -Begin - Bool jumped= *pjumped; Bool err= *perr; + while ((k >= 0) && (s[k] <= ' ')) + k--; + + j = k; + + while ((k >= 0) && (s[k] > ' ')) + k--; + + pscopy_up (u, s, k + 2, j - k); + i = entrynb (dico, u); + + if ((i > 0) && (dico->dat[i].tp == 'U')) + { + i = dico->dat[i].ivl; + scopy (subname, u); + } + else + { + i = 0; + scopy (subname, ""); + message (dico, "Cannot find subcircuit."); + } + + return i; +} + +#if 0 /* unused, from the full macro language... */ +static int +deffuma ( /* define function or macro entry. */ + tdico * dico, char *t, char tpe, unsigned short bufstart, + unsigned char *pjumped, unsigned char *perr) +{ + unsigned char jumped = *pjumped; + unsigned char err = *perr; /* if not jumped, define new function or macro, returns index to buffferstart if jumped, return index to existing function */ - int i,j; - Strbig(Llen, v); - i=attrib(dico,t,' '); j=0; - If i<=0 Then - err=message( dico," Symbol table overflow") - Else - If dico->dat[i].tp != '?' Then /*old item!*/ - If jumped Then - j=dico->dat[i].ivl - Else - scopy(v,t); sadd(v," already defined"); - err=message( dico,v) - EndIf - Else - dico->dat[i].tp=tpe; - Inc(dico->nfms); j=dico->nfms; - dico->dat[i].ivl=j; - dico->fms[j].start= bufstart; /* =ibf->bufaddr = start addr in buffer */ - EndIf - EndIf - *pjumped= jumped; - *perr= err; + int i, j; + Strbig (Llen, v); + i = attrib (dico, t, ' '); + j = 0; + if (i <= 0) + { + err = message (dico, " Symbol table overflow"); + } + else + { + if (dico->dat[i].tp != '?') + { /*old item! */ + if (jumped) + { + j = dico->dat[i].ivl; + } + else + { + scopy (v, t); + sadd (v, " already defined"); + err = message (dico, v); + } + } + else + { + dico->dat[i].tp = tpe; + dico->nfms++; + j = dico->nfms; + dico->dat[i].ivl = j; + dico->fms[j].start = bufstart; + /* =ibf->bufaddr = start addr in buffer */ ; + } + } + *pjumped = jumped; + *perr = err; return j; -EndFunc +} #endif /************ input scanner stuff **************/ -Intern -Func Byte keyword( Pchar keys, Pchar t) -Begin +static unsigned char +keyword (char *keys, char *t) +{ /* return 0 if t not found in list keys, else the ordinal number */ - Byte i,j,k; - int lt,lk; - Bool ok; - lt=length(t); - lk=length(keys); - k=0; j=0; - Repeat - Inc(j); - i=0; ok=True; - Repeat - Inc(i); Inc(k); - ok= (k<=lk) And (t[i-1]==keys[k-1]); - Until (Not ok) Or (i>=lt) EndRep - If ok Then - ok=(k==lk) Or (keys[k]<=' ') - EndIf - If Not ok And (k' ') Do Inc(k) Done - EndIf - Until ok Or (k>=lk) EndRep - If ok Then - return j - Else - return 0 - EndIf -EndFunc + unsigned char i, j, k; + int lt, lk; + unsigned char ok; + lt = length (t); + lk = length (keys); + k = 0; + j = 0; -Intern -Func double parseunit( double x, Pchar s) + do { + j++; + i = 0; + ok = 1; + + do{ + i++; + k++; + ok = (k <= lk) && (t[i - 1] == keys[k - 1]); + } while (!((!ok) || (i >= lt))); + + if (ok) + ok = (k == lk) || (keys[k] <= ' '); + + if (!ok && (k < lk)) /*skip to next item */ + while ((k <= lk) && (keys[k - 1] > ' ')) + k++; + } while (!(ok || (k >= lk))); + + if (ok) + return j; + else + return 0; +} + +static double +parseunit (double x, char *s) /* the Spice suffixes */ -Begin +{ double u = 0; - Str(20, t); - Bool isunit; - isunit=True; - pscopy(t,s,1,3); - If steq(t,"MEG") Then - u=1e6 - ElsIf s[0]=='G' Then - u=1e9 - ElsIf s[0]=='K' Then - u=1e3 - ElsIf s[0]=='M' Then - u=0.001 - ElsIf s[0]=='U' Then - u=1e-6 - ElsIf s[0]=='N' Then - u=1e-9 - ElsIf s[0]=='P' Then - u=1e-12 - ElsIf s[0]=='F' Then - u=1e-15 - Else - isunit=False - EndIf - If isunit Then x=x*u EndIf - return x -EndFunc + Str (20, t); + unsigned char isunit; + isunit = 1; + pscopy (t, s, 1, 3); -Intern -Func int fetchid( - Pchar s, Pchar t, - int ls, int i) + if (steq (t, "MEG")) + u = 1e6; + else if (s[0] == 'G') + u = 1e9; + else if (s[0] == 'K') + u = 1e3; + else if (s[0] == 'M') + u = 0.001; + else if (s[0] == 'U') + u = 1e-6; + else if (s[0] == 'N') + u = 1e-9; + else if (s[0] == 'P') + u = 1e-12; + else if (s[0] == 'F') + u = 1e-15; + else + isunit = 0; + + if (isunit) + x = x * u; + + return x; +} + +static int +fetchid (char *s, char *t, int ls, int i) /* copy next identifier from s into t, advance and return scan index i */ -Begin +{ char c; - Bool ok; - c=s[i-1]; - While (Not alfa(c)) And (ils Then - c=Nul - Else - c=s[i-1] - EndIf; - ok= (c=='(') - Until ok Or (c==Nul) EndRep - If ok Then - i=fetchid(s,t, ls,i); Dec(i); - If entrynb(d,t)>0 Then x=1.0 EndIf - Repeat - Inc(i); - If i>ls Then - c=Nul - Else - c=s[i-1] - EndIf - ok= (c==')') - Until ok Or (c==Nul) EndRep - EndIf - If Not ok Then - error=message( d," Defined() syntax"); - EndIf /*keep pointer on last closing ")" */ - *perror= error; - *pi=i; + unsigned char ok; + Strbig (Llen, t); + ls = length (s); + x = 0.0; + + do { + i++; + if (i > ls) + c = Nul; + else + c = s[i - 1]; + + ok = (c == '('); + } while (!(ok || (c == Nul))); + + if (ok) + { + i = fetchid (s, t, ls, i); + i--; + if (entrynb (d, t) > 0) + x = 1.0; + + do { + i++; + + if (i > ls) + c = Nul; + else + c = s[i - 1]; + + ok = (c == ')'); + } while (!(ok || (c == Nul))); + } + if (!ok) + error = message (d, " Defined() syntax"); + +/*keep pointer on last closing ")" */ + + *perror = error; + *pi = i; return x; -EndFunc +} -Intern -Func double fetchnumber( tdico *dico, - Pchar s, int ls, - int * pi, - Bool * perror) +static double +fetchnumber (tdico * dico, char *s, int ls, int *pi, unsigned char *perror) /* parse a Spice number in string s */ -Begin - Bool error= *perror; - int i= *pi; - int k,err; +{ + unsigned char error = *perror; + int i = *pi; + int k, err; char d; - Str(20, t); - Strbig(Llen, v); + Str (20, t); + Strbig (Llen, v); double u; - k=i; - Repeat - Inc(k); - If k>ls Then - d=chr(0) - Else - d=s[k-1] - EndIf - Until Not ((d=='.') Or ((d>='0') And (d<='9'))) EndRep - If (d=='e') Or (d=='E') Then /*exponent follows*/ - Inc(k); d=s[k-1]; - If (d=='+') Or (d=='-') Then Inc(k) EndIf - Repeat - Inc(k); - If k>ls Then - d=chr(0) - Else - d=s[k-1] - EndIf - Until Not ((d>='0') And (d<='9')) EndRep - EndIf - pscopy(t,s,i, k-i); - If t[0]=='.' Then - cins(t,'0') - ElsIf t[length(t)-1]=='.' Then - cadd(t,'0') - EndIf - u= rval(t, Addr(err)); - If err!=0 Then - scopy(v,"Number format error: "); - sadd(v,t); - error=message( dico,v) - Else - scopy(t,""); - While alfa(d) Do - cadd(t,upcase(d)); - Inc(k); - If k>ls Then - d=Nul - Else - d=s[k-1] - EndIf - Done - u=parseunit(u,t); - EndIf - i=k-1; - *perror= error; - *pi=i; - return u; -EndFunc + k = i; -Intern -Func char fetchoperator( tdico *dico, - Pchar s, int ls, - int * pi, - Byte * pstate, Byte * plevel, - Bool * perror) + do { + k++; + if (k > ls) + d = (char)(0); + else + d = s[k - 1]; + } while (!(!((d == '.') || ((d >= '0') && (d <= '9'))))); + + if ((d == 'e') || (d == 'E')) + { /*exponent follows */ + k++; + d = s[k - 1]; + + if ((d == '+') || (d == '-')) + k++; + + do { + k++; + if (k > ls) + d = (char)(0); + else + d = s[k - 1]; + } while (!(!((d >= '0') && (d <= '9')))); + } + + pscopy (t, s, i, k - i); + + if (t[0] == '.') + cins (t, '0'); + else if (t[length (t) - 1] == '.') + cadd (t, '0'); + + u = rval (t, &err); + + if (err != 0) + { + scopy (v, "Number format error: "); + sadd (v, t); + error = message (dico, v); + } + else + { + scopy (t, ""); + while (alfa (d)) + { + cadd (t, upcase (d)); + k++; + + if (k > ls) + d = Nul; + else + d = s[k - 1]; + } + + u = parseunit (u, t); + } + + i = k - 1; + *perror = error; + *pi = i; + + return u; +} + +static char +fetchoperator (tdico * dico, + char *s, int ls, + int *pi, + unsigned char *pstate, unsigned char *plevel, + unsigned char *perror) /* grab an operator from string s and advance scan index pi. each operator has: one-char alias, precedence level, new interpreter state. */ -Begin - int i= *pi; - Byte state= *pstate; - Byte level= *plevel; - Bool error= *perror; - char c,d; - Strbig(Llen, v); - c=s[i-1]; - If i') Then - c='#'; Inc(i) - ElsIf (c=='<') And (d=='=') Then - c='L'; Inc(i) - ElsIf (c=='>') And (d=='=') Then - c='G'; Inc(i) - ElsIf (c=='*') And (d=='*') Then - c='^'; Inc(i) - ElsIf (c=='=') And (d=='=') Then - Inc(i) - ElsIf (c=='&') And (d=='&') Then - Inc(i) - ElsIf (c=='|') And (d=='|') Then - Inc(i) - EndIf; - If (c=='+') Or (c=='-') Then - state=2; /*pending operator*/ - level=4; - ElsIf (c=='*')Or (c=='/') Or (c=='%')Or(c=='\\') Then - state=2; level=3; - ElsIf c=='^' Then - state=2; level=2; - ElsIf cpos(c,"=<>#GL") >0 Then - state=2; level= 5; - ElsIf c=='&' Then - state=2; level=6; - ElsIf c=='|' Then - state=2; level=7; - ElsIf c=='!' Then - state=3; - Else state=0; - If c>' ' Then - scopy(v,"Syntax error: letter ["); - cadd(v,c); cadd(v,']'); - error=message( dico,v); - EndIf - EndIf - *pi=i; - *pstate=state; - *plevel=level; - *perror=error; +{ + int i = *pi; + unsigned char state = *pstate; + unsigned char level = *plevel; + unsigned char error = *perror; + char c, d; + Strbig (Llen, v); + c = s[i - 1]; + + if (i < ls) + d = s[i]; + else + d = Nul; + + if ((c == '!') && (d == '=')) + { + c = '#'; + i++; + } + else if ((c == '<') && (d == '>')) + { + c = '#'; + i++; + } + else if ((c == '<') && (d == '=')) + { + c = 'L'; + i++; + } + else if ((c == '>') && (d == '=')) + { + c = 'G'; + i++; + } + else if ((c == '*') && (d == '*')) + { + c = '^'; + i++; + } + else if ((c == '=') && (d == '=')) + { + i++; + } + else if ((c == '&') && (d == '&')) + { + i++; + } + else if ((c == '|') && (d == '|')) + { + i++; + } + if ((c == '+') || (c == '-')) + { + state = 2; /*pending operator */ + level = 4; + } + else if ((c == '*') || (c == '/') || (c == '%') || (c == '\\')) + { + state = 2; + level = 3; + } + else if (c == '^') + { + state = 2; + level = 2; + } + else if (cpos (c, "=<>#GL") > 0) + { + state = 2; + level = 5; + } + else if (c == '&') + { + state = 2; + level = 6; + } + else if (c == '|') + { + state = 2; + level = 7; + } + else if (c == '!') + { + state = 3; + } + else + { + state = 0; + if (c > ' ') + { + scopy (v, "Syntax error: letter ["); + cadd (v, c); + cadd (v, ']'); + error = message (dico, v); + } + } + *pi = i; + *pstate = state; + *plevel = level; + *perror = error; return c; -EndFunc +} -Intern -Func char opfunctkey( tdico *dico, - Byte kw, char c, - Byte * pstate, Byte * plevel, Bool * perror) +static char +opfunctkey (tdico * dico, + unsigned char kw, char c, + unsigned char *pstate, unsigned char *plevel, + unsigned char *perror) /* handle operator and built-in keywords */ -Begin - Byte state= *pstate; - Byte level= *plevel; - Bool error= *perror; +{ + unsigned char state = *pstate; + unsigned char level = *plevel; + unsigned char error = *perror; /*if kw operator keyword, c=token*/ - Switch kw /*AND OR NOT DIV MOD Defined*/ - CaseOne 1 Is - c='&'; state=2; level=6 - Case 2 Is - c='|'; state=2; level=7 - Case 3 Is - c='!'; state=3; level=1 - Case 4 Is - c='\\'; state=2; level=3 - Case 5 Is - c='%'; state=2; level=3 - Case Defd Is - c='?'; state=1; level=0 - Default - state=0; - error=message( dico," Unexpected Keyword"); - EndSw /*case*/ - *pstate=state; - *plevel=level; - *perror=error; - return c -EndFunc + switch (kw) + { /*& | ~ DIV MOD Defined */ + case 1: + c = '&'; + state = 2; + level = 6; + break; + case 2: + c = '|'; + state = 2; + level = 7; + break; + case 3: + c = '!'; + state = 3; + level = 1; + break; + case 4: + c = '\\'; + state = 2; + level = 3; + break; + case 5: + c = '%'; + state = 2; + level = 3; + break; + case Defd: + c = '?'; + state = 1; + level = 0; + break; + default: + state = 0; + error = message (dico, " Unexpected Keyword"); + break; + } /*case */ -Intern -Func double operate( - char op, - double x, - double y) -Begin + *pstate = state; + *plevel = level; + *perror = error; + return c; +} + +static double +operate (char op, double x, double y) +{ /* execute operator op on a pair of reals */ /* bug: x:=x op y or simply x:=y for empty op? No error signalling! */ - double u=1.0; - double z=0.0; - double epsi=1e-30; + double u = 1.0; + double z = 0.0; + double epsi = 1e-30; double t; - Switch op - CaseOne ' ' Is - x=y; /*problem here: do type conversions ?! */ - Case '+' Is - x=x+y; - Case '-' Is - x=x-y; - Case '*' Is - x=x*y; - Case '/' Is - If absf(y)>epsi Then x=x/y EndIf - Case '^' Is /*power*/ - t=absf(x); - If tx Then x=y EndIf; /*=Max*/ - Case '=' Is - If x == y Then x=u Else x=z EndIf; - Case '#' Is /*<>*/ - If x != y Then x=u Else x=z EndIf; - Case '>' Is - If x>y Then x=u Else x=z EndIf; - Case '<' Is - If x=*/ - If x>=y Then x=u Else x=z EndIf; - Case 'L' Is /*<=*/ - If x<=y Then x=u Else x=z EndIf; - Case '!' Is /*Not*/ - If y==z Then x=u Else x=z EndIf; - Case '%' Is /*Mod*/ - t= np_trunc(x/y); - x= x-y*t - Case '\\' Is /*Div*/ - x= np_trunc(absf(x/y)); - EndSw /*case*/ + switch (op) + { + case ' ': + x = y; /*problem here: do type conversions ?! */ ; + break; + case '+': + x = x + y; + break; + case '-': + x = x - y; + break; + case '*': + x = x * y; + break; + case '/': + if (absf (y) > epsi) + x = x / y; + break; + case '^': /*power */ + t = absf (x); + if (t < epsi) + x = z; + else + x = exp (y * ln (t)); + break; + case '&': /*&& */ + if (y < x) + x = y; /*=Min*/ ; + break; + case '|': /*|| */ + if (y > x) + x = y; /*=Max*/ ; + break; + case '=': + if (x == y) + x = u; + else + x = z; + break; + case '#': /*<> */ + if (x != y) + x = u; + else + x = z; + break; + case '>': + if (x > y) + x = u; + else + x = z; + break; + case '<': + if (x < y) + x = u; + else + x = z; + break; + case 'G': /*>= */ + if (x >= y) + x = u; + else + x = z; + break; + case 'L': /*<= */ + if (x <= y) + x = u; + else + x = z; + break; + case '!': /*! */ + if (y == z) + x = u; + else + x = z; + break; + case '%': /*% */ + t = np_trunc (x / y); + x = x - y * t; + break; + case '\\': /*/ */ + x = np_trunc (absf (x / y)); + break; + } /*case */ return x; -EndFunc +} -Intern -Func double formula( - tdico * dico, - Pchar s, - Bool * perror) -Begin +static double +formula (tdico * dico, char *s, unsigned char *perror) +{ /* Expression parser. s is a formula with parentheses and math ops +-* / ... State machine and an array of accumulators handle operator precedence. Parentheses handled by recursion. Empty expression is forbidden: must find at least 1 atom. - Syntax error if no toggle between binoperator And (unop/state1) ! + Syntax error if no toggle between binoperator && (unop/state1) ! States : 1=atom, 2=binOp, 3=unOp, 4= stop-codon. Allowed transitions: 1->2->(3,1) and 3->(3,1). */ - 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,w=0.0; - double accu[nprece+1]; - char oper[nprece+1]; - char uop[nprece+1]; - int i,k,ls,natom, arg2, arg3; - char c,d; - Strbig(Llen, t); - Bool ok; + typedef enum {nprece=9} _nnprece; /*maximal nb of precedence levels */ + unsigned char error = *perror; + unsigned char negate = 0; + unsigned char state, oldstate, topop, ustack, level, kw, fu; + double u = 0.0, v, w = 0.0; + double accu[nprece + 1]; + char oper[nprece + 1]; + char uop[nprece + 1]; + int i, k, ls, natom, arg2, arg3; + char c, d; + Strbig (Llen, t); + unsigned char ok; - For i=0; i<=nprece; Inc(i) Do - accu[i]=0.0; oper[i]=' ' - Done - i=0; - ls=length(s); - While(ls>0) And (s[ls-1]<=' ') Do Dec(ls) Done /*clean s*/ - state=0; natom=0; ustack=0; - topop=0; oldstate=0; fu=0; - error=False; - While (ils Then - d=chr(0) - Else - d=s[k-1] - EndIf - If d=='(' Then - Inc(level) - ElsIf d==')' Then - Dec(level) - EndIf - 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."); - Inc(natom); /*shut up other error message*/ - Else - If arg2 > i Then - pscopy(t,s,i+1, arg2-i-1); - 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)); - state=1; /*atom*/ - If fu>0 Then - If ( fu == 15 ) Then - u=ternary_fcn((int)v,w,u) - ElsIf ( fu == 16 ) Then - u=agauss(v,w,u) - Else - u=mathfunction(fu,v,u) - EndIf - EndIf - EndIf - i=k; fu=0; - ElsIf alfa(c) Then - i=fetchid(s,t, ls,i); /*user id, but sort out keywords*/ - state=1; - Dec(i); - kw=keyword(keys,t); /*debug ws('[',kw,']'); */ - If kw==0 Then - fu= keyword(fmath,t); /* numeric function? */ - If fu==0 Then - u=fetchnumentry( dico, t, Addr(error)); - Else - state=0; - EndIf /* state==0 means: ignore for the moment */ - Else - c=opfunctkey( dico, kw,c, Addr(state), Addr(level) ,Addr(error)); - EndIf - If kw==Defd Then - 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, - Addr(i), Addr(state),Addr(level),Addr(error)); - /*may change c to some other operator char!*/ - 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; + for (i = 0; i <= nprece; i++) + { + accu[i] = 0.0; + oper[i] = ' '; } - If Not ok Then - error=message( dico," Misplaced operator") - EndIf - If state==3 Then /*push unary operator*/ - Inc(ustack); - uop[ustack]=c; - ElsIf state==1 Then /*atom pending*/ Inc(natom); - If i>=ls Then - state=4; level=topop - EndIf /*close all ops below*/ - For k=ustack; k>=1; Dec(k) Do - u=operate(uop[k],u,u); - Done - ustack=0; - accu[0]=u; /* done: all pending unary operators */ - EndIf - If (state==2) Or (state==4) Then - /* do pending binaries of priority Upto "level" */ - For k=1; k<=level; Inc(k) Do /* not yet speed optimized! */ - accu[k]=operate(oper[k],accu[k],accu[k-1]); - accu[k-1]=0.0; - oper[k]=' '; /*reset intermediates*/ - Done - oper[level]=c; - If level>topop Then topop=level EndIf - EndIf - If (state>0) Then oldstate=state EndIf - Done /*while*/; - If (natom==0) Or (oldstate!=4) Then - scopy(t," Expression err: "); - sadd(t,s); - error=message( dico,t) - EndIf + i = 0; + ls = length (s); - if ( negate == True ) { - error = message( dico, " Problem with formula eval -- wrongly determined negation!" ); - } + while ((ls > 0) && (s[ls - 1] <= ' ')) + ls--; /*clean s */ - *perror= error; - If error Then - return 1.0; - Else - return accu[topop]; - EndIf -EndFunc /*formula*/ + state = 0; + natom = 0; + ustack = 0; + topop = 0; + oldstate = 0; + fu = 0; + error = 0; + level = 0; -Intern -Func char fmttype( double x) -Begin + while ((i < ls) && (!error)) + { + i++; + c = s[i - 1]; + if (c == '(') + { /*sub-formula or math function */ + level = 1; + /* new: must support multi-arg functions */ + k = i; + arg2 = 0; + v = 1.0; + arg3 = 0; + + do { + k++; + if (k > ls) + d = (char)(0); + else + d = s[k - 1]; + + if (d == '(') + level++; + else if (d == ')') + level--; + + if ((d == ',') && (level == 1)) + { + if (arg2 == 0) + arg2 = k; + else + arg3 = k; // kludge for more than 2 args (ternary expression); + } /* comma list? */ ; + } + while (!((k > ls) || ((d == ')') && (level <= 0)))); + + if (k > ls) + { + error = message (dico, "Closing \")\" not found."); + natom++; /*shut up other error message */ ; + } + else + { + if (arg2 > i) + { + pscopy (t, s, i + 1, arg2 - i - 1); + v = formula (dico, t, &error); + i = arg2; + } + if (arg3 > i) + { + pscopy (t, s, i + 1, arg3 - i - 1); + w = formula (dico, t, &error); + i = arg3; + } + pscopy (t, s, i + 1, k - i - 1); + u = formula (dico, t, &error); + state = 1; /*atom */ + if (fu > 0) + { + if ((fu == 15)) + u = ternary_fcn ((int) v, w, u); + else if ((fu == 16)) + u = agauss (v, w, u); + else + u = mathfunction (fu, v, u); + + } + } + i = k; + fu = 0; + } + else if (alfa (c)) + { + i = fetchid (s, t, ls, i); /*user id, but sort out keywords */ + state = 1; + i--; + kw = keyword (keys, t); /*debug ws('[',kw,']'); */ + if (kw == 0) + { + fu = keyword (fmath, t); /* numeric function? */ + if (fu == 0) + u = fetchnumentry (dico, t, &error); + else + state = 0; /* state==0 means: ignore for the moment */ + } + else + c = opfunctkey (dico, kw, c, &state, &level, &error); + + if (kw == Defd) + u = exists (dico, s, &i, &error); + } + else if (((c == '.') || ((c >= '0') && (c <= '9')))) + { + u = fetchnumber (dico, s, ls, &i, &error); + if (negate) + { + u = -1 * u; + negate = 0; + } + state = 1; + } + else + c = fetchoperator (dico, s, ls, &i, &state, &level, &error); + /* may change c to some other operator char! */ + /* control chars <' ' ignored */ + + ok = (oldstate == 0) || (state == 0) || + ((oldstate == 1) && (state == 2)) || ((oldstate != 1) + && (state != 2)); + if (oldstate == 2 && state == 2 && c == '-') + { + ok = 1; + negate = 1; + continue; + } + + if (!ok) + error = message (dico, " Misplaced operator"); + + if (state == 3) + { /*push unary operator */ + ustack++; + uop[ustack] = c; + } + else if (state == 1) + { /*atom pending */ + natom++; + if (i >= ls) + { + state = 4; + level = topop; + } /*close all ops below */ + for (k = ustack; k >= 1; k--) + u = operate (uop[k], u, u); + + ustack = 0; + accu[0] = u; /* done: all pending unary operators */ ; + } + + if ((state == 2) || (state == 4)) + { + /* do pending binaries of priority Upto "level" */ + for (k = 1; k <= level; k++) + { /* not yet speed optimized! */ + accu[k] = operate (oper[k], accu[k], accu[k - 1]); + accu[k - 1] = 0.0; + oper[k] = ' '; /*reset intermediates */ ; + } + oper[level] = c; + + if (level > topop) + topop = level; + } + if ((state > 0)) + { + oldstate = state; + } + } /*while */ ; + if ((natom == 0) || (oldstate != 4)) + { + scopy (t, " Expression err: "); + sadd (t, s); + error = message (dico, t); + } + + if (negate == 1) + { + error = + message (dico, + " Problem with formula eval -- wrongly determined negation!"); + } + + *perror = error; + + if (error) + return 1.0; + else + return accu[topop]; +} /*formula */ + +static char +fmttype (double x) +{ /* I=integer, P=fixedpoint F=floatpoint*/ /* find out the "natural" type of format for number x*/ - double ax,dx; + double ax, dx; int rx; - Bool isint,astronomic; - ax=absf(x); - isint=False; - astronomic=False; - If ax<1e-30 Then - isint=True; - ElsIf ax<32000 Then /*detect integers*/ - rx=np_round(x); - dx=(x-rx)/ax; - isint=(absf(dx)<1e-6); - EndIf - If Not isint Then - astronomic= (ax>=1e6) Or (ax<0.01) - EndIf - If isint Then - return 'I' - ElsIf astronomic Then - return 'F' - Else - return 'P' - EndIf -EndFunc + unsigned char isint, astronomic; + ax = absf (x); + isint = 0; + astronomic = 0; -Intern -Func Bool evaluate( - tdico * dico, - Pchar q, - Pchar t, - Byte mode) -Begin + if (ax < 1e-30) + isint = 1; + else if (ax < 32000) + { /*detect integers */ + rx = np_round (x); + dx = (x - rx) / ax; + isint = (absf (dx) < 1e-6); + } + + if (!isint) + astronomic = (ax >= 1e6) || (ax < 0.01); + + if (isint) + return 'I'; + else if (astronomic) + return 'F'; + else + return 'P'; +} + +static unsigned char +evaluate (tdico * dico, char *q, char *t, unsigned char mode) +{ /* transform t to result q. mode 0: expression, mode 1: simple variable */ - double u=0.0; - int k,j,lq; - char dt,fmt; - Bool numeric, done, nolookup; - Bool err; - Strbig(Llen, v); - scopy(q,""); - numeric=False; err=False; - If mode==1 Then /*string?*/ - stupcase(t); - k=entrynb(dico,t); - nolookup= ( k<=0 ); - While (k>0) And (dico->dat[k].tp=='P') Do - k=dico->dat[k].ivl - Done - /*pointer chain*/ - If k>0 Then - dt=dico->dat[k].tp - Else - dt=' ' - EndIf; - /*data type: Real or String*/ - If dt=='R' Then - u=dico->dat[k].vl; numeric=True - ElsIf dt=='S' Then /*suppose source text "..." at*/ - j=dico->dat[k].ivl; - lq=0; - Repeat - Inc(j); Inc(lq); - dt= /*ibf->bf[j]; */ dico->dat[k].sbbase[j]; - If cpos('3',dico->option)<=0 Then - dt=upcase(dt) - EndIf /* spice-2 */ - done= (dt=='\"') Or (dt<' ') Or (lq>99); - If Not done Then cadd(q,dt) EndIf - Until done EndRep - Else k=0 EndIf - If k <= 0 Then - scopy(v,""); - cadd(v,'\"'); sadd(v,t); - sadd(v,"\" not evaluated. "); - If nolookup Then sadd(v,"Lookup failure.") EndIf - err=message( dico,v) - EndIf - Else - u=formula( dico, t, Addr(err)); - numeric=True - EndIf - If numeric Then - fmt= fmttype(u); - If fmt=='I' Then - stri(np_round(u), q) - Else - //strf(u,6,-1,q); - strf(u,17,10,q); - EndIf /* strf() arg 2 doesnt work: always >10 significant digits ! */ - EndIf + double u = 0.0; + int k, j, lq; + char dt, fmt; + unsigned char numeric, done, nolookup; + unsigned char err; + Strbig (Llen, v); + scopy (q, ""); + numeric = 0; + err = 0; + + if (mode == 1) + { /*string? */ + stupcase (t); + k = entrynb (dico, t); + nolookup = (k <= 0); + while ((k > 0) && (dico->dat[k].tp == 'P')) + k = dico->dat[k].ivl; + + /*pointer chain */ + if (k > 0) + dt = dico->dat[k].tp; + else + dt = ' '; + + /*data type: Real or String */ + if (dt == 'R') + { + u = dico->dat[k].vl; + numeric = 1; + } + else if (dt == 'S') + { /*suppose source text "..." at */ + j = dico->dat[k].ivl; + lq = 0; + do { + j++; + lq++; + dt = /*ibf->bf[j]; */ dico->dat[k].sbbase[j]; + + if (cpos ('3', dico->option) <= 0) + dt = upcase (dt); /* spice-2 */ + + done = (dt == '\"') || (dt < ' ') || (lq > 99); + + if (!done) + cadd (q, dt); + } while (!(done)); + } + else + k = 0; + + if (k <= 0) + { + scopy (v, ""); + cadd (v, '\"'); + sadd (v, t); + sadd (v, "\" not evaluated. "); + + if (nolookup) + sadd (v, "Lookup failure."); + + err = message (dico, v); + } + } + else + { + u = formula (dico, t, &err); + numeric = 1; + } + if (numeric) + { + fmt = fmttype (u); + if (fmt == 'I') + stri (np_round (u), q); + else + { + //strf(u,6,-1,q); + strf (u, 17, 10, q); + } /* strf() arg 2 doesnt work: always >10 significant digits ! */ ; + } return err; -EndFunc +} #if 0 -Intern -Func Bool scanline( - tdico * dico, - Pchar s, Pchar r, - Bool err) +static unsigned char +scanline (tdico * dico, char *s, char *r, unsigned char err) /* scan host code line s for macro substitution. r=result line */ -Begin - int i,k,ls,level,nd, nnest; - Bool spice3; - char c,d; - Strbig(Llen, q); - Strbig(Llen, t); - Str(20, u); - spice3= cpos('3', dico->option) >0; /* we had -3 on the command line */ - i=0; ls=length(s); - scopy(r,""); - err=False; - pscopy(u,s,1,3); - If (ls>7) And steq(u,"**&") Then /*special Comment **&AC #...*/ - pscopy(r,s,1,7); - i=7 - EndIf - While (ils Then - d=chr(0) - Else - d=s[k-1] - EndIf - If d=='(' Then - Inc(level) - ElsIf d==')' Then - Dec(level) - EndIf - Until (k>ls) Or ((d==')') And (level<=0)) EndRep - If k>ls Then - err=message( dico,"Closing \")\" not found."); - Else - pscopy(t,s,i+1, k-i-1); - err=evaluate( dico, q,t,0); - EndIf - i=k; - Else /*simple identifier may also be string*/ - Repeat - Inc(k); - If k>ls Then - d=chr(0) - Else - d=s[k-1] - EndIf - Until (k>ls) Or (d<=' ') EndRep - pscopy(t,s,i,k-i); - err=evaluate( dico, q,t,1); - i=k-1; - EndIf - If Not err Then /*insert the number*/ - sadd(r,q) - Else - message( dico,s) - EndIf - ElsIf c==Nodekey Then /*follows: a node keyword*/ - Repeat - Inc(i) - Until s[i-1]>' ' EndRep - k=i; - Repeat - Inc(k) - Until (k>ls) Or Not alfanum(s[k-1]) EndRep - pscopy(q,s,i,k-i); - nd=parsenode( Addr(dico->nodetab), q); - If Not spice3 Then - stri(nd,q) - EndIf; /* substitute by number */ - sadd(r,q); - i=k-1; - Else - If Not spice3 Then c=upcase(c) EndIf - cadd(r,c); /*c<>Intro*/ - EndIf - Done /*while*/ +{ + int i, k, ls, level, nd, nnest; + unsigned char spice3; + char c, d; + Strbig (Llen, q); + Strbig (Llen, t); + Str (20, u); + spice3 = cpos ('3', dico->option) > 0; /* we had -3 on the command line */ + i = 0; + ls = length (s); + scopy (r, ""); + err = 0; + pscopy (u, s, 1, 3); + if ((ls > 7) && steq (u, "**&")) + { /*special Comment **&AC #... */ + pscopy (r, s, 1, 7); + i = 7; + } + while ((i < ls) && (!err)) + { + i++; + c = s[i - 1]; + if (c == Pspice) + { /* try pspice expression syntax */ + k = i; + nnest = 1; + do + { + k++; + d = s[k - 1]; + if (d == '{') + { + nnest++; + } + else if (d == '}') + { + nnest--; + } + } + while (!((nnest == 0) || (d == 0))); + if (d == 0) + { + err = message (dico, "Closing \"}\" not found."); + } + else + { + pscopy (t, s, i + 1, k - i - 1); + err = evaluate (dico, q, t, 0); + } + i = k; + if (!err) + { /*insert number */ + sadd (r, q); + } + else + { + err = message (dico, s); + } + } + else if (c == Intro) + { + Inc (i); + while ((i < ls) && (s[i - 1] <= ' ')) + i++; + k = i; + if (s[k - 1] == '(') + { /*sub-formula */ + level = 1; + do + { + k++; + if (k > ls) + { + d = chr (0); + } + else + { + d = s[k - 1]; + } + if (d == '(') + { + level++; + } + else if (d == ')') + { + level--; + } + } + while (!((k > ls) || ((d == ')') && (level <= 0)))); + if (k > ls) + { + err = message (dico, "Closing \")\" not found."); + } + else + { + pscopy (t, s, i + 1, k - i - 1); + err = evaluate (dico, q, t, 0); + } + i = k; + } + else + { /*simple identifier may also be string */ + do + { + k++; + if (k > ls) + { + d = chr (0); + } + else + { + d = s[k - 1]; + } + } + while (!((k > ls) || (d <= ' '))); + pscopy (t, s, i, k - i); + err = evaluate (dico, q, t, 1); + i = k - 1; + } + if (!err) + { /*insert the number */ + sadd (r, q); + } + else + { + message (dico, s); + } + } + else if (c == Nodekey) + { /*follows: a node keyword */ + do + { + i++; + } + while (!(s[i - 1] > ' ')); + k = i; + do + { + k++; + } + while (!((k > ls) || !alfanum (s[k - 1]))); + pscopy (q, s, i, k - i); + nd = parsenode (Addr (dico->nodetab), q); + if (!spice3) + { + stri (nd, q); + } /* substitute by number */ + sadd (r, q); + i = k - 1; + } + else + { + if (!spice3) + { + c = upcase (c); + } + cadd (r, c); /*c<>Intro */ ; + } + } /*while */ return err; -EndFunc +} #endif /********* interface functions for spice3f5 extension ***********/ -Intern -Proc compactfloatnb(Pchar v) -/* try to squeeze a floating pt format to 10 characters */ +static void +compactfloatnb (char *v) +/* try to squeeze a floating pt format to 10 characters */ /* erase superfluous 000 digit streams before E */ -/* bug: truncating, no rounding */ -Begin - int n,k, lex; - Str(20,expo); - n=cpos('E',v); /* if too long, try to delete digits */ - If n >3 Then - pscopy(expo, v, n,length(v)); - 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) > 17 Then k= 17-lex EndIf - pscopy(v,v, 1,k+1); - sadd(v,expo); - EndIf -EndProc +/* bug: truncating, no rounding */ +{ + int n, k, lex; + Str (20, expo); + n = cpos ('E', v); /* if too long, try to delete digits */ -Intern -Func int insertnumber(tdico *dico, int i, Pchar s, Pchar u) + if (n > 3) + { + pscopy (expo, v, n, length (v)); + lex = length (expo); + k = n - 2; /* mantissa is 0...k */ + + while ((v[k] == '0') && (v[k - 1] == '0')) + k--; + + if ((k + 1 + lex) > 17) + k = 17 - lex; + + pscopy (v, v, 1, k + 1); + sadd (v, expo); + } +} + +static int +insertnumber (tdico * dico, int i, char *s, char *u) /* insert u in string s in place of the next placeholder number */ -Begin - Str(40,v); - Str(80,msg); - Bool found; - int ls, k; +{ + Str (40, v); + Str (80, msg); + unsigned char found; + int ls, k; long accu; - ls= length(s); - scopy(v,u); - compactfloatnb(v); - While length(v)<17 Do - cadd(v,' ') - Done - If length(v)>17 Then - scopy(msg," insertnumber fails: "); - sadd(msg,u); - message( dico, msg) - EndIf - found=False; - While (Not found) And (i0) And (accu<40000) - EndIf - Inc(i) - Done - If found Then /* substitute at i-1 */ - Dec(i); - 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 -EndFunc + ls = length (s); -Func Bool nupa_substitute( tdico *dico, Pchar s, Pchar r, Bool err) + scopy (v, u); + compactfloatnb (v); + + while (length (v) < 17) + cadd (v, ' '); + + if (length (v) > 17) + { + scopy (msg, " insertnumber fails: "); + sadd (msg, u); + message (dico, msg); + } + + found = 0; + + while ((!found) && (i < ls)) + { + found = (s[i] == '1'); + k = 0; + accu = 0; + + while (found && (k < 10)) + { /* parse a 10-digit number */ + found = num (s[i + k]); + + if (found) + accu = 10 * accu + s[i + k] - '0'; + + k++; + } + + if (found) + { + accu = accu - 1000000000L; /* plausibility test */ + found = (accu > 0) && (accu < 40000); + } + i++; + } + + if (found) + { /* substitute at i-1 */ + i--; + for (k = 0; k < 17; k++) + s[i + k] = v[k]; + + 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 "); + } + return i; +} + +unsigned char +nupa_substitute (tdico * dico, char *s, char *r, unsigned char err) /* s: pointer to original source line. r: pointer to result line, already heavily modified wrt s anywhere we find a 10-char numstring in r, substitute it. bug: wont flag overflow! */ -Begin - int i,k,ls,level, nnest, ir; - char c,d; - Strbig(Llen, q); - Strbig(Llen, t); - i=0; - ls=length(s); - err=False; - ir=0; - While (ils Then - d=chr(0) - Else - d=s[k-1] - EndIf - If d=='(' Then - Inc(level) - ElsIf d==')' Then - Dec(level) - EndIf - Until (k>ls) Or ((d==')') And (level<=0)) EndRep - If k>ls Then - err=message( dico,"Closing \")\" not found."); - Else - pscopy(t,s,i+1, k-i-1); - err=evaluate( dico, q,t,0); - EndIf - i=k; - Else /*simple identifier may also be string? */ - Repeat - Inc(k); - If k>ls Then - d=chr(0) - Else - d=s[k-1] - EndIf - Until (k>ls) Or (d<=' ') EndRep - pscopy(t,s,i,k-i); - err=evaluate( dico, q,t,1); - i= k-1; - EndIf - If Not err Then - ir= insertnumber(dico, ir, r,q); - Else - message( dico, "Cannot compute &(expression)") - EndIf - EndIf - Done /*while*/ - return err -EndFunc +{ + int i, k, ls, level, nnest, ir; + char c, d; + Strbig (Llen, q); + Strbig (Llen, t); + i = 0; + ls = length (s); + err = 0; + ir = 0; -Intern -Func Byte getword( - Pchar s, Pchar t, - int after, - int * pi) + while ((i < ls) && (!err)) + { + i++; + c = s[i - 1]; + if (c == Pspice) + { /* try pspice expression syntax */ + k = i; + nnest = 1; + do { + k++; + d = s[k - 1]; + if (d == '{') + nnest++; + else if (d == '}') + nnest--; + } while (!((nnest == 0) || (d == 0))); + + if (d == 0) + err = message (dico, "Closing \"}\" not found."); + else + { + pscopy (t, s, i + 1, k - i - 1); + err = evaluate (dico, q, t, 0); + } + + i = k; + if (!err) + ir = insertnumber (dico, ir, r, q); + else + err = message (dico, "Cannot compute substitute"); + } + else if (c == Intro) + { + i++; + while ((i < ls) && (s[i - 1] <= ' ')) + i++; + + k = i; + + if (s[k - 1] == '(') + { /*sub-formula */ + level = 1; + do { + k++; + if (k > ls) + d = (char)(0); + else + d = s[k - 1]; + + if (d == '(') + level++; + else if (d == ')') + level--; + } while (!((k > ls) || ((d == ')') && (level <= 0)))); + + if (k > ls) + err = message (dico, "Closing \")\" not found."); + else + { + pscopy (t, s, i + 1, k - i - 1); + err = evaluate (dico, q, t, 0); + } + i = k; + } + else + { /*simple identifier may also be string? */ + do { + k++; + if (k > ls) + d = (char)(0); + else + d = s[k - 1]; + } while (!((k > ls) || (d <= ' '))); + + pscopy (t, s, i, k - i); + err = evaluate (dico, q, t, 1); + i = k - 1; + } + + if (!err) + ir = insertnumber (dico, ir, r, q); + else + message (dico, "Cannot compute &(expression)"); + } + } /*while */ + return err; +} + +static unsigned char +getword (char *s, char *t, int after, int *pi) /* isolate a word from s after position "after". return i= last read+1 */ -Begin - int i= *pi; +{ + int i = *pi; int ls; - Byte key; - i=after; - ls=length(s); - Repeat - Inc(i) - Until (i>=ls) Or alfa(s[i-1]) EndRep - scopy(t,""); - While (i<=ls) And (alfa(s[i-1]) Or num(s[i-1])) Do - cadd(t,upcase(s[i-1])); - Inc(i); - Done - If NotZ(t[0]) Then - key=keyword(keys,t) - Else - key=0 - EndIf - *pi=i; - return key; -EndFunc + unsigned char key; + i = after; + ls = length (s); + + do + { + i++; + } while (!((i >= ls) || alfa (s[i - 1]))); -Intern -Func char getexpress( Pchar s, Pchar t, int * pi) + scopy (t, ""); + + while ((i <= ls) && (alfa (s[i - 1]) || num (s[i - 1]))) + { + cadd (t, upcase (s[i - 1])); + i++; + } + + if (t[0]) + key = keyword (keys, t); + else + key = 0; + + *pi = i; + return key; +} + +static char +getexpress (char *s, char *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 + returns tpe=='R' if ( numeric, 'S' if ( string only */ -Begin - int i= *pi; - int ia,ls,level; - char c,d, tpe; - Bool comment= False; - ls=length(s); - ia=i+1; - While (ials) Or (s[i-1] >' ') EndRep - Else - If s[ia-1]=='{' Then Inc(ia) EndIf - i= ia-1; - Repeat - Inc(i); - If i>ls Then - c=';' - Else - c=s[i-1] - EndIf - If c=='(' Then /*sub-formula*/ - level=1; - Repeat - Inc(i); - If i>ls Then - d=Nul - Else - d=s[i-1] - EndIf - If d=='(' Then - Inc(level) - ElsIf d==')' Then - Dec(level) - EndIf - Until (i>ls) Or ((d==')') And (level<=0)) EndRep - EndIf - /* buggy? */ If (c=='/') Or (c=='-') Then comment= (s[i]==c) EndIf - Until (cpos(c, ",;)}") >0) Or comment EndRep /*legal separators*/ - tpe='R'; - EndIf - pscopy(t,s,ia,i-ia); - If s[i-1]=='}' Then Inc(i) EndIf - If tpe=='S' Then Inc(i) EndIf /* beyond quote */ - *pi=i; - return tpe; -EndFunc +{ + int i = *pi; + int ia, ls, level; + char c, d, tpe; + unsigned char comment = 0; + ls = length (s); + ia = i + 1; -Func Bool nupa_assignment( tdico *dico, Pchar s, char mode) + while ((ia < ls) && (s[ia - 1] <= ' ')) + ia++; /*white space ? */ + + if (s[ia - 1] == '"') + { /*string constant */ + ia++; + i = ia; + + while ((i < ls) && (s[i - 1] != '"')) + i++; + + tpe = 'S'; + + do { + i++; + } while (!((i > ls) || (s[i - 1] > ' '))); + } + else + { + + if (s[ia - 1] == '{') + ia++; + + i = ia - 1; + + do { + i++; + + if (i > ls) + c = ';'; + else + c = s[i - 1]; + + if (c == '(') + { /*sub-formula */ + level = 1; + do { + i++; + + if (i > ls) + d = Nul; + else + d = s[i - 1]; + + if (d == '(') + level++; + else if (d == ')') + level--; + } while (!((i > ls) || ((d == ')') && (level <= 0)))); + } + /* buggy? */ if ((c == '/') || (c == '-')) + comment = (s[i] == c); + } while (!((cpos (c, ",;)}") > 0) || comment)); /*legal separators */ + + tpe = 'R'; + + } + + pscopy (t, s, ia, i - ia); + + if (s[i - 1] == '}') + i++; + + if (tpe == 'S') + i++; /* beyond quote */ + + *pi = i; + return tpe; +} + +unsigned char +nupa_assignment (tdico * dico, char *s, char mode) /* is called for all 'Param' lines of the input file. is also called for the params: section of a subckt . mode='N' define new local variable, else global... bug: we cannot rely on the transformed line, must re-parse everything! */ -Begin +{ /* s has the format: ident = expression; ident= expression ... */ - Strbig(Llen, t); - Strbig(Llen,u); - int i,j, ls; - Byte key; - Bool error, err; + Strbig (Llen, t); + Strbig (Llen, u); + int i, j, ls; + unsigned char key; + unsigned char error, err; char dtype; - Word wval=0; - double rval= 0.0; - ls=length(s); - error=False; - i=0; - j= spos("//", s); /* stop before comment if any */ - If j>0 Then ls= j-1 EndIf - /* bug: doesnt work. need to revise getexpress ... !!! */ - i=0; - While (i' ' Do Inc(i) Done - EndIf - While (i0) Then - error=message( dico," Identifier expected") - EndIf - If Not error Then /* assignment expressions */ - While (i<=ls) And (s[i-1] !='=') Do Inc(i) Done - If i>ls Then - error= message( dico," = sign expected .") - EndIf - dtype=getexpress(s,u, Addr(i)); - If dtype=='R' Then - rval=formula( dico, u, Addr(error)); - If error Then - message( dico," Formula() error."); - fprintf(stderr," %s\n",s); - EndIf - ElsIf dtype=='S' Then - wval= i - EndIf - err=define(dico,t, mode /*was ' ' */ , dtype,rval,wval,Null); - error= error Or err; - EndIf - If (i 0) + ls = j - 1; + /* bug: doesnt work. need to revise getexpress ... !!! */ + i = 0; + + while ((i < ls) && (s[i] <= ' ')) + i++; + + if (s[i] == Intro) + i++; + + if (s[i] == '.') + { /* skip any dot keyword */ + while (s[i] > ' ') + i++; + } + + while ((i < ls) && (!error)) + { + key = getword (s, t, i, &i); + if ((t[0] == 0) || (key > 0)) + error = message (dico, " Identifier expected"); + + if (!error) + { /* assignment expressions */ + while ((i <= ls) && (s[i - 1] != '=')) + i++; + + if (i > ls) + error = message (dico, " = sign expected ."); + + dtype = getexpress (s, u, &i); + + if (dtype == 'R') + { + rval = formula (dico, u, &error); + if (error) + { + message (dico, " Formula() error."); + fprintf (stderr, " %s\n", s); + } + } + else if (dtype == 'S') + wval = i; + + err = define (dico, t, mode /*was ' ' */ , dtype, rval, wval, NULL); + error = error || err; + } + + if ((i < ls) && (s[i - 1] != ';')) + error = message (dico, " ; sign expected."); + else + /* i++ */; + } + return error; +} + +unsigned char +nupa_subcktcall (tdico * dico, char *s, char *x, unsigned char err) /* s= a subckt define line, with formal params. x= a matching subckt call line, with actual params */ -Begin - 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); - +{ + 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' + skip over instance name -- fixes bug where instance 'x1' is + same name as subckt 'x1' */ - while ( *x != ' ' ) x++; + 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_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 0) + pscopy_up (t, s, 1, j - 1); + else + scopy_up (t, s); + + j = spos ("SUBCKT", t); + + if (j > 0) + { + j = j + 6; /* fetch its name */ + while ((j < ls) && (t[j] <= ' ')) + j++; + + while (t[j] != ' ') + { + cadd (subname, t[j]); + j++; + } + } + else + err = message (dico, " ! a subckt line!"); + + i = spos ("PARAMS:", t); + + if (i > 0) + { + pscopy (t, t, i + 7, length (t)); + while (j = cpos ('=', t), j > 0) + { /* isolate idents to the left of =-signs */ + k = j - 2; + while ((k >= 0) && (t[k] <= ' ')) + k--; + + h = k; + + while ((h >= 0) && alfanum (t[h])) + h--; + + if (alfa (t[h + 1]) && (k > h)) + { /* we have some id */ + for (m = (h + 1); m <= k; m++) + cadd (idlist, t[m]); + + sadd (idlist, "=$;"); + n++; + } + else + message (dico, "identifier expected."); + + pscopy (t, t, j + 1, length (t)); + } } - Else - err=message( dico," Not a subckt line!") - EndIf; - i= spos("PARAMS:",t); - If i>0 Then - pscopy(t,t, i+7, length(t)); - While j=cpos('=',t), j>0 Do /* isolate idents to the left of =-signs */ - k= j-2; - While (k>=0) And (t[k]<=' ') Do Dec(k) Done - h=k; - While (h>=0) And alfanum(t[h]) Do Dec(h) Done - If alfa(t[h+1]) And (k>h) Then /* we have some id */ - For m=(h+1); m<=k; Inc(m) Do - cadd(idlist,t[m]) - Done - sadd(idlist,"=$;"); - Inc(n); - Else - message( dico,"identifier expected.") - EndIf - pscopy(t,t, j+1, length(t)); - Done - EndIf /***** next, analyze the circuit call line */ - If Not err Then - narg=0; - j=spos("//",x); - If j>0 Then pscopy_up(t,x,1,j-1) Else scopy_up(t,x) EndIf - ls=length(t); - j= spos(subname,t); + if (!err) + { + narg = 0; + j = spos ("//", x); - /* 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) + pscopy_up (t, x, 1, j - 1); + else + scopy_up (t, x); + + ls = length (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) + { + j = j + length (subname) - 1; /* 1st position of arglist: j */ + + while ((j < ls) && ((t[j] <= ' ') || (t[j] == ','))) + j++; + + while (j < ls) + { /* try to fetch valid arguments */ + k = j; + scopy (u, ""); + if ((t[k] == Intro)) + { /* handle historical syntax... */ + if (alfa (t[k + 1])) + k++; + else if (t[k + 1] == '(') + { /* transform to braces... */ + k++; + t[k] = '{'; + g = k; + nest = 1; + while ((nest > 0) && (g < ls)) + { + g++; + if (t[g] == '(') + nest++; + else if (t[g] == ')') + nest--; + } + + if ((g < ls) && (nest == 0)) + t[g] = '}'; + } + } + + if (alfanum (t[k]) || t[k] == '.') + { /* number, identifier */ + h = k; + while (t[k] > ' ') + k++; + + pscopy (u, t, h + 1, k - h); + j = k; + } + else if (t[k] == '{') + { + getexpress (t, u, &j); + j--; /* confusion: j was in Turbo Pascal convention */ ; + } + else + { + j++; + + if (t[k] > ' ') + { + scopy (v, "Subckt call, symbol "); + cadd (v, t[k]); + sadd (v, " not understood"); + message (dico, v); + } + } + + if (u[0]) + { + narg++; + k = cpos ('$', idlist); + + if (k > 0) + { /* replace dollar with expression string u */ + pscopy (v, idlist, 1, k - 1); + sadd (v, u); + pscopy (u, idlist, k + 1, length (idlist)); + scopy (idlist, v); + sadd (idlist, u); + } + } + } + } + else + message (dico, "Cannot find called subcircuit"); } - - If j>0 Then - j=j + length(subname) -1; /* 1st position of arglist: j */ - While (j0) And (g ' ' Do Inc(k) Done - pscopy(u,t, h+1, k-h); - j= k; - ElsIf t[k]=='{' Then - getexpress(t,u, Addr(j)); - Dec(j); /* confusion: j was in Turbo Pascal convention */ - Else - Inc(j); - If t[k]>' ' Then - scopy(v,"Subckt call, symbol "); - cadd(v,t[k]); - sadd(v," not understood"); - message( dico,v); - EndIf - EndIf - If NotZ(u[0]) Then - Inc(narg); - k=cpos('$',idlist); - If k>0 Then /* replace dollar with expression string u */ - pscopy(v,idlist,1,k-1); - sadd(v,u); - pscopy(u,idlist, k+1, length(idlist)); - scopy(idlist,v); - sadd(idlist,u); - EndIf - EndIf - Done - Else - message( dico,"Cannot find called subcircuit") - EndIf - EndIf /***** finally, execute the multi-assignment line */ - dicostack(dico, Push); /* create local symbol scope */ - If narg != n Then - scopy(t," Mismatch: "); - nadd(t,n); - sadd(t," formal but "); - nadd(t,narg); - sadd(t," actual params."); - err= message( dico,t); - message( dico,idlist); - /* Else debugwarn(dico, idlist) */ - EndIf - err= nupa_assignment(dico, idlist, 'N'); - return err -EndFunc - -Proc nupa_subcktexit( tdico *dico) -Begin - dicostack(dico, Pop); -EndProc + dicostack (dico, Push); /* create local symbol scope */ + if (narg != n) + { + scopy (t, " Mismatch: "); + nadd (t, n); + sadd (t, " formal but "); + nadd (t, narg); + sadd (t, " actual params."); + err = message (dico, t); + message (dico, idlist); + /* ;} else { debugwarn(dico, idlist) */ ; + } + err = nupa_assignment (dico, idlist, 'N'); + return err; +} +void +nupa_subcktexit (tdico * dico) +{ + dicostack (dico, Pop); +}