/*
* 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;
}
