From 0214c5a8483858d0dd89e74bf31ffcd043c65f92 Mon Sep 17 00:00:00 2001 From: "Kjetil S. Matheussen" Date: Wed, 21 Jan 2004 08:56:12 +0000 Subject: Clean-up before 0.0.2 svn path=/trunk/externals/k_guile/; revision=1276 --- global.scm | 13 ++++++++++++- k_guile.c | 59 ++++++++++++++++++++++++++++++----------------------------- local.scm | 48 +++++++++++++++++++++--------------------------- 3 files changed, 63 insertions(+), 57 deletions(-) diff --git a/global.scm b/global.scm index 334e04e..7fe7ecc 100644 --- a/global.scm +++ b/global.scm @@ -27,6 +27,7 @@ (use-modules (ice-9 stack-catch)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Misc. functions ;; @@ -134,6 +135,10 @@ ;; Backtrace (does not work properly) ;; ;; + +(define (pd-backtrace-eval string) + (eval-string string)) + (define (pd-display-errorfunc key . args) (let ((dasstack (make-stack #t))) (display-backtrace dasstack (current-output-port) #f #f) @@ -149,6 +154,12 @@ thunk 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 (lambda () @@ -173,6 +184,6 @@ (func arg1 arg2 arg3 arg4)) 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")) + diff --git a/k_guile.c b/k_guile.c index 4e01f3b..82212b9 100644 --- a/k_guile.c +++ b/k_guile.c @@ -31,7 +31,6 @@ #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)) @@ -91,11 +90,12 @@ typedef struct k_guile_workaround{ static char *version = -"k_guile v0.0.1, written by Kjetil S. Matheussen, k.s.matheussen@notam02.no"; +"k_guile v0.0.2, written by Kjetil S. Matheussen, k.s.matheussen@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; static SCM pd_backtrace_run3; @@ -215,18 +215,6 @@ static void k_guile_anything_first(t_k_guile *x,t_symbol *s, t_int argc, t_atom* ***************************************************************************************************** *****************************************************************************************************/ -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; t_k_guile *x=GET_X(instance); @@ -280,6 +268,7 @@ static SCM gpd_get_num_outlets(SCM instance){ } + /***************************************************************************************************** ***************************************************************************************************** * Binding and unbinding. Called from the guile side. @@ -441,8 +430,6 @@ static void k_guile_init(void){ scm_c_define_gsubr("pd-c-inited?",1,0,0,gpd_inited_p); 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); scm_c_define_gsubr("pd-c-outlet-number",3,0,0,gpd_outlet_number); @@ -462,6 +449,9 @@ static void k_guile_init(void){ pd_backtrace_run=EVAL("pd-backtrace-run"); 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); @@ -488,7 +478,8 @@ static void k_guile_init(void){ *****************************************************************************************************/ static bool k_guile_load(t_k_guile *x,char *filename){ - bool ret=true; + SCM evalret; + bool ret=false; FILE *file=fopen(filename,"r"); if(file==NULL){ @@ -497,24 +488,33 @@ static bool k_guile_load(t_k_guile *x,char *filename){ } - // Let the file live in its own name-space, or something like that. + // Let the file live in its own name-space (or something like that). eval2("(define (pd-instance-func pd-instance)"); eval2( #include "local_scm.txt" ); eval_file(file); - eval2(" (pd-set-inlet-func)(pd-set-cleanup-func))"); + eval2(" (cons pd-inlet-func pd-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; - } + 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); return ret; @@ -567,6 +567,7 @@ static void k_guile_eval(t_k_guile *x,t_symbol *s){ //} + /***************************************************************************************************** ***************************************************************************************************** * Das setup @@ -581,8 +582,8 @@ void k_guile_setup(void){ 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_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")); diff --git a/local.scm b/local.scm index 31e107b..65546b2 100644 --- a/local.scm +++ b/local.scm @@ -58,21 +58,19 @@ (define pd-inlet-vector (make-vector 1 '())) (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)))))) +;; 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) (if (not (procedure? func)) @@ -145,7 +143,11 @@ (define (pd-unbind symbol) (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)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -158,19 +160,11 @@ (pd-display "Wrong argument to pd-set-destroy-func: " thunk " is not a procedure.") (set! pd-destroy-func thunk))) -(define (pd-cleanup) +;; 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))) - (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) + (pd-unbind-all)) -- cgit v1.2.1