/* $Id: primitives.c,v 1.48 2009/02/25 18:09:13 kiesling Exp $ */

/*
  This file is part of Ctalk.
  Copyright  2005-2009 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 <errno.h>
#include "object.h"
#include "message.h"
#include "ctalk.h"
#include "lex.h"
#include "typeof.h"

extern int library_input;   /* Declared in class.c.  TRUE if evaluating */
                            /* class libraries.                         */
extern 
I_PASS interpreter_pass;    /* Declared in main.c.                      */

extern METHOD *new_methods[MAXARGS+1];  /* Declared in lib/rtnwmthd.c. */
extern int new_method_ptr;
extern OBJECT *rcvr_class_obj;

extern HASHTAB declared_method_names;    /* Declared in method.c. */
extern HASHTAB declared_method_selectors;
extern HASHTAB declared_global_variables; /* Declared in cvars.c. */

extern JMP_ENV jmp_env;                   /* Declared in except.c. */
extern int exception_return;

void init_new_method_stack (void) {
  new_method_ptr = MAXARGS;
}

/*
  Set the name to the name of the class, the classname to 
  "Class," and the superclass to the name of the receiver
  object, and add the object to the class dictionary.
*/
OBJECT *define_class (int method_msg_ptr) {

  OBJECT *arg_object;        /* The new class object.          */
  OBJECT *tmp_object;        /* Existing class object, if any. */
  MESSAGE *m;                /* Message of the method call.    */
  MESSAGE *m_receiver;       /* Message of the receiver.       */
  METHOD *method;
  int i;
  int msg_frame_top_ptr;     /* Frame pointers for statement  */
  int next_frame_top_ptr;    /* code generation.              */
  CVAR *cvar_dup;
  char _addr_buf[MAXMSG];

  m = message_stack_at (method_msg_ptr);
  m_receiver = m -> receiver_msg;

  method = get_instance_method (m, m -> receiver_obj, m -> name, TRUE);

  class_primitive_method_args (method, message_stack (), method_msg_ptr);

  if (method -> n_args != method -> n_params)
    error (m, "Method %s: Wrong number of arguments.", m -> name);

  arg_object = method -> args[0];

  if ((tmp_object = get_class_object (arg_object -> __o_name)) != NULL) {
    warning (m, "Redefinition of class, \"%s.\"",
		    arg_object -> __o_name);
    return NULL;
  }

  arg_object -> scope = GLOBAL_VAR;

  sprintf (_addr_buf, "%#x", (unsigned int)arg_object);
  __ctalkSetObjectValue (arg_object, _addr_buf);
  __ctalkSetObjectValueVar (arg_object, _addr_buf);

  add_class_object (arg_object);

  if ((cvar_dup = _hash_remove (declared_global_variables,
				arg_object -> __o_name)) != NULL) {
    unlink_global_cvar (cvar_dup);
    _delete_cvar (cvar_dup);
  }

  /* Generate C code and mark the ctalk statement as
     evaluated and output. */

  generate_primitive_class_definition_call (m_receiver -> obj, method);

  next_frame_top_ptr = message_frame_top_n (parser_frame_ptr () - 1);
  msg_frame_top_ptr = message_frame_top_n (parser_frame_ptr ());

  for (i = msg_frame_top_ptr; i > next_frame_top_ptr; i--) {
    m = message_stack_at (i);
    ++m -> evaled;
    ++m -> output;
  }

  return NULL;
}

/* 
 *  Define a new object.  Make sure the new object has the same 
 *  class as the receiver, and add it to the dictionary.  
 */
OBJECT *new_object (int method_msg_ptr) {

  MESSAGE *m;
  MESSAGE *m_receiver;
  OBJECT *arg_object;      /* Object  from the method arguments, and   */
  OBJECT *tmp_object;      /* possibly existing in the dictionary.     */
  int arg_ptr;             /* Stack index of argument.                 */
  MESSAGE *m_arg;          /* Message of argument.                     */
  METHOD *method,          /* Actual method used to generate the object*/
    *method_orig;          /* and the original method.                 */
  char buf[MAXLABEL];
  int i;
  int attrs;
  int prev_tok_idx;
  int msg_frame_top_ptr;     /* Frame pointers for statement  */
  int next_frame_top_ptr;    /* code generation.              */
  Boolean arg_is_param;
  Boolean orig_method_replaces_primitive;
  CVAR *tmp_cvar;

  m = message_stack_at (method_msg_ptr);
  m_receiver = m -> receiver_msg;
  arg_is_param = False;

  method_orig = get_instance_method (m, m -> receiver_obj, m -> name, TRUE);
  method = method_replaces_primitive (method_orig, m -> receiver_obj);
  orig_method_replaces_primitive = (method != method_orig) ? True : False;

  if ((arg_ptr = nextlangmsg (message_stack (), method_msg_ptr))
      == ERROR)
    _error ("new_object (): Argument %s message not found.",
	    method -> args[0] -> __o_name);

  m_arg = message_stack_at (arg_ptr);

  if ((!m_arg || !IS_MESSAGE (m_arg)) ||
      (!m_arg -> obj || !IS_OBJECT (m_arg -> obj)) ||
      (strcmp (m_arg -> obj -> __o_name, method -> args[0] -> __o_name)) ||
      (strcmp (m_arg -> obj -> __o_classname, method -> args[0] -> __o_classname)))
    warning (m_arg, "new_object (): Argument mismatch.");

  /*
   *  This method has a variable number of arguments,
   *  but the function should check here that the 
   *  method is okay.
   */

  if (!method -> varargs || (method -> n_args < method -> n_params))
    error (m, "%s: Wrong number of arguments.", m -> name);

  if (interpreter_pass == method_pass) {
    METHOD *n_method;
    n_method = new_methods[new_method_ptr + 1];
    for (i = 0; i < n_method -> n_params; i++) {
      if (!strcmp (M_NAME(m_arg), n_method -> params[i] -> name)) {
	method -> args[i] = method_arg_object (m_arg);
 	arg_is_param = True;
      }
    }
  }

  arg_object = method -> args[0];

  /*
   *  The case of a global object registered as a CVAR
   *  based on syntax while C variables are being registered.
   */
  if ((tmp_cvar = _hash_remove (declared_global_variables, 
				arg_object -> __o_name)) != NULL) {
    unlink_global_cvar (tmp_cvar);
    _delete_cvar (tmp_cvar);
  }

  if (!arg_object || !IS_OBJECT (arg_object)) {
    error (m_arg, "Method \"%s\": invalid argument.", method -> name);
  } else {
    if (!arg_is_param)
      strcpy (arg_object -> __o_classname, m_receiver -> obj -> __o_name);
    arg_object -> scope = parser_frame_scope ();
    /* Make sure an object of this class does not already exist. */
    if ((tmp_object = get_object (arg_object -> __o_name, 
				  m_receiver -> obj -> __o_name)) != NULL) {
      if (tmp_object != arg_object) {
	error (m_arg, "Redefinition of object, \"%s.\"", 
	       arg_object -> __o_name);
      } else {
	goto new_object_cleanup;
      }
    }
    /*
     *  This is the same as __ctalkInstanceVariableFromClassObject.
     */
    if (!arg_is_param) {
      instance_variables_from_class_definition (arg_object);
    }

    add_object (arg_object);
    m_receiver -> value_obj = arg_object;
  }
  
  attrs = 0;

  /*
   *  Note that compound_method () does not work here, because
   *  method_msg_ptr points to, "new," and not, "super," if it
   *  is present.
   */
  if ((prev_tok_idx = prevlangmsg (message_stack (), method_msg_ptr)) == ERROR)
    _error ("Parser error.\n");
  if (!strcmp (M_NAME(message_stack_at (prev_tok_idx)), "super"))
    attrs |= METHOD_SUPER_ATTR;

  if (orig_method_replaces_primitive) {
    for (i = 0; i < method -> n_args; i++) {
      method_orig -> args[i] = method -> args[i];
      method_orig -> n_args++;
    }
  }

  if (orig_method_replaces_primitive) {
    /*
     *  Super method calls.  This should handle the cases where the 
     *  superclass method is either an actual method or a primitive.
     */
    OBJECT *method_receiver;
    METHOD *m_t;
    Boolean have_match = False;

    for (m_t = m_receiver->obj -> instance_methods; m_t; m_t = m_t -> next){
      if (method_orig == m_t) {
	have_match = True;
	generate_method_call_from_primitive (m_receiver->obj, 
					     method_orig, buf, attrs);
      }
    }
    if (!have_match) {
      for (method_receiver = 
	     get_class_object(m_receiver -> obj -> __o_superclassname);
	   method_receiver && method_receiver -> __o_superclassname 
	     && !have_match;
	   method_receiver = 
	     get_class_object(method_receiver -> __o_superclassname)) {
	for (m_t = method_receiver -> instance_methods; m_t && !have_match;
	     m_t = m_t -> next) 
	  if (method_orig == m_t) {
	    generate_method_call_from_primitive (method_receiver,
						 method_orig, buf, attrs);
	    have_match = True;
	  }
      }
    }
  } else {
    generate_primitive_method_call (m_receiver->obj, method, buf, attrs);
  }
 
  if (is_global_frame ())
    generate_set_global_variable_call (arg_object -> __o_name, 
				       arg_object -> __o_classname);
  else
    generate_set_local_variable_call (arg_object -> __o_name, 
				      m_receiver -> obj -> __o_name);

 new_object_cleanup:
  next_frame_top_ptr = message_frame_top_n (parser_frame_ptr () - 1);
  msg_frame_top_ptr = message_frame_top_n (parser_frame_ptr ());

  for (i = msg_frame_top_ptr; i > next_frame_top_ptr; i--) {
    m = message_stack_at (i);
    if (m -> tokentype != NEWLINE) {
      ++m -> evaled;
      ++m -> output;
    }
  }

  /*
   *  Should be factored into cleanup_args () at some time.
   */
  if (orig_method_replaces_primitive) {
    for (i = 0; i < method -> n_args; i++) {
      method_orig -> args[i] = NULL;
    }
    method_orig -> n_args = 0;
  }
  return NULL;
}

/*
 *  Define a new method from source file or class library.
 *
 *    Method declarations have either one or two 
 *    arguments after the method. 
 *
 *      <Class> method <function> (<args>) {<body>}
 *
 *    or 
 *
 *      <Class> method <alias> <function> (<args>) {<body>}
 *
 *    The <function> element must be a valid C identifier.
 * 
 *    Methods when imported and translated into C have the
 *    following prototype in the generated code:
 * 
 *      OBJECT *<function> (<args>) {<body>}
 *   
 */

/*
 *   Values that need to be available when parsing the
 *   method.  We need to stack the new methods when 
 *   parsing methods recursively.
 */
/*
 *  Used in library_search () to set and restore receiver classes when
 *  recursing into another class library.  get_rcvr_class_obj () must
 *  be called before parse (), and set_rcvr_class_obj () for the previous
 *  level after output_imported_methods ().
 */

OBJECT *get_rcvr_class_obj (void) {
  return rcvr_class_obj;
}

void set_rcvr_class_obj (OBJECT *o) {
  rcvr_class_obj = o;
}

OBJECT *new_instance_method (int method_msg_ptr) {

  int rcvr_ptr,           /* Index of the class message, which is the
			     same class as the method message's receiver 
			     object.                                       */
    param_start_ptr,      /* Index of parameter start.                     */
    param_end_ptr,        /* Index of parameter end.                       */
    method_start_ptr,     /* Index of function body open block.            */
    alias_ptr,      /* Index of the method alias, if any.           */
    funcname_ptr,   /* Index of the function name.                  */
    method_end_ptr, /* End of the method body.                      */
    i,
    n_params,  /* Number of parameters in declaration.                */
    buflength;
  char *tmpbuf,     /* Buffer for collected method body tokens.       */
    *srcbuf,      /* Buffer for method with translated declaration. */
    funcname[MAXLABEL],
    alias[MAXLABEL],
    *params[MAXARGS],
    c_param[MAXMSG];
  MESSAGE *m_method, /* Message of the, "method," keyword. */
    *m_rcvr;         /* Message of the class object receiver. */
  I_PASS prev_pass;
  METHOD  *n_method,
    *tm,
    *rcvr_method;
  int have_c_param = 0;
  CFUNC *__shadowed_c_fn;
  CVAR *__cvar_dup;

  char tmpname[FILENAME_MAX],  /* For method buffering. */
    *x_srcbuf;
  int x_src_size,
    x_chars_read;
  int param_class_exception;

  m_method = message_stack_at (method_msg_ptr);

  if (!m_method -> receiver_obj || !IS_OBJECT (m_method -> receiver_obj))
    error (m_method, "new_instance_method: Undefined receiver object.");

  if ((rcvr_ptr = prevlangmsg (message_stack (), method_msg_ptr)) == ERROR)
    error (m_method, "new_instance_method: can't find class object declaration.");

  m_rcvr = message_stack_at (rcvr_ptr);

  if ((strcmp (m_rcvr -> name, m_method -> receiver_obj -> __o_name)) ||
      (m_rcvr -> obj != m_method -> receiver_obj))
    error (m_method, "new_instance_method: receiver mismatch error.");

  rcvr_class_obj = m_rcvr -> obj;

  if (strcmp (rcvr_class_obj -> __o_classname, "Class"))
    error (m_method, "new_instance_method: Receiver %s is not a class object.",
	   rcvr_class_obj -> __o_name);

  /* 
   *  Find the number of args required by the method declaration.
   *  TO DO - Determine if we can use method_declaration_info ()
   *  here also - we only need n_params here.
   */

  if ((method_end_ptr = find_function_close (message_stack (), method_msg_ptr))
      == ERROR) {
    int e_prev_idx, e_next_idx;
    MESSAGE *m_error_rcvr, *m_error_name;
    if ((e_prev_idx = prevlangmsg (message_stack(), 
				   method_msg_ptr)) != ERROR) {
      m_error_rcvr = message_stack_at (e_prev_idx);
    } else {
      m_error_rcvr = NULL;
    }
    if ((e_next_idx = nextlangmsg (message_stack(), 
				   method_msg_ptr)) != ERROR) {
      m_error_name = message_stack_at (e_next_idx);
    } else {
      m_error_name = NULL;
    }
    error (m_method, "%s method %s : Can't find method close.",
	   (m_error_rcvr ? M_NAME(m_error_rcvr) : ""), 
	   (m_error_name ? M_NAME(m_error_name) : ""));
  }

  if ((param_start_ptr = 
       scanforward (message_stack (), method_msg_ptr,
		    method_end_ptr, OPENPAREN)) == ERROR)
    error (m_method, "Missing parameters in method declaration.");

  if ((param_end_ptr = scanforward (message_stack (), param_start_ptr,
				    method_end_ptr, CLOSEPAREN)) == ERROR)
    error (m_method, "Missing parameters in method declaration.");

  if ((method_start_ptr = scanforward (message_stack (), param_start_ptr,
				    method_end_ptr, OPENBLOCK)) == ERROR)
    error (m_method, "Missing start of method body.");


  if ((n_method = (METHOD *)calloc (1, sizeof (METHOD))) == NULL)
    _error ("new_instance_method: %s.", strerror (errno));
  strcpy (n_method -> sig, "METHOD");

  new_methods[new_method_ptr--] = n_method;

  fn_param_declarations (message_stack (), param_start_ptr, param_end_ptr,
			       params, &n_params);

  /*
   *   Reversing the order of the parameters here helps to 
   *   ensure that the run-time code pushes the arguments 
   *   in the correct order for nested method calls.
   */
  n_method -> n_params = n_params;
  for (i = n_params - 1, param_class_exception = ERROR; i >= 0; i--) {
    /* TO DO - Possibly add error checking in method_param (). 
       See the comment below. */
    /* TO DO - Make sure that method_param has the correct
       error line, column, and source file name. */
    n_method -> params[i] = method_param (params[i]);

    if (! param_class_exists (n_method -> params[i] -> class)) {
      /*
       *  NOTE - This should be handled as an exception in
       *  a future release.
       */
      param_class_exception = i;
    }
    if ((i == 0) && 
	(n_method -> params[i] -> attrs & PARAM_C_PARAM)) {
      char *s;
      s = strchr (params[i], ' ');
      have_c_param = TRUE;
      strcpy (c_param, s);
    }
    if (n_method -> params[i] -> attrs & PARAM_VARARGS_PARAM)
      n_method -> varargs = TRUE;
    free (params[i]);
  }

  method_declaration_msg (message_stack (), method_msg_ptr, param_start_ptr, 
			  funcname, &funcname_ptr, 
			  alias, &alias_ptr);

  if (method_proto_is_output (rcvr_class_obj -> __o_name, funcname)) {
    for (i = rcvr_ptr; i >= method_end_ptr; i--) {
      MESSAGE *m;
      m = message_stack_at (i);
      ++m -> evaled;
      ++m -> output;
    }
    for (i = 0; i < n_method -> n_params; i++) {
      free (n_method -> params[i]);
    }
    free (n_method);
    new_methods[++new_method_ptr] = NULL;
    return NULL;
  }

#ifdef DEBUG_UNDEFINED_PARAMETER_CLASSES
  if (param_class_exception != ERROR)
    warning (message_stack_at (method_msg_ptr),
	     "Undefined parameter class %s. (Method %s, Class %s).",
	     n_method -> params[param_class_exception] -> class,
	     ((*alias) ? alias : funcname),
	     rcvr_class_obj -> __o_name);
#endif

  strcpy (n_method -> name, ((*alias) ? alias : funcname));
  n_method -> n_args = 0;
  n_method -> error_line = m_method -> error_line;
  n_method -> error_column = m_method -> error_column;
  /* This is a kludge - all methods are marked as imported,
     until we can get the method buffering straightened out. */
  n_method -> imported = True;
  n_method -> queued = False;
  
  sprintf (n_method -> selector, "%s%s%s", 
	   rcvr_class_obj -> __o_name, INSTANCE_SELECTOR, funcname);

  strcpy (n_method -> returnclass, rcvr_class_obj -> __o_name);

  for (rcvr_method = rcvr_class_obj -> instance_methods; rcvr_method;
       rcvr_method = rcvr_method -> next) {
    if (!strcmp (rcvr_method -> name, n_method -> name)) {
      warning (m_method, "Redefinition of method, \"%s.\" (Class %s).",
	     n_method -> name, rcvr_class_obj -> __o_name);
      new_methods[new_method_ptr++] = NULL;
      free (n_method);
      return NULL;
    }
  }

  generate_instance_method_definition_call (rcvr_class_obj -> __o_name,
				   ((*alias) ? alias : funcname),
				   n_method -> selector, n_params);

  for (i = 0; i < n_params; i++) {
    if (!(n_method -> params[i] -> attrs & PARAM_C_PARAM))
      generate_instance_method_param_definition_call (rcvr_class_obj -> __o_name,
					   ((*alias) ? alias : funcname),
					   n_method -> params[i] -> name,
					   n_method -> params[i] -> class,
					   n_method -> params[i] -> is_ptr,
					   n_method -> params[i] -> is_ptrptr
					   );
  }

  if ((__cvar_dup = _hash_remove (declared_global_variables, 
				  n_method -> name)) != NULL) {
    warning (message_stack_at(method_msg_ptr),
	     "Method %s shadows a global variable.", n_method -> name);
    unlink_global_cvar (__cvar_dup);
    _delete_cvar (__cvar_dup);
  }

  if ((__shadowed_c_fn = get_function (n_method -> name)) != NULL) {
      warning (message_stack_at(method_msg_ptr), 
	       "Method %s shadows a function.", n_method -> name);
  }

  /* Collect tokens from the end of the ctalk declaration to the end of
     the method.
  */

  tmpbuf = 
    collect_tokens (message_stack (), method_start_ptr, method_end_ptr);

  if (have_c_param) {
    buflength = strlen (METHOD_RETURN) + strlen (" ") + 
      strlen (c_param) + strlen (" ( ) ") + 
      strlen (n_method -> selector) + strlen (" ") + strlen (tmpbuf);
  } else {
    buflength = strlen (METHOD_RETURN) + strlen (" ") + 
      strlen (METHOD_C_PARAM) + strlen (" ") + 
      strlen (n_method -> selector) + strlen (" ") + strlen (tmpbuf);
  }

  if ((srcbuf = (char *)calloc (buflength + 1, sizeof (char))) == NULL)
    _error ("new_instance_method: %s.", strerror (errno));

  if (n_method -> params[0] &&
      (n_method -> params[0] -> attrs & PARAM_C_PARAM)) {
    sprintf (srcbuf, "%s %s (%s) %s", METHOD_RETURN, n_method -> selector,
 	     c_param, tmpbuf);
   } else {
    sprintf (srcbuf, "%s %s %s %s", METHOD_RETURN, n_method -> selector, 
	     METHOD_C_PARAM, tmpbuf);
   }

  prev_pass = interpreter_pass;
  interpreter_pass = method_pass;

  /*
    TO DO -
    1. Make sure that methods can be resolved as externs - and also
       class declarations, which might be initialized in a method's
       init block.
  */

  create_tmp ();
  begin_method_buffer (n_method);
  parse (srcbuf, (long long) strlen (srcbuf));
  end_method_buffer ();
  unbuffer_method_statements ();

  close_tmp ();
  generate_instance_method_return_class_call (rcvr_class_obj -> __o_name,
				     n_method -> name, 
				     n_method -> returnclass);
  strcpy (tmpname, get_tmpname ());
  x_src_size = file_size (tmpname);
  if ((x_srcbuf = (char *) calloc (x_src_size + 1, sizeof (char))) == NULL)
    error (m_method, "new_instance_method %s (class %s): %s.",
	   n_method -> name, rcvr_class_obj -> __o_name,
	   strerror (errno));
#ifdef __DJGPP__
  errno = 0;
  x_chars_read = read_file (x_srcbuf, tmpname);
  if (errno)
    error (m_method, "new_instance_method %s (class %s): %s.",
	   n_method -> name, rcvr_class_obj -> __o_name,
	   strerror (errno));
#else
  if ((x_chars_read = read_file (x_srcbuf, tmpname)) != x_src_size)
    error (m_method, "new_instance_method %s (class %s): %s.",
	   n_method -> name, rcvr_class_obj -> __o_name,
	   strerror (errno));
#endif
  n_method -> src = strdup (x_srcbuf);
  free (x_srcbuf);

  queue_method_for_output (rcvr_class_obj -> __o_name, n_method);
  if (!library_input) {

    /* Replace the unevaled method's tokens with whitespace so
       the parent parser doesn't evaluate the method body again. */
    /* TO DO - 
       Inform the parent parser simply to skip the frames of the 
       source method, if possible, without adding another state to 
       the parser. */
    for (i = rcvr_ptr; i >= method_end_ptr; i--) {
      MESSAGE *m_tmp;
       m_tmp = message_stack_at (i);
       if ((m_tmp -> tokentype != WHITESPACE) && 
	   (m_tmp -> tokentype != NEWLINE)) {
	 m_tmp -> tokentype = WHITESPACE;
	 strcpy (m_tmp -> name, " ");
       }
    }
  }

  unlink_tmp ();

  if (rcvr_class_obj -> instance_methods == NULL) {
    rcvr_class_obj -> instance_methods = n_method;
  } else {
    for (tm = rcvr_class_obj -> instance_methods; tm -> next; tm = tm -> next)
      ;
    tm -> next = n_method;
    n_method -> prev = tm;
  }
  _hash_put (declared_method_names, n_method -> name, n_method -> name);
  _hash_put (declared_method_selectors, n_method -> selector, n_method -> selector);
  interpreter_pass = prev_pass;

  new_methods[++new_method_ptr] = NULL;
  
  for (i = rcvr_ptr; i >= method_end_ptr; i--) {
    MESSAGE *m;
    m = message_stack_at (i);
    ++m -> evaled;
    ++m -> output;
  }


  free (srcbuf);
  free (tmpbuf);

  return NULL;
}

OBJECT *new_class_method (int method_msg_ptr) {

  int rcvr_ptr,           /* Index of the class message, which is the
			     same class as the method message's receiver 
			     object.                                       */
    param_start_ptr,      /* Index of parameter start.                     */
    param_end_ptr,        /* Index of parameter end.                       */
    method_start_ptr,     /* Index of function body open block.            */
    alias_ptr,      /* Index of the method alias, if any.           */
    funcname_ptr,   /* Index of the function name.                  */
    method_end_ptr, /* End of the method body.                      */
    i,
    n_params,  /* Number of parameters in declaration.                */
    buflength;
  char *tmpbuf,     /* Buffer for collected method body tokens.       */
    *srcbuf,      /* Buffer for method with translated declaration. */
    funcname[MAXLABEL],
    alias[MAXLABEL],
    *params[MAXARGS];
  MESSAGE *m_method, /* Message of the, "method," keyword. */
    *m_rcvr;         /* Message of the class object receiver. */
  I_PASS prev_pass;
  METHOD  *n_method,
    *tm,
    *rcvr_method;
  CFUNC *__c_fn;
  CVAR *__cvar_dup;

  char tmpname[FILENAME_MAX],  /* For method buffering. */
    *x_srcbuf;
  int x_src_size,
    x_chars_read;
  int param_class_exception;

  m_method = message_stack_at (method_msg_ptr);

  if (!m_method -> receiver_obj || !IS_OBJECT (m_method -> receiver_obj))
    error (m_method, "new_class_method: Undefined receiver object.");

  if ((rcvr_ptr = prevlangmsg (message_stack (), method_msg_ptr)) == ERROR)
    error (m_method, "new_class_method: can't find class object declaration.");

  m_rcvr = message_stack_at (rcvr_ptr);

  if ((strcmp (m_rcvr -> name, m_method -> receiver_obj -> __o_name)) ||
      (m_rcvr -> obj != m_method -> receiver_obj))
    error (m_method, "new_class_method: receiver mismatch error.");

  rcvr_class_obj = m_rcvr -> obj;

  if (strcmp (rcvr_class_obj -> __o_classname, "Class"))
    error (m_method, "new_class_method: Receiver %s is not a class object.",
	   rcvr_class_obj -> __o_name);

  /* 
   *  Find the number of args required by the method declaration.
   *  TO DO - Determine if we can use method_declaration_info ()
   *  here also - we only need n_params here.
   */

  if ((method_end_ptr = find_function_close (message_stack (), method_msg_ptr))
      == ERROR)
    error (m_method, "new_class_method: can't find function close.");

  if ((param_start_ptr = 
       scanforward (message_stack (), method_msg_ptr,
		    method_end_ptr, OPENPAREN)) == ERROR)
    error (m_method, "Missing parameters in method declaration.");

  if ((param_end_ptr = scanforward (message_stack (), param_start_ptr,
				    method_end_ptr, CLOSEPAREN)) == ERROR)
    error (m_method, "Missing parameters in method declaration.");

  if ((method_start_ptr = scanforward (message_stack (), param_start_ptr,
				    method_end_ptr, OPENBLOCK)) == ERROR)
    error (m_method, "Missing start of method body.");


  if ((n_method = (METHOD *)calloc (1, sizeof (METHOD))) == NULL)
    _error ("new_class_method: %s.", strerror (errno));
  strcpy (n_method -> sig, "METHOD");

  new_methods[new_method_ptr--] = n_method;

  fn_param_declarations (message_stack (), param_start_ptr, param_end_ptr,
			       params, &n_params);

  /*
   *   Reversing the order of the parameters here helps to 
   *   ensure that the run-time code pushes the arguments 
   *   in the correct order for nested method calls.
   */
  n_method -> n_params = n_params;
  for (i = n_params - 1, param_class_exception = ERROR; i >= 0; i--) {
    /* TO DO - Possibly add error checking in method_param (). 
       See the comment below. */
    /* TO DO - Make sure that method_param has the correct
       error line, column, and source file name. */
    n_method -> params[i] = method_param (params[i]);

    if (! param_class_exists (n_method -> params[i] -> class)) {
      /*
       *  NOTE - This should be handled as an exception in
       *  a future release.
       */
      param_class_exception = i;
    }

    free (params[i]);
  }

  method_declaration_msg (message_stack (), method_msg_ptr, param_start_ptr, 
			  funcname, &funcname_ptr, 
			  alias, &alias_ptr);

#ifdef DEBUG_UNDEFINED_PARAMETER_CLASSES
  if (param_class_exception != ERROR)
    warning (message_stack_at (method_msg_ptr),
	     "Undefined parameter class %s. (Method %s, Class %s).",
	     n_method -> params[param_class_exception] -> class,
	     ((*alias) ? alias : funcname),
	     rcvr_class_obj -> __o_name);
#endif

  strcpy (n_method -> name, ((*alias) ? alias : funcname));
  n_method -> n_args = 0;
  n_method -> error_line = m_method -> error_line;
  n_method -> error_column = m_method -> error_column;
  n_method -> imported = True;
  n_method -> queued = False;
  
  sprintf (n_method -> selector, "%s%s%s", 
	   rcvr_class_obj -> __o_name, CLASS_SELECTOR, funcname);

  strcpy (n_method -> returnclass, rcvr_class_obj -> __o_name);

  for (rcvr_method = rcvr_class_obj -> instance_methods; rcvr_method;
       rcvr_method = rcvr_method -> next) {
    if (!strcmp (rcvr_method -> name, n_method -> name)) {
      error (m_method, "Redefinition of method, \"%s.\" (Class %s).",
	     n_method -> name, rcvr_class_obj -> __o_name);
    }
  }

  generate_class_method_definition_call (rcvr_class_obj -> __o_name,
				   ((*alias) ? alias : funcname),
				   n_method -> selector, n_params);

  for (i = 0; i < n_params; i++) 
    generate_instance_method_param_definition_call (rcvr_class_obj -> __o_name,
					   ((*alias) ? alias : funcname),
					   n_method -> params[i] -> name,
					   n_method -> params[i] -> class,
					   n_method -> params[i] -> is_ptr,
					   n_method -> params[i] -> is_ptrptr
					   );

  if ((__cvar_dup = _hash_remove (declared_global_variables,
				  n_method -> name)) != NULL) {
    warning (message_stack_at(method_msg_ptr),
	     "Method %s shadows a global variable.", n_method -> name);
    unlink_global_cvar (__cvar_dup);
    _delete_cvar (__cvar_dup);
  }

  if ((__c_fn = get_function (n_method -> name)) != NULL) {
      warning (message_stack_at(method_msg_ptr), 
	       "Method %s shadows a function.", n_method -> name);
  }

  /* Collect tokens from the end of the ctalk declaration to the end of
     the method.
  */

  tmpbuf = 
    collect_tokens (message_stack (), method_start_ptr, method_end_ptr);

  buflength = strlen (METHOD_RETURN) + strlen (" ") + 
    strlen (METHOD_C_PARAM) + strlen (" ") + 
    strlen (n_method -> selector) + strlen (" ") + strlen (tmpbuf);

  if ((srcbuf = (char *)calloc (buflength + 1, sizeof (char))) == NULL)
    _error ("new_class_method: %s.", strerror (errno));

  sprintf (srcbuf, "%s %s %s %s", METHOD_RETURN, n_method -> selector, 
	   METHOD_C_PARAM, tmpbuf);

  prev_pass = interpreter_pass;
  interpreter_pass = method_pass;

  /*
    TO DO -
    1. Make sure that methods can be resolved as externs - and also
       class declarations, which might be initialized in a method's
       init block.
  */

  create_tmp ();
  begin_method_buffer (n_method);
  parse (srcbuf, (long long) strlen (srcbuf));
  end_method_buffer ();
  unbuffer_method_statements ();
  close_tmp ();
  generate_class_method_return_class_call (rcvr_class_obj -> __o_name,
				     n_method -> name, 
				     n_method -> returnclass);
  strcpy (tmpname, get_tmpname ());
  x_src_size = file_size (tmpname);
  if ((x_srcbuf = (char *) calloc (x_src_size + 1, sizeof (char))) == NULL)
    error (m_method, "new_class_method %s (class %s): %s.",
	   n_method -> name, rcvr_class_obj -> __o_name,
	   strerror (errno));
#ifdef __DJGPP__
  /*
   *  Let read_file handle the error checking.
   */ 
  x_chars_read = read_file (x_srcbuf, tmpname);
#else
  if ((x_chars_read = read_file (x_srcbuf, tmpname)) != x_src_size)
    error (m_method, "new_class_method %s (class %s): %s.",
	   n_method -> name, rcvr_class_obj -> __o_name,
	   strerror (errno));
#endif

  n_method -> src = strdup (x_srcbuf);
  free (x_srcbuf);
  queue_method_for_output (rcvr_class_obj -> __o_name, n_method);
  if (!library_input) {

    /* Replace the unevaled method's tokens with whitespace so
       the parent parser doesn't evaluate the method body again. */
    /* TO DO - 
       Inform the parent parser simply to skip the frames of the 
       source method, if possible, without adding another state to 
       the parser. */
    for (i = rcvr_ptr; i >= method_end_ptr; i--) {
      MESSAGE *m_tmp;
      m_tmp = message_stack_at (i);
      if ((m_tmp -> tokentype != WHITESPACE) && 
	  (m_tmp -> tokentype != NEWLINE)) {
	m_tmp -> tokentype = WHITESPACE;
	strcpy (m_tmp -> name, " ");
      }
    }
  }
  unlink_tmp ();

  if (rcvr_class_obj -> class_methods == NULL) {
    rcvr_class_obj -> class_methods = n_method;
  } else {
    for (tm = rcvr_class_obj -> class_methods; tm -> next; tm = tm -> next)
      ;
    tm -> next = n_method;
    n_method -> prev = tm;
  }
  _hash_put (declared_method_names, n_method -> name, n_method -> name);
  _hash_put (declared_method_selectors, n_method -> selector, n_method -> selector);

  interpreter_pass = prev_pass;

  new_methods[++new_method_ptr] = NULL;
  
  for (i = rcvr_ptr; i >= method_end_ptr; i--) {
    MESSAGE *m;
    m = message_stack_at (i);
    ++m -> evaled;
    ++m -> output;
  }


  free (srcbuf);
  free (tmpbuf);

  return NULL;
}

/*
 *  Create a method parameter from the method declaration.
 *  Automagically translates C param types into the 
 *  equivalent objects.
 *
 *  These functions are also used in fn_tmpl.c.
 *
 *  TO DO - this function might have to return NULL on error.
 */

/*
 *  The preprocesor stack is unused in these passes, so use
 *  it for temporary tokenization.
 */
extern MESSAGE *p_messages[P_MESSAGES+1]; /* Preprocessor message stack. */

PARAM *method_param (char *paramstr) {

  int start_ptr,
    end_ptr,
    i,
    lookahead;
  OBJECT *class_obj;
  MESSAGE *m;
  CVAR *cvar;
  CVAR *__cvar_global_obj;
  PARAM *p;
  char parambuf[MAXMSG];

  /*
   *  End parameter with a semicolon so is_c_var_declaration_msg ()
   *  doesn't return False over an unknown state at the last token.
   */
  sprintf (parambuf, "%s;", paramstr);
  start_ptr = get_stack_top (p_messages);
  end_ptr = tokenize (p_message_push, parambuf);

  p = new_param ();

  for (i = start_ptr; i > end_ptr; i--) {

    m = p_messages[i];

    switch (m -> tokentype) 
      {
      case LABEL:
	if (!strcmp (M_NAME(m), PARAM_C_ARG_ATTR)) {
	  p -> attrs |= PARAM_C_PARAM;
	  continue;
	}
	if (is_c_data_type (M_NAME(m)) ||
	    is_c_derived_type (M_NAME(m)) ||
	    is_incomplete_type (M_NAME(m))) { 
	  /* Map C data types to classes. */
	  /* Check incomplete types for stuff like FILE, __FILE, etc... */
	  if (is_c_var_declaration_msg (p_messages, i, TRUE)) {
	    cvar = __cvar_global_obj = NULL;
 	    cvar = parser_to_cvars ();
 	    strcpy (p -> name, cvar -> name);
 	    p -> n_derefs = cvar -> n_derefs;
	    strcpy (p -> class, basic_class_from_cvar (cvar, 0));
	    if ((__cvar_global_obj = 
		 _hash_remove (declared_global_variables, cvar -> name))
		!= NULL) {
 		unlink_global_cvar (__cvar_global_obj);
		_delete_cvar (__cvar_global_obj);
	    }
	    _delete_cvar (cvar);

	  }
	} else { /* if (is_c_data_type (m -> name)) */
	  /*
	   * We should be able to use the highest level routine
	   * possible here, so we can search for library classes
	   * and local classes in the source text.
	   */
	  if ((class_obj = class_object_search (m -> name)) != NULL) {
	    strcpy (p -> class, m -> name);
	  } else {
	    if (!strcmp (m -> name, "OBJECT")) {
	      strcpy (p -> class, OBJECT_CLASSNAME);
	    } else {
	      if (!(*p -> class)) {
		warning (m, "Undefined parameter class %s, defaulting to Object.\n", m -> name);
		strcpy (p -> class, OBJECT_CLASSNAME);
	      } else {
		strcpy (p -> name, m -> name);
	      }
	    }
	  }
	}
	break;
      case ELLIPSIS:
	strcpy (p -> class, "ArgumentList");
	strcpy (p -> name, m -> name);
	p -> attrs |= PARAM_VARARGS_PARAM;
	break;
      case ASTERISK:
	for (lookahead = i - 1, p -> is_ptrptr = -1; 
	     lookahead > end_ptr; lookahead--) {
	  if ((p_messages[lookahead] -> tokentype == NEWLINE) ||
	      (p_messages[lookahead] -> tokentype == WHITESPACE))
	    continue;
	  if (p_messages[lookahead] -> tokentype != ASTERISK)
	    break;
	  p -> is_ptrptr = TRUE;
	  /*
	   *  Decrement the stack pointer to look past the
	   *  second asterisk on the next iteration.
	   */
	  --i;
	}
	if (p -> is_ptrptr == -1) {
	  p -> is_ptr = TRUE;
	  p -> is_ptrptr = FALSE;
	}
	break;
      default:
	break;
      }
  }

  /* This calls p_message_pop () enought times to remove all of the
     tokens from the stack. */
  for (i = end_ptr; i <= start_ptr; i++)
    delete_message (p_message_pop ());

  return p;
}

int param_class_exists (char *class) {
  if (is_cached_class (class) ||
      is_pending_class (class))
    return TRUE;
  else
    return FALSE;
}

static struct  _var_definition_args {
  char classobjname[MAXLABEL];
  char varname[MAXLABEL];
  char varvalueclassname[MAXLABEL];
  char initial_value[MAXLABEL];
} var_definition_args;

/*
 *  TO DO - It's less confusing to have a stack of these 
 *  than local copies when recursing.
 */
static struct _var_definition_idx {
  int class_obj_name_idx,
    var_name_idx,
    var_value_class_name_idx,
    initial_value_start_idx,
    initial_value_end_idx;
} var_definition_idx;

static char var_value_buf[MAXMSG];
static OBJECT *var_definition (MESSAGE_STACK messages, int idx) {

  int class_ptr, arg_ptr, value_lex_type = 0;  /* Avoid a warning. */
  OBJECT *var_class_object, *v;
  struct _tmp_var_definition_idx {
  int class_obj_name_idx,
    var_name_idx,
    var_value_class_name_idx,
    initial_value_start_idx,
    initial_value_end_idx;
  } tmp_var_definition_idx;

  var_definition_idx.class_obj_name_idx = 
    var_definition_idx.var_name_idx =
    var_definition_idx.var_value_class_name_idx =
    var_definition_idx.initial_value_start_idx =
    var_definition_idx.initial_value_end_idx = ERROR;

  if ((class_ptr = prevlangmsg (messages, idx)) == ERROR) {
    _warning ("Undefined class in var_definition ().\n");
    return NULL;
  }
  strcpy (var_definition_args.classobjname, M_NAME(messages[class_ptr]));
  var_definition_idx.class_obj_name_idx = class_ptr;

  if (((arg_ptr = nextlangmsg (messages, idx)) == ERROR) ||
      (M_TOK(messages[arg_ptr]) == SEMICOLON)) {
    _warning ("Undefined arg in var_definition ().\n");
    return NULL;
  }

  do {
    if (M_TOK(messages[arg_ptr]) == SEMICOLON) break;

    if (var_definition_idx.var_name_idx == ERROR) {
      if (_lextype (M_NAME(messages[arg_ptr])) != PTR_T) {
	warning (messages[idx], "instanceVariable argument syntax error.");
	break;
      }
      var_definition_idx.var_name_idx = arg_ptr;
      continue;
    }

    if (var_definition_idx.var_value_class_name_idx == ERROR) {
      if (_lextype (M_NAME(messages[arg_ptr])) != PTR_T) {
	warning (messages[idx], "instanceVariable argument syntax error.");
	break;
      }
      var_definition_idx.var_value_class_name_idx = arg_ptr;
      value_lex_type = lextype_of_class (M_NAME(messages[arg_ptr]));
      continue;
    }
    
    if (var_definition_idx.initial_value_start_idx == ERROR) {
      VAL result;
      int expr_end_ptr;
      int value_class_name_idx;
      expr_end_ptr = find_declaration_end (messages, arg_ptr);
      ++expr_end_ptr;
      eval_constant_expr (messages, arg_ptr, &expr_end_ptr, &result);
      var_definition_idx.initial_value_start_idx = arg_ptr;
      var_definition_idx.initial_value_end_idx = expr_end_ptr;

      switch (value_lex_type)
	{
	case INTEGER_T:
	  sprintf (var_value_buf, "%d", result.value.i);
	  break;
	case LONGLONG_T:
	  sprintf (var_value_buf, "%lldll", result.value.ll);
	  break;
	case FLOAT_T:
	  sprintf (var_value_buf, "%f", 
		   ((result.value.d != 0) ? result.value.d : 0.0));
	  break;
	case PTR_T:
	  if (var_definition_idx.var_value_class_name_idx != ERROR) {
	    value_class_name_idx = 
	      var_definition_idx.var_value_class_name_idx;
	  } else {
	    value_class_name_idx =
	      var_definition_idx.class_obj_name_idx;
	  }
	  if (!strcmp (M_NAME(messages[value_class_name_idx]), 
		       STRING_CLASSNAME)) {
	    if (result.value.ptr == 0) {
	      strcpy (var_value_buf, NULLSTR);
	    } else {
	      sprintf (var_value_buf, "%s", (char *)result.value.ptr);
	    }
	    while (*var_value_buf == '\"')
	      TRIM_LITERAL (var_value_buf);
	  } else {
	    sprintf (var_value_buf, "%#x", (unsigned int)result.value.ptr);
	  }
	  break;
	default:
	  sprintf (var_value_buf, "%d", result.value.i);
	  break;
	}
      continue;
    }

  } while ((arg_ptr = nextlangmsg (messages, arg_ptr)) != ERROR);

  tmp_var_definition_idx.class_obj_name_idx = 
    var_definition_idx.class_obj_name_idx;
  tmp_var_definition_idx.var_name_idx = 
    var_definition_idx.var_name_idx;
  tmp_var_definition_idx.var_value_class_name_idx = 
    var_definition_idx.var_value_class_name_idx;
  tmp_var_definition_idx.initial_value_start_idx = 
    var_definition_idx.initial_value_start_idx;
  tmp_var_definition_idx.initial_value_end_idx = 
    var_definition_idx.initial_value_end_idx;

  if ((var_class_object = 
       class_object_search (M_NAME(messages[var_definition_idx.class_obj_name_idx]))) == NULL) {
    __ctalkExceptionInternal (messages[idx], undefined_class_x, 
			      var_definition_args.classobjname);
    return NULL;
  }

  var_definition_idx.class_obj_name_idx = 
    tmp_var_definition_idx.class_obj_name_idx;
  var_definition_idx.var_name_idx = 
    tmp_var_definition_idx.var_name_idx;
  var_definition_idx.var_value_class_name_idx = 
    tmp_var_definition_idx.var_value_class_name_idx;
  var_definition_idx.initial_value_start_idx = 
    tmp_var_definition_idx.initial_value_start_idx;
  var_definition_idx.initial_value_end_idx = 
    tmp_var_definition_idx.initial_value_end_idx;

  if ((v = 
       create_object_init (var_class_object -> __o_name,
			   var_class_object -> __o_superclassname,
			   M_NAME(messages[var_definition_idx.var_name_idx]),
			   var_value_buf)) == NULL)
    _warning ("var_definition (): Error.\n");

  if (var_definition_idx.var_value_class_name_idx != ERROR) {
    OBJECT *var_value_class_object;

    tmp_var_definition_idx.class_obj_name_idx = 
      var_definition_idx.class_obj_name_idx;
    tmp_var_definition_idx.var_name_idx = 
      var_definition_idx.var_name_idx;
    tmp_var_definition_idx.var_value_class_name_idx = 
      var_definition_idx.var_value_class_name_idx;
    tmp_var_definition_idx.initial_value_start_idx = 
      var_definition_idx.initial_value_start_idx;
    tmp_var_definition_idx.initial_value_end_idx = 
      var_definition_idx.initial_value_end_idx;

    if ((var_value_class_object = 
	 class_object_search (M_NAME(messages[var_definition_idx.var_value_class_name_idx])))== NULL) {
      __ctalkExceptionInternal (messages[idx], undefined_class_x, 
				var_definition_args.varvalueclassname);
      return NULL;
    }

    var_definition_idx.class_obj_name_idx = 
      tmp_var_definition_idx.class_obj_name_idx;
    var_definition_idx.var_name_idx = 
      tmp_var_definition_idx.var_name_idx;
    var_definition_idx.var_value_class_name_idx = 
      tmp_var_definition_idx.var_value_class_name_idx;
    var_definition_idx.initial_value_start_idx = 
      tmp_var_definition_idx.initial_value_start_idx;
    var_definition_idx.initial_value_end_idx = 
      tmp_var_definition_idx.initial_value_end_idx;

    __ctalkSetObjectValueClass (v, var_value_class_object);
  }
  __ctalkSetObjectValue (v, var_value_buf);
  instance_vars_from_class_object (v);

  return v;
}

static int set_var_definition_evaled (MESSAGE_STACK messages,int keyword_ptr) {

  int i, stack_top, rcvr_ptr;
  MESSAGE *m;
  enum {
    var_def_null,
    var_def_rcvr,
    var_def_keyword,
    var_def_name, 
    var_def_classname,
    var_def_init} state;

  if ((rcvr_ptr = prevlangmsg (messages, keyword_ptr)) == ERROR) {
    _warning ("Parser error.\n");
    return ERROR;
  }

  stack_top = get_stack_top (messages);
  for (i = rcvr_ptr, state = var_def_null; i > stack_top; i--) {
    m = messages[i];
    ++m -> evaled;
    ++m -> output;
    if (M_ISSPACE (m)) continue;

    if (M_TOK(m) == SEMICOLON) return SUCCESS;

    switch (state)
      {
      case var_def_null:
	if (M_TOK(m) == LABEL) state = var_def_rcvr;
	break;
      case var_def_rcvr:
	if (M_TOK(m) == LABEL) state = var_def_keyword;
	break;
      case var_def_keyword:
	if (M_TOK(m) == LABEL) state = var_def_name;
	break;
      case var_def_name:
	if (M_TOK(m) == LABEL) state = var_def_classname;
	break;
      case var_def_classname:
	if (M_TOK(m) == LABEL) state = var_def_init;
	break;
      case var_def_init:
	break;
      }
  }

  return SUCCESS;
}

OBJECT *define_instance_variable (int keyword_ptr) {
  OBJECT *v, *v_ptr, *rcvr_obj = NULL;  /* Avoid a warning. */
  int rcvr_ptr;
  if ((v = var_definition (message_stack (), keyword_ptr)) != NULL) {

    if ((rcvr_ptr = prevlangmsg (message_stack (), keyword_ptr)) == ERROR) {
      _warning ("Undefined class in define_instance_variable ().\n");
      return NULL;
    }
    
    if ((rcvr_obj = 
	 class_object_search (M_NAME(message_stack_at (rcvr_ptr)))) == NULL) {
      __ctalkExceptionInternal (message_stack_at (rcvr_ptr), 
				undefined_class_x, 
				M_NAME(message_stack_at (rcvr_ptr)));
      return NULL;
    }

    if (rcvr_obj -> instancevars == NULL) {
      rcvr_obj -> instancevars = v;
    } else {
      for (v_ptr = rcvr_obj->instancevars; v_ptr -> next; v_ptr=v_ptr -> next)
	;
      v_ptr -> next = v;
      v -> prev = v_ptr;
    }

  }

  if ((var_definition_idx.class_obj_name_idx == -1) ||
      (var_definition_idx.var_name_idx == -1)) {
    warning (message_stack_at (keyword_ptr), 
	     "Incomplete instance variable definition.");
  }

  generate_define_instance_variable_call 
    (M_NAME(message_stack_at(var_definition_idx.class_obj_name_idx)),
     M_NAME(message_stack_at(var_definition_idx.var_name_idx)),
     ((var_definition_idx.var_value_class_name_idx == -1) ? "" :
      M_NAME(message_stack_at(var_definition_idx.var_value_class_name_idx))),
     ((var_definition_idx.initial_value_start_idx == -1) ? "" :
      var_value_buf));

  set_var_definition_evaled (message_stack (), keyword_ptr);

  return rcvr_obj;
}

OBJECT *define_class_variable (int keyword_ptr) {
  OBJECT *v, *v_ptr, *rcvr_obj;
  int rcvr_ptr;
  if ((v = var_definition (message_stack (), keyword_ptr)) != NULL) {

    if ((rcvr_ptr = prevlangmsg (message_stack (), keyword_ptr)) == ERROR) {
      _warning ("Undefined class in define_class_variabel ().\n");
      return NULL;
    }
    
    if ((rcvr_obj = 
	 class_object_search (M_NAME(message_stack_at (rcvr_ptr)))) == NULL) {
      __ctalkExceptionInternal (message_stack_at (rcvr_ptr), 
				undefined_class_x, 
				M_NAME(message_stack_at (rcvr_ptr)));
      return NULL;
    }

    if (rcvr_obj -> classvars == NULL) {
      rcvr_obj -> classvars = v;
    } else {
      for (v_ptr = rcvr_obj -> classvars; v_ptr -> next; v_ptr=v_ptr -> next)
	;
      v_ptr -> next = v;
      v -> prev = v_ptr;
    }

  }

  if ((var_definition_idx.class_obj_name_idx == -1) ||
      (var_definition_idx.var_name_idx == -1)) {
    warning (message_stack_at (keyword_ptr), 
	     "Incomplete class variable definition.");
  }

  generate_define_class_variable_call 
    (M_NAME(message_stack_at(var_definition_idx.class_obj_name_idx)),
     M_NAME(message_stack_at(var_definition_idx.var_name_idx)),
     ((var_definition_idx.var_value_class_name_idx == -1) ? NULL :
      M_NAME(message_stack_at(var_definition_idx.var_value_class_name_idx))),
     ((var_definition_idx.initial_value_start_idx == -1) ? NULL :
      var_value_buf));

  set_var_definition_evaled (message_stack (), keyword_ptr);

  return v;
}

int class_primitive_method_args (METHOD *method, MESSAGE_STACK messages, 
				 int method_idx) {

  int stack_top;
  int i;
  MESSAGE *m;
  enum {class_arg_null,
	class_arg_method,
	class_arg_arg,
	class_arg_end
  } class_arg_state;

  stack_top = get_stack_top (messages);

  for (i = method_idx, class_arg_state = class_arg_null; 
       (i > stack_top) && (class_arg_state != class_arg_end); i--) {
    
    m = messages[i];
    if (M_ISSPACE(m)) continue;
    switch (class_arg_state)
      {
      case class_arg_null:
	if (strcmp (M_NAME(m), method -> name)) 
	  _error ("class_primitive_method_args: parser error.\n");
	class_arg_state = class_arg_method;
	break;
      case class_arg_method:
	if (M_TOK(m) == LABEL) {
	  method->args[method->n_args] = 
	    /*
	     *  Create the object manually.
	     */
	    create_object ("Class", M_NAME(m));
	  method->args[method->n_args] -> instancevars =  
	    create_object (M_NAME(m), "value");
	  strcpy (method->args[method->n_args] -> __o_superclassname,
		  messages[method_idx]->receiver_obj -> __o_name);
	  strcpy (method->args[method->n_args] 
		  -> instancevars -> __o_superclassname,
		  messages[method_idx]->receiver_obj -> __o_name);
	  method->args[method->n_args] -> __o_class =
	  method->args[method->n_args] -> instancevars -> __o_class =
	    method->args[method->n_args];
	  method->args[method->n_args] -> __o_superclass =
	  method->args[method->n_args] -> instancevars -> __o_superclass =
	    messages[method_idx]->receiver_obj;
	  ++method -> n_args;
	  class_arg_state = class_arg_arg;
	} else {
	  __ctalkExceptionInternal (m, parse_error_x, M_NAME(m));
	}
	break;
      case class_arg_arg:
	if (M_TOK(m) != SEMICOLON) 
	  __ctalkExceptionInternal (m, parse_error_x, M_NAME(m));
	class_arg_state = class_arg_end;
	break;
      case class_arg_end:
	break;
      }
  }

  return SUCCESS;
}
