/**********************************************************************
 
	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	<fcntl.h>
#include	<stdlib.h>
#include	"memory_debug.h"
#include	"memory_routine.h"
#include	"gbparam.h"
#include	"task.h"
#include	"server.h"
#include	"xl.h"
#include	"utils.h"
#include	"xlerror.h"
#include	"lock_level.h"
#include	"pri_level.h"

#define LOCK_FUNCTION_TIMEOUT	(10*60)
#define FATAL_TIMEOUT	3600
#define XL_OPEN_TIMEOUT	(2*60)
#define ACCEPT_RET_MAX			120
#define ACCEPT_RET_TIMEOUT		10
#define ACCEPT_RET_DEC_INTERVAL		120
#define CR_SEND_INTERVAL		30

typedef struct lock_function_type {
	struct lock_function_type *	next;
	XL_INTERPRETER * 		xli;
	unsigned int			time;
	int				type;
	int				flags;
} LOCK_FUNCTION_TYPE;

int * _accept_tid;
int _accept_ptr;

int cmd_log;

void gc_gb_sexp();
SEM xli_lock,fifo_lock,sem_xli_lex_lock;
XL_INTERPRETER * main_interpreter;
int main_interpreter_flag;
XL_INTERPRETER * interpreter_hash[INTERPRETER_HASH_SIZE];
XL_THREAD * thread_hash[THREAD_HASH_SIZE];
unsigned int xli_id;
void _close_xl_interpreter(XL_INTERPRETER * xli);

SYS_QUEUE interpreter_que;
int interpreter_que_task;

L_CHAR * lock_function;
LOCK_FUNCTION_TYPE * lf_list;

int (* agent_open_xli)();
int (* agent_close_xli)();

void
test_thread()
{
XL_THREAD * th;
int i;
	for ( i = 0 ; i < THREAD_HASH_SIZE ; i ++ )
		for ( th = thread_hash[i] ; th ; th = th->next ) {
			printf("thread %i %i %i - %i\n",th->tid,
				th->xli->front_thread,
				th->xli->relay_thread,
				th->xli->mode);
		}
	printf(" \n");
}


void
close_all_interpreter();
void
_front_thread();
void
_relay_thread();
void
_accept_thread();
void xli_tick();

XL_SEXP * _xli_break_check();
int xl_int_handler();
char site_name[100];
void delay_thread();


void gc_ique();
void gc_get_ique();

void
gc_interpreter()
{
XL_INTERPRETER * xli;
int i;

	for ( i = 0 ; i < INTERPRETER_HASH_SIZE ; i ++ )
		for ( xli = interpreter_hash[i] ; xli ; 
				xli = xli->next ) {
			gc_xl_fifo(xli->fifo_head);
			gc_gblisp_env(xli->env);
		}
}

void
sp_gc_result1(XL_INTERPRETER * xli)
{
XL_RESULT ** rpp, * resp;
void remote_session_tick();
	for ( rpp = &xli->result_head ; *rpp ; ) {
		resp = *rpp;
		if ( TEST_MEM(resp) ) {
			rpp = &resp->next;
			continue;
		}
		if ( resp->s_id )
			new_tick(remote_session_tick,0,(int)resp->s_session);
		*rpp = resp->next;
		if ( xli->result_head == 0 )
			wakeup_task((int)&xli->result_head);
	}
}

void
sp_gc_result2(XL_INTERPRETER * xli)
{
XL_RESULT * resp;
	for ( resp = xli->result_list ; resp ;
			resp = resp->my_xli_result_next )
		gc_remote_delay(resp);
}


void
sp_gc_interpreter()
{
XL_INTERPRETER * xli;
int i;
	for ( i = 0 ; i < INTERPRETER_HASH_SIZE ; i ++ )
		for ( xli = interpreter_hash[i] ; xli ; 
				xli = xli->next )
			sp_gc_result1(xli);
	for ( i = 0 ; i < INTERPRETER_HASH_SIZE ; i ++ )
		for ( xli = interpreter_hash[i] ; xli ; 
				xli = xli->next )
			sp_gc_result2(xli);
}

void
init_interpreter()
{

	xli_lock = new_lock(LL_XLI);
	fifo_lock = new_lock(LL_XL_FIFO);
	sem_xli_lex_lock = new_lock(LL_XLI_LEX);

	memset(&interpreter_que,0,sizeof(SYS_QUEUE));
	interpreter_que.flags = QF_FIFO|QF_HIGH;
	interpreter_que.gc_func = gc_ique;
	interpreter_que.gc_get = gc_get_ique;
	interpreter_que.key_func = 0;
	interpreter_que.pri = PRI_XL_RELAY;
	setup_queue(&interpreter_que);

	xli_id = 1;
	new_tick(xli_tick,1,0);

	break_check = _xli_break_check;
	int_handler = xl_int_handler;
	get_localhostname(site_name);
	gblisp_site = nl_copy_str(std_cm,&site_name[0]);

	create_task(delay_thread,0,PRI_XL_RELAY);
}

void
gc_ique(DELAY_QUE_T * n)
{
	gc_gb_sexp(n->ret);
}

void
gc_get_ique(DELAY_QUE_T * n)
{
	lock_mem();
	gc_set_nl(n->ret,gc_gb_sexp);
	unlock_mem();
}

void
set_lock_function(L_CHAR * func)
{
	if ( lock_function )
		d_f_ree(lock_function);
	if ( func )
		lock_function = ll_copy_str(func);
	else	lock_function = 0;
}

void
inp_lock_function(L_CHAR * func)
{
LOCK_FUNCTION_TYPE w;
LOCK_FUNCTION_TYPE ** wp, * wpp;
	lock_task(xli_lock);
	if ( lock_function == 0 )
		goto end;
	w.xli = _get_my_xli();
	if ( w.xli->flags & XIF_LOCK_DISE )
		goto end;
	if ( w.xli->flags & XIF_LOCK_F )
		goto lock_phase;
	if ( func == 0 )
		goto end;
	if ( l_strcmp(lock_function,func) == 0 )
		goto lock_phase;
	else	goto end;

lock_phase:
	for ( wpp = lf_list ; wpp ; wpp = wpp->next )
		if ( wpp->xli == w.xli && wpp->type == 1 ) {
			wakeup_task((int)wpp);
			w.xli->flags &= ~XIF_LOCK_F;
			w.xli->flags |= w.flags & XIF_LOCK_F;
			goto end;
		}
	w.next = lf_list;
	w.type = 0;
	w.time = get_xltime();
	lf_list = &w;
	sleep_task((int)&w,xli_lock);
	lock_task(xli_lock);
	for ( wp = &lf_list ; *wp ; wp = &(*wp)->next )
		if ( *wp == &w ) {
			*wp = w.next;
			break;
		}
end:
	unlock_task(xli_lock,"inp_lock_function");
}

void
out_lock_function(int flags)
{
XL_INTERPRETER * xli;
LOCK_FUNCTION_TYPE * wp, ** wpp;
LOCK_FUNCTION_TYPE w;

	lock_task(xli_lock);
	xli = _get_my_xli();
	if ( xli->flags & XIF_LOCK_DISE )
		goto end2;
	for ( wp = lf_list ; wp ; wp = wp->next )
		if ( wp->xli == xli ) {
			wakeup_task((int)wp);
			goto end;
		}
	w.xli = xli;
	w.flags = flags;
	w.type = 1;
	w.next = lf_list;
	w.time = get_xltime();
	lf_list = &w;
	sleep_task((int)&w,xli_lock);
	lock_task(xli_lock);
	for ( wpp = &lf_list ; *wpp ; wpp = &(*wpp)->next )
		if ( *wpp == &w ) {
			*wpp = w.next;
			break;
		}
end:
	xli->flags |= flags&XIF_LOCK_F;
end2:
	unlock_task(xli_lock,"out_lock_function");
}

void
timeout_lock_function()
{
LOCK_FUNCTION_TYPE * wp;
unsigned int t;

	t = get_xltime();
	for ( wp = lf_list ; wp ; wp = wp->next )
		if ( wp->time + LOCK_FUNCTION_TIMEOUT < t ) {
			wp->xli->flags |= XIF_LOCK_DISE;
			wakeup_task((int)wp);
		}
}

XL_FILE * terminal_file;

int
terminal_prompt(STREAM * s,int cc)
{
int cnt;
XL_DELAY * d;
	if ( terminal_file == 0 )
		return 0;
	d = terminal_file->stack;
	for ( cnt = -1 ; d ; d = d->next , cnt ++ );
	if ( cnt == 0 && cc )
		return 0;
	s_printf(s,"%i>",cnt);
	s_flush(s);
	return 0;
}

int
terminal_prompt_2(STREAM * s)
{
int cnt;
XL_DELAY * d;
	if ( terminal_file == 0 )
		return 0;
	d = terminal_file->stack;
	for ( cnt = -1 ; d ; d = d->next , cnt ++ );
	s_printf(s,"%i>",cnt);
	s_flush(s);
	return 0;
}



void
_lock_xli_out(XL_INTERPRETER * xli)
{
int t;
	if ( xli == 0 )
		return;
	t = get_tid();
	if ( xli->out_lock == 0 ) {
retry:
		xli->out_lock = 1;
		xli->out_lock_task = t;
		return;
	}
	if ( xli->out_lock_task == t ) {
		xli->out_lock ++;
		return;
	}
	for ( ; xli->out_lock ; ) {
		sleep_task((int)&xli->out_lock,xli_lock);
		lock_task(xli_lock);
	}
	goto retry;
}

void
lock_xli_out(XL_INTERPRETER * xli)
{
	lock_task(xli_lock);
	_lock_xli_out(xli);
	unlock_task(xli_lock,"lock_xli_out");
}

int
_lock_xli_out_no_wait(XL_INTERPRETER * xli)
{
int t;
	if ( xli == 0 )
		return -1;
	t = get_tid();
	if ( xli->out_lock == 0 ) {
		xli->out_lock = 1;
		xli->out_lock_task = t;
		return 0;
	}
	if ( xli->out_lock_task == t ) {
		xli->out_lock ++;
		return 0;
	}
	return -2;
}

int
lock_xli_out_no_wait(XL_INTERPRETER * xli)
{
int ret;
	lock_task(xli_lock);
	ret = _lock_xli_out_no_wait(xli);
	unlock_task(xli_lock,"lock_xli_out");
	return ret;
}

void
_unlock_xli_out(XL_INTERPRETER * xli)
{
	if ( xli == 0 )
		return;
	xli->out_lock --;
	if ( xli->out_lock == 0 )
		wakeup_task((int)&xli->out_lock);
}

void
unlock_xli_out(XL_INTERPRETER * xli)
{
	lock_task(xli_lock);
	_unlock_xli_out(xli);
	unlock_task(xli_lock,"unlock_xli_out");
}

void
lock_xli_out_iid(int iid)
{
XL_INTERPRETER * xli;
	lock_task(xli_lock);
	_lock_xli_out(_search_xli_id(iid));
	unlock_task(xli_lock,"lock_xli_out_iid");
}

void
unlock_xli_out_iid(int iid)
{
	lock_task(xli_lock);
	_unlock_xli_out(_search_xli_id(iid));
	unlock_task(xli_lock,"unlock_xli_out_iid");
}



void
xli_lex_lock(XL_FILE * f)
{
XL_INTERPRETER * xli;

	xli = f->work;
	lock_xli_out(xli);
	s_printf(xli->out,"\013");
	s_flush(xli->out);
}

void
xli_lex_unlock(XL_FILE * f)
{
XL_INTERPRETER * xli;

	xli = f->work;
	unlock_xli_out(xli);
}

void
xli_lex_result(XL_FILE * f)
{
XL_INTERPRETER * xli;


	lock_task(sem_xli_lex_lock);
	xli = f->work;
	wakeup_task((int)&xli->out);
	unlock_task(sem_xli_lex_lock,"xli_lex_result");
}

void
_xli_page_feed(XL_INTERPRETER*xli)
{
	s_printf(xli->out,"\014\n");
	s_set_cr(xli->out,1);
	s_flush(xli->out);
}

void
xli_page_feed(int iid)
{
XL_INTERPRETER * xli;
	lock_task(xli_lock);
	xli = _search_xli_id(iid);
	_xli_page_feed(xli);
	unlock_task(xli_lock,"xli_page_feed");
}



void
new_permission_list(XL_INTERPRETER * xli,XL_SEXP * mode)
{
PERMISSION_LIST * pl;
P_MODE * pm;
XL_SEXP * r;
	pl = d_alloc(sizeof(*pl));
	pl->mode = 0;
	for ( ; get_type(mode) ; mode = cdr(mode) ) {
		pm = d_alloc(sizeof(*pm));
		pm->next = pl->mode;
		pl->mode = pm;
		r = car(mode);
		pm->name = ll_copy_str(r->string.data);
	}
	init_access_permission(&pl->ap);
	pl->next = 0;
	lock_task(xli_lock);
	if ( xli->pl_head ) {
		xli->pl_tail->next = pl;
		xli->pl_tail = pl;
	}
	else	xli->pl_head = xli->pl_tail = pl;
	unlock_task(xli_lock,"new_permission_list");
}

PERMISSION_LIST *
check_permission_list(XL_INTERPRETER * xli,int ip)
{
PERMISSION_LIST * pl;
	for ( pl = xli->pl_head ; pl ; pl = pl->next ) {
		if ( check_permission(&pl->ap,ip) == AP_DENY )
			continue;
		return pl;
	}
	return 0;
}

void
free_permission_list(XL_INTERPRETER * xli)
{
PERMISSION_LIST * pl;
P_MODE * pm;

	for ( ; xli->pl_head ; ) {
		pl = xli->pl_head;
		xli->pl_head = pl->next;
		free_access_list(&pl->ap);
		for ( ; pl->mode ; ) {
			pm = pl->mode;
			pl->mode = pm->next;
			d_f_ree(pm->name);
			d_f_ree(pm);
		}
		d_f_ree(pl);
	}
	xli->pl_tail = 0;
}

int
_new_xli_thread(XL_INTERPRETER * xli)
{
unsigned int key,tid;
XL_THREAD * t;
	lock_task(xli_lock);
	t = d_alloc(sizeof(*t));
	t->xli = xli;
	tid = t->tid = get_tid();
	key = tid%THREAD_HASH_SIZE;
	t->next = thread_hash[key];
	thread_hash[key] = t;
	unlock_task(xli_lock,"_new_xli_thread");
	return tid;
}

void
_free_xli_thread()
{
unsigned int tid,key;
XL_THREAD ** tp,*  tt;
	tid = get_tid();
	key = tid%THREAD_HASH_SIZE;
	for ( tp = &thread_hash[key] ; *tp ; tp = &(*tp)->next )
		if ( (*tp)->tid == tid ) {
			tt = *tp;
			*tp = tt->next;
			d_f_ree(tt);
			close_thread_area();
			return;
		}

}

XL_INTERPRETER *
_get_my_xli()
{
unsigned int tid,key;
XL_THREAD * t;
XL_INTERPRETER * xli;

	tid = get_tid();
	key = tid%THREAD_HASH_SIZE;
	for ( t = thread_hash[key] ; t ; t = t->next )
		if ( t->tid == tid )
			return t->xli;
	return 0;
}

XL_INTERPRETER *
get_my_xli()
{
XL_INTERPRETER * xli;
	lock_task(xli_lock);
	xli = _get_my_xli();
	unlock_task(xli_lock,"get_my_xli");
	return xli;
}


XL_INTERPRETER * 
_search_xli_thread(unsigned int tid)
{
XL_THREAD * t;
unsigned int key;
	key = tid%THREAD_HASH_SIZE;
	for ( t = thread_hash[key] ; t ; t = t->next )
		if ( t->tid == tid )
			return t->xli;
	return 0;
}

int
get_my_iid()
{
XL_INTERPRETER * xli;
int ret;
	lock_task(xli_lock);
	xli = _get_my_xli();
	ret = xli->id;
	unlock_task(xli_lock,"get_my_iid");
	return ret;
}


int
get_main_interpreter()
{
XL_INTERPRETER * xli;
int ret;
	lock_task(xli_lock);
	xli = main_interpreter;
	if ( xli == 0 )
		ret = -1;
	else 	ret = xli->id;
	unlock_task(xli_lock,"get_my_iid");
	return ret;
}

XL_SEXP *
_xli_break_check(XL_SEXP * s)
{
int tid;
XL_SEXP * ret;
XL_INTERPRETER * xli;
	tid = get_tid();
	ret = 0;
	lock_task(xli_lock);
	xli = _get_my_xli();
	if ( xli->mode != XIM_RUN ) {
ss_printf("xli_break_check 1\n");
		ret = get_error(
			s->h.file,
			s->h.line,
			XLE_SYSTEM_EXIT,
			l_string(std_cm,"break"),
			0);
	}
	if ( xli->flags & XIF_BREAK ) {
ss_printf("xli_break_check 2\n");
		ret = get_error(
			s->h.file,
			s->h.line,
			XLE_SYSTEM_EXIT,
			l_string(std_cm,"break"),
			0);
	}
	else if ( xli->flags & XIF_CANCEL ) {
		ret = get_error(
			s->h.file,
			s->h.line,
			XLE_SYSTEM_INTERRUPT,
			l_string(std_cm,"cancel"),
			0);
	}
end:
	unlock_task(xli_lock,"xli_break_check");
	return ret;
}

XL_INTERPRETER *
_search_xli_id(unsigned int id)
{
unsigned int key;
XL_INTERPRETER * xli;

	key = id%INTERPRETER_HASH_SIZE;
	xli = interpreter_hash[key];
	for ( ; xli && xli->id != id ; xli = xli->next );
	return xli;
}

XL_INTERPRETER *
search_xli_id(int id)
{
XL_INTERPRETER * ret;
	lock_task(xli_lock);
	ret = _search_xli_id((unsigned int)id);
	unlock_task(xli_lock,"search_xli_id");
	return ret;
}

int
check_iid(int id)
{
XL_INTERPRETER * xli;
int ret;
	lock_task(xli_lock);
	xli = _search_xli_id(id);
	if ( xli == 0 ) {
		ret = 0;
		goto end;
	}
	if ( xli->mode != XIM_RUN ) {
		ret = 0;
		goto end;
	}
	ret = 1;
end:
	unlock_task(xli_lock,"check_iid");
	return ret;
}

int
_get_xli_id()
{
int id;
	for ( ; ; ) {
		if ( _search_xli_id(xli_id) == 0 )
			break;
		xli_id ++;
		if ( xli_id >= 0x80000000 )
			xli_id = 1;
	}
	id = xli_id;
	xli_id ++;
	if ( xli_id >= 0x80000000 )
		xli_id = 1;
	return id;
}


int
_get_xli_info(XL_INTERPRETER * buf,int iid)
{
XL_INTERPRETER * xli;
	if ( iid == 0 )
		xli = _get_my_xli();
	else	xli = _search_xli_id(iid);
	if ( xli == 0 )
		return -1;
	memcpy(buf,xli,sizeof(*xli));
	return 0;
}

int
get_xli_info(XL_INTERPRETER * buf,int iid)
{
int ret;
	lock_task(xli_lock);
	ret = _get_xli_info(buf,iid);
	unlock_task(xli_lock,"get_xli_info");
	return ret;
}



int
get_c_timeout(int iid)
{
XL_INTERPRETER * xli;
int ret;
	ret = -1;
	lock_task(xli_lock);
	xli = _search_xli_id(iid);
	if ( xli == 0 )
		goto end;
	ret = xli->connection_timeout;
end:
	unlock_task(xli_lock,"get_s_timeout");
	return ret;
}

int
set_c_timeout(int iid,int timeout)
{
XL_INTERPRETER * xli;
int ret;
	ret = -1;
	lock_task(xli_lock);
	xli = _search_xli_id(iid);
	if ( xli == 0 )
		goto end;
	xli->connection_timeout = timeout;
	ret = 0;
end:
	unlock_task(xli_lock,"set_s_timeout");
	return ret;
}

XL_INTERPRETER *
new_xl_interpreter()
{
XL_INTERPRETER * ret;
int i;
	ret = d_alloc(sizeof(*ret));
	for ( i = 0 ; i < sizeof(*ret) ; i ++ )
		((char*)ret)[i] = 0;


	ret->a_type = 0;
	ret->ps_flags = 0;
	ret->msg = 0;
	ret->thread_mode = 0;
	ret->inp = 0;
	ret->out = 0;
	ret->err = 0;
	ret->env = 0;
	ret->flags = 0;
	ret->proxy_type = PT_DONT_CARE;

	ret->result_flag = 1;
	ret->port = GBP_PORT;
	ret->port_limit = 1;
	ret->max_connection = 10;
	ret->input_file_name = 0;
	ret->output_file_name = 0;
	ret->error_file_name = 0;
	ret->connection_timeout = -1;
	ret->silent_timeout = -1;
	ret->environment = 0;
	ret->ip = 0;
	ret->hostname = 0;
	ret->pl_head = ret->pl_tail = 0;
	ret->pl_accept = 0;
	ret->inp_desc = -1;
	ret->out_desc = -1;
	ret->err_desc = -1;
	ret->desc_type = XLA_FILE;
	ret->out_lock = 0;
	ret->open_timeout = 0;

	ret->connect_ip = 0;
	ret->accept_lock = 0;
	ret->accept_interval = ACCEPT_RET_TIMEOUT;

	ret->delay_que_cnt = 0;

	return ret;
}

int
setup_xl_interpreter(XL_INTERPRETER * xli)
{
unsigned int id,key;
CODE_METHOD * cm1;


	if ( xli->a_type != XLA_ACCEPT ) {
		xli->fifo_head = xli->fifo_tail = 0;
		xli->result_head = 0;
		xli->mode = XIM_RUN;
		xli->front_thread = 0;
		xli->relay_thread = 0;
		xli->silent_cnt = -1;
		xli->connection_cnt = 0;
	}
	switch ( xli->a_type ) {
	case XLA_CONNECT:
		if ( xli->connection_timeout == -1 )
			xli->connection_timeout = 2*3600;
		break;
	}


	lock_task(xli_lock);

	if ( xli->a_type != XLA_SELF && main_interpreter_flag == 2 ) {
		id = XLIE_CANNOT_OPEN_SERVICE_INVALID;
		unlock_task(xli_lock,"setup_xl_interpreter");
		return id;
	}

	id = xli->id = _get_xli_id();
	key = id%INTERPRETER_HASH_SIZE;
	xli->next = interpreter_hash[key];
	interpreter_hash[key] = xli;
	if ( xli->out )
		s_set_cr(xli->out,1);
	if ( xli->err )
		s_set_cr(xli->err,1);
	xli->inp_line = 0;
	xli->inp_interpreter = 0;
	xli->result_list = 0;
	xli->accept_lock = 0;
	xli->accept_last_dec = get_xltime();

	if ( xli->a_type != XLA_SELF && main_interpreter_flag == 0 ) {
		main_interpreter = xli;
		main_interpreter_flag = 1;

	}

	switch ( xli->a_type ) {
	case XLA_SELF:
		break;
	case XLA_ACCEPT:
		create_task(_accept_thread,(int)xli,PRI_XL_ACCEPT);
		break;
	default:
		create_task(_front_thread,(int)xli,PRI_XL_FRONT);
		if ( xli->thread_mode == TM_2 )
			create_task(_relay_thread,(int)xli,PRI_XL_RELAY);
		break;
	}

	if ( agent_open_xli )
		(*agent_open_xli)(xli);
	switch ( xli->a_type ) {
	case XLA_CONNECT:
		s_printf(xli->out,"\n");
		s_flush(xli->out);

		if ( !(xli->flags&XIF_PERMISSION) )
			break;

		xli->open_timeout = get_xltime() + XL_OPEN_TIMEOUT;

		for ( ; (xli->flags & XIF_P_MASK) == 0 ; ) {
			sleep_task((int)&xli->flags,xli_lock);
			lock_task(xli_lock);
		}

		xli->flags &= ~XIF_PERMISSION;
		if ( (xli->flags & XIF_P_MASK) != XIF_P_ALLOW ) {
			s_close(xli->inp);
			s_close(xli->out);
			xli->inp = xli->out = 0;
			switch ( xli->flags & XIF_P_MASK ) {
			case XIF_P_DENIED:
				id = XLIE_CANNOT_OPEN_DENIED;
				break;
			case XIF_P_BUSY:
				id = XLIE_CANNOT_OPEN_BUSY;
				break;
			default:
				id = XLIE_CANNOT_OPEN_CONNECT;
			}
		}
		xli->open_timeout = 0;
		wakeup_task((int)&xli->flags);

		if ( id >= 0 ) {
			cm1 = s_get_cm(xli->out);
			if ( cm1 )
				s_printf(xli->out,"&cx%x;\n",cm1->lccode);
			xli->flags &= ~XIF_CODE_SYNC;
		}

		break;
	}

	unlock_task(xli_lock,"setup_xl_interpreter");

	switch ( xli->a_type ) {
	case XLA_SELF:
		xli->front_thread = _new_xli_thread(xli);
		break;
	}

	return id;
}

void
insert_delay_que(XL_INTERPRETER * xli,int line,XL_SEXP * s)
{
DELAY_QUE_T  * d;

	lock_task(xli_lock);
	xli->delay_que_cnt ++;
	unlock_task(xli_lock,"insert_delay_que");
	d = new_queue_node(sizeof(*d));
	d->ret = s;
	d->line = line;
	d->xli = xli;
	d->h.key = 0;
	insert_queue(&interpreter_que,d,0);
}


void
check_result_list(XL_INTERPRETER * xli)
{
XL_RESULT * resp;
	for ( resp = xli->result_list ; 
		resp ;
		resp = resp->my_xli_result_next );
}

int
delay_t_check_xli(SYS_QUEUE * q,DELAY_QUE_T * n,XL_INTERPRETER * xli)
{
	if ( n->xli == xli )
		return 0;
	return -1;
}

void
_close_xl_interpreter(XL_INTERPRETER * xli)
{
int key;
XL_INTERPRETER ** xlip;
DELAY_QUE_T * n;

	if ( xli->flags & XIF_PERMISSION ) {
		if ( (xli->flags & XIF_P_MASK) == XIF_P_ALLOW ||
			(xli->flags & XIF_P_MASK) == 0 ) {

			xli->flags &= ~XIF_P_MASK;
			xli->flags |= XIF_P_STREAM;
		}
		wakeup_task((int)&xli->flags);
		sleep_task((int)&xli->flags,xli_lock);
		lock_task(xli_lock);
	}
	if ( xli->result_head )
		er_panic("_close_xl_interpreter(1)");
	if ( xli->fifo_head )
		er_panic("_close_xl_interpreter(2)");
	for ( ; xli->result_list ; )
		delete_result_list(xli->result_list);
	xli->mode = XIM_CLOSE;
	s_close(xli->out);
	s_close(xli->err);
	xli->out = xli->inp = xli->err = 0;
	wakeup_task((int)&xli->out_lock);
	wakeup_task((int)&xli->out);
	if ( xli->msg )
		d_f_ree(xli->msg);
	xli->msg = 0;
	if ( xli->hostname )
		d_f_ree(xli->hostname);
	if ( xli->input_file_name )
		d_f_ree(xli->input_file_name);
	if ( xli->output_file_name )
		d_f_ree(xli->output_file_name);
	if ( xli->error_file_name )
		d_f_ree(xli->error_file_name);

	key = xli->id%INTERPRETER_HASH_SIZE;
	for ( xlip = &interpreter_hash[key];
		*xlip && *xlip != xli ;
		xlip = &(*xlip)->next );
	if ( *xlip == 0 )
		er_panic("close_xl_interpreter");
	*xlip = xli->next;
	free_permission_list(xli);
	d_f_ree(xli);
	if ( xli == main_interpreter ) {
		close_all_interpreter();
		main_interpreter = 0;
		main_interpreter_flag = 2;
	}
	wakeup_task((int)xli);
	wakeup_task((int)&interpreter_hash);
}

void
wait_stop_interpreter(int id)
{
XL_INTERPRETER * xli;

retry:
	lock_task(xli_lock);
	xli = _search_xli_id(id);
	if ( xli == 0 ) {
		unlock_task(xli_lock,"wait_stop_interpreter");
		return;
	}
	if ( xli->mode != XIM_CLOSE ) {
		sleep_task((int)xli,xli_lock);
		goto retry;
	}
	unlock_task(xli_lock,"wait_stop_interpreter");
}

void
wait_stop_all()
{
int key;
XL_INTERPRETER * xli;

retry:
	wait_rs_queue();
	lock_task(xli_lock);
	for ( key = 0 ; key < INTERPRETER_HASH_SIZE ; key ++ )
		for ( xli = interpreter_hash[key]; xli ; xli = xli->next ) {
			if ( xli->a_type == XLA_SELF )
				continue;
			sleep_task((int)&interpreter_hash,xli_lock);
			goto retry;
		}
	unlock_task(xli_lock,"wait_stop_all");
	return;
}

int
_close_interpreter(XL_INTERPRETER * xli)
{
XL_RESULT * resp;
int id;

	if( xli->mode == XIM_CLOSE )
		return -1;
	if ( xli->result_head ) {
		id = xli->id;
		unlock_task(xli_lock,"_close_interpreter");
		gc_tick();
		lock_task(xli_lock);
		xli = _search_xli_id(id);
		if ( xli == 0 )
			return -1;
		if ( xli->mode == XIM_CLOSE )
			return -1;
	}
	xli->flags |= XIF_BREAK;
	for ( resp = xli->result_list ; resp ;
			resp = resp->my_xli_result_next ) {
		if ( resp->out_interpreter == 0 )
			continue;
		s_printf(resp->out_interpreter->out,
			"<Cancel/>\n");
		s_flush(resp->out_interpreter->out);
		wakeup_task((int)resp);
	}

	s_close(xli->inp);
	if ( xli->inp == xli->out )
		xli->out = 0;
	if ( xli->inp == xli->err )
		xli->err = 0;
	xli->inp = 0;
	return 0;
}

void
close_interpreter(int id)
{
XL_INTERPRETER * xli;

	lock_task(xli_lock);
	xli = _search_xli_id(id);
	if ( xli == 0 ) {
		unlock_task(xli_lock,"close_interpreter");
		goto end;
	}
	if ( _close_interpreter(xli) == 0 )
		sleep_task((int)xli,xli_lock);
	else
		unlock_task(xli_lock,"close_interpreter");
end:
	{}
}

void
close_self_interpreter()
{
XL_INTERPRETER * xli;
	gc_check_empty("close_self_interpreter");

	lock_task(xli_lock);
	xli = _get_my_xli();
	_close_xl_interpreter(xli);
	_free_xli_thread();
	unlock_task(xli_lock,"close_self_interpreter");
}

void
close_all_interpreter()
{
XL_INTERPRETER * xli, * xli2, * xli3;
int tid;
int i;
	_wait_rs_queue();
	xli = _get_my_xli();
	for ( i = 0 ; i < INTERPRETER_HASH_SIZE ; i ++ ) {
		xli2 = interpreter_hash[i];
		for ( ; xli2 ; ) {
		  	if ( xli2->a_type == XLA_SELF ) {
				xli2 = xli2->next;
				continue;
			}
			if ( xli == xli2 ) {
				xli2 = xli2->next;
				continue;
			}
			xli3 = xli2;
			xli2 = xli2->next;
			_close_interpreter(xli3);
		}
	}
}


void
accept_thread_tick(STREAM * s)
{
	s_close(s);
}

void
launch_accept_thread(
	STREAM * pip,
	unsigned int ip,
	XL_INTERPRETER * xli,
	PERMISSION_LIST * pl)
{
XL_INTERPRETER * xli2;
CODE_METHOD * cm1;

	xli2 = new_xl_interpreter();
	memcpy(xli2,xli,sizeof(*xli));
	xli2->pl_accept = pl;
	xli2->inp = pip;
	xli2->out = pip;
	xli2->err = 0;
	xli2->msg = nl_copy_str(std_cm,"connect");
	xli2->input_file_name = 0;
	xli2->output_file_name = 0;
	xli2->error_file_name = 0;
	xli2->hostname = 0;
	xli2->pl_head = xli2->pl_tail = 0;
	xli2->connect_ip = ip;

	gc_push(0,0,"accept in xl");
	if ( xli2->environment )
		xli2->env = new_env(xli2->env);
	xli2->a_type = XLA_CONNECT;


	setup_xl_interpreter(xli2);
	gc_pop(0,0);

	if ( xli2->out ) {
		cm1 = s_get_cm(xli2->out);
		if ( cm1 )
			s_printf(xli2->out,
			"&cx%x;\n<Permission>Allow</Permission>\n",
				cm1->lccode);
		s_flush(xli2->out);
		xli2->flags &= ~XIF_CODE_SYNC;
	}
}


void
a_set_t_msg(int msg)
{
	set_t_msg(msg);
}

void
_accept_thread(TKEY k)
{
XL_INTERPRETER * xli, * xli2;
ACCESS_KEY * key;
PERMISSION_LIST * pl;
CODE_METHOD * cm1;
STREAM * pip;
unsigned int next_interval,invoke_time;
char ch;
int opm,cop;


if ( _accept_tid == 0 ) {
_accept_tid = malloc(sizeof(int)*1000);
_accept_ptr = 0;
}
_accept_tid[_accept_ptr++] = get_tid();
_accept_ptr = _accept_ptr % 1000;


a_set_t_msg(1);
	xli = (XL_INTERPRETER*)GET_TKEY(k);
	for ( ; ; ) {
a_set_t_msg(2);

		lock_task(xli_lock);
		if ( xli->accept_lock ) {
a_set_t_msg(3);
			unlock_task(xli_lock,"_accept_thread");

			return;
		}
		xli->accept_lock = 1;
		unlock_task(xli_lock,"_accept_thread");
a_set_t_msg(4);

		key = accept_connection(xli->inp);

a_set_t_msg(5);
		lock_task(xli_lock);
		xli->accept_lock = 0;

a_set_t_msg(6);
		if ( key == 0 ) {
			unlock_task(xli_lock,"_accept_thread");
			if ( xli->flags & XIF_BREAK )
				break;
			continue;
		}
a_set_t_msg(7);

		create_task(_accept_thread,(int)xli,PRI_XL_ACCEPT);
a_set_t_msg(8);

		unlock_task(xli_lock,"_accept_thread");

		cop = s_check_resource2(&opm);
a_set_t_msg(9);

		if ( cop >= opm*50/64 ) {
/*
printf("BUSY 1\n");
*/
a_set_t_msg(10);
			s_printf(key->s,
				"<Permission>Busy</Permission>\n");
			s_flush(key->s);
			s_close(key->s);
			d_f_ree(key);
a_set_t_msg(11);
			continue;
		}
a_set_t_msg(12);

		pl = check_permission_list(xli,key->ip);
a_set_t_msg(13);

		if ( pl == 0 ) {
a_set_t_msg(14);
			s_printf(key->s,
				"<Permission>Denied</Permission>\n");
			s_flush(key->s);
			s_close(key->s);
			d_f_ree(key);
a_set_t_msg(15);
			continue;
		}
a_set_t_msg(16);


		invoke_time = get_xltime();
		new_tick(accept_thread_tick,-xli->accept_interval,(int)key->s);
a_set_t_msg(17);
		if ( s_read(key->s,&ch,1) < 1 ) {
a_set_t_msg(18);
			del_tick_with_data(accept_thread_tick,(int)key->s);
			xli->accept_interval *= 2;
			if ( xli->accept_interval > ACCEPT_RET_MAX )
				xli->accept_interval = ACCEPT_RET_MAX;
			xli->accept_last_dec = get_xltime();
			s_close(key->s);
			d_f_ree(key);
a_set_t_msg(19);
			continue;
		}
a_set_t_msg(20);
		del_tick_with_data(accept_thread_tick,(int)key->s);
		next_interval = get_xltime() - invoke_time;
a_set_t_msg(21);
		if ( 2*next_interval < xli->accept_interval &&
			get_xltime() - xli->accept_last_dec
				>= ACCEPT_RET_DEC_INTERVAL ) {
			xli->accept_interval --;
a_set_t_msg(22);
			if ( xli->accept_interval < ACCEPT_RET_TIMEOUT )
				xli->accept_interval = ACCEPT_RET_TIMEOUT;
		}
		else if ( 1.5*next_interval > xli->accept_interval ) {
a_set_t_msg(23);
			xli->accept_interval *= 2;
			if ( xli->accept_interval > ACCEPT_RET_MAX )
				xli->accept_interval = ACCEPT_RET_MAX;
			xli->accept_last_dec = get_xltime();
a_set_t_msg(24);
		}
a_set_t_msg(25);
		if ( s_push(key->s,ch) < 0 ) {
a_set_t_msg(26);
			s_close(key->s);
			d_f_ree(key);
a_set_t_msg(27);
			continue;
		}
a_set_t_msg(28);
		if ( ch != '\n' && ch != '\r' ) {
a_set_t_msg(29);
			switch ( new_accept(&pip,key,xli) ) {
			case -1:
				s_close(key->s);
				d_f_ree(key);
				continue;
			case 0:
				d_f_ree(key);
				continue;
			case 1:
				break;
			}
a_set_t_msg(30);
		}
		else pip = key->s;
a_set_t_msg(31);

		if ( cop >= opm*40/64 ) {
/*
printf("BUSY 2\n");
*/
a_set_t_msg(32);
			s_printf(pip,
				"<Permission>Busy</Permission>\n");
			s_flush(pip);
			s_close(pip);

			d_f_ree(key);
a_set_t_msg(33);
			continue;
		}
a_set_t_msg(34);

		launch_accept_thread(pip,key->ip,xli,pl);
		d_f_ree(key);
a_set_t_msg(35);
	}
a_set_t_msg(36);
	if ( agent_close_xli )
		(*agent_close_xli)(xli);
	lock_task(xli_lock);
	_close_xl_interpreter(xli);
	unlock_task(xli_lock,"_accept_thread");
a_set_t_msg(37);
}

void
send_code_sync(int id)
{
XL_INTERPRETER * xli;
	lock_task(xli_lock);
	xli = _search_xli_id(id);
	if ( xli )
		xli->flags |= XIF_CODE_SYNC;
	unlock_task(xli_lock,"send_code_sync");
}


void
__reply(STREAM ** stp,XL_INTERPRETER * xli,int line,XL_SEXP * ret)
{
int sc;
CODE_METHOD * cm1, * cm2, * cm3;
L_CHAR code;

	cm1 = 0;
	if ( !(xli->flags & XIF_FIX_CODE) ) {
		code = get_proper_code(ret,10);
		if ( code == LCC_ASCII )
			cm1 = 0;
		else	cm1 = search_cm_by_lccode(code);
	}

	lock_xli_out(xli);

	if ( !(xli->flags & XIF_FIX_CODE) ) {
		if ( cm1 ) {
			cm2 = s_get_cm(*stp);
			if ( cm2 == 0 )
				cm2 = 0;
			else if ( cm1 == cm2 ) {
				cm2 = 0;
			}
			else {
				s_printf(*stp,"&cx%x;",cm1->lccode);
				s_set_cm(*stp,cm1);
				s_printf(*stp,"\n");
				lock_task(xli_lock);
				xli->flags &= ~XIF_CODE_SYNC;
				unlock_task(xli_lock,"__reply");
			}
		}
		else	cm2 = 0;
	}
	else	cm2 = 0;

	sc = xli->silent_cnt;
	if ( xli->silent_cnt != -1 )
		xli->silent_cnt = -1;

	if ( xli->flags & XIF_CODE_SYNC ) {
		lock_task(xli_lock);
		cm3 = s_get_cm(xli->out);
		if ( cm3 )
			s_printf(*stp,"&cx%x;",cm3->lccode);
		xli->flags &= ~XIF_CODE_SYNC;
		unlock_task(xli_lock,"__reply");
	}

	if ( xli->result_flag )
		s_printf(*stp,"<Result> %i ",line);

	if ( *stp )
		print_sexp(*stp,ret,xli->ps_flags&(~PF_MULTI_ROOT));

	if ( xli->result_flag )
		s_printf(*stp,"</Result>\n");
	else	s_printf(*stp,"\n");
	s_flush(*stp);

	if ( cm2 ) {
		s_printf(*stp,"&cx%x;",cm2->lccode);
		s_set_cm(*stp,cm2);
		s_printf(*stp,"\n");
	}

	xli->silent_cnt = sc;

	unlock_xli_out(xli);
}

void
_reply(XL_INTERPRETER * xli,int line,XL_SEXP * ret)
{
	lock_task(xli_lock);
	xli->flags |= XIF_CTO_LOCK;
	unlock_task(xli_lock,"_reply");

	if ( get_type(ret) == XLT_ERROR ) {
		if ( (ret->err.code&XLE_VERB_MASK) == XLE_EXIT )
			__reply(&xli->out,xli,line,0);
		else {
			if ( xli->out )
				__reply(&xli->out,xli,line,ret);
			if ( xli->err && xli->err != xli->out )
				__reply(&xli->err,xli,line,ret);
		}
	}
	else if ( xli->out )
		__reply(&xli->out,xli,line,ret);

	lock_task(xli_lock);
	xli->flags &= ~XIF_CTO_LOCK;
	unlock_task(xli_lock,"_reply");
}



void
_front_thread_1(XL_INTERPRETER * xli)
{
XL_SEXP * s, * r, * ret;
int line;

int cc,cc1;
cc1 = 0;

set_cpu_thr_type(10);
set_cpu_msg(0);


	gc_push(0,0,"front_th"); /* section 1 level 1 */
	gc_push(0,0,"front_th"); /* section 2 level 2 */

	s = init_parse(xli->inp,xli->msg,0);
	if ( s == 0 )
		goto end2;
	s->h.file->work = xli;
	s->h.file->func_11 = xli_lex_result;
	if ( xli->flags & XIF_TERMINAL ) {
		terminal_file = s->h.file;
		terminal_prompt_2(xli->out);
	}
	for ( ; get_type(s) ;
			terminal_prompt_2(xli->out),
			s = cdr(s),
			xli->silent_cnt = 0
	) {
		gc_pop(s,gc_gb_sexp); /* section 2 level 2 */
		gc_push(s,gc_gb_sexp,"front_th");
					/* sectoion 2 level 2 */
		xli->silent_cnt = -1;
		if ( get_type(s) == XLT_ERROR ) {
			if ( s->err.code == XLE_SYSTEM_READ_FILE )
				break;
			printf("parsing error\n");
			continue;
		}
		lock_task(xli_lock);
		xli->flags &= ~XIF_CANCEL;
		unlock_task(xli_lock,"front_thread_1");
		r = car(s);
		if ( get_type(r) == XLT_ERROR ) {
			if ( r->err.code == XLE_SYSTEM_READ_FILE )
				break;
			ret = r;
			line = r->h.line;
			goto end;
		}
		xli->inp_line = line = r->h.line;
		xli->inp_interpreter = xli;

		ret = eval(xli->env,r);

	end:
		_reply(xli,line,ret);
		if ( get_type(ret) == XLT_ERROR ) {
			if ( ret->err.code == XLE_SYSTEM_INTERRUPT ) {
				lock_task(xli_lock);
				xli->flags &= ~XIF_CANCEL;
				unlock_task(xli_lock,"front_thread_1");


				continue;
			}
			if ( (ret->err.code&XLE_VERB_MASK) == XLE_EXIT ) {


				break;
			}
		}


		if ( get_type(s) == XLT_ERROR )
			break;
	}
end2:
	gc_pop(0,0); /* section 1 level 2 */
	gc_pop(0,0); /* section 1 level 1 */
	gc_check_empty("thread_1");

	if ( agent_close_xli )
		(*agent_close_xli)(xli);
	lock_task(xli_lock);
	_close_xl_interpreter(xli);
	_free_xli_thread();
	unlock_task(xli_lock,"front_thread");
}

void
_cancel(XL_INTERPRETER * xli)
{
XL_RESULT * resp;
	lock_task(xli_lock);
	xli->flags |= XIF_CANCEL;
	for ( resp = xli->result_list ; resp ;
			resp = resp->my_xli_result_next ) {
		if ( resp->out_interpreter == 0 )
			continue;
		s_printf(resp->out_interpreter->out,
			"<Cancel/>\n");
		s_flush(resp->out_interpreter->out);
		wakeup_task((int)resp);
	}
	unlock_task(xli_lock,"_cancel");
}

void
_break(XL_INTERPRETER * xli)
{
	lock_task(xli_lock);
	_close_interpreter(xli);
	unlock_task(xli_lock,"_break");
}

int
_get_user_info(XL_INTERPRETER * xli,XLISP_ENV * env,int line,XL_SEXP * s)
{
XL_SEXP * ret,* ip;
XL_SEXP * mode;
	if ( main_interpreter == 0 )
		return -1;
	if ( main_interpreter->a_type != XLA_CONNECT )
		return -1;
	mode = get_el(s,4);
	switch ( get_type(mode) ) {
	case XLT_ERROR:
		return -1;
	case XLT_STRING:
		break;
	default:
		return -1;
	}
	ret = remote_query(main_interpreter->id,env,0,s);
	if ( l_strcmp(mode->string.data,l_string(std_cm,"ip")) == 0 ) {
		switch ( get_type(ret) ) {
		case XLT_ERROR:
			break;
		case XLT_PAIR:
			ip = car(ret);
			switch ( get_type(ip) ) {
			case XLT_ERROR:
				ret = ip;
				break;
			case XLT_INTEGER:
				if ( hostcmp(0,getHA_v4(ip->integer.data),
						0,getHA_v4(xli->connect_ip)) )
					goto permission_error;
				ret = cons(get_integer(get_localhostip(),0),
						ret);
				break;
			default:
				goto type_missmatch;
			}
			break;
		default:
			break;
		}
	}
	_reply(xli,line,ret);
	return 0;
permission_error:
	ret = get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_PERMISSION_DENIED,
		l_string(std_cm,"GetUserInfo"),
		n_get_string("permission denied(invalid ip chain)"));
	_reply(xli,line,ret);
	return 0;
type_missmatch:
	ret = get_error(
		s->h.file,
		s->h.line,
		XLE_SYSTEM_EXIT,
		l_string(std_cm,"GetUserInfo"),
		n_get_string("type missmatch of return value of GetUserInfo"));
	_reply(xli,line,ret);
	return 0;
}

XL_SEXP *
get_user_ip(XLISP_ENV * env)
{
XL_SEXP * cmd;
int line = 0;
XL_INTERPRETER * xli;
	xli = get_my_xli();
	if ( xli->a_type == XLA_FILE ||
			xli->a_type == XLA_STDIO ||
			xli->a_type == XLA_IPC ) {
		return List(	get_integer(get_localhostip(),0),
				-1);
	}
	cmd = List(	get_symbol(l_string(std_cm,"GetUserInfo")),
			n_get_string(""),
			n_get_string(""),
			n_get_string(""),
			n_get_string("ip"),
			-1);
	return remote_query(xli->id,env,0,cmd);
}

void
_permission(XL_INTERPRETER * xli,XL_SEXP * r)
{
XL_SEXP * p;
	lock_task(xli_lock);
	p = get_el(r,1);
	xli->flags &= ~XIF_P_MASK;
	if ( get_type(p) != XLT_STRING )
		xli->flags |= XIF_P_ERROR;
	else if ( l_strcmp(p->string.data,l_string(std_cm,"Allow")) == 0 )
		xli->flags |= XIF_P_ALLOW;
	else if ( l_strcmp(p->string.data,l_string(std_cm,"Denied")) == 0 )
		xli->flags |= XIF_P_DENIED;
	else if ( l_strcmp(p->string.data,l_string(std_cm,"Busy")) == 0 )
		xli->flags |= XIF_P_BUSY;
	else 	xli->flags |= XIF_P_ERROR;
	wakeup_task((int)&xli->flags);
	unlock_task(xli_lock,"_permission");
}



void
_front_thread_2(XL_INTERPRETER * xli)
{
XL_SEXP * s, * r, * ret, * cmd;
XL_RESULT * resp;

set_cpu_thr_type(11);
set_cpu_msg(0);

set_t_msg(1);
	gc_push(0,0,"front_th2_1"); /* section 1 level 1 */
	gc_push(0,0,"front_th2_1"); /* section 2 level 2 */

	s = init_parse(xli->inp,xli->msg,0);
	if ( s == 0 )
		goto end;
	s->h.file->work = xli;
	s->h.file->func_11 = xli_lex_result;
	for ( ; get_type(s) ;
			s = cdr(s)
	) {

		gc_pop(s,gc_gb_sexp); /* section 2 level 2 */
		gc_push(s,gc_gb_sexp,"fron_th2_1");
					/* section 2 level 2 */

		cmd = 0;

		if ( get_type(s) == XLT_ERROR ) {

			if ( s->err.code == XLE_SYSTEM_READ_FILE )
				break;
			_reply(xli,s->h.line,s);
			break;
		}
		r = car(s);
		if ( get_type(r) == XLT_ERROR ) {

			if ( r->err.code == XLE_SYSTEM_READ_FILE )
				break;
			_reply(xli,r->h.line,r);
			continue;
		}
		if ( get_type(r) == 0 )
			goto put;
		cmd = car(r);
		if ( get_type(cmd) != XLT_SYMBOL ) {
			put_xl_fifo(xli,r);
			lock_task(xli_lock);
			for ( resp = xli->result_list ; resp ;
					resp = resp->my_xli_result_next ) {
				resp->flags |= XRF_INPUT;
				wakeup_task((int)resp);
			}
			unlock_task(xli_lock,"_front_thread_2");
			continue;
		}
		if ( (xli->flags & XIF_P_MASK) == 0 &&
			l_strcmp(cmd->symbol.data,
				l_string(std_cm,"Permission"))
							== 0 )
			_permission(xli,r);
		else if ( l_strcmp(cmd->symbol.data,
				l_string(std_cm,"Result"))
							== 0 )
			return_result(xli,r);
		else if ( l_strcmp(cmd->symbol.data,
				l_string(std_cm,"Cancel"))
							== 0 )
			_cancel(xli);
		else if ( l_strcmp(cmd->symbol.data,
				l_string(std_cm,"Break"))
							== 0 )
			_break(xli);
		else if ( l_strcmp(cmd->symbol.data,
				l_string(std_cm,"?xml")) == 0 ) {

			r = eval(xli->env,r);
			r = List(n_get_symbol("quote"),r,-1);
			goto put;
		}
		else if ( l_strcmp(cmd->symbol.data,
				l_string(std_cm,"?xl")) == 0 ) {
			r = eval(xli->env,r);
			r = List(n_get_symbol("quote"),r,-1);
			goto put;
		}
		else {
		put:
			put_xl_fifo(xli,r);
			lock_task(xli_lock);
			for ( resp = xli->result_list ; resp ; 
					resp = resp->my_xli_result_next ) {
				resp->flags |= XRF_INPUT;
				wakeup_task((int)resp);
			}
			unlock_task(xli_lock,"_front_thread_2");
set_t_msg(9);

		}
set_t_msg(10);
		if ( get_type(cmd) == XLT_SYMBOL )
			inp_lock_function(cmd->symbol.data);
		else	inp_lock_function(0);
set_t_msg(11);
	}
end:
set_t_msg(12);

	gc_pop(0,0); /* section 2 level 2 */
	gc_pop(0,0); /* section 1 level 1 */

set_cpu_msg(10);
set_t_msg(13);

	gc_check_empty("thread_2");

set_cpu_msg(11);
set_t_msg(14);

	if ( xli->mode == XIM_FLONT_WAIT && agent_close_xli )
		(*agent_close_xli)(xli);

set_cpu_msg(12);
set_t_msg(15);

	lock_task(xli_lock);
	switch ( xli->mode ) {
	case XIM_RUN:

set_cpu_msg(13);
set_t_msg(16);

		xli->mode = XIM_QUEUE_WAIT;
		flush_result_queue(xli);
		wakeup_task((int)&xli->mode);
		lock_task(sem_xli_lex_lock);
		xli->mode = XIM_RELAY_WAIT;
		wakeup_task((int)&xli->out);
		unlock_task(sem_xli_lex_lock,"front_thread(wait)");
		interrupt_fifo(xli);

set_cpu_msg(14);
set_t_msg(17);

		break;
	case XIM_FLONT_WAIT:

set_cpu_msg(15);
set_t_msg(18);

		flush_result_queue(xli);
		_close_xl_interpreter(xli);

set_cpu_msg(16);
set_t_msg(19);

		break;
	default:
		er_panic("front_thread_2");
	}

set_cpu_msg(17);
set_t_msg(21);

	_free_xli_thread();
	unlock_task(xli_lock,"front_thread_2");
set_t_msg(22);

}

void
_front_thread(TKEY k)
{
XL_INTERPRETER * xli;

	xli = (XL_INTERPRETER *)GET_TKEY(k);
	xli->front_thread = _new_xli_thread(xli);
	switch ( xli->thread_mode ) {
	case TM_1:
		_front_thread_1(xli);
		break;
	case TM_2:
		_front_thread_2(xli);
		break;
	}
}


void
relay_loop(XL_INTERPRETER * xli,int flag)
{
XL_SEXP * r, * ret;
XL_SEXP * cmd;
int line;

	gc_push(0,0,"relay1"); /* section 0 level 1 */

	for ( ; ; ) {

		gc_push(0,0,"relay2"); /* section 1 level 2 */

		xli->silent_cnt = 0;

		r = get_xl_fifo(xli,flag);

		xli->silent_cnt = -1;

		lock_task(xli_lock);

		if ( xli->flags & XIF_BREAK ) {
			unlock_task(xli_lock,"relay_loop");
			gc_pop(0,0); /* section 1 level 2 */
			break;
		}
		if ( xli->flags & XIF_CANCEL )
			xli->flags &= ~XIF_CANCEL;
		unlock_task(xli_lock,"relay_loop");
		
		if ( r == 0 )  {
			gc_pop(0,0); /* section 1 level 2 */
			break;
		}
		if ( get_type(r) == 0 ) {

			gc_pop(0,0); /* section 1 level 2 */

			continue;
		}
		xli->inp_line = r->h.line;
		xli->inp_interpreter = xli;

		cmd = car(r);
		if ( get_type(cmd) == XLT_SYMBOL &&
				l_strcmp(cmd->symbol.data,
				l_string(std_cm,"GetUserInfo"))
							== 0 ) {
			if ( _get_user_info(xli,xli->env,
					r->h.line,r) == 0 ) {

				gc_pop(0,0); /* section 1 level 2 */

				continue;
			}
		}


		line = r->h.line;

		if ( cmd_log ) {
			log_printf(LOG_MESSAGE,
				"%i.%i.%i.%i executes",
				(xli->connect_ip>>24)&0x0ff,
				(xli->connect_ip>>16)&0x0ff,
				(xli->connect_ip>>8)&0x0ff,
				xli->connect_ip&0x0ff);
			log_print_sexp(LOG_MESSAGE,"cmd",r,0);
		}
/*
fflush(stdout);
ss_printf("(%i)>>",get_xltime());
print_sexp(s_stdout,r,PF_RAW_DISABLE);
ss_printf("\n");
*/


		ret = eval(xli->env,r);


/*
ss_printf("(%i)>>RETURN\n",get_xltime());
print_sexp(s_stdout,ret,PF_RAW_DISABLE);
ss_printf("\n");
*/

		gc_pop(ret,gc_gb_sexp); /* section 1 level 2 */

		if ( s_exist(xli->out) == 0 )
			break;

		gc_push(ret,gc_gb_sexp,"relay3");

		if ( check_delay(ret,0) == CDT_WAIT ) {
			insert_delay_que(xli,line,ret);
			gc_pop(0,0);
			continue;
		}
		else
			_reply(xli,line,ret); /* section 2 level 2 */

		gc_pop(0,0);

		if ( get_type(ret) == XLT_ERROR &&
			(ret->err.code == XLE_SYSTEM_INTERRUPT) )
			continue;
		if ( get_type(ret) == XLT_ERROR &&
				(ret->err.code&XLE_VERB_MASK)
					== XLE_EXIT )
			break;
	}

	gc_pop(0,0); /* section 0 level 1 */


}

void
_relay_thread(TKEY k)
{
XL_SEXP * s, * r, * ret, * cmd;
XL_INTERPRETER * xli;
DELAY_QUE_T * n;

void * stt;
void * stt2;
GC_STACK * sttt;

stt2 = get_gc_check_point();
if ( stt2 ) {
sttt = stt2;
fprintf(stderr,"STACK = %x\n",sttt);
if ( sttt->msg )
fprintf(stderr,"MSG = %s\n",sttt->msg);
er_panic("_relay_thread");
}

set_cpu_thr_type(12);
set_cpu_msg(0);

stt = get_gc_check_point();
if ( stt ) {
sttt = stt;
fprintf(stderr,"STACK = %x\n",sttt);
if ( sttt->msg )
fprintf(stderr,"MSG = %s\n",sttt->msg);
er_panic("_relay_thread");
}


	xli = (XL_INTERPRETER*)GET_TKEY(k);
	xli->relay_thread = _new_xli_thread(xli);
	relay_loop(xli,XFF_BLOCK);


set_cpu_msg(11);

	if ( (xli->mode == XIM_RELAY_WAIT ||
			xli->mode == XIM_QUEUE_WAIT)
			&& agent_close_xli )
		(*agent_close_xli)(xli);

set_cpu_msg(12);

	for ( ; ; ) {
		n = delete_queue(&interpreter_que,delay_t_check_xli,xli,0);
		lock_task(xli_lock);
		xli->delay_que_cnt --;
		unlock_task(xli_lock,"insert_delay_que");
		if ( n == 0 )
			break;
		d_f_ree(n);
	}

	lock_task(xli_lock);

set_cpu_msg(13);

	close_fifo(xli);
	switch ( xli->mode ) {
	case XIM_RUN:

set_cpu_msg(14);

		s_close(xli->inp);
		if ( xli->inp == xli->out )
			xli->out = 0;
		if ( xli->inp == xli->err )
			xli->err = 0;
		xli->inp = 0;
		xli->mode = XIM_FLONT_WAIT;

set_cpu_msg(15);

		break;
	case XIM_QUEUE_WAIT:

set_cpu_msg(16);

		for ( ; xli->mode == XIM_QUEUE_WAIT ; ) {
			sleep_task((int)&xli->mode,xli_lock);
			lock_task(xli_lock);
		}
		if ( xli->mode != XIM_RELAY_WAIT )
			er_panic("_Relay_thread(1)");

set_cpu_msg(17);

	case XIM_RELAY_WAIT:

set_cpu_msg(18);

		_close_xl_interpreter(xli);

set_cpu_msg(19);


		break;
	default:
		er_panic("relay_thread");
	}

set_cpu_msg(20);


	_free_xli_thread();
	unlock_task(xli_lock,"relay_thread");

compare_gc_check_point("relay_check",stt);

	gc_check_empty("relay",stt);

}

typedef struct i_delay_work {
	int		flags;
	int		result;
} I_DELAY_WORK;

int
delay_t_check(SYS_QUEUE * q,DELAY_QUE_T * n,I_DELAY_WORK * w)
{
int ret;
int type;

	w->result = ret = check_delay(n->ret,(int)q);
	if ( w->flags & (1<<ret) )
		return 0;
	return -1;
}

void
delay_thread()
{
DELAY_QUE_T * n;
I_DELAY_WORK w;
XL_INTERPRETER * xli;
	xli = new_xl_interpreter();
	xli->a_type = XLA_SELF;
	setup_i(xli);

set_t_msg(1);

	w.flags = CDF_ALL&~(CDF_WAIT);
	for ( ; ; ) {
set_t_msg(2);
		lock_task(xli_lock);
set_t_msg(3);
		if ( interpreter_que_task >= 1 ) {
			unlock_task(xli_lock,"delay_thread");
set_t_msg(4);
			break;
		}
		interpreter_que_task ++;
set_t_msg(5);
		unlock_task(xli_lock,"delay_thread");

		gc_push(0,0,"delay_thread");
set_t_msg(6);

		n = delete_queue(&interpreter_que,delay_t_check,&w,1);
set_t_msg(7);

		lock_task(xli_lock);
		interpreter_que_task --;
		unlock_task(xli_lock,"delay_thread");
set_t_msg(8);

		if ( w.result == CDT_WAIT_ERR ) {
set_t_msg(9);
			create_task(delay_thread,0,PRI_XL_RELAY);
			get_type(n->ret);
		}
set_t_msg(10);
		_reply(n->xli,n->line,n->ret);
set_t_msg(11);
		lock_task(xli_lock);
set_t_msg(12);
		n->xli->delay_que_cnt --;
		n->xli->silent_cnt = 0;
set_t_msg(13);
		unlock_task(xli_lock,"delay_thread");
		d_f_ree(n);
set_t_msg(14);

		gc_pop(0,0);
set_t_msg(15);
	}
set_t_msg(16);

	close_self_interpreter();
set_t_msg(17);
}

void
set_xli_si(XL_INTERPRETER * xli)
{
SERVER_INFO si;
int thput;

	if ( xli->a_type != XLA_CONNECT )
		return;
	if ( xli->connect_ip == 0 )
		return;
	si.ip = xli->connect_ip;
	si.thput = s_get_thput(xli->inp);
	if ( si.thput < 0 )
		return;
	si.name = 0;
	si.status = SIS_CONNECT;
	si.active_flags = SIA_IP|SIA_STATUS|SIA_THPUT;
	set_serverinfo(&si,SIC_AVG,SIS_ALL);
}

void
_tick_check(XL_INTERPRETER * xli)
{
	set_xli_si(xli);
	if ( s_exist(xli->inp) == 0 )
		xli->inp = 0;
	if ( s_exist(xli->out) == 0 )
		xli->out = 0;
	if ( s_exist(xli->err) == 0 )
		xli->err = 0;
	if ( xli->open_timeout &&
			xli->open_timeout < get_xltime() ) {
		xli->flags &= ~XIF_P_MASK;
		xli->flags |= XIF_P_ERROR;
		s_close(xli->inp);
		if ( xli->inp == xli->out )
			xli->out = 0;
		if ( xli->inp == xli->err )
			xli->err = 0;
		xli->inp = 0;
		wakeup_task((int)&xli->flags);
		return;
	}

	xli->connection_cnt ++;
	if ( (xli->a_type == XLA_CONNECT ||
			xli->a_type == XLA_DESCRIPTER) &&
			(xli->connection_cnt % CR_SEND_INTERVAL) == 0 ) {
		if ( _lock_xli_out_no_wait(xli) == 0 ) {
			if ( xli->mode == XIM_RUN && xli->out )
				s_printf(xli->out,"\n");
			_unlock_xli_out(xli);
		}
	}
	if ( xli->silent_cnt < 0 ||
		xli->delay_que_cnt ||
		(xli->flags&XIF_CTO_LOCK) &&
		xli->connection_timeout >= 0 &&
		xli->connection_cnt < 
			FATAL_TIMEOUT + xli->connection_timeout )
		return;
	xli->silent_cnt ++;
	if ( xli->silent_timeout >= 0 &&
		xli->silent_cnt >= xli->silent_timeout ||
		xli->connection_timeout >= 0 &&
		xli->connection_cnt >= xli->connection_timeout ) {

		if ( xli->a_type == XLA_ACCEPT )
			return;
		if ( xli->mode != XIM_RUN )
			return;
		xli->flags |= XIF_BREAK;
		s_close(xli->inp);
		if ( xli->inp == xli->out )
			xli->out = 0;
		if ( xli->inp == xli->err )
			xli->err = 0;
		xli->inp = 0;
	}
}

void
xli_tick()
{
int key;
XL_INTERPRETER * xli;

	lock_task(xli_lock); 
	timeout_lock_function();
	for ( key = 0 ; key < INTERPRETER_HASH_SIZE ; key ++ )
		for ( xli = interpreter_hash[key];
				xli;
				xli = xli->next )
			_tick_check(xli);
	unlock_task(xli_lock,"xli_tick");

}


int
xl_int_handler()
{
XL_INTERPRETER * xli;
int i;

	lock_task(xli_lock);
	for ( i = 0 ; i < INTERPRETER_HASH_SIZE ; i ++ )
		for ( xli = interpreter_hash[i] ; xli ;
				xli = xli->next )
			if (xli->flags & XIF_TERMINAL ) {
				xli->flags |= XIF_CANCEL;
				unlock_task(xli_lock,"xl_int_handler");
				return 0;
			}
	unlock_task(xli_lock,"xl_int_handler");
	return -1;
}


void
gc_d_sexp(D_SEXP * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gc_gb_sexp(p->ret);
}

XL_SEXP *
d_sexp_func(XL_SEXP * s)
{
D_SEXP * d;

	lock_task(xli_lock);
	d = (D_SEXP*)s->delay.d.func;
	for ( ; !(d->flags & DSF_OK) ; ) {
		sleep_task((int)d,xli_lock);
		lock_task(xli_lock);
	}
	over_write_sexp(s,d->ret);
	unlock_task(xli_lock,"d_sexp");
	return s;
}

int
check_d_sexp(D_SEXP * d)
{
	if ( d->flags & DSF_OK )
		return CDT_READY;
	return CDT_WAIT;
}

XL_SEXP *
new_d_sexp(D_SEXP ** d)
{
D_SEXP * dd;
	dd = mmalloc(sizeof(*dd),gc_d_sexp);
	dd->h.func = d_sexp_func;
	dd->h.gc_func = gc_d_sexp;
	dd->h.check_func = check_d_sexp;
	*d = dd;
	return init_delay_func((DELAY_FUNC*)dd);
}


void
set_d_sexp(D_SEXP * d,XL_SEXP * ret)
{
	lock_task(xli_lock);
	d->ret = ret;
	d->flags |= DSF_OK;
	wakeup_task((int)d);
	unlock_task(xli_lock,"set_d_sexp");
}
