/*
	Little Smalltalk
		courier - message passing interface

		timothy a. budd 10/84
*/
/*
	The source code for the Little Smalltalk System may be freely
	copied provided that the source of all files is acknowledged
	and that this condition is copied with each file.

	The Little Smalltalk System is distributed without responsibility
	for the performance of the program and without any guarantee of
	maintenance.

	All questions concerning Little Smalltalk should be addressed to:

		Professor Tim Budd
		Department of Computer Science
		The University of Arizona
		Tucson, Arizona
		85721
		USA
*/
# include <stdio.h>
# include "object.h"
# include "interp.h"
# include "string.h"
# include "symbol.h"
# include "primitive.h"
# define streq(x,y) (strcmp(x,y) == 0)

/* send_mess - find the method needed to respond to a message, create the
	proper context and interpreter for executing the method */
send_mess(sender, receiver, message, args, numargs)
interpreter *sender;
object *receiver, **args;
char *message;
int numargs;
{	object *robject, *method;
	register object *message_array;
	object *context, *fnd_super(), *fnd_class();
	class  *objclass;
	interpreter *anInterpreter;
	int    i, maxc;

	for (robject = receiver; robject; ) {
		if (robject == (object *) 0) break;
		if (is_bltin(robject))
			objclass = (class *) fnd_class(robject);
		else
			objclass = robject->class;
		if ((objclass == (class *) 0) || ! is_class(objclass))  break;

		message_array = objclass->message_names;
		for (i = 0; i < message_array->size; i++) {
			if (symbol_value(message_array->inst_var[i]) ==
						message) {
				method = (objclass->methods)->inst_var[ i ];
				goto do_cmd;
				}
			}
		if (is_bltin(robject))
			robject = fnd_super(robject);
		else
			robject = robject->super_obj;
		}

/* if we reach this point then no method has been found matching message */
	sassign(robject, new_obj((class *) 0, 2, 0));
	sassign(robject->inst_var[0], receiver);
	sassign(robject->inst_var[1], new_sym(message));
	primitive(NORESPONDERROR, 2, &(robject->inst_var[0]));
	obj_dec(robject);
	/* generate a message passing trace */
	backtrace(sender);
	/* return nil by default */
	if (is_interpreter(sender))
		push_object(sender, o_nil);
	link_to_process(sender);
	goto clean_up;

/* do an interpreted method */
/* make a context and fill it in, make an interpeter and link it into
process queue */
do_cmd:
	maxc = objclass->context_size;
	sassign(context, new_obj((class *)0, maxc, 0));
	for (i = 0; i <= numargs; i++)
		sassign(context->inst_var[i], args[i]);
	for ( ; i < maxc ; i++ )
		sassign(context->inst_var[i], o_nil);
	anInterpreter = cr_interpreter(sender, robject, method->inst_var[1],
		method->inst_var[0], context);
	link_to_process(anInterpreter);
	obj_dec(context);
	goto clean_up;

/* clean up after yourself */
clean_up:
	return;
}

/* responds_to - see if a class responds to a message */
int responds_to(message, aClass)
char *message;
class *aClass;
{	object *message_names;
	int i;

	message_names = aClass->message_names;
	for (i = 0; i < message_names->size; i++)
		if (streq(symbol_value(message_names->inst_var[i]),
				message))
			return(1);
	return(0);
}

/* backtrace - generate a backwards message passing trace */
static backtrace(current)
interpreter *current;
{
	while (is_interpreter(current->sender) &&
			! is_driver(current->sender)) {
		fnd_message(current->receiver, current->bytecodes);
		current = current->sender;
		}
}

/* fnd_message - find the message associated with an interpreter */
static fnd_message(receiver, bytecodes)
object *receiver, *bytecodes;
{	int i;
	class *oclass;
	object *messar, *temp;
	char buffer[100];

	oclass = (class *) fnd_class(receiver);
	if (! is_class(oclass)) return;

	messar = oclass->methods;
	for (i = 0; i < messar->size; i++) {
		if ((messar->inst_var[i])->inst_var[0] == bytecodes) {
			sprintf(buffer,"%s: backtrace. message  %s",
				symbol_value(oclass->class_name),
				symbol_value(
					(oclass->message_names)->inst_var[i]));
			sassign(temp, new_str(buffer));
			primitive(ERRPRINT, 1, &temp);
			obj_dec(temp);
			return;
			}
		}
	cant_happen(24);
}

/* prnt_messages - print all the messages a class responds to.
	needed because the messages names array for some of the classes is
	created before ArrayedCollection, and thus some do not respond to
	do: */
prnt_messages(aClass)
class *aClass;
{	object *message_names;
	int i;

	message_names = aClass->message_names;
	for (i = 0; i < message_names->size; i++)
		primitive(SYMPRINT, 1, &message_names->inst_var[i]);
}