luisgulo/gambas-source-code
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

[INTERPRETER]

Browse source 
* NEW: '_operators' interface has been renamed as '_operator'.
* NEW: Arithmetic operators now can be applied on two objects with
  different classes. One at least must implement the '_operator' interface.
* NEW: Each class that implements the '_operator' interface has now an 
  automatic priority that follows the load order. When a binary operator 
  has two objects that implement two different '_operator' interface, the
  one having the highest priority is used.
* NEW: Implementing all methods in the '_operators' interface is not 
  mandatory anymore. If one method is not implemented, then it is replaced
  by a function that raises a 'Type mismatch' error.

[GB.GSL]
* NEW: Matrix arithmetic has been implemented.
* NEW: Matrix.Determinant() method.
* NEW: Matrix.Invert() method.
* NEW: Matrix.Transpose() method.
* NEW: Matrix _call special method multiplies a matrix by a vector.
* NEW: Vector <-> Array conversion.


git-svn-id: svn://localhost/gambas/trunk@4946 867c0c6c-44f3-4631-809d-bfa615b0a4ec
This commit is contained in:
Benoît Minisini 2012-07-14 02:49:57 +00:00
parent 89d42c3d40
commit df89e09b2e
18 changed files with 994 additions and 364 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

115
gb.gsl/src/c_complex.c
View file

@ -32,6 +32,7 @@
#define THIS ((CCOMPLEX *)_object)
gsl_complex COMPLEX_zero = {{ 0.0, 0.0 }};
gsl_complex COMPLEX_one = {{ 1.0, 0.0 }};
//---- Complex number creation ----------------------------------------------
@ -54,7 +55,7 @@ CCOMPLEX *COMPLEX_push_complex(double value)
//---- Utility functions ----------------------------------------------------
int COMPLEX_get_value(GB_VALUE *value, double *x, gsl_complex *z)
int COMPLEX_get_value(GB_VALUE *value, COMPLEX_VALUE *v)
{
GB.Conv(value, value->_variant.value.type);
@ -63,12 +64,9 @@ int COMPLEX_get_value(GB_VALUE *value, double *x, gsl_complex *z)
CCOMPLEX *c = (CCOMPLEX *)(value->_object.value);
if (GB.CheckObject(c))
return CGV_ERR;
*z = c->number;
if (GSL_IMAG(*z) == 0.0)
{
*x = GSL_REAL(*z);
v->z = c->number;
if (GSL_IMAG(v->z) == 0.0)
return CGV_FLOAT;
}
else
return CGV_COMPLEX;
}
@ -77,71 +75,70 @@ int COMPLEX_get_value(GB_VALUE *value, double *x, gsl_complex *z)
if (GB.Conv(value, GB_T_FLOAT))
return CGV_ERR;
*x = value->_float.value;
z->dat[0] = *x;
z->dat[1] = 0.0;
v->z.dat[0] = value->_float.value;
v->z.dat[1] = 0.0;
return CGV_FLOAT;
}
}
//---- Arithmetic operators -------------------------------------------------
static CCOMPLEX *_addf(CCOMPLEX *a, double f)
static CCOMPLEX *_addf(CCOMPLEX *a, double f, bool invert)
{
return COMPLEX_make(a, gsl_complex_add_real(a->number, f));
}
static CCOMPLEX *_add(CCOMPLEX *a, CCOMPLEX *b)
static CCOMPLEX *_add(CCOMPLEX *a, CCOMPLEX *b, bool invert)
{
return COMPLEX_make(a, gsl_complex_add(a->number, b->number));
}
static CCOMPLEX *_subf(CCOMPLEX *a, double f)
static CCOMPLEX *_subf(CCOMPLEX *a, double f, bool invert)
{
return COMPLEX_make(a, gsl_complex_sub_real(a->number, f));
if (invert)
return COMPLEX_make(a, gsl_complex_add_real(gsl_complex_negative(a->number), f));
else
return COMPLEX_make(a, gsl_complex_sub_real(a->number, f));
}
static CCOMPLEX *_isubf(CCOMPLEX *a, double f)
{
return COMPLEX_make(a, gsl_complex_add_real(gsl_complex_negative(a->number), f));
}
static CCOMPLEX *_sub(CCOMPLEX *a, CCOMPLEX *b)
static CCOMPLEX *_sub(CCOMPLEX *a, CCOMPLEX *b, bool invert)
{
return COMPLEX_make(a, gsl_complex_sub(a->number, b->number));
}
static CCOMPLEX *_mulf(CCOMPLEX *a, double f)
static CCOMPLEX *_mulf(CCOMPLEX *a, double f, bool invert)
{
return COMPLEX_make(a, gsl_complex_mul_real(a->number, f));
}
static CCOMPLEX *_mul(CCOMPLEX *a, CCOMPLEX *b)
static CCOMPLEX *_mul(CCOMPLEX *a, CCOMPLEX *b, bool invert)
{
return COMPLEX_make(a, gsl_complex_mul(a->number, b->number));
}
static CCOMPLEX *_divf(CCOMPLEX *a, double f)
static CCOMPLEX *_divf(CCOMPLEX *a, double f, bool invert)
{
gsl_complex c = gsl_complex_div_real(a->number, f);
if (isfinite(c.dat[0]) && isfinite(c.dat[1]))
return COMPLEX_make(a, c);
if (invert)
{
gsl_complex c = gsl_complex_inverse(a->number);
if (isfinite(c.dat[0]) && isfinite(c.dat[1]))
return COMPLEX_make(a, gsl_complex_mul_real(c, f));
else
return NULL;
}
else
return NULL;
{
gsl_complex c = gsl_complex_div_real(a->number, f);
if (isfinite(c.dat[0]) && isfinite(c.dat[1]))
return COMPLEX_make(a, c);
else
return NULL;
}
}
static CCOMPLEX *_idivf(CCOMPLEX *a, double f)
{
gsl_complex c = gsl_complex_inverse(a->number);
if (isfinite(c.dat[0]) && isfinite(c.dat[1]))
return COMPLEX_make(a, gsl_complex_mul_real(c, f));
else
return NULL;
}
static CCOMPLEX *_div(CCOMPLEX *a, CCOMPLEX *b)
static CCOMPLEX *_div(CCOMPLEX *a, CCOMPLEX *b, bool invert)
{
gsl_complex c = gsl_complex_div(a->number, b->number);
@ -151,12 +148,12 @@ static CCOMPLEX *_div(CCOMPLEX *a, CCOMPLEX *b)
return NULL;
}
static int _equal(CCOMPLEX *a, CCOMPLEX *b)
static int _equal(CCOMPLEX *a, CCOMPLEX *b, bool invert)
{
return a->number.dat[0] == b->number.dat[0] && a->number.dat[1] == b->number.dat[1];
}
static int _equalf(CCOMPLEX *a, double f)
static int _equalf(CCOMPLEX *a, double f, bool invert)
{
return a->number.dat[0] == f && a->number.dat[1] == 0.0;
}
@ -201,35 +198,33 @@ static double _abs(CCOMPLEX *a)
return r;
}*/
static CCOMPLEX *_pow(CCOMPLEX *a, CCOMPLEX *b)
static CCOMPLEX *_pow(CCOMPLEX *a, CCOMPLEX *b, bool invert)
{
return COMPLEX_make(a, gsl_complex_pow(a->number, b->number));
}
static CCOMPLEX *_powf(CCOMPLEX *a, double f)
static CCOMPLEX *_powf(CCOMPLEX *a, double f, bool invert)
{
return COMPLEX_make(a, gsl_complex_pow_real(a->number, f));
}
static GB_OPERATOR_DESC _operators =
static GB_OPERATOR_DESC _operator =
{
add: (void *)_add,
addf: (void *)_addf,
sub: (void *)_sub,
subf: (void *)_subf,
isubf: (void *)_isubf,
mul: (void *)_mul,
mulf: (void *)_mulf,
div: (void *)_div,
divf: (void *)_divf,
idivf: (void *)_idivf,
pow: (void *)_pow,
powf: (void *)_powf,
equal: (void *)_equal,
equalf: (void *)_equalf,
abs: (void *)_abs,
neg: (void *)_neg
.equal = (void *)_equal,
.equalf = (void *)_equalf,
.add = (void *)_add,
.addf = (void *)_addf,
.sub = (void *)_sub,
.subf = (void *)_subf,
.mul = (void *)_mul,
.mulf = (void *)_mulf,
.div = (void *)_div,
.divf = (void *)_divf,
.pow = (void *)_pow,
.powf = (void *)_powf,
.abs = (void *)_abs,
.neg = (void *)_neg
};
//---- Conversions ----------------------------------------------------------
@ -650,7 +645,7 @@ GB_DESC ComplexDesc[] =
GB_METHOD("Arccsch", "Complex", Complex_Arccsch, NULL),
GB_METHOD("Arccoth", "Complex", Complex_Arccoth, NULL),
GB_INTERFACE("_operators", &_operators),
GB_INTERFACE("_operator", &_operator),
GB_INTERFACE("_convert", &_convert),
GB_END_DECLARE

11
gb.gsl/src/c_complex.h
View file

@ -31,6 +31,7 @@ MA 02110-1301, USA.
#ifndef _C_COMPLEX_C
extern GB_DESC ComplexDesc[];
extern gsl_complex COMPLEX_zero;
extern gsl_complex COMPLEX_one;
//extern GB_DESC ComplexArrayDesc[];
#endif
@ -42,6 +43,14 @@ typedef
}
CCOMPLEX;
typedef
union
{
gsl_complex z;
double x;
}
COMPLEX_VALUE;
enum
{
CGV_ERR,
@ -55,6 +64,6 @@ char *COMPLEX_to_string(gsl_complex number, bool local);
#define COMPLEX_get(_c) ((_c) ? (_c)->number : COMPLEX_zero)
int COMPLEX_get_value(GB_VALUE *value, double *x, gsl_complex *z);
int COMPLEX_get_value(GB_VALUE *value, COMPLEX_VALUE *v);
#endif /* __C_COMPLEX_H */

552
gb.gsl/src/c_matrix.c
View file

@ -38,26 +38,44 @@
//---- Matrix creation ------------------------------------------------------
static CMATRIX *MATRIX_create(int width, int height, bool complex)
static CMATRIX *MATRIX_create(int width, int height, bool complex, bool init)
{
GB.Push(3, GB_T_INTEGER, width, GB_T_INTEGER, height, GB_T_BOOLEAN, complex);
return (CMATRIX *)GB.New(CLASS_Matrix, NULL, (void *)(intptr_t)3);
CMATRIX *m = GB.Create(CLASS_Matrix, NULL,NULL);
if (complex)
m->matrix = init ? gsl_matrix_complex_calloc(height, width) : gsl_matrix_complex_alloc(height, width);
else
m->matrix = init ? gsl_matrix_calloc(height, width) : gsl_matrix_alloc(height, width);
m->complex = complex;
return m;
}
static CMATRIX *MATRIX_create_from(void *matrix, bool complex)
{
CMATRIX *m = GB.Create(CLASS_Matrix, NULL,NULL);
m->matrix = matrix;
m->complex = complex;
return m;
}
static CMATRIX *MATRIX_copy(CMATRIX *_object)
{
CMATRIX *copy = MATRIX_create(WIDTH(THIS), HEIGHT(THIS), COMPLEX(THIS));
CMATRIX *copy = MATRIX_create(WIDTH(THIS), HEIGHT(THIS), COMPLEX(THIS), FALSE);
if (COMPLEX(THIS))
gsl_matrix_memcpy(MAT(copy), MAT(THIS));
else
gsl_matrix_complex_memcpy(CMAT(copy), CMAT(THIS));
else
gsl_matrix_memcpy(MAT(copy), MAT(THIS));
return copy;
}
#define MATRIX_make(_ma) (((_ma)->ob.ref <= 1) ? (_ma) : MATRIX_copy(_ma))
static CMATRIX *MATRIX_convert_to_complex(CMATRIX *_object)
{
CMATRIX *m = MATRIX_create(WIDTH(THIS), HEIGHT(THIS), TRUE);
CMATRIX *m = MATRIX_create(WIDTH(THIS), HEIGHT(THIS), TRUE, FALSE);
int i, j;
for (i = 0; i < HEIGHT(THIS); i++)
@ -67,7 +85,7 @@ static CMATRIX *MATRIX_convert_to_complex(CMATRIX *_object)
return m;
}
static void ensure_complex(CMATRIX *_object)
static void MATRIX_ensure_complex(CMATRIX *_object)
{
gsl_matrix_complex *v;
int w = WIDTH(THIS);
@ -88,34 +106,381 @@ static void ensure_complex(CMATRIX *_object)
}
/*static bool ensure_not_complex(CMATRIX *_object)
/*static bool MATRIX_ensure_not_complex(CMATRIX *_object)
{
gsl_matrix *v;
int size = SIZE(THIS);
int i;
gsl_matrix *m;
int w = WIDTH(THIS);
int h = HEIGHT(THIS);
int i, j;
gsl_complex c;
if (!COMPLEX(THIS))
return FALSE;
for (i = 0; i < size; i++)
{
c = gsl_matrix_complex_get(CMAT(THIS), i);
if (GSL_IMAG(c) != 0.0)
return TRUE;
}
for (i = 0; i < h; i++)
for (j = 0; j < w; j++)
{
c = gsl_matrix_complex_get(CMAT(THIS), i, j);
if (GSL_IMAG(c) != 0.0)
return TRUE;
}
v = gsl_matrix_alloc(size);
m = gsl_matrix_alloc(h, w);
for (i = 0; i < size; i++)
gsl_matrix_set(v, i, GSL_REAL(gsl_matrix_complex_get(CMAT(THIS), i)));
for (i = 0; i < h; i++)
for (j = 0; j < w; j++)
gsl_matrix_set(m, i, j, GSL_REAL(gsl_matrix_complex_get(CMAT(THIS), i, j)));
gsl_matrix_complex_free(CMAT(THIS));
THIS->matrix = v;
THIS->matrix = m;
THIS->complex = FALSE;
return FALSE;
}*/
static void matrix_negative(void *m, bool complex)
{
uint i;
gsl_matrix *mm = (gsl_matrix *)m;
double *d = mm->data;
uint n = (uint)(mm->size1 * mm->size2);
if (complex)
n *= 2;
for (i = 0; i < n; i++)
d[i] = -d[i];
}
static bool get_determinant(CMATRIX *m, COMPLEX_VALUE *det)
{
int sign = 0;
int size = WIDTH(m);
if (size != HEIGHT(m))
return TRUE;
gsl_permutation *p = gsl_permutation_calloc(size);
if (COMPLEX(m))
{
gsl_matrix_complex *tmp = gsl_matrix_complex_alloc(size, size);
gsl_matrix_complex_memcpy(tmp, CMAT(m));
gsl_linalg_complex_LU_decomp(tmp, p, &sign);
det->z = gsl_linalg_complex_LU_det(tmp, sign);
gsl_matrix_complex_free(tmp);
}
else
{
gsl_matrix *tmp = gsl_matrix_alloc(size, size);
gsl_matrix_memcpy(tmp, MAT(m));
gsl_linalg_LU_decomp(tmp, p, &sign);
det->x = gsl_linalg_LU_det(tmp, sign);
det->z.dat[1] = 0;
gsl_matrix_free(tmp);
}
gsl_permutation_free(p);
return FALSE;
}
static void *matrix_invert(void *m, bool complex)
{
int sign = 0;
int size = ((gsl_matrix *)m)->size1;
void *result;
if (size != ((gsl_matrix *)m)->size2)
return NULL;
gsl_permutation *p = gsl_permutation_calloc(size);
if (!complex)
{
gsl_matrix *tmp = gsl_matrix_alloc(size, size);
result = gsl_matrix_alloc(size, size);
gsl_matrix_memcpy(tmp, (gsl_matrix *)m);
gsl_linalg_LU_decomp(tmp, p, &sign);
if (gsl_linalg_LU_invert(tmp, p, (gsl_matrix *)result) != GSL_SUCCESS)
{
gsl_matrix_free(result);
return NULL;
}
gsl_matrix_free(tmp);
}
else
{
gsl_matrix_complex *tmp = gsl_matrix_complex_alloc(size, size);
result = gsl_matrix_complex_alloc(size, size);
gsl_matrix_complex_memcpy(tmp, (gsl_matrix_complex *)m);
gsl_linalg_complex_LU_decomp(tmp, p, &sign);
if (gsl_linalg_complex_LU_invert(tmp, p, (gsl_matrix_complex *)result) != GSL_SUCCESS)
{
gsl_matrix_complex_free(result);
return NULL;
}
gsl_matrix_complex_free(tmp);
}
gsl_permutation_free(p);
return result;
}
//---- Arithmetic operators -------------------------------------------------
#define IMPLEMENT_OP(_name) \
static CMATRIX *_name(CMATRIX *a, CMATRIX *b, bool invert) \
{ \
CMATRIX *m; \
\
if (COMPLEX(a) || COMPLEX(b)) \
{ \
MATRIX_ensure_complex(a); \
MATRIX_ensure_complex(b); \
m = MAKE_MATRIX(a); \
CFUNC(CMAT(m), CMAT(a), CMAT(b)); \
} \
else \
{ \
m = MAKE_MATRIX(a); \
FUNC(MAT(m), MAT(a), MAT(b)); \
} \
\
return m; \
}
#define IMPLEMENT_OP_FLOAT(_name) \
static CMATRIX *_name(CMATRIX *a, double f, bool invert) \
{ \
CMATRIX *m = MAKE_MATRIX(a); \
\
if (COMPLEX(a)) \
{ \
CFUNC(CMAT(m), CMAT(a), f); \
} \
else \
{ \
FUNC(MAT(m), MAT(a), f); \
} \
\
return m; \
}
#define IMPLEMENT_OP_OTHER(_name) \
static CMATRIX *_name(CMATRIX *a, void *b, bool invert) \
{ \
CMATRIX *m = MAKE_MATRIX(a); \
\
if (GB.Is(b, CLASS_Complex)) \
{ \
MATRIX_ensure_complex(m); \
CFUNC(CMAT(m), CMAT(a), ((CCOMPLEX *)b)->number); \
return m; \
} \
else \
return NULL; \
}
#define MAKE_MATRIX(_a) MATRIX_make(_a)
#define FUNC(_m, _a, _b) gsl_matrix_add(_m, _b)
#define CFUNC(_m, _a, _b) gsl_matrix_complex_add(_m, _b)
IMPLEMENT_OP(_add)
#undef FUNC
#undef CFUNC
#define FUNC(_m, _a, _f) gsl_matrix_add_constant(_m, _f)
#define CFUNC(_m, _a, _f) gsl_matrix_complex_add_constant(_m, gsl_complex_rect(_f, 0))
IMPLEMENT_OP_FLOAT(_addf)
#undef FUNC
#undef CFUNC
#define CFUNC(_m, _a, _c) gsl_matrix_complex_add_constant(_m, _c)
IMPLEMENT_OP_OTHER(_addo)
#undef CFUNC
#define FUNC(_m, _a, _b) gsl_matrix_sub(_m, _b)
#define CFUNC(_m, _a, _b) gsl_matrix_complex_sub(_m, _b)
IMPLEMENT_OP(_sub)
#undef FUNC
#undef CFUNC
#define FUNC(_m, _a, _f) \
if (invert) \
{ \
matrix_negative(_m, FALSE); \
gsl_matrix_add_constant(_m, _f); \
} \
else \
gsl_matrix_add_constant(_m, -(_f));
#define CFUNC(_m, _a, _f) \
if (invert) \
{ \
matrix_negative(_m, TRUE); \
gsl_matrix_complex_add_constant(_m, gsl_complex_rect((_f), 0)); \
} \
else \
gsl_matrix_complex_add_constant(_m, gsl_complex_rect(-(_f), 0));
IMPLEMENT_OP_FLOAT(_subf)
#undef FUNC
#undef CFUNC
#define CFUNC(_m, _a, _c) \
if (invert) \
matrix_negative(_m, TRUE); \
else \
gsl_complex_negative(_c); \
gsl_matrix_complex_add_constant(_m, _c);
IMPLEMENT_OP_OTHER(_subo)
#undef CFUNC
#define FUNC(_m, _a, _f) gsl_matrix_scale(_m, _f)
#define CFUNC(_m, _a, _f) gsl_matrix_complex_scale(_m, gsl_complex_rect(_f, 0))
IMPLEMENT_OP_FLOAT(_mulf)
#undef FUNC
#undef CFUNC
#define CFUNC(_m, _a, _c) gsl_matrix_complex_scale(_m, _c)
IMPLEMENT_OP_OTHER(_mulo)
#undef CFUNC
#undef MAKE_MATRIX
#define MAKE_MATRIX(_a) MATRIX_copy(_a)
#define FUNC(_m, _a, _b) gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, _a, _b, 0.0, _m);
#define CFUNC(_m, _a, _b) gsl_blas_zgemm(CblasNoTrans, CblasNoTrans, COMPLEX_one, _a, _b, COMPLEX_zero, _m);
IMPLEMENT_OP(_mul)
#undef FUNC
#undef CFUNC
#define FUNC(_m, _a, _b) \
{ \
gsl_matrix *inv = matrix_invert(_b, FALSE); \
if (!inv) \
return NULL; \
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, _a, inv, 0.0, _m); \
gsl_matrix_free(inv); \
}
#define CFUNC(_m, _a, _b) \
{ \
gsl_matrix_complex *inv = matrix_invert(_b, TRUE); \
if (!inv) \
return NULL; \
gsl_blas_zgemm(CblasNoTrans, CblasNoTrans, COMPLEX_one, _a, inv, COMPLEX_zero, _m); \
gsl_matrix_complex_free(inv); \
}
IMPLEMENT_OP(_div)
#undef FUNC
#undef CFUNC
static CMATRIX *_divf(CMATRIX *a, double f, bool invert)
{
bool complex = COMPLEX(a);
CMATRIX *m;
if (invert)
{
void *inv = matrix_invert(MAT(a), complex);
if (!inv)
return NULL;
m = MATRIX_create_from(inv, complex);
}
else
{
if (f == 0.0)
return NULL;
f = 1 / f;
m = MATRIX_make(a);
}
if (complex)
gsl_matrix_complex_scale(CMAT(m), gsl_complex_rect(f, 0));
else
gsl_matrix_scale(MAT(m), f);
return m;
}
static CMATRIX *_divo(CMATRIX *a, void *b, bool invert)
{
bool complex = COMPLEX(a);
CMATRIX *m;
gsl_complex c;
if (!GB.Is(b, CLASS_Complex))
return NULL;
c = ((CCOMPLEX *)b)->number;
if (invert)
{
void *inv = matrix_invert(MAT(a), complex);
if (!inv)
return NULL;
m = MATRIX_create_from(inv, complex);
}
else
{
if (c.dat[0] == 0 && c.dat[1] == 0)
return NULL;
c = gsl_complex_inverse(c);
m = MATRIX_make(a);
}
MATRIX_ensure_complex(m);
gsl_matrix_complex_scale(CMAT(m), c);
return m;
}
static int _equal(CMATRIX *a, CMATRIX *b)
{
if (COMPLEX(a) || COMPLEX(b))
{
MATRIX_ensure_complex(a);
MATRIX_ensure_complex(b);
return gsl_matrix_complex_equal(CMAT(a), CMAT(b));
}
else
return gsl_matrix_equal(MAT(a), MAT(b));
}
static CMATRIX *_neg(CMATRIX *a)
{
CMATRIX *m = MATRIX_make(a);
matrix_negative(m->matrix, m->complex);
return m;
}
static GB_OPERATOR_DESC _operator =
{
.equal = (void *)_equal,
//.equalf = (void *)_equalf,
.add = (void *)_add,
.addf = (void *)_addf,
.addo = (void *)_addo,
.sub = (void *)_sub,
.subf = (void *)_subf,
.subo = (void *)_subo,
.mul = (void *)_mul,
.mulf = (void *)_mulf,
.mulo = (void *)_mulo,
.div = (void *)_div,
.divf = (void *)_divf,
.divo = (void *)_divo,
.neg = (void *)_neg
};
//---- Conversions ----------------------------------------------------------
static char *_to_string(CMATRIX *_object, bool local)
@ -129,11 +494,11 @@ static char *_to_string(CMATRIX *_object, bool local)
result = GB.AddChar(result, '[');
for (i = 0; i < w; i++)
for (i = 0; i < h; i++)
{
result = GB.AddChar(result, '[');
for (j = 0; j < h; j++)
for (j = 0; j < w; j++)
{
if (j)
result = GB.AddChar(result, ' ');
@ -232,10 +597,10 @@ static bool _convert(CMATRIX *_object, GB_TYPE type, GB_VALUE *conv)
}
else if (type >= GB_T_OBJECT)
{
if (type == CLASS_Complex)
/*if (type == CLASS_Complex)
{
CCOMPLEX *c = (CCOMPLEX *)conv->_object.value;
CMATRIX *m = MATRIX_create(2, 2, FALSE);
CMATRIX *m = MATRIX_create(2, 2, FALSE, FALSE);
gsl_matrix_set(MAT(m), 0, 0, GSL_REAL(c->number));
gsl_matrix_set(MAT(m), 1, 1, GSL_REAL(c->number));
@ -245,7 +610,7 @@ static bool _convert(CMATRIX *_object, GB_TYPE type, GB_VALUE *conv)
conv->_object.value = m;
return FALSE;
}
else if (GB.Is(conv->_object.value, CLASS_Array))
else*/ if (GB.Is(conv->_object.value, CLASS_Array))
{
GB_ARRAY array = (GB_ARRAY)conv->_object.value;
GB_ARRAY array2;
@ -284,7 +649,7 @@ static bool _convert(CMATRIX *_object, GB_TYPE type, GB_VALUE *conv)
}
//fprintf(stderr, "create: %d %d %d\n", width, height, complex);
m = MATRIX_create(width, height, complex);
m = MATRIX_create(width, height, complex, TRUE);
for (i = 0; i < height; i++)
{
@ -338,9 +703,9 @@ static bool _convert(CMATRIX *_object, GB_TYPE type, GB_VALUE *conv)
}
}
}
else if (type > GB_T_BOOLEAN && type <= GB_T_FLOAT)
/*else if (type > GB_T_BOOLEAN && type <= GB_T_FLOAT)
{
CMATRIX *m = MATRIX_create(2, 2, FALSE);
CMATRIX *m = MATRIX_create(2, 2, FALSE, TRUE);
double value;
if (type == GB_T_FLOAT)
@ -355,7 +720,7 @@ static bool _convert(CMATRIX *_object, GB_TYPE type, GB_VALUE *conv)
conv->_object.value = m;
return FALSE;
}
}*/
return TRUE;
}
@ -439,8 +804,7 @@ BEGIN_METHOD(Matrix_put, GB_VARIANT value; GB_INTEGER i; GB_INTEGER j)
int i = VARG(i), j = VARG(j);
GB_VALUE *value = (GB_VALUE *)ARG(value);
int type;
gsl_complex z;
double x;
COMPLEX_VALUE cv;
if (i < 0 || i >= h || j < 0 || j >= w)
{
@ -448,22 +812,22 @@ BEGIN_METHOD(Matrix_put, GB_VARIANT value; GB_INTEGER i; GB_INTEGER j)
return;
}
type = COMPLEX_get_value(value, &x, &z);
type = COMPLEX_get_value(value, &cv);
if (type == CGV_ERR)
return;
if (type == CGV_COMPLEX)
{
ensure_complex(THIS);
gsl_matrix_complex_set(CMAT(THIS), i, j, z);
MATRIX_ensure_complex(THIS);
gsl_matrix_complex_set(CMAT(THIS), i, j, cv.z);
}
else
{
if (COMPLEX(THIS))
gsl_matrix_complex_set(CMAT(THIS), i, j, z);
gsl_matrix_complex_set(CMAT(THIS), i, j, cv.z);
else
gsl_matrix_set(MAT(THIS), i, j, x);
gsl_matrix_set(MAT(THIS), i, j, cv.x);
}
END_METHOD
@ -473,25 +837,24 @@ BEGIN_METHOD(Matrix_Scale, GB_VALUE value)
GB_VALUE *value = (GB_VALUE *)ARG(value);
int type;
gsl_complex z;
double x;
COMPLEX_VALUE cv;
type = COMPLEX_get_value(value, &x, &z);
type = COMPLEX_get_value(value, &cv);
if (type == CGV_ERR)
return;
if (type == CGV_COMPLEX)
{
ensure_complex(THIS);
gsl_matrix_complex_scale(CMAT(THIS), z);
MATRIX_ensure_complex(THIS);
gsl_matrix_complex_scale(CMAT(THIS), cv.z);
}
else
{
if (COMPLEX(THIS))
gsl_matrix_complex_scale(CMAT(THIS), z);
gsl_matrix_complex_scale(CMAT(THIS), cv.z);
else
gsl_matrix_scale(MAT(THIS), x);
gsl_matrix_scale(MAT(THIS), cv.x);
}
GB.ReturnObject(THIS);
@ -552,7 +915,7 @@ END_PROPERTY
BEGIN_METHOD(Matrix_Identity, GB_INTEGER width; GB_INTEGER height; GB_BOOLEAN complex)
CMATRIX *m = MATRIX_create(VARGOPT(width, 2), VARGOPT(height, 2), VARGOPT(complex, FALSE));
CMATRIX *m = MATRIX_create(VARGOPT(width, 2), VARGOPT(height, 2), VARGOPT(complex, FALSE), FALSE);
if (COMPLEX(m))
gsl_matrix_complex_set_identity(CMAT(m));
@ -688,6 +1051,95 @@ BEGIN_METHOD(Matrix_SetColumn, GB_INTEGER column; GB_OBJECT vector)
END_METHOD
BEGIN_METHOD_VOID(Matrix_Determinant)
COMPLEX_VALUE cv;
if (get_determinant(THIS, &cv))
{
GB.Error("Matrix is not square");
return;
}
if (COMPLEX(THIS))
GB.ReturnObject(COMPLEX_create(cv.z));
else
GB.ReturnFloat(cv.x);
GB.ReturnConvVariant();
END_METHOD
BEGIN_METHOD(Matrix_call, GB_OBJECT vector)
CVECTOR *v = VARG(vector);
CVECTOR *result;
if (GB.CheckObject(v))
return;
if (COMPLEX(THIS) || v->complex)
{
MATRIX_ensure_complex(THIS);
VECTOR_ensure_complex(v);
result = VECTOR_create(SIZE(v), TRUE, FALSE);
gsl_blas_zgemv(CblasNoTrans, COMPLEX_one, CMAT(THIS), CVEC(v), COMPLEX_zero, CVEC(result));
GB.ReturnObject(result);
}
else
{
result = VECTOR_create(SIZE(v), FALSE, FALSE);
gsl_blas_dgemv(CblasNoTrans, 1.0, MAT(THIS), VEC(v), 0.0, VEC(result));
GB.ReturnObject(result);
}
END_METHOD
BEGIN_METHOD_VOID(Matrix_Transpose)
if (!COMPLEX(THIS))
{
gsl_matrix *m = gsl_matrix_alloc(WIDTH(THIS), HEIGHT(THIS));
gsl_matrix_transpose_memcpy(m, MAT(THIS));
gsl_matrix_free(MAT(THIS));
THIS->matrix = m;
}
else
{
gsl_matrix_complex *m = gsl_matrix_complex_alloc(WIDTH(THIS), HEIGHT(THIS));
gsl_matrix_complex_transpose_memcpy(m, CMAT(THIS));
gsl_matrix_complex_free(CMAT(THIS));
THIS->matrix = m;
}
GB.ReturnObject(THIS);
END_METHOD
BEGIN_METHOD_VOID(Matrix_Invert)
void *m = matrix_invert(THIS->matrix, COMPLEX(THIS));
if (!m)
{
GB.ReturnNull();
return;
}
if (COMPLEX(THIS))
gsl_matrix_complex_free(CMAT(THIS));
else
gsl_matrix_free(MAT(THIS));
THIS->matrix = m;
GB.ReturnObject(THIS);
END_METHOD
//---------------------------------------------------------------------------
GB_DESC MatrixDesc[] =
{
@ -704,9 +1156,13 @@ GB_DESC MatrixDesc[] =
GB_PROPERTY_READ("Height", "i", Matrix_Height),
GB_PROPERTY_READ("Handle", "p", Matrix_Handle),
GB_METHOD("Determinant", "v", Matrix_Determinant, NULL),
GB_METHOD("_get", "v", Matrix_get, "(I)i(J)i"),
GB_METHOD("_put", NULL, Matrix_put, "(Value)v(I)i(J)i"),
GB_METHOD("_call", "Vector", Matrix_call, "(Vector)Vector"),
GB_METHOD("Scale", "Matrix", Matrix_Scale, "(Value)v"),
GB_METHOD("Equal", "b", Matrix_Equal, "(Matrix)Matrix;"),
@ -715,7 +1171,11 @@ GB_DESC MatrixDesc[] =
GB_METHOD("SetRow", NULL, Matrix_SetRow, "(Row)i(Vector)Vector;"),
GB_METHOD("SetColumn", NULL, Matrix_SetColumn, "(Column)i(Vector)Vector;"),
GB_METHOD("Transpose", "Matrix", Matrix_Transpose, NULL),
GB_METHOD("Invert", "Matrix", Matrix_Invert, NULL),
GB_INTERFACE("_convert", &_convert),
GB_INTERFACE("_operator", &_operator),
GB_END_DECLARE
};

31
gb.gsl/src/c_polynomial.c
View file

@ -25,8 +25,9 @@
#define __C_POLYNOMIAL_C
#include "c_polynomial.h"
#include "c_complex.h"
#include "c_vector.h"
#include "c_polynomial.h"
#define THIS ((CPOLYNOMIAL *)_object)
#define DATA(_p) ((double *)(_p)->data)
@ -313,7 +314,7 @@ char *POLYNOMIAL_to_string(CPOLYNOMIAL *p, bool local)
return result;
}
static bool _convert(CPOLYNOMIAL *a, GB_TYPE type, GB_VALUE *conv)
bool POLYNOMIAL_convert(CPOLYNOMIAL *a, GB_TYPE type, GB_VALUE *conv)
{
if (a)
{
@ -344,7 +345,7 @@ static bool _convert(CPOLYNOMIAL *a, GB_TYPE type, GB_VALUE *conv)
default:
if (type >= GB_T_OBJECT)
{
if (GB.Is(conv->_object.value, GB.FindClass("Array")))
if (GB.Is(conv->_object.value, CLASS_Array))
{
CPOLYNOMIAL *p;
CCOMPLEX *c;
@ -489,8 +490,7 @@ BEGIN_METHOD(Polynomial_put, GB_VARIANT value; GB_INTEGER index)
int index = VARG(index);
GB_VALUE *value = (GB_VALUE *)ARG(value);
int type;
gsl_complex z;
double x;
COMPLEX_VALUE cv;
if (index < 0 || index > 65535)
{
@ -498,7 +498,7 @@ BEGIN_METHOD(Polynomial_put, GB_VARIANT value; GB_INTEGER index)
return;
}
type = COMPLEX_get_value(value, &x, &z);
type = COMPLEX_get_value(value, &cv);
if (type == CGV_ERR)
return;
@ -508,14 +508,14 @@ BEGIN_METHOD(Polynomial_put, GB_VARIANT value; GB_INTEGER index)
if (type == CGV_COMPLEX)
{
ensure_complex(THIS);
CDATA(THIS)[index] = z;
CDATA(THIS)[index] = cv.z;
}
else
{
if (COMPLEX(THIS))
CDATA(THIS)[index] = gsl_complex_rect(x, 0);
CDATA(THIS)[index] = cv.z;
else
DATA(THIS)[index] = x;
DATA(THIS)[index] = cv.x;
}
END_METHOD
@ -525,23 +525,22 @@ BEGIN_METHOD(Polynomial_Eval, GB_VARIANT value)
GB_VALUE *value = (GB_VALUE *)ARG(value);
int type;
double x;
gsl_complex z;
COMPLEX_VALUE cv;
type = COMPLEX_get_value(value, &x, &z);
type = COMPLEX_get_value(value, &cv);
if (type == CGV_ERR)
return;
if (COMPLEX(THIS))
{
GB.ReturnObject(COMPLEX_create(gsl_complex_poly_complex_eval(CDATA(THIS), COUNT(THIS), z)));
GB.ReturnObject(COMPLEX_create(gsl_complex_poly_complex_eval(CDATA(THIS), COUNT(THIS), cv.z)));
}
else
{
if (type == CGV_COMPLEX)
GB.ReturnObject(COMPLEX_create(gsl_poly_complex_eval(DATA(THIS), COUNT(THIS), z)));
GB.ReturnObject(COMPLEX_create(gsl_poly_complex_eval(DATA(THIS), COUNT(THIS), cv.z)));
else
GB.ReturnFloat(gsl_poly_eval(DATA(THIS), COUNT(THIS), x));
GB.ReturnFloat(gsl_poly_eval(DATA(THIS), COUNT(THIS), cv.x));
}
END_METHOD
@ -736,7 +735,7 @@ GB_DESC PolynomialDesc[] =
GB_METHOD("Solve", "Array", Polynomial_Solve, "[(Complex)b]"),
//GB_INTERFACE("_operators", &_operators),
GB_INTERFACE("_convert", &_convert),
GB_INTERFACE("_convert", &POLYNOMIAL_convert),
GB_END_DECLARE
};

2
gb.gsl/src/c_polynomial.h
View file

@ -43,4 +43,6 @@ typedef
}
CPOLYNOMIAL;
bool POLYNOMIAL_convert(CPOLYNOMIAL *a, GB_TYPE type, GB_VALUE *conv);
#endif /* __C_POLYNOMIAL_H */

85
gb.gsl/src/c_vector.c
View file

@ -26,6 +26,7 @@
#define __C_VECTOR_C
#include "c_complex.h"
#include "c_polynomial.h"
#include "c_vector.h"
#define THIS ((CVECTOR *)_object)
@ -288,7 +289,7 @@ static bool _convert(CVECTOR *_object, GB_TYPE type, GB_VALUE *conv)
return FALSE;
default:
return TRUE;
break;
}
}
else
@ -321,9 +322,62 @@ static bool _convert(CVECTOR *_object, GB_TYPE type, GB_VALUE *conv)
return FALSE;
default:
return TRUE;
break;
}
}
// Vector ---> Float[]
if ((type == GB.FindClass("Float[]") || type == CLASS_Polynomial) && !COMPLEX(THIS))
{
GB_ARRAY a;
int i;
double *data;
GB.Array.New(&a, GB_T_FLOAT, SIZE(THIS));
data = (double *)GB.Array.Get(a, 0);
for(i = 0; i < SIZE(THIS); i++)
data[i] = gsl_vector_get(VEC(THIS), i);
conv->_object.value = a;
if (type != CLASS_Polynomial)
return FALSE;
}
// Vector ---> Complex[]
else if (type == GB.FindClass("Complex[]") || type == CLASS_Polynomial)
{
GB_ARRAY a;
int i;
void **data;
CCOMPLEX *c;
GB.Array.New(&a, CLASS_Complex, SIZE(THIS));
data = (void **)GB.Array.Get(a, 0);
for(i = 0; i < SIZE(THIS); i++)
{
c = COMPLEX_create(COMPLEX(THIS) ? gsl_vector_complex_get(CVEC(THIS), i) : gsl_complex_rect(gsl_vector_get(VEC(THIS), i), 0));
data[i] = c;
GB.Ref(c);
}
conv->_object.value = a;
if (type != CLASS_Polynomial)
return FALSE;
}
else
return TRUE;
// Vector ---> Polynomial
if (type == CLASS_Polynomial)
{
void *unref = conv->_object.value;
GB.Ref(unref); // Will be unref by the next GB.Conv()
POLYNOMIAL_convert(FALSE, type, conv);
GB.Unref(&unref); // Will be unref by the next GB.Conv()
//GB.Conv(conv, type);
//GB.UnrefKeep(&conv->_object.value, FALSE); // Will be ref again after the current GB.Conv()
return FALSE;
}
}
else if (type >= GB_T_OBJECT)
{
@ -337,6 +391,7 @@ static bool _convert(CVECTOR *_object, GB_TYPE type, GB_VALUE *conv)
void *data;
GB_TYPE atype = GB.Array.Type(array);
// Float[] Integer[] ... ---> Vector
if (atype > GB_T_BOOLEAN && atype <= GB_T_FLOAT)
{
v = VECTOR_create(size, FALSE, FALSE);
@ -352,6 +407,7 @@ static bool _convert(CVECTOR *_object, GB_TYPE type, GB_VALUE *conv)
conv->_object.value = v;
return FALSE;
}
// Variant[] ---> Vector
else if (atype == GB_T_VARIANT)
{
CCOMPLEX *c;
@ -373,6 +429,7 @@ static bool _convert(CVECTOR *_object, GB_TYPE type, GB_VALUE *conv)
conv->_object.value = v;
return FALSE;
}
// Complex[] ---> Vector
else if (atype == CLASS_Complex)
{
CCOMPLEX *c;
@ -391,6 +448,7 @@ static bool _convert(CVECTOR *_object, GB_TYPE type, GB_VALUE *conv)
return FALSE;
}
}
// Float Integer... ---> Vector
else if (type > GB_T_BOOLEAN && type <= GB_T_FLOAT)
{
CVECTOR *v = VECTOR_create(1, FALSE, FALSE);
@ -403,6 +461,7 @@ static bool _convert(CVECTOR *_object, GB_TYPE type, GB_VALUE *conv)
conv->_object.value = v;
return FALSE;
}
// Complex ---> Vector
else if (type == CLASS_Complex)
{
CCOMPLEX *c = (CCOMPLEX *)conv->_object.value;
@ -486,8 +545,7 @@ BEGIN_METHOD(Vector_put, GB_VARIANT value; GB_INTEGER index)
int size = SIZE(THIS);
GB_VALUE *value = (GB_VALUE *)ARG(value);
int type;
gsl_complex z;
double x;
COMPLEX_VALUE cv;
if (index < 0 || index > size)
{
@ -495,7 +553,7 @@ BEGIN_METHOD(Vector_put, GB_VARIANT value; GB_INTEGER index)
return;
}
type = COMPLEX_get_value(value, &x, &z);
type = COMPLEX_get_value(value, &cv);
if (type == CGV_ERR)
return;
@ -503,14 +561,14 @@ BEGIN_METHOD(Vector_put, GB_VARIANT value; GB_INTEGER index)
if (type == CGV_COMPLEX)
{
VECTOR_ensure_complex(THIS);
gsl_vector_complex_set(CVEC(THIS), index, z);
gsl_vector_complex_set(CVEC(THIS), index, cv.z);
}
else
{
if (COMPLEX(THIS))
gsl_vector_complex_set(CVEC(THIS), index, z);
gsl_vector_complex_set(CVEC(THIS), index, cv.z);
else
gsl_vector_set(VEC(THIS), index, x);
gsl_vector_set(VEC(THIS), index, cv.x);
}
END_METHOD
@ -520,10 +578,9 @@ BEGIN_METHOD(Vector_Scale, GB_VALUE value)
GB_VALUE *value = (GB_VALUE *)ARG(value);
int type;
gsl_complex z;
double x;
COMPLEX_VALUE cv;
type = COMPLEX_get_value(value, &x, &z);
type = COMPLEX_get_value(value, &cv);
if (type == CGV_ERR)
return;
@ -531,14 +588,14 @@ BEGIN_METHOD(Vector_Scale, GB_VALUE value)
if (type == CGV_COMPLEX)
{
VECTOR_ensure_complex(THIS);
gsl_vector_complex_scale(CVEC(THIS), z);
gsl_vector_complex_scale(CVEC(THIS), cv.z);
}
else
{
if (COMPLEX(THIS))
gsl_vector_complex_scale(CVEC(THIS), z);
gsl_vector_complex_scale(CVEC(THIS), cv.z);
else
gsl_vector_scale(VEC(THIS), x);
gsl_vector_scale(VEC(THIS), cv.x);
}
GB.ReturnObject(THIS);

2
gb.gsl/src/main.h
View file

@ -35,6 +35,8 @@
#include <gsl/gsl_complex.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_complex_math.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_matrix.h>
#ifndef __MAIN_C
extern GB_INTERFACE GB;

1
main/gbx/gbx_api.c
View file

@ -1106,6 +1106,7 @@ void GB_Error(const char *error, ...)
EXEC_set_native_error(TRUE);
}
#if DEBUG_REF
#include <execinfo.h>

50
main/gbx/gbx_c_class.c
View file

@ -61,7 +61,7 @@ static CLASS_DESC *get_desc(CLASS *class, const char *name)
return class->table[index].desc;
}
/**** Components ***********************************************************/
//---- Components ---------------------------------------------------------
BEGIN_METHOD(Components_get, GB_STRING name)
@ -129,7 +129,7 @@ BEGIN_METHOD(Component_IsLoaded, GB_STRING name)
END_METHOD
/**** Classes **************************************************************/
//---- Classes ------------------------------------------------------------
BEGIN_METHOD(Classes_get, GB_STRING name)
@ -166,13 +166,6 @@ BEGIN_METHOD(Class_Load, GB_STRING name)
END_METHOD
BEGIN_PROPERTY(Class_Name)
GB_ReturnConstZeroString(OBJECT(CLASS)->name);
END_PROPERTY
BEGIN_METHOD_VOID(Classes_next)
TABLE *table = CLASS_get_table();
@ -206,7 +199,15 @@ BEGIN_PROPERTY(Classes_count)
END_PROPERTY
/**** Class ****************************************************************/
//---- Class --------------------------------------------------------------
BEGIN_PROPERTY(Class_Name)
GB_ReturnConstZeroString(OBJECT(CLASS)->name);
END_PROPERTY
BEGIN_PROPERTY(Class_Count)
@ -214,30 +215,35 @@ BEGIN_PROPERTY(Class_Count)
END_PROPERTY
BEGIN_PROPERTY(Class_Hidden)
GB_ReturnBoolean(*(OBJECT(CLASS)->name) == '.');
END_PROPERTY
BEGIN_PROPERTY(Class_Native)
GB_ReturnBoolean(CLASS_is_native(OBJECT(CLASS)));
END_PROPERTY
BEGIN_PROPERTY(Class_Component)
GB_ReturnObject(OBJECT(CLASS)->component);
END_PROPERTY
BEGIN_PROPERTY(Class_Parent)
GB_ReturnObject(OBJECT(CLASS)->parent);
END_PROPERTY
BEGIN_PROPERTY(Class_Symbols)
CLASS *class = OBJECT(CLASS);
@ -259,6 +265,7 @@ BEGIN_PROPERTY(Class_Symbols)
END_PROPERTY
BEGIN_METHOD(Class_get, GB_STRING name)
CLASS *class = OBJECT(CLASS);
@ -286,6 +293,7 @@ BEGIN_PROPERTY(Class_Instance)
END_PROPERTY
BEGIN_METHOD_VOID(Class_AutoCreate)
CLASS *class = OBJECT(CLASS);
@ -297,6 +305,7 @@ BEGIN_METHOD_VOID(Class_AutoCreate)
END_METHOD
BEGIN_METHOD(Class_New, GB_OBJECT params)
CLASS *class = OBJECT(CLASS);
@ -325,7 +334,7 @@ BEGIN_METHOD(Class_New, GB_OBJECT params)
END_METHOD
/**** Symbol ***************************************************************/
//---- Symbol -------------------------------------------------------------
BEGIN_PROPERTY(Symbol_Name)
@ -452,7 +461,7 @@ BEGIN_PROPERTY(Symbol_Value)
END_PROPERTY
/**** Object ***************************************************************/
//---- Object -------------------------------------------------------------
BEGIN_METHOD(Object_GetProperty, GB_OBJECT object; GB_STRING property)
@ -642,6 +651,7 @@ BEGIN_METHOD(Object_SetProperty, GB_OBJECT object; GB_STRING property; GB_VARIAN
END_METHOD
BEGIN_METHOD(Object_Attach, GB_OBJECT object; GB_OBJECT parent; GB_STRING name)
void *object = VARG(object);
@ -667,6 +677,7 @@ BEGIN_METHOD(Object_Attach, GB_OBJECT object; GB_OBJECT parent; GB_STRING name)
END_METHOD
BEGIN_METHOD(Object_Detach, GB_OBJECT object)
void *object = VARG(object);
@ -681,6 +692,7 @@ BEGIN_METHOD(Object_Detach, GB_OBJECT object)
END_METHOD
BEGIN_METHOD(Object_Parent, GB_OBJECT object)
void *object = VARG(object);
@ -692,6 +704,7 @@ BEGIN_METHOD(Object_Parent, GB_OBJECT object)
END_METHOD
BEGIN_METHOD(Object_Class, GB_OBJECT object)
void *object = VARG(object);
@ -703,6 +716,7 @@ BEGIN_METHOD(Object_Class, GB_OBJECT object)
END_METHOD
BEGIN_METHOD(Object_Type, GB_OBJECT object)
void *object = VARG(object);
@ -714,6 +728,7 @@ BEGIN_METHOD(Object_Type, GB_OBJECT object)
END_METHOD
BEGIN_METHOD(Object_Is, GB_OBJECT object; GB_STRING class)
void *object = VARG(object);
@ -732,6 +747,7 @@ BEGIN_METHOD(Object_Is, GB_OBJECT object; GB_STRING class)
END_METHOD
BEGIN_METHOD(Object_Call, GB_OBJECT object; GB_STRING method; GB_OBJECT params)
int i;
@ -771,12 +787,14 @@ BEGIN_METHOD(Object_Call, GB_OBJECT object; GB_STRING method; GB_OBJECT params)
END_METHOD
BEGIN_METHOD(Object_IsValid, GB_OBJECT object)
GB_ReturnBoolean(OBJECT_is_valid(VARG(object)));
END_METHOD
BEGIN_METHOD(Object_Lock, GB_OBJECT object)
void *object = VARG(object);
@ -788,6 +806,7 @@ BEGIN_METHOD(Object_Lock, GB_OBJECT object)
END_METHOD
BEGIN_METHOD(Object_Unlock, GB_OBJECT object)
void *object = VARG(object);
@ -799,6 +818,7 @@ BEGIN_METHOD(Object_Unlock, GB_OBJECT object)
END_METHOD
BEGIN_METHOD(Object_IsLocked, GB_OBJECT object)
void *object = VARG(object);
@ -810,6 +830,7 @@ BEGIN_METHOD(Object_IsLocked, GB_OBJECT object)
END_METHOD
BEGIN_METHOD(Object_Count, GB_OBJECT object)
void *object = VARG(object);
@ -822,6 +843,7 @@ BEGIN_METHOD(Object_Count, GB_OBJECT object)
END_METHOD
BEGIN_METHOD(Object_SizeOf, GB_OBJECT object)
void *object = VARG(object);
@ -833,6 +855,7 @@ BEGIN_METHOD(Object_SizeOf, GB_OBJECT object)
END_METHOD
BEGIN_METHOD(Object_New, GB_STRING class; GB_OBJECT params)
CLASS *class = CLASS_find(GB_ToZeroString(ARG(class)));
@ -866,6 +889,7 @@ BEGIN_METHOD(Object_New, GB_STRING class; GB_OBJECT params)
END_METHOD
BEGIN_PROPERTY(Object_Address)
GB_ReturnPointer(VPROP(GB_OBJECT));
@ -875,7 +899,7 @@ END_PROPERTY
#endif
/***************************************************************************/
//-------------------------------------------------------------------------
GB_DESC NATIVE_Symbol[] =
{

14
main/gbx/gbx_c_class.h
View file

@ -27,14 +27,12 @@
#include "gambas.h"
#ifndef __GBX_C_CLASS_C
EXTERN GB_DESC NATIVE_Component[];
EXTERN GB_DESC NATIVE_Components[];
EXTERN GB_DESC NATIVE_Class[];
EXTERN GB_DESC NATIVE_Classes[];
EXTERN GB_DESC NATIVE_Object[];
EXTERN GB_DESC NATIVE_Symbol[];
extern GB_DESC NATIVE_Component[];
extern GB_DESC NATIVE_Components[];
extern GB_DESC NATIVE_Class[];
extern GB_DESC NATIVE_Classes[];
extern GB_DESC NATIVE_Object[];
extern GB_DESC NATIVE_Symbol[];
#endif
#endif

22
main/gbx/gbx_class.c
View file

@ -1264,8 +1264,11 @@ void *CLASS_auto_create(CLASS *class, int nparam)
return class->instance;
}
#define SET_OPTIONAL_OPERATOR(_class, _op, _func) if (!CLASS_has_operator(_class, _op)) (_class)->operators[_op] = (EXEC_no_operator##_func)
void CLASS_search_special(CLASS *class)
{
static int _operator_strength = 0;
int sym;
class->special[SPEC_NEW] = CLASS_get_symbol_index_kind(class, "_new", CD_METHOD, 0);
@ -1287,11 +1290,28 @@ void CLASS_search_special(CLASS *class)
class->convert = CLASS_get_desc(class, sym)->constant.value._pointer;
}
sym = CLASS_get_symbol_index_kind(class, "_@_operators", CD_CONSTANT, 0);
sym = CLASS_get_symbol_index_kind(class, "_@_operator", CD_CONSTANT, 0);
if (sym != NO_SYMBOL)
{
class->has_operators = TRUE;
class->operators = CLASS_get_desc(class, sym)->constant.value._pointer;
_operator_strength++;
CLASS_set_operator_strength(class, _operator_strength);
//fprintf(stderr, "%s: strength = %ld\n", class->name, CLASS_get_operator_strength(class));
SET_OPTIONAL_OPERATOR(class, CO_EQUALF, _O_OF);
SET_OPTIONAL_OPERATOR(class, CO_EQUALO, _O_OO);
SET_OPTIONAL_OPERATOR(class, CO_ADDF, _O_OF);
SET_OPTIONAL_OPERATOR(class, CO_ADDO, _O_OO);
SET_OPTIONAL_OPERATOR(class, CO_SUBF, _O_OF);
SET_OPTIONAL_OPERATOR(class, CO_SUBO, _O_OO);
SET_OPTIONAL_OPERATOR(class, CO_MULF, _O_OF);
SET_OPTIONAL_OPERATOR(class, CO_MULO, _O_OO);
SET_OPTIONAL_OPERATOR(class, CO_DIVF, _O_OF);
SET_OPTIONAL_OPERATOR(class, CO_DIVO, _O_OO);
SET_OPTIONAL_OPERATOR(class, CO_POW, _O_OO);
SET_OPTIONAL_OPERATOR(class, CO_POWF, _O_OF);
SET_OPTIONAL_OPERATOR(class, CO_POWO, _O_OO);
}
if (class->special[SPEC_NEXT] != NO_SYMBOL)

32
main/gbx/gbx_class.h
View file

@ -239,26 +239,14 @@ enum
};
enum {
CO_EQUAL,
CO_EQUALF,
CO_COMP,
CO_COMPF,
CO_ADD,
CO_ADDF,
CO_SUB,
CO_SUBF,
CO_ISUBF,
CO_MUL,
CO_MULF,
CO_DIV,
CO_DIVF,
CO_IDIVF,
CO_NEG,
CO_POW,
CO_POWF,
CO_ABS,
CO_MAX,
CO_MIN
CO_EQUAL, CO_EQUALF, CO_EQUALO,
CO_ADD, CO_ADDF, CO_ADDO,
CO_SUB, CO_SUBF, CO_SUBO,
CO_MUL, CO_MULF, CO_MULO,
CO_DIV, CO_DIVF, CO_DIVO,
CO_POW, CO_POWF, CO_POWO,
CO_NEG, CO_ABS,
CO_STRENGTH
};
typedef
@ -334,7 +322,7 @@ typedef
struct _CLASS *astruct_class; // 112 176 array of struct class
void *instance; // 116 184 automatically created instance
void *operators; // 120 192 arithmetic interface
void **operators; // 120 192 arithmetic interface
bool (*convert)(); // 124 200 convert method
COMPONENT *component; // 128 208 The component the class belongs to
@ -549,5 +537,7 @@ CLASS *CLASS_register(GB_DESC *desc);
#define CLASS_is_virtual(class) (class->is_virtual)
#define CLASS_has_operator(_class, _op) (((void **)(_class)->operators)[_op] != NULL)
#define CLASS_get_operator_strength(_class) (((intptr_t *)(_class)->operators)[CO_STRENGTH])
#define CLASS_set_operator_strength(_class, _strength) (((intptr_t *)(_class)->operators)[CO_STRENGTH] = (_strength))
#endif /* _CLASS_H */

6
main/gbx/gbx_exec.h
View file

@ -76,8 +76,8 @@ enum {
OP_NOTHING = 0,
OP_OBJECT_FLOAT,
OP_FLOAT_OBJECT,
OP_OBJECT_CONV,
OP_CONV_OBJECT,
OP_OBJECT_OTHER,
OP_OTHER_OBJECT,
OP_OBJECT_OBJECT
};
@ -303,6 +303,8 @@ do { \
#define EXEC_set_native_error(_err) (ERROR_current->info.native = (_err))
#define EXEC_has_native_error() (ERROR_current->info.native)
void *EXEC_no_operator_O_OO(void *a, void *b, bool invert);
void *EXEC_no_operator_O_OF(void *a, double b, bool invert);
bool EXEC_check_operator_single(VALUE *P1);
int EXEC_check_operator(VALUE *P1, VALUE *P2);
void EXEC_operator(uchar what, uchar op, VALUE *P1, VALUE *P2);

64
main/gbx/gbx_exec_loop.c
View file

@ -2065,7 +2065,7 @@ _SUBR_COMP:
static void *jump[] = {
&&__SC_VARIANT, &&__SC_BOOLEAN, &&__SC_BYTE, &&__SC_SHORT, &&__SC_INTEGER, &&__SC_LONG, &&__SC_SINGLE, &&__SC_FLOAT, &&__SC_DATE,
&&__SC_STRING, &&__SC_STRING, &&__SC_POINTER, &&__SC_ERROR, &&__SC_ERROR, &&__SC_ERROR, &&__SC_NULL, &&__SC_OBJECT,
&&__SC_OBJECT_FLOAT, &&__SC_FLOAT_OBJECT, &&__SC_OBJECT_CONV, &&__SC_CONV_OBJECT, &&__SC_OBJECT_OBJECT
&&__SC_OBJECT_FLOAT, &&__SC_FLOAT_OBJECT, &&__SC_OBJECT_OTHER, &&__SC_OTHER_OBJECT, &&__SC_OBJECT_OBJECT
};
char NO_WARNING(result);
@ -2169,14 +2169,14 @@ _SUBR_COMP:
result = EXEC_comparator(OP_FLOAT_OBJECT, CO_EQUALF, P1, P2);
goto __SC_END;
__SC_OBJECT_CONV:
__SC_OBJECT_OTHER:
result = EXEC_comparator(OP_OBJECT_CONV, CO_EQUAL, P1, P2);
result = EXEC_comparator(OP_OBJECT_OTHER, CO_EQUALO, P1, P2);
goto __SC_END;
__SC_CONV_OBJECT:
__SC_OTHER_OBJECT:
result = EXEC_comparator(OP_CONV_OBJECT, CO_EQUAL, P1, P2);
result = EXEC_comparator(OP_OTHER_OBJECT, CO_EQUALO, P1, P2);
goto __SC_END;
__SC_OBJECT_OBJECT:
@ -2404,7 +2404,7 @@ static void _SUBR_compn(ushort code)
static void *jump[] = {
&&__VARIANT, &&__BOOLEAN, &&__BYTE, &&__SHORT, &&__INTEGER, &&__LONG, &&__SINGLE, &&__FLOAT, &&__DATE,
&&__STRING, &&__STRING, &&__POINTER, &&__ERROR, &&__ERROR, &&__ERROR, &&__NULL, &&__OBJECT,
&&__OBJECT_FLOAT, &&__FLOAT_OBJECT, &&__OBJECT_CONV, &&__CONV_OBJECT, &&__OBJECT_OBJECT
&&__OBJECT_FLOAT, &&__FLOAT_OBJECT, &&__OBJECT_OTHER, &&__OTHER_OBJECT, &&__OBJECT_OBJECT
};
//static void *test[] = { &&__EQ, &&__NE, &&__GT, &&__LE, &&__LT, &&__GE };
@ -2510,14 +2510,14 @@ __FLOAT_OBJECT:
result = EXEC_comparator(OP_FLOAT_OBJECT, CO_EQUALF, P1, P2);
goto __END;
__OBJECT_CONV:
__OBJECT_OTHER:
result = EXEC_comparator(OP_OBJECT_CONV, CO_EQUAL, P1, P2);
result = EXEC_comparator(OP_OBJECT_OTHER, CO_EQUALO, P1, P2);
goto __END;
__CONV_OBJECT:
__OTHER_OBJECT:
result = EXEC_comparator(OP_CONV_OBJECT, CO_EQUAL, P1, P2);
result = EXEC_comparator(OP_OTHER_OBJECT, CO_EQUALO, P1, P2);
goto __END;
__OBJECT_OBJECT:
@ -2706,7 +2706,7 @@ static void _SUBR_add(ushort code)
{
static void *jump[] = {
&&__VARIANT, &&__BOOLEAN, &&__BYTE, &&__SHORT, &&__INTEGER, &&__LONG, &&__SINGLE, &&__FLOAT, &&__DATE, NULL, NULL, &&__POINTER,
&&__OBJECT_FLOAT, &&__FLOAT_OBJECT, &&__OBJECT_CONV, &&__CONV_OBJECT, &&__OBJECT
&&__OBJECT_FLOAT, &&__FLOAT_OBJECT, &&__OBJECT_OTHER, &&__OTHER_OBJECT, &&__OBJECT
};
TYPE type;
@ -2779,14 +2779,14 @@ __FLOAT_OBJECT:
EXEC_operator(OP_FLOAT_OBJECT, CO_ADDF, P1, P2);
goto __END;
__OBJECT_CONV:
__OBJECT_OTHER:
EXEC_operator(OP_OBJECT_CONV, CO_ADD, P1, P2);
EXEC_operator(OP_OBJECT_OTHER, CO_ADDO, P1, P2);
goto __END;
__CONV_OBJECT:
__OTHER_OBJECT:
EXEC_operator(OP_CONV_OBJECT, CO_ADD, P1, P2);
EXEC_operator(OP_OTHER_OBJECT, CO_ADDO, P1, P2);
goto __END;
__OBJECT:
@ -2812,7 +2812,7 @@ static void _SUBR_sub(ushort code)
{
static void *jump[] = {
&&__VARIANT, &&__BOOLEAN, &&__BYTE, &&__SHORT, &&__INTEGER, &&__LONG, &&__SINGLE, &&__FLOAT, &&__DATE, NULL, NULL, &&__POINTER,
&&__OBJECT_FLOAT, &&__FLOAT_OBJECT, &&__OBJECT_CONV, &&__CONV_OBJECT, &&__OBJECT
&&__OBJECT_FLOAT, &&__FLOAT_OBJECT, &&__OBJECT_OTHER, &&__OTHER_OBJECT, &&__OBJECT
};
TYPE type;
@ -2880,17 +2880,17 @@ __OBJECT_FLOAT:
__FLOAT_OBJECT:
EXEC_operator(OP_FLOAT_OBJECT, CO_ISUBF, P1, P2);
EXEC_operator(OP_FLOAT_OBJECT, CO_SUBF, P1, P2);
goto __END;
__OBJECT_CONV:
__OBJECT_OTHER:
EXEC_operator(OP_OBJECT_CONV, CO_SUB, P1, P2);
EXEC_operator(OP_OBJECT_OTHER, CO_SUBO, P1, P2);
goto __END;
__CONV_OBJECT:
__OTHER_OBJECT:
EXEC_operator(OP_CONV_OBJECT, CO_SUB, P1, P2);
EXEC_operator(OP_OTHER_OBJECT, CO_SUBO, P1, P2);
goto __END;
__OBJECT:
@ -2916,7 +2916,7 @@ static void _SUBR_mul(ushort code)
{
static void *jump[] = {
&&__VARIANT, &&__BOOLEAN, &&__BYTE, &&__SHORT, &&__INTEGER, &&__LONG, &&__SINGLE, &&__FLOAT, &&__ERROR,
&&__OBJECT_FLOAT, &&__FLOAT_OBJECT, &&__OBJECT_CONV, &&__CONV_OBJECT, &&__OBJECT
&&__OBJECT_FLOAT, &&__FLOAT_OBJECT, &&__OBJECT_OTHER, &&__OTHER_OBJECT, &&__OBJECT
};
TYPE type;
@ -2981,14 +2981,14 @@ __FLOAT_OBJECT:
EXEC_operator(OP_FLOAT_OBJECT, CO_MULF, P1, P2);
goto __END;
__OBJECT_CONV:
__OBJECT_OTHER:
EXEC_operator(OP_OBJECT_CONV, CO_MUL, P1, P2);
EXEC_operator(OP_OBJECT_OTHER, CO_MULO, P1, P2);
goto __END;
__CONV_OBJECT:
__OTHER_OBJECT:
EXEC_operator(OP_CONV_OBJECT, CO_MUL, P1, P2);
EXEC_operator(OP_OTHER_OBJECT, CO_MULO, P1, P2);
goto __END;
__OBJECT:
@ -3014,7 +3014,7 @@ static void _SUBR_div(ushort code)
{
static void *jump[] = {
&&__VARIANT, &&__BOOLEAN, &&__BYTE, &&__SHORT, &&__INTEGER, &&__LONG, &&__SINGLE, &&__FLOAT, &&__ERROR,
&&__OBJECT_FLOAT, &&__FLOAT_OBJECT, &&__OBJECT_CONV, &&__CONV_OBJECT, &&__OBJECT
&&__OBJECT_FLOAT, &&__FLOAT_OBJECT, &&__OBJECT_OTHER, &&__OTHER_OBJECT, &&__OBJECT
};
TYPE type;
@ -3050,17 +3050,17 @@ __OBJECT_FLOAT:
__FLOAT_OBJECT:
EXEC_operator(OP_FLOAT_OBJECT, CO_IDIVF, P1, P2);
EXEC_operator(OP_FLOAT_OBJECT, CO_DIVF, P1, P2);
goto __CHECK_OBJECT;
__OBJECT_CONV:
__OBJECT_OTHER:
EXEC_operator(OP_OBJECT_CONV, CO_DIV, P1, P2);
EXEC_operator(OP_OBJECT_OTHER, CO_DIVO, P1, P2);
goto __CHECK_OBJECT;
__CONV_OBJECT:
__OTHER_OBJECT:
EXEC_operator(OP_CONV_OBJECT, CO_DIV, P1, P2);
EXEC_operator(OP_OTHER_OBJECT, CO_DIVO, P1, P2);
goto __CHECK_OBJECT;
__OBJECT:

177
main/gbx/gbx_exec_operator.c
View file

@ -24,19 +24,21 @@
#define __GBX_EXEC_OPERATOR_C
#include "gb_common.h"
#include "gbx_type.h"
#include "gbx_api.h"
#include "gbx_exec.h"
typedef
void *(*FUNC_O_OF)(void *, double);
void *(*FUNC_O_OF)(void *, double, bool);
typedef
void *(*FUNC_O_OO)(void *, void *);
void *(*FUNC_O_OO)(void *, void *, bool);
typedef
int (*FUNC_I_OF)(void *, double);
int (*FUNC_I_OF)(void *, double, bool);
typedef
int (*FUNC_I_OO)(void *, void *);
int (*FUNC_I_OO)(void *, void *, bool);
typedef
void *(*FUNC_O_O)(void *);
@ -44,6 +46,18 @@ typedef
typedef
double (*FUNC_F_O)(void *);
void *EXEC_no_operator_O_OO(void *a, void *b, bool invert)
{
GB_Error((char *)E_TYPE, TYPE_get_name((TYPE)OBJECT_class(a)), TYPE_get_name((TYPE)OBJECT_class(b)));
return NULL;
}
void *EXEC_no_operator_O_OF(void *a, double b, bool invert)
{
GB_Error((char *)E_TYPE, TYPE_get_name((TYPE)OBJECT_class(a)), "Number");
return NULL;
}
bool EXEC_check_operator_single(VALUE *P1)
{
@ -81,7 +95,12 @@ int EXEC_check_operator(VALUE *P1, VALUE *P2)
return OP_OBJECT_OBJECT;
if (class2 && class2->has_operators)
return OP_OBJECT_CONV;
{
if (CLASS_get_operator_strength(class1) > CLASS_get_operator_strength(class2))
return OP_OBJECT_OTHER;
else
return OP_OTHER_OBJECT;
}
}
}
@ -90,128 +109,170 @@ int EXEC_check_operator(VALUE *P1, VALUE *P2)
void EXEC_operator(uchar what, uchar op, VALUE *P1, VALUE *P2)
{
static void *jump[] = { NULL, &&__OBJECT_FLOAT, &&__FLOAT_OBJECT, &&__OBJECT_CONV, &&__CONV_OBJECT, &&__OBJECT_OBJECT };
static void *jump[] = { NULL, &&__OBJECT_FLOAT, &&__FLOAT_OBJECT, &&__OBJECT_OTHER, &&__OTHER_OBJECT, &&__OBJECT_OBJECT };
void *func;
void *result;
bool invert;
void *o1, *o2;
goto *jump[what];
__OBJECT_FLOAT:
if (!P1->_object.object)
o1 = P1->_object.object;
if (!o1)
THROW(E_NULL);
func = ((void **)(OBJECT_class(P1->_object.object)->operators))[op];
func = OBJECT_class(o1)->operators[op];
VALUE_conv_float(P2);
result = (*(FUNC_O_OF)func)(P1->_object.object, P2->_float.value);
result = (*(FUNC_O_OF)func)(o1, P2->_float.value, FALSE);
OBJECT_REF(result, "EXEC_operator");
OBJECT_UNREF(P1->_object.object, "EXEC_operator");
OBJECT_UNREF(o1, "EXEC_operator");
goto __END;
__FLOAT_OBJECT:
if (!P2->_object.object)
o2 = P2->_object.object;
if (!o2)
THROW(E_NULL);
func = ((void **)(OBJECT_class(P2->_object.object)->operators))[op];
func = OBJECT_class(o2)->operators[op];
VALUE_conv_float(P1);
result = (*(FUNC_O_OF)func)(P2->_object.object, P1->_float.value);
result = (*(FUNC_O_OF)func)(o2, P1->_float.value, TRUE);
OBJECT_REF(result, "EXEC_operator");
P1->_object.class = P2->_object.class;
OBJECT_UNREF(P2->_object.object, "EXEC_operator");
OBJECT_UNREF(o2, "EXEC_operator");
goto __END;
__OBJECT_CONV:
__OTHER_OBJECT:
VALUE_conv(P2, (TYPE)P1->_object.class);
goto __OBJECT_OBJECT;
o2 = P1->_object.object;
o1 = P2->_object.object;
__CONV_OBJECT:
VALUE_conv(P1, (TYPE)P2->_object.class);
goto __OBJECT_OBJECT;
invert = TRUE;
goto __OTHER;
__OBJECT_OTHER:
__OBJECT_OBJECT:
if (!OBJECT_are_not_null(P1->_object.object, P2->_object.object))
o1 = P1->_object.object;
o2 = P2->_object.object;
invert = FALSE;
goto __OTHER;
__OTHER:
if (!OBJECT_are_not_null(o1, o2))
THROW(E_NULL);
func = ((void **)(OBJECT_class(P1->_object.object)->operators))[op];
result = (*(FUNC_O_OO)func)(P1->_object.object, P2->_object.object);
func = OBJECT_class(o1)->operators[op];
result = (*(FUNC_O_OO)func)(o1, o2, invert);
OBJECT_REF(result, "EXEC_operator");
OBJECT_UNREF(P1->_object.object, "EXEC_operator");
OBJECT_UNREF(P2->_object.object, "EXEC_operator");
OBJECT_UNREF(o1, "EXEC_operator");
OBJECT_UNREF(o2, "EXEC_operator");
__END:
P1->_object.object = result;
if (EXEC_has_native_error())
{
EXEC_set_native_error(FALSE);
PROPAGATE();
}
}
void EXEC_operator_object_add_quick(VALUE *P1, double val)
{
if (P1->_object.object)
{
void *func = ((void **)(OBJECT_class(P1->_object.object)->operators))[CO_ADDF];
void *result = (*(FUNC_O_OF)func)(P1->_object.object, val);
void *func = OBJECT_class(P1->_object.object)->operators[CO_ADDF];
void *result = (*(FUNC_O_OF)func)(P1->_object.object, val, FALSE);
OBJECT_REF(result, "EXEC_operator_object_float_direct");
OBJECT_UNREF(P1->_object.object, "EXEC_operator_object_float_direct");
P1->_object.object = result;
}
else
THROW(E_NULL);
if (EXEC_has_native_error())
{
EXEC_set_native_error(FALSE);
PROPAGATE();
}
}
bool EXEC_comparator(uchar what, uchar op, VALUE *P1, VALUE *P2)
{
static void *jump[] = { NULL, &&__OBJECT_FLOAT, &&__FLOAT_OBJECT, &&__OBJECT_CONV, &&__CONV_OBJECT, &&__OBJECT_OBJECT };
static void *jump[] = { NULL, &&__OBJECT_FLOAT, &&__FLOAT_OBJECT, &&__OBJECT_OTHER, &&__OTHER_OBJECT, &&__OBJECT_OBJECT };
void *func;
int result;
bool invert;
void *o1, *o2;
goto *jump[what];
__OBJECT_FLOAT:
func = ((void **)(OBJECT_class(P1->_object.object)->operators))[op];
o1 = P1->_object.object;
func = OBJECT_class(o1)->operators[op];
VALUE_conv_float(P2);
result = (*(FUNC_I_OF)func)(P1->_object.object, P2->_float.value);
OBJECT_UNREF(P1->_object.object, "EXEC_comparator");
return result;
result = (*(FUNC_I_OF)func)(o1, P2->_float.value, FALSE);
OBJECT_UNREF(o1, "EXEC_comparator");
goto __END;
__FLOAT_OBJECT:
func = ((void **)(OBJECT_class(P2->_object.object)->operators))[op];
o2 = P2->_object.object;
func = OBJECT_class(o2)->operators[op];
VALUE_conv_float(P1);
result = (*(FUNC_I_OF)func)(P2->_object.object, P1->_float.value);
OBJECT_UNREF(P2->_object.object, "EXEC_comparator");
return result;
result = (*(FUNC_I_OF)func)(o2, P1->_float.value, TRUE);
OBJECT_UNREF(o2, "EXEC_comparator");
goto __END;
__OBJECT_CONV:
__OTHER_OBJECT:
VALUE_conv(P2, (TYPE)P1->_object.class);
goto __OBJECT_OBJECT;
__CONV_OBJECT:
VALUE_conv(P1, (TYPE)P2->_object.class);
goto __OBJECT_OBJECT;
o2 = P1->_object.object;
o1 = P2->_object.object;
invert = TRUE;
goto __OTHER;
__OBJECT_OTHER:
__OBJECT_OBJECT:
func = ((void **)(OBJECT_class(P1->_object.object)->operators))[op];
result = (*(FUNC_I_OO)func)(P1->_object.object, P2->_object.object);
OBJECT_UNREF(P1->_object.object, "EXEC_comparator");
OBJECT_UNREF(P2->_object.object, "EXEC_comparator");
return result != 0;
o1 = P1->_object.object;
o2 = P2->_object.object;
invert = FALSE;
goto __OTHER;
__OTHER:
func = OBJECT_class(o1)->operators[op];
result = (*(FUNC_I_OO)func)(o1, o2, invert);
OBJECT_UNREF(o1, "EXEC_comparator");
OBJECT_UNREF(o2, "EXEC_comparator");
result = !!result; // result != 0;
__END:
if (EXEC_has_native_error())
{
EXEC_set_native_error(FALSE);
PROPAGATE();
}
return result;
}
void EXEC_operator_object_abs(VALUE *P1)
{
if (P1->_object.object)
{
void *func = ((void **)(OBJECT_class(P1->_object.object)->operators))[CO_ABS];
void *func = OBJECT_class(P1->_object.object)->operators[CO_ABS];
double result = (*(FUNC_F_O)func)(P1->_object.object);
OBJECT_UNREF(P1->_object.object, "EXEC_operator_object_abs");
P1->type = T_FLOAT;
@ -219,13 +280,19 @@ void EXEC_operator_object_abs(VALUE *P1)
}
else
THROW(E_NULL);
if (EXEC_has_native_error())
{
EXEC_set_native_error(FALSE);
PROPAGATE();
}
}
void EXEC_operator_object_single(uchar op, VALUE *P1)
{
if (P1->_object.object)
{
void *func = ((void **)(OBJECT_class(P1->_object.object)->operators))[op];
void *func = OBJECT_class(P1->_object.object)->operators[op];
void *result = (*(FUNC_O_O)func)(P1->_object.object);
OBJECT_REF(result, "EXEC_operator_object_single");
OBJECT_UNREF(P1->_object.object, "EXEC_operator_object_single");
@ -233,4 +300,10 @@ void EXEC_operator_object_single(uchar op, VALUE *P1)
}
else
THROW(E_NULL);
if (EXEC_has_native_error())
{
EXEC_set_native_error(FALSE);
PROPAGATE();
}
}

43
main/gbx/gbx_subr_math.c
View file

@ -212,7 +212,7 @@ __END:
void SUBR_pow(ushort code)
{
static void *jump[] = {
&&__VARIANT, &&__NUMBER_INTEGER, &&__NUMBER_FLOAT, &&__OBJECT_FLOAT, &&__OBJECT_OBJECT
&&__VARIANT, &&__NUMBER_INTEGER, &&__NUMBER_FLOAT, &&__OBJECT_FLOAT, &&__OBJECT_OTHER, &&__OBJECT_OBJECT
};
VALUE *P1, *P2;
@ -239,31 +239,25 @@ __VARIANT:
variant = TRUE;
}
if (EXEC_check_operator_single(P1) && CLASS_has_operator(OBJECT_class(P1->_object.object), CO_POW))
{
if (TYPE_is_number(P2->type))
type = 3;
else if (EXEC_check_operator_single(P2) && CLASS_has_operator(OBJECT_class(P2->_object.object), CO_POW))
{
VALUE_conv(P2, (TYPE)OBJECT_class(P1->_object.object));
type = 4;
}
else
VALUE_conv(P2, T_FLOAT);
}
else
if (TYPE_is_number(P1->type) && TYPE_is_number(P2->type))
{
if (TYPE_is_integer(P2->type))
type = 1;
else if (!TYPE_is_object(P2->type))
type = 2;
else if (EXEC_check_operator_single(P2) && CLASS_has_operator(OBJECT_class(P2->_object.object), CO_POW))
{
VALUE_conv(P1, (TYPE)OBJECT_class(P2->_object.object));
type = 4;
}
else
THROW(E_MATH);
type = 2;
}
else
{
type = EXEC_check_operator(P1, P2);
if (type == OP_OBJECT_FLOAT)
type = 3;
else if (type == OP_OBJECT_OTHER)
type = 4;
else if (type == OP_OBJECT_OBJECT)
type = 5;
else
THROW(E_TYPE, "Number", TYPE_get_name(P2->type));
}
if (!variant)
@ -314,6 +308,11 @@ __OBJECT_FLOAT:
EXEC_operator(OP_OBJECT_FLOAT, CO_POWF, P1, P2);
goto __END;
__OBJECT_OTHER:
EXEC_operator(OP_OBJECT_OTHER, CO_POWO, P1, P2);
goto __END;
__OBJECT_OBJECT:
EXEC_operator(OP_OBJECT_OBJECT, CO_POW, P1, P2);

116
main/lib/complex/ccomplex.c
View file

@ -59,64 +59,64 @@ CCOMPLEX *COMPLEX_push_complex(double value)
//---- Arithmetic operators -------------------------------------------------
static CCOMPLEX *_addf(CCOMPLEX *a, double f)
static CCOMPLEX *_addf(CCOMPLEX *a, double f, bool invert)
{
return COMPLEX_make(a, RE(a) + f, IM(a));
}
static CCOMPLEX *_add(CCOMPLEX *a, CCOMPLEX *b)
static CCOMPLEX *_add(CCOMPLEX *a, CCOMPLEX *b, bool invert)
{
return COMPLEX_make(a, RE(a) + RE(b), IM(a) + IM(b));
}
static CCOMPLEX *_subf(CCOMPLEX *a, double f)
static CCOMPLEX *_subf(CCOMPLEX *a, double f, bool invert)
{
return COMPLEX_make(a, RE(a) - f, IM(a));
if (invert)
return COMPLEX_make(a, f - RE(a), -IM(a));
else
return COMPLEX_make(a, RE(a) - f, IM(a));
}
static CCOMPLEX *_isubf(CCOMPLEX *a, double f)
{
return COMPLEX_make(a, f - RE(a), -IM(a));
}
static CCOMPLEX *_sub(CCOMPLEX *a, CCOMPLEX *b)
static CCOMPLEX *_sub(CCOMPLEX *a, CCOMPLEX *b, bool invert)
{
return COMPLEX_make(a, RE(a) - RE(b), IM(a) - IM(b));
}
static CCOMPLEX *_mulf(CCOMPLEX *a, double f)
static CCOMPLEX *_mulf(CCOMPLEX *a, double f, bool invert)
{
return COMPLEX_make(a, RE(a) * f, IM(a) * f);
}
static CCOMPLEX *_mul(CCOMPLEX *a, CCOMPLEX *b)
static CCOMPLEX *_mul(CCOMPLEX *a, CCOMPLEX *b, bool invert)
{
return COMPLEX_make(a, RE(a) * RE(b) - IM(a) * IM(b), RE(a) * IM(b) + IM(a) * RE(b));
}
static CCOMPLEX *_divf(CCOMPLEX *a, double f)
static CCOMPLEX *_divf(CCOMPLEX *a, double f, bool invert)
{
if (f == 0.0)
return NULL;
return COMPLEX_make(a, RE(a) / f, IM(a) / f);
if (invert)
{
if (ZERO(a))
return NULL;
double s = ABS2(a);
double re, im;
re = RE(a) / s;
im = -IM(a) / s;
return COMPLEX_make(a, re * f, im * f);
}
else
{
if (f == 0.0)
return NULL;
return COMPLEX_make(a, RE(a) / f, IM(a) / f);
}
}
static CCOMPLEX *_idivf(CCOMPLEX *a, double f)
{
if (ZERO(a))
return NULL;
double s = ABS2(a);
double re, im;
re = RE(a) / s;
im = -IM(a) / s;
return COMPLEX_make(a, re * f, im * f);
}
static CCOMPLEX *_div(CCOMPLEX *a, CCOMPLEX *b)
static CCOMPLEX *_div(CCOMPLEX *a, CCOMPLEX *b, bool invert)
{
double ar = RE(a), ai = IM(a);
double br = RE(b), bi = IM(b);
@ -135,12 +135,12 @@ static CCOMPLEX *_div(CCOMPLEX *a, CCOMPLEX *b)
return COMPLEX_make(a, zr, zi);
}
static int _equal(CCOMPLEX *a, CCOMPLEX *b)
static int _equal(CCOMPLEX *a, CCOMPLEX *b, bool invert)
{
return RE(a) == RE(b) && IM(a) == IM(b);
}
static int _equalf(CCOMPLEX *a, double f)
static int _equalf(CCOMPLEX *a, double f, bool invert)
{
return RE(a) == f && IM(a) == 0;
}
@ -193,23 +193,23 @@ static CCOMPLEX *_powi(CCOMPLEX *a, int i)
i = abs(i);
if (i == 2)
r = _mul(a, a);
r = _mul(a, a, FALSE);
else if (i == 3)
{
r = COMPLEX_create(RE(a), IM(a));
r = _mul(r, a);
r = _mul(r, a);
r = _mul(r, a, FALSE);
r = _mul(r, a, FALSE);
}
else if (i == 4)
{
a = _mul(a, a);
r = _mul(a, a);
a = _mul(a, a, FALSE);
r = _mul(a, a, FALSE);
}
else
r = COMPLEX_make(a, RE(a), IM(a));
if (inv)
return _idivf(r, 1);
return _divf(r, 1, TRUE);
else
return r;
}
@ -264,24 +264,22 @@ static CCOMPLEX *_powf(CCOMPLEX *a, double b)
}
}
static GB_OPERATOR_DESC _operators =
static GB_OPERATOR_DESC _operator =
{
add: (void *)_add,
addf: (void *)_addf,
sub: (void *)_sub,
subf: (void *)_subf,
isubf: (void *)_isubf,
mul: (void *)_mul,
mulf: (void *)_mulf,
div: (void *)_div,
divf: (void *)_divf,
idivf: (void *)_idivf,
pow: (void *)_pow,
powf: (void *)_powf,
equal: (void *)_equal,
equalf: (void *)_equalf,
abs: (void *)_abs,
neg: (void *)_neg
.equal = (void *)_equal,
.equalf = (void *)_equalf,
.add = (void *)_add,
.addf = (void *)_addf,
.sub = (void *)_sub,
.subf = (void *)_subf,
.mul = (void *)_mul,
.mulf = (void *)_mulf,
.div = (void *)_div,
.divf = (void *)_divf,
.pow = (void *)_pow,
.powf = (void *)_powf,
.abs = (void *)_abs,
.neg = (void *)_neg
};
//---- Conversions ----------------------------------------------------------
@ -463,7 +461,7 @@ END_PROPERTY
BEGIN_METHOD_VOID(Complex_Inv)
GB.ReturnObject(_idivf(THIS, 1));
GB.ReturnObject(_divf(THIS, 1, TRUE));
END_METHOD
@ -497,7 +495,7 @@ GB_DESC ComplexDesc[] =
GB_METHOD("Abs2", "f", Complex_Abs2, NULL),
GB_METHOD("Arg", "f", Complex_Arg, NULL),
GB_INTERFACE("_operators", &_operators),
GB_INTERFACE("_operator", &_operator),
GB_INTERFACE("_convert", &_convert),
GB_END_DECLARE

35
main/share/gambas.h
View file

@ -830,26 +830,27 @@ typedef
typedef
struct {
int (*equal)(void *, void *);
int (*equal)(void *, void *, bool);
int (*equalf)(void *, double);
int (*comp)(void *, void *);
int (*compf)(void *, double);
void *(*add)(void *, void *);
void *(*addf)(void *, double);
void *(*sub)(void *, void *);
void *(*subf)(void *, double);
void *(*isubf)(void *, double);
void *(*mul)(void *, void *);
void *(*mulf)(void *, double);
void *(*div)(void *, void *);
void *(*divf)(void *, double);
void *(*idivf)(void *, double);
int (*equalo)(void *, void *, bool);
void *(*add)(void *, void *, bool);
void *(*addf)(void *, double, bool);
void *(*addo)(void *, void *, bool);
void *(*sub)(void *, void *, bool);
void *(*subf)(void *, double, bool);
void *(*subo)(void *, void *, bool);
void *(*mul)(void *, void *, bool);
void *(*mulf)(void *, double, bool);
void *(*mulo)(void *, void *, bool);
void *(*div)(void *, void *, bool);
void *(*divf)(void *, double, bool);
void *(*divo)(void *, void *, bool);
void *(*pow)(void *, void *, bool);
void *(*powf)(void *, double, bool);
void *(*powo)(void *, void *, bool);
void *(*neg)(void *);
void *(*pow)(void *, void *);
void *(*powf)(void *, double);
double (*abs)(void *);
void *(*max)(void *, void *);
void *(*min)(void *, void *);
intptr_t _reserved;
}
PACKED
GB_OPERATOR_DESC;