/*===========================================================================
  Copyright (C) 1995-2006 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 Massachusetts Ave, Cambridge, 
  MA 02139, USA.
 
  Correspondence 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
===========================================================================*/

#include <string.h>

/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.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 (null-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 repeatedly 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
 060206		last modif

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

#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 long  indx = 0;			/* Index of free space in buffer */

static char *stack[FTOC_STACKSIZE];	/* pointer array */
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 *)indx;
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)	
   indx = (long) (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 - indx))) 
   {
   p = &buffer[indx],
   indx += len + 1;
   indx = (indx+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 = (int) strlen(source);
if (len > length)	len = length;

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

return(len);
}
