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

XL_SEXP *
xl_mxCompound(XLISP_ENV * env,XL_SEXP * s,XLISP_ENV * a,XL_SYM_FIELD * sf);
void * mx_glay_compress_1(int * ,MATRIX_DH_SET * d1);
void * mx_glay_compress_2(int * ,MATRIX_DH_SET * d1);
void * mx_jpeg_compress_1(int * ,MATRIX_DH_SET * d1);
void * mx_jpeg_compress_2(int * ,MATRIX_DH_SET * d1);
void set_recordlist_code(RECORD_LIST64 * rl,CHAIN_LIST64 * ptr);

void
init_mxCompound(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"mxCompound"),
		get_func_prim(xl_mxCompound,FO_APPLICATIVE,0,2,-1));
}


void
set_recordlist_code(RECORD_LIST64 * rl,CHAIN_LIST64 * ptr)
{
int size;
CHAIN_LIST64 * p;
unsigned char * buffer;
unsigned char * pp,*qq;
	size = 0;
	for ( p = ptr ; p ; p = p->next )
		size += p->len;
	pp = buffer = d_alloc(sizeof(INTEGER64)+1);
	qq = get_compressed_code64(pp,size);
	set_recordlist_chain64_middle(rl,ptr,buffer,qq - pp,1);
	d_f_ree(buffer);
}



XL_SEXP *
xl_mxCompound(XLISP_ENV * env,XL_SEXP * s,XLISP_ENV * a,XL_SYM_FIELD * sf)
{
void * d1;
MATRIX_DH_SET ds;
MATRIX_ALLOC_BLOCK_PARAM * bp;
MATRIX_TOKEN * t;
XL_SEXP * ret;
void * d;
MATRIX_ALLOC_BLOCK_PARAM p;
RECORD_LIST64 * rl;
CHAIN_LIST64 * rl_ptr;
PN64_HEADER * hd;

XL_SEXP * inp;
char type;
int len;
char * str;
INTEGER64 integer;
double ft;
	t = get_env_work(env);
	if ( t == 0 )
		return 0;

	rl = new_recordlist64(0,sizeof(PN64_HEADER));
	for ( ; get_type(s) == XLT_PAIR ; s = cdr(s) ) {
		inp = car(s);
		switch ( get_type(inp) ) {
		case XLT_PAIR:
			inp = get_el(inp,2);
			switch ( get_type(inp) ) {
			case XLT_PTR:
			case XLT_RAW:
				goto raw;
			}
			goto inv_param;
		case XLT_PTR:
		case XLT_RAW:
		raw:
			d1 = get_vdata_from_sexp(get_el(s,1));

			if ( d1 == 0 )
				goto inv_param;
			ds.hd = d1;
			switch ( ds.hd->type ) {
			case MDT_BLOCK:
				bp = d1;
				set_recordlist_chain64(rl,&bp->h.type,sizeof(bp->h.type),0);
				rl_ptr = rl->chain_tail;
				set_recordlist_chain64(rl,bp->block,bp->size,0);
				break;
			default:
				get_matrix_dh_set(&ds,d1);
				set_recordlist_chain64(rl,&ds.hd->type,sizeof(hd->type),0);
				rl_ptr = rl->chain_tail;
				(*ds.tp->convert_to_net)(
					ds.tp,rl,d1);
				break;
			}
			break;
		case XLT_INTEGER:
			type = MDT_INT64;
			set_recordlist_chain64(rl,&type,sizeof(type),0);
			rl_ptr = rl->chain_tail;
			integer = inp->integer.data;
			change_endian(integer);
			set_recordlist_chain64(rl,&integer,sizeof(integer),0);
			break;
		case XLT_FLOAT:
			type = MDT_DOUBLE;
			set_recordlist_chain64(rl,&type,sizeof(type),0);
			rl_ptr = rl->chain_tail;
			ft = inp->floating.data;
			change_endian(ft);
			set_recordlist_chain64(rl,&ft,sizeof(ft),0);
			break;
		case XLT_STRING:
			type = MDT_STRING;
			set_recordlist_chain64(rl,&type,sizeof(type),0);
			rl_ptr = rl->chain_tail;
			str = n_string(&utf8_cm,inp->string.data);
			len = strlen(str);
			set_recordlist_chain64(rl,str,len,0);
			break;
		default:
			goto type_missmatch;
		}
		set_recordlist_code(rl,rl_ptr);
	}


	setup_recordlist64(rl);
	hd = rl->data;
	change_endian_header64(hd);

	p.block = hd+1;
	p.size = hd->size - sizeof(*hd);
	
	d = (*mx_type_block.alloc_data)(&mx_type_block,MD_MMALLOC,&p,0,
			__FILE__,__LINE__);
	d_f_ree(p.block);

	ret = List(
		n_get_symbol("data"),
		get_sexp_from_dim_code(t->process_node->matrix,t->process_node->dim_code),
		get_ptr(d,gc_text),
		-1);
	goto end;

type_missmatch:
	ret = get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"mxCompound"),
		0);
	goto end;

inv_param:
	ret = get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"mxCompound"),
		n_get_string("invalid parameter in mxCompound"));
	goto end;
end:
	return ret;
}





