src/recode.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 #include <assert.h>
  22 #include <ctype.h>
  23 #include <math.h>
  24 #include <stdlib.h>
  25 #include "alloc.h"
  26 #include "command.h"
  27 #include "error.h"
  28 #include "lexer.h"
  29 #include "magic.h"
  30 #include "str.h"
  31 #include "var.h"
  32
  33 #include "debug-print.h"
  34 \f
  35 /* Definitions. */
  36
  37 /* Type of source value for RECODE. */
  38 enum
  39   {
  40     RCD_END,                    /* sentinel value */
  41     RCD_USER,                   /* user-missing => one */
  42     RCD_SINGLE,                 /* one => one */
  43     RCD_HIGH,                   /* x > a => one */
  44     RCD_LOW,                    /* x < b => one */
  45     RCD_RANGE,                  /* b < x < a => one */
  46     RCD_ELSE,                   /* any but SYSMIS => one */
  47     RCD_CONVERT                 /* "123" => 123 */
  48   };
  49
  50 /* Describes how to recode a single value or range of values into a
  51    single value.  */
  52 struct coding
  53   {
  54     int type;                   /* RCD_* */
  55     union value f1, f2;         /* Describe value or range as src.  Long
  56                                    strings are stored in `c'. */
  57     union value t;              /* Describes value as dest. Long strings in `c'. */
  58   };
  59
  60 /* Describes how to recode a single variable. */
  61 struct rcd_var
  62   {
  63     struct rcd_var *next;
  64
  65     unsigned flags;             /* RCD_SRC_* | RCD_DEST_* | RCD_MISC_* */
  66
  67     struct variable *src;       /* Source variable. */
  68     struct variable *dest;      /* Destination variable. */
  69     char dest_name[9];          /* Name of dest variable if we're creating it. */
  70
  71     int has_sysmis;             /* Do we recode for SYSMIS? */
  72     union value sysmis;         /* Coding for SYSMIS (if src is numeric). */
  73
  74     struct coding *map;         /* Coding for other values. */
  75     int nmap, mmap;             /* Length of map, max capacity of map. */
  76   };
  77
  78 /* RECODE transformation. */
  79 struct recode_trns
  80   {
  81     struct trns_header h;
  82     struct rcd_var *codings;
  83   };
  84
  85 /* What we're recoding from (`src'==`source'). */
  86 #define RCD_SRC_ERROR           0000u   /* Bad value for src. */
  87 #define RCD_SRC_NUMERIC         0001u   /* Src is numeric. */
  88 #define RCD_SRC_STRING          0002u   /* Src is short string. */
  89 #define RCD_SRC_MASK            0003u   /* AND mask to isolate src bits. */
  90
  91 /* What we're recoding to (`dest'==`destination'). */
  92 #define RCD_DEST_ERROR          0000u   /* Bad value for dest. */
  93 #define RCD_DEST_NUMERIC        0004u   /* Dest is numeric. */
  94 #define RCD_DEST_STRING         0010u   /* Dest is short string. */
  95 #define RCD_DEST_MASK           0014u   /* AND mask to isolate dest bits. */
  96
  97 /* Miscellaneous bits. */
  98 #define RCD_MISC_CREATE         0020u   /* We create dest var (numeric only) */
  99 #define RCD_MISC_DUPLICATE      0040u   /* This var_info has the same MAP
 100                                            value as the previous var_info.
 101                                            Prevents redundant free()ing. */
 102 #define RCD_MISC_MISSING        0100u   /* Encountered MISSING or SYSMIS in
 103                                            this input spec. */
 104
 105 static int parse_dest_spec (struct rcd_var * rcd, union value *v,
 106                             size_t *max_dst_width);
 107 static int parse_src_spec (struct rcd_var * rcd, int type, size_t max_src_width);
 108 static trns_proc_func recode_trns_proc;
 109 static trns_free_func recode_trns_free;
 110 static double convert_to_double (char *, int);
 111
 112 #if DEBUGGING
 113 static void debug_print (struct rcd_var * head);
 114 #endif
 115 \f
 116 /* Parser. */
 117
 118 /* First transformation in the list.  rcd is in this list. */
 119 static struct rcd_var *head;
 120
 121 /* Variables in the current part of the recoding. */
 122 struct variable **v;
 123 int nv;
 124
 125 /* Parses the RECODE transformation. */
 126 int
 127 cmd_recode (void)
 128 {
 129   int i;
 130
 131   /* Transformation that we're constructing. */
 132   struct rcd_var *rcd;
 133
 134   /* Type of the src variables. */
 135   int type;
 136
 137   /* Length of longest src string. */
 138   size_t max_src_width;
 139
 140   /* Length of longest dest string. */
 141   size_t max_dst_width;
 142
 143   /* For stepping through, constructing the linked list of
 144      recodings. */
 145   struct rcd_var *iter;
 146
 147   /* The real transformation, just a wrapper for a list of
 148      rcd_var's. */
 149   struct recode_trns *trns;
 150
 151   lex_match_id ("RECODE");
 152
 153   /* Parses each specification between slashes. */
 154   head = rcd = xmalloc (sizeof *rcd);
 155   for (;;)
 156     {
 157       /* Whether we've already encountered a specification for SYSMIS. */
 158       int had_sysmis = 0;
 159
 160       /* Initialize this rcd_var to ensure proper cleanup. */
 161       rcd->next = NULL;
 162       rcd->map = NULL;
 163       rcd->nmap = rcd->mmap = 0;
 164       rcd->has_sysmis = 0;
 165       rcd->sysmis.f = 0;
 166
 167       /* Parse variable names. */
 168       if (!parse_variables (default_dict, &v, &nv, PV_SAME_TYPE))
 169         goto lossage;
 170
 171       /* Ensure all variables are same type; find length of longest
 172          source variable. */
 173       type = v[0]->type;
 174       max_src_width = v[0]->width;
 175
 176       if (type == ALPHA)
 177         for (i = 0; i < nv; i++)
 178           if (v[i]->width > (int) max_src_width)
 179             max_src_width = v[i]->width;
 180
 181       /* Set up flags. */
 182       rcd->flags = 0;
 183       if (type == NUMERIC)
 184         rcd->flags |= RCD_SRC_NUMERIC;
 185       else
 186         rcd->flags |= RCD_SRC_STRING;
 187
 188       /* Parse each coding in parentheses. */
 189       max_dst_width = 0;
 190       if (!lex_force_match ('('))
 191         goto lossage;
 192       for (;;)
 193         {
 194           /* Get the input value (before the `='). */
 195           int mark = rcd->nmap;
 196           int code = parse_src_spec (rcd, type, max_src_width);
 197           if (!code)
 198             goto lossage;
 199
 200           /* ELSE is the same as any other input spec except that it
 201              precludes later sysmis specifications. */
 202           if (code == 3)
 203             {
 204               had_sysmis = 1;
 205               code = 1;
 206             }
 207
 208           /* If keyword CONVERT was specified, there is no output
 209              specification.  */
 210           if (code == 1)
 211             {
 212               union value output;
 213
 214               /* Get the output value (after the `='). */
 215               lex_get ();       /* Skip `='. */
 216               if (!parse_dest_spec (rcd, &output, &max_dst_width))
 217                 goto lossage;
 218
 219               /* Set the value for SYSMIS if requested and if we don't
 220                  already have one. */
 221               if ((rcd->flags & RCD_MISC_MISSING) && !had_sysmis)
 222                 {
 223                   rcd->has_sysmis = 1;
 224                   if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 225                     rcd->sysmis.f = output.f;
 226                   else
 227                     rcd->sysmis.c = xstrdup (output.c);
 228                   had_sysmis = 1;
 229
 230                   rcd->flags &= ~RCD_MISC_MISSING;
 231                 }
 232
 233               /* Since there may be multiple input values for a single
 234                  output, the output value need to propagated among all
 235                  of them. */
 236               if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 237                 for (i = mark; i < rcd->nmap; i++)
 238                   rcd->map[i].t.f = output.f;
 239               else
 240                 {
 241                   for (i = mark; i < rcd->nmap; i++)
 242                     rcd->map[i].t.c = xstrdup (output.c);
 243                   free (output.c);
 244                 }
 245             }
 246           lex_get ();           /* Skip `)'. */
 247           if (!lex_match ('('))
 248             break;
 249         }
 250
 251       /* Append sentinel value. */
 252       rcd->map[rcd->nmap++].type = RCD_END;
 253
 254       /* Since multiple variables may use the same recodings, it is
 255          necessary to propogate the codings to all of them. */
 256       rcd->src = v[0];
 257       rcd->dest = v[0];
 258       rcd->dest_name[0] = 0;
 259       iter = rcd;
 260       for (i = 1; i < nv; i++)
 261         {
 262           iter = iter->next = xmalloc (sizeof *iter);
 263           iter->next = NULL;
 264           iter->flags = rcd->flags | RCD_MISC_DUPLICATE;
 265           iter->src = v[i];
 266           iter->dest = v[i];
 267           iter->dest_name[0] = 0;
 268           iter->has_sysmis = rcd->has_sysmis;
 269           iter->sysmis = rcd->sysmis;
 270           iter->map = rcd->map;
 271         }
 272
 273       if (lex_match_id ("INTO"))
 274         {
 275           char **names;
 276           int nnames;
 277
 278           int success = 0;
 279
 280           if (!parse_mixed_vars (&names, &nnames, PV_NONE))
 281             goto lossage;
 282
 283           if (nnames != nv)
 284             {
 285               for (i = 0; i < nnames; i++)
 286                 free (names[i]);
 287               free (names);
 288               msg (SE, _("%d variable(s) cannot be recoded into "
 289                          "%d variable(s).  Specify the same number "
 290                          "of variables as input and output variables."),
 291                    nv, nnames);
 292               goto lossage;
 293             }
 294
 295           if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_STRING)
 296             for (i = 0, iter = rcd; i < nv; i++, iter = iter->next)
 297               {
 298                 struct variable *v = dict_lookup_var (default_dict, names[i]);
 299
 300                 if (!v)
 301                   {
 302                     msg (SE, _("There is no string variable named "
 303                          "%s.  (All string variables specified "
 304                          "on INTO must already exist.  Use the "
 305                          "STRING command to create a string "
 306                          "variable.)"), names[i]);
 307                     goto INTO_fail;
 308                   }
 309                 if (v->type != ALPHA)
 310                   {
 311                     msg (SE, _("Type mismatch between input and output "
 312                          "variables.  Output variable %s is not "
 313                          "a string variable, but all the input "
 314                          "variables are string variables."), v->name);
 315                     goto INTO_fail;
 316                   }
 317                 if (v->width > (int) max_dst_width)
 318                   max_dst_width = v->width;
 319                 iter->dest = v;
 320               }
 321           else
 322             for (i = 0, iter = rcd; i < nv; i++, iter = iter->next)
 323               {
 324                 struct variable *v = dict_lookup_var (default_dict, names[i]);
 325
 326                 if (v)
 327                   {
 328                     if (v->type != NUMERIC)
 329                       {
 330                         msg (SE, _("Type mismatch after INTO: %s "
 331                                    "is not a numeric variable."), v->name);
 332                         goto INTO_fail;
 333                       }
 334                     else
 335                       iter->dest = v;
 336                   }
 337                 else
 338                   strcpy (iter->dest_name, names[i]);
 339               }
 340           success = 1;
 341
 342           /* Note that regardless of whether we succeed or fail,
 343              flow-of-control comes here.  `success' is the important
 344              factor.  Ah, if C had garbage collection...  */
 345         INTO_fail:
 346           for (i = 0; i < nnames; i++)
 347             free (names[i]);
 348           free (names);
 349           if (!success)
 350             goto lossage;
 351         }
 352       else
 353         {
 354           if (max_src_width > max_dst_width)
 355             max_dst_width = max_src_width;
 356
 357           if ((rcd->flags & RCD_SRC_MASK) == RCD_SRC_NUMERIC
 358               && (rcd->flags & RCD_DEST_MASK) != RCD_DEST_NUMERIC)
 359             {
 360               msg (SE, _("INTO must be used when the input values are "
 361                          "numeric and output values are string."));
 362               goto lossage;
 363             }
 364
 365           if ((rcd->flags & RCD_SRC_MASK) != RCD_SRC_NUMERIC
 366               && (rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 367             {
 368               msg (SE, _("INTO must be used when the input values are "
 369                          "string and output values are numeric."));
 370               goto lossage;
 371             }
 372         }
 373
 374       if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_STRING)
 375         {
 376           struct coding *cp;
 377
 378           for (cp = rcd->map; cp->type != RCD_END; cp++)
 379             if (cp->t.c)
 380               {
 381                 if (strlen (cp->t.c) < max_dst_width)
 382                   {
 383                     /* The NULL is only really necessary for the
 384                        debugging code. */
 385                     char *repl = xmalloc (max_dst_width + 1);
 386                     st_pad_copy (repl, cp->t.c, max_dst_width + 1);
 387                     free (cp->t.c);
 388                     cp->t.c = repl;
 389                   }
 390                 else
 391                   /* The strings are guaranteed to be in order of
 392                      nondecreasing length. */
 393                   break;
 394               }
 395
 396         }
 397
 398       if (!lex_match ('/'))
 399         break;
 400       while (rcd->next)
 401         rcd = rcd->next;
 402       rcd = rcd->next = xmalloc (sizeof *rcd);
 403
 404       free (v);
 405     }
 406
 407   if (token != '.')
 408     {
 409       lex_error (_("expecting end of command"));
 410       goto lossage;
 411     }
 412
 413   for (rcd = head; rcd; rcd = rcd->next)
 414     if (rcd->dest_name[0])
 415       {
 416         rcd->dest = dict_create_var (default_dict, rcd->dest_name, 0);
 417         if (!rcd->dest)
 418           {
 419             /* FIXME: This can occur if a destname is duplicated.
 420                We could give an error at parse time but I don't
 421                care enough. */
 422             rcd->dest = dict_lookup_var_assert (default_dict, rcd->dest_name);
 423           }
 424       }
 425
 426   trns = xmalloc (sizeof *trns);
 427   trns->h.proc = recode_trns_proc;
 428   trns->h.free = recode_trns_free;
 429   trns->codings = head;
 430   add_transformation ((struct trns_header *) trns);
 431
 432 #if DEBUGGING
 433   debug_print (head);
 434 #endif
 435
 436   return CMD_SUCCESS;
 437
 438  lossage:
 439   {
 440     struct recode_trns t;
 441
 442     t.codings = head;
 443     recode_trns_free ((struct trns_header *) &t);
 444     return CMD_FAILURE;
 445   }
 446 }
 447
 448 static int
 449 parse_dest_spec (struct rcd_var * rcd, union value * v, size_t *max_dst_width)
 450 {
 451   int flags;
 452
 453   v->c = NULL;
 454
 455   if (token == T_NUM)
 456     {
 457       v->f = tokval;
 458       lex_get ();
 459       flags = RCD_DEST_NUMERIC;
 460     }
 461   else if (lex_match_id ("SYSMIS"))
 462     {
 463       v->f = SYSMIS;
 464       flags = RCD_DEST_NUMERIC;
 465     }
 466   else if (token == T_STRING)
 467     {
 468       size_t max = *max_dst_width;
 469       size_t toklen = ds_length (&tokstr);
 470       if (toklen > max)
 471         max = toklen;
 472       v->c = xmalloc (max + 1);
 473       st_pad_copy (v->c, ds_value (&tokstr), max + 1);
 474       flags = RCD_DEST_STRING;
 475       *max_dst_width = max;
 476       lex_get ();
 477     }
 478   else if (lex_match_id ("COPY"))
 479     {
 480       if ((rcd->flags & RCD_SRC_MASK) == RCD_SRC_NUMERIC)
 481         {
 482           flags = RCD_DEST_NUMERIC;
 483           v->f = -SYSMIS;
 484         }
 485       else
 486         {
 487           flags = RCD_DEST_STRING;
 488           v->c = NULL;
 489         }
 490     }
 491   else
 492     {
 493       lex_error (_("expecting output value"));
 494       return 0;
 495     }
 496
 497   if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_ERROR)
 498     rcd->flags |= flags;
 499 #if 0
 500   else if (((rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC
 501             && flags != RCD_DEST_NUMERIC)
 502            || ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_STRING
 503                && flags != RCD_DEST_STRING))
 504 #endif
 505     else if ((rcd->flags & RCD_DEST_MASK) ^ flags)
 506       {
 507         msg (SE, _("Inconsistent output types.  The output values "
 508                    "must be all numeric or all string."));
 509         return 0;
 510       }
 511
 512   return 1;
 513 }
 514
 515 /* Reads a set of source specifications and returns one of the
 516    following values: 0 on failure; 1 for normal success; 2 for success
 517    but with CONVERT as the keyword; 3 for success but with ELSE as the
 518    keyword. */
 519 static int
 520 parse_src_spec (struct rcd_var * rcd, int type, size_t max_src_width)
 521 {
 522   struct coding *c;
 523
 524   for (;;)
 525     {
 526       if (rcd->nmap >= rcd->mmap - 1)
 527         {
 528           rcd->mmap += 16;
 529           rcd->map = xrealloc (rcd->map, rcd->mmap * sizeof *rcd->map);
 530         }
 531
 532       c = &rcd->map[rcd->nmap];
 533       c->f1.c = c->f2.c = NULL;
 534       if (lex_match_id ("ELSE"))
 535         {
 536           c->type = RCD_ELSE;
 537           rcd->nmap++;
 538           return 3;
 539         }
 540       else if (type == NUMERIC)
 541         {
 542           if (token == T_ID)
 543             {
 544               if (lex_match_id ("LO") || lex_match_id ("LOWEST"))
 545                 {
 546                   if (!lex_force_match_id ("THRU"))
 547                     return 0;
 548                   if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
 549                     c->type = RCD_ELSE;
 550                   else if (token == T_NUM)
 551                     {
 552                       c->type = RCD_LOW;
 553                       c->f1.f = tokval;
 554                       lex_get ();
 555                     }
 556                   else
 557                     {
 558                       lex_error (_("following LO THRU"));
 559                       return 0;
 560                     }
 561                 }
 562               else if (lex_match_id ("MISSING"))
 563                 {
 564                   c->type = RCD_USER;
 565                   rcd->flags |= RCD_MISC_MISSING;
 566                 }
 567               else if (lex_match_id ("SYSMIS"))
 568                 {
 569                   c->type = RCD_END;
 570                   rcd->flags |= RCD_MISC_MISSING;
 571                 }
 572               else
 573                 {
 574                   lex_error (_("in source value"));
 575                   return 0;
 576                 }
 577             }
 578           else if (token == T_NUM)
 579             {
 580               c->f1.f = tokval;
 581               lex_get ();
 582               if (lex_match_id ("THRU"))
 583                 {
 584                   if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
 585                     c->type = RCD_HIGH;
 586                   else if (token == T_NUM)
 587                     {
 588                       c->type = RCD_RANGE;
 589                       c->f2.f = tokval;
 590                       lex_get ();
 591                     }
 592                   else
 593                     {
 594                       lex_error (NULL);
 595                       return 0;
 596                     }
 597                 }
 598               else
 599                 c->type = RCD_SINGLE;
 600             }
 601           else
 602             {
 603               lex_error (_("in source value"));
 604               return 0;
 605             }
 606         }
 607       else
 608         {
 609           assert (type == ALPHA);
 610           if (lex_match_id ("CONVERT"))
 611             {
 612               if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_ERROR)
 613                 rcd->flags |= RCD_DEST_NUMERIC;
 614               else if ((rcd->flags & RCD_DEST_MASK) != RCD_DEST_NUMERIC)
 615                 {
 616                   msg (SE, _("Keyword CONVERT may only be used with "
 617                              "string input values and numeric output "
 618                              "values."));
 619                   return 0;
 620                 }
 621
 622               c->type = RCD_CONVERT;
 623               rcd->nmap++;
 624               return 2;
 625             }
 626           else
 627             {
 628               /* Only the debugging code needs the NULLs at the ends
 629                  of the strings.  However, changing code behavior more
 630                  than necessary based on the DEBUGGING `#define' is just
 631                  *inviting* bugs. */
 632               c->type = RCD_SINGLE;
 633               if (!lex_force_string ())
 634                 return 0;
 635               c->f1.c = xmalloc (max_src_width + 1);
 636               st_pad_copy (c->f1.c, ds_value (&tokstr), max_src_width + 1);
 637               lex_get ();
 638             }
 639         }
 640
 641       if (c->type != RCD_END)
 642         rcd->nmap++;
 643
 644       lex_match (',');
 645       if (token == '=')
 646         break;
 647     }
 648   return 1;
 649 }
 650 \f
 651 /* Data transformation. */
 652
 653 static void
 654 recode_trns_free (struct trns_header * t)
 655 {
 656   int i;
 657   struct rcd_var *head, *next;
 658
 659   head = ((struct recode_trns *) t)->codings;
 660   while (head)
 661     {
 662       if (head->map && !(head->flags & RCD_MISC_DUPLICATE))
 663         {
 664           if (head->flags & RCD_SRC_STRING)
 665             for (i = 0; i < head->nmap; i++)
 666               switch (head->map[i].type)
 667                 {
 668                 case RCD_RANGE:
 669                   free (head->map[i].f2.c);
 670                   /* fall through */
 671                 case RCD_USER:
 672                 case RCD_SINGLE:
 673                 case RCD_HIGH:
 674                 case RCD_LOW:
 675                   free (head->map[i].f1.c);
 676                   break;
 677                 case RCD_END:
 678                 case RCD_ELSE:
 679                 case RCD_CONVERT:
 680                   break;
 681                 default:
 682                   assert (0);
 683                 }
 684           if (head->flags & RCD_DEST_STRING)
 685             for (i = 0; i < head->nmap; i++)
 686               if (head->map[i].type != RCD_CONVERT && head->map[i].type != RCD_END)
 687                 free (head->map[i].t.c);
 688           free (head->map);
 689         }
 690       next = head->next;
 691       free (head);
 692       head = next;
 693     }
 694 }
 695
 696 static inline struct coding *
 697 find_src_numeric (struct rcd_var * v, struct ccase * c)
 698 {
 699   double cmp = c->data[v->src->fv].f;
 700   struct coding *cp;
 701
 702   if (cmp == SYSMIS)
 703     {
 704       if (v->sysmis.f != -SYSMIS)
 705         {
 706           if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 707             c->data[v->dest->fv].f = v->sysmis.f;
 708           else
 709             memcpy (c->data[v->dest->fv].s, v->sysmis.c,
 710                     v->dest->width);
 711         }
 712       return NULL;
 713     }
 714
 715   for (cp = v->map;; cp++)
 716     switch (cp->type)
 717       {
 718       case RCD_END:
 719         return NULL;
 720       case RCD_USER:
 721         if (is_num_user_missing (cmp, v->src))
 722           return cp;
 723         break;
 724       case RCD_SINGLE:
 725         if (cmp == cp->f1.f)
 726           return cp;
 727         break;
 728       case RCD_HIGH:
 729         if (cmp >= cp->f1.f)
 730           return cp;
 731         break;
 732       case RCD_LOW:
 733         if (cmp <= cp->f1.f)
 734           return cp;
 735         break;
 736       case RCD_RANGE:
 737         if (cmp >= cp->f1.f && cmp <= cp->f2.f)
 738           return cp;
 739         break;
 740       case RCD_ELSE:
 741         return cp;
 742       default:
 743         assert (0);
 744       }
 745 }
 746
 747 static inline struct coding *
 748 find_src_string (struct rcd_var * v, struct ccase * c)
 749 {
 750   char *cmp = c->data[v->src->fv].s;
 751   int w = v->src->width;
 752   struct coding *cp;
 753
 754   for (cp = v->map;; cp++)
 755     switch (cp->type)
 756       {
 757       case RCD_END:
 758         return NULL;
 759       case RCD_SINGLE:
 760         if (!memcmp (cp->f1.c, cmp, w))
 761           return cp;
 762         break;
 763       case RCD_ELSE:
 764         return cp;
 765       case RCD_CONVERT:
 766         {
 767           double f = convert_to_double (cmp, w);
 768           if (f != -SYSMIS)
 769             {
 770               c->data[v->dest->fv].f = f;
 771               return NULL;
 772             }
 773           break;
 774         }
 775       default:
 776         assert (0);
 777       }
 778 }
 779
 780 static int
 781 recode_trns_proc (struct trns_header * t, struct ccase * c,
 782                   int case_num UNUSED)
 783 {
 784   struct rcd_var *v;
 785
 786   for (v = ((struct recode_trns *) t)->codings; v; v = v->next)
 787     {
 788       struct coding *cp;
 789
 790       switch (v->flags & RCD_SRC_MASK)
 791         {
 792         case RCD_SRC_NUMERIC:
 793           cp = find_src_numeric (v, c);
 794           break;
 795         case RCD_SRC_STRING:
 796           cp = find_src_string (v, c);
 797           break;
 798         default:
 799           assert (0);
 800         }
 801       if (!cp)
 802         continue;
 803
 804       /* A matching input value was found. */
 805       if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 806         {
 807           double val = cp->t.f;
 808           if (val == -SYSMIS)
 809             c->data[v->dest->fv].f = c->data[v->src->fv].f;
 810           else
 811             c->data[v->dest->fv].f = val;
 812         }
 813       else
 814         {
 815           char *val = cp->t.c;
 816           if (val == NULL)
 817             st_bare_pad_len_copy (c->data[v->dest->fv].s,
 818                                   c->data[v->src->fv].c,
 819                                   v->dest->width, v->src->width);
 820           else
 821             memcpy (c->data[v->dest->fv].s, cp->t.c, v->dest->width);
 822         }
 823     }
 824
 825   return -1;
 826 }
 827 \f
 828 /* Debug output. */
 829
 830 #if DEBUGGING
 831 static void
 832 dump_dest (struct rcd_var * v, union value * c)
 833 {
 834   if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 835     if (c->f == SYSMIS)
 836       printf ("=SYSMIS");
 837     else if (c->f == -SYSMIS)
 838       printf ("=COPY");
 839     else
 840       printf ("=%g", c->f);
 841   else if (c->c)
 842     printf ("=\"%s\"", c->c);
 843   else
 844     printf ("=COPY");
 845 }
 846
 847 static void
 848 debug_print (struct rcd_var * head)
 849 {
 850   struct rcd_var *iter, *start;
 851   struct coding *c;
 852
 853   printf ("RECODE\n");
 854   for (iter = head; iter; iter = iter->next)
 855     {
 856       start = iter;
 857       printf ("  %s%s", iter == head ? "" : "/", iter->src->name);
 858       while (iter->next && (iter->next->flags & RCD_MISC_DUPLICATE))
 859         {
 860           iter = iter->next;
 861           printf (" %s", iter->src->name);
 862         }
 863       if (iter->has_sysmis)
 864         {
 865           printf ("(SYSMIS");
 866           dump_dest (iter, &iter->sysmis);
 867           printf (")");
 868         }
 869       for (c = iter->map; c->type != RCD_END; c++)
 870         {
 871           printf ("(");
 872           if ((iter->flags & RCD_SRC_MASK) == RCD_SRC_NUMERIC)
 873             switch (c->type)
 874               {
 875               case RCD_END:
 876                 printf (_("!!END!!"));
 877                 break;
 878               case RCD_USER:
 879                 printf ("MISSING");
 880                 break;
 881               case RCD_SINGLE:
 882                 printf ("%g", c->f1.f);
 883                 break;
 884               case RCD_HIGH:
 885                 printf ("%g THRU HIGH", c->f1.f);
 886                 break;
 887               case RCD_LOW:
 888                 printf ("LOW THRU %g", c->f1.f);
 889                 break;
 890               case RCD_RANGE:
 891                 printf ("%g THRU %g", c->f1.f, c->f2.f);
 892                 break;
 893               case RCD_ELSE:
 894                 printf ("ELSE");
 895                 break;
 896               default:
 897                 printf (_("!!ERROR!!"));
 898                 break;
 899               }
 900           else
 901             switch (c->type)
 902               {
 903               case RCD_SINGLE:
 904                 printf ("\"%s\"", c->f1.c);
 905                 break;
 906               case RCD_ELSE:
 907                 printf ("ELSE");
 908                 break;
 909               case RCD_CONVERT:
 910                 printf ("CONVERT");
 911                 break;
 912               default:
 913                 printf (_("!!ERROR!!"));
 914                 break;
 915               }
 916           if (c->type != RCD_CONVERT)
 917             dump_dest (iter, &c->t);
 918           printf (")");
 919         }
 920       printf ("\n    INTO");
 921       for (;;)
 922         {
 923           printf (" %s",
 924                 start->dest_name[0] ? start->dest_name : start->dest->name);
 925           if (start == iter)
 926             break;
 927           start = start->next;
 928         }
 929       printf ("\n");
 930     }
 931 }
 932 #endif
 933
 934 /* Convert NPTR to a `long int' in base 10.  Returns the long int on
 935    success, NOT_LONG on failure.  On success stores a pointer to the
 936    first character after the number into *ENDPTR.  From the GNU C
 937    library. */
 938 static long int
 939 string_to_long (char *nptr, int width, char **endptr)
 940 {
 941   int negative;
 942   register unsigned long int cutoff;
 943   register unsigned int cutlim;
 944   register unsigned long int i;
 945   register char *s;
 946   register unsigned char c;
 947   const char *save;
 948
 949   s = nptr;
 950
 951   /* Check for a sign.  */
 952   if (*s == '-')
 953     {
 954       negative = 1;
 955       ++s;
 956     }
 957   else if (*s == '+')
 958     {
 959       negative = 0;
 960       ++s;
 961     }
 962   else
 963     negative = 0;
 964   if (s >= nptr + width)
 965     return NOT_LONG;
 966
 967   /* Save the pointer so we can check later if anything happened.  */
 968   save = s;
 969
 970   cutoff = ULONG_MAX / 10ul;
 971   cutlim = ULONG_MAX % 10ul;
 972
 973   i = 0;
 974   for (c = *s;;)
 975     {
 976       if (isdigit ((unsigned char) c))
 977         c -= '0';
 978       else
 979         break;
 980       /* Check for overflow.  */
 981       if (i > cutoff || (i == cutoff && c > cutlim))
 982         return NOT_LONG;
 983       else
 984         i = i * 10ul + c;
 985
 986       s++;
 987       if (s >= nptr + width)
 988         break;
 989       c = *s;
 990     }
 991
 992   /* Check if anything actually happened.  */
 993   if (s == save)
 994     return NOT_LONG;
 995
 996   /* Check for a value that is within the range of `unsigned long
 997      int', but outside the range of `long int'.  We limit LONG_MIN and
 998      LONG_MAX by one point because we know that NOT_LONG is out there
 999      somewhere. */
1000   if (i > (negative
1001            ? -((unsigned long int) LONG_MIN) - 1
1002            : ((unsigned long int) LONG_MAX) - 1))
1003     return NOT_LONG;
1004
1005   *endptr = s;
1006
1007   /* Return the result of the appropriate sign.  */
1008   return (negative ? -i : i);
1009 }
1010
1011 /* Converts S to a double according to format Fx.0.  Returns the value
1012    found, or -SYSMIS if there was no valid number in s.  WIDTH is the
1013    length of string S.  From the GNU C library. */
1014 static double
1015 convert_to_double (char *s, int width)
1016 {
1017   register const char *end = &s[width];
1018
1019   short int sign;
1020
1021   /* The number so far.  */
1022   double num;
1023
1024   int got_dot;                  /* Found a decimal point.  */
1025   int got_digit;                /* Count of digits.  */
1026
1027   /* The exponent of the number.  */
1028   long int exponent;
1029
1030   /* Eat whitespace.  */
1031   while (s < end && isspace ((unsigned char) *s))
1032     ++s;
1033   if (s >= end)
1034     return SYSMIS;
1035
1036   /* Get the sign.  */
1037   sign = *s == '-' ? -1 : 1;
1038   if (*s == '-' || *s == '+')
1039     {
1040       ++s;
1041       if (s >= end)
1042         return -SYSMIS;
1043     }
1044
1045   num = 0.0;
1046   got_dot = 0;
1047   got_digit = 0;
1048   exponent = 0;
1049   for (; s < end; ++s)
1050     {
1051       if (isdigit ((unsigned char) *s))
1052         {
1053           got_digit++;
1054
1055           /* Make sure that multiplication by 10 will not overflow.  */
1056           if (num > DBL_MAX * 0.1)
1057             /* The value of the digit doesn't matter, since we have already
1058                gotten as many digits as can be represented in a `double'.
1059                This doesn't necessarily mean the result will overflow.
1060                The exponent may reduce it to within range.
1061
1062                We just need to record that there was another
1063                digit so that we can multiply by 10 later.  */
1064             ++exponent;
1065           else
1066             num = (num * 10.0) + (*s - '0');
1067
1068           /* Keep track of the number of digits after the decimal point.
1069              If we just divided by 10 here, we would lose precision.  */
1070           if (got_dot)
1071             --exponent;
1072         }
1073       else if (!got_dot && *s == '.')
1074         /* Record that we have found the decimal point.  */
1075         got_dot = 1;
1076       else
1077         break;
1078     }
1079
1080   if (!got_digit)
1081     return -SYSMIS;
1082
1083   if (s < end && (tolower ((unsigned char) (*s)) == 'e'
1084                   || tolower ((unsigned char) (*s)) == 'd'))
1085     {
1086       /* Get the exponent specified after the `e' or `E'.  */
1087       long int exp;
1088
1089       s++;
1090       if (s >= end)
1091         return -SYSMIS;
1092
1093       exp = string_to_long (s, end - s, &s);
1094       if (exp == NOT_LONG || end == s)
1095         return -SYSMIS;
1096       exponent += exp;
1097     }
1098
1099   while (s < end && isspace ((unsigned char) *s))
1100     s++;
1101   if (s < end)
1102     return -SYSMIS;
1103
1104   if (num == 0.0)
1105     return 0.0;
1106
1107   /* Multiply NUM by 10 to the EXPONENT power,
1108      checking for overflow and underflow.  */
1109
1110   if (exponent < 0)
1111     {
1112       if (-exponent + got_digit > -(DBL_MIN_10_EXP) + 5
1113           || num < DBL_MIN * pow (10.0, (double) -exponent))
1114         return -SYSMIS;
1115       num *= pow (10.0, (double) exponent);
1116     }
1117   else if (exponent > 0)
1118     {
1119       if (num > DBL_MAX * pow (10.0, (double) -exponent))
1120         return -SYSMIS;
1121       num *= pow (10.0, (double) exponent);
1122     }
1123
1124   return sign > 0 ? num : -num;
1125 }