Hello, Anthony,

> Is there any code for these, particularly any SystemTracer code.  I already
> have most of the compiler and interpreter re-written using the new
> CompiledMethod format and BlockClosures, but I can't test it until I convert
> an image using SystemTracer.  I ran the basic SystemTracer that comes with
> the latest image.  It finishes creating an image file, but when I start it
> up the VM crashes (Exception code: C0000005) in Windows 98.  Has anyone
> created a working clone lately?

  The problem is the handling of the obsoleted classes.
Attached changeset should fix the problem.  Try it and let
me know the outcome.  (It was while ago I did this and the
memory is a bit vague.  You might have to rehash some
unordered collection after the cloned image is started up.)

  Hope this helps,

-- Yoshiki
-------------- next part --------------
'From Squeak3.1alpha of 7 March 2001 [latest update: #4081] on 29 June 2001 at 10:33:36 am'!
'From Squeak3.0 of 4 February 2001 [latest update: #3545] on 22 February 2001 at 9:40:30 am'!
Object subclass: #SystemTracer
	instanceVariableNames: 'oopMap map file writeDict maxOop specialObjects initialProcess hashGenerator imageHeaderSize cleaningUp compactClasses replacementClasses validOops '
	classVariableNames: 'Clamped NewNil UnassignedOop '
	poolDictionaries: ''
	category: 'VMConstruction-Interpreter'!
!SmallInteger methodsFor: 'comparing'!
hashMappedBy: map

	^ self! !
!SystemTracer methodsFor: 'initialization'!
initCompactClasses 
	| c |
	c _ Array new: 31.	
	"These classes have a short name (their index in this table.  It is not their oop.)
	Thus their instances can use just a single word as their header in memory."
	c at: 1 put: CompiledMethod.  c at: 2 put: Symbol. c at: 3 put: Array.
	c at: 4 put: Float.  c at: 5 put: LargePositiveInteger.  c at: 6 put: String.
	c at: 7 put: MethodDictionary.  c at: 8 put: Association.  c at: 9 put: Point.
	c at: 10 put: Rectangle.  c at: 11 put: ClassOrganizer.  c at: 12 put: TextLineInterval.

	"**NOTE** at present the Squeak VM relies on BlockContext=13 and MethodContext=14"
	c at: 13 put: BlockContext.  c at: 14 put: MethodContext.  c at: 15 put: PseudoContext.

	compactClasses _ c.
	"16 to 31 are available for user defined compact classes."

	"Attempt to correctly write contextCache image.."
	compactClasses _ Smalltalk compactClassesArray! !
!SystemTracer methodsFor: 'initialization'!
initDict
	writeDict _ Dictionary new: 256.
	Smalltalk allClassesDo: 
		[:class | 
		class isBits 
			ifTrue: 
			[writeDict at: class put: (class isBytes ifTrue: [#writeBytes:]
												ifFalse: [#writeWords:])]
			ifFalse:
			[writeDict at: class put: #writePointers:.
			(class inheritsFrom: Set) | (class == Set) ifTrue:
				[writeDict at: class put: #writeSet:].
			(class inheritsFrom: IdentitySet) | (class == IdentitySet) ifTrue:
				[writeDict at: class put: #writeIdentitySet:].
			(class inheritsFrom: IdentityDictionary) | (class == IdentityDictionary) ifTrue:
				[writeDict at: class put: #writeIdentitySet:].
			(class inheritsFrom: MethodDictionary) | (class == MethodDictionary) ifTrue:
				[writeDict at: class put: #writeMethodDictionary:]].
				].

"check for Associations of replaced classes"
	writeDict at: Association put: #writeAssociation:.

	Smalltalk allObjectsDo: [:obj |
		(obj isKindOf: Behavior) ifTrue: [
			writeDict at: obj class put: #writeBehavior:]].
	writeDict at: PseudoContext class put: #writeBehavior:.
	writeDict at: SmallInteger put: #writeClamped:.
	writeDict at: CompiledMethod put: #writeMethod:.
	writeDict at: Process put: #writeProcess:.
	writeDict at: MethodContext put: #writeContext:.
	writeDict at: BlockContext put: #writeContext:.! !
!SystemTracer methodsFor: 'mapping oops'!
hasNoSmallIntegerClamped: obj
	^ (self mapAt: obj) = Clamped! !
!SystemTracer methodsFor: 'mapping oops'!
initOopMap
	"oopMap is an array 4096 long indexed by basicHash.
	Each element a subarray of object/newOop/hash triplets.
	The subarrrays must be linearly searched.
	Access to an object causes it to be promoted in the subarray,
		so that frequently accessed objects can be found quickly."
	oopMap _ (1 to: 4096) collect: [:i | Array new].
	validOops _ IdentitySet new: 250000.

	"replacementClasses is a simple Dictionary to contain pairs of classes (well, globals should work actually) where the key is a class being replaced and the value is the replacement class"
	replacementClasses _ Dictionary new! !
!SystemTracer methodsFor: 'mapping oops'!
mapAt: obj put: oop with: hash
	"Assign the new oop for this object"
	| bucket |
	bucket _ oopMap at: obj identityHash+1.

	"Check for multiple writes (debug only)"
"	1 to: bucket size by: 3 do: 
		[:i | obj == (bucket at: i) ifTrue: [self halt]].
"
	oopMap at: obj identityHash+1 put: (Array with: obj with: oop with: hash) , bucket.
	validOops add: oop! !
!SystemTracer methodsFor: 'private'!
permutationFor: array useIdentity: useIdentity
	"Return an inverse permutation for an array to permute it according to
	the mapped oop values. The keys in array MUST have been mapped."
	| len perm key hash |
	len _ array basicSize.  
	perm _ Array new: len.
	1 to: len do:
		[:i | key _ array basicAt: i.
		(key == nil or: [self hasNoSmallIntegerClamped: key])
		  ifFalse:
			[hash _ (useIdentity or: [key class = Symbol])
					ifTrue: [key identityHashMappedBy: self]
					ifFalse: [key hashMappedBy: self].
			hash _ hash \\ len + 1.
			[(perm at: hash) == nil] 
				whileFalse:
				[hash _ (hash = len ifTrue: [1] ifFalse: [hash + 1])].
			perm at: hash put: i]].
	^ perm! !
!SystemTracer methodsFor: 'private'!
writePointerField: obj 
	| newOop |
	obj class == SmallInteger ifTrue: 
		[obj >= 0 ifTrue: [newOop _ obj * 2 + 1]
				ifFalse: [newOop _ (16r80000000 + obj) * 2 + 1].
		self write4Bytes: newOop.
		^ obj].		

	"normal pointers"
	(newOop _ self mapAt: obj) = Clamped
		ifTrue: ["If object in this field is not being traced, put out nil."
				self write4Bytes: NewNil]
		ifFalse: [(validOops includes: newOop) ifFalse: [self halt]. self write4Bytes: newOop]! !
!SystemTracer class methodsFor: 'instance creation'!
writeClone  "SystemTracer writeClone"
	| tracer |
	tracer _ self new.
	"Delay shutDown."  "part of Smalltalk processShutDownList."
	Symbol useHardSymbolTable.
	tracer doit.   " <-- execution in clone resumes after this send"
	tracer == nil "will be nil in clone, since it is clamped"
		ifTrue: [Smalltalk processStartUpList: true.
				Symbol useWeakSymbolTable.
				"Set allInstances do: [:s | s rehash]."
				"Dictionary allInstances do: [:s | s rehash]."
		].
	^ tracer! !