libgfortran/runtime/environ.c

   1 /* Copyright (C) 2002,2003,2005 Free Software Foundation, Inc.
   2    Contributed by Andy Vaught
   3
   4 This file is part of the GNU Fortran 95 runtime library (libgfortran).
   5
   6 Libgfortran is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 In addition to the permissions in the GNU General Public License, the
  12 Free Software Foundation gives you unlimited permission to link the
  13 compiled version of this file into combinations with other programs,
  14 and to distribute those combinations without any restriction coming
  15 from the use of this file.  (The General Public License restrictions
  16 do apply in other respects; for example, they cover modification of
  17 the file, and distribution when not linked into a combine
  18 executable.)
  19
  20 Libgfortran is distributed in the hope that it will be useful,
  21 but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 GNU General Public License for more details.
  24
  25 You should have received a copy of the GNU General Public License
  26 along with libgfortran; see the file COPYING.  If not, write to
  27 the Free Software Foundation, 51 Franklin Street, Fifth Floor,
  28 Boston, MA 02110-1301, USA.  */
  29
  30 #include "config.h"
  31 #include <stdio.h>
  32 #include <string.h>
  33 #include <stdlib.h>
  34 #include <ctype.h>
  35
  36 #include "libgfortran.h"
  37
  38 /* Environment scanner.  Examine the environment for controlling minor
  39  * aspects of the program's execution.  Our philosophy here that the
  40  * environment should not prevent the program from running, so an
  41  * environment variable with a messed-up value will be interpreted in
  42  * the default way.
  43  *
  44  * Most of the environment is checked early in the startup sequence,
  45  * but other variables are checked during execution of the user's
  46  * program. */
  47
  48 options_t options;
  49
  50
  51 typedef struct variable
  52 {
  53   const char *name;
  54   int value, *var;
  55   void (*init) (struct variable *);
  56   void (*show) (struct variable *);
  57   const char *desc;
  58   int bad;
  59 }
  60 variable;
  61
  62 static void init_unformatted (variable *);
  63
  64 /* print_spaces()-- Print a particular number of spaces.  */
  65
  66 static void
  67 print_spaces (int n)
  68 {
  69   char buffer[80];
  70   int i;
  71
  72   if (n <= 0)
  73     return;
  74
  75   for (i = 0; i < n; i++)
  76     buffer[i] = ' ';
  77
  78   buffer[i] = '\0';
  79
  80   st_printf (buffer);
  81 }
  82
  83
  84 /* var_source()-- Return a string that describes where the value of a
  85  * variable comes from */
  86
  87 static const char *
  88 var_source (variable * v)
  89 {
  90   if (getenv (v->name) == NULL)
  91     return "Default";
  92
  93   if (v->bad)
  94     return "Bad    ";
  95
  96   return "Set    ";
  97 }
  98
  99
 100 /* init_integer()-- Initialize an integer environment variable.  */
 101
 102 static void
 103 init_integer (variable * v)
 104 {
 105   char *p, *q;
 106
 107   p = getenv (v->name);
 108   if (p == NULL)
 109     goto set_default;
 110
 111   for (q = p; *q; q++)
 112     if (!isdigit (*q) && (p != q || *q != '-'))
 113       {
 114         v->bad = 1;
 115         goto set_default;
 116       }
 117
 118   *v->var = atoi (p);
 119   return;
 120
 121  set_default:
 122   *v->var = v->value;
 123   return;
 124 }
 125
 126
 127 /* init_unsigned_integer()-- Initialize an integer environment variable
 128    which has to be positive.  */
 129
 130 static void
 131 init_unsigned_integer (variable * v)
 132 {
 133   char *p, *q;
 134
 135   p = getenv (v->name);
 136   if (p == NULL)
 137     goto set_default;
 138
 139   for (q = p; *q; q++)
 140     if (!isdigit (*q))
 141       {
 142         v->bad = 1;
 143         goto set_default;
 144       }
 145
 146   *v->var = atoi (p);
 147   return;
 148
 149  set_default:
 150   *v->var = v->value;
 151   return;
 152 }
 153
 154
 155 /* show_integer()-- Show an integer environment variable */
 156
 157 static void
 158 show_integer (variable * v)
 159 {
 160   st_printf ("%s  %d\n", var_source (v), *v->var);
 161 }
 162
 163
 164 /* init_boolean()-- Initialize a boolean environment variable.  We
 165  * only look at the first letter of the variable. */
 166
 167 static void
 168 init_boolean (variable * v)
 169 {
 170   char *p;
 171
 172   p = getenv (v->name);
 173   if (p == NULL)
 174     goto set_default;
 175
 176   if (*p == '1' || *p == 'Y' || *p == 'y')
 177     {
 178       *v->var = 1;
 179       return;
 180     }
 181
 182   if (*p == '0' || *p == 'N' || *p == 'n')
 183     {
 184       *v->var = 0;
 185       return;
 186     }
 187
 188   v->bad = 1;
 189
 190 set_default:
 191   *v->var = v->value;
 192   return;
 193 }
 194
 195
 196 /* show_boolean()-- Show a boolean environment variable */
 197
 198 static void
 199 show_boolean (variable * v)
 200 {
 201   st_printf ("%s  %s\n", var_source (v), *v->var ? "Yes" : "No");
 202 }
 203
 204
 205 /* init_mem()-- Initialize environment variables that have to do with
 206  * how memory from an ALLOCATE statement is filled.  A single flag
 207  * enables filling and a second variable gives the value that is used
 208  * to initialize the memory. */
 209
 210 static void
 211 init_mem (variable * v)
 212 {
 213   int offset, n;
 214   char *p;
 215
 216   p = getenv (v->name);
 217
 218   options.allocate_init_flag = 0;       /* The default */
 219
 220   if (p == NULL)
 221     return;
 222
 223   if (strcasecmp (p, "NONE") == 0)
 224     return;
 225
 226   /* IEEE-754 Quiet Not-a-Number that will work for single and double
 227    * precision.  Look for the 'f95' mantissa in debug dumps. */
 228
 229   if (strcasecmp (p, "NaN") == 0)
 230     {
 231       options.allocate_init_flag = 1;
 232       options.allocate_init_value = 0xfff80f95;
 233       return;
 234     }
 235
 236   /* Interpret the string as a hexadecimal constant */
 237
 238   n = 0;
 239   while (*p)
 240     {
 241       if (!isxdigit (*p))
 242         {
 243           v->bad = 1;
 244           return;
 245         }
 246
 247       offset = '0';
 248       if (islower (*p))
 249         offset = 'a';
 250       if (isupper (*p))
 251         offset = 'A';
 252
 253       n = (n << 4) | (*p++ - offset);
 254     }
 255
 256   options.allocate_init_flag = 1;
 257   options.allocate_init_value = n;
 258 }
 259
 260
 261 static void
 262 show_mem (variable * v)
 263 {
 264   char *p;
 265
 266   p = getenv (v->name);
 267
 268   st_printf ("%s  ", var_source (v));
 269
 270   if (options.allocate_init_flag)
 271     st_printf ("0x%x", options.allocate_init_value);
 272
 273   st_printf ("\n");
 274 }
 275
 276
 277 static void
 278 init_sep (variable * v)
 279 {
 280   int seen_comma;
 281   char *p;
 282
 283   p = getenv (v->name);
 284   if (p == NULL)
 285     goto set_default;
 286
 287   v->bad = 1;
 288   options.separator = p;
 289   options.separator_len = strlen (p);
 290
 291   /* Make sure the separator is valid */
 292
 293   if (options.separator_len == 0)
 294     goto set_default;
 295   seen_comma = 0;
 296
 297   while (*p)
 298     {
 299       if (*p == ',')
 300         {
 301           if (seen_comma)
 302             goto set_default;
 303           seen_comma = 1;
 304           p++;
 305           continue;
 306         }
 307
 308       if (*p++ != ' ')
 309         goto set_default;
 310     }
 311
 312   v->bad = 0;
 313   return;
 314
 315 set_default:
 316   options.separator = " ";
 317   options.separator_len = 1;
 318 }
 319
 320
 321 static void
 322 show_sep (variable * v)
 323 {
 324   st_printf ("%s  \"%s\"\n", var_source (v), options.separator);
 325 }
 326
 327
 328 static void
 329 init_string (variable * v __attribute__ ((unused)))
 330 {
 331 }
 332
 333 static void
 334 show_string (variable * v)
 335 {
 336   const char *p;
 337
 338   p = getenv (v->name);
 339   if (p == NULL)
 340     p = "";
 341
 342   st_printf ("%s  \"%s\"\n", var_source (v), p);
 343 }
 344
 345
 346 /* Structure for associating names and values.  */
 347
 348 typedef struct
 349 {
 350   const char *name;
 351   int value;
 352 }
 353 choice;
 354
 355
 356 enum
 357 { FP_ROUND_NEAREST, FP_ROUND_UP, FP_ROUND_DOWN, FP_ROUND_ZERO };
 358
 359 static const choice rounding[] = {
 360   {"NEAREST", FP_ROUND_NEAREST},
 361   {"UP", FP_ROUND_UP},
 362   {"DOWN", FP_ROUND_DOWN},
 363   {"ZERO", FP_ROUND_ZERO},
 364   {NULL, 0}
 365 };
 366
 367 static const choice precision[] =
 368 {
 369   { "24", 1},
 370   { "53", 2},
 371   { "64", 0},
 372   { NULL, 0}
 373 };
 374
 375 static const choice signal_choices[] =
 376 {
 377   { "IGNORE", 1},
 378   { "ABORT", 0},
 379   { NULL, 0}
 380 };
 381
 382
 383 static void
 384 init_choice (variable * v, const choice * c)
 385 {
 386   char *p;
 387
 388   p = getenv (v->name);
 389   if (p == NULL)
 390     goto set_default;
 391
 392   for (; c->name; c++)
 393     if (strcasecmp (c->name, p) == 0)
 394       break;
 395
 396   if (c->name == NULL)
 397     {
 398       v->bad = 1;
 399       goto set_default;
 400     }
 401
 402   *v->var = c->value;
 403   return;
 404
 405  set_default:
 406   *v->var = v->value;
 407 }
 408
 409
 410 static void
 411 show_choice (variable * v, const choice * c)
 412 {
 413   st_printf ("%s  ", var_source (v));
 414
 415   for (; c->name; c++)
 416     if (c->value == *v->var)
 417       break;
 418
 419   if (c->name)
 420     st_printf ("%s\n", c->name);
 421   else
 422     st_printf ("(Unknown)\n");
 423 }
 424
 425
 426 static void
 427 init_round (variable * v)
 428 {
 429   init_choice (v, rounding);
 430 }
 431
 432 static void
 433 show_round (variable * v)
 434 {
 435   show_choice (v, rounding);
 436 }
 437
 438 static void
 439 init_precision (variable * v)
 440 {
 441   init_choice (v, precision);
 442 }
 443
 444 static void
 445 show_precision (variable * v)
 446 {
 447   show_choice (v, precision);
 448 }
 449
 450 static void
 451 init_signal (variable * v)
 452 {
 453   init_choice (v, signal_choices);
 454 }
 455
 456 static void
 457 show_signal (variable * v)
 458 {
 459   show_choice (v, signal_choices);
 460 }
 461
 462
 463 static variable variable_table[] = {
 464   {"GFORTRAN_STDIN_UNIT", 5, &options.stdin_unit, init_integer, show_integer,
 465    "Unit number that will be preconnected to standard input\n"
 466    "(No preconnection if negative)", 0},
 467
 468   {"GFORTRAN_STDOUT_UNIT", 6, &options.stdout_unit, init_integer,
 469    show_integer,
 470    "Unit number that will be preconnected to standard output\n"
 471    "(No preconnection if negative)", 0},
 472
 473   {"GFORTRAN_STDERR_UNIT", 0, &options.stderr_unit, init_integer,
 474    show_integer,
 475    "Unit number that will be preconnected to standard error\n"
 476    "(No preconnection if negative)", 0},
 477
 478   {"GFORTRAN_USE_STDERR", 1, &options.use_stderr, init_boolean,
 479    show_boolean,
 480    "Sends library output to standard error instead of standard output.", 0},
 481
 482   {"GFORTRAN_TMPDIR", 0, NULL, init_string, show_string,
 483    "Directory for scratch files.  Overrides the TMP environment variable\n"
 484    "If TMP is not set " DEFAULT_TEMPDIR " is used.", 0},
 485
 486   {"GFORTRAN_UNBUFFERED_ALL", 0, &options.all_unbuffered, init_boolean,
 487    show_boolean,
 488    "If TRUE, all output is unbuffered.  This will slow down large writes "
 489    "but can be\nuseful for forcing data to be displayed immediately.", 0},
 490
 491   {"GFORTRAN_SHOW_LOCUS", 1, &options.locus, init_boolean, show_boolean,
 492    "If TRUE, print filename and line number where runtime errors happen.", 0},
 493
 494   {"GFORTRAN_OPTIONAL_PLUS", 0, &options.optional_plus, init_boolean, show_boolean,
 495    "Print optional plus signs in numbers where permitted.  Default FALSE.", 0},
 496
 497   {"GFORTRAN_DEFAULT_RECL", DEFAULT_RECL, &options.default_recl,
 498    init_unsigned_integer, show_integer,
 499    "Default maximum record length for sequential files.  Most useful for\n"
 500    "adjusting line length of preconnected units.  Default "
 501    stringize (DEFAULT_RECL), 0},
 502
 503   {"GFORTRAN_LIST_SEPARATOR", 0, NULL, init_sep, show_sep,
 504    "Separator to use when writing list output.  May contain any number of "
 505    "spaces\nand at most one comma.  Default is a single space.", 0},
 506
 507   /* Memory related controls */
 508
 509   {"GFORTRAN_MEM_INIT", 0, NULL, init_mem, show_mem,
 510    "How to initialize allocated memory.  Default value is NONE for no "
 511    "initialization\n(faster), NAN for a Not-a-Number with the mantissa "
 512    "0x40f95 or a custom\nhexadecimal value", 0},
 513
 514   {"GFORTRAN_MEM_CHECK", 0, &options.mem_check, init_boolean, show_boolean,
 515    "Whether memory still allocated will be reported when the program ends.",
 516    0},
 517
 518   /* Signal handling (Unix).  */
 519
 520   {"GFORTRAN_SIGHUP", 0, &options.sighup, init_signal, show_signal,
 521    "Whether the program will IGNORE or ABORT on SIGHUP.", 0},
 522
 523   {"GFORTRAN_SIGINT", 0, &options.sigint, init_signal, show_signal,
 524    "Whether the program will IGNORE or ABORT on SIGINT.", 0},
 525
 526   /* Floating point control */
 527
 528   {"GFORTRAN_FPU_ROUND", 0, &options.fpu_round, init_round, show_round,
 529    "Set floating point rounding.  Values are NEAREST, UP, DOWN, ZERO.", 0},
 530
 531   {"GFORTRAN_FPU_PRECISION", 0, &options.fpu_precision, init_precision,
 532    show_precision,
 533    "Precision of intermediate results.  Values are 24, 53 and 64.", 0},
 534
 535   /* GFORTRAN_CONVERT_UNIT - Set the default data conversion for
 536    unformatted I/O.  */
 537   {"GFORTRAN_CONVERT_UNIT", 0, 0, init_unformatted, show_string,
 538    "Set format for unformatted files", 0},
 539
 540   {NULL, 0, NULL, NULL, NULL, NULL, 0}
 541 };
 542
 543
 544 /* init_variables()-- Initialize most runtime variables from
 545  * environment variables. */
 546
 547 void
 548 init_variables (void)
 549 {
 550   variable *v;
 551
 552   for (v = variable_table; v->name; v++)
 553     v->init (v);
 554 }
 555
 556
 557 /* check_buffered()-- Given an unit number n, determine if an override
 558  * for the stream exists.  Returns zero for unbuffered, one for
 559  * buffered or two for not set. */
 560
 561 int
 562 check_buffered (int n)
 563 {
 564   char name[22 + sizeof (n) * 3];
 565   variable v;
 566   int rv;
 567
 568   if (options.all_unbuffered)
 569     return 0;
 570
 571   sprintf (name, "GFORTRAN_UNBUFFERED_%d", n);
 572
 573   v.name = name;
 574   v.value = 2;
 575   v.var = &rv;
 576
 577   init_boolean (&v);
 578
 579   return rv;
 580 }
 581
 582
 583 void
 584 show_variables (void)
 585 {
 586   variable *v;
 587   int n;
 588
 589   /* TODO: print version number.  */
 590   st_printf ("GNU Fortran 95 runtime library version "
 591              "UNKNOWN" "\n\n");
 592
 593   st_printf ("Environment variables:\n");
 594   st_printf ("----------------------\n");
 595
 596   for (v = variable_table; v->name; v++)
 597     {
 598       n = st_printf ("%s", v->name);
 599       print_spaces (25 - n);
 600
 601       if (v->show == show_integer)
 602         st_printf ("Integer ");
 603       else if (v->show == show_boolean)
 604         st_printf ("Boolean ");
 605       else
 606         st_printf ("String  ");
 607
 608       v->show (v);
 609       st_printf ("%s\n\n", v->desc);
 610     }
 611
 612   /* System error codes */
 613
 614   st_printf ("\nRuntime error codes:");
 615   st_printf ("\n--------------------\n");
 616
 617   for (n = ERROR_FIRST + 1; n < ERROR_LAST; n++)
 618     if (n < 0 || n > 9)
 619       st_printf ("%d  %s\n", n, translate_error (n));
 620     else
 621       st_printf (" %d  %s\n", n, translate_error (n));
 622
 623   st_printf ("\nCommand line arguments:\n");
 624   st_printf ("  --help               Print this list\n");
 625
 626   /* st_printf("  --resume <dropfile>  Resume program execution from dropfile\n"); */
 627
 628   sys_exit (0);
 629 }
 630
 631 /* This is the handling of the GFORTRAN_CONVERT_UNITS environment variable.
 632    It is called from environ.c to parse this variable, and from
 633    open.c to determine if the user specified a default for an
 634    unformatted file.
 635    The syntax of the environment variable is, in bison grammar:
 636
 637    GFORTRAN_CONVERT_UNITS: mode | mode ';' exception ;
 638    mode: 'native' | 'swap' | 'big_endian' | 'little_endian' ;
 639    exception: mode ':' unit_list | unit_list ;
 640    unit_list: unit_spec | unit_list unit_spec ;
 641    unit_spec: INTEGER | INTEGER '-' INTEGER ;
 642 */
 643
 644 /* Defines for the tokens.  Other valid tokens are ',', ':', '-'.  */
 645
 646
 647 #define NATIVE   257
 648 #define SWAP     258
 649 #define BIG      259
 650 #define LITTLE   260
 651 /* Some space for additional tokens later.  */
 652 #define INTEGER  273
 653 #define END      (-1)
 654 #define ILLEGAL  (-2)
 655
 656 typedef struct
 657 {
 658   int unit;
 659   unit_convert conv;
 660 } exception_t;
 661
 662
 663 static char *p;            /* Main character pointer for parsing.  */
 664 static char *lastpos;      /* Auxiliary pointer, for backing up.  */
 665 static int unit_num;       /* The last unit number read.  */
 666 static int unit_count;     /* The number of units found. */
 667 static int do_count;       /* Parsing is done twice - first to count the number
 668                               of units, then to fill in the table.  This
 669                               variable controls what to do.  */
 670 static exception_t *elist; /* The list of exceptions to the default. This is
 671                               sorted according to unit number.  */
 672 static int n_elist;        /* Number of exceptions to the default.  */
 673
 674 static unit_convert endian; /* Current endianness.  */
 675
 676 static unit_convert def; /* Default as specified (if any).  */
 677
 678 /* Search for a unit number, using a binary search.  The
 679    first argument is the unit number to search for.  The second argument
 680    is a pointer to an index.
 681    If the unit number is found, the function returns 1, and the index
 682    is that of the element.
 683    If the unit number is not found, the function returns 0, and the
 684    index is the one where the element would be inserted.  */
 685
 686 static int
 687 search_unit (int unit, int *ip)
 688 {
 689   int low, high, mid;
 690
 691   low = -1;
 692   high = n_elist;
 693   while (high - low > 1)
 694     {
 695       mid = (low + high) / 2;
 696       if (unit <= elist[mid].unit)
 697         high = mid;
 698       else
 699         low = mid;
 700     }
 701   *ip = high;
 702   if (elist[high].unit == unit)
 703     return 1;
 704   else
 705     return 0;
 706 }
 707
 708 /* This matches a keyword.  If it is found, return the token supplied,
 709    otherwise return ILLEGAL.  */
 710
 711 static int
 712 match_word (const char *word, int tok)
 713 {
 714   int res;
 715
 716   if (strncasecmp (p, word, strlen (word)) == 0)
 717     {
 718       p += strlen (word);
 719       res = tok;
 720     }
 721   else
 722     res = ILLEGAL;
 723   return res;
 724
 725 }
 726
 727 /* Match an integer and store its value in unit_num.  This only works
 728    if p actually points to the start of an integer.  The caller has
 729    to ensure this.  */
 730
 731 static int
 732 match_integer (void)
 733 {
 734   unit_num = 0;
 735   while (isdigit (*p))
 736     unit_num = unit_num * 10 + (*p++ - '0');
 737   return INTEGER;
 738
 739 }
 740
 741 /* This reads the next token from the GFORTRAN_CONVERT_UNITS variable.
 742    Returned values are the different tokens.  */
 743
 744 static int
 745 next_token (void)
 746 {
 747   int result;
 748
 749   lastpos = p;
 750   switch (*p)
 751     {
 752     case '\0':
 753       result = END;
 754       break;
 755
 756     case ':':
 757     case ',':
 758     case '-':
 759     case ';':
 760       result = *p;
 761       p++;
 762       break;
 763
 764     case 'b':
 765     case 'B':
 766       result = match_word ("big_endian", BIG);
 767       break;
 768
 769     case 'l':
 770     case 'L':
 771       result = match_word ("little_endian", LITTLE);
 772       break;
 773
 774     case 'n':
 775     case 'N':
 776       result = match_word ("native", NATIVE);
 777       break;
 778
 779     case 's':
 780     case 'S':
 781       result = match_word ("swap", SWAP);
 782       break;
 783
 784     case '1': case '2': case '3': case '4': case '5':
 785     case '6': case '7': case '8': case '9':
 786       result = match_integer ();
 787       break;
 788
 789     default:
 790       result = ILLEGAL;
 791       break;
 792     }
 793   return result;
 794 }
 795
 796 /* Back up the last token by setting back the character pointer.  */
 797
 798 static void
 799 push_token (void)
 800 {
 801   p = lastpos;
 802 }
 803
 804 /* This is called when a unit is identified.  If do_count is nonzero,
 805    increment the number of units by one.  If do_count is zero,
 806    put the unit into the table.  */
 807
 808 static void
 809 mark_single (int unit)
 810 {
 811   int i,j;
 812
 813   if (do_count)
 814     {
 815       unit_count++;
 816       return;
 817     }
 818   if (search_unit (unit, &i))
 819     {
 820       elist[unit].conv = endian;
 821     }
 822   else
 823     {
 824       for (j=n_elist; j>=i; j--)
 825         elist[j+1] = elist[j];
 826
 827       n_elist += 1;
 828       elist[i].unit = unit;
 829       elist[i].conv = endian;
 830     }
 831 }
 832
 833 /* This is called when a unit range is identified.  If do_count is
 834    nonzero, increase the number of units.  If do_count is zero,
 835    put the unit into the table.  */
 836
 837 static void
 838 mark_range (int unit1, int unit2)
 839 {
 840   int i;
 841   if (do_count)
 842     unit_count += abs (unit2 - unit1) + 1;
 843   else
 844     {
 845       if (unit2 < unit1)
 846         for (i=unit2; i<=unit1; i++)
 847           mark_single (i);
 848       else
 849         for (i=unit1; i<=unit2; i++)
 850           mark_single (i);
 851     }
 852 }
 853
 854 /* Parse the GFORTRAN_CONVERT_UNITS variable.  This is called
 855    twice, once to count the units and once to actually mark them in
 856    the table.  When counting, we don't check for double occurrences
 857    of units.  */
 858
 859 static int
 860 do_parse (void)
 861 {
 862   int tok, def;
 863   int unit1;
 864   int continue_ulist;
 865   char *start;
 866
 867   unit_count = 0;
 868
 869   def = 0;
 870   start = p;
 871
 872   /* Parse the string.  First, let's look for a default.  */
 873   tok = next_token ();
 874   switch (tok)
 875     {
 876     case NATIVE:
 877       endian = CONVERT_NATIVE;
 878       break;
 879
 880     case SWAP:
 881       endian = CONVERT_SWAP;
 882       break;
 883
 884     case BIG:
 885       endian = CONVERT_BIG;
 886       break;
 887
 888     case LITTLE:
 889       endian = CONVERT_LITTLE;
 890       break;
 891
 892     case INTEGER:
 893       /* A leading digit means that we are looking at an exception.
 894          Reset the position to the beginning, and continue processing
 895          at the exception list.  */
 896       p = start;
 897       goto exceptions;
 898       break;
 899
 900     case END:
 901       goto end;
 902       break;
 903
 904     default:
 905       goto error;
 906       break;
 907     }
 908
 909   tok = next_token ();
 910   switch (tok)
 911     {
 912     case ';':
 913       def = endian;
 914       break;
 915
 916     case ':':
 917       /* This isn't a default after all.  Reset the position to the
 918          beginning, and continue processing at the exception list.  */
 919       p = start;
 920       goto exceptions;
 921       break;
 922
 923     case END:
 924       goto end;
 925       break;
 926
 927     default:
 928       goto error;
 929       break;
 930     }
 931
 932  exceptions:
 933
 934   /* Loop over all exceptions.  */
 935   while(1)
 936     {
 937       tok = next_token ();
 938       switch (tok)
 939         {
 940         case LITTLE:
 941           if (next_token () != ':')
 942             goto error;
 943           endian = CONVERT_LITTLE;
 944           break;
 945
 946         case BIG:
 947           if (next_token () != ':')
 948             goto error;
 949           endian = CONVERT_BIG;
 950           break;
 951
 952         case INTEGER:
 953           push_token ();
 954           break;
 955
 956         case END:
 957           goto end;
 958           break;
 959
 960         default:
 961           goto error;
 962           break;
 963         }
 964       /* We arrive here when we want to parse a list of
 965          numbers.  */
 966       continue_ulist = 1;
 967       do
 968         {
 969           tok = next_token ();
 970           if (tok != INTEGER)
 971             goto error;
 972
 973           unit1 = unit_num;
 974           tok = next_token ();
 975           /* The number can be followed by a - and another number,
 976              which means that this is a unit range, a comma
 977              or a semicolon.  */
 978           if (tok == '-')
 979             {
 980               if (next_token () != INTEGER)
 981                 goto error;
 982
 983               mark_range (unit1, unit_num);
 984               tok = next_token ();
 985               if (tok == END)
 986                 goto end;
 987               else if (tok == ';')
 988                 continue_ulist = 0;
 989               else if (tok != ',')
 990                 goto error;
 991             }
 992           else
 993             {
 994               mark_single (unit1);
 995               switch (tok)
 996                 {
 997                 case ';':
 998                   continue_ulist = 0;
 999                   break;
1000
1001                 case ',':
1002                   break;
1003
1004                 case END:
1005                   goto end;
1006                   break;
1007
1008                 default:
1009                   goto error;
1010                 }
1011             }
1012         } while (continue_ulist);
1013     }
1014  end:
1015   return 0;
1016  error:
1017   def = CONVERT_NONE;
1018   return -1;
1019 }
1020
1021 void init_unformatted (variable * v)
1022 {
1023   char *val;
1024   val = getenv (v->name);
1025   def = CONVERT_NONE;
1026   n_elist = 0;
1027
1028   if (val == NULL)
1029     return;
1030   do_count = 1;
1031   p = val;
1032   do_parse ();
1033   if (do_count <= 0)
1034     {
1035       n_elist = 0;
1036       elist = NULL;
1037     }
1038   else
1039     {
1040       elist = get_mem (unit_count * sizeof (exception_t));
1041       do_count = 0;
1042       p = val;
1043       do_parse ();
1044     }
1045 }
1046
1047 /* Get the default conversion for for an unformatted unit.  */
1048
1049 unit_convert
1050 get_unformatted_convert (int unit)
1051 {
1052   int i;
1053
1054   if (elist == NULL)
1055     return def;
1056   else if (search_unit (unit, &i))
1057     return elist[i].conv;
1058   else
1059     return def;
1060 }