/**********************************************************************
 
	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	"xl.h"
#include	"gbacrp.h"
#include	"mp.h"
#include	"gbmp.h"

int idle_interval;


void
set_idle_interval(float p)
{
MP_WORK mpw;
TQ_STATISTICS tqs;

	get_mp_work(&mpw,0);
	tick_que_statistics(&tqs);
	mpw.total_maps = tqs.maps;
	idle_interval = 2*idle_interval*(1-p);
	if ( idle_interval < mpw.total_maps*MAPPING_PING_INTERVAL_UNIT )
		idle_interval = mpw.total_maps*MAPPING_PING_INTERVAL_UNIT;
	if ( idle_interval < 10 )
		idle_interval = 10;
	set_mp_work(&mpw);
}

int
get_idle_interval()
{
	return idle_interval - (rand()/(float)RAND_MAX)*0.1*idle_interval;
}

int
mp_counter()
{
int p;
XL_SEXP * file_list;
XL_SEXP * t;
int cnt,cc;
MP_WORK mpw;
TQ_STATISTICS tqs;
int interval;

	get_mp_work(&mpw,0);
	gc_push(0,0,"mp_counter");
	file_list = eval(gblisp_top_env1,
		List(get_symbol(l_string(std_cm,"MPrule")),-1));

	switch ( get_type(file_list) ) {
	case XLT_NULL:
		break;
	case XLT_ERROR:
		print_sexp(s_stderr,file_list,0);
		s_printf(s_stderr,"\n");
		er_panic("mp_counter");
	case XLT_PAIR:
		break;
	default:
		fprintf(stderr,"type missmatch");
		print_sexp(s_stderr,file_list,0);
		s_printf(s_stderr,"\n");
		er_panic("mp_counter(2)");
	}
	cnt = 0;
	for ( ; get_type(file_list) == XLT_PAIR ; 
			file_list = cdr(file_list) ) {
		t = car(file_list);
		if ( get_type(t) != XLT_STRING ) {
			fprintf(stderr,"type missmatch");
			fflush(stderr);
			print_sexp(s_stderr,file_list,0);
			s_printf(s_stderr,"\n");
			er_panic("mp_counter(3)");
		}
		gc_push(0,0,"mp_counter");
		cc = list_length(
			get_crd_par(t->string.data));
		if ( cc > 0 )
			cnt += cc;
		cc = list_length(
			get_crd_chi(t->string.data));
		if ( cc > 0 )
			cnt += cc;
		gc_pop(0,0);
	}
	mpw.total_map_references = cnt;

	tick_que_statistics(&tqs);
	mpw.total_maps = tqs.maps;
	gc_pop(0,0);
	set_mp_work(&mpw);
	interval = mpw.total_map_references * MP_COUNTER_INTERVAL_UNIT;
	if ( interval < 2*mpw.interval_avg )
		interval = 2*get_idle_interval();
	if ( interval < MP_COUNTER_MIN_INTERVAL )
		return MP_COUNTER_MIN_INTERVAL;
	return interval;
}




XL_SEXP *
get_mapping(L_CHAR * filename,char * prefix)
{
URL u;
L_CHAR * buf;
L_CHAR * pref;
int len;
XL_SEXP * s, * ret;
XL_SEXP * get_op();
void gc_gb_sexp();
XL_SEXP * r;

	gc_push(0,0,"get_mapping");
	get_url2(&u,filename);
	buf = get_url_filepath(&u);
	free_url(&u);
	len = l_strlen(buf);
	buf = d_re_alloc(buf,(len+10)*sizeof(L_CHAR));
	pref = &buf[len];
	l_strcpy(pref,l_string(std_cm,prefix));
	s = n_get_symbol("Get");
	ret = get_op(gblisp_top_env0,s,buf);
	d_f_ree(buf);

	switch ( get_type(ret) ) {
	case XLT_ERROR:
	case XLT_NULL:
		ret = 0;
	case XLT_PAIR:
		for ( r = ret ; get_type(r) ; r = cdr(r) );
		break;
	default:
		ret = 0;
	}
	gc_pop(ret,gc_gb_sexp);
	return ret;
}

int
check_mapping(
	L_CHAR * filename,
	unsigned int* __time,
	int * __interval,
	unsigned int* __pmd_time,
	int * __pmd_interval)
{
XL_SEXP * mpt, * gv;
unsigned int interval;
unsigned int time,now;
unsigned int pmd_interval;
unsigned int pmd_time;
XL_SEXP * _interval, * _time;
XL_SEXP * _pmd_interval, * _pmd_time;
CALL_LOCK_DESCRIPTER lr;
L_CHAR * _filename;
extern L_CHAR * sys_path;
int len,slen,total;
XL_SEXP * xl_GetElement();
MP_WORK mpw;

	mpt = get_mapping(filename,".mpt");
	if ( mpt == 0 ) {
		get_mp_work(&mpw,0);
		pmd_interval = interval = mpw.interval_avg;
		pmd_time = time = get_xltime();
		goto ok;
	}
	_interval = xl_GetElement(gblisp_top_env0,
		List(n_get_symbol("GetElement"),
			get_el(mpt,1),
			n_get_symbol("interval"),
			-1));
	_interval = get_el(_interval,1);
	switch ( get_type(_interval) ) {
	case XLT_INTEGER:
		interval = _interval->integer.data;
		break;
	default:
		interval = MAPPING_INTERVAL_UNIT;
		break;
	}
	_time = xl_GetElement(gblisp_top_env0,
		List(n_get_symbol("GetElement"),
			get_el(mpt,1),
			n_get_symbol("invoke-time"),
			-1));
	_time = get_el(_time,1);
	switch ( get_type(_time) ) {
	case XLT_INTEGER:
		time = _time->integer.data;
		break;
	default:
		time = 0;
		break;
	}

	_pmd_time = xl_GetElement(gblisp_top_env0,
		List(n_get_symbol("GetElement"),
			get_el(mpt,1),
			n_get_symbol("invoke-pmd-time"),
			-1));
	_pmd_time = get_el(_pmd_time,1);
	switch ( get_type(_pmd_time) ) {
	case XLT_INTEGER:
		pmd_time = _pmd_time->integer.data;
		break;
	default:
		pmd_time = 0;
		break;
	}

	_pmd_interval = xl_GetElement(gblisp_top_env0,
		List(n_get_symbol("GetElement"),
			get_el(mpt,1),
			n_get_symbol("pmd-interval"),
			-1));
	_pmd_interval = get_el(_pmd_interval,1);
	switch ( get_type(_pmd_interval) ) {
	case XLT_INTEGER:
		pmd_interval = _pmd_interval->integer.data;
		break;
	default:
		pmd_interval = 0;
		break;
	}

	now = get_xltime();
	if ( time > now ) {
		if ( interval < 10 )
			interval = 10;
		if ( pmd_interval < 10 )
			pmd_interval = 10;
		*__time = time;
		*__interval = interval;
		*__pmd_time = pmd_time;
		*__pmd_interval = pmd_interval;
		return -1;
	}
ok:
	if ( interval < 10 )
		interval = 10;
	if ( pmd_interval < 10 )
		pmd_interval = 10;
	*__time = time;
	*__interval = interval;
	*__pmd_time = pmd_time;
	*__pmd_interval = pmd_interval;
	return 0;
}

int
set_mapping(
	L_CHAR * filename,
	unsigned int time,
	unsigned int interval,
	unsigned int pmd_time,
	unsigned int pmd_interval)
{
XL_SEXP * mpt, * gv;
CALL_LOCK_DESCRIPTER lr;
L_CHAR * _filename;
extern L_CHAR * sys_path;
int len,slen,total;
XL_SEXP * xl_GetElement();
STREAM * st;

	gv = n_get_symbol("?xl");
	set_attribute(gv,
		l_string(std_cm,"version"),
		l_string(std_cm,"1.0"));
	set_attribute(gv,
		l_string(std_cm,"encoding"),
		l_string(std_cm,"EUC-JP"));
	mpt = List(
		List(gv,-1),
		List(n_get_symbol("mp-sts"),
			List(n_get_symbol("interval"),
				get_integer(interval,0),
				-1),
			List(n_get_symbol("invoke-time"),
				get_integer(time,0),
				-1),
			List(n_get_symbol("pmd-interval"),
				get_integer(pmd_interval,0),
				-1),
			List(n_get_symbol("invoke-pmd-time"),
				get_integer(pmd_time,0),
				-1),
			-1),
			-1);
	slen = l_strlen(sys_path);
	len = l_strlen(filename);
	_filename = d_alloc((len + slen + 10)*sizeof(L_CHAR));
	l_strcpy(_filename,sys_path);
	if ( filename[0] == '/' ) {
		l_strcpy(&_filename[slen],filename);
		total = slen + len;
	}
	else {
		_filename[slen] = '/';
		l_strcpy(&_filename[slen+1],filename);
		total = slen + len + 1;
	}
	l_strcpy(&_filename[total],l_string(std_cm,".mpt"));

	lr = call_lock(_filename,CLT_WRITE_LOCK);

	st = s_open_file(
		n_string(std_cm,_filename),
		O_CREAT|O_TRUNC|O_RDWR,
		0644);
	if ( st == 0 )
		goto end;
	print_sexp(
		st,
		mpt,
		PF_MULTI_ROOT|PF_INDENT);
	s_printf(st,"\n");
	s_close(st);

end:

	call_unlock(lr);

	d_f_ree(_filename);
	return 0;
}


int
set_par_chi(L_CHAR * filename,XL_SEXP * s,char * prefix)
{
CALL_LOCK_DESCRIPTER lr;
L_CHAR * _filename;
extern L_CHAR * sys_path;
int len,slen,total;
XL_SEXP * xl_GetElement();
STREAM * st;
XL_SEXP * gv;

	slen = l_strlen(sys_path);
	len = l_strlen(filename);
	_filename = d_alloc((len + slen + 10)*sizeof(L_CHAR));
	l_strcpy(_filename,sys_path);
	if ( filename[0] == '/' ) {
		l_strcpy(&_filename[slen],filename);
		total = slen + len;
	}
	else {
		_filename[slen] = '/';
		l_strcpy(&_filename[slen+1],filename);
		total = slen + len + 1;
	}
	l_strcpy(&_filename[total],l_string(std_cm,prefix));
	gv = n_get_symbol("?xl");

	lr = call_lock(_filename,CLT_WRITE_LOCK);

	st = s_open_file(
		n_string(std_cm,_filename),
		O_CREAT|O_TRUNC|O_RDWR,
		0644);
	if ( st == 0 )
		goto end;
	print_sexp(
		st,
		s,
		PF_MULTI_ROOT);
	s_printf(st,"\n");
	s_close(st);

end:
	call_unlock(lr);
	d_f_ree(_filename);
	return 0;
}


int
set_target(int ses,
	L_CHAR * target,L_CHAR * src,L_CHAR * dest,L_CHAR * map,int dp,
	char * prefix,
	unsigned int interval,
	unsigned int mod)
{
URL u;
XL_SEXP * ret;
XL_SEXP * gt;
L_CHAR * f;
L_CHAR * _target;
int len;

	gt = n_get_symbol("Set");
	set_attribute(gt,
		l_string(std_cm,"option"),
		l_string(std_cm,"part"));
	_target = ll_copy_str(target);
	len = l_strlen(_target);
	_target = d_re_alloc(_target,(len+10)*sizeof(L_CHAR));
	l_strcpy(&_target[len],l_string(std_cm,prefix));
	get_url2(&u,_target);
	d_f_ree(_target);
	ret = remote_session(
		gblisp_top_env0,
		ses,
		&u,
		l_string(std_cm,"gbstd"),
		l_string(std_cm,"user"),
		l_string(std_cm,"Set"),
		List(List(gt,
			get_string(f = get_url_filepath(&u)),
			List(n_get_symbol("quote"),
				List(n_get_symbol("record"),
					List(n_get_symbol("src"),
						get_string(src),
						-1),
					List(n_get_symbol("dest"),
						get_string(dest),
						-1),
					List(n_get_symbol("map"),
						get_string(map),
						-1),
					List(n_get_symbol("dp"),
						get_integer(dp,0),
						-1),
					List(n_get_symbol("mod"),
						get_integer(mod,
						l_string(std_cm,"sec")),
						-1),
					-1),
				-1),
			get_integer(interval*4,0),
			-1),
			-1),
		0,0,0);
	d_f_ree(f);
	free_url(&u);
	if ( get_type(ret) == XLT_PAIR ) {
		ret = get_el(ret,1);
		if ( get_type(ret) != XLT_INTEGER )
			return 0;
		return ret->integer.data;
	}
	return 0;
	
}

int
delete_target(int ses,
	L_CHAR * target,L_CHAR * src,L_CHAR * dest,L_CHAR * map,int dp,
	char * prefix)
{
URL u;
XL_SEXP * ret;
XL_SEXP * gt;
L_CHAR * f;
L_CHAR * _target;
int len;
	gt = n_get_symbol("Set");
	set_attribute(gt,
		l_string(std_cm,"option"),
		l_string(std_cm,"delete"));
	_target = ll_copy_str(target);
	len = l_strlen(_target);
	_target = d_re_alloc(_target,(len+10)*sizeof(L_CHAR));
	l_strcpy(&_target[len],l_string(std_cm,prefix));
	get_url2(&u,_target);
printf("target %s\n",n_string(std_cm,_target));
	d_f_ree(_target);
	ret = remote_session(
		gblisp_top_env0,
		ses,
		&u,
		l_string(std_cm,"gbstd"),
		l_string(std_cm,"user"),
		l_string(std_cm,"Set"),
		List(List(gt,
			get_string(f = get_url_filepath(&u)),
			List(n_get_symbol("quote"),
				List(n_get_symbol("record"),
					List(n_get_symbol("src"),
						get_string(src),
						-1),
					List(n_get_symbol("dest"),
						get_string(dest),
						-1),
					List(n_get_symbol("map"),
						get_string(map),
						-1),
					-1),
				-1),
			-1),
			-1),
		0,0,0);
	d_f_ree(f);
	free_url(&u);
	return 0;
}

L_CHAR * 
get_full_url(L_CHAR * current,L_CHAR * url)
{
char * my_url;
int port;
int len;
L_CHAR * ret;
	port = get_my_port();
	len = l_strlen(gblisp_site);
	my_url = d_alloc(100+len);
	if ( current[0] == '/' )
		sprintf(my_url,"xlp://%s:%i%s",
			n_string(std_cm,gblisp_site),port,
			n_string(std_cm,current));
	else	sprintf(my_url,"xlp://%s:%i/%s",
			n_string(std_cm,gblisp_site),port,
			n_string(std_cm,current));
	ret = compose_url(l_string(std_cm,my_url),url);
	d_f_ree(my_url);
	return ret;
}

L_CHAR * 
get_full_my_url(L_CHAR * current)
{
char * my_url;
int port;
int len,flen;
L_CHAR * ret;
	port = get_my_port();
	len = l_strlen(gblisp_site);
	flen = l_strlen(current);
	my_url = d_alloc(100+len+flen);
	if ( current[0] == '/' )
		sprintf(my_url,"xlp://%s:%i%s",
			n_string(std_cm,gblisp_site),port,
			n_string(std_cm,current));
	else	sprintf(my_url,"xlp://%s:%i/%s",
			n_string(std_cm,gblisp_site),port,
			n_string(std_cm,current));
	ret = nl_copy_str(std_cm,my_url);
	d_f_ree(my_url);
	return ret;
}



unsigned int
get_next_interval(unsigned int p1,unsigned int p2,unsigned int interval)
{
unsigned int max;
unsigned int next_interval;
MP_WORK mpw;
unsigned int ping_interval;
	get_mp_work(&mpw,0);
	if ( p1 == 0 && p2 == 0 )
		return interval;
	if ( p1 == 0 )
		max = p2;
	else if ( p2 == 0 )
		max = p1;
	else if ( p1 < p2 )
		max = p2;
	else	max = p1;
	ping_interval = get_idle_interval();
	next_interval = max*MAPPING_INTERVAL_UNIT;
	mpw.interval_avg = (mpw.interval_avg*2 + next_interval)/3;
	if ( ping_interval > next_interval )
		next_interval = ping_interval;
	if ( next_interval > 2*interval )
		next_interval = 2*interval;
	if ( next_interval <=  8 )
		return next_interval;
	set_mp_work(&mpw);
	return next_interval - (rand()/(float)RAND_MAX)*0.1*next_interval;
}


unsigned int
get_next_pmd_interval(unsigned int p1,unsigned int p2,unsigned int interval,
		      unsigned int pmd_prev_interval)
{
int p_interval;
int next;
MP_WORK mpw;

	get_mp_work(&mpw,0);
	if ( p1 == 0 && p2 == 0 )
		next = interval;
	else if ( p1 == 0 )
		next = p2;
	else if ( p2 == 0 )
		next = p1;
	else if ( p1 > p2 )
		next = p1;
	else	next = p2;
/*
	p_interval = mpw.total_maps*MAPPING_PING_INTERVAL_UNIT;
	if ( next < p_interval ) {
		if ( 2*next < p_interval )
			next = 2*next;
		else	next = p_interval;
	}
*/
	p_interval = get_idle_interval();
	next = next - (rand()/(float)RAND_MAX)*0.2*next;
	if ( next < 10 )
		next = 10;
	if ( next < p_interval )
		next = p_interval;
	if ( next > 2*pmd_prev_interval )
		next = 2*pmd_prev_interval;
	return next;
}

int
ping_mapping(int ses,L_CHAR * filename,int force)
{
XL_SEXP * xl_GetElement();
XL_SEXP * meta;
XL_SEXP * mpt;
L_CHAR * src, * dest, * map;
XL_SEXP * dp;
int _dp;
L_CHAR * target;
unsigned int pitch,pitch1,pitch2;
unsigned int time,interval,_interval;
unsigned int pmd_time,pmd_interval;
unsigned int pmd_interval1,pmd_interval2;
unsigned int _pmd_interval;
unsigned int mod;


	if ( check_mapping(filename,
			&time,
			&interval,
			&pmd_time,
			&pmd_interval) < 0 ) {
		if ( force == 0 || force == 2 ) {
			if ( pmd_time == 0 || pmd_time <= get_xltime() ) {
				force += 4;
				goto next;
			}
			if ( pmd_time > time ) {
				if ( time > get_xltime() )
					return time - get_xltime();
			}
			else if ( pmd_time < time ) {
				if ( pmd_time > get_xltime() )
					return pmd_time - get_xltime();
			}
			if ( pmd_interval > interval )
				return interval;
			else	return pmd_interval;
		}
	}

next:
	mod = get_file_modify(filename,".mta");
	meta = get_mapping(filename,".mta");
	if ( meta == 0 ) {
		log_printf(LOG_WARNING,"MP: cannot access metadata of the %s",
			n_string(std_cm,filename));
		return -1;
	}
	meta = get_el(meta,1);
	if ( meta == 0 )
		return interval;
	get_sd_url(&src,&dest,&map,meta);
	if ( src == 0 || dest == 0 )
		return interval;
	dp = xl_GetElement(gblisp_top_env0,
		List(n_get_symbol("GetElement"),
			meta,
			n_get_symbol("dp"),
			-1));
	if ( dp == 0 )
		return interval;
	dp = get_el(dp,1);
	if ( get_type(dp) != XLT_INTEGER )
		return interval;


	_dp = dp->integer.data;
	src = get_full_url(filename,src);
	dest = get_full_url(filename,dest);
	map = get_full_my_url(filename);
	if ( force == 3 ) {
		delete_target(ses,src,src,dest,map,_dp,".par");
		delete_target(ses,dest,src,dest,map,_dp,".chi");
		d_f_ree(src);
		d_f_ree(dest);
		d_f_ree(map);
		log_printf(LOG_DEBUG,"MP: delete %s",
			n_string(std_cm,filename));
		return -1;
	}


	if ( force == 1 || pmd_time == 0 || pmd_time <= get_xltime() ) {
	unsigned int ping_interval;


		pmd_interval1 = lump_trigger(ses,src,map,pmd_interval);
		pmd_interval2 = lump_trigger(ses,dest,map,pmd_interval);
		pmd_interval = get_next_pmd_interval(
			pmd_interval1,pmd_interval2,interval,pmd_interval);

		pmd_time = get_xltime() + pmd_interval;

	}
	if ( force >= 4 ) {

		set_mapping(filename,time,interval,pmd_time,pmd_interval);

		if ( force == 4 || force == 6 ) {

			if ( pmd_time > time ) {
				if ( time > get_xltime() )
					return time - get_xltime();
			}
			else {
				if ( pmd_time > get_xltime() )
					return pmd_time - get_xltime();
			}
			if ( interval > pmd_interval )
				return pmd_interval;
			else	return interval;
		}

	}

	pitch1 = set_target(ses,src,src,dest,map,_dp,".par",interval,mod);
	pitch2 = set_target(ses,dest,src,dest,map,_dp,".chi",interval,mod);

	d_f_ree(src);
	d_f_ree(dest);
	d_f_ree(map);

	interval = get_next_interval(pitch1,pitch2,interval);
	if ( force == 2 )
		_interval = rand()%interval;
	else	_interval = interval;
	time = get_xltime() + _interval;
	set_mapping(filename,time,interval,pmd_time,pmd_interval);


	if ( pmd_interval > _interval )
		return _interval;
	else	return pmd_interval;
}


int
clear_crd_map(XL_SEXP ** retp,XL_SEXP * s)
{
XL_SEXP * ret;
XL_SEXP * t;
XL_SEXP * tm;
XL_SEXP * _tm;
extern XL_SEXP * xl_GetElement();
int flag;
XL_SEXP * sym;
	ret = 0;
	flag = 0;
	for ( ; get_type(s) == XLT_PAIR ; s = cdr(s) ) {
		t = car(s);
		tm = xl_GetElement(gblisp_top_env0,
			List(n_get_symbol("GetElement"),
				t,
				n_get_symbol("tm"),
				-1));
		if ( tm == 0 ) {
			sym = car(t);
			if ( get_type(sym) != XLT_SYMBOL ) {
				flag = 1;
				continue;
			}
			if ( l_strcmp(sym->symbol.data,
					l_string(std_cm,"cindex"))
					== 0 ) {
				ret = cons(t,ret);
				continue;
			}
			flag = 1;
			continue;
		}
		_tm = get_el(tm,1);
		if ( get_type(_tm) != XLT_INTEGER ) {
			flag = 1;
			continue;
		}
		if ( _tm->integer.data < get_xltime() ) {
			flag = 1;
			continue;
		}
		ret = cons(t,ret);
	}
	*retp = ret;
	return flag;
}

void
ping_crd_mapping(L_CHAR * filename)
{
XL_SEXP * p;

	gc_push(0,0,"trace_crd_mapping");
	p = get_mapping(filename,".par");
	if ( clear_crd_map(&p,p) ) {
		set_par_chi(filename,p,".par");
		insert_tick_que(0,filename,TQT_CRD,TQL_ACRP);
	}
	gc_pop(0,0);

	gc_push(0,0,"trace_crd_mapping");
	p = get_mapping(filename,".chi");
	if ( clear_crd_map(&p,p) ) {
		set_par_chi(filename,p,".chi");
		insert_tick_que(0,filename,TQT_CRD,TQL_ACRP);
	}
	gc_pop(0,0);
}



void
trace_mapping()
{
int p;
XL_SEXP * file_list;
XL_SEXP * t;
int ses;
int interval;
static int trace_force = 2;

	gc_push(0,0,"trace_mapping");
	file_list = eval(gblisp_top_env1,
		List(get_symbol(l_string(std_cm,"MAPPINGrule")),-1));
	switch ( get_type(file_list) ) {
	case XLT_NULL:
		break;
	case XLT_ERROR:
		print_sexp(s_stderr,file_list,0);
		s_printf(s_stderr,"\n");
		er_panic("trace_mapping");
	case XLT_PAIR:
		break;
	default:
		fprintf(stderr,"type missmatch");
		print_sexp(s_stderr,file_list,0);
		s_printf(s_stderr,"\n");
		er_panic("trace_mapping(2)");
	}
	ses = open_session(SEST_OPTIMIZE);
	for ( ; get_type(file_list) == XLT_PAIR ; 
			file_list = cdr(file_list) ) {
		t = car(file_list);
		if ( get_type(t) != XLT_STRING ) {
			fprintf(stderr,"type missmatch");
			print_sexp(s_stderr,file_list,0);
			s_printf(s_stderr,"trace_mapping(3)");
			er_panic("trace_mapping(3)");
		}
		gc_push(0,0,"trace mapping");
		interval = ping_mapping(ses,t->string.data,trace_force);
		gc_pop(0,0);
		if ( interval >= 0 )
			insert_tick_que(interval,t->string.data,TQT_MAP,
					TQL_NORMAL);
	}
	close_session(ses);
	gc_pop(0,0);
}



void
trace_crd_mapping()
{
int p;
XL_SEXP * file_list;
XL_SEXP * t;


	gc_push(0,0,"trace_mapping");
	file_list = eval(gblisp_top_env1,
		List(get_symbol(l_string(std_cm,"MPrule")),-1));
	switch ( get_type(file_list) ) {
	case XLT_NULL:
		break;
	case XLT_ERROR:
		print_sexp(s_stderr,file_list,0);
		s_printf(s_stderr,"\n");
		er_panic("trace_crd_mapping(1)");
	case XLT_PAIR:
		break;
	default:
		fprintf(stderr,"type missmatch");
		fflush(stderr);
		print_sexp(s_stderr,file_list,0);
		s_printf(s_stderr,"\n");
		er_panic("trace_crd_mapping(2)");
	}
	for ( ; get_type(file_list) == XLT_PAIR ;
			file_list = cdr(file_list) ) {
		t = car(file_list);
		if ( get_type(t) != XLT_STRING ) {
			fprintf(stderr,"type missmatch");
			fflush(stderr);
			print_sexp(s_stderr,file_list,0);
			er_panic("trace_crd_mapping(3)");
		}
		gc_push(0,0,"trace mapping");
		ping_crd_mapping(t->string.data);
		gc_pop(0,0);
	}
	gc_pop(0,0);
}


