[Tinyos-commits]
CVS: tinyos-1.x/tos/lib/VM/languages/motlle/standalone
bytecodes.h, 1.2, 1.3 dump.c, 1.4, 1.5 ins.c, 1.3,
1.4 interpret.c, 1.2, 1.3 ports.c, 1.2, 1.3 print.c, 1.2,
1.3 scheme.c, 1.9, 1.10
David Gay
idgay at users.sourceforge.net
Fri Nov 18 10:47:44 PST 2005
Update of /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19483
Modified Files:
bytecodes.h dump.c ins.c interpret.c ports.c print.c scheme.c
Log Message:
cond
Index: bytecodes.h
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/bytecodes.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** bytecodes.h 30 Nov 2004 18:52:44 -0000 1.2
--- bytecodes.h 18 Nov 2005 18:47:41 -0000 1.3
***************
*** 24,32 ****
BC(OPmreturn, 171)
BC(OPhalt, 0)
- BC(OPmhandler4, 230)
BC(OPmba3, 2)
BC(OPmbf3, 10)
BC(OPmbt3, 22)
BC(OPmscheck4, 172)
--- 24,33 ----
BC(OPmreturn, 171)
BC(OPhalt, 0)
BC(OPmba3, 2)
BC(OPmbf3, 10)
BC(OPmbt3, 22)
+ BC(OPmbtp3, 230)
+ BC(OPmbfp3, 238)
BC(OPmscheck4, 172)
Index: dump.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/dump.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** dump.c 14 Oct 2005 00:20:31 -0000 1.4
--- dump.c 18 Nov 2005 18:47:41 -0000 1.5
***************
*** 295,298 ****
--- 295,304 ----
encoding = ins - OPmbt3;
goto branch;
+ case OPmbtp3 ... OPmbtp3 + 7:
+ encoding = ins - OPmbtp3;
+ goto branch;
+ case OPmbfp3 ... OPmbfp3 + 7:
+ encoding = ins - OPmbfp3;
+ goto branch;
case OPmbf3 ... OPmbf3 + 7:
encoding = ins - OPmbf3;
Index: ins.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/ins.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** ins.c 25 Oct 2005 22:00:40 -0000 1.3
--- ins.c 18 Nov 2005 18:47:41 -0000 1.4
***************
*** 336,343 ****
*/
{
switch (abranch)
{
case OPmba3: break;
! case OPmbt3: case OPmbf3:
adjust_depth(-1, fn);
break;
--- 336,346 ----
*/
{
+ /* We adjust stack depth even for "preserving" branches. It's up to the
+ code using these to readjust the stack depth at the branch target
+ (when setting the label) */
switch (abranch)
{
case OPmba3: break;
! case OPmbt3: case OPmbtp3: case OPmbfp3: case OPmbf3:
adjust_depth(-1, fn);
break;
***************
*** 405,410 ****
--- 408,416 ----
{
case OPmbf3 ... OPmbf3 + 7: branchins = OPmbf3; break;
+ case OPmbfp3 ... OPmbfp3 + 7: branchins = OPmbfp3; break;
case OPmbt3 ... OPmbt3 + 7: branchins = OPmbt3; break;
+ case OPmbtp3 ... OPmbtp3 + 7: branchins = OPmbtp3; break;
case OPmba3 ... OPmba3 + 7: branchins = OPmba3; break;
+ default: assert(0); branchins = OPmba3; break;
}
***************
*** 674,678 ****
/* Notice which labels are really used, short-circuit branch to ba */
! if (ins == OPmba3 || ins == OPmbt3 || ins == OPmbf3)
{
ilist dest = real_label(scan->to)->ins;
--- 680,685 ----
/* Notice which labels are really used, short-circuit branch to ba */
! if (ins == OPmba3 || ins == OPmbt3 || ins == OPmbtp3 ||
! ins == OPmbf3 || ins == OPmbfp3)
{
ilist dest = real_label(scan->to)->ins;
Index: interpret.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/interpret.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** interpret.c 30 Nov 2004 18:52:44 -0000 1.2
--- interpret.c 18 Nov 2005 18:47:41 -0000 1.3
***************
*** 134,138 ****
--- 134,140 ----
set_branch_size(OPmbf3);
+ set_branch_size(OPmbfp3);
set_branch_size(OPmbt3);
+ set_branch_size(OPmbtp3);
set_branch_size(OPmba3);
***************
*** 481,488 ****
--- 483,502 ----
dobranch = !istrue(FAST_POP());
goto branch;
+ case OPmbfp3 ... OPmbfp3 + 7:
+ byteop -= OPmbfp3;
+ dobranch = !istrue(FAST_GET(0));
+ if (dobranch)
+ FAST_POP();
+ goto branch;
case OPmbt3 ... OPmbt3 + 7:
byteop -= OPmbt3;
dobranch = istrue(FAST_POP());
goto branch;
+ case OPmbtp3 ... OPmbtp3 + 7:
+ byteop -= OPmbtp3;
+ dobranch = istrue(FAST_GET(0));
+ if (!dobranch)
+ FAST_POP();
+ goto branch;
case OPmba3 ... OPmba3 + 7:
***************
*** 746,750 ****
i8 fnargs = code->nargs;
value *args = (value *)sp;
! struct vector *vargs;
bool ok;
--- 760,764 ----
i8 fnargs = code->nargs;
value *args = (value *)sp;
! struct vector *vargs = NULL;
bool ok;
Index: ports.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/ports.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** ports.c 30 Nov 2004 18:52:44 -0000 1.2
--- ports.c 18 Nov 2005 18:47:41 -0000 1.3
***************
*** 397,401 ****
/* this is to take care of LONG_MIN */
*--pos = basechars[abs((long)n % base)];
! (i32)n /= base;
}
n = -(i32)n;
--- 397,401 ----
/* this is to take care of LONG_MIN */
*--pos = basechars[abs((long)n % base)];
! n = (i32)n / (i32)base;
}
n = -(i32)n;
Index: print.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/print.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** print.c 30 Nov 2004 18:52:44 -0000 1.2
--- print.c 18 Nov 2005 18:47:41 -0000 1.3
***************
*** 235,241 ****
--- 235,247 ----
i = print_branch(f, i, ofs, "bt3", op - OPmbt3);
break;
+ case OPmbtp3 ... OPmbtp3 + 7:
+ i = print_branch(f, i, ofs, "btp3", op - OPmbtp3);
+ break;
case OPmbf3 ... OPmbf3 + 7:
i = print_branch(f, i, ofs, "bf3", op - OPmbf3);
break;
+ case OPmbfp3 ... OPmbfp3 + 7:
+ i = print_branch(f, i, ofs, "bfp3", op - OPmbfp3);
+ break;
case OPmclearl:
pprintf(f, "clear/l %u\n", insu8());
Index: scheme.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/scheme.c,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** scheme.c 1 Nov 2005 01:45:21 -0000 1.9
--- scheme.c 18 Nov 2005 18:47:41 -0000 1.10
***************
*** 59,62 ****
--- 59,67 ----
}
+ static bool is_keyword(value x, const char *keyword)
+ {
+ return TYPE(x, type_symbol) && !strcmp(keyword, symname(x));
+ }
+
static struct {
const char *name;
***************
*** 131,137 ****
}
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,
--- 136,185 ----
}
+ static void compile_call_mgc(location l, value tocall, int nargs, bool discard,
+ fncode fn)
+ {
+ /* Optimise main case: calling a given global function. Also
+ support implicit function declaration. */
+ if (TYPE(tocall, type_symbol))
+ {
+ const char *name = sym2str(fnmemory(fn), tocall);
+ u16 offset;
+ mtype t;
+ variable_class vclass = env_lookup(l, name, &offset, &t, TRUE);
+
+ if (vclass == global_var)
+ {
+ int builtin = lookup_builtin(name, nargs);
+
+ if (builtin != -1)
+ {
+ int i, count;
+
+ if (builtins[builtin].nargs == -1)
+ count = nargs - 1;
+ else
+ count = 1;
+
+ for (i = 0; i < count; i++)
+ ins0(builtin_ops[builtins[builtin].builtin], fn);
+ }
+ else
+ mexecute(l, offset, name, nargs, fn);
+
+ if (discard)
+ ins0(OPmpop, fn);
+ return;
+ }
+ }
+ scheme_compile_mgc(l, tocall, FALSE, fn);
+ ins0(OPmexec4 + (nargs & 0xf), fn);
+
+ if (discard)
+ ins0(OPmpop, fn);
+ }
+
typedef void (*gencode)(location l, void *data, fncode fn);
! void sgen_condition_mgc(location l, value condition, bool preservetrue,
label slab, gencode scode, void *sdata,
label flab, gencode fcode, void *fdata,
***************
*** 143,168 ****
{
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)
! {
! branch(OPmbf3, flab, fn);
! scode(l, sdata, fn);
! if (fcode)
! fcode(l, fdata, fn);
! }
else
! {
! branch(OPmbt3, slab, fn);
! if (fcode)
! fcode(l, fdata, fn);
! else
! branch(OPmba3, flab, fn);
! }
! break;
}
}
--- 191,219 ----
{
case b_not:
+ if (preservetrue)
+ break;
+
/* Just swap conclusions */
! sgen_condition_mgc(l, nth(condition, 2), FALSE,
flab, fcode, fdata, slab, scode, sdata, fn);
! return;
! }
!
! /* Default behaviour */
! scheme_compile_mgc(l, condition, FALSE, fn);
! if (scode)
! {
! branch(preservetrue ? OPmbfp3 : OPmbf3, flab, fn);
! scode(l, sdata, fn);
! if (fcode)
! fcode(l, fdata, fn);
! }
! else
! {
! branch(preservetrue ? OPmbtp3 : OPmbt3, slab, fn);
! if (fcode)
! fcode(l, fdata, fn);
else
! branch(OPmba3, flab, fn);
}
}
***************
*** 209,219 ****
ifdata.discard = discard;
GCPRO2(ifdata.success, ifdata.failure);
!
! 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)
--- 260,266 ----
ifdata.discard = discard;
GCPRO2(ifdata.success, ifdata.failure);
! sgen_condition_mgc(l, condition, FALSE,
! ifdata.slab, ifs_code_mgc, &ifdata,
! ifdata.flab, iff_code_mgc, &ifdata, fn);
set_label(ifdata.endlab, fn);
if (!discard)
***************
*** 242,247 ****
struct list *expr = v;
! if (TYPE(expr->car, type_symbol) &&
! !strcmp("define", symname(expr->car)))
{
if (list_length(expr->cdr) >= 2)
--- 289,293 ----
struct list *expr = v;
! if (is_keyword(expr->car, "define"))
{
if (list_length(expr->cdr) >= 2)
***************
*** 257,262 ****
return TRUE;
}
! if (TYPE(expr->car, type_symbol) &&
! !strcmp("begin", symname(expr->car)))
{
/* the definitions at the start of an embedded begin block
--- 303,307 ----
return TRUE;
}
! if (is_keyword(expr->car, "begin"))
{
/* the definitions at the start of an embedded begin block
***************
*** 622,627 ****
}
else
! sgen_condition_mgc(l, exitpart->car, exitlab, NULL, NULL,
! contlab, NULL, NULL, fn);
body = args->cdr;
body = body->cdr;
--- 667,672 ----
}
else
! sgen_condition_mgc(l, exitpart->car, FALSE,
! exitlab, NULL, NULL, contlab, NULL, NULL, fn);
body = args->cdr;
body = body->cdr;
***************
*** 640,643 ****
--- 685,794 ----
}
+ struct conddata {
+ location l;
+ struct list *args;
+ label truelab, contlab, endlab;
+ bool discard;
+ };
+
+ static void continue_cond_mgc(struct conddata *data, fncode fn);
+
+ static void exit_cond(struct conddata *data, fncode fn)
+ {
+ branch(OPmba3, data->endlab, fn);
+ if (!data->discard)
+ adjust_depth(-1, fn);
+ }
+
+ static void cond_clause_true_mgc(location l, void *_data, fncode fn)
+ {
+ struct conddata *data = _data;
+ struct list *first = data->args->car;
+
+ set_label(data->truelab, fn);
+ compile_begin_mgc(data->l, first->cdr, data->discard, fn);
+ exit_cond(data, fn);
+ }
+
+ static void cond_clause_truecall_mgc(location l, void *_data, fncode fn)
+ {
+ struct conddata *data = _data;
+
+ set_label(data->truelab, fn);
+ adjust_depth(1, fn);
+ compile_call_mgc(data->l, nth(data->args->car, 3), 1, data->discard, fn);
+ exit_cond(data, fn);
+ }
+
+ static void cond_clause_cont_mgc(location l, void *_data, fncode fn)
+ {
+ /* Copy the data as we're modifying args (there's no guarantee the
+ true clauses won't be called after us) */
+ struct conddata *olddata = _data;
+ struct conddata newdata = *olddata;
+
+ set_label(olddata->contlab, fn);
+ newdata.args = olddata->args->cdr;
+ GCPRO1(newdata.args);
+ continue_cond_mgc(&newdata, fn);
+ GCPOP(1);
+ }
+
+ static void continue_cond_mgc(struct conddata *data, fncode fn)
+ {
+ int len;
+
+ data->truelab = new_label(fn);
+ data->contlab = new_label(fn);
+
+ if (!data->args)
+ {
+ scheme_compile_mgc(data->l, makeint(42), data->discard, fn);
+ exit_cond(data, fn);
+ }
+ else if ((len = list_length(data->args->car)) >= 2)
+ {
+ struct list *clause = data->args->car;
+ struct list *body = clause->cdr;
+
+ if (is_keyword(clause->car, "else"))
+ {
+ if (data->args->cdr)
+ log_error(data->l, "else clause must come last");
+ compile_begin_mgc(data->l, body, data->discard, fn);
+ exit_cond(data, fn);
+ }
+ else if (is_keyword(body->car, "=>"))
+ {
+ if (len != 3)
+ log_error(data->l, "invalid => clause in cond");
+ else
+ sgen_condition_mgc(data->l, clause->car, TRUE,
+ data->truelab, cond_clause_truecall_mgc, data,
+ data->contlab, cond_clause_cont_mgc, data, fn);
+ }
+ else /* regular clause */
+ sgen_condition_mgc(data->l, clause->car, FALSE,
+ data->truelab, cond_clause_true_mgc, data,
+ data->contlab, cond_clause_cont_mgc, data, fn);
+ }
+ else
+ log_error(data->l, "invalid cond clause");
+ }
+
+ static void compile_cond_mgc(location l, struct list *args, bool discard, fncode fn)
+ {
+ struct conddata conddata;
+
+ conddata.l = l;
+ conddata.endlab = new_label(fn);
+ conddata.args = args;
+ conddata.discard = discard;
+ GCPRO1(conddata.args);
+ continue_cond_mgc(&conddata, fn);
+ GCPOP(1);
+ set_label(conddata.endlab, fn);
+ }
+
static struct {
const char *keyword;
***************
*** 656,659 ****
--- 807,811 ----
{ "letrec", -2, compile_letrec_mgc },
{ "do", -3, compile_do_mgc },
+ { "cond", -1, compile_cond_mgc },
};
***************
*** 710,752 ****
compile_args_mgc(l, list->cdr, fn);
GCPOP(1);
!
! /* Optimise main case: calling a given global function. Also
! support implicit function declaration. */
! if (TYPE(list->car, type_symbol))
! {
! const char *name = sym2str(fnmemory(fn), list->car);
! u16 offset;
! mtype t;
! variable_class vclass = env_lookup(l, name, &offset, &t, TRUE);
!
! if (vclass == global_var)
! {
! int builtin = lookup_builtin(name, nargs);
!
! if (builtin != -1)
! {
! int i, count;
!
! if (builtins[builtin].nargs == -1)
! count = nargs - 1;
! else
! count = 1;
!
! for (i = 0; i < count; i++)
! ins0(builtin_ops[builtins[builtin].builtin], fn);
! }
! 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);
!
! if (discard)
! ins0(OPmpop, fn);
}
--- 862,866 ----
compile_args_mgc(l, list->cdr, fn);
GCPOP(1);
! compile_call_mgc(l, list->car, nargs, discard, fn);
}
More information about the Tinyos-commits
mailing list