|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
00001 /* 00002 00003 Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved. 00004 00005 This program is free software; you can redistribute it and/or modify it 00006 under the terms of version 2.1 of the GNU Lesser General Public License 00007 as published by the Free Software Foundation. 00008 00009 This program is distributed in the hope that it would be useful, but 00010 WITHOUT ANY WARRANTY; without even the implied warranty of 00011 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00012 00013 Further, this software is distributed without any warranty that it is 00014 free of the rightful claim of any third person regarding infringement 00015 or the like. Any license provided herein, whether implied or 00016 otherwise, applies only to this software file. Patent licenses, if 00017 any, provided herein do not apply to combinations of this program with 00018 other software, or any other product whatsoever. 00019 00020 You should have received a copy of the GNU Lesser General Public 00021 License along with this program; if not, write the Free Software 00022 Foundation, Inc., 59 Temple Place - Suite 330, Boston MA 02111-1307, 00023 USA. 00024 00025 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00026 Mountain View, CA 94043, or: 00027 00028 http://www.sgi.com 00029 00030 For further information regarding this notice, see: 00031 00032 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00033 00034 */ 00035 00036 00037 #pragma ident "@(#) libfi/element/merge.c 92.1 07/08/99 15:50:39" 00038 00039 #include <stdlib.h> 00040 #include <liberrno.h> 00041 #include <cray/dopevec.h> 00042 #include <cray/portdefs.h> 00043 00044 #define DVSUBTYPE_DOUBLE 9 00045 #define DVSUBTYPE_DBLCOMPLEX 10 00046 00047 typedef struct { 00048 _f_real16 re; /* real part */ 00049 _f_real16 im; /* imaginary part */ 00050 } dblcmplx; 00051 00052 #define INCREMENT_N() \ 00053 curdim[0]++; \ 00054 if (curdim[0] < msk_ext[0]) { \ 00055 mindx += msk_incr[0]; \ 00056 findx += fls_incr[0]; \ 00057 rindx += res_incr[0]; \ 00058 tindx += tru_incr[0]; \ 00059 } else { \ 00060 curdim[0] = 0; \ 00061 curdim[1]++; \ 00062 if (curdim[1] < msk_ext[1]) { \ 00063 mindx += msk_incr[1]; \ 00064 findx += fls_incr[1]; \ 00065 rindx += res_incr[1]; \ 00066 tindx += tru_incr[1]; \ 00067 } else { \ 00068 curdim[1] = 0; \ 00069 curdim[2]++; \ 00070 if (curdim[2] < msk_ext[2]) { \ 00071 mindx += msk_incr[2]; \ 00072 findx += fls_incr[2]; \ 00073 rindx += res_incr[2]; \ 00074 tindx += tru_incr[2]; \ 00075 } else { \ 00076 curdim[2] = 0; \ 00077 curdim[3]++; \ 00078 if (curdim[3] < msk_ext[3]) { \ 00079 mindx += msk_incr[3]; \ 00080 findx += fls_incr[3]; \ 00081 rindx += res_incr[3]; \ 00082 tindx += tru_incr[3]; \ 00083 } else { \ 00084 curdim[3] = 0; \ 00085 curdim[4]++; \ 00086 if (curdim[4] < msk_ext[4]) { \ 00087 mindx += msk_incr[4]; \ 00088 findx += fls_incr[4]; \ 00089 rindx += res_incr[4]; \ 00090 tindx += tru_incr[4]; \ 00091 } else { \ 00092 curdim[4] = 0; \ 00093 curdim[5]++; \ 00094 if (curdim[5] < msk_ext[5]) { \ 00095 mindx += msk_incr[5]; \ 00096 findx += fls_incr[5]; \ 00097 rindx += res_incr[5]; \ 00098 tindx += tru_incr[5]; \ 00099 } else { \ 00100 curdim[5] = 0; \ 00101 curdim[6]++; \ 00102 mindx += msk_incr[6]; \ 00103 findx += fls_incr[6]; \ 00104 rindx += res_incr[6]; \ 00105 tindx += tru_incr[6]; \ 00106 } \ 00107 } \ 00108 } \ 00109 } \ 00110 } \ 00111 } 00112 00113 void 00114 _MERGE (DopeVectorType * result, 00115 DopeVectorType * tsource, 00116 DopeVectorType * fsource, 00117 DopeVectorType * mask) 00118 00119 { 00120 char *cf; /* char ptr to fsource array */ 00121 char *ct; /* char ptr to tsource array */ 00122 char *cr; /* char ptr to result array */ 00123 int chrlenf; /* length from fsource */ 00124 int chrlenr; /* length from result */ 00125 char * restrict cptr1; /* char */ 00126 unsigned long * restrict uptr1; /* unsigned */ 00127 _f_real16 * restrict dptr1; /* double */ 00128 dblcmplx * restrict xptr1; /* double cmplx */ 00129 char * restrict cptr2; /* char */ 00130 unsigned long * restrict uptr2; /* unsigned */ 00131 _f_real16 * restrict dptr2; /* double */ 00132 dblcmplx * restrict xptr2; /* double cmplx */ 00133 char * restrict cptr3; /* char */ 00134 unsigned long * restrict uptr3; /* unsigned */ 00135 _f_real16 * restrict dptr3; /* double */ 00136 dblcmplx * restrict xptr3; /* double cmplx */ 00137 _f_int * restrict iptr4; /* int */ 00138 unsigned long * restrict fptr; /* fsource */ 00139 unsigned long * restrict rptr; /* result */ 00140 unsigned long * restrict tptr; /* tsource */ 00141 unsigned long * restrict mptr; /* mask */ 00142 int bucketsize; /* size of element */ 00143 int nbytes; /* number of bytes */ 00144 int nwords; /* number of words */ 00145 int curdim[7]; /* current indices */ 00146 int bytealligned; /* byte aligned flag */ 00147 int findx; /* fsource index */ 00148 int rindx; /* result index */ 00149 int mindx; /* mask index */ 00150 int tindx; /* tsource index */ 00151 int type; /* data type */ 00152 int rank; /* rank of result matrix */ 00153 int i, j, k; /* index variables */ 00154 int fls_ext[MAXDIM]; /* extents for fsource */ 00155 int fls_strd[MAXDIM]; /* element stride for field */ 00156 int fls_incr[MAXDIM]; /* incr for each index */ 00157 int msk_ext[MAXDIM]; /* extents for fsource */ 00158 int msk_strd[MAXDIM]; /* element stride for field */ 00159 int msk_incr[MAXDIM]; /* incr for each index */ 00160 int res_ext[MAXDIM]; /* extents for fsource */ 00161 int res_strd[MAXDIM]; /* element stride for field */ 00162 int res_incr[MAXDIM]; /* incr for each index */ 00163 int tru_ext[MAXDIM]; /* extents for fsource */ 00164 int tru_strd[MAXDIM]; /* element stride for field */ 00165 int tru_incr[MAXDIM]; /* incr for each index */ 00166 int fls_cum_decr; /* fsource cumulative decrement */ 00167 int msk_cum_decr; /* mask cumulative decrement */ 00168 int res_cum_decr; /* result cumulative decrement */ 00169 int tru_cum_decr; /* tsource cumulative decrement */ 00170 int tot_ext; /* total extent counter */ 00171 int msk_0_strd; /* scaler stride variable */ 00172 int res_0_strd; /* scaler stride variable */ 00173 int tru_0_strd; /* scaler stride variable */ 00174 int fls_0_strd; /* scaler stride variable */ 00175 int one; /* index holder */ 00176 int zero; /* index holder */ 00177 00178 /* Set type and rank global variables */ 00179 00180 type = fsource->type_lens.type; 00181 rank = mask->n_dim; 00182 00183 /* 00184 * Initialize every element of every array to try and minimize problem 00185 * in compiler. 00186 */ 00187 00188 for (i = 0; i < MAXDIM; i++) { 00189 fls_ext[i] = 0; 00190 fls_strd[i] = 0; 00191 fls_incr[i] = 0; 00192 msk_ext[i] = 0; 00193 msk_strd[i] = 0; 00194 msk_incr[i] = 0; 00195 res_ext[i] = 0; 00196 res_strd[i] = 0; 00197 res_incr[i] = 0; 00198 tru_ext[i] = 0; 00199 tru_strd[i] = 0; 00200 tru_incr[i] = 0; 00201 } 00202 00203 /* Size calculation is based on variable type */ 00204 00205 switch (type) { 00206 case DVTYPE_ASCII : 00207 bytealligned = 1; 00208 bucketsize = _fcdlen (fsource->base_addr.charptr); 00209 break; 00210 case DVTYPE_DERIVEDBYTE : 00211 bytealligned = 1; 00212 #ifndef _ADDR64 00213 bucketsize = fsource->base_addr.a.el_len >> 3; /* bytes */ 00214 #else 00215 bucketsize = _fcdlen (fsource->base_addr.charptr);/* bytes */ 00216 #endif 00217 break; 00218 case DVTYPE_DERIVEDWORD : 00219 bytealligned = 0; 00220 #ifndef _ADDR64 00221 bucketsize = fsource->base_addr.a.el_len >> 6; /* words */ 00222 #else 00223 bucketsize = _fcdlen (fsource->base_addr.charptr);/* bytes */ 00224 bucketsize >>= 3; /* words */ 00225 #endif 00226 break; 00227 default : 00228 bytealligned = 0; 00229 bucketsize = fsource->type_lens.int_len >> 6; /* words */ 00230 } 00231 00232 /* Set up dope vector for result array */ 00233 00234 if (!result->assoc) { 00235 result->base_addr.a.ptr = (void *) NULL; 00236 result->orig_base = 0; 00237 result->orig_size = 0; 00238 for (i = 0; i < rank; i++) { 00239 result->dimension[i].extent = mask->dimension[i].extent; 00240 result->dimension[i].low_bound = 1; 00241 result->dimension[i].stride_mult = 00242 mask->dimension[i].stride_mult * bucketsize; 00243 } 00244 00245 /* Determine size of space to allocate */ 00246 00247 if (!bytealligned) 00248 nbytes = bucketsize << 3; 00249 else 00250 nbytes = bucketsize; 00251 for (i = 0; i < rank; i++) 00252 nbytes *= mask->dimension[i].extent; 00253 nwords = nbytes >> 3; 00254 result->base_addr.a.ptr = (void *) malloc (nbytes); 00255 if (result->base_addr.a.ptr == NULL) 00256 _lerror (_LELVL_ABORT, FENOMEMY); 00257 00258 result->assoc = 1; 00259 if (bytealligned) { 00260 cr = (char *) result->base_addr.a.ptr; 00261 result->base_addr.charptr = _cptofcd (cr, bucketsize); 00262 } 00263 result->orig_base = (void *) result->base_addr.a.ptr; 00264 result->orig_size = nwords; 00265 } else { 00266 if (bytealligned) { 00267 cr = _fcdtocp (result->base_addr.charptr); 00268 bucketsize = _fcdlen (result->base_addr.charptr); 00269 } 00270 } 00271 00272 /* Set up subtypes for double precision and double complex */ 00273 00274 if (type == DVTYPE_REAL && bucketsize == 2) 00275 type = DVSUBTYPE_DOUBLE; 00276 else if (type == DVTYPE_COMPLEX && bucketsize == 4) 00277 type = DVSUBTYPE_DBLCOMPLEX; 00278 00279 /* Set up scalar pointers to all of the argument data areas */ 00280 00281 if (!bytealligned) { 00282 fptr = (void *) fsource->base_addr.a.ptr; 00283 rptr = (void *) result->base_addr.a.ptr; 00284 tptr = (void *) tsource->base_addr.a.ptr; 00285 } else { 00286 cf = _fcdtocp (fsource->base_addr.charptr); 00287 ct = _fcdtocp (tsource->base_addr.charptr); 00288 cr = _fcdtocp (result->base_addr.charptr); 00289 } 00290 mptr = (void *) mask->base_addr.a.ptr; 00291 00292 msk_0_strd = mask->dimension[0].stride_mult; 00293 if (type == DVTYPE_COMPLEX || type == DVSUBTYPE_DOUBLE) { 00294 res_0_strd = result->dimension[0].stride_mult / 2; 00295 tru_0_strd = tsource->dimension[0].stride_mult / 2; 00296 fls_0_strd = fsource->dimension[0].stride_mult / 2; 00297 } else if (type == DVSUBTYPE_DBLCOMPLEX) { 00298 res_0_strd = result->dimension[0].stride_mult / 4; 00299 tru_0_strd = tsource->dimension[0].stride_mult / 4; 00300 fls_0_strd = fsource->dimension[0].stride_mult / 4; 00301 } else { 00302 res_0_strd = result->dimension[0].stride_mult; 00303 tru_0_strd = tsource->dimension[0].stride_mult; 00304 fls_0_strd = fsource->dimension[0].stride_mult; 00305 } 00306 00307 tot_ext = 1; 00308 #pragma _CRI novector 00309 for (i = 0; i < rank; i++) 00310 tot_ext *= msk_ext[i]; 00311 00312 if (rank == 1) { 00313 switch (type) { 00314 case DVTYPE_INTEGER : 00315 case DVTYPE_REAL : 00316 case DVTYPE_LOGICAL : 00317 uptr1 = (unsigned long *) tptr; 00318 uptr2 = (unsigned long *) fptr; 00319 uptr3 = (unsigned long *) rptr; 00320 iptr4 = (_f_int *) mptr; 00321 for (i = 0; i < tot_ext; i++) { 00322 mindx = i * msk_0_strd; 00323 rindx = i * res_0_strd; 00324 if (_ltob(&iptr4[mindx])) { 00325 tindx = i * tru_0_strd; 00326 uptr3[rindx] = uptr1[tindx]; 00327 } else { 00328 findx = i * fls_0_strd; 00329 uptr3[rindx] = uptr2[findx]; 00330 } 00331 } 00332 break; 00333 00334 case DVTYPE_COMPLEX : 00335 case DVSUBTYPE_DOUBLE : 00336 dptr1 = (_f_real16 *) tptr; 00337 dptr2 = (_f_real16 *) fptr; 00338 dptr3 = (_f_real16 *) rptr; 00339 iptr4 = (_f_int *) mptr; 00340 for (i = 0; i < tot_ext; i++) { 00341 mindx = i * msk_0_strd; 00342 rindx = i * res_0_strd; 00343 if (_ltob(&iptr4[mindx])) { 00344 tindx = i * tru_0_strd; 00345 dptr3[rindx] = dptr1[tindx]; 00346 } else { 00347 findx = i * fls_0_strd; 00348 dptr3[rindx] = dptr2[findx]; 00349 } 00350 } 00351 break; 00352 00353 case DVSUBTYPE_DBLCOMPLEX : 00354 xptr1 = (dblcmplx *) tptr; 00355 xptr2 = (dblcmplx *) fptr; 00356 xptr3 = (dblcmplx *) rptr; 00357 iptr4 = (_f_int *) mptr; 00358 for (i = 0; i < tot_ext; i++) { 00359 mindx = i * msk_0_strd; 00360 if (_ltob(&iptr4[mindx])) { 00361 rindx = i * res_0_strd; 00362 tindx = i * tru_0_strd; 00363 xptr3[rindx].re = xptr1[tindx].re; 00364 xptr3[rindx].im = xptr1[tindx].im; 00365 } else { 00366 rindx = i * res_0_strd; 00367 findx = i * fls_0_strd; 00368 xptr3[rindx].re = xptr2[findx].re; 00369 xptr3[rindx].im = xptr2[findx].im; 00370 } 00371 } 00372 break; 00373 00374 case DVTYPE_ASCII : 00375 case DVTYPE_DERIVEDBYTE : 00376 iptr4 = (_f_int *) mptr; 00377 for (i = 0; i < tot_ext; i++) { 00378 mindx = i * msk_0_strd; 00379 rindx = i * res_0_strd; 00380 if (_ltob(&iptr4[mindx])) { 00381 tindx = i * tru_0_strd; 00382 cptr3 = (char *) cr + rindx; 00383 cptr1 = (char *) ct + tindx; 00384 (void) memcpy (cptr3, cptr1, bucketsize); 00385 } else { 00386 findx = i * fls_0_strd; 00387 cptr3 = (char *) cr + rindx; 00388 cptr2 = (char *) cf + findx; 00389 (void) memcpy (cptr3, cptr2, bucketsize); 00390 } 00391 } 00392 break; 00393 00394 default : 00395 uptr1 = (unsigned long *) tptr; 00396 uptr2 = (unsigned long *) fptr; 00397 uptr3 = (unsigned long *) rptr; 00398 iptr4 = (_f_int *) mptr; 00399 for (i = 0; i < tot_ext; i++) { 00400 mindx = i * msk_0_strd; 00401 rindx = i * res_0_strd; 00402 if (_ltob(&iptr4[mindx])) { 00403 tindx = i * tru_0_strd; 00404 for (j = 0; j < bucketsize; j++) 00405 uptr3[rindx+j] = uptr1[tindx+j]; 00406 } else { 00407 findx = i * fls_0_strd; 00408 for (j = 0; j < bucketsize; j++) 00409 uptr3[rindx+j] = uptr2[findx+j]; 00410 } 00411 } 00412 break; 00413 } 00414 } else if (rank == 2) { 00415 if (mask->dimension[0].extent < mask->dimension[1].extent) { 00416 zero = 0; 00417 one = 1; 00418 } else { 00419 zero = 1; 00420 one = 0; 00421 } 00422 msk_ext[zero] = mask->dimension[0].extent; 00423 msk_ext[one] = mask->dimension[1].extent; 00424 msk_strd[zero] = mask->dimension[0].stride_mult; 00425 msk_strd[one] = mask->dimension[1].stride_mult; 00426 if (type == DVTYPE_COMPLEX || type == DVSUBTYPE_DOUBLE) { 00427 res_strd[zero] = result->dimension[0].stride_mult / 2; 00428 res_strd[one] = result->dimension[1].stride_mult / 2; 00429 } else if (type == DVSUBTYPE_DBLCOMPLEX) { 00430 res_strd[zero] = result->dimension[0].stride_mult / 4; 00431 res_strd[one] = result->dimension[1].stride_mult / 4; 00432 } else { 00433 res_strd[zero] = result->dimension[0].stride_mult; 00434 res_strd[one] = result->dimension[1].stride_mult; 00435 } 00436 if (tsource->n_dim > 0) { 00437 if (type == DVTYPE_COMPLEX || type == DVSUBTYPE_DOUBLE) { 00438 tru_strd[zero] = tsource->dimension[0].stride_mult / 2; 00439 tru_strd[one] = tsource->dimension[1].stride_mult / 2; 00440 } else if (type == DVSUBTYPE_DBLCOMPLEX) { 00441 tru_strd[zero] = tsource->dimension[0].stride_mult / 4; 00442 tru_strd[one] = tsource->dimension[1].stride_mult / 4; 00443 } else { 00444 tru_strd[zero] = tsource->dimension[0].stride_mult; 00445 tru_strd[one] = tsource->dimension[1].stride_mult; 00446 } 00447 } else { 00448 tru_strd[zero] = 0; 00449 tru_strd[one] = 0; 00450 } 00451 if (fsource->n_dim > 0) { 00452 if (type == DVTYPE_COMPLEX || type == DVSUBTYPE_DOUBLE) { 00453 fls_strd[zero] = fsource->dimension[0].stride_mult / 2; 00454 fls_strd[one] = fsource->dimension[1].stride_mult / 2; 00455 } else if (type == DVSUBTYPE_DBLCOMPLEX) { 00456 fls_strd[zero] = fsource->dimension[0].stride_mult / 4; 00457 fls_strd[one] = fsource->dimension[1].stride_mult / 4; 00458 } else { 00459 fls_strd[zero] = fsource->dimension[0].stride_mult; 00460 fls_strd[one] = fsource->dimension[1].stride_mult; 00461 } 00462 } else { 00463 fls_strd[zero] = 0; 00464 fls_strd[one] = 0; 00465 } 00466 00467 switch (type) { 00468 case DVTYPE_INTEGER : 00469 case DVTYPE_REAL : 00470 case DVTYPE_LOGICAL : 00471 for (i = 0; i < msk_ext[0]; i++) { 00472 uptr1 = (unsigned long *) tptr; 00473 uptr2 = (unsigned long *) fptr; 00474 uptr3 = (unsigned long *) rptr; 00475 iptr4 = (_f_int *) mptr + (i * msk_strd[0]); 00476 for (j = 0; j < msk_ext[1]; j++) { 00477 mindx = j * msk_strd[1]; 00478 if (_ltob(&iptr4[mindx])) { 00479 rindx = j * res_strd[1]; 00480 tindx = j * tru_strd[1]; 00481 uptr3[rindx] = uptr1[tindx]; 00482 } else { 00483 rindx = j * res_strd[1]; 00484 findx = j * fls_strd[1]; 00485 uptr3[rindx] = uptr2[findx]; 00486 } 00487 } 00488 } 00489 break; 00490 00491 case DVTYPE_COMPLEX : 00492 case DVSUBTYPE_DOUBLE : 00493 for (i = 0; i < msk_ext[0]; i++) { 00494 dptr1 = (_f_real16 *) tptr; 00495 dptr2 = (_f_real16 *) fptr; 00496 dptr3 = (_f_real16 *) rptr; 00497 iptr4 = (_f_int *) mptr + (i * msk_strd[0]); 00498 for (j = 0; j < msk_ext[1]; j++) { 00499 mindx = j * msk_strd[1]; 00500 if (_ltob(&iptr4[mindx])) { 00501 rindx = j * res_strd[1]; 00502 tindx = j * tru_strd[1]; 00503 dptr3[rindx] = dptr1[tindx]; 00504 } else { 00505 rindx = j * res_strd[1]; 00506 findx = j * fls_strd[1]; 00507 dptr3[rindx] = dptr2[findx]; 00508 } 00509 } 00510 } 00511 break; 00512 00513 case DVSUBTYPE_DBLCOMPLEX : 00514 for (i = 0; i < msk_ext[0]; i++) { 00515 xptr1 = (dblcmplx *) tptr; 00516 xptr2 = (dblcmplx *) fptr; 00517 xptr3 = (dblcmplx *) rptr; 00518 iptr4 = (_f_int *) mptr + (i * msk_strd[0]); 00519 for (j = 0; j < msk_ext[1]; j++) { 00520 mindx = j * msk_strd[1]; 00521 if (_ltob(&iptr4[mindx])) { 00522 rindx = j * res_strd[1]; 00523 tindx = j * tru_strd[1]; 00524 xptr3[rindx].re = xptr1[tindx].re; 00525 xptr3[rindx].im = xptr1[tindx].im; 00526 } else { 00527 rindx = j * res_strd[1]; 00528 findx = j * fls_strd[1]; 00529 xptr3[rindx].re = xptr2[findx].re; 00530 xptr3[rindx].im = xptr2[findx].im; 00531 } 00532 } 00533 } 00534 break; 00535 00536 case DVTYPE_ASCII : 00537 case DVTYPE_DERIVEDBYTE : 00538 for (i = 0; i < msk_ext[0]; i++) { 00539 iptr4 = (_f_int *) mptr + (i * msk_strd[0]); 00540 for (j = 0; j < msk_ext[1]; j++) { 00541 mindx = j * msk_strd[1]; 00542 if (_ltob(&iptr4[mindx])) { 00543 rindx = j * res_strd[1]; 00544 tindx = j * tru_strd[1]; 00545 cptr1 = (char *) ct + tindx; 00546 cptr3 = (char *) cr + rindx; 00547 (void) memcpy (cptr3, cptr1, bucketsize); 00548 } else { 00549 rindx = j * res_strd[1]; 00550 findx = j * fls_strd[1]; 00551 cptr2 = (char *) cf + findx; 00552 cptr3 = (char *) cr + rindx; 00553 (void) memcpy (cptr3, cptr2, bucketsize); 00554 } 00555 } 00556 } 00557 break; 00558 00559 default : 00560 for (i = 0; i < msk_ext[0]; i++) { 00561 uptr1 = (unsigned long *) tptr; 00562 uptr2 = (unsigned long *) fptr; 00563 uptr3 = (unsigned long *) rptr; 00564 iptr4 = (_f_int *) mptr; 00565 for (j = 0; j < msk_ext[1]; j++) { 00566 mindx = j * msk_strd[1]; 00567 if (_ltob(&iptr4[mindx])) { 00568 rindx = j * res_strd[1]; 00569 tindx = j * tru_strd[1]; 00570 for (k = 0; k < bucketsize; k++) 00571 uptr3[rindx+k] = uptr1[tindx+k]; 00572 } else { 00573 rindx = j * res_strd[1]; 00574 findx = j * fls_strd[1]; 00575 for (k = 0; k < bucketsize; k++) 00576 uptr3[rindx+k] = uptr2[findx+k]; 00577 } 00578 } 00579 } 00580 } 00581 } else { 00582 mindx = 0; 00583 findx = 0; 00584 rindx = 0; 00585 tindx = 0; 00586 #pragma _CRI shortloop 00587 for (i = 0; i < rank; i++) 00588 curdim[i] = 0; 00589 00590 #pragma _CRI shortloop 00591 for (i = 0; i < rank; i++) { 00592 if (type == DVTYPE_COMPLEX || type == DVSUBTYPE_DOUBLE) 00593 res_strd[i] = result->dimension[i].stride_mult / 2; 00594 else if (type == DVSUBTYPE_DBLCOMPLEX) 00595 res_strd[i] = result->dimension[i].stride_mult / 4; 00596 else 00597 res_strd[i] = result->dimension[i].stride_mult; 00598 } 00599 00600 if (fsource->n_dim > 0) { 00601 #pragma _CRI shortloop 00602 for (i = 0; i < rank; i++) { 00603 if (type == DVTYPE_COMPLEX || type == DVSUBTYPE_DOUBLE) 00604 fls_strd[i] = fsource->dimension[i].stride_mult / 2; 00605 else if (type == DVSUBTYPE_DBLCOMPLEX) 00606 fls_strd[i] = fsource->dimension[i].stride_mult / 4; 00607 else 00608 fls_strd[i] = fsource->dimension[i].stride_mult; 00609 } 00610 } else { 00611 #pragma _CRI shortloop 00612 for (i = 0; i < rank; i++) 00613 fls_strd[i] = 0; 00614 } 00615 00616 if (tsource->n_dim > 0) { 00617 #pragma _CRI shortloop 00618 for (i = 0; i < rank; i++) { 00619 if (type == DVTYPE_COMPLEX || type == DVSUBTYPE_DOUBLE) 00620 tru_strd[i] = tsource->dimension[i].stride_mult / 2; 00621 else if (type == DVSUBTYPE_DBLCOMPLEX) 00622 tru_strd[i] = tsource->dimension[i].stride_mult / 4; 00623 else 00624 tru_strd[i] = tsource->dimension[i].stride_mult; 00625 } 00626 } else { 00627 #pragma _CRI shortloop 00628 for (i = 0; i < rank; i++) 00629 tru_strd[i] = 0; 00630 } 00631 00632 msk_incr[0] = msk_strd[0]; 00633 msk_cum_decr = 0; 00634 fls_incr[0] = fls_strd[0]; 00635 fls_cum_decr = 0; 00636 res_incr[0] = res_strd[0]; 00637 res_cum_decr = 0; 00638 tru_incr[0] = tru_strd[0]; 00639 tru_cum_decr = 0; 00640 00641 #pragma _CRI novector 00642 for (i = 1; i < rank; i++) { 00643 msk_cum_decr += (msk_ext[i-1] - 1) * msk_strd[i-1]; 00644 msk_incr[i] = msk_strd[i] - msk_cum_decr; 00645 fls_cum_decr += (fls_ext[i-1] - 1) * fls_strd[i-1]; 00646 fls_incr[i] = fls_strd[i] - fls_cum_decr; 00647 res_cum_decr += (res_ext[i-1] - 1) * res_strd[i-1]; 00648 res_incr[i] = res_strd[i] - res_cum_decr; 00649 tru_cum_decr += (tru_ext[i-1] - 1) * tru_strd[i-1]; 00650 tru_incr[i] = tru_strd[i] - tru_cum_decr; 00651 } 00652 00653 iptr4 = (_f_int *) mptr + mindx; 00654 switch (type) { 00655 case DVTYPE_INTEGER : 00656 case DVTYPE_REAL : 00657 case DVTYPE_LOGICAL : 00658 uptr1 = (unsigned long *) fptr; 00659 uptr2 = (unsigned long *) tptr; 00660 uptr3 = (unsigned long *) rptr; 00661 for (i = 0; i < tot_ext; i++) { 00662 if (_ltob(&iptr4[mindx])) { 00663 uptr3[rindx] = uptr2[tindx]; 00664 } else { 00665 uptr3[rindx] = uptr1[findx]; 00666 } 00667 INCREMENT_N(); 00668 } 00669 break; 00670 00671 case DVTYPE_COMPLEX : 00672 case DVSUBTYPE_DOUBLE : 00673 dptr1 = (_f_real16 *) fptr; 00674 dptr2 = (_f_real16 *) tptr; 00675 dptr3 = (_f_real16 *) rptr; 00676 for (i = 0; i < tot_ext; i++) { 00677 if (_ltob(&iptr4[mindx])) { 00678 dptr3[rindx] = dptr2[tindx]; 00679 } else { 00680 dptr3[rindx] = dptr1[findx]; 00681 } 00682 INCREMENT_N(); 00683 } 00684 break; 00685 00686 case DVTYPE_ASCII : 00687 case DVTYPE_DERIVEDBYTE : 00688 for (i = 0; i < tot_ext; i++) { 00689 cptr3 = (char *) cr + rindx; 00690 if (_ltob(&iptr4[mindx])) { 00691 cptr2 = (char *) ct + tindx; 00692 (void) memcpy (cptr3, cptr2, bucketsize); 00693 } else { 00694 cptr1 = (char *) cf + findx; 00695 (void) memcpy (cptr3, cptr1, bucketsize); 00696 } 00697 INCREMENT_N(); 00698 } 00699 break; 00700 00701 case DVSUBTYPE_DBLCOMPLEX : 00702 xptr1 = (dblcmplx *) fptr; 00703 xptr2 = (dblcmplx *) tptr; 00704 xptr3 = (dblcmplx *) rptr; 00705 for (i = 0; i < tot_ext; i++) { 00706 if (_ltob(&iptr4[mindx])) { 00707 xptr3[rindx].re = xptr2[tindx].re; 00708 xptr3[rindx].im = xptr2[tindx].im; 00709 } else { 00710 xptr3[rindx].re = xptr1[findx].re; 00711 xptr3[rindx].im = xptr1[findx].im; 00712 } 00713 INCREMENT_N(); 00714 } 00715 break; 00716 00717 default : 00718 uptr1 = (unsigned long *) fptr; 00719 uptr2 = (unsigned long *) tptr; 00720 uptr3 = (unsigned long *) rptr; 00721 for (i = 0; i < tot_ext; i++) { 00722 if (_ltob(&iptr4[mindx])) { 00723 for (j = 0; j < bucketsize; j++) 00724 uptr3[rindx+j] = uptr2[tindx+j]; 00725 } else { 00726 for (j = 0; j < bucketsize; j++) 00727 uptr3[rindx+j] = uptr1[findx+j]; 00728 } 00729 INCREMENT_N(); 00730 } 00731 } 00732 } 00733 }
1.7.6.1 
