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 void
00041 _PACK(
00042 DopeVectorType *result,
00043 DopeVectorType *array,
00044 DopeVectorType *mask,
00045 DopeVectorType *vector)
00046 {
00047 char * result_p, * result_b ;
00048 char * array_p, * array_b ;
00049 char * mask_p, * mask_b ;
00050 char * vector_p, * vector_b ;
00051
00052 size_t src_extent [MAX_NARY_DIMS] ;
00053 size_t src_stride [MAX_NARY_DIMS] ;
00054 size_t src_offset [MAX_NARY_DIMS] ;
00055 size_t counter[MAX_NARY_DIMS] ;
00056
00057 size_t res_stride [MAX_NARY_DIMS] ;
00058 size_t res_extent [MAX_NARY_DIMS] ;
00059 size_t res_offset [MAX_NARY_DIMS] ;
00060
00061 size_t msk_stride [MAX_NARY_DIMS] ;
00062 size_t msk_extent [MAX_NARY_DIMS] ;
00063 size_t msk_offset [MAX_NARY_DIMS] ;
00064
00065 int32_t j,ii;
00066 char *rp, *ap ;
00067 int32_t res_rank ;
00068 int32_t src_rank = GET_RANK_FROM_DESC(array) - 1;
00069
00070 size_t typ_sz = GET_ELEMENT_SZ_FROM_DESC(array);
00071
00072 size_t a_size,a_stride,r_stride, i,k ;
00073 int8_t zero_szd_source = FALSE;
00074 int8_t byte_aligned = FALSE;
00075
00076 int32_t ddim ;
00077
00078 size_t num_trues ;
00079 int32_t local_alloc ;
00080 size_t tot_ext ;
00081 size_t str_sz ;
00082
00083 size_t src_size ;
00084 size_t m_stride ;
00085 int32_t msk_rank ;
00086
00087 size_t res_sz;
00088 size_t xfer_sz;
00089 size_t tot_sz;
00090
00091 src_size = 1 ;
00092
00093 for ( j = 0 ; j <= src_rank ; j ++ ) {
00094 src_extent[j] = GET_EXTENT_FROM_DESC(array,j) ;
00095 src_stride[j] = GET_STRIDE_FROM_DESC(array,j) ;
00096 src_size *= src_extent[j];
00097 counter[j] = 0 ;
00098 zero_szd_source = zero_szd_source || (src_extent[j] == 0) ;
00099 }
00100
00101 for ( j = 1 ; j <= src_rank ; j ++ )
00102 src_offset[j-1] = src_stride[j] - (src_stride [j-1] * (src_extent[j-1])) ;
00103
00104 byte_aligned = GET_BYTEALIGNED_FROM_DESC(array) ;
00105 tot_ext = src_size ;
00106 num_trues = 0 ;
00107 local_alloc = FALSE;
00108
00109 if (vector)
00110 tot_ext = GET_EXTENT_FROM_DESC(vector,0) ;
00111
00112 if (!GET_ASSOCIATED_FROM_DESC(result)) {
00113
00114 size_t nbytes ;
00115 char *p ;
00116
00117 SET_ADDRESS_IN_DESC(result,NULL);
00118 SET_ORIG_BS_IN_DESC(result,NULL) ;
00119 SET_ORIG_SZ_IN_DESC(result,0) ;
00120
00121 p = NULL ;
00122 local_alloc = TRUE ;
00123 nbytes = typ_sz * tot_ext ;
00124 str_sz = MK_STRIDE(byte_aligned,typ_sz);
00125
00126 SET_LBOUND_IN_DESC(result,0,1);
00127 SET_EXTENT_IN_DESC(result,0,tot_ext);
00128 SET_STRMULT_IN_DESC(result,0,str_sz);
00129
00130 if (nbytes > 0 ){
00131 p = malloc (nbytes);
00132 if (p == NULL)
00133 ERROR(_LELVL_ABORT, FENOMEMY);
00134
00135 SET_ADDRESS_IN_DESC(result,p);
00136 }
00137
00138 SET_CONTIG_IN_DESC(result);
00139 SET_ASSOCIATED_IN_DESC(result);
00140 if (GET_DV_ASCII_FROM_DESC(array)) {
00141 SET_CHARPTR_IN_DESC(result,p,typ_sz);
00142 }
00143 SET_ORIG_BS_IN_DESC(result,p) ;
00144 SET_ORIG_SZ_IN_DESC(result,nbytes * 8) ;
00145 }
00146
00147 res_stride[0] = GET_STRIDE_FROM_DESC(result,0) ;
00148
00149 if (mask != NULL) {
00150 size_t msk_typ_sz;
00151
00152 msk_typ_sz = GET_ELEMENT_SZ_FROM_DESC(mask);
00153 mask_b = (char *) GET_ADDRESS_FROM_DESC(mask) + OFFSET_TO_TF_BYTE(msk_typ_sz);
00154
00155 if (GET_RANK_FROM_DESC(mask) == 0) {
00156 if (*mask_b) {
00157 for ( j = 0 ; j <= src_rank ; j ++ ) {
00158 msk_stride[j] = 0;
00159 msk_offset[j] = 0;
00160 }
00161 } else
00162 zero_szd_source = TRUE;
00163
00164 } else {
00165
00166 for ( j = 0 ; j <= src_rank ; j ++ ) {
00167 msk_stride[j] = GET_STRIDE_FROM_DESC(mask,j) ;
00168 }
00169 for ( j = 1 ; j <= src_rank ; j ++ ) {
00170 msk_offset[j-1] = msk_stride[j] - (msk_stride [j-1] * (src_extent[j-1])) ;
00171 }
00172 }
00173 }
00174
00175 if (zero_szd_source)
00176 return ;
00177
00178 a_size = src_extent[0] ;
00179 a_stride = src_stride[0] ;
00180 r_stride = res_stride[0] ;
00181 m_stride = msk_stride[0] ;
00182 array_p = GET_ADDRESS_FROM_DESC(array);
00183 result_p = GET_ADDRESS_FROM_DESC(result);
00184 mask_p = mask_b ;
00185
00186 if (typ_sz == sizeof(i1) && ALIGNED_i1(array_p) && ALIGNED_i1(result_p)) {
00187
00188 while (counter[src_rank] < src_extent[src_rank] ) {
00189 for ( i = 0 ; i < a_size ; i ++ ) {
00190 if (*mask_p) {
00191 num_trues ++ ;
00192 *(i1 *)result_p = *(i1 *)array_p ;
00193 result_p += r_stride ;
00194 }
00195 mask_p += m_stride ;
00196 array_p += a_stride ;
00197 }
00198
00199 counter[0] = a_size ;
00200 j = 0 ;
00201 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00202 array_p += src_offset[j] ;
00203 mask_p += msk_offset[j] ;
00204 counter[j+1]++ ;
00205 counter[j] = 0 ;
00206 j ++ ;
00207 }
00208 }
00209
00210 {
00211
00212 size_t v_stride,ll1,ll2 ;
00213
00214 if (vector != NULL) {
00215 result_b = GET_ADDRESS_FROM_DESC(result);
00216 vector_b = GET_ADDRESS_FROM_DESC(vector) ;
00217 v_stride = GET_STRIDE_FROM_DESC(vector,0) ;
00218 ll1 = (result_p-result_b)/r_stride ;
00219 vector_p = vector_b + (v_stride * ll1) ;
00220 ll2 = GET_EXTENT_FROM_DESC(vector,0) ;
00221 if (ALIGNED_i1(vector_p)) {
00222 for ( i = 0 ; i < ll2-ll1 ; i ++ ) {
00223 *(i1 *)result_p = *(i1 *)vector_p ;
00224 result_p += r_stride ;
00225 vector_p += v_stride ;
00226 }
00227 } else {
00228 ap = vector_p ;
00229 rp = result_p ;
00230 for (j = 0 ; j < typ_sz ; j ++) *rp++ = *ap ++ ;
00231 result_p += r_stride ;
00232 vector_p += v_stride ;
00233 }
00234
00235 } else if (local_alloc) {
00236 SET_EXTENT_IN_DESC(result,0,num_trues);
00237 }
00238 }
00239 } else if (typ_sz == sizeof(i2) && ALIGNED_i2(array_p) && ALIGNED_i2(result_p) ) {
00240
00241 while (counter[src_rank] < src_extent[src_rank] ) {
00242 for ( i = 0 ; i < a_size ; i ++ ) {
00243 if (*mask_p) {
00244 num_trues ++ ;
00245 *(i2 *)result_p = *(i2 *)array_p ;
00246 result_p += r_stride ;
00247 }
00248 mask_p += m_stride ;
00249 array_p += a_stride ;
00250 }
00251
00252 counter[0] = a_size ;
00253 j = 0 ;
00254 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00255 array_p += src_offset[j] ;
00256 mask_p += msk_offset[j] ;
00257 counter[j+1]++ ;
00258 counter[j] = 0 ;
00259 j ++ ;
00260 }
00261 }
00262
00263 {
00264
00265 size_t v_stride,ll1,ll2 ;
00266
00267 if (vector != NULL) {
00268 result_b = GET_ADDRESS_FROM_DESC(result);
00269 vector_b = GET_ADDRESS_FROM_DESC(vector) ;
00270 v_stride = GET_STRIDE_FROM_DESC(vector,0) ;
00271 ll1 = (result_p-result_b)/r_stride ;
00272 vector_p = vector_b + (v_stride * ll1) ;
00273 ll2 = GET_EXTENT_FROM_DESC(vector,0) ;
00274 if (ALIGNED_i2(vector_p)) {
00275 for ( i = 0 ; i < ll2-ll1 ; i ++ ) {
00276 *(i2 *)result_p = *(i2 *)vector_p ;
00277 result_p += r_stride ;
00278 vector_p += v_stride ;
00279 }
00280 } else {
00281 ap = vector_p ;
00282 rp = result_p ;
00283 for (j = 0 ; j < typ_sz ; j ++) *rp++ = *ap ++ ;
00284 result_p += r_stride ;
00285 vector_p += v_stride ;
00286 }
00287
00288 } else if (local_alloc) {
00289 SET_EXTENT_IN_DESC(result,0,num_trues);
00290 }
00291 }
00292 } else if (typ_sz == sizeof(r4) && ALIGNED_r4(array_p) && ALIGNED_r4(result_p) ) {
00293
00294 while (counter[src_rank] < src_extent[src_rank] ) {
00295 for ( i = 0 ; i < a_size ; i ++ ) {
00296 if (*mask_p) {
00297 num_trues ++ ;
00298 *(r4 *)result_p = *(r4 *)array_p ;
00299 result_p += r_stride ;
00300 }
00301 mask_p += m_stride ;
00302 array_p += a_stride ;
00303 }
00304
00305 counter[0] = a_size ;
00306 j = 0 ;
00307 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00308 array_p += src_offset[j] ;
00309 mask_p += msk_offset[j] ;
00310 counter[j+1]++ ;
00311 counter[j] = 0 ;
00312 j ++ ;
00313 }
00314 }
00315
00316 {
00317
00318 size_t v_stride,ll1,ll2 ;
00319
00320 if (vector != NULL) {
00321 result_b = GET_ADDRESS_FROM_DESC(result);
00322 vector_b = GET_ADDRESS_FROM_DESC(vector) ;
00323 v_stride = GET_STRIDE_FROM_DESC(vector,0) ;
00324 ll1 = (result_p-result_b)/r_stride ;
00325 vector_p = vector_b + (v_stride * ll1) ;
00326 ll2 = GET_EXTENT_FROM_DESC(vector,0) ;
00327 if (ALIGNED_r4(vector_p)) {
00328 for ( i = 0 ; i < ll2-ll1 ; i ++ ) {
00329 *(r4 *)result_p = *(r4 *)vector_p ;
00330 result_p += r_stride ;
00331 vector_p += v_stride ;
00332 }
00333 } else {
00334 ap = vector_p ;
00335 rp = result_p ;
00336 for (j = 0 ; j < typ_sz ; j ++) *rp++ = *ap ++ ;
00337 result_p += r_stride ;
00338 vector_p += v_stride ;
00339 }
00340
00341 } else if (local_alloc) {
00342 SET_EXTENT_IN_DESC(result,0,num_trues);
00343 }
00344 }
00345 } else if (typ_sz == sizeof(r8) && ALIGNED_r8(array_p) && ALIGNED_r8(result_p) ) {
00346
00347 while (counter[src_rank] < src_extent[src_rank] ) {
00348 for ( i = 0 ; i < a_size ; i ++ ) {
00349 if (*mask_p) {
00350 num_trues ++ ;
00351 *(r8 *)result_p = *(r8 *)array_p ;
00352 result_p += r_stride ;
00353 }
00354 mask_p += m_stride ;
00355 array_p += a_stride ;
00356 }
00357
00358 counter[0] = a_size ;
00359 j = 0 ;
00360 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00361 array_p += src_offset[j] ;
00362 mask_p += msk_offset[j] ;
00363 counter[j+1]++ ;
00364 counter[j] = 0 ;
00365 j ++ ;
00366 }
00367 }
00368
00369 {
00370
00371 size_t v_stride,ll1,ll2 ;
00372
00373 if (vector != NULL) {
00374 result_b = GET_ADDRESS_FROM_DESC(result);
00375 vector_b = GET_ADDRESS_FROM_DESC(vector) ;
00376 v_stride = GET_STRIDE_FROM_DESC(vector,0) ;
00377 ll1 = (result_p-result_b)/r_stride ;
00378 vector_p = vector_b + (v_stride * ll1) ;
00379 ll2 = GET_EXTENT_FROM_DESC(vector,0) ;
00380 if (ALIGNED_r8(vector_p)) {
00381 for ( i = 0 ; i < ll2-ll1 ; i ++ ) {
00382 *(r8 *)result_p = *(r8 *)vector_p ;
00383 result_p += r_stride ;
00384 vector_p += v_stride ;
00385 }
00386 } else {
00387 ap = vector_p ;
00388 rp = result_p ;
00389 for (j = 0 ; j < typ_sz ; j ++) *rp++ = *ap ++ ;
00390 result_p += r_stride ;
00391 vector_p += v_stride ;
00392 }
00393
00394 } else if (local_alloc) {
00395 SET_EXTENT_IN_DESC(result,0,num_trues);
00396 }
00397 }
00398 } else if (typ_sz == sizeof(r16) && ALIGNED_r16(array_p) && ALIGNED_r16(result_p) ) {
00399
00400 while (counter[src_rank] < src_extent[src_rank] ) {
00401 for ( i = 0 ; i < a_size ; i ++ ) {
00402 if (*mask_p) {
00403 num_trues ++ ;
00404 *(r16 *)result_p = *(r16 *)array_p ;
00405 result_p += r_stride ;
00406 }
00407 mask_p += m_stride ;
00408 array_p += a_stride ;
00409 }
00410
00411 counter[0] = a_size ;
00412 j = 0 ;
00413 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00414 array_p += src_offset[j] ;
00415 mask_p += msk_offset[j] ;
00416 counter[j+1]++ ;
00417 counter[j] = 0 ;
00418 j ++ ;
00419 }
00420 }
00421
00422 {
00423
00424 size_t v_stride,ll1,ll2 ;
00425
00426 if (vector != NULL) {
00427 result_b = GET_ADDRESS_FROM_DESC(result);
00428 vector_b = GET_ADDRESS_FROM_DESC(vector) ;
00429 v_stride = GET_STRIDE_FROM_DESC(vector,0) ;
00430 ll1 = (result_p-result_b)/r_stride ;
00431 vector_p = vector_b + (v_stride * ll1) ;
00432 ll2 = GET_EXTENT_FROM_DESC(vector,0) ;
00433 if (ALIGNED_r16(vector_p)) {
00434 for ( i = 0 ; i < ll2-ll1 ; i ++ ) {
00435 *(r16 *)result_p = *(r16 *)vector_p ;
00436 result_p += r_stride ;
00437 vector_p += v_stride ;
00438 }
00439 } else {
00440 ap = vector_p ;
00441 rp = result_p ;
00442 for (j = 0 ; j < typ_sz ; j ++) *rp++ = *ap ++ ;
00443 result_p += r_stride ;
00444 vector_p += v_stride ;
00445 }
00446
00447 } else if (local_alloc) {
00448 SET_EXTENT_IN_DESC(result,0,num_trues);
00449 }
00450 }
00451 } else {
00452 while (counter[src_rank] < src_extent[src_rank] ) {
00453 for ( i = 0 ; i < a_size ; i ++ ) {
00454 if (*mask_p) {
00455 num_trues ++ ;
00456 ap = array_p ;
00457 rp = result_p ;
00458 if (typ_sz > BIGDEFAULTSZ)
00459 (void) memcpy (rp, ap, typ_sz);
00460 else
00461 for (j = 0 ; j < typ_sz ; j ++) *rp++ = *ap ++ ;
00462 result_p += r_stride ;
00463 }
00464 mask_p += m_stride ;
00465 array_p += a_stride ;
00466 }
00467
00468 counter[0] = a_size ;
00469 j = 0 ;
00470 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00471 array_p += src_offset[j] ;
00472 mask_p += msk_offset[j] ;
00473 counter[j+1]++ ;
00474 counter[j] = 0 ;
00475 j ++ ;
00476 }
00477 }
00478
00479 {
00480
00481 size_t v_stride,ll1,ll2 ;
00482
00483 if (vector != NULL) {
00484 result_b = GET_ADDRESS_FROM_DESC(result);
00485 vector_b = GET_ADDRESS_FROM_DESC(vector) ;
00486 v_stride = GET_STRIDE_FROM_DESC(vector,0) ;
00487 ll1 = (result_p-result_b)/r_stride ;
00488 vector_p = vector_b + (v_stride * ll1) ;
00489 ll2 = GET_EXTENT_FROM_DESC(vector,0) ;
00490
00491 for ( i = 0 ; i < ll2-ll1 ; i ++ ) {
00492 ap = vector_p ;
00493 rp = result_p ;
00494 if (typ_sz > BIGDEFAULTSZ)
00495 (void) memcpy (rp, ap, typ_sz);
00496 else
00497 for (j = 0 ; j < typ_sz ; j ++) *rp++ = *ap ++ ;
00498 result_p += r_stride ;
00499 vector_p += v_stride ;
00500 }
00501 } else if (local_alloc) {
00502 SET_EXTENT_IN_DESC(result,0,num_trues);
00503 }
00504 }
00505 }
00506 }
