src/recode.c

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