Commit bc6cfb9d authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

gc protection in builtins and eval.c -- complete?

parent 73f623ce
......@@ -232,10 +232,12 @@ obp_t bf_defspecial(obp_t args, obp_t out_port, int level)
{
obp_t sym = CAR(args);
obp_t form = CDR(args);
PROTECT; protect(form);
form = new_pair(the_Mu, form);
obp_t func = make_function(THE_STRINGS(AS(sym, SYMBOL)->name),
form, out_port);
UNPROT;
CHECK_ERROR(func);
AS(sym, SYMBOL)->function = func;
return sym;
......@@ -535,6 +537,7 @@ obp_t bf_measure(obp_t args, obp_t out_port, int level)
obp_t bindings;
obp_t objects;
obp_t result;
PROTECT; protect6(usecs, evals, applys, bindings, objects, result);
gettimeofday(&from, 0);
if (IS_NIL(args)) {
......@@ -566,6 +569,7 @@ obp_t bf_measure(obp_t args, obp_t out_port, int level)
result = cons(cons(get_symbol_z(APPLYS_NAME), applys), result);
result = cons(cons(get_symbol_z(EVALS_NAME), evals), result);
result = cons(cons(get_symbol_z(USECS_NAME), usecs), result);
UNPROT;
return result;
}
......
......@@ -6,6 +6,7 @@
#include "hashmap.h"
#include "io.h"
#include "builtins.h"
#include "gc.h"
long eval_count = 0;
long apply_count = 0;
......@@ -147,6 +148,7 @@ obp_t apply(obp_t fun, obp_t args, obp_t out_port, int level)
{
apply_count++;
obp_t value = the_Nil;
PROTECT; protect(value);
/* We need not check for fun being a function, because we already have
* a function object
*/
......@@ -159,7 +161,10 @@ obp_t apply(obp_t fun, obp_t args, obp_t out_port, int level)
obp_t params = CAR(body); /* formal parameters */
obp_t nargs = make_bindings(params, args, out_port, level);
CHECK_ERROR(nargs);
if (IS_EXIT(nargs)) {
value = nargs;
goto EXIT;
}
while (IS((body = CDR(body)), PAIR)) {
value = eval(CAR(body), out_port, level);
if (IS_EXIT(value)) {
......@@ -169,8 +174,11 @@ obp_t apply(obp_t fun, obp_t args, obp_t out_port, int level)
restore_bindings(params, (int) AS(nargs, NUMBER)->value,
out_port, level);
} else {
ERROR(out_port, ERR_NOFUNC, fun, "not a valid function");
value = throw_error(out_port, ERR_NOFUNC, fun,
"not a valid function");
}
EXIT:
UNPROT;
return value;
}
......@@ -182,35 +190,55 @@ obp_t apply(obp_t fun, obp_t args, obp_t out_port, int level)
obp_t autoload(obp_t fun, obp_t out_port, int level)
{
CHECKTYPE(out_port, fun, FUNCTION);
obp_t retval;
PROTECT; protect(retval);
if (!IS_AUTOLOAD(fun)) {
ERROR(out_port, ERR_INVARG, fun, "not an autoload function");
retval = throw_error(out_port, ERR_INVARG, fun,
"not an autoload function");
goto EXIT;
}
Lfunction_t *func = AS(fun, FUNCTION);
obp_t retval = load_file(AS(func->impl.filename, STRING)->content,
retval = load_file(AS(func->impl.filename, STRING)->content,
out_port, level);
if (IS_ERROR(retval)) {
ERROR(out_port, ERR_NOAUTOL, fun, "load triggered error");
retval = throw_error(out_port, ERR_NOAUTOL, fun,
"load triggered error");
goto EXIT;
}
Lfunction_t *newfunc =
AS(AS(get_symbol(func->name, func->namelen), SYMBOL)->function,
FUNCTION);
if (!newfunc) {
ERROR(out_port, ERR_NOAUTOL, fun, "function undefined");
retval = throw_error(out_port, ERR_NOAUTOL, fun,
"function undefined");
goto EXIT;
}
if (newfunc->type == F_AUTOLOAD) {
ERROR(out_port, ERR_NOAUTOL, fun, "still not defined");
retval = throw_error(out_port, ERR_NOAUTOL, fun,
"still not defined");
goto EXIT;
}
return (obp_t) newfunc;
retval = (obp_t) newfunc;
EXIT:
UNPROT;
return retval;
}
obp_t evalfun(obp_t funob, obp_t args, obp_t out_port, int level)
{
obp_t fun = funob;
obp_t retval;
PROTECT; protect2(fun, retval);
if (IS(fun, PAIR)) {
if (!IS_LAMBDA(fun) && !IS_MU(fun)) {
fun = eval(fun, out_port, level);
CHECK_ERROR(fun);
if (IS_EXIT(fun)) {
retval = fun;
goto EXIT;
}
}
} else if (IS(fun, SYMBOL)) {
obp_t sym = fun;
......@@ -225,7 +253,10 @@ obp_t evalfun(obp_t funob, obp_t args, obp_t out_port, int level)
}
if (IS_AUTOLOAD(fun)) {
fun = autoload(fun, out_port, level);
CHECK_ERROR(fun);
if (IS_EXIT(fun)) {
retval = fun;
goto EXIT;
}
}
/* now we *should* have a function object of any kind */
if (!IS(fun, FUNCTION) && !IS_LAMBDA(fun) && !IS_MU(fun)) {
......@@ -233,7 +264,10 @@ obp_t evalfun(obp_t funob, obp_t args, obp_t out_port, int level)
}
if (IS_LAMBDA(fun) || IS_MU(fun)) { /* may still be a constructed form! */
fun = make_function(0, 0, fun, out_port);
CHECK_ERROR(fun);
if (IS_EXIT(fun)) {
retval = fun;
goto EXIT;
}
} else if (!IS(fun, FUNCTION)) {
ERROR(out_port, ERR_NOFUNC, fun, "not a function object");
}
......@@ -243,9 +277,13 @@ obp_t evalfun(obp_t funob, obp_t args, obp_t out_port, int level)
/* must evaluate arguments */
obp_t ev_args = the_Nil; /* evaluated arguments */
obp_t last = the_Nil;
protect2(ev_args, last);
for (obp_t elem = args; IS(elem, PAIR); elem = CDR(elem)) {
obp_t value = eval(CAR(elem), out_port, level);
CHECK_ERROR(value);
if (IS_EXIT(value)) {
retval = value;
goto EXIT;
}
if (ev_args == the_Nil) {
ev_args = last = new_pair(value, the_Nil);
} else {
......@@ -256,7 +294,10 @@ obp_t evalfun(obp_t funob, obp_t args, obp_t out_port, int level)
}
args = ev_args;
}
return apply(fun, args, out_port, level);
retval = apply(fun, args, out_port, level);
EXIT:
UNPROT;
return retval;
}
......@@ -264,6 +305,7 @@ obp_t eval(obp_t ob, obp_t out_port, int level)
{
obp_t value;
Lpair_t *pair;
PROTECT; protect(value);
eval_count++;
if (traceflag) {
......@@ -273,7 +315,9 @@ obp_t eval(obp_t ob, obp_t out_port, int level)
case SYMBOL:
value = AS(ob, SYMBOL)->value;
if (!value) {
ERROR(out_port, ERR_EVAL, ob, "symbol undefined");
value = throw_error(out_port, ERR_EVAL, ob,
"symbol undefined");
goto EXIT;
}
if (traceflag) {
print_expr(new_zstring(" sym: "), out_port);
......@@ -311,6 +355,8 @@ obp_t eval(obp_t ob, obp_t out_port, int level)
print_expr(ob, out_port);
terpri(out_port);
}
EXIT:
UNPROT;
return value;
}
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment