MBlock.c 5.52 KB
Newer Older
1
/* -----------------------------------------------------------------------------
sebc's avatar
sebc committed
2
 * $Id: MBlock.c,v 1.25 2001/12/10 01:28:00 sebc 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
lnat mblocks_allocated = 0;

45
46
47
48
49
50
void *
getMBlock(void)
{
  return getMBlocks(1);
}

sof's avatar
sof committed
51
#ifndef _WIN32
52
53
54
void *
getMBlocks(nat n)
{
55
  static caddr_t next_request = (caddr_t)HEAP_BASE;
56
57
58
59
60
61
62
63
64
65
  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);
  }
66
67
68
#elif hpux_TARGET_OS
 ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
	     MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
sebc's avatar
sebc committed
69
#elif darwin_TARGET_OS
70
71
 ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
            MAP_FIXED | MAP_ANON | MAP_PRIVATE, -1, 0);
72
73
74
75
76
77
78
79
80
81
82
83
84
85
#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) {
86
    barf("GetMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
87
88
  }

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

  next_request += size;

93
94
  mblocks_allocated += n;
  
95
96
  return ret;
}
sof's avatar
sof committed
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115

#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
116
117
char* base_non_committed = (char*)0;

118
119
/* Reserve VM 256M at the time to try to minimise the slop cost. */
#define SIZE_RESERVED_POOL  ( 256 * 1024 * 1024 )
sof's avatar
sof committed
120
121

/* This predicate should be inlined, really. */
rrt's avatar
rrt committed
122
/* TODO: this only works for a single chunk */
sof's avatar
sof committed
123
124
125
126
int
is_heap_alloced(const void* x)
{
  return (((char*)(x) >= base_non_committed) && 
rrt's avatar
rrt committed
127
          ((char*)(x) <= (base_non_committed + SIZE_RESERVED_POOL)));
sof's avatar
sof committed
128
129
}

sof's avatar
sof committed
130
131
132
133
134
135
136
137
138
139
140
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
141
    if (base_non_committed)
142
        barf("Windows programs can only use 256Mb of heap; sorry!");
sof's avatar
sof committed
143
144
145
146
147
148
    base_non_committed = VirtualAlloc ( NULL
                                      , SIZE_RESERVED_POOL
				      , MEM_RESERVE
				      , PAGE_READWRITE
				      );
    if ( base_non_committed == 0 ) {
149
         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
sof's avatar
sof committed
150
151
152
         ret=(void*)-1;
    } else {
    /* The returned pointer is not aligned on a mega-block boundary. Make it. */
sof's avatar
sof committed
153
       base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)0xfff00000) + MBLOCK_SIZE;
154
155
#      if 0
       fprintf(stderr, "getMBlocks: Dropping %d bytes off of 256M chunk\n", 
sof's avatar
sof committed
156
	               (unsigned)base_mblocks - (unsigned)base_non_committed);
157
#      endif
sof's avatar
sof committed
158
159

       if ( ((char*)base_mblocks + size) > ((char*)base_non_committed + SIZE_RESERVED_POOL) ) {
160
          fprintf(stderr, "getMBlocks: oops, committed too small a region to start with.");
sof's avatar
sof committed
161
162
163
164
165
166
167
168
169
170
	  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) {
171
        fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
sof's avatar
sof committed
172
173
174
175
176
        ret=(void*)-1;
     }
  }

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

180
181
182
  if (ret == (void*)-1) {
     barf("getMBlocks: unknown memory allocation failure on Win32.");
  }
sof's avatar
sof committed
183

184
  IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
sof's avatar
sof committed
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
  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) {
207
#    ifdef DEBUG
sof's avatar
sof committed
208
     fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
209
#    endif
sof's avatar
sof committed
210
211
212
213
214
215
  }

}
#endif

#endif