1181254a7Smrg /* Implementation of the UMASK intrinsic.
2*b1e83836Smrg Copyright (C) 2004-2022 Free Software Foundation, Inc.
3181254a7Smrg Contributed by Steven G. Kargl <kargls@comcast.net>.
4181254a7Smrg
5181254a7Smrg This file is part of the GNU Fortran runtime library (libgfortran).
6181254a7Smrg
7181254a7Smrg Libgfortran is free software; you can redistribute it and/or
8181254a7Smrg modify it under the terms of the GNU General Public
9181254a7Smrg License as published by the Free Software Foundation; either
10181254a7Smrg version 3 of the License, or (at your option) any later version.
11181254a7Smrg
12181254a7Smrg Libgfortran is distributed in the hope that it will be useful,
13181254a7Smrg but WITHOUT ANY WARRANTY; without even the implied warranty of
14181254a7Smrg MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15181254a7Smrg GNU General Public License for more details.
16181254a7Smrg
17181254a7Smrg Under Section 7 of GPL version 3, you are granted additional
18181254a7Smrg permissions described in the GCC Runtime Library Exception, version
19181254a7Smrg 3.1, as published by the Free Software Foundation.
20181254a7Smrg
21181254a7Smrg You should have received a copy of the GNU General Public License and
22181254a7Smrg a copy of the GCC Runtime Library Exception along with this program;
23181254a7Smrg see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24181254a7Smrg <http://www.gnu.org/licenses/>. */
25181254a7Smrg
26181254a7Smrg
27181254a7Smrg #include "libgfortran.h"
28181254a7Smrg
29181254a7Smrg #ifdef HAVE_SYS_STAT_H
30181254a7Smrg #include <sys/stat.h>
31181254a7Smrg #endif
32181254a7Smrg
33181254a7Smrg
34181254a7Smrg /* SUBROUTINE UMASK(MASK, OLD)
35181254a7Smrg INTEGER, INTENT(IN) :: MASK
36181254a7Smrg INTEGER, INTENT(OUT), OPTIONAL :: OLD */
37181254a7Smrg
38181254a7Smrg extern void umask_i4_sub (GFC_INTEGER_4 *, GFC_INTEGER_4 *);
39181254a7Smrg iexport_proto(umask_i4_sub);
40181254a7Smrg
41181254a7Smrg void
umask_i4_sub(GFC_INTEGER_4 * mask,GFC_INTEGER_4 * old)42181254a7Smrg umask_i4_sub (GFC_INTEGER_4 *mask, GFC_INTEGER_4 *old)
43181254a7Smrg {
44181254a7Smrg mode_t val = umask((mode_t) *mask);
45181254a7Smrg if (old != NULL)
46181254a7Smrg *old = (GFC_INTEGER_4) val;
47181254a7Smrg }
48181254a7Smrg iexport(umask_i4_sub);
49181254a7Smrg
50181254a7Smrg extern void umask_i8_sub (GFC_INTEGER_8 *, GFC_INTEGER_8 *);
51181254a7Smrg iexport_proto(umask_i8_sub);
52181254a7Smrg
53181254a7Smrg void
umask_i8_sub(GFC_INTEGER_8 * mask,GFC_INTEGER_8 * old)54181254a7Smrg umask_i8_sub (GFC_INTEGER_8 *mask, GFC_INTEGER_8 *old)
55181254a7Smrg {
56181254a7Smrg mode_t val = umask((mode_t) *mask);
57181254a7Smrg if (old != NULL)
58181254a7Smrg *old = (GFC_INTEGER_8) val;
59181254a7Smrg }
60181254a7Smrg iexport(umask_i8_sub);
61181254a7Smrg
62181254a7Smrg /* INTEGER FUNCTION UMASK(MASK)
63181254a7Smrg INTEGER, INTENT(IN) :: MASK */
64181254a7Smrg
65181254a7Smrg extern GFC_INTEGER_4 umask_i4 (GFC_INTEGER_4 *);
66181254a7Smrg export_proto(umask_i4);
67181254a7Smrg
68181254a7Smrg GFC_INTEGER_4
umask_i4(GFC_INTEGER_4 * mask)69181254a7Smrg umask_i4 (GFC_INTEGER_4 *mask)
70181254a7Smrg {
71181254a7Smrg GFC_INTEGER_4 old;
72181254a7Smrg umask_i4_sub (mask, &old);
73181254a7Smrg return old;
74181254a7Smrg }
75181254a7Smrg
76181254a7Smrg extern GFC_INTEGER_8 umask_i8 (GFC_INTEGER_8 *);
77181254a7Smrg export_proto(umask_i8);
78181254a7Smrg
79181254a7Smrg GFC_INTEGER_8
umask_i8(GFC_INTEGER_8 * mask)80181254a7Smrg umask_i8 (GFC_INTEGER_8 *mask)
81181254a7Smrg {
82181254a7Smrg GFC_INTEGER_8 old;
83181254a7Smrg umask_i8_sub (mask, &old);
84181254a7Smrg return old;
85181254a7Smrg }
86