Packages February 2024

packages@lists.squeakfoundation.org

1 participants
58 discussions

The Trunk: Monticello-cmm.807.mcz
by commits＠source.squeak.org 19 Feb '24

19 Feb '24

Chris Muller uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-cmm.807.mcz ==================== Summary ==================== Name: Monticello-cmm.807 Author: cmm Time: 19 February 2024, 1:00:29.476937 am UUID: ea4dc7e6-5232-4e81-88f5-796f49140bf7 Ancestors: Monticello-eem.806 Fixed the confirmation message associated with the 'copy image versions here' function on the Repository menu. =============== Diff against Monticello-eem.806 =============== Item was changed: ----- Method: MCRepository>>copyImageVersions (in category 'versions') ----- copyImageVersions "For each package contained in the receiver, copy the version of that package which is currently loaded in this image. If no version of a package is loaded in the image, nothing is copied for that package." MCRepository trunk = self ifTrue: [^ self error: 'Must not copy over to Trunk repository' translated]. MCRepository inbox = self ifTrue: [^ self error: 'Must not copy over to Inbox repository' translated]. MCRepository treated = self ifTrue: [^ self error: 'Must not copy over to Treated repository' translated]. self cacheAllFileNamesDuring: + [ self newerImageVersions do: [ : each | self storeVersion: each ] ]! - [ self allPackageNames do: - [ : eachPkgName | MCWorkingCopy allManagers - detect: [ : each | each packageName = eachPkgName ] - ifFound: - [ : loaded | loaded ancestors do: - [ : infoToCopy | (self includesVersionNamed: infoToCopy versionName) ifFalse: - [ (MCRepositoryGroup default versionWithInfo: infoToCopy) - ifNil: [ Warning signal: infoToCopy name , ' not found in RepositoryGroup default.' ] - ifNotNil: - [ : ver | self storeVersion: ver ] ] ] ] - ifNone: [ "Image specifies no version to copy." ] ] ]! Item was added: + ----- Method: MCRepository>>newerImageVersions (in category 'private') ----- + newerImageVersions + ^ Array streamContents: + [ : stream | self allPackageNames do: + [ : eachPkgName | MCWorkingCopy allManagers + detect: [ : each | each packageName = eachPkgName ] + ifFound: + [ : loaded | loaded ancestors do: + [ : infoToCopy | (self includesVersionNamed: infoToCopy versionName) ifFalse: + [ (MCRepositoryGroup default versionWithInfo: infoToCopy) + ifNil: [ Warning signal: infoToCopy name , ' not found in RepositoryGroup default.' ] + ifNotNil: + [ : ver | stream nextPut: ver ] ] ] ] + ifNone: [ "Image specifies no version to copy." ] ] ]! Item was changed: ----- Method: MCWorkingCopyBrowser>>copyImageVersionsSafely (in category 'actions') ----- copyImageVersionsSafely + self repository newerImageVersions + ifEmpty: [ Project current uiManager inform: 'Repository up to date.' ] + ifNotEmpty: + [ : imageVersions | | msg | + msg := String streamContents: + [ : stream | imageVersions do: + [ : each | stream cr ; + nextPutAll: each info name ; nextPut: $,]. + stream cr ; + cr ; + nextPutAll: ' will be copied to {1}?' ]. + (Project current uiManager + confirm: (msg translated format: {self repository description}) asTextFromHtml + title: 'Copy Versions' translated) ifFalse: [ ^ self ]. + self copyImageVersions ]! - (Project uiManager confirm: ('Do you really want to copy the loaded version of each of {1} packages to {2}?' translated asTextFromHtml format: {MCWorkingCopy allManagers size. self repository description}) title: 'Copy Image Versions' translated) ifFalse: [^ self]. - self copyImageVersions.!

1 0

The Trunk: System-cmm.1447.mcz
by commits＠source.squeak.org 19 Feb '24

19 Feb '24

Chris Muller uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-cmm.1447.mcz ==================== Summary ==================== Name: System-cmm.1447 Author: cmm Time: 12 February 2024, 3:06:16.671515 pm UUID: 03b7d234-da01-4b78-94c0-f78c01d4afe0 Ancestors: System-codefrau.1446 FileStream's stdout and stderr are for Linux, so use Linux line-endings when writing to them. =============== Diff against System-codefrau.1446 =============== Item was changed: ----- Method: CodeLoader>>installSourceFile: (in category 'installing') ----- installSourceFile: aStream "Install the previously loaded source file" | contents trusted | aStream ifNil:[^self error:'No content to install']. trusted := SecurityManager default positionToSecureContentsOf: aStream. trusted ifFalse:[(SecurityManager default enterRestrictedMode) ifFalse:[ aStream close. ^ self error:'Insecure content encountered']]. contents := self allButShebangLine: aStream upToEnd unzipped asString. (aStream respondsTo: #close) ifTrue:[aStream close]. ^[contents readStream fileIn] on: SyntaxErrorNotification do: [ : err | Smalltalk isHeadless ifTrue: + [FileStream stdout nextPutAll: err errorCode; lf; flush. - [FileStream stdout nextPutAll: err errorCode; cr; flush. Smalltalk snapshot: false andQuit: true ] ifFalse: [err pass] ]! Item was changed: ----- Method: Exception>>printVerboseOn: (in category '*system') ----- printVerboseOn: aStream aStream nextPutAll: 'vvvvvvvvvvvvvvvvvv ' , self description , ' vvvvvvvvvvvvvvvvvv' ; + lf ; - cr ; nextPutAll: 'The time is ', DateAndTime now asString ; + lf. - cr. "Allow applications to optionally print extra details without overriding a base package." self printDetailsOn: aStream. aStream nextPutAll: self signalerContext longStack ; + lf ; - cr ; nextPutAll: '^^^^^^^^^^^^^^^^^^ ' , self description , ' ^^^^^^^^^^^^^^^^^^' ; + lf ; - cr ; flush! Item was changed: ----- Method: SmalltalkImage>>run: (in category 'command line') ----- run: aBlock [ [ self patchSystem. (aBlock numArgs = 1 and: [ self arguments size > 1 ]) ifTrue: [ "Allow a large, variable number of arguments to be passed as an Array to aBlock." aBlock value: self arguments ] ifFalse: [ aBlock valueWithEnoughArguments: self arguments ] ] on: SyntaxErrorNotification do: [ : err | FileStream stdout nextPutAll: err errorCode ; + lf; flush. - cr; flush. self isHeadless ifTrue: [ self snapshot: false andQuit: true ] ifFalse: [ err pass ] ] on: Error , ProvideAnswerNotification do: [ : err | err printVerboseOn: FileStream stderr. FileStream stderr flush. self isHeadless ifTrue: [ self snapshot: false andQuit: true ] ifFalse: [ err pass ] ] on: ProgressInitiationException do: [ : pie | "Don't want to log this Notification." pie defaultAction ] ] on: Notification , Warning do: [ : noti | FileStream stdout nextPutAll: DateAndTime now asString ; space ; nextPutAll: noti description ; + lf. - cr. noti resume ] !

1 0

The Trunk: JSON-cmm.61.mcz
by commits＠source.squeak.org 19 Feb '24

19 Feb '24

Chris Muller uploaded a new version of JSON to project The Trunk: http://source.squeak.org/trunk/JSON-cmm.61.mcz ==================== Summary ==================== Name: JSON-cmm.61 Author: cmm Time: 18 February 2024, 6:01:50.22946 pm UUID: 9f100ce1-3d3c-4ea2-b975-4821175b41ba Ancestors: JSON-ct.58 Path access and enumeration for JSON objects. =============== Diff against JSON-ct.58 =============== Item was added: + ----- Method: Collection>>atPath: (in category '*json') ----- + atPath: anArray + "Assume I'm a set of nested HashedCollections and/or SequenceableCollections. Answer the object at the path of indices and/or keys identified in anArray." + ^ self + atPath: anArray + ifLost: [ : last | self error: 'path lost after' , last asString ]! Item was added: + ----- Method: Collection>>atPath:ifLost: (in category '*json') ----- + atPath: anArray ifLost: aBlock + "Assume I'm a set of nested HashedCollections and/or SequenceableCollections. Answer the object at the path of indices and/or keys identified in anArray. If the full path specified by anArray isn't present, cull aBlock with the last element present along the path." + | last | + ^ (self + path: anArray + do: [ : elem : node | last := node ]) + ifNil: [ aBlock cull: last ] + ifNotNil: [ last ]! Item was added: + ----- Method: Collection>>path:do: (in category '*json') ----- + path: anArray do: aBlock + "Assume I'm a set of nested HashedCollections and/or SequenceableCollections. Value aBlock with each object along the path of indices and/or keys identified in anArray. If a path element isn't found, stop, and return nil, otherwise, return self." + anArray + inject: self + into: + [ : dictOrArray : pathElem | dictOrArray + at: pathElem + ifPresent: [ : node | aBlock value: pathElem value: node ] + ifAbsent: [ ^ nil ] ]. + ^ self!

1 0

The Trunk: CollectionsTests-cmm.405.mcz
by commits＠source.squeak.org 19 Feb '24

19 Feb '24

Chris Muller uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-cmm.405.mcz ==================== Summary ==================== Name: CollectionsTests-cmm.405 Author: cmm Time: 18 February 2024, 5:22:35.213846 pm UUID: fa6e9709-7f5a-4781-b197-45bd9a9e1414 Ancestors: CollectionsTests-cmm.404 Include, in #testPeeks, the cases where the argument overshoots the bounds of the underlying stream, in either direction. =============== Diff against CollectionsTests-cmm.404 =============== Item was changed: ----- Method: ReadStreamTest>>testPeeks (in category 'tests - accessing') ----- testPeeks | stream | stream := self streamOnArray. self assert: (stream peek: 0) = #(). self assert: (stream peek: 1) = #(1). self assert: (stream peek: 3) = #(1 (a b c) false). self assert: (stream peek: 4) = #(1 (a b c) false). stream next. self assert: (stream peek: -1) = #(1). + self assert: (stream peek: -99) = #(1). self assert: (stream peek: 0) = #(). self assert: (stream peek: 1) = #((a b c)). + self assert: (stream peek: 3) = #((a b c) false). + self assert: (stream peek: 99) = #((a b c) false)! - self assert: (stream peek: 3) = #((a b c) false).!

1 0

The Trunk: Collections-cmm.1059.mcz
by commits＠source.squeak.org 19 Feb '24

19 Feb '24

Chris Muller uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-cmm.1059.mcz ==================== Summary ==================== Name: Collections-cmm.1059 Author: cmm Time: 18 February 2024, 5:19:05.159381 pm UUID: 982eb6aa-f237-4e79-a208-ae6b2f23cf1b Ancestors: Collections-mt.1058 - Let #peek: support a negative number of characters to peekBack:. - Let SharedQueue2 support #atEnd. =============== Diff against Collections-mt.1058 =============== Item was changed: ----- Method: PositionableStream>>peek: (in category 'accessing') ----- + peek: anInteger + ^ anInteger positive + ifTrue: [ self peekForward: anInteger ] + ifFalse: [ self peekBack: anInteger abs ]! - peek: anInteger - "Answer what would be returned if the message next: anInteger were sent to the receiver. If the receiver has less than anInteger more elements, only answer so many elements as available." - - | oldPosition result | - oldPosition := position. - result := self next: anInteger. - position := oldPosition. - ^ result! Item was added: + ----- Method: PositionableStream>>peekBack: (in category 'accessing') ----- + peekBack: anInteger + "Answer anInteger characters previous to the current position, or all to the beginning, whichever is fewer." + ^ anInteger negative + ifTrue: [ self peek: anInteger negated ] + ifFalse: + [ | toSkip | toSkip := anInteger min: self position. + self + skip: toSkip negated ; + next: toSkip ]! Item was added: + ----- Method: PositionableStream>>peekForward: (in category 'accessing') ----- + peekForward: anInteger + "Answer what would be returned if the message next: anInteger were sent to the receiver. If the receiver is at the end, answer an empty string." + | priorPos result | + priorPos := position. + result := self next: anInteger. + position := priorPos. + ^ result! Item was added: + ----- Method: SharedQueue2>>atEnd (in category 'testing') ----- + atEnd + ^ monitor critical: [ items isEmpty ]!

1 0

The Trunk: CollectionsTests-cmm.404.mcz
by commits＠source.squeak.org 19 Feb '24

19 Feb '24

Chris Muller uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-cmm.404.mcz ==================== Summary ==================== Name: CollectionsTests-cmm.404 Author: cmm Time: 18 February 2024, 5:18:33.048788 pm UUID: 1a56870d-c708-4750-bf4b-165435161a68 Ancestors: CollectionsTests-mt.403 Test #peek: with a negative argument. =============== Diff against CollectionsTests-mt.403 =============== Item was changed: ----- Method: ReadStreamTest>>testPeeks (in category 'tests - accessing') ----- testPeeks | stream | stream := self streamOnArray. self assert: (stream peek: 0) = #(). self assert: (stream peek: 1) = #(1). self assert: (stream peek: 3) = #(1 (a b c) false). self assert: (stream peek: 4) = #(1 (a b c) false). stream next. + + self assert: (stream peek: -1) = #(1). - self assert: (stream peek: 0) = #(). self assert: (stream peek: 1) = #((a b c)). self assert: (stream peek: 3) = #((a b c) false).!

1 0

The Treated Inbox: System-jar.1367.mcz
by commits＠source.squeak.org 18 Feb '24

18 Feb '24

David T. Lewis uploaded a new version of System to project The Treated Inbox: http://source.squeak.org/treated/System-jar.1367.mcz ==================== Summary ==================== Name: System-jar.1367 Author: jar Time: 11 July 2022, 1:21:36.615972 pm UUID: 403676fc-9569-c542-ae88-f17030bb70c5 Ancestors: System-mt.1366 protect LowSpaceWatcher against concurrent invocations Currently #installLowSpaceWatcher runs unprotected against multiple concurrent invocations; try to run this example in the Workspace: p1 := [Smalltalk installLowSpaceWatcher] fork. p2 := [Smalltalk installLowSpaceWatcher] fork Expected behavior is that the LowSpaceWatcher gets reinstalled twice in a row; what's happening now is both invocations will run concurrently, both will block in terminate and then install two LowSpaceWatchers (actually, at the moment there's a little bug in terminate so the concurrent invocations will end up with one process stuck at a semaphore but that's about to be fixed soon) Alternatively, this could be fixed by running #installLowSpaceWatcher's code as a critical section but that would mean a new class variable which may not be entirely justifiable - but let me know if #critical would be preferable. =============== Diff against System-mt.1366 =============== Item was changed: ----- Method: SmalltalkImage>>installLowSpaceWatcher (in category 'memory space') ----- installLowSpaceWatcher "Start a process to watch for low-space conditions." "Smalltalk installLowSpaceWatcher" + + "Run with the highest priority to avoid concurrency issues. + Workspce example: + p1 := [Smalltalk installLowSpaceWatcher] fork. + p2 := [Smalltalk installLowSpaceWatcher] fork + Here both proceses are scheduled in the run queue, then p1 wakes up, starts the LowSpaceProcess + termination and waits on a semaphore until the termination is finished. Before the LowSpaceProcess + can proceed, process p2 wakes up and starts the LowSpaceProcess termination just like p1 and waits + on a semaphore until the termination is finished. Finally the LowSpaceProcess wakes up, unwinds, + unblocks p1 a p2 and terminates. p1 now continues and installs a new LowSpaceProcess and then + p2 does the same. The result will be two processes running the #lowSpaceWatcher method. + Please note this describes the behavior in Squeak 6 using direct process termination; see #terminate." + [ + self primSignalAtBytesLeft: 0. "disable low-space interrupts" + LowSpaceProcess == nil ifFalse: [LowSpaceProcess terminate]. + LowSpaceProcess := [self lowSpaceWatcher] newProcess. + LowSpaceProcess priority: Processor lowIOPriority. + LowSpaceProcess resume + ] valueUnpreemptively! - self primSignalAtBytesLeft: 0. "disable low-space interrupts" - LowSpaceProcess == nil ifFalse: [LowSpaceProcess terminate]. - LowSpaceProcess := [self lowSpaceWatcher] newProcess. - LowSpaceProcess priority: Processor lowIOPriority. - LowSpaceProcess resume. - - !

1 0

The Treated Inbox: System-dtl.1446.mcz
by commits＠source.squeak.org 18 Feb '24

18 Feb '24

David T. Lewis uploaded a new version of System to project The Treated Inbox: http://source.squeak.org/treated/System-dtl.1446.mcz ==================== Summary ==================== Name: System-dtl.1446 Author: dtl Time: 30 January 2024, 4:35:00.140218 pm UUID: cede9a72-39dd-4d82-91ba-9e60fe24a06a Ancestors: System-dtl.1445 Split lowSpaceWatcher into smaller methods with comments to explain each step in the low space handling process. HelpBrowser openOn: LowSpaceWatcher. =============== Diff against System-dtl.1445 =============== Item was added: + ----- Method: LowSpaceWatcher>>disableVirtualMachineNotifications (in category 'process steps') ----- + disableVirtualMachineNotifications + "Ask the virtual machine to stop sending low space interrupts, and forget the current semaphore and watcher process." + + self primSignalAtBytesLeft: 0. "disable low space interrupts" + self primLowSpaceSemaphore: nil. + lowSpaceProcess := nil. + ! Item was added: + ----- Method: LowSpaceWatcher>>findPreemptedProcess (in category 'process steps') ----- + findPreemptedProcess + "Find the process that was active at the time of the low space interrupt. Check + first if the virtual machine has recorded the process that was active at the time + that it detected the low space detection, otherwise answer the process that was + most recently preempted when the semaphore was signalled." + + | preemptedProcess | + preemptedProcess := (Smalltalk specialObjectsArray at: 23) + ifNil: [Processor preemptedProcess "if in-image signal of OutOfMemory"]. + Smalltalk specialObjectsArray at: 23 put: nil. + ^ preemptedProcess + + ! Item was added: + ----- Method: LowSpaceWatcher>>handleLowSpaceCondition (in category 'process steps') ----- + handleLowSpaceCondition + "A low space condition has been detected. Do whatever may be necessary to free + some memory in the image before proceeding." + + | preemptedProcess | + preemptedProcess := self findPreemptedProcess. + self notifyMemoryHogs ifFalse: [ + self logError: preemptedProcess. + self notifyUser: preemptedProcess ]. + + ! Item was added: + ----- Method: LowSpaceWatcher>>initializeVirtualMachineNotifications (in category 'process steps') ----- + initializeVirtualMachineNotifications + "Let the virtual machine know how to notify the image of low space conditions." + + Smalltalk specialObjectsArray at: 23 put: nil. "process causing low space will be saved here" + lowSpaceSemaphore := Semaphore new. + self primLowSpaceSemaphore: lowSpaceSemaphore. + self primSignalAtBytesLeft: Smalltalk lowSpaceThreshold. "enable low space interrupts" + ! Item was added: + ----- Method: LowSpaceWatcher>>logError: (in category 'process steps') ----- + logError: preemptedProcess + + Preferences logDebuggerStackToFile ifTrue: [ + Smalltalk + logError: 'Space is low' + inContext: preemptedProcess suspendedContext + to: 'LowSpaceDebug.log' ]. + ! Item was changed: ----- Method: LowSpaceWatcher>>lowSpaceWatcher (in category 'process') ----- lowSpaceWatcher + "Wait until the low space semaphore is signalled, then take appropriate actions. This + method is run once in the low space watcher process. Before terminating, it schedules + a new process to handle the next low space condition." - "Wait until the low space semaphore is signalled, then take appropriate actions." + self safeToInstall ifFalse: [ ^ Beeper beep]. + self initializeVirtualMachineNotifications. + lowSpaceSemaphore wait. + self disableVirtualMachineNotifications; handleLowSpaceCondition. + self start. "schedule a new process to handle the next low space condition" - | free preemptedProcess | - Smalltalk garbageCollectMost <= Smalltalk lowSpaceThreshold - ifTrue: [self garbageCollect <= Smalltalk lowSpaceThreshold - ifTrue: ["free space must be above threshold before - starting low space watcher" - ^ Beeper beep]]. - Smalltalk specialObjectsArray at: 23 put: nil. "process causing low space will be saved here" - lowSpaceSemaphore := Semaphore new. - self primLowSpaceSemaphore: lowSpaceSemaphore. - self primSignalAtBytesLeft: Smalltalk lowSpaceThreshold. "enable low space interrupts" - - lowSpaceSemaphore wait. "wait for a low space condition..." - - self primSignalAtBytesLeft: 0. "disable low space interrupts" - self primLowSpaceSemaphore: nil. - lowSpaceProcess := nil. - - "The process that was active at the time of the low space interrupt." - preemptedProcess := (Smalltalk specialObjectsArray at: 23) - ifNil: [Processor preemptedProcess "if in-image signal of OutOfMemory"]. - Smalltalk specialObjectsArray at: 23 put: nil. - - "Note: user now unprotected until the low space watcher is re-installed" - - self memoryHogs isEmpty - ifFalse: [free := Smalltalk bytesLeft. - self memoryHogs - do: [ :hog | hog freeSomeSpace ]. - self bytesLeft > free - ifTrue: [ ^ LowSpaceWatcher installLowSpaceWatcher ]]. - - Preferences logDebuggerStackToFile ifTrue: [ - self - logError: 'Space is low' - inContext: preemptedProcess suspendedContext - to: 'LowSpaceDebug.log']. - - Project current - interruptName: 'Space is low' - message: self lowSpaceChoices - preemptedProcess: preemptedProcess ! Item was added: + ----- Method: LowSpaceWatcher>>notifyMemoryHogs (in category 'process steps') ----- + notifyMemoryHogs + "Try to clean up memory hogs. Answer true if sufficient memory was released." + + | free | + self memoryHogs isEmpty + ifTrue: [ ^ false ] + ifFalse: [ free := Smalltalk bytesLeft. + self memoryHogs + do: [ :hog | hog freeSomeSpace ]. + ^ Smalltalk bytesLeft > free ] + + ! Item was added: + ----- Method: LowSpaceWatcher>>notifyUser: (in category 'process steps') ----- + notifyUser: preemptedProcess + "Interrupt the user to allow the low space condition to be corrected. The user + is now unprotected until the low space watcher is re-installed." + + Project current + interruptName: 'Space is low' + message: self lowSpaceChoices + preemptedProcess: preemptedProcess. + ! Item was added: + ----- Method: LowSpaceWatcher>>safeToInstall (in category 'process steps') ----- + safeToInstall + "Free space must be above threshold before starting low space watcher" + + Smalltalk garbageCollectMost > Smalltalk lowSpaceThreshold + ifFalse: [ ^ Smalltalk garbageCollect > Smalltalk lowSpaceThreshold ]. + ^ true + ! Item was changed: ----- Method: LowSpaceWatcher>>start (in category 'initialize-release') ----- start "Start a new low space watcher process that will register a semaphore with the virtual machine and wait for the semaphore to be signalled if a low space condition is detected." + lowSpaceProcess := [self lowSpaceWatcher] forkAt: Processor lowIOPriority. - lowSpaceProcess := [self lowSpaceWatcher] newProcess. - lowSpaceProcess priority: Processor lowIOPriority. - lowSpaceProcess resume. !

1 0

The Treated Inbox: System-jar.1446.mcz
by commits＠source.squeak.org 18 Feb '24

18 Feb '24

David T. Lewis uploaded a new version of System to project The Treated Inbox: http://source.squeak.org/treated/System-jar.1446.mcz ==================== Summary ==================== Name: System-jar.1446 Author: jar Time: 29 January 2024, 1:41:28.399781 pm UUID: fafea975-15ff-a94d-8bfc-a3c9feb44c78 Ancestors: System-dtl.1445 For discussion: A small modification of System-dtl.1445 to address the possibilty of two low space watcher processes running simultaneously if you run this example: [LowSpaceWatcher install] fork. [LowSpaceWatcher install] fork It's a contrived example but a real situation of this kind happened to me during my work on #terminate and confused me a great deal. In the current image the situation most likely can't happen by itself. If the low space watches is supposed to be a singleton then, for the sake of consistency, I'd vote for making sure the low space watcher can't start two processes concurrently. =============== Diff against System-dtl.1445 =============== Item was changed: Object subclass: #LowSpaceWatcher + instanceVariableNames: 'lowSpaceProcess lowSpaceSemaphore lowSpaceAccessProtect' - instanceVariableNames: 'lowSpaceProcess lowSpaceSemaphore' classVariableNames: 'Default MemoryHogs' poolDictionaries: '' category: 'System-Support'! !LowSpaceWatcher commentStamp: 'dtl 1/28/2024 17:56' prior: 0! LowSpaceWatcher is responsible for responding to a notification from the virtual machine that memory is low and that it (the VM) may soon be unable to support additional object memory allocations. A single default instance for the image manages both the low space semaphore and the process that waits on the semaphore to handle low space conditions. When the low space watcher is notified that memory is low, it attempts to identify the process likely associated with the low space condition and to provide a notifier to allow the problem condition to be corrected. If a low space condition is detected in the virtual machine, the low space semaphore is signalled either directly by the VM or indirectly through an OutOfMemory error following a failed primitive invocation. The VM is responsible for identifying low space conditions, and its behavior will vary depending on both the VM implementation and the memory system of the underlying platform operating system. In particular, on a virtual machine operating system the VM may continue to receive memory allocations from the operating system while the operating system attempts to support the memory requests by increased swapping to disk. Under these conditions, the low space semaphore may not be signalled because system memory still appears to be available, even though performance is severely degraded due to swapping. The VM may provide control of its memory usage, typically through command line parameters or VM parameters that can be set from the image. These parameters will affect when and if the low space watcher is signalled by the VM. A registry is maintained in class variable MemoryHogs to identify objects (classes) know how to release unneeded memory when sent the message #freeSomeSpace. The low space watcher process will send this message when a low spaced condition is encountered. To signal the low space watcher and simulate a low space condition, evaluate "LowSpaceWatcher default signalLowSpace".! Item was changed: ----- Method: LowSpaceWatcher class>>install (in category 'instance creation') ----- install "Start a process to watch for low-space conditions." "Smalltalk installLowSpaceWatcher" + self default lowSpaceAccessProtect critical: [self default stop; start] ifLocked: [] - self default stop; start - ! Item was added: + ----- Method: LowSpaceWatcher>>lowSpaceAccessProtect (in category 'process') ----- + lowSpaceAccessProtect + + ^lowSpaceAccessProtect ifNil: [lowSpaceAccessProtect := Mutex new]!

1 0

The Treated Inbox: System-dtl.1445.mcz
by commits＠source.squeak.org 18 Feb '24

18 Feb '24

David T. Lewis uploaded a new version of System to project The Treated Inbox: http://source.squeak.org/treated/System-dtl.1445.mcz ==================== Summary ==================== Name: System-dtl.1445 Author: dtl Time: 28 January 2024, 8:13:53.851653 pm UUID: 8b191722-da0b-442e-ae5d-3e23a344e720 Ancestors: System-ct.1444 Add class LowSpaceWatcher and move the low space watcher from SmalltalkImage to LowSpaceWatcher. Let the low space watcher be a singleton with responsibility for the low space semaphore and low space watcher process. Add class and method comments to document intended behavior. Improve documentation of the low space watcher mechanism: HelpBrowser openOn: LowSpaceWatcher Also add #registerCleaner for adding savvy memory hogs to the memory hog registry. =============== Diff against System-ct.1444 =============== Item was added: + Object subclass: #LowSpaceWatcher + instanceVariableNames: 'lowSpaceProcess lowSpaceSemaphore' + classVariableNames: 'Default MemoryHogs' + poolDictionaries: '' + category: 'System-Support'! + + !LowSpaceWatcher commentStamp: 'dtl 1/28/2024 17:56' prior: 0! + LowSpaceWatcher is responsible for responding to a notification from the virtual machine that memory is low and that it (the VM) may soon be unable to support additional object memory allocations. A single default instance for the image manages both the low space semaphore and the process that waits on the semaphore to handle low space conditions. When the low space watcher is notified that memory is low, it attempts to identify the process likely associated with the low space condition and to provide a notifier to allow the problem condition to be corrected. + + If a low space condition is detected in the virtual machine, the low space semaphore is signalled either directly by the VM or indirectly through an OutOfMemory error following a failed primitive invocation. The VM is responsible for identifying low space conditions, and its behavior will vary depending on both the VM implementation and the memory system of the underlying platform operating system. In particular, on a virtual machine operating system the VM may continue to receive memory allocations from the operating system while the operating system attempts to support the memory requests by increased swapping to disk. Under these conditions, the low space semaphore may not be signalled because system memory still appears to be available, even though performance is severely degraded due to swapping. + + The VM may provide control of its memory usage, typically through command line parameters or VM parameters that can be set from the image. These parameters will affect when and if the low space watcher is signalled by the VM. + + A registry is maintained in class variable MemoryHogs to identify objects (classes) know how to release unneeded memory when sent the message #freeSomeSpace. The low space watcher process will send this message when a low spaced condition is encountered. + + To signal the low space watcher and simulate a low space condition, evaluate "LowSpaceWatcher default signalLowSpace".! Item was added: + ----- Method: LowSpaceWatcher class>>default (in category 'instance creation') ----- + default + "The singleton low space watcher." + + ^ Default ifNil: [ Default := self new start ] + ! Item was added: + ----- Method: LowSpaceWatcher class>>install (in category 'instance creation') ----- + install + "Start a process to watch for low-space conditions." + "Smalltalk installLowSpaceWatcher" + + self default stop; start + + ! Item was added: + ----- Method: LowSpaceWatcher class>>registerCleaner: (in category 'memory hog registry') ----- + registerCleaner: memoryCleaner + "Add memoryCleaner to the MemoryHog list where memoryCleaner is an object or class that responds to #freeSomeSpace." + + (memoryCleaner respondsTo: #freeSomeSpace) + ifFalse: [ ^ self error: memoryCleaner asString, ' does not understand #freeSomeSpace' ]. + (self default memoryHogs includes: memoryCleaner) + ifFalse: [ MemoryHogs add: memoryCleaner ].! Item was added: + ----- Method: LowSpaceWatcher class>>signalLowSpace (in category 'signal low space') ----- + signalLowSpace + "Signal the low-space semaphore to alert the user that space is running low." + + ^ self default signalLowSpace.! Item was added: + ----- Method: LowSpaceWatcher>>lowSpaceChoices (in category 'memory space') ----- + lowSpaceChoices + "Return a notifier message string to be presented when space is running low." + + ^ 'Warning!! Squeak is almost out of memory!! + + Low space detection is now disabled. It will be restored when you close or proceed from this error notifier. Don''t panic, but do proceed with caution. + + Here are some suggestions: + + If you suspect an infinite recursion (the same methods calling each other again and again), then close this debugger, and fix the problem. + + If you want this computation to finish, then make more space available (read on) and choose "proceed" in this debugger. Here are some ways to make more space available... + > Close any windows that are not needed. + > Get rid of some large objects (e.g., images). + > Leave this window on the screen, choose "save as..." from the screen menu, quit, restart the Squeak VM with a larger memory allocation, then restart the image you just saved, and choose "proceed" in this window. + + If you want to investigate further, choose "debug" in this window. Do not use the debugger "fullStack" command unless you are certain that the stack is not very deep. (Trying to show the full stack will definitely use up all remaining memory if the low-space problem is caused by an infinite recursion!!). + + ' + ! Item was added: + ----- Method: LowSpaceWatcher>>lowSpaceWatcher (in category 'process') ----- + lowSpaceWatcher + "Wait until the low space semaphore is signalled, then take appropriate actions." + + | free preemptedProcess | + Smalltalk garbageCollectMost <= Smalltalk lowSpaceThreshold + ifTrue: [self garbageCollect <= Smalltalk lowSpaceThreshold + ifTrue: ["free space must be above threshold before + starting low space watcher" + ^ Beeper beep]]. + + Smalltalk specialObjectsArray at: 23 put: nil. "process causing low space will be saved here" + lowSpaceSemaphore := Semaphore new. + self primLowSpaceSemaphore: lowSpaceSemaphore. + self primSignalAtBytesLeft: Smalltalk lowSpaceThreshold. "enable low space interrupts" + + lowSpaceSemaphore wait. "wait for a low space condition..." + + self primSignalAtBytesLeft: 0. "disable low space interrupts" + self primLowSpaceSemaphore: nil. + lowSpaceProcess := nil. + + "The process that was active at the time of the low space interrupt." + preemptedProcess := (Smalltalk specialObjectsArray at: 23) + ifNil: [Processor preemptedProcess "if in-image signal of OutOfMemory"]. + Smalltalk specialObjectsArray at: 23 put: nil. + + "Note: user now unprotected until the low space watcher is re-installed" + + self memoryHogs isEmpty + ifFalse: [free := Smalltalk bytesLeft. + self memoryHogs + do: [ :hog | hog freeSomeSpace ]. + self bytesLeft > free + ifTrue: [ ^ LowSpaceWatcher installLowSpaceWatcher ]]. + + Preferences logDebuggerStackToFile ifTrue: [ + self + logError: 'Space is low' + inContext: preemptedProcess suspendedContext + to: 'LowSpaceDebug.log']. + + Project current + interruptName: 'Space is low' + message: self lowSpaceChoices + preemptedProcess: preemptedProcess + ! Item was added: + ----- Method: LowSpaceWatcher>>lowSpaceWatcherProcess (in category 'process') ----- + lowSpaceWatcherProcess + "Answer the process in which lowSpaceWatcher is running. A process browser + can use this to identify and label the system wide low space watcher process." + ^lowSpaceProcess! Item was added: + ----- Method: LowSpaceWatcher>>memoryHogs (in category 'memory space') ----- + memoryHogs + "Answer the list of objects to notify with #freeSomeSpace if memory gets full." + + ^ MemoryHogs ifNil: [MemoryHogs := OrderedCollection new]! Item was added: + ----- Method: LowSpaceWatcher>>primLowSpaceSemaphore: (in category 'primitive access') ----- + primLowSpaceSemaphore: aSemaphore + "Primitive. Register the given Semaphore to be signalled when the + number of free bytes drops below some threshold. Disable low-space + interrupts if the argument is nil." + + <primitive: 124> + self primitiveFailed! Item was added: + ----- Method: LowSpaceWatcher>>primSignalAtBytesLeft: (in category 'primitive access') ----- + primSignalAtBytesLeft: numBytes + "Tell the interpreter the low-space threshold in bytes. When the free + space falls below this threshold, the interpreter will signal the low-space + semaphore, if one has been registered. Disable low-space interrupts if the + argument is zero. Fail if numBytes is not an Integer." + + <primitive: 125> + self primitiveFailed! Item was added: + ----- Method: LowSpaceWatcher>>signalLowSpace (in category 'memory space') ----- + signalLowSpace + "Signal the low-space semaphore to alert the user that space is running low." + + lowSpaceSemaphore signal.! Item was added: + ----- Method: LowSpaceWatcher>>start (in category 'initialize-release') ----- + start + "Start a new low space watcher process that will register a semaphore with the + virtual machine and wait for the semaphore to be signalled if a low space condition + is detected." + + lowSpaceProcess := [self lowSpaceWatcher] newProcess. + lowSpaceProcess priority: Processor lowIOPriority. + lowSpaceProcess resume. + ! Item was added: + ----- Method: LowSpaceWatcher>>stop (in category 'initialize-release') ----- + stop. + "Ask the virtual machine to disable low space interrupts, then terminate the watcher process." + + self primSignalAtBytesLeft: 0. "disable low-space interrupts" + lowSpaceProcess == nil ifFalse: [lowSpaceProcess terminate]. + lowSpaceProcess := lowSpaceSemaphore := nil. + ! Item was changed: Object subclass: #SmalltalkImage instanceVariableNames: 'globals' + classVariableNames: 'EndianCache LastImageName LastQuitLogPosition LastStats PlatformNameCache ShutDownList SourceFileVersionString StartUpList StartupStamp VMMakerVersion WordSize' - classVariableNames: 'EndianCache LastImageName LastQuitLogPosition LastStats LowSpaceProcess LowSpaceSemaphore MemoryHogs PlatformNameCache ShutDownList SourceFileVersionString StartUpList StartupStamp VMMakerVersion WordSize' poolDictionaries: '' category: 'System-Support'! !SmalltalkImage commentStamp: 'dtl 3/6/2010 14:00' prior: 0! I represent the current image and runtime environment, including system organization, the virtual machine, object memory, plugins and source files. My instance variable #globals is a reference to the system dictionary of global variables and class names. My singleton instance is called Smalltalk.! Item was changed: ----- Method: SmalltalkImage>>installLowSpaceWatcher (in category 'memory space') ----- installLowSpaceWatcher "Start a process to watch for low-space conditions." "Smalltalk installLowSpaceWatcher" + LowSpaceWatcher install - self primSignalAtBytesLeft: 0. "disable low-space interrupts" - LowSpaceProcess == nil ifFalse: [LowSpaceProcess terminate]. - LowSpaceProcess := [self lowSpaceWatcher] newProcess. - LowSpaceProcess priority: Processor lowIOPriority. - LowSpaceProcess resume. ! Item was removed: - ----- Method: SmalltalkImage>>lowSpaceChoices (in category 'memory space') ----- - lowSpaceChoices - "Return a notifier message string to be presented when space is running low." - - ^ 'Warning!! Squeak is almost out of memory!! - - Low space detection is now disabled. It will be restored when you close or proceed from this error notifier. Don''t panic, but do proceed with caution. - - Here are some suggestions: - - If you suspect an infinite recursion (the same methods calling each other again and again), then close this debugger, and fix the problem. - - If you want this computation to finish, then make more space available (read on) and choose "proceed" in this debugger. Here are some ways to make more space available... - > Close any windows that are not needed. - > Get rid of some large objects (e.g., images). - > Leave this window on the screen, choose "save as..." from the screen menu, quit, restart the Squeak VM with a larger memory allocation, then restart the image you just saved, and choose "proceed" in this window. - - If you want to investigate further, choose "debug" in this window. Do not use the debugger "fullStack" command unless you are certain that the stack is not very deep. (Trying to show the full stack will definitely use up all remaining memory if the low-space problem is caused by an infinite recursion!!). - - ' - ! Item was removed: - ----- Method: SmalltalkImage>>lowSpaceWatcher (in category 'memory space') ----- - lowSpaceWatcher - "Wait until the low space semaphore is signalled, then take appropriate actions." - - | free preemptedProcess | - self garbageCollectMost <= self lowSpaceThreshold - ifTrue: [self garbageCollect <= self lowSpaceThreshold - ifTrue: ["free space must be above threshold before - starting low space watcher" - ^ Beeper beep]]. - - Smalltalk specialObjectsArray at: 23 put: nil. "process causing low space will be saved here" - LowSpaceSemaphore := Semaphore new. - self primLowSpaceSemaphore: LowSpaceSemaphore. - self primSignalAtBytesLeft: self lowSpaceThreshold. "enable low space interrupts" - - LowSpaceSemaphore wait. "wait for a low space condition..." - - self primSignalAtBytesLeft: 0. "disable low space interrupts" - self primLowSpaceSemaphore: nil. - LowSpaceProcess := nil. - - "The process that was active at the time of the low space interrupt." - preemptedProcess := (Smalltalk specialObjectsArray at: 23) - ifNil: [Processor preemptedProcess "if in-image signal of OutOfMemory"]. - Smalltalk specialObjectsArray at: 23 put: nil. - - "Note: user now unprotected until the low space watcher is re-installed" - - self memoryHogs isEmpty - ifFalse: [free := self bytesLeft. - self memoryHogs - do: [ :hog | hog freeSomeSpace ]. - self bytesLeft > free - ifTrue: [ ^ self installLowSpaceWatcher ]]. - - Preferences logDebuggerStackToFile ifTrue: [ - self - logError: 'Space is low' - inContext: preemptedProcess suspendedContext - to: 'LowSpaceDebug.log']. - - Project current - interruptName: 'Space is low' - message: self lowSpaceChoices - preemptedProcess: preemptedProcess - ! Item was changed: ----- Method: SmalltalkImage>>lowSpaceWatcherProcess (in category 'memory space') ----- lowSpaceWatcherProcess + ^LowSpaceWatcher default ifNotNil: [ :watcher | watcher lowSpaceWatcherProcess ]! - ^LowSpaceProcess! Item was removed: - ----- Method: SmalltalkImage>>memoryHogs (in category 'memory space') ----- - memoryHogs - "Answer the list of objects to notify with #freeSomeSpace if memory gets full." - - ^ MemoryHogs ifNil: [MemoryHogs := OrderedCollection new]! Item was removed: - ----- Method: SmalltalkImage>>primLowSpaceSemaphore: (in category 'memory space') ----- - primLowSpaceSemaphore: aSemaphore - "Primitive. Register the given Semaphore to be signalled when the - number of free bytes drops below some threshold. Disable low-space - interrupts if the argument is nil." - - <primitive: 124> - self primitiveFailed! Item was removed: - ----- Method: SmalltalkImage>>primSignalAtBytesLeft: (in category 'memory space') ----- - primSignalAtBytesLeft: numBytes - "Tell the interpreter the low-space threshold in bytes. When the free - space falls below this threshold, the interpreter will signal the low-space - semaphore, if one has been registered. Disable low-space interrupts if the - argument is zero. Fail if numBytes is not an Integer." - - <primitive: 125> - self primitiveFailed! Item was removed: - ----- Method: SmalltalkImage>>signalLowSpace (in category 'memory space') ----- - signalLowSpace - "Signal the low-space semaphore to alert the user that space is running low." - - LowSpaceSemaphore signal.!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages February 2024