Packages March 2021

packages@lists.squeakfoundation.org

1 participants
89 discussions

The Trunk: Collections-ul.932.mcz
by commits＠source.squeak.org 31 Mar '21

31 Mar '21

Levente Uzonyi uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-ul.932.mcz ==================== Summary ==================== Name: Collections-ul.932 Author: ul Time: 31 March 2021, 2:12:26.200489 am UUID: a61726a6-a12e-4074-a25f-8220699d3c06 Ancestors: Collections-dtl.931 - use #grownBy: in WriteStream >> #growTo: to grow the collection because that works for OrderedCollections too. - do not add 10 to the argument passed to WriteStream >> #growTo:. It will already increase its argument by at least 20. =============== Diff against Collections-dtl.931 =============== Item was changed: ----- Method: LimitedWriteStream>>nextPutAll: (in category 'writing') ----- nextPutAll: aCollection | newEnd | collection class == aCollection class ifFalse: [^ super nextPutAll: aCollection ]. newEnd := position + aCollection size. newEnd > limit ifTrue: [ super nextPutAll: (aCollection copyFrom: 1 to: (limit - position max: 0)). limitBlock value. ^aCollection ]. newEnd > writeLimit ifTrue: [ + self growTo: newEnd - self growTo: newEnd + 10 ]. collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: 1. position := newEnd. ^aCollection! Item was changed: ----- Method: TextStream>>nextPutAll: (in category 'writing') ----- nextPutAll: aCollection "Optimized access to get around Text at:Put: overhead" | n | n := aCollection size. position + n > writeLimit ifTrue: + [self growTo: position + n]. - [self growTo: position + n + 10]. collection replaceFrom: position+1 to: position + n with: aCollection startingAt: 1. position := position + n. ^aCollection! Item was changed: ----- Method: WriteStream>><< (in category 'printing') ----- << aCollection "we want a readable version of nextPutAll however it may be difficult to fully recreate nextPutAll: for all the different types of stream. Rather then simply send to nextPutAll: we handle the String (or ByteArray) argument as fast as possible - the rest we delegate to putOn: This means that we handle single characters and bytes whereas nextPutAll: is only for sequencable collections. . Note this may not work in every case that nextPutAll: does subject to extensive testing, but it should work in the important cases" | newEnd | collection class == aCollection class ifFalse: [ aCollection putOn: self. ^ self ]. newEnd := position + aCollection size. newEnd > writeLimit ifTrue: + [self growTo: newEnd]. - [self growTo: newEnd + 10]. collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: 1. position := newEnd. ! Item was changed: ----- Method: WriteStream>>growTo: (in category 'private') ----- growTo: anInteger + " anInteger is the required minimal new size of the collection " + | oldSize newSize | - " anInteger is the required minimal new size of the collection " - | oldSize grownCollection newSize | oldSize := collection size. + newSize := anInteger + (oldSize // 4 max: 20). + collection := collection grownBy: newSize - oldSize. - newSize := anInteger + (oldSize // 4 max: 20). - grownCollection := collection class new: newSize. - collection := grownCollection replaceFrom: 1 to: oldSize with: collection startingAt: 1. writeLimit := collection size. ! Item was changed: ----- Method: WriteStream>>next:putAll:startingAt: (in category 'accessing') ----- next: anInteger putAll: aCollection startingAt: startIndex "Store the next anInteger elements from the given collection." | newEnd | anInteger > 0 ifFalse: [ ^aCollection ]. (collection class == aCollection class or: [ collection isString and: [ aCollection isString and: [ collection class format = aCollection class format ] ] ]) "Let Strings with the same field size as collection take the quick route too." ifFalse: [ ^super next: anInteger putAll: aCollection startingAt: startIndex ]. newEnd := position + anInteger. newEnd > writeLimit ifTrue: + [self growTo: newEnd]. - [self growTo: newEnd + 10]. collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: startIndex. position := newEnd. ^aCollection! Item was changed: ----- Method: WriteStream>>nextPutAll: (in category 'accessing') ----- nextPutAll: aCollection | newEnd | (collection class == aCollection class or: [ collection class isBits and: [ aCollection isString and: [ collection class format = aCollection class format ] ] ]) "Let Strings with the same field size as collection take the quick route too." ifFalse: [ ^ super nextPutAll: aCollection ]. newEnd := position + aCollection size. newEnd > writeLimit ifTrue: + [self growTo: newEnd]. - [self growTo: newEnd + 10]. collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: 1. position := newEnd. ^aCollection!

1 0

The Trunk: Chronology-Core-dtl.66.mcz
by commits＠source.squeak.org 30 Mar '21

30 Mar '21

David T. Lewis uploaded a new version of Chronology-Core to project The Trunk: http://source.squeak.org/trunk/Chronology-Core-dtl.66.mcz ==================== Summary ==================== Name: Chronology-Core-dtl.66 Author: dtl Time: 28 March 2021, 10:52:56.0001 am UUID: 9695afba-0eaf-49ab-8d2e-177f089f1d04 Ancestors: Chronology-Core-dtl.65 Let "1 second" be a synonym for "1 seconds" so that "5 second" does not answer one second. Likewise for minute, hour, etc. =============== Diff against Chronology-Core-dtl.65 =============== Item was changed: ----- Method: Number>>day (in category '*chronology-core') ----- day + ^ self days! - ^ self sign days! Item was changed: ----- Method: Number>>hour (in category '*chronology-core') ----- hour + ^ self hours - ^ self sign hours ! Item was changed: ----- Method: Number>>microSecond (in category '*chronology-core') ----- microSecond + ^ self microSeconds! - ^ self sign microSeconds! Item was changed: ----- Method: Number>>milliSecond (in category '*chronology-core') ----- milliSecond + ^ self milliSeconds - ^ self sign milliSeconds ! Item was changed: ----- Method: Number>>minute (in category '*chronology-core') ----- minute + ^ self minutes - ^ self sign minutes ! Item was changed: ----- Method: Number>>nanoSecond (in category '*chronology-core') ----- nanoSecond + ^ self nanoSeconds - ^ self sign nanoSeconds ! Item was changed: ----- Method: Number>>second (in category '*chronology-core') ----- second + ^ self seconds - ^ self sign seconds ! Item was changed: ----- Method: Number>>week (in category '*chronology-core') ----- week + ^ self weeks - ^ self sign weeks !

1 0

The Trunk: Chronology-Tests-dtl.25.mcz
by commits＠source.squeak.org 30 Mar '21

30 Mar '21

David T. Lewis uploaded a new version of Chronology-Tests to project The Trunk: http://source.squeak.org/trunk/Chronology-Tests-dtl.25.mcz ==================== Summary ==================== Name: Chronology-Tests-dtl.25 Author: dtl Time: 28 March 2021, 10:52:19.196147 am UUID: c5ee558b-5ac5-4d89-812c-4cfd106b45e2 Ancestors: Chronology-Tests-dtl.24 Expect that "1 second" should be a synonym for "1 seconds" so that "5 second" does not answer one second. Likewise for minute, hour, etc. =============== Diff against Chronology-Tests-dtl.24 =============== Item was added: + ----- Method: DurationTest>>testDaysFromNumber (in category 'tests - from number') ----- + testDaysFromNumber + + self assert: 5 equals: 5 days asSeconds / 86400. + self assert: -5 equals: -5 days asSeconds / 86400. + self assert: 1 equals: 1 days asSeconds / 86400. + self assert: -1 equals: -1 days asSeconds / 86400. + self assert: 0 equals: 0 days asSeconds / 86400. + self assert: 1500 equals: 1.5 days asMilliSeconds / 86400. + self assert: -1500 equals: -1.5 days asMilliSeconds / 86400. + + self assert: 5 equals: 5 day asSeconds / 86400. + self assert: -5 equals: -5 day asSeconds / 86400. + self assert: 1 equals: 1 day asSeconds / 86400. + self assert: -1 equals: -1 day asSeconds / 86400. + self assert: 0 equals: 0 day asSeconds / 86400. + self assert: 1500 equals: 1.5 day asMilliSeconds / 86400. + self assert: -1500 equals: -1.5 day asMilliSeconds / 86400. + ! Item was added: + ----- Method: DurationTest>>testHoursFromNumber (in category 'tests - from number') ----- + testHoursFromNumber + + self assert: 5 equals: 5 hours asSeconds / 3600. + self assert: -5 equals: -5 hours asSeconds / 3600. + self assert: 1 equals: 1 hours asSeconds / 3600. + self assert: -1 equals: -1 hours asSeconds / 3600. + self assert: 0 equals: 0 hours asSeconds / 3600. + self assert: 1500 equals: 1.5 hours asMilliSeconds / 3600. + self assert: -1500 equals: -1.5 hours asMilliSeconds / 3600. + + self assert: 5 equals: 5 hour asSeconds / 3600. + self assert: -5 equals: -5 hour asSeconds / 3600. + self assert: 1 equals: 1 hour asSeconds / 3600. + self assert: -1 equals: -1 hour asSeconds / 3600. + self assert: 0 equals: 0 hour asSeconds / 3600. + self assert: 1500 equals: 1.5 hour asMilliSeconds / 3600. + self assert: -1500 equals: -1.5 hour asMilliSeconds / 3600. + ! Item was added: + ----- Method: DurationTest>>testMicroSecondsFromNumber (in category 'tests - from number') ----- + testMicroSecondsFromNumber + + self assert: 5 equals: 5 microSeconds asMicroSeconds. + self assert: -5 equals: -5 microSeconds asMicroSeconds. + self assert: 1 equals: 1 microSeconds asMicroSeconds. + self assert: -1 equals: -1 microSeconds asMicroSeconds. + self assert: 0 equals: 0 microSeconds asMicroSeconds. + self assert: 1500 equals: 1.5 microSeconds asNanoSeconds. + self assert: -1500 equals: -1.5 microSeconds asNanoSeconds. + + self assert: 5 equals: 5 microSecond asMicroSeconds. + self assert: -5 equals: -5 microSecond asMicroSeconds. + self assert: 1 equals: 1 microSecond asMicroSeconds. + self assert: -1 equals: -1 microSecond asMicroSeconds. + self assert: 0 equals: 0 microSecond asMicroSeconds. + self assert: 1500 equals: 1.5 microSecond asNanoSeconds. + self assert: -1500 equals: -1.5 microSecond asNanoSeconds. + ! Item was added: + ----- Method: DurationTest>>testMilliSecondsFromNumber (in category 'tests - from number') ----- + testMilliSecondsFromNumber + + self assert: 5 equals: 5 milliSeconds asMilliSeconds. + self assert: -5 equals: -5 milliSeconds asMilliSeconds. + self assert: 1 equals: 1 milliSeconds asMilliSeconds. + self assert: -1 equals: -1 milliSeconds asMilliSeconds. + self assert: 0 equals: 0 milliSeconds asMilliSeconds. + self assert: 1500 equals: 1.5 milliSeconds asMicroSeconds. + self assert: -1500 equals: -1.5 milliSeconds asMicroSeconds. + + self assert: 5 equals: 5 milliSecond asMilliSeconds. + self assert: -5 equals: -5 milliSecond asMilliSeconds. + self assert: 1 equals: 1 milliSecond asMilliSeconds. + self assert: -1 equals: -1 milliSecond asMilliSeconds. + self assert: 0 equals: 0 milliSecond asMilliSeconds. + self assert: 1500 equals: 1.5 milliSecond asMicroSeconds. + self assert: -1500 equals: -1.5 milliSecond asMicroSeconds. + ! Item was added: + ----- Method: DurationTest>>testMinutesFromNumber (in category 'tests - from number') ----- + testMinutesFromNumber + + self assert: 5 equals: 5 minutes asSeconds / 60. + self assert: -5 equals: -5 minutes asSeconds / 60. + self assert: 1 equals: 1 minutes asSeconds / 60. + self assert: -1 equals: -1 minutes asSeconds / 60. + self assert: 0 equals: 0 minutes asSeconds / 60. + self assert: 1500 equals: 1.5 minutes asMilliSeconds / 60. + self assert: -1500 equals: -1.5 minutes asMilliSeconds / 60. + + self assert: 5 equals: 5 minute asSeconds / 60. + self assert: -5 equals: -5 minute asSeconds / 60. + self assert: 1 equals: 1 minute asSeconds / 60. + self assert: -1 equals: -1 minute asSeconds / 60. + self assert: 0 equals: 0 minute asSeconds / 60. + self assert: 1500 equals: 1.5 minute asMilliSeconds / 60. + self assert: -1500 equals: -1.5 minute asMilliSeconds / 60. + ! Item was added: + ----- Method: DurationTest>>testNanoSecondsFromNumber (in category 'tests - from number') ----- + testNanoSecondsFromNumber + + self assert: 5 equals: 5 nanoSeconds asNanoSeconds. + self assert: -5 equals: -5 nanoSeconds asNanoSeconds. + self assert: 1 equals: 1 nanoSeconds asNanoSeconds. + self assert: -1 equals: -1 nanoSeconds asNanoSeconds. + self assert: 0 equals: 0 nanoSeconds asNanoSeconds. + + self assert: 5 equals: 5 nanoSecond asNanoSeconds. + self assert: -5 equals: -5 nanoSecond asNanoSeconds. + self assert: 1 equals: 1 nanoSecond asNanoSeconds. + self assert: -1 equals: -1 nanoSecond asNanoSeconds. + self assert: 0 equals: 0 nanoSecond asNanoSeconds. + ! Item was added: + ----- Method: DurationTest>>testSecondsFromNumber (in category 'tests - from number') ----- + testSecondsFromNumber + + self assert: 5 equals: 5 seconds asSeconds. + self assert: -5 equals: -5 seconds asSeconds. + self assert: 1 equals: 1 seconds asSeconds. + self assert: -1 equals: -1 seconds asSeconds. + self assert: 0 equals: 0 seconds asSeconds. + self assert: 1500 equals: 1.5 seconds asMilliSeconds. + self assert: -1500 equals: -1.5 seconds asMilliSeconds. + + self assert: 5 equals: 5 second asSeconds. + self assert: -5 equals: -5 second asSeconds. + self assert: 1 equals: 1 second asSeconds. + self assert: -1 equals: -1 second asSeconds. + self assert: 0 equals: 0 second asSeconds. + self assert: 1500 equals: 1.5 second asMilliSeconds. + self assert: -1500 equals: -1.5 second asMilliSeconds. + ! Item was added: + ----- Method: DurationTest>>testWeeksFromNumber (in category 'tests - from number') ----- + testWeeksFromNumber + + self assert: 5 equals: 5 weeks asSeconds / 604800. + self assert: -5 equals: -5 weeks asSeconds / 604800. + self assert: 1 equals: 1 weeks asSeconds / 604800. + self assert: -1 equals: -1 weeks asSeconds / 604800. + self assert: 0 equals: 0 weeks asSeconds / 604800. + self assert: 1500 equals: 1.5 weeks asMilliSeconds / 604800. + self assert: -1500 equals: -1.5 weeks asMilliSeconds / 604800. + + self assert: 5 equals: 5 week asSeconds / 604800. + self assert: -5 equals: -5 week asSeconds / 604800. + self assert: 1 equals: 1 week asSeconds / 604800. + self assert: -1 equals: -1 week asSeconds / 604800. + self assert: 0 equals: 0 week asSeconds / 604800. + self assert: 1500 equals: 1.5 week asMilliSeconds / 604800. + self assert: -1500 equals: -1.5 week asMilliSeconds / 604800. + !

1 0

The Trunk: Environments-tonyg.81.mcz
by commits＠source.squeak.org 29 Mar '21

29 Mar '21

Tony Garnock-Jones uploaded a new version of Environments to project The Trunk: http://source.squeak.org/trunk/Environments-tonyg.81.mcz ==================== Summary ==================== Name: Environments-tonyg.81 Author: tonyg Time: 29 March 2021, 10:20:10.069623 am UUID: 3b64bc37-b2d0-4b78-85fe-fa13775df713 Ancestors: Environments-tonyg.80 Repair EnvironmentRequest signal. =============== Diff against Environments-tonyg.80 =============== Item was changed: ----- Method: EnvironmentRequest>>defaultAction (in category 'exceptionDescription') ----- defaultAction | all environment | all := Environment allInstances. + environment := UIManager default + chooseFrom: (all collect: [:ea | ea printString]) + values: all. - environment := UIManager default chooseFrom: all values: all. self resume: environment.!

1 0

The Trunk: Environments-tonyg.80.mcz
by commits＠source.squeak.org 29 Mar '21

29 Mar '21

Tony Garnock-Jones uploaded a new version of Environments to project The Trunk: http://source.squeak.org/trunk/Environments-tonyg.80.mcz ==================== Summary ==================== Name: Environments-tonyg.80 Author: tonyg Time: 29 March 2021, 10:18:29.909437 am UUID: 53a02a38-aeab-425c-9157-4f243eafdd49 Ancestors: Environments-dtl.77 Take advantage of System-tonyg.1224, which teaches SystemOrganizer about environments. =============== Diff against Environments-dtl.77 =============== Item was changed: ----- Method: Environment>>initializeWithName: (in category 'initialize-release') ----- initializeWithName: aString | smalltalk | self initialize. info := EnvironmentInfo name: aString. + info organization environment: self. - . smalltalk := SmalltalkImage basicNew. smalltalk globals: self. declarations at: #Smalltalk put: smalltalk. declarations at: #Undeclared put: undeclared.! Item was changed: ----- Method: Environment>>initializeWithSystemDictionary: (in category 'initialize-release') ----- initializeWithSystemDictionary: old self initialize. info := EnvironmentInfo name: 'Smalltalk' organization: old organization packages: PackageOrganizer default. + info organization environment: self. old associationsDo: [:assc | declarations add: assc]. (old at: #Undeclared) associationsDo: [:assc | undeclared add: assc]. (declarations at: #Smalltalk) instVarNamed: 'globals' put: self. declarations at: #Undeclared put: undeclared.!

1 0

The Trunk: System-tonyg.1224.mcz
by commits＠source.squeak.org 29 Mar '21

29 Mar '21

Tony Garnock-Jones uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-tonyg.1224.mcz ==================== Summary ==================== Name: System-tonyg.1224 Author: tonyg Time: 29 March 2021, 10:15:02.279821 am UUID: 9d897d72-46fc-4205-a27b-89c7a50ac104 Ancestors: System-mt.1223 Teach SystemOrganizer about multiple environments. =============== Diff against System-mt.1223 =============== Item was changed: Categorizer subclass: #SystemOrganizer + instanceVariableNames: 'environment' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Support'! !SystemOrganizer commentStamp: '<historical>' prior: 0! My instances provide an organization for the classes in the system, just as a ClassOrganizer organizes the messages within a class. The only difference is the methods for fileIn/Out.! Item was changed: ----- Method: SystemOrganizer>>classesIn: (in category 'query') ----- classesIn: categoryName | classes | classes := OrderedCollection new. self categories withIndexCollect: [:cat :idx | (categoryName match: cat) ifTrue: [classes addAll: (self listAtCategoryNumber: idx)] ifFalse: [nil]]. + ^ classes collect: [:clsName | self environment classNamed: clsName]! - ^ classes collect: [:clsName | Smalltalk classNamed: clsName]! Item was changed: ----- Method: SystemOrganizer>>classify:under: (in category 'accessing') ----- classify: element under: newCategory | oldCategory class | self flag: #environments. "do we want notifications for classes in other environments?" oldCategory := self categoryOfElement: element. super classify: element under: newCategory. + class := self environment at: element ifAbsent: [^ self]. - class := Smalltalk at: element ifAbsent: [^ self]. self == SystemOrganization ifTrue: [ SystemChangeNotifier uniqueInstance class: class recategorizedFrom: oldCategory to: newCategory]! Item was changed: ----- Method: SystemOrganizer>>commentInventory: (in category 'query') ----- commentInventory: categoryName "SystemOrganization commentInventory: 'Morphic*'" | classes commentedClasses | classes := OrderedCollection new. self categories withIndexCollect: [:cat :idx | (categoryName match: cat) ifTrue: [classes addAll: (self listAtCategoryNumber: idx)] ifFalse: [nil]]. + commentedClasses := classes select: [:catCls | (self environment at: catCls) hasComment]. - commentedClasses := classes select: [:catCls | (Smalltalk at: catCls) hasComment]. ^ 'There are ' , classes size asString , ' classes in ' , categoryName , ' of which ' , commentedClasses size asString , ' have comments and ', (classes size - commentedClasses size) asString , ' do not yet have comments.' ! Item was added: + ----- Method: SystemOrganizer>>environment (in category 'accessing') ----- + environment + ^ environment ifNil: [Smalltalk globals]! Item was added: + ----- Method: SystemOrganizer>>environment: (in category 'accessing') ----- + environment: anEnvironment + environment := anEnvironment! Item was changed: ----- Method: SystemOrganizer>>fileOutCategory:on:initializing: (in category 'fileIn/Out') ----- fileOutCategory: category on: aFileStream initializing: aBool "Store on the file associated with aFileStream, all the traits and classes associated with the category and any requested shared pools in the right order." | first poolSet tempClass classes traits | traits := self orderedTraitsIn: category. classes := self superclassOrder: category. poolSet := Set new. classes do: [:class | class sharedPools do: [:eachPool | poolSet add: eachPool]]. poolSet size > 0 ifTrue: [ tempClass := Class new. tempClass shouldFileOutPools ifTrue: [ poolSet := poolSet select: [:aPool | + tempClass shouldFileOutPool: (self environment keyAtIdentityValue: aPool)]. - tempClass shouldFileOutPool: (Smalltalk globals keyAtIdentityValue: aPool)]. poolSet do: [:aPool | tempClass fileOutPool: aPool onFileStream: aFileStream]]]. first := true. traits, classes do: [:each | first ifTrue: [first := false] ifFalse: [aFileStream cr; nextPut: Character newPage; cr]. each fileOutOn: aFileStream moveSource: false toFile: 0 initializing: false]. aBool ifTrue: [classes do: [:cls | cls fileOutInitializerOn: aFileStream]].! Item was changed: ----- Method: SystemOrganizer>>orderedTraitsIn: (in category 'fileIn/Out') ----- orderedTraitsIn: category "Answer an OrderedCollection containing references to the traits in the category whose name is the argument, category (a string). The traits are ordered so they can be filed in." | behaviors traits | behaviors := (self listAtCategoryNamed: category asSymbol) + collect: [:title | self environment at: title]. - collect: [:title | Smalltalk at: title]. traits := behaviors reject: [:each | each isBehavior]. ^traits asArray sort: [:t1 :t2 | (t2 traitComposition allTraits includes: t1) or: [(t1 traitComposition allTraits includes: t2) not]]! Item was changed: ----- Method: SystemOrganizer>>removeMissingClasses (in category 'remove') ----- removeMissingClasses "Remove any class names that are no longer in the Smalltalk dictionary. Used for cleaning up after garbage collecting user-generated classes." "SystemOrganization removeMissingClasses" elementArray copy do: [:el | + (self environment includesKey: el) ifFalse: [self removeElement: el]]. - (Smalltalk includesKey: el) ifFalse: [self removeElement: el]]. ! Item was changed: ----- Method: SystemOrganizer>>superclassOrder: (in category 'fileIn/Out') ----- superclassOrder: category "Answer an OrderedCollection containing references to the classes in the category whose name is the argument, category (a string). The classes are ordered with superclasses first so they can be filed in." | behaviors classes | behaviors := (self listAtCategoryNamed: category asSymbol) + collect: [:title | self environment at: title]. - collect: [:title | Smalltalk at: title]. classes := behaviors select: [:each | each isBehavior]. ^ChangeSet superclassOrder: classes!

1 0

The Trunk: Kernel-ct.1382.mcz
by commits＠source.squeak.org 26 Mar '21

26 Mar '21

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1382.mcz ==================== Summary ==================== Name: Kernel-ct.1382 Author: ct Time: 15 March 2021, 1:52:03.249869 pm UUID: e108423f-661f-4d4f-9ad8-c667c3995b32 Ancestors: Kernel-mt.1381 Proposal: Revises usage and handling of primitive 19, also known as the simulation guard. Don't use it in #newProcess and variants since they don't involve any actual control logic. Instead, also show a simulation warning when debugging a control primitive (primitiveSignal primitiveWait primitiveResume primitiveSuspend). Improves integration of simulation guard warnings by signaling a Warning on the simulator stack rather than spawning a debugger on the debugged process. This also makes it easier to handle these warnings in a non-interactive context. See http://forum.world.st/Simulation-guard-lt-primitive-19-gt-crashes-the-image… and http://forum.world.st/Please-try-out-Fixes-for-debugger-invocation-during-c… for more information. Reuploaded to resolve merge conflict with Kernel-mt.1381. Replaces Kernel-ct.1381, which can be moved into the treated inbox. =============== Diff against Kernel-mt.1381 =============== Item was changed: ----- Method: BlockClosure>>newProcess (in category 'scheduling') ----- newProcess + "Answer a Process running the code in the receiver. The process is not scheduled." - "Answer a Process running the code in the receiver. The process is not - scheduled." - <primitive: 19> "Simulation guard" ^Process forContext: [self value. + "Since control is now at the bottom, there is no need to terminate (which runs unwinds) since all unwinds have been run. Simply suspend. + Note that we must use this form rather than e.g. Processor suspendActive so that isTerminated answers true. isTerminated requires that if there is a suspended context it is the bottom-most, but using a send would result in the process's suspendedContext /not/ being the bottom-most." - "Since control is now at the bottom there is no need to terminate (which - runs unwinds) since all unwnds have been run. Simply suspend. - Note that we must use this form rather than e.g. Processor suspendActive - so that isTerminated answers true. isTerminated requires that if there is a - suspended context it is the bottom-most, but using a send would result in - the process's suspendedContext /not/ being the bottom-most." Processor activeProcess suspend] asContext priority: Processor activePriority! Item was changed: ----- Method: BlockClosure>>newProcessWith: (in category 'scheduling') ----- newProcessWith: anArray + "Answer a Process running the code in the receiver. The receiver's block arguments are bound to the contents of the argument, anArray. The process is not scheduled." - "Answer a Process running the code in the receiver. The receiver's block - arguments are bound to the contents of the argument, anArray. The - process is not scheduled." - <primitive: 19> "Simulation guard" ^Process forContext: [self valueWithArguments: anArray. + "Since control is now at the bottom, there is no need to terminate (which runs unwinds) since all unwinds have been run. Simply suspend. + Note that we must use this form rather than e.g. Processor suspendActive so that isTerminated answers true. isTerminated requires that if there is a suspended context it is the bottom-most, but using a send would result in the process's suspendedContext /not/ being the bottom-most." - "Since control is now at the bottom there is no need to terminate (which - runs unwinds) since all unwnds have been run. Simply suspend. - Note that we must use this form rather than e.g. Processor suspendActive - so that isTerminated answers true. isTerminated requires that if there is a - suspended context it is the bottom-most, but using a send would result in - the process's suspendedContext /not/ being the bottom-most." Processor activeProcess suspend] asContext priority: Processor activePriority! Item was changed: ----- Method: Context>>doPrimitive:method:receiver:args: (in category 'private') ----- doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away." | value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug interesting code, such as the debugger itself. Hence use primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" + (primitiveIndex = 19 or: [primitiveIndex >= 85 and: [primitiveIndex <= 88] "control primitives"]) ifTrue: [ - primitiveIndex = 19 ifTrue: [ [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})] ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]]. ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]]. primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [^self send: arguments first to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)]. "Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: + ["Transcript + cr; + nextPutAll: 'Processor activeProcess '; + nextPutAll: (Processor activeProcess == receiver owningProcess ifTrue: [#==] ifFalse: [#~~]); + nextPutAll: ' owner'; + flush." + value := primitiveIndex = 186 + ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: Processor activeProcess] + ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: Processor activeProcess]. - [| effective | - effective := Processor activeProcess effectiveProcess. - "active == effective" - value := primitiveIndex = 186 - ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] - ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]]. primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args]. ^Context sender: self receiver: thisReceiver method: methodArg arguments: args]. primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last]. value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]!

1 0

The Trunk: Kernel-mt.1383.mcz
by commits＠source.squeak.org 26 Mar '21

26 Mar '21

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-mt.1383.mcz ==================== Summary ==================== Name: Kernel-mt.1383 Author: mt Time: 26 March 2021, 12:51:18.904073 pm UUID: 524a87b1-28d6-f044-8a9a-4ca045211ac1 Ancestors: Kernel-ct.1382 Merges Kernel-ct.1382 =============== Diff against Kernel-mt.1381 =============== Item was changed: ----- Method: BlockClosure>>newProcess (in category 'scheduling') ----- newProcess + "Answer a Process running the code in the receiver. The process is not scheduled." - "Answer a Process running the code in the receiver. The process is not - scheduled." - <primitive: 19> "Simulation guard" ^Process forContext: [self value. + "Since control is now at the bottom, there is no need to terminate (which runs unwinds) since all unwinds have been run. Simply suspend. + Note that we must use this form rather than e.g. Processor suspendActive so that isTerminated answers true. isTerminated requires that if there is a suspended context it is the bottom-most, but using a send would result in the process's suspendedContext /not/ being the bottom-most." - "Since control is now at the bottom there is no need to terminate (which - runs unwinds) since all unwnds have been run. Simply suspend. - Note that we must use this form rather than e.g. Processor suspendActive - so that isTerminated answers true. isTerminated requires that if there is a - suspended context it is the bottom-most, but using a send would result in - the process's suspendedContext /not/ being the bottom-most." Processor activeProcess suspend] asContext priority: Processor activePriority! Item was changed: ----- Method: BlockClosure>>newProcessWith: (in category 'scheduling') ----- newProcessWith: anArray + "Answer a Process running the code in the receiver. The receiver's block arguments are bound to the contents of the argument, anArray. The process is not scheduled." - "Answer a Process running the code in the receiver. The receiver's block - arguments are bound to the contents of the argument, anArray. The - process is not scheduled." - <primitive: 19> "Simulation guard" ^Process forContext: [self valueWithArguments: anArray. + "Since control is now at the bottom, there is no need to terminate (which runs unwinds) since all unwinds have been run. Simply suspend. + Note that we must use this form rather than e.g. Processor suspendActive so that isTerminated answers true. isTerminated requires that if there is a suspended context it is the bottom-most, but using a send would result in the process's suspendedContext /not/ being the bottom-most." - "Since control is now at the bottom there is no need to terminate (which - runs unwinds) since all unwnds have been run. Simply suspend. - Note that we must use this form rather than e.g. Processor suspendActive - so that isTerminated answers true. isTerminated requires that if there is a - suspended context it is the bottom-most, but using a send would result in - the process's suspendedContext /not/ being the bottom-most." Processor activeProcess suspend] asContext priority: Processor activePriority! Item was changed: ----- Method: Context>>doPrimitive:method:receiver:args: (in category 'private') ----- doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away." | value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug interesting code, such as the debugger itself. Hence use primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" + (primitiveIndex = 19 or: [primitiveIndex >= 85 and: [primitiveIndex <= 88] "control primitives"]) ifTrue: [ - primitiveIndex = 19 ifTrue: [ [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})] ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]]. ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]]. primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [^self send: arguments first to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)]. "Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: + [value := primitiveIndex = 186 + ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: Processor activeProcess] + ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: Processor activeProcess]. - [| effective | - effective := Processor activeProcess effectiveProcess. - "active == effective" - value := primitiveIndex = 186 - ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] - ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]]. primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args]. ^Context sender: self receiver: thisReceiver method: methodArg arguments: args]. primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last]. value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]!

1 0

The Trunk: Tools-mt.1033.mcz
by commits＠source.squeak.org 26 Mar '21

26 Mar '21

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1033.mcz ==================== Summary ==================== Name: Tools-mt.1033 Author: mt Time: 26 March 2021, 12:38:18.607513 pm UUID: 04055581-eafa-8d43-a839-e487634ad4e1 Ancestors: Tools-tonyg.1032 Complements System-mt.1223. Adds hook to browse environments. =============== Diff against Tools-tonyg.1032 =============== Item was added: + ----- Method: Browser class>>fullOnEnvironment: (in category 'instance creation') ----- + fullOnEnvironment: anEnvironment + + ^ self new + selectEnvironment: anEnvironment; + buildAndOpenFullBrowser! Item was added: + ----- Method: Environment>>browse (in category '*Tools-Browsing') ----- + browse + + ^ ToolSet browseEnvironment: self! Item was added: + ----- Method: StandardToolSet class>>browseEnvironment: (in category 'browsing') ----- + browseEnvironment: anEnvironment + + ^ SystemBrowser default fullOnEnvironment: anEnvironment!

1 0

The Trunk: System-mt.1223.mcz
by commits＠source.squeak.org 26 Mar '21

26 Mar '21

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1223.mcz ==================== Summary ==================== Name: System-mt.1223 Author: mt Time: 26 March 2021, 12:36:58.297513 pm UUID: a5df7ebb-e1e7-304c-85e5-61d01132f0bd Ancestors: System-mt.1222 Adds hook to browse environments. =============== Diff against System-mt.1222 =============== Item was added: + ----- Method: ToolSet class>>browseEnvironment: (in category 'browsing') ----- + browseEnvironment: anEnvironment + + self default ifNil: [^ self inform: 'Cannot open Browser']. + ^ self default browseEnvironment: anEnvironment!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages March 2021