slimming the image

Tim Rowledge tim at sumeru.stanford.edu
Fri Aug 11 20:07:09 UTC 2000


Attached is a tidyup of the shrink code (mainly folding the stuff in
discardFor2.7 back to the'right' places) thats shrinks a 2.8 image to
~930Kb.

tim
-- 
Tim Rowledge, tim at sumeru.stanford.edu, http://sumeru.stanford.edu/tim
..... REALITY.SYS Corrupted - Unable to recover Universe
-------------- next part --------------
'From Squeak2.8 of 30 June 2000 [latest update: #2348] on 10 August 2000 at 11:11:14 pm'!


!SystemDictionary methodsFor: 'shrinking' stamp: 'TPR 8/5/2000 00:56'!
discard3D
	"Discard 3D Support.
Updated for 2.8 TPR"

	Smalltalk removeKey: #WonderlandConstants ifAbsent: [].
	Smalltalk removeKey: #AliceConstants ifAbsent: [].
	Smalltalk removeKey: #B3DEngineConstants ifAbsent: [].
	SystemOrganization removeCategoriesMatching: 'Morphic-Balloon3D'.
	SystemOrganization removeCategoriesMatching: 'Balloon3D-*'.
	SystemOrganization removeCategoriesMatching: 'Pooh-*'

! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'TPR 8/10/2000 05:21'!
discardFFI
	"Discard the complete foreign function interface.
	NOTE: Recreates specialObjectsArray to prevent obsolete references. Has to specially remove external structure hierarchy before ExternalType"

	(ChangeSet superclassOrder: ExternalStructure withAllSubclasses asArray) reverseDo: 
		[:c | c removeFromSystem].
	SystemOrganization removeCategoriesMatching: 'FFI-*'.
	Smalltalk recreateSpecialObjectsArray.! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'TPR 8/5/2000 01:32'!
discardFlash
	"Discard Flash support."

	SystemOrganization removeCategoriesMatching: 'Balloon-MMFlash*'
! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'TPR 8/3/2000 23:36'!
discardMVC
   "Smalltalk discardMVC"

	| keepers |
	Smalltalk isMorphic ifFalse:
		[PopUpMenu notify: 'You must be in a Morphic project to discard MVC.'.
		^ self].
	"Check that there are no MVC Projects"
	(Project allInstances inject: true into: [:ok :proj | ok & proj isMorphic]) ifFalse:
		[(self confirm: 'Would you like a chance to remove your
MVC projects in an orderly manner?')
					ifTrue: [^ self].
		(self confirm: 'If you wish, I can remove all MVC projects,
make this project be the top project, and place
all orphaned sub-projects of MVC parents here.
Would you like be to do this
and proceed to discard all MVC classes?')
					ifTrue: [self zapMVCprojects]
					ifFalse: [^ self]].
	Smalltalk reclaimDependents.

	"Remove old Paragraph classes and View classes."
	(ChangeSet superclassOrder: Paragraph withAllSubclasses asArray) reverseDo: 
		[:c | c removeFromSystem].
	(ChangeSet superclassOrder: View withAllSubclasses asArray) reverseDo: 
		[:c | c removeFromSystem].

	"Get rid of ParagraphEditor's ScrollController dependence"
	#(markerDelta viewDelta scrollAmount scrollBar computeMarkerRegion) do:
			[:sel | ParagraphEditor removeSelector: sel].
	ParagraphEditor compile: 'updateMarker'.
	ParagraphEditor superclass: MouseMenuController .

	"Get rid of all Controller classes not needed by ParagraphEditor and ScreenController"
	keepers _ TextMorphEditor withAllSuperclasses copyWith: ScreenController.
	(ChangeSet superclassOrder: Controller withAllSubclasses asArray) reverseDo: 
		[:c | (keepers includes: c) ifFalse: [c removeFromSystem]].

	SystemOrganization removeCategoriesMatching: 'ST80-Paths'.
	SystemOrganization removeCategoriesMatching: 'ST80-Pluggable Views'.

	Smalltalk removeClassNamed: 'FormButtonCache'.
	Smalltalk removeClassNamed: 'WindowingTransformation'.
	Smalltalk removeClassNamed: 'ControlManager'.
	Smalltalk removeClassNamed: 'DisplayTextView'.

	ScheduledControllers _ nil.
	Undeclared removeUnreferencedKeys.
	SystemOrganization removeEmptyCategories.
	Symbol rehash.
! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'TPR 8/5/2000 01:33'!
discardMorphic
   "Smalltalk discardMorphic"
	"Discard Morphic.
Updated for 2.8 TPR"

	| subs |
	"Check that we are in an MVC Project and that there are no Morphic Projects
		or WorldMorphViews."
	Utilities clobberFlapTabList.
	Smalltalk discardFlash.
	Smalltalk discardTrueType.
	subs _ OrderedCollection new.
	Morph allSubclassesWithLevelDo: [:c :i | subs addFirst: c]
		startingLevel: 0.
	subs do: [:c | c removeFromSystem].
	Smalltalk removeKey: #BalloonEngineConstants ifAbsent: [].
	SystemOrganization removeCategoriesMatching: 'Balloon-*'.
	SystemOrganization removeCategoriesMatching: 'Morphic-*'.
	SystemOrganization removeSystemCategory: 'Graphics-Transformations'.
	SystemOrganization removeSystemCategory: 'ST80-Morphic'.

! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'TPR 8/3/2000 19:48'!
discardNetworking
	"Discard the support for TCP/IP networking."

	Smalltalk discardPluggableWebServer.
	SystemOrganization removeCategoriesMatching: 'Network-*'.

! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'TPR 8/10/2000 23:11'!
discardOddsAndEnds
	"This method throws out lots of classes that are not frequently used."
	"Smalltalk discardOddsAndEnds"

	SystemOrganization removeSystemCategory: 'System-Serial Port'.
	SystemOrganization removeSystemCategory: 'ST80-Symbols'.
	SystemOrganization removeSystemCategory: 'Tools-File Contents Browser'.
	SystemOrganization removeSystemCategory: 'System-Compression'.
	SystemOrganization removeSystemCategory: 'Tools-Explorer'.
	SystemOrganization removeSystemCategory: 'System-Digital Signatures'.

	Form removeSelector: #edit.
	Smalltalk at: #FormView ifPresent:
		[:c | c compile: 'defaultControllerClass  ^ NoController'
			classified: 'controller access'].
	Smalltalk removeClassNamed: #FormEditorView.
	Smalltalk removeClassNamed: #FormEditor.
	SystemOrganization removeSystemCategory: 'ST80-Paths'.

	"bit editor (remove Form editor first):"
	Form removeSelector: #bitEdit.
	Form removeSelector: #bitEditAt:scale:.
	StrikeFont removeSelector: #edit:.
	Smalltalk removeClassNamed: #FormButtonCache.
	Smalltalk removeClassNamed: #FormMenuController.
	Smalltalk removeClassNamed: #FormMenuView.
	Smalltalk removeClassNamed: #BitEditor.

	"inspector for Dictionaries of Forms"
	Dictionary removeSelector: #inspectFormsWithLabel:.
	SystemDictionary removeSelector: #viewImageImports.
	ScreenController removeSelector: #viewImageImports.
	Smalltalk removeClassNamed: #FormHolderView.
	Smalltalk removeClassNamed: #FormInspectView.

	"experimental hand-drawn character recoginizer:"
	ParagraphEditor removeSelector: #recognizeCharacters.
	ParagraphEditor removeSelector: #recognizer:.
	ParagraphEditor removeSelector: #recognizeCharactersWhileMouseIn:.
	Smalltalk removeClassNamed: #CharRecog.

	"experimental updating object viewer:"
	Object removeSelector: #evaluate:wheneverChangeIn:.
	Smalltalk removeClassNamed: #ObjectViewer.
	Smalltalk removeClassNamed: #ObjectTracer.

	"miscellaneous classes:"
	Smalltalk removeClassNamed: #Array2D.
	Smalltalk removeClassNamed: #DriveACar.
	Smalltalk removeClassNamed: #EventRecorder.
	Smalltalk removeClassNamed: #FindTheLight.
	Smalltalk removeClassNamed: #PluggableTest.
	Smalltalk removeClassNamed: #SystemMonitor.
	Smalltalk removeClassNamed: #DocLibrary.

	Smalltalk removeClassNamed: #ProtocolBrowser.
	Smalltalk removeClassNamed: #ObjectExplorerWrapper.
	Smalltalk removeClassNamed: #HierarchyBrowser.
	Smalltalk removeClassNamed: #LinkedMessageSet.
	Smalltalk removeClassNamed: #ObjectExplorer.
	Smalltalk removeClassNamed: #PackageBrowser.
	Smalltalk removeClassNamed: #AbstractHierarchicalList.
	Smalltalk removeClassNamed: #ChangeList.
	Smalltalk removeClassNamed: #VersionsBrowser.
	Smalltalk removeClassNamed: #ChangeRecord.
	Smalltalk removeClassNamed: #SelectorBrowser.

	Smalltalk at: #SampledSound ifPresent: [:c |c initialize].
	#(Helvetica Palatino Courier ComicBold ComicPlain) do:
		[:k | TextConstants removeKey: k ifAbsent: []].

Preferences setButtonFontTo:	(StrikeFont familyName: #NewYork size: 12).
Preferences setFlapsFontTo:	(StrikeFont familyName: #NewYork size: 12).

#(GZipConstants ZipConstants KlattResonatorIndices ) do:
	[:k | Smalltalk removeKey: k ifAbsent: []].
! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'TPR 8/3/2000 19:43'!
discardPluggableWebServer
	"Discard the Pluggable Web Server."

	SystemOrganization removeCategoriesMatching: 'Network-PluggableWebServer'.
! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'TPR 8/3/2000 19:21'!
discardSoundSynthesis
	"Discard the sound synthesis facilities, and the methods and classes that use it. This also discards MIDI."

	Smalltalk discardMIDI.
	Smalltalk discardSpeech.
	SystemOrganization removeCategoriesMatching: 'Sound-Interface'.
	Smalltalk at: #GraphMorph ifPresent: [:graphMorph |
		#(playOnce readDataFromFile)
			do: [:sel | graphMorph removeSelector: sel]].
	Smalltalk at: #TrashCanMorph ifPresent: [:trashMorph |
		trashMorph class removeSelector: #samplesForDelete.
		trashMorph class removeSelector: #samplesForMouseEnter.
		trashMorph class removeSelector: #samplesForMouseLeave].
	SystemOrganization removeCategoriesMatching: 'Sound-Synthesis'.
	SystemOrganization removeCategoriesMatching: 'Sound-Scores'.
! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'TPR 8/3/2000 19:21'!
discardSpeech
	"Discard support for speech synthesis"

	SystemOrganization removeCategoriesMatching: 'Speech*'.
! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'TPR 8/5/2000 01:32'!
discardTrueType
	"Discard TrueType support."

	SystemOrganization removeCategoriesMatching: 'Balloon-TrueType*'.

! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'TPR 8/5/2000 00:55'!
discardVMConstruction
	"Discard the virtual machine construction classes and the Smalltalk-to-C translator. These are only needed by those wishing to build or study the Squeak virtual machine, or by those wishing to construct new primitives via Smalltalk-to-C translation.
Updated to suit 2.8 TPR"

	"remove the code for virtual machines"
	Smalltalk removeKey: #InterpreterLog ifAbsent: [].

	"remove the Smalltalk-to-C translator"
	Smalltalk at: #CCodeGenerator ifPresent: [:codeGen | codeGen removeCompilerMethods].
	SystemOrganization removeCategoriesMatching: 'VMConstruction-*'.
	SystemOrganization removeCategoriesMatching: 'Squeak-Plugins'.
! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'TPR 8/4/2000 00:27'!
majorShrink    "Smalltalk majorShrink; abandonSources; lastRemoval"
	"This method throws out lots of the system that is not needed for, eg, operation in a hand-held PC.  Currently, since it discards Morphic, majorShrink must be run in an MVC project.  Moreover, since it throws out projects, it shouod be run in the top (and only) project.  majorShrink altogether saves about 5,620k in Squeak 2.4"

"First delete all the PlayWithMe windows and projects, and the class Component1"

	Wonderland removeActorPrototypesFromSystem.
	Player freeUnreferencedSubclasses.
	MorphicModel removeUninstantiatedModels.
	Utilities classPool at: #ScrapsBook put: nil.

	Smalltalk discardVMConstruction.  "666k"
	Smalltalk discardSoundSynthesis.  "358k"
	Smalltalk discardOddsAndEnds.  "158k"
	Smalltalk discardNetworking.  "243k"
	Smalltalk discard3D.
	Smalltalk discardFFI. 
	Smalltalk discardMorphic.  "2,494k"
	Symbol rehash.  "40k"
	"Above by itself saves about 3,960k"

"
	| a | a _ Smalltalk garbageCollect.
	Smalltalk majorShrink.
	Smalltalk garbageCollect - a
"
	"Remove references to a few classes to be deleted, so that they won't leave obsolete versions around."
	FileList removeSelector: #fileIntoNewChangeSet.
	ChangeSet class compile: 'defaultName
		^ ''Changes'' ' classified: 'initialization'.
	ScreenController removeSelector: #openChangeManager.
	ScreenController removeSelector: #exitProject.
	ScreenController removeSelector: #openProject.
	ScreenController removeSelector: #viewImageImports.

	"Now delete lots of classes.."
	SystemOrganization removeSystemCategory: 'Graphics-Files'.
	SystemOrganization removeSystemCategory: 'System-Object Storage'.
	Smalltalk removeClassNamed: #ProjectController.
	Smalltalk removeClassNamed: #ProjectView.
	"Smalltalk removeClassNamed: #Project."
	Smalltalk removeClassNamed: #Environment.
	Smalltalk removeClassNamed: #Component1.

	Smalltalk removeClassNamed: #FormSetFont.
	Smalltalk removeClassNamed: #FontSet.
	Smalltalk removeClassNamed: #InstructionPrinter.
	Smalltalk removeClassNamed: #ChangeSorter.
	Smalltalk removeClassNamed: #DualChangeSorter.
	Smalltalk removeClassNamed: #EmphasizedMenu.
	Smalltalk removeClassNamed: #MessageTally.

	StringHolder class removeSelector: #originalWorkspaceContents.
	CompiledMethod removeSelector: #symbolic.

	RemoteString removeSelector: #makeNewTextAttVersion.
	Utilities class removeSelector: #absorbUpdatesFromServer.
	Smalltalk removeClassNamed: #PenPointRecorder.
	Smalltalk removeClassNamed: #Path.
	Smalltalk removeClassNamed: #Base64MimeConverter.
	"Smalltalk removeClassNamed: #EToySystem. Dont bother - its very small and used for timestamps etc"
	Smalltalk removeClassNamed: #RWBinaryOrTextStream.
	Smalltalk removeClassNamed: #AttributedTextStream.
	Smalltalk removeClassNamed: #WordNet.
	Smalltalk removeClassNamed: #SelectorBrowser.

	TextStyle allSubInstancesDo:
		[:ts | ts newFontArray: (ts fontArray copyFrom: 1 to: (2 min: ts fontArray size))].
	ListParagraph initialize.
	PopUpMenu initialize.
	StandardSystemView initialize.

	Smalltalk noChanges.
	ChangeSorter classPool at: #AllChangeSets 
		put: (OrderedCollection with: Smalltalk changes).
	(Smalltalk includesKey: #Morph) "only remove if Morphic has been removed"
		ifTrue:[Smalltalk removeClassNamed: #CornerRounder.
			ScriptingSystem _ nil].
	SystemDictionary removeSelector: #majorShrink.

	[Smalltalk removeAllUnSentMessages > 0]
		whileTrue:
		[Smalltalk unusedClasses do: [:c | (Smalltalk at: c) removeFromSystem]].
	SystemOrganization removeEmptyCategories.
	Smalltalk allClassesDo: [:c | c zapOrganization].
	Symbol rehash.! !

SystemDictionary removeSelector: #discardFor2Point7!


More information about the Squeak-dev mailing list