'From Cuis 1.0 of 28 November 2009 [latest update: #337] on 7 December 2009 at 10:09:38 pm'!

!Utilities class methodsFor: 'closure support' stamp: 'ar 7/15/2009 22:27'!
compileUsingClosures	"Utilities compileUsingClosures"
	"Recompile the system and do some minimal clean-ups"
	| classes compilationErrors |
	Preferences setPreference: #allowBlockArgumentAssignment toValue: true.
	compilationErrors := Set new.
	classes := Smalltalk forgetDoIts allClasses reject: [:c| c name == #GeniePlugin].

	'Recompiling The System' displayProgressAt: Sensor cursorPoint
		from: 0 to: classes size during:[:bar |
			classes withIndexDo:[:c :i|
				bar value: i.
				{ c. c class } do:[:b|
					"Transcript cr; print: b; endEntry."
					b selectors "asSortedCollection" do:[:s| 
						"Transcript cr; show: b asString, '>>', s."
						[b recompile: s from: b] on: Error do:[:ex|
							Transcript
								cr; nextPutAll: 'COMPILATION ERROR: ';
								print: b; nextPutAll: '>>'; nextPutAll: s; flush.
							compilationErrors add: (MethodReference class: b selector: s)]]]]].

	(Smalltalk respondsTo: #allTraits) ifTrue:[
		'Recompiling Traits' displayProgressAt: Sensor cursorPoint
		from: 0 to: Smalltalk allTraits size during:[:bar |
			Smalltalk allTraits do:[:t|
				t selectors do:[:s|
					[t recompile: s] on: Error do:[:ex|
							Transcript
								cr; nextPutAll: 'COMPILATION ERROR: ';
								print: t; nextPutAll: '>>'; nextPutAll: s; flush.
							compilationErrors add: (MethodReference class: t selector: s)]]]]].

	compilationErrors notEmpty ifTrue:[
		SystemNavigation default
			browseMessageList: compilationErrors asSortedCollection
			name: 'Compilation Errors'].! !

!Utilities class methodsFor: 'closure support' stamp: 'nice 10/20/2009 20:17'!
initializeClosures	"Utilities initializeClosures"
	"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].
	"Remove unused class vars from CompiledMethod since we can't redefine its class definition directly. Add the new BlockClosure to the specialObjectsArray"
	(#(	BlockNodeCache MethodProperties SpecialConstants) 
			intersection: CompiledMethod classPool keys asSet) 
				do:[:classVarName| CompiledMethod removeClassVarName: classVarName].
	Smalltalk recreateSpecialObjectsArray.
	"Recompile methods in ContextPart, superclasses and subclasses that access inst vars"
	ContextPart withAllSuperclasses, ContextPart allSubclasses asArray do:[:class|
		class instSize > 0 ifTrue:[
			class allInstVarNames do:[:ivn|
				(class whichSelectorsAccess: ivn) do:[:sel| class recompile: sel]]]]! !

!Utilities class methodsFor: 'closure support' stamp: 'ar 7/13/2009 21:10'!
postRecompileCleanup	"Utilities postRecompileCleanup"
	"Cleanup after loading closure bootstrap"
	| unboundMethods contexts |
	ProcessorScheduler startUp.
	WeakArray restartFinalizationProcess.
	MethodChangeRecord allInstancesDo:[:x| x noteNewMethod: nil].
	Undeclared removeUnreferencedKeys.
	Delay startTimerEventLoop.
	EventSensor install.
	WorldState allInstancesDo:[:ws| ws convertAlarms; convertStepList].
	(Workspace canUnderstand: #initializeBindings) 
		ifTrue:[Workspace allInstancesDo:[:ws| ws initializeBindings]].
	ExternalDropHandler initialize.
	ScrollBar initializeImagesCache.
	Vocabulary initialize.
	Smalltalk garbageCollect.
	GradientFillStyle initPixelRampCache.
	Smalltalk at: #ServiceGui ifPresent:[:sg| sg initialize].
	Smalltalk
		at: #SokobanMorph
		ifPresent: [:sm| sm initFields].
	Smalltalk
		at: #DebuggerMethodMap
		ifPresent: [:dmm| dmm voidMapCache].
	Smalltalk
		at: #KClipboard
		ifPresent: [:kcb| kcb clearDefault].
	Smalltalk
		at: #ServiceRegistry
		ifPresent: [:sr| sr rebuild].
	(ProcessBrowser respondsTo: #registerWellKnownProcesses) ifTrue:
		[ProcessBrowser registerWellKnownProcesses].
	Smalltalk
		at: #DebuggerMethodMap
		ifPresent: [:dmm| dmm voidMapCache].
	Smalltalk at: #ServiceRegistry ifPresent:[:cls| cls rebuild].
	Smalltalk forgetDoIts.
	Smalltalk garbageCollect.
	unboundMethods := CompiledMethod allInstances select:[:m|
		m methodClass isNil or: [m ~~ (m methodClass compiledMethodAt: m selector ifAbsent: nil)]].
	unboundMethods := unboundMethods reject:[:m| m selector isDoIt].
	unboundMethods notEmpty ifTrue:
		[(ToolSet inspect: unboundMethods) setLabel: 'Unbound Methods'].
	contexts := BlockContext allInstances.
	contexts ifNotEmpty:[contexts inspect. self inform: 'There are left-over BlockContexts'].
	(unboundMethods isEmpty and:[contexts isEmpty]) ifTrue:[
		self inform:'Congratulations - The bootstrap is now complete.'.
	].
! !

