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 int recode_trns_proc (struct trns_header *, struct ccase *);
 108 static void recode_trns_free (struct trns_header *);
 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
 491   if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_ERROR)
 492     rcd->flags |= flags;
 493 #if 0
 494   else if (((rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC
 495             && flags != RCD_DEST_NUMERIC)
 496            || ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_STRING
 497                && flags != RCD_DEST_STRING))
 498 #endif
 499     else if ((rcd->flags & RCD_DEST_MASK) ^ flags)
 500       {
 501         msg (SE, _("Inconsistent output types.  The output values "
 502                    "must be all numeric or all string."));
 503         return 0;
 504       }
 505
 506   return 1;
 507 }
 508
 509 /* Reads a set of source specifications and returns one of the
 510    following values: 0 on failure; 1 for normal success; 2 for success
 511    but with CONVERT as the keyword; 3 for success but with ELSE as the
 512    keyword. */
 513 static int
 514 parse_src_spec (struct rcd_var * rcd, int type, size_t max_src_width)
 515 {
 516   struct coding *c;
 517
 518   for (;;)
 519     {
 520       if (rcd->nmap >= rcd->mmap - 1)
 521         {
 522           rcd->mmap += 16;
 523           rcd->map = xrealloc (rcd->map, rcd->mmap * sizeof *rcd->map);
 524         }
 525
 526       c = &rcd->map[rcd->nmap];
 527       c->f1.c = c->f2.c = NULL;
 528       if (lex_match_id ("ELSE"))
 529         {
 530           c->type = RCD_ELSE;
 531           rcd->nmap++;
 532           return 3;
 533         }
 534       else if (type == NUMERIC)
 535         {
 536           if (token == T_ID)
 537             {
 538               if (lex_match_id ("LO") || lex_match_id ("LOWEST"))
 539                 {
 540                   if (!lex_force_match_id ("THRU"))
 541                     return 0;
 542                   if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
 543                     c->type = RCD_ELSE;
 544                   else if (token == T_NUM)
 545                     {
 546                       c->type = RCD_LOW;
 547                       c->f1.f = tokval;
 548                       lex_get ();
 549                     }
 550                   else
 551                     {
 552                       lex_error (_("following LO THRU"));
 553                       return 0;
 554                     }
 555                 }
 556               else if (lex_match_id ("MISSING"))
 557                 {
 558                   c->type = RCD_USER;
 559                   rcd->flags |= RCD_MISC_MISSING;
 560                 }
 561               else if (lex_match_id ("SYSMIS"))
 562                 {
 563                   c->type = RCD_END;
 564                   rcd->flags |= RCD_MISC_MISSING;
 565                 }
 566               else
 567                 {
 568                   lex_error (_("in source value"));
 569                   return 0;
 570                 }
 571             }
 572           else if (token == T_NUM)
 573             {
 574               c->f1.f = tokval;
 575               lex_get ();
 576               if (lex_match_id ("THRU"))
 577                 {
 578                   if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
 579                     c->type = RCD_HIGH;
 580                   else if (token == T_NUM)
 581                     {
 582                       c->type = RCD_RANGE;
 583                       c->f2.f = tokval;
 584                       lex_get ();
 585                     }
 586                   else
 587                     {
 588                       lex_error (NULL);
 589                       return 0;
 590                     }
 591                 }
 592               else
 593                 c->type = RCD_SINGLE;
 594             }
 595           else
 596             {
 597               lex_error (_("in source value"));
 598               return 0;
 599             }
 600         }
 601       else
 602         {
 603           assert (type == ALPHA);
 604           if (lex_match_id ("CONVERT"))
 605             {
 606               if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_ERROR)
 607                 rcd->flags |= RCD_DEST_NUMERIC;
 608               else if ((rcd->flags & RCD_DEST_MASK) != RCD_DEST_NUMERIC)
 609                 {
 610                   msg (SE, _("Keyword CONVERT may only be used with "
 611                              "string input values and numeric output "
 612                              "values."));
 613                   return 0;
 614                 }
 615
 616               c->type = RCD_CONVERT;
 617               rcd->nmap++;
 618               return 2;
 619             }
 620           else
 621             {
 622               /* Only the debugging code needs the NULLs at the ends
 623                  of the strings.  However, changing code behavior more
 624                  than necessary based on the DEBUGGING `#define' is just
 625                  *inviting* bugs. */
 626               c->type = RCD_SINGLE;
 627               if (!lex_force_string ())
 628                 return 0;
 629               c->f1.c = xmalloc (max_src_width + 1);
 630               st_pad_copy (c->f1.c, ds_value (&tokstr), max_src_width + 1);
 631               lex_get ();
 632             }
 633         }
 634
 635       if (c->type != RCD_END)
 636         rcd->nmap++;
 637
 638       lex_match (',');
 639       if (token == '=')
 640         break;
 641     }
 642   return 1;
 643 }
 644 \f
 645 /* Data transformation. */
 646
 647 static void
 648 recode_trns_free (struct trns_header * t)
 649 {
 650   int i;
 651   struct rcd_var *head, *next;
 652
 653   head = ((struct recode_trns *) t)->codings;
 654   while (head)
 655     {
 656       if (head->map && !(head->flags & RCD_MISC_DUPLICATE))
 657         {
 658           if (head->flags & RCD_SRC_STRING)
 659             for (i = 0; i < head->nmap; i++)
 660               switch (head->map[i].type)
 661                 {
 662                 case RCD_RANGE:
 663                   free (head->map[i].f2.c);
 664                   /* fall through */
 665                 case RCD_USER:
 666                 case RCD_SINGLE:
 667                 case RCD_HIGH:
 668                 case RCD_LOW:
 669                   free (head->map[i].f1.c);
 670                   break;
 671                 case RCD_END:
 672                 case RCD_ELSE:
 673                 case RCD_CONVERT:
 674                   break;
 675                 default:
 676                   assert (0);
 677                 }
 678           if (head->flags & RCD_DEST_STRING)
 679             for (i = 0; i < head->nmap; i++)
 680               if (head->map[i].type != RCD_CONVERT && head->map[i].type != RCD_END)
 681                 free (head->map[i].t.c);
 682           free (head->map);
 683         }
 684       next = head->next;
 685       free (head);
 686       head = next;
 687     }
 688 }
 689
 690 static inline struct coding *
 691 find_src_numeric (struct rcd_var * v, struct ccase * c)
 692 {
 693   double cmp = c->data[v->src->fv].f;
 694   struct coding *cp;
 695
 696   if (cmp == SYSMIS)
 697     {
 698       if (v->sysmis.f != -SYSMIS)
 699         {
 700           if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 701             c->data[v->dest->fv].f = v->sysmis.f;
 702           else
 703             memcpy (c->data[v->dest->fv].s, v->sysmis.c,
 704                     v->dest->width);
 705         }
 706       return NULL;
 707     }
 708
 709   for (cp = v->map;; cp++)
 710     switch (cp->type)
 711       {
 712       case RCD_END:
 713         return NULL;
 714       case RCD_USER:
 715         if (is_num_user_missing (cmp, v->src))
 716           return cp;
 717         break;
 718       case RCD_SINGLE:
 719         if (cmp == cp->f1.f)
 720           return cp;
 721         break;
 722       case RCD_HIGH:
 723         if (cmp >= cp->f1.f)
 724           return cp;
 725         break;
 726       case RCD_LOW:
 727         if (cmp <= cp->f1.f)
 728           return cp;
 729         break;
 730       case RCD_RANGE:
 731         if (cmp >= cp->f1.f && cmp <= cp->f2.f)
 732           return cp;
 733         break;
 734       case RCD_ELSE:
 735         return cp;
 736       default:
 737         assert (0);
 738       }
 739 }
 740
 741 static inline struct coding *
 742 find_src_string (struct rcd_var * v, struct ccase * c)
 743 {
 744   char *cmp = c->data[v->src->fv].s;
 745   int w = v->src->width;
 746   struct coding *cp;
 747
 748   for (cp = v->map;; cp++)
 749     switch (cp->type)
 750       {
 751       case RCD_END:
 752         return NULL;
 753       case RCD_SINGLE:
 754         if (!memcmp (cp->f1.c, cmp, w))
 755           return cp;
 756         break;
 757       case RCD_ELSE:
 758         return cp;
 759       case RCD_CONVERT:
 760         {
 761           double f = convert_to_double (cmp, w);
 762           if (f != -SYSMIS)
 763             {
 764               c->data[v->dest->fv].f = f;
 765               return NULL;
 766             }
 767           break;
 768         }
 769       default:
 770         assert (0);
 771       }
 772 }
 773
 774 static int
 775 recode_trns_proc (struct trns_header * t, struct ccase * c)
 776 {
 777   struct rcd_var *v;
 778   struct coding *cp;
 779
 780   for (v = ((struct recode_trns *) t)->codings; v; v = v->next)
 781     {
 782       switch (v->flags & RCD_SRC_MASK)
 783         {
 784         case RCD_SRC_NUMERIC:
 785           cp = find_src_numeric (v, c);
 786           break;
 787         case RCD_SRC_STRING:
 788           cp = find_src_string (v, c);
 789           break;
 790         }
 791       if (!cp)
 792         continue;
 793
 794       /* A matching input value was found. */
 795       if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 796         {
 797           double val = cp->t.f;
 798           if (val == -SYSMIS)
 799             c->data[v->dest->fv].f = c->data[v->src->fv].f;
 800           else
 801             c->data[v->dest->fv].f = val;
 802         }
 803       else
 804         {
 805           char *val = cp->t.c;
 806           if (val == NULL)
 807             st_bare_pad_len_copy (c->data[v->dest->fv].s,
 808                                   c->data[v->src->fv].c,
 809                                   v->dest->width, v->src->width);
 810           else
 811             memcpy (c->data[v->dest->fv].s, cp->t.c, v->dest->width);
 812         }
 813     }
 814
 815   return -1;
 816 }
 817 \f
 818 /* Debug output. */
 819
 820 #if DEBUGGING
 821 static void
 822 dump_dest (struct rcd_var * v, union value * c)
 823 {
 824   if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 825     if (c->f == SYSMIS)
 826       printf ("=SYSMIS");
 827     else if (c->f == -SYSMIS)
 828       printf ("=COPY");
 829     else
 830       printf ("=%g", c->f);
 831   else if (c->c)
 832     printf ("=\"%s\"", c->c);
 833   else
 834     printf ("=COPY");
 835 }
 836
 837 static void
 838 debug_print (struct rcd_var * head)
 839 {
 840   struct rcd_var *iter, *start;
 841   struct coding *c;
 842
 843   printf ("RECODE\n");
 844   for (iter = head; iter; iter = iter->next)
 845     {
 846       start = iter;
 847       printf ("  %s%s", iter == head ? "" : "/", iter->src->name);
 848       while (iter->next && (iter->next->flags & RCD_MISC_DUPLICATE))
 849         {
 850           iter = iter->next;
 851           printf (" %s", iter->src->name);
 852         }
 853       if (iter->has_sysmis)
 854         {
 855           printf ("(SYSMIS");
 856           dump_dest (iter, &iter->sysmis);
 857           printf (")");
 858         }
 859       for (c = iter->map; c->type != RCD_END; c++)
 860         {
 861           printf ("(");
 862           if ((iter->flags & RCD_SRC_MASK) == RCD_SRC_NUMERIC)
 863             switch (c->type)
 864               {
 865               case RCD_END:
 866                 printf (_("!!END!!"));
 867                 break;
 868               case RCD_USER:
 869                 printf ("MISSING");
 870                 break;
 871               case RCD_SINGLE:
 872                 printf ("%g", c->f1.f);
 873                 break;
 874               case RCD_HIGH:
 875                 printf ("%g THRU HIGH", c->f1.f);
 876                 break;
 877               case RCD_LOW:
 878                 printf ("LOW THRU %g", c->f1.f);
 879                 break;
 880               case RCD_RANGE:
 881                 printf ("%g THRU %g", c->f1.f, c->f2.f);
 882                 break;
 883               case RCD_ELSE:
 884                 printf ("ELSE");
 885                 break;
 886               default:
 887                 printf (_("!!ERROR!!"));
 888                 break;
 889               }
 890           else
 891             switch (c->type)
 892               {
 893               case RCD_SINGLE:
 894                 printf ("\"%s\"", c->f1.c);
 895                 break;
 896               case RCD_ELSE:
 897                 printf ("ELSE");
 898                 break;
 899               case RCD_CONVERT:
 900                 printf ("CONVERT");
 901                 break;
 902               default:
 903                 printf (_("!!ERROR!!"));
 904                 break;
 905               }
 906           if (c->type != RCD_CONVERT)
 907             dump_dest (iter, &c->t);
 908           printf (")");
 909         }
 910       printf ("\n    INTO");
 911       for (;;)
 912         {
 913           printf (" %s",
 914                 start->dest_name[0] ? start->dest_name : start->dest->name);
 915           if (start == iter)
 916             break;
 917           start = start->next;
 918         }
 919       printf ("\n");
 920     }
 921 }
 922 #endif
 923
 924 /* Convert NPTR to a `long int' in base 10.  Returns the long int on
 925    success, NOT_LONG on failure.  On success stores a pointer to the
 926    first character after the number into *ENDPTR.  From the GNU C
 927    library. */
 928 static long int
 929 string_to_long (char *nptr, int width, char **endptr)
 930 {
 931   int negative;
 932   register unsigned long int cutoff;
 933   register unsigned int cutlim;
 934   register unsigned long int i;
 935   register char *s;
 936   register unsigned char c;
 937   const char *save;
 938
 939   s = nptr;
 940
 941   /* Check for a sign.  */
 942   if (*s == '-')
 943     {
 944       negative = 1;
 945       ++s;
 946     }
 947   else if (*s == '+')
 948     {
 949       negative = 0;
 950       ++s;
 951     }
 952   else
 953     negative = 0;
 954   if (s >= nptr + width)
 955     return NOT_LONG;
 956
 957   /* Save the pointer so we can check later if anything happened.  */
 958   save = s;
 959
 960   cutoff = ULONG_MAX / 10ul;
 961   cutlim = ULONG_MAX % 10ul;
 962
 963   i = 0;
 964   for (c = *s;;)
 965     {
 966       if (isdigit ((unsigned char) c))
 967         c -= '0';
 968       else
 969         break;
 970       /* Check for overflow.  */
 971       if (i > cutoff || (i == cutoff && c > cutlim))
 972         return NOT_LONG;
 973       else
 974         i = i * 10ul + c;
 975
 976       s++;
 977       if (s >= nptr + width)
 978         break;
 979       c = *s;
 980     }
 981
 982   /* Check if anything actually happened.  */
 983   if (s == save)
 984     return NOT_LONG;
 985
 986   /* Check for a value that is within the range of `unsigned long
 987      int', but outside the range of `long int'.  We limit LONG_MIN and
 988      LONG_MAX by one point because we know that NOT_LONG is out there
 989      somewhere. */
 990   if (i > (negative
 991            ? -((unsigned long int) LONG_MIN) - 1
 992            : ((unsigned long int) LONG_MAX) - 1))
 993     return NOT_LONG;
 994
 995   *endptr = s;
 996
 997   /* Return the result of the appropriate sign.  */
 998   return (negative ? -i : i);
 999 }
1000
1001 /* Converts S to a double according to format Fx.0.  Returns the value
1002    found, or -SYSMIS if there was no valid number in s.  WIDTH is the
1003    length of string S.  From the GNU C library. */
1004 static double
1005 convert_to_double (char *s, int width)
1006 {
1007   register const char *end = &s[width];
1008
1009   short int sign;
1010
1011   /* The number so far.  */
1012   double num;
1013
1014   int got_dot;                  /* Found a decimal point.  */
1015   int got_digit;                /* Count of digits.  */
1016
1017   /* The exponent of the number.  */
1018   long int exponent;
1019
1020   /* Eat whitespace.  */
1021   while (s < end && isspace ((unsigned char) *s))
1022     ++s;
1023   if (s >= end)
1024     return SYSMIS;
1025
1026   /* Get the sign.  */
1027   sign = *s == '-' ? -1 : 1;
1028   if (*s == '-' || *s == '+')
1029     {
1030       ++s;
1031       if (s >= end)
1032         return -SYSMIS;
1033     }
1034
1035   num = 0.0;
1036   got_dot = 0;
1037   got_digit = 0;
1038   exponent = 0;
1039   for (; s < end; ++s)
1040     {
1041       if (isdigit ((unsigned char) *s))
1042         {
1043           got_digit++;
1044
1045           /* Make sure that multiplication by 10 will not overflow.  */
1046           if (num > DBL_MAX * 0.1)
1047             /* The value of the digit doesn't matter, since we have already
1048                gotten as many digits as can be represented in a `double'.
1049                This doesn't necessarily mean the result will overflow.
1050                The exponent may reduce it to within range.
1051
1052                We just need to record that there was another
1053                digit so that we can multiply by 10 later.  */
1054             ++exponent;
1055           else
1056             num = (num * 10.0) + (*s - '0');
1057
1058           /* Keep track of the number of digits after the decimal point.
1059              If we just divided by 10 here, we would lose precision.  */
1060           if (got_dot)
1061             --exponent;
1062         }
1063       else if (!got_dot && *s == '.')
1064         /* Record that we have found the decimal point.  */
1065         got_dot = 1;
1066       else
1067         break;
1068     }
1069
1070   if (!got_digit)
1071     return -SYSMIS;
1072
1073   if (s < end && (tolower ((unsigned char) (*s)) == 'e'
1074                   || tolower ((unsigned char) (*s)) == 'd'))
1075     {
1076       /* Get the exponent specified after the `e' or `E'.  */
1077       long int exp;
1078
1079       s++;
1080       if (s >= end)
1081         return -SYSMIS;
1082
1083       exp = string_to_long (s, end - s, &s);
1084       if (exp == NOT_LONG || end == s)
1085         return -SYSMIS;
1086       exponent += exp;
1087     }
1088
1089   while (s < end && isspace ((unsigned char) *s))
1090     s++;
1091   if (s < end)
1092     return -SYSMIS;
1093
1094   if (num == 0.0)
1095     return 0.0;
1096
1097   /* Multiply NUM by 10 to the EXPONENT power,
1098      checking for overflow and underflow.  */
1099
1100   if (exponent < 0)
1101     {
1102       if (-exponent + got_digit > -(DBL_MIN_10_EXP) + 5
1103           || num < DBL_MIN * pow (10.0, (double) -exponent))
1104         return -SYSMIS;
1105       num *= pow (10.0, (double) exponent);
1106     }
1107   else if (exponent > 0)
1108     {
1109       if (num > DBL_MAX * pow (10.0, (double) -exponent))
1110         return -SYSMIS;
1111       num *= pow (10.0, (double) exponent);
1112     }
1113
1114   return sign > 0 ? num : -num;
1115 }