/* * Execute nsupdate.pl with IP and HIT given as environment variables */ int run_nsupdate(char *ips, char *hit, int start) { struct sigaction act; pid_t child_pid; HIP_DEBUG("Updating dns records...\n"); act.sa_handler = sig_chld; /* We don't want to block any other signals */ sigemptyset(&act.sa_mask); /* * We're only interested in children that have terminated, not ones * which have been stopped (eg user pressing control-Z at terminal) */ act.sa_flags = SA_NOCLDSTOP | SA_RESTART; /* Make the handler effective */ if (sigaction(SIGCHLD, &act, NULL) < 0) { HIP_PERROR("sigaction"); return ERR; } /* Let us fork to execute nsupdate as a separate process */ child_pid=fork(); if (child_pid<0) { HIP_PERROR("fork"); return ERR; } else if (child_pid == 0) {// CHILD char start_str[2]; #if 0 /* Close open sockets since FD_CLOEXEC was not used */ close_all_fds_except_stdout_and_stderr(); #endif snprintf(start_str, sizeof(start_str), "%i", start); char *env_ips = make_env(VAR_IPS, ips); char *env_hit = make_env(VAR_HIT, hit); char *env_start = make_env(VAR_START, start_str); char *cmd[] = { NSUPDATE_ARG0, NULL }; char *env[] = { env_ips, env_hit, env_start, NULL }; HIP_DEBUG("Executing %s with %s; %s; %s\n", NSUPDATE_PL, env_hit, env_ips, env_start); execve (NSUPDATE_PL, cmd, env); /* Executed only if error */ HIP_PERROR("execve"); exit(1); // just in case } else {// PARENT /* We execute waitpid in SIGCHLD handler */ return OK; } }
int main(int argc, char *argv[]) { int fd; int i; void *mlx; if (argc >= 2) { mlx = mlx_init(); i = 0; while (++i < argc) { if ((fd = open(argv[i], O_RDONLY)) == -1) perror(argv[i]); else make_env(mlx, argv[i], fd); close(fd); } check_env_number(); printf("start loop\n"); mlx_loop(mlx); } else { ft_putstr("usage: rt_v1 [files...]\n"); return (-1); } return (0); }
void register_procs(void) { root_env = make_env(NIL); while (proc_descs) { proc_descriptor_t *desc = proc_descs; obj_t *library = find_library_str(desc->pd_libdesc->ld_namespec); (*desc->pd_binder)(desc->pd_proc, library, desc->pd_name); proc_descs = desc->pd_next; } AUTO_ROOT(value, NIL); AUTO_ROOT(new_env, NIL); AUTO_ROOT(old_env, NIL); while (alias_descs) { alias_descriptor_t *desc = alias_descs; const wchar_t *old_namespec = desc->ad_old_libdesc->ld_namespec; obj_t *old_library = find_library_str(old_namespec); old_env = library_env(old_library); obj_t *old_sym = make_symbol_from_C_str(desc->ad_old_name); obj_t *binding = env_lookup(old_env, old_sym); value = binding_value(binding); const wchar_t *new_namespec = desc->ad_new_libdesc->ld_namespec; obj_t *new_library = find_library_str(new_namespec); new_env = library_env(new_library); obj_t *new_symbol = make_symbol_from_C_str(desc->ad_new_name); env_bind(new_env, new_symbol, BT_LEXICAL, M_IMMUTABLE, value); alias_descs = desc->ad_next; } POP_FUNCTION_ROOTS(); }
static void handle_op_message(uint32_t in_type, struct strbuf *in, struct strbuf *out) { struct op *op = get_local_op(in_type); struct strbuf in_plain = STRBUF_INIT, out_plain = STRBUF_INIT; char *envp[16]; if (!op) fatal("operation %x does not exist", in_type); debug("running op: %s", op->name); /* TEMPORARY */ if (!client_username()) fatal("unathenticated"); gss_decipher(in, &in_plain); make_env(envp, "LANG", "C", "CEO_USER", client_username(), "CEO_CONFIG_DIR", config_dir, NULL); char *argv[] = { op->path, NULL, }; if (spawnvemu(op->path, argv, envp, &in_plain, &out_plain, 0, op->user)) fatal("child %s failed", op->path); gss_encipher(&out_plain, out); if (!out->len) fatal("no response from op"); free_env(envp); strbuf_release(&in_plain); strbuf_release(&out_plain); }
static int eval_driver(const test_case_descriptor_t *tc) { int err_count = 0; #if TEST_TRACE printf("%s:%d eval %ls\n", tc->tcd_file, tc->tcd_lineno, tc->tcd_input); #endif instream_t *in = make_string_instream(tc->tcd_input, wcslen(tc->tcd_input)); AUTO_ROOT(expr, NIL); AUTO_ROOT(value, NIL); AUTO_ROOT(env, make_env(library_env(r6rs_library()))); while (read_stream(in, &expr)) value = eval(expr, env); /* Compare the value of the last expression. */ const size_t out_size = 100; wchar_t actual[out_size + 1]; outstream_t *out = make_string_outstream(actual, out_size); princ(value, out); delete_outstream(out); if (wcscmp(actual, tc->tcd_expected)) { printf("%s:%d FAIL eval test\n", tc->tcd_file, tc->tcd_lineno); printf(" input = %ls\n", tc->tcd_input); printf(" actual = %ls\n", actual); printf(" expected = %ls\n", tc->tcd_expected); printf("\n"); err_count++; } POP_FUNCTION_ROOTS(); return err_count; }
int main(int argc, char **argv) { // Debug flags debug_gc = getEnvFlag("MINILISP_DEBUG_GC"); always_gc = getEnvFlag("MINILISP_ALWAYS_GC"); // Memory allocation memory = alloc_semispace(); // Constants and primitives Symbols = Nil; void *root = NULL; DEFINE2(env, expr); *env = make_env(root, &Nil, &Nil); define_constants(root, env); define_primitives(root, env); // The main loop printf("%s", ">"); for (;;) { *expr = read_expr(root); if (!*expr) return 0; if (*expr == Cparen) error("Stray close parenthesis"); if (*expr == Dot) error("Stray dot"); print(eval(root, env, expr)); printf("\n%s", ">"); } }
Env *get_global_environment() { if (global == 0) { global = make_env(0); } return global; }
int main(int argc, char *argv[]) { Cell env = make_env(); for (int i = 1; i < argc; i++) { FILE* file = fopen(argv[i], "r"); while (peek(file) != EOF) { eval(read(file), env); } } }
int main() { object_t o; init(); o = make_env(scheme_null,scheme_null); printf("object->type: %s\n",type_name(o)); printf("object->type: %d\n",type_size(o)); return 0; }
OBJ env_null() { OBJ ret; int i; ret = make_env(OBJ_NULL,OBJ_NULL); for(i=0; i<sizeof(core_syntax)/sizeof(core_syntax[0]); i++) { define(obj_make_symbol(core_syntax[i].value.core.name),&core_syntax[i],ret); } return ret; }
Env *link(const wchar_t *name, const Value *value, Env *env) { Env *new_env = 0; /* we use put_binding() here and not bind(), because we * want to shadow any existing binding of `name'. */ new_env = make_env(env); put_binding(new_env, name, value); return new_env; }
// Returns a newly created environment frame. static Obj *push_env(void *root, Obj **env, Obj **vars, Obj **vals) { DEFINE3(map, sym, val); *map = Nil; for (; (*vars)->type == TCELL; *vars = (*vars)->cdr, *vals = (*vals)->cdr) { if ((*vals)->type != TCELL) error("Cannot apply function: number of argument does not match"); *sym = (*vars)->car; *val = (*vals)->car; *map = acons(root, sym, val, map); } if (*vars != Nil) *map = acons(root, vars, vals, map); return make_env(root, map, env); }
int main() { // Debug flags debug_gc = getEnvFlag("MINILISP_DEBUG_GC"); always_gc = getEnvFlag("MINILISP_ALWAYS_GC"); // Memory allocation memory = (void *)memory1; // Init constants Obj trueObj, nilObj, dotObj, cparenObj; True = &trueObj; Nil = &nilObj; Dot = &dotObj; Cparen = &cparenObj; True->type = TTRUE; Nil->type = TNIL; Dot->type = TDOT; Cparen->type = TCPAREN; // Constants and primitives Symbols = Nil; void *root = NULL; DEFINE2(env, expr); *env = make_env(root, &Nil, &Nil); define_constants(root, env); define_primitives(root, env); // The main loop for (;;) { setjmp(&jmpbuf); *expr = read_expr(root); if (!*expr) return 0; if (*expr == Cparen) error("Stray close parenthesis"); if (*expr == Dot) error("Stray dot"); print(eval(root, env, expr)); printf("\n"); } }
static OBJ analyze_lambda(const struct analyze_t *arg) { struct analyze_t new_arg; OBJ newenv; OBJ body; OBJ p,q; OBJ formals; OBJ tmp; new_arg = *arg; newenv = make_env(new_arg.env,OBJ_NULL); p = car(new_arg.sexp); q = OBJ_NULL; formals = OBJ_NULL; while(obj_pairp(p)) /* (lambda (<variable1> ...) <body>) */ { tmp = cons(define(car(p),OBJ_VOID,newenv),OBJ_NULL); if(formals == OBJ_NULL) formals = tmp; else cdr(q) = tmp; q = tmp; p = cdr(p); } if(!nullp(p)) { if(formals != OBJ_NULL) /* (lambda (<variable1> ... <variablen> . <variablen+1>) <body>) */ cdr(q) = define(p,OBJ_VOID,newenv); else formals = define(p,OBJ_VOID,newenv); /* (lambda <variable> <body>) */ } new_arg.sexp = cdr(new_arg.sexp); new_arg.env = newenv; new_arg.tail = 1; body = analyze_begin(&new_arg); return obj_make_lambda(newenv,formals,body); }
obj_t *apply_procedure(obj_t *proc, obj_t *args) { PUSH_ROOT(proc); PUSH_ROOT(args); AUTO_ROOT(body, procedure_body(proc)); if (procedure_is_C(proc)) { obj_t *env = F_ENV; if (!procedure_is_special_form(proc)) env = procedure_env(proc); GOTO_FRAME(make_short_frame, (C_procedure_t *)body, args, env); } AUTO_ROOT(new_env, make_env(procedure_env(proc))); AUTO_ROOT(formals, procedure_args(proc)); AUTO_ROOT(actuals, args); while (!is_null(formals) || !is_null(actuals)) { if (is_null(formals)) { printf_unchecked("calling %O\n", proc); RAISE("too many args"); } obj_t *formal, *actual; if (is_pair(formals)) { if (is_null(actuals)) { printf_unchecked("proc=%O\n", proc); RAISE("not enough args"); } formal = pair_car(formals); formals = pair_cdr(formals); actual = pair_car(actuals); actuals = pair_cdr(actuals); } else { formal = formals; actual = actuals; formals = actuals = NIL; } env_bind(new_env, formal, BT_LEXICAL, M_MUTABLE, actual); } GOTO(b_eval_sequence, body, new_env); }
static int eval_driver(const test_case_descriptor_t *tc) { int err_count = 0; #if TEST_TRACE printf("%s:%d eval %ls\n", tc->tcd_file, tc->tcd_lineno, tc->tcd_input); #endif static const char_t test_source[] = L"(lambda (port loop env) \n" L" (set! loop (lambda (form last) \n" L" (if (eof-object? form) \n" L" last \n" L" (loop (read port) (eval form env))))) \n" L" (loop (read port) #f))"; collect_garbage(); obj_t test_proc; { obj_t root_env = root_environment(); obj_t tsrc_str = make_string_from_C_str(test_source); obj_t eval_sym = make_symbol_from_C_str(L"eval"); obj_t read_sym = make_symbol_from_C_str(L"read"); obj_t osip_sym = make_symbol_from_C_str(L"open-string-input-port"); obj_t renv_sym = make_symbol_from_C_str(L"root-environment"); /* * (eval (read (open-string-input-port "...")) * (root-environment)) */ obj_t form1 = MAKE_LIST(eval_sym, MAKE_LIST(read_sym, MAKE_LIST(osip_sym, tsrc_str)), MAKE_LIST(renv_sym)); test_proc = core_eval(form1, root_env); // obj_t's are invalidated. core_eval may have GC'd. } obj_t port; { obj_t root_env = root_environment(); obj_t input_str = make_string_from_C_str(tc->tcd_input); obj_t osip_sym = make_symbol_from_C_str(L"open-string-input-port"); port = core_eval(MAKE_LIST(osip_sym, input_str), root_env); } obj_t root_env = root_environment(); obj_t test_env = make_env(root_env); obj_t test_args = MAKE_LIST(test_env, FALSE_OBJ, port); obj_t cont = make_cont5(c_apply_proc, EMPTY_LIST, root_env, test_proc, EMPTY_LIST); obj_t hname = make_symbol_from_C_str(L"test-handler"); obj_t handler = make_raw_procedure(c_test_handler, hname, root_env); obj_t value = core_eval_cont(cont, test_args, handler); /* Compare the value of the last expression. */ const size_t out_size = 100; wchar_t actual[out_size + 1]; outstream_t *out = make_string_outstream(actual, out_size); princ(value, out); delete_outstream(out); if (wcscmp(actual, tc->tcd_expected)) { printf("%s:%d FAIL eval test\n", tc->tcd_file, tc->tcd_lineno); printf(" input = %ls\n", tc->tcd_input); printf(" actual = %ls\n", actual); printf(" expected = %ls\n", tc->tcd_expected); printf("\n"); err_count++; } return err_count; }
// ------------------------------------------------------------------- // main function: // Compute the surface envelope // void EncQuadBezier::compute_enclosure() { //int tr[4][4][2]; // translation from xy to ccw int need_subdiv; // allocate the memory storing the results o_enc = alloc_mem_db(d1*d1*DIM); i_enc = alloc_mem_db(d1*d1*DIM); cralong = (int *) allocate (sizeof (int) * segu*segv ); // compute the bilinear envelope make_env(); // determine the support points and normals make_sup(); // average normals along the boundary between two neighboring // patch. (there is no affect for C1 surfaces) // //average_nor_PN(fp, sup_nor[fc], tr); // temp hack!!: use PN average Norm // compute and store intersection lambdas in w's need_subdiv = make_lam(); #ifdef FIX_BY_SUBDIVIDE if(need_subdiv) { int sizeu = dg*2+1; // int sizev = dg*2+1; // REAL bb[sizeu*sizev][DIM]; // space for subdivision // subdivide the patch for(i=0;i<d1;i++) { for(j=0;j<d1;j++) { Vcopy( get_bb[i][j], bb[(i*2)*sizev+(j*2)]); } } RSubDiv(bb, 2, dg, dg, sizeu-1, sizev-1); /* for(i=0;i<sizeu;i++) for(j=0;j<sizev;j++) { printf("v: %f %f %f \n", bb[i*sizev+j][0], bb[i*sizev+j][1], bb[i*sizev+j][2]); } */ // si and sj are the starting (i,j) position for subpatches for(si = 0; si<=dg; si+=dg) for(sj = 0; sj<=dg; sj+=dg) { int sub_fc; // where to place this new subdivied patch // use the first subdivided patch to overwrite // the original patch if(si==0 && sj==0) sub_fc = fc; else { sub_fc = new_patch(FNum, Face, fc); FNum++; printf("Add a new face %d, now %d faces\n", sub_fc, FNum); } for(i=0;i<d1;i++) for(j=0;j<d1;j++) Vcopy(bb[(i+si)*sizev+(j+sj)], &(Face[sub_fc].buf[(i*d1+j)*DIM])); } // increase number of patches by 3 object[index].patch_num +=3; fc --; // move back one spot to recompute the subdivided one printf("fc = %d\n", fc); // add four patches into the array // disable the current patch (quick way to delete) } #endif // this should after global lambda fix make_tri(); enc_computed = true; }
static SCM eval (SCM x, SCM env) { SCM mx; SCM proc = SCM_UNDEFINED, args = SCM_EOL; unsigned int argc; loop: SCM_TICK; mx = SCM_MEMOIZED_ARGS (x); switch (SCM_I_INUM (SCM_CAR (x))) { case SCM_M_SEQ: eval (CAR (mx), env); x = CDR (mx); goto loop; case SCM_M_IF: if (scm_is_true (EVAL1 (CAR (mx), env))) x = CADR (mx); else x = CDDR (mx); goto loop; case SCM_M_LET: { SCM inits = CAR (mx); SCM new_env; int i; new_env = make_env (VECTOR_LENGTH (inits), SCM_UNDEFINED, env); for (i = 0; i < VECTOR_LENGTH (inits); i++) env_set (new_env, 0, i, EVAL1 (VECTOR_REF (inits, i), env)); env = new_env; x = CDR (mx); goto loop; } case SCM_M_LAMBDA: RETURN_BOOT_CLOSURE (mx, env); case SCM_M_CAPTURE_ENV: { SCM locs = CAR (mx); SCM new_env; int i; new_env = make_env (VECTOR_LENGTH (locs), SCM_BOOL_F, env); for (i = 0; i < VECTOR_LENGTH (locs); i++) { SCM loc = VECTOR_REF (locs, i); int depth, width; depth = SCM_I_INUM (CAR (loc)); width = SCM_I_INUM (CDR (loc)); env_set (new_env, 0, i, env_ref (env, depth, width)); } env = new_env; x = CDR (mx); goto loop; } case SCM_M_QUOTE: return mx; case SCM_M_CAPTURE_MODULE: return eval (mx, scm_current_module ()); case SCM_M_APPLY: /* Evaluate the procedure to be applied. */ proc = EVAL1 (CAR (mx), env); /* Evaluate the argument holding the list of arguments */ args = EVAL1 (CADR (mx), env); apply_proc: /* Go here to tail-apply a procedure. PROC is the procedure and * ARGS is the list of arguments. */ if (BOOT_CLOSURE_P (proc)) { prepare_boot_closure_env_for_apply (proc, args, &x, &env); goto loop; } else return scm_apply_0 (proc, args); case SCM_M_CALL: /* Evaluate the procedure to be applied. */ proc = EVAL1 (CAR (mx), env); argc = scm_ilength (CDR (mx)); mx = CDR (mx); if (BOOT_CLOSURE_P (proc)) { prepare_boot_closure_env_for_eval (proc, argc, mx, &x, &env); goto loop; } else { SCM *argv; unsigned int i; argv = alloca (argc * sizeof (SCM)); for (i = 0; i < argc; i++, mx = CDR (mx)) argv[i] = EVAL1 (CAR (mx), env); return scm_call_n (proc, argv, argc); } case SCM_M_CONT: return scm_i_call_with_current_continuation (EVAL1 (mx, env)); case SCM_M_CALL_WITH_VALUES: { SCM producer; SCM v; producer = EVAL1 (CAR (mx), env); /* `proc' is the consumer. */ proc = EVAL1 (CDR (mx), env); v = scm_call_0 (producer); if (SCM_VALUESP (v)) args = scm_struct_ref (v, SCM_INUM0); else args = scm_list_1 (v); goto apply_proc; } case SCM_M_LEXICAL_REF: { SCM pos; int depth, width; pos = mx; depth = SCM_I_INUM (CAR (pos)); width = SCM_I_INUM (CDR (pos)); return env_ref (env, depth, width); } case SCM_M_LEXICAL_SET: { SCM pos; int depth, width; SCM val = EVAL1 (CDR (mx), env); pos = CAR (mx); depth = SCM_I_INUM (CAR (pos)); width = SCM_I_INUM (CDR (pos)); env_set (env, depth, width, val); return SCM_UNSPECIFIED; } case SCM_M_BOX_REF: { SCM box = mx; return scm_variable_ref (EVAL1 (box, env)); } case SCM_M_BOX_SET: { SCM box = CAR (mx), val = CDR (mx); return scm_variable_set_x (EVAL1 (box, env), EVAL1 (val, env)); } case SCM_M_RESOLVE: if (SCM_VARIABLEP (mx)) return mx; else { SCM var; var = scm_sys_resolve_variable (mx, env_tail (env)); scm_set_cdr_x (x, var); return var; } case SCM_M_CALL_WITH_PROMPT: { struct scm_vm *vp; SCM k, handler, res; scm_i_jmp_buf registers; scm_t_ptrdiff saved_stack_depth; k = EVAL1 (CAR (mx), env); handler = EVAL1 (CDDR (mx), env); vp = scm_the_vm (); saved_stack_depth = vp->stack_top - vp->sp; /* Push the prompt onto the dynamic stack. */ scm_dynstack_push_prompt (&SCM_I_CURRENT_THREAD->dynstack, SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY, k, vp->stack_top - vp->fp, saved_stack_depth, vp->ip, ®isters); if (SCM_I_SETJMP (registers)) { /* The prompt exited nonlocally. */ scm_gc_after_nonlocal_exit (); proc = handler; args = scm_i_prompt_pop_abort_args_x (vp, saved_stack_depth); goto apply_proc; } res = scm_call_0 (eval (CADR (mx), env)); scm_dynstack_pop (&SCM_I_CURRENT_THREAD->dynstack); return res; } default: abort (); } }
static int psgi_handler(request_rec *r) { SV *app, *env, *res; psgi_dir_config *c; int rc; psgi_apps_t *psgi_apps; int locked = 0; if (strcmp(r->handler, PSGI_HANDLER_NAME)) { return DECLINED; } rc = apr_global_mutex_lock(psgi_mutex); if (rc != APR_SUCCESS) { ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_NOTICE, 0, r->server, "apr_global_mutex_lock() failed"); rc = HTTP_INTERNAL_SERVER_ERROR; goto exit; } locked = 1; c = (psgi_dir_config *) ap_get_module_config(r->per_dir_config, &psgi_module); if (c->file == NULL) { ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_NOTICE, 0, r->server, "PSGIApp not configured"); return DECLINED; } PERL_SET_CONTEXT(perlinterp); ENTER; SAVETMPS; psgi_apps = (psgi_apps_t *)apr_shm_baseaddr_get(psgi_shm); app = apr_hash_get(psgi_apps->apps, c->file, APR_HASH_KEY_STRING); if (app == NULL) { app = load_psgi(r->pool, c->file); if (app == NULL) { server_error(r, "%s had compilation errors.", c->file); rc = HTTP_INTERNAL_SERVER_ERROR; goto exit; } SvREFCNT_inc(app); apr_hash_set(psgi_apps->apps, c->file, APR_HASH_KEY_STRING, app); } env = make_env(r, c); res = run_app(r, app, env); if (res == NULL) { server_error(r, "invalid response"); rc = HTTP_INTERNAL_SERVER_ERROR; goto exit; } rc = output_response(r, res); SvREFCNT_dec(res); exit: if (locked) { apr_global_mutex_unlock(psgi_mutex); } FREETMPS; LEAVE; return rc; }