/**********************************************************************
 
	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	"task.h"

extern SEM xli_lock,fifo_lock,lex_lock;
XL_SEXP * xl_GetCPUStatus();
extern XL_FILE gb_file_root;

void
init_GetCPUStatus(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"GetCPUStatus"),
		get_func_prim(xl_GetCPUStatus,
			      FO_APPLICATIVE,0,2,2));
}

XL_SEXP *
xl_GetCPUStatus(XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * a,
	XL_SYM_FIELD * sf)
{
L_CHAR * mode;
int _mode;
unsigned int _id;
XL_SEXP * id;
XL_INTERPRETER * xli;
XL_SEXP * ret;
int cnt;
XL_FIFO * f;
XL_RESULT * r;
XL_FILE * ff;
char * rb;

	ret = 0; 
	mode = get_sf_attribute(sf,
		l_string(std_cm,"mode"));
	if ( mode == 0 )
		_mode = 0;
	else {
		if ( l_strcmp(mode,l_string(std_cm,"iid")) == 0 )
			_mode = 0;
		else	_mode = 1;
	}
	id = get_el(s,1);
	if ( get_type(id) != XLT_INTEGER )
		goto type_missmatch;
	_id = id->integer.data;
	lock_task(lex_lock);
	lock_task(xli_lock);
	switch ( _mode ) {
	case 0:
		xli = _search_xli_id(_id);
		break;
	case 1:
		xli = _search_xli_thread(_id);
	}
	if ( xli == 0 ) {
		unlock_task(xli_lock,"GetCPUStatus");
		unlock_task(lex_lock,"GetCPUStatus");
		goto invalid_param;
	}

	for ( ff = gb_file_root.next ; ff != &gb_file_root ; ff = ff->next ) {
		if ( ff->st == xli->inp )
			goto ok;
	}
	goto st_next;
ok:
	rb = d_alloc(XLFILE_BUFFER_SIZE+1,12);
	memcpy(rb,ff->rb,XLFILE_BUFFER_SIZE);
	rb[XLFILE_BUFFER_SIZE] = 0;
	ret = cons(
		List(n_get_symbol("io"),
			n_get_string(rb),
			get_integer(ff->rb_len,0),
			get_integer(ff->rb_ptr,0),
			-1),
		ret);
	d_f_ree(rb);
st_next:
	unlock_task(lex_lock,"GetCPUStatus");


	ret = cons(
		List(n_get_symbol("live"),
			get_integer(xli->silent_cnt,0),
			get_integer(xli->connection_cnt,0),
			-1),
		ret);
	ret = cons(
		List(n_get_symbol("timeout"),
			get_integer(xli->silent_timeout,0),
			get_integer(xli->connection_timeout,0),
			-1),
		ret);
	r = xli->result_head;
	for ( cnt = 0 ; r ; r = r->next , cnt ++ );
	ret = cons(
		List(n_get_symbol("query"),
			get_integer(cnt,0),
			-1),
		ret);
	lock_task(fifo_lock);
	f = xli->fifo_head;
	for ( cnt = 0 ; f ; f = f->next , cnt ++ );
	unlock_task(fifo_lock,"GetCPUStatus");
	ret = cons(
		List(n_get_symbol("fifo"),
			get_integer(cnt,0),
			-1),
		ret);
	ret = cons(
		List(n_get_symbol("stream"),
			get_integer((int)xli->inp,0),
			get_integer((int)xli->out,0),
			get_integer((int)xli->err,0),
			-1),
		ret);
	ret = cons(
		List(n_get_symbol("msg"),
			get_string(xli->msg),
			-1),
		ret);
	ret = cons(
		List(n_get_symbol("thread-mode"),
			get_integer(xli->thread_mode,0),
			-1),
		ret);
	ret = cons(
		List(n_get_symbol("a-type"),
			get_integer(xli->a_type,0),
			-1),
		ret);
	ret = cons(
		List(n_get_symbol("connect-ip"),
			get_integer(xli->connect_ip,0),
			-1),
		ret);
	ret = cons(
		List(n_get_symbol("flags"),
			get_integer(xli->flags,0),
			-1),
		ret);
	ret = cons(
		List(n_get_symbol("mode"),
			get_integer(xli->mode,0),
			-1),
		ret);
	ret = cons(
		List(n_get_symbol("thread"),
			get_integer(xli->front_thread,0),
			get_integer(xli->relay_thread,0),
			-1),
		ret);
	ret = cons(
		List(n_get_symbol("iid"),
			get_integer(xli->id,0),
			-1),
		ret);
	unlock_task(xli_lock,"GetCPUStatus");
	ret = cons(n_get_symbol("status"),ret);
	return ret;
invalid_param:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"GetCPUStatus"),
		n_get_string("there is no such XL interpreter"));
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"GetCPUStatus"),
		0);
}


