[Tinyos-commits] CVS: tinyos-1.x/tos/lib/VM/languages/motlle/standalone mudlle.h, 1.4, 1.5 scheme.c, 1.12, 1.13

[David Gay]

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

Modified Files:
	mudlle.h scheme.c 
Log Message:
case
depth fixes


Index: mudlle.h
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/mudlle.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** mudlle.h	19 May 2005 17:23:48 -0000	1.4
--- mudlle.h	18 Nov 2005 22:28:30 -0000	1.5
***************
*** 87,90 ****
--- 87,92 ----
  #endif
  
+ #define undefined_value makeint(42)
+ 
  #ifdef MDBG
  #define MDBGLEDS(x) motlle_req_leds(led_ ## x)

Index: scheme.c
===================================================================
RCS file: /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/standalone/scheme.c,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** scheme.c	18 Nov 2005 20:27:47 -0000	1.12
--- scheme.c	18 Nov 2005 22:28:30 -0000	1.13
***************
*** 16,22 ****
  #include <string.h>
  
! static void ins_undefined(fncode fn)
  {
!   ins_constant(makeint(42), fn);
  }
  
--- 16,37 ----
  #include <string.h>
  
! static void ins_undefined(bool discard, fncode fn)
  {
!   if (!discard)
!     ins_constant(undefined_value, fn);
! }
! 
! static void terminate(label lab, bool discard, fncode fn)
! {
!   branch(OPmba3, lab, fn);
!   if (!discard)
!     adjust_depth(-1, fn);
! }
! 
! static void entry_with_data(label lab, bool discard, fncode fn)
! {
!   set_label(lab, fn);
!   if (!discard)
!     adjust_depth(1, fn);
  }
  
***************
*** 54,60 ****
  }
  
  static vlist sym2vlist(block_t region, value sym)
  {
!   return new_vlist(region, sym2str(region, sym), stype_any, NULL, NULL);
  }
  
--- 69,80 ----
  }
  
+ 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));
  }
  
***************
*** 290,296 ****
    set_label(data->slab, fn);
    scheme_compile_mgc(l, data->success, data->discard, fn);
!   branch(OPmba3, data->endlab, fn);
!   if (!data->discard)
!     adjust_depth(-1, fn);
  }
  
--- 310,314 ----
    set_label(data->slab, fn);
    scheme_compile_mgc(l, data->success, data->discard, fn);
!   terminate(data->endlab, data->discard, fn);
  }
  
***************
*** 301,307 ****
    set_label(data->flab, fn);
    scheme_compile_mgc(l, data->failure, data->discard, fn);
!   branch(OPmba3, data->endlab, fn);
!   if (!data->discard)
!     adjust_depth(-1, fn);
  }
  
--- 319,323 ----
    set_label(data->flab, fn);
    scheme_compile_mgc(l, data->failure, data->discard, fn);
!   terminate(data->endlab, data->discard, fn);
  }
  
***************
*** 321,328 ****
  		     ifdata.slab, ifs_code_mgc, &ifdata,
  		     ifdata.flab, iff_code_mgc, &ifdata, fn);
-   set_label(ifdata.endlab, fn);
-   if (!discard)
-     adjust_depth(1, fn);
    GCPOP(2);
  }
  
--- 337,342 ----
  		     ifdata.slab, ifs_code_mgc, &ifdata,
  		     ifdata.flab, iff_code_mgc, &ifdata, fn);
    GCPOP(2);
+   entry_with_data(ifdata.endlab, discard, fn);
  }
  
***************
*** 493,497 ****
      sgen_if_mgc(l, cond, true, args->car, discard, fn);
    else
!     sgen_if_mgc(l, cond, true, makeint(42), discard, fn);
  }
  
--- 507,511 ----
      sgen_if_mgc(l, cond, true, args->car, discard, fn);
    else
!     sgen_if_mgc(l, cond, true, undefined_value, discard, fn);
  }
  
***************
*** 751,757 ****
  static void exit_logical(struct logicaldata *data, fncode fn)
  {
!   branch(OPmba3, data->endlab, fn);
!   if (!data->discard)
!     adjust_depth(-1, fn);
  }
  
--- 765,769 ----
  static void exit_logical(struct logicaldata *data, fncode fn)
  {
!   terminate(data->endlab, data->discard, fn);
  }
  
***************
*** 772,777 ****
    struct logicaldata *data = _data;
  
!   set_label(data->truelab, fn);
!   adjust_depth(1, fn);
    compile_call_mgc(l, nth(data->args->car, 3), 1, data->discard, fn);
    exit_logical(data, fn);
--- 784,788 ----
    struct logicaldata *data = _data;
  
!   entry_with_data(data->truelab, FALSE, fn);
    compile_call_mgc(l, nth(data->args->car, 3), 1, data->discard, fn);
    exit_logical(data, fn);
***************
*** 801,805 ****
    if (!data->args)
      {
!       scheme_compile_mgc(l, makeint(42), data->discard, fn);
        exit_logical(data, fn);
      }
--- 812,816 ----
    if (!data->args)
      {
!       ins_undefined(data->discard, fn);
        exit_logical(data, fn);
      }
***************
*** 844,848 ****
    continue_cond_mgc(l, &logicaldata, fn);
    GCPOP(1);
!   set_label(logicaldata.endlab, fn);
  }
  
--- 855,859 ----
    continue_cond_mgc(l, &logicaldata, fn);
    GCPOP(1);
!   entry_with_data(logicaldata.endlab, discard, fn);
  }
  
***************
*** 938,944 ****
    continue_or_mgc(l, &logicaldata, fn);
    GCPOP(1);
!   set_label(logicaldata.endlab, fn);
  }
  
  
  static struct {
--- 949,1016 ----
    continue_or_mgc(l, &logicaldata, fn);
    GCPOP(1);
!   entry_with_data(logicaldata.endlab, discard, fn);
  }
  
+ #define CASEVARNAME ".case."
+ static void compile_case_mgc(location l, struct list *args, bool discard, fncode fn)
+ {
+   label nextclause = NULL;
+   label done = new_label(fn);
+ 
+   env_block_push(NULL);
+   env_declare(str2vlist(fnmemory(fn), CASEVARNAME));
+   GCPRO1(args);
+   scheme_compile_mgc(l, args->car, FALSE, fn);
+   sgen_assign_mgc(l, CASEVARNAME, TRUE, fn);
+ 
+   while (args->cdr)
+     {
+       struct list *clause;
+ 
+       if (nextclause)
+ 	set_label(nextclause, fn);
+       nextclause = new_label(fn);
+ 
+       args = args->cdr;
+       clause = args->car;
+       if (list_length(clause) < 2)
+ 	log_error(l, "invalid case clause");
+       else if (is_keyword(clause->car, "else"))
+ 	{
+ 	  if (args->cdr)
+ 	    log_error(l, "else clause must be last in case");
+ 	  compile_begin_mgc(l, clause->cdr, discard, fn);
+ 	  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)
+ 		branch(OPmbt3, match, fn);
+ 	      else
+ 		branch(OPmbf3, nextclause, fn);
+ 	    }
+ 	  GCPOP(1);
+ 	  set_label(match, fn);
+ 	  compile_begin_mgc(l, clause->cdr, discard, fn);
+ 	  terminate(done, discard, fn);
+ 	}
+     }
+   GCPOP(1);
+   set_label(nextclause, fn);
+   ins_undefined(discard, fn);
+   set_label(done, fn);
+   env_block_pop();
+ }
  
  static struct {
***************
*** 961,964 ****
--- 1033,1037 ----
    { "and", 0, compile_and_mgc },
    { "or", 0, compile_or_mgc },
+   { "case", -2, compile_case_mgc },
  };