MBlock.c 6.18 KB
Newer Older
1
/* -----------------------------------------------------------------------------
rrt's avatar
rrt committed
2
 * $Id: MBlock.c,v 1.18 2000/09/06 11:12:07 rrt Exp $
3
4
 *
 * (c) The GHC Team 1998-1999
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 *
 * MegaBlock Allocator Interface.  This file contains all the dirty
 * architecture-dependent hackery required to get a chunk of aligned
 * memory from the operating system.
 *
 * ---------------------------------------------------------------------------*/

#define NON_POSIX_SOURCE

#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
28
29
30
31
#ifndef mingw32_TARGET_OS
# ifdef HAVE_SYS_MMAN_H
# include <sys/mman.h>
# endif
32
33
34
35
36
37
#endif

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

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

42
#if freebsd2_TARGET_OS || freebsd_TARGET_OS
43
44
45
46
47
48
49
/* Executable is loaded from      0x0
 * Shared libraries are loaded at 0x2000000
 * Stack is at the top of the address space.  The kernel probably owns
 * 0x8000000 onwards, so we'll pick 0x5000000.
 */
#define ASK_FOR_MEM_AT 0x50000000

50
51
52
53
#elif netbsd_TARGET_OS
/* NetBSD i386 shared libs are at 0x40000000
 */
#define ASK_FOR_MEM_AT 0x50000000
54
55
#elif openbsd_TARGET_OS
#define ASK_FOR_MEM_AT 0x50000000
56
57
58
59
60
61
62
63
64
#elif linux_TARGET_OS
/* Any ideas?
 */
#define ASK_FOR_MEM_AT 0x50000000

#elif solaris2_TARGET_OS
/* guess */
#define ASK_FOR_MEM_AT 0x50000000

sof's avatar
sof committed
65
66
67
68
#elif osf3_TARGET_OS
/* guess */
#define ASK_FOR_MEM_AT 0x50000000

69
70
71
72
#elif hpux_TARGET_OS
/* guess */
#define ASK_FOR_MEM_AT 0x50000000

73
74
75
#elif _WIN32
/* doesn't matter, we use a reserve/commit algorithm */

76
77
78
79
80
#else
#error Dont know where to get memory from on this architecture
/* ToDo: memory locations on other architectures */
#endif

81
82
lnat mblocks_allocated = 0;

83
84
85
86
87
88
void *
getMBlock(void)
{
  return getMBlocks(1);
}

sof's avatar
sof committed
89
#ifndef _WIN32
90
91
92
93
94
95
96
97
98
99
100
101
102
103
void *
getMBlocks(nat n)
{
  static caddr_t next_request = (caddr_t)ASK_FOR_MEM_AT;
  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);
  }
104
105
106
#elif hpux_TARGET_OS
 ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
	     MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
#else
  ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
	     MAP_ANON | MAP_PRIVATE, -1, 0);
#endif
  
  if (ret == (void *)-1) {
    if (errno == ENOMEM) {
      barf("getMBlock: out of memory");
    } else {
      barf("GetMBlock: mmap failed");
    }
  }

  if (((W_)ret & MBLOCK_MASK) != 0) {
    barf("GetMBlock: misaligned block returned");
  }

  IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));

  next_request += size;

128
129
  mblocks_allocated += n;
  
130
131
  return ret;
}
sof's avatar
sof committed
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150

#else /* _WIN32 */

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

 Reserve a large chunk of VM (128M at the time), but don't supply a 
 base address that's aligned on a MB boundary. Instead we round up to the
 nearest from the chunk of VM we're given back from the OS (at the
 moment we just leave the 'slop' at the beginning of the reserved
 chunk unused - ToDo: reuse it .)

 Reserving memory doesn't allocate physical storage (not even in the
 page file), this is done by committing pages (or mega-blocks in
 our case).

*/

sof's avatar
sof committed
151
152
153
154
155
156
char* base_non_committed = (char*)0;

/* Reserve VM 128M at the time to try to minimise the slop cost. */
#define SIZE_RESERVED_POOL  ( 128 * 1024 * 1024 )

/* This predicate should be inlined, really. */
rrt's avatar
rrt committed
157
/* TODO: this only works for a single chunk */
sof's avatar
sof committed
158
159
160
161
int
is_heap_alloced(const void* x)
{
  return (((char*)(x) >= base_non_committed) && 
rrt's avatar
rrt committed
162
          ((char*)(x) <= (base_non_committed + SIZE_RESERVED_POOL)));
sof's avatar
sof committed
163
164
}

sof's avatar
sof committed
165
166
167
168
169
170
171
172
173
174
175
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;

  if ( (base_non_committed == 0) || 
       (next_request + size > base_non_committed + SIZE_RESERVED_POOL) ) {
rrt's avatar
rrt committed
176
#ifdef ENABLE_WIN32_DLL_SUPPORT
rrt's avatar
rrt committed
177
178
    if (base_non_committed)
        barf("Windows programs can only use 128Mb of heap; sorry!");
rrt's avatar
rrt committed
179
#endif
sof's avatar
sof committed
180
181
182
183
184
185
    base_non_committed = VirtualAlloc ( NULL
                                      , SIZE_RESERVED_POOL
				      , MEM_RESERVE
				      , PAGE_READWRITE
				      );
    if ( base_non_committed == 0 ) {
sof's avatar
sof committed
186
# if 1 /*def DEBUG*/
sof's avatar
sof committed
187
188
189
190
191
         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
# endif
         ret=(void*)-1;
    } else {
    /* The returned pointer is not aligned on a mega-block boundary. Make it. */
sof's avatar
sof committed
192
       base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)0xfff00000) + MBLOCK_SIZE;
sof's avatar
sof committed
193
194
195
196
197
198
# if 0
       fprintf(stderr, "Dropping %d bytes off of 128M chunk\n", 
	               (unsigned)base_mblocks - (unsigned)base_non_committed);
# endif

       if ( ((char*)base_mblocks + size) > ((char*)base_non_committed + SIZE_RESERVED_POOL) ) {
sof's avatar
sof committed
199
# if 1 /*def DEBUG*/
sof's avatar
sof committed
200
201
202
203
204
205
206
207
208
209
210
211
          fprintf(stderr, "oops, committed too small a region to start with.");
# endif
	  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) {
sof's avatar
sof committed
212
# if 1 /*def DEBUG*/
sof's avatar
sof committed
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
        fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
# endif
        ret=(void*)-1;
     }
  }

  if (((W_)ret & MBLOCK_MASK) != 0) {
    barf("GetMBlock: misaligned block returned");
  }

  IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));

  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) {
# ifdef DEBUG
     fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
# endif
  }

}
#endif

#endif