1 /* 2 * Copyright (c) 2002-2019, NVIDIA CORPORATION. All rights reserved. 3 * 4 * Licensed under the Apache License, Version 2.0 (the "License"); 5 * you may not use this file except in compliance with the License. 6 * You may obtain a copy of the License at 7 * 8 * http://www.apache.org/licenses/LICENSE-2.0 9 * 10 * Unless required by applicable law or agreed to in writing, software 11 * distributed under the License is distributed on an "AS IS" BASIS, 12 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 * See the License for the specific language governing permissions and 14 * limitations under the License. 15 * 16 */ 17 18 /* clang-format off */ 19 20 /** 21 * \file 22 * \brief descriptor and other definitions 23 */ 24 25 /* TODO FOR FLANG: is this still needed ??? */ 26 27 #ifndef _PGHPF_H_ 28 #define _PGHPF_H_ 29 30 #include <stdlib.h> 31 #include <stdarg.h> 32 #include "fortDt.h" 33 #include "fioStructs.h" 34 #include "FuncArgMacros.h" 35 36 /* special argument pointers */ 37 38 #if defined(TARGET_WIN) || defined(WIN64) || defined(WIN32) 39 WIN_IMP __INT_T ENTCOMN(0, 0)[4]; 40 WIN_IMP __STR_T ENTCOMN(0C, 0c)[1]; 41 #elif defined(WINNT) 42 __INT_T ENTCOMN(0, 0)[4]; 43 __STR_T ENTCOMN(0C, 0c)[1]; 44 char *__get_fort_01_addr(void); 45 char *__get_fort_02_addr(void); 46 char *__get_fort_03_addr(void); 47 char *__get_fort_04_addr(void); 48 char *__get_fort_0c_addr(void); 49 char *__get_fort_me_addr(void); 50 char *__get_fort_np_addr(void); 51 52 #else 53 #if defined(DESC_I8) 54 extern __INT4_T ENTCOMN(0, 0)[]; 55 #else 56 extern __INT_T ENTCOMN(0, 0)[]; 57 #endif 58 extern __STR_T ENTCOMN(0C, 0c)[]; 59 #endif 60 61 #define ABSENT (ENTCOMN(0, 0) + 2) 62 #define ABSENTC ENTCOMN(0C, 0c) 63 64 /* argument pointer tests */ 65 66 #if defined(DESC_I8) 67 #define ISPRESENT(p) \ 68 ((p) && \ 69 ((__INT4_T *)(p) < ENTCOMN(0, 0) || (__INT4_T *)(p) > (ENTCOMN(0, 0) + 3))) 70 #else 71 #define ISPRESENT(p) \ 72 ((p) && \ 73 ((__INT_T *)(p) < ENTCOMN(0, 0) || (__INT_T *)(p) > (ENTCOMN(0, 0) + 3))) 74 #endif 75 76 #define ISPRESENTC(p) ((CADR(p)) && (CADR(p) != ABSENTC)) 77 78 /* section descriptor pointer tests */ 79 80 #define ISSEQUENCE(p) (F90_TAG_G(p) < 0 && F90_TAG_G(p) != -__DESC) 81 82 #define ISSCALAR(p) (F90_TAG_G(p) > 0 && F90_TAG_G(p) != __DESC) 83 84 #define TYPEKIND(p) \ 85 ((dtype)(F90_TAG_G(p) == __DESC \ 86 ? (p)->kind \ 87 : (F90_TAG_G(p) < 0 ? -F90_TAG_G(p) : F90_TAG_G(p)))) 88 89 /* local mode flag declaration and test macro */ 90 91 #if defined(TARGET_WIN) || defined(WIN64) || defined(WIN32) 92 WIN_IMP __INT_T ENTCOMN(LOCAL_MODE, local_mode)[1]; 93 #elif defined(WINNT) || defined(C90) 94 __INT_T ENTCOMN(LOCAL_MODE, local_mode)[1]; 95 #else 96 #if defined(DESC_I8) 97 extern __INT4_T ENTCOMN(LOCAL_MODE, local_mode)[]; 98 #else 99 extern __INT_T ENTCOMN(LOCAL_MODE, local_mode)[]; 100 #endif 101 #endif 102 103 /* __gen_block implementation__ 104 * The following mask is used to check for a gen_block dimension against 105 * the isstar argument in ENTFTN(template) and ENTFTN(qopy_in) located 106 * in rdst.c 107 * 108 * We use 3 bit sets per dimension in the range of bits 7..27 of the 109 * isstar argument in ENTFTN(template) and ENTFTN(qopy_in) ... 110 * 111 * isstar == 0 => block, block(k), cyclic, or cyclic(k) 112 * isstar == 1 => gen_block 113 * isstar == 2 => indirect (not yet supported) 114 * isstar == 3 => reserved for future expansion 115 * isstar == 4 => reserved for future expansion 116 * isstar == 5 => reserved for future expansion 117 * isstar == 6 => reserved for future expansion 118 * isstar == 7 => reserved for future expansion 119 */ 120 121 #define EXTENSION_BLOCK_MASK 0xFFFFF80 122 123 /* address alignment macros */ 124 125 #define ALIGNZ 16 126 #define ALIGNR(x) (((x) + ALIGNZ - 1) & ~(ALIGNZ - 1)) 127 128 /* 129 * message macros for stats/profiling/tracing 130 * note: PROF is also referenced in entry.c 131 */ 132 133 void __fort_chn_prune(struct chdr *c); 134 135 void __fort_entry_arecv(int, long, int); 136 void __fort_entry_arecv_done(int); 137 void __fort_entry_asend(int, long, int); 138 void __fort_entry_asend_done(int); 139 void __fort_entry_await(int); 140 void __fort_entry_await_done(int); 141 void __fort_entry_copy(long); 142 void __fort_entry_copy_done(void); 143 void __fort_entry_init(void); 144 void __fort_entry_recv(int, long); 145 void __fort_entry_recv_done(int); 146 void __fort_entry_send(int, long); 147 void __fort_entry_send_done(int); 148 void __fort_entry_term(void); 149 150 void __fort_sethand(void); 151 152 int __fort_stat_init(void); 153 void __fort_stat_arecv(int cpu, long len, int reqn); 154 void __fort_stat_arecv_done(int cpu); 155 void __fort_stat_asend(int cpu, long len, int reqn); 156 void __fort_stat_asend_done(int cpu); 157 void __fort_stat_await(int reqn); 158 void __fort_stat_await_done(int reqn); 159 void __fort_stat_copy(long len); 160 void __fort_stat_copy_done(void); 161 void __fort_stat_function_entry(int line, int lines, int cline, char *func, 162 char *file, int funcl, int filel); 163 void __fort_stat_function_exit(void); 164 void __fort_stat_line_entry(int line); 165 void __fort_stat_recv(int cpu, long len); 166 void __fort_stat_recv_done(int cpu); 167 void __fort_stat_send(int cpu, long len); 168 void __fort_stat_send_done(int cpu); 169 void __fort_stat_term(void); 170 171 int __fort_prof_init(void); 172 void __fort_prof_arecv(int cpu, long len, int reqn); 173 void __fort_prof_arecv_done(int cpu); 174 void __fort_prof_asend(int cpu, long len, int reqn); 175 void __fort_prof_asend_done(int cpu); 176 void __fort_prof_await(int reqn); 177 void __fort_prof_await_done(int reqn); 178 void __fort_prof_copy(long len); 179 void __fort_prof_copy_done(void); 180 void __fort_prof_function_entry(int line, int lines, int cline, char *func, 181 char *file, int funcl, int filel); 182 void __fort_prof_function_exit(void); 183 void __fort_prof_line_entry(int line); 184 void __fort_prof_recv(int cpu, long len); 185 void __fort_prof_recv_done(int cpu); 186 void __fort_prof_send(int cpu, long len); 187 void __fort_prof_send_done(int cpu); 188 void __fort_prof_term(void); 189 190 void __fort_procargs(void); 191 192 int __fort_trac_init(void); 193 void __fort_trac_arecv(int cpu, long len, int reqn); 194 void __fort_trac_arecv_done(int cpu); 195 void __fort_trac_asend(int cpu, long len, int reqn); 196 void __fort_trac_asend_done(int cpu); 197 void __fort_trac_await(int reqn); 198 void __fort_trac_await_done(int reqn); 199 void __fort_trac_copy(long len); 200 void __fort_trac_copy_done(void); 201 void __fort_trac_function_entry(int line, int lines, int cline, DCHAR(func), 202 DCHAR(file) DCLEN64(funcl) DCLEN64(filel)); 203 void __fort_trac_function_exit(void); 204 void __fort_trac_line_entry(int line); 205 void __fort_trac_recv(int cpu, long len); 206 void __fort_trac_recv_done(int cpu); 207 void __fort_trac_send(int cpu, long len); 208 void __fort_trac_send_done(int cpu); 209 void __fort_trac_term(void); 210 211 void __fort_traceback(void); 212 213 void __fort_begpar(int ncpus); 214 void __fort_endpar(void); 215 void __fort_abortx(void); 216 void __fort_setarg(void); 217 218 void __fort_set_second(double d); 219 220 #define __DIST_ENTRY_RECV(cpu, len) 221 #define __DIST_ENTRY_RECV_DONE(cpu) 222 #define __DIST_ENTRY_SEND(cpu, len) 223 #define __DIST_ENTRY_SEND_DONE(cpu) 224 #define __DIST_ENTRY_COPY(len) 225 226 #define __DIST_ENTRY_COPY_DONE() 227 #define __DIST_ENTRY_ARECV(cpu, len, reqn) 228 #define __DIST_ENTRY_ARECV_DONE(cpu) 229 #define __DIST_ENTRY_ASEND(cpu, len, reqn) 230 #define __DIST_ENTRY_ASEND_DONE(cpu) 231 #define __DIST_ENTRY_AWAIT(reqn) 232 #define __DIST_ENTRY_AWAIT_DONE(reqn) 233 234 #ifdef WINNT 235 /* prototypes for HPF */ 236 237 /* The PG compilers cannot yet create dlls that share data. For 238 * data shared in this way, a function interface is provided for 239 * the windows environment. 240 */ 241 242 extern __LOG_T __get_fort_mask_log(void); 243 extern __LOG1_T __get_fort_mask_log1(void); 244 extern __LOG2_T __get_fort_mask_log2(void); 245 extern __LOG4_T __get_fort_mask_log4(void); 246 extern __LOG8_T __get_fort_mask_log8(void); 247 extern __INT1_T __get_fort_mask_int1(void); 248 extern __INT2_T __get_fort_mask_int2(void); 249 extern __INT4_T __get_fort_mask_int4(void); 250 extern __INT8_T __get_fort_mask_int8(void); 251 extern __LOG_T __get_fort_true_log(void); 252 extern __LOG_T *__get_fort_true_log_addr(void); 253 extern __LOG1_T __get_fort_true_log1(void); 254 extern __LOG2_T __get_fort_true_log2(void); 255 extern __LOG4_T __get_fort_true_log4(void); 256 extern __LOG8_T __get_fort_true_log8(void); 257 258 extern void __set_fort_mask_log(__LOG_T); 259 extern void __set_fort_mask_log1(__LOG1_T); 260 extern void __set_fort_mask_log2(__LOG2_T); 261 extern void __set_fort_mask_log4(__LOG4_T); 262 extern void __set_fort_mask_log8(__LOG8_T); 263 extern void __set_fort_mask_int1(__INT1_T); 264 extern void __set_fort_mask_int2(__INT2_T); 265 extern void __set_fort_mask_int4(__INT4_T); 266 extern void __set_fort_mask_int8(__INT8_T); 267 extern void __set_fort_true_log(__LOG_T); 268 extern void __set_fort_true_log1(__LOG1_T); 269 extern void __set_fort_true_log2(__LOG2_T); 270 extern void __set_fort_true_log4(__LOG4_T); 271 extern void __set_fort_true_log8(__LOG8_T); 272 273 #define GET_DIST_MASK_LOG __get_fort_mask_log() 274 #define GET_DIST_MASK_LOG1 __get_fort_mask_log1() 275 #define GET_DIST_MASK_LOG2 __get_fort_mask_log2() 276 #define GET_DIST_MASK_LOG4 __get_fort_mask_log4() 277 #define GET_DIST_MASK_LOG8 __get_fort_mask_log8() 278 #define GET_DIST_MASK_INT1 __get_fort_mask_int1() 279 #define GET_DIST_MASK_INT2 __get_fort_mask_int2() 280 #define GET_DIST_MASK_INT4 __get_fort_mask_int4() 281 #define GET_DIST_MASK_INT8 __get_fort_mask_int8() 282 #define GET_DIST_TRUE_LOG __get_fort_true_log() 283 #define GET_DIST_TRUE_LOG_ADDR __get_fort_true_log_addr() 284 #define GET_DIST_TRUE_LOG1 __get_fort_true_log1() 285 #define GET_DIST_TRUE_LOG2 __get_fort_true_log2() 286 #define GET_DIST_TRUE_LOG4 __get_fort_true_log4() 287 #define GET_DIST_TRUE_LOG8 __get_fort_true_log8() 288 289 #define SET_DIST_MASK_LOG(n) __set_fort_mask_log(n) 290 #define SET_DIST_MASK_LOG1(n) __set_fort_mask_log1(n) 291 #define SET_DIST_MASK_LOG2(n) __set_fort_mask_log2(n) 292 #define SET_DIST_MASK_LOG4(n) __set_fort_mask_log4(n) 293 #define SET_DIST_MASK_LOG8(n) __set_fort_mask_log8(n) 294 #define SET_DIST_MASK_INT1(n) __set_fort_mask_int1(n) 295 #define SET_DIST_MASK_INT2(n) __set_fort_mask_int2(n) 296 #define SET_DIST_MASK_INT4(n) __set_fort_mask_int4(n) 297 #define SET_DIST_MASK_INT8(n) __set_fort_mask_int8(n) 298 #define SET_DIST_TRUE_LOG(n) __set_fort_true_log(n) 299 #define SET_DIST_TRUE_LOG1(n) __set_fort_true_log1(n) 300 #define SET_DIST_TRUE_LOG2(n) __set_fort_true_log2(n) 301 #define SET_DIST_TRUE_LOG4(n) __set_fort_true_log4(n) 302 #define SET_DIST_TRUE_LOG8(n) __set_fort_true_log8(n) 303 304 extern void *__get_fort_maxs(int); 305 extern void *__get_fort_mins(int); 306 extern int __get_fort_shifts(int); 307 extern int __get_fort_size_of(int); 308 extern void *__get_fort_trues(int); 309 extern char *__get_fort_typenames(int); 310 extern void *__get_fort_units(int); 311 312 extern void __set_fort_maxs(int, void *); 313 extern void __set_fort_mins(int, void *); 314 extern void __set_fort_shifts(int, int); 315 extern void __set_fort_size_of(int, int); 316 extern void __set_fort_trues(int, void *); 317 extern void __set_fort_typenames(int, char *); 318 extern void __set_fort_units(int, void *); 319 320 #define GET_DIST_MAXS(idx) __get_fort_maxs(idx) 321 #define GET_DIST_MINS(idx) __get_fort_mins(idx) 322 #define GET_DIST_SHIFTS(idx) __get_fort_shifts(idx) 323 #define GET_DIST_SIZE_OF(idx) __get_fort_size_of(idx) 324 #define GET_DIST_TRUES(idx) __get_fort_trues(idx) 325 #define GET_DIST_TYPENAMES(idx) __get_fort_typenames(idx) 326 #define GET_DIST_UNITS(idx) __get_fort_units(idx) 327 328 #define SET_DIST_MAXS(idx, val) __set_fort_maxs(idx, val) 329 #define SET_DIST_MINS(idx, val) __set_fort_mins(idx, val) 330 #define SET_DIST_SHIFTS(idx, val) __set_fort_shifts(idx, val) 331 #define SET_DIST_SIZE_OF(idx, val) __set_fort_size_of(idx, val) 332 #define SET_DIST_TRUES(idx, val) __set_fort_trues(idx, val) 333 #define SET_DIST_TYPENAMES(idx, val) __set_fort_typenames(idx, val) 334 #define SET_DIST_UNITS(idx, val) __set_fort_units(idx, val) 335 336 extern long long int *__get_fort_one(void); 337 extern long long int *__get_fort_zed(void); 338 339 #define GET_DIST_ONE __get_fort_one() 340 #define GET_DIST_ZED __get_fort_zed() 341 342 extern int __get_fort_debug(void); 343 extern int __get_fort_debugn(void); 344 extern long __get_fort_heapz(void); 345 extern int __get_fort_ioproc(void); 346 extern int __get_fort_lcpu(void); 347 extern int *__get_fort_lcpu_addr(void); 348 extern int __get_fort_pario(void); 349 extern int __get_fort_quiet(void); 350 extern int __get_fort_tcpus(void); 351 extern int *__get_fort_tcpus_addr(void); 352 extern int *__get_fort_tids(void); 353 extern int __get_fort_tids_elem(int); 354 extern char *__get_fort_transnam(void); 355 356 extern void __set_fort_debug(int); 357 extern void __set_fort_debugn(int); 358 extern void __set_fort_heapz(long heapz); 359 extern void __set_fort_ioproc(int); 360 extern void __set_fort_lcpu(int); 361 extern void __set_fort_pario(int); 362 extern void __set_fort_quiet(int); 363 extern void __set_fort_tcpus(int); 364 extern void __set_fort_tids(int *); 365 extern void __set_fort_tids_elem(int, int); 366 367 #define GET_DIST_IOPROC 0 368 #define GET_DIST_TRANSNAM "rpm1" 369 #define GET_DIST_HEAPZ 0 370 #define GET_DIST_LCPU 0 371 #define GET_DIST_TCPUS 1 372 #define GET_DIST_DEBUG __get_fort_debug() 373 #define GET_DIST_DEBUGN __get_fort_debugn() 374 #define GET_DIST_LCPU_ADDR __get_fort_lcpu_addr() 375 #define GET_DIST_PARIO __get_fort_pario() 376 #define GET_DIST_QUIET __get_fort_quiet() 377 #define GET_DIST_TCPUS_ADDR __get_fort_tcpus_addr() 378 #define GET_DIST_TIDS __get_fort_tids() 379 #define GET_DIST_TIDS_ELEM(idx) __get_fort_tids_elem(idx) 380 381 #define SET_DIST_DEBUG(n) __set_fort_debug(n) 382 #define SET_DIST_DEBUGN(n) __set_fort_debugn(n) 383 #define SET_DIST_HEAPZ(n) __set_fort_heapz(n) 384 #define SET_DIST_IOPROC(n) __set_fort_ioproc(n) 385 #define SET_DIST_LCPU(n) __set_fort_lcpu(n) 386 #define SET_DIST_PARIO(n) __set_fort_pario(n) 387 #define SET_DIST_QUIET(n) __set_fort_quiet(n) 388 #define SET_DIST_TCPUS(n) __set_fort_tcpus(n) 389 #define SET_DIST_TIDS(n) __set_fort_tids(n) 390 #define SET_DIST_TIDS_ELEM(idx, val) __set_fort_tids_elem(idx, val) 391 392 #else /* linux */ 393 394 extern __LOG_T __fort_mask_log; 395 extern __LOG1_T __fort_mask_log1; 396 extern __LOG2_T __fort_mask_log2; 397 extern __LOG4_T __fort_mask_log4; 398 extern __LOG8_T __fort_mask_log8; 399 extern __INT1_T __fort_mask_int1; 400 extern __INT2_T __fort_mask_int2; 401 extern __INT4_T __fort_mask_int4; 402 extern __INT8_T __fort_mask_int8; 403 extern __LOG_T __fort_true_log; 404 extern __LOG1_T __fort_true_log1; 405 extern __LOG2_T __fort_true_log2; 406 extern __LOG4_T __fort_true_log4; 407 extern __LOG8_T __fort_true_log8; 408 409 #define GET_DIST_MASK_LOG __fort_mask_log 410 #define GET_DIST_MASK_LOG1 __fort_mask_log1 411 #define GET_DIST_MASK_LOG2 __fort_mask_log2 412 #define GET_DIST_MASK_LOG4 __fort_mask_log4 413 #define GET_DIST_MASK_LOG8 __fort_mask_log8 414 #define GET_DIST_MASK_INT1 __fort_mask_int1 415 #define GET_DIST_MASK_INT2 __fort_mask_int2 416 #define GET_DIST_MASK_INT4 __fort_mask_int4 417 #define GET_DIST_MASK_INT8 __fort_mask_int8 418 #define GET_DIST_TRUE_LOG __fort_true_log 419 #define GET_DIST_TRUE_LOG_ADDR &__fort_true_log 420 #define GET_DIST_TRUE_LOG1 __fort_true_log1 421 #define GET_DIST_TRUE_LOG2 __fort_true_log2 422 #define GET_DIST_TRUE_LOG4 __fort_true_log4 423 #define GET_DIST_TRUE_LOG8 __fort_true_log8 424 425 #define SET_DIST_MASK_LOG(n) __fort_mask_log = n 426 #define SET_DIST_MASK_LOG1(n) __fort_mask_log1 = n 427 #define SET_DIST_MASK_LOG2(n) __fort_mask_log2 = n 428 #define SET_DIST_MASK_LOG4(n) __fort_mask_log4 = n 429 #define SET_DIST_MASK_LOG8(n) __fort_mask_log8 = n 430 #define SET_DIST_MASK_INT1(n) __fort_mask_int1 = n 431 #define SET_DIST_MASK_INT2(n) __fort_mask_int2 = n 432 #define SET_DIST_MASK_INT4(n) __fort_mask_int4 = n 433 #define SET_DIST_MASK_INT8(n) __fort_mask_int8 = n 434 #define SET_DIST_TRUE_LOG(n) __fort_true_log = n 435 #define SET_DIST_TRUE_LOG1(n) __fort_true_log1 = n 436 #define SET_DIST_TRUE_LOG2(n) __fort_true_log2 = n 437 #define SET_DIST_TRUE_LOG4(n) __fort_true_log4 = n 438 #define SET_DIST_TRUE_LOG8(n) __fort_true_log8 = n 439 440 extern void *__fort_maxs[__NTYPES]; 441 extern void *__fort_mins[__NTYPES]; 442 extern int __fort_shifts[__NTYPES]; 443 extern void *__fort_trues[__NTYPES]; 444 extern char *__fort_typenames[__NTYPES]; 445 extern void *__fort_units[__NTYPES]; 446 447 #define GET_DIST_MAXS(idx) __fort_maxs[idx] 448 #define GET_DIST_MINS(idx) __fort_mins[idx] 449 #define GET_DIST_SHIFTS(idx) __fort_shifts[idx] 450 #define GET_DIST_SIZE_OF(idx) __fort_size_of[idx] 451 #define GET_DIST_TRUES(idx) __fort_trues[idx] 452 #define GET_DIST_TYPENAMES(idx) __fort_typenames[idx] 453 #define GET_DIST_UNITS(idx) __fort_units[idx] 454 455 #define SET_DIST_MAXS(idx, val) __fort_maxs[idx] = val 456 #define SET_DIST_MINS(idx, val) __fort_mins[idx] = val 457 #define SET_DIST_SHIFTS(idx, val) __fort_shifts[idx] = val 458 #define SET_DIST_SIZE_OF(idx, val) __fort_size_of[idx] = val 459 #define SET_DIST_TRUES(idx, val) __fort_trues[idx] = val 460 #define SET_DIST_TYPENAMES(idx, val) __fort_typenames[idx] = val 461 #define SET_DIST_UNITS(idx, val) __fort_units[idx] = val 462 463 extern long long int __fort_one[4]; 464 extern long long int __fort_zed[4]; 465 466 #define GET_DIST_ONE __fort_one 467 #define GET_DIST_ZED __fort_zed 468 469 #include "fort_vars.h" 470 extern char *__fort_transnam; 471 472 #define GET_DIST_HEAPZ 0 473 #define GET_DIST_IOPROC 0 474 #define GET_DIST_LCPU 0 475 #define GET_DIST_TCPUS 1 476 #define GET_DIST_TRANSNAM "rpm1" 477 #define GET_DIST_DEBUG __fort_debug 478 #define GET_DIST_DEBUGN __fort_debugn 479 #define GET_DIST_LCPU_ADDR &__fort_lcpu 480 #define GET_DIST_PARIO __fort_pario 481 #define GET_DIST_QUIET __fort_quiet 482 #define GET_DIST_TCPUS_ADDR &__fort_tcpus 483 #define GET_DIST_TIDS __fort_tids 484 #define GET_DIST_TIDS_ELEM(idx) __fort_tids[idx] 485 486 #define SET_DIST_DEBUG(n) __fort_debug = n 487 #define SET_DIST_DEBUGN(n) __fort_debugn = n 488 #define SET_DIST_HEAPZ(n) __fort_heapz = n 489 #define SET_DIST_IOPROC(n) __fort_ioproc = n 490 #define SET_DIST_LCPU(n) __fort_lcpu = n 491 #define SET_DIST_PARIO(n) __fort_pario = n 492 #define SET_DIST_QUIET(n) __fort_quiet = n 493 #define SET_DIST_TCPUS(n) __fort_tcpus = n 494 #define SET_DIST_TIDS(n) __fort_tids = n 495 #define SET_DIST_TIDS_ELEM(idx, val) __fort_tids[idx] = val 496 497 #endif /* windows, linux */ 498 499 extern int __fort_size_of[__NTYPES]; 500 501 extern int __fort_entry_mflag; 502 503 /* values for __fort_quiet */ 504 /* stats */ 505 #define Q_CPU 0x01 /* cpu */ 506 #define Q_CPUS 0x02 /* cpus */ 507 #define Q_MSG 0x04 /* message */ 508 #define Q_MSGS 0x08 /* messages */ 509 #define Q_MEM 0x10 /* memory */ 510 #define Q_MEMS 0x20 /* memories */ 511 #define Q_PROF 0x40 /* profile output (not used) */ 512 #define Q_TRAC 0x80 /* trace output (not used) */ 513 /* profiling */ 514 #define Q_PROF_AVG 0x00400000 /* output min/avg/max for profile */ 515 #define Q_PROF_NONE 0x00800000 /* disable profiling */ 516 517 /* maximum number of fortran array dimensions */ 518 519 #define MAXDIMS 7 520 521 /* generic all-dimensions bit mask */ 522 523 #define ALLDIMS (~(-1 << MAXDIMS)) 524 525 /* __fort_test debug flags */ 526 527 #define DEBUG_COPYIN_GLOBAL 0x00001 528 #define DEBUG_COPYIN_LOCAL 0x00002 529 #define DEBUG_EXCH 0x00004 530 #define DEBUG_GRAD 0x00008 531 #define DEBUG_MMUL 0x00010 532 #define DEBUG_OLAP 0x00020 533 #define DEBUG_RDST 0x00040 534 #define DEBUG_REDU 0x00080 535 #define DEBUG_SCAL 0x00100 536 #define DEBUG_SCAN 0x00200 537 #define DEBUG_SCAT 0x00400 538 #define DEBUG_LVAL 0x00800 539 #define DEBUG_HFIO 0x01000 540 #define DEBUG_ALLO 0x02000 541 #define DEBUG_TIME 0x04000 542 #define DEBUG_CSHF 0x08000 543 #define DEBUG_EOSH 0x10000 544 #define DEBUG_CHAN 0x20000 545 #define DEBUG_COPY 0x40000 546 #define DEBUG_DIST 0x80000 547 #define DEBUG_CHECK 0x100000 548 549 #define __CORMEM_M0 666 550 #define __CORMEM_M1 0x58ad5e3 551 #define __CORMEM_M2 0x61f072b 552 553 #if defined(TARGET_WIN) || defined(WIN64) || defined(WIN32) 554 WIN_IMP __INT_T *CORMEM; 555 #elif defined(WINNT) 556 extern __INT_T *CORMEM; 557 #else 558 #if defined(DESC_I8) 559 extern __INT4_T CORMEM[]; 560 #else 561 extern __INT_T CORMEM[]; 562 #endif 563 #endif /* C90 */ 564 565 #if !defined(NPLIMIT) 566 #define NPLIMIT 0 567 #endif /* NPLIMIT */ 568 569 #if defined(TARGET_WIN) || defined(WIN64) || defined(WIN32) 570 void __CORMEM_SCAN(void); 571 #else 572 #define __CORMEM_SCAN() \ 573 { \ 574 __INT_T n; \ 575 n = ((__CORMEM_M1 ^ CORMEM[2]) - CORMEM[0]) - __CORMEM_M0; \ 576 if (n != ((__CORMEM_M2 ^ CORMEM[7]) + CORMEM[1]) - __CORMEM_M0) \ 577 __fort_abort("Memory corrupted, aborting\n"); \ 578 if (NPLIMIT != 0 && (n == 0 || n > NPLIMIT)) \ 579 n = NPLIMIT; \ 580 if (n != 0 && GET_DIST_TCPUS > n) \ 581 __fort_abort("Number of processors exceeds license\n"); \ 582 } 583 #endif 584 585 /* arithmetic macros */ 586 587 #define Sign(y) ((y) < 0 ? -1 : 1) 588 #define Abs(y) ((y) < 0 ? -(y) : (y)) 589 #define Ceil(x, y) \ 590 (((x) ^ (y)) > 0 ? (Abs(x) + Abs(y) - 1) / Abs(y) : (x) / (y)) 591 #define Floor(x, y) \ 592 (((x) ^ (y)) < 0 ? -(Abs(x) + Abs(y) - 1) / Abs(y) : (x) / (y)) 593 #define Min(x, y) ((x) < (y) ? (x) : (y)) 594 #define Max(x, y) ((x) > (y) ? (x) : (y)) 595 596 /* Multiplication by a reciprocal replaces division. The low order 597 binary fraction part (mantissa) of the reciprocal is stored in the 598 descriptor as an unsigned integer. */ 599 600 #define RECIP_FRACBITS 32 601 #define RECIP(y) (1UL + ((unsigned long)0xFFFFFFFF) / ((unsigned long)(y))) 602 603 #define RECIP_DIV(q, x, y) \ 604 { \ 605 *(q) = ((y) == 1 ? (x) : (x) / (y)); \ 606 } 607 #define RECIP_MOD(r, x, y) \ 608 { \ 609 *(r) = ((y) == 1 ? 0 : (x) % (y)); \ 610 } 611 #define RECIP_DIVMOD(q, r, x, y) \ 612 { \ 613 if ((y) == 1) \ 614 *(q) = (x), *(r) = 0; \ 615 else { \ 616 register long _p_ = (x) / (y); \ 617 register long _m_ = (x)-_p_ * (y); \ 618 *(q) = _p_, *(r) = _m_; \ 619 } \ 620 } 621 622 /* descriptor flags */ 623 624 /** \def __ASSUMED_SIZE 625 * \brief This descriptor flag is used to indicate that the array is declared 626 * assumed size. 627 */ 628 #define __ASSUMED_SIZE 0x00000001 629 #define __SEQUENCE 0x00000002 630 /** \def __ASSUMED_SHAPE 631 * \brief This descriptor flag is used to indicate that the array is declared 632 * assumed shape. 633 */ 634 #define __ASSUMED_SHAPE 0x00000004 635 /** \def __SAVE 636 * \brief descriptor flag (reserved) 637 */ 638 #define __SAVE 0x00000008 639 /** \def __INHERIT 640 * \brief descriptor flag (reserved) 641 */ 642 #define __INHERIT 0x00000010 643 /** \def __NO_OVERLAPS 644 * \brief descriptor flag (reserved) 645 */ 646 #define __NO_OVERLAPS 0x00000020 647 648 typedef enum { __INOUT = 0, __IN = 1, __OUT = 2 } _io_intent; 649 650 #define __INTENT_MASK 0x3 651 #define __INTENT_SHIFT 6 652 #define __INTENT_INOUT (__INOUT << __INTENT_SHIFT) 653 #define __INTENT_IN (__IN << __INTENT_SHIFT) 654 #define __INTENT_OUT (__OUT << __INTENT_SHIFT) 655 656 typedef enum { 657 __OMITTED = 0, 658 __PRESCRIPTIVE = 1, 659 __DESCRIPTIVE = 2, 660 __TRANSCRIPTIVE = 3 661 } _io_spec; 662 663 #define __DIST_TARGET_MASK 0x3 664 #define __DIST_TARGET_SHIFT 8 665 #define __PRESCRIPTIVE_DIST_TARGET (__PRESCRIPTIVE << __DIST_TARGET_SHIFT) 666 #define __DESCRIPTIVE_DIST_TARGET (__DESCRIPTIVE << __DIST_TARGET_SHIFT) 667 #define __TRANSCRIPTIVE_DIST_TARGET (__TRANSCRIPTIVE << __DIST_TARGET_SHIFT) 668 669 #define __DIST_FORMAT_MASK 0x3 670 #define __DIST_FORMAT_SHIFT 10 671 #define __PRESCRIPTIVE_DIST_FORMAT (__PRESCRIPTIVE << __DIST_FORMAT_SHIFT) 672 #define __DESCRIPTIVE_DIST_FORMAT (__DESCRIPTIVE << __DIST_FORMAT_SHIFT) 673 #define __TRANSCRIPTIVE_DIST_FORMAT (__TRANSCRIPTIVE << __DIST_FORMAT_SHIFT) 674 675 #define __ALIGN_TARGET_MASK 0x3 676 #define __ALIGN_TARGET_SHIFT 12 677 #define __PRESCRIPTIVE_ALIGN_TARGET (__PRESCRIPTIVE << __ALIGN_TARGET_SHIFT) 678 #define __DESCRIPTIVE_ALIGN_TARGET (__DESCRIPTIVE << __ALIGN_TARGET_SHIFT) 679 680 /** \def __IDENTITY_MAP 681 * \brief descriptor flag (reserved) 682 */ 683 #define __IDENTITY_MAP 0x00004000 684 /** \def __DYNAMIC 685 * \brief descriptor flag (reserved) 686 */ 687 #define __DYNAMIC 0x00008000 688 /** \def __TEMPLATE 689 * \brief descriptor flag (reserved) 690 */ 691 #define __TEMPLATE 0x00010000 692 /** \def __LOCAL 693 * \brief descriptor flag (reserved) 694 */ 695 #define __LOCAL 0x00020000 696 /** \def __F77_LOCAL_DUMMY 697 * \brief descriptor flag (reserved) 698 */ 699 #define __F77_LOCAL_DUMMY 0x00040000 700 701 /** \def __OFF_TEMPLATE 702 * \brief descriptor flag (reserved) 703 */ 704 #define __OFF_TEMPLATE 0x00080000 705 /** \def __DIST_TARGET_AXIS 706 * \brief descriptor flag (reserved) 707 */ 708 #define __DIST_TARGET_AXIS 0x00100000 709 /** \def __ASSUMED_OVERLAPS 710 * \brief descriptor flag (reserved) 711 */ 712 #define __ASSUMED_OVERLAPS 0x00200000 713 /** \def __SECTZBASE 714 * \brief When creating a section of an array, set up each dimension and 715 * compute GSIZE (see ENTF90(SECT, sect) in dist.c). 716 */ 717 #define __SECTZBASE 0x00400000 718 /** \def __BOGUSBOUNDS 719 * \brief When creating an array section, defer set up of the bounds in the 720 * descriptor after a copy. 721 */ 722 #define __BOGUSBOUNDS 0x00800000 723 /** \def __NOT_COPIED 724 * \brief descriptor flag (reserved) 725 */ 726 #define __NOT_COPIED 0x01000000 727 /** \def __NOREINDEX 728 * \brief When creating an array section, use the existing bounds. 729 * Do not reset the lower bound to 1 and the upper bound to 730 * the extent. 731 */ 732 #define __NOREINDEX 0x02000000 733 /** \def __ASSUMED_GB_EXTENT 734 * \brief descriptor flag (reserved) 735 */ 736 #define __ASSUMED_GB_EXTENT 0x08000000 737 /** \def __DUMMY_COLLAPSE_PAXIS 738 * \brief descriptor flag (reserved) 739 */ 740 #define __DUMMY_COLLAPSE_PAXIS 0x10000000 741 742 /** \def __SEQUENTIAL_SECTION 743 * 744 * Used to determine if an array section passed as a parameter to an 745 * F77 subroutine needs to be copied or whether it can be passed as is. 746 * Set in ptr_assign and tested by the inline code. 747 */ 748 #define __SEQUENTIAL_SECTION 0x20000000 749 750 /* processors descriptor */ 751 752 typedef struct procdim procdim; 753 typedef struct proc proc; 754 755 #define PROC_HDR_INT_LEN 5 756 #define PROC_DIM_INT_LEN 5 757 758 struct procdim { 759 __INT_T shape; /* (1) extent of processor dimension */ 760 __INT_T shape_shift; /* (2) shape div shift amount */ 761 __INT_T shape_recip; /* (3) 1/shape mantissa */ 762 __INT_T coord; /* (4) this processor's coordinate */ 763 __INT_T stride; /* (5) coordinate multiplier */ 764 }; 765 766 struct proc { 767 __INT_T tag; /* (1) structure type tag == __PROC */ 768 __INT_T rank; /* (2) processor arrangement rank */ 769 __INT_T flags; /* (3) descriptor flags */ 770 __INT_T base; /* (4) base processor number */ 771 __INT_T size; /* (5) size of processor arrangement */ 772 773 /* the following array must be the last member of this struct. its 774 length is adjusted to equal rank when dynamically allocated. */ 775 776 procdim dim[MAXDIMS]; /* per dimension data */ 777 }; 778 779 /* * * * * NEW DESCRIPTOR STRUCTURE * * * * */ 780 781 /* The compiler declares these descriptors as arrays of integers which 782 may be read or written directly in the generated code. The 783 descriptor header contains pointers so it must be properly aligned 784 and the size must reflect the possible difference in length between 785 an integer and a pointer. These declarations must correspond to 786 the interface defined in frontend rte.h file */ 787 788 #define F90_DESC_HDR_INT_LEN 8 789 #define F90_DESC_HDR_PTR_LEN 2 790 #define F90_DESC_DIM_INT_LEN 6 791 #define F90_DESC_DIM_PTR_LEN 0 792 793 #define DIST_DESC_HDR_INT_LEN 16 794 #define DIST_DESC_HDR_PTR_LEN 4 795 #define DIST_DESC_DIM_INT_LEN 34 796 #define DIST_DESC_DIM_PTR_LEN 1 797 798 typedef struct F90_Desc F90_Desc; 799 typedef struct F90_DescDim F90_DescDim; 800 typedef struct DIST_Desc DIST_Desc; 801 typedef struct DIST_DescDim DIST_DescDim; 802 803 /** \brief Fortran descriptor dimension info 804 * 805 * Each F90_Desc structure below has up to \ref MAXDIMS number of F90_DescDim 806 * structures that correspond to each dimension of an array. Each F90_DescDim 807 * has 6 fields: \ref lbound, \ref extent, \ref sstride, \ref soffset, 808 * \ref lstride, and \ref ubound. 809 * 810 * The \ref lbound field is the lowerbound of the dimension. 811 * 812 * The \ref extent field is the extent of the dimension (e.g., 813 * extent = max((ubound - lbound) + 1), 0). 814 * 815 * Fields \ref sstride (i.e., section index stride on array) and \ref soffset 816 * (i.e., section offset onto array) are not needed in the Fortran runtime. 817 * They were needed in languages like HPF. For Fortran, their corresponding 818 * macros, \ref F90_DPTR_SSTRIDE_G and \ref F90_DPTR_SOFFSET_G are set to 819 * constants (see below). However, we still need to preserve the space in 820 * F90_DescDim for backward compatibility. 821 * 822 * The field \ref lstride is the "section index multiplier" for the dimension. 823 * It is used in the mapping of an array section dimension to its original 824 * array. See the __fort_finish_descriptor() runtime routine in dist.c for an 825 * example of how to compute this field. See the print_loop() runtime routine 826 * in dbug.c for an example of how to use this field. 827 * 828 * The \ref ubound field is the upperbound of the dimension. 829 */ 830 struct F90_DescDim {/* descriptor dimension info */ 831 832 __INT_T lbound; /**< (1) lower bound */ 833 __INT_T extent; /**< (2) array extent */ 834 __INT_T sstride; /**< (3) reserved */ 835 __INT_T soffset; /**< (4) reserved */ 836 __INT_T lstride; /**< (5) section index multiplier */ 837 __INT_T ubound; /**< (6) upper bound */ 838 }; 839 840 /* type descriptor forward reference. Declared in type.h */ 841 typedef struct type_desc TYPE_DESC; 842 843 /** \brief Fortran descriptor header 844 * 845 * The fields minus F90_DescDim below should remain consistent 846 * with the object_desc and proc_desc structures of type.h in terms of length 847 * and type. These fields are also mirrored in the Fortran Front-end's 848 * rte.h header file. 849 * 850 * The \ref tag field is used to identify the type of the descriptor. This is 851 * typically \ref __DESC, which identifies the descriptor as a regular array 852 * section descriptor. If the tag is a basic type, such as an \ref __INT4, 853 * \ref__REAL4, etc. then it is a 1 word pseudo descriptor. The pseudo 854 * descriptor is used as a place holder when we want to pass a scalar into a 855 * runtime routine that also requires a descriptor argument. When tag is 856 * \ref __POLY, then we have an object_desc (see its definition in type.h). 857 * When tag is \ref __PROCPTR, we have a proc_desc (see its definition in 858 * type.h). 859 * 860 * The \ref rank field equals the total number of dimensions of the associated 861 * array. If rank is 0, then this descriptor may be associated with a 862 * derived type object, a pointer to a derived type object, or an 863 * allocatable scalar. 864 * 865 * The \ref kind field holds the base type of the associated array. It is one 866 * of the basic types defined in \ref _DIST_TYPE. 867 * 868 * The \ref flags field holds various descriptor flags defined above. Most of 869 * the flags defined above, denoted as reserved, are not used for Fortran. 870 * The flags that are typically used for Fortran are \ref __ASSUMED_SIZE and 871 * \ref __ASSUMED_SHAPE. 872 * 873 * The \ref len field holds the byte length of the associated array's base type 874 * (see also kind field). 875 * 876 * The \ref lsize field holds the total number of elements in the associated 877 * array section. 878 * 879 * In distributed memory languages, such as HPF, \ref gsize represents the total 880 * number of elements that are distributed across multiple processors. In 881 * Fortran, the \ref lsize and \ref gsize fields are usually the same, however 882 * this is a case in the reshape intrinsic where \ref gsize != \ref lsize. There 883 * may just be an incidental difference during the execution of reshape. There 884 * may also be others in the Fortran runtime where \ref gsize != \ref lsize, 885 * however, they too may just be incidental differences. Therefore, use 886 * \ref lsize instead of \ref gsize when querying the total number of elements 887 * in a Fortran array. 888 * 889 * The \ref lbase field is the index offset section adjustment. It is used in 890 * the mapping of an array section to its original array. 891 * See the \ref __DIST_SET_SECTIONXX and \ref __DIST_SET_SECTIONX macros below 892 * for examples of how to compute this field. See the __fort_print_local() 893 * runtime routine in dbug.c for an example of how to use this field. 894 * 895 * The \ref gbase field historically was used in distributed memory languages 896 * like HPF. Therefore, \ref gbase is usually 0 and may always be 0 in the 897 * Fortran runtime (needs more investigation to confirm if it's always 0 in 898 * this case). 899 * 900 * When set, the \ref dist_desc field holds a pointer to the type descriptor of 901 * the associated object (see also the \ref TYPE_DESC definition in type.h). 902 * 903 * The \ref dim fields hold up to \ref number of F90_DescDim structures. It's 904 * also possible that \ref dim is empty when this descriptor is associated with 905 * a derived type, a pointer to a derived type, or an allocatable scalar. 906 * 907 * The number in paranthesis for each field below corresponds with the 908 * subscript index in the descriptor. The first 9 values are denoted. 909 * The first index is 1 because we assume Fortran style arrays when we 910 * reference these fields in the Fortran front-end. When generating assembly, 911 * the first index will be 0. After the gbase field, 912 * the subscript value depends on three conditions: Whether the target's 913 * pointers are 64-bit, whether the target's native integers are 64-bit, 914 * and whether large arrays are enabled. See the \ref DESC_HDR_LEN macro 915 * in the Fortran front-end's rte.h file for more information. The first 916 * 9 subscript values are also mirrored in the following macros in 917 * rte.h: \ref DESC_HDR_TAG, \ref DESC_HDR_RANK, \ref DESC_HDR_KIND, 918 * \ref DESC_HDR_BYTE_LEN, \ref DESC_HDR_FLAGS, \ref DESC_HDR_LSIZE, 919 * \ref DESC_HDR_GSIZE, \ref DESC_HDR_LBASE, and \ref DESC_HDR_GBASE. 920 * 921 */ 922 struct F90_Desc { 923 924 __INT_T tag; /**< (1) tag field; usually \ref __DESC 925 (see also _DIST_TYPE) */ 926 __INT_T rank; /**< (2) array section rank */ 927 __INT_T kind; /**< (3) array base type */ 928 __INT_T len; /**< (4) byte length of base type */ 929 __INT_T flags; /**< (5) descriptor flags */ 930 __INT_T lsize; /**< (6) local array section size */ 931 __INT_T gsize; /**< (7) global array section size 932 (usually same as \ref lsize) */ 933 __INT_T lbase; /**< (8) index offset section adjustment */ 934 POINT(__INT_T, gbase); /**< (9) global offset of first element of 935 section (usually 0) */ 936 POINT(TYPE_DESC, dist_desc); /**< When set, this is a pointer to the 937 object's type descriptor */ 938 F90_DescDim dim[MAXDIMS]; /**< F90 dimensions (Note: We append 939 \ref rank number of F90_DescDim 940 structures to an F90_Desc structure) */ 941 }; 942 943 struct DIST_DescDim {/* DIST dim info */ 944 945 __INT_T lab; /* (1) local array lower bound */ 946 __INT_T uab; /* (2) local array upper bound */ 947 __INT_T loffset; /* (3) local index offset */ 948 __INT_T cofstr; /* (4) cyclic offset stride */ 949 __INT_T no; /* (5) negative overlap allowance */ 950 __INT_T po; /* (6) positive overlap allowance */ 951 __INT_T olb; /* (7) global owned lower bounds */ 952 __INT_T oub; /* (8) global owned upper bounds */ 953 __INT_T clb; /* (9) template cycle lower bound */ 954 __INT_T cno; /* (10) template cycle count */ 955 __INT_T taxis; /* (11) corresponding target dim */ 956 __INT_T tstride; /* (12) section index template stride */ 957 __INT_T toffset; /* (13) section index templat offset */ 958 __INT_T tlb; /* (14) template lower bound */ 959 __INT_T tub; /* (15) template upper bound */ 960 __INT_T paxis; /* (16) correspding processor dim */ 961 __INT_T block; /* (17) template block size */ 962 __INT_T block_shift; /* (18) block div shift amount */ 963 __INT_T block_recip; /* (19) block reciprocal mantissa */ 964 __INT_T cycle; /* (20) template cycle period */ 965 __INT_T cycle_shift; /* (21) cycle div shift amount */ 966 __INT_T cycle_recip; /* (22) cycle reciprocal mantissa */ 967 __INT_T pshape; /* (23) extent of processor dim */ 968 __INT_T pshape_shift; /* (24) pshape div shift amount */ 969 __INT_T pshape_recip; /* (25) 1/pshape mantissa */ 970 __INT_T pcoord; /* (26) this processor's coordinate */ 971 __INT_T pstride; /* (27) owning processor multiplier */ 972 __INT_T astride; /* (28) array index stride onto temp */ 973 __INT_T aoffset; /* (29) array index offset onto temp */ 974 __INT_T cl; /* (30) cyclic loop lower bound */ 975 __INT_T cn; /* (31) cycle loop trip count */ 976 __INT_T cs; /* (32) cyclic loop stride */ 977 __INT_T clof; /* (33) cyclic loop local index offset*/ 978 __INT_T clos; /* (34) cyclic loop index offset str */ 979 POINT(__INT_T, gen_block); /* (35) gen_block array */ 980 }; 981 982 struct DIST_Desc { /* DIST header */ 983 __INT_T scoff; /* (1) scalar subscript offset */ 984 __INT_T heapb; /* (2) global heap block multiplier */ 985 __INT_T pbase; /* (3) owning processor base offset */ 986 __INT_T mapped; /* (4) bitmap (by section dim) */ 987 __INT_T dfmt; /* (5) dist format fields by dim */ 988 __INT_T cached; /* (6) bitmap-cyclic loop bounds flag*/ 989 __INT_T single; /* (7) bitmap 0=norm 1=single aligned*/ 990 __INT_T replicated; /* (8) bitmap 0=norm 1=repl */ 991 __INT_T nonsequence; /* (9) bitmap by section dim */ 992 __INT_T info[MAXDIMS]; /* (10) align-target dim information */ 993 POINT(proc, dist_target); /* (17) target proc arrangement */ 994 POINT(F90_Desc, align_target); /* (18) ultimate align-target */ 995 POINT(F90_Desc, next_alignee); /* (19) next alignee list */ 996 POINT(F90_Desc, actual_arg); /* (20) arg-assoc global array */ 997 DIST_DescDim dim[MAXDIMS]; /* first DIST dimension desc */ 998 }; 999 1000 /* 1001 * Macros for defining and accessing the desciptors and their fields 1002 */ 1003 1004 #define F90_DPTR_LBOUND_G(p) (p##_f90_dim->lbound) 1005 #define F90_DPTR_EXTENT_G(p) (p##_f90_dim->extent) 1006 /* no longer need section stride/section offset */ 1007 #define F90_DPTR_SSTRIDE_G(p) 1 1008 #define F90_DPTR_SOFFSET_G(p) 0 1009 #define F90_DPTR_LSTRIDE_G(p) (p##_f90_dim->lstride) 1010 #define F90_DPTR_UBOUND_G(p) (p##_f90_dim->extent + p##_f90_dim->lbound - 1) 1011 1012 #define F90_DPTR_LBOUND_P(p, v) (p##_f90_dim->lbound = v) 1013 #define F90_DPTR_EXTENT_P(p, v) (p##_f90_dim->extent = v) 1014 #define F90_DPTR_SSTRIDE_P(p, v) (p##_f90_dim->sstride = v) 1015 #define F90_DPTR_SOFFSET_P(p, v) (p##_f90_dim->soffset = v) 1016 #define F90_DPTR_LSTRIDE_P(p, v) (p##_f90_dim->lstride = v) 1017 1018 #define F90_DIM_LBOUND_G(p, i) (p->dim[i].lbound) 1019 #define F90_DIM_EXTENT_G(p, i) (p->dim[i].extent) 1020 /* no longer need section stride/section offset */ 1021 #define F90_DIM_SSTRIDE_G(p, i) 1 1022 #define F90_DIM_SOFFSET_G(p, i) 0 1023 #define F90_DIM_LSTRIDE_G(p, i) (p->dim[i].lstride) 1024 #define F90_DIM_UBOUND_G(p, i) (p->dim[i].extent + p->dim[i].lbound - 1) 1025 1026 #define F90_DIM_LBOUND_P(p, i, v) (p->dim[i].lbound = v) 1027 #define F90_DIM_EXTENT_P(p, i, v) (p->dim[i].extent = v) 1028 #define F90_DIM_SSTRIDE_P(p, i, v) (p->dim[i].sstride = v) 1029 #define F90_DIM_SOFFSET_P(p, i, v) (p->dim[i].soffset = v) 1030 #define F90_DIM_LSTRIDE_P(p, i, v) (p->dim[i].lstride = v) 1031 1032 #define DPTR_UBOUND_G(p) (p##_f90_dim->extent + p##_f90_dim->lbound - 1) 1033 #define DPTR_UBOUND_P(p, v) \ 1034 (p##_f90_dim->extent = (v)-p##_f90_dim->lbound + 1); \ 1035 (p##_f90_dim->ubound = v) 1036 1037 #define DIM_UBOUND_G(p, i) (p->dim[i].extent + p->dim[i].lbound - 1) 1038 #define DIM_UBOUND_P(p, i, v) \ 1039 (p->dim[i].extent = (v)-p->dim[i].lbound + 1; p->dim[i].ubound = v;) 1040 1041 #define F90_TAG_G(p) (*(int *)&(p->tag)) 1042 #define F90_RANK_G(p) ((p)->rank) 1043 #define F90_KIND_G(p) ((p)->kind) 1044 #define F90_LEN_G(p) ((p)->len) 1045 #define F90_FLAGS_G(p) ((p)->flags) 1046 #define F90_LSIZE_G(p) ((p)->lsize) 1047 #define F90_GSIZE_G(p) ((p)->gsize) 1048 #define F90_LBASE_G(p) ((p)->lbase) 1049 #define F90_GBASE_G(p) ((p)->gbase) 1050 #define F90_DIST_DESC_G(p) ((p)->dist_desc) 1051 1052 #define F90_TAG_P(p, v) ((p)->tag = (v)) 1053 #define F90_RANK_P(p, v) ((p)->rank = (v)) 1054 #define F90_KIND_P(p, v) ((p)->kind = (v)) 1055 /* TODO: p->len should be size_t, but it is not. This needs to be updated. This 1056 * casting will work as long as we don't have a character type longer then 32 1057 * bits. We need to cast to the type of p->len to be safe for now. If we update 1058 * the descriptor to have the len field be size_t, then we won't be backwards 1059 * compatible with existing object files. */ 1060 #define F90_LEN_P(p, v) ((p)->len = ((__INT_T)v)) 1061 #define F90_FLAGS_P(p, v) ((p)->flags = (v)) 1062 #define F90_LSIZE_P(p, v) ((p)->lsize = (v)) 1063 #define F90_GSIZE_P(p, v) ((p)->gsize = (v)) 1064 #define F90_LBASE_P(p, v) ((p)->lbase = (v)) 1065 #define F90_GBASE_P(p, v) ((p)->gbase = (v)) 1066 #define F90_DIST_DESC_P(p, v) ((p)->dist_desc = (v)) 1067 1068 1069 extern __INT_T f90DummyGenBlock; 1070 extern __INT_T *f90DummyGenBlockPtr; 1071 /* 1072 * Macros used by Fortran runtime to access the (uninstantiated) dist specific parts 1073 * of the descriptor. 1074 */ 1075 #define SET_F90_VAR_DIST_DESC_PTR(f, h) /*(f.dist_desc = NULL)*/ 1076 1077 #define SET_F90_DIST_DESC_PTR(p, r) /*(p->dist_desc = NULL)*/ 1078 1079 #define SIZE_OF_RANK_n_ARRAY_DESC(n) \ 1080 (sizeof(F90_Desc) - (MAXDIMS - n) * sizeof(F90_DescDim)) 1081 1082 #define DIST_DPTR_LAB_G(p) F90_DPTR_LBOUND_G(p) 1083 #define DIST_DPTR_UAB_G(p) F90_DPTR_UBOUND_G(p) 1084 #define DIST_DPTR_LOFFSET_G(p) (-(F90_DPTR_LSTRIDE_G(p) * DIST_DPTR_LAB_G(p))) 1085 #define DIST_DPTR_COFSTR_G(p) 0 1086 #define DIST_DPTR_NO_G(p) 0 1087 #define DIST_DPTR_PO_G(p) 0 1088 #define DIST_DPTR_OLB_G(p) F90_DPTR_LBOUND_G(p) 1089 #define DIST_DPTR_OUB_G(p) F90_DPTR_UBOUND_G(p) 1090 #define DIST_DPTR_CLB_G(p) F90_DPTR_LBOUND_G(p) 1091 #define DIST_DPTR_CNO_G(p) 1 1092 #define DIST_DPTR_TAXIS_G(p) 0 1093 #define DIST_DPTR_TSTRIDE_G(p) F90_DPTR_SSTRIDE_G(p) 1094 #define DIST_DPTR_TOFFSET_G(p) F90_DPTR_SOFFSET_G(p) 1095 #define DIST_DPTR_TLB_G(p) F90_DPTR_LBOUND_G(p) 1096 #define DIST_DPTR_TUB_G(p) F90_DPTR_UBOUND_G(p) 1097 #define DIST_DPTR_PAXIS_G(p) 0 1098 #define DIST_DPTR_BLOCK_G(p) 1 1099 #define DIST_DPTR_BLOCK_SHIFT_G(p) 0 1100 #define DIST_DPTR_BLOCK_RECIP_G(p) 0 1101 #define DIST_DPTR_CYCLE_G(p) 1 1102 #define DIST_DPTR_CYCLE_SHIFT_G(p) 0 1103 #define DIST_DPTR_CYCLE_RECIP_G(p) 0 1104 #define DIST_DPTR_PSHAPE_G(p) 1 1105 #define DIST_DPTR_PSHAPE_SHIFT_G(p) 0 1106 #define DIST_DPTR_PSHAPE_RECIP_G(p) 0 1107 #define DIST_DPTR_PCOORD_G(p) 0 1108 #define DIST_DPTR_PSTRIDE_G(p) F90_DPTR_SSTRIDE_G(p) 1109 #define DIST_DPTR_ASTRIDE_G(p) F90_DPTR_SSTRIDE_G(p) 1110 #define DIST_DPTR_AOFFSET_G(p) 0 1111 #define DIST_DPTR_CL_G(p) 0 1112 #define DIST_DPTR_CN_G(p) 1 1113 #define DIST_DPTR_CS_G(p) 0 1114 #define DIST_DPTR_CLOF_G(p) 0 1115 #define DIST_DPTR_CLOS_G(p) 0 1116 #define DIST_DPTR_GEN_BLOCK_G(p) (f90DummyGenBlockPtr) 1117 1118 #define DIST_DPTR_LAB_P(p, v) 1119 #define DIST_DPTR_UAB_P(p, v) 1120 #define DIST_DPTR_LOFFSET_P(p, v) 1121 #define DIST_DPTR_COFSTR_P(p, v) 1122 #define DIST_DPTR_NO_P(p, v) 1123 #define DIST_DPTR_PO_P(p, v) 1124 #define DIST_DPTR_OLB_P(p, v) 1125 #define DIST_DPTR_OUB_P(p, v) 1126 #define DIST_DPTR_CLB_P(p, v) 1127 #define DIST_DPTR_CNO_P(p, v) 1128 #define DIST_DPTR_TAXIS_P(p, v) 1129 #define DIST_DPTR_TSTRIDE_P(p, v) 1130 #define DIST_DPTR_TOFFSET_P(p, v) 1131 #define DIST_DPTR_TLB_P(p, v) 1132 #define DIST_DPTR_TUB_P(p, v) 1133 #define DIST_DPTR_PAXIS_P(p, v) 1134 #define DIST_DPTR_BLOCK_P(p, v) 1135 #define DIST_DPTR_BLOCK_SHIFT_P(p, v) 1136 #define DIST_DPTR_BLOCK_RECIP_P(p, v) 1137 #define DIST_DPTR_CYCLE_P(p, v) 1138 #define DIST_DPTR_CYCLE_SHIFT_P(p, v) 1139 #define DIST_DPTR_CYCLE_RECIP_P(p, v) 1140 #define DIST_DPTR_PSHAPE_P(p, v) 1141 #define DIST_DPTR_PSHAPE_SHIFT_P(p, v) 1142 #define DIST_DPTR_PSHAPE_RECIP_P(p, v) 1143 #define DIST_DPTR_PCOORD_P(p, v) 1144 #define DIST_DPTR_PSTRIDE_P(p, v) 1145 #define DIST_DPTR_ASTRIDE_P(p, v) 1146 #define DIST_DPTR_AOFFSET_P(p, v) 1147 #define DIST_DPTR_CL_P(p, v) 1148 #define DIST_DPTR_CN_P(p, v) 1149 #define DIST_DPTR_CS_P(p, v) 1150 #define DIST_DPTR_CLOF_P(p, v) 1151 #define DIST_DPTR_CLOS_P(p, v) 1152 #define DIST_DPTR_GEN_BLOCK_P(p, v) 1153 1154 #define DIST_DIM_LAB_G(p, i) F90_DIM_LBOUND_G(p, i) 1155 #define DIST_DIM_UAB_G(p, i) F90_DIM_UBOUND_G(p, i) 1156 #define DIST_DIM_LOFFSET_G(p, i) (-(F90_DIM_LSTRIDE_G(p, i))) 1157 #define DIST_DIM_COFSTR_G(p, i) 0 1158 #define DIST_DIM_NO_G(p, i) 0 1159 #define DIST_DIM_PO_G(p, i) 0 1160 #define DIST_DIM_OLB_G(p, i) F90_DIM_LBOUND_G(p, i) 1161 #define DIST_DIM_OUB_G(p, i) F90_DIM_UBOUND_G(p, i) 1162 #define DIST_DIM_CLB_G(p, i) F90_DIM_LBOUND_G(p, i) 1163 #define DIST_DIM_CNO_G(p, i) 1 1164 #define DIST_DIM_TAXIS_G(p, i) 0 1165 #define DIST_DIM_TSTRIDE_G(p, i) F90_DIM_LSTRIDE_G(p, i) 1166 #define DIST_DIM_TOFFSET_G(p, i) F90_DIM_SOFFSET_G(p, i) 1167 #define DIST_DIM_TLB_G(p, i) F90_DIM_LBOUND_G(p, i) 1168 #define DIST_DIM_TUB_G(p, i) F90_DIM_UBOUND_G(p, i) 1169 #define DIST_DIM_PAXIS_G(p, i) 0 1170 #define DIST_DIM_BLOCK_G(p, i) 0 1171 #define DIST_DIM_BLOCK_SHIFT_G(p, i) 0 1172 #define DIST_DIM_BLOCK_RECIP_G(p, i) 0 1173 #define DIST_DIM_CYCLE_G(p, i) 0 1174 #define DIST_DIM_CYCLE_SHIFT_G(p, i) 0 1175 #define DIST_DIM_CYCLE_RECIP_G(p, i) 0 1176 #define DIST_DIM_PSHAPE_G(p, i) 1 1177 #define DIST_DIM_PSHAPE_SHIFT_G(p, i) 0 1178 #define DIST_DIM_PSHAPE_recip_G(p, i) 0 1179 #define DIST_DIM_PCOORD_G(p, i) 0 1180 #define DIST_DIM_PSTRIDE_G(p, i) F90_DIM_SSTRIDE_G(p, i) 1181 #define DIST_DIM_ASTRIDE_G(p, i) F90_DIM_SSTRIDE_G(p, i) 1182 #define DIST_DIM_AOFFSET_G(p, i) 0 1183 #define DIST_DIM_CL_G(p, i) 0 1184 #define DIST_DIM_CN_G(p, i) 1 1185 #define DIST_DIM_CS_G(p, i) 0 1186 #define DIST_DIM_CLOF_G(p, i) 0 1187 #define DIST_DIM_CLOS_G(p, i) 0 1188 #define DIST_DIM_GEN_BLOCK_G(p, i) (f90DummyGenBlockPtr) 1189 1190 #define DIST_DIM_LAB_P(p, i, v) 1191 #define DIST_DIM_UAB_P(p, i, v) 1192 #define DIST_DIM_LOFFSET_P(p, i) 1193 #define DIST_DIM_COFSTR_P(p, i, v) 1194 #define DIST_DIM_NO_P(p, i, v) 1195 #define DIST_DIM_PO_P(p, i, v) 1196 #define DIST_DIM_OLB_P(p, i, v) 1197 #define DIST_DIM_OUB_P(p, i, v) 1198 #define DIST_DIM_CLB_P(p, i, v) 1199 #define DIST_DIM_CNO_P(p, i, v) 1200 #define DIST_DIM_TAXIS_P(p, i, v) 1201 #define DIST_DIM_TSTRIDE_P(p, i, v) 1202 #define DIST_DIM_TOFFSET_P(p, i, v) 1203 #define DIST_DIM_TLB_P(p, i, v) 1204 #define DIST_DIM_TUB_P(p, i, v) 1205 #define DIST_DIM_PAXIS_P(p, i, v) 1206 #define DIST_DIM_BLOCK_P(p, i, v) 1207 #define DIST_DIM_BLOCK_SHIFT_P(p, i, v) 1208 #define DIST_DIM_BLOCK_RECIP_P(p, i, v) 1209 #define DIST_DIM_CYCLE_P(p, i, v) 1210 #define DIST_DIM_CYCLE_SHIFT_P(p, i, v) 1211 #define DIST_DIM_CYCLE_RECIP_P(p, i, v) 1212 #define DIST_DIM_PSHAPE_P(p, i, v) 1213 #define DIST_DIM_PSHAPE_SHIFT_P(p, i, v) 1214 #define DIST_DIM_PSHAPE_recip_P(p, i, v) 1215 #define DIST_DIM_PCOORD_P(p, i, v) 1216 #define DIST_DIM_PSTRIDE_P(p, i, v) 1217 #define DIST_DIM_ASTRIDE_P(p, i, v) 1218 #define DIST_DIM_AOFFSET_P(p, i, v) 1219 #define DIST_DIM_CL_P(p, i, v) 1220 #define DIST_DIM_CN_P(p, i, v) 1221 #define DIST_DIM_CS_P(p, i, v) 1222 #define DIST_DIM_CLOF_P(p, i, v) 1223 #define DIST_DIM_CLOS_P(p, i, v) 1224 #define DIST_DIM_GEN_BLOCK_P(p, i, v) 1225 1226 #define DIST_SCOFF_G(p) 0 1227 #define DIST_HEAPB_G(p) 0 1228 #define DIST_PBASE_G(p) 0 1229 #define DIST_MAPPED_G(p) 0 1230 #define DIST_DFMT_G(p) 0 1231 #define DIST_CACHED_G(p) 0 1232 #define DIST_SINGLE_G(p) 0 1233 #define DIST_REPLICATED_G(p) 0 1234 #define DIST_NONSEQUENCE_G(p) 0 1235 #define DIST_DIST_TARGET_G(p) NULL 1236 #define DIST_ALIGN_TARGET_G(p) (p) 1237 #define DIST_NEXT_ALIGNEE_G(p) (p) 1238 #define DIST_ACTUAL_ARG_G(p) NULL 1239 #define DIST_INFO_G(p, i) 0 1240 1241 #define DIST_SCOFF_P(p, v) 1242 #define DIST_HEAPB_P(p, v) 1243 #define DIST_PBASE_P(p, v) 1244 #define DIST_MAPPED_P(p, v) 1245 #define DIST_DFMT_P(p, v) 1246 #define DIST_CACHED_P(p, v) 1247 #define DIST_SINGLE_P(p, v) 1248 #define DIST_REPLICATED_P(p, v) 1249 #define DIST_NONSEQUENCE_P(p, v) 1250 #define DIST_DIST_TARGET_P(p, v) 1251 #define DIST_ALIGN_TARGET_P(p, v) 1252 #define DIST_NEXT_ALIGNEE_P(p, v) 1253 #define DIST_ACTUAL_ARG_P(p, v) 1254 #define DIST_INFO_P(p, i, v) 1255 1256 #define F90_DIM_NAME(p) p##_f90_dim 1257 #define DIST_DIM_NAME(p) p##_fort_dim 1258 #define DESC_VAR_NM(p) p##_desc_var_ 1259 #define DECL_HDR_PTRS(p) F90_Desc *p 1260 #define DECL_HDR_VARS(v) \ 1261 F90_Desc DESC_VAR_NM(v); \ 1262 F90_Desc *v = &DESC_VAR_NM(v) 1263 #define DECL_F90_DIM_PTR(p) F90_DescDim *p##_f90_dim 1264 #define DECL_DIST_DIM_PTR(p) DIST_DescDim *p##_fort_dim 1265 #define DECL_DIM_PTRS(p) DECL_F90_DIM_PTR(p) 1266 1267 /* DANGER, DANGER this cause problems if "i" is pre|post incr|decr */ 1268 #define SET_DIM_PTRS(n, p, i) n##_f90_dim = &((p)->dim[i]); 1269 1270 1271 #define NONSEQ_OVERLAP (1 << MAXDIMS) 1272 #define NONSEQ_SECTION (1) 1273 1274 /* DFMT_COLLAPSED must be zero */ 1275 #define DFMT_COLLAPSED 0 1276 #define DFMT_BLOCK 1 1277 #define DFMT_BLOCK_K 2 1278 #define DFMT_CYCLIC 3 1279 #define DFMT_CYCLIC_K 4 1280 #define DFMT_GEN_BLOCK 5 1281 #define DFMT_INDIRECT 6 1282 #define DFMT__MASK 0xf 1283 #define DFMT__WIDTH 4 1284 #define DFMT(D, DIM) (DIST_DFMT_G(D) >> DFMT__WIDTH * ((DIM)-1) & DFMT__MASK) 1285 1286 /* replication descriptor */ 1287 1288 typedef struct repl_t repl_t; 1289 struct repl_t { 1290 int ncopies; /* number of identical copies */ 1291 int ndim; /* number of replicated dims */ 1292 int ngrp; /* number of replication groups */ 1293 int grpi; /* my repl. group index */ 1294 int plow; /* my repl. group lowest proc number */ 1295 int pcnt[MAXDIMS]; /* processor counts */ 1296 int pstr[MAXDIMS]; /* processor strides */ 1297 int gstr[MAXDIMS]; /* replication group index strides */ 1298 }; 1299 1300 /* communication schedule */ 1301 1302 typedef struct sked sked; 1303 struct sked { 1304 dtype tag; /* structure type tag == __SKED */ 1305 void *arg; /* unspecified pointer argument */ 1306 void (*start)(); /* function called by ENTFTN(comm_start) */ 1307 void (*free)(); /* function called by ENTFTN(comm_free) */ 1308 }; 1309 1310 1311 #if defined(DEBUG) 1312 /***** The following are internal to the HPF runtime library *****/ 1313 /***** and are not defined as compiler interfaces. *****/ 1314 void I8(__fort_print_local)(void *b, F90_Desc *d); 1315 void I8(__fort_print_vector)(char *msg, void *adr, __INT_T str, __INT_T cnt, 1316 dtype kind); 1317 void I8(__fort_show_index)(__INT_T rank, __INT_T *index); 1318 void I8(__fort_show_section)(F90_Desc *d); 1319 void I8(__fort_describe)(char *b, F90_Desc *d); 1320 void __fort_print_scalar(void *adr, dtype kind); 1321 void __fort_show_flags(__INT_T flags); 1322 void __fort_show_scalar(void *adr, dtype kind); 1323 #endif /* DEBUG */ 1324 1325 /* 1326 * routines that are inlined for F90 1327 */ 1328 1329 1330 #define __DIST_SET_ALLOCATION(d, dim, no, po) \ 1331 F90_FLAGS_P((d), F90_FLAGS_G((d)) & ~__TEMPLATE); 1332 1333 #define __DIST_SET_DISTRIBUTION(d, dim, lbound, ubound, paxis, block) \ 1334 { \ 1335 DECL_DIM_PTRS(_dd); \ 1336 SET_DIM_PTRS(_dd, (d), (dim)-1); \ 1337 F90_DPTR_LBOUND_P(_dd, lbound); \ 1338 DPTR_UBOUND_P(_dd, ubound); \ 1339 F90_DPTR_SSTRIDE_P(_dd, 1); \ 1340 F90_DPTR_SOFFSET_P(_dd, 0); \ 1341 F90_DPTR_LSTRIDE_P(_dd, 0); \ 1342 } 1343 1344 #define __DIST_INIT_SECTION(d, r, a) \ 1345 F90_TAG_P((d), __DESC); \ 1346 F90_RANK_P((d), r); \ 1347 F90_KIND_P((d), F90_KIND_G(a)); \ 1348 F90_LEN_P((d), F90_LEN_G(a)); \ 1349 F90_FLAGS_P((d), F90_FLAGS_G(a)); \ 1350 F90_GSIZE_P((d), F90_GSIZE_G(a)); \ 1351 F90_LSIZE_P((d), F90_LSIZE_G(a)); \ 1352 F90_GBASE_P((d), F90_GBASE_G(a)); \ 1353 F90_LBASE_P((d), F90_LBASE_G(a)); \ 1354 F90_DIST_DESC_P((d), F90_DIST_DESC_G(a)); /* TYPE_DESC pointer */ 1355 1356 #define __DIST_INIT_DESCRIPTOR(d, rank, kind, len, flags, target) \ 1357 F90_TAG_P((d), __DESC); \ 1358 F90_RANK_P((d), rank); \ 1359 F90_KIND_P((d), kind); \ 1360 F90_LEN_P((d), len); \ 1361 F90_FLAGS_P((d), ((flags) | __TEMPLATE | \ 1362 __SEQUENTIAL_SECTION & ~(__NOT_COPIED | __OFF_TEMPLATE))); \ 1363 F90_GSIZE_P((d), 0); \ 1364 F90_LSIZE_P((d), 0); \ 1365 F90_GBASE_P((d), 0); \ 1366 F90_DIST_DESC_P((d), 0); \ 1367 F90_LBASE_P((d), 1); 1368 1369 /** \def __DIST_SET_SECTIONXX 1370 * \brief This macro is used for creating an array section. 1371 * 1372 * Note: We no longer need section stride/section offset. 1373 * 1374 * This macro is the same as __DIST_SET_SECTIONX, 1375 * except it collects the strides into the LSTRIDE; 1376 * SSTRIDE and SOFFSET are just copied (left at one, zero) 1377 */ 1378 #define __DIST_SET_SECTIONXX(d, ddim, a, adim, l, u, s, noreindex, gsize) \ 1379 { \ 1380 DECL_DIM_PTRS(__dd); \ 1381 DECL_DIM_PTRS(__ad); \ 1382 __INT_T __extent, __myoffset; \ 1383 SET_DIM_PTRS(__ad, a, adim - 1); \ 1384 SET_DIM_PTRS(__dd, d, ddim - 1); \ 1385 __extent = u - l + s; /* section extent */ \ 1386 if (s != 1) { \ 1387 if (s == -1) \ 1388 __extent = -__extent; \ 1389 else \ 1390 __extent /= s; \ 1391 } \ 1392 if (__extent < 0) \ 1393 __extent = 0; \ 1394 if (noreindex && s == 1) { \ 1395 F90_DPTR_LBOUND_P(__dd, l); /* lower bound */ \ 1396 DPTR_UBOUND_P(__dd, __extent == 0 ? l - 1 : u); /* upper bound */ \ 1397 __myoffset = 0; \ 1398 } else { \ 1399 F90_DPTR_LBOUND_P(__dd, 1); /* lower bound */ \ 1400 DPTR_UBOUND_P(__dd, __extent); /* upper bound */ \ 1401 __myoffset = l - s; \ 1402 } \ 1403 F90_DPTR_SSTRIDE_P(__dd, 1); \ 1404 F90_DPTR_SOFFSET_P(__dd, 0); \ 1405 F90_DPTR_LSTRIDE_P(__dd, F90_DPTR_LSTRIDE_G(__ad) * s); \ 1406 F90_LBASE_P(d, F90_LBASE_G(d) + __myoffset * F90_DPTR_LSTRIDE_G(__ad)); \ 1407 if (F90_DPTR_LSTRIDE_G(__dd) != gsize) \ 1408 F90_FLAGS_P(d, (F90_FLAGS_G(d) & ~__SEQUENTIAL_SECTION)); \ 1409 gsize *= __extent; \ 1410 } 1411 /** \def __DIST_SET_SECTIONX 1412 * \brief This macro is used for creating an array section. 1413 * 1414 * This macro is the same as __DIST_SET_SECTIONXX but without the gsize 1415 * argument. 1416 */ 1417 #define __DIST_SET_SECTIONX(d, ddim, a, adim, l, u, s, noreindex) \ 1418 { \ 1419 DECL_DIM_PTRS(__dd); \ 1420 DECL_DIM_PTRS(__ad); \ 1421 __INT_T __extent, __myoffset; \ 1422 SET_DIM_PTRS(__ad, a, adim - 1); \ 1423 SET_DIM_PTRS(__dd, d, ddim - 1); \ 1424 __extent = u - l + s; /* section extent */ \ 1425 if (s != 1) { \ 1426 if (s == -1) \ 1427 __extent = -__extent; \ 1428 else \ 1429 __extent /= s; \ 1430 } \ 1431 if (__extent < 0) \ 1432 __extent = 0; \ 1433 if (noreindex && s == 1) { \ 1434 F90_DPTR_LBOUND_P(__dd, l); /* lower bound */ \ 1435 DPTR_UBOUND_P(__dd, __extent == 0 ? l - 1 : u); /* upper bound */ \ 1436 __myoffset = 0; \ 1437 } else { \ 1438 F90_DPTR_LBOUND_P(__dd, 1); /* lower bound */ \ 1439 DPTR_UBOUND_P(__dd, __extent); /* upper bound */ \ 1440 __myoffset = l - s; \ 1441 } \ 1442 F90_DPTR_SSTRIDE_P(__dd, 1); \ 1443 F90_DPTR_SOFFSET_P(__dd, 0); \ 1444 F90_DPTR_LSTRIDE_P(__dd, F90_DPTR_LSTRIDE_G(__ad) * s); \ 1445 F90_LBASE_P(d, F90_LBASE_G(d) + __myoffset * F90_DPTR_LSTRIDE_G(__ad)); \ 1446 } 1447 1448 __INT_T 1449 I8(is_nonsequential_section)(F90_Desc *d, __INT_T dim); 1450 1451 void *I8(__fort_create_conforming_mask_array)(char *what, char *ab, char *mb, 1452 F90_Desc *as, F90_Desc *ms, 1453 F90_Desc *new_ms); 1454 1455 void I8(__fort_reverse_array)(char *db, char *ab, F90_Desc *dd, F90_Desc *ad); 1456 1457 /* mleair - 12/03/1998 __gen_block implementation__ 1458 * Added functions F90_Desc() and __fort_gen_block_bounds 1459 * for modularity ... 1460 */ 1461 1462 __INT_T *I8(__fort_new_gen_block)(F90_Desc *d, int dim); 1463 1464 void I8(__fort_gen_block_bounds)(F90_Desc *d, int dim, __INT_T *the_olb, 1465 __INT_T *the_oub, __INT_T pcoord); 1466 1467 int __fort_gcd(int, int); 1468 1469 int __fort_lcm(int, int); 1470 1471 void I8(__fort_init_descriptor)(F90_Desc *d, __INT_T rank, dtype kind, 1472 __INT_T len, __INT_T flags, void *target); 1473 1474 void I8(__fort_set_distribution)(F90_Desc *d, __INT_T dim, __INT_T lbound, 1475 __INT_T ubound, __INT_T paxis, __INT_T *block); 1476 1477 /* __gen_block implementation__ 1478 * Added variable arguments to set_alignment so we can pass in gbCopy array 1479 * from ENTFTN(template) 1480 */ 1481 1482 void I8(__fort_set_alignment)(F90_Desc *d, __INT_T dim, __INT_T lbound, 1483 __INT_T ubound, __INT_T taxis, __INT_T tstride, 1484 __INT_T toffset, ...); 1485 1486 void I8(__fort_set_allocation)(F90_Desc *d, __INT_T dim, __INT_T no, __INT_T po); 1487 1488 void I8(__fort_use_allocation)(F90_Desc *d, __INT_T dim, __INT_T no, __INT_T po, 1489 F90_Desc *a); 1490 1491 typedef enum { __SINGLE, __SCALAR } _set_single_enum; 1492 1493 void I8(__fort_set_single)(F90_Desc *d, F90_Desc *a, __INT_T dim, __INT_T i, 1494 _set_single_enum what); 1495 1496 void I8(__fort_finish_descriptor)(F90_Desc *d); 1497 1498 void I8(__fort_init_section)(F90_Desc *d, __INT_T rank, F90_Desc *a); 1499 1500 void I8(__fort_set_section)(F90_Desc *d, __INT_T ddim, F90_Desc *a, __INT_T adim, 1501 __INT_T l, __INT_T u, __INT_T s); 1502 1503 void I8(__fort_finish_section)(F90_Desc *d); 1504 1505 int compute_lstride(F90_Desc *d, int dim); 1506 1507 void I8(__fort_copy_descriptor)(F90_Desc *d, F90_Desc *d0); 1508 1509 F90_Desc *I8(__fort_inherit_template)(F90_Desc *d, __INT_T rank, 1510 F90_Desc *target); 1511 1512 proc *__fort_defaultproc(int rank); 1513 1514 proc *__fort_localproc(void); 1515 1516 int __fort_myprocnum(void); 1517 1518 int __fort_is_ioproc(void); 1519 1520 int I8(__fort_owner)(F90_Desc *d, __INT_T *gidx); 1521 1522 void I8(__fort_localize)(F90_Desc *d, __INT_T *idxv, int *cpu, __INT_T *off); 1523 1524 void I8(__fort_describe_replication)(F90_Desc *d, repl_t *r); 1525 1526 int I8(__fort_next_owner)(F90_Desc *d, repl_t *r, int *pc, int owner); 1527 1528 int I8(__fort_islocal)(F90_Desc *d, __INT_T *gidx); 1529 1530 __INT_T 1531 I8(__fort_local_offset)(F90_Desc *d, __INT_T *gidx); 1532 1533 void *I8(__fort_local_address)(void *base, F90_Desc *d, __INT_T *gidx); 1534 1535 void I8(__fort_cycle_bounds)(F90_Desc *d); 1536 1537 __INT_T 1538 I8(__fort_block_bounds)(F90_Desc *d, __INT_T dim, __INT_T ci, 1539 __INT_T *bl, __INT_T *bu); 1540 1541 __INT_T 1542 I8(__fort_cyclic_loop)(F90_Desc *d, __INT_T dim, __INT_T l, __INT_T u, 1543 __INT_T s, __INT_T *cl, __INT_T *cu, __INT_T *cs, 1544 __INT_T *clof, __INT_T *clos); 1545 1546 int I8(__fort_block_loop)(F90_Desc *d, int dim, __INT_T l, __INT_T u, int s, 1547 __INT_T ci, __INT_T *bl, __INT_T *bu); 1548 1549 int I8(__fort_stored_alike)(F90_Desc *dd, F90_Desc *sd); 1550 1551 int I8(__fort_conform)(F90_Desc *s, __INT_T *smap, F90_Desc *t, __INT_T *tmap); 1552 1553 int I8(__fort_covers_procs)(F90_Desc *s, F90_Desc *t); 1554 1555 int I8(__fort_aligned)(F90_Desc *t, __INT_T *tmap, F90_Desc *u, __INT_T *umap); 1556 1557 int I8(__fort_aligned_axes)(F90_Desc *t, int tx, F90_Desc *u, int ux); 1558 1559 void __fort_abort(char *msg); 1560 1561 void __fort_abortp(char *s); 1562 1563 void __fort_bcopy(char *to, char *fr, size_t n); 1564 1565 void __fort_bcopysl(char *to, char *fr, size_t cnt, size_t tostr, size_t frstr, 1566 size_t size); 1567 1568 void I8(__fort_fills)(char *ab, F90_Desc *ad, void *fill); 1569 1570 chdr *I8(__fort_copy)(void *db, void *sb, F90_Desc *dd, F90_Desc *sd, int *smap); 1571 1572 void I8(__fort_copy_out)(void *db, void *sb, F90_Desc *dd, F90_Desc *sd, 1573 __INT_T flags); 1574 1575 int __fort_exchange_counts(int *counts); 1576 1577 void I8(__fort_get_scalar)(void *temp, void *b, F90_Desc *d, __INT_T *gidx); 1578 1579 void I8(__fort_reduce_section)(void *vec1, dtype typ1, int siz1, void *vec2, 1580 dtype typ2, int siz2, int cnt, void (*fn_g)(), 1581 int dim, F90_Desc *d); 1582 1583 void I8(__fort_replicate_result)(void *vec1, dtype typ1, int siz1, void *vec2, 1584 dtype typ2, int siz2, int cnt, F90_Desc *d); 1585 1586 sked *I8(__fort_comm_sked)(chdr *ch, char *rb, char *sb, dtype kind, int len); 1587 1588 int I8(__fort_ptr_aligned)(char *p1, dtype kind, int len, char *p2); 1589 1590 char *I8(__fort_ptr_offset)(char **pointer, __POINT_T *offset, char *base, 1591 dtype kind, __CLEN_T len, char *area); 1592 1593 char *I8(__fort_alloc)(__INT_T nelem, dtype kind, size_t len, __STAT_T *stat, 1594 char **pointer, __POINT_T *offset, char *base, int check, 1595 void *(*mallocfn)(size_t)); 1596 1597 char *I8(__fort_allocate)(int nelem, dtype kind, size_t len, char *base, 1598 char **pointer, __POINT_T *offset); 1599 1600 int I8(__fort_allocated)(char *area); 1601 1602 char *I8(__fort_local_allocate)(int nelem, dtype kind, size_t len, char *base, 1603 char **pointer, __POINT_T *offset); 1604 1605 char *I8(__fort_dealloc)(char *area, __STAT_T *stat, void (*freefn)(void *)); 1606 1607 void I8(__fort_deallocate)(char *area); 1608 1609 void I8(__fort_local_deallocate)(char *area); 1610 1611 void *__fort_malloc_without_abort(size_t n); 1612 void *__fort_calloc_without_abort(size_t n); 1613 1614 void *__fort_malloc(size_t n); 1615 1616 void *__fort_realloc(void *ptr, size_t n); 1617 1618 void *__fort_calloc(size_t n, size_t s); 1619 1620 void __fort_free(void *ptr); 1621 1622 void *__fort_gmalloc_without_abort(size_t n); 1623 void *__fort_gcalloc_without_abort(size_t n); 1624 1625 void *__fort_gmalloc(size_t n); 1626 1627 void *__fort_grealloc(void *ptr, size_t n); 1628 1629 void *__fort_gcalloc(size_t n, size_t s); 1630 1631 void __fort_gfree(void *ptr); 1632 1633 void *__fort_gsbrk(int n); 1634 1635 /* group */ 1636 1637 struct cgrp { 1638 int ncpus; /* number of cpus */ 1639 int cpus[1]; /* actually ncpus entries */ 1640 }; 1641 1642 chdr *__fort_chn_1to1(chdr *fir, int dnd, int dlow, int *dcnt, int *dstr, 1643 int snd, int slow, int *scnt, int *sstr); 1644 1645 chdr *__fort_chn_1toN(chdr *fir, int dnd, int dlow, int *dcnt, int *dstr, 1646 int snd, int slow, int *scnt, int *sstr); 1647 1648 void __fort_sendl(chdr *c, int indx, void *adr, long cnt, long str, int typ, 1649 long ilen); 1650 1651 void __fort_recvl(chdr *c, int indx, void *adr, long cnt, long str, int typ, 1652 long ilen); 1653 1654 chdr *__fort_chain_em_up(chdr *list, chdr *c); 1655 1656 void __fort_setbase(chdr *c, char *bases, char *baser, int typ, long ilen); 1657 1658 void __fort_adjbase(chdr *c, char *bases, char *baser, int typ, long ilen); 1659 1660 void __fort_doit(chdr *c); 1661 1662 void __fort_frechn(chdr *c); 1663 1664 void __fort_rsendl(int cpu, void *adr, long cnt, long str, int typ, long ilen); 1665 1666 void __fort_rrecvl(int cpu, void *adr, long cnt, long str, int typ, long ilen); 1667 1668 void __fort_rsend(int cpu, void *adr, long cnt, long str, int typ); 1669 1670 void __fort_rrecv(int cpu, void *adr, long cnt, long str, int typ); 1671 1672 void __fort_rbcstl(int src, void *adr, long cnt, long str, int typ, long ilen); 1673 1674 void __fort_rbcst(int src, void *adr, long cnt, long str, int typ); 1675 1676 void __fort_bcstchn(struct chdr *c,int scpu, int ncpus, int *cpus); 1677 1678 void __fort_exit(int s); 1679 1680 /* tracing functions -- entry.c */ 1681 1682 void __fort_tracecall(char *msg); 1683 1684 /* utility functions -- util.c */ 1685 1686 int I8(__fort_varying_int)(void *b, __INT_T *size); 1687 1688 int I8(__fort_varying_log)(void *b, __INT_T *size); 1689 1690 int I8(__fort_fetch_int)(void *b, F90_Desc *d); 1691 1692 void I8(__fort_store_int)(void *b, F90_Desc *d, int val); 1693 1694 int I8(__fort_fetch_log)(void *b, F90_Desc *d); 1695 1696 void I8(__fort_store_log)(void *b, F90_Desc *d, int val); 1697 1698 int I8(__fort_fetch_int_element)(void *b, F90_Desc *d, int i); 1699 1700 void I8(__fort_store_int_element)(void *b, F90_Desc *d, int i, int val); 1701 1702 void I8(__fort_fetch_int_vector)(void *b, F90_Desc *d, int *vec, int veclen); 1703 1704 void I8(__fort_store_int_vector)(void *b, F90_Desc *d, int *vec, int veclen); 1705 1706 void __fort_ftnstrcpy(char *dst, /* destination string, blank-filled */ 1707 int len, /* length of destination space */ 1708 char *src); /* null terminated source string */ 1709 1710 int __fort_atol(char *p); 1711 1712 long __fort_strtol(char *str, char **ptr, int base); 1713 1714 void __fort_initndx( int nd, int *cnts, int *ncnts, int *strs, int *nstrs, 1715 int *mults); 1716 1717 int __fort_findndx( int cpu, int nd, int low, int *nstrs, int *mults); 1718 1719 void __fort_barrier(void); 1720 1721 void __fort_par_unlink(char *fn); 1722 1723 void __fort_zopen(char *path); 1724 1725 void __fort_erecv(int cpu, struct ents *e); 1726 void __fort_esend(int cpu, struct ents *e); 1727 void __fort_rstchn(struct chdr *c); 1728 1729 void ENTFTN(INSTANCE, instance)(F90_Desc *dd, F90_Desc *td, __INT_T *p_kind, __INT_T *p_len, __INT_T *p_collapse, ...); 1730 void ENTFTN(TEMPLATE, template)(F90_Desc *dd, __INT_T *p_rank, __INT_T *p_flags, ...); 1731 void ENTFTN(SECT, sect)(F90_Desc *d, F90_Desc *a, ...); 1732 __LOG_T ENTFTN(ASSOCIATED, associated) (char *pb, F90_Desc *pd, char *tb, F90_Desc *td); 1733 1734 /* FIXME should ENTF90 prototypes live here? */ 1735 void ENTF90(TEMPLATE, template)(F90_Desc *dd, __INT_T *p_rank, __INT_T *p_flags, __INT_T *p_kind, __INT_T *p_len, ...); 1736 void ENTF90(TEMPLATE1, template1)(F90_Desc *dd, __INT_T *p_flags, __INT_T *p_kind, __INT_T *p_len, __INT_T *p_l1, __INT_T *p_u1); 1737 void ENTF90(TEMPLATE2, template2)(F90_Desc *dd, __INT_T *p_flags, __INT_T *p_kind, __INT_T *p_len, __INT_T *p_l1, __INT_T *p_u1, __INT_T *p_l2, __INT_T *p_u2); 1738 void ENTF90(TEMPLATE3, template3)(F90_Desc *dd, __INT_T *p_flags, __INT_T *p_kind, __INT_T *p_len, __INT_T *p_l1, __INT_T *p_u1, __INT_T *p_l2, __INT_T *p_u2, __INT_T *p_l3, __INT_T *p_u3); 1739 1740 #endif /*_PGHPF_H_*/ 1741