Changeset 15784 for release/1.9/source/lisp-kernel/x86-gc.c

Timestamp:

Mar 24, 2013, 4:34:32 AM (8 years ago)

Author:

gb

Message:

propagate r15783 to 1.9

File:

• release/1.9/source/lisp-kernel/x86-gc.c (modified) (2 diffs)

release/1.9/source/lisp-kernel/x86-gc.c

@@ -195 +195 @@
 
 
-
+void
+check_readonly_range(LispObj *start, LispObj *end)
+{
+  LispObj node, *current = start, *prev = NULL, *next, fn;
+  int tag, subtag;
+  natural elements;
+  area *a;
+  area_code code;
+
+  while (current < end) {
+    prev = current;
+    node = *current++;
+    tag = fulltag_of(node);
+    if (immheader_tag_p(tag)) {
+      current = (LispObj *)skip_over_ivector((natural)prev, node);
+    } else {
+      if (nodeheader_tag_p(tag)) {
+        next = current+(header_element_count(node)|1);
+      } else {
+        next = current+1;
+      }
+      subtag = header_subtag(node);
+      if (subtag != subtag_function) {
+        Bug(NULL, "Found 0x" LISP " in readonly area at 0x" LISP ", expected ivector or function header", node, (LispObj)current);
+      } else {
+        elements = header_element_count(node);
+        {
+#ifdef X8632
+          int skip = *(unsigned short *)current;
+          
+          fn = (LispObj)(current-1)+fulltag_misc;
+          /* XXX bootstrapping */
+          if (skip & 0x8000)
+            skip = elements - (skip & 0x7fff);
+#else
+          int skip = *(int *)current;
+          fn = (LispObj)(current-1)+fulltag_function;
+#endif
+          current += skip;
+          elements -= skip;
+        }
+        while (elements--) {
+          node = *current;
+          if (is_node_fulltag(fulltag_of(node))) {
+            a = area_containing((BytePtr)node);
+            if (a) {
+              code = a->code;
+            } else {
+              a = AREA_VOID;
+            }
+            switch (code) {
+            case AREA_READONLY:
+            case AREA_MANAGED_STATIC:
+            case AREA_STATIC:
+              break;
+            default:
+              Bug(NULL, "Bad constant reference from purified function 0x" LISP " to 0x" LISP ".", fn, node);
+            }
+          }
+          current++;
+        }
+      }
+      current = next;
+    }
+  }
+  if (current != end) {
+    Bug(NULL, "Overran end of memory range: start = 0x" LISP ", end = 0x" LISP ", prev = 0x" LISP ", current = 0x" LISP "",
+        start, end, prev, current);
+  }
+}
 
 
@@ -345 +414 @@
       check_range((LispObj *)a->low, (LispObj *)a->active, true);
       break;
+
+    case AREA_READONLY:
+      check_readonly_range((LispObj *)a->low, (LispObj *)a->active);
+      true;
 
     case AREA_VSTACK: