ObjectMemory.st
changeset 329 f14fc5ac11b7
parent 326 d2902942491d
child 332 3326b1c813c8
--- a/ObjectMemory.st	Mon May 01 23:30:32 1995 +0200
+++ b/ObjectMemory.st	Mon May 01 23:40:01 1995 +0200
@@ -33,7 +33,7 @@
 COPYRIGHT (c) 1992 by Claus Gittinger
 	     All Rights Reserved
 
-$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.36 1995-04-11 14:50:21 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.37 1995-05-01 21:37:57 claus Exp $
 '!
 
 !ObjectMemory class methodsFor:'documentation'!
@@ -54,7 +54,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.36 1995-04-11 14:50:21 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.37 1995-05-01 21:37:57 claus Exp $
 "
 !
 
@@ -1022,7 +1022,7 @@
 	use ObjectMemory>>whoReferences: or anObject>>allOwners."
 
 %{
-    _printRefChain(__context, anObject);
+    __printRefChain(__context, anObject);
 %}
 !
 
@@ -1085,7 +1085,7 @@
 
 %{  /* NOCONTEXT */
 
-    if (! _isNonNilObject(anObject)) {
+    if (! __isNonNilObject(anObject)) {
 	RETURN ( nil );
     }
     if (((int)anObject >= _MIN_INT) && ((int)anObject <= _MAX_INT)) {
@@ -1127,7 +1127,7 @@
 
 %{  /* NOCONTEXT */
 
-    RETURN ( _isNonNilObject(anObject) ? _MKSMALLINT(_qSize(anObject)) : _MKSMALLINT(0) )
+    RETURN ( __isNonNilObject(anObject) ? _MKSMALLINT(__qSize(anObject)) : _MKSMALLINT(0) )
 %}
     "
      |hist big nw|
@@ -1155,7 +1155,7 @@
 
 %{  /* NOCONTEXT */
 
-    if (! _isNonNilObject(anObject)) {
+    if (! __isNonNilObject(anObject)) {
 	RETURN ( nil );
     }
     RETURN ( _MKSMALLINT( __qSpace(anObject) ) );
@@ -1167,7 +1167,7 @@
 
 %{  /* NOCONTEXT */
 
-    if (! _isNonNilObject(anObject)) {
+    if (! __isNonNilObject(anObject)) {
 	RETURN ( nil );
     }
     RETURN ( _MKSMALLINT( anObject->o_flags ) );
@@ -1197,7 +1197,7 @@
 
 %{  /* NOCONTEXT */
 
-    if (! _isNonNilObject(anObject)) {
+    if (! __isNonNilObject(anObject)) {
 	RETURN ( 0 );
     }
     RETURN ( _MKSMALLINT( _GET_AGE(anObject) ) );
@@ -1720,6 +1720,28 @@
     "
 !
 
+oldSpaceCompressLimit:amount
+    "set the limit for oldSpace compression. If more memory than this
+     limit is in use, the system will not perform compresses on the oldspace,
+     but instead do a mark&sweep GC followed by an oldSpace increase if not enough
+     could be reclaimed. The default is currently some 8Mb, which is ok for workstations
+     with 16..32Mb of physical memory. If your system has much more physical RAM,
+     you may want to increase this limit.
+     This method returns the previous increment value."
+
+%{  /* NOCONTEXT */
+    extern unsigned __compressingGCLimit();
+
+    if (__isSmallInteger(amount)) {
+	RETURN (_MKSMALLINT( __compressingGCLimit(_intVal(amount)) ));
+    }
+%}
+    "to change the limit to 12Mb:"
+    "
+     ObjectMemory oldSpaceCompressLimit:12*1024*1024
+    "
+!
+ 
 fastMoreOldSpaceAllocation:aBoolean
     "this method turns on/off fastMoreOldSpace allocation.
      By default, this is turned off (false), which means that in case of
@@ -2123,8 +2145,10 @@
 !
 
 snapShotOn:aFileName
-    "create a snapshot in the given file. If the file exists,
-     save it for backup. Notify dependents before and after the snapshot operation."
+    "create a snapshot in the given file. 
+     If the file exists, save it for backup.
+     Return true if the snapshot worked, false if it failed for some reason.
+     Notify dependents before and after the snapshot operation."
 
     |ok oldImageName|
 
@@ -2140,7 +2164,8 @@
     "
      give others a chance to fix things
     "
-    self changed:#save.
+    self changed:#save.             "/ will vanish ...
+    self changed:#aboutToSnapshot.  "/ ... for ST-80 compatibility
 
     "
      ST-80 compatibility; send #preSnapshot to all classes
@@ -2159,15 +2184,16 @@
 
     ok ifTrue:[
 	Class addChangeRecordForSnapshot:aFileName.
+    ].
 
 
-	"
-	 ST-80 compatibility; send #postSnapshot to all classes
-	"
-	Smalltalk allBehaviorsDo:[:aClass |
-	    aClass postSnapshot
-	].
+    "
+     ST-80 compatibility; send #postSnapshot to all classes
+    "
+    Smalltalk allBehaviorsDo:[:aClass |
+	aClass postSnapshot
     ].
+    self changed:#finishedSnapshot.  "/ ST-80 compatibility
     ^ ok
 
     "