'From Cuis 1.0 of 28 November 2009 [latest update: #337] on 8 December 2009 at 11:15:31 pm'!

!ClassBuilder methodsFor: 'private' stamp: 'eem 7/21/2008 14:16'!
tooDangerousClasses
	"Return a list of class names which will not be modified in the public interface"
	^#(
		"Object will break immediately"
		ProtoObject Object
		"Contexts and their superclasses"
		InstructionStream ContextPart BlockContext MethodContext BlockClosure
		"Superclasses of basic collections"
		Collection SequenceableCollection ArrayedCollection
		"Collections known to the VM"
		Array Bitmap String Symbol ByteArray CompiledMethod TranslatedMethod
		"Basic Numbers"
		Magnitude Number SmallInteger Float
		"Misc other"
		LookupKey Association Link Point Rectangle Behavior PositionableStream UndefinedObject
	)
! !


!ContextVariablesInspector methodsFor: 'accessing' stamp: 'ar 4/11/2006 02:33'!
inspect: anObject 
	"Initialize the receiver so that it is inspecting anObject. There is no 
	current selection.
	
	Because no object's inspectorClass method answers this class, it is OK for this method to
	override Inspector >> inspect: "
	fieldList := nil.
	object := anObject.
	self initialize.
	! !


!ImageSegment methodsFor: 'read/write segment' stamp: 'jmv 12/8/2009 23:15'!
copySmartRootsExport: rootArray 
	"Use SmartRefStream to find the object.  Make them all roots.  Create the segment in memory.  Project should be in first five objects in rootArray."
	| newRoots list segSize symbolHolder dummy replacements naughtyBlocks goodToGo allClasses sizeHint proj |
	Smalltalk forgetDoIts.

	"self halt."
	symbolHolder := Symbol allSymbols.	"Hold onto Symbols with strong pointers, 
		so they will be in outPointers"

	dummy := ReferenceStream on: (DummyStream on: nil).
		"Write to a fake Stream, not a file"
	"Collect all objects"
	dummy insideASegment: true.	"So Uniclasses will be traced"
	dummy rootObject: rootArray.	"inform him about the root"
	dummy nextPut: rootArray.
	(proj :=dummy project) ifNotNil: [self dependentsSave: dummy].
	allClasses := SmartRefStream new uniClassInstVarsRefs: dummy.
		"catalog the extra objects in UniClass inst vars.  Put into dummy"
	allClasses do: [:cls | 
		dummy references at: cls class put: false.	"put Player5 class in roots"
		dummy blockers removeKey: cls class ifAbsent: []].
	"refs := dummy references."
	arrayOfRoots := self smartFillRoots: dummy.	"guaranteed none repeat"
	self savePlayerReferences: dummy references.	"for shared References table"
	replacements := dummy blockers.
	dummy project "recompute it" ifNil: [self error: 'lost the project!!'].
	dummy project class == DiskProxy ifTrue: [self error: 'saving the wrong project'].
	dummy := nil.	"force GC?"
	naughtyBlocks := arrayOfRoots select: [ :each |
		(each isKindOf: ContextPart) and: [each hasInstVarRef]
	].

	"since the caller switched ActiveWorld, put the real one back temporarily"
	naughtyBlocks isEmpty ifFalse: [
		World becomeActiveDuring: [
			goodToGo := (PopUpMenu
				withCaption:
'Some block(s) which reference instance variables 
are included in this segment. These may fail when
the segment is loaded if the class has been reshaped.
What would you like to do?'
				chooseFrom: #('keep going' 'stop and take a look')) == 1.
			goodToGo ifFalse: [
				naughtyBlocks inspect.
				self error: 'Here are the bad blocks'].
		].
	].
	"Creation of the segment happens here"

	"try using one-quarter of memory min: four megs to publish (will get bumped later)"
	sizeHint := (Smalltalk garbageCollect // 4 // 4) min: 1024*1024.
	self copyFromRoots: arrayOfRoots sizeHint: sizeHint areUnique: true.
	segSize := segment size.
	[(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [
		arrayOfRoots := newRoots.
		self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true].
		"with methods pointed at from outside"
	[(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [
		arrayOfRoots := newRoots.
		self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true].
		"with methods, blocks from outPointers"
	list := self compactClassesArray.
	outPointers := outPointers, ((list select: [:cls | cls ~~ nil]), (Array with: 1717 with: list)).
	1 to: outPointers size do: [:ii | 
		(outPointers at: ii) isBlock ifTrue: [outPointers at: ii put: nil].
		(outPointers at: ii) class == MethodContext ifTrue: [outPointers at: ii put: nil].
		"substitute new object in outPointers"
		(replacements includesKey: (outPointers at: ii)) ifTrue: [
			outPointers at: ii put: (replacements at: (outPointers at: ii))]].
	proj ifNotNil: [self dependentsCancel: proj].
	symbolHolder.! !


!UpdatingMenuItemMorph methodsFor: 'enablement' stamp: 'eem 7/21/2008 12:07'!
enablementSelector: aSelector 
	enablementSelector := aSelector isBlock 
				ifTrue: [aSelector copyForSaving]
				ifFalse: [aSelector] ! !

"Postscript:
Eliminate the prototype BlockContext from the specialObjectsArray.  The VM doesn't use it.
This paves the way for removing BlockCOntext altogether and merging ContextPart and
MethodContext into e.g. Context."
(Smalltalk specialObjectsArray at: 38) class == BlockContext ifTrue:
	[Smalltalk specialObjectsArray at: 38 put: nil]!

