Added numparam library (contributed by Georg Post) to add .param to spice

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

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)"
+

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 <stdio.h>   // NULL FILE fopen feof fgets fclose fputs fputc gets 
+#include <stdlib.h>  
+   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);
+

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 <stdio.h>
+#include <stdlib.h>
+/* #include <math.h>  -- 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<max) And (c>=' ') 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;j<i; Inc(j) Do /* eliminate null characters ! */
+    If s[j]==0 Then s[j]=1 EndIf
+  Done
+EndProc
+
+Intern
+Proc inistring(Pchar s, char c, short max)
+/* suppose s is allocated. empty it if c is zero ! */
+Begin
+  short i=0;
+  s[i]=c;
+  If c!=0 Then 
+    Inc(i); s[i]=0 
+  EndIf
+  If max<1 Then 
+    max=1 
+  ElsIf max>Maxstr Then 
+    max=Maxstr 
+  EndIf
+  s[i+1]= Hi(max); s[i+2]= Lo(max);
+EndProc
+
+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<max) Do
+    s[ls]= t[i]; 
+    Inc(i); Inc(ls);
+  Done
+  s[ls]=0; 
+  s[ls+1]= Hi(max); s[ls+2]= Lo(max);
+  ok= (t[i]==0); /* end of t is reached */
+  If Not ok Then
+    stringbug("sadd",s,t,0) 
+  EndIf
+  return ok
+EndProc
+
+Func Bool cadd( Pchar s, char c)
+Begin
+  short max, ls= length(s);
+  Bool ok;
+  max= Getmax(s,ls);
+  ok= (ls<max);
+  If ok Then
+    s[ls+3]= s[ls+2]; s[ls+2]=s[ls+1]; 
+    s[ls+1]=0; s[ls]=c
+  EndIf
+  If Not ok Then
+    stringbug("cadd",s, Null,c)
+  EndIf
+  return ok
+EndProc
+
+Func Bool cins( Pchar s, char c)
+Begin
+  short i, max, ls= length(s);
+  Bool ok;
+  max= Getmax(s,ls);
+  ok= (ls<max);
+  If ok Then
+    For i=ls+2; i>=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<lt; Inc(i) Do s[i]=t[i] Done;
+  EndIf
+  If Not ok Then
+    stringbug("sins",s, t,0)
+  EndIf
+  return ok
+EndProc
+
+Func short cpos(char c, Pchar s)
+/* return position of c in s, or 0 if not found.
+ * BUG, Pascal inherited: first char is at 1, not 0 !
+ */
+Begin
+  short i=0;
+  While (s[i] !=c) And (s[i] !=0) Do Inc(i) Done
+  If s[i]==c Then
+    return (i+1)
+  Else
+    return 0
+  EndIf
+EndFunc
+
+Func char upcase(char c)
+Begin
+  If (c>='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 (i<max) Do
+    s[i]= t[i]; Inc(i);
+  Done
+  s[i]=0; 
+  s[i+1]= Hi(max); s[i+2]= Lo(max);
+  ok= (t[i]==0); /* end of t is reached */
+  If Not ok Then
+    stringbug("scopy",s, t,0)
+  EndIf
+  return ok
+EndProc
+
+Func Bool ccopy(Pchar s, char c) /* returns success flag */
+Begin
+  short max, ls= length(s);
+  Bool ok=False;
+  max= Getmax(s,ls);
+  If max>0 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; i<leng; Inc(i) Do s[i]= t[start+i -1] Done
+    i=leng; s[i]=0;  
+    s[i+1]= Hi(max); s[i+2]= Lo(max);
+  EndIf
+  /* If Not ok Then stringbug("copy",s, t, 0) EndIf */
+  /* If ok Then return s Else return Null EndIf */
+  ok=ok;
+  return s
+EndProc
+
+Func short ord(char c)
+Begin
+  return c AND 0xff
+EndFunc /* strip high byte */
+
+Func short pred(short i)
+Begin
+ return (--i)
+EndFunc
+
+Func short succ(short i)
+Begin
+  return (++i)
+EndFunc
+
+Func Bool nadd( Pchar s, long n)
+/* append a decimal integer to a string */
+Begin
+  short d[25];
+  short j,k,ls,len;
+  char sg;  /* the sign */
+  Bool ok;
+  k=0;
+  len=maxlen(s);
+  If n<0 Then
+    n= -n; sg='-' 
+  Else
+    sg='+'
+  EndIf
+  While n>0 Do 
+    d[k]=n Mod 10; Inc(k); 
+    n= n Div 10
+  Done
+  If k==0 Then 
+    ok=cadd(s,'0')
+  Else
+    ls=length(s);
+    ok= (len-ls)>k;
+    If ok Then
+      If sg=='-' Then
+        s[ls]=sg; Inc(ls)
+      EndIf
+      For j=k-1; j>=0; Dec(j) Do
+        s[ls]=d[j]+'0'; Inc(ls)
+      Done
+      sfix(s,ls,len);
+    EndIf
+  EndIf
+  If Not ok Then
+    stringbug("nadd",s, Null,sg)
+  EndIf
+  return ok
+EndProc
+
+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 lb<la Then
+    n=lb 
+  Else
+    n=la
+  EndIf
+  For j=0; j<n; Inc(j) Do
+    ((Pchar)a)[j]=((Pchar)b)[j]
+  Done
+EndProc
+
+Func short scompare(Pchar a, Pchar b)
+Begin
+  Word j=0; 
+  short k=0;
+  While (a[j]==b[j]) And (a[j]!=0) And (b[j]!=0) Do Inc(j) Done;
+  If a[j]<b[j] Then
+    k= -1 
+  ElsIf a[j]>b[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<max Then max=mxlen EndIf
+  Repeat 
+     c=fgetc(f); /*  tab is the only control char accepted */
+    If ((c>=' ') Or (c<0) Or (c==Tab)) And (i<max) Then
+      s[i]=c; Inc(i)
+    EndIf
+  Until feof(f) Or (c=='\n') EndRep
+  s[i]=0; 
+  s[i+1]= Hi(mxlen); s[i+2]= Lo(mxlen);
+  return i
+EndProc
+
+Func char freadc(Pfile f)
+Begin
+  return fgetc(f)
+EndFunc
+
+Func long freadi(Pfile f)
+/* reads next integer, but returns 0 if none found. */
+Begin 
+  long z=0;
+  Bool minus=False;
+  char c;
+  Repeat c=fgetc(f) 
+  Until feof(f) Or  Not ((c>0) 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=(tstart<lt);
+  While ok And (i<n) Do
+    a=s[i]; b=t[j];
+    If Not testcase Then
+      a=upcase(a); b=upcase(b)
+    EndIf
+    ok= (j<lt) And (a==b);
+    Inc(i); Inc(j);
+  Done
+  return ok
+EndFunc
+
+Intern 
+Func short posi(Pchar sub, Pchar s, short opt)
+/* find position of substring in s */
+Begin
+  /* opt=0: like Turbo Pascal */
+ /*  opt=1: like Turbo Pascal Pos, but case insensitive */
+ /*  opt=2: position in space separated wordlist for scanners */
+  short a,b,k,j;
+  Bool ok, tstcase;
+  Str(250,t);
+  ok=False;
+  tstcase=( opt==0);
+  If opt<=1 Then
+    scopy(t,sub)
+  Else
+    cadd(t,' '); sadd(t,sub); cadd(t,' ');
+  EndIf
+  a= length(t); 
+  b= (short)(length(s)-a);
+  k=0; j=1;
+  If a>0 Then  /*Else return 0*/
+    While (k<=b) And (Not ok) Do
+      ok=match(t,s, a,k, tstcase); /* we must start at k=0 ! */
+      Inc(k);
+      If s[k]==' ' Then Inc(j) EndIf /* word counter */
+    Done
+  EndIf
+  If opt==2 Then k=j EndIf
+  If ok Then
+    return k
+  Else
+    return 0
+  EndIf
+EndFunc
+
+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 <math.h>, 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 (n<x) And (x<0.0) Then
+    Inc(n)
+  EndIf
+  return n
+EndFunc
+
+Func double frac(double x)
+Begin
+  return x- trunc(x) 
+EndFunc
+
+Func double intp(double x)
+Begin
+  double u=2e9;
+  If (x>u) 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 */
+
+

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  ####
+

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);
+

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 <filename.cir>           ****/
+
+#include <stdio.h>
+
+#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 (i<istop) And (Not done) Do
+    c= dico->category[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 (i<max) Then 
+      cadd(s,c); Inc(i) 
+    EndIf
+    done= (c==Lf) Or (c==Cr)
+  Done
+EndProc
+#endif
+
+Proc fwrites(Pfile f, Pchar s)
+Begin 
+  fputs(s,f) 
+EndProc
+
+Proc fwriteln(Pfile f)
+Begin 
+  fputc('\n',f) 
+EndProc
+
+Intern
+Proc freadln(Pfile f, Pchar s, short max)
+Begin 
+  short ls;
+  freadstr(f,s,max); 
+  ls=length(s);
+  If feof(f) And (ls>0) 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<ls) And (s[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<ls) And (s[j] >  ' ') Do Inc(j) Done /* skip current word */ 
+  pscopy(u, s,  k+1, j-k);
+  While (j<ls) And (s[j] <= ' ') Do Inc(j) Done
+  return j
+EndFunc
+
+Func short inwordlist(Pchar u, Pchar wl)
+/* suppose wl is single-space separated, plus 1 space at start and end. */ 
+Begin
+  short n,p,k;
+  Str(80,t);
+  n=0;
+  ccopy(t,' '); sadd(t,u); cadd(t,' ');
+  p= spos(t,wl);
+  If p>0 Then
+    For k=0; k<p; Inc(k) Do
+      If wl[k] <= ' ' Then Inc(n) EndIf
+    Done
+  EndIf
+  return n
+EndFunc
+
+Proc takewordlist(Pchar u, short k, Pchar wl)
+Begin
+  short i,j,lwl;
+  lwl= length(wl);
+  i=0; j=0;
+  scopy(u,"");
+  While (i<lwl) And (j<k ) Do
+    If wl[i] <= ' ' Then Inc(j) EndIf
+    Inc(i)
+  Done
+  If j==k Then /* word has been found and starts at i */
+    While wl[i]>' ' 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<ls) And (s[i]<=' ') Do Inc(i) Done
+  If alfa(s[i]) Or (categ=='X') Then /* splice in the prefix and nodelist */
+    wordinsert(s,p, i+1);
+    j= getnextword(s,u,i); 
+    done=False;
+    If p[0]== pfxsep Then
+      pscopy(pfx,p, 2, length(p)) 
+    Else 
+      scopy(pfx,p)
+    EndIf
+    leadchar=upcase(s[i]); 
+    dtype= cpos( leadchar, deviceletter) -1 ;
+    If dtype >= 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<ls Do
+    j= getnextword(s,u,j); 
+    If j<ls Then sadd(act,u); cadd(act,' ') EndIf
+  Done
+  /* now u already holds the subckt name if all is ok ? */
+  idef = findsubckt( dic, buf2[k], u); 
+  /* line buf2[idef] contains: .subckt name < formal list > */ 
+  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 j<ls Do
+    j= getnextword(t,u,j); 
+    sadd(form,u); cadd(form,' ');
+  Done
+EndProc
+
+Proc nupa_test(Pchar fname, char mode)
+/* debugging circuit expansion run. mode='w': write ouput file */
+/* bugs in nupa_eval(), and for nested subckt definitions !?! */
+Begin
+  Pfile tf, fout;
+  tdico * dic; /* dictionary data pointer */
+  Str(250,s);
+  Str(80, prefix);
+  /* Str(250, formals); Str(250,actuals); */
+  Darray(formals, Pchar, 10)
+  Darray(actuals, Pchar, 10)
+  short i, j, k, nline, parstack;
+  For i=0; i<Maxline; Inc(i) Do /* allocate string storage */
+    buff[i]= newstring(80);
+    buf2[i]= Null;
+    pxbuf[i]= Null 
+  Done
+  For i=0; i<10; Inc(i) Do
+    formals[i]= newstring(250);
+    actuals[i]= newstring(250);
+  Done
+  i=0; parstack=0;
+  tf=fopen( fname, "r");
+  If tf != Null Then
+    While (Not feof(tf)) And ((i+1) < Maxline) Do
+      Inc(i);
+      freadln(tf, buff[i], 80); /* original data */
+    Done
+    fclose(tf);
+  Else
+    ws("Cannot find "); ws(fname); wln();
+  EndIf
+  /* continuation lines are glued at this stage, so they can be ignored
+     in all the subsequent manipulations.
+  */
+  gluepluslines(i); /* must re-allocate certain buff[i]  */ 
+  nupa_signal(NUPADECKCOPY, fname);
+  dic= nupa_fetchinstance(); /* bug: should have a task handle as arg */
+  For j=1; j<=i; Inc(j) Do
+    buf2[j]= nupa_copy(buff[j], j); /* transformed data */
+  Done
+  nupa_signal(NUPASUBDONE, Null);
+  nline= runscript(dic, "", 1,i, 20); /* our own subckt expansion */
+  /* putlogfile(' ',nline," expanded lines"); */
+  If mode=='w' Then
+    i= cpos('.', fname); 
+    pscopy(s, fname, 1, i);
+    sadd(s,"out");
+    fout= fopen(s, "w");
+  Else
+    fout= Null
+  EndIf
+  For j=0; j<irunbuf; Inc(j) Do
+    k= runbuf[j]; 
+    If buf2[k] != Null Then 
+      scopy(s, buf2[k]);
+      nupa_eval(s, k);
+      scopy(prefix,pxbuf[pindex[j]]); 
+      If NotZ(prefix[0]) Then cadd(prefix, pfxsep) EndIf 
+      prefixing(s, prefix, formals[parstack], actuals[parstack],
+           dic->category[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
+

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 <identifier> = <expression>
+
+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 :
+  { <expression> }
+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 <ckt-ident> <node> ... params: <id>=<value> <id>=<value> ...
+
+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,
+<ident> means an alphanumeric identifier (<20 chars, starting with a letter)
+<expr>  means an expression, composed of <ident>s, Spice numbers, and operators.
+
+1. The .param line:
+   Syntax:   .param <ident> = <expr> ; <ident> = <expr> ....
+
+  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:     { <expr> }
+
+  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 <expr> 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 <ident> node node ... params: <ident>= <value> <ident>=<value>...
+
+   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 <ident> is a formal parameter, and each <value> 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 <value> 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<name>  node node ... <ident>  <value> <value> ....
+    
+   Here <name> is the symbolic name given to that instance of the subcircuit,
+   <ident> is the name of a subcircuit defined beforehand.  node node ... is  
+   the list of actual nodes where the subcircuit is connected. 
+   <value> is either a Spice number or a brace expression { <expr> } .
+   The sequence of <value> 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 <expr>  ( optional parts within [ ...] ):
+
+    An expression may be one of:
+       <atom>       where <atom> is either a Spice number or an identifier 
+       <unary-operator> <atom>
+       <function-name> ( <expr> [ , <expr> ...] )
+       <atom> <binary-operator> <expr>         
+       ( <expr> )
+
+    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
+

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 <stdio.h>
+#ifdef __TURBOC__
+#include <process.h>   /* 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 (i<ls) And Not stop Do 
+    d=c; 
+    Inc(i); c=s[i-1];
+    stop=(c==d) And ((c=='/')Or(c=='-'));  /* comments after // or -- */
+  Done
+  If stop Then 
+    i=i-2; /*last valid character before Comment */
+    While (i>0)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 (i<ls) And (s[i]<=' ') Do Inc(i) Done
+  If (i>0) And (i<ls) And (cpos(s[i],markers) >0) 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; i<lt; Inc(i) Do 
+    c=t[i];
+    If c=='=' Then 
+      state=1
+    ElsIf (state==1) And (c==' ') Then 
+      state=2
+    EndIf
+    If state==2 Then 
+      cadd(u,Lf); cadd(u,Intro); 
+      state=0 
+    EndIf
+    cadd(u,c)
+  Done
+  scopy(t,u);
+  For i=0; i<length(t); Inc(i) Do /* kill braces inside */
+    If (t[i]=='{') Or (t[i]=='}') Then 
+       t[i]=' '   
+    EndIf
+  Done
+EndProc
+#endif
+
+Intern
+Func short stripbraces( Pchar s)
+/* puts the funny placeholders. returns the number of {...} substitutions */
+Begin
+  short n,i,nest,ls,j;
+  Str(Llen,t);
+  n=0; ls=length(s); 
+  i=0;
+  While i<ls Do
+    If s[i]=='{' Then /* something to strip */
+      j= i+1; nest=1; 
+      Inc(n);
+      While (nest>0) And (j<ls) Do
+        If s[j]=='{' Then 
+          Inc(nest) 
+        ElsIf s[j]=='}' Then 
+          Dec(nest) 
+        EndIf
+        Inc(j)
+      Done
+      pscopy(t,s,1,i);
+      Inc(placeholder); 
+      If t[i-1]>' '  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<ls) Then 
+    pscopy(s,s,1,h) 
+  EndIf
+  return h;
+EndFunc
+
+Intern
+Proc modernizeex( Pchar s)
+/* old style expressions &(..) and &id --> new style with braces. */
+Begin
+  Str(250,t);
+  short i,state, ls;
+  char c,d;
+  i=0; state=0;
+  ls= length(s);
+  While i<ls Do
+    c= s[i]; d=s[i+1];
+    If Zero(state) And (c==Intro) And (i>0) 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; i<Maxline; Inc(i) Do
+    dico->refptr[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 (linenum<Maxline) Then 
+    Inc(linecount);
+    dico->refptr[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
+

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 <string> <string>   substitute. use ""  around string if spaces inside.
+ w <string> <string>   first string must be a whole word only
+ m <macro1> <macro2>   macro substitution with args 1 2 3 ...
+ u <macro1> <macro2>   macro with atomic args, no punctuation "(;,:)" inside.
+ x <strng1> <strng2>   exclude text section from strng1 to strng2.
+ a <mac1>   <mac2>     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 <stdio.h>   /* 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<max) Then
+       cadd(s,c); Inc(i) 
+    EndIf
+    done= (c=='\n') Or (c==Cr)
+  Done
+EndProc
+
+/*****************/
+
+Proc saddn( Pchar s, Pchar t, short n)
+Begin
+  Str(250,u);
+  short lt= length(t);
+  If lt<= n Then 
+    sadd(s,t) 
+  Else
+    pscopy(u,t,1,n); 
+    sadd(s,u)
+  EndIf
+EndProc
+
+Proc allocdata(void)
+Begin /* prevent any string overflow */
+  short i;
+  For i=0; i<nsub; Inc(i) Do
+    Sini(search[i]); 
+    Sini(replace[i])
+  Done 
+EndProc
+
+Proc setOptions(Pchar s)
+/* command-line options c-mode and/or lookahead buffer size */
+Begin
+  short j,k; 
+  Bool num; 
+  short z; 
+  char c;
+/*-StartProc-*/
+  ws("Options: ");
+  For j=1; j<length(s); Inc(j) Do /*scan for option setting chars */
+    If s[j]=='C' Then 
+       cMode=True; ws("cMode ") 
+    EndIf
+    If s[j]=='L' Then /*redefine max lookahead length */
+      z=0; 
+      k= (short)(j+1);
+      Repeat
+        Inc(k); c=s[k]; 
+        num= (c>='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); i<b; Inc(i) Do
+    c=t[i]; 
+    If (c>0) And (c<' ') Then leader=True EndIf
+    If cMode And (c=='/') And (t[i+1]=='*') Then comment=1 EndIf
+    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=(tstart<lt);
+  While ok And (i<n) Do
+    ok= (j<lt) And ((s[i]==t[j]) Or (s[i]==joker));
+    Inc(i); Inc(j);
+  Done
+  return ok
+EndFunc
+
+Func short posi(Pchar sub, Pchar s)
+Begin /*re-defines Turbo Pos, result Pascal compatible */
+  short a,b,k; 
+  Bool ok;
+/*-StartProc-*/ 
+  ok=False;
+  a=length(sub); 
+  b=(short)(length(s)-a); 
+  k=0;
+  If a>0 Then  /*Else return 0*/
+    While (k<=b) And (Not ok) Do
+      ok=match(sub,s, a,k); /*remark we must start at k=0 ! */
+      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=(tstart<lt);
+  While ok And (i<n) Do
+    If s[i]==' ' Then /* always Ok, skip space in t */
+      If cMode Then 
+        j=skipCwhite(t,j,lt) 
+      Else
+        While (j<=lt) And (t[j]<=' ') And (t[j]>0) 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 (isr<nsub) And   (cpos(s[0],"swmuxa") >0) 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. 
+ <white> means space excluding \n,  and <white2>, space including newlines.
+ Wanted: regular-expression scripts or tricks to do the same or better...
+ 
+ Rule1:  <white>Lf<white>; --> ;<white>Lf<white>       states 2 3 
+ Rule2:  ;<white2>;         --> ;<white2>              state  1  
+ Rule3:  }<white2>;         --> }<white2>              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; i<iobf; Inc(i) Do 
+        fputc(obf[i], fout) 
+      Done
+      iobf=0; 
+      wstate=0
+    EndIf
+  ElsIf wstate==2 Then
+    obf[iobf]=c; Inc(iobf); 
+    If c==Lf Then  
+      wstate=3
+    ElsIf c<=' ' Then /* keep state */
+    Else  
+      For i=0; i<iobf; Inc(i) Do 
+        fputc(obf[i], fout) 
+      Done
+      iobf=0; 
+      wstate=0
+    EndIf
+  ElsIf wstate==3 Then
+    obf[iobf]=c; Inc(iobf); 
+    If c<=' ' Then /* keep state */
+    Else
+      If c==';' Then 
+        Dec(iobf); fputc(c, fout) 
+      EndIf
+      For i=0; i<iobf; Inc(i) Do 
+        fputc(obf[i], fout) 
+      Done
+      iobf=0; 
+      wstate=0
+    EndIf
+  EndIf
+EndProc
+
+Proc washflush(void)
+Begin
+  short i;
+  If NotZ(wstate) Then
+    For i=0; i<iobf; Inc(i) Do 
+      fputc(obf[i], fout) 
+    Done
+    iobf=0; 
+    wstate=0
+  EndIf
+EndProc
+
+Proc washstring( Pchar s)
+Begin
+  short i;
+  For i=0; i<length(s); Inc(i) Do 
+    washchar(s[i]) 
+  Done
+EndProc
+   
+/************* main part of translation filter  ***********/
+
+Proc translate(Pchar bf);  /* recursion */
+
+Proc echoOut(Pchar r, char isWild, string mac[] )
+Begin
+  short u; 
+  Str(250,s);
+/*-StartProc-*/
+  If isWild !=0 Then
+     u= cpos(isWild,r) 
+  Else 
+    u=0 
+  EndIf
+  If u==0 Then 
+    washstring(r) 
+  Else /*substitute with wildcard*/
+    pscopy(s,r, (Word)1, (Word)(u-1)); washstring(s);
+    If isWild==joker Then 
+      washchar(mac[nargs][0])
+    ElsIf Recursion Then 
+      translate(mac[nargs])
+    Else 
+      washstring(mac[nargs]) 
+    EndIf
+    scopy(mac[nargs], "");
+    pscopy(s,r, (Word)(u+1), (Word)40); 
+    washstring(s);
+  EndIf
+EndProc
+
+Proc macroOut(Pchar r, string mac[] )
+Begin
+/* substitutes "1"..."9", uses "0" as escape character*/
+  char c; 
+  short i,j; 
+  Bool escape;
+/*-StartProc-*/ 
+  escape=False;
+  For i=0; i<length(r); Inc(i) Do
+    c=r[i]; 
+    j= (short)(c-'0');
+    If j==0 Then 
+      escape=True /*And skip*/
+    ElsIf ((j>0) And (j<nargs)) And (Not escape) Then
+      If Recursion Then 
+        translate(mac[j]) 
+      Else 
+        washstring(mac[j]) 
+      EndIf
+    Else 
+      washchar(c); 
+      escape=False 
+    EndIf
+  Done
+EndProc
+
+Proc makeNewRule(Pchar r, string mac[] )
+Begin
+/* substitutes "1"..."9", uses "0" as escape character*/
+  char c; 
+  short i,j; 
+  Bool escape; 
+  Str(250,s);
+/*-StartProc-*/ 
+  escape=False; 
+  For i=0; i<length(r); Inc(i) Do
+    c=r[i]; 
+    j= (short)(c-'0');
+    If j==0 Then 
+      escape=True /*And skip*/
+    ElsIf ((j>0) And (j<nargs)) And (Not escape) Then
+      sadd(s,mac[j])
+    Else 
+      cadd(s,c); escape=False 
+    EndIf
+  Done
+  isr= addSubList(s,isr)
+EndProc
+
+Proc translate(Pchar bff)
+Begin /*light version, inside recursion only */
+  Bool  done; 
+  Str(250,bf);
+  Darray(mac, string, nargs)
+  Bool ok; 
+  short i,sm; 
+  char lastBf1; 
+  Word nbrep;
+/*-StartProc-*/
+  For i=0; i<nargs; Inc(i) Do 
+    Sini(mac[i]) 
+  Done
+  nbrep=0;
+  done= Zero(bff[0]); 
+  lastBf1=' ';
+  If Not done Then scopy(bf,bff) EndIf
+  While Not done Do
+    i=1; 
+    ok=False; sm=0;
+    While (i<=isr) And (Not ok) Do /*search For 1st match*/
+      If (srule[i]=='m') Or (srule[i]=='u') 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
+    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; i<nargs; Inc(i) Do 
+    Sini(mac[i]) 
+  Done
+  nbrep=0; 
+  nline=0;
+  exclusion=0; /* will be >0 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)<lookmax) Do /*refill buffer*/
+      If Not feof(fin) Then
+	c=fgetc(fin);
+	If (c== Cr) Or (c== Lf) Then 
+          Inc(nline);
+	  If odd(nline) Then wc('.') EndIf
+          If (nline Mod 150)==0 Then wln() EndIf
+        EndIf
+        If (c==0) Or feof(fin) Then c=' ' EndIf /*== space*/
+      Else 
+        c=0 
+      EndIf
+      If NotZ(c) Then cadd(bf,c) EndIf
+    Done
+    ok=False; 
+    sm=0; i=0;
+    If exclusion>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
+