diff --git a/src/include/script.h b/src/include/script.h index 0572ee0c0..c723dd89d 100644 --- a/src/include/script.h +++ b/src/include/script.h @@ -119,6 +119,7 @@ extern int CclInConfigFile; /// True while config file parsing ----------------------------------------------------------------------------*/ extern void CclGcProtect(SCM obj); /// Protect scm object for GC +extern void CclGcUnprotect(SCM obj); /// Unprotect scm object for GC extern void InitCcl(void); /// Initialise ccl extern void LoadCcl(void); /// Load ccl config file extern void SaveCcl(FILE* file); /// Save CCL module diff --git a/src/stratagus/script.cpp b/src/stratagus/script.cpp index b02a8da76..cf72b4fc0 100644 --- a/src/stratagus/script.cpp +++ b/src/stratagus/script.cpp @@ -96,6 +96,34 @@ global void CclGcProtect(SCM obj) setvar(var,cons(obj,symbol_value(var,NIL)),NIL); } +/** +** Remove a SCM object from garbage collectors protection list. +** +** @param obj Scheme object +*/ +global void CclGcUnprotect(SCM obj) +{ + // Remove obj from the list *ccl-protect* + SCM sym; + SCM old_lst; + SCM new_lst; + + sym = gh_symbol2scm("*ccl-protect*"); + old_lst = symbol_value(sym, NIL); + new_lst = NIL; + + while( !gh_null_p(old_lst) ) { + SCM el = gh_car(old_lst); + + if (el != obj) + new_lst = cons(el, new_lst); + + old_lst = gh_cdr(old_lst); + } + + setvar(sym, new_lst, NIL); +} + /*............................................................................ .. Config ............................................................................*/