/*
    Clif - A C-like Interpreter Framework
    Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997 T. Hruz, L. Koren
    1998 L. Koren

    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 Mass Ave, Cambridge, MA 02139, USA.

*/

/*
 * myintrinsic.c
 *
 * In this file are functions which user consider to
 * have as intrinsic function in Clif.
 * There are part of the "library".
 */

#include <stdio.h>
#include "config.h"
#if STDC_HEADERS
#include <ctype.h>
#else
#ifndef HAVE_ISSPACE
#define HT '\t'
#define NL '\n'
#define VT '\v'
#define NP '\f'
#define CR '\r'
#define SP ' '
#define isspace(c)							\
(c == HT || c == NL || c == VT || c == NP || c == CR || c == SP)
#endif
#endif
#include "type.h"
#include "struct.h"
#include "define.h"

#ifndef PROTO
#if defined (USE_PROTOTYPES) ? USE_PROTOTYPES : defined(__STDC__)
#define PROTO(ARGS) ARGS
#else
#define PROTO(ARGS) ()
#endif 
#endif

#ifndef BUFSIZ
#define BUFSIZ 1024
#endif

double sin_ PROTO((char **));
double exp_ PROTO((char **));
int cprintf PROTO((char **));
int cscanf PROTO((char **));
int copen PROTO((char **));
int cclose PROTO((char **));
int cputc PROTO((char **));
int cgetc PROTO((char **));

/* Channel functions. */
void chclose PROTO((char **));
void chwrite PROTO((char **));
int chopen PROTO((char **));
void chflush PROTO((void));

static int do_fprintf PROTO((FILE *, char **));
static int do_fscanf PROTO((FILE *, char **));


int transform_to_simple_type PROTO((enum global_type));

FILE *str[100]={stdin,stdout,stderr}; /* Handles of standard devices.
				       * 0 - stdin
				       * 1 - stdout
				       * 2 - stderr
				       */
int handle_pointer=2;



                       /*
			* Intrinsic functions.
			*/

/* \verbatim{myintrinsic_c_sin_.tex} */

double sin_(a)char **a;{return(sin(*(double *) a[0]));}

/* \verbatim */

double exp_(x)char **x;{return(exp(*(double *)x[0]));}

static int
do_fprintf (stream, a)
  FILE *stream;
  char **a;
{
  char *form;
  char c, buf[BUFSIZ];

  extern int call_by_value, call_by_reference;
  
  int n = 2, result = 0, part_res;
  if (call_by_value)
    form = *(char **)a[0];
  else if (call_by_reference)
    form = (char *)a[0];

  while ((c = *form++))
    {
      if ('%' != c)
	{
	  part_res = fputc (c, stream);
	  if (EOF == part_res)
	    {
	      result = part_res;
	      break;
	    }
	  else
	    part_res = 1;
	}
      else
	{
	  int i;
	  buf[0] = c;
	  for (i = 1; *form; form++, i++)
	    {
	      buf[i] = c = *form;
	      if ('c' == c)
		{
		  buf[i + 1] = '\0';
		  part_res = fprintfx (stream, buf, *(char *)a[n]);
		  form++;
		  n += 2;
		  break;
		}
	      else if ('d' == c || 'i' == c || 'o' == c || 'u' == c ||
		       'x' == c || 'X' == c)
		{
		  int res;
		  buf[i + 1] = '\0';
		  res = transform_to_simple_type (*(int *)a[n + 1]);
		  if (res == (SIGNED_AC | CHR))
		    part_res = fprintfx (stream, buf,
					 *(signed char *)a[n]);
		  else if (res == (UNSIGNED_AC | CHR))
		    part_res = fprintfx (stream, buf,
					 *(unsigned char *)a[n]);
		  else if (res == CHR)
		    part_res = fprintfx (stream, buf, *(char *)a[n]);
		  else if (res == (UNSIGNED_AC | INTEGER))
		    part_res = fprintfx (stream, buf,
					 *(unsigned int *)a[n]);
		  else if (res == (LONG_AC | INTEGER))
		    part_res = fprintfx (stream, buf,
					 *(long int *)a[n]);
		  else if (res == (LONG_AC | UNSIGNED_AC | INTEGER))
		    part_res = fprintfx (stream, buf,
					 *(long unsigned int *)a[n]);
		  else if (res == (SHORT_AC | INTEGER))
		    part_res = fprintfx (stream, buf,
					 *(short int *)a[n]);
		  else if (res == (SHORT_AC | UNSIGNED_AC | INTEGER))
		    part_res = fprintfx (stream, buf,
					 *(short unsigned int *)a[n]);
		  else
		    part_res = fprintfx (stream, buf, *(int *)a[n]);
		  form++;
		  n += 2;
		  break;
		}
	      else if ('f' == c)
		{
		  int res;
		  buf[i + 1] = '\0';
		  if (call_by_value)
		    res = transform_to_simple_type (*(int *)a[n + 2]);
		  else if (call_by_reference)
		    res = transform_to_simple_type (*(int *)a[n + 1]);
		  if (res == FLT)
		    part_res = fprintfx (stream, buf, *(float *)a[n]);
		  else if (res == DOUB)
		    part_res = fprintfx (stream, buf,
					 *(double *)a[n]);
		  else 
		    part_res = fprintfx (stream, buf,
					 *(long double *)a[n]);
		  form++;
		  if (call_by_value)
		    n += 1;
		  n += 2;
		  break;
		}
	      else if ('g' == c || 'G' == c || 'e' == c || 'E' == c)
		{
		  int res;
		  buf[i + 1] = '\0';
		  if (call_by_value)
		    res = transform_to_simple_type (*(int *)a[n + 2]);
		  else if (call_by_reference)
		    res = transform_to_simple_type (*(int *)a[n + 1]);
		  if (res == FLT)
		    part_res = fprintfx (stream, buf, *(float *)a[n]);
		  else if (res == DOUB)
		    part_res = fprintfx (stream, buf,
					 *(double *)a[n]);
		  else
		    part_res = fprintfx (stream, buf,
					 *(long double *)a[n]);
		  form++;
		  if (call_by_value)
		    n += 1;
		  n += 2;
		  break;
		}
	      else if ('s' == c)
		{
		  buf[i + 1] = '\0';
		  if (call_by_value)
		    part_res = fprintfx (stream, buf, *(char **)a[n]);
		  else
		    part_res = fprintfx (stream, buf, a[n]);
		  form++;
		  n += 2;
		  break;
		}
	      else if ('p' == c)
		{
		  buf[i + 1] = '\0';
		  part_res = fprintfx (stream, buf, *(int *)a[n]);
		  form++;
		  n += 2;
		  break;
		}
	      else if ('n' == c)
		{
		  buf[i + 1] = '\0';
		  part_res = fprintfx (stream, buf, *(int *)a[n]);
		  form++;
		  n += 2;
		  break;
		}
	    }
	}
      if (EOF == part_res)
	{
	  result = part_res;
	  break;
	}
      else
	result += part_res;
    }

  return result;
}



/*
 * Writes to a file.
 */
int 
cfprintf (a)
  char **a;
{
  return do_fprintf (str[*(int *)a[0]], &a[2]);
}


int 
cprintf (a)
  char **a;
{
  return do_fprintf (str[1], a);
}


static int
do_fscanf (stream, a)
  FILE *stream;
  char **a;
{
  char *form;
  char buf[BUFSIZ];
  int c;
  int n = 1, result = 0, part_res;
  
  extern int call_by_value, call_by_reference;

  if (call_by_value)
    form = *(char **)a[0];
  else if (call_by_reference)
    form = (char *)a[0];

  /* Parse format string. */
  while ((c = *form++))
    {
      if ('%' != c)
	{
	  part_res = getc (stream);
	  if (EOF == part_res)
	    {
	      result = part_res;
	      break;
	    }
	  else if (isspace (c) && isspace (part_res))
	      part_res = 0;
	  else if (c != part_res)
	    {
	      result = part_res = EOF;
	      break;
	    }
	  else
	    part_res = 0;
	}
      else
	{
	  int i;
	  buf[0] = c;
	  for (i = 1; *form; form++, i++)
	    {
	      buf[i] = c = *form;
	      if ('c' == c)
		{
		  buf[i + 1] = '\0';
		  if (call_by_value)
		    part_res = fscanf (stream, buf, *(char *)a[n]);
		  else if (call_by_reference)
		    part_res = fscanf (stream, buf, a[n]);
		  form++;
		  n++;
		  break;
		}
	      else if ('d' == c || 'i' == c || 'o' == c || 'u' == c ||
		       'x' == c || 'X' == c)
		{
		  buf[i + 1] = '\0';
		  if (call_by_value)
		    part_res = fscanf (stream, buf, *(int *)a[n]);
		  else if (call_by_reference)
		    part_res = fscanf (stream, buf, a[n]);
		  form++;
		  n++;
		  break;
		}
	      else if ('f' == c || 'g' == c || 'G' == c || 'e' == c ||
		       'E' == c)
		{
		  buf[i + 1] = '\0';
		  if (call_by_value)
		    {
		      if (buf[i - 1] == 'l')
			part_res =  fscanf (stream, buf,
					    *(double *)a[n]);
		      else if (buf[i - 1] == 'L')
			part_res = fscanf (stream, buf,
					   *(long double *)a[n]);
		      else
			part_res = fscanf (stream, buf,
					   *(float *)a[n]);
		    }
		  else if (call_by_reference)
		    part_res = fscanf (stream, buf, a[n]);
		  form++;
		  n++;
		  break;
		}
	      else if ('s' == c)
		{
		  buf[i + 1] = '\0';
		  if (call_by_value)
		    part_res = fscanf (stream, buf, *(char *)a[n]);
		  else if (call_by_reference)
		    part_res = fscanf (stream, buf, a[n]);
		  form++;
		  n++;
		  break;
		}
	      else if ('p' == c)
		{
		  buf[i + 1] = '\0';
		  if (call_by_value)
		    part_res = fscanf (stream, buf, *(char *)a[n]);
		  else if (call_by_reference)
		    part_res = fscanf (stream, buf, a[n]);
		  form++;
		  n++;
		  break;
		}
	      else if ('n' == c)
		{
		  buf[i + 1] = '\0';
		  if (call_by_value)
		    part_res = fscanf (stream, buf, *(char *)a[n]);
		  else if (call_by_reference)
		    part_res = fscanf (stream, buf, a[n]);
		  form++;
		  n++;
		  break;
		}
	    }
	}
      if (EOF == part_res)
	{
	  result = part_res;
	  break;
	}
      else
	result += part_res;
    }

  return result;
}


/*
 * Reads from a file.
 */
int
cfscanf (a)
  char **a;
{
  return do_fscanf (str[*(int *)a[0]], &a[1]);
}


int 
cscanf (a)
  char **a;
{
  return do_fscanf (str[0], a);
}


/*
 * Opens a stream.
 */
int 
copen (a)
  char **a;
{
  char *fn, *type;
  
  fn = (char *)a[0];
  type = (char *)a[1];

  if ((str[++handle_pointer]=fopen(fn,type)) == NULL)
    return(EOF);
  else
    return(handle_pointer);
}

/*
 * Closes a stream.
 */
int
cclose (a)
  char **a;
{
  int *handle;

  handle = (int *)a[0];

  handle_pointer--;
  return (fclose (str[*handle]));
}

/*
 * Puts a character into a stream.
 */
int
cputc (a)
  char **a;
{
  char *c;
  int *handle;

  c = (char *)a[0];
  handle = (int *)a[1];

  return (fputc (*c, str[*handle]));}

/*
 * Gets a character from a stream.
 */
int
cgetc (a)
  char **a;
{
  int *handle;
  
  handle = (int *)a[0];

  return (fgetc (str[*handle]));
}


int
cfflush (a)
  char **a;
{
  return fflush (str[*(int *)a[0]]);
}


                      /*
		       * Supporting functions.
		       */

/* 
 * Transformation from a global type to simple or array.
 */
int
transform_to_simple_type (type)
  enum global_type type;
{
  switch(type)
    {
    case INTEGERAR : 
      return INTEGER;
    case FLTAR : 
      return FLT;
    case DOUBAR : 
      return DOUB;
    case CHRAR : 
      return CHRAR;
    case INTEGERS : 
      return INTEGER;
    case UINTEGERS:
      return UNSIGNED_AC | INTEGER;
    case LINTEGERS:
      return LONG_AC | INTEGER;
    case LUINTEGERS:
      return LONG_AC | UNSIGNED_AC | INTEGER;
    case SINTEGERS:
      return SHORT_AC | INTEGER;
    case SUINTEGERS:
      return SHORT_AC | UNSIGNED_AC | INTEGER;
    case FLTS : 
      return FLT;
    case DOUBS : 
      return DOUB;
    case LDOUBS:
      return (LONG_AC | DOUB);
    case CHRS : 
    case SCHRS:
    case UCHRS:
      return CHR;
    default:
      abort ();
      break;
    }
  return(EOF);
}
