ghc/rts/RtsUtils.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: RtsUtils.c,v 1.12 2000/01/13 12:40:16 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * General utility functions used in the RTS.
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "Rts.h"
  11 #include "RtsAPI.h"
  12 #include "RtsFlags.h"
  13 #include "Hooks.h"
  14 #include "Main.h"
  15 #include "RtsUtils.h"
  16 #include "Ticky.h"
  17
  18 #ifdef HAVE_TIME_H
  19 #include <time.h>
  20 #endif
  21
  22 #ifdef HAVE_FCNTL_H
  23 #include <fcntl.h>
  24 #endif
  25
  26 #include <stdarg.h>
  27
  28 /* variable-argument error function. */
  29
  30 void barf(char *s, ...)
  31 {
  32   va_list ap;
  33   va_start(ap,s);
  34   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  35   if (prog_argv != NULL && prog_argv[0] != NULL) {
  36     fprintf(stderr, "%s: fatal error: ", prog_argv[0]);
  37   } else {
  38     fprintf(stderr, "fatal error: ");
  39   }
  40   vfprintf(stderr, s, ap);
  41   fprintf(stderr, "\n");
  42   fflush(stderr);
  43   stg_exit(EXIT_INTERNAL_ERROR);
  44 }
  45
  46 void prog_belch(char *s, ...)
  47 {
  48   va_list ap;
  49   va_start(ap,s);
  50   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  51   if (prog_argv != NULL && prog_argv[0] != NULL) {
  52     fprintf(stderr, "%s: ", prog_argv[0]);
  53   }
  54   vfprintf(stderr, s, ap);
  55   fprintf(stderr, "\n");
  56 }
  57
  58 void belch(char *s, ...)
  59 {
  60   va_list ap;
  61   va_start(ap,s);
  62   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  63   vfprintf(stderr, s, ap);
  64   fprintf(stderr, "\n");
  65 }
  66
  67 /* result-checking malloc wrappers. */
  68
  69 void *
  70 stgMallocBytes (int n, char *msg)
  71 {
  72     char *space;
  73
  74     if ((space = (char *) malloc((size_t) n)) == NULL) {
  75       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  76       MallocFailHook((W_) n, msg); /*msg*/
  77       stg_exit(EXIT_INTERNAL_ERROR);
  78     }
  79     return space;
  80 }
  81
  82 void *
  83 stgReallocBytes (void *p, int n, char *msg)
  84 {
  85     char *space;
  86
  87     if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
  88       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  89       MallocFailHook((W_) n, msg); /*msg*/
  90       stg_exit(EXIT_INTERNAL_ERROR);
  91     }
  92     return space;
  93 }
  94
  95 void *
  96 stgMallocWords (int n, char *msg)
  97 {
  98   return(stgMallocBytes(n * sizeof(W_), msg));
  99 }
 100
 101 void *
 102 stgReallocWords (void *p, int n, char *msg)
 103 {
 104   return(stgReallocBytes(p, n * sizeof(W_), msg));
 105 }
 106
 107 void
 108 _stgAssert (char *filename, nat linenum)
 109 {
 110   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 111   fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
 112   abort();
 113 }
 114
 115 /* -----------------------------------------------------------------------------
 116    Stack overflow
 117
 118    Not sure if this belongs here.
 119    -------------------------------------------------------------------------- */
 120
 121 void
 122 stackOverflow(void)
 123 {
 124   StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
 125
 126 #if defined(TICKY_TICKY)
 127   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 128 #endif
 129 }
 130
 131 void
 132 heapOverflow(void)
 133 {
 134   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 135   OutOfHeapHook(0/*unknown request size*/,
 136                 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
 137
 138 #if defined(TICKY_TICKY)
 139   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 140 #endif
 141
 142   stg_exit(EXIT_HEAPOVERFLOW);
 143 }
 144
 145 /* -----------------------------------------------------------------------------
 146    Out-of-line strlen.
 147
 148    Used in addr2Integer because the C compiler on x86 chokes on
 149    strlen, trying to inline it with not enough registers available.
 150    -------------------------------------------------------------------------- */
 151
 152 nat stg_strlen(char *s)
 153 {
 154    char *p = s;
 155
 156    while (*p) p++;
 157    return p-s;
 158 }
 159
 160
 161 /* -----------------------------------------------------------------------------
 162    genSym stuff, used by GHC itself for its splitting unique supply.
 163
 164    ToDo: put this somewhere sensible.
 165    -------------------------------------------------------------------------  */
 166
 167 I_ __GenSymCounter = 0;
 168
 169 I_
 170 genSymZh(void)
 171 {
 172     return(__GenSymCounter++);
 173 }
 174 I_
 175 resetGenSymZh(void) /* it's your funeral */
 176 {
 177     __GenSymCounter=0;
 178     return(__GenSymCounter);
 179 }
 180
 181 /* -----------------------------------------------------------------------------
 182    Get the current time as a string.  Used in profiling reports.
 183    -------------------------------------------------------------------------- */
 184
 185 #if defined(PROFILING) || defined(DEBUG)
 186 char *
 187 time_str(void)
 188 {
 189     static time_t now = 0;
 190     static char nowstr[26];
 191
 192     if (now == 0) {
 193         time(&now);
 194         strcpy(nowstr, ctime(&now));
 195         strcpy(nowstr+16,nowstr+19);
 196         nowstr[21] = '\0';
 197     }
 198     return nowstr;
 199 }
 200 #endif
 201
 202 /* -----------------------------------------------------------------------------
 203  * Reset a file handle to blocking mode.  We do this for the standard
 204  * file descriptors before exiting, because the shell doesn't always
 205  * clean up for us.
 206  * -------------------------------------------------------------------------- */
 207
 208 void
 209 resetNonBlockingFd(int fd)
 210 {
 211   long fd_flags;
 212
 213 #if !defined(_WIN32) || defined(__CYGWIN__) || defined(__CYGWIN32__)
 214   /* clear the non-blocking flag on this file descriptor */
 215   fd_flags = fcntl(fd, F_GETFL);
 216   if (fd_flags & O_NONBLOCK) {
 217     fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
 218   }
 219 #endif
 220 }
 221
 222 /* -----------------------------------------------------------------------------
 223    Print large numbers, with punctuation.
 224    -------------------------------------------------------------------------- */
 225
 226 char *
 227 ullong_format_string(ullong x, char *s, rtsBool with_commas)
 228 {
 229     if (x < (ullong)1000)
 230         sprintf(s, "%d", (nat)x);
 231     else if (x < (ullong)1000000)
 232         sprintf(s, (with_commas) ? "%ld,%3.3ld" : "%ld%3.3ld",
 233                 (nat)((x)/(ullong)1000),
 234                 (nat)((x)%(ullong)1000));
 235     else if (x < (ullong)1000000000)
 236         sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld" :  "%ld%3.3ld%3.3ld",
 237                 (nat)((x)/(ullong)1000000),
 238                 (nat)((x)/(ullong)1000%(ullong)1000),
 239                 (nat)((x)%(ullong)1000));
 240     else
 241         sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld%3.3ld",
 242                 (nat)((x)/(ullong)1000000000),
 243                 (nat)((x)/(ullong)1000000%(ullong)1000),
 244                 (nat)((x)/(ullong)1000%(ullong)1000),
 245                 (nat)((x)%(ullong)1000));
 246     return s;
 247 }