/* @(#)osmemory.c	17.1.1.1 (ES0-DMD) 01/25/02 17:35:26 */
/*===========================================================================
  Copyright (C) 1995 European Southern Observatory (ESO)
 
  This program is free software; you can redistribute it and/or 
  modify it under the terms of the GNU General Public License as 
  published by the Free Software Foundation; either version 2 of 
  the License, or (at your option) any later version.
 
  This program 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 General Public License for more details.
 
  You should have received a copy of the GNU General Public 
  License along with this program; if not, write to the Free 
  Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
  MA 02139, USA.
 
  Corresponding concerning ESO-MIDAS should be addressed as follows:
	Internet e-mail: midas@eso.org
	Postal address: European Southern Observatory
			Data Management Division 
			Karl-Schwarzschild-Strasse 2
			D 85748 Garching bei Muenchen 
			GERMANY
===========================================================================*/

/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.TYPE		Module
.IDENTIFICATION	osmemory
.AUTHOR    	Marc Wenger [CDS], Francois Ochsenbein [ESO-IPG]
.LANGUAGE  	C
.VERSION 1	Originally written by Marc Wenger (CDS).
	Adapted by Francois Ochsenbein 28-Oct-1986
.VERSION 2.0	13-Oct-1988: Adapted for VMS
.VERSION 2.1	26-Jun-1990: Use SYS$EXPREG system service
.KEYWORDS	Memory Management
.ENVIRONMENT 	VAX/VMS
.COMMENTS
	These routines allow the management of memory to allocate
	pieces of memory, e.g. for temporary copy of 
	strings. It's especially useful for string communication
	between FORTRAN and C.
\begin{TeX}
\\
	Note that the allocated memory is never freed --- but may be
	reused. The memory is decomposed into ``areas'', in principle multiple
	of the page size (defined as MEM\_AMOUNT), and each area
	may contain several ``zones''. areas and zones are preceded
	by a `memory header' made of :
\begin{itemize}
\item	the length of the area / zone
\item	chain pointer (to next for free zones, to preceding for occupied
	zones)
\end{itemize}

The complete memory structure is described via a ``memory packet'' 
internal to this module.

{\bf Note}: In the Minimal Implementation, use just interfaces to
	malloc / free / realloc routines.
\end{TeX}

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

#define	DEBUG		0	/* For debugging purposes	*/

#define MEM_AMOUNT	2048	/* Memory Amount Allocation	*/

#include <osdefos.h>
#include <macrogen.h>
#include <errno.h>
#include <ssdef.h>

MID_EXTERN int oserror;  		/* system error codes */
MID_EXTERN int vmserror;		/* VMS-specific error code */


typedef struct header { 
	long int nbytes ;	/* Byte length, INCLUDING header size 	*/
	struct header *anext ; 	/* Chain pointer			*/
        } HEADER ;
#define NULL_HEADER	NULL_PTR(HEADER)

MID_STATIC struct { 	/* Initial describing packet	*/	
	long int 	lfree ;		/* length of free zones		*/
	HEADER 		*afree ;    	/* adr. of first free zone	*/
	long int 	larea ;    	/* length of allocated zones	*/
	HEADER 		*aused ;    	/* adr. of last used zone	*/
	int 		nfree ;    	/* number of free zones		*/
	} MMPKT = { 0,NULL_HEADER,0,NULL_HEADER, 0};

static HEADER *osmlink(), *osmget();

/*==========================================================================*/
static HEADER *osmlink(adri)    
/*+++
.PURPOSE Insert into the chain of free zones the adri zone.
.RETURNS Address of previous zone
.REMARKS Internal routine, not traced.
---*/
	HEADER *adri ;	/* IN: adress of zone to insert	*/
{
	register HEADER *adr ;

	/* Look where to place the new zone, such that 
	 * the sequence of addresses is respected	*/

  for (adr = (HEADER *)(&MMPKT) ; 
  	(adr->anext) && (adri > adr->anext); adr = adr->anext) ;

	/* adr points to the preceding zone. Link */

  adri->anext = adr->anext ;
  adr->anext  = adri ;

  MMPKT.lfree += adri->nbytes;	/* for statistics	*/
  MMPKT.nfree++ ; 		/* for statistics	*/

  return(adr) ;
}

/*==========================================================================*/
static HEADER *osmget(nbytes)        
/*+++
.PURPOSE Allocation and insertion of a new zone.
	The new zone is always a multiple of a page.
.RETURNS Address of allocated area / NULL_HEADER if error.
.REMARKS Internal routine, not traced.
---*/
	long int nbytes ;   	/* IN: Length (bytes) of this zone	*/
{
	HEADER 	*adr[2] ;
	long int length;

  length = (nbytes + MEM_AMOUNT - 1)/MEM_AMOUNT;	
  					/* Integer number of pages 	*/
  length *= MEM_AMOUNT;

  vmserror = SYS$EXPREG(length/512, adr, 0, 0);
  if (!(vmserror&1))
  {	oserror = ENOMEM;
	return(NULL_HEADER) ;
  }

  MMPKT.larea += length;	/* For statistics 	*/

  adr[0]->nbytes = length;
  osmlink(adr[0]);		/* Complete the chain of free zones	*/

  return(adr[0]);
}

/*==========================================================================*/
char	*osmmget(nbytes)
/*+++
.PURPOSE Allocate a zone
.RETURNS Address of usable zone, or NULL (failed); oserror contains
	then the error code.
.REMARKS 
---*/
	int  nbytes ;	/* IN: Required length (bytes)	*/
{
	HEADER 	*adr, *aprevious, *aprefit, *adrfit;
	long int length, lenfit;

  adrfit = NULL_HEADER, lenfit = 999999999;

	/* Adjust the length: add header and express in header units	*/

  length  = (nbytes + 2*sizeof(HEADER) - 1) / sizeof(HEADER);
  length *= sizeof(HEADER);

  if (MMPKT.lfree >= length)	
				/* Look for the best matching zone	*/
  {
	for (adr = MMPKT.afree , aprevious = (HEADER *)(&MMPKT); adr; 
		aprevious = adr , adr = adr->anext) 
	{ 	if (adr->nbytes <  length) 	continue;
		if (adr->nbytes < lenfit)	/* Better fit		*/
		{  	adrfit = adr, aprefit = aprevious;
			lenfit = adr->nbytes ;
			if (adr->nbytes == length)	/* Exact match!	*/
				break ;
		}
	}
  }

	/* Here, adrfit contains the address of the best available zone,
	 * or NULL --- lenfit contains the total length of this zone	*/

	/* If no zone is acceptable, then allocate a new area		*/

  if (!adrfit)
  {	if(!osmget(length))
		return(NULL_PTR(char)) ;
	return(osmmget((int)length)) ;
	/* The result of 1 recursive call is returned. Should always work! */
  }

	/* If too few space remains, increase the number of asked bytes */

  lenfit = adrfit->nbytes - length;	/* Free bytes */
  if (lenfit <= sizeof(HEADER))	length += lenfit;

	/* In the found zone is larger than the required number of bytes,
	 * the begginning is free. The actual allocation is at the
	 * end of the found zone. */

  if ((adrfit->nbytes -= length) == 0) 	/* If the free zone exactly matches,
					 * just one less free zone	*/
  { 	MMPKT.nfree-- ;
	aprefit->anext = adrfit->anext ; 
  }

  MMPKT.lfree -= length ; 		/* statistics */

	/* adrfit->nbytes contains the exact remaining length 
	 * Now, compute address of allocated zone, and store.		*/

  adr = (HEADER *)((char *)adrfit + adrfit->nbytes);
  adr->nbytes = length ;
  adr->anext  = MMPKT.aused, MMPKT.aused = adr;
  				/* Insert in chains of allocated pieces	*/

	/* TEST : Lists of :	*/
	
#if DEBUG
  list(adr, nbytes);
#endif

  return((char*)(++adr));
}

/*==========================================================================*/
int	osmmfree(address) 
/*+++
.PURPOSE Free a zone allocated via osmmget
.RETURNS 0 / -1 if error
.REMARKS A null address to free returns 0 (no error).
	A -1 address frees the last zone (unstack).
---*/
	HEADER *address ; /* IN: adress to free	*/
{
	HEADER *aprevious, *adr ;

  if (address == NULL_HEADER)		return(0);
  adr = (address == (HEADER *)(-1) ? MMPKT.aused : address - 1);

	/* Check if was allocated	*/
	
  for (aprevious = (HEADER *)(&MMPKT.larea); 
  	(aprevious->anext) && (aprevious->anext != adr); 
  	aprevious = aprevious->anext) ;

  if (aprevious->anext == NULL_HEADER)
  {	oserror = EFAULT;
	return(-1);
  }

	/* Remove from allocated areas */

  aprevious->anext = adr->anext;

  
	/* insert the zone in the "Free" chain	*/

  aprevious = osmlink(adr);


	/* Try to join consecutive zones:	*/

	/* 1. with preceding zone		*/

  if ((char *) aprevious + aprevious->nbytes == (char *)adr)
  {	aprevious->anext = adr->anext ;
	aprevious->nbytes += adr->nbytes ;
	MMPKT.nfree-- ;
	adr = aprevious ; 
  }
	/* 2. with following zone		*/

  if ((char *)adr + adr->nbytes == (char *)adr->anext)
  {	adr->nbytes += (adr->anext)->nbytes ;
	adr->anext = (adr->anext)->anext ;
	MMPKT.nfree-- ;
  }
#if DEBUG
  list(adr, 0);
#endif

  return(0);
}

/*==========================================================================*/
char	*osmmexp(address, nbytes) 
/*+++
.PURPOSE Reallocates a piece of memory allocated via osmmget
.RETURNS Address of new zone, or NULL if failed.
.REMARKS Values are copied to new zone.
---*/
	HEADER *address ; /* MOD: adress to realloc	*/
	int nbytes;	  /* IN: New length		*/
{
	HEADER	*adrnew, *a;
	int i;

  if (nbytes <= 0)		
  {	oserror = EINVAL;
  	return(NULL_PTR(char));	/* Impossible !!! 	*/
  }

  a = address;
  if (a == NULL_HEADER)	
  	return(osmmget(nbytes)); 	/* Only allocate */

				/* If shorter length, no reallocation	*/
  if ( (--a)->nbytes >= (nbytes + sizeof(HEADER)))
	return((char *)address);

				/* Allocate a new area	*/
  if (!(adrnew = (HEADER *)osmmget(nbytes)))
  	return(NULL_PTR(char));

  	/* Copy the old string into the new one, then free the old one	
	 * Don't forget that nbytes includes also the header !
	 */

  i = a->nbytes - sizeof(HEADER);	/* Number of bytes to copy */
  oscopy((char *)adrnew, (char *)address, i);
  
	/* Free the old memory	*/
  osmmfree(address);

  return( (char *)adrnew);
}

#if DEBUG
static int list(a,n)
	HEADER *a;
	int n;
{	
	HEADER *x;
	static char deb[25];
	char *p;
	int  i;
	
	printf("------Just allocated address %d with %d bytes for %d asked\n", 
		a, a->nbytes, n);

	printf("Total allocated bytes: %d\n", MMPKT.larea);

	printf("%d Free zones (Total = %d bytes)\n", MMPKT.nfree, MMPKT.lfree);
	for (x = MMPKT.afree; x; x = x->anext)
	{	
		printf("Zones %d: bytes=%d\n", x, x->nbytes);
	}
	printf("--------------------------------\n");

	return(0);
	
}
#endif