2018-01-03 11:03:58 +01:00
|
|
|
/* Copyright (C) 2002-2018 Free Software Foundation, Inc.
|
2004-05-13 08:41:07 +02:00
|
|
|
Contributed by Paul Brook
|
|
|
|
|
2015-09-02 16:51:40 +02:00
|
|
|
This file is part of the GNU Fortran runtime library (libgfortran).
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2005-01-12 22:27:33 +01:00
|
|
|
Libgfortran is free software; you can redistribute it and/or modify
|
2004-05-13 08:41:07 +02:00
|
|
|
it under the terms of the GNU General Public License as published by
|
2009-04-09 17:00:19 +02:00
|
|
|
the Free Software Foundation; either version 3, or (at your option)
|
2004-05-13 08:41:07 +02:00
|
|
|
any later version.
|
|
|
|
|
2005-01-12 22:27:33 +01:00
|
|
|
Libgfortran is distributed in the hope that it will be useful,
|
2004-05-13 08:41:07 +02:00
|
|
|
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.
|
|
|
|
|
2009-04-09 17:00:19 +02:00
|
|
|
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/>. */
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
#include "libgfortran.h"
|
2007-08-31 16:01:34 +02:00
|
|
|
#include <string.h>
|
2016-12-21 10:49:40 +01:00
|
|
|
#include <strings.h>
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
|
|
|
|
/* Given a fortran string, return its length exclusive of the trailing
|
|
|
|
spaces. */
|
2007-05-26 23:15:22 +02:00
|
|
|
|
|
|
|
gfc_charlen_type
|
|
|
|
fstrlen (const char *string, gfc_charlen_type len)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2007-05-26 23:15:22 +02:00
|
|
|
for (; len > 0; len--)
|
|
|
|
if (string[len-1] != ' ')
|
2004-05-13 08:41:07 +02:00
|
|
|
break;
|
|
|
|
|
2007-05-26 23:15:22 +02:00
|
|
|
return len;
|
2004-05-13 08:41:07 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
|
2007-05-26 23:15:22 +02:00
|
|
|
/* 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)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (srclen >= destlen)
|
|
|
|
{
|
|
|
|
/* This will truncate if too long. */
|
|
|
|
memcpy (dest, src, destlen);
|
2007-05-26 23:15:22 +02:00
|
|
|
return destlen;
|
2004-05-13 08:41:07 +02:00
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
memcpy (dest, src, srclen);
|
|
|
|
/* Pad with spaces. */
|
|
|
|
memset (&dest[srclen], ' ', destlen - srclen);
|
2007-05-26 23:15:22 +02:00
|
|
|
return srclen;
|
2004-05-13 08:41:07 +02:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2007-05-26 23:15:22 +02:00
|
|
|
/* 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)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2007-05-26 23:15:22 +02:00
|
|
|
size_t src_len;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
src_len = strlen (src);
|
|
|
|
|
2007-05-26 23:15:22 +02:00
|
|
|
if (src_len >= (size_t) dest_len)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
/* This will truncate if too long. */
|
|
|
|
memcpy (dest, src, dest_len);
|
2007-05-26 23:15:22 +02:00
|
|
|
return dest_len;
|
2004-05-13 08:41:07 +02:00
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
memcpy (dest, src, src_len);
|
|
|
|
/* Pad with spaces. */
|
|
|
|
memset (&dest[src_len], ' ', dest_len - src_len);
|
2007-05-26 23:15:22 +02:00
|
|
|
return src_len;
|
2004-05-13 08:41:07 +02:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2014-05-22 05:51:25 +02:00
|
|
|
#ifndef HAVE_STRNLEN
|
|
|
|
static size_t
|
|
|
|
strnlen (const char *s, size_t maxlen)
|
|
|
|
{
|
|
|
|
for (size_t ii = 0; ii < maxlen; ii++)
|
|
|
|
{
|
|
|
|
if (s[ii] == '\0')
|
|
|
|
return ii;
|
|
|
|
}
|
|
|
|
return maxlen;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
|
|
|
#ifndef HAVE_STRNDUP
|
|
|
|
static char *
|
|
|
|
strndup (const char *s, size_t n)
|
|
|
|
{
|
|
|
|
size_t len = strnlen (s, n);
|
|
|
|
char *p = malloc (len + 1);
|
|
|
|
if (!p)
|
|
|
|
return NULL;
|
|
|
|
memcpy (p, s, len);
|
|
|
|
p[len] = '\0';
|
|
|
|
return p;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
|
|
|
/* Duplicate a non-null-terminated Fortran string to a malloced
|
|
|
|
null-terminated C string. */
|
|
|
|
|
|
|
|
char *
|
|
|
|
fc_strdup (const char *src, gfc_charlen_type src_len)
|
|
|
|
{
|
|
|
|
gfc_charlen_type n = fstrlen (src, src_len);
|
|
|
|
char *p = strndup (src, n);
|
|
|
|
if (!p)
|
|
|
|
os_error ("Memory allocation failed in fc_strdup");
|
|
|
|
return p;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2014-11-13 13:05:01 +01:00
|
|
|
/* Duplicate a non-null-terminated Fortran string to a malloced
|
|
|
|
null-terminated C string, without getting rid of trailing
|
|
|
|
blanks. */
|
|
|
|
|
|
|
|
char *
|
|
|
|
fc_strdup_notrim (const char *src, gfc_charlen_type src_len)
|
|
|
|
{
|
|
|
|
char *p = strndup (src, src_len);
|
|
|
|
if (!p)
|
|
|
|
os_error ("Memory allocation failed in fc_strdup");
|
|
|
|
return p;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
/* 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
|
2007-05-26 23:15:22 +02:00
|
|
|
find_option (st_parameter_common *cmp, const char *s1, gfc_charlen_type s1_len,
|
re PR fortran/14943 (read/write code generation is not thread safe)
gcc/fortran/
PR fortran/14943
PR fortran/21647
* Make-lang.in (fortran/trans-io.o): Depend on fortran/ioparm.def.
* dump-parse-tree.c (gfc_show_code_node): Dump c->block for
EXEC_{READ,WRITE,IOLENGTH} nodes.
* io.c (terminate_io, match_io, gfc_match_inquire): Put data
transfer commands into EXEC_{READ,WRITE,IOLENGTH}'s code->block.
* resolve.c (resolve_blocks): Handle EXEC_{READ,WRITE,IOLENGTH}.
* trans-io.c (ioparm_unit, ioparm_err, ioparm_end, ioparm_eor,
ioparm_list_format, ioparm_library_return, ioparm_iostat,
ioparm_exist, ioparm_opened, ioparm_number, ioparm_named,
ioparm_rec, ioparm_nextrec, ioparm_size, ioparm_recl_in,
ioparm_recl_out, ioparm_iolength, ioparm_file, ioparm_file_len,
ioparm_status, ioparm_status_len, ioparm_access, ioparm_access_len,
ioparm_form, ioparm_form_len, ioparm_blank, ioparm_blank_len,
ioparm_position, ioparm_position_len, ioparm_action,
ioparm_action_len, ioparm_delim, ioparm_delim_len, ioparm_pad,
ioparm_pad_len, ioparm_format, ioparm_format_len, ioparm_advance,
ioparm_advance_len, ioparm_name, ioparm_name_len,
ioparm_internal_unit, ioparm_internal_unit_len,
ioparm_internal_unit_desc, ioparm_sequential, ioparm_sequential_len,
ioparm_direct, ioparm_direct_len, ioparm_formatted,
ioparm_formatted_len, ioparm_unformatted, ioparm_unformatted_len,
ioparm_read, ioparm_read_len, ioparm_write, ioparm_write_len,
ioparm_readwrite, ioparm_readwrite_len, ioparm_namelist_name,
ioparm_namelist_name_len, ioparm_namelist_read_mode, ioparm_iomsg,
ioparm_iomsg_len, ioparm_var): Remove.
(enum ioparam_type, enum iofield_type, enum iofield,
enum iocall): New enums.
(gfc_st_parameter_field, gfc_st_parameter): New typedefs.
(st_parameter, st_parameter_field, iocall): New variables.
(ADD_FIELD, ADD_STRING): Remove.
(dt_parm, dt_post_end_block): New variables.
(gfc_build_st_parameter): New function.
(gfc_build_io_library_fndecls): Use it. Initialize iocall
array rather than ioparm_*, add extra first arguments to
the function types.
(set_parameter_const): New function.
(set_parameter_value): Add type argument, return a bitmask.
Changed to set a field in automatic structure variable rather
than set a field in a global _gfortran_ioparm variable.
(set_parameter_ref): Likewise. If requested var has different
size than what field should point to, call with a temporary and
then copy into the user variable. Add postblock argument.
(set_string): Remove var_len argument, add type argument, return
a bitmask. Changed to set fields in automatic structure variable
rather than set a field in a global _gfortran_ioparm variable.
(set_internal_unit): Remove iunit, iunit_len, iunit_desc arguments,
add var argument. Return a bitmask. Changed to set fields in
automatic structure variable rather than set a field in a global
_gfortran_ioparm variable.
(set_flag): Removed.
(io_result): Add var argument. Changed to read common.flags field
from automatic structure variable and bitwise AND it with 3.
(set_error_locus): Add var argument. Changed to set fields in
automatic structure variable rather than set a field in a global
_gfortran_{filename,line} variables.
(gfc_trans_open): Use gfc_start_block rather than gfc_init_block.
Create a temporary st_parameter_* structure. Adjust callers of
all above mentioned functions. Pass address of the temporary
variable as first argument to the generated function call.
Use iocall array rather than ioparm_* separate variables.
(gfc_trans_close, build_filepos, gfc_trans_inquire): Likewise.
(build_dt): Likewise. Change first argument to tree from tree *.
Don't dereference code->ext.dt if last_dt == INQUIRE. Emit
IOLENGTH argument setup here. Set dt_parm/dt_post_end_block
variables and gfc_trans_code the nested data transfer commands
in code->block.
(gfc_trans_iolength): Just set last_dt and call build_dt immediately.
(transfer_namelist_element): Pass address of dt_parm variable
to generated functions. Use iocall array rather than ioparm_*
separate variables.
(gfc_trans_backspace, gfc_trans_endfile, gfc_trans_rewind,
gfc_trans_flush, gfc_trans_read, gfc_trans_write): Use iocall array
rather than ioparm_* separate variables.
(gfc_trans_dt_end): Likewise. Pass address of dt_parm variable
as first argument to generated function. Adjust io_result caller.
Prepend dt_post_end_block before io_result code.
(transfer_expr): Use iocall array rather than ioparm_* separate
variables. Pass address of dt_parm variables as first argument
to generated functions.
* ioparm.def: New file.
gcc/testsuite/
PR fortran/24774
* gfortran.dg/inquire_9.f90: New test.
PR fortran/21647
* gfortran.fortran-torture/execute/inquire_5.f90: New test.
libgfortran/
PR fortran/24774
PR fortran/14943
PR fortran/21647
* Makefile.am (AM_CPPFLAGS): Add gcc directories as -I paths,
add -D_GNU_SOURCE.
* Makefile.in: Regenerated.
* acinclude.m4 (LIBGFOR_CHECK_SYNC_FETCH_AND_ADD,
LIBGFOR_CHECK_GTHR_DEFAULT, LIBGFOR_CHECK_PRAGMA_WEAK): New macros.
* configure.ac: Add them.
* configure: Rebuilt.
* config.h.in: Rebuilt.
* libtool-version: Bump libgfortran.so SONAME to libgfortran.so.1.
* libgfortran.h (library_start, show_locus, internal_error,
generate_error, find_option): Add st_parameter_common * argument.
(library_end): Change into a dummy macro.
* io/io.h: Include gthr.h.
(SUPPORTS_WEAK): Define if HAVE_PRAGMA_WEAK.
(CHARACTER): Remove define.
(st_parameter, global_t): Remove typedef.
(ioparm, g, ionml, current_unit): Remove variables.
(init_error_stream): Remove prototype.
(CHARACTER1, CHARACTER2): Define.
(st_parameter_common, st_parameter_open, st_parameter_close,
st_parameter_filepos, st_parameter_inquire, st_parameter_dt): New
typedefs.
(IOPARM_LIBRETURN_MASK, IOPARM_LIBRETURN_OK, IOPARM_LIBRETURN_ERROR,
IOPARM_LIBRETURN_END, IOPARM_LIBRETURN_EOR, IOPARM_ERR, IOPARM_END,
IOPARM_EOR, IOPARM_HAS_IOSTAT, IOPARM_HAS_IOMSG, IOPARM_COMMON_MASK,
IOPARM_OPEN_HAS_RECL_IN, IOPARM_OPEN_HAS_FILE, IOPARM_OPEN_HAS_STATUS,
IOPARM_OPEN_HAS_ACCESS, IOPARM_OPEN_HAS_FORM, IOPARM_OPEN_HAS_BLANK,
IOPARM_OPEN_HAS_POSITION, IOPARM_OPEN_HAS_ACTION,
IOPARM_OPEN_HAS_DELIM, IOPARM_OPEN_HAS_PAD, IOPARM_CLOSE_HAS_STATUS,
IOPARM_INQUIRE_HAS_EXIST, IOPARM_INQUIRE_HAS_OPENED,
IOPARM_INQUIRE_HAS_NUMBER, IOPARM_INQUIRE_HAS_NAMED,
IOPARM_INQUIRE_HAS_NEXTREC, IOPARM_INQUIRE_HAS_RECL_OUT,
IOPARM_INQUIRE_HAS_FILE, IOPARM_INQUIRE_HAS_ACCESS,
IOPARM_INQUIRE_HAS_FORM, IOPARM_INQUIRE_HAS_BLANK,
IOPARM_INQUIRE_HAS_POSITION, IOPARM_INQUIRE_HAS_ACTION,
IOPARM_INQUIRE_HAS_DELIM, IOPARM_INQUIRE_HAS_PAD,
IOPARM_INQUIRE_HAS_NAME, IOPARM_INQUIRE_HAS_SEQUENTIAL,
IOPARM_INQUIRE_HAS_DIRECT, IOPARM_INQUIRE_HAS_FORMATTED,
IOPARM_INQUIRE_HAS_UNFORMATTED, IOPARM_INQUIRE_HAS_READ,
IOPARM_INQUIRE_HAS_WRITE, IOPARM_INQUIRE_HAS_READWRITE,
IOPARM_DT_LIST_FORMAT, IOPARM_DT_NAMELIST_READ_MODE,
IOPARM_DT_HAS_REC, IOPARM_DT_HAS_SIZE, IOPARM_DT_HAS_IOLENGTH,
IOPARM_DT_HAS_FORMAT, IOPARM_DT_HAS_ADVANCE,
IOPARM_DT_HAS_INTERNAL_UNIT, IOPARM_DT_HAS_NAMELIST_NAME,
IOPARM_DT_IONML_SET): Define.
(gfc_unit): Add lock, waiting and close fields. Change file
from flexible array member into pointer to char.
(open_external): Add st_parameter_open * argument.
(find_file, file_exists): Add file and file_len arguments.
(flush_all_units): New prototype.
(max_offset, unit_root, unit_lock): New variable.
(is_internal_unit, is_array_io, next_array_record,
parse_format, next_format, unget_format, format_error,
read_block, write_block, next_record, convert_real,
read_a, read_f, read_l, read_x, read_radix, read_decimal,
list_formatted_read, finish_list_read, namelist_read,
namelist_write, write_a, write_b, write_d, write_e, write_en,
write_es, write_f, write_i, write_l, write_o, write_x, write_z,
list_formatted_write, get_unit): Add st_parameter_dt * argument.
(insert_unit): Remove prototype.
(find_or_create_unit, unlock_unit): New prototype.
(new_unit): Return gfc_unit *. Add st_parameter_open *
and gfc_unit * arguments.
(free_fnodes): Remove prototype.
(free_format_data): New prototype.
(scratch): Remove.
(init_at_eol): Remove prototype.
(free_ionml): New prototype.
(inc_waiting_locked, predec_waiting_locked, dec_waiting_unlocked):
New inline functions.
* io/unit.c (max_offset, unit_root, unit_lock): New variables.
(insert): Adjust os_error caller.
(insert_unit): Made static. Allocate memory here, initialize
lock and after inserting it return it, locked.
(delete_unit): Adjust for deletion of g.
(find_unit_1): New function.
(find_unit): Use it.
(find_or_create_unit): New function.
(get_unit): Add dtp argument, change meaning of the int argument
as creation request flag. Adjust for different st_* calling
conventions, lock internal unit's lock before returning it
and removal of g. Call find_unit_1 instead of find_unit.
(is_internal_unit, is_array_io): Add dtp argument, adjust for
removal of most of global variables.
(init_units): Initialize unit_lock. Adjust insert_unit callers
and adjust for g removal.
(close_unit_1): New function.
(close_unit): Use it.
(unlock_unit): New function.
(close_units): Lock unit_lock, use close_unit_1 rather than
close_unit.
* io/close.c (st_close): Add clp argument. Adjust for new
st_* calling conventions and internal function API changes.
* io/file_pos.c (st_backspace, st_endfile, st_rewind, st_flush):
Add fpp argument. Adjust for new st_* calling conventions and
internal function API changes.
(formatted_backspace, unformatted_backspace): Likewise. Add
u argument.
* io/open.c (edit_modes, st_open): Add opp argument. Adjust for
new st_* calling conventions and internal function API changes.
(already_open): Likewise. If not HAVE_UNLINK_OPEN_FILE, unlink
scratch file. Instead of calling close_unit just call sclose,
free u->file if any and clear a few u fields before calling
new_unit.
(new_unit): Return gfc_unit *. Add opp and u arguments.
Adjust for new st_* calling conventions and internal function
API changes. Don't allocate unit here, rather than work with
already created unit u already locked on entry. In case
of failure, close_unit it.
* io/unix.c: Include unix.h.
(BUFFER_SIZE, unix_stream): Moved to unix.h.
(unit_to_fd): Add unlock_unit call.
(tempfile): Add opp argument, use its fields rather than ioparm.
(regular_file): Likewise.
(open_external): Likewise. Only unlink file if fd >= 0.
(init_error_stream): Add error argument, set structure it points
to rather than filling static variable and returning its address.
(FIND_FILE0_DECL, FIND_FILE0_ARGS): Define.
(find_file0): Use them. Don't crash if u->s == NULL.
(find_file): Add file and file_len arguments, use them instead
of ioparm. Add locking. Pass either an array of 2 struct stat
or file and file_len pair to find_file0.
(flush_all_units_1, flush_all_units): New functions.
(file_exists): Add file and file_len arguments, use them instead
of ioparm.
* io/unix.h: New file.
* io/lock.c (ioparm, g, ionml): Remove variables.
(library_start): Add cmp argument, adjust for new st_* calling
conventions.
(library_end): Remove.
(free_ionml): New function.
* io/inquire.c (inquire_via_unit, inquire_via_filename,
st_inquire): Add iqp argument, adjust for new st_* calling
conventions and internal function API changes.
* io/format.c (FARRAY_SIZE): Decrease to 64.
(fnode_array, format_data): New typedefs.
(avail, array, format_string, string, error, saved_token, value,
format_string_len, reversion_ok, saved_format): Remove variables.
(colon_node): Add const.
(free_fnode, free_fnodes): Remove.
(free_format_data): New function.
(next_char, unget_char, get_fnode, format_lex, parse_format_list,
format_error, parse_format, revert, unget_format, next_test): Add
fmt or dtp arguments, pass it all around, adjust for internal
function API changes and adjust for removal of global variables.
(next_format): Likewise. Constify return type.
(next_format0): Constify return type.
* io/transfer.c (current_unit, sf_seen_eor, eor_condition, max_pos,
skips, pending_spaces, scratch, line_buffer, advance_status,
transfer): Remove variables.
(transfer_integer, transfer_real, transfer_logical,
transfer_character, transfer_complex, transfer_array, current_mode,
read_sf, read_block, read_block_direct, write_block,
write_block_direct, unformatted_read, unformatted_write,
type_name, write_constant_string, require_type,
formatted_transfer_scalar, us_read, us_write, pre_position,
data_transfer_init, next_record_r, next_record_w, next_record,
finalize_transfer, iolength_transfer, iolength_transfer_init,
st_iolength, st_iolength_done, st_read, st_read_done, st_write,
st_write_done, st_set_nml_var, st_set_nml_var_dim,
next_array_record): Add dtp argument, pass it all around, adjust for
internal function API changes and removal of global variables.
* io/list_read.c (repeat_count, saved_length, saved_used,
input_complete, at_eol, comma_flag, last_char, saved_string,
saved_type, namelist_mode, nml_read_error, value, parse_err_msg,
nml_err_msg, prev_nl): Remove variables.
(push_char, free_saved, next_char, unget_char, eat_spaces,
eat_separator, finish_separator, nml_bad_return, convert_integer,
parse_repeat, read_logical, read_integer, read_character,
parse_real, read_complex, read_real, check_type,
list_formatted_read_scalar, list_formatted_read, finish_list_read,
find_nml_node, nml_untouch_nodes, nml_match_name, nml_query,
namelist_read): Add dtp argument, pass it all around, adjust for
internal function API changes and removal of global variables.
(nml_parse_qualifier): Likewise. Add parse_err_msg argument.
(nml_read_obj): Likewise. Add pprev_nl, nml_err_msg, clow and
chigh arguments.
(nml_get_obj_data): Likewise. Add pprev_nl and nml_err_msg
arguments.
(init_at_eol): Removed.
* io/read.c (convert_real, read_l, read_a, next_char, read_decimal,
read_radix, read_f, read_x): Add dtp argument, pass it all around,
adjust for internal function API changes and removal of global
variables.
(set_integer): Adjust internal_error caller.
* io/write.c (no_leading_blank, nml_delim): Remove variables.
(write_a, calculate_sign, calculate_G_format, output_float,
write_l, write_float, write_int, write_decimal, write_i, write_b,
write_o, write_z, write_d, write_e, write_f, write_en, write_es,
write_x, write_char, write_logical, write_integer, write_character,
write_real, write_complex, write_separator,
list_formatted_write_scalar, list_formatted_write, nml_write_obj,
namelist_write): Add dtp argument, pass it all around, adjust for
internal function API changes and removal of global variables.
(extract_int, extract_uint, extract_real): Adjust internal_error
callers.
* runtime/fpu.c (_GNU_SOURCE): Don't define here.
* runtime/error.c: Include ../io/unix.h.
(filename, line): Remove variables.
(st_printf): Pass address of a local variable to init_error_stream.
(show_locus): Add cmp argument. Use fields it points to rather than
filename and line variables.
(os_error, runtime_error): Remove show_locus calls.
(internal_error): Add cmp argument. Pass it down to show_locus.
(generate_error): Likewise. Use flags bitmask instead of non-NULL
check for iostat and iomsg parameter presence, adjust for st_*
calling convention changes.
* runtime/stop.c (stop_numeric, stop_string): Remove show_locus
calls.
* runtime/pause.c (pause_numeric, pause_string): Likewise.
* runtime/string.c: Include ../io/io.h.
(find_option): Add cmp argument. Pass it down to generate_error.
* intrinsics/flush.c (recursive_flush): Remove.
(flush_i4, flush_i8): Use flush_all_units. Add unlock_unit
call.
* intrinsics/rand.c: Include ../io/io.h.
(rand_seed_lock): New variable.
(srand, irand): Add locking.
(init): New constructor function.
* intrinsics/random.c: Include ../io/io.h.
(random_lock): New variable.
(random_r4, random_r8, arandom_r4, arandom_r8): Add locking.
(random_seed): Likewise. open failed if fd < 0. Set i correctly.
(init): New constructor function.
* intrinsics/system_clock.c (tp0, t0): Remove.
(system_clock_4, system_clock_8): Don't subtract tp0/t0 from current
time, use just integer arithmetics.
* intrinsics/tty.c (isatty_l4, isatty_l8, ttynam_sub): Add
unlock_unit calls.
From-SVN: r107328
2005-11-21 23:03:56 +01:00
|
|
|
const st_option * opts, const char *error_message)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2010-09-10 14:19:57 +02:00
|
|
|
/* Strip trailing blanks from the Fortran string. */
|
|
|
|
size_t len = (size_t) fstrlen (s1, s1_len);
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
for (; opts->name; opts++)
|
2010-09-10 14:19:57 +02:00
|
|
|
if (len == strlen(opts->name) && strncasecmp (s1, opts->name, len) == 0)
|
2004-05-13 08:41:07 +02:00
|
|
|
return opts->value;
|
|
|
|
|
re PR fortran/31675 (Fortran front-end and libgfortran should have a common header file)
PR fortran/31675
* libgfortran.h: New file.
* iso-fortran-env.def: Use macros in the new header instead of
hardcoded integer constants.
* Make-lang.in (F95_PARSER_OBJS, GFORTRAN_TRANS_DEPS): Add
fortran/libgfortran.h.
* gfortran.h (GFC_STD_*, GFC_FPE_*, options_convert,
ioerror_codes): Remove.
* trans.c (ERROR_ALLOCATION): Remove.
(gfc_call_malloc, gfc_allocate_with_status,
gfc_allocate_array_with_status): Use LIBERROR_ALLOCATION.
* trans-types.h (GFC_DTYPE_*): Remove.
* trans-decl.c (gfc_generate_function_code): Use
GFC_CONVERT_NATIVE instead of CONVERT_NATIVE.
* trans-io.c (set_parameter_value, set_parameter_ref): Use
LIBERROR_* macros instead of IOERROR_ macros.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Use
LIBERROR_END and LIBERROR_EOR instead of hardcoded constants.
* options.c (gfc_init_options): Use GFC_CONVERT_NATIVE instead of
CONVERT_NATIVE.
(gfc_handle_option): Use GFC_CONVERT_* macros instead of CONVERT_*.
* libgfortran.h: Include gcc/fortran/libgfortran.h.
Remove M_PI, GFC_MAX_DIMENSIONS, GFC_DTYPE_*, GFC_NUM_RANK_BITS,
error_codes, GFC_STD_*, GFC_FPE_* and unit_convert.
* runtime/environ.c (variable_table): Use GFC_*_UNIT_NUMBER instead
of hardcoded constants.
(do_parse, init_unformatted): Use GFC_CONVERT_* macros instead of
CONVERT_*.
* runtime/string.c (find_option): Use LIBERROR_BAD_OPTION instead
of ERROR_BAD_OPTION.
* runtime/error.c (translate_error, generate_error): Use
LIBERROR_* macros instead of ERROR_*.
* io/file_pos.c (formatted_backspace, unformatted_backspace,
st_backspace, st_rewind, st_flush): Rename macros.
* io/open.c (convert_opt, edit_modes, new_unit, already_open,
st_open): Likewise.
* io/close.c (st_close): Likewise.
* io/list_read.c (next_char, convert_integer, parse_repeat,
read_logical, read_integer, read_character, parse_real,
check_type, list_formatted_read_scalar, namelist_read,
nml_err_ret): Likewise.
* io/read.c (convert_real, read_l, read_decimal, read_radix,
read_f): Likewise.
* io/inquire.c (inquire_via_unit): Likewise.
* io/unit.c (get_internal_unit): Likewise.
* io/transfer.c (read_sf, read_block, read_block_direct,
write_block, write_buf, unformatted_read, unformatted_write,
formatted_transfer_scalar, us_read, us_write, data_transfer_init,
skip_record, next_record_r, write_us_marker, next_record_w_unf,
next_record_w, finalize_transfer, st_read, st_write_done):
Likewise.
* io/format.c (format_error): Likewise.
From-SVN: r128050
2007-09-03 18:44:15 +02:00
|
|
|
generate_error (cmp, LIBERROR_BAD_OPTION, error_message);
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
return -1;
|
|
|
|
}
|
2015-09-02 16:51:40 +02:00
|
|
|
|
|
|
|
|
|
|
|
/* gfc_itoa()-- Integer to decimal conversion.
|
|
|
|
The itoa function is a widespread non-standard extension to
|
|
|
|
standard C, often declared in <stdlib.h>. Even though the itoa
|
|
|
|
defined here is a static function we take care not to conflict with
|
|
|
|
any prior non-static declaration. Hence the 'gfc_' prefix, which
|
|
|
|
is normally reserved for functions with external linkage. Notably,
|
|
|
|
in contrast to the *printf() family of functions, this ought to be
|
|
|
|
async-signal-safe. */
|
|
|
|
|
|
|
|
const char *
|
|
|
|
gfc_itoa (GFC_INTEGER_LARGEST n, char *buffer, size_t len)
|
|
|
|
{
|
|
|
|
int negative;
|
|
|
|
char *p;
|
|
|
|
GFC_UINTEGER_LARGEST t;
|
|
|
|
|
|
|
|
if (len < GFC_ITOA_BUF_SIZE)
|
|
|
|
sys_abort ();
|
|
|
|
|
|
|
|
if (n == 0)
|
|
|
|
return "0";
|
|
|
|
|
|
|
|
negative = 0;
|
|
|
|
t = n;
|
|
|
|
if (n < 0)
|
|
|
|
{
|
|
|
|
negative = 1;
|
|
|
|
t = -n; /*must use unsigned to protect from overflow*/
|
|
|
|
}
|
|
|
|
|
|
|
|
p = buffer + GFC_ITOA_BUF_SIZE - 1;
|
|
|
|
*p = '\0';
|
|
|
|
|
|
|
|
while (t != 0)
|
|
|
|
{
|
|
|
|
*--p = '0' + (t % 10);
|
|
|
|
t /= 10;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (negative)
|
|
|
|
*--p = '-';
|
|
|
|
return p;
|
|
|
|
}
|