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