diff options
Diffstat (limited to 'gcc-4.8.1/libgfortran/runtime')
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/backtrace.c | 279 | ||||
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/bounds.c | 271 | ||||
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/compile_options.c | 278 | ||||
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/convert_char.c | 69 | ||||
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/environ.c | 856 | ||||
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/error.c | 618 | ||||
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/fpu.c | 41 | ||||
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/in_pack_generic.c | 220 | ||||
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/in_unpack_generic.c | 241 | ||||
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/main.c | 256 | ||||
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/memory.c | 60 | ||||
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/pause.c | 70 | ||||
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/select.c | 46 | ||||
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/select_inc.c | 133 | ||||
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/stop.c | 109 | ||||
| -rw-r--r-- | gcc-4.8.1/libgfortran/runtime/string.c | 111 |
16 files changed, 0 insertions, 3658 deletions
diff --git a/gcc-4.8.1/libgfortran/runtime/backtrace.c b/gcc-4.8.1/libgfortran/runtime/backtrace.c deleted file mode 100644 index 3b5811881..000000000 --- a/gcc-4.8.1/libgfortran/runtime/backtrace.c +++ /dev/null @@ -1,279 +0,0 @@ -/* Copyright (C) 2006-2013 Free Software Foundation, Inc. - Contributed by François-Xavier Coudert - -This file is part of the GNU Fortran runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - -#include "libgfortran.h" - -#include <string.h> -#include <stdlib.h> - -#ifdef HAVE_UNISTD_H -#include <unistd.h> -#endif - -#ifdef HAVE_SYS_WAIT_H -#include <sys/wait.h> -#endif - -#include <limits.h> - -#include "unwind.h" - - -/* Macros for common sets of capabilities: can we fork and exec, and - can we use pipes to communicate with the subprocess. */ -#define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVE) \ - && defined(HAVE_WAIT)) -#define CAN_PIPE (CAN_FORK && defined(HAVE_PIPE) \ - && defined(HAVE_DUP2) && defined(HAVE_CLOSE)) - -#ifndef PATH_MAX -#define PATH_MAX 4096 -#endif - - -/* GDB style #NUM index for each stack frame. */ - -static void -bt_header (int num) -{ - st_printf ("#%d ", num); -} - - -/* fgets()-like function that reads a line from a fd, without - needing to malloc() a buffer, and does not use locks, hence should - be async-signal-safe. */ - -static char * -fd_gets (char *s, int size, int fd) -{ - for (int i = 0; i < size; i++) - { - char c; - ssize_t nread = read (fd, &c, 1); - if (nread == 1) - { - s[i] = c; - if (c == '\n') - { - if (i + 1 < size) - s[i+1] = '\0'; - else - s[i] = '\0'; - break; - } - } - else - { - s[i] = '\0'; - if (i == 0) - return NULL; - break; - } - } - return s; -} - - -extern char *addr2line_path; - -/* Struct containing backtrace state. */ -typedef struct -{ - int frame_number; - int direct_output; - int outfd; - int infd; - int error; -} -bt_state; - -static _Unwind_Reason_Code -trace_function (struct _Unwind_Context *context, void *state_ptr) -{ - bt_state* state = (bt_state*) state_ptr; - _Unwind_Ptr ip; -#ifdef HAVE_GETIPINFO - int ip_before_insn = 0; - ip = _Unwind_GetIPInfo (context, &ip_before_insn); - - /* If the unwinder gave us a 'return' address, roll it back a little - to ensure we get the correct line number for the call itself. */ - if (! ip_before_insn) - --ip; -#else - ip = _Unwind_GetIP (context); -#endif - - if (state->direct_output) - { - bt_header(state->frame_number); - st_printf ("%p\n", (void*) ip); - } - else - { - char addr_buf[GFC_XTOA_BUF_SIZE], func[1024], file[PATH_MAX]; - char *p; - const char* addr = gfc_xtoa (ip, addr_buf, sizeof (addr_buf)); - write (state->outfd, addr, strlen (addr)); - write (state->outfd, "\n", 1); - - if (! fd_gets (func, sizeof(func), state->infd)) - { - state->error = 1; - goto done; - } - if (! fd_gets (file, sizeof(file), state->infd)) - { - state->error = 1; - goto done; - } - - for (p = func; *p != '\n' && *p != '\r'; p++) - ; - *p = '\0'; - - /* _start is a setup routine that calls main(), and main() is - the frontend routine that calls some setup stuff and then - calls MAIN__, so at this point we should stop. */ - if (strcmp (func, "_start") == 0 || strcmp (func, "main") == 0) - return _URC_END_OF_STACK; - - bt_header (state->frame_number); - estr_write ("0x"); - estr_write (addr); - - if (func[0] != '?' && func[1] != '?') - { - estr_write (" in "); - estr_write (func); - } - - if (strncmp (file, "??", 2) == 0) - estr_write ("\n"); - else - { - estr_write (" at "); - estr_write (file); - } - } - - done: - - state->frame_number++; - - return _URC_NO_REASON; -} - - -/* Display the backtrace. */ - -void -backtrace (void) -{ - bt_state state; - state.frame_number = 0; - state.error = 0; - -#if CAN_PIPE - - if (addr2line_path == NULL) - goto fallback_noerr; - - /* We attempt to extract file and line information from addr2line. */ - do - { - /* Local variables. */ - int f[2], pid, inp[2]; - - /* Don't output an error message if something goes wrong, we'll simply - fall back to printing the addresses. */ - if (pipe (f) != 0) - break; - if (pipe (inp) != 0) - break; - if ((pid = fork ()) == -1) - break; - - if (pid == 0) - { - /* Child process. */ -#define NUM_FIXEDARGS 7 - char *arg[NUM_FIXEDARGS]; - char *newenv[] = { NULL }; - - close (f[0]); - - close (inp[1]); - if (dup2 (inp[0], STDIN_FILENO) == -1) - _exit (1); - close (inp[0]); - - close (STDERR_FILENO); - - if (dup2 (f[1], STDOUT_FILENO) == -1) - _exit (1); - close (f[1]); - - arg[0] = addr2line_path; - arg[1] = (char *) "-e"; - arg[2] = full_exe_path (); - arg[3] = (char *) "-f"; - arg[4] = (char *) "-s"; - arg[5] = (char *) "-C"; - arg[6] = NULL; - execve (addr2line_path, arg, newenv); - _exit (1); -#undef NUM_FIXEDARGS - } - - /* Father process. */ - close (f[1]); - close (inp[0]); - - state.outfd = inp[1]; - state.infd = f[0]; - state.direct_output = 0; - _Unwind_Backtrace (trace_function, &state); - if (state.error) - goto fallback; - close (inp[1]); - close (f[0]); - wait (NULL); - return; - -fallback: - estr_write ("** Something went wrong while running addr2line. **\n" - "** Falling back to a simpler backtrace scheme. **\n"); - } - while (0); - -fallback_noerr: -#endif /* CAN_PIPE */ - - /* Fallback to the simple backtrace without addr2line. */ - state.direct_output = 1; - _Unwind_Backtrace (trace_function, &state); -} -iexport(backtrace); diff --git a/gcc-4.8.1/libgfortran/runtime/bounds.c b/gcc-4.8.1/libgfortran/runtime/bounds.c deleted file mode 100644 index b9c6c4122..000000000 --- a/gcc-4.8.1/libgfortran/runtime/bounds.c +++ /dev/null @@ -1,271 +0,0 @@ -/* Copyright (C) 2009-2013 Free Software Foundation, Inc. - Contributed by Thomas Koenig - -This file is part of the GNU Fortran runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - -#include "libgfortran.h" -#include <assert.h> - -/* Auxiliary functions for bounds checking, mostly to reduce library size. */ - -/* Bounds checking for the return values of the iforeach functions (such - as maxloc and minloc). The extent of ret_array must - must match the rank of array. */ - -void -bounds_iforeach_return (array_t *retarray, array_t *array, const char *name) -{ - index_type rank; - index_type ret_rank; - index_type ret_extent; - - ret_rank = GFC_DESCRIPTOR_RANK (retarray); - - if (ret_rank != 1) - runtime_error ("Incorrect rank of return array in %s intrinsic:" - "is %ld, should be 1", name, (long int) ret_rank); - - rank = GFC_DESCRIPTOR_RANK (array); - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " %s intrinsic: is %ld, should be %ld", - name, (long int) ret_extent, (long int) rank); - -} - -/* Check the return of functions generated from ifunction.m4. - We check the array descriptor "a" against the extents precomputed - from ifunction.m4, and complain about the argument a_name in the - intrinsic function. */ - -void -bounds_ifunction_return (array_t * a, const index_type * extent, - const char * a_name, const char * intrinsic) -{ - int empty; - int n; - int rank; - index_type a_size; - - rank = GFC_DESCRIPTOR_RANK (a); - a_size = size0 (a); - - empty = 0; - for (n = 0; n < rank; n++) - { - if (extent[n] == 0) - empty = 1; - } - if (empty) - { - if (a_size != 0) - runtime_error ("Incorrect size in %s of %s" - " intrinsic: should be zero-sized", - a_name, intrinsic); - } - else - { - if (a_size == 0) - runtime_error ("Incorrect size of %s in %s" - " intrinsic: should not be zero-sized", - a_name, intrinsic); - - for (n = 0; n < rank; n++) - { - index_type a_extent; - a_extent = GFC_DESCRIPTOR_EXTENT(a, n); - if (a_extent != extent[n]) - runtime_error("Incorrect extent in %s of %s" - " intrinsic in dimension %ld: is %ld," - " should be %ld", a_name, intrinsic, (long int) n + 1, - (long int) a_extent, (long int) extent[n]); - - } - } -} - -/* Check that two arrays have equal extents, or are both zero-sized. Abort - with a runtime error if this is not the case. Complain that a has the - wrong size. */ - -void -bounds_equal_extents (array_t *a, array_t *b, const char *a_name, - const char *intrinsic) -{ - index_type a_size, b_size, n; - - assert (GFC_DESCRIPTOR_RANK(a) == GFC_DESCRIPTOR_RANK(b)); - - a_size = size0 (a); - b_size = size0 (b); - - if (b_size == 0) - { - if (a_size != 0) - runtime_error ("Incorrect size of %s in %s" - " intrinsic: should be zero-sized", - a_name, intrinsic); - } - else - { - if (a_size == 0) - runtime_error ("Incorrect size of %s of %s" - " intrinsic: Should not be zero-sized", - a_name, intrinsic); - - for (n = 0; n < GFC_DESCRIPTOR_RANK (b); n++) - { - index_type a_extent, b_extent; - - a_extent = GFC_DESCRIPTOR_EXTENT(a, n); - b_extent = GFC_DESCRIPTOR_EXTENT(b, n); - if (a_extent != b_extent) - runtime_error("Incorrect extent in %s of %s" - " intrinsic in dimension %ld: is %ld," - " should be %ld", a_name, intrinsic, (long int) n + 1, - (long int) a_extent, (long int) b_extent); - } - } -} - -/* Check that the extents of a and b agree, except that a has a missing - dimension in argument which. Complain about a if anything is wrong. */ - -void -bounds_reduced_extents (array_t *a, array_t *b, int which, const char *a_name, - const char *intrinsic) -{ - - index_type i, n, a_size, b_size; - - assert (GFC_DESCRIPTOR_RANK(a) == GFC_DESCRIPTOR_RANK(b) - 1); - - a_size = size0 (a); - b_size = size0 (b); - - if (b_size == 0) - { - if (a_size != 0) - runtime_error ("Incorrect size in %s of %s" - " intrinsic: should not be zero-sized", - a_name, intrinsic); - } - else - { - if (a_size == 0) - runtime_error ("Incorrect size of %s of %s" - " intrinsic: should be zero-sized", - a_name, intrinsic); - - i = 0; - for (n = 0; n < GFC_DESCRIPTOR_RANK (b); n++) - { - index_type a_extent, b_extent; - - if (n != which) - { - a_extent = GFC_DESCRIPTOR_EXTENT(a, i); - b_extent = GFC_DESCRIPTOR_EXTENT(b, n); - if (a_extent != b_extent) - runtime_error("Incorrect extent in %s of %s" - " intrinsic in dimension %ld: is %ld," - " should be %ld", a_name, intrinsic, (long int) i + 1, - (long int) a_extent, (long int) b_extent); - i++; - } - } - } -} - -/* count_0 - count all the true elements in an array. The front - end usually inlines this, we need this for bounds checking - for unpack. */ - -index_type count_0 (const gfc_array_l1 * array) -{ - const GFC_LOGICAL_1 * restrict base; - index_type rank; - int kind; - int continue_loop; - index_type count[GFC_MAX_DIMENSIONS]; - index_type extent[GFC_MAX_DIMENSIONS]; - index_type sstride[GFC_MAX_DIMENSIONS]; - index_type result; - index_type n; - - rank = GFC_DESCRIPTOR_RANK (array); - kind = GFC_DESCRIPTOR_SIZE (array); - - base = array->base_addr; - - if (kind == 1 || kind == 2 || kind == 4 || kind == 8 -#ifdef HAVE_GFC_LOGICAL_16 - || kind == 16 -#endif - ) - { - if (base) - base = GFOR_POINTER_TO_L1 (base, kind); - } - else - internal_error (NULL, "Funny sized logical array in count_0"); - - for (n = 0; n < rank; n++) - { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); - extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); - count[n] = 0; - - if (extent[n] <= 0) - return 0; - } - - result = 0; - continue_loop = 1; - while (continue_loop) - { - if (*base) - result ++; - - count[0]++; - base += sstride[0]; - n = 0; - while (count[n] == extent[n]) - { - count[n] = 0; - base -= sstride[n] * extent[n]; - n++; - if (n == rank) - { - continue_loop = 0; - break; - } - else - { - count[n]++; - base += sstride[n]; - } - } - } - return result; -} diff --git a/gcc-4.8.1/libgfortran/runtime/compile_options.c b/gcc-4.8.1/libgfortran/runtime/compile_options.c deleted file mode 100644 index a49514c0a..000000000 --- a/gcc-4.8.1/libgfortran/runtime/compile_options.c +++ /dev/null @@ -1,278 +0,0 @@ -/* Handling of compile-time options that influence the library. - Copyright (C) 2005-2013 Free Software Foundation, Inc. - -This file is part of the GNU Fortran runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - -#include "libgfortran.h" -#include <signal.h> - - -/* Useful compile-time options will be stored in here. */ -compile_options_t compile_options; - - -volatile sig_atomic_t fatal_error_in_progress = 0; - - -/* Helper function for backtrace_handler to write information about the - received signal to stderr before actually giving the backtrace. */ -static void -show_signal (int signum) -{ - const char * name = NULL, * desc = NULL; - - switch (signum) - { -#if defined(SIGQUIT) - case SIGQUIT: - name = "SIGQUIT"; - desc = "Terminal quit signal"; - break; -#endif - - /* The following 4 signals are defined by C89. */ - case SIGILL: - name = "SIGILL"; - desc = "Illegal instruction"; - break; - - case SIGABRT: - name = "SIGABRT"; - desc = "Process abort signal"; - break; - - case SIGFPE: - name = "SIGFPE"; - desc = "Floating-point exception - erroneous arithmetic operation"; - break; - - case SIGSEGV: - name = "SIGSEGV"; - desc = "Segmentation fault - invalid memory reference"; - break; - -#if defined(SIGBUS) - case SIGBUS: - name = "SIGBUS"; - desc = "Access to an undefined portion of a memory object"; - break; -#endif - -#if defined(SIGSYS) - case SIGSYS: - name = "SIGSYS"; - desc = "Bad system call"; - break; -#endif - -#if defined(SIGTRAP) - case SIGTRAP: - name = "SIGTRAP"; - desc = "Trace/breakpoint trap"; - break; -#endif - -#if defined(SIGXCPU) - case SIGXCPU: - name = "SIGXCPU"; - desc = "CPU time limit exceeded"; - break; -#endif - -#if defined(SIGXFSZ) - case SIGXFSZ: - name = "SIGXFSZ"; - desc = "File size limit exceeded"; - break; -#endif - } - - if (name) - st_printf ("\nProgram received signal %s: %s.\n", name, desc); - else - st_printf ("\nProgram received signal %d.\n", signum); -} - - -/* A signal handler to allow us to output a backtrace. */ -void -backtrace_handler (int signum) -{ - /* Since this handler is established for more than one kind of signal, - it might still get invoked recursively by delivery of some other kind - of signal. Use a static variable to keep track of that. */ - if (fatal_error_in_progress) - raise (signum); - fatal_error_in_progress = 1; - - show_signal (signum); - estr_write ("\nBacktrace for this error:\n"); - backtrace (); - - /* Now reraise the signal. We reactivate the signal's - default handling, which is to terminate the process. - We could just call exit or abort, - but reraising the signal sets the return status - from the process correctly. */ - signal (signum, SIG_DFL); - raise (signum); -} - - -/* Helper function for set_options because we need to access the - global variable options which is not seen in set_options. */ -static void -maybe_find_addr2line (void) -{ - if (options.backtrace == -1) - find_addr2line (); -} - -/* Set the usual compile-time options. */ -extern void set_options (int , int []); -export_proto(set_options); - -void -set_options (int num, int options[]) -{ - if (num >= 1) - compile_options.warn_std = options[0]; - if (num >= 2) - compile_options.allow_std = options[1]; - if (num >= 3) - compile_options.pedantic = options[2]; - /* options[3] is the removed -fdump-core option. It's place in the - options array is retained due to ABI compatibility. Remove when - bumping the library ABI. */ - if (num >= 5) - compile_options.backtrace = options[4]; - if (num >= 6) - compile_options.sign_zero = options[5]; - if (num >= 7) - compile_options.bounds_check = options[6]; - /* options[7] is the -frange-check option, which no longer affects - the library behavior; range checking is now always done when - parsing integers. It's place in the options array is retained due - to ABI compatibility. Remove when bumping the library ABI. */ - - /* If backtrace is required, we set signal handlers on the POSIX - 2001 signals with core action. */ - if (compile_options.backtrace) - { -#if defined(SIGQUIT) - signal (SIGQUIT, backtrace_handler); -#endif - - /* The following 4 signals are defined by C89. */ - signal (SIGILL, backtrace_handler); - signal (SIGABRT, backtrace_handler); - signal (SIGFPE, backtrace_handler); - signal (SIGSEGV, backtrace_handler); - -#if defined(SIGBUS) - signal (SIGBUS, backtrace_handler); -#endif - -#if defined(SIGSYS) - signal (SIGSYS, backtrace_handler); -#endif - -#if defined(SIGTRAP) - signal (SIGTRAP, backtrace_handler); -#endif - -#if defined(SIGXCPU) - signal (SIGXCPU, backtrace_handler); -#endif - -#if defined(SIGXFSZ) - signal (SIGXFSZ, backtrace_handler); -#endif - - maybe_find_addr2line (); - } -} - - -/* Default values for the compile-time options. Keep in sync with - gcc/fortran/options.c (gfc_init_options). */ -void -init_compile_options (void) -{ - compile_options.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY; - compile_options.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL - | GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77 - | GFC_STD_F2008_OBS | GFC_STD_GNU | GFC_STD_LEGACY; - compile_options.pedantic = 0; - compile_options.backtrace = 0; - compile_options.sign_zero = 1; -} - -/* Function called by the front-end to tell us the - default for unformatted data conversion. */ - -extern void set_convert (int); -export_proto (set_convert); - -void -set_convert (int conv) -{ - compile_options.convert = conv; -} - -extern void set_record_marker (int); -export_proto (set_record_marker); - - -void -set_record_marker (int val) -{ - - switch(val) - { - case 4: - compile_options.record_marker = sizeof (GFC_INTEGER_4); - break; - - case 8: - compile_options.record_marker = sizeof (GFC_INTEGER_8); - break; - - default: - runtime_error ("Invalid value for record marker"); - break; - } -} - -extern void set_max_subrecord_length (int); -export_proto (set_max_subrecord_length); - -void set_max_subrecord_length(int val) -{ - if (val > GFC_MAX_SUBRECORD_LENGTH || val < 1) - { - runtime_error ("Invalid value for maximum subrecord length"); - return; - } - - compile_options.max_subrecord_length = val; -} diff --git a/gcc-4.8.1/libgfortran/runtime/convert_char.c b/gcc-4.8.1/libgfortran/runtime/convert_char.c deleted file mode 100644 index e30a2f634..000000000 --- a/gcc-4.8.1/libgfortran/runtime/convert_char.c +++ /dev/null @@ -1,69 +0,0 @@ -/* Runtime conversion of strings from one character kind to another. - Copyright (C) 2008-2013 Free Software Foundation, Inc. - -This file is part of the GNU Fortran runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public -License as published by the Free Software Foundation; either -version 3 of the License, or (at your option) any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - -#include "libgfortran.h" - -#include <stdlib.h> -#include <string.h> - - -extern void convert_char1_to_char4 (gfc_char4_t **, gfc_charlen_type, - const unsigned char *); -export_proto(convert_char1_to_char4); - -extern void convert_char4_to_char1 (unsigned char **, gfc_charlen_type, - const gfc_char4_t *); -export_proto(convert_char4_to_char1); - - -void -convert_char1_to_char4 (gfc_char4_t **dst, gfc_charlen_type len, - const unsigned char *src) -{ - gfc_charlen_type i, l; - - l = len > 0 ? len : 0; - *dst = xmalloc ((l + 1) * sizeof (gfc_char4_t)); - - for (i = 0; i < l; i++) - (*dst)[i] = src[i]; - - (*dst)[l] = '\0'; -} - - -void -convert_char4_to_char1 (unsigned char **dst, gfc_charlen_type len, - const gfc_char4_t *src) -{ - gfc_charlen_type i, l; - - l = len > 0 ? len : 0; - *dst = xmalloc ((l + 1) * sizeof (unsigned char)); - - for (i = 0; i < l; i++) - (*dst)[i] = src[i]; - - (*dst)[l] = '\0'; -} diff --git a/gcc-4.8.1/libgfortran/runtime/environ.c b/gcc-4.8.1/libgfortran/runtime/environ.c deleted file mode 100644 index 8c09391f0..000000000 --- a/gcc-4.8.1/libgfortran/runtime/environ.c +++ /dev/null @@ -1,856 +0,0 @@ -/* Copyright (C) 2002-2013 Free Software Foundation, Inc. - Contributed by Andy Vaught - -This file is part of the GNU Fortran runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - -#include "libgfortran.h" - -#include <string.h> -#include <stdlib.h> -#include <ctype.h> - - -/* Environment scanner. Examine the environment for controlling minor - * aspects of the program's execution. Our philosophy here that the - * environment should not prevent the program from running, so an - * environment variable with a messed-up value will be interpreted in - * the default way. - * - * Most of the environment is checked early in the startup sequence, - * but other variables are checked during execution of the user's - * program. */ - -options_t options; - - -typedef struct variable -{ - const char *name; - int value, *var; - void (*init) (struct variable *); - void (*show) (struct variable *); - const char *desc; - int bad; -} -variable; - -static void init_unformatted (variable *); - - -#ifdef FALLBACK_SECURE_GETENV -char * -secure_getenv (const char *name) -{ - if ((getuid () == geteuid ()) && (getgid () == getegid ())) - return getenv (name); - else - return NULL; -} -#endif - - -/* print_spaces()-- Print a particular number of spaces. */ - -static void -print_spaces (int n) -{ - char buffer[80]; - int i; - - if (n <= 0) - return; - - for (i = 0; i < n; i++) - buffer[i] = ' '; - - buffer[i] = '\0'; - - estr_write (buffer); -} - - -/* var_source()-- Return a string that describes where the value of a - * variable comes from */ - -static const char * -var_source (variable * v) -{ - if (getenv (v->name) == NULL) - return "Default"; - - if (v->bad) - return "Bad "; - - return "Set "; -} - - -/* init_integer()-- Initialize an integer environment variable. */ - -static void -init_integer (variable * v) -{ - char *p, *q; - - p = getenv (v->name); - if (p == NULL) - goto set_default; - - for (q = p; *q; q++) - if (!isdigit (*q) && (p != q || *q != '-')) - { - v->bad = 1; - goto set_default; - } - - *v->var = atoi (p); - return; - - set_default: - *v->var = v->value; - return; -} - - -/* init_unsigned_integer()-- Initialize an integer environment variable - which has to be positive. */ - -static void -init_unsigned_integer (variable * v) -{ - char *p, *q; - - p = getenv (v->name); - if (p == NULL) - goto set_default; - - for (q = p; *q; q++) - if (!isdigit (*q)) - { - v->bad = 1; - goto set_default; - } - - *v->var = atoi (p); - return; - - set_default: - *v->var = v->value; - return; -} - - -/* show_integer()-- Show an integer environment variable */ - -static void -show_integer (variable * v) -{ - st_printf ("%s %d\n", var_source (v), *v->var); -} - - -/* init_boolean()-- Initialize a boolean environment variable. We - * only look at the first letter of the variable. */ - -static void -init_boolean (variable * v) -{ - char *p; - - p = getenv (v->name); - if (p == NULL) - goto set_default; - - if (*p == '1' || *p == 'Y' || *p == 'y') - { - *v->var = 1; - return; - } - - if (*p == '0' || *p == 'N' || *p == 'n') - { - *v->var = 0; - return; - } - - v->bad = 1; - -set_default: - *v->var = v->value; - return; -} - - -/* show_boolean()-- Show a boolean environment variable */ - -static void -show_boolean (variable * v) -{ - st_printf ("%s %s\n", var_source (v), *v->var ? "Yes" : "No"); -} - - -static void -init_sep (variable * v) -{ - int seen_comma; - char *p; - - p = getenv (v->name); - if (p == NULL) - goto set_default; - - v->bad = 1; - options.separator = p; - options.separator_len = strlen (p); - - /* Make sure the separator is valid */ - - if (options.separator_len == 0) - goto set_default; - seen_comma = 0; - - while (*p) - { - if (*p == ',') - { - if (seen_comma) - goto set_default; - seen_comma = 1; - p++; - continue; - } - - if (*p++ != ' ') - goto set_default; - } - - v->bad = 0; - return; - -set_default: - options.separator = " "; - options.separator_len = 1; -} - - -static void -show_sep (variable * v) -{ - st_printf ("%s \"%s\"\n", var_source (v), options.separator); -} - - -static void -init_string (variable * v __attribute__ ((unused))) -{ -} - -static void -show_string (variable * v) -{ - const char *p; - - p = getenv (v->name); - if (p == NULL) - p = ""; - - estr_write (var_source (v)); - estr_write (" \""); - estr_write (p); - estr_write ("\"\n"); -} - - -static variable variable_table[] = { - {"GFORTRAN_STDIN_UNIT", GFC_STDIN_UNIT_NUMBER, &options.stdin_unit, - init_integer, show_integer, - "Unit number that will be preconnected to standard input\n" - "(No preconnection if negative)", 0}, - - {"GFORTRAN_STDOUT_UNIT", GFC_STDOUT_UNIT_NUMBER, &options.stdout_unit, - init_integer, show_integer, - "Unit number that will be preconnected to standard output\n" - "(No preconnection if negative)", 0}, - - {"GFORTRAN_STDERR_UNIT", GFC_STDERR_UNIT_NUMBER, &options.stderr_unit, - init_integer, show_integer, - "Unit number that will be preconnected to standard error\n" - "(No preconnection if negative)", 0}, - - {"TMPDIR", 0, NULL, init_string, show_string, - "Directory for scratch files.", 0}, - - {"GFORTRAN_UNBUFFERED_ALL", 0, &options.all_unbuffered, init_boolean, - show_boolean, - "If TRUE, all output is unbuffered. This will slow down large writes " - "but can be\nuseful for forcing data to be displayed immediately.", 0}, - - {"GFORTRAN_UNBUFFERED_PRECONNECTED", 0, &options.unbuffered_preconnected, - init_boolean, show_boolean, - "If TRUE, output to preconnected units is unbuffered.", 0}, - - {"GFORTRAN_SHOW_LOCUS", 1, &options.locus, init_boolean, show_boolean, - "If TRUE, print filename and line number where runtime errors happen.", 0}, - - {"GFORTRAN_OPTIONAL_PLUS", 0, &options.optional_plus, init_boolean, show_boolean, - "Print optional plus signs in numbers where permitted. Default FALSE.", 0}, - - {"GFORTRAN_DEFAULT_RECL", DEFAULT_RECL, &options.default_recl, - init_unsigned_integer, show_integer, - "Default maximum record length for sequential files. Most useful for\n" - "adjusting line length of preconnected units. Default " - stringize (DEFAULT_RECL), 0}, - - {"GFORTRAN_LIST_SEPARATOR", 0, NULL, init_sep, show_sep, - "Separator to use when writing list output. May contain any number of " - "spaces\nand at most one comma. Default is a single space.", 0}, - - /* GFORTRAN_CONVERT_UNIT - Set the default data conversion for - unformatted I/O. */ - {"GFORTRAN_CONVERT_UNIT", 0, 0, init_unformatted, show_string, - "Set format for unformatted files", 0}, - - {"GFORTRAN_ERROR_BACKTRACE", -1, &options.backtrace, - init_boolean, show_boolean, - "Print out a backtrace (if possible) on runtime error", -1}, - - {NULL, 0, NULL, NULL, NULL, NULL, 0} -}; - - -/* init_variables()-- Initialize most runtime variables from - * environment variables. */ - -void -init_variables (void) -{ - variable *v; - - for (v = variable_table; v->name; v++) - v->init (v); -} - - -void -show_variables (void) -{ - variable *v; - int n; - - /* TODO: print version number. */ - estr_write ("GNU Fortran runtime library version " - "UNKNOWN" "\n\n"); - - estr_write ("Environment variables:\n"); - estr_write ("----------------------\n"); - - for (v = variable_table; v->name; v++) - { - n = estr_write (v->name); - print_spaces (25 - n); - - if (v->show == show_integer) - estr_write ("Integer "); - else if (v->show == show_boolean) - estr_write ("Boolean "); - else - estr_write ("String "); - - v->show (v); - estr_write (v->desc); - estr_write ("\n\n"); - } - - /* System error codes */ - - estr_write ("\nRuntime error codes:"); - estr_write ("\n--------------------\n"); - - for (n = LIBERROR_FIRST + 1; n < LIBERROR_LAST; n++) - if (n < 0 || n > 9) - st_printf ("%d %s\n", n, translate_error (n)); - else - st_printf (" %d %s\n", n, translate_error (n)); - - estr_write ("\nCommand line arguments:\n"); - estr_write (" --help Print this list\n"); - - exit (0); -} - -/* This is the handling of the GFORTRAN_CONVERT_UNITS environment variable. - It is called from environ.c to parse this variable, and from - open.c to determine if the user specified a default for an - unformatted file. - The syntax of the environment variable is, in bison grammar: - - GFORTRAN_CONVERT_UNITS: mode | mode ';' exception ; - mode: 'native' | 'swap' | 'big_endian' | 'little_endian' ; - exception: mode ':' unit_list | unit_list ; - unit_list: unit_spec | unit_list unit_spec ; - unit_spec: INTEGER | INTEGER '-' INTEGER ; -*/ - -/* Defines for the tokens. Other valid tokens are ',', ':', '-'. */ - - -#define NATIVE 257 -#define SWAP 258 -#define BIG 259 -#define LITTLE 260 -/* Some space for additional tokens later. */ -#define INTEGER 273 -#define END (-1) -#define ILLEGAL (-2) - -typedef struct -{ - int unit; - unit_convert conv; -} exception_t; - - -static char *p; /* Main character pointer for parsing. */ -static char *lastpos; /* Auxiliary pointer, for backing up. */ -static int unit_num; /* The last unit number read. */ -static int unit_count; /* The number of units found. */ -static int do_count; /* Parsing is done twice - first to count the number - of units, then to fill in the table. This - variable controls what to do. */ -static exception_t *elist; /* The list of exceptions to the default. This is - sorted according to unit number. */ -static int n_elist; /* Number of exceptions to the default. */ - -static unit_convert endian; /* Current endianness. */ - -static unit_convert def; /* Default as specified (if any). */ - -/* Search for a unit number, using a binary search. The - first argument is the unit number to search for. The second argument - is a pointer to an index. - If the unit number is found, the function returns 1, and the index - is that of the element. - If the unit number is not found, the function returns 0, and the - index is the one where the element would be inserted. */ - -static int -search_unit (int unit, int *ip) -{ - int low, high, mid; - - if (n_elist == 0) - { - *ip = 0; - return 0; - } - - low = 0; - high = n_elist - 1; - - do - { - mid = (low + high) / 2; - if (unit == elist[mid].unit) - { - *ip = mid; - return 1; - } - else if (unit > elist[mid].unit) - low = mid + 1; - else - high = mid - 1; - } while (low <= high); - - if (unit > elist[mid].unit) - *ip = mid + 1; - else - *ip = mid; - - return 0; -} - -/* This matches a keyword. If it is found, return the token supplied, - otherwise return ILLEGAL. */ - -static int -match_word (const char *word, int tok) -{ - int res; - - if (strncasecmp (p, word, strlen (word)) == 0) - { - p += strlen (word); - res = tok; - } - else - res = ILLEGAL; - return res; - -} - -/* Match an integer and store its value in unit_num. This only works - if p actually points to the start of an integer. The caller has - to ensure this. */ - -static int -match_integer (void) -{ - unit_num = 0; - while (isdigit (*p)) - unit_num = unit_num * 10 + (*p++ - '0'); - return INTEGER; - -} - -/* This reads the next token from the GFORTRAN_CONVERT_UNITS variable. - Returned values are the different tokens. */ - -static int -next_token (void) -{ - int result; - - lastpos = p; - switch (*p) - { - case '\0': - result = END; - break; - - case ':': - case ',': - case '-': - case ';': - result = *p; - p++; - break; - - case 'b': - case 'B': - result = match_word ("big_endian", BIG); - break; - - case 'l': - case 'L': - result = match_word ("little_endian", LITTLE); - break; - - case 'n': - case 'N': - result = match_word ("native", NATIVE); - break; - - case 's': - case 'S': - result = match_word ("swap", SWAP); - break; - - case '1': case '2': case '3': case '4': case '5': - case '6': case '7': case '8': case '9': - result = match_integer (); - break; - - default: - result = ILLEGAL; - break; - } - return result; -} - -/* Back up the last token by setting back the character pointer. */ - -static void -push_token (void) -{ - p = lastpos; -} - -/* This is called when a unit is identified. If do_count is nonzero, - increment the number of units by one. If do_count is zero, - put the unit into the table. */ - -static void -mark_single (int unit) -{ - int i,j; - - if (do_count) - { - unit_count++; - return; - } - if (search_unit (unit, &i)) - { - elist[i].conv = endian; - } - else - { - for (j=n_elist-1; j>=i; j--) - elist[j+1] = elist[j]; - - n_elist += 1; - elist[i].unit = unit; - elist[i].conv = endian; - } -} - -/* This is called when a unit range is identified. If do_count is - nonzero, increase the number of units. If do_count is zero, - put the unit into the table. */ - -static void -mark_range (int unit1, int unit2) -{ - int i; - if (do_count) - unit_count += abs (unit2 - unit1) + 1; - else - { - if (unit2 < unit1) - for (i=unit2; i<=unit1; i++) - mark_single (i); - else - for (i=unit1; i<=unit2; i++) - mark_single (i); - } -} - -/* Parse the GFORTRAN_CONVERT_UNITS variable. This is called - twice, once to count the units and once to actually mark them in - the table. When counting, we don't check for double occurrences - of units. */ - -static int -do_parse (void) -{ - int tok; - int unit1; - int continue_ulist; - char *start; - - unit_count = 0; - - start = p; - - /* Parse the string. First, let's look for a default. */ - tok = next_token (); - switch (tok) - { - case NATIVE: - endian = GFC_CONVERT_NATIVE; - break; - - case SWAP: - endian = GFC_CONVERT_SWAP; - break; - - case BIG: - endian = GFC_CONVERT_BIG; - break; - - case LITTLE: - endian = GFC_CONVERT_LITTLE; - break; - - case INTEGER: - /* A leading digit means that we are looking at an exception. - Reset the position to the beginning, and continue processing - at the exception list. */ - p = start; - goto exceptions; - break; - - case END: - goto end; - break; - - default: - goto error; - break; - } - - tok = next_token (); - switch (tok) - { - case ';': - def = endian; - break; - - case ':': - /* This isn't a default after all. Reset the position to the - beginning, and continue processing at the exception list. */ - p = start; - goto exceptions; - break; - - case END: - def = endian; - goto end; - break; - - default: - goto error; - break; - } - - exceptions: - - /* Loop over all exceptions. */ - while(1) - { - tok = next_token (); - switch (tok) - { - case NATIVE: - if (next_token () != ':') - goto error; - endian = GFC_CONVERT_NATIVE; - break; - - case SWAP: - if (next_token () != ':') - goto error; - endian = GFC_CONVERT_SWAP; - break; - - case LITTLE: - if (next_token () != ':') - goto error; - endian = GFC_CONVERT_LITTLE; - break; - - case BIG: - if (next_token () != ':') - goto error; - endian = GFC_CONVERT_BIG; - break; - - case INTEGER: - push_token (); - break; - - case END: - goto end; - break; - - default: - goto error; - break; - } - /* We arrive here when we want to parse a list of - numbers. */ - continue_ulist = 1; - do - { - tok = next_token (); - if (tok != INTEGER) - goto error; - - unit1 = unit_num; - tok = next_token (); - /* The number can be followed by a - and another number, - which means that this is a unit range, a comma - or a semicolon. */ - if (tok == '-') - { - if (next_token () != INTEGER) - goto error; - - mark_range (unit1, unit_num); - tok = next_token (); - if (tok == END) - goto end; - else if (tok == ';') - continue_ulist = 0; - else if (tok != ',') - goto error; - } - else - { - mark_single (unit1); - switch (tok) - { - case ';': - continue_ulist = 0; - break; - - case ',': - break; - - case END: - goto end; - break; - - default: - goto error; - } - } - } while (continue_ulist); - } - end: - return 0; - error: - def = GFC_CONVERT_NONE; - return -1; -} - -void init_unformatted (variable * v) -{ - char *val; - val = getenv (v->name); - def = GFC_CONVERT_NONE; - n_elist = 0; - - if (val == NULL) - return; - do_count = 1; - p = val; - do_parse (); - if (do_count <= 0) - { - n_elist = 0; - elist = NULL; - } - else - { - elist = xmalloc (unit_count * sizeof (exception_t)); - do_count = 0; - p = val; - do_parse (); - } -} - -/* Get the default conversion for for an unformatted unit. */ - -unit_convert -get_unformatted_convert (int unit) -{ - int i; - - if (elist == NULL) - return def; - else if (search_unit (unit, &i)) - return elist[i].conv; - else - return def; -} diff --git a/gcc-4.8.1/libgfortran/runtime/error.c b/gcc-4.8.1/libgfortran/runtime/error.c deleted file mode 100644 index f09fa201e..000000000 --- a/gcc-4.8.1/libgfortran/runtime/error.c +++ /dev/null @@ -1,618 +0,0 @@ -/* Copyright (C) 2002-2013 Free Software Foundation, Inc. - Contributed by Andy Vaught - -This file is part of the GNU Fortran runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - - -#include "libgfortran.h" -#include <assert.h> -#include <string.h> -#include <errno.h> -#include <signal.h> - -#ifdef HAVE_UNISTD_H -#include <unistd.h> -#endif - -#include <stdlib.h> - -#ifdef HAVE_SYS_TIME_H -#include <sys/time.h> -#endif - -/* <sys/time.h> has to be included before <sys/resource.h> to work - around PR 30518; otherwise, MacOS 10.3.9 headers are just broken. */ -#ifdef HAVE_SYS_RESOURCE_H -#include <sys/resource.h> -#endif - - -#ifdef __MINGW32__ -#define HAVE_GETPID 1 -#include <process.h> -#endif - - -/* Termination of a program: F2008 2.3.5 talks about "normal - termination" and "error termination". Normal termination occurs as - a result of e.g. executing the end program statement, and executing - the STOP statement. It includes the effect of the C exit() - function. - - Error termination is initiated when the ERROR STOP statement is - executed, when ALLOCATE/DEALLOCATE fails without STAT= being - specified, when some of the co-array synchronization statements - fail without STAT= being specified, and some I/O errors if - ERR/IOSTAT/END/EOR is not present, and finally EXECUTE_COMMAND_LINE - failure without CMDSTAT=. - - 2.3.5 also explains how co-images synchronize during termination. - - In libgfortran we have two ways of ending a program. exit(code) is - a normal exit; calling exit() also causes open units to be - closed. No backtrace or core dump is needed here. When something - goes wrong, we have sys_abort() which tries to print the backtrace - if -fbacktrace is enabled, and then dumps core; whether a core file - is generated is system dependent. When aborting, we don't flush and - close open units, as program memory might be corrupted and we'd - rather risk losing dirty data in the buffers rather than corrupting - files on disk. - -*/ - -/* Error conditions. The tricky part here is printing a message when - * it is the I/O subsystem that is severely wounded. Our goal is to - * try and print something making the fewest assumptions possible, - * then try to clean up before actually exiting. - * - * The following exit conditions are defined: - * 0 Normal program exit. - * 1 Terminated because of operating system error. - * 2 Error in the runtime library - * 3 Internal error in runtime library - * - * Other error returns are reserved for the STOP statement with a numeric code. - */ - - -/* Write a null-terminated C string to standard error. This function - is async-signal-safe. */ - -ssize_t -estr_write (const char *str) -{ - return write (STDERR_FILENO, str, strlen (str)); -} - - -/* st_vprintf()-- vsnprintf-like function for error output. We use a - stack allocated buffer for formatting; since this function might be - called from within a signal handler, printing directly to stderr - with vfprintf is not safe since the stderr locking might lead to a - deadlock. */ - -#define ST_VPRINTF_SIZE 512 - -int -st_vprintf (const char *format, va_list ap) -{ - int written; - char buffer[ST_VPRINTF_SIZE]; - -#ifdef HAVE_VSNPRINTF - written = vsnprintf(buffer, ST_VPRINTF_SIZE, format, ap); -#else - written = vsprintf(buffer, format, ap); - - if (written >= ST_VPRINTF_SIZE - 1) - { - /* The error message was longer than our buffer. Ouch. Because - we may have messed up things badly, report the error and - quit. */ -#define ERROR_MESSAGE "Internal error: buffer overrun in st_vprintf()\n" - write (STDERR_FILENO, buffer, ST_VPRINTF_SIZE - 1); - write (STDERR_FILENO, ERROR_MESSAGE, strlen(ERROR_MESSAGE)); - sys_abort (); -#undef ERROR_MESSAGE - - } -#endif - - written = write (STDERR_FILENO, buffer, written); - return written; -} - - -int -st_printf (const char * format, ...) -{ - int written; - va_list ap; - va_start (ap, format); - written = st_vprintf (format, ap); - va_end (ap); - return written; -} - - -/* sys_abort()-- Terminate the program showing backtrace and dumping - core. */ - -void -sys_abort (void) -{ - /* If backtracing is enabled, print backtrace and disable signal - handler for ABRT. */ - if (options.backtrace == 1 - || (options.backtrace == -1 && compile_options.backtrace == 1)) - { - estr_write ("\nProgram aborted. Backtrace:\n"); - backtrace (); - signal (SIGABRT, SIG_DFL); - } - - abort(); -} - - -/* gfc_xtoa()-- Integer to hexadecimal conversion. */ - -const char * -gfc_xtoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len) -{ - int digit; - char *p; - - assert (len >= GFC_XTOA_BUF_SIZE); - - if (n == 0) - return "0"; - - p = buffer + GFC_XTOA_BUF_SIZE - 1; - *p = '\0'; - - while (n != 0) - { - digit = n & 0xF; - if (digit > 9) - digit += 'A' - '0' - 10; - - *--p = '0' + digit; - n >>= 4; - } - - return p; -} - - -/* Hopefully thread-safe wrapper for a strerror_r() style function. */ - -char * -gf_strerror (int errnum, - char * buf __attribute__((unused)), - size_t buflen __attribute__((unused))) -{ -#ifdef HAVE_STRERROR_R - /* POSIX returns an "int", GNU a "char*". */ - return - __builtin_choose_expr (__builtin_classify_type (strerror_r (0, buf, 0)) - == 5, - /* GNU strerror_r() */ - strerror_r (errnum, buf, buflen), - /* POSIX strerror_r () */ - (strerror_r (errnum, buf, buflen), buf)); -#elif defined(HAVE_STRERROR_R_2ARGS) - strerror_r (errnum, buf); - return buf; -#else - /* strerror () is not necessarily thread-safe, but should at least - be available everywhere. */ - return strerror (errnum); -#endif -} - - -/* show_locus()-- Print a line number and filename describing where - * something went wrong */ - -void -show_locus (st_parameter_common *cmp) -{ - char *filename; - - if (!options.locus || cmp == NULL || cmp->filename == NULL) - return; - - if (cmp->unit > 0) - { - filename = filename_from_unit (cmp->unit); - - if (filename != NULL) - { - st_printf ("At line %d of file %s (unit = %d, file = '%s')\n", - (int) cmp->line, cmp->filename, (int) cmp->unit, filename); - free (filename); - } - else - { - st_printf ("At line %d of file %s (unit = %d)\n", - (int) cmp->line, cmp->filename, (int) cmp->unit); - } - return; - } - - st_printf ("At line %d of file %s\n", (int) cmp->line, cmp->filename); -} - - -/* recursion_check()-- It's possible for additional errors to occur - * during fatal error processing. We detect this condition here and - * exit with code 4 immediately. */ - -#define MAGIC 0x20DE8101 - -static void -recursion_check (void) -{ - static int magic = 0; - - /* Don't even try to print something at this point */ - if (magic == MAGIC) - sys_abort (); - - magic = MAGIC; -} - - -#define STRERR_MAXSZ 256 - -/* os_error()-- Operating system error. We get a message from the - * operating system, show it and leave. Some operating system errors - * are caught and processed by the library. If not, we come here. */ - -void -os_error (const char *message) -{ - char errmsg[STRERR_MAXSZ]; - recursion_check (); - estr_write ("Operating system error: "); - estr_write (gf_strerror (errno, errmsg, STRERR_MAXSZ)); - estr_write ("\n"); - estr_write (message); - estr_write ("\n"); - exit (1); -} -iexport(os_error); - - -/* void runtime_error()-- These are errors associated with an - * invalid fortran program. */ - -void -runtime_error (const char *message, ...) -{ - va_list ap; - - recursion_check (); - estr_write ("Fortran runtime error: "); - va_start (ap, message); - st_vprintf (message, ap); - va_end (ap); - estr_write ("\n"); - exit (2); -} -iexport(runtime_error); - -/* void runtime_error_at()-- These are errors associated with a - * run time error generated by the front end compiler. */ - -void -runtime_error_at (const char *where, const char *message, ...) -{ - va_list ap; - - recursion_check (); - estr_write (where); - estr_write ("\nFortran runtime error: "); - va_start (ap, message); - st_vprintf (message, ap); - va_end (ap); - estr_write ("\n"); - exit (2); -} -iexport(runtime_error_at); - - -void -runtime_warning_at (const char *where, const char *message, ...) -{ - va_list ap; - - estr_write (where); - estr_write ("\nFortran runtime warning: "); - va_start (ap, message); - st_vprintf (message, ap); - va_end (ap); - estr_write ("\n"); -} -iexport(runtime_warning_at); - - -/* void internal_error()-- These are this-can't-happen errors - * that indicate something deeply wrong. */ - -void -internal_error (st_parameter_common *cmp, const char *message) -{ - recursion_check (); - show_locus (cmp); - estr_write ("Internal Error: "); - estr_write (message); - estr_write ("\n"); - - /* This function call is here to get the main.o object file included - when linking statically. This works because error.o is supposed to - be always linked in (and the function call is in internal_error - because hopefully it doesn't happen too often). */ - stupid_function_name_for_static_linking(); - - exit (3); -} - - -/* translate_error()-- Given an integer error code, return a string - * describing the error. */ - -const char * -translate_error (int code) -{ - const char *p; - - switch (code) - { - case LIBERROR_EOR: - p = "End of record"; - break; - - case LIBERROR_END: - p = "End of file"; - break; - - case LIBERROR_OK: - p = "Successful return"; - break; - - case LIBERROR_OS: - p = "Operating system error"; - break; - - case LIBERROR_BAD_OPTION: - p = "Bad statement option"; - break; - - case LIBERROR_MISSING_OPTION: - p = "Missing statement option"; - break; - - case LIBERROR_OPTION_CONFLICT: - p = "Conflicting statement options"; - break; - - case LIBERROR_ALREADY_OPEN: - p = "File already opened in another unit"; - break; - - case LIBERROR_BAD_UNIT: - p = "Unattached unit"; - break; - - case LIBERROR_FORMAT: - p = "FORMAT error"; - break; - - case LIBERROR_BAD_ACTION: - p = "Incorrect ACTION specified"; - break; - - case LIBERROR_ENDFILE: - p = "Read past ENDFILE record"; - break; - - case LIBERROR_BAD_US: - p = "Corrupt unformatted sequential file"; - break; - - case LIBERROR_READ_VALUE: - p = "Bad value during read"; - break; - - case LIBERROR_READ_OVERFLOW: - p = "Numeric overflow on read"; - break; - - case LIBERROR_INTERNAL: - p = "Internal error in run-time library"; - break; - - case LIBERROR_INTERNAL_UNIT: - p = "Internal unit I/O error"; - break; - - case LIBERROR_DIRECT_EOR: - p = "Write exceeds length of DIRECT access record"; - break; - - case LIBERROR_SHORT_RECORD: - p = "I/O past end of record on unformatted file"; - break; - - case LIBERROR_CORRUPT_FILE: - p = "Unformatted file structure has been corrupted"; - break; - - default: - p = "Unknown error code"; - break; - } - - return p; -} - - -/* generate_error()-- Come here when an error happens. This - * subroutine is called if it is possible to continue on after the error. - * If an IOSTAT or IOMSG variable exists, we set it. If IOSTAT or - * ERR labels are present, we return, otherwise we terminate the program - * after printing a message. The error code is always required but the - * message parameter can be NULL, in which case a string describing - * the most recent operating system error is used. */ - -void -generate_error (st_parameter_common *cmp, int family, const char *message) -{ - char errmsg[STRERR_MAXSZ]; - - /* If there was a previous error, don't mask it with another - error message, EOF or EOR condition. */ - - if ((cmp->flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_ERROR) - return; - - /* Set the error status. */ - if ((cmp->flags & IOPARM_HAS_IOSTAT)) - *cmp->iostat = (family == LIBERROR_OS) ? errno : family; - - if (message == NULL) - message = - (family == LIBERROR_OS) ? gf_strerror (errno, errmsg, STRERR_MAXSZ) : - translate_error (family); - - if (cmp->flags & IOPARM_HAS_IOMSG) - cf_strcpy (cmp->iomsg, cmp->iomsg_len, message); - - /* Report status back to the compiler. */ - cmp->flags &= ~IOPARM_LIBRETURN_MASK; - switch (family) - { - case LIBERROR_EOR: - cmp->flags |= IOPARM_LIBRETURN_EOR; - if ((cmp->flags & IOPARM_EOR)) - return; - break; - - case LIBERROR_END: - cmp->flags |= IOPARM_LIBRETURN_END; - if ((cmp->flags & IOPARM_END)) - return; - break; - - default: - cmp->flags |= IOPARM_LIBRETURN_ERROR; - if ((cmp->flags & IOPARM_ERR)) - return; - break; - } - - /* Return if the user supplied an iostat variable. */ - if ((cmp->flags & IOPARM_HAS_IOSTAT)) - return; - - /* Terminate the program */ - - recursion_check (); - show_locus (cmp); - estr_write ("Fortran runtime error: "); - estr_write (message); - estr_write ("\n"); - exit (2); -} -iexport(generate_error); - - -/* generate_warning()-- Similar to generate_error but just give a warning. */ - -void -generate_warning (st_parameter_common *cmp, const char *message) -{ - if (message == NULL) - message = " "; - - show_locus (cmp); - estr_write ("Fortran runtime warning: "); - estr_write (message); - estr_write ("\n"); -} - - -/* Whether, for a feature included in a given standard set (GFC_STD_*), - we should issue an error or a warning, or be quiet. */ - -notification -notification_std (int std) -{ - int warning; - - if (!compile_options.pedantic) - return NOTIFICATION_SILENT; - - warning = compile_options.warn_std & std; - if ((compile_options.allow_std & std) != 0 && !warning) - return NOTIFICATION_SILENT; - - return warning ? NOTIFICATION_WARNING : NOTIFICATION_ERROR; -} - - -/* Possibly issue a warning/error about use of a nonstandard (or deleted) - feature. An error/warning will be issued if the currently selected - standard does not contain the requested bits. */ - -try -notify_std (st_parameter_common *cmp, int std, const char * message) -{ - int warning; - - if (!compile_options.pedantic) - return SUCCESS; - - warning = compile_options.warn_std & std; - if ((compile_options.allow_std & std) != 0 && !warning) - return SUCCESS; - - if (!warning) - { - recursion_check (); - show_locus (cmp); - estr_write ("Fortran runtime error: "); - estr_write (message); - estr_write ("\n"); - exit (2); - } - else - { - show_locus (cmp); - estr_write ("Fortran runtime warning: "); - estr_write (message); - estr_write ("\n"); - } - return FAILURE; -} diff --git a/gcc-4.8.1/libgfortran/runtime/fpu.c b/gcc-4.8.1/libgfortran/runtime/fpu.c deleted file mode 100644 index 209cbfbab..000000000 --- a/gcc-4.8.1/libgfortran/runtime/fpu.c +++ /dev/null @@ -1,41 +0,0 @@ -/* Set FPU mask. - Copyright (C) 2005-2013 Free Software Foundation, Inc. - Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr> - -This file is part of the GNU Fortran runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public -License as published by the Free Software Foundation; either -version 3 of the License, or (at your option) any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - -#include "libgfortran.h" - -/* We include the platform-dependent code. */ -#include "fpu-target.h" - -/* Function called by the front-end to tell us - when a FPE should be raised. */ -extern void set_fpe (int); -export_proto(set_fpe); - -void -set_fpe (int exceptions) -{ - options.fpe = exceptions; - set_fpu (); -} diff --git a/gcc-4.8.1/libgfortran/runtime/in_pack_generic.c b/gcc-4.8.1/libgfortran/runtime/in_pack_generic.c deleted file mode 100644 index 330f0f425..000000000 --- a/gcc-4.8.1/libgfortran/runtime/in_pack_generic.c +++ /dev/null @@ -1,220 +0,0 @@ -/* Generic helper function for repacking arrays. - Copyright (C) 2003-2013 Free Software Foundation, Inc. - Contributed by Paul Brook <paul@nowt.org> - -This file is part of the GNU Fortran runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public -License as published by the Free Software Foundation; either -version 3 of the License, or (at your option) any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - -#include "libgfortran.h" -#include <stdlib.h> -#include <assert.h> -#include <string.h> - -extern void *internal_pack (gfc_array_char *); -export_proto(internal_pack); - -void * -internal_pack (gfc_array_char * source) -{ - index_type count[GFC_MAX_DIMENSIONS]; - index_type extent[GFC_MAX_DIMENSIONS]; - index_type stride[GFC_MAX_DIMENSIONS]; - index_type stride0; - index_type dim; - index_type ssize; - const char *src; - char *dest; - void *destptr; - int n; - int packed; - index_type size; - index_type type_size; - - if (source->base_addr == NULL) - return NULL; - - type_size = GFC_DTYPE_TYPE_SIZE(source); - size = GFC_DESCRIPTOR_SIZE (source); - switch (type_size) - { - case GFC_DTYPE_INTEGER_1: - case GFC_DTYPE_LOGICAL_1: - case GFC_DTYPE_DERIVED_1: - return internal_pack_1 ((gfc_array_i1 *) source); - - case GFC_DTYPE_INTEGER_2: - case GFC_DTYPE_LOGICAL_2: - return internal_pack_2 ((gfc_array_i2 *) source); - - case GFC_DTYPE_INTEGER_4: - case GFC_DTYPE_LOGICAL_4: - return internal_pack_4 ((gfc_array_i4 *) source); - - case GFC_DTYPE_INTEGER_8: - case GFC_DTYPE_LOGICAL_8: - return internal_pack_8 ((gfc_array_i8 *) source); - -#if defined(HAVE_GFC_INTEGER_16) - case GFC_DTYPE_INTEGER_16: - case GFC_DTYPE_LOGICAL_16: - return internal_pack_16 ((gfc_array_i16 *) source); -#endif - case GFC_DTYPE_REAL_4: - return internal_pack_r4 ((gfc_array_r4 *) source); - - case GFC_DTYPE_REAL_8: - return internal_pack_r8 ((gfc_array_r8 *) source); - -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) -# if defined (HAVE_GFC_REAL_10) - case GFC_DTYPE_REAL_10: - return internal_pack_r10 ((gfc_array_r10 *) source); -# endif - -# if defined (HAVE_GFC_REAL_16) - case GFC_DTYPE_REAL_16: - return internal_pack_r16 ((gfc_array_r16 *) source); -# endif -#endif - - case GFC_DTYPE_COMPLEX_4: - return internal_pack_c4 ((gfc_array_c4 *) source); - - case GFC_DTYPE_COMPLEX_8: - return internal_pack_c8 ((gfc_array_c8 *) source); - -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) -# if defined (HAVE_GFC_COMPLEX_10) - case GFC_DTYPE_COMPLEX_10: - return internal_pack_c10 ((gfc_array_c10 *) source); -# endif - -# if defined (HAVE_GFC_COMPLEX_16) - case GFC_DTYPE_COMPLEX_16: - return internal_pack_c16 ((gfc_array_c16 *) source); -# endif -#endif - - case GFC_DTYPE_DERIVED_2: - if (GFC_UNALIGNED_2(source->base_addr)) - break; - else - return internal_pack_2 ((gfc_array_i2 *) source); - - case GFC_DTYPE_DERIVED_4: - if (GFC_UNALIGNED_4(source->base_addr)) - break; - else - return internal_pack_4 ((gfc_array_i4 *) source); - - case GFC_DTYPE_DERIVED_8: - if (GFC_UNALIGNED_8(source->base_addr)) - break; - else - return internal_pack_8 ((gfc_array_i8 *) source); - -#ifdef HAVE_GFC_INTEGER_16 - case GFC_DTYPE_DERIVED_16: - if (GFC_UNALIGNED_16(source->base_addr)) - break; - else - return internal_pack_16 ((gfc_array_i16 *) source); -#endif - - default: - break; - } - - dim = GFC_DESCRIPTOR_RANK (source); - ssize = 1; - packed = 1; - for (n = 0; n < dim; n++) - { - count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); - extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); - if (extent[n] <= 0) - { - /* Do nothing. */ - packed = 1; - break; - } - - if (ssize != stride[n]) - packed = 0; - - ssize *= extent[n]; - } - - if (packed) - return source->base_addr; - - /* Allocate storage for the destination. */ - destptr = xmalloc (ssize * size); - dest = (char *)destptr; - src = source->base_addr; - stride0 = stride[0] * size; - - while (src) - { - /* Copy the data. */ - memcpy(dest, src, size); - /* Advance to the next element. */ - dest += size; - src += stride0; - count[0]++; - /* Advance to the next source element. */ - n = 0; - while (count[n] == extent[n]) - { - /* When we get to the end of a dimension, reset it and increment - the next dimension. */ - count[n] = 0; - /* We could precalculate these products, but this is a less - frequently used path so probably not worth it. */ - src -= stride[n] * extent[n] * size; - n++; - if (n == dim) - { - src = NULL; - break; - } - else - { - count[n]++; - src += stride[n] * size; - } - } - } - return destptr; -} diff --git a/gcc-4.8.1/libgfortran/runtime/in_unpack_generic.c b/gcc-4.8.1/libgfortran/runtime/in_unpack_generic.c deleted file mode 100644 index b369eedae..000000000 --- a/gcc-4.8.1/libgfortran/runtime/in_unpack_generic.c +++ /dev/null @@ -1,241 +0,0 @@ -/* Generic helper function for repacking arrays. - Copyright (C) 2003-2013 Free Software Foundation, Inc. - Contributed by Paul Brook <paul@nowt.org> - -This file is part of the GNU Fortran runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public -License as published by the Free Software Foundation; either -version 3 of the License, or (at your option) any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - -#include "libgfortran.h" -#include <stdlib.h> -#include <assert.h> -#include <string.h> - -extern void internal_unpack (gfc_array_char *, const void *); -export_proto(internal_unpack); - -void -internal_unpack (gfc_array_char * d, const void * s) -{ - index_type count[GFC_MAX_DIMENSIONS]; - index_type extent[GFC_MAX_DIMENSIONS]; - index_type stride[GFC_MAX_DIMENSIONS]; - index_type stride0; - index_type dim; - index_type dsize; - char *dest; - const char *src; - int n; - int size; - int type_size; - - dest = d->base_addr; - /* This check may be redundant, but do it anyway. */ - if (s == dest || !s) - return; - - type_size = GFC_DTYPE_TYPE_SIZE (d); - switch (type_size) - { - case GFC_DTYPE_INTEGER_1: - case GFC_DTYPE_LOGICAL_1: - case GFC_DTYPE_DERIVED_1: - internal_unpack_1 ((gfc_array_i1 *) d, (const GFC_INTEGER_1 *) s); - return; - - case GFC_DTYPE_INTEGER_2: - case GFC_DTYPE_LOGICAL_2: - internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s); - return; - - case GFC_DTYPE_INTEGER_4: - case GFC_DTYPE_LOGICAL_4: - internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s); - return; - - case GFC_DTYPE_INTEGER_8: - case GFC_DTYPE_LOGICAL_8: - internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s); - return; - -#if defined (HAVE_GFC_INTEGER_16) - case GFC_DTYPE_INTEGER_16: - case GFC_DTYPE_LOGICAL_16: - internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s); - return; -#endif - - case GFC_DTYPE_REAL_4: - internal_unpack_r4 ((gfc_array_r4 *) d, (const GFC_REAL_4 *) s); - return; - - case GFC_DTYPE_REAL_8: - internal_unpack_r8 ((gfc_array_r8 *) d, (const GFC_REAL_8 *) s); - return; - -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) -# if defined(HAVE_GFC_REAL_10) - case GFC_DTYPE_REAL_10: - internal_unpack_r10 ((gfc_array_r10 *) d, (const GFC_REAL_10 *) s); - return; -# endif - -# if defined(HAVE_GFC_REAL_16) - case GFC_DTYPE_REAL_16: - internal_unpack_r16 ((gfc_array_r16 *) d, (const GFC_REAL_16 *) s); - return; -# endif -#endif - - case GFC_DTYPE_COMPLEX_4: - internal_unpack_c4 ((gfc_array_c4 *)d, (const GFC_COMPLEX_4 *)s); - return; - - case GFC_DTYPE_COMPLEX_8: - internal_unpack_c8 ((gfc_array_c8 *)d, (const GFC_COMPLEX_8 *)s); - return; - -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) -# if defined(HAVE_GFC_COMPLEX_10) - case GFC_DTYPE_COMPLEX_10: - internal_unpack_c10 ((gfc_array_c10 *) d, (const GFC_COMPLEX_10 *) s); - return; -# endif - -# if defined(HAVE_GFC_COMPLEX_16) - case GFC_DTYPE_COMPLEX_16: - internal_unpack_c16 ((gfc_array_c16 *) d, (const GFC_COMPLEX_16 *) s); - return; -# endif -#endif - - case GFC_DTYPE_DERIVED_2: - if (GFC_UNALIGNED_2(d->base_addr) || GFC_UNALIGNED_2(s)) - break; - else - { - internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s); - return; - } - case GFC_DTYPE_DERIVED_4: - if (GFC_UNALIGNED_4(d->base_addr) || GFC_UNALIGNED_4(s)) - break; - else - { - internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s); - return; - } - - case GFC_DTYPE_DERIVED_8: - if (GFC_UNALIGNED_8(d->base_addr) || GFC_UNALIGNED_8(s)) - break; - else - { - internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s); - return; - } - -#ifdef HAVE_GFC_INTEGER_16 - case GFC_DTYPE_DERIVED_16: - if (GFC_UNALIGNED_16(d->base_addr) || GFC_UNALIGNED_16(s)) - break; - else - { - internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s); - return; - } -#endif - - default: - break; - } - - size = GFC_DESCRIPTOR_SIZE (d); - - dim = GFC_DESCRIPTOR_RANK (d); - dsize = 1; - for (n = 0; n < dim; n++) - { - count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); - extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); - if (extent[n] <= 0) - return; - - if (dsize == stride[n]) - dsize *= extent[n]; - else - dsize = 0; - } - - src = s; - - if (dsize != 0) - { - memcpy (dest, src, dsize * size); - return; - } - - stride0 = stride[0] * size; - - while (dest) - { - /* Copy the data. */ - memcpy (dest, src, size); - /* Advance to the next element. */ - src += size; - dest += stride0; - count[0]++; - /* Advance to the next source element. */ - n = 0; - while (count[n] == extent[n]) - { - /* When we get to the end of a dimension, reset it and increment - the next dimension. */ - count[n] = 0; - /* We could precalculate these products, but this is a less - frequently used path so probably not worth it. */ - dest -= stride[n] * extent[n] * size; - n++; - if (n == dim) - { - dest = NULL; - break; - } - else - { - count[n]++; - dest += stride[n] * size; - } - } - } -} diff --git a/gcc-4.8.1/libgfortran/runtime/main.c b/gcc-4.8.1/libgfortran/runtime/main.c deleted file mode 100644 index d774cfb8a..000000000 --- a/gcc-4.8.1/libgfortran/runtime/main.c +++ /dev/null @@ -1,256 +0,0 @@ -/* Copyright (C) 2002-2013 Free Software Foundation, Inc. - Contributed by Andy Vaught and Paul Brook <paul@nowt.org> - -This file is part of the GNU Fortran runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - -#include "libgfortran.h" -#include <stdlib.h> -#include <string.h> -#include <limits.h> - - -#ifdef HAVE_UNISTD_H -#include <unistd.h> -#endif - -/* Stupid function to be sure the constructor is always linked in, even - in the case of static linking. See PR libfortran/22298 for details. */ -void -stupid_function_name_for_static_linking (void) -{ - return; -} - -/* This will be 0 for little-endian - machines and 1 for big-endian machines. */ -int big_endian = 0; - - -/* Figure out endianness for this machine. */ - -static void -determine_endianness (void) -{ - union - { - GFC_LOGICAL_8 l8; - GFC_LOGICAL_4 l4[2]; - } u; - - u.l8 = 1; - if (u.l4[0]) - big_endian = 0; - else if (u.l4[1]) - big_endian = 1; - else - runtime_error ("Unable to determine machine endianness"); -} - - -static int argc_save; -static char **argv_save; - -static const char *exe_path; -static int please_free_exe_path_when_done; - -/* Save the path under which the program was called, for use in the - backtrace routines. */ -void -store_exe_path (const char * argv0) -{ -#ifndef PATH_MAX -#define PATH_MAX 1024 -#endif - -#ifndef DIR_SEPARATOR -#define DIR_SEPARATOR '/' -#endif - - char buf[PATH_MAX], *path; - const char *cwd; - - /* This can only happen if store_exe_path is called multiple times. */ - if (please_free_exe_path_when_done) - free ((char *) exe_path); - - /* Reading the /proc/self/exe symlink is Linux-specific(?), but if - it works it gives the correct answer. */ -#ifdef HAVE_READLINK - int len; - if ((len = readlink ("/proc/self/exe", buf, sizeof (buf) - 1)) != -1) - { - buf[len] = '\0'; - exe_path = strdup (buf); - please_free_exe_path_when_done = 1; - return; - } -#endif - - /* If the path is absolute or on a simulator where argv is not set. */ -#ifdef __MINGW32__ - if (argv0 == NULL - || ('A' <= argv0[0] && argv0[0] <= 'Z' && argv0[1] == ':') - || ('a' <= argv0[0] && argv0[0] <= 'z' && argv0[1] == ':') - || (argv0[0] == '/' && argv0[1] == '/') - || (argv0[0] == '\\' && argv0[1] == '\\')) -#else - if (argv0 == NULL || argv0[0] == DIR_SEPARATOR) -#endif - { - exe_path = argv0; - please_free_exe_path_when_done = 0; - return; - } - -#ifdef HAVE_GETCWD - cwd = getcwd (buf, sizeof (buf)); -#else - cwd = NULL; -#endif - - if (!cwd) - { - exe_path = argv0; - please_free_exe_path_when_done = 0; - return; - } - - /* exe_path will be cwd + "/" + argv[0] + "\0". This will not work - if the executable is not in the cwd, but at this point we're out - of better ideas. */ - size_t pathlen = strlen (cwd) + 1 + strlen (argv0) + 1; - path = malloc (pathlen); - snprintf (path, pathlen, "%s%c%s", cwd, DIR_SEPARATOR, argv0); - exe_path = path; - please_free_exe_path_when_done = 1; -} - - -/* Return the full path of the executable. */ -char * -full_exe_path (void) -{ - return (char *) exe_path; -} - - -char *addr2line_path; - -/* Find addr2line and store the path. */ - -void -find_addr2line (void) -{ -#ifdef HAVE_ACCESS -#define A2L_LEN 10 - char *path = secure_getenv ("PATH"); - if (!path) - return; - size_t n = strlen (path); - char ap[n + 1 + A2L_LEN]; - size_t ai = 0; - for (size_t i = 0; i < n; i++) - { - if (path[i] != ':') - ap[ai++] = path[i]; - else - { - ap[ai++] = '/'; - memcpy (ap + ai, "addr2line", A2L_LEN); - if (access (ap, R_OK|X_OK) == 0) - { - addr2line_path = strdup (ap); - return; - } - else - ai = 0; - } - } -#endif -} - - -/* Set the saved values of the command line arguments. */ - -void -set_args (int argc, char **argv) -{ - argc_save = argc; - argv_save = argv; - store_exe_path (argv[0]); -} -iexport(set_args); - - -/* Retrieve the saved values of the command line arguments. */ - -void -get_args (int *argc, char ***argv) -{ - *argc = argc_save; - *argv = argv_save; -} - - -/* Initialize the runtime library. */ - -static void __attribute__((constructor)) -init (void) -{ - /* Figure out the machine endianness. */ - determine_endianness (); - - /* Must be first */ - init_variables (); - - init_units (); - set_fpu (); - init_compile_options (); - -#ifdef DEBUG - /* Check for special command lines. */ - - if (argc > 1 && strcmp (argv[1], "--help") == 0) - show_variables (); - - /* if (argc > 1 && strcmp(argv[1], "--resume") == 0) resume(); */ -#endif - - if (options.backtrace == 1) - find_addr2line (); - - random_seed_i4 (NULL, NULL, NULL); -} - - -/* Cleanup the runtime library. */ - -static void __attribute__((destructor)) -cleanup (void) -{ - close_units (); - - if (please_free_exe_path_when_done) - free ((char *) exe_path); - - free (addr2line_path); -} diff --git a/gcc-4.8.1/libgfortran/runtime/memory.c b/gcc-4.8.1/libgfortran/runtime/memory.c deleted file mode 100644 index d25a97a27..000000000 --- a/gcc-4.8.1/libgfortran/runtime/memory.c +++ /dev/null @@ -1,60 +0,0 @@ -/* Memory management routines. - Copyright (C) 2002-2013 Free Software Foundation, Inc. - Contributed by Paul Brook <paul@nowt.org> - -This file is part of the GNU Fortran runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public -License as published by the Free Software Foundation; either -version 3 of the License, or (at your option) any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - -#include "libgfortran.h" -#include <stdlib.h> - - -void * -xmalloc (size_t n) -{ - void *p; - - if (n == 0) - n = 1; - - p = malloc (n); - - if (p == NULL) - os_error ("Memory allocation failed"); - - return p; -} - - -/* calloc wrapper that aborts on error. */ - -void * -xcalloc (size_t nmemb, size_t size) -{ - if (nmemb * size == 0) - nmemb = size = 1; - - void *p = calloc (nmemb, size); - if (!p) - os_error ("Allocating cleared memory failed"); - - return p; -} diff --git a/gcc-4.8.1/libgfortran/runtime/pause.c b/gcc-4.8.1/libgfortran/runtime/pause.c deleted file mode 100644 index ad69c95ca..000000000 --- a/gcc-4.8.1/libgfortran/runtime/pause.c +++ /dev/null @@ -1,70 +0,0 @@ -/* Implementation of the PAUSE statement. - Copyright (C) 2002-2013 Free Software Foundation, Inc. - Contributed by Paul Brook <paul@nowt.org> - -This file is part of the GNU Fortran runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public -License as published by the Free Software Foundation; either -version 3 of the License, or (at your option) any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - -#include "libgfortran.h" -#include <string.h> -#include <unistd.h> - -static void -do_pause (void) -{ - char buff[4]; - estr_write ("To resume execution, type go. " - "Other input will terminate the job.\n"); - - fgets(buff, 4, stdin); - if (strncmp(buff, "go\n", 3) != 0) - stop_string ('\0', 0); - estr_write ("RESUMED\n"); -} - -/* A numeric PAUSE statement. */ - -extern void pause_numeric (GFC_INTEGER_4); -export_proto(pause_numeric); - -void -pause_numeric (GFC_INTEGER_4 code) -{ - st_printf ("PAUSE %d\n", (int) code); - do_pause (); -} - -/* A character string or blank PAUSE statement. */ - -extern void pause_string (char *string, GFC_INTEGER_4 len); -export_proto(pause_string); - -void -pause_string (char *string, GFC_INTEGER_4 len) -{ - estr_write ("PAUSE "); - ssize_t w = write (STDERR_FILENO, string, len); - (void) sizeof (w); /* Avoid compiler warning about not using write - return val. */ - estr_write ("\n"); - - do_pause (); -} diff --git a/gcc-4.8.1/libgfortran/runtime/select.c b/gcc-4.8.1/libgfortran/runtime/select.c deleted file mode 100644 index b5ca1facc..000000000 --- a/gcc-4.8.1/libgfortran/runtime/select.c +++ /dev/null @@ -1,46 +0,0 @@ -/* Implement the SELECT statement for character variables. - Copyright (C) 2008-2013 Free Software Foundation, Inc. - -This file is part of the GNU Fortran runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public -License as published by the Free Software Foundation; either -version 3 of the License, or (at your option) any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - -#include "libgfortran.h" - - -/* The string selection function is defined using a few generic macros - in select_inc.c, so we avoid code duplication between the various - character type kinds. */ - -#undef CHARTYPE -#define CHARTYPE char -#undef SUFFIX -#define SUFFIX(x) x - -#include "select_inc.c" - - -#undef CHARTYPE -#define CHARTYPE gfc_char4_t -#undef SUFFIX -#define SUFFIX(x) x ## _char4 - -#include "select_inc.c" - diff --git a/gcc-4.8.1/libgfortran/runtime/select_inc.c b/gcc-4.8.1/libgfortran/runtime/select_inc.c deleted file mode 100644 index 625587ec8..000000000 --- a/gcc-4.8.1/libgfortran/runtime/select_inc.c +++ /dev/null @@ -1,133 +0,0 @@ -/* Implement the SELECT statement for character variables. - Copyright (C) 2008-2013 Free Software Foundation, Inc. - -This file is part of the GNU Fortran runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - -#define select_string SUFFIX(select_string) -#define select_struct SUFFIX(select_struct) -#define compare_string SUFFIX(compare_string) - -typedef struct -{ - CHARTYPE *low; - gfc_charlen_type low_len; - CHARTYPE *high; - gfc_charlen_type high_len; - int address; -} -select_struct; - -extern int select_string (select_struct *table, int table_len, - const CHARTYPE *selector, - gfc_charlen_type selector_len); -export_proto(select_string); - - -/* select_string()-- Given a selector string and a table of - * select_struct structures, return the address to jump to. */ - -int -select_string (select_struct *table, int table_len, const CHARTYPE *selector, - gfc_charlen_type selector_len) -{ - select_struct *t; - int i, low, high, mid; - int default_jump = -1; - - if (table_len == 0) - return -1; - - /* Record the default address if present */ - - if (table->low == NULL && table->high == NULL) - { - default_jump = table->address; - - table++; - table_len--; - if (table_len == 0) - return default_jump; - } - - /* Try the high and low bounds if present. */ - - if (table->low == NULL) - { - if (compare_string (table->high_len, table->high, - selector_len, selector) >= 0) - return table->address; - - table++; - table_len--; - if (table_len == 0) - return default_jump; - } - - t = table + table_len - 1; - - if (t->high == NULL) - { - if (compare_string (t->low_len, t->low, selector_len, selector) <= 0) - return t->address; - - table_len--; - if (table_len == 0) - return default_jump; - } - - /* At this point, the only table entries are bounded entries. Find - the right entry with a binary chop. */ - - low = -1; - high = table_len; - - while (low + 1 < high) - { - mid = (low + high) / 2; - - t = table + mid; - i = compare_string (t->low_len, t->low, selector_len, selector); - - if (i == 0) - return t->address; - - if (i < 0) - low = mid; - else - high = mid; - } - - /* The string now lies between the low indeces of the now-adjacent - high and low entries. Because it is less than the low entry of - 'high', it can't be that one. If low is still -1, then no - entries match. Otherwise, we have to check the high entry of - 'low'. */ - - if (low == -1) - return default_jump; - - t = table + low; - if (compare_string (selector_len, selector, t->high_len, t->high) <= 0) - return t->address; - - return default_jump; -} diff --git a/gcc-4.8.1/libgfortran/runtime/stop.c b/gcc-4.8.1/libgfortran/runtime/stop.c deleted file mode 100644 index 1f0f453bc..000000000 --- a/gcc-4.8.1/libgfortran/runtime/stop.c +++ /dev/null @@ -1,109 +0,0 @@ -/* Implementation of the STOP statement. - Copyright (C) 2002-2013 Free Software Foundation, Inc. - Contributed by Paul Brook <paul@nowt.org> - -This file is part of the GNU Fortran runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public -License as published by the Free Software Foundation; either -version 3 of the License, or (at your option) any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - -#include "libgfortran.h" -#include <stdlib.h> -#include <string.h> -#include <unistd.h> - -/* A numeric STOP statement. */ - -extern void stop_numeric (GFC_INTEGER_4) - __attribute__ ((noreturn)); -export_proto(stop_numeric); - -void -stop_numeric (GFC_INTEGER_4 code) -{ - if (code == -1) - code = 0; - else - st_printf ("STOP %d\n", (int)code); - - exit (code); -} - - -/* A Fortran 2008 numeric STOP statement. */ - -extern void stop_numeric_f08 (GFC_INTEGER_4) - __attribute__ ((noreturn)); -export_proto(stop_numeric_f08); - -void -stop_numeric_f08 (GFC_INTEGER_4 code) -{ - st_printf ("STOP %d\n", (int)code); - exit (code); -} - - -/* A character string or blank STOP statement. */ - -void -stop_string (const char *string, GFC_INTEGER_4 len) -{ - if (string) - { - estr_write ("STOP "); - (void) write (STDERR_FILENO, string, len); - estr_write ("\n"); - } - exit (0); -} - - -/* Per Fortran 2008, section 8.4: "Execution of a STOP statement initiates - normal termination of execution. Execution of an ERROR STOP statement - initiates error termination of execution." Thus, error_stop_string returns - a nonzero exit status code. */ - -extern void error_stop_string (const char *, GFC_INTEGER_4) - __attribute__ ((noreturn)); -export_proto(error_stop_string); - -void -error_stop_string (const char *string, GFC_INTEGER_4 len) -{ - estr_write ("ERROR STOP "); - (void) write (STDERR_FILENO, string, len); - estr_write ("\n"); - - exit (1); -} - - -/* A numeric ERROR STOP statement. */ - -extern void error_stop_numeric (GFC_INTEGER_4) - __attribute__ ((noreturn)); -export_proto(error_stop_numeric); - -void -error_stop_numeric (GFC_INTEGER_4 code) -{ - st_printf ("ERROR STOP %d\n", (int) code); - exit (code); -} diff --git a/gcc-4.8.1/libgfortran/runtime/string.c b/gcc-4.8.1/libgfortran/runtime/string.c deleted file mode 100644 index 4c506cd01..000000000 --- a/gcc-4.8.1/libgfortran/runtime/string.c +++ /dev/null @@ -1,111 +0,0 @@ -/* Copyright (C) 2002-2013 Free Software Foundation, Inc. - Contributed by Paul Brook - -This file is part of the GNU Fortran 95 runtime library (libgfortran). - -Libgfortran is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -Libgfortran is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -Under Section 7 of GPL version 3, you are granted additional -permissions described in the GCC Runtime Library Exception, version -3.1, as published by the Free Software Foundation. - -You should have received a copy of the GNU General Public License and -a copy of the GCC Runtime Library Exception along with this program; -see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -<http://www.gnu.org/licenses/>. */ - -#include "libgfortran.h" -#include <string.h> - - -/* Given a fortran string, return its length exclusive of the trailing - spaces. */ - -gfc_charlen_type -fstrlen (const char *string, gfc_charlen_type len) -{ - for (; len > 0; len--) - if (string[len-1] != ' ') - break; - - return len; -} - - -/* Copy a Fortran string (not null-terminated, hence length arguments - for both source and destination strings. Returns the non-padded - length of the destination. */ - -gfc_charlen_type -fstrcpy (char *dest, gfc_charlen_type destlen, - const char *src, gfc_charlen_type srclen) -{ - if (srclen >= destlen) - { - /* This will truncate if too long. */ - memcpy (dest, src, destlen); - return destlen; - } - else - { - memcpy (dest, src, srclen); - /* Pad with spaces. */ - memset (&dest[srclen], ' ', destlen - srclen); - return srclen; - } -} - - -/* Copy a null-terminated C string to a non-null-terminated Fortran - string. Returns the non-padded length of the destination string. */ - -gfc_charlen_type -cf_strcpy (char *dest, gfc_charlen_type dest_len, const char *src) -{ - size_t src_len; - - src_len = strlen (src); - - if (src_len >= (size_t) dest_len) - { - /* This will truncate if too long. */ - memcpy (dest, src, dest_len); - return dest_len; - } - else - { - memcpy (dest, src, src_len); - /* Pad with spaces. */ - memset (&dest[src_len], ' ', dest_len - src_len); - return src_len; - } -} - - -/* Given a fortran string and an array of st_option structures, search through - the array to find a match. If the option is not found, we generate an error - if no default is provided. */ - -int -find_option (st_parameter_common *cmp, const char *s1, gfc_charlen_type s1_len, - const st_option * opts, const char *error_message) -{ - /* Strip trailing blanks from the Fortran string. */ - size_t len = (size_t) fstrlen (s1, s1_len); - - for (; opts->name; opts++) - if (len == strlen(opts->name) && strncasecmp (s1, opts->name, len) == 0) - return opts->value; - - generate_error (cmp, LIBERROR_BAD_OPTION, error_message); - - return -1; -} |