#include "config.h"
#include <stdlib.h>
#include "libgfortran.h"
#define GFC_CLEAR_MEMORY
#define GFC_CHECK_MEMORY
#define malloc_t prefix(malloc_t)
typedef struct malloc_t
{
int magic;
int marker;
struct malloc_t *prev, *next;
void *data;
}
malloc_t;
#define GFC_MALLOC_MAGIC 0x4d353941
#define HEADER_SIZE offsetof (malloc_t, data)
#define DATA_POINTER(pheader) (&((pheader)->data))
#define DATA_HEADER(pdata) ((malloc_t *)((char *) (pdata) - HEADER_SIZE))
static malloc_t mem_root;
void
memory_init (void)
{
mem_root.magic = 0;
mem_root.next = &mem_root;
mem_root.prev = &mem_root;
mem_root.marker = 0;
}
void
runtime_cleanup (void)
{
if (mem_root.next != &mem_root)
runtime_error ("Unfreed memory on program termination");
}
void *
get_mem (size_t n)
{
void *p;
#ifdef GFC_CLEAR_MEMORY
p = (void *) calloc (n, 1);
#else
#define temp malloc
#undef malloc
p = (void *) malloc (n);
#define malloc temp
#undef temp
#endif
if (p == NULL)
os_error ("Memory allocation failed");
return p;
}
void
free_mem (void *p)
{
free (p);
}
static malloc_t *
malloc_with_header (size_t n)
{
malloc_t *newmem;
n = n + HEADER_SIZE;
newmem = (malloc_t *) get_mem (n);
if (newmem)
{
newmem->magic = GFC_MALLOC_MAGIC;
newmem->marker = 0;
}
return newmem;
}
void *
internal_malloc_size (size_t size)
{
malloc_t *newmem;
newmem = malloc_with_header (size);
if (!newmem)
os_error ("Out of memory.");
newmem->next = &mem_root;
newmem->prev = mem_root.prev;
mem_root.prev->next = newmem;
mem_root.prev = newmem;
return DATA_POINTER (newmem);
}
void *
internal_malloc (GFC_INTEGER_4 size)
{
#ifdef GFC_CHECK_MEMORY
if (size <= 0)
runtime_error ("Attempt to allocate a non-positive amount of memory.");
#endif
return internal_malloc_size ((size_t) size);
}
void *
internal_malloc64 (GFC_INTEGER_8 size)
{
#ifdef GFC_CHECK_MEMORY
if (size <= 0)
runtime_error ("Attempt to allocate a non-positive amount of memory.");
#endif
return internal_malloc_size ((size_t) size);
}
void
internal_free (void *mem)
{
malloc_t *m;
if (!mem)
runtime_error ("Internal: Possible double free of temporary.");
m = DATA_HEADER (mem);
if (m->magic != GFC_MALLOC_MAGIC)
runtime_error ("Internal: No magic memblock marker. "
"Possible memory corruption");
m->prev->marker += m->marker;
m->prev->next = m->next;
m->next->prev = m->prev;
free (m);
}
static void
allocate_size (void **mem, size_t size, GFC_INTEGER_4 * stat)
{
malloc_t *newmem;
if (!mem)
runtime_error ("Internal: NULL mem pointer in ALLOCATE.");
newmem = malloc_with_header (size);
if (!newmem)
{
if (stat)
{
*stat = 1;
return;
}
else
runtime_error ("ALLOCATE: Out of memory.");
}
newmem->next = newmem;
newmem->prev = newmem;
(*mem) = DATA_POINTER (newmem);
if (stat)
*stat = 0;
}
void
allocate (void **mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
{
if (size < 0)
{
runtime_error ("Attempt to allocate negative amount of memory. "
"Possible integer overflow");
abort ();
}
allocate_size (mem, (size_t) size, stat);
}
void
allocate64 (void **mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
{
if (size < 0)
{
runtime_error
("ALLOCATE64: Attempt to allocate negative amount of memory. "
"Possible integer overflow");
abort ();
}
allocate_size (mem, (size_t) size, stat);
}
void
deallocate (void **mem, GFC_INTEGER_4 * stat)
{
if (!mem)
runtime_error ("Internal: NULL mem pointer in ALLOCATE.");
if (!*mem)
{
if (stat)
{
*stat = 1;
return;
}
else
{
runtime_error
("Internal: Attempt to DEALLOCATE unallocated memory.");
abort ();
}
}
internal_free (*mem);
*mem = NULL;
if (stat)
*stat = 0;
}