/*--------------------------------------------------------------------------*/
/* ALBERTA_UTIL:  tools for messages, memory allocation, parameters, etc.   */
/*                                                                          */
/* file:     alloc.c                                                        */
/*                                                                          */
/* description:  utilities for memory allocation                            */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/*  authors:   Alfred Schmidt                                               */
/*             Zentrum fuer Technomathematik                                */
/*             Fachbereich 3 Mathematik/Informatik                          */
/*             Universitaet Bremen                                          */
/*             Bibliothekstr. 2                                             */
/*             D-28359 Bremen, Germany                                      */
/*                                                                          */
/*             Kunibert G. Siebert                                          */
/*             Institut fuer Mathematik                                     */
/*             Universitaet Augsburg                                        */
/*             Universitaetsstr. 14                                         */
/*             D-86159 Augsburg, Germany                                    */
/*                                                                          */
/*  http://www.mathematik.uni-freiburg.de/IAM/ALBERTA                       */
/*                                                                          */
/*  (c) by A. Schmidt and K.G. Siebert (1996-2003)                          */
/*                                                                          */
/*--------------------------------------------------------------------------*/

#if HAVE_CONFIG_H
# include "config.h"
#endif

#if defined(__MACH__)
  #include <stdlib.h>
#else
  #include <malloc.h>
  #include <stdlib.h>
#endif

#include "alberta_util.h"

#if ALBERTA_ALLOC_MALLOC && !defined(print_mem_use)
void print_mem_use(void)
{
  FUNCNAME("print_mem_use");
#if HAVE_MALLOC_STATS
  MSG("General malloc statistics:\n");
  fflush(stdout);
  malloc_stats();
#else
  MSG("Sorry, this information is unavailable, caused by the use of\n");
  MSG("the system's standard allocation routines and missing features\n");
  MSG("of the system's malloc implementation.\n");
#endif
}
#endif

#define MALLOC(size)         malloc(size)
#define REALLOC(ptr, size)   (ptr) ? realloc(ptr, size) : malloc(size)
#define FREE(ptr)            free(ptr)
#define CALLOC(size, elsize) calloc(size, elsize)

#define ALLOC_ERR(fct, file, line)\
if (fct && file) ERROR_EXIT("called by %s in %s, line %d\n", fct, file, line);\
else if (fct)    ERROR_EXIT("called by %s, (unknown filename)\n", fct);\
else if (file)   ERROR_EXIT("called in %s, line %d\n", file, line);\
else             ERROR_EXIT("location unknown\n")

#if !ALBERTA_ALLOC_MALLOC
/*--------------------------------------------------------------------------*/
/*  routines for allocation/deallocation of memory. every (de)allocation is */
/*  done via alberta_alloc(), alberta_realloc(), alberta_free() resp.       */
/*--------------------------------------------------------------------------*/

static const char *size_as_string(size_t size)
{
  static char  sas[128];

  if (size < (1UL << 10)) {
    sprintf(sas, "%d %s", (int) size, "B");
  } else if (size < (1UL << 20)) {
    sprintf(sas, "%.2lf %s", (double)size/(double)1024.0, "KB");
  } else if (size < (1UL << 30)) {
    sprintf(sas, "%.2lf %s", (double)size/(double)1048576.0, "MB");
  } else {
    sprintf(sas, "%.2lf %s", (double)size/(double)(1UL << 30), "GB");
  }

  return sas;
}

static ssize_t size_used;

#if ALBERTA_DEBUG == 1
int alberta_memtrace = 0;
#else
# define alberta_memtrace 0
#endif

void *alberta_alloc(size_t size, const char *fct, const char *file, int line)
{
  FUNCNAME("alberta_alloc");
  void *mem;

  if (size) {
    if ((mem = MALLOC(size)) == NULL) {
      ERROR("can not allocate %s\n", size_as_string(size));
      ALLOC_ERR(fct, file, line);
    }
  } else {
    mem = NULL;
  }

  if (alberta_memtrace)
    fprintf(stderr, "alloc @ %p %ld %s @ %d\n", mem, size, file, line);

#if HAVE_MALLOC_USABLE_SIZE
  if (mem != NULL) {
    size_used += (ssize_t)malloc_usable_size(mem);
  }
#else
  size_used += (ssize_t)size;
#endif
  return mem;
}

void *alberta_realloc(void *ptr, size_t old_size, size_t new_size,
		      const char *fct, const char *file, int line)
{
  FUNCNAME("alberta_realloc");
  void *mem;

  if (ptr == NULL) {
    if (old_size != 0 && old_size != MEM_UNKNOWN_SIZE) {
      ERROR("ptr == NULL, but old_size = %s\n", size_as_string(old_size));
      ALLOC_ERR(fct, file, line);
    }
    return alberta_alloc(new_size, fct, file, line);
  }

#if HAVE_MALLOC_USABLE_SIZE
  old_size = malloc_usable_size(ptr);
#else
  if (old_size == MEM_UNKNOWN_SIZE) {
    old_size = 0;
  }
#endif

  if (new_size) {
    if ((mem = REALLOC(ptr, new_size)) == NULL) {
      ERROR("can not allocate %s\n", size_as_string(new_size));
      ALLOC_ERR(fct, file, line);
    }
    if (alberta_memtrace) {
      fprintf(stderr, "free @ %p %ld %s @ %d\n", ptr, old_size, file, line);
      fprintf(stderr, "alloc @ %p %ld %s @ %d\n", mem, new_size, file, line);
    }
  } else {
    FREE(ptr);
    if (alberta_memtrace) {
      fprintf(stderr, "free @ %p %ld %s @ %d\n", ptr, old_size, file, line);
    }
    mem = NULL;
  }

#if HAVE_MALLOC_USABLE_SIZE
  new_size = mem == NULL ? 0 : malloc_usable_size(mem);
#endif
  size_used += (ssize_t)new_size - (ssize_t)old_size;

  return mem;
}

void *alberta_calloc(size_t size, size_t elsize, const char *fct,
		     const char *file, int line)
{
  FUNCNAME("alberta_calloc");
  void  *mem;

  if (size && elsize) {
    if ((mem = CALLOC(size, elsize)) == NULL) {
      ERROR("can not allocate %s\n", size_as_string(size*elsize));
      ALLOC_ERR(fct, file, line);
    }
  } else {
    mem = NULL;
  }

  if (alberta_memtrace)
    fprintf(stderr, "alloc @ %p %ld %s @ %d\n", mem, size * elsize, file, line);

#if HAVE_MALLOC_USABLE_SIZE
  size_used += mem == 0 ? 0 : (ssize_t)malloc_usable_size(mem);
#else
  size_used += (ssize_t)size * (ssize_t)elsize;
#endif

  return mem;
}

void alberta_free(void *ptr, size_t size)
{
  if (ptr == NULL) {
    if (size != 0 && size != MEM_UNKNOWN_SIZE) {
      ERROR_EXIT("ptr == NULL, but size = %s\n", size_as_string(size));
    }
    return;
  }

#if HAVE_MALLOC_USABLE_SIZE
  size = malloc_usable_size(ptr);
#else
  if (size == MEM_UNKNOWN_SIZE) {
    size = 0;
  }
#endif

  if (alberta_memtrace)
    fprintf(stderr, "free @ %p %ld\n", ptr, size);

  FREE(ptr);

  size_used -= (ssize_t)size;
}

void print_mem_use(void)
{
  FUNCNAME("print_mem_use");

  MSG("%s of memory allocated through alberta_alloc()\n",
      size_as_string(size_used));
#if HAVE_MALLOC_STATS
  MSG("General malloc statistics:\n");
  fflush(stdout);
  malloc_stats();
#endif
}

/* Obstacks are more handy than work-spaces and efficient enough. */
void *alberta_obstack_chunk_alloc(size_t size)
{
  return alberta_alloc(size, "alberta_obstack_alloc", __FILE__, __LINE__);
}

void alberta_obstack_chunk_free(void *ptr)
{
  alberta_free(ptr, MEM_UNKNOWN_SIZE);
}

#endif /* ALBERTA_ALLOC_MALLOC */

WORKSPACE *get_workspace(size_t size, const char *fct, const char *f, int l)
{
#if ALBERTA_DEBUG && ALBERTA_EFENCE
  WORKSPACE *ws = (WORKSPACE *)MALLOC(sizeof(WORKSPACE));

  ws->work = MALLOC(size);
#else
  WORKSPACE *ws = (WORKSPACE *)alberta_alloc(sizeof(WORKSPACE), fct, f, l);

  ws->work = alberta_alloc(size, fct, f, l);
#endif

  ws->size = size;

  return ws;
}

WORKSPACE  *realloc_workspace(WORKSPACE *ws, size_t new_size,
			      const char *fct, const char *file, int line)
{
  WORKSPACE  *workspace = ws;

  if (!workspace) {
#if ALBERTA_DEBUG && ALBERTA_EFENCE
    workspace = (WORKSPACE *)MALLOC(sizeof(WORKSPACE));
#else
    workspace = (WORKSPACE *)alberta_alloc(sizeof(WORKSPACE), fct, file, line);
#endif
    workspace->work = NULL;
  }

  if (!workspace->work)
  {
#if ALBERTA_DEBUG && ALBERTA_EFENCE
    workspace->work = MALLOC(new_size);
#else
    workspace->work = alberta_alloc(new_size, fct, file, line);
#endif
    workspace->size = new_size;
  } else if (workspace->size < new_size) {
#if ALBERTA_DEBUG && ALBERTA_EFENCE
    workspace->work = REALLOC(workspace->work, new_size);
#else
    workspace->work = alberta_realloc(workspace->work, workspace->size,
				      new_size, fct, file, line);
#endif
    workspace->size = new_size;
  }
  return workspace;
}

void clear_workspace(WORKSPACE *ws)
{
  if (!ws) return;
#if ALBERTA_DEBUG && ALBERTA_EFENCE
  FREE(ws->work);
#else
  alberta_free(ws->work, ws->size);
#endif
  ws->work = NULL;
  ws->size = 0;
}

void free_workspace(WORKSPACE *ws)
{
  if (!ws) return;
#if ALBERTA_DEBUG && ALBERTA_EFENCE
  FREE(ws->work);
  FREE(ws);
#else
  alberta_free(ws->work, ws->size);
  MEM_FREE(ws, 1, WORKSPACE);
#endif
}

/*--------------------------------------------------------------------------*/
/*  matrix (de-)allocation routines: 					    */
/*  free_matrix deallocates such a matrix				    */
/*--------------------------------------------------------------------------*/


void **alberta_matrix(int nr, int nc, size_t size,
		      const char *fct, const char *file, int line)
{
  int       i;
  size_t    row_length = nc*size;
  char      **mat, *mrows;

#if ALBERTA_DEBUG && ALBERTA_EFENCE
  mat = (char **)MALLOC(nr*sizeof(void *));
  mrows = (char *)MALLOC(nr*nc*size);
#else
  mat = (char **)alberta_alloc(nr*sizeof(char *), fct, file, line);
  mrows = (char *)alberta_alloc(nr*nc*size, fct, file, line);
#endif

  for(i = 0; i < nr; i++)
    mat[i] = mrows + i*row_length;

  return (void **)mat;
}

void  free_alberta_matrix(void **ptr, int nr, int nc, size_t size)
{
#if ALBERTA_DEBUG && ALBERTA_EFENCE
  if (ptr) {
    FREE(ptr[0]);
  }
  FREE(ptr);
#else
  if (ptr) {
    alberta_free(ptr[0], nr*nc*size);
  }
  alberta_free(ptr, nr*sizeof(char *));
#endif
}

void clear_alberta_matrix(void **ptr, int nr, int nc, size_t size)
{
  memset(ptr[0], 0, size*nr*nc);
}

void ***alberta_3array(int nr, int nc, int nd, size_t size,
		       const char *fct, const char *file, int line)
{
  int    i, j;
  size_t depth_length = nd*size;
  char   ***array, *mdepth;

  array = (char ***)alberta_matrix(nr, nc, sizeof(char *), fct, file, line);
#if ALBERTA_DEBUG && ALBERTA_EFENCE
  mdepth = (char *)MALLOC(nr*nc*nd*size);
#else
  mdepth = (char *)alberta_alloc(nr*nc*nd*size, fct, file, line);
#endif

  for(i = 0; i < nr; i++) {
    for(j = 0; j < nc; j++) {
      array[i][j] = mdepth;
      mdepth += depth_length;
    }
  }

  return (void ***)array;
}

void free_alberta_3array(void ***array, int nr, int nc, int nd, size_t size)
{
#if ALBERTA_DEBUG && ALBERTA_EFENCE
  if (array) {
    if (array[0]) {
      FREE(array[0][0]);
    }
    FREE(array[0]);
  }
  FREE(array);
#else
  if (array) {
    if (array[0]) {
      alberta_free(array[0][0], nr*nc*nd*size);
    }
    alberta_free(array[0], nr*nc*sizeof(void *));
  }
  alberta_free(array, nr*sizeof(void **));
#endif
}

void clear_alberta_3array(void ***array, int nr, int nc, int nd, size_t size)
{
  memset(array[0][0], 0, nr*nc*nd*size);
}

/* Allocate memory for a 4-tensor */
void ****alberta_4array(int n0, int n1, int n2, int n3, size_t size,
			const char *fct, const char *file, int line)
{
  int    i, j, k;
  size_t depth_length = n3*size;
  char   ****array, *mdepth;

  array =
    (char ****)alberta_3array(n0, n1, n2, sizeof(char *), fct, file, line);
#if ALBERTA_DEBUG && ALBERTA_EFENCE
  mdepth = (char *)MALLOC(n0*n1*n2*n3*size);
#else
  mdepth = (char *)alberta_alloc(n0*n1*n2*n3*size, fct, file, line);
#endif

  for(i = 0; i < n0; i++) {
    for(j = 0; j < n1; j++) {
      for(k = 0; k < n2; k++) {
	array[i][j][k] = mdepth;
	mdepth += depth_length;
      }
    }
  }

  return (void ****)array;
}

void
free_alberta_4array(void ****array, int n0, int n1, int n2, int n3, size_t size)
{
#if ALBERTA_DEBUG && ALBERTA_EFENCE
  if (array) {
    if (array[0]) {
      if (array[0][0]) {
	FREE(array[0][0][0]);
      }
    }
  }
#else
  if (array) {
    if (array[0]) {
      if (array[0][0]) {
	alberta_free(array[0][0][0], n0*n1*n2*n3*size);
      }
    }
  }
#endif  
  free_alberta_3array((void ***)array, n0, n1, n2, sizeof(char *));
}

void clear_alberta_4array(void ****array,
			  int n0, int n1, int n2, int n3, size_t size)
{
  memset(array[0][0][0], 0, n0*n1*n2*n3*size);
}

