[Tinyos-commits]
CVS: tinyos-1.x/tos/lib/VM/languages/motlle/standalone
compile.c, 1.5, 1.6 scheme.c, 1.3, 1.4 scheme.h, 1.1, 1.2
David Gay
idgay at users.sourceforge.net
Fri Oct 7 12:00:49 PDT 2005
Update of /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10478
Modified Files:
compile.c scheme.c scheme.h
Log Message:
do
hungarian notation (_mgc) for functions which may cause gc (in scheme.c only, for now)
Index: compile.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/compile.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** compile.c 7 Oct 2005 18:01:22 -0000 1.5
--- compile.c 7 Oct 2005 19:00:47 -0000 1.6
***************
*** 604,608 ****
break;
case c_scheme:
! scheme_compile(comp->l, make_constant(comp->u.cst, fn), discard, fn);
discard = FALSE;
break;
--- 604,608 ----
break;
case c_scheme:
! scheme_compile_mgc(comp->l, make_constant(comp->u.cst, fn), discard, fn);
discard = FALSE;
break;
Index: scheme.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/scheme.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** scheme.c 7 Oct 2005 18:01:22 -0000 1.3
--- scheme.c 7 Oct 2005 19:00:47 -0000 1.4
***************
*** 9,12 ****
--- 9,17 ----
#include "scheme.h"
+ /* MAYGC
+ env_lookup
+ generate_fncode
+ */
+
#include <string.h>
***************
*** 60,63 ****
--- 65,70 ----
} builtins[] = {
{ "+", 2, b_add },
+ { "<", 2, b_lt },
+ { ">", 2, b_gt },
};
***************
*** 90,99 ****
}
! static void compile_args(location l, struct list *args, fncode fn)
{
GCPRO1(args);
while (args)
{
! scheme_compile(l, args->car, FALSE, fn);
args = args->cdr;
}
--- 97,106 ----
}
! static void compile_args_mgc(location l, struct list *args, fncode fn)
{
GCPRO1(args);
while (args)
{
! scheme_compile_mgc(l, args->car, FALSE, fn);
args = args->cdr;
}
***************
*** 103,110 ****
typedef void (*gencode)(location l, void *data, fncode fn);
! void sgen_condition(location l, value condition,
! label slab, gencode scode, void *sdata,
! label flab, gencode fcode, void *fdata,
! fncode fn)
{
int builtin = is_builtin_call(condition, fn);
--- 110,117 ----
typedef void (*gencode)(location l, void *data, fncode fn);
! void sgen_condition_mgc(location l, value condition,
! label slab, gencode scode, void *sdata,
! label flab, gencode fcode, void *fdata,
! fncode fn)
{
int builtin = is_builtin_call(condition, fn);
***************
*** 114,122 ****
case b_not:
/* Just swap conclusions */
! sgen_condition(l, nth(condition, 2),
! flab, fcode, fdata, slab, scode, sdata, fn);
break;
default:
! scheme_compile(l, condition, FALSE, fn);
if (scode)
{
--- 121,129 ----
case b_not:
/* Just swap conclusions */
! sgen_condition_mgc(l, nth(condition, 2),
! flab, fcode, fdata, slab, scode, sdata, fn);
break;
default:
! scheme_compile_mgc(l, condition, FALSE, fn);
if (scode)
{
***************
*** 145,154 ****
};
! static void ifs_code(location l, void *_data, fncode fn)
{
struct ifdata *data = _data;
set_label(data->slab, fn);
! scheme_compile(l, data->success, data->discard, fn);
branch(OPmba3, data->endlab, fn);
if (!data->discard)
--- 152,161 ----
};
! static void ifs_code_mgc(location l, void *_data, fncode fn)
{
struct ifdata *data = _data;
set_label(data->slab, fn);
! scheme_compile_mgc(l, data->success, data->discard, fn);
branch(OPmba3, data->endlab, fn);
if (!data->discard)
***************
*** 156,165 ****
}
! static void iff_code(location l, void *_data, fncode fn)
{
struct ifdata *data = _data;
set_label(data->flab, fn);
! scheme_compile(l, data->failure, data->discard, fn);
branch(OPmba3, data->endlab, fn);
if (!data->discard)
--- 163,172 ----
}
! static void iff_code_mgc(location l, void *_data, fncode fn)
{
struct ifdata *data = _data;
set_label(data->flab, fn);
! scheme_compile_mgc(l, data->failure, data->discard, fn);
branch(OPmba3, data->endlab, fn);
if (!data->discard)
***************
*** 167,172 ****
}
! void sgen_if(location l, value condition, value success, value failure,
! bool discard, fncode fn)
{
struct ifdata ifdata;
--- 174,179 ----
}
! void sgen_if_mgc(location l, value condition, value success, value failure,
! bool discard, fncode fn)
{
struct ifdata ifdata;
***************
*** 181,189 ****
if (failure)
! sgen_condition(l, condition, ifdata.slab, ifs_code, &ifdata,
! ifdata.flab, iff_code, &ifdata, fn);
else
! sgen_condition(l, condition, ifdata.slab, ifs_code, &ifdata,
! ifdata.endlab, NULL, NULL, fn);
set_label(ifdata.endlab, fn);
if (!discard)
--- 188,196 ----
if (failure)
! sgen_condition_mgc(l, condition, ifdata.slab, ifs_code_mgc, &ifdata,
! ifdata.flab, iff_code_mgc, &ifdata, fn);
else
! sgen_condition_mgc(l, condition, ifdata.slab, ifs_code_mgc, &ifdata,
! ifdata.endlab, NULL, NULL, fn);
set_label(ifdata.endlab, fn);
if (!discard)
***************
*** 198,206 ****
}
! void compile_begin(location l, struct list *blk, bool discard, fncode fn)
{
GCPRO1(blk);
for (; blk; blk = blk->cdr)
! scheme_compile(l, blk->car, blk->cdr || discard, fn);
GCPOP(1);
}
--- 205,213 ----
}
! void compile_begin_mgc(location l, struct list *blk, bool discard, fncode fn)
{
GCPRO1(blk);
for (; blk; blk = blk->cdr)
! scheme_compile_mgc(l, blk->car, blk->cdr || discard, fn);
GCPOP(1);
}
***************
*** 247,251 ****
}
! void compile_block(location l, struct list *blk, bool discard, fncode fn)
{
struct list *defines;
--- 254,258 ----
}
! void compile_block_mgc(location l, struct list *blk, bool discard, fncode fn)
{
struct list *defines;
***************
*** 256,265 ****
GCPRO1(blk);
for (; blk; blk = blk->cdr)
! scheme_compile(l, blk->car, blk->cdr || discard, fn);
GCPOP(1);
}
! static void sgen_function(location l, struct string *varname, value formals,
! value body, bool discard, fncode fn)
{
struct code *c;
--- 263,272 ----
GCPRO1(blk);
for (; blk; blk = blk->cdr)
! scheme_compile_mgc(l, blk->car, blk->cdr || discard, fn);
GCPOP(1);
}
! static void sgen_function_mgc(location l, struct string *varname, value formals,
! value body, bool discard, fncode fn)
{
struct code *c;
***************
*** 320,324 ****
start_block("<return>", FALSE, FALSE, newfn);
! compile_block(l, body, FALSE, newfn);
end_block(newfn);
ins0(OPmreturn, newfn);
--- 327,331 ----
start_block("<return>", FALSE, FALSE, newfn);
! compile_block_mgc(l, body, FALSE, newfn);
end_block(newfn);
ins0(OPmreturn, newfn);
***************
*** 344,353 ****
}
! static void compile_lambda(location l, struct list *lambda_args, bool discard, fncode fn)
{
! sgen_function(l, NULL, lambda_args->car, lambda_args->cdr, discard, fn);
}
! static void compile_if(location l, struct list *args, bool discard, fncode fn)
{
value cond, true;
--- 351,360 ----
}
! static void compile_lambda_mgc(location l, struct list *lambda_args, bool discard, fncode fn)
{
! sgen_function_mgc(l, NULL, lambda_args->car, lambda_args->cdr, discard, fn);
}
! static void compile_if_mgc(location l, struct list *args, bool discard, fncode fn)
{
value cond, true;
***************
*** 358,365 ****
args = args->cdr;
if (args)
! sgen_if(l, cond, true, args->car, discard, fn);
else
{
! sgen_if(l, cond, true, NULL, TRUE, fn);
if (!discard)
ins_undefined(fn);
--- 365,372 ----
args = args->cdr;
if (args)
! sgen_if_mgc(l, cond, true, args->car, discard, fn);
else
{
! sgen_if_mgc(l, cond, true, NULL, TRUE, fn);
if (!discard)
ins_undefined(fn);
***************
*** 367,371 ****
}
! static void sgen_assign(location l, const char *name, bool discard, fncode fn)
{
u16 offset;
--- 374,378 ----
}
! static void sgen_assign_mgc(location l, const char *name, bool discard, fncode fn)
{
u16 offset;
***************
*** 384,391 ****
}
! static void compile_setb(location l, struct list *args, bool discard, fncode fn)
{
GCPRO1(args);
! scheme_compile(l, nth(args, 2), FALSE, fn);
GCPOP(1);
--- 391,398 ----
}
! static void compile_setb_mgc(location l, struct list *args, bool discard, fncode fn)
{
GCPRO1(args);
! scheme_compile_mgc(l, nth(args, 2), FALSE, fn);
GCPOP(1);
***************
*** 396,400 ****
}
! sgen_assign(l, sym2str(fnmemory(fn), args->car), discard, fn);
}
--- 403,407 ----
}
! sgen_assign_mgc(l, sym2str(fnmemory(fn), args->car), discard, fn);
}
***************
*** 406,410 ****
}
! static void compile_define(location l, struct list *args, bool discard, fncode fn)
{
vlist vfn = NULL;
--- 413,417 ----
}
! static void compile_define_mgc(location l, struct list *args, bool discard, fncode fn)
{
vlist vfn = NULL;
***************
*** 415,419 ****
vfn = sym2vlist(fnmemory(fn), args->car);
define_of(l, vfn, fn);
! scheme_compile(l, nth(args, 2), FALSE, fn);
}
else if (TYPE(args->car, type_pair))
--- 422,426 ----
vfn = sym2vlist(fnmemory(fn), args->car);
define_of(l, vfn, fn);
! scheme_compile_mgc(l, nth(args, 2), FALSE, fn);
}
else if (TYPE(args->car, type_pair))
***************
*** 427,431 ****
vfn = sym2vlist(fnmemory(fn), name);
define_of(l, vfn, fn);
! sgen_function(l, name->name, fndecl->cdr, args->cdr, FALSE, fn);
}
}
--- 434,438 ----
vfn = sym2vlist(fnmemory(fn), name);
define_of(l, vfn, fn);
! sgen_function_mgc(l, name->name, fndecl->cdr, args->cdr, FALSE, fn);
}
}
***************
*** 433,444 ****
log_error(l, "invalid define syntax");
else
! sgen_assign(l, vfn->var, discard, fn);
}
! static int check_binding(location l, value binding)
{
! if (list_length(binding) != 2)
{
! log_error(l, "invalid let binding");
return FALSE;
}
--- 440,451 ----
log_error(l, "invalid define syntax");
else
! sgen_assign_mgc(l, vfn->var, discard, fn);
}
! static int check_binding(location l, value binding, int extra)
{
! if (list_length(binding) != 2 + extra)
{
! log_error(l, "invalid variable binding");
return FALSE;
}
***************
*** 451,457 ****
}
! static void sgen_binding_init(location l, struct list *binding, fncode fn)
{
! scheme_compile(l, nth(binding, 2), FALSE, fn);
}
--- 458,464 ----
}
! static void sgen_binding_init_mgc(location l, struct list *binding, fncode fn)
{
! scheme_compile_mgc(l, nth(binding, 2), FALSE, fn);
}
***************
*** 461,534 ****
}
! static void sgen_binding_assign(location l, struct list *binding, fncode fn)
{
! sgen_assign(l, symname(binding->car), TRUE, fn);
}
! static void let_body(location l, struct list *body, bool discard, fncode fn)
{
! compile_block(l, body, discard, fn);
env_block_pop();
}
! static void let_bindings(location l, struct list *bindings, fncode fn)
{
if (TYPE(bindings, type_pair))
{
! int ok = check_binding(l, bindings->car);
GCPRO1(bindings);
if (ok)
! sgen_binding_init(l, bindings->car, fn);
! let_bindings(l, bindings->cdr, fn);
if (ok)
{
sgen_binding_decl(l, bindings->car, fn);
! sgen_binding_assign(l, bindings->car, fn);
}
GCPOP(1);
}
else if (bindings)
! log_error(l, "invalid bindings");
}
! static void compile_let(location l, struct list *args, bool discard, fncode fn)
{
env_block_push(NULL);
! let_bindings(l, args->car, fn);
! let_body(l, args->cdr, discard, fn);
}
! static void letstar_bindings(location l, struct list *bindings, fncode fn)
{
for (; TYPE(bindings, type_pair); bindings = bindings->cdr)
! {
! value binding = bindings->car;
!
! if (check_binding(l, binding))
! {
! sgen_binding_init(l, binding, fn);
! sgen_binding_decl(l, binding, fn);
! sgen_binding_assign(l, binding, fn);
! }
! }
if (bindings)
log_error(l, "invalid bindings");
}
! static void compile_letstar(location l, struct list *args, bool discard, fncode fn)
{
env_block_push(NULL);
! letstar_bindings(l, args->car, fn);
! let_body(l, args->cdr, discard, fn);
}
! static void letrec_bindings(location l, struct list *bindings, fncode fn)
{
if (TYPE(bindings, type_pair))
{
! int ok = check_binding(l, bindings->car);
GCPRO1(bindings);
--- 468,550 ----
}
! static void sgen_binding_assign_mgc(location l, struct list *binding, fncode fn)
{
! sgen_assign_mgc(l, symname(binding->car), TRUE, fn);
}
! static void let_body_mgc(location l, struct list *body, bool discard, fncode fn)
{
! compile_block_mgc(l, body, discard, fn);
env_block_pop();
}
! static bool let_bindings_mgc(location l, struct list *bindings, int extra, fncode fn)
{
if (TYPE(bindings, type_pair))
{
! int ok = check_binding(l, bindings->car, extra);
GCPRO1(bindings);
if (ok)
! sgen_binding_init_mgc(l, bindings->car, fn);
! ok = let_bindings_mgc(l, bindings->cdr, extra, fn) && ok;
if (ok)
{
sgen_binding_decl(l, bindings->car, fn);
! sgen_binding_assign_mgc(l, bindings->car, fn);
}
GCPOP(1);
+
+ return ok;
}
else if (bindings)
! {
! log_error(l, "invalid bindings");
! return FALSE;
! }
! else
! return TRUE;
}
! static void compile_let_mgc(location l, struct list *args, bool discard, fncode fn)
{
env_block_push(NULL);
! GCPRO1(args);
! let_bindings_mgc(l, args->car, 0, fn);
! let_body_mgc(l, args->cdr, discard, fn);
! GCPOP(1);
}
! static void letstar_bindings_mgc(location l, struct list *bindings, fncode fn)
{
+ GCPRO1(bindings);
for (; TYPE(bindings, type_pair); bindings = bindings->cdr)
! if (check_binding(l, bindings->car, 0))
! {
! sgen_binding_init_mgc(l, bindings->car, fn);
! sgen_binding_decl(l, bindings->car, fn);
! sgen_binding_assign_mgc(l, bindings->car, fn);
! }
if (bindings)
log_error(l, "invalid bindings");
+ GCPOP(1);
}
! static void compile_letstar_mgc(location l, struct list *args, bool discard, fncode fn)
{
env_block_push(NULL);
! GCPRO1(args);
! letstar_bindings_mgc(l, args->car, fn);
! let_body_mgc(l, args->cdr, discard, fn);
! GCPOP(1);
}
! static void letrec_bindings_mgc(location l, struct list *bindings, fncode fn)
{
if (TYPE(bindings, type_pair))
{
! int ok = check_binding(l, bindings->car, 0);
GCPRO1(bindings);
***************
*** 536,545 ****
sgen_binding_decl(l, bindings->car, fn);
! letrec_bindings(l, bindings->cdr, fn);
if (ok)
{
! sgen_binding_init(l, bindings->car, fn);
! sgen_binding_assign(l, bindings->car, fn);
}
GCPOP(1);
--- 552,561 ----
sgen_binding_decl(l, bindings->car, fn);
! letrec_bindings_mgc(l, bindings->cdr, fn);
if (ok)
{
! sgen_binding_init_mgc(l, bindings->car, fn);
! sgen_binding_assign_mgc(l, bindings->car, fn);
}
GCPOP(1);
***************
*** 549,557 ****
}
! static void compile_letrec(location l, struct list *args, bool discard, fncode fn)
{
env_block_push(NULL);
! letrec_bindings(l, args->car, fn);
! let_body(l, args->cdr, discard, fn);
}
--- 565,622 ----
}
! static void compile_letrec_mgc(location l, struct list *args, bool discard, fncode fn)
{
env_block_push(NULL);
! GCPRO1(args);
! letrec_bindings_mgc(l, args->car, fn);
! let_body_mgc(l, args->cdr, discard, fn);
! GCPOP(1);
! }
!
! static void do_var_update_mgc(location l, struct list *bindings, fncode fn)
! {
! if (bindings)
! {
! GCPRO1(bindings);
! scheme_compile_mgc(l, nth(bindings->car, 3), FALSE, fn);
! do_var_update_mgc(l, bindings->cdr, fn);
! sgen_binding_assign_mgc(l, bindings->car, fn);
! GCPOP(1);
! }
! }
!
! static void compile_do_mgc(location l, struct list *args, bool discard, fncode fn)
! {
! struct list *exitpart, *body;
! int ok;
! label looplab = new_label(fn), exitlab = new_label(fn), contlab = new_label(fn);
!
! env_block_push(NULL);
! GCPRO1(args);
! ok = let_bindings_mgc(l, args->car, 1, fn);
! set_label(looplab, fn);
! exitpart = nth(args, 2);
! if (list_length(exitpart) < 2)
! {
! ok = FALSE;
! log_error(l, "invalid do");
! }
! else
! sgen_condition_mgc(l, exitpart->car, exitlab, NULL, NULL,
! contlab, NULL, NULL, fn);
! body = args->cdr;
! body = body->cdr;
! set_label(contlab, fn);
! compile_block_mgc(l, body, TRUE, fn);
! if (ok)
! do_var_update_mgc(l, args->car, fn);
! branch(OPmba3, looplab, fn);
! set_label(exitlab, fn);
! if (ok)
! {
! exitpart = nth(args, 2);
! compile_begin_mgc(l, exitpart->cdr, discard, fn);
! }
! GCPOP(1);
}
***************
*** 559,577 ****
const char *keyword;
int nargs;
! void (*compile)(location l, struct list *args, bool discard, fncode fn);
int maxargs;
} syntax[] = {
{ "quote", 1, compile_quote },
! { "lambda", -2, compile_lambda },
! { "begin", -1, compile_begin },
! { "if", -2, compile_if, 3 },
! { "set!", 2, compile_setb },
! { "define", -1, compile_define },
! { "let", -2, compile_let },
! { "let*", -2, compile_letstar },
! { "letrec", -2, compile_letrec },
};
! static void compile_list(location l, struct list *list, bool discard, fncode fn)
{
int nargs = list_length(list->cdr);
--- 624,643 ----
const char *keyword;
int nargs;
! void (*compile_mgc)(location l, struct list *args, bool discard, fncode fn);
int maxargs;
} syntax[] = {
{ "quote", 1, compile_quote },
! { "lambda", -2, compile_lambda_mgc },
! { "begin", -1, compile_begin_mgc },
! { "if", -2, compile_if_mgc, 3 },
! { "set!", 2, compile_setb_mgc },
! { "define", -1, compile_define_mgc },
! { "let", -2, compile_let_mgc },
! { "let*", -2, compile_letstar_mgc },
! { "letrec", -2, compile_letrec_mgc },
! { "do", -3, compile_do_mgc },
};
! static void compile_list_mgc(location l, struct list *list, bool discard, fncode fn)
{
int nargs = list_length(list->cdr);
***************
*** 615,619 ****
}
}
! syntax[i].compile(l, list->cdr, discard, fn);
return;
}
--- 681,685 ----
}
}
! syntax[i].compile_mgc(l, list->cdr, discard, fn);
return;
}
***************
*** 625,629 ****
GCPRO1(list);
! compile_args(l, list->cdr, fn);
GCPOP(1);
--- 691,695 ----
GCPRO1(list);
! compile_args_mgc(l, list->cdr, fn);
GCPOP(1);
***************
*** 645,652 ****
else
mexecute(l, offset, name, nargs, fn);
return;
}
}
! scheme_compile(l, list->car, FALSE, fn);
ins0(OPmexec4 + (nargs & 0xf), fn);
--- 711,721 ----
else
mexecute(l, offset, name, nargs, fn);
+
+ if (discard)
+ ins0(OPmpop, fn);
return;
}
}
! scheme_compile_mgc(l, list->car, FALSE, fn);
ins0(OPmexec4 + (nargs & 0xf), fn);
***************
*** 655,659 ****
}
! void scheme_compile(location l, value v, bool discard, fncode fn) /* MAYGC */
{
if (INTEGERP(v))
--- 724,728 ----
}
! void scheme_compile_mgc(location l, value v, bool discard, fncode fn)
{
if (INTEGERP(v))
***************
*** 672,676 ****
return;
case type_pair:
! compile_list(l, v, discard, fn);
return;
case type_symbol:
--- 741,745 ----
return;
case type_pair:
! compile_list_mgc(l, v, discard, fn);
return;
case type_symbol:
Index: scheme.h
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/scheme.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** scheme.h 6 Oct 2005 23:38:01 -0000 1.1
--- scheme.h 7 Oct 2005 19:00:47 -0000 1.2
***************
*** 25,29 ****
#include "ins.h"
! void scheme_compile(location l, value v, bool discard, fncode fn);
#endif
--- 25,29 ----
#include "ins.h"
! void scheme_compile_mgc(location l, value v, bool discard, fncode fn);
#endif
More information about the Tinyos-commits
mailing list