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
 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                   int case_num UNUSED)
 777 {
 778   struct rcd_var *v;
 779   struct coding *cp;
 780
 781   for (v = ((struct recode_trns *) t)->codings; v; v = v->next)
 782     {
 783       switch (v->flags & RCD_SRC_MASK)
 784         {
 785         case RCD_SRC_NUMERIC:
 786           cp = find_src_numeric (v, c);
 787           break;
 788         case RCD_SRC_STRING:
 789           cp = find_src_string (v, c);
 790           break;
 791         }
 792       if (!cp)
 793         continue;
 794
 795       /* A matching input value was found. */
 796       if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 797         {
 798           double val = cp->t.f;
 799           if (val == -SYSMIS)
 800             c->data[v->dest->fv].f = c->data[v->src->fv].f;
 801           else
 802             c->data[v->dest->fv].f = val;
 803         }
 804       else
 805         {
 806           char *val = cp->t.c;
 807           if (val == NULL)
 808             st_bare_pad_len_copy (c->data[v->dest->fv].s,
 809                                   c->data[v->src->fv].c,
 810                                   v->dest->width, v->src->width);
 811           else
 812             memcpy (c->data[v->dest->fv].s, cp->t.c, v->dest->width);
 813         }
 814     }
 815
 816   return -1;
 817 }
 818 \f
 819 /* Debug output. */
 820
 821 #if DEBUGGING
 822 static void
 823 dump_dest (struct rcd_var * v, union value * c)
 824 {
 825   if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
 826     if (c->f == SYSMIS)
 827       printf ("=SYSMIS");
 828     else if (c->f == -SYSMIS)
 829       printf ("=COPY");
 830     else
 831       printf ("=%g", c->f);
 832   else if (c->c)
 833     printf ("=\"%s\"", c->c);
 834   else
 835     printf ("=COPY");
 836 }
 837
 838 static void
 839 debug_print (struct rcd_var * head)
 840 {
 841   struct rcd_var *iter, *start;
 842   struct coding *c;
 843
 844   printf ("RECODE\n");
 845   for (iter = head; iter; iter = iter->next)
 846     {
 847       start = iter;
 848       printf ("  %s%s", iter == head ? "" : "/", iter->src->name);
 849       while (iter->next && (iter->next->flags & RCD_MISC_DUPLICATE))
 850         {
 851           iter = iter->next;
 852           printf (" %s", iter->src->name);
 853         }
 854       if (iter->has_sysmis)
 855         {
 856           printf ("(SYSMIS");
 857           dump_dest (iter, &iter->sysmis);
 858           printf (")");
 859         }
 860       for (c = iter->map; c->type != RCD_END; c++)
 861         {
 862           printf ("(");
 863           if ((iter->flags & RCD_SRC_MASK) == RCD_SRC_NUMERIC)
 864             switch (c->type)
 865               {
 866               case RCD_END:
 867                 printf (_("!!END!!"));
 868                 break;
 869               case RCD_USER:
 870                 printf ("MISSING");
 871                 break;
 872               case RCD_SINGLE:
 873                 printf ("%g", c->f1.f);
 874                 break;
 875               case RCD_HIGH:
 876                 printf ("%g THRU HIGH", c->f1.f);
 877                 break;
 878               case RCD_LOW:
 879                 printf ("LOW THRU %g", c->f1.f);
 880                 break;
 881               case RCD_RANGE:
 882                 printf ("%g THRU %g", c->f1.f, c->f2.f);
 883                 break;
 884               case RCD_ELSE:
 885                 printf ("ELSE");
 886                 break;
 887               default:
 888                 printf (_("!!ERROR!!"));
 889                 break;
 890               }
 891           else
 892             switch (c->type)
 893               {
 894               case RCD_SINGLE:
 895                 printf ("\"%s\"", c->f1.c);
 896                 break;
 897               case RCD_ELSE:
 898                 printf ("ELSE");
 899                 break;
 900               case RCD_CONVERT:
 901                 printf ("CONVERT");
 902                 break;
 903               default:
 904                 printf (_("!!ERROR!!"));
 905                 break;
 906               }
 907           if (c->type != RCD_CONVERT)
 908             dump_dest (iter, &c->t);
 909           printf (")");
 910         }
 911       printf ("\n    INTO");
 912       for (;;)
 913         {
 914           printf (" %s",
 915                 start->dest_name[0] ? start->dest_name : start->dest->name);
 916           if (start == iter)
 917             break;
 918           start = start->next;
 919         }
 920       printf ("\n");
 921     }
 922 }
 923 #endif
 924
 925 /* Convert NPTR to a `long int' in base 10.  Returns the long int on
 926    success, NOT_LONG on failure.  On success stores a pointer to the
 927    first character after the number into *ENDPTR.  From the GNU C
 928    library. */
 929 static long int
 930 string_to_long (char *nptr, int width, char **endptr)
 931 {
 932   int negative;
 933   register unsigned long int cutoff;
 934   register unsigned int cutlim;
 935   register unsigned long int i;
 936   register char *s;
 937   register unsigned char c;
 938   const char *save;
 939
 940   s = nptr;
 941
 942   /* Check for a sign.  */
 943   if (*s == '-')
 944     {
 945       negative = 1;
 946       ++s;
 947     }
 948   else if (*s == '+')
 949     {
 950       negative = 0;
 951       ++s;
 952     }
 953   else
 954     negative = 0;
 955   if (s >= nptr + width)
 956     return NOT_LONG;
 957
 958   /* Save the pointer so we can check later if anything happened.  */
 959   save = s;
 960
 961   cutoff = ULONG_MAX / 10ul;
 962   cutlim = ULONG_MAX % 10ul;
 963
 964   i = 0;
 965   for (c = *s;;)
 966     {
 967       if (isdigit ((unsigned char) c))
 968         c -= '0';
 969       else
 970         break;
 971       /* Check for overflow.  */
 972       if (i > cutoff || (i == cutoff && c > cutlim))
 973         return NOT_LONG;
 974       else
 975         i = i * 10ul + c;
 976
 977       s++;
 978       if (s >= nptr + width)
 979         break;
 980       c = *s;
 981     }
 982
 983   /* Check if anything actually happened.  */
 984   if (s == save)
 985     return NOT_LONG;
 986
 987   /* Check for a value that is within the range of `unsigned long
 988      int', but outside the range of `long int'.  We limit LONG_MIN and
 989      LONG_MAX by one point because we know that NOT_LONG is out there
 990      somewhere. */
 991   if (i > (negative
 992            ? -((unsigned long int) LONG_MIN) - 1
 993            : ((unsigned long int) LONG_MAX) - 1))
 994     return NOT_LONG;
 995
 996   *endptr = s;
 997
 998   /* Return the result of the appropriate sign.  */
 999   return (negative ? -i : i);
1000 }
1001
1002 /* Converts S to a double according to format Fx.0.  Returns the value
1003    found, or -SYSMIS if there was no valid number in s.  WIDTH is the
1004    length of string S.  From the GNU C library. */
1005 static double
1006 convert_to_double (char *s, int width)
1007 {
1008   register const char *end = &s[width];
1009
1010   short int sign;
1011
1012   /* The number so far.  */
1013   double num;
1014
1015   int got_dot;                  /* Found a decimal point.  */
1016   int got_digit;                /* Count of digits.  */
1017
1018   /* The exponent of the number.  */
1019   long int exponent;
1020
1021   /* Eat whitespace.  */
1022   while (s < end && isspace ((unsigned char) *s))
1023     ++s;
1024   if (s >= end)
1025     return SYSMIS;
1026
1027   /* Get the sign.  */
1028   sign = *s == '-' ? -1 : 1;
1029   if (*s == '-' || *s == '+')
1030     {
1031       ++s;
1032       if (s >= end)
1033         return -SYSMIS;
1034     }
1035
1036   num = 0.0;
1037   got_dot = 0;
1038   got_digit = 0;
1039   exponent = 0;
1040   for (; s < end; ++s)
1041     {
1042       if (isdigit ((unsigned char) *s))
1043         {
1044           got_digit++;
1045
1046           /* Make sure that multiplication by 10 will not overflow.  */
1047           if (num > DBL_MAX * 0.1)
1048             /* The value of the digit doesn't matter, since we have already
1049                gotten as many digits as can be represented in a `double'.
1050                This doesn't necessarily mean the result will overflow.
1051                The exponent may reduce it to within range.
1052
1053                We just need to record that there was another
1054                digit so that we can multiply by 10 later.  */
1055             ++exponent;
1056           else
1057             num = (num * 10.0) + (*s - '0');
1058
1059           /* Keep track of the number of digits after the decimal point.
1060              If we just divided by 10 here, we would lose precision.  */
1061           if (got_dot)
1062             --exponent;
1063         }
1064       else if (!got_dot && *s == '.')
1065         /* Record that we have found the decimal point.  */
1066         got_dot = 1;
1067       else
1068         break;
1069     }
1070
1071   if (!got_digit)
1072     return -SYSMIS;
1073
1074   if (s < end && (tolower ((unsigned char) (*s)) == 'e'
1075                   || tolower ((unsigned char) (*s)) == 'd'))
1076     {
1077       /* Get the exponent specified after the `e' or `E'.  */
1078       long int exp;
1079
1080       s++;
1081       if (s >= end)
1082         return -SYSMIS;
1083
1084       exp = string_to_long (s, end - s, &s);
1085       if (exp == NOT_LONG || end == s)
1086         return -SYSMIS;
1087       exponent += exp;
1088     }
1089
1090   while (s < end && isspace ((unsigned char) *s))
1091     s++;
1092   if (s < end)
1093     return -SYSMIS;
1094
1095   if (num == 0.0)
1096     return 0.0;
1097
1098   /* Multiply NUM by 10 to the EXPONENT power,
1099      checking for overflow and underflow.  */
1100
1101   if (exponent < 0)
1102     {
1103       if (-exponent + got_digit > -(DBL_MIN_10_EXP) + 5
1104           || num < DBL_MIN * pow (10.0, (double) -exponent))
1105         return -SYSMIS;
1106       num *= pow (10.0, (double) exponent);
1107     }
1108   else if (exponent > 0)
1109     {
1110       if (num > DBL_MAX * pow (10.0, (double) -exponent))
1111         return -SYSMIS;
1112       num *= pow (10.0, (double) exponent);
1113     }
1114
1115   return sign > 0 ? num : -num;
1116 }