From df89e09b2e420e08282dfa7630d87bc74c8cafcb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Beno=C3=AEt=20Minisini?= Date: Sat, 14 Jul 2012 02:49:57 +0000 Subject: [PATCH] [INTERPRETER] * 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 --- gb.gsl/src/c_complex.c | 115 ++++---- gb.gsl/src/c_complex.h | 11 +- gb.gsl/src/c_matrix.c | 552 ++++++++++++++++++++++++++++++++--- gb.gsl/src/c_polynomial.c | 31 +- gb.gsl/src/c_polynomial.h | 2 + gb.gsl/src/c_vector.c | 85 +++++- gb.gsl/src/main.h | 2 + main/gbx/gbx_api.c | 1 + main/gbx/gbx_c_class.c | 50 +++- main/gbx/gbx_c_class.h | 14 +- main/gbx/gbx_class.c | 22 +- main/gbx/gbx_class.h | 32 +- main/gbx/gbx_exec.h | 6 +- main/gbx/gbx_exec_loop.c | 64 ++-- main/gbx/gbx_exec_operator.c | 177 +++++++---- main/gbx/gbx_subr_math.c | 43 ++- main/lib/complex/ccomplex.c | 116 ++++---- main/share/gambas.h | 35 +-- 18 files changed, 994 insertions(+), 364 deletions(-) diff --git a/gb.gsl/src/c_complex.c b/gb.gsl/src/c_complex.c index 0e6b67653..201455529 100644 --- a/gb.gsl/src/c_complex.c +++ b/gb.gsl/src/c_complex.c @@ -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 diff --git a/gb.gsl/src/c_complex.h b/gb.gsl/src/c_complex.h index 0f1642a37..30b86377e 100644 --- a/gb.gsl/src/c_complex.h +++ b/gb.gsl/src/c_complex.h @@ -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 */ diff --git a/gb.gsl/src/c_matrix.c b/gb.gsl/src/c_matrix.c index 223578e9d..8df06ce65 100644 --- a/gb.gsl/src/c_matrix.c +++ b/gb.gsl/src/c_matrix.c @@ -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 }; diff --git a/gb.gsl/src/c_polynomial.c b/gb.gsl/src/c_polynomial.c index 150a96e34..46e1f4e10 100644 --- a/gb.gsl/src/c_polynomial.c +++ b/gb.gsl/src/c_polynomial.c @@ -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 }; diff --git a/gb.gsl/src/c_polynomial.h b/gb.gsl/src/c_polynomial.h index f78ef9c25..c198ac5f1 100644 --- a/gb.gsl/src/c_polynomial.h +++ b/gb.gsl/src/c_polynomial.h @@ -43,4 +43,6 @@ typedef } CPOLYNOMIAL; +bool POLYNOMIAL_convert(CPOLYNOMIAL *a, GB_TYPE type, GB_VALUE *conv); + #endif /* __C_POLYNOMIAL_H */ diff --git a/gb.gsl/src/c_vector.c b/gb.gsl/src/c_vector.c index 10caa5dd4..39504b073 100644 --- a/gb.gsl/src/c_vector.c +++ b/gb.gsl/src/c_vector.c @@ -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); diff --git a/gb.gsl/src/main.h b/gb.gsl/src/main.h index 1c89f2575..484c9ce26 100644 --- a/gb.gsl/src/main.h +++ b/gb.gsl/src/main.h @@ -35,6 +35,8 @@ #include #include #include +#include +#include #ifndef __MAIN_C extern GB_INTERFACE GB; diff --git a/main/gbx/gbx_api.c b/main/gbx/gbx_api.c index 237b41d1a..cb7280d8a 100644 --- a/main/gbx/gbx_api.c +++ b/main/gbx/gbx_api.c @@ -1106,6 +1106,7 @@ void GB_Error(const char *error, ...) EXEC_set_native_error(TRUE); } + #if DEBUG_REF #include diff --git a/main/gbx/gbx_c_class.c b/main/gbx/gbx_c_class.c index 14c3b477b..b5e869fb0 100644 --- a/main/gbx/gbx_c_class.c +++ b/main/gbx/gbx_c_class.c @@ -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[] = { diff --git a/main/gbx/gbx_c_class.h b/main/gbx/gbx_c_class.h index 0cf81cbd8..a41b7828d 100644 --- a/main/gbx/gbx_c_class.h +++ b/main/gbx/gbx_c_class.h @@ -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 diff --git a/main/gbx/gbx_class.c b/main/gbx/gbx_class.c index 685699e21..9136614ad 100644 --- a/main/gbx/gbx_class.c +++ b/main/gbx/gbx_class.c @@ -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) diff --git a/main/gbx/gbx_class.h b/main/gbx/gbx_class.h index 7f59dcfcf..1a227c566 100644 --- a/main/gbx/gbx_class.h +++ b/main/gbx/gbx_class.h @@ -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 */ diff --git a/main/gbx/gbx_exec.h b/main/gbx/gbx_exec.h index 83a7ea8bb..967c941c1 100644 --- a/main/gbx/gbx_exec.h +++ b/main/gbx/gbx_exec.h @@ -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); diff --git a/main/gbx/gbx_exec_loop.c b/main/gbx/gbx_exec_loop.c index fd8f2a633..7242bf788 100644 --- a/main/gbx/gbx_exec_loop.c +++ b/main/gbx/gbx_exec_loop.c @@ -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: diff --git a/main/gbx/gbx_exec_operator.c b/main/gbx/gbx_exec_operator.c index 83ca794aa..ffdb0ee76 100644 --- a/main/gbx/gbx_exec_operator.c +++ b/main/gbx/gbx_exec_operator.c @@ -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(); + } } diff --git a/main/gbx/gbx_subr_math.c b/main/gbx/gbx_subr_math.c index 060091b80..b0d0edc69 100644 --- a/main/gbx/gbx_subr_math.c +++ b/main/gbx/gbx_subr_math.c @@ -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); diff --git a/main/lib/complex/ccomplex.c b/main/lib/complex/ccomplex.c index 7ede15059..76e706ed2 100644 --- a/main/lib/complex/ccomplex.c +++ b/main/lib/complex/ccomplex.c @@ -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 diff --git a/main/share/gambas.h b/main/share/gambas.h index a28f8f010..13c696d7c 100644 --- a/main/share/gambas.h +++ b/main/share/gambas.h @@ -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;