/*
	Little Smalltalk

		block creation and block return
		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 "drive.h"
# include "interp.h"
# include "block.h"
# include "string.h"
# include "primitive.h"
# include "process.h"

extern object *o_object;	/* value of generic object */

static mstruct *fr_block = 0;	/* free list of unused blocks */

int ca_block = 0;		/* count block allocations */

/* cpyInterpreter - make a new copy of an existing interpreter */
static interpreter *cpyInterpreter(anInterpreter)
interpreter *anInterpreter;
{	interpreter *new;

	new = cr_interpreter((interpreter *) 0,
		anInterpreter->receiver,
		anInterpreter->literals,
		anInterpreter->bytecodes,
		anInterpreter->context);

	if (anInterpreter->creator)
		new->creator = anInterpreter->creator;
	else
		new->creator = anInterpreter;

	new->currentbyte = anInterpreter->currentbyte;
	return(new);
}

/* new_block - create a new instance of class Block */
object *new_block(anInterpreter, argcount, arglocation)
interpreter *anInterpreter;
int argcount, arglocation;
{	block *new;

	if (fr_block) {
		new = (block *) fr_block;
		fr_block = fr_block->mlink;
		}
	else {
		new = structalloc(block);
		ca_block++;
		}

	new->b_ref_count = 0;
	new->b_size = BLOCKSIZE;

	sassign(new->b_interpreter, cpyInterpreter(anInterpreter));
	new->b_numargs = argcount;
	new->b_arglocation = arglocation;
	return((object *) new);
}

/* free_block - return an unused block to the block free list */
free_block(b)
block *b;
{
	if (! is_block(b)) 
		cant_happen(8);

	obj_dec((object *)(b->b_interpreter));

	((mstruct *) b)->mlink = fr_block;
	fr_block = (mstruct *) b;
}

/* block_execute - queue a block interpreter for execution */
interpreter *block_execute(sender, aBlock, numargs, args)
interpreter *sender;
block *aBlock;
int numargs;
object **args;
{	interpreter *newInt;
	object *tempobj;

	if (! is_block(aBlock)) cant_happen(11);
	if (numargs != aBlock->b_numargs) {
		sassign(tempobj, 
			new_str("wrong number of arguments for block"));
		primitive(ERRPRINT, 1, &tempobj);
		obj_dec(tempobj);
		if (sender) {
			push_object(sender, o_nil);
			}
		return(sender); /* not sure about this ..... */
		}

	/* we copy the interpreter so as to not destroy the original and to
	   avoid memory pointer cycles */

	newInt = cpyInterpreter(aBlock->b_interpreter);
	if (sender)
		assign(newInt->sender, sender);
	if (numargs)
		copy_arguments(newInt, aBlock->b_arglocation, 
			numargs, args);
	return(newInt);
}

/* block_return - return an object from the context in which a block was
created */
block_return(blockInterpreter, anObject)
interpreter *blockInterpreter;
object *anObject;
{	interpreter *backchain, *parent;
	interpreter *creatorblock;

	creatorblock = blockInterpreter->creator;
	for (backchain = blockInterpreter->sender; backchain; 
			backchain = backchain->sender) {
		if (! is_interpreter(backchain)) break;
		if (backchain == creatorblock) {
			/* found creating context, back up one more */
			parent = backchain->sender;
			if (parent) {
				if (! is_driver(parent))
					push_object(parent, anObject);
				link_to_process(parent);
				}
			else {
				terminate_process(runningProcess);
				}
			return;
			}
		}

	/* no block found, issue error message */
	primitive(BLKRETERROR, 1, (object **) &blockInterpreter);
	parent = blockInterpreter->sender;
	if (parent) {
		if (! is_driver(parent))
			push_object(parent, anObject);
		link_to_process(parent);
		}
	else {
		terminate_process(runningProcess);
		}
}