Hi all, The attached patch fixes the problem from subject, as described here: http://lists.nongnu.org/archive/html/chicken-users/2014-03/msg00088.html
It also cleans up the code a little bit by re-using well-named C functions instead of repeating the same inline and C preprocessor-heavy checks which required comments to make sense of them. Felix has provided feedback on this patch, and it has been tested by Pluijzer. Cheers, Peter -- http://www.more-magic.net
>From 7110da9beb8e6ada2a070dc07acdeadd3df8ad4e Mon Sep 17 00:00:00 2001 From: Peter Bex <peter....@xs4all.nl> Date: Mon, 17 Mar 2014 21:30:39 +0100 Subject: [PATCH] Don't fire finalizers on compiled, non-GCable constants (reported by "Pluijzer") --- NEWS | 3 +++ manual/Acknowledgements | 38 +++++++++++++++++++------------------- runtime.c | 45 +++++++++++++++++---------------------------- tests/runtests.bat | 4 ++++ tests/runtests.sh | 2 ++ tests/test-finalizers.scm | 15 +++++++++++++++ 6 files changed, 60 insertions(+), 47 deletions(-) diff --git a/NEWS b/NEWS index e967a15..b7120df 100644 --- a/NEWS +++ b/NEWS @@ -24,6 +24,9 @@ - Runtime system - The procedure trace buffer has been made resizable. - C_zap_strings and ##sys#zap-strings (undocumented) have been deprecated. + - finalizers on constants are ignored in compiled code because compiled + constants are never GCed (before, the finalizer would be incorrectly + invoked after the first GC). (Reported by "Pluijzer") - Tools - csc: "-z origin" is now passed as a linker option on FreeBSD when diff --git a/manual/Acknowledgements b/manual/Acknowledgements index cbf9d5f..14283c2 100644 --- a/manual/Acknowledgements +++ b/manual/Acknowledgements @@ -35,25 +35,25 @@ Eric Merrit, Perry Metzger, Scott G. Miller, Mikael, Karel Miklav, Bruce Mitchener, Fadi Moukayed, Chris Moline, Eric E. Moore, Julian Morrison, Dan Muresan, David N. Murray, Timo Myyrä, "nicktick", Lars Nilsson, Ian Oversby, "o.t.", Gene Pavlovsky, Levi Pearson, Jeronimo -Pellegrini, Nicolas Pelletier, Derrell Piper, Carlos Pita, Robin Lee -Powell, Alan Post, "Pupeno", Davide Puricelli, "presto", Doug Quale, -Imran Rafique, Eric Raible, Ivan Raikov, Santosh Rajan, Joel Reymont, -"rivo", Chris Roberts, Eric Rochester, Paul Romanchenko, Andreas -Rottman, David Rush, Lars Rustemeier, Daniel Sadilek, Otavio Salvador, -Burton Samograd, "Sandro", "satori", Aleksej Saushev, Oskar Schirmer, -Reed Sheridan, Ronald Schröder, Spencer Schumann, Ivan Shcheklein, -Alex Shinn, Ivan Shmakov, "Shmul", Tony Sidaway, Jeffrey B. Siegal, -Andrey Sidorenko, Michele Simionato, Iruata Souza, Volker Stolz, Jon -Strait, Dorai Sitaram, Robert Skeels, Jason Songhurst, Clifford Stein, -David Steiner, Sunnan, Zbigniew Szadkowski, Rick Taube, Nathan Thern, -Mike Thomas, Minh Thu, Christian Tismer, Andre van Tonder, John Tobey, -Henrik Tramberend, Vladimir Tsichevsky, James Ursetto, Neil van Dyke, -Sam Varner, Taylor Venable, Sander Vesik, Jaques Vidrine, Panagiotis -Vossos, Shawn Wagner, Peter Wang, Ed Watkeys, Brad Watson, Thomas -Weidner, Göran Weinholt, Matthew Welland, Drake Wilson, Jörg -Wittenberger, Peter Wright, Mark Wutka, Adam Young, Richard Zidlicky, -Houman Zolfaghari and Florian Zumbiehl for bug-fixes, tips and -suggestions. +Pellegrini, Nicolas Pelletier, Derrell Piper, Carlos Pita, "Pluijzer", +Robin Lee Powell, Alan Post, "Pupeno", Davide Puricelli, "presto", +Doug Quale, Imran Rafique, Eric Raible, Ivan Raikov, Santosh Rajan, +Joel Reymont, "rivo", Chris Roberts, Eric Rochester, Paul Romanchenko, +Andreas Rottman, David Rush, Lars Rustemeier, Daniel Sadilek, Otavio +Salvador, Burton Samograd, "Sandro", "satori", Aleksej Saushev, Oskar +Schirmer, Reed Sheridan, Ronald Schröder, Spencer Schumann, Ivan +Shcheklein, Alex Shinn, Ivan Shmakov, "Shmul", Tony Sidaway, Jeffrey +B. Siegal, Andrey Sidorenko, Michele Simionato, Iruata Souza, Volker +Stolz, Jon Strait, Dorai Sitaram, Robert Skeels, Jason Songhurst, +Clifford Stein, David Steiner, Sunnan, Zbigniew Szadkowski, Rick +Taube, Nathan Thern, Mike Thomas, Minh Thu, Christian Tismer, Andre +van Tonder, John Tobey, Henrik Tramberend, Vladimir Tsichevsky, James +Ursetto, Neil van Dyke, Sam Varner, Taylor Venable, Sander Vesik, +Jaques Vidrine, Panagiotis Vossos, Shawn Wagner, Peter Wang, Ed +Watkeys, Brad Watson, Thomas Weidner, Göran Weinholt, Matthew Welland, +Drake Wilson, Jörg Wittenberger, Peter Wright, Mark Wutka, Adam Young, +Richard Zidlicky, Houman Zolfaghari and Florian Zumbiehl for +bug-fixes, tips and suggestions. Special thanks to Brandon van Every for contributing the (now defunct) [[http://www.cmake.org|CMake]] support and for helping with Windows diff --git a/runtime.c b/runtime.c index fdbc4d0..35dcf2b 100644 --- a/runtime.c +++ b/runtime.c @@ -497,6 +497,7 @@ static void C_fcall really_mark(C_word *x) C_regparm; static WEAK_TABLE_ENTRY *C_fcall lookup_weak_table_entry(C_word item, C_word container) C_regparm; static C_ccall void values_continuation(C_word c, C_word closure, C_word dummy, ...) C_noret; static C_word add_symbol(C_word **ptr, C_word key, C_word string, C_SYMBOL_TABLE *stable); +static C_regparm int C_fcall C_in_new_heapp(C_word x); static C_word C_fcall hash_string(int len, C_char *str, C_word m, C_word r, int ci) C_regparm; static C_word C_fcall lookup(C_word key, int len, C_char *str, C_SYMBOL_TABLE *stable) C_regparm; static double compute_symbol_table_load(double *avg_bucket_len, int *total); @@ -2289,6 +2290,12 @@ C_regparm int C_fcall C_in_heapp(C_word x) (ptr >= tospace_start && ptr < tospace_limit); } +/* Only used during major GC (heap realloc) */ +static C_regparm int C_fcall C_in_new_heapp(C_word x) +{ + C_byte *ptr = (C_byte *)(C_uword)x; + return (ptr >= new_tospace_start && ptr < new_tospace_limit); +} C_regparm int C_fcall C_in_fromspacep(C_word x) { @@ -3129,26 +3136,17 @@ C_regparm void C_fcall really_mark(C_word *x) val = *x; - p = (C_SCHEME_BLOCK *)val; - - /* not in stack and not in heap? */ - if ( -#if C_STACK_GROWS_DOWNWARD - p < (C_SCHEME_BLOCK *)C_stack_pointer || p >= (C_SCHEME_BLOCK *)stack_bottom -#else - p >= (C_SCHEME_BLOCK *)C_stack_pointer || p < (C_SCHEME_BLOCK *)stack_bottom -#endif - ) - if((p < (C_SCHEME_BLOCK *)fromspace_start || p >= (C_SCHEME_BLOCK *)C_fromspace_limit) && - (p < (C_SCHEME_BLOCK *)tospace_start || p >= (C_SCHEME_BLOCK *)tospace_limit) ) { + if (!C_in_stackp(val) && !C_in_heapp(val)) { #ifdef C_GC_HOOKS if(C_gc_trace_hook != NULL) C_gc_trace_hook(x, gc_mode); #endif return; - } + } + p = (C_SCHEME_BLOCK *)val; + h = p->header; if(gc_mode == GC_MINOR) { @@ -3473,27 +3471,17 @@ C_regparm void C_fcall really_remark(C_word *x) val = *x; - p = (C_SCHEME_BLOCK *)val; - - /* not in stack and not in heap? */ - if( -#if C_STACK_GROWS_DOWNWARD - p < (C_SCHEME_BLOCK *)C_stack_pointer || p >= (C_SCHEME_BLOCK *)stack_bottom -#else - p >= (C_SCHEME_BLOCK *)C_stack_pointer || p < (C_SCHEME_BLOCK *)stack_bottom -#endif - ) - if((p < (C_SCHEME_BLOCK *)fromspace_start || p >= (C_SCHEME_BLOCK *)C_fromspace_limit) && - (p < (C_SCHEME_BLOCK *)tospace_start || p >= (C_SCHEME_BLOCK *)tospace_limit) && - (p < (C_SCHEME_BLOCK *)new_tospace_start || p >= (C_SCHEME_BLOCK *)new_tospace_limit) ) { + if (!C_in_stackp(val) && !C_in_heapp(val) && !C_in_new_heapp(val)) { #ifdef C_GC_HOOKS if(C_gc_trace_hook != NULL) C_gc_trace_hook(x, gc_mode); #endif return; - } + } + p = (C_SCHEME_BLOCK *)val; + h = p->header; if(is_fptr(h)) { @@ -8282,7 +8270,8 @@ void C_ccall C_software_version(C_word c, C_word closure, C_word k) void C_ccall C_register_finalizer(C_word c, C_word closure, C_word k, C_word x, C_word proc) { - if(C_immediatep(x)) C_kontinue(k, x); + if(C_immediatep(x) || (!C_in_stackp(x) && !C_in_heapp(x))) /* not GCable? */ + C_kontinue(k, x); C_do_register_finalizer(x, proc); C_kontinue(k, x); diff --git a/tests/runtests.bat b/tests/runtests.bat index a33d1b7..03e7684 100644 --- a/tests/runtests.bat +++ b/tests/runtests.bat @@ -432,6 +432,10 @@ rem if errorlevel 1 exit /b 1 echo ======================================== finalizer tests ... %interpret% -s test-finalizers.scm if errorlevel 1 exit /b 1 +%compile% test-finalizers.scm +if errorlevel 1 exit /b 1 +a.out +if errorlevel 1 exit /b 1 echo ======================================== finalizer tests (2) ... %compile% finalizer-error-test.scm diff --git a/tests/runtests.sh b/tests/runtests.sh index 6ea1730..8d98cc2 100755 --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -366,6 +366,8 @@ $compile symbolgc-tests.scm echo "======================================== finalizer tests ..." $interpret -s test-finalizers.scm +$compile test-finalizers.scm +./a.out $compile finalizer-error-test.scm echo "expect an error message here:" ./a.out -:hg101 diff --git a/tests/test-finalizers.scm b/tests/test-finalizers.scm index 6ff33e1..320a097 100644 --- a/tests/test-finalizers.scm +++ b/tests/test-finalizers.scm @@ -1,5 +1,7 @@ ;;;; test-finalizers.scm +(use extras) + (##sys#eval-debug-level 0) ; disable keeping trace-buffer with frameinfo (define x (list 1 2 3)) @@ -63,3 +65,16 @@ a fix that unfortunately disables finalizers in the interpreter (gc #t) (print n) (assert (= 2 n)) + +;; Finalizers on constants are ignored in compiled mode (because +;; they're never GCed). Reported by "Pluijzer". + +(set! n 0) +(define bar "constant string") +(set-finalizer! bar bump) +(set! bar #f) +(gc #t) +(print n) +(cond-expand + (compiling (assert (= 0 n))) + (else (assert (= 1 n)))) -- 1.7.10.4
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
