luke
/
ngspice
mirror of https://git.code.sf.net/p/ngspice/ngspice
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

numparm, remove unused artifacts

This commit is contained in:
rlar 2011-02-19 15:11:53 +00:00
parent 70c97e12bb
commit 701027b1ff
8 changed files with 11 additions and 1654 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
ChangeLog
View File

@ -1,3 +1,13 @@
2011-02-19 Robert Larice
* src/frontend/numparam/Makefile.am ,
* src/frontend/numparam/general.h ,
* src/frontend/numparam/mystring.c ,
* src/frontend/numparam/numparam.h ,
* src/frontend/numparam/xpressn.c ,
* Removed src/frontend/numparam/downgrad.txt ,
* Removed src/frontend/numparam/washprog.c :
numparm, remove unused artifacts
2011-02-19 Robert Larice
* src/frontend/numparam/mystring.c ,
* src/frontend/numparam/nupatest.c ,

2
src/frontend/numparam/Makefile.am
View File

@ -1,6 +1,6 @@
## Process this file with automake to produce Makefile.in
EXTRA_DIST = downgrad.txt ngconfig.sh readme.txt nupatest.c washprog.c
EXTRA_DIST = ngconfig.sh readme.txt nupatest.c
noinst_LTLIBRARIES = libnumparam.la

89
src/frontend/numparam/downgrad.txt
View File

@ -1,89 +0,0 @@
! 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)"

29
src/frontend/numparam/general.h
View File

@ -8,15 +8,6 @@
#include "dstring.h"
#include "bool.h"
#define Use(x) x=0;x=x
#define Uses(s) s=s
#define Usep(x) x=x
typedef enum {Esc=27} _nEsc;
typedef enum {Tab=9} _nTab;
typedef enum {Bs=8} _nBs;
typedef enum {Lf=10} _nLf;
typedef enum {Cr=13} _nCr;
typedef char string[258];
@ -41,46 +32,26 @@ bool ci_prefix( register char *p, register char *s );
int length(char * s);
bool steq(char * s, char * t);
bool stne(char * s, char * t);
int scompare(char * a, char * b);
int ord(char c);
int pred(int i);
int succ(int i);
void stri(long n, SPICE_DSTRINGPTR s);
void strif(long n, int f, SPICE_DSTRINGPTR dstr_p);
void strf(double x, int a, int b, SPICE_DSTRINGPTR dstr_p); /* float -> string */
long ival(char * s, int *err);
double rval(char * s, int *err);
int posi (char *sub, char *s, int opt);
char upcase(char c);
char lowcase(char c);
int hi(long w);
int lo(long w);
bool odd(long x);
bool alfa(char c);
bool num(char c);
bool alfanum(char c);
char * stupcase( char * s);
/***** primitive input-output ***/
void wc(char c);
void wln(void);
void ws( char * s);
void wi(long i);
void rs( SPICE_DSTRINGPTR s);
char rc(void);
int freadstr(FILE * f, SPICE_DSTRINGPTR dstr_p);
char freadc(FILE * f);
long freadi(FILE * f);
long np_round(double d); // sjb to avoid clash with round() in math.h
long np_trunc(double x); // sjb to avoid clash with trunc() in math.h
double sqr(double x);
double absf(double x); /* abs */
long absi( long i);
double frac(double x);
void rawcopy(void * a, void * b, int la, int lb);
void * new(size_t sz);
void dispose(void * p);

420
src/frontend/numparam/mystring.c
View File

@ -38,34 +38,6 @@ ci_prefix (register char *p, register char *s)
return (1);
}
void
wc (char c)
{
fputc (c, stdout);
}
void
wln (void)
{
fputc ('\n', stdout);
}
void
ws (char *s)
{
fputs(s, stdout);
}
void
wi (long i)
{
SPICE_DSTRING s ;
spice_dstring_init(&s) ;
nadd (&s, i);
ws ( spice_dstring_value(&s)) ;
spice_dstring_free(&s) ;
}
void
rs ( SPICE_DSTRINGPTR dstr_p)
{
@ -81,29 +53,6 @@ rs ( SPICE_DSTRINGPTR dstr_p)
while (!((c == '\r') || (c == '\n')));
}
char
rc (void)
{
int ls;
char val ;
char *s_p ;
SPICE_DSTRING dstr ;
spice_dstring_init(&dstr) ;
rs (&dstr);
ls = spice_dstring_length (&dstr);
if (ls > 0)
{
s_p = spice_dstring_value(&dstr) ;
val = s_p[ls - 1] ;
}
else
{
val = 0 ;
}
spice_dstring_free(&dstr) ;
return val ;
}
/******* Strings ************
* are 0-terminated char arrays with a 2-byte trailer: max length.
@ -378,24 +327,6 @@ pscopy_up (SPICE_DSTRINGPTR dstr_p, char *t, int start, int leng)
return s_p ;
}
int
ord (char c)
{
return (c & 0xff);
} /* strip high byte */
int
pred (int i)
{
return (--i);
}
int
succ (int i)
{
return (++i);
}
bool
nadd ( SPICE_DSTRINGPTR dstr_p, long n)
/* append a decimal integer to a string */
@ -494,36 +425,6 @@ stri (long n, SPICE_DSTRINGPTR dstr_p)
nadd (dstr_p, n) ;
}
void
rawcopy (void *a, void *b, int la, int lb)
/* dirty binary copy */
{
int j, n;
if (lb < la)
n = lb;
else
n = la;
for (j = 0; j < n; j++)
((char *) a)[j] = ((char *) b)[j];
}
int
scompare (char *a, char *b)
{
unsigned short j = 0;
int k = 0;
while ((a[j] == b[j]) && (a[j] != 0) && (b[j] != 0))
j++;
if (a[j] < b[j])
k = -1;
else if (a[j] > b[j])
k = 1;
return k;
}
bool
steq (char *a, char *b) /* string a==b test */
{
@ -536,18 +437,6 @@ stne (char *s, char *t)
return strcmp (s, t) != 0;
}
int
hi (long w)
{
return (w & 0xff00) >> 8;
}
int
lo (long w)
{
return (w & 0xff);
}
char
lowcase (char c)
{
@ -605,46 +494,6 @@ freadstr (FILE * f, SPICE_DSTRINGPTR dstr_p)
return len ;
}
char
freadc (FILE * f)
{
return fgetc (f);
}
long
freadi (FILE * f)
/* reads next integer, but returns 0 if none found. */
{
long z = 0;
bool minus = 0;
char c;
do
{
c = fgetc (f);
}
while (!(feof (f) || !((c > 0) && (c <= ' ')))); /* skip space */
if (c == '-')
{
minus = 1;
c = fgetc (f);
}
while (num (c))
{
z = 10 * z + c - '0';
c = fgetc (f);
}
ungetc (c, f); /* re-push character lookahead */
if (minus)
z = -z;
return z;
}
char *
stupcase (char *s)
{
@ -682,12 +531,6 @@ new (size_t sz)
/***** elementary math *******/
double
sqr (double x)
{
return x * x;
}
double
absf (double x)
{
@ -706,153 +549,6 @@ absi (long i)
return (-i);
}
void
strif (long i, int f, SPICE_DSTRINGPTR dstr_p)
/* formatting like str(i:f,s) in Turbo Pascal */
{
int j, k ;
char cs;
char t[32];
char load_str[2] ; /* load dstring */
k = 0;
if (i < 0)
{
i = -i;
cs = '-';
}
else
{
cs = ' ';
}
while (i > 0)
{
j = (int) (i % 10);
i = (long) (i / 10);
t[k] = (char)('0' + j);
k++;
}
if (k == 0)
{
t[k] = '0';
k++;
}
if (cs == '-')
t[k] = cs;
else
k--;
/* now the string is in 0...k in reverse order */
for (j = 1; j <= k; j++)
t[k + j] = t[k - j]; /* mirror image */
t[2 * k + 1] = 0; /* null termination */
load_str[1] = 0 ; /* not really needed */
spice_dstring_reinit(dstr_p) ;
if ((f > k) && (f < 40))
{
/* reasonable format */
for (j = k + 2; j <= f; j++)
{
load_str[0] = ' ';
spice_dstring_append( dstr_p, load_str, 1 ) ;
}
}
for (j = 0; j <= k + 1; j++)
{
load_str[0] = t[k + j]; /* shift t down */
spice_dstring_append( dstr_p, load_str, 1 ) ;
}
}
bool
odd (long x)
{
return (x & 1);
}
static bool
match (char *s, char *t, int n, int tstart, bool testcase)
{
/* returns 0 if ( tstart is out of range. But n may be 0 ? */
/* 1 if s matches t[tstart...tstart+n] */
int i, j, lt;
bool ok;
char a, b;
i = 0;
j = tstart;
lt = length (t);
ok = (tstart < lt);
while (ok && (i < n))
{
a = s[i];
b = t[j];
if (!testcase)
{
a = upcase (a);
b = upcase (b);
}
ok = (j < lt) && (a == b);
i++;
j++;
}
return ok;
}
int
posi (char *sub, char *s, int opt)
/* find position of substring in s */
{
/* opt=0: like Turbo Pascal */
/* opt=1: like Turbo Pascal Pos, but case insensitive */
/* opt=2: position in space separated wordlist for scanners */
int a, b, k, j;
bool ok, tstcase;
SPICE_DSTRING tstr ;
ok = 0;
spice_dstring_init(&tstr) ;
tstcase = (opt == 0);
if (opt <= 1)
scopys (&tstr, sub);
else
{
cadd (&tstr, ' ');
sadd (&tstr, sub);
cadd (&tstr, ' ');
}
a = spice_dstring_length(&tstr) ;
b = (int) (length (s) - a);
k = 0;
j = 1;
if (a > 0) /* ;} else { return 0 */
while ((k <= b) && (!ok))
{
ok = match ( spice_dstring_value(&tstr), s, a, k, tstcase); /* we must start at k=0 ! */
k++;
if (s[k] == ' ')
j++; /* word counter */ ;
}
if (opt == 2)
k = j;
if (ok)
return k;
else
return 0;
}
int
spos_(char *sub, char *s)
/* equivalent to Turbo Pascal pos().
@ -868,107 +564,6 @@ spos_(char *sub, char *s)
}
void
strf (double x, int f1, int f2, SPICE_DSTRINGPTR dstr_p)
/* e-format if f2<0, else f2 digits after the point, total width=f1 */
/* if f1=0, also e-format with f2 digits */
{
/* ngspice default f1=17, f2=10 */
int dlen ; /* length of digits */
char *dbuf_p ; /* beginning of sprintf buffer */
SPICE_DSTRING fmt ; /* format string */
SPICE_DSTRING dformat ; /* format float */
spice_dstring_init(&fmt) ;
spice_dstring_init(&dformat) ;
cadd (&fmt, '%');
if (f1 > 0)
{
nadd (&fmt, f1); /* f1 is the total width */
if (f2 < 0)
sadd (&fmt, "lE"); /* exponent format */
else
{
cadd (&fmt, '.');
nadd (&fmt, f2);
sadd (&fmt, "g");
}
}
else
{
cadd (&fmt, '.');
nadd (&fmt, absi (f2 - 6)); /* note the 6 surplus positions */
cadd (&fmt, 'e');
}
dlen = 2 * (f1 + f2) + 1 ; /* be conservative */
dbuf_p = spice_dstring_setlength(&dformat, dlen) ;
sprintf (dbuf_p, spice_dstring_value(&fmt), x);
scopys( dstr_p, dbuf_p ) ;
spice_dstring_free(&fmt) ;
spice_dstring_free(&dformat) ;
}
double
rval (char *s, int *err)
/* returns err=0 if ok, else length of partial string ? */
{
double r = 0.0;
int n = sscanf (s, "%lG", &r);
if (n == 1)
(*err) = 0;
else
(*err) = 1;
return r;
}
long
ival (char *s, int *err)
/* value of s as integer string. error code err= 0 if Ok */
{
int k = 0, digit = 0, ls;
long z = 0;
bool minus = 0, ok = 1;
char c;
ls = length (s);
do
{
c = s[k];
k++;
}
while (!((k >= ls) || !((c > 0) && (c <= ' ')))); /* skip space */
if (c == '-')
{
minus = 1;
c = s[k];
k++;
}
while (num (c))
{
z = 10 * z + c - '0';
c = s[k];
k++;
digit++;
}
if (minus)
z = -z;
ok = (digit > 0) && (c == 0); /* successful end of string */
if (ok)
(*err) = 0;
else
(*err) = k; /* one beyond error position */
return z;
}
#ifndef HAVE_LIBM
@ -1006,12 +601,6 @@ np_trunc (double x)
return n;
}
double
frac (double x)
{
return x - np_trunc (x);
}
#else /* use floor() and ceil() */
long
@ -1029,13 +618,4 @@ np_trunc (double r)
return (long) ceil (r);
}
double
frac (double x)
{
if (x >= 0.0)
return (x - floor (x));
else
return (x - ceil (x));
}
#endif

1
src/frontend/numparam/numparam.h
View File

@ -13,7 +13,6 @@
#define ln(x) log(x)
#define trunc(x) floor(x)
typedef enum {Nul=0} _nNul;
typedef enum {Nodekey='#'} _nNodekey; /* Introduces node symbol */
typedef enum {Intro='&'} _nIntro; /* Introduces preprocessor tokens */
typedef enum {Comment='*'} _nComment; /* Spice Comment lines*/

996
src/frontend/numparam/washprog.c
View File

@ -1,996 +0,0 @@
/* 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(Llen, 15000)
Cconst(nsub, 100+1) /*max nbr of substitution rules */
Cconst(nargs, 11) /*max number of macro args + 1*/
Cconst(wild,'æ') /* wildcard character in patterns */
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 */
int isr; /* nb of substitution rules */
Bool cMode; /* a scanning options: c language mode */
int 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, int fmt)
Begin
int k;
For k=1; k<=fmt-length(s); Inc(k) Do
wc(' ')
Done
ws(s)
EndProc
Proc wcf(char c, int fmt)
Begin
int k;
For k=1; k<=fmt-1; Inc(k) Do
wc(' ')
Done
wc(c)
EndProc
Proc wif(long i, int fmt)
Begin /*default fmt=1*/
Str(30, s);
nadd(s,i);
wsf(s,fmt)
EndProc
Proc rln(Pchar s) /* 78 column limit */
Begin
int i; Bool done; char c;
int 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, int n)
Begin
Strbig(Llen,u);
int 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 */
int 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
int j,k;
Bool num;
int 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= (int)(j+1);
Repeat
Inc(k); c=s[k];
num= (c>='0') And (c<='9');
If num Then z= (int)( 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, int a, int b) /* a,b>0 ! Pascal indexing */
Begin
/*echo any "nontrivial" whitespace t-->s */
int 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=(int)(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 int skipCwhite(Pchar t, int j, int 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;
int 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 (int)(j-1); /* return last white-matching char position */
EndProc
Func Bool simple(Pchar s)
Begin /* check if no strange punctuations inside s */
char c;
int 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, int n, int 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 "?"
*/
int 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 int posi(Pchar sub, Pchar s)
Begin re-defines Turbo Pos, result Pascal compatible
int a,b,k;
Bool ok;
-StartProc-
ok=False;
a=length(sub);
b=(int)(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 int matchwhite(Pchar s, Pchar t, int n, int tstart)
Begin
/* like match, but any whitespace in t matches space in s*/
int 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 (int)(j-tstart)
Else
return (int)0
EndIf
EndFunc
Func int posizero(Pchar sub, Pchar s)
Begin /*another Pos */
/* substring search. like posi, but reject quotes & bracketed stuff */
int a,b,k;
Bool ok;
int blevel;
char c;
/*-StartProc-*/
ok=False;
a=length(sub);
b=(int)(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 int isMacro(Pchar s, char option, Pchar t, int 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, int, nargs+1)
Word j,k,dk,ls, lst, lmt, jmax, pj;
Bool ok;
char arg;
Strbig(Llen,u);
Str(40,st);
/* returns >0 If comparison Ok == length of compared Pchar */
/*-StartProc-*/ k=0;
ok= (s[0]==t[tstart]); /* intcut: 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]=(int)(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, (int)(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 int similar(Pchar s, char wilds, Pchar t,
int 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;
Strbig(Llen,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, (int)(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 int addSubList(Pchar s, int isr)
/* add the rule s to the Rule list at isr */
Begin
int 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
Strbig(Llen,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,(int)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 */
Strbig(Llen,obf); /* output buffer */
int iobf=0; /* its index */
int wstate=0; /* output state machine */
Proc washinit(void)
Begin
iobf=0;
wstate=0
EndProc
Proc washchar(char c)
Begin /* state machine receives one character */
int 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
int 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
int 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
int u;
Strbig(Llen,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;
int i,j;
Bool escape;
/*-StartProc-*/
escape=False;
For i=0; i<length(r); Inc(i) Do
c=r[i];
j= (int)(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;
int i,j;
Bool escape;
Strbig(Llen,s);
/*-StartProc-*/
escape=False;
For i=0; i<length(r); Inc(i) Do
c=r[i];
j= (int)(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;
Strbig(Llen,bf);
Darray(mac, string, nargs)
Bool ok;
int 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, (int)0,mac)
EndIf
Else
sm=similar(search[i],wildcard[i],bf, (int)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
Strbig(Llen, outname); Strbig(Llen,bf);
Bool done;
Darray( mac, string, nargs)
Pfile fin;
Bool ok;
int 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, (int)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, (int)0,mac)
EndIf
Else
sm=similar(search[i],wildcard[i],bf, (int)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);
int 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

118
src/frontend/numparam/xpressn.c
View File

@ -21,8 +21,6 @@
extern double gauss0(void);
extern double drand(void);
static void debugwarn(tdico *d, char *s);
/************ keywords ************/
/* SJB - 150 chars is ample for this - see initkeys() */
@ -201,14 +199,6 @@ message(tdico * dic, const char *fmt, ...)
}
static void
debugwarn (tdico * d, char *s)
{
message (d, "%s", s);
d->errcount--;
}
/************ the input text symbol table (dictionary) *************/
void
@ -1327,39 +1317,6 @@ formula (tdico * dico, char *s, bool *perror)
return accu[topop];
} /* formula */
static char
fmttype (double x)
{
/* I=integer, P=fixedpoint, F=floatpoint */
/* find out the "natural" type of format for number x */
double ax, dx;
int rx;
bool isint, astronomic;
ax = absf (x);
isint = 0;
astronomic = 0;
if (ax < 1e-39) /* smaller then 1e-39 is 0 */
isint = 1; /* and seen as an integer */
else if (ax < 64000)
{
/* detect integers */
rx = np_round (x);
dx = (x - rx) / ax;
isint = (absf (dx) < 1e-06);
}
if (!isint)
astronomic = (ax >= 1e+06) || (ax < 0.01); /* astronomic for 10 digits */
if (isint)
return 'I';
else if (astronomic)
return 'F';
else
return 'P';
}
static bool
evaluate (tdico * dico, SPICE_DSTRINGPTR qstr_p, char *t, unsigned char mode)
{
@ -1613,81 +1570,6 @@ scanline (tdico * dico, char *s, char *r, bool err)
/********* interface functions for spice3f5 extension ***********/
static void
compactfloatnb (SPICE_DSTRINGPTR vstr_p)
/* try to squeeze a floating pt format to ACT_CHARACTS characters */
/* erase superfluous 000 digit streams before E */
/* bug: truncating, no rounding */
/* Not used anymore !!*/
{
int n, k, m, lex, lem;
// char *expov ;
// char *expnv ;
char *v_p ;
SPICE_DSTRING expo_str ;
SPICE_DSTRING expn_str ;
spice_dstring_init(&expo_str) ;
spice_dstring_init(&expn_str) ;
n = cpos ('E', spice_dstring_value(vstr_p)) ; /* if too long, try to delete digits */
if (n<0) n = cpos ('e', spice_dstring_value(vstr_p));
if (n >= 0)
{
pscopy (&expo_str, spice_dstring_value(vstr_p), n,
spice_dstring_length(vstr_p));
lex = spice_dstring_length (&expo_str) ;
k = n ; /* mantissa is [0..k[ */
v_p = spice_dstring_value(vstr_p) ;
for(m=k; m>0; --m)
if(v_p[m-1] == ' ')
break;
/* FIXME, v_p[k] === 'e' thus this is never executed
while ((v_p[k] == '0') && (v_p[k - 1] == '0'))
k--;*/
lem = k - m;
if ((lem + lex) > ACT_CHARACTS)
lem = ACT_CHARACTS - lex;
pscopy (vstr_p, spice_dstring_value(vstr_p), m, lem);
if (cpos('.', spice_dstring_value(vstr_p)) >= 0)
{
while (lem < ACT_CHARACTS - EXP_LENGTH)
{
cadd(vstr_p, '0');
lem++;
}
}
else
{
cadd(vstr_p, '.');
lem++;
while (lem < ACT_CHARACTS - EXP_LENGTH)
{
cadd(vstr_p, '0');
lem++;
}
}
sadd (vstr_p, spice_dstring_value(&expo_str) );
}
else
{
m = 0;
v_p = spice_dstring_value(vstr_p) ;
while (v_p[m] == ' ')
m++;
lem = spice_dstring_length(vstr_p) - m;
if (lem > ACT_CHARACTS) lem = ACT_CHARACTS;
pscopy (vstr_p, spice_dstring_value(vstr_p), m, lem);
}
}
static int
insertnumber (tdico * dico, int i, char *s, SPICE_DSTRINGPTR ustr_p)