[foo-cvs] foo/elkfoo/src Makefile.am,1.4,1.5 bpf.m,1.4,1.5 context.m,1.4,1.5 defaults.m,1.1,1.2 foof

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/foo/foo/elkfoo/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8258

Modified Files:
	Makefile.am bpf.m context.m defaults.m foofun.m main.c 
	module.m modules.m signals.m task.m 
Log Message:
kernighan/ritchie goes ANSI.  turned disabled serialization stuff into dummy functions

Index: foofun.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/foofun.m,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** foofun.m	4 Aug 2004 07:15:58 -0000	1.1
--- foofun.m	6 Aug 2004 02:52:59 -0000	1.2
***************
*** 45,99 ****
  #include <math.h>

! static SchemeObject P_Shelfing_Coefs (sGl, sGm, sGh, sfl, sfh, ssr)
! SchemeObject sGl, sGm, sGh, sfl, sfh, ssr;
  {
!     SchemeObject ret = Null;
!     double k1, k2, r1, r2, k1r1, k2r2, a1, a2, b1, b2, c1, c2;
!     double C0, C1, C2, D0, D1, D2;
!     double Gl = Get_Double(sGl);
!     double Gm = Get_Double(sGm);
!     double Gh = Get_Double(sGh);
!     double fl = Get_Double(sfl);
!     double fh = Get_Double(sfh);
!     double sr = Get_Double(ssr);
!     double pi = 4.*atan(1.);
!     GC_Node;

!     GC_Link(ret);

!     k1 = pow(10., (Gl - Gm) / 20);
!     r1 = tan(pi * (fl / sr)) / sqrt(k1);
!     k1r1 = k1 * r1;
!     c1 = (k1r1 + 1) / (r1 + 1);
!     b1 = (k1r1 - 1) / (k1r1 + 1);
!     a1 = (r1 - 1) / (r1 + 1);

!     k2 = pow(10., (Gm - Gh) / 20);
!     r2 = tan(pi * (fh / sr)) / sqrt(k2);
!     k2r2 = k2 * r2;
!     c2 = (k2r2 + 1) / (r2 + 1);
!     b2 = (k2r2 - 1) / (k2r2 + 1);
!     a2 = (r2 - 1) / (r2 + 1);

!     C0 = c1 * c2 * pow(10., Gh / 20);

!     C1 = a1 + a2;
!     C2 = a1 * a2;
!     D0 = C0;
!     D1 = C0 * (b1 + b2);
!     D2 = C0 * (b1 * b2);

!     ret = Cons(Make_Reduced_Flonum(C2), ret);
!     ret = Cons(Make_Reduced_Flonum(C1), ret);
!     ret = Cons(Make_Reduced_Flonum(D2), ret);
!     ret = Cons(Make_Reduced_Flonum(D1), ret);
!     ret = Cons(Make_Reduced_Flonum(D0), ret);

!     GC_Unlink;;
!     return ret;
  }

! void elk_init_foofun()
  {
!     Define_Primitive(P_Shelfing_Coefs,  "foo:shelfing-coefs",	6, 6, EVAL);
  }
--- 45,108 ----
  #include <math.h>

! 
! static SchemeObject
! P_Shelfing_Coefs (SchemeObject sGl,
! 		  SchemeObject sGm,
! 		  SchemeObject sGh,
! 		  SchemeObject sfl,
! 		  SchemeObject sfh,
! 		  SchemeObject ssr)
  {
!   SchemeObject ret = Null;
!   double k1, k2, r1, r2, k1r1, k2r2, a1, a2, b1, b2, c1, c2;
!   double C0, C1, C2, D0, D1, D2;
!   double Gl = Get_Double(sGl);
!   double Gm = Get_Double(sGm);
!   double Gh = Get_Double(sGh);
!   double fl = Get_Double(sfl);
!   double fh = Get_Double(sfh);
!   double sr = Get_Double(ssr);
!   double pi = 4.*atan(1.);
!   GC_Node;

!   GC_Link(ret);

!   k1 = pow(10., (Gl - Gm) / 20);
!   r1 = tan(pi * (fl / sr)) / sqrt(k1);
!   k1r1 = k1 * r1;
!   c1 = (k1r1 + 1) / (r1 + 1);
!   b1 = (k1r1 - 1) / (k1r1 + 1);
!   a1 = (r1 - 1) / (r1 + 1);

!   k2 = pow(10., (Gm - Gh) / 20);
!   r2 = tan(pi * (fh / sr)) / sqrt(k2);
!   k2r2 = k2 * r2;
!   c2 = (k2r2 + 1) / (r2 + 1);
!   b2 = (k2r2 - 1) / (k2r2 + 1);
!   a2 = (r2 - 1) / (r2 + 1);

!   C0 = c1 * c2 * pow(10., Gh / 20);

!   C1 = a1 + a2;
!   C2 = a1 * a2;
!   D0 = C0;
!   D1 = C0 * (b1 + b2);
!   D2 = C0 * (b1 * b2);

!   ret = Cons(Make_Reduced_Flonum(C2), ret);
!   ret = Cons(Make_Reduced_Flonum(C1), ret);
!   ret = Cons(Make_Reduced_Flonum(D2), ret);
!   ret = Cons(Make_Reduced_Flonum(D1), ret);
!   ret = Cons(Make_Reduced_Flonum(D0), ret);

!   GC_Unlink;;
! 
!   return ret;
  }

! 
! void
! elk_init_foofun ()
  {
!   Define_Primitive(P_Shelfing_Coefs,  "foo:shelfing-coefs",	6, 6, EVAL);
  }

Index: context.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/context.m,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** context.m	5 Aug 2004 22:37:56 -0000	1.4
--- context.m	6 Aug 2004 02:52:59 -0000	1.5
***************
*** 53,111 ****

! static void Check_Context(o)
! SchemeObject o;
  {
!     Check_Type(o, T_Context);
!     if (CONTEXT_T(o)->pointer == NULL)
! 	Primitive_Error("dead context");
  }

! SchemeObject Get_Context()
  {
!     SchemeObject context;

!     context = Var_Get(V_Context);
!     if (!Truep(context))
! 	Primitive_Error("no current context");
!     if (TYPE(context) != T_Context)
! 	Primitive_Error("illegal current context");
!     return context;
  }

! id getCurrentContext() /* used in ../kernel/Context.h */
  {
!     id context;
!     const char *oldErrorTag;

!     oldErrorTag = Error_Tag;
!     Error_Tag = "getCurrentContext";
!     context = CONTEXT_T(Get_Context())->pointer;
!     Error_Tag = oldErrorTag;
!     return context;
  }

! static SchemeObject P_Contextp(x)
! SchemeObject x;
  {
!     return TYPE(x) == T_Context ? True : False;
  }

! static SchemeObject P_Context_Lockedp(context)
! SchemeObject context;
  {
!     Check_Context(context);
!     return [CONTEXT_T(context)->pointer isLocked] == YES ? True : False;
  }

! static SchemeObject P_Context_Channels(context)
! SchemeObject context;
  {
!     Check_Context(context);
!     return Make_Integer(CONTEXT_T(context)->channels);
  }

--- 53,119 ----

! static void
! Check_Context (SchemeObject o)
  {
!   Check_Type(o, T_Context);
!   if (CONTEXT_T(o)->pointer == NULL)
!     {
!       Primitive_Error("dead context");
!     }
  }

! SchemeObject
! Get_Context ()
  {
!   SchemeObject context;

!   context = Var_Get(V_Context);
!   if (!Truep(context))
!     {
!       Primitive_Error("no current context");
!     }
!   if (TYPE(context) != T_Context)
!     {
!       Primitive_Error("illegal current context");
!     }
!   return context;
  }

! id
! getCurrentContext () /* used in ../kernel/Context.h */
  {
!   id context;
!   const char *oldErrorTag;

!   oldErrorTag = Error_Tag;
!   Error_Tag = "getCurrentContext";
!   context = CONTEXT_T(Get_Context())->pointer;
!   Error_Tag = oldErrorTag;
!   return context;
  }

! static SchemeObject
! P_Contextp (SchemeObject x)
  {
!   return TYPE(x) == T_Context ? True : False;
  }

! static SchemeObject
! P_Context_Lockedp (SchemeObject context)
  {
!   Check_Context(context);
!   return [CONTEXT_T(context)->pointer isLocked] == YES ? True : False;
  }

! static SchemeObject
! P_Context_Channels (SchemeObject context)
  {
!   Check_Context(context);
!   return Make_Integer(CONTEXT_T(context)->channels);
  }

***************
*** 113,257 ****
  static int Debug_Context = 0;

! 
! static SchemeObject P_Debug_Context(flag)
! SchemeObject flag;
  {
!     int old = Debug_Context;

!     if (Truep(flag))
! 	Debug_Context = 1;
!     else
! 	Debug_Context = 0;
!     return old == 1 ? True : False;
  }

! static SchemeObject Kill_Context(context)
! SchemeObject context;
  {
!     if (Debug_Context == 1) {
! 	fprintf(stderr, "\nkill context %u\n", (unsigned int)CONTEXT_T(context)->pointer);
! 	fflush(stderr);
      }
!     RELEASE(CONTEXT_T(context)->pointer);
!     CONTEXT_T(context)->pointer = NULL;
!     return True;
  }

! static SchemeObject P_Kill_Context(context)
! SchemeObject context;
  {
!     Check_Context(context);
!     Deregister_Object(context);
!     Kill_Context(context);
!     return True;
  }

! static SchemeObject P_Kill_All_Contexts()
  {
!     Terminate_Type(T_Context);
!     return True;
  }

! SchemeObject A_Make_Context(c)
! id c;
  {
!     SchemeObject context = Null, zero = Make_Integer(0);
!     GC_Node;

!     context = Alloc_Object(sizeof(struct S_Context), T_Context, 0);
!     GC_Link(context);
!     CONTEXT_T(context)->times = Null;
!     CONTEXT_T(context)->times = Cons(zero, Cons(zero, Null));
!     CONTEXT_T(context)->pointer = c;
!     CONTEXT_T(context)->channels = [c getNumberOfChannels];
!     Register_Object(context, (GENERIC)0, Kill_Context, 0);
!     GC_Unlink;
!     return context;
  }

! static SchemeObject P_Make_Context(chans)
! SchemeObject chans;
  {
!     SchemeObject context;
!     GC_Node;

!     GC_Link(chans);
!     context = A_Make_Context([[FOOContext alloc] initWithChans: Get_Integer(chans)]);
!     GC_Unlink;
!     return context;
  }

! static SchemeObject P_Push_Time_Frame(context, number)
! SchemeObject context, number;
  {
!     SchemeObject frames = Null;
!     double time;
!     GC_Node3;

!     Check_Context(context);
!     frames = CONTEXT_T(context)->times;
!     GC_Link3(context, number, frames);
!     time = Get_Double(number) + Get_Double(Car(frames));
!     CONTEXT_T(context)->times = Cons(Make_Reduced_Flonum(time), frames);
!     [CONTEXT_T(context)->pointer setTime:time];
!     GC_Unlink;
!     return Make_Reduced_Flonum(time);
  }

! static SchemeObject P_Pop_Time_Frame(context)
! SchemeObject context;
  {
!     SchemeObject frames;
!     double time;

!     Check_Context(context);
!     frames = CONTEXT_T(context)->times;
!     if (Nullp(frames) || Nullp(Cdr(frames)) || Nullp(Cdr(Cdr(frames))))
! 	Primitive_Error("no more time frame to pop");
!     frames = Cdr(frames);
!     time = Get_Double(Car(frames));
!     CONTEXT_T(context)->times = frames;
!     [CONTEXT_T(context)->pointer setTime:time];
!     return Make_Reduced_Flonum(time);
  }

! static SchemeObject P_Context_Time(context)
! SchemeObject context;
  {
!     Check_Context(context);
!     return Make_Reduced_Flonum(Get_Double(Car(CONTEXT_T(context)->times)));
  }

! static SchemeObject P_Context_Time_Frames(context)
! SchemeObject context;
  {
!     Check_Context(context);
!     return CONTEXT_T(context)->times;
  }

! static SchemeObject P_Context_Pointer(context)
! SchemeObject context;
  {
!     Check_Context(context);
!     return A_Make_Pointer(CONTEXT_T(context)->pointer, C_ID);
  }

! // commented out so far
! // int Write_Context(fp, context)
! // FILE *fp;
! // id context;
! // {
  //   //    NXStream *s;
! //     TypedStream *ts;

  // //     if ((s = NXOpenFile(fileno(fp), OBJC_WRITEONLY)) == NULL)
--- 121,285 ----
  static int Debug_Context = 0;

! static SchemeObject
! P_Debug_Context (SchemeObject flag)
  {
!   int old = Debug_Context;

!   if (Truep(flag))
!     {
!       Debug_Context = 1;
!     }
!   else
!     {
!       Debug_Context = 0;
!     }
!   return old == 1 ? True : False;
  }

! static SchemeObject
! Kill_Context (SchemeObject context)
  {
!   if (Debug_Context == 1)
!     {
!       fprintf(stderr, "\nkill context %u\n", (unsigned int)CONTEXT_T(context)->pointer);
!       fflush(stderr);
      }
!   RELEASE(CONTEXT_T(context)->pointer);
!   CONTEXT_T(context)->pointer = NULL;
! 
!   return True;
  }

! static SchemeObject
! P_Kill_Context (SchemeObject context)
  {
!   Check_Context(context);
!   Deregister_Object(context);
!   Kill_Context(context);
! 
!   return True;
  }

! static SchemeObject
! P_Kill_All_Contexts ()
  {
!   Terminate_Type(T_Context);
! 
!   return True;
  }

! SchemeObject
! A_Make_Context (id c)
  {
!   SchemeObject context = Null, zero = Make_Integer(0);
!   GC_Node;

!   context = Alloc_Object(sizeof(struct S_Context), T_Context, 0);
!   GC_Link(context);
!   CONTEXT_T(context)->times = Null;
!   CONTEXT_T(context)->times = Cons(zero, Cons(zero, Null));
!   CONTEXT_T(context)->pointer = c;
!   CONTEXT_T(context)->channels = [c getNumberOfChannels];
!   Register_Object(context, (GENERIC)0, Kill_Context, 0);
!   GC_Unlink;
! 
!   return context;
  }

! static SchemeObject
! P_Make_Context (SchemeObject chans)
  {
!   SchemeObject context;
!   GC_Node;

!   GC_Link(chans);
!   context = A_Make_Context([[FOOContext alloc] initWithChans: Get_Integer(chans)]);
!   GC_Unlink;
! 
!   return context;
  }

! static SchemeObject
! P_Push_Time_Frame (SchemeObject context,
! 		   SchemeObject number)
  {
!   SchemeObject frames = Null;
!   double time;
!   GC_Node3;

!   Check_Context(context);
!   frames = CONTEXT_T(context)->times;
!   GC_Link3(context, number, frames);
!   time = Get_Double(number) + Get_Double(Car(frames));
!   CONTEXT_T(context)->times = Cons(Make_Reduced_Flonum(time), frames);
!   [CONTEXT_T(context)->pointer setTime:time];
!   GC_Unlink;
! 
!   return Make_Reduced_Flonum(time);
  }

! static SchemeObject
! P_Pop_Time_Frame (SchemeObject context)
  {
!   SchemeObject frames;
!   double time;

!   Check_Context(context);
!   frames = CONTEXT_T(context)->times;
!   if (Nullp(frames) || Nullp(Cdr(frames)) || Nullp(Cdr(Cdr(frames))))
!     {
!       Primitive_Error("no more time frame to pop");
!     }
!   frames = Cdr(frames);
!   time = Get_Double(Car(frames));
!   CONTEXT_T(context)->times = frames;
!   [CONTEXT_T(context)->pointer setTime:time];
! 
!   return Make_Reduced_Flonum(time);
  }

! static SchemeObject
! P_Context_Time (SchemeObject context)
  {
!   Check_Context(context);
! 
!   return Make_Reduced_Flonum(Get_Double(Car(CONTEXT_T(context)->times)));
  }

! static SchemeObject
! P_Context_Time_Frames (SchemeObject context)
  {
!   Check_Context(context);
! 
!   return CONTEXT_T(context)->times;
  }

! static SchemeObject
! P_Context_Pointer (SchemeObject context)
  {
!   Check_Context(context);
! 
!   return A_Make_Pointer(CONTEXT_T(context)->pointer, C_ID);
  }

! 
! int
! Write_Context (FILE *fp,
! 	       id context)
! {
!   Primitive_Error("sorry. not yet ported");
! 
  //   //    NXStream *s;
! //   TypedStream *ts;

  // //     if ((s = NXOpenFile(fileno(fp), OBJC_WRITEONLY)) == NULL)
***************
*** 267,278 ****
  //     //    NXClose(s);

! //     return 1;
! // }

! // static SchemeObject P_Context_Write(argc, argv)
! // int argc;
! // SchemeObject *argv;
! // {
  //   //    NXStream *s;
  //   //    TypedStream *ts;
--- 295,308 ----
  //     //    NXClose(s);

!     return 1;
! }

! static SchemeObject P_Context_Write(argc, argv)
! int argc;
! SchemeObject *argv;
! {
!   Primitive_Error("sorry. not yet ported");
! 
  //   //    NXStream *s;
  //   //    TypedStream *ts;
***************
*** 296,307 ****
  // 	    Primitive_Error("cannot open typed stream for: ~a", port);
  //     }
! //     return True;
! // }

! // int Read_Context(fp, context)
! // FILE *fp;
! // id *context;
! // {
  //   //    NXStream *s;
  //     TypedStream *ts;
--- 326,339 ----
  // 	    Primitive_Error("cannot open typed stream for: ~a", port);
  //     }
!     return True;
! }

! int
! Read_Context (FILE *fp,
! 	      id *context)
! {
!   Primitive_Error("sorry. not yet ported");
! 
  //   //    NXStream *s;
  //     TypedStream *ts;
***************
*** 324,336 ****
  //     //    *context = c;

! //     return 1;
! // }

! // static SchemeObject P_Context_Read(argc, argv)
! // int argc;
! // SchemeObject *argv;
! // {
! //     SchemeObject port;
  //     //    NXStream *s;
  //     //    TypedStream *ts;
--- 356,370 ----
  //     //    *context = c;

!     return 1;
! }

! static SchemeObject
! P_Context_Read (int argc,
! 		SchemeObject *argv)
! {
!   Primitive_Error("sorry. not yet ported");
!   return True;
! //   SchemeObject port;
  //     //    NXStream *s;
  //     //    TypedStream *ts;
***************
*** 355,365 ****
  //     }
  //     return A_Make_Context(c);
! // }

! // static SchemeObject P_Context_Copy(context)
! // SchemeObject context;
! // {
! //     id c;
  //     //    NXStream *ws, *rs;
  //     FILE *stream;
--- 389,402 ----
  //     }
  //     return A_Make_Context(c);
! }

! static SchemeObject
! P_Context_Copy (SchemeObject context)
! {
!   Primitive_Error("sorry. not yet ported");
!   return True;
! 
! //   id c;
  //     //    NXStream *ws, *rs;
  //     FILE *stream;
***************
*** 408,465 ****

  //     return A_Make_Context(c);
! // }

! static SchemeObject P_Context_Interval(context)
! SchemeObject context;
  {
!     double b, e;

!     Check_Context(context);
!     switch ([CONTEXT_T(context)->pointer getTimeInterval:&b :&e]) {
! 	case TI_BEG_END:
! 	    return Cons(Make_Reduced_Flonum(b), Make_Reduced_Flonum(e));
! 	case TI_END:
! 	    return Cons(False, Make_Reduced_Flonum(e));
! 	case TI_BEG:
! 	    return Cons(Make_Reduced_Flonum(b), False);
! 	case TI_NONE:
! 	    return Cons(False, False);
! 	default:
! 	    Primitive_Error("internal inconsistency");
      }
  }

! static int Context_Equal(a, b)
! SchemeObject a, b;
  {
!     return (CONTEXT_T(a)->pointer == CONTEXT_T(b)->pointer);
  }

! static int Context_Print(x, port, raw, depth, length)
! SchemeObject x, port;
! int raw, depth, length;
  {
!     int c = CONTEXT_T(x)->channels;

!     Printf(port, "#[context (%d channel", c);
!     if (c != 1) Printf(port, "s");
!     Printf(port, ")]");
!     return 0;
  }

! static int Context_Visit(x, f)
! SchemeObject *x;
! int (*f)(SchemeObject*);
  {
!     if (Debug_Context == 1) {
! 	fprintf(stderr, "\nvisit context %u\n", (unsigned int)CONTEXT_T(*x)->pointer);
! 	fflush(stderr);
      }
!     (*f)(&(CONTEXT_T(*x)->times));
!     return 0;
  }

--- 445,517 ----

  //     return A_Make_Context(c);
! }

! static SchemeObject
! P_Context_Interval (SchemeObject context)
  {
!   double b, e;

!   Check_Context(context);
!   switch ([CONTEXT_T(context)->pointer getTimeInterval:&b :&e])
!     {
!     case TI_BEG_END:
!       return Cons(Make_Reduced_Flonum(b), Make_Reduced_Flonum(e));
! 
!     case TI_END:
!       return Cons(False, Make_Reduced_Flonum(e));
! 
!     case TI_BEG:
!       return Cons(Make_Reduced_Flonum(b), False);
! 
!     case TI_NONE:
!       return Cons(False, False);
! 
!     default:
!       Primitive_Error("internal inconsistency");
      }
  }

! static int
! Context_Equal (SchemeObject a,
! 	       SchemeObject b)
  {
!   return (CONTEXT_T(a)->pointer == CONTEXT_T(b)->pointer);
  }

! static int
! Context_Print (SchemeObject x,
! 	       SchemeObject port,
! 	       int raw,
! 	       int depth,
! 	       int length)
  {
!   int c = CONTEXT_T(x)->channels;

!   Printf(port, "#[context (%d channel", c);
!   if (c != 1)
!     {
!       Printf(port, "s");
!     }
!   Printf(port, ")]");
! 
!   return 0;
  }

! static int
! Context_Visit (SchemeObject *x,
! 	       int (*f)(SchemeObject*))
  {
!   if (Debug_Context == 1)
!     {
!       fprintf(stderr, "\nvisit context %u\n", (unsigned int)CONTEXT_T(*x)->pointer);
!       fflush(stderr);
      }
!   (*f)(&(CONTEXT_T(*x)->times));
! 
!   return 0;
  }

***************
*** 467,471 ****
  #define DP Define_Primitive

! void elk_init_context()
  {
      Define_Variable(&V_Context, "foo:current-context", False);
--- 519,524 ----
  #define DP Define_Primitive

! void
! elk_init_context ()
  {
      Define_Variable(&V_Context, "foo:current-context", False);
***************
*** 484,491 ****
      DP(P_Pop_Time_Frame,	"foo:context-pop-time-frame",	1, 1, EVAL);
      DP(P_Context_Time,		"foo:context-time",		1, 1, EVAL);
!     // serialization stuff commented out so far
! //     DP(P_Context_Write,		"foo:write-context",		1, 2, VARARGS);
! //     DP(P_Context_Read,		"foo:read-context",		0, 1, VARARGS);
! //     DP(P_Context_Copy,		"foo:copy-context",		1, 1, EVAL);
      DP(P_Context_Interval,	"foo:context-interval",		1, 1, EVAL);

--- 537,543 ----
      DP(P_Pop_Time_Frame,	"foo:context-pop-time-frame",	1, 1, EVAL);
      DP(P_Context_Time,		"foo:context-time",		1, 1, EVAL);
!     DP(P_Context_Write,		"foo:write-context",		1, 2, VARARGS);
!     DP(P_Context_Read,		"foo:read-context",		0, 1, VARARGS);
!     DP(P_Context_Copy,		"foo:copy-context",		1, 1, EVAL);
      DP(P_Context_Interval,	"foo:context-interval",		1, 1, EVAL);

Index: signals.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/signals.m,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** signals.m	5 Aug 2004 23:13:56 -0000	1.3
--- signals.m	6 Aug 2004 02:52:59 -0000	1.4
***************
*** 51,346 ****
  int T_Signal;

! SchemeObject A_Add_List_Of_Terminal_Signals(SchemeObject list);

! static SchemeObject P_Signalp(x)
! SchemeObject x;
  {
!     return TYPE(x) == T_Signal ? True : False;
  }

! SchemeObject A_Make_Signal(n, f)
! int n;
! SchemeObject f;
  {
!     SchemeObject signal;
!     GC_Node;

!     GC_Link(f);
!     signal = Alloc_Object(sizeof(struct S_Signal), T_Signal, 0);
!     SIGNAL_T(signal)->vector = Make_Vector(n, f);
!     GC_Unlink;
!     SIGNAL_T(signal)->terminal = 0;
!     return signal;
  }

! SchemeObject A_Make_Terminal_Signal(SchemeObject module, int constant, double value)
  {
!     SchemeObject signal;

!     signal = A_Make_Signal(1, module);
!     SIGNAL_T(signal)->terminal = 1;
!     if (constant != 0) {
! 	SIGNAL_T(signal)->constant = 1;
! 	SIGNAL_T(signal)->value = value;
!     } else
! 	SIGNAL_T(signal)->constant = 0;
!     return signal;
  }
!     
! static SchemeObject P_Signal(argc, argv)
! int argc;
! SchemeObject *argv;
  {
!     SchemeObject signal, x;
!     int i;

!     signal = A_Make_Signal(argc, Null);
!     for (i = 0; i < argc; i++) {
! 	x = *argv++;
! 	Check_Type(x, T_Signal);
! 	VECTOR(SIGNAL_T(signal)->vector)->data[i] = x;
      }
!     return signal;
  }

! static long Signal_Length(signal)
! SchemeObject signal;
  {
!     return VECTOR(SIGNAL_T(signal)->vector)->size;
  }

! static SchemeObject P_Signal_Length(signal)
! SchemeObject signal;
  {
!     Check_Type(signal, T_Signal);
!     return Make_Integer(Signal_Length(signal));
  }

! static SchemeObject Signal_Ref (signal, n)
! SchemeObject signal;
! int n;
  {
!     SchemeObject vector = SIGNAL_T(signal)->vector;
!     if (n < 0 || n >= VECTOR(vector)->size)
! 	Range_Error (Make_Integer(n));
!     return VECTOR(vector)->data[n];
  }

! static SchemeObject P_Signal_Ref (signal, n)
! SchemeObject signal, n;
  {
!     int i = Get_Exact_Integer(n);
!     
!     Check_Type (signal, T_Signal);
!     if (SIGNAL_T(signal)->terminal == 1 && i == 0)
! 	return signal;
!     else
! 	return Signal_Ref(signal, i);
  }

! static SchemeObject P_Signal_Terminalp(signal)
! SchemeObject signal;
  {
!     Check_Type(signal, T_Signal);
!     return SIGNAL_T(signal)->terminal == 0 ? False : True;
  }

! static SchemeObject Signal_Monop(SchemeObject signal)
  {
!     if (SIGNAL_T(signal)->terminal == 1)
! 	return True;
!     else if (Signal_Length(signal) != 1)
! 	return False;
!     else
! 	return Signal_Monop(Signal_Ref(signal, 0));
  }

! static SchemeObject P_Signal_Monop(signal)
! SchemeObject signal;
  {
!     Check_Type(signal, T_Signal);
!     return Signal_Monop(signal);	
  }

! SchemeObject Signal_Constantp(signal)
! SchemeObject signal;
  {
!     if (Signal_Length(signal) != 1)
! 	return False;
!     else if (SIGNAL_T(signal)->terminal == 1)
! 	return SIGNAL_T(signal)->constant == 1 ? True : False;
!     else
! 	return Signal_Constantp(Signal_Ref(signal, 0));
  }

! static SchemeObject P_Signal_Constantp(signal)
! SchemeObject signal;
  {
!     Check_Type(signal, T_Signal);
!     return Signal_Constantp(signal);
  }

! double Signal_Constant_Value(signal)
! SchemeObject signal;
  {
!     if (Signal_Length(signal) != 1)
! 	Primitive_Error("signal not constant");
!     else if (SIGNAL_T(signal)->terminal == 1)
! 	if (SIGNAL_T(signal)->constant != 1)
! 	    Primitive_Error("signal not constant");
! 	else
! 	    return SIGNAL_T(signal)->value;
!     else
! 	return Signal_Constant_Value(Signal_Ref(signal, 0));
  }

! static SchemeObject P_Signal_Constant_Value(signal)
! SchemeObject signal;
  {
!     Check_Type(signal, T_Signal);
!     return Make_Reduced_Flonum(Signal_Constant_Value(signal));
  }

! static SchemeObject P_Signal_2_List(signal)
! SchemeObject signal;
  {
!     SchemeObject list = Null;
!     int i;
!     GC_Node;
!     
!     Check_Type(signal, T_Signal);
!     if (SIGNAL_T(signal)->terminal == 1)
! 	return Cons(signal, Null);
!     GC_Link(signal);
!     for (i = Signal_Length(signal) - 1; i >= 0; i--)
! 	list = Cons(Signal_Ref(signal, i), list);
!     GC_Unlink;
!     return list;

  }

! static SchemeObject P_Signal_Module(signal)
! SchemeObject signal;
  {
!     Check_Type(signal, T_Signal);
!     if (SIGNAL_T(signal)->terminal != 1)
! 	Primitive_Error("signal not terminal");
!     return Signal_Ref(signal, 0);
  }

  /*
   * produces a list of terminal signals
   */
! void A_Signal_Flatten(signal, list)
! SchemeObject signal;
! SchemeObject *list;
  {
!     int i;

!     if (SIGNAL_T(signal)->terminal == 1)
! 	*list = Cons(signal, *list);
!     else
! 	for (i = 0; i < Signal_Length(signal); i++)
! 	    A_Signal_Flatten(Signal_Ref(signal, i), list);
  }

! SchemeObject A_Make_Signal_Terminal(signal)
! SchemeObject signal;
  {
!     SchemeObject list = Null, ret;
!     GC_Node;

!     if (SIGNAL_T(signal)->terminal == 1)
! 	return signal;
!     GC_Link(list);
!     A_Signal_Flatten(signal, &list);
!     if (Fast_Length(list) == 1)
! 	ret = Car(list);
!     else
! 	ret =
! 	    A_Make_Terminal_Signal(A_Add_List_Of_Terminal_Signals(list),0,0.);
!     GC_Unlink;
!     return ret;
  }

! static SchemeObject P_A_Make_Signal_Terminal(signal)
! SchemeObject signal;
! {    
!     Check_Type(signal, T_Signal);
!     return A_Make_Signal_Terminal(signal);
  }

! static int Signal_Equal(a, b)
! SchemeObject a, b;
  {
!     return EQ(a, b);
  }

! static void Signal_Print_Tree(x, port, raw, depth, length)
! SchemeObject x, port;
! int raw, depth, length;
  {
!     SchemeObject s;
!     int i;

!     if (SIGNAL_T(x)->terminal == 1)
! 	Printf(port, ".");
!     else {
! 	Printf(port, "(");
! 	for (i = 0; i < Signal_Length(x); i++) {
! 	    s = VECTOR(SIGNAL_T(x)->vector)->data[i];
! 	    Signal_Print_Tree(s, port, raw, depth, length);
  	}
! 	Printf(port, ")");
      }
  }

! static int Signal_Print(x, port, raw, depth, length)
! SchemeObject x, port;
! int raw, depth, length;
  {
!     SchemeObject module;

!     Printf(port, "#[signal ");
!     if (SIGNAL_T(x)->terminal == 1) {
! 	module = VECTOR(SIGNAL_T(x)->vector)->data[0];
! 	Print_Object (MODULE_T(module)->type, port, raw, depth, length);
! 	if (SIGNAL_T(x)->constant == 1) {
! 	    Printf(port, " ");
! 	    Printf(port, FLONUM_FORMAT, SIGNAL_T(x)->value);		
  	}
!     } else
! 	Signal_Print_Tree(x, port, raw, depth, length);
!     Printf(port, "]");
!     return 0;
  }

! static int Signal_Visit(x, f)
! SchemeObject *x;
! int (*f)(SchemeObject*);
  {
!     //fprintf(stderr, "visit signal\n");
!     //fflush(stderr);
!     (*f)(&(SIGNAL_T(*x)->vector));
!     return 0;
  }

  #define DP Define_Primitive

! void elk_init_signals()
  {   
!     T_Signal = Define_Type(0, "signal", NOFUNC, sizeof(struct S_Signal),
! 	       Signal_Equal, Signal_Equal, Signal_Print, Signal_Visit);
!     DP(P_Signalp,		"foo:signal?", 			1, 1, EVAL);
!     DP(P_Signal,		"foo:signal",  		  0, MANY, VARARGS);
!     DP(P_Signal_Length,		"foo:signal-length",  		1, 1, EVAL);
!     DP(P_Signal_Ref,		"foo:signal-ref",  		2, 2, EVAL);
!     DP(P_Signal_2_List,		"foo:signal->list",		1, 1, EVAL);
!     DP(P_Signal_Terminalp,	"foo:signal-terminal?",		1, 1, EVAL);
!     DP(P_Signal_Monop,		"foo:signal-mono?",		1, 1, EVAL);
!     DP(P_Signal_Constantp,	"foo:signal-constant?",		1, 1, EVAL);
!     DP(P_Signal_Constant_Value,	"foo:signal-constant-value",	1, 1, EVAL);
!     DP(P_Signal_Module,		"foo:signal-module",		1, 1, EVAL);
!     DP(P_A_Make_Signal_Terminal,	"foo:signal-make-terminal",	1, 1, EVAL);
!     P_Provide(Intern("signal"));
  }
--- 51,459 ----
  int T_Signal;

! SchemeObject A_Add_List_Of_Terminal_Signals (SchemeObject list);

! 
! static SchemeObject
! P_Signalp (SchemeObject x)
  {
!   return TYPE(x) == T_Signal ? True : False;
  }

! 
! SchemeObject
! A_Make_Signal (int n,
! 	       SchemeObject f)
  {
!   SchemeObject signal;
!   GC_Node;

!   GC_Link(f);
!   signal = Alloc_Object(sizeof(struct S_Signal), T_Signal, 0);
!   SIGNAL_T(signal)->vector = Make_Vector(n, f);
!   GC_Unlink;
!   SIGNAL_T(signal)->terminal = 0;
! 
!   return signal;
  }

! 
! SchemeObject
! A_Make_Terminal_Signal (SchemeObject module,
! 			int constant,
! 			double value)
  {
!   SchemeObject signal;

!   signal = A_Make_Signal(1, module);
!   SIGNAL_T(signal)->terminal = 1;
!   if (constant != 0)
!     {
!       SIGNAL_T(signal)->constant = 1;
!       SIGNAL_T(signal)->value = value;
!     }
!   else
!     {
!       SIGNAL_T(signal)->constant = 0;
!     }
! 
!   return signal;
  }
! 
! 
! static SchemeObject
! P_Signal (int argc,
! 	  SchemeObject *argv)
  {
!   SchemeObject signal, x;
!   int i;

!   signal = A_Make_Signal(argc, Null);
!   for (i = 0; i < argc; i++)
!     {
!       x = *argv++;
!       Check_Type(x, T_Signal);
!     VECTOR(SIGNAL_T(signal)->vector)->data[i] = x;
      }
! 
!   return signal;
  }

! 
! static long
! Signal_Length (SchemeObject signal)
  {
!   return VECTOR(SIGNAL_T(signal)->vector)->size;
  }

! 
! static SchemeObject
! P_Signal_Length (SchemeObject signal)
  {
!   Check_Type(signal, T_Signal);
! 
!   return Make_Integer(Signal_Length(signal));
  }

! 
! static SchemeObject
! Signal_Ref (SchemeObject signal,
! 	    int n)
  {
!   SchemeObject vector = SIGNAL_T(signal)->vector;
!   if (n < 0 || n >= VECTOR(vector)->size)
!     {
!       Range_Error (Make_Integer(n));
!     }
! 
!   return VECTOR(vector)->data[n];
  }

! 
! static SchemeObject
! P_Signal_Ref (SchemeObject signal,
! 	      SchemeObject n)
  {
!   int i = Get_Exact_Integer(n);
! 
!   Check_Type (signal, T_Signal);
!   if (SIGNAL_T(signal)->terminal == 1 && i == 0)
!     {
!       return signal;
!     }
!   else
!     {
!       return Signal_Ref(signal, i);
!     }
  }

! 
! static SchemeObject
! P_Signal_Terminalp (SchemeObject signal)
  {
!   Check_Type(signal, T_Signal);
! 
!   return SIGNAL_T(signal)->terminal == 0 ? False : True;
  }

! 
! static SchemeObject
! Signal_Monop (SchemeObject signal)
  {
!   if (SIGNAL_T(signal)->terminal == 1)
!     {
!       return True;
!     }
!   else if (Signal_Length(signal) != 1)
!     {
!       return False;
!     }
!   else
!     {
!       return Signal_Monop(Signal_Ref(signal, 0));
!     }
  }

! 
! static SchemeObject
! P_Signal_Monop (SchemeObject signal)
  {
!   Check_Type(signal, T_Signal);
! 
!   return Signal_Monop(signal);	
  }

! 
! SchemeObject
! Signal_Constantp (SchemeObject signal)
  {
!   if (Signal_Length(signal) != 1)
!     {
!       return False;
!     }
!   else if (SIGNAL_T(signal)->terminal == 1)
!     {
!       return SIGNAL_T(signal)->constant == 1 ? True : False;
!     }
!   else
!     {
!       return Signal_Constantp(Signal_Ref(signal, 0));
!     }
  }

! 
! static SchemeObject
! P_Signal_Constantp (SchemeObject signal)
  {
!   Check_Type(signal, T_Signal);
! 
!   return Signal_Constantp(signal);
  }

! 
! double
! Signal_Constant_Value (SchemeObject signal)
  {
!   if (Signal_Length(signal) != 1)
!     {
!       Primitive_Error("signal not constant");
!     }
!   else if (SIGNAL_T(signal)->terminal == 1)
!     {
!       if (SIGNAL_T(signal)->constant != 1)
! 	{
! 	  Primitive_Error("signal not constant");
! 	}
!       else
! 	{
! 	  return SIGNAL_T(signal)->value;
! 	}
!     }
!   else
!     {
!       return Signal_Constant_Value(Signal_Ref(signal, 0));
!     }
  }

! 
! static SchemeObject
! P_Signal_Constant_Value (SchemeObject signal)
  {
!   Check_Type(signal, T_Signal);
! 
!   return Make_Reduced_Flonum(Signal_Constant_Value(signal));
  }

! 
! static SchemeObject
! P_Signal_2_List (SchemeObject signal)
  {
!   SchemeObject list = Null;
!   int i;
!   GC_Node;

+   Check_Type(signal, T_Signal);
+   if (SIGNAL_T(signal)->terminal == 1)
+     {
+       return Cons(signal, Null);
+     }
+   GC_Link(signal);
+   for (i = Signal_Length(signal) - 1; i >= 0; i--)
+     {
+       list = Cons(Signal_Ref(signal, i), list);
+     }
+   GC_Unlink;
+ 
+   return list;
  }

! 
! static SchemeObject
! P_Signal_Module (SchemeObject signal)
  {
!   Check_Type(signal, T_Signal);
!   if (SIGNAL_T(signal)->terminal != 1)
!     {
!       Primitive_Error("signal not terminal");
!     }
!   return Signal_Ref(signal, 0);
  }

+ 
  /*
   * produces a list of terminal signals
   */
! void
! A_Signal_Flatten (SchemeObject signal,
! 		  SchemeObject *list)
  {
!   int i;

!   if (SIGNAL_T(signal)->terminal == 1)
!     {
!       *list = Cons(signal, *list);
!     }
!   else
!     {
!       for (i = 0; i < Signal_Length(signal); i++)
! 	{
! 	  A_Signal_Flatten(Signal_Ref(signal, i), list);
! 	}
!     }
  }

! 
! SchemeObject
! A_Make_Signal_Terminal (SchemeObject signal)
  {
!   SchemeObject list = Null, ret;
!   GC_Node;

!   if (SIGNAL_T(signal)->terminal == 1)
!     {
!       return signal;
!     }
!   GC_Link(list);
!   A_Signal_Flatten(signal, &list);
!   if (Fast_Length(list) == 1)
!     {
!       ret = Car(list);
!     }
!   else
!     {
!       ret = A_Make_Terminal_Signal(A_Add_List_Of_Terminal_Signals(list),0,0.);
!     }
!   GC_Unlink;
! 
!   return ret;
  }

! 
! static SchemeObject
! P_A_Make_Signal_Terminal (SchemeObject signal)
! {  
!   Check_Type(signal, T_Signal);
! 
!   return A_Make_Signal_Terminal(signal);
  }

! 
! static int
! Signal_Equal (SchemeObject a,
! 	      SchemeObject b)
  {
!   return EQ(a, b);
  }

! 
! static void
! Signal_Print_Tree (SchemeObject x,
! 		   SchemeObject port,
! 		   int raw,
! 		   int depth,
! 		   int length)
  {
!   SchemeObject s;
!   int i;

!   if (SIGNAL_T(x)->terminal == 1)
!     {
!       Printf(port, ".");
!     }
!   else
!     {
!       Printf(port, "(");
!       for (i = 0; i < Signal_Length(x); i++)
! 	{
! 	  s = VECTOR(SIGNAL_T(x)->vector)->data[i];
! 	  Signal_Print_Tree(s, port, raw, depth, length);
  	}
!       Printf(port, ")");
      }
  }

! 
! static int
! Signal_Print (SchemeObject x,
! 	      SchemeObject port,
! 	      int raw,
! 	      int depth,
! 	      int length)
  {
!   SchemeObject module;

!   Printf(port, "#[signal ");
!   if (SIGNAL_T(x)->terminal == 1)
!     {
!       module = VECTOR(SIGNAL_T(x)->vector)->data[0];
!       Print_Object (MODULE_T(module)->type, port, raw, depth, length);
!       if (SIGNAL_T(x)->constant == 1)
! 	{
! 	  Printf(port, " ");
! 	  Printf(port, FLONUM_FORMAT, SIGNAL_T(x)->value);		
  	}
!     }
!   else
!     {
!     Signal_Print_Tree(x, port, raw, depth, length);
!     }
!   Printf(port, "]");
! 
!   return 0;
  }

! 
! static int
! Signal_Visit (SchemeObject *x,
! 	      int (*f)(SchemeObject*))
  {
!   //fprintf(stderr, "visit signal\n");
!   //fflush(stderr);
!   (*f)(&(SIGNAL_T(*x)->vector));
! 
!   return 0;
  }

+ 
  #define DP Define_Primitive

! void
! elk_init_signals ()
  {   
!   T_Signal = Define_Type(0, "signal", NOFUNC, sizeof(struct S_Signal),
! 			 Signal_Equal, Signal_Equal,
! 			 Signal_Print, Signal_Visit);
! 
!   DP(P_Signalp,			"foo:signal?", 			1, 1, EVAL);
!   DP(P_Signal,			"foo:signal",  		  0, MANY, VARARGS);
!   DP(P_Signal_Length,		"foo:signal-length",  		1, 1, EVAL);
!   DP(P_Signal_Ref,		"foo:signal-ref",  		2, 2, EVAL);
!   DP(P_Signal_2_List,		"foo:signal->list",		1, 1, EVAL);
!   DP(P_Signal_Terminalp,	"foo:signal-terminal?",		1, 1, EVAL);
!   DP(P_Signal_Monop,		"foo:signal-mono?",		1, 1, EVAL);
!   DP(P_Signal_Constantp,	"foo:signal-constant?",		1, 1, EVAL);
!   DP(P_Signal_Constant_Value,	"foo:signal-constant-value",	1, 1, EVAL);
!   DP(P_Signal_Module,		"foo:signal-module",		1, 1, EVAL);
!   DP(P_A_Make_Signal_Terminal,	"foo:signal-make-terminal",	1, 1, EVAL);
! 
!   P_Provide(Intern("signal"));
  }

Index: module.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/module.m,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** module.m	5 Aug 2004 23:13:56 -0000	1.4
--- module.m	6 Aug 2004 02:52:59 -0000	1.5
***************
*** 58,167 ****
  int T_Module;

- SchemeObject Get_Context(); /* defined in context.m */

! static SchemeObject P_Modulep(x)
! SchemeObject x;
  {
!     return TYPE(x) == T_Module ? True : False;
  }

! static SchemeObject P_Module_Type(module)
! SchemeObject module;
  {
!     Check_Type(module, T_Module);
!     return MODULE_T(module)->type;
  }

! static SchemeObject P_Module_Context(module)
! SchemeObject module;
  {
!     Check_Type(module, T_Module);
!     return MODULE_T(module)->context;
  }

! static SchemeObject P_Module_Pointer(module)
! SchemeObject module;
  {
!     Check_Type(module, T_Module);
!     return A_Make_Pointer(MODULE_T(module)->pointer, C_ID);
  }

! SchemeObject A_Make_Module(class)
! id class;
  {
!     SchemeObject module;
!     GC_Node;

!     module = Alloc_Object(sizeof(struct S_Module), T_Module, 0);
!     GC_Link(module);
!     MODULE_T(module)->pointer = [[class alloc] init];
!     MODULE_T(module)->type = Null;
!     MODULE_T(module)->context = Get_Context();
!     MODULE_T(module)->type = Intern([[class description] cString]);
!     GC_Unlink;
!     return module;
  }

! static SchemeObject P_Make_Module(class)
! SchemeObject class;
  {
!     id objc_class;
!     char *name;
! //     Alloca_Begin;

!     if (TYPE(class) != T_String && TYPE(class) != T_Symbol)
! 	Wrong_Type_Combination(class, "string or symbol");
!     if (TYPE(class) == T_Symbol)
! 	class = SYMBOL(class)->name;
!     name = Get_String(class);
  #ifdef NeXT_RUNTIME
!     if ((objc_class = objc_getClass(name)) == nil)
  #elif GNU_RUNTIME
!     if ((objc_class = objc_get_class(name)) == nil)
  #else
  #error *** NEITHER NeXT NOR GNU RUNTIME PRESENT ***
  #endif
!       {
! 	Primitive_Error("class not found: ~s", class);
!       }
  //     Alloca_End;
!     return A_Make_Module(objc_class);
  }

! static int Module_Equal(a, b)
! SchemeObject a, b;
  {
!     return EQ(MODULE_T(a)->type, MODULE_T(b)->type) &&
! 	(MODULE_T(a)->pointer == MODULE_T(b)->pointer);
  }

! static int Module_Print(x, port, raw, depth, length)
! SchemeObject x, port;
! int raw, depth, length;
  {
!     Printf(port, "#[module]");
!     return 0;
  }

! static int Module_Visit(x, f)
! SchemeObject *x;
! int (*f)(SchemeObject*);
  {
!     //fprintf(stderr, "visit module\n");
!     //fflush(stderr);
!     (*f)(&(MODULE_T(*x)->context));
!     (*f)(&(MODULE_T(*x)->type));
!     return 0;
  }

! void elk_init_module()
  {   
!     T_Module = Define_Type(0, "module", NOFUNC, sizeof(struct S_Module),
! 		       Module_Equal, Module_Equal, Module_Print, Module_Visit);
!     Define_Primitive(P_Modulep,		 "foo:module?",          1, 1, EVAL);
!     Define_Primitive(P_Make_Module,	 "foo:make-module",      1, 1, EVAL);
!     Define_Primitive(P_Module_Type,	 "foo:module-type",      1, 1, EVAL);
!     Define_Primitive(P_Module_Context,	 "foo:module-context",   1, 1, EVAL);
!     Define_Primitive(P_Module_Pointer,	 "foo:module-pointer",   1, 1, EVAL);
!     P_Provide(Intern("module"));
  }
--- 58,194 ----
  int T_Module;

! SchemeObject Get_Context (); /* defined in context.m */
! 
! static SchemeObject
! P_Modulep (SchemeObject x)
  {
!   return TYPE(x) == T_Module ? True : False;
  }

! 
! static SchemeObject
! P_Module_Type (SchemeObject module)
  {
!   Check_Type(module, T_Module);
! 
!   return MODULE_T(module)->type;
  }

! 
! static SchemeObject
! P_Module_Context (SchemeObject module)
  {
!   Check_Type(module, T_Module);
! 
!   return MODULE_T(module)->context;
  }

! 
! static SchemeObject
! P_Module_Pointer (SchemeObject module)
  {
!   Check_Type(module, T_Module);
! 
!   return A_Make_Pointer(MODULE_T(module)->pointer, C_ID);
  }

! 
! SchemeObject
! A_Make_Module (id class)
  {
!   SchemeObject module;
!   GC_Node;

!   module = Alloc_Object(sizeof(struct S_Module), T_Module, 0);
!   GC_Link(module);
!   MODULE_T(module)->pointer = [[class alloc] init];
!   MODULE_T(module)->type = Null;
!   MODULE_T(module)->context = Get_Context();
!   MODULE_T(module)->type = Intern([[class description] cString]);
!   GC_Unlink;
! 
!   return module;
  }

! 
! static SchemeObject
! P_Make_Module (SchemeObject class)
  {
!   id objc_class;
!   char *name;
!   //     Alloca_Begin;

!   if (TYPE(class) != T_String && TYPE(class) != T_Symbol)
!     {
!       Wrong_Type_Combination(class, "string or symbol");
!     }
!   if (TYPE(class) == T_Symbol)
!     {
!       class = SYMBOL(class)->name;
!     }
!   name = Get_String(class);
  #ifdef NeXT_RUNTIME
!   if ((objc_class = objc_getClass(name)) == nil)
  #elif GNU_RUNTIME
!   if ((objc_class = objc_get_class(name)) == nil)
  #else
  #error *** NEITHER NeXT NOR GNU RUNTIME PRESENT ***
  #endif
!     {
!       Primitive_Error("class not found: ~s", class);
!     }
  //     Alloca_End;
!   return A_Make_Module(objc_class);
  }

! 
! static int
! Module_Equal (SchemeObject a,
! 	      SchemeObject b)
  {
!   return EQ(MODULE_T(a)->type, MODULE_T(b)->type) &&
!     (MODULE_T(a)->pointer == MODULE_T(b)->pointer);
  }

! 
! static int
! Module_Print (SchemeObject x,
! 	      SchemeObject port,
! 	      int raw,
! 	      int depth,
! 	      int length)
  {
!   Printf(port, "#[module]");
! 
!   return 0;
  }

! 
! static int
! Module_Visit (SchemeObject *x,
! 	      int (*f)(SchemeObject*))
  {
!   //fprintf(stderr, "visit module\n");
!   //fflush(stderr);
!   (*f)(&(MODULE_T(*x)->context));
!   (*f)(&(MODULE_T(*x)->type));
! 
!   return 0;
  }

! 
! void
! elk_init_module ()
  {   
!   T_Module = Define_Type(0, "module", NOFUNC, sizeof(struct S_Module),
! 			 Module_Equal, Module_Equal,
! 			 Module_Print, Module_Visit);
!   Define_Primitive(P_Modulep,		 "foo:module?",          1, 1, EVAL);
!   Define_Primitive(P_Make_Module,	 "foo:make-module",      1, 1, EVAL);
!   Define_Primitive(P_Module_Type,	 "foo:module-type",      1, 1, EVAL);
!   Define_Primitive(P_Module_Context,	 "foo:module-context",   1, 1, EVAL);
!   Define_Primitive(P_Module_Pointer,	 "foo:module-pointer",   1, 1, EVAL);
! 
!   P_Provide(Intern("module"));
  }

Index: modules.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/modules.m,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** modules.m	5 Aug 2004 18:58:52 -0000	1.2
--- modules.m	6 Aug 2004 02:52:59 -0000	1.3
***************
*** 86,673 ****
  #define IdOf(module) (MODULE_T(module)->pointer)

! static int Get_Taps(taps)
! SchemeObject taps;
  {
!     int n = Get_Integer(taps);

!     if (n < [FOOGlobalsManager getMinimumTaps] ||
!         n > [FOOGlobalsManager getMaximumTaps])
! 	Primitive_Error("taps out of range [~a,~a]: ~a",
[...2085 lines suppressed...]
!   DP(P_Make_ReadTranspSnd,	"foo:make-read-snd",		1, 1, EVAL);
!   DP(P_Make_Reverb,		"foo:make-reverb",	     4, MANY, VARARGS);
!   DP(P_Make_Reverb8,		"foo:make-reverb8",	     8, MANY, VARARGS);
!   DP(P_Make_ReverbOutput,	"foo:make-revout",		2, 2, EVAL);
!   DP(P_Make_Sub,		"foo:make-sub",		     1, MANY, VARARGS);
!   DP(P_Make_TranspBpf,		"foo:make-transp-bpf",		2, 2, EVAL);
!   DP(P_Make_TranspSnd,		"foo:make-transp-snd",		2, 3, VARARGS);
!   DP(P_Make_V2pf,		"foo:make-v2pf",		3, 3, EVAL);
  /// math modules
!   DP(P_Make_Abs,		"foo:make-abs",			1, 1, EVAL);
!   DP(P_Make_Exp,		"foo:make-exp",			1, 1, EVAL);
!   DP(P_Make_Log,		"foo:make-log",			1, 1, EVAL);
!   DP(P_Make_Log10,		"foo:make-log10",		1, 1, EVAL);
!   DP(P_Make_Sqrt,		"foo:make-sqrt",		1, 1, EVAL);
!   DP(P_Make_Pow,		"foo:make-pow",			2, 2, EVAL);
!   DP(P_Make_Min,		"foo:make-min",			2, 2, EVAL);
!   DP(P_Make_Max,		"foo:make-max",			2, 2, EVAL);

!   P_Provide(Intern("modules"));
  }

Index: task.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/task.m,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** task.m	5 Aug 2004 18:58:52 -0000	1.2
--- task.m	6 Aug 2004 02:52:59 -0000	1.3
***************
*** 67,345 ****
  int T_Task;

! static SchemeObject P_Taskp(x)
! SchemeObject x;
  {
!     return TYPE(x) == T_Task ? True : False;
  }

! SchemeObject A_Make_Task(ref, off, fil, sr, bs, con, inc, t)
! int bs, inc, t;
! double ref, off, sr;
! SchemeObject fil, con;
  {
!     SchemeObject task;
!     GC_Node2;
!     
!     GC_Link2(fil, con);
!     task = Alloc_Object(sizeof(struct S_Task), T_Task, 0);
!     GC_Unlink;
!     TASK_T(task)->context = con;
!     TASK_T(task)->output = fil;
!     TASK_T(task)->reference = rint(ref * sr);
!     TASK_T(task)->offset = rint(off * sr);
!     TASK_T(task)->position = TASK_T(task)->reference + TASK_T(task)->offset;   
!     TASK_T(task)->samplingrate = sr;   
!     TASK_T(task)->buffersize = bs;   
!     TASK_T(task)->incremental = inc;   
!     TASK_T(task)->type = t;   
!     return task;
  }

! static SchemeObject P_Make_Task(argc, argv)
! int argc;
! SchemeObject *argv;
  {
!     SchemeObject ref, off, fil, con;
!     SchemeObject task, file;
!     char *name, buffer[PATH_MAX + 1];
!     struct stat st;
!     int inc, bs = [FOOGlobalsManager getDefaultBlockSize], t;
!     double sr = [FOOGlobalsManager getDefaultSamplingRate], r, o;
!     id context;
  //     Alloca_Begin;

!     ref = argv[0];
!     off = argv[1];
!     fil = argv[2];
!     con = argv[3];
!     file = General_File_Operation(fil, 0);
!     if (argc > 5) {
! 	sr = Get_Double(argv[5]);
! 	if (sr <= 0)
! 	    Primitive_Error("illegal sampling rate: ~a", argv[5]);
      }
!     if (argc > 6) {
! 	bs = Get_Integer(argv[6]);
! 	if (bs <= 0)
! 	    Primitive_Error("illegal block size: ~a", argv[6]);
      }
!     Check_Type(con, T_Context);
!     context = CONTEXT_T(con)->pointer;
!     if ([context isLocked])
! 	Primitive_Error("context already locked (i.e. bound to a task)");
!     r = Get_Double(ref);
!     o = Get_Double(off);
!     if (r + o < 0)
! 	Primitive_Error("reference + offset is negative");
!     name =Get_String(file);
!     if (stat(name, &st) == -1)
! 	Primitive_Error("does not exist: ~a", file);
!     if (st.st_mode & S_IFDIR) {
! 	sprintf(buffer, "%s/%s", name, SND_MIX_FILE_NAME);
! 	inc = 1;
!     } else {
! 	strcpy(buffer, name);
! 	inc = 0;
      }
!     if (argc > 4)
! 	t = Scheme_To_C_Symbol(argv[4], taskTypes);
!     else
! 	t = (inc == 1) ? TASK_BLEND : TASK_PUNCH;
!     if (t == TASK_PUNCH && inc == 1)
! 	Primitive_Error
! 	    ("'punch' output type not allowed with incremental sound files");
!     task = A_Make_Task(r, o, 
! 		     Make_String(buffer, strlen(buffer)), sr, bs, con, inc, t);
!     [context setSamplingRate:sr]; // locks context
!     [context setBufferSize:bs];

!     /* this has to be frame unit instead of seconds
!      * was wrong first, therefore <offset> didn't work correctly
!      * rumori 2004-05-03
!      * orig:  [context setSampleTime:o];
!      */
!     [context setSampleTime: rint(o * sr)];
!     [context compile];
! //     Alloca_End;
!     return task;
  }

! static int Lock_Mix(dir)
! const char *dir;
  {
!     char buffer[PATH_MAX + 1];

!     sprintf(buffer, "%s/%s", dir, SND_MIX_LOCK_NAME);
!     return mkdir(buffer, 0755) == 0 ? 1 : 0;
  }

! static int Unlock_Mix(dir)
! const char *dir;
  {
!     char buffer[PATH_MAX + 1];

!     sprintf(buffer, "%s/%s", dir, SND_MIX_LOCK_NAME);
!     return rmdir(buffer) == 0 ? 1 : 0;
  }

! static int Write_Header(fp, ver, fac, ref, off, dur, sr, bs)
! FILE *fp;
! int ver, ref, off, dur, bs;
! double sr, fac;
  {    
!     fprintf(fp, "((version %d)\n", ver);
!     fprintf(fp, "(factor %.15g)\n", fac);
!     fprintf(fp, "(reference %d)\n", ref);
!     fprintf(fp, "(offset %d)\n", off);
!     fprintf(fp, "(duration %d)\n", dur);
!     fprintf(fp, "(srate %.15g)\n", sr);
!     fprintf(fp, "(blocksize %d))\n", bs);
!     return 1;
  }

! static void Register_Incremental_Mix(task, factor, done)
! SchemeObject task;
! double factor;
! int done;
  {
!     FILE *fp;
!     char *dir, *p;
!     char buffer[PATH_MAX + 1];
!     int count, ref, off, bs;
!     double sr;
  //     Alloca_Begin;

!     dir = Get_String(TASK_T(task)->output);
!     p = rindex(dir, '/');
!     if (p && *p)
! 	*p = '\0';
!     sprintf(buffer, "%s/mixcount", dir);
!     if ((fp = fopen(buffer, "r")) == NULL)
! 	count = 0;
!     else if (fscanf(fp, "%d", &count) != 1) {
! 	fclose(fp);
! 	Primitive_Error("counter file ~a corrupted",
! 	    Make_String(buffer, strlen(buffer)));
!     } else
! 	fclose(fp);
!     sprintf(buffer, "%s/mix%04dt", dir, count);
!     if ((fp = fopen(buffer, "w+")) == NULL)
! 	Primitive_Error("cannot create ~a",
! 	    Make_String(buffer, strlen(buffer)));
!     ref = TASK_T(task)->reference;
!     off = TASK_T(task)->offset;
!     sr  = TASK_T(task)->samplingrate;
!     bs  = TASK_T(task)->buffersize;
!     if (Write_Header(fp, 1, factor, ref, off, done, sr, bs) != 1) {
! 	fclose(fp);
! 	Primitive_Error("cannot write header to ~a",
! 	    Make_String(buffer, strlen(buffer)));
      }
!     fclose(fp);
!     sprintf(buffer, "%s/mix%04dc", dir, count);
!     if ((fp = fopen(buffer, "w+")) == NULL)
! 	Primitive_Error("cannot create ~a",
! 	    Make_String(buffer, strlen(buffer)));
!     if (Write_Context(fp, CONTEXT_T(TASK_T(task)->context)->pointer) != 1) {
! 	fclose(fp);
! 	Primitive_Error("cannot write context to ~a",
! 	    Make_String(buffer, strlen(buffer)));
      }
!     fclose(fp);
!     sprintf(buffer, "%s/mixcount", dir);
!     if ((fp = fopen(buffer, "w+")) == NULL)
! 	Primitive_Error("cannot create ~a",
! 	    Make_String(buffer, strlen(buffer)));
!     fprintf(fp, "%d", ++count);
!     fclose(fp);
! //     Alloca_End;
  }

! static SchemeObject P_Run_Task(argc, argv)
! int argc;
! SchemeObject *argv;
  {
!     int todo, done;
!     char *output, *dir, *p;
!     id context;
!     SchemeObject task, duration;
!     double factor = 1;
!     NSString *filename;
! //     Alloca_Begin;

!     task = argv[0];
!     duration = argv[1];
!     if (argc == 3)
! 	factor = Get_Double(argv[2]);
!     Check_Type(task, T_Task);
!     context = CONTEXT_T(TASK_T(task)->context)->pointer;
!     if (context == NULL)
! 	Primitive_Error("dead context");
!     todo = rint(Get_Double(duration) * TASK_T(task)->samplingrate);
!     output = Get_String(TASK_T(task)->output);
!     if (TASK_T(task)->incremental == 1) {
        dir = Get_String(TASK_T(task)->output);
! 	p = rindex(dir, '/');
! 	if (p && *p)
! 	    *p = '\0';
! 	if (Lock_Mix(dir) != 1) {
! // 	    Alloca_End;
! 	    return False;
  	}
      }

!     filename = AUTORELEASE([NSString stringWithCString: output]);
!     [context openOutput: filename
! 	     addin:(int)((TASK_T(task)->incremental == 1) ||
! 	     		  TASK_T(task)->type == TASK_BLEND)
! 	     at:TASK_T(task)->position];

!     done = [context run:todo factor:factor];
!     [context closeOutput];
!     if (todo != done)
! 	Printf(Curr_Output_Port, " run-task: interrupted\n");
!     if (TASK_T(task)->incremental == 1) {
! 	Register_Incremental_Mix(task, factor, done);
! 	if (Unlock_Mix(dir) != 1)
! 	    Primitive_Error("cannot remove lock");
      }
!     TASK_T(task)->position += done;
! //     Alloca_End;
!     return Make_Reduced_Flonum(done / TASK_T(task)->samplingrate);
  }

! static int Task_Equal(a, b)
! SchemeObject a, b;
  {
!     return EQ(a, b);
  }

! static int Task_Print(x, port, raw, depth, length)
! SchemeObject x, port;
! int raw, depth, length;
  {

!     Printf(port, "#[task]");
!     return 0;
  }

! static int Task_Visit(task, f)
! SchemeObject *task;
! int (*f)();
  {
!     struct S_Task *p = TASK_T(*task);
!     (*f)(&(p->context));
!     (*f)(&(p->output));

!     return 0;
  }

! void elk_init_task()
! {   
!     T_Task = Define_Type(0, "task", NOFUNC, sizeof(struct S_Task),
  		       Task_Equal, Task_Equal, Task_Print, Task_Visit);
!     Define_Primitive(P_Taskp,		"foo:task?",     1, 1, EVAL);
!     Define_Primitive(P_Make_Task,	"foo:make-task", 4, 7, VARARGS);
!     Define_Primitive(P_Run_Task,	"foo:run-task",  2, 3, VARARGS);
!     P_Provide(Intern("task"));
  }
--- 67,429 ----
  int T_Task;

! 
! static SchemeObject
! P_Taskp (SchemeObject x)
  {
!   return TYPE(x) == T_Task ? True : False;
  }

! 
! SchemeObject
! A_Make_Task (double ref,
! 	     double off,
! 	     SchemeObject fil,
! 	     double sr,
! 	     int bs,
! 	     SchemeObject con,
! 	     int inc,
! 	     int t)
  {
!   SchemeObject task;
!   GC_Node2;
! 
!   GC_Link2(fil, con);
!   task = Alloc_Object(sizeof(struct S_Task), T_Task, 0);
!   GC_Unlink;
!   TASK_T(task)->context = con;
!   TASK_T(task)->output = fil;
!   TASK_T(task)->reference = rint(ref * sr);
!   TASK_T(task)->offset = rint(off * sr);
!   TASK_T(task)->position = TASK_T(task)->reference + TASK_T(task)->offset;   
!   TASK_T(task)->samplingrate = sr;   
!   TASK_T(task)->buffersize = bs;   
!   TASK_T(task)->incremental = inc;   
!   TASK_T(task)->type = t;   
! 
!   return task;
  }

! 
! static SchemeObject
! P_Make_Task (int argc,
! 	     SchemeObject *argv)
  {
!   SchemeObject ref, off, fil, con;
!   SchemeObject task, file;
!   char *name, buffer[PATH_MAX + 1];
!   struct stat st;
!   int inc, bs = [FOOGlobalsManager getDefaultBlockSize], t;
!   double sr = [FOOGlobalsManager getDefaultSamplingRate], r, o;
!   id context;
  //     Alloca_Begin;

!   ref = argv[0];
!   off = argv[1];
!   fil = argv[2];
!   con = argv[3];
!   file = General_File_Operation(fil, 0);
!   if (argc > 5)
!     {
!       sr = Get_Double(argv[5]);
!       if (sr <= 0)
! 	{
! 	  Primitive_Error("illegal sampling rate: ~a", argv[5]);
! 	}
      }
!   if (argc > 6)
!     {
!       bs = Get_Integer(argv[6]);
!       if (bs <= 0)
! 	{
! 	  Primitive_Error("illegal block size: ~a", argv[6]);
! 	}
      }
!   Check_Type(con, T_Context);
!   context = CONTEXT_T(con)->pointer;
!   if ([context isLocked])
!     {
!       Primitive_Error("context already locked (i.e. bound to a task)");
      }
!   r = Get_Double(ref);
!   o = Get_Double(off);
!   if (r + o < 0)
!     {
!       Primitive_Error("reference + offset is negative");
!     }
!   name =Get_String(file);
!   if (stat(name, &st) == -1)
!     {
!       Primitive_Error("does not exist: ~a", file);
!     }
!   if (st.st_mode & S_IFDIR)
!     {
!       sprintf(buffer, "%s/%s", name, SND_MIX_FILE_NAME);
!       inc = 1;
!     }
!   else
!     {
!       strcpy(buffer, name);
!       inc = 0;
!     }
!   if (argc > 4)
!     {
!       t = Scheme_To_C_Symbol(argv[4], taskTypes);
!     }
!   else
!     {
!       t = (inc == 1) ? TASK_BLEND : TASK_PUNCH;
!     }
!   if (t == TASK_PUNCH && inc == 1)
!     {
!       Primitive_Error("'punch' output type not allowed with incremental sound files");
!     }
!   task = A_Make_Task(r, o, Make_String(buffer, strlen(buffer)),
! 		     sr, bs, con, inc, t);
!   [context setSamplingRate:sr]; // locks context
!   [context setBufferSize:bs];

!   /* this has to be frame unit instead of seconds
!    * was wrong first, therefore <offset> didn't work correctly
!    * rumori 2004-05-03
!    * orig:  [context setSampleTime:o];
!    */
!   [context setSampleTime: rint(o * sr)];
!   [context compile];
!   //     Alloca_End;
! 
!   return task;
  }

! 
! static int
! Lock_Mix (const char *dir)
  {
!   char buffer[PATH_MAX + 1];

!   sprintf(buffer, "%s/%s", dir, SND_MIX_LOCK_NAME);
! 
!   return mkdir(buffer, 0755) == 0 ? 1 : 0;
  }

! 
! static int
! Unlock_Mix (const char *dir)
  {
!   char buffer[PATH_MAX + 1];

!   sprintf(buffer, "%s/%s", dir, SND_MIX_LOCK_NAME);
! 
!   return rmdir(buffer) == 0 ? 1 : 0;
  }

! 
! static int
! Write_Header (FILE *fp,
! 	      int ver,
! 	      double fac,
! 	      int ref,
! 	      int off,
! 	      int dur,
! 	      double sr,
! 	      int bs)
  {    
!   fprintf(fp, "((version %d)\n", ver);
!   fprintf(fp, "(factor %.15g)\n", fac);
!   fprintf(fp, "(reference %d)\n", ref);
!   fprintf(fp, "(offset %d)\n", off);
!   fprintf(fp, "(duration %d)\n", dur);
!   fprintf(fp, "(srate %.15g)\n", sr);
!   fprintf(fp, "(blocksize %d))\n", bs);
! 
!   return 1;
  }

! 
! static void
! Register_Incremental_Mix (SchemeObject task,
! 			  double factor,
! 			  int done)
  {
!   FILE *fp;
!   char *dir, *p;
!   char buffer[PATH_MAX + 1];
!   int count, ref, off, bs;
!   double sr;
  //     Alloca_Begin;

!   dir = Get_String(TASK_T(task)->output);
!   p = rindex(dir, '/');
!   if (p && *p)
!     {
!       *p = '\0';
      }
!   sprintf(buffer, "%s/mixcount", dir);
!   if ((fp = fopen(buffer, "r")) == NULL)
!     {
!       count = 0;
      }
!   else if (fscanf(fp, "%d", &count) != 1)
!     {
!       fclose(fp);
!       Primitive_Error("counter file ~a corrupted",
! 		      Make_String(buffer, strlen(buffer)));
!     }
!   else
!     {
!       fclose(fp);
!     }
!   sprintf(buffer, "%s/mix%04dt", dir, count);
!   if ((fp = fopen(buffer, "w+")) == NULL)
!     {
!       Primitive_Error("cannot create ~a",
! 		      Make_String(buffer, strlen(buffer)));
!     }
!   ref = TASK_T(task)->reference;
!   off = TASK_T(task)->offset;
!   sr  = TASK_T(task)->samplingrate;
!   bs  = TASK_T(task)->buffersize;
!   if (Write_Header(fp, 1, factor, ref, off, done, sr, bs) != 1)
!     {
!       fclose(fp);
!       Primitive_Error("cannot write header to ~a",
! 		      Make_String(buffer, strlen(buffer)));
!     }
!   fclose(fp);
!   sprintf(buffer, "%s/mix%04dc", dir, count);
!   if ((fp = fopen(buffer, "w+")) == NULL)
!     {
!       Primitive_Error("cannot create ~a",
! 		      Make_String(buffer, strlen(buffer)));
!     }
!   if (Write_Context(fp, CONTEXT_T(TASK_T(task)->context)->pointer) != 1)
!     {
!       fclose(fp);
!       Primitive_Error("cannot write context to ~a",
! 		      Make_String(buffer, strlen(buffer)));
!     }
!   fclose(fp);
!   sprintf(buffer, "%s/mixcount", dir);
!   if ((fp = fopen(buffer, "w+")) == NULL)
!     {
!       Primitive_Error("cannot create ~a",
! 		      Make_String(buffer, strlen(buffer)));
!     }
!   fprintf(fp, "%d", ++count);
!   fclose(fp);
!   //     Alloca_End;
  }

! 
! static SchemeObject
! P_Run_Task (int argc,
! 	    SchemeObject *argv)
  {
!   int todo, done;
!   char *output, *dir, *p;
!   id context;
!   SchemeObject task, duration;
!   double factor = 1;
!   NSString *filename;
!   //     Alloca_Begin;

!   task = argv[0];
!   duration = argv[1];
!   if (argc == 3)
!     {
!       factor = Get_Double(argv[2]);
!     }
!   Check_Type(task, T_Task);
!   context = CONTEXT_T(TASK_T(task)->context)->pointer;
!   if (context == NULL)
!     {
!       Primitive_Error("dead context");
!     }
!   todo = rint(Get_Double(duration) * TASK_T(task)->samplingrate);
!   output = Get_String(TASK_T(task)->output);
!   if (TASK_T(task)->incremental == 1)
!     {
        dir = Get_String(TASK_T(task)->output);
!       p = rindex(dir, '/');
!       if (p && *p)
! 	{
! 	  *p = '\0';
! 	}
!       if (Lock_Mix(dir) != 1)
! 	{
! 	// 	    Alloca_End;
! 	  return False;
  	}
      }

!   filename = AUTORELEASE([NSString stringWithCString: output]);
!   [context openOutput: filename
! 	   addin:(int)((TASK_T(task)->incremental == 1) ||
! 		       TASK_T(task)->type == TASK_BLEND)
! 	   at:TASK_T(task)->position];

!   done = [context run:todo factor:factor];
!   [context closeOutput];
!   if (todo != done)
!     {
!       Printf(Curr_Output_Port, " run-task: interrupted\n");
      }
!   if (TASK_T(task)->incremental == 1)
!     {
!       Register_Incremental_Mix(task, factor, done);
!       if (Unlock_Mix(dir) != 1)
! 	{
! 	  Primitive_Error("cannot remove lock");
! 	}
!     }
!   TASK_T(task)->position += done;
!   //     Alloca_End;
! 
!   return Make_Reduced_Flonum(done / TASK_T(task)->samplingrate);
  }

! 
! static int
! Task_Equal (SchemeObject a,
! 	    SchemeObject b)
  {
!   return EQ(a, b);
  }

! 
! static int
! Task_Print (SchemeObject x,
! 	    SchemeObject port,
! 	    int raw,
! 	    int depth,
! 	    int length)
  {
+   Printf(port, "#[task]");

!   return 0;
  }

! 
! static int
! Task_Visit (SchemeObject *task,
! 	    int (*f)())
  {
!   struct S_Task *p = TASK_T(*task);
!   (*f)(&(p->context));
!   (*f)(&(p->output));

!   return 0;
  }

! 
! void
! elk_init_task ()
! { 
!   T_Task = Define_Type(0, "task", NOFUNC, sizeof(struct S_Task),
  		       Task_Equal, Task_Equal, Task_Print, Task_Visit);
! 
!   Define_Primitive(P_Taskp,		"foo:task?",     1, 1, EVAL);
!   Define_Primitive(P_Make_Task,		"foo:make-task", 4, 7, VARARGS);
!   De...

[truncated message content]

[foo-cvs] foo/elkfoo/src Makefile.am,1.4,1.5 bpf.m,1.4,1.5 context.m,1.4,1.5 defaults.m,1.1,1.2 foof

[foo-cvs] foo/elkfoo/src Makefile.am,1.4,1.5 bpf.m,1.4,1.5 context.m,1.4,1.5 defaults.m,1.1,1.2 foofun.m,1.1,1.2 main.c,1.1,1.2 module.m,1.4,1.5 modules.m,1.2,1.3 signals.m,1.3,1.4 task.m,1.2,1.3