From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Fri, 10 Oct 2014 23:57:02 +0000 (-0700)
Subject: svm: Fix continue_from_trap.
X-Git-Tag: mit-scheme-pucked-9.2.12~398^2~1
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e6df3e1210719a3578f0172a94b181d873257f10;p=mit-scheme.git

svm: Fix continue_from_trap.

Signal handlers always find an unknown pc when the svm interpreter is
running.  This patch extracts the virtual machine's instruction
pointer for classify_pc in the hope that the compiled code block can
be located.
---

diff --git a/src/microcode/cmpintmd/svm1.h b/src/microcode/cmpintmd/svm1.h
index 021a67555..e26254208 100644
--- a/src/microcode/cmpintmd/svm1.h
+++ b/src/microcode/cmpintmd/svm1.h
@@ -93,5 +93,6 @@ extern long C_to_interface (void *);
 extern void initialize_svm1 (void);
 extern insn_t * read_uuo_target (SCHEME_OBJECT *);
 extern unsigned int read_u16 (insn_t *);
+extern unsigned long svm_export_instruction_pointer (unsigned long pc);
 
 #endif /* !SCM_CMPINTMD_H_INCLUDED */
diff --git a/src/microcode/svm1-interp.c b/src/microcode/svm1-interp.c
index 7a87732de..08bf0eb80 100644
--- a/src/microcode/svm1-interp.c
+++ b/src/microcode/svm1-interp.c
@@ -212,20 +212,43 @@ initialize_svm1 (void)
   SET_VAL ((SCHEME_OBJECT) (WREG_REF (SVM1_REG_VALUE)));		\
 } while (0)
 
+/* Only true when the virtual machine is running, e.g. while Free is
+   cached in word_registers[].  In a signal handler, the virtual
+   instruction that trapped is at instruction_pointer. */
+static bool running_p = false;
+static insn_t * instruction_pointer;
+
 long
 C_to_interface (void * address)
 {
-  insn_t * PC = (insn_t *)address;
+  instruction_pointer = (insn_t *)address;
   IMPORT_REGS ();
-  while (predict_true (PC))
+  running_p = true;
+  while (predict_true (instruction_pointer))
     {
-      byte_t opcode = *PC++;
-      PC = (* (inst_defns[opcode])) (PC);
+      byte_t opcode = *instruction_pointer;
+      instruction_pointer = (* (inst_defns[opcode])) (instruction_pointer+1);
     }
   EXPORT_REGS ();
+  running_p = false;
   return (svm1_result);
 }
 
+/* For signal/trap handlers. */
+unsigned long
+svm_export_instruction_pointer (unsigned long pc)
+{
+  if (running_p)
+    {
+      EXPORT_REGS ();
+      return ((unsigned long)instruction_pointer);
+    }
+  else
+    {
+      return (pc);
+    }
+}
+
 static byte_t *
 illegal_instruction (byte_t * PC)
 {
@@ -848,10 +871,12 @@ illegal_trap_3 (byte_t * PC, wreg_t r1, wreg_t r2, wreg_t r3)
 
 #define TRAP_PREFIX(result)						\
   utility_result_t result;						\
-  EXPORT_REGS ()
+  EXPORT_REGS ();							\
+  running_p = false
 
 #define TRAP_SUFFIX(result)						\
   IMPORT_REGS ();							\
+  running_p = true;							\
   if ((result).scheme_p)						\
     {									\
       NEW_PC ((result).arg.new_pc);					\
diff --git a/src/microcode/uxtrap.c b/src/microcode/uxtrap.c
index 6e7db83ba..a2ac2936e 100644
--- a/src/microcode/uxtrap.c
+++ b/src/microcode/uxtrap.c
@@ -353,6 +353,9 @@ continue_from_trap (int signo, SIGINFO_T info, SIGCONTEXT_T * scp)
 #ifdef PC_VALUE_MASK
   pc &= PC_VALUE_MASK;
 #endif
+#ifdef CC_IS_SVM
+  pc = svm_export_instruction_pointer (pc);
+#endif
 
   /* Choose new SP and encode location data.  */
   switch (classify_pc (pc, (&block_addr), (&index)))
@@ -366,8 +369,15 @@ continue_from_trap (int signo, SIGINFO_T info, SIGCONTEXT_T * scp)
     case pcl_heap:
     case pcl_constant:
 #ifdef CC_SUPPORT_P
+
+#  ifdef CC_IS_SVM
+      new_sp = stack_pointer;
+      /* Free already set by svm_export_instruction_pointer. */
+#  else
       new_sp = ((SCHEME_OBJECT *) (SIGCONTEXT_SCHSP (scp)));
       Free = ((SCHEME_OBJECT *) (SIGCONTEXT_RFREE (scp)));
+#  endif
+
       SET_RECOVERY_INFO
 	(STATE_COMPILED_CODE,
 	 (MAKE_CC_BLOCK (block_addr)),