xpressn.c

ngspice又一个电子CAD仿真软件代码.功能更全

    If entrynb(d,t)>0 Then x=1.0 EndIf
    Repeat 
      Inc(i);
      If i>ls Then 
        c=Nul 
      Else 
        c=s[i-1] 
      EndIf 
      ok= (c==')')
    Until ok Or (c==Nul) EndRep
  EndIf
  If Not ok Then
    error=message( d," Defined() syntax");
  EndIf /*keep pointer on last closing ")" */
  *perror= error; 
  *pi=i;
  return x;
EndFunc

Intern
Func double fetchnumber( tdico *dico,
 Pchar s, short  ls,
 short * pi,
 Bool * perror)
/* parse a Spice number in string s */
Begin
  Bool error= *perror; 
  short i= *pi;
  short k,err;
  char d;
  Str(20, t); 
  Strbig(Llen, v);
  double u;
  k=i;
  Repeat 
    Inc(k);
    If k>ls Then 
      d=chr(0) 
    Else 
      d=s[k-1] 
    EndIf
  Until Not ((d=='.') Or ((d>='0') And (d<='9')))  EndRep
  If (d=='e') Or (d=='E') Then /*exponent follows*/
    Inc(k); d=s[k-1];
    If (d=='+') Or (d=='-') Then Inc(k) EndIf
    Repeat 
      Inc(k); 
      If k>ls Then 
        d=chr(0) 
      Else 
        d=s[k-1] 
      EndIf
    Until Not ((d>='0') And (d<='9')) EndRep
  EndIf
  pscopy(t,s,i, k-i);
  If t[0]=='.' Then 
    cins(t,'0')
  ElsIf t[length(t)-1]=='.' Then 
    cadd(t,'0') 
  EndIf
  u= rval(t, Addr(err));
  If err!=0 Then
    scopy(v,"Number format error: "); 
    sadd(v,t);
    error=message( dico,v)
  Else
    scopy(t,"");
    While alfa(d) Do 
      cadd(t,upcase(d));
      Inc(k); 
      If k>ls Then 
        d=Nul 
      Else 
        d=s[k-1] 
      EndIf
    Done
    u=parseunit(u,t);
  EndIf
  i=k-1;
  *perror= error; 
  *pi=i;
  return u;
EndFunc

Intern
Func  char fetchoperator( tdico *dico,
 Pchar s, short  ls,
 short * pi,
 Byte * pstate, Byte * plevel,
 Bool * perror)
/* grab an operator from string s and advance scan index pi.
   each operator has: one-char alias, precedence level, new interpreter state.
*/
Begin
  short i= *pi; 
  Byte state= *pstate; 
  Byte level= *plevel;
  Bool error= *perror;
  char c,d;
  Strbig(Llen, v);
  c=s[i-1];  
  If i<ls Then 
    d=s[i] 
  Else 
    d=Nul 
  EndIf
  If (c=='!') And (d=='=') Then 
    c='#'; Inc(i)
  ElsIf (c=='<') And (d=='>') Then 
    c='#'; Inc(i)
  ElsIf (c=='<') And (d=='=') Then 
    c='L'; Inc(i)
  ElsIf (c=='>') And (d=='=') Then 
    c='G'; Inc(i)
  ElsIf (c=='*') And (d=='*') Then 
    c='^'; Inc(i)
  ElsIf (c=='=') And (d=='=') Then 
    Inc(i)
  ElsIf (c=='&') And (d=='&') Then 
    Inc(i)
  ElsIf (c=='|') And (d=='|') Then 
    Inc(i)
  EndIf;
  If (c=='+') Or (c=='-') Then
    state=2; /*pending operator*/ 
    level=4;
  ElsIf (c=='*')Or (c=='/') Or (c=='%')Or(c=='\\') Then
    state=2; level=3;
  ElsIf c=='^' Then
    state=2; level=2;
  ElsIf cpos(c,"=<>#GL") >0 Then
    state=2; level= 5;
  ElsIf c=='&' Then
    state=2; level=6;
  ElsIf c=='|' Then
    state=2; level=7;
  ElsIf c=='!' Then
    state=3;
  Else state=0;
    If c>' ' Then
      scopy(v,"Syntax error: letter ["); 
      cadd(v,c); cadd(v,']');
      error=message( dico,v);
    EndIf
  EndIf
  *pi=i; 
  *pstate=state; 
  *plevel=level; 
  *perror=error;
  return c;
EndFunc

Intern
Func  char opfunctkey( tdico *dico,
 Byte  kw, char  c,
 Byte * pstate, Byte * plevel, Bool * perror)
/* handle operator and built-in keywords */
Begin
  Byte state= *pstate; 
  Byte level= *plevel;  
  Bool error= *perror;
/*if kw operator keyword, c=token*/
  Switch kw  /*AND OR NOT DIV MOD  Defined*/
  CaseOne 1 Is 
     c='&'; state=2; level=6
  Case 2 Is 
     c='|'; state=2; level=7
  Case 3 Is
     c='!'; state=3; level=1
  Case 4 Is
     c='\\'; state=2; level=3
  Case 5 Is
     c='%'; state=2; level=3
  Case Defd Is
     c='?'; state=1; level=0
  Default 
     state=0;
     error=message( dico," Unexpected Keyword");
  EndSw /*case*/
  *pstate=state; 
  *plevel=level; 
  *perror=error;
  return c
EndFunc

Intern
Func  double operate(
 char  op,
 double  x,
 double  y)
Begin
/* execute operator op on a pair of reals */
/* bug:   x:=x op y or simply x:=y for empty op?  No error signalling! */
  double u=1.0;
  double z=0.0;
  double epsi=1e-30;
  double t;
  Switch op
  CaseOne ' ' Is  
    x=y; /*problem here: do type conversions ?! */
  Case '+' Is  
    x=x+y;
  Case '-' Is  
    x=x-y;
  Case '*' Is  
    x=x*y;
  Case '/' Is  
    If absf(y)>epsi Then x=x/y EndIf
  Case '^' Is  /*power*/ 
    t=absf(x);
    If t<epsi Then 
      x=z 
    Else 
      x=exp(y*ln(t)) 
    EndIf
  Case '&' Is  /*And*/ 
    If y<x Then x=y EndIf; /*=Min*/
  Case '|' Is  /*Or*/ 
    If y>x Then x=y EndIf;  /*=Max*/
  Case '=' Is  
    If x == y Then x=u Else x=z EndIf;
  Case '#' Is  /*<>*/ 
    If x != y Then x=u Else x=z EndIf;
  Case '>' Is  
    If x>y Then x=u Else x=z EndIf;
  Case '<' Is  
    If x<y Then x=u Else x=z EndIf;
  Case 'G' Is  /*>=*/ 
    If x>=y Then x=u Else x=z EndIf;
  Case 'L' Is  /*<=*/ 
    If x<=y Then x=u Else x=z EndIf;
  Case '!' Is  /*Not*/ 
    If y==z Then x=u Else x=z EndIf;
  Case '%' Is  /*Mod*/ 
    t= np_trunc(x/y); 
    x= x-y*t
  Case '\\' Is  /*Div*/ 
    x= np_trunc(absf(x/y));
  EndSw /*case*/
  return x;
EndFunc

Intern
Func  double formula(
 tdico * dico,
 Pchar  s,
 Bool * perror)
Begin
/* Expression parser. 
  s is a formula with parentheses and math ops +-* / ...
  State machine and an array of accumulators handle operator precedence.
  Parentheses handled by recursion.
  Empty expression is forbidden: must find at least 1 atom.
  Syntax error if no toggle between binoperator And (unop/state1) !
  States : 1=atom, 2=binOp, 3=unOp, 4= stop-codon. 
  Allowed transitions:  1->2->(3,1) and 3->(3,1).
*/
  Cconst(nprece,9) /*maximal nb of precedence levels*/
  Bool error= *perror;
  Byte state,oldstate, topop,ustack, level, kw, fu;
  double u=0.0,v;
  double accu[nprece+1];
  char oper[nprece+1];
  char uop[nprece+1];
  short i,k,ls,natom, arg2;
  char c,d;
  Strbig(Llen, t);
  Bool ok;
  For i=0; i<=nprece; Inc(i) Do 
    accu[i]=0.0; oper[i]=' ' 
  Done
  i=0; 
  ls=length(s);
  While(ls>0) And (s[ls-1]<=' ') Do Dec(ls) Done /*clean s*/
  state=0; natom=0; ustack=0; 
  topop=0; oldstate=0; fu=0; 
  error=False;
  While (i<ls) And (Not error) Do
    Inc(i); c=s[i-1]; 
    If c=='(' Then /*sub-formula or math function */ 
      level=1;
      /* new: must support multi-arg functions */
      k=i; 
      arg2=0; v=1.0;
      Repeat 
        Inc(k);
        If k>ls Then 
          d=chr(0) 
        Else 
          d=s[k-1] 
        EndIf
        If d=='(' Then 
          Inc(level) 
        ElsIf d==')' Then 
          Dec(level) 
        EndIf
        If (d==',') And (level==1) Then arg2=k EndIf /* comma list? */
      Until (k>ls) Or ((d==')') And (level<=0)) EndRep
      If k>ls Then 
        error=message( dico,"Closing \")\" not found.");
        Inc(natom); /*shut up other error message*/
      Else
        If arg2 > i Then
          pscopy(t,s,i+1, arg2-i-1);
	  v=formula( dico, t, Addr(error));
          i=arg2;
        EndIf
        pscopy(t,s,i+1, k-i-1);
	u=formula( dico, t, Addr(error)); 
        state=1; /*atom*/
        If fu>0 Then 
          u= mathfunction(fu,v,u) 
        EndIf
      EndIf
      i=k; fu=0;
    ElsIf alfa(c) Then
      i=fetchid(s,t, ls,i); /*user id, but sort out keywords*/
      state=1; 
      Dec(i);
      kw=keyword(keys,t); /*debug ws('[',kw,']'); */
      If kw==0 Then 
        fu= keyword(fmath,t); /* numeric function? */
        If fu==0 Then
          u=fetchnumentry( dico, t, Addr(error))
        Else 
          state=0 
        EndIf /* state==0 means: ignore for the moment */
      Else 
        c=opfunctkey( dico, kw,c, Addr(state), Addr(level) ,Addr(error)) 
      EndIf
      If kw==Defd Then 
        u=exists( dico, s, Addr(i), Addr(error)) 
      EndIf
    ElsIf ((c=='.') Or ((c>='0') And (c<='9'))) Then
      u=fetchnumber( dico, s,ls, Addr(i), Addr(error));
      state=1;
    Else
      c=fetchoperator(dico, s,ls,
         Addr(i), Addr(state),Addr(level),Addr(error));
      /*may change c to some other operator char!*/
    EndIf /* control chars <' '  ignored*/
    ok= (oldstate==0) Or (state==0) Or
      ((oldstate==1) And (state==2)) Or ((oldstate!=1)And(state!=2));
    If Not ok Then 
      error=message( dico," Misplaced operator") 
    EndIf
    If state==3 Then /*push unary operator*/
      Inc(ustack); 
      uop[ustack]=c;
    ElsIf state==1 Then /*atom pending*/ Inc(natom);
      If i>=ls Then 
        state=4; level=topop 
      EndIf /*close all ops below*/
      For k=ustack; k>=1; Dec(k) Do
        u=operate(uop[k],u,u) 
      Done
      ustack=0;
      accu[0]=u; /* done: all pending unary operators */
    EndIf
    If (state==2) Or (state==4) Then
      /* do pending binaries of priority Upto "level" */
      For k=1; k<=level; Inc(k) Do /* not yet speed optimized! */
        accu[k]=operate(oper[k],accu[k],accu[k-1]);
        accu[k-1]=0.0; 
        oper[k]=' '; /*reset intermediates*/
      Done
      oper[level]=c; 
      If level>topop Then topop=level EndIf
    EndIf
    If (state>0) Then oldstate=state EndIf
  Done /*while*/;
  If (natom==0) Or (oldstate!=4) Then 
    scopy(t," Expression err: "); 
    sadd(t,s);
    error=message( dico,t) 
  EndIf
  *perror= error;
  If error Then
    return 1.0 
  Else 
    return  accu[topop] 
  EndIf
EndFunc /*formula*/

Intern
Func  char fmttype( double  x)
Begin
/* I=integer, P=fixedpoint F=floatpoint*/
/*  find out the "natural" type of format for number x*/
  double ax,dx;
  short rx;
  Bool isint,astronomic;
  ax=absf(x); 
  isint=False; 
  astronomic=False;
  If ax<1e-30 Then
    isint=True;
  ElsIf ax<32000 Then /*detect integers*/ rx=np_round(x);
    dx=(x-rx)/ax; 
    isint=(absf(dx)<1e-6);
  EndIf
  If Not isint Then 
    astronomic= (ax>=1e6) Or (ax<0.01) 
  EndIf
  If isint Then 
    return 'I'
  ElsIf astronomic Then 
    return 'F'
  Else 
    return 'P' 
  EndIf
EndFunc

Intern
Func  Bool evaluate(
 tdico * dico,
 Pchar q,
 Pchar t,
 Byte  mode)
Begin
/* transform t to result q. mode 0: expression, mode 1: simple variable */
  double u=0.0;
  short k,j,lq;
  char dt,fmt;
  Bool numeric, done, nolookup;
  Bool err;
  Strbig(Llen, v);
  scopy(q,""); 
  numeric=False; err=False;
  If mode==1 Then /*string?*/
    stupcase(t);
    k=entrynb(dico,t);
    nolookup= ( k<=0 );
    While (k>0) And (dico->dat[k].tp=='P') Do 
      k=dico->dat[k].ivl 
    Done
      /*pointer chain*/
    If k>0 Then 
      dt=dico->dat[k].tp 
    Else 
      dt=' ' 
    EndIf;
      /*data type: Real or String*/
    If dt=='R' Then
       u=dico->dat[k].vl; numeric=True
    ElsIf dt=='S' Then /*suppose source text "..." at*/
      j=dico->dat[k].ivl; 
      lq=0;
      Repeat 
        Inc(j); Inc(lq); 
        dt= /*ibf->bf[j]; */ dico->dat[k].sbbase[j];
        If cpos('3',dico->option)<=0 Then 
          dt=upcase(dt) 
        EndIf /* spice-2 */
        done= (dt=='\"') Or (dt<' ') Or (lq>99);
        If Not done Then cadd(q,dt) EndIf
      Until done EndRep
    Else k=0 EndIf
    If k <= 0 Then
      scopy(v,""); 
      cadd(v,'\"'); sadd(v,t); 
      sadd(v,"\" not evaluated. ");
      If nolookup Then sadd(v,"Lookup failure.") EndIf
      err=message( dico,v)
    EndIf
  Else 
    u=formula( dico, t, Addr(err)); 
    numeric=True 
  EndIf
  If numeric Then
    fmt= fmttype(u);
    If fmt=='I' Then 
      stri(np_round(u), q) 
    Else 
      strf(u,6,-1,q) 
    EndIf /* strf() arg 2 doesnt work: always >10 significant digits ! */
  EndIf
  return err;
EndFunc

#if 0
Intern
Func  Bool scanline(
 tdico * dico,
 Pchar  s, Pchar r,
 Bool  err)
/* scan host code line s for macro substitution.  r=result line */
Begin
  short i,k,ls,level,nd, nnest;
  Bool spice3;
  char c,d;
  Strbig(Llen, q);
  Strbig(Llen, t);
  Str(20, u);
  spice3= cpos('3', dico->option) >0; /* we had -3 on the command line */
  i=0; ls=length(s); 
  scopy(r,""); 
  err=False; 
  pscopy(u,s,1,3);
  If (ls>7) And steq(u,"**&") Then /*special Comment **&AC #...*/
    pscopy(r,s,1,7); 
    i=7
  EndIf
  While (i<ls) And (Not err) Do
    Inc(i); 
    c=s[i-1];
    If c==Pspice Then /* try pspice expression syntax */
      k=i; nnest=1;
      Repeat 
        Inc(k); d=s[k-1];
        If d=='{' Then 
          Inc(nnest) 
        ElsIf d=='}' Then 
          Dec(nnest) 
        EndIf
      Until (nnest==0) Or (d==0) EndRep
      If d==0 Then 
        err=message( dico,"Closing \"}\" not found.");