#ifdef emacs
#include <config.h>
#include "lisp.h"
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
typedef POINTER_TYPE *POINTER;
typedef size_t SIZE;
extern void safe_bcopy ();
#ifdef DOUG_LEA_MALLOC
#define M_TOP_PAD -2
extern int mallopt ();
#else
#ifndef SYSTEM_MALLOC
extern size_t __malloc_extra_blocks;
#endif
#endif
#else
#include <stddef.h>
typedef size_t SIZE;
typedef void *POINTER;
#include <unistd.h>
#include <malloc.h>
#define safe_bcopy(x, y, z) memmove (y, x, z)
#define bzero(x, len) memset (x, 0, len)
#endif
#include "getpagesize.h"
#define NIL ((POINTER) 0)
static int r_alloc_initialized = 0;
static void r_alloc_init ();
POINTER (*real_morecore) ();
static POINTER virtual_break_value;
static POINTER break_value;
static int page_size;
static int extra_bytes;
#define PAGE (getpagesize ())
#define ALIGNED(addr) (((unsigned long int) (addr) & (page_size - 1)) == 0)
#define ROUNDUP(size) (((unsigned long int) (size) + page_size - 1) \
& ~(page_size - 1))
#define ROUND_TO_PAGE(addr) (addr & (~(page_size - 1)))
#define MEM_ALIGN sizeof(double)
#define MEM_ROUNDUP(addr) (((unsigned long int)(addr) + MEM_ALIGN - 1) \
& ~(MEM_ALIGN - 1))
#ifndef SYSTEM_MALLOC
extern POINTER (*__morecore) ();
#endif
typedef struct heap
{
struct heap *next;
struct heap *prev;
POINTER start;
POINTER end;
POINTER bloc_start;
POINTER free;
struct bp *first_bloc;
struct bp *last_bloc;
} *heap_ptr;
#define NIL_HEAP ((heap_ptr) 0)
#define HEAP_PTR_SIZE (sizeof (struct heap))
static struct heap heap_base;
static heap_ptr first_heap, last_heap;
typedef struct bp
{
struct bp *next;
struct bp *prev;
POINTER *variable;
POINTER data;
SIZE size;
POINTER new_data;
struct heap *heap;
} *bloc_ptr;
#define NIL_BLOC ((bloc_ptr) 0)
#define BLOC_PTR_SIZE (sizeof (struct bp))
static bloc_ptr first_bloc, last_bloc;
static int use_relocatable_buffers;
static int r_alloc_freeze_level;
static heap_ptr
find_heap (address)
POINTER address;
{
heap_ptr heap;
for (heap = last_heap; heap; heap = heap->prev)
{
if (heap->start <= address && address <= heap->end)
return heap;
}
return NIL_HEAP;
}
static POINTER
obtain (address, size)
POINTER address;
SIZE size;
{
heap_ptr heap;
SIZE already_available;
for (heap = last_heap; heap; heap = heap->prev)
{
if (heap->start <= address && address <= heap->end)
break;
}
if (! heap)
abort ();
while (heap && (char *) address + size > (char *) heap->end)
{
heap = heap->next;
if (heap == NIL_HEAP)
break;
address = heap->bloc_start;
}
if (heap == NIL_HEAP)
{
POINTER new = (*real_morecore)(0);
SIZE get;
already_available = (char *)last_heap->end - (char *)address;
if (new != last_heap->end)
{
heap_ptr new_heap = (heap_ptr) MEM_ROUNDUP (new);
POINTER bloc_start = (POINTER) MEM_ROUNDUP ((POINTER)(new_heap + 1));
if ((*real_morecore) ((char *) bloc_start - (char *) new) != new)
return 0;
new_heap->start = new;
new_heap->end = bloc_start;
new_heap->bloc_start = bloc_start;
new_heap->free = bloc_start;
new_heap->next = NIL_HEAP;
new_heap->prev = last_heap;
new_heap->first_bloc = NIL_BLOC;
new_heap->last_bloc = NIL_BLOC;
last_heap->next = new_heap;
last_heap = new_heap;
address = bloc_start;
already_available = 0;
}
get = size + extra_bytes - already_available;
get = (char *) ROUNDUP ((char *)last_heap->end + get)
- (char *) last_heap->end;
if ((*real_morecore) (get) != last_heap->end)
return 0;
last_heap->end = (char *) last_heap->end + get;
}
return address;
}
static void
relinquish ()
{
register heap_ptr h;
int excess = 0;
for (h = last_heap; h && break_value < h->end; h = h->prev)
{
excess += (char *) h->end - (char *) ((break_value < h->bloc_start)
? h->bloc_start : break_value);
}
if (excess > extra_bytes * 2 && (*real_morecore) (0) == last_heap->end)
{
excess -= extra_bytes;
if ((char *)last_heap->end - (char *)last_heap->bloc_start <= excess)
{
if (last_heap->first_bloc != NIL_BLOC
|| last_heap->last_bloc != NIL_BLOC)
abort ();
excess = (char *)last_heap->end - (char *)last_heap->start;
last_heap = last_heap->prev;
last_heap->next = NIL_HEAP;
}
else
{
excess = (char *) last_heap->end
- (char *) ROUNDUP ((char *)last_heap->end - excess);
last_heap->end = (char *) last_heap->end - excess;
}
if ((*real_morecore) (- excess) == 0)
{
last_heap->end = (char *) last_heap->end + excess;
if (last_heap->end != (*real_morecore) (0))
abort ();
}
}
}
long
r_alloc_size_in_use ()
{
return (char *) break_value - (char *) virtual_break_value;
}
static bloc_ptr
find_bloc (ptr)
POINTER *ptr;
{
register bloc_ptr p = first_bloc;
while (p != NIL_BLOC)
{
if (p->variable == ptr && p->data == *ptr)
return p;
p = p->next;
}
return p;
}
static bloc_ptr
get_bloc (size)
SIZE size;
{
register bloc_ptr new_bloc;
register heap_ptr heap;
if (! (new_bloc = (bloc_ptr) malloc (BLOC_PTR_SIZE))
|| ! (new_bloc->data = obtain (break_value, size)))
{
if (new_bloc)
free (new_bloc);
return 0;
}
break_value = (char *) new_bloc->data + size;
new_bloc->size = size;
new_bloc->next = NIL_BLOC;
new_bloc->variable = (POINTER *) NIL;
new_bloc->new_data = 0;
heap = find_heap (new_bloc->data);
heap->free = break_value;
new_bloc->heap = heap;
heap->last_bloc = new_bloc;
if (heap->first_bloc == NIL_BLOC)
heap->first_bloc = new_bloc;
if (first_bloc)
{
new_bloc->prev = last_bloc;
last_bloc->next = new_bloc;
last_bloc = new_bloc;
}
else
{
first_bloc = last_bloc = new_bloc;
new_bloc->prev = NIL_BLOC;
}
return new_bloc;
}
static int
relocate_blocs (bloc, heap, address)
bloc_ptr bloc;
heap_ptr heap;
POINTER address;
{
register bloc_ptr b = bloc;
if (r_alloc_freeze_level)
abort();
while (b)
{
while (heap && (char *) address + b->size > (char *) heap->end)
{
heap = heap->next;
if (heap == NIL_HEAP)
break;
address = heap->bloc_start;
}
if (heap == NIL_HEAP)
{
register bloc_ptr tb = b;
register SIZE s = 0;
while (tb != NIL_BLOC)
{
if (tb->variable)
s += tb->size;
tb = tb->next;
}
address = obtain (address, s);
if (address == 0)
return 0;
heap = last_heap;
}
b->new_data = address;
if (b->variable)
address = (char *) address + b->size;
b = b->next;
}
return 1;
}
static void
reorder_bloc (bloc, before)
bloc_ptr bloc, before;
{
bloc_ptr prev, next;
prev = bloc->prev;
next = bloc->next;
if (prev)
prev->next = next;
if (next)
next->prev = prev;
prev = before->prev;
if (prev)
prev->next = bloc;
bloc->prev = prev;
before->prev = bloc;
bloc->next = before;
}
static void
update_heap_bloc_correspondence (bloc, heap)
bloc_ptr bloc;
heap_ptr heap;
{
register bloc_ptr b;
if (bloc != NIL_BLOC && bloc->prev != NIL_BLOC && bloc->prev->heap == heap)
{
heap->last_bloc = bloc->prev;
heap->free = (char *) bloc->prev->data + bloc->prev->size;
}
else
{
heap->first_bloc = NIL_BLOC;
heap->last_bloc = NIL_BLOC;
heap->free = heap->bloc_start;
}
for (b = bloc; b != NIL_BLOC; b = b->next)
{
while (heap)
{
if (heap->bloc_start <= b->data && b->data <= heap->end)
break;
heap = heap->next;
heap->first_bloc = NIL_BLOC;
heap->last_bloc = NIL_BLOC;
heap->free = heap->bloc_start;
}
heap->free = (char *) b->data + b->size;
heap->last_bloc = b;
if (heap->first_bloc == NIL_BLOC)
heap->first_bloc = b;
b->heap = heap;
}
heap = heap->next;
while (heap)
{
heap->first_bloc = NIL_BLOC;
heap->last_bloc = NIL_BLOC;
heap->free = heap->bloc_start;
heap = heap->next;
}
}
static int
resize_bloc (bloc, size)
bloc_ptr bloc;
SIZE size;
{
register bloc_ptr b;
heap_ptr heap;
POINTER address;
SIZE old_size;
if (r_alloc_freeze_level)
abort();
if (bloc == NIL_BLOC || size == bloc->size)
return 1;
for (heap = first_heap; heap != NIL_HEAP; heap = heap->next)
{
if (heap->bloc_start <= bloc->data && bloc->data <= heap->end)
break;
}
if (heap == NIL_HEAP)
abort ();
old_size = bloc->size;
bloc->size = size;
address = (bloc->prev ? (char *) bloc->prev->data + bloc->prev->size
: (char *) first_heap->bloc_start);
while (heap)
{
if (heap->bloc_start <= address && address <= heap->end)
break;
heap = heap->prev;
}
if (! relocate_blocs (bloc, heap, address))
{
bloc->size = old_size;
return 0;
}
if (size > old_size)
{
for (b = last_bloc; b != bloc; b = b->prev)
{
if (!b->variable)
{
b->size = 0;
b->data = b->new_data;
}
else
{
safe_bcopy (b->data, b->new_data, b->size);
*b->variable = b->data = b->new_data;
}
}
if (!bloc->variable)
{
bloc->size = 0;
bloc->data = bloc->new_data;
}
else
{
safe_bcopy (bloc->data, bloc->new_data, old_size);
bzero ((char *) bloc->new_data + old_size, size - old_size);
*bloc->variable = bloc->data = bloc->new_data;
}
}
else
{
for (b = bloc; b != NIL_BLOC; b = b->next)
{
if (!b->variable)
{
b->size = 0;
b->data = b->new_data;
}
else
{
safe_bcopy (b->data, b->new_data, b->size);
*b->variable = b->data = b->new_data;
}
}
}
update_heap_bloc_correspondence (bloc, heap);
break_value = (last_bloc ? (char *) last_bloc->data + last_bloc->size
: (char *) first_heap->bloc_start);
return 1;
}
static void
free_bloc (bloc)
bloc_ptr bloc;
{
heap_ptr heap = bloc->heap;
if (r_alloc_freeze_level)
{
bloc->variable = (POINTER *) NIL;
return;
}
resize_bloc (bloc, 0);
if (bloc == first_bloc && bloc == last_bloc)
{
first_bloc = last_bloc = NIL_BLOC;
}
else if (bloc == last_bloc)
{
last_bloc = bloc->prev;
last_bloc->next = NIL_BLOC;
}
else if (bloc == first_bloc)
{
first_bloc = bloc->next;
first_bloc->prev = NIL_BLOC;
}
else
{
bloc->next->prev = bloc->prev;
bloc->prev->next = bloc->next;
}
if (heap->first_bloc == bloc)
{
if (bloc->next != 0 && bloc->next->heap == heap)
heap->first_bloc = bloc->next;
else
heap->first_bloc = heap->last_bloc = NIL_BLOC;
}
if (heap->last_bloc == bloc)
{
if (bloc->prev != 0 && bloc->prev->heap == heap)
heap->last_bloc = bloc->prev;
else
heap->first_bloc = heap->last_bloc = NIL_BLOC;
}
relinquish ();
free (bloc);
}
POINTER
r_alloc_sbrk (size)
long size;
{
register bloc_ptr b;
POINTER address;
if (! r_alloc_initialized)
r_alloc_init ();
if (! use_relocatable_buffers)
return (*real_morecore) (size);
if (size == 0)
return virtual_break_value;
if (size > 0)
{
POINTER new_bloc_start;
heap_ptr h = first_heap;
SIZE get = ROUNDUP (size);
address = (POINTER) ROUNDUP (virtual_break_value);
while ((char *) h->end < (char *) MEM_ROUNDUP ((char *)address + get))
{
h = h->next;
if (h == NIL_HEAP)
break;
address = (POINTER) ROUNDUP (h->start);
}
if (h == NIL_HEAP)
{
get += extra_bytes + page_size;
if (! obtain (address, get))
return 0;
if (first_heap == last_heap)
address = (POINTER) ROUNDUP (virtual_break_value);
else
address = (POINTER) ROUNDUP (last_heap->start);
h = last_heap;
}
new_bloc_start = (POINTER) MEM_ROUNDUP ((char *)address + get);
if (first_heap->bloc_start < new_bloc_start)
{
if (r_alloc_freeze_level)
return NIL;
if (! relocate_blocs (first_bloc, h, new_bloc_start))
return 0;
for (b = last_bloc; b != NIL_BLOC; b = b->prev)
{
safe_bcopy (b->data, b->new_data, b->size);
*b->variable = b->data = b->new_data;
}
h->bloc_start = new_bloc_start;
update_heap_bloc_correspondence (first_bloc, h);
}
if (h != first_heap)
{
first_heap->prev = NIL_HEAP;
first_heap->next = h->next;
first_heap->start = h->start;
first_heap->end = h->end;
first_heap->free = h->free;
first_heap->first_bloc = h->first_bloc;
first_heap->last_bloc = h->last_bloc;
first_heap->bloc_start = h->bloc_start;
if (first_heap->next)
first_heap->next->prev = first_heap;
else
last_heap = first_heap;
}
bzero (address, size);
}
else
{
SIZE excess = (char *)first_heap->bloc_start
- ((char *)virtual_break_value + size);
address = virtual_break_value;
if (r_alloc_freeze_level == 0 && excess > 2 * extra_bytes)
{
excess -= extra_bytes;
first_heap->bloc_start
= (POINTER) MEM_ROUNDUP ((char *)first_heap->bloc_start - excess);
relocate_blocs (first_bloc, first_heap, first_heap->bloc_start);
for (b = first_bloc; b != NIL_BLOC; b = b->next)
{
safe_bcopy (b->data, b->new_data, b->size);
*b->variable = b->data = b->new_data;
}
}
if ((char *)virtual_break_value + size < (char *)first_heap->start)
{
first_heap->start = (POINTER) ((char *)virtual_break_value + size);
}
}
virtual_break_value = (POINTER) ((char *)address + size);
break_value = (last_bloc
? (char *) last_bloc->data + last_bloc->size
: (char *) first_heap->bloc_start);
if (size < 0)
relinquish ();
return address;
}
POINTER
r_alloc (ptr, size)
POINTER *ptr;
SIZE size;
{
register bloc_ptr new_bloc;
if (! r_alloc_initialized)
r_alloc_init ();
new_bloc = get_bloc (MEM_ROUNDUP (size));
if (new_bloc)
{
new_bloc->variable = ptr;
*ptr = new_bloc->data;
}
else
*ptr = 0;
return *ptr;
}
void
r_alloc_free (ptr)
register POINTER *ptr;
{
register bloc_ptr dead_bloc;
if (! r_alloc_initialized)
r_alloc_init ();
dead_bloc = find_bloc (ptr);
if (dead_bloc == NIL_BLOC)
abort ();
free_bloc (dead_bloc);
*ptr = 0;
#ifdef emacs
refill_memory_reserve ();
#endif
}
POINTER
r_re_alloc (ptr, size)
POINTER *ptr;
SIZE size;
{
register bloc_ptr bloc;
if (! r_alloc_initialized)
r_alloc_init ();
if (!*ptr)
return r_alloc (ptr, size);
if (!size)
{
r_alloc_free (ptr);
return r_alloc (ptr, 0);
}
bloc = find_bloc (ptr);
if (bloc == NIL_BLOC)
abort ();
if (size < bloc->size)
{
if ((bloc->size - MEM_ROUNDUP (size) >= page_size)
&& r_alloc_freeze_level == 0)
{
resize_bloc (bloc, MEM_ROUNDUP (size));
}
}
else if (size > bloc->size)
{
if (r_alloc_freeze_level)
{
bloc_ptr new_bloc;
new_bloc = get_bloc (MEM_ROUNDUP (size));
if (new_bloc)
{
new_bloc->variable = ptr;
*ptr = new_bloc->data;
bloc->variable = (POINTER *) NIL;
}
else
return NIL;
}
else
{
if (! resize_bloc (bloc, MEM_ROUNDUP (size)))
return NIL;
}
}
return *ptr;
}
void
r_alloc_freeze (size)
long size;
{
if (! r_alloc_initialized)
r_alloc_init ();
if (r_alloc_freeze_level > 0)
size = 0;
while (size > 0 && r_alloc_sbrk (size) == 0)
size /= 2;
++r_alloc_freeze_level;
if (size > 0)
r_alloc_sbrk (-size);
}
void
r_alloc_thaw ()
{
if (! r_alloc_initialized)
r_alloc_init ();
if (--r_alloc_freeze_level < 0)
abort ();
if (!r_alloc_freeze_level)
{
bloc_ptr *b = &first_bloc;
while (*b)
if (!(*b)->variable)
free_bloc (*b);
else
b = &(*b)->next;
}
}
#if defined (emacs) && defined (DOUG_LEA_MALLOC)
void
r_alloc_reinit ()
{
if (__morecore != r_alloc_sbrk)
{
real_morecore = __morecore;
__morecore = r_alloc_sbrk;
}
}
#endif
#ifdef DEBUG
#include <assert.h>
void
r_alloc_check ()
{
int found = 0;
heap_ptr h, ph = 0;
bloc_ptr b, pb = 0;
if (!r_alloc_initialized)
return;
assert (first_heap);
assert (last_heap->end <= (POINTER) sbrk (0));
assert ((POINTER) first_heap < first_heap->start);
assert (first_heap->start <= virtual_break_value);
assert (virtual_break_value <= first_heap->end);
for (h = first_heap; h; h = h->next)
{
assert (h->prev == ph);
assert ((POINTER) ROUNDUP (h->end) == h->end);
#if 0
assert ((POINTER) MEM_ROUNDUP (h->start) == h->start);
#endif
assert ((POINTER) MEM_ROUNDUP (h->bloc_start) == h->bloc_start);
assert (h->start <= h->bloc_start && h->bloc_start <= h->end);
if (ph)
{
assert (ph->end < h->start);
assert (h->start <= (POINTER)h && (POINTER)(h+1) <= h->bloc_start);
}
if (h->bloc_start <= break_value && break_value <= h->end)
found = 1;
ph = h;
}
assert (found);
assert (last_heap == ph);
for (b = first_bloc; b; b = b->next)
{
assert (b->prev == pb);
assert ((POINTER) MEM_ROUNDUP (b->data) == b->data);
assert ((SIZE) MEM_ROUNDUP (b->size) == b->size);
ph = 0;
for (h = first_heap; h; h = h->next)
{
if (h->bloc_start <= b->data && b->data + b->size <= h->end)
break;
ph = h;
}
assert (h);
if (pb && pb->data + pb->size != b->data)
{
assert (ph && b->data == h->bloc_start);
while (ph)
{
if (ph->bloc_start <= pb->data
&& pb->data + pb->size <= ph->end)
{
assert (pb->data + pb->size + b->size > ph->end);
break;
}
else
{
assert (ph->bloc_start + b->size > ph->end);
}
ph = ph->prev;
}
}
pb = b;
}
assert (last_bloc == pb);
if (last_bloc)
assert (last_bloc->data + last_bloc->size == break_value);
else
assert (first_heap->bloc_start == break_value);
}
#endif
static void
r_alloc_init ()
{
if (r_alloc_initialized)
return;
r_alloc_initialized = 1;
page_size = PAGE;
#ifndef SYSTEM_MALLOC
real_morecore = __morecore;
__morecore = r_alloc_sbrk;
first_heap = last_heap = &heap_base;
first_heap->next = first_heap->prev = NIL_HEAP;
first_heap->start = first_heap->bloc_start
= virtual_break_value = break_value = (*real_morecore) (0);
if (break_value == NIL)
abort ();
extra_bytes = ROUNDUP (50000);
#endif
#ifdef DOUG_LEA_MALLOC
mallopt (M_TOP_PAD, 64 * 4096);
#else
#ifndef SYSTEM_MALLOC
__malloc_extra_blocks = 64;
#endif
#endif
#ifndef SYSTEM_MALLOC
first_heap->end = (POINTER) ROUNDUP (first_heap->start);
(*real_morecore) ((char *) first_heap->end - (char *) first_heap->start);
bzero (first_heap->start,
(char *) first_heap->end - (char *) first_heap->start);
virtual_break_value = break_value = first_heap->bloc_start = first_heap->end;
#endif
use_relocatable_buffers = 1;
}