A new version of System was added to project The Inbox: http://source.squeak.org/inbox/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. !
squeak-dev@lists.squeakfoundation.org