OSDN Git Service

PR libfortran/27107
[pf3gnuchains/gcc-fork.git] / 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 }