hg/stx-libbasic: comparison ObjectMemory.st

equal deleted inserted replaced

-:20527009f352
+:9a3fc7cc7127
 initialize
 "initialize the class"
 "/ protect against double initialization
 AllocationFailureSignal isNil ifTrue:[
-AllocationFailureSignal := AllocationFailure.
+	AllocationFailureSignal := AllocationFailure.
-AllocationFailureSignal notifierString:'allocation failure'.
+	AllocationFailureSignal notifierString:'allocation failure'.
-MallocFailureSignal := MallocFailure.
+	MallocFailureSignal := MallocFailure.
-MallocFailureSignal notifierString:'(malloc) allocation failure'.
+	MallocFailureSignal notifierString:'(malloc) allocation failure'.
-LowSpaceSemaphore := Semaphore new name:'LowSpaceSemaphore'.
+	LowSpaceSemaphore := Semaphore new name:'LowSpaceSemaphore'.
-DisposeInterruptHandler := self.
+	DisposeInterruptHandler := self.
-"/ BackgroundCollectMaximumInterval := 3600.     "/ run it at least once an hour
+	"/ BackgroundCollectMaximumInterval := 3600.     "/ run it at least once an hour
-BackgroundCollectMaximumInterval := nil.      "/ only run when space situation makes it feasable
+	BackgroundCollectMaximumInterval := nil.      "/ only run when space situation makes it feasable
-IncrementalGCLimit := 500000.                 "/ run it whenever 500k have been allocated
+	IncrementalGCLimit := 500000.                 "/ run it whenever 500k have been allocated
-FreeSpaceGCLimit := FreeSpaceGCAmount := nil. "/ no minumum-freeSpace trigger.
+	FreeSpaceGCLimit := FreeSpaceGCAmount := nil. "/ no minumum-freeSpace trigger.
-MemoryInterruptHandler := self.
+	MemoryInterruptHandler := self.
-ExceptionInterruptHandler := self.
+	ExceptionInterruptHandler := self.
-VMSelectors := #( #noByteCode #invalidCodeObject #invalidByteCode #invalidInstruction
+	VMSelectors := #( #noByteCode #invalidCodeObject #invalidByteCode #invalidInstruction
-#tooManyArguments #badLiteralTable #receiverNotBoolean: #typeCheckError
+			  #tooManyArguments #badLiteralTable #receiverNotBoolean: #typeCheckError
-#integerCheckError #wrongNumberOfArguments: #privateMethodCalled
+			  #integerCheckError #wrongNumberOfArguments: #privateMethodCalled
-#doesNotUnderstand: #invalidReturn: #invalidReturnOrRestart:
+			  #doesNotUnderstand: #invalidReturn: #invalidReturnOrRestart:
-#userInterrupt #internalError: #spyInterrupt #timerInterrupt #stepInterrupt
+			  #userInterrupt #internalError: #spyInterrupt #timerInterrupt #stepInterrupt
-#errorInterrupt:with: #disposeInterrupt #recursionInterrupt
+			  #errorInterrupt:with: #disposeInterrupt #recursionInterrupt
-#memoryInterrupt #fpExceptionInterrupt #signalInterrupt: #childSignalInterrupt
+			  #memoryInterrupt #fpExceptionInterrupt #signalInterrupt: #childSignalInterrupt
-#ioInterrupt #customInterrupt #schedulerInterrupt #contextInterrupt
+			  #ioInterrupt #customInterrupt #schedulerInterrupt #contextInterrupt
-#interruptLatency:receiver:class:selector:vmActivity:id:).
+			  #interruptLatency:receiver:class:selector:vmActivity:id:).
 ]
 "Modified: / 5.8.1998 / 15:30:12 / cg"
 ! !
 bytesPerOOP
 "return the number of bytes an object reference (for example: an instvar)
 takes"
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN(8);    // not really true
+#else
 RETURN(__mkSmallInteger(sizeof(OBJ)));
+#endif
 %}
 "
 ObjectMemory bytesPerOOP
 "
 bytesPerOTE
 "return the number of overhead bytes of an object.
 i.e. the number of bytes in every objects header."
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN(0);    // not really true
+#else
 RETURN(__mkSmallInteger(OHDR_SIZE));
+#endif
 %}
 "
 ObjectMemory bytesPerOTE
 "
 debugPrinting
 "return true, if various debug printouts in the VM
 are turned on, false of off."
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN( STMain.DebugPrinting ? STObject.True : STObject.False);
+#else
 extern int __getDebugPrinting();
 RETURN (__getDebugPrinting() ? true : false);
+#endif
 %}.
 "
 ObjectMemory debugPrinting
 "
 !
 If off, those messages are suppressed.
 The default is on, since these messages are only printed for severe errors.
 Returns the previous setting."
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+{
+	boolean prev = STMain.DebugPrinting;
+	STMain.DebugPrinting = (aBoolean == STObject.True);
+	return __c__._RETURN( prev ? STObject.True : STObject.False);
+}
+/* NOTREACHED */
+#else
 extern int __setDebugPrinting();
 RETURN ( __setDebugPrinting( (aBoolean == true) ) ? true : false);
+#endif
 %}
 !
 infoPrinting
 "return true, if various informational printouts in the VM
 are turned on, false of off."
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN( STMain.InfoPrinting ? STObject.True : STObject.False);
+#else
 extern int __getInfoPrinting();
 RETURN (__getInfoPrinting() ? true : false);
+#endif
 %}
 "
 ObjectMemory infoPrinting
 "
 !
 this flags setting.
 The default is true, since (currently) those messages are useful for ST/X developers.
 Returns the previous setting."
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+{
+	boolean prev = STMain.InfoPrinting;
+	STMain.InfoPrinting = (aBoolean == STObject.True);
+	return __c__._RETURN( prev ? STObject.True : STObject.False);
+}
+/* NOTREACHED */
+#else
 extern int __setInfoPrinting();
 RETURN ( __setInfoPrinting( (aBoolean == true) ) ? true : false);
+#endif
 %}
 !
 initTrace:aBoolean
 "turn on/off various init-trace printouts in the VM.
 The default is false.
 Returns the previous setting."
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN_false();
+#else
 extern int __setInitTrace();
 RETURN ( __setInitTrace( (aBoolean == true) ) ? true : false);
+#endif
 %}
 ! !
 !ObjectMemory class methodsFor:'VM unwind protect support'!
 By default, this is on in the ST/X IDE, but off for standAlone (packaged) endUser
 applications. Method privacy is an experimental feature, which may be removed in later
 versions, if it turns out to be not useful."
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN_false();
+#else
 extern int __setPrivacyChecks__();
 RETURN ( __setPrivacyChecks__( (aBoolean == true) ) ? true : false);
+#endif
 %}
 !
 setTrapOnAccessFor:anObject
 "install an access trap for anObject;
 An accessSignal will be raised, whenever any instvar of anObject is either read or written.
 This is not supported on all architectures, therefore the return value
 (true of trap was installed ok, false if failed) should be checked."
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN_false();
+#else
 RETURN (__addTrapOnAccess(anObject, 2) ? true : false);
+#endif
 %}
 !
 setTrapOnReadFor:anObject
 "install a read trap for anObject;
 An accessSignal will be raised, whenever any access into anObject occurrs.
 This is not supported on all architectures, therefore the return value
 (true of trap was installed ok, false if failed) should be checked."
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN_false();
+#else
 RETURN (__addTrapOnAccess(anObject, 0) ? true : false);
+#endif
 %}
 !
 setTrapOnWriteFor:anObject
 "install a write trap for anObject;
 An accessSignal will be raised, whenever any instvar of anObject is written to.
 This is not supported on all architectures, therefore the return value
 (true of trap was installed ok, false if failed) should be checked."
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN_false();
+#else
 RETURN (__addTrapOnAccess(anObject, 1) ? true : false);
+#endif
 %}
 !
 unsetAllTraps
 "remove all access traps"
 debugBreakPoint3
 %{
 #ifndef WIN32
-	/*extern void __debugBreakPoint3__();*/
+/*extern void __debugBreakPoint3__();*/
-	__debugBreakPoint3__();
+__debugBreakPoint3__();
 #endif
 %}.
-	^ 0
+^ 0
 !
 flushCaches
 "flush method and inline caches for all classes"
 __flushMethodCacheForSelector(aSelector);
 %}
 !
 ilcMisses: newValue
+newValue class == SmallInteger ifFalse:[
-	newValue class == SmallInteger ifFalse:[^self error:'Not an integer value'].
+	^ self error:'Not an integer value'
-%{  /* NOCONTEXT */
+].
-	/*extern int __ilcMisses(int);*/
+%{  /* NOCONTEXT */
+/*extern int __ilcMisses(int);*/
 #ifdef ILC_PROFILING
-	RETURN ( __MKSMALLINT ( __ilcMisses ( __intVal ( newValue ) ) ) );
+RETURN ( __MKSMALLINT ( __ilcMisses ( __intVal ( newValue ) ) ) );
 #endif
 %}.
-	^ -1
+^ -1
 !
 ilcMissesTrace: bool
 %{
-	/*extern int __ilcMissesTrace(int);*/
+/*extern int __ilcMissesTrace(int);*/
 #ifdef ILC_PROFILING
-	RETURN ( __ilcMissesTrace ( bool == true ) ? true : false );
+RETURN ( __ilcMissesTrace ( bool == true ) ? true : false );
 #endif
 %}.
-	^ 0
+^ 0
 !
 incrementSnapshotID
 "obsolete - do not use"
 stored with the image.
 Not for normal users, this is used by the VM to invalidate
 caches which are stored with the image"
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN(0);
+#else
 RETURN ( __mkSmallInteger( __snapshotID() ));
+#endif
 %}
 "
 ObjectMemory snapshotID
 "
 !
 It may change or even vanish (if it shows to be not useful)."
 |oldTrap|
 %{
-	if (__setTrapRestrictedMethods(trap == true))
+#ifdef __SCHTEAM__
-	    oldTrap = true;
+return __c__._RETURN_false();
-	else
+#else
-	    oldTrap = false;
+if (__setTrapRestrictedMethods(trap == true))
-%}.
+	oldTrap = true;
+else
+	oldTrap = false;
+#endif
+%}.
 (trap and:[oldTrap not]) ifTrue:[
 	self flushCaches
 ].
 ^ oldTrap
 next scavenge/collect.
 WARNING: this method is for ST/X debugging only
 	      it will be removed without notice"
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN(0);
+#else
 if (anObject != nil) {
 	if (! __isNonNilObject(anObject)) {
 	    RETURN ( nil );
 	}
 }
 if ((unsigned INT)anObject <= _MAX_INT) {
 	RETURN ( __mkSmallInteger((INT)anObject) );
 }
 RETURN ( __MKUINT((INT)anObject) );
+#endif
 %}
 "
 |p|
 p := Point new.
 ((ObjectMemory addressOf:p) printStringRadix:16) printCR.
 For old objects and living contexts, the returned number is invalid.
 WARNING: this method is for ST/X debugging only
 	      it will be removed without notice"
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN(0);
+#else
 if (! __isNonNilObject(anObject)) {
 	RETURN ( 0 );
 }
 RETURN ( __mkSmallInteger( _GET_AGE(anObject) ) );
+#endif
 %}
 "
 |p|
 p := Point new.
 (ObjectMemory ageOf:p) printCR.
 lbl := Label label:'compressing garbage ...' in:top.
 lbl adjust:#left.
 lbl origin:(0.0@0.0) corner:(1.0@0.0).
 h := lbl preferredHeight.
 lbl
-topInset:5;
+	topInset:5;
-bottomInset:(h+5) negated;
+	bottomInset:(h+5) negated;
-leftInset:5;
+	leftInset:5;
-rightInset:5.
+	rightInset:5.
 progress := ProgressIndicator in:top.
 progress origin:(0.0@45) corner:(1.0@45).
 progress level:-1.
 h := progress preferredHeight.
 progress
-topInset:(h // 2) negated;
+	topInset:(h // 2) negated;
-bottomInset:(h // 2) negated;
+	bottomInset:(h // 2) negated;
-leftInset:5;
+	leftInset:5;
-rightInset:5.
+	rightInset:5.
 progress beInvisible.
 listV := HVScrollableView for:SelectionInListView in:top.
 listV origin:(0.0@55) corner:(1.0@1.0).
 listV
-topInset:(h // 2);
+	topInset:(h // 2);
-bottomInset:40;
+	bottomInset:40;
-leftInset:5;
+	leftInset:5;
-rightInset:5.
+	rightInset:5.
 listV beInvisible.
 panel := HorizontalPanelView in:top.
 panel origin:(0.0@1.0) corner:(1.0@1.0).
 panel topInset:-40.
 Smalltalk at:#'__VMProcesses__' put:(self processesKnownInVM).
 firstRound := true.
 [done] whileFalse:[
-anyShown := false.
+	anyShown := false.
-progress percentage:0.
+	progress percentage:0.
-firstRound ifTrue:[
+	firstRound ifTrue:[
-firstRound := false.
+	    firstRound := false.
-] ifFalse:[
+	] ifFalse:[
-lbl label:'compressing garbage ...'.
+	    lbl label:'compressing garbage ...'.
-self garbageCollect.
+	    self garbageCollect.
-].
+	].
-lbl label:('searching level '
+	lbl label:('searching level '
-, levels size printString
+		   , levels size printString
-, ' (' , objects size printString , ' refs) ...').
+		   , ' (' , objects size printString , ' refs) ...').
-nAll := objects size.
+	nAll := objects size.
-nDone := 0.
+	nDone := 0.
-objectArray := objects asArray.
+	objectArray := objects asArray.
-owners := "Weak"IdentitySet new.
+	owners := "Weak"IdentitySet new.
-numObjectsDone := 0.
+	numObjectsDone := 0.
-found := false.
+	found := false.
-AbortOperationRequest catch:[
+	AbortOperationRequest catch:[
-self allObjectsIncludingContextsDo:[:o |
+	    self allObjectsIncludingContextsDo:[:o |
-|inPrevLevel isOwner|
+		|inPrevLevel isOwner|
-stop ifTrue:[AbortOperationRequest raise].
+		stop ifTrue:[AbortOperationRequest raise].
-stop ifFalse:[
+		stop ifFalse:[
-isOwner := false.
+		    isOwner := false.
-(o referencesAny:objectArray) ifTrue:[
+		    (o referencesAny:objectArray) ifTrue:[
-o isBehavior ifTrue:[
+			o isBehavior ifTrue:[
-o == Smalltalk ifTrue:[
+			    o == Smalltalk ifTrue:[
-found := true.
+				found := true.
-] ifFalse:[
+			    ] ifFalse:[
-"/ only add it if it has classInstVars
+				"/ only add it if it has classInstVars
-o instSize ~~ Class instSize ifTrue:[
+				o instSize ~~ Class instSize ifTrue:[
-isOwner := true.
+				    isOwner := true.
-]
+				]
-]
+			    ]
-] ifFalse:[
+			] ifFalse:[
-o class ~~ WeakArray ifTrue:[
+			    o class ~~ WeakArray ifTrue:[
-isOwner := true.
+				isOwner := true.
-]
+			    ]
-].
+			].
-].
+		    ].
-isOwner ifTrue:[
+		    isOwner ifTrue:[
-(objects includesIdentical:o) ifFalse:[
+			(objects includesIdentical:o) ifFalse:[
-inPrevLevel := false.
+			    inPrevLevel := false.
-levels do:[:lColl |
+			    levels do:[:lColl |
-lColl == o ifTrue:[
+				lColl == o ifTrue:[
-inPrevLevel := true
+				    inPrevLevel := true
-] ifFalse:[
+				] ifFalse:[
-(lColl includesIdentical:o) ifTrue:[inPrevLevel := true].
+				    (lColl includesIdentical:o) ifTrue:[inPrevLevel := true].
-]
+				]
-].
+			    ].
-inPrevLevel ifFalse:[
+			    inPrevLevel ifFalse:[
-owners add:o.
+				owners add:o.
-(limitOrNil notNil and:[owners size >= limitOrNil]) ifTrue:[
+				(limitOrNil notNil and:[owners size >= limitOrNil]) ifTrue:[
-AbortOperationRequest raise
+				    AbortOperationRequest raise
-].
+				].
-]
+			    ]
-]
+			]
-].
+		    ].
-numObjectsDone := numObjectsDone + 1.
+		    numObjectsDone := numObjectsDone + 1.
-numObjects notNil ifTrue:[
+		    numObjects notNil ifTrue:[
-numObjectsDone \\ 1000 == 0 ifTrue:[
+			numObjectsDone \\ 1000 == 0 ifTrue:[
-progress percentage:(numObjectsDone / numObjects * 100).
+			    progress percentage:(numObjectsDone / numObjects * 100).
-Processor yield.
+			    Processor yield.
-]
+			]
-]
+		    ]
-]
+		]
-].
+	    ].
-].
+	].
-progress percentage:100.
+	progress percentage:100.
-numObjects isNil ifTrue:[
+	numObjects isNil ifTrue:[
-numObjects := numObjectsDone.
+	    numObjects := numObjectsDone.
-].
+	].
-owners remove:aCollection ifAbsent:nil.
+	owners remove:aCollection ifAbsent:nil.
-owners remove:thisContext ifAbsent:nil.
+	owners remove:thisContext ifAbsent:nil.
-owners remove:objectArray ifAbsent:nil.
+	owners remove:objectArray ifAbsent:nil.
-owners remove:objects keyArray ifAbsent:nil.
+	owners remove:objects keyArray ifAbsent:nil.
-owners remove:owners keyArray ifAbsent:nil.
+	owners remove:owners keyArray ifAbsent:nil.
 "/ 'done with level: ' print. levels size print. ' found ' print. owners size print. ' refs' printCR.
-owners isEmpty ifTrue:[
+	owners isEmpty ifTrue:[
-found ifFalse:[
+	    found ifFalse:[
-stop := true.
+		stop := true.
-]
+	    ]
-].
+	].
-stop ifFalse:[
+	stop ifFalse:[
-done := found or:[(owners includesIdentical:Smalltalk)].
+	    done := found or:[(owners includesIdentical:Smalltalk)].
-done ifTrue:[
+	    done ifTrue:[
-moreChainsOnThisLevel := true.
+		moreChainsOnThisLevel := true.
-temporaryRemoved := IdentitySet new.
+		temporaryRemoved := IdentitySet new.
-levels size > 0 ifTrue:[
+		levels size > 0 ifTrue:[
-"/ show what we found so far.
+		    "/ show what we found so far.
-levels last add:Smalltalk.
+		    levels last add:Smalltalk.
-levels reverse.
+		    levels reverse.
-].
+		].
-chains := OrderedCollection new.
+		chains := OrderedCollection new.
-tLevels := levels collect:[:lColl | lColl copy].
+		tLevels := levels collect:[:lColl | lColl copy].
-lbl label:('building refchains ...').
+		lbl label:('building refchains ...').
-nAll := aCollection size.
+		nAll := aCollection size.
-nDone := 0.
+		nDone := 0.
-aCollection do:[:anObject | |theseChains|
+		aCollection do:[:anObject | |theseChains|
-stop ifFalse:[
+		    stop ifFalse:[
-theseChains := self
+			theseChains := self
-refChainsFrom:Smalltalk
+				refChainsFrom:Smalltalk
-to:anObject
+				to:anObject
-inRefSets:tLevels
+				inRefSets:tLevels
-startingAt:1.
+				startingAt:1.
-theseChains size > 0 ifTrue:[
+			theseChains size > 0 ifTrue:[
-chains addAll:theseChains
+			    chains addAll:theseChains
-].
+			].
-nDone := nDone + 1.
+			nDone := nDone + 1.
-progress percentage:(nDone / nAll * 100).
+			progress percentage:(nDone / nAll * 100).
-]
+		    ]
-].
+		].
-tLevels := nil.
+		tLevels := nil.
-levels size > 0 ifTrue:[
+		levels size > 0 ifTrue:[
-levels reverse.
+		    levels reverse.
-levels last remove:Smalltalk.
+		    levels last remove:Smalltalk.
-].
+		].
-[stop not
+		[stop not
-and:[chains size > 0]] whileTrue:[
+		 and:[chains size > 0]] whileTrue:[
-chain := chains first.
+		    chain := chains first.
-chains removeFirst.
+		    chains removeFirst.
-lbl label:('found a reference chain.').
+		    lbl label:('found a reference chain.').
-progress beInvisible.
+		    progress beInvisible.
-chain addFirst:Smalltalk.
+		    chain addFirst:Smalltalk.
-list := OrderedCollection newWithSize:chain size.
+		    list := OrderedCollection newWithSize:chain size.
-1 to:chain size-1 do:[:i |
+		    1 to:chain size-1 do:[:i |
-list
+			list
-at:i
+			    at:i
-put:(self refNameFor:(chain at:i+1) in:(chain at:i))
+			    put:(self refNameFor:(chain at:i+1) in:(chain at:i))
-].
+		    ].
-list at:list size put:(chain last classNameWithArticle).
+		    list at:list size put:(chain last classNameWithArticle).
-"/ hide the VMProcesses stuff from the user ...
+		    "/ hide the VMProcesses stuff from the user ...
-(list at:1) string = 'Smalltalk:__VMProcesses__' ifTrue:[
+		    (list at:1) string = 'Smalltalk:__VMProcesses__' ifTrue:[
-list at:1 put:'__VMProcesses__ (a hidden VM reference)'.
+			list at:1 put:'__VMProcesses__ (a hidden VM reference)'.
-list removeIndex:2.
+			list removeIndex:2.
-chain at:1 put:nil.
+			chain at:1 put:nil.
-chain removeIndex:2.
+			chain removeIndex:2.
-].
+		    ].
-listV list:list.
+		    listV list:list.
-listV beVisible.
+		    listV beVisible.
-listV doubleClickAction:[:idx | |o|
+		    listV doubleClickAction:[:idx | |o|
-(o := chain at:idx) notNil ifTrue:[
+						(o := chain at:idx) notNil ifTrue:[
-o inspect.
+						    o inspect.
-]
+						]
-].
+					    ].
-moreButton beVisible.
+		    moreButton beVisible.
-anyShown := anyShownInAnyLevel := true.
+		    anyShown := anyShownInAnyLevel := true.
-showMore := false.
+		    showMore := false.
-"/ kludge - wait for some user action
+		    "/ kludge - wait for some user action
-[showMore or:[stop or:[top realized not]]] whileFalse:[
+		    [showMore or:[stop or:[top realized not]]] whileFalse:[
-Delay waitForSeconds:0.1
+			Delay waitForSeconds:0.1
-].
+		    ].
-chain := nil.
+		    chain := nil.
-top realized ifFalse:[
+		    top realized ifFalse:[
-stop := true
+			stop := true
-] ifTrue:[
+		    ] ifTrue:[
-listV doubleClickAction:nil.
+			listV doubleClickAction:nil.
-showMore ifFalse:[
+			showMore ifFalse:[
-stop := true.
+			    stop := true.
-].
+			].
-].
+		    ].
-done := false.
+		    done := false.
-stop ifFalse:[
+		    stop ifFalse:[
-progress beVisible.
+			progress beVisible.
-listV beInvisible.
+			listV beInvisible.
-moreButton beInvisible.
+			moreButton beInvisible.
-chain := nil.
+			chain := nil.
-]
+		    ]
-].
+		].
-levels size > 0 ifTrue:[
+		levels size > 0 ifTrue:[
-levels last addAll:temporaryRemoved.
+		    levels last addAll:temporaryRemoved.
-]
+		]
-].
+	    ].
-].
+	].
-owners remove:Smalltalk ifAbsent:nil.
+	owners remove:Smalltalk ifAbsent:nil.
-owners remove:(owners keyArray) ifAbsent:nil.
+	owners remove:(owners keyArray) ifAbsent:nil.
-owners remove:objectArray ifAbsent:nil.
+	owners remove:objectArray ifAbsent:nil.
-levels do:[:lColl |
+	levels do:[:lColl |
-owners remove:lColl ifAbsent:nil
+	    owners remove:lColl ifAbsent:nil
-].
+	].
-levels add:owners.
+	levels add:owners.
-objects := owners.
+	objects := owners.
-objects size == 0 ifTrue:[
+	objects size == 0 ifTrue:[
-stop := true
+	    stop := true
-].
+	].
-stop ifTrue:[
+	stop ifTrue:[
-Smalltalk at:#'__VMProcesses__' put:nil.
+	    Smalltalk at:#'__VMProcesses__' put:nil.
-top destroy.
+	    top destroy.
-anyShown ifFalse:[
+	    anyShown ifFalse:[
-userStop ifFalse:[
+		userStop ifFalse:[
-self information:(anyShownInAnyLevel ifTrue:['no more references'] ifFalse:['no references']).
+		    self information:(anyShownInAnyLevel ifTrue:['no more references'] ifFalse:['no references']).
-]
+		]
-].
+	    ].
-^ self.
+	   ^ self.
-].
+	].
 ].
 anyShown ifTrue:[
-userStop ifFalse:[
+	userStop ifFalse:[
-self information:'no more references'.
+	    self information:'no more references'.
-]
+	]
 ].
 Smalltalk at:#'__VMProcesses__' put:nil.
 ^ self
 "
 "low level dump an object.
 WARNING: this method is for ST/X debugging only
 	      it may be removed (or replaced by a noop) without notice"
 %{
+#ifdef __SCHTEAM__
+someObject.dumpObject();
+#else
 __dumpObject__(someObject, __LINE__);
+#endif
 %}
 "
 ObjectMemory dumpObject:true
 ObjectMemory dumpObject:(Array new:10)
 ObjectMemory dumpObject:(10@20 corner:30@40)
 dumpSender
 "dump my senders context"
 %{
+#ifdef __SCHTEAM__
+__c__.currentContinuation.dumpObject();
+#else
 __PATCHUPCONTEXT(__thisContext);
 __dumpContext__(__ContextInstPtr(__thisContext)->c_sender);
+#endif
 %}
 "
 ObjectMemory dumpSender
 "
 !
 "For debugging only.
 WARNING: this method is for ST/X debugging only
 	      it will be removed without notice"
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN(0);
+#else
 if (! __isNonNilObject(anObject)) {
 	RETURN ( nil );
 }
 RETURN ( __mkSmallInteger( anObject->o_flags ) );
+#endif
 %}
 "
 F_ISREMEMBERED  1       /* a new-space thing being refd by some oldSpace thing */
 F_ISFORWARDED   2       /* a forwarded object (you will never see this here) */
 F_DEREFERENCED  4       /* a collection after grow (not currently used) */
 INT addr = __longIntVal(anAddress);
 if (addr) {
 	RETURN ((OBJ)(addr));
 }
-RETURN (nil);
+%}.
-%}
+^ nil
 !
 printReferences:anObject
 "for debugging: print referents to anObject.
 WARNING: this method is for ST/X debugging only
 (this is not the same as 'anObject size').
 WARNING: this method is for ST/X debugging only
 	      it will be removed without notice"
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN(0);
+#else
 RETURN ( __isNonNilObject(anObject) ? __mkSmallInteger(__qSize(anObject)) : __mkSmallInteger(0) )
+#endif
 %}
 "
 |hist big nw|
 hist := Array new:100 withAll:0.
 the returned value may be invalid after the next scavenge/collect.
 WARNING: this method is for ST/X debugging only
 	      it will be removed without notice"
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN(0);
+#else
 if (! __isNonNilObject(anObject)) {
 	RETURN ( nil );
 }
 RETURN ( __mkSmallInteger( __qSpace(anObject) ) );
+#endif
 %}
 ! !
 !ObjectMemory class methodsFor:'debugging ST/X'!
 (You may turn off the stack print with debugPrinting:false)
 WARNING: this method is for debugging only
 	      it will be removed without notice"
 %{
+#ifdef __SCHTEAM__
+__c__.printWalkback( STObject.StandardErrorStream );
+#else
 __printStack(__context);
+#endif
 %}
 "
 ObjectMemory printStackBacktrace
 "
 %{
 extern OBJ __processesKnownInVM();
 RETURN (__processesKnownInVM());
-%}
+%}.
+^ #()
 "
 ObjectMemory processesKnownInVM
 "
 ! !
 %{
 if (! __garbageCollect(__context)) {
 	__markAndSweep();
 	RETURN (false);
 }
-RETURN (true);
+%}.
-%}
+^ true
 "
 ObjectMemory compressingGarbageCollect
 "
 !
 If no limit has been reached yet, do nothing and return false.
 This is called by the ProcessorScheduler at idle times or by the
 backgroundCollector."
 |done limit|
+self isSchteamEngine ifTrue:[^ false ].
 AbortOperationRequest handle:[:ex |
 	"/ in case of abort (from the debugger),
 	"/ disable gcSteps.
 	done := true.
 cases, this can avoid a pause (in the higher prio processes) due to
 a blocking GC."
 |delay|
+self isSchteamEngine ifTrue:[^ self].
 Processor activeProcess priority > Processor userBackgroundPriority ifTrue:[
 	delay := Delay forMilliseconds:1
 ].
 ((self incrementalGCPhaseSymbolic ~~ #idle)
 Use this, if you have suspendable background processes which
 run all the time, and therefore would prevent the idle-collector
 from running. See documentation in this class for more details."
 |p|
+self isSchteamEngine ifTrue:[^ self].
 "/
 "/ its not useful, to run it more than once
 "/
 BackgroundCollectProcess notNil ifTrue:[
 value should be used to switch back."
 |result|
 %{
+#ifdef __SCHTEAM__
+return __c__._RETURN_false();
+#else
 extern int __fastMoreOldSpaceAllocation();
 result = __fastMoreOldSpaceAllocation(aBoolean == true ? 1 : 0) ? true : false;
+#endif
 %}.
 self saveGarbageCollectorSetting:#fastMoreOldSpaceAllocation: value:aBoolean.
 ^ result
 used by applications - it may vanish without notice"
 |result|
 %{
+#ifdef __SCHTEAM__
+return __c__._RETURN_false();
+#else
 result = __incrementalSweep((aBoolean == true) ? 1 : 0) ? true : false;
+#endif
 %}.
 self saveGarbageCollectorSetting:#incrementalSweep: value:aBoolean.
 ^ result.
 This is an EXPERIMENTAL interface.
 "
 %{
+#ifdef __SCHTEAM__
+return __c__._RETURN_false();
+#else
 if (flag == true) {
 	__tenure(__context);
 }
 __lockTenure(flag == true ? 1 : 0);
+#endif
 %}.
 self saveGarbageCollectorSetting:#lockTenure: value:flag.
 !
 On systems which do not support the mmap (or equivalent) system call,
 this (currently) implies a compressing garbage collect - so its slow.
 Notice: this is a nonstandard interface - use only in special situations."
 %{
+#ifdef __SCHTEAM__
+return __c__._RETURN_true();
+#else
 if (__isSmallInteger(howMuch)) {
 	RETURN( __moreOldSpace(__context, __intVal(howMuch)) ? true : false );
 }
 RETURN (false);
+#endif
 %}
 "
 ObjectMemory moreOldSpace:1000000
 "
 !
 	excessive scavenges. You have been warned."
 |result|
 %{
+#ifdef __SCHTEAM__
+return __c__._RETURN_false();
+#else
 extern int __setNewSpaceSize();
 if (__isSmallInteger(newSize)) {
 	result = __setNewSpaceSize(__intVal(newSize)) ? true : false;
 }
+#endif
 %}.
 result isNil ifTrue:[
 	self primitiveFailed.
 ].
 result ifTrue:[
 				    __isSmallInteger(aNumber)
 				    ? __intVal(aNumber)
 				    : -1);
 RETURN (__mkSmallInteger(prev));
 %}.
+^ 0
 "
 ObjectMemory byteCodeSizeLimitForDynamicCompilation:nil
 ObjectMemory byteCodeSizeLimitForDynamicCompilation:8000
 "
 %{  /* NOCONTEXT */
 extern OBJ __codeForCPU();
 RETURN (__codeForCPU(aCPUSymbol));
 %}.
+^ nil
 "
 ObjectMemory codeForCPU:nil
 ObjectMemory codeForCPU:#i486
 ObjectMemory codeForCPU:#i586
 prev = __codeSizeLimitForDynamicCompilation( __isSmallInteger(aNumber)
 				    ? __intVal(aNumber)
 				    : -1);
 RETURN (__mkSmallInteger(prev));
 %}.
+^ 0
 "
 ObjectMemory codeSizeLimitForDynamicCompilation:nil
 ObjectMemory codeSizeLimitForDynamicCompilation:8000
 "
 extern __compiledCodeCounter();
 int nBytes;
 nBytes = __compiledCodeCounter();
 RETURN (__mkSmallInteger(nBytes));
-%}
+%}.
+^ 0
 "
 ObjectMemory compiledCodeCounter
 "
 !
 extern __compiledCodeSpaceUsed();
 int nBytes;
 nBytes = __compiledCodeSpaceUsed();
 RETURN (__mkSmallInteger(nBytes));
-%}
+%}.
+^ 0
 "
 ObjectMemory compiledCodeSpaceUsed
 "
 !
 fullSingleStepSupport
 "return the setting of the full single step support flag"
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN_false();
+#else
 extern int __fullSingleStep();
 RETURN (__fullSingleStep(-1) ? true : false);
+#endif
 %}
 "
 ObjectMemory fullSingleStepSupport
 "
 stores are not steppable, but treated like atomar invisible operations.
 If on, single step halts at those operations.
 Execution is a bit slower if enabled."
 %{  /* NOCONTEXT */
+#ifdef __SCHTEAM__
+return __c__._RETURN_false();
+#else
 extern int __fullSingleStep();
 int prev;
 prev = __fullSingleStep(aBoolean == true
 				   ? 1
 				   : (aBoolean == false)
 					? 0
 					: -1);
 RETURN (prev ? true : false);
+#endif
 %}
 "
 ObjectMemory fullSingleStepSupport:true
 ObjectMemory fullSingleStepSupport:false
 "
 limit = __dynamicCodeLimit();
 if (limit) {
 	RETURN (__mkSmallInteger(limit));
 }
-RETURN (nil);
+%}.
-%}
+^ nil
 !
 insnSizeLimitForDynamicCompilation:aNumber
 "set a limit on a methods number of internal insns.
 Compilation of a method into machine code is aborted,
 prev = __insnSizeLimitForDynamicCompilation( __isSmallInteger(aNumber)
 				    ? __intVal(aNumber)
 				    : -1);
 RETURN (__mkSmallInteger(prev));
 %}.
+^ 0
 "
 ObjectMemory insnSizeLimitForDynamicCompilation:nil
 ObjectMemory insnSizeLimitForDynamicCompilation:8000
 "
 %{  /* NOCONTEXT */
 extern int __javaJustInTimeCompilation();
 RETURN (__javaJustInTimeCompilation(-1) ? true : false);
-%}
+%}.
+^ false
 "
 ObjectMemory javaJustInTimeCompilation
 "
 !
 				   : (aBoolean == false)
 					? 0
 					: -1);
 RETURN (prev ? true : false);
 %}.
+^ false
 "
 ObjectMemory justInTimeCompilation:true
 ObjectMemory justInTimeCompilation:false
 "
 !
 %{  /* NOCONTEXT */
 extern int __optimizeContexts();
 RETURN (__optimizeContexts(-1) ? true : false);
-%}
+%}.
+^ false
 "
 ObjectMemory optimizeContexts
 "
 !
 				   ? 1
 				   : (aBoolean == false)
 					? 0
 					: -1);
 RETURN (prev ? true : false);
-%}
+%}.
+^ false
 "
 ObjectMemory optimizeContexts:true
 ObjectMemory optimizeContexts:false
 "
 !
 %{  /* NOCONTEXT */
 extern int __canDoJustInTimeCompilation();
 RETURN (__canDoJustInTimeCompilation() ? true : false);
-%}
+%}.
+^ false
 "
 ObjectMemory supportsJustInTimeCompilation
 "
 ! !
 %{  /* NOCONTEXT */
 extern unsigned INT __oldSpaceUsed(), __freeListSpace();
 extern unsigned int __newSpaceUsed();
 RETURN ( __MKUINT(__oldSpaceUsed() + (INT)__newSpaceUsed() - __freeListSpace()) );
-%}
+%}.
+^ 0
 "
 ObjectMemory bytesUsed
 "
 !
 #ifdef COLLECTEDOLD_ADDRESS
 RETURN(__MKUINT(COLLECTEDOLD_ADDRESS));
 #else
 RETURN(__mkSmallInteger(0));
 #endif
-%}
+%}.
+^ 0
 "
 	self collectedOldSpaceAddress
 "
 !
 %{  /* NOCONTEXT */
 extern unsigned __fixSpaceSize();
 RETURN ( __MKUINT(__fixSpaceSize()) );
-%}
+%}.
+^ 0
 "
 ObjectMemory fixSpaceSize
 "
 !
 %{  /* NOCONTEXT */
 extern unsigned __fixSpaceUsed();
 RETURN ( __MKUINT(__fixSpaceUsed()) );
-%}
+%}.
+^ 0
 "
 ObjectMemory fixSpaceUsed
 "
 !
 %{  /* NOCONTEXT */
 extern unsigned INT __freeListSpace();
 RETURN ( __MKUINT(__freeListSpace()) );
-%}
+%}.
+^ 0
 "
 ObjectMemory freeListSpace
 "
 !
 %{  /* NOCONTEXT */
 extern unsigned INT __oldSpaceSize(), __oldSpaceUsed();
 RETURN ( __MKUINT(__oldSpaceSize() - __oldSpaceUsed()) );
-%}
+%}.
+^ 0
 "
 ObjectMemory freeSpace
 "
 !
 %{  /* NOCONTEXT */
 extern int __garbageCollectCount();
 RETURN (__mkSmallInteger(__garbageCollectCount()));
-%}
+%}.
+^ 0
 "
 ObjectMemory garbageCollectCount
 "
 !
 %{  /* NOCONTEXT */
 extern int __incrementalGCCount();
 RETURN (__mkSmallInteger(__incrementalGCCount()));
-%}
+%}.
+^ 0
 "
 ObjectMemory incrementalGCCount
 "
 !
 %{  /* NOCONTEXT */
 extern int __incrGCphase();
 RETURN (__mkSmallInteger(__incrGCphase()));
-%}
+%}.
+^ 2
 !
 incrementalGCPhaseSymbolic
 "returns the internal state of the incremental GC
 in a symbolic form.
 ^ #sweeping
 "Created: / 10.8.1998 / 15:02:52 / cg"
 !
+isSchteamEngine
+"is this Smalltalk/X system running under the new Schteam engine?"
+%{
+#ifdef __SCHTEAM__
+return __c__._RETURN_true();
+#endif
+%}.
+^ false
+!
 lastScavengeReclamation
 "returns the number of bytes replacimed by the last scavenge.
 For statistic only - this may vanish."
 %{  /* NOCONTEXT */
 extern int __newSpaceReclaimed();
 RETURN ( __mkSmallInteger(__newSpaceReclaimed()) );
-%}
+%}.
+^ 0
 "percentage of reclaimed objects is returned by:
 ((ObjectMemory lastScavengeReclamation)
 / (ObjectMemory newSpaceSize)) * 100.0
 "
 %{  /* NOCONTEXT */
 extern OBJ __lifoRememberedSet();
 RETURN ( __lifoRememberedSet() );
-%}
+%}.
+^ nil
 "
 ObjectMemory lifoRememberedSet
 "
 !
 %{  /* NOCONTEXT */
 extern int __lifoRememberedSetSize();
 RETURN (__mkSmallInteger(__lifoRememberedSetSize()));
-%}
+%}.
+^ 0
 "
 ObjectMemory lifoRememberedSetSize
 "
 !
 filled = __stx_malloc_stats(statsArray, sizeof(statsArray));
 if (filled < 1) {
 	RETURN(__mkSmallInteger(0));
 }
 RETURN ( __MKUINT(statsArray[0]));
-%}
+%}.
+^ 0
 "
 ObjectMemory mallocAllocated
 "
 !
 	__arrayVal(allStats)[i] = temp = __MKUINT(statsArray[i]);
 	__STORE(allStats, temp);
 }
 RETURN ( allStats );
-%}
+%}.
+^ #()
 "
 ObjectMemory mallocStatsArray
 "
 !
 filled = __stx_malloc_stats(statsArray, sizeof(statsArray));
 if (filled < 2) {
 	RETURN(__mkSmallInteger(0));
 }
 RETURN ( __MKUINT(statsArray[1]));
-%}
+%}.
+^ 0
 "
 ObjectMemory mallocTotal
 "
 !
 %{  /* NOCONTEXT */
 extern int __markAndSweepCount();
 RETURN (__mkSmallInteger(__markAndSweepCount()));
-%}
+%}.
+^ 0
 "
 ObjectMemory markAndSweepCount
 "
 !
 Since ST/X uses direct pointers, a field in the objectHeader
 is used, which is currently 11 bits in size."
 %{  /* NOCONTEXT */
 RETURN ( __mkSmallInteger( __MAX_HASH__ << __HASH_SHIFT__) );
-%}
+%}.
+^ 8191
 "
 ObjectMemory maximumIdentityHashValue
 "
 !
 minScavengeReclamation
-"returns the number of bytes replacimed by the least effective scavenge.
+"returns the number of bytes replaimed by the least effective scavenge.
 For statistic only - this may vanish."
 %{  /* NOCONTEXT */
 extern int __newSpaceReclaimedMin();
 RETURN ( __mkSmallInteger(__newSpaceReclaimedMin()) );
-%}
+%}.
+^ 0
 "
 ObjectMemory minScavengeReclamation
 "
 !
 %{  /* NOCONTEXT */
 extern unsigned __newSpaceSize();
 RETURN ( __MKUINT(__newSpaceSize()) );
-%}
+%}.
+^ 0
 "
 ObjectMemory newSpaceSize
 "
 !
 %{  /* NOCONTEXT */
 extern unsigned int __newSpaceUsed();
 RETURN ( __MKUINT(__newSpaceUsed()) );
-%}
+%}.
+^ 0
 "
 ObjectMemory newSpaceUsed
 "
 !
 %{  /* NOCONTEXT */
 extern int __weakListSize();
 RETURN ( __mkSmallInteger(__weakListSize()) );
-%}
+%}.
+^ 0
 "
 ObjectMemory numberOfWeakObjects
 "
 !
 #ifdef OLDSPACE_ADDRESS
 RETURN(__MKUINT(OLDSPACE_ADDRESS));
 #else
 RETURN(__mkSmallInteger(0));
 #endif
-%}
+%}.
+^ 0
 "
 	self oldSpaceAddress
 "
 !
 %{  /* NOCONTEXT */
 extern unsigned INT __oldSpaceAllocatedSinceLastGC();
 RETURN ( __MKUINT(__oldSpaceAllocatedSinceLastGC()) );
-%}
+%}.
+^ 0
 "
 ObjectMemory oldSpaceAllocatedSinceLastGC
 "
 !
 %{  /* NOCONTEXT */
 extern unsigned INT __oldSpaceSize();
 RETURN ( __MKUINT(__oldSpaceSize()) );
-%}
+%}.
+^ 0
 "
 ObjectMemory oldSpaceSize
 "
 !
 %{  /* NOCONTEXT */
 extern unsigned INT __oldSpaceUsed();
 RETURN ( __MKUINT(__oldSpaceUsed()) );
-%}
+%}.
+^ 0
 "
 ObjectMemory oldSpaceUsed
 "
 !
 %{  /* NOCONTEXT */
 extern unsigned int __rememberedSetSize();
 RETURN (__mkSmallInteger(__rememberedSetSize()));
-%}
+%}.
+^ 0
 "
 ObjectMemory rememberedSetSize
 "
 !
 extern void __resetNewSpaceReclaimedMin();
 __resetNewSpaceReclaimedMin();
 %}.
 ^ self
 "
 ObjectMemory resetMinScavengeReclamation.
 ObjectMemory minScavengeReclamation
 "
 !
 %{  /* NOCONTEXT */
 extern int __runsSingleOldSpace();
 RETURN ( (__runsSingleOldSpace() ? true : false) );
-%}
+%}.
+^ true
 "
 ObjectMemory runsSingleOldSpace
 "
 !
 %{  /* NOCONTEXT */
 extern int __scavengeCount();
 RETURN (__mkSmallInteger(__scavengeCount()));
-%}
+%}.
+^ 0
 "
 ObjectMemory scavengeCount
 "
 !
 %{  /* NOCONTEXT */
 extern unsigned __symSpaceSize();
 RETURN ( __mkSmallInteger(__symSpaceSize()) );
-%}
+%}.
+^ 0
 "
 ObjectMemory symSpaceSize
 "
 !
 %{  /* NOCONTEXT */
 extern unsigned __symSpaceUsed();
 RETURN ( __mkSmallInteger(__symSpaceUsed()) );
-%}
+%}.
+^ 0
 "
 ObjectMemory symSpaceUsed
 "
 !
 %{  /* NOCONTEXT */
 extern unsigned __tenureAge();
 RETURN ( __mkSmallInteger(__tenureAge()) );
-%}
+%}.
+^ 0
 !
 vmSymbols
 "return a collection of symbols used by the VM"
 |modules|
 modules := IdentityDictionary new.
 self allBinaryModulesDo:[:idArg :nameArg :flagsArg :libName :timeStamp |
-|type subModuleName module dynamic infoRec handle pathName
+	|type subModuleName module dynamic infoRec handle pathName
-typeName name nameString|
+	 typeName name nameString|
-nameArg isString ifFalse:[
+	nameArg isString ifFalse:[
-'Error in binaryModuleInfo - skip entry' errorPrintCR.
+	    'Error in binaryModuleInfo - skip entry' errorPrintCR.
-] ifTrue:[
+	] ifTrue:[
-name := nameArg.
+	    name := nameArg.
-subModuleName := name asSymbol.
+	    subModuleName := name asSymbol.
-idArg > 0 ifTrue:[
+	    idArg > 0 ifTrue:[
-dynamic := true.
+		dynamic := true.
-typeName := 'dynamic '.
+		typeName := 'dynamic '.
-handle := ObjectFileLoader handleFromID:idArg.
+		handle := ObjectFileLoader handleFromID:idArg.
-(handle isNil or:[(pathName := handle pathName) isNil]) ifTrue:[
+		(handle isNil or:[(pathName := handle pathName) isNil]) ifTrue:[
-name := '?'
+		    name := '?'
-] ifFalse:[
+		] ifFalse:[
-name := pathName asFilename baseName
+		    name := pathName asFilename baseName
-]
+		]
-] ifFalse:[
+	    ] ifFalse:[
-dynamic := false.
+		dynamic := false.
-typeName := 'builtIn '.
+		typeName := 'builtIn '.
-pathName := nil.
+		pathName := nil.
-libName isNil ifTrue:[
+		libName isNil ifTrue:[
-name := subModuleName
+		    name := subModuleName
-] ifFalse:[
+		] ifFalse:[
-name := libName
+		    name := libName
-].
+		].
-].
+	    ].
-nameString := typeName.
+	    nameString := typeName.
-libName isNil ifTrue:[
+	    libName isNil ifTrue:[
-nameString := nameString, 'module '
+		nameString := nameString, 'module '
-] ifFalse:[
+	    ] ifFalse:[
-nameString := nameString, 'classLib '
+		nameString := nameString, 'classLib '
-].
+	    ].
-nameString := nameString , name.
+	    nameString := nameString , name.
-libName isNil ifTrue:[
+	    libName isNil ifTrue:[
-type := #classObject
+		type := #classObject
-] ifFalse:[
+	    ] ifFalse:[
-type := #classLibrary
+		type := #classLibrary
-].
+	    ].
-infoRec := modules at:idArg ifAbsent:nil.
+	    infoRec := modules at:idArg ifAbsent:nil.
-infoRec notNil ifTrue:[
+	    infoRec notNil ifTrue:[
-infoRec classNames add:subModuleName.
+		infoRec classNames add:subModuleName.
-] ifFalse:[
+	    ] ifFalse:[
-infoRec := BinaryModuleDescriptor
+		infoRec := BinaryModuleDescriptor
-name:nameString
+				name:nameString
-type:type
+				type:type
-id:idArg
+				id:idArg
-dynamic:dynamic
+				dynamic:dynamic
-classNames:( (OrderedSet ? Set) with:subModuleName)
+				classNames:( (OrderedSet ? Set) with:subModuleName)
-handle:handle
+				handle:handle
-pathName:pathName
+				pathName:pathName
-libraryName:libName
+				libraryName:libName
-timeStamp:nil.
+				timeStamp:nil.
-modules at:idArg put:infoRec.
+		modules at:idArg put:infoRec.
-].
+	    ].
-].
+	].
 ].
 ^ modules
 "
 ObjectMemory binaryModuleInfo
 %{
 extern OBJ __getVMReleaseStrings();
 RETURN (__getVMReleaseStrings());
-%}
+%}.
+^ #()
 "
 ObjectMemory getVMIdentificationStrings
 "
 ! !
 dir := Filename currentDirectory.
 "/ the current directory is not a good idea, if stx is started via a desktop manager
 "/ or in osx, by clicking on stx.app.
 dir isRootDirectory ifTrue:[
-exeDir := OperatingSystem nameOfSTXExecutable asFilename directory.
+	exeDir := OperatingSystem nameOfSTXExecutable asFilename directory.
-dir ~= exeDir ifTrue:[
+	dir ~= exeDir ifTrue:[
-"/ Change it to ~/.smalltalk or is executable directory better?
+	    "/ Change it to ~/.smalltalk or is executable directory better?
-"/ use executable dir, as otherwise I'd have to change the VM to include an image path...
+	    "/ use executable dir, as otherwise I'd have to change the VM to include an image path...
-"/ dir := Filename usersPrivateSmalltalkDirectory.
+	    "/ dir := Filename usersPrivateSmalltalkDirectory.
-dir := exeDir.
+	    dir := exeDir.
-].
+	].
 ].
 ^ dir
 "
 self directoryForImageAndChangeFile
 initChangeFilename
 "/ make the changeFilePath an absolute one,
 "/ in case some stupid windows fileDialog changes the current directory...
 self
-nameForChanges:(self directoryForImageAndChangeFile / ObjectMemory nameForChangesLocal)
+	nameForChanges:(self directoryForImageAndChangeFile / ObjectMemory nameForChangesLocal)
-asAbsoluteFilename pathName
+			    asAbsoluteFilename pathName
 "
 self initChangeFilename
 "
 !
 oldImageName := ImageName.
 oldImageTime := ImageSaveTime.
 ImageName := filenameString.
 ImageSaveTime := Timestamp now.
+ok := false.
 %{  /* CALLSSTACK:32000 */
 OBJ __snapShotOn();
 OBJ funny = @symbol(funnySnapshotSymbol);
 "
 ST-80 compatibility; send #preSnapshot to all classes
 "
 Smalltalk allClassesDo:[:aClass |
-aClass preSnapshot
+	aClass preSnapshot
 ].
 "
 save in a temp file and rename - just in case something
 bad happens while writing the image.
 (could be ST/X error or file-system errors etc.)
 "
 snapshotFilename := aFileName asFilename.
 snapshotFilename isAbsolute ifFalse:[
-snapshotFilename := self directoryForImageAndChangeFile
+	snapshotFilename := self directoryForImageAndChangeFile
-/ snapshotFilename name.
+			    / snapshotFilename name.
 ].
 tempFilename := (FileStream newTemporaryIn:snapshotFilename directory)
-close;
+			close;
-fileName.
+			fileName.
 ok := self primSnapShotOn:tempFilename.
 ok ifTrue:[
-"keep history of one snapshot file"
+	"keep history of one snapshot file"
-snapshotFilename exists ifTrue:[
+	snapshotFilename exists ifTrue:[
-tempFilename symbolicAccessRights:snapshotFilename symbolicAccessRights.
+	    tempFilename symbolicAccessRights:snapshotFilename symbolicAccessRights.
-snapshotFilename renameTo:(snapshotFilename withSuffix:'sav').
+	    snapshotFilename renameTo:(snapshotFilename withSuffix:'sav').
-] ifFalse:[
+	] ifFalse:[
-"image file hat stx as interpreter and can be executed"
+	    "image file hat stx as interpreter and can be executed"
-tempFilename makeExecutable.
+	    tempFilename makeExecutable.
-].
+	].
-tempFilename renameTo:snapshotFilename.
+	tempFilename renameTo:snapshotFilename.
-Class addChangeRecordForSnapshot:aFileName.
+	Class addChangeRecordForSnapshot:aFileName.
-setImageName ifTrue:[
+	setImageName ifTrue:[
-oldChangeFile := self nameForChanges.
+	    oldChangeFile := self nameForChanges.
-ImageName := snapshotFilename asAbsoluteFilename asString.
+	    ImageName := snapshotFilename asAbsoluteFilename asString.
-self refreshChangesFrom:oldChangeFile.
+	    self refreshChangesFrom:oldChangeFile.
-].
+	].
 ] ifFalse:[
-tempFilename remove.
+	tempFilename remove.
 ].
 "
 ST-80 compatibility; send #postSnapshot to all classes
 "
 Smalltalk allClassesDo:[:aClass |
-aClass postSnapshot
+	aClass postSnapshot
 ].
 self changed:#finishedSnapshot.  "/ ST-80 compatibility
 ok ifFalse:[
-SnapshotError raise.
+	SnapshotError raise.
-"not reached"
+	"not reached"
 ].
 Transcript
-show:'Snapshot ';
+	show:'Snapshot ';
-show:snapshotFilename baseName allBold;
+	show:snapshotFilename baseName allBold;
-show:' saved ';
+	show:' saved ';
-show:Timestamp now;
+	show:Timestamp now;
-show:' in ';
+	show:' in ';
-show:snapshotFilename asAbsoluteFilename directoryName;
+	show:snapshotFilename asAbsoluteFilename directoryName;
-showCR:'.'.
+	showCR:'.'.
 ^ ok
 "
 ObjectMemory snapShotOn:'myimage.img' setImageName:false
 ! !
 !ObjectMemory class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.286 2015-02-20 22:45:22 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.287 2015-05-24 12:52:28 cg Exp $'
 !
 version_CVS
-^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.286 2015-02-20 22:45:22 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.287 2015-05-24 12:52:28 cg Exp $'
 !
 version_SVN
 ^ '$ Id: ObjectMemory.st 10643 2011-06-08 21:53:07Z vranyj1  $'
 ! !

branch	jv
changeset 18403	9a3fc7cc7127
parent 18120	e3a375d5f6a8
parent 18400	68951cdfb08b
child 18786	237a87b4fe8f