src/recode.c

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