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