kmat 0.0.3

data/ext/kmat/smat/share.c

@@ -0,0 +1,427 @@
+#include "../kmat.h"
+
+// freeze `self' and all submatricies of `self'
+// `self' must be a full-matrix (can't deep_freeze submatrix)
+static void
+km_mat_deep_freeze_func(VALUE *ent, void *null)
+{
+	if ( rb_respond_to(*ent, id_deep_freeze) ) {
+		rb_funcall(*ent, id_deep_freeze, 0);
+	} else {
+		rb_obj_freeze(*ent);
+	}
+}
+static void
+km_mat_deep_freeze0(VALUE self)
+{
+	SMAT *smat = km_mat2smat(self);
+	if ( smat->vtype == VT_VALUE ) {
+		km_smat_each_v(smat, km_mat_deep_freeze_func, NULL);
+	}
+}
+VALUE
+kmm_mat_deep_freeze(VALUE self)
+{
+	SMAT *smat = km_mat2smat(self);
+	if ( smat->stype != ST_FULL ) {
+		rb_raise(km_eShare, "can't deep_freeze submatricies directory. deep_freeze supermatrix instead");
+	}
+	if ( smat->may_have_sub ) {
+		VALUE subs = kmm_mat_submatricies(self);
+		for ( long i=0; i<RARRAY_LEN(subs); i++ ) {
+			km_mat_deep_freeze0(rb_ary_entry(subs, i));
+		}
+	}
+	km_mat_deep_freeze0(self);
+	return self;
+}
+
+typedef int each_obj_callback(void *, void *, size_t, void *);
+void rb_objspace_each_objects(each_obj_callback *callback, void *data);
+int rb_objspace_internal_object_p(VALUE obj);
+
+// return true if `self' has at least one submatrix, otherwise, return false
+struct km_have_sub {
+	bool found;
+	VALUE target;
+};
+static int
+km_have_sub_p(void *vstart, void *vend, size_t stride, void *data)
+{
+	struct km_have_sub *have_sub = (struct km_have_sub *)data;
+	for (VALUE v = (VALUE)vstart; v != (VALUE)vend; v += stride) {
+		if (!rb_objspace_internal_object_p(v)) {
+			if (rb_obj_is_kind_of(v, km_cMat)) {
+				SMAT *smat = km_mat2smat(v);
+				if ( have_sub->target == smat->parent ) {
+					have_sub->found = true;
+					return 1;
+				}
+			}
+		}
+	}
+	return 0;
+}
+VALUE
+kmm_mat_have_submatrix_p(VALUE self)
+{
+	SMAT *smat = km_mat2smat(self);
+	if ( smat->may_have_sub ) {
+		struct km_have_sub data = {false, self};
+		rb_objspace_each_objects(km_have_sub_p, (void *)&data);
+		if ( data.found ) {
+			return Qtrue;
+		} else {
+			smat->may_have_sub = false;
+			return Qfalse;
+		}
+	} else {
+		return Qfalse;
+	}
+}
+
+// the SMAT version of above
+bool
+km_smat_have_submatrix_p(SMAT *smat)
+{
+	if ( smat->may_have_sub ) {
+		VALUE v = km_smat_find_value(smat);
+		if ( v == Qnil ) {
+			rb_raise(km_eInternal, "km_smat_have_submatrix_p has been called with out-of-ruby-controlled Mat struct");
+		} else {
+			return (kmm_mat_have_submatrix_p(v) != Qfalse);
+		}
+	} else {
+		return false;
+	}
+}
+
+// find VALUE of `smat' from ObjectSpace.each_object
+// return Qnil if not found
+struct km_find_value {
+	SMAT *target;
+	VALUE out;
+};
+static int
+km_find_value(void *vstart, void *vend, size_t stride, void *data)
+{
+	struct km_find_value *fv = (struct km_find_value *)data;
+	for (VALUE v = (VALUE)vstart; v != (VALUE)vend; v += stride) {
+		if (!rb_objspace_internal_object_p(v)) {
+			if ( rb_obj_is_kind_of(v, km_cMat) && km_mat2smat(v) == fv->target ) {
+				fv->out = v;
+				return 1;
+			}
+		}
+	}
+	return 0;
+}
+VALUE
+km_smat_find_value(SMAT *smat)
+{
+	struct km_find_value data = {smat, Qnil};
+	rb_objspace_each_objects(km_find_value, (void *)&data);
+	return data.out;
+}
+
+// return an Array submatricies of `self'
+// the return will be nil if `self' is a submatrix (submatrix cannot have a submatrix of itself)
+// the return will be an empty Array ([]) if `self' is full-matrix but does not have any submatricies
+struct km_submx {
+	VALUE parent;
+	VALUE list;
+};
+static int
+km_mat_submx(void *vstart, void *vend, size_t stride, void *data)
+{
+	struct km_submx *sm = (struct km_submx *)data;
+	for ( VALUE v = (VALUE)vstart; v != (VALUE)vend; v += stride ) {
+		if (!rb_objspace_internal_object_p(v)) {
+			if ( rb_obj_is_kind_of(v, km_cMat) && km_mat2smat(v)->parent == sm->parent ) {
+				rb_ary_push(sm->list, v);
+			}
+		}
+	}
+	return 0;
+}
+VALUE
+kmm_mat_submatricies(VALUE self)
+{
+	SMAT *smat = km_mat2smat(self);
+	if ( smat->stype != ST_FULL ) {
+		return Qnil;
+	} else if ( !smat->may_have_sub ) {
+		return rb_ary_new();
+	}
+	struct km_submx data = {self, rb_ary_new()};
+	rb_objspace_each_objects(km_mat_submx, (void *)&data);
+	if ( RARRAY_LEN(data.list) == 0 ) {
+		smat->may_have_sub = false;
+	}
+	return data.list;
+}
+
+// return supermatrix of `self'
+// the return will be nil if `self' is full-matrix
+VALUE
+kmm_mat_supermatrix(VALUE self)
+{
+	SMAT *data = km_mat2smat(self);
+	return data->parent;
+}
+
+// if `self' is a supermatrix of some submatricies, detach all the submatricies by replacing them by copied full-matrix
+// if `self' is a submatrix of a supermatrix, replace `self' by a copied full-matrix of 'self'
+// return self if at least a matrix is replaced, otherwise, return nil
+VALUE
+kmm_mat_detach(int argc, VALUE *argv, VALUE self)
+{
+	rb_check_arity(argc, 0, 1);
+	bool check_other = ( ( argc == 1 ) && RTEST(argv[0]) );
+	SMAT *smat = km_mat2smat(self);
+	if ( smat->stype == ST_FULL ) {
+		VALUE list = kmm_mat_submatricies(self);
+		if ( !smat->may_have_sub ) {
+			return Qnil;
+		}
+		for (long i=0; i<RARRAY_LEN(list); i++) {
+			VALUE elm = rb_ary_entry(list, i);
+			kmm_mat_replace(elm, rb_obj_dup(elm));
+		}
+		smat->may_have_sub = false;
+		return self;
+	} else {
+		VALUE old_parent = smat->parent;
+		kmm_mat_replace(self, rb_obj_dup(self));
+		if ( check_other ) {
+			kmm_mat_submatricies(old_parent);
+		}
+		return self;
+	}
+}
+
+// if `self' is a supermatrix of some submatricies, detach all the submatricies by replacing them by (0, 0)-matrix
+// if `self' is a submatrix of a supermatrix, detach from the supermatrix
+// in any case, `self' is replaced by (0, 0)-matrix, and return `self'
+static VALUE
+km_kill_func(VALUE elm, VALUE nil, VALUE self)
+{
+	SMAT *ssub = km_mat2smat(elm);
+	if ( ssub->stype != ST_SSUB ) {
+		ruby_xfree(ssub->body);
+	}
+	ssub->stype = ST_FULL;
+	ssub->body = NULL;
+	ssub->m = 0; ssub->n = 0; ssub->ld = 0;
+	ssub->parent = Qnil;
+	return elm;
+}
+VALUE
+kmm_mat__kill(VALUE self)
+{
+	km_check_frozen(self);
+	SMAT *smat = km_mat2smat(self);
+	if ( smat->stype == ST_FULL ) {
+		VALUE list = kmm_mat_submatricies(self);
+		rb_iterate(rb_ary_each, list, km_kill_func, Qnil);
+	}
+	if ( smat->stype != ST_SSUB ) {
+		ruby_xfree(smat->body);
+	}
+	smat->stype = ST_FULL;
+	smat->body = NULL;
+	smat->m = 0; smat->n = 0; smat->ld = 0;
+	smat->may_have_sub = false; smat->parent = Qnil;
+	return self;
+}
+
+// replace the substance of `self' by `val'
+// if `val' is a submatrix, `self' is a submatrix of the same supermatrix
+// if `val' is a full-matrix, `self' is a copy of it (submatricies are not succeeded)
+VALUE
+kmm_mat_replace(VALUE self, VALUE val)
+{
+	km_check_frozen(self);
+	SMAT *dest = km_mat2smat(self);
+	SMAT *src = km_mat2smat(val);
+	if ( kmm_mat_have_submatrix_p(self) ) {
+		rb_raise(km_eShare, "can't replace supermatrix. try detach before replacing");
+	}
+	if ( src->stype == ST_FULL ) {
+		switch ( dest->stype ) {
+		case ST_RSUB:
+			ruby_xfree(dest->body);
+			// FALL THROUGH
+		case ST_SSUB:
+			dest->vtype = VT_END;
+			dest->stype = ST_FULL;
+			dest->parent = Qnil;
+			dest->may_have_sub = false;
+			dest->body = NULL;
+			break;
+		default:
+			break;
+		}
+		km_smat_copy(dest, src);
+	} else if ( src->stype == ST_SSUB ) {
+		if ( dest->stype != ST_SSUB ) {
+			ruby_xfree(dest->body);
+		}
+		dest->body = src->body;
+		dest->ld = src->ld; dest->m = src->m; dest->n = src->n;
+		dest->vtype = src->vtype; dest->stype = ST_SSUB;
+		dest->trans = src->trans;
+		dest->parent = src->parent;
+	} else if ( src->stype == ST_RSUB ) {
+		if ( dest->stype != ST_RSUB || LENGTH(dest) != LENGTH(src) ) {
+			if ( dest->stype != ST_SSUB ) {
+				ruby_xfree(dest->body);
+			}
+			dest->body = ruby_xcalloc(LENGTHs(src), sizeof(void*));
+		}
+		memcpy(dest->body, src->body, sizeof(void*)*LENGTHs(src));
+		dest->ld = src->ld; dest->m = src->m; dest->n = src->n;
+		dest->vtype = src->vtype; dest->stype = ST_RSUB;
+		dest->trans = src->trans;
+		dest->parent = src->parent;
+	} else {
+		rb_raise(km_eInternal, "unknown storage type");
+	}
+	return self;
+}
+
+VALUE
+km_Mat_ssub(int i, int j, int m, int n, VALUE super)
+{
+	SMAT *ssup = km_mat2smat(super);
+	if ( ssup->m < i+m || ssup->n < j+n ) {
+		rb_raise(rb_eIndexError, "given index+size (%d+%d, %d+%d) is out of range (%d, %d)", i, m, j, n, ssup->m, ssup->n);
+	}
+	SMAT *sret;
+	if ( ssup->stype == ST_FULL ) {
+		VT_SWITCH( ssup->vtype,
+			sret = km_smat_alloc_with(m, n, VT_DOUBLE, ssup->dbody+INDEX(ssup, i, j));,
+			sret = km_smat_alloc_with(m, n, VT_COMPLEX, ssup->zbody+INDEX(ssup, i, j));,
+			sret = km_smat_alloc_with(m, n, VT_INT, ssup->ibody+INDEX(ssup, i, j));,
+			sret = km_smat_alloc_with(m, n, VT_BOOL, ssup->bbody+INDEX(ssup, i, j));,
+			sret = km_smat_alloc_with(m, n, VT_VALUE, ssup->vbody+INDEX(ssup, i, j));
+		);
+		sret->parent = super;
+		ssup->may_have_sub = true;
+	} else if ( ssup->stype == ST_SSUB ) {
+		VT_SWITCH( ssup->vtype,
+			sret = km_smat_alloc_with(m, n, VT_DOUBLE, ssup->dbody+INDEX(ssup, i, j));,
+			sret = km_smat_alloc_with(m, n, VT_COMPLEX, ssup->zbody+INDEX(ssup, i, j));,
+			sret = km_smat_alloc_with(m, n, VT_INT, ssup->ibody+INDEX(ssup, i, j));,
+			sret = km_smat_alloc_with(m, n, VT_BOOL, ssup->bbody+INDEX(ssup, i, j));,
+			sret = km_smat_alloc_with(m, n, VT_VALUE, ssup->vbody+INDEX(ssup, i, j));
+		);
+		sret->parent = ssup->parent;
+	} else if ( ssup->stype == ST_RSUB ) {
+		int is[m]; int js[n];
+		for ( int k=0; k<m; k++ ) { is[k] = i+k; }
+		for ( int k=0; k<n; k++ ) { js[k] = j+k; }
+		return km_Mat_rsub1(m, n, is, js, super);
+	} else {
+		rb_raise(km_eInternal, "unknown storage type");
+	}
+	sret->trans=ssup->trans; sret->ld = ssup->ld; sret->stype = ST_SSUB;
+	VALUE ret = TypedData_Wrap_Struct(km_cMat, &km_mat_data_type, sret);
+	km_infect_frozen(super, ret);
+	return ret;
+}
+
+static void
+km_rsub_check_range(SMAT *ssup, int ii, int jj)
+{
+	if ( ii < 0 || ssup->m <= ii || jj < 0 || ssup->n <= jj ) {
+		rb_raise(rb_eIndexError, "given index (%d, %d) is out of range (%d, %d)", ii, jj, ssup->m, ssup->n);
+	}
+}
+#define RSUB1_LOOPr(id) for ( int i=0; i<m; i++ ) { for ( int j=0; j<n; j++ ) { \
+	km_rsub_check_range(ssup, is[i], js[j]); \
+	sret->id##pbody[i+j*m] = ssup->id##pbody[INDEX(ssup, is[i], js[j])]; \
+} }
+#define RSUB1_LOOP(id) for ( int i=0; i<m; i++ ) { for ( int j=0; j<n; j++ ) { \
+	km_rsub_check_range(ssup, is[i], js[j]); \
+	sret->id##pbody[i+j*m] = ssup->id##body + INDEX(ssup, is[i], js[j]); \
+} }
+VALUE
+km_Mat_rsub1(int m, int n, int *is, int *js, VALUE super)
+{
+	km_check_positive(m, n);
+	VALUE ret = km_Mat_alloc(km_cMat);
+	SMAT *ssup = km_mat2smat(super);
+	SMAT *sret = km_mat2smat(ret);
+	km_smat_alloc_pbody(sret, m, n, ssup->vtype);
+	if ( ssup->stype == ST_RSUB ) {
+		VT_SWITCH( ssup->vtype,
+			RSUB1_LOOPr(d);,
+			RSUB1_LOOPr(z);,
+			RSUB1_LOOPr(i);,
+			RSUB1_LOOPr(b);,
+			RSUB1_LOOPr(v);
+		);
+		sret->parent = ssup->parent;
+	} else {
+		VT_SWITCH( ssup->vtype,
+			RSUB1_LOOP(d);,
+			RSUB1_LOOP(z);,
+			RSUB1_LOOP(i);,
+			RSUB1_LOOP(b);,
+			RSUB1_LOOP(v);
+		);
+		if ( ssup->stype == ST_FULL ) {
+			sret->parent = super;
+			ssup->may_have_sub = true;
+		} else {
+			sret->parent = ssup->parent;
+		}
+	}
+	km_infect_frozen(super, ret);
+	return ret;
+}
+
+#define RSUB2_LOOPr(id) for( int i=0; i<m; i++ ) { for ( int j=0; j<n; j++ ) { \
+	km_rsub_check_range(ssup, is[i+j*m], js[i+j*m]); \
+	sret->id##pbody[i+j*m] = ssup->id##pbody[INDEX(ssup, is[i+j*m], js[i+j*m])]; \
+} }
+#define RSUB2_LOOP(id) for( int i=0; i<m; i++ ) { for ( int j=0; j<n; j++ ) { \
+	km_rsub_check_range(ssup, is[i+j*m], js[i+j*m]); \
+	sret->id##pbody[i+j*m] = ssup->id##body+INDEX(ssup, is[i+j*m], js[i+j*m]); \
+} }
+VALUE
+km_Mat_rsub2(int m, int n, int *is, int *js, VALUE super)
+{
+	km_check_positive(m, n);
+	VALUE ret = km_Mat_alloc(km_cMat);
+	SMAT *ssup = km_mat2smat(super);
+	SMAT *sret = km_mat2smat(ret);
+	km_smat_alloc_pbody(sret, m, n, ssup->vtype);
+	if ( ssup->stype == ST_RSUB ) {
+		VT_SWITCH( ssup->vtype,
+			RSUB2_LOOPr(d);,
+			RSUB2_LOOPr(z);,
+			RSUB2_LOOPr(i);,
+			RSUB2_LOOPr(b);,
+			RSUB2_LOOPr(v);
+		);
+		sret->parent = ssup->parent;
+	} else {
+		VT_SWITCH( ssup->vtype,
+			RSUB2_LOOP(d);,
+			RSUB2_LOOP(z);,
+			RSUB2_LOOP(i);,
+			RSUB2_LOOP(b);,
+			RSUB2_LOOP(v);
+		);
+		if ( ssup->stype == ST_FULL ) {
+			sret->parent = super;
+			ssup->may_have_sub = true;
+		} else {
+			sret->parent = ssup->parent;
+		}
+	}
+	km_infect_frozen(super, ret);
+	return ret;
+}

data/ext/kmat/smat/smat.c

@@ -0,0 +1,530 @@
+#include "../kmat.h"
+
+static void
+km_rb_gc_mark_wrap(VALUE *obj, void *null)
+{
+	rb_gc_mark(*obj);
+}
+static void
+km_smat_mark(void *_data)
+{
+	SMAT *data = (SMAT *)_data;
+	rb_gc_mark(data->parent);
+	if ( data->vtype == VT_VALUE && data->body != NULL ) {
+		km_smat_each_v(data, km_rb_gc_mark_wrap, NULL);
+	}
+}
+
+static void
+km_smat_free(void *_data)
+{
+	SMAT *data = (SMAT *)_data;
+	if ( data != NULL ) {
+		if ( data->stype != ST_SSUB && data->body != NULL ) {
+			ruby_xfree(data->body);
+		}
+		ruby_xfree(data);
+	}
+}
+
+static size_t
+km_smat_size(const void *_data)
+{
+	const SMAT *data = (const SMAT *)_data;
+	if ( data != NULL ) {
+		size_t ret = sizeof(SMAT);
+		if ( data->body != NULL ) {
+			if ( data->stype == ST_FULL ) {
+				ret += km_sizeof_vt(data->vtype)*int2size_t(data->m*data->n);
+			} else if ( data->stype == ST_RSUB ) {
+				ret += sizeof(void *)*int2size_t(data->m*data->n);
+			}
+		}
+		return ret;
+	} else {
+		return (size_t)0;
+	}
+}
+
+// functions for allocation
+const rb_data_type_t km_mat_data_type = {
+	"kmat-Mat",
+	{
+		km_smat_mark,
+		km_smat_free,
+		km_smat_size,
+		{ (void *)0, (void *)0 }
+	},
+	(rb_data_type_t *)0,
+	(void *)0,
+	(VALUE)0
+};
+VALUE
+km_Mat_alloc(VALUE klass)
+{
+	return TypedData_Wrap_Struct(klass, &km_mat_data_type, km_smat_alloc_with(0, 0, VT_END, NULL));
+}
+
+// calloc a side of SMAT
+// return->body is the argument `body'
+SMAT *
+km_smat_alloc_with(int m, int n, VTYPE vt, void *body)
+{
+	km_check_positive(m, n);
+	SMAT *data = ZALLOC(SMAT);
+	data->body = body; data->ld = data->m = m; data->n = n;
+	data->vtype = vt; data->stype = ST_FULL; data->trans = false;
+	data->may_have_sub = false; data->parent = Qnil;
+	return data;
+}
+
+SMAT *
+km_smat_alloc(int m, int n, VTYPE vt)
+{
+	km_check_positive(m, n);
+	void *body = ruby_xcalloc(int2size_t(n*m), km_sizeof_vt(vt));
+	return km_smat_alloc_with(m, n, vt, body);
+}
+
+// calloc a SMAT of (m, n)-matrix
+// return->body will be calloc-ed
+void
+km_smat_alloc_body(SMAT *data, int m, int n, VTYPE vt)
+{
+	km_check_positive(m, n);
+	if ( data->stype != ST_FULL ) {
+		rb_raise(km_eShare, "can't re-alloc submatrix body");
+	} else if ( km_smat_have_submatrix_p(data) ) {
+		rb_raise(km_eShare, "can't re-alloc supermatrix body");
+	}
+	data->ld = data->m = m; data->n = n; data->vtype = vt; data->stype = ST_FULL;
+	ruby_xfree(data->body);
+	data->body = ruby_xcalloc(int2size_t(n*m), km_sizeof_vt(vt));
+}
+void
+km_smat_alloc_pbody(SMAT *data, int m, int n, VTYPE vt)
+{
+	km_check_positive(m, n);
+	if ( data->stype != ST_FULL ) {
+		rb_raise(km_eShare, "can't re-alloc submatrix body");
+	} else if ( km_smat_have_submatrix_p(data) ) {
+		rb_raise(km_eShare, "can't re-alloc supermatrix body");
+	}
+	data->ld = data->m = m; data->n = n; data->vtype = vt; data->stype = ST_RSUB;
+	ruby_xfree(data->body);
+	data->body = ruby_xcalloc(int2size_t(n*m), sizeof(void*));
+}
+
+
+// extract and return SMAT from mat_obj
+SMAT *
+km_mat2smat(VALUE mat_obj)
+{
+	SMAT *data;
+	if ( !rb_obj_is_kind_of(mat_obj, km_cMat) ) {
+		rb_raise(rb_eTypeError, "Mat is expected, not %s", rb_obj_classname(mat_obj));
+	}
+	TypedData_Get_Struct(mat_obj, SMAT, &km_mat_data_type, data);
+	return data;
+}
+
+// copy the content of SMAT
+// if the size are not same, calloc before copying
+#define DEFINE_SMAT_COPY(id, type) static void \
+km_smat_copy_##id(type *ed, const type *es, void *null) \
+{ \
+	*ed = *es; \
+}
+DEFINE_SMAT_COPY(d, double)
+DEFINE_SMAT_COPY(z, COMPLEX)
+DEFINE_SMAT_COPY(i, int)
+DEFINE_SMAT_COPY(b, bool)
+DEFINE_SMAT_COPY(v, VALUE)
+void
+km_smat_copy(SMAT *dest, const SMAT *src)
+{
+	if ( src->body == NULL ) {
+		ruby_xfree(dest->body);
+		dest->body = NULL;
+	} else {
+		if ( dest->vtype != src->vtype || LENGTH(dest) != LENGTH(src) ) { // re-calloc
+			if ( dest->stype != ST_FULL ) { // the destination must not be a submatrix
+				rb_raise(km_eShare, "can't copy to value-type mismatched or dimension mismatched submatrix");
+			}
+			ruby_xfree(dest->body);
+			dest->body = ruby_xcalloc(LENGTHs(src), km_sizeof_vt(src->vtype));
+			dest->ld = src->m; dest->vtype = src->vtype;
+		} else if ( dest->m != src->m ) { // need not to resize but reshape is needed
+			if ( dest->stype != ST_FULL ) { // the destination must not be a submatrix
+				rb_raise(km_eShare, "can't reshape submatrix");
+			}
+			dest->ld = src->m;
+		}
+		dest->m = src->m; dest->n = src->n;
+		if ( dest->stype==ST_FULL && src->stype==ST_FULL ) {
+			dest->ld = src->ld; dest->trans = src->trans;
+			memcpy(dest->body, src->body, km_sizeof_vt(src->vtype)*LENGTHs(src));
+		} else {
+			VT_SWITCH( dest->vtype,
+				km_smat_each2_dcd(dest, src, km_smat_copy_d, NULL);,
+				km_smat_each2_zcz(dest, src, km_smat_copy_z, NULL);,
+				km_smat_each2_ici(dest, src, km_smat_copy_i, NULL);,
+				km_smat_each2_bcb(dest, src, km_smat_copy_b, NULL);,
+				km_smat_each2_vcv(dest, src, km_smat_copy_v, NULL);
+			);
+		}
+	}
+}
+
+// Mat#marhsal_dump/load for Marshal.dump/load
+// return an Array with 2 elements
+// the first element is a bytes (String) which contains shape and value type
+// the second element is `self'.to_ary if the value type is ruby-object
+// otherwise, the second element is a bytes (String) which is the same as `self'->body
+// the supermatrix-submatrix information will not be saved
+VALUE
+kmm_mat_marshal_dump(VALUE self)
+{
+	SMAT *smat = km_mat2smat(self);
+	if ( smat->stype != ST_FULL ) {
+		smat = km_mat2smat(rb_obj_dup(self));
+	}
+	VALUE headder = rb_str_new((char *)&(smat->vtype), sizeof(VTYPE));
+	VALUE body;
+	if ( smat->vtype == VT_VALUE ) {
+		body = kmm_mat_to_ary(self);
+	} else {
+		rb_str_cat(headder, (char *)&(smat->m), sizeof(int));
+		rb_str_cat(headder, (char *)&(smat->n), sizeof(int));
+		rb_str_cat(headder, (char *)&(smat->trans), sizeof(bool));
+		body = rb_str_new((char *)(smat->body), (long)km_sizeof_vt(smat->vtype)*LENGTH(smat));
+	}
+	return rb_ary_new3(2, headder, body);
+}
+VALUE
+kmm_mat_marshal_load(VALUE self, VALUE dump)
+{
+	SMAT *smat = km_mat2smat(self);
+	char *hptr = RSTRING_PTR(rb_ary_entry(dump, 0));
+	VALUE body = rb_ary_entry(dump, 1);
+	memcpy(&(smat->vtype), hptr, sizeof(VTYPE));
+	if ( smat->vtype == VT_VALUE ) {
+		km_smat_copy(smat, km_mat2smat(kmm_ary_to_omat(body)));
+	} else {
+		hptr += sizeof(VTYPE);
+		int m, n; bool t;
+		memcpy(&m, hptr, sizeof(int)); hptr += sizeof(int);
+		memcpy(&n, hptr, sizeof(int)); hptr += sizeof(int);
+		memcpy(&t, hptr, sizeof(bool)); hptr += sizeof(bool);
+		km_smat_alloc_body(smat, m, n, smat->vtype);
+		smat->trans = t;
+		size_t sb = km_sizeof_vt(smat->vtype)*LENGTHs(smat);
+		if ( RSTRING_LEN(body) != (long)sb ) {
+			rb_raise(rb_eArgError, "wrong object given");
+		}
+		memcpy(smat->body, RSTRING_PTR(body), sb);
+	}
+	return self;
+}
+
+// call `func'(&element, `data') for each elements of `smat'
+#define DEFINE_KM_SMAT_EACH_ID(id, type) void \
+km_smat_each_##id(SMAT *smat, void (*func)(type *, void *), void *data) \
+{ \
+	if ( smat->stype == ST_RSUB ) { \
+		if ( smat->trans ) { \
+			for ( int i=0; i<smat->m; i++ ) { for ( int j=0; j<smat->n; j++ ) { \
+				func(smat->id##pbody[j+i*(smat->ld)], data); \
+			} } \
+		} else { \
+			for ( int i=0; i<smat->m; i++ ) { for ( int j=0; j<smat->n; j++ ) { \
+				func(smat->id##pbody[i+j*(smat->ld)], data); \
+			} } \
+		} \
+	} else { \
+		if ( smat->trans ) { \
+			for ( int i=0; i<smat->m; i++ ) { for ( int j=0; j<smat->n; j++ ) { \
+				func(&(smat->id##body[j+i*(smat->ld)]), data); \
+			} } \
+		} else { \
+			for ( int i=0; i<smat->m; i++ ) { for ( int j=0; j<smat->n; j++ ) { \
+				func(&(smat->id##body[i+j*(smat->ld)]), data); \
+			} } \
+		} \
+	} \
+}
+DEFINE_KM_SMAT_EACH_ID(d, double)
+DEFINE_KM_SMAT_EACH_ID(z, COMPLEX)
+DEFINE_KM_SMAT_EACH_ID(i, int)
+DEFINE_KM_SMAT_EACH_ID(b, bool)
+DEFINE_KM_SMAT_EACH_ID(v, VALUE)
+
+// call `func'(&element, `data', i, j) for each elements of `smat'
+#define DEFINE_KM_SMAT_EACH_WI_ID(id, type) void \
+km_smat_each_with_index_##id(SMAT *smat, void (*func)(type *, int, int, void *), void *data) \
+{ \
+	if ( smat->stype == ST_RSUB ) { \
+		if ( smat->trans ) { \
+			for ( int i=0; i<smat->m; i++ ) { for ( int j=0; j<smat->n; j++ ) { \
+				func(smat->id##pbody[j+i*(smat->ld)], i, j, data); \
+			} } \
+		} else { \
+			for ( int i=0; i<smat->m; i++ ) { for ( int j=0; j<smat->n; j++ ) { \
+				func(smat->id##pbody[i+j*(smat->ld)], i, j, data); \
+			} } \
+		} \
+	} else { \
+		if ( smat->trans ) { \
+			for ( int i=0; i<smat->m; i++ ) { for ( int j=0; j<smat->n; j++ ) { \
+				func(&(smat->id##body[j+i*(smat->ld)]), i, j, data); \
+			} } \
+		} else { \
+			for ( int i=0; i<smat->m; i++ ) { for ( int j=0; j<smat->n; j++ ) { \
+				func(&(smat->id##body[i+j*(smat->ld)]), i, j, data); \
+			} } \
+		} \
+	} \
+}
+DEFINE_KM_SMAT_EACH_WI_ID(d, double)
+DEFINE_KM_SMAT_EACH_WI_ID(z, COMPLEX)
+DEFINE_KM_SMAT_EACH_WI_ID(i, int)
+DEFINE_KM_SMAT_EACH_WI_ID(b, bool)
+DEFINE_KM_SMAT_EACH_WI_ID(v, VALUE)
+
+// call `func'(&(element of sa), &(element of sb), `data') for each elements of `sa'
+// you must check the shape of `sb' is the same as that of `sa'
+// SEGV will occur if `sb' is smaller than `sa'
+#define KM_SMAT_EACH2_BLOOP(elma, id) if ( sb->stype == ST_RSUB ) { \
+	if ( sb->trans ) { \
+		for ( int i=0; i<sa->m; i++ ) { for ( int j=0; j<sa->n; j++ ) { \
+			func(elma, sb->id##pbody[j+i*(sb->ld)], data); \
+		} } \
+	} else { \
+		for ( int i=0; i<sa->m; i++ ) { for ( int j=0; j<sa->n; j++ ) { \
+			func(elma, sb->id##pbody[i+j*(sb->ld)], data); \
+		} } \
+	} \
+} else { \
+	if ( sb->trans ) { \
+		for ( int i=0; i<sa->m; i++ ) { for ( int j=0; j<sa->n; j++ ) { \
+			func(elma, &(sb->id##body[j+i*(sb->ld)]), data); \
+		} } \
+	} else { \
+		for ( int i=0; i<sa->m; i++ ) { for ( int j=0; j<sa->n; j++ ) { \
+			func(elma, &(sb->id##body[i+j*(sb->ld)]), data); \
+		} } \
+	} \
+}
+#define DEFINE_KM_SMAT_EACH2_ID(id, type) void \
+km_smat_each2_##id(SMAT *sa, SMAT *sb, void (*func)(type *, type *, void *), void *data) \
+{ \
+	if ( sa->stype == ST_RSUB ) { \
+		if ( sa->trans ) { \
+			KM_SMAT_EACH2_BLOOP(sa->id##pbody[j+i*(sa->ld)], id) \
+		} else { \
+			KM_SMAT_EACH2_BLOOP(sa->id##pbody[i+j*(sa->ld)], id) \
+		} \
+	} else { \
+		if ( sa->trans ) { \
+			KM_SMAT_EACH2_BLOOP(&(sa->id##body[j+i*(sa->ld)]), id) \
+		} else { \
+			KM_SMAT_EACH2_BLOOP(&(sa->id##body[i+j*(sa->ld)]), id) \
+		} \
+	} \
+}
+#define DEFINE_KM_SMAT_EACH2_ID_CONST_ID(id, type, id2, type2) void \
+km_smat_each2_##id##c##id2(SMAT *sa, const SMAT *sb, void (*func)(type *, const type2 *, void *), void *data) \
+{ \
+	if ( sa->stype == ST_RSUB ) { \
+		if ( sa->trans ) { \
+			KM_SMAT_EACH2_BLOOP(sa->id##pbody[j+i*(sa->ld)], id2) \
+		} else { \
+			KM_SMAT_EACH2_BLOOP(sa->id##pbody[i+j*(sa->ld)], id2) \
+		} \
+	} else { \
+		if ( sa->trans ) { \
+			KM_SMAT_EACH2_BLOOP(&(sa->id##body[j+i*(sa->ld)]), id2) \
+		} else { \
+			KM_SMAT_EACH2_BLOOP(&(sa->id##body[i+j*(sa->ld)]), id2) \
+		} \
+	} \
+}
+DEFINE_KM_SMAT_EACH2_ID(d, double)
+DEFINE_KM_SMAT_EACH2_ID(z, COMPLEX)
+DEFINE_KM_SMAT_EACH2_ID(i, int)
+DEFINE_KM_SMAT_EACH2_ID(b, bool)
+DEFINE_KM_SMAT_EACH2_ID(v, VALUE)
+DEFINE_KM_SMAT_EACH2_ID_CONST_ID(d, double, d, double)
+DEFINE_KM_SMAT_EACH2_ID_CONST_ID(z, COMPLEX, z, COMPLEX)
+DEFINE_KM_SMAT_EACH2_ID_CONST_ID(i, int, i, int)
+DEFINE_KM_SMAT_EACH2_ID_CONST_ID(b, bool, b, bool)
+DEFINE_KM_SMAT_EACH2_ID_CONST_ID(v, VALUE, v, VALUE)
+DEFINE_KM_SMAT_EACH2_ID_CONST_ID(d, double, b, bool)
+DEFINE_KM_SMAT_EACH2_ID_CONST_ID(z, COMPLEX, b, bool)
+DEFINE_KM_SMAT_EACH2_ID_CONST_ID(i, int, b, bool)
+DEFINE_KM_SMAT_EACH2_ID_CONST_ID(v, VALUE, b, bool)
+DEFINE_KM_SMAT_EACH2_ID_CONST_ID(d, double, z, COMPLEX)
+
+// call `func'(&(element of sa), &(element of sb), &(element of sc), `data') for each elements of `sa'
+// you must check the shape of `sb' and that of `sc' are the same as that of `sa'
+// SEGV will occur if `sb' or `sc' is smaller than `sa'
+#define KM_SMAT_EACH3_CLOOP(elma, elmb, id) if ( sc->stype == ST_RSUB ) { \
+	if ( sc->trans ) { \
+		for ( int i=0; i<sa->m; i++ ) { for ( int j=0; j<sa->n; j++ ) { \
+			func(elma, elmb, sc->id##pbody[j+i*(sc->ld)], data); \
+		} } \
+	} else { \
+		for ( int i=0; i<sa->m; i++ ) { for ( int j=0; j<sa->n; j++ ) { \
+			func(elma, elmb, sc->id##pbody[i+j*(sc->ld)], data); \
+		} } \
+	} \
+} else { \
+	if ( sc->trans ) { \
+		for ( int i=0; i<sa->m; i++ ) { for ( int j=0; j<sa->n; j++ ) { \
+			func(elma, elmb, &(sc->id##body[j+i*(sc->ld)]), data); \
+		} } \
+	} else { \
+		for ( int i=0; i<sa->m; i++ ) { for ( int j=0; j<sa->n; j++ ) { \
+			func(elma, elmb, &(sc->id##body[i+j*(sc->ld)]), data); \
+		} } \
+	} \
+}
+#define KM_SMAT_EACH3_BLOOP(elma, id) if ( sb->stype == ST_RSUB ) { \
+	if ( sb->trans ) { \
+		KM_SMAT_EACH3_CLOOP(elma, sb->id##pbody[j+i*(sb->ld)], id) \
+	} else { \
+		KM_SMAT_EACH3_CLOOP(elma, sb->id##pbody[i+j*(sb->ld)], id) \
+	} \
+} else { \
+	if ( sb->trans ) { \
+		KM_SMAT_EACH3_CLOOP(elma, &(sb->id##body[j+i*(sb->ld)]), id) \
+	} else { \
+		KM_SMAT_EACH3_CLOOP(elma, &(sb->id##body[i+j*(sb->ld)]), id) \
+	} \
+}
+#define DEFINE_KM_SMAT_EACH3_ID(id, type) void \
+km_smat_each3_##id(SMAT *sa, SMAT *sb, SMAT *sc, void (*func)(type *, type *, type *, void *), void *data) \
+{ \
+	if ( sa->stype == ST_RSUB ) { \
+		if ( sa->trans ) { \
+			KM_SMAT_EACH3_BLOOP(sa->id##pbody[j+i*(sa->ld)], id) \
+		} else { \
+			KM_SMAT_EACH3_BLOOP(sa->id##pbody[i+j*(sa->ld)], id) \
+		} \
+	} else { \
+		if ( sa->trans ) { \
+			KM_SMAT_EACH3_BLOOP(&(sa->id##body[j+i*(sa->ld)]), id) \
+		} else { \
+			KM_SMAT_EACH3_BLOOP(&(sa->id##body[i+j*(sa->ld)]), id) \
+		} \
+	} \
+}
+// DEFINE_KM_SMAT_EACH3_ID(d, double)
+// DEFINE_KM_SMAT_EACH3_ID(z, COMPLEX)
+// DEFINE_KM_SMAT_EACH3_ID(i, int)
+// DEFINE_KM_SMAT_EACH3_ID(b, bool)
+// DEFINE_KM_SMAT_EACH3_ID(v, VALUE)
+void
+km_smat_each3_zcdcd(SMAT *sa, const SMAT *sb, const SMAT *sc, void (*func)(COMPLEX *, const double *, const double *, void *), void *data)
+{
+	if ( sa->stype == ST_RSUB ) {
+		if ( sa->trans ) {
+			KM_SMAT_EACH3_BLOOP(sa->zpbody[j+i*(sa->ld)], d)
+		} else {
+			KM_SMAT_EACH3_BLOOP(sa->zpbody[i+j*(sa->ld)], d)
+		}
+	} else {
+		if ( sa->trans ) {
+			KM_SMAT_EACH3_BLOOP(&(sa->zbody[j+i*(sa->ld)]), d)
+		} else {
+			KM_SMAT_EACH3_BLOOP(&(sa->zbody[i+j*(sa->ld)]), d)
+		}
+	}
+}
+
+void
+km_smat_each3_bcdcd(SMAT *sa, const SMAT *sb, const SMAT *sc, void (*func)(bool *, const double *, const double *, void *), void *data)
+{
+	if ( sa->stype == ST_RSUB ) {
+		if ( sa->trans ) {
+			KM_SMAT_EACH3_BLOOP(sa->bpbody[j+i*(sa->ld)], d)
+		} else {
+			KM_SMAT_EACH3_BLOOP(sa->bpbody[i+j*(sa->ld)], d)
+		}
+	} else {
+		if ( sa->trans ) {
+			KM_SMAT_EACH3_BLOOP(&(sa->bbody[j+i*(sa->ld)]), d)
+		} else {
+			KM_SMAT_EACH3_BLOOP(&(sa->bbody[i+j*(sa->ld)]), d)
+		}
+	}
+}
+void
+km_smat_each3_bczcz(SMAT *sa, const SMAT *sb, const SMAT *sc, void (*func)(bool *, const COMPLEX *, const COMPLEX *, void *), void *data)
+{
+	if ( sa->stype == ST_RSUB ) {
+		if ( sa->trans ) {
+			KM_SMAT_EACH3_BLOOP(sa->bpbody[j+i*(sa->ld)], z)
+		} else {
+			KM_SMAT_EACH3_BLOOP(sa->bpbody[i+j*(sa->ld)], z)
+		}
+	} else {
+		if ( sa->trans ) {
+			KM_SMAT_EACH3_BLOOP(&(sa->bbody[j+i*(sa->ld)]), z)
+		} else {
+			KM_SMAT_EACH3_BLOOP(&(sa->bbody[i+j*(sa->ld)]), z)
+		}
+	}
+}
+void
+km_smat_each3_bcici(SMAT *sa, const SMAT *sb, const SMAT *sc, void (*func)(bool *, const int *, const int *, void *), void *data)
+{
+	if ( sa->stype == ST_RSUB ) {
+		if ( sa->trans ) {
+			KM_SMAT_EACH3_BLOOP(sa->bpbody[j+i*(sa->ld)], i)
+		} else {
+			KM_SMAT_EACH3_BLOOP(sa->bpbody[i+j*(sa->ld)], i)
+		}
+	} else {
+		if ( sa->trans ) {
+			KM_SMAT_EACH3_BLOOP(&(sa->bbody[j+i*(sa->ld)]), i)
+		} else {
+			KM_SMAT_EACH3_BLOOP(&(sa->bbody[i+j*(sa->ld)]), i)
+		}
+	}
+}
+void
+km_smat_each3_bcbcb(SMAT *sa, const SMAT *sb, const SMAT *sc, void (*func)(bool *, const bool *, const bool *, void *), void *data)
+{
+	if ( sa->stype == ST_RSUB ) {
+		if ( sa->trans ) {
+			KM_SMAT_EACH3_BLOOP(sa->bpbody[j+i*(sa->ld)], b)
+		} else {
+			KM_SMAT_EACH3_BLOOP(sa->bpbody[i+j*(sa->ld)], b)
+		}
+	} else {
+		if ( sa->trans ) {
+			KM_SMAT_EACH3_BLOOP(&(sa->bbody[j+i*(sa->ld)]), b)
+		} else {
+			KM_SMAT_EACH3_BLOOP(&(sa->bbody[i+j*(sa->ld)]), b)
+		}
+	}
+}
+void
+km_smat_each3_bcvcv(SMAT *sa, const SMAT *sb, const SMAT *sc, void (*func)(bool *, const VALUE *, const VALUE *, void *), void *data)
+{
+	if ( sa->stype == ST_RSUB ) {
+		if ( sa->trans ) {
+			KM_SMAT_EACH3_BLOOP(sa->bpbody[j+i*(sa->ld)], v)
+		} else {
+			KM_SMAT_EACH3_BLOOP(sa->bpbody[i+j*(sa->ld)], v)
+		}
+	} else {
+		if ( sa->trans ) {
+			KM_SMAT_EACH3_BLOOP(&(sa->bbody[j+i*(sa->ld)]), v)
+		} else {
+			KM_SMAT_EACH3_BLOOP(&(sa->bbody[i+j*(sa->ld)]), v)
+		}
+	}
+}
+