Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA. */
-/* AIX requires this to be the first thing in the file. */
#include <config.h>
-#if __GNUC__
-#define alloca __builtin_alloca
-#else
-#if HAVE_ALLOCA_H
-#include <alloca.h>
-#else
-#ifdef _AIX
-#pragma alloca
-#else
-#ifndef alloca /* predefined by HP cc +Olibcalls */
-char *alloca ();
-#endif
-#endif
-#endif
-#endif
#if TIME_WITH_SYS_TIME
#include <sys/time.h>
#include <ctype.h>
#include "expr.h"
#include "exprP.h"
-#include <assert.h>
+#include "error.h"
+#include <gsl/gsl_randist.h>
#include <math.h>
#include <errno.h>
#include <stdio.h>
-#include "approx.h"
+#include "case.h"
#include "data-in.h"
+#include "dictionary.h"
#include "error.h"
#include "julcal/julcal.h"
#include "magic.h"
-#include "random.h"
-#include "stats.h"
+#include "misc.h"
+#include "moments.h"
+#include "pool.h"
+#include "settings.h"
#include "str.h"
#include "var.h"
#include "vfm.h"
#include "vfmP.h"
-/* FIXME: This could be even more efficient if we caught SYSMIS when
- it first reared its ugly head, then threw it into an entirely new
- switch that handled SYSMIS aggressively like all the code does now.
- But I've spent a couple of weeks on the expression code, and that's
- enough to make anyone sick. For that matter, it could be more
- efficient if I hand-coded it in assembly for a dozen processors,
- but I'm not going to do that either. */
-
-/* These macros are defined differently depending on the way that
- the stack is managed. (i.e., I have to adapt the code to inferior
- environments.)
-
- void CHECK_STRING_SPACE(int x): Assure that at least X+1 bytes of
- space are available in the string evaluation stack.
-
- unsigned char *ALLOC_STRING_SPACE(int x): Return a pointer to X+1
- bytes of space. CHECK_STRING_SPACE must have previously been
- called with an argument of at least X. */
-
-#if PAGED_STACK
-#define CHECK_STRING_SPACE(X) /* nothing to do! */
-#define ALLOC_STRING_SPACE(X) \
- alloca((X) + 1)
-#else /* !PAGED_STACK */
-#define CHECK_STRING_SPACE(X) \
- do \
- { \
- if (str_stk + X >= str_end) \
- { \
- e->str_size += 1024; \
- e->str_stk = xrealloc (e->str_stk, e->str_size); \
- str_end = e->str_stk + e->str_size - 1; \
- } \
- } \
- while (0)
-
-#define ALLOC_STRING_SPACE(X) \
- (str_stk += X + 1, str_stk - X - 1)
-#endif /* !PAGED_STACK */
-
double
-expr_evaluate (struct expression *e, struct ccase *c, union value *v)
+expr_evaluate (const struct expression *e, const struct ccase *c, int case_idx,
+ union value *v)
{
unsigned char *op = e->op;
double *dbl = e->num;
unsigned char *str = e->str;
-#if !PAGED_STACK
- unsigned char *str_stk = e->str_stk;
- unsigned char *str_end = e->str_stk + e->str_size - 1;
-#endif
struct variable **vars = e->var;
int i, j;
/* Stack pointer. */
union value *sp = e->stack;
+ pool_clear (e->pool);
+
for (;;)
{
switch (*op++)
{
- case OP_PLUS:
- sp -= *op - 1;
- if (sp->f != SYSMIS)
- for (i = 1; i < *op; i++)
- {
- if (sp[i].f == SYSMIS)
- {
- sp->f = SYSMIS;
- break;
- }
- else
- sp->f += sp[i].f;
- }
- op++;
+ case OP_ADD:
+ sp--;
+ if (sp[1].f == SYSMIS)
+ sp[0].f = SYSMIS;
+ else if (sp[0].f != SYSMIS)
+ sp[0].f += sp[1].f;
+ break;
+ case OP_SUB:
+ sp--;
+ if (sp[1].f == SYSMIS)
+ sp[0].f = SYSMIS;
+ else if (sp[0].f != SYSMIS)
+ sp[0].f -= sp[1].f;
break;
case OP_MUL:
- sp -= *op - 1;
- if (sp->f != SYSMIS)
- for (i = 1; i < *op; i++)
- {
- if (sp[i].f == SYSMIS)
- {
- sp->f = SYSMIS;
- break;
- }
- else
- sp->f *= sp[i].f;
- }
- op++;
+ sp--;
+ if (sp[1].f == SYSMIS)
+ sp[0].f = SYSMIS;
+ else if (sp[0].f != SYSMIS)
+ sp[0].f *= sp[1].f;
+ break;
+ case OP_DIV:
+ sp--;
+ if (sp[1].f == SYSMIS || sp[1].f == 0.)
+ sp[0].f = SYSMIS;
+ else if (sp[0].f != SYSMIS)
+ sp[0].f /= sp[1].f;
break;
case OP_POW:
sp--;
if (sp[0].f == SYSMIS)
{
- if (approx_eq (sp[1].f, 0.0))
+ if (sp[1].f == 0.0)
sp->f = 1.0;
}
else if (sp[1].f == SYSMIS)
{
if (sp[0].f == 0.0)
- /* SYSMIS**0 */
sp->f = 0.0;
else
sp->f = SYSMIS;
}
- else if (approx_eq (sp[0].f, 0.0) && approx_eq (sp[1].f, 0.0))
+ else if (sp[0].f == 0.0 && sp[1].f <= 0.0)
sp->f = SYSMIS;
else
sp->f = pow (sp[0].f, sp[1].f);
break;
case OP_AND:
- /* Note that the equality operator (==) may be used here
- (instead of approx_eq) because booleans are always
- *exactly* 0, 1, or SYSMIS.
+ /* Note that booleans are always one of 0, 1, or SYSMIS.
Truth table (in order of detection):
if (sp[1].f == SYSMIS)
sp->f = SYSMIS;
else
- sp->f = approx_eq (sp[0].f, sp[1].f);
+ sp->f = sp[0].f == sp[1].f;
}
break;
case OP_GE:
if (sp[1].f == SYSMIS)
sp->f = SYSMIS;
else
- sp->f = approx_ge (sp[0].f, sp[1].f);
+ sp->f = sp[0].f >= sp[1].f;
}
break;
case OP_GT:
if (sp[1].f == SYSMIS)
sp->f = SYSMIS;
else
- sp->f = approx_gt (sp[0].f, sp[1].f);
+ sp->f = sp[0].f > sp[1].f;
}
break;
case OP_LE:
if (sp[1].f == SYSMIS)
sp->f = SYSMIS;
else
- sp->f = approx_le (sp[0].f, sp[1].f);
+ sp->f = sp[0].f <= sp[1].f;
}
break;
case OP_LT:
if (sp[1].f == SYSMIS)
sp->f = SYSMIS;
else
- sp->f = approx_lt (sp[0].f, sp[1].f);
+ sp->f = sp[0].f < sp[1].f;
}
break;
case OP_NE:
if (sp[1].f == SYSMIS)
sp->f = SYSMIS;
else
- sp->f = approx_ne (sp[0].f, sp[1].f);
+ sp->f = sp[0].f != sp[1].f;
}
break;
/* String operators. */
- case OP_STRING_EQ:
+ case OP_EQ_STRING:
sp--;
sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
&sp[1].c[1], sp[1].c[0]) == 0;
break;
- case OP_STRING_GE:
+ case OP_GE_STRING:
sp--;
sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
&sp[1].c[1], sp[1].c[0]) >= 0;
break;
- case OP_STRING_GT:
+ case OP_GT_STRING:
sp--;
sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
&sp[1].c[1], sp[1].c[0]) > 0;
break;
- case OP_STRING_LE:
+ case OP_LE_STRING:
sp--;
sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
&sp[1].c[1], sp[1].c[0]) <= 0;
break;
- case OP_STRING_LT:
+ case OP_LT_STRING:
sp--;
sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
&sp[1].c[1], sp[1].c[0]) < 0;
break;
- case OP_STRING_NE:
+ case OP_NE_STRING:
sp--;
sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
&sp[1].c[1], sp[1].c[0]) != 0;
if (sp->f != SYSMIS)
{
errno = 0;
- sp->f = log10 (sp->f);
+ sp->f = log (sp->f);
if (errno)
sp->f = SYSMIS;
}
sp -= n_args - 1;
if (sp->f == SYSMIS)
break;
- for (i = 1; i <= n_args; i++)
- if (approx_eq (sp[0].f, sp[i].f))
+ for (i = 1; i < n_args; i++)
+ if (sp[0].f == sp[i].f)
{
sp->f = 1.0;
goto main_loop;
case OP_ANY_STRING:
{
int n_args = *op++;
+ int result = 0.0;
sp -= n_args - 1;
- for (i = 1; i <= n_args; i++)
+ for (i = 1; i < n_args; i++)
if (!st_compare_pad (&sp[0].c[1], sp[0].c[0],
&sp[i].c[1], sp[i].c[0]))
{
- sp->f = 1.0;
- goto main_loop;
+ result = 1.0;
+ break;
}
- sp->f = 0.0;
+ sp->f = result;
}
break;
case OP_CFVAR:
{
int n_args = *op++;
- int nv = 0;
- double sum[2] =
- {0.0, 0.0};
+ double weight, mean, variance;
sp -= n_args - 1;
- for (i = 0; i < n_args; i++)
- if (sp[i].f != SYSMIS)
- {
- nv++;
- sum[0] += sp[i].f;
- sum[1] += sp[i].f * sp[i].f;
- }
- if (nv < *op++)
+
+ moments_of_values (sp, n_args,
+ &weight, &mean, &variance, NULL, NULL);
+
+ if (weight < *op++ || mean == SYSMIS
+ || mean == 0 || variance == SYSMIS)
sp->f = SYSMIS;
else
- sp->f = calc_cfvar (sum, nv);
+ sp->f = sqrt (variance) / mean;
}
break;
case OP_MAX:
sp->f = max;
}
break;
+ case OP_MAX_STRING:
+ {
+ int n_args = *op++;
+ int max_idx = 0;
+
+ sp -= n_args - 1;
+ for (i = 1; i < n_args; i++)
+ if (st_compare_pad (&sp[i].c[1], sp[i].c[0],
+ &sp[max_idx].c[1], sp[max_idx].c[0]) > 0)
+ max_idx = i;
+ sp[0].c = sp[max_idx].c;
+ }
+ break;
case OP_MEAN:
{
int n_args = *op++;
- int nv = 0;
- double sum[1] =
- {0.0};
+ double weight, mean;
sp -= n_args - 1;
- for (i = 0; i < n_args; i++)
- if (sp[i].f != SYSMIS)
- {
- nv++;
- sum[0] += sp[i].f;
- }
- if (nv < *op++)
- sp->f = SYSMIS;
- else
- sp->f = calc_mean (sum, nv);
+
+ moments_of_values (sp, n_args,
+ &weight, &mean, NULL, NULL, NULL);
+ sp->f = weight < *op++ ? SYSMIS : mean;
}
break;
case OP_MIN:
sp->f = min;
}
break;
+ case OP_MIN_STRING:
+ {
+ int n_args = *op++;
+ int min_idx = 0;
+
+ sp -= n_args - 1;
+ for (i = 1; i < n_args; i++)
+ if (st_compare_pad (&sp[i].c[1], sp[i].c[0],
+ &sp[min_idx].c[1], sp[min_idx].c[0]) < 0)
+ min_idx = i;
+ sp[0].c = sp[min_idx].c;
+ }
+ break;
case OP_NMISS:
{
int n_args = *op++;
sp -= n_args - 1;
if (sp->f == SYSMIS)
break;
- for (i = 1; i <= n_args; i += 2)
+ for (i = 1; i < n_args; i += 2)
if (sp[i].f == SYSMIS || sp[i + 1].f == SYSMIS)
continue;
- else if (approx_ge (sp[0].f, sp[i].f)
- && approx_le (sp[0].f, sp[i + 1].f))
+ else if (sp[0].f >= sp[i].f && sp[0].f <= sp[i + 1].f)
{
sp->f = 1.0;
goto main_loop;
int n_args = *op++;
sp -= n_args - 1;
- for (i = 1; i <= n_args; i += 2)
+ for (i = 1; i < n_args; i += 2)
if (st_compare_pad (&sp[0].c[1], sp[0].c[0],
&sp[i].c[1], sp[i].c[0]) >= 0
&& st_compare_pad (&sp[0].c[1], sp[0].c[0],
case OP_SD:
{
int n_args = *op++;
- int nv = 0;
- double sum[2];
-
- sum[0] = sum[1] = 0.0;
+ double weight, variance;
sp -= n_args - 1;
- for (i = 0; i < n_args; i++)
- if (sp[i].f != SYSMIS)
- {
- nv++;
- sum[0] += sp[i].f;
- sum[1] += sp[i].f * sp[i].f;
- }
- if (nv < *op++)
- sp->f = SYSMIS;
- else
- sp->f = calc_stddev (calc_variance (sum, nv));
+ moments_of_values (sp, n_args,
+ &weight, NULL, &variance, NULL, NULL);
+ sp->f = weight < *op++ ? SYSMIS : sqrt (variance);
}
break;
case OP_SUM:
case OP_VARIANCE:
{
int n_args = *op++;
- int nv = 0;
- double sum[2];
-
- sum[0] = sum[1] = 0.0;
+ double weight, variance;
sp -= n_args - 1;
- for (i = 0; i < n_args; i++)
- if (sp[i].f != SYSMIS)
- {
- nv++;
- sum[0] += sp[i].f;
- sum[1] += sp[i].f * sp[i].f;
- }
- if (nv < *op++)
- sp->f = SYSMIS;
- else
- sp->f = calc_variance (sum, nv);
+ moments_of_values (sp, n_args,
+ &weight, NULL, &variance, NULL, NULL);
+ sp->f = weight < *op++ ? SYSMIS : variance;
}
break;
/* Time construction function. */
- case OP_TIME_HMS:
- sp -= 2;
- if (sp[0].f == SYSMIS || sp[1].f == SYSMIS || sp[2].f == SYSMIS)
- sp->f = SYSMIS;
- else
- sp->f = 60. * (60. * sp[0].f + sp[1].f) + sp[2].f;
+ case OP_TIME_HMS:
+ sp -= 2;
+ if (sp[0].f == SYSMIS || sp[1].f == SYSMIS || sp[2].f == SYSMIS)
+ sp->f = SYSMIS;
+ else
+ {
+ double min, max;
+ min = min (sp[0].f, min (sp[1].f, sp[2].f));
+ max = max (sp[0].f, max (sp[1].f, sp[2].f));
+ if (min < 0. && max > 0.)
+ {
+ msg (SW, _("TIME.HMS cannot mix positive and negative "
+ "in its arguments."));
+ sp->f = SYSMIS;
+ }
+ else
+ sp->f = 60. * (60. * sp[0].f + sp[1].f) + sp[2].f;
+ }
+ break;
+ case OP_CTIME_DAYS:
+ if (sp->f != SYSMIS)
+ sp->f /= 60. * 60. * 24.;
break;
+ case OP_CTIME_HOURS:
+ if (sp->f != SYSMIS)
+ sp->f /= 60. * 60;
+ break;
+ case OP_CTIME_MINUTES:
+ if (sp->f != SYSMIS)
+ sp->f /= 60.;
+ break;
+ case OP_TIME_DAYS:
+ if (sp->f != SYSMIS)
+ sp->f *= 60. * 60. * 24.;
+ break;
+ case OP_CTIME_SECONDS:
+ /* No-op. */
+ break;
/* Date construction functions. */
case OP_DATE_DMY:
break;
case OP_DATE_WKYR:
sp--;
- if (sp[0].f == SYSMIS)
+ if (sp[0].f == SYSMIS || sp[1].f == SYSMIS)
sp->f = SYSMIS;
- else
+ else if (sp[0].f < 0. || sp[0].f > 53.)
+ {
+ msg (SW, _("Week argument to WKYR must be in range 0 to 53."));
+ sp->f = SYSMIS;
+ }
+ else
{
- sp[1].f = yrmoda (sp[1].f, 1, 1);
- if (sp->f != SYSMIS)
- sp[1].f = 60. * 60. * 24. * (sp[1].f + 7. * (floor (sp[0].f) - 1.));
- sp->f = sp[1].f;
+ double result = yrmoda (sp[1].f, 1, 1);
+ if (result != SYSMIS)
+ result = 60. * 60. * 24. * (result + 7. * (sp->f - 1.));
+ sp->f = result;
}
break;
case OP_DATE_YRDAY:
break;
case OP_XDATE_JDAY:
if (sp->f != SYSMIS)
- sp->f = 86400. * julian_to_jday (sp->f / 86400.);
+ sp->f = julian_to_jday (sp->f / 86400.);
break;
case OP_XDATE_MDAY:
if (sp->f != SYSMIS)
int n_args = *op++;
unsigned char *dest;
- CHECK_STRING_SPACE (255);
- dest = ALLOC_STRING_SPACE (255);
+ dest = pool_alloc (e->pool, 256);
dest[0] = 0;
sp -= n_args - 1;
sp[0].c = dest;
}
break;
- case OP_INDEX:
+ case OP_INDEX_2:
sp--;
if (sp[1].c[0] == 0)
sp->f = SYSMIS;
else
{
int last = sp[0].c[0] - sp[1].c[0];
+ int result = 0;
for (i = 0; i <= last; i++)
- if (!memcmp (&sp[0].c[i + 1], &sp[0].c[1], sp[0].c[0]))
+ if (!memcmp (&sp[0].c[i + 1], &sp[1].c[1], sp[1].c[0]))
{
- sp->f = i + 1;
- goto main_loop;
+ result = i + 1;
+ break;
}
- sp->f = 0.0;
+ sp->f = result;
}
break;
- case OP_INDEX_OPT:
- {
- /* Length of each search string. */
- int part_len = sp[2].f;
-
- sp -= 2;
- if (sp[1].c[0] == 0 || part_len <= 0 || sp[2].f == SYSMIS
- || sp[1].c[0] % part_len != 0)
- sp->f = SYSMIS;
- else
- {
- /* Last possible index. */
- int last = sp[0].c[0] - part_len;
-
- for (i = 0; i <= last; i++)
- for (j = 0; j < sp[1].c[0]; j += part_len)
- if (!memcmp (&sp[0].c[i], &sp[1].c[j], part_len))
- {
- sp->f = i + 1;
- goto main_loop;
- }
- sp->f = 0.0;
- }
- }
- break;
- case OP_RINDEX:
+ case OP_INDEX_3:
+ sp -= 2;
+ if (sp[1].c[0] == 0)
+ {
+ sp->f = SYSMIS;
+ break;
+ }
+ else if (sp[2].f == SYSMIS)
+ {
+ msg (SW, _("Argument 3 of RINDEX may not be system-missing."));
+ sp->f = SYSMIS;
+ }
+ else
+ {
+ int part_len = sp[2].f;
+ int result = 0;
+ if (part_len < 0 || part_len > sp[1].c[0]
+ || sp[1].c[0] % part_len != 0)
+ {
+ msg (SW, _("Argument 3 of RINDEX must be between 1 and "
+ "the length of argument 2, and it must "
+ "evenly divide the length of argument 2."));
+ sp->f = SYSMIS;
+ break;
+ }
+ else
+ {
+ int last = sp[0].c[0] - part_len;
+ for (i = 0; i <= last; i++)
+ for (j = 0; j < sp[1].c[0]; j += part_len)
+ if (!memcmp (&sp[0].c[i + 1], &sp[1].c[j + 1], part_len))
+ {
+ result = i + 1;
+ goto index_3_out;
+ }
+ index_3_out:
+ sp->f = result;
+ }
+ }
+ break;
+ case OP_RINDEX_2:
sp--;
if (sp[1].c[0] == 0)
sp->f = SYSMIS;
else
{
+ int result = 0;
for (i = sp[0].c[0] - sp[1].c[0]; i >= 0; i--)
- if (!memcmp (&sp[0].c[i + 1], &sp[0].c[1], sp[0].c[0]))
+ if (!memcmp (&sp[0].c[i + 1], &sp[1].c[1], sp[1].c[0]))
{
- sp->f = i + 1;
- goto main_loop;
+ result = i + 1;
+ break;
}
- sp->f = 0.0;
+ sp->f = result;
}
break;
- case OP_RINDEX_OPT:
- {
- /* Length of each search string. */
- int part_len = sp[2].f;
-
- sp -= 2;
- if (sp[1].c[0] == 0 || part_len <= 0 || sp[2].f == SYSMIS
- || sp[1].c[0] % part_len != 0)
- sp->f = SYSMIS;
- else
- {
- for (i = sp[0].c[0] - part_len; i >= 0; i--)
- for (j = 0; j < sp[1].c[0]; j += part_len)
- if (!memcmp (&sp[0].c[i], &sp[1].c[j], part_len))
- {
- sp->f = i + 1;
- goto main_loop;
- }
- sp->f = 0.0;
- }
- }
+ case OP_RINDEX_3:
+ sp -= 2;
+ if (sp[1].c[0] == 0)
+ {
+ sp->f = SYSMIS;
+ break;
+ }
+ else if (sp[2].f == SYSMIS)
+ {
+ msg (SW, _("Argument 3 of RINDEX may not be system-missing."));
+ sp->f = SYSMIS;
+ }
+ else
+ {
+ int part_len = sp[2].f;
+ int result = 0;
+ if (part_len < 0 || part_len > sp[1].c[0]
+ || sp[1].c[0] % part_len != 0)
+ {
+ msg (SW, _("Argument 3 of RINDEX must be between 1 and "
+ "the length of argument 2, and it must "
+ "evenly divide the length of argument 2."));
+ sp->f = SYSMIS;
+ }
+ else
+ {
+ for (i = sp[0].c[0] - part_len; i >= 0; i--)
+ for (j = 0; j < sp[1].c[0]; j += part_len)
+ if (!memcmp (&sp[0].c[i + 1], &sp[1].c[j + 1], part_len))
+ {
+ result = i + 1;
+ goto rindex_3_out;
+ }
+ rindex_3_out:
+ sp->f = result;
+ }
+ }
break;
case OP_LENGTH:
sp->f = sp[0].c[0];
sp[0].c[i] = toupper ((unsigned char) (sp[0].c[i]));
break;
case OP_LPAD:
- {
- int len;
- sp--;
- len = sp[1].f;
- if (sp[1].f == SYSMIS || len < 0 || len > 255)
- sp->c[0] = 0;
- else if (len > sp[0].c[0])
- {
- unsigned char *dest;
-
- CHECK_STRING_SPACE (len);
- dest = ALLOC_STRING_SPACE (len);
- dest[0] = len;
- memset (&dest[1], ' ', len - sp->c[0]);
- memcpy (&dest[len - sp->c[0] + 1], &sp->c[1], sp->c[0]);
- sp->c = dest;
- }
- }
- break;
- case OP_LPAD_OPT:
{
int len;
sp -= 2;
{
unsigned char *dest;
- CHECK_STRING_SPACE (len);
- dest = ALLOC_STRING_SPACE (len);
+ dest = pool_alloc (e->pool, len + 1);
dest[0] = len;
memset (&dest[1], sp[2].c[1], len - sp->c[0]);
memcpy (&dest[len - sp->c[0] + 1], &sp->c[1], sp->c[0]);
}
break;
case OP_RPAD:
- {
- int len;
- sp--;
- len = sp[1].f;
- if (sp[1].f == SYSMIS || len < 0 || len > 255)
- sp->c[0] = 0;
- else if (len > sp[0].c[0])
- {
- unsigned char *dest;
-
- CHECK_STRING_SPACE (len);
- dest = ALLOC_STRING_SPACE (len);
- dest[0] = len;
- memcpy (&dest[1], &sp->c[1], sp->c[0]);
- memset (&dest[sp->c[0] + 1], ' ', len - sp->c[0]);
- sp->c = dest;
- }
- }
- break;
- case OP_RPAD_OPT:
{
int len;
sp -= 2;
{
unsigned char *dest;
- CHECK_STRING_SPACE (len);
- dest = ALLOC_STRING_SPACE (len);
+ dest = pool_alloc (e->pool, len + 1);
dest[0] = len;
memcpy (&dest[1], &sp->c[1], sp->c[0]);
memset (&dest[sp->c[0] + 1], sp[2].c[1], len - sp->c[0]);
}
break;
case OP_LTRIM:
- {
- int len = sp[0].c[0];
-
- i = 1;
- while (i <= len && sp[0].c[i] == ' ')
- i++;
- if (--i)
- {
- sp[0].c[i] = sp[0].c[0] - i;
- sp->c = &sp[0].c[i];
- }
- }
- break;
- case OP_LTRIM_OPT:
{
sp--;
if (sp[1].c[0] != 1)
}
break;
case OP_RTRIM:
- assert (' ' != 0);
- while (sp[0].c[sp[0].c[0]] == ' ')
- sp[0].c[0]--;
- break;
- case OP_RTRIM_OPT:
sp--;
if (sp[1].c[0] != 1)
sp[0].c[0] = 0;
else
{
- /* Note that NULs are not allowed in strings. This code
- needs to change if this decision is changed. */
int cmp = sp[1].c[1];
- while (sp[0].c[sp[0].c[0]] == cmp)
+ while (sp[0].c[0] > 0 && sp[0].c[sp[0].c[0]] == cmp)
sp[0].c[0]--;
}
break;
case OP_NUMBER:
{
struct data_in di;
-
- di.s = &sp->c[1];
- di.e = &sp->c[1] + sp->c[0];
- di.v = sp;
- di.flags = DI_IGNORE_ERROR;
- di.f1 = 1;
- di.format.type = FMT_F;
- di.format.w = sp->c[0];
- di.format.d = 0;
- data_in (&di);
- }
- break;
- case OP_NUMBER_OPT:
- {
- struct data_in di;
+ union value out;
di.s = &sp->c[1];
- di.e = &sp->c[1] + sp->c[0];
- di.v = sp;
- di.flags = DI_IGNORE_ERROR;
+ di.v = &out;
+ di.flags = 0;
di.f1 = 1;
di.format.type = *op++;
di.format.w = *op++;
di.format.d = *op++;
+ di.e = &sp->c[1] + min (sp->c[0], di.format.w);
data_in (&di);
+ sp->f = out.f;
}
break;
case OP_STRING:
f.w = *op++;
f.d = *op++;
- CHECK_STRING_SPACE (f.w);
- dest = ALLOC_STRING_SPACE (f.w);
+ dest = pool_alloc (e->pool, f.w + 1);
dest[0] = f.w;
+ assert ((formats[f.type].cat & FCAT_STRING) == 0);
data_out (&dest[1], &f, sp);
sp->c = dest;
}
break;
- case OP_SUBSTR:
+ case OP_SUBSTR_2:
{
int index;
}
}
break;
- case OP_SUBSTR_OPT:
+ case OP_SUBSTR_3:
{
int index;
int n;
break;
/* Artificial. */
- case OP_INV:
- if (sp->f != SYSMIS)
- sp->f = 1. / sp->f;
- break;
case OP_SQUARE:
if (sp->f != SYSMIS)
sp->f *= sp->f;
break;
case OP_NUM_TO_BOOL:
- if (approx_eq (sp->f, 0.0))
+ if (sp->f == 0.0)
sp->f = 0.0;
- else if (approx_eq (sp->f, 1.0))
+ else if (sp->f == 1.0)
sp->f = 1.0;
else if (sp->f != SYSMIS)
{
{
if (sp[1].f == SYSMIS)
{
- if (approx_ne (sp[0].f, 0.0))
+ if (sp[0].f != 0.0)
sp->f = SYSMIS;
}
else
break;
case OP_NORMAL:
if (sp->f != SYSMIS)
- sp->f *= rng_get_double_normal (pspp_rng ());
+ sp->f = gsl_ran_gaussian (get_rng (), sp->f);
break;
case OP_UNIFORM:
if (sp->f != SYSMIS)
- sp->f *= rng_get_double (pspp_rng ());
+ sp->f *= gsl_rng_uniform (get_rng ());
break;
case OP_SYSMIS:
- if (sp[0].f == SYSMIS || !finite (sp[0].f))
- sp->f = 1.0;
- else
- sp->f = 0.0;
+ sp->f = sp->f == SYSMIS || !finite (sp->f);
break;
case OP_VEC_ELEM_NUM:
{
sp->f = SYSMIS;
break;
}
- sp->f = c->data[v->var[rindx - 1]->fv].f;
+ assert (c != NULL);
+ sp->f = case_num (c, v->var[rindx - 1]->fv);
}
break;
case OP_VEC_ELEM_STR:
msg (SE, _("%g is not a valid index value for vector %s. "
"The result will be set to the empty string."),
sp[0].f, vect->name);
- CHECK_STRING_SPACE (0);
- sp->c = ALLOC_STRING_SPACE (0);
+ sp->c = pool_alloc (e->pool, 1);
sp->c[0] = 0;
break;
}
v = vect->var[rindx - 1];
- CHECK_STRING_SPACE (v->width);
- sp->c = ALLOC_STRING_SPACE (v->width);
+ sp->c = pool_alloc (e->pool, v->width + 1);
sp->c[0] = v->width;
- memcpy (&sp->c[1], c->data[v->fv].s, v->width);
+ assert (c != NULL);
+ memcpy (&sp->c[1], case_str (c, v->fv), v->width);
}
break;
break;
case OP_STR_CON:
sp++;
- CHECK_STRING_SPACE (*str);
- sp->c = ALLOC_STRING_SPACE (*str);
+ sp->c = pool_alloc (e->pool, *str + 1);
memcpy (sp->c, str, *str + 1);
str += *str + 1;
break;
case OP_NUM_VAR:
sp++;
- sp->f = c->data[(*vars)->fv].f;
+ assert (c != NULL);
+ sp->f = case_num (c, (*vars)->fv);
if (is_num_user_missing (sp->f, *vars))
sp->f = SYSMIS;
vars++;
int width = (*vars)->width;
sp++;
- CHECK_STRING_SPACE (width);
- sp->c = ALLOC_STRING_SPACE (width);
+ sp->c = pool_alloc (e->pool, width + 1);
sp->c[0] = width;
- memcpy (&sp->c[1], &c->data[(*vars)->fv], width);
+ assert (c != NULL);
+ memcpy (&sp->c[1], case_str (c, (*vars)->fv), width);
vars++;
}
break;
sp->f = SYSMIS;
else
{
- sp->f = c->data[(*vars)->fv].f;
+ sp->f = case_num (c, (*vars)->fv);
if (is_num_user_missing (sp->f, *vars))
sp->f = SYSMIS;
}
int width = (*vars)->width;
sp++;
- CHECK_STRING_SPACE (width);
- sp->c = ALLOC_STRING_SPACE (width);
+ sp->c = pool_alloc (e->pool, width + 1);
sp->c[0] = width;
if (c == NULL)
memset (sp->c, ' ', width);
else
- memcpy (&sp->c[1], &c->data[(*vars)->fv], width);
+ memcpy (&sp->c[1], case_str (c, (*vars)->fv), width);
vars++;
}
break;
case OP_NUM_SYS:
sp++;
- sp->f = c->data[*op++].f == SYSMIS;
- break;
- case OP_STR_MIS:
- sp++;
- sp->f = is_str_user_missing (c->data[(*vars)->fv].s, *vars);
- vars++;
+ assert (c != NULL);
+ sp->f = case_num (c, *op++) == SYSMIS;
break;
case OP_NUM_VAL:
sp++;
- sp->f = c->data[*op++].f;
+ assert (c != NULL);
+ sp->f = case_num (c, *op++);
break;
case OP_CASENUM:
sp++;
- sp->f = vfm_sink_info.ncases + 1;
+ sp->f = case_idx;
break;
case OP_SENTINEL:
goto finished;
default:
-#if GLOBAL_DEBUGGING
- printf (_("evaluate_expression(): not implemented: %s\n"),
- ops[op[-1]].name);
-#else
- printf (_("evaluate_expression(): not implemented: %d\n"), op[-1]);
-#endif
assert (0);
}
main_loop: ;
}
finished:
- if (e->type != EX_STRING)
+ if (e->type != EXPR_STRING)
{
double value = sp->f;
if (!finite (value))
{
assert (v);
-#if PAGED_STACK
- memcpy (e->str_stack, sp->c, sp->c[0] + 1);
- v->c = e->str_stack;
-#else
v->c = sp->c;
-#endif
return 0.0;
}
projects / pspp-builds.git / blobdiff