Thread: [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
!     {...

[truncated message content]