xpressn.c

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

/*       xpressn.c                Copyright (C)  2002    Georg Post
 *
 *  This file is part of Numparam, see:  readme.txt  
 *  Free software under the terms of the GNU Lesser General Public License 
 */

#include <stdio.h>   /* for function message() only. */
#include <math.h>

#include "general.h"
#include "numparam.h"

/************ keywords ************/

/* SJB - 150 chars is ample for this - see initkeys() */
Intern Str(150, keys); /*all my keywords*/
Intern Str(150, fmath); /* all math functions */
 
Intern
Proc initkeys(void)
/* the list of reserved words */
Begin
  scopy(keys,
  "and or not div mod if else end while macro funct defined"
  " include for to downto is var"); 
  stupcase(keys);
  scopy(fmath, "sqr sqrt sin cos exp ln arctan abs pwr"); 
  stupcase(fmath);
EndProc

Intern
Func double mathfunction(short f, double z, double x)
/* the list of built-in functions. Patch 'fmath' and here to get more ...*/
Begin
  double y;
  Switch f
  CaseOne 1 Is  y= x*x
  Case    2 Is  y= sqrt(x)
  Case    3 Is  y= sin(x)
  Case    4 Is  y= cos(x)
  Case    5 Is  y= exp(x)
  Case    6 Is  y= ln(x)
  Case    7 Is  y= atan(x)
  Case    8 Is  y= fabs(x)
  Case    9 Is  y= exp( x* ln(fabs(z))) 
     /* pwr(,): the only one with 2 args */
  Default y=x EndSw
  return y
EndFunc

Cconst(Defd,12)
/* serial numb. of 'defined' keyword. The others are not used (yet) */

Intern
Func  Bool message( tdico * dic, Pchar s)
/* record 'dic' should know about source file and line */
Begin
  Strbig(Llen,t);
  Inc( dic->errcount);
  If (dic->srcfile != Null) And NotZ(dic->srcfile[0]) Then  
    scopy(t, dic->srcfile); cadd(t,':')
  EndIf
  If dic->srcline >=0 Then
    nadd(t,dic->srcline); sadd(t,": ");
  EndIf
  sadd(t,s); cadd(t,'\n');
  fputs(t,stderr); 
  return True /*error!*/
EndFunc

Proc debugwarn( tdico *d, Pchar s)
Begin
  message(d,s);
  Dec( d->errcount)
EndProc

/************* historical: stubs for nodetable manager ************/
/* in the full preprocessor version there was a node translator for spice2 */

Intern
Proc initsymbols(auxtable * n)
Begin
EndProc

Intern
Proc donesymbols(auxtable * n)
Begin
EndProc

/* Intern
Func short parsenode(auxtable *n, Pchar s)
Begin
  return 0
EndFunc
*/

/************ the input text symbol table (dictionary) *************/

Proc initdico(tdico * dico)
Begin
  short i;
  dico->nbd=0;  
  Sini(dico->option);
  Sini(dico->srcfile);
  dico->srcline= -1;
  dico->errcount= 0;
  For i=0; i<=Maxdico; Inc(i) Do
    sini(dico->dat[i].nom,20) 
  Done
  dico->tos= 0; 
  dico->stack[dico->tos]= 0; /* global data beneath */
  initsymbols(Addr(dico->nodetab));
  initkeys();
EndProc

/*  local semantics for parameters inside a subckt */
/*  arguments as wll as .param expressions  */  
/* to do:  scope semantics ?
   "params:" and all new symbols should have local scope inside subcircuits.
   redefinition of old symbols gives a warning message.
*/

Cconst(Push,'u')
Cconst(Pop, 'o')

Intern
Proc dicostack(tdico *dico, char op) 
/* push or pop operation for nested subcircuit locals */
Begin

  If op==Push Then
    If dico->tos < (20-1) Then Inc(dico->tos)
    Else message(dico, " Subckt Stack overflow")
    EndIf 
    dico->stack [dico->tos]= dico->nbd;
  ElsIf op==Pop Then
    /*       obsolete:  undefine all data items of level dico->tos  
    For i=dico->nbd; i>0; Dec(i) Do 
      c= dico->dat[i].tp;
      If ((c=='R') Or (c=='S')) And (dico->dat[i].level == dico->tos) Then 
        dico->dat[i].tp= '?' 
      EndIf 
    Done
    */
    If dico->tos >0 Then
      dico->nbd= dico->stack[dico->tos]; /* simply kill all local items */
      Dec(dico->tos)
    Else message(dico," Subckt Stack underflow.") 
    EndIf 
  EndIf
EndProc

Func short donedico(tdico * dico)
Begin
  short sze= dico->nbd;
  donesymbols(Addr(dico->nodetab));
  return sze;
EndProc

Intern
Func  short entrynb( tdico * d, Pchar s)
/* symbol lookup from end to start,  for stacked local symbols .*/
/* bug: sometimes we need access to same-name symbol, at lower level? */
Begin
  short i;
  Bool ok;
  ok=False;
  i=d->nbd+1;
  While (Not ok) And (i>1) Do
    Dec(i);
    ok= steq(d->dat[i].nom, s);
  Done
  If Not ok Then 
    return 0 
  Else 
    return i 
  EndIf
EndFunc

Func char getidtype( tdico *d, Pchar s)
/* test if identifier s is known. Answer its type, or '?' if not in list */
Begin
  char itp='?'; /* assume unknown */
  short i= entrynb(d, s);
  If i >0 Then itp= d->dat[i].tp EndIf
  return itp
EndFunc

Intern
Func double fetchnumentry(
 tdico * dico,
 Pchar t,
 Bool * perr)
Begin
  Bool err= *perr;
  Word k;
  double u;
  Strbig(Llen, s);
  k=entrynb(dico,t); /*no keyword*/
  /*dbg -- If k<=0 Then ws("Dico num lookup fails. ") EndIf */
  While (k>0) And (dico->dat[k].tp=='P') Do 
    k= dico->dat[k].ivl 
  Done  /*pointer chain*/
  If k>0 Then
    If dico->dat[k].tp!='R' Then k=0 EndIf
  EndIf
  If k>0 Then 
    u=dico->dat[k].vl 
  Else
    u=0.0; 
    scopy(s,"Undefined number ["); sadd(s,t); cadd(s,']');
    err=message( dico, s)
  EndIf
  *perr= err;
  return u
EndFunc

/*******  writing dictionary entries *********/

Intern
Func  short attrib( tdico * dico, Pchar t, char  op)
Begin
/* seek or attribute dico entry number for string t.
   Option  op='N' : force a new entry, if tos>level and old is  valid.
*/
  short i;
  Bool ok;
  i=dico->nbd+1;
  ok=False;
  While (Not ok) And (i>1) Do /*search old*/
    Dec(i); 
    ok= steq(dico->dat[i].nom,t);
  Done
  If ok And (op=='N') 
     And ( dico->dat[i].level < dico->tos)
     And ( dico->dat[i].tp != '?')
  Then ok=False EndIf
  If Not ok Then
    Inc(dico->nbd); 
    i= dico->nbd;
    If dico->nbd > Maxdico Then 
      i=0 
    Else
      scopy(dico->dat[i].nom,t); 
      dico->dat[i].tp='?'; /*signal Unknown*/
      dico->dat[i].level= dico->tos;
    EndIf
  EndIf
  return i
EndFunc

Intern
Func  Bool define(
 tdico * dico,
 Pchar t,      /* identifier to define */
 char  op,     /* option */
 char tpe,     /* type marker */
 double  z,    /* float value if any */
 Word  w,      /* integer value if any */ 
 Pchar base)   /* string pointer if any */
Begin
/*define t as real or integer, 
  opcode= 'N' impose a new item under local conditions. 
  check for pointers, too, in full macrolanguage version:
     Call with 'N','P',0.0, ksymbol ... for VAR parameter passing.
  Overwrite warning, beware: During 1st pass (macro definition),
      we already make symbol entries which are dummy globals !
      we mark each id with its subckt level, and warn if write at higher one.
*/
  short i;
  char c;
  Bool err, warn;
  Strbig(Llen,v);
  i=attrib(dico,t,op); 
  err=False;
  If i<=0 Then 
    err=message( dico," Symbol table overflow")
  Else
    If dico->dat[i].tp=='P' Then 
      i= dico->dat[i].ivl 
    EndIf; /*pointer indirection*/
    If i>0 Then 
      c=dico->dat[i].tp 
    Else 
      c=' ' 
    EndIf
    If (c=='R') Or (c=='S') Or (c=='?') Then
      dico->dat[i].vl=z; 
      dico->dat[i].tp=tpe; 
      dico->dat[i].ivl=w;
      dico->dat[i].sbbase= base;
      /* If (c !='?') And (i<= dico->stack[dico->tos]) Then  */
      If c=='?' Then 
        dico->dat[i].level= dico->tos 
      EndIf /* promote! */ 
      If dico->dat[i].level < dico->tos Then 
        /* warn about re-write to a global scope! */
        scopy(v,t); cadd(v,':'); 
        nadd(v,dico->dat[i].level);
        sadd(v," overwritten.");  
        warn=message( dico,v);
      EndIf 
    Else
      scopy(v,t); 
      sadd(v,": cannot redefine");  
      err=message( dico,v);
    EndIf
  EndIf
  return err;
EndFunc

Func Bool defsubckt(tdico *dico, Pchar s, Word w, char categ)
/* called on 1st pass of spice source code, 
   to enter subcircuit (categ=U) and model (categ=O) names 
*/
Begin
  Str(80,u);
  Bool err;
  short i,j,ls;
  ls=length(s);
  i=0; 
  While (i<ls) And (s[i] !='.') Do Inc(i) Done /* skip 1st dotword */
  While (i<ls) And (s[i]>' ') Do Inc(i) Done
  While (i<ls) And (s[i]<=' ') Do Inc(i) Done /* skip blank */
  j=i; 
  While (j<ls) And (s[j]>' ') Do Inc(j) Done
  If (j>i) And alfa(s[i]) Then
    pscopy(u,s, i+1, j-i);
    stupcase(u);
    err= define( dico, u, ' ',categ, 0.0, w, Null);
  Else
    err= message( dico,"Subcircuit or Model without name.");
  EndIf
  return err
EndFunc

Func short findsubckt( tdico *dico, Pchar s, Pchar subname)
/* input: s is a subcircuit invocation line.
   returns 0 if not found, else the stored definition line number value
   and the name in string subname  */
Begin
  Str(80,u); /* u= subckt name is last token in string s */
  short i,j,k;
  k=length(s); 
  While (k>=0) And (s[k]<=' ') Do Dec(k) Done
  j=k;
  While (k>=0) And (s[k]>' ') Do Dec(k) Done
  pscopy(u,s, k+2, j-k);
  stupcase(u);
  i= entrynb(dico,u);
  If (i>0) And (dico->dat[i].tp == 'U')  Then 
    i= dico->dat[i].ivl;
    scopy(subname,u) 
  Else 
    i= 0;
    scopy(subname,"");
    message(dico, "Cannot find subcircuit.");  
  EndIf
  return i
EndFunc  

#if 0   /* unused, from the full macro language... */
Intern
Func  short deffuma(  /* define function or macro entry. */
 tdico * dico, Pchar t, char  tpe, Word bufstart,
 Bool * pjumped, Bool * perr)
Begin
  Bool jumped= *pjumped; Bool err= *perr;
/* if not jumped, define new function or macro, returns index to buffferstart
   if jumped, return index to existing function
*/
  short i,j;
  Strbig(Llen, v);
  i=attrib(dico,t,' '); j=0;
  If i<=0 Then
    err=message( dico," Symbol table overflow")
  Else
    If dico->dat[i].tp != '?' Then /*old item!*/
      If jumped Then 
        j=dico->dat[i].ivl
      Else
        scopy(v,t); sadd(v," already defined");  
        err=message( dico,v)
      EndIf
    Else
      dico->dat[i].tp=tpe; 
      Inc(dico->nfms); j=dico->nfms; 
      dico->dat[i].ivl=j;
      dico->fms[j].start= bufstart; /* =ibf->bufaddr = start addr in buffer */
    EndIf
  EndIf
  *pjumped= jumped; 
  *perr= err;
  return j;
EndFunc
#endif

/************ input scanner stuff **************/

Intern
Func  Byte keyword( Pchar keys, Pchar t)
Begin
/* return 0 if t not found in list keys, else the ordinal number */
 Byte i,j,k;
 short lt,lk;
 Bool ok;
  lt=length(t); 
  lk=length(keys); 
  k=0; j=0;
  Repeat 
    Inc(j); 
    i=0; ok=True;
    Repeat 
      Inc(i); Inc(k); 
      ok= (k<=lk) And (t[i-1]==keys[k-1]);
    Until (Not ok) Or (i>=lt) EndRep
    If ok Then 
      ok=(k==lk) Or (keys[k]<=' ') 
    EndIf
    If Not ok And (k<lk) Then /*skip to next item*/
      While (k<=lk) And (keys[k-1]>' ') Do Inc(k) Done
    EndIf
  Until ok Or (k>=lk) EndRep
  If ok Then 
    return j 
  Else 
    return 0 
  EndIf
EndFunc

Intern
Func  double parseunit( double x, Pchar s)
/* the Spice suffixes */
Begin
  double u;
  Str(20, t);
  Bool isunit;
  isunit=True; 
  pscopy(t,s,1,3);
  If steq(t,"MEG") Then
    u=1e6
  ElsIf s[0]=='G' Then
    u=1e9
  ElsIf s[0]=='K' Then
    u=1e3
  ElsIf s[0]=='M' Then
    u=0.001
  ElsIf s[0]=='U' Then
    u=1e-6
  ElsIf s[0]=='N' Then
    u=1e-9
  ElsIf s[0]=='P' Then
    u=1e-12
  ElsIf s[0]=='F' Then
    u=1e-15
  Else 
    isunit=False 
  EndIf
  If isunit Then x=x*u EndIf
  return x
EndFunc

Intern
Func  short fetchid(
 Pchar s, Pchar t,
 short  ls, short i)
/* copy next identifier from s into t, advance and return scan index i */
Begin
  char c;
  Bool ok;
  c=s[i-1];
  While (Not alfa(c)) And (i<ls) Do 
    Inc(i); c=s[i-1] 
  Done
  scopy(t,""); 
  cadd(t,upcase(c)); 
  Repeat 
    Inc(i);
    If i<=ls Then 
      c=s[i-1] 
    Else 
      c=Nul 
    EndIf
    c= upcase(c);
    ok= ((c>='0') And (c<='9')) Or ((c>='A') And (c<='Z'));
    If ok Then cadd(t,c) EndIf
  Until Not ok EndRep
  return i /*return updated i */
EndFunc

Intern
Func  double exists(
 tdico * d,
 Pchar  s,
 short * pi,
 Bool * perror)
/* check if s in smboltable 'defined': expect (ident) and return 0 or 1 */
Begin
  Bool error= *perror; 
  short i= *pi;
  double x;
  short ls;
  char c;
  Bool ok;
  Strbig(Llen, t);
  ls=length(s); 
  x=0.0;
  Repeat 
    Inc(i);
    If i>ls Then
      c=Nul 
    Else 
      c=s[i-1]
    EndIf; 
    ok= (c=='(')
  Until ok Or (c==Nul) EndRep
  If ok Then 
    i=fetchid(s,t, ls,i); Dec(i);