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 _TRANSFER( 00042 DopeVectorType *result, 00043 DopeVectorType *array, 00044 DopeVectorType *mold, 00045 i4 *size) 00046 { 00047 char * result_p, * result_b ; 00048 char * array_p, * array_b ; 00049 char * mold_p, * mold_b ; 00050 00051 size_t src_extent [MAX_NARY_DIMS] ; 00052 size_t src_stride [MAX_NARY_DIMS] ; 00053 size_t src_offset [MAX_NARY_DIMS] ; 00054 size_t counter[MAX_NARY_DIMS] ; 00055 00056 size_t res_stride [MAX_NARY_DIMS] ; 00057 size_t res_extent [MAX_NARY_DIMS] ; 00058 size_t res_offset [MAX_NARY_DIMS] ; 00059 00060 int32_t j,ii; 00061 char *rp, *ap ; 00062 int32_t res_rank ; 00063 int32_t src_rank = GET_RANK_FROM_DESC(array) - 1; 00064 00065 size_t typ_sz = GET_ELEMENT_SZ_FROM_DESC(array); 00066 00067 size_t a_size,a_stride,r_stride, i,k ; 00068 int8_t zero_szd_source = FALSE; 00069 int8_t byte_aligned = FALSE; 00070 00071 int32_t ddim ; 00072 00073 size_t num_trues ; 00074 int32_t local_alloc ; 00075 size_t tot_ext ; 00076 size_t str_sz ; 00077 00078 size_t src_size ; 00079 00080 size_t res_sz; 00081 size_t xfer_sz; 00082 size_t tot_sz; 00083 00084 byte_aligned = GET_BYTEALIGNED_FROM_DESC(mold) ; 00085 00086 src_extent[0] = 1; 00087 src_stride[0] = GET_ELEMENT_SZ_FROM_DESC(array); 00088 src_offset[0] = 0 ; 00089 counter[0] = 0 ; 00090 src_size = GET_ELEMENT_SZ_FROM_DESC(array); 00091 tot_ext = 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 counter[j] = 0 ; 00097 zero_szd_source = zero_szd_source || (src_extent[j] == 0) ; 00098 src_size *= src_extent[j]; 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 res_sz = GET_ELEMENT_SZ_FROM_DESC(mold); 00105 res_rank = GET_RANK_FROM_DESC(result); 00106 res_offset[0] = 0 ; 00107 res_stride[0] = res_sz ; 00108 00109 k = 0 ; 00110 if (size) { 00111 if (*size > 0) 00112 tot_ext = * size ; 00113 else { 00114 zero_szd_source = TRUE; 00115 tot_ext = 0 ; 00116 } 00117 tot_sz = tot_ext * res_sz ; 00118 00119 } else { 00120 if (GET_RANK_FROM_DESC(mold) == 0) { 00121 tot_ext = 1 ; 00122 tot_sz = res_sz ; 00123 00124 } else { 00125 tot_ext = GET_EXTENT_FROM_DESC(mold,0); 00126 00127 tot_sz = src_size ; 00128 tot_ext = tot_sz/res_sz ; 00129 if (tot_sz%res_sz) 00130 tot_ext ++ ; 00131 } 00132 } 00133 00134 if (!GET_ASSOCIATED_FROM_DESC(result)) { 00135 00136 size_t nbytes ; 00137 char *p ; 00138 00139 SET_ADDRESS_IN_DESC(result,NULL); 00140 SET_ORIG_BS_IN_DESC(result,NULL) ; 00141 SET_ORIG_SZ_IN_DESC(result,0) ; 00142 00143 p = NULL ; 00144 nbytes = tot_ext * res_sz ; 00145 str_sz = MK_STRIDE(byte_aligned,res_sz); 00146 00147 if (res_rank > 0) { 00148 SET_LBOUND_IN_DESC(result,0,1); 00149 SET_EXTENT_IN_DESC(result,0,tot_ext); 00150 SET_STRMULT_IN_DESC(result,0, str_sz ); 00151 } 00152 00153 if (nbytes > 0 ) { 00154 p = (void *) malloc (nbytes); 00155 if (p == NULL) 00156 ERROR(_LELVL_ABORT, FENOMEMY); 00157 00158 SET_ADDRESS_IN_DESC(result,p); 00159 } 00160 00161 SET_CONTIG_IN_DESC(result); 00162 SET_ASSOCIATED_IN_DESC(result); 00163 SET_CONTIG_IN_DESC(result); 00164 if (GET_DV_ASCII_FROM_DESC(result)) { 00165 SET_CHARPTR_IN_DESC(result,p,res_sz << 3); 00166 } 00167 SET_ORIG_BS_IN_DESC(result,p) ; 00168 SET_ORIG_SZ_IN_DESC(result,nbytes * 8 ) ; 00169 } 00170 00171 if (res_rank > 0) 00172 res_stride[0] = GET_STRIDE_FROM_DESC(result,0) ; 00173 00174 if (src_rank < 0) src_rank ++ ; 00175 00176 result_b = GET_ADDRESS_FROM_DESC(result); 00177 array_b = GET_ADDRESS_FROM_DESC(array); 00178 00179 if (zero_szd_source) 00180 return ; 00181 00182 a_size = src_extent[0] ; 00183 a_stride = src_stride[0] ; 00184 r_stride = res_stride[0] ; 00185 array_p = GET_ADDRESS_FROM_DESC(array); 00186 result_p = GET_ADDRESS_FROM_DESC(result); 00187 00188 { 00189 while (counter[src_rank] < src_extent[src_rank] ) { 00190 { 00191 size_t todo_s,todo_r ; 00192 todo_r = res_sz ; 00193 00194 for ( i = 0 ; i < a_size ; i ++ ) { 00195 00196 ap = array_p ; 00197 rp = result_p ; 00198 todo_s = typ_sz ; 00199 while (todo_s != 0) { 00200 xfer_sz = todo_s ; 00201 if (xfer_sz > todo_r) xfer_sz = todo_r ; 00202 for (j = 0 ; j < xfer_sz ; j ++) *rp++ = *ap ++ ; 00203 00204 todo_r -= xfer_sz ; 00205 todo_s -= xfer_sz ; 00206 00207 if (todo_r != 0) 00208 result_p += xfer_sz ; 00209 else { 00210 result_b += r_stride ; 00211 result_p = result_b ; 00212 todo_r = res_sz ; 00213 } 00214 k += xfer_sz ; 00215 if (k >= tot_sz) 00216 return ; 00217 } 00218 array_p += a_stride ; 00219 } 00220 } 00221 counter[0] = a_size ; 00222 j = 0 ; 00223 while ((counter[j] == src_extent[j]) && (j < src_rank)) { 00224 array_p += src_offset[j] ; 00225 counter[j+1]++ ; 00226 counter[j] = 0 ; 00227 j ++ ; 00228 } 00229 00230 } 00231 } 00232 }