[Openmcl-cvs-notifications] r10100 - /trunk/source/lisp-kernel/lisp-debug.c

[rme at clozure.com]

Author: rme
Date: Fri Jul 18 15:47:31 2008
New Revision: 10100

Log:
Additions for Darwin/x8632.

Modified:
    trunk/source/lisp-kernel/lisp-debug.c

Modified: trunk/source/lisp-kernel/lisp-debug.c
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lisp-kernel/lisp-debug.c (original)
+++ trunk/source/lisp-kernel/lisp-debug.c Fri Jul 18 15:47:31 2008
@@ -146,6 +146,29 @@
 #endif
 #endif
 =

+#ifdef X8632
+#ifdef DARWIN
+char *Iregnames[] =3D {"eax", "ebx", "ecx", "edx", "edi", "esi",
+		     "ebp", "???", "efl", "eip"};
+#endif
+#endif
+
+#ifdef X8632
+int bit_for_regnum(int r)
+{
+  switch (r) {
+  case REG_EAX: return 1<<0;
+  case REG_ECX: return 1<<1;
+  case REG_EDX: return 1<<2;
+  case REG_EBX: return 1<<3;
+  case REG_ESP: return 1<<4;
+  case REG_EBP: return 1<<5;
+  case REG_ESI: return 1<<6;
+  case REG_EDI: return 1<<7;
+  }
+}
+#endif
+
 void
 show_lisp_register(ExceptionInformation *xp, char *label, int r)
 {
@@ -155,8 +178,21 @@
 #ifdef PPC
   fprintf(stderr, "r%02d (%s) =3D %s\n", r, label, print_lisp_object(val));
 #endif
-#ifdef X86
+#ifdef X8664
   fprintf(stderr, "%%%s (%s) =3D %s\n",Iregnames[r], label, print_lisp_obj=
ect(val));
+#endif
+#ifdef X8632
+  {
+    TCR *tcr =3D get_tcr(false);
+    char *s;
+
+    if (tcr && (tcr->node_regs_mask & bit_for_regnum(r)) =3D=3D 0)
+      s =3D "marked as unboxed";
+    else
+      s =3D print_lisp_object(val);
+
+    fprintf(stderr, "%%%s (%s) =3D %s\n", Iregnames[r], label, s);
+  }
 #endif
 =

 }
@@ -431,6 +467,21 @@
     }
 #endif
   }
+
+#ifdef X8632
+  show_lisp_register(xp, "arg_z", Iarg_z);
+  show_lisp_register(xp, "arg_y", Iarg_y);
+  fprintf(stderr,"------\n");
+  show_lisp_register(xp, "fn", Ifn);
+  fprintf(stderr,"------\n");
+  show_lisp_register(xp, "temp0", Itemp0);
+  show_lisp_register(xp, "temp1", Itemp1);
+  fprintf(stderr,"------\n");
+  if (tag_of(xpGPR(xp,Inargs)) =3D=3D tag_fixnum) {
+    fprintf(stderr,"%%edx (nargs) =3D %d (maybe)\n", unbox_fixnum(xpGPR(xp=
,Inargs)));
+  }
+#endif
+  =

   return debug_continue;
 }
 =

@@ -629,6 +680,20 @@
   fprintf(stderr,"%%rip =3D 0x%016lX   %%rflags =3D 0x%016lX\n",
 	  xpGPR(xp, Iip), xpGPR(xp, Iflags));
 #endif
+
+#ifdef X8632
+  fprintf(stderr, "%%eax =3D 0x%08X\n", xpGPR(xp, REG_EAX));
+  fprintf(stderr, "%%ecx =3D 0x%08X\n", xpGPR(xp, REG_ECX));
+  fprintf(stderr, "%%edx =3D 0x%08X\n", xpGPR(xp, REG_EDX));
+  fprintf(stderr, "%%ebx =3D 0x%08X\n", xpGPR(xp, REG_EBX));
+  fprintf(stderr, "%%esp =3D 0x%08X\n", xpGPR(xp, REG_ESP));
+  fprintf(stderr, "%%ebp =3D 0x%08X\n", xpGPR(xp, REG_EBP));
+  fprintf(stderr, "%%esi =3D 0x%08X\n", xpGPR(xp, REG_ESI));
+  fprintf(stderr, "%%edi =3D 0x%08X\n", xpGPR(xp, REG_EDI));
+  fprintf(stderr, "%%eip =3D 0x%08X\n", xpGPR(xp, REG_EIP));
+  fprintf(stderr, "%%eflags =3D 0x%08X\n", xpGPR(xp, REG_EFL));
+#endif
+
   return debug_continue;
 }
 =

@@ -695,6 +760,24 @@
 #endif
           );
 #endif  =

+#ifdef X8632
+#ifdef DARWIN
+  struct xmm {
+    char fpdata[8];
+  };
+  struct xmm *xmmp =3D (struct xmm *)(xpFPRvector(xp));
+
+  for (i =3D 0; i < 8; i++, xmmp++) {
+    float *sp =3D (float *)xmmp;
+    dp =3D (double *)xmmp;
+    np =3D (int *)xmmp;
+    fprintf(stderr, "f%1d: 0x%08x (%e), 0x%08x%08x (%e)\n", i, *np,
+	    (double)(*sp), np[1], np[0], *dp);
+  }
+  fprintf(stderr, "mxcsr =3D 0x%08x\n", UC_MCONTEXT(xp)->__fs.__fpu_mxcsr);
+#endif
+#endif
+
   return debug_continue;
 }
 =

@@ -941,6 +1024,21 @@
   if (lisp_global(BATCH_FLAG)) {
     abort();
   }
+#ifdef DARWIN
+#ifdef X8664
+  if (xp) {
+    extern void *_sigtramp();
+    extern int os_major_version;
+
+    if (xpPC(xp) =3D=3D (natural)_sigtramp) {
+      xp =3D (ExceptionInformation *) xpGPR(xp, REG_R8);
+      fprintf(stderr, "Exception raised at _sigtramp; using context passed=
 to _sigtramp.  Raw register values (R) may be more interesting then lisp v=
alues or lisp backtrace\n");
+    }
+  }
+#endif
+#endif
+
+
   if (xp) {
     if (why > debug_entry_exception) {
       debug_identify_exception(xp, info, why);