/*****************************************************************
* LSC 2.0
*  - square@cco.caltech.edu aka square@imperial.lp.mud
*			    aka square@tmi2.lp.mud
*
* 4/25/92 - Start writing LSC. variable list based on a hash_table
* 5/15/92 - switched to mapping for variable list (LSC 2.0)
*	    thus reduce the file size to 22K :)
* 5/15/92 - The bug that causes "/var{1}def" to give an error
*	    has been fixed.
* 5/17/92 - Flexible stack implemented
* 5/19/92 - Array implemeted. Operations like +, -, * (intersection)
*	    extract have meaning either in context of C or Boulean
*	    Algebra
* 5/23/92 - Break/continue implemented by using tokens
*	  - lots of operators added
* 5/25/92 - lots of game-related operators added
*	    many of them support parse_command
* 5/26/92 - primary support for mapping implemeted
*	  - +, * has meaning for mapping
*	  - boost the file size to 40K!!!!
* 5/27/92 - Start building the concept of LSC objects.
* 6/02/92 - a bug which stack up BREAKTOKEN in _pending_input fixed
* 1/93    - modulization begun, first application written 
*	    (programmable shop)
* 3/93	  - second project, the ultimate tracer, begun
* 3/12/93 - horrible bug in multi-tasking discovered!
*****************************************************************/

#include <lsc.h>
inherit LSC_MATH;

#define THIS_FILE "u/s/square/lsc/lsc2"

#define MAX_SPEED 10
#define MAXSTACK 500
#define MAP_SIZE 30
#define BREAKTOKEN "##"
#define CONTTOKEN "#*"
#define OBJTOKEN "**"

/***********************/
/* compiler essentials */
/***********************/
mapping _varlist;
static mapping _e_varlist;
static mixed * _stack;
static int _stack_ptr;

static string _pending_input;	/* waiting to be executed */
static int _pending_bracket;	/* {} */
static int _pending_parenthese;	/* () */
static int _pending_square_brk;	/* [] */
int wait_time;		/* wait time for each (_speed) executions */
int _speed;		/* must always MAX_SPEED >= _speed >= 2 */
static int _counter;

static object this_play;	/* the master of this object */

static int pause_requested;
static mixed stdout, stderr;

/************************************/
/* multi-tasking and IPC essentials */
/************************************/
static string _process_id;		/* process id, 0 for ROOT */
static object _parent, * _children;	/* just like unix */
/* note: a child process's
						 * _children is linked
						 to parent's */
static int _status;			/* process status */
static int _max_ch_size;	/* NOTE: children can't spawn process */
static object active_child;	/* set if its _* is called from child obj */

/********************************/
/* pre-definitions of functions */
/********************************/
int _pause();
int number_of_children();
string Parse_String(string str);
varargs int Compile(mixed input);
/********************************/

void pause() {
	_pause();
}

int remove() {
	int i,n;
	if (!_process_id) { /* ROOT should kill its children first */
		n = sizeof(_children);
		for(i=0;i<n;i++) if(_children[i]) _children[i]->remove();
	}
	destruct(this_object());
	return 1;
}

/* should be replaced by application */
void error(mixed str) {
	if (_parent && function_exists("error", _parent)) {
		_parent->error(_process_id+": "+str);
	}
	_status = ERROR;
}

/***********************/
/* some sets & queries */
/***********************/

void set_process_id(string str) {
	_process_id = str;
}

void set_parent(object ob) {
	this_play = _parent = ob;
	_e_varlist = (mapping) ob->query_varlist();
}

void set_e_varlist(mapping varl) {
	_e_varlist = varl;
}

void set_this_play(object ob) {
	this_play = ob;
}

void set_active_child(object i) {
	if (i != this_object()) active_child = i;
}

void insert_input(string str) {
	if (active_child) {
		active_child->insert_input(str);
		return;
	}
	if (str == "" || !str) return;
	if (!_pending_input || _pending_input == "") _pending_input = str;
	else if (_pending_input[0]==' ' ||
		 str[strlen(str)-1]==' ')
		 _pending_input = str + _pending_input;
	else _pending_input = str+" "+_pending_input;
}

mapping query_varlist() {
	return _varlist;
}
mixed * query_stack() {
	if (active_child) return (mixed *) active_child->query_stack();
	return ( _stack_ptr > 0 ? _stack[0..(_stack_ptr-1)] : ({ }) );
}
int query_stack_ptr() {
	if (active_child) return (int) active_child->query_stack_ptr();
	return _stack_ptr;
}
string query_input() {
	return _pending_input;
}
int query__speed() {
	return _speed;
}
int query_wait_time() {
	return wait_time;
}

void set_wait_time(int i) {
	wait_time = i;
}
/* should be removed soon */
void set__speed(int n) {
	if (n<2) _speed = 2;
	else if(n>MAX_SPEED) _speed = MAX_SPEED;
	else _speed = n;
}
int query_status() {
	return _status;
}
object query_parent() {
	return _parent;
}
object query_this_play() {
	return this_play;
}
mixed query_process_id() {
	return _process_id;
}

string query_short() {
	return "A thought"; /* grin */
}

/************/
/* Reset()s */
/************/

void Reset() {
	if (!this_play) this_play = this_player();

	/* should be intelligence-dependent */
	wait_time = 1;
	_speed = MAX_SPEED;
	_max_ch_size = _process_id==ROOT? 5 : 0 ;

	if (!_children && _process_id==ROOT)
		_children = allocate(_max_ch_size);

	_counter = 0;
	_pending_input = 0;
	_stack_ptr = 0;
	active_child = 0;
	if (!_varlist) _varlist = allocate_mapping(MAP_SIZE);

	if (!_stack)
		_stack = ({ 
		}
	);
	remove_call_out("Compile");
}

void
LSC_create() {
	seteuid(getuid(this_object()));
	if (LSC_CONSOLE=="") return;
	call_other(LSC_CONSOLE,"register_compiler", this_object());
}

create() { LSC_create(); }

/*****************************/
/* LSC operators definitions */
/*****************************/

int _clear()
{
	int i;
	if (active_child) return (int) active_child->_clear();
	_stack_ptr = 0;
	_pending_input = 0;
	_stack = ({ });
	return 0;
}

int _clear_hash()
{
	int i;
	if (active_child) return (int) active_child->_clear_hash();
	_varlist = allocate_mapping(MAP_SIZE);
	return 0;
}

mixed Pop()
{
	if (active_child) return (mixed) active_child->Pop();
	if (_stack_ptr < 1) {
		error("Stack underflows.");
		return -1;
	}
	return _stack[--_stack_ptr]; /* predecrement */
}

int _pop() { /* discard the top element */
	Pop();
	if (_status==ERROR) return -1;
	return 0;
}

int Push(mixed elt)
{
	if (active_child) return (int) active_child->Push(elt);
	if (_stack_ptr >= MAXSTACK) {
		error("Stack overflows.");
		return -1;
	}

	if (sizeof(_stack) > _stack_ptr)
		_stack[_stack_ptr++] = elt;
	else {
		_stack+= ({ 
			elt 		}
		);
		_stack_ptr++;
	}
	return 0;
}

int _count() {
	if (active_child) return Push(active_child->query_stack_ptr());
	return Push(_stack_ptr);
}

int Is_Block(mixed str) {
	if (!str || !stringp(str) || str=="") return 0;
	return str[0]=='{' && str[strlen(str)-1]=='}' ;
}

int Is_empty_block(string str) {
	string inside;
	int len;
	if (!Is_Block(str)) return -1;
	len = strlen(str);
	if (len < 3) return 1;
	sscanf(str,"{%s}",inside);
	while(sscanf(inside," %s",inside));
	if (inside=="") return 1;
	return 0;
}

int Is_String(mixed str) {
	if (!str || !stringp(str) || str=="") return 0;
	return str[0]=='(' && str[strlen(str)-1]==')' ;
}

int Is_Object(mixed str) {
	if (!str || !stringp(str) || strlen(str)<3) return 0;
	return str[0..1]==OBJTOKEN;
}

int _add() {
	mixed i,j;
	i=Pop();
	j=Pop();

	if (pointerp(i)) {
		if( pointerp(j) ) {
			Push(j+i);
			return 0;
		}
		return Push( ({ j }) + (mixed*) i);
	}
	if (pointerp(j)) {
		return Push( (mixed *)j + ({ i }) );
	}
	if (mapp(i) && mapp(j)) 
		return Push( i + j);

	if (Is_String(i) || Is_String(j)) {
		string tmp1, tmp2;

		if (Is_String(i)) {
			if (strlen(i) <3) tmp1="";
			else tmp1=i[1..strlen(i)-2];
		}
		if (Is_String(j)) {
			if (strlen(j) <3) tmp2="";
			else tmp2=j[1..strlen(j)-2];
		}

		if (tmp1 && tmp2) {
			Push( "("+tmp2+tmp1+")" );
			return 0;
		}
		else if (tmp1) {
			Push( "("+j+tmp1+")" );
			return 0;
		}
		else if (tmp2) {
			Push( "("+tmp2+i+")" );
			return 0;
		}

	}

	if (intp(i) && intp(j)) {
		Push(i+j);
		return 0;
	}

	error("Illegal addition.");
	return -1;
}

/* "j i sub" pushes (j-i) onto stack */
int _sub() {
	mixed i, j;
	i=Pop(); /* top */
	j=Pop();

	if (pointerp(j)) {
		if (pointerp(i)) {
			return Push( j - i);
		}
		return Push( (mixed *) j - ({ 
			i 		}
		) );
	}

	if (!intp(i) || !intp(j)) {
		error("Illegal subtraction.");
		return -1;
	}
	return Push(j-i); /* below - above */
}

/* "j i div" pushes (j/i) onto stack */
int _div() {
	mixed i, j;
	i=Pop(); /* top */
	j=Pop();

	if (!intp(i) || !intp(j)) {
		error("Illegal subtraction.");
		return -1;
	}
	if (!i) {
		error("division by zero.");
		return -1;
	}
	return Push(j/i); /* below - above */
}

int _mul() {
	mixed i,j;
	int n;
	i=Pop();
	j=Pop();

	if (pointerp(i)) {
		if (pointerp(j)) {
			return Push(i-(i-j)); /* intersection */
		}
		n = member_array(j,i);
		if (n==-1) {
			return Push( ({ }) );
		}
		return Push( ({ j }) );
	}

	if (pointerp(j)) {
		n = member_array(i,j);
		if (n==-1) {
			return Push( ({ }) );
		}
		return Push( ({ i }) );
	}

	if (mapp(i) && mapp(j)) return Push( j * i );

	if (!intp(i) || !intp(j)) {
		error("Illegal multiplication.");
		return -1;
	}
	return Push(i*j);
}

int _neg() {
	mixed i;
	i=Pop();

	if (!intp(i)) {
		error("_neg: illegal arg");
		return -1;
	}
	Push(-i);
}

int _sqrt() {
	mixed i;
	i = Pop();

	if (!intp(i) || i<0) {
		error("sqrt: illegal arg");
		return -1;
	}
	Push(sqrt(i));
}

int _mod() {
	mixed i,j;
	i=Pop();
	j=Pop();

	if (!intp(i) || !intp(j)) {
		error("_mod: illegal arg.");
		return -1;
	}
	return Push(j % i);
}

string SubStr(string str, string orig, string new) {
	string ret, front, back, tmp;
	if (!str || str=="" ) return "";
	tmp = "%s"+orig+"%s";
	ret="";
	while(sscanf(str, tmp, front, back)) {
		if(!back) back="";
		ret+= front+new;
		str=back;
	}
	return ret+str;
}

mixed Restore_String(mixed str) {
	if (!stringp(str)) return str;
	str = SubStr(str,"\\","\\\\");

	str = SubStr(str,"(", "\\(");
	str = SubStr(str,")", "\\)");
	str = SubStr(str,"[", "\\[");
	str = SubStr(str,"]", "\\]");
	str = SubStr(str,"{", "\\{");
	str = SubStr(str,"}", "\\}");
	str = SubStr(str,"#", "\\#");
	str = SubStr(str,"*", "\\*");

	str = SubStr(str,"\n","\\n");
	str = SubStr(str,"\t","\\t");
	return "("+str+")";
}

string Restore_Array(mixed * arry) {
	int i,n;
	string ret;
	ret = "[";
	n = sizeof(arry);
	for(i=0;i<n;i++) {
		if(pointerp(arry[i])) ret+=Restore_Array(arry[i]);
		else if(arry[i] && objectp(arry[i]))
			ret+=OBJTOKEN+file_name(arry[i]);
		else ret+=arry[i];
		ret += " ";
	}
	return ret+"]";
}

int _extract() {
	mixed start,end;
	mixed arry;
	int n;
	string tmp;

	end = Pop();
	start = Pop();

	arry = Pop();
	if (!intp(end) || !intp(start)) {
		error("extract: 1st and 2nd must be integers");
		return -1;
	}

	if (pointerp(arry)) {
		n = sizeof(arry);
		if (end <0) end += n;
		if (start<0) start+=n;
		if (end < start) {
			Push( ({ }));
			return 0;
		}
		if (start < 0 || start >= n || end < 0 || end >= n) {
			error("extract: out of range");
			return -1;
		}
		return Push(arry[start..end]);
	}
	if (Is_String(arry)) {
		tmp = Parse_String(arry);
		n = strlen(tmp);
		if (end <0 ) end += n;
		if (start<0) start+=n;
		if (end < start) {
			Push("()");
			return 0;
		}
		if (start < 0 || start >= n || end < 0 || end >= n) {
			error("extract: out of range:"+start+" to "+end+" range "+n);
			return -1;
		}
		return Push( Restore_String(tmp[start..end]) );
	}
	error("extract: must be either array or string");
	return -1;
}

void Def(mapping table, string varname, mixed above) {
	table[varname]=above;
	return 0;
}

int _def() {
	mixed below, above;
	string varname;

	above = Pop();
	below = Pop();

	if (!stringp(below) || !sscanf(below,"\/%s",varname) ) {
		error("_def: Illegal var format.");
		return -1;
	}
	Def(_varlist, varname, above);
}

int _edef() {
	mixed below, above;
	string varname;

	if (!_parent) return _def();
	above = Pop();
	below = Pop();

	if (!stringp(below) || !sscanf(below,"\/%s",varname) ) {
		error("_edef: Illegal var format.");
		return -1;
	}
	Def(_e_varlist, varname,above);
}

int _isdef() {
	string varname;
	mixed data;

	data = Pop();
	if (!stringp(data) || !sscanf(data,"\/%s",varname) ) {
		error("_isdef: Illegal var format.");
		return -1;
	}

	if (undefinedp(_varlist[varname]))
		Push(0);
	else Push(1);
}

int _isedef() {
	string varname;
	mixed data;

	if (!_parent) {
		Push(0);
		return 0;
	}
	data = Pop();
	if (!stringp(data) || !sscanf(data,"\/%s",varname) ) {
		error("_isedef: Illegal var format.");
		return -1;
	}

	if (undefinedp(_e_varlist[varname]))
		Push(0);
	else Push(1);

}

int _undef() {
	string varname;
	mixed data;

	data = Pop();
	if (!stringp(data) || !sscanf(data,"\/%s",varname) ) {
		error("_undef: Illegal var format.");
		return -1;
	}

	map_delete(_varlist, varname);
}

int _unedef() {
	string varname;
	mixed data, up, down;
	int i, hash_num, n;

	if (!_parent) {
		if (!_process_id) { /* really a <ROOT> */
			return _undef();
		}
		/* orphane */
		Pop();
		return 0; /* should I make it an error? */
	}
	data = Pop();
	if (!stringp(data) || !sscanf(data,"\/%s",varname) ) {
		error("_unedef: Illegal var format.");
		return -1;
	}

	map_delete(_e_varlist, varname);
}

int _load() {
	string varname;
	mixed data,what;
	data = Pop();
	if (!stringp(data) || !sscanf(data,"\/%s",varname) ) {
		error("load: not a /variable format");
		return -1;
	}
	if (!undefinedp(what = _varlist[varname])) {
		Push(what);
		return 0;
	}
	if (!undefinedp(what = _e_varlist[varname])) {
		Push(what);
		return 0;
	}
	error("load: variable "+varname+" not found");
	return -1;
}

int _array() {
	mixed i, *j;
	i = Pop();
	if (!intp(i) || i < 0) {
		error("array: illegal argument");
		return -1;
	}
	j = allocate(i);
	return Push(j);
}

int _mapping() {
	mixed i;
	mapping j;
	i = Pop();
	if (!intp(i) || i < 0) {
		error("mapping: illegal argument");
		return -1;
	}
	j = allocate_mapping(i);
	return Push(j);
}

int _keys() {
	mixed i;
	i = Pop();
	if (!mapp(i)) {
		error("keys: not a mapping");
		return -1;
	}
	Push(keys(i));
}

int _get() {
	mixed i, data, tmp;
	string tmpstr;
	int len;
	i = Pop();
	data = Pop();
	if (!intp(i) && !mapp(data)) {
		error("get: 1st must be int");
		return -1;
	}
	if (Is_String(data)) {
		tmpstr = Parse_String(data);
		len = strlen(tmpstr);
		if (i<0) i+=len;
		if (i<0 || i>=len) {
			error("get: out of range");
			return -1;
		}
		return Push("("+tmpstr[i]+")");
	}
	if (pointerp(data)) {
		len = sizeof(data);
		if (i<0) i+=len;
		if (i<0 || i>=len) {
			error("get: out of range");
			return -1;
		}
		return Push(data[i]);
	}
	if (mapp(data)) {
		return Push(data[i]);
	}
	error("get: not [array] nor (string)");
	return -1;
}

int _put() {
	mixed i, what, data, tmp;
	string tmpdata, tmpwhat;
	int lendata, lenwhat;
	i = Pop();
	what = Pop();
	data = Pop();
	if (!intp(i) && !mapp(data) ) {
		error("put: 1st must be int");
		return -1;
	}
	if (Is_String(data)) {
		if (intp(what)) tmpwhat=""+what;
		else {
			if (!Is_String(what)) {
				error("put: 2nd is not (char) nor int");
				return -1;
			} else {
				tmpwhat = Parse_String(what);
			}
		}
			
		lenwhat = strlen(tmpwhat);
		if (lenwhat>1) {
			error("put: chain substitution not yet possible");
			return -1;
		}

		tmpdata = Parse_String(data);
		lendata = strlen(tmpdata);
		if (i<0) i+=lendata;
		if (i<0 || i>=lendata) {
			error("get: out of range");     
			return -1;
		}
		tmpdata[i]=tmpwhat[0];
		return Push(Restore_String(tmpdata));
	}
	if (pointerp(data)) {
		lendata = sizeof(data);
		if (i<0) i+=lendata;
		if (i<0 || i>=lendata) {
			error("get: out of range");     
			return -1;
		}
		data[i]=what;
		return Push(data);
	}
	if (mapp(data)) {
		data[i]=what;
		return Push(data);
	}
	error("put: not [array] nor (string)");
	return -1;
}

int _aload() {
	int i,n;
	mixed data;
	data = Pop();
	if (!pointerp(data)) {
		error("aload: illegal argument");
		return -1;
	}
	n = sizeof(data);

	if (n+query_stack_ptr() > MAXSTACK) {
		error("aload: array too large to be contained in stack");
		return -1;
	}
		
	for(i=0;i<n;i++) {
		Push(data[i]);
	}
	return Push(data);
}

int _astore() {
	int i,n;
	mixed data;
	data = Pop();
	if (!pointerp(data)) {
		error("astore: 1st is not [array]");
		return -1;
	}
	n = sizeof(data);
	if (query_stack_ptr() < n) {
		error("astore: not enough elements to fill array");
		return -1;
	}
	for(i=n-1;i>=0;i--) data[i]=Pop();
	return Push(data);
}

int _member_array() {
	mixed array;
	mixed item;

	array = Pop();
	item = Pop();
	if (!pointerp(array)) {
		error("member_array: 1st is not [array]");
		return -1;
	}
	return Push( member_array(item, (mixed *) array) );
}

int _exch() {
	mixed i,j;
	i = Pop();
	j = Pop();
	Push(i);
	Push(j);
}

int _dup() {
	mixed i;
	i = Pop();
	Push(i);
	Push(i);
}

int _length() {
	mixed i;
	i = Pop();
	if (Is_String(i)) {
		return Push(strlen(Parse_String(i)));
	}
	if (pointerp(i)) {
		return Push(sizeof(i));
	}
	error("length: not (string) nor [array]");
}

string Parse_String(string str) {
	int i,n;
	string tmp;
	for(i=1;i<(n=strlen(str)-1);i++) {
		if (str[i]=='\\') {
			tmp = str[0..(i-1)];
			if (str[i+1]=='n')
				tmp += "\n"+str[(i+2)..n];
			else if (str[i+1]=='t')
				tmp += "\t"+str[(i+2)..n];
			else tmp += str[(1+i)..n];
			str = tmp;
		}
	}
	return str[1..(n-1)];
}

int Look_for_char(string str,int anti_char,int char) {
	int i,n, count;
	count = 0;
	n = strlen(str);
	for(i=0;i<n;i++) {
		if (str[i]=='\\') {
			if (i==(n-1)) continue;
			else i++;
		} else if (str[i]==anti_char) count++;
		else if (str[i]==char) {
			count--;
			if (!count) return i;
		}
	}
	return -1;
}

mixed * Parse_Array(string str) {
	string current, rest;
	int len, part, num;
	mixed * ret, data;

	ret = ({
	}
	);

	len = strlen(str);
	if (len<3) return ret;

	str = str[1..len-2];
	while(str!="") {
		while(sscanf(str," %s",str));
		if (str=="") break;
		len = strlen(str);
		if (str[0]=='(') {
			part = Look_for_char(str,'(',')');
			if (part==-1) {
				error("Fatal: illegal array format "+str);
				return 0;
			}
			ret += ({ 
				str[0..part] 			}
			);
			str = part == len-1 ? "" : str[part+1..len-1];
			continue;
		}
		if (str[0]=='[') {
			part = Look_for_char(str,'[',']');
			if (part==-1) {
				error("Fatal: illegal array format "+str);
				return 0;
			}
			ret += Parse_Array(str[0..part]);
			str = part == len-1 ? "" : str[part+1..len-1];
			continue;
		}
		if (str[0]=='{') {
			part = Look_for_char(str,'{','}');
			if (part==-1) {
				error("Fatal: illegal array format "+str);
				return 0;
			}
			ret += ({ 
				str[0..part] 			}
			);
			str = part == len-1 ? "" : str[part+1..len-1];
			continue;
		}

		if (sscanf(str,"%s %s",current, rest)!=2) {
			current = str;
			rest = "";
		}

		if (sscanf(current,"%d",num)) {
			ret += ({ 
				num 			}
			);
			str = rest;
			continue;
		}

		if (!undefinedp(data=_varlist[current])) {
			ret += ({ data });
			str = rest;
			continue;
		}

		if (_e_varlist && !undefinedp(data=_e_varlist[current])) {
			ret += ({ data });
			str = rest;
			continue;
		}

		ret += ({ 
			current 		}
		);
		str = rest;
	}
	return ret;

}

int _exec() {
	mixed i;
	if (!Is_Block(i)) {
		error("exec: not a {block}");
		return -1;
	}
	if (strlen(i)>2)
		insert_input( i[1..strlen(i)-2]);

}

int _randexec() {
	mixed i;
	i = Pop();
	if (!pointerp(i)) {
		error("randexec: not an [array]");
		return -1;
	}
	insert_input("exec");
	return Push(i[random(sizeof(i))]);
}

/* cond { block } if */
int _if() {
	mixed blk;
	blk = Pop();
	if(Pop()) {
		if (!Is_Block(blk)) {
			error("if: block missing");
			return -1;
		}
		if (strlen(blk)>2)
			insert_input(blk[1..(strlen(blk)-2)]);
	}
}

int _ifelse() {
	mixed blkif, blkelse;
	blkelse = Pop();
	blkif = Pop();
	if (Pop()) {
		if (!Is_Block(blkif)) {
			error("ifelse: block missing");
			return -1;
		}
		if (strlen(blkif)>2)
			insert_input(blkif[1..(strlen(blkif)-2)]);
	}
	else {
		if (!Is_Block(blkelse)) {
			error("ifelse: block missing");
			return -1;
		}
		if (strlen(blkelse)>2)
			insert_input(blkelse[1..(strlen(blkelse)-2)]);
	}
}

int _while() {
	mixed blkif, blkdo;
	blkdo = Pop();
	blkif = Pop();
	if (!Is_Block(blkdo) || !Is_Block(blkif) ) {
		error("while: wrong argument type");
		return -1;
	}
	if (Is_empty_block(blkif)) {
		error("while: empty condition block");
		return -1;
	}
	insert_input( blkif[1..(strlen(blkif)-2)]+" "+CONTTOKEN+" {"+
	    blkdo[1..(strlen(blkdo)-2)] + " "+blkif+" "+blkdo+" wHILe } if "+
	    BREAKTOKEN);
	/* grin */
}

/* i know that's ugly, but i don't want to have BREAKTOKEN stacked up
   in the _pending_input in an infinite loop */
int _wHILe() {
	mixed blkif, blkdo;
	blkdo = Pop();
	blkif = Pop();
	if (!Is_Block(blkdo) || !Is_Block(blkif) ) {
		error("while: wrong argument type");
		return -1;
	}
	if (Is_empty_block(blkif)) {
		error("while: empty condition block");
		return -1;
	}
	insert_input( blkif[1..(strlen(blkif)-2)]+" "+CONTTOKEN+" {"+
	    blkdo[1..(strlen(blkdo)-2)] + " "+blkif+" "+blkdo+" wHILe } if");
}


int _forall() {
	mixed blk,data;
	string tmpstr;
	int n;

	blk = Pop();
	data = Pop();
	if (!Is_Block(blk)) {
		error("forall: 1st is not a {block}");
		return -1;
	}
	if (Is_empty_block(blk)) {
		error("forall: empty block");
		return -1;
	}

	if (Is_String(data)) {
		tmpstr = Parse_String(data);
		n = strlen(tmpstr);
		if (n<1) return 0;
		if (n==1) {
			insert_input(blk[1..strlen(blk)-2]+" "+CONTTOKEN+" "+
					BREAKTOKEN);
			return Push(Restore_String(tmpstr));
		}
		insert_input(blk[1..strlen(blk)-2]+" "+CONTTOKEN+" "+
				Restore_String(tmpstr[1..n-1])+blk+" forall "
				+BREAKTOKEN);
		return Push(Restore_String( tmpstr[0..0] ));
	}

/* I hate this ugly code!!! */
	if (pointerp(data)) {
		n = sizeof(data);
		if (n<1) return 0;
		if (n==1) {
			insert_input(blk[1..strlen(blk)-2]+" "+CONTTOKEN+" "+
					BREAKTOKEN);
			return 0;
		}
		insert_input(blk[1..strlen(blk)-2]+" "+CONTTOKEN+" "+
				Restore_Array(data[1..n-1])+blk+" forall"
				+BREAKTOKEN);
		return Push(data[0]);
	}
	error("forall: 2nd is not (string) nor [array]");
	return -1;
}

int _continue() {
	string tmp1,tmp2;
	if(sscanf(_pending_input,"%s "+CONTTOKEN+" %s",tmp1,tmp2)!=2) {
		error("continue: no loop to skip");
		return -1;
	}
	_pending_input = tmp2;
}

int _exit() {
	string tmp1,tmp2;
	if(sscanf(_pending_input,"%s "+BREAKTOKEN+" %s",tmp1,tmp2)!=2) {
		error("exit: no loop to break out of");
		return -1;
	}       
	_pending_input = tmp2;

}

int _and() {
	Push(Pop() && Pop());
}

int _or() {
	Push(Pop() || Pop());
}

int _not() {
	Push(!Pop());
}

int _eq() {
	Push(Pop() == Pop());
}

int _ne() {
	Push(Pop() != Pop());
}

/* "2 1 gt" pushes True (1) onto the stack */
int _gt() {
	mixed i,j;
	i = Pop();
	j = Pop();
	if (intp(i) && intp(j))
		Push(i < j);
	else {
		error("gt: non-integer comparison");
		return -1;
	}
}

int _lt() {
	mixed i,j;
	i = Pop();
	j = Pop();
	if (intp(i) && intp(j))
		Push(i > j);
	else {
		error("lt: non-integer comparison");
		return -1;
	}
}

int _ge() {
	mixed i,j;
	i = Pop();
	j = Pop();
	if (intp(i) && intp(j))
		Push(i <= j);
	else {
		error("ge: non-integer comparison");
		return -1;
	}
}

int _le() {
	mixed i,j;
	i = Pop();
	j = Pop();
	if (intp(i) && intp(j))
		Push(i >= j);
	else {
		error("le: non-integer comparison");
		return -1;
	}
}

string object_to_Object(mixed ob) {
	if (!ob || !objectp(ob)) return 0;
	return OBJTOKEN+file_name(ob);
}

object Object_to_object(string obstr) {
	if (!sscanf(obstr,OBJTOKEN+"%s",obstr)) return 0;
	return find_object(obstr);
}

int _random() {
	mixed i;
	i = Pop();
	if (!intp(i)) {
		error("random: illegal argument");
		return -1;
	}
	if (i<1) {
		error("random: unacceptable arg "+i);
		return -1;
	}
	Push(random(i));
}

int _wtime() {
	mixed i;
	i = Pop();
	if (i && !intp(i)) {
		error("wait_time: illegal argument");
		return -1;
	}
	if (i<1) i = 1;
	if (active_child) active_child->set_wait_time(i);
	else set_wait_time(i);
}

int _pause() {
	if (active_child) return (int) active_child->_pause();
	pause_requested = 1;
	return 0;
}

/* the max and min should depend on the cleverness of the monster */
int _speed() {
	mixed i;
	if (active_child) return (int) active_child->_speed();
	i = Pop();
	if (!i || !intp(i)) return 0;
	if (i>MAX_SPEED) _speed = MAX_SPEED;
	else if (i<2) _speed = 2;
	else _speed = i;
}

int _sleep() {
	mixed i,j;
	if (active_child) return (int) active_child->_sleep();
	i=Pop();
	j=wait_time;
	wait_time = i;
	_counter = -1;
	insert_input(""+j+" wtime");
}

int _list_proc() {
	string todo, statstr;
	int i, n, stat;
	n = number_of_children();
	if (!n) {
		insert_input("(This is the only task I'm doing.) say");
		return 0;
	}
	todo="(I'm doing "+n+" additional tasks.) say ( #  Id    Status) say ";
	n = sizeof(_children);
	for (i=0;i<n;i++) {
		if (_children[i]) {
			stat = (int) _children[i]->query_status();
			if (stat==IDLE) statstr="Idle";
			else if (stat==RUNNING) statstr="Running";
			else if (stat==INCOMPLETE_INPUT) statstr="Incmplt";
			else if (stat==PAUSED) statstr="Paused";
			else if (stat==ERROR) statstr="Error";

			todo+=sprintf("(%2d %7s %8s) say ",i,
				_children[i]->query_process_id(),statstr);
		}
	}
	insert_input(todo);
	return 0;
}

object Find_process(mixed clue) {
	int i,n;
	if (intp(clue)) {
		if (clue<0 || clue>= sizeof(_children)) {
			return 0;
		}
		if (_children[clue]) {
			return _children[clue];
		}
		return 0;
	}

	if (Is_String(clue)) {
		clue = clue[1..(strlen(clue)-2)];
		n = sizeof(_children);
		for (i=0; i<n; i++) {
			if (_children[i] && (string)
			    _children[i]->query_process_id()==clue) {
				return _children[i];
			}
		}
	}

	if (objectp(clue)) {
		for(i=0;i<n;i++) if (clue==_children[i]) return _children[i];
	}

	return 0;
}

int _pause_proc() {
	mixed data;
	int i,n;
	object child;
	data = Pop();
	child = Find_process(data);
	if (!child) {
		error("pause_proc: no such process");
		return -1;
	}
	child->pause();
}

int _kill_proc() {
	mixed data;
	int i,n;
	object child;
	data = Pop();
	child = Find_process(data);
	if (!child) {
		error("kill_proc: no such process");
		return -1;
	}
	destruct(child);
}

/* similar to fork() in unix */
int _spawn() {
	mixed i, n, data;
	int j, num, hash_num, childnum;
	object child;
	string childname, varname, todo;

	if (active_child) return (int) active_child->_spawn();
	i = Pop();
	if (_process_id != ROOT) {
		error("_spawn: Child can't spawn process.");
		return -1; /* could be a restriction, but what the heck! */
	}
	if ( (num=number_of_children()) >= _max_ch_size) {
		error("_spawn: Can't spawn anymore");
		return -1;
	}
	if (!stringp(i) || strlen(i)<2) {
		error("_spawn: Invalid argument");
		return -1;
	}

	for(j=0;j<sizeof(_children);j++) {
		if (!_children[j]) {
			childnum = j;
			break;
		}
	}

	if (Is_Block(i)) {
		childname = "proc "+childnum;
		todo = i[1..(strlen(i)-2)];
	}
	else {
		if (!sscanf(i,"\/%s",varname) ) {
			error("spawn: Illegal var format.");
			return -1;
		}
		if (Find_process("("+varname+")")) {
			error("spawn: Identical process exists!");
			return -1;
		}

		if (undefinedp(data=_varlist[varname]) ) {
			error("spawn: variable "+varname+" not found");
			return -1;
		}

		if (!Is_Block(data)) {
			error("spawn: non-block data "+varname);
			return -1;
		}
		todo = data[1..(strlen(data)-2)];
	}

	child = clone_object(THIS_FILE);
	export_uid(child);
	_children[childnum]=child;
	child->set_parent(this_object());
	child->set_this_play(this_play);
	child->set_process_id(childname);
	child->set_children(_children);
	child->Reset();
	child->set__speed(_speed);
	child->Compile(todo);
	_counter = 0;
	return 0;
}

int number_of_children() {
	int i,n, ret ;
	for (i=0,n=sizeof(_children); i<n; i++) {
		if (_children[i]) ret ++;
	}
	return ret;
}

void Next() {
	if (pause_requested) {
		pause_requested = 0;
		_status = PAUSED;
		return;
	}
	if (!_counter) call_out("Compile",wait_time);
	else Compile();
}

varargs int Compile(mixed input) {
	mixed data;
	string rawstr, str, current, rest, tmp1,tmp2;
	int i,n, last, hash_num;
	int num;

	_status = RUNNING;
	if (input) { /* new command */

		if (!stringp(input)) {
			error("Compile: only accepts strings");
			return -1;
		}

		/* ignore comment lines */
		while(sscanf(input," %s",input) ||
		    sscanf(input,"\t%s",input));
		if (input!="" && input[0]=='%') input="";
		if (sscanf(input,"%s"+CONTTOKEN,tmp1)) {
			if (tmp1!="" && tmp1[strlen(tmp1)-1]!='\\') {
				error("Compile: Cont. token "+CONTTOKEN+" found.");
				return -1;
			}
		}

		if (sscanf(input,"%s"+BREAKTOKEN,tmp1) ) {
			if (tmp1!="" && tmp1[strlen(tmp1)-1]!='\\') {
				error("Compile: break token "+BREAKTOKEN+" found.");
				return -1;
			}
		}

		if (sscanf(input,"%s"+OBJTOKEN,tmp1)) {
			if (tmp1!="" && tmp1[strlen(tmp1)-1]!='\\') {
				error("Compile: Obj token "+OBJTOKEN+" found.");
				return -1;
			}
		}

		/* append input to _pending_input */
		if (!_pending_input || _pending_input=="") {
			_pending_input = input;
		}
		else if (_pending_input==" ") {
			_pending_input = " "+input;
		}
		else {
			n = strlen(_pending_input);
			if (_pending_input[n-1]==' ')
			_pending_input = _pending_input + input;
			else
			_pending_input = _pending_input+" "+input;
		}
		remove_call_out("Compile");
		call_out("Compile", wait_time);
		return 0;
	}

	if(!_pending_input) {
		_status = IDLE;
		if (_process_id) destruct(this_object());
		return 0;
	}
	remove_call_out("Compile");
	while(sscanf(_pending_input," %s",_pending_input) ||
	    sscanf(_pending_input,"\t%s",_pending_input) );
	if (_pending_input=="") {
		_pending_input = 0;
		_status = IDLE;
		if (_process_id) destruct(this_object());
		return 0;
	}

	str = _pending_input;
	_pending_input=" ";
	_pending_bracket=0;
	_pending_parenthese=0;

	_counter = (_counter + 1) % _speed;

	if (str[0]=='(') {
		n=strlen(str);
		_pending_parenthese=1;
		last=0;
		for(i=1;i<n;i++) {
			if (str[i]=='\\') {
				if (i==(n-1)) continue;
				else i++; /* skip the next char */
			}
			else if (str[i]=='(') _pending_parenthese++;
			else if (str[i]==')') {
				_pending_parenthese--;
				last = i;
			}

			if (!_pending_parenthese) break;
		}

		if (!_pending_parenthese) {
			if (last >= (n-1) ) { /* the whole string */
				Push(str);
				_status = IDLE;
				return 0;
			}
			else {
				Push(str[0..last]);
				insert_input(str[(last+1)..(n-1)]);
				Next();
				return 0;
			}
		}
		else {
			insert_input(str);
			_status = INCOMPLETE_INPUT;
			return 0;
		}
	}

	if (str[0]=='{') {
		n=strlen(str);
		_pending_bracket=1;
		last=0;
		for(i=1;i<n;i++) {
			if (str[i]=='\\') {
				if (i==(n-1)) continue;
				else i++; /* skip the next char */
			}
			else if (str[i]=='{') _pending_bracket++;
			else if (str[i]=='}') {
				_pending_bracket--;
				last = i;
			}

			if (!_pending_bracket) break;
		}

		if (!_pending_bracket) {
			if (last >= (n-1) ) {
				Push(str);
				_status = IDLE;
				return 0;
			}
			else {
				Push(str[0..last]);
				insert_input(str[(last+1)..(n-1)]);
				Next();
				return 0;
			}
		}
		else {
			insert_input(str);
			_status = INCOMPLETE_INPUT;
			return 0;
		}
	}

	if (str[0]=='[') {
		mixed arry;
		n=strlen(str);
		_pending_square_brk=1;
		last=0;
		for(i=1;i<n;i++) {
			if (str[i]=='\\') {
				if (i==(n-1)) continue;
				else i++; /* skip the next char */
			}
			else if (str[i]=='[') _pending_square_brk++;
			else if (str[i]==']') {
				_pending_square_brk--;
				last = i;
			}

			if (!_pending_square_brk) break;
		}

		if (!_pending_square_brk) {
			if (last >= (n-1) ) {
				arry = Parse_Array(str);
				if (!arry) {
					_status = ERROR;
					return 0;
				}
				Push(arry);
				_status = IDLE;
				return 0;
			}
			else {
				arry = Parse_Array(str[0..last]);
				insert_input(str[(last+1)..(n-1)]);
				if (!arry) {
					_status = ERROR;
					return 0;
				}
				Push(arry);
				Next();
				return 0;
			}
		}
		else {
			insert_input(str);
			_status = INCOMPLETE_INPUT;
			return 0;
		}
	}

	if(sscanf(str,"%s %s", current, rest)!=2) {
		current = str;
		rest = "";
	}

	if (sscanf(current,"%s\{%s",tmp1,tmp2)==2) {
		current = tmp1;
		rest = "\{"+tmp2+" "+rest;
	}

	if (sscanf(current,"%s\[%s",tmp1,tmp2)==2) {
		current = tmp1;
		rest = "\["+tmp2+" "+rest;
	}

	if (sscanf(current,"%s\(%s",tmp1,tmp2)==2) {
		current = tmp1;
		rest = "\("+tmp2+" "+rest;
	}

	if (current==BREAKTOKEN || current==CONTTOKEN) {
		_pending_input=rest+_pending_input;
		Next();
		return 0;
	}

	if (current[0]=='/') {
		if (strlen(current)==1) {
			error("Compile: missing variable id");
			return -1;
		}
		Push(current);
		_pending_input=rest+_pending_input;
		Next();
		return 0;
	}

	if (sscanf(current, "%d", num)) {
		Push(num);
		_pending_input=rest+_pending_input;
		Next();
		return 0;
	}

	if (Is_Object(current) ) {
		Push(Object_to_object(current));
		_pending_input=rest+_pending_input;
		Next();
		return 0;
	}

	if (!undefinedp(data=_varlist[current]) ||
	    (_parent && !undefinedp(data=_e_varlist[current])) ) {
		if (Is_Block(data)) {
			if (strlen(data)>2) {
				insert_input(rest);
				insert_input(data[1..(strlen(data)-2)]);
			}
			else {
				_pending_input=rest+ _pending_input;
			}
		}
		else {
			Push(data);
			_pending_input = rest+_pending_input;
		}
		Next();
		return 0;
	}

	if (current[0]>='a' &&
	    current[0]<='z') {
                /* necessary for child process */
                if (_parent && function_exists("_"+current,_parent)) {
			_parent->set_active_child(this_object());
                        _pending_input=rest+_pending_input;
                        if((int)call_other(_parent,
                           "_"+current)==-1 || _status == ERROR) {
				_parent->set_active_child(0);
                                return -1;
                        }
			_parent->set_active_child(0);
                        Next();
                        return 0;
                }
		if (function_exists("_"+current, this_object())) {
			_pending_input=rest+_pending_input;
			if((int)call_other(this_object(), "_"+current)==-1 ||
			   _status == ERROR ) {
				return -1;
			}
			Next();
			return 0;
		}
	}

	/* couldn't find variable in memory */
	error("Compile: Unknown variable/operation "+current);
}