[Tinyos-commits] CVS: tinyos-1.x/tos/lib/VM/languages/motlle/standalone mparser.c, 1.7, 1.8 parser.y, 1.7, 1.8 scheme.c, 1.15, 1.16

David Gay idgay at users.sourceforge.net
Tue Nov 22 10:33:13 PST 2005 

Update of /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27250/standalone

Modified Files:
	mparser.c parser.y scheme.c 
Log Message:
regression tests and bug fixes


Index: mparser.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/mparser.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** mparser.c	19 Nov 2005 00:42:09 -0000	1.7
--- mparser.c	22 Nov 2005 18:33:11 -0000	1.8
***************
*** 2220,2224 ****
    case 155:
  #line 648 "../standalone/parser.y"
!     { (*yyvalp).tconstant = new_constant(parser_memory, cst_list, NULL); ;}
      break;
  
--- 2220,2224 ----
    case 155:
  #line 648 "../standalone/parser.y"
!     { (*yyvalp).tconstant = new_constant(parser_memory, cst_list, yyvsp[-1].yystate.yysemantics.yysval.location, NULL); ;}
      break;
  

Index: parser.y
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/parser.y,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** parser.y	19 Nov 2005 00:42:09 -0000	1.7
--- parser.y	22 Nov 2005 18:33:11 -0000	1.8
***************
*** 646,650 ****
      $$ = new_constant(parser_memory, cst_list, $1, new_cstlist(parser_memory, $3, $2));
    } |
!   '(' ')' { $$ = new_constant(parser_memory, cst_list, NULL); } ;
  
  optional_constant_tail :
--- 646,650 ----
      $$ = new_constant(parser_memory, cst_list, $1, new_cstlist(parser_memory, $3, $2));
    } |
!   '(' ')' { $$ = new_constant(parser_memory, cst_list, $1, NULL); } ;
  
  optional_constant_tail :

Index: scheme.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/scheme.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** scheme.c	19 Nov 2005 00:42:09 -0000	1.15
--- scheme.c	22 Nov 2005 18:33:11 -0000	1.16
***************
*** 124,135 ****
  }
  
! static vlist str2vlist(block_t region, const char *str)
  {
!   return new_vlist(region, str, stype_any, NULL, NULL);
  }
  
! static vlist sym2vlist(block_t region, value sym)
  {
!   return str2vlist(region, sym2str(region, sym));
  }
  
--- 124,137 ----
  }
  
! static vlist str2vlist(block_t region, location l, const char *str)
  {
!   vlist v = new_vlist(region, str, stype_any, NULL, NULL);
!   v->l = l;
!   return v;
  }
  
! static vlist sym2vlist(block_t region, location l, value sym)
  {
!   return str2vlist(region, l, sym2str(region, sym));
  }
  
***************
*** 303,307 ****
      {
        /* Just swap conclusions */
!       sgen_condition_mgc(l, nth(condition, 2), FALSE,
  			 flab, fcode, fdata, slab, scode, sdata, fn);
        return;
--- 305,309 ----
      {
        /* Just swap conclusions */
!       sgen_condition_mgc(l, nth(skip_location(condition), 2), FALSE,
  			 flab, fcode, fdata, slab, scode, sdata, fn);
        return;
***************
*** 425,429 ****
  		expr = skip_location(expr->car);
  	      if (TYPE(expr->car, type_symbol))
! 		env_declare(sym2vlist(fnmemory(fn), expr->car));
  
  	    }
--- 427,431 ----
  		expr = skip_location(expr->car);
  	      if (TYPE(expr->car, type_symbol))
! 		env_declare(sym2vlist(fnmemory(fn), l, expr->car));
  
  	    }
***************
*** 468,472 ****
    struct string *help, *afilename;
    fncode newfn;
!   vlist fnargs;
    u16 clen;
    i8 nargs;
--- 470,474 ----
    struct string *help, *afilename;
    fncode newfn;
!   vlist fnargs = NULL;
    u16 clen;
    i8 nargs;
***************
*** 488,496 ****
  
    nargs = list_length(formals);
    if (nargs < -1) /* we don't support (arg1 ... argn . argrest) */
      {
        log_error(l, "(x1 ... xn . rest) parameter syntax not supported");
        nargs = 0;
-       fnargs = NULL;
      }
    else if (nargs == -1)
--- 490,499 ----
  
    nargs = list_length(formals);
+   if (nargs >= 16)
+     log_error(l, "no more than 15 parameters allowed");
    if (nargs < -1) /* we don't support (arg1 ... argn . argrest) */
      {
        log_error(l, "(x1 ... xn . rest) parameter syntax not supported");
        nargs = 0;
      }
    else if (nargs == -1)
***************
*** 499,503 ****
  	log_error(l, "symbol expected");
        else
! 	fnargs = sym2vlist(region, formals);
      }
    else
--- 502,506 ----
  	log_error(l, "symbol expected");
        else
! 	fnargs = sym2vlist(region, l, formals);
      }
    else
***************
*** 506,510 ****
        vlist *nextarg = &fnargs;
  
-       fnargs = NULL;
        for (actual_args = formals; actual_args; actual_args = actual_args->cdr)
  	if (!TYPE(actual_args->car, type_symbol))
--- 509,512 ----
***************
*** 512,516 ****
  	else
  	  {
! 	    *nextarg = sym2vlist(region, actual_args->car);
  	    nextarg = &(*nextarg)->next;
  	  }
--- 514,518 ----
  	else
  	  {
! 	    *nextarg = sym2vlist(region, l, actual_args->car);
  	    nextarg = &(*nextarg)->next;
  	  }
***************
*** 609,615 ****
    int toplevel = fntoplevel(fn);
  
!   if (TYPE(args->car, type_symbol))
      {
!       vfn = sym2vlist(fnmemory(fn), args->car);
        define_of(l, vfn, fn);
        scheme_compile_mgc(l, nth(args, 2), FALSE, fn);
--- 611,617 ----
    int toplevel = fntoplevel(fn);
  
!   if (TYPE(args->car, type_symbol) && list_length(args) == 2)
      {
!       vfn = sym2vlist(fnmemory(fn), l, args->car);
        define_of(l, vfn, fn);
        scheme_compile_mgc(l, nth(args, 2), FALSE, fn);
***************
*** 623,627 ****
  	  struct symbol *name = fndecl->car;
  
! 	  vfn = sym2vlist(fnmemory(fn), name);
  	  define_of(l, vfn, fn);
  	  sgen_function_mgc(l, name->name, fndecl->cdr, args->cdr, FALSE, fn);
--- 625,629 ----
  	  struct symbol *name = fndecl->car;
  
! 	  vfn = sym2vlist(fnmemory(fn), l, name);
  	  define_of(l, vfn, fn);
  	  sgen_function_mgc(l, name->name, fndecl->cdr, args->cdr, FALSE, fn);
***************
*** 659,663 ****
  static void sgen_binding_decl(location l, struct list *binding, fncode fn)
  {
!   env_declare(sym2vlist(fnmemory(fn), binding->car));
  }
  
--- 661,665 ----
  static void sgen_binding_decl(location l, struct list *binding, fncode fn)
  {
!   env_declare(sym2vlist(fnmemory(fn), l, binding->car));
  }
  
***************
*** 722,726 ****
    env_block_push(NULL);
    cname = sym2str(fnmemory(fn), args->car);
!   env_declare(str2vlist(fnmemory(fn), cname));
  
    bindings = extract_location(nth(args, 2), &l);
--- 724,728 ----
    env_block_push(NULL);
    cname = sym2str(fnmemory(fn), args->car);
!   env_declare(str2vlist(fnmemory(fn), l, cname));
  
    bindings = extract_location(nth(args, 2), &l);
***************
*** 753,758 ****
    if (bindings)
      log_error(l, "invalid bindings");
-   if (nargs >= 16)
-     log_error(l, "no more than 15 arguments allowed");
    name = args->car;
    sgen_function_mgc(l, name->name, parameters, nthtail(args, 3), FALSE, fn);
--- 755,758 ----
***************
*** 782,787 ****
  }
  
! static void letstar_bindings_mgc(location l, struct list *bindings, fncode fn)
  {
    GCPRO1(bindings);
    for (; TYPE(bindings, type_pair); bindings = bindings->cdr)
--- 782,789 ----
  }
  
! static int letstar_bindings_mgc(location l, struct list *bindings, fncode fn)
  {
+   int count = 0;
+ 
    GCPRO1(bindings);
    for (; TYPE(bindings, type_pair); bindings = bindings->cdr)
***************
*** 791,796 ****
--- 793,800 ----
        if (check_binding(l, binding, 0))
  	{
+ 	  count++;
  	  GCPRO1(binding);
  	  sgen_binding_init_mgc(l, binding, fn);
+ 	  env_block_push(NULL);
  	  sgen_binding_decl(l, binding, fn);
  	  sgen_binding_assign_mgc(l, binding, fn);
***************
*** 801,804 ****
--- 805,810 ----
      log_error(l, "invalid bindings");
    GCPOP(1);
+ 
+   return count;
  }
  
***************
*** 806,815 ****
  {
    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);
  }
--- 812,824 ----
  {
    value bindings;
+   int count;
  
    GCPRO1(args);
+   env_block_push(NULL); // useless, but let_body_mgc has a pop
    bindings = extract_location(args->car, &l);
!   count = letstar_bindings_mgc(l, bindings, fn);
    let_body_mgc(l, args->cdr, discard, fn);
+   while (count--)
+     env_block_pop();
    GCPOP(1);
  }
***************
*** 836,840 ****
  	  sgen_binding_assign_mgc(l, binding, fn);
  	}
!       GCPOP(1);
      }
    else if (bindings)
--- 845,849 ----
  	  sgen_binding_assign_mgc(l, binding, fn);
  	}
!       GCPOP(2);
      }
    else if (bindings)
***************
*** 859,865 ****
      {
        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);
      }
--- 868,874 ----
      {
        GCPRO1(bindings);
!       scheme_compile_mgc(l, nth(skip_location(bindings->car), 3), FALSE, fn);
        do_var_update_mgc(l, bindings->cdr, fn);
!       sgen_binding_assign_mgc(l, skip_location(bindings->car), fn);
        GCPOP(1);
      }
***************
*** 879,886 ****
    set_label(looplab, fn);
    exitpart = extract_location(nth(args, 2), &exitl);
!   if (list_length(exitpart) < 2)
      {
        ok = FALSE;
!       log_error(exitl, "invalid do");
      }
    else
--- 888,895 ----
    set_label(looplab, fn);
    exitpart = extract_location(nth(args, 2), &exitl);
!   if (list_length(exitpart) < 1)
      {
        ok = FALSE;
!       log_error(exitl, "invalid do exit condition");
      }
    else
***************
*** 889,893 ****
    body = nthtail(args, 3);
    set_label(contlab, fn);
!   compile_block_mgc(l, body, TRUE, fn);
    if (ok)
      {
--- 898,903 ----
    body = nthtail(args, 3);
    set_label(contlab, fn);
!   if (body)
!     compile_block_mgc(l, body, TRUE, fn);
    if (ok)
      {
***************
*** 900,904 ****
      {
        exitpart = skip_location(nth(args, 2));
!       compile_begin_mgc(exitl, exitpart->cdr, discard, fn);
      }
    GCPOP(1);
--- 910,917 ----
      {
        exitpart = skip_location(nth(args, 2));
!       if (exitpart->cdr)
! 	compile_begin_mgc(exitl, exitpart->cdr, discard, fn);
!       else
! 	ins_undefined(discard, fn);
      }
    GCPOP(1);
***************
*** 1111,1115 ****
  
    env_block_push(NULL);
!   env_declare(str2vlist(fnmemory(fn), CASEVARNAME));
    GCPRO1(args);
    scheme_compile_mgc(l, args->car, FALSE, fn);
--- 1124,1128 ----
  
    env_block_push(NULL);
!   env_declare(str2vlist(fnmemory(fn), l, CASEVARNAME));
    GCPRO1(args);
    scheme_compile_mgc(l, args->car, FALSE, fn);
***************
*** 1180,1184 ****
    { "let*", -2, compile_letstar_mgc },
    { "letrec", -2, compile_letrec_mgc },
!   { "do", -3, compile_do_mgc },
    { "cond", -1, compile_cond_mgc },
    { "and", 0, compile_and_mgc },
--- 1193,1197 ----
    { "let*", -2, compile_letstar_mgc },
    { "letrec", -2, compile_letrec_mgc },
!   { "do", -2, compile_do_mgc },
    { "cond", -1, compile_cond_mgc },
    { "and", 0, compile_and_mgc },
***************
*** 1205,1215 ****
  	if (!strcmp(name->str, syntax[i].keyword))
  	  {
  	    if (syntax[i].nargs > 0)
  	      {
  		if (nargs != syntax[i].nargs)
  		  {
! 		    log_error(l, "%s expected %d arguments",
! 			      syntax[i].keyword, syntax[i].nargs);
! 		    break;
  		  }
  	      }
--- 1218,1230 ----
  	if (!strcmp(name->str, syntax[i].keyword))
  	  {
+ 	    const char *plural_args = abs(syntax[i].nargs) == 1 ? "" : "s";
+ 
  	    if (syntax[i].nargs > 0)
  	      {
  		if (nargs != syntax[i].nargs)
  		  {
! 		    log_error(l, "%s expected %d argument%s",
! 			      syntax[i].keyword, syntax[i].nargs, plural_args);
! 		    return;
  		  }
  	      }
***************
*** 1218,1230 ****
  		if (nargs < -syntax[i].nargs)
  		  {
! 		    log_error(l, "%s expected at least %d arguments",
! 			      syntax[i].keyword, -syntax[i].nargs);
! 		    break;
  		  }
  		if (syntax[i].maxargs && nargs > syntax[i].maxargs)
  		  {
! 		    log_error(l, "%s expected at most %d arguments",
! 			      syntax[i].keyword, syntax[i].maxargs);
! 		    break;
  		  }
  	      }
--- 1233,1245 ----
  		if (nargs < -syntax[i].nargs)
  		  {
! 		    log_error(l, "%s expected at least %d argument%s",
! 			      syntax[i].keyword, -syntax[i].nargs, plural_args);
! 		    return;
  		  }
  		if (syntax[i].maxargs && nargs > syntax[i].maxargs)
  		  {
! 		    log_error(l, "%s expected at most %d argument%s",
! 			      syntax[i].keyword, syntax[i].maxargs, plural_args);
! 		    return;
  		  }
  	      }

More information about the Tinyos-commits mailing list