← Back to branch summary

~ubuntu-branches/debian/sid/ocaml/sid

« back to all changes in this revision

Viewing changes to byterun/memory.c

  • Committer: Bazaar Package Importer
  • Author(s): Stefano Zacchiroli
  • Date: 2009-02-22 08:49:13 UTC
  • mfrom: (12.1.1 squeeze)
  • Revision ID: james.westby@ubuntu.com-20090222084913-3i0uw2bhd0lgw0ok
* Uploading to unstable
* debian/control: bump dh-ocaml to (>= 0.4) to avoid buggy ocamlinit.mk

Show diffs side-by-side

added added

removed removed

Lines of Context:
byterun/memory.c
11
11
/*                                                                     */
12
12
/***********************************************************************/
13
13
 
14
 
/* $Id: memory.c,v 1.43.10.3 2008/02/12 21:26:29 doligez Exp $ */
 
14
/* $Id: memory.c,v 1.46.4.1 2008/11/02 14:30:05 xleroy Exp $ */
15
15
 
16
16
#include <stdlib.h>
17
17
#include <string.h>
29
29
 
30
30
extern uintnat caml_percent_free;                   /* major_gc.c */
31
31
 
32
 
#ifdef USE_MMAP_INSTEAD_OF_MALLOC
33
 
extern char * caml_aligned_mmap (asize_t size, int modulo, void ** block);
34
 
extern void caml_aligned_munmap (char * addr, asize_t size);
35
 
#endif
 
32
/* Page table management */
 
33
 
 
34
#define Page(p) ((uintnat) (p) >> Page_log)
 
35
#define Page_mask ((uintnat) -1 << Page_log)
 
36
 
 
37
#ifdef ARCH_SIXTYFOUR
 
38
 
 
39
/* 64-bit implementation:
 
40
   The page table is represented sparsely as a hash table
 
41
   with linear probing */
 
42
 
 
43
struct page_table {
 
44
  mlsize_t size;                /* size == 1 << (wordsize - shift) */
 
45
  int shift;
 
46
  mlsize_t mask;                /* mask == size - 1 */
 
47
  mlsize_t occupancy;
 
48
  uintnat * entries;            /* [size]  */
 
49
};
 
50
 
 
51
static struct page_table caml_page_table;
 
52
 
 
53
/* Page table entries are the logical 'or' of
 
54
   - the key: address of a page (low Page_log bits = 0)
 
55
   - the data: a 8-bit integer */
 
56
 
 
57
#define Page_entry_matches(entry,addr) \
 
58
  ((((entry) ^ (addr)) & Page_mask) == 0)
 
59
 
 
60
/* Multiplicative Fibonacci hashing
 
61
   (Knuth, TAOCP vol 3, section 6.4, page 518).
 
62
   HASH_FACTOR is (sqrt(5) - 1) / 2 * 2^wordsize. */
 
63
#ifdef ARCH_SIXTYFOUR
 
64
#define HASH_FACTOR 11400714819323198486UL
 
65
#else
 
66
#define HASH_FACTOR 2654435769UL
 
67
#endif
 
68
#define Hash(v) (((v) * HASH_FACTOR) >> caml_page_table.shift)
 
69
 
 
70
int caml_page_table_lookup(void * addr)
 
71
{
 
72
  uintnat h, e;
 
73
 
 
74
  h = Hash(Page(addr));
 
75
  /* The first hit is almost always successful, so optimize for this case */
 
76
  e = caml_page_table.entries[h];
 
77
  if (Page_entry_matches(e, (uintnat)addr)) return e & 0xFF;
 
78
  while(1) {
 
79
    if (e == 0) return 0;
 
80
    h = (h + 1) & caml_page_table.mask;
 
81
    e = caml_page_table.entries[h];
 
82
    if (Page_entry_matches(e, (uintnat)addr)) return e & 0xFF;
 
83
  }
 
84
}
 
85
 
 
86
int caml_page_table_initialize(mlsize_t bytesize)
 
87
{
 
88
  uintnat pagesize = Page(bytesize);
 
89
 
 
90
  caml_page_table.size = 1;
 
91
  caml_page_table.shift = 8 * sizeof(uintnat);
 
92
  /* Aim for initial load factor between 1/4 and 1/2 */
 
93
  while (caml_page_table.size < 2 * pagesize) {
 
94
    caml_page_table.size <<= 1;
 
95
    caml_page_table.shift -= 1;
 
96
  }
 
97
  caml_page_table.mask = caml_page_table.size - 1;
 
98
  caml_page_table.occupancy = 0;
 
99
  caml_page_table.entries = calloc(caml_page_table.size, sizeof(uintnat));
 
100
  if (caml_page_table.entries == NULL)
 
101
    return -1;
 
102
  else
 
103
    return 0;
 
104
}
 
105
 
 
106
static int caml_page_table_resize(void)
 
107
{
 
108
  struct page_table old = caml_page_table;
 
109
  uintnat * new_entries;
 
110
  uintnat i, h;
 
111
 
 
112
  caml_gc_message (0x08, "Growing page table to %lu entries\n",
 
113
                   caml_page_table.size);
 
114
 
 
115
  new_entries = calloc(2 * old.size, sizeof(uintnat));
 
116
  if (new_entries == NULL) {
 
117
    caml_gc_message (0x08, "No room for growing page table\n", 0);
 
118
    return -1;
 
119
  }
 
120
 
 
121
  caml_page_table.size = 2 * old.size;
 
122
  caml_page_table.shift = old.shift - 1;
 
123
  caml_page_table.mask = caml_page_table.size - 1;
 
124
  caml_page_table.occupancy = old.occupancy;
 
125
  caml_page_table.entries = new_entries;
 
126
 
 
127
  for (i = 0; i < old.size; i++) {
 
128
    uintnat e = old.entries[i];
 
129
    if (e == 0) continue;
 
130
    h = Hash(Page(e));
 
131
    while (caml_page_table.entries[h] != 0)
 
132
      h = (h + 1) & caml_page_table.mask;
 
133
    caml_page_table.entries[h] = e;
 
134
  }
 
135
 
 
136
  free(old.entries);
 
137
  return 0;
 
138
}
 
139
 
 
140
static int caml_page_table_modify(uintnat page, int toclear, int toset)
 
141
{
 
142
  uintnat h;
 
143
 
 
144
  Assert ((page & ~Page_mask) == 0);
 
145
 
 
146
  /* Resize to keep load factor below 1/2 */
 
147
  if (caml_page_table.occupancy * 2 >= caml_page_table.size) {
 
148
    if (caml_page_table_resize() != 0) return -1;
 
149
  }
 
150
  h = Hash(Page(page));
 
151
  while (1) {
 
152
    if (caml_page_table.entries[h] == 0) {
 
153
      caml_page_table.entries[h] = page | toset;
 
154
      caml_page_table.occupancy++;
 
155
      break;
 
156
    }
 
157
    if (Page_entry_matches(caml_page_table.entries[h], page)) {
 
158
      caml_page_table.entries[h] =
 
159
        (caml_page_table.entries[h] & ~toclear) | toset;
 
160
      break;
 
161
    }
 
162
    h = (h + 1) & caml_page_table.mask;
 
163
  }
 
164
  return 0;
 
165
}
 
166
 
 
167
#else
 
168
 
 
169
/* 32-bit implementation:
 
170
   The page table is represented as a 2-level array of unsigned char */
 
171
 
 
172
CAMLexport unsigned char * caml_page_table[Pagetable1_size];
 
173
static unsigned char caml_page_table_empty[Pagetable2_size] = { 0, };
 
174
 
 
175
int caml_page_table_initialize(mlsize_t bytesize)
 
176
{
 
177
  int i;
 
178
  for (i = 0; i < Pagetable1_size; i++) 
 
179
    caml_page_table[i] = caml_page_table_empty;
 
180
  return 0;
 
181
}
 
182
 
 
183
static int caml_page_table_modify(uintnat page, int toclear, int toset)
 
184
{
 
185
  uintnat i = Pagetable_index1(page);
 
186
  uintnat j = Pagetable_index2(page);
 
187
 
 
188
  if (caml_page_table[i] == caml_page_table_empty) {
 
189
    unsigned char * new_tbl = calloc(Pagetable2_size, 1);
 
190
    if (new_tbl == 0) return -1;
 
191
    caml_page_table[i] = new_tbl;
 
192
  }
 
193
  caml_page_table[i][j] = (caml_page_table[i][j] & ~toclear) | toset;
 
194
  return 0;
 
195
}
 
196
 
 
197
#endif
 
198
 
 
199
int caml_page_table_add(int kind, void * start, void * end)
 
200
{
 
201
  uintnat pstart = (uintnat) start & Page_mask;
 
202
  uintnat pend = ((uintnat) end - 1) & Page_mask;
 
203
  uintnat p;
 
204
 
 
205
  for (p = pstart; p <= pend; p += Page_size)
 
206
    if (caml_page_table_modify(p, 0, kind) != 0) return -1;
 
207
  return 0;
 
208
}
 
209
 
 
210
int caml_page_table_remove(int kind, void * start, void * end)
 
211
{
 
212
  uintnat pstart = (uintnat) start & Page_mask;
 
213
  uintnat pend = ((uintnat) end - 1) & Page_mask;
 
214
  uintnat p;
 
215
 
 
216
  for (p = pstart; p <= pend; p += Page_size)
 
217
    if (caml_page_table_modify(p, kind, 0) != 0) return -1;
 
218
  return 0;
 
219
}
36
220
 
37
221
/* Allocate a block of the requested size, to be passed to
38
222
   [caml_add_to_heap] later.
46
230
  char *mem;
47
231
  void *block;
48
232
                                              Assert (request % Page_size == 0);
49
 
#ifdef USE_MMAP_INSTEAD_OF_MALLOC
50
 
  mem = caml_aligned_mmap (request + sizeof (heap_chunk_head),
51
 
                           sizeof (heap_chunk_head), &block);
52
 
#else
53
233
  mem = caml_aligned_malloc (request + sizeof (heap_chunk_head),
54
234
                             sizeof (heap_chunk_head), &block);
55
 
#endif
56
235
  if (mem == NULL) return NULL;
57
236
  mem += sizeof (heap_chunk_head);
58
237
  Chunk_size (mem) = request;
65
244
*/
66
245
void caml_free_for_heap (char *mem)
67
246
{
68
 
#ifdef USE_MMAP_INSTEAD_OF_MALLOC
69
 
  caml_aligned_munmap (Chunk_block (mem),
70
 
                       Chunk_size (mem) + sizeof (heap_chunk_head));
71
 
#else
72
247
  free (Chunk_block (mem));
73
 
#endif
74
248
}
75
249
 
76
250
/* Take a chunk of memory as argument, which must be the result of a
78
252
   The contents of the chunk must be a sequence of valid blocks and
79
253
   fragments: no space between blocks and no trailing garbage.  If
80
254
   some blocks are blue, they must be added to the free list by the
81
 
   caller.  All other blocks must have the color [caml_allocation_color(mem)].
 
255
   caller.  All other blocks must have the color [caml_allocation_color(m)].
82
256
   The caller must update [caml_allocated_words] if applicable.
83
257
   Return value: 0 if no error; -1 in case of error.
84
258
*/
85
259
int caml_add_to_heap (char *m)
86
260
{
87
 
  asize_t i;
88
261
                                     Assert (Chunk_size (m) % Page_size == 0);
89
262
#ifdef DEBUG
90
263
  /* Should check the contents of the block. */
93
266
  caml_gc_message (0x04, "Growing heap to %luk bytes\n",
94
267
                   (caml_stat_heap_size + Chunk_size (m)) / 1024);
95
268
 
96
 
  /* Extend the page table as needed. */
97
 
  if (Page (m) < caml_page_low){
98
 
    page_table_entry *block, *new_page_table;
99
 
    asize_t new_page_low = Page (m);
100
 
    asize_t new_size = caml_page_high - new_page_low;
101
 
 
102
 
    caml_gc_message (0x08, "Growing page table to %lu entries\n", new_size);
103
 
    block = malloc (new_size * sizeof (page_table_entry));
104
 
    if (block == NULL){
105
 
      caml_gc_message (0x08, "No room for growing page table\n", 0);
106
 
      return -1;
107
 
    }
108
 
    new_page_table = block - new_page_low;
109
 
    for (i = new_page_low; i < caml_page_low; i++){
110
 
      new_page_table [i] = Not_in_heap;
111
 
    }
112
 
    for (i = caml_page_low; i < caml_page_high; i++){
113
 
      new_page_table [i] = caml_page_table [i];
114
 
    }
115
 
    free (caml_page_table + caml_page_low);
116
 
    caml_page_table = new_page_table;
117
 
    caml_page_low = new_page_low;
118
 
  }
119
 
  if (Page (m + Chunk_size (m)) > caml_page_high){
120
 
    page_table_entry *block, *new_page_table;
121
 
    asize_t new_page_high = Page (m + Chunk_size (m));
122
 
    asize_t new_size = new_page_high - caml_page_low;
123
 
 
124
 
    caml_gc_message (0x08, "Growing page table to %lu entries\n", new_size);
125
 
    block = malloc (new_size * sizeof (page_table_entry));
126
 
    if (block == NULL){
127
 
      caml_gc_message (0x08, "No room for growing page table\n", 0);
128
 
      return -1;
129
 
    }
130
 
    new_page_table = block - caml_page_low;
131
 
    for (i = caml_page_low; i < caml_page_high; i++){
132
 
      new_page_table [i] = caml_page_table [i];
133
 
    }
134
 
    for (i = caml_page_high; i < new_page_high; i++){
135
 
      new_page_table [i] = Not_in_heap;
136
 
    }
137
 
    free (caml_page_table + caml_page_low);
138
 
    caml_page_table = new_page_table;
139
 
    caml_page_high = new_page_high;
140
 
  }
141
 
 
142
 
  /* Mark the pages as being in the heap. */
143
 
  for (i = Page (m); i < Page (m + Chunk_size (m)); i++){
144
 
    caml_page_table [i] = In_heap;
145
 
  }
 
269
  /* Register block in page table */
 
270
  if (caml_page_table_add(In_heap, m, m + Chunk_size(m)) != 0)
 
271
    return -1;
146
272
 
147
273
  /* Chain this heap chunk. */
148
274
  {
159
285
    ++ caml_stat_heap_chunks;
160
286
  }
161
287
 
162
 
  /* Update the heap bounds as needed. */
163
 
  /* already done:   if (m < caml_heap_start) heap_start = m; */
164
 
  if (m + Chunk_size (m) > caml_heap_end) caml_heap_end = m + Chunk_size (m);
165
 
 
166
288
  caml_stat_heap_size += Chunk_size (m);
167
289
  if (caml_stat_heap_size > caml_stat_top_heap_size){
168
290
    caml_stat_top_heap_size = caml_stat_heap_size;
230
352
void caml_shrink_heap (char *chunk)
231
353
{
232
354
  char **cp;
233
 
  asize_t i;
234
355
 
235
356
  /* Never deallocate the first block, because caml_heap_start is both the
236
357
     first block and the base address for page numbers, and we don't
242
363
 
243
364
  caml_stat_heap_size -= Chunk_size (chunk);
244
365
  caml_gc_message (0x04, "Shrinking heap to %luk bytes\n",
245
 
                   caml_stat_heap_size / 1024);
 
366
                   (unsigned long) caml_stat_heap_size / 1024);
246
367
 
247
368
#ifdef DEBUG
248
369
  {
261
382
  *cp = Chunk_next (chunk);
262
383
 
263
384
  /* Remove the pages of [chunk] from the page table. */
264
 
  for (i = Page (chunk); i < Page (chunk + Chunk_size (chunk)); i++){
265
 
    caml_page_table [i] = Not_in_heap;
266
 
  }
 
385
  caml_page_table_remove(In_heap, chunk, chunk + Chunk_size (chunk));
267
386
 
268
387
  /* Free the [malloc] block that contains [chunk]. */
269
388
  caml_free_for_heap (chunk);