SqueakLight or SqueakDiet ?( Was: Re: Minimal Image)

Lic. Edgar J. De Cleene edgardec2001 at yahoo.com.ar
Thu Feb 13 10:22:21 UTC 2003


1 Load a fresh image.

ftp://st.cs.uiuc.edu/Smalltalk/Squeak/3.4gamma/Squeak3.4gammaOne.zip seems
the most recent.

2 load VHUtilities.st from Goran. I attach a old version what he kinly send
me.
>From comment for VHUtilities stripAndSave

"Strip and save image as squeak.image and quits.
    Before this do:
    - Save your development image so that nothing is lost.
    - Clean away stray Processes with Processbrowser
    - Turn off CPU watcher
    - Remove all windows from screen.
    - Destroy all global flaps.
    - Make sure Undeclared is empty
    - Make sure Preferences are OK"
I do the following change. "VHUtilities cleanup.". I don't think you have
Virtual Home . (Why yo stop thois Goran ?)

3 tyoe Undeclared removeUnreferencedKeys in a Workspace . Select with mouse
and choose do it from menu.

4 VHUtilities stripAndSave and do it
5 Here I have a halt and  have to do following change.

"Check for Undeclared
Undeclared isEmpty
ifFalse: [self error:'Please clean out Undeclared']. "

6 Filein DoCleaning.st
In a Workspace do the following.

DoCleaning removeCategories: 'SUnit*'.
DoCleaning removeCategories: 'Genie*'
DoCleaning removeCategories: 'Star*'
DoCleaning removeCategories: 'XML*'
DoCleaning removeCategories: 'FFI-Examples*

7 save this.
I test with my own projects and with a little problems , all works.
Its all Goran credits if works and my not enough understand if not.

Sure this can improve in a unique script.

I vote for this image are nemed Squeak 3.4Light or Squeak 3.4Diet, until we
have the marvellous Alejandro Raimondo work for all systems. I have Mac and
still waiting outside in the cold.

Edgar

-------------- next part --------------
'From Squeak3.2 of 11 July 2002 [latest update: #4956] on 18 September 2002 at 09:05:35'!
Object subclass: #VHUtilities
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'VH-development'!
!VHUtilities commentStamp: '<historical>' prior: 0!
VHUtilities is a class used for "loose methods". If you have code that you do not know where to put - this might be a good place. :-) Also - if you have extensions to base classes that you want to keep within the VirtualHome classes you can place those here too.

Currently there are methods here for stripping and packaging and a few methods for starting/stopping a few testclients and servers.!


"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

VHUtilities class
	instanceVariableNames: ''!

!VHUtilities class methodsFor: 'documentation' stamp: 'gh 1/7/2002 11:09'!
startLocalClient
	"Start a local client on the local testserver."

	"VHUtilities startLocalClient"

	(VHBookmarkManagerModel server: 'localhost') openAsMorph! !

!VHUtilities class methodsFor: 'documentation' stamp: 'J… 4/24/2002 12:11'!
startLocalClientAtPort: aPort
	"Start a local client on the local testserver."

	"VHUtilities startLocalClient"

	(VHBookmarkManagerModel server: 'localhost' port: aPort) openAsMorph! !

!VHUtilities class methodsFor: 'documentation' stamp: 'gh 1/7/2002 10:55'!
startLocalServer
	"Start the local server with a bit of faked data in it."

	"VHUtilities startLocalServer"

	VHTestBtpServer setUp: (VHTestBookmarkStructure fillManager: VHServerBookmarkManager new)! !

!VHUtilities class methodsFor: 'documentation' stamp: 'gh 1/7/2002 12:51'!
startLocalServerFromFile
	"Start the local server and read in data from an old logfile."

	"VHUtilities startLocalServerFromFile"

	| fileName |
	fileName _ FillInTheBlank request: 'Enter name of logfile'  initialAnswer: 'bookmarks.1'.
	VHTestBtpServer setUp: (VHServerBookmarkManager new: 'bookmarksnew' from: fileName)! !

!VHUtilities class methodsFor: 'documentation' stamp: 'gh 1/7/2002 10:55'!
stopLocalServer
	"Stop the local testserver."

	"VHUtilities stopLocalServer"

	VHTestBtpServer tearDown! !


!VHUtilities class methodsFor: 'stripping' stamp: 'gh 5/7/2002 16:56'!
cleanup
	"Stop everything running."
	
	"clean up server"
	| instances |
	VHServer singleton ifNotNil: [VHServer singleton stop].
	VHServer clearSingleton.
	ComancheService services do: [:s | s stop; unregister].
	Smalltalk garbageCollect.
	ComancheService services isEmpty ifFalse:[self error: 'Services left!!'].
	Socket allInstances isEmpty ifFalse:[self error: 'Sockets left!!'].
	instances _ Set new.
	Smalltalk allClassesDo: [:c | (c name beginsWith: 'VH') ifTrue:[
	c allInstances size > 0 ifTrue:[instances addAll: c allInstances]]].
	instances size > 0 ifTrue:[ instances explore. self error: 'VH instances left!!']
! !

!VHUtilities class methodsFor: 'stripping' stamp: 'gh 5/14/2002 15:23'!
strip
	"Strip down the image quite a bit.
	This method removes all Projects, Flaps, ChangeSets and
	various parts of the class library.
	It seems to be able to bring a 3.2gamma-4743 down to about 6Mb
	and still being able to work in the image. Read on:
		http://minnow.cc.gatech.edu/squeak/2182
	for even more tricks."


"Remove freaky classes"
 | collection |
  collection := OrderedCollection new.
  Smalltalk associationsDo:
    [:assoc | (assoc key class == Symbol)
               ifFalse: [collection add: assoc key]].
  collection do:
      [:k | Smalltalk removeKey: k].

"delete global flaps and delete the example projects manually."

"make sure the current project is the topmost project"
Project current setParent: Project current.

"remove changes files"
ChangeSorter removeChangeSetsNamedSuchThat: [:aName | aName first isDigit].

Project allSubInstancesDo:[:p|
(p == Project current) ifFalse:[Project deletingProject: p].
].

"Fix up for some historical problem"
Smalltalk allObjectsDo:[:o|
o isMorph ifTrue:[o removeProperty: #undoGrabCommand].
].
"Remove stuff from References"
References keys do:[:k| References removeKey: k].

"Reset command history"
CommandHistory resetAllHistory.

"Clean out Undeclared"
Undeclared removeUnreferencedKeys.

"Reset scripting system"
StandardScriptingSystem initialize.

"Reset preferences"
Preferences initialize.

"Do a nice fat GC"
Smalltalk garbageCollect.

"Dependents mean that we're holding onto stuff"
(Object classPool at: #DependentsFields) size > 1
ifTrue: [self error:'Still have dependents'].

"Initialize Browser (e.g., reset recent classes etc)"
Browser initialize.

"Check for Undeclared"
Undeclared isEmpty
ifFalse: [self error:'Please clean out Undeclared'].

"Remove graphics we don't want"
ScriptingSystem deletePrivateGraphics.

"Remove a few text styles"
#(Helvetica Palatino Courier) do:
[:n | TextConstants removeKey: n ifAbsent: []].

"Dump all player uniclasses"
Smalltalk at: #Player ifPresent:[:player|
player allSubclassesDo:[:cls|
cls isSystemDefined ifFalse:[cls removeFromSystem]]].

"Dump all Wonderland uniclasses"
Smalltalk at: #WonderlandActor ifPresent:[:wnldActor|
wnldActor allSubclassesDo:[:cls|
cls isSystemDefined ifFalse:[cls removeFromSystem]]].

"Attempt to get rid of them"
Smalltalk garbageCollect.

"Now remove larger parts"
Smalltalk discard3D;
	discardFlash;
	discardIRC;
	discardMIDI;
	discardMVC;
	discardPWS;
	discardPluggableWebServer;
	discardSoundAndSpeech;
	discardSoundSynthesis;
	discardSpeech;
	discardTrueType;
	discardVMConstruction;
	discardWonderland.
"SystemOrganization removeSystemCategory: 'Morphic-Experimental'."
SystemOrganization removeSystemCategory: 'Morphic-Games'.
Smalltalk at: #Wonderland ifPresent:[:cls| cls removeActorPrototypesFromSystem].
Player freeUnreferencedSubclasses.
Player abandonUnnecessaryUniclasses.
MorphicModel removeUninstantiatedModels.
Utilities classPool at: #ScrapsBook put: nil.
Utilities zapUpdateDownloader.
ProjectHistory currentHistory initialize.
Project rebuildAllProjects.

"Dump all change sets"
ChangeSet allInstancesDo: [:cs | cs zapHistory].
ChangeSorter removeChangeSetsNamedSuchThat:
[:cs| cs name ~= Smalltalk changes name].
ChangeSorter classPool at: #AllChangeSets
put: (OrderedCollection with: Smalltalk changes).
ChangeSorter initializeChangeSetCategories.

"Clear current change set"
Smalltalk changes clear.
Smalltalk changes name: 'Unnamed1'.
Smalltalk garbageCollect.

"Reinitialize DataStream; it may hold on to some zapped entitities"
DataStream initialize.
Smalltalk garbageCollect.

"Remove refs to old ControlManager"
ScheduledControllers _ nil.

"Flush obsolete subclasses"
Behavior flushObsoleteSubclasses.
Smalltalk garbageCollect.
"Smalltalk obsoleteBehaviors isEmpty
ifFalse:[self error:'Still have obsolete behaviors']."

3 timesRepeat: [
Smalltalk garbageCollect.
Symbol compactSymbolTable.
].
! !

!VHUtilities class methodsFor: 'stripping' stamp: 'gh 5/14/2002 15:37'!
stripAndSave
	"Strip and save image as squeak.image and quits.
	Before this do:
	- Save your development image so that nothing is lost.
	- Clean away stray Processes with Processbrowser
	- Turn off CPU watcher
	- Remove all windows from screen.
	- Destroy all global flaps.
	- Make sure Undeclared is empty
	- Make sure Preferences are OK"

	"VHUtilities stripAndSave"
	
	VHUtilities cleanup.
	VHUtilities strip.
	Smalltalk
		abandonTempNames;
		changeImageNameTo: (FileDirectory default fullNameFor: 'squeak.image');
		closeSourceFiles; openSourceFiles;  "so SNAPSHOT appears in new changes file"
		snapshot: true andQuit: true! !
-------------- next part --------------
Object subclass: #DoCleaning
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'CleanImage'!

!DoCleaning methodsFor: 'as yet unclassified'!
removeCategories: t1 
	| t2 t3 t4 |
	t3 _ SystemOrganization categoriesMatching: t1.
	t2 _ Smalltalk garbageCollect.
	t3
		do: [:t5 | SystemOrganization removeSystemCategory: t5].
	t3 _ nil.
	Smalltalk garbageCollect.
	(Association allSubInstances
		select: [:t6 | (t6 key isMemberOf: Symbol)
				and: [(t6 key beginsWith: 'SUnit')
						and: [t6 key endsWithDigit]]])
		do: [:t6 | 
			t4 _ t6 value.
			(t4 isKindOf: self class)
				ifTrue: [t4 superclass addSubclass: t4.
					Smalltalk add: t6]].
	(Metaclass allInstances
		select: [:t7 | (t7 soleInstance name beginsWith: 'Player')
				and: [t7 soleInstance name endsWithDigit]])
		do: [:t7 | 
			t4 _ t7 soleInstance.
			((t4 isKindOf: self class)
					and: [(Smalltalk includesKey: t4 name) not])
				ifTrue: [self addSubclass: t4.
					Smalltalk at: t4 name put: t4]].
	SystemOrganization removeMissingClasses.
	^ Smalltalk garbageCollect - t2! !


More information about the Squeak-dev mailing list