MBlock.c 6.08 KB
Newer Older
1
/* -----------------------------------------------------------------------------
2
 * $Id: MBlock.c,v 1.29 2002/07/17 09:21:50 simonmar Exp $
3
4
 *
 * (c) The GHC Team 1998-1999
5
6
7
8
9
10
11
 *
 * MegaBlock Allocator Interface.  This file contains all the dirty
 * architecture-dependent hackery required to get a chunk of aligned
 * memory from the operating system.
 *
 * ---------------------------------------------------------------------------*/

12
13
/* This is non-posix compliant. */
/* #include "PosixSource.h" */
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

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

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif

sof's avatar
sof committed
29
30
31
32
#ifndef mingw32_TARGET_OS
# ifdef HAVE_SYS_MMAN_H
# include <sys/mman.h>
# endif
33
34
35
36
37
38
#endif

#ifdef HAVE_FCNTL_H
#include <fcntl.h>
#endif

sof's avatar
sof committed
39
#if HAVE_WINDOWS_H
40
41
42
#include <windows.h>
#endif

43
44
#include <errno.h>

45
46
lnat mblocks_allocated = 0;

47
48
49
50
51
52
void *
getMBlock(void)
{
  return getMBlocks(1);
}

sof's avatar
sof committed
53
#if !defined(mingw32_TARGET_OS) && !defined(cygwin32_TARGET_OS)
54
55
56
void *
getMBlocks(nat n)
{
57
  static caddr_t next_request = (caddr_t)HEAP_BASE;
58
59
60
61
62
63
64
65
66
67
  caddr_t ret;
  lnat size = MBLOCK_SIZE * n;
 
#ifdef solaris2_TARGET_OS
  { 
      int fd = open("/dev/zero",O_RDONLY);
      ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
		 MAP_FIXED | MAP_PRIVATE, fd, 0);
      close(fd);
  }
68
69
70
#elif hpux_TARGET_OS
 ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
	     MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
sebc's avatar
sebc committed
71
#elif darwin_TARGET_OS
72
73
 ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
            MAP_FIXED | MAP_ANON | MAP_PRIVATE, -1, 0);
74
75
76
77
78
79
80
#else
  ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
	     MAP_ANON | MAP_PRIVATE, -1, 0);
#endif
  
  if (ret == (void *)-1) {
    if (errno == ENOMEM) {
sof's avatar
sof committed
81
      barf("getMBlock: out of memory (blocks requested: %d)", n);
82
83
84
85
86
87
    } else {
      barf("GetMBlock: mmap failed");
    }
  }

  if (((W_)ret & MBLOCK_MASK) != 0) {
88
    barf("GetMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
89
90
  }

ken's avatar
ken committed
91
  IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %p\n",n,ret));
92
93
94

  next_request += size;

95
96
  mblocks_allocated += n;
  
97
98
  return ret;
}
sof's avatar
sof committed
99

sof's avatar
sof committed
100
#else /* defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS) */
sof's avatar
sof committed
101
102
103
104
105

/*
 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
106
107
108
109
110
 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
111
112

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

sof's avatar
sof committed
117
char* base_non_committed = (char*)0;
sof's avatar
sof committed
118
char* end_non_committed = (char*)0;
sof's avatar
sof committed
119

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

sof's avatar
sof committed
123
124
125
/* Number of bytes reserved */
static unsigned long size_reserved_pool = SIZE_RESERVED_POOL;

sof's avatar
sof committed
126
/* This predicate should be inlined, really. */
rrt's avatar
rrt committed
127
/* TODO: this only works for a single chunk */
sof's avatar
sof committed
128
129
130
131
int
is_heap_alloced(const void* x)
{
  return (((char*)(x) >= base_non_committed) && 
sof's avatar
sof committed
132
          ((char*)(x) <= end_non_committed));
sof's avatar
sof committed
133
134
}

sof's avatar
sof committed
135
136
137
138
139
140
141
142
void *
getMBlocks(nat n)
{
  static char* base_mblocks       = (char*)0;
  static char* next_request       = (char*)0;
  void* ret                       = (void*)0;

  lnat size = MBLOCK_SIZE * n;
sof's avatar
sof committed
143
144
145
146
147
148
149
150
151
152
153
  
  if ( (base_non_committed == 0) || (next_request + size > end_non_committed) ) {
    if (base_non_committed) {
      barf("RTS exhausted max heap size (%d bytes)\n", size_reserved_pool);
    }
    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
154
    base_non_committed = VirtualAlloc ( NULL
sof's avatar
sof committed
155
                                      , size_reserved_pool
sof's avatar
sof committed
156
157
158
159
				      , MEM_RESERVE
				      , PAGE_READWRITE
				      );
    if ( base_non_committed == 0 ) {
160
         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
sof's avatar
sof committed
161
162
         ret=(void*)-1;
    } else {
sof's avatar
sof committed
163
164
165
      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. */
      base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)0xfff00000) + MBLOCK_SIZE;
166
167
#      if 0
       fprintf(stderr, "getMBlocks: Dropping %d bytes off of 256M chunk\n", 
sof's avatar
sof committed
168
	               (unsigned)base_mblocks - (unsigned)base_non_committed);
169
#      endif
sof's avatar
sof committed
170

sof's avatar
sof committed
171
       if ( ((char*)base_mblocks + size) > end_non_committed ) {
172
          fprintf(stderr, "getMBlocks: oops, committed too small a region to start with.");
sof's avatar
sof committed
173
174
175
176
177
178
179
180
181
182
	  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) {
183
        fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
sof's avatar
sof committed
184
185
186
187
188
        ret=(void*)-1;
     }
  }

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

192
193
194
  if (ret == (void*)-1) {
     barf("getMBlocks: unknown memory allocation failure on Win32.");
  }
sof's avatar
sof committed
195

196
  IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
sof's avatar
sof committed
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
  next_request = (char*)next_request + size;

  mblocks_allocated += n;
  
  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) {
219
#    ifdef DEBUG
sof's avatar
sof committed
220
     fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
221
#    endif
sof's avatar
sof committed
222
223
224
225
226
227
  }

}
#endif

#endif