'From Squeak3.5 of ''11 April 2003'' [latest update: #5180] on 5 May 2003 at 3:54:59 pm'! "Change Set: VMCodeRemovalCleanup Date: 22 March 2003 Author: tim@sumeru.stanford.edu This is the code for VM and VM making tools stripping changeset. ! !Object methodsFor: 'translation support'! inline: inlineFlag "For translation only; noop when running in Smalltalk."! ! !ExternalScreen methodsFor: 'accessing' stamp: 'tpr 5/5/2003 14:41'! defaultBitBltClass ^BitBlt! ! !ExternalScreen methodsFor: 'accessing' stamp: 'tpr 5/5/2003 14:42'! defaultWarpBltClass ^WarpBlt! ! !SystemDictionary methodsFor: 'housekeeping' stamp: 'tpr 3/13/2003 21:21'! macroBenchmark2 "Smalltalk macroBenchmark2" "Copied from VMMaker>generateInterpreteFile" | cg fileName interpClass objMemClass ccgClass | interpClass _ Smalltalk at: #Interpreter ifAbsent:[^self]. objMemClass _ Smalltalk at: #ObjectMemory ifAbsent: [^self]. ccgClass _ Smalltalk at: #CCodeGenerator ifAbsent: [^self]. fileName _ 'benchmark2.out'. interpClass initialize. objMemClass initialize. cg _ ccgClass new initialize. cg addClass: interpClass. cg addClass: objMemClass. FileDirectory default deleteFileNamed: fileName. cg storeCodeOnFile: fileName doInlining: true. FileDirectory default deleteFileNamed: fileName. ! ! !SystemDictionary methodsFor: 'housekeeping' stamp: 'tpr 3/13/2003 21:17'! macroBenchmarks "Reports an array of times taken to run a number of macro operations indicative of typical Squeak activity, each run after a full garbageCollection, and with exactly 10Mb of free space available. In addition it puts up a window with recent VM statistics local to each test." "PLEASE TAKE NOTE: The goal of these benchmarks is to provide a simple basis for A/B performance comparisons with a given Squeak image. For example JIT vs interpreter, new GC vs old, etc. However, a number of these benchmarks will 'drift' with evolution of the Squeak image, as, for instance, if the number of methods decompiled in macroBenchmark1 were to change. Therefore it is essential *never* to make comarisons between macroBenchmarks run from two different images." "Smalltalk macroBenchmarks #(43215 53122 81336 26927 8993 12607 9024) 400MHz G3" | interp time saveMorphs freeCell report fullReport individualTimes interpClass | individualTimes _ OrderedCollection new. fullReport _ String streamContents: [:strm | Smalltalk timeStamp: strm. "1: Decompile, pretty-print, and compile a bunch of methods. Does not install in classes, so does not flush cache." strm cr; cr; nextPutAll: 'Benchmark #1: '; print: (time _ self standardTime: [Smalltalk macroBenchmark1]); nextPutAll: 'ms'; cr; nextPutAll: '---------------------'; cr; nextPutAll: Utilities vmStatisticsShortString. individualTimes addLast: time. "2: Build morphic tiles for all methods over 800 bytes (;-). Does no display." strm cr; nextPutAll: 'Benchmark #2: '; print: (time _ self standardTime: [SyntaxMorph testAllMethodsOver: 800]); nextPutAll: 'ms'; cr; nextPutAll: '---------------------'; cr; nextPutAll: Utilities vmStatisticsShortString. individualTimes addLast: time. "3: Translate the interpreter with inlining. Does not include any plugins." strm cr; nextPutAll: 'Benchmark #3: '; print: (time _ self standardTime: [Smalltalk macroBenchmark2]); nextPutAll: 'ms'; cr; nextPutAll: '---------------------'; cr; nextPutAll: Utilities vmStatisticsShortString. individualTimes addLast: time. "4: Run the context step simulator. 200 iterations printing pi and 15 factorial." strm cr; nextPutAll: 'Benchmark #4: '; print: (time _ self standardTime: [Smalltalk macroBenchmark3]); nextPutAll: 'ms'; cr; nextPutAll: '---------------------'; cr; nextPutAll: Utilities vmStatisticsShortString. individualTimes addLast: time. "5: Run the InterpreterSimulator for 150,000 bytecodes. Will only run if you have mini.image in your directory." strm cr; nextPutAll: 'Benchmark #5: '; print: ((FileDirectory default includesKey: 'mini.image') ifTrue: [interpClass _ Smalltalk at: #InterpreterSimulator ifAbsent:[nil]. interpClass ifNotNil:[interp _ interpClass new openOn: 'mini.image'. time _ self standardTime: [interp runForNBytes: 150000]. interp close. Display restore. time]] ifFalse: [time _ 0]); nextPutAll: 'ms'; cr; nextPutAll: '---------------------'; cr; nextPutAll: Utilities vmStatisticsShortString. individualTimes addLast: time. "6: Open 10 browsers and close them. Includes browsing to a specific method." strm cr; nextPutAll: 'Benchmark #6: '; print: (Smalltalk isMorphic ifTrue: [saveMorphs _ self currentWorld submorphs. self currentWorld removeAllMorphs. "heh, heh" time _ self standardTime: [1 to: 10 do: [:i | Browser fullOnClass: SystemDictionary selector: #macroBenchmarks]. self currentWorld submorphs do: [:m | m delete. self currentWorld doOneCycle]]. self currentWorld addAllMorphs: saveMorphs. time] ifFalse: [time _ 0]); nextPutAll: 'ms'; cr; nextPutAll: '---------------------'; cr; nextPutAll: Utilities vmStatisticsShortString. individualTimes addLast: time. "7: Play a game of FreeCell with display, while running the MessageTally. Thanks to Bob Arning for the clever part of this one." strm cr; nextPutAll: 'Benchmark #7: '; print: (Smalltalk isMorphic ifTrue: ["Play a trivial game of FreeCell with MessageTally and report." (freeCell _ FreeCell new) openInWorld. time _ self standardTime: [freeCell board pickGame: 1]. (((report _ self currentWorld firstSubmorph) isKindOf: SystemWindow) and: [self currentWorld firstSubmorph label = 'Spy Results']) ifTrue: [report delete]. freeCell delete. time] ifFalse: [time _ 0]); nextPutAll: 'ms'; cr; nextPutAll: '---------------------'; cr; nextPutAll: Utilities vmStatisticsShortString. individualTimes addLast: time. strm cr; nextPutAll: '---------------------'; cr; nextPutAll: 'Total time = '; print: individualTimes sum; nextPutAll: ' milliseconds.'; cr]. StringHolder new textContents: fullReport; openLabel: 'Macro Benchmark Results'. ^ individualTimes asArray ! ! !SystemDictionary methodsFor: 'housekeeping' stamp: 'tpr 3/13/2003 21:28'! makeSqueaklandRelease "Smalltalk makeSqueaklandRelease" "NOTE: This method assumes that * ALL WINDOWS HAVE BEEN CLOSED (most importantly all project windows) * ALL GLOBAL FLAPS HAVE BEEN DESTROYED (not just disabled) This method may needs to be run twice - upon the first run you will probably receive an error message saying 'still have obsolete behaviors'. Close the notifier and try again. If there are still obsolete behaviors then go looking for them. Last update: ar 8/18/2001 01:14 for Squeak 3.1" | ss | (self confirm: self version , ' Is this the correct version designation? If not, choose no, and fix it.') ifFalse: [^ self]. "Delete all projects" 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]. ]. "Hm ... how did this come in?!!" Smalltalk keys do:[:x| (x class == String and:[(Smalltalk at: x) isBehavior]) ifTrue:[Smalltalk removeKey: x]. ]. "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 chooseInitialSettings; installBrightWindowColors. "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']. "Set a few default preferences" #( (honorDesktopCmdKeys false) (warnIfNoChangesFile false) (warnIfNoSourcesFile false) (showDirectionForSketches true) (menuColorFromWorld false) (unlimitedPaintArea true) (useGlobalFlaps false) (mvcProjectsAllowed false) (projectViewsInWindows false) (automaticKeyGeneration true) (securityChecksEnabled true) (showSecurityStatus false) (startInUntrustedDirectory true) (warnAboutInsecureContent false) (promptForUpdateServer false) (fastDragWindowForMorphic false) ) do:[:spec| Preferences setPreference: spec first toValue: (spec last == #true). ]. "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 discardFFI; discard3D; discardSUnit; discardSpeech; "discardVMConstruction;" discardPWS; discardIRC. "Dump change sets" ChangeSorter removeChangeSetsNamedSuchThat: [:cs| cs name ~= Smalltalk changes name]. "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. "Remove refs to old ControlManager" ScheduledControllers _ nil. "Flush obsolete subclasses" Behavior flushObsoleteSubclasses. Smalltalk garbageCollect. Smalltalk obsoleteBehaviors isEmpty ifFalse:[self error:'Still have obsolete behaviors']. "Clear all server entries" ServerDirectory serverNames do: [:each | ServerDirectory removeServerNamed: each]. SystemVersion current resetHighestUpdate. ss _ Set allSubInstances. 'Rehashing all sets' displayProgressAt: Sensor cursorPoint from: 1 to: ss size during:[:bar| 1 to: ss size do:[:i| bar value: i. (ss at: i) rehash. ]. ]. Smalltalk obsoleteClasses isEmpty ifFalse: [self halt]. self halt: 'Ready to condense changes or sources'. SystemDictionary removeSelector: #makeSqueaklandRelease.! ! !SystemDictionary methodsFor: 'shrinking' stamp: 'tpr 3/13/2003 21:28'! majorShrink "Undertake a major shrinkage of the image. This method throws out lots of the system that is not needed for, eg, operation in a hand-held PC. majorShrink produces a 999k image in Squeak 2.8 Smalltalk majorShrink; abandonSources; lastRemoval" | oldDicts newDicts | Smalltalk isMorphic ifTrue: [^ self error: 'You can only run majorShrink in MVC']. Project current isTopProject ifFalse: [^ self error: 'You can only run majorShrink in the top project']. (Smalltalk confirm: 'All sub-projects will be deleted from this image. You should already have made a backup copy, or you must save with a different name after shrinking. Shall we proceed to discard most of the content in this image?') ifFalse: [^ self inform: 'No changes have been made.']. "Remove all projects but the current one. - saves 522k" ProjectView allInstancesDo: [:pv | pv controller closeAndUnscheduleNoTerminate]. Project current setParent: Project current. MorphWorldView allInstancesDo: [:pv | pv topView controller closeAndUnscheduleNoTerminate]. Smalltalk at: #Wonderland ifPresent:[:cls| cls removeActorPrototypesFromSystem]. Player freeUnreferencedSubclasses. MorphicModel removeUninstantiatedModels. Utilities classPool at: #ScrapsBook put: nil. Utilities zapUpdateDownloader. ProjectHistory currentHistory initialize. Project rebuildAllProjects. " Smalltalk discardVMConstruction. " "755k" Smalltalk discardSoundSynthesis. "544k" Smalltalk discardOddsAndEnds. "227k" Smalltalk discardNetworking. "234k" Smalltalk discard3D. "407k" Smalltalk discardFFI. "33k" Smalltalk discardMorphic. "1372k" Symbol rehash. "40k" "Above by itself saves about 4,238k" "Remove references to a few classes to be deleted, so that they won't leave obsolete versions around." ChangeSet class compile: 'defaultName ^ ''Changes'' ' classified: 'initialization'. ScreenController removeSelector: #openChangeManager. ScreenController removeSelector: #exitProject. ScreenController removeSelector: #openProject. ScreenController removeSelector: #viewImageImports. "Now delete various other 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). SystemDictionary removeSelector: #majorShrink. [Smalltalk removeAllUnSentMessages > 0] whileTrue: [Smalltalk unusedClasses do: [:c | (Smalltalk at: c) removeFromSystem]]. SystemOrganization removeEmptyCategories. Smalltalk allClassesDo: [:c | c zapOrganization]. Smalltalk garbageCollect. 'Rehashing method dictionaries . . .' displayProgressAt: Sensor cursorPoint from: 0 to: MethodDictionary instanceCount during: [:bar | oldDicts _ MethodDictionary allInstances. newDicts _ Array new: oldDicts size. oldDicts withIndexDo: [:d :index | bar value: index. newDicts at: index put: d rehashWithoutBecome. ]. oldDicts elementsExchangeIdentityWith: newDicts. ]. oldDicts _ newDicts _ nil. Project rebuildAllProjects. Smalltalk changes initialize. "seems to take more than one try to gc all the weak refs in SymbolTable" 3 timesRepeat: [ Smalltalk garbageCollect. Symbol compactSymbolTable. ]. ! ! VariableNode removeSelector: #asTranslatorNode! SystemDictionary removeSelector: #discardVMConstruction! String removeSelector: #primGetInteger32:! String removeSelector: #primPutInteger32:at:! ReturnNode removeSelector: #asTranslatorNode! MethodNode removeSelector: #asTranslationMethodOfClass:! MessageNode removeSelector: #asTranslatorNode! LiteralNode removeSelector: #asTranslatorNode! CascadeNode removeSelector: #asTranslatorNode! CRRecognizer class removeSelector: #checkPluginVersion! BlockNode removeSelector: #asTranslatorNode! B3DRenderEngine class removeSelector: #rasterizer! AssignmentNode removeSelector: #asTranslatorNode! Object removeSelector: #asIf:var:! Object removeSelector: #asIf:var:asValue:! Object removeSelector: #asIf:var:put:! Object removeSelector: #asOop:! Object removeSelector: #asSmallIntegerObj! Object removeSelector: #asValue:! Object removeSelector: #cCode:! Object removeSelector: #cCode:inSmalltalk:! Object removeSelector: #cCoerce:to:! Object removeSelector: #debugCode:! Object removeSelector: #export:! Object removeSelector: #primitive:parameters:receiver:! Object removeSelector: #remapOop:in:! Object removeSelector: #returnTypeC:! Object removeSelector: #sharedCodeNamed:inCase:! Object removeSelector: #stAt:! Object removeSelector: #stAt:put:! Object removeSelector: #stSize! Object removeSelector: #static:! Object removeSelector: #suppressFailureGuards:! Object removeSelector: #var:type:! Object removeSelector: #var:type:array:! Smalltalk removeClassNamed: #ADPCMCodecPlugin! Smalltalk removeClassNamed: #AEDesc! Smalltalk removeClassNamed: #Applescript! Smalltalk removeClassNamed: #ApplescriptError! Smalltalk removeClassNamed: #ApplescriptInstance! Smalltalk removeClassNamed: #AsynchFilePlugin! Smalltalk removeClassNamed: #B3DAcceleratorPlugin! Smalltalk removeClassNamed: #B3DActiveEdgeTable! Smalltalk removeClassNamed: #B3DClipperPlugin! Smalltalk removeClassNamed: #B3DEnginePlugin! Smalltalk removeClassNamed: #B3DFillList! Smalltalk removeClassNamed: #B3DPickerPlugin! Smalltalk removeClassNamed: #B3DPrimitiveEdge! Smalltalk removeClassNamed: #B3DPrimitiveEdgeList! Smalltalk removeClassNamed: #B3DPrimitiveFace! Smalltalk removeClassNamed: #B3DPrimitiveFaceAttributes! Smalltalk removeClassNamed: #B3DPrimitiveObject! Smalltalk removeClassNamed: #B3DRasterizerPlugin! Smalltalk removeClassNamed: #B3DScanner! Smalltalk removeClassNamed: #B3DShaderPlugin! Smalltalk removeClassNamed: #B3DSimulRasterizer! Smalltalk removeClassNamed: #B3DTransformerPlugin! Smalltalk removeClassNamed: #B3DVertexBufferPlugin! Smalltalk removeClassNamed: #BMPReadWriterPlugin! Smalltalk removeClassNamed: #BalloonDebugCanvas! Smalltalk removeClassNamed: #BalloonDebugEngine! Smalltalk removeClassNamed: #BalloonEngineBase! Smalltalk removeClassNamed: #BalloonEnginePlugin! Smalltalk removeClassNamed: #BalloonEngineSimulation! Smalltalk removeClassNamed: #BitBltSimulation! Smalltalk removeClassNamed: #BitBltSimulator! Smalltalk removeClassNamed: #CArrayAccessor! Smalltalk removeClassNamed: #CCodeGenerator! Smalltalk removeClassNamed: #CObjectAccessor! Smalltalk removeClassNamed: #CPluggableAccessor! Smalltalk removeClassNamed: #CompiledApplescript! Smalltalk removeClassNamed: #ComponentInstance! Smalltalk removeClassNamed: #DSAPlugin! Smalltalk removeClassNamed: #DeflatePlugin! Smalltalk removeClassNamed: #DescType! Smalltalk removeClassNamed: #DropPlugin! Smalltalk removeClassNamed: #FFIPlugin! Smalltalk removeClassNamed: #FFTPlugin! Smalltalk removeClassNamed: #FXBlt! Smalltalk removeClassNamed: #FXBltSimulation! Smalltalk removeClassNamed: #FXBltSimulator! Smalltalk removeClassNamed: #FXGrafPort! Smalltalk removeClassNamed: #FileCopyPlugin! Smalltalk removeClassNamed: #FilePlugin! Smalltalk removeClassNamed: #FilePluginSimulator! Smalltalk removeClassNamed: #FlippyArray2! Smalltalk removeClassNamed: #FlippyArrayPlugin2! Smalltalk removeClassNamed: #FloatArrayPlugin! Smalltalk removeClassNamed: #Foo2! Smalltalk removeClassNamed: #FooPlugin2! Smalltalk removeClassNamed: #GeniePlugin! Smalltalk removeClassNamed: #InflatePlugin! Smalltalk removeClassNamed: #IntegerPokerPlugin! Smalltalk removeClassNamed: #InternetConfigPlugin! Smalltalk removeClassNamed: #Interpreter! Smalltalk removeClassNamed: #InterpreterPlugin! Smalltalk removeClassNamed: #InterpreterProxy! Smalltalk removeClassNamed: #InterpreterSimulator! Smalltalk removeClassNamed: #InterpreterSimulatorLSB! Smalltalk removeClassNamed: #InterpreterSimulatorMSB! Smalltalk removeClassNamed: #InterpreterSupportCode! Smalltalk removeClassNamed: #JPEGReadWriter2Plugin! Smalltalk removeClassNamed: #JPEGReaderPlugin! Smalltalk removeClassNamed: #JoystickTabletPlugin! Smalltalk removeClassNamed: #KlattSynthesizerPlugin! Smalltalk removeClassNamed: #LargeIntegersPlugin! Smalltalk removeClassNamed: #LargeIntegersTest! Smalltalk removeClassNamed: #MIDIPlugin! Smalltalk removeClassNamed: #MacExternalData! Smalltalk removeClassNamed: #MacOSPowerPCOS9BrowserVMMaker! Smalltalk removeClassNamed: #MacOSPowerPCOS9VMMaker! Smalltalk removeClassNamed: #Matrix2x3Plugin! Smalltalk removeClassNamed: #MiscPrimitivePlugin! Smalltalk removeClassNamed: #Mpeg3Plugin! Smalltalk removeClassNamed: #OSAID! Smalltalk removeClassNamed: #ObjectMemory! Smalltalk removeClassNamed: #Oop! Smalltalk removeClassNamed: #Pixmap! Smalltalk removeClassNamed: #PluggableCodeGenerator! Smalltalk removeClassNamed: #RiscOSVMMaker! Smalltalk removeClassNamed: #SecurityPlugin! Smalltalk removeClassNamed: #SerialPlugin! Smalltalk removeClassNamed: #SocketPlugin! Smalltalk removeClassNamed: #SoundCodecPlugin! Smalltalk removeClassNamed: #SoundGenerationPlugin! Smalltalk removeClassNamed: #SoundPlugin! Smalltalk removeClassNamed: #StarSqueakPlugin! Smalltalk removeClassNamed: #SurfacePlugin! Smalltalk removeClassNamed: #SystemMonitor! Smalltalk removeClassNamed: #SystemTracer! Smalltalk removeClassNamed: #TAssignmentNode! Smalltalk removeClassNamed: #TCaseStmtNode! Smalltalk removeClassNamed: #TConstantNode! Smalltalk removeClassNamed: #TGoToNode! Smalltalk removeClassNamed: #TIPTestPlugin! Smalltalk removeClassNamed: #TLabeledCommentNode! Smalltalk removeClassNamed: #TMethod! Smalltalk removeClassNamed: #TParseNode! Smalltalk removeClassNamed: #TReturnNode! Smalltalk removeClassNamed: #TSendNode! Smalltalk removeClassNamed: #TStmtListNode! Smalltalk removeClassNamed: #TVariableNode! Smalltalk removeClassNamed: #TestCClass1! Smalltalk removeClassNamed: #TestCClass2! Smalltalk removeClassNamed: #TestCClass3! Smalltalk removeClassNamed: #TestCodeGenerator! Smalltalk removeClassNamed: #TestInterpreterPlugin! Smalltalk removeClassNamed: #TestOSAPlugin! Smalltalk removeClassNamed: #TestTMethod! Smalltalk removeClassNamed: #UUIDPlugin! Smalltalk removeClassNamed: #Unsigned! Smalltalk removeClassNamed: #VMMaker! Smalltalk removeClassNamed: #VMMakerException! Smalltalk removeClassNamed: #VMMakerTool! Smalltalk removeClassNamed: #VMMakerWithFileCopying! Smalltalk removeClassNamed: #Win32VMMaker!