HsBase.h 10.3 KB
Newer Older
1
/* -----------------------------------------------------------------------------
2
 *
3
 * (c) The University of Glasgow 2001-2004
4
 *
5
 * Definitions for package `base' which are visible in Haskell land.
6
7
8
 *
 * ---------------------------------------------------------------------------*/

sof's avatar
sof committed
9
10
#ifndef __HSBASE_H__
#define __HSBASE_H__
11

12
13
14
#ifdef __NHC__
# include "Nhc98BaseConfig.h"
#else
ross's avatar
ross committed
15
#include "HsBaseConfig.h"
16
#endif
ross's avatar
ross committed
17
18

/* ultra-evil... */
ross's avatar
ross committed
19
20
21
22
23
24
#undef PACKAGE_BUGREPORT
#undef PACKAGE_NAME
#undef PACKAGE_STRING
#undef PACKAGE_TARNAME
#undef PACKAGE_VERSION

25
26
27
28
29
/* Needed to get the macro version of errno on some OSs (eg. Solaris).
   We must do this, because these libs are only compiled once, but
   must work in both single-threaded and multi-threaded programs. */
#define _REENTRANT 1

30
#include "HsFFI.h"
31

32
#include <stdio.h>
33
#include <stdlib.h>
34
#include <math.h>
35

36
#if HAVE_SYS_TYPES_H
37
38
#include <sys/types.h>
#endif
39
#if HAVE_UNISTD_H
40
41
#include <unistd.h>
#endif
42
#if HAVE_SYS_STAT_H
43
44
#include <sys/stat.h>
#endif
45
#if HAVE_FCNTL_H
46
47
# include <fcntl.h>
#endif
48
#if HAVE_TERMIOS_H
49
50
#include <termios.h>
#endif
51
#if HAVE_SIGNAL_H
52
#include <signal.h>
53
/* Ultra-ugly: OpenBSD uses broken macros for sigemptyset and sigfillset (missing casts) */
54
#if __OpenBSD__
55
#undef sigemptyset
56
57
#undef sigfillset
#endif
58
#endif
59
#if HAVE_ERRNO_H
60
61
#include <errno.h>
#endif
62
#if HAVE_STRING_H
63
64
#include <string.h>
#endif
65
#if HAVE_UTIME_H
66
67
#include <utime.h>
#endif
68
#if HAVE_SYS_UTSNAME_H
69
70
#include <sys/utsname.h>
#endif
71
72
#if HAVE_GETTIMEOFDAY
#  if HAVE_SYS_TIME_H
73
74
#   include <sys/time.h>
#  endif
75
76
#elif HAVE_GETCLOCK
# if HAVE_SYS_TIMERS_H
77
78
79
80
#  define POSIX_4D9 1
#  include <sys/timers.h>
# endif
#endif
81
82
#if HAVE_TIME_H
#include <time.h>
83
#endif
84
#if HAVE_SYS_TIMEB_H && !defined(__FreeBSD__)
85
86
#include <sys/timeb.h>
#endif
87
#if HAVE_WINDOWS_H
88
89
#include <windows.h>
#endif
90
#if HAVE_SYS_TIMES_H
91
92
#include <sys/times.h>
#endif
Ross Paterson's avatar
Ross Paterson committed
93
#if HAVE_WINSOCK_H && defined(__MINGW32__)
94
95
#include <winsock.h>
#endif
96
#if HAVE_LIMITS_H
97
98
#include <limits.h>
#endif
99
#if HAVE_WCTYPE_H
100
101
#include <wctype.h>
#endif
102
103
104
105
106
#if HAVE_INTTYPES_H
# include <inttypes.h>
#elif HAVE_STDINT_H
# include <stdint.h>
#endif
107
108
109
110
111
112
#if HAVE_CLOCK_GETTIME
# ifdef _POSIX_MONOTONIC_CLOCK
#  define CLOCK_ID CLOCK_MONOTONIC
# else
#  define CLOCK_ID CLOCK_REALTIME
# endif
113
114
115
#elif defined(darwin_HOST_OS)
# include <mach/mach.h>
# include <mach/mach_time.h>
116
#endif
117

Ross Paterson's avatar
Ross Paterson committed
118
#if !defined(__MINGW32__) && !defined(irix_HOST_OS)
119
# if HAVE_SYS_RESOURCE_H
120
121
122
123
#  include <sys/resource.h>
# endif
#endif

Ross Paterson's avatar
Ross Paterson committed
124
125
126
127
128
129
#if !HAVE_GETRUSAGE && HAVE_SYS_SYSCALL_H
# include <sys/syscall.h>
# if defined(SYS_GETRUSAGE)	/* hpux_HOST_OS */
#  define getrusage(a, b)  syscall(SYS_GETRUSAGE, a, b)
#  define HAVE_GETRUSAGE 1
# endif
130
131
132
#endif

/* For System */
133
#if HAVE_SYS_WAIT_H
134
135
#include <sys/wait.h>
#endif
136
#if HAVE_VFORK_H
137
138
#include <vfork.h>
#endif
139
#include "WCsubst.h"
140

141
142
143
#if defined(__MINGW32__)
/* in Win32Utils.c */
extern void maperrno (void);
144
extern HsWord64 getMonotonicUSec(void);
145
146
#endif

Ross Paterson's avatar
Ross Paterson committed
147
#if defined(__MINGW32__)
148
149
#include <io.h>
#include <fcntl.h>
150
#include <shlobj.h>
151
#include <share.h>
152
153
#endif

154
155
156
157
#if HAVE_SYS_SELECT_H
#include <sys/select.h>
#endif

158
/* in inputReady.c */
159
extern int fdReady(int fd, int write, int msecs, int isSock);
160

161
162
/* -----------------------------------------------------------------------------
   INLINE functions.
163

164
165
166
167
   These functions are given as inlines here for when compiling via C,
   but we also generate static versions into the cbits library for
   when compiling to native code.
   -------------------------------------------------------------------------- */
168

169
#ifndef INLINE
sof's avatar
sof committed
170
171
# if defined(_MSC_VER)
#  define INLINE extern __inline
ross's avatar
ross committed
172
# else
173
#  define INLINE static inline
sof's avatar
sof committed
174
# endif
175
#endif
176

177
INLINE int __hscore_get_errno(void) { return errno; }
178
INLINE void __hscore_set_errno(int e) { errno = e; }
179

180
INLINE HsInt
181
__hscore_bufsiz(void)
182
183
184
185
{
  return BUFSIZ;
}

186
INLINE int
187
__hscore_o_binary(void)
188
{
sof's avatar
sof committed
189
190
191
#if defined(_MSC_VER)
  return O_BINARY;
#else
192
  return CONST_O_BINARY;
sof's avatar
sof committed
193
#endif
194
195
}

196
INLINE int
197
__hscore_o_rdonly(void)
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
{
#ifdef O_RDONLY
  return O_RDONLY;
#else
  return 0;
#endif
}

INLINE int
__hscore_o_wronly( void )
{
#ifdef O_WRONLY
  return O_WRONLY;
#else
  return 0;
#endif
}

INLINE int
__hscore_o_rdwr( void )
{
#ifdef O_RDWR
  return O_RDWR;
#else
  return 0;
#endif
}

INLINE int
__hscore_o_append( void )
{
#ifdef O_APPEND
  return O_APPEND;
#else
  return 0;
#endif
}

INLINE int
__hscore_o_creat( void )
{
#ifdef O_CREAT
  return O_CREAT;
#else
  return 0;
#endif
}

INLINE int
__hscore_o_excl( void )
{
#ifdef O_EXCL
  return O_EXCL;
#else
  return 0;
#endif
}

INLINE int
__hscore_o_trunc( void )
{
#ifdef O_TRUNC
  return O_TRUNC;
#else
  return 0;
#endif
}

INLINE int
__hscore_o_noctty( void )
{
#ifdef O_NOCTTY
  return O_NOCTTY;
#else
  return 0;
#endif
}

INLINE int
__hscore_o_nonblock( void )
{
#ifdef O_NONBLOCK
  return O_NONBLOCK;
#else
  return 0;
#endif
}

286
287
288
289
290
291
292
293
INLINE int
__hscore_ftruncate( int fd, off_t where )
{
#if defined(HAVE_FTRUNCATE)
  return ftruncate(fd,where);
#elif defined(HAVE__CHSIZE)
  return _chsize(fd,where);
#else
294
295
296
// ToDo: we should use _chsize_s() on Windows which allows a 64-bit
// offset, but it doesn't seem to be available from mingw at this time 
// --SDM (01/2008)
297
298
299
300
#error at least ftruncate or _chsize functions are required to build
#endif
}

301
302
INLINE int
__hscore_setmode( int fd, HsBool toBin )
303
{
Ross Paterson's avatar
Ross Paterson committed
304
#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)
305
306
307
  return setmode(fd,(toBin == HS_BOOL_TRUE) ? _O_BINARY : _O_TEXT);
#else
  return 0;
308
#endif
309
310
}

ross's avatar
ross committed
311
312
313
314
#if __GLASGOW_HASKELL__

#endif /* __GLASGOW_HASKELL__ */

315
316
317
318
319
320
321
322
323
324
325
326
#if defined(__MINGW32__)
// We want the versions of stat/fstat/lseek that use 64-bit offsets,
// and you have to ask for those explicitly.  Unfortunately there
// doesn't seem to be a 64-bit version of truncate/ftruncate, so while
// hFileSize and hSeek will work with large files, hSetFileSize will not.
typedef struct _stati64 struct_stat;
typedef off64_t stsize_t;
#else
typedef struct stat struct_stat;
typedef off_t stsize_t;
#endif

327
328
329
INLINE HsInt
__hscore_sizeof_stat( void )
{
330
  return sizeof(struct_stat);
331
332
}

333
334
INLINE time_t __hscore_st_mtime ( struct_stat* st ) { return st->st_mtime; }
INLINE stsize_t __hscore_st_size  ( struct_stat* st ) { return st->st_size; }
sof's avatar
sof committed
335
#if !defined(_MSC_VER)
336
INLINE mode_t __hscore_st_mode  ( struct_stat* st ) { return st->st_mode; }
337
338
INLINE dev_t  __hscore_st_dev  ( struct_stat* st ) { return st->st_dev; }
INLINE ino_t  __hscore_st_ino  ( struct_stat* st ) { return st->st_ino; }
sof's avatar
sof committed
339
#endif
340

341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
#if defined(__MINGW32__)
INLINE int __hscore_stat(wchar_t *file, struct_stat *buf) {
	return _wstati64(file,buf);
}

INLINE int __hscore_fstat(int fd, struct_stat *buf) {
	return _fstati64(fd,buf);
}
INLINE int __hscore_lstat(wchar_t *fname, struct_stat *buf )
{
	return _wstati64(fname,buf);
}
#else
INLINE int __hscore_stat(char *file, struct_stat *buf) {
	return stat(file,buf);
}

INLINE int __hscore_fstat(int fd, struct_stat *buf) {
	return fstat(fd,buf);
}

INLINE int __hscore_lstat( const char *fname, struct stat *buf )
{
#if HAVE_LSTAT
  return lstat(fname, buf);
#else
  return stat(fname, buf);
#endif
}
#endif

372
373
374
375
376
377
378
#if HAVE_TERMIOS_H
INLINE tcflag_t __hscore_lflag( struct termios* ts ) { return ts->c_lflag; }

INLINE void
__hscore_poke_lflag( struct termios* ts, tcflag_t t ) { ts->c_lflag = t; }

INLINE unsigned char*
379
__hscore_ptr_c_cc( struct termios* ts )
380
381
382
383
384
{ return (unsigned char*) &ts->c_cc; }

INLINE HsInt
__hscore_sizeof_termios( void )
{
Ross Paterson's avatar
Ross Paterson committed
385
#ifndef __MINGW32__
386
387
388
389
390
  return sizeof(struct termios);
#else
  return 0;
#endif
}
sof's avatar
sof committed
391
#endif
392

Ross Paterson's avatar
Ross Paterson committed
393
#if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32)
394
395
396
397
398
INLINE HsInt
__hscore_sizeof_sigset_t( void )
{
  return sizeof(sigset_t);
}
sof's avatar
sof committed
399
#endif
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477

INLINE int
__hscore_echo( void )
{
#ifdef ECHO
  return ECHO;
#else
  return 0;
#endif

}

INLINE int
__hscore_tcsanow( void )
{
#ifdef TCSANOW
  return TCSANOW;
#else
  return 0;
#endif

}

INLINE int
__hscore_icanon( void )
{
#ifdef ICANON
  return ICANON;
#else
  return 0;
#endif
}

INLINE int __hscore_vmin( void )
{
#ifdef VMIN
  return VMIN;
#else
  return 0;
#endif
}

INLINE int __hscore_vtime( void )
{
#ifdef VTIME
  return VTIME;
#else
  return 0;
#endif
}

INLINE int __hscore_sigttou( void )
{
#ifdef SIGTTOU
  return SIGTTOU;
#else
  return 0;
#endif
}

INLINE int __hscore_sig_block( void )
{
#ifdef SIG_BLOCK
  return SIG_BLOCK;
#else
  return 0;
#endif
}

INLINE int __hscore_sig_setmask( void )
{
#ifdef SIG_SETMASK
  return SIG_SETMASK;
#else
  return 0;
#endif
}

478
479
480
481
482
483
484
#ifndef __MINGW32__
INLINE size_t __hscore_sizeof_siginfo_t (void)
{
    return sizeof(siginfo_t);
}
#endif

485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
INLINE int
__hscore_f_getfl( void )
{
#ifdef F_GETFL
  return F_GETFL;
#else
  return 0;
#endif
}

INLINE int
__hscore_f_setfl( void )
{
#ifdef F_SETFL
  return F_SETFL;
#else
  return 0;
#endif
}

505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
INLINE int
__hscore_f_setfd( void )
{
#ifdef F_SETFD
  return F_SETFD;
#else
  return 0;
#endif
}

INLINE long
__hscore_fd_cloexec( void )
{
#ifdef FD_CLOEXEC
  return FD_CLOEXEC;
#else
  return 0;
#endif
}

525
// defined in rts/RtsStartup.c.
526
527
extern void* __hscore_get_saved_termios(int fd);
extern void __hscore_set_saved_termios(int fd, void* ts);
528

Ross Paterson's avatar
Ross Paterson committed
529
#ifdef __MINGW32__
530
INLINE int __hscore_open(wchar_t *file, int how, mode_t mode) {
531
	if ((how & O_WRONLY) || (how & O_RDWR) || (how & O_APPEND))
532
	  return _wsopen(file,how | _O_NOINHERIT,_SH_DENYNO,mode);
533
          // _O_NOINHERIT: see #2650
534
	else
535
	  return _wsopen(file,how | _O_NOINHERIT,_SH_DENYNO,mode);
536
          // _O_NOINHERIT: see #2650
537
}
538
#else
539
INLINE int __hscore_open(char *file, int how, mode_t mode) {
540
541
	return open(file,how,mode);
}
542
#endif
543

544
545
546
547
#if darwin_HOST_OS
// You should not access _environ directly on Darwin in a bundle/shared library.
// See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html
#include <crt_externs.h>
548
INLINE char **__hscore_environ(void) { return *(_NSGetEnviron()); }
549
#else
ross's avatar
ross committed
550
551
552
/* ToDo: write a feature test that doesn't assume 'environ' to
 *    be in scope at link-time. */
extern char** environ;
553
INLINE char **__hscore_environ(void) { return environ; }
554
#endif
ross's avatar
ross committed
555

556
557
558
559
560
561
/* lossless conversions between pointers and integral types */
INLINE void *    __hscore_from_uintptr(uintptr_t n) { return (void *)n; }
INLINE void *    __hscore_from_intptr (intptr_t n)  { return (void *)n; }
INLINE uintptr_t __hscore_to_uintptr  (void *p)     { return (uintptr_t)p; }
INLINE intptr_t  __hscore_to_intptr   (void *p)     { return (intptr_t)p; }

562
563
564
void errorBelch2(const char*s, char *t);
void debugBelch2(const char*s, char *t);

sof's avatar
sof committed
565
#endif /* __HSBASE_H__ */
566