Changeset 14026

Timestamp:

Jul 23, 2010, 1:11:03 PM (9 years ago)

Author:

gb

Message:

About 7 years late: use the current (GC) thread's binding of *PACKAGE*
for GCTWA, not the static binding.

File:

• branches/arm/lisp-kernel/arm-gc.c (modified) (9 diffs)

branches/arm/lisp-kernel/arm-gc.c

@@ -174 +174 @@
 
 
-
+LispObj
+code_vector_from_pc(LispObj *pcloc)
+{
+  /* Scan forward from pcloc until we find a 0 word (marking the start
+     of a constant pool or the empty constant pool at the end of the
+     code vector.  The word following the 0 contains the offset of that
+     word from the code-vector header. */
+  while (*pcloc) {
+    pcloc++;
+  }
+  pcloc -= *pcloc;
+  return (LispObj)pcloc+fulltag_misc;
+}
 
 
@@ -328 +340 @@
     if ((dnode < GCndnodes_in_area) &&
         !ref_bit(GCmarkbits,dnode)) {
-      LispObj
-        *headerP,
-        header;
-
-      for(headerP = (LispObj*)(pc);
-          gc_area_dnode(headerP) < GCndnodes_in_area;
-          headerP++) {
-        header = *headerP;
-        if (header == 0) {      /* start of constant pool or end of function */
-          headerP++;
-          headerP -=  *headerP;
-          header = *headerP;
-          if (header_subtag(header) == subtag_code_vector) {
-            set_n_bits(GCmarkbits, dnode, (2+header_element_count(header))>>1);
-            return;
-          }
-          break;
-        }
-      }
-      /*
-        Expected to have found a header by now, but didn't.
-        That's a bug.
-        */
-      Bug(NULL, "code_vector header not found!");
+      mark_root(code_vector_from_pc((LispObj *)pc));
     }
   }
@@ -1487 +1476 @@
 
 
-
+  
 
       
@@ -1619 +1608 @@
     loc = *locaddr,
     *headerP;
-  opcode
-    *p,
-    insn;
   natural
     tag = fulltag_of(loc);
@@ -1632 +1618 @@
     case fulltag_even_fixnum:
     case fulltag_odd_fixnum:
-      if (*headerP == forward_marker) {
-        *locaddr = (headerP[1]+tag);
-      } else {
-        /* Grovel backwards until the header's found; copy
-           the code vector to to space, then treat it as if it 
-           hasn't already been copied. */
-        p = (opcode *)headerP;
-        do {
-          p += 1;
-          insn = *p;
-        } while (insn);
-        p++;
-        p -= *p;
-        Bug(NULL, "funky code in purfiy_locref()");
-        *locaddr = purify_displaced_object(ptr_to_lispobj(p), to, tag);
-      }
+      if (*headerP != forward_marker) {
+        LispObj code_vector = code_vector_from_pc(headerP);
+        
+        copy_ivector_reference(&code_vector, low, high, to);
+      }
+      *locaddr = (headerP[1]+tag);
       break;
     }
@@ -1900 +1876 @@
   
   switch (fulltag_of(q)) {
-#ifdef PPC64
-  case fulltag_cons:
-#endif
   case fulltag_misc:
   case fulltag_even_fixnum:
@@ -2004 +1977 @@
       if (!nodeheader_tag_p(tag)) {
         impurify_noderef(start, low, high, delta);
+      }
+      start++;
+      if (header_subtag(header) == subtag_function) {
+        LispObj entrypt = *start;
+        if ((entrypt > (LispObj)low) && 
+            (entrypt < (LispObj)high) &&
+            (fulltag_of(entrypt) == fulltag_odd_fixnum)) {
+          *start = untag(entrypt) + fulltag_misc;
+          impurify_noderef(start, low, high, delta);
+          *start = untag(*start)+fulltag_odd_fixnum;
+        } else {
+          impurify_noderef(start, low, high, delta);
         }
-      start++;
-      impurify_noderef(start, low, high, delta);
-      start++;
+        start++;
+      }
     }
   }
@@ -2104 +2088 @@
     BytePtr ro_base = r->low, ro_limit = r->active, oldfree = a->active,
       oldhigh = a->high, newhigh; 
-    unsigned n = ro_limit - ro_base;
-    int delta = oldfree-ro_base;
+    natural n = ro_limit - ro_base;
+    signed_natural delta = oldfree-ro_base;
     TCR *other_tcr;
 
@@ -2117 +2101 @@
       a->active += n;
       memmove(oldfree, ro_base, n);
-      munmap(ro_base, n);
+      UnCommitMemory(ro_base, n);
       a->ndnodes = area_dnode(a, a->active);
       pure_space_active = r->active = r->low;