/**********************************************************************
 
	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	"xl.h"
#include	"resource.h"
#include	"lock_level.h"
#include	"task.h"
#include	"utils.h"

SEM cu_lock;

COORDINATE_UNIT * cu_list;

void
init_coordinate_unit()
{
	cu_lock = new_lock(LL_CU);
}


COORDINATE_UNIT *
_new_c_unit(L_CHAR * url,L_CHAR * system,L_CHAR * unit)
{
COORDINATE_UNIT * ret;
	ret = d_alloc(sizeof(*ret),1234);
	ret->url = ll_copy_str(url,123);
	if ( system ) {
		if ( l_strcmp(system,l_string(std_cm,"base")) )
			ret->system = compose_url(url,system);
		else	ret->system = ll_copy_str(system,1245);
		ret->unit = ll_copy_str(unit,123);
	}
	else {
		ret->system = 0;
		ret->unit = 0;
	}
	ret->next = cu_list;
	cu_list = ret;
	return ret;
}


COORDINATE_UNIT *
_search_c_unit(L_CHAR * url)
{
COORDINATE_UNIT * ret;
	for ( ret = cu_list ; ret ; ret = ret->next )
		if ( l_strcmp(ret->url,url) == 0 )
			return ret;
	return 0;
}

COORDINATE_UNIT *
search_c_unit(L_CHAR * url)
{
COORDINATE_UNIT * ret;
	lock_task(cu_lock);
	ret = _search_c_unit(url);
	unlock_task(cu_lock,"search_c_unit");
	return ret;
}

COORDINATE_UNIT *
_set_c_unit(L_CHAR * url,L_CHAR * system,L_CHAR * unit)
{
COORDINATE_UNIT * ret;
	ret = _search_c_unit(url);
	if ( ret == 0 )
		return _new_c_unit(url,system,unit);
	else {
		if ( ret->system )
			d_f_ree(ret->system);
		if ( ret->unit )
			d_f_ree(ret->unit);
		if ( l_strcmp(system,l_string(std_cm,"base")) )
			ret->system = compose_url(url,system);
		else	ret->system = ll_copy_str(system,1245);
		ret->unit = ll_copy_str(unit,123);
		wakeup_task((int)ret);
		return ret;
	}
}

void
setup_c_unit(COORDINATE_UNIT * up,int ses,L_CHAR * url,
	XL_SEXP * meta,XL_SYM_FIELD * sf)
{
COORDINATE_UNIT * u;
XL_SEXP * bu, * ret;
L_CHAR * uri, * unit;
UNIT_ENV * ue;
XLISP_ENV * env;
int _ses;


retry:
	_ses = 0;
	up->uenv = 0;
	lock_task(cu_lock);
	u = _search_c_unit(url);
	if ( u ) {
		if ( u->system ) {
			up->system = ll_copy_str(u->system,141);
			up->unit = ll_copy_str(u->unit,1451);
			up->url = ll_copy_str(u->url,132);
			unlock_task(cu_lock,"setup_c_unit");
			goto next;
		}
		else {
			sleep_task((int)u,cu_lock);
			goto retry;
		}
	}
	else {
		_new_c_unit(url,0,0);
	}
	unlock_task(cu_lock,"setup_c_unit");

	up->system = 0;
	up->unit = 0;
	up->url = 0;

	gc_push(0,0,"setup_c_unit");
	if ( meta == 0 && sf == 0 ) {
		if ( ses < 0 ) {
			ses = open_session(SEST_OPTIMIZE);
			_ses = 1;
		}
		meta = load_meta(ses,"meta",url);
		switch ( get_type(meta) ) {
		case XLT_ERROR:
			gc_pop(0,0);
			if ( _ses )
				close_session(ses);
			return;
		case XLT_PAIR:
			break;
		default:
			if ( _ses )
				close_session(ses);
			gc_pop(0,0);
			return;
		}
	}
	if ( meta ) {
		bu = car(meta);
		if ( get_type(bu) != XLT_SYMBOL ||
				l_strcmp(bu->symbol.data,
				l_string(std_cm,"meta")) ) {
			meta = get_el_by_symbol(meta,
				l_string(std_cm,"meta"),
				0);
		}
		bu = get_el_by_symbol(meta,
				l_string(std_cm,"base-unit"),
				0);
		lock_task(cu_lock);
		if ( bu == 0 ) {
			u = _set_c_unit(url,
				l_string(std_cm,"base"),
				l_string(std_cm,"m"));
		}
		else {
			bu = car(bu);
			if ( get_type(bu) != XLT_SYMBOL )
				goto err;
			uri = get_sf_attribute(bu->symbol.field,
					l_string(std_cm,"uri"));
			unit = get_sf_attribute(bu->symbol.field,
					l_string(std_cm,"unit"));
			if ( uri == 0 )
				uri = l_string(std_cm,"base");
			if ( unit == 0 )
				unit = l_string(std_cm,"m");
			u = _set_c_unit(url,uri,unit);
		}
	}
	else {
		lock_task(cu_lock);
		uri = get_sf_attribute(sf,l_string(std_cm,"uri"));
		unit = get_sf_attribute(sf,l_string(std_cm,"unit"));
		if ( uri == 0 )
			uri = l_string(std_cm,"base");
		if ( unit == 0 )
			unit = l_string(std_cm,"m");
		u = _set_c_unit(url,uri,unit);
	}
	up->system = ll_copy_str(u->system,124);
	up->unit = ll_copy_str(u->unit,123);
	up->url = ll_copy_str(u->url,125);
err:
	unlock_task(cu_lock,"setup_c_unit");
	gc_pop(0,0);

	if ( up->system == 0 ) {
		if ( _ses )
			close_session(ses);
		return;
	}

next:
	if ( l_strcmp(up->system,l_string(std_cm,"base")) == 0 ) {
		if ( _ses )
			close_session(ses);
		up->uenv = get_uenv(gblisp_top_env0);
		return;
	}
	ue = search_uenv_name(up->system);
	if ( ue ) {
		if ( _ses )
			close_session(ses);
		up->uenv = ue;
		return;
	}
	gc_push(0,0,"setup_c_unit");
	if ( ses < 0 ) {
		ses = open_session(SEST_OPTIMIZE);
		_ses = 1;
	}
	meta = load_meta(ses,"data",up->system);
	switch ( get_type(meta) ) {
	case XLT_ERROR:
		gc_pop(0,0);
		if ( _ses )
			close_session(ses);
		return;
	case XLT_PAIR:
		break;
	default:
		gc_pop(0,0);
		if ( _ses )
			close_session(ses);
		return;
	}
	env = new_env(gblisp_top_env0);
	for ( ; get_type(meta) == XLT_PAIR ; meta = cdr(meta) ) {
		ret = eval(env,car(meta));
	}
	if ( env->e.uenv == 0 ) {
		gc_pop(0,0);
		if ( _ses )
			close_session(ses);
		return;
	}
	ue = env->e.uenv;
	set_uenv_name(ue,up->system);
	gc_pop(0,0);
	if ( _ses )
		close_session(ses);
	up->uenv = ue;
	return;
}


