/**********************************************************************
 
	Copyright (C) 2003 Hirohisa MORI <joshua@nichibun.ac.jp>
 
	This program is free software; you can redistribute it 
	and/or modify it under the terms of the GLOBALBASE 
	Library General Public License (G-LGPL) as published by 

	http://www.globalbase.org/
 
	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.

**********************************************************************/


#include	"memory_debug.h"
#include	"xlerror.h"
#include	"xl.h"
#include	"lock_level.h"
#include	"memory_routine.h"

XL_SEXP * xl_Thread();

/*
typedef struct op_data {
	XL_SEXP *		args;
	XLISP_ENV *		env;
	D_SEXP *		delay;
	int			ok_flag;
} OP_DATA;
*/

typedef struct th_data {
	struct th_data *	next;
	int			parent_tid;
	int			child_tid;
	int			child_iid;
	D_SEXP *		delay;
	unsigned 		use_DelayAppend:1;
	unsigned		ok_flag:1;
	unsigned		release_base_flag:1;
	XLISP_ENV * 		env;
	XL_SEXP *		args;
} TH_DATA;

SEM sthread_lock;
TH_DATA * sthread_list;

void Thread_op_task(TKEY d);
XL_SEXP * xl_DearyAppend(XLISP_ENV * env,XL_SEXP * s,XLISP_ENV * a,XL_SYM_FIELD * sf);
void _insert_th_data_list(TH_DATA * d);
void _delete_th_data_list(TH_DATA * d);
TH_DATA * _search_th_data_by_child(int tid);
XL_SEXP * xl_KillThread(XLISP_ENV * env,XL_SEXP * s);
TH_DATA * _search_th_data_by_delay(D_SEXP * delay);
TH_DATA * _search_th_data_by_parent(int tid);


void gc_gb_sexp();

void
init_Thread(XLISP_ENV * env)
{
	sthread_lock = new_lock(LL_STHREAD);
	set_env(env,l_string(std_cm,"Thread"),
		get_func_prim(xl_Thread,FO_NORMAL,0,1,-1));
	set_env(env,l_string(std_cm,"DelayAppend"),
		get_func_prim(xl_DearyAppend,FO_APPLICATIVE,0,2,2));
	set_env(env,l_string(std_cm,"KillThread"),
		get_func_prim(xl_KillThread,FO_APPLICATIVE,0,1,2));

}

void
_insert_th_data_list(TH_DATA * d)
{
	d->next = sthread_list;
	sthread_list = d;
}

void
_delete_th_data_list(TH_DATA * d)
{
TH_DATA ** p;
	for ( p = &sthread_list ; *p ; p = &(*p)->next )
		if ( *p == d ) {
			*p = d->next;
			d_f_ree(d);
			return;
		}
}

TH_DATA *
_search_th_data_by_child(int tid)
{
TH_DATA * d;
	for ( d = sthread_list ; d ; d = d->next )
		if ( d->child_tid == tid )
			return d;
	return 0;
}

TH_DATA *
_search_th_data_by_delay(D_SEXP * delay)
{
TH_DATA * d;
	for ( d = sthread_list ; d ; d = d->next )
		if ( d->delay == delay )
			return d;
	return 0;
}

TH_DATA *
_search_th_data_by_parent(int tid)
{
TH_DATA * d;
	for ( d = sthread_list ; d ; d = d->next )
		if ( d->parent_tid == tid )
			return d;
	return 0;
}




void
Thread_op_task(TKEY d)
{
XL_SEXP * args, * ret;
XLISP_ENV * env;
TH_DATA * dd;
XL_INTERPRETER * xli;
D_SEXP * delay;
void gc_d_sexp();
	xli = new_xl_interpreter();
	xli->a_type = XLA_SELF;
	setup_xl_interpreter(xli);

	dd = (TH_DATA*)GET_TKEY(d);
	args = dd->args;
	env = dd->env;
	delay = dd->delay;
	lock_mem();
	gc_set_nl(delay,gc_d_sexp);
	unlock_mem();

	gc_push(cons(get_env(env),args),gc_gb_sexp,"1");

	lock_task(sthread_lock);
	dd->child_iid = xli->id;
	dd->child_tid = get_tid();
	dd->ok_flag = 1;
	wakeup_task((int)dd);
	unlock_task(sthread_lock,"xl_thread");
	
	ret = 0;
	if ( get_type(args) == XLT_PAIR )
		for ( args = cdr(args) ; ; ) {
			gc_push(0,0,"2");
			ret = eval(env,car(args));
			if ( get_type(ret) == XLT_ERROR ) {
				gc_pop(ret,gc_gb_sexp);
				break;
			}
			args = cdr(args);
			if ( get_type(args) != XLT_PAIR ) {
				gc_pop(ret,gc_gb_sexp);
				break;
			}
			gc_pop(0,0);
		}
	lock_task(sthread_lock);
	if ( dd->use_DelayAppend == 0 || get_type(ret) == XLT_ERROR ) {
		set_d_sexp(dd->delay,ret);
	}
	else if ( dd->use_DelayAppend && get_type(ret) == XLT_ERROR ) {
		set_d_sexp(dd->delay,List(ret,-1));
	}
	else {
		set_d_sexp(dd->delay,0);
	}
	for ( ; dd->release_base_flag == 0 ; ) {
		sleep_task((int)dd,sthread_lock);
		lock_task(sthread_lock);
	}
	_delete_th_data_list(dd);
	unlock_task(sthread_lock,"xl_thread");

	gc_pop(0,0);

}

XL_SEXP *
xl_Thread(XLISP_ENV * env,XL_SEXP * s,XLISP_ENV * a,XL_SYM_FIELD * sf)
{
TH_DATA * dd;
L_CHAR * pri;
int _pri;
XL_SEXP * ret;
	pri = get_sf_attribute(sf,l_string(std_cm,"pri"));
	if ( pri == 0)
		_pri = 3;
	else	_pri = atoi(n_string(std_cm,pri));
	dd = d_alloc(sizeof(*dd));
	memset(dd,0,sizeof(*dd));
	dd->parent_tid = get_tid();
	dd->args = s;
	dd->env = env;
	ret = new_d_sexp(&dd->delay);
	dd->ok_flag = 0;
	lock_task(sthread_lock);
	_insert_th_data_list(dd);
	create_task(Thread_op_task,(int)dd,_pri);
	for ( ; dd->ok_flag == 0 ; ) {
		sleep_task((int)dd,sthread_lock);
		lock_task(sthread_lock);
	}
	dd->release_base_flag = 1;
	wakeup_task((int)dd);
	unlock_task(sthread_lock,"xl_thread");
	return ret;
}


XL_SEXP * 
xl_DearyAppend(XLISP_ENV * env,XL_SEXP * s,XLISP_ENV * a,XL_SYM_FIELD * sf)
{
XL_SEXP * d_data, * d;
TH_DATA * td;
D_SEXP * n_delay;
	d_data = get_el(s,1);
	switch ( get_type(d_data) ) {
	case XLT_PAIR:
		d_data = reverse(d_data);
		d = new_d_sexp(&n_delay);
		for ( ; get_type(d_data) == XLT_PAIR ; ) {
			d = cons(car(d_data),d);
			d_data = cdr(d_data);
		}
		d_data = d;
		break;
	default:
		n_delay = 0;
		break;
	}
	lock_task(sthread_lock);
	td = _search_th_data_by_child(get_tid());
	if ( td->delay == 0 ) {
		unlock_task(sthread_lock,"DelayAppend");
		goto invalid_command;
	}
	set_d_sexp(td->delay,d_data);
	if ( n_delay )
		td->delay = n_delay;
	td->use_DelayAppend = 1;
	unlock_task(sthread_lock,"DelayAppend");
	return 0;
invalid_command:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_UNSUPPORT_MODE,
		l_string(std_cm,"DelayAppend"),
		n_get_string(
			"this command cannot use in this thread"));
}

void
kill_thread(XL_SEXP * target)
{
D_SEXP * delay;
TH_DATA * td;
int tid;
	if ( target ) {
		lock_task(sthread_lock);
		delay = search_d_sexp(target);
		if ( delay ) {
			td = _search_th_data_by_delay(delay);
			if ( td )
				send_cancel(td->child_iid);
		}
		unlock_task(sthread_lock,"xl_KillThread");
	}
	else {
		lock_task(sthread_lock);
		tid = get_tid();
		for ( ; ; ) {
			td = _search_th_data_by_parent(tid);
			if ( td == 0 )
				break;
			send_cancel(td->child_iid);
		}
		unlock_task(sthread_lock,"xl_Killthread");
	}
}

XL_SEXP *
xl_KillThread(XLISP_ENV * env,XL_SEXP * s)
{
XL_SEXP * sym;
	if ( list_length(s) == 2 ) {
		sym = get_el(s,1);
	}
	else {
		sym = 0;
	}
	kill_thread(sym);
	return 0;
}

