[PD-cvs] externals/k_guile global.scm,1.2,1.3 k_guile.c,1.2,1.3 local.scm,1.2,1.3
ksvalast at users.sourceforge.net
ksvalast at users.sourceforge.net
Wed Jan 21 09:56:15 CET 2004
Update of /cvsroot/pure-data/externals/k_guile
In directory sc8-pr-cvs1:/tmp/cvs-serv27488
Modified Files:
global.scm k_guile.c local.scm
Log Message:
Clean-up before 0.0.2
Index: global.scm
===================================================================
RCS file: /cvsroot/pure-data/externals/k_guile/global.scm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** global.scm 12 Jan 2004 13:10:17 -0000 1.2
--- global.scm 21 Jan 2004 08:56:12 -0000 1.3
***************
*** 28,31 ****
--- 28,32 ----
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Misc. functions
***************
*** 135,138 ****
--- 136,143 ----
;;
;;
+
+ (define (pd-backtrace-eval string)
+ (eval-string string))
+
(define (pd-display-errorfunc key . args)
(let ((dasstack (make-stack #t)))
***************
*** 150,153 ****
--- 155,164 ----
pd-display-errorfunc))
+ (define (pd-backtrace-runx func arg1)
+ (stack-catch #t
+ (lambda x
+ (apply func x))
+ pd-display-errorfunc))
+
(define (pd-backtrace-run1 func arg1)
(stack-catch #t
***************
*** 174,178 ****
pd-display-errorfunc))
-
(pd-backtrace-run1 pd-load-if-exists "/etc/.k_guile.scm")
(pd-backtrace-run1 pd-load-if-exists (string-append (getenv "HOME") "/.k_guile.scm"))
--- 185,189 ----
pd-display-errorfunc))
(pd-backtrace-run1 pd-load-if-exists "/etc/.k_guile.scm")
(pd-backtrace-run1 pd-load-if-exists (string-append (getenv "HOME") "/.k_guile.scm"))
+
Index: k_guile.c
===================================================================
RCS file: /cvsroot/pure-data/externals/k_guile/k_guile.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** k_guile.c 12 Jan 2004 13:25:12 -0000 1.2
--- k_guile.c 21 Jan 2004 08:56:12 -0000 1.3
***************
*** 32,36 ****
#define MAKE_STRING(a) scm_mem2string(a,strlen(a))
#define EVAL(a) scm_eval_string(MAKE_STRING(a))
- #define EVALINT(a) do{char tempstring[500];sprintf(tempstring,"%d",a);EVAL(tempstring);}while(0)
#define MAKE_SYM(a) gensym(SCM_SYMBOL_CHARS(a))
--- 32,35 ----
***************
*** 92,100 ****
static char *version =
! "k_guile v0.0.1, written by Kjetil S. Matheussen, k.s.matheussen at notam02.no";
static t_class *k_guile_class, *k_guile_workaroundclass;
static SCM pd_backtrace_run;
static SCM pd_backtrace_run1;
static SCM pd_backtrace_run2;
--- 91,100 ----
static char *version =
! "k_guile v0.0.2, written by Kjetil S. Matheussen, k.s.matheussen at notam02.no";
static t_class *k_guile_class, *k_guile_workaroundclass;
static SCM pd_backtrace_run;
+ static SCM pd_backtrace_runx;
static SCM pd_backtrace_run1;
static SCM pd_backtrace_run2;
***************
*** 216,231 ****
*****************************************************************************************************/
- static SCM gpd_set_inlet_func(SCM instance,SCM func){
- t_k_guile *x=GET_X(instance);
- x->inlet_func=func;
- scm_gc_protect_object(x->inlet_func);
- RU_;
- }
- static SCM gpd_set_cleanup_func(SCM instance,SCM func){
- t_k_guile *x=GET_X(instance);
- x->cleanup_func=func;
- scm_gc_protect_object(x->cleanup_func);
- RU_;
- }
static SCM gpd_inlets(SCM instance,SCM num_ins){
int lokke;
--- 216,219 ----
***************
*** 281,284 ****
--- 269,273 ----
+
/*****************************************************************************************************
*****************************************************************************************************
***************
*** 442,447 ****
scm_c_define_gsubr("pd-c-get-num-inlets",1,0,0,gpd_get_num_inlets);
scm_c_define_gsubr("pd-c-get-num-outlets",1,0,0,gpd_get_num_outlets);
- scm_c_define_gsubr("pd-c-set-inlet-func",2,0,0,gpd_set_inlet_func);
- scm_c_define_gsubr("pd-c-set-cleanup-func",2,0,0,gpd_set_cleanup_func);
scm_c_define_gsubr("pd-c-bind",2,0,0,gpd_bind);
scm_c_define_gsubr("pd-c-unbind",2,0,0,gpd_unbind);
--- 431,434 ----
***************
*** 463,466 ****
--- 450,456 ----
scm_permanent_object(pd_backtrace_run);
+ pd_backtrace_runx=EVAL("pd-backtrace-runx");
+ scm_permanent_object(pd_backtrace_runx);
+
pd_backtrace_run1=EVAL("pd-backtrace-run1");
scm_permanent_object(pd_backtrace_run1);
***************
*** 489,493 ****
static bool k_guile_load(t_k_guile *x,char *filename){
! bool ret=true;
FILE *file=fopen(filename,"r");
--- 479,484 ----
static bool k_guile_load(t_k_guile *x,char *filename){
! SCM evalret;
! bool ret=false;
FILE *file=fopen(filename,"r");
***************
*** 498,502 ****
! // Let the file live in its own name-space, or something like that.
eval2("(define (pd-instance-func pd-instance)");
eval2(
--- 489,493 ----
! // Let the file live in its own name-space (or something like that).
eval2("(define (pd-instance-func pd-instance)");
eval2(
***************
*** 504,519 ****
);
eval_file(file);
! eval2(" (pd-set-inlet-func)(pd-set-cleanup-func))");
eval2("1");
! if(
! 1!=GET_INTEGER(eval_do())
! || 1!=GET_INTEGER(scm_call_2(pd_backtrace_run1,EVAL("pd-instance-func"),MAKE_POINTER(x)))
! )
! {
! post("Failed.");
! ret=false;
! }
fclose(file);
--- 495,519 ----
);
eval_file(file);
! eval2(" (cons pd-inlet-func pd-cleanup-func))");
eval2("1");
! if(1!=GET_INTEGER(eval_do())){
! post("Failed.");
! goto exit;
! }
+ evalret=scm_call_2(pd_backtrace_run1,EVAL("pd-instance-func"),MAKE_POINTER(x));
+ if(INTEGER_P(evalret)){
+ post("Failed.");
+ goto exit;
+ }
+ x->inlet_func=SCM_CAR(evalret);
+ x->cleanup_func=SCM_CDR(evalret);
+ scm_gc_protect_object(x->inlet_func);
+ scm_gc_protect_object(x->cleanup_func);
+
+ ret=true;
+
+ exit:
fclose(file);
***************
*** 568,571 ****
--- 568,572 ----
+
/*****************************************************************************************************
*****************************************************************************************************
***************
*** 582,587 ****
class_addanything(k_guile_class, (t_method)k_guile_anything_first);
class_addmethod(k_guile_class, (t_method)k_guile_reload, gensym("reload"), 0);
! class_addmethod(k_guile_class, (t_method)k_guile_eval, gensym("eval"), A_DEFSYM, 0);
! //class_addmethod(k_guile_class, (t_method)k_guile_evalfile, gensym("evalfile"), A_DEFSYM, 0);
class_sethelpsymbol(k_guile_class, gensym("help-k_guile.pd"));
--- 583,588 ----
class_addanything(k_guile_class, (t_method)k_guile_anything_first);
class_addmethod(k_guile_class, (t_method)k_guile_reload, gensym("reload"), 0);
! class_addmethod(k_guile_class, (t_method)k_guile_eval, gensym("eval"), A_DEFSYM,0);
! //class_addmethod(k_guile_class, (t_method)k_guile_evalfile, gensym("evalfile"), A_DEFSYM,0);
class_sethelpsymbol(k_guile_class, gensym("help-k_guile.pd"));
Index: local.scm
===================================================================
RCS file: /cvsroot/pure-data/externals/k_guile/local.scm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** local.scm 16 Jan 2004 15:07:14 -0000 1.2
--- local.scm 21 Jan 2004 08:56:12 -0000 1.3
***************
*** 59,77 ****
(define pd-inlet-anyvector (make-vector 1 '()))
! (define (pd-set-inlet-func)
! (pd-c-set-inlet-func pd-instance
! ;; This function is called from the C side when the object receives something on an inlet.
! (lambda (inlet-num symbol args)
! (let ((inlet-func (assq symbol
! (vector-ref pd-inlet-vector
! inlet-num))))
! (if (not inlet-func)
! (begin
! (set! inlet-func (assq 'any
! (vector-ref pd-inlet-vector inlet-num)))
! (set! args (cons symbol args))))
! (if inlet-func
! (apply (cadr inlet-func) args)
! (pd-display "No function defined for handling \'" symbol " to inlet " inlet-num))))))
(define (pd-inlet inlet-num symbol func)
--- 59,75 ----
(define pd-inlet-anyvector (make-vector 1 '()))
! ;; This function is called from the C side when the object receives something on an inlet.
! (define (pd-inlet-func inlet-num symbol args)
! (let ((inlet-func (assq symbol
! (vector-ref pd-inlet-vector
! inlet-num))))
! (if (not inlet-func)
! (begin
! (set! inlet-func (assq 'any
! (vector-ref pd-inlet-vector inlet-num)))
! (set! args (cons symbol args))))
! (if inlet-func
! (apply (cadr inlet-func) args)
! (pd-display "No function defined for handling \'" symbol " to inlet " inlet-num))))
(define (pd-inlet inlet-num symbol func)
***************
*** 146,150 ****
(set! pd-local-bindings (pd-unbind-do symbol pd-local-bindings)))
!
--- 144,152 ----
(set! pd-local-bindings (pd-unbind-do symbol pd-local-bindings)))
! (define (pd-unbind-all)
! (if (not (null? pd-local-bindings))
! (begin
! (pd-unbind (car (car pd-local-bindings)))
! (pd-unbind-all))))
***************
*** 159,176 ****
(set! pd-destroy-func thunk)))
! (define (pd-cleanup)
(if pd-destroy-func
(begin
(pd-destroy-func)
(set! pd-destroy-func #f)))
! (if (not (null? pd-local-bindings))
! (begin
! (pd-unbind (car (car pd-local-bindings)))
! (pd-cleanup))))
!
! ;; This one also returns the return-value for the pd-instance-func function, which is 1 for success.
! (define (pd-set-cleanup-func)
! (pd-c-set-cleanup-func pd-instance
! pd-cleanup)
! 1)
--- 161,170 ----
(set! pd-destroy-func thunk)))
! ;; This func is called from the C-side.
! (define (pd-cleanup-func)
(if pd-destroy-func
(begin
(pd-destroy-func)
(set! pd-destroy-func #f)))
! (pd-unbind-all))
More information about the Pd-cvs
mailing list