src/expr-evl.c

   1 /* PSPP - computes sample statistics.
   2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
   3    Written by Ben Pfaff <blp@gnu.org>.
   4
   5    This program is free software; you can redistribute it and/or
   6    modify it under the terms of the GNU General Public License as
   7    published by the Free Software Foundation; either version 2 of the
   8    License, or (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful, but
  11    WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13    General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  18    02111-1307, USA. */
  19
  20 #include <config.h>
  21
  22 #if TIME_WITH_SYS_TIME
  23 #include <sys/time.h>
  24 #include <time.h>
  25 #else
  26 #if HAVE_SYS_TIME_H
  27 #include <sys/time.h>
  28 #else
  29 #include <time.h>
  30 #endif
  31 #endif
  32
  33 #include <ctype.h>
  34 #include "expr.h"
  35 #include "exprP.h"
  36 #include <assert.h>
  37 #include <math.h>
  38 #include <errno.h>
  39 #include <stdio.h>
  40 #include "data-in.h"
  41 #include "error.h"
  42 #include "julcal/julcal.h"
  43 #include "magic.h"
  44 #include "misc.h"
  45 #include "pool.h"
  46 #include "random.h"
  47 #include "stats.h"
  48 #include "str.h"
  49 #include "var.h"
  50 #include "vfm.h"
  51 #include "vfmP.h"
  52
  53 double
  54 expr_evaluate (struct expression *e, struct ccase *c, union value *v)
  55 {
  56   unsigned char *op = e->op;
  57   double *dbl = e->num;
  58   unsigned char *str = e->str;
  59   struct variable **vars = e->var;
  60   int i, j;
  61
  62   /* Stack pointer. */
  63   union value *sp = e->stack;
  64
  65   pool_clear (e->pool);
  66
  67   for (;;)
  68     {
  69       switch (*op++)
  70         {
  71         case OP_PLUS:
  72           sp -= *op - 1;
  73           if (sp->f != SYSMIS)
  74             for (i = 1; i < *op; i++)
  75               {
  76                 if (sp[i].f == SYSMIS)
  77                   {
  78                     sp->f = SYSMIS;
  79                     break;
  80                   }
  81                 else
  82                   sp->f += sp[i].f;
  83               }
  84           op++;
  85           break;
  86         case OP_MUL:
  87           sp -= *op - 1;
  88           if (sp->f != SYSMIS)
  89             for (i = 1; i < *op; i++)
  90               {
  91                 if (sp[i].f == SYSMIS)
  92                   {
  93                     sp->f = SYSMIS;
  94                     break;
  95                   }
  96                 else
  97                   sp->f *= sp[i].f;
  98               }
  99           op++;
 100           break;
 101         case OP_POW:
 102           sp--;
 103           if (sp[0].f == SYSMIS)
 104             {
 105               if (sp[1].f == 0.0)
 106                 sp->f = 1.0;
 107             }
 108           else if (sp[1].f == SYSMIS)
 109             {
 110               if (sp[0].f == 0.0)
 111                 /* SYSMIS**0 */
 112                 sp->f = 0.0;
 113               else
 114                 sp->f = SYSMIS;
 115             }
 116           else if (sp[0].f == 0.0 && sp[1].f == 0.0)
 117             sp->f = SYSMIS;
 118           else
 119             sp->f = pow (sp[0].f, sp[1].f);
 120           break;
 121
 122         case OP_AND:
 123           /* Note that booleans are always one of 0, 1, or SYSMIS.
 124
 125              Truth table (in order of detection):
 126
 127              1:
 128              0 and 0 = 0
 129              0 and 1 = 0
 130              0 and SYSMIS = 0
 131
 132              2:
 133              1 and 0 = 0
 134              SYSMIS and 0 = 0
 135
 136              3:
 137              1 and SYSMIS = SYSMIS
 138              SYSMIS and SYSMIS = SYSMIS
 139
 140              4:
 141              1 and 1 = 1
 142              SYSMIS and 1 = SYSMIS
 143
 144            */
 145           sp--;
 146           if (sp[0].f == 0.0);  /* 1 */
 147           else if (sp[1].f == 0.0)
 148             sp->f = 0.0;        /* 2 */
 149           else if (sp[1].f == SYSMIS)
 150             sp->f = SYSMIS;     /* 3 */
 151           break;
 152         case OP_OR:
 153           /* Truth table (in order of detection):
 154
 155              1:
 156              1 or 1 = 1
 157              1 or 0 = 1
 158              1 or SYSMIS = 1
 159
 160              2:
 161              0 or 1 = 1
 162              SYSMIS or 1 = 1
 163
 164              3:
 165              0 or SYSMIS = SYSMIS
 166              SYSMIS or SYSMIS = SYSMIS
 167
 168              4:
 169              0 or 0 = 0
 170              SYSMIS or 0 = SYSMIS
 171
 172            */
 173           sp--;
 174           if (sp[0].f == 1.0);  /* 1 */
 175           else if (sp[1].f == 1.0)
 176             sp->f = 1.0;        /* 2 */
 177           else if (sp[1].f == SYSMIS)
 178             sp->f = SYSMIS;     /* 3 */
 179           break;
 180         case OP_NOT:
 181           if (sp[0].f == 0.0)
 182             sp->f = 1.0;
 183           else if (sp[0].f == 1.0)
 184             sp->f = 0.0;
 185           break;
 186
 187         case OP_EQ:
 188           sp--;
 189           if (sp[0].f != SYSMIS)
 190             {
 191               if (sp[1].f == SYSMIS)
 192                 sp->f = SYSMIS;
 193               else
 194                 sp->f = sp[0].f == sp[1].f;
 195             }
 196           break;
 197         case OP_GE:
 198           sp--;
 199           if (sp[0].f != SYSMIS)
 200             {
 201               if (sp[1].f == SYSMIS)
 202                 sp->f = SYSMIS;
 203               else
 204                 sp->f = sp[0].f >= sp[1].f;
 205             }
 206           break;
 207         case OP_GT:
 208           sp--;
 209           if (sp[0].f != SYSMIS)
 210             {
 211               if (sp[1].f == SYSMIS)
 212                 sp->f = SYSMIS;
 213               else
 214                 sp->f = sp[0].f > sp[1].f;
 215             }
 216           break;
 217         case OP_LE:
 218           sp--;
 219           if (sp[0].f != SYSMIS)
 220             {
 221               if (sp[1].f == SYSMIS)
 222                 sp->f = SYSMIS;
 223               else
 224                 sp->f = sp[0].f <= sp[1].f;
 225             }
 226           break;
 227         case OP_LT:
 228           sp--;
 229           if (sp[0].f != SYSMIS)
 230             {
 231               if (sp[1].f == SYSMIS)
 232                 sp->f = SYSMIS;
 233               else
 234                 sp->f = sp[0].f < sp[1].f;
 235             }
 236           break;
 237         case OP_NE:
 238           sp--;
 239           if (sp[0].f != SYSMIS)
 240             {
 241               if (sp[1].f == SYSMIS)
 242                 sp->f = SYSMIS;
 243               else
 244                 sp->f = sp[0].f != sp[1].f;
 245             }
 246           break;
 247
 248           /* String operators. */
 249         case OP_STRING_EQ:
 250           sp--;
 251           sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
 252                                     &sp[1].c[1], sp[1].c[0]) == 0;
 253           break;
 254         case OP_STRING_GE:
 255           sp--;
 256           sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
 257                                     &sp[1].c[1], sp[1].c[0]) >= 0;
 258           break;
 259         case OP_STRING_GT:
 260           sp--;
 261           sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
 262                                     &sp[1].c[1], sp[1].c[0]) > 0;
 263           break;
 264         case OP_STRING_LE:
 265           sp--;
 266           sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
 267                                     &sp[1].c[1], sp[1].c[0]) <= 0;
 268           break;
 269         case OP_STRING_LT:
 270           sp--;
 271           sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
 272                                     &sp[1].c[1], sp[1].c[0]) < 0;
 273           break;
 274         case OP_STRING_NE:
 275           sp--;
 276           sp[0].f = st_compare_pad (&sp[0].c[1], sp[0].c[0],
 277                                     &sp[1].c[1], sp[1].c[0]) != 0;
 278           break;
 279
 280           /* Unary functions. */
 281         case OP_NEG:
 282           if (sp->f != SYSMIS)
 283             sp->f = -sp->f;
 284           break;
 285         case OP_ABS:
 286           if (sp->f != SYSMIS)
 287             sp->f = fabs (sp->f);
 288           break;
 289         case OP_ARCOS:
 290           if (sp->f != SYSMIS)
 291             {
 292               errno = 0;
 293               sp->f = acos (sp->f);
 294               if (errno)
 295                 sp->f = SYSMIS;
 296             }
 297           break;
 298         case OP_ARSIN:
 299           if (sp->f != SYSMIS)
 300             {
 301               errno = 0;
 302               sp->f = asin (sp->f);
 303               if (errno)
 304                 sp->f = SYSMIS;
 305             }
 306           break;
 307         case OP_ARTAN:
 308           if (sp->f != SYSMIS)
 309             sp->f = atan (sp->f);
 310           break;
 311         case OP_COS:
 312           if (sp->f != SYSMIS)
 313             sp->f = cos (sp->f);
 314           break;
 315         case OP_EXP:
 316           if (sp->f != SYSMIS)
 317             {
 318               errno = 0;
 319               sp->f = exp (sp->f);
 320               if (errno)
 321                 sp->f = SYSMIS;
 322             }
 323           break;
 324         case OP_LG10:
 325           if (sp->f != SYSMIS)
 326             {
 327               errno = 0;
 328               sp->f = log10 (sp->f);
 329               if (errno)
 330                 sp->f = SYSMIS;
 331             }
 332           break;
 333         case OP_LN:
 334           if (sp->f != SYSMIS)
 335             {
 336               errno = 0;
 337               sp->f = log10 (sp->f);
 338               if (errno)
 339                 sp->f = SYSMIS;
 340             }
 341           break;
 342         case OP_MOD10:
 343           if (sp->f != SYSMIS)
 344             sp->f = fmod (sp->f, 10);
 345           break;
 346         case OP_RND:
 347           if (sp->f != SYSMIS)
 348             {
 349               if (sp->f >= 0.0)
 350                 sp->f = floor (sp->f + 0.5);
 351               else
 352                 sp->f = -floor (-sp->f + 0.5);
 353             }
 354           break;
 355         case OP_SIN:
 356           if (sp->f != SYSMIS)
 357             sp->f = sin (sp->f);
 358           break;
 359         case OP_SQRT:
 360           if (sp->f != SYSMIS)
 361             {
 362               errno = 0;
 363               sp->f = sqrt (sp->f);
 364               if (errno)
 365                 sp->f = SYSMIS;
 366             }
 367           break;
 368         case OP_TAN:
 369           if (sp->f != SYSMIS)
 370             {
 371               errno = 0;
 372               sp->f = tan (sp->f);
 373               if (errno)
 374                 sp->f = SYSMIS;
 375             }
 376           break;
 377         case OP_TRUNC:
 378           if (sp->f != SYSMIS)
 379             {
 380               if (sp->f >= 0.0)
 381                 sp->f = floor (sp->f);
 382               else
 383                 sp->f = -floor (-sp->f);
 384             }
 385           break;
 386
 387           /* N-ary numeric functions. */
 388         case OP_ANY:
 389           {
 390             int n_args = *op++;
 391             int sysmis = 1;
 392
 393             sp -= n_args - 1;
 394             if (sp->f == SYSMIS)
 395               break;
 396             for (i = 1; i <= n_args; i++)
 397               if (sp[0].f == sp[i].f)
 398                 {
 399                   sp->f = 1.0;
 400                   goto main_loop;
 401                 }
 402               else if (sp[i].f != SYSMIS)
 403                 sysmis = 0;
 404             sp->f = sysmis ? SYSMIS : 0.0;
 405           }
 406           break;
 407         case OP_ANY_STRING:
 408           {
 409             int n_args = *op++;
 410
 411             sp -= n_args - 1;
 412             for (i = 1; i <= n_args; i++)
 413               if (!st_compare_pad (&sp[0].c[1], sp[0].c[0],
 414                                    &sp[i].c[1], sp[i].c[0]))
 415                 {
 416                   sp->f = 1.0;
 417                   goto main_loop;
 418                 }
 419             sp->f = 0.0;
 420           }
 421           break;
 422         case OP_CFVAR:
 423           {
 424             int n_args = *op++;
 425             int nv = 0;
 426             double sum[2] =
 427             {0.0, 0.0};
 428
 429             sp -= n_args - 1;
 430             for (i = 0; i < n_args; i++)
 431               if (sp[i].f != SYSMIS)
 432                 {
 433                   nv++;
 434                   sum[0] += sp[i].f;
 435                   sum[1] += sp[i].f * sp[i].f;
 436                 }
 437             if (nv < *op++)
 438               sp->f = SYSMIS;
 439             else
 440               sp->f = calc_cfvar (sum, nv);
 441           }
 442           break;
 443         case OP_MAX:
 444           {
 445             int n_args = *op++;
 446             int nv = 0;
 447             double max = -DBL_MAX;
 448
 449             sp -= n_args - 1;
 450             for (i = 0; i < n_args; i++)
 451               if (sp[i].f != SYSMIS)
 452                 {
 453                   nv++;
 454                   if (sp[i].f > max)
 455                     max = sp[i].f;
 456                 }
 457             if (nv < *op++)
 458               sp->f = SYSMIS;
 459             else
 460               sp->f = max;
 461           }
 462           break;
 463         case OP_MEAN:
 464           {
 465             int n_args = *op++;
 466             int nv = 0;
 467             double sum[1] =
 468             {0.0};
 469
 470             sp -= n_args - 1;
 471             for (i = 0; i < n_args; i++)
 472               if (sp[i].f != SYSMIS)
 473                 {
 474                   nv++;
 475                   sum[0] += sp[i].f;
 476                 }
 477             if (nv < *op++)
 478               sp->f = SYSMIS;
 479             else
 480               sp->f = calc_mean (sum, nv);
 481           }
 482           break;
 483         case OP_MIN:
 484           {
 485             int n_args = *op++;
 486             int nv = 0;
 487             double min = DBL_MAX;
 488
 489             sp -= n_args - 1;
 490             for (i = 0; i < n_args; i++)
 491               if (sp[i].f != SYSMIS)
 492                 {
 493                   nv++;
 494                   if (sp[i].f < min)
 495                     min = sp[i].f;
 496                 }
 497             if (nv < *op++)
 498               sp->f = SYSMIS;
 499             else
 500               sp->f = min;
 501           }
 502           break;
 503         case OP_NMISS:
 504           {
 505             int n_args = *op++;
 506             int n_missing = 0;
 507
 508             sp -= n_args - 1;
 509             for (i = 0; i < n_args; i++)
 510               if (sp[i].f == SYSMIS)
 511                 n_missing++;
 512             sp->f = n_missing;
 513           }
 514           break;
 515         case OP_NVALID:
 516           {
 517             int n_args = *op++;
 518             int n_valid = 0;
 519
 520             sp -= n_args - 1;
 521             for (i = 0; i < n_args; i++)
 522               if (sp[i].f != SYSMIS)
 523                 n_valid++;
 524             sp->f = n_valid;
 525           }
 526           break;
 527         case OP_RANGE:
 528           {
 529             int n_args = *op++;
 530             int sysmis = 1;
 531
 532             sp -= n_args - 1;
 533             if (sp->f == SYSMIS)
 534               break;
 535             for (i = 1; i <= n_args; i += 2)
 536               if (sp[i].f == SYSMIS || sp[i + 1].f == SYSMIS)
 537                 continue;
 538               else if (sp[0].f >= sp[i].f && sp[0].f <= sp[i + 1].f)
 539                 {
 540                   sp->f = 1.0;
 541                   goto main_loop;
 542                 }
 543               else
 544                 sysmis = 0;
 545             sp->f = sysmis ? SYSMIS : 0.0;
 546           }
 547           break;
 548         case OP_RANGE_STRING:
 549           {
 550             int n_args = *op++;
 551
 552             sp -= n_args - 1;
 553             for (i = 1; i <= n_args; i += 2)
 554               if (st_compare_pad (&sp[0].c[1], sp[0].c[0],
 555                                   &sp[i].c[1], sp[i].c[0]) >= 0
 556                   && st_compare_pad (&sp[0].c[1], sp[0].c[0],
 557                                      &sp[i + 1].c[1], sp[i + 1].c[0]) <= 0)
 558                 {
 559                   sp->f = 1.0;
 560                   goto main_loop;
 561                 }
 562             sp->f = 0.0;
 563           }
 564           break;
 565         case OP_SD:
 566           {
 567             int n_args = *op++;
 568             int nv = 0;
 569             double sum[2];
 570
 571             sum[0] = sum[1] = 0.0;
 572
 573             sp -= n_args - 1;
 574             for (i = 0; i < n_args; i++)
 575               if (sp[i].f != SYSMIS)
 576                 {
 577                   nv++;
 578                   sum[0] += sp[i].f;
 579                   sum[1] += sp[i].f * sp[i].f;
 580                 }
 581             if (nv < *op++)
 582               sp->f = SYSMIS;
 583             else
 584               sp->f = calc_stddev (calc_variance (sum, nv));
 585           }
 586           break;
 587         case OP_SUM:
 588           {
 589             int n_args = *op++;
 590             int nv = 0;
 591             double sum = 0.0;
 592
 593             sp -= n_args - 1;
 594             for (i = 0; i < n_args; i++)
 595               if (sp[i].f != SYSMIS)
 596                 {
 597                   nv++;
 598                   sum += sp[i].f;
 599                 }
 600             if (nv < *op++)
 601               sp->f = SYSMIS;
 602             else
 603               sp->f = sum;
 604           }
 605           break;
 606         case OP_VARIANCE:
 607           {
 608             int n_args = *op++;
 609             int nv = 0;
 610             double sum[2];
 611
 612             sum[0] = sum[1] = 0.0;
 613
 614             sp -= n_args - 1;
 615             for (i = 0; i < n_args; i++)
 616               if (sp[i].f != SYSMIS)
 617                 {
 618                   nv++;
 619                   sum[0] += sp[i].f;
 620                   sum[1] += sp[i].f * sp[i].f;
 621                 }
 622             if (nv < *op++)
 623               sp->f = SYSMIS;
 624             else
 625               sp->f = calc_variance (sum, nv);
 626           }
 627           break;
 628
 629           /* Time construction function. */
 630         case OP_TIME_HMS:
 631           sp -= 2;
 632           if (sp[0].f == SYSMIS || sp[1].f == SYSMIS || sp[2].f == SYSMIS)
 633             sp->f = SYSMIS;
 634           else
 635             sp->f = 60. * (60. * sp[0].f + sp[1].f) + sp[2].f;
 636           break;
 637
 638           /* Date construction functions. */
 639         case OP_DATE_DMY:
 640           sp -= 2;
 641           sp->f = yrmoda (sp[2].f, sp[1].f, sp[0].f);
 642           if (sp->f != SYSMIS)
 643             sp->f *= 60. * 60. * 24.;
 644           break;
 645         case OP_DATE_MDY:
 646           sp -= 2;
 647           sp->f = yrmoda (sp[2].f, sp[0].f, sp[1].f);
 648           if (sp->f != SYSMIS)
 649             sp->f *= 60. * 60. * 24.;
 650           break;
 651         case OP_DATE_MOYR:
 652           sp--;
 653           sp->f = yrmoda (sp[1].f, sp[0].f, 1);
 654           if (sp->f != SYSMIS)
 655             sp->f *= 60. * 60. * 24.;
 656           break;
 657         case OP_DATE_QYR:
 658           sp--;
 659           if (sp[0].f == SYSMIS)
 660             sp->f = SYSMIS;
 661           else
 662             {
 663               sp->f = yrmoda (sp[1].f, sp[0].f * 3 - 2, 1);
 664               if (sp->f != SYSMIS)
 665                 sp->f *= 60. * 60. * 24.;
 666             }
 667           break;
 668         case OP_DATE_WKYR:
 669           sp--;
 670           if (sp[0].f == SYSMIS)
 671             sp->f = SYSMIS;
 672           else
 673             {
 674               sp[1].f = yrmoda (sp[1].f, 1, 1);
 675               if (sp->f != SYSMIS)
 676                 sp[1].f = 60. * 60. * 24. * (sp[1].f + 7. * (floor (sp[0].f) - 1.));
 677               sp->f = sp[1].f;
 678             }
 679           break;
 680         case OP_DATE_YRDAY:
 681           sp--;
 682           if (sp[1].f == SYSMIS)
 683             sp->f = SYSMIS;
 684           else
 685             {
 686               sp->f = yrmoda (sp[0].f, 1, 1);
 687               if (sp->f != SYSMIS)
 688                 sp->f = 60. * 60. * 24. * (sp->f + floor (sp[1].f) - 1);
 689             }
 690           break;
 691         case OP_YRMODA:
 692           sp -= 2;
 693           sp->f = yrmoda (sp[0].f, sp[1].f, sp[2].f);
 694           break;
 695
 696           /* Date extraction functions. */
 697         case OP_XDATE_DATE:
 698           if (sp->f != SYSMIS)
 699             sp->f = floor (sp->f / 60. / 60. / 24.) * 60. * 60. * 24.;
 700           break;
 701         case OP_XDATE_HOUR:
 702           if (sp->f != SYSMIS)
 703             sp->f = fmod (floor (sp->f / 60. / 60.), 24.);
 704           break;
 705         case OP_XDATE_JDAY:
 706           if (sp->f != SYSMIS)
 707             sp->f = 86400. * julian_to_jday (sp->f / 86400.);
 708           break;
 709         case OP_XDATE_MDAY:
 710           if (sp->f != SYSMIS)
 711             {
 712               int day;
 713               julian_to_calendar (sp->f / 86400., NULL, NULL, &day);
 714               sp->f = day;
 715             }
 716           break;
 717         case OP_XDATE_MINUTE:
 718           if (sp->f != SYSMIS)
 719             sp->f = fmod (floor (sp->f / 60.), 60.);
 720           break;
 721         case OP_XDATE_MONTH:
 722           if (sp->f != SYSMIS)
 723             {
 724               int month;
 725               julian_to_calendar (sp->f / 86400., NULL, &month, NULL);
 726               sp->f = month;
 727             }
 728           break;
 729         case OP_XDATE_QUARTER:
 730           if (sp->f != SYSMIS)
 731             {
 732               int month;
 733               julian_to_calendar (sp->f / 86400., NULL, &month, NULL);
 734               sp->f = (month - 1) / 3 + 1;
 735             }
 736           break;
 737         case OP_XDATE_SECOND:
 738           if (sp->f != SYSMIS)
 739             sp->f = fmod (sp->f, 60.);
 740           break;
 741         case OP_XDATE_TDAY:
 742           if (sp->f != SYSMIS)
 743             sp->f = floor (sp->f / 60. / 60. / 24.);
 744           break;
 745         case OP_XDATE_TIME:
 746           if (sp->f != SYSMIS)
 747             sp->f -= floor (sp->f / 60. / 60. / 24.) * 60. * 60. * 24.;
 748           break;
 749         case OP_XDATE_WEEK:
 750           if (sp->f != SYSMIS)
 751             sp->f = (julian_to_jday (sp->f / 86400.) - 1) / 7 + 1;
 752           break;
 753         case OP_XDATE_WKDAY:
 754           if (sp->f != SYSMIS)
 755             sp->f = julian_to_wday (sp->f / 86400.);
 756           break;
 757         case OP_XDATE_YEAR:
 758           if (sp->f != SYSMIS)
 759             {
 760               int year;
 761               julian_to_calendar (sp->f / 86400., &year, NULL, NULL);
 762               sp->f = year;
 763             }
 764           break;
 765
 766           /* String functions. */
 767         case OP_CONCAT:
 768           {
 769             int n_args = *op++;
 770             unsigned char *dest;
 771
 772             dest = pool_alloc (e->pool, 256);
 773             dest[0] = 0;
 774
 775             sp -= n_args - 1;
 776             for (i = 0; i < n_args; i++)
 777               if (sp[i].c[0] != 0)
 778                 {
 779                   if (sp[i].c[0] + dest[0] < 255)
 780                     {
 781                       memcpy (&dest[dest[0] + 1], &sp[i].c[1], sp[i].c[0]);
 782                       dest[0] += sp[i].c[0];
 783                     }
 784                   else
 785                     {
 786                       memcpy (&dest[dest[0] + 1], &sp[i].c[1], 255 - dest[0]);
 787                       dest[0] = 255;
 788                       break;
 789                     }
 790                 }
 791             sp[0].c = dest;
 792           }
 793           break;
 794         case OP_INDEX:
 795           sp--;
 796           if (sp[1].c[0] == 0)
 797             sp->f = SYSMIS;
 798           else
 799             {
 800               int last = sp[0].c[0] - sp[1].c[0];
 801               for (i = 0; i <= last; i++)
 802                 if (!memcmp (&sp[0].c[i + 1], &sp[0].c[1], sp[0].c[0]))
 803                   {
 804                     sp->f = i + 1;
 805                     goto main_loop;
 806                   }
 807               sp->f = 0.0;
 808             }
 809           break;
 810         case OP_INDEX_OPT:
 811           {
 812             /* Length of each search string. */
 813             int part_len = sp[2].f;
 814
 815             sp -= 2;
 816             if (sp[1].c[0] == 0 || part_len <= 0 || sp[2].f == SYSMIS
 817                 || sp[1].c[0] % part_len != 0)
 818               sp->f = SYSMIS;
 819             else
 820               {
 821                 /* Last possible index. */
 822                 int last = sp[0].c[0] - part_len;
 823
 824                 for (i = 0; i <= last; i++)
 825                   for (j = 0; j < sp[1].c[0]; j += part_len)
 826                     if (!memcmp (&sp[0].c[i], &sp[1].c[j], part_len))
 827                       {
 828                         sp->f = i + 1;
 829                         goto main_loop;
 830                       }
 831                 sp->f = 0.0;
 832               }
 833           }
 834           break;
 835         case OP_RINDEX:
 836           sp--;
 837           if (sp[1].c[0] == 0)
 838             sp->f = SYSMIS;
 839           else
 840             {
 841               for (i = sp[0].c[0] - sp[1].c[0]; i >= 0; i--)
 842                 if (!memcmp (&sp[0].c[i + 1], &sp[0].c[1], sp[0].c[0]))
 843                   {
 844                     sp->f = i + 1;
 845                     goto main_loop;
 846                   }
 847               sp->f = 0.0;
 848             }
 849           break;
 850         case OP_RINDEX_OPT:
 851           {
 852             /* Length of each search string. */
 853             int part_len = sp[2].f;
 854
 855             sp -= 2;
 856             if (sp[1].c[0] == 0 || part_len <= 0 || sp[2].f == SYSMIS
 857                 || sp[1].c[0] % part_len != 0)
 858               sp->f = SYSMIS;
 859             else
 860               {
 861                 for (i = sp[0].c[0] - part_len; i >= 0; i--)
 862                   for (j = 0; j < sp[1].c[0]; j += part_len)
 863                     if (!memcmp (&sp[0].c[i], &sp[1].c[j], part_len))
 864                       {
 865                         sp->f = i + 1;
 866                         goto main_loop;
 867                       }
 868                 sp->f = 0.0;
 869               }
 870           }
 871           break;
 872         case OP_LENGTH:
 873           sp->f = sp[0].c[0];
 874           break;
 875         case OP_LOWER:
 876           for (i = sp[0].c[0]; i >= 1; i--)
 877             sp[0].c[i] = tolower ((unsigned char) (sp[0].c[i]));
 878           break;
 879         case OP_UPPER:
 880           for (i = sp[0].c[0]; i >= 1; i--)
 881             sp[0].c[i] = toupper ((unsigned char) (sp[0].c[i]));
 882           break;
 883         case OP_LPAD:
 884           {
 885             int len;
 886             sp--;
 887             len = sp[1].f;
 888             if (sp[1].f == SYSMIS || len < 0 || len > 255)
 889               sp->c[0] = 0;
 890             else if (len > sp[0].c[0])
 891               {
 892                 unsigned char *dest;
 893
 894                 dest = pool_alloc (e->pool, len + 1);
 895                 dest[0] = len;
 896                 memset (&dest[1], ' ', len - sp->c[0]);
 897                 memcpy (&dest[len - sp->c[0] + 1], &sp->c[1], sp->c[0]);
 898                 sp->c = dest;
 899               }
 900           }
 901           break;
 902         case OP_LPAD_OPT:
 903           {
 904             int len;
 905             sp -= 2;
 906             len = sp[1].f;
 907             if (sp[1].f == SYSMIS || len < 0 || len > 255 || sp[2].c[0] != 1)
 908               sp->c[0] = 0;
 909             else if (len > sp[0].c[0])
 910               {
 911                 unsigned char *dest;
 912
 913                 dest = pool_alloc (e->pool, len + 1);
 914                 dest[0] = len;
 915                 memset (&dest[1], sp[2].c[1], len - sp->c[0]);
 916                 memcpy (&dest[len - sp->c[0] + 1], &sp->c[1], sp->c[0]);
 917                 sp->c = dest;
 918               }
 919           }
 920           break;
 921         case OP_RPAD:
 922           {
 923             int len;
 924             sp--;
 925             len = sp[1].f;
 926             if (sp[1].f == SYSMIS || len < 0 || len > 255)
 927               sp->c[0] = 0;
 928             else if (len > sp[0].c[0])
 929               {
 930                 unsigned char *dest;
 931
 932                 dest = pool_alloc (e->pool, len + 1);
 933                 dest[0] = len;
 934                 memcpy (&dest[1], &sp->c[1], sp->c[0]);
 935                 memset (&dest[sp->c[0] + 1], ' ', len - sp->c[0]);
 936                 sp->c = dest;
 937               }
 938           }
 939           break;
 940         case OP_RPAD_OPT:
 941           {
 942             int len;
 943             sp -= 2;
 944             len = sp[1].f;
 945             if (len < 0 || len > 255 || sp[2].c[0] != 1)
 946               sp->c[0] = 0;
 947             else if (len > sp[0].c[0])
 948               {
 949                 unsigned char *dest;
 950
 951                 dest = pool_alloc (e->pool, len + 1);
 952                 dest[0] = len;
 953                 memcpy (&dest[1], &sp->c[1], sp->c[0]);
 954                 memset (&dest[sp->c[0] + 1], sp[2].c[1], len - sp->c[0]);
 955                 sp->c = dest;
 956               }
 957           }
 958           break;
 959         case OP_LTRIM:
 960           {
 961             int len = sp[0].c[0];
 962
 963             i = 1;
 964             while (i <= len && sp[0].c[i] == ' ')
 965               i++;
 966             if (--i)
 967               {
 968                 sp[0].c[i] = sp[0].c[0] - i;
 969                 sp->c = &sp[0].c[i];
 970               }
 971           }
 972           break;
 973         case OP_LTRIM_OPT:
 974           {
 975             sp--;
 976             if (sp[1].c[0] != 1)
 977               sp[0].c[0] = 0;
 978             else
 979               {
 980                 int len = sp[0].c[0];
 981                 int cmp = sp[1].c[1];
 982
 983                 i = 1;
 984                 while (i <= len && sp[0].c[i] == cmp)
 985                   i++;
 986                 if (--i)
 987                   {
 988                     sp[0].c[i] = sp[0].c[0] - i;
 989                     sp->c = &sp[0].c[i];
 990                   }
 991               }
 992           }
 993           break;
 994         case OP_RTRIM:
 995           assert (' ' != 0);
 996           while (sp[0].c[sp[0].c[0]] == ' ')
 997             sp[0].c[0]--;
 998           break;
 999         case OP_RTRIM_OPT:
1000           sp--;
1001           if (sp[1].c[0] != 1)
1002             sp[0].c[0] = 0;
1003           else
1004             {
1005               /* Note that NULs are not allowed in strings.  This code
1006                  needs to change if this decision is changed. */
1007               int cmp = sp[1].c[1];
1008               while (sp[0].c[sp[0].c[0]] == cmp)
1009                 sp[0].c[0]--;
1010             }
1011           break;
1012         case OP_NUMBER:
1013           {
1014             struct data_in di;
1015
1016             di.s = &sp->c[1];
1017             di.e = &sp->c[1] + sp->c[0];
1018             di.v = sp;
1019             di.flags = DI_IGNORE_ERROR;
1020             di.f1 = 1;
1021             di.format.type = FMT_F;
1022             di.format.w = sp->c[0];
1023             di.format.d = 0;
1024             data_in (&di);
1025           }
1026           break;
1027         case OP_NUMBER_OPT:
1028           {
1029             struct data_in di;
1030             di.s = &sp->c[1];
1031             di.e = &sp->c[1] + sp->c[0];
1032             di.v = sp;
1033             di.flags = DI_IGNORE_ERROR;
1034             di.f1 = 1;
1035             di.format.type = *op++;
1036             di.format.w = *op++;
1037             di.format.d = *op++;
1038             data_in (&di);
1039           }
1040           break;
1041         case OP_STRING:
1042           {
1043             struct fmt_spec f;
1044             unsigned char *dest;
1045
1046             f.type = *op++;
1047             f.w = *op++;
1048             f.d = *op++;
1049
1050             dest = pool_alloc (e->pool, f.w + 1);
1051             dest[0] = f.w;
1052
1053             assert ((formats[f.type].cat & FCAT_STRING) == 0);
1054             data_out (&dest[1], &f, sp);
1055             sp->c = dest;
1056           }
1057           break;
1058         case OP_SUBSTR:
1059           {
1060             int index;
1061
1062             sp--;
1063             index = sp[1].f;
1064             if (index < 1 || index > sp[0].c[0])
1065               sp->c[0] = 0;
1066             else if (index > 1)
1067               {
1068                 index--;
1069                 sp->c[index] = sp->c[0] - index;
1070                 sp->c += index;
1071               }
1072           }
1073           break;
1074         case OP_SUBSTR_OPT:
1075           {
1076             int index;
1077             int n;
1078
1079             sp -= 2;
1080             index = sp[1].f;
1081             n = sp[2].f;
1082             if (sp[1].f == SYSMIS || sp[2].f == SYSMIS || index < 1
1083                 || index > sp[0].c[0] || n < 1)
1084               sp->c[0] = 0;
1085             else
1086               {
1087                 if (index > 1)
1088                   {
1089                     index--;
1090                     sp->c[index] = sp->c[0] - index;
1091                     sp->c += index;
1092                   }
1093                 if (sp->c[0] > n)
1094                   sp->c[0] = n;
1095               }
1096           }
1097           break;
1098
1099           /* Artificial. */
1100         case OP_INV:
1101           if (sp->f != SYSMIS)
1102             sp->f = 1. / sp->f;
1103           break;
1104         case OP_SQUARE:
1105           if (sp->f != SYSMIS)
1106             sp->f *= sp->f;
1107           break;
1108         case OP_NUM_TO_BOOL:
1109           if (sp->f == 0.0)
1110             sp->f = 0.0;
1111           else if (sp->f == 1.0)
1112             sp->f = 1.0;
1113           else if (sp->f != SYSMIS)
1114             {
1115               msg (SE, _("A number being treated as a Boolean in an "
1116                          "expression was found to have a value other than "
1117                          "0 (false), 1 (true), or the system-missing value.  "
1118                          "The result was forced to 0."));
1119               sp->f = 0.0;
1120             }
1121           break;
1122
1123           /* Weirdness. */
1124         case OP_MOD:
1125           sp--;
1126           if (sp[0].f != SYSMIS)
1127             {
1128               if (sp[1].f == SYSMIS)
1129                 {
1130                   if (sp[0].f != 0.0)
1131                     sp->f = SYSMIS;
1132                 }
1133               else
1134                 sp->f = fmod (sp[0].f, sp[1].f);
1135             }
1136           break;
1137         case OP_NORMAL:
1138           if (sp->f != SYSMIS)
1139             sp->f *= rng_get_double_normal (pspp_rng ());
1140           break;
1141         case OP_UNIFORM:
1142           if (sp->f != SYSMIS)
1143             sp->f *= rng_get_double (pspp_rng ());
1144           break;
1145         case OP_SYSMIS:
1146           if (sp[0].f == SYSMIS || !finite (sp[0].f))
1147             sp->f = 1.0;
1148           else
1149             sp->f = 0.0;
1150           break;
1151         case OP_VEC_ELEM_NUM:
1152           {
1153             int rindx = sp[0].f + EPSILON;
1154             const struct vector *v = dict_get_vector (default_dict, *op++);
1155
1156             if (sp[0].f == SYSMIS || rindx < 1 || rindx > v->cnt)
1157               {
1158                 if (sp[0].f == SYSMIS)
1159                   msg (SE, _("SYSMIS is not a valid index value for vector "
1160                              "%s.  The result will be set to SYSMIS."),
1161                        v->name);
1162                 else
1163                   msg (SE, _("%g is not a valid index value for vector %s.  "
1164                              "The result will be set to SYSMIS."),
1165                        sp[0].f, v->name);
1166                 sp->f = SYSMIS;
1167                 break;
1168               }
1169             sp->f = c->data[v->var[rindx - 1]->fv].f;
1170           }
1171           break;
1172         case OP_VEC_ELEM_STR:
1173           {
1174             int rindx = sp[0].f + EPSILON;
1175             const struct vector *vect = dict_get_vector (default_dict, *op++);
1176             struct variable *v;
1177
1178             if (sp[0].f == SYSMIS || rindx < 1 || rindx > vect->cnt)
1179               {
1180                 if (sp[0].f == SYSMIS)
1181                   msg (SE, _("SYSMIS is not a valid index value for vector "
1182                              "%s.  The result will be set to the empty "
1183                              "string."),
1184                        vect->name);
1185                 else
1186                   msg (SE, _("%g is not a valid index value for vector %s.  "
1187                              "The result will be set to the empty string."),
1188                        sp[0].f, vect->name);
1189                 sp->c = pool_alloc (e->pool, 1);
1190                 sp->c[0] = 0;
1191                 break;
1192               }
1193
1194             v = vect->var[rindx - 1];
1195             sp->c = pool_alloc (e->pool, v->width + 1);
1196             sp->c[0] = v->width;
1197             memcpy (&sp->c[1], c->data[v->fv].s, v->width);
1198           }
1199           break;
1200
1201           /* Terminals. */
1202         case OP_NUM_CON:
1203           sp++;
1204           sp->f = *dbl++;
1205           break;
1206         case OP_STR_CON:
1207           sp++;
1208           sp->c = pool_alloc (e->pool, *str + 1);
1209           memcpy (sp->c, str, *str + 1);
1210           str += *str + 1;
1211           break;
1212         case OP_NUM_VAR:
1213           sp++;
1214           sp->f = c->data[(*vars)->fv].f;
1215           if (is_num_user_missing (sp->f, *vars))
1216             sp->f = SYSMIS;
1217           vars++;
1218           break;
1219         case OP_STR_VAR:
1220           {
1221             int width = (*vars)->width;
1222
1223             sp++;
1224             sp->c = pool_alloc (e->pool, width + 1);
1225             sp->c[0] = width;
1226             memcpy (&sp->c[1], &c->data[(*vars)->fv], width);
1227             vars++;
1228           }
1229           break;
1230         case OP_NUM_LAG:
1231           {
1232             struct ccase *c = lagged_case (*op++);
1233
1234             sp++;
1235             if (c == NULL)
1236               sp->f = SYSMIS;
1237             else
1238               {
1239                 sp->f = c->data[(*vars)->fv].f;
1240                 if (is_num_user_missing (sp->f, *vars))
1241                   sp->f = SYSMIS;
1242               }
1243             vars++;
1244             break;
1245           }
1246         case OP_STR_LAG:
1247           {
1248             struct ccase *c = lagged_case (*op++);
1249             int width = (*vars)->width;
1250
1251             sp++;
1252             sp->c = pool_alloc (e->pool, width + 1);
1253             sp->c[0] = width;
1254
1255             if (c == NULL)
1256               memset (sp->c, ' ', width);
1257             else
1258               memcpy (&sp->c[1], &c->data[(*vars)->fv], width);
1259
1260             vars++;
1261           }
1262           break;
1263         case OP_NUM_SYS:
1264           sp++;
1265           sp->f = c->data[*op++].f == SYSMIS;
1266           break;
1267         case OP_STR_MIS:
1268           sp++;
1269           sp->f = is_str_user_missing (c->data[(*vars)->fv].s, *vars);
1270           vars++;
1271           break;
1272         case OP_NUM_VAL:
1273           sp++;
1274           sp->f = c->data[*op++].f;
1275           break;
1276         case OP_CASENUM:
1277           sp++;
1278           sp->f = vfm_sink_info.ncases + 1;
1279           break;
1280
1281         case OP_SENTINEL:
1282           goto finished;
1283
1284         default:
1285           assert (0);
1286         }
1287
1288     main_loop: ;
1289     }
1290 finished:
1291   if (e->type != EX_STRING)
1292     {
1293       double value = sp->f;
1294       if (!finite (value))
1295         value = SYSMIS;
1296       if (v)
1297         v->f = value;
1298       return value;
1299     }
1300   else
1301     {
1302       assert (v);
1303
1304       v->c = sp->c;
1305
1306       return 0.0;
1307     }
1308 }