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



void gc_gb_sexp();
void gc_entity_stack();
void gc_entity();
void gc_gb_sym_field();
void gc_entry();

int ttest;
SEM lex_lock;

#define TEST_LEN	1000

unsigned char emp_tag_table[][10] = {
	"meta",
	"META",
	"br",
	"BR",
	"!DOCTYPE",
	"IMG",
	"img",
	""
};

/*
typedef struct ptbl {
	char 		cmd[10];
	void 		(*func)();
} PTBL;
*/

void
test_mem(char * str)
{
int i;
char ** d;
/*
	fprintf(stderr,"%s...\n",str);
*/
	fflush(stderr);
	d = d_alloc(TEST_LEN*sizeof(char*),13);
	for ( i = 0 ; i < TEST_LEN ; i ++ )
		d[i] = d_alloc(i+1,14);
	for ( i = 0 ; i < TEST_LEN ; i ++ )
		d_f_ree(d[i]);
	d_f_ree(d);
/*
	fprintf(stderr,"%s...END\n",str);
*/
}


XL_FILE gb_file_root ={
	&gb_file_root,
	&gb_file_root
};

/*
void pt_line();

PTBL ptable[] = {
	{"@l",pt_line},
	{"",0}
};
*/


void *
lex_mrealloc(void * p,int size,void (*func)())
{

	if ( p == 0 )
		return mmalloc(size,func);
	return mrealloc(p,size,func);
}

void
gb_file_insert(XL_FILE * f)
{
	lock_task(lex_lock);
	f->prev = &gb_file_root;
	f->next = gb_file_root.next;
	f->prev->next = f;
	f->next->prev = f;
	unlock_task(lex_lock,"gb_file_insert(1)");
}

void
set_parseflags(XL_FILE * f,int set_flags,int res_flags)
{
	f->flags |= set_flags;
	f->flags &= ~res_flags;
}

void
set_file_line(XL_FILE * f,int line)
{
	f->line = line;
}

void
gb_file_delete(XL_FILE * f)
{
	if ( f->st && (f->flags & XLF_DONT_CLOSE) == 0 )
		s_close(f->st);
	f->st = 0;
	if ( f->close_func )
		(*f->close_func)(CF_CLOSE,f->close_work);
	f->close_func = 0;
	f->close_work = 0;
	f->flags |= XLF_CLOSE;
	if ( f->cm ) {
		(*f->cm->close)(0,f->cm_work);
		f->cm = 0;
		f->cm_work = 0;
	}
	lock_task(lex_lock);
	f->prev->next = f->next;
	f->next->prev = f->prev;
	unlock_task(lex_lock,"gb_file_delete(1)");
}

void
_gb_file_delete(XL_FILE * f)
{
	if ( f->st && (f->flags & XLF_DONT_CLOSE) == 0 )
		_s_close(f->st);
	f->st = 0;
	if ( f->close_func )
		(*f->close_func)(CF_CLOSE,f->close_work);
	f->close_func = 0;
	f->close_work = 0;
	if ( f->cm ) {
		(*f->cm->close)(0,f->cm_work);
		f->cm = 0;
		f->cm_work = 0;
	}

	f->flags |= XLF_CLOSE;
	f->prev->next = f->next;
	f->next->prev = f->prev;
}

int
get_sexp_size(int type)
{

set_t_msg(7000);
set_t_msg2(type);
	switch ( type ) {
	case XLT_NULL:
		return sizeof(XL_SEXP_HEADER);
	case XLT_ERROR:
		return sizeof(XL_ERROR);
	case XLT_PAIR:
		return sizeof(XL_PAIR);
	case XLT_SYMBOL:
		return sizeof(XL_SYMBOL);
	case XLT_STRING:
		return sizeof(XL_STRING);
	case XLT_INTEGER:
		return sizeof(XL_INTEGER);
	case XLT_FLOAT:
		return sizeof(XL_FLOAT);
	case XLT_FUNC:
		return sizeof(XL_FUNC);
	case XLT_DELAY:
		return sizeof(XL_SEXP);
	case XLT_PTR:
		return sizeof(XL_PTR);
	case XLT_RAW:
		return sizeof(XL_RAW);
	case XLT_ENV:
		return sizeof(XL_XLISP_ENV);
	default:
		fprintf(stderr,"get_sexp_size(1) %i\n",type);
		er_panic("get_sexp_size(1)");
	}
	return 0;
}

void
set_header(XL_SEXP * s,XL_FILE * f,int type)
{
	s->h.type = type;
	if ( f ) {
		s->h.line = f->token_head_line;
		s->h.file = f;
		f->sexp = s;
	}
	else {
		s->h.line = 0;
		s->h.file = 0;
	}
	s->h.flags = 0;
}


void
set_header_inh(XL_SEXP * s,XL_FILE * f,int type,XL_SEXP * h)
{
	s->h.type = type;
	if ( h == 0 ) {
		if ( f ) {
			s->h.line = f->token_head_line;
			s->h.file = f;
		}
		else {
			s->h.line = 0;
			s->h.file = 0;
		}
		return;
	}

	s->h.line = h->h.line;
	s->h.file = h->h.file;
}



XL_SEXP *
get_sexp(XL_FILE * f,int type)
{
XL_SEXP * s;

	lock_mem();
	s = mmalloc(get_sexp_size(type),gc_gb_sexp);
	s->h.type = type;
	unlock_mem();
	if ( f ) {
		s->h.line = f->token_head_line;
		s->h.file = f;
		f->sexp = s;
	}
	else {
		s->h.line = 0;
		s->h.file = 0;
	}
	s->h.flags = 0;
	return s;
}


XL_SEXP * 
get_sexp_inh(XL_FILE * f,int type,XL_SEXP * h)
{
XL_SEXP * s;

int z;

	lock_mem(); 
	s = mmalloc(z=get_sexp_size(type),gc_gb_sexp);
	s->h.type = type;
	unlock_mem();

	if ( h == 0 ) {
		if ( f ) {
			s->h.line = f->token_head_line;
			s->h.file = f;
		}
		else {
			s->h.line = 0;
			s->h.file = 0;
		}
		return s;
	}

	s->h.line = h->h.line;
	s->h.file = h->h.file;

	return s;
}

void
set_sexp(XL_FILE * f,int type,XL_SEXP * d)
{
XL_SEXP * s;
int size;
/*
	s = get_sexp(f,type);
	size = get_sexp_size(type);
	memcpy(d,s,size);
*/

	size = get_sexp_size(type);
	lock_mem();
	set_header(d,f,type);
	memset((&d->h)+1,0,size - sizeof(d->h));
	unlock_mem();
}

void
set_sexp_inh(XL_FILE * f,int type,XL_SEXP * d,XL_SEXP * h)
{
XL_SEXP * s;
int size;
/*
	s = get_sexp_inh(f,type,h);
	size = get_sexp_size(type);
	memcpy(d,s,size);

*/
	size = get_sexp_size(type);
	lock_mem();
	set_header_inh(d,f,type,h);
	memset((&d->h)+1,0,size - sizeof(d->h));
	unlock_mem();
}

void
over_write_sexp(XL_SEXP * d,XL_SEXP * from)
{
int size;

set_t_msg(6000);
	if ( from == 0 ) {
		set_sexp_inh(0,XLT_NULL,d,0);
	}
	else {
		lock_mem();
		size = get_sexp_size(from->h.type);
		memcpy(d,from,size);
		unlock_mem();
	}
}

void
token_head(XL_FILE * f)
{
	f->token_head_line = f->line;
}

void
put_data(XL_FILE * f,L_CHAR ch)
{
int i;

	if ( f->yytext == 0 )
		f->yytextlen = 0;
	if ( f->yytextlen == 0 ) {
		f->yytext = mmalloc(YYTEXTLEN*sizeof(L_CHAR),gc_text);
		f->yytextlen = YYTEXTLEN;
		f->yylen = 0;
	}
	else if ( f->yytextlen <= f->yylen ) {
		f->yytext = mrealloc(f->yytext,
			2*f->yytextlen*sizeof(L_CHAR),
			gc_text);
		f->yytextlen *= 2;
	}
	f->yytext[f->yylen] = ch;
	f->yylen ++;

/*
if ( f->yylen >= 5 ) {
if ( memcmp(f->yytext,l_string(std_cm,"</Res"),5*4) == 0 ) {
printf("**************** ");
for ( i = 0 ; i < f->yylen ; i ++ )
printf("%c %x ",(char)f->yytext[i],f->yytext[i]);
printf("\n");
}
}
*/


}

void
reset_yytext(XL_FILE * f)
{
	f->yytext = 0;
	f->yylen = 0; // *
}


int
get_long_char(L_CHAR * ch,XL_FILE * f)
{
unsigned char c;
int er;

	for ( ; ; ) {
		if ( f->rb_ptr >= f->rb_len ) {
			er = s_read(f->st,f->rb,XLFILE_BUFFER_SIZE);
			if ( er <= 0 )
				return er;
			f->rb_len = er;
			f->rb_ptr = 1;
			c = f->rb[0];
		}
		else {
			c = f->rb[f->rb_ptr++];
		}
		if ( (*f->cm->to_internal)
				(ch,f->cm_work,c) ) {

			return 1;
		}
	}
}

L_CHAR
get_1char(XL_FILE * f,int * ent_flag)
{
L_CHAR ch;
int er;

	if ( ent_flag )
		*ent_flag = 0;
	if ( f->flags & XLF_CLOSE )
		return 0;
	if ( f->buf ) {
		ch = f->buf;
		if ( ent_flag )
			*ent_flag = f->buf_ent_flag;
		f->buf = 0;
		return ch;
	}
	errno = 0;
retry2:
	er = get_long_char(&ch,f);
	if ( er < 0 ) {
		if ( errno == ESYS_AGAIN )
			goto retry2;
/*
		perror("");
*/
		f->lex_error = cons(
			get_error(
				f,
				f->token_head_line,
				XLE_SYSTEM_READ_FILE,
				l_string(std_cm,"lex"),
				list(get_string(
					l_string(std_cm,
						 "cannot read the file")),
				get_string(f->name),
				0)),
			f->lex_error);
		gb_file_delete(f);
		return 0;
	}
	if ( er == 0 ) {
		gb_file_delete(f);
		return 0;
	}
	return ch;
}

int
get_nchar(XL_FILE * f,char * buf,int len)
{
char ch;
int er;
int size;
int s;
	if ( f->flags & XLF_CLOSE )
		return 0;
	errno = 0;
	if ( f->rb_ptr < f->rb_len ) {
		s = f->rb_len - f->rb_ptr;
		if ( len < s )
			s = len;
		memcpy(buf,&f->rb[f->rb_ptr],s);
		f->rb_ptr += s;
		size = s;
	}
	else	size = 0;
	for ( ; size < len ; ) {
		er = s_read(f->st,&buf[size],len-size);
		if ( er < 0 ) {
			if ( errno ) {
				if ( errno == ESYS_AGAIN )
					continue;
			}
			f->lex_error = cons(
				get_error(f,
					f->token_head_line,
				XLE_SYSTEM_READ_FILE,
					l_string(std_cm,"lex"),
					list(get_string(
				l_string(std_cm,
					 "cannot read the file")),
					get_string(f->name),
					0)),
				f->lex_error);
			return size;
		}
		if ( er == 0 ) {
			gb_file_delete(f);
			return size;
		}
		size += er;
	}
	return size;
}

void
put_1char(XL_FILE * f,L_CHAR ch,int ent_flag)
{
	f->buf = ch;
	f->buf_ent_flag = ent_flag;
}

int
token_text(XL_FILE * f)
{
XL_STRING * s;
	put_data(f,0);
	s = &get_sexp(f,XLT_STRING)->string;
	l_strcpy(f->yytext,&f->yytext[1]);
	f->yytext[l_strlen(f->yytext)-1] = 0;
	s->data = f->yytext;
	f->yytext = 0;
	f->yylen = 0; // *
	return T_SEXP;
}

int
token_symbol(XL_FILE * f)
{
XL_SYMBOL * s;
XL_ERROR * e;
	put_data(f,0);
	if ( l_strcmp(f->yytext,l_string(std_cm,"%E")) == 0 ) {
		e = &get_sexp(f,XLT_ERROR)->err;
		e->data = 0;
		e->filename = ll_copy_mstr(f->name);
		if ( f->site )
			e->site = ll_copy_mstr(f->site);
		else	e->site = nl_copy_mstr(std_cm,"");
		e->func = nl_copy_mstr(std_cm,"");
		e->line = f->token_head_line;
		e->code = 0;
		f->yytext = 0;
		f->yylen = 0; // *
		return T_ERR;
	}
	else {
		s = &get_sexp(f,XLT_SYMBOL)->symbol;
		s->data = f->yytext;
		f->yytext = 0;
		f->yylen = 0; // *
		return T_SEXP;
	}
}

int
token_raw(XL_FILE * f)
{
XL_RAW * s;
	s = &get_sexp(f,XLT_RAW)->raw;
	s->size = f->yylen;
	s->data = (void*)f->yytext;
	f->yytext = 0;
	f->yylen = 0; // *
	return T_SEXP;
}

int
token_oct_hex(XL_FILE * f)
{
XL_INTEGER * i;
int ii;
	put_data(f,0);
	i = &get_sexp(f,XLT_INTEGER)->integer;
	sscanf(n_string(std_cm,f->yytext),"%i",&i->data);
	if ( f->yytext[1] == 'x' ) {
		for ( ii = 2;
			'0' <= f->yytext[ii] &&
			f->yytext[ii] <= '9' ||
			'a' <= f->yytext[ii] &&
			f->yytext[ii] <= 'f' ||
			'A' <= f->yytext[ii] &&
			f->yytext[ii] <= 'F';
			ii ++ );
	}
	else {
		for ( ii = 1;
			'0' <= f->yytext[ii] &&
			f->yytext[ii] <= '7';
			ii ++ );
	}
	if ( f->yytext[ii] == 0 ) {
		i->unit = 0;
		f->yytext = 0;
		f->yylen = 0; // *
		return T_SEXP;
	}
	else {
		l_strcpy(f->yytext,&f->yytext[ii]);
		i->unit = f->yytext;
		f->yytext = 0;
		f->yylen = 0; // *
		return T_SEXP;
	}
}

int
token_number(XL_FILE * f)
{
int i;
union xl_sexp * s;
XL_INTEGER * in;
XL_FLOAT * fn;
int type;
	put_data(f,0);
	type = 0;
	for ( i = 0 ; f->yytext[i] ; i ++ ) {
		if ( f->yytext[i] == '+' )
			continue;
		else if ( f->yytext[i] == '-' )
			continue;
		else if ( f->yytext[i] == '.' )
			type = 1; /* floating */
		else if ( '0' > f->yytext[i] ||
				f->yytext[i] > '9' )
			break;
	}
	if ( type ) {
		s = get_sexp(f,XLT_FLOAT);
		fn = &s->floating;
		sscanf(n_string(std_cm,f->yytext),"%lf",&fn->data);
	}
	else {
		s = get_sexp(f,XLT_INTEGER);
		in = &s->integer;
		sscanf(n_string(std_cm,f->yytext),"%i",&in->data);
	}
	if ( f->yytext[i] == 0 ) {
		s->integer.unit = 0;
		f->yytext = 0;
		f->yylen = 0; // *
		return T_SEXP;
	}
	else {
		l_strcpy(f->yytext,&f->yytext[i]);
		s->integer.unit = f->yytext;
		f->yytext = 0;
		f->yylen = 0; // *
		return T_SEXP;
	}
}

int
get_token(XL_FILE * f)
{

	if ( f->yytext == 0 ) {
		er_panic("get_token(1)\n");
	}
	if ( f->yytext[0] == '"' )
		return token_text(f);
	else if ( f->yytext[0] == '0' ) {
		if ( f->yytext[1] == '.' )
			return token_number(f);
		else	return token_oct_hex(f);
	}
	else if ( f->yytext[0] == '-' ||
			f->yytext[0] == '+' ) {
		if ( f->yytext[1] == '0' ) {
			if ( f->yytext[2] == '.' )
				return token_number(f);
			else	return token_oct_hex(f);
		}
		else if ( '0' < f->yytext[1] &&
				f->yytext[1] <= '9' )
			return token_number(f);
		else	return token_symbol(f);
	}
	else if ( '0' < f->yytext[0] && f->yytext[0] <= '9' )
		return token_number(f);
	else if ( f->yytext[0] == '#' ) {
		er_panic("get_token - token_raw");
		return 0;
	}
	else 	return token_symbol(f);
}

void
pt_line(XL_FILE * f)
{
	sscanf(n_string(std_cm,&f->yytext[2]),"%i",&f->line);
}

int
get_raw_length(XL_FILE * f)
{
L_CHAR * ptr;
int ret;
	for ( ptr = &f->yytext[1]; *ptr != '#'; ptr ++ );
	*ptr = 0;
	sscanf(n_string(std_cm,&f->yytext[1]),"%x",&ret);
	return ret;
}

int
get_x_symbol(XL_FILE * f)
{
XL_SYMBOL * s;
	s = &get_sexp(f,XLT_SYMBOL)->symbol;
	f->yytext = mrealloc(f->yytext,(f->yylen+1)*sizeof(L_CHAR),
		gc_text);
	f->yytext[f->yylen] = 0;
	s->data = f->yytext;
	s->h.flags |= GBF_XML;
	f->yytext = 0;
	f->yylen = 0; // *
	return T_SEXP;
}

int
_get_x_text(XL_FILE * f)
{
XL_STRING * s;
int len;
	len = f->yylen;
	f->yytext = mrealloc(f->yytext,(len+1)*sizeof(L_CHAR),
		gc_text);
	f->yytext[len] = 0;
	s = &get_sexp(f,XLT_STRING)->string;
	s->data = f->yytext;
	s->h.flags |= GBF_XML;
	f->yytext = 0;
	f->yylen = 0; // *
	return T_SEXP;
}
int
get_x_text(XL_FILE * f)
{
XL_STRING * s;
int len;
	len = f->yylen;
	f->yytext = lex_mrealloc(f->yytext,(len+1)*sizeof(L_CHAR),
		gc_text);
	f->yytext[len] = 0;
	if ( f->flags & XLF_TEXT )
		goto next;
	switch ( f->yytext[0] ) {
	case '-':
	case '+':
		if ( '0' <= f->yytext[1] &&
			f->yytext[1] <= '9' ) {
			return get_x_number(f);
		}
		break;
	default:
		if ( '0' <= f->yytext[0] &&
			f->yytext[0] <= '9' ) {
			return get_x_number(f);
		}
	}
next:
	s = &get_sexp(f,XLT_STRING)->string;
	s->data = f->yytext;
	s->h.flags |= GBF_XML;
	f->yytext = 0;
	f->yylen = 0; // *
	return T_SEXP;
}

int
get_x_tag(XL_FILE * f)
{
XL_SYMBOL * s;
int ret;
int len;

if ( memcmp(f->yytext,l_string(std_cm,"</Res"),5*4) == 0 &&
l_strcmp(f->yytext,l_string(std_cm,"</Result>")) )
printf("****************************** %s\n",n_string(std_cm,f->yytext));

	if ( f->yytextlen <= f->yylen ) {
		f->yytext = mrealloc(f->yytext,
			(f->yylen+1)*sizeof(L_CHAR),
			gc_text);
		f->yytextlen = f->yylen+1;
	}
	f->yytext[f->yylen] = 0;
	if ( memcmp(f->yytext,l_string(std_cm,"<?"),2*sizeof(L_CHAR)) == 0 )
		ret = T_TAG_Q;
	else if ( l_strcmp(f->yytext,l_string(std_cm,"<[CDATA[")) == 0 )
		ret = T_TAG_C;
	else if ( memcmp(f->yytext,l_string(std_cm,"<!--"),4*sizeof(L_CHAR))
		  == 0 ) {
		ret = T_TAG_COMMENT;
		f->mode = XLM_X_COMMENT;
		return ret;
	}
	else if ( memcmp(f->yytext,l_string(std_cm,"<!"),
			2*sizeof(L_CHAR)) == 0 )
		ret = T_TAG_E;
	else if ( l_strcmp(f->yytext,l_string(std_cm,"<[")) == 0 )
		ret = T_TAG_P;
	else if ( memcmp(f->yytext,l_string(std_cm,"</"),
			2*sizeof(L_CHAR)) == 0 )
		ret = T_TAG_N;
	else {
		len = l_strlen(f->yytext);
		if ( l_strcmp(&f->yytext[len-2],
				l_string(std_cm,"/>")) == 0 )
			ret = T_TAG_EMP;
		else 	ret = T_TAG;
	}
	if ( ret == T_TAG_N )
		l_strcpy(f->yytext,&f->yytext[2]);
	else	l_strcpy(f->yytext,&f->yytext[1]);
	len = l_strlen(f->yytext);
	if ( f->yytext[len-1] == '>' ) {
		if ( ret != T_TAG && ret != T_TAG_EMP && ret != T_TAG_N &&
				ret != T_TAG_COMMENT ) {
			f->lex_error = cons(
				get_error(
					f,
					f->token_head_line,
					XLE_SYNTAX_TOKEN_ERROR,
					l_string(std_cm,"lex"),
					list(get_string(
						l_string(std_cm,
							 "token error 5")),
						get_string(f->name),
						get_string(f->yytext),
					0)),
				f->lex_error);
			return 0;
		}
		if ( f->yytext[len-2] == '/' ) {
			f->yytext[len-2] = 0;
			len -= 2;
		}
		else {
			f->yytext[len-1] = 0;
			len -= 1;
		}
	}
	else if ( ret == T_TAG )
		ret = T_TAG_F;
	f->yytext = mrealloc(f->yytext,(len+1)*sizeof(L_CHAR),
		gc_text);
	s = &get_sexp(f,XLT_SYMBOL)->symbol;
	s->data = f->yytext;
	s->h.flags |= GBF_XML;
	f->yytext = 0;
	f->yylen = 0; // *
	return ret;
}

int
get_x_tag_end(XL_FILE * f)
{
XL_SYMBOL * s;
int ret;
	if ( f->yytextlen <= f->yylen ) {
		f->yytext = mrealloc(f->yytext,
			(f->yylen+1)*sizeof(L_CHAR),
			gc_text);
		f->yytextlen = f->yylen+1;
	}
	f->yytext[f->yylen] = 0;
	if ( l_strcmp(f->yytext,l_string(std_cm,"?>")) == 0 )
		ret = T_TAG_END_Q;
	else if ( l_strcmp(f->yytext,l_string(std_cm,"]]>")) == 0 )
		ret = T_TAG_END_C;
	else if ( memcmp(f->yytext,l_string(std_cm,"!>"),
			2*sizeof(L_CHAR)) == 0 )
		ret = T_TAG_END_E;
	else if ( l_strcmp(f->yytext,l_string(std_cm,"]>")) == 0 )
		ret = T_TAG_END_P;
	else if ( l_strcmp(f->yytext,l_string(std_cm,"/>")) == 0 )
		ret = T_TAG_END_EMP;
	else if ( l_strcmp(f->yytext,l_string(std_cm,"-->")) == 0 )
		ret = T_TAG_END_COMMENT;
	else {
		f->lex_error = cons(
			get_error(
				f,
				f->token_head_line,
				XLE_SYNTAX_TOKEN_ERROR,
				l_string(std_cm,"lex"),
				list(get_string(
					l_string(std_cm,
						 "token error 1")),
				get_string(f->name),
				0)),
			f->lex_error);
		return 0;
	}
	s = &get_sexp(f,XLT_SYMBOL)->symbol;
	s->data = f->yytext;
	s->h.flags |= GBF_XML;
	f->yytext = 0;
	f->yylen = 0; // *
	return ret;
}

int
get_x_tfield(XL_FILE * f)
{
XL_STRING * s;
	s = &get_sexp(f,XLT_STRING)->string;
	f->yytext = mrealloc(f->yytext,(f->yylen+1)*sizeof(L_CHAR),
		gc_text);
	f->yytext[f->yylen] = 0;
	s->data = f->yytext;
	s->h.flags |= GBF_XML;
	f->yytext = 0;
	f->yylen = 0; // *
	return T_FIELD;
}

int
get_x_ttext(XL_FILE * f)
{
XL_STRING * s;
int len;

	s = &get_sexp(f,XLT_STRING)->string;
	len = f->yylen;
	memmove(f->yytext,&f->yytext[1],(len-2)*sizeof(L_CHAR));
	f->yytext[len-2] = 0;
	f->yytext = mrealloc(f->yytext,
		(len-1)*sizeof(L_CHAR),
		gc_text);
	s->data = f->yytext;
	s->h.flags |= GBF_XML;
	f->yytext = 0;
	f->yylen = 0; // *
	return T_TTEXT;
}


int
get_x_number(XL_FILE * f)
{
XL_SEXP * s;
int len,stop;
char * buf;
int i;
int in_no;
int float_flag;
double fl_no;

	len = f->yylen;
	if ( f->yytextlen <= len ) {
		f->yytext = mrealloc(f->yytext,(len+1)*sizeof(L_CHAR),gc_text);
		f->yytextlen = len+1;
	}
	f->yytext[len] = 0;
	buf = d_alloc((len+1)*sizeof(L_CHAR),15);
	for ( i = 0 ; i < len ; i ++ ) {
		if ( f->yytext[i] &0xffffff00 )
			buf[i] = 255;
		else	buf[i] = f->yytext[i];
	}
	buf[len] = 0;
	if ( buf[0] == '-' )
		i = 1;
	else if ( buf[0] == '+' )
		i = 1;
	else 	i = 0;
	if ( buf[i] == '0' ) {
		if ( buf[i+1] == 'x' || buf[i+1] == 'X' )
			goto hex;
		else 	goto oct_dec_float;
	}
	else goto oct_dec_float;

hex:
	for ( i = i+2 ; i < len ; i ++ ) {
		if ( '0' <= buf[i] && buf[i] <= '9' )
			continue;
		if ( 'a' <= buf[i] && buf[i] <= 'f' )
			continue;
		if ( 'A' <= buf[i] && buf[i] <= 'F' )
			continue;
		break;
	}
	stop = i;
	buf[i] = 0;
	goto integer;

oct_dec_float:
	float_flag = 0;

	for ( i = i+1 ; i < len ; i ++ ) {
		if ( '0' <= buf[i] && buf[i] <= '9' )
			continue;
		if ( buf[i] == '.' ) {
			if ( float_flag ) {
		    		d_f_ree(buf);
				return _get_x_text(f);
			}
			float_flag = 1;
			continue;
		}
		break;
	}
	stop = i;
	buf[i] = 0;
	if ( float_flag )
		goto floating;
	else	goto integer;

integer:
	sscanf(buf,"%i",&in_no);
	s = get_sexp(f,XLT_INTEGER);
	s->integer.data = in_no;
	if ( f->yytext[stop] )
		s->integer.unit = ll_copy_mstr(&f->yytext[stop]);
	else	s->integer.unit = 0;
	goto end;

floating:
	sscanf(buf,"%lf",&fl_no);
	s = get_sexp(f,XLT_FLOAT);
	s->floating.data = fl_no;
	if ( f->yytext[stop] )
		s->floating.unit = ll_copy_mstr(&f->yytext[stop]);
	else	s->floating.unit = 0;
	goto end;

end:
	d_f_ree(buf);
	f->yytext = 0;
	f->yylen = 0; // *
	return T_SEXP;
}

void
push_ent_stack(XL_FILE * f,ENTITY * ent,int mode)
{
ENTITY_STACK * es;
	es = mmalloc(sizeof(*es),gc_entity_stack);
	es->up = f->ent_stack;
	es->ent = ent;
	es->mode = mode;
	es->ptr = ent->data;
	f->ent_stack = es;
}

void
pop_ent_stack(XL_FILE * f)
{
ENTITY_STACK * es;
	if ( f->ent_stack == 0 )
		return;
	es = f->ent_stack;
	f->ent_stack = es->up;
	mfree(es);
}

ENTITY *
search_entity(XL_FILE * f,L_CHAR * name)
{
ENTITY * ent;
	for ( ent = f->entity ; ent ; ent = ent->next )
		if ( l_strcmp(ent->name,name) == 0 )
			return ent;
	return 0;
}

void
new_entity(XL_FILE * f,L_CHAR * name,L_CHAR * data)
{
ENTITY * ent;

	ent = mmalloc(sizeof(*ent),gc_entity);
	ent->name = ll_copy_mstr(name);
	ent->data = ll_copy_mstr(data);
	ent->next = f->entity;
	f->entity = ent;
}


L_CHAR
get_1ent(XL_FILE * f,int * ent_flag)
{
L_CHAR ch;

	*ent_flag = 0;
	if ( f->ent_stack ) {
		switch ( f->ent_stack->mode ) {
		case EST_REPLACE:
			ch = *f->ent_stack->ptr++;
			if ( *f->ent_stack->ptr == 0 )
				pop_ent_stack(f);
			return ch;
		case EST_ENTITY:
			ch = '&';
			f->ent_stack->ptr = f->ent_stack->ent->data;
			f->ent_stack->mode = EST_ENTITY_1;
			return ch;
		case EST_ENTITY_1:
			ch = *f->ent_stack->ptr++;
			if ( *f->ent_stack->ptr == 0 )
				f->ent_stack->mode = EST_ENTITY_2;
			return ch;
		case EST_ENTITY_2:
			ch = ';';
			pop_ent_stack(f);
			return ch;
		default:
			er_panic("get_1ent");
		}
	}
	else {
		return get_1char(f,ent_flag);
	}
	return 0;
}

L_CHAR
gb_lex_entity(int * flag,XL_FILE * f,int mode)
{
L_CHAR ch;
L_CHAR * ent_name;
int ptr;
unsigned int d;
ENTITY * entt;


	*flag = 0;
	if ( mode == EST_IGNORE )
		return get_1char(f,flag);
retry:
	ch = get_1ent(f,flag);
	switch ( ch ) {
	case '&':
		if ( *flag )
			return ch;
		goto ent;
	default:
		return ch;
	}
ent:
	ch = get_1ent(f,flag);
	switch ( ch ) {
	case '#':
	case 'C':
	case 'c':
		goto number;
	default:
		goto entity;
	}
number:
	ch = get_1ent(f,flag);
	switch ( ch ) {
	case 'x':
		goto number_hex;
	default:
		goto number_dec;
	}
number_dec:
	d = 0;
	for ( ; ; ) {
		ch = get_1ent(f,flag);
		if ( ch == ';' ) {
			*flag = 1;
			return (L_CHAR)d;
		}
		else if ( '0' <= ch && ch <= '9' ) {
			d = d * 10;
			d += ch-'0';
		}
		else goto entity_error;
	}
number_hex:
	d = 0;
	for ( ; ; ) {
		ch = get_1ent(f,flag);
		if ( ch == ';' ) {
			*flag = 1;
			return (L_CHAR)d;
		}
		else if ( '0' <= ch && ch <= '9' ) {
			d = d << 4;
			d += ch-'0';
		}
		else if ( 'A' <= ch && ch <= 'F' ) {
			d = d << 4;
			d += ch-'A'+10;
		}
		else if ( 'a' <= ch && ch <= 'f' ) {
			d = d << 4;
			d += ch-'a'+10;
		}
		else goto entity_error;
	}

entity:
	ent_name = d_alloc(sizeof(L_CHAR)*2,16);
	ptr = 1;
	ent_name[0]= ch;
	for ( ; ; ) {
		ch = get_1ent(f,flag);
		switch ( ch ) {
		case ';':
			ent_name = d_re_alloc(ent_name,sizeof(L_CHAR)*(1+ptr));
			ent_name[ptr] = 0;
			goto entity_end;
		case 0:
			d_f_ree(ent_name);
			goto entity_error;
		default:
			ent_name = d_re_alloc(ent_name,sizeof(L_CHAR)*(1+ptr));
			ent_name[ptr] = ch;
			ptr ++;
		}
	}
entity_end:
	entt = search_entity(f,ent_name);
	d_f_ree(ent_name);
	if ( entt == 0 )
		goto entity_error;
	push_ent_stack(f,entt,mode);
	goto retry;

entity_error:
	f->lex_error = cons(
		get_error(
			f,
			f->token_head_line,
			XLE_SYNTAX_INVALID_ENTITY,
			l_string(std_cm,"lex"),
			list(get_string(
				l_string(std_cm,
					 "invalid entity")),
				0)),
		f->lex_error);
	return 0;
}


int
_gb_lex(XL_FILE * f,int ent_mode)
{
L_CHAR ch,ch2;
int ent_flag;
CODE_METHOD * cm;

	if ( f->flags & XLF_CLOSE ) {
		f->error = E_GBOPEN;
		return -1;
	}
	f->sexp = 0;
gb_read:

	ch = gb_lex_entity(&ent_flag,f,ent_mode);
/*
{
extern int test_gb;
if ( test_gb )
printf("+%c:%i / ",(char)ch,f->token_head_line);
}
*/
	if ( (ch&LCZM_2B_TYPE) == LCZ_2BC_LCCODE ) {
		cm = search_cm_by_lccode(ch);
		if ( cm ) {
			(*f->cm->close)(0,f->cm_work);
			f->cm = cm;
			f->cm_work = (*f->cm->open)();
		}
		goto gb_read;
	}

	switch ( ch ) {
	case C_CANCEL:
		f->mode = XLM_X_WAIT;
		f->flags &= ~(XLF_L_MODE|XLF_EQUAL);
		if ( !(f->flags & XLF_FIX_LINE) )
			f->line ++;
		return ch;
	}
	switch ( f->mode ) {
	case XLM_X_CRSP:
		goto p_x_crsp;
	case XLM_X_NUMBER:
		goto p_x_number;
	case XLM_X_COMMENT2:
		goto p_x_comment2;
	case XLM_X_COMMENT1:
		goto p_x_comment1;
	case XLM_X_COMMENT:
		goto p_x_comment;
	case XLM_X_TAG_END_Q1:
		goto p_x_tag_end;
	case XLM_X_TAG_END1:
		goto p_x_tag_end;
	case XLM_X_TAG_END:
		goto p_x_tag_end;
	case XLM_X_TWAIT:
		goto p_x_twait;
	case XLM_X_TFIELD:
		goto p_x_tfield;
	case XLM_X_TTEXT:
		goto p_x_ttext;
	case XLM_X_TAG:
		goto p_x_tag;
	case XLM_X_TEXT:
		goto p_x_text;
	case XLM_X_WAIT:
		goto p_x_wait;
	case XLM_L_WAIT:
		goto p_l_wait;
	case XLM_L_SYMBOL:
		goto p_l_symbol;
	case XLM_L_TEXT:
		goto p_l_text;
	case XLM_L_COMMENT:
		goto p_l_comment;
	case XLM_L_RAW:
		goto p_l_raw;
	default:
		fprintf(stderr,"gb_lex(1) %i\n",f->mode);
		er_panic("gb_lex(1)");
	}

p_x_wait:
	if ( ent_flag )
		goto def;
	if ( f->flags & XLF_L_MODE )
		goto p_l_wait;
	switch ( ch ) {
	case 0:
		return 0;
	case 0xe:

		if ( f->func_14 )
			(*f->func_14)(f);
		goto gb_read;
	case 0xc:

		f->line = 0;
		s_set_cr(f->st,1);
		if ( f->func_12 )
			(*f->func_12)(f);
		goto gb_read;
	case 0xb:

		if ( f->func_11 )
			(*f->func_11)(f);
		goto gb_read;
	case ' ':
	case '\t':
		goto gb_read;
	case '\n':
	case '\r':
		if ( !(f->flags & XLF_FIX_LINE) )
			f->line ++;
		goto gb_read;
	case '(':
		if ( f->flags & XLF_TEXT )
			goto def;
		token_head(f);
		put_1char(f,ch,ent_flag);
		f->mode = XLM_L_WAIT;
		f->flags |= XLF_L_MODE;
		goto gb_read;
	case '<':
		token_head(f);
		put_data(f,ch);
		f->mode = XLM_X_TAG;
		goto gb_read;
	case '^':
		token_head(f);
		f->mode = XLM_L_WAIT;
		f->flags |= XLF_L_MODE;
		goto gb_read;
	default:
	def:
		token_head(f);
		put_data(f,ch);
		if ( (f->flags&XLF_TEXT) == 0 && '0' <= ch && ch <= '9' )
			f->mode = XLM_X_NUMBER;
		else	f->mode = XLM_X_TEXT;
		goto gb_read;
	}

p_x_number:
	switch ( ch ) {
	case 0:
		return get_x_number(f);
	case ' ':
	case '\t':
		f->mode = XLM_X_WAIT;
		return get_x_number(f);
	case '\n':
	case '\r':
		if ( !(f->flags & XLF_FIX_LINE) )
			f->line ++;
		f->mode = XLM_X_WAIT;
		return get_x_number(f);
	case '\\':
		f->mode = XLM_X_WAIT;
		return get_x_number(f);
	case '<':
		put_1char(f,ch,ent_flag);
		f->mode = XLM_X_WAIT;
		return get_x_number(f);
	case '(':
		if ( f->flags & XLF_TEXT )
			goto def13;
		put_1char(f,ch,ent_flag);
		f->mode = XLM_L_WAIT;
		return get_x_number(f);
	case '^':
		put_1char(f,ch,ent_flag);
		f->mode = XLM_X_WAIT;
		return get_x_number(f);
	default:
	def13:
		put_data(f,ch);
		goto gb_read;
	}

p_x_text:
	if ( ent_flag )
		goto def2;
	switch ( ch ) {
	case 0:
		return get_x_text(f);
	case ' ':
	case '\t':
		put_1char(f,ch,ent_flag);
		f->mode = XLM_X_CRSP;
		return get_x_text(f);
	case '\n':
	case '\r':
		f->mode = XLM_X_CRSP;
		put_1char(f,ch,ent_flag);
		return get_x_text(f);
	case '<':
		put_1char(f,ch,ent_flag);
		f->mode = XLM_X_WAIT;
		return get_x_text(f);
	case '(':
		if ( f->flags & XLF_TEXT )
			goto def2;
		put_1char(f,ch,ent_flag);
		f->mode = XLM_L_WAIT;
		return get_x_text(f);
	case '^':
		put_1char(f,ch,ent_flag);
		f->mode = XLM_X_WAIT;
		return get_x_text(f);
	default:
	def2:
		put_data(f,ch);
		goto gb_read;
	}

p_x_crsp:
	switch ( ch ) {
	case 0:
		if ( f->yytext == 0 || f->yylen == 0 )
			return 0;
		return get_x_text(f);
	case ' ':
	case '\t':
		if ( !(f->flags & XLF_X_NO_SP) )
			put_data(f,ch);
		goto gb_read;
	case '\n':
	case '\r':
		if ( !(f->flags & XLF_FIX_LINE) )
			f->line ++;
		if ( !(f->flags & XLF_X_NO_CR) )
			put_data(f,ch);
		goto gb_read;
	case '<':
		put_1char(f,ch,ent_flag);
		reset_yytext(f);
		f->mode = XLM_X_WAIT;
		goto gb_read;
	case '(':
		if ( f->flags & XLF_TEXT )
			goto def4;
		put_1char(f,ch,ent_flag);
		reset_yytext(f);
		f->mode = XLM_L_WAIT;
		goto gb_read;
	case '^':
		put_1char(f,ch,ent_flag);
		f->mode = XLM_X_WAIT;
		reset_yytext(f);
		goto gb_read;
	default:
	def4:
		put_1char(f,ch,ent_flag);
		f->mode = XLM_X_WAIT;
		if ( f->yytext == 0 || f->yylen == 0 )
			goto gb_read;
		return get_x_text(f);
	}

p_x_tag:
	switch ( ch ) {
	case 0:
		f->lex_error = cons(
			get_error(
				f,
				f->token_head_line,
				XLE_SYNTAX_UNSUTISFIED_FILE_END,
				l_string(std_cm,"lex"),
				list(get_string(
					l_string(std_cm,
						 "unsutisfied file end")),
				get_string(f->name),
				0)),
			f->lex_error);
		return 0;
	case '>':
		put_data(f,ch);
		f->mode = XLM_X_WAIT;
		return get_x_tag(f);
	case ' ':
	case '\t':
		f->mode = XLM_X_TWAIT;
		return get_x_tag(f);
	case '\n':
	case '\r':
		if ( !(f->flags & XLF_FIX_LINE) )
			f->line ++;
		f->mode = XLM_X_TWAIT;
		return get_x_tag(f);
	default:
		put_data(f,ch);
		goto gb_read;
	}
p_x_twait:
	switch ( ch ) {
	case 0:
		f->lex_error = cons(
			get_error(
				f,
				f->token_head_line,
				XLE_SYNTAX_UNSUTISFIED_FILE_END,
				l_string(std_cm,"lex"),
				list(get_string(
					l_string(std_cm,
						 "unsutisfied file end")),
				get_string(f->name),
				0)),
			f->lex_error);
		return 0;
	case ' ':
	case '\t':
		goto gb_read;
	case '\n':
	case '\r':
		if ( !(f->flags & XLF_FIX_LINE) )
			f->line ++;
		goto gb_read;
	case '"':
		put_data(f,ch);
		f->mode = XLM_X_TTEXT;
		goto gb_read;
	case '=':
		return ch;
	case '/':
		put_data(f,ch);
		f->mode = XLM_X_TAG_END;
		goto gb_read;
	case ']':
		put_data(f,ch);
		f->mode = XLM_X_TAG_END1;
		goto gb_read;
	case '?':
		put_data(f,ch);
		f->mode = XLM_X_TAG_END;
		goto gb_read;
	case '!':
		put_data(f,ch);
		f->mode = XLM_X_TAG_END;
		goto gb_read;
	case '>':
		f->mode = XLM_X_WAIT;
		return ch;
	default:
		put_data(f,ch);
		f->mode = XLM_X_TFIELD;
		goto gb_read;
	}
p_x_tfield:
	switch ( ch ) {
	case 0:
		f->lex_error = cons(
			get_error(
				f,
				f->token_head_line,
				XLE_SYNTAX_UNSUTISFIED_FILE_END,
				l_string(std_cm,"lex"),
				list(get_string(
					l_string(std_cm,
						 "unsutisfied file end")),
				get_string(f->name),
				0)),
			f->lex_error);
		return 0;
	case ' ':
	case '\t':
		f->mode = XLM_X_TWAIT;
		put_1char(f,ch,ent_flag);
		return get_x_tfield(f);
	case '\r':
	case '\n':
		if ( !(f->flags & XLF_FIX_LINE) )
			f->line ++;
		f->mode = XLM_X_TWAIT;
		put_1char(f,ch,ent_flag);
		return get_x_tfield(f);
	case '(':
	case ')':
		if ( f->flags & XLF_TEXT )
			goto def5;
	case '=':
	case '>':
		f->mode = XLM_X_TWAIT;
		put_1char(f,ch,ent_flag);
		return get_x_tfield(f);
	default:
	def5:
		put_data(f,ch);
		goto gb_read;
	}
p_x_ttext:
	switch ( ch ) {
	case '\r':
	case '\n':
		if ( !(f->flags & XLF_FIX_LINE) )
			f->line ++;
		put_data(f,ch);
		goto gb_read;
	case 0:

		f->lex_error = cons(
			get_error(
				f,
				f->token_head_line,
				XLE_SYNTAX_UNSUTISFIED_FILE_END,
				l_string(std_cm,"lex"),
				list(get_string(
					l_string(std_cm,
						 "unsutisfied file end")),
				get_string(f->name),
				0)),
			f->lex_error);
		return 0;
	case '\\':
		ch2 = get_1char(f,0);
		switch ( ch2 ) {
		case '"':
			put_data(f,ch2);
			break;
		case 'n':
			put_data(f,'\n');
			break;
		case 'r':
			put_data(f,'\r');
			break;
		case 't':
			put_data(f,'\t');
			break;
		case '\\':
			put_data(f,'\\');
			break;
		default:
			put_data(f,ch);
			put_data(f,ch2);
		}
		goto gb_read;
	case '"':
		put_data(f,ch);
		f->mode = XLM_X_TWAIT;
		return get_x_ttext(f);
	default:
		put_data(f,ch);
		goto gb_read;
	}
p_x_tag_end1:
	switch ( ch ) {
	case 0:
		f->lex_error = cons(
			get_error(
				f,
				f->token_head_line,
				XLE_SYNTAX_UNSUTISFIED_FILE_END,
				l_string(std_cm,"lex"),
				list(get_string(
					l_string(std_cm,
						 "unsutisfied file end")),
				get_string(f->name),
				0)),
			f->lex_error);
		return 0;
	case '>':
		put_data(f,ch);
		f->mode = XLM_X_WAIT;
		return get_x_tag_end(f);
	case ']':
		put_data(f,ch);
		f->mode = XLM_X_TAG_END;
		goto gb_read;
	default:
		put_data(f,ch);
		f->lex_error = cons(
			get_error(
				f,
				f->token_head_line,
				XLE_SYNTAX_TOKEN_ERROR,
				l_string(std_cm,"lex"),
				list(get_string(
					l_string(std_cm,
						 "token error 2")),
					get_string(f->yytext),
				0)),
			f->lex_error);
		return 0;
	}
p_x_tag_end:
	switch ( ch ) {
	case 0:
		f->lex_error = cons(
			get_error(
				f,
				f->token_head_line,
				XLE_SYNTAX_UNSUTISFIED_FILE_END,
				l_string(std_cm,"lex"),
				list(get_string(
					l_string(std_cm,
						 "unsutisfied file end")),
					get_string(f->name),
				0)),
			f->lex_error);
		return 0;
	case '>':
		put_data(f,ch);
		f->mode = XLM_X_WAIT;
		return get_x_tag_end(f);;
	default:
		put_data(f,ch);
		f->lex_error = cons(
			get_error(
				f,
				f->token_head_line,
				XLE_SYNTAX_TOKEN_ERROR,
				l_string(std_cm,"lex"),
				list(get_string(
					l_string(std_cm,
						 "token error 3")),
					get_string(f->yytext),
				0)),
			f->lex_error);
		return 0;
	}

p_x_comment:
	switch ( ch ) {
	case 0:
		return 0;
	case '-':
		f->mode = XLM_X_COMMENT1;
		goto gb_read;
	case '\n':
	case '\r':
		if ( !(f->flags & XLF_FIX_LINE) )
			f->line ++;
		goto gb_read;
	default:
		goto gb_read;
	}

p_x_comment1:
	switch ( ch ) {
	case 0:
		return 0;
	case '-':
		f->mode = XLM_X_COMMENT2;
		goto gb_read;
	case '\n':
	case '\r':
		if ( !(f->flags & XLF_FIX_LINE) )
			f->line ++;
		f->mode = XLM_X_COMMENT;
		goto gb_read;
	default:
		f->mode = XLM_X_COMMENT;
		goto gb_read;
	}

p_x_comment2:
	switch ( ch ) {
	case 0:
		return 0;
	case '-':
		goto gb_read;
	case '>':
		f->mode = XLM_X_WAIT;
		f->yytext = 0;
		f->yylen = 0; // *
		return T_TAG_END_COMMENT;
	case '\n':
	case '\r':
		if ( !(f->flags & XLF_FIX_LINE) )
			f->line ++;
		goto gb_read;
	default:
		f->mode = XLM_X_COMMENT;
		goto gb_read;
	}

p_l_wait:
	if ( !(f->flags & XLF_L_MODE) )
		goto p_x_wait;
	if ( ent_flag )
		goto def10;
	switch ( ch ) {
	case 0:
		return 0;
	case ' ':
	case '\t':
		goto gb_read;
	case '(':
		if ( f->flags & XLF_TEXT )
			goto def10;
		token_head(f);
		return ch;
	case ')':
		if ( f->flags & XLF_TEXT )
			goto def10;
		token_head(f);
		return ch;
	case '[':
		token_head(f);
		return ch;
	case ']':
		token_head(f);
		return ch;
	case '\'':
		token_head(f);
		return ch;
	case '"':
		token_head(f);
		put_data(f,ch);
		f->mode = XLM_L_TEXT;
		goto gb_read;
	case '\n':
	case '\r':
		if ( !(f->flags & XLF_FIX_LINE) )
			f->line ++;
		goto gb_read;
	case ';':
		f->mode = XLM_L_COMMENT;
		goto gb_read;
	case '#':
		token_head(f);
		put_data(f,ch);
		f->mode = XLM_L_RAW;
		goto gb_read;
	case '<':
		put_1char(f,ch,ent_flag);
		f->mode = XLM_X_WAIT;
		f->flags &= ~XLF_L_MODE;
		goto gb_read;
	case '=':
		if ( f->flags & XLF_EQUAL ) {
			token_head(f);
			return ch;
		}
	default:
	def10:
		token_head(f);
		put_data(f,ch);
		f->mode = XLM_L_SYMBOL;
		goto gb_read;
	}
p_l_symbol:

	if ( ent_flag )
		goto def11;
	switch ( ch ) {
	case 0:
	case ' ':
	case '\t':
		f->mode = XLM_L_WAIT;
		return get_token(f);
	case '(':
	case ')':
		if ( f->flags & XLF_TEXT )
			goto def11;
	case '\'':
	case '"':
	case ';':
	case '<':
		put_1char(f,ch,ent_flag);
		f->mode = XLM_L_WAIT;
		return get_token(f);
	case '\n':
	case '\r':
		f->line ++;
		f->mode = XLM_L_WAIT;
		return get_token(f);
	case '=':
		if ( f->flags & XLF_EQUAL ) {
			put_1char(f,ch,ent_flag);
			f->mode = XLM_L_WAIT;
			return get_token(f);
		}
	default:
	def11:
		put_data(f,ch);
		goto gb_read;
	}
p_l_text:
	if ( ent_flag )
		goto def3;
	switch ( ch ) {
	case 0:
		f->lex_error = cons(
			get_error(
				f,
				f->token_head_line,
				XLE_SYNTAX_UNSUTISFIED_FILE_END,
				l_string(std_cm,"lex"),
				list(get_string(
					l_string(std_cm,
						 "unsutisfied file end")),
				get_string(f->name),
				0)),
			f->lex_error);
		return 0;
	case '\n':
	case '\r':
		f->line ++;
		f->lex_error = cons(
			get_error(
				f,
				f->token_head_line,
				XLE_SYNTAX_UNTERMINATED_TEXT,
				l_string(std_cm,"lex"),
				list(get_string(
					l_string(std_cm,
						 "unterminated text")),
				get_string(f->name),
				0)),
			f->lex_error);
		f->mode = XLM_L_WAIT;
		return get_token(f);
	case '"':
		put_data(f,ch);
		f->mode = XLM_L_WAIT;
		return get_token(f);
	case '\\':
		ch2 = get_1char(f,0);
		switch ( ch2 ) {
		case '"':
			put_data(f,ch2);
			break;
		case 'n':
			put_data(f,'\n');
			break;
		case 'r':
			put_data(f,'\r');
			break;
		case 't':
			put_data(f,'\t');
			break;
		case '\\':
			put_data(f,'\\');
			break;
		default:
			put_data(f,ch);
			put_data(f,ch2);
		}
		goto gb_read;
	default:
	def3:
		put_data(f,ch);
		goto gb_read;
	}
p_l_raw:
	switch ( ch ) {
	case 0:
		f->mode = XLM_L_WAIT;
		return get_token(f);
	case '#':
		put_data(f,ch);
		break;
	default:
		put_data(f,ch);
		goto gb_read;
	}
	{
	int len,len1;
		f->yytextlen = -1;
		len = get_raw_length(f);
		f->yytext = mrealloc(f->yytext,len,
			gc_text);
		len1 = get_nchar(f,(char*)f->yytext,len);
		if ( len1 < len ) {
			f->yytext = mrealloc(f->yytext,
					     len1,
				gc_text);
			len = len1;
			f->mode = XLM_L_WAIT;
			return 0;
		}
		else {
			f->yylen = len;
		}
	}
	f->mode = XLM_L_WAIT;
	return token_raw(f);
p_l_comment:

	switch ( ch ) {
	case 0:
		return 0;
	case '\n':
	case '\r':
		f->line ++;
		f->mode = XLM_L_WAIT;
		goto gb_read;
	default:
		goto gb_read;
	}
}

int
check_html_emp(XL_SEXP * s)
{
unsigned char * p;
int i;
L_CHAR * pp;
	if ( s->h.type != XLT_SYMBOL )
		er_panic("check_html_emp");
	for ( pp = s->symbol.data ; *pp ; pp ++ )
		if ( (*pp)&0xffffff00 )
			return -1;
	for ( i = 0 ; ; i ++ ) {
		p = emp_tag_table[i];
		if ( *p == 0 )
			break;
		pp = s->symbol.data;
		for ( ; *pp && *p ; ) {
			if ( *pp != (L_CHAR)*p )
				goto no_match;
			pp ++;
			p ++;
		}
		if ( *pp == 0 && *p == 0 )
			return 0;
	no_match:
		{}
	}
	return -1;
}


int
__gb_lex(XL_FILE * f)
{
int t;
XL_SEXP * s;
int start_tag;
XL_SYM_FIELD * sf, ** sfp;
L_CHAR * field_name;
L_CHAR * msg;

restart:
	t = _gb_lex(f,EST_REPLACE);
	switch ( t ) {
	case T_TAG_COMMENT:
		goto comment;
	case T_TAG_F:
	case T_TAG_C:
	case T_TAG_Q:
	case T_TAG_E:
	case T_TAG_P:
		start_tag = t;
		break;
	case '[':
		goto p_l_symbol;
	case T_ERR:
	case '\'':
		return t;
	case T_TAG:
		if ( f->flags & XLF_HTML ) {
			if ( check_html_emp(f->sexp) == 0 )
				return T_TAG_EMP;
		}
		return t;
	default:
		return t;
	}
	s = f->sexp;
p_wait:
	t = _gb_lex(f,EST_REPLACE);
p_wait_2:
/*
if ( t >= 256 )
printf("t2 %x %s\n",t,n_string(std_cm,f->sexp->string.data));
else
printf("t2 %x\n",t);
*/
	if ( (t&TM_TYPE) == TT_TAG_END ) {
		if ( start_tag == T_TAG_F && t == T_TAG_END_EMP ) {
			f->sexp = s;
			return T_TAG_EMP;
		}
		if ( (start_tag&TM_SUBTYPE) != (t&TM_SUBTYPE) ) {
			msg = l_string(std_cm,"not correspond end tag");
			goto err;
		}
		f->sexp = s;
		return start_tag;
	}
	switch ( t ) {
	case T_FIELD:
		field_name = f->sexp->string.data;
		goto p_field_name;
	case T_TTEXT:
		sf = mmalloc(sizeof(*sf),gc_gb_sym_field);
		field_name = sf->name = nl_copy_mstr(std_cm,"!text");
		sf->data = f->sexp->string.data;
		sf->next = 0;
		for ( sfp = &s->symbol.field ; *sfp ; sfp = &(*sfp)->next )
			if ( l_strcmp((*sfp)->name,field_name) == 0 ) {
				(*sfp)->data = f->sexp->string.data;
				mfree(sf);
				goto p_wait;
			}
		*sfp = sf;
		goto p_wait;
	case '>':
		if ( (f->flags&XLF_HTML) == 0 &&
				start_tag != T_TAG_F ) {
			msg = l_string(std_cm,"not correspond end tag");
			goto err;
		}
		f->sexp = s;
		if ( f->flags & XLF_HTML )
			if ( check_html_emp(f->sexp) == 0 )
				return T_TAG_EMP;
		return T_TAG;
	default:
		msg = l_string(std_cm,
			"attribute syntax error.");
		goto err;
	}
p_field_name:
	t = _gb_lex(f,EST_REPLACE);
	if ( t != '=' ) {
		sf = mmalloc(sizeof(*sf),gc_gb_sym_field);
		sf->name = field_name;
		sf->data = nl_copy_mstr(std_cm,"!on");
		sf->next = 0;
		for ( sfp = &s->symbol.field ; *sfp ; sfp = &(*sfp)->next )
			if ( l_strcmp((*sfp)->name,field_name) == 0 ) {
				(*sfp)->data = nl_copy_mstr(std_cm,"!on");
				mfree(sf);
				goto p_wait_2;
			}
		*sfp = sf;
		goto p_wait_2;
	}
p_field_data:
	t = _gb_lex(f,EST_REPLACE);
	if ( t != T_TTEXT && t != T_FIELD ) {
		msg = l_string(std_cm,
			"text is required 1");
		goto err;
	}
	sf = mmalloc(sizeof(*sf),gc_gb_sym_field);
	sf->name = field_name;
	sf->data = f->sexp->string.data;
	sf->next = 0;
	for ( sfp = &s->symbol.field ; *sfp ; sfp = &(*sfp)->next )
		if ( l_strcmp((*sfp)->name,field_name) == 0 ) {
			(*sfp)->data = f->sexp->string.data;
			mfree(sf);
			goto p_wait;
		}
	*sfp = sf;
	goto p_wait;
p_l_symbol:
	f->flags |= XLF_EQUAL;
	t = _gb_lex(f,EST_REPLACE);
	if ( t != T_SEXP ) {
		msg = l_string(std_cm,"symbol is required");
		f->flags &= ~XLF_EQUAL;
		goto err;
	}
	s = f->sexp;
	if ( s->h.type != XLT_SYMBOL ) {
		msg = l_string(std_cm,"symbol is required");
		f->flags &= ~XLF_EQUAL;
		goto err;
	}
p_l_wait:
	t = _gb_lex(f,EST_REPLACE);
	switch ( t ) {
	case T_SEXP:
		if ( f->sexp->h.type != XLT_SYMBOL ) {
			msg = l_string(std_cm,
				"field name is required");
			f->flags &= ~XLF_EQUAL;
			goto err;
		}
		field_name = f->sexp->symbol.data;
		goto p_l_field_name;
	case ']':
		f->sexp = s;
		f->flags &= ~XLF_EQUAL;
		return T_SEXP;
	default:
		msg = l_string(std_cm,
			"only field description can be used in a tag");
		f->flags &= ~XLF_EQUAL;
		goto err;
	}
p_l_field_name:
	t = _gb_lex(f,EST_REPLACE);
	if ( t != '=' ) {
		msg = l_string(std_cm,
			"\"=\" is required");
		f->flags &= ~XLF_EQUAL;
		goto err;
	}
p_l_field_data:
	t = _gb_lex(f,EST_ENTITY);
	if ( t != T_SEXP ) {
		msg = l_string(std_cm,
			"text is required 2");
		f->flags &= ~XLF_EQUAL;
		goto err;
	}
	if ( f->sexp->h.type != XLT_STRING ) {
		msg = l_string(std_cm,
			"text is required 3");
		f->flags &= ~XLF_EQUAL;
		goto err;
	}
	sf = mmalloc(sizeof(*sf),gc_gb_sym_field);
	sf->name = field_name;
	sf->data = f->sexp->string.data;
	sf->next = 0;
	for ( sfp = &s->symbol.field ; *sfp ; sfp = &(*sfp)->next )
		if ( l_strcmp((*sfp)->name,field_name) == 0 ) {
			(*sfp)->data = f->sexp->string.data;
			mfree(sf);
			goto p_wait;
		}
	*sfp = sf;
	goto p_l_wait;

err:
	f->lex_error = cons(
		get_error(
		f,
			f->token_head_line,
			XLE_SYNTAX_TOKEN_ERROR,
			l_string(std_cm,"lex"),
			List(get_string(
				l_string(std_cm,
					 "token error 4")),
				get_string(f->name),
				get_string(f->yytext),
				get_string(msg),
				-1)),
		f->lex_error);
	return 0;

comment:

	if ( l_strcmp(&f->yytext[
			l_strlen(f->yytext)-3],
			l_string(std_cm,"-->")) == 0 ) {
		f->mode = XLM_X_WAIT;
		f->yytext = 0;
		f->yylen = 0; // *
		goto restart;
	}
	for ( ; _gb_lex(f,EST_IGNORE) != T_TAG_END_COMMENT ; );
	goto restart;
}


int
gb_lex(XL_FILE * f)
{
int ret;
	ret = __gb_lex(f);
	return ret;
}
