CORE: Try to avoid calling into Scheme after exit. (#366)

This disables log-trace on newer gambit when deadlock-exceptions are encountered as otherwise they get stuck in an infinite loop. However, this should reduce some of the other problems with  ___cleanup() when we encounter segfaults.

Author: 0-8-15

languages/scm.c

@@ -29,6 +29,7 @@ int debug_settings = ___DEBUG_SETTINGS_INITIAL;
 
 void system_init();
 
+static int lambdanative_exit_call_count = -1;  /* System running when 0 */
 void lambdanative_payload_setup()
 {
   DMSG("lambdanative_payload_setup [scm]");
@@ -39,6 +40,7 @@ void lambdanative_payload_setup()
   debug_settings = (debug_settings & ~___DEBUG_SETTINGS_REPL_MASK) |
   (___DEBUG_SETTINGS_REPL_STDIO << ___DEBUG_SETTINGS_REPL_SHIFT);
   setup_params.debug_settings = debug_settings;
+  lambdanative_exit_call_count = 0;
   ___setup(&setup_params);
   #if defined(ANDROID)
     #if (___VERSION < 409002)
@@ -52,7 +54,7 @@ void lambdanative_payload_setup()
 void lambdanative_payload_cleanup()
 {
   DMSG("lambdanative_payload_cleanup [scm]");
-  ___cleanup();
+  if(lambdanative_exit_call_count++==0) ___cleanup();
 }
 
 #ifndef STANDALONE
@@ -61,7 +63,7 @@ void scm_event(int,int,int);
 
 void lambdanative_payload_event(int t, int x, int y)
 {
-  scm_event(t,x,y);
+  if( lambdanative_exit_call_count == 0 ) scm_event(t,x,y);
 }
 #endif
 

loaders/hook/hook.c

@@ -64,7 +64,7 @@ void ffi_event(int t, int x, int y)
   } 
   FFI_EVENT_LOCK
   if (!lambdanative_needsinit&&t) lambdanative_payload_event(t,x,y);
-  if (t==EVENT_TERMINATE) { lambdanative_payload_cleanup(); exit(0); }
+  if (t==EVENT_TERMINATE) { lambdanative_exit(0); }
   FFI_EVENT_UNLOCK
 }
 #endif // STANDALONE

modules/config/config.scm

@@ -47,8 +47,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 void force_terminate()
 {
-  ___cleanup();
-  exit(0);
+  lambdanative_exit(0);
 }
 
 end-of-c-declare

modules/ln_core/log.scm

@@ -1,6 +1,6 @@
 #|
 LambdaNative - a cross-platform Scheme framework
-Copyright (c) 2009-2013, University of British Columbia
+Copyright (c) 2009-2020, University of British Columbia
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or
@@ -150,10 +150,17 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
     (string-mapconcat (reverse tmp) ": ")))
 
 (define (log:exception-handler e)
-  (log-error (thread-name (current-thread)) ": " (exception->string e))
-  (log-trace (current-thread))
-  (log-error "HALT")
-  (exit))
+  (log-error "Thread \"" (thread-name (current-thread)) "\": " (exception->string e))
+  (cond-expand
+    (gambit-c (log-trace (current-thread)))
+    (else
+      (unless (deadlock-exception? e)
+        ;; gambit ___cleanup(); re-enters with a deadlock-exception here
+        ;; while printing the trace
+        (log-trace (current-thread)))
+    ))
+  (log-error "HALT pid " ((c-lambda () int "getpid")))
+  (exit 70))
 
 ;; catch primordial thread exceptions
 (current-exception-handler log:exception-handler)
@@ -174,7 +181,4 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 (log-system "Application " (system-appname) " built " (system-builddatetime))
 (log-system "Git hash " (system-buildhash))
 
-
-
-
 ;; eof