diff options
Diffstat (limited to 'mdk-stage1/slang/slarrfun.inc')
| -rw-r--r-- | mdk-stage1/slang/slarrfun.inc | 257 |
1 files changed, 257 insertions, 0 deletions
diff --git a/mdk-stage1/slang/slarrfun.inc b/mdk-stage1/slang/slarrfun.inc new file mode 100644 index 000000000..348473a6f --- /dev/null +++ b/mdk-stage1/slang/slarrfun.inc @@ -0,0 +1,257 @@ +/* -*- mode: C -*- */ + +/* Some "inline" functions for generic scalar types */ + +#ifdef TRANSPOSE_2D_ARRAY +static SLang_Array_Type *TRANSPOSE_2D_ARRAY (SLang_Array_Type *at, SLang_Array_Type *bt) +{ + GENERIC_TYPE *a_data, *b_data; + int nr, nc, i; + + nr = at->dims[0]; + nc = at->dims[1]; + + a_data = (GENERIC_TYPE *) at->data; + b_data = (GENERIC_TYPE *) bt->data; + + for (i = 0; i < nr; i++) + { + GENERIC_TYPE *offset = b_data + i; + int j; + for (j = 0; j < nc; j++) + { + *offset = *a_data++; + offset += nr; + } + } + return bt; +} +#undef TRANSPOSE_2D_ARRAY +#endif + + +#ifdef INNERPROD_FUNCTION + +static void INNERPROD_FUNCTION + (SLang_Array_Type *at, SLang_Array_Type *bt, SLang_Array_Type *ct, + unsigned int a_loops, unsigned int a_stride, + unsigned int b_loops, unsigned int b_inc, + unsigned int inner_loops) +{ + GENERIC_TYPE_A *a; + GENERIC_TYPE_B *b; + GENERIC_TYPE_C *c; + + c = (GENERIC_TYPE_C *) ct->data; + b = (GENERIC_TYPE_B *) bt->data; + a = (GENERIC_TYPE_A *) at->data; + + while (a_loops--) + { + GENERIC_TYPE_B *bb; + unsigned int j; + + bb = b; + + for (j = 0; j < inner_loops; j++) + { + double x = (double) a[j]; + + if (x != 0.0) + { + unsigned int k; + + for (k = 0; k < b_loops; k++) + c[k] += x * bb[k]; + } + bb += b_inc; + } + c += b_loops; + a += a_stride; + } +} +#undef INNERPROD_FUNCTION + +#undef GENERIC_TYPE_A +#undef GENERIC_TYPE_B +#undef GENERIC_TYPE_C +#endif + +#ifdef INNERPROD_COMPLEX_A +static void INNERPROD_COMPLEX_A + (SLang_Array_Type *at, SLang_Array_Type *bt, SLang_Array_Type *ct, + unsigned int a_loops, unsigned int a_stride, + unsigned int b_loops, unsigned int b_inc, + unsigned int inner_loops) +{ + double *a; + GENERIC_TYPE *b; + double *c; + + c = (double *) ct->data; + b = (GENERIC_TYPE *) bt->data; + a = (double *) at->data; + + a_stride *= 2; + + while (a_loops--) + { + GENERIC_TYPE *bb; + unsigned int bb_loops; + + bb = b; + bb_loops = b_loops; + + while (bb_loops--) + { + double real_sum; + double imag_sum; + unsigned int iloops; + double *aa; + GENERIC_TYPE *bbb; + + aa = a; + bbb = bb; + iloops = inner_loops; + + real_sum = 0.0; + imag_sum = 0.0; + while (iloops--) + { + real_sum += aa[0] * (double)bbb[0]; + imag_sum += aa[1] * (double)bbb[0]; + aa += 2; + bbb += b_inc; + } + + *c++ = real_sum; + *c++ = imag_sum; + bb++; + } + + a += a_stride; + } +} + +static void INNERPROD_A_COMPLEX + (SLang_Array_Type *at, SLang_Array_Type *bt, SLang_Array_Type *ct, + unsigned int a_loops, unsigned int a_stride, + unsigned int b_loops, unsigned int b_inc, + unsigned int inner_loops) +{ + GENERIC_TYPE *a; + double *b; + double *c; + + c = (double *) ct->data; + b = (double *) bt->data; + a = (GENERIC_TYPE *) at->data; + + b_inc *= 2; + + while (a_loops--) + { + double *bb; + unsigned int bb_loops; + + bb = b; + bb_loops = b_loops; + + while (bb_loops--) + { + double real_sum; + double imag_sum; + unsigned int iloops; + GENERIC_TYPE *aa; + double *bbb; + + aa = a; + bbb = bb; + iloops = inner_loops; + + real_sum = 0.0; + imag_sum = 0.0; + while (iloops--) + { + real_sum += (double)aa[0] * bbb[0]; + imag_sum += (double)aa[0] * bbb[1]; + aa += 1; + bbb += b_inc; + } + + *c++ = real_sum; + *c++ = imag_sum; + bb += 2; + } + + a += a_stride; + } +} + +#undef INNERPROD_A_COMPLEX +#undef INNERPROD_COMPLEX_A +#endif /* INNERPROD_COMPLEX_A */ + + +#ifdef INNERPROD_COMPLEX_COMPLEX +static void INNERPROD_COMPLEX_COMPLEX + (SLang_Array_Type *at, SLang_Array_Type *bt, SLang_Array_Type *ct, + unsigned int a_loops, unsigned int a_stride, + unsigned int b_loops, unsigned int b_inc, + unsigned int inner_loops) +{ + double *a; + double *b; + double *c; + + c = (double *) ct->data; + b = (double *) bt->data; + a = (double *) at->data; + + a_stride *= 2; + b_inc *= 2; + + while (a_loops--) + { + double *bb; + unsigned int bb_loops; + + bb = b; + bb_loops = b_loops; + + while (bb_loops--) + { + double real_sum; + double imag_sum; + unsigned int iloops; + double *aa; + double *bbb; + + aa = a; + bbb = bb; + iloops = inner_loops; + + real_sum = 0.0; + imag_sum = 0.0; + while (iloops--) + { + real_sum += aa[0]*bbb[0] - aa[1]*bbb[1]; + imag_sum += aa[0]*bbb[1] + aa[1]*bbb[0]; + aa += 2; + bbb += b_inc; + } + + *c++ = real_sum; + *c++ = imag_sum; + bb += 2; + } + + a += a_stride; + } +} +#undef INNERPROD_COMPLEX_COMPLEX +#endif + +#ifdef GENERIC_TYPE +# undef GENERIC_TYPE +#endif |