|
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/array/all.c 92.1 07/07/99 15:52:02" 00038 #include <stddef.h> 00039 #include <liberrno.h> 00040 #include <cray/dopevec.h> 00041 #include <cray/portdefs.h> 00042 #include "logical.h" 00043 00044 #ifdef _UNICOS 00045 #pragma _CRI duplicate _ALL as ALL@ 00046 #endif 00047 void 00048 _ALL ( DopeVectorType * result, 00049 DopeVectorType * mask, 00050 _f_int *dimension) 00051 { 00052 void __all(); 00053 (void) __all (result, mask, dimension); 00054 } 00055 00056 00057 #ifdef _UNICOS 00058 #pragma _CRI duplicate _ALL0 as ALL0@ 00059 #endif 00060 _f_log 00061 _ALL0 ( DopeVectorType * mask, 00062 _f_int *dimension) 00063 { 00064 void __all(); 00065 _f_log logres; 00066 DopeVectorType result, *res_ptr; 00067 00068 res_ptr = (DopeVectorType *) &result; 00069 res_ptr->base_addr.a.ptr = &logres; 00070 res_ptr->base_addr.a.el_len = sizeof(_f_log8) * BITS_PER_BYTE; 00071 res_ptr->assoc = 1; 00072 res_ptr->ptr_alloc = 0; 00073 res_ptr->p_or_a = NOT_P_OR_A; 00074 res_ptr->n_dim = 0; 00075 res_ptr->type_lens.type = DVTYPE_LOGICAL; 00076 res_ptr->type_lens.dpflag = 0; 00077 res_ptr->type_lens.kind_or_star = DVD_DEFAULT; 00078 res_ptr->type_lens.int_len = sizeof(_f_log8) * BITS_PER_BYTE; 00079 res_ptr->type_lens.dec_len = 0; 00080 res_ptr->orig_base = res_ptr->base_addr.a.ptr; 00081 res_ptr->orig_size = 0; 00082 __all (res_ptr, mask, dimension); 00083 return(*(_f_log *) res_ptr->base_addr.a.ptr); 00084 } 00085 00086 00087 void 00088 _ALL_4 (DopeVectorType * result, 00089 DopeVectorType * mask, 00090 _f_int *dimension) 00091 { 00092 void __all(); 00093 (void) __all (result, mask, dimension); 00094 } 00095 00096 _f_log4 00097 _ALL0_4 (DopeVectorType * mask, 00098 _f_int *dimension) 00099 { 00100 void __all(); 00101 _f_log4 log4res; 00102 DopeVectorType result, *res_ptr; 00103 00104 res_ptr = (DopeVectorType *) &result; 00105 res_ptr->base_addr.a.ptr = &log4res; 00106 res_ptr->base_addr.a.el_len = sizeof(_f_log4) * BITS_PER_BYTE; 00107 res_ptr->assoc = 1; 00108 res_ptr->ptr_alloc = 0; 00109 res_ptr->p_or_a = NOT_P_OR_A; 00110 res_ptr->n_dim = 0; 00111 res_ptr->type_lens.type = DVTYPE_LOGICAL; 00112 res_ptr->type_lens.dpflag = 0; 00113 res_ptr->type_lens.kind_or_star = DVD_DEFAULT; 00114 res_ptr->type_lens.int_len = sizeof(_f_log4) * BITS_PER_BYTE; 00115 res_ptr->type_lens.dec_len = 0; 00116 res_ptr->orig_base = res_ptr->base_addr.a.ptr; 00117 res_ptr->orig_size = 0; 00118 __all (res_ptr, mask, dimension); 00119 return(*(_f_log4 *) res_ptr->base_addr.a.ptr); 00120 } 00121 00122 00123 void 00124 _ALL_8 (DopeVectorType * result, 00125 DopeVectorType * mask, 00126 _f_int *dimension) 00127 { 00128 void __all(); 00129 (void) __all (result, mask, dimension); 00130 } 00131 00132 _f_log8 00133 _ALL0_8 (DopeVectorType * mask, 00134 _f_int *dimension) 00135 { 00136 void __all(); 00137 _f_log8 log8res; 00138 DopeVectorType result, *res_ptr; 00139 00140 res_ptr = (DopeVectorType *) &result; 00141 res_ptr->base_addr.a.ptr = &log8res; 00142 res_ptr->base_addr.a.el_len = sizeof(_f_log8) * BITS_PER_BYTE; 00143 res_ptr->assoc = 1; 00144 res_ptr->ptr_alloc = 0; 00145 res_ptr->p_or_a = NOT_P_OR_A; 00146 res_ptr->n_dim = 0; 00147 res_ptr->type_lens.type = DVTYPE_LOGICAL; 00148 res_ptr->type_lens.dpflag = 0; 00149 res_ptr->type_lens.kind_or_star = DVD_DEFAULT; 00150 res_ptr->type_lens.int_len = sizeof(_f_log8) * BITS_PER_BYTE; 00151 res_ptr->type_lens.dec_len = 0; 00152 res_ptr->orig_base = res_ptr->base_addr.a.ptr; 00153 res_ptr->orig_size = 0; 00154 __all (res_ptr, mask, dimension); 00155 return(*(_f_log8 *) res_ptr->base_addr.a.ptr); 00156 } 00157 00158 00159 void 00160 _ALL_2 (DopeVectorType * result, 00161 DopeVectorType * mask, 00162 _f_int *dimension) 00163 { 00164 void __all(); 00165 (void) __all (result, mask, dimension); 00166 } 00167 00168 _f_log2 00169 _ALL0_2 (DopeVectorType * mask, 00170 _f_int *dimension) 00171 { 00172 void __all(); 00173 _f_log2 log2res; 00174 DopeVectorType result, *res_ptr; 00175 00176 res_ptr = (DopeVectorType *) &result; 00177 res_ptr->base_addr.a.ptr = &log2res; 00178 res_ptr->base_addr.a.el_len = sizeof(_f_log2) * BITS_PER_BYTE; 00179 res_ptr->assoc = 1; 00180 res_ptr->ptr_alloc = 0; 00181 res_ptr->p_or_a = NOT_P_OR_A; 00182 res_ptr->n_dim = 0; 00183 res_ptr->type_lens.type = DVTYPE_LOGICAL; 00184 res_ptr->type_lens.dpflag = 0; 00185 res_ptr->type_lens.kind_or_star = DVD_DEFAULT; 00186 res_ptr->type_lens.int_len = sizeof(_f_log2) * BITS_PER_BYTE; 00187 res_ptr->type_lens.dec_len = 0; 00188 res_ptr->orig_base = res_ptr->base_addr.a.ptr; 00189 res_ptr->orig_size = 0; 00190 __all (res_ptr, mask, dimension); 00191 return(*(_f_log2 *) res_ptr->base_addr.a.ptr); 00192 } 00193 00194 00195 void 00196 _ALL_1 (DopeVectorType * result, 00197 DopeVectorType * mask, 00198 _f_int *dimension) 00199 { 00200 void __all(); 00201 (void) __all (result, mask, dimension); 00202 } 00203 00204 _f_log1 00205 _ALL0_1 (DopeVectorType * mask, 00206 _f_int *dimension) 00207 { 00208 void __all(); 00209 _f_log1 log1res; 00210 DopeVectorType result, *res_ptr; 00211 00212 res_ptr = (DopeVectorType *) &result; 00213 res_ptr->base_addr.a.ptr = &log1res; 00214 res_ptr->base_addr.a.el_len = sizeof(_f_log1) * BITS_PER_BYTE; 00215 res_ptr->assoc = 1; 00216 res_ptr->ptr_alloc = 0; 00217 res_ptr->p_or_a = NOT_P_OR_A; 00218 res_ptr->n_dim = 0; 00219 res_ptr->type_lens.type = DVTYPE_LOGICAL; 00220 res_ptr->type_lens.dpflag = 0; 00221 res_ptr->type_lens.kind_or_star = DVD_DEFAULT; 00222 res_ptr->type_lens.int_len = sizeof(_f_log1) * BITS_PER_BYTE; 00223 res_ptr->type_lens.dec_len = 0; 00224 res_ptr->orig_base = res_ptr->base_addr.a.ptr; 00225 res_ptr->orig_size = 0; 00226 __all (res_ptr, mask, dimension); 00227 return(*(_f_log1 *) res_ptr->base_addr.a.ptr); 00228 } 00229 00230 00231 void 00232 __all ( DopeVectorType * result, 00233 DopeVectorType * mask, 00234 _f_int *dimension) 00235 { 00236 int c_dim; /* C form of input dimension */ 00237 int other_dim; /* other dimension in rank-2 */ 00238 int num_elts = 1; /* elts in result array */ 00239 long nbytes = 0; /* bytes to malloc */ 00240 _f_log * irptr; /* ptr to result array */ 00241 _f_log * imptr; /* ptr to mask array */ 00242 _f_log4 * i4rptr; /* ptr to result array */ 00243 _f_log4 * i4mptr; /* ptr to mask array */ 00244 _f_log8 * i8rptr; /* ptr to result array */ 00245 _f_log8 * i8mptr; /* ptr to mask array */ 00246 #ifdef _F_LOG1 00247 _f_log1 * i1rptr; /* ptr to result array */ 00248 _f_log1 * i1mptr; /* ptr to mask array */ 00249 #endif 00250 #ifdef _F_LOG2 00251 _f_log2 * i2rptr; /* ptr to result array */ 00252 _f_log2 * i2mptr; /* ptr to mask array */ 00253 #endif 00254 long i, j; /* index variables */ 00255 long indx, jndx; /* loop indices */ 00256 int done, stop; /* work done indicators */ 00257 int el_len; /* LTOB length indicator */ 00258 int mshftct=0; /* mask amount to shift index */ 00259 int rshftct=0; /* result amount to shift index */ 00260 00261 /* Per-dimension arrays */ 00262 long current_place[MAXDIM-1]; /* current place*/ 00263 long mask_offset[MAXDIM-1]; /* mask offset */ 00264 long mask_extent[MAXDIM-1]; /* mask extent */ 00265 long mask_stride[MAXDIM-1]; /* mask stride */ 00266 long result_offset[MAXDIM-1]; /* result offset*/ 00267 long result_stride[MAXDIM-1]; /* result stride*/ 00268 long cdim_mask_stride; /* cdim stride */ 00269 00270 /* Validate dimension variable */ 00271 if (dimension != NULL && mask->n_dim > 1) { 00272 c_dim = *dimension - 1; 00273 if (c_dim < 0 || c_dim >= mask->n_dim) 00274 _lerror (_LELVL_ABORT, FESCIDIM); 00275 } else { 00276 c_dim = 0; 00277 if (dimension != NULL) { 00278 if (*dimension < 1 || *dimension > mask->n_dim) 00279 _lerror (_LELVL_ABORT, FESCIDIM); 00280 } 00281 } 00282 00283 /* Setup dope vector for result array */ 00284 if (!result->assoc) { 00285 int sm = 1; 00286 if (result->base_addr.a.el_len >= BITS_PER_WORD) 00287 sm = result->base_addr.a.el_len / BITS_PER_WORD; 00288 if (dimension != NULL) { 00289 for (i = 0; i < c_dim; i++) { 00290 result->dimension[i].extent = 00291 mask->dimension[i].extent; 00292 result->dimension[i].low_bound = 1; 00293 result->dimension[i].stride_mult = 00294 num_elts * sm; 00295 num_elts *= mask->dimension[i].extent; 00296 } 00297 for ( ; i < result->n_dim; i++) { 00298 result->dimension[i].extent = 00299 mask->dimension[i+1].extent; 00300 result->dimension[i].low_bound = 1; 00301 result->dimension[i].stride_mult = 00302 num_elts * sm; 00303 num_elts *= mask->dimension[i+1].extent; 00304 } 00305 } 00306 00307 result->base_addr.a.ptr = (void *) NULL; 00308 00309 nbytes = ((num_elts * result->base_addr.a.el_len) / 00310 BITS_PER_BYTE); 00311 if (nbytes != 0) { 00312 result->base_addr.a.ptr = (void *) malloc (nbytes); 00313 if (result->base_addr.a.ptr == NULL) 00314 _lerror(_LELVL_ABORT, FENOMEMY); 00315 result->assoc = 1; 00316 } 00317 00318 /* set fields for null array as well */ 00319 result->orig_base = result->base_addr.a.ptr; 00320 result->orig_size = nbytes * BITS_PER_BYTE; 00321 } 00322 00323 /* Set pointer to result array and initialize result array to TRUE */ 00324 irptr = (void *) result->base_addr.a.ptr; 00325 switch (result->type_lens.int_len) { 00326 case 64 : 00327 i8rptr = (_f_log8 *) result->base_addr.a.ptr; 00328 #ifdef _F_LOG4 00329 if (sizeof(_f_int) == sizeof(_f_log4)) 00330 rshftct = 1; 00331 #endif 00332 #ifdef _UNICOS 00333 #pragma _CRI ivdep 00334 #endif 00335 for (i = 0; i < num_elts; i++) { 00336 i8rptr[i] = (_f_log8) _btol(1); 00337 } 00338 break; 00339 #ifdef _F_LOG2 00340 case 16 : 00341 i2rptr = (_f_log2 *) result->base_addr.a.ptr; 00342 for (i = 0; i < num_elts; i++) { 00343 i2rptr[i] = (_f_log2) _btol(1); 00344 } 00345 break; 00346 #endif 00347 #ifdef _F_LOG1 00348 case 8 : 00349 i1rptr = (_f_log1 *) result->base_addr.a.ptr; 00350 for (i = 0; i < num_elts; i++) { 00351 i1rptr[i] = (_f_log1) _btol(1); 00352 } 00353 break; 00354 #endif 00355 case 32 : 00356 default : 00357 i4rptr = (_f_log4 *) result->base_addr.a.ptr; 00358 #ifdef _UNICOS 00359 #pragma _CRI ivdep 00360 #endif 00361 for (i = 0; i < num_elts; i++) { 00362 i4rptr[i] = (_f_log4) _btol(1); 00363 } 00364 } 00365 00366 imptr = (void *) mask->base_addr.a.ptr; 00367 switch (mask->type_lens.int_len) { 00368 case 64 : 00369 el_len = sizeof(_f_log8) * BITS_PER_BYTE; 00370 i8mptr = (_f_log8 *) imptr; 00371 #ifdef _F_LOG4 00372 /* Set mask shftct for ALL with no size specified since 00373 * no size means a 64-bit logical value. A default of 00374 * 32-bit logical has a stride_mult of two for a 64-bit 00375 * logical on WORD32. Normally, the ALL_8 entry point 00376 * is used. On MPP, the stride_mult is one for 32-bit 00377 * or 64-bit logical. 00378 */ 00379 if (sizeof(_f_int) == sizeof(_f_log4)) 00380 mshftct = 1; 00381 #endif 00382 break; 00383 #ifdef _F_LOG2 00384 case 16 : 00385 el_len = sizeof(_f_log2) * BITS_PER_BYTE; 00386 i2mptr = (_f_log2 *) imptr; 00387 break; 00388 #endif 00389 #ifdef _F_LOG1 00390 case 8 : 00391 el_len = sizeof(_f_log1) * BITS_PER_BYTE; 00392 i1mptr = (_f_log1 *) imptr; 00393 break; 00394 #endif 00395 case 32 : 00396 default : 00397 el_len = sizeof(_f_log4) * BITS_PER_BYTE; 00398 i4mptr = (_f_log4 *) imptr; 00399 } 00400 00401 /* check for zero-sized mask array */ 00402 for (i = 0; i < mask->n_dim; i++) { 00403 if (mask->dimension[i].extent == 0) 00404 return; 00405 } 00406 00407 /* Handle a rank-one mask array */ 00408 if (mask->n_dim == 1) { 00409 00410 /* Use local mask_stride and divide by two when two-word 00411 * logical is being done. 00412 */ 00413 #ifdef _F_LOG4 00414 mask_stride[0] = (mask->dimension[0].stride_mult) >> mshftct; 00415 #else 00416 mask_stride[0] = mask->dimension[0].stride_mult; 00417 #endif 00418 /* Scan array until a FALSE element is found */ 00419 i = 0; 00420 indx = 0; 00421 switch (mask->type_lens.int_len) { 00422 case 64 : 00423 while (i < mask->dimension[0].extent) { 00424 if (LTOB(el_len, (i8mptr + indx))) { 00425 /* true element */ 00426 i++; 00427 indx = i * mask_stride[0]; 00428 } else { 00429 /* false element */ 00430 switch (result->type_lens.int_len) { 00431 case 64 : 00432 i8rptr[0] = (_f_log8) _btol(0); 00433 break; 00434 #ifdef _F_LOG2 00435 case 16 : 00436 i2rptr[0] = (_f_log2) _btol(0); 00437 break; 00438 #endif 00439 #ifdef _F_LOG1 00440 case 8 : 00441 i1rptr[0] = (_f_log1) _btol(0); 00442 break; 00443 #endif 00444 case 32 : 00445 default : 00446 i4rptr[0] = (_f_log4) _btol(0); 00447 } 00448 i = mask->dimension[0].extent; 00449 } 00450 } 00451 break; 00452 #ifdef _F_LOG2 00453 case 16 : 00454 while (i < mask->dimension[0].extent) { 00455 if (LTOB(el_len, (i2mptr + indx))) { 00456 /* true element */ 00457 i++; 00458 indx = i * mask_stride[0]; 00459 } else { 00460 /* false element */ 00461 switch (result->type_lens.int_len) { 00462 case 64 : 00463 i8rptr[0] = (_f_log8) _btol(0); 00464 break; 00465 case 16 : 00466 i2rptr[0] = (_f_log2) _btol(0); 00467 break; 00468 #ifdef _F_LOG1 00469 case 8 : 00470 i1rptr[0] = (_f_log1) _btol(0); 00471 break; 00472 #endif 00473 case 32 : 00474 default : 00475 i4rptr[0] = (_f_log4) _btol(0); 00476 } 00477 i = mask->dimension[0].extent; 00478 } 00479 } 00480 break; 00481 #endif 00482 #ifdef _F_LOG1 00483 case 8 : 00484 while (i < mask->dimension[0].extent) { 00485 if (LTOB(el_len, (i1mptr + indx))) { 00486 /* true element */ 00487 i++; 00488 indx = i * mask_stride[0]; 00489 } else { 00490 /* false element */ 00491 switch (result->type_lens.int_len) { 00492 case 64 : 00493 i8rptr[0] = (_f_log8) _btol(0); 00494 break; 00495 case 16 : 00496 i2rptr[0] = (_f_log2) _btol(0); 00497 break; 00498 case 8 : 00499 i1rptr[0] = (_f_log1) _btol(0); 00500 break; 00501 case 32 : 00502 default : 00503 i4rptr[0] = (_f_log4) _btol(0); 00504 } 00505 i = mask->dimension[0].extent; 00506 } 00507 } 00508 break; 00509 #endif 00510 case 32 : 00511 default : 00512 while (i < mask->dimension[0].extent) { 00513 if (LTOB(el_len, (i4mptr + indx))) { 00514 /* true element */ 00515 i++; 00516 indx = i * mask_stride[0]; 00517 } else { 00518 /* false element */ 00519 switch (result->type_lens.int_len) { 00520 case 64 : 00521 i8rptr[0] = (_f_log8) _btol(0); 00522 break; 00523 #ifdef _F_LOG2 00524 case 16 : 00525 i2rptr[0] = (_f_log2) _btol(0); 00526 break; 00527 #endif 00528 #ifdef _F_LOG1 00529 case 8 : 00530 i1rptr[0] = (_f_log1) _btol(0); 00531 break; 00532 #endif 00533 case 32 : 00534 default : 00535 i4rptr[0] = (_f_log4) _btol(0); 00536 } 00537 i = mask->dimension[0].extent; 00538 } 00539 } 00540 } 00541 00542 /* Handle a rank-two mask array */ 00543 } else if (mask->n_dim == 2) { 00544 00545 /* Initialize data */ 00546 if (c_dim == 0) 00547 other_dim = 1; 00548 else 00549 other_dim = 0; 00550 #ifdef _F_LOG4 00551 mask_stride[0] = (mask->dimension[0].stride_mult) >> mshftct; 00552 mask_stride[1] = (mask->dimension[1].stride_mult) >> mshftct; 00553 #else 00554 mask_stride[0] = mask->dimension[0].stride_mult; 00555 mask_stride[1] = mask->dimension[1].stride_mult; 00556 #endif 00557 /* Scan array until a FALSE element is found */ 00558 i = 0; 00559 indx = 0; 00560 while (i < mask->dimension[other_dim].extent) { 00561 j = 0; 00562 jndx = indx; 00563 switch (mask->type_lens.int_len) { 00564 case 64 : 00565 while (j < mask->dimension[c_dim].extent) { 00566 if (LTOB(el_len, (i8mptr + jndx))) { 00567 /* true element */ 00568 j++; 00569 jndx = indx + j * 00570 mask_stride[c_dim]; 00571 } else { 00572 /* false element */ 00573 if (result->n_dim == 0) { 00574 switch (result->type_lens.int_len) { 00575 case 64 : 00576 i8rptr[0] = (_f_log8) _btol(0); 00577 break; 00578 #ifdef _F_LOG2 00579 case 16 : 00580 i2rptr[0] = (_f_log2) _btol(0); 00581 break; 00582 #endif 00583 #ifdef _F_LOG1 00584 case 8 : 00585 i1rptr[0] = (_f_log1) _btol(0); 00586 break; 00587 #endif 00588 case 32 : 00589 default : 00590 i4rptr[0] = (_f_log4) _btol(0); 00591 } 00592 j = mask->dimension[c_dim].extent; 00593 i = mask->dimension[other_dim].extent; 00594 } else { 00595 switch (result->type_lens.int_len) { 00596 case 64 : 00597 i8rptr[i] = (_f_log8) _btol(0); 00598 break; 00599 #ifdef _F_LOG2 00600 case 16 : 00601 i2rptr[i] = (_f_log2) _btol(0); 00602 break; 00603 #endif 00604 #ifdef _F_LOG1 00605 case 8 : 00606 i1rptr[i] = (_f_log1) _btol(0); 00607 break; 00608 #endif 00609 case 32 : 00610 default : 00611 i4rptr[i] = (_f_log4) _btol(0); 00612 } 00613 j = mask->dimension[c_dim].extent; 00614 } 00615 } 00616 } 00617 break; 00618 #ifdef _F_LOG2 00619 case 16 : 00620 while (j < mask->dimension[c_dim].extent) { 00621 if (LTOB(el_len, (i2mptr + jndx))) { 00622 /* true element */ 00623 j++; 00624 jndx = indx + j * 00625 mask_stride[c_dim]; 00626 } else { 00627 /* false element */ 00628 if (result->n_dim == 0) { 00629 switch (result->type_lens.int_len) { 00630 case 64 : 00631 i8rptr[0] = (_f_log8) _btol(0); 00632 break; 00633 case 16 : 00634 i2rptr[0] = (_f_log2) _btol(0); 00635 break; 00636 #ifdef _F_LOG1 00637 case 8 : 00638 i1rptr[0] = (_f_log1) _btol(0); 00639 break; 00640 #endif 00641 case 32 : 00642 default : 00643 i4rptr[0] = (_f_log4) _btol(0); 00644 } 00645 j = mask->dimension[c_dim].extent; 00646 i = mask->dimension[other_dim].extent; 00647 } else { 00648 switch (result->type_lens.int_len) { 00649 case 64 : 00650 i8rptr[i] = (_f_log8) _btol(0); 00651 break; 00652 case 16 : 00653 i2rptr[i] = (_f_log2) _btol(0); 00654 break; 00655 #ifdef _F_LOG1 00656 case 8 : 00657 i1rptr[i] = (_f_log1) _btol(0); 00658 break; 00659 #endif 00660 case 32 : 00661 default : 00662 i4rptr[i] = (_f_log4) _btol(0); 00663 } 00664 j = mask->dimension[c_dim].extent; 00665 } 00666 } 00667 } 00668 break; 00669 #endif 00670 #ifdef _F_LOG1 00671 case 8 : 00672 while (j < mask->dimension[c_dim].extent) { 00673 if (LTOB(el_len, (i1mptr + jndx))) { 00674 /* true element */ 00675 j++; 00676 jndx = indx + j * 00677 mask_stride[c_dim]; 00678 } else { 00679 /* false element */ 00680 if (result->n_dim == 0) { 00681 switch (result->type_lens.int_len) { 00682 case 64 : 00683 i8rptr[0] = (_f_log8) _btol(0); 00684 break; 00685 case 16 : 00686 i2rptr[0] = (_f_log2) _btol(0); 00687 break; 00688 case 8 : 00689 i1rptr[0] = (_f_log1) _btol(0); 00690 break; 00691 case 32 : 00692 default : 00693 i4rptr[0] = (_f_log4) _btol(0); 00694 } 00695 j = mask->dimension[c_dim].extent; 00696 i = mask->dimension[other_dim].extent; 00697 } else { 00698 switch (result->type_lens.int_len) { 00699 case 64 : 00700 i8rptr[i] = (_f_log8) _btol(0); 00701 break; 00702 case 16 : 00703 i2rptr[i] = (_f_log2) _btol(0); 00704 break; 00705 case 8 : 00706 i1rptr[i] = (_f_log1) _btol(0); 00707 break; 00708 case 32 : 00709 default : 00710 i4rptr[i] = (_f_log4) _btol(0); 00711 } 00712 j = mask->dimension[c_dim].extent; 00713 } 00714 } 00715 } 00716 break; 00717 #endif 00718 case 32 : 00719 default : 00720 while (j < mask->dimension[c_dim].extent) { 00721 if (LTOB(el_len, (i4mptr + jndx))) { 00722 /* true element */ 00723 j++; 00724 jndx = indx + j * 00725 mask_stride[c_dim]; 00726 } else { 00727 /* false element */ 00728 if (result->n_dim == 0) { 00729 switch (result->type_lens.int_len) { 00730 case 64 : 00731 i8rptr[0] = (_f_log8) _btol(0); 00732 break; 00733 #ifdef _F_LOG2 00734 case 16 : 00735 i2rptr[0] = (_f_log2) _btol(0); 00736 break; 00737 #endif 00738 #ifdef _F_LOG1 00739 case 8 : 00740 i1rptr[0] = (_f_log1) _btol(0); 00741 break; 00742 #endif 00743 case 32 : 00744 default : 00745 i4rptr[0] = (_f_log4) _btol(0); 00746 } 00747 j = mask->dimension[c_dim].extent; 00748 i = mask->dimension[other_dim].extent; 00749 } else { 00750 switch (result->type_lens.int_len) { 00751 case 64 : 00752 i8rptr[i] = (_f_log8) _btol(0); 00753 break; 00754 #ifdef _F_LOG2 00755 case 16 : 00756 i2rptr[i] = (_f_log2) _btol(0); 00757 break; 00758 #endif 00759 #ifdef _F_LOG1 00760 case 8 : 00761 i1rptr[i] = (_f_log1) _btol(0); 00762 break; 00763 #endif 00764 case 32 : 00765 default : 00766 i4rptr[i] = (_f_log4) _btol(0); 00767 } 00768 j = mask->dimension[c_dim].extent; 00769 } 00770 } 00771 } 00772 } 00773 if (i != mask->dimension[other_dim].extent) { 00774 i++; 00775 indx = i * mask_stride[other_dim]; 00776 } 00777 } 00778 00779 /* Handle a rank-three through rank-seven mask array */ 00780 } else { 00781 00782 /* Initialize data */ 00783 if (result->n_dim != 0) 00784 #ifdef _UNICOS 00785 #pragma _CRI shortloop 00786 #endif 00787 for (i = 0; i < result->n_dim; i++) { 00788 result_offset[i] = 0; 00789 #ifdef _F_LOG4 00790 result_stride[i] = 00791 (result->dimension[i].stride_mult) >> rshftct; 00792 #else 00793 result_stride[i] = 00794 result->dimension[i].stride_mult; 00795 #endif 00796 } 00797 00798 /* Initialize mask parameters based on which dimension 00799 * has been requested 00800 */ 00801 00802 if (c_dim == 0) 00803 i = 0; 00804 else 00805 #ifdef _UNICOS 00806 #pragma _CRI shortloop 00807 #endif 00808 for (i = 0; i < c_dim; i++) { 00809 current_place[i] = 0; 00810 mask_offset[i] = 0; 00811 mask_extent[i] = mask->dimension[i].extent; 00812 #ifdef _F_LOG4 00813 mask_stride[i] = 00814 (mask->dimension[i].stride_mult) >> mshftct; 00815 #else 00816 mask_stride[i] = mask->dimension[i].stride_mult; 00817 #endif 00818 } 00819 if (i < (mask->n_dim - 1)) 00820 #ifdef _UNICOS 00821 #pragma _CRI shortloop 00822 #endif 00823 for ( ; i < mask->n_dim - 1; i++) { 00824 current_place[i] = 0; 00825 mask_offset[i] = 0; 00826 mask_extent[i] = mask->dimension[i+1].extent; 00827 #ifdef _F_LOG4 00828 mask_stride[i] = 00829 (mask->dimension[i+1].stride_mult) >> mshftct; 00830 #else 00831 mask_stride[i] = mask->dimension[i+1].stride_mult; 00832 #endif 00833 } 00834 #ifdef _F_LOG4 00835 cdim_mask_stride = mask->dimension[c_dim].stride_mult >> mshftct; 00836 #else 00837 cdim_mask_stride = mask->dimension[c_dim].stride_mult; 00838 #endif 00839 00840 /* Scan array until a FALSE element is found */ 00841 done = FALSE; 00842 while (!done) { 00843 00844 /* Determine starting point */ 00845 indx = 0; 00846 #ifdef _UNICOS 00847 #pragma _CRI shortloop 00848 #endif 00849 for (i = 0; i < mask->n_dim - 1; i++) 00850 indx += mask_offset[i]; 00851 j = 0; 00852 jndx = indx; 00853 00854 /* Scan elements */ 00855 switch (mask->type_lens.int_len) { 00856 case 64 : 00857 while (j < mask->dimension[c_dim].extent) { 00858 if (LTOB(el_len, (i8mptr + jndx))) { 00859 /* true element */ 00860 j++; 00861 jndx = indx + j * 00862 cdim_mask_stride; 00863 } else { 00864 /* false element */ 00865 if (result->n_dim == 0) { 00866 switch (result->type_lens.int_len) { 00867 case 64 : 00868 i8rptr[0] = (_f_log8) _btol(0); 00869 break; 00870 #ifdef _F_LOG2 00871 case 16 : 00872 i2rptr[0] = (_f_log2) _btol(0); 00873 break; 00874 #endif 00875 #ifdef _F_LOG1 00876 case 8 : 00877 i1rptr[0] = (_f_log1) _btol(0); 00878 break; 00879 #endif 00880 case 32 : 00881 default : 00882 i4rptr[0] = (_f_log4) _btol(0); 00883 } 00884 j = mask->dimension[c_dim].extent; 00885 done = TRUE; 00886 } else { 00887 indx = 0; 00888 for (i = 0; i < mask->n_dim - 1; i++) 00889 indx += result_offset[i]; 00890 switch (result->type_lens.int_len) { 00891 case 64 : 00892 i8rptr[indx] = (_f_log8) _btol(0); 00893 break; 00894 #ifdef _F_LOG2 00895 case 16 : 00896 i2rptr[indx] = (_f_log2) _btol(0); 00897 break; 00898 #endif 00899 #ifdef _F_LOG1 00900 case 8 : 00901 i1rptr[indx] = (_f_log1) _btol(0); 00902 break; 00903 #endif 00904 case 32 : 00905 default : 00906 i4rptr[indx] = (_f_log4) _btol(0); 00907 } 00908 j = mask->dimension[c_dim].extent; 00909 } 00910 } 00911 } 00912 break; 00913 #ifdef _F_LOG2 00914 case 16 : 00915 while (j < mask->dimension[c_dim].extent) { 00916 if (LTOB(el_len, (i2mptr + jndx))) { 00917 /* true element */ 00918 j++; 00919 jndx = indx + j * 00920 cdim_mask_stride; 00921 } else { 00922 /* false element */ 00923 if (result->n_dim == 0) { 00924 switch (result->type_lens.int_len) { 00925 case 64 : 00926 i8rptr[0] = (_f_log8) _btol(0); 00927 break; 00928 case 16 : 00929 i2rptr[0] = (_f_log2) _btol(0); 00930 break; 00931 #ifdef _F_LOG1 00932 case 8 : 00933 i1rptr[0] = (_f_log1) _btol(0); 00934 break; 00935 #endif 00936 case 32 : 00937 default : 00938 i4rptr[0] = (_f_log4) _btol(0); 00939 } 00940 j = mask->dimension[c_dim].extent; 00941 done = TRUE; 00942 } else { 00943 indx = 0; 00944 for (i = 0; i < mask->n_dim - 1; i++) 00945 indx += result_offset[i]; 00946 switch (result->type_lens.int_len) { 00947 case 64 : 00948 i8rptr[indx] = (_f_log8) _btol(0); 00949 break; 00950 case 16 : 00951 i2rptr[indx] = (_f_log2) _btol(0); 00952 break; 00953 #ifdef _F_LOG1 00954 case 8 : 00955 i1rptr[indx] = (_f_log1) _btol(0); 00956 break; 00957 #endif 00958 case 32 : 00959 default : 00960 i4rptr[indx] = (_f_log4) _btol(0); 00961 } 00962 j = mask->dimension[c_dim].extent; 00963 } 00964 } 00965 } 00966 break; 00967 #endif 00968 #ifdef _F_LOG1 00969 case 8 : 00970 while (j < mask->dimension[c_dim].extent) { 00971 if (LTOB(el_len, (i1mptr + jndx))) { 00972 /* true element */ 00973 j++; 00974 jndx = indx + j * 00975 cdim_mask_stride; 00976 } else { 00977 /* false element */ 00978 if (result->n_dim == 0) { 00979 switch (result->type_lens.int_len) { 00980 case 64 : 00981 i8rptr[0] = (_f_log8) _btol(0); 00982 break; 00983 case 16 : 00984 i2rptr[0] = (_f_log2) _btol(0); 00985 break; 00986 case 8 : 00987 i1rptr[0] = (_f_log1) _btol(0); 00988 break; 00989 case 32 : 00990 default : 00991 i4rptr[0] = (_f_log4) _btol(0); 00992 } 00993 j = mask->dimension[c_dim].extent; 00994 done = TRUE; 00995 } else { 00996 indx = 0; 00997 for (i = 0; i < mask->n_dim - 1; i++) 00998 indx += result_offset[i]; 00999 switch (result->type_lens.int_len) { 01000 case 64 : 01001 i8rptr[indx] = (_f_log8) _btol(0); 01002 break; 01003 case 16 : 01004 i2rptr[indx] = (_f_log2) _btol(0); 01005 break; 01006 case 8 : 01007 i1rptr[indx] = (_f_log1) _btol(0); 01008 break; 01009 case 32 : 01010 default : 01011 i4rptr[indx] = (_f_log4) _btol(0); 01012 } 01013 j = mask->dimension[c_dim].extent; 01014 } 01015 } 01016 } 01017 break; 01018 #endif 01019 case 32 : 01020 default : 01021 while (j < mask->dimension[c_dim].extent) { 01022 if (LTOB(el_len, (i4mptr + jndx))) { 01023 /* true element */ 01024 j++; 01025 jndx = indx + j * 01026 cdim_mask_stride; 01027 } else { 01028 /* false element */ 01029 if (result->n_dim == 0) { 01030 switch (result->type_lens.int_len) { 01031 case 64 : 01032 i8rptr[0] = (_f_log8) _btol(0); 01033 break; 01034 #ifdef _F_LOG2 01035 case 16 : 01036 i2rptr[0] = (_f_log2) _btol(0); 01037 break; 01038 #endif 01039 #ifdef _F_LOG1 01040 case 8 : 01041 i1rptr[0] = (_f_log1) _btol(0); 01042 break; 01043 #endif 01044 case 32 : 01045 default : 01046 i4rptr[0] = (_f_log4) _btol(0); 01047 } 01048 j = mask->dimension[c_dim].extent; 01049 done = TRUE; 01050 } else { 01051 indx = 0; 01052 #ifdef _UNICOS 01053 #pragma _CRI shortloop 01054 #endif 01055 for (i = 0; i < mask->n_dim - 1; i++) 01056 indx += result_offset[i]; 01057 switch (result->type_lens.int_len) { 01058 case 64 : 01059 i8rptr[indx] = (_f_log8)_btol(0); 01060 break; 01061 #ifdef _F_LOG2 01062 case 16 : 01063 i2rptr[indx] = (_f_log2)_btol(0); 01064 break; 01065 #endif 01066 #ifdef _F_LOG1 01067 case 8 : 01068 i1rptr[indx] = (_f_log1)_btol(0); 01069 break; 01070 #endif 01071 case 32 : 01072 default : 01073 i4rptr[indx] = (_f_log4)_btol(0); 01074 } 01075 j = mask->dimension[c_dim].extent; 01076 } 01077 } 01078 } 01079 } 01080 01081 /* If not done, add to pointer for each dimension */ 01082 if (!done) { 01083 i = 0; 01084 stop = FALSE; 01085 while (stop == FALSE && i < mask->n_dim - 1) { 01086 if (current_place[i] == mask_extent[i] - 1) { 01087 current_place[i] = 0; 01088 mask_offset[i] = 0; 01089 if (result->n_dim != 0) 01090 result_offset[i] = 0; 01091 } else { 01092 current_place[i]++; 01093 mask_offset[i] = 01094 current_place[i] * 01095 mask_stride[i]; 01096 if (result->n_dim != 0) 01097 result_offset[i] = 01098 current_place[i] * 01099 result_stride[i]; 01100 stop = TRUE; 01101 } 01102 i++; 01103 } 01104 if (stop == FALSE) 01105 01106 /* Processed the whole array, 01107 * quit processing 01108 */ 01109 done = TRUE; 01110 } 01111 } 01112 } 01113 }
1.7.6.1 
