Squeak-dev May 2015

squeak-dev@lists.squeakfoundation.org

50 participants
615 discussions

The Trunk: System.spur-eem.739.mcz
by commits＠source.squeak.org 30 May '15

30 May '15

Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System.spur-eem.739.mcz ==================== Summary ==================== Name: System.spur-eem.739 Author: eem Time: 29 May 2015, 4:28:17.452 pm UUID: fe7a0115-0706-4a19-a2b1-280f5a7e50d6 Ancestors: System-eem.739, System.spur-cmm.738 System-eem.739 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.267 Support for condensing sources and changes while preserving direct history. =============== Diff against System-eem.739 =============== Item was removed: - Object subclass: #ObjectHistory - instanceVariableNames: 'marks markProcess' - classVariableNames: 'Current ObjectHistoryEnabled' - poolDictionaries: '' - category: 'System-Support'! - - !ObjectHistory commentStamp: 'bf 11/16/2012 12:19' prior: 0! - ObjectHistory holds ObjectHistoryMark objects which are placed in the object memory at regular intervals by its markProcess in the background. Adjacent marks (with no remaining objects inbetween) are coalesced so over time the collection does not grow unnecessarily large. - - Using these markers it is possible to determine the age of objects in memory from the time the ObjectHistory was initialized. Try e.g.: - self oopTimestamp. - self oopAge. - ObjectHistory current oopClassesByDate. - - Instance Variables - marks: SortedCollection of ObjectHistoryMark objects - markProcess: a Process running our markLoop - ! Item was removed: - ----- Method: ObjectHistory class>>current (in category 'accessing') ----- - current - ^ Current ifNil: [Current := self new]! Item was removed: - ----- Method: ObjectHistory class>>initialize (in category 'class initialization') ----- - initialize - self current. - ! Item was removed: - ----- Method: ObjectHistory class>>keepTrackOfObjectHistory (in category 'preferences') ----- - keepTrackOfObjectHistory - <preference: 'Keep track of object history' - category: #('debug' 'general' 'performance') - description: 'Collect marker objects in the object memory at regular intervals in the background. - - Using these markers it is possible to determine the age of objects in memory from the time the object history was initialized.' - type: #Boolean> - ^ ObjectHistoryEnabled ifNil: [ - Current - ifNil: [false] - ifNotNil: [:objectHistory | objectHistory isRunning]]! Item was removed: - ----- Method: ObjectHistory class>>keepTrackOfObjectHistory: (in category 'preferences') ----- - keepTrackOfObjectHistory: aBoolean - " Reflect the desired state by starting/stopping the process if necessary " - ObjectHistoryEnabled = aBoolean ifTrue: [^ self]. - ObjectHistoryEnabled := aBoolean. - - Current - ifNil: [aBoolean ifTrue: [self current]] - ifNotNil: [:objectHistory | - (objectHistory isRunning xor: aBoolean) "state switch needed" - ifTrue: [objectHistory toggleRunning]].! Item was removed: - ----- Method: ObjectHistory class>>obsolete (in category 'class initialization') ----- - obsolete - "Kill the mark process before removing the class." - Current ifNotNil: - [:objectHistory| - objectHistory terminate]. - super obsolete! Item was removed: - ----- Method: ObjectHistory>>ageOf: (in category 'queries') ----- - ageOf: anObject - "Age of anObject in seconds" - | timestamp | - timestamp := self timestampOf: anObject. - timestamp ifNil: [^0]. - ^(DateAndTime now - timestamp) asSeconds roundTo: self markRate! Item was removed: - ----- Method: ObjectHistory>>initialize (in category 'initializing') ----- - initialize - self restartMarkProcess. - - ! Item was removed: - ----- Method: ObjectHistory>>isRunning (in category 'testing') ----- - isRunning - ^ markProcess - ifNil: [false] - ifNotNil: [:process | - process isSuspended not and: [ - process isTerminated not]]! Item was removed: - ----- Method: ObjectHistory>>markLoop (in category 'marking') ----- - markLoop - [true] whileTrue: [ - self markUpdate. - (Delay forSeconds: self markRate) wait]! Item was removed: - ----- Method: ObjectHistory>>markRate (in category 'marking') ----- - markRate - "rate of creating ObjectHistoryMarks" - ^60! Item was removed: - ----- Method: ObjectHistory>>markUpdate (in category 'marking') ----- - markUpdate - "Add a new mark and compact the marks collection" - | mark prev | - "lazy init so this happens in the background process" - marks ifNil: [self reinitMarks]. - "add new mark to object memory" - mark := self newMark. - mark timestamp <= marks last timestamp ifTrue: [^self "could happen if clock is wrong"]. - marks addLast: mark. - "compact the table by removing adjacent marks" - prev := marks first. - marks removeAllSuchThat: [:each | | doDelete | - doDelete := prev objectAfter == each. - prev := each. - doDelete]. - "The loop above is O(n) in number of marks, but that number should never become so large to be an issue. Even if the number was large, this is running at system background priority so should not interfere with any user process, not even user background processes. The symptom should only be that the system is less idle. - - If we ever get to a point where the number of marks is an issue then the compacting here could be made partial: since old marks rarely get coalesced it would make sense to only check the newer ones often, and the old ones perhaps only at the system startup."! Item was removed: - ----- Method: ObjectHistory>>newMark (in category 'private') ----- - newMark - ^ ObjectHistoryMark new! Item was removed: - ----- Method: ObjectHistory>>oopClassesByAge (in category 'stats') ----- - oopClassesByAge - "Answer collection of (oopAge in seconds -> sorted counts of object classes) sorted from lowest age" - "ObjectHistory current oopClassesByAge" - - | stats prev endOfMemory now bag age obj | - endOfMemory := Object new. - stats := OrderedCollection new: 1000. - prev := nil. - now := self newMark timestamp. - marks do: [:mark | - prev ifNotNil: [ - bag := Bag new. - obj := prev objectAfter. - [obj == mark] whileFalse: [ - bag add: obj class. - obj := obj nextObject. - obj == endOfMemory ifTrue: [self error: 'should not happen']]. - age := (now - mark timestamp) asSeconds roundTo: self markRate. - stats addFirst: age -> bag sortedCounts]. - prev := mark]. - ^ stats - ! Item was removed: - ----- Method: ObjectHistory>>oopClassesByDate (in category 'stats') ----- - oopClassesByDate - "Answer collection of (Date -> sorted counts of object classes) sorted from newest date" - "ObjectHistory current oopClassesByDate" - - | stats prev endOfMemory bag date obj thisDate | - endOfMemory := Object new. - stats := OrderedCollection new: 1000. - prev := nil. - thisDate := nil. - bag := Bag new. - marks do: [:mark | - prev ifNotNil: [ - obj := prev objectAfter. - [obj == mark] whileFalse: [ - bag add: obj class. - obj := obj nextObject. - obj == endOfMemory ifTrue: [self error: 'should not happen']]. - date := mark timestamp asDate. - thisDate = date ifFalse: [ - stats addFirst: date -> bag sortedCounts. - bag := Bag new. - thisDate := date]]. - prev := mark]. - thisDate = date ifFalse: [ - stats addLast: date -> bag sortedCounts]. - ^ stats - ! Item was removed: - ----- Method: ObjectHistory>>oopCountsByAge (in category 'stats') ----- - oopCountsByAge - "Answer collection of (oopAge in seconds -> number of objects) sorted from lowest age" - "ObjectHistory current oopCountsByAge" - - | stats prev endOfMemory now n age obj | - endOfMemory := Object new. - stats := OrderedCollection new: 1000. - prev := nil. - now := self newMark timestamp. - marks do: [:mark | - prev ifNotNil: [ - n := 0. - obj := prev objectAfter. - [obj == mark] whileFalse: [ - n := n + 1. - obj := obj nextObject. - obj == endOfMemory ifTrue: [self error: 'should not happen']]. - age := (now - mark timestamp) asSeconds roundTo: self markRate. - stats addFirst: age -> n]. - prev := mark]. - ^ stats - ! Item was removed: - ----- Method: ObjectHistory>>reinitMarks (in category 'private') ----- - reinitMarks - marks := ObjectHistoryMark allInstances asOrderedCollection. - marks - ifEmpty: [marks add: self newMark] - ifNotEmpty: [ | prev | - prev := nil. - marks removeAllSuchThat: [:obj | - prev notNil and: [prev timestamp >= obj timestamp]]]. - ! Item was removed: - ----- Method: ObjectHistory>>restartMarkProcess (in category 'marking') ----- - restartMarkProcess - markProcess ifNotNil: [markProcess terminate]. - markProcess := [self markLoop] - forkAt: Processor systemBackgroundPriority - named: 'ObjectHistory''s markProcess'. - ! Item was removed: - ----- Method: ObjectHistory>>terminate (in category 'private') ----- - terminate - markProcess ifNotNil: - [markProcess terminate]! Item was removed: - ----- Method: ObjectHistory>>timestampOf: (in category 'queries') ----- - timestampOf: anObject - "Timestamp of anObject, or nil if too new" - | endOfMemory mark | - anObject class == SmallInteger ifTrue: [^nil]. - mark := anObject. - endOfMemory := Object new. - [mark class == ObjectHistoryMark] whileFalse: [ - mark := mark nextObject. - mark == endOfMemory ifTrue: [^nil]]. - ^mark timestamp! Item was removed: - ----- Method: ObjectHistory>>toggleRunning (in category 'private') ----- - toggleRunning - self isRunning - ifTrue: [self terminate] - ifFalse: [self restartMarkProcess]! Item was removed: - Object subclass: #ObjectHistoryMark - instanceVariableNames: 'timestamp' - classVariableNames: '' - poolDictionaries: '' - category: 'System-Support'! - - !ObjectHistoryMark commentStamp: 'bf 11/7/2012 00:12' prior: 0! - An ObjectHistoryMark is a permanent mark in the object memory. It holds a timestamp. - - While the timestamp could be used directly as mark by ObjectHistory, it's conceivable that its format might change in the future, and we do not want the mark's relative position in memory to change (which would be the case if it was migrated to a new format). So we use a distinct object instead (and we protect it against accidental become-ing by overriding those methods).! Item was removed: - ----- Method: ObjectHistoryMark>>become: (in category 'mutating') ----- - become: otherObject - ^self error: 'marks need to stay fixed in the object memory'! Item was removed: - ----- Method: ObjectHistoryMark>>becomeForward: (in category 'mutating') ----- - becomeForward: otherObject - ^self error: 'marks need to stay fixed in the object memory'! Item was removed: - ----- Method: ObjectHistoryMark>>initialize (in category 'initialization') ----- - initialize - timestamp := DateAndTime now floor. - ! Item was removed: - ----- Method: ObjectHistoryMark>>objectAfter (in category 'accessing') ----- - objectAfter - "Answer the next object in memory after me and my timestamp" - | successor | - successor := self nextObject. - successor == timestamp - ifTrue: [successor := successor nextObject]. - ^ successor! Item was removed: - ----- Method: ObjectHistoryMark>>printOn: (in category 'printing') ----- - printOn: aStream - aStream - nextPutAll: self class name; - nextPut: $(; - print: timestamp; - nextPut: $)! Item was removed: - ----- Method: ObjectHistoryMark>>timestamp (in category 'accessing') ----- - timestamp - ^timestamp - ! Item was changed: ----- Method: SmalltalkImage>>compactClassesArray (in category 'special objects') ----- compactClassesArray "Smalltalk compactClassesArray" + "Backward-compatibility support. Spur does not have compact classes." + ^{}! - "Return the array of 31 classes whose instances may be - represented compactly" - ^ self specialObjectsArray at: 29! Item was added: + ----- Method: SmalltalkImage>>growMemoryByAtLeast: (in category 'memory space') ----- + growMemoryByAtLeast: numBytes + "Grow memory by at least the requested number of bytes. + Primitive. Essential. Fail if no memory is available." + <primitive: 180> + (numBytes isInteger and: [numBytes > 0]) ifTrue: + [OutOfMemory signal]. + ^self primitiveFailed! Item was added: + ----- Method: SmalltalkImage>>maxIdentityHash (in category 'system attributes') ----- + maxIdentityHash + "Answer the maximum identityHash value supported by the VM." + <primitive: 176> + ^self primitiveFailed! Item was changed: ----- Method: SmalltalkImage>>primBytesLeft (in category 'memory space') ----- primBytesLeft + "Primitive. Answer the number of free bytes available in old space. + Not accurate unless preceded by - "Primitive. Answer the number of bytes available for new object data. - Not accurate unless preceded by Smalltalk garbageCollectMost (for reasonable accuracy), or Smalltalk garbageCollect (for real accuracy). + See Object documentation whatIsAPrimitive." - See Object documentation whatIsAPrimitive." <primitive: 112> + ^0! - ^ 0! Item was changed: ----- Method: SmalltalkImage>>primitiveGarbageCollect (in category 'memory space') ----- primitiveGarbageCollect + "Primitive. Reclaims all garbage and answers the size of the largest free chunk in old space.." - "Primitive. Reclaims all garbage and answers the number of bytes of available space." <primitive: 130> + ^self primitiveFailed! - ^ self primBytesLeft! Item was changed: ----- Method: SmalltalkImage>>recreateSpecialObjectsArray (in category 'special objects') ----- recreateSpecialObjectsArray "Smalltalk recreateSpecialObjectsArray" "To external package developers: **** DO NOT OVERRIDE THIS METHOD. ***** If you are writing a plugin and need additional special object(s) for your own use, use addGCRoot() function and use own, separate special objects registry " "The Special Objects Array is an array of objects used by the Squeak virtual machine. Its contents are critical and accesses to it by the VM are unchecked, so don't even think of playing here unless you know what you are doing." | newArray | + newArray := Array new: 60. - newArray := Array new: 58. "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 specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias". "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: BoxedFloat64. + newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]). + newArray at: 12 put: nil. "was BlockContext." - 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) ifNil: [Semaphore new]). "low space Semaphore" - 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. "This is the process signalling low space." "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. + Cog inlines table into machine code at: prim so do not regenerate it. + This is nil in Spur, which has immediate Characters." - Cog inlines table into machine code at: prim so do not regenerate it." newArray at: 25 put: (self specialObjectsArray at: 25). 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; an empty array in Spur" - "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) ifNil: [Semaphore new]). "delay Semaphore" + newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore" - newArray at: 30 put: (self specialObjectsArray at: 30). "(delay Semaphore)" - newArray at: 31 put: (self specialObjectsArray at: 31). "(user interrupt Semaphore)" "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization" + newArray at: 32 put: nil. "was the prototype Float" + newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger" + newArray at: 34 put: nil. "was the prototype Point" - newArray at: 32 put: nil. "was (Float new: 2)" - newArray at: 33 put: nil. "was (LargePositiveInteger new: 4)" - newArray at: 34 put: nil. "was Point new" newArray at: 35 put: #cannotInterpret:. + newArray at: 36 put: nil. "was the prototype MethodContext" - "Note: This must be fixed once we start using context prototypes (yeah, right)" - "(MethodContext new: CompiledMethod fullFrameSize)." - newArray at: 36 put: (self specialObjectsArray at: 36). "Is the prototype MethodContext (unused by the VM)" newArray at: 37 put: BlockClosure. + newArray at: 38 put: nil. "was the prototype BlockContext" - "(BlockContext new: CompiledMethod fullFrameSize)." - newArray at: 38 put: (self specialObjectsArray at: 38). "Is the prototype BlockContext (unused by the VM)" "array of objects referred to by external code" + newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores" - newArray at: 39 put: (self specialObjectsArray at: 39). "preserve external semaphores" newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs" + newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT" + newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore" - newArray at: 41 put: nil. "Reserved for a LinkedList instance for overlapped calls in CogMT" - "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:. "51 reserved for immutability message" + newArray at: 51 put: #attemptToAssign:withIndex:. - "newArray at: 51 put: #attemptToAssign:withIndex:." - newArray at: 51 put: (self specialObjectsArray at: 51 ifAbsent: []). newArray at: 52 put: #(nil "nil => generic error" #'bad receiver' #'bad argument' #'bad index' #'bad number of arguments' #'inappropriate operation' #'unsupported operation' #'no modification' #'insufficient object memory' #'insufficient C memory' #'not found' #'bad method' #'internal error in named primitive machinery' #'object may move' #'resource limit exceeded' + #'object is pinned' #'primitive write beyond end of object'). - #'object is pinned'). "53 to 55 are for Alien" newArray at: 53 put: (self at: #Alien ifAbsent: []). + newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks." - newArray at: 54 put: #invokeCallbackContext::. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks." newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []). + "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support." + newArray at: 56 put: nil. - "Weak reference finalization" - newArray at: 56 put: (self at: #WeakFinalizationList ifAbsent: []). "reserved for foreign callback process" newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []). newArray at: 58 put: #unusedBytecode. + "59 reserved for Sista counter tripped message" + newArray at: 59 put: #conditionalBranchCounterTrippedOn:. + "60 reserved for Sista class trap message" + newArray at: 60 put: #classTrapFor:. "Now replace the interpreter's reference in one atomic operation" + self specialObjectsArray becomeForward: newArray! - self specialObjectsArray becomeForward: newArray - ! Item was changed: ----- Method: SmalltalkImage>>setGCParameters (in category 'snapshot and quit') ----- setGCParameters + "Adjust the VM's default GC parameters to avoid too much tenuring. + Maybe this should be left to the VM?" - "Adjust the VM's default GC parameters to avoid premature tenuring." + | proportion edenSize survivorSize averageObjectSize numObjects | + proportion := 0.9. "tenure when 90% of pastSpace is full" + edenSize := SmalltalkImage current vmParameterAt: 44. + survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)" + averageObjectSize := 8 * self wordSize. "a good approximation" + numObjects := (proportion * survivorSize / averageObjectSize) rounded. + SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"! - self vmParameterAt: 5 put: 4000. "do an incremental GC after this many allocations" - self vmParameterAt: 6 put: 2000. "tenure when more than this many objects survive the GC" - ! Item was changed: ----- Method: SpaceTally>>spaceForInstancesOf: (in category 'instance size') ----- spaceForInstancesOf: aClass + "Answer a pair of the number of bytes consumed by all instances of the + given class, including their object headers, and the number of instances." - "Answer the number of bytes consumed by all instances of the given class, including their object headers and the number of instances." + | instances total | + instances := aClass allInstances. + instances isEmpty ifTrue: [^#(0 0)]. - | smallHeaderSize instVarBytes isVariable bytesPerElement total lastInstance instance instanceCount | - instance := aClass someInstance ifNil: [ ^#(0 0) ]. - smallHeaderSize := aClass isCompact ifTrue: [ 4 ] ifFalse: [ 8 ]. - instVarBytes := aClass instSize * 4. - isVariable := aClass isVariable. - bytesPerElement := isVariable - ifFalse: [ 0 ] - ifTrue: [ aClass isBytes ifTrue: [ 1 ] ifFalse: [ 4 ] ]. total := 0. + aClass isVariable + ifTrue: + [instances do: + [:i| total := total + (aClass byteSizeOfInstanceOfSize: i basicSize)]] + ifFalse: + [total := instances size * aClass byteSizeOfInstance]. + ^{ total. instances size }! - instanceCount := 0. - "A modified version of #allInstancesDo: is inlined here. It avoids an infinite loop when another process is creating new instances of aClass." - self flag: #allInstancesDo:. - lastInstance := - aClass == CompiledMethod "CompiledMethod has special format, see its class comment" - ifTrue: [aClass new] - ifFalse: [aClass basicNew]. - [ instance == lastInstance ] whileFalse: [ - | contentBytes headerBytes | - contentBytes := instVarBytes + (isVariable - ifFalse: [ 0 ] - ifTrue: [ instance basicSize * bytesPerElement ]). - headerBytes := contentBytes > 255 - ifTrue: [ 12 ] - ifFalse: [ smallHeaderSize ]. - total := total + headerBytes + (contentBytes roundUpTo: 4). - instanceCount := instanceCount + 1. - instance := instance nextInstance ]. - ^{ total. instanceCount }! Item was added: + ----- Method: SystemDictionary>>growMemoryByAtLeast: (in category 'memory space') ----- + growMemoryByAtLeast: numBytes + "Grow memory by at least the requested number of bytes. + Primitive. Fail if no memory is available. Essential." + <primitive: 180> + ^(numBytes isInteger and: [numBytes > 0]) + ifTrue: [OutOfMemory signal] + ifFalse: [self primitiveFailed]! Item was added: + ----- Method: SystemDictionary>>maxIdentityHash (in category 'system attributes') ----- + maxIdentityHash + "Answer the maximum identityHash value supported by the VM." + <primitive: 176> + ^self primitiveFailed! Item was added: + ----- Method: SystemDictionary>>setGCParameters (in category 'snapshot and quit') ----- + setGCParameters + "Adjust the VM's default GC parameters to avoid too much tenuring. + Maybe this should be left to the VM?" + + | proportion edenSize survivorSize averageObjectSize numObjects | + proportion := 0.9. "tenure when 90% of pastSpace is full" + edenSize := SmalltalkImage current vmParameterAt: 44. + survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)" + averageObjectSize := 8 * self wordSize. "a good approximation" + numObjects := (proportion * survivorSize / averageObjectSize) rounded. + SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"! Item was added: + ----- Method: SystemNavigation>>allObjects (in category 'query') ----- + allObjects + "Answer an Array of all objects in the system. Fail if + there isn't enough memory to instantiate the result." + <primitive: 178> + ^self primitiveFailed! Item was changed: ----- Method: SystemNavigation>>allObjectsDo: (in category 'query') ----- allObjectsDo: aBlock + "Evaluate the argument, aBlock, for each object in the system, excluding immediates + such as SmallInteger and Character." + self allObjectsOrNil + ifNotNil: [:allObjects| allObjects do: aBlock] + ifNil: + ["Fall back on the old single object primitive code. With closures, this needs + to use an end marker (lastObject) since activation of the block will create + new contexts and cause an infinite loop. The lastObject must be created + before calling someObject, so that the VM can settle the enumeration (e.g. + by flushing new space) as a side effect of someObject" + | object lastObject | + lastObject := Object new. + object := self someObject. + [lastObject == object or: [0 == object]] whileFalse: + [aBlock value: object. + object := object nextObject]]! - "Evaluate the argument, aBlock, for each object in the system - excluding SmallIntegers. With closures, this needs to use an end - marker (lastObject) since activation of the block will create new - contexts and cause an infinite loop." - | object lastObject | - object := self someObject. - lastObject := Object new. - [lastObject == object or: [0 == object]] - whileFalse: [aBlock value: object. - object := object nextObject]! Item was added: + ----- Method: SystemNavigation>>allObjectsOrNil (in category 'query') ----- + allObjectsOrNil + "Answer an Array of all objects in the system. Fail if there isn't + enough memory to instantiate the result and answer nil." + <primitive: 178> + ^nil!

1 0

The Trunk: System.spur-cmm.738.mcz
by commits＠source.squeak.org 30 May '15

30 May '15

Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System.spur-cmm.738.mcz ==================== Summary ==================== Name: System.spur-cmm.738 Author: eem Time: 29 May 2015, 4:28:11.979 pm UUID: 84a28675-cf59-465f-86cc-58e2b38557bc Ancestors: System-cmm.738, System.spur-ul.737 System-cmm.738 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.267 Fix #run: leaving headless image stuck because there was a MNU or Halt. =============== Diff against System-cmm.738 =============== Item was removed: - Object subclass: #ObjectHistory - instanceVariableNames: 'marks markProcess' - classVariableNames: 'Current ObjectHistoryEnabled' - poolDictionaries: '' - category: 'System-Support'! - - !ObjectHistory commentStamp: 'bf 11/16/2012 12:19' prior: 0! - ObjectHistory holds ObjectHistoryMark objects which are placed in the object memory at regular intervals by its markProcess in the background. Adjacent marks (with no remaining objects inbetween) are coalesced so over time the collection does not grow unnecessarily large. - - Using these markers it is possible to determine the age of objects in memory from the time the ObjectHistory was initialized. Try e.g.: - self oopTimestamp. - self oopAge. - ObjectHistory current oopClassesByDate. - - Instance Variables - marks: SortedCollection of ObjectHistoryMark objects - markProcess: a Process running our markLoop - ! Item was removed: - ----- Method: ObjectHistory class>>current (in category 'accessing') ----- - current - ^ Current ifNil: [Current := self new]! Item was removed: - ----- Method: ObjectHistory class>>initialize (in category 'class initialization') ----- - initialize - self current. - ! Item was removed: - ----- Method: ObjectHistory class>>keepTrackOfObjectHistory (in category 'preferences') ----- - keepTrackOfObjectHistory - <preference: 'Keep track of object history' - category: #('debug' 'general' 'performance') - description: 'Collect marker objects in the object memory at regular intervals in the background. - - Using these markers it is possible to determine the age of objects in memory from the time the object history was initialized.' - type: #Boolean> - ^ ObjectHistoryEnabled ifNil: [ - Current - ifNil: [false] - ifNotNil: [:objectHistory | objectHistory isRunning]]! Item was removed: - ----- Method: ObjectHistory class>>keepTrackOfObjectHistory: (in category 'preferences') ----- - keepTrackOfObjectHistory: aBoolean - " Reflect the desired state by starting/stopping the process if necessary " - ObjectHistoryEnabled = aBoolean ifTrue: [^ self]. - ObjectHistoryEnabled := aBoolean. - - Current - ifNil: [aBoolean ifTrue: [self current]] - ifNotNil: [:objectHistory | - (objectHistory isRunning xor: aBoolean) "state switch needed" - ifTrue: [objectHistory toggleRunning]].! Item was removed: - ----- Method: ObjectHistory class>>obsolete (in category 'class initialization') ----- - obsolete - "Kill the mark process before removing the class." - Current ifNotNil: - [:objectHistory| - objectHistory terminate]. - super obsolete! Item was removed: - ----- Method: ObjectHistory>>ageOf: (in category 'queries') ----- - ageOf: anObject - "Age of anObject in seconds" - | timestamp | - timestamp := self timestampOf: anObject. - timestamp ifNil: [^0]. - ^(DateAndTime now - timestamp) asSeconds roundTo: self markRate! Item was removed: - ----- Method: ObjectHistory>>initialize (in category 'initializing') ----- - initialize - self restartMarkProcess. - - ! Item was removed: - ----- Method: ObjectHistory>>isRunning (in category 'testing') ----- - isRunning - ^ markProcess - ifNil: [false] - ifNotNil: [:process | - process isSuspended not and: [ - process isTerminated not]]! Item was removed: - ----- Method: ObjectHistory>>markLoop (in category 'marking') ----- - markLoop - [true] whileTrue: [ - self markUpdate. - (Delay forSeconds: self markRate) wait]! Item was removed: - ----- Method: ObjectHistory>>markRate (in category 'marking') ----- - markRate - "rate of creating ObjectHistoryMarks" - ^60! Item was removed: - ----- Method: ObjectHistory>>markUpdate (in category 'marking') ----- - markUpdate - "Add a new mark and compact the marks collection" - | mark prev | - "lazy init so this happens in the background process" - marks ifNil: [self reinitMarks]. - "add new mark to object memory" - mark := self newMark. - mark timestamp <= marks last timestamp ifTrue: [^self "could happen if clock is wrong"]. - marks addLast: mark. - "compact the table by removing adjacent marks" - prev := marks first. - marks removeAllSuchThat: [:each | | doDelete | - doDelete := prev objectAfter == each. - prev := each. - doDelete]. - "The loop above is O(n) in number of marks, but that number should never become so large to be an issue. Even if the number was large, this is running at system background priority so should not interfere with any user process, not even user background processes. The symptom should only be that the system is less idle. - - If we ever get to a point where the number of marks is an issue then the compacting here could be made partial: since old marks rarely get coalesced it would make sense to only check the newer ones often, and the old ones perhaps only at the system startup."! Item was removed: - ----- Method: ObjectHistory>>newMark (in category 'private') ----- - newMark - ^ ObjectHistoryMark new! Item was removed: - ----- Method: ObjectHistory>>oopClassesByAge (in category 'stats') ----- - oopClassesByAge - "Answer collection of (oopAge in seconds -> sorted counts of object classes) sorted from lowest age" - "ObjectHistory current oopClassesByAge" - - | stats prev endOfMemory now bag age obj | - endOfMemory := Object new. - stats := OrderedCollection new: 1000. - prev := nil. - now := self newMark timestamp. - marks do: [:mark | - prev ifNotNil: [ - bag := Bag new. - obj := prev objectAfter. - [obj == mark] whileFalse: [ - bag add: obj class. - obj := obj nextObject. - obj == endOfMemory ifTrue: [self error: 'should not happen']]. - age := (now - mark timestamp) asSeconds roundTo: self markRate. - stats addFirst: age -> bag sortedCounts]. - prev := mark]. - ^ stats - ! Item was removed: - ----- Method: ObjectHistory>>oopClassesByDate (in category 'stats') ----- - oopClassesByDate - "Answer collection of (Date -> sorted counts of object classes) sorted from newest date" - "ObjectHistory current oopClassesByDate" - - | stats prev endOfMemory bag date obj thisDate | - endOfMemory := Object new. - stats := OrderedCollection new: 1000. - prev := nil. - thisDate := nil. - bag := Bag new. - marks do: [:mark | - prev ifNotNil: [ - obj := prev objectAfter. - [obj == mark] whileFalse: [ - bag add: obj class. - obj := obj nextObject. - obj == endOfMemory ifTrue: [self error: 'should not happen']]. - date := mark timestamp asDate. - thisDate = date ifFalse: [ - stats addFirst: date -> bag sortedCounts. - bag := Bag new. - thisDate := date]]. - prev := mark]. - thisDate = date ifFalse: [ - stats addLast: date -> bag sortedCounts]. - ^ stats - ! Item was removed: - ----- Method: ObjectHistory>>oopCountsByAge (in category 'stats') ----- - oopCountsByAge - "Answer collection of (oopAge in seconds -> number of objects) sorted from lowest age" - "ObjectHistory current oopCountsByAge" - - | stats prev endOfMemory now n age obj | - endOfMemory := Object new. - stats := OrderedCollection new: 1000. - prev := nil. - now := self newMark timestamp. - marks do: [:mark | - prev ifNotNil: [ - n := 0. - obj := prev objectAfter. - [obj == mark] whileFalse: [ - n := n + 1. - obj := obj nextObject. - obj == endOfMemory ifTrue: [self error: 'should not happen']]. - age := (now - mark timestamp) asSeconds roundTo: self markRate. - stats addFirst: age -> n]. - prev := mark]. - ^ stats - ! Item was removed: - ----- Method: ObjectHistory>>reinitMarks (in category 'private') ----- - reinitMarks - marks := ObjectHistoryMark allInstances asOrderedCollection. - marks - ifEmpty: [marks add: self newMark] - ifNotEmpty: [ | prev | - prev := nil. - marks removeAllSuchThat: [:obj | - prev notNil and: [prev timestamp >= obj timestamp]]]. - ! Item was removed: - ----- Method: ObjectHistory>>restartMarkProcess (in category 'marking') ----- - restartMarkProcess - markProcess ifNotNil: [markProcess terminate]. - markProcess := [self markLoop] - forkAt: Processor systemBackgroundPriority - named: 'ObjectHistory''s markProcess'. - ! Item was removed: - ----- Method: ObjectHistory>>terminate (in category 'private') ----- - terminate - markProcess ifNotNil: - [markProcess terminate]! Item was removed: - ----- Method: ObjectHistory>>timestampOf: (in category 'queries') ----- - timestampOf: anObject - "Timestamp of anObject, or nil if too new" - | endOfMemory mark | - anObject class == SmallInteger ifTrue: [^nil]. - mark := anObject. - endOfMemory := Object new. - [mark class == ObjectHistoryMark] whileFalse: [ - mark := mark nextObject. - mark == endOfMemory ifTrue: [^nil]]. - ^mark timestamp! Item was removed: - ----- Method: ObjectHistory>>toggleRunning (in category 'private') ----- - toggleRunning - self isRunning - ifTrue: [self terminate] - ifFalse: [self restartMarkProcess]! Item was removed: - Object subclass: #ObjectHistoryMark - instanceVariableNames: 'timestamp' - classVariableNames: '' - poolDictionaries: '' - category: 'System-Support'! - - !ObjectHistoryMark commentStamp: 'bf 11/7/2012 00:12' prior: 0! - An ObjectHistoryMark is a permanent mark in the object memory. It holds a timestamp. - - While the timestamp could be used directly as mark by ObjectHistory, it's conceivable that its format might change in the future, and we do not want the mark's relative position in memory to change (which would be the case if it was migrated to a new format). So we use a distinct object instead (and we protect it against accidental become-ing by overriding those methods).! Item was removed: - ----- Method: ObjectHistoryMark>>become: (in category 'mutating') ----- - become: otherObject - ^self error: 'marks need to stay fixed in the object memory'! Item was removed: - ----- Method: ObjectHistoryMark>>becomeForward: (in category 'mutating') ----- - becomeForward: otherObject - ^self error: 'marks need to stay fixed in the object memory'! Item was removed: - ----- Method: ObjectHistoryMark>>initialize (in category 'initialization') ----- - initialize - timestamp := DateAndTime now floor. - ! Item was removed: - ----- Method: ObjectHistoryMark>>objectAfter (in category 'accessing') ----- - objectAfter - "Answer the next object in memory after me and my timestamp" - | successor | - successor := self nextObject. - successor == timestamp - ifTrue: [successor := successor nextObject]. - ^ successor! Item was removed: - ----- Method: ObjectHistoryMark>>printOn: (in category 'printing') ----- - printOn: aStream - aStream - nextPutAll: self class name; - nextPut: $(; - print: timestamp; - nextPut: $)! Item was removed: - ----- Method: ObjectHistoryMark>>timestamp (in category 'accessing') ----- - timestamp - ^timestamp - ! Item was changed: ----- Method: SmalltalkImage>>compactClassesArray (in category 'special objects') ----- compactClassesArray "Smalltalk compactClassesArray" + "Backward-compatibility support. Spur does not have compact classes." + ^{}! - "Return the array of 31 classes whose instances may be - represented compactly" - ^ self specialObjectsArray at: 29! Item was added: + ----- Method: SmalltalkImage>>growMemoryByAtLeast: (in category 'memory space') ----- + growMemoryByAtLeast: numBytes + "Grow memory by at least the requested number of bytes. + Primitive. Essential. Fail if no memory is available." + <primitive: 180> + (numBytes isInteger and: [numBytes > 0]) ifTrue: + [OutOfMemory signal]. + ^self primitiveFailed! Item was added: + ----- Method: SmalltalkImage>>maxIdentityHash (in category 'system attributes') ----- + maxIdentityHash + "Answer the maximum identityHash value supported by the VM." + <primitive: 176> + ^self primitiveFailed! Item was changed: ----- Method: SmalltalkImage>>primBytesLeft (in category 'memory space') ----- primBytesLeft + "Primitive. Answer the number of free bytes available in old space. + Not accurate unless preceded by - "Primitive. Answer the number of bytes available for new object data. - Not accurate unless preceded by Smalltalk garbageCollectMost (for reasonable accuracy), or Smalltalk garbageCollect (for real accuracy). + See Object documentation whatIsAPrimitive." - See Object documentation whatIsAPrimitive." <primitive: 112> + ^0! - ^ 0! Item was changed: ----- Method: SmalltalkImage>>primitiveGarbageCollect (in category 'memory space') ----- primitiveGarbageCollect + "Primitive. Reclaims all garbage and answers the size of the largest free chunk in old space.." - "Primitive. Reclaims all garbage and answers the number of bytes of available space." <primitive: 130> + ^self primitiveFailed! - ^ self primBytesLeft! Item was changed: ----- Method: SmalltalkImage>>recreateSpecialObjectsArray (in category 'special objects') ----- recreateSpecialObjectsArray "Smalltalk recreateSpecialObjectsArray" "To external package developers: **** DO NOT OVERRIDE THIS METHOD. ***** If you are writing a plugin and need additional special object(s) for your own use, use addGCRoot() function and use own, separate special objects registry " "The Special Objects Array is an array of objects used by the Squeak virtual machine. Its contents are critical and accesses to it by the VM are unchecked, so don't even think of playing here unless you know what you are doing." | newArray | + newArray := Array new: 60. - newArray := Array new: 58. "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 specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias". "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: BoxedFloat64. + newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]). + newArray at: 12 put: nil. "was BlockContext." - 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) ifNil: [Semaphore new]). "low space Semaphore" - 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. "This is the process signalling low space." "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. + Cog inlines table into machine code at: prim so do not regenerate it. + This is nil in Spur, which has immediate Characters." - Cog inlines table into machine code at: prim so do not regenerate it." newArray at: 25 put: (self specialObjectsArray at: 25). 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; an empty array in Spur" - "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) ifNil: [Semaphore new]). "delay Semaphore" + newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore" - newArray at: 30 put: (self specialObjectsArray at: 30). "(delay Semaphore)" - newArray at: 31 put: (self specialObjectsArray at: 31). "(user interrupt Semaphore)" "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization" + newArray at: 32 put: nil. "was the prototype Float" + newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger" + newArray at: 34 put: nil. "was the prototype Point" - newArray at: 32 put: nil. "was (Float new: 2)" - newArray at: 33 put: nil. "was (LargePositiveInteger new: 4)" - newArray at: 34 put: nil. "was Point new" newArray at: 35 put: #cannotInterpret:. + newArray at: 36 put: nil. "was the prototype MethodContext" - "Note: This must be fixed once we start using context prototypes (yeah, right)" - "(MethodContext new: CompiledMethod fullFrameSize)." - newArray at: 36 put: (self specialObjectsArray at: 36). "Is the prototype MethodContext (unused by the VM)" newArray at: 37 put: BlockClosure. + newArray at: 38 put: nil. "was the prototype BlockContext" - "(BlockContext new: CompiledMethod fullFrameSize)." - newArray at: 38 put: (self specialObjectsArray at: 38). "Is the prototype BlockContext (unused by the VM)" "array of objects referred to by external code" + newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores" - newArray at: 39 put: (self specialObjectsArray at: 39). "preserve external semaphores" newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs" + newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT" + newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore" - newArray at: 41 put: nil. "Reserved for a LinkedList instance for overlapped calls in CogMT" - "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:. "51 reserved for immutability message" + newArray at: 51 put: #attemptToAssign:withIndex:. - "newArray at: 51 put: #attemptToAssign:withIndex:." - newArray at: 51 put: (self specialObjectsArray at: 51 ifAbsent: []). newArray at: 52 put: #(nil "nil => generic error" #'bad receiver' #'bad argument' #'bad index' #'bad number of arguments' #'inappropriate operation' #'unsupported operation' #'no modification' #'insufficient object memory' #'insufficient C memory' #'not found' #'bad method' #'internal error in named primitive machinery' #'object may move' #'resource limit exceeded' + #'object is pinned' #'primitive write beyond end of object'). - #'object is pinned'). "53 to 55 are for Alien" newArray at: 53 put: (self at: #Alien ifAbsent: []). + newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks." - newArray at: 54 put: #invokeCallbackContext::. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks." newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []). + "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support." + newArray at: 56 put: nil. - "Weak reference finalization" - newArray at: 56 put: (self at: #WeakFinalizationList ifAbsent: []). "reserved for foreign callback process" newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []). newArray at: 58 put: #unusedBytecode. + "59 reserved for Sista counter tripped message" + newArray at: 59 put: #conditionalBranchCounterTrippedOn:. + "60 reserved for Sista class trap message" + newArray at: 60 put: #classTrapFor:. "Now replace the interpreter's reference in one atomic operation" + self specialObjectsArray becomeForward: newArray! - self specialObjectsArray becomeForward: newArray - ! Item was changed: ----- Method: SmalltalkImage>>setGCParameters (in category 'snapshot and quit') ----- setGCParameters + "Adjust the VM's default GC parameters to avoid too much tenuring. + Maybe this should be left to the VM?" - "Adjust the VM's default GC parameters to avoid premature tenuring." + | proportion edenSize survivorSize averageObjectSize numObjects | + proportion := 0.9. "tenure when 90% of pastSpace is full" + edenSize := SmalltalkImage current vmParameterAt: 44. + survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)" + averageObjectSize := 8 * self wordSize. "a good approximation" + numObjects := (proportion * survivorSize / averageObjectSize) rounded. + SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"! - self vmParameterAt: 5 put: 4000. "do an incremental GC after this many allocations" - self vmParameterAt: 6 put: 2000. "tenure when more than this many objects survive the GC" - ! Item was changed: ----- Method: SpaceTally>>spaceForInstancesOf: (in category 'instance size') ----- spaceForInstancesOf: aClass + "Answer a pair of the number of bytes consumed by all instances of the + given class, including their object headers, and the number of instances." - "Answer the number of bytes consumed by all instances of the given class, including their object headers and the number of instances." + | instances total | + instances := aClass allInstances. + instances isEmpty ifTrue: [^#(0 0)]. - | smallHeaderSize instVarBytes isVariable bytesPerElement total lastInstance instance instanceCount | - instance := aClass someInstance ifNil: [ ^#(0 0) ]. - smallHeaderSize := aClass isCompact ifTrue: [ 4 ] ifFalse: [ 8 ]. - instVarBytes := aClass instSize * 4. - isVariable := aClass isVariable. - bytesPerElement := isVariable - ifFalse: [ 0 ] - ifTrue: [ aClass isBytes ifTrue: [ 1 ] ifFalse: [ 4 ] ]. total := 0. + aClass isVariable + ifTrue: + [instances do: + [:i| total := total + (aClass byteSizeOfInstanceOfSize: i basicSize)]] + ifFalse: + [total := instances size * aClass byteSizeOfInstance]. + ^{ total. instances size }! - instanceCount := 0. - "A modified version of #allInstancesDo: is inlined here. It avoids an infinite loop when another process is creating new instances of aClass." - self flag: #allInstancesDo:. - lastInstance := - aClass == CompiledMethod "CompiledMethod has special format, see its class comment" - ifTrue: [aClass new] - ifFalse: [aClass basicNew]. - [ instance == lastInstance ] whileFalse: [ - | contentBytes headerBytes | - contentBytes := instVarBytes + (isVariable - ifFalse: [ 0 ] - ifTrue: [ instance basicSize * bytesPerElement ]). - headerBytes := contentBytes > 255 - ifTrue: [ 12 ] - ifFalse: [ smallHeaderSize ]. - total := total + headerBytes + (contentBytes roundUpTo: 4). - instanceCount := instanceCount + 1. - instance := instance nextInstance ]. - ^{ total. instanceCount }! Item was added: + ----- Method: SystemDictionary>>growMemoryByAtLeast: (in category 'memory space') ----- + growMemoryByAtLeast: numBytes + "Grow memory by at least the requested number of bytes. + Primitive. Fail if no memory is available. Essential." + <primitive: 180> + ^(numBytes isInteger and: [numBytes > 0]) + ifTrue: [OutOfMemory signal] + ifFalse: [self primitiveFailed]! Item was added: + ----- Method: SystemDictionary>>maxIdentityHash (in category 'system attributes') ----- + maxIdentityHash + "Answer the maximum identityHash value supported by the VM." + <primitive: 176> + ^self primitiveFailed! Item was added: + ----- Method: SystemDictionary>>setGCParameters (in category 'snapshot and quit') ----- + setGCParameters + "Adjust the VM's default GC parameters to avoid too much tenuring. + Maybe this should be left to the VM?" + + | proportion edenSize survivorSize averageObjectSize numObjects | + proportion := 0.9. "tenure when 90% of pastSpace is full" + edenSize := SmalltalkImage current vmParameterAt: 44. + survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)" + averageObjectSize := 8 * self wordSize. "a good approximation" + numObjects := (proportion * survivorSize / averageObjectSize) rounded. + SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"! Item was added: + ----- Method: SystemNavigation>>allObjects (in category 'query') ----- + allObjects + "Answer an Array of all objects in the system. Fail if + there isn't enough memory to instantiate the result." + <primitive: 178> + ^self primitiveFailed! Item was changed: ----- Method: SystemNavigation>>allObjectsDo: (in category 'query') ----- allObjectsDo: aBlock + "Evaluate the argument, aBlock, for each object in the system, excluding immediates + such as SmallInteger and Character." + self allObjectsOrNil + ifNotNil: [:allObjects| allObjects do: aBlock] + ifNil: + ["Fall back on the old single object primitive code. With closures, this needs + to use an end marker (lastObject) since activation of the block will create + new contexts and cause an infinite loop. The lastObject must be created + before calling someObject, so that the VM can settle the enumeration (e.g. + by flushing new space) as a side effect of someObject" + | object lastObject | + lastObject := Object new. + object := self someObject. + [lastObject == object or: [0 == object]] whileFalse: + [aBlock value: object. + object := object nextObject]]! - "Evaluate the argument, aBlock, for each object in the system - excluding SmallIntegers. With closures, this needs to use an end - marker (lastObject) since activation of the block will create new - contexts and cause an infinite loop." - | object lastObject | - object := self someObject. - lastObject := Object new. - [lastObject == object or: [0 == object]] - whileFalse: [aBlock value: object. - object := object nextObject]! Item was added: + ----- Method: SystemNavigation>>allObjectsOrNil (in category 'query') ----- + allObjectsOrNil + "Answer an Array of all objects in the system. Fail if there isn't + enough memory to instantiate the result and answer nil." + <primitive: 178> + ^nil!

1 0

The Trunk: Compiler.spur-eem.300.mcz
by commits＠source.squeak.org 30 May '15

30 May '15

Eliot Miranda uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler.spur-eem.300.mcz ==================== Summary ==================== Name: Compiler.spur-eem.300 Author: eem Time: 29 May 2015, 4:28:02.94 pm UUID: 876db460-d55d-4dd8-8f53-3e78f6492e39 Ancestors: Compiler-eem.300, Compiler.spur-eem.299 Compiler-eem.300 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.267 Use the size/emitPushNClosureTemps: api in block generation. =============== Diff against Compiler-eem.300 =============== Item was changed: ----- Method: BytecodeEncoder>>computeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method generation') ----- computeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex + numArgs > 15 ifTrue: + [^self error: 'Cannot compile -- too many arguments']. + numTemps > 63 ifTrue: + [^self error: 'Cannot compile -- too many temporary variables']. + numLits > 65535 ifTrue: + [^self error: 'Cannot compile -- too many literals']. + ^(CompiledMethod headerFlagForEncoder: self) + + (numArgs bitShift: 24) + + (numTemps bitShift: 18) + "+ (largeBit bitShift: 17)" "largeBit gets filled in later" + + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0]) + + numLits! - "Compute the compiled method header that encodes the arguments - in the receiver's header format (see CompiledMehtod's class comment)." - self subclassResponsibility! Item was removed: - ----- Method: EncoderForV3>>computeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method generation') ----- - computeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex - | primBits | - numTemps > 63 ifTrue: - [^self error: 'Cannot compile -- too many temporary variables']. - numLits > 255 ifTrue: - [^self error: 'Cannot compile -- too many literals']. - primBits := primitiveIndex <= 16r1FF - ifTrue: [primitiveIndex] - ifFalse: "For now the high bit of primitive no. is in the 29th bit of header" - [primitiveIndex > 16r3FF ifTrue: [self error: 'prim num too large']. - (primitiveIndex bitAnd: 16r1FF) + ((primitiveIndex bitAnd: 16r200) bitShift: 19)]. - ^(numArgs bitShift: 24) - + (numTemps bitShift: 18) - "+ (largeBit bitShift: 17)" "largeBit gets filled in later" - + (numLits bitShift: 9) - + primBits! Item was changed: ----- Method: EncoderForV3PlusClosures class>>bytecodeSize: (in category 'instruction stream support') ----- bytecodeSize: bytecode "Answer the number of bytes in the bytecode." bytecode <= 125 ifTrue: [^1]. bytecode >= 176 ifTrue: [^1]. bytecode >= 160 ifTrue: "long jumps" [^2]. bytecode >= 144 ifTrue: "short jumps" [^1]. "extensions" bytecode >= 128 ifTrue: + [^#(2 2 2 2 3 2 2 1 1 1 2 3 3 3 3 4) at: bytecode - 127]. - [^#(2 2 2 2 3 2 2 1 1 1 2 nil 3 3 3 4) at: bytecode - 127]. ^nil! Item was added: + ----- Method: EncoderForV3PlusClosures class>>callPrimitiveCode (in category 'bytecode decoding') ----- + callPrimitiveCode + "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)" + ^139! Item was added: + ----- Method: EncoderForV3PlusClosures>>genCallPrimitive: (in category 'bytecode generation') ----- + genCallPrimitive: primitiveIndex + "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)" + (primitiveIndex < 1 or: [primitiveIndex > 65535]) ifTrue: + [self outOfRangeError: 'primitive index' index: primitiveIndex range: 1 to: 65535]. + stream + nextPut: 139; + nextPut: (primitiveIndex bitAnd: 255); + nextPut: (primitiveIndex bitShift: -8)! Item was changed: ----- Method: MethodNode>>generate:using: (in category 'code generation') ----- generate: trailer using: aCompiledMethodClass "The receiver is the root of a parse tree. Answer an instance of aCompiledMethodClass. The argument, trailer, is arbitrary but is typically either the reference to the source code that is stored with every CompiledMethod, or an encoding of the method's temporary names." + | primErrNode blkSize nLits locals literals stack header method | - | primErrNode blkSize nLits literals stack method | self generate: trailer using: aCompiledMethodClass ifQuick: [:m | encoder noteBlockExtent: (0 to: 2) hasLocals: arguments. m literalAt: 2 put: encoder associationForClass; properties: properties. ^m]. primErrNode := self primitiveErrorVariableName ifNotNil: [encoder fixTemp: self primitiveErrorVariableName]. + self ensureClosureAnalysisDone. + encoder rootNode: self. "this is for BlockNode>>sizeCodeForClosureValue:" - encoder supportsClosureOpcodes ifTrue: - [self ensureClosureAnalysisDone. - encoder rootNode: self. "this is for BlockNode>>sizeCodeForClosureValue:"]. blkSize := (block sizeCodeForEvaluatedValue: encoder) + + (primitive > 0 + ifTrue: [encoder sizeCallPrimitive: primitive] + ifFalse: [0]) + (primErrNode ifNil: [0] ifNotNil: [primErrNode index: arguments size + temporaries size; sizeCodeForStore: encoder "The VM relies on storeIntoTemp: (129)"]). + locals := arguments, temporaries, (primErrNode ifNil: [#()] ifNotNil: [{primErrNode}]). + encoder noteBlockExtent: block blockExtent hasLocals: locals. + header := encoder computeMethodHeaderForNumArgs: arguments size + numTemps: locals size + numLits: (nLits := (literals := encoder allLiterals) size) + primitive: primitive. + method := trailer + createMethod: blkSize + class: aCompiledMethodClass + header: header. - method := aCompiledMethodClass - newBytes: blkSize - trailerBytes: trailer - nArgs: arguments size - nTemps: (encoder supportsClosureOpcodes - ifTrue: [| locals | - locals := arguments, - temporaries, - (primErrNode - ifNil: [#()] - ifNotNil: [{primErrNode}]). - encoder - noteBlockExtent: block blockExtent - hasLocals: locals. - locals size] - ifFalse: [encoder maxTemp]) - nStack: 0 - nLits: (nLits := (literals := encoder allLiterals) size) - primitive: primitive. - nLits > 255 ifTrue: - [^self error: 'Too many literals referenced']. 1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)]. encoder streamToMethod: method. stack := ParseStack new init. + primitive > 0 ifTrue: + [encoder genCallPrimitive: primitive. + primErrNode ifNotNil: + [primErrNode emitCodeForStore: stack encoder: encoder]]. - primErrNode ifNotNil: [primErrNode emitCodeForStore: stack encoder: encoder]. stack position: method numTemps. [block emitCodeForEvaluatedValue: stack encoder: encoder] on: Error "If an attempt is made to write too much code the method will be asked" do: [:ex| "to grow, and the grow attempt will fail in CompiledMethod class>>#new:" ex signalerContext sender method = (CompiledMethod class>>#new:) ifTrue: [^self error: 'Compiler code size discrepancy'] ifFalse: [ex pass]]. stack position ~= (method numTemps + 1) ifTrue: [^self error: 'Compiler stack discrepancy']. encoder methodStreamPosition ~= (method size - trailer size) ifTrue: [^self error: 'Compiler code size discrepancy']. method needsFrameSize: stack size - method numTemps. method properties: properties. ^method!

1 0

The Trunk: Compiler.spur-eem.299.mcz
by commits＠source.squeak.org 30 May '15

30 May '15

Eliot Miranda uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler.spur-eem.299.mcz ==================== Summary ==================== Name: Compiler.spur-eem.299 Author: eem Time: 29 May 2015, 4:27:59.664 pm UUID: 85f293a2-b374-4879-971a-049a9dbb1ff9 Ancestors: Compiler-eem.299, Compiler.spur-eem.298 Compiler-eem.299 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.267 Provide support for a specialized pushNClosureTemps: bytecode, as included in the Sista bytecode set. =============== Diff against Compiler-eem.299 =============== Item was changed: ----- Method: BytecodeEncoder>>computeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method generation') ----- computeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex + numArgs > 15 ifTrue: + [^self error: 'Cannot compile -- too many arguments']. + numTemps > 63 ifTrue: + [^self error: 'Cannot compile -- too many temporary variables']. + numLits > 65535 ifTrue: + [^self error: 'Cannot compile -- too many literals']. + ^(CompiledMethod headerFlagForEncoder: self) + + (numArgs bitShift: 24) + + (numTemps bitShift: 18) + "+ (largeBit bitShift: 17)" "largeBit gets filled in later" + + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0]) + + numLits! - "Compute the compiled method header that encodes the arguments - in the receiver's header format (see CompiledMehtod's class comment)." - self subclassResponsibility! Item was removed: - ----- Method: EncoderForV3>>computeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method generation') ----- - computeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex - | primBits | - numTemps > 63 ifTrue: - [^self error: 'Cannot compile -- too many temporary variables']. - numLits > 255 ifTrue: - [^self error: 'Cannot compile -- too many literals']. - primBits := primitiveIndex <= 16r1FF - ifTrue: [primitiveIndex] - ifFalse: "For now the high bit of primitive no. is in the 29th bit of header" - [primitiveIndex > 16r3FF ifTrue: [self error: 'prim num too large']. - (primitiveIndex bitAnd: 16r1FF) + ((primitiveIndex bitAnd: 16r200) bitShift: 19)]. - ^(numArgs bitShift: 24) - + (numTemps bitShift: 18) - "+ (largeBit bitShift: 17)" "largeBit gets filled in later" - + (numLits bitShift: 9) - + primBits! Item was changed: ----- Method: EncoderForV3PlusClosures class>>bytecodeSize: (in category 'instruction stream support') ----- bytecodeSize: bytecode "Answer the number of bytes in the bytecode." bytecode <= 125 ifTrue: [^1]. bytecode >= 176 ifTrue: [^1]. bytecode >= 160 ifTrue: "long jumps" [^2]. bytecode >= 144 ifTrue: "short jumps" [^1]. "extensions" bytecode >= 128 ifTrue: + [^#(2 2 2 2 3 2 2 1 1 1 2 3 3 3 3 4) at: bytecode - 127]. - [^#(2 2 2 2 3 2 2 1 1 1 2 nil 3 3 3 4) at: bytecode - 127]. ^nil! Item was added: + ----- Method: EncoderForV3PlusClosures class>>callPrimitiveCode (in category 'bytecode decoding') ----- + callPrimitiveCode + "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)" + ^139! Item was added: + ----- Method: EncoderForV3PlusClosures>>genCallPrimitive: (in category 'bytecode generation') ----- + genCallPrimitive: primitiveIndex + "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)" + (primitiveIndex < 1 or: [primitiveIndex > 65535]) ifTrue: + [self outOfRangeError: 'primitive index' index: primitiveIndex range: 1 to: 65535]. + stream + nextPut: 139; + nextPut: (primitiveIndex bitAnd: 255); + nextPut: (primitiveIndex bitShift: -8)! Item was changed: ----- Method: MethodNode>>generate:using: (in category 'code generation') ----- generate: trailer using: aCompiledMethodClass "The receiver is the root of a parse tree. Answer an instance of aCompiledMethodClass. The argument, trailer, is arbitrary but is typically either the reference to the source code that is stored with every CompiledMethod, or an encoding of the method's temporary names." + | primErrNode blkSize nLits locals literals stack header method | - | primErrNode blkSize nLits literals stack method | self generate: trailer using: aCompiledMethodClass ifQuick: [:m | encoder noteBlockExtent: (0 to: 2) hasLocals: arguments. m literalAt: 2 put: encoder associationForClass; properties: properties. ^m]. primErrNode := self primitiveErrorVariableName ifNotNil: [encoder fixTemp: self primitiveErrorVariableName]. + self ensureClosureAnalysisDone. + encoder rootNode: self. "this is for BlockNode>>sizeCodeForClosureValue:" - encoder supportsClosureOpcodes ifTrue: - [self ensureClosureAnalysisDone. - encoder rootNode: self. "this is for BlockNode>>sizeCodeForClosureValue:"]. blkSize := (block sizeCodeForEvaluatedValue: encoder) + + (primitive > 0 + ifTrue: [encoder sizeCallPrimitive: primitive] + ifFalse: [0]) + (primErrNode ifNil: [0] ifNotNil: [primErrNode index: arguments size + temporaries size; sizeCodeForStore: encoder "The VM relies on storeIntoTemp: (129)"]). + locals := arguments, temporaries, (primErrNode ifNil: [#()] ifNotNil: [{primErrNode}]). + encoder noteBlockExtent: block blockExtent hasLocals: locals. + header := encoder computeMethodHeaderForNumArgs: arguments size + numTemps: locals size + numLits: (nLits := (literals := encoder allLiterals) size) + primitive: primitive. + method := trailer + createMethod: blkSize + class: aCompiledMethodClass + header: header. - method := aCompiledMethodClass - newBytes: blkSize - trailerBytes: trailer - nArgs: arguments size - nTemps: (encoder supportsClosureOpcodes - ifTrue: [| locals | - locals := arguments, - temporaries, - (primErrNode - ifNil: [#()] - ifNotNil: [{primErrNode}]). - encoder - noteBlockExtent: block blockExtent - hasLocals: locals. - locals size] - ifFalse: [encoder maxTemp]) - nStack: 0 - nLits: (nLits := (literals := encoder allLiterals) size) - primitive: primitive. - nLits > 255 ifTrue: - [^self error: 'Too many literals referenced']. 1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)]. encoder streamToMethod: method. stack := ParseStack new init. + primitive > 0 ifTrue: + [encoder genCallPrimitive: primitive. + primErrNode ifNotNil: + [primErrNode emitCodeForStore: stack encoder: encoder]]. - primErrNode ifNotNil: [primErrNode emitCodeForStore: stack encoder: encoder]. stack position: method numTemps. [block emitCodeForEvaluatedValue: stack encoder: encoder] on: Error "If an attempt is made to write too much code the method will be asked" do: [:ex| "to grow, and the grow attempt will fail in CompiledMethod class>>#new:" ex signalerContext sender method = (CompiledMethod class>>#new:) ifTrue: [^self error: 'Compiler code size discrepancy'] ifFalse: [ex pass]]. stack position ~= (method numTemps + 1) ifTrue: [^self error: 'Compiler stack discrepancy']. encoder methodStreamPosition ~= (method size - trailer size) ifTrue: [^self error: 'Compiler code size discrepancy']. method needsFrameSize: stack size - method numTemps. method properties: properties. ^method!

1 0

The Trunk: Collections.spur-eem.636.mcz
by commits＠source.squeak.org 30 May '15

30 May '15

Eliot Miranda uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections.spur-eem.636.mcz ==================== Summary ==================== Name: Collections.spur-eem.636 Author: eem Time: 29 May 2015, 4:26:29.424 pm UUID: b341b330-e1ef-455e-9880-7b782cc4f014 Ancestors: Collections-eem.636, Collections.spur-mt.635 Collections-eem.636 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.267 findLast:startingAt: dual for findFirst:startingAt: =============== Diff against Collections-eem.636 =============== Item was changed: ----- Method: Array>>elementsExchangeIdentityWith: (in category 'converting') ----- elementsExchangeIdentityWith: otherArray + "This primitive performs a bulk mutation, causing all pointers to the elements of the + receiver to be replaced by pointers to the corresponding elements of otherArray. + At the same time, all pointers to the elements of otherArray are replaced by + pointers to the corresponding elements of this array. The identityHashes remain + with the pointers rather than with the objects so that objects in hashed structures + should still be properly indexed after the mutation." - "This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray. At the same time, all pointers to the elements of otherArray are replaced by pointers to the corresponding elements of this array. The identityHashes remain with the pointers rather than with the objects so that objects in hashed structures should still be properly indexed after the mutation." + <primitive: 128 error: ec> + ec == #'bad receiver' ifTrue: + [^self error: 'receiver must be of class Array']. + ec == #'bad argument' ifTrue: + [^self error: (otherArray class == Array + ifTrue: ['arg must be of class Array'] + ifFalse: ['receiver and argument must have the same size'])]. + ec == #'inappropriate operation' ifTrue: + [^self error: 'can''t become immediates such as SmallIntegers or Characters']. + ec == #'no modification' ifTrue: + [^self error: 'can''t become immutable objects']. + ec == #'object is pinned' ifTrue: + [^self error: 'can''t become pinned objects']. + ec == #'insufficient object memory' ifTrue: + [Smalltalk garbageCollect < 1048576 ifTrue: + [Smalltalk growMemoryByAtLeast: 1048576]. + ^self elementsExchangeIdentityWith: otherArray]. + self primitiveFailed! - <primitive: 128> - otherArray class == Array ifFalse: [^ self error: 'arg must be array']. - self size = otherArray size ifFalse: [^ self error: 'arrays must be same size']. - (self anySatisfy: [:obj | obj class == SmallInteger]) ifTrue: [^ self error: 'can''t become SmallIntegers']. - (otherArray anySatisfy: [:obj | obj class == SmallInteger]) ifTrue: [^ self error: 'can''t become SmallIntegers']. - self with: otherArray do:[:a :b| a == b ifTrue:[^self error:'can''t become yourself']]. - - "Must have failed because not enough space in forwarding table (see ObjectMemory-prepareForwardingTableForBecoming:with:twoWay:). Do GC and try again only once" - (Smalltalk bytesLeft: true) = Smalltalk primitiveGarbageCollect - ifTrue: [^ self primitiveFailed]. - ^ self elementsExchangeIdentityWith: otherArray! Item was changed: ----- Method: Array>>elementsForwardIdentityTo: (in category 'converting') ----- elementsForwardIdentityTo: otherArray + "This primitive performs a bulk mutation, causing all pointers to the elements of the + receiver to be replaced by pointers to the corresponding elements of otherArray. + The identityHashes remain with the pointers rather than with the objects so that + the objects in this array should still be properly indexed in any existing hashed + structures after the mutation." + <primitive: 72 error: ec> - "This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray. The identityHashes remain with the pointers rather than with the objects so that the objects in this array should still be properly indexed in any existing hashed structures after the mutation." - <primitive: 72> self primitiveFailed! Item was changed: ----- Method: Array>>elementsForwardIdentityTo:copyHash: (in category 'converting') ----- elementsForwardIdentityTo: otherArray copyHash: copyHash + "This primitive performs a bulk mutation, causing all pointers to the elements of the + receiver to be replaced by pointers to the corresponding elements of otherArray. + If copyHash is true, the identityHashes remain with the pointers rather than with the + objects so that the objects in the receiver should still be properly indexed in any + existing hashed structures after the mutation. If copyHash is false, then the hashes + of the objects in otherArray remain unchanged. If you know what you're doing this + may indeed be what you want." + <primitive: 249 error: ec> - "This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray. The identityHashes remain with the pointers rather than with the objects so that the objects in this array should still be properly indexed in any existing hashed structures after the mutation." - <primitive: 249> self primitiveFailed! Item was changed: ==== ERROR === Error: Unrecognized class type 29 May 2015 11:29:12.996 pm VM: unix - a SmalltalkImage Image: Squeak3.11alpha [latest update: #8824] SecurityManager state: Restricted: false FileAccess: true SocketAccess: true Working Dir /home/squeaksource Trusted Dir /home/squeaksource/secure Untrusted Dir /home/squeaksource/My Squeak MCClassDefinition(Object)>>error: Receiver: a MCClassDefinition(Character) Arguments and temporary variables: aString: 'Unrecognized class type' Receiver's instance variables: name: #Character superclassName: #Magnitude variables: an OrderedCollection(a MCClassVariableDefinition(AlphaNumericMask) a...etc... category: #'Collections-Strings' type: #immediate comment: 'I represent a character by storing its associated Unicode as an unsig...etc... commentStamp: 'eem 8/12/2014 14:53' traitComposition: nil classTraitComposition: nil MCClassDefinition>>kindOfSubclass Receiver: a MCClassDefinition(Character) Arguments and temporary variables: Receiver's instance variables: name: #Character superclassName: #Magnitude variables: an OrderedCollection(a MCClassVariableDefinition(AlphaNumericMask) a...etc... category: #'Collections-Strings' type: #immediate comment: 'I represent a character by storing its associated Unicode as an unsig...etc... commentStamp: 'eem 8/12/2014 14:53' traitComposition: nil classTraitComposition: nil MCClassDefinition>>printDefinitionOn: Receiver: a MCClassDefinition(Character) Arguments and temporary variables: stream: a WriteStream Receiver's instance variables: name: #Character superclassName: #Magnitude variables: an OrderedCollection(a MCClassVariableDefinition(AlphaNumericMask) a...etc... category: #'Collections-Strings' type: #immediate comment: 'I represent a character by storing its associated Unicode as an unsig...etc... commentStamp: 'eem 8/12/2014 14:53' traitComposition: nil classTraitComposition: nil [] in MCDiffyTextWriter(MCStWriter)>>writeClassDefinition: Receiver: a MCDiffyTextWriter Arguments and temporary variables: definition: a WriteStream s: a MCClassDefinition(Character) Receiver's instance variables: stream: a WriteStream initStream: nil --- The full stack --- MCClassDefinition(Object)>>error: MCClassDefinition>>kindOfSubclass MCClassDefinition>>printDefinitionOn: [] in MCDiffyTextWriter(MCStWriter)>>writeClassDefinition: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - String class(SequenceableCollection class)>>new:streamContents: String class(SequenceableCollection class)>>streamContents: MCDiffyTextWriter(MCTextWriter)>>chunkContents: MCDiffyTextWriter(MCStWriter)>>writeClassDefinition: MCDiffyTextWriter(MCStWriter)>>visitClassDefinition: MCClassDefinition>>accept: [] in MCDiffyTextWriter(MCTextWriter)>>visitInFork: String class(SequenceableCollection class)>>new:streamContents: String class(SequenceableCollection class)>>streamContents: MCDiffyTextWriter(MCTextWriter)>>visitInFork: MCDiffyTextWriter>>writePatchFrom:to: MCDiffyTextWriter>>writeModification: [] in MCDiffyTextWriter>>writePatch: SortedCollection(OrderedCollection)>>do: MCDiffyTextWriter>>writePatch: SSDiffyTextWriter>>writePatch: [] in SSDiffyTextWriter>>writeVersion:for: BlockClosure>>on:do: SSDiffyTextWriter>>writeVersion:for: [] in SSEMailSubscription>>versionAdded:to: BlockClosure>>on:do: SSEMailSubscription>>versionAdded:to: [] in [] in SSProject>>versionAdded: [] in BlockClosure>>newProcess

1 0

The Trunk: Compiler.spur-eem.298.mcz
by commits＠source.squeak.org 30 May '15

30 May '15

Eliot Miranda uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler.spur-eem.298.mcz ==================== Summary ==================== Name: Compiler.spur-eem.298 Author: eem Time: 29 May 2015, 4:27:51.392 pm UUID: 929039ad-58e2-40e1-82c9-887b6df58153 Ancestors: Compiler-eem.298, Compiler.spur-cmm.297 Compiler-eem.298 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.267 Provide multiple-bytecode-sets aware support for markerOrNil =============== Diff against Compiler-eem.298 =============== Item was changed: ----- Method: BytecodeEncoder>>computeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method generation') ----- computeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex + numArgs > 15 ifTrue: + [^self error: 'Cannot compile -- too many arguments']. + numTemps > 63 ifTrue: + [^self error: 'Cannot compile -- too many temporary variables']. + numLits > 65535 ifTrue: + [^self error: 'Cannot compile -- too many literals']. + ^(CompiledMethod headerFlagForEncoder: self) + + (numArgs bitShift: 24) + + (numTemps bitShift: 18) + "+ (largeBit bitShift: 17)" "largeBit gets filled in later" + + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0]) + + numLits! - "Compute the compiled method header that encodes the arguments - in the receiver's header format (see CompiledMehtod's class comment)." - self subclassResponsibility! Item was removed: - ----- Method: EncoderForV3>>computeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method generation') ----- - computeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex - | primBits | - numTemps > 63 ifTrue: - [^self error: 'Cannot compile -- too many temporary variables']. - numLits > 255 ifTrue: - [^self error: 'Cannot compile -- too many literals']. - primBits := primitiveIndex <= 16r1FF - ifTrue: [primitiveIndex] - ifFalse: "For now the high bit of primitive no. is in the 29th bit of header" - [primitiveIndex > 16r3FF ifTrue: [self error: 'prim num too large']. - (primitiveIndex bitAnd: 16r1FF) + ((primitiveIndex bitAnd: 16r200) bitShift: 19)]. - ^(numArgs bitShift: 24) - + (numTemps bitShift: 18) - "+ (largeBit bitShift: 17)" "largeBit gets filled in later" - + (numLits bitShift: 9) - + primBits! Item was changed: ----- Method: EncoderForV3PlusClosures class>>bytecodeSize: (in category 'instruction stream support') ----- bytecodeSize: bytecode "Answer the number of bytes in the bytecode." bytecode <= 125 ifTrue: [^1]. bytecode >= 176 ifTrue: [^1]. bytecode >= 160 ifTrue: "long jumps" [^2]. bytecode >= 144 ifTrue: "short jumps" [^1]. "extensions" bytecode >= 128 ifTrue: + [^#(2 2 2 2 3 2 2 1 1 1 2 3 3 3 3 4) at: bytecode - 127]. - [^#(2 2 2 2 3 2 2 1 1 1 2 nil 3 3 3 4) at: bytecode - 127]. ^nil! Item was added: + ----- Method: EncoderForV3PlusClosures class>>callPrimitiveCode (in category 'bytecode decoding') ----- + callPrimitiveCode + "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)" + ^139! Item was added: + ----- Method: EncoderForV3PlusClosures>>genCallPrimitive: (in category 'bytecode generation') ----- + genCallPrimitive: primitiveIndex + "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)" + (primitiveIndex < 1 or: [primitiveIndex > 65535]) ifTrue: + [self outOfRangeError: 'primitive index' index: primitiveIndex range: 1 to: 65535]. + stream + nextPut: 139; + nextPut: (primitiveIndex bitAnd: 255); + nextPut: (primitiveIndex bitShift: -8)! Item was changed: ----- Method: MethodNode>>generate:using: (in category 'code generation') ----- generate: trailer using: aCompiledMethodClass "The receiver is the root of a parse tree. Answer an instance of aCompiledMethodClass. The argument, trailer, is arbitrary but is typically either the reference to the source code that is stored with every CompiledMethod, or an encoding of the method's temporary names." + | primErrNode blkSize nLits locals literals stack header method | - | primErrNode blkSize nLits literals stack method | self generate: trailer using: aCompiledMethodClass ifQuick: [:m | encoder noteBlockExtent: (0 to: 2) hasLocals: arguments. m literalAt: 2 put: encoder associationForClass; properties: properties. ^m]. primErrNode := self primitiveErrorVariableName ifNotNil: [encoder fixTemp: self primitiveErrorVariableName]. + self ensureClosureAnalysisDone. + encoder rootNode: self. "this is for BlockNode>>sizeCodeForClosureValue:" - encoder supportsClosureOpcodes ifTrue: - [self ensureClosureAnalysisDone. - encoder rootNode: self. "this is for BlockNode>>sizeCodeForClosureValue:"]. blkSize := (block sizeCodeForEvaluatedValue: encoder) + + (primitive > 0 + ifTrue: [encoder sizeCallPrimitive: primitive] + ifFalse: [0]) + (primErrNode ifNil: [0] ifNotNil: [primErrNode index: arguments size + temporaries size; sizeCodeForStore: encoder "The VM relies on storeIntoTemp: (129)"]). + locals := arguments, temporaries, (primErrNode ifNil: [#()] ifNotNil: [{primErrNode}]). + encoder noteBlockExtent: block blockExtent hasLocals: locals. + header := encoder computeMethodHeaderForNumArgs: arguments size + numTemps: locals size + numLits: (nLits := (literals := encoder allLiterals) size) + primitive: primitive. + method := trailer + createMethod: blkSize + class: aCompiledMethodClass + header: header. - method := aCompiledMethodClass - newBytes: blkSize - trailerBytes: trailer - nArgs: arguments size - nTemps: (encoder supportsClosureOpcodes - ifTrue: [| locals | - locals := arguments, - temporaries, - (primErrNode - ifNil: [#()] - ifNotNil: [{primErrNode}]). - encoder - noteBlockExtent: block blockExtent - hasLocals: locals. - locals size] - ifFalse: [encoder maxTemp]) - nStack: 0 - nLits: (nLits := (literals := encoder allLiterals) size) - primitive: primitive. - nLits > 255 ifTrue: - [^self error: 'Too many literals referenced']. 1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)]. encoder streamToMethod: method. stack := ParseStack new init. + primitive > 0 ifTrue: + [encoder genCallPrimitive: primitive. + primErrNode ifNotNil: + [primErrNode emitCodeForStore: stack encoder: encoder]]. - primErrNode ifNotNil: [primErrNode emitCodeForStore: stack encoder: encoder]. stack position: method numTemps. [block emitCodeForEvaluatedValue: stack encoder: encoder] on: Error "If an attempt is made to write too much code the method will be asked" do: [:ex| "to grow, and the grow attempt will fail in CompiledMethod class>>#new:" ex signalerContext sender method = (CompiledMethod class>>#new:) ifTrue: [^self error: 'Compiler code size discrepancy'] ifFalse: [ex pass]]. stack position ~= (method numTemps + 1) ifTrue: [^self error: 'Compiler stack discrepancy']. encoder methodStreamPosition ~= (method size - trailer size) ifTrue: [^self error: 'Compiler code size discrepancy']. method needsFrameSize: stack size - method numTemps. method properties: properties. ^method!

1 0

The Trunk: System-eem.740.mcz
by commits＠source.squeak.org 30 May '15

30 May '15

Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-eem.740.mcz ==================== Summary ==================== Name: System-eem.740 Author: eem Time: 29 May 2015, 4:09:46.189 pm UUID: 53894fe9-e3f5-44c7-b4c2-101e4d72f0d3 Ancestors: System-eem.739 Modify condensSources to preserve direct method history. =============== Diff against System-eem.739 =============== Item was changed: ----- Method: SmalltalkImage>>condenseSources (in category 'housekeeping') ----- condenseSources "Move all the changes onto a compacted sources file." "Smalltalk condenseSources" | newSourcesFile defaultDirectory newVersion currentVersion | Utilities fixUpProblemsWithAllCategory. "The above removes any concrete, spurious '-- all --' categories, which mess up the process." defaultDirectory := FileDirectory default. currentVersion := self sourceFileVersionString. newVersion := UIManager default request: 'Please designate the version\for the new source code file...' withCRs initialAnswer: currentVersion. newVersion ifEmpty: [ ^ self ]. newVersion = currentVersion ifTrue: [ ^ self error: 'The new source file must not be the same as the old.' ]. self sourceFileVersionString: newVersion. "Write all sources with fileIndex 1" newSourcesFile := defaultDirectory newFileNamed: (defaultDirectory localNameFor: self sourcesName). newSourcesFile ifNil: [ ^ self error: 'Couldn''t create source code file in\' withCRs, defaultDirectory name]. newSourcesFile header; timeStamp. 'Condensing Sources File...' displayProgressFrom: 0 to: self classNames size + self traitNames size during: [ :bar | | count | count := 0. Smalltalk allClassesAndTraitsDo: [ :classOrTrait | bar value: (count := count + 1). classOrTrait fileOutOn: newSourcesFile + moveSource: #historically - moveSource: true toFile: 1 ] ]. newSourcesFile trailer; close. "Make a new empty changes file" self closeSourceFiles. defaultDirectory rename: self changesName toBe: self changesName , '.old'. (FileStream newFileNamed: self changesName) header; timeStamp; close. self lastQuitLogPosition: 0. self setMacFileInfoOn: self changesName. self setMacFileInfoOn: newSourcesFile name. self openSourceFiles. self inform: 'Source files have been rewritten to\' withCRs, newSourcesFile name, '\Check that all is well,\and then save/quit.' withCRs!

1 0

The Trunk: Kernel-eem.928.mcz
by commits＠source.squeak.org 30 May '15

30 May '15

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.928.mcz ==================== Summary ==================== Name: Kernel-eem.928 Author: eem Time: 29 May 2015, 4:08:39.106 pm UUID: 42550ae5-1cf6-41e1-8e22-93b7ad2a6166 Ancestors: Kernel-eem.927 Modify condenseChanges to preserve direct method history. =============== Diff against Kernel-eem.927 =============== Item was changed: ----- Method: ClassDescription>>moveChangesTo: (in category 'fileIn/Out') ----- moveChangesTo: newFile "Used in the process of condensing changes, this message requests that the source code of all methods of the receiver that have been changed should be moved to newFile." | changes | changes := self methodDict keys select: [:sel | (self compiledMethodAt: sel) fileIndex > 1]. self fileOutChangedMessages: changes on: newFile + moveSource: #historically - moveSource: true toFile: 2!

1 0

The Trunk: System-eem.739.mcz
by commits＠source.squeak.org 30 May '15

30 May '15

Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-eem.739.mcz ==================== Summary ==================== Name: System-eem.739 Author: eem Time: 29 May 2015, 4:06:02.935 pm UUID: 0b6049b8-02b1-4f6e-97eb-8776c9604f3e Ancestors: System-cmm.738 Support for condensing sources and changes while preserving direct history. =============== Diff against System-cmm.738 =============== Item was added: + ----- Method: ChangeRecord>>file (in category 'access') ----- + file + ^file! Item was added: + ----- Method: ChangeRecord>>position: (in category 'access') ----- + position: anInteger + "Set the position. Dangerous!! Used in condenseChanges implementation by a very knowledgeable client!!" + position := anInteger! Item was added: + ----- Method: ChangeSet class>>directAncestryOfVersions: (in category 'scanning') ----- + directAncestryOfVersions: changeRecords + "Take a sequence of ChangeRecords as answered by scanVersionsOf:class:meta:category:selector: + and answer a filtered subsequence consisting only of direct ancestors. For example, if the input is + eem 7/7/2009 20:06 7 July 2009 8:06 pm + eem 6/18/2009 19:21 18 June 2009 7:21 pm + eem 5/5/2009 12:16 5 May 2009 12:16 pm + eem 6/18/2009 19:19 18 June 2009 7:19 pm + eem 6/18/2009 18:57 18 June 2009 6:57 pm + eem 5/5/2009 12:16 5 May 2009 12:16 pm + eem 6/18/2009 18:17 18 June 2009 6:17 pm + eem 6/18/2009 18:14 18 June 2009 6:14 pm + eem 6/18/2009 18:06 18 June 2009 6:06 pm + eem 5/5/2009 12:16 5 May 2009 12:16 pm + eem 5/4/2009 19:19 4 May 2009 7:19 pm + the output should be + eem 7/7/2009 20:06 7 July 2009 8:06 pm + eem 6/18/2009 19:21 18 June 2009 7:21 pm + eem 5/5/2009 12:16 5 May 2009 12:16 pm + eem 5/4/2009 19:19 4 May 2009 7:19 pm" + + | filtered i last | + filtered := OrderedCollection new. + i := 1. + [i <= changeRecords size] whileTrue: + [filtered addLast: (changeRecords at: i). + last := changeRecords + findLast: [:chgRec| filtered last stamp = chgRec stamp and: [filtered last position = chgRec position]] + startingAt: i. + i := last = 0 ifTrue: [i + 1] ifFalse: [last + 1]]. + ^filtered!

1 0

The Trunk: Kernel-eem.927.mcz
by commits＠source.squeak.org 30 May '15

30 May '15

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.927.mcz ==================== Summary ==================== Name: Kernel-eem.927 Author: eem Time: 29 May 2015, 4:04:53.411 pm UUID: b759de23-0d29-460f-94ba-69d3ee900124 Ancestors: Kernel-eem.926 Support for condensing sources and changes while preserving direct history. =============== Diff against Kernel-eem.926 =============== Item was added: + ----- Method: ClassDescription>>fileOutCategoryHistorically:on:moveSource:toFile: (in category 'fileIn/Out') ----- + fileOutCategoryHistorically: aSymbol on: aFileStream moveSource: moveSource toFile: fileIndex + "File a description of the receiver's category, aString, onto aFileStream, preserving direct + history, but excluding branches . If moveSource, is true, then set the method source pointer + to the new file position. Note when this method is called with moveSource=true, it is + condensing the sources file, and should only write one preamble per method category." + + | selectors | + aFileStream cr. + selectors := aSymbol asString = ClassOrganizer allCategory + ifTrue: [self organization allMethodSelectors] + ifFalse: [self organization listAtCategoryNamed: aSymbol]. + + selectors := selectors select: [:each | self includesLocalSelector: each]. + + "Overridden to preserve author stamps in sources file regardless." + selectors do: [:sel | + self printMethodChunkHistorically: sel + on: aFileStream + moveSource: moveSource + toFile: fileIndex]! Item was changed: ----- Method: ClassDescription>>fileOutChangedMessages:on:moveSource:toFile: (in category 'fileIn/Out') ----- fileOutChangedMessages: aSet on: aFileStream moveSource: moveSource toFile: fileIndex "File a description of the messages of this class that have been changed (i.e., are entered into the argument, aSet) onto aFileStream. If moveSource, is true, then set the method source pointer to the new file position. Note when this method is called with moveSource=true, it is condensing the .changes file, and should only write a preamble for every method." | org | (org := self organization) categories do: + [:cat | | sels | - [:cat | - | sels | sels := (org listAtCategoryNamed: cat) select: [:sel | aSet includes: sel]. + (moveSource == #historically + or: [moveSource and: [(cat beginsWith: '*') and: [cat endsWith: '-override']]]) + ifTrue: "when condensing sources/changes, preserve overridden methods" + [sels do: + [:sel | + self printMethodChunkHistorically: sel on: aFileStream + moveSource: moveSource ~~ false toFile: fileIndex]] + ifFalse: + [sels do: - (moveSource and: [(cat beginsWith: '*') and: [cat endsWith: '-override']]) - ifTrue: ["when condensing sources/changes, preserve overridden methods" - sels do: - [:sel | self printMethodChunkHistorically: sel on: aFileStream - moveSource: moveSource toFile: fileIndex]] - ifFalse: [ - sels do: [:sel | self printMethodChunk: sel withPreamble: true on: aFileStream moveSource: moveSource toFile: fileIndex]]]! Item was changed: ----- Method: ClassDescription>>fileOutOn:moveSource:toFile: (in category 'fileIn/Out') ----- fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex + "File a description of the receiver on aFileStream. moveSOurce is one of + true, false or #historically. If the argument, moveSource, is not false, then + set the trailing bytes to the position of aFileStream and to fileIndex in order + to indicate where to find the source code. If moveSource == #historically, + print out each method's history, excluding branches" - "File a description of the receiver on aFileStream. If the boolean - argument, moveSource, is true, then set the trailing bytes to the position - of aFileStream and to fileIndex in order to indicate where to find the - source code." + aFileStream command: 'H3'; nextChunkPut: self definition; command: '/H3'. - aFileStream command: 'H3'. - aFileStream nextChunkPut: self definition. - aFileStream command: '/H3'. self organization putCommentOnFile: aFileStream numbered: fileIndex + moveSource: moveSource ~~ false - moveSource: moveSource forClass: self. self organization categories do: [:heading | + moveSource == #historically + ifTrue: + [self fileOutCategoryHistorically: heading + on: aFileStream + moveSource: true + toFile: fileIndex] + ifFalse: + [self fileOutCategory: heading + on: aFileStream + moveSource: moveSource + toFile: fileIndex]]! - self fileOutCategory: heading - on: aFileStream - moveSource: moveSource - toFile: fileIndex]! Item was changed: ----- Method: ClassDescription>>printMethodChunkHistorically:on:moveSource:toFile: (in category 'fileIn/Out') ----- printMethodChunkHistorically: selector on: outStream moveSource: moveSource toFile: fileIndex "Copy all source codes historically for the method associated with selector onto the + fileStream. If moveSource is true, then also set the source code pointer of the method. + N.B. fileIndex is interpreted as follows, 0 => just a fileOut; 1 => condensing sources; + 2 => condensing changes; therefore only changes on the chnages file before the last + version in the sources file are recorded." - fileStream. If moveSource true, then also set the source code pointer of the method." + | preamble method newPos category changeList prior index | - | preamble method sourceFile endPos category changeList newPos | category := self organization categoryOfElement: selector. preamble := self name , ' methodsFor: ', category asString printString. method := self methodDict at: selector. + (method filePosition = 0 + or: [method fileIndex = 0 + or: [(SourceFiles at: method fileIndex) isNil]]) + ifTrue: "no source; must decompile" + [outStream cr; nextPut: $!!; nextChunkPut: preamble; cr. + outStream nextChunkPut: method decompileString. + outStream nextChunkPut: ' '; cr] + ifFalse: + [changeList := ChangeSet directAncestryOfVersions: (ChangeSet + scanVersionsOf: method + class: self + meta: self isMeta + category: category + selector: selector). + newPos := prior := nil. + (fileIndex = 2 "condensing changes; select changes file code and find last sources file change" + and: [(index := changeList findFirst: [:chgRec| chgRec fileIndex = 1]) > 0]) ifTrue: + [prior := changeList at: index. + changeList := changeList copyFrom: 1 to: index - 1]. + changeList reverseDo: + [:chgRec| + chgRec file closed ifTrue: + [chgRec file reopen; setToEnd]. + outStream copyPreamble: preamble from: chgRec file at: chgRec position. + prior ifNotNil: + [outStream + position: outStream position - 2; + nextPutAll: ' prior: '; + print: (SourceFiles + sourcePointerFromFileIndex: prior fileIndex + andPosition: prior position); + nextPut: $!!; cr]. - ((method fileIndex = 0 - or: [(SourceFiles at: method fileIndex) == nil]) - or: [method filePosition = 0]) - ifTrue: [ - outStream cr; nextPut: $!!; nextChunkPut: preamble; cr. - outStream nextChunkPut: method decompileString. - outStream nextChunkPut: ' '; cr] - ifFalse: [ - changeList := ChangeSet - scanVersionsOf: method - class: self - meta: self isMeta - category: category - selector: selector. - newPos := nil. - sourceFile := SourceFiles at: method fileIndex. - changeList reverseDo: [ :chgRec | | prior | - chgRec fileIndex = fileIndex ifTrue: [ - outStream copyPreamble: preamble from: sourceFile at: chgRec position. - (prior := chgRec prior) ifNotNil: [ - outStream position: outStream position - 2. - outStream nextPutAll: ' prior: ', ( - prior first = method fileIndex ifFalse: [prior third] ifTrue: [ - SourceFiles - sourcePointerFromFileIndex: method fileIndex - andPosition: newPos]) printString. - outStream nextPut: $!!; cr]. "Copy the method chunk" newPos := outStream position. + outStream copyMethodChunkFrom: chgRec file at: chgRec position. + chgRec file skipSeparators. "The following chunk may have ]style[" + chgRec file peek == $] ifTrue: + [outStream cr; copyMethodChunkFrom: chgRec file]. + outStream nextChunkPut: ' '; cr. + chgRec position: newPos. + prior := chgRec]. + moveSource ifTrue: + [method setSourcePosition: newPos inFile: fileIndex]]. + ^outStream! - outStream copyMethodChunkFrom: sourceFile at: chgRec position. - sourceFile skipSeparators. "The following chunk may have ]style[" - sourceFile peek == $] ifTrue: [ - outStream cr; copyMethodChunkFrom: sourceFile]. - outStream nextChunkPut: ' '; cr]]. - moveSource ifTrue: [ - endPos := outStream position. - method checkOKToAdd: endPos - newPos at: newPos. - method setSourcePosition: newPos inFile: fileIndex]]. - ^ outStream! Item was changed: ----- Method: Metaclass>>fileOutOn:moveSource:toFile:initializing: (in category 'fileIn/Out') ----- fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: aBool + super fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex. + (aBool + and: [moveSource == false + and: [self methodDict includesKey: #initialize]]) ifTrue: + [aFileStream cr; cr; nextChunkPut: thisClass name , ' initialize'; cr]! - super fileOutOn: aFileStream - moveSource: moveSource - toFile: fileIndex. - (aBool and:[moveSource not and: [self methodDict includesKey: #initialize]]) ifTrue: - [aFileStream cr. - aFileStream cr. - aFileStream nextChunkPut: thisClass name , ' initialize'. - aFileStream cr]!

1 0

← Newer
1
2
3
4
5
6
7
...
62
Older →

Jump to page: