foo-cvs Mailing List for foo (Page 18)

Status: Beta

Brought to you by: gurx, rgbach, rumori

foo-cvs — mailing list for CVS commit messages.

You can subscribe to this list here.

2004	Jan	Feb	Mar	Apr	May	Jun	Jul (22)	Aug (270)	Sep	Oct	Nov	Dec
2005	Jan (8)	Feb (24)	Mar	Apr	May	Jun (5)	Jul	Aug (4)	Sep	Oct	Nov (2)	Dec (2)
2006	Jan	Feb	Mar	Apr (4)	May (2)	Jun	Jul	Aug	Sep	Oct	Nov	Dec
2007	Jan	Feb	Mar	Apr (25)	May	Jun	Jul	Aug	Sep (6)	Oct (3)	Nov (1)	Dec (14)
2008	Jan (1)	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct	Nov	Dec
2009	Jan	Feb	Mar (31)	Apr (5)	May	Jun	Jul	Aug	Sep	Oct	Nov	Dec
2010	Jan	Feb	Mar	Apr (90)	May	Jun	Jul	Aug (1)	Sep	Oct	Nov	Dec
2011	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct	Nov (2)	Dec
2016	Jan	Feb	Mar	Apr	May (2)	Jun	Jul	Aug	Sep	Oct	Nov	Dec (1)

Flat | Threaded

<< < 1 .. 16 17 18 19 20 21 > >> (Page 18 of 21)

[foo-cvs] fooelk configure.ac,1.3,1.4

From: Martin R. <ru...@us...> - 2004-08-07 08:57:42

Update of /cvsroot/foo/fooelk
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17649

Modified Files:
	configure.ac 
Log Message:
show which readline was detected in configure summary (-ledit or -lreadline)

Index: configure.ac
===================================================================
RCS file: /cvsroot/foo/fooelk/configure.ac,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** configure.ac	7 Aug 2004 08:55:29 -0000	1.3
--- configure.ac	7 Aug 2004 08:57:32 -0000	1.4
***************
*** 7,11 ****
  AC_CANONICAL_SYSTEM
  
! AM_INIT_AUTOMAKE(fooelk, 0.0.5)
  AM_CONFIG_HEADER(config.h)
  
--- 7,11 ----
  AC_CANONICAL_SYSTEM
  
! AM_INIT_AUTOMAKE(fooelk, 0.0.6)
  AM_CONFIG_HEADER(config.h)
  
***************
*** 675,679 ****
  Xaw support: ${ac_cv_my_have_xaw}
  Motif support: ${ac_cv_my_have_motif}
! readline support: ${ac_cv_my_have_readline}
  use garbage colllector: ${with_gc_type}
  default heap size: ${with_default_heapsize}
--- 675,679 ----
  Xaw support: ${ac_cv_my_have_xaw}
  Motif support: ${ac_cv_my_have_motif}
! readline support: ${ac_cv_my_have_readline} (${RL_LIBS})
  use garbage colllector: ${with_gc_type}
  default heap size: ${with_default_heapsize}

[foo-cvs] fooelk/lib/readline completion.c,1.3,1.4 readline.c,1.1.1.1,1.2 readline.h,1.1.1.1,1.2

From: Martin R. <ru...@us...> - 2004-08-07 08:56:35

Update of /cvsroot/foo/fooelk/lib/readline
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17521

Modified Files:
	completion.c readline.c readline.h 
Log Message:
include scheme functions in header file. #ifdefs for (limited) BSD libedit support

Index: readline.c
===================================================================
RCS file: /cvsroot/foo/fooelk/lib/readline/readline.c,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** readline.c	6 Aug 2004 20:56:43 -0000	1.1.1.1
--- readline.c	7 Aug 2004 08:56:26 -0000	1.2
***************
*** 79,83 ****
  
  
! static Object
  P_Readline_Read (void)
  {
--- 79,83 ----
  
  
! Object
  P_Readline_Read (void)
  {
***************
*** 142,146 ****
  
  
! static Object
  P_Readline_Add_History (Object add)
  {
--- 142,146 ----
  
  
! Object
  P_Readline_Add_History (Object add)
  {
***************
*** 151,155 ****
  
  
! static Object
  P_Readline_Set_Prompt (Object prompt)
  {
--- 151,155 ----
  
  
! Object
  P_Readline_Set_Prompt (Object prompt)
  {

Index: readline.h
===================================================================
RCS file: /cvsroot/foo/fooelk/lib/readline/readline.h,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** readline.h	6 Aug 2004 20:56:43 -0000	1.1.1.1
--- readline.h	7 Aug 2004 08:56:26 -0000	1.2
***************
*** 52,55 ****
--- 52,56 ----
  extern Object P_Readline_Add_History (Object add);
  extern Object P_Readline_Set_Prompt (Object prompt);
+ extern Object P_Readline_Completion (Object enable);
  
  #define Def_Prim Define_Primitive

Index: completion.c
===================================================================
RCS file: /cvsroot/foo/fooelk/lib/readline/completion.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** completion.c	7 Aug 2004 08:07:25 -0000	1.3
--- completion.c	7 Aug 2004 08:56:26 -0000	1.4
***************
*** 75,78 ****
--- 75,85 ----
  erl_symbol_complete (char *text, int state)
  {
+ #ifdef HAVE_EDITLINE_READLINE_H
+   if (! _do_completion)
+     {
+       return NULL;
+     }
+ #endif
+ 
    if (! state)
      {
***************
*** 84,87 ****
--- 91,95 ----
  
  
+ #ifdef HAVE_READLINE_READLINE_H
  static char **
  erl_guess_completion (const char *text, int start, int end)
***************
*** 105,111 ****
    return matches;
  }
  
  
! static Object
  P_Readline_Completion (Object enable)
  {
--- 113,120 ----
    return matches;
  }
+ #endif /* #ifdef HAVE_READLINE_READLINE_H */
  
  
! Object
  P_Readline_Completion (Object enable)
  {
***************
*** 141,145 ****
--- 150,161 ----
    _erl_completions = (char **)malloc(_erl_maxcompl * sizeof(char *));
    rl_readline_name = "fooelk";
+ 
+ #ifdef HAVE_READLINE_READLINE_H
    rl_attempted_completion_function = erl_guess_completion;
+ #elif HAVE_EDITLINE_READLINE_H
+   rl_completion_entry_function = (void *)erl_symbol_complete;
+ #else
+ #error *** NO EDITLINE/READLINE SUPPORT FOUND ***
+ #endif
  
    Def_Prim(P_Readline_Completion,	"readline-completion",	1, 1,	EVAL);

[foo-cvs] fooelk configure.ac,1.2,1.3

From: Martin R. <ru...@us...> - 2004-08-07 08:55:37

Update of /cvsroot/foo/fooelk
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17439

Modified Files:
	configure.ac 
Log Message:
include fink's /sw directory automatically when searching for headers/libs on mac os x

Index: configure.ac
===================================================================
RCS file: /cvsroot/foo/fooelk/configure.ac,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** configure.ac	7 Aug 2004 00:27:31 -0000	1.2
--- configure.ac	7 Aug 2004 08:55:29 -0000	1.3
***************
*** 58,61 ****
--- 58,63 ----
    *darwin*)
      AC_DEFINE(SYS_DARWIN, 1, Define if the system is Darwin)
+     CPPFLAGS="${CPPFLAGS} -I/sw/include"
+     LDFLAGS="${LDFLAGS} -L/sw/lib"
      ;;
  esac

[foo-cvs] fooelk/lib/readline completion.c,1.2,1.3

From: Martin R. <ru...@us...> - 2004-08-07 08:07:34

Update of /cvsroot/foo/fooelk/lib/readline
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10989

Modified Files:
	completion.c 
Log Message:
inverted behavior of completion initial state (disabled if FOO_READLINE_COMPLETION is set)

Index: completion.c
===================================================================
RCS file: /cvsroot/foo/fooelk/lib/readline/completion.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** completion.c	7 Aug 2004 08:04:40 -0000	1.2
--- completion.c	7 Aug 2004 08:07:25 -0000	1.3
***************
*** 132,140 ****
    if ((completion = getenv("ELK_READLINE_COMPLETION")) && strlen(completion))
      {
!       _do_completion = 1;
      }
    else
      {
!       _do_completion = 0;
      }
    _erl_maxcompl = 512;
--- 132,140 ----
    if ((completion = getenv("ELK_READLINE_COMPLETION")) && strlen(completion))
      {
!       _do_completion = 0;
      }
    else
      {
!       _do_completion = 1;
      }
    _erl_maxcompl = 512;

[foo-cvs] fooelk/lib/readline completion.c,1.1.1.1,1.2

From: Martin R. <ru...@us...> - 2004-08-07 08:04:49

Update of /cvsroot/foo/fooelk/lib/readline
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10503

Modified Files:
	completion.c 
Log Message:
complete filenames instead of symbols inside strings.  switch completion on/off via scheme functions, initial state determined by ELK_READLINE_COMPLETION environment var

Index: completion.c
===================================================================
RCS file: /cvsroot/foo/fooelk/lib/readline/completion.c,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** completion.c	6 Aug 2004 20:56:43 -0000	1.1.1.1
--- completion.c	7 Aug 2004 08:04:40 -0000	1.2
***************
*** 30,35 ****
--- 30,38 ----
  
  #include "readline.h"
+ #include <stdlib.h>
+ #include <string.h>
  
  static int _erl_maxcompl;
+ static int _do_completion;
  static char **_erl_completions;
  
***************
*** 70,74 ****
  
  static char *
! erl_complete (char *text, int state)
  {
    if (! state)
--- 73,77 ----
  
  static char *
! erl_symbol_complete (char *text, int state)
  {
    if (! state)
***************
*** 81,90 ****
  
  
  void
  elk_init_readline_completion (void)
  {
!   _erl_maxcompl = 256;
    _erl_completions = (char **)malloc(_erl_maxcompl * sizeof(char *));
!   rl_completion_entry_function = (void *)erl_complete;
  }
  
--- 84,147 ----
  
  
+ static char **
+ erl_guess_completion (const char *text, int start, int end)
+ {
+   char **matches;
+ 
+   if (! _do_completion)
+     {
+       rl_attempted_completion_over = 1;
+       return NULL;
+     }
+ 
+   matches = (char **)NULL;
+ 
+   /* complete symbols if not in string */
+   if (rl_line_buffer[start - 1] != '"')
+     {
+       matches = rl_completion_matches(text, erl_symbol_complete);
+     }
+ 
+   return matches;
+ }
+ 
+ 
+ static Object
+ P_Readline_Completion (Object enable)
+ {
+   Check_Type(enable, T_Boolean);
+ 
+   if (Truep(enable))
+     {
+       _do_completion = 1;
+     }
+   else
+     {
+       _do_completion = 0;
+     }
+ 
+   return True;
+ }
+ 
+ 
  void
  elk_init_readline_completion (void)
  {
!   char *completion;
! 
!   if ((completion = getenv("ELK_READLINE_COMPLETION")) && strlen(completion))
!     {
!       _do_completion = 1;
!     }
!   else
!     {
!       _do_completion = 0;
!     }
!   _erl_maxcompl = 512;
    _erl_completions = (char **)malloc(_erl_maxcompl * sizeof(char *));
!   rl_readline_name = "fooelk";
!   rl_attempted_completion_function = erl_guess_completion;
! 
!   Def_Prim(P_Readline_Completion,	"readline-completion",	1, 1,	EVAL);
  }

[foo-cvs] fooelk/scm slib.scm.in,1.1.1.1,1.2

From: Martin R. <ru...@us...> - 2004-08-07 00:31:04

Update of /cvsroot/foo/fooelk/scm
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14178

Modified Files:
	slib.scm.in 
Log Message:
path name .../elk -> .../fooelk

Index: slib.scm.in
===================================================================
RCS file: /cvsroot/foo/fooelk/scm/slib.scm.in,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** slib.scm.in	6 Aug 2004 20:56:42 -0000	1.1.1.1
--- slib.scm.in	7 Aug 2004 00:30:48 -0000	1.2
***************
*** 48,52 ****
  ;;; implementation reside.
  
! (define (implementation-vicinity) "@prefix@/share/elk")
  
  ;;; (library-vicinity) should be defined to be the pathname of the
--- 48,52 ----
  ;;; implementation reside.
  
! (define (implementation-vicinity) "@prefix@/share/fooelk")
  
  ;;; (library-vicinity) should be defined to be the pathname of the

[foo-cvs] fooelk configure.ac,1.1.1.1,1.2

From: Martin R. <ru...@us...> - 2004-08-07 00:27:40

Update of /cvsroot/foo/fooelk
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13529

Modified Files:
	configure.ac 
Log Message:
added gc-type and heapsize configure-time options

Index: configure.ac
===================================================================
RCS file: /cvsroot/foo/fooelk/configure.ac,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** configure.ac	6 Aug 2004 20:56:42 -0000	1.1.1.1
--- configure.ac	7 Aug 2004 00:27:31 -0000	1.2
***************
*** 83,88 ****
  # check for libedit/libreadline
  AC_ARG_ENABLE(gnu-readline,
!   [  --enable-gnu-readline   force gnu readline support (GPL license!!!)
! ],,
    enable_gnu_readline=no)
  
--- 83,87 ----
  # check for libedit/libreadline
  AC_ARG_ENABLE(gnu-readline,
!   AC_HELP_STRING([--enable-gnu-readline], [force gnu readline support (GPL license!!!)]),,
    enable_gnu_readline=no)
  
***************
*** 482,490 ****
  # Do you want to use the generational garbage collector?  If not, the
  # stop-and-copy garbage collector will be used.
! AC_DEFINE(GENERATIONAL_GC, 1, [FIXME HARD])
  
  # The default heap size of the Scheme interpreter in KBytes (if the
  # stop-and-copy garbage collector is used).
! AC_DEFINE(HEAP_SIZE, 65536, [FIXME HARD])
  
  # The directory where all files are installed by running "make install". We
--- 481,499 ----
  # Do you want to use the generational garbage collector?  If not, the
  # stop-and-copy garbage collector will be used.
! AC_ARG_WITH(gc-type,
!   AC_HELP_STRING([--with-gc-type=TYPE], [use 'generational' or 'stopncopy' garbage collector (generational)]),,
!   [with_gc_type=generational])
! 
! if test "x${with_gc_type}" = "xgenerational" ; then
!    AC_DEFINE(GENERATIONAL_GC, 1, [use the generational garbage collector])
! fi
  
  # The default heap size of the Scheme interpreter in KBytes (if the
  # stop-and-copy garbage collector is used).
! AC_ARG_WITH(default-heapsize,
!   AC_HELP_STRING([--with-default-heapsize=SIZE], [default heapsize of the interpreter for stop-and-copy garbage collector (4096k)]),,
!   [with_default_heapsize=4096])
! 
! AC_DEFINE_UNQUOTED(HEAP_SIZE, ${with_default_heapsize}, [default heap size of the interpreter for stop-and-copy garbage collector])
  
  # The directory where all files are installed by running "make install". We
***************
*** 665,669 ****
  Motif support: ${ac_cv_my_have_motif}
  readline support: ${ac_cv_my_have_readline}
  build documentation: ${ac_cv_my_have_groff}
  EOF
- 
--- 674,679 ----
  Motif support: ${ac_cv_my_have_motif}
  readline support: ${ac_cv_my_have_readline}
+ use garbage colllector: ${with_gc_type}
+ default heap size: ${with_default_heapsize}
  build documentation: ${ac_cv_my_have_groff}
  EOF

[foo-cvs] fooelk/src type.c,1.1.1.1,1.2

From: Martin R. <ru...@us...> - 2004-08-07 00:26:56

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

Modified Files:
	type.c 
Log Message:
with some luck: fixed bug which led to garbage collector crashes

Index: type.c
===================================================================
RCS file: /cvsroot/foo/fooelk/src/type.c,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** type.c	6 Aug 2004 20:56:42 -0000	1.1.1.1
--- type.c	7 Aug 2004 00:26:42 -0000	1.2
***************
*** 106,110 ****
      char *p;
  
!     Num_Types = (sizeof(builtin_types) - 1) / sizeof(char *);
      Max_Type = Num_Types + TYPE_GROW;
      bytes = Max_Type * sizeof(TYPEDESCR);
--- 106,116 ----
      char *p;
  
!     /* may be the next line led to the GC crash (both sc and gen).
!      * the first Define_Type gets 22, which is T_Broken_Heart
!      * (according to include/object.h).  crashes sc immediately and
!      * gen later, but only if objects of that first defined type are
!      * actually created */
!     /* Num_Types = (sizeof(builtin_types) - 1) / sizeof(char *); */
!     Num_Types = sizeof(builtin_types) / sizeof(char *);
      Max_Type = Num_Types + TYPE_GROW;
      bytes = Max_Type * sizeof(TYPEDESCR);

[foo-cvs] foo/elkfoo configure.ac,1.7,1.8

From: Martin R. <ru...@us...> - 2004-08-06 05:59:36

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

Modified Files:
	configure.ac 
Log Message:
cleaned up.  don't check for unused headers/functions

Index: configure.ac
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/configure.ac,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** configure.ac	6 Aug 2004 02:53:47 -0000	1.7
--- configure.ac	6 Aug 2004 05:59:27 -0000	1.8
***************
*** 49,53 ****
  AC_TYPE_SIGNAL
  AC_FUNC_STAT
! AC_CHECK_FUNCS([bzero gettimeofday getcwd memset mkdir pow rint rmdir sqrt strdup sigaction])
  
  # check for foundation library to use
--- 49,53 ----
  AC_TYPE_SIGNAL
  AC_FUNC_STAT
! AC_CHECK_FUNCS([gettimeofday getcwd memset mkdir pow rint rmdir sqrt strdup sigaction])
  
  # check for foundation library to use

[foo-cvs] foo/elkfoo/src Makefile.am,1.6,1.7 bpf.m,1.5,1.6

From: Martin R. <ru...@us...> - 2004-08-06 05:59:15

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

Modified Files:
	Makefile.am bpf.m 
Log Message:
minor include change

Index: Makefile.am
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/Makefile.am,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** Makefile.am	6 Aug 2004 03:01:55 -0000	1.6
--- Makefile.am	6 Aug 2004 05:59:07 -0000	1.7
***************
*** 49,53 ****
  			-I../../libfoo/modules/orthodox
  elkfoo_la_LDFLAGS =	$(ELKFOO_LDFLAGS) \
! 			-module -avoid-version -no-undefined
  elkfoo_la_LIBADD =	$(ELKFOO_LIBS) \
  			$(ELKFOO_EXT_LIBS) \
--- 49,55 ----
  			-I../../libfoo/modules/orthodox
  elkfoo_la_LDFLAGS =	$(ELKFOO_LDFLAGS) \
! 			-module -avoid-version
! # -no-undefined # does not work for OS X, maybe libtool bug
! 
  elkfoo_la_LIBADD =	$(ELKFOO_LIBS) \
  			$(ELKFOO_EXT_LIBS) \

Index: bpf.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/bpf.m,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** bpf.m	6 Aug 2004 02:52:59 -0000	1.5
--- bpf.m	6 Aug 2004 05:59:07 -0000	1.6
***************
*** 35,40 ****
  #endif
  
- #include <FOO/FOOBreakpointFunction.h>
- 
  #define Object SchemeObject	/* avoid Obj-C type clash */
  #ifdef HAVE_FOOELK_SCHEME_H
--- 35,38 ----
***************
*** 46,49 ****
--- 44,48 ----
  
  #include "elkfoo.h"
+ #include <FOO/FOOBreakpointFunction.h>
  
  int T_Bpf;
***************
*** 305,308 ****
--- 304,308 ----
    T_Bpf = Define_Type(0, "bpf", NOFUNC, sizeof(struct S_Bpf), Bpf_Equal,
  		      Bpf_Equal, Bpf_Print, Bpf_Visit);
+ 
    DP(P_Bpfp,		"foo:bpf?",		1, 1, EVAL);
    DP(P_Make_Bpf,	"foo:make-bpf",		1, 1, EVAL);

[foo-cvs] foo/libfoo configure.ac,1.11,1.12

From: Martin R. <ru...@us...> - 2004-08-06 05:58:31

Update of /cvsroot/foo/foo/libfoo
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28802

Modified Files:
	configure.ac 
Log Message:
cleaned up. removed checks for unused headers/functions

Index: configure.ac
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/configure.ac,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** configure.ac	4 Aug 2004 06:44:19 -0000	1.11
--- configure.ac	6 Aug 2004 05:58:20 -0000	1.12
***************
*** 71,75 ****
  AC_STDC_HEADERS
  AC_HEADER_SYS_WAIT
! AC_CHECK_HEADERS([limits.h stdlib.h string.h strings.h sys/param.h sys/timeb.h unistd.h signal.h])
  
  # Checks for library functions.
--- 71,75 ----
  AC_STDC_HEADERS
  AC_HEADER_SYS_WAIT
! AC_CHECK_HEADERS([limits.h stdlib.h string.h signal.h])
  
  # Checks for library functions.
***************
*** 79,83 ****
  AC_TYPE_SIGNAL
  AC_FUNC_STAT
! AC_CHECK_FUNCS([bzero ftime getcwd memset mkdir pow rint rmdir sqrt strdup sigaction])
  
  # check for foundation library to use
--- 79,83 ----
  AC_TYPE_SIGNAL
  AC_FUNC_STAT
! AC_CHECK_FUNCS([memset mkdir pow rint rmdir sqrt strdup])
  
  # check for foundation library to use

[foo-cvs] foo/libfoo/modules/orthodox FOOMExpon.m,1.1,1.2 FOOMFof.m,1.1,1.2 FOOMGate.m,1.1,1.2 FOOMLine.m,1.1,1.2 FOOMLookup.m,1.2,1.3 FOOMReadSnd.m,1.2,1.3 FOOMReadTranspSnd.m,1.3,1.4 FOOMReverb.m,1.1,1.2 FOOMReverb8.m,1.1,1.2 FOOMTransposeSnd.m,1.3,1.4

From: Martin R. <ru...@us...> - 2004-08-06 05:57:58

Update of /cvsroot/foo/foo/libfoo/modules/orthodox
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28716

Modified Files:
	FOOMExpon.m FOOMFof.m FOOMGate.m FOOMLine.m FOOMLookup.m 
	FOOMReadSnd.m FOOMReadTranspSnd.m FOOMReverb.m FOOMReverb8.m 
	FOOMTransposeSnd.m 
Log Message:
bzero(x, y) -> memset(x, 0, y)

Index: FOOMReverb8.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/orthodox/FOOMReverb8.m,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** FOOMReverb8.m	31 Jul 2004 03:05:30 -0000	1.1
--- FOOMReverb8.m	6 Aug 2004 05:57:41 -0000	1.2
***************
*** 580,587 ****
    else
      {
!       bzero([_buffer data], sizeof(sample_t) * BLOCKSIZE);
        for (i = 0; i < 8 - 1; i++)
  	{
! 	bzero([[_buffers objectAtIndex: i] data], sizeof(sample_t) * BLOCKSIZE);
  	}
      }
--- 580,587 ----
    else
      {
!       memset([_buffer data], 0, sizeof(sample_t) * BLOCKSIZE);
        for (i = 0; i < 8 - 1; i++)
  	{
! 	memset([[_buffers objectAtIndex: i] data], 0, sizeof(sample_t) * BLOCKSIZE);
  	}
      }

Index: FOOMReverb.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/orthodox/FOOMReverb.m,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** FOOMReverb.m	31 Jul 2004 03:05:30 -0000	1.1
--- FOOMReverb.m	6 Aug 2004 05:57:41 -0000	1.2
***************
*** 618,625 ****
  	else 
  		{
! 			bzero([_buffer data], sizeof(sample_t) * BLOCKSIZE);
  			for (i = 0; i < _channels - 1; i++)
  				{
! 				  bzero([[_buffers objectAtIndex: i] data], sizeof(sample_t) * BLOCKSIZE);
  				}
  		}
--- 618,625 ----
  	else 
  		{
! 			memset([_buffer data], 0, sizeof(sample_t) * BLOCKSIZE);
  			for (i = 0; i < _channels - 1; i++)
  				{
! 				  memset([[_buffers objectAtIndex: i] data], 0, sizeof(sample_t) * BLOCKSIZE);
  				}
  		}

Index: FOOMLookup.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/orthodox/FOOMLookup.m,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** FOOMLookup.m	4 Aug 2004 06:20:31 -0000	1.2
--- FOOMLookup.m	6 Aug 2004 05:57:41 -0000	1.3
***************
*** 75,79 ****
  {
      [super reset];
!     bzero(_samples, _count * sizeof(sample_t));
      _offset = -_count;
  
--- 75,79 ----
  {
      [super reset];
!     memset(_samples, 0, _count * sizeof(sample_t));
      _offset = -_count;
  

Index: FOOMGate.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/orthodox/FOOMGate.m,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** FOOMGate.m	31 Jul 2004 03:05:29 -0000	1.1
--- FOOMGate.m	6 Aug 2004 05:57:41 -0000	1.2
***************
*** 93,97 ****
      {
        b = _begin - SAMPLETIME;
!       bzero(out, b * sizeof(sample_t));
      }
    else
--- 93,97 ----
      {
        b = _begin - SAMPLETIME;
!       memset(out, 0, b * sizeof(sample_t));
      }
    else
***************
*** 103,107 ****
      {
        e = BLOCKSIZE - (BLOCKEND - _end);
!       bzero(out + e, (BLOCKSIZE - e) * sizeof(sample_t));
      }
    else
--- 103,107 ----
      {
        e = BLOCKSIZE - (BLOCKEND - _end);
!       memset(out + e, 0, (BLOCKSIZE - e) * sizeof(sample_t));
      }
    else

Index: FOOMReadTranspSnd.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/orthodox/FOOMReadTranspSnd.m,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** FOOMReadTranspSnd.m	2 Aug 2004 00:43:15 -0000	1.3
--- FOOMReadTranspSnd.m	6 Aug 2004 05:57:41 -0000	1.4
***************
*** 201,205 ****
      {
        b = _begin - SAMPLETIME;
!       bzero(p, b * sizeof(sample_t));
      } 
    else
--- 201,205 ----
      {
        b = _begin - SAMPLETIME;
!       memset(p, 0, b * sizeof(sample_t));
      } 
    else
***************
*** 210,214 ****
      {
        e = BLOCKSIZE - (BLOCKEND - _end);
!       bzero(p + e, (BLOCKSIZE - e) * sizeof(sample_t));
      } 
    else
--- 210,214 ----
      {
        e = BLOCKSIZE - (BLOCKEND - _end);
!       memset(p + e, 0, (BLOCKSIZE - e) * sizeof(sample_t));
      } 
    else
***************
*** 249,253 ****
      {
        b = _begin - SAMPLETIME;
!       bzero(out, b * sizeof(sample_t));
        out += b;
        n -= b;
--- 249,253 ----
      {
        b = _begin - SAMPLETIME;
!       memset(out, 0, b * sizeof(sample_t));
        out += b;
        n -= b;

Index: FOOMTransposeSnd.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/orthodox/FOOMTransposeSnd.m,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** FOOMTransposeSnd.m	4 Aug 2004 06:20:31 -0000	1.3
--- FOOMTransposeSnd.m	6 Aug 2004 05:57:41 -0000	1.4
***************
*** 94,98 ****
  {
    [super reset];
!   bzero(_samples, _count * sizeof(sample_t));
    [self initPos];
  
--- 94,98 ----
  {
    [super reset];
!   memset(_samples, 0, _count * sizeof(sample_t));
    [self initPos];
  
***************
*** 150,154 ****
      {
        b = _begin - SAMPLETIME;
!       bzero(out, b * sizeof(sample_t));
        in  += b;
        out += b;
--- 150,154 ----
      {
        b = _begin - SAMPLETIME;
!       memset(out, 0, b * sizeof(sample_t));
        in  += b;
        out += b;

Index: FOOMReadSnd.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/orthodox/FOOMReadSnd.m,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** FOOMReadSnd.m	1 Aug 2004 23:39:20 -0000	1.2
--- FOOMReadSnd.m	6 Aug 2004 05:57:41 -0000	1.3
***************
*** 100,104 ****
      {
        b = _begin - SAMPLETIME;
!       bzero(p, b * sizeof(sample_t));
      } 
    else
--- 100,104 ----
      {
        b = _begin - SAMPLETIME;
!       memset(p, 0, b * sizeof(sample_t));
      } 
    else
***************
*** 109,113 ****
      {
        e = BLOCKSIZE - (BLOCKEND - _end);
!       bzero(p + e, (BLOCKSIZE - e) * sizeof(sample_t));
      } 
    else
--- 109,113 ----
      {
        e = BLOCKSIZE - (BLOCKEND - _end);
!       memset(p + e, 0, (BLOCKSIZE - e) * sizeof(sample_t));
      } 
    else

Index: FOOMFof.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/orthodox/FOOMFof.m,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** FOOMFof.m	31 Jul 2004 03:05:29 -0000	1.1
--- FOOMFof.m	6 Aug 2004 05:57:41 -0000	1.2
***************
*** 439,443 ****
  	  f0p += offset; frp += offset; bwp += offset;
  	  amp += offset; txp += offset; dbp += offset; atp += offset;
! 	  bzero(out, offset * sizeof(sample_t));
  	  out += offset;
  	  n -= offset;
--- 439,443 ----
  	  f0p += offset; frp += offset; bwp += offset;
  	  amp += offset; txp += offset; dbp += offset; atp += offset;
! 	  memset(out, 0, offset * sizeof(sample_t));
  	  out += offset;
  	  n -= offset;

Index: FOOMLine.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/orthodox/FOOMLine.m,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** FOOMLine.m	31 Jul 2004 03:05:30 -0000	1.1
--- FOOMLine.m	6 Aug 2004 05:57:41 -0000	1.2
***************
*** 99,103 ****
      {
        b = _begin - SAMPLETIME;
!       bzero(p, b * sizeof(sample_t));
      }
    else
--- 99,103 ----
      {
        b = _begin - SAMPLETIME;
!       memset(p, 0, b * sizeof(sample_t));
      }
    else
***************
*** 108,112 ****
      {
        e = BLOCKSIZE - (BLOCKEND - _end);
!     bzero(p + e, (BLOCKSIZE - e) * sizeof(sample_t));
      }
    else
--- 108,112 ----
      {
        e = BLOCKSIZE - (BLOCKEND - _end);
!     memset(p + e, 0, (BLOCKSIZE - e) * sizeof(sample_t));
      }
    else

Index: FOOMExpon.m
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/modules/orthodox/FOOMExpon.m,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** FOOMExpon.m	31 Jul 2004 03:05:29 -0000	1.1
--- FOOMExpon.m	6 Aug 2004 05:57:41 -0000	1.2
***************
*** 102,106 ****
      {
        b = _begin - SAMPLETIME;
!       bzero(p, b * sizeof(sample_t));
      }
    else
--- 102,106 ----
      {
        b = _begin - SAMPLETIME;
!       memset(p, 0, b * sizeof(sample_t));
      }
    else
***************
*** 112,116 ****
      {
        e = BLOCKSIZE - (BLOCKEND - _end);
!       bzero(p + e, (BLOCKSIZE - e) * sizeof(sample_t));
      }
    else
--- 112,116 ----
      {
        e = BLOCKSIZE - (BLOCKEND - _end);
!       memset(p + e, 0, (BLOCKSIZE - e) * sizeof(sample_t));
      }
    else

[foo-cvs] foo/elkfoo/src Makefile.am,1.5,1.6

From: Martin R. <ru...@us...> - 2004-08-06 03:02:03

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

Modified Files:
	Makefile.am 
Log Message:
link elkfoo->foo after in install-exec-hook

Index: Makefile.am
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/Makefile.am,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Makefile.am	6 Aug 2004 02:52:59 -0000	1.5
--- Makefile.am	6 Aug 2004 03:01:55 -0000	1.6
***************
*** 60,61 ****
--- 60,65 ----
  elkfoo_LDADD =		$(ELKFOO_LIBS) \
  			$(FND_LIBS) @FOO_GNUSTEP_LDFLAGS@
+ 
+ install-exec-hook:
+ 	rm -f "$(DESTDIR)$(bindir)/foo"
+ 	ln -s elkfoo "$(DESTDIR)$(bindir)/foo"

[foo-cvs] foo/elkfoo configure.ac,1.6,1.7

From: Martin R. <ru...@us...> - 2004-08-06 02:53:58

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

Modified Files:
	configure.ac 
Log Message:
fixed elkfoo binary build params

Index: configure.ac
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/configure.ac,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** configure.ac	5 Aug 2004 23:15:35 -0000	1.6
--- configure.ac	6 Aug 2004 02:53:47 -0000	1.7
***************
*** 101,104 ****
--- 101,105 ----
     AC_DEFINE(FOO_GNUSTEP, 1, Define if we are using GNUstep)
     FOO_GNUSTEP_OBJCFLAGS="\$(GNUSTEP_HEADERS_FLAGS) \$(AUXILIARY_OBJCFLAGS)"
+    FOO_GNUSTEP_INCLUDES="\$(GNUSTEP_HEADERS_FLAGS)"
     FOO_GNUSTEP_LDFLAGS="\$(GNUSTEP_LIBRARIES_FLAGS)"
  
***************
*** 210,214 ****
  if test -z "${RECURSIVE_BUILD}"; then
     AC_MSG_WARN([ommitting check for libfoo])
!    ELKFOO_LIBS="${ELKFOO_LIBS} -lfoo"
  
  dnl    AC_LANG_PUSH(Objective C)
--- 211,215 ----
  if test -z "${RECURSIVE_BUILD}"; then
     AC_MSG_WARN([ommitting check for libfoo])
!    ELKFOO_EXT_LIBS="${ELKFOO_EXT_LIBS} -lfoo"
  
  dnl    AC_LANG_PUSH(Objective C)
***************
*** 218,222 ****
  dnl       AC_CHECK_LIB([foo], [main])
  dnl       if test "${ac_cv_lib_foo_main}" = yes; then
! dnl 	ELKFOO_LIBS="${ELKFOO_LIBS} -lfoo"
  dnl    else
  dnl         have_libfoo=no
--- 219,223 ----
  dnl       AC_CHECK_LIB([foo], [main])
  dnl       if test "${ac_cv_lib_foo_main}" = yes; then
! dnl 	ELKFOO_EXT_LIBS="${ELKFOO_EXT_LIBS} -lfoo"
  dnl    else
  dnl         have_libfoo=no
***************
*** 234,238 ****
  else
    INCLUDES="-I\$(top_srcdir)/../libfoo -I\$(top_builddir)/../libfoo ${INCLUDES}"
!   ELKFOO_LIBS="${ELKFOO_LIBS} \$(top_builddir)/../libfoo/src/libfoo.la"
  fi
  
--- 235,239 ----
  else
    INCLUDES="-I\$(top_srcdir)/../libfoo -I\$(top_builddir)/../libfoo ${INCLUDES}"
!   ELKFOO_EXT_LIBS="${ELKFOO_EXT_LIBS} \$(top_builddir)/../libfoo/src/libfoo.la"
  fi
  
***************
*** 249,254 ****
--- 250,257 ----
  AC_SUBST(ELKFOO_LDFLAGS)
  AC_SUBST(ELKFOO_LIBS)
+ AC_SUBST(ELKFOO_EXT_LIBS)
  AC_SUBST(GNUSTEP_MAKEFILES)
  AC_SUBST(FOO_GNUSTEP_OBJCFLAGS)
+ AC_SUBST(FOO_GNUSTEP_INCLUDES)
  AC_SUBST(FOO_GNUSTEP_LDFLAGS)
  AC_SUBST(ELK_LIBRARY)

[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

From: Martin R. <ru...@us...> - 2004-08-06 02:53:10

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 pointer.m,1.3,1.4 tell.m,1.6,1.7

From: Martin R. <ru...@us...> - 2004-08-06 00:22:21

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

Modified Files:
	pointer.m tell.m 
Log Message:
K&R->ANSI (partially)

Index: pointer.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/pointer.m,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** pointer.m	5 Aug 2004 23:13:56 -0000	1.3
--- pointer.m	6 Aug 2004 00:22:11 -0000	1.4
***************
*** 93,348 ****
  };
  
! static SchemeObject P_Pointerp(x)
! SchemeObject x;
  {
!     return TYPE(x) == T_Pointer ? True : False;
  }
  
! static SchemeObject P_Null_Pointerp(x)
! SchemeObject x;
  {
!     Check_Type(x, T_Pointer);
!     return POINTER_T(x)->pointer == (void *)0 ? True : False;
  }
  
! static SchemeObject P_Pointer_Type(ptr)
! SchemeObject ptr;
  {
!     Check_Type(ptr, T_Pointer);
!     return Make_String(type_names[POINTER_T(ptr)->type.data],
! 		       strlen(type_names[POINTER_T(ptr)->type.data]));
  }
  
! static SchemeObject P_Pointer_Addr(ptr)
! SchemeObject ptr;
  {
!     Check_Type(ptr, T_Pointer);
!     return Make_Integer((int)(POINTER_T(ptr)->pointer));
  }
  
! SchemeObject A_Make_Pointer(address, type)
! int address, type;
  {
!     SchemeObject pointer;
  
!     pointer = Alloc_Object(sizeof(struct S_Pointer), T_Pointer, 0);
!     POINTER_T(pointer)->type.data = type;
!     POINTER_T(pointer)->pointer = (void *)address;
!     return pointer;
  }
  
! static SchemeObject P_Make_Pointer(addr, type)
! SchemeObject addr, type;
  {
    //    SchemeObject pointer;
!     int i;
  
!     if (TYPE(type) != T_String && TYPE(type) != T_Symbol)
! 	Wrong_Type_Combination(type, "string or symbol");
!     if (TYPE(type) == T_Symbol)
! 	type = SYMBOL(type)->name;
!     for (i = C_pointers; i < C_last; i++) {
! 	if (strlen(type_names[i]) != STRING(type)->size)
! 	    continue;
! 	if (strcmp(STRING(type)->data, type_names[i]) == 0)
! 	    break;
      }
!     if (i == C_last)
! 	Primitive_Error("unknown pointer type: ~s", type);
!     return A_Make_Pointer(Get_Integer(addr), i);
  }
  
! static SchemeObject Reference_Address(p, t, b)
! int p, t;
! SchemeObject b;
  {
!     switch (t) {
!       case C_CHAR:
!       case C_UNSIGNED_CHAR:
! 	return Make_String((char *)p, strlen((char *)p));
!       case C_SHORT:
! 	return Make_Integer(*((short *)p));
!       case C_INT:
! 	return Make_Integer(*((int *)p));
!       case C_LONG:
! 	return Make_Integer(*((long *)p));
!       case C_UNSIGNED_SHORT:
! 	return Make_Unsigned(*((unsigned short *)p));
!       case C_UNSIGNED_INT:
! 	return Make_Unsigned(*((unsigned int *)p));
!       case C_UNSIGNED_LONG:
! 	return Make_Unsigned(*((unsigned long *)p));
!       case C_FLOAT:
! 	return Make_Reduced_Flonum(*((float *)p));
!       case C_DOUBLE:
! 	return Make_Reduced_Flonum(*((double *)p));
!       case C_CHARPTR:
! 	return Make_String(*((char **)p), strlen((*(char **)p)));
!       default:
! 	return Null;
      }
  }
  
! static int Get_String_List_Items(p, n)
! char **p;
! int n;
  {
!     int m = 0;
!     int l = 10000;
  
!     if (n == 0)
! 	while (*p++ != (char *)0 && --l)
! 	    m++;
!     else
! 	while (n-- > 0)
! 	    if (*p++ == (char *)0 && --l)
! 		break;
! 	    else
! 		m++;
!     if (l)
! 	return m;
!     else
! 	Primitive_Error("expected string vector too long");
!     /*NOTREACHED*/
!     return 0; /* avoid warnings */
  }
  
! static SchemeObject P_Pointer_Ref(argc, argv)
! int argc;
! SchemeObject *argv;
  {
!     SchemeObject result, pointer;
!     int offset = 0, items = 1, type, addr, i;
  
!     GC_Node;
  
!     pointer = argv[0];
!     Check_Type(pointer, T_Pointer);
!     GC_Link(pointer);
!     type = POINTER_T(pointer)->type.data;
!     addr = (int)POINTER_T(pointer)->pointer;
!     if (argc > 1)
! 	offset = Get_Integer(argv[1]);
!     if (argc > 2)
! 	items = Get_Integer(argv[2]);
!     if (items == 1)
! 	result = Reference_Address(addr, type, pointer);
!     else {
! 	if (type == C_CHARPTR)
! 	    items = Get_String_List_Items((char **)addr, items);
! 	result = Make_Vector(items, Null);
! 	for (i = 0; i < items; i++) {
! 	    VECTOR(result)->data[i] = Reference_Address(addr, type, pointer);
! 	    switch (type) {
! 	      case C_CHAR:
! 		addr += sizeof(char);
! 		break;
! 	      case C_SHORT:
! 		addr += sizeof(short);
! 		break;
! 	      case C_INT:
! 		addr += sizeof(int);
! 		break;
! 	      case C_LONG:
! 		addr += sizeof(long);
! 		break;
! 	      case C_UNSIGNED_CHAR:
! 		addr += sizeof(unsigned char);
! 		break;
! 	      case C_UNSIGNED_SHORT:
! 		addr += sizeof(unsigned short);
! 		break;
! 	      case C_UNSIGNED_INT:
! 		addr += sizeof(unsigned int);
! 		break;
! 	      case C_UNSIGNED_LONG:
! 		addr += sizeof(unsigned long);
! 		break;
! 	      case C_FLOAT:
! 		addr += sizeof(float);
! 		break;
! 	      case C_DOUBLE:
! 		addr += sizeof(double);
! 		break;
! 	      case C_CHARPTR:
! 		addr += sizeof(char *);
! 		break;
! 	      default:
! 		Primitive_Error("internal error with address increment");
  	    }
  	}
      }
!     GC_Unlink;
!     return result;
  }
  
! static SchemeObject P_Pointer_Set(ptr, addr)
! SchemeObject ptr, addr;
  {
!     Check_Type(ptr, T_Pointer);
!     POINTER_T(ptr)->pointer = (void *)Get_Integer(addr);
!     return ptr;
  }
  
! static int Pointer_Equal(a, b)
! SchemeObject a, b;
  {
!     return EQ(POINTER_T(a)->type, POINTER_T(b)->type) &&
! 	(POINTER_T(a)->pointer == POINTER_T(b)->pointer);
  }
  
! static int Pointer_Print(x, port, raw, depth, length)
! SchemeObject x, port;
! int raw, depth, length;
  {
!     int type;
!     GC_Node2;
  
!     GC_Link2(port, x);
!     type = POINTER_T(x)->type.data;
!     if (type < C_base || type > C_last)
! 	Panic("bad pointer type in print");
!     if (POINTER_T(x)->pointer == (void *)0)
! 	Printf(port, "#[pointer NULL]");
!     else {
! 	Printf(port, "#[pointer <%s>", type_names[type]);
! 	if (type == C_ID) {
  	  id obj = ((id) (POINTER_T(x)->pointer));
! 	    char *otype = "instance";
  #ifdef NeXT_RUNTIME
! 	    if (CLS_GETINFO(obj->isa, CLS_META))
  #elif GNU_RUNTIME
! 	    if (CLS_ISMETA(obj->class_pointer))
  #else
  #error *** NEITHER NeXT NOR GNU RUNTIME PRESENT ***
  #endif
! 		otype = "class";
  #ifdef NeXT_RUNTIME
! 	    Printf(port, " {%s %s}", obj->isa->name, otype);
  #elif GNU_RUNTIME
! 	    Printf(port, " {%s %s}", obj->class_pointer->name, otype);
  #else
  #error *** NEITHER NeXT NOR GNU RUNTIME PRESENT ***
  #endif
  	}
! 	Printf(port, " (%u)]", (unsigned int)POINTER_T(x)->pointer);
      }
!     GC_Unlink;
  
!     return 0;
  }
  
! void elk_init_pointer()
  {   
!     T_Pointer = Define_Type(0, "pointer", NOFUNC, sizeof(struct S_Pointer),
! 		       Pointer_Equal, Pointer_Equal, Pointer_Print, NOFUNC);
!     Null_Pointer = A_Make_Pointer(0, C_VOID);
!     Define_Primitive(P_Pointerp, "pointer?", 1, 1, EVAL);
!     Define_Primitive(P_Null_Pointerp, "null-pointer?", 1, 1, EVAL);
!     Define_Primitive(P_Make_Pointer, "make-pointer", 2, 2, EVAL);
!     Define_Primitive(P_Pointer_Type, "pointer-type", 1, 1, EVAL);
!     Define_Primitive(P_Pointer_Addr, "pointer-addr", 1, 1, EVAL);
!     Define_Primitive(P_Pointer_Ref, "pointer-ref", 1, 3, VARARGS);
!     Define_Primitive(P_Pointer_Set, "pointer-set!", 2, 2, EVAL);
!     P_Provide(Intern("pointer"));
  }
--- 93,442 ----
  };
  
! 
! static SchemeObject
! P_Pointerp(SchemeObject x)
  {
!   return TYPE(x) == T_Pointer ? True : False;
  }
  
! 
! static SchemeObject
! P_Null_Pointerp (SchemeObject x)
  {
!   Check_Type(x, T_Pointer);
!   return POINTER_T(x)->pointer == (void *)0 ? True : False;
  }
  
! 
! static SchemeObject
! P_Pointer_Type (SchemeObject ptr)
  {
!   Check_Type(ptr, T_Pointer);
!   return Make_String(type_names[POINTER_T(ptr)->type.data],
! 		     strlen(type_names[POINTER_T(ptr)->type.data]));
  }
  
! 
! static SchemeObject
! P_Pointer_Addr (SchemeObject ptr)
  {
!   Check_Type(ptr, T_Pointer);
!   return Make_Integer((int)(POINTER_T(ptr)->pointer));
  }
  
! 
! SchemeObject
! A_Make_Pointer (int address,
! 		int type)
  {
!   SchemeObject pointer;
  
!   pointer = Alloc_Object(sizeof(struct S_Pointer), T_Pointer, 0);
!   POINTER_T(pointer)->type.data = type;
!   POINTER_T(pointer)->pointer = (void *)address;
!   return pointer;
  }
  
! 
! static SchemeObject
! P_Make_Pointer (SchemeObject addr,
! 		SchemeObject type)
  {
    //    SchemeObject pointer;
!   int i;
  
!   if (TYPE(type) != T_String && TYPE(type) != T_Symbol)
!     {
!       Wrong_Type_Combination(type, "string or symbol");
      }
!   if (TYPE(type) == T_Symbol)
!     {
!       type = SYMBOL(type)->name;
!     }
!   for (i = C_pointers; i < C_last; i++)
!     {
!       if (strlen(type_names[i]) != STRING(type)->size)
! 	{
! 	  continue;
! 	}
!       if (strcmp(STRING(type)->data, type_names[i]) == 0)
! 	{
! 	  break;
! 	}
!     }
!   if (i == C_last)
!     {
!       Primitive_Error("unknown pointer type: ~s", type);
!     }
! 
!   return A_Make_Pointer(Get_Integer(addr), i);
  }
  
! 
! static SchemeObject
! Reference_Address (int p,
! 		   int t,
! 		   SchemeObject b)
  {
!   switch (t)
!     {
!     case C_CHAR:
!     case C_UNSIGNED_CHAR:
!       return Make_String((char *)p, strlen((char *)p));
! 
!     case C_SHORT:
!       return Make_Integer(*((short *)p));
! 
!     case C_INT:
!       return Make_Integer(*((int *)p));
! 
!     case C_LONG:
!       return Make_Integer(*((long *)p));
! 
!     case C_UNSIGNED_SHORT:
!       return Make_Unsigned(*((unsigned short *)p));
! 
!     case C_UNSIGNED_INT:
!       return Make_Unsigned(*((unsigned int *)p));
! 
!     case C_UNSIGNED_LONG:
!       return Make_Unsigned(*((unsigned long *)p));
! 
!     case C_FLOAT:
!       return Make_Reduced_Flonum(*((float *)p));
! 
!     case C_DOUBLE:
!       return Make_Reduced_Flonum(*((double *)p));
! 
!     case C_CHARPTR:
!       return Make_String(*((char **)p), strlen((*(char **)p)));
! 
!     default:
!       return Null;
      }
  }
  
! 
! static int
! Get_String_List_Items (char **p,
! 		       int n)
  {
!   int m = 0;
!   int l = 10000;
  
!   if (n == 0)
!     {
!       while (*p++ != (char *)0 && --l)
! 	{
! 	  m++;
! 	}
!     }
!   else
!     {
!       while (n-- > 0)
! 	{
! 	  if (*p++ == (char *)0 && --l)
! 	    {
! 	      break;
! 	    }
! 	  else
! 	    {
! 	      m++;
! 	    }
! 	}
!     }
!   if (l)
!     {
!       return m;
!     }
!   else
!     {
!       Primitive_Error("expected string vector too long");
!     }
!   /*NOTREACHED*/
!   return 0; /* avoid warnings */
  }
  
! 
! static SchemeObject
! P_Pointer_Ref (int argc,
! 	       SchemeObject *argv)
  {
!   SchemeObject result, pointer;
!   int offset = 0, items = 1, type, addr, i;
  
!   GC_Node;
  
!   pointer = argv[0];
!   Check_Type(pointer, T_Pointer);
!   GC_Link(pointer);
!   type = POINTER_T(pointer)->type.data;
!   addr = (int)POINTER_T(pointer)->pointer;
! 
!   if (argc > 1)
!     {
!       offset = Get_Integer(argv[1]);
!     }
!   if (argc > 2)
!     {
!       items = Get_Integer(argv[2]);
!     }
!   if (items == 1)
!     {
!       result = Reference_Address(addr, type, pointer);
!     }
!   else
!     {
!       if (type == C_CHARPTR)
! 	items = Get_String_List_Items((char **)addr, items);
!       result = Make_Vector(items, Null);
!       for (i = 0; i < items; i++)
! 	{
! 	  VECTOR(result)->data[i] = Reference_Address(addr, type, pointer);
! 	  switch (type)
! 	    {
! 	    case C_CHAR:
! 	      addr += sizeof(char);
! 	      break;
! 
! 	    case C_SHORT:
! 	      addr += sizeof(short);
! 	      break;
! 
! 	    case C_INT:
! 	      addr += sizeof(int);
! 	      break;
! 
! 	    case C_LONG:
! 	      addr += sizeof(long);
! 	      break;
! 
! 	    case C_UNSIGNED_CHAR:
! 	      addr += sizeof(unsigned char);
! 	      break;
! 
! 	    case C_UNSIGNED_SHORT:
! 	      addr += sizeof(unsigned short);
! 	      break;
! 
! 	    case C_UNSIGNED_INT:
! 	      addr += sizeof(unsigned int);
! 	      break;
! 
! 	    case C_UNSIGNED_LONG:
! 	      addr += sizeof(unsigned long);
! 	      break;
! 
! 	    case C_FLOAT:
! 	      addr += sizeof(float);
! 	      break;
! 
! 	    case C_DOUBLE:
! 	      addr += sizeof(double);
! 	      break;
! 
! 	    case C_CHARPTR:
! 	      addr += sizeof(char *);
! 	      break;
! 
! 	    default:
! 	      Primitive_Error("internal error with address increment");
  	    }
  	}
      }
!   GC_Unlink;
! 
!   return result;
  }
  
! 
! static SchemeObject
! P_Pointer_Set (SchemeObject ptr,
! 	       SchemeObject addr)
  {
!   Check_Type(ptr, T_Pointer);
!   POINTER_T(ptr)->pointer = (void *)Get_Integer(addr);
! 
!   return ptr;
  }
  
! 
! static int
! Pointer_Equal (SchemeObject a,
! 	       SchemeObject b)
  {
!   return EQ(POINTER_T(a)->type, POINTER_T(b)->type) &&
!     (POINTER_T(a)->pointer == POINTER_T(b)->pointer);
  }
  
! 
! static int
! Pointer_Print(SchemeObject x,
! 	      SchemeObject port,
! 	      int raw,
! 	      int depth,
! 	      int length)
  {
!   int type;
!   GC_Node2;
  
!   GC_Link2(port, x);
!   type = POINTER_T(x)->type.data;
!   if (type < C_base || type > C_last)
!     {
!       Panic("bad pointer type in print");
!     }
!   if (POINTER_T(x)->pointer == NULL)
!     {
!       Printf(port, "#[pointer NULL]");
!     }
!   else
!     {
!       // FIXME: THIS MIGHT GET BETTER USING HIGHLEVEL CALLS
! 
!       Printf(port, "#[pointer <%s>", type_names[type]);
!       if (type == C_ID)
! 	{
  	  id obj = ((id) (POINTER_T(x)->pointer));
! 	  char *otype = "instance";
  #ifdef NeXT_RUNTIME
! 	  if (CLS_GETINFO(obj->isa, CLS_META))
  #elif GNU_RUNTIME
! 	  if (CLS_ISMETA(obj->class_pointer))
  #else
  #error *** NEITHER NeXT NOR GNU RUNTIME PRESENT ***
  #endif
! 	    {
! 	      otype = "class";
! 	    }
  #ifdef NeXT_RUNTIME
! 	  Printf(port, " {%s %s}", obj->isa->name, otype);
  #elif GNU_RUNTIME
! 	  Printf(port, " {%s %s}", obj->class_pointer->name, otype);
  #else
  #error *** NEITHER NeXT NOR GNU RUNTIME PRESENT ***
  #endif
  	}
!       Printf(port, " (%u)]", (unsigned int)POINTER_T(x)->pointer);
      }
!   GC_Unlink;
  
!   return 0;
  }
  
! 
! void
! elk_nit_pointer ()
  {   
!   T_Pointer = Define_Type(0, "pointer", NOFUNC, sizeof(struct S_Pointer),
! 			  Pointer_Equal, Pointer_Equal, Pointer_Print, NOFUNC);
!   Null_Pointer = A_Make_Pointer(0, C_VOID);
!   Define_Primitive(P_Pointerp, "pointer?", 1, 1, EVAL);
!   Define_Primitive(P_Null_Pointerp, "null-pointer?", 1, 1, EVAL);
!   Define_Primitive(P_Make_Pointer, "make-pointer", 2, 2, EVAL);
!   Define_Primitive(P_Pointer_Type, "pointer-type", 1, 1, EVAL);
!   Define_Primitive(P_Pointer_Addr, "pointer-addr", 1, 1, EVAL);
!   Define_Primitive(P_Pointer_Ref, "pointer-ref", 1, 3, VARARGS);
!   Define_Primitive(P_Pointer_Set, "pointer-set!", 2, 2, EVAL);
!   P_Provide(Intern("pointer"));
  }

Index: tell.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/tell.m,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** tell.m	5 Aug 2004 23:32:08 -0000	1.6
--- tell.m	6 Aug 2004 00:22:11 -0000	1.7
***************
*** 655,660 ****
  
  static SchemeObject
! P_Types(SchemeObject receiver,
! 	SchemeObject selector)
  {
    STR name;
--- 655,660 ----
  
  static SchemeObject
! P_Types (SchemeObject receiver,
! 	 SchemeObject selector)
  {
    STR name;

[foo-cvs] foo/libfoo/FOO FOOObject.h,1.1,1.2

From: Martin R. <ru...@us...> - 2004-08-06 00:14:54

Update of /cvsroot/foo/foo/libfoo/FOO
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19743

Modified Files:
	FOOObject.h 
Log Message:
added (void *) cast to NULL definition

Index: FOOObject.h
===================================================================
RCS file: /cvsroot/foo/foo/libfoo/FOO/FOOObject.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** FOOObject.h	4 Aug 2004 05:15:48 -0000	1.1
--- FOOObject.h	6 Aug 2004 00:14:45 -0000	1.2
***************
*** 65,69 ****
  /* more tedious stuff for mac os x */
  #ifndef NULL
! #define NULL (0) /* haha */
  #endif
  /* end: more tedious stuff for mac os x */
--- 65,69 ----
  /* more tedious stuff for mac os x */
  #ifndef NULL
! #define NULL ((void *)0) /* haha */
  #endif
  /* end: more tedious stuff for mac os x */

[foo-cvs] foo/elkfoo/src misc.c,1.6,1.7

From: Martin R. <ru...@us...> - 2004-08-05 23:58:56

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

Modified Files:
	misc.c 
Log Message:
apparently getting tired.  again stupid fix in misc.c

Index: misc.c
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/misc.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** misc.c	5 Aug 2004 23:57:09 -0000	1.6
--- misc.c	5 Aug 2004 23:58:47 -0000	1.7
***************
*** 147,161 ****
        return False;
      }
!   if (WIFSIGNALED(n))
      {
!       return Cons(Make_Fixnum(WTERMSIG(n)), Null);
      }
!   else if (WIFSTOPPED(n))
      {
!       return Make_Fixnum(WSTOPSIG(n));
      }
  
    /* assert(WIFEXITED); */
!   return Make_Fixnum(WEXITSTATUS(n));
  }
  
--- 147,161 ----
        return False;
      }
!   if (WIFSIGNALED(status))
      {
!       return Cons(Make_Fixnum(WTERMSIG(status)), Null);
      }
!   else if (WIFSTOPPED(status))
      {
!       return Make_Fixnum(WSTOPSIG(status));
      }
  
    /* assert(WIFEXITED); */
!   return Make_Fixnum(WEXITSTATUS(status));
  }

[foo-cvs] foo/elkfoo/src misc.c,1.5,1.6

From: Martin R. <ru...@us...> - 2004-08-05 23:57:19

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

Modified Files:
	misc.c 
Log Message:
fixed wait() issues

Index: misc.c
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/misc.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** misc.c	5 Aug 2004 23:39:47 -0000	1.5
--- misc.c	5 Aug 2004 23:57:09 -0000	1.6
***************
*** 111,118 ****
  
    s = Get_String(cmd);
! #ifdef VFORK
!   switch (pid = vfork ())
  #else
!   switch (pid = fork ())
  #endif
      {
--- 111,120 ----
  
    s = Get_String(cmd);
! #ifdef HAVE_WORKING_VFORK
!   switch (pid = vfork())
! #elif HAVE_WORKING_FORK
!   switch (pid = fork())
  #else
! #error *** NEITHER VFORK NOR FORK ARE REPORTED TO WORK ***
  #endif
      {
***************
*** 145,153 ****
        return False;
      }
!   if ((n = (status.w_status & 0377)))
      {
!       return Cons (Make_Fixnum (n), Null);
      }
!   return Make_Fixnum ((status.w_status >> 8) & 0377);
  }
  
--- 147,161 ----
        return False;
      }
!   if (WIFSIGNALED(n))
      {
!       return Cons(Make_Fixnum(WTERMSIG(n)), Null);
      }
!   else if (WIFSTOPPED(n))
!     {
!       return Make_Fixnum(WSTOPSIG(n));
!     }
! 
!   /* assert(WIFEXITED); */
!   return Make_Fixnum(WEXITSTATUS(n));
  }

[foo-cvs] foo/elkfoo/src misc.c,1.4,1.5

From: Martin R. <ru...@us...> - 2004-08-05 23:39:56

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

Modified Files:
	misc.c 
Log Message:
time(union wait *) -> time(int *), K&R->ANSI

Index: misc.c
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/misc.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** misc.c	5 Aug 2004 23:13:56 -0000	1.4
--- misc.c	5 Aug 2004 23:39:47 -0000	1.5
***************
*** 35,38 ****
--- 35,39 ----
  #endif
  
+ #define Object SchemeObject	/* avoid Obj-C type clash */
  #ifdef HAVE_FOOELK_SCHEME_H
  #include <fooelk/scheme.h>
***************
*** 40,43 ****
--- 41,45 ----
  #include <elk/scheme.h>
  #endif
+ #undef Object
  
  #ifdef HAVE_SYS_TIME_H
***************
*** 83,87 ****
  
  
! static Object P_Time()
  {
    struct timeval t;
--- 85,90 ----
  
  
! static SchemeObject
! P_Time ()
  {
    struct timeval t;
***************
*** 93,185 ****
  
  
! static Object P_Getpid()
  {
!     return Make_Integer(getpid());
  }
  
  
! static Object P_System (cmd) Object cmd; {
!     register char *s;
!     register int i, n, pid;
!     union wait status;
  
!     s = Get_String(cmd);
  #ifdef VFORK
!     switch (pid = vfork ()) {
  #else
!     switch (pid = fork ()) {
  #endif
      case -1:
! /* where is extern errno defined ?
! 	Saved_Errno = errno;
! 	Primitive_Error ("cannot fork: ~E");
! */
! 	Primitive_Error ("cannot fork");
      case 0:
! 	n = Open_Max ();
! 	for (i = 3; i < n; i++)
! 	    (void)close (i);
! 	execl ("/bin/sh", "sh", "-c", s, (char *)0);
! 	_exit (127);
      default:
! 	Disable_Interrupts;
! 	while ((i = wait (&status)) != pid && i != -1)
! 		;
! 	Enable_Interrupts;
      }
!     if (i == -1)
! 	return False;
!     if ((n = (status.w_status & 0377)))
! 	return Cons (Make_Fixnum (n), Null);
!     return Make_Fixnum ((status.w_status >> 8) & 0377);
  }
  
  
! static Object P_Getenv (e) Object e; {
!     register char *s;
!     Object ret;
  
!     s = Get_String(e);
!     ret = (s = getenv (s)) ? Make_String (s, strlen (s)) : False;
  
!     return ret;
  }
  
  
! static Object P_Getwd () {
!     char buffer[PATH_MAX + 1];
!     if (getcwd(buffer, PATH_MAX) == NULL)
! 	return False;
!     else
! 	return Make_String(buffer, strlen(buffer));
  }
  
  
! static Object P_Num_Sprintf (form, num) Object form; Object num; {
!     char buffer[1024];
!     char *f;
!     Object ret;
!     
!     f = Get_String(form);
!     switch (TYPE(num)) {
!         case T_Fixnum:
! 	    sprintf(buffer, f, FIXNUM(num));
! 	    break;
! 	case T_Bignum:
! 	    sprintf(buffer, f, Bignum_To_Long(num));
! 	    break;
! 	case T_Flonum:
! 	    sprintf(buffer, f, Get_Double(num));
! 	    break;
! 	default:
! 	    Primitive_Error("illegal type - expected number");
      }
!     ret = Make_String(buffer, strlen (buffer));
  
!     return ret;
  }
  
  
! void elk_init_misc()
  {
    /* "seconds" was formerly known as "time" */
--- 96,218 ----
  
  
! static SchemeObject
! P_Getpid ()
  {
!   return Make_Integer(getpid());
  }
  
  
! static SchemeObject
! P_System (SchemeObject cmd)
! {
!   register char *s;
!   register int i, n, pid;
!   int status;
  
!   s = Get_String(cmd);
  #ifdef VFORK
!   switch (pid = vfork ())
  #else
!   switch (pid = fork ())
  #endif
+     {
      case -1:
!       /* where is extern errno defined ?
! 	 Saved_Errno = errno;
! 	 Primitive_Error ("cannot fork: ~E");
!       */
!       Primitive_Error ("cannot fork");
! 
      case 0:
!       n = Open_Max ();
!       for (i = 3; i < n; i++)
! 	{
! 	  (void)close (i);
! 	}
!       execl ("/bin/sh", "sh", "-c", s, (char *)0);
!       _exit (127);
! 
      default:
!       Disable_Interrupts;
!       while ((i = wait(&status)) != pid && i != -1)
! 	{
! 	  ;
! 	}
!       Enable_Interrupts;
      }
!   if (i == -1)
!     {
!       return False;
!     }
!   if ((n = (status.w_status & 0377)))
!     {
!       return Cons (Make_Fixnum (n), Null);
!     }
!   return Make_Fixnum ((status.w_status >> 8) & 0377);
  }
  
  
! static SchemeObject
! P_Getenv (SchemeObject e)
! {
!   register char *s;
!   SchemeObject ret;
  
!   s = Get_String(e);
!   ret = (s = getenv (s)) ? Make_String (s, strlen (s)) : False;
  
!   return ret;
  }
  
  
! static SchemeObject
! P_Getwd ()
! {
!   char buffer[PATH_MAX + 1];
!   if (getcwd(buffer, PATH_MAX) == NULL)
!     {
!       return False;
!     }
!   else
!     {
!       return Make_String(buffer, strlen(buffer));
!     }
  }
  
  
! static SchemeObject
! P_Num_Sprintf (SchemeObject form,
! 	       SchemeObject num)
! {
!   char buffer[1024];
!   char *f;
!   SchemeObject ret;
! 
!   f = Get_String(form);
!   switch (TYPE(num))
!     {
!     case T_Fixnum:
!       sprintf(buffer, f, FIXNUM(num));
!       break;
! 
!     case T_Bignum:
!       sprintf(buffer, f, Bignum_To_Long(num));
!       break;
! 
!     case T_Flonum:
!       sprintf(buffer, f, Get_Double(num));
!       break;
! 
!     default:
!       Primitive_Error("illegal type - expected number");
      }
!   ret = Make_String(buffer, strlen (buffer));
  
!   return ret;
  }
  
  
! void
! elk_init_misc ()
  {
    /* "seconds" was formerly known as "time" */

[foo-cvs] foo/elkfoo/src tell.m,1.5,1.6

From: Martin R. <ru...@us...> - 2004-08-05 23:32:17

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

Modified Files:
	tell.m 
Log Message:
fixed runtime dependent ifdefs


Index: tell.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/tell.m,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** tell.m	5 Aug 2004 23:29:46 -0000	1.5
--- tell.m	5 Aug 2004 23:32:08 -0000	1.6
***************
*** 542,548 ****
    id obj = nil;		// idem
  #ifdef NeXT_RUNTIME
!   Method meth,
  #elif GNU_RUNTIME
!     Method_t meth,
  #else
  #error *** NEITHER NeXT NOR GNU RUNTIME PRESENT ***
--- 542,548 ----
    id obj = nil;		// idem
  #ifdef NeXT_RUNTIME
!   Method meth;
  #elif GNU_RUNTIME
!   Method_t meth;
  #else
  #error *** NEITHER NeXT NOR GNU RUNTIME PRESENT ***
***************
*** 662,668 ****
    id obj = nil;				// idem
  #ifdef NeXT_RUNTIME
!   Method meth,
  #elif GNU_RUNTIME
!     Method_t meth,
  #else
  #error *** NEITHER NeXT NOR GNU RUNTIME PRESENT ***
--- 662,668 ----
    id obj = nil;				// idem
  #ifdef NeXT_RUNTIME
!   Method meth;
  #elif GNU_RUNTIME
!   Method_t meth;
  #else
  #error *** NEITHER NeXT NOR GNU RUNTIME PRESENT ***

[foo-cvs] foo/elkfoo/src tell.m,1.4,1.5

From: Martin R. <ru...@us...> - 2004-08-05 23:29:55

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

Modified Files:
	tell.m 
Log Message:
OSX fix: Method_t -> Method

Index: tell.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/tell.m,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** tell.m	5 Aug 2004 23:26:48 -0000	1.4
--- tell.m	5 Aug 2004 23:29:46 -0000	1.5
***************
*** 201,205 ****
--- 201,211 ----
  Objc_Send (id obj,
  	   SEL sel,
+ #ifdef NeXT_RUNTIME
+ 	   Method meth,
+ #elif GNU_RUNTIME
  	   Method_t meth,
+ #else
+ #error *** NEITHER NeXT NOR GNU RUNTIME PRESENT ***
+ #endif
  	   int argc,
  	   SchemeObject *argv)
***************
*** 535,539 ****
    SEL sel = @selector(name);	// to make compiler shut up
    id obj = nil;		// idem
!   Method_t meth;
    //     Alloca_Begin;
    GC_Node2;
--- 541,551 ----
    SEL sel = @selector(name);	// to make compiler shut up
    id obj = nil;		// idem
! #ifdef NeXT_RUNTIME
!   Method meth,
! #elif GNU_RUNTIME
!     Method_t meth,
! #else
! #error *** NEITHER NeXT NOR GNU RUNTIME PRESENT ***
! #endif
    //     Alloca_Begin;
    GC_Node2;
***************
*** 649,653 ****
    SEL sel = @selector(name);			// make compiler shut up
    id obj = nil;				// idem
!   Method_t meth;
    //     Alloca_Begin;
      
--- 661,671 ----
    SEL sel = @selector(name);			// make compiler shut up
    id obj = nil;				// idem
! #ifdef NeXT_RUNTIME
!   Method meth,
! #elif GNU_RUNTIME
!     Method_t meth,
! #else
! #error *** NEITHER NeXT NOR GNU RUNTIME PRESENT ***
! #endif
    //     Alloca_Begin;

[foo-cvs] foo/elkfoo/src tell.m,1.3,1.4

From: Martin R. <ru...@us...> - 2004-08-05 23:26:57

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

Modified Files:
	tell.m 
Log Message:
modern times arriving: removed K&R syntax in favor for ANSI

Index: tell.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/tell.m,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** tell.m	5 Aug 2004 23:13:56 -0000	1.3
--- tell.m	5 Aug 2004 23:26:48 -0000	1.4
***************
*** 64,177 ****
  #define SKIP_BODY(p, c) while (*p != c) if (!*p) goto format_error; else p++;
  
! static int Convert_Type(type)
! char *type;
  {
!     int t;
  
!     switch (*type++) {
!       case '\0':	return 0;
!       case _C_ID:	return C_ID;
[...1345 lines suppressed...]
!     }
  }
  
***************
*** 752,758 ****
  void elk_init_tell()
  {
!     Define_Primitive(P_Tell, "tell", 2, MANY, VARARGS);
!     Define_Primitive(P_Types, "types", 2, 2, EVAL);
!     Define_Primitive(P_Selector, "selector", 1, 1, EVAL);
!     P_Provide(Intern("tell"));
  }
--- 773,779 ----
  void elk_init_tell()
  {
!   Define_Primitive(P_Tell, "tell", 2, MANY, VARARGS);
!   Define_Primitive(P_Types, "types", 2, 2, EVAL);
!   Define_Primitive(P_Selector, "selector", 1, 1, EVAL);
!   P_Provide(Intern("tell"));
  }

[foo-cvs] foo/elkfoo configure.ac,1.5,1.6

From: Martin R. <ru...@us...> - 2004-08-05 23:15:43

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

Modified Files:
	configure.ac 
Log Message:
check for time.h and sys/time.h rather than timeb.h (gettimeofday related)

Index: configure.ac
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/configure.ac,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** configure.ac	5 Aug 2004 22:21:21 -0000	1.5
--- configure.ac	5 Aug 2004 23:15:35 -0000	1.6
***************
*** 41,45 ****
  AC_STDC_HEADERS
  AC_HEADER_SYS_WAIT
! AC_CHECK_HEADERS([limits.h stdlib.h string.h strings.h sys/param.h sys/timeb.h unistd.h signal.h])
  
  # Checks for library functions.
--- 41,45 ----
  AC_STDC_HEADERS
  AC_HEADER_SYS_WAIT
! AC_CHECK_HEADERS([limits.h stdlib.h string.h strings.h sys/param.h sys/time.h time.h unistd.h signal.h])
  
  # Checks for library functions.

[foo-cvs] foo/elkfoo/include elkfoo.h,1.1,1.2

From: Martin R. <ru...@us...> - 2004-08-05 23:15:02

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

Modified Files:
	elkfoo.h 
Log Message:
added include 

Index: elkfoo.h
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/include/elkfoo.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** elkfoo.h	5 Aug 2004 18:57:41 -0000	1.1
--- elkfoo.h	5 Aug 2004 23:14:53 -0000	1.2
***************
*** 1,2 ****
--- 1,4 ----
+ /* -*-Mode:objc-*- */
+ 
  /*
   * elkfoo.h
***************
*** 36,39 ****
--- 38,43 ----
  #define FOO_ELKFOO_H_INCLUDED
  
+ #include <FOO/FOOObject.h>
+ 
  /*
   * bpf

Flat | Threaded

<< < 1 .. 16 17 18 19 20 21 > >> (Page 18 of 21)