ObjMem.st
changeset 326 d2902942491d
parent 325 46bca6125b93
child 329 f14fc5ac11b7
--- a/ObjMem.st	Sun Apr 02 13:07:58 1995 +0200
+++ b/ObjMem.st	Tue Apr 11 16:52:00 1995 +0200
@@ -33,7 +33,7 @@
 COPYRIGHT (c) 1992 by Claus Gittinger
 	     All Rights Reserved
 
-$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.35 1995-04-02 11:07:09 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.36 1995-04-11 14:50:21 claus Exp $
 '!
 
 !ObjectMemory class methodsFor:'documentation'!
@@ -54,7 +54,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.35 1995-04-02 11:07:09 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.36 1995-04-11 14:50:21 claus Exp $
 "
 !
 
@@ -413,8 +413,6 @@
     "initialize the class"
 
     AllocationFailureSignal isNil ifTrue:[
-	ErrorSignal isNil ifTrue:[super initialize].
-
 	AllocationFailureSignal := ErrorSignal newSignalMayProceed:true.
 	AllocationFailureSignal nameClass:self message:#allocationFailureSignal.
 	AllocationFailureSignal notifierString:'allocation failure'.
@@ -561,7 +559,7 @@
     |work|
 
 %{  /* NOREGISTER - work may not be placed into a register here */
-    nonTenuringScavenge(__context);
+    __nonTenuringScavenge(__context);
     /*
      * allObjectsDo needs a temporary to hold newSpace objects
      */
@@ -927,15 +925,15 @@
 
 runsSingleOldSpace
     "return true, if the system runs in a single oldSpace or
-     false, if it has given up baker-collection. The memory
-     system will always drop the second semispace when running out of
-     virtual memory, or the baker-limit is reached.
+     false if not.
+     The memory system will always drop the second semispace when 
+     running out of virtual memory, or the baker-limit is reached.
      OBSOLETE: 
 	 the system may now decide at any time to switch between
 	 single and double-space algorithms, depending on the overall memory
 	 size. You will now almost always get false as result, since the
-	 second semispaces are only allocated when needed, and released
-	 afterwards.
+	 second semispace is only allocated when needed, and released
+	 immediately afterwards.
     "
 
 %{  /* NOCONTEXT */
@@ -951,7 +949,11 @@
 incrementalGCPhase
     "returns the internal state of the incremental GC.
      The meaning of those numbers is a secret :-).
-     This is for debugging and monitoring only - and may vanish"
+     (for the curious: (currently)
+      2 is idle, 3..11 are various mark phases,
+      12 is the sweep phase. 0 and 1 are cleanup phases when the
+      incr. GC gets interrupted by a full GC).
+     This is for debugging and monitoring only - and may change or vanish"
 
 %{  /* NOCONTEXT */
     extern int __incrGCphase();
@@ -1002,7 +1004,7 @@
 numberOfObjects
     "return the number of objects in the system."
 
-    |tally|
+    |tally "{ Class: SmallInteger }"|
 
     tally := 0.
     self allObjectsDo:[:obj | tally := tally + 1].
@@ -1086,7 +1088,10 @@
     if (! _isNonNilObject(anObject)) {
 	RETURN ( nil );
     }
-    RETURN ( _MKSMALLINT( (int)anObject ) );
+    if (((int)anObject >= _MIN_INT) && ((int)anObject <= _MAX_INT)) {
+	RETURN ( _MKSMALLINT((int)anObject) );
+    }
+    RETURN ( _MKLARGEINT((int)anObject) );
 %}
     "
     |p|
@@ -1100,9 +1105,9 @@
 objectAt:anAddress
     "return whatever anAddress points to as object.
      BIG BIG DANGER ALERT: 
-	this method is only to be used for debugging
-	ST/X itself - you can easily (and badly) crash the system.
-     This method will be removed from the final shipping version"
+	this method is only to be used for debugging ST/X itself 
+	- you can easily (and badly) crash the system.
+     This method may be removed from the final shipping version"
 
     |low high|
 
@@ -1117,6 +1122,7 @@
 
 sizeOf:anObject
     "return the size of anObject in bytes.
+     (this is not the same as 'anObject size').
      Use only for debugging/memory monitoring."
 
 %{  /* NOCONTEXT */
@@ -1143,8 +1149,8 @@
 
 spaceOf:anObject
     "return the memory space, in which anObject is.
-     - since objects may move between spaces, returned value is invalid after the
-     next scavenge/collect.
+     - since objects may move between spaces, 
+       the returned value may be invalid after the next scavenge/collect.
      For debugging only; Dont use this method; it may vanish."
 
 %{  /* NOCONTEXT */
@@ -1173,12 +1179,20 @@
 F_ISONLIFOLIST  8       /* a non-lifo-context-referencing-obj already on list */
 F_MARK          16      /* mark bit for background collector */
     "
+
+    "
+     |arr|
+
+     arr := Array new.
+     arr at:1 put:([thisContext] value).
+     (ObjectMemory flagsOf:anObject) printNL
+    "
 !
 
 ageOf:anObject
     "return the number of scavenges, an object has survived
-     in new space. For old objects and living contexts, the returned number 
-     is invalid.
+     in new space. 
+     For old objects and living contexts, the returned number is invalid.
      For debugging only; Dont use this method; it may vanish."
 
 %{  /* NOCONTEXT */
@@ -1230,7 +1244,7 @@
      Of course, only recently allocated resources will be freed this
      way. If none was freed, a full collect will be needed."
 %{
-    nonTenuringScavenge(__context);
+    __nonTenuringScavenge(__context);
 %}
 
     "
@@ -1245,7 +1259,7 @@
      this automatically when the newspace fills up.
      This is relatively fast (compared to oldspace collect)"
 %{
-    scavenge(__context);
+    __scavenge(__context);
 %}
 
     "
@@ -1267,7 +1281,7 @@
      the oldspace).
      In normal situations, explicit tenures are not needed."
 %{
-    tenure(__context);
+    __tenure(__context);
 %}
 
     "
@@ -1290,7 +1304,7 @@
      the -Msingle option, this does a non-COMPRESSING collect."
 %{
     if (! __garbageCollect(__context)) {
-	markAndSweep(__context);
+	__markAndSweep(__context);
     }
 %}
 
@@ -1318,7 +1332,7 @@
      perform a full mark&sweep collect.
      Warning: this may take some time."
 %{
-    markAndSweep(__context);
+    __markAndSweep(__context);
 %}
 
     "
@@ -1821,7 +1835,7 @@
 allShadowObjectsDo:aBlock
     "evaluate the argument, aBlock for all known shadow objects"
 %{
-    __allShadowObjectsDo(&aBlock, __context);
+    __allShadowObjectsDo(&aBlock COMMA_CON);
 %}
 !
 
@@ -1829,7 +1843,7 @@
     "evaluate the argument, aBlock for all known shadow objects which have
      lost a pointer recently."
 %{
-    __allChangedShadowObjectsDo(&aBlock, __context);
+    __allChangedShadowObjectsDo(&aBlock COMMA_CON);
 %}
 !