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/intrinsics/exit.c | 49 ++++++++++++++++++++++++ libgfortran/intrinsics/umask.c | 75 ++++++++++++++++++++++++++++++++++++ libgfortran/intrinsics/unlink.c | 85 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 209 insertions(+) create mode 100644 libgfortran/intrinsics/exit.c create mode 100644 libgfortran/intrinsics/umask.c create mode 100644 libgfortran/intrinsics/unlink.c (limited to 'libgfortran/intrinsics') 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