#ifndef lint
static char *RCSid = "$Id: memory.c,v 1.1 1999/08/31 20:32:32 mark Exp $";
#endif

/*
 *  The Regina Rexx Interpreter
 *  Copyright (C) 1992-1994  Anders Christensen <anders@pvv.unit.no>
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Library General Public
 *  License as published by the Free Software Foundation; either
 *  version 2 of the License, or (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Library General Public License for more details.
 *
 *  You should have received a copy of the GNU Library General Public
 *  License along with this library; if not, write to the Free
 *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/*
 * The routines in this file try to minimize the the number of calls
 * to malloc() and free(). Since it would generally not be possible to
 * release memory, unless it actually is last in the virtual memory
 * that the process holds, just don't release it, and let the
 * interpreter grow. Memory are allocated in only certain sizes, and
 * are "freed" to a freelist, which is within the interpreter.
 *
 * The important routines are get_a_chunk() and give_a_chunk(), which 
 * might be called a large number of times. All the other routines are
 * either called once to initiate, or it is used in tracing and 
 * debugging, where speed and space is not important anyway. 
 *
 * The algorithm works something like this: memory can only be allocated
 * in predetermined sizes (8, 12, 16, 24, 32, ...) and allocation of a 
 * size other than that will have to allocate something slightly bigger.
 * For each size, there is a linked list of free pieces of memory of 
 * that size, the first entry of each of these lists can be accessed 
 * through 'flists', which is an array of pointers to these lists. 
 *
 * Every time someone needs a piece of memory, the first piece of the 
 * freelist containing memory of suitable size (as big or slightly 
 * bigger) is returned. If the list is empty, a large piece of 
 * memory is allocated by malloc(), chopped up and put on the freelist
 * that was empty. 
 *
 * When memory is released, the prime problem is to decide which 
 * freelist to put it on. To manage that, each time memory is 
 * allocated by malloc(), the upper and lower address of the memory 
 * is put in hashtable; given a particular address, the hashtable
 * can be sought using the address as hashvalue, and the result will 
 * be the size of the memory chunks at that address.
 *
 * When dealloacting strings, we know the max-size of the string, and 
 * then we can calculate which freelist the string should be put on,
 * without having to search the hashtable structure. Note that there
 * is no need to deallocate strings using the give_a_string() function,
 * the normal give_a_chunk() will work just as well, but is somewhat
 * slower. 
 *
 * If you don't #define FLISTS, then malloc() and free() should be
 * used instead. That might be very slow on some machines, since rexx
 * tend to use lots of small size memory. If you #define TRACEMEM,
 * memory is traced, which also tend to be slow, since there is a lot
 * of overhead in allocation and deallocation. Also note that in the
 * current implementation you can use malloc()/free() in parallel with
 * the routines defined here.
 *
 * Note that using this metod, the last piece of memory freed will be
 * the first to be used when more memory is needed. 
 *
 * The number of calls to malloc() seems to be negligable when using 
 * this metod (typical less than 100 for medium sized programs). But
 * this is of course dependent on how the program uses memory. 
 *
 * The tracing part of this file, (#ifdef TRACEMEM) is an optional
 * extention for debugging purposes. Whenever memory is allocated,
 * mymalloc() allocates 16 bytes more than needed. These bytes are
 * used like this:
 *
 *   0       4       8      12       16 bytes
 *   | count |f|m|seq| prev  | next  | start of allocated memory
 *
 * The 'count' is the number of bytes allocated, 'f' (flag) is used in 
 * garbage collection, and 'prev' and 'next' are pointers used in a 
 * double linked list. seqv is a sequence number which is iterated 
 * for each memoryallocation.
 * 
 * count is int, prev and next are char*, f is char and seqv is a 
 * 16 bit integer. The 'm' is a magic number. Actually it is just 
 * there to fill the space, and can be used for more useful purposed
 * if needed.
 *
 * An additional option to TRACEMEM is filling allocated and deallocated
 * memory with bitpatterns. If the PATTERN_MEMORY cpp-variable is set,
 * all allocated memory is initated to NOT_USED, and deallocated memory 
 * is set BEEN_USED before deallocation.
 * 
 * Garbage-collection is not implemented, but listleaked will list out
 * every chunk of allocated memory that are not currently in use. The
 * array markptrs contains a list of functions for marking memory.
 * There is a potensial problem with garbage collection, since the 
 * interpreter might 'loose' some memory everytime it hits a syntax
 * error, like "say random(.5)". To fix that, memory should either 
 * be traced and then garbage collected, or it should have a sort 
 * of transaction oriented memory management (yuk!).
 *
 * NOTE that #define'ing TRACEMEM requires that your machine follows
 *      this:  sizeof(int) = sizeof(char*) = 32 bits. It might work
 *      for other machines to (having larger word size), but I don't
 *      guarantee it. 
 *
 */
/****************************************************************************
*   This code modified for Multithread Win32 port by Les Moull April 1999.  *
****************************************************************************/

#include "rexx.h"
#include <stdlib.h>
#include <stdio.h>
#include <assert.h>
#include <string.h>

#ifdef FLISTS

/* 
 * CHUNK_SIZE it the size in which memory is allocated using malloc(), 
 * and that memory is then divided into pieces of the wanted size. 
 * If you increase it, things will work slightly faster, but more 
 * memory is wasted, and vice versa. The 'right' size is dependent on
 * your machine, rexx scripts and your personal taste.
 */
#define CHUNK_SIZE (8192)

/*
 * MAX_INTERNAL_SIZE is the max size of individual pieces of memory 
 * that this system will handle itself. If bigger pieces are requested
 * it will just forward the request to malloc()/free(). Note that 
 * this value should be less than or equal to CHUNK_SIZE.
 */
#define MAX_INTERNAL_SIZE (2048)

/* 
 * MEMINFO_HASHSIZE is the size of the 'hashtable' used to find the size
 * of a chunk of memory, given an address of a byte within that chunk. 
 * Actually, this isn't much of a real hashtable, but still. Allocating
 * large value will not make much harm other than wasting memory. Using 
 * too small value can seriously degrade execution. The optimal size
 * is such that MEMINFO_HASHSIZE * CHUNK_SIZE is only slight bigger 
 * than the actual use of memory in your rexx script (including the 
 * memory that will be wasted)
 */
#define MEMINFO_HASHSIZE (499)

/* 
 * GET_SIZE() is a 'function' that returns a index into the 'hash' 
 * variable, given a specific number. The index returned will be the
 * index of the ptr to the list of free memory entries that is identical
 * or slightly bigger than the parameter in size.
 */
#define GET_SIZE(a) (hash[((a)+3)>>2])

/*
 * This is the hashfunction for use with 'hashtable'. It will effectively
 * just shift away some of the lower bits and fold the result around
 * the 'hashtable'. Note that '13' is corresponent to CHUNK_SIZE, since
 * 8192 == 1<<13, which is the optimal size. If you change one of them
 * be sure to change the other. 
 * 
 * Maybe we could eliminate a division by letting MEMINFO_HASHSIZE have
 * a number equal to a binary 'round' number (e.g. 512). There is no
 * need to keep the size a prime number, since the elements in the 
 * table *will* be well distributed.
 */
#define mem_hash_func(a) (((a)>>13)%MEMINFO_HASHSIZE)

/* 
 * Here are the list of the 'approved' sizes. Memory is only allocatable
 * in these sizes. If you need anything else, use the lowest number that
 * is higher than what you need.
 *
 * Why exactly these numbers? Why not? Note that these are a subset 
 * of the series {8,16,32,64,128...} and {12,24,48,96} mingled together. 
 * Note that you can not allocate memory in smaller sizes than is 
 * possible to fit a pointer (to char and/or void) into. Also take 
 * into consideration that all these sizes should be aligned according
 * to the size of ints and pointers, so don't make them too small.
 */
#if !defined(HAVE_WINMULTITHREADING)
static int sizes[] = {    8,   12,   16,   24,   32,   48,   64,   96, 
                        128,  192 , 256,  384,  512,  768, 1024, 1536, 
                       2048, 3072, 4096 } ;
#endif
/* 
 * The array of pointers to the freelists having memory of the sizes 
 * specified in 'sizes'. I.e. flists[0] is a pointer to a linked list
 * of free memory chunks of size 8, flist[1] to memory of size 12 etc.
 * The size of this array is the same as the size of 'sizes'.
 */
#if !defined(HAVE_WINMULTITHREADING)
static char *flists[sizeof(sizes)/sizeof(int)] = { NULL } ; 
#else
   extern globalext SG;
#endif

/*
 * The type meminfo holds the info about the connection between the 
 * address of allocated memory and the size of that memory. When new
 * memory is allocated by malloc(), in size CHUNK_SIZE, a new box of
 * meminfo is created, which holds the address returned from malloc()
 * and the size in which the chunk was divided {8,12,16,24,32...}.
 */
#if !defined(HAVE_WINMULTITHREADING)
typedef struct meminfo_type 
{
   char *start ;                /* start of memory's address */
   char *last ;                 /* end of memory's address */
   struct meminfo_type *next ;  /* next ptr in linked list */
   int size ;                   /* size of chunks at that address */
} meminfo ;
#endif

/* 
 * The 'hashtable'. Used for quick access to the size of a chunk of
 * memory, given its address.
 */
#if !defined(HAVE_WINMULTITHREADING)
static meminfo *hashtable[ MEMINFO_HASHSIZE ] = { NULL } ;
#endif

/* 
 * Array used for rounding a number to an 'approved' size, i.e. a size
 * in which the interpreter will allocate memory. Remember that the 
 * approved sizes are {8,12,16,24,32 ...}? This function will return 
 * 8 for 1 through 8; 12 for 9 through 12; 16 for 13 through 16 etc.
 * It is not initially set, but will be set by init_hash_table().
 *
 * Note: the 'step' in this table (4 as it is defined below) must not
 * be bigger then the smallest gap in between two 'approved' sizes of
 * memory. E.g the smallest gap as defined above is 12-8 = 4.
 *
 * Actually, the name is somewhat misleading, since this is not really
 * a hashtable, it is just a leftover from the time when it actually
 * was a hashtable. 
 *
 * Due to how the hash array is initialized, we have to allocate one 
 * more item than is going to be used. This is really a klugde, and we 
 * really ought to fix it a more clean way.
 */
/* static */ 
#if !defined(HAVE_WINMULTITHREADING)
short hash[ CHUNK_SIZE/4 + 1 ] ;
#endif


/*
 * This function initiates the variable 'hash'. This might have been 
 * done initially, since the values in this will never change. But 
 * since the size is rather big. it is more efficient to spend some 
 * CPU on initiating it. The startup time might be decreased by swapping
 * this routine for a pre-defined variable. Perhaps it should be 
 * rewritten to use two arrays, one for large pieces of memory and 
 * one for small pieces. That would save space in 'hash'
 *
 * The values put into the array has been described above. 
 */
void init_hash_table( void ) 
{
   int indeks ;   /* index into current element to be initiated */
   int j ;
   int size ;
   int num ;
#include "multi.h"

   /* 
    * Set the few lowest values manually, since the algoritm breaks
    * down for sufficient small values. 
    */
   indeks = 0 ;
   hash[indeks++] = 0 ;  /* when size equals 0, well ... 8 :-) */
   hash[indeks++] = 0 ;  /* for 1 <= size < 4 */
   hash[indeks++] = 0 ;  /* for 4 <= size < 8 */

   /* 
    * The main loop. How does this algorithm work, well, look at the 
    * following table, in which all numbers should be multiplied with
    * 4 to get the correct numbers. 
    *
    *  bin        sizes
    *   0   (8) :  2
    *   1  (12) :  3
    *   2  (16) :  4  5
    *   3  (24) :  6  7
    *   4  (32) :  8  9 10 11
    *   5  (48) : 12 13 14 15 
    *   6  (64) : 16 17 18 19 20 21 22 23 
    *   7  (96) : 24 25 26 27 28 29 30 31
    *   8 (128) : 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
    *   9 (192) : 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
    * etc
    *
    * The number to the left of the colon is the index into the
    * 'sizes' array, and the number in parenthesis is the size which
    * 'sizes' would return for that index. The numbers to the right of
    * the colon are all the elements in 'hash' that contains that
    * particular index into 'sizes'.  Notice that pairs of lines have
    * equal number of numbers, and that the number of numbers doubles
    * for every second line.
    *
    * Therefore, let size be the number of elements to initialize in
    * each iteration, and double it at the end of the loop. 'size'
    * will then loop through 8, 16, 32, 64, 128 ... For each iteration
    * of that loop, initialize 'size'/2 numbers to 'num' and then the
    * next 'size'/2 numbers to 'num'+1. Increment 'num' by two for
    * each iteration. The 'indeks' is the current number in hash to
    * initialize.
    */
   size = 1 ;
   num = 1 ;
   for (; indeks<(CHUNK_SIZE/4); )
   {
      /* 
       * Initalize first in each pair of bins of same length.
       * I.e  8, 16, 32,  64 ... etc
       */
      for (j=0; j<size; j++ )
         hash[indeks++] = (short) num ;
      num++ ;

      /* 
       * Initialize the second in each pair: 12, 24, 48, 96 ... etc
       */
      for (j=0; j<size; j++ )
         hash[indeks++] = (short) num ;
      num++ ;
      size = size << 1 ;
   }

   /* 
    * Do I need this? I don't think so. It is a kludge to make something
    * work on 64 bit machines, but I don't think it is needed anymore.
    * Just let is be commented out, and the delete it if things seem
    * to work.
    */

   if (sizeof(int)>4 || sizeof(int*)>4)
      hash[3] = 2 ;
   memset( flists, 0, ( sizeof(sizes) / sizeof(int) ) * sizeof(char *) );
#include "unmulti.h"
}



/*
 * Adds information about a chunk of memory to the hashtable memory 
 * addresses and the chunksize at that address. Note that two addresses
 * are sent as parameters, the start of the memory to be registerd, and
 * the address under which the information is to be registered. Why? 
 * Look at the following figure:
 *
 * 0               8K               16K                24K
 * +---------------+-----------------+------------------+-------------+
 * |    AAAAAAAAAAAAAAAAAA   BBBBBBBBBBBBBBBBBB
 * +----+----------------+---+----------------+-------------------------+
 *      3K              11K 13K              21K
 * 
 * Two chunks are allocated: A and B. The chunks are allocated in 8K
 * blocks, but they will in general not follow the 8K boundaries of
 * the machine. The 'hashtable' array have entries that _do_ follow
 * the 8K boundaries of the machine. Therefore, chunk A must be
 * registered under the in the 'hashtable' entries for both the 0-8K
 * segment, and the 8-16K segment. And vice versa, the 8-16K segment
 * may contain parts of chunk A and B.
 *
 * This could be avoided, if the chunks were aligned with the boundaries 
 * of the computer. If you change any of the constants in this part of
 * the program, be sure to tune them to match eachother!
 * 
 * Of course, this routines need memory to be able to register other 
 * memory, so to avoid a deadlock, it calls malloc directly. It will 
 * never release memory, since we can really not be sure that all 
 * memory has been released.
 */
void add_entry( char *start, char *addr, int bin_no ) 
{
   meminfo *ptr ;              /* work ptr */
   int tmp ;                   /* tmp storage for mem_hash_func() */
   static meminfo *mem=NULL ;  /* ptr to array, empty at first */
   static int indeks=128 ;      /* force it to allocate at first invocation */
#include "multi.h"

   /*
    * If we have used all free meminfo-boxes, allocate more. This is 
    * forces upon us at the first invocation. Allocate space for 128
    * at a time.
    */
   if (indeks>=128)
   {
      /* Stupid SunOS acc gives incorrect warning for the next line */
      if  ((mem = malloc( sizeof( meminfo) * 128 )) == NULL)
          exiterror( ERR_STORAGE_EXHAUSTED, 0 )  ;
      indeks = 0 ;
   }

   /* 
    * Fill in the fields of the box, and put it in the front of the 
    * requested bin in hashtable
    */
   ptr = &mem[ indeks++ ] ;   
   ptr->next = hashtable[tmp=mem_hash_func((unsigned int)addr)] ;
   ptr->size = bin_no ;
   ptr->start = start ;
   hashtable[tmp] = ptr ;
#include "unmulti.h"
}


/* 
 * Allocate a piece of memory. The size is given as the 'size' parameter.
 * If size is more than MAX_INTERNAL_SIZE, it will call malloc()
 * directly, else, it will return a piece of memory from the freelist,
 * after possibly filling the freelist with more memory if is was
 * empty in the first place.
 */
void *get_a_chunk( int size )
{
   register int bin ;     /* bin no in array of freelists */
   register char *vptr ;  /* holds the result */
   register void *result ; 
#include "multi.h"

   /*
    * If memory is too big, let malloc() handle the problem. 
    */
   if (size>MAX_INTERNAL_SIZE) 
   {
      if ((result=malloc( size )) != NULL)
         return result ;
      else
          exiterror( ERR_STORAGE_EXHAUSTED, 0 )  ;
   }

   /*
    * Get the first item from the appropriate freelist, and let 'vptr'
    * point to it. Simultaneously set bin to the bin no in 'flists' 
    * to avoid recalculating the number. If the freelist is empty 
    * (i.e vptr==NULL) then allocate more memory.
    */
   if ((vptr=flists[bin=GET_SIZE(size)])==NULL)
   {
      char *ptr ;      /* work ptr, to loop through the memory */
      char *topaddr ;  /* points to last item in memory */

      /* 
       * Allocate the memory, and set both vptr and initiate the 
       * right element in 'flists'. Note that the value in 'flists' is 
       * 'incremented' later, so it must be set to the value which now
       * is to be allocated. 
       */
      vptr = malloc( CHUNK_SIZE + sizes[bin]) ;
      if (!vptr)
          exiterror( ERR_STORAGE_EXHAUSTED, 0 )  ;
      flists[bin] = vptr ;

      /* 
       * Calculate the top address of the memory allocated, and put 
       * the memory into 'topaddr'. Then register the chunk of memory 
       * in both the possible CHUNK_SIZE segments of the machine. In 
       * some rare cases the last registration might not be needed,
       * but do it anyway, to avoid having to determine it.
       */
      topaddr = vptr + CHUNK_SIZE - sizes[bin] ;
      add_entry( vptr, vptr, bin ) ;
      add_entry( vptr, vptr + CHUNK_SIZE, bin ) ;

      /*
       * Then loop through the individual pieced of memory within the 
       * newly allocated chunk, and make it a linked list, where the 
       * last ptr in the list is NULL.
       */
      for (ptr=vptr; ptr<topaddr; ptr=ptr+sizes[bin] )
         *(char**)ptr = ptr + sizes[bin] ;
  
      *((char**)(ptr-sizes[bin])) = NULL ;
   }

   /*
    * Update the pointer in 'flist' to point to the next entry in the
    * freelist instead of the one we just allocated, and return to 
    * caller.
    */
   flists[bin] = (*((char**)(vptr))) ;
   return (vptr) ;
#include "unmulti.h"
}


streng *get_a_streng( int size )
{
   register int bin ;     /* bin no in array of freelists */
   register char *vptr ;  /* holds the result */
   register streng *result ; 
#include "multi.h"

   size = size + STRHEAD;
   /*
    * If memory is too big, let malloc() handle the problem. 
    */
   if (size>MAX_INTERNAL_SIZE) 
   {
      if ((result=malloc( size )) != NULL)
      {
         result->len = 0 ;
         result->max = size-STRHEAD ;
         return result ;
      }
      else
          exiterror( ERR_STORAGE_EXHAUSTED, 0 )  ;
   }

   /*
    * Get the first item from the appropriate freelist, and let 'vptr'
    * point to it. Simultaneously set bin to the bin no in 'flists' 
    * to avoid recalculating the number. If the freelist is empty 
    * (i.e vptr==NULL) then allocate more memory.
    */
   if ((vptr=flists[bin=GET_SIZE(size)])==NULL)
   {
      char *ptr ;      /* work ptr, to loop through the memory */
      char *topaddr ;  /* points to last item in memory */

      /* 
       * Allocate the memory, and set both vptr and initiate the 
       * right element in 'flists'. Note that the value in 'flists' is 
       * 'incremented' later, so it must be set to the value which now
       * is to be allocated. 
       */
      vptr = malloc( CHUNK_SIZE + sizes[bin]) ;
      if (!vptr)
          exiterror( ERR_STORAGE_EXHAUSTED, 0 )  ;
      flists[bin] = vptr ;

      /* 
       * Calculate the top address of the memory allocated, and put 
       * the memory into 'topaddr'. Then register the chunk of memory 
       * in both the possible CHUNK_SIZE segments of the machine. In 
       * some rare cases the last registration might not be needed,
       * but do it anyway, to avoid having to determine it.
       */
      topaddr = vptr + CHUNK_SIZE - sizes[bin] ;
      add_entry( vptr, vptr, bin ) ;
      add_entry( vptr, vptr + CHUNK_SIZE, bin ) ;

      /*
       * Then loop through the individual pieced of memory within the 
       * newly allocated chunk, and make it a linked list, where the 
       * last ptr in the list is NULL.
       */
      for (ptr=vptr; ptr<topaddr; ptr=ptr+sizes[bin] )
         *(char**)ptr = ptr + sizes[bin] ;
  
      *((char**)(ptr-sizes[bin])) = NULL ;
   }

   /*
    * Update the pointer in 'flist' to point to the next entry in the
    * freelist instead of the one we just allocated, and return to 
    * caller.
    */

   flists[bin] = (*((char**)(vptr))) ;
   ((streng *)vptr)->len = 0 ;
   ((streng *)vptr)->max = size-STRHEAD ;

   return ((streng *)vptr) ;
#include "unmulti.h"
}

/* 
 * Shortcut to deallocate a streng. Since we know the max size of a 
 * streng, we don't really need to calculate the size using of the
 * hashtable structure. That saves some time, since a lot of the 
 * memorychunks in rexx are strengs. 
 *
 * Note that strengs can just as well be deallocated using the 
 * 'normal' method, but this interface saves some time. Just a thought:
 * if all allocated string were sure to have a max size that did not
 * waste any memory, we didn't have to expand the GET_SIZE macro, 
 * and thereby saving even a few more cycles
 */
void give_a_streng( streng *ptr )
{
   char **tptr ;   /* tmp variable, points to element in flists */
#include "multi.h"

   assert( ptr->len <= ptr->max ) ;
   if ((ptr->max+STRHEAD) > MAX_INTERNAL_SIZE)  /* off-by-one error ? */
   {
      free( ptr ) ; 
      return ; 
   }

   /* 
    * First find the right element in flists, then link this piece
    * of memory into the start of the list, clean and simple. 'tptr'
    * is the old first element in the freelist, and 'ptr' is the 
    * memory to free. 
    */
   tptr = &flists[ GET_SIZE(ptr->max + STRHEAD) ] ;
   *((char**)ptr) = *tptr ;
   *tptr = (char*)ptr ;
#include "unmulti.h"
}

/*
 * The standard interface to freeing memory. The parameter 'ptr' is 
 * a pointer to the memory to be freed, is put first in the freelist
 * pointed to by the appropriate element in 'flists'.
 * 
 * I am not really sure what cptr do in this, but I think it has 
 * something to do with *void != *char on Crays ... The main consumer
 * of CPU in this routine is the for(;;) loop, it should be rewritten.
 */
void give_a_chunk( void *ptr ) 
{
   char *cptr ;      /* pseudonym for 'ptr' */
   meminfo *mptr ;   /* caches the right element in hashtable */
#include "multi.h"

   /*
    * initialize a few values, 'cptr' is easy, while 'mptr' is the
    * list of values for this piece of memory, that is in the 
    * hashtable that returns memory size given a specific address
    */
   cptr = (char*)ptr ;
   mptr = hashtable[ mem_hash_func( ((unsigned int)cptr) ) ] ;

   /* 
    * For each element in the list attached to the specific hashvalue, 
    * loop through the list, and stop at the entry which has a start 
    * address _less_ than 'cptr' and a stop address _higher_ than 
    * 'cptr' (i.e. cptr is within the chunk.)
    */
   for ( ; (mptr) && ((mptr->start+CHUNK_SIZE<=cptr) || (mptr->start>cptr)); mptr = mptr->next) ;

   /*
    * Now, there are two possibilities, either is mptr==NULL, in which
    * case this piece of memory is never registered in the system, or 
    * then we have more information. In the former case, just give 
    * the address to free(), hoping it knows more. In the latter, put
    * the memory on the appropriate freelist. 
    */
   if (mptr)
   {
      /* 
       * Link it into the first place of the freelist.
       */
      *((char**)cptr) = flists[mptr->size] ;
      flists[mptr->size] = cptr ;
   }
   else
      free( ptr ) ; 
#include "unmulti.h"
}

#endif /* FLISTS */



#ifdef TRACEMEM
/* 
 * If we are tracing memory, each piece of allocated memory gets the 
 * following header prepended, which are used to keep track of that 
 * piece of memory. 
 */
#if !defined(HAVE_WINMULTITHREADING)
typedef struct memhead
{ 
   int count ;                    /* Size of this piece of memeory */ 
   struct memhead *prev, *next ;  /* Ptrs in double linked list */
   unsigned short seqv ;          /* Sequential counter */
   unsigned char flag ;           /* What is this memory used for */
   unsigned char magic ;          /* Not really used */
} memheader;
#endif


# ifdef PATTERN_MEMORY
/*
 * The two byte values NOT_USED and BEEN_USED are patterns which newly 
 * allocated dynamic memory will be set to, and memory to be freed 
 * will be set to, respectively. This is done to provoke problems  if 
 * memory is used but not initialized, or if it used after is has 
 * been released. 
 */

#  define NOT_USED (0x42)    /* letter 'B' */
#  define BEEN_USED (0x69)   /* letter 'i' */

/*
 * The magic cookie is just a placeholder, it is checked for consistency
 * but could easily be used for something else, if the space is needed.
 */
#  define MAGIC_COOKIE (0xd4)

# endif /* PATTERN_MEMORY */


/*
 * Strings used to mark chunks of memory when listing dynamically 
 * allocated memory in listleaked(). Length is max 8 chars.
 * 
 * NOTE: There is a close correspondace between these and the cpp
 *       variables TRC_* in defs.h. If you change one of them, please
 *       change the other too. 
 */
char *allocs[] = {
   "leaked",     /* status unknown, probably leaked */
   "hashtab",    /* holds hashtable in variable subsystem */
   "procbox",    /* the info local to a single routine */
   "source",     /* a line of source code */
   "srcbox",     /* box in list of source lines */
   "treenode",   /* node in the parse three */
   "var_val",    /* value of a variable */
   "var_nam",    /* name of a variable */
   "var_box",    /* other structure in the variable subsystem */
   "stc_box",    /* box in linked list of the stack lines */
   "stc_line",   /* stack line */
   "sys_info",   /* the common info for a whole program */
   "file_ptr",   /* holds the filetable */
   "proc_arg",   /* holds arguments for internal or builtin functions */
   "label",      /* holds info about labels */
   "static",     /* names of special variables */
   "argcache",   /* the proc argument cache */
   "math",       /* dynamic workarrays in the math funcstion */
   "envirbx",    /* box holding environment definition */
   "envirnm",    /* name in a box holding environment definition */
   "spcvarbx",   /* special variable box */
   "spcvarnm",   /* special variable name */
   "spcnumbx",   /* special number box */
   "spcnumnm",   /* special number contents */
   NULL          /* terminator */
} ;

/* 
 * Array of functions to call for marking all active chunks of dynamic
 * allocated memory. These will mark _all_ dynamically allocated 
 * memory. Anything unmarked after all these routines are called, 
 * must be leaked memory. Add more functions as you wish
 */
static void (*fptr[])() = {
   mark_stack,       /* the lines on the stack */
   mark_systeminfo,  /* the system information box */
   mark_filetable,   /* the file descriptor table */
   mark_param_cache, /* the parameter chache */
   mark_descrs,      /* memory used by sting math routines */
   mark_signals,     /* */
   NULL              /* terminator */
} ;


/*
 * Counter for dynamically memory allocated, in bytes, and ditto for
 * the deallocated memory, dynamic memory currently in use is the
 * difference between these. This is only used for gathering 
 * statistics.
 */
#if !defined(HAVE_WINMULTITHREADING)
static int allocated=0 ;
static int deallocated=0 ;
#endif


/* 
 * Sequence number for newly allocated memory, incremented for each 
 * new allocation of dynamic memory. Actually, it is stored as a
 * unsigned short in the memhead of each memory allocation. That might
 * be slightly too small, since the number of memory allocation can 
 * easily reach 100000, even for relatively small programs. 
 *
 * Therefore, the sequence number might be stored as a 24 bit number,
 * (on 32 bit machines). But anyway, who cares, it is only used for 
 * debugging purposes.
 */
#if !defined(HAVE_WINMULTITHREADING)
static int sequence=0 ;
/*
 * Pointer to last (most newly) allocated memorychunk in double linked 
 * list of all allocated dynamic memory.
 */
struct memhead *header0=NULL ;
#endif

/*
 * This routine obtains memory, either through get_a_chunk, or through
 * malloc() if we are not running with freelists. The memory requested
 * will be increased with the size of a memhead structure (32 bytes on 
 * 'normal' 32 bit machines). 
 *
 * The function also updates the statistics, linkes it into the list
 * of currently allocated memory, and might pattern the memory.
 */
void *mymalloc( int bytes )
{
   struct memhead *memptr ;  /* holds the result */
#include "multi.h"

   /*
    * Increase the size of the memory wanted, so we can put the 
    * header into it first. You'd better not have played with the
    * parameters above in such a way that the result is non-aligned.
    */
   allocated += (bytes += sizeof(struct memhead) ) ;

   /* 
    * Do the actual allocation of memory, either call get_a_chunk()
    * or be boring and call plain old malloc(). In either case, 
    * chicken out if there are not any more memory left. Hmmm, this 
    * situation should be handled better. Memory management should 
    * be transaction oriented
    */
#ifdef FLISTS
   if (!(memptr=get_a_chunk(bytes))) 
#else
   if (!(memptr=malloc(bytes))) 
#endif
       exiterror( ERR_STORAGE_EXHAUSTED, 0 )  ;

#ifdef PATTERN_MEMORY
   /* 
    * If the options for memory patterning is set, perform it. This is
    * only useful during debugging, to provoke error due to the use of
    * uninitialized variables. Other than that, it is just a pure waste
    * of CPU.
    */
   memset( memptr, NOT_USED, bytes ) ;
#endif /* PATTERN_MEMORY */

   /* 
    * Fill in the fields of the header: the size, the sequence number, 
    * the magic number, initialize the flag, and then link it into the
    * linked list of allocated memory, at the start of the list. 
    */
   memptr->count = bytes ;
   memptr->flag = 0 ;
   memptr->magic = MAGIC_COOKIE ;
   memptr->seqv = ++sequence ;
   memptr->prev = NULL ;
   memptr->next = header0 ;
   if (header0)
      header0->prev = memptr ;

   /*
    * Increment the pointer to the start of the memory that the user
    * is allowed to use, i.e past the header. The return.
    */
   header0 = memptr++ ;
   return memptr ;
#include "unmulti.h"
}



/* 
 * myfree takes a pointer to memory to be deallocated, it is a wrapper 
 *    for free(3), and does some housekeeping tasks
 */
void myfree( void *cptr )
{
   struct memhead *memptr ;   /* ptr to memory to be freed */
#include "multi.h"

   /* 
    * The header part of the memory is prepended to the part of the 
    * memory that the user saw, so move the pointer backwards to the
    * start of the header. 
    */
   memptr = ((struct memhead *)cptr) - 1 ;

   /*
    * If the magic cookie is not intact, there must be some serious 
    * problems somewhere. Inform the user about it, and exit.
    */
   if (memptr->magic != MAGIC_COOKIE)
       exiterror( ERR_INTERPRETER_FAILURE, 0 )  ;

   /*
    * Update the statistics. Remember that we do not decrement the 
    * variable 'allocated'. The real number of memory allocated is 
    * the difference between those two. 
    */
   deallocated -= memptr->count ;

   /* 
    * Then unlink the chunk of memory from the linked list of allocated
    * memory. Set the pointers at its neighbors (if any) and set the
    * 'header' variable if it was first in the list.
    */
   if (memptr->next)
      memptr->next->prev = memptr->prev ;

   if (memptr->prev)
      memptr->prev->next = memptr->next ;
   else
      header0 = memptr->next ;

#ifdef PATTERN_MEMORY
   /* 
    * If we are to pattern the memory, overwrite the contents of the 
    * memory, to provoke errors if parts of the interpreter use 
    * memory after it have been deallocated.
    */
   memset( memptr, BEEN_USED, memptr->count ) ;
#endif

   /* 
    * Then at last, deallocate the memory, either by giving it to 
    * give_a_chunk (to be stored in the freelists) or by giving it
    * it directly to free().
    */
#ifdef FLISTS
   give_a_chunk(memptr) ; 
#else
   free(memptr) ;  
#endif
#include "unmulti.h"
}



/* have_allocated returns the amount of dynamic memory that has been
 *    allocated, in bytes.
 */
int have_allocated( int flag )
{
   int result ;
#if !defined(HAVE_WINMULTITHREADING)
   extern int allocated ;
   extern int deallocated ;
#else
# include "multi.h"
#endif

   switch ( flag ) 
   {
      case ( MEM_CURRENT ) :
         result = allocated - deallocated ;
         break ;
  
      case ( MEM_ALLOC ) :
         result = allocated - deallocated - listleaked( MEMTRC_NONE ) ;
         break ;
   
      case ( MEM_LEAKED ) :
         result = listleaked( MEMTRC_NONE ) ;
         break ;

      default :
          exiterror( ERR_INCORRECT_CALL, 0 )  ;
   }

   return result ;
#include "unmulti.h"
}


#define MAX_MARKERS 100

#if !defined(HAVE_WINMULTITHREADING)
static void (*(markers[MAX_MARKERS]))() = { NULL } ;
static int max_markers_regd= 0 ;
#endif

void regmarker( void (*marker)() )
{
#include "multi.h"
   if (max_markers_regd>=MAX_MARKERS)
       exiterror( ERR_INTERPRETER_FAILURE, 0 )  ;

   markers[max_markers_regd++] = marker ;
#include "unmulti.h"
}



/* 
 * This routine will three distinct things. First it iterates through 
 * all the memory currently allocated and mark them as leaked. Then
 * it calls in sequence all the routines that mark the memory that the
 * various parts of the system claims. The pieces of memory that is 
 * still marked leaked are then unclaimed. At last it iterates 
 * through the list of memory once more, and dumps info about those 
 * that are unclaimed by any part of the interpreter. 
 *
 * The parameter 'pflag' may have a value which is defined by the 
 * macros MEMTRC_ in defs.h. These may be MEMTRC_NONE to not write out
 * anything; MEMTRC_ALL to list all memory; or MEMTRC_LEAKED which 
 * only writes out the memory that is actually leaked. 
 */
int listleaked( int pflag ) 
{
   struct memhead *memptr ;  /* ptr that iterates through the memory */
   int i ;                   /* general loop control variable */
   int sum ;                 /* the sum of allocated memory */
   char *string ;            /* ptr to the current allocated memory */
#include "multi.h"

   /* 
    * First, set the status of all pieces of memory to leaked.
    */
   for (memptr=header0; memptr; memptr=memptr->next)
      memptr->flag = TRC_LEAKED ;

   /*
    * Then, call the functions that claims the memory that belongs to 
    * the various parts of the system. These routines are stored in the 
    * array 'fptr'. If you ever write anything that uses more memory, 
    * be sure to add a function that is able to mark it, and append the
    * name of that function to 'fptr'. If you don't, and garbage 
    * collection is implemented, you are in deep trouble. 
    *
    * Note the mark_listleaked_params(), that is special, since it marks
    * the parameters that the is in use by during the calling of the
    * builtin function that invokes this function.
    */
   mark_listleaked_params() ; 
   for (i=0;fptr[i];i++)
      (*(fptr[i]))() ;

   for (i=0; i<max_markers_regd; i++)
     (*(markers[i]))() ;

   /* 
    * Write out a header for the output, but only if we actually are to
    * trace the values.
    */
   if (! pflag==MEMTRC_NONE)
      fprintf(stddump," Len  Flg Tag      Seqv Contents\n") ;

   /*
    * Then, loop through the allocated memory, and for each piece of 
    * memory in the linked list, check to see if it is leaked. If we
    * were called with the MEMTRC_ALL flag, then list out for every
    * piece of memory.
    */
   for (sum=0,memptr=header0; memptr; memptr=memptr->next)
      if ((memptr->flag==TRC_LEAKED)||(pflag==MEMTRC_ALL))
      {
         /*
          * Keep an account on how much memory is actually in use. If 
          * we are not to write anything out, skip the rest of this 
          * iteration. 
          */
         sum += memptr->count ;
         if (!(pflag==MEMTRC_NONE))
            {
            /* 
             * Dump info about the current piece of memory. That includes
             * the size (excl the header), the flag and the string 
             * belonging to the flag, and then the sequence number. 
             */
            fprintf(stddump, "%5d %3d %-8s %4d \"", 
                    memptr->count - sizeof(struct memhead),
                    memptr->flag, allocs[memptr->flag], memptr->seqv ) ;

            /*
             * Dump the contents of the piece of memory. One piece of 
             * memory per line in the output. 
             */
            string = (char*)(memptr+1) ; 
            for (i=0; i<(memptr->count - sizeof(struct memhead)); i++ )
            {
               if (i==40) /* bja 20->40 */
               {
                  /* 
                   * If it is more than 40 bytes long, terminate and write - bja 20->40
                   * out "..." to indicate that there are more bytes in 
                   * the memory than was possible to write out. 
                   */
                  fprintf(stddump, " ..." ) ;
                  break ;
               }
               /*
                * Write out a byte. If it is not a printable character, 
                * write out a "?" instead, to indicate this. Perhaps this
                * should really be done using isprint() instead of 
                * testing for a specific range of values?
                */
               if ((string[i]>=' ')&&(string[i]<0x7f))
                  putc( string[i], stddump ) ;
               else
                  putc( '?', stddump ) ;
            }
            fprintf( stddump, "\"\n" ) ;
         }
      }

   return sum ;
#include "unmulti.h"
}


/*
 * Marks a chunk of memory pointed to by 'ptr' to be of the kind
 * referenced in 'flag'. Might be defined as a macro, but since memory
 * garbagecollection is just for debugging purposes, there is really
 * no need to worry about that now. 
 */
void markmemory( void *ptr, int flag )
{
  struct memhead *memptr ;  /* work pointer to memory to be marked */

  /* 
   * It's rather simple, ptr is non-NULL, decrement the memptr pointer
   * to the start of the header, and set the flag. I am not sure 
   * whether an internal error should be given if 'ptr' is NULL. 
   * Maybe lots of code could be extracted from other parts of the 
   * interpreter if they don't have to worry about not sending NULL
   * pointer to markmemory()?
   *
   * That is hardly a problem now, since this is only used for debugging.
   * The only confusing part of this routine might be the casting.
   */
  if ((memptr=((struct memhead *)ptr)))
  {
     memptr-- ;
     memptr->flag = flag ;
  }
  else
      exiterror( ERR_INTERPRETER_FAILURE, 0 )  ;
}


/*
 * This is really a simple routine, to write out the values of some
 * of the statistics gathered during (de)allocation of memory. Maybe it
 * should return the answer instead?
 */
void memory_stats()
{
#if !defined(HAVE_WINMULTITHREADING)
   extern int allocated ;    /* total number of bytes allocated */
   extern int deallocated ;  /* total number of bytes deallocated */
   extern int sequence ;     /* the number of allocations */
#else
# include "multi.h"
#endif

   fprintf(stddump,
        "Allocated %d bytes in %d chunks, of which %d is deallocated\n",
        allocated, sequence, deallocated ) ; /* bja - variables out of order */
#include "unmulti.h"
}

#endif /* TRACEMEM */

#ifdef CHECK_MEMORY
#  if defined(TRACEMEM) || defined(FLISTS)
#     error CHECK_MEMORY should only be defined if FLISTS and TRACEMEM are not defined. Please, check the header files.
#  endif

void give_a_streng( streng *ptr )
{
/*
 * The assert is not really needed if we check for ptr!=NULL for the
 * free(ptr->value). Note, that free(NULL) is allowed in ANSI. But we will
 * check for error free code in case of !defined(CHECK_MEMORY), thus, we
 * assert the freeing. FGC
 */
   assert((ptr != NULL) && (ptr->value != NULL));
   free(ptr->value);
   free(ptr);
}

#endif /* CHECK_MEMORY */