ghc/rts/RtsUtils.c

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