// (vector-set! x index e) Cell* op_vecset(Scheme *sc) { if (is_immutable(first(sc->args))) { return error_helper(sc, "vector-set!: unable to alter immutable vector:", first(sc->args)); } int index = long_value(second(sc->args)); if (index < 0 || index >= long_value(first(sc->args))) { return error_helper(sc, "vector-set!: out of bounds:", second(sc->args)); } set_vector_item(first(sc->args), index, third(sc->args)); return s_return_helper(sc, first(sc->args)); }
Cell* op_read_dot(Scheme *sc) { if (token(sc) != TOK_RPAREN) { return error_helper(sc, "syntax error: illegal dot expression", NULL); } else { return s_return_helper(sc, revappend(sc, sc->returnValue, sc->args)); } }
/* callback for when the error handler is registered */ static void errhandler_reg_callbk (pmix_status_t status, size_t errhandler_ref, void *cbdata) { _g_errhandler_ref = errhandler_ref; if(verbose_print)error_helper(status, hostn,"error handler registered callback:"); }
// (vector-ref x index) Cell* op_vecref(Scheme *sc) { int index = long_value(second(sc->args)); if (index < 0 || index >= long_value(first(sc->args))) { return error_helper(sc, "vector-ref: out of bounds:", second(sc->args)); } return s_return_helper(sc, get_vector_item(first(sc->args), index)); }
// (modulo x y) Cell* op_mod(Scheme *sc) { Cell* x = first(sc->args); Cell* y = second(sc->args); Num value = num_value(x); if (long_value(y) != 0) { value = num_mod(value, num_value(y)); return s_return_helper(sc, make_number(sc, value)); } else { return error_helper(sc, "modulo: division by zero", NULL); } }
//将一个数字(整型或浮点型)无损的转化为整型 // (inexact->exact x) Cell* op_inexact2exact(Scheme *sc) { Cell* num; double dd; num = first(sc->args); if (num->_num.isFix) { return s_return_helper(sc, num); } else if (modf(num->_num.doubleValue, &dd) == 0.0) { return s_return_helper(sc, make_integer(sc, long_value(num))); } else { return error_helper(sc, "inexact->exact: not integral:", num); } }
// (vector x y ...) Cell* op_vector(Scheme *sc) { Cell* x; int len = ls_length(sc, sc->args); if (len < 0) return error_helper(sc, "vector: not a proper list:", sc->args); Cell* vec = make_vector(sc, len); int index = 0; for (x = sc->args; is_pair(x); x = cdr(x), index++) { set_vector_item(vec, index, car(x)); } return s_return_helper(sc, vec); }
// (quotient x y ...) Cell* op_intdiv(Scheme *sc) { Num value; Cell* x; if (cdr(sc->args) == &g_nil) { x = sc->args; value = g_one; } else { x = cdr(sc->args); value = num_value(car(sc->args)); } for (; x != &g_nil; x = cdr(x)) { if (long_value(car(x)) != 0) value = num_intdiv(value, num_value(car(x))); else { return error_helper(sc, "quotient: division by zero", NULL); } } return s_return_helper(sc, make_number(sc, value)); }
// (/ x y ...) Cell* op_div(Scheme *sc) { Num value; Cell* x; if (cdr(sc->args) == &g_nil) { x = sc->args; value = g_one; } else { x = cdr(sc->args); value = num_value(car(sc->args)); } for (; x != &g_nil; x = cdr(x)) { if (!is_zero_double(double_value(car(x)))) value = num_div(value, num_value(car(x))); else { return error_helper(sc, "/: division by zero", NULL); } } return s_return_helper(sc, make_number(sc, value)); }
Cell* op_read_sexpr(Scheme *sc) { Cell* x; char *temp; switch (sc->token) { case TOK_EOF: return s_return_helper(sc, &g_eof); case TOK_VECTOR: s_save(sc, op_read_vec, &g_nil, &g_nil); //压入 数组 处理过程 break; /* no break */ /* fall through */ case TOK_LPAREN: sc->token = token(sc); if (sc->token == TOK_RPAREN) { return s_return_helper(sc, &g_nil); } else if (sc->token == TOK_DOT) { return error_helper(sc, "syntax error: illegal dot expression", NULL); } else { //sc->nesting_stack[sc->top_file_index]++; s_save(sc, op_read_list, &g_nil, &g_nil); //压入读取列表的函数 //读取S表达式 sc->op = op_read_sexpr; return &g_true; } case TOK_QUOTE: //引用 s_save(sc, op_read_quote, &g_nil, &g_nil); //压入 引用 处理函数 sc->token = token(sc); //读取S表达式 sc->op = op_read_sexpr; return &g_true; case TOK_ATOM: //原子 temp = readstr_upto(sc, DELIMITERS); // printf("%s\n", temp); return s_return_helper(sc, make_atom_from_string(sc, temp)); case TOK_DQUOTE: //双引号 (字符串类型的原子) x = readstrexp(sc); if (x == &g_false) return error_helper(sc, "Error reading string", NULL); set_immutable(x); return s_return_helper(sc, x); case TOK_SHARP: { //#是eval的简写吗? Cell* f = find_slot_in_env(sc, sc->env, sc->sym_sharp_hook, TRUE); //f的类型symbol_kv ,f是一段处理#的代码 if (f == &g_nil) return error_helper(sc, "undefined sharp expression", NULL); sc->code = cons(sc, slot_value_in_env(f), &g_nil); sc->op = op_eval; return &g_true; } /* no break */ case TOK_SHARP_CONST: //常量 x = make_sharp_const(sc, readstr_upto(sc, DELIMITERS)); if (x == &g_nil) return error_helper(sc, "undefined const sharp expression", NULL); return s_return_helper(sc, x); default: return error_helper(sc, "syntax error: illegal token", NULL); } return NULL; }
int main(int argc, char **argv, const char **environ) { pmix_status_t rc; pmix_info_t *info = NULL; bool flag; pmix_status_t retval; pmix_app_t *spawned_app = NULL; pmix_info_t *job_info = NULL; pmix_info_t *proc_info = NULL; int job_info_count = 0; int job_info_index = 0; int proc_info_count = 0; int proc_info_index = 0; char spawned_nsp[PMIX_MAX_NSLEN+1]; char *path_to_app = NULL; char *host_to_use = NULL; int number_of_clients = 0; int temp_counter = 0; done_flag = false; gethostname(hostn, 500); int spawned_app_argc = 0; char **scr_environ = NULL; int proc_count = 1; int node_count = 0; bool blocking_mode = true; char *node_list = NULL; bool forward_all_scr_envs = false; bool pmix_mode = false; const char *optstring = "+n:N:L:x:bB:pPvhe"; int temp_slen=0; /* todo: add arg parsing with ompi schizo */ verbose_print = false; int sleep_max = 30; const int fixed_sleep = 5; int c; while((c = getopt(argc, argv, optstring)) != -1){ switch(c){ case 'h': print_usage(argv[0]); exit(0); break; case 'n': proc_count = atoi(optarg); if(proc_count <= 0 || proc_count > 100){ printf("outside the range of allowable instances to spawn [1-100]\n"); exit(1); } if(verbose_print) { printf("proc_count = %d\n", proc_count); } break; case 'N': /* node_count = atoi(optarg); */ node_count = 1; if(verbose_print) { printf("node_count = %d\n", node_count); } break; case 'B': blocking_mode = true; sleep_max = atoi(optarg); if(sleep_max < 0){ printf("can't sleep for less than 0 seconds\n"); exit(1); } if(verbose_print){ printf("blocking mode = %x\n", blocking_mode); } break; case 'b': blocking_mode = false; if(verbose_print){ printf("blocking mode = %x\n", blocking_mode); } break; case 'L': node_list = optarg; host_to_use = node_list; if(verbose_print){ printf("node_list = '%s'\n", node_list); } break; case 'x': temp_slen = strlen(optarg); /* check if the string is the same length as 'SCR', if so compare them */ if(temp_slen == strlen(SCR_STRING)){ if(strncmp(optarg, SCR_STRING, strlen(SCR_STRING)) == 0){ /* if the string is SCR, then forward all SCR related env vars */ if(verbose_print) printf("all scr envs will be forwarded\n"); forward_all_scr_envs = true; } else{ /* handled like a normal env var */ handle_standard_env_var(optarg, &scr_environ); } } else{ /*handled like a normal env var */ handle_standard_env_var(optarg, &scr_environ); } break; case 'v': verbose_print = true; break; case 'p': pmix_mode = true; if(verbose_print){ printf("pmix_mode = %x\n", pmix_mode); } break; case 'P': pmix_mode = false; if(verbose_print){ printf("pmix_mode = %x\n", pmix_mode); } break; case 'e': experimental = true; break; case '?': printf("missing a required argument or invalid option: %x\n", optopt); print_usage(argv[0]); exit(1); break; default: printf("Unrecognized argument: %c\n", c); print_usage(argv[0]); exit(1); break; } } /* number of instances to spawn */ number_of_clients = proc_count; /* check to make sure an application was specified to launch */ if( optind < argc ){ /* if optind is < argc, it means there is at least one more arg * beyond the args for this program */ path_to_app = argv[optind]; spawned_app_argc = argc - optind; if(verbose_print) { printf("app to launch: %s @ %s:%d\n", path_to_app, __FILE__, __LINE__); } } else{ printf("program_to_spawn option was not provded\n"); print_usage(argv[0]); exit(1); } if(verbose_print){ printf("master process will spawn %d instances; app to run: %s\n\n", number_of_clients, path_to_app); printf("pmix version: %s (host: %s)\n", PMIx_Get_version(), hostn); } /* init pmix */ retval = PMIx_Init(&main_proc, NULL, 0); if(retval != PMIX_SUCCESS){ error_helper(retval, hostn, "error initializing pmix"); exit(0); } if(verbose_print){ printf("rank %d, host '%s', nspace: '%s' init'd pmix succesfully\n\n", main_proc.rank, hostn, main_proc.nspace); } /* we need to attach to a "system" PMIx server so we * can ask it to spawn applications for us. There can * only be one such connection on a node, so we will * instruct the tool library to only look for it */ int ninfo = 1; PMIX_INFO_CREATE(info, ninfo); flag = true; PMIX_INFO_LOAD(&info[0], PMIX_CONNECT_TO_SYSTEM, &flag, PMIX_BOOL); /* initialize the library and make the connection */ if (PMIX_SUCCESS != (rc = PMIx_tool_init(&tool_proc, NULL, 0 ))) { fprintf(stderr, "PMIx_tool_init failed: %d\n", rc ); exit(rc); } if (0 < ninfo) { PMIX_INFO_FREE(info, ninfo); } /* first call fence to sync all processes */ retval = fence_helper(); if(retval != PMIX_SUCCESS) { error_helper(retval, hostn, "error fencing"); exit(retval); } /* Process SCR env vars if needed */ if(forward_all_scr_envs){ parse_all_scr_envs(&scr_environ, environ); } /* finalize the env array so a NULL is in place */ finalize_array(scr_environ); /* Setup info structs to pass to this: */ /* pmix_info_t *error_info = NULL; */ /* PMIX_INFO_CREATE(error_info, 1); */ /* strncpy(error_info[0].key, PMIX_ERROR_GROUP_ABORT, PMIX_MAX_KEYLEN); error_info[0].value.type = PMIX_BOOL; error_info[0].value.data.flag = true; */ /* strncpy(error_info[0].key, PMIX_ERROR_GROUP_SPAWN, PMIX_MAX_KEYLEN); int t_val = 1; pmix_value_load(&error_info[1].value, &t_val, PMIX_BOOL); */ /*error_info[1].value.type = PMIX_BOOL; error_info[1].value.data.flag = true; */ /* strncpy(error_info[2].key, PMIX_ERROR_GROUP_GENERAL, PMIX_MAX_KEYLEN); error_info[2].value.type = PMIX_BOOL; error_info[2].value.data.flag = true; */ /* TODO: setup error handling when implemented in pmix with the * following error codes: */ /* pmix_status_t registered_codes[5]; registered_codes[0] = PMIX_ERR_JOB_TERMINATED; registered_codes[1] = PMIX_ERR_PROC_ABORTED; registered_codes[2] = PMIX_ERR_PROC_ABORTING; */ PMIx_Register_event_handler(NULL, 0, NULL, 0, errhandler_cb, errhandler_reg_callbk, (void *) NULL); /* PMIX_INFO_DESTRUCT(error_info); */ /* allocate memory to hold the spawend app struct */ PMIX_APP_CREATE(spawned_app, 1); /* maxprocs isn't documented very well, but it appears to control * how many instances of the spanwed app are created */ spawned_app->maxprocs = number_of_clients; /* set the app to run */ (void)asprintf(&spawned_app->cmd, "%s", path_to_app); /* set argv for spawned app starting with remaining argv */ spawned_app->argv = &argv[optind]; /* set the environment pointer */ spawned_app->env = scr_environ; /*--START: add all proc level infos */ /* add things to the proc level info */ if(!pmix_mode){ job_info_count++; } if(host_to_use != NULL){ proc_info_count++; } if(verbose_print){ printf("enabling debug feature for forwarding stdout/stderr\n"); proc_info_count+=2; /* add PMIX_FWD_STDOUT and PMIX_FWD_STDERR later*/ } if(experimental){ job_info_count++; } if(node_count == 1){ job_info_count++; } /*--END: add all proc level infos */ /*--START: append actual proc level info */ PMIX_INFO_CREATE(job_info, job_info_count); PMIX_INFO_CREATE(proc_info, proc_info_count); /* PMIX_VAL_set_assign(_v, _field, _val ) */ /* PMIX_VAL_set_strdup(_v, _field, _val ) */ if(host_to_use != NULL){ /* add info struct to the spawned app itself for the host */ /* old way */ strncpy(proc_info[proc_info_index].key, PMIX_HOST, PMIX_MAX_KEYLEN); //proc_info[proc_info_index].value.type = PMIX_STRING; /* set the data for host list to use */ //proc_info[proc_info_index].value.data.string = host_to_use; /* end old way */ if(verbose_print) printf("about to set host val\n"); PMIX_VAL_SET(&(proc_info[proc_info_index].value), string, host_to_use ); proc_info_index++; } if(!pmix_mode){ strncpy(job_info[job_info_index].key, PMIX_NON_PMI, PMIX_MAX_KEYLEN); if(verbose_print) printf("about to set non pmix flag\n"); PMIX_VAL_SET(&(job_info[job_info_index].value), flag, true); job_info_index++; } if(verbose_print){ strncpy(proc_info[proc_info_index].key, PMIX_FWD_STDOUT, PMIX_MAX_KEYLEN); if(verbose_print) printf("about to set stdout flag\n"); PMIX_VAL_SET(&(proc_info[proc_info_index].value), flag, true ); proc_info_index++; strncpy(proc_info[proc_info_index].key, PMIX_FWD_STDERR, PMIX_MAX_KEYLEN); if(verbose_print) printf("about to set stderr flag\n"); PMIX_VAL_SET(&(proc_info[proc_info_index].value), flag, true ); proc_info_index++; } if(experimental){ printf("attempting to perform experiment\n"); bool local_flag = true; PMIX_INFO_LOAD(&job_info[job_info_index], PMIX_NOTIFY_COMPLETION, &local_flag, PMIX_BOOL); job_info_index++; } if(node_count == 1){ strncpy(job_info[job_info_index].key, PMIX_PPR, PMIX_MAX_KEYLEN); PMIX_VAL_SET(&(job_info[job_info_index].value), string, "1:n"); job_info_index++; } /*--END: append actual proc level info */ /* sanity check to make sure we covered all the info structs */ if(proc_info_index != proc_info_count ){ printf("bug: mismatch with appending proc info\n"); exit(1); } if(job_info_index != job_info_count){ printf("bug: mismatch with appending job info\n"); exit(1); } /* TODO: TEST PMIX_NOTIFY_COMPLETION WHEN IT'S IMPLEMENTED IN PMIX */ /* fill in job_info */ /* strncpy(job_info[0].key, PMIX_TIMEOUT, PMIX_MAX_KEYLEN); job_info[0].value.type = PMIX_INT; job_info[0].value.data.integer = 10; */ /* strncpy(job_info[0].key, PMIX_NOTIFY_COMPLETION, PMIX_MAX_KEYLEN); job_info[0].value.type = PMIX_BOOL; job_info[0].value.data.flag = true; */ /*strncpy(spawned_app->info[0].key, PMIX_DISPLAY_MAP, PMIX_MAX_KEYLEN); job_info[0].value.type = PMIX_BOOL; job_info[0].value.data.flag = true;*/ /* TODO: TEST PMIX_NOTIFY_COMPLETION WHEN IT'S IMPLEMENTED IN PMIX */ spawned_app->info = proc_info; spawned_app->ninfo = proc_info_count; if(verbose_print){ printf("proc level info count: %d\n", proc_info_count); } /* call spawn */ retval = PMIx_Spawn(job_info, job_info_count, spawned_app, 1, spawned_nsp); if(verbose_print) { printf("rank %d (host %s) just called spawn; spawned nspace: %s, retval:%d\n", main_proc.rank, hostn, spawned_nsp, retval); } if(retval != PMIX_SUCCESS){ error_helper(retval, hostn, "error with spawn"); goto done; } /* TODO: TEMPORARY WORKAROUND TO WAIT FOR A SPAWNED PROCESS */ if(blocking_mode){ sleep(fixed_sleep); /* wait until app completes: */ while(!done_flag){ sleep(fixed_sleep); temp_counter++; if(temp_counter*fixed_sleep >= sleep_max) { if(verbose_print) printf("broke out early\n"); break; } } if(verbose_print){ if(done_flag == true) { printf("done_flag was set to true!\n"); } } } done: /* fence first */ retval = fence_helper(); if(retval != PMIX_SUCCESS){ if(verbose_print) printf("error fencing, finalize may fail ! \n"); } /* finalize */ PMIx_Deregister_event_handler(_g_errhandler_ref, NULL, NULL); if(verbose_print){ fprintf(stdout, "spawn master process (rank %d) (host %s) finalizing\n", main_proc.rank, hostn); } /* clean up pmix */ retval = PMIx_tool_finalize(); if(retval == PMIX_SUCCESS) { if(verbose_print){ printf("spawn master process %d finalize success\n\n", main_proc.rank); } } else { printf("spawn master process %d pmix_finalize FAILURE: %d\n\n", main_proc.rank, retval); } retval = PMIx_Finalize(NULL, 0); fflush(stdout); /* cleanup before returning */ PMIX_INFO_FREE(job_info, job_info_count); spawned_app->argv = NULL; PMIX_APP_FREE(spawned_app, 1); if(verbose_print) printf("%s exiting cleanly :)\n", argv[0]); return 0; }