[etoys-dev] Etoys: System-bf.11.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat May 8 15:49:24 EDT 2010
Bert Freudenberg uploaded a new version of System to project Etoys:
http://source.squeak.org/etoys/System-bf.11.mcz
==================== Summary ====================
Name: System-bf.11
Author: bf
Time: 8 May 2010, 11:31 am
UUID: 1f5514af-427f-4218-913f-8466772ac9ee
Ancestors: System-bf.10
- Fix for SQ-489 (Alt-. does not always work): LowSpaceAndInterruptHandler-3-dtl-1
=============== Diff against System-bf.10 ===============
Item was added:
+ ----- Method: CurrentProjectRefactoring classSide>>currentInterruptName:preemptedProcess: (in category 'revectoring to current') -----
+ currentInterruptName: aString preemptedProcess: theInterruptedProcess
+
+ ^ Project interruptName: aString preemptedProcess: theInterruptedProcess!
Item was changed:
----- Method: SystemDictionary>>recreateSpecialObjectsArray (in category 'special objects') -----
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: (self 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: ByteString.
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:.
+ "The process that signaled the low space semaphore."
newArray at: 23 put: nil.
- "*unused*"
"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: (self
at: #ExternalAddress
ifAbsent: []).
newArray
at: 45
put: (self
at: #ExternalStructure
ifAbsent: []).
newArray
at: 46
put: (self
at: #ExternalData
ifAbsent: []).
newArray
at: 47
put: (self
at: #ExternalFunction
ifAbsent: []).
newArray
at: 48
put: (self
at: #ExternalLibrary
ifAbsent: []).
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!
Item was changed:
----- Method: Project class>>interruptName: (in category 'utilities') -----
interruptName: labelString
"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.
+ ^ self interruptName: labelString preemptedProcess: nil
- projectProcess _ self uiProcess. "we still need the accessor for a while"
- preemptedProcess _ 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 _ projectProcess suspend offList.
- ].
- Debugger openInterrupt: labelString onProcess: preemptedProcess
!
Item was changed:
----- Method: SystemDictionary>>lowSpaceWatcher (in category 'memory space') -----
lowSpaceWatcher
+ "Wait until the low space semaphore is signalled, then take appropriate actions."
+
+ | free preemptedProcess |
- "Wait until the low space semaphore is signalled, then take
- appropriate actions."
- | free |
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.
- 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 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"
+
- LowSpaceProcess := 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 ].
- do: [:hog | hog freeSomeSpace].
self bytesLeft > free
+ ifTrue: [ ^ self installLowSpaceWatcher ]].
- ifTrue: [^ self installLowSpaceWatcher]].
self isMorphic
+ ifTrue: [CurrentProjectRefactoring
+ currentInterruptName: 'Space is low'
+ preemptedProcess: preemptedProcess]
+ ifFalse: [ScheduledControllers
+ interruptName: 'Space is low'
+ preemptedProcess: preemptedProcess]
+ !
- ifTrue: [CurrentProjectRefactoring currentInterruptName: 'Space is low']
- ifFalse: [ScheduledControllers interruptName: 'Space is low']!
Item was added:
+ ----- Method: Project class>>interruptName:preemptedProcess: (in category 'utilities') -----
+ 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
+ !
More information about the etoys-dev
mailing list