static void
fixdotplot(wordlist *wl)
{
char *s;
char numbuf[128]; /* Printnum Fix */
double *d, d1, d2;
while (wl) {
wl->wl_word = fixem(wl->wl_word);
/* Is this a trailing (a,b) ? Note that we require it to be
* one word.
*/
if (!wl->wl_next && (*wl->wl_word == '(')) /*)*/ {
s = wl->wl_word + 1;
d = ft_numparse(&s, FALSE);
if (*s != ',') {
fprintf(cp_err, "Error: bad limits \"%s\"\n",
wl->wl_word);
return;
}
d1 = *d;
s++;
d = ft_numparse(&s, FALSE);
if ((*s != /*(*/ ')') || s[1]) {
fprintf(cp_err, "Error: bad limits \"%s\"\n",
wl->wl_word);
return;
}
d2 = *d;
tfree(wl->wl_word);
wl->wl_word = copy("xlimit");
printnum(numbuf, d1);
wl_append_word(NULL, &wl, copy(numbuf));
printnum(numbuf, d2);
wl_append_word(NULL, &wl, copy(numbuf));
}
wl = wl->wl_next;
}
}
static double *
getlims(wordlist *wl, char *name, int number)
{
double *d;
wordlist *beg, *wk;
int n;
if (number < 1)
return NULL;
beg = wl_find(name, wl->wl_next);
if (!beg)
return NULL;
wk = beg->wl_next;
d = TMALLOC(double, number);
for (n = 0; n < number; n++) {
char *ss;
double *td;
if (!wk) {
fprintf(cp_err,
"Syntax error: not enough parameters for \"%s\".\n", name);
txfree(d);
return NULL;
}
ss = wk->wl_word;
td = ft_numparse(&ss, FALSE);
if (!td) {
fprintf(cp_err,
"Syntax error: bad parameters for \"%s\".\n", name);
txfree(d);
return NULL;
}
d[n] = *td;
wk = wk->wl_next;
}
wl_delete_slice(beg, wk);
return d;
}
int
fourier(wordlist *wl, struct plot *current_plot)
{
struct dvec *time, *vec;
struct pnode *pn, *names;
double *ff, fundfreq, *data = NULL;
int nfreqs, fourgridsize, polydegree;
double *freq, *mag, *phase, *nmag, *nphase; /* Outputs from CKTfour */
double thd, *timescale = NULL;
char *s;
int i, err, fw;
char xbuf[20];
int shift;
int rv = 1;
char newvecname[32];
struct dvec *n;
int newveccount = 1;
static int callstof = 1;
if (!current_plot)
return 1;
sprintf(xbuf, "%1.1e", 0.0);
shift = (int) strlen(xbuf) - 7;
if (!current_plot || !current_plot->pl_scale) {
fprintf(cp_err, "Error: no vectors loaded.\n");
return 1;
}
if (!cp_getvar("nfreqs", CP_NUM, &nfreqs) || nfreqs < 1)
nfreqs = 10;
if (!cp_getvar("polydegree", CP_NUM, &polydegree) || polydegree < 0)
polydegree = 1;
if (!cp_getvar("fourgridsize", CP_NUM, &fourgridsize) || fourgridsize < 1)
fourgridsize = DEF_FOURGRIDSIZE;
time = current_plot->pl_scale;
if (!isreal(time)) {
fprintf(cp_err, "Error: fourier needs real time scale\n");
return 1;
}
s = wl->wl_word;
if ((ff = ft_numparse(&s, FALSE)) == NULL || (*ff <= 0.0)) {
fprintf(cp_err, "Error: bad fund freq %s\n", wl->wl_word);
return 1;
}
fundfreq = *ff;
freq = TMALLOC(double, nfreqs);
mag = TMALLOC(double, nfreqs);
phase = TMALLOC(double, nfreqs);
nmag = TMALLOC(double, nfreqs);
nphase = TMALLOC(double, nfreqs);
wl = wl->wl_next;
names = ft_getpnames(wl, TRUE);
for (pn = names; pn; pn = pn->pn_next) {
vec = ft_evaluate(pn);
for (; vec; vec = vec->v_link2) {
if (vec->v_length != time->v_length) {
fprintf(cp_err,
"Error: lengths don't match: %d, %d\n",
vec->v_length, time->v_length);
continue;
}
if (!isreal(vec)) {
fprintf(cp_err, "Error: %s isn't real!\n", vec->v_name);
continue;
}
if (polydegree) {
double *dp, d;
/* Build the grid... */
timescale = TMALLOC(double, fourgridsize);
data = TMALLOC(double, fourgridsize);
dp = ft_minmax(time, TRUE);
/* Now get the last fund freq... */
d = 1 / fundfreq; /* The wavelength... */
if (dp[1] - dp[0] < d) {
fprintf(cp_err, "Error: wavelength longer than time span\n");
goto done;
} else if (dp[1] - dp[0] > d) {
dp[0] = dp[1] - d;
}
d = (dp[1] - dp[0]) / fourgridsize;
for (i = 0; i < fourgridsize; i++)
timescale[i] = dp[0] + i * d;
/* Now interpolate the data... */
if (!ft_interpolate(vec->v_realdata, data,
time->v_realdata, vec->v_length,
timescale, fourgridsize,
polydegree)) {
fprintf(cp_err, "Error: can't interpolate\n");
goto done;
}
} else {
fourgridsize = vec->v_length;
data = vec->v_realdata;
timescale = time->v_realdata;
}
err = CKTfour(fourgridsize, nfreqs, &thd, timescale,
data, fundfreq, freq, mag, phase, nmag,
nphase);
if (err != OK) {
ft_sperror(err, "fourier");
goto done;
}
fprintf(cp_out, "Fourier analysis for %s:\n", vec->v_name);
fprintf(cp_out,
" No. Harmonics: %d, THD: %g %%, Gridsize: %d, Interpolation Degree: %d\n\n",
nfreqs, thd, fourgridsize,
polydegree);
/* Each field will have width cp_numdgt + 6 (or 7
* with HP-UX) + 1 if there is a - sign.
*/
fw = ((cp_numdgt > 0) ? cp_numdgt : 6) + 5 + shift;
fprintf(cp_out, "Harmonic %-*s %-*s %-*s %-*s %-*s\n",
fw, "Frequency", fw, "Magnitude",
fw, "Phase", fw, "Norm. Mag",
fw, "Norm. Phase");
fprintf(cp_out, "-------- %-*s %-*s %-*s %-*s %-*s\n",
fw, "---------", fw, "---------",
fw, "-----", fw, "---------",
fw, "-----------");
for (i = 0; i < nfreqs; i++) {
char *pnumfr, *pnumma, *pnumph, *pnumnm, *pnumnp;
pnumfr = pnum(freq[i]);
pnumma = pnum(mag[i]);
pnumph = pnum(phase[i]);
pnumnm = pnum(nmag[i]);
pnumnp = pnum(nphase[i]);
fprintf(cp_out,
" %-4d %-*s %-*s %-*s %-*s %-*s\n",
i,
fw, pnumfr,
fw, pnumma,
fw, pnumph,
fw, pnumnm,
fw, pnumnp);
tfree(pnumfr);
tfree(pnumma);
tfree(pnumph);
tfree(pnumnm);
tfree(pnumnp);
}
fputs("\n", cp_out);
/* generate name for new vector, using vec->name */
sprintf(newvecname, "fourier%d%d", callstof, newveccount);
/* create and assign a new vector n */
/* with size 3 * nfreqs in current plot */
n = alloc(struct dvec);
ZERO(n, struct dvec);
n->v_name = copy(newvecname);
n->v_type = SV_NOTYPE;
n->v_flags = (VF_REAL | VF_PERMANENT);
n->v_length = 3 * nfreqs;
n->v_numdims = 2;
n->v_dims[0] = 3;
n->v_dims[1] = nfreqs;
n->v_realdata = TMALLOC(double, n->v_length);
vec_new(n);
/* store data in vector: freq, mag, phase */
for (i = 0; i < nfreqs; i++) {
n->v_realdata[i] = freq[i];
n->v_realdata[i + nfreqs] = mag[i];
n->v_realdata[i + 2 * nfreqs] = phase[i];
}
newveccount++;
if (polydegree) {
tfree(timescale);
tfree(data);
}
timescale = NULL;
data = NULL;
}
}
/*CDHW This needs leak checking carefully CDHW*/
struct variable *
cp_setparse(wordlist *wl)
{
char *name = NULL, *val, *copyval, *s, *ss;
double *td;
struct variable *listv = NULL, *vv, *lv = NULL;
struct variable *vars = NULL;
int balance;
while (wl) {
if (name)
tfree(name);
name = cp_unquote(wl->wl_word);
wl = wl->wl_next;
if ((!wl || (*wl->wl_word != '=')) && !strchr(name, '=')) {
vars = var_alloc_bool(copy(name), TRUE, vars);
tfree(name); /*DG: cp_unquote Memory leak*/
continue;
}
if (wl && eq(wl->wl_word, "=")) {
wl = wl->wl_next;
if (wl == NULL) {
fprintf(cp_err, "Error: bad set form.\n");
tfree(name); /*DG: cp_unquote Memory leak*/
if (ft_stricterror)
controlled_exit(EXIT_BAD);
return (NULL);
}
val = wl->wl_word;
wl = wl->wl_next;
} else if (wl && (*wl->wl_word == '=')) {
val = wl->wl_word + 1;
wl = wl->wl_next;
} else if ((s = strchr(name, '=')) != NULL) {
val = s + 1;
*s = '\0';
if (*val == '\0') {
if (!wl) {
fprintf(cp_err, "Error: %s equals what?.\n", name);
tfree(name); /*DG: cp_unquote Memory leak: free name before exiting*/
if (ft_stricterror)
controlled_exit(EXIT_BAD);
return (NULL);
} else {
val = wl->wl_word;
wl = wl->wl_next;
}
}
} else {
fprintf(cp_err, "Error: bad set form.\n");
tfree(name); /*DG: cp_unquote Memory leak: free name befor exiting */
if (ft_stricterror)
controlled_exit(EXIT_BAD);
return (NULL);
}
/* val = cp_unquote(val); DG: bad old val is lost*/
copyval = cp_unquote(val); /*DG*/
strcpy(val, copyval);
tfree(copyval);
if (eq(val, "(")) {
/* The beginning of a list... We have to walk down the
* list until we find a close paren... If there are nested
* ()'s, treat them as tokens... */
balance = 1;
while (wl && wl->wl_word) {
if (eq(wl->wl_word, "(")) {
balance++;
} else if (eq(wl->wl_word, ")")) {
if (!--balance)
break;
}
copyval = ss = cp_unquote(wl->wl_word);
td = ft_numparse(&ss, FALSE);
if (td)
vv = var_alloc_real(NULL, *td, NULL);
else
vv = var_alloc_string(NULL, copy(ss), NULL);
tfree(copyval); /*DG: must free ss any way to avoid cp_unquote memory leak*/
if (listv) {
lv->va_next = vv;
lv = vv;
} else {
listv = lv = vv;
}
wl = wl->wl_next;
}
if (balance && !wl) {
fprintf(cp_err, "Error: bad set form.\n");
tfree(name); /* va: cp_unquote memory leak: free name before exiting */
if (ft_stricterror)
controlled_exit(EXIT_BAD);
return (NULL);
}
vars = var_alloc_vlist(copy(name), listv, vars);
wl = wl->wl_next;
continue;
}
copyval = ss = cp_unquote(val);
td = ft_numparse(&ss, FALSE);
if (td) {
/*** We should try to get CP_NUM's... */
vars = var_alloc_real(copy(name), *td, vars);
} else {
vars = var_alloc_string(copy(name), copy(val), vars);
}
tfree(copyval); /*DG: must free ss any way to avoid cp_unquote memory leak */
tfree(name); /* va: cp_unquote memory leak: free name for every loop */
}
if (name)
tfree(name);
return (vars);
}
int
PPlex(YYSTYPE *lvalp, struct PPltype *llocp, char **line)
{
static char *specials = " \t%()-^+*,/|&<>~=";
char *sbuf = *line;
int token;
while ((*sbuf == ' ') || (*sbuf == '\t'))
sbuf++;
llocp->start = sbuf;
#define lexer_return(token_, length) \
do { token = token_; sbuf += length; goto done; } while(0)
if ((sbuf[0] == 'g') && (sbuf[1] == 't') &&
strchr(specials, sbuf[2])) {
lexer_return('>', 2);
} else if ((sbuf[0] == 'l') && (sbuf[1] == 't') &&
strchr(specials, sbuf[2])) {
lexer_return('<', 2);
} else if ((sbuf[0] == 'g') && (sbuf[1] == 'e') &&
strchr(specials, sbuf[2])) {
lexer_return(TOK_GE, 2);
} else if ((sbuf[0] == 'l') && (sbuf[1] == 'e') &&
strchr(specials, sbuf[2])) {
lexer_return(TOK_LE, 2);
} else if ((sbuf[0] == 'n') && (sbuf[1] == 'e') &&
strchr(specials, sbuf[2])) {
lexer_return(TOK_NE, 2);
} else if ((sbuf[0] == 'e') && (sbuf[1] == 'q') &&
strchr(specials, sbuf[2])) {
lexer_return('=', 2);
} else if ((sbuf[0] == 'o') && (sbuf[1] == 'r') &&
strchr(specials, sbuf[2])) {
lexer_return('|', 2);
} else if ((sbuf[0] == 'a') && (sbuf[1] == 'n') &&
(sbuf[2] == 'd') && strchr(specials, sbuf[3])) {
lexer_return('&', 3);
} else if ((sbuf[0] == 'n') && (sbuf[1] == 'o') &&
(sbuf[2] == 't') && strchr(specials, sbuf[3])) {
lexer_return('~', 3);
}
switch (*sbuf) {
case '[':
case ']':
lexer_return(*sbuf, 1);
case '>':
case '<':
{
/* Workaround, The Frontend makes "<>" into "< >" */
int j = 1;
while (isspace_c(sbuf[j]))
j++;
if (((sbuf[j] == '<') || (sbuf[j] == '>')) && (sbuf[0] != sbuf[j])) {
/* Allow both <> and >< for NE. */
lexer_return(TOK_NE, j+1);
} else if (sbuf[1] == '=') {
lexer_return((sbuf[0] == '>') ? TOK_GE : TOK_LE, 2);
} else {
lexer_return(*sbuf, 1);
}
}
case '?':
case ':':
case ',':
case '+':
case '-':
case '*':
case '%':
case '/':
case '^':
case '(':
case ')':
case '=':
case '&':
case '|':
case '~':
lexer_return(*sbuf, 1);
case '\0':
lexer_return(*sbuf, 0);
case '"':
{
char *start = ++sbuf;
while (*sbuf && (*sbuf != '"'))
sbuf++;
lvalp->str = copy_substring(start, sbuf);
if (*sbuf)
sbuf++;
lexer_return(TOK_STR, 0);
}
default:
{
char *s = sbuf;
double *td = ft_numparse(&s, FALSE);
if ((!s || *s != ':') && td) {
sbuf = s;
lvalp->num = *td;
lexer_return(TOK_NUM, 0);
} else {
int atsign = 0;
char *start = sbuf;
/* It is bad how we have to recognise '[' -- sometimes
* it is part of a word, when it defines a parameter
* name, and otherwise it isn't.
*
* what is valid here ?
* foo dc1.foo dc1.@m1[vth]
* this too ?
* vthing#branch
* should we convert the pseudo identifier ?
* i(v5) --> v5#branch
*/
for (; *sbuf && !strchr(specials, *sbuf); sbuf++)
if (*sbuf == '@')
atsign = 1;
else if (!atsign && *sbuf == '[')
break;
else if (*sbuf == ']') {
if (atsign)
sbuf++;
break;
}
lvalp->str = copy_substring(start, sbuf);
lexer_return(TOK_STR, 0);
}
}
}
done:
if (ft_parsedb) {
if (token == TOK_STR)
fprintf(stderr, "lexer: TOK_STR, \"%s\"\n", lvalp->str);
else if (token == TOK_NUM)
fprintf(stderr, "lexer: TOK_NUM, %G\n", lvalp->num);
else
fprintf(stderr, "lexer: token %d\n", token);
}
*line = sbuf;
llocp->stop = sbuf;
return (token);
}
