/* @(#)ftocc	17.1.1.1 (ESO-IPG) 01/25/02 17:34:06 */
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.TYPE		Module
.IDENTIFICATION	ftoc.c
.AUTHOR    	Francois Ochsenbein [ESO-IPG]
.LANGUAGE  	C
.KEYWORDS	Fortran to C strings
.ENVIRONMENT 	VAX / VMS
.COMMENTS
	Fortran / C interface.
	These routines allow to convert Fortran strings (blank-filled)
	to C standards (nul-terminated). It is assumed that the
	strings are stacked (last in, first out). The size of the stack
	is defined by the parameter FTOC_STACKSIZE.

	The normal way to use these interfaces is to get first a ``mark''
	with the routine ftoc_mark, then use repeatidly ftoc_get
	if strings are needed (and eventually ftoc_cpy to reformat
	string for FORTRAN usage), and finally ftoc_free(mark)
	to release the memory allocated.
	
	A copy in a static area (size FTOC_LOCALSIZE) is done when possible; 
	a dynamic allocation is made if there is not enough room.
	
	
.VERSION   1.0	12-Jun-1987: Extracted from OS_FORIF (VAX/VMS)
.VERSION   2.0	15-Oct-1990: Generalized

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

#include <string.h>

#define FTOC_LOCALSIZE	1024	/* Up to this amount is stored here	*/
#define FTOC_STACKSIZE	32	/* How many strings can be stacked	*/

	/* The local buffer stores short strings, up to 128 bytes;
	   the upper value of the stack is the index in buffer.
	*/

static char buffer[FTOC_LOCALSIZE];
static int  mindex = 0;			/* Index of free space in buffer */

static char *stack[FTOC_STACKSIZE];
static int  marker = 0;			/* Current index in stack */

/*==========================================================================*/
int ftoc_mark()
/*+++
.PURPOSE Get a ``marker'' for Fortran to C
.RETURNS A number to be used in ftoc_free
---*/
{
	static char err_text[] = "**** ftoc stack full ****\n";

  if (marker < FTOC_STACKSIZE)
	stack[marker] = (char *)mindex;
  else	write(2, err_text, sizeof(err_text)-1);
  return(marker++);
}

/*==========================================================================*/
int ftoc_free(mark)
/*+++
.PURPOSE Free the memory allocated since ftoc_mark call
.RETURNS 0 / -1
---*/
	int	mark;	/* IN: Marker returned from ftoc_mark */
{
	static char err_text[] = "**** ftoc_free: bad argument\n";

  if (mark >= marker) {
  	write(2, err_text, sizeof(err_text)-1);
	return(-1);
  }
  while (--marker > mark) {
	if (marker < FTOC_STACKSIZE)	osmmfree(stack[marker]);
  }
  if (marker < FTOC_STACKSIZE)	mindex = (int) (stack[marker]);
  return(0);
}

/*==========================================================================*/
char *ftoc_get(fs, length, option)        
/*+++
.PURPOSE Convert a FORTRAN string to a C string, in a new piece of memory.
.RETURNS C address of string completed with trailing '\0'
.METHOD  Local copy if string not too long; dynaminc memory allocation
		otherwise.
---*/
	char	*fs;	/* IN: Fortran string		*/
	int	length;	/* IN: The length of the string	*/
	int 	option;	/* IN: 1 for suppressing trailing blanks	*/
{
  	char	*p, *osmmget();
	int	len;

		/* Count the number of bytes required to store the string */
  if (option) {
	for (p = fs + length - 1; (p >= fs) && (*p == ' '); p--) ;
	len = 1 + (p - fs);
  }
  else	len = length;

			/* Is it possible to store it locally ? */
  if ((len < 128) && (len < (FTOC_LOCALSIZE - 1 - mindex))) {
	p = &buffer[mindex],
	mindex += len + 1;
	mindex = (mindex+3) & ~3;		/* Make a multiple of 4 */
  }
  else	if (marker++ < FTOC_STACKSIZE)  {
	p = osmmget(len+1);
	stack[marker-1] = p;
	}
  else	p = (char *)0;

  if (p)
	oscopy(p, fs, len),
	p[len] = '\0';

  return(p);
}

/*==========================================================================*/
int ftoc_cpy(dest, source, length)        
/*+++
.PURPOSE Copy a C string to FORTRAN.
.RETURNS The original length of the C string
.METHOD  Fill with blanks.
---*/
	char	*dest;	  /* OUT: FORTRAN string */
	char  	*source;  /* IN:  C string	 */
	int	length;	  /* IN: Length of FORTRAN string */
{
	int	len;

  len = strlen(source);
  if (len > length)	len = length;

  oscopy (dest, source, len);
  oscfill(dest+len, length-len, ' ');

  return(len);
}