/*
 * SCCTLA.C - memory management functions
 *          - WARNING: in the multi-threaded version threads are
 *          - assumed to NOT share allocated spaces
 *
 * Source Version: 2.0
 * Software Release #92-0043
 *
 */

#include "cpyright.h"

#ifndef MM_CONFIG

# include "score.h"

#else

# include <stdio.h>
# define N_DOUBLES_MD 3

#endif

/*--------------------------------------------------------------------------*/

typedef union u_mem_header mem_header;
typedef struct s_mem_descriptor mem_descriptor;

/* use the mem_header struct to force alignment to that of a double
 * this solves all alignment problems (especially for RISC chips)
 */

struct s_mem_descriptor
   {char *name;
    long id;
    short ref_count;
    short type;
    long length;
    mem_header *prev;
    mem_header *next;};

union u_mem_header
   {mem_descriptor block;
    double align[N_DOUBLES_MD];};

/*--------------------------------------------------------------------------*/

#ifndef MM_CONFIG

/* fundamental platform memory constants */

#define BITS_PER_BYTE       8
#ifdef ANSI
# if defined(SGI) || defined(OSF)
#  define SC_MEM_ALIGN_SIZE   sizeof(double);
# else
#  define SC_MEM_ALIGN_SIZE   sizeof(long double);
# endif
#else
# define SC_MEM_ALIGN_SIZE   sizeof(double);
#endif

/* SCORE memory manager constants */

#define SC_MEM_ID         0xF1E2D300
#define SC_MEM_IDM        0xE1E2D300
#define SC_BLOCK_ID_MASK  0xEFFFFF00
#define SC_FTN_NAME_MASK  0x10000000
#define SC_HEAP_ID_MASK   0x000000FF
#define UNIT_DELTA        10L

#if 0

# define SC_BIN_N          100
# define SC_BIN_INDEX(_n)  ((_n) >> _SC_mem_align_expt)
# define SC_BIN_SIZE(_n)   (((_n) + 1) << _SC_mem_align_expt)
# define SC_BIN_UNITS(_n)  (4096/(_n))

#else

# define SC_BIN_N          _SC_n_bins
# define SC_BIN_INDEX(_n)  _SC_bin_index(_n)
# define SC_BIN_SIZE(_n)   (((_n) >= _SC_n_bins) ? -1 : _SC_mm_bins[_n])
# define SC_BIN_UNITS(_n)  (((_n) < _SC_block_size) ? _SC_block_size/(_n) : 1)

#endif

#define ASSIGN_ID(_d, _i)                                              \
    (_d)->id = (SC_MEM_ID | (SC_HEAP_ID_MASK & (_i)))

#define HEAP_ID(_d)                                                    \
    ((_d)->id & SC_HEAP_ID_MASK)

#define SCORE_BLOCK_P(desc)                                            \
    ((SC_BLOCK_ID_MASK & (desc)->id) == SC_MEM_IDM)

#define FTN_NAME(desc)                                                 \
    ((SC_FTN_NAME_MASK & (desc)->id) == 0)

#define BLOCK_LENGTH(desc)                                             \
    (desc)->length

#define REF_COUNT(desc)                                                \
    ((desc)->ref_count)

#define EXTRA_WORD_SIZE   sizeof(long)
#define NBITS             (BITS_PER_BYTE*EXTRA_WORD_SIZE - 4)

#define _SC_ALLOC   (*_SC_alloc_hook)
#define _SC_REALLOC (*_SC_realloc_hook)
#define _SC_FREE    (*_SC_free_hook)


/*--------------------------------------------------------------------------*/

# define ASSIGN_BLOCK(space, nb, name)                                 \
   {mem_descriptor *desc;                                              \
    desc = &space->block;                                              \
    ASSIGN_ID(desc, id);                                               \
    desc->ref_count = 0;                                               \
    desc->type      = 0;                                               \
    desc->length    = nb;                                              \
    desc->name      = name;                                            \
    if (SC_LATEST_BLOCK(id) != NULL)                                   \
       {mem_header *prev, *next;                                       \
        next = SC_LATEST_BLOCK(id)->block.next;                        \
        prev = SC_LATEST_BLOCK(id);                                    \
        next->block.prev = space;                                      \
        prev->block.next = space;                                      \
        desc->next = next;                                             \
        desc->prev = prev;                                             \
        SC_LATEST_BLOCK(id) = space;}                                  \
    else                                                               \
       {SC_LATEST_BLOCK(id)             = space;                       \
        SC_LATEST_BLOCK(id)->block.prev = space;                       \
        SC_LATEST_BLOCK(id)->block.next = space;};}

# define SAVE_LINKS(desc)                                              \
   {prev = desc->prev;                                                 \
    next = desc->next;                                                 \
    if (space == SC_LATEST_BLOCK(id))                                  \
       SC_LATEST_BLOCK(id) = next;}

# define REASSIGN_BLOCK(space)                                         \
    {desc = &space->block;                                             \
     desc->length = nb;                                                \
     prev->block.next = space;                                         \
     next->block.prev = space;}

# define UNASSIGN_BLOCK(desc)                                          \
    {mem_header *prev, *next;                                          \
     prev = desc->prev;                                                \
     next = desc->next;                                                \
     if (space == next)                                                \
        SC_LATEST_BLOCK(id) = NULL;                                    \
     prev->block.next = next;                                          \
     next->block.prev = prev;                                          \
     if (space == SC_LATEST_BLOCK(id))                                 \
        SC_LATEST_BLOCK(id) = next;}

/*--------------------------------------------------------------------------*/

#ifdef HAVE_THREADS

# define SC_HEAP_INIT(x)          _SC_heaps[x].heap_init
# define SC_FREE_LIST(x)          _SC_heaps[x].free_list
# define SC_MAJOR_BLOCK_LIST(x)   _SC_heaps[x].major_block_list
# define SC_N_MAJOR_BLOCKS(x)     _SC_heaps[x].n_major_blocks
# define SC_NX_MAJOR_BLOCKS(x)    _SC_heaps[x].nx_major_blocks
# define SC_MAX_MEM_BLOCKS(x)     _SC_heaps[x].max_mem_blocks
# define SC_N_MEM_BLOCKS(x)       _SC_heaps[x].n_mem_blocks
# define SC_HDR_SIZE_MAX(x)       _SC_heaps[x].size_max
# define SC_HDR_SIZE(x)           _SC_heaps[x].size
# define SC_LATEST_BLOCK(x)       _SC_heaps[x].latest_block
# define SC_MEM_TRACE_PTR(x)      _SC_heaps[x].mem_trace_ptr
# define SC_SP_ALLOC(x)           _SC_heaps[x].sp_alloc
# define SC_SP_FREE(x)            _SC_heaps[x].sp_free
# define SC_SP_DIFF(x)            _SC_heaps[x].sp_diff
# define SC_SP_MAX(x)             _SC_heaps[x].sp_max

typedef struct s_SC_heap_des SC_heap_des;

struct s_SC_heap_des
   {int heap_init;
    mem_descriptor **free_list;
    mem_header *latest_block;
    char **major_block_list;
    long n_major_blocks;
    long nx_major_blocks;
    long max_mem_blocks;
    long n_mem_blocks;
    unsigned long size_max;
    unsigned long size;
    long sp_alloc;
    long sp_free;
    long sp_diff;
    long sp_max;};

static SC_heap_des
 _SC_single_heap,
 *_SC_heaps = &_SC_single_heap;

#else

# define SC_HEAP_INIT(x)          _SC_heap_init
# define SC_FREE_LIST(x)          _SC_free_list
# define SC_MAJOR_BLOCK_LIST(x)   _SC_major_block_list
# define SC_N_MAJOR_BLOCKS(x)     _SC_n_major_blocks
# define SC_NX_MAJOR_BLOCKS(x)    _SC_nx_major_blocks
# define SC_MAX_MEM_BLOCKS(x)     _SC_max_mem_blocks
# define SC_N_MEM_BLOCKS(x)       _SC_n_mem_blocks
# define SC_HDR_SIZE_MAX(x)       _SC_size_max
# define SC_HDR_SIZE(x)           _SC_size
# define SC_LATEST_BLOCK(x)       _SC_latest_block
# define SC_MEM_TRACE_PTR(x)      _SC_mem_trace_ptr
# define SC_SP_ALLOC(x)           _SC_c_sp_alloc
# define SC_SP_FREE(x)            _SC_c_sp_free
# define SC_SP_DIFF(x)            _SC_c_sp_diff
# define SC_SP_MAX(x)             _SC_c_sp_max

static mem_header
 *_SC_latest_block;

static mem_descriptor
 **_SC_free_list;

static char
 **_SC_major_block_list;

static long
 _SC_c_sp_alloc,
 _SC_c_sp_free, 
 _SC_c_sp_diff,
 _SC_c_sp_max,
 _SC_n_major_blocks,
 _SC_nx_major_blocks,
 _SC_max_mem_blocks,
 _SC_n_mem_blocks;

static unsigned long
 _SC_size_max,
 _SC_size;                          /* size in bytes of header */

static int
 _SC_heap_init = FALSE;

#endif

/*--------------------------------------------------------------------------*/

static long
 _SC_block_size = 0L,
 _SC_n_bins = 0L,
 *_SC_mm_bins = NULL;

static int
 _SC_mem_align_expt = 0,
 _SC_mem_align_size = 0,
 _SC_mem_align_pad = 0;

int
 _SC_zero_space = 1,
 SC_mm_debug = FALSE;

SC_THREAD_LOCK(SC_mm_lock);
SC_THREAD_LOCK(SC_mc_lock);

PFVoid
 _SC_free_hook = (PFVoid) free;

PFPByte
 _SC_alloc_hook   = (PFPByte) malloc,
 _SC_realloc_hook = (PFPByte) realloc;

PFVoid
 SC_tid_hook = NULL;

/*--------------------------------------------------------------------------*/

/*                           MEMORY HEAP ROUTINES                           */

/*--------------------------------------------------------------------------*/

/* SC_CONFIGURE_MM - configure the memory manager bin structure
 *                 - bin sizes increase linearly up to MXL and
 *                 - exponentially up to the maximum managed size MXM
 *                 - for efficiency memory will be requested from the
 *                 - system in units of BSZ for bins with size <= BSZ
 *                 - and broken up into appropriately sized units to
 *                 - be added to the free lists
 *                 - for bins with size > BSZ single units will be
 *                 - requested from the system in order to keep applications
 *                 - from grabbing too much memory that may not be used
 *                 -   MXL - maximum block size for linear region
 *                 -   MXM - maximum managed block size
 *                 -   BSZ - maximum block size requested from the system
 *                 -   R   - bin size ratio in exponential region
 */

void SC_configure_mm(mxl, mxm, bsz, r)
   long mxl, mxm, bsz;
   double r;
   {long l, n, nlg, nln;
    double t;
    static int first = TRUE;

    if (first)
       {SC_LOCKON(SC_mc_lock);
	if (first)
	   {first = FALSE;

	    _SC_mem_align_size = SC_MEM_ALIGN_SIZE;
	    _SC_mem_align_pad  = _SC_mem_align_size - 1;
	    _SC_mem_align_expt = 0;
	    for (n = _SC_mem_align_size; 1L < n; n >>= 1L)
	        _SC_mem_align_expt++;

	    _SC_block_size = bsz;

/* find the number of bins */
	    t   = ((double) mxm)/((double) mxl);
	    nlg = (long)(log(t)/log(r));
	    nln = mxl >> _SC_mem_align_expt;

	    _SC_n_bins  = 1 + nln + nlg;
	    _SC_mm_bins = (long *) malloc(sizeof(long)*_SC_n_bins);

/* fill the linear region */
	    for (n = 1L; _SC_mem_align_size*n <= mxl; n++)
	        _SC_mm_bins[n-1] = n << _SC_mem_align_expt;

/* fill the exponential region */
	    for (--n; n < _SC_n_bins; n++)
	        {l = (long) (r*((double) _SC_mm_bins[n-1]));
		 _SC_mm_bins[n] = ((l + _SC_mem_align_pad) >>
				   _SC_mem_align_expt) <<
				   _SC_mem_align_expt;};};

	SC_LOCKOFF(SC_mc_lock);};

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _SC_BIN_INDEX - hash a byte size to an index */

long _SC_bin_index(n)
   long n;
   {long m, imn, imx;

    m = -1L;
    if (n > _SC_mm_bins[0])
       {m = _SC_n_bins - 1;

	if (n < _SC_mm_bins[m])
	   {imn = 0L;
	    imx = m;
	    for (m = (imn + imx) >> 1L; m > imn; m = (imn + imx) >> 1L)
	        {if (n <= _SC_mm_bins[m])
		    imx = m;
		 else
		    imn = m;};};};

    return(m + 1);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _SC_INIT_HEAP - initialize an SC_heap instance */

static void _SC_init_heap(id)
   int id;
   {int i;
    mem_descriptor **lst;

    lst = (mem_descriptor **) malloc(sizeof(mem_descriptor *)*SC_BIN_N);
    for (i = 0; i < SC_BIN_N; i++)
        lst[i] = NULL;
    SC_FREE_LIST(id) = lst;

    SC_MAJOR_BLOCK_LIST(id) = NULL;
    SC_N_MAJOR_BLOCKS(id)   = 0L;
    SC_NX_MAJOR_BLOCKS(id)  = 0L;
    SC_MAX_MEM_BLOCKS(id)   = 0L;
    SC_N_MEM_BLOCKS(id)     = 0L;
    SC_HDR_SIZE_MAX(id)     = (1L << NBITS) - 1;
    SC_HDR_SIZE(id)         = sizeof(mem_header);
    SC_LATEST_BLOCK(id)     = NULL;

    SC_SP_ALLOC(id) = 0L;
    SC_SP_FREE(id)  = 0L; 
    SC_SP_DIFF(id)  = 0L;
    SC_SP_MAX(id)   = 0L;

    SC_HEAP_INIT(id) = TRUE;

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _SC_TID_MM - get the ID for the current thread
 *            - and be sure that there is an initialized heap instance
 *            - for this thread
 */

static int _SC_tid_mm()
   {int id;
    static int first = TRUE;

    if (first)
       {SC_LOCKON(SC_mm_lock);
        if (first)
	   {SC_configure_mm(128L, 4096L, 4096L, 1.1);
	    first = FALSE;};
	SC_LOCKOFF(SC_mm_lock);};

    SC_TID(id);

#ifdef HAVE_THREADS
    {int n;
     static int nx = (int) UNIT_DELTA;

     if (_SC_heaps == &_SC_single_heap)
        {SC_LOCKON(SC_mm_lock);

/* retest so that only the first thread gets in */
         if (_SC_heaps == &_SC_single_heap)
	    {nx        = max(id, nx);
	     n         = nx*sizeof(SC_heap_des);
	     _SC_heaps = malloc(n);
             memset(_SC_heaps, 0, n);};

         SC_LOCKOFF(SC_mm_lock);};

    if (id >= nx)
       {SC_LOCKON(SC_mm_lock);

/* retest so that only the first thread gets in */
	if (id >= nx)
	   {n         = nx*sizeof(SC_heap_des);
	    nx        = id + UNIT_DELTA;
	    _SC_heaps = realloc(_SC_heaps, nx*sizeof(SC_heap_des));
	    memset((char *) _SC_heaps + n, 0, nx*sizeof(SC_heap_des) - n);};

	SC_LOCKOFF(SC_mm_lock);};};
#endif

    if (!SC_HEAP_INIT(id))
       _SC_init_heap(id);

    return(id);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _SC_MEM_STATS_ACC - change the memory usage by A and F
 *                     takes pthread id as argument
 */

static void _SC_mem_stats_acc(a, f, id)
   long a, f;
   int id;
   {

    SC_SP_ALLOC(id) += a;
    SC_SP_FREE(id)  += f;

    SC_SP_DIFF(id) = SC_SP_ALLOC(id) - SC_SP_FREE(id);
    SC_SP_MAX(id)  = (SC_SP_MAX(id) > SC_SP_DIFF(id)) ?
                   SC_SP_MAX(id) : SC_SP_DIFF(id);

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _SC_PRIM_ALLOC - memory allocator that manages banks of small chunks
 *                - for efficiency
 */

static byte *_SC_prim_alloc(nbp, id)
   size_t nbp;
   int id;
   {int nu, us, ns, i;
    long j, nb;
    char *pn;
    mem_descriptor *md, *ths;
    size_t tnb;
    byte *p;

    if (nbp <= 0)
       return(NULL);

    nb = nbp - SC_HDR_SIZE(id);
    j  = SC_BIN_INDEX(nb);

/* if this chunk size is within SCORE managed space handle it here */
    if (j < SC_BIN_N)
       {md = SC_FREE_LIST(id)[j];

/* if we are out of free chunks get a block of them from the system */
        if (md == NULL)
           {us = SC_HDR_SIZE(id) + SC_BIN_SIZE(j);
	    us = ((us + _SC_mem_align_pad) >>
		  _SC_mem_align_expt) <<
	         _SC_mem_align_expt;
            nu = SC_BIN_UNITS(us);
            ns = nu*us;
            pn = _SC_ALLOC((size_t) ns);

/* adjust the block lists and add the new block */
	    if (SC_MAJOR_BLOCK_LIST(id) == NULL)
	       {SC_NX_MAJOR_BLOCKS(id) = UNIT_DELTA;
		SC_N_MAJOR_BLOCKS(id)  = 0;
		tnb = sizeof(char *)*SC_NX_MAJOR_BLOCKS(id);
		SC_MAJOR_BLOCK_LIST(id) = (char **) _SC_ALLOC(tnb);};

	    SC_MAJOR_BLOCK_LIST(id)[SC_N_MAJOR_BLOCKS(id)++] = pn;

	    if (SC_N_MAJOR_BLOCKS(id) >= SC_NX_MAJOR_BLOCKS(id))
	       {SC_NX_MAJOR_BLOCKS(id) += UNIT_DELTA;
		tnb = sizeof(char *)*SC_NX_MAJOR_BLOCKS(id);
		SC_MAJOR_BLOCK_LIST(id) = (char **) _SC_REALLOC(SC_MAJOR_BLOCK_LIST(id),
								tnb);};
/* chain the new chunks on the block properly */
            md = (mem_descriptor *) pn;
            nu--;
            for (i = 0; i < nu; i++, pn += us)
                {ths       = (mem_descriptor *) pn;
                 ths->name = (char *) (pn + us);};
            ths       = (mem_descriptor *) pn;
            ths->name = NULL;};

/* attach the new chunks to the free list */
        SC_FREE_LIST(id)[j] = (mem_descriptor *) (md->name);

/* take the top of the free list for this size chunk */
        p = (byte *) md;}

/* otherwise go out to the system for memory */
    else
       p = _SC_ALLOC((size_t) nbp);

    return(p);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _SC_PRIM_FREE - free small block counterpart to _SC_prim_alloc
 *               - for efficiency
 */

static void _SC_prim_free(p, nbp, id)
   byte *p;
   long nbp;
   int id;
   {long j, nb;
    mem_descriptor *lst, *ths;

    if (p == NULL)
       return;

    nb = nbp - SC_HDR_SIZE(id);
    j  = SC_BIN_INDEX(nb);
    if (j < SC_BIN_N)
       {ths = (mem_descriptor *) p;
        lst = SC_FREE_LIST(id)[j];
        ths->name = (char *) lst;
        SC_FREE_LIST(id)[j] = ths;}

    else
       _SC_FREE(p);

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_ALLOC_NA - add a layer of control over the C level memory management
 *             - system to store the byte length of allocated spaces
 *             - a space EXTRA_WORD_SIZE greater than requested is allocated
 *             - the length in bytes is written into the first EXTRA_WORD_SIZE
 *             - bytes with a 4 bit marker in the high bits and a pointer to the
 *             - next byte is returned
 *             - if the maximum size is exceeded a NULL pointer is returned
 *             - iff NA TRUE fudge the accounting so that this block
 *             - will not show up in the bytes allocated count
 */

byte *SC_alloc_na(nitems, bytepitem, name, na)
   long nitems, bytepitem;
   char *name;
   int na;
   {int id;
    long nb, nbp, a, f;
    mem_header *space;

    id  = _SC_tid_mm();
    nb  = nitems*bytepitem;
    nbp = nb + SC_HDR_SIZE(id);

    if ((nb <= 0) || ((unsigned long) nb > SC_HDR_SIZE_MAX(id)))
       return(NULL);

    if (SC_tid_hook == NULL)
       SC_LOCKON(SC_mm_lock);

    if (na)
       SC_mem_stats(&a, &f, NULL, NULL);

    if (SC_mm_debug)
       space = (mem_header *) _SC_ALLOC((size_t) nbp);
    else
       space = (mem_header *) _SC_prim_alloc((size_t) nbp, id);

    if (space != NULL)
       {ASSIGN_BLOCK(space, nb, name);

	_SC_mem_stats_acc((long) nb, 0L, id);
    
	SC_MAX_MEM_BLOCKS(id)++;
	SC_N_MEM_BLOCKS(id)++;

        space++;

/* zero out the space */
	if ((_SC_zero_space == 1) || (_SC_zero_space == 2))
	   memset(space, 0, nb);};

    if (na)
       SC_mem_stats_set(a, f);

    if (SC_tid_hook == NULL)
       SC_LOCKOFF(SC_mm_lock);

    return((byte *) space);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_ALLOC - add a layer of control over the C level memory management
 *          - system to store the byte length of allocated spaces
 *          - a space EXTRA_WORD_SIZE greater than requested is allocated
 *          - the length in bytes is written into the first EXTRA_WORD_SIZE
 *          - bytes with a 4 bit marker in the high bits and a pointer to the
 *          - next byte is returned
 *          - if the maximum size is exceeded a NULL pointer is returned
 */

byte *SC_alloc(nitems, bytepitem, name)
   long nitems, bytepitem;
   char *name;
   {return(SC_alloc_na(nitems, bytepitem, name, FALSE));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_REALLOC_NA - add a layer of control over the C level memory management
 *               - system to store the byte length of allocated spaces
 *               - a space EXTRA_WORD_SIZE greater than requested is reallocated
 *               - the length in bytes is written into the first EXTRA_WORD_SIZE
 *               - bytes with a 4 bit marker in the high bits and a pointer to
 *               - the next byte is returned
 *               - if the maximum size implied by the EXTRA_WORD_SIZE - 4 is
 *               - exceeded a NULL pointer is returned
 *               - iff NA TRUE fudge the accounting so that this block
 *               - will not show up in the bytes allocated count
 */

byte *SC_realloc_na(p, nitems, bytepitem, na)
   byte *p;
   long nitems, bytepitem;
   int na;
   {int id;
    long nb, ob, db, nbp, obp, a, f;
    mem_header *space, *tmp;
    mem_descriptor *desc;
    mem_header *prev, *next;

    if (p == NULL)
       return(NULL);

    space = ((mem_header *) p) - 1;
    desc  = &space->block;
    if (!SCORE_BLOCK_P(desc))
       return(NULL);

    id  = HEAP_ID(desc);
    nb  = nitems*bytepitem;
    nbp = nb + SC_HDR_SIZE(id);

    if ((nb <= 0) || ((unsigned long) nb > SC_HDR_SIZE_MAX(id)))
       return(NULL);

    ob = BLOCK_LENGTH(desc);
    db = nb - ob;
    
    if (SC_tid_hook == NULL)
       SC_LOCKON(SC_mm_lock);

    if (na)
       SC_mem_stats(&a, &f, NULL, NULL);

    SAVE_LINKS(desc);

    if (SC_mm_debug)
       space = (mem_header *) _SC_REALLOC((byte *) space, (size_t) nbp);

    else
       {tmp = (mem_header *) _SC_prim_alloc((size_t) nbp, id);
        if (tmp == NULL)
           {if (SC_tid_hook == NULL)
              SC_LOCKOFF(SC_mm_lock);
	    return(NULL);}
        else
           {obp = ob + SC_HDR_SIZE(id);
            memcpy(tmp, space, min(obp, nbp));
            _SC_prim_free((byte *) space, obp, id);
            space = tmp;};};
    
    if (space != NULL)
       {REASSIGN_BLOCK(space);

	_SC_mem_stats_acc((long) db, 0L, id);

        space++;

/* zero out the new space */
        if ((db > 0) && ((_SC_zero_space == 1) || (_SC_zero_space == 2)))
           memset(((char *) space + ob), 0, db);};

    if (na)
       SC_mem_stats_set(a, f);

    if (SC_tid_hook == NULL)
       SC_LOCKOFF(SC_mm_lock);

    return((byte *) space);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_REALLOC - add a layer of control over the C level memory management
 *            - system to store the byte length of allocated spaces
 *            - a space EXTRA_WORD_SIZE greater than requested is reallocated
 *            - the length in bytes is written into the first EXTRA_WORD_SIZE
 *            - bytes with a 4 bit marker in the high bits and a pointer to
 *            - the next byte is returned
 *            - if the maximum size implied by the EXTRA_WORD_SIZE - 4 is
 *            - exceeded a NULL pointer is returned
 */

byte *SC_realloc(p, nitems, bytepitem)
   byte *p;
   long nitems, bytepitem;
   {return(SC_realloc_na(p, nitems, bytepitem, FALSE));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_FREE - the complementary routine for SC_alloc
 *         - free all the space including the counter
 *         - return TRUE if successful and FALSE otherwise
 */

int SC_free(p)
   byte *p;
   {int id;
    mem_header *space;
    mem_descriptor *desc;
    long nbp;

    if (p == NULL)
       return(TRUE);

    space = ((mem_header *) p) - 1;
    desc  = &space->block;
    if (!SCORE_BLOCK_P(desc))
       return(FALSE);

    if (REF_COUNT(desc) == UNCOLLECT)
       return(TRUE);

    if (--REF_COUNT(desc) > 0)
       return(TRUE);

    id  = HEAP_ID(desc);
    nbp = BLOCK_LENGTH(desc) + SC_HDR_SIZE(id);

    if (SC_tid_hook == NULL)
       SC_LOCKON(SC_mm_lock);

    UNASSIGN_BLOCK(desc);

    _SC_mem_stats_acc(0L, (long) (nbp - SC_HDR_SIZE(id)), id);

    if ((_SC_zero_space == 1) || (_SC_zero_space == 3))
       memset(space, 0, nbp);
    else
       {desc->name      = NULL;
	desc->id        = 0L;
	desc->ref_count = 0;
	desc->type      = 0;
	desc->length    = 0L;};

    if (SC_mm_debug)
       _SC_FREE((byte *) space);
    else
       _SC_prim_free((byte *) space, nbp, id);

    SC_N_MEM_BLOCKS(id)--;

    if (SC_tid_hook == NULL)
       SC_LOCKOFF(SC_mm_lock);

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_ARRLEN - return the length of an array which was allocated
 *           - with SC_alloc
 *           - return -1L on error
 */

long SC_arrlen(p)
   byte *p;
   {mem_header *space;
    mem_descriptor *desc;
    long nb;

    if (p == NULL)
       return(-1L);

    space = ((mem_header *) p) - 1;
    desc  = &space->block;
    if (!SCORE_BLOCK_P(desc))
       return(-1L);

    nb = BLOCK_LENGTH(desc);

    if (nb < 0L)
       return(-1L);
    else
       return(nb);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_MARK - change the reference count by n */

int SC_mark(p, n)
   byte *p;
   int n;
   {mem_header *space;
    mem_descriptor *desc;

    if (p == NULL)
       return(-1);

    space = ((mem_header *) p) - 1;
    desc  = &space->block;
    if (!SCORE_BLOCK_P(desc))
       return(-1L);

    if (REF_COUNT(desc) < UNCOLLECT)
       REF_COUNT(desc) += n;

    n = REF_COUNT(desc);

    return(n);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_SET_COUNT - set the reference count of the given object */

int SC_set_count(p, n)
   byte *p;
   int n;
   {mem_header *space;
    mem_descriptor *desc;

    if (p == NULL)
       return(-1);

    space = ((mem_header *) p) - 1;
    desc  = &space->block;
    if (!SCORE_BLOCK_P(desc))
       return(-1L);

    REF_COUNT(desc) = n;

    return(n);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_REF_COUNT - return the reference count of the given object */

int SC_ref_count(p)
   byte *p;
   {mem_header *space;
    mem_descriptor *desc;
    int n;

    if (p == NULL)
       return(-1);

    space = ((mem_header *) p) - 1;
    desc  = &space->block;
    if (!SCORE_BLOCK_P(desc))
       return(-1L);

    n = REF_COUNT(desc);

    return(n);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_PERMANENT - make an object unfreeable */

int SC_permanent(p)
   byte *p;
   {mem_header *space;
    mem_descriptor *desc;
    int n;

    if (p == NULL)
       return(-1);

    space = ((mem_header *) p) - 1;
    desc  = &space->block;
    if (!SCORE_BLOCK_P(desc))
       return(-1L);

    REF_COUNT(desc) = UNCOLLECT;

    n = REF_COUNT(desc);

    return(n);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_ARRTYPE - return the type index of the object */

int SC_arrtype(p, type)
   byte *p;
   int type;
   {int n;
    mem_header *space;
    mem_descriptor *desc;

    if (p == NULL)
       return(-1);

    space = ((mem_header *) p) - 1;
    desc  = &space->block;
    if (!SCORE_BLOCK_P(desc))
       return(-1L);

    if (type > 0)
       desc->type = type;

    n = desc->type;

    return(n);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_COPY_ITEM - copy a bit of memory */

byte *SC_copy_item(in)
   byte *in;
   {int len;
    void *out;

    if (in == NULL)
       return NULL;

    len = SC_arrlen(in);
    if (len == 0)
       return NULL;

    out = FMAKE_N(char, len, "SC_COPY_ITEM:out");
    if (out == NULL)
       return NULL;

    memcpy(out, in, len);

    return(out);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_ZERO_SPACE - set flag to zero space
 *               - 0 : don't zero
 *               - 1 : zero on alloc and free
 *               - 2 : zero on alloc only
 *               - 3 : zero on free only
 *               - if flag is legal set _SC_zero_space and return new value
 *               - otherwise return old value
 */

int SC_zero_space(flag)
   int flag;
   {

    if ((flag >= 0) && (flag <= 3))
       _SC_zero_space = flag;

    return(_SC_zero_space);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SCZRSP - fortran interface for SC_zero_space */

FIXNUM F77_ID(sczrsp_, sczrsp, SCZRSP)(pf)
   FIXNUM *pf;
   {return((FIXNUM) SC_zero_space((int) *pf));}

/*--------------------------------------------------------------------------*/

/*                     MEMORY STATISTICS ROUTINES                           */

/*--------------------------------------------------------------------------*/

/* SC_MEM_STATS - return memory usage statistics */

void SC_mem_stats(al, fr, df, mx)
   long *al, *fr, *df, *mx;
   {int id;

    id = _SC_tid_mm();

    if (al != NULL)
       *al = SC_SP_ALLOC(id);

    if (fr != NULL)
       *fr = SC_SP_FREE(id);

    if (df != NULL)
       *df = SC_SP_DIFF(id);

    if (mx != NULL)
       *mx = SC_SP_MAX(id);

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_MEM_STATS_ACC - change the memory usage by A and F */

void SC_mem_stats_acc(a, f)
   long a, f;
   {int id;

    id = _SC_tid_mm();

    SC_SP_ALLOC(id) += a;
    SC_SP_FREE(id)  += f;

    SC_SP_DIFF(id) = SC_SP_ALLOC(id) - SC_SP_FREE(id);
    SC_SP_MAX(id)  = (SC_SP_MAX(id) > SC_SP_DIFF(id)) ?
                   SC_SP_MAX(id) : SC_SP_DIFF(id);

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_MEM_STATS_SET - set the memory usage to A and F */

void SC_mem_stats_set(a, f)
   long a, f;
   {int id;

    id = _SC_tid_mm();

    SC_SP_ALLOC(id) = a;
    SC_SP_FREE(id)  = f;

    SC_SP_DIFF(id) = SC_SP_ALLOC(id) - SC_SP_FREE(id);
    SC_SP_MAX(id)  = (SC_SP_MAX(id) > SC_SP_DIFF(id)) ?
                     SC_SP_MAX(id) : SC_SP_DIFF(id);

    return;}

/*--------------------------------------------------------------------------*/

/*                             HEAP ANALYZER ROUTINES                       */

/*--------------------------------------------------------------------------*/

/* _SC_PRINT_FREE - print the free memory lists */

DEBUG_FUNC void _SC_print_free()
   {int id;
    long i, j;
    mem_descriptor *md;

    id = _SC_tid_mm();

    PRINT(stdout, "Bin  Max  Blocks\n");
    for (j = 0L; j < SC_BIN_N; j++)
        {PRINT(stdout, "%3ld %4ld ", j, SC_BIN_SIZE(j));
         for (md  = SC_FREE_LIST(id)[j], i = 0L;
	      md != NULL;
	      md  = (mem_descriptor *) md->name, i++)
             {PRINT(stdout, " %lx", md);
	      fflush(stdout);};
	 PRINT(stdout, "\n");};

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _SC_NAME_OK - filter names for PACT function names */

static int _SC_name_ok(name, flag)
   char *name;
   int flag;
   {int i, n;
    char t[MAXLINE];
    static char *prefixes[] = { "_SC_", "SC_", "_PM_", "PM_", "_PD_", "PD_",
				"_PC_", "PC_", "_PG_", "PG_", "_PA_", "PA_",
				"_SH_", "SH_", "_SX_", "SX_", "_UL_", "ULA_",
				"PAAREC", "PABREC", "PAGRID", "PATRNL",
				"PATRNN", "PAMRGN"};

    n = sizeof(prefixes)/sizeof(char *);
    if (flag)
       {for (i = 0; i < n; i++)
	    {if (strncmp(name, prefixes[i], strlen(prefixes[i])) == 0)
	        return(FALSE);

	     sprintf(t, "char*:%s", prefixes[i]);
	     if (strncmp(name, t, strlen(t)) == 0)
	        return(FALSE);};};

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_MEM_TRACE - return the number of chunks of memory managed by the
 *              - system
 *              - the given pointer must have been allocated by SC_alloc
 *              - return -1 if the forward and backward counts differ
 *              - return -2 if a NULL pointer occurs in the chain
 *              - return -3 if the link count exceeds the number of blocks
 *              - allocated
 */

int SC_mem_trace()
   {int id, n_mf, n_mb, ret;
    long i, n;
    mem_header *block;

    id = _SC_tid_mm();

    SC_LOCKON(SC_mm_lock);

    ret = 0;
    if (SC_LATEST_BLOCK(id) != NULL)
       {n    = SC_MAX_MEM_BLOCKS(id) + UNIT_DELTA;
	n_mf = 1;
	n_mb = 1;

	for (block = SC_LATEST_BLOCK(id), i = 0L;
	     i < n;
	     block = block->block.next, n_mf++, i++)
	    if ((block->block.next == SC_LATEST_BLOCK(id)) ||
		(block == NULL))
	       break;

	if ((i >= n) && (SC_MAX_MEM_BLOCKS(id) != 0))
	   ret = -3;

	else if (block == NULL)
	   ret = -2;

	else
	   {for (block = SC_LATEST_BLOCK(id), i = 0L;
		 i < n;
		 block = block->block.prev, n_mb++, i++)
	        if ((block->block.prev == SC_LATEST_BLOCK(id)) ||
		    (block == NULL))
		   break;

	    if ((i >= n) && (SC_MAX_MEM_BLOCKS(id) != 0))
	       ret = -3;

	    else if (block == NULL)
	       ret = -2;

	    else if (n_mf != n_mb)
	       ret = -1;

	    else
	       ret = n_mf;};};

    SC_LOCKOFF(SC_mm_lock);

    return(ret);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_MEM_MAP - print out a memory map to the given FILE */

int SC_mem_map(fp, flag)
   FILE *fp;
   int flag;
   {int id, i, j, n, nc, nf, nbl;
    long nb, a, f, d;
    char *name, *pc, c, *ps;
    char bf[MAXLINE];
    mem_header *space;
    mem_descriptor *desc;

    id = _SC_tid_mm();

    SC_LOCKON(SC_mm_lock);

    nbl = 0;
    if (SC_LATEST_BLOCK(id) != NULL)
       {n = SC_MAX_MEM_BLOCKS(id) + UNIT_DELTA;

	if (fp == NULL)
	   fp = stdout;

	SC_mem_stats(&a, &f, &d, NULL);
	PRINT(fp, "\nMemory Map (%8d %8d %8d)\n", a, f, d);

/* handle the first block */
	for (space = SC_LATEST_BLOCK(id), i = 0, nbl = 0;
	     (i < n) && (space != NULL);
	     space = space->block.next, i++)
	    {desc = &space->block;
	     nb   = BLOCK_LENGTH(desc);
	     name = desc->name;
	     if (name == NULL)
	        {if (!flag)
		    PRINT(fp, "Block: %12lx %9ld\t(no name)\n",
			  space+1, nb);}

	     else
	        {if (FTN_NAME(desc))
		    {name = SC_F77_C_STRING((F77_string) desc->name);
		     nc   = strlen(name);

		     ps = strchr(name, ' ');
		     if (ps != NULL)
		        {nf = ps - name;
			 nc = min(nc, nf);};

		     strncpy(bf, name, nc);
		     name     = bf;
		     name[nc] = '\0';};
		     
		 if (_SC_name_ok(name, flag))
		    {PRINT(fp, "Block: %12lx %9ld\t%s",
			   space+1, nb, name);

		     if (strncmp(name, "char*:", 6) == 0)
		        {PRINT(fp, " = \"");
			 pc = (char *) (space + 1);
			 for (j = 0; j < nb; j++)
			     {c = *pc++;
			      if (isprint(c))
				 PRINT(fp, "%c", c);
			      else
				 PRINT(fp, "\\%03o", c);};

			 PRINT(fp, "\"");};

		     PRINT(fp, "\n");};};

	     nbl++;
	     if (space->block.next == SC_LATEST_BLOCK(id))
	        break;};

	PRINT(fp, "\n");};

    SC_LOCKOFF(SC_mm_lock);

    return(nbl);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SC_MEM_MONITOR - monitor memory leaks
 *                - Arguments:
 *                -    OLD   byte count from previous call
 *                -    LEV   level of monitoring
 *                -          0 - off
 *                -          1 - total byte measure only
 *                -          2 - give detailed map of leaked blocks
 *                -    ID    identifier for temporary files
 *                -    MSG   user allocated space to return error message
 */

long SC_mem_monitor(old, lev, id, msg)
   int old, lev;
   char *id, *msg;
   {int on;
    long d;
    char sa[MAXLINE], ta[MAXLINE], ca[MAXLINE];
    char sb[MAXLINE], tb[MAXLINE], cb[MAXLINE];
    char sd[MAXLINE], td[MAXLINE], cd[MAXLINE];
    FILE *fp;

    on = abs(lev);

    if (on == 0)
       return(-1);

    sprintf(sb, "mem-u-%s.before", id);
    sprintf(tb, "mem-s-%s.before", id);
    sprintf(cb, "sort %s > %s", sb, tb);

    sprintf(sa, "mem-u-%s.after", id);
    sprintf(ta, "mem-s-%s.after", id);
    sprintf(ca, "sort %s > %s", sa, ta);

    sprintf(td, "mem-u-%s.diff", id);
    sprintf(sd, "diff %s %s > %s", tb, ta, td);
    sprintf(cd, "cat %s", td);

    SC_mem_stats(NULL, NULL, &d, NULL);

    if (old == 0)
       {if (on > 1)
	   {fp = io_open(sb, "w");
	    SC_mem_map(fp, 0);
	    io_close(fp);

	    SYSTEM(cb);
	    REMOVE(sb);};}

    else
       {if (on > 1)
	   {fp = io_open(sa, "w");
	    SC_mem_map(fp, 0);
	    io_close(fp);

	    SYSTEM(ca);
	    REMOVE(sa);

	    REMOVE(td);

	    if (old != d)
	       {SYSTEM(sd);
		SYSTEM(cd);};

	    REMOVE(tb);
	    REMOVE(ta);};

	if (old != d)
	   sprintf(msg,
		   "LEAKED %ld BYTES MEMORY - SC_MEM_MONITOR",
		   d - old);
	else
	  *msg = '\0';};

    return(d);}

/*---------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* DFLPR - show the free list for the specified bin */

void dflpr(j)
   int j;
   {int id;
    mem_descriptor *md;

    id = _SC_tid_mm();
    
    PRINT(stdout, "Free chunks of size %ld to %ld bytes\n",
	  (j < 1) ? 1L : SC_BIN_SIZE(j-1) + 1L,
	  SC_BIN_SIZE(j));
	  
    for (md = SC_FREE_LIST(id)[j];
	 md != NULL;
	 md = (mem_descriptor *) md->name)
        PRINT(stdout, "%8lx\n", md);

    return;}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _SC_FLCHK - return the total number of free blocks */

static int _SC_flchk()
   {int j, id, nf;
    mem_descriptor *md;

    id = _SC_tid_mm();
    nf = 0;
    for (j = 0; j < SC_BIN_N; j++)
        {for (md = SC_FREE_LIST(id)[j];
	      md != NULL;
	      md = (mem_descriptor *) md->name)
	     nf++;};

    return(nf);}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* SC_MEM_CHK - check out all aspects of managed memory
 *            - if bit #1 of TYP is 1 include the allocated memory
 *            - if bit #2 of TYP is 1 include the freed memory
 */

long SC_mem_chk(typ)
   int typ;
   {long nb;

    nb = 0L;

    if (typ & 1)
       nb += SC_mem_trace();

    if (typ & 2)
       nb += _SC_flchk();

    return(nb);}

/*---------------------------------------------------------------------------*/

/*                       FORTRAN MEMORY MANAGER ROUTINES                     */

/*---------------------------------------------------------------------------*/

/* SCMAKE - allocate a chunk of memory and set the pointer
 *        - WARNING: only for FORTRAN with pointers
 *        - return TRUE if successful and FALSE otherwise
 */

FIXNUM F77_ID(scmake_, scmake, SCMAKE)(pm, pni, pnb)
   byte **pm;
   FIXNUM *pni, *pnb;
   {byte *s;
    mem_header *space;
    mem_descriptor *desc;

    s = SC_alloc_na((long) *pni, (long) *pnb, NULL, FALSE);

    if (s != NULL)
       {space = ((mem_header *) s) - 1;
	desc  = &space->block;
	
	desc->id &= ~SC_FTN_NAME_MASK;};

    return((*pm = s) != NULL);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SCMAKF - allocate a chunk of memory and set the pointer
 *        - keep a name attached to this piece of memory
 *        - WARNING: only for FORTRAN with pointers
 *        - return TRUE if successful and FALSE otherwise
 */

FIXNUM F77_ID(scmakf_, scmakf, SCMAKF)(pm, pni, pnb, pnc, pname)
   byte **pm;
   FIXNUM *pni, *pnb, *pnc;
   F77_string pname;
   {byte *s;
    mem_header *space;
    mem_descriptor *desc;

    s = SC_alloc_na((long) *pni, (long) *pnb, (char *) pname, FALSE);

/* mark this block as having been allocated to FORTRAN
 * the memory map will need to know how to interpret the
 * F77_string pname correctly
 */
    if (s != NULL)
       {space = ((mem_header *) s) - 1;
	desc  = &space->block;
	
	desc->id &= ~SC_FTN_NAME_MASK;};

    return((*pm = s) != NULL);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SCREMA - reallocate a chunk of memory and set the pointer
 *        - WARNING: only for F77 with CRAY pointer extensions
 *        - return TRUE if successful and FALSE otherwise
 */

FIXNUM F77_ID(screma_, screma, SCREMA)(pm, pni, pnb)
   byte **pm;
   FIXNUM *pni, *pnb;
   {byte *s;

    s = SC_realloc_na(*pm, (long) *pni, (long) *pnb, FALSE);

    return((*pm = s) != NULL);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SCFREE - free a chunk of memory */

FIXNUM F77_ID(scfree_, scfree, SCFREE)(pm)
   byte **pm;
   {FIXNUM ok;

    ok = SC_free(*pm);
    if (ok)
       *pm = NULL;

    return(ok);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SCFPTE - free a chunk of memory */

FIXNUM F77_ID(scfpte_, scfpte, SCFPTE)(pm)
   byte *pm;
   {return(F77_ID(scfree_, scfree, SCFREE)(&pm));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SCMEMT - FORTRAN interface to SC_mem_trace */

FIXNUM F77_ID(scmemt_, scmemt, SCMEMT)()
   {

    return((FIXNUM) SC_mem_trace());}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* SCMEMC - FORTRAN interface to SC_mem_chk */

FIXNUM F77_ID(scmemc_, scmemc, SCMEMC)(typ)
   int typ;
   {

    return((FIXNUM) SC_mem_chk(typ));}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* SCMEMM - FORTRAN interface to SC_mem_monitor */

FIXNUM F77_ID(scmemm_, scmemm, SCMEMM)(po, pl, pni, pid, pnc, pmsg)
   FIXNUM *po, *pl, *pni;
   F77_string pid;
   FIXNUM *pnc;
   F77_string pmsg;
   {int old, lev, ni, nc, n;
    FIXNUM rv;
    char msg[MAXLINE], id[MAXLINE];

    old = *po;
    lev = *pl;
    ni  = *pni;
    nc  = *pnc;

    SC_FORTRAN_STR_C(id, pid, ni);

    rv = SC_mem_monitor(old, lev, id, msg);

    n = strlen(msg);
    n = min(n, nc);
    strncpy(SC_F77_C_STRING(pmsg), msg, n);

    return(rv);}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* SCMEMP - FORTRAN interface to SC_mem_map */

FIXNUM F77_ID(scmemp_, scmemp, SCMEMP)(po)
   FIXNUM *po;
   {int ord;
    FIXNUM rv;

    ord = *po;
    rv  = SC_mem_map(stdout, ord);

    return(rv);}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* SCMMCF - FORTRAN interface to SC_configure_mm */

FIXNUM F77_ID(scmmcf_, scmmcf, SCMMCF)(pxl, pxm, psz, pr)
   FIXNUM *pxl, *pxm, *psz;
   REAL *pr;
   {long mxl, mxm, bsz;
    double r;

    mxl = *pxl;
    mxm = *pxm;
    bsz = *psz;
    r   = *pr;

    SC_configure_mm(mxl, mxm, bsz, r);

    return((FIXNUM) TRUE);}

/*---------------------------------------------------------------------------*/

/*                                CONFIGURATION                              */

/*---------------------------------------------------------------------------*/

#else

int main()
   {int nb, nd, ni;

    nb = sizeof(mem_descriptor);
    nd = sizeof(double);
    ni = (nb + nd - 1)/nd;

    printf("#define N_DOUBLES_MD %d\n", ni);

    return(0);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

#endif
