// // COPY_VALUE_Debug: C // // The implementation of COPY_VALUE_CORE is designed to be fairly optimal // (since it is being called in lieu of what would have been a memcpy() or // plain assignment). It is left in its raw form as an inline function to // to help convey that it is nearly as efficient as an assignment. // // This adds some verbose checking in the debug build to help debug cases // where the relative information bits are incorrect. // void COPY_VALUE_Debug( REBVAL *dest, const RELVAL *src, REBCTX *specifier ) { assert(!IS_END(src)); assert(!IS_TRASH_DEBUG(src)); #ifdef __cplusplus Assert_Cell_Writable(dest, __FILE__, __LINE__); #endif if (IS_RELATIVE(src)) { assert(ANY_WORD(src) || ANY_ARRAY(src)); if (specifier == SPECIFIED) { Debug_Fmt("Internal Error: Relative item used with SPECIFIED"); PROBE_MSG(src, "word or array"); PROBE_MSG(FUNC_VALUE(VAL_RELATIVE(src)), "func"); assert(FALSE); } else if ( VAL_RELATIVE(src) != VAL_FUNC(CTX_FRAME_FUNC_VALUE(specifier)) ) { Debug_Fmt("Internal Error: Function mismatch in specific binding"); PROBE_MSG(src, "word or array"); PROBE_MSG(FUNC_VALUE(VAL_RELATIVE(src)), "expected func"); PROBE_MSG(CTX_FRAME_FUNC_VALUE(specifier), "actual func"); assert(FALSE); } } COPY_VALUE_CORE(dest, src, specifier); }
static int test_item3(void) { int rc = TC_PASS; static TYPE_VALUE shmem_value = 0; TYPE_VALUE* shmem_addr = &shmem_value; TYPE_VALUE my_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; int peer_proc = 0; int i = 0; num_proc = _num_pes(); my_proc = _my_pe(); { TYPE_VALUE value = 0; /* Store my value */ my_value = (TYPE_VALUE)my_proc; *shmem_addr = DEFAULT_VALUE; /* Define peer */ peer_proc = (my_proc + 1) % num_proc; /* Define expected value */ expect_value = ( my_proc == 0 ? (num_proc - 1) : (my_proc - 1) ) + (__cycle_count - 1); shmem_barrier_all(); for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { value = num_proc + __cycle_count; value = FUNC_VALUE(shmem_addr, value, (my_value + i), peer_proc); if ( ((i > 0 ) && (value != (my_value + i - 1))) || ((i == 0) && (value != DEFAULT_VALUE)) ) { break; } value = ( i == 0 ? DEFAULT_VALUE : (my_value + i - 1)); value = FUNC_VALUE(shmem_addr, value, (my_value + i), peer_proc); if ( ((i > 0 ) && (value != (my_value + i - 1))) || ((i == 0) && (value != DEFAULT_VALUE)) ) { break; } } shmem_barrier_all(); value = *shmem_addr; rc = (expect_value == value ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d:%lld) expected = %lld vs got = %lld\n", my_proc, (INT64_TYPE)my_value, (INT64_TYPE)expect_value, (INT64_TYPE)value); } return rc; }
// // MAKE_Function: C // // For REB_FUNCTION and "make spec", there is a function spec block and then // a block of Rebol code implementing that function. In that case we expect // that `def` should be: // // [[spec] [body]] // // With REB_COMMAND, the code is implemented via a C DLL, under a system of // APIs that pre-date Rebol's open sourcing and hence Ren/C: // // [[spec] extension command-num] // // See notes in Make_Command() regarding that mechanism and meaning. // void MAKE_Function(REBVAL *out, enum Reb_Kind kind, const REBVAL *arg) { assert(kind == REB_FUNCTION); if ( !IS_BLOCK(arg) || VAL_LEN_AT(arg) != 2 || !IS_BLOCK(VAL_ARRAY_AT(arg)) || !IS_BLOCK(VAL_ARRAY_AT(arg) + 1) ){ fail (Error_Bad_Make(kind, arg)); } REBVAL spec; COPY_VALUE(&spec, VAL_ARRAY_AT(arg), VAL_SPECIFIER(arg)); REBVAL body; COPY_VALUE(&body, VAL_ARRAY_AT(arg) + 1, VAL_SPECIFIER(arg)); // Spec-constructed functions do *not* have definitional returns // added automatically. They are part of the generators. So the // behavior comes--as with any other generator--from the projected // code (though round-tripping it via text is not possible in // general in any case due to loss of bindings.) // REBFUN *fun = Make_Interpreted_Function_May_Fail( &spec, &body, MKF_ANY_VALUE ); *out = *FUNC_VALUE(fun); }
static int test_item2(void) { int rc = TC_PASS; TYPE_VALUE* shmem_addr = NULL; TYPE_VALUE my_value = 0; TYPE_VALUE peer_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; int peer_proc = 0; num_proc = _num_pes(); my_proc = _my_pe(); shmem_addr = shmalloc(sizeof(*shmem_addr)); if (shmem_addr) { TYPE_VALUE value = -1; /* Set my value */ my_value = (-1); *shmem_addr = my_value; /* Define peer and it value */ peer_proc = (my_proc + 1) % num_proc; peer_value = (TYPE_VALUE)my_proc; /* Define expected value */ expect_value = (TYPE_VALUE)(my_proc ? (my_proc - 1) : (num_proc - 1)); /* This guarantees that PE set initial value before peer change one */ shmem_barrier_all(); /* Write value to peer */ FUNC_VALUE(shmem_addr, peer_value, peer_proc); /* Get value put by peer: * These routines start the remote transfer and may return before the data * is delivered to the remote PE */ wait_for_put_completion(peer_proc,10 /* wait for 10 secs */); value = *shmem_addr; rc = (sys_fcompare(expect_value, value) ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d:%Lf) peer(#%d:%Lf) expected = %Lf vs got = %Lf\n", my_proc, (long double)my_value, peer_proc, (long double)peer_value, (long double)expect_value, (long double)value); } else { rc = TC_SETUP_FAIL; } if (shmem_addr) { shfree(shmem_addr); } return rc; }
/* OP to root, allocated */ static int test_item1(void) { int rc = TC_PASS; TYPE_VALUE* shmem_addr = NULL; TYPE_VALUE my_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; int root_proc = 0; int i; int j; num_proc = _num_pes(); my_proc = _my_pe(); shmem_addr = shmalloc(sizeof(*shmem_addr)); if (shmem_addr) { TYPE_VALUE value = 0; /* Store my value */ my_value = (TYPE_VALUE)PROC_VALUE(my_proc); *shmem_addr = 0; /* Define expected value */ if (my_proc == root_proc) { /* if root proc */ for (j = 0; j < num_proc; j++) { for (i = 0; i < __cycle_count; i++) { expect_value ^= PROC_VALUE(i + j); } } } shmem_barrier_all(); for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { FUNC_VALUE(shmem_addr, PROC_VALUE(i + my_proc), root_proc); } shmem_barrier_all(); value = *shmem_addr; rc = (expect_value == value ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d:%lld) expected = %lld vs got = %lld\n", my_proc, (INT64_TYPE)my_value, (INT64_TYPE)expect_value, (INT64_TYPE)value); } else { rc = TC_SETUP_FAIL; } if (shmem_addr) { shfree(shmem_addr); } return rc; }
static int test_item2(void) { int rc = TC_PASS; TYPE_VALUE* shmem_addr = NULL; TYPE_VALUE my_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; int peer_proc = 0; int i = 0; num_proc = _num_pes(); my_proc = _my_pe(); shmem_addr = shmalloc(sizeof(*shmem_addr)); if (shmem_addr) { TYPE_VALUE value = 0; /* Store my value */ my_value = (TYPE_VALUE)my_proc; *shmem_addr = 0; /* Define peer */ peer_proc = (my_proc + 1) % num_proc; /* Define expected value */ expect_value = ( my_proc == 0 ? (num_proc - 1) * __cycle_count : (my_proc - 1) * __cycle_count); shmem_barrier_all(); for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { value = FUNC_VALUE(shmem_addr, my_value, peer_proc); if (value != (my_value * i)) { break; } } shmem_barrier_all(); value = *shmem_addr; rc = (expect_value == value ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d:%lld) expected = %lld vs got = %lld\n", my_proc, (INT64_TYPE)my_value, (INT64_TYPE)expect_value, (INT64_TYPE)value); } else { rc = TC_SETUP_FAIL; } if (shmem_addr) { shfree(shmem_addr); } return rc; }
/**************************************************************************** * Place for Test Item functions ***************************************************************************/ static int test_item1(void) { int rc = TC_PASS; TYPE_VALUE* shmem_addr = NULL; TYPE_VALUE my_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; int peer_proc = 0; int i = 0; num_proc = _num_pes(); my_proc = _my_pe(); shmem_addr = shmalloc(sizeof(*shmem_addr)); if (shmem_addr) { TYPE_VALUE value = 0; /* Store my value */ my_value = (TYPE_VALUE)my_proc; *shmem_addr = DEFAULT_VALUE; /* Define peer */ peer_proc = (my_proc + 1) % num_proc; /* Define expected value */ expect_value = (TYPE_VALUE)(( my_proc == 0 ? (num_proc - 1) : (my_proc - 1) ) + (__cycle_count - 1)); shmem_barrier_all(); for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { value = FUNC_VALUE(shmem_addr, (my_value + i), peer_proc); if ( ((i >0 ) && (!sys_fcompare(value, my_value + i - 1))) || ((i == 0) && (!sys_fcompare(value, DEFAULT_VALUE))) ) { break; } } shmem_barrier_all(); value = *shmem_addr; rc = (sys_fcompare(expect_value, value) ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d:%Lf) expected = %Lf vs got = %Lf\n", my_proc, (long double)my_value, (long double)expect_value, (long double)value); } else { rc = TC_SETUP_FAIL; } if (shmem_addr) { shfree(shmem_addr); } return rc; }
/**************************************************************************** * Place for Test Item functions ***************************************************************************/ static int test_item1(void) { int rc = TC_PASS; TYPE_VALUE* shmem_addr = NULL; TYPE_VALUE my_value = 0; TYPE_VALUE peer_value = 0; TYPE_VALUE expect_value = 0; int my_proc = 0; int peer_proc = 0; my_proc = _my_pe(); shmem_addr = shmalloc(sizeof(*shmem_addr)); if (shmem_addr) { TYPE_VALUE value = -1; /* Set my value */ my_value = (-1); *shmem_addr = my_value; /* Define peer and it value */ peer_proc = my_proc; peer_value = (TYPE_VALUE)(((double)rand() / (double)RAND_MAX) * MAX_VALUE); /* Define expected value */ expect_value = peer_value; /* This guarantees that PE set initial value before peer change one */ shmem_barrier_all(); /* Write value to peer */ FUNC_VALUE(shmem_addr, peer_value, peer_proc); /* Get value put by peer: * These routines start the remote transfer and may return before the data * is delivered to the remote PE */ wait_for_put_completion(peer_proc,10 /* wait for 10 secs */); value = *shmem_addr; rc = (expect_value == value ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d:%lld) peer(#%d:%lld) expected = %lld vs got = %lld\n", my_proc, (INT64_TYPE)my_value, peer_proc, (INT64_TYPE)peer_value, (INT64_TYPE)expect_value, (INT64_TYPE)value); } else { rc = TC_SETUP_FAIL; } if (shmem_addr) { shfree(shmem_addr); } return rc; }
// // Val_Init_Context: C // // Common routine for initializing OBJECT, MODULE!, PORT!, and ERROR! // // A fully constructed context can reconstitute the ANY-CONTEXT! REBVAL that // is its canon form from a single pointer...the REBVAL sitting in the 0 slot // of the context's varlist. // void Val_Init_Context(REBVAL *out, enum Reb_Kind kind, REBCTX *context) { // // In a debug build we check to make sure the type of the embedded value // matches the type of what is intended (so someone who thinks they are // initializing a REB_OBJECT from a CONTEXT does not accidentally get a // REB_ERROR, for instance.) It's a point for several other integrity // checks as well. // #if !defined(NDEBUG) REBVAL *value = CTX_VALUE(context); assert(ANY_CONTEXT(value)); assert(CTX_TYPE(context) == kind); assert(VAL_CONTEXT(value) == context); if (!CTX_KEYLIST(context)) { Debug_Fmt("Context found with no keylist set"); Panic_Context(context); } assert(GET_ARR_FLAG(CTX_VARLIST(context), ARRAY_FLAG_CONTEXT_VARLIST)); // !!! Historically spec is a frame of an object for a "module spec", // may want to use another word of that and make a block "spec" // if (IS_FRAME(CTX_VALUE(context))) { assert(IS_FUNCTION(FUNC_VALUE(CTX_FRAME_FUNC(context)))); } else assert( NOT(CTX_SPEC(context)) || ANY_CONTEXT(CTX_VALUE(CTX_SPEC(context))) ); #endif // Some contexts (stack frames in particular) start out unmanaged, and // then check to see if an operation like Val_Init_Context set them to // managed. If not, they will free the context. This avoids the need // for the garbage collector to have to deal with the series if there's // no reason too. // // Here is a case of where we mark the context as having an extant usage, // so that at minimum this value must become unreachable from the root GC // set before they are GC'd. For another case, see INIT_WORD_CONTEXT(), // where an ANY-WORD! can mark a context as in use. // ENSURE_ARRAY_MANAGED(CTX_VARLIST(context)); // Keylists are different, because they may-or-may-not-be-reused by some // operations. There needs to be a uniform policy on their management, // or certain routines would return "sometimes managed, sometimes not" // keylist series...a bad invariant. // ASSERT_ARRAY_MANAGED(CTX_KEYLIST(context)); *out = *CTX_VALUE(context); }
static int test_item2(void) { int rc = TC_PASS; TYPE_VALUE* shmem_addr = NULL; TYPE_VALUE my_value = {0, 0}; TYPE_VALUE peer_value = {0, 0}; TYPE_VALUE expect_value = {0, 0}; int num_proc = 0; int my_proc = 0; int peer_proc = 0; num_proc = _num_pes(); my_proc = _my_pe(); shmem_addr = shmalloc(sizeof(*shmem_addr)); if (shmem_addr) { TYPE_VALUE value = {-1, 0}; /* Set my value */ my_value.field1 = my_proc; memcpy(shmem_addr, &my_value, sizeof(my_value)); /* Define peer and it value */ peer_proc = (my_proc + 1) % num_proc; peer_value.field1 = peer_proc; /* Define expected value */ memcpy(&expect_value, &peer_value, sizeof(peer_value)); /* Wait is set instead of barrier to give some time to all PE for setting their values */ shmem_barrier_all(); /* Get value from peer */ FUNC_VALUE(&value, shmem_addr, 1, peer_proc); rc = (compare_buffer((unsigned char*)&expect_value, (unsigned char*)&value, sizeof(value), NULL) ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d:%lld.%lld) peer(#%d:%lld.%lld) expected = %lld.%lld actual = %lld.%lld\n", my_proc, (INT64_TYPE)my_value.field1, (INT64_TYPE)my_value.field2, peer_proc, (INT64_TYPE)peer_value.field1, (INT64_TYPE)peer_value.field2, (INT64_TYPE)expect_value.field1, (INT64_TYPE)expect_value.field2, (INT64_TYPE)value.field1, (INT64_TYPE)value.field2); } else { rc = TC_SETUP_FAIL; } if (shmem_addr) { shfree(shmem_addr); } return rc; }
/**************************************************************************** * Place for Test Item functions ***************************************************************************/ static int test_item1(void) { int rc = TC_PASS; TYPE_VALUE* shmem_addr = NULL; TYPE_VALUE my_value = 0; TYPE_VALUE expect_value = 0; int my_proc = 0; int i = 0; my_proc = _my_pe(); shmem_addr = shmalloc(sizeof(*shmem_addr)); if (shmem_addr) { TYPE_VALUE value = 0; /* Store my value */ my_value = (TYPE_VALUE)my_proc; *shmem_addr = DEFAULT_VALUE; /* Define expected value */ expect_value = my_proc + (__cycle_count - 1); shmem_barrier_all(); for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { value = ( i == 0 ? DEFAULT_VALUE : (my_value + i - 1)); value = FUNC_VALUE(shmem_addr, value, (my_value + i), my_proc); if ( ((i > 0 ) && (value != (my_value + i - 1))) || ((i == 0) && (value != DEFAULT_VALUE)) || ((my_value + i) != *shmem_addr) ) { break; } } shmem_barrier_all(); value = *shmem_addr; rc = (expect_value == value ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d:%lld) expected = %lld vs got = %lld\n", my_proc, (INT64_TYPE)my_value, (INT64_TYPE)expect_value, (INT64_TYPE)value); } else { rc = TC_SETUP_FAIL; } if (shmem_addr) { shfree(shmem_addr); } return rc; }
/* OP to neighbour, allocated */ static int test_item2(void) { int rc = TC_PASS; TYPE_VALUE* shmem_addr = NULL; TYPE_VALUE my_value = DEFAULT_VALUE; TYPE_VALUE expect_value = DEFAULT_VALUE; int num_proc = 0; int my_proc = 0; int peer_proc = 0; int i = 0; num_proc = _num_pes(); my_proc = _my_pe(); peer_proc = (my_proc + 1) % num_proc; shmem_addr = shmalloc(sizeof(*shmem_addr)); if (shmem_addr) { TYPE_VALUE value = 0; /* Store my value */ *shmem_addr = DEFAULT_VALUE; for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { my_value &= PROC_VALUE(i + my_proc + 1); } shmem_barrier_all(); for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { value = FUNC_VALUE(shmem_addr, PROC_VALUE(i + peer_proc + 1), peer_proc); if (value != expect_value) { break; } expect_value = value & PROC_VALUE(i + peer_proc + 1); } shmem_barrier_all(); value = *shmem_addr; rc = (my_value == value ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d:%lld) expected = %lld vs got = %lld\n", my_proc, (INT64_TYPE)my_value, (INT64_TYPE)expect_value, (INT64_TYPE)value); } else { rc = TC_SETUP_FAIL; } if (shmem_addr) { shfree(shmem_addr); } return rc; }
static int test_item2(void) { int rc = TC_PASS; TYPE_VALUE* shmem_addr = NULL; TYPE_VALUE my_value = 0; TYPE_VALUE peer_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; int peer_proc = 0; num_proc = _num_pes(); my_proc = _my_pe(); shmem_addr = shmalloc(sizeof(*shmem_addr)); if (shmem_addr) { TYPE_VALUE value = -1; /* Set my value */ my_value = (TYPE_VALUE)my_proc; *shmem_addr = my_value; /* Define peer and it value */ peer_proc = (my_proc + 1) % num_proc; peer_value = (TYPE_VALUE)peer_proc; /* Define expected value */ expect_value = peer_value; /* Wait is set instead of barrier to give some time to all PE for setting their values */ shmem_barrier_all(); /* Get value from peer */ FUNC_VALUE(&value, shmem_addr, 1, peer_proc); rc = (sys_fcompare(expect_value, value) ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d:%Lf) peer(#%d:%Lf) expected = %Lf buffer size = %lld\n", my_proc, (long double)my_value, peer_proc, (long double)peer_value, (long double)expect_value, (INT64_TYPE)1); } else { rc = TC_SETUP_FAIL; } if (shmem_addr) { shfree(shmem_addr); } return rc; }
/**************************************************************************** * Place for Test Item functions ***************************************************************************/ static int test_item1(void) { int rc = TC_PASS; TYPE_VALUE* shmem_addr = NULL; TYPE_VALUE my_value = 0; TYPE_VALUE peer_value = 0; TYPE_VALUE expect_value = 0; int my_proc = 0; int peer_proc = 0; my_proc = _my_pe(); shmem_addr = shmalloc(sizeof(*shmem_addr)); if (shmem_addr) { TYPE_VALUE value = -1; /* Set my value */ my_value = (TYPE_VALUE)(((double)rand() / (double)RAND_MAX) * MAX_VALUE); *shmem_addr = my_value; /* Define peer and it value */ peer_proc = my_proc; peer_value = my_value; /* Define expected value */ expect_value = peer_value; /* Wait is set instead of barrier to give some time to all PE for setting their values */ shmem_barrier_all(); /* Get value from peer */ FUNC_VALUE(&value, shmem_addr, 1, peer_proc); rc = (expect_value == value ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d:%lld) peer(#%d:%lld) expected = %lld buffer size = %lld\n", my_proc, (INT64_TYPE)my_value, peer_proc, (INT64_TYPE)peer_value, (INT64_TYPE)expect_value, (INT64_TYPE)1); } else { rc = TC_SETUP_FAIL; } if (shmem_addr) { shfree(shmem_addr); } return rc; }
static int test_item3(void) { int rc = TC_PASS; static TYPE_VALUE shmem_value = 0; TYPE_VALUE* shmem_addr = &shmem_value; TYPE_VALUE my_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; int peer_proc = 0; int i = 0; num_proc = _num_pes(); my_proc = _my_pe(); { TYPE_VALUE value = 0; /* Store my value */ my_value = (TYPE_VALUE)1; *shmem_addr = 0; /* Define peer */ peer_proc = (my_proc + 1) % num_proc; /* Define expected value */ expect_value = __cycle_count; shmem_barrier_all(); for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { FUNC_VALUE(shmem_addr, peer_proc); } shmem_barrier_all(); value = *shmem_addr; rc = (expect_value == value ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d:%lld) expected = %lld vs got = %lld\n", my_proc, (INT64_TYPE)my_value, (INT64_TYPE)expect_value, (INT64_TYPE)value); } return rc; }
/* OP to neighbour, static */ static int test_item3(void) { int rc = TC_PASS; static TYPE_VALUE shmem_value = 0; TYPE_VALUE* shmem_addr = &shmem_value; TYPE_VALUE my_value = DEFAULT_VALUE; int num_proc = 0; int my_proc = 0; int peer_proc = 0; int i = 0; num_proc = _num_pes(); my_proc = _my_pe(); peer_proc = (my_proc + 1) % num_proc; TYPE_VALUE value = 0; /* Store my value */ *shmem_addr = DEFAULT_VALUE; for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { my_value |= PROC_VALUE(i + my_proc + 1); } shmem_barrier_all(); for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { FUNC_VALUE(shmem_addr, PROC_VALUE(i + peer_proc + 1), peer_proc); } shmem_barrier_all(); value = *shmem_addr; rc = (my_value == value ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d) expected = %lld vs got = %lld\n", my_proc, (INT64_TYPE)my_value, (INT64_TYPE)value); return rc; }
static int test_item9(void) { int rc = TC_PASS; static TYPE_VALUE target_addr[MAX_BUFFER_SIZE * 2]; static TYPE_VALUE source_addr[MAX_BUFFER_SIZE * 2]; TYPE_VALUE source_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; long* pSyncMult = NULL; TYPE_VALUE* pWrkMult = NULL; int pSyncNum = 2; int pWrkNum = 2; num_proc = _num_pes(); my_proc = _my_pe(); pSyncMult = shmalloc(sizeof(*pSyncMult) * pSyncNum * _SHMEM_REDUCE_SYNC_SIZE); if (pSyncMult) { TYPE_VALUE value = DEFAULT_VALUE; int i = 0; int j = 0; long cur_buf_size = 0; for ( j = 0; j < pSyncNum * _SHMEM_REDUCE_SYNC_SIZE; j++ ) { pSyncMult[j] = _SHMEM_SYNC_VALUE; } /* Give some time to all PE for setting their values */ shmem_barrier_all(); pWrkMult = shmalloc(sizeof(*pWrkMult) * pWrkNum * sys_max(MAX_BUFFER_SIZE, _SHMEM_REDUCE_MIN_WRKDATA_SIZE)); if (pWrkMult) { value = DEFAULT_VALUE; source_value = (TYPE_VALUE)(my_proc + 1); fill_buffer((void *)source_addr, MAX_BUFFER_SIZE * 2, (void *)&source_value, sizeof(source_value)); fill_buffer((void *)target_addr, MAX_BUFFER_SIZE * 2, (void *)&value, sizeof(value)); shmem_barrier_all(); for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { cur_buf_size = sys_max(1, (i + 1) * MAX_BUFFER_SIZE / __cycle_count); /* Set initial target value */ value = DEFAULT_VALUE; /* Set my value */ source_value = (TYPE_VALUE)(my_proc + 1); /* Define expected value */ expect_value = 0; if (my_proc % 2) expect_value = DEFAULT_VALUE; else { int k = num_proc; while (k) { if (k % 2) expect_value |= k; k--; } } int in_active_set = check_within_active_set(0, 1, ((num_proc / 2) + (num_proc % 2)), my_proc, num_proc); if ( in_active_set ) { /* Put value to peer */ FUNC_VALUE(target_addr + (i % 2) * MAX_BUFFER_SIZE, source_addr + (i % 2) * MAX_BUFFER_SIZE, cur_buf_size, 0, 1, ((num_proc / 2) + (num_proc % 2)), pWrkMult + (i % pWrkNum) * sys_max(MAX_BUFFER_SIZE, _SHMEM_REDUCE_MIN_WRKDATA_SIZE), pSyncMult + (i % pSyncNum) * _SHMEM_REDUCE_SYNC_SIZE); rc = (!compare_buffer_with_const(target_addr + (i % 2) * MAX_BUFFER_SIZE, cur_buf_size, &expect_value, sizeof(expect_value)) ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my#%d source = %lld expected = %lld actual = %lld buffer size = %lld\n", my_proc, (INT64_TYPE)source_value, (INT64_TYPE)expect_value, (INT64_TYPE)value, (INT64_TYPE)cur_buf_size); if (rc) { TYPE_VALUE* check_addr = target_addr + (i % 2) * MAX_BUFFER_SIZE; int odd_index = compare_buffer_with_const(check_addr, cur_buf_size, &expect_value, sizeof(expect_value)); int show_index = (odd_index > 1 ? odd_index - 2 : 0); int show_size = sizeof(*check_addr) * sys_min(3, cur_buf_size - odd_index - 1); log_debug(OSH_TC, "index of incorrect value: 0x%08X (%d)\n", odd_index - 1, odd_index - 1); log_debug(OSH_TC, "buffer interval: 0x%08X - 0x%08X\n", show_index, show_index + show_size); show_buffer(check_addr + show_index, show_size); } fill_buffer((void *)(source_addr + (i % 2) * MAX_BUFFER_SIZE), cur_buf_size, (void *)&source_value, sizeof(source_value)); fill_buffer((void *)(target_addr + (i % 2) * MAX_BUFFER_SIZE ), cur_buf_size, (void *)&value, sizeof(value)); } } shfree(pWrkMult); } else { rc = TC_SETUP_FAIL; } shfree(pSyncMult); } else { rc = TC_SETUP_FAIL; } return rc; }
static int test_item8(void) { int rc = TC_PASS; static TYPE_VALUE target_addr[MAX_BUFFER_SIZE]; static TYPE_VALUE source_addr[MAX_BUFFER_SIZE]; TYPE_VALUE source_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; num_proc = _num_pes(); my_proc = _my_pe(); { TYPE_VALUE value = DEFAULT_VALUE; int i = 0; int j = 0; long cur_buf_size = 0; for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { cur_buf_size = sys_max(1, (i + 1) * MAX_BUFFER_SIZE / __cycle_count); pWrk = shmalloc(sizeof(*pWrk) * sys_max(cur_buf_size/2 + 1, _SHMEM_REDUCE_MIN_WRKDATA_SIZE)); if (pWrk) { /* Set initial target value */ value = DEFAULT_VALUE; fill_buffer((void *)target_addr, cur_buf_size, (void *)&value, sizeof(value)); /* Give some time to all PE for setting their values */ shmem_barrier_all(); /* Set my value */ source_value = (TYPE_VALUE)(my_proc + 1); fill_buffer((void *)source_addr, cur_buf_size, (void *)&source_value, sizeof(source_value)); /* Define expected value */ expect_value = 0; if (my_proc % 2) expect_value = DEFAULT_VALUE; else { int k = num_proc; while (k) { if (k % 2) expect_value |= k; k--; } } /* This guarantees that PE set initial value before peer change one */ for ( j = 0; j < _SHMEM_REDUCE_SYNC_SIZE; j++ ) { pSync[j] = _SHMEM_SYNC_VALUE; } shmem_barrier_all(); int in_active_set = check_within_active_set(0, 1, ((num_proc / 2) + (num_proc % 2)), my_proc, num_proc); if ( in_active_set ) { /* Put value to peer */ FUNC_VALUE(target_addr, source_addr, cur_buf_size, 0, 1, ((num_proc / 2) + (num_proc % 2)), pWrk, pSync); } /* Get value put by peer: * These routines start the remote transfer and may return before the data * is delivered to the remote PE */ shmem_barrier_all(); { int wait = WAIT_COUNT; while (wait--) { value = *target_addr; if (expect_value == value) break; sleep(1); } } if ( in_active_set ) { rc = (!compare_buffer_with_const(target_addr, cur_buf_size, &expect_value, sizeof(expect_value)) ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my#%d source = %lld expected = %lld actual = %lld buffer size = %lld\n", my_proc, (INT64_TYPE)source_value, (INT64_TYPE)expect_value, (INT64_TYPE)value, (INT64_TYPE)cur_buf_size); if (rc) { TYPE_VALUE* check_addr = target_addr; int odd_index = compare_buffer_with_const(check_addr, cur_buf_size, &expect_value, sizeof(expect_value)); int show_index = (odd_index > 1 ? odd_index - 2 : 0); int show_size = sizeof(*check_addr) * sys_min(3, cur_buf_size - odd_index - 1); log_debug(OSH_TC, "index of incorrect value: 0x%08X (%d)\n", odd_index - 1, odd_index - 1); log_debug(OSH_TC, "buffer interval: 0x%08X - 0x%08X\n", show_index, show_index + show_size); show_buffer(check_addr + show_index, show_size); } } shfree(pWrk); } else { rc = TC_SETUP_FAIL; } } } return rc; }
static int test_item4(void) { int rc = TC_PASS; TYPE_VALUE* target_addr = NULL; TYPE_VALUE* source_addr = NULL; TYPE_VALUE source_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; num_proc = _num_pes(); my_proc = _my_pe(); pWrk = shmalloc(sizeof(*pWrk) * sys_max(1/2 + 1, _SHMEM_REDUCE_MIN_WRKDATA_SIZE)); if (pWrk) { source_addr = shmalloc(sizeof(*source_addr)); target_addr = source_addr; } if (target_addr && source_addr) { TYPE_VALUE value = DEFAULT_VALUE; int j = 0; /* Set my value */ source_value = (TYPE_VALUE)my_proc; *source_addr = source_value; /* Define expected value */ expect_value = 0; { int k = num_proc; while (k--) expect_value |= k; } /* This guarantees that PE set initial value before peer change one */ for ( j = 0; j < _SHMEM_REDUCE_SYNC_SIZE; j++ ) { pSync[j] = _SHMEM_SYNC_VALUE; } shmem_barrier_all(); /* Put value to peer */ FUNC_VALUE(target_addr, source_addr, 1, 0, 0, num_proc, pWrk, pSync); /* Get value put by peer: * These routines start the remote transfer and may return before the data * is delivered to the remote PE */ shmem_barrier_all(); { int total_wait = 0; while (*target_addr == DEFAULT_VALUE && total_wait < 1000 * WAIT_COUNT) { total_wait++; usleep(1); } value = *target_addr; } rc = (expect_value == value ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my#%d source = %lld expected = %lld actual = %lld\n", my_proc, (INT64_TYPE)source_value, (INT64_TYPE)expect_value, (INT64_TYPE)value); } else { rc = TC_SETUP_FAIL; } if (source_addr) { shfree(source_addr); } if (pWrk) { shfree(pWrk); pWrk = NULL; } return rc; }
/**************************************************************************** * Place for Test Item functions ***************************************************************************/ static int test_item1(void) { int rc = TC_PASS; TYPE_VALUE* shmem_addr = NULL; TYPE_VALUE* local_addr = NULL; TYPE_VALUE my_value = 0; TYPE_VALUE peer_value = 0; TYPE_VALUE* expect_value = NULL; int num_proc = 0; int my_proc = 0; int peer_proc = 0; int tst, sst; int max_stride = MAX_ARRAY_SIZE/2-1; num_proc = _num_pes(); my_proc = _my_pe(); shmem_addr = shmalloc(sizeof(*shmem_addr)*MAX_ARRAY_SIZE); local_addr = malloc(sizeof(*local_addr)*MAX_ARRAY_SIZE); expect_value = malloc(sizeof(*expect_value)*MAX_ARRAY_SIZE); if (shmem_addr) { INT64_TYPE i = 0; INT64_TYPE j = 0; int num_to_get; my_value = 0; size_t odd_pos; for (i = 0; (i < COUNT_VALUE) && (rc == TC_PASS); i++) { tst = (i < max_stride) ? i+1 : max_stride; sst = tst; num_to_get = MAX_ARRAY_SIZE/tst; /* Set my value */ my_value = (TYPE_VALUE)(my_proc + 1); memset(local_addr,0,MAX_ARRAY_SIZE*SIZE_VALUE); memset(expect_value,0,MAX_ARRAY_SIZE*SIZE_VALUE); for (j = 0; j < MAX_ARRAY_SIZE; j++) shmem_addr[j] = my_value; /* Define peer and it value */ peer_proc = (my_proc + 1) % num_proc; peer_value = (TYPE_VALUE)(peer_proc + 1); /* Define expected value */ for (j=0; j<num_to_get; j++) expect_value[j*tst] = peer_value; /* Wait is set instead of barrier to give some time to all PE for setting their values */ shmem_barrier_all(); /* Get value from peer */ FUNC_VALUE(local_addr, shmem_addr,tst,sst,num_to_get,peer_proc); if (rc == TC_PASS) { rc = (compare_buffer((unsigned char*)local_addr, (unsigned char*)expect_value, MAX_ARRAY_SIZE, &odd_pos) ? TC_PASS : TC_FAIL); } log_debug(OSH_TC, "my(#%d:%lld) peer(#%d:%lld) expected = %lld vs got = %lld\n", my_proc, (INT64_TYPE)my_value, peer_proc, (INT64_TYPE)peer_value, (INT64_TYPE)expect_value[0], (INT64_TYPE)local_addr[0]); /* Wait is set instead of barrier to give some time to all PE for setting their values */ shmem_barrier_all(); } } else { rc = TC_SETUP_FAIL; } if (local_addr) { free(local_addr); } if (expect_value) { free(expect_value); } if (shmem_addr) { shfree(shmem_addr); } return rc; }
static int test_item2(void) { int rc = TC_PASS; TYPE_VALUE* target_addr = NULL; TYPE_VALUE* source_addr = NULL; TYPE_VALUE source_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; num_proc = _num_pes(); my_proc = _my_pe(); pWrk = shmalloc(sizeof(*pWrk) * sys_max(1/2 + 1, _SHMEM_REDUCE_MIN_WRKDATA_SIZE)); if (pWrk) { target_addr = shmalloc(sizeof(*target_addr)); source_addr = shmalloc(sizeof(*source_addr)); } if (target_addr && source_addr) { TYPE_VALUE value = DEFAULT_VALUE; int j = 0; /* Set initial target value */ *target_addr = DEFAULT_VALUE; /* Set my value */ source_value = ( my_proc < OVERFLOW_FACTORIAL_LIMIT ? (TYPE_VALUE)(my_proc + 1) : 1); *source_addr = source_value; /* Define expected value */ expect_value = 1; { int k = ( num_proc <= OVERFLOW_FACTORIAL_LIMIT ? num_proc : OVERFLOW_FACTORIAL_LIMIT); while (k) expect_value *= k--; } /* This guarantees that PE set initial value before peer change one */ for ( j = 0; j < _SHMEM_REDUCE_SYNC_SIZE; j++ ) { pSync[j] = _SHMEM_SYNC_VALUE; } shmem_barrier_all(); /* Put value to peer */ FUNC_VALUE(target_addr, source_addr, 1, 0, 0, num_proc, pWrk, pSync); /* Get value put by peer: * These routines start the remote transfer and may return before the data * is delivered to the remote PE */ shmem_barrier_all(); { int total_wait = 0; while (sys_fcompare(*target_addr, DEFAULT_VALUE) && total_wait < 1000 * WAIT_COUNT) { total_wait++; usleep(1); } value = *target_addr; } rc = (sys_fcompare(expect_value, value) ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my#%d source = %Lf expected = %Lf actual = %Lf\n", my_proc, (long double)source_value, (long double)expect_value, (long double)value); } else { rc = TC_SETUP_FAIL; } if (source_addr) { shfree(source_addr); } if (target_addr) { shfree(target_addr); } if (pWrk) { shfree(pWrk); pWrk = NULL; } return rc; }
static int test_item3(void) { int rc = TC_PASS; TYPE_VALUE* shmem_addr = NULL; TYPE_VALUE my_value = 0; TYPE_VALUE* check_arr = NULL; int num_proc = 0; int my_proc = 0; int peer_proc = 0; int i = 0; int j = 0; int k = 0; int flag = 0; int missed_values = 0; static long* pSync = NULL; num_proc = _num_pes(); my_proc = _my_pe(); shmem_addr = shmalloc(sizeof(*shmem_addr)); check_arr = shmalloc(sizeof(*check_arr) * num_proc); pSync = shmalloc(sizeof(*pSync) * _SHMEM_COLLECT_SYNC_SIZE); for (i = 0; i < _SHMEM_COLLECT_SYNC_SIZE; i++) { pSync[i] = _SHMEM_SYNC_VALUE; } if (shmem_addr && pSync && check_arr) { static TYPE_VALUE value = 0; /* Store my value */ my_value = (TYPE_VALUE)my_proc; *shmem_addr = DEFAULT_VALUE; shmem_barrier_all(); for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { missed_values = 0; my_value = (TYPE_VALUE)my_proc; value = FUNC_VALUE(shmem_addr, my_value, peer_proc); shmem_barrier_all(); shmem_collect32(check_arr, &value, (sizeof(value) + 3 ) / 4, 0, 0, num_proc, pSync); shmem_barrier_all(); for (j = 0; j < num_proc ; j++) { flag = 0; for (k = 0; k < num_proc; k++) { if (sys_fcompare(check_arr[k], j)) { flag = 1; break; } } if (flag == 0) { missed_values++; } if (missed_values > 1) { rc = TC_FAIL; break; } } } shmem_barrier_all(); log_debug(OSH_TC, "my(#%d:%lld) missed_values expected = 1 vs missed_values = %d\n", my_proc, (INT64_TYPE)my_value, missed_values); } else { rc = TC_SETUP_FAIL; } if (shmem_addr) { shfree(shmem_addr); } if (pSync) { shfree(pSync); } return rc; }
static int test_item4(void) { int rc = TC_PASS; TYPE_VALUE* shmem_addr = NULL; TYPE_VALUE* send_addr = NULL; TYPE_VALUE my_value = 0; TYPE_VALUE peer_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; int root_proc = 0; num_proc = _num_pes(); my_proc = _my_pe(); shmem_addr = shmalloc(sizeof(*shmem_addr)); send_addr = shmalloc(sizeof(*send_addr)); if (shmem_addr && send_addr) { TYPE_VALUE value = DEFAULT_VALUE; int j = 0; /* Set my value */ my_value = DEFAULT_VALUE; *shmem_addr = my_value; /* Define peer and it value */ peer_value = BASE_VALUE; *send_addr = peer_value; /* Set root */ root_proc = 0; /* Define expected value */ expect_value = (((my_proc % 2) == 0) && (my_proc != 0) ? BASE_VALUE : DEFAULT_VALUE); /* This guarantees that PE set initial value before peer change one */ for ( j = 0; j < _SHMEM_COLLECT_SYNC_SIZE; j++ ) { pSync[j] = _SHMEM_SYNC_VALUE; } shmem_barrier_all(); /* Put value to peer */ if ((my_proc % 2) == 0) { FUNC_VALUE(shmem_addr, send_addr, 1, root_proc, 0, 1, ((num_proc / 2) + (num_proc % 2)), pSync); } /* Get value put by peer: * These routines start the remote transfer and may return before the data * is delivered to the remote PE */ shmem_barrier_all(); { int wait = WAIT_COUNT; while (wait--) { value = *shmem_addr; if (expect_value == value) break; sleep(1); } } rc = (expect_value == value ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my#%d root(#%d:%lld) expected = %lld actual = %lld\n", my_proc, root_proc, (INT64_TYPE)peer_value, (INT64_TYPE)expect_value, (INT64_TYPE)value); } else { rc = TC_SETUP_FAIL; } if (send_addr) { shfree(send_addr); } if (shmem_addr) { shfree(shmem_addr); } return rc; }
static int test_item5(void) { int rc = TC_PASS; static TYPE_VALUE shmem_addr[MAX_BUFFER_SIZE]; static TYPE_VALUE send_addr[MAX_BUFFER_SIZE]; TYPE_VALUE my_value = 0; TYPE_VALUE peer_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; int peer_proc = 0; num_proc = _num_pes(); my_proc = _my_pe(); { INT64_TYPE i = 0; long cur_buf_size = 0; for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { cur_buf_size = sys_max(1, (i + 1) * MAX_BUFFER_SIZE / __cycle_count); /* Set my value */ my_value = (-1); fill_buffer((void *)shmem_addr, cur_buf_size, (void *)&my_value, sizeof(my_value)); /* Give some time to all PE for setting their values */ shmem_barrier_all(); /* Define peer and it value */ peer_proc = (my_proc + 1) % num_proc; peer_value = (peer_proc % 2 ? 1 : -1) * (i * (MAX_VALUE / __cycle_count)); fill_buffer((void *)send_addr, cur_buf_size, (void *)&peer_value, sizeof(peer_value)); /* Define expected value */ expect_value = (my_proc % 2 ? 1 : -1) * (i * (MAX_VALUE / __cycle_count)); /* Get value put by peer */ FUNC_VALUE(shmem_addr, send_addr, cur_buf_size, peer_proc); /* Get value put by peer: * These routines start the remote transfer and may return before the data * is delivered to the remote PE */ wait_for_put_completion(peer_proc,10 /* wait for 10 secs */); rc = (!compare_buffer_with_const_longdouble(shmem_addr, cur_buf_size, expect_value) ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d:%Lf) peer(#%d:%Lf) expected = %Lf buffer size = %lld\n", my_proc, (long double)my_value, peer_proc, (long double)peer_value, (long double)expect_value, (INT64_TYPE)1); if (rc) { TYPE_VALUE* check_addr = shmem_addr; int odd_index = compare_buffer_with_const_longdouble(check_addr, cur_buf_size, expect_value); int show_index = (odd_index > 1 ? odd_index - 2 : 0); int show_size = sizeof(*check_addr) * sys_min(3, cur_buf_size - odd_index - 1); log_debug(OSH_TC, "index of incorrect value: 0x%08X (%d)\n", odd_index - 1, odd_index - 1); log_debug(OSH_TC, "buffer interval: 0x%08X - 0x%08X\n", show_index, show_index + show_size); show_buffer(check_addr + show_index, show_size); } } } return rc; }
static int test_item5(void) { int rc = TC_PASS; static TYPE_VALUE shmem_addr[MAX_BUFFER_SIZE]; static TYPE_VALUE recv_addr[MAX_BUFFER_SIZE]; TYPE_VALUE my_value = 0; TYPE_VALUE peer_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; int peer_proc = 0; num_proc = _num_pes(); my_proc = _my_pe(); { INT64_TYPE i = 0; long cur_buf_size = 0; my_value = 0; for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { /* Set my value */ my_value = (my_proc % 2 ? 1 : -1) * (i * (MAX_VALUE / __cycle_count)); cur_buf_size = sys_max(1, (i + 1) * MAX_BUFFER_SIZE / __cycle_count); fill_buffer((void *)shmem_addr, cur_buf_size, (void *)&my_value, sizeof(my_value)); /* Give some time to all PE for setting their values */ shmem_barrier_all(); /* Define peer and it value */ peer_proc = (my_proc + 1) % num_proc; peer_value = (peer_proc % 2 ? 1 : -1) * (i * (MAX_VALUE / __cycle_count)); /* Define expected value */ expect_value = peer_value; /* Get value from peer */ FUNC_VALUE(recv_addr, shmem_addr, cur_buf_size, peer_proc); rc = (!compare_buffer_with_const(recv_addr, cur_buf_size, &expect_value, sizeof(expect_value)) ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d:%Lf) peer(#%d:%Lf) expected = %Lf buffer size = %lld\n", my_proc, (long double)my_value, peer_proc, (long double)peer_value, (long double)expect_value, (INT64_TYPE)cur_buf_size); if (rc) { TYPE_VALUE* check_addr = recv_addr; int odd_index = compare_buffer_with_const(check_addr, cur_buf_size, &expect_value, sizeof(expect_value)); int show_index = (odd_index > 1 ? odd_index - 2 : 0); int show_size = sizeof(*check_addr) * sys_min(3, cur_buf_size - odd_index - 1); log_debug(OSH_TC, "index of incorrect value: 0x%08X (%d)\n", odd_index - 1, odd_index - 1); log_debug(OSH_TC, "buffer interval: 0x%08X - 0x%08X\n", show_index, show_index + show_size); show_buffer(check_addr + show_index, show_size); } shmem_barrier_all(); } } return rc; }
// // Frame_For_Stack_Level: C // // Level can be an UNSET!, an INTEGER!, an ANY-FUNCTION!, or a FRAME!. If // level is UNSET! then it means give whatever the first call found is. // // Returns NULL if the given level number does not correspond to a running // function on the stack. // // Can optionally give back the index number of the stack level (counting // where the most recently pushed stack level is the lowest #) // // !!! Unfortunate repetition of logic inside of BACKTRACE; find a way to // unify the logic for omitting things like breakpoint frames, or either // considering pending frames or not... // struct Reb_Frame *Frame_For_Stack_Level( REBCNT *number_out, const REBVAL *level, REBOOL skip_current ) { struct Reb_Frame *frame = FS_TOP; REBOOL first = TRUE; REBINT num = 0; if (IS_INTEGER(level)) { if (VAL_INT32(level) < 0) { // // !!! fail() here, or just return NULL? // return NULL; } } // We may need to skip some number of frames, if there have been stack // levels added since the numeric reference point that "level" was // supposed to refer to has changed. For now that's only allowed to // be one level, because it's rather fuzzy which stack levels to // omit otherwise (pending? parens?) // if (skip_current) frame = frame->prior; for (; frame != NULL; frame = frame->prior) { if (frame->mode != CALL_MODE_FUNCTION) { // // Don't consider pending calls, or GROUP!, or any non-invoked // function as a candidate to target. // // !!! The inability to target a GROUP! by number is an artifact // of implementation, in that there's no hook in Do_Core() at // the point of group evaluation to process the return. The // matter is different with a pending function call, because its // arguments are only partially processed--hence something // like a RESUME/AT or an EXIT/FROM would not know which array // index to pick up running from. // continue; } if (first) { if ( IS_FUNCTION_AND(FUNC_VALUE(frame->func), FUNC_CLASS_NATIVE) && ( FUNC_CODE(frame->func) == &N_pause || FUNC_CODE(frame->func) == N_breakpoint ) ) { // this is considered the "0". Return it only if 0 was requested // specifically (you don't "count down to it"); // if (IS_INTEGER(level) && num == VAL_INT32(level)) goto return_maybe_set_number_out; else { first = FALSE; continue; } } else { ++num; // bump up from 0 } } if (IS_INTEGER(level) && num == VAL_INT32(level)) goto return_maybe_set_number_out; first = FALSE; if (frame->mode != CALL_MODE_FUNCTION) { // // Pending frames don't get numbered // continue; } if (IS_UNSET(level) || IS_NONE(level)) { // // Take first actual frame if unset or none // goto return_maybe_set_number_out; } else if (IS_INTEGER(level)) { ++num; if (num == VAL_INT32(level)) goto return_maybe_set_number_out; } else if (IS_FRAME(level)) { if ( (frame->flags & DO_FLAG_FRAME_CONTEXT) && frame->data.context == VAL_CONTEXT(level) ) { goto return_maybe_set_number_out; } } else { assert(IS_FUNCTION(level)); if (VAL_FUNC(level) == frame->func) goto return_maybe_set_number_out; } } // Didn't find it... // return NULL; return_maybe_set_number_out: if (number_out) *number_out = num; return frame; }
static int test_item6(void) { int rc = TC_PASS; static TYPE_VALUE shmem_addr[MAX_BUFFER_SIZE]; static TYPE_VALUE send_addr[MAX_BUFFER_SIZE]; TYPE_VALUE my_value = 0; TYPE_VALUE peer_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; int root_proc = 0; num_proc = _num_pes(); my_proc = _my_pe(); { TYPE_VALUE value = DEFAULT_VALUE; int i = 0; int j = 0; long cur_buf_size = 0; for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { cur_buf_size = sys_max(1, (i + 1) * MAX_BUFFER_SIZE / __cycle_count); /* Set my value */ my_value = DEFAULT_VALUE; fill_buffer((void *)shmem_addr, cur_buf_size, (void *)&my_value, sizeof(my_value)); /* Give some time to all PE for setting their values */ shmem_barrier_all(); /* Define peer and it value */ peer_value = (i * (MAX_VALUE / __cycle_count)); fill_buffer((void *)send_addr, cur_buf_size, (void *)&peer_value, sizeof(peer_value)); /* Set root */ root_proc = 0; /* Define expected value */ expect_value = (((my_proc % 2) == 0) && (my_proc != root_proc) ? peer_value : DEFAULT_VALUE); /* This guarantees that PE set initial value before peer change one */ for ( j = 0; j < _SHMEM_COLLECT_SYNC_SIZE; j++ ) { pSync[j] = _SHMEM_SYNC_VALUE; } shmem_barrier_all(); /* Put value to peer */ if ((my_proc % 2) == 0) { FUNC_VALUE(shmem_addr, send_addr, cur_buf_size, root_proc, 0, 1, ((num_proc / 2) + (num_proc % 2)), pSync); } /* Get value put by peer: * These routines start the remote transfer and may return before the data * is delivered to the remote PE */ shmem_barrier_all(); { int wait = WAIT_COUNT; while (wait--) { value = *shmem_addr; if (expect_value == value) break; sleep(1); } } rc = (!compare_buffer_with_const(shmem_addr, cur_buf_size, &expect_value, sizeof(expect_value)) ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my#%d root(#%d:%lld) expected = %lld actual = %lld buffer size = %lld\n", my_proc, root_proc, (INT64_TYPE)peer_value, (INT64_TYPE)expect_value, (INT64_TYPE)value, (INT64_TYPE)cur_buf_size); if (rc) { TYPE_VALUE* check_addr = shmem_addr; int odd_index = compare_buffer_with_const(check_addr, cur_buf_size, &expect_value, sizeof(expect_value)); int show_index = (odd_index > 1 ? odd_index - 2 : 0); int show_size = sizeof(*check_addr) * sys_min(3, cur_buf_size - show_index); log_debug(OSH_TC, "index of incorrect value: 0x%08X (%d)\n", odd_index - 1, odd_index - 1); log_debug(OSH_TC, "buffer interval: 0x%08X - 0x%08X\n", show_index, show_index + show_size); show_buffer(check_addr + show_index, show_size); } } } return rc; }
static int test_item6(void) { int rc = TC_PASS; TYPE_VALUE* target_addr = NULL; TYPE_VALUE* source_addr = NULL; TYPE_VALUE source_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; num_proc = _num_pes(); my_proc = _my_pe(); target_addr = (TYPE_VALUE*)shmalloc(sizeof(*target_addr) * __max_buffer_size); source_addr = (TYPE_VALUE*)shmalloc(sizeof(*source_addr) * __max_buffer_size); if (target_addr && source_addr) { TYPE_VALUE value = DEFAULT_VALUE; int i = 0; int j = 0; long cur_buf_size = 0; for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { cur_buf_size = sys_max(1, (i + 1) * __max_buffer_size / __cycle_count); pWrk = shmalloc(sizeof(*pWrk) * sys_max(cur_buf_size/2 + 1, _SHMEM_REDUCE_MIN_WRKDATA_SIZE)); if (pWrk) { /* Set initial target value */ value = DEFAULT_VALUE; fill_buffer((void *)target_addr, cur_buf_size, (void *)&value, sizeof(value)); /* Give some time to all PE for setting their values */ shmem_barrier_all(); /* Set my value */ source_value = ( my_proc < OVERFLOW_FACTORIAL_LIMIT ? (TYPE_VALUE)(my_proc + 1) : 1); fill_buffer((void *)source_addr, cur_buf_size, (void *)&source_value, sizeof(source_value)); /* Define expected value */ expect_value = 1; { int k = ( num_proc <= OVERFLOW_FACTORIAL_LIMIT ? num_proc : OVERFLOW_FACTORIAL_LIMIT); while (k) expect_value *= k--; } /* This guarantees that PE set initial value before peer change one */ for ( j = 0; j < _SHMEM_REDUCE_SYNC_SIZE; j++ ) { pSync[j] = _SHMEM_SYNC_VALUE; } shmem_barrier_all(); /* Put value to peer */ FUNC_VALUE(target_addr, source_addr, cur_buf_size, 0, 0, num_proc, pWrk, pSync); /* Get value put by peer: * These routines start the remote transfer and may return before the data * is delivered to the remote PE */ shmem_barrier_all(); { int wait = WAIT_COUNT; while (wait--) { value = *target_addr; if (sys_fcompare(expect_value, value)) break; sleep(1); } } rc = (!compare_buffer_with_const_longdouble(target_addr, cur_buf_size, expect_value) ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my#%d source = %Lf expected = %Lf actual = %Lf buffer size = %lld\n", my_proc, (long double)source_value, (long double)expect_value, (long double)value, (INT64_TYPE)cur_buf_size); if (rc) { TYPE_VALUE* check_addr = target_addr; int odd_index = compare_buffer_with_const_longdouble(check_addr, cur_buf_size, expect_value); int show_index = (odd_index > 1 ? odd_index - 2 : 0); int show_size = sizeof(*check_addr) * sys_min(3, cur_buf_size - odd_index - 1); log_debug(OSH_TC, "index of incorrect value: 0x%08X (%d)\n", odd_index - 1, odd_index - 1); log_debug(OSH_TC, "buffer interval: 0x%08X - 0x%08X\n", show_index, show_index + show_size); show_buffer(check_addr + show_index, show_size); } shfree(pWrk); } else { rc = TC_SETUP_FAIL; } } } else { rc = TC_SETUP_FAIL; } if (source_addr) { shfree(source_addr); } if (target_addr) { shfree(target_addr); } return rc; }
static int test_item7(void) { int rc = TC_PASS; static TYPE_VALUE shmem_addr[MAX_BUFFER_SIZE * 2]; static TYPE_VALUE send_addr[MAX_BUFFER_SIZE * 2]; TYPE_VALUE my_value = 0; TYPE_VALUE peer_value = 0; TYPE_VALUE expect_value = 0; int num_proc = 0; int my_proc = 0; int root_proc = 0; long* pSyncMult = NULL; int pSyncNum = 2; num_proc = _num_pes(); my_proc = _my_pe(); pSyncMult = shmalloc(sizeof(*pSyncMult) * pSyncNum * _SHMEM_COLLECT_SYNC_SIZE); if (!pSyncMult) { rc = TC_SETUP_FAIL; } if (rc == TC_PASS) { int i = 0; int j = 0; for ( j = 0; j < pSyncNum * _SHMEM_COLLECT_SYNC_SIZE; j++ ) { pSyncMult[j] = _SHMEM_SYNC_VALUE; } /* Give some time to all PE for setting their values */ shmem_barrier_all(); /* Set root */ root_proc = 0; my_value = DEFAULT_VALUE; peer_value = MAX_VALUE; expect_value = (my_proc == root_proc ? DEFAULT_VALUE : peer_value); fill_buffer((void *)send_addr, MAX_BUFFER_SIZE * 2, (void *)&peer_value, sizeof(peer_value)); fill_buffer((void *)shmem_addr, MAX_BUFFER_SIZE * 2, (void *)&my_value, sizeof(my_value)); shmem_barrier_all(); for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { /* Put value to peer */ FUNC_VALUE(shmem_addr + (i % 2) * MAX_BUFFER_SIZE, send_addr + (i % 2) * MAX_BUFFER_SIZE, MAX_BUFFER_SIZE, root_proc, 0, 0, num_proc, pSyncMult + (i % pSyncNum) * _SHMEM_COLLECT_SYNC_SIZE); rc = (!compare_buffer_with_const(shmem_addr + (i % 2) * MAX_BUFFER_SIZE, MAX_BUFFER_SIZE, &expect_value, sizeof(expect_value)) ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my#%d root(#%d:%lld) expected = %lld actual = %lld buffer size = %lld\n", my_proc, root_proc, (INT64_TYPE)peer_value, (INT64_TYPE)expect_value, (INT64_TYPE)(*shmem_addr), (INT64_TYPE)MAX_BUFFER_SIZE); if (rc) { TYPE_VALUE* check_addr = shmem_addr + (i % 2) * MAX_BUFFER_SIZE; int odd_index = compare_buffer_with_const(check_addr, MAX_BUFFER_SIZE, &expect_value, sizeof(expect_value)); int show_index = (odd_index > 1 ? odd_index - 2 : 0); int show_size = sizeof(*check_addr) * sys_min(3, MAX_BUFFER_SIZE - show_index); log_debug(OSH_TC, "index of incorrect value: 0x%08X (%d)\n", odd_index - 1, odd_index - 1); log_debug(OSH_TC, "buffer interval: 0x%08X - 0x%08X\n", show_index, show_index + show_size); show_buffer(check_addr + show_index, show_size); } fill_buffer((void *)(send_addr + (i % 2) * MAX_BUFFER_SIZE), MAX_BUFFER_SIZE, (void *)&peer_value, sizeof(peer_value)); fill_buffer((void *)(shmem_addr + (i % 2) * MAX_BUFFER_SIZE ), MAX_BUFFER_SIZE, (void *)&my_value, sizeof(my_value)); } } if (pSyncMult) { shfree(pSyncMult); } return rc; }
static int test_item3(void) { int rc = TC_PASS; TYPE_VALUE* shmem_addr = NULL; TYPE_VALUE* recv_addr = NULL; TYPE_VALUE my_value = 0; TYPE_VALUE peer_value = 0; TYPE_VALUE expect_value = 0; int my_proc = 0; int peer_proc = 0; my_proc = _my_pe(); shmem_addr = (TYPE_VALUE*)shmalloc(sizeof(*shmem_addr) * __max_buffer_size); recv_addr = (TYPE_VALUE*)sys_malloc(sizeof(*recv_addr) * __max_buffer_size); if (shmem_addr && recv_addr) { INT64_TYPE i = 0; long cur_buf_size = 0; my_value = 0; for (i = 0; (i < __cycle_count) && (rc == TC_PASS); i++) { /* Set my value */ my_value = (my_proc % 2 ? 1 : -1) * (i * (MAX_VALUE / __cycle_count)); cur_buf_size = sys_max(1, (i + 1) * __max_buffer_size / __cycle_count); fill_buffer((void *)shmem_addr, cur_buf_size, (void *)&my_value, sizeof(my_value)); /* Give some time to all PE for setting their values */ shmem_barrier_all(); /* Define peer and it value */ peer_proc = my_proc; peer_value = my_value; /* Define expected value */ expect_value = peer_value; /* Get value from peer */ FUNC_VALUE(recv_addr, shmem_addr, cur_buf_size, peer_proc); rc = (!compare_buffer_with_const(recv_addr, cur_buf_size, &expect_value, sizeof(expect_value)) ? TC_PASS : TC_FAIL); log_debug(OSH_TC, "my(#%d:%lld) peer(#%d:%lld) expected = %lld buffer size = %lld\n", my_proc, (INT64_TYPE)my_value, peer_proc, (INT64_TYPE)peer_value, (INT64_TYPE)expect_value, (INT64_TYPE)cur_buf_size); if (rc) { TYPE_VALUE* check_addr = recv_addr; int odd_index = compare_buffer_with_const(check_addr, cur_buf_size, &expect_value, sizeof(expect_value)); int show_index = (odd_index > 1 ? odd_index - 2 : 0); int show_size = sizeof(*check_addr) * sys_min(3, cur_buf_size - odd_index - 1); log_debug(OSH_TC, "index of incorrect value: 0x%08X (%d)\n", odd_index - 1, odd_index - 1); log_debug(OSH_TC, "buffer interval: 0x%08X - 0x%08X\n", show_index, show_index + show_size); show_buffer(check_addr + show_index, show_size); } shmem_barrier_all(); } } else { rc = TC_SETUP_FAIL; } if (recv_addr) { sys_free(recv_addr); } if (shmem_addr) { shfree(shmem_addr); } return rc; }