/* $Id: val.c,v 1.1.1.1 2008/10/28 13:28:21 kiesling Exp $ -*-c-*-*/

/*
  This file is part of ctalk.
  Copyright © 2005-2008  Robert Kiesling, ctalk@ctalklang.org.
  Permission is granted to copy this software provided that this copyright
  notice is included in all source code modules.

  This library is free software; you can redistribute it and/or
  modify it under the terms of the GNU Lesser 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
  Lesser 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., 51 Franklin St., Fifth Floor, Boston, MA 02110-1301 USA.
*/

/* Functions to check and set VAL's. */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "lex.h"
#include "object.h"
#include "message.h"
#include "ctalk.h"
#include "typeof.h"

extern I_PASS interpreter_pass;   /* Declared in rtinfo.c. */

int m_print_val (MESSAGE *m, VAL *val) {
  switch (val -> type)
      {
      case INTEGER_T:
	sprintf (m -> value, "%d", val -> value.i);
	break;
      case LONG_T:
	sprintf (m -> value, "%ld", val -> value.l);
	break;
      case LONGLONG_T:
	sprintf (m -> value, "%lld", val -> value.ll);
	break;
      case DOUBLE_T:
      case FLOAT_T:
	sprintf (m -> value, "%f", val -> value.d);
	break;
      case LONGDOUBLE_T:
	sprintf (m -> value, "%Lf", val -> value.ld);
	break;
      case PTR_T:
	if (val -> value.ptr) {
	  if (IS_OBJECT (val -> value.ptr)) {
	    OBJECT *o, *o_value;
	    o = (OBJECT *)val -> value.ptr;
	    if ((o_value = __ctalkGetInstanceVariable (o, "value", FALSE))
		== NULL)
	      o_value = o;

	    if (strlen (o_value -> __o_value) >= MAXLABEL) {
	      if ((m -> value = realloc (m -> value, 
					 strlen ((char *)m -> value) + 1)) 
		  == NULL) 
		_error ("m_print_val: allocation error.\n");
	    }
	    sprintf (m -> value, "%s", o_value -> __o_value);
	    
	  } else {
	    if (strlen ((char *)val -> value.ptr) >= MAXLABEL) {
	      if ((m -> value = realloc (m -> value, 
					 strlen ((char *)m -> value) + 1)) 
		  == NULL) 
		_error ("m_print_val: allocation error.\n");
	    }
	    sprintf (m -> value, "%#x", (unsigned int)val -> value.ptr);
	  }
	}
	break;
      default:
	_warning ("Unknown type %d in m_print_val.\n", val -> type);
	break;
      }
  return val -> type;
}
    
int d_print_val (DEFINITION *d, VAL *val) {
  switch (val -> type)
      {
      case INTEGER_T:
	sprintf (d -> value, "%d", val -> value.i);
	break;
      case LONG_T:
	sprintf (d -> value, "%ld", val -> value.l);
	break;
      case LONGLONG_T:
	sprintf (d -> value, "%lld", val -> value.ll);
	break;
      case DOUBLE_T:
	sprintf (d -> value, "%f", val -> value.d);
	break;
      case LONGDOUBLE_T:
	sprintf (d -> value, "%Lf", val -> value.ld);
	break;
      case PTR_T:
 	sprintf (d -> value, "%#x", (unsigned int)val -> value.ptr);
	break;
      default:
	_warning ("Unknown type %d in d_print_val.\n", val -> type);
	break;
      }
  return val -> type;
}
    
int copy_val (VAL *s, VAL *d) {
  d -> type = s -> type;
  switch (s -> type)
    {
    case INTEGER_T:
      d -> value.i = s -> value.i;
      break;
    case LONG_T:
      d -> value.l = s -> value.l;
      break;
    case LONGLONG_T:
      d -> value.ll = s -> value.ll;
      break;
    case DOUBLE_T:
      d -> value.d = s -> value.d;
      break;
    case LONGDOUBLE_T:
      d -> value.ld = s -> value.ld;
      break;
    case PTR_T:
      d -> value.ptr = s -> value.ptr;
      break;
    default:
      _warning ("Unknown type %d in copy_val.\n", s -> type);
      break;
    }
  return SUCCESS;
}

int is_val_true (VAL *val) {
  switch (val -> type)
    {
    case PTR_T:
      return (val -> value.ptr != NULL) ? TRUE : FALSE;
      break;
    case INTEGER_T:
      return (val -> value.i != 0) ? TRUE : FALSE;
      break;
    case BOOLEAN_T:
      return (val -> value.b != 0) ? TRUE : FALSE;
      break;
    case DOUBLE_T:
    case FLOAT_T:
      return (val -> value.d != 0.0) ? TRUE : FALSE;
      break;
    case LONG_T:
      return (val -> value.l != 0l) ? TRUE : FALSE;
      break;
    case LONGLONG_T:
      return (val -> value.ll != 0ll) ? TRUE : FALSE;
      break;
    case LONGDOUBLE_T:
      return (val -> value.ld != 0.0l) ? TRUE : FALSE;
      break;
    case 0:           /* Unitialized value. */
      return FALSE;
      break;
    }
  _warning ("Unknown type %d in is_val_true.\n", val -> type);
  return FALSE;
}

/*
 *  NOTE - Numeric_value is used only during expression parsing
 *  by the preprocessor, at this time, so an empty valbuf indicates 
 *  an undefined symbol, which we can evaluate silently to 
 *  FALSE unless we specify otherwise.
 */
int numeric_value (char *valbuf, VAL *val) {

  int r;

  if (interpreter_pass == preprocessing_pass) {
    if (!strlen (valbuf)) {
      val -> type = INTEGER_T;
      val -> value.i = 0;
#ifdef DEBUG_UNDEFINED_PREPROCESSOR_SYMBOLS
      debug ("Undefined preprocessor symbol, \"%s.\"", m -> name);
#endif
      return val -> type;
    }
  }

  switch (_lextype (valbuf))
  {
  case INTEGER_T:
    val -> type = INTEGER_T;
    switch (radix_of (valbuf))
      {
      case decimal:
	r = sscanf (valbuf, "%d", &(val-> value.i));
	break;
      case octal:
	r = sscanf (valbuf, "%o", &val-> value.i);
	break;
      case hexadecimal:
	r = sscanf (valbuf, "%x", &val-> value.i);
	if ((int *)val -> value.i == (int *)val -> value.ptr)
	  val -> type = PTR_T;
	break;
      case binary:
	break;
      }
    break;
  case LONG_T:
    val -> type = LONG_T;
    switch (radix_of (valbuf))
      {
      case decimal:
	r = sscanf (valbuf, "%ld", &val-> value.l);
	break;
      case octal:
	r = sscanf (valbuf, "%lo", &val-> value.l);
	break;
      case hexadecimal:
	r = sscanf (valbuf, "%lx", &val-> value.l);
	if ((long int *)val -> value.l == (long int *)val -> value.ptr)
	  val -> type = PTR_T;
	break;
      case binary:
	break;
      }
    break;
  case LONGLONG_T:
    val -> type = LONGLONG_T;
    switch (radix_of (valbuf))
      {
      case decimal:
	r = sscanf (valbuf, "%lld", &val-> value.ll);
	break;
      case octal:
	r = sscanf (valbuf, "%llo", &val-> value.ll);
	break;
      case hexadecimal:
	r = sscanf (valbuf, "%llx", &val-> value.ll);
	if ((long long int *)val -> value.l == (long long int *)val -> value.ptr)
	  val -> type = PTR_T;
	val -> type = PTR_T;
	break;
      case binary:
	break;
      }
    break;
  case FLOAT_T:
  case DOUBLE_T:
    sscanf (valbuf, "%lf", &val-> value.d);
    val -> type = DOUBLE_T;
    break;
  case LONGDOUBLE_T:
    sscanf (valbuf, "%Lf", &val-> value.ld);
    val -> type = LONGDOUBLE_T;
    break;
  case BOOLEAN_T:
    sscanf (valbuf, "%d", (int *) &val-> value.b);
    val -> type = BOOLEAN_T;
    break;
  case PTR_T:
    val -> value.ptr = valbuf;
    val -> type = PTR_T;
    break;
  case LITERAL_T:
    val -> value.ptr = valbuf;
    val -> type = LITERAL_T;
    break;
  default:
    val -> type = INTEGER_T;
    val -> value.b = FALSE;
#ifdef DEBUG_CODE
    _warning ("Undefined type of %s in numeric_value.\n", valbuf);
#endif
    break;
  }

  return val -> type;
}

int val_eq (VAL *val1, VAL *val2) {

  int bool_result = FALSE;

  if (val1 -> type == val2 -> type) {
    switch (val1 -> type) 
      {
      case INTEGER_T:
	if (val1 -> value.i == val2 -> value.i)
	  bool_result = TRUE;
	break;
      case LONG_T:
	if (val1 -> value.l == val2 -> value.l)
	  bool_result = TRUE;
	break;
      case LONGLONG_T:
	if (val1 -> value.ll == val2 -> value.ll)
	  bool_result = TRUE;
	break;
      case DOUBLE_T:
	if (val1 -> value.d == val2 -> value.d)
	  bool_result = TRUE;
	break;
      case LONGDOUBLE_T:
	if (val1 -> value.ld == val2 -> value.ld)
	  bool_result = TRUE;
	break;
      case PTR_T:
	if (val1 -> value.ptr == val2 -> value.ptr)
	  bool_result = TRUE;
	break;
    }
  }

  return bool_result;
}

char *hex_from_numeric_val (char *s) {

  static char buf[MAXMSG];
  char tmpbuf[MAXLABEL];
#ifdef __DJGPP__
  char *endp;            /* For strtoll. */
#endif

  switch (_lextype (s))
    {
    case INTEGER_T:
      sprintf (buf, "0x%x", atoi(s));
      break;
    case LONG_T:
      sprintf (buf, "0x%lx", atol(s));
      break;
    case LONGLONG_T:
#ifdef __DJGPP__
      sprintf (buf, "0x%llx", strtoll(s, &endp, 0));
#else
# if defined(__GNUC__) && defined(__sparc__) && defined(__svr4__)
      /*
       *  SPARC uses atol right now.
       */
      sprintf (buf, "0x%lx", atol(s));
# else
      sprintf (buf, "0x%llx", atoll(s));
# endif
#endif
      break;
    case LITERAL_CHAR_T:
      strcpy (tmpbuf, s);
      TRIM_CHAR (tmpbuf);
      sprintf (buf, "0x%x", (int) *tmpbuf);
      break;
    case DOUBLE_T:
    default:
      __ctalkExceptionInternal (NULL, ptr_conversion_x, "");
      break;
    }
  return buf;
}
