/* $Id: math.c,v 1.1.1.1 2008/10/28 13:28:20 kiesling Exp $ */

/*
  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 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., 51 Franklin St., Fifth Floor, Boston, MA 02110-1301 USA.
*/

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

extern EXCEPTION parse_exception;   /* Declared in pexcept.c.     */

/*
 *  Evaluate operators that return true or false: ==, <, >, <=, 
 *  and >=.
 */

Boolean eval_bool (MESSAGE_STACK messages, int op_ptr, VAL *result) {

  MESSAGE *m_op;
  MESSAGE *m_op1 = NULL, 
    *m_op2 = NULL;
  VAL op1_val, op2_val;
  Boolean ret_value = False;
  int op_res, op1_ptr, op2_ptr;
  int i;
  OP_CONTEXT context;

  m_op  = messages[op_ptr];

  if ((op_res = operands (messages, op_ptr, &op1_ptr, &op2_ptr))
      == ERROR) {
    warning (m_op, "Invalid operand to %s.", m_op -> name);
    parse_exception = parse_error_x;
    result -> type = INTEGER_T;
    result -> value.i = FALSE;
    return FALSE;
  }
  
  context = op_context (messages, op_ptr);

  switch (context)
    {
    case op_not_an_op:
    case op_cast_context:
    case op_null_context:
      warning (m_op, "Invalid operand to %s.", m_op -> name);
      parse_exception = parse_error_x;
      result -> type = INTEGER_T;
      result -> value.i = FALSE;
      return FALSE;
      break;
    case op_unary_context:
      m_op2 = messages[op2_ptr];
      numeric_value (m_op2 -> value, &op2_val);
      break;
    case op_binary_context:
      m_op1 = messages[op1_ptr];
      m_op2 = messages[op2_ptr];
      numeric_value (m_op1 -> value, &op1_val);
      numeric_value (m_op2 -> value, &op2_val);
      break;
    }

  if (context == op_binary_context) {
    if (match_type (&op1_val, &op2_val) == ERROR)
      warning (m_op1, "Type mismatch: %s, %s.", m_op1 -> name, m_op2 -> name);

    if (!IS_C_TYPE (op1_val.type))
      warning (m_op1, "Undefined C type %d in bool_arithmetic.", op1_val.type);
    if (!IS_C_TYPE (op2_val.type))
      warning (m_op2, "Undefined C type %d in bool_arithmetic.", op2_val.type);
  } else {
    if (context == op_unary_context) {
      if (!IS_C_TYPE (op2_val.type))
	warning (m_op2, "Undefined C type %d in bool_arithmetic.", 
		 op2_val.type);
    } else {
      warning (m_op, "Bad context for operator %s.", m_op -> name);
    }
  }
     
   switch (m_op -> tokentype) 
     {
     case EQ:
       switch (op1_val.type)
	 {
	 case PTR_T:
	   ret_value = (op1_val.value.ptr == op2_val.value.ptr) ? True : False;
	   break;
	 case INTEGER_T:
	   ret_value = (op1_val.value.i == op2_val.value.i) ? True : False;
	   break;
	 case FLOAT_T:
	 case DOUBLE_T:
	   ret_value = (op1_val.value.d == op2_val.value.d) ? True : False;
	   break;
	 case LONGDOUBLE_T:
	   ret_value = (op1_val.value.ld == op2_val.value.ld) ? True : False;
	   break;
	 case LONG_T:
	   ret_value = (op1_val.value.l == op2_val.value.l) ? True : False;
	   break;
	 case LONGLONG_T:
	   ret_value = (op1_val.value.ll == op2_val.value.ll) ? True : False;
	   break;
	 }
       break;
     case GE:
       switch (op1_val.type)
	 {
	 case PTR_T:
	   ret_value = (op1_val.value.ptr >= op2_val.value.ptr) ? True : False;
	   break;
	 case INTEGER_T:
	   ret_value = (op1_val.value.i >= op2_val.value.i) ? True : False;
	   break;
	 case FLOAT_T:
	 case DOUBLE_T:
	   ret_value = (op1_val.value.d >= op2_val.value.d) ? True : False;
	   break;
	 case LONGDOUBLE_T:
	   ret_value = (op1_val.value.ld >= op2_val.value.ld) ? True : False;
	   break;
	 case LONG_T:
	   ret_value = (op1_val.value.l >= op2_val.value.l) ? True : False;
	   break;
	 case LONGLONG_T:
	   ret_value = (op1_val.value.ll >= op2_val.value.ll) ? True : False;
	   break;
	 }
       break;
     case LE:
       switch (op1_val.type)
	 {
	 case PTR_T:
	   ret_value = (op1_val.value.ptr <= op2_val.value.ptr) ? True : False;
	   break;
	 case INTEGER_T:
	   ret_value = (op1_val.value.i <= op2_val.value.i) ? True : False;
	   break;
	 case FLOAT_T:
	 case DOUBLE_T:
	   ret_value = (op1_val.value.d <= op2_val.value.d) ? True : False;
	   break;
	 case LONGDOUBLE_T:
	   ret_value = (op1_val.value.ld <= op2_val.value.ld) ? True : False;
	   break;
	 case LONG_T:
	   ret_value = (op1_val.value.l <= op2_val.value.l) ? True : False;
	   break;
	 case LONGLONG_T:
	   ret_value = (op1_val.value.ll <= op2_val.value.ll) ? True : False;
	   break;
	 }
       break;
     case GT:
       switch (op1_val.type)
	 {
	 case PTR_T:
	   ret_value = (op1_val.value.ptr > op2_val.value.ptr) ? True : False;
	   break;
	 case INTEGER_T:
	   ret_value = (op1_val.value.i > op2_val.value.i) ? True : False;
	   break;
	 case FLOAT_T:
	 case DOUBLE_T:
	   ret_value = (op1_val.value.d > op2_val.value.d) ? True : False;
	   break;
	 case LONGDOUBLE_T:
	   ret_value = (op1_val.value.ld > op2_val.value.ld) ? True : False;
	   break;
	 case LONG_T:
	   ret_value = (op1_val.value.l > op2_val.value.l) ? True : False;
	   break;
	 case LONGLONG_T:
	   ret_value = (op1_val.value.ll > op2_val.value.ll) ? True : False;
	   break;
	 }
       break;
     case LT:
       switch (op1_val.type)
	 {
	 case PTR_T:
	   ret_value = (op1_val.value.ptr < op2_val.value.ptr) ? True : False;
	   break;
	 case INTEGER_T:
	   ret_value = (op1_val.value.i < op2_val.value.i) ? True : False;
	   break;
	 case FLOAT_T:
	 case DOUBLE_T:
	   ret_value = (op1_val.value.d < op2_val.value.d) ? True : False;
	   break;
	 case LONGDOUBLE_T:
	   ret_value = (op1_val.value.ld < op2_val.value.ld) ? True : False;
	   break;
	 case LONG_T:
	   ret_value = (op1_val.value.l < op2_val.value.l) ? True : False;
	   break;
	 case LONGLONG_T:
	   ret_value = (op1_val.value.ll < op2_val.value.ll) ? True : False;
	   break;
	 }
       break;
     case BOOLEAN_EQ:
       switch (op1_val.type)
	 {
	 case PTR_T:
	   ret_value = (op1_val.value.ptr == op2_val.value.ptr) ? True : False;
	   break;
	 case INTEGER_T:
	   ret_value = (op1_val.value.i == op2_val.value.i) ? True : False;
	   break;
	 case FLOAT_T:
	 case DOUBLE_T:
	   ret_value = (op1_val.value.d == op2_val.value.d) ? True : False;
	   break;
	 case LONGDOUBLE_T:
	   ret_value = (op1_val.value.ld == op2_val.value.ld) ? True : False;
	   break;
	 case LONG_T:
	   ret_value = (op1_val.value.l == op2_val.value.l) ? True : False;
	   break;
	 case LONGLONG_T:
	   ret_value = (op1_val.value.ll < op2_val.value.ll) ? True : False;
	   break;
	 }
       break;
     case INEQUALITY:
       switch (op1_val.type)
	 {
	 case PTR_T:
	   ret_value = (op1_val.value.ptr != op2_val.value.ptr) ? True : False;
	   break;
	 case INTEGER_T:
	   ret_value = (op1_val.value.i != op2_val.value.i) ? True : False;
	   break;
	 case FLOAT_T:
	 case DOUBLE_T:
	   ret_value = (op1_val.value.d != op2_val.value.d) ? True : False;
	   break;
	 case LONGDOUBLE_T:
	   ret_value = (op1_val.value.ld != op2_val.value.ld) ? True : False;
	   break;
	 case LONG_T:
	   ret_value = (op1_val.value.l != op2_val.value.l) ? True : False;
	   break;
	 case LONGLONG_T:
	   ret_value = (op1_val.value.ll != op2_val.value.ll) ? True : False;
	   break;
	 }
       break;
     case BOOLEAN_AND:
       switch (op1_val.type)
	 {
	 case PTR_T:
	   ret_value = (op1_val.value.ptr && op2_val.value.ptr) ? True : False;
	   break;
	 case INTEGER_T:
	   ret_value = (op1_val.value.i && op2_val.value.i) ? True : False;
	   break;
	 case FLOAT_T:
	 case DOUBLE_T:
	   ret_value = (op1_val.value.d && op2_val.value.d) ? True : False;
	   break;
	 case LONGDOUBLE_T:
	   ret_value = (op1_val.value.ld && op2_val.value.ld) ? True : False;
	   break;
	 case LONG_T:
	   ret_value = (op1_val.value.l && op2_val.value.l) ? True : False;
	   break;
	 case LONGLONG_T:
	   ret_value = (op1_val.value.ll && op2_val.value.ll) ? True : False;
	   break;
	 }
       break;
     case BOOLEAN_OR:
       switch (op1_val.type)
	 {
	 case PTR_T:
	   ret_value = (op1_val.value.ptr || op2_val.value.ptr) ? True : False;
	   break;
	 case INTEGER_T:
	   ret_value = (op1_val.value.i || op2_val.value.i) ? True : False;
	   break;
	 case FLOAT_T:
	 case DOUBLE_T:
	   ret_value = (op1_val.value.d || op2_val.value.d) ? True : False;
	   break;
	 case LONGDOUBLE_T:
	   ret_value = (op1_val.value.ld || op2_val.value.ld) ? True : False;
	   break;
	 case LONG_T:
	   ret_value = (op1_val.value.l || op2_val.value.l) ? True : False;
	   break;
	 case LONGLONG_T:
	   ret_value = (op1_val.value.ll || op2_val.value.ll) ? True : False;
	   break;
	 }
       break;
     case LOG_NEG:
       switch (op2_val.type)
	 {
	 case PTR_T:
	   ret_value = (op2_val.value.ptr) ? False : True;
	   break;
	 case INTEGER_T:
	   ret_value = (op2_val.value.i) ? False : True;
	   break;
	 case FLOAT_T:
	 case DOUBLE_T:
	   ret_value = (op2_val.value.d) ? False : True;
	   break;
	 case LONGDOUBLE_T:
	   ret_value = (op2_val.value.ld) ? False : True;
	   break;
	 case LONG_T:
	   ret_value = (op2_val.value.l) ? False : True;
	   break;
	 case LONGLONG_T:
	   ret_value = (op2_val.value.ll) ? False : True;
	   break;
	 }
       break;
     default:
       break;
     }
   
   result -> type = INTEGER_T;
   result -> value.i = (ret_value == True) ? TRUE : FALSE;
   
   if (context == op_unary_context) {
     if ((m_op2 -> tokentype == RESULT) ||
	 (m_op2 -> tokentype == PREPROCESS_EVALED))
       set_subexpr_val (messages, op2_ptr, result);
     for (i = op_ptr; i >= op2_ptr; i--) {
       ++messages[i] -> evaled;
       m_print_val (messages[i], result);
       messages[i] -> tokentype = RESULT;
     }
   } else {
     if ((m_op1 -> tokentype == RESULT) ||
	 (m_op1 -> tokentype == PREPROCESS_EVALED))
       set_subexpr_val (messages, op1_ptr, result);
     if ((m_op2 -> tokentype == RESULT) ||
	 (m_op2 -> tokentype == PREPROCESS_EVALED))
       set_subexpr_val (messages, op2_ptr, result);
     for (i = op1_ptr; i >= op2_ptr; i--) {
       ++messages[i] -> evaled;
       m_print_val (messages[i], result);
       messages[i] -> tokentype = RESULT;
     }
   }

   return ret_value;
}

/*
 *  Evaluate operators that calculate numeric values: +, -, *, /,
 *  >>, <<...
 */

int eval_math (MESSAGE_STACK messages, int op_ptr, VAL *result) {

  MESSAGE *m_op;
  MESSAGE *m_op1 = NULL, 
    *m_op2 = NULL;
  int op1_ptr, op2_ptr;
  int op_res;
  int i;
  VAL op1_val, op2_val;
  OP_CONTEXT context;

  m_op = messages[op_ptr];

  if ((op_res = operands (messages, op_ptr, &op1_ptr, &op2_ptr))
      == ERROR) {
    warning (m_op, "Invalid operand to %s.", m_op -> name);
    parse_exception = parse_error_x;
    result -> type = INTEGER_T;
    result -> value.i = FALSE;
    return FALSE;
  }
  
  context = op_context (messages, op_ptr);

  /* 
   * In each case, evaluate the operands in case they were not 
   * evaluated previously.  Subexpressions (in parentheses) 
   * should already have been evaluated.
   */

  switch (context)
    {
    case op_not_an_op:
    case op_null_context:
      warning (m_op, "Invalid operand to %s.", m_op -> name);
      parse_exception = parse_error_x;
      result -> type = INTEGER_T;
      result -> value.i = FALSE;
      return FALSE;
      break;
    case op_cast_context:
      return FALSE;
    case op_unary_context:
      m_op2 = messages[op2_ptr];
      numeric_value (m_op2 -> value, &op2_val);
      break;
    case op_binary_context:
      m_op1 = messages[op1_ptr];
/*       if ((m_op1 -> tokentype != RESULT) && */
/* 	  (m_op1 -> tokentype != PREPROCESS_EVALED)) { */
/* 	resolve_symbol (m_op1 -> name, &op1_val); */
/* 	m_print_val (m_op1, &op1_val); */
/*       } else { */
	numeric_value (m_op1 -> value, &op1_val);
/*       } */
      m_op2 = messages[op2_ptr];
/*       if ((m_op2 -> tokentype != RESULT) && */
/* 	  (m_op2 -> tokentype != PREPROCESS_EVALED)) { */
/* 	resolve_symbol (m_op2 -> name, &op2_val); */
/* 	m_print_val (m_op2, &op2_val); */
/*       } else { */
	numeric_value (m_op2 -> value, &op2_val);
/*       } */
      break;
    }

  switch (m_op -> tokentype)
    {
      /* Promote to double if either operand is a double,
	 otherwise, promote to largest type. */
    case PLUS:
      perform_add (m_op, &op1_val, &op2_val, result);
      break;
    case MINUS:
      perform_subtract (m_op, &op1_val, &op2_val, result);
      break;
    case MULT:
      perform_multiply (m_op, &op1_val, &op2_val, result);
      break;
    case DIVIDE:
      perform_divide (m_op, &op1_val, &op2_val, result);
      break;
      /* Error if op2 is not an integer type. */
    case ASL:
      perform_asl (m_op, &op1_val, &op2_val, result);
      break;
    case ASR:
      perform_asr (m_op, &op1_val, &op2_val, result);
      break;
    case BIT_AND:
      perform_bit_and (m_op, &op1_val, &op2_val, result);
      break;
    case BIT_OR:
      perform_bit_or (m_op, &op1_val, &op2_val, result);
      break;
    case BIT_XOR:
      perform_bit_xor (m_op, &op1_val, &op2_val, result);
      break;
      /* Unary op. */
    case BIT_COMP:
      perform_bit_comp (m_op, &op2_val, result);
      break;
    case MODULUS:
      perform_modulus (m_op, &op1_val, &op2_val, result);
    default:
      break;
    }

   if (context == op_unary_context) {
     if ((m_op2 -> tokentype == RESULT) ||
	 (m_op2 -> tokentype == PREPROCESS_EVALED))
       set_subexpr_val (messages, op2_ptr, result);
     for (i = op_ptr; i >= op2_ptr; i--) {
       ++messages[i] -> evaled;
       m_print_val (messages[i], result);
       messages[i] -> tokentype = RESULT;
     }
   } else {
     if ((m_op1 -> tokentype == RESULT) ||
	 (m_op1 -> tokentype == PREPROCESS_EVALED))
       set_subexpr_val (messages, op1_ptr, result);
     if ((m_op2 -> tokentype == RESULT) ||
	 (m_op2 -> tokentype == PREPROCESS_EVALED))
       set_subexpr_val (messages, op2_ptr, result);
     for (i = op1_ptr; i >= op2_ptr; i--) {
       ++messages[i] -> evaled;
       m_print_val (messages[i], result);
       messages[i] -> tokentype = RESULT;
     }
   }

   return result -> type;
}

int perform_add (MESSAGE *m_op, VAL *op1, VAL *op2, VAL *result) {

  switch (op1 -> type) 
    {
    case INTEGER_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.i = op1 -> value.i + op2 -> value.i;
	  result -> type = INTEGER_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.i + op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.i + op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.i + op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.i + op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  result -> value.ptr = op1 -> value.i + op2 -> value.ptr;
	  result -> type = PTR_T;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_add.");
#endif
	  break;
	}
      break;
    case LONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.l = op1 -> value.l + op2 -> value.i;
	  result -> type = LONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.l + op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.l + op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.l + op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.l + op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  result -> value.ptr = op1 -> value.l + op2 -> value.ptr;
	  result -> type = PTR_T;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_add.");
#endif
	  break;
	}
      break;
    case LONGLONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.ll = op1 -> value.ll + op2 -> value.i;
	  result -> type = LONGLONG_T;
	  break;
	case LONG_T:
	  result -> value.ll = op1 -> value.ll + op2 -> value.l;
	  result -> type = LONGLONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.ll + op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.ll + op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.ll + op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  result -> value.ptr = op1 -> value.ll + op2 -> value.ptr;
	  result -> type = PTR_T;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_add.");
#endif
	  break;
	}
      break;
    case DOUBLE_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.d = op1 -> value.d + op2 -> value.i;
	  result -> type = DOUBLE_T;
	  break;
	case LONG_T:
	  result -> value.d = op1 -> value.d + op2 -> value.l;
	  result -> type = DOUBLE_T;
	  break;
	case LONGLONG_T:
	  result -> value.ld = op1 -> value.d + op2 -> value.ll;
	  result -> type = LONGDOUBLE_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.d + op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.d + op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_add.");
#endif
	  break;
	}
      break;
    case LONGDOUBLE_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.d = op1 -> value.ld + op2 -> value.i;
	  result -> type = LONGDOUBLE_T;
	  break;
	case LONG_T:
	  result -> value.d = op1 -> value.ld + op2 -> value.l;
	  result -> type = LONGDOUBLE_T;
	  break;
	case LONGLONG_T:
	  result -> value.ld = op1 -> value.ld + op2 -> value.ll;
	  result -> type = LONGDOUBLE_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.ld + op2 -> value.d;
	  result -> type = LONGDOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.ld + op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_add.");
#endif
	  break;
	}
      break;
    case PTR_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.ptr = op1 -> value.ptr + op2 -> value.i;
	  break;
	case LONG_T:
	  result -> value.ptr = op1 -> value.ptr + op2 -> value.l;
	  break;
	case LONGLONG_T:
	  result -> value.ptr = op1 -> value.ptr + op2 -> value.ll;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_add.");
#endif
	  break;
	}
      result -> type = PTR_T;
      break;
    default:
#ifdef DEBUG_CODE
      debug ("Unimplemented operand 1 type in perform_add.");
#endif
      break;
  }

  return is_val_true (result);
}

int perform_subtract (MESSAGE *m_op, VAL *op1, VAL *op2, VAL *result) { 
  switch (op1 -> type) 
    {
    case INTEGER_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.i = op1 -> value.i - op2 -> value.i;
	  result -> type = INTEGER_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.i - op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.i - op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.i - op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.i - op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_subtract.");
#endif
	  break;
	}
      break;
    case LONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.l = op1 -> value.l - op2 -> value.i;
	  result -> type = LONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.l - op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.l - op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.l - op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.l - op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_subtract.");
#endif
	  break;
	}
      break;
    case LONGLONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.l = op1 -> value.ll - op2 -> value.i;
	  result -> type = LONGLONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.ll - op2 -> value.l;
	  result -> type = LONGLONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.ll - op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.ll - op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.ll - op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_subtract.");
#endif
	  break;
	}
      break;
    case DOUBLE_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.d = op1 -> value.d - op2 -> value.i;
	  result -> type = DOUBLE_T;
	  break;
	case LONG_T:
	  result -> value.d = op1 -> value.d - op2 -> value.l;
	  result -> type = DOUBLE_T;
	  break;
	case LONGLONG_T:
	  result -> value.ld = op1 -> value.d - op2 -> value.ll;
	  result -> type = LONGDOUBLE_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.d - op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.d - op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_subtract.");
#endif
	  break;
	}
      break;
    case LONGDOUBLE_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.d = op1 -> value.ld - op2 -> value.i;
	  result -> type = LONGDOUBLE_T;
	  break;
	case LONG_T:
	  result -> value.d = op1 -> value.ld - op2 -> value.l;
	  result -> type = LONGDOUBLE_T;
	  break;
	case LONGLONG_T:
	  result -> value.ld = op1 -> value.ld - op2 -> value.ll;
	  result -> type = LONGDOUBLE_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.ld - op2 -> value.d;
	  result -> type = LONGDOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.ld - op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_subtract.");
#endif
	  break;
	}
      break;
    case PTR_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.ptr = op1 -> value.ptr - op2 -> value.i;
	  break;
	case LONG_T:
	  result -> value.ptr = op1 -> value.ptr - op2 -> value.l;
	  break;
	case LONGLONG_T:
	  result -> value.ptr = op1 -> value.ptr - op2 -> value.ll;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_subtract.");
#endif
	  break;
	}
      result -> type = PTR_T;
      break;
    default:
#ifdef DEBUG_CODE
      debug ("Unimplemented operand 1 type in perform_subtract.");
#endif
      break;
  }

  return is_val_true (result);
}

int perform_multiply (MESSAGE *m_op, VAL *op1, VAL *op2, VAL *result) { 
  switch (op1 -> type) 
    {
    case INTEGER_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.i = op1 -> value.i * op2 -> value.i;
	  result -> type = INTEGER_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.i * op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.i * op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.i * op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.i * op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_multiply.");
#endif
	  break;
	}
      break;
    case LONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.l = op1 -> value.l * op2 -> value.i;
	  result -> type = LONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.l * op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.l * op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.l * op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.l * op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_multiply.");
#endif
	  break;
	}
      break;
    case LONGLONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.l = op1 -> value.ll * op2 -> value.i;
	  result -> type = LONGLONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.ll * op2 -> value.l;
	  result -> type = LONGLONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.ll * op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.ll * op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.ll * op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_multiply.");
#endif
	  break;
	}
      break;
    case DOUBLE_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.d = op1 -> value.d * op2 -> value.i;
	  result -> type = DOUBLE_T;
	  break;
	case LONG_T:
	  result -> value.d = op1 -> value.d * op2 -> value.l;
	  result -> type = DOUBLE_T;
	  break;
	case LONGLONG_T:
	  result -> value.ld = op1 -> value.d * op2 -> value.ll;
	  result -> type = LONGDOUBLE_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.d * op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.d * op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_multiply.");
#endif
	  break;
	}
      break;
    case LONGDOUBLE_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.d = op1 -> value.ld * op2 -> value.i;
	  result -> type = LONGDOUBLE_T;
	  break;
	case LONG_T:
	  result -> value.d = op1 -> value.ld * op2 -> value.l;
	  result -> type = LONGDOUBLE_T;
	  break;
	case LONGLONG_T:
	  result -> value.ld = op1 -> value.ld * op2 -> value.ll;
	  result -> type = LONGDOUBLE_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.ld * op2 -> value.d;
	  result -> type = LONGDOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.ld * op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_multiply.");
#endif
	  break;
	}
      break;
    case PTR_T:
      warning (m_op, "Invalid operand to %s in perform_multiply.", 
	       m_op -> name);
      parse_exception = parse_error_x;
      return ERROR;
      break;
    default:
#ifdef DEBUG_CODE
      debug ("Unimplemented operand 1 type in perform_multiply.");
#endif
      break;
  }

  return is_val_true (result);
}

int perform_divide (MESSAGE *m_op, VAL *op1, VAL *op2, VAL *result) { 

  /* Check first for division by zero. */
  switch (op2 -> type)
    {
    case INTEGER_T:
      if (op2 -> value.i == 0) {
	warning (m_op, "Division by zero.");
	parse_exception = parse_error_x;
	return FALSE;
      }
      break;
    case LONG_T:
      if (op2 -> value.l == 0) {
	warning (m_op, "Division by zero.");
	parse_exception = parse_error_x;
	return FALSE;
      }
      break;
    case LONGLONG_T:
      if (op2 -> value.ll == 0) {
	warning (m_op, "Division by zero.");
	parse_exception = parse_error_x;
	return FALSE;
      }
      break;
    case DOUBLE_T:
      if (op2 -> value.d == 0) {
	warning (m_op, "Division by zero.");
	parse_exception = parse_error_x;
	return FALSE;
      }
      break;
    case LONGDOUBLE_T:
      if (op2 -> value.ld == 0) {
	warning (m_op, "Division by zero.");
	parse_exception = parse_error_x;
	return FALSE;
      }
      break;
    case PTR_T:
      if (op2 -> value.ptr == 0) {
	warning (m_op, "Division by zero.");
	parse_exception = parse_error_x;
	return FALSE;
      }
      break;
    }

  switch (op1 -> type) 
    {
    case INTEGER_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.i = op1 -> value.i / op2 -> value.i;
	  result -> type = INTEGER_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.i / op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.i / op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.i / op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.i / op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_divide.");
#endif
	  break;
	}
      break;
    case LONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.l = op1 -> value.l / op2 -> value.i;
	  result -> type = LONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.l / op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.l / op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.l / op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.l / op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_divide.");
#endif
	  break;
	}
      break;
    case LONGLONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.l = op1 -> value.ll / op2 -> value.i;
	  result -> type = LONGLONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.ll / op2 -> value.l;
	  result -> type = LONGLONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.ll / op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.ll / op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.ll / op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_divide.");
#endif
	  break;
	}
      break;
    case DOUBLE_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.d = op1 -> value.d / op2 -> value.i;
	  result -> type = DOUBLE_T;
	  break;
	case LONG_T:
	  result -> value.d = op1 -> value.d / op2 -> value.l;
	  result -> type = DOUBLE_T;
	  break;
	case LONGLONG_T:
	  result -> value.ld = op1 -> value.d / op2 -> value.ll;
	  result -> type = LONGDOUBLE_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.d / op2 -> value.d;
	  result -> type = DOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.d / op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_divide.");
#endif
	  break;
	}
      break;
    case LONGDOUBLE_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.d = op1 -> value.ld / op2 -> value.i;
	  result -> type = LONGDOUBLE_T;
	  break;
	case LONG_T:
	  result -> value.d = op1 -> value.ld / op2 -> value.l;
	  result -> type = LONGDOUBLE_T;
	  break;
	case LONGLONG_T:
	  result -> value.ld = op1 -> value.ld / op2 -> value.ll;
	  result -> type = LONGDOUBLE_T;
	  break;
	case DOUBLE_T:
	  result -> value.d = op1 -> value.ld / op2 -> value.d;
	  result -> type = LONGDOUBLE_T;
	  break;
	case LONGDOUBLE_T:
	  result -> value.ld = op1 -> value.ld / op2 -> value.ld;
	  result -> type = LONGDOUBLE_T;
	  break;
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_divide.");
#endif
	  break;
	}
      break;
    case PTR_T:
      warning (m_op, "Invalid operand to %s.", m_op -> name);
      parse_exception = parse_error_x;
      return ERROR;
      break;
    default:
#ifdef DEBUG_CODE
      debug ("Unimplemented operand 1 type in perform_divide.");
#endif
      break;
  }

  return is_val_true (result);
}

int perform_asl (MESSAGE *m_op, VAL *op1, VAL *op2, VAL *result) { 
  switch (op1 -> type) 
    {
    case INTEGER_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.i = op1 -> value.i << op2 -> value.i;
	  result -> type = INTEGER_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.i << op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.i << op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG
	  debug ("Unimplemented operand 2 type in perform_asl.");
#endif
	  break;
	}
      break;
    case LONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.l = op1 -> value.l << op2 -> value.i;
	  result -> type = LONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.l << op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.l << op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_asl.");
#endif
	  break;
	}
      break;
    case LONGLONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.ll = op1 -> value.ll << op2 -> value.i;
	  result -> type = LONGLONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.ll << op2 -> value.l;
	  result -> type = LONGLONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.ll << op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_asl.");
#endif
	  break;
	}
      break;
    case DOUBLE_T:
    case LONGDOUBLE_T:
    case PTR_T:
      warning (m_op, "Invalid operand to %s.", m_op -> name);
      parse_exception = parse_error_x;
      return ERROR;
      break;
    default:
#ifdef DEBUG_CODE
      debug ("Unimplemented operand 1 type in perform_add.");
#endif
      break;
  }

  return is_val_true (result);
}

int perform_asr (MESSAGE *m_op, VAL *op1, VAL *op2, VAL *result) { 
  switch (op1 -> type) 
    {
    case INTEGER_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.i = op1 -> value.i >> op2 -> value.i;
	  result -> type = INTEGER_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.i >> op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.i >> op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_subtract.");
#endif
	  break;
	}
      break;
    case LONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.l = op1 -> value.l >> op2 -> value.i;
	  result -> type = LONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.l >> op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.l >> op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_asr.");
#endif
	  break;
	}
      break;
    case LONGLONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.ll = op1 -> value.ll >> op2 -> value.i;
	  result -> type = LONGLONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.ll >> op2 -> value.l;
	  result -> type = LONGLONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.ll >> op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_asr.");
#endif
	  break;
	}
      break;
    case DOUBLE_T:
    case LONGDOUBLE_T:
    case PTR_T:
      warning (m_op, "Invalid operand to %s.", m_op -> name);
      parse_exception = parse_error_x;
      return ERROR;
      break;
    default:
#ifdef DEBUG_CODE
      debug ("Unimplemented operand 1 type in perform_asr.");
#endif
      break;
  }

  return is_val_true (result);
}


int perform_bit_and (MESSAGE *m_op, VAL *op1, VAL *op2, VAL *result) { 
  switch (op1 -> type) 
    {
    case INTEGER_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.i = op1 -> value.i & op2 -> value.i;
	  result -> type = INTEGER_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.i & op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.i & op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_bit_and.");
#endif
	  break;
	}
      break;
    case LONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.l = op1 -> value.l & op2 -> value.i;
	  result -> type = LONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.l & op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.l & op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_bit_and.");
#endif
	  break;
	}
      break;
    case LONGLONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.ll = op1 -> value.ll & op2 -> value.i;
	  result -> type = LONGLONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.ll & op2 -> value.l;
	  result -> type = LONGLONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.ll & op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_bit_and.");
#endif
	  break;
	}
      break;
    case DOUBLE_T:
    case LONGDOUBLE_T:
    case PTR_T:
      warning (m_op, "Invalid operand to %s.", m_op -> name);
      parse_exception = parse_error_x;
      return ERROR;
      break;
    default:
#ifdef DEBUG_CODE
      debug ("Unimplemented operand 1 type in perform_bit_and.");
#endif
      break;
  }

  return is_val_true (result);
}

int perform_bit_or (MESSAGE *m_op, VAL *op1, VAL *op2, VAL *result) { 
  switch (op1 -> type) 
    {
    case INTEGER_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.i = op1 -> value.i | op2 -> value.i;
	  result -> type = INTEGER_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.i | op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.i | op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_bit_or.");
#endif
	  break;
	}
      break;
    case LONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.l = op1 -> value.l | op2 -> value.i;
	  result -> type = LONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.l | op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.l | op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_bit_or.");
#endif
	  break;
	}
      break;
    case LONGLONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.ll = op1 -> value.ll | op2 -> value.i;
	  result -> type = LONGLONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.ll | op2 -> value.l;
	  result -> type = LONGLONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.ll | op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_bit_or.");
#endif
	  break;
	}
      break;
    case DOUBLE_T:
    case LONGDOUBLE_T:
    case PTR_T:
      warning (m_op, "Invalid operand to %s.", m_op -> name);
      parse_exception = parse_error_x;
      return ERROR;
      break;
    default:
#ifdef DEBUG_CODE
      debug ("Unimplemented operand 1 type in perform_bit_or.");
#endif
      break;
  }

  return is_val_true (result);
}

int perform_bit_xor (MESSAGE *m_op, VAL *op1, VAL *op2, VAL *result) {
  switch (op1 -> type) 
    {
    case INTEGER_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.i = op1 -> value.i ^ op2 -> value.i;
	  result -> type = INTEGER_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.i ^ op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.i ^ op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_bit_xor.");
#endif
	  break;
	}
      break;
    case LONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.l = op1 -> value.l ^ op2 -> value.i;
	  result -> type = LONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.l ^ op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.l ^ op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_bit_xor.");
#endif
	  break;
	}
      break;
    case LONGLONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.ll = op1 -> value.ll ^ op2 -> value.i;
	  result -> type = LONGLONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.ll ^ op2 -> value.l;
	  result -> type = LONGLONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.ll ^ op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_bit_xor.");
#endif
	  break;
	}
      break;
    case DOUBLE_T:
    case LONGDOUBLE_T:
    case PTR_T:
      warning (m_op, "Invalid operand to %s.", m_op -> name);
      parse_exception = parse_error_x;
      return ERROR;
      break;
    default:
#ifdef DEBUG_CODE
      debug ("Unimplemented operand 1 type in perform_bit_xor.");
#endif
      break;
  }

  return is_val_true (result);
}

int perform_modulus (MESSAGE *m_op, VAL *op1, VAL *op2, VAL *result) {
  switch (op1 -> type) 
    {
    case INTEGER_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.i = op1 -> value.i % op2 -> value.i;
	  result -> type = INTEGER_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.i % op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.i % op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_bit_xor.");
#endif
	  break;
	}
      break;
    case LONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.l = op1 -> value.l % op2 -> value.i;
	  result -> type = LONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.l % op2 -> value.l;
	  result -> type = LONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.l % op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_bit_xor.");
#endif
	  break;
	}
      break;
    case LONGLONG_T:
      switch (op2 -> type)
	{
	case INTEGER_T:
	  result -> value.ll = op1 -> value.ll % op2 -> value.i;
	  result -> type = LONGLONG_T;
	  break;
	case LONG_T:
	  result -> value.l = op1 -> value.ll % op2 -> value.l;
	  result -> type = LONGLONG_T;
	  break;
	case LONGLONG_T:
	  result -> value.ll = op1 -> value.ll % op2 -> value.ll;
	  result -> type = LONGLONG_T;
	  break;
	case DOUBLE_T:
	case LONGDOUBLE_T:
	case PTR_T:
	  warning (m_op, "Invalid operand to %s.", m_op -> name);
	  parse_exception = parse_error_x;
	  return ERROR;
	  break;
	default:
#ifdef DEBUG_CODE
	  debug ("Unimplemented operand 2 type in perform_bit_xor.");
#endif
	  break;
	}
      break;
    case DOUBLE_T:
    case LONGDOUBLE_T:
    case PTR_T:
      warning (m_op, "Invalid operand to %s.", m_op -> name);
      parse_exception = parse_error_x;
      return ERROR;
      break;
    default:
#ifdef DEBUG_CODE
      debug ("Unimplemented operand 1 type in perform_bit_xor.");
#endif
      break;
  }

  return is_val_true (result);
}

int perform_bit_comp (MESSAGE *m_op, VAL *op2, VAL *result) { 

  switch (op2 -> type) 
    {
    case INTEGER_T:
      result -> value.i = ~op2 -> value.i;
      result -> type = INTEGER_T;
      break;
    case LONG_T:
      result -> value.l = ~op2 -> value.l;
      result -> type = LONG_T;
      break;
    case LONGLONG_T:
      result -> value.ll = ~op2 -> value.ll;
      result -> type = LONGLONG_T;
      break;
    case DOUBLE_T:
    case LONGDOUBLE_T:
    case PTR_T:
      warning (m_op, "Invalid operand to %s.", m_op -> name);
      parse_exception = parse_error_x;
      return ERROR;
      break;
    default:
#ifdef DEBUG_CODE
      debug ("Unimplemented operand 1 type in perform_bit_comp.");
#endif
      break;
  }

  return is_val_true (result);
}

Boolean question_conditional_eval (MESSAGE_STACK messages, 
				   int op_ptr, int *end_ptr, VAL *result) {

  int i;
  int stacktop, stack_end;
  int n_parens;
  int pred_start_ptr, pred_end_ptr,
    true_start_ptr, true_end_ptr,
    false_start_ptr, false_end_ptr;
  int else_op_ptr = 0;              /* Avoid a warning. */
  int eval_token;
  VAL pred_val;
  MESSAGE *m;

  memset ((void *)&pred_val, 0, sizeof (VAL));
  pred_val.type = 1;


  stacktop = stack_start (messages);
  stack_end = get_stack_top (messages);

  /* Find the beginning and end of the predicate. */

  for (i = op_ptr + 1, n_parens = 0, 
	 pred_start_ptr = ERROR, pred_end_ptr = ERROR; 
       (i < stacktop) && (pred_start_ptr == ERROR || pred_end_ptr == ERROR); 
       i++) {

    m = messages[i];
    
    if (m -> tokentype == WHITESPACE)
      continue;
    switch (m -> tokentype) 
      {
      case LABEL:
	if (!n_parens)
	  pred_start_ptr = pred_end_ptr = i;
	break;
      case PREPROCESS_EVALED:
      case RESULT:
	if (pred_end_ptr == ERROR)
	  pred_end_ptr = i;
	/* Lookback should be sufficient. */
	if (messages[i+1] -> tokentype != m -> tokentype)
	  pred_start_ptr = i;
	break;
	/* Scanning right to left, so increment the parentheses on
	   close, decerement on open. */
      case OPENPAREN:
	--n_parens;
	if (!n_parens)
	  pred_start_ptr = i;
	break;
      case CLOSEPAREN:
	if (!n_parens)
	  pred_end_ptr = i;
	++n_parens;
	break;
      }
  }

  if (pred_start_ptr == ERROR || pred_end_ptr == ERROR) {
    parse_exception = parse_error_x;
    warning (messages[op_ptr], "Parse error.");
    result -> type = INTEGER_T;
    result -> value.i = FALSE;
  }

  /* Find the beginning and end of the true subexpression. */

  for (i = op_ptr - 1, true_start_ptr = ERROR, true_end_ptr = ERROR; 
       (i > stack_end) && (true_start_ptr == ERROR || true_end_ptr == ERROR);
       i--) {

    m = messages[i];
    
    if (m -> tokentype == WHITESPACE)
      continue;

    if (true_start_ptr == ERROR)
      true_start_ptr = i;

    if ((m -> tokentype == COLON) ||
	!strncmp (m -> name, ":", 1)) {
      true_end_ptr = i+1;
      else_op_ptr = i;
    }
  }

  /* Find the beginning and end of the false subexpression. */

  for (i = else_op_ptr - 1, false_start_ptr = ERROR, false_end_ptr = ERROR; 
       (i > stack_end) && (false_start_ptr == ERROR || false_end_ptr == ERROR);
       i--) {
    m = messages[i];
    
    if (m -> tokentype == WHITESPACE)
      continue;

    if (false_start_ptr == ERROR)
      false_start_ptr = i;

/*     if (preprocessing) { */
/*       if ((m -> tokentype == NEWLINE) || */
/* 	  !strncmp (m -> name, "\n", 1)) { */
/* 	false_end_ptr = i+1; */
/* 	*end_ptr = i; */
/*       } */
/*     } else { */
      if ((m -> tokentype == SEMICOLON) ||
	  !strncmp (m -> name, ";", 1)) {
	false_end_ptr = i+1;
	*end_ptr = i;
      }
/*     } */
  }

  eval_constant_expr (messages, pred_start_ptr, &pred_end_ptr, &pred_val);

  if (is_val_true (&pred_val)) {
    eval_constant_expr (messages, true_start_ptr, &true_end_ptr, result);
  } else {
    eval_constant_expr (messages, false_start_ptr, &false_end_ptr, result);
  }

/*   if (preprocessing)  */
/*     eval_token = PREPROCESS_EVALED; */
/*   else */
    eval_token = RESULT;
  for (i = pred_start_ptr; i >= false_end_ptr; i--) {

    ++(messages[i] -> evaled);
    messages[i] -> tokentype = eval_token;
    m_print_val (messages[i], result);
  }
  return is_val_true (result);
}

/*
 *   We have to retokenize the argument because sizeof,
 *   being also a C keyword, may have had its arguemnt 
 *   evaluated elsewhere.
 */

int handle_sizeof_op (MESSAGE_STACK messages, int op_ptr, 
		      int *end, VAL *val) {

  int i,
    stack_end,
    arg_start,
    first_token,
    arg_end,
    n_parens;
  MESSAGE *m;

  if (strcmp (messages[op_ptr] -> name, "sizeof"))
    _error ("handle_sizeof_op: wrong message.");

  stack_end = first_token = get_stack_top (messages);

  /* Find the start and end of the argument. */
  for (i = op_ptr - 1, n_parens = 0, arg_start = ERROR, arg_end = ERROR; 
       i > stack_end; i--) {

    m = messages[i];

    switch (m -> tokentype)
      {
      case OPENPAREN:
	if (!n_parens)
	  arg_start = i;
	++n_parens;
	break;
      case CLOSEPAREN:
	--n_parens;
	if (!n_parens) {
	  arg_end = i;
	  goto retokenize;
	}
      case RESULT:
      case PREPROCESS_EVALED:
	if (m -> name[0] == '(') {
	  if (!n_parens)
	    arg_start = i;
	  ++n_parens;
	}
	if (m -> name[0] == ')') {
	  --n_parens;
	  if (!n_parens) {
	    *end = arg_end = i;
	    goto retokenize;
	  }
	}
 	break;
      }
  }

 retokenize:

  /* FIXME! -
     Until we can calculate the size of derived types, simply set the 
     size to the size of a void *. */

  for (i = op_ptr; i >= arg_end; i--) {
/*     if (preprocessing) */
/*       messages[i] -> tokentype = PREPROCESS_EVALED; */
/*     else */
      messages[i] -> tokentype = RESULT;
    
#ifdef __DJGPP__
    sprintf (messages[i] -> value, "%lu", sizeof (void *));
#else
    sprintf (messages[i] -> value, "%u", sizeof (void *));
#endif
  }

  val -> type = INTEGER_T;
  val -> value.i = sizeof (void *);

  *end = arg_end;

  return SUCCESS;
}

