|
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/any.c 92.1 07/07/99 15:52:02" 00038 #include <stddef.h> 00039 #include <stdlib.h> 00040 #include <liberrno.h> 00041 #include <cray/dopevec.h> 00042 #include <cray/portdefs.h> 00043 #include "logical.h" 00044 00045 #ifdef _UNICOS 00046 #pragma _CRI duplicate _ANY as ANY@ 00047 #endif 00048 void 00049 _ANY ( DopeVectorType * result, 00050 DopeVectorType * mask, 00051 _f_int *dimension) 00052 { 00053 void __any(); 00054 (void) __any (result, mask, dimension); 00055 } 00056 00057 #ifdef _UNICOS 00058 #pragma _CRI duplicate _ANY0 as ANY0@ 00059 #endif 00060 _f_log 00061 _ANY0 ( DopeVectorType * mask, 00062 _f_int *dimension) 00063 { 00064 void __any(); 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 __any (res_ptr, mask, dimension); 00083 return(*(_f_log *) res_ptr->base_addr.a.ptr); 00084 } 00085 00086 00087 void 00088 _ANY_4 (DopeVectorType * result, 00089 DopeVectorType * mask, 00090 _f_int *dimension) 00091 { 00092 void __any(); 00093 (void) __any (result, mask, dimension); 00094 } 00095 00096 _f_log4 00097 _ANY0_4 (DopeVectorType * mask, 00098 _f_int *dimension) 00099 { 00100 void __any(); 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 __any (res_ptr, mask, dimension); 00119 return(*(_f_log4 *) res_ptr->base_addr.a.ptr); 00120 } 00121 00122 00123 void 00124 _ANY_8 (DopeVectorType * result, 00125 DopeVectorType * mask, 00126 _f_int *dimension) 00127 { 00128 void __any(); 00129 (void) __any (result, mask, dimension); 00130 } 00131 00132 _f_log8 00133 _ANY0_8 (DopeVectorType * mask, 00134 _f_int *dimension) 00135 { 00136 void __any(); 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 __any (res_ptr, mask, dimension); 00155 return(*(_f_log8 *) res_ptr->base_addr.a.ptr); 00156 } 00157 00158 00159 void 00160 _ANY_2 (DopeVectorType * result, 00161 DopeVectorType * mask, 00162 _f_int *dimension) 00163 { 00164 void __any(); 00165 (void) __any (result, mask, dimension); 00166 } 00167 00168 _f_log2 00169 _ANY0_2 (DopeVectorType * mask, 00170 _f_int *dimension) 00171 { 00172 void __any(); 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 __any (res_ptr, mask, dimension); 00191 return(*(_f_log2 *) res_ptr->base_addr.a.ptr); 00192 } 00193 00194 00195 void 00196 _ANY_1 (DopeVectorType * result, 00197 DopeVectorType * mask, 00198 _f_int *dimension) 00199 { 00200 void __any(); 00201 (void) __any (result, mask, dimension); 00202 } 00203 00204 _f_log1 00205 _ANY0_1 (DopeVectorType * mask, 00206 _f_int *dimension) 00207 { 00208 void __any(); 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 __any (res_ptr, mask, dimension); 00227 return(*(_f_log1 *) res_ptr->base_addr.a.ptr); 00228 } 00229 00230 00231 void 00232 __any (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; /* elements 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 * i1mptr; /* ptr to mask array */ 00248 _f_log1 * i1rptr; /* ptr to result array */ 00249 #endif 00250 #ifdef _F_LOG2 00251 _f_log2 * i2mptr; /* ptr to mask array */ 00252 _f_log2 * i2rptr; /* ptr to result 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 /* set fields for null array as well */ 00318 result->orig_base = result->base_addr.a.ptr; 00319 result->orig_size = nbytes * BITS_PER_BYTE; 00320 } 00321 00322 00323 /* Set pointer to mask array and initialize result array to FALSE */ 00324 irptr = (_f_log *) 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(0); 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(0); 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(0); 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(0); 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 ANY 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 ANY_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 00419 /* Scan array until a TRUE element is found */ 00420 i = 0; 00421 indx = 0; 00422 switch (mask->type_lens.int_len) { 00423 case 64 : 00424 while (i < mask->dimension[0].extent) { 00425 if (LTOB(el_len, (i8mptr + indx))) { 00426 /* true element */ 00427 switch (result->type_lens.int_len) { 00428 case 64 : 00429 i8rptr[0] = (_f_log8) _btol(1); 00430 break; 00431 #ifdef _F_LOG2 00432 case 16 : 00433 i2rptr[0] = (_f_log2) _btol(1); 00434 break; 00435 #endif 00436 #ifdef _F_LOG1 00437 case 8 : 00438 i1rptr[0] = (_f_log1) _btol(1); 00439 break; 00440 #endif 00441 case 32 : 00442 default : 00443 i4rptr[0] = (_f_log4) _btol(1); 00444 } 00445 i = mask->dimension[0].extent; 00446 } else { 00447 /* false element */ 00448 i++; 00449 indx = i * mask_stride[0]; 00450 } 00451 } 00452 break; 00453 #ifdef _F_LOG2 00454 case 16 : 00455 while (i < mask->dimension[0].extent) { 00456 if (LTOB(el_len, (i2mptr + indx))) { 00457 /* true element */ 00458 switch (result->type_lens.int_len) { 00459 case 64 : 00460 i8rptr[0] = (_f_log8) _btol(1); 00461 break; 00462 case 16 : 00463 i2rptr[0] = (_f_log2) _btol(1); 00464 break; 00465 #ifdef _F_LOG1 00466 case 8 : 00467 i1rptr[0] = (_f_log1) _btol(1); 00468 break; 00469 #endif 00470 case 32 : 00471 default : 00472 i4rptr[0] = (_f_log4) _btol(1); 00473 } 00474 i = mask->dimension[0].extent; 00475 } else { 00476 /* false element */ 00477 i++; 00478 indx = i * mask_stride[0]; 00479 } 00480 } 00481 break; 00482 #endif 00483 #ifdef _F_LOG1 00484 case 8 : 00485 while (i < mask->dimension[0].extent) { 00486 if (LTOB(el_len, (i1mptr + indx))) { 00487 /* true element */ 00488 switch (result->type_lens.int_len) { 00489 case 64 : 00490 i8rptr[0] = (_f_log8) _btol(1); 00491 break; 00492 case 16 : 00493 i2rptr[0] = (_f_log2) _btol(1); 00494 break; 00495 case 8 : 00496 i1rptr[0] = (_f_log1) _btol(1); 00497 break; 00498 case 32 : 00499 default : 00500 i4rptr[0] = (_f_log4) _btol(1); 00501 } 00502 i = mask->dimension[0].extent; 00503 } else { 00504 /* false element */ 00505 i++; 00506 indx = i * mask_stride[0]; 00507 } 00508 } 00509 break; 00510 #endif 00511 case 32 : 00512 default : 00513 while (i < mask->dimension[0].extent) { 00514 if (LTOB(el_len, (i4mptr + indx))) { 00515 /* true element */ 00516 switch (result->type_lens.int_len) { 00517 case 64 : 00518 i8rptr[0] = (_f_log8) _btol(1); 00519 break; 00520 #ifdef _F_LOG2 00521 case 16 : 00522 i2rptr[0] = (_f_log2) _btol(1); 00523 break; 00524 #endif 00525 #ifdef _F_LOG1 00526 case 8 : 00527 i1rptr[0] = (_f_log1) _btol(1); 00528 break; 00529 #endif 00530 case 32 : 00531 default : 00532 i4rptr[0] = (_f_log4) _btol(1); 00533 } 00534 i = mask->dimension[0].extent; 00535 } else { 00536 /* false element */ 00537 i++; 00538 indx = i * mask_stride[0]; 00539 } 00540 } 00541 } 00542 00543 /* Handle a rank-two mask array */ 00544 } else if (mask->n_dim == 2) { 00545 00546 /* Initialize data */ 00547 if (c_dim == 0) 00548 other_dim = 1; 00549 else 00550 other_dim = 0; 00551 #ifdef _F_LOG4 00552 mask_stride[0] = (mask->dimension[0].stride_mult) >> mshftct; 00553 mask_stride[1] = (mask->dimension[1].stride_mult) >> mshftct; 00554 #else 00555 mask_stride[0] = mask->dimension[0].stride_mult; 00556 mask_stride[1] = mask->dimension[1].stride_mult; 00557 #endif 00558 00559 /* Scan array until a TRUE element is found */ 00560 i = 0; 00561 indx = 0; 00562 while (i < mask->dimension[other_dim].extent) { 00563 j = 0; 00564 jndx = indx; 00565 switch (mask->type_lens.int_len) { 00566 case 64 : 00567 while (j < mask->dimension[c_dim].extent) { 00568 if (LTOB(el_len, (i8mptr + jndx))) { 00569 /* true element */ 00570 if (result->n_dim == 0) { 00571 switch (result->type_lens.int_len) { 00572 case 64 : 00573 i8rptr[0] = (_f_log8) _btol(1); 00574 break; 00575 #ifdef _F_LOG2 00576 case 16 : 00577 i2rptr[0] = (_f_log2) _btol(1); 00578 break; 00579 #endif 00580 #ifdef _F_LOG1 00581 case 8 : 00582 i1rptr[0] = (_f_log1) _btol(1); 00583 break; 00584 #endif 00585 case 32 : 00586 default : 00587 i4rptr[0] = (_f_log4) _btol(1); 00588 } 00589 j = mask->dimension[c_dim].extent; 00590 i = mask->dimension[other_dim].extent; 00591 } else { 00592 switch (result->type_lens.int_len) { 00593 case 64 : 00594 i8rptr[i] = (_f_log8) _btol(1); 00595 break; 00596 #ifdef _F_LOG2 00597 case 16 : 00598 i2rptr[i] = (_f_log2) _btol(1); 00599 break; 00600 #endif 00601 #ifdef _F_LOG1 00602 case 8 : 00603 i1rptr[i] = (_f_log1) _btol(1); 00604 break; 00605 #endif 00606 case 32 : 00607 default : 00608 i4rptr[i] = (_f_log4) _btol(1); 00609 } 00610 j = mask->dimension[c_dim].extent; 00611 } 00612 } else { 00613 /* false element */ 00614 j++; 00615 jndx = indx + j * 00616 mask_stride[c_dim]; 00617 } 00618 } 00619 break; 00620 #ifdef _F_LOG2 00621 case 16 : 00622 while (j < mask->dimension[c_dim].extent) { 00623 if (LTOB(el_len, (i2mptr + jndx))) { 00624 /* true element */ 00625 if (result->n_dim == 0) { 00626 switch (result->type_lens.int_len) { 00627 case 64 : 00628 i8rptr[0] = (_f_log8) _btol(1); 00629 break; 00630 case 16 : 00631 i2rptr[0] = (_f_log2) _btol(1); 00632 break; 00633 #ifdef _F_LOG1 00634 case 8 : 00635 i1rptr[0] = (_f_log1) _btol(1); 00636 break; 00637 #endif 00638 case 32 : 00639 default : 00640 i4rptr[0] = (_f_log4) _btol(1); 00641 } 00642 j = mask->dimension[c_dim].extent; 00643 i = mask->dimension[other_dim].extent; 00644 } else { 00645 switch (result->type_lens.int_len) { 00646 case 64 : 00647 i8rptr[i] = (_f_log8) _btol(1); 00648 break; 00649 case 16 : 00650 i2rptr[i] = (_f_log2) _btol(1); 00651 break; 00652 #ifdef _F_LOG1 00653 case 8 : 00654 i1rptr[i] = (_f_log1) _btol(1); 00655 break; 00656 #endif 00657 case 32 : 00658 default : 00659 i4rptr[i] = (_f_log4) _btol(1); 00660 } 00661 j = mask->dimension[c_dim].extent; 00662 } 00663 } else { 00664 /* false element */ 00665 j++; 00666 jndx = indx + j * 00667 mask_stride[c_dim]; 00668 } 00669 } 00670 break; 00671 #endif 00672 #ifdef _F_LOG1 00673 case 8 : 00674 while (j < mask->dimension[c_dim].extent) { 00675 if (LTOB(el_len, (i8mptr + jndx))) { 00676 /* true element */ 00677 if (result->n_dim == 0) { 00678 switch (result->type_lens.int_len) { 00679 case 64 : 00680 i8rptr[0] = (_f_log8) _btol(1); 00681 break; 00682 case 16 : 00683 i2rptr[0] = (_f_log2) _btol(1); 00684 break; 00685 case 8 : 00686 i1rptr[0] = (_f_log1) _btol(1); 00687 break; 00688 case 32 : 00689 default : 00690 i4rptr[0] = (_f_log4) _btol(1); 00691 } 00692 j = mask->dimension[c_dim].extent; 00693 i = mask->dimension[other_dim].extent; 00694 } else { 00695 switch (result->type_lens.int_len) { 00696 case 64 : 00697 i8rptr[i] = (_f_log8) _btol(1); 00698 break; 00699 case 16 : 00700 i2rptr[i] = (_f_log2) _btol(1); 00701 break; 00702 case 8 : 00703 i1rptr[i] = (_f_log1) _btol(1); 00704 break; 00705 case 32 : 00706 default : 00707 i4rptr[i] = (_f_log4) _btol(1); 00708 } 00709 j = mask->dimension[c_dim].extent; 00710 } 00711 } else { 00712 /* false element */ 00713 j++; 00714 jndx = indx + j * 00715 mask_stride[c_dim]; 00716 } 00717 } 00718 break; 00719 #endif 00720 case 32 : 00721 default : 00722 while (j < mask->dimension[c_dim].extent) { 00723 if (LTOB(el_len, (i4mptr + jndx))) { 00724 /* true element */ 00725 if (result->n_dim == 0) { 00726 switch (result->type_lens.int_len) { 00727 case 64 : 00728 i8rptr[0] = (_f_log8) _btol(1); 00729 break; 00730 #ifdef _F_LOG2 00731 case 16 : 00732 i2rptr[0] = (_f_log2) _btol(1); 00733 break; 00734 #endif 00735 #ifdef _F_LOG1 00736 case 8 : 00737 i1rptr[0] = (_f_log1) _btol(1); 00738 break; 00739 #endif 00740 case 32 : 00741 default : 00742 i4rptr[0] = (_f_log4) _btol(1); 00743 } 00744 j = mask->dimension[c_dim].extent; 00745 i = mask->dimension[other_dim].extent; 00746 } else { 00747 switch (result->type_lens.int_len) { 00748 case 64 : 00749 i8rptr[i] = (_f_log8) _btol(1); 00750 break; 00751 #ifdef _F_LOG2 00752 case 16 : 00753 i2rptr[i] = (_f_log2) _btol(1); 00754 break; 00755 #endif 00756 #ifdef _F_LOG1 00757 case 8 : 00758 i1rptr[i] = (_f_log1) _btol(1); 00759 break; 00760 #endif 00761 case 32 : 00762 default : 00763 i4rptr[i] = (_f_log4) _btol(1); 00764 } 00765 j = mask->dimension[c_dim].extent; 00766 } 00767 } else { 00768 /* false element */ 00769 j++; 00770 jndx = indx + j * 00771 mask_stride[c_dim]; 00772 } 00773 } 00774 } 00775 00776 if (i != mask->dimension[other_dim].extent) { 00777 i++; 00778 indx = i * mask_stride[other_dim]; 00779 } 00780 } 00781 00782 /* Handle a rank-three through rank-seven mask array */ 00783 } else { 00784 00785 /* Initialize data */ 00786 if (result->n_dim != 0) 00787 #ifdef _UNICOS 00788 #pragma _CRI shortloop 00789 #endif 00790 for (i = 0; i < result->n_dim; i++) { 00791 result_offset[i] = 0; 00792 #ifdef _F_LOG4 00793 result_stride[i] = 00794 (result->dimension[i].stride_mult) >> rshftct; 00795 #else 00796 result_stride[i] = 00797 result->dimension[i].stride_mult; 00798 #endif 00799 } 00800 00801 /* Initialize mask parameters based on which dimension 00802 * has been requested 00803 */ 00804 if (c_dim == 0) 00805 i = 0; 00806 else 00807 #ifdef _UNICOS 00808 #pragma _CRI shortloop 00809 #endif 00810 for (i = 0; i < c_dim; i++) { 00811 current_place[i] = 0; 00812 mask_offset[i] = 0; 00813 mask_extent[i] = mask->dimension[i].extent; 00814 #ifdef _F_LOG4 00815 mask_stride[i] = 00816 (mask->dimension[i].stride_mult) >> mshftct; 00817 #else 00818 mask_stride[i] = mask->dimension[i].stride_mult; 00819 #endif 00820 } 00821 if (i < (mask->n_dim - 1)) 00822 #ifdef _UNICOS 00823 #pragma _CRI shortloop 00824 #endif 00825 for ( ; i < mask->n_dim - 1; i++) { 00826 current_place[i] = 0; 00827 mask_offset[i] = 0; 00828 mask_extent[i] = mask->dimension[i+1].extent; 00829 #ifdef _F_LOG4 00830 mask_stride[i] = 00831 (mask->dimension[i+1].stride_mult) >> mshftct; 00832 #else 00833 mask_stride[i] = mask->dimension[i+1].stride_mult; 00834 #endif 00835 } 00836 #ifdef _F_LOG4 00837 cdim_mask_stride = mask->dimension[c_dim].stride_mult >> mshftct; 00838 #else 00839 cdim_mask_stride = mask->dimension[c_dim].stride_mult; 00840 #endif 00841 00842 /* Scan array until a TRUE element is found */ 00843 done = FALSE; 00844 while (!done) { 00845 /* Determine starting point */ 00846 indx = 0; 00847 #ifdef _UNICOS 00848 #pragma _CRI shortloop 00849 #endif 00850 for (i = 0; i < mask->n_dim - 1; i++) 00851 indx += mask_offset[i]; 00852 j = 0; 00853 jndx = indx; 00854 00855 /* Scan elements */ 00856 switch (mask->type_lens.int_len) { 00857 case 64 : 00858 while (j < mask->dimension[c_dim].extent) { 00859 if (LTOB(el_len, (i8mptr + jndx))) { 00860 /* true element */ 00861 if (result->n_dim == 0) { 00862 switch (result->type_lens.int_len) { 00863 case 64 : 00864 i8rptr[0] = (_f_log8) _btol(1); 00865 break; 00866 #ifdef _F_LOG2 00867 case 16 : 00868 i2rptr[0] = (_f_log2) _btol(1); 00869 break; 00870 #endif 00871 #ifdef _F_LOG1 00872 case 8 : 00873 i1rptr[0] = (_f_log1) _btol(1); 00874 break; 00875 #endif 00876 case 32 : 00877 default : 00878 i4rptr[0] = (_f_log4) _btol(1); 00879 } 00880 j = mask->dimension[c_dim].extent; 00881 done = TRUE; 00882 } else { 00883 indx = 0; 00884 #ifdef _UNICOS 00885 #pragma _CRI shortloop 00886 #endif 00887 for (i = 0; i < mask->n_dim - 1; i++) 00888 indx += result_offset[i]; 00889 switch (result->type_lens.int_len) { 00890 case 64 : 00891 i8rptr[indx] = (_f_log8) _btol(1); 00892 break; 00893 #ifdef _F_LOG2 00894 case 16 : 00895 i2rptr[indx] = (_f_log2) _btol(1); 00896 break; 00897 #endif 00898 #ifdef _F_LOG1 00899 case 8 : 00900 i1rptr[indx] = (_f_log1) _btol(1); 00901 break; 00902 #endif 00903 case 32 : 00904 default : 00905 i4rptr[indx] = (_f_log4) _btol(1); 00906 } 00907 j = mask->dimension[c_dim].extent; 00908 } 00909 } else { 00910 /* false element */ 00911 j++; 00912 jndx = indx + j * 00913 cdim_mask_stride; 00914 } 00915 } 00916 break; 00917 #ifdef _F_LOG2 00918 case 16 : 00919 while (j < mask->dimension[c_dim].extent) { 00920 if (LTOB(el_len, (i2mptr + jndx))) { 00921 /* true element */ 00922 if (result->n_dim == 0) { 00923 switch (result->type_lens.int_len) { 00924 case 64 : 00925 i8rptr[0] = (_f_log8) _btol(1); 00926 break; 00927 case 16 : 00928 i2rptr[0] = (_f_log2) _btol(1); 00929 break; 00930 #ifdef _F_LOG1 00931 case 8 : 00932 i1rptr[0] = (_f_log1) _btol(1); 00933 break; 00934 #endif 00935 case 32 : 00936 default : 00937 i4rptr[0] = (_f_log4) _btol(1); 00938 } 00939 j = mask->dimension[c_dim].extent; 00940 done = TRUE; 00941 } else { 00942 indx = 0; 00943 #ifdef _UNICOS 00944 #pragma _CRI shortloop 00945 #endif 00946 for (i = 0; i < mask->n_dim - 1; i++) 00947 indx += result_offset[i]; 00948 switch (result->type_lens.int_len) { 00949 case 64 : 00950 i8rptr[indx] = (_f_log8) _btol(1); 00951 break; 00952 case 16 : 00953 i2rptr[indx] = (_f_log2) _btol(1); 00954 break; 00955 #ifdef _F_LOG1 00956 case 8 : 00957 i1rptr[indx] = (_f_log1) _btol(1); 00958 break; 00959 #endif 00960 case 32 : 00961 default : 00962 i4rptr[indx] = (_f_log4) _btol(1); 00963 } 00964 j = mask->dimension[c_dim].extent; 00965 } 00966 } else { 00967 /* false element */ 00968 j++; 00969 jndx = indx + j * 00970 cdim_mask_stride; 00971 } 00972 } 00973 break; 00974 #endif 00975 #ifdef _F_LOG1 00976 case 8 : 00977 while (j < mask->dimension[c_dim].extent) { 00978 if (LTOB(el_len, (i1mptr + jndx))) { 00979 /* true element */ 00980 if (result->n_dim == 0) { 00981 switch (result->type_lens.int_len) { 00982 case 64 : 00983 i8rptr[0] = (_f_log8) _btol(1); 00984 break; 00985 case 16 : 00986 i2rptr[0] = (_f_log2) _btol(1); 00987 break; 00988 case 8 : 00989 i1rptr[0] = (_f_log1) _btol(1); 00990 break; 00991 case 32 : 00992 default : 00993 i4rptr[0] = (_f_log4) _btol(1); 00994 } 00995 j = mask->dimension[c_dim].extent; 00996 done = TRUE; 00997 } else { 00998 indx = 0; 00999 #ifdef _UNICOS 01000 #pragma _CRI shortloop 01001 #endif 01002 for (i = 0; i < mask->n_dim - 1; i++) 01003 indx += result_offset[i]; 01004 switch (result->type_lens.int_len) { 01005 case 64 : 01006 i8rptr[indx] = (_f_log8) _btol(1); 01007 break; 01008 case 16 : 01009 i2rptr[indx] = (_f_log2) _btol(1); 01010 break; 01011 case 8 : 01012 i1rptr[indx] = (_f_log1) _btol(1); 01013 break; 01014 case 32 : 01015 default : 01016 i4rptr[indx] = (_f_log4) _btol(1); 01017 } 01018 j = mask->dimension[c_dim].extent; 01019 } 01020 } else { 01021 /* false element */ 01022 j++; 01023 jndx = indx + j * 01024 cdim_mask_stride; 01025 } 01026 } 01027 break; 01028 #endif 01029 case 32 : 01030 default : 01031 while (j < mask->dimension[c_dim].extent) { 01032 if (LTOB(el_len, (i4mptr + jndx))) { 01033 /* true element */ 01034 if (result->n_dim == 0) { 01035 switch (result->type_lens.int_len) { 01036 case 64 : 01037 i8rptr[0] = (_f_log8) _btol(1); 01038 break; 01039 #ifdef _F_LOG2 01040 case 16 : 01041 i2rptr[0] = (_f_log2) _btol(1); 01042 break; 01043 #endif 01044 #ifdef _F_LOG1 01045 case 8 : 01046 i1rptr[0] = (_f_log1) _btol(1); 01047 break; 01048 #endif 01049 case 32 : 01050 default : 01051 i4rptr[0] = (_f_log4) _btol(1); 01052 } 01053 j = mask->dimension[c_dim].extent; 01054 done = TRUE; 01055 } else { 01056 indx = 0; 01057 #ifdef _UNICOS 01058 #pragma _CRI shortloop 01059 #endif 01060 for (i = 0; i < mask->n_dim - 1; i++) 01061 indx += result_offset[i]; 01062 switch (result->type_lens.int_len) { 01063 case 64 : 01064 i8rptr[indx] = (_f_log8) _btol(1); 01065 break; 01066 #ifdef _F_LOG2 01067 case 16 : 01068 i2rptr[indx] = (_f_log2) _btol(1); 01069 break; 01070 #endif 01071 #ifdef _F_LOG1 01072 case 8 : 01073 i1rptr[indx] = (_f_log1) _btol(1); 01074 break; 01075 #endif 01076 case 32 : 01077 default : 01078 i4rptr[indx] = (_f_log4) _btol(1); 01079 } 01080 j = mask->dimension[c_dim].extent; 01081 } 01082 } else { 01083 /* false element */ 01084 j++; 01085 jndx = indx + j * 01086 cdim_mask_stride; 01087 } 01088 } 01089 } 01090 01091 /* If not done, add to pointers for each dimension */ 01092 if (!done) { 01093 i = 0; 01094 stop = FALSE; 01095 while (stop == FALSE && i < mask->n_dim - 1) { 01096 if (current_place[i] == mask_extent[i] - 1) { 01097 current_place[i] = 0; 01098 mask_offset[i] = 0; 01099 if (result->n_dim != 0) 01100 result_offset[i] = 0; 01101 } else { 01102 current_place[i]++; 01103 mask_offset[i] = current_place[i] * 01104 mask_stride[i]; 01105 if (result->n_dim != 0) 01106 result_offset[i] = current_place[i] * 01107 result_stride[i]; 01108 stop = TRUE; 01109 } 01110 i++; 01111 } 01112 if (!stop) 01113 /* Been through the whole array, 01114 * quit processing 01115 */ 01116 done = TRUE; 01117 } 01118 } 01119 } 01120 }
1.7.6.1 
