'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 16 April 2005 at 3:25:11 am'! "Change Set: LowSpaceAndInterruptHandler-2-dtl Date: 16 April 2005 Author: David T. Lewis Alternate version of low space handler fix, using Tim's approach of passing the process causing low space back through the special objects array. Includes both Morphic and MVC updates. The low space watcher is restarted in the postscript. LowSpaceAndInterruptHandler-2-dtl VMMLowSpaceAndInterruptHandler-2-dtl "! !ControlManager methodsFor: 'scheduling' stamp: 'dtl 4/4/2005 06:42'! interruptName: labelString "Create a Notifier on the active scheduling process with the given label. Make the Notifier the active controller." ^ self interruptName: labelString preemptedProcess: nil ! ! !ControlManager methodsFor: 'scheduling' stamp: 'dtl 4/6/2005 23:20'! interruptName: labelString preemptedProcess: theInterruptedProcess "Create a Notifier on the active scheduling process with the given label. Make the Notifier the active controller." | suspendingList newActiveController preemptedProcess | preemptedProcess _ theInterruptedProcess ifNil: [Processor preemptedProcess]. preemptedProcess == activeControllerProcess ifFalse: [(suspendingList _ preemptedProcess suspendingList) == nil ifTrue: [preemptedProcess suspend] ifFalse: [suspendingList remove: preemptedProcess. preemptedProcess offList]]. (suspendingList _ activeControllerProcess suspendingList) == nil ifTrue: [activeControllerProcess == Processor activeProcess ifTrue: [activeControllerProcess suspend]] ifFalse: [suspendingList remove: activeControllerProcess ifAbsent:[]. activeControllerProcess offList]. activeController ~~ nil ifTrue: [ "Carefully de-emphasis the current window." activeController view topView deEmphasizeForDebugger]. newActiveController _ (Debugger openInterrupt: labelString onProcess: preemptedProcess) controller. newActiveController centerCursorInView. self activeController: newActiveController. ! ! !CurrentProjectRefactoring class methodsFor: 'revectoring to current' stamp: 'dtl 4/3/2005 14:14'! currentInterruptName: aString preemptedProcess: theInterruptedProcess ^ Project interruptName: aString preemptedProcess: theInterruptedProcess! ! !Project class methodsFor: 'utilities' stamp: 'dtl 4/3/2005 14:02'! interruptName: labelString "Create a Notifier on the active scheduling process with the given label." ^ self interruptName: labelString preemptedProcess: nil ! ! !Project class methodsFor: 'utilities' stamp: 'dtl 4/3/2005 16:27'! interruptName: labelString preemptedProcess: theInterruptedProcess "Create a Notifier on the active scheduling process with the given label." | preemptedProcess projectProcess suspendingList | Smalltalk isMorphic ifFalse: [^ ScheduledControllers interruptName: labelString]. ActiveHand ifNotNil:[ActiveHand interrupted]. ActiveWorld _ World. "reinstall active globals" ActiveHand _ World primaryHand. ActiveHand interrupted. "make sure this one's interrupted too" ActiveEvent _ nil. projectProcess _ self uiProcess. "we still need the accessor for a while" preemptedProcess _ theInterruptedProcess ifNil: [Processor preemptedProcess]. "Only debug preempted process if its priority is >= projectProcess' priority" preemptedProcess priority < projectProcess priority ifTrue:[ (suspendingList _ projectProcess suspendingList) == nil ifTrue: [projectProcess == Processor activeProcess ifTrue: [projectProcess suspend]] ifFalse: [suspendingList remove: projectProcess ifAbsent: []. projectProcess offList]. preemptedProcess _ projectProcess. ] ifFalse:[ preemptedProcess suspend offList. ]. Debugger openInterrupt: labelString onProcess: preemptedProcess ! ! !SystemDictionary methodsFor: 'memory space' stamp: 'dtl 4/16/2005 01:06'! 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. 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 ]]. Smalltalk isMorphic ifTrue: [CurrentProjectRefactoring currentInterruptName: 'Space is low' preemptedProcess: preemptedProcess] ifFalse: [ScheduledControllers interruptName: 'Space is low' preemptedProcess: preemptedProcess]! ! !SystemDictionary methodsFor: 'special objects' stamp: 'dtl 4/16/2005 00:57'! recreateSpecialObjectsArray "Smalltalk recreateSpecialObjectsArray" "The Special Objects Array is an array of object pointers used by the Squeak virtual machine. Its contents are critical and unchecked, so don't even think of playing here unless you know what you are doing." | newArray | newArray _ Array new: 50. "Nil false and true get used throughout the interpreter" newArray at: 1 put: nil. newArray at: 2 put: false. newArray at: 3 put: true. "This association holds the active process (a ProcessScheduler)" newArray at: 4 put: (Smalltalk associationAt: #Processor). "Numerous classes below used for type checking and instantiation" newArray at: 5 put: Bitmap. newArray at: 6 put: SmallInteger. newArray at: 7 put: String. newArray at: 8 put: Array. newArray at: 9 put: Smalltalk. newArray at: 10 put: Float. newArray at: 11 put: MethodContext. newArray at: 12 put: BlockContext. newArray at: 13 put: Point. newArray at: 14 put: LargePositiveInteger. newArray at: 15 put: Display. newArray at: 16 put: Message. newArray at: 17 put: CompiledMethod. newArray at: 18 put: (self specialObjectsArray at: 18) "(low space Semaphore)". newArray at: 19 put: Semaphore. newArray at: 20 put: Character. newArray at: 21 put: #doesNotUnderstand:. newArray at: 22 put: #cannotReturn:. newArray at: 23 put: nil. "process that signaled the low space semaphore" "An array of the 32 selectors that are compiled as special bytecodes, paired alternately with the number of arguments each takes." newArray at: 24 put: #(+ 1 - 1 < 1 > 1 <= 1 >= 1 = 1 ~= 1 * 1 / 1 \\ 1 @ 1 bitShift: 1 // 1 bitAnd: 1 bitOr: 1 at: 1 at:put: 2 size 0 next 0 nextPut: 1 atEnd 0 == 1 class 0 blockCopy: 1 value 0 value: 1 do: 1 new 0 new: 1 x 0 y 0 ). "An array of the 255 Characters in ascii order." newArray at: 25 put: ((0 to: 255) collect: [:ascii | Character value: ascii]). newArray at: 26 put: #mustBeBoolean. newArray at: 27 put: ByteArray. newArray at: 28 put: Process. "An array of up to 31 classes whose instances will have compact headers" newArray at: 29 put: self compactClassesArray. newArray at: 30 put: (self specialObjectsArray at: 30) "(delay Semaphore)". newArray at: 31 put: (self specialObjectsArray at: 31) "(user interrupt Semaphore)". "Prototype instances that can be copied for fast initialization" newArray at: 32 put: (Float new: 2). newArray at: 33 put: (LargePositiveInteger new: 4). newArray at: 34 put: Point new. newArray at: 35 put: #cannotInterpret:. "Note: This must be fixed once we start using context prototypes" newArray at: 36 put: (self specialObjectsArray at: 36). "(MethodContext new: CompiledMethod fullFrameSize)." newArray at: 37 put: nil. newArray at: 38 put: (self specialObjectsArray at: 38). "(BlockContext new: CompiledMethod fullFrameSize)." newArray at: 39 put: Array new. "array of objects referred to by external code" newArray at: 40 put: PseudoContext. newArray at: 41 put: TranslatedMethod. "finalization Semaphore" newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil:[Semaphore new]). newArray at: 43 put: LargeNegativeInteger. "External objects for callout. Note: Written so that one can actually completely remove the FFI." newArray at: 44 put: (Smalltalk at: #ExternalAddress ifAbsent:[nil]). newArray at: 45 put: (Smalltalk at: #ExternalStructure ifAbsent:[nil]). newArray at: 46 put: (Smalltalk at: #ExternalData ifAbsent:[nil]). newArray at: 47 put: (Smalltalk at: #ExternalFunction ifAbsent:[nil]). newArray at: 48 put: (Smalltalk at: #ExternalLibrary ifAbsent:[nil]). newArray at: 49 put: #aboutToReturn:through:. newArray at: 50 put: #run:with:in:. "Now replace the interpreter's reference in one atomic operation" self specialObjectsArray become: newArray! ! "Postscript: Restart the low space watcher to activate the new version." Smalltalk installLowSpaceWatcher. !