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