From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Tue, 12 Sep 2017 02:03:29 +0000 (-0700)
Subject: ffi: Set last_return_code.  Restore prev_restore_history_offset?
X-Git-Tag: mit-scheme-pucked-9.2.12~73
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=56cb74c55a32fee30172f963e99681ccc3c0fbf6;p=mit-scheme.git

ffi: Set last_return_code.  Restore prev_restore_history_offset?
---

diff --git a/src/microcode/pruxffi.c b/src/microcode/pruxffi.c
index 72a4674d2..c87b73277 100644
--- a/src/microcode/pruxffi.c
+++ b/src/microcode/pruxffi.c
@@ -578,6 +578,7 @@ callback_run_kernel (long callback_id, CallbackKernel kernel)
   /* Used by callback trampolines after saving the callback args on
      the CStack. */
   SCM * saved_stack_pointer, * saved_last_return_code;
+  unsigned long saved_prev_restore_history_offset;
   unsigned long nargs = GET_LEXPR_ACTUALS;
 
   if (run_callback == SHARP_F)
@@ -608,8 +609,9 @@ callback_run_kernel (long callback_id, CallbackKernel kernel)
   SET_EXP (c_call_continue);
   SAVE_CONT ();
 
-  saved_last_return_code = last_return_code;
   saved_stack_pointer = stack_pointer;
+  saved_last_return_code = last_return_code;
+  saved_prev_restore_history_offset = prev_restore_history_offset;
  Will_Push ((2 * CONTINUATION_SIZE) + STACK_ENV_EXTRA_SLOTS + 1);
   SET_RC (RC_END_OF_COMPUTATION);
   SET_EXP (run_callback);
@@ -620,7 +622,8 @@ callback_run_kernel (long callback_id, CallbackKernel kernel)
   SET_EXP (run_callback);
   SAVE_CONT ();
  Pushed ();
-  SET_EXP (SHARP_F);		/* fall through to pop_return */
+  last_return_code = stack_pointer;
+  SET_EXP (SHARP_F);
   Re_Enter_Interpreter ();
 
   if (stack_pointer != saved_stack_pointer
@@ -631,11 +634,21 @@ callback_run_kernel (long callback_id, CallbackKernel kernel)
       || ((STACK_REF (3)) != c_call_continue)
 #endif
       )
-    signal_error_from_primitive (ERR_STACK_HAS_SLIPPED);
-    /*NOTREACHED*/
+    {
+      SET_PRIMITIVE (c_call_continue);
+      SET_LEXPR_ACTUALS (0);
+      outf_error_line ("\nWarning: stack slipped in callback.");
+      signal_error_from_primitive (ERR_STACK_HAS_SLIPPED);
+      /*NOTREACHED*/
+    }
 
-  last_return_code = saved_last_return_code;
   stack_pointer = STACK_LOC (4);
+  last_return_code = saved_last_return_code;
+  if (prev_restore_history_offset != saved_prev_restore_history_offset)
+    {
+      outf_error_line ("Warning: restoring prev_restore_history_offset.");
+      prev_restore_history_offset = saved_prev_restore_history_offset;
+    }
   SET_PRIMITIVE (c_call_continue);
   SET_LEXPR_ACTUALS (nargs);