[squeak-dev] The Trunk: System-fbs.577.mczcommits at source.squeak.org commits at source.squeak.orgThu Jul 25 07:54:20 UTC 2013
Frank Shearar uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-fbs.577.mcz ==================== Summary ==================== Name: System-fbs.577 Author: fbs Time: 25 July 2013, 8:53:24.156 am UUID: 70bbc861-0488-be4d-9735-46511275adb2 Ancestors: System-fbs.576 SmalltalkImage current -> Smalltalk. =============== Diff against System-fbs.576 =============== Item was changed: ----- Method: AutoStart class>>checkForPluginUpdate (in category 'updating') ----- checkForPluginUpdate | pluginVersion updateURL | World ifNotNil: [ World install. ActiveHand position: 100 at 100]. HTTPClient isRunningInBrowser ifFalse: [^false]. pluginVersion := AbstractLauncher extractParameters + at: (Smalltalk platformName copyWithout: Character space) asUppercase - at: (SmalltalkImage current platformName copyWithout: Character space) asUppercase ifAbsent: [^false]. updateURL := AbstractLauncher extractParameters at: 'UPDATE_URL' ifAbsent: [^false]. ^SystemVersion check: pluginVersion andRequestPluginUpdate: updateURL! Item was changed: ----- Method: ChangeSet class>>getRecentLocatorWithPrompt: (in category 'scanning') ----- getRecentLocatorWithPrompt: aPrompt "Prompt with a menu of how far back to go. Return nil if user backs out. Otherwise return the number of characters back from the end of the .changes file the user wishes to include" "ChangeList getRecentPosition" | end changesFile banners positions pos chunk i | changesFile := (SourceFiles at: 2) readOnlyCopy. banners := OrderedCollection new. positions := OrderedCollection new. end := changesFile size. + pos := Smalltalk lastQuitLogPosition. - pos := SmalltalkImage current lastQuitLogPosition. [pos = 0 or: [banners size > 20]] whileFalse: [changesFile position: pos. chunk := changesFile nextChunk. i := chunk indexOfSubCollection: 'priorSource: ' startingAt: 1. i > 0 ifTrue: [positions addLast: pos. banners addLast: (chunk copyFrom: 5 to: i-2). pos := Number readFrom: (chunk copyFrom: i+13 to: chunk size)] ifFalse: [pos := 0]]. changesFile close. pos := UIManager default chooseFrom: banners values: positions title: aPrompt. pos == nil ifTrue: [^ nil]. ^ end - pos! Item was changed: ----- Method: DigitalSignatureAlgorithm>>initRandomNonInteractively (in category 'initialization') ----- initRandomNonInteractively [self initRandom: (SoundService default randomBitsFromSoundInput: 512)] ifError: [self initRandomFromString: Time millisecondClockValue printString, Date today printString, + Smalltalk platformName printString].! - SmalltalkImage current platformName printString].! Item was changed: ----- Method: ExternalSettings class>>preferenceDirectory (in category 'accessing') ----- preferenceDirectory | prefDirName path | prefDirName := self preferenceDirectoryName. + path := Smalltalk vmPath. - path := SmalltalkImage current vmPath. ^(FileDirectory default directoryExists: prefDirName) ifTrue: [FileDirectory default directoryNamed: prefDirName] ifFalse: [ ((FileDirectory on: path) directoryExists: prefDirName) ifTrue: [(FileDirectory on: path) directoryNamed: prefDirName] ifFalse: [nil]] ! Item was changed: ----- Method: FileDirectory class>>openSources:andChanges:forImage: (in category '*System-Files') ----- openSources: sourcesName andChanges: changesName forImage: imageName "Open the changes and sources files and install them in SourceFiles. Inform the user of problems regarding write permissions or CR/CRLF mixups." "Note: SourcesName and imageName are full paths; changesName is a local name." | sources changes msg wmsg | msg := 'Squeak cannot locate &fileRef. Please check that the file is named properly and is in the same directory as this image.'. wmsg := 'Squeak cannot write to &fileRef. Please check that you have write permission for this file. You won''t be able to save this image correctly until you fix this.'. sources := self openSources: sourcesName forImage: imageName. changes := self openChanges: changesName forImage: imageName. ((sources == nil or: [sources atEnd]) and: [Preferences valueOfFlag: #warnIfNoSourcesFile]) + ifTrue: [Smalltalk platformName = 'Mac OS' - ifTrue: [SmalltalkImage current platformName = 'Mac OS' ifTrue: [msg := msg , ' Make sure the sources file is not an Alias.']. self inform: (msg copyReplaceAll: '&fileRef' with: 'the sources file named ' , sourcesName)]. (changes == nil and: [Preferences valueOfFlag: #warnIfNoChangesFile]) ifTrue: [self inform: (msg copyReplaceAll: '&fileRef' with: 'the changes file named ' , changesName)]. ((Preferences valueOfFlag: #warnIfNoChangesFile) and: [changes notNil]) ifTrue: [changes isReadOnly ifTrue: [self inform: (wmsg copyReplaceAll: '&fileRef' with: 'the changes file named ' , changesName)]. ((changes next: 200) includesSubString: String crlf) ifTrue: [self inform: 'The changes file named ' , changesName , ' has been injured by an unpacking utility. Crs were changed to CrLfs. Please set the preferences in your decompressing program to "do not convert text files" and unpack the system again.']]. SourceFiles := Array with: sources with: changes! Item was changed: ----- Method: FileDirectory class>>openSources:forImage: (in category '*System-Files') ----- openSources: fullSourcesName forImage: imageName "We first do a check to see if a compressed version ofthe sources file is present. Open the .sources file read-only after searching in: a) the directory where the VM lives b) the directory where the image came from c) the DefaultDirectory (which is likely the same as b unless the SecurityManager has changed it). " | sources fd sourcesName | (fullSourcesName endsWith: 'sources') ifTrue: ["Look first for a sources file in compressed format." sources := self openSources: (fullSourcesName allButLast: 7) , 'stc' forImage: imageName. sources ifNotNil: [^ CompressedSourceStream on: sources]]. sourcesName := FileDirectory localNameFor: fullSourcesName. "look for the sources file or an alias to it in the VM's directory" + fd := FileDirectory on: Smalltalk vmPath. - fd := FileDirectory on: SmalltalkImage current vmPath. (fd fileExists: sourcesName) ifTrue: [sources := fd readOnlyFileNamed: sourcesName]. sources ifNotNil: [^ sources]. "look for the sources file or an alias to it in the image directory" fd := FileDirectory on: (FileDirectory dirPathFor: imageName). (fd fileExists: sourcesName) ifTrue: [sources := fd readOnlyFileNamed: sourcesName]. sources ifNotNil: [^ sources]. "look for the sources in the current directory" fd := DefaultDirectory. (fd fileExists: sourcesName) ifTrue: [sources := fd readOnlyFileNamed: sourcesName]. "sources may still be nil here" ^sources ! Item was changed: ----- Method: GetTextTranslator class>>setupLocaleDirs (in category 'translation data layout') ----- setupLocaleDirs | dirs sepa localesDirName | sepa := FileDirectory slash. SystemDefaultLocaleDirs := nil. dirs := self systemDefaultLocaleDirs. localesDirName := 'locale'. + dirs add: (Smalltalk imagePath) , sepa , localesDirName. + dirs add: (Smalltalk vmPath) , sepa , localesDirName. - dirs add: (SmalltalkImage current imagePath) , sepa , localesDirName. - dirs add: (SmalltalkImage current vmPath) , sepa , localesDirName. ^dirs! Item was changed: ----- Method: HTTPClient class>>shouldUsePluginAPI (in category 'testing') ----- shouldUsePluginAPI "HTTPClient shouldUsePluginAPI" self isRunningInBrowser ifFalse: [^false]. self browserSupportsAPI ifFalse: [^false]. "The Mac plugin calls do not work in full screen mode" + ^((Smalltalk platformName = 'Mac OS') - ^((SmalltalkImage current platformName = 'Mac OS') and: [Project current lastScreenModeSelected]) not! Item was changed: ----- Method: ImageSegment class>>folder (in category 'fileIn/Out') ----- folder | im | "Full path name of segments folder. Be sure to duplicate and rename the folder when you duplicate and rename an image. Is $_ legal in all file systems?" + im := Smalltalk imageName. - im := SmalltalkImage current imageName. ^ (im copyFrom: 1 to: im size - 6 "'.image' size"), '_segs'! Item was changed: ----- Method: ImageSegment class>>startUp (in category 'fileIn/Out') ----- startUp | choice | "Minimal thing to assure that a .segs folder is present" (Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [ (FileDirectory default includesKey: (FileDirectory localNameFor: self folder)) ifFalse: [ choice := UIManager default chooseFrom: #('Create folder' 'Quit without saving') title: 'The folder with segments for this image is missing.\' withCRs, self folder, '\If you have moved or renamed the image file,\' withCRs, 'please Quit and rename the segments folder in the same way'. choice = 1 ifTrue: [FileDirectory default createDirectory: self folder]. + choice = 2 ifTrue: [Smalltalk snapshot: false andQuit: true]]] - choice = 2 ifTrue: [SmalltalkImage current snapshot: false andQuit: true]]] ! Item was changed: ----- Method: Locale class>>defaultEncodingName: (in category 'platform specific') ----- defaultEncodingName: languageSymbol | encodings platformName osVersion | + platformName := Smalltalk platformName. + osVersion := Smalltalk getSystemAttribute: 1002. - platformName := SmalltalkImage current platformName. - osVersion := SmalltalkImage current getSystemAttribute: 1002. encodings := self platformEncodings at: languageSymbol ifAbsent: [self platformEncodings at: #default]. encodings at: platformName ifPresent: [:encoding | ^encoding]. encodings at: platformName , ' ' , osVersion ifPresent: [:encoding | ^encoding]. ^encodings at: #default! Item was changed: ----- Method: Locale class>>defaultInputInterpreter (in category 'platform specific') ----- defaultInputInterpreter | platformName osVersion | + platformName := Smalltalk platformName. + osVersion := Smalltalk getSystemAttribute: 1002. - platformName := SmalltalkImage current platformName. - osVersion := SmalltalkImage current getSystemAttribute: 1002. (platformName = 'Win32' and: [osVersion = 'CE']) ifTrue: [^NoInputInterpreter new]. platformName = 'Win32' ifTrue: [^MacRomanInputInterpreter new]. ^NoInputInterpreter new! Item was changed: ----- Method: MessageTally>>computeGCStats (in category 'private') ----- computeGCStats "Compute the deltas in the GC stats. Serves for reporting, hibernating and unhibernating." + Smalltalk getVMParameters keysAndValuesDo: - SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal | gcVal isNumber ifTrue: [gcStats at: idx put: (gcVal - (gcStats at: idx))]]! Item was changed: ----- Method: MessageTally>>spyAllEvery:on: (in category 'initialize-release') ----- spyAllEvery: millisecs on: aBlock "Create a spy and spy on the given block at the specified rate." "Spy all the system processes" | myDelay | aBlock isBlock ifFalse: [ self error: 'spy needs a block here' ]. self class: aBlock receiver class method: aBlock method. "set up the probe" myDelay := Delay forMilliseconds: millisecs. time0 := Time millisecondClockValue. + gcStats := Smalltalk getVMParameters. - gcStats := SmalltalkImage current getVMParameters. Timer ifNotNil: [ self error: 'it seems a tally is already running' ]. Timer := [ [true] whileTrue: [ | observedProcess | startTime := Time millisecondClockValue. myDelay wait. observedProcess := Processor preemptedProcess. self tally: observedProcess suspendedContext in: observedProcess "tally can be > 1 if ran a long primitive" by: (Time millisecondClockValue - startTime) // millisecs]. nil] newProcess. Timer priority: Processor timingPriority-1. "activate the probe and evaluate the block" Timer resume. ^ aBlock ensure: [ "cancel the probe and return the value" "Could have already been terminated. See #terminateTimerProcess" self class terminateTimerProcess. self computeGCStats. time := Time millisecondClockValue - time0]! Item was changed: ----- Method: MessageTally>>spyEvery:on: (in category 'initialize-release') ----- spyEvery: millisecs on: aBlock "Create a spy and spy on the given block at the specified rate." "Spy only on the active process (in which aBlock is run)" | myDelay observedProcess | aBlock isBlock ifFalse: [ self error: 'spy needs a block here' ]. self class: aBlock receiver class method: aBlock method. "set up the probe" observedProcess := Processor activeProcess. myDelay := Delay forMilliseconds: millisecs. + gcStats := Smalltalk getVMParameters. - gcStats := SmalltalkImage current getVMParameters. Timer ifNotNil: [ self error: 'it seems a tally is already running' ]. time0 := Time millisecondClockValue. Timer := [ [ true ] whileTrue: [ startTime := Time millisecondClockValue. myDelay wait. self tally: Processor preemptedProcess suspendedContext in: (observedProcess == Processor preemptedProcess ifTrue: [observedProcess] ifFalse: [nil]) "tally can be > 1 if ran a long primitive" by: (Time millisecondClockValue - startTime) // millisecs]. nil] newProcess. Timer priority: Processor timingPriority-1. "activate the probe and evaluate the block" Timer resume. ^ aBlock ensure: [ "cancel the probe and return the value" "Could have already been terminated. See #terminateTimerProcess" self class terminateTimerProcess. self computeGCStats. time := Time millisecondClockValue - time0]! Item was changed: ----- Method: MessageTally>>spyEvery:onProcess:forMilliseconds: (in category 'initialize-release') ----- spyEvery: millisecs onProcess: aProcess forMilliseconds: msecDuration "Create a spy and spy on the given process at the specified rate." | myDelay observedProcess sem | (aProcess isKindOf: Process) ifFalse: [self error: 'spy needs a Process here']. self class: aProcess suspendedContext receiver class method: aProcess suspendedContext method. "set up the probe" observedProcess := aProcess. myDelay := Delay forMilliseconds: millisecs. time0 := Time millisecondClockValue. endTime := time0 + msecDuration. sem := Semaphore new. + gcStats := Smalltalk getVMParameters. - gcStats := SmalltalkImage current getVMParameters. Timer ifNotNil: [ self error: 'it seems a tally is already running' ]. Timer := [ [ startTime := Time millisecondClockValue. myDelay wait. self tally: Processor preemptedProcess suspendedContext in: (observedProcess == Processor preemptedProcess ifTrue: [ observedProcess ] ifFalse: [ nil ]) "tally can be > 1 if ran a long primitive" by: (Time millisecondClockValue - startTime) // millisecs. startTime < endTime ] whileTrue. sem signal. ] newProcess. Timer priority: Processor timingPriority-1. "activate the probe and evaluate the block" Timer resume. "activate the probe and wait for it to finish" sem wait. self computeGCStats. time := Time millisecondClockValue - time0! Item was changed: ----- Method: PowerManagement class>>itsyVoltage (in category 'computing') ----- itsyVoltage "On the Itsy, answer the approximate Vcc voltage. The Itsy will shut itself down when this value reaches 2.0 volts. This method allows one to build a readout of the current battery condition." | n | + n := Smalltalk getSystemAttribute: 1200. - n := SmalltalkImage current getSystemAttribute: 1200. n ifNil: [^ 'no voltage attribute']. ^ (n asNumber / 150.0 roundTo: 0.01) asString , ' volts'! Item was changed: ----- Method: Preferences class>>disableProgrammerFacilities (in category 'personalization') ----- disableProgrammerFacilities "Warning: do not call this lightly!! It disables all access to menus, debuggers, halos. There is no guaranteed return from this, which is to say, you cannot necessarily reenable these things once they are disabled -- you can only use whatever the UI of the current project affords, and you cannot even snapshot -- you can only quit. You can completely reverse the work of this method by calling the dual Preferences method enableProgrammerFacilities, provided you have left yourself leeway to bring about a call to that method. To set up a system that will come up in such a state, you have to request the snapshot in the same breath as you disable the programmer facilities. To do this, put the following line into the 'do' menu and then evaluate it from that 'do' menu: Preferences disableProgrammerFacilities. You will be prompted for a new image name under which to save the resulting image." Beeper beep. (self confirm: 'CAUTION!!!! This is a drastic step!! Do you really want to do this?') ifFalse: [Beeper beep. ^self inform: 'whew!!']. self disable: #cmdDotEnabled. "No user-interrupt-into-debugger" self compileHardCodedPref: #cmdGesturesEnabled enable: false. "No halos, etc." self compileHardCodedPref: #cmdKeysInText enable: false. "No user commands invokable via cmd-key combos in text editor" self enable: #noviceMode. "No control-menu" self disable: #warnIfNoSourcesFile. self disable: #warnIfNoChangesFile. + Smalltalk saveAs! - SmalltalkImage current saveAs! Item was changed: ----- Method: Preferences class>>personalizeUserMenu: (in category 'personalization') ----- personalizeUserMenu: aMenu "The user has clicked on the morphic desktop with the yellow mouse button (option+click on the Mac); a menu is being constructed to present to the user in response; its default target is the current world. In this method, you are invited to add items to the menu as per personal preferences. The default implementation, for illustrative purposes, sets the menu title to 'personal', and adds items for go-to-previous-project, show/hide flaps, and load code updates" aMenu addTitle: 'personal' translated. "Remove or modify this as per personal choice" aMenu addStayUpItem. aMenu add: 'previous project' translated action: #goBack. aMenu add: 'load latest code updates' translated target: Utilities action: #updateFromServer. + aMenu add: 'about this system...' translated target: Smalltalk action: #aboutThisSystem. - aMenu add: 'about this system...' translated target: SmalltalkImage current action: #aboutThisSystem. aMenu addLine. aMenu addUpdating: #suppressFlapsString target: Project current action: #toggleFlapsSuppressed. aMenu balloonTextForLastItem: 'Whether prevailing flaps should be shown in the project right now or not.' translated! Item was changed: ----- Method: Project>>storeToMakeRoom (in category 'file in/out') ----- storeToMakeRoom "Write out enough projects to fulfill the space goals. Include the size of the project about to come in." | params memoryEnd goalFree cnt gain proj skip tried | GoalFreePercent ifNil: [GoalFreePercent := 33]. GoalNotMoreThan ifNil: [GoalNotMoreThan := 20000000]. + params := Smalltalk getVMParameters. - params := SmalltalkImage current getVMParameters. memoryEnd := params at: 3. " youngSpaceEnd := params at: 2. free := memoryEnd - youngSpaceEnd. " goalFree := GoalFreePercent asFloat / 100.0 * memoryEnd. goalFree := goalFree min: GoalNotMoreThan. world isInMemory ifFalse: ["enough room to bring it in" goalFree := goalFree + (self projectParameters at: #segmentSize ifAbsent: [0])]. cnt := 30. gain := Smalltalk garbageCollectMost. "skip a random number of projects that are in memory" proj := self. skip := 6 atRandom. [proj := proj nextInstance ifNil: [Project someInstance]. proj world isInMemory ifTrue: [skip := skip - 1]. skip > 0] whileTrue. cnt := 0. tried := 0. [gain > goalFree] whileFalse: [ proj := proj nextInstance ifNil: [Project someInstance]. proj storeSegment ifTrue: ["Yes, did send its morphs to the disk" gain := gain + (proj projectParameters at: #segmentSize ifAbsent: [20000]). "a guess" Beeper beep. (cnt := cnt + 1) > 5 ifTrue: [^ self]]. "put out 5 at most" (tried := tried + 1) > 23 ifTrue: [^ self]]. "don't get stuck in a loop"! Item was changed: ----- Method: ResourceManager>>convertMapNameForBackwardcompatibilityFrom: (in category 'backward-compatibility') ----- convertMapNameForBackwardcompatibilityFrom: aString + (Smalltalk platformName = 'Mac OS' + and: ['10*' match: Smalltalk osVersion]) - (SmalltalkImage current platformName = 'Mac OS' - and: ['10*' match: SmalltalkImage current osVersion]) ifTrue: [^aString convertFromWithConverter: ShiftJISTextConverter new]. ^aString convertFromSystemString! Item was changed: ----- Method: SecurityManager>>generateLocalKeyPair (in category 'private') ----- generateLocalKeyPair "SecurityManager default generateLocalKeyPair" "Generate a key set on the local machine." | dsa | dsa := DigitalSignatureAlgorithm new. dsa initRandomFromString: Time millisecondClockValue printString, Date today printString, + Smalltalk platformName printString. - SmalltalkImage current platformName printString. privateKeyPair := dsa generateKeySet. self storeSecurityKeys.! Item was changed: ----- Method: SmalltalkImage>>calcEndianness (in category 'system attributes') ----- calcEndianness | bytes word blt | "What endian-ness is the current hardware? The String '1234' will be stored into a machine word. On BigEndian machines (the Mac), $1 will be the high byte if the word. On LittleEndian machines (the PC), $4 will be the high byte." + "Smalltalk endianness" - "SmalltalkImage current endianness" bytes := ByteArray withAll: #(0 0 0 0). "(1 2 3 4) or (4 3 2 1)" word := WordArray with: 16r01020304. blt := (BitBlt toForm: (Form new hackBits: bytes)) sourceForm: (Form new hackBits: word). blt combinationRule: Form over. "store" blt sourceY: 0; destY: 0; height: 1; width: 4. blt sourceX: 0; destX: 0. blt copyBits. "paste the word into the bytes" bytes first = 1 ifTrue: [^ #big]. bytes first = 4 ifTrue: [^ #little]. self error: 'Ted is confused'.! Item was changed: ----- Method: SmalltalkImage>>currentChangeSetString (in category 'image, changes names') ----- currentChangeSetString + "Smalltalk currentChangeSetString" - "SmalltalkImage current currentChangeSetString" ^ 'Current Change Set: ' translated, ChangeSet current name! Item was changed: ----- Method: SmalltalkImage>>fixObsoleteReferences (in category 'housekeeping') ----- fixObsoleteReferences + "Smalltalk fixObsoleteReferences" - "SmalltalkImage current fixObsoleteReferences" Smalltalk garbageCollect; garbageCollect. Preference allInstances do: [:each | | informee | informee := each instVarNamed: #changeInformee. ((informee isKindOf: Behavior) and: [informee isObsolete]) ifTrue: [ Transcript show: 'Preference: '; show: each name; cr. each instVarNamed: #changeInformee put: (Smalltalk at: (informee name copyReplaceAll: 'AnObsolete' with: '') asSymbol)]]. CompiledMethod allInstances do: [:method | | obsoleteBindings | obsoleteBindings := method literals select: [:literal | literal isVariableBinding and: [literal value isBehavior and: [literal value isObsolete]]]. obsoleteBindings do: [:binding | | obsName realName realClass | obsName := binding value name. Transcript show: 'Binding: '; show: obsName; cr. realName := obsName copyReplaceAll: 'AnObsolete' with: ''. realClass := Smalltalk at: realName asSymbol ifAbsent: [UndefinedObject]. binding isSpecialWriteBinding ifTrue: [binding privateSetKey: binding key value: realClass] ifFalse: [binding key: binding key value: realClass]]]. Behavior flushObsoleteSubclasses. Smalltalk garbageCollect; garbageCollect. SystemNavigation default obsoleteBehaviors size > 0 ifTrue: [ SystemNavigation default obsoleteBehaviors inspect. self error:'Still have obsolete behaviors. See inspector']. ! Item was changed: ----- Method: SmalltalkImage>>getVMParameters (in category 'vm parameters') ----- getVMParameters "Answer an Array containing the current values of the VM's internal parameter/metric registers. Each value is stored in the array at the index corresponding to its VM register. (See #vmParameterAt: and #vmParameterAt:put:.)" + "Smalltalk getVMParameters" - "SmalltalkImage current getVMParameters" <primitive: 254> self primitiveFailed! Item was changed: ----- Method: SmalltalkImage>>imageName (in category 'image, changes names') ----- imageName "Answer the full path name for the current image." + "Smalltalk imageName" - "SmalltalkImage current imageName" | str | str := self primImageName. ^ (FilePath pathName: str isEncoded: true) asSqueakPathName. ! Item was changed: ----- Method: SmalltalkImage>>imagePath (in category 'image, changes names') ----- imagePath "Answer the path for the directory containing the image file." + "Smalltalk imagePath" - "SmalltalkImage current imagePath" ^ FileDirectory dirPathFor: self imageName ! Item was changed: ----- Method: SmalltalkImage>>lastUpdateString (in category 'sources, changes log') ----- lastUpdateString + "Smalltalk lastUpdateString" - "SmalltalkImage current lastUpdateString" ^'latest update: #' translated, SystemVersion current highestUpdate printString! Item was changed: ----- Method: SmalltalkImage>>listBuiltinModules (in category 'modules') ----- listBuiltinModules + "Smalltalk listBuiltinModules" - "SmalltalkImage current listBuiltinModules" "Return a list of all builtin modules (e.g., plugins). Builtin plugins are those that are compiled with the VM directly, as opposed to plugins residing in an external shared library. The list will include all builtin plugins regardless of whether they are currently loaded or not. Note that the list returned is not sorted!!" | modules index name | modules := WriteStream on: (Array new: 20). index := 1. [ name := self listBuiltinModule: index. name ifNil:[^modules contents]. modules nextPut: name. index := index + 1 ] repeat! Item was changed: ----- Method: SmalltalkImage>>listLoadedModules (in category 'modules') ----- listLoadedModules + "Smalltalk listLoadedModules" - "SmalltalkImage current listLoadedModules" "Return a list of all currently loaded modules (e.g., plugins). Loaded modules are those that currently in use (e.g., active). The list returned will contain all currently active modules regardless of whether they're builtin (that is compiled with the VM) or external (e.g., residing in some external shared library). Note that the returned list is not sorted!!" | modules index name | modules := WriteStream on: (Array new: 20). index := 1. [ name := self listLoadedModule: index. name ifNil:[^modules contents]. modules nextPut: name. index := index + 1 ] repeat! Item was changed: ----- Method: SmalltalkImage>>primImageName (in category 'image, changes names') ----- primImageName "Answer the full path name for the current image." + "Smalltalk imageName" - "SmalltalkImage current imageName" <primitive: 121> self primitiveFailed! Item was changed: ----- Method: SmalltalkImage>>primVmPath (in category 'image, changes names') ----- primVmPath "Answer the path for the directory containing the Smalltalk virtual machine. Return the empty string if this primitive is not implemented." + "Smalltalk vmPath" - "SmalltalkImage current vmPath" <primitive: 142> ^ ''! Item was changed: ----- Method: SmalltalkImage>>saveAsNewVersion (in category 'sources, changes log') ----- saveAsNewVersion "Save the image/changes using the next available version number." + "Smalltalk saveAsNewVersion" - "SmalltalkImage current saveAsNewVersion" | newName changesName aName anIndex | aName := FileDirectory baseNameFor: (FileDirectory default localNameFor: self imageName). anIndex := aName lastIndexOf: FileDirectory dot asCharacter ifAbsent: [nil]. (anIndex notNil and: [(aName copyFrom: anIndex + 1 to: aName size) isAllDigits]) ifTrue: [aName := aName copyFrom: 1 to: anIndex - 1]. newName := FileDirectory default nextNameFor: aName extension: FileDirectory imageSuffix. changesName := self fullNameForChangesNamed: newName. "Check to see if there is a .changes file that would cause a problem if we saved a new .image file with the new version number" (FileDirectory default fileOrDirectoryExists: changesName) ifTrue: [^ self inform: 'There is already .changes file of the desired name, ', newName, ' curiously already present, even though there is no corresponding .image file. Please remedy manually and then repeat your request.']. (SourceFiles at: 2) ifNotNil: [self closeSourceFiles; "so copying the changes file will always work" saveChangesInFileNamed: (self fullNameForChangesNamed: newName)]. self saveImageInFileNamed: (self fullNameForImageNamed: newName) ! Item was changed: ----- Method: SmalltalkImage>>vmStatisticsReportString (in category 'vm statistics') ----- vmStatisticsReportString "StringHolderView open: (StringHolder new contents: + Smalltalk vmStatisticsReportString) label: 'VM Statistics'" - SmalltalkImage current vmStatisticsReportString) label: 'VM Statistics'" | params oldSpaceEnd youngSpaceEnd memoryEnd fullGCs fullGCTime incrGCs incrGCTime tenureCount upTime upTime2 fullGCs2 fullGCTime2 incrGCs2 incrGCTime2 tenureCount2 str | params := self getVMParameters. oldSpaceEnd := params at: 1. youngSpaceEnd := params at: 2. memoryEnd := params at: 3. fullGCs := params at: 7. fullGCTime := params at: 8. incrGCs := params at: 9. incrGCTime := params at: 10. tenureCount := params at: 11. upTime := Time millisecondClockValue. str := WriteStream on: (String new: 1000). str nextPutAll: 'uptime '; print: (upTime / 1000 / 60 // 60); nextPut: $h; print: (upTime / 1000 / 60 \\ 60) asInteger; nextPut: $m; print: (upTime / 1000 \\ 60) asInteger; nextPut: $s; cr. str nextPutAll: 'memory '; nextPutAll: memoryEnd asStringWithCommas; nextPutAll: ' bytes'; cr. str nextPutAll: ' old '; nextPutAll: oldSpaceEnd asStringWithCommas; nextPutAll: ' bytes ('; print: (oldSpaceEnd / memoryEnd * 100) maxDecimalPlaces: 1; nextPutAll: '%)'; cr. str nextPutAll: ' young '; nextPutAll: (youngSpaceEnd - oldSpaceEnd) asStringWithCommas; nextPutAll: ' bytes ('; print: (youngSpaceEnd - oldSpaceEnd / memoryEnd * 100) maxDecimalPlaces: 1; nextPutAll: '%)'; cr. str nextPutAll: ' used '; nextPutAll: youngSpaceEnd asStringWithCommas; nextPutAll: ' bytes ('; print: (youngSpaceEnd / memoryEnd * 100) maxDecimalPlaces: 1; nextPutAll: '%)'; cr. str nextPutAll: ' free '; nextPutAll: (memoryEnd - youngSpaceEnd) asStringWithCommas; nextPutAll: ' bytes ('; print: (memoryEnd - youngSpaceEnd / memoryEnd * 100) maxDecimalPlaces: 1; nextPutAll: '%)'; cr. str nextPutAll: 'GCs '; nextPutAll: (fullGCs + incrGCs) asStringWithCommas. fullGCs + incrGCs > 0 ifTrue: [ str nextPutAll: ' ('; print: (upTime / (fullGCs + incrGCs)) maxDecimalPlaces: 1; nextPutAll: ' ms between GCs)' ]. str cr. str nextPutAll: ' full '; nextPutAll: fullGCs asStringWithCommas; nextPutAll: ' totalling '; nextPutAll: fullGCTime asStringWithCommas; nextPutAll: ' ms ('; print: (fullGCTime / upTime * 100) maxDecimalPlaces: 1; nextPutAll: '% uptime)'. fullGCs = 0 ifFalse: [str nextPutAll: ', avg '; print: (fullGCTime / fullGCs) maxDecimalPlaces: 1; nextPutAll: ' ms']. str cr. str nextPutAll: ' incr '; nextPutAll: incrGCs asStringWithCommas; nextPutAll: ' totalling '; nextPutAll: incrGCTime asStringWithCommas; nextPutAll: ' ms ('; print: (incrGCTime / upTime * 100) maxDecimalPlaces: 1; nextPutAll: '% uptime), avg '; print: (incrGCTime / incrGCs) maxDecimalPlaces: 1; nextPutAll: ' ms'; cr. str nextPutAll: ' tenures '; nextPutAll: tenureCount asStringWithCommas. tenureCount = 0 ifFalse: [str nextPutAll: ' (avg '; print: incrGCs // tenureCount; nextPutAll: ' GCs/tenure)']. str cr. LastStats ifNil: [LastStats := Array new: 6] ifNotNil: [ upTime2 := upTime - (LastStats at: 1). fullGCs2 := fullGCs - (LastStats at: 2). fullGCTime2 := fullGCTime - (LastStats at: 3). incrGCs2 := incrGCs - (LastStats at: 4). incrGCTime2 := incrGCTime - (LastStats at: 5). tenureCount2 := tenureCount - (LastStats at: 6). str nextPutAll: self textMarkerForShortReport ; nextPutAll: (fullGCs2 + incrGCs2) asStringWithCommas. fullGCs2 + incrGCs2 > 0 ifTrue: [ str nextPutAll: ' ('; print: upTime2 // (fullGCs2 + incrGCs2); nextPutAll: ' ms between GCs)'. ]. str cr. str nextPutAll: ' uptime '; print: (upTime2 / 1000.0) maxDecimalPlaces: 1; nextPutAll: ' s'; cr. str nextPutAll: ' full '; nextPutAll: fullGCs2 asStringWithCommas; nextPutAll: ' totalling '; nextPutAll: fullGCTime2 asStringWithCommas; nextPutAll: ' ms ('; print: (fullGCTime2 / upTime2 * 100) maxDecimalPlaces: 1; nextPutAll: '% uptime)'. fullGCs2 = 0 ifFalse: [str nextPutAll: ', avg '; print: (fullGCTime2 / fullGCs2) maxDecimalPlaces: 1; nextPutAll: ' ms']. str cr. str nextPutAll: ' incr '; nextPutAll: incrGCs2 asStringWithCommas; nextPutAll: ' totalling '; nextPutAll: incrGCTime2 asStringWithCommas; nextPutAll: ' ms ('; print: (incrGCTime2 / upTime2 * 100) maxDecimalPlaces: 1; nextPutAll: '% uptime), avg '. incrGCs2 > 0 ifTrue: [ str print: (incrGCTime2 / incrGCs2) maxDecimalPlaces: 1; nextPutAll: ' ms' ]. str cr. str nextPutAll: ' tenures '; nextPutAll: tenureCount2 asStringWithCommas. tenureCount2 = 0 ifFalse: [str nextPutAll: ' (avg '; print: incrGCs2 // tenureCount2; nextPutAll: ' GCs/tenure)']. str cr. ]. LastStats at: 1 put: upTime. LastStats at: 2 put: fullGCs. LastStats at: 3 put: fullGCTime. LastStats at: 4 put: incrGCs. LastStats at: 5 put: incrGCTime. LastStats at: 6 put: tenureCount. ^ str contents ! Item was changed: ----- Method: SmalltalkImage>>vmStatisticsShortString (in category 'vm statistics') ----- vmStatisticsShortString "Convenience item for access to recent statistics only" + "StringHolderView open: (StringHolder new contents: Smalltalk vmStatisticsShortString) - "StringHolderView open: (StringHolder new contents: SmalltalkImage current vmStatisticsShortString) label: 'VM Recent Statistics'" ^ (ReadStream on: self vmStatisticsReportString) upToAll: 'Since'; nextLine; upToEnd ! Item was changed: ----- Method: SmalltalkImage>>vmVersion (in category 'system attributes') ----- vmVersion "Return a string identifying the interpreter version" + "Smalltalk vmVersion" - "SmalltalkImage current vmVersion" ^self getSystemAttribute: 1004! Item was changed: ----- Method: SmartRefStream>>writeConversionMethodIn:fromInstVars:to:renamedFrom: (in category 'class changed shape') ----- writeConversionMethodIn: newClass fromInstVars: oldList to: newList renamedFrom: oldName "The method convertToCurrentVersion:refStream: was not found in newClass. Write a default conversion method for the author to modify. If method exists, append new info into the end." | code newOthers oldOthers copied newCode | newOthers := newList asOrderedCollection "copy". oldOthers := oldList asOrderedCollection "copy". copied := OrderedCollection new. newList do: [:instVar | (oldList includes: instVar) ifTrue: [ instVar isInteger ifFalse: [copied add: instVar]. newOthers remove: instVar. oldOthers remove: instVar]]. code := WriteStream on: (String new: 500). + code cr; cr; tab; nextPutAll: '"From ', SystemVersion current version, ' [', Smalltalk lastUpdateString; - code cr; cr; tab; nextPutAll: '"From ', SystemVersion current version, ' [', SmalltalkImage current lastUpdateString; nextPutAll: '] on ', Date today printString, '"'; cr. code tab; nextPutAll: '"These variables are automatically stored into the new instance: '. code nextPutAll: copied asArray printString; nextPut: $.; cr. code tab; nextPutAll: 'Test for this particular conversion.'; nextPutAll: ' Get values using expressions like (varDict at: ''foo'')."'; cr; cr. (newOthers size = 0) & (oldOthers size = 0) & (oldName == nil) ifTrue: [^ self]. "Instance variables are the same. Only the order changed. No conversion needed." (newOthers size > 0) ifTrue: [ code tab; nextPutAll: '"New variables: ', newOthers asArray printString, '. If a non-nil value is needed, please assign it."'; cr]. (oldOthers size > 0) ifTrue: [ code tab; nextPutAll: '"These are going away ', oldOthers asArray printString, '. Possibly store their info in some other variable?"'; cr]. oldName ifNotNil: [ code tab; nextPutAll: '"Test for instances of class ', oldName, '.'; cr. code tab; nextPutAll: 'Instance vars with the same name have been moved here."'; cr. ]. code tab; nextPutAll: '"Move your code above the ^ super... Delete extra comments."'; cr. (newClass includesSelector: #convertToCurrentVersion:refStream:) ifTrue: ["append to old methods" newCode := (newClass sourceCodeAt: #convertToCurrentVersion:refStream:), code contents] ifFalse: ["new method" newCode := 'convertToCurrentVersion: varDict refStream: smartRefStrm', code contents, ' ^ super convertToCurrentVersion: varDict refStream: smartRefStrm']. newClass compile: newCode classified: 'object fileIn'. "If you write a conversion method beware that the class may need a version number change. This only happens when two conversion methods in the same class have the same selector name. (A) The inst var lists of the new and old versions intials as some older set of new and old inst var lists. or (B) Twice in a row, the class needs a conversion method, but the inst vars stay the same the whole time. (For an internal format change.) If either is the case, fileouts already written with the old (wrong) version number, say 2. Your method must be able to read files that say version 2 but are really 3, until you expunge the erroneous version 2 files from the universe." ! Item was changed: ----- Method: SystemVersion class>>check:andRequestPluginUpdate: (in category 'updating') ----- check: pluginVersion andRequestPluginUpdate: updateURL "SystemVersion check: 'zzz' andRequestPluginUpdate: 'http://www.squeakland.org/installers/update.html' " "We don't have a decent versioning scheme yet, so we are basically checking for a nil VM version on the mac." (self pluginVersion: pluginVersion newerThan: self currentPluginVersion) ifFalse: [^true]. (self confirm: 'There is a newer plugin version available. Do you want to install it now?') ifFalse: [^false]. HTTPClient + requestURL: updateURL , (Smalltalk platformName copyWithout: Character space) asLowercase , '.html' - requestURL: updateURL , (SmalltalkImage current platformName copyWithout: Character space) asLowercase , '.html' target: '_top'. ^false! Item was changed: ----- Method: SystemVersion class>>checkAndApplyUpdates: (in category 'updating') ----- checkAndApplyUpdates: availableUpdate "SystemVersion checkAndApplyUpdates: nil" ^(availableUpdate isNil or: [availableUpdate > SystemVersion current highestUpdate]) ifTrue: [ (self confirm: 'There are updates available. Do you want to install them now?') ifFalse: [^false]. Utilities readServerUpdatesThrough: availableUpdate saveLocally: false updateImage: true. + Smalltalk snapshot: true andQuit: false. - SmalltalkImage current snapshot: true andQuit: false. true] ifFalse: [false]! Item was changed: ----- Method: SystemVersion class>>currentPluginVersion (in category 'updating') ----- currentPluginVersion + ^Smalltalk vmVersion! - ^SmalltalkImage current vmVersion!
More information about the Squeak-dev mailing list |