gcc/m2/gm2-libs-ch/wrapc.c

   1 /* wrapc.c provide access to miscellaneous C library functions.
   2
   3 Copyright (C) 2005-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius@glam.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 Under Section 7 of GPL version 3, you are granted additional
  19 permissions described in the GCC Runtime Library Exception, version
  20 3.1, as published by the Free Software Foundation.
  21
  22 You should have received a copy of the GNU General Public License and
  23 a copy of the GCC Runtime Library Exception along with this program;
  24 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  25 <http://www.gnu.org/licenses/>.  */
  26
  27 #include "config.h"
  28 #include "system.h"
  29 #include "ansidecl.h"
  30 #include "math.h"
  31
  32 #include "gm2-libs-host.h"
  33
  34 #ifdef __cplusplus
  35 extern "C" {
  36 #endif
  37
  38 /* strtime - returns the address of a string which describes the
  39 local time.  */
  40
  41 char *
  42 wrapc_strtime (void)
  43 {
  44 #if defined(HAVE_CTIME)
  45   time_t clock = time ((time_t *)0);
  46   char *string = ctime (&clock);
  47
  48   string[24] = (char)0;
  49
  50   return string;
  51 #else
  52   return "";
  53 #endif
  54 }
  55
  56 int
  57 wrapc_filesize (int f, unsigned int *low, unsigned int *high)
  58 {
  59   struct stat s;
  60   int res = fstat (f, (struct stat *)&s);
  61
  62   if (res == 0)
  63     {
  64       *low = (unsigned int)s.st_size;
  65       *high = (unsigned int)(s.st_size >> (sizeof (unsigned int) * 8));
  66     }
  67   return res;
  68 }
  69
  70 /* filemtime - returns the mtime of a file, f.  */
  71
  72 int
  73 wrapc_filemtime (int f)
  74 {
  75   struct stat s;
  76
  77   if (fstat (f, (struct stat *)&s) == 0)
  78     return s.st_mtime;
  79   else
  80     return -1;
  81 }
  82
  83 /* fileinode - returns the inode associated with a file, f.  */
  84
  85 #if defined(HAVE_SYS_STAT_H)
  86 ino_t
  87 wrapc_fileinode (int f, unsigned int *low, unsigned int *high)
  88 {
  89   struct stat s;
  90
  91   if (fstat (f, (struct stat *)&s) == 0)
  92     {
  93       *low = (unsigned int)s.st_ino;
  94       *high = (unsigned int)(s.st_ino >> (sizeof (unsigned int) * 8));
  95       return 0;
  96     }
  97   else
  98     return -1;
  99 }
 100 #else
 101 int
 102 wrapc_fileinode (int f, unsigned int *low, unsigned int *high)
 103 {
 104 #error we need stat
 105   *low = 0;
 106   *high = 0;
 107   return -1;
 108 }
 109 #endif
 110
 111 /* getrand - returns a random number between 0..n-1 */
 112
 113 int
 114 wrapc_getrand (int n)
 115 {
 116   return rand () % n;
 117 }
 118
 119 #if defined(HAVE_PWD_H)
 120 #include <pwd.h>
 121
 122 char *
 123 wrapc_getusername (void)
 124 {
 125   return getpwuid (getuid ())->pw_gecos;
 126 }
 127
 128 /* getnameuidgid - fills in the, uid, and, gid, which represents
 129 user, name.  */
 130
 131 void
 132 wrapc_getnameuidgid (char *name, int *uid, int *gid)
 133 {
 134   struct passwd *p = getpwnam (name);
 135
 136   if (p == NULL)
 137     {
 138       *uid = -1;
 139       *gid = -1;
 140     }
 141   else
 142     {
 143       *uid = p->pw_uid;
 144       *gid = p->pw_gid;
 145     }
 146 }
 147 #else
 148 char *
 149 wrapc_getusername (void)
 150 {
 151   return "unknown";
 152 }
 153
 154 void
 155 wrapc_getnameuidgid (char *name, int *uid, int *gid)
 156 {
 157   *uid = -1;
 158   *gid = -1;
 159 }
 160 #endif
 161
 162 int
 163 wrapc_signbit (double r)
 164 {
 165 #if defined(HAVE_SIGNBIT)
 166
 167   /* signbit is a macro which tests its argument against sizeof(float),
 168   sizeof(double) */
 169   return signbit (r);
 170 #else
 171   return 0;
 172 #endif
 173 }
 174
 175 int
 176 wrapc_signbitl (long double r)
 177 {
 178 #if defined(HAVE_SIGNBITL)
 179
 180   /* signbit is a macro which tests its argument against sizeof(float),
 181   sizeof(double) */
 182   return signbitl (r);
 183 #else
 184   return 0;
 185 #endif
 186 }
 187
 188 int
 189 wrapc_signbitf (float r)
 190 {
 191 #if defined(HAVE_SIGNBITF)
 192
 193   /* signbit is a macro which tests its argument against sizeof(float),
 194   sizeof(double) */
 195   return signbitf (r);
 196 #else
 197   return 0;
 198 #endif
 199 }
 200
 201 /* isfinite - provide non builtin alternative to the gcc builtin
 202    isfinite.  Returns 1 if x is finite and 0 if it is not.  */
 203
 204 int
 205 wrapc_isfinite (double x)
 206 {
 207   return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
 208 }
 209
 210 /* isfinitel - provide non builtin alternative to the gcc builtin
 211    isfinite.  Returns 1 if x is finite and 0 if it is not.  */
 212
 213 int
 214 wrapc_isfinitel (long double x)
 215 {
 216   return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
 217 }
 218
 219 /* isfinitef - provide non builtin alternative to the gcc builtin
 220    isfinite.  Returns 1 if x is finite and 0 if it is not.  */
 221
 222 int
 223 wrapc_isfinitef (float x)
 224 {
 225   return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
 226 }
 227
 228 /* isnan - provide non builtin alternative to the gcc builtin isnan.
 229    Returns 1 if x is a NaN otherwise return 0.  */
 230
 231 int
 232 wrapc_isnan (double x)
 233 {
 234   return isnan (x);
 235 }
 236
 237 /* isnanf - provide non builtin alternative to the gcc builtin isnanf.
 238    Returns 1 if x is a NaN otherwise return 0.  */
 239
 240 int
 241 wrapc_isnanf (float x)
 242 {
 243   return isnan (x);
 244 }
 245
 246 /* isnanl - provide non builtin alternative to the gcc builtin isnanl.
 247    Returns 1 if x is a NaN otherwise return 0.  */
 248
 249 int
 250 wrapc_isnanl (long double x)
 251 {
 252   return isnan (x);
 253 }
 254
 255 /* init - init/finish functions for the module */
 256
 257 void
 258 _M2_wrapc_init (int argc, char *argv[], char *envp[])
 259 {
 260 }
 261
 262 void
 263 _M2_wrapc_finish ()
 264 {
 265 }
 266
 267 #ifdef __cplusplus
 268 }
 269 #endif