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

rme at clozure.com rme at clozure.com
Tue Jun 1 18:03:19 UTC 2010


Author: rme
Date: Tue Jun  1 12:03:19 2010
New Revision: 13765

Log:
Kernel debugger command "M" to show lisp memory areas.

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 Tue Jun  1 12:03:19 2010
@@ -504,6 +504,41 @@
 }
 #endif
 =

+char *
+area_code_name(int code)
+{
+  switch (code) {
+    case AREA_VOID: return "void";
+    case AREA_CSTACK: return "cstack";
+    case AREA_VSTACK: return "vstack";
+    case AREA_TSTACK: return "tstack";
+    case AREA_READONLY: return "readonly";
+    case AREA_WATCHED: return "watched";
+    case AREA_STATIC_CONS: return "static cons";
+    case AREA_MANAGED_STATIC: return "managed static";
+    case AREA_STATIC: return "static";
+    case AREA_DYNAMIC: return "dynamic";
+    default: return "unknown";
+  }
+}
+
+debug_command_return
+debug_memory_areas(ExceptionInformation *xp, siginfo_t *info, int arg)
+{
+  int i;
+  area *a, *header =3D all_areas;
+  char label[100];
+
+  fprintf(dbgout, "Lisp memory areas:\n");
+  fprintf(dbgout, "%20s %20s %20s\n", "code", "low", "high");
+  for (a =3D header->succ; a !=3D header; a =3D a->succ) {
+    snprintf(label, sizeof(label), "%s (%d)", area_code_name(a->code),
+	     a->code >> fixnumshift);
+    fprintf(dbgout, "%20s %20p %20p\n", label, a->low, a->high);
+  }
+  return debug_continue;
+}
+
 debug_command_return
 debug_lisp_registers(ExceptionInformation *xp, siginfo_t *info, int arg)
 {
@@ -1035,6 +1070,11 @@
    0,
    NULL,
    'T'},
+  {debug_memory_areas,
+   "Show memory areas",
+   0,
+   NULL,
+   'M'},
   {debug_win,
    "Exit from this debugger, asserting that any exception was handled",
    0,
@@ -1250,7 +1290,6 @@
   vsnprintf(s, sizeof(s),format, args);
   va_end(args);
   lisp_Debugger(xp, NULL, debug_entry_bug, true, s);
-
 }
 =

 void



More information about the Openmcl-cvs-notifications mailing list