00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038 #include "f90_intrinsic.h"
00039
00040 static size_t read_source_desc(DopeVectorType * array,
00041 size_t src_extent[MAX_NARY_DIMS],
00042 size_t src_stride[MAX_NARY_DIMS],
00043 size_t src_offset[MAX_NARY_DIMS],
00044 int32_t ddim) ;
00045
00046 static void
00047 get_offset_and_stride(DopeVectorType * array,
00048 size_t src_extent[MAX_NARY_DIMS],
00049 size_t src_stride[MAX_NARY_DIMS],
00050 size_t src_offset[MAX_NARY_DIMS],
00051 int32_t ddim) ;
00052
00053 static void alloc_res(DopeVectorType * result,
00054 size_t src_extent[MAX_NARY_DIMS]);
00055
00056 void
00057 _ALL_1(
00058 DopeVectorType *result,
00059 DopeVectorType *array,
00060 i4 *dim)
00061 {
00062 char * result_p, * result_b ;
00063 char * array_p, * array_b ;
00064
00065 size_t src_extent [MAX_NARY_DIMS] ;
00066 size_t counter [MAX_NARY_DIMS] ;
00067 size_t src_offset [MAX_NARY_DIMS] ;
00068 size_t src_stride [MAX_NARY_DIMS] ;
00069 size_t src_size ;
00070
00071 size_t res_stride [MAX_NARY_DIMS] ;
00072 size_t res_offset [MAX_NARY_DIMS] ;
00073
00074 int32_t ddim ;
00075 uint32_t src_rank ;
00076 uint32_t res_rank ;
00077
00078 size_t j,k,i ;
00079
00080 l1 accum ;
00081 l1 const initv = 1 ;
00082 size_t a_size,a_stride;
00083
00084 l1 temp,new ;
00085
00086 if (dim != NULL) {
00087 ddim = (* dim) - 1 ;
00088 } else
00089 ddim = 0 ;
00090
00091 array_b = (char *) GET_ADDRESS_FROM_DESC(array) ;
00092 src_rank = GET_RANK_FROM_DESC(array) - 1;
00093
00094 src_size = read_source_desc(array, src_extent, src_stride, src_offset, ddim);
00095
00096 for (i = 0 ; i <= src_rank ; i ++)
00097 counter[i] = 0 ;
00098
00099 if ((ddim > src_rank ) || (ddim < 0))
00100 ERROR(_LELVL_ABORT,FESCIDIM);
00101
00102 res_rank = GET_RANK_FROM_DESC(result);
00103
00104 if (!GET_ASSOCIATED_FROM_DESC(result)) {
00105 alloc_res(result,src_extent);
00106 }
00107
00108 res_stride[0] = 0;
00109 for (j = 0 ; j <= src_rank; j ++ ) res_offset[j] = 0 ;
00110 for (j = 0 ; j < res_rank ; j ++ ) {
00111 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ;
00112 }
00113
00114 res_offset[0] = res_stride[0] ;
00115 for ( j = 1 ; j < res_rank ; j ++ )
00116 res_offset[j] = res_stride[j] - (res_stride[j-1]*(src_extent[j])) ;
00117
00118 result_b = GET_ADDRESS_FROM_DESC(result);
00119
00120 accum = initv ;
00121
00122 if (src_size == 0 ) {
00123 for (i = 1 ; i <= src_rank ; i ++ )
00124 if (src_extent[i] == 0)
00125 return ;
00126 }
00127 array_p = array_b ;
00128 result_p = result_b ;
00129
00130 a_size = src_extent[0] ;
00131 a_stride = src_stride[0] ;
00132
00133 while (counter[src_rank] < src_extent[src_rank] ) {
00134
00135 if(res_rank != 0) accum = initv ;
00136
00137 for ( i = 0 ; i < a_size ; i ++ ) {
00138 accum &= *(l1 *)array_p ;
00139
00140 array_p += a_stride ;
00141 }
00142 *(l1 *) result_p = accum ;
00143 counter[0] = a_size ;
00144 j = 0 ;
00145 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00146 array_p += src_offset[j] ;
00147 result_p += res_offset[j] ;
00148 counter[j+1]++ ;
00149 counter[j] = 0 ;
00150 j ++ ;
00151 }
00152 }
00153 }
00154 void
00155 _ALL_2(
00156 DopeVectorType *result,
00157 DopeVectorType *array,
00158 i4 *dim)
00159 {
00160 char * result_p, * result_b ;
00161 char * array_p, * array_b ;
00162
00163 size_t src_extent [MAX_NARY_DIMS] ;
00164 size_t counter [MAX_NARY_DIMS] ;
00165 size_t src_offset [MAX_NARY_DIMS] ;
00166 size_t src_stride [MAX_NARY_DIMS] ;
00167 size_t src_size ;
00168
00169 size_t res_stride [MAX_NARY_DIMS] ;
00170 size_t res_offset [MAX_NARY_DIMS] ;
00171
00172 int32_t ddim ;
00173 uint32_t src_rank ;
00174 uint32_t res_rank ;
00175
00176 size_t j,k,i ;
00177
00178 l2 accum ;
00179 l2 const initv = 1 ;
00180 size_t a_size,a_stride;
00181
00182 l2 temp,new ;
00183
00184 if (dim != NULL) {
00185 ddim = (* dim) - 1 ;
00186 } else
00187 ddim = 0 ;
00188
00189 array_b = (char *) GET_ADDRESS_FROM_DESC(array) ;
00190 src_rank = GET_RANK_FROM_DESC(array) - 1;
00191
00192 src_size = read_source_desc(array, src_extent, src_stride, src_offset, ddim);
00193
00194 for (i = 0 ; i <= src_rank ; i ++)
00195 counter[i] = 0 ;
00196
00197 if ((ddim > src_rank ) || (ddim < 0))
00198 ERROR(_LELVL_ABORT,FESCIDIM);
00199
00200 res_rank = GET_RANK_FROM_DESC(result);
00201
00202 if (!GET_ASSOCIATED_FROM_DESC(result)) {
00203 alloc_res(result,src_extent);
00204 }
00205
00206 res_stride[0] = 0;
00207 for (j = 0 ; j <= src_rank; j ++ ) res_offset[j] = 0 ;
00208 for (j = 0 ; j < res_rank ; j ++ ) {
00209 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ;
00210 }
00211
00212 res_offset[0] = res_stride[0] ;
00213 for ( j = 1 ; j < res_rank ; j ++ )
00214 res_offset[j] = res_stride[j] - (res_stride[j-1]*(src_extent[j])) ;
00215
00216 result_b = GET_ADDRESS_FROM_DESC(result);
00217
00218 accum = initv ;
00219
00220 if (src_size == 0 ) {
00221 for (i = 1 ; i <= src_rank ; i ++ )
00222 if (src_extent[i] == 0)
00223 return ;
00224 }
00225 array_p = array_b ;
00226 result_p = result_b ;
00227
00228 a_size = src_extent[0] ;
00229 a_stride = src_stride[0] ;
00230
00231 while (counter[src_rank] < src_extent[src_rank] ) {
00232
00233 if(res_rank != 0) accum = initv ;
00234
00235 for ( i = 0 ; i < a_size ; i ++ ) {
00236 accum &= *(l2 *)array_p ;
00237
00238 array_p += a_stride ;
00239 }
00240 *(l2 *) result_p = accum ;
00241 counter[0] = a_size ;
00242 j = 0 ;
00243 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00244 array_p += src_offset[j] ;
00245 result_p += res_offset[j] ;
00246 counter[j+1]++ ;
00247 counter[j] = 0 ;
00248 j ++ ;
00249 }
00250 }
00251 }
00252 void
00253 _ALL_4(
00254 DopeVectorType *result,
00255 DopeVectorType *array,
00256 i4 *dim)
00257 {
00258 char * result_p, * result_b ;
00259 char * array_p, * array_b ;
00260
00261 size_t src_extent [MAX_NARY_DIMS] ;
00262 size_t counter [MAX_NARY_DIMS] ;
00263 size_t src_offset [MAX_NARY_DIMS] ;
00264 size_t src_stride [MAX_NARY_DIMS] ;
00265 size_t src_size ;
00266
00267 size_t res_stride [MAX_NARY_DIMS] ;
00268 size_t res_offset [MAX_NARY_DIMS] ;
00269
00270 int32_t ddim ;
00271 uint32_t src_rank ;
00272 uint32_t res_rank ;
00273
00274 size_t j,k,i ;
00275
00276 l4 accum ;
00277 l4 const initv = 1 ;
00278 size_t a_size,a_stride;
00279
00280 l4 temp,new ;
00281
00282 if (dim != NULL) {
00283 ddim = (* dim) - 1 ;
00284 } else
00285 ddim = 0 ;
00286
00287 array_b = (char *) GET_ADDRESS_FROM_DESC(array) ;
00288 src_rank = GET_RANK_FROM_DESC(array) - 1;
00289
00290 src_size = read_source_desc(array, src_extent, src_stride, src_offset, ddim);
00291
00292 for (i = 0 ; i <= src_rank ; i ++)
00293 counter[i] = 0 ;
00294
00295 if ((ddim > src_rank ) || (ddim < 0))
00296 ERROR(_LELVL_ABORT,FESCIDIM);
00297
00298 res_rank = GET_RANK_FROM_DESC(result);
00299
00300 if (!GET_ASSOCIATED_FROM_DESC(result)) {
00301 alloc_res(result,src_extent);
00302 }
00303
00304 res_stride[0] = 0;
00305 for (j = 0 ; j <= src_rank; j ++ ) res_offset[j] = 0 ;
00306 for (j = 0 ; j < res_rank ; j ++ ) {
00307 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ;
00308 }
00309
00310 res_offset[0] = res_stride[0] ;
00311 for ( j = 1 ; j < res_rank ; j ++ )
00312 res_offset[j] = res_stride[j] - (res_stride[j-1]*(src_extent[j])) ;
00313
00314 result_b = GET_ADDRESS_FROM_DESC(result);
00315
00316 accum = initv ;
00317
00318 if (src_size == 0 ) {
00319 for (i = 1 ; i <= src_rank ; i ++ )
00320 if (src_extent[i] == 0)
00321 return ;
00322 }
00323 array_p = array_b ;
00324 result_p = result_b ;
00325
00326 a_size = src_extent[0] ;
00327 a_stride = src_stride[0] ;
00328
00329 while (counter[src_rank] < src_extent[src_rank] ) {
00330
00331 if(res_rank != 0) accum = initv ;
00332
00333 for ( i = 0 ; i < a_size ; i ++ ) {
00334 accum &= *(l4 *)array_p ;
00335
00336 array_p += a_stride ;
00337 }
00338 *(l4 *) result_p = accum ;
00339 counter[0] = a_size ;
00340 j = 0 ;
00341 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00342 array_p += src_offset[j] ;
00343 result_p += res_offset[j] ;
00344 counter[j+1]++ ;
00345 counter[j] = 0 ;
00346 j ++ ;
00347 }
00348 }
00349 }
00350 void
00351 _ALL(
00352 DopeVectorType *result,
00353 DopeVectorType *array,
00354 i4 *dim)
00355 {
00356 char * result_p, * result_b ;
00357 char * array_p, * array_b ;
00358
00359 size_t src_extent [MAX_NARY_DIMS] ;
00360 size_t counter [MAX_NARY_DIMS] ;
00361 size_t src_offset [MAX_NARY_DIMS] ;
00362 size_t src_stride [MAX_NARY_DIMS] ;
00363 size_t src_size ;
00364
00365 size_t res_stride [MAX_NARY_DIMS] ;
00366 size_t res_offset [MAX_NARY_DIMS] ;
00367
00368 int32_t ddim ;
00369 uint32_t src_rank ;
00370 uint32_t res_rank ;
00371
00372 size_t j,k,i ;
00373
00374 l8 accum ;
00375 l8 const initv = 1 ;
00376 size_t a_size,a_stride;
00377
00378 l8 temp,new ;
00379
00380 if (dim != NULL) {
00381 ddim = (* dim) - 1 ;
00382 } else
00383 ddim = 0 ;
00384
00385 array_b = (char *) GET_ADDRESS_FROM_DESC(array) ;
00386 src_rank = GET_RANK_FROM_DESC(array) - 1;
00387
00388 src_size = read_source_desc(array, src_extent, src_stride, src_offset, ddim);
00389
00390 for (i = 0 ; i <= src_rank ; i ++)
00391 counter[i] = 0 ;
00392
00393 if ((ddim > src_rank ) || (ddim < 0))
00394 ERROR(_LELVL_ABORT,FESCIDIM);
00395
00396 res_rank = GET_RANK_FROM_DESC(result);
00397
00398 if (!GET_ASSOCIATED_FROM_DESC(result)) {
00399 alloc_res(result,src_extent);
00400 }
00401
00402 res_stride[0] = 0;
00403 for (j = 0 ; j <= src_rank; j ++ ) res_offset[j] = 0 ;
00404 for (j = 0 ; j < res_rank ; j ++ ) {
00405 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ;
00406 }
00407
00408 res_offset[0] = res_stride[0] ;
00409 for ( j = 1 ; j < res_rank ; j ++ )
00410 res_offset[j] = res_stride[j] - (res_stride[j-1]*(src_extent[j])) ;
00411
00412 result_b = GET_ADDRESS_FROM_DESC(result);
00413
00414 accum = initv ;
00415
00416 if (src_size == 0 ) {
00417 for (i = 1 ; i <= src_rank ; i ++ )
00418 if (src_extent[i] == 0)
00419 return ;
00420 }
00421 array_p = array_b ;
00422 result_p = result_b ;
00423
00424 a_size = src_extent[0] ;
00425 a_stride = src_stride[0] ;
00426
00427 while (counter[src_rank] < src_extent[src_rank] ) {
00428
00429 if(res_rank != 0) accum = initv ;
00430
00431 for ( i = 0 ; i < a_size ; i ++ ) {
00432 accum &= *(l8 *)array_p ;
00433
00434 array_p += a_stride ;
00435 }
00436 *(l8 *) result_p = accum ;
00437 counter[0] = a_size ;
00438 j = 0 ;
00439 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00440 array_p += src_offset[j] ;
00441 result_p += res_offset[j] ;
00442 counter[j+1]++ ;
00443 counter[j] = 0 ;
00444 j ++ ;
00445 }
00446 }
00447 }
00448 static void
00449 alloc_res(DopeVectorType * result,
00450 size_t src_extent[MAX_NARY_DIMS])
00451 {
00452 size_t tot_ext ;
00453 size_t str_sz ;
00454 size_t nbytes ;
00455 size_t esz ;
00456 int32_t res_rank ;
00457 char *p = NULL ;
00458 int32_t i ;
00459
00460 SET_ADDRESS_IN_DESC(result,NULL);
00461 SET_ORIG_BS_IN_DESC(result,NULL) ;
00462 SET_ORIG_SZ_IN_DESC(result,0) ;
00463
00464 res_rank = GET_RANK_FROM_DESC(result);
00465 tot_ext = 1 ;
00466 esz = GET_ALEN_FROM_DESC(result) >> 3 ;
00467 nbytes = esz ;
00468 str_sz = MK_STRIDE(FALSE,esz);
00469
00470 for ( i = 0 ; i < res_rank ; i ++) {
00471 SET_LBOUND_IN_DESC(result,i,1);
00472 SET_EXTENT_IN_DESC(result,i,src_extent[i+1]);
00473 SET_STRMULT_IN_DESC(result,i,tot_ext * str_sz );
00474 tot_ext *= src_extent[i+1] ;
00475 }
00476 nbytes *= tot_ext;
00477 if (nbytes > 0 ) {
00478 p = (void *) malloc (nbytes);
00479 if (p == NULL)
00480 ERROR(_LELVL_ABORT, FENOMEMY);
00481
00482 SET_ADDRESS_IN_DESC(result,p);
00483 }
00484 SET_ASSOCIATED_IN_DESC(result);
00485 SET_CONTIG_IN_DESC(result);
00486 SET_ORIG_BS_IN_DESC(result,p) ;
00487 SET_ORIG_SZ_IN_DESC(result,nbytes * 8) ;
00488 }
00489
00490 static size_t
00491 read_source_desc(DopeVectorType * array,
00492 size_t src_extent[MAX_NARY_DIMS],
00493 size_t src_stride[MAX_NARY_DIMS],
00494 size_t src_offset[MAX_NARY_DIMS],
00495 int32_t ddim)
00496 {
00497 int32_t src_rank ,k,j ;
00498 size_t src_size ;
00499
00500 src_extent[0] = GET_EXTENT_FROM_DESC(array,ddim) ;
00501 src_rank = GET_RANK_FROM_DESC(array);
00502
00503 src_size = src_extent[0];
00504
00505 for ( k = 1, j = 0 ; j < src_rank ; j ++ ) {
00506 if (j != ddim ) {
00507 src_extent[k] = GET_EXTENT_FROM_DESC(array,j) ;
00508 src_size *= src_extent[k];
00509 k++ ;
00510 }
00511 }
00512 get_offset_and_stride(array, src_extent, src_stride, src_offset, ddim);
00513
00514 return src_size;
00515 }
00516
00517 static void
00518 get_offset_and_stride(DopeVectorType * array,
00519 size_t src_extent[MAX_NARY_DIMS],
00520 size_t src_stride[MAX_NARY_DIMS],
00521 size_t src_offset[MAX_NARY_DIMS],
00522 int32_t ddim)
00523 {
00524
00525 int32_t src_rank ,k,j ;
00526
00527 src_stride[0] = GET_STRIDE_FROM_DESC(array,ddim) ;
00528 src_offset[0] = 0;
00529 src_rank = GET_RANK_FROM_DESC(array);
00530
00531 for ( k = 1, j = 0 ; j < src_rank ; j ++ ) {
00532 if (j != ddim ) {
00533 src_stride[k] = GET_STRIDE_FROM_DESC(array,j) ;
00534 src_offset[k-1] = src_stride[k] - (src_stride [k-1] * (src_extent[k-1])) ;
00535 k++ ;
00536 }
00537 }
00538 }