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