[squeak-dev] The Trunk: Kernel-ul.515.mczNicolas Cellier nicolas.cellier.aka.nice at gmail.comMon Nov 15 10:16:31 UTC 2010
Please restore #inboundPointersExcluding:
A loop for enumerating objects MUST use == 0
Otherwise, the loop will stop at first occurrence of Float 0.0 instead
of exhausting the object memory...
anObj := self someObject.
+ [0 = anObj] whileFalse: [
- [0 == anObj] whileFalse: [
anObj := anObj nextObject].
Nicolas
2010/11/15 <commits at source.squeak.org>:
> Levente Uzonyi uploaded a new version of Kernel to project The Trunk:
> http://source.squeak.org/trunk/Kernel-ul.515.mcz
>
> ==================== Summary ====================
>
> Name: Kernel-ul.515
> Author: ul
> Time: 15 November 2010, 10:32:19.849 am
> UUID: 2254c085-e86b-ef4e-916c-4e2008a6e9dc
> Ancestors: Kernel-ul.513
>
> - use #= for integer comparison instead of #== (http://bugs.squeak.org/view.php?id=2788 )
>
> =============== Diff against Kernel-ul.513 ===============
>
> Item was changed:
> ----- Method: Behavior>>commentsIn: (in category 'accessing method dictionary') -----
> commentsIn: sourceString
>
>
> | commentStart nextQuotePos someComments aPos |
> ('*"*' match: sourceString) ifFalse: [^#()].
> someComments:= OrderedCollection new.
> + sourceString size = 0 ifTrue: [^ someComments].
> - sourceString size == 0 ifTrue: [^ someComments].
> aPos:=1.
> nextQuotePos:= 0.
> [commentStart := sourceString findString: '"' startingAt: aPos.
> nextQuotePos:= self nextQuotePosIn: sourceString startingFrom: commentStart.
> (commentStart ~= 0 and: [nextQuotePos >commentStart])] whileTrue: [
> commentStart ~= nextQuotePos ifTrue: [
> someComments add: ((sourceString copyFrom: commentStart + 1 to: nextQuotePos - 1) copyReplaceAll: '""' with: '"').].
> aPos := nextQuotePos+1].
> ^someComments!
>
> Item was changed:
> ----- Method: Behavior>>inspectAllInstances (in category 'accessing instances and variables') -----
> inspectAllInstances
> "Inpsect all instances of the receiver. 1/26/96 sw"
>
> | all allSize prefix |
> all := self allInstances.
> + (allSize := all size) = 0 ifTrue: [^ self inform: 'There are no
> - (allSize := all size) == 0 ifTrue: [^ self inform: 'There are no
> instances of ', self name].
> + prefix := allSize = 1
> - prefix := allSize == 1
> ifTrue: ['The lone instance']
> ifFalse: ['The ', allSize printString, ' instances'].
>
> all asArray inspectWithLabel: (prefix, ' of ', self name)!
>
> Item was changed:
> ----- Method: Behavior>>inspectSubInstances (in category 'accessing instances and variables') -----
> inspectSubInstances
> "Inspect all instances of the receiver and all its subclasses. CAUTION - don't do this for something as generic as Object!! 1/26/96 sw"
>
> | all allSize prefix |
> all := self allSubInstances.
> + (allSize := all size) = 0 ifTrue: [^ self inform: 'There are no
> - (allSize := all size) == 0 ifTrue: [^ self inform: 'There are no
> instances of ', self name, '
> or any of its subclasses'].
> + prefix := allSize = 1
> - prefix := allSize == 1
> ifTrue: ['The lone instance']
> ifFalse: ['The ', allSize printString, ' instances'].
>
> all asArray inspectWithLabel: (prefix, ' of ', self name, ' & its subclasses')!
>
> Item was changed:
> ----- Method: ClassDescription>>instVarIndexFor:ifAbsent: (in category 'instance variables') -----
> instVarIndexFor: instVarName ifAbsent: aBlock
> "Answer the index of the named instance variable."
>
> | index |
> index := instanceVariables == nil
> ifTrue: [0]
> ifFalse: [instanceVariables indexOf: instVarName ifAbsent: [0]].
> + index = 0 ifTrue:
> - index == 0 ifTrue:
> [^superclass == nil
> ifTrue: [aBlock value]
> ifFalse: [superclass instVarIndexFor: instVarName ifAbsent: aBlock]].
> ^superclass == nil
> ifTrue: [index]
> ifFalse: [index + superclass instSize]!
>
> Item was changed:
> ----- Method: ClassDescription>>moveClassCommentTo:fileIndex: (in category 'fileIn/Out') -----
> moveClassCommentTo: aFileStream fileIndex: newFileIndex
> "Called when condensing changes. If the receiver has a class comment, and if that class comment does not reside in the .sources file, then write it to the given filestream, with the resulting RemoteString being reachable from the source file fileIndex. Note that any existing backpointer into the .sources file is lost by this process -- a situation that maybe should be fixed someday."
>
> | header aStamp aCommentRemoteStr |
> self isMeta ifTrue: [^ self]. "bulletproofing only"
> ((aCommentRemoteStr := self organization commentRemoteStr) isNil or:
> + [aCommentRemoteStr sourceFileNumber = 1]) ifTrue: [^ self].
> - [aCommentRemoteStr sourceFileNumber == 1]) ifTrue: [^ self].
>
> aFileStream cr; nextPut: $!!.
> header := String streamContents: [:strm | strm nextPutAll: self name;
> nextPutAll: ' commentStamp: '.
> (aStamp := self organization commentStamp ifNil: ['<historical>']) storeOn: strm.
> strm nextPutAll: ' prior: 0'].
> aFileStream nextChunkPut: header.
> aFileStream cr.
> self organization classComment: (RemoteString newString: self organization classComment onFileNumber: newFileIndex toFile: aFileStream) stamp: aStamp!
>
> Item was changed:
> ----- Method: CompiledMethod>>timeStamp (in category 'printing') -----
> timeStamp
> "Answer the authoring time-stamp for the given method, retrieved from the sources or changes file. Answer the empty string if no time stamp is available."
>
> "(CompiledMethod compiledMethodAt: #timeStamp) timeStamp"
>
> | file preamble stamp tokens tokenCount |
> + self fileIndex = 0 ifTrue: [^ String new]. "no source pointer for this method"
> - self fileIndex == 0 ifTrue: [^ String new]. "no source pointer for this method"
> file := SourceFiles at: self fileIndex.
> file ifNil: [^ String new]. "sources file not available"
> "file does not exist happens in secure mode"
> file := [file readOnlyCopy] on: FileDoesNotExistException do:[:ex| nil].
> file ifNil: [^ String new].
> preamble := self getPreambleFrom: file at: (0 max: self filePosition - 3).
> stamp := String new.
> tokens := (preamble findString: 'methodsFor:' startingAt: 1) > 0
> ifTrue: [Scanner new scanTokens: preamble]
> ifFalse: [Array new "ie cant be back ref"].
> (((tokenCount := tokens size) between: 7 and: 8) and: [(tokens at: tokenCount - 5) = #methodsFor:])
> ifTrue:
> [(tokens at: tokenCount - 3) = #stamp:
> ifTrue: ["New format gives change stamp and unified prior pointer"
> stamp := tokens at: tokenCount - 2]].
> ((tokenCount between: 5 and: 6) and: [(tokens at: tokenCount - 3) = #methodsFor:])
> ifTrue:
> [(tokens at: tokenCount - 1) = #stamp:
> ifTrue: ["New format gives change stamp and unified prior pointer"
> stamp := tokens at: tokenCount]].
> file close.
> ^ stamp
> !
>
> Item was changed:
> ----- Method: CompiledMethodTrailer>>kindAsByte (in category 'private') -----
> kindAsByte
> | index |
> index := self class trailerKinds indexOf: kind.
> + self assert: (index ~= 0).
> - self assert: (index ~~ 0).
>
> ^ (index - 1) << 2!
>
> Item was changed:
> ----- Method: InstructionStream>>willReallySend (in category 'testing') -----
> willReallySend
> "Answer whether the next bytecode is a real message-send,
> not blockCopy:."
>
> | byte |
> byte := self method at: pc.
> ^byte >= 131
> + and: [byte ~= 200
> - and: [byte ~~ 200
> and: [byte >= 176 "special send or short send"
> or: [byte <= 134 "long sends"
> and: [| litIndex |
> "long form support demands we check the selector"
> litIndex := byte = 132
> ifTrue: [(self method at: pc + 1) // 32 > 1 ifTrue: [^false].
> self method at: pc + 2]
> ifFalse: [byte = 134
> ifTrue: [(self method at: pc + 1) bitAnd: 2r111111]
> ifFalse: [(self method at: pc + 1) bitAnd: 2r11111]].
> (self method literalAt: litIndex + 1) ~~ #blockCopy:]]]]!
>
> Item was changed:
> ----- Method: Object>>inboundPointersExcluding: (in category 'tracing') -----
> inboundPointersExcluding: objectsToExclude
> "Answer a list of all objects in the system that point to me, excluding those in the collection of objectsToExclude. I do my best to avoid creating any temporary objects that point to myself, especially method and block contexts. Adapted from PointerFinder class >> #pointersTo:except:"
>
> | anObj pointers objectsToAlwaysExclude |
> Smalltalk garbageCollect.
> "big collection shouldn't grow, so it's contents array is always the same"
> pointers := OrderedCollection new: 1000.
>
> "#allObjectsDo: and #pointsTo: are expanded inline to keep spurious
> method and block contexts out of the results"
> anObj := self someObject.
> + [0 = anObj] whileFalse: [
> - [0 == anObj] whileFalse: [
> anObj isInMemory
> ifTrue: [((anObj instVarsInclude: self)
> or: [anObj class == self])
> ifTrue: [pointers add: anObj]].
> anObj := anObj nextObject].
>
> objectsToAlwaysExclude := {
> pointers collector.
> thisContext.
> thisContext sender.
> thisContext sender sender.
> objectsToExclude.
> }.
>
> ^ pointers removeAllSuchThat: [:ea |
> (objectsToAlwaysExclude identityIncludes: ea)
> or: [objectsToExclude identityIncludes: ea]]!
>
> Item was changed:
> ----- Method: Object>>saveOnFile (in category 'objects from disk') -----
> saveOnFile
> "Ask the user for a filename and save myself on a SmartReferenceStream file. Writes out the version and class structure. The file is fileIn-able. Does not file out the class of the object. tk 6/26/97 13:48"
>
> | aFileName fileStream |
> aFileName := self class name asFileName. "do better?"
> aFileName := UIManager default
> request: 'File name?' translated initialAnswer: aFileName.
> + aFileName size = 0 ifTrue: [^ Beeper beep].
> - aFileName size == 0 ifTrue: [^ Beeper beep].
>
> fileStream := FileStream newFileNamed: aFileName asFileName.
> fileStream fileOutClass: nil andObject: self.!
>
> Item was changed:
> ----- Method: Semaphore>>critical:ifLocked: (in category 'mutual exclusion') -----
> critical: mutuallyExcludedBlock ifLocked: alternativeBlock
> "Evaluate mutuallyExcludedBlock only if the receiver is not currently in
> the process of running the critical: message. If the receiver is, evaluate
> mutuallyExcludedBlock after the other critical: message is finished."
>
> "Note: The following is tricky and depends on the fact that the VM will not switch between processes while executing byte codes (process switches happen only in real sends). The following test is written carefully so that it will result in bytecodes only."
> + excessSignals = 0 ifTrue:[
> - excessSignals == 0 ifTrue:[
> "If we come here, then the semaphore was locked when the test executed.
> Evaluate the alternative block and answer its result."
> ^alternativeBlock value
> ].
> ^self critical: mutuallyExcludedBlock!
>
> Item was changed:
> ----- Method: SmallInteger>>quo: (in category 'arithmetic') -----
> quo: aNumber
> "Primitive. Divide the receiver by the argument and answer with the
> result. Round the result down towards zero to make it a whole integer.
> Fail if the argument is 0 or is not a SmallInteger. Optional. See Object
> documentation whatIsAPrimitive."
> <primitive: 13>
> aNumber = 0 ifTrue: [^ (ZeroDivide dividend: self) signal].
> (aNumber isMemberOf: SmallInteger)
> ifFalse: [^ super quo: aNumber].
> + (aNumber = -1 and: [self = self class minVal])
> - (aNumber == -1 and: [self == self class minVal])
> ifTrue: ["result is aLargeInteger" ^ self negated].
> self primitiveFailed!
>
> Item was changed:
> ----- Method: Time>>print24:showSeconds:on: (in category 'printing') -----
> print24: hr24 showSeconds: showSeconds on: aStream
> "Format is 'hh:mm:ss' or 'h:mm:ss am' or, if showSeconds is false, 'hh:mm' or 'h:mm am'"
>
> | h m s |
> h := self hour. m := self minute. s := self second.
> hr24
> ifTrue:
> [ h < 10 ifTrue: [ aStream nextPutAll: '0' ].
> h printOn: aStream ]
> ifFalse:
> [ h > 12
> ifTrue: [h - 12 printOn: aStream]
> ifFalse:
> [h < 1
> ifTrue: [ 12 printOn: aStream ]
> ifFalse: [ h printOn: aStream ]]].
>
> aStream nextPutAll: (m < 10 ifTrue: [':0'] ifFalse: [':']).
> m printOn: aStream.
>
> showSeconds ifTrue:
> [ aStream nextPutAll: (s < 10 ifTrue: [':0'] ifFalse: [':']).
> + self nanoSecond = 0
> - self nanoSecond == 0
> ifTrue: [s asInteger printOn: aStream]
> ifFalse: [(s + (self nanoSecond / NanosInSecond) asFloat) printOn: aStream]].
>
> hr24 ifFalse:
> [ aStream nextPutAll: (h < 12 ifTrue: [' am'] ifFalse: [' pm']) ].
> !
>
>
>
More information about the Squeak-dev mailing list |