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 /* automatically generated file, do not edit */ 00037 00038 #include "f90_intrinsic.h" 00039 00040 void 00041 _UNPACK( 00042 DopeVectorType *result, 00043 DopeVectorType *vector, 00044 DopeVectorType *mask, 00045 DopeVectorType *field) 00046 { 00047 char * result_p, * result_b ; 00048 char * vector_p, * vector_b ; 00049 char * mask_p, * mask_b ; 00050 char * field_p, * field_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(vector) - 1; 00069 00070 size_t typ_sz = GET_ELEMENT_SZ_FROM_DESC(vector); 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 fill_stride [MAX_NARY_DIMS] ; 00079 size_t fill_offset [MAX_NARY_DIMS] ; 00080 size_t f_stride ; 00081 int32_t fill_rank ; 00082 size_t num_trues ; 00083 int32_t local_alloc ; 00084 size_t tot_ext ; 00085 size_t str_sz ; 00086 00087 size_t src_size ; 00088 size_t m_stride ; 00089 int32_t msk_rank ; 00090 00091 size_t res_sz; 00092 size_t xfer_sz; 00093 size_t tot_sz; 00094 00095 src_stride[0] = GET_STRIDE_FROM_DESC(vector,0) ; 00096 zero_szd_source = (GET_EXTENT_FROM_DESC(vector,0) == 0); 00097 byte_aligned = GET_BYTEALIGNED_FROM_DESC(vector) ; 00098 00099 { 00100 size_t msk_typ_sz ; 00101 msk_typ_sz = GET_ELEMENT_SZ_FROM_DESC(mask); 00102 mask_b = (char *) GET_ADDRESS_FROM_DESC(mask) + OFFSET_TO_TF_BYTE(msk_typ_sz); 00103 msk_rank = GET_RANK_FROM_DESC(mask) - 1 ; 00104 00105 for ( j = 0 ; j <= msk_rank ; j ++ ) { 00106 msk_stride[j] = GET_STRIDE_FROM_DESC(mask,j) ; 00107 src_extent[j] = GET_EXTENT_FROM_DESC(mask,j) ; 00108 } 00109 00110 for ( j = 1 ; j <= msk_rank ; j ++ ) 00111 msk_offset[j-1] = msk_stride[j] - (msk_stride [j-1] * (src_extent[j-1])) ; 00112 } 00113 00114 if (!GET_ASSOCIATED_FROM_DESC(result)) { 00115 00116 size_t nbytes ; 00117 char *p ; 00118 00119 SET_ADDRESS_IN_DESC(result,NULL); 00120 SET_ORIG_BS_IN_DESC(result,NULL) ; 00121 SET_ORIG_SZ_IN_DESC(result,0) ; 00122 00123 p = NULL ; 00124 tot_ext = 1 ; 00125 nbytes = typ_sz ; 00126 str_sz = MK_STRIDE(byte_aligned,typ_sz); 00127 00128 for ( i = 0 ; i <= msk_rank ; i ++) { 00129 SET_LBOUND_IN_DESC(result,i,1); 00130 SET_EXTENT_IN_DESC(result,i,src_extent[i]); 00131 SET_STRMULT_IN_DESC(result,i,tot_ext * str_sz ); 00132 tot_ext *= src_extent[i]; 00133 nbytes *= src_extent[i]; 00134 } 00135 00136 if (nbytes > 0) { 00137 p = malloc (nbytes); 00138 if (p == NULL) 00139 ERROR(_LELVL_ABORT, FENOMEMY); 00140 00141 SET_ADDRESS_IN_DESC(result,p); 00142 } 00143 SET_CONTIG_IN_DESC(result); 00144 SET_ASSOCIATED_IN_DESC(result); 00145 if (GET_DV_ASCII_FROM_DESC(vector)) { 00146 SET_CHARPTR_IN_DESC(result,p,typ_sz); 00147 } 00148 SET_ORIG_BS_IN_DESC(result,p) ; 00149 SET_ORIG_SZ_IN_DESC(result,nbytes * 8) ; 00150 } 00151 00152 for ( j = 0 ; j <= msk_rank ; j ++ ) { 00153 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ; 00154 counter[j] = 0 ; 00155 src_offset[j] = 0 ; 00156 } 00157 00158 for ( j = 1 ; j <= msk_rank ; j ++ ) 00159 res_offset[j-1] = res_stride[j] - (res_stride [j-1] * (src_extent[j-1])) ; 00160 00161 field_p = GET_ADDRESS_FROM_DESC(field); 00162 fill_rank = GET_RANK_FROM_DESC(field) ; 00163 00164 for ( j = 0 ; j <= msk_rank ; j ++ ) { 00165 fill_stride[j] = 0; 00166 fill_offset[j] = 0; 00167 } 00168 for ( j = 0 ; j < fill_rank ; j ++ ) { 00169 fill_stride[j] = GET_STRIDE_FROM_DESC(field,j) ; 00170 } 00171 for ( j = 1 ; j < fill_rank ; j ++ ) { 00172 fill_offset[j] = fill_stride[j] - (fill_stride [j-1] * (src_extent[j])) ; 00173 } 00174 00175 src_rank = msk_rank ; 00176 00177 if (zero_szd_source) 00178 return ; 00179 00180 a_size = src_extent[0] ; 00181 a_stride = src_stride[0] ; 00182 r_stride = res_stride[0] ; 00183 m_stride = msk_stride[0] ; 00184 f_stride = fill_stride[0] ; 00185 vector_p = GET_ADDRESS_FROM_DESC(vector); 00186 result_p = GET_ADDRESS_FROM_DESC(result); 00187 mask_p = mask_b ; 00188 00189 { 00190 while (counter[src_rank] < src_extent[src_rank] ) { 00191 char * lfill ; 00192 00193 for ( i = 0 ; i < a_size ; i ++ ) { 00194 00195 lfill = field_p ; 00196 if (*mask_p) { 00197 ap = vector_p ; 00198 vector_p += a_stride ; 00199 } else { 00200 ap = lfill ; 00201 } 00202 00203 rp = result_p ; 00204 if (typ_sz > BIGDEFAULTSZ) 00205 (void) memcpy (rp, ap, typ_sz); 00206 else 00207 for (j = 0 ; j < typ_sz ; j ++) *rp++ = *ap ++ ; 00208 00209 result_p += r_stride ; 00210 mask_p += m_stride ; 00211 field_p += f_stride ; 00212 } 00213 counter[0] = a_size ; 00214 j = 0 ; 00215 while ((counter[j] == src_extent[j]) && (j < src_rank)) { 00216 vector_p += src_offset[j] ; 00217 result_p += res_offset[j] ; 00218 mask_p += msk_offset[j] ; 00219 field_p += fill_offset[j] ; 00220 counter[j+1]++ ; 00221 counter[j] = 0 ; 00222 j ++ ; 00223 } 00224 00225 } 00226 } 00227 }