include/HsBase.h

   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
   9 #ifndef __HSBASE_H__
  10 #define __HSBASE_H__
  11
  12 #include "HsBaseConfig.h"
  13
  14 /* ultra-evil... */
  15 #undef PACKAGE_BUGREPORT
  16 #undef PACKAGE_NAME
  17 #undef PACKAGE_STRING
  18 #undef PACKAGE_TARNAME
  19 #undef PACKAGE_VERSION
  20
  21 /* Needed to get the macro version of errno on some OSs (eg. Solaris).
  22    We must do this, because these libs are only compiled once, but
  23    must work in both single-threaded and multi-threaded programs. */
  24 #define _REENTRANT 1
  25
  26 #include "HsFFI.h"
  27
  28 #include <stdio.h>
  29 #include <stdlib.h>
  30 #include <math.h>
  31
  32 #if HAVE_SYS_TYPES_H
  33 #include <sys/types.h>
  34 #endif
  35 #if HAVE_UNISTD_H
  36 #include <unistd.h>
  37 #endif
  38 #if HAVE_SYS_STAT_H
  39 #include <sys/stat.h>
  40 #endif
  41 #if HAVE_FCNTL_H
  42 # include <fcntl.h>
  43 #endif
  44 #if HAVE_TERMIOS_H
  45 #include <termios.h>
  46 #endif
  47 #if HAVE_SIGNAL_H
  48 #include <signal.h>
  49 /* Ultra-ugly: OpenBSD uses broken macros for sigemptyset and sigfillset (missing casts) */
  50 #if __OpenBSD__
  51 #undef sigemptyset
  52 #undef sigfillset
  53 #endif
  54 #endif
  55 #if HAVE_ERRNO_H
  56 #include <errno.h>
  57 #endif
  58 #if HAVE_STRING_H
  59 #include <string.h>
  60 #endif
  61 #if HAVE_DIRENT_H
  62 #include <dirent.h>
  63 #endif
  64 #if HAVE_UTIME_H
  65 #include <utime.h>
  66 #endif
  67 #if HAVE_SYS_UTSNAME_H
  68 #include <sys/utsname.h>
  69 #endif
  70 #if HAVE_GETTIMEOFDAY
  71 #  if HAVE_SYS_TIME_H
  72 #   include <sys/time.h>
  73 #  endif
  74 #elif HAVE_GETCLOCK
  75 # if HAVE_SYS_TIMERS_H
  76 #  define POSIX_4D9 1
  77 #  include <sys/timers.h>
  78 # endif
  79 #endif
  80 #if HAVE_TIME_H
  81 #include <time.h>
  82 #endif
  83 #if HAVE_SYS_TIMEB_H
  84 #include <sys/timeb.h>
  85 #endif
  86 #if HAVE_WINDOWS_H
  87 #include <windows.h>
  88 #endif
  89 #if HAVE_SYS_TIMES_H
  90 #include <sys/times.h>
  91 #endif
  92 #if HAVE_WINSOCK_H && defined(__MINGW32__)
  93 #include <winsock.h>
  94 #endif
  95 #if HAVE_LIMITS_H
  96 #include <limits.h>
  97 #endif
  98 #if HAVE_WCTYPE_H
  99 #include <wctype.h>
 100 #endif
 101 #if HAVE_INTTYPES_H
 102 # include <inttypes.h>
 103 #elif HAVE_STDINT_H
 104 # include <stdint.h>
 105 #endif
 106
 107 #if !defined(__MINGW32__) && !defined(irix_HOST_OS)
 108 # if HAVE_SYS_RESOURCE_H
 109 #  include <sys/resource.h>
 110 # endif
 111 #endif
 112
 113 #if !HAVE_GETRUSAGE && HAVE_SYS_SYSCALL_H
 114 # include <sys/syscall.h>
 115 # if defined(SYS_GETRUSAGE)     /* hpux_HOST_OS */
 116 #  define getrusage(a, b)  syscall(SYS_GETRUSAGE, a, b)
 117 #  define HAVE_GETRUSAGE 1
 118 # endif
 119 #endif
 120
 121 /* For System */
 122 #if HAVE_SYS_WAIT_H
 123 #include <sys/wait.h>
 124 #endif
 125 #if HAVE_VFORK_H
 126 #include <vfork.h>
 127 #endif
 128 #include "lockFile.h"
 129 #include "dirUtils.h"
 130 #include "WCsubst.h"
 131
 132 #if defined(__MINGW32__)
 133 /* in Win32Utils.c */
 134 extern void maperrno (void);
 135 extern HsWord64 getUSecOfDay(void);
 136 #endif
 137
 138 #if defined(__MINGW32__)
 139 #include <io.h>
 140 #include <fcntl.h>
 141 #include <shlobj.h>
 142 #include <share.h>
 143 #endif
 144
 145 #if HAVE_SYS_SELECT_H
 146 #include <sys/select.h>
 147 #endif
 148
 149 /* in inputReady.c */
 150 int inputReady(int fd, int msecs, int isSock);
 151
 152 /* in Signals.c */
 153 extern HsInt nocldstop;
 154
 155 /* -----------------------------------------------------------------------------
 156    64-bit operations, defined in longlong.c
 157    -------------------------------------------------------------------------- */
 158
 159 #ifdef SUPPORT_LONG_LONGS
 160
 161 HsBool hs_gtWord64 (HsWord64, HsWord64);
 162 HsBool hs_geWord64 (HsWord64, HsWord64);
 163 HsBool hs_eqWord64 (HsWord64, HsWord64);
 164 HsBool hs_neWord64 (HsWord64, HsWord64);
 165 HsBool hs_ltWord64 (HsWord64, HsWord64);
 166 HsBool hs_leWord64 (HsWord64, HsWord64);
 167
 168 HsBool hs_gtInt64 (HsInt64, HsInt64);
 169 HsBool hs_geInt64 (HsInt64, HsInt64);
 170 HsBool hs_eqInt64 (HsInt64, HsInt64);
 171 HsBool hs_neInt64 (HsInt64, HsInt64);
 172 HsBool hs_ltInt64 (HsInt64, HsInt64);
 173 HsBool hs_leInt64 (HsInt64, HsInt64);
 174
 175 HsWord64 hs_remWord64  (HsWord64, HsWord64);
 176 HsWord64 hs_quotWord64 (HsWord64, HsWord64);
 177
 178 HsInt64 hs_remInt64    (HsInt64, HsInt64);
 179 HsInt64 hs_quotInt64   (HsInt64, HsInt64);
 180 HsInt64 hs_negateInt64 (HsInt64);
 181 HsInt64 hs_plusInt64   (HsInt64, HsInt64);
 182 HsInt64 hs_minusInt64  (HsInt64, HsInt64);
 183 HsInt64 hs_timesInt64  (HsInt64, HsInt64);
 184
 185 HsWord64 hs_and64  (HsWord64, HsWord64);
 186 HsWord64 hs_or64   (HsWord64, HsWord64);
 187 HsWord64 hs_xor64  (HsWord64, HsWord64);
 188 HsWord64 hs_not64  (HsWord64);
 189
 190 HsWord64 hs_uncheckedShiftL64   (HsWord64, HsInt);
 191 HsWord64 hs_uncheckedShiftRL64  (HsWord64, HsInt);
 192 HsInt64  hs_uncheckedIShiftL64  (HsInt64, HsInt);
 193 HsInt64  hs_uncheckedIShiftRA64 (HsInt64, HsInt);
 194 HsInt64  hs_uncheckedIShiftRL64 (HsInt64, HsInt);
 195
 196 HsInt64  hs_intToInt64    (HsInt);
 197 HsInt    hs_int64ToInt    (HsInt64);
 198 HsWord64 hs_int64ToWord64 (HsInt64);
 199 HsWord64 hs_wordToWord64  (HsWord);
 200 HsWord   hs_word64ToWord  (HsWord64);
 201 HsInt64  hs_word64ToInt64 (HsWord64);
 202
 203 HsWord64 hs_integerToWord64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da);
 204 HsInt64  hs_integerToInt64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da);
 205
 206 #endif /* SUPPORT_LONG_LONGS */
 207
 208 /* -----------------------------------------------------------------------------
 209    INLINE functions.
 210
 211    These functions are given as inlines here for when compiling via C,
 212    but we also generate static versions into the cbits library for
 213    when compiling to native code.
 214    -------------------------------------------------------------------------- */
 215
 216 #ifndef INLINE
 217 # if defined(_MSC_VER)
 218 #  define INLINE extern __inline
 219 # else
 220 #  define INLINE static inline
 221 # endif
 222 #endif
 223
 224 INLINE int __hscore_get_errno(void) { return errno; }
 225 INLINE void __hscore_set_errno(int e) { errno = e; }
 226
 227 #if !defined(_MSC_VER)
 228 INLINE int __hscore_s_isreg(mode_t m)  { return S_ISREG(m);  }
 229 INLINE int __hscore_s_isdir(mode_t m)  { return S_ISDIR(m);  }
 230 INLINE int __hscore_s_isfifo(mode_t m) { return S_ISFIFO(m); }
 231 INLINE int __hscore_s_isblk(mode_t m)  { return S_ISBLK(m);  }
 232 INLINE int __hscore_s_ischr(mode_t m)  { return S_ISCHR(m);  }
 233 #ifdef S_ISSOCK
 234 INLINE int __hscore_s_issock(mode_t m) { return S_ISSOCK(m); }
 235 #endif
 236 #endif
 237
 238 #if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32)
 239 INLINE int
 240 __hscore_sigemptyset( sigset_t *set )
 241 { return sigemptyset(set); }
 242
 243 INLINE int
 244 __hscore_sigfillset( sigset_t *set )
 245 { return sigfillset(set); }
 246
 247 INLINE int
 248 __hscore_sigaddset( sigset_t * set, int s )
 249 { return sigaddset(set,s); }
 250
 251 INLINE int
 252 __hscore_sigdelset( sigset_t * set, int s )
 253 { return sigdelset(set,s); }
 254
 255 INLINE int
 256 __hscore_sigismember( sigset_t * set, int s )
 257 { return sigismember(set,s); }
 258 #endif
 259
 260 INLINE void *
 261 __hscore_memcpy_dst_off( char *dst, int dst_off, char *src, size_t sz )
 262 { return memcpy(dst+dst_off, src, sz); }
 263
 264 INLINE void *
 265 __hscore_memcpy_src_off( char *dst, char *src, int src_off, size_t sz )
 266 { return memcpy(dst, src+src_off, sz); }
 267
 268 INLINE HsBool
 269 __hscore_supportsTextMode()
 270 {
 271 #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)
 272   return HS_BOOL_FALSE;
 273 #else
 274   return HS_BOOL_TRUE;
 275 #endif
 276 }
 277
 278 INLINE HsInt
 279 __hscore_bufsiz()
 280 {
 281   return BUFSIZ;
 282 }
 283
 284 INLINE int
 285 __hscore_seek_cur()
 286 {
 287   return SEEK_CUR;
 288 }
 289
 290 INLINE int
 291 __hscore_o_binary()
 292 {
 293 #if defined(_MSC_VER)
 294   return O_BINARY;
 295 #else
 296   return CONST_O_BINARY;
 297 #endif
 298 }
 299
 300 INLINE int
 301 __hscore_o_rdonly()
 302 {
 303 #ifdef O_RDONLY
 304   return O_RDONLY;
 305 #else
 306   return 0;
 307 #endif
 308 }
 309
 310 INLINE int
 311 __hscore_o_wronly( void )
 312 {
 313 #ifdef O_WRONLY
 314   return O_WRONLY;
 315 #else
 316   return 0;
 317 #endif
 318 }
 319
 320 INLINE int
 321 __hscore_o_rdwr( void )
 322 {
 323 #ifdef O_RDWR
 324   return O_RDWR;
 325 #else
 326   return 0;
 327 #endif
 328 }
 329
 330 INLINE int
 331 __hscore_o_append( void )
 332 {
 333 #ifdef O_APPEND
 334   return O_APPEND;
 335 #else
 336   return 0;
 337 #endif
 338 }
 339
 340 INLINE int
 341 __hscore_o_creat( void )
 342 {
 343 #ifdef O_CREAT
 344   return O_CREAT;
 345 #else
 346   return 0;
 347 #endif
 348 }
 349
 350 INLINE int
 351 __hscore_o_excl( void )
 352 {
 353 #ifdef O_EXCL
 354   return O_EXCL;
 355 #else
 356   return 0;
 357 #endif
 358 }
 359
 360 INLINE int
 361 __hscore_o_trunc( void )
 362 {
 363 #ifdef O_TRUNC
 364   return O_TRUNC;
 365 #else
 366   return 0;
 367 #endif
 368 }
 369
 370 INLINE int
 371 __hscore_o_noctty( void )
 372 {
 373 #ifdef O_NOCTTY
 374   return O_NOCTTY;
 375 #else
 376   return 0;
 377 #endif
 378 }
 379
 380 INLINE int
 381 __hscore_o_nonblock( void )
 382 {
 383 #ifdef O_NONBLOCK
 384   return O_NONBLOCK;
 385 #else
 386   return 0;
 387 #endif
 388 }
 389
 390 INLINE int
 391 __hscore_seek_set( void )
 392 {
 393   return SEEK_SET;
 394 }
 395
 396 INLINE int
 397 __hscore_seek_end( void )
 398 {
 399   return SEEK_END;
 400 }
 401
 402 INLINE int
 403 __hscore_ftruncate( int fd, off_t where )
 404 {
 405 #if defined(HAVE_FTRUNCATE)
 406   return ftruncate(fd,where);
 407 #elif defined(HAVE__CHSIZE)
 408   return _chsize(fd,where);
 409 #else
 410 #error at least ftruncate or _chsize functions are required to build
 411 #endif
 412 }
 413
 414 INLINE int
 415 __hscore_setmode( int fd, HsBool toBin )
 416 {
 417 #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)
 418   return setmode(fd,(toBin == HS_BOOL_TRUE) ? _O_BINARY : _O_TEXT);
 419 #else
 420   return 0;
 421 #endif
 422 }
 423
 424 #if __GLASGOW_HASKELL__
 425
 426 INLINE int
 427 __hscore_PrelHandle_write( int fd, void *ptr, HsInt off, int sz )
 428 {
 429   return write(fd,(char *)ptr + off, sz);
 430 }
 431
 432 INLINE int
 433 __hscore_PrelHandle_read( int fd, void *ptr, HsInt off, int sz )
 434 {
 435   return read(fd,(char *)ptr + off, sz);
 436
 437 }
 438
 439 #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)
 440 INLINE int
 441 __hscore_PrelHandle_send( int fd, void *ptr, HsInt off, int sz )
 442 {
 443     return send(fd,(char *)ptr + off, sz, 0);
 444 }
 445
 446 INLINE int
 447 __hscore_PrelHandle_recv( int fd, void *ptr, HsInt off, int sz )
 448 {
 449     return recv(fd,(char *)ptr + off, sz, 0);
 450 }
 451 #endif
 452
 453 #endif /* __GLASGOW_HASKELL__ */
 454
 455 INLINE int
 456 __hscore_mkdir( char *pathName, int mode )
 457 {
 458 #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)
 459   return mkdir(pathName);
 460 #else
 461   return mkdir(pathName,mode);
 462 #endif
 463 }
 464
 465 INLINE int
 466 __hscore_lstat( const char *fname, struct stat *st )
 467 {
 468 #if HAVE_LSTAT
 469   return lstat(fname, st);
 470 #else
 471   return stat(fname, st);
 472 #endif
 473 }
 474
 475 INLINE char *
 476 __hscore_d_name( struct dirent* d )
 477 {
 478   return (d->d_name);
 479 }
 480
 481 INLINE int
 482 __hscore_end_of_dir( void )
 483 {
 484   return READDIR_ERRNO_EOF;
 485 }
 486
 487 INLINE void
 488 __hscore_free_dirent(struct dirent *dEnt)
 489 {
 490 #if HAVE_READDIR_R
 491   free(dEnt);
 492 #endif
 493 }
 494
 495 INLINE HsInt
 496 __hscore_sizeof_stat( void )
 497 {
 498   return sizeof(struct stat);
 499 }
 500
 501 INLINE time_t __hscore_st_mtime ( struct stat* st ) { return st->st_mtime; }
 502 INLINE off_t  __hscore_st_size  ( struct stat* st ) { return st->st_size; }
 503 #if !defined(_MSC_VER)
 504 INLINE mode_t __hscore_st_mode  ( struct stat* st ) { return st->st_mode; }
 505 #endif
 506
 507 #if HAVE_TERMIOS_H
 508 INLINE tcflag_t __hscore_lflag( struct termios* ts ) { return ts->c_lflag; }
 509
 510 INLINE void
 511 __hscore_poke_lflag( struct termios* ts, tcflag_t t ) { ts->c_lflag = t; }
 512
 513 INLINE unsigned char*
 514 __hscore_ptr_c_cc( struct termios* ts )
 515 { return (unsigned char*) &ts->c_cc; }
 516
 517 INLINE HsInt
 518 __hscore_sizeof_termios( void )
 519 {
 520 #ifndef __MINGW32__
 521   return sizeof(struct termios);
 522 #else
 523   return 0;
 524 #endif
 525 }
 526 #endif
 527
 528 #if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32)
 529 INLINE HsInt
 530 __hscore_sizeof_sigset_t( void )
 531 {
 532   return sizeof(sigset_t);
 533 }
 534 #endif
 535
 536 INLINE int
 537 __hscore_echo( void )
 538 {
 539 #ifdef ECHO
 540   return ECHO;
 541 #else
 542   return 0;
 543 #endif
 544
 545 }
 546
 547 INLINE int
 548 __hscore_tcsanow( void )
 549 {
 550 #ifdef TCSANOW
 551   return TCSANOW;
 552 #else
 553   return 0;
 554 #endif
 555
 556 }
 557
 558 INLINE int
 559 __hscore_icanon( void )
 560 {
 561 #ifdef ICANON
 562   return ICANON;
 563 #else
 564   return 0;
 565 #endif
 566 }
 567
 568 INLINE int __hscore_vmin( void )
 569 {
 570 #ifdef VMIN
 571   return VMIN;
 572 #else
 573   return 0;
 574 #endif
 575 }
 576
 577 INLINE int __hscore_vtime( void )
 578 {
 579 #ifdef VTIME
 580   return VTIME;
 581 #else
 582   return 0;
 583 #endif
 584 }
 585
 586 INLINE int __hscore_sigttou( void )
 587 {
 588 #ifdef SIGTTOU
 589   return SIGTTOU;
 590 #else
 591   return 0;
 592 #endif
 593 }
 594
 595 INLINE int __hscore_sig_block( void )
 596 {
 597 #ifdef SIG_BLOCK
 598   return SIG_BLOCK;
 599 #else
 600   return 0;
 601 #endif
 602 }
 603
 604 INLINE int __hscore_sig_setmask( void )
 605 {
 606 #ifdef SIG_SETMASK
 607   return SIG_SETMASK;
 608 #else
 609   return 0;
 610 #endif
 611 }
 612
 613 INLINE int
 614 __hscore_f_getfl( void )
 615 {
 616 #ifdef F_GETFL
 617   return F_GETFL;
 618 #else
 619   return 0;
 620 #endif
 621 }
 622
 623 INLINE int
 624 __hscore_f_setfl( void )
 625 {
 626 #ifdef F_SETFL
 627   return F_SETFL;
 628 #else
 629   return 0;
 630 #endif
 631 }
 632
 633 // defined in rts/RtsStartup.c.
 634 extern void* __hscore_get_saved_termios(int fd);
 635 extern void __hscore_set_saved_termios(int fd, void* ts);
 636
 637 INLINE int __hscore_hs_fileno (FILE *f) { return fileno (f); }
 638
 639 INLINE int __hscore_open(char *file, int how, mode_t mode) {
 640 #ifdef __MINGW32__
 641         if ((how & O_WRONLY) || (how & O_RDWR) || (how & O_APPEND))
 642           return _sopen(file,how,_SH_DENYRW,mode);
 643         else
 644           return _sopen(file,how,_SH_DENYWR,mode);
 645 #else
 646         return open(file,how,mode);
 647 #endif
 648 }
 649
 650 // These are wrapped because on some OSs (eg. Linux) they are
 651 // macros which redirect to the 64-bit-off_t versions when large file
 652 // support is enabled.
 653 //
 654 INLINE off_t __hscore_lseek(int fd, off_t off, int whence) {
 655         return (lseek(fd,off,whence));
 656 }
 657
 658 INLINE int __hscore_stat(char *file, struct stat *buf) {
 659         return (stat(file,buf));
 660 }
 661
 662 INLINE int __hscore_fstat(int fd, struct stat *buf) {
 663         return (fstat(fd,buf));
 664 }
 665
 666 // select-related stuff
 667
 668 #if !defined(__MINGW32__)
 669 INLINE int  hsFD_SETSIZE(void) { return FD_SETSIZE; }
 670 INLINE void hsFD_CLR(int fd, fd_set *fds) { FD_CLR(fd, fds); }
 671 INLINE int  hsFD_ISSET(int fd, fd_set *fds) { return FD_ISSET(fd, fds); }
 672 INLINE void hsFD_SET(int fd, fd_set *fds) { FD_SET(fd, fds); }
 673 INLINE HsInt sizeof_fd_set(void) { return sizeof(fd_set); }
 674 extern void hsFD_ZERO(fd_set *fds);
 675 #endif
 676
 677 // gettimeofday()-related
 678
 679 #if !defined(__MINGW32__)
 680
 681 INLINE HsInt sizeofTimeVal(void) { return sizeof(struct timeval); }
 682
 683 INLINE HsWord64 getUSecOfDay(void)
 684 {
 685     struct timeval tv;
 686     gettimeofday(&tv, (struct timezone *) NULL);
 687     // Don't forget to cast *before* doing the arithmetic, otherwise
 688     // the arithmetic happens at the type of tv_sec, which is probably
 689     // only 'int'.
 690     return ((HsWord64)tv.tv_sec * 1000000 + (HsWord64)tv.tv_usec);
 691 }
 692
 693 INLINE void setTimevalTicks(struct timeval *p, HsWord64 usecs)
 694 {
 695     p->tv_sec  = usecs / 1000000;
 696     p->tv_usec = usecs % 1000000;
 697 }
 698 #endif /* !defined(__MINGW32__) */
 699
 700 /* ToDo: write a feature test that doesn't assume 'environ' to
 701  *    be in scope at link-time. */
 702 extern char** environ;
 703 INLINE char **__hscore_environ() { return environ; }
 704
 705 /* lossless conversions between pointers and integral types */
 706 INLINE void *    __hscore_from_uintptr(uintptr_t n) { return (void *)n; }
 707 INLINE void *    __hscore_from_intptr (intptr_t n)  { return (void *)n; }
 708 INLINE uintptr_t __hscore_to_uintptr  (void *p)     { return (uintptr_t)p; }
 709 INLINE intptr_t  __hscore_to_intptr   (void *p)     { return (intptr_t)p; }
 710
 711 #endif /* __HSBASE_H__ */
 712