/* $Id: rt_cvar.c,v 1.6 2008/11/06 20:54:36 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 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.
*/

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

CVAR *global_cvars;
CVAR *local_cvars;
CVAR *typedefs;
CVAR *typedefs_ptr;
CVAR *externs;
CVAR *externs_ptr;
CVAR *method_arg_cvars;
CFUNC *functions,
  *functions_ptr;
void _new_cvar (CVARREF_T);

void init_rt_cvars (void) {
}

/*
 *  For the prototype, see src/output.c.
 */
int __ctalk_register_c_method_arg (char *decl, char *type, 
				   char *qualifier, char *qualifier2,
				   char *storage_class, char *name, 
				   int is_unsigned, int n_derefs, int scope, 
				   void *var) {
  CVAR *c;
  _new_cvar (CVARREF(c));
  if (strcmp (decl, NULLSTR))
    strcpy (c -> decl, decl);
  if (strcmp (type, NULLSTR))
    strcpy (c -> type, type);
  if (strcmp (qualifier, NULLSTR))
    strcpy (c -> qualifier, qualifier);
  if (strcmp (qualifier2, NULLSTR))
    strcpy (c -> qualifier2, qualifier2);
  if (strcmp (storage_class, NULLSTR))
    strcpy (c -> storage_class, storage_class);
  if (strcmp (name, NULLSTR))
    strcpy (c -> name, name);
  c -> is_unsigned = (is_unsigned) ? True : False;
  c -> n_derefs = n_derefs;
  c -> scope = scope;

  if (!strcmp (c -> type, "int")) {
    if (!strcmp (c -> qualifier, "long")) {
      if (!strcmp (c -> qualifier2, "long")) {
	c -> val.type = LONGLONG_T;
	c -> val.value.ll = *(long long int *)var;
      } else {
	c -> val.type = LONG_T;
	c -> val.value.l = *(long int *)var;
      }
    } else {
      c -> val.type = INTEGER_T;
      c -> val.value.i = *(int *)var;
    }
  } else {
    if ((!strcmp (c -> type, "double")) ||
	(!strcmp (c -> type, "float"))) {
      if (!strcmp (c -> qualifier, "long")) {
	c -> val.type = LONGDOUBLE_T;
	c -> val.value.ld = *(long double *)var;
      } else {
	c -> val.type = DOUBLE_T;
	c -> val.value.d = *(double *)var;
      }
    } else {
      if (!strcmp (c -> type, "char")) {
	switch (c -> n_derefs)
	  {
	    /*
	     *  Promote a character to an int.
	     */
	  case 0:
	    c -> val.type = INTEGER_T;
	    c -> val.value.i = *(char *)var;
	    break;
	  case 1:
	  case 2:
	    c -> val.type = PTR_T;
	    c -> val.value.ptr = var;
	    break;
	  }
      } else {
	if (!strcmp (c -> type, "OBJECT")) {
	  c -> val.type = OBJECT_T;
	  c -> val.value.ptr = (OBJECT *)var;
	} else {
	  /*
	   *   At the moment we should only need to store a generic
	   *   pointer.
	   */
	  c -> val.type = PTR_T;
	  c -> val.value.ptr = var;
	}
      }
    }
  }

  add_method_arg_cvar (c);

  return SUCCESS;
}

/*
 *  The order of precedence for adding and removing cvars is:
 *  1. Method local cvar.
 *  2. Function local cvar.
 *  3. Global cvar.
 */

CVAR *remove_method_arg_cvar (char *name) {

  CVAR *t = NULL;                /* Avoid a warning. */
  OBJECT *(*method_fn)(void);
  METHOD *method;
  RT_FN *fn;

  if ((method_fn = __ctalkRtGetMethodFn ()) != NULL) {

    if ((method = __this_method ()) == NULL) {
      _warning ("Undefined method in remove_method_arg_cvar.\n");
      return NULL;
    }

    if (method -> local_cvars) {
      if ((method -> local_cvars -> next == NULL) &&
	  (method -> local_cvars -> prev == NULL)) {
	if (!strcmp (method -> local_cvars -> name, name)) {
	  t = method -> local_cvars;
	  method -> local_cvars = NULL;
	  return t;
	}
      } else {
	for (t = method -> local_cvars; t && t -> next; t = t -> next) {
	  if (!strcmp (t -> name, name)) {
	    if (t -> prev)
	      t -> prev -> next = (t -> next ? t -> next : NULL);
	    if (t -> next)
	      t -> next -> prev = (t -> prev ? t -> prev : NULL);
	    return t;
	  }
	}
      }
    }
  }

  if ((fn = get_fn ()) != NULL) {
    if (fn -> local_cvars) {
      if ((fn -> local_cvars -> next == NULL) &&
	  (fn -> local_cvars -> prev == NULL)) {
	if (!strcmp (fn -> local_cvars -> name, name)) {
	  t = fn -> local_cvars;
	  fn -> local_cvars = NULL;
	  return t;
	}
      } else {
	for (t = fn -> local_cvars; t; t = t -> next) {
	  if (!strcmp (t -> name, name)) {
	    if (t -> prev)
	      t -> prev -> next = (t -> next ? t -> next : NULL);
	    if (t -> next)
	      t -> next -> prev = (t -> prev ? t -> prev : NULL);
	    return t;
	  }
	}
      }
    }
  }


  if (method_arg_cvars) {

    if ((method_arg_cvars -> next == NULL) &&
	(method_arg_cvars -> prev == NULL)) {
      if (!strcmp (name, t -> name)) {
	t = method_arg_cvars;
	method_arg_cvars = NULL;
	return t;
      } else {
	return NULL;
      }
    } else {
      for (t = method_arg_cvars; t && t -> next; t = t -> next) {
	if (!strcmp (t -> name, name)) {
	  if (t -> prev)
	    t -> prev -> next = (t -> next ? t -> next : NULL);
	  if (t -> next)
	    t -> next -> prev = (t -> prev ? t -> prev : NULL);
	  return t;
	}
      }
    }
  }
  return NULL;
}

int add_method_arg_cvar (CVAR *c) {

  CVAR *t;
  OBJECT *(*method_fn)(void);
  METHOD *method;
  RT_FN *fn;

  if ((method_fn = __ctalkRtGetMethodFn ()) != NULL) {

    if ((method = __this_method ()) == NULL) {
      _warning ("Undefined method in add_method_arg_cvar.\n");
      return ERROR;
    }

    if (!method -> local_cvars) {
      method -> local_cvars = c;
    } else {
      for (t = method -> local_cvars; t -> next; t = t -> next)
	;
      t -> next = c;
      c -> prev = t;
    }

    return SUCCESS;
  }

  if ((fn = get_fn ()) != NULL) {

    if (fn -> local_cvars == NULL) {
      fn -> local_cvars = c;
    } else {
    for (t = fn -> local_cvars; t -> next; t = t -> next)
      ;
    t -> next = c;
    c -> prev = t;
    }
    return SUCCESS;
  }

  if (!method_arg_cvars) {
    method_arg_cvars = c;
  } else {
    for (t = method_arg_cvars; t -> next; t = t -> next)
      ;
    t -> next = c;
    c -> prev = t;
  }

  return SUCCESS;

}

CVAR *get_method_arg_cvars (const char *s) {

  CVAR *c;
  OBJECT *(*method_fn)(void);
  METHOD *method;
  RT_FN *fn;

  if ((method_fn = __ctalkRtGetMethodFn ()) != NULL) {

    if ((method = __this_method ()) == NULL) {
      _warning ("Undefined method in get_method_arg_cvar.\n");
      return NULL;
    }

    if (!method -> local_cvars)
      return NULL;

    for (c = method -> local_cvars; c; c = c -> next)
      if (!strcmp (c -> name, s))
	return c;

  }

  if ((fn = get_fn ()) != NULL) {
    for (c = fn -> local_cvars; c; c = c -> next) {
      if (!strcmp (c -> name, s))
	return c;
    }
  }

  if (!method_arg_cvars)
    return NULL;

  for (c = method_arg_cvars; c; c = c -> next)
    if (!strcmp (c -> name, s))
      return c;

  return NULL;
}

/*
 *  API version of the function above.
 */

CVAR *__ctalkGetCArg (OBJECT *o) {

  CVAR *c;
  OBJECT *(*method_fn)(void), *arg_value_obj;
  METHOD *method;
  RT_FN *fn;

  arg_value_obj = ((o -> instancevars) ? o -> instancevars : o);

  if ((method_fn = __ctalkRtGetMethodFn ()) != NULL) {

    if ((method = __this_method ()) == NULL) {
      _warning ("Undefined method in get_method_arg_cvar.\n");
      return NULL;
    }

    for (c = method -> local_cvars; c; c = c -> next)
      if (!strcmp (c -> name, arg_value_obj -> __o_value))
 	return c;

  }

   if ((fn = get_fn ()) != NULL) {
     for (c = fn -> local_cvars; c; c = c -> next) {
       if (!strcmp (c -> name, arg_value_obj -> __o_value))
 	return c;
     }
   }

   if ((fn = get_calling_fn ()) != NULL) {
     for (c = fn -> local_cvars; c; c = c -> next) {
       if (!strcmp (c -> name, arg_value_obj -> __o_value))
 	return c;
     }
   }

  return NULL;
}

/*
 *  Check for both OBJECT_T and PTR_T types. TO DO - Make sure that 
 *  when we have an OBJECT * as a value, its type is OBJECT_T.
 */

OBJECT *cvar_object (CVAR *c) {
  OBJECT *o = NULL;         /* Avoid a warning. */
  OBJECT *o_from_var;
  char buf[MAXLABEL];
  switch (c -> val.type) 
    {
    case INTEGER_T:
    case LONG_T:
      /*
       *  Char types can also occur here.
       */
      if (!strcmp (c -> type, "char")) {
	sprintf (buf, "%c", (char)c -> val.value.i);
	o = __ctalkCreateObjectInit (c -> name, 
					CHARACTER_CLASSNAME, 
					CHARACTER_SUPERCLASSNAME,
					LOCAL_VAR, buf);
      } else {
	sprintf (buf, "%d", c -> val.value.i);
	o = __ctalkCreateObjectInit (c -> name, 
					INTEGER_CLASSNAME, 
					INTEGER_SUPERCLASSNAME,
					LOCAL_VAR, buf);
      }
      break;
    case LONGLONG_T:
      sprintf (buf, "%lld", c -> val.value.ll);
      o = __ctalkCreateObjectInit (c -> name, 
				      LONGINTEGER_CLASSNAME, 
				      LONGINTEGER_SUPERCLASSNAME,
				      LOCAL_VAR, buf);
      break;
    case FLOAT_T:
    case DOUBLE_T:
#ifdef DJGPP
      sprintf (buf, "%lf", c -> val.value.d);
#else
      snprintf (buf, MAXLABEL, "%lf", c -> val.value.d);
#endif
      o = __ctalkCreateObjectInit (c -> name, 
				      FLOAT_CLASSNAME, 
				      FLOAT_SUPERCLASSNAME,
				      LOCAL_VAR, buf);
      break;
    case OBJECT_T:
      o_from_var = (OBJECT *)c -> val.value.ptr;
      __ctalkCopyObject(OBJREF(o_from_var), OBJREF(o));
      __ctalkSetObjectScope
	(o, (o_from_var -> scope | CVAR_VAR_ALIAS_COPY));
      break;
    case PTR_T:
      o = (OBJECT *)c -> val.value.ptr;
      if (!o || !IS_OBJECT (o)) {
	/*
	 *  Character types.
	 */
	if (!strcmp (c -> type, "char")) {
	  switch (c -> n_derefs)
	    {
	    case 0:
	      /*
	       *  Character class are handled as INTEGER_T values,
	       *  above.
	       */
	      break;
	    case 1:
	      o = __ctalkCreateObjectInit (c -> name, 
					      STRING_CLASSNAME,
					      STRING_SUPERCLASSNAME,
					      LOCAL_VAR, 
					      (char *)c -> val.value.ptr);
	      break;
	    case 2:
	      /*
	       *  Array members do not automatically translate 
	       *  from cvars - they need to be atPut manually.
	       */
	      o = __ctalkCreateObjectInit (c -> name, 
					      ARRAY_CLASSNAME,
					      ARRAY_SUPERCLASSNAME,
					      LOCAL_VAR, 
					   (char *)c->val.value.ptr);
	      break;
	    default:
	      break;
	    }
	} else {
/* 	  sprintf (buf, "%p", (char *)c -> val.value.ptr); */
	  sprintf (buf, FMT_0XHEX((char *)c -> val.value.ptr));
	  o = __ctalkCreateObjectInit (c -> name, 
					  EXPR_CLASSNAME,
					  EXPR_SUPERCLASSNAME,
					  LOCAL_VAR, 
					  buf);
	}
      }
      break;
    }
  return o;
}

int delete_method_arg_cvars (void) {

  OBJECT *(*method_fn)(void);
  METHOD *method;
  RT_FN *fn;

  if ((method_fn = __ctalkRtGetMethodFn ()) != NULL) {

    if ((method = __this_method ()) == NULL) {
      _warning ("Undefined method in delete_method_arg_cvar.\n");
      return ERROR;
    }

    if (method -> local_cvars) {
      CVAR *s, *t;
      if ((method -> local_cvars -> next == NULL) &&
	  (method -> local_cvars -> prev == NULL)) {
	_delete_cvar (method -> local_cvars);
	method -> local_cvars = NULL;
      } else {
	for (t = method -> local_cvars; t && t -> next; t = t -> next)
	  ;
	while (1) {
	  s = t -> prev;
	  _delete_cvar (t);
	  if (!s) break;
	  t = s;
	}
      }
      method -> local_cvars = NULL;
    }
    return SUCCESS;
  }

  if ((fn = get_fn ()) != NULL) {
    CVAR *s, *t;
    if (fn -> local_cvars) {
      for (t = fn -> local_cvars; t && t -> next; t = t -> next)
	;
      while (1) {
	s = t -> prev;
	_delete_cvar (t);
	if (!s) break;
	t = s;
      }
      fn -> local_cvars = NULL;
    }
  }

  if (method_arg_cvars) {
    CVAR *s, *t;
    for (t = method_arg_cvars; t && t -> next; t = t -> next)
      ;
    while (1) {
      s = t -> prev;
      free (t);
      if (!s) break;
      t = s;
    }
  }
  method_arg_cvars = NULL;
  return SUCCESS;
}

void _new_cvar (CVARREF_T cvar_ref) {
  *cvar_ref = __xalloc (sizeof(CVAR));
  strcpy ((*cvar_ref) -> sig, "CVAR");
}

/*
 *  TO DO - If necessary, delete all links of a 
 *  multiple declaration.
 */
void _delete_cvar (CVAR *c) {

  CVAR *t;

  if (!c || !IS_CVAR (c)) return;

  if (c -> members && IS_CVAR(c -> members)) {
    for (t = c -> members; t -> next; t = t -> next)
      ;
    while (t -> prev) {
      t = t -> prev;
      _delete_cvar (t -> next);
    }
    _delete_cvar (t);
  }

  free (c);

}

/*
 *  Check that the operand types match.  If they don't,
 *  promote the operand.  If the operand is a dictionary object,
 *  then create a temporary object with the correct class.
 *
 *  The order of promoting variables follows C99 as closely
 *  as possible.
 *
 *    1. If either operand class is, "Float," then cast the
 *       other operand to, "Float," if necessary.
 *    2. If the operands are of different integer classes, 
 *       then promote the operand with the lesser precision
 *       to the class of the operand with the greater precision,
 *       e.g.,
 *
 *         Character -> Integer -> LongInteger
 *
 *  Characters in this context always get promoted to Integers.
 *
 *  The function takes message pointers as arguments, in case it
 *  needs to substitute an object.
 *
 *  TO DO - Do not hardcode the class and superclass names.
 */

/* #define OP1_OBJ (M_VALUE_OBJ (messages[op1_ptr])) */
/* #define OP2_OBJ (M_VALUE_OBJ (messages[op2_ptr])) */

/* int match_math_operands (MESSAGE_STACK messages, int op1_ptr, int op2_ptr) { */

/*   OBJECT *op1_val_obj,  */
/*     *op2_val_obj; */

  /*
   *  The object should already have a value defined.
   */

/*   if (((op1_val_obj = __ctalkGetInstanceVariable (OP1_OBJ, "value", FALSE)) */
/*        == NULL) || */
/*       ((op2_val_obj = __ctalkGetInstanceVariable (OP2_OBJ, "value", FALSE)) */
/*        == NULL)) { */
/*     _warning ("match_operand_type: undefined value.\n"); */
/*     return ERROR; */
/*   } */

  /*
   *   Promote Character class to Integers.
   */

/*   if (!strcmp (op1_val_obj -> __o_classname, "Character")) */
/*     __set_left_operand_value (messages, op1_ptr, char_to_int (OP1_OBJ)); */
/*   if (!strcmp (op2_val_obj -> __o_classname, "Character")) */
/*     __set_right_operand_value (messages, op2_ptr, char_to_int (OP2_OBJ)); */

  /*
   *  Get the new value objects.
   */

/*   if (((op1_val_obj = __ctalkGetInstanceVariable (OP1_OBJ, "value", FALSE)) */
/*        == NULL) || */
/*       ((op2_val_obj = __ctalkGetInstanceVariable (OP2_OBJ, "value", FALSE)) */
/*        == NULL)) { */
/*     _warning ("match_operand_type: undefined value.\n"); */
/*     return ERROR; */
/*   } */

  /*
   *  If the objects are of the same class, then we don't
   *  need to do anything.
   */

/*   if (!strcmp (op1_val_obj -> __o_classname, op2_val_obj -> __o_classname)) */
/*     return SUCCESS; */

  /*
   *  If the operand is a method that is not a math op, then check 
   *  the receiver.  In that case, OP1_OBJ should be the value 
   *  object of the receiver, because methods
   *  that are not math ops have higher precedence.
   *
   *  This is the case for expressions like, "myString length - 1."
   */
/*   if (messages[op1_ptr] -> tokentype == METHODMSGLABEL) { */
/*     int rcvr_ptr, */
/*       stack_start; */

/*     stack_start = __rt_get_stack_top (messages); */
/*     rcvr_ptr = __ctalkPrevLangMsg (messages, op1_ptr, stack_start); */
/*     op1_ptr = rcvr_ptr; */
/*   } */

  /*
   *  The operand classes here should be, "Integer", "LongInteger", or 
   *  their subclasses.
   *  TO DO - Add a superclass lookup.
   *
   *  Otherwise, generate a type mismatch warning.
   */

/*   if ((strcmp (OP1_OBJ -> __o_classname, "Integer") && */
/*        strcmp (OP1_OBJ -> __o_classname, "LongInteger")) || */
/*       (strcmp (OP2_OBJ -> __o_classname, "Integer") && */
/*        strcmp (OP2_OBJ -> __o_classname, "LongInteger"))) { */
/*     char *__s = NULL;  /\* Avoid a warning. *\/ */
/*     __s = expr_text (__s);  */
/*     _warning ("warning: type mismatch: %s.\n", __s); */
/*     free (__s); */
/*     return ERROR; */
/*   } */

/*   if (!strcmp (OP1_OBJ -> __o_classname, "LongInteger")) */
/*     __set_left_operand_value (messages, op1_ptr, int_to_longint (OP1_OBJ)); */
/*   if (!strcmp (OP2_OBJ -> __o_classname, "LongInteger")) */
/*     __set_right_operand_value (messages, op2_ptr, int_to_longint (OP2_OBJ)); */

/*   return SUCCESS; */
/* } */

/*
 *  TO DO - Int_to_longint () is easy, all we have to do is 
 *  create a new object with the promoted class.  But we
 *  should add range checking, and, again, not hardcode the 
 *  class and superclass names.
 */

OBJECT *int_to_longint (OBJECT *int_obj) {

  OBJECT *longInt_obj,
    *longInt_value_obj,
    *int_value_obj;

  if ((int_value_obj = __ctalkGetInstanceVariable(int_obj, "value", FALSE))
      == NULL) {
    _warning ("int_to_longint: undefined value.\n");
    return NULL;
  }

  longInt_obj = __ctalkCreateObjectInit (int_value_obj -> __o_value, 
					    "LongInteger", 
					    "Magnitude", 
					    int_value_obj -> scope,
					    int_value_obj -> __o_value);
  longInt_obj -> nrefs = int_obj -> nrefs;
  longInt_value_obj = __ctalkGetInstanceVariable(longInt_obj, "value", FALSE);
  longInt_value_obj -> nrefs = int_value_obj -> nrefs;

  return longInt_obj;
}

OBJECT *char_to_int (OBJECT *char_obj) {

  OBJECT *char_value_obj,
    *int_obj,
    *int_value_obj;
  int int_val;
  char int_val_buf[MAXMSG];

  if ((char_value_obj = __ctalkGetInstanceVariable(char_obj, "value", FALSE))
      == NULL) {
    _warning ("char_to_int: undefined value.\n");
    return NULL;
  }
      
  /*
   *   Check for a character value enclosed in single quotes.
   */
  if (*char_value_obj -> __o_value == '\'') {
    substrcpy (int_val_buf, char_value_obj -> __o_value, 1, 1);
    int_val = (int)*int_val_buf;
  } else {
    int_val = (int)*char_value_obj -> __o_value;
  }
  sprintf (int_val_buf, "%d", int_val);

  int_obj = __ctalkCreateObjectInit (int_val_buf, "Integer", 
					"Magnitude", char_value_obj -> scope,
					int_val_buf);
  int_obj -> nrefs = char_obj -> nrefs;
  int_value_obj = __ctalkGetInstanceVariable(int_obj, "value", FALSE);
  int_value_obj -> nrefs = char_value_obj -> nrefs;

  return int_obj;
}

CVAR *__ctalkCopyCVariable (CVAR *c) {

  CVAR *t, *p, *mbr, *mbr_ptr = NULL;  /* Avoid a warning. */

  _new_cvar (CVARREF(t));
  memcpy ((void *)t, (void *)c, (int)&((CVAR *)0)->val);

  for (p = c -> members; p; p = p -> next) {
    mbr = __ctalkCopyCVariable (p);
    if (! t -> members) {
      t -> members = mbr_ptr = mbr;
    } else {
      mbr_ptr -> next = mbr;
      mbr -> prev = mbr_ptr;
      mbr_ptr = mbr_ptr -> next;
    }
  }
  return t;
}

/*
 *  If the label following an aggregate type is a method
 *  message, set the label token type to METHODMSGLABEL.
 *
 *  Call with rcvr_ptr pointing to the last token of the 
 *  aggregate variable.
 */
int __resolve_aggregate_method (MESSAGE_STACK messages, int rcvr_ptr) {

  int stack_end,
    stack_start,
    lookahead;

  stack_end = __rt_get_stack_end (messages);
  stack_start = __rt_get_stack_top (messages);

  if ((lookahead = __ctalkNextLangMsg (messages, rcvr_ptr, stack_end))
      != ERROR) {
    if (messages[lookahead] -> tokentype == LABEL) {
      if (__ctalk_isMethod (messages[lookahead] -> name, 
			    messages, lookahead, stack_start, stack_end)) {
	messages[lookahead] -> tokentype = METHODMSGLABEL;
	return TRUE;
      }
    }
  }
  return FALSE;
}

CVAR *__get_rt_typedef (char *name) {
  CVAR *t;
  for (t = typedefs; t; t = t -> next)
    if (!strcmp (t -> name, name))
      return t;
  return NULL;
}

OBJECT *__caller_tmp_cvar_object = NULL;
OBJECT *__caller_tmp_cvar_object_ptr = NULL;

extern RT_INFO *__call_stack[MAXARGS+1];
extern int __call_stack_ptr;

OBJECT *__ctalkGetTemplateCallerCVAR (char *name) {

  RT_FN *__cfn;
  RT_INFO *__r;
  CVAR *__lcvar = NULL;  /* Avoid a warning. */
  OBJECT *__t, *__c, *__method_rcvr_obj;
  OBJECT *(*__method_fn)(void);
  char __s[MAXLABEL];
  int __calling_fn_or_method_ptr;
  MESSAGE *m;  /* This fn uses m_print_val for val-to-string conversion. */
  METHOD *__calling_method;

  __ctalkTemplateCallerCVARCleanup ();

  *__s = 0; 
  __calling_fn_or_method_ptr = __get_call_stack_ptr () + 2;
  if (__calling_fn_or_method_ptr <= MAXARGS) {
    if ((__cfn = __call_stack[__call_stack_ptr+2]->_rt_fn) != NULL) {
      /*   if ((__cfn = get_fn ()) != NULL) { */
      for (__lcvar = __cfn -> local_cvars; __lcvar && (*__s == 0); 
	   __lcvar = __lcvar -> next) {
	if (!strcmp (__lcvar -> name, name)) {
	  __ctalkCVARReturnClass (__lcvar, __s);
	  goto found_lcvar;
	}
      }
    }
  }
 found_lcvar:

  if (!*__s && !__lcvar) {
    if ((__calling_method = 
	 __call_stack[__calling_fn_or_method_ptr]->method) != NULL) {
      for (__lcvar = __calling_method -> local_cvars; 
	   __lcvar; __lcvar = __lcvar -> next) {
	if (!strcmp (__lcvar -> name, name)) {
	  __ctalkCVARReturnClass (__lcvar, __s);
	}
      }
    }
  }

  if (!*__s || !__lcvar) {
    _warning ("__ctalkGetTemplateCallerCVAR: calling method or function CVAR %s not found.", name);
    return NULL;
  }

  if ((__c = __ctalkGetClass (__s)) == NULL)
    _error ("__ctalkGetTemplateCallerCVAR: Undefined class %s.\n", __s);
  m = new_message ();
  m_print_val (m, &(__lcvar -> val));
  __t = __ctalkCreateObjectInit (__lcvar -> name, __c -> __o_name,
				 __c -> __o_superclass -> __o_name,
				 LOCAL_VAR,
				 m -> value);
  delete_message (m);
  if (!__caller_tmp_cvar_object_ptr) {
    __caller_tmp_cvar_object = 
      __caller_tmp_cvar_object_ptr = __t;
  } else {
    __caller_tmp_cvar_object_ptr -> next = __t;
    __t -> prev = __caller_tmp_cvar_object_ptr;
    __caller_tmp_cvar_object_ptr = __t;
  }
  return __caller_tmp_cvar_object;
}

void __ctalkTemplateCallerCVARCleanup (void) {

  if (__caller_tmp_cvar_object) {
    if (__caller_tmp_cvar_object == __caller_tmp_cvar_object_ptr) {
      __ctalkDeleteObjectInternal (__caller_tmp_cvar_object);
      __caller_tmp_cvar_object = __caller_tmp_cvar_object_ptr = NULL;
    } else {
      _warning ("__ctalkTemplateCallerCVARCleanup: Multiple CVAR objects.\n");
    }
  }
}

int cvar_object_ref_cleanup (MESSAGE_STACK messages, int idx,
			     int stack_start, int stack_top) {
  MESSAGE *m_idx;
  OBJECT *__t_obj = NULL;
  m_idx = messages[idx];
  if (m_idx -> obj && (m_idx -> obj -> scope & CVAR_VAR_ALIAS_COPY)) {
    __t_obj = m_idx -> obj;
  } else {
    if (m_idx -> value_obj && 
	(m_idx -> value_obj -> scope & CVAR_VAR_ALIAS_COPY)) {
      __t_obj = m_idx -> value_obj;
    }
  }

  if (__t_obj && IS_OBJECT(__t_obj)) {
    if ((__t_obj == messages[stack_start] -> obj) ||
	(__t_obj == messages[stack_start] -> value_obj))
      return SUCCESS;
    if (OBJ_REF_STR(__t_obj -> __o_value)) {
      OBJECT *__r;
      sscanf (__t_obj -> __o_value, "0x%p", &__r);
      __ctalkDeleteObject(__r);
      __t_obj -> __o_value[0] = '\0';
    }
    if(__t_obj -> instancevars && 
       OBJ_REF_STR(__t_obj->instancevars->__o_value)) {
      OBJECT *__r;
      sscanf (__t_obj -> instancevars -> __o_value, "0x%p", &__r);
      __ctalkDeleteObject(__r);
      __t_obj -> instancevars ->__o_value[0] = '\0';
    }
      
    __ctalkDeleteObjectInternal (__t_obj);
  }
  return SUCCESS;
}

int cvar_ref_delete (char *obj_ref_str) {
  OBJECT *__o;
  sscanf (obj_ref_str, "0x%p", &__o);
  if (__o && IS_OBJECT(__o))
    __ctalkDeleteObject(__o);
  return SUCCESS;
}
