Skip to content

Commit

Permalink
eliminate unneeded instructions
Browse files Browse the repository at this point in the history
  • Loading branch information
@bksaiki
bksaiki committed May 2, 2024
1 parent ff74bb2 commit 8c47e64
Show file tree
Hide file tree
Showing 10 changed files with 37 additions and 196 deletions.
8 changes: 4 additions & 4 deletions src/boot/test/jit.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ void no_check(const char *input) {
istream = tmpfile();
tc = current_tc();
load(istream, input);
tc_env(tc) = make_base_env();
tc_env(tc) = NULL;
eval_expr(tc, read_object(istream));
}

Expand All @@ -53,7 +53,7 @@ void check_true(const char *input) {
istream = tmpfile();
tc = current_tc();
load(istream, input);
tc_env(tc) = make_base_env();
tc_env(tc) = NULL;
result = eval_expr(tc, read_object(istream));
if (!minim_truep(result)) {
log_failed_case(input, "#t", write_debug(result));
Expand All @@ -70,7 +70,7 @@ void check_false(const char *input) {
istream = tmpfile();
tc = current_tc();
load(istream, input);
tc_env(tc) = make_base_env();
tc_env(tc) = NULL;
result = eval_expr(tc, read_object(istream));
if (!minim_falsep(result)) {
log_failed_case(input, "#f", write_debug(result));
Expand All @@ -88,7 +88,7 @@ void check_equal(const char *input, const char *expect) {
istream = tmpfile();
tc = current_tc();
load(istream, input);
tc_env(tc) = make_base_env();
tc_env(tc) = NULL;
result = eval_expr(tc, read_object(istream));
str = write_debug(result);
if (strcmp(str, expect) != 0) {
Expand Down
6 changes: 3 additions & 3 deletions src/boot/test/prims.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,7 @@ void check_true(const char *input) {
tc = current_tc();
load(istream, input);
tc_tenv(tc) = make_base_env();
tc_env(tc) = tc_tenv(tc);
tc_env(tc) = NULL;
result = eval_expr(tc, read_object(istream));
if (!minim_truep(result)) {
log_failed_case(input, "#t", write_debug(result));
Expand All @@ -66,7 +66,7 @@ void check_false(const char *input) {
tc = current_tc();
load(istream, input);
tc_tenv(tc) = make_base_env();
tc_env(tc) = tc_tenv(tc);
tc_env(tc) = NULL;
result = eval_expr(tc, read_object(istream));
if (!minim_falsep(result)) {
log_failed_case(input, "#f", write_debug(result));
Expand All @@ -85,7 +85,7 @@ void check_equal(const char *input, const char *expect) {
tc = current_tc();
load(istream, input);
tc_tenv(tc) = make_base_env();
tc_env(tc) = tc_tenv(tc);
tc_env(tc) = NULL;
result = eval_expr(tc, read_object(istream));
str = write_debug(result);
if (strcmp(str, expect) != 0) {
Expand Down
95 changes: 3 additions & 92 deletions src/core/c/env.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -173,103 +173,14 @@ static mobj top_env_symbols(mobj env) {
// A vector of bindings with a previous frame pointer
//

mobj Menv(mobj prev, size_t size) {
mobj env = GC_alloc(minim_env_size);
mobj Menv(size_t size) {
mobj env = GC_alloc(minim_env_size(size));
minim_type(env) = MINIM_OBJ_ENV;
minim_env_bindings(env) = Mvector(size, minim_false);
minim_env_prev(env) = prev;
return env;
}

static mobj env_find(mobj env, mobj k, int rec) {
mobj frame, cell;
size_t i;

for (; minim_envp(env); env = minim_env_prev(env)) {
frame = minim_env_bindings(env);
for (i = 0; i < minim_vector_len(frame); i++) {
cell = minim_vector_ref(frame, i);
if (minim_falsep(cell))
break;

if (minim_car(cell) == k)
return cell;
}

if (!rec)
break;
}

cell = top_env_find(env, k);
return minim_falsep(cell) ? minim_false : minim_car(cell);
}

void env_define_var_no_check(mobj env, mobj var, mobj val) {
mobj frame, cell;
size_t size, i;

if (minim_top_envp(env)) {
// TODO: splice this out
top_env_insert(env, var, val);
} else {
frame = minim_env_bindings(env);
size = minim_vector_len(frame);
for (i = 0; i < size; ++i) {
cell = minim_vector_ref(frame, i);
if (minim_falsep(cell)) {
minim_vector_ref(frame, i) = Mcons(var, val);
return;
}
}

minim_error1("env_define_var_no_check", "exceeded environment size", var);
}
}

mobj env_define_var(mobj env, mobj var, mobj val) {
mobj cell, old;

cell = env_find(env, var, 0);
if (minim_falsep(cell)) {
// insert new cell
env_define_var_no_check(env, var, val);
return NULL;
} else {
// overwrite cell
old = minim_cdr(cell);
minim_cdr(cell) = val;
return old;
}
}

mobj env_set_var(mobj env, mobj var, mobj val) {
mobj cell, old;

cell = env_find(env, var, 1);
if (minim_falsep(cell)) {
// panic, cannot find cell
minim_error1("env_set_var", "unbound variable", var);
} else {
// overwrite cell
old = minim_cdr(cell);
minim_cdr(cell) = val;
return old;
}
}

mobj env_lookup_var(mobj env, mobj var) {
mobj cell = env_find(env, var, 1);
if (minim_falsep(cell)) {
// panic, cannot find cell
minim_error1("env_lookup_var", "unbound variable", var);
} else {
// found cell
return minim_cdr(cell);
}
}

#define add_value(env, name, c_val) \
env_define_var(env, intern(name), c_val);
top_env_insert(env, intern(name), c_val);

mobj base_env;

Expand Down
69 changes: 12 additions & 57 deletions src/core/c/eval.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -328,39 +328,19 @@ static mobj tl_env_lookup_cell(mobj tc, mobj id) {

static void tl_env_rebind(mobj tc, mobj id, mobj val) {
mobj cell = top_env_find(tc_tenv(tc), id);
if (minim_falsep(cell)) {
minim_error1(NULL, "cannot use before initialization", id);
}

minim_cdar(cell) = val;
}

static void env_bind_cell(mobj tc, mobj cell, mobj idx) {
if (!minim_envp(tc_env(tc))) {
minim_error1("env_bind_cell", "expected environment", tc_env(tc));
}

mobj bindings = minim_env_bindings(tc_env(tc));
minim_vector_ref(bindings, minim_fixnum(idx)) = cell;
minim_env_ref(tc_env(tc), minim_fixnum(idx)) = cell;
}

static void env_rebind(mobj tc, mobj idx, mobj val) {
if (!minim_envp(tc_env(tc))) {
minim_error1("env_rebind", "expected environment", tc_env(tc));
}

mobj bindings = minim_env_bindings(tc_env(tc));
mobj cell = minim_vector_ref(bindings, minim_fixnum(idx));
minim_cdr(cell) = val;
minim_cdr(minim_env_ref(tc_env(tc), minim_fixnum(idx))) = val;
}

static void env_bind_values(mobj tc, mobj idx, mobj valc, mobj ids, mobj val) {
mobj bindings;
size_t count, bidx;

if (!minim_envp(tc_env(tc))) {
minim_error1("env_bind_values", "expected environment", tc_env(tc));
}

count = minim_fixnum(valc);
if (minim_valuesp(val)) {
Expand All @@ -369,12 +349,11 @@ static void env_bind_values(mobj tc, mobj idx, mobj valc, mobj ids, mobj val) {
result_arity_exn(NULL, count, tc_vc(tc));
}

bindings = minim_env_bindings(tc_env(tc));
bidx = minim_fixnum(idx);
for (size_t i = 0; i < count; i++) {
mobj val = tc_values(tc)[i];
SET_NAME_IF_CLOSURE(minim_car(ids), val);
minim_vector_ref(bindings, bidx) = Mcons(minim_car(ids), val);
minim_env_ref(tc_env(tc), bidx) = Mcons(minim_car(ids), val);
ids = minim_cdr(ids);
bidx += 1;
}
Expand All @@ -384,19 +363,13 @@ static void env_bind_values(mobj tc, mobj idx, mobj valc, mobj ids, mobj val) {
result_arity_exn(NULL, count, 1);
}

bindings = minim_env_bindings(tc_env(tc));
SET_NAME_IF_CLOSURE(minim_car(ids), val);
bidx = minim_fixnum(idx);
minim_vector_ref(bindings, bidx) = Mcons(minim_car(ids), val);
minim_env_ref(tc_env(tc), minim_fixnum(idx)) = Mcons(minim_car(ids), val);
}
}

static mobj env_lookup_value(mobj tc, mobj idx) {
if (!minim_envp(tc_env(tc))) {
minim_error1("env_lookup_value", "expected environment", tc_env(tc));
}

mobj cell = vector_ref(minim_env_bindings(tc_env(tc)), idx);
mobj cell = minim_env_ref(tc_env(tc), minim_fixnum(idx));
if (minim_cdr(cell) == minim_unbound) {
minim_error1(
NULL,
Expand All @@ -409,21 +382,12 @@ static mobj env_lookup_value(mobj tc, mobj idx) {
}

static mobj env_lookup_cell(mobj tc, mobj idx) {
if (!minim_envp(tc_env(tc))) {
minim_error1("env_lookup_cell", "expected environment", tc_env(tc));
}

return vector_ref(minim_env_bindings(tc_env(tc)), idx);
return minim_env_ref(tc_env(tc), minim_fixnum(idx));
}

static void env_load_closure(mobj tc, mobj proc) {
if (!minim_envp(tc_env(tc))) {
minim_error1("env_load_closure", "expected environment", tc_env(tc));
}

mobj bindings = minim_env_bindings(tc_env(tc));
for (size_t i = 0; i < minim_closure_count(proc); i++) {
minim_vector_ref(bindings, i) = minim_closure_ref(proc, i);
minim_env_ref(tc_env(tc), i) = minim_closure_ref(proc, i);
}
}

Expand All @@ -438,7 +402,7 @@ static mobj load_reg(mobj tc, mobj *tregs, mobj ins, mobj idx) {
case 3:
return tc_cp(tc);
case 4:
return Mfixnum(tc_ac(tc));
return (mobj) tc_ac(tc);
default:
minim_error1(NULL, "invalid register", ins);
}
Expand All @@ -459,7 +423,7 @@ static void store_reg(mobj tc, mobj *tregs, mobj ins, mobj idx, mobj val) {
tc_cp(tc) = val;
break;
case 4:
tc_ac(tc) = minim_fixnum(val);
tc_ac(tc) = (mfixnum) val;
break;
default:
minim_error1(NULL, "invalid register", ins);
Expand Down Expand Up @@ -588,21 +552,12 @@ static mobj eval_istream(mobj tc, mobj *istream) {
} else if (ty == tl_rebind_symbol) {
// tl-rebind
tl_env_rebind(tc, minim_cadr(ins), tregs[0]);
} else if (ty == make_env_symbol) {
// make-env
tregs[0] = Menv(tc_env(tc), minim_fixnum(minim_cadr(ins)));
} else if (ty == push_env_symbol) {
// push-env
tc_env(tc) = Menv(tc_env(tc), minim_fixnum(minim_cadr(ins)));
} else if (ty == pop_env_symbol) {
// pop-env
tc_env(tc) = minim_env_prev(tc_env(tc));
tc_env(tc) = Menv(minim_fixnum(minim_cadr(ins)));
} else if (ty == save_cc_symbol) {
// save-cc
push_frame(tc, (mobj*) minim_fixnum(minim_cadr(ins)));
} else if (ty == get_ac_symbol) {
// get-ac
tregs[0] = (mobj*) tc_ac(tc);
push_frame(tc, (mobj) minim_fixnum(minim_cadr(ins)));
} else if (ty == get_arg_symbol) {
// get-arg
tregs[0] = tc_frame_ref(tc, minim_fixnum(minim_cadr(ins)));
Expand All @@ -624,7 +579,7 @@ static mobj eval_istream(mobj tc, mobj *istream) {
arity_mismatch_exn(tc_cp(tc), tc_ac(tc));
} else if (ty == do_eval_symbol) {
// do-eval
tregs[0] = Mclosure(Menv(NULL, 0), compile_expr(tc_frame_ref(tc, 0)), 0);
tregs[0] = Mclosure(Menv(0), compile_expr(tc_frame_ref(tc, 0)), 0);
} else if (ty == do_raise_symbol) {
// do-raise
goto do_raise;
Expand Down
3 changes: 0 additions & 3 deletions src/core/c/global.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,6 @@ void init_minim() {
do_rest_symbol = intern("#%do-rest");
do_values_symbol = intern("#%do-values");
do_with_values_symbol = intern("#%do-with-values");
get_ac_symbol = intern("#%get-ac");
get_arg_symbol = intern("#%get-arg");
get_tenv_symbol = intern("#%get-tenv");
literal_symbol = intern("#%literal");
Expand All @@ -65,11 +64,9 @@ void init_minim() {
tl_lookup_cell_symbol = intern("#%tl-lookup-cell");
tl_rebind_symbol = intern("#%tl-rebind!");
make_closure_symbol = intern("#%make-closure");
make_env_symbol = intern("#%make-env");
make_unbound_symbol = intern("#%make-unbound");
mov_symbol = intern("#%mov");
pop_symbol = intern("#%pop");
pop_env_symbol = intern("#%pop-env");
push_symbol = intern("#%push");
push_env_symbol = intern("#%push-env");
rebind_symbol = intern("#%rebind");
Expand Down
18 changes: 4 additions & 14 deletions src/core/c/jitcompile.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -112,19 +112,6 @@ static mobj compile_lambda_clause(mobj clause, mobj env, mobj fvs, mobj bound) {
Mlist1(closure_bind_symbol) // copy free variables
);

// ins = Mlist1(Mlist2(push_env_symbol, Mfixnum(env_size)));

// // load free variables from closure
// bidx = 0;
// for (mobj it = fvs; !minim_nullp(it); it = minim_cdr(it)) {
// list_set_tail(ins, Mlist2(
// Mlist3(closure_ref_symbol, Mfixnum(cp_reg_idx), Mfixnum(bidx)),
// Mlist2(bind_cell_symbol, Mfixnum(bidx))
// ));
// bidx += 1;
// }


// bind arguments
env = scope_cenv_extend(env);
aidx = 0;
Expand Down Expand Up @@ -203,7 +190,10 @@ static mobj compile_case_lambda2(mobj expr, mobj env, mobj fvs, mobj bounds, int
list_set_tail(ins, Mlist1(Mlist3(branch, Mfixnum(req_arity), label)));
} else {
label = cenv_make_label(proc_env);
ins = Mlist2(Mlist1(get_ac_symbol), Mlist3(branch, Mfixnum(req_arity), label));
ins = Mlist2(
Mlist3(mov_symbol, Mfixnum(res_reg_idx), Mfixnum(ac_reg_idx)),
Mlist3(branch, Mfixnum(req_arity), label)
);
}

arity = update_arity(arity, req_arity, restp);
Expand Down
Loading

0 comments on commit 8c47e64

Please sign in to comment.