/**********************************************************************
 
	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	<stdio.h>
#include	<fcntl.h>
#include	"memory_debug.h"
#include	"machine/err.h"
#include	"xl.h"
#include	"memory_routine.h"
#include	"xlerror.h"
#include	"utils.h"
#include	"task.h"
#include	"mlong_char.h"
#include	"lock_level.h"


void gc_gb_file();
SEM parse_lock;
int parse_lock_task;
int parse_lock_cnt;


#define ACTIVE 629

/*
void
test_set(void * ptr)
{
	if ( test_cnt == ACTIVE-1 )
		test_ptr = ptr;
}

void
test_print(char * str)
{
	test_cnt ++;
	printf("t %i ",test_cnt);
	if ( test_cnt < ACTIVE ) {
		printf("\n");
		return;
	}
	printf("%s ptr=%x f=%x\n",
		str,test_ptr,test_ptr->h.file);
}
*/

void
init_parse_system()
{
	parse_lock = new_lock(LL_PARSE);
}

void
lock_parse()
{
int t;
	t = get_tid();
	if ( parse_lock_task == t ) {
		parse_lock_cnt ++;
		return;
	}
	lock_task(parse_lock);
	parse_lock_task = t;
	parse_lock_cnt ++;
}

void
unlock_parse(char * str)
{
	parse_lock_cnt --;
	if ( parse_lock_cnt )
		return;
	parse_lock_task = 0;
	unlock_task(parse_lock,str);
}


STREAM *
get_sexp_stream(XL_SEXP * s)
{
XL_FILE * f;
STREAM * ret;
	lock_parse();
	if ( s == 0 ) {
		ret = 0;
		goto end;
	}
	f = s->h.file;
	if ( f == 0 ) {
		ret = 0;
		goto end;
	}
	ret = f->st;
end:
	unlock_parse("get_sexp_stream");
	return ret;
}


XL_SEXP *
gb_push_delay(XL_FILE * f,XL_SEXP * p,int dtype)
{
XL_DELAY * d;

	lock_mem(); 
	d = &get_sexp_inh(f,XLT_DELAY,p)->delay;
	d->dtype = dtype;
	unlock_mem(); 
	d->d.file.f = f;
	d->next = f->stack;
	f->stack = d;
	return (XL_SEXP*)d;
}

int
gb_pop_delay(XL_FILE * f)
{
int dtype;
	if ( f->stack == 0 )
		return 0;
	dtype = f->stack->dtype;
	f->stack = f->stack->next;
	return dtype;
}

XL_SEXP *
init_parse(STREAM * st,
	L_CHAR * name,L_CHAR * comment)
{
XL_FILE * f;
XL_SEXP * pp;

	if ( st == 0 )
		return 0; 
	f = mmalloc(sizeof(XL_FILE),gc_gb_file);
	f->name = ll_copy_mstr(name);
	f->site = ll_copy_mstr(gblisp_site);
	f->st = st;
	if ( comment )
		f->comment = ll_copy_mstr(comment);
	else	f->comment = ll_copy_mstr(name);
	f->lex_error = 0;
	f->stack = 0;
	f->line = 1;
	f->token_head_line = 1;
	f->flags = XLF_X_NO_CR|XLF_X_NO_SP;
	f->mode = 0;
	f->entity = 0;
	f->ent_stack = 0;
	f->func_12 = 0;
	f->func_11 = 0;
	f->func_14 = 0;
	f->work = 0;
	f->close_func = 0;
	f->close_work = 0;
	f->cm = s_get_cm(st);
	if ( f->cm == 0 )
		f->cm = std_cm;
	f->cm_work = (*f->cm->open)();
	f->rb_len = 0;
	f->rb_ptr = 0;
	pp = gb_push_delay(f,0,GBDT_FILE);
	pp->h.line = 1;
	gb_file_insert(f);
	new_entity(f,l_string(std_cm,"lt"),l_string(std_cm,"&#x3c;"));
	new_entity(f,l_string(std_cm,"amp"),l_string(std_cm,"&#x26;"));
	new_entity(f,l_string(std_cm,"quot"),l_string(std_cm,"&#x27;"));
	return pp;
}

void
set_close_func(XL_FILE * f,void (*func)(),void * work)
{
	f->close_work = work;
	f->close_func = func;
}

XL_SEXP *
init_delay_func(DELAY_FUNC * df)
{
XL_SEXP * s;
XL_FILE * f;
	f = mmalloc(sizeof(*f),gc_gb_file);
	f->st = 0;
	gb_file_insert(f);

	lock_mem();
	s = get_sexp(f,XLT_DELAY);
	s->delay.dtype = GBDT_FUNC;
	s->delay.d.func = df;
	unlock_mem();
	return s;
}

void
new_pair(XL_FILE * f)
{
XL_PAIR * p1;
XL_DELAY * d;
int dtype;
XL_SEXP * tag;
int mode;


	lock_parse(); 
	d = f->stack;
	tag = d->d.file.tag;
	mode = d->d.file.mode;
	dtype = gb_pop_delay(f);
	set_sexp(f,XLT_PAIR,d);
	p1 = (XL_PAIR*)d;
	if ( dtype == GBDT_FILE ) {

		p1->cdr = gb_push_delay(f,(XL_SEXP*)p1,GBDT_FILE);
		p1->cdr->delay.d.file.tag = tag;
		p1->cdr->delay.d.file.mode = mode;
	}
	else	p1->cdr = 0;
	p1->car = gb_push_delay(f,(XL_SEXP*)p1,GBDT_FILE);


	unlock_parse("new_pair");
}

void
new_quote(XL_FILE * f)
{
XL_PAIR * p1, * p2, * p3;
XL_DELAY * d;
int dtype;
XL_SEXP * tag;
int mode;
	lock_parse(); 
	d = f->stack;
	tag = d->d.file.tag;
	mode = d->d.file.mode;
	dtype = gb_pop_delay(f);
	set_sexp(f,XLT_PAIR,d);
	p1 = (XL_PAIR*)d;
	if ( dtype == GBDT_FILE ) {
		p1->cdr = gb_push_delay(f,(XL_SEXP*)p1,GBDT_FILE);
		p1->cdr->delay.d.file.tag = tag;
		p1->cdr->delay.d.file.mode = mode;
	}
	else	p1->cdr = 0;
	p2 = &get_sexp(f,XLT_PAIR)->pair;
	p1->car = (XL_SEXP*)p2;


	p2->car = n_get_symbol("quote");


	p2->cdr = gb_push_delay(f,(XL_SEXP*)p1,GBDT_FILE_QUOTE);
	unlock_parse("new_quote"); 
}

void
null_pair(XL_FILE * f)
{
XL_PAIR * p1;
XL_DELAY * d;
int dtype;
XL_SEXP * tag;
int mode;
	lock_parse(); 
	d = f->stack;
	tag = d->d.file.tag;
	mode = d->d.file.mode;
	dtype = gb_pop_delay(f);
	set_sexp(f,XLT_PAIR,d);
	p1 = (XL_PAIR*)d;
	if ( dtype == GBDT_FILE ) {
		p1->cdr = gb_push_delay(f,(XL_SEXP*)p1,GBDT_FILE);
		p1->cdr->delay.d.file.tag = tag;
		p1->cdr->delay.d.file.mode = mode;
	}
	else	p1->cdr = 0;
	p1->car = 0;


	unlock_parse("null_pair");
}

void
new_data_set(XL_FILE * f,XL_SEXP * data)
{
XL_PAIR * p1;
XL_DELAY * d;
int dtype;
XL_SEXP * tag;
int mode;
	lock_parse(); 
	d = f->stack;
	tag = d->d.file.tag;
	mode = d->d.file.mode;
	dtype = gb_pop_delay(f);
	set_sexp(f,XLT_PAIR,d);
	p1 = (XL_PAIR*)d;
	if ( dtype == GBDT_FILE ) {
		p1->cdr = gb_push_delay(f,(XL_SEXP*)p1,GBDT_FILE);
		p1->cdr->delay.d.file.tag = tag;
		p1->cdr->delay.d.file.mode = mode;
	}
	else	p1->cdr = 0;
	p1->car = data;



	unlock_parse("new_data_set");
}

void
new_data(XL_FILE * f,XL_SEXP * data)
{
XL_PAIR * p;
XL_DELAY * d;
int dtype;
XL_SEXP * tag;
int mode;

	lock_parse(); 
	d = f->stack;
	tag = d->d.file.tag;
	mode = d->d.file.mode;
	dtype = gb_pop_delay(f);
	set_sexp_inh(f,XLT_PAIR,d,data);
	p = (XL_PAIR*)d;
	p->car = data;


	if ( dtype == GBDT_FILE ) {
		p->cdr = gb_push_delay(f,(XL_SEXP*)p,GBDT_FILE);
		p->cdr->delay.d.file.tag = tag;
		p->cdr->delay.d.file.mode = mode;
	}
	else	p->cdr = 0;
	unlock_parse("new_data");
}


XL_SEXP *
parse_data(XL_FILE * f)
{
	return f->sexp;
}

XL_SEXP *
parse_sexp(int *,XL_FILE *);

XL_SEXP *
parse_quote(XL_FILE * f)
{
int er;
	return list(
		n_get_symbol("quote"),
		parse_sexp(&er,f),
		0);
}

XL_SEXP *
parse_pair(XL_FILE * f)
{
int t;
XL_SEXP * ret, * s;
XL_SEXP ** rp;
	ret = 0;
	rp = &ret;
	for ( ; ; ) {
		t = gb_lex(f);
		switch ( t ) {
		case 0:
		case -1:
			return 0;
		case ')':
			return ret;
		case '(':
			s = parse_pair(f);
			break;
		case '\'':
			s = parse_quote(f);
			break;
		case T_SEXP:
			s = parse_data(f);
			break;
		case T_ERR:
			return ret;
			break;
		case C_CANCEL:
			s = get_error(
				f,
				f->stack->h.line,
				XLE_SYSTEM_EXIT,
				l_string(std_cm,"parser"),
				n_get_string("cancel"));
			break;
		default:
			printf("%i(%c)\n",t,t);
			er_panic("gb_parse(1)");
		}
		*rp = cons(s,0);
		rp = &(*rp)->pair.cdr;
	}
}

XL_SEXP *
parse_sexp(int * er,XL_FILE * f)
{
int t;
XL_SEXP * s;
	*er = 0;
	t = gb_lex(f);
	switch ( t ) {
	case 0:
	case -1:
		goto err;
	case ')':
		goto err;
	case '(':
		s = parse_pair(f);
		break;
	case '\'':
		s = parse_quote(f);
		break;
	case T_SEXP:
		s = parse_data(f);
		break;
	case T_ERR:
		goto err;
		break;
	default:
		printf("%i(%c)\n",t,t);
		er_panic("gb_parse(1)");
	}
	return s;
err:
	*er = -1;
	return 0;
}

void
parse_error(XL_FILE * f)
{
XL_PAIR * p;
XL_DELAY * d;
int dtype;
int t;
XL_ERROR * e;
XL_SEXP * pp;
int er;
XL_SEXP * tag;
int mode;
	lock_parse(); 
	d = f->stack;
	tag = d->d.file.tag;
	mode = d->d.file.mode;
	dtype = gb_pop_delay(f);
	set_sexp_inh(f,XLT_PAIR,d,f->sexp);
	p = (XL_PAIR*)d;
	e = (XL_ERROR*)f->sexp;
	p->car = (XL_SEXP*)e;



	if ( dtype == GBDT_FILE ) {
		p->cdr = gb_push_delay(f,(XL_SEXP*)p,GBDT_FILE);
		p->cdr->delay.d.file.tag = tag;
		p->cdr->delay.d.file.mode = mode;
	}
	else	p->cdr = 0;
	t = gb_lex(f);
	if ( t != '(' )
		goto err;
	t = gb_lex(f);
	if ( t != T_SEXP )
		goto err;
	pp = f->sexp;
	if ( pp->h.type != XLT_STRING )
		goto err;
	e->site = pp->string.data;
	t = gb_lex(f);
	if ( t != T_SEXP )
		goto err;
	pp = f->sexp;
	if ( pp->h.type != XLT_STRING )
		goto err;
	e->filename = pp->string.data;
	t = gb_lex(f);
	if ( t != T_SEXP )
		goto err;
	pp = f->sexp;
	if ( pp->h.type != XLT_INTEGER )
		goto err;
	e->line = pp->integer.data;
	t = gb_lex(f);
	if ( t != T_SEXP )
		goto err;
	pp = f->sexp;
	if ( pp->h.type != XLT_STRING )
		goto err;
	e->func = pp->string.data;
	t = gb_lex(f);
	if ( t != T_SEXP )
		goto err;
	pp = f->sexp;
	if ( pp->h.type != XLT_INTEGER )
		goto err;
	e->code = pp->integer.data;
	e->data = parse_sexp(&er,f);
	if ( er == -1 )
		goto err;

	t = gb_lex(f);
	if ( t != ')' )
		goto err;
	unlock_parse("parse_err");
	return;
err:
	e->code = XLE_SYNTAX_ERROR_CODE;
	e->data = 0;
	unlock_parse("parse_err");
	return;
}

int stop_flag;


XL_SEXP *
_realize_sexp(XL_SEXP * s)
{
int t;
XL_FILE * f,* f2;
XL_DELAY * d;
XL_SEXP * err, * data;
int plt,plc;


set_t_msg(4002);
	lock_parse();
set_t_msg(4003);
	if ( s == 0 ) {
		unlock_parse("realize_sexp");
set_t_msg(4004);
		return 0;
	}
	if ( s->h.type != XLT_DELAY ) {
		unlock_parse("realize_sexp");
set_t_msg(4005);
		return s;
	}
	for ( ; s->h.file->flags & XLF_PARSE ; ) {
		plt = parse_lock_task;
		plc = parse_lock_cnt;
		parse_lock_task = 0;
		parse_lock_cnt = 0;
set_t_msg(4006);
		sleep_task((int)s->h.file,parse_lock);
		lock_parse();
set_t_msg(4007);
		parse_lock_task = plt;
		parse_lock_cnt = plc;
		if ( s == 0 ) {
			unlock_parse("realize_sexp");
set_t_msg(4008);
			return 0;
		}
		if ( s->h.type != XLT_DELAY ) {
set_t_msg(4009);
			unlock_parse("realize_sexp");
			return s;
		}
	}
set_t_msg(4010);
	if ( s->h.type == XLT_DELAY ) {
		if ( s->delay.dtype == GBDT_FUNC ) {
		delay_retry:
set_t_msg(4011);
			f = s->h.file;
			f->flags |= XLF_PARSE;
			unlock_parse("realize_sexp");
set_t_msg(4012);
set_t_msg2(s->delay.d.func->func);
			s = (*s->delay.d.func->func)(s);
set_t_msg(4013);
			lock_parse();
			if ( s->h.type == XLT_DELAY )
				goto delay_retry;
set_t_msg(4014);
			wakeup_task((int)f);
			f->flags &= ~XLF_PARSE;
			unlock_parse("realize_sexp");
set_t_msg(4015);
			return s;
		}
	}
	else {
set_t_msg(4016);
		unlock_parse("realize_sexp");
		return s;
	}
set_t_msg(4017);
	f = s->h.file;
	f->flags |= XLF_PARSE;
	unlock_parse("realize_sexp");
	for ( ; ; ) {
		lock_parse();
		wakeup_task((int)f);
		if ( s == 0 ) {
			f->flags &= ~XLF_PARSE;
			unlock_parse("realize_sexp");
			return 0;
		}
		if ( s->h.type != XLT_DELAY ) {
			f->flags &= ~XLF_PARSE;
			unlock_parse("realize_sexp");
			return s;
		}
		unlock_parse("realize_sexp");
		t = gb_lex(f);

		if ( f->lex_error ) {
			err = f->lex_error;
			for ( ; get_type(cdr(err)) ; err = cdr(err) )
			new_data_set(f,car(err));
			f->lex_error = 0;
			continue;
		}
		switch ( t ) {
		case 0:
		case -1:
			for ( ; f->stack ; ) {
				d = f->stack;
				gb_pop_delay(f);
				if ( f->stack ) {
					set_sexp_inh(f,XLT_ERROR,d,d);
					err = get_error(
						f,
						f->stack->h.line,
						XLE_SYNTAX_NO_PUNC,
						l_string(std_cm,"parser"),
						list(
				get_string(l_string(std_cm,"no ) for (")),
						0));
					memcpy(d,err,
						get_sexp_size(XLT_ERROR));
				}
				else	set_sexp_inh(f,XLT_NULL,d,d);
			}
			break;
		case C_CANCEL:

			if ( f->stack->next == 0 ) {
				err = get_error(
						f,
						f->stack->h.line,
						XLE_SYSTEM_INTERRUPT,
						l_string(std_cm,"parser"),
						list(
				get_string(l_string(std_cm,"cancel")),
						0));
				err->h.file = f;
				err->h.line = f->stack->h.line;
				new_data(f,err);
			}
			else for ( ; f->stack->next ; ) {
				d = f->stack;
				gb_pop_delay(f);
				if ( f->stack ) {
					set_sexp_inh(f,XLT_ERROR,d,d);
					err = get_error(
						f,
						f->stack->h.line,
						XLE_SYSTEM_INTERRUPT,
						l_string(std_cm,"parser"),
						list(
				get_string(l_string(std_cm,"cancel")),
						0));
					memcpy(d,err,
						get_sexp_size(XLT_ERROR));
				}
				else	set_sexp_inh(f,XLT_NULL,d,d);
			}
			break;
		case ')':
			if ( f->stack->next == 0 ) {
				err = get_error(
					f,
					f->line,
					XLE_SYNTAX_TOO_MANY_PUNC,
					l_string(std_cm,"parser"),
					list(
					get_string(
					 l_string(std_cm,"too many )")),
					0));
				new_data_set(f,err);
			}
			else {
				d = f->stack;
				gb_pop_delay(f);
				set_sexp_inh(f,XLT_NULL,d,d);
				if ( f->stack->d.file.mode == 0 )
					f->flags &= ~XLF_L_MODE;
			}


			break;
		case '(':
			new_pair(f);
			f->stack->d.file.mode = XLF_L_MODE;
			f->flags |= XLF_L_MODE;
			break;
		case '\'':
			new_quote(f);
			f->stack->d.file.mode = XLF_L_MODE;
			f->flags |= XLF_L_MODE;
			break;
		case T_SEXP:
			new_data(f,f->sexp);
			if ( f->stack->d.file.mode )
				f->flags |= XLF_L_MODE;
			else	f->flags &= ~XLF_L_MODE;
			break;
		case T_ERR:
			parse_error(f);
			if ( f->stack->d.file.mode )
				f->flags |= XLF_L_MODE;
			else	f->flags &= ~XLF_L_MODE;
			break;
		case T_TAG:
			data = f->sexp;
			new_pair(f);
			f->stack->d.file.tag = data;
			f->stack->d.file.mode = 0;
			f->flags &= ~XLF_L_MODE;
			new_data(f,data);
			break;
		case T_TAG_N:
			if ( f->stack->next == 0 ) {
				err = get_error(
					f,
					f->line,
					XLE_SYNTAX_NOT_CORRESPOND_TAG,
					l_string(std_cm,"parser"),
					list(
					get_string(
				 l_string(std_cm,"not correspond tag ( to")),
					get_string(f->sexp->symbol.data),
					0));
				new_data_set(f,err);
				break;
			}
			d = f->stack;
			data = d->d.file.tag;
			gb_pop_delay(f);
			set_sexp_inh(f,XLT_NULL,d,d);
			if ( data == 0 ) {
				err = get_error(
					f,
					f->line,
					XLE_SYNTAX_NOT_CORRESPOND_TAG,
					l_string(std_cm,"parser"),
					list(
					get_string(
				 l_string(std_cm,"not correspond tag ( to")),
					get_string(f->sexp->symbol.data),
					0));
				new_data_set(f,err);
				break;
			}
			if ( l_strcmp(data->symbol.data,
					f->sexp->symbol.data) != 0 ) {
				err = get_error(
					f,
					f->line,
					XLE_SYNTAX_NOT_CORRESPOND_TAG,
					l_string(std_cm,"parser"),
					list(
					get_string(
				 l_string(std_cm,"not correspond tag")),
				get_string(data->symbol.data),
					get_string(f->sexp->symbol.data),
					0));
				new_data_set(f,err);
				break;
			}
			if ( f->stack->d.file.mode )
				f->flags |= XLF_L_MODE;
			break;
		case T_TAG_C:
		case T_TAG_Q:
		case T_TAG_E:
		case T_TAG_P:
		case T_TAG_EMP:
			data = f->sexp;
			new_pair(f);
			new_data(f,data);
			d = f->stack;
			gb_pop_delay(f);
			set_sexp_inh(f,XLT_NULL,d,d);
			if ( f->stack->d.file.mode )
				f->flags |= XLF_L_MODE;
			else	f->flags &= ~XLF_L_MODE;
			break;
		case ']':
		case '[':
		case '=':
		case T_FIELD:
		case T_TTEXT:
		case '>':
		case T_TAG_END_EMP:
		case T_TAG_END_COMMENT:
			err = get_error(
				f,
				f->line,
				XLE_SYNTAX_TOKEN_ERROR,
				l_string(std_cm,"parser"),
				list(
				get_string(
				 l_string(std_cm,"token error")),
				0));
			new_data_set(f,err);
			break;
		default:
			printf("%i(%c)\n",t,t);
			er_panic("gb_parse(1)");
		}
	}
}


XL_SEXP *
realize_sexp(XL_SEXP * s)
{
XL_SEXP * ret;


	ret = _realize_sexp(s);
	return ret;
}

int _cs_sexp_on_mem(CS_WORK * w,XL_SEXP * s);
int cs_sexp(CS_WORK * w,XL_SEXP * s);

void
free_cs_work(CS_WORK * w)
{
CS_LIST * cs;
	for ( ; w->lst ; ) {
		cs = w->lst;
		w->lst = cs->next;
		d_f_ree(cs);
	}
}

CS_LIST * search_cs(CS_LIST * cs,L_CHAR code)
{
	for ( ; cs ; cs = cs->next )
		if ( cs->code == code )
			return cs;
	return 0;
}

int
cs_l_char(CS_WORK * w,L_CHAR * str)
{
L_CHAR ch,type;
CS_LIST * target;

	if ( w->str_max == 0 )
		return -1;
	if ( w->str_max > 0 )
		w->str_max --;
	if ( str == 0 )
		return 0;
	for ( ; *str ; str ++ ) {
		ch = *str;
		if ( (ch&LCZM_1B_TYPE) == 0 )
			continue;
		type = ch&get_lc_mask(ch);
		target = search_cs(w->lst,type);
		if ( target == 0 ) {
			target = d_alloc(sizeof(*target),2);
			target->next = w->lst;
			w->lst = target;
			target->code = type;
			target->count = 1;
		}
		else {
			target->count ++;
		}
	}
	return 0;
}

int
cs_error_on_mem(CS_WORK * w,XL_SEXP * s)
{
	if ( cs_l_char(w,s->err.site) < 0 )
		return -1;
	if ( cs_l_char(w,s->err.filename) < 0 )
		return -1;
	if ( cs_l_char(w,s->err.func) < 0 )
		return -1;
	return _cs_sexp_on_mem(w,s->err.data);
}

int
cs_error(CS_WORK * w,XL_SEXP * s)
{
	if ( cs_l_char(w,s->err.site) < 0 )
		return -1;
	if ( cs_l_char(w,s->err.filename) < 0 )
		return -1;
	if ( cs_l_char(w,s->err.func) < 0 )
		return -1;
	return cs_sexp(w,s->err.data);
}

int
cs_string(CS_WORK * w,XL_SEXP * s)
{
	return cs_l_char(w,s->string.data);
}

int
cs_symbol(CS_WORK * w,XL_SEXP * s)
{
XL_SYM_FIELD * sf;
	if ( cs_l_char(w,s->symbol.data) < 0 )
		return -1;
	for ( sf = s->symbol.field ; sf ; sf = sf->next ) {
		if ( cs_l_char(w,sf->name) < 0 )
			return -1;
		if ( cs_l_char(w,sf->data) < 0 )
			return -1;
	}
	return 0;
}

int
cs_pair_on_mem(CS_WORK * w,XL_SEXP * s)
{
	for ( ; s && s->h.type == XLT_PAIR ; s = s->pair.cdr ) {
		if ( _cs_sexp_on_mem(w,s->pair.car) < 0 )
			return -1;
	}
	return _cs_sexp_on_mem(w,s);
}

int
cs_pair(CS_WORK * w,XL_SEXP * s)
{
	for ( ; get_type(s) == XLT_PAIR ; s = cdr(s) ) {
		if ( cs_sexp(w,car(s)) < 0 )
			return -1;
	}
	return cs_sexp(w,s);
}

int
_cs_sexp_on_mem(CS_WORK * w,XL_SEXP * s)
{
	if ( s == 0 )
		return 0;
	switch ( s->h.type ) {
	case XLT_NULL:
		return 0;
	case XLT_ERROR:
		return cs_error_on_mem(w,s);
	case XLT_STRING:
		return cs_string(w,s);
	case XLT_SYMBOL:
		return cs_symbol(w,s);
	case XLT_PAIR:
		return cs_pair_on_mem(w,s);
	default:
		return 0;
	}
	return 0;
}
int
cs_sexp_on_mem(CS_WORK * w,XL_SEXP * s)
{
int ret;
	lock_parse();
	ret = _cs_sexp_on_mem(w,s);
	unlock_parse("cs_sexp_on_mem");
	return ret;
}


int
cs_sexp(CS_WORK * w,XL_SEXP * s)
{
	switch ( get_type(s) ) {
	case XLT_NULL:
		return 0;
	case XLT_ERROR:
		return cs_error(w,s);
	case XLT_STRING:
		return cs_string(w,s);
	case XLT_SYMBOL:
		return cs_symbol(w,s);
	case XLT_PAIR:
		return cs_pair(w,s);
	default:
		return 0;
	}
	return 0;
}


int
check_delay(XL_SEXP * s,int key)
{
int t;
XL_FILE * f,* f2;
XL_DELAY * d;
XL_SEXP * err, * data;
int plt,plc;
int ret;

	lock_parse();
	if ( s == 0 ) {
		unlock_parse("check_delay");
		return CDT_NONDELAY;
	}
	if ( s->h.type != XLT_DELAY ) {
		unlock_parse("check_delay");
		return CDT_NONDELAY;
	}
	for ( ; s->h.file->flags & XLF_PARSE ; ) {
		plt = parse_lock_task;
		plc = parse_lock_cnt;
		parse_lock_task = 0;
		parse_lock_cnt = 0;
		sleep_task((int)s->h.file,parse_lock);
		lock_parse();
		parse_lock_task = plt;
		parse_lock_cnt = plc;
		if ( s == 0 ) {
			unlock_parse("check_delay");
			return CDT_NONDELAY;
		}
		if ( s->h.type != XLT_DELAY ) {
			unlock_parse("check_delay");
			return CDT_NONDELAY;
		}
	}
	if ( s->h.type == XLT_DELAY ) {
		if ( s->delay.dtype == GBDT_FUNC ) {
		delay_retry:
			f = s->h.file;
			f->flags |= XLF_PARSE;
			unlock_parse("realize_sexp");
			if ( s->delay.d.func->check_func )
				ret = (*s->delay.d.func->check_func)
					(s->delay.d.func,key);
			else	ret = CDT_DEMAND;
			lock_parse();
			wakeup_task((int)f);
			f->flags &= ~XLF_PARSE;
			unlock_parse("check_delay");
			return ret;
		}
		unlock_parse("check_delay");
		return CDT_STREAM;
	}
	else {
		unlock_parse("check_delay");
		return CDT_NONDELAY;
	}
}
