From feedbaf092f02ced4fba8b463d4b7a6222c2cb36 Mon Sep 17 00:00:00 2001 From: pnenzi Date: Thu, 25 Sep 2003 17:19:44 +0000 Subject: [PATCH] Added numparam library (contributed by Georg Post) to add .param to spice netlists. --- src/frontend/numparam/Makefile.am | 13 + src/frontend/numparam/downgrad.txt | 89 ++ src/frontend/numparam/general.h | 211 ++++ src/frontend/numparam/mystring.c | 881 ++++++++++++++++ src/frontend/numparam/ngconfig.sh | 20 + src/frontend/numparam/numparam.h | 76 ++ src/frontend/numparam/nupatest.c | 453 ++++++++ src/frontend/numparam/readme.txt | 674 ++++++++++++ src/frontend/numparam/spicenum.c | 550 ++++++++++ src/frontend/numparam/washprog.c | 996 ++++++++++++++++++ src/frontend/numparam/xpressn.c | 1548 ++++++++++++++++++++++++++++ 11 files changed, 5511 insertions(+) create mode 100644 src/frontend/numparam/Makefile.am create mode 100644 src/frontend/numparam/downgrad.txt create mode 100644 src/frontend/numparam/general.h create mode 100644 src/frontend/numparam/mystring.c create mode 100644 src/frontend/numparam/ngconfig.sh create mode 100644 src/frontend/numparam/numparam.h create mode 100644 src/frontend/numparam/nupatest.c create mode 100644 src/frontend/numparam/readme.txt create mode 100644 src/frontend/numparam/spicenum.c create mode 100644 src/frontend/numparam/washprog.c create mode 100644 src/frontend/numparam/xpressn.c diff --git a/src/frontend/numparam/Makefile.am b/src/frontend/numparam/Makefile.am new file mode 100644 index 000000000..9a354a335 --- /dev/null +++ b/src/frontend/numparam/Makefile.am @@ -0,0 +1,13 @@ +## Process this file with automake to produce Makefile.in + +noinst_LIBRARIES = libnumparam.a + +libnumparam_a_SOURCES = \ + spicenum.c \ + xpressn.c \ + mystring.c \ + general.h \ + numparam.h + +INCLUDES = -I$(top_srcdir)/src/include +MAINTAINERCLEANFILES = Makefile.in diff --git a/src/frontend/numparam/downgrad.txt b/src/frontend/numparam/downgrad.txt new file mode 100644 index 000000000..24b13b8bb --- /dev/null +++ b/src/frontend/numparam/downgrad.txt @@ -0,0 +1,89 @@ +! downgrad.txt, Use with 'washprog.c' +! opcodes: x=exclusion, m=macro, w=wordsubst s= general subst +! Macros to keep: Cconst Hi Lo Str Strbig Use ...? + +w Proc void +w Begin { +w EndProc ;} +w Func "" +w EndFunc ;} +w If "if (" +w Then ") {" +w Else ";} else {" +w ElsIf ";} else if (" +w EndIf ;} +w While "while (" +w Do ") {" +w Done ;} +w Repeat "do {" +w Until ";} while ( !(" +w EndRep )); +w For "for (" +w Switch "switch (" +w CaseOne ") { case" +w Case "; break; } case" +w AndCase ":; case" +w Is :{ +w Default "; break;} default: {" +w EndSw ";break;} }" + +m Const(1,2) "const short 1 = 2;" + +m Record(1) "typedef struct _t1 {" +m RecPtr(1) "typedef struct _t1 *" +m EndRec(1) "} 1;" +m Addr(1) &1 + +w False 0 +w True 1 +w Not ! +w And && +w Or || +w Div / +w Mod % + +w Shl << +w Shr >> +w AND & +w OR | +w XOR \^ +w NOT ~ +w AT * + +m Inc(1) 1++ +m Dec(1) 1-- +w Null NULL +w Void void +m Table(1) "[1]= {" +w EndTab }; + +m chr(1) (char)(1) +m Zero(1) (!(1)) +m NotZ(1) (1) + +w Pointer "void *" +w Pfile "FILE *" + +w Char "unsigned char" +w Byte "unsigned char" +w Bool "unsigned char" +w Word "unsigned short" +w Pchar "char *" + +w Intern static +w Extern extern +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 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)}" + +w Aconst(1,2,3) "2 1[3] ={" +w EndAco "};" +m Sini(1) "sini(1,sizeof(1)-04)" +m New(1) "(1 *)new(sizeof(1))" +m Dispose(1) "dispose((void *)1)" +m NewArr(1,2) "(1 *)new(sizeof(1)*2)" + diff --git a/src/frontend/numparam/general.h b/src/frontend/numparam/general.h new file mode 100644 index 000000000..1277a0af6 --- /dev/null +++ b/src/frontend/numparam/general.h @@ -0,0 +1,211 @@ +/* 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 short ...(...) 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, Pointer) +#endif +#endif + +Type(Char, unsigned char) +Type(Byte, unsigned char) +#ifndef Bool +Type(Bool, unsigned char) +#endif +Type(Word, unsigned short) +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 short 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 +#include + the function code is in 'mystring.c' . +*/ + +#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 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,2004) /* was 255, string maxlen, may be up to 32000 or so */ + +typedef char string[258]; + +Cconst(Esc, 27) +Cconst(Tab, 9) +Cconst(Bs, 8) +Cconst(Lf, 10) +Cconst(Cr, 13) + +Proc sini( Pchar s, short i); +Proc sfix(Pchar s, short i, short max); +Func short maxlen(Pchar s); +Func Pchar pscopy( Pchar s, Pchar a, short i,short j); +Func Bool scopy( Pchar a, Pchar b); +Func Bool ccopy( Pchar a, char c); +Func Bool sadd( Pchar s, Pchar t); +Func Bool nadd( Pchar s, long n); +Func Bool cadd( Pchar s, char c); +Func Bool sins( Pchar s, Pchar t); +Func Bool cins( Pchar s, char c); +Func short cpos( char c, Pchar s); +Func short spos( Pchar sub, Pchar s); + +Func short length(Pchar s); +Func Bool steq(Pchar s, Pchar t); +Func Bool stne(Pchar s, Pchar t); +Func short scompare(Pchar a, Pchar b); +Func short ord(char c); +Func short pred(short i); +Func short succ(short i); +Proc stri(long n, Pchar s); +Proc strif(long n, short f, Pchar s); +Proc strf(double x, short a, short b, Pchar s); /* float -> string */ +Func long ival(Pchar s, short *err); +Func double rval(Pchar s, short *err); + +Func char upcase(char c); +Func char lowcase(char c); +Func short hi(long w); +Func short 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); + +/***** 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); + +Func short freadstr(Pfile f, Pchar s, short max); +Func char freadc(Pfile f); +Func long freadi(Pfile f); + +Func long round(double d); +Func long trunc(double x); +Func double sqr(double x); +Func double absf(double x); /* abs */ +Func long absi( long i); +Func double frac(double x); + +Func Bool reset(Pfile f); +Func Bool rewrite(Pfile f); +Proc rawcopy(Pointer a, Pointer b, short la, short lb); +Func Pointer new(long sz); +Proc dispose(Pointer p); +Func Pchar newstring(short n); + diff --git a/src/frontend/numparam/mystring.c b/src/frontend/numparam/mystring.c new file mode 100644 index 000000000..15a9c7691 --- /dev/null +++ b/src/frontend/numparam/mystring.c @@ -0,0 +1,881 @@ +/* mystring.c Copyright (C) 2002 Georg Post + * + * This file is part of Numparam, see: readme.txt + * Free software under the terms of the GNU Lesser General Public License + */ + +#ifdef __TURBOC__ +extern unsigned _stklen= 32000; /* Turbo C default was only 4 K */ +#endif + +#include +#include +/* #include -- ceil floor */ + +#include "general.h" + +#define Getmax(s,ls) (((Byte)(s[ls+1])) Shl 8) + (Byte)(s[ls+2]) + +/***** primitive input-output ***/ + +Proc wc(char c) +Begin + fputc(c, stdout) +EndProc + +Proc wln(void) +Begin wc('\n') EndProc + +Proc ws( Pchar s) +Begin + short k=0; + While s[k] !=0 Do + wc(s[k]); Inc(k) + Done +EndProc + +Proc wi(long i) +Begin + Str(16,s); + nadd(s,i); + ws(s) +EndProc + +Proc rs( Pchar s) +Begin /*basic line input, limit= 80 chars */ + short max,i; + char c; + 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 + +Func char rc(void) +Begin + short ls; + Str(80,s); + rs(s); ls=length(s); + If ls>0 Then + return s[ls-1] + Else + return 0 + EndIf +EndProc + +/******* Strings ************ + * are 0-terminated char arrays with a 2-byte trailer: max length. + * the string mini-library is "overflow-safe" under these conditions: + * use Str(n,s) macro: define and initialize a string s of maxlen n<255 + * use sini() to initialize empty strings; sfix() for non-empty ones. + * the Sini() macro does automatic sizing, for automatic char arrays + * to allocate a string on the heap, use newstring(n). + * use maxlen() and length() to retrieve string max and actual length + * use: cadd, cins, sadd, sins, scopy, pscopy to manipulate them + * never put '\x0' characters inside strings ! + * + * the 'killer idea' is the following: + * on string overflow and/or on heap allocation failure, a program + * MUST die. + */ + +Intern +Proc stringbug(Pchar op, Pchar s, Pchar t, char c) +/* we brutally stop the program on string overflow */ +Begin + char rep=' '; + ws(" STRING overflow "); + ws(op); wln(); + ws(" Operand1: "); + ws(s); wln(); + If t != Null Then + ws(" Operand2: "); + ws(t); wln(); + EndIf + If c != 0 Then + wc('{'); wc(c); wc('}') + EndIf + ws(" [A]bort [I]gnore ? "); + rep=rc(); + If upcase(rep)=='A' Then exit(1) EndIf +EndProc + +Proc sini(Pchar s, short max) /* suppose s is allocated */ +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 + +Proc sfix(Pchar s, short i, short max) +/* suppose s is allocated and filled with non-zero stuff */ +Begin + short 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;jMaxstr Then + max=Maxstr + EndIf + s[i+1]= Hi(max); s[i+2]= Lo(max); +EndProc + +Func short length(Pchar s) +Begin + short lg=0; + While NotZ(s[lg]) Do Inc(lg) Done + return lg +EndFunc + +Func short maxlen(Pchar s) +Begin + short ls= length(s); + return Getmax(s,ls) +EndFunc + +Func Bool sadd( Pchar s, Pchar t) +Begin + Bool ok; + short i=0, max, ls= length(s); + 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 + +Func Bool sins( Pchar s, Pchar t) +Begin + short 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='a')And(c<='z') Then + return c+'A'-'a' + Else + return c + EndIf +EndFunc + +Func Bool scopy(Pchar s, Pchar t) /* returns success flag */ +Begin + Bool ok; + short 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 + +Func Pchar pscopy(Pchar s, Pchar t, short start, short leng) +/* partial string copy, with Turbo Pascal convention for "start" */ +/* BUG: position count starts at 1, not 0 ! */ +Begin + short max= maxlen(s); /* keep it for later */ + short stop= length(t); + short i; + 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; i0 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 + +Proc stri( long n, Pchar s) +/* convert integer to string */ +Begin + sini(s, maxlen(s)); + nadd(s,n) +EndProc + +Proc rawcopy(Pointer a, Pointer b, short la, short lb) +/* dirty binary copy */ +Begin + short j,n; + If lbb[j] Then + k=1 + EndIf + return k +EndFunc + +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 + +Func Bool stne(Pchar s, Pchar t) +Begin + return scompare(s,t) !=0 +EndFunc + +Func short hi(long w) +Begin + return (w AND 0xff00) Shr 8 +EndFunc + +Func short lo(long w) +Begin + return (w AND 0xff) +EndFunc + +Func char lowcase(char c) +Begin + If (c>='A')And(c<='Z') Then + return (char)(c-'A' +'a') + Else + return c + EndIf +EndFunc + +Func Bool alfa( char c) +Begin + return ((c>='a') And (c<='z')) Or ((c>='A') And (c<='Z')); +EndFunc + +Func Bool num( char c) +Begin + return (c>='0') And (c<='9'); +EndFunc + +Func Bool alfanum(char c) +Begin + return + ((c>='a') And (c<='z')) Or ((c>='A')And(c<='Z')) + Or ((c>='0')And(c<='9')) + Or (c=='_') +EndFunc + +Func short freadstr(Pfile f, Pchar s, short max) +/* read a line from a file. + BUG: long lines truncated without warning, ctrl chars are dumped. +*/ +Begin + char c; + short i=0, mxlen=maxlen(s); + 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 + +Func Pchar stupcase( Pchar s) +Begin + short i=0; + While s[i] !=0 Do + s[i]= upcase(s[i]); Inc(i) + Done + return s +EndFunc + +/***** pointer tricks: app won't use naked malloc(), free() ****/ + +Proc dispose(Pointer p) +Begin + If p != Null Then free(p) EndIf +EndProc + +Func Pointer new(long sz) +Begin + Pointer p; + If sz<=0 Then + return Null + Else +#ifdef __TURBOC__ + /* truncate to 64 K ! */ + If sz> 0xffff Then sz= 0xffff EndIf + p= malloc((Word)sz); +#else + p= malloc(sz); +#endif + If p==Null Then /* fatal error */ + ws(" new() failure. Program halted.\n"); + exit(1); + EndIf + return p + EndIf +EndFunc + +Func Pchar newstring(short n) +Begin + Pchar s= (Pchar)new(n+4); + sini(s, n); + return s +EndFunc + +/***** elementary math *******/ + +Func double sqr(double x) +Begin + return x*x +EndFunc + +Func double absf(double x) +Begin + If x<0.0 Then + return -x + Else + return x + EndIf +EndFunc + +Func long absi(long i) +Begin + If i>=0 Then + return(i) + Else + return(-i) + EndIf +EndFunc + +Proc strif(long i, short f, Pchar s) +/* formatting like str(i:f,s) in Turbo Pascal */ +Begin + short 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=(short)(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 + +Func Bool odd(long x) +Begin + return NotZ(x AND 1) +EndFunc + +Func short vali(Pchar s, long * i) +/* convert s to integer i. returns error code 0 if Ok */ +/* BUG: almost identical to ival() with arg/return value swapped ... */ +Begin + short k=0, digit=0, ls; + long z=0; + Bool minus=False, ok=True; + 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 + +Intern +Func Bool match + (Pchar s, Pchar t, short n, short tstart, Bool testcase) +Begin +/* returns 0 If tstart is out of range. But n may be 0 ? */ +/* True if s matches t[tstart...tstart+n] */ + short i,j,lt; + Bool ok; + char a,b; + i=0; j=tstart; + lt= length(t); + ok=(tstart0 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 + +Func short spos(Pchar sub, Pchar s) +/* equivalent to Turbo Pascal pos(). + BUG: counts 1 ... length(s), not from 0 like C +*/ +Begin + return posi( sub, s, 0) +EndFunc + +/**** float formatting with printf/scanf ******/ + +Func short valr(Pchar s, double *r) +/* returns 0 if ok, else length of partial string ? */ +Begin + short n=sscanf(s, "%lG", r); + If n==1 Then + return(0) + Else + return(1) + EndIf +EndFunc + +Proc strf( double x, short f1, short f2, Pchar t) +/* e-format if f2<0, else f2 digits after the point, total width=f1 */ +/* if f1=0, also e-format with f2 digits */ +Begin /*default f1=17, f2=-1*/ + Str(30,fmt); + short n,mlt; + 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,"lf") + 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 + +Func double rval(Pchar s, short *err) +/* returns err=0 if ok, else length of partial string ? */ +Begin + double r= 0.0; + short n=sscanf(s, "%lG", &r); + If n==1 Then + (*err)=0 + Else + (*err)=1 + EndIf + return r; +EndFunc + +Func long ival(Pchar s, short *err) +/* value of s as integer string. error code err= 0 if Ok */ +Begin + short k=0, digit=0, ls; + long z=0; + Bool minus=False, ok=True; + 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 + +#ifndef _MATH_H + +Func long round(double x) +/* using , it would be simpler: floor(x+0.5) */ +Begin + double u; + long z; + short 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 + +Func long trunc(double x) +Begin + long n=round(x); + If (n>x) And (x>=0.0) Then + Dec(n) + ElsIf (nu) Or (x< -u) Then + return x + Else + return trunc(x) + EndIf +EndFunc + +#else /* use floor() and ceil() */ + +Func long round(double r) +Begin + return (long)floor(r+0.5) +EndFunc + +Func long trunc(double r) +Begin + If r>=0.0 Then + return (long)floor(r) + Else + return (long)ceil(r) + EndIf +EndFunc + +Func double frac(double x) +Begin + If x>=0.0 Then + return(x - floor(x)) + Else + return(x - ceil(x)) + EndIf +EndFunc + +Func double intp(double x) /* integral part */ +Begin + If x>=0.0 Then + return floor(x) + Else + return ceil(x) + EndIf +EndFunc + +#endif /* _MATH_H */ + + diff --git a/src/frontend/numparam/ngconfig.sh b/src/frontend/numparam/ngconfig.sh new file mode 100644 index 000000000..c51b18d0b --- /dev/null +++ b/src/frontend/numparam/ngconfig.sh @@ -0,0 +1,20 @@ +#!/bin/sh + +# ngconfig.sh +# configure options for ngspice with numparam add-on +# run this in ngspice's top-level directory + +# specify your Numparam directory +HACK=/home/post/spice3f5/hack + +# over-write the original subckt.c +cp -biv $HACK/ngsubckt.c src/frontend/subckt.c + +# my box needs CFLAGS on 1st run, else 'terminal.c' wont find 'termcap.h' ? + +CFLAGS=-I/usr/include/ncurses \ +LIBS=$HACK/libnupa.a \ +./configure --without-x --prefix=/usr/local/ngsp + +#### end of sample script #### + diff --git a/src/frontend/numparam/numparam.h b/src/frontend/numparam/numparam.h new file mode 100644 index 000000000..fef250bb9 --- /dev/null +++ b/src/frontend/numparam/numparam.h @@ -0,0 +1,76 @@ +/* numparam.h */ + +/*** interface to spice frontend subckt.c ***/ + +#define NUPADECKCOPY 0 +#define NUPASUBSTART 1 +#define NUPASUBDONE 2 +#define NUPAEVALDONE 3 + +extern char * nupa_copy(char *s, int linenum); +extern int nupa_eval(char *s, int linenum); +extern int nupa_signal(int sig, char *info); + +/***** numparam internals ********/ + +#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,200) /*size of symbol table*/ + +Cconst(Llen,250) /* maximum composite input line length */ +typedef char str20 [24]; +typedef char str80 [84]; + +Cconst(Maxline, 1000) /* size of initial unexpanded circuit code */ +Cconst(Maxckt, 5000) /* size of expanded circuit code */ + + +typedef Pchar auxtable; /* dummy */ + +Record(entry) + char tp; /* type: I)nt R)eal S)tring F)unction M)acro P)ointer */ + str20 nom; + short level; /* subckt nesting level */ + double vl; /* float value if defined */ + Word ivl; /*int value or string buffer index*/ + Pchar sbbase; /* string buffer base address if any */ +EndRec(entry) + +Record(fumas) /*funtion,macro,string*/ + Word start /*,stop*/ ; /*buffer index or location */ +EndRec(fumas) + +Record(tdico) +/* the input scanner data structure */ + str80 srcfile; /* last piece of source file name */ + short srcline; + short errcount; + entry dat[Maxdico+1]; + short nbd; /* number of data entries */ + fumas fms[101]; + short nfms; /* number of functions & macros */ + short stack[20]; + short tos; /* top of stack index for symbol mark/release mechanics */ + str20 option; /* one-character translator options */ + auxtable nodetab; + Darray(refptr, Pchar, Maxline) /* pointers to source code lines */ + Darray(category, char, Maxline) /* category of each line */ +EndRec(tdico) + +Proc initdico(tdico * dico); +Func short donedico(tdico * dico); +Func Bool defsubckt( tdico *dico, Pchar s, Word w, char categ); +Func short 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); + diff --git a/src/frontend/numparam/nupatest.c b/src/frontend/numparam/nupatest.c new file mode 100644 index 000000000..f4cab88a5 --- /dev/null +++ b/src/frontend/numparam/nupatest.c @@ -0,0 +1,453 @@ +/* nupatest.c Copyright (C) 2002 Georg Post + * + * This file is part of Numparam, see: readme.txt + * Free software under the terms of the GNU Lesser General Public License + */ + +/**** test executable for the numparam library ****/ +/**** usage: nupatest ****/ + +#include + +#include "general.h" +#include "numparam.h" + +Cconst(pfxsep,'_') /* official prefix separator is ':' not '_' ! */ + +Darray(buff, Pchar, Maxline) /* input lines */ +Darray(buf2, Pchar, Maxline) /* stripped lines */ +Darray(pxbuf, Pchar, Maxline) /* prefix for subnodes */ +Darray(runbuf, short, Maxckt) /* index list of expanded circuit */ +Darray(pindex, short, Maxckt) /* prefix index list */ +short irunbuf= 0; /* count lines of runbuf */ +short ipx=0; /* count prefixes in pxbuf */ + +/* + this toy imitates the Spice subcircuit expansion. + To ckeck against Genuine Spice, use the 'listing expand' JDML command + Bug1: model or device call with parameters: incorrectly parsed + needs a database about _optional_ model/device pars... + better: Enter all .model identifiers in the symbol table ! + Bug2: nested subckt declarations, local .models: might be dangerous. + expanded circuit lines, device/node names: + any line that starts with a letter (device): splice the prefix in + any node that isnt a formal param: add the prefix + any formal param node: substitute actual params and their prefixes + +Node and subdevice references for prefixing: + +deviceletter[n] is a device type prefix +nbofnodes [n] is the number of "node-type" arguments that follow. +nbsubdevice [n] is the number of "subdevices" for splice-in prefix. + +To solve the Q ambiguity, forbid any model identifiers as node names. + +Bug3: +In arbitrary dependent sources, we must parse v(,) and i(,) expressions +and substitute node/device name arguments. + +*/ + +Func short runscript( tdico *dico, Pchar prefix, + short istart, short istop, short maxnest) +/* recursive top-down expansion: circuit --> list of line numbers */ +/* keep it simple,stupid compared to Spice's code */ +/* prefix: inherited string for node & device prefixing */ +/* istart, istop: allowed interval in table buf[], buf2[]. */ +/* return value: number of lines included */ +Begin + short i,j, idef, nnest, nline, dn, myipx; + Str(250, subpfx); /* subckt prefix */ + Str(80, subname); + char c; + Bool done= False; + i=istart; + nline=0; + Inc(ipx); myipx= ipx; /* local copy */ + pxbuf[ipx]= newstring( length(prefix)); + scopy( pxbuf[ipx], prefix); + While (maxnest>0) And (icategory[i]; + If c=='U' Then + done=True; /* subcircuit end. Keep as a comment? */ + buf2[i][0]='#'; + EndIf + If c=='S' Then /* skip nested subcircuits */ + nnest=1; + Repeat + 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 ! */ + 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 + 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 + dn= runscript(dico, subpfx, idef+1, istop, maxnest-1); + nline= nline+dn; + Else /* FIXME: error message here! */ + ws("cannot find subckt "); ws(buf2[i]); wln(); + EndIf + ElsIf (c != '?') And NotZ(buf2[i][0]) Then + /* 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 + +Proc gluepluslines( short imax) +/* general sweep to eliminate continuation lines */ +Begin + short i,j,k, ls, p; + Str(250,s); + i=1; + While i<= imax Do + If (buff[i][0]=='+') And (i>1) Then + j= i-1; + While (i < imax) And (buff[i+1][0]=='+') Do Inc(i) Done + /* the lines j+1 ... i are continuation lines to j */ + For k=j; k<=i; Inc(k) Do + 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 + ls= length(s); + If ls> 80 Then + Dispose(buff[j]); + buff[j]=newstring(ls) + EndIf + scopy(buff[j], s) + EndIf + Inc(i) + Done +EndProc + +#if 0 +Proc rs(Pchar s) /* 78 coumn limit */ +Begin + short i; + Bool done; + char c; + short max=maxlen(s); + If max>78 Then max=78 EndIf + i=0; done=False; + scopy(s,""); + While Not done Do + c=fgetc(stdin); + If (c>=' ')And(c<='~') And (i0) Then + pscopy(s,s,1,ls-1) + EndIf /* kill EOF character */ +EndProc + +Proc wordinsert(Pchar s, Pchar w, short i) +/* insert w before s[i] */ +Begin + Str(250,t); + short ls=length(s); + pscopy(t,s,i+1,ls); pscopy(s,s,1,i); + sadd(s,w); sadd(s,t); +EndProc + +Func short worddelete(Pchar s, short i) +/* delete word starting at s[i] */ +Begin + Str(250,t); + short ls= length(s); + short j=i; + While (j' ') Do Inc(j) Done + pscopy(t,s,j+1,ls); + pscopy(s,s,1,i); + sadd(s,t); + return j-i /* nb of chars deleted */ +EndProc + +Func short getnextword(Pchar s, Pchar u, short j) +Begin + short ls,k; + ls= length(s); + k=j; + While (j ' ') Do Inc(j) Done /* skip current word */ + pscopy(u, s, k+1, j-k); + While (j0 Then + For k=0; k' ' Do + cadd(u,wl[i]); Inc(i) + Done + EndIf +EndProc + +Pchar deviceletter= "RLCVIBSGETOUWFHDQKJZM"; +Pchar nbofnodes = "222222444443222240334"; +Pchar nbsubdevice = "000000000000111002000"; + +Proc prefixing(Pchar s, Pchar p, Pchar formals, Pchar actuals, + char categ, tdico *dic) +/* s is a line in expanded subcircuit. + p is the prefix to be glued anywhere . + assume that everything except first and last word in s may be a node. + formals: node parameter list of a subckt definition line + actuals: substitutes from the last X... call line (commented-out) + subdevices (L belonging to a K line, for example) must be within the + same subckt, they get the same prefix splice-in. + There is a kludge for Q lines (may have 3 or 4 nodes, you never know). +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 + short i,j,k,ls, jnext, dsize; + short dtype, nodes, subdv; + Bool done; + char leadchar; + Str(80,u); Str(80,v); Str(80,pfx); + i=0; ls=length(s); + While (i= 0 Then + nodes= nbofnodes[dtype] - '0'; + subdv= nbsubdevice[dtype] - '0'; + Else + nodes=999; subdv=0; + EndIf + While Not done Do + 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 */ + 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 */ + k= inwordlist(u, formals); + If (k>0) Then /* 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 */ + wordinsert(s,pfx,j); + dsize= length(pfx); + Else dsize=0 EndIf + ElsIf (Not done) And (subdv >0) Then /* 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 + +Proc getnodelist(Pchar form, Pchar act, Pchar s, tdico *dic, short k) +/* the line s contains the actual node parameters, between 1st & last word */ +Begin + short j,ls, idef; + Str(80,u); Str(250,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 + 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 + 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 + Dispose(actuals[i]); + Dispose(formals[i]); + Done + For i= Maxline -1; i>=0; Dec(i) Do + Dispose(pxbuf[i]); + Dispose(buf2[i]); + /* Dispose(buff[i]) done elsewhere */ + Done +EndProc + +Func int main(int argc, Pchar argv[]) +Begin + Str(80,fname); + If argc>1 Then + scopy(fname, argv[1]) + Else + scopy(fname,"testfile.nup") + EndIf + nupa_test(fname, 'w'); + return 0 +EndFunc + diff --git a/src/frontend/numparam/readme.txt b/src/frontend/numparam/readme.txt new file mode 100644 index 000000000..d83d6cf0e --- /dev/null +++ b/src/frontend/numparam/readme.txt @@ -0,0 +1,674 @@ +******************************************************** +README.TXT the minimal Numparam documentation +******************************************************** + +Numparam: an add-on library for electronic circuit analysis front-ends +Copyright (C) 2002 Georg Post + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + +CONTENTS + +A. The Numparam library +B. Circuit description with Numparam (in lieu of a tutorial) +C. Reference section +D. Installation +E. Theory of operation +F. Files in this package +G. Known bugs + + +A. The Numparam library: + +The spice-3f(x) front end lacks some features of commercial derivatives, +such as the ability to define numerical attributes of devices by symbols +or by constant (at circuit-expansion time) numerical expressions. +Numerical parameters - other than node names - for subcircuits are also +commonly available in these non-free Spices. + +This library provides a retrofit to the Spice circuit description language +to add these features. By design, the new code is organized as an independent +library which does not import any Spice header files and whose only interface +to Spice is a set of three function headers. The only place where these +functions are called - if a new compile-time option for Spice is set - is +the code file src/lib/fte/subckt.c. There are no patches anywhere else. + +The purpose of this minimal coupling was to freely license the additional code. +It is distributed under the GNU-LGPL and thus can be linked to the original +Spice which is open-source software but maintains a special license. +(As I read somewhere, Berkeley Spice is reserved to people friendly to the USA). +Due to GPL-type requirements, I cannot merge any lines from Spice with +the new code, and I cannot avoid redundancies, such as one more symbol table +manager and the umpteenth arithmetic expression parser. + +Coding style of my add-on is a bit personal. Using a set of keyword-hiding +macros, it is closer to Pascal and/or Basic than to authentic C programs. +Most of it originated from my initial Turbo Pascal preprocessors that have been +translated to C. After all, I'm definitely not "friendly to the C language". +Even in disguise, the code is pure Ansi-C and compiles without a warning +under the severest settings of gcc (under GNU/Linux) or Turbo C++ (under +MS-DOS). For C hardliners, I include the 'washprog' utility which downgrades +the source code to the common C look-&-feel. Extreme purists might apply +some appropriate "indent" utility, in addition. + + +B. Circuit description with Numparam (in lieu of a tutorial). + +As we now know, all the text entry to Spice comes in two separate languages: +- a circuit description language (CDL) which defines the electronic hardware. +- an analysis job and data management language (JDML) which may be used + as an interactive shell or in batch files. + +In the circuit description "CDL" file, the design is typically organized +as a hierarchical set of subcircuits which are connected together in +the 'main' circuit (they are "called", like procedures in a general-purpose +programming language). CDL is line-oriented, with a recognizer role assigned +to the first non-space character of a line. +(In the ancient times of data processing, a line was called a "card".) +For example, '*' introduces comment lines. 'C' places a capacitor +device in the circuit, 'R' a resistor, 'L' an inductor, and so on. +'X' signals the "call" of a subcircuit. Character '+' introduces a continuation +line (the way to split exceedingly long lines into pieces). + +A special class of lines that start with a dot '.' have control functions +inside CDL: they do not add physical circuit elements. +For instance, the control pair '.subckt' and '.ends' brackets a subcircuit +definition section in CDL. +In the old days of Spice-2, some of the functions now assigned to JDML were +also inserted as dot cards. You can still insert pieces of JDML inside +a CDL file, as a section enclosed within lines '.control' and '.endc' . + +Example CDL file, a netlist of some double T RC-filter: + +* First-example +.subckt myfilter in out +Ra in p1 2k +Rb p1 out 2k +C1 p1 0 2nF +Ca in p2 1nF +Cb p2 out 1nF +R1 p2 0 1k +.ends myfilter + +X1 input output myfilter +V1 input 0 AC 1V + + +Let us recall what the Spice "front-end" essentially does to your +circuit-description (CDL) file whenever it is submitted, either at program +start-up or after some interactive JDML commands like 'edit' or 'source'. +First, all the JDML sections in the file are sorted out and kept for +later use (unless the file is pure JDML and thus immediately executed). +Next, the hierarchy of subcircuits is expanded and an internal representation +of the flattened circuit is stored, i.e. a set of CDL lines without any more +'X' and '.subckt' lines. This flat circuit is also known as the "netlist". +Then, the netlist is translated into the internal data structures of Spice, +essentially a sparse matrix of elements indexed by pairs of circuit nodes. + +Finally, the mathematical analysis is carried out under the control of JDML, +and output data may be stored, printed, plotted, compared, and so on. +Analyses may be repeated under varying bias/frequency/time... conditions. +But to change the circuit topology, the CDL must be edited and re-compiled. + +Numparam-specific features of CDL : + +The Numparam library is an enhancement of the Spice front-end which adds +clarity and arithmetic functionality to the circuit description language. + +The most wanted feature of a language is to have word-like symbols that +take the place of specific values or objects. The dot-line + +.param = + +defines such symbols. For example, to describe a triple RC filter +with identical values of components, we do not need to explicitly +repeat constant numbers. The CDL code may go like this: + + .param res= 1kohm // numparam allows comment tails like in C++ + .param tau= 10ns // we want a time constant + .param cap= tau/res // tau= RC, of course + + .subckt triplerc in out + R1 in p1 {res} + C1 p1 0 {cap} + R2 p1 p2 {res} + C2 p2 0 {cap} + R3 p2 out {res} + C3 out 0 {cap} + .ends + +As you can see, the use of symbols anywhere in the circuit description +requires the curly braces : + { } +This coding style is even more interesting if circuit elements have known +fixed ratios (Butterworth filters and the like) and we only need to +touch one value (a time constant) to tune the circuit. + +Only numerical constants such as '30pF' may be used without enclosing +braces. It is the braces that tell our CDL front-end to look up +symbols and to crunch arithmetic expressions inside. + +Obviously, it was restrictive that subcircuit definitions could only +accept interface node names as symbolic parameters. With the following +syntax of the .subckt line, we add numerical parameters: + + .subckt ... params: = = ... + +Example, a parameterized filter: + + .subckt triplerc2 in out params: res=1kohm cap=50pF + * all the following lines as above. + * the specified default values are always overridden with X lines. + +To call variants of such a subcircuit later on, we may write: + + X1 in out1 triplerc2 {r1} {c1} + X2 in out2 triplerc2 {2*r1} {c1/2} + X3 in out3 triplerc2 {3*r1} {c1/3} + +where the r1 and c1 symbols are defined in .param lines. +So, we can use subcircuits with one or more parameters, the same way +as Spice2 already allowed an area parameter for diodes and transistors. + + +Here is the first example, rewritten with parameters: + +* Param-example +.param amplitude= 1V + +.subckt myfilter in out ++ params: rval=100k cval= 100nF +Ra in p1 {2*rval} +Rb p1 out {2*rval} +C1 p1 0 {2*cval} +Ca in p2 {cval} +Cb p2 out {cval} +R1 p2 0 {rval} +.ends myfilter + +X1 input output myfilter 1k 1nF +V1 input 0 AC {amplitude} + + +Note: +Now, there is some possible confusion in Spice because of multiple numerical +expression features. The .param lines and the braces expressions are +evaluated in the front-end, that is, just after the subcircuit expansion. +(Technically, the X lines are kept as comments in the expanded circuit +so that the actual parameters can correctly be substituted ). +So, after the netlist expansion and before the internal data setup, all +number attributes in the circuit are known constants. + However, there are some circuit elements in Spice which accept arithmetic +expressions that are NOT evaluated at this point, but only later during +circuit analysis. These are the arbitrary current and voltage sources. +The syntactic difference is that "compile-time" expressions are +within braces, but "run-time" expressions have no braces. + To make things more complicated, the backend language JDML also accepts +arithmetic/logic expressions that operate on its own scalar or vector data sets. + +It would be desirable to have the same expression syntax, operator and function +set, and precedence rules, for the three contexts mentioned above. +In the current Numparam implementation, that goal is not yet achieved... + + +C. Reference section: + +The Numparam add-on supports the following elements in the circuit description +language. + +1. '.param' control lines to define symbolic numbers +2. arithmetic expressions in place of any numeric constant +3. formal and actual numeric parameters for subcircuit definition and 'call'. + +NOT YET IMPLEMENTED: + To activate the additional functions, put a line near the top of the CDL file: + .option numparam + +In the syntax description, + means an alphanumeric identifier (<20 chars, starting with a letter) + means an expression, composed of s, Spice numbers, and operators. + +1. The .param line: + Syntax: .param = ; = .... + + This line assigns numerical values to identifiers. More than one assignment + per line is possible using the ';' separator. + The .param lines inside subcircuits are copied per call, like any other line. + All assignments are executed sequentially through the expanded circuit. + Before its first use, a name must have been assigned a value. + +2. Brace expressions in cicuit elements: + Syntax: { } + + These are allowed in .model lines and in device lines, wherever only constant + Spice numbers could be used in spice2/3. A Spice number is a floating + point number with an optional scaling suffix, immediately glued to the + numeric tokens (see below). + Warning: {..} cannot be used to 'parameterize' node names or parts of names. + ( We are not into obfuscated shell scripting ...) + All identifiers used within an must have known values at the time + when the line is evaluated, else an error is flagged. + +3. Subcircuit parameters: + The syntax of a subcircuit definition header is: + .subckt node node ... params: = =... + + node is an integer number or an identifier, for one of the external nodes. + The 'params:' keyword introduces an optional section of the line. + Each is a formal parameter, and each is either a Spice + number or a brace expression. + Inside the '.subckt' ... '.ends' context, each formal parameter may be + used like any identifier that was defined on a .param control line. + The parts are supposed to be default values of the parameters. + However, in the current version of Numparam, they are not used and each + invocation of the subcircuit must supply the _exact_ number of actual + parameters. + + The syntax of a subcircuit call (invocation) is: + X node node ... .... + + Here is the symbolic name given to that instance of the subcircuit, + is the name of a subcircuit defined beforehand. node node ... is + the list of actual nodes where the subcircuit is connected. + is either a Spice number or a brace expression { } . + The sequence of items on the X line must exactly match the number + and the order of formal parameters of the subcircuit. + +4. Symbol scope + + All Subcircuit and Model names are considered global and must be unique. + The .param symbols that are defined outside of any '.subckt' ... '.ends' + section are global. Inside such a section, the pertaining 'params:' + symbols and any .param assignments are considered local: they mask any + global identical names, until the .ends line is encountered. + You cannot reassign to a global number inside a .subckt, a local copy is + created instead. Scope nesting works up to a level of 10. For example, + if the main circuit calls A which has a formal parameter xx, A calls B + which has a param. xx, and B calls C which also has a formal param. xx, + there will be three versions of 'xx' in the symbol table but only the most + local one - belonging to C - is visible. + +5. Syntax of expressions ( optional parts within [ ...] ): + + An expression may be one of: + where is either a Spice number or an identifier + + ( [ , ...] ) + + ( ) + + As expected, atoms, builtin function calls and stuff within parentheses + are evaluated before the other operators. The operators are evaluated + following a list of precedence close to the one of the C language. + For equal precedence binary ops, evaluation goes left to right. + + Operators: Alias Internal symb. Precedence + + - - 1 (unary -) + not ! ! 1 (unary not) + ** ^ ^ 2 (power) + * * 3 (multiply) + / / 3 (divide) + mod % % 3 (modulo) + div \ \ 3 (integer divide) + + + 4 (add) + - - 4 (subtract) + == = 5 (equality) + <> != # 5 (un-equal) + <= L 5 (less or equal) + >= G 5 (greater or equal) + < < 5 (less than) + > > 5 (greater than) + and && & 6 (and) + or || | 7 (or) + + The result of logical operators is 1 or 0 , for True or False. + + + Builtin functions: Internal ref. + + defined 0 (returns 1 if symbol is defined, else 0) + sqr 1 + sqrt 2 + sin 3 + cos 4 + exp 5 + ln 6 + arctan 7 + abs 8 + pwr 9 + + Scaling suffixes (any decorative alphanum. string may follow ...) + + g 1e9 + meg 1e6 + k 1e3 + m 1e-3 + u 1e-6 + n 1e-9 + p 1e-12 + f 1e-15 + + Note: there are intentional redundancies in expression syntax, e.g. + x^y , x**y and pwr(x,y) all have nearly the same result. + +6. Reserved words + In addition to the above function names and to the verbose operators + ( not and or div mod ), other words are reserved and cannot be used + as parameter names. Historically, they come from a version of Numparam + that was a full-blown macro language. I won't link that one to Spice, + not before somebody proves to me that such a thing could be useful... + + and or not div mod if else end while macro funct defined + include for to downto is var + sqr sqrt sin cos exp ln arctan abs pwr + + +7. Alternative syntax + the & sign is tolerated to provide some 'historical' parameter notation: + & as the first character of a line is equivalent to: .param + Inside a line, the notation &(....) is equivalent to {....}, and + &identifier means the same thing as {identifier} . + + This notation exists a bit for the same reason as my macros which wipe + the curly braces out of the C language: entering those signs is a pain in + the neck on IBM French-type keyboards. You hit, among others, a vanishingly + small AltGr key which is squeezed by superfluous buttons that show ugly + office-software logos... + + Comments in the style of C++ line trailers (//) are detected and erased. + Warning: this is NOT possible in embedded .control parts of a source + file, these JDML lines are outside of Numparam's scope. DOS-style + carriage returns at line ends are difficult for JDML, too. + + +D. Installation + +There are two versions of Spice on which this library has been tried: +a. a 1997 version spice3f5 that was arranged for Red Hat Linux +b. the version 14 of ngspice (will now be privileged for development) + +On my system, the size of libnupa.a is about 47k, so this is the additional +bloat that the spice3 and nutmeg binary programs will accumulate. +( The numparam source tarball weighs in for some 70k ) + +The common part to build the Numparam library is this: + +0. choose any directory you like for Numparam, let's call it $HACK. +1. un-tar the .c and .h files and the rest, in Numparam's directory : + tar xzvf numparam.tgz + +2. compile the lib sources with gcc -c -Wall: + + gcc -c -ansi -pedantic -Wall spicenum.c nupatest.c xpressn.c mystring.c + +3. pre-link together the library part to numparam.o and libnupa.a: + + ld -r -o numparam.o spicenum.o xpressn.o mystring.o + ar -rcs libnupa.a spicenum.o xpressn.o mystring.o + +4. make the test executable nupatest: + + gcc -o nupatest nupatest.o spicenum.o xpressn.o mystring.o -lm + +The script file 'mknumpar.sh' does all this (2-4). + + +5a. Link with the "third version of Spice3f5 for RedHat Linux 2.6" (1997) + + do the following in the spice3f5 top-level directory: + + 1. patch the file src/lib/fte/subckt.c : + cp -biv $HACK/rhsubckt.c src/lib/fte/subckt.c + 2. edit src/bin/makeops , to add $HACK/libnupa.a to LIBS and LIBN. + 3. ./util/build linux + 4. ./util/build linux install + + +5b. Link procedure for ngspice version 14 + +I haven't yet a working knowledge of the 'automake/autoconf' system, so I'll +describe the pedestrian hacks to get Numparam in. That's evil; the right way +would need a configuration flag that chooses to make and to link the library. +Only the top level files 'configure.in' and 'Makefile.am' should be revised +to process the numparam option. (?) +Help! + +1. replace the file src/frontend/subckt.c with Numparam's patched version : + cp -biv $HACK/ngsubckt.c src/frontend/subckt.c +2. run ./configure with a "LIBS prefix" to include numparam (see below) +3. make +4. make install + +Here is one "prefixed" ngspice configure script that works on my system: + +#!/bin/sh + +# ngconfig.sh +# configure options for ngspice with numparam add-on +# run this in ngspice's top-level directory + +# specify your Numparam directory +HACK=/home/post/spice3f5/hack + +# over-write the original subckt.c +cp -biv $HACK/ngsubckt.c src/frontend/subckt.c + +# my box needs CFLAGS on 1st run, else 'terminal.c' wont find 'termcap.h' ? + +CFLAGS=-I/usr/include/ncurses \ +LIBS=$HACK/libnupa.a \ +./configure --without-x --prefix=/usr/local/ngsp + +#### end of sample script #### + + +E. Theory of operation + +Spice's front end does a lot of malloc/free type memory gymnastics and does not +seem to care much about small leaks here and there. Numparam will do some +malloc'ing in place of Spice (essentially the translated strings of the input +deck) and rely on Spice to clean it up - or not - later on. My library will +clean up its private space only (the symbol tables) and will make some +assumptions about the interface function calls coming from Spice. +Here is the scenario supposed to be followed by Spice and Numparam: + +0. the patched codefile subckt.c imports the following header lines: + +#define NUPADECKCOPY 0 +#define NUPASUBSTART 1 +#define NUPASUBDONE 2 +#define NUPAEVALDONE 3 + +extern char * nupa_copy(char *s, int linenum); +extern int nupa_eval(char *s, int linenum); +extern int nupa_signal(int sig); + +These are the three library functions called, i.e. + +- nupa_copy by inp_subcktexpand to preprocess all extended-syntax lines. +- nupa_eval by inp_subcktexpand to do the parameter substitutions +- nupa_signal with one of the 4 signals, from various places to + send state information to the Numparam library. + +The only places with numparam patches are the functions +inp_subcktexpand() and its recursive subroutine doit(), in the +file subckt.c . At this stage, we suppose that: +- any .control sections are filtered out +- any .include are expanded +- any + continuation line chunks are glued together + +1. In the first phase, Numparam runs through the deck (whose .control sections + have already been removed by Spice) to create copies of the lines + without the extended syntax. Pointers to the original deck lines are kept + and the copies are traditional Spice, with placeholders for + symbols and expressions. Spice loses the originals and gets the bleached-out + copies. + +2. The "doit()" circuit expansions are modified to keep more information. + Contrary to the initial Spice code, now the subcircuit invocation + lines are preserved as comments, which allows Numparam to update + symbolic subcircuit parameters a bit later. Subcircuit exit lines are also + copied and out-commented, to keep track of identifier scopes during + the final pass. + +If this seems waste of storage, just consider all those sloppy memory +leaks in the circuit expansion code... + +3. The final wash-up is a sequential call to the library (nupa_eval()) + line-by-line through the expanded circuit. By using its pointers + to the original lines, Numparam recovers the added syntax features. + It triggers all the symbol value computations and inserts constant + numbers into the circuit definition lines, whose length must not change! + This option is a kludge to avoid memory reallocation [ my intuitive + fear is that these free() malloc() realloc() and friends swallow a lot of + CPU time ? ]. + +4. The termination signal at the end of inp_subcktexpand() tells the Numparam + library to clean up its mess, release its pointers to the original + Spice circuit description text, and to get prepared for another run. + Note: Numparam frees the storage related to the original lines + whose pointers have been stolen in phase 1. + + +In a future release, Numparam will be re-entrant, all its 'global' data being +referenced via a handle which the client program should keep around. + + +F. Files in this package + +The following Ansi C code files belong to Numparam: + +general.h header file with macros to disguise the C language. + stuff for an 'overflow-safe' string library ( whose biggest bug + is that it indexes strings from 1 like Pascal). + +numparam.h header file for numparam-specific symbols and functions + +mystring.c collection of 'safer' character string (and misc.) functions. + beware of the nasty Turbo Pascal conventions. + +xpressn.c the interpreter of arithmetic/logical expressions + +spicenum.c the interface part, functions that are called by Spice. + +nupatest.c a stand-alone subcircuit expander, for test purpose. + +washprog.c a program that washes all the above C files, including itself, + to recover the crude syntax of the True Language (see below). + +Patched versions of spice's subckt.c file incorporate the library calls +and maybe try to repair some memory leaks (in rhsubckt.c, not yet tested). + +rhsubckt.c for spice3f5 1997 Red Hat (src/lib/fte/subckt.c) +ngsubckt.c for ngspice version 14 (src/frontend/subckt.c) +subckt.dif 'diff' between ngsubckt.c and ngspice frontend/subckt.c + +The following text, data and script files are also included: + +readme.txt this documentation file +downgrad.txt the substitution rules required for washprog.c +mknumpar.sh script to make the library binaries +ngconfig.sh sample script to run ./configure for ngspice + +configure.in crappy ? +Makefile.am crappy ? + +testfile.nup a test text (nonsense circuit) for Numparam ? + + +So, if you are a Real Programmer, think that the Pascal amateurs confound +programming with writing novels, and find those Basic greenhorns' style +too childish, then execute the following two-liner first of all +(should work on GNU/Linux, but it's not a speed monster) : + +gcc -o washprog washprog.c mystring.c +./washprog *.c + +You get all the *.c files in a version where the first character becomes an +underbar, and the interior resembles to _code_. (although it lacks such +powerful features as continue, break, goto, ?:-expressions, gets(), ... ) + + +G. Known Bugs + +First of all, lots of size limits - incompatible with the Spirit of the +Gnu, who wants that everything may grow as much as malloc() can grab ... + +- circuit source code line length: 80 chars +- circuit '+' extended code lines: 250 chars +- number of source lines: 1000 +- number of lines in expanded circuit: 5000 +- length of numparam identifiers: 20 chars +- number of numparam identifiers: 200 +- length of file names: 80 chars +- significant digits in param results: 5 +- nesting depth of parentheses 9 +- nesting of subckt calls 10 + +All these constants should be in the header file but aren't. + +After each circuit expansion, numparam asks a silly question +of the "Abort/Continue" type. A debugging feature, to be killed soon. + +The Numparam symbol table accumulates the following sets of names: +subcircuits, models, global parameters, subcircuit arguments. +Node names, however, are completely ignored. + +Call the following "bugs" or "features": +- A model/subckt name cannot be defined twice, even if local to a subcircuit. +- The same name cannot design a model here, and a parameter elsewhere. +- A subcircuit argument masks any global parameter of same name, + anytime the subckt is invoked. Inside a .subckt context, .param assignments + also have local scope and override global identical names. + +It is wise to always use unique names for everything. + + +While Numparam is in 'early beta stage', I strongly suggest to use +'nupatest' first, on any 'parameterized' Spice circuit file, +before starting the enhanced circuit analyser. + +The command + nupatest foobar.cir +produces an output file 'foobar.out' which is the expanded and +parameter-reduced flat netlist. +By the way, it produces error messages whenever it chokes on the source file. +If nupatest succeeds, the spice+numparam combo should swallow it, too. +Big bug: Nupatest does not yet prefix and infix things inside v() and i(). + + +Numparam comes with two very experimental files 'configure.in' and +'Makefile.am' as an exercise of the automake/autoconf mechanisms. +I certainly got a lot of things wrong and had to do _eight_ steps to +have it kind of work: + +1. edit/create configure.in +2. edit/create Makefile.am +3. run autoheader --> config.h.in +4. run automake --foreign --add-missing --verbose --> Makefile.in +5. run aclocal --> aclocal.m4 +6. run autoconf --> configure +7. run ./configure --> Makefile config.h +8. run make + +Do we need all this, and -worse- do we need to repeat it whenever we touch +'configure.in' and/or 'Makefile.am' ? Help! + + +Please send your bug reports, improvements, flames etc. to the author: +georg.post @ wanadoo.fr + diff --git a/src/frontend/numparam/spicenum.c b/src/frontend/numparam/spicenum.c new file mode 100644 index 000000000..12c1b8e84 --- /dev/null +++ b/src/frontend/numparam/spicenum.c @@ -0,0 +1,550 @@ +/* spicenum.c Copyright (C) 2002 Georg Post + * + * This file is part of Numparam, see: readme.txt + * Free software under the terms of the GNU Lesser General Public License + */ + +/* number parameter add-on for Spice. + to link with mystring.o, xpressn.o (math formula interpreter), + and with Spice frontend src/lib/fte.a . + Interface function nupa_signal to tell us about automaton states. +Buglist (some are 'features'): + blank lines get category '*' + inserts conditional blanks before or after braces + between .control and .endc, flags all lines as 'category C', dont touch. + there are reserved magic numbers (1e9 + n) as placeholders + control lines must not contain {} . + ignores the '.option numparam' line planned to trigger the actions + operation of .include certainly doesnt work + there are frozen maxima for source and expanded circuit size. +Todo: + add support for nested .if .elsif .else .endif controls. +*/ + +#include +#ifdef __TURBOC__ +#include /* exit() */ +#endif + +#include "general.h" +#include "numparam.h" + +/* the nupa_signal arguments sent from Spice: + + sig=1: Start of the subckt expansion. + sig=2: Stop of the subckt expansion. + sig=3: Stop of the evaluation phase. + sig=0: Start of a deck copy operation + + After sig=1 until sig=2, nupa_copy does no transformations. + At sig=2, we prepare for nupa_eval loop. + After sig=3, we assume the initial state (clean). + + In Clean state, a lot of deckcopy operations come in and we + overwrite any line pointers, or we start a new set after each sig=0 ? + Anyway, we neutralize all & and .param lines (category[] array!) + and we substitute all {} &() and &id placeholders by dummy numbers. + The placeholders are long integers 1000000000+n (10 digits, n small). + +*/ +/********** string handling ***********/ + +#define PlaceHold 1000000000L +Intern long placeholder= 0; + +Intern +Func short stripcomment( Pchar s) +/* allow end-of-line comments in Spice, like C++ */ +Begin + short 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 + +Intern +Proc stripsomespace(Pchar s, Bool incontrol) +Begin +/* iff s starts with one of some markers, strip leading space */ + Str(12,markers); + short 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 + +#if 0 /* unused? */ +Proc partition(Pchar 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 + Str(Llen,u); + short 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); + 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 + +Intern +Func short findsubname(tdico * dico, Pchar s) +/* truncate the parameterized subckt call to regular old Spice */ +/* scan a string from the end, skipping non-idents and {expressions} */ +/* then truncate s after the last subckt(?) identifier */ +Begin + Str(80, name); + short h,j,k,nest,ls; + 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 alfa(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 new style with braces. */ +Begin + Str(250,t); + short 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 + +Intern +Func char transform(tdico * dico, Pchar s, Bool nostripping, Pchar u) +/* line s is categorized and crippled down to basic Spice + * returns in u control word following dot, if any + * + * any + line is copied as-is. + * any & or .param line is commented-out. + * any .subckt line has params section stripped off + * any X line loses its arguments after circuit name + * any &id or &() or {} inside line gets a 10-digit substitute. + * + * strip the new syntax off the codeline s, and + * return the line category as follows: + * '*' comment line + * '+' continuation line + * ' ' other untouched netlist or command line + * 'P' parameter line, commented-out; (name,linenr)-> symbol table. + * 'S' subckt entry line, stripped; (name,linenr)-> symbol table. + * 'U' subckt exit line + * 'X' subckt call line, stripped + * 'C' control entry line + * 'E' control exit line + * '.' any other dot line + * 'B' netlist (or .model ?) line that had Braces killed + */ +Begin + Str(Llen,t); + char category; + short i,k, a,n; + i=stripcomment(s); + stripsomespace(s, nostripping); + modernizeex(s); /* required for stripbraces count */ + scopy(u,""); + If s[0]=='.' Then /* check Pspice parameter format */ + scopy(t,s); + stupcase(t); + k=1; + While t[k]>' ' Do + cadd(u, t[k]); Inc(k) + Done + If spos(".PARAM",t) ==1 Then /* comment it out */ + s[0]='*'; + category='P'; + ElsIf spos(".SUBCKT",t) ==1 Then /* split off any "params" tail */ + a= spos("PARAMS:",t); + If a>0 Then + pscopy(s,s,1,a-1); + EndIf + category='S'; + ElsIf spos(".CONTROL",t) ==1 Then + category='C' + ElsIf spos(".ENDC",t) ==1 Then + category='E' + ElsIf spos(".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 */ + pscopy(s,s,1,i); + 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 + +/************ core of numparam **************/ + +/* some day, all these nasty globals will go into the tdico structure + 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= True; /* for debugging */ +Intern Bool firstsignal=True; +Intern Pfile logfile= Null; +Intern tdico * dico=Null; + +/* already part of dico : */ +/* Str(80, srcfile); source file */ +/* Darray(refptr, Pchar, Maxline) pointers to source code lines */ +/* Darray(category, char, Maxline) category of each line */ + +Intern +Proc putlogfile(char c, int num, Pchar t) +Begin + Str(Llen, u); + If dologfile And (logfile != Null) Then + cadd(u,c); nadd(u,num); + cadd(u,':'); cadd(u,' '); + sadd(u,t); cadd(u,'\n'); + fputs(u,logfile); + EndIf +EndProc + +Intern +Proc nupa_init( Pchar srcfile) +Begin + short i; + Str(20,fname); + /* init the symbol table and so on, before the first nupa_copy. */ + evalcount=0; + linecount= 0; + incontrol=False; + placeholder= 0; + /* If logfile != Null Then fclose(logfile) EndIf */ + If dologfile And (logfile==Null) Then + scopy(fname,"logfile."); + Inc(nblog); nadd(fname,nblog); + logfile=fopen(fname, "w"); + EndIf + dico= New(tdico); + initdico(dico); + For i=0; irefptr[i]= Null; + dico->category[i]='?'; + Done + Sini(dico->srcfile); + If srcfile != Null Then scopy(dico->srcfile, srcfile) EndIf +EndProc + +Intern +Proc nupa_done(void) +Begin + short i; + Str(80,rep); + short 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; + /* 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("Expansion "); + If Zero(nerrors) Then ws("done") Else ws("errors") EndIf + ws(": Really run Spice y/n ? \n"); + rs(rep); + If upcase(rep[0]) != 'Y' Then exit(-1) EndIf + linecount= 0; + evalcount= 0; + placeholder= 0; + /* release symbol table data */ +EndProc + +Func Pchar nupa_copy(Pchar s, int linenum) +/* returns a copy (not quite) of s in freshly allocated memory. + linenum, for info only, is the source line number. + 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 + 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 + Str(250,u); + Str(250,keywd); + Pchar t; + short i,ls; + char c,d; + ls= length(s); + While (ls>0) And (s[ls-1]<=' ') Do Dec(ls) Done + pscopy(u,s, 1,ls); /* strip trailing space, CrLf and so on */ + 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 + fputs(" Numparam warning: overwriting P,S or X line.\n",stderr); + EndIf + If c=='S' Then + defsubckt( dico, s, linenum, 'U' ) + ElsIf steq(keywd,"MODEL") Then + defsubckt( dico, s, linenum, 'O' ) + EndIf; /* feed symbol table */ + dico->category[linenum]= c; + EndIf /* keep a local copy and mangle the string */ + ls=length(u); + t= NewArr( char, ls+1); /* == (Pchar)malloc(ls+1); */ + If t==NULL Then + fputs("Fatal: String malloc crash in nupa_copy()\n", stderr); + exit(-1) + Else + For i=0;i<=ls; Inc(i) Do + t[i]=u[i] + Done + If Not inexpansion Then + putlogfile(dico->category[linenum],linenum,t) + EndIf; + EndIf + return t +EndFunc + +Func int nupa_eval(Pchar 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. + All the X lines are preserved (commented out) in the expanded circuit. +*/ +Begin + short idef; /* subckt definition line */ + char c; + Str(80,subname); + dico->srcline= linenum; + c= dico->category[linenum]; + If c=='P' Then /* evaluate parameters */ + nupa_assignment( dico, dico->refptr[linenum] , 'N'); + ElsIf c=='B' Then /* substitute braces line */ + nupa_substitute( dico, dico->refptr[linenum], s, False); + ElsIf c=='X' Then /* compute args of subcircuit, if required */ + 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); + return 1 +EndFunc + +Func int nupa_signal(int sig, Pchar 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 + ElsIf sig == NUPAEVALDONE Then + nupa_done(); + firstsignal=True + EndIf + return 1 +EndFunc + +Func tdico * nupa_fetchinstance(void) +Begin + return dico +EndFunc + diff --git a/src/frontend/numparam/washprog.c b/src/frontend/numparam/washprog.c new file mode 100644 index 000000000..4a60279e1 --- /dev/null +++ b/src/frontend/numparam/washprog.c @@ -0,0 +1,996 @@ +/* washprog.c Copyright (C) 2002 Georg Post + * + * This file is part of Numparam, see: readme.txt + * Free software under the terms of the GNU Lesser General Public License + */ + +/**** washprog: trivial text substitution utility. ****/ + +/* history: this was an exercise to make an 'intersection' language + of C and Java, that would look like Basic. A complete failure, of course. + + Now only used to clean my Basic/Pascal-contaminated C code. + With the rules file below, it destroys all those macros of mine for + quiche eaters, which seem offensive to C aficionados. + + Standard rules file needed : downgrad.txt + + Typical command line: ./washprog -r downgrad washprog.c + + There is no printf. Console Output/Input primitives are as follows: + wc ws wr wn wi wln rln + The bare-bones string(=Pchar) manipulation library is this: + pscopy streq str length upcase scopy sadd saddn cadd pos + +Format of substitution rules: + + s substitute. use "" around string if spaces inside. + w first string must be a whole word only + m macro substitution with args 1 2 3 ... + u macro with atomic args, no punctuation "(;,:)" inside. + x exclude text section from strng1 to strng2. + a dynamically add a new macro rule, if table space left. + + string: may contain special chars: ^A ... ^Z \n \" + macro1: string with "placeholders" 1 2 ... 9, in this order + macro2: may contain the "arguments" anywhere + non-arg digits in macro2 are prefixed 0 + + Heavy use of 3 string operations: + - pscopy() substring extraction. + - comparison: match(). + - spos() substring search + + added : special postprocessing for C to place the ; and } : +1. any ';' following a ';' or '}' is wiped out. +2. any ';' preceding a '}' is wiped out. +3. any remaining ';' on start of line is shifted to end of preceding one. +*/ + +#include /* NULL FILE fopen feof fgets fclose fputs fputc gets */ +#include "general.h" + +Cconst(nsub, 100+1) /*max nbr of substitution rules */ +Cconst(nargs, 11) /*max number of macro args + 1*/ +Cconst(wild,'æ') /* wildcard character in patterns */ +Cconst(joker,1) /* one-character placeholder */ +Cconst( Recursion, True) /* 20 % slower, re-substitute inside macro args */ + +Tarray(macargs, string, nargs) /* 0..9 macro copy args, 10: a wildcard */ + + /* global vars */ +short isr; /* nb of substitution rules */ +Bool cMode; /* a scanning options: c language mode */ +short lookmax; /* input lookahead max size */ +Pfile fout; /* file filled by: echoOut macroOut translate traduire */ + +Tarray(str40, char, 44) +Tarray(str80, char, 84) +Darray(search, str40, nsub) +Darray(replace, str80, nsub) +Str(nsub, srule); +Str(nsub, wildcard); + +/********* trivial io ***/ + +Proc wsf( Pchar s, short fmt) +Begin + short k; + For k=1; k<=fmt-length(s); Inc(k) Do + wc(' ') + Done + ws(s) +EndProc + +Proc wcf(char c, short fmt) +Begin + short k; + For k=1; k<=fmt-1; Inc(k) Do + wc(' ') + Done + wc(c) +EndProc + +Proc wif(long i, short fmt) +Begin /*default fmt=1*/ + Str(30, s); + nadd(s,i); + wsf(s,fmt) +EndProc + +Proc rln(Pchar s) /* 78 column limit */ +Begin + short i; Bool done; char c; + short max=maxlen(s); + If max>78 Then max=78 EndIf + i=0; done=False; + scopy(s,""); + While Not done Do + c=fgetc(stdin); + If (c>=' ') And (c<='~') And (i='0') And (c<='9'); + If num Then z= (short)( 10*z+ c - '0') EndIf + Until Not num EndRep + If (z>lookmax) And (z<255) Then + lookmax= z + EndIf + ws("Lookahead="); wi(lookmax); + EndIf + Done + wln(); +EndProc + +/******** matching routines *******/ + +Proc copySpace(Pchar s, Pchar t, short a, short b) /* a,b>0 ! Pascal indexing */ +Begin +/*echo any "nontrivial" whitespace t-->s */ + short lt,i,k, comment; + Bool leader; + char c; +/*-StartProc-*/ + scopy(s,""); + leader=False; /*leader space on new line...*/ + k=0; + comment=0; /* for C type whitespaces 1 And 2*/ + lt= length(t); + If b>lt Then b=lt EndIf + For i=(short)(a-1); i0) And (c<' ') Then leader=True EndIf + If cMode And (c=='/') And (t[i+1]=='*') Then comment=1 EndIf + If ((c>0) And (c<' ')) Or (leader And (c==' ')) Or (comment>0) Then + cadd(s,c); Inc(k); + EndIf + If (comment==1) And (c=='/') And (t[i-1]=='*') Then comment=0 EndIf + Done +EndProc + +Func short skipCwhite(Pchar t, short j, short lt) /* assume C indexing */ +Begin +/* skip any C And C++ type whitespace in t, from j to lt */ +/* returns j-1 If current char is no white at all! */ + char c; + short comment; /*types 1 And 2! */ + /*t[j] may already be '/' ? */ comment=0; + c=t[j]; /*If c>' ', we are done! */ + If (c>0) And (c<=' ') Then + Repeat + If (comment==0) And (c=='/') Then + If t[j+1]=='*' Then + comment=1 + ElsIf t[j+1]=='/' Then + comment=2 + EndIf + ElsIf (comment==1) And (c=='/') And (t[j-1]=='*') Then + comment=0 + ElsIf (comment==2) And (c==Lf) Then + comment=0 + EndIf + Inc(j); c=t[j]; + Until (j>lt) Or ((comment==0) And (c>' ')) EndRep + EndIf + return (short)(j-1); /* return last white-matching char position */ +EndProc + +Func Bool simple(Pchar s) +Begin /* check if no strange punctuations inside s */ + char c; + short i,ls; + Bool found; +/*-StartProc-*/ + ls=length(s); + i=0; + Repeat c=s[i]; + found=(c=='(') Or (c==')') Or (c==',') Or (c==';') Or (c==':'); + Inc(i); + Until found Or (i>=ls) EndRep + return Not found; +EndFunc + +Func Bool match(Pchar s, Pchar t, short n, short tstart) +Begin +/* test if t starts with substring s. + returns 0 If tstart is out of range. But n may be 0 ? + options: Singlechar wildcards "?" +*/ + short i,j,lt; + Bool ok; +/*-StartProc-*/ + i=0; j=tstart; + lt= length(t); + ok=(tstart0 Then /*Else return 0*/ + While (k<=b) And (Not ok) Do + ok=match(sub,s, a,k); /*remark we must start at k=0 ! */ + Inc(k); + Done + EndIf + If ok Then + return k + Else + return 0 + EndIf +EndFunc + +Func short matchwhite(Pchar s, Pchar t, short n, short tstart) +Begin +/* like match, but any whitespace in t matches space in s*/ + short i,j,lt; Bool ok; +/*-StartProc-*/ + i=0; j=tstart; + lt= length(t); + ok=(tstart0) Do Inc(j) Done + Dec(j); + EndIf + Repeat + Inc(j) + Until (j>=lt) Or (t[j]>' ') EndRep /*skip space in t*/ + Dec(j); + Else + ok= (j<=lt) And ((s[i]==t[j]) Or (s[i]==joker)); + EndIf + Inc(i); Inc(j); + Done + If ok Then + return (short)(j-tstart) + Else + return (short)0 + EndIf +EndFunc + +Func short posizero(Pchar sub, Pchar s) +Begin /*another Pos */ +/* substring search. like posi, but reject quotes & bracketed stuff */ + short a,b,k; + Bool ok; + short blevel; + char c; +/*-StartProc-*/ + ok=False; + a=length(sub); + b=(short)(length(s)-a); + k=0; blevel=0; + If a>0 Then /*Else return 0*/ + While (k<=b) And (Not ok) Do + ok= (matchwhite(sub,s, a,k)>0); + If (k<=b) And (Not ok) Then + c=s[k]; + If (c==')') Or (c==']') Or (c=='}') Then + If c!=sub[0] Then Dec(blevel) EndIf /*negative level: fail!*/ + If blevel<0 Then k=b EndIf + ElsIf (c=='\'') Or (c=='\"') Then /*skip quote */ + Repeat Inc(k) + Until (k>=b) Or (s[k]==c) EndRep + ElsIf (c=='(') Or (c=='[') Or (c=='{') Then /*skip block*/ + Inc(blevel); /*counts the bracketing level */ + Repeat + Inc(k); c=s[k]; + If (c=='(') Or (c=='[') Or (c=='{') Then + Inc(blevel) + ElsIf (c==')') Or (c==']') Or (c=='}') Then + Dec(blevel) + EndIf + Until (k>=b) Or (blevel==0) EndRep + EndIf + EndIf + Inc(k); + Done + EndIf + If ok Then + return k + Else + return 0 + EndIf +EndFunc + +Func short isMacro(Pchar s, char option, Pchar t, short tstart, + string maccopy[] ) +/* s= macro template, t=buffer, maccopy = arg Array + return value: number of characters matched, + restrictive option: 'u' + macro substitution args 1 2 3 ...9. + sample: bla1tra2gla3vla matches "bla ME tra YOU gla HIM vla" + substitute 1 by maccopy[1] etc +*/ +Begin + Darray(ps, short, nargs+1) + Word j,k,dk,ls, lst, lmt, jmax, pj; + Bool ok; + char arg; + Str(250,u); + Str(40,st); +/* returns >0 If comparison Ok == length of compared Pchar */ +/*-StartProc-*/ k=0; + ok= (s[0]==t[tstart]); /* shortcut: how much does it accelerate ? some % */ + If ok Then + ps[0]=0; + ps[nargs]=0; /*only 1..9 are valid data, 10 filler templates*/ + j=0; + Repeat + Inc(j); arg= (char)(j+'0'); + ps[j]= cpos(arg,s); + Until (j>=nargs) Or (ps[j]==0) EndRep + ls= length(s); + ps[j]=(short)(ls+1); /*For last template chunk*/ + jmax=j; j=1; + k=0; lmt=0; + Repeat + pscopy(st,s, (Word)(ps[j-1]+1), (Word)(ps[j]-ps[j-1]-1) ); + /*j-th template Pchar*/ lst=length(st); + If j==1 Then + If option=='u' Then + lmt= matchwhite(st,t,lst,tstart); + ok=(lmt>0) /*length of match in t*/ + Else + ok= match(st,t,lst,tstart) + EndIf + If ok Then + pscopy(u,t, (Word)(tstart+1), (Word)255); + pj=1 + Else + pj=0 + EndIf + Else + If option=='u' Then + pj= posizero(st,u); + If pj>0 Then lmt= matchwhite(st,u, lst, (short)(pj-1)) EndIf + Else + pj= posi(st,u) + EndIf /* qs[j]= k+pj; is position in t*/ + ok=(pj>0); + EndIf + If ok Then + If option=='u' Then + If j==1 Then scopy(maccopy[0],"") EndIf + saddn(maccopy[j-1],u, (Word)(pj-1)); + dk= (Word)(pj+lmt); + copySpace(maccopy[j], t, + (Word)(tstart+k+pj), (Word)(tstart+k+dk)); + /* space in t[k+pj...k+dk] goes into maccopy[j] as a prefix. */ + Else + pscopy(maccopy[j-1],u, (Word)1, (Word)(pj-1)); + /*the stuff preceding the marker*/ + dk= (Word)(pj+lst); /* start of unexplored part */ + EndIf + pscopy(u,u, (Word)dk, (Word)length(u)); /*shift in the rest*/ + k= (Word)(k+dk-1); + EndIf + Inc(j) + Until (j>jmax) Or (Not ok) EndRep + EndIf + If Not ok Then k=0 EndIf + return k +EndFunc + +Func short similar(Pchar s, char wilds, Pchar t, + short tstart, string maccopy[] ) +/* try to match s with t, then save the wildcard parts ins maccopy[] */ +/* s=template, t=buffer, wilds= number of wildcards, maccopy=substitute */ +/* return value: number of characters matched */ +Begin + Word j,k,ps,ls; + Bool ok; + char endc; + Str(250,u); +/* returns >0 if comparison Ok = length of compared string */ +/* char comparison, s may have wildcard regions with "æ" BUT 1 valid End */ +/*-StartProc-*/ + ls=length(s); + k=0; + If wilds==wild Then + ps= cpos(wild,s) + Else + ps=0 + EndIf + If ps==0 Then + If match(s,t,ls,tstart) Then + k=ls; + ps= cpos(joker,s); /*save joker's substitute*/ + If ps>0 Then + maccopy[nargs][0]=t[ps-1+tstart] + EndIf + Else + k=0 + EndIf + Else + k= (Word)(ps-1); + While s[k]==wild Do Inc(k) Done + endc=s[k]; /*End char to detect, at length */ + ok= match(s,t, (short)(ps-1), tstart); + If ok Then + pscopy(u,t, (Word)(ps+tstart), (Word)255); + j= cpos(endc, u); + ok=(j>0); + If ok Then + k= (Word)(ps+j-1); + pscopy(maccopy[nargs],t, (Word)(ps+tstart), (Word)(j-1)); + EndIf + EndIf + If Not ok Then k=0 EndIf + EndIf + return k +EndProc + +Func short addSubList(Pchar s, short isr) +/* add the rule s to the Rule list at isr */ +Begin + short j,ls; + char c,d,endc; + Bool start,stop; +/*-StartProc-*/ + ls=length(s); /* must kill the Newline */ + endc=' '; + While (ls>0) And (s[ls]<' ') Do Dec(ls) Done; + s[ls+1]=' '; + s[ls+2]=0; /* add a space */ + If s[0]=='o' Then + setOptions(s) + ElsIf (isr0) Then + j=1; + Inc(isr); + scopy(search[isr],""); scopy(replace[isr],""); + srule[isr]=(s[0]); + wildcard[isr]=0; + /*init search*/ + start=True; stop=False; + d=0; + While Not stop Do + Inc(j); c=s[j]; + If start Then + If c !=' ' Then + start=False; + If c=='\"' Then endc=c Else endc=' ' EndIf + EndIf + Else + stop=(c==endc) + EndIf + If Not (start Or (c==endc)) Then + If c=='?' Then + c=joker + ElsIf (c=='^') And (s[j+1]>= ' ') Then + Inc(j); c=s[j]; + If (c>='@') And (c<='_') Then + c= (char)(c-'@') + EndIf + ElsIf (c=='\\') And (s[j+1]>= ' ') Then + Inc(j); c=s[j]; + If c=='n' Then c= Cr; d=Lf EndIf + EndIf + cadd(search[isr],c); + If (c==wild) Or (c==joker) Then + wildcard[isr]=c + EndIf + If d!=0 Then + cadd(search[isr],d); + d=0 + EndIf + EndIf + Done + If endc!=' ' Then Inc(j) EndIf + /*init replace*/ + start=True; stop=False; + d=0; + While Not stop Do + Inc(j); c=s[j]; + If start Then + If c!=' ' Then + start=False; + If c=='\"' Then endc=c Else endc=' ' EndIf + EndIf + Else + stop=(c==endc) + EndIf + If Not (start Or (c==endc)) Then + If c=='?' Then + c=joker + ElsIf (c=='^') And (s[j+1]>= ' ') Then + Inc(j); c=s[j]; + If (c>='@') And (c<='Z') Then c= (char)(c-'@') EndIf + ElsIf (c=='\\') And (s[j+1]>= ' ') Then + Inc(j); c=s[j]; /*echo next char */ + If c=='n' Then c=Cr; d=Lf EndIf + EndIf + cadd(replace[isr],c); + If d!=0 Then + cadd(replace[isr],d); + d=0 + EndIf + EndIf + Done + If endc !=' ' Then Inc(j) EndIf + EndIf + If isr>=nsub Then + ws("No more room for rules."); wln() + EndIf + return isr +EndFunc + +Func Bool getSubList(Pchar slist) +/* read the search and substitution rule list */ +Begin + Str(250,s); + Pfile f; + Bool done, ok; +/*-StartProc-*/ + cMode=False; + lookmax= 80; /* or 250: handle 4 full lines maximum ? */ + If Zero(slist[0]) Then + scopy(slist, "slist.txt") + EndIf + f=fopen(slist,"rb"); + isr=0; + done= (f == Null); + ok= Not done; + While Not done Do + fgets(s,(short)80,f); + isr=addSubList(s,isr); + done= feof(f) + Done + If f != Null Then fclose(f) EndIf + ws("Number of rules: "); + wi(isr); wln(); + return ok +EndFunc + +Func Bool nonAlfa(char c) +Begin + return ((c<'a') Or (c>'z')) And ((c<'A') Or (c>'Z')) +EndFunc + +/********** optional output postprocessor **************/ + +/* the main translator calls these: + washinit to reset the postprocessor + washchar to output a char + washstring to output a string + washflush to terminate +*/ + +/* C reformatter, keeping an eye on the following (modulo whitespace): + ; } Lf. + + This is just a state machine, handling 3 rules using an output buffer obf. + means space excluding \n, and , space including newlines. + Wanted: regular-expression scripts or tricks to do the same or better... + + Rule1: Lf; --> ;Lf states 2 3 + Rule2: ;; --> ; state 1 + Rule3: }; --> } state 1 +*/ + +Bool washmore= True; /* flag that activates the postprocessor */ +Str(250,obf); /* output buffer */ +short iobf=0; /* its index */ +short wstate=0; /* output state machine */ + +Proc washinit(void) +Begin + iobf=0; + wstate=0 +EndProc + +Proc washchar(char c) +Begin /* state machine receives one character */ + short i; + If Not washmore Then /* never leave state 0 */ + fputc(c, fout) + ElsIf wstate==0 Then /* buffer empty */ + If (c==';') Or (c=='}') Then + iobf=0; obf[iobf]=c; + Inc(iobf); wstate=1 + ElsIf c<=' ' Then + iobf=0; obf[iobf]=c; + Inc(iobf); + If c==Lf Then wstate=3 Else wstate=2 EndIf + Else + fputc(c, fout) + EndIf + ElsIf wstate==1 Then + If c <= ' ' Then + obf[iobf]=c; Inc(iobf) + Else + If c != ';' Then + obf[iobf]=c; Inc(iobf) + EndIf + For i=0; i0) And (j0) And (j0; + If ok And (srule[i]=='w') Then + ok=nonAlfa(lastBf1) And nonAlfa(bf[sm]) + EndIf + If Not ok Then Inc(i) EndIf + Done + If ok Then + If (srule[i]=='m') Or (srule[i]=='u') Then + macroOut(replace[i], mac) + Else + echoOut(replace[i],wildcard[i], mac) + EndIf + lastBf1=bf[sm-1]; pscopy(bf,bf, (Word)(sm+1), (Word)255); + Inc(nbrep); + Else + lastBf1=bf[0]; + washchar(lastBf1); + pscopy(bf,bf, (Word)2, (Word)255); + EndIf + done= Zero(bf[0]) + Done +EndProc + +Proc translator( Pchar fname) +/* checks list of possible substitution rules sequentially. + Does the first that matches. Option: recursion. + BUG: is very slow. +*/ +Begin + Str(250, outname); Str(250,bf); + Bool done; + Darray( mac, string, nargs) + Pfile fin; + Bool ok; + short i,sm, exclusion, idot; + char c,lastBf1; + Word nbrep,nline; +/*-StartProc-*/ + For i=0; i0 if an exclusion rule is active */ + fin=fopen( fname, "rb"); + scopy(outname, fname); + idot= cpos('.',outname); + If idot <= 8 Then /* room for underbar prefix, even in Ms-dos */ + cins(outname,'_') + ElsIf NotZ(outname[0]) Then /* just erase first char */ + outname[0] = '_' + Else + scopy(outname,"washprog.out") + EndIf + fout=fopen( outname,"wb"); + washinit(); + done= (fin == Null) Or (fout == Null); + scopy(bf,""); + lastBf1=' '; + /* lookmax=80; handle a line maximum ! */ + While Not done Do + c=' '; + While (c !=0) And (length(bf)0 Then + i=exclusion; + sm=similar(replace[i], (char)0, bf, (short)0, mac); + ok= sm>0 + EndIf + If Zero(exclusion) Then + i=1; + While (i<=isr) And (Not ok) Do /*search for 1st match*/ + If (srule[i]=='m') Or (srule[i]=='u') Or (srule[i]=='a') Then + If alfa(lastBf1) And (alfa(search[i][0])) Then + sm=0 /*inside word*/ + Else + sm= isMacro(search[i], srule[i], bf, (short)0,mac) + EndIf + Else + sm=similar(search[i],wildcard[i],bf, (short)0, mac) + EndIf + ok=sm>0; + If ok And (srule[i]=='w') Then + ok=nonAlfa(lastBf1) And nonAlfa(bf[sm]) + EndIf + If Not ok Then Inc(i) EndIf + Done + EndIf + If ok Then + If (srule[i]=='m') Or (srule[i]=='u') Then + macroOut(replace[i], mac) + ElsIf srule[i]=='x' Then + If Zero(exclusion) Then + exclusion=i + Else + exclusion=0 + EndIf + ElsIf srule[i]=='a' Then + makeNewRule(replace[i],mac) + Else + echoOut(replace[i],wildcard[i],mac) + EndIf + lastBf1=bf[sm-1]; pscopy(bf,bf, (Word)(sm+1), (Word)lookmax); + Inc(nbrep); + Else + lastBf1=bf[0]; + If Zero(exclusion) Then washchar(lastBf1) EndIf; + pscopy(bf,bf, (Word)2, (Word)lookmax); + /*avoid this time-consuming buffer shuffling ?*/ + EndIf + done= Zero(bf[0]); + Done + If fout !=Null Then + washflush(); + fputc('\n', fout); + fclose(fout) + EndIf + If fin !=Null Then fclose(fin) EndIf + ws("Lines: "); wi(nline); + ws(" Replacements: "); + wi(nbrep); wln(); +EndProc + +Func int main( int argc, Pchar argv[]) +Begin + Str(80,dico); + short istart= 1; + Bool ok= True; +/*-StartProc-*/ + allocdata(); + scopy(dico,"downgrad"); /* default rules file */ + ws(" washprog: A text substitution utility"); wln(); + If (argc>2) And steq(argv[1],"-r") Then + scopy(dico,argv[2]); + istart= 3; +/* + Else + ws("Dictionary file (.TXT automatic): "); + rln(dico); +*/ + EndIf + If spos(".txt",dico) <=0 Then + sadd(dico,".txt") + EndIf + ok= getSubList(dico); /*list of substitution rules */ + While ok And (istart< argc) Do + If argv[istart][0] != '_' Then /* leading underbar not accepted */ + translator( argv[istart]) + EndIf + Inc(istart) + Done + return 0 +EndFunc + diff --git a/src/frontend/numparam/xpressn.c b/src/frontend/numparam/xpressn.c new file mode 100644 index 000000000..1bf72d797 --- /dev/null +++ b/src/frontend/numparam/xpressn.c @@ -0,0 +1,1548 @@ +/* xpressn.c Copyright (C) 2002 Georg Post + * + * This file is part of Numparam, see: readme.txt + * Free software under the terms of the GNU Lesser General Public License + */ + +#include /* for function message() only. */ +#include + +#include "general.h" +#include "numparam.h" + +/************ keywords ************/ + +Intern Str(Llen, keys); /*all my keywords*/ +Intern Str(Llen, fmath); /* all math functions */ + +Intern +Proc initkeys(void) +/* the list of reserved words */ +Begin + scopy(keys, + "and or not div mod if else end while macro funct defined" + " include for to downto is var"); + stupcase(keys); + scopy(fmath, "sqr sqrt sin cos exp ln arctan abs pwr"); + stupcase(fmath); +EndProc + +Intern +Func double mathfunction(short f, double z, double x) +/* the list of built-in functions. Patch 'fmath' and here 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= exp( x* ln(fabs(z))) + /* pwr(,): the only one with 2 args */ + Default y=x EndSw + return y +EndFunc + +Cconst(Defd,12) +/* serial numb. of 'defined' keyword. The others are not used (yet) */ + +Intern +Func Bool message( tdico * dic, Pchar s) +/* record 'dic' should know about source file and line */ +Begin + Str(250,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 + +Proc debugwarn( tdico *d, Pchar s) +Begin + message(d,s); + Dec( d->errcount) +EndProc + +/************* historical: stubs for nodetable manager ************/ +/* in the full preprocessor version there was a node translator for spice2 */ + +Intern +Proc initsymbols(auxtable * n) +Begin +EndProc + +Intern +Proc donesymbols(auxtable * n) +Begin +EndProc + +/* Intern +Func short parsenode(auxtable *n, Pchar s) +Begin + return 0 +EndFunc +*/ + +/************ the input text symbol table (dictionary) *************/ + +Proc initdico(tdico * dico) +Begin + short i; + dico->nbd=0; + Sini(dico->option); + Sini(dico->srcfile); + dico->srcline= -1; + dico->errcount= 0; + For i=0; i<=Maxdico; Inc(i) Do + sini(dico->dat[i].nom,20) + Done + dico->tos= 0; + dico->stack[dico->tos]= 0; /* global data beneath */ + initsymbols(Addr(dico->nodetab)); + initkeys(); +EndProc + +/* local semantics for parameters inside a subckt */ +/* 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') + +Intern +Proc dicostack(tdico *dico, char op) +/* push or pop operation for nested subcircuit locals */ +Begin + 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; + 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 + dico->nbd= dico->stack[dico->tos]; /* simply kill all local items */ + Dec(dico->tos) + Else message(dico," Subckt Stack underflow.") + EndIf + EndIf +EndProc + +Func short donedico(tdico * dico) +Begin + short sze= dico->nbd; + donesymbols(Addr(dico->nodetab)); + return sze; +EndProc + +Intern +Func short entrynb( tdico * d, Pchar s) +/* symbol lookup from end to start, for stacked local symbols .*/ +/* bug: sometimes we need access to same-name symbol, at lower level? */ +Begin + short i; + Bool ok; + ok=False; + 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 + +Func char getidtype( tdico *d, Pchar s) +/* test if identifier s is known. Answer its type, or '?' if not in list */ +Begin + char itp='?'; /* assume unknown */ + short i= entrynb(d, s); + If i >0 Then itp= d->dat[i].tp EndIf + return itp +EndFunc + +Intern +Func double fetchnumentry( + tdico * dico, + Pchar t, + Bool * perr) +Begin + Bool err= *perr; + Word k; + double u; + Str(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) + EndIf + *perr= err; + return u +EndFunc + +/******* writing dictionary entries *********/ + +Intern +Func short attrib( tdico * dico, Pchar t, char op) +Begin +/* seek or attribute dico entry number for string t. + Option op='N' : force a new entry, if tos>level and old is valid. +*/ + short i; + 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 + +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 +/*define t as real or integer, + opcode= 'N' impose a new item under local conditions. + check for pointers, too, in full macrolanguage version: + Call with 'N','P',0.0, ksymbol ... for VAR parameter passing. + Overwrite warning, beware: During 1st pass (macro definition), + we already make symbol entries which are dummy globals ! + we mark each id with its subckt level, and warn if write at higher one. +*/ + short i; + char c; + Bool err, warn; + Str(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 + 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 + return err; +EndFunc + +Func Bool defsubckt(tdico *dico, Pchar s, Word 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; + short i,j,ls; + ls=length(s); + i=0; + While (i' ') Do Inc(i) Done + While (i' ') Do Inc(j) Done + If (j>i) And alfa(s[i]) Then + pscopy(u,s, i+1, j-i); + stupcase(u); + err= define( dico, u, ' ',categ, 0.0, w, Null); + Else + err= message( dico,"Subcircuit or Model without name."); + EndIf + return err +EndFunc + +Func short findsubckt( tdico *dico, Pchar s, Pchar subname) +/* input: s is a subcircuit invocation line. + returns 0 if not found, else the stored definition line number value + and the name in string subname */ +Begin + Str(80,u); /* u= subckt name is last token in string s */ + short i,j,k; + k=length(s); + While (k>=0) And (s[k]<=' ') Do Dec(k) Done + j=k; + While (k>=0) And (s[k]>' ') Do Dec(k) Done + pscopy(u,s, k+2, j-k); + stupcase(u); + 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 + +#if 0 /* unused, from the full macro language... */ +Intern +Func short 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; +/* if not jumped, define new function or macro, returns index to buffferstart + if jumped, return index to existing function +*/ + short i,j; + Str(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; + return j; +EndFunc +#endif + +/************ input scanner stuff **************/ + +Intern +Func Byte keyword( Pchar keys, Pchar t) +Begin +/* return 0 if t not found in list keys, else the ordinal number */ + Byte i,j,k; + short lt,lk; + 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 + +Intern +Func double parseunit( double x, Pchar s) +/* the Spice suffixes */ +Begin + double u; + 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 + +Intern +Func short fetchid( + Pchar s, Pchar t, + short ls, short 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 (i='0') And (c<='9')) Or ((c>='A') And (c<='Z')); + If ok Then cadd(t,c) EndIf + Until Not ok EndRep + return i /*return updated i */ +EndFunc + +Intern +Func double exists( + tdico * d, + Pchar s, + short * pi, + Bool * perror) +/* check if s in smboltable 'defined': expect (ident) and return 0 or 1 */ +Begin + Bool error= *perror; + short i= *pi; + double x; + short ls; + char c; + Bool ok; + Str(Llen, t); + ls=length(s); + x=0.0; + Repeat + Inc(i); + If i>ls 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; + return x; +EndFunc + +Intern +Func double fetchnumber( tdico *dico, + Pchar s, short ls, + short * pi, + Bool * perror) +/* parse a Spice number in string s */ +Begin + Bool error= *perror; + short i= *pi; + short k,err; + char d; + Str(20, t); + Str(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 + +Intern +Func char fetchoperator( tdico *dico, + Pchar s, short ls, + short * pi, + Byte * pstate, Byte * plevel, + Bool * perror) +/* grab an operator from string s and advance scan index pi. + each operator has: one-char alias, precedence level, new interpreter state. +*/ +Begin + short i= *pi; + Byte state= *pstate; + Byte level= *plevel; + Bool error= *perror; + char c,d; + Str(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; + return c; +EndFunc + +Intern +Func char opfunctkey( tdico *dico, + Byte kw, char c, + Byte * pstate, Byte * plevel, Bool * perror) +/* handle operator and built-in keywords */ +Begin + Byte state= *pstate; + Byte level= *plevel; + Bool 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 + +Intern +Func double operate( + char op, + double x, + double y) +Begin +/* 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 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= trunc(x/y); + x= x-y*t + Case '\\' Is /*Div*/ + x= trunc(absf(x/y)); + EndSw /*case*/ + return x; +EndFunc + +Intern +Func double formula( + tdico * dico, + Pchar s, + Bool * perror) +Begin +/* 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) ! + 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; + Byte state,oldstate, topop,ustack, level, kw, fu; + double u,v; + double accu[nprece+1]; + char oper[nprece+1]; + char uop[nprece+1]; + short i,k,ls,natom, arg2; + char c,d; + Str(Llen, t); + Bool 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 arg2=k 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 + pscopy(t,s,i+1, k-i-1); + u=formula( dico, t, Addr(error)); + state=1; /*atom*/ + If fu>0 Then + u= mathfunction(fu,v,u) + 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)); + 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 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 + *perror= error; + If error Then + return 1.0 + Else + return accu[topop] + EndIf +EndFunc /*formula*/ + +Intern +Func char fmttype( double x) +Begin +/* I=integer, P=fixedpoint F=floatpoint*/ +/* find out the "natural" type of format for number x*/ + double ax,dx; + short 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=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 + +Intern +Func Bool evaluate( + tdico * dico, + Pchar q, + Pchar t, + Byte mode) +Begin +/* transform t to result q. mode 0: expression, mode 1: simple variable */ + double u; + short k,j,lq; + char dt,fmt; + Bool numeric, done, nolookup; + Bool err; + Str(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(round(u), q) + Else + strf(u,6,-1,q) + EndIf /* strf() arg 2 doesnt work: always >10 significant digits ! */ + EndIf + return err; +EndFunc + +#if 0 +Intern +Func Bool scanline( + tdico * dico, + Pchar s, Pchar r, + Bool err) +/* scan host code line s for macro substitution. r=result line */ +Begin + short i,k,ls,level,nd, nnest; + Bool spice3; + char c,d; + Str(Llen, q); + Str(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*/ + return err; +EndFunc +#endif + +/********* interface functions for spice3f5 extension ***********/ + +Intern +Proc compactfloatnb(Pchar v) +/* try to squeeze a floating pt format to 10 characters */ +/* erase superfluous 000 digit streams before E */ +/* bug: truncating, no rounding */ +Begin + short 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) > 10 Then k= 9-lex EndIf + pscopy(v,v, 1,k+1); + sadd(v,expo); + EndIf +EndProc + +Intern +Func short insertnumber(tdico *dico, short i, Pchar s, Pchar u) +/* insert u in string s in place of the next placeholder number */ +Begin + Str(40,v); + Str(80,msg); + Bool found; + short ls, k; + long accu; + ls= length(s); + scopy(v,u); + compactfloatnb(v); + While length(v)<10 Do + cadd(v,' ') + Done + If length(v)>10 Then + scopy(msg," insertnumber fails: "); + sadd(msg,u); + message( dico, msg) + EndIf + found=False; + While (Not found) And (i0) And (accu<2000) + EndIf + Inc(i) + Done + If found Then /* substitute at i-1 */ + Dec(i); + For k=0; k<10; Inc(k) Do s[i+k]= v[k] Done + i= i+10; + Else + i= ls; + message( dico,"insertnumber: missing slot "); + EndIf + return i +EndFunc + +Func Bool nupa_substitute( tdico *dico, Pchar s, Pchar r, Bool 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 + short i,k,ls,level, nnest, ir; + char c,d; + Str(Llen, q); + Str(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 + +Intern +Func Byte getword( + Pchar s, Pchar t, + Byte after, + short * pi) +/* isolate a word from s after position "after". return i= last read+1 */ +Begin + short i= *pi; + short 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 + +Intern +Func char getexpress( Pchar s, Pchar t, short * pi) +/* returns expression-like string until next separator + Input i=position before expr, output i=just after expr, on separator. + returns tpe=='R' If numeric, 'S' If string only +*/ +Begin + short i= *pi; + short ia,ls,level; + 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 + +Func Bool nupa_assignment( tdico *dico, Pchar 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 ... */ + Str(Llen, t); + Str(Llen,u); + short i,j, ls; + Byte key; + Bool 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.") + EndIf + ElsIf dtype=='S' Then + wval= i + EndIf + err=define(dico,t, mode /*was ' ' */ , dtype,rval,wval,Null); + error= error Or err; + EndIf + If (i0 Then pscopy(t,s,1,j-1) Else scopy(t,s) EndIf + stupcase(t); + j= spos("SUBCKT", t); + If j>0 Then + j= j +6; /* fetch its name */ + While (j0 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(t,x,1,j-1) Else scopy(t,x) EndIf + stupcase(t); + ls=length(t); + j= spos(subname,t); + 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 +