Frank Shearar uploaded a new version of TrueType to project The Trunk:
http://source.squeak.org/trunk/TrueType-fbs.25.mcz
==================== Summary ====================
Name: TrueType-fbs.25
Author: fbs
Time: 25 July 2013, 9:02:47.403 am
UUID: 36e831df-1fcc-674c-8dc0-82246dc0028f
Ancestors: TrueType-fbs.24
SmalltalkImage current -> Smalltalk.
=============== Diff against TrueType-fbs.24 ===============
Item was changed:
----- Method: TTFileDescription class>>fontPathsDo: (in category 'font paths') -----
fontPathsDo: aBlock
"Evaluate aBlock with all of the font paths that should be searched on the current platform"
"Start with the current directory"
aBlock value: FileDirectory default pathName.
"Then subdirectory 'fonts'"
aBlock value: (FileDirectory default directoryNamed: 'fonts') pathName.
"Platform specific directories"
+ Smalltalk platformName caseOf:{
- SmalltalkImage current platformName caseOf:{
['Win32'] -> [
"Standard Windows fonts directory"
aBlock value: 'C:\Windows\Fonts'.
].
['Mac OS'] -> [
"Standard system fonts directory"
aBlock value: '/Library/Fonts'.
].
['unix'] -> [ | base |
"Standard fonts are in /usr/share/fonts/*"
base := '/usr/share/fonts'.
(FileDirectory on: base) directoryNames
do:[:dn| aBlock value: base, '/', dn].
].
} otherwise:[].
!
Frank Shearar uploaded a new version of TrueType to project The Trunk:
http://source.squeak.org/trunk/TrueType-fbs.25.mcz
==================== Summary ====================
Name: TrueType-fbs.25
Author: fbs
Time: 25 July 2013, 9:02:47.403 am
UUID: 36e831df-1fcc-674c-8dc0-82246dc0028f
Ancestors: TrueType-fbs.24
SmalltalkImage current -> Smalltalk.
=============== Diff against TrueType-fbs.24 ===============
Item was changed:
----- Method: TTFileDescription class>>fontPathsDo: (in category 'font paths') -----
fontPathsDo: aBlock
"Evaluate aBlock with all of the font paths that should be searched on the current platform"
"Start with the current directory"
aBlock value: FileDirectory default pathName.
"Then subdirectory 'fonts'"
aBlock value: (FileDirectory default directoryNamed: 'fonts') pathName.
"Platform specific directories"
+ Smalltalk platformName caseOf:{
- SmalltalkImage current platformName caseOf:{
['Win32'] -> [
"Standard Windows fonts directory"
aBlock value: 'C:\Windows\Fonts'.
].
['Mac OS'] -> [
"Standard system fonts directory"
aBlock value: '/Library/Fonts'.
].
['unix'] -> [ | base |
"Standard fonts are in /usr/share/fonts/*"
base := '/usr/share/fonts'.
(FileDirectory on: base) directoryNames
do:[:dn| aBlock value: base, '/', dn].
].
} otherwise:[].
!
Frank Shearar uploaded a new version of TrueType to project The Trunk:
http://source.squeak.org/trunk/TrueType-fbs.25.mcz
==================== Summary ====================
Name: TrueType-fbs.25
Author: fbs
Time: 25 July 2013, 9:02:47.403 am
UUID: 36e831df-1fcc-674c-8dc0-82246dc0028f
Ancestors: TrueType-fbs.24
SmalltalkImage current -> Smalltalk.
=============== Diff against TrueType-fbs.24 ===============
Item was changed:
----- Method: TTFileDescription class>>fontPathsDo: (in category 'font paths') -----
fontPathsDo: aBlock
"Evaluate aBlock with all of the font paths that should be searched on the current platform"
"Start with the current directory"
aBlock value: FileDirectory default pathName.
"Then subdirectory 'fonts'"
aBlock value: (FileDirectory default directoryNamed: 'fonts') pathName.
"Platform specific directories"
+ Smalltalk platformName caseOf:{
- SmalltalkImage current platformName caseOf:{
['Win32'] -> [
"Standard Windows fonts directory"
aBlock value: 'C:\Windows\Fonts'.
].
['Mac OS'] -> [
"Standard system fonts directory"
aBlock value: '/Library/Fonts'.
].
['unix'] -> [ | base |
"Standard fonts are in /usr/share/fonts/*"
base := '/usr/share/fonts'.
(FileDirectory on: base) directoryNames
do:[:dn| aBlock value: base, '/', dn].
].
} otherwise:[].
!
Frank Shearar uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-fbs.489.mcz
==================== Summary ====================
Name: Tools-fbs.489
Author: fbs
Time: 25 July 2013, 8:59:51.9 am
UUID: 91b8789c-87f2-d941-9ed5-432aec4a1aca
Ancestors: Tools-fbs.488
SmalltalkImage current -> Smalltalk.
=============== Diff against Tools-fbs.488 ===============
Item was changed:
----- Method: ChangeList class>>browseRecentLog (in category 'public access') -----
browseRecentLog
"ChangeList browseRecentLog"
"Prompt with a menu of how far back to go to browse the current image's changes log file"
^ self
browseRecentLogOn: (SourceFiles at: 2)
+ startingFrom: Smalltalk lastQuitLogPosition!
- startingFrom: SmalltalkImage current lastQuitLogPosition!
Item was changed:
----- Method: ChangeList class>>getRecentLocatorWithPrompt: (in category 'public access') -----
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: CodeHolder>>informPossiblyCorruptSource (in category 'misc') -----
informPossiblyCorruptSource
| sourcesName |
+ sourcesName := FileDirectory localNameFor: Smalltalk sourcesName.
- sourcesName := FileDirectory localNameFor: SmalltalkImage current sourcesName.
self inform: 'There may be a problem with your sources file!!
The source code for every method should (usually) start with the
method selector but this is not the case with this method!! You may
proceed with caution but it is recommended that you get a new source file.
This can happen if you download the "' , sourcesName , '" file,
or the ".changes" file you use, as TEXT. It must be transfered
in BINARY mode, even if it looks like a text file,
to preserve the CR line ends.
Mac users: This may have been caused by Stuffit Expander.
To prevent the files above to be converted to Mac line ends
when they are expanded, do this: Start the program, then
from Preferences... in the File menu, choose the Cross
Platform panel, then select "Never" and press OK.
Then expand the compressed archive again.
(Occasionally, the source code for a method may legitimately
start with a non-alphabetic character -- for example, Behavior
method #formalHeaderPartsFor:. In such rare cases, you can
happily disregard this warning.)'!
Frank Shearar uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-fbs.489.mcz
==================== Summary ====================
Name: Tools-fbs.489
Author: fbs
Time: 25 July 2013, 8:59:51.9 am
UUID: 91b8789c-87f2-d941-9ed5-432aec4a1aca
Ancestors: Tools-fbs.488
SmalltalkImage current -> Smalltalk.
=============== Diff against Tools-fbs.488 ===============
Item was changed:
----- Method: ChangeList class>>browseRecentLog (in category 'public access') -----
browseRecentLog
"ChangeList browseRecentLog"
"Prompt with a menu of how far back to go to browse the current image's changes log file"
^ self
browseRecentLogOn: (SourceFiles at: 2)
+ startingFrom: Smalltalk lastQuitLogPosition!
- startingFrom: SmalltalkImage current lastQuitLogPosition!
Item was changed:
----- Method: ChangeList class>>getRecentLocatorWithPrompt: (in category 'public access') -----
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: CodeHolder>>informPossiblyCorruptSource (in category 'misc') -----
informPossiblyCorruptSource
| sourcesName |
+ sourcesName := FileDirectory localNameFor: Smalltalk sourcesName.
- sourcesName := FileDirectory localNameFor: SmalltalkImage current sourcesName.
self inform: 'There may be a problem with your sources file!!
The source code for every method should (usually) start with the
method selector but this is not the case with this method!! You may
proceed with caution but it is recommended that you get a new source file.
This can happen if you download the "' , sourcesName , '" file,
or the ".changes" file you use, as TEXT. It must be transfered
in BINARY mode, even if it looks like a text file,
to preserve the CR line ends.
Mac users: This may have been caused by Stuffit Expander.
To prevent the files above to be converted to Mac line ends
when they are expanded, do this: Start the program, then
from Preferences... in the File menu, choose the Cross
Platform panel, then select "Never" and press OK.
Then expand the compressed archive again.
(Occasionally, the source code for a method may legitimately
start with a non-alphabetic character -- for example, Behavior
method #formalHeaderPartsFor:. In such rare cases, you can
happily disregard this warning.)'!
Frank Shearar uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-fbs.489.mcz
==================== Summary ====================
Name: Tools-fbs.489
Author: fbs
Time: 25 July 2013, 8:59:51.9 am
UUID: 91b8789c-87f2-d941-9ed5-432aec4a1aca
Ancestors: Tools-fbs.488
SmalltalkImage current -> Smalltalk.
=============== Diff against Tools-fbs.488 ===============
Item was changed:
----- Method: ChangeList class>>browseRecentLog (in category 'public access') -----
browseRecentLog
"ChangeList browseRecentLog"
"Prompt with a menu of how far back to go to browse the current image's changes log file"
^ self
browseRecentLogOn: (SourceFiles at: 2)
+ startingFrom: Smalltalk lastQuitLogPosition!
- startingFrom: SmalltalkImage current lastQuitLogPosition!
Item was changed:
----- Method: ChangeList class>>getRecentLocatorWithPrompt: (in category 'public access') -----
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: CodeHolder>>informPossiblyCorruptSource (in category 'misc') -----
informPossiblyCorruptSource
| sourcesName |
+ sourcesName := FileDirectory localNameFor: Smalltalk sourcesName.
- sourcesName := FileDirectory localNameFor: SmalltalkImage current sourcesName.
self inform: 'There may be a problem with your sources file!!
The source code for every method should (usually) start with the
method selector but this is not the case with this method!! You may
proceed with caution but it is recommended that you get a new source file.
This can happen if you download the "' , sourcesName , '" file,
or the ".changes" file you use, as TEXT. It must be transfered
in BINARY mode, even if it looks like a text file,
to preserve the CR line ends.
Mac users: This may have been caused by Stuffit Expander.
To prevent the files above to be converted to Mac line ends
when they are expanded, do this: Start the program, then
from Preferences... in the File menu, choose the Cross
Platform panel, then select "Never" and press OK.
Then expand the compressed archive again.
(Occasionally, the source code for a method may legitimately
start with a non-alphabetic character -- for example, Behavior
method #formalHeaderPartsFor:. In such rare cases, you can
happily disregard this warning.)'!
Frank Shearar uploaded a new version of Tests to project The Trunk:
http://source.squeak.org/trunk/Tests-fbs.244.mcz
==================== Summary ====================
Name: Tests-fbs.244
Author: fbs
Time: 25 July 2013, 8:55:25.056 am
UUID: c331e496-09f7-d844-b28c-9b30fe401874
Ancestors: Tests-fbs.243
SmalltalkImage current -> Smalltalk.
=============== Diff against Tests-fbs.243 ===============
Item was changed:
Object subclass: #PrimCallControllerAbstract
instanceVariableNames: 'treatedMethods logStream changeStatusOfFailedCallsFlag'
classVariableNames: ''
poolDictionaries: ''
category: 'Tests-PrimCallController'!
+ !PrimCallControllerAbstract commentStamp: 'fbs 7/25/2013 07:16' prior: 0!
- !PrimCallControllerAbstract commentStamp: 'nice 3/25/2010 23:02' prior: 0!
A PrimCallController (PCC) serves for switching external prim calls (primitiveExternalCall) on and off: this is an abstract class, instantiate one of the subclasses PCCByLiterals and PCCByCompilation.
External prim calls are used to access internal and external modules (plugins) as shown by
+ Smalltalk listLoadedModules.
+ Smalltalk listBuiltinModules.
- SmalltalkImage current listLoadedModules.
- SmalltalkImage current listBuiltinModules.
Note: not loaded external modules (since they have not been called so far) are not shown by these methods.
Highlight: dis/en-abling prims by a PCC works for both internal and external modules!!
To help you choosing the right subclass, some properties are listed in the following table:
Functionality/Property | PCCByLiterals PCCByCompilation
------------------------------------------------------------------------------------------------------
testing plugins | suited not suited
permanent disabling of external prim calls | no yes
------------------------------------------------------------------------------------------------------
method changes visible in changeset | no yes
enabling survives snapshot/compilation | yes yes
disabling survives snapshot/compilation | no yes
speed disabling | fast medium
speed enabling | fast slow
CompiledMethod pointer valid after en/dis-abling | yes no
Important: Be careful with mixing the use of different PCCs!! PCCByLiterals does not see prims disabled by PCCByCompilation and vice versa. For playing around you should start with PCCByLiterals; use PCCByCompilation only, if you know what you are doing!!
In protocols 'ui controlling', 'ui logging' and 'ui querying' (please look into this class) are the most important user interface methods. Thereafter the methods in 'ui testing' could be of interest.
Useful expressions:
Controlling:
"Factorial example"
| pcc tDisabled tEnabled tEnabled2 |
pcc := PCCByLiterals new logStream: Transcript. "logStream set here for more info"
pcc disableCallsIntoModule: 'LargeIntegers'.
tDisabled := [1000 factorial] timeToRun.
pcc enableDisabled.
tEnabled := [1000 factorial] timeToRun.
tEnabled2 := [1000 factorial] timeToRun.
{tDisabled. tEnabled. tEnabled2}
Note: You shouldn't switch off module 'LargeIntegers' for a longer time, since this slows down your system.
Querying:
PCCByLiterals new methodsWithCall. "all calls"
PCCByLiterals new methodsWithCall: 'prim1'. "call in all modules or without module"
PCCByLiterals new methodsWithCallIntoModule: nil. "all calls without module"
PCCByLiterals new methodsWithCallIntoModule: 'LargeIntegers'. "all calls into module 'LargeIntegers'"
PCCByLiterals new
methodsWithCallIntoModule: 'LargeIntegers'
forClass: Integer. "all calls into module 'LargeIntegers' in class Integer"
PCCByLiterals new
methodsWithCallIntoModule: 'LargeIntegers'
forClasses: Integer withAllSubclasses. "all calls into module 'LargeIntegers' in class Integer withAllSubclasses"
| pcc | (pcc := PCCByLiterals new) methodsWithCall
collect: [:mRef | {mRef. pcc extractCallModuleNames: mRef}].
Structure:
treatedMethods Dictionary of MethodReferences->#disabled/#enabled
-- contains changed methods and how they are changed last
logStream WriteStream -- shows info about changed methods ifNotNil
changeStatusOfFailedCalls Boolean -- if status of failed calls should be changed, default is false!
Item was changed:
----- Method: SmalltalkImageTest>>testImageName (in category 'testing') -----
testImageName
"Non regression test for http://bugs.squeak.org/view.php?id=7351"
| shortImgName fullImgName fullChgName |
shortImgName := 'Squeak3.10.2-7179-basic'.
+ fullImgName := Smalltalk fullNameForImageNamed: shortImgName.
+ fullChgName := Smalltalk fullNameForChangesNamed: shortImgName.
- fullImgName := SmalltalkImage current fullNameForImageNamed: shortImgName.
- fullChgName := SmalltalkImage current fullNameForChangesNamed: shortImgName.
FileDirectory splitName: fullImgName to: [:path :name |
+ self assert: path = Smalltalk imagePath.
- self assert: path = SmalltalkImage current imagePath.
self assert: name = 'Squeak3.10.2-7179-basic.image'.].
FileDirectory splitName: fullChgName to: [:path :name |
+ self assert: path = Smalltalk imagePath.
- self assert: path = SmalltalkImage current imagePath.
self assert: name = 'Squeak3.10.2-7179-basic.changes'.].!
Frank Shearar uploaded a new version of Tests to project The Trunk:
http://source.squeak.org/trunk/Tests-fbs.244.mcz
==================== Summary ====================
Name: Tests-fbs.244
Author: fbs
Time: 25 July 2013, 8:55:25.056 am
UUID: c331e496-09f7-d844-b28c-9b30fe401874
Ancestors: Tests-fbs.243
SmalltalkImage current -> Smalltalk.
=============== Diff against Tests-fbs.243 ===============
Item was changed:
Object subclass: #PrimCallControllerAbstract
instanceVariableNames: 'treatedMethods logStream changeStatusOfFailedCallsFlag'
classVariableNames: ''
poolDictionaries: ''
category: 'Tests-PrimCallController'!
+ !PrimCallControllerAbstract commentStamp: 'fbs 7/25/2013 07:16' prior: 0!
- !PrimCallControllerAbstract commentStamp: 'nice 3/25/2010 23:02' prior: 0!
A PrimCallController (PCC) serves for switching external prim calls (primitiveExternalCall) on and off: this is an abstract class, instantiate one of the subclasses PCCByLiterals and PCCByCompilation.
External prim calls are used to access internal and external modules (plugins) as shown by
+ Smalltalk listLoadedModules.
+ Smalltalk listBuiltinModules.
- SmalltalkImage current listLoadedModules.
- SmalltalkImage current listBuiltinModules.
Note: not loaded external modules (since they have not been called so far) are not shown by these methods.
Highlight: dis/en-abling prims by a PCC works for both internal and external modules!!
To help you choosing the right subclass, some properties are listed in the following table:
Functionality/Property | PCCByLiterals PCCByCompilation
------------------------------------------------------------------------------------------------------
testing plugins | suited not suited
permanent disabling of external prim calls | no yes
------------------------------------------------------------------------------------------------------
method changes visible in changeset | no yes
enabling survives snapshot/compilation | yes yes
disabling survives snapshot/compilation | no yes
speed disabling | fast medium
speed enabling | fast slow
CompiledMethod pointer valid after en/dis-abling | yes no
Important: Be careful with mixing the use of different PCCs!! PCCByLiterals does not see prims disabled by PCCByCompilation and vice versa. For playing around you should start with PCCByLiterals; use PCCByCompilation only, if you know what you are doing!!
In protocols 'ui controlling', 'ui logging' and 'ui querying' (please look into this class) are the most important user interface methods. Thereafter the methods in 'ui testing' could be of interest.
Useful expressions:
Controlling:
"Factorial example"
| pcc tDisabled tEnabled tEnabled2 |
pcc := PCCByLiterals new logStream: Transcript. "logStream set here for more info"
pcc disableCallsIntoModule: 'LargeIntegers'.
tDisabled := [1000 factorial] timeToRun.
pcc enableDisabled.
tEnabled := [1000 factorial] timeToRun.
tEnabled2 := [1000 factorial] timeToRun.
{tDisabled. tEnabled. tEnabled2}
Note: You shouldn't switch off module 'LargeIntegers' for a longer time, since this slows down your system.
Querying:
PCCByLiterals new methodsWithCall. "all calls"
PCCByLiterals new methodsWithCall: 'prim1'. "call in all modules or without module"
PCCByLiterals new methodsWithCallIntoModule: nil. "all calls without module"
PCCByLiterals new methodsWithCallIntoModule: 'LargeIntegers'. "all calls into module 'LargeIntegers'"
PCCByLiterals new
methodsWithCallIntoModule: 'LargeIntegers'
forClass: Integer. "all calls into module 'LargeIntegers' in class Integer"
PCCByLiterals new
methodsWithCallIntoModule: 'LargeIntegers'
forClasses: Integer withAllSubclasses. "all calls into module 'LargeIntegers' in class Integer withAllSubclasses"
| pcc | (pcc := PCCByLiterals new) methodsWithCall
collect: [:mRef | {mRef. pcc extractCallModuleNames: mRef}].
Structure:
treatedMethods Dictionary of MethodReferences->#disabled/#enabled
-- contains changed methods and how they are changed last
logStream WriteStream -- shows info about changed methods ifNotNil
changeStatusOfFailedCalls Boolean -- if status of failed calls should be changed, default is false!
Item was changed:
----- Method: SmalltalkImageTest>>testImageName (in category 'testing') -----
testImageName
"Non regression test for http://bugs.squeak.org/view.php?id=7351"
| shortImgName fullImgName fullChgName |
shortImgName := 'Squeak3.10.2-7179-basic'.
+ fullImgName := Smalltalk fullNameForImageNamed: shortImgName.
+ fullChgName := Smalltalk fullNameForChangesNamed: shortImgName.
- fullImgName := SmalltalkImage current fullNameForImageNamed: shortImgName.
- fullChgName := SmalltalkImage current fullNameForChangesNamed: shortImgName.
FileDirectory splitName: fullImgName to: [:path :name |
+ self assert: path = Smalltalk imagePath.
- self assert: path = SmalltalkImage current imagePath.
self assert: name = 'Squeak3.10.2-7179-basic.image'.].
FileDirectory splitName: fullChgName to: [:path :name |
+ self assert: path = Smalltalk imagePath.
- self assert: path = SmalltalkImage current imagePath.
self assert: name = 'Squeak3.10.2-7179-basic.changes'.].!
Frank Shearar uploaded a new version of Tests to project The Trunk:
http://source.squeak.org/trunk/Tests-fbs.244.mcz
==================== Summary ====================
Name: Tests-fbs.244
Author: fbs
Time: 25 July 2013, 8:55:25.056 am
UUID: c331e496-09f7-d844-b28c-9b30fe401874
Ancestors: Tests-fbs.243
SmalltalkImage current -> Smalltalk.
=============== Diff against Tests-fbs.243 ===============
Item was changed:
Object subclass: #PrimCallControllerAbstract
instanceVariableNames: 'treatedMethods logStream changeStatusOfFailedCallsFlag'
classVariableNames: ''
poolDictionaries: ''
category: 'Tests-PrimCallController'!
+ !PrimCallControllerAbstract commentStamp: 'fbs 7/25/2013 07:16' prior: 0!
- !PrimCallControllerAbstract commentStamp: 'nice 3/25/2010 23:02' prior: 0!
A PrimCallController (PCC) serves for switching external prim calls (primitiveExternalCall) on and off: this is an abstract class, instantiate one of the subclasses PCCByLiterals and PCCByCompilation.
External prim calls are used to access internal and external modules (plugins) as shown by
+ Smalltalk listLoadedModules.
+ Smalltalk listBuiltinModules.
- SmalltalkImage current listLoadedModules.
- SmalltalkImage current listBuiltinModules.
Note: not loaded external modules (since they have not been called so far) are not shown by these methods.
Highlight: dis/en-abling prims by a PCC works for both internal and external modules!!
To help you choosing the right subclass, some properties are listed in the following table:
Functionality/Property | PCCByLiterals PCCByCompilation
------------------------------------------------------------------------------------------------------
testing plugins | suited not suited
permanent disabling of external prim calls | no yes
------------------------------------------------------------------------------------------------------
method changes visible in changeset | no yes
enabling survives snapshot/compilation | yes yes
disabling survives snapshot/compilation | no yes
speed disabling | fast medium
speed enabling | fast slow
CompiledMethod pointer valid after en/dis-abling | yes no
Important: Be careful with mixing the use of different PCCs!! PCCByLiterals does not see prims disabled by PCCByCompilation and vice versa. For playing around you should start with PCCByLiterals; use PCCByCompilation only, if you know what you are doing!!
In protocols 'ui controlling', 'ui logging' and 'ui querying' (please look into this class) are the most important user interface methods. Thereafter the methods in 'ui testing' could be of interest.
Useful expressions:
Controlling:
"Factorial example"
| pcc tDisabled tEnabled tEnabled2 |
pcc := PCCByLiterals new logStream: Transcript. "logStream set here for more info"
pcc disableCallsIntoModule: 'LargeIntegers'.
tDisabled := [1000 factorial] timeToRun.
pcc enableDisabled.
tEnabled := [1000 factorial] timeToRun.
tEnabled2 := [1000 factorial] timeToRun.
{tDisabled. tEnabled. tEnabled2}
Note: You shouldn't switch off module 'LargeIntegers' for a longer time, since this slows down your system.
Querying:
PCCByLiterals new methodsWithCall. "all calls"
PCCByLiterals new methodsWithCall: 'prim1'. "call in all modules or without module"
PCCByLiterals new methodsWithCallIntoModule: nil. "all calls without module"
PCCByLiterals new methodsWithCallIntoModule: 'LargeIntegers'. "all calls into module 'LargeIntegers'"
PCCByLiterals new
methodsWithCallIntoModule: 'LargeIntegers'
forClass: Integer. "all calls into module 'LargeIntegers' in class Integer"
PCCByLiterals new
methodsWithCallIntoModule: 'LargeIntegers'
forClasses: Integer withAllSubclasses. "all calls into module 'LargeIntegers' in class Integer withAllSubclasses"
| pcc | (pcc := PCCByLiterals new) methodsWithCall
collect: [:mRef | {mRef. pcc extractCallModuleNames: mRef}].
Structure:
treatedMethods Dictionary of MethodReferences->#disabled/#enabled
-- contains changed methods and how they are changed last
logStream WriteStream -- shows info about changed methods ifNotNil
changeStatusOfFailedCalls Boolean -- if status of failed calls should be changed, default is false!
Item was changed:
----- Method: SmalltalkImageTest>>testImageName (in category 'testing') -----
testImageName
"Non regression test for http://bugs.squeak.org/view.php?id=7351"
| shortImgName fullImgName fullChgName |
shortImgName := 'Squeak3.10.2-7179-basic'.
+ fullImgName := Smalltalk fullNameForImageNamed: shortImgName.
+ fullChgName := Smalltalk fullNameForChangesNamed: shortImgName.
- fullImgName := SmalltalkImage current fullNameForImageNamed: shortImgName.
- fullChgName := SmalltalkImage current fullNameForChangesNamed: shortImgName.
FileDirectory splitName: fullImgName to: [:path :name |
+ self assert: path = Smalltalk imagePath.
- self assert: path = SmalltalkImage current imagePath.
self assert: name = 'Squeak3.10.2-7179-basic.image'.].
FileDirectory splitName: fullChgName to: [:path :name |
+ self assert: path = Smalltalk imagePath.
- self assert: path = SmalltalkImage current imagePath.
self assert: name = 'Squeak3.10.2-7179-basic.changes'.].!
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@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!