--- a/ObjectMemory.st	Wed Sep 30 15:13:43 2015 +0200
+++ b/ObjectMemory.st	Wed Sep 30 19:35:28 2015 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 1992 by Claus Gittinger
 	      All Rights Reserved
@@ -1853,6 +1855,49 @@
     ^ nil
 !
 
+preventTenureOf:anObject
+    "set the age of anObject to the never-tenure special age. 
+     This prevents the object from ever going out of the new space,
+     and if used without care may lead to a filling of th newspace to a point,
+     where the system becomes inoperable.
+     Therefore it should only be used in very special situations.
+     One such situation may be to ensure that an object is finalized early by the next
+     scavenge, and not by a (possibly late) old space collect.
+     To undo this setup (i.e. to allow the object to tenure again), set its age back to
+     any value with the seatAgeOf:to: message.
+     If the object is already old, this call has no effect.
+     WARNING: this method is for ST/X experts only
+              it is dangerous, should be used with care
+              and it may be removed without notice"
+
+%{  /* NOCONTEXT */
+#ifndef __SCHTEAM__
+    if (__isNonNilObject(anObject)) {
+        _SET_AGE(anObject, NO_TENURE_AGE);
+    }    
+#endif
+%}
+    "
+    |p|
+    p := Point new.
+    Transcript showCR:(ObjectMemory preventTenureOf:p).
+    ObjectMemory tenuringScavenge.
+    Transcript showCR:(ObjectMemory ageOf:p).
+    ObjectMemory tenure.
+    Transcript showCR:(ObjectMemory ageOf:p).
+    ObjectMemory tenure.
+    ObjectMemory tenure.
+    ObjectMemory tenure.
+    Transcript showCR:(ObjectMemory ageOf:p).
+    ObjectMemory setAgeOf:p to:30.
+    Transcript showCR:(ObjectMemory ageOf:p).
+    ObjectMemory tenure.
+    Transcript showCR:(ObjectMemory ageOf:p).
+    ObjectMemory tenure.
+    Transcript showCR:(ObjectMemory ageOf:p).
+    "
+!
+
 printReferences:anObject
     "for debugging: print referents to anObject.
      WARNING: this method is for ST/X debugging only
@@ -2004,6 +2049,43 @@
     "Modified: / 4.2.1998 / 22:03:36 / cg"
 !
 
+setAgeOf:anObject to:newAge
+    "change the age of anObject. 
+     This counts the number of scavenges that an object has survived in new space.
+     For old space objects, this is a no-op.
+     WARNING: this method is for ST/X debugging only
+              it may be removed without notice"
+
+%{  /* NOCONTEXT */
+#ifndef __SCHTEAM__
+    if (__isNonNilObject(anObject) && __isSmallInteger(newAge)) {
+        int age = __intVal(newAge);
+
+        if (age < 0) age = 0;
+        else if (age > AGE_MAX) age = AGE_MAX;
+        _SET_AGE(anObject, age);
+    }    
+#endif
+%}
+    "
+    |p|
+    p := Point new.
+    Transcript showCR:(ObjectMemory ageOf:p).
+    ObjectMemory tenuringScavenge.
+    Transcript showCR:(ObjectMemory ageOf:p).
+    ObjectMemory tenuringScavenge.
+    Transcript showCR:(ObjectMemory ageOf:p).
+    ObjectMemory tenuringScavenge.
+    Transcript showCR:(ObjectMemory ageOf:p).
+    ObjectMemory tenuringScavenge.
+    Transcript showCR:(ObjectMemory ageOf:p).
+    ObjectMemory setAgeOf:p to:0.
+    Transcript showCR:(ObjectMemory ageOf:p).
+    ObjectMemory tenuringScavenge.
+    Transcript showCR:(ObjectMemory ageOf:p).
+    "
+!
+
 sizeOf:anObject
     "return the size of anObject in bytes.
      (this is not the same as 'anObject size').
@@ -5834,11 +5916,11 @@
 !ObjectMemory class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.287 2015-05-24 12:52:28 cg Exp $'
+    ^ '$Header$'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.287 2015-05-24 12:52:28 cg Exp $'
+    ^ '$Header$'
 !
 
 version_SVN