[Tinyos-commits]
CVS: tinyos-1.x/tos/lib/VM/languages/motlle/standalone
compile.c, 1.7, 1.8 compile.h, 1.3, 1.4 lexer.l, 1.8,
1.9 mparser.c, 1.6, 1.7 parser.y, 1.6, 1.7 scheme.c, 1.14,
1.15 tokens.h, 1.4, 1.5 tree.c, 1.3, 1.4 tree.h, 1.3, 1.4
David Gay
idgay at users.sourceforge.net
Fri Nov 18 16:42:11 PST 2005
Update of /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15488
Modified Files:
compile.c compile.h lexer.l mparser.c parser.y scheme.c
tokens.h tree.c tree.h
Log Message:
keep track of locations. needs testing.
Index: compile.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/compile.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** compile.c 14 Oct 2005 00:20:31 -0000 1.7
--- compile.c 19 Nov 2005 00:42:09 -0000 1.8
***************
*** 106,112 ****
}
! value make_constant(constant c, fncode fn);
! static value make_list(cstlist csts, int has_tail, fncode fn)
{
struct list *l;
--- 106,117 ----
}
! value make_constant(constant c, bool save_location, fncode fn);
! static value make_location(location *loc)
! {
! return alloc_extptr(loc);
! }
!
! static value make_list(constant loc, cstlist csts, int has_tail, bool save_location, fncode fn)
{
struct list *l;
***************
*** 114,118 ****
if (has_tail && csts != NULL)
{
! l = csts->cst ? make_constant(csts->cst, fn) : NULL;
csts = csts->next;
}
--- 119,123 ----
if (has_tail && csts != NULL)
{
! l = csts->cst ? make_constant(csts->cst, FALSE, fn) : NULL;
csts = csts->next;
}
***************
*** 124,128 ****
while (csts)
{
! value tmp = make_constant(csts->cst, fn);
l = alloc_list(tmp, l);
--- 129,133 ----
while (csts)
{
! value tmp = make_constant(csts->cst, save_location, fn);
l = alloc_list(tmp, l);
***************
*** 130,133 ****
--- 135,144 ----
csts = csts->next;
}
+ if (save_location)
+ {
+ value vloc = make_location(&loc->loc);
+ l = alloc_list(vloc, l);
+ SET_READONLY(l); SET_IMMUTABLE(l);
+ }
GCPOP(1);
***************
*** 146,150 ****
/* This intermediate step is necessary as v is IMMUTABLE
(so must be allocated after its contents) */
! l = make_list(csts, 0, fn);
GCPRO1(l);
v = alloc_vector(size);
--- 157,161 ----
/* This intermediate step is necessary as v is IMMUTABLE
(so must be allocated after its contents) */
! l = make_list(NULL, csts, 0, FALSE, fn);
GCPRO1(l);
v = alloc_vector(size);
***************
*** 169,173 ****
for (; csts; csts = csts->next)
table_set(t, csts->cst->u.constpair->cst1->u.string,
! make_constant(csts->cst->u.constpair->cst2, fn), NULL);
table_foreach(t, protect_symbol);
SET_READONLY(t);
--- 180,184 ----
for (; csts; csts = csts->next)
table_set(t, csts->cst->u.constpair->cst1->u.string,
! make_constant(csts->cst->u.constpair->cst2, FALSE, fn), NULL);
table_foreach(t, protect_symbol);
SET_READONLY(t);
***************
*** 184,188 ****
GCPRO1(s);
SET_IMMUTABLE(s); SET_READONLY(s);
! sym = alloc_symbol(s, make_constant(p->cst2, fn));
SET_IMMUTABLE(sym); SET_READONLY(sym);
GCPOP(1);
--- 195,199 ----
GCPRO1(s);
SET_IMMUTABLE(s); SET_READONLY(s);
! sym = alloc_symbol(s, make_constant(p->cst2, FALSE, fn));
SET_IMMUTABLE(sym); SET_READONLY(sym);
GCPOP(1);
***************
*** 209,218 ****
}
! static value make_quote(constant c, fncode fn)
{
struct list *l;
value quote;
! l = alloc_list(make_constant(c, fn), NULL);
SET_READONLY(l); SET_IMMUTABLE(l);
GCPRO1(l);
--- 220,229 ----
}
! static value make_quote(constant c, bool save_location, fncode fn)
{
struct list *l;
value quote;
! l = alloc_list(make_constant(c->u.constant, save_location, fn), NULL);
SET_READONLY(l); SET_IMMUTABLE(l);
GCPRO1(l);
***************
*** 220,223 ****
--- 231,240 ----
l = alloc_list(quote, l);
SET_READONLY(l); SET_IMMUTABLE(l);
+ if (save_location)
+ {
+ value loc = make_location(&c->loc);
+ l = alloc_list(loc, l);
+ SET_READONLY(l); SET_IMMUTABLE(l);
+ }
GCPOP(1);
***************
*** 225,229 ****
}
! value make_constant(constant c, fncode fn)
{
struct obj *cst;
--- 242,246 ----
}
! value make_constant(constant c, bool save_location, fncode fn)
{
struct obj *cst;
***************
*** 236,241 ****
return cst;
case cst_gsymbol: return make_gsymbol(c->u.string, fn);
! case cst_quote: return make_quote(c->u.constant, fn);
! case cst_list: return make_list(c->u.constants, 1, fn);
case cst_array: return make_array(c->u.constants, fn);
case cst_int: return makeint(c->u.integer);
--- 253,258 ----
return cst;
case cst_gsymbol: return make_gsymbol(c->u.string, fn);
! case cst_quote: return make_quote(c, save_location, fn);
! case cst_list: return make_list(c, c->u.constants, 1, save_location, fn);
case cst_array: return make_array(c->u.constants, fn);
case cst_int: return makeint(c->u.integer);
***************
*** 610,617 ****
break;
case c_constant:
! ins_constant(make_constant(comp->u.cst, fn), fn);
break;
case c_scheme:
! scheme_compile_mgc(comp->l, make_constant(comp->u.cst, fn), discard, fn);
discard = FALSE;
break;
--- 627,634 ----
break;
case c_constant:
! ins_constant(make_constant(comp->u.cst, FALSE, fn), fn);
break;
case c_scheme:
! scheme_compile_mgc(comp->l, make_constant(comp->u.cst, TRUE, fn), discard, fn);
discard = FALSE;
break;
Index: compile.h
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/compile.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** compile.h 6 Oct 2005 23:38:00 -0000 1.3
--- compile.h 19 Nov 2005 00:42:09 -0000 1.4
***************
*** 28,32 ****
extern component component_undefined, component_true, component_false;
! value make_constant(constant c, fncode fn);
struct string *make_filename(const char *fname);
--- 28,32 ----
extern component component_undefined, component_true, component_false;
! value make_constant(constant c, bool save_location, fncode fn);
struct string *make_filename(const char *fname);
Index: lexer.l
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/lexer.l,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** lexer.l 25 Oct 2005 23:08:52 -0000 1.8
--- lexer.l 19 Nov 2005 00:42:09 -0000 1.9
***************
*** 121,133 ****
}
}
! <INITIAL,schemelex>"(" { return '('; }
<INITIAL,schemelex>")" { return ')'; }
! <INITIAL,schemelex>"'" { return QUOTE; }
<INITIAL,schemelex>"." { return '.'; }
<INITIAL,schemelex>"," { return ','; }
! "[" { return '['; }
"]" { return ']'; }
! "{" { return '{'; }
"}" { return '}'; }
"=" { return ASSIGN; }
--- 121,133 ----
}
}
! <INITIAL,schemelex>"(" { yylval.location = lexloc; return '('; }
<INITIAL,schemelex>")" { return ')'; }
! <INITIAL,schemelex>"'" { yylval.location = lexloc; return QUOTE; }
<INITIAL,schemelex>"." { return '.'; }
<INITIAL,schemelex>"," { return ','; }
! "[" { yylval.location = lexloc; return '['; }
"]" { return ']'; }
! "{" { yylval.location = lexloc; return '{'; }
"}" { return '}'; }
"=" { return ASSIGN; }
***************
*** 231,235 ****
for (i = 0; i < NKEYWORDS; i++)
if (stricmp(yytext, keywords[i].name) == 0)
! return keywords[i].value;
return SYMBOL;
--- 231,238 ----
for (i = 0; i < NKEYWORDS; i++)
if (stricmp(yytext, keywords[i].name) == 0)
! {
! yylval.location = lexloc;
! return keywords[i].value;
! }
return SYMBOL;
***************
*** 242,246 ****
return SYMBOL;
}
! <schemelex>#\( { return '['; }
<schemelex>#\\space { yylval.integer = ' '; return INTEGER; }
--- 245,249 ----
return SYMBOL;
}
! <schemelex>#\( { yylval.location = lexloc; return '['; }
<schemelex>#\\space { yylval.integer = ' '; return INTEGER; }
Index: mparser.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/mparser.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** mparser.c 25 Oct 2005 22:33:21 -0000 1.6
--- mparser.c 19 Nov 2005 00:42:09 -0000 1.7
***************
*** 53,96 ****
FOR = 262,
ASSIGN = 263,
! QUOTE = 264,
! BREAK = 265,
! CONTINUE = 266,
! RETURN = 267,
! SYMBOL = 268,
! BIGINT = 269,
! SINK = 270,
! SWITCH = 271,
[...3142 lines suppressed...]
--- 2460,2464 ----
# undef YYRECOVERING
/* Line 671 of glr.c. */
! #line 2462 "parser.tab.c"
}
***************
*** 3759,3763 ****
! #line 777 "../standalone/parser.y"
--- 3743,3747 ----
! #line 780 "../standalone/parser.y"
Index: parser.y
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/parser.y,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** parser.y 25 Oct 2005 22:33:21 -0000 1.6
--- parser.y 19 Nov 2005 00:42:09 -0000 1.7
***************
*** 36,39 ****
--- 36,40 ----
%union {
+ location location;
char *string;
char *symbol;
***************
*** 59,66 ****
}
! %token <symbol> FUNCTION IF ELSE WHILE FOR ASSIGN QUOTE BREAK CONTINUE RETURN
! %token <symbol> SYMBOL BIGINT SINK SWITCH CASE DEFAULT
! %token <symbol> ELLIPSIS DO
! %token <symbol> MODULE LIBRARY IMPORTS DEFINES READS WRITES
%token <integer> INTEGER
%token <string> STRING
--- 60,68 ----
}
! %token FUNCTION IF ELSE WHILE FOR ASSIGN BREAK CONTINUE RETURN
! %token SINK SWITCH CASE DEFAULT
! %token ELLIPSIS DO
! %token MODULE LIBRARY IMPORTS DEFINES READS WRITES
! %token <symbol> SYMBOL
%token <integer> INTEGER
%token <string> STRING
***************
*** 68,71 ****
--- 70,74 ----
%token <operator> OP_ASSIGN INCREMENTER
%token <symbol> SCHEME SCHEMEFILE
+ %token <location> QUOTE '[' '(' '{'
%right '.'
***************
*** 634,638 ****
constant :
simple_constant |
! QUOTE constant { $$ = new_constant(parser_memory, cst_quote, $2); } |
anysymbol { $$ = new_constant(parser_memory, cst_gsymbol, $1); } |
'{' table_entry_list '}' { $$ = new_constant(parser_memory, cst_table, $2); } |
--- 637,641 ----
constant :
simple_constant |
! QUOTE constant { $$ = new_constant(parser_memory, cst_quote, $1, $2); } |
anysymbol { $$ = new_constant(parser_memory, cst_gsymbol, $1); } |
'{' table_entry_list '}' { $$ = new_constant(parser_memory, cst_table, $2); } |
***************
*** 641,645 ****
'[' optional_constant_list ')' { $$ = new_constant(parser_memory, cst_array, $2); } |
'(' constant_list optional_constant_tail ')' {
! $$ = new_constant(parser_memory, cst_list, new_cstlist(parser_memory, $3, $2));
} |
'(' ')' { $$ = new_constant(parser_memory, cst_list, NULL); } ;
--- 644,648 ----
'[' optional_constant_list ')' { $$ = new_constant(parser_memory, cst_array, $2); } |
'(' constant_list optional_constant_tail ')' {
! $$ = new_constant(parser_memory, cst_list, $1, new_cstlist(parser_memory, $3, $2));
} |
'(' ')' { $$ = new_constant(parser_memory, cst_list, NULL); } ;
Index: scheme.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/scheme.c,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** scheme.c 18 Nov 2005 22:55:49 -0000 1.14
--- scheme.c 19 Nov 2005 00:42:09 -0000 1.15
***************
*** 36,39 ****
--- 36,86 ----
}
+ static value extract_location(value v, location *loc)
+ {
+ if (TYPE(v, type_pair))
+ {
+ struct list *l = v;
+ struct extptr *locptr = l->car;
+ *loc = *(location *)locptr->external;
+ return l->cdr;
+ }
+ else
+ return v;
+ }
+
+ static value skip_location(value v)
+ {
+ if (TYPE(v, type_pair))
+ return ((struct list *)v)->cdr;
+ else
+ return v;
+ }
+
+ static value filter_locations_mgc(value v)
+ {
+ struct list *newv = NULL, *end = NULL;
+
+ if (!TYPE(v, type_pair))
+ return v;
+
+ GCPRO2(newv, end);
+ GCPRO1(v);
+ while (TYPE(v, type_pair))
+ {
+ struct list *newend = alloc_list(filter_locations_mgc(((struct list *)v)->car), NULL);
+
+ if (!newv)
+ newv = end = newend;
+ else
+ {
+ end->cdr = newend;
+ end = newend;
+ }
+ }
+ end->cdr = v;
+ GCPOP(3);
+ return newv;
+ }
+
static int list_length(value v)
{
***************
*** 141,145 ****
if (TYPE(v, type_pair))
{
! struct list *call = v;
if (TYPE(call->car, type_symbol))
--- 188,192 ----
if (TYPE(v, type_pair))
{
! struct list *call = skip_location(v);
if (TYPE(call->car, type_symbol))
***************
*** 262,268 ****
/* check for non-degenerate and, or */
! if (list_length(condition) >= 2)
{
! struct list *condlist = condition;
bool is_or = is_keyword(condlist->car, "or");
bool is_and = is_keyword(condlist->car, "and");
--- 309,315 ----
/* check for non-degenerate and, or */
! if (list_length(skip_location(condition)) >= 2)
{
! struct list *condlist = extract_location(condition, &l);
bool is_or = is_keyword(condlist->car, "or");
bool is_and = is_keyword(condlist->car, "and");
***************
*** 352,356 ****
{
if (!discard)
! ins_constant(args->car, fn);
}
--- 399,403 ----
{
if (!discard)
! ins_constant(skip_location(args->car), fn);
}
***************
*** 367,371 ****
if (TYPE(v, type_pair))
{
! struct list *expr = v;
if (is_keyword(expr->car, "define"))
--- 414,418 ----
if (TYPE(v, type_pair))
{
! struct list *expr = extract_location(v, &l);
if (is_keyword(expr->car, "define"))
***************
*** 376,380 ****
if (TYPE(expr->car, type_pair))
! expr = expr->car;
if (TYPE(expr->car, type_symbol))
env_declare(sym2vlist(fnmemory(fn), expr->car));
--- 423,427 ----
if (TYPE(expr->car, type_pair))
! expr = skip_location(expr->car);
if (TYPE(expr->car, type_symbol))
env_declare(sym2vlist(fnmemory(fn), expr->car));
***************
*** 501,505 ****
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);
}
--- 548,552 ----
static void compile_lambda_mgc(location l, struct list *lambda_args, bool discard, fncode fn)
{
! sgen_function_mgc(l, NULL, skip_location(lambda_args->car), lambda_args->cdr, discard, fn);
}
***************
*** 570,574 ****
else if (TYPE(args->car, type_pair))
{
! struct list *fndecl = args->car;
if (TYPE(fndecl->car, type_symbol))
--- 617,621 ----
else if (TYPE(args->car, type_pair))
{
! struct list *fndecl = extract_location(args->car, &l);
if (TYPE(fndecl->car, type_symbol))
***************
*** 630,638 ****
if (TYPE(bindings, type_pair))
{
! int ok = check_binding(l, bindings->car, extra) != NULL;
! GCPRO1(bindings);
if (ok)
! sgen_binding_init_mgc(l, bindings->car, fn);
ok = let_bindings_mgc(l, bindings->cdr, extra, fn) && ok;
--- 677,689 ----
if (TYPE(bindings, type_pair))
{
! value binding;
! int ok;
! binding = extract_location(bindings->car, &l);
! ok = check_binding(l, binding, extra) != NULL;
!
! GCPRO2(binding, bindings);
if (ok)
! sgen_binding_init_mgc(l, binding, fn);
ok = let_bindings_mgc(l, bindings->cdr, extra, fn) && ok;
***************
*** 640,647 ****
if (ok)
{
! sgen_binding_decl(l, bindings->car, fn);
! sgen_binding_assign_mgc(l, bindings->car, fn);
}
! GCPOP(1);
return ok;
--- 691,698 ----
if (ok)
{
! sgen_binding_decl(l, binding, fn);
! sgen_binding_assign_mgc(l, binding, fn);
}
! GCPOP(2);
return ok;
***************
*** 673,695 ****
env_declare(str2vlist(fnmemory(fn), cname));
! bindings = nth(args, 2);
GCPRO2(bindings, args);
GCPRO2(parameters, last_parameter);
for (; TYPE(bindings, type_pair); bindings = bindings->cdr)
! if ((parm = check_binding(l, bindings->car, 0)))
! {
! struct list *parmtail = alloc_list(parm, NULL);
! if (!parameters)
! parameters = last_parameter = parmtail;
! else
! {
! last_parameter->cdr = parmtail;
! last_parameter = parmtail;
! }
! sgen_binding_init_mgc(l, bindings->car, fn);
! nargs++;
! }
if (bindings)
log_error(l, "invalid bindings");
--- 724,754 ----
env_declare(str2vlist(fnmemory(fn), cname));
! bindings = extract_location(nth(args, 2), &l);
GCPRO2(bindings, args);
GCPRO2(parameters, last_parameter);
for (; TYPE(bindings, type_pair); bindings = bindings->cdr)
! {
! value binding;
! binding = extract_location(bindings->car, &l);
! GCPRO1(binding);
! if ((parm = check_binding(l, binding, 0)))
! {
! struct list *parmtail = alloc_list(parm, NULL);
!
! if (!parameters)
! parameters = last_parameter = parmtail;
! else
! {
! last_parameter->cdr = parmtail;
! last_parameter = parmtail;
! }
!
! sgen_binding_init_mgc(l, binding, fn);
! nargs++;
! }
! GCPOP(1);
! }
if (bindings)
log_error(l, "invalid bindings");
***************
*** 708,711 ****
--- 767,772 ----
static void compile_let_mgc(location l, struct list *args, bool discard, fncode fn)
{
+ value bindings;
+
if (TYPE(args->car, type_symbol))
{
***************
*** 715,719 ****
env_block_push(NULL);
GCPRO1(args);
! let_bindings_mgc(l, args->car, 0, fn);
let_body_mgc(l, args->cdr, discard, fn);
GCPOP(1);
--- 776,781 ----
env_block_push(NULL);
GCPRO1(args);
! bindings = extract_location(args->car, &l);
! let_bindings_mgc(l, bindings, 0, fn);
let_body_mgc(l, args->cdr, discard, fn);
GCPOP(1);
***************
*** 724,733 ****
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");
--- 786,801 ----
GCPRO1(bindings);
for (; TYPE(bindings, type_pair); bindings = bindings->cdr)
! {
! value binding = extract_location(bindings->car, &l);
!
! if (check_binding(l, binding, 0))
! {
! GCPRO1(binding);
! sgen_binding_init_mgc(l, binding, fn);
! sgen_binding_decl(l, binding, fn);
! sgen_binding_assign_mgc(l, binding, fn);
! GCPOP(1);
! }
! }
if (bindings)
log_error(l, "invalid bindings");
***************
*** 737,743 ****
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);
--- 805,814 ----
static void compile_letstar_mgc(location l, struct list *args, bool discard, fncode fn)
{
+ value bindings;
+
env_block_push(NULL);
GCPRO1(args);
! bindings = extract_location(args->car, &l);
! letstar_bindings_mgc(l, bindings, fn);
let_body_mgc(l, args->cdr, discard, fn);
GCPOP(1);
***************
*** 748,756 ****
if (TYPE(bindings, type_pair))
{
! int ok = check_binding(l, bindings->car, 0) != NULL;
! GCPRO1(bindings);
if (ok)
! sgen_binding_decl(l, bindings->car, fn);
letrec_bindings_mgc(l, bindings->cdr, fn);
--- 819,831 ----
if (TYPE(bindings, type_pair))
{
! value binding;
! int ok;
! binding = extract_location(bindings->car, &l);
! ok = check_binding(l, binding, 0) != NULL;
!
! GCPRO2(bindings, binding);
if (ok)
! sgen_binding_decl(l, binding, fn);
letrec_bindings_mgc(l, bindings->cdr, fn);
***************
*** 758,763 ****
if (ok)
{
! sgen_binding_init_mgc(l, bindings->car, fn);
! sgen_binding_assign_mgc(l, bindings->car, fn);
}
GCPOP(1);
--- 833,838 ----
if (ok)
{
! sgen_binding_init_mgc(l, binding, fn);
! sgen_binding_assign_mgc(l, binding, fn);
}
GCPOP(1);
***************
*** 769,775 ****
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);
--- 844,853 ----
static void compile_letrec_mgc(location l, struct list *args, bool discard, fncode fn)
{
+ value bindings;
+
env_block_push(NULL);
GCPRO1(args);
! bindings = extract_location(args->car, &l);
! letrec_bindings_mgc(l, bindings, fn);
let_body_mgc(l, args->cdr, discard, fn);
GCPOP(1);
***************
*** 790,822 ****
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, FALSE,
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);
--- 868,904 ----
static void compile_do_mgc(location l, struct list *args, bool discard, fncode fn)
{
! struct list *exitpart, *body, *bindings;
int ok;
+ location exitl = l;
label looplab = new_label(fn), exitlab = new_label(fn), contlab = new_label(fn);
env_block_push(NULL);
GCPRO1(args);
! bindings = extract_location(args->car, &l);
! ok = let_bindings_mgc(l, bindings, 1, fn);
set_label(looplab, fn);
! exitpart = extract_location(nth(args, 2), &exitl);
if (list_length(exitpart) < 2)
{
ok = FALSE;
! log_error(exitl, "invalid do");
}
else
! sgen_condition_mgc(exitl, exitpart->car, FALSE,
exitlab, NULL, NULL, contlab, NULL, NULL, fn);
! body = nthtail(args, 3);
set_label(contlab, fn);
compile_block_mgc(l, body, TRUE, fn);
if (ok)
! {
! bindings = extract_location(args->car, &l);
! do_var_update_mgc(l, bindings, fn);
! }
branch(OPmba3, looplab, fn);
set_label(exitlab, fn);
if (ok)
{
! exitpart = skip_location(nth(args, 2));
! compile_begin_mgc(exitl, exitpart->cdr, discard, fn);
}
GCPOP(1);
***************
*** 839,846 ****
{
struct logicaldata *data = _data;
! struct list *first = data->args->car;
set_label(data->truelab, fn);
! compile_begin_mgc(l, first->cdr, data->discard, fn);
exit_logical(data, fn);
}
--- 921,928 ----
{
struct logicaldata *data = _data;
! struct list *clause = skip_location(data->args->car);
set_label(data->truelab, fn);
! compile_begin_mgc(l, clause->cdr, data->discard, fn);
exit_logical(data, fn);
}
***************
*** 851,855 ****
entry_with_data(data->truelab, FALSE, fn);
! compile_call_mgc(l, nth(data->args->car, 3), 1, data->discard, fn);
exit_logical(data, fn);
}
--- 933,937 ----
entry_with_data(data->truelab, FALSE, fn);
! compile_call_mgc(l, nth(skip_location(data->args->car), 3), 1, data->discard, fn);
exit_logical(data, fn);
}
***************
*** 872,875 ****
--- 954,958 ----
{
int len;
+ struct list *clause;
data->truelab = new_label(fn);
***************
*** 880,887 ****
ins_undefined(data->discard, fn);
exit_logical(data, fn);
}
! else if ((len = list_length(data->args->car)) >= 2)
{
- struct list *clause = data->args->car;
struct list *body = clause->cdr;
--- 963,973 ----
ins_undefined(data->discard, fn);
exit_logical(data, fn);
+ return;
}
!
! clause = extract_location(data->args->car, &l);
! len = list_length(clause);
! if (len >= 2)
{
struct list *body = clause->cdr;
***************
*** 935,939 ****
else
{
! struct list *clause = data->args->car;
data->args = data->args->cdr;
--- 1021,1025 ----
else
{
! value clause = data->args->car;
data->args = data->args->cdr;
***************
*** 984,988 ****
else
{
! struct list *clause = data->args->car;
data->args = data->args->cdr;
--- 1070,1074 ----
else
{
! value clause = data->args->car;
data->args = data->args->cdr;
***************
*** 1032,1036 ****
while (args->cdr)
{
! struct list *clause;
if (nextclause)
--- 1118,1122 ----
while (args->cdr)
{
! struct list *clause, *datums;
if (nextclause)
***************
*** 1039,1043 ****
args = args->cdr;
! clause = args->car;
if (list_length(clause) < 2)
log_error(l, "invalid case clause");
--- 1125,1129 ----
args = args->cdr;
! clause = extract_location(args->car, &l);
if (list_length(clause) < 2)
log_error(l, "invalid case clause");
***************
*** 1049,1064 ****
terminate(done, discard, fn);
}
! else if (list_length(clause->car) < 0)
log_error(l, "invalid case datums");
! else if (clause->car) /* empty datums is ok, but should be ignored */
{
- struct list *datums;
label match = new_label(fn);
GCPRO1(datums);
! for (datums = clause->car; datums; datums = datums->cdr)
{
scompile_recall(l, CASEVARNAME, fn);
! ins_constant(datums->car, fn);
ins0(OPmeq, fn);
if (datums->cdr)
--- 1135,1149 ----
terminate(done, discard, fn);
}
! else if (list_length((datums = skip_location(clause->car))) < 0)
log_error(l, "invalid case datums");
! else if (datums) /* empty datums is ok, but should be ignored */
{
label match = new_label(fn);
GCPRO1(datums);
! for (; datums; datums = datums->cdr)
{
scompile_recall(l, CASEVARNAME, fn);
! ins_constant(filter_locations_mgc(datums->car), fn);
ins0(OPmeq, fn);
if (datums->cdr)
***************
*** 1174,1177 ****
--- 1259,1263 ----
return;
case type_pair:
+ v = extract_location(v, &l);
compile_list_mgc(l, v, discard, fn);
return;
Index: tokens.h
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/tokens.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** tokens.h 25 Oct 2005 22:33:21 -0000 1.4
--- tokens.h 19 Nov 2005 00:42:09 -0000 1.5
***************
*** 31,74 ****
FOR = 262,
ASSIGN = 263,
! QUOTE = 264,
! BREAK = 265,
! CONTINUE = 266,
! RETURN = 267,
! SYMBOL = 268,
! BIGINT = 269,
! SINK = 270,
! SWITCH = 271,
! CASE = 272,
! DEFAULT = 273,
! ELLIPSIS = 274,
! DO = 275,
! MODULE = 276,
! LIBRARY = 277,
! IMPORTS = 278,
! DEFINES = 279,
! READS = 280,
! WRITES = 281,
! INTEGER = 282,
! STRING = 283,
! FLOAT = 284,
! OP_ASSIGN = 285,
! INCREMENTER = 286,
! SCHEME = 287,
! SCHEMEFILE = 288,
! XOR = 289,
! OR = 290,
! SC_OR = 291,
! AND = 292,
! SC_AND = 293,
! GE = 294,
! GT = 295,
! LE = 296,
! LT = 297,
! NE = 298,
! EQ = 299,
! SHIFT_RIGHT = 300,
! SHIFT_LEFT = 301,
! UMINUS = 302,
! NOT = 303
};
#endif
--- 31,73 ----
FOR = 262,
ASSIGN = 263,
! BREAK = 264,
! CONTINUE = 265,
! RETURN = 266,
! SINK = 267,
! SWITCH = 268,
! CASE = 269,
! DEFAULT = 270,
! ELLIPSIS = 271,
! DO = 272,
! MODULE = 273,
! LIBRARY = 274,
! IMPORTS = 275,
! DEFINES = 276,
! READS = 277,
! WRITES = 278,
! SYMBOL = 279,
! INTEGER = 280,
! STRING = 281,
! FLOAT = 282,
! OP_ASSIGN = 283,
! INCREMENTER = 284,
! SCHEME = 285,
! SCHEMEFILE = 286,
! QUOTE = 287,
! XOR = 288,
! OR = 289,
! SC_OR = 290,
! AND = 291,
! SC_AND = 292,
! GE = 293,
! GT = 294,
! LE = 295,
! LT = 296,
! NE = 297,
! EQ = 298,
! SHIFT_RIGHT = 299,
! SHIFT_LEFT = 300,
! UMINUS = 301,
! NOT = 302
};
#endif
***************
*** 79,122 ****
#define FOR 262
#define ASSIGN 263
! #define QUOTE 264
! #define BREAK 265
! #define CONTINUE 266
! #define RETURN 267
! #define SYMBOL 268
! #define BIGINT 269
! #define SINK 270
! #define SWITCH 271
! #define CASE 272
! #define DEFAULT 273
! #define ELLIPSIS 274
! #define DO 275
! #define MODULE 276
! #define LIBRARY 277
! #define IMPORTS 278
! #define DEFINES 279
! #define READS 280
! #define WRITES 281
! #define INTEGER 282
! #define STRING 283
! #define FLOAT 284
! #define OP_ASSIGN 285
! #define INCREMENTER 286
! #define SCHEME 287
! #define SCHEMEFILE 288
! #define XOR 289
! #define OR 290
! #define SC_OR 291
! #define AND 292
! #define SC_AND 293
! #define GE 294
! #define GT 295
! #define LE 296
! #define LT 297
! #define NE 298
! #define EQ 299
! #define SHIFT_RIGHT 300
! #define SHIFT_LEFT 301
! #define UMINUS 302
! #define NOT 303
--- 78,120 ----
#define FOR 262
#define ASSIGN 263
! #define BREAK 264
! #define CONTINUE 265
! #define RETURN 266
! #define SINK 267
! #define SWITCH 268
! #define CASE 269
! #define DEFAULT 270
! #define ELLIPSIS 271
! #define DO 272
! #define MODULE 273
! #define LIBRARY 274
! #define IMPORTS 275
! #define DEFINES 276
! #define READS 277
! #define WRITES 278
! #define SYMBOL 279
! #define INTEGER 280
! #define STRING 281
! #define FLOAT 282
! #define OP_ASSIGN 283
! #define INCREMENTER 284
! #define SCHEME 285
! #define SCHEMEFILE 286
! #define QUOTE 287
! #define XOR 288
! #define OR 289
! #define SC_OR 290
! #define AND 291
! #define SC_AND 292
! #define GE 293
! #define GT 294
! #define LE 295
! #define LT 296
! #define NE 297
! #define EQ 298
! #define SHIFT_RIGHT 299
! #define SHIFT_LEFT 300
! #define UMINUS 301
! #define NOT 302
***************
*** 126,129 ****
--- 124,128 ----
#line 37 "../standalone/parser.y"
typedef union YYSTYPE {
+ location location;
char *string;
char *symbol;
***************
*** 149,153 ****
} YYSTYPE;
/* Line 1985 of glr.c. */
! #line 151 "parser.tab.h"
# define YYSTYPE_IS_DECLARED 1
# define YYSTYPE_IS_TRIVIAL 1
--- 148,152 ----
} YYSTYPE;
/* Line 1985 of glr.c. */
! #line 150 "parser.tab.h"
# define YYSTYPE_IS_DECLARED 1
# define YYSTYPE_IS_TRIVIAL 1
Index: tree.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/tree.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** tree.c 6 Oct 2005 23:38:01 -0000 1.3
--- tree.c 19 Nov 2005 00:42:09 -0000 1.4
***************
*** 146,149 ****
--- 146,151 ----
newp->vclass = vclass;
+ newp->loc.filename = NULL;
+ newp->loc.lineno = 0;
va_start(args, vclass);
switch (vclass)
***************
*** 155,162 ****
newp->u.string = va_arg(args, const char *);
break;
! case cst_list: case cst_array: case cst_table:
newp->u.constants = va_arg(args, cstlist);
break;
case cst_quote:
newp->u.constant = va_arg(args, constant);
break;
--- 157,168 ----
newp->u.string = va_arg(args, const char *);
break;
! case cst_list:
! newp->loc = va_arg(args, location);
! /* fall through */
! case cst_array: case cst_table:
newp->u.constants = va_arg(args, cstlist);
break;
case cst_quote:
+ newp->loc = va_arg(args, location);
newp->u.constant = va_arg(args, constant);
break;
***************
*** 464,468 ****
case c_constant: case c_scheme:
! val = make_constant(c->u.cst, NULL);
mc->data[1] = val;
break;
--- 470,474 ----
case c_constant: case c_scheme:
! val = make_constant(c->u.cst, FALSE, NULL);
mc->data[1] = val;
break;
Index: tree.h
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/tree.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** tree.h 6 Oct 2005 23:38:01 -0000 1.3
--- tree.h 19 Nov 2005 00:42:09 -0000 1.4
***************
*** 77,80 ****
--- 77,81 ----
struct _constant {
enum constant_class vclass;
+ location loc;
union {
int integer;
More information about the Tinyos-commits
mailing list