From d8fe26b2cd7073e13d2a4c8bc0d4f4d310050ce1 Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Sat, 20 Nov 2004 01:44:49 +0000 Subject: check.c (gfc_check_getcwd_sub): Fix seg fault. * check.c (gfc_check_getcwd_sub): Fix seg fault. * check.c (gfc_check_exit,gfc_check_umask,gfc_check_umask_sub, gfc_check_unlink,gfc_check_unlink_sub): New functions * gfortran.h (GFC_ISYM_UMASK,GFC_ISYM_UNLINK): New symbols * intrinsic.c (add_functions,add_subroutines): Add umask, unlink, exit to intrinsics symbol tables. * intrinsic.h (gfc_check_umask,gfc_check_unlink,gfc_check_exit, gfc_check_umask_sub,gfc_check_unlink_sub,gfc_resolve_umask, gfc_resolve_unlink,gfc_resolve_exit,gfc_resolve_umask_sub, gfc_resolve_unlink_sub): Add and sort prototypes. * iresolve.c (gfc_resolve_umask,gfc_resolve_unlink,gfc_resolve_exit, gfc_resolve_umask_sub,gfc_resolve_unlink_sub): New functions * trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbols libgfortran/ * Makefile.am: Add intrinsics/{umask.c,unlink.c,exit.c} * Makefile.in: Regenerated * intrinsics/umask.c: New file * intrinsics/unlink.c: ditto * intrinsics/exit.c: ditto From-SVN: r90949 --- libgfortran/ChangeLog | 34 ++++++++++------- libgfortran/Makefile.am | 3 ++ libgfortran/intrinsics/exit.c | 49 ++++++++++++++++++++++++ libgfortran/intrinsics/umask.c | 75 ++++++++++++++++++++++++++++++++++++ libgfortran/intrinsics/unlink.c | 85 +++++++++++++++++++++++++++++++++++++++++ 5 files changed, 233 insertions(+), 13 deletions(-) create mode 100644 libgfortran/intrinsics/exit.c create mode 100644 libgfortran/intrinsics/umask.c create mode 100644 libgfortran/intrinsics/unlink.c (limited to 'libgfortran') diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 15315d2..3324b0f 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,11 @@ +2004-11-20 Steven G. Kargl + + * Makefile.am: Add intrinsics/{umask.c,unlink.c,exit.c} + * Makefile.in: Regenerated + * intrinsics/umask.c: New file + * intrinsics/unlink.c: ditto + * intrinsics/exit.c: ditto + 2004-11-18 Victor Leikehman * m4/matmul.m4: Loops reordered to improve cache behavior. @@ -273,7 +281,7 @@ PR fortran/17143 * runtime/error.c (itoa): keep from overflowing during - mod operation by using unsigned variable. + mod operation by using unsigned variable. 2004-08-24 Bud Davis @@ -545,9 +553,9 @@ PR gfortran/14897 * io/transfer.c (formatted_transfer): position is unique - for T and TL edit descriptors. + for T and TL edit descriptors. (data_transfer_init): set record length to size of internal - file. + file. 2004-06-09 Bud Davis @@ -743,7 +751,7 @@ PR fortran/14906 * io/format.c (format_item): gracefully handle a ')' - when it is the first character encountered in the string. + when it is the first character encountered in the string. 2004-04-11 Bud Davis @@ -809,7 +817,7 @@ PR 13919 * io/io.h (global_t): * io/list_read.c (next_char,list_formatted_read,ist_formatted_read): - Move eof_jmp to a global structure. + Move eof_jmp to a global structure. * io/transfer.c(finalize_transfer) : Set up eof_jump for callers. 2004-03-24 Bud Davis @@ -1233,14 +1241,14 @@ 2003-04-11 Xiaoqiang Zhang - * io/write.c (extract_real): Ouput floating point value. - (write_float): New Function. - (write_e, write_f, write_en, write_es): Modified - * io/transfer.c (formatted_transfer): Modified. - * libgfor.h (default_rtoa): Declaration. - (rtoa): Declaration. - * runtime/error.c (default_rtoa): New Function. - (rtoa): New Function. + * io/write.c (extract_real): Ouput floating point value. + (write_float): New Function. + (write_e, write_f, write_en, write_es): Modified + * io/transfer.c (formatted_transfer): Modified. + * libgfor.h (default_rtoa): Declaration. + (rtoa): Declaration. + * runtime/error.c (default_rtoa): New Function. + (rtoa): New Function. 2003-04-05 Paul Brook diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index df6335e..50a3dac 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -50,6 +50,7 @@ intrinsics/erf.c \ intrinsics/eoshift0.c \ intrinsics/eoshift2.c \ intrinsics/etime.c \ +intrinsics/exit.c \ intrinsics/getcwd.c \ intrinsics/getXid.c \ intrinsics/ishftc.c \ @@ -67,6 +68,8 @@ intrinsics/selected_int_kind.f90 \ intrinsics/selected_real_kind.f90 \ intrinsics/system_clock.c \ intrinsics/transpose_generic.c \ +intrinsics/umask.c \ +intrinsics/unlink.c \ intrinsics/unpack_generic.c \ runtime/in_pack_generic.c \ runtime/in_unpack_generic.c \ diff --git a/libgfortran/intrinsics/exit.c b/libgfortran/intrinsics/exit.c new file mode 100644 index 0000000..6ae4dfd --- /dev/null +++ b/libgfortran/intrinsics/exit.c @@ -0,0 +1,49 @@ +/* Implementation of the EXIT intrinsic. + Copyright (C) 2004 Free Software Foundation, Inc. + Contributed by Steven G. Kargl . + +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 Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 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 Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + + +#include "config.h" +#include "libgfortran.h" + +#ifdef HAVE_STDLIB_H +#include +#endif + +/* SUBROUTINE EXIT(STATUS) + INTEGER, INTENT(IN), OPTIONAL :: STATUS */ + +void +prefix(exit_i4) (GFC_INTEGER_4 * status) +{ + + if (status == NULL) + exit(0); + exit(*status); +} + +void +prefix(exit_i8) (GFC_INTEGER_8 * status) +{ + + if (status == NULL) + exit(0); + exit((int) *status); +} diff --git a/libgfortran/intrinsics/umask.c b/libgfortran/intrinsics/umask.c new file mode 100644 index 0000000..cf41451 --- /dev/null +++ b/libgfortran/intrinsics/umask.c @@ -0,0 +1,75 @@ +/* Implementation of the UMASK intrinsic. + Copyright (C) 2004 Free Software Foundation, Inc. + Contributed by Steven G. Kargl . + +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 Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 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 Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + + +#include "config.h" +#include "libgfortran.h" + +#ifdef HAVE_STDLIB_H +#include +#endif + +#ifdef HAVE_SYS_STAT_H +#include +#endif + +/* SUBROUTINE UMASK(MASK, OLD) + INTEGER, INTENT(IN) :: MASK + INTEGER, INTENT(OUT), OPTIONAL :: OLD */ + +void +prefix(umask_i4_sub) (GFC_INTEGER_4 * mask, GFC_INTEGER_4 * old) +{ + mode_t val; + + val = umask((mode_t) *mask); + if (old != NULL) + *old = (GFC_INTEGER_4) val; +} + +void +prefix(umask_i8_sub) (GFC_INTEGER_8 * mask, GFC_INTEGER_8 * old) +{ + mode_t val; + + val = umask((mode_t) *mask); + if (old != NULL) + *old = (GFC_INTEGER_8) val; +} + +/* INTEGER FUNCTION UMASK(MASK) + INTEGER, INTENT(IN) :: MASK */ + +GFC_INTEGER_4 +prefix(umask) (GFC_INTEGER_4 * mask) +{ + GFC_INTEGER_4 old; + prefix(umask_i4_sub) (mask, &old); + return old; +} + +GFC_INTEGER_8 +prefix(umask_i8) (GFC_INTEGER_8 * mask) +{ + GFC_INTEGER_8 old; + prefix(umask_i8_sub) (mask, &old); + return old; +} diff --git a/libgfortran/intrinsics/unlink.c b/libgfortran/intrinsics/unlink.c new file mode 100644 index 0000000..11c3509 --- /dev/null +++ b/libgfortran/intrinsics/unlink.c @@ -0,0 +1,85 @@ +/* Implementation of the UNLINK intrinsic. + Copyright (C) 2004 Free Software Foundation, Inc. + Contributed by Steven G. Kargl . + +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 Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 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 Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include "libgfortran.h" + +#ifdef HAVE_UNISTD_H +#include +#endif +#ifdef HAVE_STRING_H +#include +#endif + +#include + +/* SUBROUTINE UNLINK(NAME, STATUS) + CHARACTER(LEN= ), INTENT(IN) :: NAME + INTEGER, INTENT(OUT), OPTIONAL :: STATUS) */ + +void +prefix(unlink_i4_sub) (char * name, GFC_INTEGER_4 * status, + gfc_charlen_type name_len) +{ + + char *str, *s; + GFC_INTEGER_4 stat; + + /* Trim trailing spaces from name. */ + while (name_len > 0 && name[name_len - 1] == ' ') + name_len--; + + /* Make a null terminated copy of the string. */ + str = gfc_alloca (name_len + 1); + memcpy (str, name, name_len); + str[name_len] = '\0'; + + stat = unlink (str); + + if (status != NULL) + *status = (stat == 0) ? stat : errno; +} + + +void +prefix(unlink_i8_sub) (char * name, GFC_INTEGER_8 * status, + gfc_charlen_type name_len) +{ + + GFC_INTEGER_4 status4; + + prefix (unlink_i4_sub) (name, &status4, name_len); + if (status) + *status = status4; +} + + +/* INTEGER FUNCTION UNLINK(NAME) + CHARACTER(LEN= ), INTENT(IN) :: NAME */ + +GFC_INTEGER_4 +prefix(unlink) (char * name, gfc_charlen_type name_len) +{ + GFC_INTEGER_4 status; + prefix(unlink_i4_sub) (name, &status, name_len); + return status; +} + -- cgit v1.1