MBlock.c 10.7 KB
Newer Older
1
/* -----------------------------------------------------------------------------
2
3
 *
 * (c) The GHC Team 1998-1999
4
5
6
7
8
9
10
 *
 * MegaBlock Allocator Interface.  This file contains all the dirty
 * architecture-dependent hackery required to get a chunk of aligned
 * memory from the operating system.
 *
 * ---------------------------------------------------------------------------*/

11
12
/* This is non-posix compliant. */
/* #include "PosixSource.h" */
13
14
15
16
17
18
19

#include "Rts.h"
#include "RtsUtils.h"
#include "RtsFlags.h"
#include "MBlock.h"
#include "BlockAlloc.h"

20
21
22
#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif
23
24
25
#ifdef HAVE_STRING_H
#include <string.h>
#endif
26
27
28
29
30
31
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
sof's avatar
sof committed
32
33
34
35
#ifndef mingw32_TARGET_OS
# ifdef HAVE_SYS_MMAN_H
# include <sys/mman.h>
# endif
36
37
38
39
#endif
#ifdef HAVE_FCNTL_H
#include <fcntl.h>
#endif
sof's avatar
sof committed
40
#if HAVE_WINDOWS_H
41
42
#include <windows.h>
#endif
43
44
45
#if darwin_TARGET_OS
#include <mach/vm_map.h>
#endif
46

47
48
#include <errno.h>

49
50
lnat mblocks_allocated = 0;

51
52
53
54
/* -----------------------------------------------------------------------------
   The MBlock Map: provides our implementation of HEAP_ALLOCED()
   -------------------------------------------------------------------------- */

55
56
57
#ifdef MBLOCK_MAP_SIZE
StgWord8 mblock_map[MBLOCK_MAP_SIZE]; // initially all zeros
#endif
58
59
60
61
62

/* -----------------------------------------------------------------------------
   Allocate new mblock(s)
   -------------------------------------------------------------------------- */

63
64
65
66
67
68
void *
getMBlock(void)
{
  return getMBlocks(1);
}

69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
/* -----------------------------------------------------------------------------
   The mmap() method

   On Unix-like systems, we use mmap() to allocate our memory.  We
   want memory in chunks of MBLOCK_SIZE, and aligned on an MBLOCK_SIZE
   boundary.  The mmap() interface doesn't give us this level of
   control, so we have to use some heuristics.

   In the general case, if we want a block of n megablocks, then we
   allocate n+1 and trim off the slop from either side (using
   munmap()) to get an aligned chunk of size n.  However, the next
   time we'll try to allocate directly after the previously allocated
   chunk, on the grounds that this is aligned and likely to be free.
   If it turns out that we were wrong, we have to munmap() and try
   again using the general method.
   -------------------------------------------------------------------------- */

sof's avatar
sof committed
86
#if !defined(mingw32_TARGET_OS) && !defined(cygwin32_TARGET_OS)
87
88
89
90
91

// A wrapper around mmap(), to abstract away from OS differences in
// the mmap() interface.

static void *
92
my_mmap (void *addr, lnat size)
93
94
95
{
    void *ret;

96
#if defined(solaris2_TARGET_OS) || defined(irix_TARGET_OS)
97
98
    { 
	int fd = open("/dev/zero",O_RDONLY);
99
	ret = mmap(addr, size, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0);
100
101
102
103
104
105
	close(fd);
    }
#elif hpux_TARGET_OS
    ret = mmap(addr, size, PROT_READ | PROT_WRITE, 
	       MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
#elif darwin_TARGET_OS
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
    // Without MAP_FIXED, Apple's mmap ignores addr.
    // With MAP_FIXED, it overwrites already mapped regions, whic
    // mmap(0, ... MAP_FIXED ...) is worst of all: It unmaps the program text
    // and replaces it with zeroes, causing instant death.
    // This behaviour seems to be conformant with IEEE Std 1003.1-2001.
    // Let's just use the underlying Mach Microkernel calls directly,
    // they're much nicer.
    
    kern_return_t err;
    ret = addr;
    if(addr)	// try to allocate at adress
	err = vm_allocate(mach_task_self(),(vm_address_t*) &ret, size, FALSE);
    if(!addr || err)	// try to allocate anywhere
	err = vm_allocate(mach_task_self(),(vm_address_t*) &ret, size, TRUE);
	
121
    if(err) // don't know what the error codes mean exactly
122
	barf("memory allocation failed (requested %lu bytes)", size);
123
124
    else
	vm_protect(mach_task_self(),ret,size,FALSE,VM_PROT_READ|VM_PROT_WRITE);
125
#else
126
    ret = mmap(addr, size, PROT_READ | PROT_WRITE | PROT_EXEC, 
127
128
129
	       MAP_ANON | MAP_PRIVATE, -1, 0);
#endif

130
    if (ret == (void *)-1) {
131
132
133
134
	if (errno == ENOMEM || 
	    (errno == EINVAL && sizeof(void*)==4 && size >= 0xc0000000)) {
	    // If we request more than 3Gig, then we get EINVAL
	    // instead of ENOMEM (at least on Linux).
135
	    errorBelch("out of memory (requested %lu bytes)", size);
136
	    stg_exit(EXIT_FAILURE);
137
	} else {
138
	    barf("getMBlock: mmap: %s", strerror(errno));
139
140
141
	}
    }

142
    return ret;
143
}
144
145
146
147
148

// Implements the general case: allocate a chunk of memory of 'size'
// mblocks.

static void *
149
gen_map_mblocks (lnat size)
150
151
152
153
154
155
156
157
158
159
160
{
    int slop;
    void *ret;

    // Try to map a larger block, and take the aligned portion from
    // it (unmap the rest).
    size += MBLOCK_SIZE;
    ret = my_mmap(0, size);
    
    // unmap the slop bits around the chunk we allocated
    slop = (W_)ret & MBLOCK_MASK;
sof's avatar
sof committed
161
    
162
    if (munmap(ret, MBLOCK_SIZE - slop) == -1) {
sof's avatar
sof committed
163
      barf("gen_map_mblocks: munmap failed");
164
165
    }
    if (slop > 0 && munmap(ret+size-slop, slop) == -1) {
sof's avatar
sof committed
166
      barf("gen_map_mblocks: munmap failed");
167
    }
sof's avatar
sof committed
168

169
    // ToDo: if we happened to get an aligned block, then don't
sof's avatar
sof committed
170
171
172
173
174
175
176
177
178
179
    // unmap the excess, just use it. For this to work, you
    // need to keep in mind the following:
    //     * Calling my_mmap() with an 'addr' arg pointing to
    //       already my_mmap()ed space is OK and won't fail.
    //     * If my_mmap() can't satisfy the request at the
    //       given 'next_request' address in getMBlocks(), that
    //       you unmap the extra mblock mmap()ed here (or simply
    //       satisfy yourself that the slop introduced isn't worth
    //       salvaging.)
    // 
180

181
182
183
184
185
186
187
188
189
    // next time, try after the block we just got.
    ret += MBLOCK_SIZE - slop;
    return ret;
}


// The external interface: allocate 'n' mblocks, and return the
// address.

190
191
192
void *
getMBlocks(nat n)
{
193
  static caddr_t next_request = (caddr_t)HEAP_BASE;
194
195
  caddr_t ret;
  lnat size = MBLOCK_SIZE * n;
196
  nat i;
197
 
198
199
200
201
202
  if (next_request == 0) {
      // use gen_map_mblocks the first time.
      ret = gen_map_mblocks(size);
  } else {
      ret = my_mmap(next_request, size);
203

204
205
      if (((W_)ret & MBLOCK_MASK) != 0) {
	  // misaligned block!
206
#if 0 // defined(DEBUG)
207
	  errorBelch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
208
#endif
209

210
211
212
213
214
215
216
	  // unmap this block...
	  if (munmap(ret, size) == -1) {
	      barf("getMBlock: munmap failed");
	  }
	  // and do it the hard way
	  ret = gen_map_mblocks(size);
      }
217
218
  }

219
  // Next time, we'll try to allocate right after the block we just got.
220
  // ToDo: check that we haven't already grabbed the memory at next_request
221
222
  next_request = ret + size;

223
  IF_DEBUG(gc,debugBelch("Allocated %d megablock(s) at %p\n",n,ret));
224

225
226
  // fill in the table
  for (i = 0; i < n; i++) {
227
      MARK_HEAP_ALLOCED( ret + i * MBLOCK_SIZE );
228
  }
229

230
  mblocks_allocated += n;
231

232
233
  return ret;
}
sof's avatar
sof committed
234

sof's avatar
sof committed
235
#else /* defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS) */
sof's avatar
sof committed
236
237
238
239
240

/*
 On Win32 platforms we make use of the two-phased virtual memory API
 to allocate mega blocks. We proceed as follows:

sof's avatar
sof committed
241
242
243
244
245
 Reserve a large chunk of VM (256M at the time, or what the user asked
 for via the -M option), but don't supply a base address that's aligned on
 a MB boundary. Instead we round up to the nearest mblock from the chunk of
 VM we're handed back from the OS (at the moment we just leave the 'slop' at
 the beginning of the reserved chunk unused - ToDo: reuse it .)
sof's avatar
sof committed
246
247

 Reserving memory doesn't allocate physical storage (not even in the
sof's avatar
sof committed
248
 page file), this is done later on by committing pages (or mega-blocks in
sof's avatar
sof committed
249
250
251
 our case).
*/

sof's avatar
sof committed
252
char* base_non_committed = (char*)0;
sof's avatar
sof committed
253
char* end_non_committed = (char*)0;
sof's avatar
sof committed
254

sof's avatar
sof committed
255
/* Default is to reserve 256M of VM to minimise the slop cost. */
256
#define SIZE_RESERVED_POOL  ( 256 * 1024 * 1024 )
sof's avatar
sof committed
257

sof's avatar
sof committed
258
259
260
/* Number of bytes reserved */
static unsigned long size_reserved_pool = SIZE_RESERVED_POOL;

sof's avatar
sof committed
261
262
263
264
265
266
void *
getMBlocks(nat n)
{
  static char* base_mblocks       = (char*)0;
  static char* next_request       = (char*)0;
  void* ret                       = (void*)0;
sof's avatar
sof committed
267
  nat i;
sof's avatar
sof committed
268
269

  lnat size = MBLOCK_SIZE * n;
sof's avatar
sof committed
270
271
272
  
  if ( (base_non_committed == 0) || (next_request + size > end_non_committed) ) {
    if (base_non_committed) {
sof's avatar
sof committed
273
274
275
276
277
278
279
	/* Tacky, but if no user-provided -M option is in effect,
	 * set it to the default (==256M) in time for the heap overflow PSA.
	 */
	if (RtsFlags.GcFlags.maxHeapSize == 0) {
	    RtsFlags.GcFlags.maxHeapSize = size_reserved_pool / BLOCK_SIZE;
	}
	heapOverflow();
sof's avatar
sof committed
280
281
282
283
284
285
286
    }
    if (RtsFlags.GcFlags.maxHeapSize != 0) {
      size_reserved_pool = BLOCK_SIZE * RtsFlags.GcFlags.maxHeapSize;
      if (size_reserved_pool < MBLOCK_SIZE) {
	size_reserved_pool = 2*MBLOCK_SIZE;
      }
    }
sof's avatar
sof committed
287
    base_non_committed = VirtualAlloc ( NULL
sof's avatar
sof committed
288
                                      , size_reserved_pool
sof's avatar
sof committed
289
290
291
292
				      , MEM_RESERVE
				      , PAGE_READWRITE
				      );
    if ( base_non_committed == 0 ) {
293
         errorBelch("getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
sof's avatar
sof committed
294
295
         ret=(void*)-1;
    } else {
sof's avatar
sof committed
296
297
      end_non_committed = (char*)base_non_committed + (unsigned long)size_reserved_pool;
      /* The returned pointer is not aligned on a mega-block boundary. Make it. */
298
      base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)~MBLOCK_MASK) + MBLOCK_SIZE;
299
#      if 0
300
301
       debugBelch("getMBlocks: Dropping %d bytes off of 256M chunk\n", 
		  (unsigned)base_mblocks - (unsigned)base_non_committed);
302
#      endif
sof's avatar
sof committed
303

sof's avatar
sof committed
304
       if ( ((char*)base_mblocks + size) > end_non_committed ) {
305
          debugBelch("getMBlocks: oops, committed too small a region to start with.");
sof's avatar
sof committed
306
307
308
309
310
311
312
313
314
315
	  ret=(void*)-1;
       } else {
          next_request = base_mblocks;
       }
    }
  }
  /* Commit the mega block(s) to phys mem */
  if ( ret != (void*)-1 ) {
     ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
     if (ret == NULL) {
316
        debugBelch("getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
sof's avatar
sof committed
317
318
319
320
321
        ret=(void*)-1;
     }
  }

  if (((W_)ret & MBLOCK_MASK) != 0) {
322
    barf("getMBlocks: misaligned block returned");
sof's avatar
sof committed
323
324
  }

325
326
327
  if (ret == (void*)-1) {
     barf("getMBlocks: unknown memory allocation failure on Win32.");
  }
sof's avatar
sof committed
328

329
  IF_DEBUG(gc,debugBelch("Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
sof's avatar
sof committed
330
331
332
333
  next_request = (char*)next_request + size;

  mblocks_allocated += n;
  
334
335
  // fill in the table
  for (i = 0; i < n; i++) {
336
      MARK_HEAP_ALLOCED ( ret + i * MBLOCK_SIZE );
337
338
  }

sof's avatar
sof committed
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
  return ret;
}

/* Hand back the physical memory that is allocated to a mega-block. 
   ToDo: chain the released mega block onto some list so that
         getMBlocks() can get at it.

   Currently unused.
*/
#if 0
void
freeMBlock(void* p, nat n)
{
  BOOL rc;

  rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
  
  if (rc == FALSE) {
357
#    ifdef DEBUG
358
     debugBelch("freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
359
#    endif
sof's avatar
sof committed
360
361
362
363
364
365
  }

}
#endif

#endif