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