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



void gc_gb_sexp(XL_SEXP * p);
void gc_gb_delay(XL_DELAY * p);
void gc_gblisp_env(XLISP_ENV * p);


void
gc_unit_alias(UNIT_ALIAS * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gc_unit_alias(p->n_next);
	gc_unit_alias(p->d_next);
	gc_text((char*)p->name);
}

void
gc_system_unit(SYSTEM_UNIT * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gc_system_unit(p->next);
	gc_text((char*)p->name);
}

void
gc_unit_env(UNIT_ENV * p)
{
int i,j;
	for ( ; p ; p = p->next ) {
		if ( p == 0 )
			return;
		if ( TEST_AND_SET(p) )
			return;
		gc_text((char*)p->name);
		for ( i = 0 ; i < HASH_UNIT_SIZE ; i ++ ) {
			gc_unit_alias(p->name_hash[i]);
			gc_unit_alias(p->dim_hash[i]);
		}
		for ( i = 0 ; i < DIM ; i ++ ) {
			gc_system_unit(p->sys_unit[i]);
			gc_text((char*)p->no2su[i]);
			for ( j = 0 ; j < p->no2su_len[i] ; j ++ )
				gc_system_unit(p->no2su[i][j]);
		}
	}
}

void
gc_entity(ENTITY * p)
{
	for ( ; ;) {
		if ( p == 0 )
			return;
		if ( TEST_AND_SET(p) )
			return;
		gc_text((char*)p->name);
		gc_text((char*)p->data);
		p = p->next;
	}
}

void
gc_entity_stack(ENTITY_STACK * p)
{
	for ( ; ; ) {
		if ( p == 0 )
			return;
		if ( TEST_AND_SET(p) )
			return;
		gc_entity(p->ent);
		p = p->up;
	}
}

void
gc_gb_file(XL_FILE * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gc_text((char*)p->name);
	gc_text((char*)p->yytext);
	gc_text((char*)p->site);
	gc_gb_sexp(p->sexp);
	gc_gb_delay(p->stack);
	gc_text((char*)p->comment);
	gc_entity(p->entity);
	gc_entity_stack(p->ent_stack);

	if ( p->close_func )
		(*p->close_func)(CF_GC,p->close_work);
}

void
gcv_gb_header(XL_SEXP_HEADER * p)
{
	if ( p == 0 )
		return;
	gc_gb_file(p->file);
}

void
gc_gb_header(XL_SEXP_HEADER * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gcv_gb_header(p);
}


void
gc_gb_delay(XL_DELAY * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gcv_gb_header(&p->h);
	switch ( p->dtype ) {
	case GBDT_FILE:
	case GBDT_FILE_QUOTE:
		gc_gb_file(p->d.file.f);
		gc_gb_sexp(p->d.file.tag);
		break;
	case GBDT_FUNC:
		(*p->d.func->gc_func)(p->d.func);
		break;
	default:
		er_panic("gc_gb_delay(1)");
	}
	gc_gb_delay(p->next);
}


void
gc_gb_pair(XL_PAIR * p)
{
	for ( ; p ; p = (XL_PAIR*)p->cdr ) {
		if ( p == 0 )
			return;
		if ( p->h.type != XLT_PAIR ) {
			gc_gb_sexp((XL_SEXP*)p);
			return;
		}
		if ( TEST_AND_SET(p) )
			return;
		gcv_gb_header(&p->h);
		gc_gb_sexp(p->car);
	}
}

void
gc_gb_sym_field(XL_SYM_FIELD * p)
{
	for ( ; p ; p = p->next ) {
		if ( p == 0 )
			return;
		if ( TEST_AND_SET(p) )
			return;
		gc_text((char*)p->data);
		gc_text((char*)p->name);
	}
}

void
gc_gb_symbol(XL_SYMBOL * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gcv_gb_header(&p->h);
	gc_text((char*)p->data);
	gc_gb_sym_field(p->field);
}

void
gc_gb_string(XL_STRING * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gcv_gb_header(&p->h);
	gc_text((char*)p->data);
}

void
gc_gb_integer(XL_INTEGER * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gcv_gb_header(&p->h);
	gc_text((char*)p->unit);
}

void
gc_gb_float(XL_FLOAT * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gcv_gb_header(&p->h);
	gc_text((char*)p->unit);
}

void
gc_gb_func(XL_FUNC * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gcv_gb_header(&p->h);
	gc_gblisp_env(p->args_env);
	gc_gblisp_env(p->sp_env);
	gc_gb_sexp(p->l_params);
	gc_gb_sexp(p->l_body);
}

void
gc_gb_ptr(XL_PTR * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gcv_gb_header(&p->h);
	if ( p->gc )
		(*p->gc)(p->ptr);
}

void
gc_gb_raw(XL_RAW * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gcv_gb_header(&p->h);
	gc_text(p->data);
}

void
gc_gb_error(XL_ERROR * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gcv_gb_header(&p->h);
	gc_text((char*)p->site);
	gc_text((char*)p->filename);
	gc_text((char*)p->func);
	gc_gb_sexp(p->data);
}


void
gc_gb_gblisp_env(XL_XLISP_ENV * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gcv_gb_header(&p->h);
	gc_gblisp_env(p->data);
}

extern void * test_ptr;

void
gc_gb_sexp(XL_SEXP * p)
{
	if ( p == 0 )
		return;


	switch ( p->h.type ) {
	case XLT_NULL:
		gc_gb_header(&p->h);
		break;
	case XLT_ERROR:
		gc_gb_error(&p->err);
		break;
	case XLT_PAIR:
		gc_gb_pair(&p->pair);
		break;
	case XLT_SYMBOL:
		gc_gb_symbol(&p->symbol);
		break;
	case XLT_STRING:
		gc_gb_string(&p->string);
		break;
	case XLT_INTEGER:
		gc_gb_integer(&p->integer);
		break;
	case XLT_FLOAT:
		gc_gb_float(&p->floating);
		break;
	case XLT_FUNC:
		gc_gb_func(&p->func);
		break;
	case XLT_DELAY:
		gc_gb_delay(&p->delay);
		break;
	case XLT_PTR:
		gc_gb_ptr(&p->ptr);
		break;
	case XLT_RAW:
		gc_gb_raw(&p->raw);
		break;
	case XLT_ENV:
		gc_gb_gblisp_env(&p->env);
		break;
	default:
		fprintf(stderr,"%i\n",p->h.type);
		er_panic("gc_gb_sexp(1)");
	}
}

void
gc_element(ELEMENT * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gc_text((char*)p->sym);
	gc_element(p->next);
	gc_gb_sexp(p->data);
}

void
gc_gb_env(XL_ENV * p)
{
int i;
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gc_gblisp_env(p->parent);
	for ( i = 0 ; i < ENV_HASH_SIZE ; i ++ )
		gc_element(p->hash[i]);
	gc_element(p->default_sym);
	gc_unit_env(p->uenv);
}

void
gc_gb_env_pair(XL_ENV_PAIR * p)
{
	if ( p == 0 )
		return;
	if ( TEST_AND_SET(p) )
		return;
	gc_gblisp_env(p->env[0]);
	gc_gblisp_env(p->env[1]);
}

void
gc_gblisp_env(XLISP_ENV * p)
{
	if ( p == 0 )
		return;
	switch ( p->type ) {
	case GBET_ENV:
		gc_gb_env(&p->e);
		break;
	case GBET_PAIR:
		gc_gb_env_pair(&p->p);
		break;
	default:
		er_panic("gc_gblisp_env(1)");
	}
}
