/**********************************************************************
 
	Copyright (C) 2005- 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	"machine/include.h"
#include	"memory_debug.h"
#include	"pri_level.h"
#include	"lock_level.h"
#include	"utils.h"
#include	"task.h"
#include	"matrix.h"
#include	"xl.h"
#include	"xlerror.h"

/*
#define SCRIPT_TRIGGER
#define SCRIPT_DEBUG
#define SCRIPT_ERR
*/


typedef struct load_work {
	int		pri;
	int		cnt;
} LOAD_WORK;

void gc_tick_notin_tick();

int NC_flag;

MATRIX_SEXP	ms_root;
MATRIX_NODE *	nd_root;
int		nd_cnt;
int		total_ncache_size;
MATRIX *	matrices_root;
int mn_length;
SEM matrix_lock,matrix_gc_lock;
SYS_QUEUE matrix_que;
XLISP_ENV * matrix_xl_env;
MATRIX_DATA_TYPE * mtx_type_tbl[MDT_MAX];
int load_indicate_tick_end_flag;

void _close_matrix(MATRIX * m);

MATRIX *
_open_matrix(L_CHAR * neturl,L_CHAR * filename,L_CHAR * key,void (*open_method)(),void * work);

MATRIX_NODE * _get_matrix_node(int * errp,MATRIX * m,INTEGER64 * dim_code,int,INTEGER64);

void _wait_matrix_mode(MATRIX * m);
int _set_matrix_channel_info(MATRIX * m,int ch,MATRIX_CHANNEL_INFO * inf);
int _set_matrix_param(MATRIX * m,MATRIX_PARAM * p);
int _set_matrix_dim_divide(MATRIX * m,int dim,int dim_divide);
int _set_matrix_block_size(MATRIX * m,int dim,int block_size);
int _set_matrix_pixel_size(MATRIX * m,int dim,INTEGER64 pixel_size);
int _set_matrix_cal(MATRIX * m,int id,XL_SEXP * cal);
int _set_matrix_cal_equ(MATRIX * m,int id,int id2);
void _cal_nlist_dim_bit_field(MATRIX * m);

void _insert_node_ring(MATRIX_NODE * n);
void _delete_node_ring(MATRIX_NODE * n);
void _get_matrix_access(MATRIX_NODE * n);
int  _cmp_dim_code(MATRIX * m,INTEGER64 * dim_code1,INTEGER64 * dim_code2);
INTEGER64 * _copy_dim_code(MATRIX * m,INTEGER64 * dim_code);
MATRIX_NODE * _get_matrix_tree(int * errp,MATRIX * m,INTEGER64 * dim_code,int access);
MATRIX_NODE * _get_matrix_tree_1(int * errp,MATRIX * m,INTEGER64 * dim_code,int access);
MATRIX_NODE * _get_matrix_tree_2(int * errp,MATRIX * m,INTEGER64 * dim_code,int access);
void matrix_exec_cal(MATRIX_TOKEN * t);

void _lock_node(MATRIX_NODE *,MATRIX_TOKEN * );
void _unlock_node(MATRIX_NODE *,MATRIX_TOKEN *);
void _insert_node_wait_token(MATRIX_NODE * ,MATRIX_TOKEN *);
XL_SEXP *  _get_channel_data(MATRIX_NODE * n,int ch,XL_SEXP * s);
MATRIX * _search_matrix(L_CHAR * neturl,L_CHAR * filename,L_CHAR * key);
int _set_channel_sexp(MATRIX_NODE * n,int ch,XL_SEXP *s);
void _matrix_node_channel_unlock(MATRIX_NODE * n,int);
void _matrix_node_channel_lock(MATRIX_NODE * n);
void _xx_insert_matrix_access(MATRIX_TOKEN * t,void (*func)(),char*,int);
#define _insert_matrix_access(t,f)	_xx_insert_matrix_access(t,f,__FILE__,__LINE__)
void _set_matrix_mode(MATRIX * m,int mode);
void _insert_matrix_open(MATRIX * m,void (*func)());
void _matrix_trigger_access(MATRIX_NODE * n,int access,int clear_err);
int _check_dim_code(MATRIX_NODE *,INTEGER64 *);
int _get_dim_code_index(MATRIX_NODE * n,INTEGER64 * dim_code);
void _insert_dim_code_index(MATRIX_NODE *,INTEGER64 *,int);
void _set_dirty_file(MATRIX_NODE * n);
void _cal_matrix_total_levels(MATRIX * m);

void matrix_que_task();
int _free_matrix_node(MATRIX_NODE *);
void _delete_matrix_sexp(MATRIX_SEXP*);
void _lock_save(MATRIX_NODE *);
void _unlock_save(MATRIX_NODE*);
void _xx_insert_access_list(MATRIX_TOKEN * t,int acc,char *,int);
#define _insert_access_list(t,acc)	\
	_xx_insert_access_list(t,acc,__FILE__,__LINE__)
int _delete_access_list(MATRIX_TOKEN * t);
MATRIX_TOKEN * _new_matrix_token(MATRIX_NODE*);
void
_set_access_jump(MATRIX_TOKEN * t,
	int err_jump,int normal_jump,int err_jump_status,int normal_jump_status);
void _matrix_token_error(MATRIX_TOKEN * t);
void see_access_list(MATRIX_ACCESS_LIST * a);
void _allset_dim_code_index(MATRIX_NODE * n,int dirty);
void _matrix_access_tick();
void matrix_access_tick();
void _insert_matrix_ring(MATRIX * m);
void _delete_matrix_ring(MATRIX * m);
void _flush_all_dirty_file(MATRIX * m);
void _sync_matrix(MATRIX*);
int _sync_matrix_node(MATRIX_NODE*);
void _set_matrix_env(MATRIX * m,char * name,char * data);
int mx_last_access(int *);
void mx_purge();


int
_dc_peano_inc(MATRIX * m,
	INTEGER64 * dc,
	INTEGER64 * dc_start,
	INTEGER64 * dc_end,
	int level);
void
_matrix_peano_trigger(
	MATRIX * m,
	INTEGER64 * dc_start,
	INTEGER64 * dc_end,
	int _access);

void load_indicate_tick();
int load_indicate_cond(SYS_QUEUE * sq,Q_HEADER * h,LOAD_WORK * w);

MEM_PURGE_TBL mx_mpt = {
	mx_last_access,
	mx_purge,
};


void
init_matrix()
{
	init_mx_file();

	ms_root.prev = ms_root.next = &ms_root;
	nd_root = d_alloc(sizeof(MATRIX_NODE_HEADER));
	nd_root->h.next = nd_root->h.prev = nd_root;
	total_ncache_size = MIN_NCACHE_SIZE;
	mn_length = 0;
	matrix_lock = new_lock(LL_MATRIX);
	matrix_gc_lock = new_lock(LL_MATRIX_GC);
	matrices_root = d_alloc(sizeof(MATRIX*)*2);
	matrices_root->mx_next = matrices_root->mx_prev = matrices_root;

	memset(&matrix_que,0,sizeof(SYS_QUEUE));
	matrix_que.flags = QF_PRI_FIFO;
	matrix_que.gc_func = 0;
	matrix_que.gc_get = 0;
	matrix_que.key_func = matrix_que_task;
	matrix_que.pri = PRI_DRAW;
	setup_queue(&matrix_que);


	insert_matrix_type_table(&mx_type_bit);
	insert_matrix_type_table(&mx_type_bit_v);
	insert_matrix_type_table(&mx_type_int8);
	insert_matrix_type_table(&mx_type_int8_v);
	insert_matrix_type_table(&mx_type_uint8);
	insert_matrix_type_table(&mx_type_uint8_v);
	insert_matrix_type_table(&mx_type_int16);
	insert_matrix_type_table(&mx_type_int16_v);
	insert_matrix_type_table(&mx_type_uint16);
	insert_matrix_type_table(&mx_type_uint16_v);
	insert_matrix_type_table(&mx_type_int32);
	insert_matrix_type_table(&mx_type_int32_v);
	insert_matrix_type_table(&mx_type_uint32);
	insert_matrix_type_table(&mx_type_uint32_v);
	insert_matrix_type_table(&mx_type_int64);
	insert_matrix_type_table(&mx_type_int64_v);
	insert_matrix_type_table(&mx_type_uint64);
	insert_matrix_type_table(&mx_type_uint64_v);
	insert_matrix_type_table(&mx_type_float);
	insert_matrix_type_table(&mx_type_float_v);
	insert_matrix_type_table(&mx_type_double);
	insert_matrix_type_table(&mx_type_double_v);
	insert_matrix_type_table(&mx_type_block);
	insert_matrix_type_table(&mx_type_string);
	insert_matrix_type_table(&mx_type_string_v);
	insert_matrix_type_table(&mx_type_sexp);

	matrix_xl_env = new_env(gblisp_top_env0);

	init_mxCH(matrix_xl_env);
	init_mxSet(matrix_xl_env);
	init_mxTrigger(matrix_xl_env);
	init_mxAdd(matrix_xl_env);
	init_mxDiff(matrix_xl_env);
	init_mxThinnedOut(matrix_xl_env);
	init_mxCompressJPEG(matrix_xl_env);
	init_mxUncompressJPEG(matrix_xl_env);
	init_mxLoad(matrix_xl_env);
	init_mxSave(matrix_xl_env);
	init_mxFinish(matrix_xl_env);
	init_mxUncompressOldFormat(matrix_xl_env);
	init_mxCompressZ(matrix_xl_env);
	init_mxUncomressZ(matrix_xl_env);
	init_mxCompound(matrix_xl_env);
	init_mxSeparate(matrix_xl_env);
	init_mxSquash(matrix_xl_env);
	init_mxStuffing(matrix_xl_env);


	
	new_tick(matrix_access_tick,STAT_TICK,0);
}

char * 
pt_dc(MATRIX * m,INTEGER64 * dc,int fmt)
{
char * ret;
int dim;
int i;
char * p;
	dim = m->p.dim;
	p = ret = d_alloc(30*(dim+1)+10);
	sprintf(ret,"+max %i+[" I64_FORMAT " ",m->total_levels,dc[0]);
	p = &p[strlen(p)];
	for ( i = 0 ; i < dim ; i ++ ) {
		switch ( fmt ) {
		case PTDC_NODE_ID:
			sprintf(p,"%llx ",
				dc[i+1] &
				(-(((INTEGER64)1)<<(dc[0]*m->dim_divide[i]
						+ m->block_size[i]))));
			break;
		case PTDC_PIXEL_1:
			sprintf(p,"%llx ",
				dc[i+1] &
				(-(((INTEGER64)1)<<(dc[0]*m->dim_divide[i]
						))));
			break;
		default:
			er_panic("pt_dc");
		}
		p = &p[strlen(p)];
	}
	sprintf(p,"]");
	set_buffer(ret);
	return ret;
}


void
xx_check_point(MATRIX_TOKEN * t,char * __f,int __l)
{
	t->c_file = __f;
	t->c_line = __l;
}

int
mx_last_access(int * ret)
{
	if ( nd_root->h.next == nd_root )
		return -1;
	*ret = nd_root->h.next->last_access;
	return 0;
}

void
mx_purge()
{
MATRIX_NODE * n1,*n2;
int start_nd_cnt;
	n1 = nd_root->h.prev;
	start_nd_cnt = nd_cnt/2;
	for ( ; n1 != nd_root && nd_cnt > start_nd_cnt ; ) {
		n2 = n1->h.next;
		if ( n1->status != MS_OK )
			continue;
		if ( n1->dirty_file_time )
			_matrix_trigger_access(n1,MI_SAVE_TP,0);
		_free_matrix_node(n1);
		n1 = n2;
	}
}


void
_matrix_access_tick()
{
MATRIX * m;
int acc;
	acc = 0;
	for ( m = matrices_root->mx_next ; m != matrices_root ; m = m->mx_next ) {
		m->access_cnt <<= 1;
		if ( m->access_cnt & 6 )
			acc += m->total_levels;
	}
	if ( acc == 0 )
		return;
	acc *= NCACHE_RATE;
	if ( MIN_NCACHE_SIZE > acc )
		total_ncache_size = MIN_NCACHE_SIZE;
	else	total_ncache_size = acc;
}

void
matrix_access_tick()
{
	lock_task(matrix_lock);
	_matrix_access_tick();
	unlock_task(matrix_lock,"matrix_access_tick");
}

void 
insert_matrix_type_table(MATRIX_DATA_TYPE * tp)
{
	mtx_type_tbl[tp->type] = tp;
}

MATRIX_DATA_TYPE *
get_matrix_data_type(int type)
{
	return mtx_type_tbl[type];
}

void 
_lock_save(MATRIX_NODE * n)
{
	n->save_lock = 1;
}


void 
_unlock_save(MATRIX_NODE*n)
{
	n->save_lock = 0;
	n->dirty_file_time = 0;
	wakeup_task((int)n);
}


void 
lock_save(MATRIX_NODE * n)
{
	lock_task(matrix_lock);
	_lock_save(n);
	unlock_task(matrix_lock,"lock_save");
}
void 
unlock_save(MATRIX_NODE*n)
{
	lock_task(matrix_lock);
	_unlock_save(n);
	unlock_task(matrix_lock,"lock_save");
}

void
_insert_matrix_ring(MATRIX * m)
{
	m->mx_next = matrices_root->mx_next;
	m->mx_prev = matrices_root;
	m->mx_next->mx_prev = m;
	m->mx_prev->mx_next = m;
	m->last_access = get_xltime();
}


void
_delete_matrix_ring(MATRIX * m)
{
	m->mx_next->mx_prev = m->mx_prev;
	m->mx_prev->mx_next = m->mx_next;
}

void
matrix_que_task()
{
XL_INTERPRETER * xli;
L_CHAR* key;
MATRIX_TOKEN * t;

	key = touch_qkey(&matrix_que);
	if ( key == 0 )
		return;

	xli = new_xl_interpreter();
	xli->a_type = XLA_SELF;
	setup_i(xli);

	for ( ; ; ) {
		gc_push(0,0,"dm_loading_task");

		t = delete_queue(&matrix_que,sq_key_cond,key,0);
		if ( t == 0 ) {
			gc_pop(0,0);
			break;
		}
		(*t->func)(t);

		gc_pop(0,0);
	}

	close_self_interpreter();
	release_qkey(&matrix_que,key);
}


void
_insert_node_ring(MATRIX_NODE * n)
{
MATRIX_NODE * n1, * n2;
int cnt;
unsigned int now;
	n->h.prev = nd_root;
	n->h.next = nd_root->h.next;
	n->h.prev->h.next = n;
	n->h.next->h.prev = n;
	n->last_access = get_xltime();
	nd_cnt ++;
	n1 = nd_root->h.next;
	cnt = 0;
	now = get_xltime();
	for ( ; n1 != nd_root ; n1 = n1->h.next ) {
		if ( cnt >= total_ncache_size )
			break;
		if ( n1->status != MS_OK )
			continue;
		if ( n1->dirty_file_time &&
				now - n1->dirty_file_time > DIRTY_LIMIT )
			_matrix_trigger_access(n1,MI_SAVE_TP,0);
		cnt ++;
	}
	for ( ; n1 != nd_root ; ) {
		n2 = n1->h.next;
		if ( n1 != n ) {
			if ( n1->dirty_file_time && n1->status == MS_OK )
				_matrix_trigger_access(n1,MI_SAVE_TP,0);
			_free_matrix_node(n1);
		}
		n1 = n2;
	}
}

void
_delete_node_ring(MATRIX_NODE * n)
{
	n->h.prev->h.next = n->h.next;
	n->h.next->h.prev = n->h.prev;
	nd_cnt --;
}

void
_xx_insert_matrix_sexp(MATRIX_SEXP * d,char * f,int l)
{
	lock_task(matrix_gc_lock);
	d->prev = &ms_root;
	d->next = ms_root.next;
	d->prev->next = d;
	d->next->prev = d;
	d->file = f;
	d->line = l;
	unlock_task(matrix_gc_lock,"insert_matrix_sexp");
}

void
_delete_matrix_sexp(MATRIX_SEXP * d)
{
	d->prev->next = d->next;
	d->next->prev = d->prev;
}

void
gc_matrix_lock()
{
	lock_task(matrix_gc_lock);
}

void
gc_matrix_unlock()
{
	unlock_task(matrix_gc_lock,"gc_matrix_unlock");
}


void
gc_matrix()
{
MATRIX_SEXP * d, * dn;
	gc_gblisp_env(matrix_xl_env);
	for ( d = ms_root.next ; d != &ms_root ; ) {
		dn = d->next;
		if ( d->del == 0 )
			(*d->gc_func)(d->data);
		else {
			_delete_matrix_sexp(d);
			d_f_ree(d);
		}
		d = dn;
	}
}

void
_matrix_node_channel_lock(MATRIX_NODE * n)
{
int tid;
	tid = get_tid();
	if ( n->ch_lock ) {
		if ( n->ch_lock_tid != tid ) {
			for ( ; n->ch_lock ; ) {
				sleep_task((int)n,matrix_lock);
				lock_task(matrix_lock);
			}
		}
	}
	n->ch_lock ++;
	n->ch_lock_tid = tid;
}

void
matrix_node_channel_lock(MATRIX_NODE * n)
{
	lock_task(matrix_lock);
	_matrix_node_channel_lock(n);
	unlock_task(matrix_lock,"matrix_node_channel_lock");
}



void
_matrix_node_channel_unlock(MATRIX_NODE * n,int flags)
{
	n->ch_lock --;
	if ( n->ch_lock < 0 )
		er_panic("_matrix_node_channel_unlock");
	if ( n->ch_lock == 0 ) {
		if ( flags & NF_DIRTY )
			_set_dirty_file(n);
		n->ch_lock_tid = 0;
	}
	wakeup_task((int)n);
	
}

void
matrix_node_channel_unlock(MATRIX_NODE * n,int flags)
{
	lock_task(matrix_lock);
	_matrix_node_channel_unlock(n,flags);
	unlock_task(matrix_lock,"matrix_node_channel_lock");
}


void
_insert_matrix_open(MATRIX * m,void (*func)())
{
MATRIX_TOKEN * t;
	t = d_alloc(sizeof(*t));
	memset(t,0,sizeof(*t));
	t->h.key = nl_copy_str(std_cm,"_insert_matrix_open");
	t->h.pri = 1000;
	t->func = func;
	t->wait_matrix = m;
	t->normal_jump = t->err_jump = -1;
	if ( m->p.new_token )
		(*m->p.new_token)(t,MPT_NEW_TOKEN_MATRIX);
	insert_queue(&matrix_que,t,0);
}

MATRIX *
_open_matrix(L_CHAR * neturl,L_CHAR * filename,L_CHAR * key,void (*open_method)(),void * work)
{
MATRIX * ret;
MATRIX_SEXP * d;
	ret = d_alloc(sizeof(*ret));
	memset(ret,0,sizeof(*ret));
	ret->neturl = ll_copy_str(neturl);
	ret->filename = ll_copy_str(filename);
	ret->key = ll_copy_str(key);
	ret->p.open_method = open_method;
	ret->open_work = work;

	d = d_alloc(sizeof(*d));
	memset(d,0,sizeof(*d));
	d->data = new_env(matrix_xl_env);
	d->gc_func = gc_gblisp_env;
	ret->mx_env = d;
	_insert_matrix_sexp(d);

	_insert_matrix_ring(ret);

	if ( open_method )
		_insert_matrix_open(ret,open_method);
	return ret;
}

MATRIX *
open_matrix(L_CHAR * neturl,L_CHAR * filename,L_CHAR * key,
	void (*open_method)(MATRIX_TOKEN*),void * work)
{
MATRIX * ret;
	lock_task(matrix_lock);

	ret = _open_matrix(neturl,filename,key,open_method,work);

	unlock_task(matrix_lock,"new_matrix");
	return ret;
}


void
_sync_matrix(MATRIX * m)
{
int i;
MATRIX_NODE * n;

retry1:
	switch ( m->mode ) {
	case MM_CREATE:
		unlock_task(matrix_lock,"sync");
		sleep_sec(1);
		lock_task(matrix_lock);
		goto retry1;
	case MM_STANBY:
		break;
	default:
		return;
	}

retry:
	_flush_all_dirty_file(m);

	for ( ; m->access_lock ; ) {
		sleep_task((int)m,matrix_lock);
		lock_task(matrix_lock);
		goto retry;
	}
	if ( m->wait_token ) {
		sleep_task((int)m,matrix_lock);
		lock_task(matrix_lock);
		goto retry;
	}
	for ( i = 0 ; i < NHASH_SIZE ; i ++ ) {
		if ( m->node_hash[i] == 0 )
			continue;
		n = m->node_hash[i];
		for ( ; n ; n = n->nh_next )
			if ( _sync_matrix_node(n) < 0 ) {
				sleep_task((int)n,matrix_lock);
				lock_task(matrix_lock);
				goto retry;
			}
	}
}

void
sync_matrix(MATRIX * m)
{
	lock_task(matrix_lock);
	_sync_matrix(m);
	unlock_task(matrix_lock,"sync_matrix");
}

void
_close_matrix(MATRIX * m)
{
int i;
int f;
MATRIX_SEXP * d;
MATRIX_NODE * n;
MATRIX_TOKEN * t;
int ret_id;
int retry_f;
	retry_f = 0;
	if ( m->mode == MM_CLOSE )
		return;

	m->mode = MM_CLOSE;
	_delete_matrix_ring(m);

retry:
	_flush_all_dirty_file(m);

	for ( ; m->access_lock ; ) {
		sleep_task((int)m,matrix_lock);
		lock_task(matrix_lock);
		goto retry;
	}
	if ( m->wait_token ) {
		for ( t = m->wait_token ; t ; t = t->next ) {
			if ( t->aboat_func == 0 )
				continue;
			(t->aboat_func)(t);
		}
		sleep_task((int)m,matrix_lock);
		lock_task(matrix_lock);
		goto retry;
	}
	f = 0;
	retry_f = 0;
	for ( i = 0 ; i < NHASH_SIZE ; i ++ ) {
		if ( m->node_hash[i] == 0 )
			continue;
		f = 1;
		n = m->node_hash[i];
		if ( (ret_id = _free_matrix_node(m->node_hash[i]) )< 0 ) {
			if ( n->dirty_file_time && n->status == MS_OK )
				_matrix_trigger_access(n,MI_SAVE_TP,0);
			t = m->node_hash[i]->process_token;
			if ( t && t->aboat_func )
				(*t->aboat_func)(t);
/*
			sleep_task((int)n,matrix_lock);
			lock_task(matrix_lock);
*/
			retry_f = 1;
		}
	}
	if ( retry_f ) {
		unlock_task(matrix_lock,"");
		sleep_sec(1);
		lock_task(matrix_lock);
	
		goto retry;
	}
	for ( i = 0 ; i < m->p.channel_nos ; i ++ ) {
		if ( m->channel_info[i].default_data == 0 )
			continue;
		if ( m->channel_info[i].data_type->parent ) {
			(*m->channel_info[i].data_type->parent->free_data)
				(m->channel_info[i].data_type->parent,
				m->channel_info[i].default_data);
		}
		else {
			(*m->channel_info[i].data_type->free_data)
				(m->channel_info[i].data_type,
				m->channel_info[i].default_data);
		}
	}
	m->mx_env->del = 1;
	if ( m->p.close_file )
		(*m->p.close_file)(m);
	if ( m->p.close_net )
		(*m->p.close_net)(m);

	if ( m->channel_info )
		d_f_ree(m->channel_info);
	if ( m->dim_divide )
		d_f_ree(m->dim_divide);
	if ( m->block_size )
		d_f_ree(m->block_size);
	if ( m->pixel_size )
		d_f_ree(m->pixel_size);
	for ( i = 0 ; i < MI_MAX ; i ++ ) {
		d = m->cal[i];
		if ( d == 0 )
			continue;
		d->del = 1;
	}
	if ( m->neturl )
		d_f_ree(m->neturl);
	if ( m->filename )
		d_f_ree(m->filename);
	if ( m->key )
		d_f_ree(m->key);
}

void
close_matrix(MATRIX * m)
{
	lock_task(matrix_lock);
	_close_matrix(m);
	unlock_task(matrix_lock,"close_matrix");
}

void
close_all_matrix()
{
	lock_task(matrix_lock);
	for ( ; matrices_root->mx_next != matrices_root ; ) {
		_close_matrix(matrices_root->mx_next);
	}
	unlock_task(matrix_lock,"close_matrix_");
}



MATRIX *
_search_matrix(L_CHAR * neturl,L_CHAR * filename,L_CHAR * key)
{
MATRIX * ret;
	for ( ret = matrices_root->mx_next ; ret != matrices_root ; ret = ret->mx_next ) {
		if ( neturl ) {
			if ( ret->neturl == 0 )
				continue;
			if ( l_strcmp(neturl,ret->neturl) )
				continue;
		}
		if ( filename ) {
			if ( ret->filename == 0 )
				continue;
			if ( l_strcmp(filename,ret->filename) )
				continue;
		}
		if ( key ) {
			if ( ret->key == 0 )
				continue;
			if ( l_strcmp(key,ret->key) )
				continue;
		}
		return ret;
	}
	return 0;
}

MATRIX *
search_matrix(int * errp,L_CHAR * neturl,L_CHAR * filename,L_CHAR * key,MATRIX_TOKEN * t)
{
MATRIX * ret;
	lock_task(matrix_lock);
	ret = _search_matrix(neturl,filename,key);
	if ( ret ) {
		if ( ret->mode == MM_CREATE && t ) {
			t->wait_matrix = ret;
			t->next = ret->wait_token;
			ret->wait_token = t;
			if ( errp )
				*errp = ME_PROC_NODE;
		}
		else if ( errp )
			*errp = 0;
	}
	else if ( errp )
		*errp = ME_NO_NODE;
	unlock_task(matrix_lock,"search_matrix");
	return ret;
}

int
_set_matrix_channel_info(MATRIX * m,int ch,MATRIX_CHANNEL_INFO * inf)
{
	if ( m->p.channel_nos <= ch || ch < 0 ) 
		return ME_INDEX_OVER;
	m->channel_info[ch] = *inf;
	if ( inf->default_data ) {
		if ( inf->data_type->parent )
			m->channel_info[ch].default_data
				= (*inf->data_type->parent->alloc_copy)
					(inf->data_type->parent,inf->default_data,MD_DALLOC,0);
		else	m->channel_info[ch].default_data
				= (*inf->data_type->alloc_copy)
					(inf->data_type,inf->default_data,MD_DALLOC,0);
	}
	return 0;
}

void
_cal_matrix_total_levels(MATRIX * m)
{
INTEGER64 pix;
int i,j;
int lev;
int max;
	m->total_levels = 0;
	if ( m->pixel_size == 0 )
		return;
	if ( m->p.dim == 0 )
		return;
	if ( m->dim_divide == 0 )
		return;
	if ( m->p.total_levels == 0 ) {
		max = 0;
		for ( i = 0 ; i < m->p.dim ; i ++ ) {
			if ( m->pixel_size[i] == 0 )
				return;
			if ( m->dim_divide[i] == 0 )
				return;
			pix = m->pixel_size[i];
			lev = 0;
			for ( ; pix > 1 ; ) {
				lev ++;
				if ( pix & ((1<<m->dim_divide[i])-1) )
					pix = (pix >> m->dim_divide[i]) + 1;
				else	pix = pix >> m->dim_divide[i];
			}
			lev ++;
			if ( max < lev )
				max = lev;
		}
	}
	else {
		for ( i = 0 ; i < m->p.dim ; i ++ ) {
			if ( m->pixel_size[i] == 0 )
				return;
			if ( m->dim_divide[i] == 0 )
				return;
		}
		max = m->p.total_levels;
	}
	if ( m->pixel_size_list ) {
		for ( i = 0 ; i < m->total_levels ; i ++ )
			d_f_ree(m->pixel_size_list[i]);
		d_f_ree(m->pixel_size_list);
	}
	m->total_levels = max;
	m->pixel_size_list = d_alloc(sizeof(INTEGER64*)*max);
	for ( i = 0 ; i < m->total_levels ; i ++  )
		m->pixel_size_list[i] = d_alloc(sizeof(INTEGER64)*m->p.dim);
	for ( j = 0 ; j < m->p.dim ; j ++ )
		m->pixel_size_list[0][j] = m->pixel_size[j];
	for ( i = 1 ; i < m->total_levels ; i ++ ) {
		for ( j = 0 ; j < m->p.dim ; j ++ ) {
			pix = m->pixel_size_list[i-1][j];
			if ( pix & ((1<<m->dim_divide[j])-1) )
				pix = (pix >> m->dim_divide[j]) + 1;
			else 	pix = (pix >> m->dim_divide[j]);
			if ( pix == 0 )
				pix = 1;
			m->pixel_size_list[i][j] = pix;
		}
	}
}

int
_set_matrix_param(MATRIX * m,MATRIX_PARAM * p)
{
int i;
	if ( m->p.channel_nos && p->channel_nos )
		return ME_CHANNEL_NOS;
	if ( m->p.dim && p->dim )
		return ME_DIM;
	for ( i = 0 ; i < MI_MAX ; i ++ ) {
		if ( m->p.pri_area[i] && p->pri_area[i] )
			return ME_PRI_AREA;
	}
	if ( m->p.open_method && p->open_method )
		return ME_OPEN_METHOD;
	if ( m->p.read_file && p->read_file )
		return ME_FETCH_METHOD;
	if ( m->p.write_file && p->write_file )
		return ME_FETCH_METHOD;
	if ( m->p.read_net && p->read_net )
		return ME_FETCH_METHOD;
	if ( m->p.close_file && p->close_file )
		return ME_FETCH_METHOD;
	if ( m->p.close_net && p->close_net )
		return ME_FETCH_METHOD;
	if ( m->p.new_token && p->new_token )
		return ME_NEW_TOKEN;
	if ( m->p.free_token && p->free_token )
		return ME_FREE_TOKEN;
	if ( m->p.trigger && p->trigger )
		return ME_TRIGGER;
	if ( m->p.flags && p->flags )
		return ME_FLAGS;
	if ( m->p.total_levels && p->total_levels )
		return ME_TOTAL_LEVELS;
	if ( m->p.modify_time && p->modify_time )
		return ME_MODIFY_TIME;
	if ( p->channel_nos ) {
		m->p.channel_nos = p->channel_nos;
		m->channel_info = d_alloc(sizeof(MATRIX_CHANNEL_INFO)*p->channel_nos);
		memset(m->channel_info,0,sizeof(MATRIX_CHANNEL_INFO)*p->channel_nos);
	}
	if ( p->dim ) {
		m->p.dim = p->dim;
		m->dim_divide = d_alloc(p->dim);
		memset(m->dim_divide,0,p->dim);
		m->block_size = d_alloc(p->dim);
		memset(m->block_size,0,p->dim);
		m->pixel_size = d_alloc(p->dim*sizeof(INTEGER64));
		memset(m->pixel_size,0,p->dim*sizeof(INTEGER64));
	}
	for ( i = 0 ; i < MI_MAX ;i ++ ) {
		if ( p->pri_area[i] )
			m->p.pri_area[i] = p->pri_area[i];
	}
	if ( p->open_method )
		m->p.open_method = p->open_method;
	if ( p->read_file )
		m->p.read_file = p->read_file;
	if ( p->write_file )
		m->p.write_file = p->write_file;
	if ( p->read_net )
		m->p.read_net = p->read_net;
	if ( p->close_file )
		m->p.close_file = p->close_file;
	if ( p->close_net )
		m->p.close_net = p->close_net;
	if ( p->new_token )
		m->p.new_token = p->new_token;
	if ( p->free_token )
		m->p.free_token = p->free_token;
	if ( p->trigger )
		m->p.trigger = p->trigger;
	if ( p->flags )
		m->p.flags = p->flags;
	if ( p->total_levels ) {
		m->p.total_levels = p->total_levels;
		_cal_matrix_total_levels(m);
	}
	if ( p->modify_time )
		m->p.modify_time = p->modify_time;
	return 0;
}

void
_cal_nlist_dim_bit_field(MATRIX * m)
{
int i;
int acc;
int len;
	acc = 0;
	for ( i = 0 ; i < m->p.dim ; i ++ ) {
		if ( m->dim_divide[i] == 0 )
			return;
		acc += m->dim_divide[i];
		if ( acc > 13 ) {
			m->dim_bit_field = 0;
			return;
		}
	}
	if ( acc < 3 )
		len = 1;
	else {
		len = 1<<(acc-3);
	}
	m->dim_bit_field = len;
}

int
_set_matrix_dim_divide(MATRIX * m,int dim,int dim_divide)
{
	if ( m->p.dim == 0 )
		return ME_DIM;
	if ( dim < 0 || dim >= m->p.dim )
		return ME_INDEX_OVER;
	m->dim_divide[dim] = dim_divide;
	_cal_matrix_total_levels(m);
	_cal_nlist_dim_bit_field(m);
	return 0;
}

int
_set_matrix_block_size(MATRIX * m,int dim,int block_size)
{
	if ( m->p.dim == 0 )
		return ME_DIM;
	if ( dim < 0 || dim >= m->p.dim )
		return ME_INDEX_OVER;
	m->block_size[dim] = block_size;
	return 0;
}

int
_set_matrix_pixel_size(MATRIX * m,int dim,INTEGER64 pixel_size)
{
	if ( m->p.dim == 0 )
		return ME_DIM;
	if ( dim < 0 || dim >= m->p.dim )
		return ME_INDEX_OVER;
	m->pixel_size[dim] = pixel_size;
	_cal_matrix_total_levels(m);
	return 0;
}

int
_set_matrix_cal(MATRIX * m,int id,XL_SEXP * cal)
{
MATRIX_SEXP * d;
	if ( id < 0 || id >= MI_MAX )
		return ME_INDEX_OVER;
	if ( get_type(cal) == XLT_ERROR ) {
		print_sexp(s_stdout,cal,0);
		er_panic("_set_matrix_cal");
	}
	if ( m->cal[id] ) {
		m->cal[id]->data = cal;
	}
	else {
		m->cal[id] = d = d_alloc(sizeof(*d));
		d->data = cal;
		d->del = 0;
		d->gc_func = gc_gb_sexp;
		_insert_matrix_sexp(d);
	}
	return 0;
}

int 
_set_matrix_cal_equ(MATRIX * m,int id,int id2)
{
MATRIX_SEXP * d;
XL_SEXP * target;
	if ( id < 0 || id >= MI_MAX )
		return ME_INDEX_OVER;
	if ( id2 < 0 || id2 >= MI_MAX )
		return ME_INDEX_OVER;
	if ( m->cal[id2] == 0 )
		target = 0;
	else	target = m->cal[id2]->data;

	if ( m->cal[id] ) {
		m->cal[id]->data = target;
	}
	else {
		m->cal[id] = d = d_alloc(sizeof(*d));
		d->data = target;
		d->del = 0;
		d->gc_func = gc_gb_sexp;
		_insert_matrix_sexp(d);
	}
	return 0;
}

int 
set_matrix_cal_equ(MATRIX * m,int id,int id2)
{
int ret;
	lock_task(matrix_lock);
	ret = _set_matrix_cal_equ(m,id,id2);
	unlock_task(matrix_lock,"set_matrix_cal_equ");
	return ret;
}


void
_set_matrix_mode(MATRIX * m,int mode)
{
MATRIX_TOKEN * t;
	m->mode = mode;
	switch ( m->mode ) {
	case MM_CREATE:
		return;
	case MM_STANBY:
		if ( (m->flags & MXF_CREATE_ACCESS) &&
				m->p.trigger )
			(*m->p.trigger)(TRT_MATRIX_STANBY,m);
		break;
	case MM_ERR:
	case MM_CLOSE:
		break;
	default:
		er_panic("_set_matrix_mode");
	}
	for ( ; m->wait_token ; ) {
		t = m->wait_token;
		m->wait_token = t->next;
		t->wait_matrix = 0;
		_insert_matrix_access(t,matrix_exec_cal);
	}
	wakeup_task((int)m);
}

void
set_matrix_mode(MATRIX * m,int mode)
{
	lock_task(matrix_lock);
	_set_matrix_mode(m,mode);
	unlock_task(matrix_lock,"set_matrix_mode");
}


void
_wait_matrix_mode(MATRIX * m)
{
	for ( ; m->mode == MM_CREATE ; ) {
		sleep_task((int)m,matrix_lock);
		lock_task(matrix_lock);
	}
}

void
wait_matrix_mode(MATRIX * m)
{
	lock_task(matrix_lock);
	_wait_matrix_mode(m);
	unlock_task(matrix_lock,"set_matrix_mode");
}

int
set_matrix_channel_info(MATRIX * m,int ch,MATRIX_CHANNEL_INFO * inf)
{
int ret;
	lock_task(matrix_lock);
	ret = _set_matrix_channel_info(m,ch,inf);
	unlock_task(matrix_lock,"set_matrix");
	return ret;
}


int 
set_matrix_param(MATRIX * m,MATRIX_PARAM * p)
{
int ret;
	lock_task(matrix_lock);
	ret = _set_matrix_param(m,p);
	unlock_task(matrix_lock,"set_matrix");
	return ret;
}


int 
set_matrix_dim_divide(MATRIX * m,int dim,int dim_divide)
{
int ret;
	lock_task(matrix_lock);
	ret = _set_matrix_dim_divide(m,dim,dim_divide);
	unlock_task(matrix_lock,"set_matrix");
	return ret;
}


int 
set_matrix_block_size(MATRIX * m,int dim,int block_size)
{
int ret;
	lock_task(matrix_lock);
	ret = _set_matrix_block_size(m,dim,block_size);
	unlock_task(matrix_lock,"set_matrix");
	return ret;
}


int 
set_matrix_pixel_size(MATRIX * m,int dim,INTEGER64 pixel_size)
{
int ret;
	lock_task(matrix_lock);
	ret = _set_matrix_pixel_size(m,dim,pixel_size);
	unlock_task(matrix_lock,"set_matrix");
	return ret;
}

int 
set_matrix_cal(MATRIX * m,int id,XL_SEXP * cal)
{
int ret;
	lock_task(matrix_lock);
	ret = _set_matrix_cal(m,id,cal);
	unlock_task(matrix_lock,"set_matrix");
	return ret;
}

int 
_cmp_dim_code(MATRIX * m,INTEGER64 * dim_code1,INTEGER64 * dim_code2)
{
int dim;
int i;
INTEGER64 level_1,level_2;
INTEGER64 mask;
	if ( dim_code1 == 0 && dim_code2 == 0 )
		return 0;
	if ( dim_code1 == 0 && dim_code2 )
		return -1;
	if ( dim_code1 && dim_code2 == 0 )
		return 1;
	level_1 = dim_code1[0];
	level_2 = dim_code2[0];
	dim = m->p.dim;

	if ( level_1 < level_2 )
		return -1;
	if ( level_1 > level_2 )
		return 1;
	for ( i = 1 ; i <= dim ; i ++ ) {
		mask = - (1 << (level_1*m->dim_divide[i-1] + m->block_size[i-1]));
		if ( (dim_code1[i] & mask) < (dim_code2[i] & mask)  )
			return -1;
		if ( (dim_code1[i] & mask) > (dim_code2[i] & mask)  )
			return 1;
	}
	return 0;
}

int
cmp_dim_code(MATRIX * m,INTEGER64 * dc1,INTEGER64 * dc2)
{
	return _cmp_dim_code(m,dc1,dc2);
}

INTEGER64 *
_copy_dim_code(MATRIX * m,INTEGER64 * dim_code)
{
INTEGER64 * ret;
int dim;
	if ( dim_code == 0 )
		return 0;
	dim = m->p.dim;
	ret = d_alloc(sizeof(INTEGER64)*(dim+1));
	memcpy(ret,dim_code,sizeof(INTEGER64)*(dim+1));
	return ret;
}

INTEGER64 *
copy_dim_code(MATRIX * m,INTEGER64 * dim_code)
{
	return _copy_dim_code(m,dim_code);
}


void
token_check(MATRIX_TOKEN * t)
{
	if ( t->process_node->process_token != t )
		er_panic("_insert_matrix_acess");
}


void
_xx_insert_matrix_access(MATRIX_TOKEN * t,void (*func)(),char * __f,int __l)
{
int pri;
MATRIX_NODE * n;
int b;
MATRIX * m;

	t->h.key = nl_copy_str(std_cm,"_get_matrix_access");
	t->func = func;
	n = t->process_node;
	m = n->matrix;
	if ( t->access_target_id < 0 ) {
		if ( t->access_list == 0 )
			b = PR_MAX;
		else	b = m->p.pri_area[t->access_list->id];
	}
	else	b = m->p.pri_area[t->access_target_id];
	m = n->matrix;
	switch ( b & 0xffff ) {
	case PR_UP:
		pri = ((b >> 16) & 0xffff) + n->dim_code[0];
		break;
	case PR_DOWN:
		pri = ((b >> 16) & 0xffff) - n->dim_code[0]
			+ m->total_levels * 2;
		break;
	case PR_STRT:
		pri = ((b >> 16) & 0xffff);
		break;
	case PR_MAX:
		pri = 0x7fff;
		break;
	default:
		er_panic("_get_matrix_access");
	}
	t->h.pri = pri;

#ifdef SCRIPT_TRIGGER
ss_printf("INSM %x:%i\n",t,t->access_target_id);
token_check(t);
#endif

	xx_check_point(t,__f,__l);
	xx_insert_queue(&matrix_que,t,0,__f,__l);
}

void
xx_insert_matrix_access(MATRIX_TOKEN * t,void (*func)(),char * __f,int __l)
{
	lock_task(matrix_lock);
	_xx_insert_matrix_access(t,func,__f,__l);
	unlock_task(matrix_lock,"insert_matrix_access");
}


void
_xx_insert_access_list(MATRIX_TOKEN * t,int acc,char * __f,int __l)
{
MATRIX_ACCESS_LIST * al,** alp;

#ifdef SCRIPT_TRIGGER
ss_printf("IALT %x:* = %i (%s %i)\n",t,acc,__f,__l);
#endif

	for ( alp = &t->access_list ; *alp ; alp = &(*alp)->next ) {
		if ( (*alp)->id == acc )
			return;
	}
	al = d_alloc(sizeof(*al));
	al->id = acc;
	al->next = 0;
	*alp = al;
#ifdef SCRIPT_TRIGGER
see_access_list(t->access_list);
#endif


}

int
_delete_access_list(MATRIX_TOKEN * t)
{
MATRIX_ACCESS_LIST * ret;
int id;
	ret = t->access_list;
	if ( ret == 0 )
		return -1;
	t->access_list = ret->next;
	id = ret->id;
	d_f_ree(ret);
	return id;
}

void
_set_access_jump(MATRIX_TOKEN * t,
	int err_jump,int normal_jump,int err_jump_status,int normal_jump_status)
{
	if ( err_jump >= 0 )
		t->err_jump = err_jump;
	if ( normal_jump >= 0 )
		t->normal_jump = normal_jump;
	if ( err_jump_status >= 0 )
		t->err_jump_status = err_jump_status;
	if ( normal_jump_status >= 0 )
		t->normal_jump_status = normal_jump_status;
}

void
set_access_jump(MATRIX_TOKEN * t,
	int err_jump,int normal_jump,int err_jump_status,int normal_jump_status)
{
	lock_task(matrix_lock);
	_set_access_jump(t,err_jump,normal_jump,err_jump_status,normal_jump_status);
	unlock_task(matrix_lock,"set_access_jump");
}

void
see_access_list(MATRIX_ACCESS_LIST * a)
{
	ss_printf("alist(");
	for ( ; a ; a = a->next ) {
		ss_printf("%i ",a->id);
	}
	ss_printf(")\n");
}


void
matrix_exec_cal(MATRIX_TOKEN * t)
{
XL_SEXP * ret;
XLISP_ENV * e;
XL_SEXP * c;
int _code;
int id;
MATRIX_NODE * n;
MATRIX_TOKEN * t2;
MATRIX * m;

#ifdef SCRIPT_DEBUG
int i;
#endif

check_point(t);

	e = t->env->data;
	m = t->process_node->matrix;

#ifdef SCRIPT_DEBUG

ss_printf("ENTR %x:%i(%i) = NODE=%x [%x]+%i+(%i %i %i %i -- atid=%i cal=%x)\n",t,t->access_target_id,
(int)(t->process_node->matrix->total_levels - t->process_node->dim_code[0]),
t->process_node,
t->process_node->process_token,
t->process_node->status,
t->normal_jump,
t->normal_jump_status,
t->err_jump,
t->err_jump_status,
t->access_target_id,
t->cal_target);
ss_printf("(");
for ( i = 0 ; i <= t->process_node->matrix->p.dim ; i ++ )
ss_printf("%i ",(int)t->process_node->dim_code[i]);
ss_printf(")\n");
see_access_list(t->access_list);
#endif

	lock_task(matrix_lock);
	m = t->process_node->matrix;
	switch ( m->mode ) {
	case MM_CREATE:
		t->next = m->wait_token;
		m->wait_token = t;
		goto end1;
	case MM_STANBY:
	case MM_CLOSE:
		break;
	case MM_ERR:
		goto end;
	default:
		er_panic("cal");
	}
	if ( t->access_target_id < 0 ) {
		t->cal_target = 0;
		for ( ; get_type(t->cal_target) == XLT_NULL ; ) {
			t->err_jump = t->normal_jump = -1;
			t->err_jump_status = t->normal_jump_status = -1;
			id = _delete_access_list(t);
			if ( id < 0 ) {
				goto end;
			}
			id = MI_GET(id,t->process_node);
			t->access_target_id = id;
			if ( t->process_node->matrix->cal[id] )
				t->cal_target = 
					t->process_node
						->matrix->cal[id]->data;
			else 	t->cal_target = 0;
		}
	}
	else {
		if ( get_type(t->cal_target) == XLT_NULL )
			goto success;
	}
	unlock_task(matrix_lock,"matrix_exec_cal");
	for( ; get_type(t->cal_target) == XLT_PAIR ; ) {
		lock_task(matrix_lock);
/*
		if ( t->process_node->matrix->mode == MM_CLOSE )
			goto end;
*/
		unlock_task(matrix_lock,"matrix_exec_cal");
		gc_push(0,0,"matrix_exec_cal");

#ifdef SCRIPT_DEBUG
ss_printf("EXEC %x:%i = +%i+",t,t->access_target_id,t->process_node->status);
print_sexp(s_stdout,car(t->cal_target),0);
ss_printf("\n");
see_access_list(t->access_list);
#endif

		ret = eval(e,car(t->cal_target));

		if ( get_type(ret) != XLT_ERROR ) {

#ifdef SCRIPT_DEBUG
ss_printf("EXEC %x:%i = OK+%i+\n",t,t->access_target_id,t->process_node->status);
#endif
			t->cal_target = cdr(t->cal_target);
			gc_pop(0,0);
			continue;
		}

#ifdef SCRIPT_ERR
#ifndef SCRIPT_DEBUG
ss_printf("EXEC %x:%i = +%i+",t,t->access_target_id,t->process_node->status);
print_sexp(s_stdout,car(t->cal_target),0);
ss_printf("\n");
#endif
ss_printf("TAR  %x:%i = %s\n",t,t->access_target_id,
		pt_dc(t->process_node->matrix,
			t->process_node->dim_code,
			PTDC_NODE_ID));
ss_printf("ERR  %x:%i = ",t,t->access_target_id);
print_sexp(s_stdout,ret,0);
ss_printf("\n");
#endif
		switch ( ret->err.code ) {
		case XLE_SYSTEM_EXIT:
			gc_pop(0,0);
			return;
		case XLE_SYSTEM_APPLICATION:
			c = get_el(ret->err.data,1);
			if ( get_type(c) != XLT_INTEGER )
				er_panic("matrix_exec_Cal");
			_code = c->integer.data;
			switch ( _code ) {
			case AME_TRAP:
				break;
			case AME_INTERRUPT:
				t->cal_target = cdr(t->cal_target);
			}
			gc_pop(0,0);
			return;
		}
//		log_print_sexp(LOG_ERROR,LOG_LAYER_XL,0,"matrix_exec_cal",ret,0);
		gc_pop(0,0);
		lock_task(matrix_lock);
		if ( t->err_jump_status >= 0 ) {
#ifdef SCRIPT_DEBUG
ss_printf("ERST %x:%i = %i ns=%i\n",t,t->access_target_id,
t->err_jump_status,
t->process_node->status);
see_access_list(t->access_list);
#endif
			t->process_node->status = t->err_jump_status;
			n = t->process_node;
			for ( ; n->wait_token ; ) {
				t2 = n->wait_token;
				n->wait_token = t2->next;
				t2->wait_node = 0;
				_insert_matrix_access(t2,matrix_exec_cal);
			}
			wakeup_task((int)n);
		}
		if ( t->err_jump >= 0 ) {

#ifdef SCRIPT_DEBUG
ss_printf("ERJP %x:%i = %i ns=%i %i\n",t,t->access_target_id,t->err_jump,
t->process_node->status,t->err_jump_status);
see_access_list(t->access_list);
#endif
			t->cal_target = 0;
			t->access_target_id = -1;
			_insert_access_list(t,t->err_jump);
			_insert_matrix_access(t,matrix_exec_cal);
			goto end1;
		}
		if ( t->access_list ) {
			t->access_target_id = -1;
			_insert_matrix_access(t,matrix_exec_cal);
			goto end1;
		}
		goto end;
	}
	lock_task(matrix_lock);
success:
	if ( t->normal_jump >= 0 ) {

#ifdef SCRIPT_DEBUG
ss_printf("NOJP %x:%i = %i +%i+\n",t,t->access_target_id,t->normal_jump,t->process_node->status);
see_access_list(t->access_list);
#endif
		t->access_target_id = -1;
		_insert_access_list(t,t->normal_jump);
		_insert_matrix_access(t,matrix_exec_cal);
		goto end1;
	}

#ifdef SCRIPT_DEBUG
ss_printf("NOOK %x:%i = %i +%i+\n",t,t->access_target_id,t->normal_jump_status,t->process_node->status);
see_access_list(t->access_list);
#endif
	if ( t->normal_jump_status >= 0 ) {
		t->process_node->status = t->normal_jump_status;
		if ( t->process_node->status == MS_OK && t->process_node->matrix->p.trigger )
			(*t->process_node->matrix->p.trigger)(TRT_TOKEN,t);
		n = t->process_node;
		for ( ; n->wait_token ; ) {
			t2 = n->wait_token;
			n->wait_token = t2->next;
			t2->wait_node = 0;
			_insert_matrix_access(t2,matrix_exec_cal);
		}
		wakeup_task((int)t->process_node);
	}
	t->cal_target = 0;
	if ( t->access_list ) {
		t->access_target_id = -1;
		_insert_matrix_access(t,matrix_exec_cal);
		goto end1;
	}
end:


#ifdef SCRIPT_DEBUG
ss_printf("EXIT %x:%i =\n",t,t->access_target_id);
#endif

	for ( ; t->locked_node_list ; ) {
		_unlock_node(t->locked_node_list->node,t);
	}
	t->env->del = 1;
	if ( t->process_node->matrix->p.free_token )
		(*t->process_node->matrix->p.free_token)(t,0);
	n = t->process_node;
	n->process_token = 0;
	wakeup_task((int)n);
	d_f_ree(t);
	m->token_cnt --;
	if ( m->token_cnt < 0 )
		er_panic("token_cnt");
	for ( ; n->wait_token ; ) {
		t = n->wait_token;
		n->wait_token = t->next;
		t->wait_node = 0;
		_insert_matrix_access(t,matrix_exec_cal);
	}
	wakeup_task((int)n);
end1:
	unlock_task(matrix_lock,"matrix_exec_cal");
	if ( m->token_cnt == 0 && m->p.trigger )
		(*m->p.trigger)(TRT_FINISH,0);
}

void
_matrix_token_error(MATRIX_TOKEN * t)
{
	if ( t->err_jump_status >= 0 ) {
		t->process_node->status = t->err_jump_status;
		wakeup_task((int)t->process_node);
	}
	if ( t->err_jump >= 0 ) {
		t->cal_target = 0;
		t->access_target_id = -1;
		_insert_access_list(t,t->err_jump);
		_insert_matrix_access(t,matrix_exec_cal);
	}
	else {
		t->cal_target = 0;
		t->access_target_id = -1;
		_insert_matrix_access(t,matrix_exec_cal);
	}
}

void
matrix_token_error(MATRIX_TOKEN * t)
{
	lock_task(matrix_lock);
	_matrix_token_error(t);
	unlock_task(matrix_lock,"matrix_token_error");
}


void
_insert_node_wait_token(MATRIX_NODE * n,MATRIX_TOKEN * t)
{
	if ( t == 0 )
		return;
	if ( t->wait_node )
		er_panic("_insert_node_wait_token");
check_point(t);
	t->wait_node = n;
	t->next = n->wait_token;
	n->wait_token = t;
#ifdef SCRIPT_TRIGGER
ss_printf("NWAIT %x:%i = node=%x(%x)\n",t,t->access_target_id,n,n->process_token);
#endif

}

void
_lock_node(MATRIX_NODE * n,MATRIX_TOKEN * t)
{
MATRIX_LIST * lst;
	n->locked ++;
	if ( t == 0 )
		return;
	lst = d_alloc(sizeof(*lst));
	lst->node = n;
	lst->next = t->locked_node_list;
	t->locked_node_list = lst;
}

void
_unlock_node(MATRIX_NODE * n,MATRIX_TOKEN * t)
{
MATRIX_LIST ** lp,* lst;
	if ( n->locked > 0 )
		n->locked --;
	if ( t ) {
		for ( lp = &t->locked_node_list ; *lp ; lp = &(*lp)->next )
			if ( (*lp)->node == n ) {
				lst = *lp;
				*lp = lst->next;
				d_f_ree(lst);
				break;
			}
	}
	wakeup_task((int)n);
}

void
unlock_node(MATRIX_NODE * n,MATRIX_TOKEN * t)
{
	lock_task(matrix_lock);
	_unlock_node(n,t);
	unlock_task(matrix_lock,"unlock_node");
}

MATRIX_TOKEN *
_new_matrix_token(MATRIX_NODE * n)
{
MATRIX_TOKEN * t;
MATRIX*m;
XLISP_ENV * e;
MATRIX_SEXP * d;

	gc_push(0,0,"_new_matrix_token");
	if ( n->process_token )
		er_panic("_new_matrix_token");
	t = d_alloc(sizeof(*t));
	memset(t,0,sizeof(*t));
	n->matrix->token_cnt ++;
	t->process_node = n;
	m = n->matrix;
	t->access_target_id = -1;
	t->err_jump = t->normal_jump = -1;
	e = new_env((XLISP_ENV*)n->matrix->mx_env->data);
	e->e.work = t;
	t->env = d = d_alloc(sizeof(*d));
	memset(d,0,sizeof(*d));
	d->data = e;
	d->gc_func = gc_gblisp_env;
	_insert_matrix_sexp(d);
	n->process_token = t;
	if ( n->matrix->p.new_token )
		(*n->matrix->p.new_token)(t,MPT_NEW_TOKEN_NODE);
	gc_pop(0,0);
	return t;
}

void
_get_matrix_access(MATRIX_NODE * n)
{
MATRIX_TOKEN * t;
	switch ( n->status ) {
	case MS_NOBIND:
		if ( n->process_token ) {
			t = n->process_token;
			n->status = MS_PROCESS;
			wakeup_task((int)n);
#ifdef SCRIPT_TRIGGER
ss_printf("GETM1 %x:%i = %i\n",t,-1,MI_FETCH_1_TP);
#endif
			_insert_access_list(t,MI_GET(MI_FETCH_1_TP,n));
		}
		else {
			t = _new_matrix_token(n);

#ifdef SCRIPT_TRIGGER
ss_printf("GETM2 %x:%i = %i\n",t,-1,MI_FETCH_1_TP);
#endif
			n->status = MS_PROCESS;
			wakeup_task((int)n);
			_insert_access_list(t,MI_GET(MI_FETCH_1_TP,n));
			_insert_matrix_access(t,matrix_exec_cal);
		}
		break;
	case MS_PROCESS:
	case MS_OK:
	case MS_PROCESS_ERR_1:
	case MS_EDIT_ERR_1:
	case MS_EDIT_ERR_2:
		break;
	}
}


void
_matrix_trigger_access(MATRIX_NODE * n,int _access,int clear_err)
{
MATRIX_TOKEN * t;
int n_f;

	n_f = 0;
	t = n->process_token;
	if ( t == 0 ) {
		n_f = 1;
		t = _new_matrix_token(n);
	}
	switch ( n->status ) {
	case MS_NOBIND:
	case MS_PROCESS:
	case MS_OK:
		break;
	case MS_LOADING_ERR_1:
		n->status = MS_PROCESS;
		wakeup_task((int)n);
		if ( _access != MI_FETCH_1_TP )
{
#ifdef SCRIPT_TRIGGER
ss_printf("MTR1 %x:%i = %i\n",t,-1,MI_FETCH_1_TP);
#endif
			_insert_access_list(t,MI_GET(MI_FETCH_1_TP,n));
}
		break;
	case MS_PROCESS_ERR_1:
		n->status = MS_PROCESS;
		wakeup_task((int)n);
		if ( _access != MI_FETCH_1_TP )
{
#ifdef SCRIPT_TRIGGER
ss_printf("MTR2 %x:%i = %i\n",t,-1,MI_FETCH_1_TP);
#endif
			_insert_access_list(t,MI_GET(MI_VISU_1_TP,n));
}
		break;
	case MS_EDIT_ERR_1:
		if ( clear_err ) {
			n->status = MS_OK;
			wakeup_task((int)n);
		}
		if ( _access != MI_FETCH_1_TP )
{
#ifdef SCRIPT_TRIGGER
ss_printf("MTR3 %x:%i = %i\n",t,-1,MI_EDIT_1_TP);
#endif
			_insert_access_list(t,MI_GET(MI_EDIT_1_TP,n));
}
		break;
	case MS_EDIT_ERR_2:
		if ( clear_err ) {
			n->status = MS_OK;
			wakeup_task((int)n);
		}
		if ( _access != MI_FETCH_1_TP )
{
#ifdef SCRIPT_TRIGGER
ss_printf("MTR3 %x:%i = %i\n",t,-1,MI_EDIT_2_TP);
#endif
			_insert_access_list(t,MI_GET(MI_EDIT_2_TP,n));
}
		break;
	default:
		er_panic("_matrix_trigger_access");
	}
#ifdef SCRIPT_TRIGGER
ss_printf("MTRG %x:%i = %i(n=%i)\n",t,-1,_access,n->status);
#endif
	_insert_access_list(t,MI_GET(_access,n));
	if ( n_f )
		_insert_matrix_access(t,matrix_exec_cal);
}

void
matrix_trigger_access(MATRIX_NODE * n,int access,int clear_err)
{
	lock_task(matrix_lock);
	_matrix_trigger_access(n,access,clear_err);
	unlock_task(matrix_lock,"trigger_access");
}

void
_set_matrix_env(MATRIX * m,char * name,char * data)
{
	set_env((XLISP_ENV*)m->mx_env->data,l_string(std_cm,name),
		n_get_string(data));
}

void
set_matrix_env(MATRIX * m,char * name,char * data)
{
	lock_task(matrix_lock);
	_set_matrix_env(m,name,data);
	unlock_task(matrix_lock,"set_matrix_env");
}


INLINE unsigned int
_get_node_hash(MATRIX * m,INTEGER64 * dim_code)
{
U_INTEGER64 key;
int i;
int dim;
INTEGER64 mask;
INTEGER64 level;
	dim = m->p.dim;
	level = dim_code[0];
	key = dim_code[0];
	for ( i = 1 ; i <= dim ; i ++ ) {
		mask = - (1 << (level*m->dim_divide[i-1] + m->block_size[i-1]));
		key += (dim_code[i] & mask);
	}
	return key % NHASH_SIZE;
}


int
_free_matrix_node(MATRIX_NODE * n)
{
MATRIX_NODE ** np;
unsigned int key;
MATRIX * m;
int i;
MATRIX_DATA_TYPE * md;
	key = _get_node_hash(n->matrix,n->dim_code);
	m = n->matrix;
	for ( np = &m->node_hash[key] ; 
			*np && *np != n ; np = &(*np)->nh_next );
	if ( *np == 0 )
		er_panic("_free_matrix_node");
	if ( n->locked || n->ch_lock || n->save_lock )
		return -1;
	if ( n->dirty_file_time )
		return -1;
	if ( n->wait_token || n->process_token )
		return -2;
/*
	if ( n->status <= MS_PROCESS )
		return -3;
*/
	_delete_node_ring(n);
	*np = n->nh_next;
	d_f_ree(n->dim_code);
	if ( n->channel ) {
		for ( i = 0 ; i < m->p.channel_nos ; i ++ ) {
			md = m->channel_info[i].data_type;
			if ( md == 0 )
				continue;
			if ( n->channel[i].data )
				(*md->free_data)(md,n->channel[i].data);
		}
	}
	if ( n->nlist_dim_bit_field )
		d_f_ree(n->nlist_dim_bit_field);
	if ( n->nlist_dim_addr )
		d_f_ree(n->nlist_dim_addr);
	d_f_ree(n);
	return 0;
}


int
_sync_matrix_node(MATRIX_NODE * n)
{
	if ( n->locked || n->ch_lock || n->save_lock || 
			n->dirty_file_time )
		return -1;
	if ( n->wait_token || n->process_token )
		return -2;
	if ( n->status <= MS_PROCESS )
		return -3;
	return 0;
}



MATRIX_NODE *
_get_matrix_node(int * errp,MATRIX * m,INTEGER64 * dim_code,int access,INTEGER64 lev)
{
MATRIX_NODE * n;
unsigned int key;

	switch ( m->mode ) {
	case MM_CREATE:
		m->flags |= MXF_CREATE_ACCESS;
		if ( errp )
			*errp = ME_MATRIX_ERR;
		return 0;
	case MM_STANBY:
		break;
	case MM_ERR:
		if ( errp )
			*errp = ME_MATRIX_ERR;
		return 0;
	case MM_CLOSE:
		if ( errp )
			*errp = ME_MATRIX_ERR;
		return 0;
	default:
		er_panic("_get_matrix_node");
	}
	m->access_cnt |= 1;
	_delete_matrix_ring(m);
	_insert_matrix_ring(m);
	key = _get_node_hash(m,dim_code);
	for ( n = m->node_hash[key] ; n ; n = n->nh_next )
		if ( _cmp_dim_code(m,n->dim_code,dim_code) == 0 )
			break;
	if ( n ) {


		_delete_node_ring(n);
		_insert_node_ring(n);
		n->req_level = lev;
		switch ( n->status ) {
		case MS_NOBIND:
		case MS_PROCESS:
			if ( errp )
				*errp = ME_PROC_NODE;
			break;
		case MS_OK:
			break;
		case MS_LOADING_ERR_1:
			if ( access < 0 || access == GN_ERROR_NORETRY ) {
				if ( errp )
					*errp = ME_NO_NODE;
				n = 0;
				break;
			}
			n->status = MS_NOBIND;
			wakeup_task((int)n);
			_get_matrix_access(n);
			if ( errp )
				*errp = ME_NO_NODE;
		case MS_PROCESS_ERR_1:
			if ( access < 0 || access == GN_ERROR_NORETRY ) {
				if ( errp )
					*errp = ME_NO_NODE;
				n = 0;
				break;
			}
			n->status = MS_PROCESS;
			wakeup_task((int)n);
			_matrix_trigger_access(n,MI_VISU_1_TP,0);
			if ( errp )
				*errp = ME_NO_NODE;
			break;
		case MS_EDIT_ERR_1:
		case MS_EDIT_ERR_2:
			if ( access < 0 ) {
				if ( errp )
					*errp = ME_ERR_NODE;
				n = 0;
				break;
			}
			break;
		default:
			er_panic("_get_matrix_node");
		}
		return n;
	}
	if ( access < 0 ) {
		if ( errp )
			*errp = ME_NO_NODE;
		return 0;
	}
	n = d_alloc(sizeof(*n));
	memset(n,0,sizeof(*n));
	n->matrix = m;
	n->dim_code = _copy_dim_code(m,dim_code);
	n->status = MS_NOBIND;
	wakeup_task((int)n);
	n->nh_next = m->node_hash[key];
	n->channel = d_alloc(sizeof(MATRIX_CHANNEL)*m->p.channel_nos);
	memset(n->channel,0,sizeof(MATRIX_CHANNEL)*m->p.channel_nos);
	if ( m->dim_bit_field ) {
		n->nlist_dim_bit_field = d_alloc(m->dim_bit_field);
		memset(n->nlist_dim_bit_field,
				0,
				m->dim_bit_field);
		n->nlist_dim_bit_field_len = m->dim_bit_field;
	}
	m->node_hash[key] = n;
	_insert_node_ring(n);
	_get_matrix_access(n);
	if ( errp )
		*errp = ME_PROC_NODE;
	return n;
}

MATRIX_NODE *
get_matrix_node(int * errp,MATRIX * m,INTEGER64 * dim_code,
		int access,MATRIX_TOKEN * t)
{
MATRIX_NODE * n;
int err;
	lock_task(matrix_lock);
	err = 0;
	n = _get_matrix_node(&err,m,dim_code,access,dim_code[0]);
	if ( errp && err )
		*errp = err;
	if ( err ) {
		if ( err == ME_MATRIX_ERR )
			n = 0;
		else if ( err == ME_ERR_NODE )
			n = 0;
		else if ( access < 0 )
			n = 0;
		else if ( n )
			_insert_node_wait_token(n,t);
	}
	else	_lock_node(n,t);
	unlock_task(matrix_lock,"get_matrix_node");
	return n;
}

MATRIX_NODE *
get_matrix_node_wait(int * errp,MATRIX * m,INTEGER64 * dim_code,
			int access)
{
MATRIX_NODE * n;
int err;

retry:
	lock_task(matrix_lock);
	err = 0;
	n = _get_matrix_node(&err,m,dim_code,access,dim_code[0]);
	if ( n && n->status <= MS_PROCESS ) {

#ifdef SCRIPT_DEBUG
ss_printf("GMNW %p\n",n);
#endif
		sleep_task((int)n,matrix_lock);
		goto retry;
	}
	if ( errp && err )
		*errp = err;
	unlock_task(matrix_lock,"get_matrix_node");
	return n;
}


int
_get_dim_code_index(MATRIX_NODE * n,INTEGER64 * dim_code)
{
int ix;
MATRIX * m;
INTEGER64 dd;
int i;
	ix = 0;
	m = n->matrix;
	for ( i = 1 ; i <= m->p.dim ; i ++ ) {
		dd = dim_code[i] >> ((n->dim_code[0]-1)*m->dim_divide[i-1]
				+ m->block_size[i-1]);
		dd &= (1<<m->dim_divide[i-1])-1;
		ix = (ix << m->dim_divide[i-1]) | dd;
	}
	return ix;
}

INTEGER64 * 
get_dim_code_from_index(MATRIX * m,INTEGER64 * dc,int ix)
{
INTEGER64 * ret;
int i;
INTEGER64 d;
	ret = copy_dim_code(m,dc);
	ret[0] --;
	for ( i = m->p.dim - 1 ; i >= 0 ; i -- ) {
		ret[i+1] &= -(dc[0]*m->dim_divide[i] + m->block_size[i]);
		d = ix & ((1<<m->dim_divide[i])-1);
		ret[i+1] |= d << (ret[0]*m->dim_divide[i] + m->block_size[i]);
		ix >>= m->dim_divide[i];
	}
	return ret;
}


int
_check_dim_code(MATRIX_NODE * n,INTEGER64 * dim_code)
{
int pt_st,pt_end;
int mid;
int lev;
int ix;
	if ( n->dim_code[0] == 0 )
		return 0;
	if ( n->nlist_dim_bit_field ) {
		ix = _get_dim_code_index(n,dim_code);
		if ( (n->nlist_dim_bit_field[ix/8]) & (1<<(ix % 8)) )
			return 1;
		return 0;
	}
	else {
		pt_st = 0;
		pt_end = n->nlist_dim_addr_len;
		lev = dim_code[0];
		dim_code[0] = n->dim_code[0]-1;
		for ( ; pt_st + 1 < pt_end ; ) {
			mid = (pt_st + pt_end)/2;
			switch ( _cmp_dim_code(n->matrix,dim_code,
					n->nlist_dim_addr[mid])) {
			case -1:
				pt_end = mid;
				break;
			case 0:
				dim_code[0] = lev;
				return 1;
			case 1:
				pt_st = mid+1;
				break;
			}
		}
		if ( _cmp_dim_code(n->matrix,dim_code,
				n->nlist_dim_addr[pt_st]) == 0 ) {
			dim_code[0] = lev;
			return 1;
		}
		dim_code[0] = lev;
		return 0;
	}
}

void
_allset_dim_code_index(MATRIX_NODE * n,int dirty)
{
int ix;
int max_ix;
int i;
	if ( n->nlist_dim_bit_field == 0 )
		return;
	max_ix = 1;
	for ( i = 0 ; i < n->matrix->p.dim ; i ++ )
		max_ix *= (1<<n->matrix->dim_divide[i]);
	for ( ix = 0 ; ix < max_ix ; ix ++ )
		n->nlist_dim_bit_field[ix/8] |= (1<<(ix % 8));
	if ( dirty )
		_set_dirty_file(n);
}

void
allset_dim_code_index(MATRIX_NODE * n,int dirty)
{
	lock_task(matrix_lock);
	_allset_dim_code_index(n,dirty);
	unlock_task(matrix_lock,"insert_dim_code_index");
}


void
_insert_dim_code_index(MATRIX_NODE * n,INTEGER64 * dim_code,int dirty)
{
int ix;
INTEGER64 ** lst;
int pt_st,pt_end;
int mid;
int lev;
int i;
	if ( _check_dim_code(n,dim_code) )
		return;
	if ( n->nlist_dim_bit_field ) {
		ix = _get_dim_code_index(n,dim_code);
		n->nlist_dim_bit_field[ix/8] |= (1<<(ix % 8));
		if ( dirty )
			_set_dirty_file(n);
		return;
	}
	lst = n->nlist_dim_addr = d_re_alloc(n->nlist_dim_addr,
			sizeof(int*) * (n->nlist_dim_addr_len + 1));
	pt_st = 0;
	pt_end = n->nlist_dim_addr_len;
	lev = dim_code[0];
	dim_code[0] = n->dim_code[0]-1;
	for ( ; pt_st + 1 < pt_end ; ) {
		mid = (pt_st + pt_end)/2;
		switch ( _cmp_dim_code(n->matrix,dim_code,
				n->nlist_dim_addr[mid])) {
		case -1:
			pt_end = mid;
			break;
		case 0:
			er_panic("_insert_dim_code_index");
		case 1:
			pt_st = mid+1;
			break;
		}
	}
	for ( i = n->nlist_dim_addr_len ; i > pt_st ; i -- )
		n->nlist_dim_addr[i] = n->nlist_dim_addr[i-1];
	n->nlist_dim_addr[pt_st] = _copy_dim_code(n->matrix,dim_code);
	dim_code[0] = lev;

	if ( dirty )
		_set_dirty_file(n);
}

void
insert_dim_code_index(MATRIX_NODE * n,INTEGER64 * dim_code,int dirty)
{
	lock_task(matrix_lock);
	_insert_dim_code_index(n,dim_code,dirty);
	unlock_task(matrix_lock,"insert_dim_code_index");
}

MATRIX_NODE *
_get_matrix_tree(int * errp,MATRIX * m,INTEGER64 * dim_code,int access)
{
MATRIX_NODE * ret,* _ret,*prev;
int err;
INTEGER64 lev;
	lev = dim_code[0];
	dim_code[0] = m->total_levels-1;
	err = 0;
	ret = 0;
	prev = 0;
	_ret = _get_matrix_node(&err,m,dim_code,GN_READ_ONLY,lev);
	if ( err ) {
		if ( err == ME_MATRIX_ERR )
			goto end;
		if ( access == GN_READ_ONLY )
			goto end;
	}
	_ret = 0;
	for ( ; dim_code[0] >= lev ; dim_code[0] -- , prev = _ret ) {
		err = 0;
		_ret = _get_matrix_node(&err,m,dim_code,access,lev);
		if ( err == 0 )
			ret = _ret;
		else {
			if ( err == ME_MATRIX_ERR )
				break;
			switch ( access ) {
			case GN_READ_ONLY:
				break;
			case GN_NODE_CREATE:
				if ( prev == 0 )
					continue;
				if ( _check_dim_code(prev,dim_code) )
					continue;	
				break;
			case GN_LIST_CREATE:
				if ( prev == 0 )
					continue;
				_insert_dim_code_index(prev,dim_code,1);
				continue;
			}
			break;
		}
	}
end:
	if ( ret == 0 && errp )
		*errp = ME_NO_NODE;
	if ( ret )
		_lock_node(ret,0);
	dim_code[0] = lev;
	return ret;
}


void *
get_matrix_node_channel(int * errp,MATRIX_NODE ** np,
		MATRIX * m,INTEGER64 * dim_code,
		int ch,int type,int access,
		MATRIX_ALLOC_VECTOR_PARAM * vp)
{
MATRIX_NODE * n;
int err;
void * ret;

	if ( ch < 0 || ch >= m->p.channel_nos ) {
		if ( errp )
			*errp = ME_INDEX_OVER;
		return 0;
	}
retry:
	lock_task(matrix_lock);
	if ( type == GN_TREE ) {
		ret = 0;
		err = 0;
		n = _get_matrix_tree(&err,m,dim_code,access);
		if ( err == ME_MATRIX_ERR ) {
			if ( errp )
				*errp = err;
			goto end;
		}
		if ( n )
			goto ok;
		if ( errp )
			*errp = err;
		goto end;	
	}
	err = 0;
	n = _get_matrix_node(&err,m,dim_code,access,dim_code[0]);
	if ( err == ME_MATRIX_ERR ) {
		if ( errp )
			*errp = err;
		ret = 0;
		goto end;
	}

	if ( err == ME_PROC_NODE ) {
		sleep_task((int)n,matrix_lock);
		goto retry;
	}

	if ( err ) {
		if ( errp )
			*errp = err;
		ret = 0;
		goto end;
	}
ok:

	*np = n;
	_matrix_node_channel_lock(n);
	if ( n->channel[ch].data == 0 ) {
		if ( access < 0 ) {
			ret = 0;
			if ( errp )
				*errp = ME_DATA_ACCESS;
			_matrix_node_channel_unlock(n,0);
		}
		else if ( m->channel_info[ch].data_type->type 
					& MDT_VECTOR ) {
			if ( vp == 0 ) {
				ret = mxt_alloc_vector_by_dim_code(
					m,m->channel_info[ch].data_type,
					MD_DALLOC,
					dim_code,
					m->channel_info[ch].default_data);
			}
			else {
				ret = mxt_alloc_vector(
					m->channel_info[ch].data_type,
					MD_DALLOC,
					vp,0);
			}
			n->channel[ch].data = ret;
			_set_dirty_file(n);
		}
		else {
			ret = (*m->channel_info[ch].data_type
				->alloc_copy)
				(m->channel_info[ch].data_type,
				m->channel_info[ch].default_data,
				MD_DALLOC,0);
			n->channel[ch].data = ret;
			_set_dirty_file(n);
		}
	}
	else {
		ret = n->channel[ch].data;
	}
end:
	unlock_task(matrix_lock,"get_matrix_node_channel");
	return ret;
}

INTEGER64 *
get_dim_code_from_sexp(XL_SEXP * s)
{
INTEGER64 *ret;
int len;
int i;
XL_SEXP * ss;
	len = list_length(s);
	if ( len < 2 )
		return 0;
	ret = d_alloc(sizeof(INTEGER64)*len);
	for ( i = 0 ; i < len ; i ++ , s = cdr(s) ) {
		ss = car(s);
		if ( get_type(ss) != XLT_INTEGER )
			ret[i] = 0;
		ret[i] = ss->integer.data;
	}
	return ret;
}

int *
get_dim_code_from_sexp_int(XL_SEXP * s)
{
int *ret;
int len;
int i;
XL_SEXP * ss;
	len = list_length(s);
	if ( len < 2 )
		return 0;
	ret = d_alloc(sizeof(int)*len);
	for ( i = 0 ; i < len ; i ++ , s = cdr(s) ) {
		ss = car(s);
		if ( get_type(ss) != XLT_INTEGER )
			ret[i] = 0;
		ret[i] = ss->integer.data;
	}
	return ret;
}

XL_SEXP * get_sexp_from_dim_code(MATRIX * m,INTEGER64* dim_code)
{
XL_SEXP * ret;
int i;
INTEGER64 d;
	ret = cons(get_integer(dim_code[0],0),0);
	for ( i = 0 ; i < m->p.dim ; i ++ ) {
		d = dim_code[i+1] &
			(-(((INTEGER64)1)<<(dim_code[0]*
				m->dim_divide[i] + 
				m->block_size[i])));
		ret = cons(get_integer(d,0),ret);
	}
	return reverse(ret);
}

XL_SEXP * 
matrix_error(char * func,XL_SEXP * s,int code,XL_SEXP * info)
{
	if ( info == 0 )
		return get_error(
			s->h.file,
			s->h.line,
			XLE_SYSTEM_APPLICATION,
			l_string(std_cm,func),
			List(n_get_string("Application System error"),
				get_integer(code,0),
				-1));
	else	return get_error(
			s->h.file,
			s->h.line,
			XLE_SYSTEM_APPLICATION,
			l_string(std_cm,func),
			List(n_get_string("Application System error"),
				get_integer(code,0),
				info,
				-1));
}


void
check_bit(int ch,void * d);

void
check_bit(int ch,void * d)
{
MATRIX_DH_SET ds;
	if ( ch != 9 )
		return;
	get_matrix_dh_set(&ds,d);
	if ( *(char*)ds.offset )
		ss_printf("CB %i\n",*(char*)ds.offset);
}


XL_SEXP * 
_get_channel_data(MATRIX_NODE * n,int ch,XL_SEXP * s)
{
MATRIX * m;
void * d;
MATRIX_DATA_TYPE * md;
MATRIX_SEXP * sx;
XL_SEXP * ret;
char * err_msg;

	err_msg =0;
	if  ( n->channel == 0 ) {
		err_msg = "no data channel";
		goto no_obj;
	}
	m = n->matrix;
	if ( ch < 0 || ch >= m->p.channel_nos ) {
		err_msg = "overflow the ch No.";
		goto no_obj;
	}
	md = m->channel_info[ch].data_type;
	if ( md->type == MDT_SEXP ) {
		_matrix_node_channel_lock(n);
		sx = n->channel[ch].data;
		if ( sx == 0 ) {
			_matrix_node_channel_unlock(n,0);
			err_msg = "SEXP type no data";
			goto no_obj;
		}
		cons(ret = sx->data,0);
		_matrix_node_channel_unlock(n,0);
		return ret;
	}
	else {
		_matrix_node_channel_lock(n);
		d = n->channel[ch].data;
		if ( d == 0 ) {
			_matrix_node_channel_unlock(n,0);
			err_msg = "not sexp data / no data";
			goto no_obj;
		}
//check_bit(ch,d);
		ret = (*md->md2sexp)(md,d);
		_matrix_node_channel_unlock(n,0);
		return ret;
	}
no_obj:
	if ( s )
		return get_error(
			s->h.file,
			s->h.line,
			XLE_PROTO_INV_OBJECT,
			l_string(std_cm,"mxCH:get_channel_data"),
			List(n_get_string(
				"invalid object in channel of NODE"),
				n_get_string(err_msg),
				get_sexp_from_dim_code(m,n->dim_code),
				get_integer(ch,0),
				-1));
	else	return get_error(
			0,
			0,
			XLE_PROTO_INV_OBJECT,
			l_string(std_cm,"mxCH:get_channel_data"),
			List(n_get_string(
				"invalid object in channel of NODE"),
				n_get_string(err_msg),
				get_sexp_from_dim_code(m,n->dim_code),
				get_integer(ch,0),
				-1));
}


XL_SEXP * 
get_channel_data(MATRIX_NODE * n,int ch,XL_SEXP * s)
{
XL_SEXP * ret;
	lock_task(matrix_lock);
	ret = _get_channel_data(n,ch,s);
	unlock_task(matrix_lock,"get_channel_data");
	return ret;
}

void
_set_dirty_file(MATRIX_NODE * n)
{
	n->dirty_file_time = get_xltime();
//	_matrix_trigger_access(n,MI_SAVE_TP);
}


void
_flush_all_dirty_file(MATRIX * m)
{
int i;
MATRIX_NODE * n;
	for ( i = 0 ; i < NHASH_SIZE ; i ++ ) {
		n = m->node_hash[i];
		for ( ; n ; n = n->nh_next ) {
			if ( n->dirty_file_time == 0 )
				continue;
			switch ( n->status ) {
			case MS_OK:
				_matrix_trigger_access(n,MI_SAVE_TP,0);
				break;
			default:
				n->dirty_file_time = 0;
				break;
			}
		}
	}
}

void
flush_all_dirty_file(MATRIX * m)
{
	lock_task(matrix_lock);
	_flush_all_dirty_file(m);
	unlock_task(matrix_lock,"flush_all_dirty_file");
}


int
_set_channel_sexp(MATRIX_NODE * n,int ch,XL_SEXP * s)
{
MATRIX * m;
MATRIX_DATA_HEADER * h;
MATRIX_DATA_TYPE * md;
int cf;
MATRIX_SEXP * s1, * s2;
	m = n->matrix;
	if ( ch < 0 || ch >= m->p.channel_nos )
		return -1;
	if ( n->channel == 0 ) {
		n->channel = d_alloc(sizeof(MATRIX_CHANNEL)*m->p.channel_nos);
		memset(n->channel,0,sizeof(MATRIX_CHANNEL)*m->p.channel_nos);
	}
	md = m->channel_info[ch].data_type;
	h = (*md->sexp2md)(&cf,md,s);
	if ( h == 0 )
		return -1;
	_matrix_node_channel_lock(n);
	if ( n->channel[ch].data == 0 ) {
		if ( cf )
			n->channel[ch].data = h;
		else	n->channel[ch].data = (md->alloc_copy)(md,h,MD_DALLOC,0);
		if ( m->channel_info[ch].flags & MF_FILE )
			_set_dirty_file(n);
		_matrix_node_channel_unlock(n,0);
		return 1;
	}
	switch ( (*md->cmp)(md,h,n->channel[ch].data) ) {
	case -2:
		if ( cf )
			(*md->free_data)(md,h);
		_matrix_node_channel_unlock(n,0);
		return -1;
	case -1:
	case 1:
		if ( md->type == MDT_SEXP ) {
			s1 = n->channel[ch].data;
			s2 = (MATRIX_SEXP*)h;
			s1->data = s2->data;
			s2->del = 1;
		}
		else {
			(md->copy)(md,n->channel[ch].data,h,MD_DALLOC,0);
			if ( cf )
				(*md->free_data)(md,h);
		}
		if ( m->channel_info[ch].flags & MF_FILE )
			_set_dirty_file(n);
		_matrix_node_channel_unlock(n,0);
		return 1;
	case 0:
		if ( md->type == MDT_SEXP ) {
			s2 = (MATRIX_SEXP*)h;
			s2->del = 1;
		}
		else if ( cf )
			(*md->free_data)(md,h);
		_matrix_node_channel_unlock(n,0);
		return 0;
	default:
		er_panic("_set_channel_sexp");
	}
	_matrix_node_channel_unlock(n,0);
	return -1;
}


int
set_channel_sexp(MATRIX_NODE * n,int ch,XL_SEXP * s)
{
int ret;
	lock_task(matrix_lock);
	ret = _set_channel_sexp(n,ch,s);
	unlock_task(matrix_lock,"get_channel_data");
	return ret;
}



void
get_ix_from_seq(int * target,int * ix_size,int ix,int dim)
{
int i;
/*
	x + y * x_size + z * x_size * y_size  + w * x_size * y_size * z_size;
	y + z * y_size; + w * y_size * z_size .... x
	z  + w * z_size ... y;
	w ... z;
*/
	for ( i = 0 ; i < dim ; i ++ ) {
		target[i] = ix % ix_size[i];
		ix = ix / ix_size[i];
	}
	
}

int
get_seq_from_ix(int * ix,int * ix_size,int dim)
{
int i;
int ret;
int mass;
	ret = 0;
	mass = 1;
	for ( i = 0 ; i < dim ; i ++ ) {
		ret += ix[i] * mass;
		mass *= ix_size[i];
	}
	return ret;
}

int
inc_ix(int * ix,int * st,int * inc,int * ix_size,int dim)
{
int i;
	for ( i = 0 ; i < dim ; i ++ ) {
		ix[i] += inc[i];
		if ( ix[i] < ix_size[i] )
			break;
		if ( st == 0 )
			ix[i] = 0;
		else	ix[i] = st[i];
	}
	if ( i == dim )
		return 1;
	return 0;
}


int
inc_dim_code_ix(INTEGER64 * ix,INTEGER64 * st,INTEGER64 * inc,INTEGER64 * ix_size,int dim)
{
int i;
	for ( i = 1 ; i <= dim ; i ++ ) {
		ix[i] += inc[i];
		if ( ix[i] < ix_size[i] )
			break;
		if ( st == 0 )
			ix[i] = 0;
		else	ix[i] = st[i];
	}
	if ( i > dim )
		return 1;
	return 0;
}

void *
get_vdata_from_sexp(XL_SEXP * s)
{
	switch ( get_type(s) ) {
	case XLT_PTR:
		return s->ptr.ptr;
	case XLT_RAW:
		return s->raw.data;
	default:
		return 0;
	}
}


int
_dc_peano_inc(MATRIX * m,
	INTEGER64 * dc,
	INTEGER64 * dc_start,
	INTEGER64 * dc_end,
	int level)
{
int i;
INTEGER64 d1,d2,mask;

retry:
	if ( level >= m->total_levels )
		return -1;
	for ( i = 0 ; i < m->p.dim ; i ++ ) {

		mask = (((INTEGER64)1)<<(level * m->dim_divide[i]
				+ m->block_size[i]));
		d1 = dc[i+1] & (-mask);
		d2 = d1 + mask;
		mask = - (((INTEGER64)1)<<((level + 1) * m->dim_divide[i]
				+ m->block_size[i]));
		if ( (d1 & mask) != (d2 & mask) )
			goto reset;
		if ( d2 >= dc_end[i+1] )
			goto reset;
		dc[i+1] = d2;
		break;
	reset:
		mask = ((INTEGER64)1)<<m->dim_divide[i];
		mask = mask << (level * m->dim_divide[i]
				+ m->block_size[i]);
		dc[i+1] &= (-mask);
		if ( dc[i+1] < dc_start[i+1] )
			dc[i+1] = dc_start[i+1];
	}
	if ( i == m->p.dim ) {
		level ++;
		goto retry;
	}
	return 0;
}

void
_matrix_peano_trigger(
	MATRIX * m,
	INTEGER64 * dc_start,
	INTEGER64 * dc_end,
	int _access)
{
MATRIX_NODE * n;
int err;
INTEGER64 * dc;


	dc = _copy_dim_code(m,dc_start);
	for ( ; ; ) {
		if ( matrix_que.total_cnt >= NCACHE_SIZE ) {
			unlock_task(matrix_lock,"matrix_peano_trigger");
			sleep_sec(1);
			lock_task(matrix_lock);
			continue;
		}
		err = 0;
		n = _get_matrix_node(&err,m,dc,GN_ERROR_NORETRY,
					dc_start[0]);
		if ( n )
			_matrix_trigger_access(n,_access,0);
		_unlock_node(n,0);
		if ( _dc_peano_inc(m,dc,dc_start,dc_end,dc_start[0]) < 0 )
			break;
	}
}

void
matrix_peano_trigger(
	MATRIX * m,
	INTEGER64 * dc_start,
	INTEGER64 * dc_end,
	int _access)
{
	lock_task(matrix_lock);
	_matrix_peano_trigger(m,dc_start,dc_end,_access);
	unlock_task(matrix_lock,"matrix_peano_trigger");
}


MX_DIM_CODE_LIST * 
get_children_list(int * errp,MATRIX * m,INTEGER64 * dc,
	int access,int wait_flag,MATRIX_TOKEN * t)
{
MATRIX_NODE * n;
int err;
INTEGER64 ** pp;
int pp_len;
int i;
int ix;
MX_DIM_CODE_LIST * lst, * lst2, * ret;
	err = 0;
	if ( wait_flag )
		n = get_matrix_node_wait(&err,m,dc,access);
	else	n = get_matrix_node(&err,m,dc,access,t);
	if ( err ) {
		if ( errp )
			*errp = err;
		return 0;
	}
	if ( n->nlist_dim_bit_field ) {
		ix = 1;
		for ( i = 0 ; i < m->p.dim ; i ++ )
			ix *= 1<<m->dim_divide[i];
		ix = ix -1;
		lst = 0;
		for ( ; ix >= 0 ; ix -- ) {
			if ( (n->nlist_dim_bit_field[ix/8] & (1<<(ix % 8))) == 0 )
				continue;
			lst2 = d_alloc(sizeof(*lst2));
			lst2->dc = get_dim_code_from_index(m,dc,ix);
			lst2->next = lst;
			lst = lst2;
		}
		ret = lst;
		goto end;
	}
	else {
		pp = n->nlist_dim_addr;
		pp_len = n->nlist_dim_addr_len;
		if ( pp ) {
			ret = 0;
			goto end;
		}
		lst = 0;
		for ( ; pp_len  ; pp ++ , pp_len ) {
			lst2 = d_alloc(sizeof(*lst2));
			lst2->dc = copy_dim_code(m,*pp);
			lst2->next = lst;
			lst = lst2;
		}
		ret = lst;
	}
end:
	unlock_node(n,0);
	return ret;
}



void
free_mx_dim_code_list(MX_DIM_CODE_LIST * lst)
{
MX_DIM_CODE_LIST * lst2;
	for ( ; lst ; ) {
		lst2 = lst->next;
		d_f_ree(lst->dc);
		d_f_ree(lst);
		lst = lst2;
	}
}




int
load_indicate_cond(SYS_QUEUE * sq,Q_HEADER * h,LOAD_WORK * w)
{
	if ( h->pri == w->pri ) {
		w->cnt ++;
	}
	else {
		ss_printf("%i[%i]",w->pri,w->cnt);
		w->pri = h->pri;
		w->cnt = 1;
	}
	return 0;
}


void
load_indicate_tick()
{
LOAD_WORK w;
	switch ( load_indicate_tick_end_flag ) {
	case 1:
		load_indicate_tick_end_flag = 2;
		change_tick(-1);
	case 2:
		load_indicate_tick_end_flag = 0;
		return;
	}
	w.pri = -1;
	w.cnt = 0;
	ss_printf("QL");
	check_queue(&matrix_que,load_indicate_cond,&w);
	ss_printf("%i[%i]\n",w.pri,w.cnt);
}

void
load_indicate(int start)
{
	if ( start ) {
		for ( ; load_indicate_tick_end_flag ; )
			sleep_sec(1);
		new_tick(load_indicate_tick,2,0);
	}
	else {
		load_indicate_tick_end_flag = 1;
	}
}


