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