/* * main() is just a shell for routines that parse the command line, * do all the requested work, and then exit cleanly. main() is pretty * much all there is in cpu_rate.c */ int main(int argc, char *argv[]) { /* * Parse command line and set global variables */ parsecl(argc,argv); /* * Note that most of my cpu_rates (except the terminally simple/stupid) * have three phases after parsecl(): * * Startup: Allocate memory, initialize all derivative variables from * command line values. */ startup(); /* * Work: Do all the work. In a complicated cpu_rate, project_work would * itself be a shell for a lot of other modular routines. */ work(); /* * Quit: Done. Clean up (if necessary) and exit. dieharder_quit(); */ }
SEXP dieharder(SEXP genS, SEXP testS, SEXP seedS, SEXP psamplesS, SEXP verbS, SEXP infileS, SEXP ntupleS) { int verb, testarg; unsigned int i; SEXP result = NULL, vec, pv, name, desc, nkps; char *inputfile; /* Setup argv to allow call of parsecl() to let dieharder set globals */ char *argv[] = { "dieharder" }; optind = 0; parsecl(1, argv); /* Parse 'our' parameters from R */ generator = INTEGER_VALUE(genS); testarg = INTEGER_VALUE(testS); diehard = rgb = sts = user = 0; if (testarg < 100) { diehard = testarg; } else if (testarg < 200) { rgb = testarg - 100; } else if (testarg < 300) { sts = testarg - 200; } else { user = testarg - 300; } Seed = (unsigned long int) INTEGER_VALUE(seedS); /* (user-select) Seed, not (save switch) seed */ psamples = INTEGER_VALUE(psamplesS); verb = INTEGER_VALUE(verbS); inputfile = (char*) CHARACTER_VALUE(infileS); ntuple = INTEGER_VALUE(ntupleS); rdh_testptr = NULL; rdh_dtestptr = NULL; /* to be safe, explicitly flag as NULL; cf test in output.c */ if (strcmp(inputfile, "") != 0) { strncpy(filename, inputfile, 128); fromfile = 1; /* flag this as file input */ } if (Seed == 0) { seed = random_seed(); } else { seed = (unsigned long int) Seed; } if (verb) { Rprintf("Dieharder called with gen=%d test=%d seed=%lu\n", generator, diehard, seed); quiet = 0; hist_flag = 1; } else { quiet = 1; /* override dieharder command-line default */ hist_flag = 0; } /* Now do the work that dieharder.c does */ startup(); work(); gsl_rng_free(rng); reset_bit_buffers(); /* And then bring our results back to R */ /* create vector of size four: [0] is vector (!!) ks_pv, [1] is pvalues vec, [2] name, [3] nkps */ PROTECT(result = allocVector(VECSXP, 4)); /* alloc vector and scalars, and set it */ PROTECT(pv = allocVector(REALSXP, rdh_dtestptr->nkps)); PROTECT(name = allocVector(STRSXP, 1)); PROTECT(nkps = allocVector(INTSXP, 1)); if (rdh_testptr != NULL && rdh_dtestptr != NULL) { for (i=0; i<rdh_dtestptr->nkps; i++) { /* there can be nkps p-values per test */ REAL(pv)[i] = rdh_testptr[i]->ks_pvalue; } PROTECT(vec = allocVector(REALSXP, rdh_testptr[0]->psamples)); /* alloc vector and set it */ for (i = 0; i < rdh_testptr[0]->psamples; i++) { REAL(vec)[i] = rdh_testptr[0]->pvalues[i]; } SET_STRING_ELT(name, 0, mkChar(rdh_dtestptr->name)); INTEGER(nkps)[0] = rdh_dtestptr->nkps; /* nb of Kuiper KS p-values in pv vector */ } else { PROTECT(vec = allocVector(REALSXP, 1)); REAL(pv)[0] = R_NaN; REAL(vec)[0] = R_NaN; SET_STRING_ELT(name, 0, mkChar("")); INTEGER(nkps)[0] = R_NaN; } /* insert vectors and scalars into result vector */ SET_VECTOR_ELT(result, 0, pv); SET_VECTOR_ELT(result, 1, vec); SET_VECTOR_ELT(result, 2, name); SET_VECTOR_ELT(result, 3, nkps); UNPROTECT(5); return result; }
SEXP dieharder(SEXP genS, SEXP testS, SEXP seedS, SEXP psamplesS, SEXP verbS, SEXP infileS, SEXP ntupleS) { /* In the RDieHarder/R/zzz.R startup code, dieharderGenerators() * has already called dieharder_rng_types(), and dieharderTests() * has already called dieharder_rng_tests(). The results are * stored in RDieHarder:::.dieharderGenerators and * RDieHarder:::.dieharderTests, as well as C static variables * used by libdieharder. Since user defined generators and tests * may have been added, we do not call these routines again. */ int verb; char *inputfile; char *argv[] = { "dieharder" }; /* Setup argv to allow call of parsecl() to let dieharder set globals */ optind = 0; parsecl(1, argv); /* also covers part of setup_globals() */ generator = INTEGER_VALUE(genS); /* 'our' parameters from R; used below by choose_rng() and run_test() */ dtest_num = INTEGER_VALUE(testS); Seed = (unsigned long int) INTEGER_VALUE(seedS); /* (user-select) Seed, not (save switch) seed */ psamples = INTEGER_VALUE(psamplesS); verb = INTEGER_VALUE(verbS); inputfile = (char*) CHARACTER_VALUE(infileS); ntuple = INTEGER_VALUE(ntupleS); result = NULL; if (strcmp(inputfile, "") != 0) { strncpy(filename, inputfile, 128); fromfile = 1; /* flag this as file input */ } if (Seed == 0) { seed = random_seed(); } else { seed = (unsigned long int) Seed; } if (verb) { Rprintf("Dieharder called with gen=%d test=%d seed=%lu\n", generator, dtest_num, seed); quiet = 0; hist_flag = 1; } else { quiet = 1; /* override dieharder command-line default */ hist_flag = 0; } /* * Pick a rng, establish a seed based on how things were initialized * in parsecl() or elsewhere. Note that choose_rng() times the selected * rng as a matter of course now. */ choose_rng(); /* * At this point, a valid rng should be selected, allocated, and * provisionally seeded. It -a(ll) is set (CLI only) run all the * available tests on the selected rng, reseeding at the beginning of * each test if Seed is nonzero. Otherwise, run the single selected * test (which may still return a vector of pvalues) on the single * selected rng. The CLI then goes on to exit; an interactive UI would * presumably loop back to permit the user to run another test on the * selected rng or select a new rng (and run more tests on it) until the * user elects to exit. * * It is the UI's responsibility to ensure that run_test() is not called * without choosing a valid rng first! */ /* if(all){ */ /* run_all_tests(); */ /* } else { */ run_test(); /* } */ /* * This ends the core loop for a non-CLI interactive UI. GUIs will * typically exit directly from the event loop. Tool UIs may well fall * through, and the CLI simply proceeds sequentially to exit. It isn't * strictly necessary to execute an exit() command at the end, but it * does make the code a bit clearer (and let's one choose an exit code, * if that might ever matter. Exit code 0 clearly means "completed * normally". */ if (rng != NULL) { gsl_rng_free(rng); rng = NULL; } reset_bit_buffers(); return result; /* And then bring our results back to R */ }