|
111
|
1 /* Implementation of the STOP statement.
|
|
|
2 Copyright (C) 2002-2017 Free Software Foundation, Inc.
|
|
|
3 Contributed by Paul Brook <paul@nowt.org>
|
|
|
4
|
|
|
5 This file is part of the GNU Fortran runtime library (libgfortran).
|
|
|
6
|
|
|
7 Libgfortran is free software; you can redistribute it and/or
|
|
|
8 modify it under the terms of the GNU General Public
|
|
|
9 License as published by the Free Software Foundation; either
|
|
|
10 version 3 of the License, or (at your option) any later version.
|
|
|
11
|
|
|
12 Libgfortran is distributed in the hope that it will be useful,
|
|
|
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
15 GNU General Public License for more details.
|
|
|
16
|
|
|
17 Under Section 7 of GPL version 3, you are granted additional
|
|
|
18 permissions described in the GCC Runtime Library Exception, version
|
|
|
19 3.1, as published by the Free Software Foundation.
|
|
|
20
|
|
|
21 You should have received a copy of the GNU General Public License and
|
|
|
22 a copy of the GCC Runtime Library Exception along with this program;
|
|
|
23 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
|
|
|
24 <http://www.gnu.org/licenses/>. */
|
|
|
25
|
|
|
26 #include "libgfortran.h"
|
|
|
27
|
|
|
28 #ifdef HAVE_UNISTD_H
|
|
|
29 #include <unistd.h>
|
|
|
30 #endif
|
|
|
31
|
|
|
32
|
|
|
33 /* Fortran 2008 demands: If any exception (14) is signaling on that image, the
|
|
|
34 processor shall issue a warning indicating which exceptions are signaling;
|
|
|
35 this warning shall be on the unit identified by the named constant
|
|
|
36 ERROR_UNIT (13.8.2.8). In line with other compilers, we do not report
|
|
|
37 inexact - and we optionally ignore underflow, cf. thread starting at
|
|
|
38 http://mailman.j3-fortran.org/pipermail/j3/2013-June/006452.html. */
|
|
|
39
|
|
|
40 static void
|
|
|
41 report_exception (void)
|
|
|
42 {
|
|
|
43 int set_excepts;
|
|
|
44
|
|
|
45 if (!compile_options.fpe_summary)
|
|
|
46 return;
|
|
|
47
|
|
|
48 set_excepts = get_fpu_except_flags ();
|
|
|
49 if ((set_excepts & compile_options.fpe_summary) == 0)
|
|
|
50 return;
|
|
|
51
|
|
|
52 estr_write ("Note: The following floating-point exceptions are signalling:");
|
|
|
53
|
|
|
54 if ((compile_options.fpe_summary & GFC_FPE_INVALID)
|
|
|
55 && (set_excepts & GFC_FPE_INVALID))
|
|
|
56 estr_write (" IEEE_INVALID_FLAG");
|
|
|
57
|
|
|
58 if ((compile_options.fpe_summary & GFC_FPE_ZERO)
|
|
|
59 && (set_excepts & GFC_FPE_ZERO))
|
|
|
60 estr_write (" IEEE_DIVIDE_BY_ZERO");
|
|
|
61
|
|
|
62 if ((compile_options.fpe_summary & GFC_FPE_OVERFLOW)
|
|
|
63 && (set_excepts & GFC_FPE_OVERFLOW))
|
|
|
64 estr_write (" IEEE_OVERFLOW_FLAG");
|
|
|
65
|
|
|
66 if ((compile_options.fpe_summary & GFC_FPE_UNDERFLOW)
|
|
|
67 && (set_excepts & GFC_FPE_UNDERFLOW))
|
|
|
68 estr_write (" IEEE_UNDERFLOW_FLAG");
|
|
|
69
|
|
|
70 if ((compile_options.fpe_summary & GFC_FPE_DENORMAL)
|
|
|
71 && (set_excepts & GFC_FPE_DENORMAL))
|
|
|
72 estr_write (" IEEE_DENORMAL");
|
|
|
73
|
|
|
74 if ((compile_options.fpe_summary & GFC_FPE_INEXACT)
|
|
|
75 && (set_excepts & GFC_FPE_INEXACT))
|
|
|
76 estr_write (" IEEE_INEXACT_FLAG");
|
|
|
77
|
|
|
78 estr_write ("\n");
|
|
|
79 }
|
|
|
80
|
|
|
81
|
|
|
82 /* A numeric STOP statement. */
|
|
|
83
|
|
|
84 extern _Noreturn void stop_numeric (GFC_INTEGER_4);
|
|
|
85 export_proto(stop_numeric);
|
|
|
86
|
|
|
87 void
|
|
|
88 stop_numeric (GFC_INTEGER_4 code)
|
|
|
89 {
|
|
|
90 report_exception ();
|
|
|
91 st_printf ("STOP %d\n", (int)code);
|
|
|
92 exit (code);
|
|
|
93 }
|
|
|
94
|
|
|
95
|
|
|
96 /* A character string or blank STOP statement. */
|
|
|
97
|
|
|
98 void
|
|
|
99 stop_string (const char *string, GFC_INTEGER_4 len)
|
|
|
100 {
|
|
|
101 report_exception ();
|
|
|
102 if (string)
|
|
|
103 {
|
|
|
104 estr_write ("STOP ");
|
|
|
105 (void) write (STDERR_FILENO, string, len);
|
|
|
106 estr_write ("\n");
|
|
|
107 }
|
|
|
108 exit (0);
|
|
|
109 }
|
|
|
110
|
|
|
111
|
|
|
112 /* Per Fortran 2008, section 8.4: "Execution of a STOP statement initiates
|
|
|
113 normal termination of execution. Execution of an ERROR STOP statement
|
|
|
114 initiates error termination of execution." Thus, error_stop_string returns
|
|
|
115 a nonzero exit status code. */
|
|
|
116
|
|
|
117 extern _Noreturn void error_stop_string (const char *, GFC_INTEGER_4);
|
|
|
118 export_proto(error_stop_string);
|
|
|
119
|
|
|
120 void
|
|
|
121 error_stop_string (const char *string, GFC_INTEGER_4 len)
|
|
|
122 {
|
|
|
123 report_exception ();
|
|
|
124 estr_write ("ERROR STOP ");
|
|
|
125 (void) write (STDERR_FILENO, string, len);
|
|
|
126 estr_write ("\n");
|
|
|
127
|
|
|
128 exit_error (1);
|
|
|
129 }
|
|
|
130
|
|
|
131
|
|
|
132 /* A numeric ERROR STOP statement. */
|
|
|
133
|
|
|
134 extern _Noreturn void error_stop_numeric (GFC_INTEGER_4);
|
|
|
135 export_proto(error_stop_numeric);
|
|
|
136
|
|
|
137 void
|
|
|
138 error_stop_numeric (GFC_INTEGER_4 code)
|
|
|
139 {
|
|
|
140 report_exception ();
|
|
|
141 st_printf ("ERROR STOP %d\n", (int) code);
|
|
|
142 exit_error (code);
|
|
|
143 }
|
