int main(int argc, char* argv[]) { init_symbol_table(); init_builtin_types(); init_global_env(); init_singleton_objects(); init_primitive_procs(); struct vm_context *global_ctx = make_vm_context(NULL, NULL, global_env); INC_REF(&global_ctx->obj); struct vm_context **pctx = &global_ctx; struct object *value; value = load("prelude.scm", pctx); YIELD_OBJ(value); init_compiler(); value = load("stage2.scm", pctx); YIELD_OBJ(value); struct vm_context *repl_ctx; repl_ctx = make_vm_context(NULL, make_stack(1024), make_environment(global_env)); INC_REF(&repl_ctx->obj); pctx = &repl_ctx; struct object *ret = env_lookup(global_env, "initial-repl"); assert(ret->type->code == PROCEDURE_TYPE); struct procedure *repl = container_of(ret, struct procedure, obj); apply_and_run(repl, NIL, pctx); return 0; }
int main() { Environment *env; pthread_t self; pthread_t child; int ret; self = pthread_self (); env = make_environment (); /* the parent thread uses sproc to create the new thread, passing a pointer to card as an argument */ ret = pthread_create (&child, NULL, entry, (void *) env); if (ret == -1) { perror ("pthread_create failed"); exit (-1); } loop_and_count (self, env); printf ("Parent done looping.\n"); ret = pthread_join (child, NULL); if (ret == -1) { perror ("pthread_join failed"); exit (-1); } check_array (env); return 0; }
void init(void) { the_empty_list = alloc_object(); the_empty_list->type = THE_EMPTY_LIST; false = alloc_object(); false->type = BOOLEAN; false->data.boolean.value = 0; true = alloc_object(); true->type = BOOLEAN; true->data.boolean.value = 1; symbol_table = the_empty_list; quote_symbol = make_symbol("quote"); define_symbol = make_symbol("define"); set_symbol = make_symbol("set!"); ok_symbol = make_symbol("ok"); if_symbol = make_symbol("if"); begin_symbol = make_symbol("begin"); cond_symbol = make_symbol("cond"); else_symbol = make_symbol("else"); let_symbol = make_symbol("let"); lambda_symbol = make_symbol("lambda"); and_symbol = make_symbol("and"); or_symbol = make_symbol("or"); eof_object = alloc_object(); eof_object->type = EOF_OBJECT; the_empty_environment = the_empty_list; the_global_environment = make_environment(); }
Environment fixed_environment(double canopy_openness, double height_max) { std::vector<double> x = {0, height_max/2.0, height_max}; std::vector<double> y = {canopy_openness, canopy_openness, canopy_openness}; interpolator::Interpolator env; env.init(x, y); Parameters<FF16_Strategy> p; Environment ret(make_environment(p)); ret.light_environment = env; return ret; }
typename result<convert_farm(LHS, RHS, State, BackEnd)>::type operator()(LHS const& lhs, RHS const& rhs, State& s, BackEnd const& be) const { convert<tag::process_network_> callee; // Pre-compute environment to not copy it twice BOOST_AUTO(lhe, callee(lhs,s,be) ); BOOST_AUTO(rhe, callee(rhs,lhe,be)); return make_environment ( join_network(lhe.network(),rhe.network()) , rhe.next_pid() ); }
int main(int argc, char **argv) { int i; environment *env = make_environment(); for(i = 1; i < argc; ++i){ FILE *fp = fopen(argv[i], "r"); if(!fp) file_error(argv[i]); blazeit(fp, env); fclose(fp); } blazeit(stdin, env); free_environment(env); return 0; }
/*! * Creates and initializes a new environment struct for the global environment. * The global environment is the root of all other environments, and has a * couple of unique characteristics. First, it has no parent environment * (obvious, since it's the root of all environments). Second, all built-in * functions are bound into this environment. */ Environment * init_global_environment(void) { NativeLambdaBinding *binding; assert(global_env == NULL); global_env = make_environment(NULL); binding = native_lambdas; while (binding->name != NULL) { create_binding(global_env, binding->name, make_native_lambda(global_env, binding->func)); binding++; } return global_env; }
environment* extend_environment(object* vars, object* vals, environment* enclosing_environment) { environment* env = make_environment(enclosing_environment); object* var, *val; while (!is_empty_list(vars)) { if(is_empty_list(vals)){ fprintf(stderr, "too much arguments\n"); exit(1); } var = car(vars); val = car(vals); define_variable(var, val, env); vars = cdr(vars); vals = cdr(vals); } return env; }
static int win_spawn(const char *cmd, const char **argv, const char **envp, const char *cwd, HANDLE handles[3], int background, int shell) { char *args = make_command_line(shell, cmd, argv); char *env = make_environment(envp); char *program = shell ? NULL : find_program(cmd); STARTUPINFO si; PROCESS_INFORMATION pi; BOOL result; DWORD exitcode; int i; if (!shell) { G_debug(3, "win_spawn: program = %s", program); if (!program) { G_free(args); G_free(env); return -1; } } G_debug(3, "win_spawn: args = %s", args); memset(&si, 0, sizeof(si)); si.cb = sizeof(si); si.dwFlags |= STARTF_USESTDHANDLES; si.hStdInput = handles[0]; si.hStdOutput = handles[1]; si.hStdError = handles[2]; result = CreateProcess( program, /* lpApplicationName */ args, /* lpCommandLine */ NULL, /* lpProcessAttributes */ NULL, /* lpThreadAttributes */ 1, /* bInheritHandles */ 0, /* dwCreationFlags */ env, /* lpEnvironment */ cwd, /* lpCurrentDirectory */ &si, /* lpStartupInfo */ &pi /* lpProcessInformation */ ); G_free(args); G_free(env); G_free(program); if (!result) { G_warning(_("CreateProcess() failed: error = %d"), GetLastError()); return -1; } CloseHandle(pi.hThread); for (i = 0; i < 3; i++) if (handles[i] != INVALID_HANDLE_VALUE) CloseHandle(handles[i]); if (!background) { WaitForSingleObject(pi.hProcess, INFINITE); if (!GetExitCodeProcess(pi.hProcess, &exitcode)) return -1; CloseHandle(pi.hProcess); return (int) exitcode; } CloseHandle(pi.hProcess); return pi.dwProcessId; }
Value * evaluate(Environment *env, Value *expr) { EvaluationContext *ctx; Value *temp, *result; Value *operator; Value *operand_val, *operand_cons; Value *operands, *operands_end, *nil_value; int num_operands; /* Set up a new evaluation context and record our local variables, so that * the garbage-collector can see any temporary values we use. */ ctx = push_new_evalctx(env, expr); evalctx_register(&temp); evalctx_register(&result); evalctx_register(&operator); evalctx_register(&operand_val); evalctx_register(&operand_cons); evalctx_register(&operands); evalctx_register(&operands_end); evalctx_register(&nil_value); #ifdef VERBOSE_EVAL printf("\nEvaluating expression: "); print_value(stdout, expr); printf("\n"); #endif /* If this is a special form, evaluate it. Otherwise, this function will * simply pass the input through to the result. */ result = eval_special_form(env, expr); if (result != expr) goto Done; /* It was a special form. */ /* * If the input is an atom, we need to resolve it to a value, using the * current environment. */ if (is_atom(expr)) { /* Treat the atom as a name - resolve it to a value. */ result = resolve_binding(env, expr->string_val); if (result == NULL) { result = make_error("couldn't resolve name \"%s\" to a value!", expr->string_val); } goto Done; } /* * If the input isn't an atom and isn't a cons-pair, then assume it's a * value that doesn't need evaluating, and just return it. */ if (!is_cons_pair(expr)) { result = expr; goto Done; } /* * Evaluate operator into a lambda expression. */ temp = get_car(expr); operator = evaluate(env, temp); if (is_error(operator)) { result = operator; goto Done; } if (!is_lambda(operator)) { result = make_error("operator is not a valid lambda expression"); goto Done; } #ifdef VERBOSE_EVAL printf("Operator: "); print_value(stdout, operator); printf("\n"); #endif /* * Evaluate each operand into a value, and build a list up of the values. */ #ifdef VERBOSE_EVAL printf("Starting evaluation of operands.\n"); #endif num_operands = 0; operands_end = NULL; operands = nil_value = make_nil(); temp = get_cdr(expr); while (is_cons_pair(temp)) { Value *raw_operand; num_operands++; /* This is the raw unevaluated value. */ raw_operand = get_car(temp); /* Evaluate the raw input into a value. */ operand_val = evaluate(env, raw_operand); if (is_error(operand_val)) { result = operand_val; goto Done; } operand_cons = make_cons(operand_val, nil_value); if (operands_end != NULL) set_cdr(operands_end, operand_cons); else operands = operand_cons; operands_end = operand_cons; temp = get_cdr(temp); } /* * Apply the operator to the operands, to generate a result. */ if (operator->lambda_val->native_impl) { /* Native lambdas don't need an environment created for them. Rather, * we just pass the list of arguments to the native function, and it * processes the arguments as needed. */ result = operator->lambda_val->func(num_operands, operands); } else { /* These don't need registered on the explicit stack. (I hope.) */ Environment *child_env; Value *body_iter; /* It's an interpreted lambda. Create a child environment, then * populate it with values based on the lambda's argument-specification * and the input operands. */ child_env = make_environment(operator->lambda_val->parent_env); temp = bind_arguments(child_env, operator->lambda_val, operands); if (is_error(temp)) { result = temp; goto Done; } /* Evaluate each expression in the lambda, using the child environment. * The result of the last expression is the result of the lambda. */ body_iter = operator->lambda_val->body; do { result = evaluate(child_env, get_car(body_iter)); body_iter = get_cdr(body_iter); } while (!is_nil(body_iter)); } Done: #ifdef VERBOSE_EVAL printf("Result: "); print_value(stdout, result); printf("\n\n"); #endif /* Record the result and then perform garbage-collection. */ pop_evalctx(result); collect_garbage(); return result; }
object *environment_proc(object *arguments) { return make_environment(); }
void load_command(regcontext_t *REGS, int run, int fd, char *cmd_name, u_short *param, char **argv, char **envs) { struct exehdr hdr; int min_memory, max_memory; int biggest; int envseg; char *psp; int text_size = 0; int i; int start_segment; int exe_file; char *p; int used, n; char *fcb; int newpsp; u_short init_cs, init_ip, init_ss, init_sp, init_ds, init_es; if (envs) envseg = make_environment(cmd_name, envs); else envseg = env_s[curpsp]; /* read exe header */ if (read (fd, &hdr, sizeof hdr) != sizeof hdr) fatal ("can't read header\n"); /* proper header ? */ if (hdr.magic == 0x5a4d) { exe_file = 1; text_size = (hdr.size - 1) * 512 + hdr.bytes_on_last_page - hdr.hdr_size * 16; min_memory = hdr.min_memory + (text_size + 15)/16; max_memory = hdr.max_memory + (text_size + 15)/16; } else { exe_file = 0; min_memory = 64 * (1024/16); max_memory = 0xffff; } /* alloc mem block */ pspseg = mem_alloc(max_memory, 1, &biggest); if (pspseg == 0) { if (biggest < min_memory || (pspseg = mem_alloc(biggest, 1, NULL)) == 0) fatal("not enough memory: needed %d have %d\n", min_memory, biggest); max_memory = biggest; } mem_change_owner(pspseg, pspseg); mem_change_owner(envseg, pspseg); /* create psp */ newpsp = curpsp + 1; psp_s[newpsp] = pspseg; env_s[newpsp] = envseg; psp = (char *)MAKEPTR(pspseg, 0); memset(psp, 0, 256); psp[0] = 0xcd; psp[1] = 0x20; *(u_short *)&psp[2] = pspseg + max_memory; /* * this is supposed to be a long call to dos ... try to fake it */ psp[5] = 0xcd; psp[6] = 0x99; psp[7] = 0xc3; *(u_short *)&psp[0x16] = psp_s[curpsp]; psp[0x18] = 1; psp[0x19] = 1; psp[0x1a] = 1; psp[0x1b] = 0; psp[0x1c] = 2; memset(psp + 0x1d, 0xff, 15); *(u_short *)&psp[0x2c] = envseg; *(u_short *)&psp[0x32] = 20; *(u_long *)&psp[0x34] = MAKEVEC(pspseg, 0x18); *(u_long *)&psp[0x38] = 0xffffffff; psp[0x50] = 0xcd; psp[0x51] = 0x98; psp[0x52] = 0xc3; p = psp + 0x81; *p = 0; used = 0; for (i = 0; argv[i]; i++) { n = strlen(argv[i]); if (used + 1 + n > 0x7d) break; *p++ = ' '; memcpy(p, argv[i], n); p += n; used += n; } psp[0x80] = strlen(psp + 0x81); psp[0x81 + psp[0x80]] = 0x0d; psp[0x82 + psp[0x80]] = 0; p = psp + 0x81; parse_filename(0x00, p, psp + 0x5c, &n); p += n; parse_filename(0x00, p, psp + 0x6c, &n); if (param[4]) { fcb = (char *)MAKEPTR(param[4], param[3]); memcpy(psp + 0x5c, fcb, 16); } if (param[6]) { fcb = (char *)MAKEPTR(param[6], param[5]); memcpy(psp + 0x6c, fcb, 16); } #if 0 printf("005c:"); for (n = 0; n < 16; n++) printf(" %02x", psp[0x5c + n]); printf("\n"); printf("006c:"); for (n = 0; n < 16; n++) printf(" %02x", psp[0x6c + n]); printf("\n"); #endif disk_transfer_addr = MAKEVEC(pspseg, 0x80); start_segment = pspseg + 0x10; if (!exe_file) { load_com(fd, start_segment); init_cs = pspseg; init_ip = 0x100; init_ss = init_cs; init_sp = 0xfffe; init_ds = init_cs; init_es = init_cs; } else { load_exe(fd, start_segment, start_segment, &hdr, text_size); init_cs = hdr.init_cs + start_segment; init_ip = hdr.init_ip; init_ss = hdr.init_ss + start_segment; init_sp = hdr.init_sp; init_ds = pspseg; init_es = init_ds; } debug(D_EXEC, "cs:ip = %04x:%04x, ss:sp = %04x:%04x, " "ds = %04x, es = %04x\n", init_cs, init_ip, init_ss, init_sp, init_ds, init_es); if (run) { frames[newpsp] = *REGS; curpsp = newpsp; R_EFLAGS = 0x20202; R_CS = init_cs; R_IP = init_ip; R_SS = init_ss; R_SP = init_sp; R_DS = init_ds; R_ES = init_es; R_AX = R_BX = R_CX = R_DX = R_SI = R_DI = R_BP = 0; } else { param[7] = init_sp; param[8] = init_ss; param[9] = init_ip; param[10] = init_cs; } }