From VisualWorks®, 7.6 of February 1, 2008 on February 1, 2008 at 12:28:48 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <name>RuntimePackager</name> <environment>Smalltalk</environment> <private>false</private> <imports> private Smalltalk.* </imports> <category>Advbool-RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> <class> <name>RuntimeBuilderAppModel</name> <environment>RuntimePackager</environment> <super>UI.ApplicationModel</super> <private>false</private> none isChanged <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderAppModel
RuntimeBuilderAppModel implements an abstract class used as the basis of user interface ApplicationModel subclasses. RuntimeBuilderAppModel is part of the Runtime Packager tool, and has no public API. It provides the functionality to track whether the user has made changes since the Runtime Packager tool was opened. As such, this class and all of its subclasses get stripped from the deployed image. Instance Variables: isChanged <Boolean>
</comment> <class> <name>RuntimeBuilderEditor</name> <environment>RuntimePackager</environment> <super>RuntimePackager.RuntimeBuilderAppModel</super> <private>false</private> none subject warnings <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderEditor
RuntimeBuilderEditor provides a framework for objects that can be edited through a user interface. RuntimeBuilderEditableObject is a support class used by the Runtime Packager tool, and has no public API. It provides the corresponding part of the framework for the object being changed. When the editor window closes, the subject object is notified to remove references to the application window containing the editor. As such, this class and all of its subclasses get stripped from the deployed image. Warnings are filtered to show each occurence only once. If the warning is identified by a user interface component, a new warning can be issued if the component is changed. Subclasses must implement the following messages: internals copyValuesFromSubject Instance Variables: subject <RuntimeBuilderEditableObject> warnings <Set>
</comment> <class> <name>RuntimeMethodSurrogate</name> <environment>RuntimePackager</environment> <super>Kernel.CompiledMethod</super> <private>false</private> objects hookedMethod hookedSelector <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeMethodSurrogate
RuntimeMethodSurrogate is used as a replacement for a method which has been wrappered so that a reference to the original method can be detected. Instance Variables: hookedMethod <CompiledMethod> hookedSelector <Symbol>
</comment> <class> <name>RuntimeManager</name> <environment>RuntimePackager</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeManager
RuntimeManager provides a central set of data and methods used in creating the final stripped image and in managing image startup. The template methods implemented here are copied to other classes as needed to selectively replace existing methods. RuntimeManager and its subclass RuntimeManagerStripper are responsible for creating the final stripped image. After the stripping process is completed, many of the methods are removed from RuntimeManager by the stripping process. Class RuntimeManager gets deployed, since it is used during startup of the user's application. Class Variables: DeletedClasses < ( IdentitySet of: Behavior ) | nil > DeletedGlobals < ( IdentitySet of: Symbol ) | nil> DeletedMethods < ( IdentityDictionary key: Behavior value: Set ) | nil > ErrorLogPath <String | nil> ErrorNotifierClass <Behavior | nil> ImageIdentification <String | nil> ImagePath <String | nil> InstVarIndexes <IdentityDictionary> RunState <Symbol> StartupMethod <Symbol | nil> StrippingOptions <Set> VWRelease <Number | nil > ImageDumperClass <Behavior | nil> LoadableClasses < ( IdentitySet of: Behavior ) | nil> MemoryParams <RuntimeBuilderMemoryParams | nil> NewMemoryPolicy <MemoryPolicy | nil> PostStripBlock <BlockClosure | nil> QuitBlock <BlockClosure | nil> StartupClassName <Symbol | nil>
</comment> <class> <name>RuntimeExample</name> <environment>RuntimePackager</environment> <super>UI.ApplicationModel</super> <private>false</private> none survUsed oldUsed largeAlloc edenUsed permUsed oldAlloc largeUsed edenAlloc permAlloc survAlloc <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeExample
RuntimeExample is a simple example application for exercising the packager tool. RuntimeExample shows memory statistics taken from ObjectMemory. RuntimeExample is a support class for the Runtime Packager, and gets stripped from the deployed application. Instance Variables: survUsed <ValueHolder on: Integer> oldUsed <ValueHolder on: Integer> largeAlloc <ValueHolder on: Integer> edenUsed <ValueHolder on: Integer> permUsed <ValueHolder on: Integer> oldAlloc <ValueHolder on: Integer> largeUsed <ValueHolder on: Integer> edenAlloc <ValueHolder on: Integer> permAlloc <ValueHolder on: Integer> survAlloc <ValueHolder on: Integer>
</comment> <class> <name>RuntimeBuilderClassChooser</name> <environment>RuntimePackager</environment> <super>RuntimePackager.RuntimeBuilderEditor</super> <private>false</private> none nameSpaceList categoryListTitle selectableClasses definedClasses selectableClassList selectedSubapplications bindingsInCurrentlySelected <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderClassChooser
RuntimeBuilderClassChooser provides a common framework for classes that choose classes based upon packages. A user interface showing a selection list of packages must be provided by the subclass. RuntimeBuilderClassChooser is part of the Runtime Packager tool, and has no public API. As such, this class and all of its subclasses get stripped from the deployed image. Note that this class was formerly used to select via categories, but is being repurposed to select via packages. Some of the old "category" nomenclature may still be used in comments, methods, and variable names. Subclasses must implement the following messages: Instance protocol: accessing systemPackagesTree actions systemCategoriesSelectionChanged Class protocol: resources systemSelectionMenu Instance Variables: categoryListTitle <ValueModel> definedClasses <IdentitySet of: Class> globalBindings <(Set of: (GeneralBindingReference))> Binding references for shared variables in classes and in namespaces nameSpaceList <SelectionInList> selectableClasses <IdentitySet of: Class> selectableClassList <List of: Association> selectedSubapplications <IdentitySet of: Class> systemCategoriesList <TreeSelectionModule>
</comment> <class> <name>RuntimeBuilderUI</name> <environment>RuntimePackager</environment> <super>UI.ApplicationModel</super> <private>false</private> none stepTitle stepDescription currentStepNumber options keptItems tester paramFilename memoryParams reviewDone itemsDone scanDone testDone memoryDone optionsDone cleanupDone saveParcelsDone interactWithUser <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderUI
RuntimeBuilderUI provides the main application window from which all other functions are launched. RuntimeBuilderUI is part of the Runtime Packager tool, and has no public API. As such, this class gets stripped from the deployed image. Instance Variables: stepTitle <ValueHolder on: String> stepDescription <ValueHolder on: String> currentStepNumber <SmallInteger> options <RuntimeBuilderOptions> keptItems <RuntimeBuilderItems> tester <RuntimeBuilderTester> paramFilename <Filename> memoryParams <RuntimeBuilderMemoryParams> reviewDone <ValueHolder on: Boolean> itemsDone <ValueHolder on: Boolean> scanDone <ValueHolder on: Boolean> testDone <ValueHolder on: Boolean> memoryDone <ValueHolder on: Boolean> optionsDone <ValueHolder on: Boolean> cleanupDone <ValueHolder on: Boolean> saveParcelsDone <ValueHolder on: Boolean> Class Variables: ActiveApplication <RuntimeBuilderUI | nil> LicenseAccepted <Boolean | nil>
</comment> <class> <name>RuntimeErrorNotifier</name> <environment>RuntimePackager</environment> <super>Core.ErrorNotifier</super> <private>false</private> none isProceedable exceptionType debugNotifierMode <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeErrorNotifier
RuntimeErrorNotifier is an abstract class from which error notifier subclasses can be created. RuntimeErrorNotifier is a support class for the Runtime Packager, and gets packaged with the deployed application. In a runtime image, the Notifier current instance is typically be set to one of these subclasses. Subclasses typically override methods in the 'user interface' protocol. The most common type of behavior is that, rather than opening an interactive debugger, they write some sort of error log. This class tries to ensure that it has a writable file when dumping the system state to a file (see #createEmergencyDump). Instance Variables: isProceedable <Boolean> Is the exception proceedable. exceptionType <Symbol> Different runtime behaviour may be desirable for different broad categories of exceptions. The method #classifyException will group exceptions into one of #(halt notify userInterrupt lowSpace other), and some methods will do different things for different categories of exceptions. Class Instance Variables: debugNotifierMode <nil | Boolean> A flag for debug testing of this notifier. If this is true, then our intercept of notification is ignored, and it will reset the notifier to development mode and halt.
</comment> <class> <name>RuntimeEmergencyNotifier</name> <environment>RuntimePackager</environment> <super>RuntimePackager.RuntimeErrorNotifier</super> <private>false</private> none emergencyAbortText <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeEmergencyNotifier
RuntimeEmergencyNotifier provides the notifier used for unhandled exceptions in the stripped image. Text provided to the user can be changed by supplying new values for the class variables (and the sole class instance variable, emergencyAbortText). RuntimeEmergencyNotifier is a support class for the Runtime Packager, and gets packaged with the deployed application. Class Instance Variables: emergencyAbortText <String> The message to display when there is an error while the image is quitting. Class Variables: DialogClass <Dialog|Class> This is the class that will understand #choose:labels:values:default:. By default the system's dialog class, Dialog is used. DumpFailedMsg <String> This is the message to display when there was an error while writing the dump of the system state. ErrorOccurredMsg <String> This is the message to display when an unhandled exception has occurred. UserInterruptMsg <String> The is the message to display when an UserInterrupt (or one of its subclasses) has occurred.
</comment> <class> <name>RuntimeDebugNotifier</name> <environment>RuntimePackager</environment> <super>RuntimePackager.RuntimeEmergencyNotifier</super> <private>false</private> none <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeDebugNotifier
RuntimeDebugNotifier is an extension of the standard runtime emergency notifier that allows processing to continue after an application error. Any unhandled exceptions are dismissed if the user so authorizes. RuntimeDebugNotifier is a support class for the Runtime Packager, and gets packaged with the deployed application. Class Variables: DebugErrorMsg <String | nil> The message to display when an unhanded exception has occurred. Different from its superclass, because this user might proceed through the exception. DebugInterruptMsg <String | nil> The message to display when UserInterrupt (or subclass) has occurred during the proceeding of the UnhandledException. ButtonTitles <Dictionary | nil> A dictionary that provides the labels for the dialog buttons, see the class side #buttonTitles method for an example of its structure.
</comment> <class> <name>RuntimeFullDumper</name> <environment>RuntimePackager</environment> <super>Core.ErrorDumper</super> <private>false</private> none <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeFullDumper
RuntimeFullDumper creates a more complete dump suitable for a packaged runtime image. RuntimeFullDumper is a support class for the Runtime Packager, and gets packaged with the deployed application. In addition to the information written by ErrorDumper, this class provides a means to include a more detailed stack dump, the command line information, database connections, an image identifier that can be set with the Runtime Packager, stacks for all quiescent processes, the contents of the Transcript, and open windows.
</comment> <class> <name>RuntimeStartupController</name> <environment>RuntimePackager</environment> <super>UI.ApplicationStandardSystemController</super> <private>false</private> none <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeStartupController
RuntimeStartupContoller is the controller of the main Runtime Packager window (see RuntimeBuilderUI). RuntimeStartupController detects the close of the window during the process of stripping the image and passes control to RuntimeManager to complete the stripping operation. This is done to allow as much of RuntimeBuilderUI and associated objects to be eliminated from the runtime image as possible.
</comment> <class> <name>RuntimeBuilderOptionsEditor</name> <environment>RuntimePackager</environment> <super>RuntimePackager.RuntimeBuilderEditor</super> <private>false</private> none edittingBuilder tabs errorNotifierClass errorLogPath shutdownOnLastWin startupClass startupMethod removeCompiler imagePath doThreeSaves installEmergencyEvaluator removeOrganization packageExternalInterfaces uiLookMac uiLookMotif osMac osUnix uiLookWindows osWindows headlessImage uiLookOpenLook useRuntimeCompiledMethod uiLookCUA osOS2 parcelOptions parcelIsLoadable stripParcel parcelList currentParcel parcelPath mergeLiterals mergeByteCodes useAutoLoader imageDumperClass lastWindowCloseAction prestripClass prestripMethod saveParcel parcelSaveOption mergeMethods clearParcelPath parcelUnloadBeforeStrip traceLevel stripGlobals skipScan suppressSplashScreen <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderOptionsEditor
RuntimeBuilderOptionsEditor provides for user a way to set options that control creation of the final stripped image. RuntimeBuilderOptionsEditor is part of the Runtime Packager tool, and has no public API. As such, this class gets stripped from the deployed image. Instance Variables: doThreeSaves <ValueHolder on: Boolean> edittingBuilder <UIBuilder> errorNotifierClass <ValueHolder on: String> errorLogPath <ValueHolder on: String> imagePath <ValueHolder on: String> installEmergencyEvaluator <ValueHolder on: Boolean> packageExternalInterfaces <ValueHolder on: Boolean> prestripClass <ValueHolder on: String> prestripMethod <ValueHolder on: String> removeCompiler <ValueHolder on: Boolean> removeOrganization <ValueHolder on: Boolean> shutdownOnLastWin <ValueHolder on: Boolean> startupClass <ValueHolder on: String> startupMethod <ValueHolder on: String> currentParcel <String | nil> headlessImage <ValueHolder on: Boolean> imageDumperClass <ValueHolder on: String> lastWindowCloseAction <ValueHolder on: Symbol> mergeByteCodes <ValueHolder on: Boolean> mergeCommonMethods <ValueHolder on: Boolean> mergeLiterals <ValueHolder on: Boolean> osMac <ValueHolder on: Boolean> osOS2 <ValueHolder on: Boolean> osUnix <ValueHolder on: Boolean> osWindows <ValueHolder on: Boolean> parcelIsLoadable <ValueHolder on: Boolean> parcelList <ValueHolder on: List> parcelOptions <Dictionary> parcelPath <ValueHolder on: String> parcelPostLoadClass <ValueHolder on: String> parcelPostLoadMethod <ValueHolder on: String> prestripClass <ValueHolder on: String> prestripMethod <ValueHolder on: String> stripParcel <ValueHolder on: Boolean> uiLookCUA <ValueHolder on: Boolean> uiLookMac <ValueHolder on: Boolean> uiLookMotif <ValueHolder on: Boolean> uiLookOpenLook <ValueHolder on: Boolean> uiLookWindows <ValueHolder on: Boolean> useAutoLoader <ValueHolder on: Boolean> useRuntimeCompiledMethod <ValueHolder on: Boolean> tabs <SelectionInList> saveParcel <ValueHolder on: Boolean> skipScan <ValueHolder on: Boolean> parcelSaveOption <ValueHolder on: Symbol> mergeMethods <ValueHolder on: Boolean> clearParcelPath <ValueHolder on: Boolean> suppressSplashScreen <ValueHolder on: Boolean> If true, set the flag that supresses the herald and sound on start-up.
</comment> <class> <name>RuntimeCompiledMethod</name> <environment>RuntimePackager</environment> <super>Kernel.CompiledMethod</super> <private>false</private> objects <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeCompiledMethod
This class provides an implementation of CompiledMethod that does away with instance variables not used by the virtual machine. When the RuntimeCompiledMethod option is selected during packaging, the Runtime Packager checks for classes with unused instance variables and, if possible, alters the format of the class in the runtime image to reduce the number of variables. Replacement methods are supplied for methods that would have accessed these variables. This class will be used in the deployed image, where necessary.
</comment> <class> <name>RuntimeBuilderItemsChooser</name> <environment>RuntimePackager</environment> <super>RuntimePackager.RuntimeBuilderClassChooser</super> <private>false</private> none workingCopy keptClassesList keptMethodsList contingentClassesList contingentMethodsList deletedClassesList deletedMethodsList systemPackagesTree <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderItemsChooser
RuntimeBuilderItemsChooser provides the editor for setting values in the object holding collections of kept and deleted classes, methods, and globals. RuntimeBuilderItemsChooser is part of the Runtime Packager tool, and has no public API. As such, this class and all of its subclasses get stripped from the deployed image. Instance Variables: deletedClasses <IdentitySet of: Behavior> keptClasses <IdentitySet of: Behavior> keptMethods <IdentityDictionary key: Behavior value: Set> deletedMethods <IdentityDictionary key: Behavior value: Set> keptClassesList <ValueHolder on: MultiSelectionInList> keptMethodsList <ValueHolder on: MultiSelectionInList> contingentClassesList <ValueHolder on: MultiSelectionInList> contingentMethodsList <ValueHolder on: MultiSelectionInList> deletedClassesList <ValueHolder on: MultiSelectionInList> deletedMethodsList <ValueHolder on: MultiSelectionInList> deletedGlobals <IdentitySet> keptGlobals <IdentitySet> deletedClasses and keptClasses contain class names rather than the classes themselves.
</comment> <class> <name>RuntimeBuilderItemsViewer</name> <environment>RuntimePackager</environment> <super>RuntimePackager.RuntimeBuilderItemsChooser</super> <private>false</private> none showParcelsAs <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderItemsViewer
RuntimeBuilderItemsViewer provides a read-only editor (viewer) for kept and deleted classes, methods, and globals. This viewer reflects the status after classes, methods and globals are deleted. The contingent category does not apply. RuntimeBuilderItemsViewer is part of the Runtime Packager tool, and has no public API. As such, this class gets stripped from the deployed image. Instance Variables: showParcelsAs <ValueHolder on: Symbol>
</comment> <class> <name>RuntimeQuietEmergencyNotifier</name> <environment>RuntimePackager</environment> <super>RuntimePackager.RuntimeErrorNotifier</super> <private>false</private> none <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeQuietEmergencyNotifier
RuntimeQuietEmergencyNotifier provides an emergency notifier that does not interact with the user. RuntimeQuietEmergencyNotifier is a support class for the Runtime Packager, and gets packaged with the deployed application. When RuntimeQuietEmergencyNotifier has been chosen as an error notifier, the sole means of diagnosing an error is the dump created. This class is generally used when packaging a headless image for deployment.
</comment> <class> <name>RuntimeBuilderEditableObject</name> <environment>RuntimePackager</environment> <super>UI.Model</super> <private>false</private> none editor viewer hasBeenEdited <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderEditableObject
RuntimeBuilderEditableObject provides a framework for objects that can be edited through a user interface. RuntimeBuilderEditableObject is a support class for the Runtime Packager tool, and has no public API. As such, this class gets stripped from the deployed image. RuntimeBuilderEditor provides the corresponding part of the framework for the user interface used to change the object. In addition to an editor, an object can have a viewer, which is a user interface that displays but does not change the object. Only a single editor is permitted at one time. When the editor window closes, editor is set to nil. The same rules apply to viewer as well. Subclasses must implement the following messages: accessing editorClass Instance Variables: editor <RuntimeBuilderEditor> viewer <RuntimeBuilderEditor> hasBeenEditted <Boolean>
</comment> <class> <name>RuntimeBuilderOptions</name> <environment>RuntimePackager</environment> <super>RuntimePackager.RuntimeBuilderEditableObject</super> <private>false</private> none errorNotifierClass errorLogPath imageDumperClass startupClass startupMethod imagePath strippingOptions uiLooks operatingSystems parcelOptions prestripClass prestripMethod traceLevel <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderOptions
RuntimeBuilderOptions is an editable object holding user-selected options that control building of the final stripped image. RuntimeBuilderOptions is a support class for the Runtime Packager tool, and has no public API. As such, this class gets stripped from the deployed image. Instance Variables: errorNotifierClass <Class> errorLogPath <String> imageDumperClass <Class | nil > imagePath <String> operatingSystems <Set> prestripClass <Class | nil> prestripMethod <Symbol | nil> startupClass <Class | nil> startupMethod <Symbol | nil> strippingOptions <Set> uiLooks <Set> parcelOptions <Dictionary> prestripClass <Class | nil > prestripMethod <Symbol | nil > traceLevel <Integer>
</comment> <class> <name>RuntimeBuilderReferenceBrowser</name> <environment>RuntimePackager</environment> <super>RuntimePackager.RuntimeBuilderAppModel</super> <private>false</private> none referenceFoundText referencesList keptItemsFilter targetsList referencesCache currentTarget keptItems deletedClasses deletedGlobals deletedMethods <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderReferenceBrowser
Browse for references using an extended notion of a reference to class or method. This is parallel to the type of references detected in the scan for referenced items. RuntimeBuilderReferenceBrowser is part of the Runtime Packager tool, and has no public API. As such, this class gets stripped from the deployed image. Instance Variables: referenceFoundText <ValueHolder on: Text> referencesList <SelectionInList of: Association > keptItemsFilter <ValueHolder on: Boolean> targetsList <List> referencesCache <IdentityDictionary> currentTarget <Symbol | String > keptItems <RuntimeBuilderItems> deletedClasses <IdentitySet of: Class> deletedGlobals <Set of: VariableBinding> deletedMethods <IdentityDictionary key: Behavior value: Set>
</comment> <class> <name>RuntimeManagerStripper</name> <environment>RuntimePackager</environment> <super>RuntimePackager.RuntimeManager</super> <private>false</private> none <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeManagerStripper
RuntimeManagerStripper is a subclass of RuntimeManager that provides an easy way to delete methods used for stripping that are not used in the runtime image. RuntimeManagerStripper is part of the Runtime Packager tool. As such, this class gets stripped from the deployed application. RuntimeManagerStripper implements the process of actually stripping deleted items from the image. Class Variables: AllDeletedBehaviors <nil | IdentitySet of: Behavior > All the classes that are to be deleted by the stripper ClassPrerequisites <nil | IdentiyDictionary of: Behavior -> OrderedCollection of: Behavior > A map of each class to be deleted to its prequisites (subclasses and prerequisitesForLoading) DeletedClassesInOrder <nil | OrderedCollection of: Behavior> A topological sort based ClassPrerequisites (see the class side method sortClassForDeletion:in:notifying:) LiteralKeyBlocks < (Dictionary key: Behavior value: BlockClosure) | nil >
</comment> <class> <name>RuntimeBuilderItems</name> <environment>RuntimePackager</environment> <super>RuntimePackager.RuntimeBuilderEditableObject</super> <private>false</private> none deletedClasses keptClasses deletedMethods keptMethods deletedGlobals keptGlobals unreferencedClasses unreferencedGlobals unreferencedMethods options globalBindings cachedDefaults <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderItems
RuntimeBuilderItems holds collections of classes, methods, and globals to be kept or deleted. RuntimeBuilderItems provides for setting default values and interfacing with the external file holding settings. RuntimeBuilderItems is a support class for the Runtime Packager tool, and has no public API. As such, this class gets stripped from the deployed image. Instance Variables: deletedClasses <IdentitySet of: Class> keptClasses <IdentitySet of: Class> keptMethods <IdentityDictionary key: Behavior value: Set> deletedMethods <IdentityDictionary key: Behavior value: Set> deletedGlobals <IdentitySet of: BindingReference> keptGlobals <IdentitySet of: BindingReference> unreferencedMethods <IdentityDictionary key: Behavior value: Set> unreferencedClasses <IdentitySet of: Class> unreferencedGlobals <IdentitySet of: BindingReference> options <RuntimeBuilderOptions> The encoding of deletedMethods, keptMethods, and unreferencedMethods is as a dictionary in which the key is the class or metaclass and the value is a set of selectors within the behavior.
</comment> <class> <name>RuntimeInstanceSurrogate</name> <environment>RuntimePackager</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeInstanceSurrogate
RuntimeInstanceSurrogate provides a superclass for surrogates of classes. A minimal set of methods is provided with all messages that are not understood routed to the RuntimeSurrogateManager for processing.
</comment> <class> <name>RuntimeClassSurrogate</name> <environment>RuntimePackager</environment> <super>RuntimePackager.RuntimeInstanceSurrogate</super> <private>false</private> none <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeClassSurrogate
RuntimeClassSurrogate provides a superclass for surrogates of metaclasses. A minimal set of methods is provided with all messages that are not understood routed to the RuntimeSurrogateManager for processing. RuntimeClassSurrogate is a support class for the Runtime Packager tool, and has no public API. As such, this class gets stripped from the deployed image.
</comment> <class> <name>RuntimeApplicationStartupSystem</name> <environment>Smalltalk</environment> <super>Core.UserApplication</super> <private>false</private> none <imports></imports> <category>System-Subsystems</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimeApplicationStartupSystem
This starts up the application specified by Runtime Packager. Packaged applications are started using the Subsystem mechanism, (class RuntimeApplicationStartupSystem is a subclass of Subsystem). Runtime Packager includes this class in the deployed image, and uses the #main method to invoke the startup class/method. The same mechanism is used in both headless images and those with an active GUI. Note that the startup sequence of subsystems depends upon their prerequisite ordering. For details, see the comment for class Subsystem and the "Application Developer's Guide" (located in the /doc subdirectory of the VisualWorks installation).
</comment> <class> <name>RuntimeHeadlessExample</name> <environment>RuntimePackager</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeHeadlessExample
RuntimeHeadlessExample provides a simple application for testing headless image support. RuntimeHeadlessExample is a support class for the Runtime Packager, and gets stripped from the deployed application.
</comment> <class> <name>RuntimeDeletedBehavior</name> <environment>RuntimePackager</environment> <super>Core.Behavior</super> <private>false</private> none originalName <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeDeletedBehavior
RuntimeDeletedBehavior provides a "meta" class for instances of the objects substituted for behaviors which are deleted. Messages sent to these objects are generally not understood and cause a signal to be raised. RuntimeDeletedBehavior is a support class for the Runtime Packager, and gets packaged with the deployed application. Instance Variables: originalName <Symbol | String> Class Variables: DeletedBehaviorReferencedSignal <Signal | nil> DummyMethodDictionary <MethodDictionary | nil>
</comment> <class> <name>RuntimeBuilderMemoryParams</name> <environment>RuntimePackager</environment> <super>RuntimePackager.RuntimeBuilderEditableObject</super> <private>false</private> none codeSize edenSize growthLimit incrementSize largeSize memoryLimit oldSize retryDecrement stackSize survivorSize fixedSize <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderMemoryParams
RuntimeBuilderMemoryParams holds the current settings for memory parameters. RuntimeBuilderMemoryParams is a support class for the Runtime Packager tool, and has no public API. As such, this class gets stripped from the deployed image. This class obtains the current space size values from ObjectMemory and the memory policy settings from ObjectMemory's current memory policy. Please consult ObjectMemory and MemoryPolicy for further information on what these memory parameters are used for. Instance Variables: codeSize <Number> The size (in bytes) of the Compiled CodeCache edenSize <Number> The size (in bytes) of Eden largeSize <Number> The size (in bytes) of the Large Space oldSize <Number> The size (in bytes) of the Old Space stackSize <Number> The size (in bytes) of the Stack Space survivorSize <Number> The size (in bytes) of the Survivor Space fixedSize <Number> The size (in bytes) of Fixed Space growthLimit <Number> The point where the system switches from a growth regime to a reclamation regime incrementSize <Number> The minimum amount of memory to try to grow by when needed memoryLimit <Number> The ceiling of memory growth retryDecrement <Number> The amount to decrease incrementSize by if there is not enough memory to grow by incrementSize
</comment> <class> <name>RuntimeSurrogateManager</name> <environment>RuntimePackager</environment> <super>Core.Object</super> <private>false</private> none recursionLock exemptClasses hookedSuperclasses hookedMethodDictionaries unhookClassBlock unhookMethodBlock surrogateMethods activeManager unhookingErrorSignal <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeSurrogateManager
RuntimeSurrogateManager maintains information needed to support class and instance surrogates. Surrogates are created by dynamically rearranging the class hierarchy and removing access to method dictionaries. RuntimeClassSurrogate and RuntimeInstanceSurrogate provide for routing message sends from surrogates to RuntimeSurrogateManager which in turn restores the hierarchy and method dictionary before resending the message previously not understood. A recursion lock is used to ensure integrity when multiple processes could potentially be sending messages to surroagates. Exempt classes are classes used in surrogate message processing. These classes themselves can not be surrogates due to the obvious recursion problem when they are referenced. There is a distinguished instance of RuntimeSurrogateManager which can be accessed through RuntimeSurrogateManager class>>activeManager. Normally a new instance is needed only if the surrogate manager itself has been corrupted (which probably will orphan some surrogates) or if the collection of exempt classes is changed. Instance Variables: recursionLock <RecursionLock> exemptClasses <IdentitySet> hookedSuperclasses <IdentityDictionary> hookedMethodDictionaries <IdentityDictionary> unhookClassBlock <BlockClosure | nil> hookedMethods <IdentityDictionary> unhookMethodBlock <BlockClosure | nil> surrogateMethods <OrderedCollection of: CompiledMethod > Class Variables: ActiveManager <RuntimeSurrogateManager | nil> UnhookingErrorSignal <Signal | nil>
</comment> <class> <name>RuntimeBuilderMessageTracer</name> <environment>RuntimePackager</environment> <super>Core.Object</super> <private>false</private> none notifier options items invertedSelectors invertedClasses exitClasses accessors globalBindings sentSelectors deletedClasses deletedGlobals referencedClasses referencedGlobals referencedMethods newSelectors newClasses blocksReferenced externalInterfaceClasses pragmaReferences <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderMessageTracer
RuntimeBuilderMessageTracer provides a way to trace message sends throughout the image to discover which classes, global, shared and methods may be removed when creating the runtime image. Description RuntimeBuilderMessageTracer is a support class for the Runtime Packager tool, and has no public API. This class gets stripped from the deployed image. Usage During the stripping process, an instance of this class is created, supplied with a collection of items to keep and options (an instance of RuntimeBuilderOptions). Tracing is done by sending #traceSystem. After #traceSystem is done, the instance variable items is fully popluated with the results. For example: tracer := RuntimeBuilderMessageTracer new. options := RuntimeBuilderOptions new setDefaults. keptItems := RuntimeBuilderItems new options: options; setDefaults. tracer options: options, tracer keptItems: keptItems. tracer traceSystem Starting from kept methods and kepts classes, class, global, and selector refrerences are accumulated. When no new references are discovered, the process is complete. See #traceMessages for the details. Instance Variables: notifier <RuntimeProgressNotifier> invertedSelectors <IdentityDictionary > accessors <IdentitySet of: Symbol> sentSelectors <IdentitySet of: Symbol> deletedClasses <IdentitySet of: Behavior> deletedGlobals <IdentitySet of: BindingReference> referencedClasses <IdentitySet of: Behavior> referencedGlobals <IdentitySet of: BindingReference > newSelectors <IdentitySet of: Symbol> newClasses <IdentitySet of: Behavior> options <RuntimeBuilderOptions> items <RuntimeBuilderItems> exitClasses <IdentitySet of: Behavior> referencedMethods <IdentityDictionary> pragmaReferences <List of: CompiledMethod> A cache of all CompiledMethods that reference the Pragma class directly, to save doing a senders operation for each pragma method
</comment> <class> <name>RuntimeBuilderMemoryParamEditor</name> <environment>RuntimePackager</environment> <super>RuntimePackager.RuntimeBuilderEditor</super> <private>false</private> none incrementSize growthLimit codeSize largeSize memoryLimit oldSize retryDecrement survivorSize edenSize stackSize fixedSize <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderMemoryParamEditor
RuntimeBuilderMemoryParamEditor provides editor services for the current settings for memory parameters. RuntimeBuilderMemoryParamEditor is part of the Runtime Packager tool, and has no public API. As such, this class gets stripped from the deployed image. Instance Variables: codeSize <ValueHolder on: Number> edenSize <ValueHolder on: Number> growthLimit <ValueHolder on: Number> incrementSize <ValueHolder on: Number> largeSize <ValueHolder on: Number> memoryLimit <ValueHolder on: Number> oldSize <ValueHolder on: Number> retryDecrement <ValueHolder on: Number> stackSize <ValueHolder on: Number> survivorSize <ValueHolder on: Number>
</comment> <class> <name>RuntimeDeletedInstance</name> <environment>RuntimePackager</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeDeletedInstance
RuntimeDeletedInstance provides a class defining the objects substituted for deleted classes. Instances of these objects use RuntimeDeletedInstance to provide methods, primarily in implementing doesNotUnderstand and selected compilation methods. RuntimeDeletedInstance is a support class for the Runtime Packager, and gets packaged with the deployed application.
</comment> <class> <name>RuntimeBuilderHelp</name> <environment>RuntimePackager</environment> <super>UI.ApplicationModel</super> <private>false</private> none helpString title <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderHelp
RuntimeBuilderHelp provides a way to display help text. RuntimeBuilderHelp is a support class for the Runtime Packager tool, and has no public API. As such, this class gets stripped from the deployed image. A special interface is provided for displaying license text that allow the user to accept or reject the license agreement. Instance Variables: helpString <Text> title <Text>
</comment> <class> <name>RuntimeBuilderTester</name> <environment>RuntimePackager</environment> <super>UI.ApplicationModel</super> <private>false</private> none mainApplication testStatus dynamicMethods dynamicClasses options keptItems testInProgress dynamicItemsText textInProgress progressIndicator acceptedDynamicMethods acceptedDynamicClasses exemptClasses tickCounter tickRate progressCounter activeTester <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeBuilderTester
RuntimeBuilderTester provides the user interface and implementation of the application testing environment. RuntimeBuilderTester is part of the Runtime Packager tool, and has no public API. As such, this class gets stripped from the deployed image. RuntimeBuilderTester provides a way to install surrogates for classes and methods that will be deleted in the final stripped image, and a mechanism for detecting references to these surrogates. Referenced items are fed back as kept items when the window is closed. ExemptClasses are classes that are used by the tester itself and thus do not participate in the reference detection process. Instance Variables: mainApplication <RuntimeBuilderUI> testStatus <ValueHolder on: Text> dynamicMethods <IdentitySet> dynamicClasses <IdentitySet> options <RuntimeBuilderOptions> keptItems <RuntimeBuilderItems> testInProgress <Boolean> dynamicItemsText <ValueHolder on: String> textInProgress <Boolean> progressIndicator <ValueHolder on: String> acceptedDynamicMethods <IdentitySet> acceptedDynamicClasses <IdentitySet> exemptClasses <IdentitySet> savedClassDeletions <OrderedCollection> savedLoadableMethods <Dictionary key: Behavior value: Set> savedParcels <Collection> tickCounter <Integer> tickRate <Integer> progressCounter <Integer> Class Variables: ActiveTester <RuntimeBuilderTester | nil >
</comment> <class> <name>RuntimeProgressNotifier</name> <environment>RuntimePackager</environment> <super>UI.ApplicationModel</super> <private>false</private> none progressCount text textWidget tickCount tickRate ended windowExtent progressString <imports></imports> <category>RuntimePackager</category> <attributes> <package>RuntimePackager</package> </attributes> </class> <comment> RuntimePackager.RuntimeProgressNotifier
RuntimeProgressNotifier provides a separate window in which progress messages can be written to show the user that work is being done and is proceeding as expected. RuntimeProgressNotifier is part of the Runtime Packager tool. As such, this class gets stripped from the deployed application. Instance Variables: tickCount <Integer> tickRate <Integer> text <ValueHolder on: Text> progressCount <Integer> textWidget <TextEditorView> ended <Boolean> windowExtent <Point> progressString <ValueHolder on: String>
</comment> <name>DebugInterruptMsg</name> <environment>RuntimePackager.RuntimeDebugNotifier</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>DebugErrorMsg</name> <environment>RuntimePackager.RuntimeDebugNotifier</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>ButtonTitles</name> <environment>RuntimePackager.RuntimeDebugNotifier</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>ActiveApplication</name> <environment>RuntimePackager.RuntimeBuilderUI</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>LicenseAccepted</name> <environment>RuntimePackager.RuntimeBuilderUI</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>UserInterruptMsg</name> <environment>RuntimePackager.RuntimeEmergencyNotifier</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>DumpFailedMsg</name> <environment>RuntimePackager.RuntimeEmergencyNotifier</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>ErrorOccurredMsg</name> <environment>RuntimePackager.RuntimeEmergencyNotifier</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>DialogClass</name> <environment>RuntimePackager.RuntimeEmergencyNotifier</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>ClassPrerequisites</name> <environment>RuntimePackager.RuntimeManagerStripper</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>LiteralKeyBlocks</name> <environment>RuntimePackager.RuntimeManagerStripper</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>DeletedClassesInOrder</name> <environment>RuntimePackager.RuntimeManagerStripper</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>AllDeletedBehaviors</name> <environment>RuntimePackager.RuntimeManagerStripper</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>DeletedBehaviorReferencedSignal</name> <environment>RuntimePackager.RuntimeDeletedBehavior</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>DummyMethodDictionary</name> <environment>RuntimePackager.RuntimeDeletedBehavior</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>NewMemoryPolicy</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>SanityCheckDeferredBindings</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>DeletedGlobals</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>StartupClassName</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>ImageIdentification</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>MemoryParams</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>RunState</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>DeletedClasses</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>TraceLevel</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>ImageDumperClass</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>LoadableParcels</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>QuitBlock</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>VWRelease</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>ErrorNotifierClass</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>LoadableNameSpaces</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>PostStripBlock</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>StrippingOptions</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>ErrorLogPath</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>LoadableClasses</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>ParcelsToUnload</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>LauncherClassNames</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <initializer>nil</initializer> <attributes> <package>RuntimePackager</package> </attributes> <name>StartupMethod</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>DeletedMethods</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>InstVarIndexes</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <name>ImagePath</name> <environment>RuntimePackager.RuntimeManager</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>RuntimePackager</package> </attributes> <methods> RuntimePackager.RuntimeBuilderAppModel <category>internals</category>
changeRequest "An attempt is being made to close the window. If changes have been made, confirm with user before close" super changeRequest ifFalse: [ ^false ]. self isChanged ifTrue: [ ( Dialog confirm: 'Changes have been made.\Do you want to discard them?' withCRs ) ifFalse: [ ^false ] ]. ^true
isChanged "Answer if a change has been made or is pending" | widget | isChanged ifTrue: [ ^true ]. " look for pending changes from text fields due to auto accept " self builder namedComponents keysAndValuesDo: [ :compName :comp | ( ( ( widget := comp widget ) isKindOf: View ) and: [ ( widget controller isKindOf: ParagraphEditor ) and: [ widget controller textHasChanged ] ] ) ifTrue: [ ^true ] ]. ^false
isChanged: aBoolean "Force the check for if a change has been made or is pending" isChanged := aBoolean.
resetChanges "Reset the indicator that changes have been made" isChanged := false.
update: anAspect "Note that an aspect has changed" anAspect == #value ifTrue: [ isChanged := true ].
</methods> <methods> RuntimePackager.RuntimeBuilderAppModel <category>initialize-release</category>
initialize "Initialize the instance" super initialize. isChanged := false.
</methods> <methods> RuntimePackager.RuntimeBuilderAppModel <category>interface opening</category>
open "Open if needed. Otherwise just bring to the front" ( self builder isNil or: [ self builder window isOpen not ] ) ifTrue: [ super open] ifFalse: [ self builder window raise expand ]
postBuildWith: aBuilder "Set up dependencies to track changes" self postBuildWith: aBuilder trackingChanges: true
postBuildWith: aBuilder trackingChanges: aBoolean "Set up dependencies to track changes" super postBuildWith: aBuilder. aBoolean ifTrue: [ aBuilder bindings keysAndValuesDo: [ :aspect :binding | ( binding isKindOf: Model ) ifTrue: [ binding addDependent: self ] ] ].
</methods> <methods> RuntimePackager.RuntimeBuilderAppModel <category>help</category>
overviewHelp "Open a general help window" RuntimeBuilderUI helpFor: #helpForOverview.
</methods> <methods> RuntimePackager.RuntimeBuilderEditor <category>actions</category>
accept "Accept the input if valid. Answer true if the contents are valid and the window can be closed." | valid | ( valid := self validate ) ifTrue: [ self isChanged ifTrue: [ self copyValuesToSubject. self subject changed. isChanged := false. ]. self terminateEdit. self closeRequest. ]. ^ valid
cancel "Discard any values input and close the window" self terminateEdit. isChanged := false. self closeRequest.
refresh "refresh the view with new values in the subject." super initialize. self copyValuesFromSubject. warnings := IdentitySet new.
</methods> <methods> RuntimePackager.RuntimeBuilderEditor <category>internals</category>
changeRequest "An attempt is being made to close the window. If changes have been made, confirm with user before close" super changeRequest ifFalse: [ ^false ]. self terminateEdit. ^true
copyValuesFromSubject "Copy values from the options into receivers aspects (ValueHolders)" self subclassResponsibility
copyValuesToSubject "Copy values from the options into receivers aspects (ValueHolders)" subject hasBeenEdited: true.
terminateEdit "Terminate the edit on the subject, if any" subject isNil ifFalse: [ subject terminateEdit ].
update: anAspect with: aParam from: anObject "If an aspect is changed, remove it from already issued warnings dictionary" warnings remove: anObject ifAbsent: [ ]. super update: anAspect with: aParam from: anObject.
</methods> <methods> RuntimePackager.RuntimeBuilderEditor <category>name spaces</category>
classIsDefinedWithName: aString "Answer true if the class fully named in aString is defined" | class | class := self classNamed: aString. ^ class notNil and: [ class isBehavior and: [ class isMeta not ] ]
classNamed: aString "Convert the full name provided in aString into a class. Answer nil if not found" ^ self classNamed: aString ifAbsent: [ nil ]
classNamed: aString ifAbsent: aBlock "Convert the full name provided in aString into a class. Answer the value of aBlock if not found" ^aString asString asQualifiedReference valueOrDo: aBlock
</methods> <methods> RuntimePackager.RuntimeBuilderEditor <category>initialize-release</category>
initialize "Initialize the instance" super initialize. self copyValuesFromSubject. warnings := Set new.
</methods> <methods> RuntimePackager.RuntimeBuilderEditor <category>accessing</category>
subject "answer the RuntimeBuilderOptions being editted." ^subject
subject: anObject "Set the RuntimeBuilderOptions being editted." subject := anObject
</methods> <methods> RuntimePackager.RuntimeBuilderEditor <category>validations</category>
validate "Validate all fields. Answer true if all validations are passed. Typically this is overridden in subclasses" ^true
validatePositive: anAspect "Check that an aspect has a postive numeric value" | aspectValue | aspectValue := ( self perform: anAspect) value. ( aspectValue <= 0) ifTrue: [ ( self builder componentAt: anAspect ) takeKeyboardFocus. Dialog warn: 'Value must be positive'. ^ false ]. ^true
validateRange: anAspect low: low high: high "Check that an aspect is within the range provided" | aspectValue | aspectValue := ( self perform: anAspect) value. ( aspectValue < low or: [ aspectValue> high ] ) ifTrue: [ ( self builder componentAt: anAspect ) takeKeyboardFocus. Dialog warn: 'Value is out of range'. ^ false ]. ^true
validateRequiredValue: anAspect "Check that a required value has been provided" | aspectValue | aspectValue := ( self perform: anAspect ) value. ( aspectValue = 0 or: [ aspectValue = '' ] ) ifTrue: [ ( self builder componentAt: anAspect ) takeKeyboardFocus. Dialog warn: 'A value is required value is missing'. ^ false ]. ^true
warn: aString about: anObject "If a warning has not previously been issued about this object (typically a value holder for an aspect) issue one to the user. Answer true if the warning was issued" ( warnings includes: anObject ) ifFalse: [ warnings add: anObject. ^ ( Dialog choose: aString labels: #( 'Correct the error' 'Ignore this warning' ) values: #( #correct #ignore ) default: #correct ) == #correct ]. ^false.
</methods> <methods> RuntimePackager.RuntimeBuilderEditor class <category>internals</category>
decodeFromLiteralArray: anArray "Answer the result of sending a message to self. This is useful in building menus of menus" ^self perform: (anArray at: 2)
</methods> <methods> RuntimePackager.RuntimeBuilderEditor class <category>actions</category>
choose: aString fromList: aList "Prompt the user to choose from the list provided and answer the item choosed. If nothing is chosen, answer nil" ^(IncrementalSearchDialog forSelectionWithSearch: [:pattern | pattern isEmpty ifTrue: [aList] ifFalse: [aList select: [:each | pattern , '*' match: each]]]) windowLabel: aString; firstLabel: (#FilterC << #browser >> 'Filter:'); secondLabel: #MethodsC << #browser >> 'Methods:'; select.
findClass: prompt where: aBlock "Prompt for a class. Answer the class name selected or nil if none. Prompt is the string shown to the user in solicting the name." | dialog | dialog := IncrementalSearchDialog forSelectionWithSearch: [:pattern | Root allClasses select: [:each | (aBlock value: each) and: [('*', pattern, '*') match: each name]]]. dialog windowLabel: prompt. dialog firstLabel: (#FilterC << #browser >> 'Filter:'). dialog secondLabel: (#ClassesC << #browser >> 'Classes:'). ^dialog select.
findClassName: prompt "Prompt for a class. Answer the class name selected or nil if none. Prompt is the string shown to the user in solicting the name." | classFound | classFound := self findClass: prompt where: [ :cl | true ]. ^classFound isNil ifTrue: [ nil ] ifFalse: [ classFound fullName ]
findClassName: prompt where: aBlock "Prompt for a class. Answer the class name selected or nil if none. Prompt is the string shown to the user in solicting the name." | classFound | classFound := self findClass: prompt where: aBlock. ^classFound isNil ifTrue: [ nil ] ifFalse: [ classFound fullName ]
findSelectorUnderstoodBy: aClass where: aBlock "Prompt for a selector understood by the class provided. aBlock is evaluationed with each possible selector and only those which evaluate to true are considered as possibilities. Answer nil if none selected." | classes selectorList selectedMethod classSelectors | classes := OrderedCollection new: 12. classes add: aClass. [ classes last superclass notNil ] whileTrue: [ classes addLast: classes last superclass ]. selectorList := OrderedCollection new: classes size * 15. classes do: [ :cl | classSelectors := cl class selectors select: aBlock. classSelectors isEmpty ifFalse: [ selectorList addAll: classSelectors ] ]. selectorList isEmpty ifTrue: [ Dialog warn: 'No suitable methods were found'. ^ nil ]. selectorList := selectorList asSet asSortedCollection. selectedMethod := nil. [ selectedMethod := self choose: 'Select a method' fromList: selectorList. selectedMethod isNil ifTrue: [ ^ nil ]. selectedMethod isSymbol ifTrue: [ ^selectedMethod ]. ( Dialog confirm: 'An invalid selection was made.\Try again?' withCRs ) ] whileTrue: []. ^nil
</methods> <methods> RuntimePackager.RuntimeBuilderEditor class <category>instance creation</category>
on: subject "Answer an instance with the subject set to the RuntimeBuilderOptions supplied" ^self basicNew subject: subject; initialize.
</methods> <methods> RuntimePackager.RuntimeBuilderEditor class <category>interface opening</category>
open "Editors are not usually opened by themselves" Dialog warn: 'This window can not be opened without a subject to edit'
</methods> <methods> RuntimePackager.RuntimeMethodSurrogate <category>initialization</category>
cloneFromMethod: aMethod "Copy instance variables and literals from the method supplied. This only needs to handle CompiledMethods since only surrogates are used. Blocks are not truely copied since they do not exist in the template methods appearing in RuntimeSurrogateManager." " copy the instance variables " 1 to: self class instSize - 1 do: [ :idx | self instVarAt: idx put: ( aMethod instVarAt: idx ) ]. " now copy the literals " 1 to: aMethod basicSize do: [ :idx | self basicAt: idx put: ( aMethod basicAt: idx ) ].
</methods> <methods> RuntimePackager.RuntimeMethodSurrogate <category>accessing</category>
hookedMethod "Answer the method that this surrogate represents" ^hookedMethod
hookedMethod: aMethod "Set the method that this surrogate represents" hookedMethod := aMethod.
hookedSelector "Answer the selector that this surrogate represents" ^hookedSelector
hookedSelector: aSymbol "Set the selector that this surrogate represents" hookedSelector := aSymbol.
</methods> <methods> RuntimePackager.RuntimeMethodSurrogate <category>compatibility</category>
attributeMessages ^hookedMethod attributeMessages.
</methods> <methods> RuntimePackager.RuntimeMethodSurrogate class <category>instance creation</category>
cloneFromMethod: aMethod "Answer a new instance cloned from the method supplied" | x | x := self basicNew: aMethod basicSize. x cloneFromMethod: aMethod. ^x
</methods> <methods> RuntimePackager.RuntimeManager <category>method templates</category>
readConfigurationFile "Bypass reading the ENVY/Developer configuration file. This is probably no longer needed, but it is a clean kill of the configuration file access." ^self
toolsRuntimePackager "Method template added to VisualLauncher for VW 3.0 and above. Open Runtime Packager" "<menuItem: 'Runtime Packager' nameKey: nil menu: #(#menuBar #tools) position: 100.01>" ^( #{RuntimePackager.RuntimeBuilderUI} valueOrDo: [ Dialog warn: 'Runtime Packager is not loaded'. ^self ] ) open
unscheduleWindow: aWindow "This is a surrogate for WindowManager>>unscheduleWindow: It is used to shutdown the system when the last window is closed and to avoid opening the launcher during the final packaging step 1) gain access to RuntimeManager in a manner independent of home name space 2) Get known windows 3) if there are open windows, shut them down 4) if are we are in runtime image -- check for shutdown and if so, shutdown normal 5) are we are in a state where execution continues after the last window closes if so, close the dialog 6) otherwise, no special handling is needed" | windows managerClass runState | managerClass := #{RuntimePackager.RuntimeManager} value. windows := ScheduledWindow scheduledWindows. (windows size > 1 or: [windows size == 1 and: [(windows includes: aWindow) not]]) ifTrue: [^self rtpUnscheduleWindow: aWindow]. runState := managerClass runState. runState == #runtime ifTrue: [managerClass shutdownOnLastWin == true ifTrue: [^managerClass quitImageNormal]]. aWindow isModalDialog ifTrue: [^self rtpUnscheduleWindow: aWindow]. (managerClass continueOnLastWin or: [#(#aboutToSave #applicationStarting #autoShutdownInhibited) includes: runState]) ifTrue: [^self]. ^self rtpUnscheduleWindow: aWindow
</methods> <methods> RuntimePackager.RuntimeManager class <category>control</category>
addToLauncherMenu "Add to the Tools menu for the current VisualLauncher(s). This logic is used for VW 3.0 and above. The strange way the annotated method is created is to allow file-in with pre 3.0 versions of VW, which may no longer be really necessary" | mth | mth := self compiledMethodAt: #toolsRuntimePackager. mth := AnnotatedMethod fromMethod: mth. mth mclass: VisualLauncher; sourcePointer: nil; attributeMessages: ( Array with: ( Message selector: #'menuItem:nameKey:menu:position:' arguments: #('Runtime Packager' nil #(#menuBar #tools) 100.01) ) ). VisualLauncher addSelector: #toolsRuntimePackager withMethod: mth category: #actions.
hookNotifierClass: aClass "Hook up the class as an emergency notifier, for both GUI and headless operation. This is VW release dependent" | headless | Notifier current: aClass. headless := (self hiddenReferenceTo: 'BasicHeadlessSystem'). headless isNil ifFalse: [headless current headlessNotifier: aClass].
hookToWindowManager "Install intercept for WindowManager>>unscheduleWindow:" | mdict surrogate method | mdict := WindowManager instVarAt: self methodDictIndex. surrogate := (self compiledMethodAt: #unscheduleWindow:) copy. surrogate mclass: WindowManager. surrogate sourcePointer: nil. (mdict includesKey: #rtpUnscheduleWindow:) ifFalse: [method := mdict at: #unscheduleWindow:. mdict at: #rtpUnscheduleWindow: put: method]. mdict at: #unscheduleWindow: put: surrogate copy. WindowManager flushVMmethodCache
installHooks "Install any necessary hooks for runtime environment" self hookToWindowManager.
removeFromLauncherMenu "Remove from the Tools menu for the current VisualLauncher(s). This logic is used for VW 3.0 and above" VisualLauncher simplyRemoveSelector: #toolsRuntimePackager.
startupApplication "Start the application and check to see if we should continue" " look for special startup procedures " ( self canUnderstand: #startupApplication ) ifTrue: [ self new startupApplication. ]. RunState := #applicationStarting. " set a variable that is otherwise not initialized as a sanity check. if the deferred binding process is working, the binding should be resolved now." SanityCheckDeferredBindings := true. " actually start the application " self startupClass notNil ifTrue: [ self startupClass perform: StartupMethod ]. RunState := #runtime. " if no windows are open then shutdown the image " self shutdownOnLastWin ifTrue: [ self processEventsToDetectWindows. ScheduledWindow scheduledWindows isEmpty ifTrue: [ RuntimeManager quitImageNormal] ].
unhookFromWindowManager "Remove intercept for WindowManager>>unscheduleWindow:" | mdict method | mdict := WindowManager instVarAt: self methodDictIndex. (mdict includesKey: #rtpUnscheduleWindow:) ifTrue: [method := mdict at: #rtpUnscheduleWindow:. mdict at: #unscheduleWindow: put: method. mdict removeKey: #rtpUnscheduleWindow:. WindowManager flushVMmethodCache]
unhookNotifierClass "Restore the emergency error notifier." Notifier beDevelopment
</methods> <methods> RuntimePackager.RuntimeManager class <category>utility</category>
allClassesDo: aBlock "Evaluate aBlock with each class in the image. This method is located here to allow release dependent versions to be done later if needed." SystemUtils allClassesDo: aBlock.
allGlobalsFrom: aNameSpace "Answer binding references for all the the globals (general bindings) in aNameSpace or those contained it." | globals envRef | globals := OrderedCollection new. envRef := aNameSpace fullyQualifiedReference asQualifiedReference. aNameSpace bindingsDo: [ :binding | binding isForGeneral ifTrue: [ globals add: ( envRef append: binding key ) ]. binding isForNameSpace ifTrue: [ globals addAll: ( self allGlobalsFrom: binding value ) ] ]. ^globals
allNameSpacesFrom: aNameSpace "Answer an ordered collection of the name spaces contained in aNameSpace and those name spaces in turn." | nameSpaces | nameSpaces := OrderedCollection with: aNameSpace. aNameSpace bindingsDo: [ :binding | ( binding isForNameSpace and: [ binding value isObsolete not ] ) ifTrue: [ nameSpaces addAll: ( self allNameSpacesFrom: binding value ). ] ]. ^nameSpaces
cleanUpDeferredBindings "Reset extraneous value references in DeferredBindings and ResolvedDeferredBindings. The values are never used but cause extraneous entries in Undeclared." | idx dbClass rdbClass | " cache things that must not change while this is executing" idx := RuntimeManager resolvedValueIndex. dbClass := DeferredBinding. rdbClass := ResolvedDeferredBinding. " fix all instances watching for the possibility that an instances's class may change while this is running " dbClass allInstancesDo: [ :binding | ( binding instVarAt: idx ) isNil ifFalse: [ [ binding class == dbClass ifTrue: [ binding instVarAt: idx put: nil ] ] valueUnpreemptively. ] ]. rdbClass allInstancesDo: [ :binding | ( binding instVarAt: idx ) isNil ifFalse: [ [ binding class == rdbClass ifTrue: [ binding instVarAt: idx put: nil ] ] valueUnpreemptively. ] ].
expandedFilenameFrom: aString "If this version of VW supports it, expand the string by substituting environment variables and make a file name out of the result." ^ ( self expandedStringFrom: aString ) asFilename
expandedStringFrom: aString "If this version of VW supports it, expand the string by substituting environment variables using the Filename methods" ^ Filename expandEnvironmentIn: aString
hiddenReferenceTo: aString "Answer a class or global named by aString or nil if none. This particular way of doing things avoids the compiler. aString is assumed to name something accessible from the current environment. " "RuntimeManager hiddenReferenceTo: 'RuntimeBuilderUI' " "RuntimeManager hiddenReferenceTo: 'Fraction' " | names | names := ( aString tokensBasedOn: $. ) collect: [:x | x asSymbol ]. ^ ( BindingReference new path: names; class: nil home: self environment ) valueOrDo: [ nil ]
in: anObject performWithoutReference: aString "Perform the selector named by aString in anObject without creating a detectable reference to the selector. aString holds the selector name prefixed with a single underscore." ^ self in: anObject performWithoutReference: aString withArguments: ( Array new: 0 )
in: anObject performWithoutReference: aString withArguments: anArray "Perform the selector named by aString in anObject without creating a detectable reference to the selector. aString holds the selector name prefixed with a single underscore." | selector | selector := ( aString first = $_ ifTrue: [ aString copyFrom: 2 to: aString size ] ifFalse: [ aString ] ) asSymbol. ^ anObject perform: selector withArguments: anArray
logicalFileSpecFrom: aString "Answer a LogicalFileSpecification based on the string supplied. If the conversion fails, answer nil." ^ [ aString asLogicalFileSpecification ] on: Error do: [ :ex | ex return: nil ]
processEventsToDetectWindows "On application startup allow enough events to be processed to fill ScheduledWindow scheduledWindows collection." WindowManager allInstancesDo: [:wm | wm hasWindows ifTrue: [ [ScheduledWindow scheduledWindows isEmpty ifFalse: [^self]. wm processNextAvailableEvent] whileTrue]]
purgeUndeclaredEntries "Purge entries in Undeclared which are unreferenced and currently bound to nil. Answer with a collection of the keys removed." | allKeys | allKeys := Undeclared keys. Undeclared purgeUnusedBindings. "Answer what was deleted" ^allKeys reject: [ :x | Undeclared includesKey: x ]
valueWithoutShutdownOf: aBlock "Evaluate a block during which the image will not shutdown when no windows are open. This is useful if a dialog or windows needs to be closed before the next window is open. Answer the value of the block." | ans saveState | saveState := RunState. RunState := #autoShutdownInhibited. ans := aBlock ensure: [RunState := saveState]. ^ans
</methods> <methods> RuntimePackager.RuntimeManager class <category>encapsulation breaking</category>
bytesIndex "Answer the instVarAt: value for bytes in CompiledCode" ^self instVarIndexes at: #bytes
initializeInstVarIndexes "Initialize a dictionary of instance variable indexes for instance variables that must be accessed outside of normal protocols" InstVarIndexes := IdentityDictionary new. InstVarIndexes add: #quiescentProcessLists -> ( ProcessorScheduler allInstVarNames indexOf: 'quiescentProcessLists' ); add: #methodDict -> ( Behavior allInstVarNames indexOf: 'methodDict' ); add: #organization -> ( ClassDescription allInstVarNames indexOf: 'organization' ); add: #bytes -> ( CompiledMethod allInstVarNames indexOf: 'bytes' ); add: #resolvedValue -> ( DeferredBinding allInstVarNames indexOf: 'resolvedValue' ).
methodDictIndex "Answer the instVarAt: value for methodDict in Behavior" ^self instVarIndexes at: #methodDict
organizationIndex "Answer the instVarAt: value for organization in ClassDescription" ^self instVarIndexes at: #organization
quiescentProcessListsIndex "Answer the instVarAt: value for quiescentProcessLists in ProcessorScheduler" ^self instVarIndexes at: #quiescentProcessLists
resolvedValueIndex "Answer the instVarAt: value for resolvedValue in DeferredBinding" ^self instVarIndexes at: #resolvedValue
selectorsInClass: aClass "Answer a collection of the selectors in a class using primitive access techniques to avoid hidden code schemes. MethodDictionary is different in VW 4.0. Just use the standard methods until the need arises for something different." ^aClass selectors
</methods> <methods> RuntimePackager.RuntimeManager class <category>accessing</category>
continueOnLastWin "Answer true if the image is to continue when the last window closes. Note that this is not the opposite of shutdown -- the other option is to use whatever standard behavior the base image provides" ^( StrippingOptions includes: #continueOnLastWin )
deletedClasses ^DeletedClasses
deletedClasses: anIdentitySet DeletedClasses := anIdentitySet
deletedGlobals ^DeletedGlobals
deletedGlobals: anIdentitySet DeletedGlobals := anIdentitySet
deletedMethods ^DeletedMethods
deletedMethods: anIdentitySet DeletedMethods := anIdentitySet
emergencyHandlerBlock "Answer the block used to handle unhandled exceptions" RuntimeManager rtpObsoleteCode. "Should not need this now, but see if Notifier swap can be avoided. Maybe this is the right way to hook an exception handler again" ^ [ :ex :ctx | ErrorNotifierClass notify: ex context: ctx ]
errorLogPath ^ErrorLogPath
errorLogPath: aStringOrNil "Set the error log path to either a portable file specification or nil. The portable form is used so that this image can be run on different platforms than the one the image was created on. Conversion errors should be prevented by earlier validations, but if they occur, ErrorLogPath is set to nil. For VW 2.5, a string is used instead of the portable file form" aStringOrNil size = 0 ifTrue: [ ErrorLogPath := nil. ] ifFalse: [ ErrorLogPath := self logicalFileSpecFrom: aStringOrNil. ]
errorNotifierClass "Answer the class to use for emergency error notification." ^ErrorNotifierClass
errorNotifierClass: aClassOrNil ErrorNotifierClass := aClassOrNil
imageDumperClass "Answer the class to use for dumping the image in emergency error notification." ^ImageDumperClass
imageDumperClass: aClassOrNil "Set the class to use for dumping the image in emergency error notification." ImageDumperClass := aClassOrNil
imageIdentification ImageIdentification isNil ifTrue: [ ^ 'An anonymous image' ]. ^ImageIdentification
imageIdentification: aString ImageIdentification := aString
imagePath ^ImagePath
imagePath: aString ImagePath := aString.
instVarIndexes "Answer a dictionary of instance variable indexes for instance variables that must be accessed outside of normal protocols" ^InstVarIndexes
launcherClassNames "Return a list of launcher class names, so we know which things to close as part of the final stripping process." LauncherClassNames isNil ifTrue: [LauncherClassNames := Array with: #VisualLauncher with: #WPENFIN]. ^LauncherClassNames.
launcherClassNames: anArray "Set the list of launcher class names, used to know which things to close as part of the final stripping process." LauncherClassNames := anArray.
loadableClasses ^LoadableClasses
loadableClasses: aSet LoadableClasses := aSet.
loadableNameSpaces ^LoadableNameSpaces
loadableNameSpaces: aCollection LoadableNameSpaces := IdentitySet withAll: aCollection.
loadableParcels ^LoadableParcels
loadableParcels: aCollection LoadableParcels := aCollection.
managerVersion "Answer a number indentifying this version of RuntimeManager" ^7.31
memoryParams ^MemoryParams
memoryParams: params MemoryParams := params.
parcelsToUnload ^ParcelsToUnload
parcelsToUnload: aSet ParcelsToUnload := aSet.
postStripBlock "Answer a block to be evaluated after the stripping process is complete but before the final image save. If nothing is to be done, answer nil" ^PostStripBlock
postStripBlock: aBlockOrNil "Set a block to be evaluated after the stripping process is complete but before the final image save." " validate this nowto prevent problems in the strip when debugging is hard" aBlockOrNil notNil ifTrue: [ ( aBlockOrNil class == BlockClosure and: [ aBlockOrNil numArgs = 0 ] ) ifFalse: [ ^self error: 'PostStripBlock must be a zero-argument block or nil' ] ]. PostStripBlock := aBlockOrNil.
quitBlock "Answer a block (or nil) to be executed before quiting the image" ^QuitBlock
quitBlock: aBlockOrNil "Set the block (or nil) to be executed before quiting the image. If a block is provided, it should accept either one or zero arguments -- see RuntimeManager quitImage for arguments" QuitBlock := aBlockOrNil
runState "Answer the run state of the image" RunState isNil ifTrue: [ RunState := #development ]. ^RunState
runState: aSymbol "Set the run state of the image" RunState := aSymbol.
shutdownOnLastWin "Answer true if the image is to shutdown when the last window closes" ^( StrippingOptions includes: #shutdownOnLastWin )
startupClass "Answer the startup class by looking up the name or nil if none" ^StartupClassName isNil ifTrue: [ nil ] ifFalse: [ StartupClassName asQualifiedReference value ]
startupClass: aClassOrNil "Set the name of the startup class. Names are used in case the startup class is loaded via parcels." aClassOrNil isNil ifTrue: [ StartupClassName := nil ] ifFalse: [ StartupClassName := aClassOrNil fullName ].
startupMethod ^StartupMethod
startupMethod: aSymbol StartupMethod := aSymbol
strippingOptions "Answer the set of stripping options" ^StrippingOptions
strippingOptions: aSet "Set the set of stripping options" StrippingOptions := aSet.
traceLevel "Answer a number as the trace level for stripping. Values are: 0 - no debug tracing during stripping. 2 - trace class removals and namespace removals 4 - also trace method removals. When these values are referenced, they are hardcoded to avoid the potential for problems during stripping." " Usually this is left as nil -- do a lazy init response" ^TraceLevel isInteger ifFalse: [ TraceLevel := 0 ] ifTrue: [ TraceLevel ]
traceLevel: anInteger "Set a number as the trace level for stripping. See traceLevel method for values." TraceLevel := anInteger
vwRelease "Answer the VisualWorks release of this image" ^VWRelease
vwVersion "Returns the VisualWorks version number of this image as a Float. Used in comparison with the version recorded with the loaded params.rtp. Intended to distinguish between major releases (e.g. 7.4), minor releases (e.g. 7.4.1), and internal build releases (e.g. Pre-Release 7.4 (nov05.4))" | versionString version dictionary numbers isBuild maxSize | versionString := SystemUtils.SystemVersionName. dictionary := versionString groupedBy: [:e | e isDigit]. numbers := dictionary at: true. maxSize := numbers size. isBuild := maxSize > 3. isBuild ifTrue: [maxSize := numbers size - 3]. version := numbers copyFrom: 1 to: maxSize. maxSize = 2 ifTrue: [version := version , '0']. ^(Number readFrom: version readStream) asFloat / 100
</methods> <methods> RuntimePackager.RuntimeManager class <category>stripping</category>
copyMethodNamed: fromSelector as: toSelector in: toClass "Copy a method from RuntimeManager to another class adjusting the mclass along the way. The method must be valid in the target class (toClass)." self copyMethodNamed: fromSelector from: RuntimeManager as: toSelector in: toClass
copyMethodNamed: fromSelector from: fromClass as: toSelector in: toClass "Copy a method from one class to another adjusting the mclass along the way. The method must be valid in the target class (toClass)." | fromMethod copiedMethod | fromMethod := fromClass compiledMethodAt: fromSelector. " two copies are used to allow mclass to be changed and propogated to blocks " copiedMethod := ( fromMethod shallowCopy mclass: toClass ) copy. copiedMethod sourcePointer: nil. toClass addSelector: toSelector withMethod: copiedMethod.
copyMethodNamed: fromSelector toClass: toClass "Copy a method from RuntimeManager to another class adjusting the mclass along the way. The method must be valid in the target class (toClass)." self copyMethodNamed: fromSelector from: RuntimeManager as: fromSelector in: toClass
createAndSaveFinalImage "Create the final image and save it. This is done in RuntimeManager to ensure that methods and classes needed are not deleted from the image during this process. This method should always be kept even though it is not used at runtime. " " create an image identification if none present " ImageIdentification isNil ifTrue: [ ImageIdentification := 'Image created ', Date today printString, ' ', Time now printString. ]. " create the final image. Stop if this fails (when possible ) " RuntimeManagerStripper createFinalImage ifFalse: [ self unhookNotifierClass. RunState := #development. self unhookFromWindowManager. ^self ]. " discard the stripper class since its methods are no longer needed" RuntimeManagerStripper quietlyRemoveFromSystem. "Turn off the change set notification mechanism." 'ChangeSet.BroadcastChanges' asQualifiedReference ifDefinedDo: [:flag | 'ChangeSet.BroadcastChanges' asQualifiedReference value: false]. " evaluate the postStripBlock, if any" PostStripBlock notNil ifTrue: [ PostStripBlock value ]. " do the final save " ( StrippingOptions includes: #doThreeSaves ) ifTrue: [ self doThreeStepFinalImageSave ] ifFalse: [ self doOneStepFinalImageSave ].
doOneStepFinalImageSave "Save the final image in one step as a perm save" | saveMemoryPolicy | " tell user what is about to happen " self notifyUserNoninteractively: ( '\ Runtime image is about to be saved. ', '\ This window will close and then ', '\ reappear after the save completes. \' ) withCRs label: 'About to save' delay: 5. " compact memory, install memory policy, and do a perm save " ObjectMemory globalGarbageCollect. saveMemoryPolicy := ObjectMemory currentMemoryPolicy. ObjectMemory removeDependent: RuntimeManager. ( StrippingOptions includes: #headlessImage ) ifTrue: [ self prepareForSavingHeadlessImage. ]. ObjectMemory addDependent: RuntimeManager. ObjectMemory installMemoryPolicy: NewMemoryPolicy. DeploymentOptionsSystem current startInRuntime: true. ObjectMemory abortOrFinishIncrementalGC. ( ObjectMemory snapshotAs: ImagePath thenQuit: false withLoadPolicy: 1 "perm" ) ifTrue: [ "still executing the saved image" " Restore old memory policy just in case " ObjectMemory installMemoryPolicy: saveMemoryPolicy. " Put things back so the message window can open " ( StrippingOptions includes: #headlessImage ) ifTrue: [ self resetFromSavingHeadlessImage. ]. " Terminate the current image " self notifyUserNoninteractively: ( '\ Runtime image "' withCRs, ImagePath, '" saved. \ The current image will now be terminated. \' withCRs ) label: 'About to quit' delay: 5. RuntimeManager quitImageNormal. ].
doThreeStepFinalImageSave "Save the final image in three steps as described in Objectworks documentation. This is needed for shared perm space though it is unlikely that this will make a practical difference. AutoLoader and HeadlessImage are engaged just before the last save" | saveMemoryPolicy | " tell user what is about to happen " self notifyUserNoninteractively: ( ' \ The first of three saves is about to occur. \', ' After this save, the runtime image must be \', ' launched two more times to complete \', ' the process. \' ) withCRs label: 'About to do first save' delay: 5. " compact memory, install memory policy, and do a perm save " ObjectMemory globalGarbageCollect. saveMemoryPolicy := ObjectMemory currentMemoryPolicy. ObjectMemory installMemoryPolicy: NewMemoryPolicy. ObjectMemory abortOrFinishIncrementalGC. ObjectMemory removeDependent: RuntimeManager. ImageConfigurationSystem current canActivate: false. ( ObjectMemory snapshotAs: ImagePath thenQuit: false withLoadPolicy: 1 "perm" ) ifTrue: [ " Restore the memory policy just in case" ObjectMemory installMemoryPolicy: saveMemoryPolicy. " Terminate the current image after the first save " self notifyUserNoninteractively: '\ The first save of image "' withCRs, ImagePath, ( '" \ is now complete. The runtime image must be launched ', '\ two more times to complete the process. \' ) withCRs label: 'About to quit (1 of 3)' delay: 5. RuntimeManager quitImageNormal. ]. "restarted after the first snapshot" ObjectMemory globalGarbageCollect. ( ObjectMemory snapshotAs: ImagePath thenQuit: false ) ifTrue: [ "continuing image execution" self notifyUserNoninteractively: '\ The second save of image "' withCRs, ImagePath, ( '" \ is now complete. The runtime image must be launched', ' \ one more time to complete the process. \' ) withCRs label: 'About to quit (2 of 3)' delay: 5. RuntimeManager quitImageNormal ]. "restarted after second snapshot " ( StrippingOptions includes: #headlessImage ) ifTrue: [ self prepareForSavingHeadlessImage. ]. ObjectMemory addDependent: RuntimeManager. ImageConfigurationSystem current canActivate: true. DeploymentOptionsSystem current startInRuntime: true. ( ObjectMemory snapshotAs: ImagePath thenQuit: false ) ifTrue: [ "continuing image execution" ( StrippingOptions includes: #headlessImage ) ifTrue: [ self resetFromSavingHeadlessImage. ]. self notifyUserNoninteractively: '\ The third save of image "' withCRs, ImagePath, ( '" \ is now complete. The runtime image is now', ' \ ready to use. \' ) withCRs label: 'About to quit (3 of 3)' delay: 5. RuntimeManager quitImageNormal ]. " restarted after third snapshot " ^self
notifyUserNoninteractively: aString label: label delay: delaySeconds "Place a message in a window labeled with the label provided. After a delay, close the window and proceed" | msg rect win | #{WindowingSystem} ifDefinedDo: [:ws | ws isActive ifFalse: [^self]] elseDo: [^self]. " Open a window " msg := aString asComposedText. rect := Screen default bounds center - ( ( msg width @ msg height ) / 2 ) rounded extent: (msg width @ msg height ). win := ScheduledWindow openNewIn: rect. win label: label. [msg displayOn: win graphicsContext at: 0@0] uiEvent. " Allow UI window closes to complete and give user a chance to read message " (Delay forSeconds: delaySeconds) wait. win close. win windowManager terminate. WindowManager restoreAll.
prepareForSavingHeadlessImage "Set up for saving a headless image by positioning HeadlessImage in the ObjectMemory dependents and setting the appropriate flag." | headlessClass | " locate the class " headlessClass := self hiddenReferenceTo: 'HeadlessImage'. headlessClass isNil ifTrue: [ ^self ]. " set the magic flag " headlessClass default shouldSaveHeadless: true. " reset the startup file unless the compiler was kept " ( ( StrippingOptions includes: #removeCompiler ) not and: [ ( self hiddenReferenceTo: 'SmalltalkCompiler' ) notNil ] ) ifFalse: [ headlessClass default startupFilename: nil. ].
resetFromSavingHeadlessImage "Restore environment after saving a headless image."
</methods> <methods> RuntimePackager.RuntimeManager class <category>dynamic references</category>
dynamicallyReferencedClasses "Answer classes that can be dynamically referenced in the runtime image. This is both an example and a practical necessity. The following classes can be skipped in the scan of refrenced items in some cases." | classNames | " Some hardcoded classes to start" classNames := #( #Class #Metaclass #LicenseProtect #SystemError #RuntimeStartupController #PortableFilename #CompiledInitializer ) asOrderedCollection. classNames add: #Notifier. " Make sure the methods are not deleted" CompiledMethod withAllSubclasses do: [ :cl | ( #( #RuntimeMethodSurrogate #RuntimeCompiledMethod ) includes: cl name ) ifFalse: [ classNames add: cl name ] ]. " Save all CTypes to be safe" CType withAllSubclasses do: [ :cl | classNames add: cl name ]. ^classNames
dynamicallyReferencedGlobals "Answer globals that can be dynamically referenced in the runtime image. This is an example and a possibly a necessity " ^ #( #{Root.Root} #{Smalltalk.Root} #{Smalltalk.Smalltalk} #{Kernel.Processor} #{Core.Transcript } )
dynamicallyReferencedSelectors "Answer selectors that can be dynamically referenced in the runtime image. This is both an example and a practical necessity. The following selectors are used to create the runtime image and thus must be preserved." ^ #( " the following are probably referenced elsewhere but included for safety" #update:with:from: " pick up ObjectMemory dependents among others " #createAndSaveFinalImage " used by runtime manager for final image save " #returnFromSnapshot " restart after image save " #launchBaseProcess " references items used in starting WindowManagers" " a special null selector used in one of the older eval versions of VW" #'' " used in VW Eval version" " selectors known to the VM. see DefineOpCodePool class>>initializeSpecialSelectors for the technique used to locate the sysOopRegistry" #doesNotUnderstand: #cannotReturn: #mustBeBoolean #cannotResume #at: #at:put: #size #nonlocalReturn:through: #invoke:arguments: #invokeFromThread:arguments:process: #invoke #unlinkedCall:arguments: #badBytecodeAt: #literalsDo: )
itemsReferencedByClassSelector: aSelector "Answer a collection of the references in the class method named by aSelector or else answer nil to take normal defaults" aSelector == #removeFromSystem ifTrue: [ ^Array new ]. aSelector == #restoreNotifierDeploymentMethods ifTrue: [ ^Array new ]. aSelector == #replaceNotifierDeploymentMethods ifTrue: [ ^Array new ]. ^nil
</methods> <methods> RuntimePackager.RuntimeManager class <category>class initialization</category>
initialize "Initialize the class" RunState := #development. InstVarIndexes := nil. LoadableParcels := nil. DeletedClasses := nil. DeletedMethods := nil. StartupClassName := nil. StartupMethod := nil. ImagePath:= nil. VWRelease := nil. StrippingOptions := IdentitySet new.
initializeVWRelease "Initialize the VisualWorks release value based upon what is found in SystemDictionary>>version. Look for the first number and take that as the release level. This should work in most languages including Japanese. " | verStr | VWRelease := 9999. "unknown" verStr := Smalltalk version readStream. [ verStr atEnd not and: [ ( verStr peek) isDigit not ] ] whileTrue: [ verStr next ]. verStr atEnd ifFalse: [ VWRelease := Number readFrom: verStr ].
loaded "Perform all class initializations needed when the package is loaded. The references generated by this method are overridden and packagerLoaded is effectively hidden from the references scan." self packagerLoaded.
packagerLoaded "Perform all class initializations needed when the package is loaded" RuntimeManager initialize; initializeVWRelease; initializeInstVarIndexes. RuntimeBuilderUI initialize. RuntimeErrorNotifier initialize. RuntimeEmergencyNotifier initialize. RuntimeSurrogateManager initialize. Transcript cr; show: 'Runtime Packager loaded. '; cr; show: 'Do "RuntimePackager.RuntimeBuilderUI open" for initial window'; cr; show: 'or use Tools menu on launcher window'; cr. self addToLauncherMenu.
packagerRemoving "Close any open windows as part of removing the application" RuntimeBuilderUI activeApplication notNil ifTrue: [ RuntimeBuilderUI activeApplication closeRequest. ScheduledControllers checkForEvents. ]. self removeFromLauncherMenu. ObjectMemory removeDependent: self. RuntimeSurrogateManager removing.
removeFromSystem "Clean up changes to the system menu if the applicaiton is deleted. Note that this can be done twice, once per class or subclass" RuntimeManager rtpDependsOnEnvy. "This has never been really right -- it was done because of the way ENVY/Developer works, but the rationale needs to be rexamined. obsolete would be more appropriate." self == RuntimeManager ifTrue: [ self removeFromLauncherMenu. ObjectMemory removeDependent: self. ]. ^super removeFromSystem
removing "Close open windows before removing the application. The references generated by this method are overridden and packagerRemoving is effectively hidden from the references scan." self packagerRemoving.
</methods> <methods> RuntimePackager.RuntimeManager class <category>parcel actions</category>
postLoadActionFor: aParcel "Open the application when it is loaded from a Parcel" self loaded.
preUnloadActionFor: aParcel "Prepare to unload the application" self packagerRemoving.
</methods> <methods> RuntimePackager.RuntimeManager class <category>runtime</category>
quitImage: aParam "Quit the image doing any special cleanups before exiting. If the block in QuitBlock does not take arguments, then no argument is provided to it. aParam is passed to the quit block as an argument. Upon normal quit, aParam = #normal. Upon unhandled exception or user interrupt, aParam = #exception Other values can be used if understood by the quitBlock. QuitBlock may want to test RuntimeManager>>isRuntime if special handling is needed of the final quits prior to exiting the image after the save of the stripped image." QuitBlock notNil ifTrue: [ QuitBlock numArgs = 0 ifTrue: [ QuitBlock value ] ifFalse: [ QuitBlock value: aParam ] ]. ObjectMemory quit.
quitImageException "Quit the image due to an unhandled exception" self quitImage: #exception.
quitImageNormal "Quit the image under normal circumstances" self quitImage: #normal.
</methods> <methods> RuntimePackager.RuntimeManager class <category>markers</category>
rtpDependsOnEnvy "Marks code dependent on ENVY/Developer in ways that need to be addressed" ^true
rtpIsBroken "This message is sent to leave a cross reference to broken code. Eventually there should not be references" self notify: 'Executed a broken method in Runtime Packager'. ^true
rtpNeedsWork "References to this method note places of dubious code" ^true
rtpObsoleteCode "References to this method note places of obsolete code" ^true
</methods> <methods> RuntimePackager.RuntimeManager class <category>window unscheduling</category>
ensureUnscheduleWindow: aWindow | windowManager | windowManager := aWindow windowManager. (windowManager respondsTo: #rtpUnscheduleWindow:) ifTrue: [| noWindowBlock | [noWindowBlock := WindowManager.NoWindowBlock. WindowManager.NoWindowBlock := [:null | ]. windowManager rtpUnscheduleWindow: aWindow] ensure: [WindowManager.NoWindowBlock := noWindowBlock]]
</methods> <methods> RuntimePackager.RuntimeManager class <category>testing</category>
isHeadless "Answer true if this is a headless image, without introducing a dependency on having WindowingSystem loaded." | windowingSystem | windowingSystem := self hiddenReferenceTo: 'WindowingSystem'. ^windowingSystem notNil and: [windowingSystem isHeadless].
isRuntime "Answer true if the image is in runtime mode." ^RuntimeSystem isRuntime.
</methods> <methods> RuntimePackager.RuntimeManager class <category>copyright</category>
copyright ^SystemUtils copyright copyUpTo: Character cr.
</methods> <methods> RuntimePackager.RuntimeExample <category>aspects</category>
edenAlloc "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^edenAlloc isNil ifTrue: [edenAlloc := 0 asValue] ifFalse: [edenAlloc]
edenUsed "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^edenUsed isNil ifTrue: [edenUsed := 0 asValue] ifFalse: [edenUsed]
largeAlloc "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^largeAlloc isNil ifTrue: [largeAlloc := 0 asValue] ifFalse: [largeAlloc]
largeUsed "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^largeUsed isNil ifTrue: [largeUsed := 0 asValue] ifFalse: [largeUsed]
oldAlloc "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^oldAlloc isNil ifTrue: [oldAlloc := 0 asValue] ifFalse: [oldAlloc]
oldUsed "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^oldUsed isNil ifTrue: [oldUsed := 0 asValue] ifFalse: [oldUsed]
permAlloc "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^permAlloc isNil ifTrue: [permAlloc := 0 asValue] ifFalse: [permAlloc]
permUsed "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^permUsed isNil ifTrue: [permUsed := 0 asValue] ifFalse: [permUsed]
survAlloc "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^survAlloc isNil ifTrue: [survAlloc := 0 asValue] ifFalse: [survAlloc]
survUsed "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^survUsed isNil ifTrue: [survUsed := 0 asValue] ifFalse: [survUsed]
</methods> <methods> RuntimePackager.RuntimeExample <category>accessing</category>
edenAllocNow ^ObjectMemory current edenBytes
edenUsedNow ^ObjectMemory current edenUsedBytes
largeAllocNow ^ObjectMemory current largeBytes
largeUsedNow ^ObjectMemory current largeUsedBytes
oldAllocNow ^ObjectMemory current oldBytes
oldUsedNow | om | om := ObjectMemory current. ^( om oldDataBytes + ( om bytesPerOTE * om oldOTEs ) + ( om bytesPerRTE * om oldRtUsedEntries) )
permAllocNow ^ObjectMemory current permBytes
permUsedNow | om | om := ObjectMemory current. ^( om permDataBytes + ( om bytesPerOTE * om permOTEs ) )
survAllocNow ^ObjectMemory current survBytes
survUsedNow ^ObjectMemory current survUsedBytes
</methods> <methods> RuntimePackager.RuntimeExample <category>actions</category>
forceError "An error was requested by the user to test error handling" Transcript cr; show: 'Error requested by user'. ^self error: 'Error requested by user'
setValues "Set the values for the different aspects based on the current memory usage" self edenAlloc value: self edenAllocNow. self edenUsed value: self edenUsedNow. self largeAlloc value: self largeAllocNow. self largeUsed value: self largeUsedNow. self oldAlloc value: self oldAllocNow. self oldUsed value: self oldUsedNow. self permAlloc value: self permAllocNow. self permUsed value: self permUsedNow. self survAlloc value: self survAllocNow. self survUsed value: self survUsedNow.
</methods> <methods> RuntimePackager.RuntimeExample <category>initialization</category>
initialize "Initialize the instance" self setValues.
</methods> <methods> RuntimePackager.RuntimeExample class <category>parcel actions</category>
postLoadActionFor: aParcel "Open the application when it is loaded from a Parcel" self open.
</methods> <methods> RuntimePackager.RuntimeBuilderClassChooser <category>internals</category>
allClassesAndBindingReferencesDo: aBlock "Copied from BrowserEnvironment's bindingReferencesDo:, but actually creating the binding references in the real namespace that owns them, and not filtering" "self basicNew allClassesAndBindingReferencesDo: [:each | each yourself]" Root withAllNameSpacesDo: [:ns | | ref | ref := ns fullyQualifiedReference. ns bindingsDo: [:each | aBlock value: (each isForClass ifTrue: [each value] ifFalse: [ref append: each key])]]. Root allBehaviorsDo: [:cls | cls isMeta ifFalse: [cls asNameSpace bindingsDo: [:each | | ref | ref := cls fullyQualifiedReference. aBlock value: (each isForClass ifTrue: [each value] ifFalse: [ref append: each key])]]].
buildCategoryList "Build the list of all system categories or applications" self categoryListTitle value: ('Packages/Bundles (<1p> selected)' expandMacrosWith: self systemPackagesTree selections size) asText allBold.
buildSelectableClassList "Build a list of classes that can be selected based on current category selections. The list contains entries of associations where the key is the name of the class in text and the value is the class. The name is italic if the class is not defined in one of the applications/categories selected" self buildSelectableClassListFor: self systemCategoriesList selections.
buildSelectableClassListFor: pundles "Build a list of classes that can be selected based on current category selections. The list contains entries of associations where the key is the name of the class in text and the value is the class. The name is italic if the class is not defined in one of the applications/categories selected." " initialize sets that are built one category/application at a time" selectableClasses := IdentitySet new. definedClasses := IdentitySet new. bindingsInCurrentlySelected := IdentitySet new. selectedSubapplications := IdentitySet new. pundles do: [ :eachPundle | self addClassesInPundle: eachPundle ]. " now build the list of selectable classes and globals " selectableClassList := List new. selectableClassList addAll: ( bindingsInCurrentlySelected collect: [:ref | ( Text string: ' Data ' emphasis: #italic ), ref toolListDisplayString -> ref ] ). selectableClasses do: [ :cl | ( definedClasses includes: cl ) ifTrue: [ selectableClassList add: ( cl fullyQualifiedReference toolListDisplayString asText -> cl) ] ifFalse: [ selectableClassList add: ( Text string: cl fullyQualifiedReference toolListDisplayString emphasis: #italic ) -> cl] ]. " sort by name " selectableClassList sort.
categoriesForClass: aClassOrBindingReference "Answer a collection of the appropriate category, application, or subapplication depending on the current display mode." | paths immediatePackages | immediatePackages := (aClassOrBindingReference isBehavior) ifTrue: [Store.Registry packagesContaining: aClassOrBindingReference] ifFalse: [ (aClassOrBindingReference value isNameSpace and: [aClassOrBindingReference environment isBehavior not]) ifTrue: ["This is a 'global' namespace, rather than a class shared. This is odd, in that we have to ask for Store.Registry containingPackageForNameSpace: Kernel.UI, but Store.Registry allContainingPackagesForDataKey: #Processor owner: Kernel" (Array with: (Store.Registry containingPackageForNameSpace: aClassOrBindingReference value))] ifFalse: [Store.Registry allContainingPackagesForDataKey: aClassOrBindingReference name owner: aClassOrBindingReference environment]]. paths := immediatePackages inject: Array new into: [:sum :each | sum, (self containmentPathsFor: each)]. ^paths.
classesMatching: aBlock "Copied from the RB" | names | names := Set new. self allClassesAndBindingReferencesDo: [:each | (aBlock value: each) ifTrue: [names add: each]]. ^names
containmentPathsFor: aPundle | parents | parents := (Store.Registry enclosingComponentsFor: aPundle) asArray. parents isEmpty ifTrue: [^Array with: (Array with: aPundle)]. ^parents inject: OrderedCollection new into: [:allPaths :eachParent | allPaths addAll: ((self containmentPathsFor: eachParent) collect: [:eachPath | eachPath, (Array with: aPundle)]). allPaths].
expressInterests "Setup interests in changed window contents" self systemCategoriesList selectionIndexHolder onChangeSend: #systemCategoriesSelectionChanged to: self.
findPackage: prompt "Prompt for a category. Answer the category name selected or nil if none. Prompt is the string shown to the user in solicting the name." | dialog thePundle | dialog := IncrementalSearchDialog forSelectionFrom: (Store.Registry allPundles) filterBlock: [:entry :pundle | entry, '*' match: pundle name]. dialog windowLabel: #FindPackageOrBundle << #browser >> 'Find Package or Bundle'; firstLabel: #FilterC << #browser >> 'Filter:'; secondLabel: #PackagesAndBundlesC << #browser >> 'Packages and Bundles:'; objectToStringBlock: [:pundle | pundle name]; iconSelector: #toolListIcon. thePundle := dialog select. ^thePundle.
movableClassesFrom: selections "Answer the classes in selections that are not extensions. selections is a collection of associations in which the actual class is the value of the association. If the value is a symbol, it represents a global, which can always be moved" | classes | classes := OrderedCollection new. selections do: [ :assoc | (definedClasses includes: assoc value ) ifTrue: [ classes add: assoc value ] ]. ^classes
moveClassSelectionsFrom: fromMS to: toMS "Move the items selected in fromMS (a MultiSelectionInList) to toMS (also a MultSelectionInList). Answer the selections moved. Only move entries associated with defined classes or globals" | selections | selections := fromMS selections select: [ :sel | sel value isBindingReference or: [ definedClasses includes: sel value ] ]. ^self moveSelectionsFrom: fromMS to: toMS selections: selections
moveSelectionsFrom: fromMS to: toMS "Move the items selected in fromMS (a MultiSelectionInList) to toMS (also a MultSelectionInList). Answer the selections moved." ^self moveSelectionsFrom: fromMS to: toMS selections:fromMS selections
moveSelectionsFrom: fromMS to: toMS selections: selections "Move the items selected in fromMS (a MultiSelectionInList) to toMS (also a MultSelectionInList). Answer the selections moved." | selSet toList | "optimize some common cases" selections isEmpty ifTrue: [ ^OrderedCollection new ]. " handle the general case " selSet := selections asSet. fromMS list: ( fromMS list reject: [ :x | selSet includes: x ] ). toList := toMS list. toMS list: List new. "Temporarily break a relationship" toList addAll: selections; sort. toMS list: toList. "Restore the relationship" self setSelections: selSet in: toMS. ^selections
nameSpaceTreeFrom: aNameSpace "Answer a tree containing the name space with its contained name spaces as children. If aNameSpace is nil, start from Root. The top level key is not shown in the hierarchial list, so this allows Root to appear." | tree bindings | aNameSpace isNil ifTrue: [ tree := AssociationTreeWithParent key: 'nil' value: nil. tree addChild: (self nameSpaceTreeFrom: Root ). ^tree ]. tree := AssociationTreeWithParent key: aNameSpace name value: aNameSpace. bindings := OrderedCollection new. aNameSpace bindingsDo: [ :binding | ( binding isForNameSpace and: [ binding value isObsolete not and: [ binding value ~~ Undeclared ] ] ) ifTrue: [ bindings add: binding ] ]. " sort the name spaces by name and add recursively " ( bindings asSortedCollection: [ :x :y | x key < y key ] ) do: [ :binding | tree addChild: ( self nameSpaceTreeFrom: binding value ) ]. ^tree
referencesMatchingPartialName: aString "Copied from the RB" | pattern matches nameSelector | aString trimBlanks isEmpty ifTrue: [^Array new]. pattern := aString trimBlanks. pattern := (pattern includes: $*) ifTrue: [pattern] ifFalse: ['*', pattern, '*']. nameSelector := (pattern includes: $.) ifTrue: [#fullName] ifFalse: [#name]. matches := self classesMatching: [:each | pattern match: (each perform: nameSelector)]. ^matches asSortedCollection: [:a :b | a toolListDisplayString < b toolListDisplayString]
retractInterests "Retract interests in changed window contents" self systemCategoriesList selectionIndexHolder retractInterestsFor: self.
setSelectionOnValues: aCollection in: msl "Set the selections in msl (aMultiSelectionInList) to match the values contained in aCollection." | selSet indexes | selSet := Set new: aCollection size * 3 // 2. aCollection do: [ :x | selSet add: x value ]. indexes := Set new: aCollection size * 3 // 2. 1 to: msl list size do: [ :i | ( selSet includes: (msl list at: i ) value ) ifTrue: [ indexes add: i ] ]. msl selectionIndexes: indexes.
setSelections: aCollection in: msl "Set the selections in msl (aMultiSelectionInList) to aCollections. This is conceptually the same as the selections: method, but faster when there are many selections." | selSet indexes | aCollection size < 3 ifTrue: [ msl selections: aCollection ] ifFalse: [ selSet := aCollection asSet. indexes := Set new: aCollection size * 3 // 2. 1 to: msl list size do: [ :i | ( selSet includes: (msl list at: i ) ) ifTrue: [ indexes add: i ] ]. msl selectionIndexes: indexes. ].
</methods> <methods> RuntimePackager.RuntimeBuilderClassChooser <category>aspects</category>
categoryListTitle "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^categoryListTitle isNil ifTrue: [categoryListTitle := Text new asValue] ifFalse: [categoryListTitle]
nameSpaceList "Answer the list of system category (organization) names" ^nameSpaceList isNil ifTrue: [nameSpaceList := IndentedTreeSelectionInList newEmptyInstance] ifFalse: [nameSpaceList]
systemCategoriesList self subclassResponsibility
</methods> <methods> RuntimePackager.RuntimeBuilderClassChooser <category>actions</category>
clearAllCategories "Clear all system categories in the selection list" self systemCategoriesList treeHolder selectionIndexes: OrderedCollection new.
findCategoryWithGlobal "Prompt for a class and select the category containing it. Answer the class selected or nil if none" | dialog bindingRef | dialog := IncrementalSearchDialog forSelectionWithSearch: [:entry | self referencesMatchingPartialName: entry]. dialog windowLabel: #FindPackageForClassVariableOrNameSpace << #browser >> 'Find Package for Class, Variable, or Name Space'; firstLabel: #FindC << #browser >> 'Find:'; secondLabel: #ClassesNamespacesAndVariablesC << #browser >> 'Classes, Variables, Name Spaces:'; iconSelector: #toolListIcon; displayStringSelector: #toolListDisplayString; objectToStringBlock: [:class | class name asString]. bindingRef := dialog select. bindingRef isNil ifTrue: [^nil]. bindingRef notNil ifTrue: [ self findCategoryWithGlobal: bindingRef. ]. ^bindingRef
findCategoryWithGlobal: aGlobal "Prompt for a class and select the category containing it." | selectedPackagePaths | selectedPackagePaths := self categoriesForClass: aGlobal. selectedPackagePaths isEmpty ifTrue:[ ^nil ]. self systemCategoriesList treeHolder selectionIndexes: OrderedCollection new. selectedPackagePaths do: [:eachCollection | self systemCategoriesList addSelectPath: eachCollection]. "Multiselection tree views don't correctly make things visible in 7.3.1" (self systemCategoriesList widgetAt: #treeList) makeVisible: self systemCategoriesList treeHolder selectionIndexes first.
findPackage "Prompt for a category and select it." | package paths | package := self findPackage: 'Find and select package/bundle'. package isNil ifTrue: [ ^nil ]. paths := self containmentPathsFor: package. self systemCategoriesList treeHolder selectionIndexes: OrderedCollection new. paths do: [:each | self systemCategoriesList addSelectPath: each]. "Multiselection tree views don't correctly make things visible in 7.3.1" (self systemCategoriesList widgetAt: #treeList) makeVisible: self systemCategoriesList treeHolder selectionIndexes first.
nameSpaceSelectionChanged "Respond to a change in selections among name spaces." (self systemCategoriesList selections isEmpty and: [self nameSpaceList selection notNil]) ifTrue: [self selectAllCategories] ifFalse: [self systemCategoriesSelectionChanged]
refresh "Reset current selections if the underlying data has changed." self systemCategoriesList treeHolder selectionIndexes: OrderedCollection new. super refresh.
selectAllCategories "Select all system categories in the selection list" self systemCategoriesList treeHolder selectAll.
systemCategoriesSelectionChanged "Respond to a change in selections among system categories." self subclassResponsibility.
</methods> <methods> RuntimePackager.RuntimeBuilderClassChooser <category>interface opening</category>
postBuildWith: aBuilder trackingChanges: aBoolean "Initialize after the builder is done" super postBuildWith: aBuilder trackingChanges: aBoolean. self buildCategoryList. self expressInterests.
</methods> <methods> RuntimePackager.RuntimeBuilderClassChooser <category>accessing</category>
systemPackagesTree self subclassResponsibility.
</methods> <methods> RuntimePackager.RuntimeBuilderClassChooser class <category>resources</category>
systemSelectionMenu ^self subclassResponsibility.
</methods> <methods> RuntimePackager.RuntimeBuilderUI <category>internals</category>
changeRequest "See if the window can be closed. If so, cancel any opertions in progress" " See if window is being closed for image save " RuntimeManager runState == #aboutToSave ifTrue: [ ^true ]. " Proceed with normal checks for closing the window" super changeRequest ifFalse: [ ^false ]. ( tester notNil and: [ tester testInProgress ] ) ifTrue: [ Dialog warn: 'A test is in progress.\It must be ended before closing this window' withCRs. ^false ]. options cancel. keptItems cancel. tester notNil ifTrue: [ tester cancel ]. memoryParams cancel. ScheduledControllers scheduledControllers do: [ :ctrl | ( ctrl model isKindOf: RuntimeBuilderAppModel ) ifTrue:[ ctrl closeNoTerminate ] ]. ActiveApplication := nil. " clear the manager to, among other things, allow the application to be unloaded " RuntimeSurrogateManager activeManager: nil. ^true
closeExtraWindows: deletedClasses "Close all windows which directly reference classes that are being deleted, present company excepted." | controllers extras | WindowManager allInstancesDo: [:each | each purgeDeadWindows]. controllers := ScheduledControllers scheduledControllers reject: [ :controller | controller == self builder window controller or: [ controller model isKindOf: RuntimeBuilderAppModel ] ]. extras := controllers select: [ :controller | controller class isObsolete or: [ ( deletedClasses includes: controller class ) or: [ ( deletedClasses includes: controller view class ) or: [ ( deletedClasses includes: controller model class ) or: [ ( deletedClasses includes: controller sensor class ) ] ] ] ] ]. extras isEmpty ifFalse: [ ( interactWithUser not or: [ Dialog confirm: 'There are windows scheduled that reference deleted', '\classes. Do you want to close them now?' withCRs ] ) ifTrue: [ extras do: [ :controller | controller closeAndUnschedule ] ] ].
moveToStep: anInteger "Move to the user step indicated" | sels | " move to the indicated step " ( anInteger <= self class numberOfSteps and: [ anInteger > 0 ] ) ifTrue: [ currentStepNumber := anInteger. self stepTitle value: ( self class titleForStep: currentStepNumber ) asText allBold. self stepDescription value: ( self class summaryOfStep: currentStepNumber ) ]. " adjust the button states " ( self builder componentAt: #previousStepButton ) perform: ( currentStepNumber == 1 ifTrue: [ #disable ] ifFalse: [ #enable ] ). ( self builder componentAt: #nextStepButton ) perform: ( currentStepNumber == self class numberOfSteps ifTrue: [ #disable ] ifFalse: [ #enable ] ). " see if there are actions for this step " sels := self class selectorsForStep: currentStepNumber. ( self builder componentAt: #doThisStepButton ) perform: ( ( sels first isNil or: [ (sels at: 2) notNil and: [ ( self perform: (sels at: 2) ) not ] ] ) ifTrue: [ #disable ] ifFalse: [ #enable ] ). ( self builder componentAt: #takeDefaultsButton ) perform: ( ( sels last isNil or: [ (sels at: 2) notNil and: [ ( self perform: (sels at: 2) ) not ] ] ) ifTrue: [ #disable ] ifFalse: [ #enable ] ).
prepareToStripSystem "Open a window confirming that the stripping is to proceed. If the user approves the strip, set up RuntimeManager." | launcherControllers deletedClasses | ( tester notNil and: [ tester testInProgress ] ) ifTrue: [ Dialog warn: ( 'A test is in progress.\', 'It must be ended before performing this step' ) withCRs. ^false ]. " get the real set of classes to be deleted " deletedClasses := keptItems allDeletedClasses. " close any extraneous windows" self closeExtraWindows: deletedClasses. "Disconnect from Store and remove debug hooks" (RuntimeManager hiddenReferenceTo: 'Store.DbRegistry') ifNotNil: [:registry | registry disconnect]. (RuntimeManager hiddenReferenceTo: 'ProbedCompiledMethod') ifNotNil: [:probe | probe revertAllProbedMethodsInSystem]. " look for open launchers (Visual Launchers only) not caught in the previous step" launcherControllers := ScheduledControllers scheduledControllers select: [ :cont | RuntimeManager launcherClassNames includes: cont model class name]. launcherControllers size > 0 ifTrue: [ ( interactWithUser not or: [ Dialog confirm: 'Do you want to close all open visual launchers now?' ] ) ifTrue: [ launcherControllers do: [ :lc | lc closeAndUnschedule ] ] ]. " alert the user that this is the last chance to stop this process" interactWithUser ifTrue: [ ( Dialog confirm: 'This is the final step in preparing the runtime image. Any extraneous windows should already be closed and application windows that are to remain open should be in their desired position. Runtime Packager windows will be closed automatically. Once the preparation process begins, it should not be interrupted. The resulting runtime image will be saved automatically when the process completes. Do you want to proceed with this step?' ) ifFalse: [ ^false ] ]. RuntimeManager runState: #aboutToSave. " get final set of deleted classes and methods " RuntimeManager deletedClasses: deletedClasses. RuntimeManager deletedMethods: keptItems allDeletedMethods. RuntimeManager deletedGlobals: keptItems deletedGlobals copy. RuntimeManager deletedGlobals addAll: keptItems unreferencedGlobals. RuntimeManager loadableClasses: options loadableClasses. " setup runtime manager for exit/startup sequence " RuntimeManager strippingOptions: options strippingOptions; errorNotifierClass: options errorNotifierClass; imageDumperClass: options imageDumperClass; errorLogPath: options errorLogPath; imagePath: options imagePath; startupClass: options startupClass; startupMethod: options startupMethod; memoryParams: memoryParams; loadableParcels: options loadableParcels; loadableNameSpaces: options loadableNameSpaces; parcelsToUnload: options parcelsToUnload; traceLevel: options traceLevel. " install hooks so that all windows can be closed " RuntimeManager installHooks. " now that everything is set up, send the user defined message, if any" self sendPrestripMessage. " Remove as much of the UI as possible" options cancel. keptItems cancel. tester notNil ifTrue: [ tester cancel ]. memoryParams cancel. ScheduledControllers scheduledControllers do: [ :ctrl | ( ctrl model isKindOf: RuntimeBuilderAppModel ) ifTrue:[ ctrl closeNoTerminate ] ]. ActiveApplication := nil. self release. options := keptItems := tester := memoryParams := nil. self builder window controller closeAndUnschedule controlTerminate. " done without error" ^true
sendPrestripMessage "Send the prestrip message defined by the user. This can be used to hook up to the Runtime Manager for special handling during stripping" options prestripClass isNil | options prestripMethod isNil ifFalse: [ options prestripClass perform: options prestripMethod ].
</methods> <methods> RuntimePackager.RuntimeBuilderUI <category>aspects</category>
cleanupDone "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^cleanupDone isNil ifTrue: [cleanupDone := false asValue] ifFalse: [cleanupDone]
itemsDone "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^itemsDone isNil ifTrue: [itemsDone := false asValue] ifFalse: [itemsDone]
memoryDone "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^memoryDone isNil ifTrue: [memoryDone := false asValue] ifFalse: [memoryDone]
optionsDone "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^optionsDone isNil ifTrue: [optionsDone := false asValue] ifFalse: [optionsDone]
reviewDone "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^reviewDone isNil ifTrue: [reviewDone := false asValue] ifFalse: [reviewDone]
saveParcelsDone "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^saveParcelsDone isNil ifTrue: [saveParcelsDone := false asValue] ifFalse: [saveParcelsDone]
scanDone "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^scanDone isNil ifTrue: [scanDone := false asValue] ifFalse: [scanDone]
stepDescription "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^stepDescription isNil ifTrue: [stepDescription := String new asValue] ifFalse: [stepDescription]
stepTitle "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^stepTitle isNil ifTrue: [stepTitle := String new asValue] ifFalse: [stepTitle]
testDone "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^testDone isNil ifTrue: [testDone := false asValue] ifFalse: [testDone]
</methods> <methods> RuntimePackager.RuntimeBuilderUI <category>parcels</category>
defineParcelPrereqs: parcelAppls "Define prerequisite parcels based on Envy Application prereqs. ENVY/Developer is assumed to be present in the image. parcelAppls is an IdentityDictionary with the application as key and parcel as value." parcelAppls keysAndValuesDo: [ :pappl :parcel | | prereqs | prereqs := OrderedCollection new. " The first prereq is hard coded to allow use of Application classes in the parcel," prereqs add: #('ENVYManagerApplicationSupport' '' ) copy. " Add any loadable prerequisite applications as parcel prereqs" pappl prerequisites do: [ :appl | ( parcelAppls includesKey: appl ) ifTrue: [ | preq | preq := parcelAppls at: appl. prereqs add: ( Array with: preq name with: String new ) ] ]. parcel prerequisiteParcels: prereqs. ].
hasParcelsToBeSaved "Answer true if there are runtime loadable parcels" ^options hasParcelsToBeSaved
parcelsToBeSaved "Answer the parcels that are to be saved as part of this packaging operation" ^options loadableParcels.
trimParcel: aParcel "Answer a parcel copied from aParcel but with deleted classes and methods removed" | deletedClasses deletedMethods workParcel | " determine which classes and methods are deleted other than by being in parcels" deletedClasses := keptItems unreferencedClasses isEmpty ifTrue: [ keptItems deletedClasses ] ifFalse: [ keptItems unreferencedClasses ]. deletedMethods := keptItems unreferencedMethods isEmpty ifTrue: [ keptItems deletedMethods ] ifFalse: [ keptItems unreferencedMethods ]. workParcel := aParcel copy. "Now we have a working copy that can be changed. Remove deleted classes and methods using mostly public protocols" workParcel definedClasses do: [ :cl | ( deletedClasses includes: cl ) ifTrue: [ workParcel removeClasses: cl withAllSubclasses ] ]. workParcel definedAndExtendedClasses do: [ :cl | " need to work around a bug by deleting these selectors one at a time" ( deletedMethods includesKey: cl ) ifTrue: [ ( deletedMethods at: cl ) do: [ :sel | workParcel removeSelector: sel forClass: cl. ] ]. ( deletedMethods includesKey: cl class ) ifTrue: [ ( deletedMethods at: cl class ) do: [ :sel | workParcel removeSelector: sel forClass: cl class. ] ] ]. ^workParcel
</methods> <methods> RuntimePackager.RuntimeBuilderUI <category>actions</category>
doThisStepPushed "Act on the do step button. Make sure we have interactivity turned on." | sel | interactWithUser := true. sel := (self class selectorsForStep: currentStepNumber) first. sel notNil ifTrue: [ self perform: sel ].
loadParametersFile: filename "Load the parameters that are specified by filename. If there are any pending changes, they will be lost. Also, it is assumed that file is readable." | in fileVersion tokens actionBlocks | Transcript cr; show: (#LoadingRuntimePackagerParams << #RuntimePackager >> 'Loading Runtime Packager parameters from <1s>' expandMacrosWith: filename asString). in := filename readStream. fileVersion := 1.0. [tokens := Scanner new scanTokens: in contents] on: Object errorSignal do: [:ex | Dialog warn: (#x1sErrorOccured << #RuntimePackager >> '<1s><n>An error occurred scanning the settings file contents' expandMacrosWith: ex errorString). in close. ^self]. in close. " set up for processing tokens " actionBlocks := (Dictionary new) add: #version -> [:nbr | nbr isReal ifTrue: [fileVersion := nbr]]; add: #options -> [:tokenArray | options decodeFrom: tokenArray fileVersion: fileVersion]; add: #keptItems -> [:tokenArray | " for compatibility with version 2 files" keptItems decodeFrom: tokenArray fileVersion: fileVersion]; add: #keptAndDeletedItems -> [:tokenArray | keptItems decodeFrom: tokenArray fileVersion: fileVersion]; add: #memoryParams -> [:tokenArray | memoryParams decodeFrom: tokenArray fileVersion: fileVersion]; yourself. " get the contents using a two pass edit procedure" 1 to: 2 do: [:pass | 1 to: tokens size by: 2 do: [:tokenIndex | | actionBlock | actionBlock := actionBlocks at: (tokens at: tokenIndex) ifAbsent: [Dialog warn: (#InvalidToken1sFound << #RuntimePackager >> 'Invalid token <1s> found<n>Settings were not loaded' expandMacrosWith: (tokens at: tokenIndex)). ^self]. pass == 2 ifTrue: [actionBlock notNil ifTrue: [[actionBlock value: (tokens at: tokenIndex + 1)] on: Object informationSignal do: [:ex | Dialog warn: (#ErrorDecodingSettingsFile << #RuntimePackager >> 'Error decoding settings file<n><1s>' expandMacrosWith: ex errorString)]]]]]. " if unreferenced classes, methods, or globals were loaded alert the user" self anyUnreferencedDefinitions ifTrue: [Dialog warn: self class warningForEarlierScanMessage]. " remember the file loaded " paramFilename := filename
nextStepPushed "Act on the next step button" self moveToStep: currentStepNumber + 1.
previousStepPushed "Act on the previous step button" self moveToStep: currentStepNumber - 1.
takeDefaultsPushed "Act on the take defaults button. Just in case, enable interactivity" | sel | interactWithUser := true. sel := (self class selectorsForStep: currentStepNumber) last. sel notNil ifTrue: [ self perform: sel ].
</methods> <methods> RuntimePackager.RuntimeBuilderUI <category>interface opening</category>
open "Open if needed. Otherwise just bring to the front" ( self builder isNil or: [ self builder window isOpen not ] ) ifTrue: [ super open] ifFalse: [ self builder window raise expand ]
postBuildWith: aBuilder "Set up to use special controller needed for doing the final strip step" " Hook in special controller that will kick off stripping at the end" aBuilder window controller: RuntimeStartupController new. " Make status boxes non-changable" #( #cleanupDone #optionsDone #itemsDone #scanDone #reviewDone saveParcelsDone #testDone #memoryDone ) do: [ :id | ( aBuilder componentAt: id ) widget controller: NoController new. ].
postOpenWith: aBuilder "Initialize the window." ActiveApplication := self. self moveToStep: 1.
</methods> <methods> RuntimePackager.RuntimeBuilderUI <category>menu actions</category>
helpContents "Pick a topic for help and open the window" | helpSelection helpContents | helpContents := List new. 1 to: self class stepTitles size do: [ :i | helpContents add: ( self class titleForStep: i ) -> i ]. helpSelection := Dialog choose: 'Which help topic would you like to view?' fromList: helpContents values: helpContents lines: 15 cancel: [ ^self ]. ( RuntimeBuilderHelp onString: ( self class perform: ( self class helpAccessors at: helpSelection value ) ) title: helpSelection key ) open.
loadParams "Load parameters from a file" | file | self anyPendingChanges ifTrue: [(Dialog confirm: self class changesPendingMessage) ifFalse: [^self]]. " make sure file is readable " ( [file := (Dialog requestFileName: #FilenameToLoadParams << #RuntimePackager >> 'File name to load parameters from' default: paramFilename asString version: #mustBeOld ifFail: [^self]) asFilename. file isReadable] on: OSErrorHolder errorSignal do: [:ex | ex return: false]) ifFalse: [Dialog warn: #TheFileSuppliedDoes << #RuntimePackager >> 'The file supplied does not exist or could not be read'. ^self]. Cursor read showWhile: [self loadParametersFile: file]
openLauncher "Open the standard launcher" | launcher | "Hide the dependency because of Envy prereqs" launcher := #{VisualLauncher } valueOrDo: [ Dialog warn: 'Image no longer contains VisualLauncher'. ^self ]. launcher open. RuntimeManager addToLauncherMenu.
packageRuntimeImage "Package the runtime image in one step" ( Dialog confirm: 'This function will package the runtime image in one step based on options already set either through the user interface or by loading a saved parameters file. The following actions are taken automatically: o Scan for unreferenced items (if not skipped as an option) o Save any pacels indicated as loadable at runtime o Strip and save the runtime image Except for error conditions and warnings, no further prompts are made. The current image is not saved prior to creating the runtime image and exiting. Are you ready to proceed with packaging the runtime image?' ) ifFalse: [ ^ self ]. interactWithUser := false. [ options skipScan ifFalse: [ self traceMessages ifFalse: [ interactWithUser := true. ^self ] ]. self saveParcels ifFalse: [ interactWithUser := true. ^self ]. ] on: Error do: [ :ex | interactWithUser := true. ex pass. ]. " This is basically the point of no return, but if we come back here, the strip failed in some way." self stripSystem. interactWithUser := true.
quitImage "Quit the image after a dialog" ObjectMemory quitDialog.
saveImage "Quit the image after a dialog" ObjectMemory saveDialogThenQuit: false.
saveParams "Save parameters to a file" | out file | " See if any pending changes are outstanding" options isBeingChanged | keptItems isBeingChanged | memoryParams isBeingChanged ifTrue: [(Dialog confirm: ('Changes are pending in already open windows.\' , 'Saving settings will not include those changes\' , 'unless you first press Ok in the respective windows.\\' , 'Do you want to continue anyway?') withCRs) ifFalse: [^self]]. ( [file := (Dialog requestFileName: 'File name for saving parameters' default: paramFilename asString version: #new ifFail: [^self]) asFilename. file canBeWritten] on: OSErrorHolder errorSignal do: [:ex | ex return: false]) ifFalse: [Dialog warn: 'Parameter file cannot be written with name supplied'. ^self]. " show work in progress " Cursor write showWhile: [" open the output file " [out := file writeStream] on: OSErrorHolder errorSignal do: [:ex | (Dialog choose: 'Output file cannot be written' labels: #('OK' 'Debug') values: #(#ok #debug) default: #ok) == #ok ifTrue: [^self] ifFalse: [ex reject]]. " Write each parameter class from current contents" [out nextPutAll: '"RuntimeBuilderUI settings '; nextPutAll: Date today printString; space; nextPutAll: Time now printString; nextPut: $"; cr; cr; nextPutAll: 'version '; print: RuntimeManager vwVersion; cr; nextPutAll: 'options ( '. options encodeOn: out tab: 1. out nextPutAll: ' )'; cr; cr; nextPutAll: 'keptAndDeletedItems ('. keptItems encodeOn: out tab: 1. out nextPutAll: ' )'. out cr; cr; nextPutAll: 'memoryParams ('. memoryParams encodeOn: out tab: 1. out nextPutAll: ' )' " close the output file and remember its name "] ensure: [out close]. paramFilename := file " end cursor showWhile "]
stepHelp "Open a help window on showing information about the current step" self class helpForStep: currentStepNumber
</methods> <methods> RuntimePackager.RuntimeBuilderUI <category>functions</category>
chooseKeptItems "Open the kept items window" keptItems edit.
cleanUpImage "Invoke inspectors if needed to enable image to be cleaned up. Check for extra undeclared items and non-model models" | inspectorOpened insp | inspectorOpened := false. keptItems canBeReset ifTrue: [ keptItems setDefaults. self itemsDone value:false. ]. options canBeReset ifTrue: [ options setDefaults. self optionsDone value: false. ]. Undeclared isEmpty ifFalse: [ " see if there are still entries to be removed from Undeclared " ( Dialog confirm: 'Undeclared dictionary is not empty. Do you want to ', '\remove unreferenced nil entries before opening a browser?' withCRs ) ifTrue: [ " get rid of extraneous values that hang around " Transcript cr; show: 'Cleaning up DeferredBindings'. RuntimeManager cleanUpDeferredBindings. " now that the junk is out of the way, purge undeclared " Transcript cr; show: 'Purging unreferenced entries from Undeclared ...'. Cursor wait showWhile: [ RuntimeManager purgeUndeclaredEntries asSortedCollection do: [ :k | Transcript cr; show: 'Removed ', k displayString. ] ]. Transcript cr; show: '...done'. ] ]. Undeclared isEmpty ifFalse: [ " open an inspector with an appropriate title " inspectorOpened := true. insp := DictionaryInspector inspect: Undeclared. insp open. insp builder window label: 'Undeclared Items'. ]. ( DependentsFields keys contains: [ :obj | ( #( #{ObjectMemory} #{RuntimeManager} #{ExternalDatabaseConnection} #{Parcel} ) contains: [ :bnd | ( bnd valueOrDo: [] ) == obj ] ) not ] ) ifTrue: [ inspectorOpened := true. " open an inspector with an appropriate title " insp := DictionaryInspector inspect: DependentsFields. insp open. insp builder window label: 'DependentsFields'. ]. inspectorOpened ifFalse: [ Dialog warn: 'Undeclared and DependentsFields look clean' ]. self cleanupDone value: true.
defaultKeptItems "Set the defaults for kept items" keptItems setDefaults; refresh. "force changed message since items might not have been editted yet. This will cause status tracking to notice the event" keptItems changed.
defaultMemoryParams "Choose default memory parameters" memoryParams setDefaults; refresh.
defaultOptions "Choose default options" options setDefaults; refresh.
saveParcels "Save loadable parcels to files. Answer true if the step succeeds." | parcelToSave path continue parcels resp saveAll obsoleteClasses | " make sure there are no open editor windows " ( options isBeingChanged or: [ keptItems isBeingChanged ] ) ifTrue: [ ( Dialog confirm: ( 'There are pending changes in open windows.\', 'Do you still want to proceed?' ) withCRs ) ifFalse: [ ^ false ] ]. " find the parcels to be saved " parcels := self parcelsToBeSaved. parcels isEmpty ifTrue: [ interactWithUser ifTrue: [ Dialog warn: 'There are no parcels to be saved.'. ]. ^true ]. saveAll := interactWithUser not. parcels do: [ :parcel | ( options stripParcel: parcel name ) ifTrue: [ parcelToSave := self trimParcel: parcel ] ifFalse: [ parcelToSave := parcel copy ]. " set padded to true (hardly ever a bad idea and sometimes required)" parcelToSave propertyAt: #padded put: true. path := options pathForParcel: parcelToSave name. Transcript cr; show: 'Saving parcel ', parcelToSave name, ' to ', ( RuntimeManager expandedStringFrom: path) , ' ...'. continue := true. "See if any obsolete classes were included in the parcel saved" obsoleteClasses := parcelToSave definedAndExtendedClasses select: [ :cl | cl isObsolete ]. obsoleteClasses isEmpty ifFalse: [ Transcript cr; show: 'Warning: The following obsolete classes are present in the parcel:'. ( obsoleteClasses asSortedCollection: [ :x :y | x name < y name ] ) do: [ :cl | Transcript crtab; show: cl name ]. ( Dialog confirm: 'Obsolete classes are defined or extended in parcel ', parcelToSave name, '\Do you want to save it anyway?' withCRs ) ifFalse: [ Transcript cr; show: 'skipped due to error'. continue := false. ] ]. " watch out for errors writing the file " continue ifTrue: [ OSErrorHolder errorSignal handle: [ :ex | ( Dialog confirm: ex errorString, '\Error writing ' withCRs, path, '\Do you want to continue with the next parcel?' withCRs ) ifFalse: [ ^false ] ifTrue: [ ex return ] ] do: [ | src file | file := RuntimeManager expandedFilenameFrom:path. src := file asString. ( src lastIndexOf: $. ) > 0 ifTrue: [ src := ( src copyFrom: 1 to: ( src lastIndexOf: $.) - 1 ), Parcel sourceExtension. ] ifFalse: [ src := src, Parcel sourceExtension ]. src asFilename exists ifTrue: [ resp := Dialog choose: ( 'Parcel source file exists:<n><1s><n><n>Should it be deleted now?' expandMacrosWith: src ) labels: #( 'Yes' 'No' 'Cancel' ) values: #( #yes #no #cancel ) default: #cancel. resp == #yes ifTrue: [ src asFilename delete. Transcript cr; show: src, ' deleted'. ]. resp == #cancel ifTrue: [ Transcript show: 'cancelled'. ^false ] ]. saveAll not & file exists ifTrue: [ resp := Dialog choose: path, ' exists. Use it anyway?' labels: #( 'Yes' 'Yes to All' 'No' 'Cancel' ) values: #( #yes #yesAll #no #cancel ) default: #yes. resp == #yesAll ifTrue: [ saveAll := true ]. resp == #no ifTrue: [ Transcript show: 'skipped'. continue := false ]. resp == #cancel ifTrue: [ Transcript show: 'cancelled'. ^false ] ]. continue ifTrue: [ parcelToSave parcelOutOn: file withSource: nil hideOnLoad: true republish: false backup: true. Transcript show: ' ... done'. ] ] ] ]. interactWithUser ifTrue: [ Dialog warn: 'Parcels have been saved. See Transcript for results'. ]. self saveParcelsDone value: true. ^true
setMemoryParams "Open the memory parameters window" memoryParams edit.
setOptions "Open the options window" options edit.
stripSystem "Set up for stripping the image. Make sure runState is set correctly before entering the prepare phase and reset it if the operation is not to proceed. Control is passed to RuntimeManager via RuntimeStartupController after the window closes." RuntimeManager runState: #development. ^ self prepareToStripSystem ifFalse: [ RuntimeManager runState: #development. false. ] ifTrue: [ true ]
testApplication "Test the application" tester isNil ifTrue: [ tester := RuntimeBuilderTester new. tester mainApplication: self. tester keptItems: keptItems. tester options: options. ]. tester open.
testCompleted "The test has been completed, clear the current tester" tester := nil.
traceMessages "Trace sent messages to determine which classes and selectors are not needed. Answer true if the step suceeded." | tracer startTime endTime resp | ( options isBeingChanged | keptItems isBeingChanged ) ifTrue: [ (Dialog confirm: ( 'Changes are pending in already open windows.\', 'These changes do not take effect until OK is pressed in\', 'the respective windows.\\', 'Executing the scan for references now will ignore pending changes.\\', 'Do you want to continue anyway?' ) withCRs ) ifFalse: [ ^false ] ]. ( options startupClass notNil or: [ keptItems hasBeenEdited or: [ options useAutoLoader and: [ options hasLoadableParcels ] ] ] ) ifFalse: [ ( Dialog confirm: ( 'No startup class and method have specified, use AutoLoader for\', 'parcel loading was not specified or there are no loadable parcels,\', 'and no changes were made to the kept classes and methods.\\', 'This can result in the intended application being omitted from\', 'the scan of sent messages and subsequently being deleted\', 'from the runtime image.\\', 'Do you want to continue anyway?' ) withCRs ) ifFalse: [ ^ false ] ]. " note when we started " startTime := Time now. " do the trace " tracer := RuntimeBuilderMessageTracer new. [ tracer options: options; items: keptItems; traceSystem ] on: UserInterrupt do: [ :ex | ex errorString = 'User Interrupt' ifFalse: [ ex reject ]. resp := Dialog choose: 'Terminate scan for referenced items?' labels: #( 'Yes' 'No' 'Debug' ) values: #( true false nil ) default: true. resp = true ifTrue: [ keptItems resetUnreferencedItems. self scanDone value: false. ^false ]. resp = false ifTrue: [ tracer raiseNotifier. ex resume ]. ex pass. ]. " note when we ended " endTime := Time now. " tel the user about the results " interactWithUser ifTrue: [ stepDescription value: ('Scan completed in ', (endTime asSeconds - startTime asSeconds ) printString, ' seconds', '\\Unreferenced Items:\', ' ', keptItems unreferencedClasses size printString, ' classes\', ' ', keptItems unreferencedMethodsCount printString, ' methods\', ' ', keptItems unreferencedGlobals size printString, ' globals', '\\Proceed to the next step to review details') withCRs. ]. self scanDone value: true. self reviewDone value: false. self saveParcelsDone value: false. self testDone value: false. ^true
viewReferencedItems "Open the referenced items window" keptItems view. self reviewDone value: true.
</methods> <methods> RuntimePackager.RuntimeBuilderUI <category>updating</category>
update: anAspect with: aParam from: anObject "Monitor changes to keep track of status" anObject == options ifTrue: [ self optionsDone value: true. self scanDone value: false. self saveParcelsDone value: false. self testDone value: false. ]. anObject == keptItems ifTrue: [ self itemsDone value: true. self scanDone value: false. self reviewDone value: false. self saveParcelsDone value: false. self testDone value: false. ]. anObject == memoryParams ifTrue: [ self memoryDone value: true. ]. ^super update: anAspect with: aParam from: anObject
</methods> <methods> RuntimePackager.RuntimeBuilderUI <category>initialize-release</category>
initialize "Initialize the instance" super initialize. interactWithUser := true. currentStepNumber := 0. options := RuntimeBuilderOptions new setDefaults. keptItems := RuntimeBuilderItems new options: options; setDefaults. memoryParams := RuntimeBuilderMemoryParams new setDefaults. paramFilename := 'params.rtp' asFilename. options addDependent: self. keptItems addDependent: self. memoryParams addDependent: self.
release options removeDependent: self. keptItems removeDependent: self. memoryParams removeDependent: self. super release
</methods> <methods> RuntimePackager.RuntimeBuilderUI <category>testing</category>
anyPendingChanges ^options isBeingChanged or: [keptItems isBeingChanged or: [memoryParams isBeingChanged]]
anyUnreferencedDefinitions ^keptItems unreferencedClasses isEmpty not or: [keptItems unreferencedMethods isEmpty not or: [keptItems unreferencedGlobals isEmpty not]]
</methods> <methods> RuntimePackager.RuntimeBuilderUI <category>accessing</category>
interactWithUser: aBoolean interactWithUser := aBoolean
keptItems ^keptItems
options ^options
</methods> <methods> RuntimePackager.RuntimeBuilderUI class <category>accessing</category>
activeApplication "Answer the currently active instance, if any" ^ActiveApplication
activeApplication: aUI "Set the currently active instance, if any" ActiveApplication := aUI
numberOfSteps "Answer the total number of user steps presented" ^10
selectorsForStep: anInteger "Answer the selectosr to execute when performing the user step specified by anInteger. Answer at:1 is the selector to use for executing the step, answer at: 2 is the selector to use for setting defaults" ^self stepSelectors at: anInteger
stepSelectors "Answer the array of step selectors" ^ #( (nil nil nil) (cleanUpImage nil nil) (setOptions nil defaultOptions ) (chooseKeptItems nil defaultKeptItems ) (traceMessages nil nil) (viewReferencedItems nil nil) (saveParcels hasParcelsToBeSaved nil) (testApplication nil nil) (setMemoryParams nil defaultMemoryParams) (stripSystem nil nil) )
stepSummaries "Answer the array of step summaries." ^ #( "Step 1 - Overview" 'This step provides an overview of the general process of packaging runtime images for release. By consulting the help for this step, you can obtain an overview of the packaging process and the commonly used conventions of the user interface.' "Step 2 - Clean up image" 'Objects can accumulate in a development image that are not needed for runtime execution but would occupy storage. This step scans for global objects that commonly arise in the development process. If Parcels containing development tools such as UIPainter or Store are present, they should be unloaded before packaging the image for runtime. Runtime Packager does not perform this function for you, but the resulting image will be more compact if you do so before proceeding.' "Step 3 - Set basic options" 'Options and data entry fields used in later steps are entered here. Default values can be used but in most cases it will be necessary to at least specify a starting method for the application. Changes to options can affect the outcome of later steps and may require that they be done again.' "Step 4 - Specify items to keep" 'In this step you will specify globals, classes, and methods that will be kept or deleted in the final runtime image. Items that are specified as contingent will be analyzed in the following step to determine if they are referenced and thus should be kept in the final runtime image.' "Step 5 - Scan for unreferenced items" 'In this step the image is scanned to detect classes, methods, and globals that should be kept in the runtime image and which can be deleted. Kept methods within kept classes are scanned for selectors representing message sends and references to classes and globals until no more references are found.' "Step 6 - Review kept items" 'In this step you see the detailed results of the previous step. If you are pursuing an aggressive strategy of removing all extraneous classes, you would want to check here to see that you have eliminated exactly what you intended.' "Step 7 - Save parcels" 'In this step you save parcels that are loadable at runtime. Parcels specified as loadable in the Options step are saved under the path names provided in that step. These path names should be different from the names used for any development copies of these parcels or the development copies will be overwritten. If no parcels have been specified as loadable, the DO THIS STEP button is disabled.' "Step 8 - Test application" 'This step allows you to test your application in a simulated runtime environment. Some references can slip past the scanning process unnoticed and cause your application to die an untimely death in the runtime version. This step provides an way to detect these references and keep the referenced items in the final image.' "Step 9 - Set Runtime Memory Parameters" 'This step provides a way to set memory parameters for the runtime image. See VisualWorks documentation for a more complete description of the parameters and how they are used in the Smalltalk image. Current image start-up values are used as the default and in many cases these would be sufficient without further changes. This step is optional.' "Step 10 - Strip and save image" 'This step is the final one. Deleted classes and methods are removed and the final image is saved under the name provided earlier on the options window. The stripping process is automatic once a few preliminary questions are posed. Once it is underway, the stripping process should not be interupted. After the stripping process is completed, this image exits automatically.' )
stepTitles "Answer the array of step titles" ^#( 'Overview' 'Clean up image' 'Set common options' 'Specify classes and methods to keep' 'Scan for unreferenced items' 'Review kept classes and methods' 'Save runtime loadable parcels' 'Test application' 'Set runtime memory parameters' 'Strip and save image' )
summaryOfStep: anInteger "Answer a summary of the step." ^self stepSummaries at: anInteger
titleForStep: anInteger "Answer the title for a user step based on the number supplied" ^ self stepTitles at: anInteger
</methods> <methods> RuntimePackager.RuntimeBuilderUI class <category>help</category>
helpAccessors "Answer the accessors for help in step number order" ^#( #helpForOverview #helpForCleanup #helpForOptions #helpForItems #helpForScan #helpForReview #helpForParcels #helpForTest #helpForMemory #helpForStrip ).
helpFor: accessor "Open a help window on showing information about a step" ( RuntimeBuilderHelp onString: ( self perform: accessor ) title: ( self titleForStep: ( self helpAccessors indexOf: accessor ) ) ) open
helpForCleanup "Display help for Image Cleanup step." ^'PURPOSE OF THIS STEP Objects can accumulate in a development image that are not needed for runtime execution and would occupy storage needlessly. This step scans for global objects that commonly arise in the development process. The scan for referenced and unreferenced items will detect unreferenced globals appearing in the Smalltalk System Dictionary. Two other major possible sources for extraneous globals cannot be detected in the scan of referenced items: Undeclared variables and non-Model objects that have dependents. When this step is performed, inspectors are opened on the contents of the global variables Undeclared and DependentsFields. If no suspicious contents are found, you will be notified and no inspectors are opened. USAGE If entries exist in the Undeclared dictionary, you will be prompted to remove any items that are apparently unreferenced and which are also currently bound to nil. These can entries can be left behind when classes are removed from the system, for example. Removing these entries should normally be harmless and will greatly simplify analyzing the Undeclared items. However, there is no provision for restoring any entries deleted by this process and the image should first be saved if you are not sure that the entries are extraneous. The inspectors that are opened provide menu actions in the ordinary way. Be especially careful when removing items from DependentsFields if you do not understand why they are there. In most cases, undeclared variables represent some type of problem in the development process and each entry should be investigated to ensure that no problems are lurking in the application. If no references to an entry can be found, the entry can be eliminated. This step can be skipped if you do not want to eliminate the types of global objects detected here.'
helpForItems "Display help for a step." ^'PURPOSE OF THIS STEP: In this step you will specify variables, classes, and methods that will be kept or deleted in the final runtime image. Items are divided into three major categories: o Deleted - these are always deleted in the runtime image. o Contingent - these are deleted if no references to them can be detected. o Kept - these are kept in any case. Being deleted has different meanings for different types of objects. For variables, being deleted means that its name is removed from the containing namespace, and any previous references to the variable by name become references to nil. For classes, being deleted means that the class is replaced with a subclass of Object having no methods of its own and having the class name removed from its containing namespace. Deleting a method means removing it from the method dictionary in which it appears. When a class is kept, only the definition of the class is necessarily kept in its entirety. Methods that are unreferenced can still be deleted from kept classes. When a method is kept, it will remain in the runtime image only if its defining class is not otherwise deleted. Several rules are enforced in the specification of kept and deleted items. You cannot delete a class if subclasses of it are kept. Specifying that a class is to be deleted implicitly specifies that its subclasses are also to be deleted. USAGE The packages tree allows selection of the package(s) and/or bundle(s) for which classes and variables are displayed. All lists, including the package/bundle tree view appearing in this window are of the multiselect variety. In the lists, selected items are shown with check marks, while in the tree they are shown by highlighting the selected item(s). When you select packages or bundles, all classes they define or extend are shown in the class selection boxes. When you select classes, all methods implemented on either as instance methods or as class methods are shown in the method selection boxes. Do not forget to unselect packages and classes when you no longer want related classes and methods to be visible. The status of classes, methods, and variables can be changed by pressing the buttons between the selection boxes. The meaning of the buttons is mnemonic: >> means move all selected items from the left to the right. << means move all selected items from the right to the left. After items are moved, they become the selected items in the box to which they are moved. Hence, you can easily undo an erroneous button press by pressing the button for movement in the opposite direction. Pop-up menus are provided in each selection box. These can be used to select all items currently appearing in the box, clear all selections, look at specific items, and scan for references. Two types of reference scan are provided. The standard reference scan is provided through the Browser classes and may miss some references that will be detected during the more complete scan for referenced items in the next step. The extended reference scan is more inclusive. It also allows you to filter out the items that are not being kept in the runtime image, which is especially useful after the scan for referenced items has been completed in the following step. Classes that are extended but not defined in a selected application or subapplication are shown in italics. Such classes can only be moved among the deleted, contingent, and kept groups only when their defining application or subapplication is selected. When a class or classes are selected, only those methods defined in a selected application or subapplication are shown. The pop-up menu option Select Class is provided to allow easy selection of all applications and subapplications in which a class is defined or extended and thus allows the listing of all methods associated with the class. Classes that are dynamically loaded through the use of parcels should be indicated as contingent or kept in the runtime image. Since all classes loadable through parcels are deleted in the base runtime image, whether the class is kept or contingent is relevant only to the scanning for unreferenced items. A menu option is provided for resetting classes and methods to their default settings. Only classes and methods in currently selected categories (or applications) will be affected. This permits a more selective way to reset to default values than would achieved by pressing TAKE DEFAULTS in the main window. DEFAULTS By default, some classes are kept. These are kernel classes and they are almost certainly needed to make a runtime image. For a complete list, see the method defaultClassesKeptVW in class RuntimeBuilderItems. Class RuntimeManager within Runtime Packager is needed for image start-up and is by default also a kept class. RuntimeManagerStripper is a special subclass of RuntimeManager used to complete the stripping operation and is required. It will be elimated in the final runtime image. Global objects are not kept by default, but the major system globals are referenced in numerous places are will be detected as referenced. Classes that are not generally used in the runtime image are deleted by default. These classes come from the Tools name space and related Tools categories. For a complete list, see the method defaultClassesDeleteVW in class RuntimeBuilderItems. When an image starts, ObjectMemory sends update:with:from: messages to all its dependents. By default, the classes of all dependents of ObjectMemory are kept. If you know that a dependent is not needed in the runtime image, you can specify the class as deleted. '
helpForMemory "Display help for a step" ^'PURPOSE OF THIS STEP This step provides a way to set memory parameters for the runtime image. See VisualWorks documentation for a more complete description of the parameters and how they are used in the Smalltalk image. Spaces sizes are: Eden - initial space used for creating new objects Survivor - space used for new objects that have graduated from eden Large - space for objects larger than 1K Stack - space holding the portion of the stack not converted to objects Code Cache - cache of dynamically compiled method machine code Old - tenured objects that have graduated from survivor space Policy values are: Growth Increment - how much additional memory to allocate at a time Retry Decrement - how much less to ask for if memory is not available Growth Regime Limit - size at which reclaiming space is preferred to expansion Memory Limit - maximum amount of memory allocated USAGE Enter the desired values and press OK. Space sizes have a minimum value of 10000 bytes and a maximum value of 1000 times the default sizes at startup. Growth Increment must be at least twice Retry Decrement and no more than Memory Limit. NOTES Spaces sizes are derived from ObjectMemory>>defaultSizesAtStartup. MemoryPolicy values are taken from the following MemoryPolicy aspects: preferredGrowthIncrement growthRetryDecrement growthRegimeUpperBound memoryUpperBound When memory values are stored in the parameters file, they are stored as ratios between the values specified here and the startup values of the image. If the parameters file is loaded on a different platform than the one where it was created, the interpretation of these ratios may or may not be what was intended and the final results should be reviewed before they are used.'
helpForOptions "Display help for a step." ^'PURPOSE OF THIS STEP Options and data entry fields used in later steps are entered here. For simplicity of organization, the options are grouped into pages of a notebook. Pages are as follows: -------------------- Basics Page This page includes the essential elements that are always needed. These are: o Startup Class and Startup Method When the runtime image starts, the selector specified in Startup Method is sent as a message to the class specified in Startup Class. This message provides a convenient way to open the initial window of the application or do other application initializations. The initial message is included in the scan of sent messages done later. If you do not use a Startup Class and Startup Method, you will need to specify the starting point for scanning referenced classes and methods in the next step. The fully qualified name of the Startup Class should be provided. o Image Path Name When the image is finally stripped, it is saved to the file named here. For obvious reasons, this field is required and the file named must be writable. The same conventions for appending suffixes to the file name are used here as are normally used for image saves. -------------------- Details Page This page includes a variety of options that are commonly selected: o Remove compiler classes Remove classes used to provide the public access interface to the compiler. In many cases the compiler is required, even in a runtime image. o Install emergency evaluator as a dialog The emergency evaluator is invoked by pressing control- shift-C. If this box is checked, a dialog will appear confirming that the user wants to exit the image. If this box is not checked, the control-shift-C key press is ignored. o Build headless image Create an image that does not access the display. Class HeadlessImage supplied with VisualWorks 2.5 and above must be present in the image to select this option. o Clear parcel search path Clear the list of directories to be searched when loading parcels. If this is not selected, the settings value will be preserved in the runtime image. o Use three-step save procedure A three-step procedure is recommended for optimal runtime images. See the "Memory Management" chapter in the VisualWorks documentation for an explanation of the procedure. The procedure will be used if this box is checked. Because of the extra time required for three saves, the default is to create a slightly less optimal image in a single step. o Skip default scan for unreferenced items The menu option File -> Packager Runtime Image normally performs a scan for unreferenced items as part of the packaging process. To instead skip doing the scan, select this option. o Supress splash screen and herald sound While loading the image, the virtual machine normally displays a splash screen and plays a herald sound. This can be suppressed by setting a flag in the image before saving it. This flag will automatically be set for a headless image, but is optional for a GUI runtime image. o Action on last window close This option selects what is to be done when the last window in the runtime image is closed. The choices are: Shutdown image - shutdown the image using normal quit procedures Continue - continue processing without any windows open Standard Behavior - allow base image behavior to determine the action If Shutdown image is selected and there are no windows open when the application startup procedure completes, then the image will be shutdown at that time. -------------------- Platforms Page This page allows you to select UILooks and Operating Systems to be supported in the runtime image. By default only the current platform and look are supported and any others required must be selected. These selections are used to set defaults for classes to be deleted from the system. -------------------- Exceptions Page This page is used to specify information needed to handle exceptions in the runtime image: o Error Notifier Class The default class, RuntimeEmergencyNotifier, notifies the user and creates a diagnostic dump when an unhandled exception is detected. If you want to enhance the standard behavior, you can subclass RuntimeEmergencyNotifier and specify your class here. Other error handler classes provided with Runtime Packager are RuntimeDebugNotifier and RuntimeQuietEmergencyNotifier. The fully qualified name of the error notifier class must be provided. o Image Dumper Class The default class, RuntimeImageDumper, is used by RuntimeEmergencyNotifier to create the diagnostic dump when an unhandled exception occurs. If you want to replace this with your own class, your class must understand the class method #dumpSystemImage:context:on:. If your emergency error handler does not use the dumper class, the dumper class may be omitted here. The fully qualified name of the image dumper class must be provided if any is entered. o Error Log Path Name The diagnostic dump created on unhandled exceptions is written to the file named here. This file should be writable by the runtime user for a dump to be created. Exceptions occurring during the final stages of the image stripping process are also reported as dumps to this file. If you do not want dumps to be created, leave this field blank. -------------------- Parcels Page This page allows you to provide information about Parcels that will be loaded into the runtime image. Each parcel defined in the current image is listed. The following information can be provided for each parcel by selecting it from the list: o Loaded into image at runtime Select this option for each parcel or application that is loaded into the image during runtime execution. Before other Parcel options can be entered this one must be selected. o Unload before saving runtime image Select this option to cause the parcel or application to be unloaded in the normal way before stripping and saving the runtime image. If this option is not selected, all classes and methods defined in the parcel or application are deleted before saving the runtime image, but preUnload and removing actions are not performed. o Save options The "Save Loadable Parcels" step to follow allows you to save parcels that are loaded into the runtime image. This option controls how the selected parcel is to be handled in that step. The choices are: - Strip unreferenced items and save Saves only those classes and methods that are determined to be referenced. The contents of the parcel in the image are not changed, but the version of the parcel saved omits unreferenced items. - Save full parcel The full contents of the parcel, including unreferenced items are saved based on the current definition of the parcel in the image. - Do not save parcel The parcel is not saved. You should ensure that the parcel is saved by using the Parcel Browser before the Test step is done and before using the runtime image. o Path name for saving parcel After the scan for referenced items is completed, loadable parcels are stored. Each parcel is stored in the corresponding file specified with this option. The path is required for the parcels that are to be saved. No source file is generated for runtime parcels and the name specified here should not have a corresponding .pst file resident in the same directory. Buttons available on this page are as follows: NEW PARCEL - creates a new empty parcel and adds it to the list. UNLOAD - unloads the currently selected parcel. This removes classes and extension methods defined in the parcel from the current image. -------------------- Stripping Page This page allows specification of options that control the final stripping step. These options are: o Remove system organization Remove the system organization and categories from the System Dictionary and from all classes. This option will reduce the size of the runtime image but may conflict with any services that require categories to be present or application logic that depends on naming conventions for categories.. o Package external interfaces Prior to creating the stripped image, replace CMacroDefinition instances with their values. o Merge method and block byte codes The byte codes that control the operation of the Smalltalk Virtual Machine are merged so that unique values are stored in a single instance of ByteArray rather than being duplicated. o Use compact compiled methods CompiledMethod objects contain pointers to source code and other objects not used in the runtime image. This will option will cause a replacement class to be used eliminating the extra storage needed for the pointers. Note that historically this was most useful when using ENVY/Developer. For normal methods, the savings are minimal. o Merge literals Multiple instances of compiler generated literals with the same value are merged into single instances. This option should be used very carefully since it can cause some application bugs to be manifest in ways that could be very difficult to debug. o Merge methods Multiple instances of methods that are equal except for the class in which they appear are merged into a common instance. Normally this operation is safe, but since the identity of merged methods cannot be determined in all cases, there are possible exposures, especially in some exception handling logic. o Remove unreferenced globals Unreferenced globals are set to nil and removed from their name spaces during the final stripping step if this option is selected. o Trace Level During the final stripping step additional information can be logged in the progress notifier window so that hangs or crashes can be isolated. For the Medium setting, classes and globals being removed are shown. For the High setting, individual methods are shown as they are stripped from the image. o Prestrip Class Prestrip Class names a class to which a message will be sent before the actual stripping processing commences. This message can be used to invoke user logic for customizing some aspects of the stripping process, for example, by becoming a dependent of RuntimeManager and monitoring changed: messages used to inform of progress through the different steps in the stripping process. The fully qualified name of the prestrip class must be supplied. o Prestrip Method Prestrip Method names the method to which the pre-strip message is to be sent. This method must be one the prestrip class can respond to. If no message is to be sent, Prestrip Method and Prestrip Class should be blank. USAGE Options are selected as check boxes. Entry fields can be supplied in any order. Options are not acted on until the OK button is pressed except for Parcel Post Load class and method specifications. When the OK button is pressed, you may be informed of errors or inconsistencies in the entered fields. If you press the CANCEL button, changes you have made are discarded and the window is closed. Buttons labeled "?" can be used to select items through pop-up menus. DEFAULTS Default values are as shown below: Basics Page Startup Class: none (blank) Startup Method: none (blank) Image Path Name: runtime Details Page Remove compiler classes: false Install emergency evaluator dialog: false Use AutoLoader: true Build headless image: false Use three-step save procedure: false Action on last window close: Shutdown image. Platforms Page UI Looks: All Operating Systems: All Exceptions Page Error Notifier Class: RuntimeEmergencyNotifier Image Dumper Class: RuntimeImageDumper Error Log Path Name: error.log Parcels Page Loaded into image at runtime: false Save options: strip and save the parcel Path name for saving parcel: <parcel name>.pcl Stripping Page Remove system organization: true Package external interfaces: true Merge method and block byte codes: true Use compact compiled method: false Merge literals: false Merge methods: false Remove unreferenced globals: true Trace Level: none Prestrip Class: none Prestrip Method: none '
helpForOverview "Display general overview help." ^'PURPOSE OF THIS STEP This step provides an overview of the general process of packaging runtime images for release. It includes general usage information and an overview of the overall process. There are no actions to perform in this step. USAGE In packaging a runtime image, you will proceed through a series of steps to convert your development image into its stand-alone runtime form. A description of the step will appear much as this one does, showing you the purpose of the step, usage information about how to use windows associated with the step, and other necessary information. At each step, you may make choices about what function is to be performed. The following buttons control these actions: o DO THIS STEP performs the function of the step, o TAKE DEFAULTS elects to take system provided default actions, o << PREVIOUS returns you to the previous step in the sequence, and o NEXT >> advances you to the next step in the sequence. Some steps are optional. The description of the step will clearly state this fact when it applies. In that case, you may progress directly to the next step without pressing either DO THIS STEP or TAKE DEFAULTS. In some cases, one or more buttons might not apply to a step, and buttons will be disabled when applicable. For example, the DO THIS STEP button is disabled for this step because there is no associated action. The following menu items are provided in this window for performing common functions: File menu Load parameters - read values for parameters (see below) from a file. Save parameters - write values for parameters (see below) to a file. Open launcher - open the system launcher. Save image - save the image in its current state. Quit image - use the normal quit dialog to allow you to exit the image. Package Runtime Image - prepare the runtime image in one step Exit - exit this application (but does not exit the image as a whole). The parameters file is used to store the specifications the programmer has made when using Runtime Packager. It contains of the following specifications: o Common Options o Kept and deleted classes, methods, and globals o Memory parameters Actions menu Menu items correspond with the actions taken at each step. You can use these items to perform the step directly without going forward or backward to reach the desired step. Help menu Contents - shows a list of help topics to select from Help for current step - shows help window for current step About Runtime Packager - shows current version About Patches - shows Runtime Packager patches OVERVIEW OF STEPS The following steps are presented in sequence through this user interface. In general, these steps should be performed in this sequence. If information supplied in a previous step is changed, you may need to perform later steps over again. For the most common cases, you will be notified when a step must be done over. The sequence of steps follows: 1. Overview - information only; no action is performed for this step. 2. Clean up image - check the image for extraneous global objects. 3. Set common options - specify parameters used in later steps. 4. Specify runtime classes and methods to keep - customize the items to be kept for runtime. 5. Scan for unreferenced items - scan the image for unreferenced classes, methods, and globals. 6. Review kept classes, methods, and globals - review the results of the previous scan. 7. Save runtime loadable parcels - save any parcels needed for the runtime image. 8. Test application - interactively detect missed references to application classes and methods. 9. Set runtime memory parameters - set sizes for different spaces on startup and set memory policy values. 10. Strip and save image - create a stripped image for stand-alone application execution. You can save the image at any time to preserve the progress you have made, but saving while you are testing your application is not recommended. You might find it useful to save the current parameters (see menus above) after steps 3, 4, 8, and 9. This will permit you to return quickly to the current status even if you start from a clean image. MEANING OF OK AND CANCEL BUTTONS Several windows have OK and CANCEL buttons. They operate the same in each case. The OK button saves all current changes and closes the window. If errors or inconsistencies are detected, you will be informed and have an opportunity to correct them before the window is closed. The CANCEL button closes the window without saving changes. Changes are not applied unless the OK button was pressed. REOPENING ALREADY OPEN WINDOWS If you return to a previous step for which a window is already open, doing the action of that step will cause the previous window to be raised to the foreground. If you had made changes to that window but not yet pressed OK, you will see the window with the changes in place. If the previous window was minimized, it will automatically be expanded. You are not required to close the windows that go with each step as you proceed through the sequence of steps, but leaving all windows open can be confusing and a source of errors in the final image. Only one instance of this main window is permitted at a time. If you attempt to open a new instance, the currently active instance will be brought to the foreground. PRINT HELP PAGES Help pages such as this one can be printed by pressing the PRINT button. Be sure to correctly specify the image settings for printing documents. If you find that PostScript is being printed rather than text, use the Setting option in the VisualWorks Launcher window to change the Printing settings for Document Printing from PostScript Printing to Document Printing.'
helpForParcels "Answer help text for the step." ^'PURPOSE OF THIS STEP Parcels identified as loadable in the runtime image are saved to files in this step. The identification of which parcels are loadable and the file names under which they will be saved occurred in the Common Options step earlier. Changing which parcels are loadable would affect the outcome of the previous scan step. Parcels are saved in their entirety except for those where the "Strip unreferenced items and save" option was selected. For these parcels, only classes and methods found to be referenced in the previous scan step will be saved. The contents of the parcel in the current image are not changed. Parcels are saved without source. Care should be taken that a version of the parcel file (*.pcl) is not overwritten when a corresponding parcel sources file (*.pst) is present. If the overwrite occurs, the source file will be usable and the source for the parcel may be lost. USAGE Press DO THIS STEP. The names of parcels saved are written to the Transcript as the saves proceed. RESTRICTIONS Parcels being saved must be defined in the image and all classes and methods must be in the image as they are to be saved.'
helpForReview "Display help for a step." ^'PURPOSE OF THIS STEP In this step you see the detailed results of the previous step. The first time through, this might not be especially meaningful, but you probably want to make sure that your application was not somehow bypassed in the scan and thus declared deleted. If you are pursuing an aggressive strategy of removing all extraneous classes, you would want to check here to see that you have eliminated exactly what you intended. In this step you can also create a report file showing classes, methods, and variables deleted as well as those kept. Before creating the final stripped version of an application, you may want to create this report and save it for later support of the deployed application. USAGE The usage here is roughly the same as the usage for specifying the kept and deleted items earlier. You are presented with selection boxes that can be used to view packages/bundles, classes, and methods. In this step, there is no contingent category. Everything being deleted is shown as such. Classes loaded through Parcels at runtime are not included in the runtime image and are shown as deleted or kept depending on the selection for the Show Parcels As option. You can select classes to see which of their methods are being deleted. If you select a deleted class, its methods will be shown as deleted. You can use pop-up menus to browse or scan references to the methods shown. The extended references browser is especially useful in determining why a class or method is kept or deleted based on the results of the scan for referenced items. There are no decisions to make in this step. If you find that something needs to be changed, you must return to an earlier step to make the change. In all likelihood you will want to rerun the scan for referenced items after your change. RuntimeManagerStripper is shown as kept when, in fact, it will be eliminated in the final runtime image. This class is a special case due to the need to discard the stripper methods after the final image has been created, but not before. Similarly, copyright methods are preserved in the final image but may appear as deleted here. These are also treated as special cases to preserve copyright markings. Press the CLOSE button to close this window. If you want to write a report file, press the REPORT button. You will be prompted for the name of the file to which the report should be written. After the report is written, a file browser is opened on the report file created.'
helpForScan "Display help for a step." ^'PURPOSE OF THIS STEP In this step the image is scanned to detect classes, methods, and variables that should be kept in the runtime image. Conceptually, the scan is a straightforward process. Kept methods within kept classes are scanned for selectors representing message sends and references to classes and globals. As new methods, classes, and variables are detected, they are added to the list of kept items and, in turn, scanned for references to other items. Eventually the processes reaches the point at which no new references can be detected and the scan ends. The initial kept classes and methods are those indicated as such in the previous step plus the application startup class and method as well as the error notifier class. Deleted classes are bypassed in the scan for referenced items, as are deleted globals and methods. The following special class methods are used to allow classes to specify additional items to be kept: o dynamicallyReferencedClasses Answer a collection of classes or qualified class names that are to be kept in the runtime image. o dynamicallyReferencedSelectors Answer a collection of symbols naming methods that are to be kept in the runtime image. o dynamicallyReferencedGlobals Answer a collection of symbols or vairable bindings naming globals that are to be kept in the runtime image. o itemsReferencedBySelector: aSymbol Answer the collection of literals including symbols, variable bindings, and classes referenced in the instance method named by aSymbol. In the scan, these literals replace entirely those found in the method itself. o itemsReferencedByClassSelector: aSymbol Answer the collection of literals including symbols, variable bindings, and classes referenced in the class method named by aSymbol. In the scan, these literals replace entirely those found in the method itself. When these selectors are implemented as class methods, the answers provided by them are used during the scan to include classes, methods, and globals to be considered referenced and thus kept in the runtime image. If an improper answer is returned by these selectors, a dialog is used to alert you to the error. USAGE All you need to do is press the DO THIS STEP button. A window will open to show you progress reports. Scanning a large image might take some time. For large images, a fast machine with adequate memory will make this and other steps proceed much more smoothly. When the scan is complete, you will be presented with a dialog box summarizing the results of the scan. You can see more detailed information by proceeding to the next step. If you choose to bypass this step, only classes, methods, and variables that you have explicitly indicated as deleted will be removed from the runtime image.'
helpForStep: anInteger "Open a help window on showing information about a step" | accessor | accessor := self helpAccessors at: anInteger. ( RuntimeBuilderHelp onString: ( self perform: accessor ) title: ( self titleForStep: anInteger ) ) open
helpForStrip "Display help for a step." ^'PURPOSE OF THIS STEP This step is the final one. Deleted classes and methods are removed and the final image is saved under the name provided earlier on the options window. The final image is created with the following steps: 1. The image is checked for instances of Browser and its subclasses. Associated windows will be closed automatically if you press YES in the dialog box. 2. Visual Launchers are closed if you so authorize by pressing YES in the dialog box. You probably do not want the standard launcher in your runtime image, but you might want to use instances of the launcher in your application. If so, you should close the launchers manually and just say NO here instead of closing all launchers automatically. 3. You will be given one last chance to change your mind. 4. Subclasses of ExternalInterface are packaged for the runtime environment if the Package External Interfaces option was selected. C macros are fully expanded to prevent the need to do so at runtime and to remove the dependency on CMacroDefinition. 5. Your emergency notifier is installed. If you are using RuntimeEmergencyNotifier, any errors after this point will cause a dump file to be written. If the debuggers are stripped out this could be the only way to debug a problem in this step. 6. Sources are discarded. That is, the image will no longer look for sources or create changes entries. 7. A new emergency evaluator is installed. The evaluator is invoked when you press Ctrl-Shift-Y. The replacement evaluator is a dialog confirming that you want to quit now. 8. A series of mundane clean-ups are done. One of these is clearing the transcript. The transcript is written to the dump file on errors, and you might want to place application error messages there even if the transcript is not shown to the user. The definitions of any parcels indicated as loadable at runtime are discarded at this time to prevent conflicts when the parcel is loaded at runtime. 9. The default pop-up menu for text fields that could contain code is replaced with the menu for straight text. A few other menus that reference the compiler are not altered. If you select DOIT from these menus, the request is ignored. 10. System and method categories are discarded if the remove system organization and categories option was selected. 11. Methods, classes, and variables are deleted from the image. Copyright notices in the method named copyright are always retained. 12. If selected, literals are merged based on value. 13. If selected, multiple instances of the same byte code string are consolidated into a single instance referenced from multiple methods. 14. If selected, multiple instances of the same method are merged into a single instance. Because only one instance of the method is present in the image, functions that request the identity of the method will get only one of possibly multiple classes and selectors that use the method. 15. If the compact compiled methods option was selected the method dictionaries are rebuilt with instances of CompiledMethod replaced by RuntimeCompiledMethod instances. 16. The symbol table is rehashed to reclaim space from unreferenced symbols. 17. You are informed that the image is about to be saved. This window and the one appearing later do not have controllers. You will be given 5 seconds to read the contents and then the window is closed automatically. 18. The garbage collector runs to remove all the deleted objects from the image. A perm save is then done. 19. Another window appears letting you know that the save was done successfully. 20. The image quits automatically. If you are using the "three step procedure" for saving the image, the image is left in a state in which another save is done upon image start-up for the next two times the image is launched. A garbage collection is done before the first of these saves. You are now the proud owner of a stripped runtime image. Place it to good use and may your dump files remain empty. USAGE Press the DO THIS STEP button. The rest of the process is automated once you get past the warning dialogs unless you have selected the "Save runtime image using three step procedure" option. If you are using the three step procedure, a runtime image is first created and saved automatically. You must then launch that runtime image two more times to create the final runtime image. On each launch, a new runtime images is saved and you are notified of your progress. After the final save, the runtime image is left in a state in which the application will be started on the next launch.'
helpForTest "Display help for a step" ^'PURPOSE OF THIS STEP It would be nice to say that the process of scanning references was foolproof and that you could rest assured that all the classes and methods, and only the classes and methods, needed to run your application will remain in the runtime image. This, however, is not the case. A number of types of references can slip past unnoticed causing the application to die an untimely death in the runtime version. Typically the problems revolve around dynamically created names. For example, the following code would cause an undetected reference: pickOne: aString self perform: (#pick, aString) asSymbol. In general, there is no way to know what values aString might assume, even if you could connect them together with the naming convention that prefixes them with #pick to form a selector name. Classes and globals can be referenced in similar dynamic fashion. Similarly, extraneous references are very common. For example, Icon class>>initialize references Icon class>>createLauncherIcon which references class LauncherView, which, in turn, references most programming tools, none of which are probably needed in the runtime image. The only way to eliminate these extraneous references is to delete either classes or methods explicitly. This step provides a way for you to take a broad-brush approach towards which classes and methods are needed and find out where you were wrong by running test cases. When you reference a deleted class or method during a test, it is recorded as referenced and can be fedback to the selection of kept items. If your test cases are sufficient, you will discover all dynamic references. At a minimum, you should be able to discover the pattern of which things are dynamically referenced and which are not. Note that image startup and shutdown processing is not included within the scope of a test. Deleting classes or methods used in startup or shutdown is a common source of difficulty in creating a viable runtime image. In most cases, dumps written to the error log are the best way to debug startup or shutdown problems. USAGE If you have extra windows open, for example a browser, you should close or minimize them before beginning an application test. References to classes and methods from all open windows will be considered part of the application being tested. Having extra windows open tends to result in extraneous references and may cause you to include unneeded classes and methods in the runtime image. Buttons along the top of the window control activities during the application test. o SAVE In spite of all precautions to the contrary, it is possible that the image could be corrupted during the test. It might be wise to save the image before beginning the test itself. Pressing this button gives you an easy way to do this. Once the test starts, you probably do not want to save the image. Changes made to the image to detect references to deleted classes and methods could result in an image that cannot be restarted after it is saved or result in loss of source information. o BEGIN TEST This button begins the test process. All deleted classes and methods are altered to allow the detection of any references to them. When that process has been completed, the startup message, if any, is sent and the application starts its execution in the normal way. o END TEST When you have completed application testing, pressing this button will restore the image to its status prior to the beginning of the test. If debugger windows are opened during the test, you might want to press this button before debugging the problem. o ACCEPT DYNAMIC REFERENCES As deleted classes and methods are referenced, they are reported in the scrollable text area below. If you want to accept all such classes and methods as items to be kept in the runtime image, press this button. o IGNORE DYNAMIC REFERENCES In some cases you may see references to items that are clearly not part of your application. For example, you may see references to the debugger if an error occurs. To ignore the dynamic references appearing in the text area below, press this button. All dynamic references displayed will be ignored. This button is active both during and after the test. If pressed during the test, displayed dynamic references revert to the status they had at the beginning of the test. If pressed after the test, displayed dynamic references are simply ignored. References to classes and methods that would have been deleted in the runtime image are shown in the scrollable text area as they occur. Only the first reference to each item is shown. Once the references are accepted or are ignored, the text area is cleared. OK and CANCEL have the conventional meaning in this window. After the test ends, you can press OK and have all accepted dynamic references included as kept items. You might want to go back and rerun the scan step at this time to pick up other classes and methods that are now reachable but just did not happen to get used in your test. If you press CANCEL, no changes are made to the kept items and the window is simply closed. Classes and methods that are potentially loadable through Parcels do not get special treatment in this step. The assumption is that loadable Parcels will be loaded into the image through command processing at start up or through some equivalent process. Do not allow Parcels to be loaded during the test or you not be able to recover the source for methods contained in such parcels, as would be case if runtime parcels into any development image.'
</methods> <methods> RuntimePackager.RuntimeBuilderUI class <category>interface opening</category>
open "Open the currently active instance, if any" "RuntimeBuilderUI open" ActiveApplication notNil ifTrue: [ ActiveApplication open ] ifFalse: [ super open ].
</methods> <methods> RuntimePackager.RuntimeBuilderUI class <category>utility</category>
browseClass: aClass "Browse the class provided. This method is primarily here to allow release dependent changes to the interface for browsing a class" #{SmalltalkWorkbench} value browseClass: aClass.
changesPendingMessage ^(#ChangesPendingMessage << #RuntimePackager >> 'Changes are pending in already open windows.<n>Loading a new settings file will override these changes.<n><n>Do you want to continue anyway?') expandMacros
warningForEarlierScanMessage ^(#WarningForEarlierScan << #RuntimePackager >> 'Warning: results of an earlier Scan for Unreferenced Items step were<n>saved in the parameters file just loaded. These classes, methods, and<n>globals will be deleted in the final stripped image.<n><n>You may want to perform the Scan for Unreferenced Items step again to<n>ensure that the set of unreferenced items is consistent with this image.<n>') expandMacros
</methods> <methods> RuntimePackager.RuntimeBuilderUI class <category>class initialization</category>
initialize "Initialize the class" "RuntimeBuilderUI initialize" ActiveApplication := nil.
</methods> <methods> RuntimePackager.RuntimeErrorNotifier <category>internal</category>
checkForErrorRecursion "Make sure there was not a recursive error, that is, an error arising while handling a different error. ErrorProcess holds only the most recent error process to allow errors to arise within multiple processes. No semaphores are used for synchronization to avoid the possibility that an infinite wait could result. Multiple simultaneous entries into this logic are possible, but very unlikely and mostly harmless" self class errorState isNil ifTrue: [^self]. "check to see if we are in debug mode before shutting down" self debugNotifierMode ifTrue: [ RuntimeManager unhookNotifierClass. self halt: 'Recursive error condition in notifier under test']. ^super checkForErrorRecursion.
classifyException "Classify an exception as to its type." self exceptionType: #other. "Default" "is this a halt?" self exception creator == Object haltSignal ifTrue: [self exceptionType: #halt. ^self]. "is this a notify?" self exception creator == Object notifySignal ifTrue: [self exceptionType: #notify. ^self]. "check for types of user interrupt. Note that low space is a user interrupt." self exception creator == UserInterrupt ifTrue: [self exceptionType: #userInterrupt. ^self]. self exception creator == LowSpaceInterrupt ifTrue: [self exceptionType: #lowSpace. ^self].
inferMissingData "Fill out missing values based on what was provided" "if no exception was passed initially find one" self exception isNil ifTrue: [ self exception: self findException ]. "if proceedability was not indicated, take it from the exception" self isProceedable isNil ifTrue: [ self isProceedable: self exception isResumable ]. "in the case where no context was provided explicitly, it should be the parameter for the exception." self context isNil ifTrue: [ self context: self exception parameter ]. "determine the type of exception" self classifyException.
quitImage RuntimeManager quitImageException.
</methods> <methods> RuntimePackager.RuntimeErrorNotifier <category>actions</category>
createDump "Create a dump that is appropriate for the runtime image. If the interrupt was from the user, then check with the user first, to see if they want to quit the image. If they do, then write the dump and quit the image. If the request to create a runtime image dump was not caused by an user interrupt, then write the dump file and quit the image." self isHeadless ifTrue: [^self createEmergencyDump]. Processor activeProcess suspendResumable: true do: [:proc | | userNotified dumpWorked | userNotified := false. self cleanUpUserInterface. self isInterruptFromUser ifTrue: [userNotified := true. self confirmUserInterruptRequest ifFalse: [self class resetErrorState. ^self proceedAfterUserInterrupt]]. dumpWorked := self createEmergencyDump. userNotified ifFalse: [self notifyUserOfUnhandledException: dumpWorked]]. "Finally, terminate the image. " self class errorState: #quitting. RuntimeManager quitImageException
createEmergencyDump "If RuntimeImageDumper is defined, create a dump log unless #dumpLogTo: fails with an OsError. If the dump fails due to an OsError and the image is not headless alert the user of an error saving the dump file and ask for a new pathname until the dump is successful or the user cancels. Answer true if the dump succeeded or false otherwise. Also answer true if no dump is requested, as in the case where RuntimeImageDumper isNil." self imageDumperClass ifNil: [^true]. errorFilename := self initialDumpPathString. errorFilename := self validDumpFilenameFrom: errorFilename asString. ^[ errorFilename := self ensureDumpFilenameIsWritable: errorFilename. errorFilename isNil ifTrue: [false] ifFalse: [self dumpLogTo: errorFilename]. ] on: OsError do: [:ex | self requestNewValidFilenameAfterError: ex].
proceedAfterUserInterrupt "Proceed carefully after a user interrupt. When event driven windows are interrupted, event queue synchronization errors can result. This case is recognized and the exception is dismissed. Since there is nothing going on at the time anyway, the effect is the same. This is all just a work-around for what is probably a bug in the event queue mechanism" self canProceedAfterUserInterrupt ifFalse: [ self dismissException ]. " otherwise we can just proceed as normal " ^self exception proceed
proceedExceptionOr: aBlock "See if this notifier is being tested and if so open a normal debugging notifier." self debugNotifierMode ifTrue: [RuntimeManager unhookNotifierClass. self halt: 'Halted in notifier under test']. "Fill out missing information depending on which instantiation technique was used. This is done after the recursive error test to catch problems finding the missing ingredients." self inferMissingData. "Check for proceedable signal that can proceed." self isProceedable ifTrue: [self canProceedableExceptionProceed ifTrue: [self class resetErrorState. self exception proceed]]. ^aBlock value
</methods> <methods> RuntimePackager.RuntimeErrorNotifier <category>testing</category>
canProceedableExceptionProceed "Answer true if the current exception can proceed and false if not. By default halts are allowed to proceed, but this can be overridden. Low space warnings are generally not allowed to proceed. This test can be overridden in subclasses." " ignore a halt " self exceptionType == #halt ifTrue: [ ^ self canProceedAfterHalt ]. "Look for a low space warning" self exceptionType == #lowSpace ifTrue: [ ^self canProceedOnLowSpaceWarning ]. " other cases do not proceed automatically" ^false
canProceedAfterHalt "Answer whether halts are to be automatically proceeded. The default is true but this can be overridden in subclasses" ^true
canProceedAfterUserInterrupt "Answer true if a user interrupt can proceed. When event driven windows are interrupted, event queue synchronization errors can result. This case is recognized and false is answered." | queueClass nextClassAndMethod semaphoreClass waitClassAndMethod ctx foundNext foundWait counter | "obviously, the exception must be proceedable" self isProceedable ifFalse: [ ^false ]. " locate the things needed to search the context stack " queueClass := #{EventQueue} valueOrDo: [ ^true ]. ( nextClassAndMethod := queueClass findSelector: #next ) isNil ifTrue: [ ^ true ]. semaphoreClass := #{Semaphore} valueOrDo: [ ^false ]. ( waitClassAndMethod := semaphoreClass findSelector: #wait ) isNil ifTrue: [ ^true ]. " now look through the stack for Semaphore>>wait and EventQueue>>next " ctx := self context. foundNext := false. foundWait := false. counter := 0. [ foundNext not and: [ ctx notNil and: [ counter < 10 ] ] ] whileTrue: [ ( ctx receiver class == semaphoreClass and: [ ctx method == waitClassAndMethod last ] ) ifTrue: [ foundWait := true ]. ( ctx receiver class == queueClass and: [ ctx method == nextClassAndMethod last ] ) ifTrue: [ foundNext := true ]. ctx := ctx sender. counter := counter + 1 ]. " if the problem children methods are found, then there is no way to proceed without causing an error" foundNext & foundWait ifTrue: [ ^false ]. " otherwise we can just proceed as normal " ^true
canProceedOnLowSpaceWarning "Answer true if the current low space warning is to be proceeded. This can be overridden in subclasses" ^false
isHeadless "Answer true if this image is operating in headless mode" ^RuntimeManager isHeadless
isInterruptFromUser "Answer true if the exception really is from the user versus other unrelated ways of raising the userInterruptSignal such as low memory." " must be a user interrupt signal" ^( self exceptionType == #userInterrupt and: [ self exception isResumable ] )
</methods> <methods> RuntimePackager.RuntimeErrorNotifier <category>private</category>
ensureDumpFilenameIsWritable: aFilenameOrNil "Return aFilenameOrNil if it is writable, or prompt for a new file if it is not. If aFilenameOrNil is nil, it represents the user's attempt to cancel, so return nil." ^(aFilenameOrNil isNil or: [aFilenameOrNil canBeWritten]) ifTrue: [aFilenameOrNil] ifFalse: [self requestValidFilenameIfHeadful: #unwritableErrorLog << #dialogs >> 'Unwritable file. Please specify a writable file for the error log:' default: aFilenameOrNil asString]
initialDumpPathString | path | path := self errorLogPath isNil ifTrue: [String new] ifFalse: [self errorLogPath]. (path respondsTo: #asResolvedString) ifTrue: [path := path asResolvedString]. ^path
requestNewValidFilenameAfterError: ex "There's been an error in writing out the log (e.g. disk full, disk error, no permissions). If we have a GUI available, ask the user if they want to try another filename, or just give up and quit. If there's no GUI, then just quit" self isHeadless ifTrue: [ex return: false]. ^(RuntimeManager hiddenReferenceTo: 'Dialog') ifNil: [false] ifNotNil: [:dialogClass | | tryToContinue | "An OS error has prevented dump completion. Ask the user for an alternate dump file and retry" tryToContinue := (dialogClass choose: (#unableToWriteLog << #dialogs >> 'Unable to write log: <1s>' expandMacrosWith: ex messageText) labels: (Array with: #chooseNewDestination << #dialogs >> 'Choose new destination' with: #runtimeAbort << #labels >> 'Quit without writing error log') values: #(true false) default: true). tryToContinue ifTrue: [ errorFilename := self requestValidFilenameIfHeadful: #invalidLogFileName << #dialogs >> 'Invalid file name. To what file should errors be written?' default: errorFilename asString. ex retry] ifFalse: [false]].
requestValidFilenameIfHeadful: messageString default: defaultString "Ask the user to supply a filename. Answer the resulting string, or answer nil if headless or if Dialog is undefined." | dialogClass newFileString | (self isHeadless or: [(dialogClass := RuntimeManager hiddenReferenceTo: 'Dialog') isNil]) ifTrue: [^nil]. newFileString := dialogClass requestFileName: messageString default: defaultString. ^self validDumpFilenameFrom: newFileString
showBusyWhile: aBlock | cursorClass | ^(self isHeadless or: [(cursorClass := RuntimeManager hiddenReferenceTo: 'Cursor') isNil]) ifTrue: [aBlock value] ifFalse: [cursorClass write showWhile: aBlock].
validDumpFilenameFrom: aStringOrNil "Return the filename representation of aStringOrNil, or nil. Prompt the user for a new file if aString does not represent a valid filename. If aString is empty or nil, this represents the user's attempt to cancel, or an abort of the prompt when running headless, so return nil." ^(aStringOrNil isNil or: [aStringOrNil isEmpty]) ifTrue: [nil] ifFalse: [[aStringOrNil asFilename] on: Error do: [:ex | self requestValidFilenameIfHeadful: #invalidLogFileName << #dialogs >> 'Invalid file name. To what file should errors be written?' default: aStringOrNil]]
</methods> <methods> RuntimePackager.RuntimeErrorNotifier <category>accessing</category>
debugNotifierMode "Answer true if the notifier is being tested and the standard debugger is used to follow its progress" ^self class debugNotifierMode == true
errorLogPath "Answer the name of the file used to contain the image dump. Expanded the string using current environment variables (if supported) This can be overridden in subclasses" ^RuntimeManager errorLogPath
exceptionType "Answer the type of the exception" ^exceptionType
exceptionType: aSymbol "Set the type of the exception" exceptionType := aSymbol.
isProceedable "Answer whether this exception is proceedable" ^isProceedable
isProceedable: aBoolean "Set whether this exception is proceedable" isProceedable := aBoolean.
</methods> <methods> RuntimePackager.RuntimeErrorNotifier <category>user interface</category>
cleanUpUserInterface "Clean up the user interface after an error. This should be overridden in subclasses as needed" ^self
confirmUserInterruptRequest "Ask the user if the image should quit now This should be overridden in subclasses as needed" ^true
notifyUserOfUnhandledException: dumpWorked "Actually notify the user of the unhandled exception. dumpWorked is a boolean indicating if a dump was written. This should be overridden in subclasses as needed" ^self
</methods> <methods> RuntimePackager.RuntimeErrorNotifier class <category>instance creation</category>
notify: anException context: aContext "Notify the user about an exception" ^self new exception: anException; context: aContext; notify
</methods> <methods> RuntimePackager.RuntimeErrorNotifier class <category>accessing</category>
debugNotifierMode "Answer whether we are running in debug mode" ^debugNotifierMode
debugNotifierMode: aBoolean "Set whether we are running in debug mode" "self debugNotifierMode: true" debugNotifierMode := aBoolean.
imageDumperClass "Answer the class for dumping the image. If no class is set, use the value provided in RuntimeManager which originated in the options specifications." imageDumperClass notNil ifTrue: [ ^imageDumperClass ]. ^RuntimeManager imageDumperClass
</methods> <methods> RuntimePackager.RuntimeErrorNotifier class <category>class initialization</category>
initialize "Reset class state to an initial condition" debugNotifierMode := false. self resetErrorState.
</methods> <methods> RuntimePackager.RuntimeEmergencyNotifier <category>user interface</category>
cleanUpUserInterface "Clean up the user interface after an error." "Try to shutdown any active controllers when an error occurs" Window activeController ifNotNil: [:activeController | activeController shutdownBecauseOfError]. "Make all open windows non-modal" WindowManager beEffectivelyModeless. (InputState default respondsTo: #ungrabBecauseOfError) ifTrue: [InputState default ungrabBecauseOfError]. " Restore event queue " EventQueue allInstancesDo: [:each | each restoreReadSynchSignals].
confirmUserInterruptRequest "Ask the user if the image should quit now" ^self confirm: self class userInterruptMsg
notifyUserOfUnhandledException: dumpWorked "Actually notify the user of the unhandled exception. dumpWorked is a boolean indicating if a dump was written" | msg errorString | msg := WriteStream on: (String new: 512). errorString := self exception errorString. errorString size > 60 ifTrue: [ errorString := errorString copyFrom: 1 to: 55. errorString := errorString, ' ...' ]. msg nextPutAll: errorString; cr; cr; nextPutAll: self class errorOccurredMsg. dumpWorked ifFalse: [ msg cr; nextPutAll: self class dumpFailedMsg ]. self warn: msg contents.
notifyUserWhenImageQuitFails "Notify the user when an attempt to quit the image fails" | abortTime abortWin text | " remember when this started " abortTime := Time now asSeconds. " put up a dumb window without a real UI (safer that way)" text := (self class emergencyAbortText expandMacrosWith: self initialDumpPathString) asComposedText. abortWin := ScheduledWindow openNewIn: ( 0@0 extent: text preferredBounds extent + (40@40) ). text displayOn: abortWin graphicsContext at: 20@20. " write the dump " self createEmergencyDump. " wait in a spin loop -- safest way possible" [Time now asSeconds - abortTime < 5 ] whileTrue: [text displayOn: abortWin graphicsContext at: 20@20]. " now close the window " abortWin close.
</methods> <methods> RuntimePackager.RuntimeEmergencyNotifier <category>dialog interface</category>
choose: choice labels: labels values: values default: default "Notify user via a Dialog" ^self class dialogClass choose: choice labels: labels values: values default: default
confirm: aString "Notify the user by using a Dialog." ^self class dialogClass confirm: aString
warn: aString "Warn the user by using a Dialog." ^self class dialogClass warn: aString.
</methods> <methods> RuntimePackager.RuntimeEmergencyNotifier class <category>accessing</category>
dialogClass "Answer the class for notifying the user of an error" ^DialogClass
dialogClass: aClass "Set the class for notifying the user of an error" DialogClass := aClass.
dumpFailedMsg ^DumpFailedMsg
dumpFailedMsg: aString DumpFailedMsg := aString
emergencyAbortText ^emergencyAbortText
emergencyAbortText: aComposedText emergencyAbortText := aComposedText asString
errorOccurredMsg ^ErrorOccurredMsg
errorOccurredMsg: aString ErrorOccurredMsg := aString
userInterruptMsg ^UserInterruptMsg
userInterruptMsg: aString UserInterruptMsg := aString
</methods> <methods> RuntimePackager.RuntimeEmergencyNotifier class <category>class initialization</category>
initialize "Reset class state to an initial condition" DialogClass := Dialog. UserInterruptMsg := 'Processing was interrupted by user request. Do you want to terminate this application now?'. ErrorOccurredMsg := 'An error occurred in this application. The application will now terminate. '. DumpFailedMsg := 'A diagnostic dump of the error could not be made, or the dump was incomplete.'. emergencyAbortText := 'A system error occurred during quit. A diagnostic dump is being written to <t><1p> after which this application will terminate'.
</methods> <methods> RuntimePackager.RuntimeDebugNotifier <category>user interface</category>
confirmUserInterruptRequest "Ask the user if the image should quit now. If the user indicates that the error should be ignored create a dump and dismiss the exception." | userResp labels values | "see if there is a way to proceed after the interrupt " self canProceedAfterUserInterrupt ifTrue: [ labels := Array with: ( self class buttonTitles at: #exit ) with: ( self class buttonTitles at: #proceed ) with: ( self class buttonTitles at: #dismiss ). values := #( #exit #proceed #dismiss). ] ifFalse: [ labels := Array with: ( self class buttonTitles at: #exit ) with: ( self class buttonTitles at: #dismiss ). values := #( #exit #dismiss). ]. " take input from the user " userResp := self choose: self class userInterruptMsg labels: labels values: values default: #exit. userResp == #dismiss ifTrue: [ self createEmergencyDump. self dismissException ]. ^userResp == #exit
notifyUserOfUnhandledException: dumpWorked "Notify user and see if image should be terminated" | msg errorString labels values resp | msg := WriteStream on: (String new: 512). errorString := self exception errorString. errorString size > 80 ifTrue: [ errorString := errorString copyFrom: 1 to: 75. errorString := errorString, ' ...' ]. msg nextPutAll: errorString; cr; cr; nextPutAll: self class errorOccurredMsg. dumpWorked ifFalse: [ msg cr; nextPutAll: self class dumpFailedMsg ]. " ask the user if the image should be terminated " self isProceedable ifTrue: [ labels := Array with: ( self class buttonTitles at: #exit ) with: ( self class buttonTitles at: #proceed ) with: ( self class buttonTitles at: #continue ). values := #( #exit #proceed #continue ). ] ifFalse: [ labels := Array with: ( self class buttonTitles at: #exit ) with: ( self class buttonTitles at: #continue ). values := #( #exit #continue ). ]. resp := self choose: msg contents labels: labels values: values default: #exit. resp == #exit ifTrue: [ ^self ]. " see if we should proceed with this exception " resp == #proceed ifTrue: [ self class resetErrorState. ^self exception proceed ]. "otherwise, dismiss the current exception -- this does not return" self dismissException.
</methods> <methods> RuntimePackager.RuntimeDebugNotifier class <category>accessing</category>
buttonTitles "Answer the dictionary used to hold button titles. If no value has been saved for buttons, answer with a default" ButtonTitles size = 0 ifTrue: [ ButtonTitles := Dictionary new at: #exit put: 'Exit'; at: #proceed put: 'Proceed'; at: #dismiss put: 'Dismiss'; at: #continue put: 'Continue'; yourself. ]. ^ButtonTitles
buttonTitles: aDictionary "Set the dictionary used to hold button titles." ButtonTitles := aDictionary.
debugErrorMsg "Answer the message to be displayed to the user when an unhandled exception is encounterred." ^DebugErrorMsg
debugErrorMsg: aString "Set the message to be displayed to the user when an unhandled exception is encounterred." DebugErrorMsg := aString.
debugInterruptMsg "Answer the message to be displayed to the user when a user interrupt is encounterred." ^DebugInterruptMsg
debugInterruptMsg: aString "Set the message to be displayed to the user when a user interrupt is encounterred." DebugInterruptMsg := aString.
errorOccurredMsg "Provide a message to the user for errors in a debug mode." ^ self debugErrorMsg size == 0 ifTrue: [ 'An error has occurred. Continue processing only if you are\' withCRs, 'certain that application data integrity will not be affected.' ] ifFalse: [ self debugErrorMsg ]
userInterruptMsg "Answer the message displayed when a user interrupt occurs" ^self debugInterruptMsg size = 0 ifTrue: [ 'Processing was interrupted by user request. Press Exit to exit the application. Press Proceed (if shown) to proceed without interruption. Press Dismiss to stop the current operation. ' ] ifFalse: [ self debugInterruptMsg ]
</methods> <methods> RuntimePackager.RuntimeFullDumper <category>dumping</category>
dumpArgs: aContext "Dump the receiver and stack for the context" | local | aContext isBlockContext ifFalse: ["Must be a method context" dumpStream crtab; nextPutAll: 'Receiver: '. self dumpValue: aContext homeReceiver. 1 to: aContext method numArgs do: [:n | [local := aContext localAt: n] on: Object subscriptOutOfBoundsSignal do: [:ex | local := 'Out of bounds -- not on context stack']. dumpStream crtab; nextPutAll: 'Arg'; nextPutAll: n printString; nextPutAll: ': '. self dumpValue: local]]
dumpCommandLine "Write a representation of the current command line, if possible" | opts | dumpStream cr; nextPutAll: 'Command Line:'. opts := CEnvironment commandLine. opts do: [ :opt | dumpStream space; nextPutAll: opt asString. ].
dumpDatabases "Dump critical database objects, that is, connections and sessions" " make sure that database classes are resident before writing the dump " | dbConnClass dbSessionClass | dbConnClass := RuntimeManager hiddenReferenceTo: 'ExternalDatabaseConnection'. dbSessionClass := RuntimeManager hiddenReferenceTo: 'ExternalDatabaseSession'. dbConnClass isNil | dbSessionClass isNil ifTrue: [ ^self ]. self dumpSeparator. " dump all database connections " dumpStream cr; nextPutAll: 'External Database Connections (all instances):'. dbConnClass allSubclasses do: [ :dbConnCl | dbConnCl allInstances do: [ :conn | dumpStream cr; crtab; print: conn; crtab: 2; nextPutAll: 'hash: '; print: conn identityHash; crtab: 2; nextPutAll: 'state: '; print: conn state; crtab: 2; nextPutAll: 'username: '; print: conn username; crtab: 2; nextPutAll: 'environment: '; print: conn environment. ] ]. " dump all database sessions " dumpStream cr; cr; nextPutAll: 'External Database Sessions (all instances):'. dbSessionClass allSubclasses do: [ :dbSessCl | dbSessCl allInstances do: [ :sess | dumpStream cr; crtab; print: sess; crtab: 2; nextPutAll: 'state: '; print: sess state; crtab: 2; nextPutAll: 'connection hash: '; print: sess connection identityHash; crtab: 2; nextPutAll: 'query: '; print: sess query. ] ]. " end of this section" dumpStream cr.
dumpExceptionReport: anException context: aContext "Append a dump onto the dump stream. anException represents the condition causing the dump to be written in the first place. aContext is the context in which the exception was raised. The invoker should handle exceptions that may arise in this process " self dumpHeader. self dumpSummary: anException. self dumpCommandLine. self dumpSeparator. dumpStream cr; nextPutAll: 'Active Process'. self dumpDetailsOfProcess: Processor activeProcess. self dumpStack: aContext. self dumpException: anException. self dumpStackArgs: aContext. self dumpQuiescentProcesses. self dumpSuspendedProcesses. self dumpTranscript. self dumpDatabases. self dumpWindows. self dumpExtra. self dumpTrailer.
dumpExtra "Dump anything else that needs dumping. This method is here for subclasses that might want to add to the end of a dump." ^self
dumpImageIdentification dumpStream cr; nextPutAll: 'Image Identification: '; print: RuntimeManager imageIdentification
dumpQuiescentProcesses "Dump all processes other than the active one" | quiescentProcesses | self dumpSeparator. dumpStream cr; nextPutAll: 'Quiescent Processes'. quiescentProcesses := Processor instVarAt: ( RuntimeManager quiescentProcessListsIndex). quiescentProcesses do: [ :pl | pl do: [ :p | p suspendedContext notNil ifTrue: [ self dumpDetailsOfProcess: p. self dumpStack: p suspendedContext ] ] ].
dumpStackArgs: aContext "Dump a description of the args used for the initial stack entries. This is done separately just in case there is a fatal error in evaluating the printString of one of the argument values.." | maxNbr ctx stackSize | self dumpSeparator. dumpStream cr; nextPutAll: 'Initial Context Stack Arguments:'. maxNbr := self maximumArgFramesDumped. ctx := aContext. stackSize := 0. [ ctx notNil and: [ stackSize < maxNbr ] ] whileTrue: [ stackSize := stackSize + 1. "Only dump args for MethodContexts, which are those that are not block contexts" ctx isBlockContext ifFalse: [ [ dumpStream cr; nextPut: $[; print: stackSize; nextPut: $]; space; print: ctx. self dumpArgs: ctx. ] on: Error do: [ :ex | dumpStream cr; nextPutAll: '--Error: ', ex description ] ]. ctx := ctx sender ]. " end of this section " dumpStream cr.
dumpSuspendedProcesses "Dump all processes that are neither active nor suspended" | quiescentProcesses rejectProcesses | self dumpSeparator. dumpStream cr; nextPutAll: 'Suspended Processes'. " Get the collection of processes not to be printed" quiescentProcesses := Processor instVarAt: ( RuntimeManager quiescentProcessListsIndex). rejectProcesses := IdentitySet withAll: quiescentProcesses. rejectProcesses add: Processor activeProcess. " Now look at all instances of Process and print those with a suspended context" Process allInstances do: [ :process | process suspendedContext notNil ifTrue: [ ( rejectProcesses includes: process ) ifFalse: [ self dumpDetailsOfProcess: process. self dumpStack: process suspendedContext ] ] ].
dumpTranscript "Dump the entire Transcript" " do not do the dump is Transcript is not in the image " Transcript class == TextCollector ifFalse: [ dumpStream cr; nextPutAll: 'Transcript is not a TextCollector'; cr. ^self ]. self dumpSeparator. dumpStream cr; nextPutAll: 'Transcript:'; cr; nextPutAll: '<<<BEGIN TRANSCRIPT>>>'; cr; nextPutAll: Transcript value; cr; nextPutAll: '<<<END TRANSCRIPT>>>'; cr.
dumpWindowParts: aComp origin: aPoint "Dump window parts by recursively descending the window structure. aComp is the component being dumped and aPoint is theoretically its origin. This very non-oo approach is used to avoid sprinkling methods into the classes that would ordinarily do this recursion." | contents pointString | " descend the window structure " ( aComp isKindOf: ( RuntimeManager hiddenReferenceTo: 'BoundedWrapper' ) ) ifTrue: [ ^self dumpWindowParts: aComp component origin: aPoint + aComp bounds origin ]. ( aComp isKindOf: ( RuntimeManager hiddenReferenceTo: 'Wrapper' ) ) ifTrue: [ ^self dumpWindowParts: aComp component origin: aPoint ]. ( aComp isKindOf: ( RuntimeManager hiddenReferenceTo: 'CompositePart' ) ) ifTrue: [ ^aComp components do: [ :comp | self dumpWindowParts: comp origin: aPoint ] ]. " see if we have reached something with a model " ( aComp isKindOf: ( RuntimeManager hiddenReferenceTo: 'DependentPart' ) ) ifFalse: [ ^self ]. pointString := ( aPoint printString, ' ' ) copyFrom: 1 to: 10. " see how to dump what we have found " ( aComp isKindOf: ( RuntimeManager hiddenReferenceTo: 'ComposedTextView' ) ) ifTrue: [ dumpStream crtab: 2; nextPutAll: pointString; tab; nextPutAll: 'displayContents: '. contents := ( aComp displayContents textAt: 1 ) asString. contents size > 128 ifFalse: [ ^dumpStream print: contents ] ifTrue: [ ^dumpStream print: (contents copyFrom: 1 to: 64); nextPutAll: ' ... '; print: (contents copyFrom: contents size - 63 to: contents size ) ] ]. ( aComp isKindOf: ( RuntimeManager hiddenReferenceTo: 'SequenceView' ) ) ifTrue: [ aComp selectionIndex > 0 ifTrue: [ dumpStream crtab: 2; nextPutAll: pointString; tab. ^dumpStream nextPutAll: 'selection: '; print: (aComp displayStringAt: aComp selectionIndex ) ] ]. ( aComp isKindOf: ( RuntimeManager hiddenReferenceTo: 'TableView' ) ) ifTrue: [ aComp selectionIndex = aComp zeroIndex ifFalse: [ dumpStream crtab: 2; nextPutAll: pointString; tab. ^dumpStream nextPutAll: 'selection: '; print: (aComp displayStringAt: aComp selectionIndex ) ] ].
dumpWindows "Dump identifying information on all scheduled windows" | controllers view retryCount | self dumpSeparator. dumpStream cr; nextPutAll: 'Scheduled Windows:'. controllers := ScheduledControllers scheduledControllers. controllers do: [:cont | view := cont view. dumpStream cr; crtab; print: view. (view isKindOf: ScheduledWindow) ifTrue: [dumpStream space; nextPutAll: 'label: '; print: view label; crtab: 2; nextPutAll: 'model class: '; nextPutAll: view model class name. retryCount := 0. [self dumpWindowParts: view component origin: 0 @ 0] on: Object errorSignal do: [:ex | (retryCount := retryCount + 1) > 1 ifTrue: [ex reject]. dumpStream cr; nextPutAll: '=== EXCEPTION DURING DUMP: '; print: ex errorString] " detect recursive errors and percolate if so"]]. dumpStream cr
</methods> <methods> RuntimePackager.RuntimeStartupController <category>basic control sequence</category>
controlTerminate RuntimeManager runState == #aboutToSave ifTrue: ["remove dead references" RuntimeManager ensureUnscheduleWindow: view. eventDispatcher := model := view := sensor := nil. "now go do the real work" [RuntimeManager createAndSaveFinalImage] fork]
</methods> <methods> RuntimePackager.RuntimeBuilderOptionsEditor <category>internals</category>
buildParcelList "Build the list of parcels on startup or whenever it is changed" | saveSelection list loadables | self retractParcelInterests. saveSelection := self parcelList selection. list := List new. loadables := Set new. parcelOptions keysAndValuesDo: [ :key :popt | ( popt at: #loadable ifAbsent: [ false ] ) ifTrue: [ loadables add: key ] ]. Parcel parcels do: [ :parcel | | nm key | nm := parcel name asString. key := ( '<', nm, '>' ) asText. ( loadables includes: nm ) ifTrue: [ key := key allBold ]. list add: key -> nm. ]. self parcelList list: ( list sort; yourself ). self parcelList selection: saveSelection. self parcelList selection isNil ifTrue: [ currentParcel := nil. edittingBuilder notNil ifTrue: [ self disableParcelEntryFields: edittingBuilder. ]. self clearParcelEntryFields. ]. self expressParcelInterests.
changeRequest "Release dependencies when the window closes" | result | ( result := super changeRequest ) ifTrue: [ self release ]. ^result
clearParcelEntryFields "Reset the data entry fields for a parcel" self parcelIsLoadable value: false. self parcelUnloadBeforeStrip value: false. self parcelSaveOption value: #doNotSaveParcel. self parcelPath value: String new.
copyValuesFromSubject "Copy options values from the options object to its editor" self removeCompiler value: subject removeCompiler. self doThreeSaves value: subject doThreeSaves. self skipScan value: subject skipScan. self suppressSplashScreen value: subject suppressSplashScreen. self clearParcelPath value: subject clearParcelPath. self packageExternalInterfaces value: subject packageExternalInterfaces. self removeOrganization value: subject removeOrganization. self startupClass value: ( subject startupClass isNil ifTrue: [ '' ] ifFalse: [ subject startupClass fullName asString ] ). self startupMethod value: ( subject startupMethod isNil ifTrue: [ '' ] ifFalse: [ subject startupMethod asString ] ). self errorNotifierClass value: ( subject errorNotifierClass isNil ifTrue: [ '' ] ifFalse: [ subject errorNotifierClass fullName asString ] ). self imageDumperClass value: ( subject imageDumperClass isNil ifTrue: [ '' ] ifFalse: [ subject imageDumperClass fullName asString ] ). self errorLogPath value: subject errorLogPath. self imagePath value: subject imagePath. self useAutoLoader value: subject useAutoLoader. self headlessImage value: subject headlessImage. self mergeByteCodes value: subject mergeByteCodes. self mergeLiterals value: subject mergeLiterals. self mergeMethods value: subject mergeMethods. self osMac value: subject osMac. self osOS2 value: subject osOS2. self osUnix value: subject osUnix. self osWindows value: subject osWindows. self uiLookCUA value: subject uiLookCUA. self uiLookMac value: subject uiLookMac. self uiLookMotif value: subject uiLookMotif. self uiLookOpenLook value: subject uiLookOpenLook. self uiLookWindows value: subject uiLookWindows. self useRuntimeCompiledMethod value: subject useRuntimeCompiledMethod. self stripGlobals value: subject stripGlobals. self traceLevel value: subject traceLevel. " set prestrip class and method " self prestripClass value: ( subject prestripClass isNil ifTrue: [ '' ] ifFalse: [ subject prestripClass fullName asString ] ). self prestripMethod value: ( subject prestripMethod isNil ifTrue: [ '' ] ifFalse: [ subject prestripMethod asString ] ). " set last window action " subject continueOnLastWin ifTrue: [ self lastWindowCloseAction value: #continue ] ifFalse: [ subject shutdownOnLastWin ifTrue: [ self lastWindowCloseAction value: #shutdown ] ifFalse: [ self lastWindowCloseAction value: #standard ] ]. " set up parcel information " parcelOptions := Dictionary new. subject parcelOptions keysAndValuesDo: [ :key :value | parcelOptions at: key put: value copy ]. self buildParcelList.
copyValuesToSubject "Copy options values back to the options object holding them" | changedAspects | super copyValuesToSubject. changedAspects := Set new. " see what was changed. Only certain aspects are checked" #( #removeCompiler #headlessImage #useRuntimeCompiledMethod #errorNotifierClass #imageDumperClass #startupClass #startupMethod) do: [ :aspect | ( self perform: aspect ) value = ( subject perform: aspect ) ifFalse: [ changedAspects add: aspect ] ]. #( #osWindows #osOS2 #osUnix #osMac ) do: [ :aspect | ( self perform: aspect ) value = ( subject perform: aspect ) ifFalse: [ changedAspects add: #operatingSystems ] ]. #( #uiLookCUA #uiLookMac #uiLookMotif #uiLookOpenLook #uiLookWindows ) do: [ :aspect | ( self perform: aspect ) value = ( subject perform: aspect ) ifFalse: [ changedAspects add: #uiLooks ] ]. " transfer values to the subject " subject removeCompiler: self removeCompiler value. subject doThreeSaves: self doThreeSaves value. subject skipScan: self skipScan value. subject suppressSplashScreen: self suppressSplashScreen value. subject clearParcelPath: self clearParcelPath value. subject packageExternalInterfaces: self packageExternalInterfaces value. subject removeOrganization: self removeOrganization value. subject shutdownOnLastWin: ( self lastWindowCloseAction value == #shutdown ). subject continueOnLastWin: ( self lastWindowCloseAction value == #continue ). subject startupClass: ( self startupClass value = '' ifTrue: [ nil ] ifFalse: [ self classNamed: self startupClass value ] ). subject startupMethod: ( self startupClass value = '' ifTrue: [ nil ] ifFalse: [ self startupMethod value asSymbol ] ). subject errorNotifierClass: ( self errorNotifierClass value = '' ifTrue: [ nil ] ifFalse: [ self classNamed: self errorNotifierClass value ] ). subject imageDumperClass: ( self imageDumperClass value = '' ifTrue: [ nil ] ifFalse: [ self classNamed: self imageDumperClass value ] ). subject prestripClass: ( self prestripClass value = '' ifTrue: [ nil ] ifFalse: [ self classNamed: self prestripClass value ] ). subject prestripMethod: ( self prestripClass value = '' ifTrue: [ nil ] ifFalse: [ self prestripMethod value asSymbol ] ). subject errorLogPath: self errorLogPath value. subject imagePath: self imagePath value. currentParcel notNil ifTrue: [ " force any pending values to be processed " self parcelList selectionIndex: 0 ]. subject useAutoLoader: self useAutoLoader value. subject headlessImage: self headlessImage value. subject mergeByteCodes: self mergeByteCodes value. subject mergeLiterals: self mergeLiterals value. subject mergeMethods: self mergeMethods value. subject osMac: self osMac value. subject osOS2: self osOS2 value. subject osUnix: self osUnix value. subject osWindows: self osWindows value. subject uiLookCUA: self uiLookCUA value. subject uiLookMac: self uiLookMac value. subject uiLookMotif: self uiLookMotif value. subject uiLookOpenLook: self uiLookOpenLook value. subject uiLookWindows: self uiLookWindows value. subject useRuntimeCompiledMethod: self useRuntimeCompiledMethod value. subject stripGlobals: self stripGlobals value. subject traceLevel: self traceLevel value. subject parcelOptions: parcelOptions. subject removeNonloadableParcels. " tell interested parties about the change " subject changed: #values with: changedAspects.
disableParcelEntryFields: aBuilder "Disable the data entry fields for a parcel" | comp | self parcelAspects do: [ :aspect | comp := aBuilder componentAt: aspect. comp notNil ifTrue: [ " do not disable loadable option selection" aspect == #parcelIsLoadable ifFalse: [ comp disable ] ] ]. self parcelList selection isNil ifTrue: [ comp := aBuilder componentAt: #parcelIsLoadable. comp notNil ifTrue: [ comp disable ] ].
enableParcelEntryFields: aBuilder "Enable the data entry fields for a parcel" | comp | self parcelAspects do: [ :aspect | comp := aBuilder componentAt: aspect. comp notNil ifTrue: [ " only enable those allow by the loadable status" ( aspect == #parcelIsLoadable ) | ( self parcelIsLoadable value ) ifTrue: [ comp enable ] ifFalse: [ comp disable ] ] ].
expressParcelInterests "Add dependency relationships used for parcel processing. Note that Parcel sends multiple update messages for one change in some cases. " " need to know if parcels change in Parcel class" self parcelList selectionIndexHolder onChangeSend: #parcelListSelectionChanged to: self. self parcelIsLoadable onChangeSend: #parcelIsLoadableChanged to: self. Parcel addDependent: self.
parcelAspects "Answer the names of the parcel entry field aspects" ^#( #parcelIsLoadable #parcelUnloadBeforeStrip #saveParcel #stripParcel #doNotSaveParcel #parcelPath ).
parcelIsLoadableChanged "React to a change in parcelIsLoadable aspect by enabling/disabling fields. The default value of the save option changes depending on whether the parcel is loadable or not. Actually, the save option for a non-loadable parcel is irrelevant, but potentially confusing to a user who may not be aware of this." | popt | popt := parcelOptions at: currentParcel ifAbsent: [ Dictionary new ]. edittingBuilder notNil & self parcelIsLoadable value ifTrue: [ popt isEmpty ifTrue: [ self parcelUnloadBeforeStrip value: false. self parcelSaveOption value: #stripParcel. ]. self enableParcelEntryFields: edittingBuilder. ] ifFalse: [ popt isEmpty ifTrue: [ self parcelUnloadBeforeStrip value: false. self parcelSaveOption value: #doNotSaveParcel. ]. self disableParcelEntryFields: edittingBuilder. ].
parcelListSelectionChanged "Respond to a change in the parcel list selection" " ignore changing back to where we are already" self parcelList selection value = currentParcel ifTrue: [ ^self ]. currentParcel notNil ifTrue: [ " check current values and record them in the parcel " self validateCurrentParcel ifFalse: [ self resetParcelSelection. ^self ]. self saveCurrentParcelEntry. ]. " get values from the new current selection, if any " currentParcel := self parcelList selection value. currentParcel isNil ifTrue: [ edittingBuilder notNil ifTrue: [ self disableParcelEntryFields: edittingBuilder. ]. self clearParcelEntryFields. ] ifFalse: [ self setParcelAspectValues. edittingBuilder notNil ifTrue: [ self enableParcelEntryFields: edittingBuilder ] ].
resetParcelSelection "Reset the current parcel selection to the current parcel if possible" self parcelList selection: ( self parcelList list detect: [ :x | x value = currentParcel ] ifNone: [ currentParcel := nil. nil ] ).
retractParcelInterests "Add dependency relationships used for parcel processing" " need to know if parcels change in Parcel class" self parcelList selectionIndexHolder retractInterestsFor: self. self parcelIsLoadable retractInterestsFor: self. Parcel removeDependent: self.
saveCurrentParcelEntry "Save the current parcel entry before moving on to a new selection" | popt loadableChanged | " save the entered values, but only for loadable parcels " loadableChanged := self parcelIsLoadable value ~= ( ( parcelOptions at: currentParcel ifAbsent: [ Dictionary new ] ) at: #loadable ifAbsent: [ false ] ). self parcelIsLoadable value ifTrue: [ popt := Dictionary new. popt at: #loadable put: true. popt at: #saveParcel put: ( self parcelSaveOption value = #saveParcel ). popt at: #stripParcel put: ( self parcelSaveOption value = #stripParcel ). popt at: #path put: self parcelPath value. popt at: #unloadBeforeStrip put: self parcelUnloadBeforeStrip value. parcelOptions at: currentParcel put: popt. ] ifFalse: [ parcelOptions removeKey: currentParcel ifAbsent: [ ] ]. " force a rebuild of the parcel list to change emphasis" loadableChanged ifTrue: [ self buildParcelList ].
setParcelAspectValues "Set the values of parcel aspects when a new selection occurs" | popt | " avoid side effects of setting things" self retractParcelInterests. " set the loadable value" popt := parcelOptions at: currentParcel ifAbsent: [ Dictionary new ]. self parcelIsLoadable value: ( popt at: #loadable ifAbsent: [ false ] ). self parcelUnloadBeforeStrip value: ( popt at: #unloadBeforeStrip ifAbsent: [ false ] ). " set the save option value" ( popt at: #stripParcel ifAbsent: [ false ] ) ifTrue: [ self parcelSaveOption value: #stripParcel ] ifFalse: [ ( popt at: #saveParcel ifAbsent: [ self parcelIsLoadable value ] ) ifTrue: [ self parcelSaveOption value: #saveParcel ] ifFalse: [ self parcelSaveOption value: #doNotSaveParcel. ] ]. self parcelPath value: ( popt at: #path ifAbsent: [ currentParcel, '.pcl' ] ). self expressParcelInterests.
setTab: specName "Set the tab selection to the one with the specified subcanvas spec" | tabIndex | tabIndex := 0. 1 to: self tabs list size do: [ :i | ( self tabs list at: i ) value = specName ifTrue: [ tabIndex := i ] ]. self tabs selectionIndex: tabIndex.
tabSelectionChanged "Respond to a change in the notebook tab by setting the new subcanvas" | spec | self tabs selectionIndex = 0 ifTrue: [ ^self ]. spec := self tabs selection value. edittingBuilder := (self builder componentAt: #notebook) widget client: self spec:spec. self tabs selection value = #parcelsSpec ifTrue: [ self parcelIsLoadableChanged. ].
</methods> <methods> RuntimePackager.RuntimeBuilderOptionsEditor <category>aspects</category>
clearParcelPath "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^clearParcelPath isNil ifTrue: [clearParcelPath := false asValue] ifFalse: [clearParcelPath]
doThreeSaves "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^doThreeSaves isNil ifTrue: [doThreeSaves := false asValue] ifFalse: [doThreeSaves]
errorLogPath "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^errorLogPath isNil ifTrue: [errorLogPath := String new asValue] ifFalse: [errorLogPath]
errorNotifierClass "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^errorNotifierClass isNil ifTrue: [errorNotifierClass := String new asValue] ifFalse: [errorNotifierClass]
headlessImage "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^headlessImage isNil ifTrue: [headlessImage := false asValue] ifFalse: [headlessImage]
imageDumperClass "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^imageDumperClass isNil ifTrue: [imageDumperClass := String new asValue] ifFalse: [imageDumperClass]
imagePath "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^imagePath isNil ifTrue: [imagePath := String new asValue] ifFalse: [imagePath]
lastWindowCloseAction "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^lastWindowCloseAction isNil ifTrue: [lastWindowCloseAction := nil asValue] ifFalse: [lastWindowCloseAction]
mergeByteCodes "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^mergeByteCodes isNil ifTrue: [mergeByteCodes := false asValue] ifFalse: [mergeByteCodes]
mergeLiterals "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^mergeLiterals isNil ifTrue: [mergeLiterals := false asValue] ifFalse: [mergeLiterals]
mergeMethods "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^mergeMethods isNil ifTrue: [mergeMethods := false asValue] ifFalse: [mergeMethods]
osMac "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^osMac isNil ifTrue: [osMac := true asValue] ifFalse: [osMac]
osOS2 "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^osOS2 isNil ifTrue: [osOS2 := true asValue] ifFalse: [osOS2]
osUnix "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^osUnix isNil ifTrue: [osUnix := true asValue] ifFalse: [osUnix]
osWindows "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^osWindows isNil ifTrue: [osWindows := true asValue] ifFalse: [osWindows]
packageExternalInterfaces "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^packageExternalInterfaces isNil ifTrue: [packageExternalInterfaces := false asValue] ifFalse: [packageExternalInterfaces]
parcelIsLoadable "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^parcelIsLoadable isNil ifTrue: [parcelIsLoadable := false asValue] ifFalse: [parcelIsLoadable]
parcelList "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^parcelList isNil ifTrue: [parcelList := SelectionInList new] ifFalse: [parcelList]
parcelPath "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^parcelPath isNil ifTrue: [parcelPath := String new asValue] ifFalse: [parcelPath]
parcelSaveOption "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^parcelSaveOption isNil ifTrue: [parcelSaveOption := nil asValue] ifFalse: [parcelSaveOption]
parcelUnloadBeforeStrip "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^parcelUnloadBeforeStrip isNil ifTrue: [parcelUnloadBeforeStrip := false asValue] ifFalse: [parcelUnloadBeforeStrip]
prestripClass "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^prestripClass isNil ifTrue: [prestripClass := String new asValue] ifFalse: [prestripClass]
prestripMethod "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^prestripMethod isNil ifTrue: [prestripMethod := String new asValue] ifFalse: [prestripMethod]
removeCompiler "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^removeCompiler isNil ifTrue: [removeCompiler := false asValue] ifFalse: [removeCompiler]
removeOrganization "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^removeOrganization isNil ifTrue: [removeOrganization := false asValue] ifFalse: [removeOrganization]
saveParcel "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^saveParcel isNil ifTrue: [saveParcel := false asValue] ifFalse: [saveParcel]
shutdownOnLastWin "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^shutdownOnLastWin isNil ifTrue: [shutdownOnLastWin := false asValue] ifFalse: [shutdownOnLastWin]
skipScan "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^skipScan isNil ifTrue: [skipScan := false asValue] ifFalse: [skipScan]
startupClass "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^startupClass isNil ifTrue: [startupClass := String new asValue] ifFalse: [startupClass]
startupMethod "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^startupMethod isNil ifTrue: [startupMethod := String new asValue] ifFalse: [startupMethod]
stripGlobals "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^stripGlobals isNil ifTrue: [stripGlobals := false asValue] ifFalse: [stripGlobals]
stripParcel "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^stripParcel isNil ifTrue: [stripParcel := false asValue] ifFalse: [stripParcel]
suppressSplashScreen ^suppressSplashScreen isNil ifTrue: [suppressSplashScreen := false asValue] ifFalse: [suppressSplashScreen].
tabs "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^tabs isNil ifTrue: [tabs := SelectionInList new] ifFalse: [tabs]
traceLevel "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^traceLevel isNil ifTrue: [traceLevel := nil asValue] ifFalse: [traceLevel]
uiLookCUA "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^uiLookCUA isNil ifTrue: [uiLookCUA := true asValue] ifFalse: [uiLookCUA]
uiLookMac "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^uiLookMac isNil ifTrue: [uiLookMac := true asValue] ifFalse: [uiLookMac]
uiLookMotif "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^uiLookMotif isNil ifTrue: [uiLookMotif := true asValue] ifFalse: [uiLookMotif]
uiLookOpenLook "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^uiLookOpenLook isNil ifTrue: [uiLookOpenLook := true asValue] ifFalse: [uiLookOpenLook]
uiLookWindows "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^uiLookWindows isNil ifTrue: [uiLookWindows := true asValue] ifFalse: [uiLookWindows]
useAutoLoader "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^useAutoLoader isNil ifTrue: [useAutoLoader := false asValue] ifFalse: [useAutoLoader]
useRuntimeCompiledMethod "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^useRuntimeCompiledMethod isNil ifTrue: [useRuntimeCompiledMethod := false asValue] ifFalse: [useRuntimeCompiledMethod]
</methods> <methods> RuntimePackager.RuntimeBuilderOptionsEditor <category>actions</category>
browseParcels "Open a browser for parcels" (#{Refactory.Browser.RefactoringBrowser} valueOrDo: [^self]) openParcel
discardParcel "Discard the selected parcel" | parcelClass pname | currentParcel isNil ifTrue: [ ^ self ]. parcelClass := #{Parcel} valueOrDo: [ ^self ]. ( Dialog confirm: 'Really discard the parcel ', currentParcel, ( '?\\This will remove the definition of the parcel from the image\', 'Classes that make up the parcel remain in the image.' ) withCRs ) ifFalse: [ ^self ]. pname := currentParcel. currentParcel := nil. self parcelList selection: nil. self clearParcelEntryFields. parcelClass destroyParcelNamed: pname. parcelOptions removeKey: pname ifAbsent: [ ].
findErrorNotifierClass "Set the error notifier class to a menu choice" | className | className := RuntimeBuilderClassChooser findClassName: 'Find error notifier class:' where: [ :cl | cl respondsTo: #openContext:label:proceedable: ]. className notNil ifTrue: [ self errorNotifierClass value: className asString ].
findImageDumperClass "Set the image dumper class to a menu choice" | className | className := RuntimeBuilderClassChooser findClassName: 'Find image dumper class:' where: [ :cl | cl respondsTo: #dumpSystemImage:context:on: ]. className notNil ifTrue: [ self imageDumperClass value: className asString ].
findPrestripClass "Set the prestrip class to a menu choice" | className | className := RuntimeBuilderClassChooser findClassName: 'Find pre-strip class:'. className notNil ifTrue: [ self prestripClass value: className asString ].
findPrestripMethod "Set the prestrip method to a menu choice" | cl selector | cl := self classNamed: self prestripClass value ifAbsent: [ nil ]. ( cl isNil or: [ cl isBehavior not ] ) ifTrue: [ Dialog warn: 'Pre-strip class is not a valid class name'. ^ self. ]. selector := RuntimeBuilderClassChooser findSelectorUnderstoodBy: cl where: [ :sel | sel numArgs = 0 ]. selector notNil ifTrue: [ self prestripMethod value: selector asString. ].
findStartupClass "Set the startup class to a menu choice." | aClass | aClass := IncrementalSearchDialog selectClass: (#FindStartupClass << #RuntimePackager >>'Find startup class:'). aClass notNil ifTrue: [ self startupClass value: aClass fullName ].
findStartupMethod "Set the startup method to a menu choice" | cl selector | cl := self classNamed: self startupClass value ifAbsent: [ nil ]. ( cl isNil or: [ cl isBehavior not ] ) ifTrue: [ Dialog warn: 'Startup class is not a valid class name'. ^ self. ]. selector := RuntimeBuilderClassChooser findSelectorUnderstoodBy: cl where: [ :sel | sel numArgs = 0 ]. selector notNil ifTrue: [ self startupMethod value: selector asString. ].
newParcel "Add a new parcel to the list" | parcelClass parcelName | " create an empty parcel " parcelClass := #{Parcel} valueOrDo: [ ^self ]. parcelName := Dialog request: 'Enter the name of the new parcel' initialAnswer: String new onCancel: [ ^ self ]. parcelClass createParcelNamed: parcelName.
refresh "Resync with subject. In this case, special handling of parcels is needed to prevent collision with a currently selected parcel" currentParcel := nil. self parcelList selection: nil. ^super refresh
stepHelp "Open a help window" RuntimeBuilderUI helpFor: #helpForOptions.
unloadParcel "Unload the selected parcel" | parcelClass pname | currentParcel isNil ifTrue: [ ^ self ]. parcelClass := #{Parcel} valueOrDo: [ ^self ]. ( Dialog confirm: 'Really unload the parcel ', currentParcel, ( '?\\This will remove both the classes and the definition of the parcel\', 'from the image. Normally parcels that will be dynamically loaded\', 'should not be unloaded prior to the final stripping step.' ) withCRs ) ifFalse: [ ^self ]. pname := currentParcel. currentParcel := nil. self parcelList selection: nil. self clearParcelEntryFields. parcelClass unloadParcelNamed: pname. parcelOptions removeKey: pname ifAbsent: [ ].
</methods> <methods> RuntimePackager.RuntimeBuilderOptionsEditor <category>interface opening</category>
postOpenWith: aBuilder "Initially select the first tab" self tabs selectionIndex: 1
</methods> <methods> RuntimePackager.RuntimeBuilderOptionsEditor <category>initialize-release</category>
initialize "Initialize the instance" super initialize. currentParcel := nil. self tabs list: List new. self tabs list add: 'Basics' -> #basicsSpec; add: 'Details' -> #detailsSpec; add: 'Platforms' -> #platformsSpec; add: 'Exceptions' -> #exceptionsSpec; add: 'Parcels' -> #parcelsSpec; add: 'Stripping' -> #strippingSpec. self tabs selectionIndexHolder onChangeSend: #tabSelectionChanged to: self.
release "Release any long-term dependencies when closing down" self retractParcelInterests.
</methods> <methods> RuntimePackager.RuntimeBuilderOptionsEditor <category>updating</category>
update: anAspect with: aParam from: anObject "watch for changes in other objects" anAspect == #parcels ifTrue: [ self buildParcelList ]. ^super update: anAspect with: aParam from: anObject
</methods> <methods> RuntimePackager.RuntimeBuilderOptionsEditor <category>validations</category>
validate "Validate all fields. Answer true if all validations are passed" self validateStartupClass ifFalse: [ ^false ]. self validateStartupMethod ifFalse: [ ^false ]. self validateHeadlessImage ifFalse: [ ^false ]. self validateLastWindowCloseAction ifFalse: [ ^false ]. self validateErrorNotifierClass ifFalse: [ ^false ]. self validateImageDumperClass ifFalse: [ ^false ]. self validateErrorLogPath ifFalse: [ ^false ]. self validateImagePath ifFalse: [ ^false ]. self validateUILooks ifFalse: [ ^ false ]. self validateOperatingSystems ifFalse: [ ^ false ]. self validateParcels ifFalse: [ ^ false ]. self validatePrestripClass ifFalse: [ ^false ]. self validatePrestripMethod ifFalse: [ ^false ]. ^true
validateCurrentParcel " Check the currently selected parcel entry and true if it is OK" " ignore pacels that are not loadable " | lfs | self parcelIsLoadable value ifFalse: [^true]. self validateCurrentParcelAsParcel ifFalse: [^false]. " check for writability of save file " self parcelPath value = '' ifTrue: [self parcelIsLoadable value & (self stripParcel value | self saveParcel value) ifTrue: [self setTab: #parcelsSpec. (edittingBuilder componentAt: #parcelPath) takeKeyboardFocus. Dialog warn: 'Path is required save the parcel'. ^false] ifFalse: [self setTab: #parcelsSpec. (edittingBuilder componentAt: #parcelPath) takeKeyboardFocus. (self warn: 'Warning: parcel cannot be saved unless a path name is provided' about: #parcelPathMissing) ifTrue: [^false]]]. ( [lfs := RuntimeManager logicalFileSpecFrom: self parcelPath value. lfs notNil and: [lfs asFilename canBeWritten]] on: OSErrorHolder errorSignal do: [:ex | ex return: false]) ifFalse: [self setTab: #parcelsSpec. (edittingBuilder componentAt: #parcelPath) takeKeyboardFocus. Dialog warn: 'Parcel save path name is not writable or is invalid'. ^false]. ^true
validateCurrentParcelAsParcel " Check the currently selected parcel entry and true if it is OK. This check is specialized to the case where the current parcel is really a parcel and not an application." | extraClasses parcel | parcel := Parcel parcelNamed: currentParcel. " Make sure the parcel is still present " parcel isNil ifTrue: [ self setTab: #parcelsSpec. ( edittingBuilder componentAt:#parcelIsLoadable ) takeKeyboardFocus. Dialog warn: 'Selection is no longer defined in this image.'. self parcelIsLoadable value: false. ^false ]. "Check for names spaces defined in the parcel that contain other classes" extraClasses := IdentitySet new. parcel definedNameSpaces do: [ :ns | extraClasses addAll: ns allClasses ]. parcel definedClasses do: [ :cl | extraClasses remove: cl ifAbsent: [ ] ]. extraClasses isEmpty ifFalse: [ self setTab: #parcelsSpec. ( edittingBuilder componentAt: #parcelIsLoadable ) takeKeyboardFocus. ( self warn: ( 'Warning: Parcel defines name space(s) that contain\', 'classes not in the parcel itself. Such classes will be\', 'deleted along with the name space during preparation\', 'of the final runtime image.' ) withCRs about: 'classesInDeletedNameSpaces for ', currentParcel ) ifTrue: [ ^false ] ]. ^true
validateErrorLogPath "Check to see of the error log path is writable. Issue a warning if not. Answer true a the warning was actually issued (supressed after the first time) or if the name is not well formed" | lfs | self errorLogPath value = '' ifTrue: [^true]. ( [lfs := RuntimeManager logicalFileSpecFrom: self errorLogPath value. lfs notNil and: [lfs asFilename canBeWritten]] on: OSErrorHolder errorSignal do: [:ex | ex return: false]) ifFalse: [(self warn: 'Warning: Error log path is not currently writable or is invalid' about: self errorLogPath) ifTrue: [self setTab: #exceptionsSpec. (edittingBuilder componentAt: #errorLogPath) takeKeyboardFocus. ^false]]. ^true
validateErrorNotifierClass "Check that a valid class has been specified" | cl requiredSelector | self errorNotifierClass value = '' ifFalse: [ ( cl := ( self classNamed: self errorNotifierClass value ifAbsent: [ nil ] ) ) isBehavior ifFalse: [ self setTab: #exceptionsSpec. ( edittingBuilder componentAt: #errorNotifierClass ) takeKeyboardFocus. Dialog warn: 'Error notifier class should be a valid class name'. ^false] ifTrue: [ ( cl respondsTo: ( requiredSelector := #openContext:label:proceedable: ) ) ifFalse: [ self setTab: #exceptionsSpec. ( edittingBuilder componentAt: #errorNotifierClass ) takeKeyboardFocus. Dialog warn: 'Error notifier class must respond to ', requiredSelector. ^false] ] ] ifTrue: [ ( self warn: 'Warning: you must supply your own handler for unhandled exceptions.', '\This handler must be in place before the final strip and save step.' withCRs about: self errorNotifierClass ) ifTrue: [ self setTab: #exceptionsSpec. ( edittingBuilder componentAt: #errorNotifierClass ) takeKeyboardFocus. ^ false ] ]. ^true
validateHeadlessImage "Validate the Headless Image feature" self headlessImage value ifFalse: [ ^true ]. #{HeadlessImage} isDefined ifFalse: [ self setTab: #detailsSpec. ( edittingBuilder componentAt: #headlessImage ) takeKeyboardFocus. Dialog warn: 'Class HeadlessImage must be present in the image'. ^false]. ^true
validateImageDumperClass "Check that a valid class has been specified" | cl | self imageDumperClass value = '' ifFalse: [ ( cl := ( self classNamed: self imageDumperClass value ifAbsent: [ nil ] ) ) isBehavior ifFalse: [ self setTab: #exceptionsSpec. ( edittingBuilder componentAt: #imageDumperClass ) takeKeyboardFocus. Dialog warn: 'Image dumper class should be a valid class name'. ^false] ifTrue: [ ( cl respondsTo: #dumpSystemImage:context:on: ) ifFalse: [ self setTab: #exceptionsSpec. ( edittingBuilder componentAt: #imageDumperClass ) takeKeyboardFocus. Dialog warn: ('Image dumper class must respond to the\', '#dumpSystemImage:context:on: selector' ) withCRs. ^false] ] ]. ^true
validateImagePath "Check to see of the image path is writable." | lfs imageName | self imagePath value = '' ifTrue: [self setTab: #basicsSpec. (edittingBuilder componentAt: #imagePath) takeKeyboardFocus. Dialog warn: 'Image path name is required'. ^false]. ( [imageName := self imagePath value, '.im'. lfs := RuntimeManager logicalFileSpecFrom: imageName. lfs notNil and: [lfs asFilename canBeWritten]] on: OSErrorHolder errorSignal do: [:ex | ex return: false]) ifFalse: [self setTab: #basicsSpec. (edittingBuilder componentAt: #imagePath) takeKeyboardFocus. Dialog warn: 'Image path name is not writable or is invalid'. ^false]. ^true
validateLastWindowCloseAction "Check that the last window close action is compatible with other parameters" ( self lastWindowCloseAction value = #shutdown and: [ self headlessImage value = true and: [ self startupClass value = '' ] ] ) ifTrue: [ ( self warn: 'Warning: there is no startup method specified. Specifying shutdown as the last window action in a headless image will cause the image to shut down immediately after image startup processing is completed.' about: self lastWindowCloseAction ) ifTrue: [ self setTab: #detailsSpec. (edittingBuilder componentAt: #shutdown ) takeKeyboardFocus. ^false ] ]. ^true
validateOperatingSystems "Make sure the current operating system is selected" | os table aspect | os := ExternalInterface currentPlatform first. table := #( (#win32 #osWindows ) (#mac #osMac ) (#unix #osUnix ) (#os2 #osOS2 ) ). aspect := ( table select: [ :x | x first == os ] ) first last. ( self perform: aspect ) value ifFalse: [ self setTab: #platformsSpec. ( edittingBuilder componentAt: aspect ) takeKeyboardFocus. Dialog warn: 'The operating system currently in use must be among those selected.'. ^false ]. ^ true
validateParcels "Parcels are handled differently than other fields since their changes are applied immediately to parcel objects rather than being saved up for application when the OK button is pressed. The validation occurs when the list selection changes." currentParcel notNil ifTrue: [ " check that the current selection is valid " self validateCurrentParcel ifFalse: [ self resetParcelSelection. ^false ] ]. ^ true
validatePrestripClass "Check that a valid class has been specified" ( self prestripClass value = '' or: [ ( self classNamed: self prestripClass value ifAbsent: [ nil ] ) isBehavior ] ) ifFalse: [ self setTab: #strippingSpec. ( edittingBuilder componentAt: #prestripClass ) takeKeyboardFocus. Dialog warn: 'Pre-strip Class should be either omitted or be a valid class name'. ^false] ifTrue: [ ^true ]
validatePrestripMethod "Check that a valid method has been specified" | cl sel | " make sure both or neither prestrip class and method are defined" ( self prestripMethod value = '' ) ifFalse: [ self prestripClass value = '' ifTrue: [ self setTab: #strippingSpec. ( edittingBuilder componentAt: #prestripClass ) takeKeyboardFocus. Dialog warn: 'Pre-strip class must be defined for pre-strip method to be used'. ^false ] ] ifTrue: [ self prestripClass value = '' ifTrue: [ ^true ] ifFalse: [ self setTab: #strippingSpec. ( edittingBuilder componentAt: #prestripMethod ) takeKeyboardFocus. Dialog warn: 'Pre-strip method must be defined for pre-strip class to be used'. ^false ] ]. " make sure method takes no args " sel := self prestripMethod value asSymbol. ( sel = #'' or: [ sel numArgs = 0 ] ) ifFalse: [ self setTab: #strippingSpec. ( edittingBuilder componentAt: #prestripMethod ) takeKeyboardFocus. Dialog warn: 'Pre-strip method must not require arguments'. ^false ]. " make sure method really is a class method of prestrip class" cl := self classNamed: self prestripClass value ifAbsent: [ ^true ]. ( cl isBehavior and: [ cl respondsTo: sel ] ) ifFalse: [ self setTab: #strippingSpec. ( edittingBuilder componentAt: #prestripMethod ) takeKeyboardFocus. Dialog warn: 'Pre-strip method is not understood by the pre-strip class'. ^false]. ^true
validateStartupClass "Check that a valid class has been specified" ( self startupClass value = '' or: [ ( self classNamed: self startupClass value ifAbsent: [ nil ] ) isBehavior ] ) ifFalse: [ self setTab: #basicsSpec. ( edittingBuilder componentAt: #startupClass ) takeKeyboardFocus. Dialog warn: 'Startup Class should be either omitted or be a valid class name'. ^false] ifTrue: [ ^true ]
validateStartupMethod "Check that a valid method has been specified" | cl sel | " make sure both or neither startup class and startup method are defined" ( self startupMethod value = '' ) ifFalse: [ self startupClass value = '' ifTrue: [ self setTab: #basicsSpec. ( edittingBuilder componentAt: #startupClass ) takeKeyboardFocus. Dialog warn: 'Startup class must be defined for startup method to be used'. ^false ] ] ifTrue: [ self startupClass value = '' ifTrue: [ ^true ] ifFalse: [ self setTab: #basicsSpec. ( edittingBuilder componentAt: #startupMethod ) takeKeyboardFocus. Dialog warn: 'Startup method must be defined for startup class to be used'. ^false ] ]. " make sure statup method takes no args " sel := self startupMethod value asSymbol. ( sel = #'' or: [ sel numArgs = 0 ] ) ifFalse: [ self setTab: #basicsSpec. ( edittingBuilder componentAt: #startupMethod ) takeKeyboardFocus. Dialog warn: 'Startup method must not require arguments'. ^false ]. " make sure startup method really is a class method of startup class" cl := self classNamed: self startupClass value asSymbol ifAbsent: [ ^true ]. ( cl isBehavior and: [ cl respondsTo: sel ] ) ifFalse: [ self setTab: #basicsSpec. ( edittingBuilder componentAt: #startupMethod ) takeKeyboardFocus. (Object canUnderstand: sel) ifFalse: [ Behavior withAllSubclasses detect: [ :cls | cls canUnderstand: sel ] ifNone: [ Dialog warn: ('Startup method is not implemented \', 'as a class method in any class') withCRs. ^false. ] ]. Dialog warn: 'Startup method is not understood by the startup class'. ^false]. ^true
validateUILooks "Make sure the current UILook is selected" | uiName table aspect uiPair | uiName := UIBuilder defaultPolicyClass name asString. table := #( ('*Win*' #uiLookWindows) ('Mac*' #uiLookMac) ('Motif*' #uiLookMotif) ('OpenLook*' #uiLookOpenLook) ('Default*' #uiLookMotif) ). uiPair := table select: [ :x | x first match: uiName ]. uiPair isEmpty ifFalse: [ aspect := uiPair first last. ( self perform: aspect ) value ifFalse: [ self setTab: #platformsSpec. ( edittingBuilder componentAt: aspect ) takeKeyboardFocus. " Default look uses Motif for some functions " ( aspect == #uiLookMotif and: [ ( 'Motif*' match: uiPair first first ) not ] ) ifTrue: [ ^ (self warn: 'Warning: Motif classes are used by Default Look\\' withCRs, 'Select Motif here and then customize kept\' withCRs, 'classes as needed in the following step' about: self uiLookMotif ) not ]. " Otherwise, the default look should be selected" Dialog warn: 'The current default UI Look must be among those selected.'. ^ false ] ]. ^ true
</methods> <methods> RuntimePackager.RuntimeCompiledMethod <category>Envy</category>
filePointer "There is no file pointer so answer nil" ^nil
filePointer: x "There is no file pointer so ignore this" ^self
hasFilePointer "There is no pointer, so the answer is no" ^false
methodWithSource "There is no source, so answer nil" ^nil
selector "Use who to get the answer since there is no such instance variable" | who | who := self who. ^ who == nil ifTrue: [ self mclass defaultSelectorForMethod: self ] ifFalse: [ who at: 2 ]
selector: x "There is no such instance variable, so ignore this" ^ self
sourceString "There is no source, so answer nil" ^nil
testVisibilityIn: anApp "There is no way to do this, so just ignore it" ^self
</methods> <methods> RuntimePackager.RuntimeCompiledMethod <category>accessing</category>
getSource "Answer the source code for the receiver. Answer nil if this method has no stored source, which is always the case here." ^nil
instVarAt: anInteger "Answer the instance variable, bypassing references to dropped instance variables" | superSize selfSize | superSize := self class superclass instSize. selfSize := self class instSize. ^anInteger <= selfSize ifTrue: [ super instVarAt: anInteger ] ifFalse: [ anInteger <= superSize ifTrue: [ nil ] ifFalse: [ super instVarAt: anInteger + selfSize - superSize ] ]
instVarAt: anInteger put: aValue "Set the instance variable, bypassing references to dropped instance variables" | superSize selfSize | superSize := self class superclass instSize. selfSize := self class instSize. ^anInteger <= selfSize ifTrue: [ super instVarAt: anInteger put: aValue ] ifFalse: [ anInteger <= superSize ifTrue: [ aValue ] ifFalse: [ super instVarAt: anInteger + selfSize - superSize put: aValue ] ]
sourcePointer "There is no source pointer, so answer nil" ^ nil
sourcePointer: x "There is no source pointer, so ignore this" ^ self
storeGeneralStructureOn: aBinaryStorageWriter "This function is not really used in the runtime environment. Just make sure there are no references to missing variables" self error: 'Function not supported for compressed methods'.
</methods> <methods> RuntimePackager.RuntimeCompiledMethod class <category>instance creation</category>
fromMethod: aMethod "Answer a new instance copied from the method supplied" | newCM | newCM := self new: aMethod basicSize. " copy values dropping any not in this type of method " 1 to: aMethod size + aMethod class instSize do: [ :index | newCM instVarAt: index put: (aMethod instVarAt: index ) ]. ^newCM
</methods> <methods> RuntimePackager.RuntimeCompiledMethod class <category>activation</category>
setRuntimeFormat "Change the class format to reflect dropping CompiledMethod's instance variables. This is done during the process of stripping an image for runtime. The following code relies upon mclass being the first instance variable in CompiledMethod." self setInstanceFormat: ( (self format bitAnd: self fixedFieldsMask bitInvert ) bitOr: ( CompiledCode instSize + 1 ) ).
</methods> <methods> RuntimePackager.RuntimeBuilderItemsChooser <category>internals</category>
addClassesInPundle: aPundle "Add the classes in the category or application to selectableClasses definedClasses and globalNames as appropriate. Make sure currently obsolete classes are not selectable." | pundles shareds | pundles := aPundle allContainedItems , (Array with: aPundle). selectedSubapplications addAll: pundles. pundles do: [:subapp | subapp isBundle ifFalse: [selectableClasses addAll: (subapp extendedClassModels collect: [:each | each value]). selectableClasses addAll: (subapp definedClassModels collect: [:each | each value]). definedClasses addAll: (subapp definedClassModels collect: [:each | each value]). shareds := OrderedCollection new. workingCopy addSharedVariablesFor: subapp extendedClassModels into: shareds. workingCopy addSharedVariablesFor: subapp definedClassModels into: shareds. workingCopy addSharedVariablesFor: subapp definedNameSpaceModels into: shareds. workingCopy addSharedVariablesFor: subapp extendedNameSpaceModels into: shareds. subapp nameSpaceModels do: [:each | shareds add: (workingCopy uniqueReferenceFor: each)]. bindingsInCurrentlySelected addAll: shareds]].
addSelector: aSymbol in: aBehavior to: aDict "Add the selector/behavior combination to the dictionary. aDict is typically keptMethods or deletedMethods." ( aDict at: aBehavior ifAbsent: [ aDict at: aBehavior put: Set new ] ) add: aSymbol.
buildClassLists "Set the contents of deleted, kept and contingent class lists based upon currently selected categories. Preserve existing selections as much as possible." | keptSelections contingentSelections deletedSelections | "save existing selections" deletedSelections := self deletedClassesList selections. keptSelections := self keptClassesList selections. contingentSelections := self contingentClassesList selections. " build new lists " self buildSelectableClassList. self deletedClassesList list: ( selectableClassList select: [ :assoc | ( self deletedClasses includes: assoc value ) | ( self deletedGlobals includes: assoc value ) ] ). self contingentClassesList list: ( selectableClassList reject: [ :assoc | | cl | cl := assoc value. ( self keptClasses includes: cl ) | ( self keptGlobals includes: cl ) | ( self deletedClasses includes: cl ) | ( self deletedGlobals includes: cl ) ] ). self keptClassesList list: ( selectableClassList select: [ :assoc | ( self keptClasses includes: assoc value ) | ( self keptGlobals includes: assoc value ) ] ). "restore selections" self setSelections: deletedSelections in: self deletedClassesList. self setSelections: contingentSelections in: self contingentClassesList. self setSelections: keptSelections in: self keptClassesList.
buildMethodLists "Set the contents of deleted, kept, and contingent method lists based upon currently selected classes. Preserve existing method selections as much as possible" | classes keptSelections contingentSelections deletedSelections keptSel contingentSel deletedSel selKey multipleClasses who className metaName | "save existing selections" deletedSelections := self deletedMethodsList selections. contingentSelections := self contingentMethodsList selections. keptSelections := self keptMethodsList selections. " build new lists " " first determine which classes are involved " classes := self selectedClasses. multipleClasses := ( classes size > 1 ). " build up lists of deleted, contingent, and kept selectors" keptSel := List new: 127. contingentSel := List new: classes size * 19. deletedSel := List new: 127. classes do: [ :cl | className := cl name. metaName := cl class name. ( self visibleSelectorsIn: cl ) do: [ :sel | who := Array with: cl with: sel. selKey := self selectorDisplayString: sel in: cl name: className multiple: multipleClasses. ( self isKeptSelector: sel in: cl ) ifTrue: [ keptSel add: selKey -> who ] ifFalse: [ ( self isDeletedSelector: sel in: cl ) ifTrue: [ deletedSel add: selKey -> who ] ifFalse: [ contingentSel add: selKey -> who ] ] ]. ( self visibleSelectorsIn: cl class ) do: [ :sel | who := Array with: cl class with: sel. selKey := self selectorDisplayString: sel in: cl class name: metaName multiple: multipleClasses. ( self isKeptSelector: sel in: cl class ) ifTrue: [ keptSel add: selKey -> who ] ifFalse: [ ( self isDeletedSelector: sel in: cl class ) ifTrue: [ deletedSel add: selKey -> who ] ifFalse: [ contingentSel add: selKey -> who ] ] ] ]. " sort the lists -- save some indirections in the compare " keptSel sortWith: [ :x :y | x key < y key ]. contingentSel sortWith: [ :x :y | x key < y key ]. deletedSel sortWith: [ :x :y | x key < y key ]. " save as new lists " self keptMethodsList list: keptSel. self contingentMethodsList list: contingentSel. self deletedMethodsList list: deletedSel. "restore selections" self setSelectionOnValues: deletedSelections in: self deletedMethodsList. self setSelectionOnValues: contingentSelections in: self contingentMethodsList. self setSelectionOnValues: keptSelections in: self keptMethodsList.
copyValuesFromSubject workingCopy := subject copy.
copyValuesToSubject "Copy values to the subject. If a previous scan for unreferenced items was done reset the results and inform the user." super copyValuesToSubject. self isChanged ifFalse: [ ^self ]. workingCopy ensureValidHierarchy. subject copyFrom: workingCopy. subject hasComputedUnreferencedItems ifTrue: [ subject resetUnreferencedItems. Dialog warn: ( 'Results of the previous scan for\', 'unreferenced items have been discarded.\\', 'The scan for unreferenced items \', 'probably should be done again.' ) withCRs. ]
deleteSelector: aSelector inClass: aClass workingCopy deleteSelector: aSelector inClass: aClass.
displayHierarchyErrorMsg: hierarchyErrors "Display an error message that the intended move would create an invalid hierarchy. hierarchyErrors is a collection of classes in error." | errorMsg | errorMsg := WriteStream on: ( String new: 128). errorMsg nextPutAll: 'The requested move would create an invalid hierarchy'; cr; nextPutAll: 'in which a superclass is deleted while a subclass is kept.'; cr; cr; nextPutAll: 'See the following classes:'. 1 to: (3 min: (hierarchyErrors size) ) do: [ :index | errorMsg cr; nextPutAll: ( hierarchyErrors at: index ) name ]. hierarchyErrors size > 3 ifTrue: [ errorMsg cr; nextPutAll: '... and additional classes'. ]. Dialog warn: errorMsg contents.
displayParcelErrorMsg: errors "Display an error message that the intended move would conflict with parcels. errors contains the classes in error." | errorMsg | errorMsg := WriteStream on: ( String new: 128). errorMsg nextPutAll: 'The requested move would create a conflict with current'; cr; nextPutAll: 'parcel definitions. Classes loaded from parcels are deleted'; cr; nextPutAll: 'from the final runtime image.'; cr; cr; nextPutAll: 'See the following classes:'. 1 to: (3 min: (errors size) ) do: [ :index | errorMsg cr; nextPutAll: ( errors at: index ) name ]. errors size > 3 ifTrue: [ errorMsg cr; nextPutAll: '... and additional classes'. ]. Dialog warn: errorMsg contents.
dontDeleteSelector: aSelector inClass: aClass workingCopy dontDeleteSelector: aSelector inClass: aClass.
dontKeepSelector: aSelector inClass: aClass workingCopy dontKeepSelector: aSelector inClass: aClass.
expressInterests "Setup interests in changed window contents" super expressInterests. self deletedClassesList selectionIndexHolder onChangeSend: #classSelectionChanged to: self. self keptClassesList selectionIndexHolder onChangeSend: #classSelectionChanged to: self. self contingentClassesList selectionIndexHolder onChangeSend: #classSelectionChanged to: self.
keepSelector: aSelector inClass: aClass workingCopy keepSelector: aSelector inClass: aClass.
removeSelector: aSymbol in: aBehavior from: aDict "Remove the selector/behavior combination to the dictionary. aDict is typically keptMethods or deletedMethods." | set | set := aDict at: aBehavior. set remove: aSymbol. set isEmpty ifTrue: [ aDict removeKey: aBehavior ].
removeSelector: aSymbol in: aBehavior from: aDict ifAbsent: aBlock "Remove the selector/behavior combination to the dictionary. aDict is typically keptMethods or deletedMethods." | set | set := aDict at: aBehavior ifAbsent: [^aBlock value]. set remove: aSymbol ifAbsent: []. set isEmpty ifTrue: [ aDict removeKey: aBehavior ].
retractInterests "Retract interests in changed window contents" super retractInterests. self deletedClassesList selectionIndexHolder retractInterestsFor: self. self keptClassesList selectionIndexHolder retractInterestsFor: self. self contingentClassesList selectionIndexHolder retractInterestsFor: self.
selectedClasses "Answer all classes currently selected" | selections selectedClasses | " get all the selections together " ( selections :=OrderedCollection new: 37 ) addAll: self keptClassesList selections; addAll: self contingentClassesList selections; addAll: self deletedClassesList selections. " reject the symbols (ie globals) and just get the classes" selectedClasses := OrderedCollection new: selections size. selections do: [ :assoc | assoc value isBindingReference ifFalse: [ selectedClasses add: assoc value ] ]. ^selectedClasses
selectorDisplayString: sel in: cl name: clName multiple: multiple "Answer a string for displaying the selector in a selection list. sel := a symbol naming the selector cl := a class or metaclass containing the selector clName := name of class or metaclass multiple := a Boolean indicating if the selector potentially appears in multiple classes" | selString str | selString := sel asString. str := WriteStream on: ( selString class new: ( selString size + clName size + 5 ) ). str nextPutAll: selString. multiple ifFalse: [ cl isMeta ifTrue: [ str nextPutAll: ' (class)'. ] ] ifTrue: [ str nextPutAll: ' ('; nextPutAll: clName; nextPut: $). ]. ^str contents
uniqueReferenceFor: aStoreDescriptorOrBinding ^workingCopy uniqueReferenceFor: aStoreDescriptorOrBinding.
updateCategoryTitle "Build the list of all system categories or applications." self categoryListTitle value: ( 'Packages/Bundles (<1p> selected)' expandMacrosWith: self systemPackagesTree selections size) asText allBold.
visibleSelectorsIn: cl "Answer the selectors currently visible by virtue of being controlled by one of the selected applications." ^(RuntimeManager selectorsInClass: cl) select: [:sel | selectedSubapplications includes: (Store.Registry containingPackageForSelector: sel class: cl)]
</methods> <methods> RuntimePackager.RuntimeBuilderItemsChooser <category>menu actions</category>
browseClasses: aListView "Browse the selected classes in the view provided" | anObject assoc | aListView selectionIndexes isEmpty ifTrue: [ ^self ]. aListView selectionIndexes size > 1 ifTrue: [ assoc := self class choose: 'Choose a class' fromList: aListView selections ] ifFalse: [ assoc := aListView selections first ]. assoc isNil ifTrue: [ ^self ]. anObject := assoc value. anObject isBehavior ifTrue: [ RuntimeBuilderUI browseClass: anObject ] ifFalse: [ ( anObject valueOrDo: [ ^self ] ) inspect ].
browseContingentClasses "Browse selected contingent classes" self browseClasses: self contingentClassesList.
browseContingentMethods "Browse selected methods" self browseMethods: self contingentMethodsList
browseDeletedClasses "Browse selected deleted classes" self browseClasses: self deletedClassesList.
browseDeletedMethods "Browse selected methods" self browseMethods: self deletedMethodsList
browseKeptClasses "Browse selected contingent classes" self browseClasses: self keptClassesList.
browseKeptMethods "Browse selected methods" self browseMethods: self keptMethodsList
browseMethods: aListView "Browse the selected methods in the view provided" | methods | aListView selectionIndexes isEmpty ifTrue: [ ^ self ]. methods := aListView selections collect: [ :x | MethodDefinition class: x value first selector: x value last ]. MethodCollector new openListBrowserOn: methods label: 'Methods Browser'.
browseSelectedPundle self systemCategoriesList treeHolder selections do: [:each | Refactory.Browser.RefactoringBrowser open navigator selectPundle: each value].
clearAllContingentClasses "Clear all contingent classes" self contingentClassesList clearAll.
clearAllContingentMethods "Clear all methods" self contingentMethodsList clearAll.
clearAllDeletedClasses "Clear all deleted classes" self deletedClassesList clearAll.
clearAllDeletedMethods "Clear all methods" self deletedMethodsList clearAll.
clearAllKeptClasses "Clear all kept classes" self keptClassesList clearAll.
clearAllKeptMethods "Clear all methods" self keptMethodsList clearAll.
extendedReferenceContingentClasses "Browse references to selected classes" self extendedReferencesTo: self contingentClassesList.
extendedReferenceContingentMethods "Browse references to selected methods" self extendedReferencesToMethods: self contingentMethodsList.
extendedReferenceDeletedClasses "Browse references to selected classes" self extendedReferencesTo: self deletedClassesList.
extendedReferenceDeletedMethods "Browse references to selected methods" self extendedReferencesToMethods: self deletedMethodsList.
extendedReferenceKeptClasses "Browse references to selected classes" self extendedReferencesTo: self keptClassesList.
extendedReferenceKeptMethods "Browse references to selected methods" self extendedReferencesToMethods: self keptMethodsList.
extendedReferencesTo: aListView "Browse class references to the selected classes in the view provided" | sel target | aListView selectionIndexes size = 0 ifTrue: [ ^ self ]. sel := aListView selections first. ( aListView selectionIndexes size ) > 1 ifTrue: [ sel := Dialog choose: 'Choose one' fromList: ( aListView selections collect: [ :x | x key ] ) values: aListView selections lines: 10 cancel: [ ^self ] ]. " See whether a class or global was selected " target := sel value isBehavior ifTrue: [ sel value fullName ] ifFalse: [ sel value asString ]. RuntimeBuilderReferenceBrowser openOn: target withItems: subject.
extendedReferencesToMethods: aListView "Browse class references to the selected methods in the view provided" | sel | aListView selectionIndexes size = 0 ifTrue: [ ^ self ]. sel := aListView selections first. ( aListView selectionIndexes size ) > 1 ifTrue: [ sel := self class choose: 'Choose one' fromList: ( aListView selections ). sel isNil ifTrue: [ ^ self ] ]. RuntimeBuilderReferenceBrowser openOn: sel value last withItems: subject.
implementorsOfContingentMethods "Browse implementors of the selected methods" self implementorsOfMethods: self contingentMethodsList.
implementorsOfDeletedMethods "Browse implementors of the selected methods" self implementorsOfMethods: self deletedMethodsList.
implementorsOfKeptMethods "Browse implementors of the selected methods" self implementorsOfMethods: self keptMethodsList.
implementorsOfMethods: aListView "Browse implementors of the selected methods in the view provided" | sel mc | aListView selectionIndexes isEmpty ifTrue: [^self]. sel := aListView selectionIndexes size > 1 ifTrue: [self class choose: 'Choose selector to browse' fromList: aListView selections] ifFalse: [aListView selections first]. sel isNil ifTrue: [^self]. mc := MethodCollector new. mc browseSelect: (mc implementorsOf: sel value last)
resetAllCategoriesToDefaults "Reset all categories/applications to default values." "Make sure the user meant it" ( Dialog confirm: 'Really reset all packages/bundles to default settings?' ) ifFalse: [ ^ self ]. " do the deed " self resetToDefaults: Store.Registry allPundles. " now rebuild all lists " self systemCategoriesSelectionChanged.
resetSelectedCategoriesToDefaults "Reset the selected category/application to default values leaving other classes and globals as they were." "Make sure the user meant it" ( Dialog confirm: 'Really reset selected packages/bundles to default settings?' ) ifFalse: [ ^ self ]. " do the deed " self resetToDefaults: (self systemCategoriesList treeHolder selections collect: [:each | each value]). " now rebuild all lists " self systemCategoriesSelectionChanged.
resetToDefaults: packages "Reset the packages or bundles to default values leaving other classes and globals as they were." "See which classes are affected and set definedClasses etc." workingCopy resetToDefaults: packages. " remember that we changed things " isChanged := true.
selectAllContingentClasses "Select all contingent classes" self contingentClassesList selectAll.
selectAllContingentMethods "Select all methods" self contingentMethodsList selectAll.
selectAllDeletedClasses "Select all deleted classes" self deletedClassesList selectAll.
selectAllDeletedMethods "Select all methods" self deletedMethodsList selectAll.
selectAllKeptClasses "Select all kept classes" self keptClassesList selectAll.
selectAllKeptMethods "Select all methods" self keptMethodsList selectAll.
selectByCategory: aList widgetName: aSymbol "Select the methods in a given category" | classes categories protocol selections index | classes := self selectedClasses. categories := classes inject: IdentitySet new into: [ :set :cl | set addAll: cl organization categories; addAll: cl class organization categories; yourself ]. protocol := self class choose: 'Select a category' fromList: ( List new addAll: categories; sort; yourself ). protocol isNil ifTrue: [ ^self ]. selections := aList list select: [ :sel | ( sel value first organization categoryOfElement: sel value last ) = protocol ]. selections isEmpty ifFalse: [ index := aList list indexOf: selections first. ( self builder componentAt: aSymbol ) widget makeVisible: index; targetIndex: index. aList selections: selections. ].
selectClassFrom: aListView widgetName: widgetName "Choose one of the selected items in aList and select the class in all categories" | selections selectedClass index selection | selections := aListView selections. selections size = 0 ifTrue: [ ^self ]. selections size = 1 ifTrue: [ selectedClass := selections first value ] ifFalse: [ selection := self class choose: 'Which class should be selected in all packages?' fromList: aListView selections. selection isNil ifTrue: [ ^self ]. selectedClass := selection value. ]. selectedClass isBehavior ifFalse: [ ^self ]. self findCategoryWithGlobal: selectedClass. index := aListView list findFirst: [ :assoc | assoc value = selectedClass] . aListView selectionIndexes: ( Set with: index ). ( self builder componentAt: widgetName ) widget makeVisible: index; targetIndex: index.
selectContingentClass "Choose one of the selected items and select the class in all categories" self selectClassFrom: self contingentClassesList widgetName: #contingentClassesList.
selectContingentMethodsByCategory "Select methods by category" self selectByCategory: self contingentMethodsList widgetName: #contingentMethodsList.
selectDeletedClass "Choose one of the selected items and select the class in all categories" self selectClassFrom: self deletedClassesList widgetName: #deletedClassesList.
selectDeletedMethodsByCategory "Select methods by category" self selectByCategory: self deletedMethodsList widgetName: #deletedMethodsList.
selectKeptClass "Choose one of the selected items and select the class in all categories" self selectClassFrom: self keptClassesList widgetName: #keptClassesList.
selectKeptMethodsByCategory "Select methods by category" self selectByCategory: self keptMethodsList widgetName: #keptMethodsList.
stepHelp "Open a help window" RuntimeBuilderUI helpFor: #helpForItems.
</methods> <methods> RuntimePackager.RuntimeBuilderItemsChooser <category>actions</category>
classSelectionChanged "Respond to a change in selections in classes" Cursor wait showWhile: [ self buildMethodLists. ].
deleteAllInPundle: aPundle workingCopy deleteAllInPundle: aPundle.
deleteSelectedPundle "Move everything in the selected pundle(s) to deleted." self systemPackagesTree selections do: [:each | each withAllContainedItems do: [:eachSubItem | eachSubItem isBundle ifFalse: [self deleteAllInPundle: eachSubItem]]]. self systemCategoriesSelectionChanged. isChanged := true.
findCategoryWithClassOrGlobal: foundItem "Prompt for a class or global and select the category or categories containing it. Answer the item selected or nil if none. Select the item found whichever category it is in." | index | self deletedClassesList clearAll. self contingentClassesList clearAll. self keptClassesList clearAll. ( index := self deletedClassesList list findFirst: [ :x | x value = foundItem ] ) > 0 ifTrue: [ ( self builder componentAt: #deletedClassesList ) widget makeVisible: index; targetIndex: index. self deletedClassesList selectionIndexes: ( Set with: index ). ^foundItem ]. ( index := self contingentClassesList list findFirst: [ :x | x value = foundItem ] ) > 0 ifTrue: [ ( self builder componentAt: #contingentClassesList ) widget makeVisible: index; targetIndex: index. self contingentClassesList selectionIndexes: ( Set with: index ). ^foundItem ]. ( index := self keptClassesList list findFirst: [ :x | x value = foundItem ] ) > 0 ifTrue: [ ( self builder componentAt: #keptClassesList ) widget makeVisible: index; targetIndex: index. self keptClassesList selectionIndexes: ( Set with: index ). ^foundItem ]. "should never occur" ^nil
findCategoryWithGlobal "Prompt for a class and select the category or categories containing it. Answer the class selected or nil if none. Select the class found whichever category it is in." | foundGlobal | ( foundGlobal := super findCategoryWithGlobal ) isNil ifTrue: [ ^ nil ]. ^self findCategoryWithClassOrGlobal: foundGlobal.
keepAllInPundle: aPundle workingCopy keepAllInPundle: aPundle.
keepSelectedPundle "Move everything in the selected pundle(s) to kept" self systemPackagesTree selections do: [:each | each withAllContainedItems do: [:eachSubItem | eachSubItem isBundle ifFalse: [self keepAllInPundle: eachSubItem]]]. self systemCategoriesSelectionChanged. isChanged := true.
makeAllInPundleContingent: aPundle workingCopy makeAllInPundleContingent: aPundle.
makeSelectedPundleContingent "Move everything in the selected pundle(s) to deleted." self systemPackagesTree selections do: [:each | each withAllContainedItems do: [:eachSubItem | eachSubItem isBundle ifFalse: [self makeAllInPundleContingent: eachSubItem]]]. self systemCategoriesSelectionChanged. isChanged := true.
moveClassesContingentToDeleted "Move selected classes from contigent to deleted" | sel hierarchyErrors selectedClassesChanged | self contingentClassesList selectionIndexes isEmpty ifTrue: [ ^ self ]. hierarchyErrors := self validateDeletableClassSelections: ( self contingentClassesList selections ). hierarchyErrors size == 0 ifFalse: [ self displayHierarchyErrorMsg: hierarchyErrors. ^self ]. Cursor wait showWhile: [ self retractInterests. selectedClassesChanged := self deletedClassesList selectionIndexes isEmpty not. sel := self moveClassSelectionsFrom: self contingentClassesList to: self deletedClassesList. selectedClassesChanged ifTrue: [ self buildMethodLists. ]. sel do: [ :assoc | assoc value isBindingReference ifFalse: [ workingCopy deleteClass: assoc value ] ifTrue: [ workingCopy deleteGlobal: assoc value ] ]. isChanged := true. self expressInterests. ].
moveClassesContingentToKept "Move selected classes from contigent to kept" | sel hierarchyErrors selections selectedClassesChanged | self contingentClassesList selectionIndexes isEmpty ifTrue: [ ^ self ]. selections := self contingentClassesList selections. hierarchyErrors := self validateKeptClassSelections: selections. hierarchyErrors size == 0 ifFalse: [ self displayHierarchyErrorMsg: hierarchyErrors. ^self ]. " The following test is obsolete. parcelErrors := self validateKeptClassesWRTParcels: selections. parcelErrors size ==0 ifFalse: [ self displayParcelErrorMsg: parcelErrors. ^self ]. " Cursor wait showWhile: [ self retractInterests. selectedClassesChanged := self keptClassesList selectionIndexes isEmpty not. sel := self moveClassSelectionsFrom: self contingentClassesList to: self keptClassesList. selectedClassesChanged ifTrue: [ self buildMethodLists. ]. sel do: [ :assoc | assoc value isBindingReference ifFalse: [ workingCopy keepClass: assoc value ] ifTrue: [ workingCopy keepGlobal: assoc value ] ]. isChanged := true. self expressInterests. ].
moveClassesDeletedToContingent "Move selected classes from deleted to contingent" | sel selectedClassesChanged | self deletedClassesList selectionIndexes isEmpty ifTrue: [ ^ self ]. Cursor wait showWhile: [ self retractInterests. selectedClassesChanged := self contingentClassesList selectionIndexes isEmpty not. sel := self moveClassSelectionsFrom: self deletedClassesList to: self contingentClassesList. selectedClassesChanged ifTrue: [ self buildMethodLists. ]. sel do: [ :assoc | assoc value isBindingReference ifFalse: [ workingCopy dontDeleteClass: assoc value ] ifTrue: [ workingCopy dontDeleteGlobal: assoc value ] ]. isChanged := true. self expressInterests. ].
moveClassesKeptToContigent "Move selected classes from kept to contingent" | sel selectedClassesChanged | self keptClassesList selectionIndexes isEmpty ifTrue: [ ^ self ]. Cursor wait showWhile: [ self retractInterests. selectedClassesChanged := self contingentClassesList selectionIndexes isEmpty not. sel := self moveClassSelectionsFrom: self keptClassesList to: self contingentClassesList. selectedClassesChanged ifTrue: [ self buildMethodLists. ]. sel do: [ :assoc | assoc value isBindingReference ifFalse: [ workingCopy dontKeepClass: assoc value ] ifTrue: [ workingCopy dontKeepGlobal: assoc value ] ]. isChanged := true. self expressInterests. ].
moveMethodsContingentToDeleted "Move selected methods from contigent to deleted" | sel selections cl | self contingentMethodsList selectionIndexes isEmpty ifTrue: [ ^ self ]. Cursor wait showWhile: [ self retractInterests. selections := self moveSelectionsFrom: self contingentMethodsList to: self deletedMethodsList. selections do: [ :assoc | cl := assoc value first. sel := assoc value last. self deleteSelector: sel inClass: cl]. isChanged := true. self expressInterests. ].
moveMethodsContingentToKept "Move selected methods from contigent to kept" | sel selections cl | self contingentMethodsList selectionIndexes isEmpty ifTrue: [ ^ self ]. Cursor wait showWhile: [ self retractInterests. selections := self moveSelectionsFrom: self contingentMethodsList to: self keptMethodsList. selections do: [ :assoc | cl := assoc value first. sel := assoc value last. self keepSelector: sel inClass: cl ]. isChanged := true. self expressInterests. ].
moveMethodsDeletedToContingent "Move selected methods from deleted to contingent" | sel selections cl | self deletedMethodsList selectionIndexes isEmpty ifTrue: [ ^ self ]. Cursor wait showWhile: [ self retractInterests. selections := self moveSelectionsFrom: self deletedMethodsList to: self contingentMethodsList. selections do: [ :assoc | cl := assoc value first. sel := assoc value last. self dontDeleteSelector: sel inClass: cl]. isChanged := true. self expressInterests. ].
moveMethodsKeptToContingent "Move selected methods from kept to contingent" | sel selections cl | self keptMethodsList selectionIndexes isEmpty ifTrue: [ ^ self ]. Cursor wait showWhile: [ self retractInterests. selections := self moveSelectionsFrom: self keptMethodsList to: self contingentMethodsList. selections do: [ :assoc | cl := assoc value first. sel := assoc value last. self dontKeepSelector: sel inClass: cl. ]. isChanged := true. self expressInterests. ].
selectPrerequisites "Add the prerequisites of the currently selected items to the selections, recursively." | new all next prereqs | new := OrderedCollection new. self systemPackagesTree selections do: [:each | new addAll: each withAllContainedItems]. all := Set new. [new isEmpty] whileFalse: [ next := new removeFirst. all add: next. prereqs := next deploymentPrerequisites collect: [:each | Store.Registry pundleNamed: each first]. new addAll: (prereqs select: [:each | each notNil])]. self systemPackagesTree selections: all. self systemCategoriesSelectionChanged. isChanged := true.
systemCategoriesSelectionChanged "respond to a change in selections among system categories" Cursor wait showWhile: [ self retractInterests. self buildClassLists. self buildMethodLists. self expressInterests. self updateCategoryTitle ].
</methods> <methods> RuntimePackager.RuntimeBuilderItemsChooser <category>aspects</category>
contingentClassesList "Answer the list of contingent classes" ^contingentClassesList isNil ifTrue: [contingentClassesList := MultiSelectionInList new] ifFalse: [contingentClassesList]
contingentMethodsList "Answer the list of contingent method names" ^contingentMethodsList isNil ifTrue: [contingentMethodsList := MultiSelectionInList new] ifFalse: [contingentMethodsList]
deletedClassesList "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^deletedClassesList isNil ifTrue: [deletedClassesList := MultiSelectionInList new] ifFalse: [deletedClassesList]
deletedMethodsList "Answer the list of deleted method names" ^deletedMethodsList isNil ifTrue: [deletedMethodsList := MultiSelectionInList new] ifFalse: [deletedMethodsList]
keptClassesList "Answer the list of kept class names" ^keptClassesList isNil ifTrue: [keptClassesList := MultiSelectionInList new] ifFalse: [keptClassesList]
keptMethodsList "Answer the list of kpet method names" ^keptMethodsList isNil ifTrue: [keptMethodsList := MultiSelectionInList new] ifFalse: [keptMethodsList]
systemCategoriesList "Answer the list of system category (organization) names" ^self systemPackagesTree
</methods> <methods> RuntimePackager.RuntimeBuilderItemsChooser <category>interface opening</category>
postBuildWith: aBuilder trackingChanges: aBoolean "Bypass setting up dependencies to track changes" super postBuildWith: aBuilder trackingChanges: false.
</methods> <methods> RuntimePackager.RuntimeBuilderItemsChooser <category>validations</category>
validateDeletableClasses: classes "Validate that the set of classes provided can be moved to the deleted category without causing an error in which a subclass is kept while its superclass is deleted. Answer an ordered collection of any classes in error. classes can also contain globals. These are not tested " | errors | errors := OrderedCollection new. classes do: [:cl | "watch for globals that could get included here" cl isSymbol ifFalse: [ ( cl withAllSubclasses contains: [ :scl | self keptClasses includes: scl ] ) ifTrue: [ errors add: cl ] ] ]. ^errors
validateDeletableClassSelections: selections "Validate that the class selections as deletable" ^workingCopy validateDeletableClasses: ( self movableClassesFrom: selections )
validateKeptClasses: classes "Validate that the set of classes provided can be moved to the kept category without causing an error in which a subclass is kept while its superclass is deleted. Answeran ordered collection of any class names in error classNames can also contain globals. These are not tested " | errors | errors := OrderedCollection new. classes do: [:cl | "watch for globals that could get included here" cl isSymbol ifFalse: [ ( cl withAllSuperclasses contains: [ :scl | self deletedClasses includes: scl ] ) ifTrue: [ errors add: cl ] ] ]. ^errors
validateKeptClassesWRTParcels: classSelections "Validate that the set of classes provided can be moved to the kept category without conflicting with parcels. This is an approximation since the contents of parcels can change at any time. Answer an ordered collection of any classes in error classes can also contain symbols which are globals. These are not tested " | errors loadables cl | loadables := subject options loadableClasses. loadables isEmpty ifTrue: [ ^OrderedCollection new ]. errors := OrderedCollection new. classSelections do: [:assoc | cl := assoc value. "watch for globals that could get included here" cl isSymbol ifFalse: [ ( cl withAllSuperclasses select: [ :scl | loadables includes: cl ] ) isEmpty ifFalse: [ errors add: cl ] ] ]. ^errors
validateKeptClassSelections: selections "Validate that the class selections as kept" ^self validateKeptClasses: ( self movableClassesFrom: selections )
</methods> <methods> RuntimePackager.RuntimeBuilderItemsChooser <category>accessing</category>
bindingsInCurrentlySelected ^bindingsInCurrentlySelected
bindingsInCurrentlySelected: aSet bindingsInCurrentlySelected := aSet
deletedClasses ^workingCopy deletedClasses
deletedClasses: aCollection workingCopy deletedClasses: aCollection
deletedGlobals ^workingCopy deletedGlobals
deletedGlobals: anObject workingCopy deletedGlobals: anObject
deletedMethods ^workingCopy deletedMethods
deletedMethods: anObject workingCopy deletedMethods: anObject
initializeSystemPackagesTreeWidget systemPackagesTree := TreeSelectionModule forStoreBundlesAndPackages. systemPackagesTree useMultiSelection: true. systemPackagesTree menu: self class systemSelectionMenu performer: self.
keptClasses ^workingCopy keptClasses
keptClasses: aCollection workingCopy keptClasses: aCollection
keptGlobals ^workingCopy keptGlobals
keptGlobals: anObject workingCopy keptGlobals: anObject
keptMethods ^workingCopy keptMethods
keptMethods: anObject workingCopy keptMethods: anObject
systemPackagesTree "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^systemPackagesTree isNil ifTrue: [self initializeSystemPackagesTreeWidget. systemPackagesTree] ifFalse: [systemPackagesTree]
workingCopy ^workingCopy
workingCopy: anObject workingCopy := anObject
</methods> <methods> RuntimePackager.RuntimeBuilderItemsChooser <category>testing</category>
isDeletedSelector: aSymbol in: aBehavior "Answer true if aSymbol names a deleted method in the behavior" ^workingCopy isDeletedSelector: aSymbol in: aBehavior.
isKeptSelector: aSymbol in: aBehavior "Answer true if aSymbol names a kept method in the behavior" ^workingCopy isKeptSelector: aSymbol in: aBehavior.
isPundleSelected ^self systemPackagesTree hasSelection.
</methods> <methods> RuntimePackager.RuntimeBuilderItemsChooser class <category>resources</category>
mainMenu ^self mainMenuVW.
</methods> <methods> RuntimePackager.RuntimeBuilderItemsViewer <category>actions</category>
accept "Because this is read only, accept is the same as cancel" self cancel.
</methods> <methods> RuntimePackager.RuntimeBuilderItemsViewer <category>internals</category>
buildClassLists "Set the contents of deleted, kept and contingent class lists based upon currently selected categories. Preserve existing selections as much as possible." | keptSelections deletedSelections | "save existing selections" deletedSelections := self deletedClassesList selections. keptSelections := self keptClassesList selections. " build new lists " self buildSelectableClassList. self deletedClassesList list: ( selectableClassList select: [ :assoc | ( self deletedClasses includes: assoc value ) | ( self deletedGlobals includes: assoc value ) ] ). self keptClassesList list: ( selectableClassList reject: [ :assoc | ( self deletedClasses includes: assoc value ) | ( self deletedGlobals includes: assoc value ) ] ). "restore selections" self setSelections: deletedSelections in: self deletedClassesList. self setSelections: keptSelections in: self keptClassesList.
buildMethodLists "Set the contents of deleted, kept, and contingent method lists based upon currently selected classes. Preserve existing method selections as much as possible" | classes keptSelections deletedSelections keptSel deletedSel selKey multipleClasses who isDeletedClass className metaName | "save existing selections" deletedSelections := self deletedMethodsList selections. keptSelections := self keptMethodsList selections. " build new lists " " first determine which classes are involved " classes := self selectedClasses. multipleClasses := ( classes size > 1 ). " build up sets of deleted, contingent, and kept selectors" keptSel := List new: 127. deletedSel := List new: 127. classes do: [ :cl | className := cl name. metaName := cl class name. isDeletedClass := self deletedClasses includes: cl. ( self visibleSelectorsIn: cl ) do: [ :sel | who := Array with: cl with: sel. selKey := self selectorDisplayString: sel in: cl name: className multiple: multipleClasses. ( isDeletedClass or: [ self isDeletedSelector: sel in: cl ] ) ifTrue: [ deletedSel add: selKey -> who ] ifFalse: [ keptSel add: selKey -> who ] ]. ( self visibleSelectorsIn: cl class ) do: [ :sel | who := Array with: cl class with: sel. selKey := self selectorDisplayString: sel in: cl class name: metaName multiple: multipleClasses. ( isDeletedClass or: [ self isDeletedSelector: sel in: cl class ] ) ifTrue: [ deletedSel add: selKey -> who ] ifFalse: [ keptSel add: selKey -> who ] ] ]. " sort the lists -- save some indirections in the compare " keptSel sortWith: [ :x :y | x key < y key ]. deletedSel sortWith: [ :x :y | x key < y key ]. " save as new lists " self keptMethodsList list: keptSel. self deletedMethodsList list: deletedSel. "restore selections" self setSelectionOnValues: deletedSelections in: self deletedMethodsList. self setSelectionOnValues: keptSelections in: self keptMethodsList.
changeRequest "Indicate that the window can be closed if the superclass permits" super changeRequest ifFalse: [ ^false ]. subject terminateView. ^true
copyValuesFromSubject "This is a bit weird, because we're really modifying our working copy to display according to our options, but since we know we'll never save it, it doesn't matter." super copyValuesFromSubject. self deletedClasses: (subject allDeletedClassesWithLoadables: ( self showParcelsAs value = #deleted )). self deletedMethods: (subject allDeletedMethodsWithLoadables: ( self showParcelsAs value = #deleted )). subject options stripGlobals ifTrue: [ self deletedGlobals: subject allDeletedGlobals.] ifFalse: [ self deletedGlobals: IdentitySet new ].
copyValuesToSubject "Copy values to the subject. Since this is a read-only view, do nothing" ^self
expressInterests "Setup interests in changed window contents" self systemCategoriesList selectionIndexHolder onChangeSend: #systemCategoriesSelectionChanged to: self. self keptClassesList selectionIndexHolder onChangeSend: #classSelectionChanged to: self. self deletedClassesList selectionIndexHolder onChangeSend: #classSelectionChanged to: self.
retractInterests "Retract interests in changed window contents" self systemCategoriesList selectionIndexHolder retractInterestsFor: self. self keptClassesList selectionIndexHolder retractInterestsFor: self. self deletedClassesList selectionIndexHolder retractInterestsFor: self.
</methods> <methods> RuntimePackager.RuntimeBuilderItemsViewer <category>initialization</category>
initialize "Initialize the instance within the framework" self showParcelsAs value: #kept. super initialize.
</methods> <methods> RuntimePackager.RuntimeBuilderItemsViewer <category>interface opening</category>
postBuildWith: aBuilder trackingChanges: aBoolean " Hook in relationships " super postBuildWith: aBuilder trackingChanges: aBoolean. self showParcelsAs onChangeSend: #refresh to: self.
</methods> <methods> RuntimePackager.RuntimeBuilderItemsViewer <category>aspects</category>
showParcelsAs "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^showParcelsAs isNil ifTrue: [showParcelsAs := nil asValue] ifFalse: [showParcelsAs]
</methods> <methods> RuntimePackager.RuntimeBuilderItemsViewer <category>menu actions</category>
stepHelp "Open a help window" RuntimeBuilderUI helpFor: #helpForReview.
</methods> <methods> RuntimePackager.RuntimeBuilderItemsViewer <category>reporting</category>
generateReport "Write out deleted classes and methods to a file. This is your basic report generation logic with nothing fancy about its design at all." | file out preSort postSort prevCat selDeleted selInDeletedClasses totalSelectors totalClasses keyBlock keyTitle deletedSel loadedParcelCount loadedNameSpaceCount | ( [file := (Dialog request: 'File name to which report should be written' initialAnswer: 'report.txt' onCancel: [^self]) asFilename. file canBeWritten] on: OSErrorHolder errorSignal do: [:ex | ex return: false]) ifFalse: [Dialog warn: 'Report file cannot be written with name supplied'. ^self]. file exists ifTrue: [(Dialog confirm: file asString , ' already exists.\Use it anyway?' withCRs) ifFalse: [^self]]. keyBlock := [:cls | (Store.Registry containingPackageForClass: cls) name]. keyTitle := 'Package'. " show work in progress " Cursor write showWhile: [" open the output file " [out := file writeStream. " write a title for the report " out nextPutAll: 'RUNTIME PACKAGER KEPT AND DELETED CLASSES, METHODS, AND VARIABLES'; cr; nextPutAll: Date today printString; space; nextPutAll: Time now printString; cr. out cr; nextPutAll: 'Classes and methods loaded from parcels are shown as '; nextPutAll: self showParcelsAs value asUppercase; cr. " intialize counters " totalSelectors := 0. totalClasses := 0. " now print each report in category / class name sequence " out cr; nextPutAll: 'DELETED CLASSES BY '; nextPutAll: keyTitle asUppercase. preSort := OrderedCollection new: (self deletedClasses) size. self deletedClasses do: [:cl | preSort add: cl -> (keyBlock value: cl)]. postSort := preSort asSortedCollection: [:x :y | x value < y value or: [x value = y value and: [x key name < y key name]]]. prevCat := nil. selInDeletedClasses := 0. postSort do: [:clAndCat | | cl cat | cl := clAndCat key. cat := clAndCat value. " category break " cat = prevCat ifFalse: [out cr; cr; nextPutAll: cat; nextPutAll: ' deleted classes:'. prevCat := cat]. out cr; space; space; nextPutAll: cl name. selInDeletedClasses := selInDeletedClasses + (RuntimeManager selectorsInClass: cl) size + (RuntimeManager selectorsInClass: cl class) size]. " now print report of deleted selectors in category / class name sequence " out cr; cr; nextPutAll: 'DELETED METHODS BY '; nextPutAll: keyTitle asUppercase; nextPutAll: ' AND CLASS'. preSort := OrderedCollection new. RuntimeManager allClassesDo: [:cl | totalClasses := totalClasses + 1. totalSelectors := totalSelectors + (RuntimeManager selectorsInClass: cl) size + (RuntimeManager selectorsInClass: cl class) size. (self deletedClasses includes: cl) not ifTrue: [preSort add: cl -> (keyBlock value: cl)]]. postSort := preSort asSortedCollection: [:x :y | x value < y value or: [x value = y value and: [x key name < y key name]]]. prevCat := nil. selDeleted := 0. postSort do: [:clAndCat | | cl cat charCount anyDeletedSel | cl := clAndCat key. cat := clAndCat value. "class report including selectors." anyDeletedSel := false. (self deletedMethods at: cl ifAbsent: [#()]) asSortedCollection do: [:sel | anyDeletedSel ifFalse: [" test category break " cat = prevCat ifFalse: [out cr; cr; nextPutAll: cat. prevCat := cat]. " print class name " out cr; cr; space; space; nextPutAll: cl name; nextPutAll: ' deleted methods:'. charCount := 1000. anyDeletedSel := true]. selDeleted := selDeleted + 1. charCount := charCount + sel size + 1. charCount > 60 ifTrue: [out crtab. charCount := sel size + 1]. out nextPutAll: sel; space]. " and now the meta class " anyDeletedSel := false. (self deletedMethods at: cl class ifAbsent: [#()]) asSortedCollection do: [:sel | anyDeletedSel ifFalse: [" test category break " cat = prevCat ifFalse: [out cr; cr; nextPutAll: cat. prevCat := cat]. " print metaclass name" out cr; cr; space; space; nextPutAll: cl class name; nextPutAll: ' deleted methods:'. charCount := 1000. anyDeletedSel := true]. selDeleted := selDeleted + 1. charCount := charCount + sel size + 1. charCount > 60 ifTrue: [out crtab. charCount := sel size + 1]. out nextPutAll: sel; space]]. " now print report of deleted selectors in category / class name sequence " out cr; cr; nextPutAll: 'KEPT METHODS BY '; nextPutAll: keyTitle asUppercase; nextPutAll: ' AND CLASS'. preSort := OrderedCollection new. RuntimeManager allClassesDo: [:cl | (self deletedClasses includes: cl) not ifTrue: [preSort add: cl -> (keyBlock value: cl)]]. postSort := preSort asSortedCollection: [:x :y | x value < y value or: [x value = y value and: [x key name < y key name]]]. prevCat := nil. postSort do: [:clAndCat | | cl cat charCount anyKeptSel | cl := clAndCat key. cat := clAndCat value. "class report including kept selectors." anyKeptSel := false. deletedSel := self deletedMethods at: cl ifAbsent: [#()]. (RuntimeManager selectorsInClass: cl) asSortedCollection do: [:sel | (deletedSel includes: sel) ifFalse: [anyKeptSel ifFalse: [" test category break " cat = prevCat ifFalse: [out cr; cr; nextPutAll: cat. prevCat := cat]. " print class name " out cr; cr; space; space; nextPutAll: cl name; nextPutAll: ' kept methods:'. charCount := 1000. anyKeptSel := true]. charCount := charCount + sel size + 1. charCount > 60 ifTrue: [out crtab. charCount := sel size + 1]. out nextPutAll: sel; space]]. " and now the meta class " anyKeptSel := false. deletedSel := self deletedMethods at: cl class ifAbsent: [#()]. (RuntimeManager selectorsInClass: cl class) asSortedCollection do: [:sel | (deletedSel includes: sel) ifFalse: [anyKeptSel ifFalse: [" test category break " cat = prevCat ifFalse: [out cr; cr; nextPutAll: keyTitle; space; nextPutAll: cat. prevCat := cat]. " print metaclass name" out cr; cr; space; space; nextPutAll: cl class name; nextPutAll: ' kept methods:'. charCount := 1000. anyKeptSel := true]. charCount := charCount + sel size + 1. charCount > 60 ifTrue: [out crtab. charCount := sel size + 1]. out nextPutAll: sel; space]]]. " report on deleted Globals " out cr; cr; nextPutAll: 'DELETED GLOBALS'. self deletedGlobals do: [:global | out crtab; nextPutAll: global asString]. (self deletedGlobals) isEmpty ifTrue: [out crtab; nextPutAll: 'none']. " report on which parcels are loadable " loadedParcelCount := 0. out cr; cr; nextPutAll: 'RUNTIME LOADABLE PARCELS'. subject options loadableParcels do: [:parcel | loadedParcelCount := loadedParcelCount + 1. out crtab; nextPutAll: parcel name]. loadedParcelCount = 0 ifTrue: [out crtab; nextPutAll: 'none']. " report on which name spaces are loadable " loadedNameSpaceCount := 0. out cr; cr; nextPutAll: 'RUNTIME LOADABLE NAME SPACES'. subject options loadableNameSpaces do: [:ns | loadedNameSpaceCount := loadedNameSpaceCount + 1. out crtab; nextPutAll: ns fullName]. loadedNameSpaceCount = 0 ifTrue: [out crtab; nextPutAll: 'none']. " summary information " out cr; cr; nextPutAll: 'SUMMARY STATISTICS'; cr; crtab; nextPutAll: 'Classes entirely deleted: ' , (self deletedClasses) size printString; crtab; nextPutAll: 'Classes kept: ' , (totalClasses - (self deletedClasses) size) printString; crtab; nextPutAll: 'Total classes: ' , totalClasses printString; crtab; nextPutAll: 'Percent of classes deleted: ' , ((self deletedClasses) size * 100 // totalClasses) printString , '%'; cr; crtab; nextPutAll: 'Methods in deleted classes: ' , selInDeletedClasses printString; crtab; nextPutAll: 'Methods separately deleted: ' , selDeleted printString; crtab; nextPutAll: 'Total methods deleted: ' , (selDeleted + selInDeletedClasses) printString; crtab; nextPutAll: 'Methods kept: ' , (totalSelectors - selDeleted - selInDeletedClasses) printString; crtab; nextPutAll: 'Total methods kept and deleted: ' , totalSelectors printString; crtab; nextPutAll: 'Percent of methods deleted: ' , ((selDeleted + selInDeletedClasses) * 100 // totalSelectors) printString , '%'; cr; crtab; nextPutAll: 'Globals deleted: ' , (self deletedGlobals) size printString; crtab; nextPutAll: 'Parcels loaded at runtime: ' , loadedParcelCount printString; crtab; nextPutAll: 'Name spaces loaded at runtime: ' , loadedNameSpaceCount printString " close the output file "] ensure: [out close]]. " end cursor showWhile " " show the file just generated " FileBrowser openOnFileNamed: file asString
</methods> <methods> RuntimePackager.RuntimeQuietEmergencyNotifier <category>testing</category>
isHeadless "Answer true to force all user interface elements to be skipped" ^true
</methods> <methods> RuntimePackager.RuntimeBuilderEditableObject <category>actions</category>
cancel "Terminate any edit in progress" editor notNil ifTrue: [ editor cancel ]. viewer notNil ifTrue: [ viewer cancel ].
edit "Open a window for editting" self editor open.
refresh "Have open views refresh themselves" editor notNil ifTrue: [ editor refresh ]. viewer notNil ifTrue: [ viewer refresh ].
refreshViewer "Have open viewers refresh themselves" viewer notNil ifTrue: [ viewer refresh ].
setDefaults "Set aspects to their default values" self canBeReset ifFalse: [ ( Dialog confirm: 'Reset to default values discarding any previous changes?' ) ifFalse: [ ^self ] ]. self setDefaultValues. hasBeenEdited := false. editor notNil ifTrue: [ editor copyValuesFromSubject; resetChanges ].
setDefaultValues "Set default values for the receiver's aspects. Typically this is overridden in subclasses"
terminateEdit "Cancel the current editor" editor := nil.
terminateView "Cancel the current viewer" viewer := nil.
view "Open a view on the receiver" viewer isNil ifTrue: [ viewer := self viewerClass on: self ]. viewer open.
</methods> <methods> RuntimePackager.RuntimeBuilderEditableObject <category>name spaces</category>
classNamed: aString "Convert the full name provided in aString into a class. Answer nil if not found" ^ self classNamed: aString ifAbsent: [ nil ]
classNamed: aString ifAbsent: aBlock "Convert the full name provided in aString into a class. Answer the value of aBlock if not found" ^aString asString asQualifiedReference valueOrDo: aBlock
</methods> <methods> RuntimePackager.RuntimeBuilderEditableObject <category>accessing</category>
editor "Answer the application model controlling the editor window for changing options" editor isNil ifTrue: [ editor := self editorClass on: self ]. ^editor.
editorClass "Answer the class used to edit the receiver" ^self subclassResponsibility
hasBeenEdited "Answer true if an editor has been open on the receiver" ^hasBeenEdited
hasBeenEdited: aBoolean "Set true if an editor has been open on the receiver" hasBeenEdited := aBoolean.
viewer "Answer the object being used to view the receiver. " ^viewer
viewerClass "Answer the class used to view the receiver. This may be overidden in subclasses if a class other than the editor is used" ^self editorClass
</methods> <methods> RuntimePackager.RuntimeBuilderEditableObject <category>testing</category>
canBeReset "Answer true if values can be reset now" ^self hasBeenEdited not and: [ editor isNil ]
isBeingChanged "Answer true if there is an editor pending with changes" ^ editor notNil and: [ editor isChanged ]
</methods> <methods> RuntimePackager.RuntimeBuilderEditableObject <category>updating</category>
update: aspect with: aParam from: anObject "Note that a change was made to the values in the object" anObject == editor ifTrue: [ hasBeenEdited := true. ]. ^super update: aspect with: aParam from: anObject
</methods> <methods> RuntimePackager.RuntimeBuilderEditableObject <category>initialize-release</category>
initialize "Initialize a new instance" hasBeenEdited := false.
</methods> <methods> RuntimePackager.RuntimeBuilderEditableObject <category>copying</category>
copyFrom: aRuntimeBuilderEditor editor := nil. hasBeenEdited := false.
postCopy "Reset copy to relect its initial state" super postCopy. editor := nil. hasBeenEdited := false.
</methods> <methods> RuntimePackager.RuntimeBuilderEditableObject class <category>instance creation</category>
new "Answer an initialized instance of the receiver" ^super new initialize
</methods> <methods> RuntimePackager.RuntimeBuilderOptions <category>accessing</category>
clearParcelPath ^( strippingOptions includes: #clearParcelPath )
clearParcelPath: aBoolean aBoolean ifTrue: [ strippingOptions add: #clearParcelPath ] ifFalse: [ strippingOptions remove: #clearParcelPath ifAbsent: [] ].
continueOnLastWin ^( strippingOptions includes: #continueOnLastWin )
continueOnLastWin: aBoolean aBoolean ifTrue: [ strippingOptions add: #continueOnLastWin ] ifFalse: [ strippingOptions remove: #continueOnLastWin ifAbsent: [] ].
doThreeSaves ^(strippingOptions includes: #doThreeSaves)
doThreeSaves: aBoolean aBoolean ifTrue: [ strippingOptions add: #doThreeSaves ] ifFalse: [ strippingOptions remove: #doThreeSaves ifAbsent: [] ].
editorClass "Answer the class to edit the receiver" ^RuntimeBuilderOptionsEditor
errorLogPath ^errorLogPath
errorLogPath: aString errorLogPath := aString
errorNotifierClass ^errorNotifierClass
errorNotifierClass: aClass errorNotifierClass := aClass
headlessImage ^(strippingOptions includes: #headlessImage)
headlessImage: aBoolean aBoolean ifTrue: [ strippingOptions add: #headlessImage ] ifFalse: [ strippingOptions remove: #headlessImage ifAbsent: [] ].
imageDumperClass ^imageDumperClass
imageDumperClass: aClass imageDumperClass := aClass
imagePath ^imagePath
imagePath: aString imagePath := aString
mergeByteCodes ^( strippingOptions includes: #mergeByteCodes )
mergeByteCodes: aBoolean aBoolean ifTrue: [ strippingOptions add: #mergeByteCodes ] ifFalse: [ strippingOptions remove: #mergeByteCodes ifAbsent: [] ].
mergeLiterals ^( strippingOptions includes: #mergeLiterals )
mergeLiterals: aBoolean aBoolean ifTrue: [ strippingOptions add: #mergeLiterals ] ifFalse: [ strippingOptions remove: #mergeLiterals ifAbsent: [] ].
mergeMethods "Answer true if equal methods are to be merged in the runtime image" ^( strippingOptions includes: #mergeMethods )
mergeMethods: aBoolean "Add the option for merging methods if aBoolean is true" aBoolean ifTrue: [ strippingOptions add: #mergeMethods ] ifFalse: [ strippingOptions remove: #mergeMethods ifAbsent: [] ].
operatingSystems "Answer the set of operating systems being supported" ^operatingSystems
operatingSystems: aSet "Answer the set of operating systems being supported" operatingSystems := aSet
osMac ^( operatingSystems includes: #mac )
osMac: aBoolean aBoolean ifTrue: [ operatingSystems add: #mac ] ifFalse: [ operatingSystems remove: #mac ifAbsent: [] ].
osOS2 ^( operatingSystems includes: #os2 )
osOS2: aBoolean aBoolean ifTrue: [ operatingSystems add: #os2 ] ifFalse: [ operatingSystems remove: #os2 ifAbsent: [] ].
osUnix ^( operatingSystems includes: #unix )
osUnix: aBoolean aBoolean ifTrue: [ operatingSystems add: #unix ] ifFalse: [ operatingSystems remove: #unix ifAbsent: [] ].
osWindows ^( operatingSystems includes: #win )
osWindows: aBoolean aBoolean ifTrue: [ operatingSystems add: #win ] ifFalse: [ operatingSystems remove: #win ifAbsent: [] ].
packageExternalInterfaces ^( strippingOptions includes: #packageExternalInterfaces )
packageExternalInterfaces: aBoolean aBoolean ifTrue: [ strippingOptions add: #packageExternalInterfaces ] ifFalse: [ strippingOptions remove: #packageExternalInterfaces ifAbsent: [] ].
parcelOptions "Answer dictionary of options by parcel name" ^parcelOptions
parcelOptions: aDict "Set a dictionary of options by parcel name" parcelOptions := aDict.
prestripClass ^prestripClass
prestripClass: aClassOrNil prestripClass := aClassOrNil
prestripMethod ^prestripMethod
prestripMethod: aSymbolOrNil prestripMethod := aSymbolOrNil
removeCompiler ^(strippingOptions includes: #removeCompiler)
removeCompiler: aBoolean aBoolean ifTrue: [ strippingOptions add: #removeCompiler ] ifFalse: [ strippingOptions remove: #removeCompiler ifAbsent: [] ].
removeOrganization ^( strippingOptions includes: #removeOrganization )
removeOrganization: aBoolean aBoolean ifTrue: [ strippingOptions add: #removeOrganization ] ifFalse: [ strippingOptions remove: #removeOrganization ifAbsent: [] ].
shutdownOnLastWin ^( strippingOptions includes: #shutdownOnLastWin )
shutdownOnLastWin: aBoolean aBoolean ifTrue: [ strippingOptions add: #shutdownOnLastWin ] ifFalse: [ strippingOptions remove: #shutdownOnLastWin ifAbsent: [] ].
skipScan ^( strippingOptions includes: #skipScan )
skipScan: aBoolean aBoolean ifTrue: [ strippingOptions add: #skipScan ] ifFalse: [ strippingOptions remove: #skipScan ifAbsent: [] ].
startupClass ^startupClass
startupClass: aClassOrNil startupClass := aClassOrNil
startupMethod ^startupMethod
startupMethod: aSymbolOrNil startupMethod := aSymbolOrNil
stripGlobals ^( strippingOptions includes: #stripGlobals )
stripGlobals: aBoolean aBoolean ifTrue: [ strippingOptions add: #stripGlobals ] ifFalse: [ strippingOptions remove: #stripGlobals ifAbsent: [] ].
strippingOptions "Answer the set of options for stripping the image" ^strippingOptions
strippingOptions: aSet "Answer the set of options for stripping the image" strippingOptions := aSet.
suppressSplashScreen ^( strippingOptions includes: #suppressSplashScreen )
suppressSplashScreen: aBoolean aBoolean ifTrue: [ strippingOptions add: #suppressSplashScreen ] ifFalse: [ strippingOptions remove: #suppressSplashScreen ifAbsent: [] ].
traceLevel "Answer the trace level used during stripping" ^traceLevel
traceLevel: anInteger "Set the trace level used during stripping" traceLevel := anInteger.
uiLookCUA ^(uiLooks includes: #CUA )
uiLookCUA: aBoolean aBoolean ifTrue: [ uiLooks add: #CUA ] ifFalse: [ uiLooks remove: #CUA ifAbsent: [] ].
uiLookMac ^(uiLooks includes: #mac )
uiLookMac: aBoolean aBoolean ifTrue: [ uiLooks add: #mac ] ifFalse: [ uiLooks remove: #mac ifAbsent: [] ].
uiLookMotif ^(uiLooks includes: #motif )
uiLookMotif: aBoolean aBoolean ifTrue: [ uiLooks add: #motif ] ifFalse: [ uiLooks remove: #motif ifAbsent: [] ].
uiLookOpenLook ^(uiLooks includes: #openLook )
uiLookOpenLook: aBoolean aBoolean ifTrue: [ uiLooks add: #openLook ] ifFalse: [ uiLooks remove: #openLook ifAbsent: [] ].
uiLooks "Answer the set of uiLooks being supported" ^uiLooks
uiLooks: aSet "Answer the set of uiLooks being supported" uiLooks := aSet.
uiLookWindows ^(uiLooks includes: #win )
uiLookWindows: aBoolean aBoolean ifTrue: [ uiLooks add: #win ] ifFalse: [ uiLooks remove: #win ifAbsent: [] ].
useAutoLoader ^(strippingOptions includes: #useAutoLoader)
useAutoLoader: aBoolean aBoolean ifTrue: [ strippingOptions add: #useAutoLoader ] ifFalse: [ strippingOptions remove: #useAutoLoader ifAbsent: [] ].
useRuntimeCompiledMethod ^( strippingOptions includes: #useRuntimeCompiledMethod )
useRuntimeCompiledMethod: aBoolean aBoolean ifTrue: [ strippingOptions add: #useRuntimeCompiledMethod ] ifFalse: [ strippingOptions remove: #useRuntimeCompiledMethod ifAbsent: [] ].
</methods> <methods> RuntimePackager.RuntimeBuilderOptions <category>load-save</category>
decodeErrorNotifierClass: val ^self errorNotifierClass: (val == #nil ifTrue: [nil] ifFalse: [self classNamed: val ifAbsent: [Transcript cr; show: ('Error Notifier Class <1p> not found. It was skipped' expandMacrosWith: val). nil]])
decodeFrom: tokens fileVersion: version "Decode the new value from the token array provided" | actionBlocks | " set up blocks to accept input values " actionBlocks := (Dictionary new) add: #packageExternalInterfaces -> [:val | self packageExternalInterfaces: val == #true]; add: #doThreeSaves -> [:val | self doThreeSaves: val == #true]; add: #removeOrganization -> [:val | self removeOrganization: val == #true]; add: #removeCompiler -> [:val | self removeCompiler: val == #true]; add: #shutdownOnLastWin -> [:val | self shutdownOnLastWin: val == #true]; add: #errorLogPath -> [:val | self errorLogPath: val]; add: #errorNotifierClass -> [:val | self decodeErrorNotifierClass: val]; add: #imageDumperClass -> [:val | self decodeImageDumperClass: val]; add: #imagePath -> [:val | self imagePath: val]; add: #startupClass -> [:val | self startupClass: (val == #nil ifTrue: [nil] ifFalse: [self classNamed: val ifAbsent: [Transcript cr; show: ('Startup Class <1p> not found. It was skipped' expandMacrosWith: val). nil]])]; add: #startupMethod -> [:val | self startupMethod: (val == #nil ifTrue: [nil] ifFalse: [val asSymbol])]; add: #prestripClass -> [:val | self prestripClass: (val == #nil ifTrue: [nil] ifFalse: [self classNamed: val ifAbsent: [Transcript cr; show: ('Prestrip Class <1p> not found. It was skipped' expandMacrosWith: val). nil]])]; add: #prestripMethod -> [:val | self prestripMethod: (val == #nil ifTrue: [nil] ifFalse: [val asSymbol])]; add: #parcelOptions -> [:val | | dict pname optVals popts opt | dict := Dictionary new. 1 to: val size by: 2 do: [:idx | pname := val at: idx. optVals := val at: idx + 1. popts := Dictionary new. 1 to: optVals size by: 2 do: [:idx2 | opt := optVals at: idx2 + 1. opt == #true ifTrue: [opt := true]. opt == #false ifTrue: [opt := false]. popts at: (optVals at: idx2) put: opt]. dict at: pname put: popts]. self parcelOptions: dict]; add: #strippingOptions -> [:val | self strippingOptions: val asSet]; add: #operatingSystems -> [:val | self operatingSystems: val asSet]; add: #uiLooks -> [:val | self uiLooks: val asSet]; yourself. " include compatibility for earlier formats " " parameters with non-boolean values " " decode parcel options keyword " " accept new formats for strippingOptions, operating systems, and UI Looks " " assign values using action blocks " 1 to: tokens size by: 2 do: [:index | (actionBlocks includesKey: (tokens at: index)) ifFalse: [Dialog warn: 'Invalid token "' , (tokens at: index) , '" found'] ifTrue: [(actionBlocks at: (tokens at: index)) value: (tokens at: index + 1)]]. " indicate values were changed " self refresh. hasBeenEdited := true. self changed
decodeImageDumperClass: val "Set the class that will write out the system state when an unhandled exception occurs. If val is nil, then the parameters file did not have on specified. If val refers to the old RuntimeImageDumper class, then use the RuntimeFullDumper class instead." | decodedValue | decodedValue := val. decodedValue == #nil ifTrue: [^self imageDumperClass: nil]. decodedValue = 'RuntimePackager.RuntimeImageDumper' ifTrue: [decodedValue := 'RuntimePackager.RuntimeFullDumper']. ^self imageDumperClass: (self classNamed: decodedValue ifAbsent: [Transcript cr; show: (#ImageDumperClassNotFound << #RuntimePackager >> 'Image Dumper Class <1p> not found. It was skipped' expandMacrosWith: val). nil])
encodeOn: aStream tab: tabCount "Encode the receiver onto a stream in a form suitable for decoding as a literal array" aStream crtab: tabCount; nextPutAll: 'errorLogPath '; print: errorLogPath; crtab: tabCount; nextPutAll: 'errorNotifierClass '; print: ( errorNotifierClass isNil ifTrue: [ nil ] ifFalse: [ errorNotifierClass fullName ] ); crtab: tabCount; nextPutAll: 'imageDumperClass '; print: ( imageDumperClass isNil ifTrue: [ nil ] ifFalse: [ imageDumperClass fullName ] ); crtab: tabCount; nextPutAll: 'imagePath '; print: imagePath; crtab: tabCount; nextPutAll: 'startupClass '; print: ( startupClass isNil ifTrue: [ nil ] ifFalse: [ startupClass fullName ] ); crtab: tabCount; nextPutAll: 'startupMethod '; print: ( startupMethod isNil ifTrue: [ nil ] ifFalse: [ startupMethod asString ] ); crtab: tabCount; nextPutAll: 'prestripClass '; print: ( prestripClass isNil ifTrue: [ nil ] ifFalse: [ prestripClass fullName ] ); crtab: tabCount; nextPutAll: 'prestripMethod '; print: ( prestripMethod isNil ifTrue: [ nil ] ifFalse: [ prestripMethod asString ] ) . aStream crtab: tabCount; nextPutAll: 'strippingOptions ('. strippingOptions do: [ :x | aStream crtab: tabCount+1; nextPutAll: x ]. aStream nextPutAll: ' )'. aStream crtab: tabCount; nextPutAll: 'operatingSystems ('. operatingSystems do: [ :x | aStream crtab: tabCount+1; nextPutAll: x ]. aStream nextPutAll: ' )'. aStream crtab: tabCount; nextPutAll: 'uiLooks ('. uiLooks do: [ :x | aStream crtab: tabCount+1; nextPutAll: x ]. aStream nextPutAll: ' )'. aStream crtab: tabCount; nextPutAll: 'parcelOptions ('. parcelOptions keysAndValuesDo: [ :pname :popts | ( popts at: #loadable ifAbsent: [ false ] ) ifTrue: [ aStream crtab: tabCount+1; print: pname; nextPutAll: ' ( '. popts keysAndValuesDo: [ :opt :val | aStream crtab: tabCount+ 2; nextPutAll: opt; space; print: val ]. aStream nextPut: $) ] ]. aStream nextPutAll: ' )'.
</methods> <methods> RuntimePackager.RuntimeBuilderOptions <category>parcels</category>
hasLoadableParcels "Answer true if at least one parcel is loadable into the runtime image" parcelOptions keysAndValuesDo: [ :p :opt | ( opt at: #loadable ifAbsent: [ false ] ) ifTrue:[ ^true ] ]. ^false
hasParcelsToBeSaved "Answer true if at least one parcel is loadable into the runtime image" parcelOptions keysAndValuesDo: [ :p :opt | ( opt at: #saveParcel ifAbsent: [ false ] ) ifTrue:[ ^true ]. ( opt at: #stripParcel ifAbsent: [ false] ) ifTrue: [ ^true ] ]. ^false
loadableApplications "Answer the runtime loadable ENVY/Developer applications not including those representing runtime loadable parcels." ^#().
loadableClasses "Answer all classes that can be dynamically loaded into the image. For now all classes defined in parcels are assumed to be loadable plus those defined in loadable ENVY/Developer applications." | classes | classes := IdentitySet new. self loadableParcels do: [:parcel | classes addAll: parcel definedClasses]. ^classes.
loadableMethods "Answer all methods that can be dynamically loaded into the image. These are the method extensions in parcels and the methods in classes defined in parcels plus those from loadable applications. Answer in the form of a dictionary whose key is the behavior and value is a set of the applicable selectors. The round about access logic is an attempt to live with the Parcel public protocols" | methods selectors | methods := IdentityDictionary new. "First, get the extensions from loadable parcels" self loadableParcels do: [ :parcel | parcel extendedBehaviors do: [ :behav | selectors := methods at: behav ifAbsent: [ Set new ]. ( RuntimeManager selectorsInClass: behav ) do: [ :sel | ( parcel definesSelector: sel forClass: behav ) ifTrue: [ selectors add: sel ] ]. selectors isEmpty ifFalse: [ methods at: behav put: selectors ] ]. " defined and extended classes are assumed to be exclusive " parcel definedClasses do: [ :cl | selectors := methods at: cl ifAbsent: [ Set new ]. selectors addAll: ( RuntimeManager selectorsInClass: cl ). selectors isEmpty ifFalse: [ methods at: cl put: selectors. ]. selectors := methods at: cl class ifAbsent: [ Set new ]. selectors addAll: ( RuntimeManager selectorsInClass: cl class ). selectors isEmpty ifFalse: [ methods at: cl class put: selectors. ] ] ]. ^methods
loadableNameSpaces "Answer name spaces that can be dynamically loaded into the image. All name spaces defined in parcels are assumed to be loadable as are those defined in pragmas in classes defined in loadable applications." | loadableNameSpaces | loadableNameSpaces := IdentitySet new. self loadableParcels do: [ :parcel | loadableNameSpaces addAll: parcel definedNameSpaces ]. ^loadableNameSpaces
loadableParcels "Answer the loadable parcels not including ENVY/Developer applications" | parcels | parcels := IdentitySet new. parcelOptions keysAndValuesDo: [ :pname :popts | ( popts at: #loadable ifAbsent: [ false ] ) ifTrue: [ parcels add: ( Parcel parcelNamed: pname ). ] ]. ^parcels
parcelIsLoadable: parcelName "Answer true if the parcel is loadable per parcelOptions" ^( parcelOptions at: parcelName asString ifAbsent: [ ^false ] ) at: #loadable ifAbsent: [ false ]
parcelNamesToUnload "Answer the names of parcels and applications to be unloaded before the final stripping step." | pnames | pnames := Set new. parcelOptions keysAndValuesDo: [ :parcelName :popts | ( ( popts at: #loadable ifAbsent: [ false ] ) and: [ popts at: #unloadBeforeStrip ifAbsent:[ false ] ] ) ifTrue: [ pnames add: parcelName ] ]. ^pnames
parcelsToUnload "Answer the parcels to be unloaded before the final stripping step." ^self loadableParcels select: [ :parcel | self unloadParcelBeforeStrip: parcel name ]
pathForParcel: parcelName "Answer a string naming the path to which parcelName should be saved" ^ ( parcelOptions at: parcelName asString ) at: #path ifAbsent: [ parcelName, '.pcl' ]
removeNonloadableParcels "Remove parcels that will be loaded at runtime from the parcel options dictionary. Parcels that are not currently defined are treated as not loadable and deleted." parcelOptions copy keysAndValuesDo: [:parcelName :parcelDict | (parcelDict at: #loadable ifAbsent: [false]) not ifTrue: [parcelOptions removeKey: parcelName]].
stripParcel: parcelName "Answer true if the parcel is to save only kept classes and methods" ^( parcelOptions at: parcelName asString ifAbsent: [ ^false ] ) at: #stripParcel ifAbsent: [ false ]
unloadParcelBeforeStrip: parcelName "Answer true if the parcel is unloaded before stripping per parcelOptions" ^( parcelOptions at: parcelName asString ifAbsent: [ ^false ] ) at: #unloadBeforeStrip ifAbsent: [ false ]
</methods> <methods> RuntimePackager.RuntimeBuilderOptions <category>initialization</category>
initialize "Initialize the object" super initialize. strippingOptions := Set new. operatingSystems := Set new. uiLooks := Set new. parcelOptions := Dictionary new.
</methods> <methods> RuntimePackager.RuntimeBuilderOptions <category>actions</category>
setDefaultValues "Set options to their default values" | changedAspects saveOperatingSystems saveUILooks saveRemoveCompiler | " save certain aspects for which changes are of interest " changedAspects := Set new. saveRemoveCompiler := self removeCompiler. saveOperatingSystems := operatingSystems. saveUILooks := uiLooks. " set new values " strippingOptions := Set new. operatingSystems := Set new. uiLooks := Set new. " set canned options " self removeCompiler: false. self shutdownOnLastWin: true. self doThreeSaves: false. self skipScan: false. self clearParcelPath: true. self suppressSplashScreen: true. self useAutoLoader: true. self headlessImage: false. self packageExternalInterfaces: true. self removeOrganization: true. self mergeByteCodes: true. self mergeLiterals: false. self mergeMethods: false. self useRuntimeCompiledMethod: false. self startupClass: nil. self startupMethod: nil. self prestripClass: nil. self prestripMethod: nil. self errorNotifierClass: RuntimeEmergencyNotifier. self imageDumperClass: RuntimeFullDumper. self errorLogPath: 'error.log'. self imagePath: 'runtime'. self traceLevel: 0. self stripGlobals: true. operatingSystems addAll: #(#win #unix #mac). self uiLookWindows: true. self uiLookMac: true. self uiLookMotif: true. " clear parcel options " parcelOptions := Dictionary new. " look at some options that may have been changed " self hasBeenEdited ifTrue: [ saveRemoveCompiler = self removeCompiler ifFalse: [ changedAspects add: #removeCompiler ]. saveOperatingSystems asSortedCollection = operatingSystems asSortedCollection ifFalse: [ changedAspects add: #operatingSystems ]. saveUILooks asSortedCollection = uiLooks asSortedCollection ifFalse: [ changedAspects add: #uiLooks ] ]. " notify interested parties that things have changed. " self changed: #values with: changedAspects.
</methods> <methods> RuntimePackager.RuntimeBuilderReferenceBrowser <category>actions</category>
addTargetFromUser "Prompt for a new target to add.. Keep the cache entry around just in case" | name | name := Dialog request: 'Enter Class, selector, or global to add' initialAnswer: '' onCancel: [ ^ self ]. ( self targetsList list includes: name ) ifFalse: [ self targetsList list add: name. ]. self targetsList selection: name. self targetsSelectionChanged.
browseReference "Browse the current selected reference" | reference methodDef | ( self referencesList selection ) isNil ifTrue: [ ^self ]. reference := self referencesList selection value. " open browser on class " reference isBehavior ifTrue: [ RuntimeBuilderUI browseClass: ( reference isMeta ifTrue: [ reference soleInstance ] ifFalse: [ reference ] ). ^self ]. " open protocol browser on method " ( reference isKindOf: CompiledMethod ) ifTrue: [ methodDef := MethodDefinition class: reference mclass selector: ( reference mclass selectorAtMethod: reference ifAbsent: [ #unknown ] ). MethodCollector new openListBrowserOn: ( Array with: methodDef ) label: 'Method Browser'. ^ self ]. " open inspector on a globals contents " reference isVariableBinding ifTrue: [ reference value inspect. ^ self ]. " open inspector on a variables contents " reference class == Association ifTrue: [ ( reference key classPool includesKey: reference value ) ifTrue: [ ( reference key classPool at: reference value ) inspect. ^ self ] ]. " otherwise just inspect something " reference inspect.
browseReferenceClass "Browse the class of the current selected reference" | reference targetClass | ( self referencesList selection ) isNil ifTrue: [ ^self ]. reference := self referencesList selection value. " open browser on class " reference isBehavior ifTrue: [ targetClass := reference.]. " open browser on method's class " ( reference isKindOf: CompiledMethod ) ifTrue: [ targetClass := reference mclass.]. " open inspector on a global's contents " reference isVariableBinding ifTrue: [ targetClass := reference value class.]. " open browser on the class containing the variable " reference class == Association ifTrue: [ targetClass := reference key ]. targetClass notNil ifTrue: [ RuntimeBuilderUI browseClass: ( targetClass isMeta ifTrue: [ targetClass soleInstance ] ifFalse: [ targetClass ] ). ].
changeRequest "Always allow window close" ^true
filterKeptItemsChanged "Respond to a change in the filter value" self setDeletedItems. self targetsSelectionChanged.
newClassReferences "Add a new target from the current selection in the references list and scan for references to it. If the reference is to a method, add the class rather than the selector. If reference is to a class variable, add the class it is defined in." | reference | ( self referencesList selection ) isNil ifTrue: [ ^self ]. reference := self referencesList selection value. " browse mclass of the method" ( reference isKindOf: CompiledMethod ) ifTrue: [ self addToTargets: ( reference mclass isMeta ifTrue: [ reference mclass soleInstance ] ifFalse: [ reference mclass ] ). ^ self ]. " browse the class owning the class variable " ( reference isKindOf: Association ) ifTrue: [ self addToTargets: ( reference key isMeta ifTrue: [ reference key soleInstance ] ifFalse: [ reference key ] ). ^ self ]. "Otherwise - add the reference itself" self addToTargets: reference.
newReferences "Add a new target from the current selection in the references list and scan for references to it" | reference | ( self referencesList selection ) isNil ifTrue: [ ^self ]. reference := self referencesList selection value. self addToTargets: reference.
referencesSelectionChanged "Respond to changes in the selection on the references list" | reference source str colonIdx binding | ( self referencesList selection ) isNil ifTrue: [ self referenceFoundText value: Text new. ^ self ]. reference := self referencesList selection value. " get source if the reference is to a method" ( reference isKindOf: CompiledMethod ) ifTrue: [ | idx fdx | " get source of the the method" source := reference getSource. source := ( source isNil ifTrue: [ '' ] ifFalse: [ source ] ) asText. " get name and trim after first colon (to find multi-keyword selectors)" str := self searchStringFor: currentTarget. ( colonIdx := str indexOf: $: ) > 0 ifTrue: [ str := str copyFrom: 1 to: colonIdx - 1 ]. " highlight occurrences of the search string" idx := 1. [ idx <= source size ] whileTrue: [ fdx := source findString: str startingAt: idx. fdx = 0 ifTrue: [ idx := source size + 1 ] ifFalse: [ source emphasizeFrom: fdx to: fdx + str size - 1 with: #bold. idx := fdx + str size ] ]. self referenceFoundText value: source. ^ self ]. " print out a definition if this is a class " reference isBehavior ifTrue: [ self referenceFoundText value: reference definition. ^ self ]. " print value if this is a class variable reference" reference class == Association ifTrue: [ binding := reference key classPool bindingFor: reference value. self referenceFoundText value: ( binding notNil ifTrue: [ reference key definitionOfStatic: binding ] ifFalse: [ 'Not found in class' ] ). ^ self ]. " print out the current value of a global " reference isVariableBinding ifTrue: [ self referenceFoundText value: reference value printString. ^self ]. " othewise just put out the display string for the referenced object" self referenceFoundText value: reference printString.
removeTarget "Remove the select entry from the list displayed. Keep the cache entry around just in case" | index list | index := self targetsList selectionIndex. index = 0 ifTrue: [ ^ self ]. list := self targetsList list. self targetsList list: ( list copyFrom: 1 to: index - 1 ), ( list copyFrom: index + 1 to: list size ). self referencesSelectionChanged.
sortTargets "Sort the list of targets by name" | selection list | selection := self targetsList selection. list := self targetsList list. list sort. self targetsList list: list. self targetsList selection: selection.
targetsSelectionChanged "The targets selection has changed. Find the new references" | list references referenceElements who | " get references to the currently selected target " self targetsList selection isNil ifTrue: [ self referencesList list: (List new). ^ self ]. currentTarget := self targetsList selection. references := self referencesTo: currentTarget. references isNil ifTrue: [ self referencesList list: (List new). ^ self ]. " select references that are not being deleted " referenceElements := OrderedCollection new. references do: [ :x | x isBehavior ifTrue: [ ( deletedClasses includes: x ) ifFalse: [ referenceElements add: x ] ]. x isVariableBinding ifTrue: [ ( deletedGlobals includes: x binding ) ifFalse: [ referenceElements add: x binding ] ]. x class == Association ifTrue: [ ( deletedClasses includes: x key ) ifFalse: [ referenceElements add: x ] ]. ( x isKindOf: CompiledMethod ) ifTrue: [ ( ( ( who := x who ) notNil and: [ ( deletedMethods at: who first ifAbsent: [ #( ) ] ) includes: who last ] ) or: [ deletedClasses includes: ( x mclass isMeta ifTrue: [ x mclass soleInstance ] ifFalse: [ x mclass ] ) ] ) ifFalse: [ referenceElements add: x ] ] ]. list := List new: referenceElements size. referenceElements do:[ :x | list add: (self nameFor: x ) -> x. ]. list sortWith: [ :x :y | x key < y key ]. self referencesList list: list.
</methods> <methods> RuntimePackager.RuntimeBuilderReferenceBrowser <category>internals</category>
addToTargets: reference "Add a new item to the targets list" | referenceName | referenceName := self referenceStringFor: reference. ( self targetsList list includes: referenceName ) ifFalse: [ self retractInterests. self targetsList list add: referenceName; changed. self expressInterests. ]. self targetsList selection: referenceName.
array: anArray references: targets ignoring: aCollection "Answer true if any element of the array references any of the targets" anArray do: [ :element | " is the element one of the targets " ( targets includes: element ) ifTrue: [ ^true ]. " is the element a binding reference to a target " element isBindingReference ifTrue: [ ( ( targets includes: element simpleName ) and: [ targets includes: ( element valueOrDo: [ nil ] ) ] ) ifTrue: [ ^true ] ]. " recursively descend an array" element class == Array ifTrue: [ ( aCollection includes: element ) ifFalse: [ aCollection add: element. ^self array: element references: targets ignoring: aCollection ] ] ]. ^ false
clearCache "empty the cache of references found" referencesCache := Dictionary new.
expressInterests "Setup interests in changed window contents" self targetsList selectionIndexHolder onChangeSend: #targetsSelectionChanged to: self. self referencesList selectionIndexHolder onChangeSend: #referencesSelectionChanged to: self. self keptItemsFilter onChangeSend: #filterKeptItemsChanged to: self.
method: aMethod references: targets special: specialSelectorIndex "Answer whether the method references any of the target items" aMethod withAllBlockMethods do: [ :block | block literals do: [ :lit | " is a target directly referenced. references to the defining class do not count" ( ( targets includes: lit ) and: [ lit ~~ aMethod mclass ] ) ifTrue: [ ^ true ]. " use a short cut for associations (if any are still used) " lit class == Association ifTrue: [ ( ( targets includes: lit key ) or: [ targets includes: lit value ] ) ifTrue: [ ^true ] ]. " for variable bingings, look at the value of the binding" lit isVariableBinding ifTrue: [ ( targets includes: lit value ) ifTrue: [ ^true ] ]. " for binding references, see if how they resolve" lit isBindingReference ifTrue: [ ( ( targets includes: lit simpleName ) and: [ targets includes: ( lit valueOrDo: [ nil ] ) ] ) ifTrue: [ ^true ] ]. " decompose an array and look for internal references " lit class == Array ifTrue: [ ( self array: lit references: targets ignoring: IdentitySet new ) ifTrue: [ ^ true ] ] ] ]. " special selectors are known only by number in the method" specialSelectorIndex = 0 ifFalse: [ ( aMethod sendsSpecialSelector: specialSelectorIndex ) ifTrue: [ ^ true ] ]. " otherwise there is no reference " ^false
nameFor: x "Answer the name for displaying in the target or references list" " format a method reference " ( x isKindOf: CompiledMethod ) ifTrue: [ ^x mclass fullName, '>>', ( x mclass selectorAtMethod: x ifAbsent: [ 'unboundMethod' ] ) ]. " format a class reference " x isBehavior ifTrue: [ ^x fullName ]. " format a class variable reference " x class == Association ifTrue: [ ^x printString ]. " format a global name " x isVariableBinding ifTrue: [ ^ x key ]. "otherwise error" self error: 'Should not occur'.
referencesTo: aString "Answer the references to what is named by aString, which can be a global, a class name, or a selector" | notifier resp foundReferences | foundReferences := referencesCache at: aString ifAbsent: [ nil ]. foundReferences notNil ifTrue: [ ^foundReferences ]. [ [ notifier := RuntimeProgressNotifier open. notifier log: 'Scanning for references to ', aString. foundReferences := self referencesTo: aString notifying: notifier. referencesCache at: aString put: foundReferences. ] ensure: [ notifier close ] ] on: UserInterrupt do: [ :ex | resp := Dialog choose: 'Terminate scan for references?' labels: #( 'Yes' 'No' 'Debug' ) values: #( true false nil ) default: true. resp = true ifTrue: [ ^nil ]. resp = false ifTrue: [ notifier raise. ex proceed. ]. ex pass. ]. ^foundReferences
referencesTo: aStringOrSymbol notifying: aNotifier "Answer the references to the symbol, which can be a global, a class name, or a selector. " | references targets specialSelector targetClass aClassOrGlobalBinding | references := OrderedCollection new. specialSelector := 0. " See if aStringOrSymbol can be a class or global reference. Watch out for ill formed names which result in an error whether you want them to or not" ( aStringOrSymbol isSymbol or: [ aStringOrSymbol contains: [ :ch | ch = $: ] ] ) ifTrue: [ aClassOrGlobalBinding := nil ] ifFalse: [ aClassOrGlobalBinding := aStringOrSymbol asQualifiedReference bindingOrNil. ]. " figure out what targets could be named by aString " targets := OrderedCollection new: 7. targets add: aStringOrSymbol. targetClass := nil. aClassOrGlobalBinding notNil ifTrue: [ aClassOrGlobalBinding isForClass ifTrue: [ targetClass := aClassOrGlobalBinding value. targets add: targetClass; add: aClassOrGlobalBinding; add: targetClass fullName asSymbol; add: targetClass name asSymbol. ] ifFalse: [ " look for references to global by name " targets add: aClassOrGlobalBinding; add: aClassOrGlobalBinding key. ] ] ifFalse: [ | numArgs sym | " treat aString as a selector, also add any related accessors" sym := aStringOrSymbol asSymbol. targets add: aStringOrSymbol; add: sym. numArgs := aStringOrSymbol occurrencesOf: $: . numArgs = 0 ifTrue: [ | str | str := aStringOrSymbol, ':'. targets add: str ; add: str asSymbol . ]. numArgs = 1 ifTrue: [ | str | str := aStringOrSymbol copyWithout: $:. targets add: str; add: str asSymbol. ]. specialSelector := CompiledCode specialSelectorIndexFor: sym ]. targets := targets asSet asOrderedCollection. " check each class for a reference " aNotifier log: 'Scanning classes for references'. aNotifier tickRate: Smalltalk allClasses size // 50. RuntimeManager allClassesDo: [ :cl | aNotifier tick. " check for references via class imports " aClassOrGlobalBinding notNil ifTrue: [ ( cl importDefinitions contains: [ :ref | ref bindingOrNil = aClassOrGlobalBinding ] ) ifTrue: [ references add: cl ] ]. targetClass notNil ifTrue: [ " check for reference via subclass " ( cl inheritsFrom: targetClass ) ifTrue: [ references add: cl ]. " check for references via class variables " cl classPool keysAndValuesDo: [ :key :value | ( targetClass == value or: [ value isKindOf: targetClass ] ) ifTrue: [ references add: cl -> key ] ifFalse: [ ( value class == ValueHolder and: [ targetClass == value value or: [ value value isKindOf: targetClass ] ] ) ifTrue: [ references add: cl -> key ] ] ] ]. " check for reference via methods " ( RuntimeManager selectorsInClass: cl ) do: [ :sel | | meth | meth := cl compiledMethodAt: sel. ( self method: meth references: targets special: specialSelector) ifTrue: [ references add: meth ] ]. ( RuntimeManager selectorsInClass: cl class ) do: [ :sel | | meth | meth := cl class compiledMethodAt: sel. ( self method: meth references: targets special: specialSelector ) ifTrue: [ references add: meth ] ] ]. "Look for references to classes via globals" targetClass notNil ifTrue: [ aNotifier log: 'Scanning for references via globals'. ( RuntimeManager allNameSpacesFrom: Root ) do: [ :ns | ns bindingsDo: [ :binding | binding isForGeneral ifTrue: [ ( binding value class == targetClass or: [ binding value class inheritsFrom: targetClass ] ) ifTrue: [ references add: binding ] ] ] ] ]. ^ references
referenceStringFor: x "Answer the name for searching for references to the object provided" ^ x isBehavior ifTrue: [ ( x isMeta ifTrue: [ x soleInstance ] ifFalse: [ x ] ) fullName ] ifFalse: [ self searchStringFor: x ]
retractInterests "Retract interests in changed window contents" self targetsList selectionIndexHolder retractInterestsFor: self. self referencesList selectionIndexHolder retractInterestsFor: self. self keptItemsFilter retractInterestsFor: self.
searchStringFor: x "Answer the name for searching for the object provided" | lastPeriod | " check for a class " x isBehavior ifTrue: [ ^x name ]. " check for a class variable reference " x class == Association ifTrue: [ ^ x value ]. " check for a global reference " x isVariableBinding ifTrue: [ ^x key ]. " check for selector name " x isSymbol ifTrue: [ ^x asString ]. " check for method " ( x isKindOf: CompiledMethod ) ifTrue: [ ^x mclass selectorAtMethod: x ifAbsent: [ ^ #unknown ] ]. " for a string, extract the last part of a string as a qualified reference" ( x isKindOf: String ) ifTrue: [ lastPeriod := x lastIndexOf: $. ifAbsent: [ 0 ]. ^ lastPeriod > 0 ifTrue: [ x copyFrom: lastPeriod + 1 to: x size ] ifFalse: [ x ] ]. " otherwise, convert x to a string if possible (shoud not occur) " ^x asString
setDeletedItems "set the collections of deleted items based on the current kept items" ( self keptItemsFilter value and: [ keptItems notNil ] ) ifTrue: [ deletedClasses := keptItems allDeletedClassesWithLoadables: false. deletedGlobals := IdentitySet withAll: ( keptItems allDeletedGlobals collect: [ :x | x bindingOrNil ] ). deletedMethods := keptItems allDeletedMethodsWithLoadables: false. ] ifFalse: [ deletedClasses := IdentitySet new. deletedGlobals := IdentitySet new. deletedMethods := IdentityDictionary new. ].
</methods> <methods> RuntimePackager.RuntimeBuilderReferenceBrowser <category>accessing</category>
currentTarget ^currentTarget
currentTarget: aSymbolClassOrBinding currentTarget := aSymbolClassOrBinding
keptItems "Answer the kept items object or nil, if none" ^keptItems
keptItems: items "Set the kept items object or nil, if none" keptItems := items
</methods> <methods> RuntimePackager.RuntimeBuilderReferenceBrowser <category>initialization</category>
initialize "Set the initial values" self keptItemsFilter value: true. self clearCache. self setDeletedItems.
</methods> <methods> RuntimePackager.RuntimeBuilderReferenceBrowser <category>aspects</category>
keptItemsFilter "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^keptItemsFilter isNil ifTrue: [keptItemsFilter := false asValue] ifFalse: [keptItemsFilter]
referenceFoundText "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^referenceFoundText isNil ifTrue: [referenceFoundText := String new asValue] ifFalse: [referenceFoundText]
referencesList "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^referencesList isNil ifTrue: [referencesList := SelectionInList new] ifFalse: [referencesList]
targetsList "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^targetsList isNil ifTrue: [targetsList := SelectionInList new] ifFalse: [targetsList]
</methods> <methods> RuntimePackager.RuntimeBuilderReferenceBrowser <category>interface opening</category>
postOpenWith: aBuilder "Initialize for opening the window" super postBuildWith: aBuilder. self targetsList list: ( List with: currentTarget ). self targetsList selectionIndex: 1. self targetsSelectionChanged. self expressInterests.
</methods> <methods> RuntimePackager.RuntimeBuilderReferenceBrowser class <category>interface opening</category>
openOn: aSymbol "Open on the target provided. This can be a global name, a class name, or a selector" "RuntimeBuilderReferenceBrowser openOn: #RuntimeManager" "RuntimeBuilderReferenceBrowser openOn: #Win3LookPolicy" "RuntimeBuilderReferenceBrowser openOn: #ScheduledControllers" "RuntimeBuilderReferenceBrowser openOn: #ControlManager" ^self openOn: aSymbol withItems: nil.
openOn: aSymbol withItems: items "Open on the target provided. This can be a global name, a class name, or a selector" "RuntimeBuilderReferenceBrowser openOn: #RuntimeManager" "RuntimeBuilderReferenceBrowser openOn: #Win3LookPolicy" "RuntimeBuilderReferenceBrowser openOn: #ScheduledControllers" "RuntimeBuilderReferenceBrowser openOn: #ControlManager" | inst | inst := self new. inst currentTarget: aSymbol. inst keptItems:items. inst setDeletedItems. inst open. ^inst
</methods> <methods> RuntimePackager.RuntimeManagerStripper class <category>stripping</category>
createFinalImage "Create the final image before the save. RuntimeManager dependents are notified of events through changed messages." | notifier tickRatePerClass | notifier := RuntimeProgressNotifier open. notifier log: 'Creating final runtime image'. RuntimeManager changed: #aboutToStripImage. "Suppress the splash screen and herald if desired" DeploymentOptionsSystem suppressSplashScreenAndHerald: (StrippingOptions includes: #suppressSplashScreen). "Supress the ability to raise the EmergencyEvaluator" self suppressEmergencyEvaluator: notifier. "do preliminary operations that do not need to be seen as referenced." self createFinalImageHiddenLogic: notifier. " remove unreferenced items and force a relinkSystem when done " SystemUtils modifySystem: [ self discardUnreferencedMethodsClassesAndGlobals: notifier. self discardLoadableNameSpaces: notifier. notifier log: 'Linking System'. ]. notifier log: 'Cleaning up DeferredBindings'. self cleanUpDeferredBindings. " finish stripping the image " tickRatePerClass := Smalltalk allClasses size // 50. ( StrippingOptions includes: #mergeLiterals ) ifTrue: [ notifier tickRate: tickRatePerClass. self mergeLiterals: notifier ]. ( StrippingOptions includes: #mergeByteCodes ) ifTrue: [ notifier tickRate: tickRatePerClass. self mergeByteCodeStrings: notifier. ]. ( StrippingOptions includes: #mergeMethods ) ifTrue: [ notifier tickRate: tickRatePerClass. self mergeMethods: notifier. ]. ( StrippingOptions includes: #useRuntimeCompiledMethod ) ifTrue: [ notifier tickRate: tickRatePerClass. self installCompactMethods: notifier. ]. " garbage collection more time " notifier log: 'Global garbage collect again'. ObjectMemory globalGarbageCollect. " rebuild the dictionary of symbols " notifier log: 'Rehashing symbol table'. Symbol rehash. " that's all follks " notifier log: 'Done'. notifier close. RuntimeManager changed: #imageStrippingComplete. ^true
createFinalImageHiddenLogic: notifier "Perform the steps needed to create the final image that should not be seen in the scan for referenced classes and methods. Answer true if successful." " expand the filename for the target image file" ImagePath := self expandedStringFrom: ImagePath. " keep this class and its superclasses (just in case) " self withAllSuperclasses do: [ :cl | DeletedClasses remove: cl ifAbsent: [] ]. " remove the definitions of loadable parcels " self destroyLoadableParcels: notifier. " package external interface classes - do first in case of failure " ( StrippingOptions includes: #packageExternalInterfaces ) ifTrue: [ ( self packageExternalInterfaceSubclasses: notifier ) ifFalse: [ ^ false ] ]. "Install the emergency error handler" notifier log: 'Installing emergency error handler'. RuntimeManager changed: #aboutToInstallEmergencyErrorHandler. ErrorNotifierClass notNil ifTrue: [ self hookNotifierClass: ErrorNotifierClass ]. self discardSourcesFromFinalImage: notifier. self emptyChangeSetsInFinalImage: notifier. self doMiscellaneousCleanupsInFinalImage: notifier. self replaceDoItMenusInFinalImage: notifier. ( StrippingOptions includes: #removeOrganization ) ifTrue: [ self discardSystemAndClassOrganizations: notifier. ]. " garbage collect before removing methods etc." notifier log: 'Global garbage collect (please wait)'. ObjectMemory globalGarbageCollect. "Set spaces for runtime image startup" self setSpaceSizesInFinalImage: notifier. ^true
destroyLoadableParcels: notifier "Destroy the definitions of loadable parcels so that there are no conflicts when the parcels are later reloaded. Unload parcels that are to be unloaded and unload applications that will be represented as parcels." | | notifier log: 'Removing the definitions of loadable parcels'. RuntimeManager changed: #destroyingLoadableParcels. "Destroy parcels that are known to be loadable. Classes will be removed later." LoadableParcels do: [ :parcel | ( ParcelsToUnload includes: parcel ) ifFalse: [ Parcel destroyParcelNamed: parcel name ] ]. "Unload remaining parcels that are to be unloaded" ( SystemUtils sortForLoading: ParcelsToUnload ) reverseDo: [ :parcel | Parcel unloadParcelNamed: parcel name. "This way hooks with ED 5i" ]. "Remove any dangling references" LoadableParcels := nil. ParcelsToUnload := nil.
discardLoadableNameSpaces: notifier "Discard name spaces that are loaded via parcels " | sortedNS | RuntimeManager changed: #aboutToDeleteLoadableNameSpaces. " Delete names spaces that are loaded via parcels " LoadableNameSpaces isEmpty ifFalse: [ notifier log: ' Deleting loadable Name Spaces'. " put the name spaces in an arbitrary but predictable order" sortedNS := LoadableNameSpaces asSortedCollection: [ :x :y | x name < y name ]. sortedNS do: [ :ns | ns isObsolete ifFalse: [ self traceLevel >= 2 ifTrue: [ notifier cr; show: 'Removing namespace ', ns name. ]. ns quietlyRemoveFromSystem. ] ] ]. " Make really sure extraneous references are gone " LoadableNameSpaces := nil.
discardSourcesFromFinalImage: notifier "Discard sources to prevent access to sources and changes files in the runtime image. Be sure to tell the DevelopmentSystem that it can not be activated, otherwise it will try to re-install the changes file when the system is starting up." | cl | ( cl := RuntimeManager hiddenReferenceTo: 'SourceFileManager' ) notNil ifTrue: [ notifier log: (#DisconnectingSourcesAndChanges << #RuntimePackager >> 'Disconnecting sources and changes files from this image') asString. RuntimeManager changed: #aboutToDiscardSources. cl default removeAllSources. DevelopmentSystem canActivate: false].
discardSystemAndClassOrganizations: notifier " discard system organizer, class organizers, and misc info" | exceptionClasses | notifier log: 'Deleting system and class organizations'. RuntimeManager changed: #aboutToDiscardOrganizations. ( RuntimeManager allNameSpacesFrom: Root ) do: [ :ns | ns organization: ns organization class new. ]. " save a collection of exceptions consisting of classes that use organization information at runtime" exceptionClasses := IdentitySet new. exceptionClasses add: CIntegerType. "see CIntegerType class>>initializeSelectors" " empty organizations. setting to nil trips up ClassDescription>>whichCategoryIncludesSelector: in VW5i.0" RuntimeManager allClassesDo: [ :cl | ( exceptionClasses includes: cl ) ifFalse: [ cl instVarAt: self organizationIndex put: cl organization class new. cl class instVarAt: self organizationIndex put: cl class organization class new. ] ].
discardUnreferencedMethodsClassesAndGlobals: notifier " discard unreferenced classes, methods and globals " | replacements specialCompilerClasses traceClassRemovals traceMethodRemovals traceCount | notifier log: 'Deleting unreferenced items'. RuntimeManager changed: #aboutToDeleteUnreferencedItems. " discard unreferenced classes " notifier tickRate: DeletedClasses size // 50. " check the TraceLevel " traceClassRemovals := false. traceMethodRemovals := false. self traceLevel >= 2 ifTrue: [ traceClassRemovals := true. ]. self traceLevel >= 4 ifTrue: [ traceMethodRemovals := true. ]. "Special compiler classes are not removed removed from their name space to allow deleted behaviors to remain behind with just enough behavior." specialCompilerClasses := IdentitySet new. ( StrippingOptions includes: #removeCompiler ) ifTrue: [ specialCompilerClasses add: ( self hiddenReferenceTo: 'SmalltalkCompiler' ). specialCompilerClasses add: ( self hiddenReferenceTo: 'Compiler' ). specialCompilerClasses add: ( self hiddenReferenceTo: 'Scanner' ). specialCompilerClasses add: ( self hiddenReferenceTo: 'Parser' ). ]. "sort the deleted classes bottom up in the hierarchy" notifier log: ' Deleting classes part 1'. "Always, always keep method dictionaries" MethodDictionary withAllSubclasses do: [ : cl | DeletedClasses remove: cl ifAbsent: [] ]. replacements := self prepareClassesForDeletionIn: notifier. " remove classes from the System Dictionary and make them obsolete " notifier log: ' Deleting classes part 2'. self purgeDependents: AllDeletedBehaviors. replacements do: [ :repArray | | cl | cl := repArray at: 1. " For special compiler classes, leave alone until phase 2 " ( specialCompilerClasses includes: cl ) ifFalse: [ " watch out for ghost classes " ( cl format notNil and: [ cl class format notNil and: [ cl environment includesKey: cl name ] ] ) ifTrue: [ traceClassRemovals ifTrue: [ notifier cr; show: 'Removing ',cl name. ]. cl quietlyRemoveFromSystem. ] ]. notifier tick. ]. " replace each class with a naked behavior and replace old instances" notifier log: ' Deleting classes part 3'. replacements do: [ :x | | cl meta replClass replMeta replInstBehavior | cl := x at: 1. meta := cl class. replInstBehavior := x at: 2. replClass := x at: 3. replMeta := x at: 4. " dispose of old instances " cl allInstancesDo: [ :obj | | newObj | newObj := replInstBehavior new. newObj primBecome: obj. ]. " switch places between old and new classes " replClass become: cl. cl flushVMmethodCache. replMeta become: meta. meta flushVMmethodCache. notifier tick. ]. replacements := nil. " remove unreferenced methods " notifier log: ' Deleting methods'. notifier tickRate: DeletedMethods size // 50. traceCount := 0. DeletedMethods keysAndValuesDo: [ :behav :selectors | " do not bother deleted classes (which still understand identity methods)" ( AllDeletedBehaviors includes: behav ) ifFalse: [ selectors do: [ :sel | traceMethodRemovals ifTrue: [ ( traceCount := traceCount + 1) > 20 ifTrue: [ notifier text value: String new. traceCount := 0. ]. notifier cr; show: behav name, '>>', sel. ]. " hard code keeping copyright methods " sel == #copyright ifFalse: [ behav quietlyRemoveSelector: sel ] ]. " flush the method cache all at once " behav flushVMmethodCache. ]. notifier tick. ]. " set unreferenced globals to nil " ( StrippingOptions includes: #stripGlobals ) ifTrue: [ notifier log: ' Removing unreferenced globals'. notifier tickRate: DeletedGlobals size // 50. traceCount := 0. self sortDeletedGlobals. DeletedGlobals do: [ :ref | | refBinding | refBinding := ref bindingOrNil. refBinding notNil ifTrue: [ traceClassRemovals ifTrue: [ ( traceCount := traceCount + 1) > 20 ifTrue: [ notifier text value: String new. traceCount := 0 ]. notifier cr; show: 'Resetting ', refBinding key. ]. refBinding whileMutableDo: [refBinding setValue: nil]. "Remove the binding, notifying the change set so that it gets removed from the containing package. If the binding is for a shared variable on a class, its environment will be a class so coerce it to be a namespace. This is a no-op for proper Namespaces." refBinding value isNameSpace ifTrue: [ref removeFromSystem: #(changes)] ifFalse: [ref environment asNameSpace removeBinding: refBinding recordIn: #(changes) ifAbsent: []]]]]. self purgeChangeSets. self removeExtraneousReferences
doMiscellaneousCleanupsInFinalImage: notifier "Take care of minor cleanups" | cl | notifier log: 'Doing miscellaneous cleanups'. RuntimeManager changed: #doingMiscellaneousCleanups. "clear the transcript, but only if standard text collector is in use" Transcript removeDependent: RuntimeManager. " just in case" ( Transcript isKindOf: TextCollector ) ifTrue: [ Transcript clear. Transcript dependents do: [ :dep | dep class == ScheduledWindow ifTrue: [ dep refresh ] ]. Transcript addDependent: RuntimeManager. ]. "discard installation instructions and system workspace" cl := RuntimeManager hiddenReferenceTo: 'ComposedTextView'. cl notNil ifTrue: [ ( cl classPool at: #InstallationWorkspace ifAbsent: [ ValueHolder new ] ) value: Text new. ( cl classPool at: #SystemWorkspace ifAbsent: [ ValueHolder new ] ) value: Text new. ]. "forget previous paste buffer selections (more privacy than space savings)" cl := RuntimeManager hiddenReferenceTo: 'ParagraphEditor'. cl notNil ifTrue: [ ( cl classPool includesKey: #PreviousSelection ) ifTrue: [ cl classPool at: #PreviousSelection put: ( ( cl classPool at: #PreviousSelection ) class new ). ]. ( cl classPool includesKey: #UndoSelection ) ifTrue: [ cl classPool at: #UndoSelection put: ( ( cl classPool at: #UndoSelection ) class new ). ]. ]. " Clear the Parcel search path is indicated and valid for this release " ( ( StrippingOptions includes: #clearParcelPath ) and: [ ( cl := RuntimeManager hiddenReferenceTo: 'Parcel' ) notNil ] ) ifTrue: [ cl searchPathModel value: List new. ]. "unhook from the Launcher Window" self removeFromLauncherMenu. "Disable the warp to launcher feature" (RuntimeManager hiddenReferenceTo: 'InputState') ifNotNil: [:inputState | inputState warpToLauncherKey: -1]. "just to clean up extra reference - not really needed" cl := nil.
emptyChangeSetsInFinalImage: notifier " empty the current change set(s). If Project is defined, remove changes " | cl | notifier log: 'Emptying change sets'. RuntimeManager changed: #emptyingChangeSets. cl := #{ChangeSet} valueOrDo: [ nil ]. cl notNil ifTrue: [ cl current initialize ].
installCompactMethods: notifier " Install the more compact runtime methods as replacements for existing method dictionaries." | rtcmClass | notifier log: 'Installing compact methods'. RuntimeManager changed: #aboutToInstallCompactMethods. rtcmClass := self hiddenReferenceTo: 'RuntimeCompiledMethod'. rtcmClass setRuntimeFormat. RuntimeManager allClassesDo: [ :cl | notifier tick. ( cl ~~ self and: [ cl ~~ Object and: [ cl ~~ Behavior ] ] ) ifTrue: [ self replaceMethodsIn: cl using: rtcmClass. self replaceMethodsIn: cl class using: rtcmClass. ] ].
mergeArrayLiteral: litArray pool: literals "Replace the contents of litArray with merged literals" | lit repl | 1 to: litArray size do: [ :idx | lit := litArray at: idx. repl := self mergeLiteral: lit pool: literals. lit == repl ifFalse: [ "avoid changing things that are not different" litArray whileMutableDo: [litArray at: idx put: repl ] ] ].
mergeByteCodeStrings: notifier "Merge method bytes that are the same to refer to only one occurrence" | methodBytes bytesIdx tableSize sortedBytes lastBytes bytes | bytesIdx := self bytesIndex. "cache for later frequent use" tableSize := 63. notifier log: 'Merging method byte codes'. notifier tickRate: notifier tickRate * 2. " i.e. only go half way" RuntimeManager changed: #aboutToMergeByteCodes. " put methods into slots based on a fast hash " methodBytes := Array new: tableSize. 1 to: tableSize do: [ :index | methodBytes at: index put: OrderedCollection new ]. notifier tick. RuntimeManager allClassesDo: [ :obj | ( Array with: obj with: obj class ) do: [ :behav | ( behav instVarAt: self methodDictIndex ) do: [ :meth | meth withAllBlockMethodsDo: [ :bl | bl isShort ifFalse: [ | mbytes | mbytes := bl instVarAt: bytesIdx. mbytes size > 4 ifTrue: [ "this should always be true" ( methodBytes at: ( ( mbytes at: 5) + mbytes size \\ tableSize + 1 ) ) add: bl. ] ] ] ] ]. notifier tick. ]. " sort and merge each group of methods " notifier tickRate: tableSize // 25. 1 to: tableSize do: [ :index | sortedBytes := ( methodBytes at: index ) asSortedCollection: [ :xBlock :yBlock | " sort based on length of bytes and contents of bytes " | x y | x := xBlock instVarAt: bytesIdx. y := yBlock instVarAt: bytesIdx. x size == y size ifTrue: [ | i n | i := 1. n :=x size. [ i <=n and: [ (x at: i) == (y at: i) ] ] whileTrue: [ i := i + 1]. i <= n ifTrue: [ ( x at: i) < (y at: i ) ] ifFalse: [ false ] ] ifFalse: [ x size < y size ] ]. sortedBytes size > 1 ifTrue: [ lastBytes := sortedBytes first instVarAt: bytesIdx. sortedBytes do: [ :bl | bytes := bl instVarAt: bytesIdx. bytes = lastBytes ifTrue: [ bl instVarAt: bytesIdx put: lastBytes ] ifFalse: [ lastBytes := bytes ] ] ]. notifier tick. ].
mergeLiteral: lit pool: literals "Answer the unique value to use for merging the literal lit. literals contains a dictionary with the unique instance of each literal value" | litKey lits literalBlock | " Arrays are scanned for merged immediate values but are not merged into unique values themselves " lit class == Array ifTrue: [ self mergeArrayLiteral: lit pool: literals. ^lit ]. " Get the dictionary of values for the literal " lits := literals at: lit class ifAbsent: [ ^lit ]. " Empty strings are not merged -- if there were an application bug, too many undiagnosable problems would arise because of the widespread use of this literal in the base image. See for example ComposedText class>>new." ( lit isString and: [ lit size = 0 ] ) ifTrue: [ ^lit ]. litKey := lit. "default key is the literal itself" "See if special handling applies to arithmetic values" lit respondsToArithmetic ifTrue: [ literalBlock := LiteralKeyBlocks at: lit class ifAbsent: [ nil ]. literalBlock notNil ifTrue: [ litKey := literalBlock value: lit ] ]. " Answer the unique value from the literals dictionary " ^lits at: litKey ifAbsent: [ lits at: litKey put: lit ]
mergeLiterals: notifier "Merge literals that are the same to refer to only one occurrence. Literals are merged only for selected classes and then only for equal values. Empty strings are used in too many critical places and are not merged. Array contents are merged but the Arrays themselves are not. Arithmetic values get special blocks to handle cases where equality does not mean that values can be merged." | literals | notifier log: 'Merging method and block literals'. RuntimeManager changed: #aboutToMergeLiterals. " Special classes to use for literals. Fraction is a hopeful addition since the compiler does not treat 1/2 as a literal Do not cause extraneous references in the unlikely event these classes are not used elsewhere." literals := Dictionary new: 17. #( 'ByteString' 'TwoByteString' 'LargePositiveInteger' 'LargeNegativeInteger' 'Float' 'Double' 'FixedPoint' 'Fraction' ) do: [ :cln | ( cln asQualifiedReference isDefined ) ifTrue: [ literals at: ( cln asQualifiedReference value ) put: Dictionary new. ] ]. " initialize the blocks used to compare literals " self setupLiteralKeyBlocks. " get unique occurrences of literals and replace them in methods and blocks " RuntimeManager allClassesDo: [ :cl | ( cl instVarAt: self methodDictIndex ) do: [ :meth | self mergeLiteralsInMethod: meth pool: literals ]. ( cl class instVarAt: self methodDictIndex ) do: [ :meth | self mergeLiteralsInMethod: meth pool: literals ]. notifier tick. ]. "Just to be safe, clear the literal key blocks" LiteralKeyBlocks := nil.
mergeLiteralsInMethod: method pool: literals "Merge the literals in method using literals as the pool of common values" | numLit lit repl | " protect against any strange variants of methods " ( method class == CompiledMethod or: [ method class == AnnotatedMethod ] ) ifFalse: [ ^self ]. " replace literals with unique instances " method withAllBlockMethods do: [ :bl | numLit := bl numLiterals. 1 to: numLit do: [ :idx | lit := bl literalAt: idx. repl := self mergeLiteral: lit pool: literals. lit == repl ifFalse: [ "do not change if not different" bl literalAt: idx put: repl; flushCachedVMCode ] ] ].
mergeMethods: notifier "Merge methods that are the same so that only one real instance is present. Moving methods to a common owner is no longer used because of SystemUtils class>>linkSystem which uses mclass to reset the bindings. Method names appearing in stack traces will therefore be unreliable." | allMethods mdictIdx exceptionClasses rtcmClass count | notifier log: 'Merging common methods'. RuntimeManager changed: #aboutToMergeMethods. count := 0. "One tick for class and one for metaclass" notifier tickRate: notifier tickRate * 2. " set up a place to store methods so that dups can be detected " allMethods := Dictionary new: 32000. mdictIdx := self methodDictIndex. " initialize the blocks used to compare literals " self setupLiteralKeyBlocks. " prepare a list of classes that are not touched " exceptionClasses := IdentitySet with: self. exceptionClasses addAll: ExternalInterface withAllSuperclasses; addAll: Class withAllSuperclasses; addAll: Metaclass withAllSuperclasses; addAll: GenericException withAllSubclasses; addAll: GeneralNameSpace withAllSubclasses; addAll: DeferredBinding withAllSubclasses; addAll: ( exceptionClasses copy collect: [ :x | x class ] ). " go through all behaviors and do the merge " rtcmClass := self hiddenReferenceTo: 'RuntimeCompiledMethod'. SystemUtils allBehaviorsDo: [ :behav | | dups mdict | notifier tick. ( exceptionClasses includes: behav ) ifFalse: [ mdict := behav instVarAt: mdictIdx. dups := IdentityDictionary new. mdict keysAndValuesDo: [ :sel :mth | " Screen for only cases that can be safely merged " ( ( mth class == CompiledMethod or: [ mth class == rtcmClass ] ) and: [ " value is sent internally by the VM in some cases -- avoid problems" sel ~~ #value ] ) ifTrue: [ | replAssoc | replAssoc := allMethods associationAt: mth ifAbsent: [ allMethods at: mth put: sel. nil ]. replAssoc notNil ifTrue: [ dups at: sel put: replAssoc key ] ] ]. dups keysAndValuesDo: [ : sel :repl | " put the replacement in where the current method was " count := count + 1. mdict at: sel put: repl. behav flushVMmethodCacheEntriesFor: sel. ] ] ]. "DEBUG output notifier show: ' ', count printString, ' methods merged'. "
packageExternalInterfaceSubclasses: notifier "Do any necessary cleanups for C macros by invoking ExternalDictionary class>>fillDefineCachesWithValues." | macroClass fillSelector | " put message on notifier " notifier log: 'Packaging ExternalInterface subclasses'. notifier tickRate: 1. RuntimeManager changed: #packagingExternalInterfaceSubclasses. " avoid references to certain selectors and classes " macroClass := RuntimeManager hiddenReferenceTo: 'CMacroDefinition'. macroClass isNil ifTrue: [ ^ true ]. fillSelector := ( '_fillDefineCaches' copyWithout: $_ ) asSymbol. " package each external interface subclass " ExternalInterface allSubclasses do: [ :cl | ( DeletedClasses includes: cl ) ifFalse: [ [ cl perform: fillSelector ] on: Error do: [ :ex | Dialog warn: ex errorString, '\\Error in packaging external interface for ' withCRs, cl class name. ^false ] ]. notifier tick.]. ^true
prepareClassesForDeletionIn: notifier "Sort the classes to make sure that we delete subclasses before superclasses, and dependents (as defined by prerequisitesForLoading) before the things they depend on. Create a collection of replacement classes and metaclasses to substitute, and also populate the AllDeletedBehaviors list." | replacements visited | DeletedClassesInOrder := OrderedCollection new: DeletedClasses size. ClassPrerequisites := IdentityDictionary new: DeletedClasses size. DeletedClasses := DeletedClasses asSet. DeletedClasses copy do: [:each | DeletedClasses addAll: each allSubclasses]. "Subclasses must be removed before superclasses" DeletedClasses do: [:each | ClassPrerequisites at: each put: each subclasses asOrderedCollection]. "Prerequisites must be removed *after* things that require them" DeletedClasses do: [:each | each prerequisitesForLoading do: [:eachPrereq | ClassPrerequisites at: eachPrereq ifPresent: [:collection | collection add: each]]]. visited := IdentitySet new: DeletedClasses size. DeletedClasses do: [:each | self sortClassForDeletion: each in: visited notifying: notifier]. AllDeletedBehaviors := IdentitySet new: DeletedClasses size. DeletedClasses do: [ :cl | AllDeletedBehaviors add: cl; add: cl class ]. replacements := OrderedCollection new: DeletedClasses size. DeletedClassesInOrder do: [ :cl | replacements add: ( Array with: cl with: ( RuntimeDeletedBehavior forDeletedInstance: cl) with: ( RuntimeDeletedBehavior onDeletedClass: cl ) with: ( RuntimeDeletedBehavior onDeletedMetaclass: cl class ) ) ]. ^replacements.
purgeDependents: deletedClasses "Clean up any well-known system dependencies that include things that are going to be deleted. The most basic of these, is any class-level dependencies, e.g. dependencies on ObjectMemory, ChangeSet, etc." Object withAllSubclasses, (Array with: Transcript with: Store.Registry) do: [:each | | deletedDependents | deletedDependents := each dependents select: [:dependent | (deletedClasses includes: dependent) or: [deletedClasses includes: dependent class]]. deletedDependents do: [:dependent | each removeDependent: dependent]].
replaceDoItMenusInFinalImage: notifier " check for need to delete doits from menu (but avoid dependency on compiler)" | paraEdCl | ( DeletedClasses includes: ( RuntimeManager hiddenReferenceTo: 'SmalltalkCompiler' ) ) ifTrue: [ notifier log: 'Removing doits from ParagraphEditor menus'. RuntimeManager changed: #removingDoIts. " just make sure we are not dealing with a deviant image" paraEdCl := RuntimeManager hiddenReferenceTo: 'ParagraphEditor'. paraEdCl notNil ifTrue: [ ( paraEdCl classPool includesKey: #TextEditorYellowButtonMenu ) ifTrue: [ paraEdCl classPool at: #CodeYellowButtonMenu put: ( paraEdCl classPool at: #TextEditorYellowButtonMenu ) ]. paraEdCl withAllSubclasses do: [ :cl | cl allInstances do: [ :x | x initializeMenu] ] ] ].
replaceMethodsIn: aBehavior using: rtcmClass "Replace the methods in the behavior provided with ones of the class provided. This is done to remove extra instance variables." | mdict | mdict := aBehavior instVarAt: self methodDictIndex. "check for spoof method dictionaries that may have unusual protocols and are thus better avoided" mdict class == MethodDictionary ifFalse: [ ^ self ]. "replace each method with a more compact one" mdict keysAndValuesDo: [:sel :meth | ( meth class == CompiledMethod and: [ meth mclass == aBehavior ] ) ifTrue: [ meth become: ( rtcmClass fromMethod: meth ). aBehavior flushVMmethodCacheEntriesFor: sel. ] ]
setSpaceSizesInFinalImage: notifier " set space sizes at startup and build a new memory policy (installed later)" | startupSizes newSizes | notifier log: 'Setting startup space sizes'. startupSizes := ObjectMemory defaultSizesAtStartup. newSizes := Array new: 7. newSizes at: 1 put: MemoryParams edenSize asFloat / ( startupSizes at: 1 ). newSizes at: 2 put: MemoryParams survivorSize asFloat / (startupSizes at: 2). newSizes at: 3 put: MemoryParams largeSize asFloat / (startupSizes at: 3). newSizes at: 4 put: MemoryParams stackSize asFloat / (startupSizes at: 4). newSizes at: 5 put: MemoryParams codeSize asFloat / (startupSizes at: 5). newSizes at: 6 put: MemoryParams oldSize asFloat / (startupSizes at: 6). newSizes at: 7 put: MemoryParams fixedSize asFloat / (startupSizes at: 7). ObjectMemory sizesAtStartup: newSizes. NewMemoryPolicy := ObjectMemory currentMemoryPolicy. NewMemoryPolicy preferredGrowthIncrement: MemoryParams incrementSize; growthRetryDecrement: MemoryParams retryDecrement; growthRegimeUpperBound: MemoryParams growthLimit; memoryUpperBound: MemoryParams memoryLimit. MemoryParams := nil.
setupLiteralKeyBlocks "Setup a dictionary of blocks used to generate keys for comparing numeric literals. These blocks handle special cases in which the criteria for merging is not the normal definition of equality. Allow for classes having been stripped out and avoid adding new references to classes." | cl | LiteralKeyBlocks := Dictionary new: 17. (cl := Smalltalk at: 'Fraction' asSymbol ifAbsent: [ nil ] ) notNil ifTrue: [ LiteralKeyBlocks at: cl put: [ :lit | Array with: lit numerator with: lit denominator ] ]. (cl := Smalltalk at: 'FixedPoint' asSymbol ifAbsent: [ nil ] ) notNil ifTrue: [ LiteralKeyBlocks at: cl put: [ :lit | Array with: lit numerator with: lit scale with: lit denominator ] ]. (cl := Smalltalk at: 'Double' asSymbol ifAbsent: [ nil ] ) notNil ifTrue: [ LiteralKeyBlocks at: cl put: [ :lit | | key | key := Array new: lit basicSize. 1 to: key size do: [ :i | key at: i put: ( lit basicAt: i ) ]. key ] ]. (cl := Smalltalk at: 'Float' asSymbol ifAbsent: [ nil ] ) notNil ifTrue: [ LiteralKeyBlocks at: cl put: [ :lit | | key | key := Array new: lit basicSize. 1 to: key size do: [ :i | key at: i put: ( lit basicAt: i ) ]. key ] ].
sortClassForDeletion: aClass in: aSet notifying: notifier "Do a topological sort for this class, based on the prerequisites we have set up in ClassPrerequisites for subclass and prerequisitesForLoading relationships. Put the results into DeletedClassesInOrder." | prereqs | (aSet includes: aClass) ifTrue: [^self]. aSet add: aClass. prereqs := ClassPrerequisites at: aClass. prereqs do: [:each | self sortClassForDeletion: each in: aSet notifying: notifier]. notifier ifNotNil: [notifier tick]. DeletedClassesInOrder add: aClass.
sortDeletedGlobals "Sort the deleted globals so that things contained get deleted before the things that contain them. Note that this won't work for references in general, but ours are all fully qualified, so it gets the environment right" DeletedGlobals := DeletedGlobals asSortedCollection: [:a :b | | allEnvs current | allEnvs := OrderedCollection new. current := a environment. [current isNil] whileFalse: [allEnvs add: current. current := current environment]. (allEnvs includes: b)].
suppressEmergencyEvaluator: notifier "Ignore keystrokes that raise the EmergencyEvaluator in the runitme image" notifier log: 'Suppressing the emergency evaluator'. InputState interruptKeyValue: (Character value: 0).
</methods> <methods> RuntimePackager.RuntimeManagerStripper class <category>dynamic references</category>
itemsReferencedByClassSelector: aSelector "Filter out false references" aSelector == #createFinalImage ifTrue: [ ^( self class compiledMethodAt: #createFinalImage ) allLiterals reject: [ :lit | lit == #createFinalImageHiddenLogic: ] ]. ^nil
</methods> <methods> RuntimePackager.RuntimeManagerStripper class <category>private-stripping</category>
purgeChangeSets "Purge all change sets, if any are present. This is done very late so we get changes that were caused by our deletions. Try to avoid using possibly-stripped messages, e.g. #allGeneralInstances." (self hiddenReferenceTo: 'ChangeSet') ifNotNil: [:changeSet | [changeSet allSubclasses, (Array with: changeSet) do: [:eachClass | eachClass allInstancesDo: [:each | [each initialize] on: Error do: [:ex | ex return]]]] on: Error do: [:ex | ex return]].
removeExtraneousReferences " Make really sure extraneous references are gone." LoadableClasses := nil. DeletedMethods := nil. DeletedClasses := nil. DeletedGlobals := nil. AllDeletedBehaviors := nil. DeletedClassesInOrder := nil. ClassPrerequisites := nil.
</methods> <methods> RuntimePackager.RuntimeBuilderItems <category>accessing</category>
allDeletedClasses "Answer the collection of deleted classes including any implied subclasses" ^self allDeletedClassesWithLoadables: true
allDeletedClassesWithLoadables: includeLoadables "Answer the collection of deleted classes including any implied subclasses. If includeLoadable is true, add in the classes defined in loadable parcels. Classes defined in name spaces that are themselves defined in loadable parcels will be deleted unless such classes are loaded in parcels." | classes | classes := IdentitySet new: ( deletedClasses size max: unreferencedClasses size). unreferencedClasses isEmpty ifTrue: [ deletedClasses do: [ :cl | classes addAll: cl withAllSubclasses ] ] ifFalse: [ unreferencedClasses do: [ :cl | classes addAll: cl withAllSubclasses. ] ]. self classesInDeletedNameSpaces do: [ :cl | classes addAll: cl withAllSubclasses ]. includeLoadables ifTrue: [ options loadableClasses do: [ :cl | classes addAll: cl withAllSubclasses ] ]. ^classes
allDeletedGlobals "Answer the deleted globals " ^unreferencedGlobals isEmpty ifTrue: [ deletedGlobals ] ifFalse: [ unreferencedGlobals ]
allDeletedMethods "Answer the dictionary of all deleted methods including those defined as extensions in loadable parcels " ^self allDeletedMethodsWithLoadables: true
allDeletedMethodsWithLoadables: includeLoadables "Answer the dictionary of all deleted methods including those defined as extensions in loadable parcels if includeLoadables is true " | dict deleted selSet | " choose the right starting point depending of whether scan was done or not " deleted := unreferencedMethods isEmpty ifTrue: [ deletedMethods ] ifFalse: [ unreferencedMethods ]. includeLoadables ifFalse: [ dict := deleted. ] ifTrue: [ " allocate a dictionary to hold the final result. " dict := IdentityDictionary new: deleted size. deleted keysAndValuesDo: [:cl :selectors | dict at: cl put: selectors ]. " get methods loaded by way of parcels " options loadableMethods keysAndValuesDo: [ :behav :loadables | selSet := ( dict at: behav ifAbsent: [ dict at: behav put: Set new ] ) copy. selSet addAll: loadables. dict at: behav put: selSet. ] ]. ^dict
classesInDeletedNameSpaces "Answer classes defined in name spaces that are being deleted. If a class is defined in a name space that is itself defined in a loadable parcel, the class is considered deleted unless it is defined in a loadable parcel." | deletedNS classes loadableNS loadableClasses | deletedNS := self deletedNameSpaces. classes := IdentitySet new. deletedNS do: [ :ns | classes addAll: ns allClasses ]. loadableNS := options loadableNameSpaces. loadableClasses := options loadableClasses. loadableNS do: [ :ns | classes addAll: ( ns allClasses reject: [ :cl | loadableClasses includes: cl ] ). ]. ^classes
deletedClasses ^deletedClasses
deletedClasses: aSetOfClasses deletedClasses := aSetOfClasses
deletedGlobals ^deletedGlobals
deletedGlobals: aSetOfBindingReferences deletedGlobals := aSetOfBindingReferences
deletedMethods "Answer the dictionary of deleted methods. Key is class, value is set of selectors." ^deletedMethods
deletedMethods: aDictionary "Set the dictionary of deleted methods. Key is class, value is set of selectors." deletedMethods := aDictionary
deletedNameSpaces "Answer namespaces that will be deleted because they are contained in loadable namespaces but not themselves loadable." | loadableNS deletedNS | loadableNS := options loadableNameSpaces. deletedNS := IdentitySet new. loadableNS do: [ :ns | deletedNS addAll: ns withAllNameSpaces ]. deletedNS removeAll: loadableNS. ^deletedNS
editorClass "Answer the class to use as an editor" ^RuntimeBuilderItemsChooser
keptClasses ^keptClasses
keptClasses: aSetOfClasses keptClasses := aSetOfClasses
keptGlobals ^keptGlobals
keptGlobals: aSetOfBindingReferences keptGlobals := aSetOfBindingReferences
keptMethods "Answer the dictionary of kept methods. Key is class, value is set of selectors." ^keptMethods
keptMethods: aDictionary "Set the dictionary of kept methods. Key is class, value is set of selectors." keptMethods := aDictionary
options "Answer the options used for setting defaults" ^options
options: opts "Set the options (RuntimeBuilderOptions) used for setting defaults" options notNil ifTrue: [ options removeDependent: self ]. options := opts. options addDependent: self.
unreferencedClasses ^unreferencedClasses
unreferencedClasses: aCollection unreferencedClasses := aCollection
unreferencedGlobals ^unreferencedGlobals
unreferencedGlobals: aCollection unreferencedGlobals := aCollection
unreferencedMethods "Answer the dictionary of unreferenced methods. Key is class, value is set of selectors." ^unreferencedMethods
unreferencedMethods: aDictionary "Set the dictionary of unreferenced methods. Key is class, value is set of selectors." unreferencedMethods := aDictionary
unreferencedMethodsCount "Answer the number of methods represented in unreferencedMethods" ^unreferencedMethods inject: 0 into: [ :n :sel | n + sel size ]
viewerClass "Answer the class to use as an viewer" ^RuntimeBuilderItemsViewer
</methods> <methods> RuntimePackager.RuntimeBuilderItems <category>load-save</category>
decodeClassesFrom: tokenArray "Answer the classes named in the token array" ^IdentitySet withAll: ( ( tokenArray collect: [ :token | ( BindingReference pathString: token ) valueOrDo: [ Transcript cr; show: 'Class ', token printString, ' not found. It was skipped'. nil ] ] ) select: [ :x | x notNil and: [ x isBehavior and: [ x isMeta not ] ] ] )
decodeFrom: tokens fileVersion: version "Decode the new value from the token array provided" " set up action blocks for scanning tokens" | actionBlocks | actionBlocks := Dictionary new add: #deletedClasses -> [ :tokenArray | deletedClasses := self decodeClassesFrom: tokenArray ]; add: #keptClasses -> [ :tokenArray | keptClasses := self decodeClassesFrom: tokenArray ]; add: #unreferencedClasses -> [ :tokenArray | unreferencedClasses := self decodeClassesFrom: tokenArray ]; add: #deletedMethods -> [ :tokenArray | deletedMethods := self decodeMethodsFrom: tokenArray ]; add: #keptMethods -> [ :tokenArray | keptMethods := self decodeMethodsFrom: tokenArray ]; add: #unreferencedMethods -> [ :tokenArray | unreferencedMethods := self decodeMethodsFrom: tokenArray ]; add: #deletedGlobals -> [ :tokenArray | deletedGlobals := self decodeGlobalsFrom: tokenArray ]; add: #keptGlobals -> [ :tokenArray | keptGlobals := self decodeGlobalsFrom: tokenArray ]; add: #unreferencedGlobals -> [ :tokenArray | unreferencedGlobals := self decodeGlobalsFrom: tokenArray ]; yourself. "discard the results of previous scans for unreferenced items" self resetUnreferencedItems. " extract the new values from the tokens " self initialize. 1 to: tokens size by: 2 do: [ :tokenIndex | ( actionBlocks includesKey: (tokens at: tokenIndex) ) ifFalse: [ Dialog warn: 'Invalid token ', (tokens at: tokenIndex), ' found'. ] ifTrue: [ (actionBlocks at: (tokens at: tokenIndex) ) value: (tokens at: tokenIndex + 1) ] ]. "Make sure that loaded values are a valid class hierarchy, and are appropriate for this version. " self adjustForVersion: version. self ensureValidHierarchy. " for unreferenced classes that were loaded, make their methods unreferenced also" unreferencedClasses do: [ :cl | unreferencedMethods at: cl put: ( RuntimeManager selectorsInClass: cl ). unreferencedMethods at: cl class put: (RuntimeManager selectorsInClass: cl class ). ]. " display new values if applicable " self refresh. hasBeenEdited := true. self changed.
decodeGlobalsFrom: tokenArray "Answer the bindings for globals named in the token array" | ref | ^Set withAll: ( ( tokenArray collect: [ :token | ref := ( BindingReference pathString: token ) makeUnambiguous. ( ref isDefined and: [ ref binding isForClass not ] ) ifFalse: [ Transcript cr; show: ( 'Global <1s> not found. It was skipped' expandMacrosWith: token printString ). ]. ref ] ) )
decodeMethodsFrom: tokenArray "Answer the methods named in the token array. See keptMethods and deletedMethods for the encoding used. Selectors entered alone are from an earlier version of the setting file. There are treated as references to all implementations of the selector." | allSelectors result classNamed classFound selIndex | allSelectors := IdentitySet new. result := IdentityDictionary new. tokenArray do: [ :token | token isString ifTrue: [ allSelectors add: token asSymbol ] ifFalse: [ "token should be an array of size at least 1" ( token size > 1 and: [ ( classNamed := ( BindingReference pathString: token first ) valueOrDo: [ Transcript cr; show: 'Class ', token printString, ' not found. It was skipped'. nil ] ) notNil and: [ classNamed isBehavior and: [ classNamed isMeta not ] ] ] ) ifTrue: [ classFound := classNamed. selIndex := 2. ( token size >= 2 and: [ ( token at: 2 ) = #class ] ) ifTrue: [ classFound := classNamed class. selIndex := 3. ]. result at: classFound put: ( ( token copyFrom: selIndex to: token size ) collect: [ :x | x asSymbol ] ) asSet ] ifFalse: [ token size > 1 ifTrue: [ Transcript cr; show: 'Invalid class in method token: ', token first printString, '. It was skipped' ] ifFalse: [ Transcript cr; show: 'Empty method token skipped'. ] ] ] ]. " Convert old format param files in which a reference to the selector applies to all classes implementing the selector. The assumption is that only the primary name space is affected." allSelectors isEmpty ifFalse: [ Smalltalk allBehaviorsDo: [ :cl | allSelectors do: [ :sel | ( cl includesSelector: sel ) ifTrue: [ ( result at: cl ifAbsent: [ result at: cl put: Set new ] ) add: sel. ] ] ] ]. ^result
encodeClasses: aSet on: aStream tab: tabCount "Encode a set of classes on a stream. The classes are sorted by category and obsolete items are omitted." | prevCategory | prevCategory := ''. ( ( ( aSet reject: [ :cl | cl isObsolete ] ) collect: [ :cl | | cat | cat := cl category. cat isNil ifTrue: [ cat := '' ]. Array with: cl with: cat with: cl name ] ) asSortedCollection: [ :x :y | ( x at: 2 ) = ( y at: 2) ifTrue: [ ( x at: 3 ) < ( y at: 3) ] ifFalse: [ ( x at: 2 ) < ( y at: 2 ) ] ] ) do: [ :triple | | cl cat | cl := triple at: 1. cat := triple at: 2. cat ~= prevCategory ifTrue: [ aStream cr; crtab: tabCount; nextPut: $"; nextPutAll: cat; nextPut: $". prevCategory := cat. ]. aStream crtab: tabCount; print: cl fullName ].
encodeMethods: aDict on: aStream tab: tabCount "Encode methods on the stream. Methods are encoded in one of the following ways in the stream: ( 'class-name' 'selector1' 'selector2' .... ) <- methods in the class named ( 'class-name' class 'selector1' 'selector2' ... ) <- class methods See keptMethods and deletedMethods for the contents of aDict" | classes selectors | classes := aDict keys asSortedCollection: [ :x :y | x name < y name ]. classes do: [ :cl | selectors := ( aDict at: cl ) asSortedCollection. aStream crtab: tabCount; nextPutAll: '( '. cl isMeta ifTrue: [ aStream print: cl soleInstance fullName ; nextPutAll: ' class'. ] ifFalse: [ aStream print: cl fullName ]. selectors do: [ :sel | selectors size > 1 ifTrue: [ aStream crtab: tabCount + 1 ] ifFalse: [ aStream space ]. aStream print: sel asString ]. aStream nextPutAll: ' )'. ].
encodeOn: aStream tab: tabCount "Encode the receiver onto a stream in a form suitable for decoding as a literal array. saveUnreferenced is a boolean that controls whether the unreferenced classes, methods, and globals are saved with the parameters." | meth | " write a separator " aStream cr; crtab: tabCount; nextPutAll: '"====deleted classes methods and globals===="'. " deleted classes " aStream crtab: tabCount; nextPutAll: 'deletedClasses ('. self encodeClasses: deletedClasses on:aStream tab: tabCount+1. aStream nextPutAll: ' )'. " deleted methods " aStream crtab: tabCount; nextPutAll: 'deletedMethods ('. self encodeMethods: deletedMethods on: aStream tab: tabCount + 1. aStream nextPutAll: ' )'. " deleted globals " aStream crtab: tabCount; nextPutAll: 'deletedGlobals ('. ( deletedGlobals asSortedCollection ) do: [ :ref | aStream crtab: tabCount+1; print: ref asString ]. aStream nextPutAll: ' )'. " write a separator " aStream cr; crtab: tabCount; nextPutAll: '"====kept classes methods and globals===="'. " kept classes " aStream crtab: tabCount; nextPutAll: 'keptClasses ('. self encodeClasses: keptClasses on:aStream tab: tabCount+1. aStream nextPutAll: ' )'. " kept methods " aStream crtab: tabCount; nextPutAll: 'keptMethods ('. self encodeMethods: keptMethods on: aStream tab: tabCount + 1. aStream nextPutAll: ' )'. " kept globals " aStream crtab: tabCount; nextPutAll: 'keptGlobals ('. ( keptGlobals asSortedCollection ) do: [ :ref | aStream crtab: tabCount+1; print: ref asString. ]. aStream nextPutAll: ' )'. " write a separator " aStream cr; crtab: tabCount; nextPutAll: '"====unreferenced classes methods and globals, if any===="'. " unreferenced classes, if any" unreferencedClasses isEmpty ifFalse: [ aStream crtab: tabCount; nextPutAll: 'unreferencedClasses ('. self encodeClasses: unreferencedClasses on:aStream tab: tabCount+1. aStream nextPutAll: ' )'. ]. " unreferenced methods, if any, but not for unreferenced classes" unreferencedMethods isEmpty ifFalse: [ "remove methods is classes that are themselves unreferenced" meth := IdentityDictionary new: unreferencedMethods size. unreferencedMethods keysAndValuesDo: [ :cl :v | ( unreferencedClasses includes: ( cl isMeta ifTrue: [ cl soleInstance ] ifFalse: [ cl ] ) ) ifFalse: [ meth add: cl -> v ] ]. aStream crtab: tabCount; nextPutAll: 'unreferencedMethods ('. self encodeMethods: meth on: aStream tab: tabCount + 1. aStream nextPutAll: ' )'. " unreferenced globals, if any " unreferencedGlobals isEmpty ifFalse: [ aStream crtab: tabCount; nextPutAll: 'unreferencedGlobals ('. ( unreferencedGlobals asSortedCollection ) do: [ :ref | aStream crtab: tabCount+1; print: ref asString ]. aStream nextPutAll: ' )'. ] ].
</methods> <methods> RuntimePackager.RuntimeBuilderItems <category>defaults</category>
defaultBundleNamesDeleted "Answer the names of bundles to be completely deleted when using VisualWorks." ^#('Tools-Refactoring Browser')
defaultBundleNamesKept "Answer the names of bundles to be completely kept by default when using VisualWorks." ^#()
defaultClassesDeleted "Answer a set of classes deleted by default " | deleted | cachedDefaults notNil and: [ cachedDefaults at: #defaultClassesDeleted ifPresent: [:answer | ^answer]]. deleted := IdentitySet new. " choose which of classes should be deleted from the base image " deleted addAll: self defaultClassesDeletedVW. deleted addAll: self defaultRBClassesDeleted. deleted addAll: self defaultPDPClassesDeleted. " see if compiler is being deleted " options removeCompiler ifTrue: [ deleted addAll: self defaultCompilerClassesDeleted ]. " get platform system specific deletions " deleted addAll: self defaultOSClassesDeleted. deleted addAll: self defaultUILookClassesDeleted. " avoid keeping development portions of Runtime Packager" deleted addAll: self defaultClassesDeletedRTP. cachedDefaults isNil ifFalse: [cachedDefaults at: #defaultClassesDeleted put: deleted]. ^deleted
defaultClassesDeletedRTP "Answer the classes deleted from Runtime Packager" ^ #( #RuntimeBuilderAppModel #RuntimeBuilderClassChooser #RuntimeBuilderEditableObject #RuntimeBuilderEditor #RuntimeBuilderHelp #RuntimeBuilderItems #RuntimeBuilderItemsChooser #RuntimeBuilderItemsViewer #RuntimeBuilderMemoryParamEditor #RuntimeBuilderMemoryParams #RuntimeBuilderMessageTracer #RuntimeBuilderOptions #RuntimeBuilderOptionsEditor #RuntimeBuilderReferenceBrowser #RuntimeBuilderTester #RuntimeBuilderUI #RuntimeClassSurrogate #RuntimeInstanceSurrogate #RuntimeMethodSurrogate #RuntimeSurrogateManager ) collect: [ :nm | ( self class environment bindingFor: nm ) value ]
defaultClassesDeletedVW "Answer the classes deleted when using VisulaWorks. Tools oriented classes typically loaded through parcels (or the ENVY/Developer equivalent applications) are included to simplify the stripping process for the user especially when building a baseline image for use with parcels." ^ #( "Interface-Dialogs" #PickASomethingDialog "Interface-Events-Trackers" #BitEditorTracker #ColorBitEditorTracker #ColumnReorderTracker "Tools-Changes" #ChangeEditor #ChangeList " #NamedChangeSet -- do not delete" "Tools-Programming" #BrowsingAgent #ClassCreationDialog #ContextDefinition #ContextInspector #DebugContextsBrowserHelper #Debugger #DefinitionCreationDialog #Explainer " #GeneralMethodDefinition -- not deleted as of RTP5i.3" " #InitializerDefinition -- not deleted as of RTP5i.3" #MethodCollector " #MethodDefinition -- not deleted as of RTP5i.3" #MethodFilter #MethodFilterAnd #MethodFilterClassHierarchy #MethodFilterImplementor #MethodFilterInstVar #MethodFilterNameSpace #MethodFilterNot #MethodFilterNull #MethodFilterOr #MethodFilterParcel #MethodFilterProtocol #MethodFilterReference #MethodFilterSelect " #Notifier -- do not delete" #NotifierView #ProcessHandle #SharedVariableCreationDialog #SmalltalkWorkbench "UIBasics-Components" #HotSlice "UIBuilder-Specifications" #MultiSpec #SpecModel "UIBuilder-Support" #LabelConstructor #HelpConstructor "UIPainter" #UISpecificationTreeModel "UIPainter-Modes" #DragHandle #DrawingModeTracker #SelectModeTracker "UIPainter-Support" #BitEditor #BitView #ColorBitEditor #ColorBitView #ColoredArea #ColoredAreaController #ColumnReorderAgent #DataSetCallbacksSpecModel #DataSetSpecColumnDetailsModel #DataSetSpecColumnModel #DirectBitView #DSVDependencyAgent #GridWrapper #MaskPainterController #MaskPainterView #PaintedDataSetController #PaintedDataSetView #PaintTracker #UIDefiner #UIPainterController #UIPainterSystemController #UIPainterView #UIPainterWatcher "UIPainter-Tools" #ClassFinder #ColorToolModel #IntegratedSpecModel #MenuEditor #PositionToolModel #UIFinderVW2 #UIHotRegionEditor #UIMaskEditor #UIPainter #UIPainterTool #UIPalette ) collect: [ :nm | nm asQualifiedReference valueOrDo: [ "debug-- Transcript cr; show: nm." nil ] ]
defaultClassesKept "Answer a set of classes kept." | kept | cachedDefaults notNil and: [ cachedDefaults at: #defaultClassesKept ifPresent: [:answer | ^answer]]. " choose which of classes should be deleted by default " kept := self defaultClassesKeptVW asSet. "Include ourselves as a special class" kept add: RuntimeManager. " add any special startup classes " kept addAll: self defaultStartupClasses. cachedDefaults isNil ifFalse: [cachedDefaults at: #defaultClassesKept put: kept]. ^kept
defaultClassesKeptVW "Answer a set of classes kept when using Visual Works 5.0 and above." ^self defaultClassesKeptVW_ClassOnly, self defaultClassesKeptVWWithSubclasses, self defaultClassesKeptVWWithSubclassesAndAllMethods
defaultClassesKeptVWWithSubclasses | classes | classes := OrderedCollection new. #(#ByteEncodedString #Boolean #Integer #DeferredBinding #VariableBinding #NameSpaceImport #CDatum #CPointerType #SocketAccessor #SocketAddress #StreamEncoder #CharacterEncoder #SymbolTable) do: [:clName | clName asQualifiedReference ifDefinedDo: [:class | classes addAll: class withAllSubclasses asArray]]. ^classes asArray
defaultClassesKeptVWWithSubclassesAndAllMethods | classes | classes := OrderedCollection new. #(#StringCollationPolicy #PrintPolicy #LocaleSensitiveDataReader #Subsystem #CStructureLayout) do: [:clName | clName asQualifiedReference ifDefinedDo: [:class | classes addAll: class withAllSubclasses asArray]]. ^classes asArray
defaultClassesKeptVW_ClassOnly "Answer a set of classes kept when using Visual Works 5.0 and above." ^( #( "Kernel-Classes" #Behavior #Class #ClassDescription #Metaclass "Kernel-Collections" #UTF8StreamEncoder "Kernel-Exception Handling" #Exception #GenericException #Signal "Kernel-Methods" #AnnotatedMethod #BlockClosure #BlockContext #CompiledBlock #CompiledCode #CompiledMethod #Context #InstructionClient #InstructionStream #MarkedMethod #Message #MessageSend #MethodContext "Kernel-Support" #MethodDictionary #SystemError "Kernel-Objects" #Model #Object #UndefinedObject #UninterpretedBytes "Kernel-Processes" #Delay #Process #ProcessEnvironment #ProcessorScheduler #Promise #RecursionLock #Semaphore #SharedQueue "Magnitude-General" #Character #Date #Magnitude #Time #TimeZone "Magnitude-Numbers" #ArithmeticValue #Number "System-Support" #AllocationFailure #DependentsCollection #MemoryPolicy #ObjectMemory #PoolDictionary #SystemUtils #WeakKeyAssociation "System-Name Spaces" #NameSpace #NameSpaceOfClass #WeakNameSpaceBindings #ScopeList " Collections Support - explicitly keep binding classes" #BindingReference "Extra C support classes" #CCompositeType #CProcedureType #FinalizeCallbackProcessNotification "Tools" #Notifier #NamedChangeSet ) collect: [ :nm | nm asQualifiedReference valueOrDo: [ "debug -- Transcript cr; show: nm. " nil ] ])
defaultCompilerClassesDeleted "Answer the classes deleted when the compiler is to be removed. This list is specific to VisualWorks 2.0 and above and includes DLLCC as well as the standard compiler support." ^ #( "DLLCC-CParsing" CDeclarationParser CExpressionParser CParser CPreprocessor CScanner "DLLCC-Interface" ExternalInterfaceBuilder ExternalInterfaceFinder ExternalInterfaceHolder "DLLCC-Parsing" ExtendedCompiler ExtendedParser "System-Compiler-Public Access" CodeRegenerator Compiler Decompiler SmalltalkCompiler ) collect: [ :nm | nm asQualifiedReference valueOrDo: [] ]
defaultCUAClassesDeleted "Answer the names of UILook specific classes to be deleted" ^ #( #CUAActionButtonView #CUABorderDecorationPolicy #CUACheckButtonView #CUAComboBoxButtonView #CUAFeelPolicy #CUALookPolicy #CUAMenuBar #CUAMenuBarButtonView #CUAMenuButtonView #CUAMenuItemView #CUAMenuView #CUARadioButtonView #CUAScrollBar #CUAScrollBarSlider #CUAScrollerButtonView #CUASpinButtonView #CUAWidgetPolicy ) collect: [ :nm | nm asQualifiedReference valueOrDo: [ "debug -- Transcript cr; show: nm. " nil ] ]
defaultGlobalsDeleted "Answer the names of globals which will be kept by default" "Right now there are no globals deleted by default This method is here for future patches" ^ Set new
defaultGlobalsKept "Answer the names of globals which will be kept by default. See RuntimeManager class>>dynamicallyReferencedGlobals for a list. At present no globals are explicitly kept" | kept reference | cachedDefaults notNil and: [ cachedDefaults at: #defaultGlobalsKept ifPresent: [:answer | ^answer]]. kept := Set new. kept add: #{CharacterEncoderPool}. reference := CharacterEncoderPool fullyQualifiedReference. kept addAll: (CharacterEncoderPool localBindings collect: [:each | reference append: each key]). cachedDefaults isNil ifFalse: [cachedDefaults at: #defaultGlobalsKept put: kept]. ^kept.
defaultMacClassesDeleted "Answer the names of os specific classes to be deleted" ^ #( #MacDiskFileAccessor #MacFilename #MacIOAccessor #MacSpinButtonView #MacSystemSupport #PowerMacSystemSupport #MacOSXSystemSupport ) collect: [ :nm | nm asQualifiedReference valueOrDo: [ "debug -- Transcript cr; show: nm. " nil ] ]
defaultMacUIClassesDeleted "Answer the names of UILook specific classes to be deleted" ^ #( #MacActionButtonView #MacBorderDecorationPolicy #MacCheckButtonView #MacComboBoxButtonView #MacFeelPolicy #MacLookPolicy #MacMenuBar #MacMenuBarButtonView #MacMenuButtonView #MacMenuItemView #MacMenuView #MacRadioButtonView #MacScrollBar #MacSliderView #MacWidgetPolicy #MacOSXActionButtonView #MacOSXBorderedWrapper #MacOSXComboBoxView #MacOSXProgressWidgetView #MacOSXScrollBar #MacOSXSliderView #MacOSXSpinBox #MacOSXTabControlBarView #MacOSXMenuController #MacOSXMenuAsPopUpController #MacOSXMenuAsSubmenuController #MacOSXMenuFromMenuBarController ) collect: [ :nm | nm asQualifiedReference valueOrDo: [ "debug -- Transcript cr; show: nm." nil ] ]
defaultMethodsDeleted "Answer the methods which will be deleted by default" "Right now there are no such methods. This method is here for future patches" ^ IdentityDictionary new
defaultMethodsKept "Answer the methods which will be kept by default" | kept | cachedDefaults notNil and: [ cachedDefaults at: #defaultMethodsKept ifPresent: [:answer | ^answer]]. kept := self defaultMethodsKeptVW. cachedDefaults isNil ifFalse: [cachedDefaults at: #defaultMethodsKept put: kept]. ^kept.
defaultMethodsKeptVW "Answer the methods which will be kept by default" | keptMethodDict sels | keptMethodDict := IdentityDictionary new. self defaultClassesKeptVWWithSubclassesAndAllMethods do: [:class | sels := class selectors. sels isEmpty ifFalse: [(keptMethodDict at: class ifAbsentPut: [Set new]) addAll: sels]. sels := class class selectors. sels isEmpty ifFalse: [(keptMethodDict at: class class ifAbsentPut: [Set new]) addAll: sels]]. ^keptMethodDict
defaultMotifClassesDeleted "Answer the names of UILook specific classes to be deleted" ^ #( #HPFeelPolicy #MotifFeelPolicy #MotifInsertionPoint #SunFeelPolicy #MotifActionButtonView #MotifBorderDecorationPolicy #MotifCheckButtonView #MotifComboBoxButtonView #MotifLookPolicy #MotifMenuBar #MotifMenuBarButtonView #MotifMenuButtonView #MotifMenuItemSeparatorComponent #MotifMenuItemView #MotifMenuView #MotifRadioButtonView #MotifScrollBar #MotifScrollerButton #MotifSpinButtonView #MotifWidgetPolicy ) collect: [ :nm | nm asQualifiedReference valueOrDo: [ "debug -- Transcript cr; show: nm. " nil ] ]
defaultOpenLookClassesDeleted "Answer the names of UILook specific classes to be deleted" ^ #( #OpenLookActionButtonView #OpenLookBorderDecorationPolicy #OpenLookCheckButtonView #OpenLookHorizontalScrollbar #OpenLookLabeledButtonView #OpenLookMenuBarButtonView #OpenLookMenuButtonController #OpenLookMenuTracker #OpenLookMenuView #OpenLookPolicy #OpenLookRadioButtonView #OpenLookScrollBar #OpenLookScrollBarController #OpenLookVerticalScrollbar #OpenLookWidgetPolicy ) collect: [ :nm | nm asQualifiedReference valueOrDo: [] ]
defaultOSClassesDeleted "Answer the classes to be deleted given the supported operating systems" | classes | classes := Set new: 31. options osWindows | options osOS2 ifFalse: [ classes addAll: self defaultPCClassesDeleted ]. options osMac ifFalse: [ classes addAll: self defaultMacClassesDeleted ]. options osUnix ifFalse: [ classes addAll: self defaultUnixClassesDeleted ]. ^ classes
defaultPackageNamesDeleted "Answer the names of packages to be completely deleted when using VisualWorks." ^#("These are in the Base VisualWorks bundle." 'Tools-Differences' 'Tools-Inspector' 'Tools-Misc' 'Tools-NameSpaces' "These are in Tools-IDE bundle." 'Tools-Trippy' 'Tools-Workspace' 'Tools-Parcel Manager' 'Tools-File Browser' 'Tools-Changes' 'Tools-Settings-VW' 'Tools-Settings' 'Tools-IDE-ListIcons' "These are not in a bundle." 'OldBrowsers')
defaultPackageNamesKept "Answer the names of packages to be completely kept by default when using VisualWorks." ^#()
defaultPackagesDeleted "Answer the packages or bundles to be completely deleted by default when using VisualWorks." | fromBundles fromPackages | fromBundles := (self defaultBundleNamesDeleted collect: [:each | Store.Registry bundleNamed: each]) inject: OrderedCollection new into: [:sum :each | sum addAll: each leafItems. sum]. fromPackages := self defaultPackageNamesDeleted collect: [:each | Store.Registry packageNamed: each]. ^fromBundles, (fromPackages select: [:each | each notNil]).
defaultPackagesKept "Answer the packages or bundles to be completely kept by default when using VisualWorks." | fromBundles fromPackages | fromBundles := (self defaultBundleNamesKept collect: [:each | Store.Registry bundleNamed: each]) inject: OrderedCollection new into: [:sum :each | sum addAll: each leafItems. sum]. fromPackages := self defaultPackageNamesKept collect: [:each | Store.Registry packageNamed: each]. ^fromBundles, (fromPackages select: [:each | each notNil]).
defaultPCClassesDeleted "Answer the names of os specific classes to be deleted" ^ #( #FATFilename #HPFSFilename #NTFSFilename #PCDiskFileAccessor #PCFilename #PCIOAccessor " the following are strictly VW 1 classes but will be ignored in VW 2" #DOSDiskFileAccessor #DOSFilename #DOSIOAccessor #OS2FatFilename #OS2Filename #OS2IOAccessor " the following are VW3 only" #OS2SystemSupport #Win32sSystemSupport #Win95SystemSupport #WinNTSystemSupport ) collect: [ :nm | nm asQualifiedReference valueOrDo: [] ]
defaultPDPClassesDeleted "Answer the names of PDP specific classes to be deleted" ^ (#{Smalltalk.CraftedSmalltalk} valueOrDo:[#()]) asArray
defaultRBClassesDeleted "Answer the names of RB specific classes to be deleted" ^ (#{Refactory.Browser} valueOrDo:[#()]) asArray
defaultStartupClasses "Answer the classes that are dependents of ObjectMemory or otherwise referenced dynamically in system startup" | kept | kept := IdentitySet new: 17. " get the current dependents of ObjectMemory " ObjectMemory dependents do: [ :obj | obj isBehavior ifFalse: [ obj class isObsolete ifFalse: [ kept add: obj class ] ] ifTrue: [ obj isMeta ifTrue: [ obj isObsolete ifFalse: [ kept add: obj soleInstance ] ] ifFalse: [ ( ( obj isKindOf: Class ) and: [ obj isObsolete not ] ) ifTrue: [ kept add: obj ] ] ] ]. ^kept
defaultUILookClassesDeleted "Answer the classes to be deleted given the supported operating systems" | classes | classes := Set new: 31. options uiLookWindows ifFalse: [ classes addAll: self defaultWindowsClassesDeleted ]. options uiLookMac ifFalse: [ classes addAll: self defaultMacUIClassesDeleted ]. options uiLookCUA ifFalse: [ classes addAll: self defaultCUAClassesDeleted ]. options uiLookMotif ifFalse: [ classes addAll: self defaultMotifClassesDeleted ]. options uiLookOpenLook ifFalse: [ classes addAll: self defaultOpenLookClassesDeleted ]. ^ classes
defaultUnixClassesDeleted "Answer the names of os specific classes to be deleted" ^ #( #UnixDiskFileAccessor #UnixFilename #UnixIOAccessor #UnixPipeAccessor #UnixProcess #UnixSystemSupport #X11InputManager ) collect: [ :nm | nm asQualifiedReference valueOrDo: [] ]
defaultWindowsClassesDeleted "Answer the names of UILook specific classes to be deleted" ^ #( "Note: Win3* classes are obsolete, and typically will not be in the image." #Win3ActionButtonView #Win3Border #Win3BorderDecorationPolicy #Win3CheckButtonView #Win3ComboBoxButtonView #Win3FeelPolicy #Win3LookPolicy #Win3MenuBar #Win3MenuBarButtonView #Win3MenuButtonView #Win3MenuItemView #Win3MenuView #Win3RadioButtonView #Win3ScrollBar #Win3SliderView #Win3SpinButtonView #Win3WidgetPolicy "Note: Win4* classes are obsolete, and typically will not be in the image." #Win4ActionButtonView #Win4Border #Win4BorderDecorationPolicy #Win4CheckButtonView #Win4ComboBoxButtonView #Win4FeelPolicy #Win4LookPolicy #Win4MenuBar #Win4MenuBarButtonView #Win4MenuButtonView #Win4MenuItemView #Win4MenuView #Win4RadioButtonView #Win4ScrollBar #Win4SliderView #Win4SpinButtonView #Win4WidgetPolicy #Win95ActionButtonView #Win95Border #Win95BorderDecorationPolicy #Win95CheckButtonView #Win95ComboBoxButtonView #Win95FeelPolicy #Win95GroupBox #Win95LookPolicy #Win95MenuAsPopUpController #Win95MenuAsSubmenuController #Win95MenuBar #Win95MenuBarButtonController #Win95MenuBarButtonView #Win95MenuBorder #Win95MenuButtonController #Win95MenuButtonView #Win95MenuController #Win95MenuFromMenuBarController #Win95MenuFromMenuButtonController #Win95MenuItemController #Win95MenuItemView #Win95MenuView #Win95PassiveLabel #Win95RadioButtonView #Win95ScrollBar #Win95SliderView #Win95SpinButtonView #Win95TabControlBarView #Win95TableDecorator #Win95VariableBorder #Win95WidgetPolicy #Win98LookPolicy #Win98MenuBar #Win98MenuBarButtonController #Win98MenuBarButtonView #Win98ToolBar #Win98ToolbarButtonController #Win98ToolbarButtonView #Win98WidgetPolicy #WinXPBorder #WinXPComboBoxButtonController #WinXPComboBoxButtonView #WinXPMarkerScrollBarTracker #WinXPProgressWidgetView #WinXPRadioButtonController #WinXPRoundedEdgeBorder #WinXPScrollBarController #WinXPSliderController #WinXPSliderTracker #WinXPSpinButtonController #WinXPToggleButtonController #WinXPTriggerButtonController #WinXPVisualPairButton ) collect: [ :nm | nm asQualifiedReference valueOrDo: [ "debug -- Transcript cr; show: nm. " nil ] ]
</methods> <methods> RuntimePackager.RuntimeBuilderItems <category>actions</category>
adjustForVersion: aVersion "If we are loading a specification from a different version, reset all of the default kept classes, because they may not be correct. This may cause a bit more to be kept than is strictly necessary, but will avoid the situation of new, important code being stripped because you loaded a packager spec from an older version. For example, older specifications loaded into 7.3 would strip the entire subsystem hierarchy." aVersion < RuntimeManager vwVersion ifFalse: [^self]. self defaultMethodsKept keysAndValuesDo: [:eachClass :eachSelectorSet | (keptMethods at: eachClass ifAbsentPut: [Set new]) addAll: eachSelectorSet. deletedMethods at: eachClass ifPresent: [:set | deletedMethods at: eachClass put: set - eachSelectorSet]. unreferencedMethods at: eachClass ifPresent: [:set | unreferencedMethods at: eachClass put: set - eachSelectorSet]]. keptClasses addAll: self defaultClassesKept. self defaultClassesKept do: [:each | deletedClasses remove: each ifAbsent: []. unreferencedClasses remove: each ifAbsent: []]
ensureValidHierarchy "Make sure that no classes are kept while their superclasses are deleted. Resolve any differences in favor of kept classes." | namespaces | namespaces := OrderedCollection new. keptClasses do: [:eachClass | eachClass withAllSuperclasses do: [:eachSubclass | self dontDeleteClass: eachSubclass. unreferencedClasses remove: eachSubclass ifAbsent: []. self addNameSpace: eachSubclass environment into: namespaces]]. namespaces do: [:each | self dontDeleteGlobal: each].
resetDefaultsFromOptions "Set default values for classes where the default status is affected by option " | wasReset defaultClasses newDeleted newKept | " reset the results of any previous references scan " wasReset := self canBeReset not. self resetUnreferencedItems. defaultClasses := IdentitySet new: 37. defaultClasses addAll: self defaultCompilerClassesDeleted; addAll: self defaultCUAClassesDeleted; addAll: self defaultMacClassesDeleted; addAll: self defaultMacUIClassesDeleted; addAll: self defaultMotifClassesDeleted; addAll: self defaultOpenLookClassesDeleted; addAll: self defaultPCClassesDeleted; addAll: self defaultUnixClassesDeleted; addAll: self defaultWindowsClassesDeleted; addAll: self defaultRBClassesDeleted; addAll: self defaultPDPClassesDeleted. " sift out defaults to see what should be changed " newDeleted := self defaultClassesDeleted select: [ :x | defaultClasses includes: x ]. newKept := self defaultClassesKept select: [ :x | defaultClasses includes: x ]. " adjust kept and deleted collections. Leave globals and methods alone since they are not affected by the options selections. " defaultClasses do: [ :cl | deletedClasses remove: cl ifAbsent: []. keptClasses remove: cl ifAbsent: [] ]. deletedClasses addAll: newDeleted. keptClasses addAll: newKept. self includeStartupCode. " ensure that kept classes are not deleted in their superclasses" self ensureValidHierarchy. " notify interested parties that things have changed." wasReset ifTrue: [ self changed. ]. self refresh.
resetUnreferencedItems "Reset fields associated with storing unreferenced classes, methods, and globals" unreferencedMethods := IdentityDictionary new. unreferencedClasses := IdentitySet new. unreferencedGlobals := IdentitySet new.
setDefaultValues "Set default values for classes and methods " | wasReset | wasReset := self canBeReset not. self resetUnreferencedItems. "Do packages first, so that specific items listed overrule them." self defaultPackagesDeleted do: [:each | self deleteAllInPundle: each]. self defaultPackagesKept do: [:each | self keepAllInPundle: each]. self defaultClassesDeleted do: [:each | self deleteClass: each]. self defaultClassesKept do: [:each | self keepClass: each]. self defaultGlobalsKept do: [:each | self keepGlobal: each]. self defaultGlobalsDeleted do: [:each | self deleteGlobal: each]. self defaultMethodsKept keysAndValuesDo: [:eachClass :selectors | selectors do: [:eachSelector | self keepSelector: eachSelector inClass: eachClass]]. self defaultMethodsDeleted keysAndValuesDo: [:eachClass :selectors | selectors do: [:eachSelector | self deleteSelector: eachSelector inClass: eachClass]]. self includeStartupCode. " ensure that kept classes are not deleted in their superclasses" self ensureValidHierarchy. " notify interested parties that things have changed." wasReset ifTrue: [ self changed. ]. self refresh.
</methods> <methods> RuntimePackager.RuntimeBuilderItems <category>internal</category>
addNameSpace: aNameSpace into: aCollection "Add the given name space (or class) into the list of global bindings that we have known unique references for. To make sure we've got everything, also add its parents to the list, walking backwards until we get to either Smalltalk or Root." | binding | (aNameSpace == Root or: [aNameSpace == Smalltalk]) ifTrue: [^self]. aNameSpace isBehavior ifFalse: [binding := aNameSpace environment fullyQualifiedReference append: aNameSpace name. binding := binding asSimplestReference. binding := self uniqueReferenceFor: binding. (aCollection includes: binding) ifFalse: [aCollection add: binding]]. self addNameSpace: aNameSpace environment into: aCollection.
addSharedVariablesFor: aStoreModelCollection into: aCollection aStoreModelCollection do: [:each | self addNameSpace: each value into: aCollection. each datumDescriptors do: [:eachDescriptor | aCollection add: (self uniqueReferenceFor: eachDescriptor)]].
uniqueReferenceFor: aStoreDescriptorOrBinding "We need a way of normalizing the bindings we hold for shared variables and namespaces so that we can just know we're dealing with unique instances, simplifying the tests for equality. We do that by holding a set of bindings and normalizing each reference to an instance in that set." | uniqueReference reference subCollection | aStoreDescriptorOrBinding isBindingReference ifTrue: [reference := aStoreDescriptorOrBinding] ifFalse: [reference := aStoreDescriptorOrBinding nameSpace fullyQualifiedReference. aStoreDescriptorOrBinding isForData ifTrue: [reference := reference append: aStoreDescriptorOrBinding dataKey]]. subCollection := globalBindings at: reference name ifAbsentPut: [OrderedCollection new]. uniqueReference := subCollection detect: [:x | x = reference] ifNone: [subCollection add: reference. reference]. ^uniqueReference.
validateDeletableClasses: classes "Validate that the set of classes provided can be moved to the deleted category without causing an error in which a subclass is kept while its superclass is deleted. Answer an ordered collection of any classes in error." ^classes select: [:eachClass | eachClass withAllSubclasses anySatisfy: [ :eachSubclass | self keptClasses includes: eachSubclass ]].
</methods> <methods> RuntimePackager.RuntimeBuilderItems <category>keeping/deleting</category>
defaultAllInPundle: aPundle | methods | aPundle definedClasses do: [:each | self keepClass: each]. "If the class is extended, and we're keeping methods, then we need to keep the class too, but don't actually move them into kept, just make sure they're not explicitly deleted." aPundle extendedClasses do: [:each | self dontDeleteClass: each]. aPundle data do: [:each | self keepGlobal: each]. aPundle nameSpacesDefinedInPackage , aPundle nameSpacesExtendedInPackage do: [:each | self keepGlobal: each]. methods := aPundle methods. methods do: [:each | self keepSelector: each selector inClass: each implementingClass].
deleteAllInPundle: aPundle | methods | aPundle definedClasses do: [:each | self deleteClass: each]. "Note that we don't have to do anything for extended classes here. If they were contingent on just us, then presumably they will go away when all their methods do. If others use them, they won't" aPundle data do: [:each | self deleteGlobal: each]. aPundle nameSpacesDefinedInPackage, aPundle nameSpacesExtendedInPackage do: [:each | self deleteGlobal: each]. methods := aPundle methods. methods do: [:each | self deleteSelector: each selector inClass: each implementingClass].
deleteClass: aClass self dontKeepClass: aClass. deletedClasses add: aClass.
deleteGlobal: aBindingReference | uniqueReference | uniqueReference := self uniqueReferenceFor: aBindingReference. self dontKeepGlobal: uniqueReference. deletedGlobals add: uniqueReference.
deleteSelector: aSymbol inClass: aBehavior self dontKeepSelector: aSymbol inClass: aBehavior. (self deletedMethods at: aBehavior ifAbsentPut: [Set new]) add: aSymbol.
dontDeleteClass: aClass deletedClasses remove: aClass ifAbsent: [].
dontDeleteGlobal: aBindingReference | uniqueReference | uniqueReference := self uniqueReferenceFor: aBindingReference. deletedGlobals remove: uniqueReference ifAbsent: [].
dontDeleteSelector: aSymbol inClass: aBehavior | selectors | selectors := self deletedMethods at: aBehavior ifAbsent: [^self]. selectors remove: aSymbol ifAbsent: []. selectors isEmpty ifTrue: [self deletedMethods removeKey: aBehavior].
dontKeepClass: aClass keptClasses remove: aClass ifAbsent: [].
dontKeepGlobal: aBindingReference | uniqueReference | uniqueReference := self uniqueReferenceFor: aBindingReference. self keptGlobals remove: uniqueReference ifAbsent: [].
dontKeepSelector: aSymbol inClass: aBehavior | selectors | selectors := self keptMethods at: aBehavior ifAbsent: [^self]. selectors remove: aSymbol ifAbsent: []. selectors isEmpty ifTrue: [self keptMethods removeKey: aBehavior].
includeStartupCode "Make sure that we're not going to explicitly delete anything that we're told is startup code. Most important for the fairly trivial test case of packaging up SimpleWorkspace." | package | self options startupMethod isNil ifTrue: [^self]. self keepClass: self options startupClass. self keepSelector: self options startupMethod inClass: self options startupClass class. "Make all the methods in the containing package of the startup method be contingent." package := Store.Registry containingPackageForSelector: self options startupMethod class: self options startupClass class. (package methodsForClassNamed: self options startupClass absoluteName meta: true), (package methodsForClassNamed: self options startupClass absoluteName meta: false) do: [:each | self dontDeleteSelector: each selector inClass: each implementingClass].
keepAllInPundle: aPundle | methods | aPundle definedClasses do: [:each | self keepClass: each]. "If the class is extended, and we're keeping methods, then we need to keep the class too, but don't actually move them into kept, just make sure they're not explicitly deleted." aPundle extendedClasses do: [:each | self dontDeleteClass: each]. aPundle data do: [:each | self keepGlobal: each]. aPundle nameSpacesDefinedInPackage , aPundle nameSpacesExtendedInPackage do: [:each | self keepGlobal: each]. methods := aPundle methods. methods do: [:each | self keepSelector: each selector inClass: each implementingClass].
keepClass: aClass self dontDeleteClass: aClass. keptClasses add: aClass.
keepGlobal: aBindingReference | uniqueReference | uniqueReference := self uniqueReferenceFor: aBindingReference. self dontDeleteGlobal: uniqueReference. self keptGlobals add: uniqueReference.
keepSelector: aSymbol inClass: aBehavior self dontDeleteSelector: aSymbol inClass: aBehavior. (self keptMethods at: aBehavior ifAbsentPut: [Set new]) add: aSymbol.
makeAllInPundleContingent: aPundle | methods | aPundle definedClasses do: [:each | self dontKeepClass: each. self dontDeleteClass: each]. "If the classes are extended, and we're making methods contingent, then we may need to keep the classes too, but don't actually move them into kept, just make sure they're not explicitly deleted." aPundle extendedClasses do: [:each | self dontDeleteClass: each]. aPundle data do: [:each | self dontKeepGlobal: each. self dontDeleteGlobal: each]. aPundle nameSpacesDefinedInPackage, aPundle nameSpacesExtendedInPackage do: [:each | self dontKeepGlobal: each. self dontDeleteGlobal: each]. methods := aPundle methods. methods do: [:each | self dontKeepSelector: each selector inClass: each implementingClass. self dontDeleteSelector: each selector inClass: each implementingClass].
resetToDefaults: packages "Reset the packages or bundles to default values leaving other classes and globals as they were." | hierarchyErrors | self withDefaultsDo: [packages do: [:each | self resetToDefaultsForPackage: each]. " ensure that the class hierarchy is valid -- resolve in favor of kept classes " hierarchyErrors := self validateDeletableClasses: self deletedClasses. hierarchyErrors do: [:each | self dontDeleteClass: each]]. self includeStartupCode.
resetToDefaultsForClass: aClass self dontDeleteClass: aClass. self dontKeepClass: aClass. self deletedMethods removeKey: aClass ifAbsent: [ ]. self deletedMethods removeKey: aClass class ifAbsent: [ ]. self keptMethods removeKey: aClass ifAbsent: [ ]. self keptMethods removeKey: aClass class ifAbsent: [ ]. (self defaultClassesDeleted includes: aClass ) ifTrue: [ self deleteClass: aClass]. (self defaultClassesKept includes: aClass ) ifTrue: [ self keepClass: aClass ]. (self defaultMethodsDeleted includesKey: aClass ) ifTrue: [ self deletedMethods at: aClass put: ( self defaultMethodsDeleted at: aClass ) copy. ]. (self defaultMethodsDeleted includesKey: aClass class ) ifTrue: [ self deletedMethods at: aClass class put: ( self defaultMethodsDeleted at: aClass class ) copy. ]. (self defaultMethodsKept includesKey: aClass ) ifTrue: [ self keptMethods at: aClass put: ( self defaultMethodsKept at: aClass ) copy. ]. (self defaultMethodsKept includesKey: aClass class ) ifTrue: [ self keptMethods at: aClass class put: ( self defaultMethodsKept at: aClass class ) copy. ].
resetToDefaultsForPackage: aPackage "Reset the packages or bundles to default values leaving other classes and globals as they were." "Get current defaults and save them. Note that this does not really support defaults for methods. This only resets to contingent methods defined in the application." | shareds | aPackage isBundle ifTrue: [ aPackage allContainedItems do: [:each | self resetToDefaultsForPackage: each]. ^self]. "Reset classes based on defaults -- defined classes only" aPackage definedClasses do: [ :classToDefault | self resetToDefaultsForClass: classToDefault]. "It's easier to find all the shareds at once, and some are global to the package, rather than associated with a class, so do them all here." shareds := OrderedCollection new. self addSharedVariablesFor: aPackage extendedClassModels into: shareds. self addSharedVariablesFor: aPackage definedClassModels into: shareds. self addSharedVariablesFor: aPackage definedNameSpaceModels into: shareds. self addSharedVariablesFor: aPackage extendedNameSpaceModels into: shareds. aPackage nameSpaceModels do: [:each | shareds add: (self uniqueReferenceFor: each)]. shareds do: [ :glName | self dontDeleteGlobal: glName. self dontKeepGlobal: glName. (self defaultGlobalsDeleted includes: glName ) ifTrue: [ self deleteGlobal: glName]. (self defaultGlobalsKept includes: glName ) ifTrue: [ self keepGlobal: glName ] ].
withDefaultsDo: aBlock "Do a calculation that makes use of our defaults (which can be moderately expensive to calculate). Cache them for the duration of the calculation, and then throw them away at the end." cachedDefaults := Dictionary new. aBlock ensure: [cachedDefaults := nil].
</methods> <methods> RuntimePackager.RuntimeBuilderItems <category>testing</category>
canBeReset "Answer true if values can be reset without causing side effects" ^super canBeReset and: [self hasComputedUnreferencedItems not]
hasComputedUnreferencedItems ^self unreferencedMethods notEmpty or: [self unreferencedClasses notEmpty or: [self unreferencedGlobals notEmpty]].
isDeletedSelector: aSymbol in: aBehavior "Answer true if aSymbol names a deleted method in the behavior" ^( self deletedMethods at: aBehavior ifAbsent: [ #( ) ] ) includes: aSymbol
isKeptSelector: aSymbol in: aBehavior "Answer true if aSymbol names a kept method in the behavior" ^( self keptMethods at: aBehavior ifAbsent: [ #( ) ] ) includes: aSymbol
</methods> <methods> RuntimePackager.RuntimeBuilderItems <category>initialize-release</category>
initialize "Initialize an instance with dummy values" super initialize. deletedClasses := IdentitySet new. keptClasses := IdentitySet new. deletedMethods := IdentityDictionary new. keptMethods := IdentityDictionary new. deletedGlobals :=Set new. keptGlobals := Set new. globalBindings := Dictionary new. self resetUnreferencedItems.
</methods> <methods> RuntimePackager.RuntimeBuilderItems <category>updating</category>
optionsThatAffectKeptItems ^#(#removeCompiler #operatingSystems #uiLooks #startupClass #startupMethod).
update: aspect with: aParam from: anObject "Note the effects of a change" | dialogPrompt | " look for options changes in which the aspects are identified " (aspect == #values and: [anObject == options and: [aParam anySatisfy: [:each | self optionsThatAffectKeptItems includes: each]]]) ifTrue: [self canBeReset ifTrue: [self setDefaultValues. hasBeenEdited := false] ifFalse: [dialogPrompt := 'Changes to options can affect default kept and deleted classes. Do you want to reset the status of classes affected by options at this time? If you do not reset these items to defaults now, you can do so in the next step or at a later time.'. self isBeingChanged ifTrue: [dialogPrompt := dialogPrompt , '\Warning: pending changes to classes kept and deleted will be lost if you reset to defaults now.' withCRs]. (Dialog choose: dialogPrompt labels: #('Reset to defaults' 'Do not reset now') values: #(#reset #noReset) default: #reset) == #reset ifTrue: [self resetDefaultsFromOptions. hasBeenEdited := false]]]. ^super update: aspect with: aParam from: anObject.
</methods> <methods> RuntimePackager.RuntimeBuilderItems <category>copying</category>
copyFrom: aRuntimeBuilderItems super copyFrom: aRuntimeBuilderItems. deletedClasses := aRuntimeBuilderItems deletedClasses. keptClasses := aRuntimeBuilderItems keptClasses. deletedMethods := aRuntimeBuilderItems deletedMethods. keptMethods := aRuntimeBuilderItems keptMethods. deletedGlobals := aRuntimeBuilderItems deletedGlobals. keptGlobals := aRuntimeBuilderItems keptGlobals. options := aRuntimeBuilderItems options.
postCopy super postCopy. deletedClasses := deletedClasses copy. keptClasses := keptClasses copy. deletedMethods := deletedMethods copy. deletedMethods keysAndValuesDo: [:eachKey :eachValue | deletedMethods at: eachKey put: eachValue copy]. keptMethods := keptMethods copy. keptMethods keysAndValuesDo: [:eachKey :eachValue | keptMethods at: eachKey put: eachValue copy]. deletedGlobals := deletedGlobals copy. keptGlobals := keptGlobals copy. unreferencedClasses := unreferencedClasses copy. unreferencedGlobals := unreferencedGlobals copy. unreferencedMethods := unreferencedMethods copy. options := options copy.
</methods> <methods> RuntimePackager.RuntimeInstanceSurrogate <category>basic methods</category>
== anObject "Perform the same function as Object>>==. This is needed to keep surrogates in an IdentitySet or IdentityDictionary." <primitive: 110> self primitiveFailed
doesNotUnderstand: aMessage "Relay the message to the surrogate manager to force the receiver's class to be restored to its normal state before resending the message." ^RuntimeSurrogateManager activeManager interceptedInstanceMessage: aMessage receiver: self
identityHash "Perform the same function as Object>>identityHash" <primitive: 75> self primitiveFailed
isNil "Provide the standard answer of false" ^false
notNil "Provide the standard answer of true" ^true
primitiveFailed "Indicate that a primitive failed" ^Object errorSignal raiseErrorString: 'Primitive failed in a behavior surrogate'
rtpClass "Answer the object which is the receiver's class. This form of the message is used by the manager to get access to the real class" <primitive: 111> ^self primitiveFailed
</methods> <methods> RuntimePackager.RuntimeClassSurrogate <category>basic methods</category>
class "Treat as a doesNotUnderstand situation. Logic can be added here if there are exceptions to this general rule." " treat as a doesNotUnderstand situation " ^RuntimeSurrogateManager activeManager interceptedClassMessage: ( Message selector: #class ) receiver: self
doesNotUnderstand: aMessage "Relay the message to the surrogate manager to force the receiver to be restored to its normal state before resending the message." ^RuntimeSurrogateManager activeManager interceptedClassMessage: aMessage receiver: self
instVarAt: anInteger put: anObject "Perfrom the same function as Object>>instVarAt:put:" <primitive: 74> ^self primitiveFailed
rtpInstVarAt: index "Answer the instance variable. See the normal instVarAt: implementation." <primitive: 73> ^self primitiveFailed
</methods> <methods> RuntimePackager.RuntimeClassSurrogate <category>behavior methods</category>
flushVMmethodCache "Perform the same function as Behavior>>flushVMmethodCache" <primitive: 89> self primitiveFailed
format "Answer the behaviors format -- needed to validate method hooking" ^self rtpInstVarAt: 3
name "Answer the class name by direct access to the variable" ^self rtpInstVarAt: 7
</methods> <methods> RuntimePackager.RuntimeClassSurrogate <category>scanner methods</category>
isLiteralSymbol: aSymbol "Symbol>>storeOn: sends this message to Scanner class if it is present. When Scanner is hooked, it is still in the SystemDictionary and would thus get the message. One case where this occurs is when an exception occurs, as for example, in RuntimeSurrogateManager>>unhookClass:. Supply an appropriate response to avoid circular unhooking of Scanner." ^false
</methods> <methods> RuntimeApplicationStartupSystem <category>startup</category>
main RuntimePackager.RuntimeManager startupApplication.
</methods> <methods> RuntimePackager.RuntimeHeadlessExample class <category>actions</category>
openDialog "Open a dialog, which is an error in the headless environment" Dialog warn: 'RuntimeHeadlessExample class>>openDialog executed'.
writeExampleFile "Write a file containing some indication that the function was performed" | file | file := 'rtpexmpl.txt' asFilename writeStream. file nextPutAll: 'RuntimeHeadlessExample was executed '; nextPutAll: Date today printString; space; nextPutAll: Time now printString; cr. file close.
</methods> <methods> RuntimePackager.RuntimeHeadlessExample class <category>parcel actions</category>
postLoadActionFor: aParcel "Open the application when it is loaded from a Parcel" self writeExampleFile.
</methods> <methods> RuntimePackager.RuntimeDeletedBehavior <category>error handling</category>
doesNotUnderstand: aMessage "Raise a signal indicating that a messsage was sent to a deleted behavior." ^RuntimeDeletedBehavior deletedBehaviorReferencedSignal raiseWith: ( MessageSend receiver: self selector: aMessage selector arguments: aMessage arguments ) errorString: 'A deleted Behavior was referenced: ', self originalName.
</methods> <methods> RuntimePackager.RuntimeDeletedBehavior <category>file in</category>
evaluate: x logged: y "Can not do evaluate, so just answer self to pick up further messages" ^self
scanFrom: x "Can not really do this function when compiler is not present. Answer nil" ^ nil
</methods> <methods> RuntimePackager.RuntimeDeletedBehavior <category>startup-shutdown</category>
exiting "Ignore message to an application on image exit" ^self
restart "Ignore message to application when image is being restarted" ^self
saving "Ignore message to application when image is being saved" ^self
shutDown "Ignore message to application when image is being shut down" ^self
startUp "Ignore message to application when image is being started" ^self
</methods> <methods> RuntimePackager.RuntimeDeletedBehavior <category>parsing</category>
flushCachedParser "Simulate the method called during finalization of CDeclarationParser" ^self
preferredParserClass "If Compiler is deleted, try to redirect to Parser" ^Parser
</methods> <methods> RuntimePackager.RuntimeDeletedBehavior <category>initialization</category>
initialize "Perform a dummy class initialize (may be used on image start)" ^self
initializeDeletedClass "Initialize a new instance" superclass := RuntimeDeletedInstance. methodDict := self class dummyMethodDictionary.
initializeDeletedMetaclass "Initialize an instance for a metaclass" self initializeDeletedClass. superclass := Metaclass.
install "Perform a dummy class initialize (may be used on image start)" ^self
installOn: aPlatform "Perform a dummy class initialize (may be used on image start)" ^self
localize "Ignore attempts to localize the class for a locale. This is sent to ENVY/Developer Applications, for example." ^self
</methods> <methods> RuntimePackager.RuntimeDeletedBehavior <category>accessing</category>
instanceBehavior "Answer the source of instance behavior for this deleted behavior." ^self
name "Answer a name string indicative of the object" ^ '(deleted) ', originalName, ( superclass == Metaclass ifFalse: [ '' ] ifTrue: [ ' class' ] )
originalName "Answer the original class name" ^originalName
setOriginalName: aString "Set the original class name so that references can be debugged" originalName := aString copy.
shortName "Answer a name string indicative of the object" ^ self name
</methods> <methods> RuntimePackager.RuntimeDeletedBehavior <category>testing</category>
isManaged "Allow former ENVY/Developer subApplications to be ignored" ^false
isPublic "Always consider deleted behaviors as private. This is a partial fix to the problem of updating all cross references when classes are deleted from ENVY/Developer applications. This prevents the application from answering deleted classes to messages such as allLocalClasses. The more general problem rarely happens." ^false
needsSafeRebinding "Answer true to force rebinding of any reference to a deleted item" ^true
</methods> <methods> RuntimePackager.RuntimeDeletedBehavior <category>printing</category>
printOn: aStream "Add the behavior' name to the stream" aStream nextPutAll: self name.
</methods> <methods> RuntimePackager.RuntimeDeletedBehavior class <category>Signal constants</category>
deletedBehaviorReferencedSignal "Answer the appropriate signal" DeletedBehaviorReferencedSignal isNil ifTrue: [ DeletedBehaviorReferencedSignal := Object errorSignal newSignal notifierString: 'A deleted Behavior was referenced'; nameClass: self message: #deletedBehaviorReferencedSignal. ]. ^DeletedBehaviorReferencedSignal
</methods> <methods> RuntimePackager.RuntimeDeletedBehavior class <category>accessing</category>
dummyMethodDictionary "Answer a sharable empty method dictionary" DummyMethodDictionary isNil ifTrue: [ DummyMethodDictionary := MethodDictionary new ]. ^DummyMethodDictionary
</methods> <methods> RuntimePackager.RuntimeDeletedBehavior class <category>instance creation</category>
forDeletedInstance: aClass "answer a new behavior to be used as a behavior for replacement instances of the class provided." ^super new initializeDeletedClass setOriginalName: aClass fullName; setInstanceFormat: RuntimeDeletedInstance format.
new "This is an error if used" ^self shouldNotImplement
onDeletedClass: aClass "answer a new behavior patterned on the behavior provided" ^super new initializeDeletedClass setOriginalName: aClass fullName; setInstanceFormat: aClass format
onDeletedMetaclass: aMetaclass "answer a new behavior patterned on the behavior provided" ^super new initializeDeletedMetaclass setOriginalName: aMetaclass soleInstance fullName; setInstanceFormat: aMetaclass format
</methods> <methods> RuntimePackager.RuntimeBuilderMemoryParams <category>accessing</category>
codeSize ^codeSize
codeSize: anInteger codeSize := anInteger
edenSize ^edenSize
edenSize: anInteger edenSize := anInteger
editorClass "Answer the class that can edit this object" ^RuntimeBuilderMemoryParamEditor
fixedSize ^fixedSize
fixedSize: anObject fixedSize := anObject
growthLimit ^growthLimit
growthLimit: anInteger growthLimit := anInteger
incrementSize ^incrementSize
incrementSize: anInteger incrementSize := anInteger
largeSize ^largeSize
largeSize: anInteger largeSize := anInteger
memoryLimit ^memoryLimit
memoryLimit: anInteger memoryLimit := anInteger
oldSize ^oldSize
oldSize: anInteger oldSize := anInteger
retryDecrement ^retryDecrement
retryDecrement: anInteger retryDecrement := anInteger
stackSize ^stackSize
stackSize: anInteger stackSize := anInteger
survivorSize ^survivorSize
survivorSize: anInteger survivorSize := anInteger
</methods> <methods> RuntimePackager.RuntimeBuilderMemoryParams <category>load-save</category>
decodeFrom: tokens fileVersion: version "Decode the new value from the token array provided" | omSizes edenSizeOM survivorSizeOM largeSizeOM stackSizeOM codeSizeOM oldSizeOM mp incrementSizeMP retryDecrementMP growthLimitMP memoryLimitMP actionBlocks | " get sizes for possible conversion from fractions. version 1.0 files used absolute values while version 2.0 uses fractional numbers for ObjectMemory derived values" version >= 2.0 ifTrue: [ omSizes := ObjectMemory defaultSizesAtStartup. edenSizeOM := omSizes at: 1. survivorSizeOM := omSizes at: 2. largeSizeOM := omSizes at: 3. stackSizeOM := omSizes at: 4. codeSizeOM := omSizes at: 5. oldSizeOM := omSizes at: 6. mp := ObjectMemory currentMemoryPolicy. incrementSizeMP := mp preferredGrowthIncrement. retryDecrementMP := mp growthRetryDecrement. growthLimitMP := mp growthRegimeUpperBound. memoryLimitMP := mp memoryUpperBound. ] ifFalse: [ edenSizeOM := 1. survivorSizeOM := 1. largeSizeOM := 1. stackSizeOM := 1. codeSizeOM := 1. oldSizeOM := 1. incrementSizeMP := 1. retryDecrementMP := 1. growthLimitMP := 1. memoryLimitMP := 1. ]. " set up blocks to accept input values " actionBlocks := Dictionary new add: #codeSize -> [:val | codeSize := ( val * codeSizeOM ) rounded ]; add: #edenSize -> [:val | edenSize := ( val * edenSizeOM ) rounded ]; add: #growthLimit -> [:val | growthLimit := ( val * growthLimitMP ) rounded ]; add: #incrementSize -> [:val | incrementSize := ( val * incrementSizeMP ) rounded]; add: #largeSize -> [:val | largeSize := ( val * largeSizeOM ) rounded ]; add: #memoryLimit -> [:val | memoryLimit := ( val * memoryLimitMP ) rounded]; add: #oldSize -> [:val | oldSize := ( val * oldSizeOM ) rounded ]; add: #retryDecrement -> [:val | retryDecrement := ( val * retryDecrementMP ) rounded ]; add: #stackSize -> [:val | stackSize := ( val * stackSizeOM ) rounded ]; add: #survivorSize -> [:val | survivorSize := ( val * survivorSizeOM ) rounded ]; yourself. " assign values using action blocks " 1 to: tokens size by: 2 do: [ :index | (actionBlocks includesKey: ( tokens at: index ) ) ifFalse: [ Dialog warn: ( 'Invalid token "', (tokens at: index), '" found' ). ] ifTrue: [ (actionBlocks at: (tokens at: index)) value: (tokens at: index + 1). ] ]. " indicate values were changed " self refresh. hasBeenEdited := true. self changed.
encodeOn: aStream tab: tabCount "Encode the receiver onto a stream in a form suitable for decoding as a literal array. Values are encoded as fractions of the current system values" | omSizes edenSizeOM survivorSizeOM largeSizeOM stackSizeOM codeSizeOM oldSizeOM mp incrementSizeMP retryDecrementMP growthLimitMP memoryLimitMP | omSizes := ObjectMemory defaultSizesAtStartup. edenSizeOM := omSizes at: 1. survivorSizeOM := omSizes at: 2. largeSizeOM := omSizes at: 3. stackSizeOM := omSizes at: 4. codeSizeOM := omSizes at: 5. oldSizeOM := omSizes at: 6. mp := ObjectMemory currentMemoryPolicy. incrementSizeMP := mp preferredGrowthIncrement. retryDecrementMP := mp growthRetryDecrement. growthLimitMP := mp growthRegimeUpperBound. memoryLimitMP := mp memoryUpperBound. aStream crtab: tabCount; nextPutAll: 'codeSize '; print: codeSize asDouble / codeSizeOM; nextPutAll: ' "'; print: codeSize; nextPut:$"; crtab: tabCount; nextPutAll: 'edenSize '; print: edenSize asDouble / edenSizeOM; nextPutAll: ' "'; print: edenSize; nextPut:$"; crtab: tabCount; nextPutAll: 'growthLimit '; print: growthLimit asDouble / growthLimitMP; nextPutAll: ' "'; print: growthLimit; nextPut:$"; crtab: tabCount; nextPutAll: 'incrementSize '; print: incrementSize asDouble / incrementSizeMP; nextPutAll: ' "'; print: incrementSize; nextPut:$"; crtab: tabCount; nextPutAll: 'largeSize '; print: largeSize asDouble / largeSizeOM; nextPutAll: ' "'; print: largeSize; nextPut:$"; crtab: tabCount; nextPutAll: 'memoryLimit '; print: memoryLimit asDouble / memoryLimitMP; nextPutAll: ' "'; print: memoryLimit; nextPut:$"; crtab: tabCount; nextPutAll: 'oldSize '; print: oldSize asDouble / oldSizeOM; nextPutAll: ' "'; print: oldSize; nextPut:$"; crtab: tabCount; nextPutAll: 'retryDecrement '; print: retryDecrement asDouble / retryDecrementMP; nextPutAll: ' "'; print: retryDecrement; nextPut:$"; crtab: tabCount; nextPutAll: 'stackSize '; print: stackSize asDouble / stackSizeOM; nextPutAll: ' "'; print: stackSize; nextPut:$"; crtab: tabCount; nextPutAll: 'survivorSize '; print: survivorSize asDouble / survivorSizeOM; nextPutAll: ' "'; print: survivorSize; nextPut:$".
</methods> <methods> RuntimePackager.RuntimeBuilderMemoryParams <category>actions</category>
setDefaultValues "Set default memory value based on current values" | omSizes mp | "ObjectMemory derived sizes" omSizes := OrderedCollection new: 7. ObjectMemory defaultSizesAtStartup with: ObjectMemory sizesAtStartup do: [:size :multiplier | omSizes add: (size * multiplier asDouble) truncated]. edenSize := omSizes at: 1. survivorSize := omSizes at: 2. largeSize := omSizes at: 3. stackSize := omSizes at: 4. codeSize := omSizes at: 5. oldSize := omSizes at: 6. fixedSize := omSizes at: 7. "Memory Policy sizes" mp := ObjectMemory currentMemoryPolicy. incrementSize := mp preferredGrowthIncrement. retryDecrement := mp growthRetryDecrement. growthLimit := mp growthRegimeUpperBound. memoryLimit := mp memoryUpperBound. " notify interested parties " self changed.
</methods> <methods> RuntimePackager.RuntimeSurrogateManager <category>method hooking</category>
addSelectorQuietly: aSelector withMethod: aMethod to: aBehavior "Add the selector with the indicated method to a class or metaclass. The standard Behavior methods are not used because we do not want to trigger side-effects of changing instance methods. Similarly, this add is done without regard to validation considerations" | mdict | mdict := aBehavior instVarAt: 2. mdict at: aSelector put: aMethod. aBehavior flushVMmethodCacheEntriesFor: aSelector.
allHookedMethods "Answer a collection of all hooked methods. Look through all method dictionaries (watching out for those tricky dicts) and find the surrogates" | surrogates selectors meth | surrogates :=OrderedCollection new: 127. Smalltalk allBehaviorsDo: [ :behav | selectors := RuntimeManager selectorsInClass: behav. selectors do: [ :sel | meth := behav compiledMethodAt: sel ifAbsent: [ nil ]. meth class == RuntimeMethodSurrogate ifTrue: [ surrogates add: meth ] ] ]. ^surrogates
hookMethod: aMethod selector: aSymbol "Hook the compiled method so that notfication of its execution can be made." " watch out for special meta classes that are not one associated with the class " aMethod mclass isMeta ifTrue: [ aMethod mclass soleInstance class == aMethod mclass ifFalse: [ ^self "cannot unhook in this case" ] ]. ^self hookMethod: aMethod selector: aSymbol mclass: aMethod mclass
hookMethod: aMethod selector: aSymbol mclass: mclass "Hook the compiled method so that notfication of its execution can be made." | surrogate numArgs repl mcl numLit | " do not attempt to make a surrogate of an existing surrogate " aMethod class == RuntimeMethodSurrogate ifTrue: [ ^self ]. " only install the surrogate if the classes are compatible " mclass format = aMethod mclass format ifFalse: [ ^ self ]. "exempt classes are ignored as far as method hooking goes, except for Object" ( mclass ~~ Object and: [ self exemptClasses includes: mclass ] ) ifTrue: [ ^self ]. ( mclass isMeta and: [ mclass ~~ Object class and: [ self exemptClasses includes: mclass soleInstance ] ] ) ifTrue: [ ^ self ]. "do not attempt to hook marked methods" aMethod isMarked ifTrue: [ ^self ]. numArgs := aMethod numArgs. "surrogates are only available for up to 32 arguments" numArgs > 32 ifTrue: [ ^self ]. recursionLock critical: [ " build a surrogate method to go into the method dictionary" surrogate := ( surrogateMethods at: numArgs + 1 ) copy. surrogate mclass: mclass. "note that there are no blocks in the templates" surrogate sourcePointer: nil. aMethod mclass == mclass ifTrue: [ surrogate hookedMethod: aMethod. ] ifFalse: [ " relocate the template to a new class " repl := aMethod copy mclass: mclass. mcl := aMethod mclass. repl withAllBlockMethodsDo: [ :code | numLit := code numLiterals. 1 to: numLit do: [ :idx | ( code literalAt: idx ) == mcl ifTrue: [ code literalAt: idx put: mclass ] ] ]. surrogate hookedMethod: repl. ]. surrogate hookedSelector: aSymbol. " install the surrogate in the method dictionary " self addSelectorQuietly: aSymbol withMethod: surrogate to: mclass. ]. " end critical section "
hookSelector: selector in: aBehavior "Hook the method named by the selector. aBehavior must itself implement the method, that is, superclasses are not inspected" self hookMethod: ( aBehavior compiledMethodAt: selector ifAbsent: [ ^self error: 'Behavior supplied does not implement selector being hooked' ] ) selector: selector
unhookAllMethods "Unhook all methods known to be hooked at present. Look through all methods (watching out for the hidden dictionaries) and unhook any surrogates found" | selectors meth | Smalltalk allBehaviorsDo: [ :behav | selectors := RuntimeManager selectorsInClass: behav. selectors do: [ :sel | meth := behav compiledMethodAt: sel ifAbsent: [ nil ]. meth class == RuntimeMethodSurrogate ifTrue: [ self unhookMethod: meth ] ] ].
unhookMethod: surrogateMethod "Unhook the surrogate method by replacing it with the original method" | mclass hookedMethod sel | " make sure the class is unhooked first (class is not understood if hooked ) " mclass := surrogateMethod mclass. mclass class. " can only unhook methods that are really surrogates " surrogateMethod class == RuntimeMethodSurrogate ifFalse: [ ^self ]. " unhook the method by storing the original method in the method dictionary " recursionLock critical: [ sel := surrogateMethod hookedSelector. hookedMethod := surrogateMethod hookedMethod. self addSelectorQuietly: sel withMethod: hookedMethod to: surrogateMethod mclass. ]. " perform requested functions upon successful unhooking" unhookMethodBlock notNil ifTrue: [ unhookMethodBlock value: mclass value: sel value: hookedMethod ].
</methods> <methods> RuntimePackager.RuntimeSurrogateManager <category>class hooking</category>
allHookedClasses "Answer a collection of all hooked classes" ^hookedSuperclasses keys
hookClass: aClass "Transform aClass into a surrogate for itself" | meta | recursionLock critical: [ " ignore attempts to hook exempt classes" ( self exemptClasses includes: aClass ) ifTrue: [ ^self ]. " do not hook and already hooked class " ( hookedSuperclasses includesKey: aClass ) ifTrue: [ ^self ]. " just make sure we are still sane " ( aClass isBehavior and: [ aClass isMeta not ] ) ifFalse: [ ^self error: 'class is not valid for hooking to surrogate' ]. " hook all subclasses recursively " aClass subclasses do: [ :sub | self hookClass: sub ]. " remember the metaclass for later use " meta := aClass class. " save the superclass and method dictionary for the class and metaclass " hookedSuperclasses at: aClass put: (aClass instVarAt: 1). hookedMethodDictionaries at: aClass put: (aClass instVarAt: 2). hookedSuperclasses at: meta put: (meta instVarAt: 1). hookedMethodDictionaries at: meta put: (meta instVarAt: 2). " set the superclass and empty the method dictionary " aClass instVarAt: 1 put: RuntimeInstanceSurrogate. aClass instVarAt: 2 put: MethodDictionary new. aClass flushVMmethodCache. meta instVarAt: 1 put: RuntimeClassSurrogate. meta instVarAt: 2 put: MethodDictionary new. meta flushVMmethodCache. ]. "end critical section"
unhookAllClasses "Unhook all classes by sending each global object a message. This will perform at list a minimal repair of any hooked classes that are not in the hooked classes dictionaries" Smalltalk allBehaviorsDo: [ :behav | behav class ].
unhookClass: aClass "Restore the behavior surrogate to its normal form" self unhookClass: aClass selector: nil.
unhookClass: aClass selector: aSymbolOrNil "Restore the behavior surrogate to its normal form" " set up error handling environment and critical section controls " | meta savedException | savedException := nil. [recursionLock critical: [" the main function to perform " [meta := aClass rtpClass] on: Object messageNotUnderstoodSignal do: [:ex | ^self]. " make sure super class is also unhooked, if needed " self unhookClass: (hookedSuperclasses at: aClass ifAbsent: ["Attempt temporary repair so debugger can open." aClass instVarAt: 1 put: Object. meta instVarAt: 1 put: Object class. ^self class unhookingErrorSignal raiseErrorString: 'Fatal error unhooking class ' , aClass name]) selector: nil. " restore superclasses and method dictionaries " meta instVarAt: 1 put: (hookedSuperclasses at: meta ifAbsent: [^self]). "stop if already unhooked by superclass" meta instVarAt: 2 put: (hookedMethodDictionaries at: meta). meta flushVMmethodCache. hookedSuperclasses removeKey: meta. hookedMethodDictionaries removeKey: meta. aClass instVarAt: 1 put: (hookedSuperclasses at: aClass). aClass instVarAt: 2 put: (hookedMethodDictionaries at: aClass). aClass flushVMmethodCache. hookedSuperclasses removeKey: aClass ifAbsent: []. hookedMethodDictionaries removeKey: aClass ifAbsent: [] "changed"]] on: Object errorSignal do: [:ex | savedException := ex]. "end critical section" " reraised (non-proceedable) any exception " savedException isNil ifFalse: [^(savedException creator newException) originator: savedException originator; errorString: savedException localErrorString; parameter: savedException parameter; raise]. " perform any desired notifications " unhookClassBlock notNil ifTrue: [unhookClassBlock value: aClass value: aSymbolOrNil]
</methods> <methods> RuntimePackager.RuntimeSurrogateManager <category>initialization</category>
beginTest "Do intializations needed to begin a test using surrogates" RuntimeInstanceSurrogate assignSuperclass: nil.
endTest "Do intializations needed to end a test using surrogates" RuntimeInstanceSurrogate assignSuperclass: Object.
initialize "Initialize a new instance" | surrogateSelectors templateSelector | recursionLock := RecursionLock new. hookedSuperclasses := IdentityDictionary new. hookedMethodDictionaries := IdentityDictionary new. unhookClassBlock := nil. unhookMethodBlock := nil. " cache surrogate methods " surrogateSelectors := #( #surrogateMethod ) asOrderedCollection. templateSelector := #surrogateMethod:. 1 to: 32 do: [ :n | surrogateSelectors add: templateSelector. templateSelector := ( templateSelector, 'with:' ) asSymbol ]. surrogateMethods := ( surrogateSelectors collect: [ :sel | RuntimeMethodSurrogate cloneFromMethod: ( self class compiledMethodAt: sel ) ] ) asArray.
</methods> <methods> RuntimePackager.RuntimeSurrogateManager <category>accessing</category>
exemptClasses "Answer the set of classes which are exempt from being hooked and, except for Object, whose methods are likewise exempt from being hooked." exemptClasses notNil ifTrue: [ ^exemptClasses ]. exemptClasses := self kernelClasses. exemptClasses addAll: RuntimeMethodSurrogate withAllSuperclasses; addAll: RuntimeClassSurrogate withAllSuperclasses; addAll: RuntimeInstanceSurrogate withAllSuperclasses; addAll: RuntimeSurrogateManager withAllSuperclasses. ^exemptClasses
kernelClasses "Answer the set of classes which are part of the kernel and are required for hooking and unhooking classes and methods" ^ IdentitySet new addAll: Class withAllSuperclasses; addAll: ControlManager withAllSuperclasses; addAll: WindowManager withAllSuperclasses; addAll: Exception withAllSuperclasses; addAll: IdentitySet withAllSuperclasses; addAll: InputSensor withAllSuperclasses; addAll: LargePositiveInteger withAllSuperclasses; addAll: MarkedMethod withAllSuperclasses; addAll: Metaclass withAllSuperclasses; addAll: MethodContext withAllSuperclasses; addAll: MethodDictionary withAllSuperclasses; addAll: ObjectMemory withAllSuperclasses; addAll: Process withAllSuperclasses; addAll: RecursionLock withAllSuperclasses; addAll: Semaphore withAllSuperclasses; addAll: ScannerTable withAllSuperclasses; addAll: Signal withAllSuperclasses; addAll: SmallInteger withAllSuperclasses; addAll: VariableBinding withAllSubclasses; addAll: VariableBinding withAllSuperclasses; addAll: BindingReference withAllSubclasses; addAll: BindingReference withAllSuperclasses; addAll: DeferredBinding withAllSuperclasses; addAll: DeferredBinding withAllSubclasses; yourself
unhookClassBlock "Answer the block to execute when a class is unhooked" ^unhookClassBlock
unhookClassBlock: aBlockOrNil "Set the block to execute when a class is unhooked" unhookClassBlock := aBlockOrNil.
unhookMethodBlock "Answer the block to execute when a method is unhooked" ^unhookMethodBlock
unhookMethodBlock: aBlockOrNil "Set the block to execute when a method is unhooked" unhookMethodBlock := aBlockOrNil.
</methods> <methods> RuntimePackager.RuntimeSurrogateManager <category>message handling</category>
interceptedClassMessage: aMessage receiver: aClass "Unhook the surrogate and resend the intercepted message" self unhookClass: aClass selector: aMessage selector. ^aClass perform: aMessage selector withArguments: aMessage arguments
interceptedInstanceMessage: aMessage receiver: anObject "Unhook the surrogate and resend the intercepted message" self unhookClass: anObject rtpClass selector: nil. ^anObject perform: aMessage selector withArguments: aMessage arguments
interceptedMethodInvocation "Intercept invocation of a hooked method" | ctx surrogate method args numArgs | " locate what was sent in the original context " ctx := thisContext sender. surrogate := ctx method. method := surrogate hookedMethod. " extract the original arguements " numArgs := method numArgs. args := Array new: numArgs. 1 to: numArgs do: [ :index | args at: index put: (ctx localAt: index) ]. " unhook the method that got the message " self unhookMethod: surrogate. " resent the original message" ^ctx receiver performMethod: method arguments: args.
</methods> <methods> RuntimePackager.RuntimeSurrogateManager <category>template methods</category>
surrogateMethod ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 with: t18 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 with: t18 with: t19 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 with: t18 with: t19 with: t20 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 with: t18 with: t19 with: t20 with: t21 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 with: t18 with: t19 with: t20 with: t21 with: t22 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 with: t18 with: t19 with: t20 with: t21 with: t22 with: t23 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 with: t18 with: t19 with: t20 with: t21 with: t22 with: t23 with: t24 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 with: t18 with: t19 with: t20 with: t21 with: t22 with: t23 with: t24 with: t25 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 with: t18 with: t19 with: t20 with: t21 with: t22 with: t23 with: t24 with: t25 with: t26 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 with: t18 with: t19 with: t20 with: t21 with: t22 with: t23 with: t24 with: t25 with: t26 with: t27 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 with: t18 with: t19 with: t20 with: t21 with: t22 with: t23 with: t24 with: t25 with: t26 with: t27 with: t28 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 with: t18 with: t19 with: t20 with: t21 with: t22 with: t23 with: t24 with: t25 with: t26 with: t27 with: t28 with: t29 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 with: t18 with: t19 with: t20 with: t21 with: t22 with: t23 with: t24 with: t25 with: t26 with: t27 with: t28 with: t29 with: t30 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 with: t18 with: t19 with: t20 with: t21 with: t22 with: t23 with: t24 with: t25 with: t26 with: t27 with: t28 with: t29 with: t30 with: t31 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
surrogateMethod: t1 with: t2 with: t3 with: t4 with: t5 with: t6 with: t7 with: t8 with: t9 with: t10 with: t11 with: t12 with: t13 with: t14 with: t15 with: t16 with: t17 with: t18 with: t19 with: t20 with: t21 with: t22 with: t23 with: t24 with: t25 with: t26 with: t27 with: t28 with: t29 with: t30 with: t31 with: t32 ^RuntimePackager.RuntimeSurrogateManager activeManager interceptedMethodInvocation
</methods> <methods> RuntimePackager.RuntimeSurrogateManager class <category>accessing</category>
activeManager "Answer the current global surrogate manager" activeManager isNil ifTrue: [ activeManager := self new. ]. ^activeManager
activeManager: aManager "Set the current global surrogate manager" activeManager := aManager.
</methods> <methods> RuntimePackager.RuntimeSurrogateManager class <category>class initialize-release</category>
initialize "Initialize the class" activeManager := nil.
removeFromSystem "Reset access to the active manager" self removing. super removeFromSystem.
removing "Reset access to activeManager to free up anchor for surrogate methods" self activeManager: nil.
</methods> <methods> RuntimePackager.RuntimeSurrogateManager class <category>instance creation</category>
new "Answer a new instance" ^super new initialize
</methods> <methods> RuntimePackager.RuntimeSurrogateManager class <category>Signal constants</category>
unhookingErrorSignal "Answer the signal used to report unhooking errors" unhookingErrorSignal isNil ifTrue: [ unhookingErrorSignal := Object errorSignal newSignal notifierString: 'Error unhooking a surrogate object'; nameClass: self message: #unhookingErrorSignal. ]. ^unhookingErrorSignal
</methods> <methods> RuntimePackager.RuntimeBuilderMessageTracer <category>internal</category>
addReferencedSelector: aSymbol in: aBehavior "Remember that a selector was referenced explicitly in a specific behavior" ( referencedMethods at: aBehavior ifAbsent: [ referencedMethods at: aBehavior put: Set new ] ) add: aSymbol.
addUnreferencedGlobalsIn: aNameSpace to: unref referenced: globals "Add all global binding references that were not referenced. globals holds a set of referenced globals as variable bindings. Take the globals in aNameSpace and the name spaces in it" | nsRef | nsRef := aNameSpace fullyQualifiedReference. aNameSpace bindingsDo: [ :binding | binding isForClass ifFalse: [ ( globals includes: binding ) ifFalse: [ unref add: ( nsRef append: binding key ). ] ]. binding isForNameSpace ifTrue: [ self addUnreferencedGlobalsIn: binding value to: unref referenced: globals ] ].
findPragmaMessages "Set up a cache of all messages that reference the Pragma class directly, to save doing a senders operation for each pragma method" | methodCollector | methodCollector := MethodCollector new. pragmaReferences := methodCollector select: (methodCollector referencesTo: #{Pragma} binding). pragmaReferences := pragmaReferences collect: [:each | each method].
invertClassesAndGlobals "Find and save all name spaces including those used for pools and class variables." notifier log: 'Inverting global and class bindings.'. self invertNameSpacesFrom: Root. "We need to make sure that our list of globals are using the correct unique instance of the binding." deletedGlobals := deletedGlobals collect: [:each | (globalBindings detect: [:eachGlobalBinding | eachGlobalBinding = each] ifNone: [nil])]. deletedGlobals := deletedGlobals select: [:each | each notNil]. referencedGlobals := referencedGlobals collect: [:each | (globalBindings detect: [:eachGlobalBinding | eachGlobalBinding = each] ifNone: [nil])]. referencedGlobals := referencedGlobals select: [:each | each notNil].
invertNameSpacesFrom: aNameSpace "Recursively go through name spaces inverting globals and classes." aNameSpace bindingsDo: [ :binding | ( binding isForClass not and: [ aNameSpace isForClass not ] ) ifTrue: [ globalBindings at: binding put: ( aNameSpace fullyQualifiedReference append: binding key ) ]. binding isForClass ifTrue: [ | classesAtName | classesAtName := invertedClasses at: binding key ifAbsent: [ nil ]. classesAtName isNil ifTrue: [ invertedClasses at: binding key put: (OrderedCollection with: binding value ) ] ifFalse: [ classesAtName add: binding value ]. self invertNameSpacesFrom: binding value asNameSpace. " Is this needed -- hangs up on some classes like X11InputManager -- binding value importDefinitions do: [ :ref | | refValue | ( refValue := ref valueOrDo: [nil ] ) notNil ifTrue: [ self invertNameSpacesFrom: refValue. ] ]. " ]. binding isForNameSpace ifTrue: [ self invertNameSpacesFrom: binding value. ] ].
invertSelectors "Build the dictionary of selectors and where they are used" | classesFound | notifier log: 'Inverting selectors '. notifier tickRate: Symbol tableSize // 700. classesFound := IdentitySet new. RuntimeManager allClassesDo: [ :cl | ( classesFound includes: cl ) not ifTrue: [ notifier tick. classesFound add: cl. ( RuntimeManager selectorsInClass: cl ) do: [ :sel | | x mth | x := invertedSelectors at: sel ifAbsent: [ nil ]. mth := cl compiledMethodAt: sel. x isNil ifTrue: [ invertedSelectors at: sel put: (OrderedCollection with: mth). ] ifFalse: [ x add: mth ] ]. ( RuntimeManager selectorsInClass: cl class ) do: [ :sel | | x mth | x := invertedSelectors at: sel ifAbsent: [ nil ]. mth := cl class compiledMethodAt: sel. x isNil ifTrue: [ invertedSelectors at: sel put: (OrderedCollection with: mth). ] ifFalse: [ x add: mth ] ]. self noteExitMethodsIn: cl ] ]. accessors := IdentitySet new: invertedSelectors size // 4. invertedSelectors keysAndValuesDo: [ :k : v | invertedSelectors at: k put: v asArray. ( k isSequenceable and: [ k size > 0 and: [ k last == $: and: [ ( k inject: 0 into: [ :n :c | c == $: ifTrue: [ n + 1 ] ifFalse: [ n ] ] ) == 1 ] ] ] ) ifTrue: [ | str | str := k copyFrom: 1 to: k size - 1. Symbol hasInterned: str ifTrue: [ :sym | accessors add: sym. ] ] ].
noteExitMethodsIn: aClass "Note whether aClass implements any of the magic methods used to override normal behavior in the message tracing process. The set of such classes is used to optimize performance since most classes will not implement any such methods" #( #dynamicallyReferencedClasses #dynamicallyReferencedSelectors #dynamicallyReferencedGlobals #itemsReferencedBySelector: #itemsReferencedByClassSelector: ) do: [ :sel | ( aClass class includesSelector: sel ) ifTrue: [ exitClasses add: aClass ] ].
</methods> <methods> RuntimePackager.RuntimeBuilderMessageTracer <category>initialization</category>
addActiveWindowPolicyClass "Add the default instance of WindowManagerUsagePolicy to the list of classes to keep. If the runtime application names another it should be traced later" newClasses add: (Processor activeProcess environmentAt: #WindowManagerUsagePolicy) class
deletedClassesAdd: aCollection "Add to the set of classes that will not be scanned." aCollection do: [ :cl | deletedClasses addAll: cl withAllSubclasses ].
deletedGlobalsAdd: aCollection "Add to the set of classes that will not be scanned." deletedGlobals addAll: aCollection.
initialClassesAdd: aCollection "Add to the set of classes to assume as resident." newClasses addAll: aCollection
initialGlobalsAdd: aCollection "Add to the set of globals (as binding references) to assume as referenced. The class of each global's current value is assumed to referenced as well. If the global refers to a class, then that class is added also." | refValue | referencedGlobals addAll: aCollection. aCollection do: [ :bindingRef | refValue := bindingRef valueOrDo: [ nil ]. refValue isBehavior ifTrue: [ newClasses add: ( refValue isMeta ifTrue: [ refValue soleInstance ] ifFalse: [ refValue ] ) ] ifFalse: [ newClasses add: refValue class ] ].
initialize "Initialize a new instance" sentSelectors := IdentitySet new. deletedClasses := IdentitySet new. referencedClasses := IdentitySet new. referencedGlobals := IdentitySet new. referencedMethods := IdentityDictionary new. deletedGlobals := IdentitySet new. newSelectors := IdentitySet new. newClasses := IdentitySet new. exitClasses := IdentitySet new. globalBindings := IdentityDictionary new. invertedClasses := IdentityDictionary new. invertedSelectors := IdentityDictionary new. blocksReferenced := IdentitySet new. externalInterfaceClasses := IdentitySet withAll: ExternalInterface withAllSubclasses.
</methods> <methods> RuntimePackager.RuntimeBuilderMessageTracer <category>accessing</category>
items "Answer the items object holding kept and deleted classes, globals, and methods" ^ items
items: aRuntimeBuilderItems "Set the items object holding kept and deleted classes, globals, and methods" items := aRuntimeBuilderItems.
newClasses ^newClasses
newClasses: anObject newClasses := anObject
newSelectors ^newSelectors
newSelectors: anObject newSelectors := anObject
notifier ^notifier
notifier: anObject notifier := anObject
options "Answer options being used for tracing" ^ options
options: aRuntimeBuilderOptions "Set options (RuntimeBuilderOptions) being used for tracing" options := aRuntimeBuilderOptions
referencedClasses "Answer the collection of classes referenced somewhere" ^referencedClasses
referencedGlobals "Answer the collection of global variables referenced somewhere" ^referencedGlobals
sentSelectors "Answer the collection of selectors found to be sent from somewhere" ^sentSelectors
unreferencedClasses "Answer a collection of classes that werer not referenced" | classes | referencedClasses size == 0 ifTrue: [ ^IdentitySet new. ]. classes := IdentitySet new. RuntimeManager allClassesDo: [ :cl | ( referencedClasses includes: cl ) ifFalse: [ classes add: cl ] ]. ^classes
unreferencedGlobals "Answer a collection of globals that were not referenced anywhere" | unref globals | referencedGlobals size == 0 ifTrue: [ ^Set new. ]. unref := Set new. globals := IdentitySet new: referencedGlobals size. referencedGlobals do: [ :ref | globals add: ref bindingOrNil ]. self addUnreferencedGlobalsIn: Root to: unref referenced: globals. ^unref
unreferencedMethods "Answer the methods that are not referenced. These are methods in which the selector was not sent, the class was not referenced, or the method was explicitly deleted. Kept methods in referenced classes are considered referenced in any case though." | unrefMethods unrefSelectors selectors | unrefMethods := IdentityDictionary new. Smalltalk allBehaviorsDo: [ :behav | unrefSelectors := Set new: 17. selectors := RuntimeManager selectorsInClass: behav. " see if the class was referenced " ( referencedClasses includes: ( behav isMeta ifTrue: [ behav soleInstance ] ifFalse: [ behav ] ) ) ifFalse: [ " all selectors are thereby unreferenced as well " unrefSelectors addAll: selectors. ] ifTrue: [ " add any methods explicitly deleted " unrefSelectors addAll: ( items deletedMethods at: behav ifAbsent: [ #( ) ] ). " add all selectors not sent anywhere " unrefSelectors addAll: ( selectors reject: [ :sel | sentSelectors includes: sel ] ). " remove selectors that were aprior referenced " ( referencedMethods at:behav ifAbsent: [ #( ) ] ) do: [ :sel | unrefSelectors remove: sel ifAbsent: []. ] ]. " create the entry in the unreferenced methods dictionary " unrefSelectors isEmpty ifFalse: [ unrefMethods at: behav put: unrefSelectors asSet ] ]. ^unrefMethods
</methods> <methods> RuntimePackager.RuntimeBuilderMessageTracer <category>actions</category>
raiseNotifier "Raise the notifier window, if there is one" notifier notNil ifTrue: [ notifier raise ].
traceSystem "Trace all message sends to determine unreferenced classes and selectors. items and options must be set before starting this process." notifier := RuntimeProgressNotifier open. [Cursor wait showWhile: [ " initialize for message tracing " notifier log: 'Preparing for message trace'. self initialClassesAdd: items keptClasses. self addActiveWindowPolicyClass. notifier tick. self deletedClassesAdd: items deletedClasses. self deletedClassesAdd: items classesInDeletedNameSpaces. notifier tick. self initialGlobalsAdd: items keptGlobals. notifier tick. self deletedGlobalsAdd: items deletedGlobals. notifier tick. " do the transitive closure of messages found " self traceMessages. " collect the results" notifier log: 'Extracting unreferenced classes'. items unreferencedClasses: self unreferencedClasses. notifier log: 'Extracting unreferenced methods'. items unreferencedMethods: self unreferencedMethods. notifier log: 'Extracting unreferenced globals'. items unreferencedGlobals: self unreferencedGlobals. "With the addition of namespace tracing, we can undelete referenced namespaces" items deletedGlobals: deletedGlobals. items refreshViewer]] ensure: [ notifier close. notifier := nil].
</methods> <methods> RuntimePackager.RuntimeBuilderMessageTracer <category>message tracing</category>
isCollectionWeShouldIterate: anObject ^#(Array Set Dictionary IdentityDictionary OrderedCollection List) includes: anObject class name.
methodIsResourceMethod: aCompiledMethod "Return true if this is a resource method, and thus might have compound selectors" ^aCompiledMethod homeMethod attributeMessages notNil and: [aCompiledMethod homeMethod attributeMessages anySatisfy: [:each | each selector == #resource:]].
overriddenReferencesListForMethod: aMethod "Trace a compiled method to detect sent selectors and referenced classes." | lits mclass who | " look for class exits that will specify the literals in the method " lits := nil. [ ( mclass := aMethod mclass ) isBehavior ifTrue: [ mclass isMeta ifTrue: [ ( mclass includesSelector: #itemsReferencedByClassSelector: ) ifTrue: [ ( who := aMethod who ) notNil ifTrue: [ lits := mclass soleInstance perform: #itemsReferencedByClassSelector: with: ( who at: 2 ) ] ] ] ifFalse: [ ( mclass class includesSelector: #itemsReferencedBySelector: ) ifTrue: [ ( who := aMethod who ) notNil ifTrue: [ lits := mclass perform: #itemsReferencedBySelector: with: ( who at: 2 ) ] ] ]. ( lits isNil or: [ lits isKindOf: Collection ] ) ifFalse: [ self notify: 'Answered references are not in the form of a collection'. lits := nil. ] ] ] on: Error do: [ :ex | ( Dialog choose: ( ex errorString, '\\Error while obtaining reference overrides for \' withCRs, aMethod displayString, '\\These overrides will be ignored' withCRs ) labels: #( 'OK' 'Debug' ) values: #( #ok #debug) default: #ok ) == #ok ifTrue: [ lits := nil ] ifFalse: [ ex pass ] ]. ^lits.
traceAllLiterals: literal "trace references from the literal including those contained within literal if it is an Array" literal class == Array ifTrue: [ self traceArray: literal excluding: IdentitySet new. ] ifFalse: [ self traceLiteral: literal. ].
traceArray: anArray excluding: exclusionSet "Recursively trace the array provided skipping elements in the exlusionSet." exclusionSet add: self. anArray do: [ :element | element class == Array ifTrue: [ (exclusionSet includes: element ) ifFalse: [ self traceArray: element excluding: exclusionSet ] ] ifFalse: [ self traceLiteral: element ] ].
traceBlockClosure: aBlockClosure "Trace references from a block closure. Need to avoid recursion in initializers, so make sure no block is scanned twice." ( blocksReferenced includes: aBlockClosure ) ifFalse: [ blocksReferenced add: aBlockClosure. self traceMethod: aBlockClosure method. ].
traceClass: aClass "Examine the selectors implemented in a class to see if any of them are sent. If so, trace the implementing methods. Trace superclass also." " do not retrace classes already done or apriori deleted " " see if there are kept methods that should be included " aClass isObsolete ifTrue: [^self]. ((referencedClasses includes: aClass) or: [deletedClasses includes: aClass]) ifTrue: [^self]. referencedClasses add: aClass. "Include references through class pool" aClass classPool bindingsDo: [:binding | self traceClassPoolEntry: binding]. "Include references to imported classes and globals" self traceGlobalBinding: aClass environment strictReference bindingOrNil required: true. aClass importDefinitions do: [:ref | self traceGlobalBinding: ref bindingOrNil required: true. self traceLiteral: ref]. "Note - In RTP 5i.3 removed dead code left over from logic to scan for references to items in dictionaries etc. This is not needed since the references are detected via their bindings." " external interfaces can reference items via their external dictionary " (externalInterfaceClasses includes: aClass) ifTrue: [sentSelectors add: #resolveCTypeNamed:. "Used for parcel loading" aClass externals keys do: [:ext | ext isSymbol ifTrue: [self traceSelector: ext from: aClass]]]. self traceSentMessagesIn: aClass. " see if there are kept methods that should be included " (items keptMethods includesKey: aClass) ifTrue: [(items keptMethods at: aClass) do: [:sel | self traceSelector: sel from: aClass]]. (items keptMethods includesKey: aClass class) ifTrue: [(items keptMethods at: aClass class) do: [:sel | self traceSelector: sel from: aClass class]]. " look for special exits which provide additional directives " (exitClasses includes: aClass) ifTrue: [self traceDynamicItemsFrom: aClass]. " recursively do the same for the superclass, if any" aClass superclass isNil ifFalse: [self traceClass: aClass superclass].
traceClassPoolEntry: aVariableBinding "Trace a class shared variable, and if that is a namespace or other collection, the contents of it. This is particularly significant for class pools that include references to other classes" | binding | binding := globalBindings at: aVariableBinding ifAbsent: [^nil]. ( deletedGlobals includes: binding ) ifFalse: [ (referencedGlobals includes: binding) ifFalse: [ referencedGlobals add: binding. binding value isBehavior ifTrue: [self traceLiteral: binding value] ifFalse: [ self traceLiteral: binding value class. self traceStoredObject: binding value visited: IdentitySet new]]].
traceCompoundSymbol: lit "Trace selectors appearing in a compound symbol in addition to those in a normal symbol" " trace normal symbol references " | idx1 | self traceSymbol: lit. " if symbol is a compound form, parse out the selectors compound forms have selectors separated by spaces and possibly by |" idx1 := 1. 1 to: lit size do: [ :idx2 | | ch | ch := lit at: idx2. ( ch == Character space or: [ ch == $| ] ) ifTrue: [ idx2 > idx1 ifTrue: [ newSelectors add: ( lit copyFrom: idx1 to: idx2 - 1 ) asSymbol. ]. idx1 := idx2 + 1. ] ]. ( idx1 ~= 1 and: [ idx1 <= lit size ] ) ifTrue: [ newSelectors add: ( lit copyFrom: idx1 to: lit size ) asSymbol ].
traceDynamicItemsFrom: aClass "Trace dynamic items identified via special class methods The following methods are invoked where found: - dynamicallyReferencedClasses - dynamicallyReferencedGlobals - dynamicallyReferencedSelectors Each answers a collection of the object being referenced. Classes can be answered as class objects, symbols naming the class , or as binding references. Globals are similar. Selectors are answered as symbols naming the selector. To allow flexibility, references to classes and globals that are not currently loaded are allowed but ignored. Names of classes and globals are first resolved in the environment of aClass and if not found, are resolved in the Smalltalk name space." | classes globals selectors dynamicClasses dynamicGlobals dynamicSelectors | [ " get dynamic items with some protection " classes := ( aClass class includesSelector: #dynamicallyReferencedClasses ) ifTrue: [ aClass dynamicallyReferencedClasses ] ifFalse: [ Array new ]. globals := ( aClass class includesSelector: #dynamicallyReferencedGlobals ) ifTrue: [ aClass dynamicallyReferencedGlobals ] ifFalse: [ Array new ]. selectors := ( aClass class includesSelector: #dynamicallyReferencedSelectors ) ifTrue: [ aClass dynamicallyReferencedSelectors ] ifFalse: [ Array new ]. " Convert the answers to a standard form" " If a singleton was provided, make it a collection " ( classes isKindOf: Collection ) ifFalse: [ classes := Array with: classes ]. ( globals isKindOf: Collection ) ifFalse: [ globals := Array with: globals ]. ( selectors isKindOf: Collection ) ifFalse: [ selectors := Array with: selectors ]. " Look up items referenced " dynamicClasses := classes collect: [ :item | | ref cl | item isSymbol ifTrue: [ ref := aClass environment fullyQualifiedReference append: item. ref isDefined ifFalse: [ ref := item asQualifiedReference ] ] ifFalse: [ ref := item asQualifiedReference ]. cl := ref valueOrDo: [ nil ]. cl isBehavior ifTrue: [ cl isMeta ifTrue: [ cl soleInstance ] ifFalse: [ cl ] ] ifFalse: [ nil ] ]. dynamicGlobals := globals collect: [ : item | | ref | item isSymbol ifTrue: [ ref := aClass environment fullyQualifiedReference append: item. ref isDefined ifFalse: [ ref := item asQualifiedReference ] ] ifFalse: [ ref := item asQualifiedReference ]. ref isDefined ifTrue: [ ref makeUnambiguous ] ifFalse: [ nil ] ]. dynamicSelectors := selectors select: [ :item | item isSymbol ] ] on: Error do: [ :ex | ( Dialog choose: ( ex errorString, '\\Error while obtaining dynamic items from \' withCRs, aClass fullName, '\Dynamic items from this class will be ignored' withCRs ) labels: #( 'OK' 'Debug' ) values: #( #ok #debug) default: #ok ) == #ok ifTrue: [ ^self ] ifFalse: [ ex pass ] ]. " add items to the things to be traced " newClasses addAll: ( dynamicClasses select: [ :item | item notNil ] ). referencedGlobals addAll: (dynamicGlobals select: [ :item | item notNil ] ). newSelectors addAll: dynamicSelectors.
traceGlobalBinding: vb required: aBoolean "Trace a variable binding to a global literal including those in class pools. If this binding is required, then remove it from the deleted list. Otherwise if it's not being deleted, include the class of the literal's value as referenced. Required means that this binding contains some kept value. If it is merely referenced, then we don't override the deletion. The value of ValueHolders (but not subclasses thereof) are also included as referenced." | binding realValue | " look up the variable binding to get a standard binding reference, it any" binding := globalBindings at: vb ifAbsent: [ ^nil ]. realValue := vb value. aBoolean ifTrue: [deletedGlobals remove: binding ifAbsent: []]. ( deletedGlobals includes: binding ) ifFalse: [ referencedGlobals add: binding. ((realValue isBehavior or: [realValue isNameSpace]) and: [realValue environment notNil]) ifTrue: [self traceGlobalBinding: realValue environment strictReference binding required: true]. realValue isBehavior ifFalse: [ self traceLiteral: realValue class. realValue class == ValueHolder ifTrue: [ self traceAllLiterals: realValue value ] ] ifTrue: [ self traceAllLiterals: realValue ] ].
traceLiteral: lit "Trace a literal to detect sent selectors and referenced classes. There are a number of special cases that are sifted through: - for a class, add to the list to classes to scan - for a binding to a class, add it to the classes to scan - for a symbol, determine what it could be the name of and trace that - for a binding reference, trace its value - for an association, trace its value" " look for a direct class or meta class reference. These only occur as a reference to the class itself. " lit isBehavior ifTrue: [ newClasses add: ( lit isMeta ifTrue: [ lit soleInstance ] ifFalse: [ lit ] ). ^self ]. " look for a reference via a variable binding " lit isVariableBinding ifTrue: [ | vb | vb := lit binding. vb isForClass ifTrue: [ self traceLiteral: vb value. ]. (vb isForGeneral or: [vb isForNameSpace]) ifTrue: [ self traceGlobalBinding: vb required: false. ]. vb hasInitializer ifTrue: [ self traceBlockClosure: vb initializer. ]. ^ self ]. " look for references to selectors and classes by name " ( lit isSymbol and: [ lit size > 0 ] ) ifTrue: [ self traceSymbol: lit. ^self ]. " resolve binding references that appear as literals and trace that" ( lit isBindingReference ) ifTrue: [ self traceGlobalBinding: lit bindingOrNil required: false. self traceLiteral: lit bindingOrNil. ^self ]. " trace the value of an association, which is probably something rare " lit class == Association ifTrue: [ self traceLiteral: lit value. ^self ].
traceMessages "Find all sent selectors by starting from the initial selectors and classes and expanding as methods are examined for sent messages." self invertClassesAndGlobals. self invertSelectors. self findPragmaMessages. notifier log: 'Tracing sent messages '. notifier tickRate: 1. self traceOptionsReferences. notifier tickRate: invertedSelectors size // 50. " approximate guess " [ newClasses isEmpty and: [ newSelectors isEmpty ] ] whileFalse: [ | tempClasses tempSelectors | notifier tick. tempClasses := newClasses. newClasses := IdentitySet new: tempClasses size * 3 // 2. tempClasses do: [ :cl | self traceClass: cl. ]. notifier tick. tempSelectors := newSelectors. newSelectors := IdentitySet new: tempSelectors size * 3 // 2. tempSelectors do: [ :sel | self traceSelector: sel ] ].
traceMethod: aMethod "Trace a compiled method to detect sent selectors and referenced classes." | lits attributes done | notifier tick. lits := self overriddenReferencesListForMethod: aMethod. lits notNil ifTrue: [ lits do: [ :lit | self traceLiteral: lit ]. ^self ]. done := OrderedCollection new. attributes := aMethod homeMethod attributeMessages. attributes isNil ifFalse: [ attributes do: [:eachMessage | self traceMethodAttributeWithKey: eachMessage selector value: eachMessage arguments in: aMethod. done add: eachMessage selector. "We don't know that the arguments aren't compound selectors, but if they are, the worst thing that happens is we trace something twice" done addAll: eachMessage arguments]]. lits := aMethod allLiterals. (self methodIsResourceMethod: aMethod) ifTrue: [ lits do: [ :lit | (done includes: lit) ifFalse: [ lit isSymbol ifTrue: [ self traceCompoundSymbol: lit ] ifFalse: [ self traceLiteral: lit ] ] ] ] ifFalse: [ lits do: [ :lit | (done includes: lit) ifFalse: [self traceLiteral: lit ] ] ]. aMethod messages do: [ :sel | ( done includes: sel ) ifFalse: [ self traceLiteral: sel ] ]. " For ExternalMethods, include the result type name as a literal " aMethod class == ExternalMethod ifTrue: [ self traceLiteral: aMethod resultType name ]
traceMethodAttributeWithKey: aSelector value: argumentArray in: aMethod "Trace something that's in the header list" | references | argumentArray do: [:eachArgument | self traceLiteral: eachArgument]. (aMethod mclass recognizedMethodPragmas includes: aSelector) ifTrue: [ "This symbol represents a pragma. We don't know for sure what the pragma is going to use, so find methods in this hierarchy that reference both the symbol and the class Pragma, as the most likely things to be using it" newSelectors add: aSelector. references := pragmaReferences select: [:eachMethod | | classOne classTwo inTheRightHierarchy | classOne := eachMethod mclass instanceBehavior. classTwo := aMethod mclass instanceBehavior. inTheRightHierarchy := classOne = classTwo or: [ (classOne inheritsFrom: classTwo) or: [ classTwo inheritsFrom: classOne]]. inTheRightHierarchy and: [eachMethod allLiterals includes: aSelector]]. newSelectors addAll: (references collect: [:each | each selector])].
traceOptionsReferences "Trace classes and methods mentioned in the options." " trace startup class and method " options startupClass notNil ifTrue: [ items includeStartupCode. newClasses add: options startupClass. self traceSelector: options startupMethod from: options startupClass class. ]. " trace error handler and image dumper -- note that selector is hard coded" options errorNotifierClass notNil ifTrue: [ newClasses add: options errorNotifierClass. self traceSelector: #notify:context: from: options errorNotifierClass class. ]. options imageDumperClass notNil ifTrue: [ newClasses add: options imageDumperClass. ]. " trace HeadlessImage if the options were selected " options headlessImage ifTrue: [ newClasses add: ( #{HeadlessImage} valueOrDo: [ nil ] ) ]. " look for parcel action methods, which are always invoked. unload functions are also used for references since they can be invoked if the parcel is unloaded." options loadableParcels do: [ :parcel | Parcel binaryActions do:[ :action | | blk | blk := parcel propertyAt: action ifAbsent: [ nil ]. blk notNil ifTrue: [ self traceBlockClosure: blk ] ] ]. "postLoad: is sent to classes loaded through parcels. If the parcel is not being trimmed, this results in extra class references and they need to be added to the collection of referenced classes to make the postLoad: or initialize references visible" options loadableParcels do: [ :parcel | ( options stripParcel: parcel name asString ) ifFalse: [ self initialClassesAdd: parcel definedClasses. ] ]. "Because of postLoad processing, any potentially loadable ExternalMethods need to be examined for references to items that may define types" options loadableMethods keysAndValuesDo: [ :cl :selectors | selectors do: [ :sel | | mth | mth := cl compiledMethodAt: sel ifAbsent: [ nil ]. mth class == ExternalMethod ifTrue: [ self traceMethod: mth ] ] ]. " if compact methods are used, will need to add a reference to the special class used" options useRuntimeCompiledMethod ifTrue: [ self initialClassesAdd: ( Array with: RuntimeCompiledMethod ) ].
traceSelector: aSelector "Examine the methods which send the selector to see if any of them are included in referenced classes." ( sentSelectors includes: aSelector ) ifFalse: [ | methods | sentSelectors add: aSelector. methods := invertedSelectors at: aSelector ifAbsent: [ ^self "not a selector" ]. methods do: [ :mth | " see if the class is being kept so far " ( referencedClasses includes: ( mth mclass isMeta ifTrue: [ mth mclass soleInstance ] ifFalse: [ mth mclass ] ) ) ifTrue: [ " make sure this method is not deleted " ( ( items deletedMethods includesKey: mth mclass ) and: [ ( items deletedMethods at: mth mclass ) includes: aSelector ] ) ifFalse: [ " ok - trace the individual method " self traceMethod: mth ] ] ] ].
traceSelector: aSymbol from: aBehavior "Trace the specific method referenced by aSymbol as implemented in aBehavior or its superclasses" | who | who := aBehavior findSelector: aSymbol. who notNil ifTrue: [ self traceMethod: (who at: 2). self addReferencedSelector: aSymbol in: ( who at: 1 ). ].
traceSentMessagesIn: aClass "Trace the messages sent in this class, both class and instance methods" self traceSentMessagesInClass: aClass. self traceSentMessagesInClass: aClass class.
traceSentMessagesInClass: aClass "Trace the messages sent in this class, or that contain one of the class pragmas, on the theory that they're likely to be used reflectively. Note that this will do only instance methods. To find class methods, pass it a metaclass." | deletedSel pragmas | deletedSel := items deletedMethods at: aClass ifAbsent: [#()]. pragmas := aClass recognizedMethodPragmas. (RuntimeManager selectorsInClass: aClass) do: [:eachSelector | | sent method containsPragma | (deletedSel includes: eachSelector) ifFalse: [ sent := (sentSelectors includes: eachSelector). method := aClass compiledMethodAt: eachSelector. containsPragma := method attributeMessages notNil and: [method attributeMessages anySatisfy: [:each | pragmas includes: each selector]]. sent | containsPragma ifTrue: [ sentSelectors add: method selector. self traceMethod: method]]].
traceStoredObject: anObject visited: aSet "Trace this object, and if it's a collection, its contents. Normally this is used for the contents of globals or shared variables. We aren't going to affect their contents directly if they're not namespaces, but we want to know what they hold so we know enough to trace the classes involved. Keep a local set to avoid infinite recursion for non-namespace collections that contain themselves. As soon as we get to something that involves a binding, it should stop anyway, so we only need to do this locally." (aSet includes: anObject) ifTrue: [^self]. aSet add: anObject. anObject isBehavior ifTrue: [^self traceLiteral: anObject]. self traceLiteral: anObject class. anObject isNameSpace ifTrue: [anObject bindingsDo: [:each | self traceClassPoolEntry: each]. ^self]. "This is awkward. We'd like to iterate over collections, but if we iterate over 'fake' collections like FixedPallette it takes an enormous amount of time. So restrict the types of things we iterate over to a minimal set of common collections we expect to see" (self isCollectionWeShouldIterate: anObject) ifTrue: [anObject do: [:each | self traceStoredObject: each visited: aSet]] ifFalse: [self traceLiteral: anObject].
traceSymbol: lit "Trace the references implied by the symbol (lit) These could be message sends ( a selector ) or a class named by the symbol." | simpleName index refClass | " a few null symbols may be used in the system " lit size >0 ifFalse: [ ^self ]. " treat each symbol reference as a message send" ( newSelectors includes: lit ) ifTrue: [ ^self ]. "been done " newSelectors add: lit. "Lookup in inverted selectors happens later" " expand an getter selector to its setter equivalent " ( lit last ~= $: and: [ accessors includes: lit ] ) ifTrue: [ Symbol hasInterned: lit, ':' ifTrue: [ :sym | newSelectors add: sym. ] ]. " check for classes with that name -- all are assumed to be referenced " newClasses addAll: ( invertedClasses at: lit ifAbsent: [ #( ) ] ). " if the symbol happens to name a class that can be resolved as a qualified reference trace that too. Look in inverted classes to avoid futile searches and avoid useless symbol interns in the process." index := lit lastIndexOf: $. . simpleName := index = 0 ifTrue: [lit ] ifFalse: [ ( lit copyFrom: index + 1 to: lit size ) asSymbol ]. ( invertedClasses includesKey: simpleName ) ifTrue: [ refClass := lit asQualifiedReference valueOrDo: [ nil ]. refClass isBehavior ifTrue: [ newClasses add: refClass instanceBehavior ] ].
</methods> <methods> RuntimePackager.RuntimeBuilderMessageTracer class <category>instance creation</category>
new ^super new initialize
</methods> <methods> RuntimePackager.RuntimeBuilderMemoryParamEditor <category>aspects</category>
codeSize "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^codeSize isNil ifTrue: [codeSize := 0 asValue] ifFalse: [codeSize]
edenSize "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^edenSize isNil ifTrue: [edenSize := 0 asValue] ifFalse: [edenSize]
fixedSize "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^fixedSize isNil ifTrue: [fixedSize := 0 asValue] ifFalse: [fixedSize]
growthLimit "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^growthLimit isNil ifTrue: [growthLimit := 0 asValue] ifFalse: [growthLimit]
incrementSize "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^incrementSize isNil ifTrue: [incrementSize := 0 asValue] ifFalse: [incrementSize]
largeSize "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^largeSize isNil ifTrue: [largeSize := 0 asValue] ifFalse: [largeSize]
memoryLimit "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^memoryLimit isNil ifTrue: [memoryLimit := 0 asValue] ifFalse: [memoryLimit]
oldSize "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^oldSize isNil ifTrue: [oldSize := 0 asValue] ifFalse: [oldSize]
retryDecrement "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^retryDecrement isNil ifTrue: [retryDecrement := 0 asValue] ifFalse: [retryDecrement]
stackSize "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^stackSize isNil ifTrue: [stackSize := 0 asValue] ifFalse: [stackSize]
survivorSize "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^survivorSize isNil ifTrue: [survivorSize := 0 asValue] ifFalse: [survivorSize]
</methods> <methods> RuntimePackager.RuntimeBuilderMemoryParamEditor <category>Internals</category>
copyValuesFromSubject "Copy value from the subject into aspect holders" self codeSize value: subject codeSize. self edenSize value: subject edenSize. self growthLimit value: subject growthLimit. self incrementSize value: subject incrementSize. self largeSize value: subject largeSize. self memoryLimit value: subject memoryLimit. self oldSize value: subject oldSize. self retryDecrement value: subject retryDecrement. self stackSize value: subject stackSize. self survivorSize value: subject survivorSize. self fixedSize value: subject fixedSize
copyValuesToSubject "Copy values back to the subject to record the change" super copyValuesToSubject. self isChanged ifFalse: [ ^self ]. subject codeSize: self codeSize value. subject edenSize: self edenSize value. subject growthLimit: self growthLimit value. subject incrementSize: self incrementSize value. subject largeSize: self largeSize value. subject memoryLimit: self memoryLimit value. subject oldSize: self oldSize value. subject retryDecrement: self retryDecrement value. subject stackSize: self stackSize value. subject survivorSize: self survivorSize value. subject fixedSize: self fixedSize value.
stepHelp "Open a help window" RuntimeBuilderUI helpFor: #helpForMemory.
</methods> <methods> RuntimePackager.RuntimeBuilderMemoryParamEditor <category>validations</category>
validate "Validate all values before copying them to subject" | max | max := ObjectMemory defaultSizesAtStartup collect: [ :x | x asFloat * 1000 ]. " make sure these are positive numbers and not too big" ( self validateRange: #edenSize low: 10000 high: ( max at: 1) ) ifFalse: [ ^false ]. ( self validateRange: #stackSize low: 10000 high: (max at: 4) ) ifFalse: [ ^false ]. ( self validateRange: #survivorSize low: 10000 high: (max at: 2) ) ifFalse: [ ^false ]. ( self validateRange: #codeSize low: 10000 high: (max at: 5) ) ifFalse: [ ^false ]. ( self validateRange: #largeSize low: 10000 high: (max at: 3) ) ifFalse: [ ^false ]. ( self validateRange: #oldSize low: 10000 high: (max at: 6) ) ifFalse: [ ^false ]. " check memory policy values " ( self validatePositive: #incrementSize ) ifFalse: [ ^false ]. ( self validatePositive: #growthLimit ) ifFalse: [ ^false ]. ( self validatePositive: #retryDecrement ) ifFalse: [ ^false ]. ( self validatePositive: #memoryLimit ) ifFalse: [ ^false ]. " cross check some relationships " ( self validateRange: #incrementSize low: self retryDecrement value * 2 high: self memoryLimit value ) ifFalse: [ ^ false ]. ^true
</methods> <methods> RuntimePackager.RuntimeDeletedInstance <category>compiling</category>
compile: textOrStream in: aClass notifying: aRequestor ifFail: failBlock "Always treat compile requests as failures" ^failBlock value
evaluate: textOrStream in: aContext receiver: receiver notifying: aRequestor ifFail: failBlock "Always treat compile requests as failures" ^failBlock value
evaluate: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock "Always treat compile requests as failures" ^failBlock value
format: textOrStream in: aClass notifying: aRequestor "Do not really do the format" ^textOrStream
</methods> <methods> RuntimePackager.RuntimeDeletedInstance <category>error handling</category>
doesNotUnderstand: aMessage "Raise a signal indicating that a messsage was sent to a deleted behavior." ^RuntimeDeletedBehavior deletedBehaviorReferencedSignal raiseWith: ( MessageSend receiver: self selector: aMessage selector arguments: aMessage arguments ) errorString: 'Referenced an instance of deleted Behavior: ', self class originalName
</methods> <methods> RuntimePackager.RuntimeDeletedInstance <category>parsing</category>
initScanner "Fill in for Scanner or Parser on this -- do nothing" ^self
isLetter: aChar "Fill in for Parser processing of this" ^ aChar = $_ or: [ aChar isLetter ]
</methods> <methods> RuntimePackager.RuntimeDeletedInstance <category>printing</category>
printOn: aStream "Print the receiver, an instance of a deleted behavior" aStream nextPutAll: 'a '; nextPutAll: self class name.
</methods> <methods> RuntimePackager.RuntimeBuilderHelp <category>actions</category>
hardcopy "Print the help currently being displayed" | doc blankLines | blankLines := '\\' withCRs asText. doc := ( #{Document} valueOrDo: [ Dialog warn: 'Class Document is not present in the image'. ^self ] ) new. doc doFooter: true footerString: 'Runtime Packager Help: ', self title value asString doPageNumbers: true. doc startParagraph. doc addText: 'Runtime Packager Help' withCRs asText allBold. doc addText: blankLines. doc addText: self title value. doc addText: blankLines. doc addText: self helpString value. doc close. Cursor wait showWhile: [ doc toPrinter. ].
</methods> <methods> RuntimePackager.RuntimeBuilderHelp <category>aspects</category>
helpString "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^helpString isNil ifTrue: [helpString := Text new asValue] ifFalse: [helpString]
setHelpString: aString "Set the value of helpString after some simple edits" "For now just set the string" self helpString value: aString asText.
setTitle: aString "Set the value of title" self title value: aString asText allBold
title "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^title isNil ifTrue: [title := Text new asValue] ifFalse: [title]
</methods> <methods> RuntimePackager.RuntimeBuilderHelp class <category>instance creation</category>
onString: aString "Create an instance on a string" ^self new setHelpString: aString
onString: aString title: titleString "Create an instance on a string" ^self new setHelpString: aString; setTitle: titleString
</methods> <methods> RuntimePackager.RuntimeBuilderTester <category>actions</category>
accept "Alter keptItems unreferenced and deleted classes and methods to reflect dynamic items" | answer | testInProgress ifTrue: [ ^self ]. " is there are dynamic references see what is to be done " dynamicClasses size + dynamicMethods size == 0 ifFalse: [ answer := Dialog choose: ( ( 'Do you want to accept the most recent dynamic \', 'references before closing this window?' ) withCRs ) labels: #( 'Yes' 'No' 'Cancel' ) values: #( #yes #no #cancel ) default: #yes. answer = #cancel ifTrue: [ ^self ]. answer = #yes ifTrue: [ self acceptReferences ] ifFalse: [ "rehooking was done in endTest" dynamicClasses := IdentitySet new. dynamicMethods := IdentityDictionary new. ] ]. " adjust kept and deleted items to keep dynamic referenced items " self testStatus value: 'Removing dynamic references from deleted items' asText allBold. self incorporateClassReferences. self incorporateMethodReferences. "Update any now invalid view of kept items" acceptedDynamicClasses size + acceptedDynamicMethods size == 0 ifFalse: [ keptItems refresh ]. self closeWindow. RuntimeBuilderUI activeApplication testDone value: true.
acceptReferences "Accept dynamic references as part of the application" " if there are no dynamic items, ignore the button" dynamicMethods size + dynamicClasses size == 0 ifTrue: [ ^ self ]. " copy dynamic classes and methods to accepted " acceptedDynamicMethods addAll: dynamicMethods. dynamicMethods := Set new. acceptedDynamicClasses addAll: dynamicClasses. dynamicClasses := Set new. " reset appropriate displays" dynamicItemsText value: Text new. testStatus value: 'Dynamically referenced items were accepted' asText allBold.
beginTest "Initiate a test sequence" | endButton startupClass | " make sure we are not trying to restart a test already in progress" testInProgress ifTrue: [ ^self ]. " clean up for intiating more than one test in this window. " self builder window refresh. ScheduledControllers checkForEvents. " check to see if there may be parcels loaded into the image " options hasLoadableParcels ifTrue: [ self warnAboutParcelLoading ifFalse: [ ^self ] ]. " really start setting up for the test " startupClass := options startupClass. self testStatus value: 'Installing wrappers for classes and methods' asText allBold. #( saveImage beginTest accept cancel ) do: [ :comp | ( self builder componentAt: comp ) disable ]. endButton := ( self builder componentAt: #endTest ). endButton enable; takeKeyboardFocus; disable. " all systems are go -- initiate the test environment " testInProgress := true. self class activeTester: self. Cursor wait showWhile: [ self prepareForTest. ]. endButton enable. #( acceptReferences ignoreReferences ) do: [ :comp | ( self builder componentAt: comp ) enable ]. self testStatus value: 'Ready to test application' asText allBold. " no longer attempt to preload parcels -- function is obsolete" startupClass notNil ifTrue: [ startupClass perform: options startupMethod. ].
cancel "Cancel any changes in progress" testInProgress ifTrue: [ ^self ]. self closeWindow.
endTest "Restore the image to its initial state" self restoreMinimalDevelopmentState. self mainWindow refresh. ScheduledControllers checkForEvents. dynamicClasses size + dynamicMethods size == 0 ifTrue: [ #( acceptReferences ignoreReferences ) do: [ :comp | (self wrapperAt: comp ) disable ] ]. ( self wrapperAt: #endTest ) disable. " return classes and methods to their original state " Cursor wait showWhile: [ self unhookAll. ]. " finish restoring the image state and clean up displays " RuntimeSurrogateManager activeManager endTest. self class activeTester: nil. testInProgress := false. self testStatus value: (#Testcompleted << #RuntimePackager >> 'Test completed') asText allBold. #( saveImage beginTest accept cancel ) do: [ :comp | (self wrapperAt: comp ) enable ].
endTestQuietly "Restore the image to its initial state without progress notifications" | manager | self restoreMinimalDevelopmentState. manager := RuntimeSurrogateManager activeManager. manager allHookedClasses do: [ :cl | manager unhookClass: cl ]. manager allHookedMethods do: [ :meth | manager unhookMethod: meth ]. manager endTest. self class activeTester: nil. testInProgress := false.
ignoreReferences "Ignore dynamic references and do not include them as part of the application" " if there are no dynamic items, ignore the button" dynamicMethods size + dynamicClasses size == 0 ifTrue: [ ^ self ]. "reset dynamic classes and methods " testInProgress ifTrue: [ testStatus value: 'Reapplying wrappers' asText allBold. dynamicItemsText value: Text new. Cursor wait showWhile: [ self rehookDynamicReferences. ] ] ifFalse: [ dynamicMethods := Set new. dynamicClasses := Set new. ]. " reset appropriate displays" dynamicItemsText value: Text new. testStatus value: 'Dynamically referenced items were ignored' asText allBold.
overviewHelp "Open a general help window" RuntimeBuilderUI helpFor: #helpForOverview.
saveImage "Save the image before any real damage is done" testInProgress ifTrue: [ ^self ]. ObjectMemory saveDialogThenQuit: false.
stepHelp "Open a general help window" RuntimeBuilderUI helpFor: #helpForTest.
</methods> <methods> RuntimePackager.RuntimeBuilderTester <category>internals</category>
changeRequest "Need to prevent the window from closing while a test is in progress" super changeRequest ifFalse: [ ^false ]. testInProgress ifTrue: [ ( Dialog confirm: 'The test in progress must be ended before this window is closed. Ending the test now may take several minutes and no progress indicators are provided during the process. Do you want to end the test now?' ) ifTrue: [ self endTestQuietly. ^true ] ifFalse: [ ^ false ] ]. ( dynamicClasses size + dynamicMethods size + acceptedDynamicClasses size + acceptedDynamicMethods size == 0 ) ifFalse: [ ( Dialog confirm: ('Do you want to discard changes concerning \', 'dynamically referenced classes and methods?' ) withCRs ) ifFalse: [ ^false ] ]. mainApplication testCompleted. ^true
closeWindow "close the window now" dynamicClasses := Set new. dynamicMethods :=Set new. acceptedDynamicClasses := Set new. acceptedDynamicMethods := Set new. self closeRequest.
findClassByName: aSymbol "Find the named class which could be present in the System Dictionary or be currently Undeclared. If not found answer nil. Avoid using asQualifiedReference because of entanglement with the compiler. This assumes that the name is a Smalltalk name" | names binding | names := aSymbol tokensBasedOn: $. . binding :=#{Root.Smalltalk}. names do: [ :token | binding notNil ifTrue: [ binding := binding value bindingFor: token asSymbol ] ]. ( binding notNil and: [ binding isForClass ] ) ifFalse: [ binding := Undeclared bindingFor: names last asSymbol ]. ^ binding notNil ifTrue: [ binding value ] ifFalse: [ nil ]
hideProgressIndicator "Make the progress indicator border invisble and reset the indicator" | area | self resetProgressIndicator. area := self builder componentAt: #progressIndicator. area graphicsContext clippingRectangle: area bounds; clear.
hookDeletedMethods: deletedMethods using: manager "Hook all methods that will be deleted from the runtime system." | method methClass | self testStatus value: (#InstallingWrappersForMethods << #RuntimePackager >>'Installing wrappers for methods') asText allBold. tickRate := deletedMethods size // 50. self showProgressIndicator. deletedMethods keysAndValuesDo: [:behav :selectors | self progressTick. methClass := behav isMeta ifTrue: [behav soleInstance] ifFalse: [behav]. (self exemptClasses includes: methClass) ifFalse: [selectors do: [:sel | method := behav compiledMethodAt: sel ifAbsent: [nil]. method notNil ifTrue: [manager hookMethod: method selector: sel]]]]
incorporateClassReferences "Incorporate accepted class references within the sets of kept and deleted classes" | cl | acceptedDynamicClasses do: [ :cln | cl := self findClassByName: cln. keptItems deletedClasses remove: cl ifAbsent: []. keptItems keptClasses add: cl. keptItems unreferencedClasses remove: cl ifAbsent: []. ].
incorporateMethodReferences "Incorporate dynamic method references within the sets of kept and deleted methods" | cl sel | acceptedDynamicMethods do: [ :array | "array is class + isMeta + selector" cl := self findClassByName: ( array at: 1 ). sel := array at: 3. cl notNil ifTrue: [ ( array at: 2) ifTrue: [ cl := cl class ]. sel := array at: 3. keptItems keptMethods at: cl put: ( ( keptItems keptMethods at: cl ifAbsent: [ Set new ] ) add: sel; yourself ). ( keptItems deletedMethods includesKey: cl ) ifTrue: [ ( ( keptItems deletedMethods at: cl ) remove: sel ifAbsent: []; yourself ) isEmpty ifTrue: [ keptItems deletedMethods removeKey: cl ] ]. ( keptItems unreferencedMethods includesKey: cl ) ifTrue: [ ( ( keptItems unreferencedMethods at: cl ) remove: sel ifAbsent: [ ]; yourself ) isEmpty ifTrue: [ keptItems unreferencedMethods removeKey: cl ] ] ] ].
installUnhookClassBlock: runtimeManager "Set up blocks that will act upon references to deleted items. " |textView| textView := self widgetAt: #dynamicItemsText. runtimeManager unhookClassBlock: [ :cl :sel | | cln | cln := ( cl isMeta ifTrue: [ cl soleInstance ] ifFalse: [ cl ] ) fullName. dynamicClasses add: cln. textInProgress ifFalse: [ textInProgress := true. dynamicItemsText value: dynamicItemsText value, ( '(Class) ',cl fullName, ' class', ( sel isNil ifTrue: [ '' ] ifFalse: [ '>>', sel ] ), (String with:Character cr) ). textView selectAt: dynamicItemsText value size. textInProgress := false. ] ].
installUnhookMethodBlock: runtimeManager "Set up blocks that will act upon references to deleted items. " |textView| textView := self widgetAt: #dynamicItemsText. runtimeManager unhookMethodBlock: [ :cl :sel :meth | | cln | cln := ( cl isMeta ifTrue: [ cl soleInstance ] ifFalse: [ cl ] ) fullName. dynamicMethods add: ( Array with: cln with: cl isMeta with: sel ). textInProgress ifFalse: [ textInProgress := true. dynamicItemsText value: dynamicItemsText value, ( '(Method) ', cl fullName, '>>', sel, (String with: Character cr) ). textView selectAt: dynamicItemsText value size. textInProgress := false. ] ].
prepareForTest "Hook all classes and methods that would normally be stripped from runtime image. Install blocks that will record references to these items." | mgr deletedClasses deletedMethods classDeletions | " initialize and reset from previous tests " dynamicItemsText value: Text new. mgr := RuntimeSurrogateManager activeManager. mgr beginTest. mgr unhookMethodBlock: nil; unhookClassBlock: nil. mgr unhookAllMethods. mgr unhookAllClasses. textInProgress := false. self installUnhookMethodBlock: mgr. self installUnhookClassBlock: mgr. "Cache some things that will be needed later but whose accessor methods may be deleted." deletedClasses := keptItems allDeletedClassesWithLoadables: false. deletedMethods := keptItems allDeletedMethodsWithLoadables: false. self hookDeletedMethods: deletedMethods using: mgr. " hook deleted classes in hierarchial order. " self exemptClasses do: [:cl | deletedClasses remove: cl ifAbsent: []]. deletedClasses copy do: [:cl | (deletedClasses includes: cl) ifTrue: [cl allSubclasses do: [:sub | deletedClasses remove: sub ifAbsent: []]]]. classDeletions := OrderedCollection new. deletedClasses do: [:cl | classDeletions addAll: cl withAllSubclasses reverse]. " go back and hook the classes so that references can be detected " self testStatus value: (#InstallingWrappers << #RuntimePackager >> 'Installing wrappers for classes') asText allBold. tickRate := classDeletions size // 50. self showProgressIndicator. classDeletions do: [:cl | self progressTick. mgr hookClass: cl]. DeploymentOptionsSystem current isRuntime: true. " more or less done at this point " self installQuitSurrogate. self hideProgressIndicator
progressTick "Move the progress indicator one notch" | area rect | tickCounter := tickCounter + 1. tickCounter > tickRate ifTrue: [ tickCounter := 0. ( progressCounter := progressCounter + 1 ) > 50 ifTrue: [ self resetProgressIndicator. progressCounter := 1. ]. area := self builder componentAt: #progressIndicator. rect := Rectangle origin: 0.0 @ 0.0 extent: ( progressCounter / 50.0 ) @ 1.0. rect := rect scaledBy: ( area bounds insetBy: 3 ) extent. rect := rect translatedBy: area bounds origin + ( 3 @ 3). rect displayFilledOn: area graphicsContext. ].
rehookDynamicReferences "Unhook methods and classes that were dynamically referenced" | mgr methods classes classesInOrder | mgr := RuntimeSurrogateManager activeManager. " avoid case in which things somehow change underneath you " methods := dynamicMethods. classes := dynamicClasses collect: [ :cln | self findClassByName: cln ]. dynamicMethods := Set new. dynamicClasses := Set new. " Order classes so that rehooking is done in hierarchial order " classesInOrder := OrderedCollection new: methods size. classes copy do: [ :cl | cl withAllSuperclasses reverseDo: [ :scl | ( classes includes: scl ) ifTrue: [ classesInOrder add: scl. classes remove: scl ] ] ]. " rehook methods " tickRate := methods size // 50. self showProgressIndicator. methods do: [ :array | "array = class name + isMeta + selector " | cl meth sel | self progressTick. sel := array at: 3. cl := self findClassByName: ( array at: 1 ). cl notNil ifTrue: [ " class could have been unloaded " ( array at: 2 ) ifTrue: [ cl := cl class ]. meth := cl compiledMethodAt: sel ifAbsent: [ nil ]. mgr hookMethod: meth selector: sel mclass: cl ] ]. " rehook classes " tickRate := classesInOrder size // 50. self showProgressIndicator. classesInOrder reverseDo: [ :cl | self progressTick. mgr hookClass: cl ]. self hideProgressIndicator.
resetProgressIndicator "Reset the progress indicator to an intial value" | area | progressCounter := 0. self builder isNil ifFalse: [ area := self builder componentAt: #progressIndicator. area graphicsContext clippingRectangle: ( area bounds insetBy: 3 ); clear. ].
restoreMinimalDevelopmentState "Restore enough image state to provide progress feedback." "Ignore dynamic refrences during this process. " RuntimeSurrogateManager activeManager unhookMethodBlock: nil; unhookClassBlock: nil. DeploymentOptionsSystem current isRuntime: false. self restoreQuitMethod.
showLogEntry: aString "Place the information into the dynamic items area of the display" dynamicItemsText value: dynamicItemsText value, aString. ( self builder componentAt: #dynamicItemsText ) widget selectAt: dynamicItemsText value size.
showProgressIndicator "Make the progress indicator border visible and reset the indicator" | area | area := self builder componentAt: #progressIndicator. ( area bounds insetBy: 1 ) displayStrokedOn: area graphicsContext. self resetProgressIndicator.
unhookAll "Unhook all methods and classes originally hooked for this test execution" | mgr hookedClasses hookedMethods | mgr := RuntimeSurrogateManager activeManager. mgr unhookMethodBlock: nil; unhookClassBlock: nil. self testStatus value: 'Restoring classes' asText allBold. hookedClasses := mgr allHookedClasses. tickRate := hookedClasses size // 50. self showProgressIndicator. hookedClasses do: [ :cl | " The following is debug only --- self showLogEntry: 'Restoring ', cl name, (String with:Character cr). " self progressTick. mgr unhookClass: cl ]. self testStatus value: 'Restoring methods' asText allBold. hookedMethods := mgr allHookedMethods. tickRate := hookedMethods size // 50. self showProgressIndicator. hookedMethods do: [ :meth | self progressTick. mgr unhookMethod: meth ]. " reset the progress indicator - we are done" self hideProgressIndicator.
warnAboutParcelLoading "Give the user a warning about the impact of parcels" ^Dialog confirm: 'Parcels have been indicated as loadable at runtime. For purposes of the test, it is assumed that these parcels would be loaded at runtime through command line parameters and that the results of loading these parcels is the same as the current contents of the image. If these parcels or any others are loaded into the image because of application processing during the test, it is likely that the integrity of the image will be adversely affected. The test process cannot protect the image from this possibility. Do you still want to continue with the test?'
</methods> <methods> RuntimePackager.RuntimeBuilderTester <category>aspects</category>
dynamicItemsText "Answer the text describing dynamic references found so far" ^dynamicItemsText
progressIndicator "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^progressIndicator isNil ifTrue: [progressIndicator := String new asValue] ifFalse: [progressIndicator]
testStatus "This method was generated by UIDefiner. The initialization provided below may have been preempted by an initialize method." ^testStatus isNil ifTrue: [testStatus := Text new asValue] ifFalse: [testStatus]
</methods> <methods> RuntimePackager.RuntimeBuilderTester <category>accessing</category>
exemptClasses "Answer tester classes that should never be hooked as part of a test." exemptClasses notNil ifTrue: [ ^exemptClasses ]. exemptClasses := IdentitySet new. exemptClasses addAll: RuntimeManager withAllSuperclasses; addAll: RuntimeBuilderUI withAllSuperclasses; addAll: RuntimeBuilderItems withAllSuperclasses; addAll: RuntimeBuilderOptions withAllSuperclasses; addAll: RuntimeBuilderTester withAllSuperclasses. " test for case in which CMacroDefinition will ultimately be eliminated " ( ExternalInterface respondsTo: #optimizationLevel: ) ifTrue: [ exemptClasses add: ( #{CMacroDefinition} valueOrDo: [ nil ] ). ]. ^exemptClasses
keptItems "Answer the items indicated to be kept by the user" ^keptItems
keptItems: items "Set the items indicated to be kept by the user" keptItems := items
mainApplication "Answer the controlling application object" ^mainApplication
mainApplication: anApplication "Set the controlling application object" mainApplication := anApplication
options "Answer the options specified for building the runtime image" ^options
options: opts "Set the options specified for building the runtime image" options := opts
testInProgress "Answer true if a test is in progress" ^testInProgress
</methods> <methods> RuntimePackager.RuntimeBuilderTester <category>initialize-release</category>
initialize "Initialize a new instance" testInProgress := false. dynamicItemsText := Text new asValue. textInProgress := false. dynamicClasses := Set new. dynamicMethods := Set new. acceptedDynamicClasses := Set new. acceptedDynamicMethods := Set new. tickCounter := 0. tickRate := 1. progressCounter := 0.
</methods> <methods> RuntimePackager.RuntimeBuilderTester <category>image quitting</category>
installQuitSurrogate "Install the surrogate as a replacement for the quit method." | quitMethod quitSurrogate mdict | quitMethod := ObjectMemory class compiledMethodAt: #quit ifAbsent: [ ^self ]. quitSurrogate := ( self class compiledMethodAt: #quitMethodSurrogate ) shallowCopy. quitSurrogate sourcePointer: nil. mdict := ObjectMemory class instVarAt: 2. " avoid installing the surrogate twice, which is not good " ( mdict includesKey: #rtpQuit ) ifFalse: [ mdict at: #rtpQuit put: quitMethod. ]. mdict at: #quit put: quitSurrogate. ObjectMemory class flushVMmethodCache.
restoreQuitMethod "Restore the original quit method to ObjectMemory class." | quitMethod mdict | mdict := ObjectMemory class instVarAt: 2. quitMethod := mdict at: #rtpQuit ifAbsent: [ ^self ]. mdict at: #quit put: quitMethod. mdict removeKey: #rtpQuit. ObjectMemory class flushVMmethodCache.
</methods> <methods> RuntimePackager.RuntimeBuilderTester <category>interface opening</category>
open "Open if needed. Otherwise just bring to the front" ( self builder isNil or: [ self builder window isOpen not ] ) ifTrue: [ super open] ifFalse: [ self builder window raise expand ]
postBuildWith: aBuilder "Set buttons and selection lists to their initial condition" # ( endTest acceptReferences ignoreReferences ) do: [ :comp | ( aBuilder componentAt: comp ) disable ].
</methods> <methods> RuntimePackager.RuntimeBuilderTester <category>template methods</category>
quitMethodSurrogate "This method is installed in the method dictionary of ObjectMemory class to detect attempts at quitting the image while a test is active. " (Dialog confirm: 'A quit was requested during a test. Do you really want to quit the image now?') ifTrue: [self rtpQuit ]. ^self
</methods> <methods> RuntimePackager.RuntimeBuilderTester class <category>accessing</category>
activeTester "Answer the active tester instance, if any, or else nil" ^activeTester
activeTester: aTester "Set the active tester instance, if any, or else nil" activeTester := aTester
</methods> <methods> RuntimePackager.RuntimeProgressNotifier <category>internals</category>
advanceProgressIndicator "Bump the progress indicator up to the next value" | area rect | progressCount := progressCount + 1. progressCount > 50 ifTrue: [ self resetProgressIndicator. ] ifFalse: [ area := self builder componentAt: #progressString. rect := Rectangle origin: 0.0 @ 0.0 extent: ( progressCount / 50.0 ) @ 1.0. rect := rect scaledBy: ( area bounds insetBy: 3 ) extent. rect := rect translatedBy: area bounds origin + ( 3 @3 ). rect displayFilledOn: area graphicsContext. ].
changeRequest "Answer true if the window can be closed" super changeRequest ifTrue: [ ^ true ]. ended := true. ^true
checkForResize "Look to see if the window size has changed" windowExtent = self builder window extent ifFalse: [ self builder window checkForEvents. self builder window component invalidate. windowExtent := self builder window extent. textWidget selectAt: 1. textWidget selectAt: text value size. ].
resetProgressIndicator "Reset the progress indicator to an intial value" | area | progressCount := 0. self builder isNil ifFalse: [ area := self builder componentAt: #progressString. area graphicsContext clippingRectangle: ( area bounds insetBy: 3 ); clear. ].
</methods> <methods> RuntimePackager.RuntimeProgressNotifier <category>actions</category>
close "Close the window now" self closeAndUnschedule. RuntimeManager ensureUnscheduleWindow: self builder window.
cr "Send a CR to the text" ended ifTrue: [ ^ self ]. self show: (String with: Character cr).
log: aString "Print the current time and the string in the window" self show: (String with: Character cr), Time now printString, ' ' , aString. tickCount := 0. self resetProgressIndicator.
raise "Raise the window if any" self builder isNil ifTrue: [ ^nil ]. self builder window isOpen ifFalse: [ ^self ]. self builder window raise.
show: aString "Show the string in the progress window" ended ifTrue: [ ^ self ]. text value: text value, aString. textWidget selectAt: text value size. self checkForResize.
tab "Send a tab to the text" ended ifTrue: [ ^ self ]. self show: (String with: Character tab).
tick "Indicate progress by advancing the indicator" ended ifTrue: [ ^self ]. tickCount := tickCount + 1. tickCount > tickRate ifTrue: [ self checkForResize. self advanceProgressIndicator. tickCount := 0. ].
</methods> <methods> RuntimePackager.RuntimeProgressNotifier <category>initialization</category>
initialize "Intitialize the instance" tickCount := 0. tickRate := 1. text := Text new asValue. ended := false. self resetProgressIndicator.
</methods> <methods> RuntimePackager.RuntimeProgressNotifier <category>interface opening</category>
postBuildWith: aBuilder "Make the progressIndicator non-interactive" super postBuildWith: aBuilder. textWidget := ( aBuilder componentAt: #text ) widget.
</methods> <methods> RuntimePackager.RuntimeProgressNotifier <category>aspects</category>
progressString "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^progressString isNil ifTrue: [progressString := String new asValue] ifFalse: [progressString]
text "Answer the model of the currently showing text." ^text
</methods> <methods> RuntimePackager.RuntimeProgressNotifier <category>accessing</category>
tickRate "Answer the rate at which tick events are displayed" ^tickRate
tickRate: anInteger "Set the rate at which tick events are displayed" tickRate := anInteger
</methods> <methods> RuntimePackager.RuntimeProgressNotifier class <category>interface opening</category>
open "Create a new instance and open it" | x extent | x := self new. x allButOpenInterface: #windowSpec. extent := x builder windowSpec bounds extent. x builder openIn: (Rectangle origin: (Screen default bounds center - ( extent // 2 ) ) extent: extent ). ^x
</methods> <methods> Store.Method <category>public interface</category>
loadAsNewWithCommittingSource: commitSourceStream "Load the method and skip the checking since the method is new. Answer true if the compilation was successful. If commitSourceStream is false, then it is the the client's responsibility to ensure that the changes log file is flushed." | class protocol ret | class := self myClass. class == nil ifTrue: [ UnloadableDefinitionError signalWith: self. ^false ]. protocol := (self protocolName ifNil: [#unknown]) asSymbol. ret := commitSourceStream ifTrue: [ (class compile: self sourceCode classified: protocol notifying: nil attributes: nil) notNil] ifFalse: [ (class compileWithoutUsingChangeFile: self sourceCode classified: protocol notifying: nil attributes: nil) notNil]. IncrementNotification raiseSignal. ^ret
</methods> <methods> Kernel.NameSpaceOfClass <category>accessing</category>
fullyQualifiedReference ^self owner fullyQualifiedReference.
fullyQualifiedReferenceFrom: base ^self owner fullyQualifiedReferenceFrom: base.
</methods> <methods> Core.ImageConfigurationSystem <category>helpers</category>
getOptionsFrom: aStream "Override this to allow the runtime packager functionality of putting arbitrary command-line options in the config file" ^(Array with: ObjectMemory imageName with: '-pcl'), (self tokensFromStream: aStream).
processOptions: options "Override this to allow the runtime packager functionality of putting arbitrary command-line options in the config file" | optionsBySequence sequenceValues earlyOptionsBySequence | "Note that this duplicates most of runActivationActions" earlyOptionsBySequence := (DeploymentOptionsSystem current commandLineOptionsWithPositionsInCommandLine: options) groupedBy: [:each | each value sequence]. optionsBySequence := (self commandLineOptionsWithPositionsInCommandLine: options) groupedBy: [:each | each value sequence]. (Array with: earlyOptionsBySequence with: optionsBySequence) do: [:each | sequenceValues := each keys asSortedCollection. sequenceValues do: [:sequence | | interests | interests := each at: sequence. (interests asSortedCollection: [:a :b | a key <= b key]) do: [:association | association value triggerOptionAt: association key]]].
</methods> <methods> DeploymentOptionsSystem <category>command-line options</category>
hookNotifierClass: aClassName | requiredSelector notifierClass | requiredSelector := #openContext:label:proceedable:. "can be release dependent" notifierClass := RuntimePackager.RuntimeManager hiddenReferenceTo: aClassName. "use to look up name" "These used to be transcript show's, but we want this to run early enough that the transcript may not be available. And it doesn't really make sense in a runtime image anyway" notifierClass isNil ifTrue: [self error: ('Notifier class <1s> not in image.' expandMacrosWith: aClassName). ^self]. (notifierClass respondsTo: requiredSelector) ifFalse: [self error: 'Notifier class <1s> does not respond to <2s>.'. ^self]. RuntimePackager.RuntimeManager hookNotifierClass: notifierClass.
</methods> <methods> Store.PackageModel <category>private-class model</category>
extendedClasses models == nil ifTrue: [ ^OrderedCollection new: 1 ]. ^(self classModels reject: [ :cm | cm hasDefinition ]) collect: [:each | each actual].
</methods> <methods> Store.PackageModel <category>accessing</category>
withAllContainedItems ^(OrderedCollection with: self).
</methods> <methods> Store.BundleModel <category>accessing</category>
withAllContainedItems ^(OrderedCollection with: self), self allContainedItems.
</methods> <methods> Tools.ItemSelectionModule <category>accessing-selection</category>
addSelect: anObject "Select an object equal to the one passed as the argument, if found. If multi-selecting, add to the selection rather than replacing it" | item | item := self selectionAspect list detect: [:some | some value = anObject] ifNone: [^self]. useMultiSelection ifTrue: [ self selectionAspect selections: (self selectionAspect selections, (Array with: item))] ifFalse: [self selectionAspect selection: item]
</methods> <methods> Tools.TreeSelectionModule <category>accessing-selection</category>
addSelectPath: aCollection "The inherited #select: method will only select a visible item. This one will walk aCollection, selecting and expanding its elements, until either the last element is selected, or an element is encountered that cannot be found." self expandPathButLast: aCollection; addSelect: aCollection last
</methods> <methods> Tools.TreeSelectionModule <category>interface opening</category>
postBuildWith: aBuilder super postBuildWith: aBuilder. self treeWidget controller performer: menuPerformer. self treeWidget rootExpander: expandableRoots. self treeHolder list expandToLevel: preExpandLevel
</methods> <methods> RuntimePackager.RuntimeBuilderEditor class <category>resources</category>
selectionMenu "UIMenuEditor new openOnClass: self andSelector: #selectionMenu" <resource: #menu> ^#(#Menu #( #(#MenuItem #label: 'Select all' ) #(#MenuItem #label: 'Clear all' ) ) #(2 ) #(#selectAll #clearAll ) ) decodeAsLiteralArray
</methods> <methods> RuntimePackager.RuntimeExample class <category>interface specs</category>
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Smalltalk Storage Statistics' #min: #(#{Core.Point} 40 20 ) #bounds: #(#{Graphics.Rectangle} 290 285 738 632 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0591133 0 0.174041 ) #label: 'Eden bytes' ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0591133 0 0.289086 ) #label: 'Survivor space bytes' ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0591133 0 0.40413 ) #label: 'Large space bytes' ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0591133 0 0.519174 ) #label: 'Old space bytes' ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0591133 0 0.634218 ) #label: 'Perm space bytes' ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.438424 0 0.0825959 ) #label: 'Allocated' ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.770936 0 0.0825959 ) #label: 'Used' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.413793 0 0.174041 0 0.633005 0 0.247788 ) #isOpaque: true #model: #edenAlloc #alignment: #right #isReadOnly: true #type: #number ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.70936 0 0.174041 0 0.928571 0 0.247788 ) #isOpaque: true #model: #edenUsed #alignment: #right #isReadOnly: true #type: #number ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.413793 0 0.289086 0 0.633005 0 0.362832 ) #isOpaque: true #model: #survAlloc #alignment: #right #isReadOnly: true #type: #number ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.70936 0 0.289086 0 0.928571 0 0.362832 ) #isOpaque: true #model: #survUsed #alignment: #right #isReadOnly: true #type: #number ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.413793 0 0.40413 0 0.633005 0 0.477876 ) #isOpaque: true #model: #largeAlloc #alignment: #right #isReadOnly: true #type: #number ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.70936 0 0.40413 0 0.928571 0 0.477876 ) #isOpaque: true #model: #largeUsed #alignment: #right #isReadOnly: true #type: #number ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.413793 0 0.519174 0 0.633005 0 0.59292 ) #isOpaque: true #model: #oldAlloc #alignment: #right #isReadOnly: true #type: #number ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.70936 0 0.519174 0 0.928571 0 0.59292 ) #isOpaque: true #model: #oldUsed #alignment: #right #isReadOnly: true #type: #number ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.413793 0 0.634218 0 0.633005 0 0.707965 ) #isOpaque: true #model: #permAlloc #alignment: #right #isReadOnly: true #type: #number ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.70936 0 0.634218 0 0.928571 0 0.707965 ) #isOpaque: true #model: #permUsed #alignment: #right #isReadOnly: true #type: #number ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0647321 0 0.824713 0 0.321429 0 0.899425 ) #model: #setValues #label: 'Refresh' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.368304 0 0.827089 0 0.625 0 0.902017 ) #model: #forceError #label: 'Force Error' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.669643 0 0.827089 0 0.926339 0 0.902017 ) #model: #closeRequest #label: 'Close' #defaultable: true ) ) ) )
</methods> <methods> RuntimePackager.RuntimeBuilderUI class <category>interface specs</category>
windowSpec "Tools.UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #properties: #(#{UI.PropertyListDictionary} #positionType #cascade #sizeAutoSave true #openType #cascade ) #label: 'Runtime Packager' #min: #(#{Core.Point} 40 20 ) #bounds: #(#{Graphics.Rectangle} 426 384 1024 751 ) #flags: 4 #menu: #mainMenu ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0367893 0 0.0849858 0 0.598662 0 0.728045 ) #name: #stepDescription #model: #stepDescription #isReadOnly: true ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.041806 0 0.0169972 0 0.575251 0 0.0708215 ) #flags: 0 #model: #stepTitle #alignment: #center #isReadOnly: true #type: #string ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0351171 0 0.815864 0 0.210702 0 0.90085 ) #name: #previousStepButton #model: #previousStepPushed #label: '<< Previous' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.443144 0 0.815864 0 0.618729 0 0.90085 ) #name: #doThisStepButton #model: #doThisStepPushed #label: 'Do this step' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.62709 0 0.815864 0 0.802676 0 0.90085 ) #name: #takeDefaultsButton #model: #takeDefaultsPushed #label: 'Take Defaults' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.219064 0 0.815864 0 0.394649 0 0.90085 ) #name: #nextStepButton #model: #nextStepPushed #label: 'Next >>' #defaultable: true ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.640468 0 0.0679887 0 0.936455 0 0.730878 ) #label: 'Steps Completed' ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.662207 0 0.141643 ) #name: #cleanupDone #model: #cleanupDone #tabable: false #label: 'Clean Up Image' #style: #small ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.662207 0 0.212465 ) #name: #optionsDone #model: #optionsDone #tabable: false #label: 'Set Options' #style: #small ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.662207 0 0.283286 ) #name: #itemsDone #model: #itemsDone #tabable: false #label: 'Specify Kept/Deleted' #style: #small ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.662207 0 0.354108 ) #name: #scanDone #model: #scanDone #tabable: false #label: 'Scan for Unreferenced' #style: #small ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.662207 0 0.424929 ) #name: #reviewDone #model: #reviewDone #tabable: false #label: 'Review Kept/Deleted' #style: #small ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.662207 0 0.566572 ) #name: #testDone #model: #testDone #tabable: false #label: 'Test Application' #style: #small ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.662207 0 0.637394 ) #name: #memoryDone #model: #memoryDone #tabable: false #label: 'Set Memory Params' #style: #small ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.662207 0 0.495751 ) #name: #saveParcelsDone #model: #saveParcelsDone #tabable: false #label: 'Save Parcels' #style: #small ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.847826 0 0.815864 0 0.93311 0 0.90085 ) #model: #stepHelp #label: 'Help' #defaultable: true ) ) ) )
</methods> <methods> RuntimePackager.RuntimeBuilderUI class <category>resources</category>
mainMenu "Tools.MenuEditor new openOnClass: self andSelector: #mainMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'File' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Load parameters ...' #value: #loadParams ) #(#{UI.MenuItem} #rawLabel: 'Save parameters ...' #value: #saveParams ) #(#{UI.MenuItem} #rawLabel: 'Open launcher' #value: #openLauncher ) #(#{UI.MenuItem} #rawLabel: 'Save image ...' #value: #saveImage ) #(#{UI.MenuItem} #rawLabel: 'Quit image ...' #value: #quitImage ) #(#{UI.MenuItem} #rawLabel: 'Package Runtime Image' #value: #packageRuntimeImage ) #(#{UI.MenuItem} #rawLabel: 'Exit Runtime Packager' #value: #closeRequest ) ) #(2 1 2 1 1 ) nil ) ) #(#{UI.MenuItem} #rawLabel: 'Actions' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Cleanup image' #value: #cleanUpImage ) #(#{UI.MenuItem} #rawLabel: 'Set common options ...' #value: #setOptions ) #(#{UI.MenuItem} #rawLabel: 'Specify kept items ...' #value: #chooseKeptItems ) #(#{UI.MenuItem} #rawLabel: 'Scan unreferenced' #value: #traceMessages ) #(#{UI.MenuItem} #rawLabel: 'Review kept items ...' #value: #viewReferencedItems ) #(#{UI.MenuItem} #rawLabel: 'Save loadable parcels' #value: #saveParcels ) #(#{UI.MenuItem} #rawLabel: 'Test application ...' #value: #testApplication ) #(#{UI.MenuItem} #rawLabel: 'Set memory params ...' #value: #setMemoryParams ) #(#{UI.MenuItem} #rawLabel: 'Strip system' #value: #stripSystem ) ) #(2 3 1 1 2 ) nil ) ) #(#{UI.MenuItem} #rawLabel: 'Help' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Contents' #value: #helpContents ) #(#{UI.MenuItem} #rawLabel: 'Help for Current Step' #value: #stepHelp ) ) #(2 ) nil ) ) ) #(3 ) nil ) decodeAsLiteralArray
</methods> <methods> RuntimePackager.RuntimeBuilderOptionsEditor class <category>interface specs</category>
basicsSpec "UIPainter new openOnClass: self andSelector: #basicsSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Basics' #min: #(#{Core.Point} 40 20 ) #bounds: #(#{Graphics.Rectangle} 243 294 657 600 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{Core.Point} 9 12 ) #label: 'Startup Class' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 7 80 ) #label: 'Startup Method' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 9 149 ) #label: 'Runtime Image Path Name' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 10 38 334 63 ) #name: #startupClass #isOpaque: true #model: #startupClass #menu: #startupClassMenu #type: #string ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 364 38 396 63 ) #model: #findStartupClass #label: '?' #defaultable: true ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 10 106 334 131 ) #name: #startupMethod #isOpaque: true #model: #startupMethod #menu: #startupMethodMenu #type: #string ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 364 106 396 131 ) #model: #findStartupMethod #label: '?' #defaultable: true ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 11 175 335 200 ) #name: #imagePath #isOpaque: true #model: #imagePath ) ) ) )
detailsSpec "Tools.UIPainter new openOnClass: self andSelector: #detailsSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #properties: #(#{UI.PropertyListDictionary} #positionType #cascade #sizeAutoSave true #openType #cascade ) #label: 'Details' #min: #(#{Core.Point} 417 301 ) #max: #(#{Core.Point} 417 301 ) #bounds: #(#{Graphics.Rectangle} 512 384 929 685 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 25 192 388 282 ) #label: 'Action on last window close' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 25 16 ) #name: #removeCompiler #model: #removeCompiler #label: 'Remove compiler classes' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 25 40 ) #name: #headlessImage #model: #headlessImage #label: 'Build headless image' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 25 64 ) #name: #clearParcelPath #model: #clearParcelPath #label: 'Clear parcel search path' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 25 88 ) #name: #doThreeSaves #model: #doThreeSaves #label: 'Use three-step save procedure' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 25 112 ) #name: #skipScan #model: #skipScan #label: 'Skip default scan for unreferenced items' ) #(#{UI.RadioButtonSpec} #layout: #(#{Core.Point} 26 214 ) #name: #shutdown #model: #lastWindowCloseAction #label: 'Shutdown image' #select: #shutdown ) #(#{UI.RadioButtonSpec} #layout: #(#{Core.Point} 201 214 ) #model: #lastWindowCloseAction #label: 'Continue processing' #select: #continue ) #(#{UI.RadioButtonSpec} #layout: #(#{Core.Point} 26 242 ) #model: #lastWindowCloseAction #label: 'Standard Behavior (e.g. open launcher)' #select: #standard ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 25 135 ) #name: #suppressSplashScreen #model: #suppressSplashScreen #label: 'Suppress splash screen and herald sound' ) ) ) )
emptySpec "UIPainter new openOnClass: self andSelector: #emptySpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: 'Unlabeled Canvas' #bounds: #(#Rectangle 252 286 626 552 ) ) #component: #(#SpecCollection #collection: #() ) )
exceptionsSpec "UIPainter new openOnClass: self andSelector: #exceptionsSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Exceptions' #min: #(#{Core.Point} 40 20 ) #bounds: #(#{Graphics.Rectangle} 301 288 723 601 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{Core.Point} 17 26 ) #label: 'Error Notifier Class' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 17 148 ) #label: 'Error Log Path Name' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 17 87 ) #label: 'Image Dumper Class' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 17 52 343 77 ) #name: #errorNotifierClass #isOpaque: true #model: #errorNotifierClass #menu: #errorNotifierMenu #type: #string ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 363 52 395 77 ) #model: #findErrorNotifierClass #label: '?' #defaultable: true ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 17 113 343 138 ) #name: #imageDumperClass #isOpaque: true #model: #imageDumperClass #menu: #imageDumperMenu #type: #string ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 363 113 395 138 ) #model: #findImageDumperClass #label: '?' #defaultable: true ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 17 174 343 200 ) #name: #errorLogPath #isOpaque: true #model: #errorLogPath ) ) ) )
parcelsSpec "UIPainter new openOnClass: self andSelector: #parcelsSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Parcels' #min: #(#{Core.Point} 40 20 ) #bounds: #(#{Graphics.Rectangle} 243 263 676 595 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 3 149 419 326 ) ) #(#{UI.LabelSpec} #layout: #(#{Graphics.Rectangle} 112 1 161 22 ) #label: 'Parcel' ) #(#{UI.LabelSpec} #layout: #(#{Graphics.Rectangle} 43 292 123 313 ) #label: 'Path Name' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 34 219 ) #label: 'Save Option' ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.Rectangle} 6 22 275 140 ) #name: #parcelList #model: #parcelList #menu: #parcelsMenu #useModifierKeys: true #selectionType: #highlight ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 283 22 417 47 ) #name: #newParcel #model: #newParcel #label: 'New Parcel' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 283 53 417 78 ) #name: #unloadParcel #model: #unloadParcel #label: 'Unload Parcel' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 283 84 417 109 ) #name: #discardParcel #model: #discardParcel #label: 'Discard Parcel' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 283 115 417 140 ) #name: #browseParcels #model: #browseParcels #label: 'Browse Parcels' #defaultable: true ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 34 162 ) #name: #parcelIsLoadable #model: #parcelIsLoadable #label: 'Parcel is loaded into image at runtime' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 34 186 ) #name: #parcelUnloadBeforeStrip #model: #parcelUnloadBeforeStrip #label: 'Unload before saving runtime image' ) #(#{UI.RadioButtonSpec} #layout: #(#{Core.Point} 158 221 ) #name: #stripParcel #model: #parcelSaveOption #label: 'Strip unreferenced items and save' #select: #stripParcel ) #(#{UI.RadioButtonSpec} #layout: #(#{Core.Point} 158 240 ) #name: #saveParcel #model: #parcelSaveOption #label: 'Save full parcel' #select: #saveParcel ) #(#{UI.RadioButtonSpec} #layout: #(#{Core.Point} 158 259 ) #name: #doNotSaveParcel #model: #parcelSaveOption #label: 'Do not save' #select: #doNotSaveParcel ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 158 288 370 313 ) #name: #parcelPath #model: #parcelPath ) ) ) )
platformsSpec "Tools.UIPainter new openOnClass: self andSelector: #platformsSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Platforms' #bounds: #(#{Graphics.Rectangle} 700 525 1074 791 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 20 15 298 115 ) #label: 'UI Looks' ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 20 126 297 207 ) #label: 'Operating Systems' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 42 37 ) #name: #uiLookWindows #model: #uiLookWindows #label: 'Windows' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 42 61 ) #name: #uiLookMotif #model: #uiLookMotif #label: 'Motif' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 42 85 ) #name: #uiLookMac #model: #uiLookMac #label: 'Mac' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 42 152 ) #name: #osWindows #model: #osWindows #label: 'Windows' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 42 176 ) #name: #osUnix #model: #osUnix #label: 'Unix' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 161 152 ) #name: #osMac #model: #osMac #label: 'Mac' ) ) ) )
strippingSpec "UIPainter new openOnClass: self andSelector: #strippingSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Stripping' #min: #(#{Core.Point} 40 20 ) #bounds: #(#{Graphics.Rectangle} 367 276 786 589 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{Core.Point} 20 209 ) #label: 'Prestrip Class' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 20 242 ) #label: 'Prestrip Method' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 20 174 ) #label: 'Trace Level' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 19 13 ) #name: #removeOrganization #model: #removeOrganization #label: 'Remove system organization' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 19 35 ) #name: #packageExternalInterfaces #model: #packageExternalInterfaces #label: 'Package external interfaces' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 19 57 ) #name: #mergeByteCodes #model: #mergeByteCodes #label: 'Merge method and block byte codes' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 19 79 ) #name: #useRuntimeCompiledMethod #model: #useRuntimeCompiledMethod #label: 'Use compact compiled methods' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 19 101 ) #name: #mergeLiterals #model: #mergeLiterals #label: 'Merge literals' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 19 123 ) #name: #mergeMethods #model: #mergeMethods #label: 'Merge methods' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 20 145 ) #name: #stripGlobals #model: #stripGlobals #label: 'Remove unreferenced globals' ) #(#{UI.RadioButtonSpec} #layout: #(#{Core.Point} 148 176 ) #model: #traceLevel #label: 'None' #select: 0 ) #(#{UI.RadioButtonSpec} #layout: #(#{Core.Point} 227 176 ) #model: #traceLevel #label: 'Medium' #select: 2 ) #(#{UI.RadioButtonSpec} #layout: #(#{Core.Point} 321 176 ) #model: #traceLevel #label: 'High' #select: 4 ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 148 209 367 230 ) #name: #prestripClass #model: #prestripClass #menu: #prestripClassMenu ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 381 209 407 230 ) #model: #findPrestripClass #label: '?' #defaultable: true ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 148 242 367 263 ) #name: #prestripMethod #model: #prestripMethod #menu: #prestripMethodMenu ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 381 242 407 263 ) #model: #findPrestripMethod #label: '?' #defaultable: true ) ) ) )
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: 'Runtime Packager Common Options' #min: #(#Point 40 20 ) #bounds: #(#Rectangle 221 253 807 701 ) #flags: 12 #menu: #mainMenu ) #component: #(#SpecCollection #collection: #( #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.0684931 0 0.908665 0 0.238014 0 0.971897 ) #model: #accept #label: 'OK' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.724315 0 0.906323 0 0.893836 0 0.969555 ) #model: #cancel #label: 'Cancel' #defaultable: true ) #(#NoteBookSpec #layout: #(#LayoutFrame 0 0.0256849 0 0.030445 0 0.962329 0 0.86651 ) #name: #notebook #model: #tabs #tabable: false #rightInset: 80 #bottomInset: 0 ) ) ) )
</methods> <methods> RuntimePackager.RuntimeBuilderOptionsEditor class <category>resources</category>
errorNotifierMenu "UIMenuEditor new openOnClass: self andSelector: #errorNotifierMenu" <resource: #menu> ^#(#Menu #( #(#MenuItem #label: 'Find class ...' ) ) #(1 ) #(#findErrorNotifierClass ) ) decodeAsLiteralArray
imageDumperMenu "UIMenuEditor new openOnClass: self andSelector: #imageDumperMenu" <resource: #menu> ^#(#Menu #( #(#MenuItem #label: 'Find class ...' ) ) #(1 ) #(#findImageDumperClass ) ) decodeAsLiteralArray
mainMenu "UIMenuEditor new openOnClass: self andSelector: #mainMenu" <resource: #menu> ^#(#Menu #( #(#MenuItem #label: 'Help' #submenu: #(#Menu #( #(#MenuItem #label: 'Overview' ) #(#MenuItem #label: 'This Step' ) ) #(2 ) #(#overviewHelp #stepHelp ) ) ) ) #(1 ) #(nil ) ) decodeAsLiteralArray
parcelsMenu "MenuEditor new openOnClass: self andSelector: #parcelsMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Update' #value: #buildParcelList ) ) #(1 ) nil ) decodeAsLiteralArray
prestripClassMenu "UIMenuEditor new openOnClass: self andSelector: #prestripClassMenu" <resource: #menu> ^#(#Menu #( #(#MenuItem #label: 'Find class ...' ) ) #(1 ) #(#findPrestripClass ) ) decodeAsLiteralArray
prestripMethodMenu "UIMenuEditor new openOnClass: self andSelector: #prestripMethodMenu" <resource: #menu> ^#(#Menu #( #(#MenuItem #label: 'Find method ...' ) ) #(1 ) #(#findPrestripMethod ) ) decodeAsLiteralArray
startupClassMenu "UIMenuEditor new openOnClass: self andSelector: #startupClassMenu" <resource: #menu> ^#(#Menu #( #(#MenuItem #label: 'Find class ...' ) ) #(1 ) #(#findStartupClass ) ) decodeAsLiteralArray
startupMethodMenu "UIMenuEditor new openOnClass: self andSelector: #startupMethodMenu" <resource: #menu> ^#(#Menu #( #(#MenuItem #label: 'Find method ...' ) ) #(1 ) #(#findStartupMethod ) ) decodeAsLiteralArray
</methods> <methods> RuntimePackager.RuntimeBuilderItemsChooser class <category>resources</category>
contingentClassesMenu "MenuEditor new openOnClass: self andSelector: #contingentClassesMenu" <resource: #menu> ^#(#{Menu} #( #(#{MenuItem} #rawLabel: 'Select all' #value: #selectAllContingentClasses ) #(#{MenuItem} #rawLabel: 'Clear all' #value: #clearAllContingentClasses ) #(#{MenuItem} #rawLabel: 'Browse' #value: #browseContingentClasses ) #(#{MenuItem} #rawLabel: 'Select class' #value: #selectContingentClass ) #(#{MenuItem} #rawLabel: 'References' #value: #extendedReferenceContingentClasses ) ) #(2 3 ) nil ) decodeAsLiteralArray
contingentMethodsMenu "MenuEditor new openOnClass: self andSelector: #contingentMethodsMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllContingentMethods ) #(#{UI.MenuItem} #rawLabel: 'Select category' #value: #selectContingentMethodsByCategory ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllContingentMethods ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseContingentMethods ) #(#{UI.MenuItem} #rawLabel: 'References' #value: #extendedReferenceContingentMethods ) ) #(3 2 ) nil ) decodeAsLiteralArray
deletedClassesMenu "MenuEditor new openOnClass: self andSelector: #deletedClassesMenu" <resource: #menu> ^#(#{Menu} #( #(#{MenuItem} #rawLabel: 'Select all' #value: #selectAllDeletedClasses ) #(#{MenuItem} #rawLabel: 'Clear all' #value: #clearAllDeletedClasses ) #(#{MenuItem} #rawLabel: 'Browse' #value: #browseDeletedClasses ) #(#{MenuItem} #rawLabel: 'Select class' #value: #selectDeletedClass ) #(#{MenuItem} #rawLabel: 'References' #value: #extendedReferenceDeletedClasses ) ) #(2 3 ) nil ) decodeAsLiteralArray
deletedMethodsMenu "MenuEditor new openOnClass: self andSelector: #deletedMethodsMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllDeletedMethods ) #(#{UI.MenuItem} #rawLabel: 'Select category' #value: #selectDeletedMethodsByCategory ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllDeletedMethods ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseDeletedMethods ) #(#{UI.MenuItem} #rawLabel: 'References' #value: #extendedReferenceDeletedMethods ) ) #(3 2 ) nil ) decodeAsLiteralArray
keptClassesMenu "MenuEditor new openOnClass: self andSelector: #keptClassesMenu" <resource: #menu> ^#(#{Menu} #( #(#{MenuItem} #rawLabel: 'Select all' #value: #selectAllKeptClasses ) #(#{MenuItem} #rawLabel: 'Clear all' #value: #clearAllKeptClasses ) #(#{MenuItem} #rawLabel: 'Browse' #value: #browseKeptClasses ) #(#{MenuItem} #rawLabel: 'Select class' #value: #selectKeptClass ) #(#{MenuItem} #rawLabel: 'References' #value: #extendedReferenceKeptClasses ) ) #(2 3 ) nil ) decodeAsLiteralArray
keptMethodsMenu "MenuEditor new openOnClass: self andSelector: #keptMethodsMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllKeptMethods ) #(#{UI.MenuItem} #rawLabel: 'Select category' #value: #selectKeptMethodsByCategory ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllKeptMethods ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseKeptMethods ) #(#{UI.MenuItem} #rawLabel: 'References' #value: #extendedReferenceKeptMethods ) ) #(3 2 ) nil ) decodeAsLiteralArray
mainMenuVW "Tools.MenuEditor new openOnClass: self andSelector: #mainMenuVW" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Packages/Bundles' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllCategories ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllCategories ) #(#{UI.MenuItem} #rawLabel: 'Find Package ...' #value: #findPackage #shortcutKeyCharacter: $p #shortcutModifiers: 3 ) #(#{UI.MenuItem} #rawLabel: 'Find Class/Variable/Name Space...' #value: #findCategoryWithGlobal #shortcutKeyCharacter: $f #shortcutModifiers: 3 ) #(#{UI.MenuItem} #rawLabel: 'Select Prerequisites' #value: #selectPrerequisites #enablementSelector: #isPundleSelected ) #(#{UI.MenuItem} #rawLabel: 'Keep' #value: #keepSelectedPundle #enablementSelector: #isPundleSelected ) #(#{UI.MenuItem} #rawLabel: 'Delete' #value: #deleteSelectedPundle #enablementSelector: #isPundleSelected ) #(#{UI.MenuItem} #rawLabel: 'Make Contingent' #value: #makeSelectedPundleContingent #enablementSelector: #isPundleSelected ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseSelectedPundle #enablementSelector: #isPundleSelected #shortcutKeyCharacter: $b #shortcutModifiers: 3 ) #(#{UI.MenuItem} #rawLabel: 'Reset to Defaults' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Selected Only' #value: #resetSelectedCategoriesToDefaults ) #(#{UI.MenuItem} #rawLabel: 'All' #value: #resetAllCategoriesToDefaults ) ) #(2 ) nil ) ) ) #(2 3 4 1 ) nil ) ) #(#{UI.MenuItem} #rawLabel: 'Classes' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Deleted' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllDeletedClasses ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllDeletedClasses ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseDeletedClasses ) #(#{UI.MenuItem} #rawLabel: 'Select class' #value: #selectDeletedClass ) #(#{UI.MenuItem} #rawLabel: 'References' #value: #extendedReferenceDeletedClasses ) ) #(2 3 ) nil ) ) #(#{UI.MenuItem} #rawLabel: 'Contingent' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllContingentClasses ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllContingentClasses ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseContingentClasses ) #(#{UI.MenuItem} #rawLabel: 'Select class' #value: #selectContingentClass ) #(#{UI.MenuItem} #rawLabel: 'References' #value: #extendedReferenceContingentClasses ) ) #(2 3 ) nil ) ) #(#{UI.MenuItem} #rawLabel: 'Kept' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllKeptClasses ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllKeptClasses ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseKeptClasses ) #(#{UI.MenuItem} #rawLabel: 'Select class' #value: #selectKeptClass ) #(#{UI.MenuItem} #rawLabel: 'References' #value: #extendedReferenceKeptClasses ) ) #(2 3 ) nil ) ) ) #(3 ) nil ) ) #(#{UI.MenuItem} #rawLabel: 'Methods' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Deleted' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllDeletedMethods ) #(#{UI.MenuItem} #rawLabel: 'Select category' #value: #selectDeletedMethodsByCategory ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllDeletedMethods ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseDeletedMethods ) #(#{UI.MenuItem} #rawLabel: 'Implementors' #value: #implementorsOfDeletedMethods ) #(#{UI.MenuItem} #rawLabel: 'References' #value: #extendedReferenceDeletedMethods ) ) #(3 1 2 ) nil ) ) #(#{UI.MenuItem} #rawLabel: 'Contingent' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllContingentMethods ) #(#{UI.MenuItem} #rawLabel: 'Select category' #value: #selectContingentMethodsByCategory ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllContingentMethods ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseContingentMethods ) #(#{UI.MenuItem} #rawLabel: 'Implementors' #value: #implementorsOfContingentMethods ) #(#{UI.MenuItem} #rawLabel: 'References' #value: #extendedReferenceContingentMethods ) ) #(3 1 2 ) nil ) ) #(#{UI.MenuItem} #rawLabel: 'Kept' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllKeptMethods ) #(#{UI.MenuItem} #rawLabel: 'Select category' #value: #selectKeptMethodsByCategory ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllKeptMethods ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseKeptMethods ) #(#{UI.MenuItem} #rawLabel: 'Implementors' #value: #implementorsOfKeptMethods ) #(#{UI.MenuItem} #rawLabel: 'References' #value: #extendedReferenceKeptMethods ) ) #(3 1 2 ) nil ) ) ) #(3 ) nil ) ) #(#{UI.MenuItem} #rawLabel: 'Help' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Overview' #value: #overviewHelp ) #(#{UI.MenuItem} #rawLabel: 'This Step' #value: #stepHelp ) ) #(2 ) nil ) ) ) #(4 ) nil ) decodeAsLiteralArray
systemSelectionMenu "Tools.MenuEditor new openOnClass: self andSelector: #systemSelectionMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllCategories ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllCategories ) #(#{UI.MenuItem} #rawLabel: 'Find Package...' #value: #findPackage #shortcutKeyCharacter: $p #shortcutModifiers: 3 ) #(#{UI.MenuItem} #rawLabel: 'Find Class/Variable/Name Space...' #value: #findCategoryWithGlobal #shortcutKeyCharacter: $f #shortcutModifiers: 3 ) #(#{UI.MenuItem} #rawLabel: 'Select Prerequisites' #value: #selectPrerequisites #enablementSelector: #isPundleSelected ) #(#{UI.MenuItem} #rawLabel: 'Keep' #value: #keepSelectedPundle #enablementSelector: #isPundleSelected ) #(#{UI.MenuItem} #rawLabel: 'Delete' #value: #deleteSelectedPundle #enablementSelector: #isPundleSelected ) #(#{UI.MenuItem} #rawLabel: 'Make Contingent' #value: #makeSelectedPundleContingent #enablementSelector: #isPundleSelected ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseSelectedPundle #enablementSelector: #isPundleSelected #shortcutKeyCharacter: $b #shortcutModifiers: 3 ) #(#{UI.MenuItem} #rawLabel: 'Reset to Defaults' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Selected Only' #value: #resetSelectedCategoriesToDefaults ) #(#{UI.MenuItem} #rawLabel: 'All' #value: #resetAllCategoriesToDefaults ) ) #(2 ) nil ) ) ) #(2 3 4 1 ) nil ) decodeAsLiteralArray
</methods> <methods> RuntimePackager.RuntimeBuilderItemsChooser class <category>interface specs</category>
windowSpec "Tools.UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #properties: #(#{UI.PropertyListDictionary} #positionType #cascade #sizeAutoSave true #openType #cascade ) #label: 'Runtime Class and Method Selection' #min: #(#{Core.Point} 20 20 ) #bounds: #(#{Graphics.Rectangle} 700 525 1311 956 ) #flags: 4 #menu: #mainMenu ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.729951 0 0.239808 ) #label: 'Kept Classes/Globals' #style: #default ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.358429 0 0.239808 ) #label: 'Contingent Classes/Globals' #style: #default ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0376432 0 0.239808 ) #label: 'Deleted Classes/Globals' #style: #default ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.765957 0 0.561151 ) #label: 'Kept Methods' #style: #default ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.394435 0 0.561151 ) #label: 'Contingent Methods' #style: #default ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0458265 5 0 0 0.977087 0 0.0611247 ) #name: #categoryListTitle #flags: 0 #model: #categoryListTitle #tabable: false #alignment: #center #style: #default #isReadOnly: true #type: #text ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0736498 0 0.561151 ) #label: 'Deleted Methods' #style: #default ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0278232 0 0.29976 0 0.301146 0 0.549161 ) #name: #deletedClassesList #flags: 15 #model: #deletedClassesList #menu: #deletedClassesMenu #multipleSelections: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.309329 0 0.340528 0 0.358429 0 0.395683 ) #model: #moveClassesContingentToDeleted #label: '<<' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.309329 0 0.407674 0 0.358429 0 0.46283 ) #model: #moveClassesDeletedToContingent #label: '>>' #defaultable: true ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.364975 0 0.302158 0 0.638298 0 0.551559 ) #name: #contingentClassesList #flags: 15 #model: #contingentClassesList #menu: #contingentClassesMenu #multipleSelections: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.648118 0 0.342926 0 0.697218 0 0.398082 ) #model: #moveClassesKeptToContigent #label: '<<' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.648118 0 0.407674 0 0.697218 0 0.46283 ) #model: #moveClassesContingentToKept #label: '>>' #defaultable: true ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.703764 0 0.302158 0 0.977087 0 0.551559 ) #name: #keptClassesList #flags: 15 #model: #keptClassesList #menu: #keptClassesMenu #multipleSelections: true ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0278232 0 0.618705 0 0.301146 0 0.868105 ) #name: #deletedMethodsList #flags: 15 #model: #deletedMethodsList #menu: #deletedMethodsMenu #multipleSelections: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.309329 0 0.659472 0 0.358429 0 0.714628 ) #model: #moveMethodsContingentToDeleted #label: '<<' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.309329 0 0.726619 0 0.358429 0 0.781775 ) #model: #moveMethodsDeletedToContingent #label: '>>' #defaultable: true ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.364975 0 0.618705 0 0.638298 0 0.868105 ) #name: #contingentMethodsList #flags: 15 #model: #contingentMethodsList #menu: #contingentMethodsMenu #multipleSelections: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.648118 0 0.659472 0 0.697218 0 0.714628 ) #model: #moveMethodsKeptToContingent #label: '<<' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.648118 0 0.726619 0 0.697218 0 0.781775 ) #model: #moveMethodsContingentToKept #label: '>>' #defaultable: true ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.703764 0 0.618705 0 0.977087 0 0.868105 ) #name: #keptMethodsList #flags: 15 #model: #keptMethodsList #menu: #keptMethodsMenu #multipleSelections: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0785597 0 0.901679 0 0.229133 0 0.966427 ) #model: #accept #label: 'OK' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.754501 0 0.901679 0 0.905074 0 0.966427 ) #model: #cancel #label: 'Cancel' #defaultable: true ) #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0310966 5 0.0611247 0 0.977087 0 0.229829 ) #name: #systemCategoriesList #majorKey: #{TreeSelectionModule} #minorKey: #multiSelectSpecWithNoScrollbar #clientKey: #systemPackagesTree ) ) ) )
</methods> <methods> RuntimePackager.RuntimeBuilderItemsViewer class <category>interface specs</category>
windowSpec "Tools.UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #properties: #(#{UI.PropertyListDictionary} #positionType #cascade #sizeAutoSave true #openType #cascade ) #label: 'Runtime Kept Items Viewer' #min: #(#{Core.Point} 20 20 ) #bounds: #(#{Graphics.Rectangle} 422 341 1024 768 ) #flags: 4 #menu: #mainMenu ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.60299 0 0.244552 ) #label: 'Kept Classes/Globals' #style: #default ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.121262 0 0.244552 ) #label: 'Deleted Classes/Globals' #style: #default ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.641196 0 0.539952 ) #label: 'Kept Methods' #style: #default ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.159468 0 0.539952 ) #label: 'Deleted Methods' #style: #default ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.317276 0 0.878935 0 0.700997 0 0.975787 ) #name: #showParcelsAsGroup #label: 'Show loadable parcels as' ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0714286 0 0.305085 0 0.456811 0 0.539952 ) #name: #deletedClassesList #flags: 15 #model: #deletedClassesList #menu: #deletedClassesMenu #multipleSelections: true ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.534884 0 0.305085 0 0.920266 0 0.539952 ) #name: #keptClassesList #flags: 15 #model: #keptClassesList #menu: #keptClassesMenu #multipleSelections: true ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0730897 0 0.600484 0 0.458472 0 0.854722 ) #name: #deletedMethodsList #flags: 15 #model: #deletedMethodsList #menu: #deletedMethodsMenu #multipleSelections: true ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.536545 0 0.600484 0 0.921927 0 0.854722 ) #name: #keptMethodsList #flags: 15 #model: #keptMethodsList #menu: #keptMethodsMenu #multipleSelections: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0697674 0 0.912833 0 0.219269 0 0.975787 ) #model: #generateReport #label: 'Report' #defaultable: true ) #(#{UI.RadioButtonSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.380399 0 0.922518 ) #name: #showParcelsAsDeleted #model: #showParcelsAs #label: 'Deleted' #select: #deleted ) #(#{UI.RadioButtonSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.51495 0 0.922518 ) #name: #showParcelsAsKept #model: #showParcelsAs #label: 'Kept' #select: #kept ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.774086 0 0.912833 0 0.923588 0 0.975787 ) #model: #accept #label: 'Close' #defaultable: true ) #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0714286 30 0 0 0.920266 0 0.229829 ) #name: #Subcanvas1 #majorKey: #{TreeSelectionModule} #minorKey: #multiSelectSpecWithNoScrollbar #clientKey: #systemPackagesTree ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutSizedOrigin} -115 0.5 6 0 231 21 ) #name: #categoryListTitle #flags: 0 #model: #categoryListTitle #tabable: false #alignment: #center #isReadOnly: true #type: #text ) ) ) )
</methods> <methods> RuntimePackager.RuntimeBuilderItemsViewer class <category>resources</category>
mainMenuVW "Tools.MenuEditor new openOnClass: self andSelector: #mainMenuVW" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Package/Bundle' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllCategories ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllCategories ) #(#{UI.MenuItem} #rawLabel: 'Find Package ...' #value: #findPackage #shortcutKeyCharacter: $p #shortcutModifiers: 3 ) #(#{UI.MenuItem} #rawLabel: 'Find Class/Variable/Name Space...' #value: #findCategoryWithGlobal #shortcutKeyCharacter: $f #shortcutModifiers: 3 ) #(#{UI.MenuItem} #rawLabel: 'Select Prerequisites' #value: #selectPrerequisites #enablementSelector: #isPundleSelected ) #(#{UI.MenuItem} #rawLabel: 'Browse Selected' #value: #browseSelectedPundle #shortcutKeyCharacter: $b #shortcutModifiers: 3 ) ) #(2 3 1 ) nil ) ) #(#{UI.MenuItem} #rawLabel: 'Classes' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Deleted' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllDeletedClasses ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllDeletedClasses ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseDeletedClasses ) #(#{UI.MenuItem} #rawLabel: 'Select class' #value: #selectDeletedClass ) #(#{UI.MenuItem} #rawLabel: 'References' #value: #extendedReferenceDeletedClasses ) ) #(2 3 ) nil ) ) #(#{UI.MenuItem} #rawLabel: 'Kept' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllKeptClasses ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllKeptClasses ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseKeptClasses ) #(#{UI.MenuItem} #rawLabel: 'Select class' #value: #selectKeptClass ) #(#{UI.MenuItem} #rawLabel: 'References' #value: #extendedReferenceKeptClasses ) ) #(2 3 ) nil ) ) ) #(2 ) nil ) ) #(#{UI.MenuItem} #rawLabel: 'Methods' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Deleted' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllDeletedMethods ) #(#{UI.MenuItem} #rawLabel: 'Select category' #value: #selectDeletedMethodsByCategory ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllDeletedMethods ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseDeletedMethods ) #(#{UI.MenuItem} #rawLabel: 'Implementors' #value: #implementorsOfDeletedMethods ) #(#{UI.MenuItem} #rawLabel: 'References' #value: #extendedReferenceDeletedMethods ) ) #(3 1 2 ) nil ) ) #(#{UI.MenuItem} #rawLabel: 'Kept' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllKeptMethods ) #(#{UI.MenuItem} #rawLabel: 'Select category' #value: #selectKeptMethodsByCategory ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllKeptMethods ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseKeptMethods ) #(#{UI.MenuItem} #rawLabel: 'Implementors' #value: #implementorsOfKeptMethods ) #(#{UI.MenuItem} #rawLabel: 'References' #value: #extendedReferenceKeptMethods ) ) #(3 1 2 ) nil ) ) ) #(2 ) nil ) ) #(#{UI.MenuItem} #rawLabel: 'Help' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Overview' #value: #overviewHelp ) #(#{UI.MenuItem} #rawLabel: 'This Step' #value: #stepHelp ) ) #(2 ) nil ) ) ) #(4 ) nil ) decodeAsLiteralArray
systemSelectionMenu "Tools.MenuEditor new openOnClass: self andSelector: #systemSelectionMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Select all' #value: #selectAllCategories ) #(#{UI.MenuItem} #rawLabel: 'Clear all' #value: #clearAllCategories ) #(#{UI.MenuItem} #rawLabel: 'Find Package...' #value: #findPackage #shortcutKeyCharacter: $p #shortcutModifiers: 3 ) #(#{UI.MenuItem} #rawLabel: 'Find Class/Variable/Name Space...' #value: #findCategoryWithGlobal #shortcutKeyCharacter: $f #shortcutModifiers: 3 ) #(#{UI.MenuItem} #rawLabel: 'Select Prerequisites' #value: #selectPrerequisites #enablementSelector: #isPundleSelected ) #(#{UI.MenuItem} #rawLabel: 'Browse Selected' #value: #browseSelectedPundle #shortcutKeyCharacter: $b #shortcutModifiers: 3 ) ) #(2 3 1 ) nil ) decodeAsLiteralArray
</methods> <methods> RuntimePackager.RuntimeBuilderReferenceBrowser class <category>resources</category>
referencesMenu "MenuEditor new openOnClass: self andSelector: #referencesMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'References' #value: #newReferences ) #(#{UI.MenuItem} #rawLabel: 'Class References' #value: #newClassReferences ) #(#{UI.MenuItem} #rawLabel: 'Browse' #value: #browseReference ) #(#{UI.MenuItem} #rawLabel: 'Browse Class' #value: #browseReferenceClass ) #(#{UI.MenuItem} #rawLabel: 'Clear Cache' #value: #clearCache ) ) #(2 2 1 ) nil ) decodeAsLiteralArray
targetsMenu "MenuEditor new openOnClass: self andSelector: #targetsMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Add ...' #value: #addTargetFromUser ) #(#{UI.MenuItem} #rawLabel: 'Remove' #value: #removeTarget ) #(#{UI.MenuItem} #rawLabel: 'Sort' #value: #sortTargets ) ) #(3 ) nil ) decodeAsLiteralArray
</methods> <methods> RuntimePackager.RuntimeBuilderReferenceBrowser class <category>interface specs</category>
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Extended References Browser' #min: #(#{Core.Point} 20 20 ) #bounds: #(#{Graphics.Rectangle} 239 247 798 650 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.TextEditorSpec} #layout: #(#{UI.LayoutFrame} 7 0 0 0.488834 0 0.987478 0 0.985112 ) #name: #referenceFoundText #model: #referenceFoundText #isReadOnly: true ) #(#{UI.LabelSpec} #layout: #(#{UI.LayoutOrigin} 0 0.436494 1 0 ) #label: 'References to Target' ) #(#{UI.SequenceViewSpec} #layout: #(#{UI.LayoutFrame} 7 0 0 0.0496278 0 0.404293 0 0.476427 ) #name: #targetsList #flags: 15 #model: #targetsList #menu: #targetsMenu ) #(#{UI.SequenceViewSpec} #layout: #(#{UI.LayoutFrame} 0 0.413238 0 0.0545906 0 0.987478 0 0.476427 ) #name: #referencesList #flags: 15 #model: #referencesList #menu: #referencesMenu ) #(#{UI.CheckBoxSpec} #layout: #(#{UI.LayoutOrigin} 0 0.760286 0 0.00496278 ) #name: #keptItemsFilter #model: #keptItemsFilter #label: 'Kept Items Only' ) #(#{UI.LabelSpec} #layout: #(#{UI.LayoutOrigin} 0 0.175313 1 0 ) #label: 'Target' ) ) ) )
</methods> <methods> RuntimePackager.RuntimeBuilderMemoryParamEditor class <category>interface specs</category>
windowSpec "Tools.UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #(#{Kernel.UserMessage} #key: #runtimeMemoryParameters #defaultString: 'Runtime Memory Parameters' #catalogID: #RuntimePackager ) #min: #(#{Core.Point} 498 395 ) #max: #(#{Core.Point} 0 0 ) #bounds: #(#{Graphics.Rectangle} 700 525 1198 920 ) #menu: #mainMenu ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{UI.AlignmentOrigin} 20 0 52 0 0 1 ) #label: 'Eden:' ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.LayoutFrame} 10 0 10 0 -110 1 245 0 ) #label: 'Space Sizes' ) #(#{UI.LabelSpec} #layout: #(#{UI.AlignmentOrigin} 20 0 102 0 0 1 ) #label: 'Survivor:' ) #(#{UI.LabelSpec} #layout: #(#{UI.AlignmentOrigin} 20 0 152 0 0 1 ) #label: 'Large:' ) #(#{UI.LabelSpec} #layout: #(#{UI.AlignmentOrigin} 20 0 202 0 0 1 ) #label: 'Stack:' ) #(#{UI.LabelSpec} #layout: #(#{UI.AlignmentOrigin} -40 0.5 52 0 0 1 ) #label: 'Code Cache:' ) #(#{UI.LabelSpec} #layout: #(#{UI.AlignmentOrigin} -40 0.5 100 0 0 1 ) #label: 'Old Space Headroom:' ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.LayoutFrame} 10 0 252 0 -110 1 385 0 ) #label: 'Memory Policy' ) #(#{UI.LabelSpec} #layout: #(#{UI.AlignmentOrigin} 20 0 292 0 0 1 ) #label: 'Growth Increment:' ) #(#{UI.LabelSpec} #layout: #(#{UI.AlignmentOrigin} -40 0.5 292 0 0 1 ) #label: 'Growth Regime Limit:' ) #(#{UI.LabelSpec} #layout: #(#{UI.AlignmentOrigin} 20 0 342 0 0 1 ) #label: 'Retry Decrement:' ) #(#{UI.LabelSpec} #layout: #(#{UI.AlignmentOrigin} -40 0.5 342 0 0 1 ) #label: 'Memory Limit:' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 20 0 52 0 -60 0.5 77 0 ) #name: #edenSize #model: #edenSize #type: #number #formatString: '#,##0' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 20 0 102 0 -60 0.5 127 0 ) #name: #survivorSize #model: #survivorSize #type: #number #formatString: '#,##0' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 20 0 152 0 -60 0.5 177 0 ) #name: #largeSize #model: #largeSize #type: #number #formatString: '#,##0' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 20 0 202 0 -60 0.5 227 0 ) #name: #stackSize #model: #stackSize #type: #number #formatString: '#,##0' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} -40 0.5 52 0 -120 1 77 0 ) #name: #codeSize #model: #codeSize #type: #number #formatString: '#,##0' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} -40 0.5 102 0 -120 1 127 0 ) #name: #oldSize #model: #oldSize #type: #number #formatString: '#,##0' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} -40 0.5 152 0 -120 1 177 0 ) #name: #fixedSize #model: #fixedSize #type: #number #formatString: '#,##0' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 20 0 292 0 -60 0.5 317 0 ) #name: #incrementSize #model: #incrementSize #type: #number #formatString: '#,##0' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 20 0 342 0 -60 0.5 367 0 ) #name: #retryDecrement #model: #retryDecrement #type: #number #formatString: '#,##0' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} -40 0.5 292 0 -120 1 317 0 ) #name: #growthLimit #model: #growthLimit #type: #number #formatString: '#,##0' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} -40 0.5 342 0 -120 1 367 0 ) #name: #memoryLimit #model: #memoryLimit #type: #number #formatString: '#,##0' ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} -100 1 17 0 -10 1 42 0 ) #model: #accept #label: #(#{Kernel.UserMessage} #key: #ok #defaultString: 'OK' #catalogID: #RuntimePackager ) #isDefault: true #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} -100 1 50 0 -10 1 75 0 ) #name: #cancel #model: #cancel #label: #(#{Kernel.UserMessage} #key: #cancel #defaultString: 'Cancel' #catalogID: #RuntimePackager ) #defaultable: true ) #(#{UI.LabelSpec} #layout: #(#{UI.AlignmentOrigin} -40 0.5 152 0 0 1 ) #label: 'Fixed Space Headroom:' ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} -100 1 102 0 -10 1 127 0 ) #name: #helpButton #model: #stepHelp #label: #(#{Kernel.UserMessage} #key: #help #defaultString: 'Help' #catalogID: #RuntimePackager ) #defaultable: true ) ) ) )
</methods> <methods> RuntimePackager.RuntimeBuilderHelp class <category>interface specs</category>
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: 'Runtime Packager Help' #min: #(#Point 40 20 ) #bounds: #(#Rectangle 283 274 851 637 ) ) #component: #(#SpecCollection #collection: #( #(#TextEditorSpec #layout: #(#LayoutFrame 0 0.0328125 0 0.100962 0 0.970312 0 0.846154 ) #name: #helpString #model: #helpString #isReadOnly: true ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.028125 0 0.0288462 0 0.967187 0 0.0865385 ) #name: #title #flags: 0 #model: #title #tabable: false #alignment: #center #isReadOnly: true #type: #text ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.828125 0 0.884615 0 0.970312 0 0.961538 ) #model: #closeRequest #label: 'Close' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.0328125 0 0.884615 0 0.175 0 0.961538 ) #name: #hardcopy #model: #hardcopy #label: 'Print' #defaultable: true ) ) ) )
</methods> <methods> RuntimePackager.RuntimeBuilderTester class <category>resources</category>
mainMenu "Tools.MenuEditor new openOnClass: self andSelector: #mainMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Help' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Overview' #value: #overviewHelp ) #(#{UI.MenuItem} #rawLabel: 'This Step' #value: #stepHelp ) ) #(2 ) nil ) ) ) #(1 ) nil ) decodeAsLiteralArray
</methods> <methods> RuntimePackager.RuntimeBuilderTester class <category>interface specs</category>
windowSpec "Tools.UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Runtime Application Tester' #min: #(#{Core.Point} 20 20 ) #bounds: #(#{Graphics.Rectangle} 700 525 1279 909 ) #flags: 4 #menu: #mainMenu ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.417962 0 0.0164384 ) #label: 'Test Controls' #style: #default ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.176166 0 0.807365 0 0.810017 0 0.883853 ) #name: #testStatus #flags: 0 #model: #testStatus #alignment: #center #isReadOnly: true #type: #text ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0362694 0 0.410959 0 0.948186 0 0.764384 ) #name: #dynamicItemsText #model: #dynamicItemsText #isReadOnly: true ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.38342 0 0.348958 ) #label: 'Dynamic References' #style: #default ) #(#{UI.TextEditorSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.274611 0 0.939726 0 0.709845 15 0.939726 ) #name: #progressIndicator #flags: 28 #isOpaque: true #model: #progressIndicator #style: #system #isReadOnly: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0552677 0 0.104167 0 0.229706 0 0.192708 ) #name: #saveImage #model: #saveImage #label: 'Save Image' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.405872 0 0.10411 0 0.580311 0 0.191781 ) #name: #beginTest #model: #beginTest #label: 'Begin Test' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.761658 0 0.104167 0 0.936097 0 0.192708 ) #name: #endTest #model: #endTest #label: 'End Test' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0552677 0 0.210938 0 0.393782 0 0.294271 ) #name: #acceptReferences #model: #acceptReferences #label: 'Accept Dynamic References' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.580311 0 0.203125 0 0.936097 0 0.291667 ) #name: #ignoreReferences #model: #ignoreReferences #label: 'Ignore Dynamic References' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0359375 0 0.848958 0 0.15 0 0.942708 ) #name: #accept #model: #accept #label: 'OK' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.835937 0 0.848958 0 0.95 0 0.942708 ) #name: #cancel #model: #cancel #label: 'Cancel' #defaultable: true ) ) ) )
</methods> <methods> RuntimePackager.RuntimeProgressNotifier class <category>interface specs</category>
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: 'Progress Notifier' #min: #(#Point 40 20 ) #bounds: #(#Rectangle 301 362 721 485 ) ) #component: #(#SpecCollection #collection: #( #(#TextEditorSpec #layout: #(#LayoutFrame 0 0.0119048 0 0.0487805 0 0.985714 0 0.764228 ) #name: #text #flags: 12 #model: #text #isReadOnly: true ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.0119048 0 0.821138 0 0.983333 15 0.821138 ) #name: #progressString #model: #progressString #tabable: false #isReadOnly: true ) ) ) )
</methods> <methods> DeploymentOptionsSystem <category>command-line options</category>
errorLog: fileNameStream "Set the location of the error log." <option: '-err'> | errorLogNames | errorLogNames := CommandLineInterest argumentsFrom: fileNameStream. errorLogNames do: [:each | RuntimePackager.RuntimeManager errorLogPath: each].
notifierClass: classNameStream "Set the class to use for error notifiers." <option: '-notifier'> | classNames | classNames := CommandLineInterest argumentsFrom: classNameStream. classNames do: [:each | self hookNotifierClass: each].
</methods> <initialize> RuntimePackager.RuntimeManager </initialize> <initialize> RuntimePackager.RuntimeBuilderUI </initialize> <initialize> RuntimePackager.RuntimeErrorNotifier </initialize> <initialize> RuntimePackager.RuntimeEmergencyNotifier </initialize> <initialize> RuntimePackager.RuntimeSurrogateManager </initialize> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>ImageConfigurationSystem</name> <environment>Core</environment> <super>Core.Subsystem</super> <private>false</private> none allowParcelLoading allowFilein allowSettings allowExpressions useDefaultConfigFile allowDevelopment <imports></imports> <category>System-Subsystems</category> <attributes> <package>System-Subsystems</package> </attributes> </class> <class> <name>PackageModel</name> <environment>Store</environment> <super>Store.PundleModel</super> <private>false</private> none models <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <class> <name>UserApplication</name> <environment>Core</environment> <super>Core.Subsystem</super> <private>false</private> none <imports></imports> <category>System-Subsystems</category> <attributes> <package>System-Subsystems</package> </attributes> </class> <class> <name>Model</name> <environment>UI</environment> <super>Core.Object</super> <private>false</private> none dependents <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>ApplicationModel</name> <environment>UI</environment> <super>UI.Model</super> <private>false</private> none builder uiSession eventHandlers savedWindowInformation <imports></imports> <category>UIBuilder-Framework</category> <attributes> <package>UIBuilder-Framework</package> </attributes> </class> <class> <name>BundleModel</name> <environment>Store</environment> <super>Store.PundleModel</super> <private>false</private> none <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <class> <name>ApplicationStandardSystemController</name> <environment>UI</environment> <super>UI.StandardSystemController</super> <private>false</private> none eventDispatcher <imports></imports> <category>UIBasics-Controllers</category> <attributes> <package>UIBasics-Controllers</package> </attributes> </class> <class> <name>ErrorDumper</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none dumpStream dumpDate dumpTime fileName maximumStackEntriesDumped <imports></imports> <category>RuntimePackager</category> <attributes> <package>ErrorNotifier</package> </attributes> </class> <class> <name>Method</name> <environment>Store</environment> <super>Store.Subdef</super> <private>false</private> none className meta metaString protocolName documentStr <imports></imports> <category>Store-DB-Subdefs</category> <attributes> <package>Store-DB-Subdefs</package> </attributes> </class> <class> <name>ErrorNotifier</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none exception context errorFilename errorState errorProcess imageDumperClass errorFilename <imports></imports> <category>Kernel-Objects</category> <attributes> <package>ErrorNotifier</package> </attributes> </class> <class> <name>ItemSelectionModule</name> <environment>Tools</environment> <super>Tools.ToolModule</super> <private>false</private> none displayStringBlock iconBlock useMultiSelection useHorizontalScrollBar menuHolder menuPerformer <imports></imports> <category>Tools-Modules</category> <attributes> <package>Tools-Modules</package> </attributes> </class> <class> <name>TreeSelectionModule</name> <environment>Tools</environment> <super>Tools.ItemSelectionModule</super> <private>false</private> none showRoot preExpandLevel treeHolder expandableRoots rootHolder <imports></imports> <category>Tools-Modules</category> <attributes> <package>Tools-Modules</package> </attributes> </class> <class> <name>Behavior</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none superclass methodDict format subclasses <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>CompiledMethod</name> <environment>Kernel</environment> <super>Kernel.CompiledMainBlock</super> <private>false</private> objects mclass sourceCode <imports> private Kernel.OpcodePool.* </imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>NameSpaceOfClass</name> <environment>Kernel</environment> <super>Kernel.GeneralNameSpace</super> <private>false</private> none owner <imports></imports> <category>System-Name Spaces</category> <attributes> <package>System-Name Spaces</package> </attributes> </class> <class> <name>DeploymentOptionsSystem</name> <environment>Smalltalk</environment> <super>Core.Subsystem</super> <private>false</private> none isRuntime startInRuntime allowCommandLineOptions <imports></imports> <category>My Classes</category> <attributes> <package>System-Subsystems</package> </attributes> </class>