Squeak-dev September 2009

squeak-dev@lists.squeakfoundation.org

119 participants
370 discussions

Start a nNew thread

test for nabble
by Mariano Martinez Peck 28 Sep '09

28 Sep '09

1 1

Re: [squeak-dev] The Inbox: Kernel-ul.251.mcz
by Michael van der Gulik 28 Sep '09

28 Sep '09

On Mon, Sep 28, 2009 at 1:38 PM, <commits(a)source.squeak.org> wrote: > Item was added: > + ----- Method: BlockClosure>>timeToRunWithoutGC (in category 'evaluating') > ----- > + timeToRunWithoutGC > + "Answer the number of milliseconds taken to execute this block > without GC time." > + > + ^(SmalltalkImage current vmParameterAt: 8) + > + (SmalltalkImage current vmParameterAt: 10) + > + self timeToRun - > + (SmalltalkImage current vmParameterAt: 8) - > + (SmalltalkImage current vmParameterAt: 10) > + ! > > > Could this method be put somewhere other than in Kernel, say for example in a separate profiling package? Gulik. -- http://gulik.pbwiki.com/

2 2

The Inbox: Kernel-ul.251.mcz
by commits＠source.squeak.org 28 Sep '09

28 Sep '09

A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-ul.251.mcz ==================== Summary ==================== Name: Kernel-ul.251 Author: ul Time: 26 September 2009, 3:01:51 am UUID: 0926180d-3ca0-0d41-9a06-d3a1d210b2bd Ancestors: Kernel-ar.249, Kernel-ul.250 - replaced uses of #findElementOrNil: with #scanFor: - new #scanFor: implementation for MethodDictionary - Added BlockClosue >> #timeToRunWithoutGC which returns the number of milliseconds taken to the block without GC time. =============== Diff against Kernel-ul.250 =============== Item was changed: ----- Method: MethodDictionary>>at:put: (in category 'accessing') ----- at: key put: value "Set the value at key to be value." | index | + index := self scanFor: key. - index := self findElementOrNil: key. (self basicAt: index) == nil ifTrue: [tally := tally + 1. self basicAt: index put: key] ifFalse: [(array at: index) flushCache]. array at: index put: value. self fullCheck. ^ value! Item was changed: ----- Method: MethodDictionary>>removeDangerouslyKey:ifAbsent: (in category 'private') ----- removeDangerouslyKey: key ifAbsent: aBlock "This is not really dangerous. But if normal removal were done WHILE a MethodDict were being used, the system might crash. So instead we make a copy, then do this operation (which is NOT dangerous in a copy that is not being used), and then use the copy after the removal." | index element | + index := self scanFor: key. - index := self findElementOrNil: key. (self basicAt: index) == nil ifTrue: [ ^ aBlock value ]. element := array at: index. array at: index put: nil. self basicAt: index put: nil. tally := tally - 1. self fixCollisionsFrom: index. ^ element! Item was added: + ----- Method: BlockClosure>>timeToRunWithoutGC (in category 'evaluating') ----- + timeToRunWithoutGC + "Answer the number of milliseconds taken to execute this block without GC time." + + ^(SmalltalkImage current vmParameterAt: 8) + + (SmalltalkImage current vmParameterAt: 10) + + self timeToRun - + (SmalltalkImage current vmParameterAt: 8) - + (SmalltalkImage current vmParameterAt: 10) + ! Item was changed: ----- Method: MethodFinder>>initialize2 (in category 'initialize') ----- initialize2 "The methods we are allowed to use. (MethodFinder new initialize) " "Set" #("in class" sizeFor: "testing" "adding" "removing" "enumerating" + "private" array scanFor: - "private" array findElementOrNil: "accessing" someElement) do: [:sel | Approved add: sel]. "Dictionary, IdentityDictionary, IdentitySet" #("accessing" associationAt: associationAt:ifAbsent: at:ifPresent: keyAtIdentityValue: keyAtIdentityValue:ifAbsent: keyAtValue: keyAtValue:ifAbsent: keys "testing" includesKey: ) do: [:sel | Approved add: sel]. #(removeKey: removeKey:ifAbsent: ) do: [:sel | AddAndRemove add: sel]. "LinkedList, Interval, MappedCollection" #("in class" from:to: from:to:by: "accessing" contents) do: [:sel | Approved add: sel]. #( "adding" addFirst: addLast:) do: [:sel | AddAndRemove add: sel]. "OrderedCollection, SortedCollection" #("accessing" after: before: "copying" copyEmpty "adding" growSize "removing" "enumerating" "private" "accessing" sortBlock) do: [:sel | Approved add: sel]. #("adding" add:after: add:afterIndex: add:before: addAllFirst: addAllLast: addFirst: addLast: "removing" removeAt: removeFirst removeLast "accessing" sortBlock:) do: [:sel | AddAndRemove add: sel]. "Character" #("in class, instance creation" allCharacters digitValue: new separators "accessing untypeable characters" backspace cr enter lf linefeed nbsp newPage space tab "constants" alphabet characterTable "accessing" asciiValue digitValue "comparing" "testing" isAlphaNumeric isDigit isLetter isLowercase isSafeForHTTP isSeparator isSpecial isUppercase isVowel tokenish "copying" "converting" asIRCLowercase asLowercase asUppercase ) do: [:sel | Approved add: sel]. "String" #("in class, instance creation" crlf fromPacked: "primitives" findFirstInString:inSet:startingAt: indexOfAscii:inString:startingAt: "internet" valueOfHtmlEntity: "accessing" byteAt: endsWithDigit findAnySubStr:startingAt: findBetweenSubStrs: findDelimiters:startingAt: findString:startingAt: findString:startingAt:caseSensitive: findTokens: findTokens:includes: findTokens:keep: includesSubString: includesSubstring:caseSensitive: indexOf:startingAt: indexOfAnyOf: indexOfAnyOf:ifAbsent: indexOfAnyOf:startingAt: indexOfAnyOf:startingAt:ifAbsent: lineCorrespondingToIndex: lineCount lineNumber: skipAnySubStr:startingAt: skipDelimiters:startingAt: startsWithDigit "comparing" alike: beginsWith: caseSensitiveLessOrEqual: charactersExactlyMatching: compare: crc16 endsWith: endsWithAnyOf: sameAs: startingAt:match:startingAt: "copying" copyReplaceTokens:with: padded:to:with: "converting" asByteArray asDate asDisplayText asFileName asHtml asLegalSelector asPacked asParagraph asText asTime asUnHtml asUrl asUrlRelativeTo: capitalized compressWithTable: contractTo: correctAgainst: encodeForHTTP initialIntegerOrNil keywords quoted sansPeriodSuffix splitInteger stemAndNumericSuffix substrings surroundedBySingleQuotes truncateWithElipsisTo: withBlanksTrimmed withFirstCharacterDownshifted withNoLineLongerThan: withSeparatorsCompacted withoutLeadingDigits withoutTrailingBlanks "displaying" "printing" "system primitives" compare:with:collated: "Celeste" withCRs "internet" decodeMimeHeader decodeQuotedPrintable unescapePercents withInternetLineEndings withSqueakLineEndings withoutQuoting "testing" isAllSeparators lastSpacePosition "paragraph support" indentationIfBlank: "arithmetic" ) do: [:sel | Approved add: sel]. #(byteAt:put: translateToLowercase match:) do: [:sel | AddAndRemove add: sel]. "Symbol" #("in class, private" hasInterned:ifTrue: "access" morePossibleSelectorsFor: possibleSelectorsFor: selectorsContaining: thatStarts:skipping: "accessing" "comparing" "copying" "converting" "printing" "testing" isInfix isKeyword isPvtSelector isUnary) do: [:sel | Approved add: sel]. "Array" #("comparing" "converting" evalStrings "printing" "private" hasLiteralSuchThat:) do: [:sel | Approved add: sel]. "Array2D" #("access" at:at: atCol: atCol:put: atRow: extent extent:fromArray: height width width:height:type:) do: [:sel | Approved add: sel]. #(at:at:add: at:at:put: atRow:put: ) do: [:sel | AddAndRemove add: sel]. "ByteArray" #("accessing" doubleWordAt: wordAt: "platform independent access" longAt:bigEndian: shortAt:bigEndian: unsignedLongAt:bigEndian: unsignedShortAt:bigEndian: "converting") do: [:sel | Approved add: sel]. #(doubleWordAt:put: wordAt:put: longAt:put:bigEndian: shortAt:put:bigEndian: unsignedLongAt:put:bigEndian: unsignedShortAt:put:bigEndian: ) do: [:sel | AddAndRemove add: sel]. "FloatArray" "Dont know what happens when prims not here" false ifTrue: [#("accessing" "arithmetic" *= += -= /= "comparing" "primitives-plugin" primAddArray: primAddScalar: primDivArray: primDivScalar: primMulArray: primMulScalar: primSubArray: primSubScalar: "primitives-translated" primAddArray:withArray:from:to: primMulArray:withArray:from:to: primSubArray:withArray:from:to: "converting" "private" "user interface") do: [:sel | Approved add: sel]. ]. "IntegerArray, WordArray" "RunArray" #("in class, instance creation" runs:values: scanFrom: "accessing" runLengthAt: "adding" "copying" "private" runs values) do: [:sel | Approved add: sel]. #(coalesce addLast:times: repeatLast:ifEmpty: repeatLastIfEmpty: ) do: [:sel | AddAndRemove add: sel]. "Stream -- many operations change its state" #("testing" atEnd) do: [:sel | Approved add: sel]. #("accessing" next: nextMatchAll: nextMatchFor: upToEnd next:put: nextPut: nextPutAll: "printing" print: printHtml: ) do: [:sel | AddAndRemove add: sel]. "PositionableStream" #("accessing" contentsOfEntireFile originalContents peek peekFor: "testing" "positioning" position ) do: [:sel | Approved add: sel]. #(nextDelimited: nextLine upTo: position: reset resetContents setToEnd skip: skipTo: upToAll: ) do: [:sel | AddAndRemove add: sel]. "Because it is so difficult to test the result of an operation on a Stream (you have to supply another Stream in the same state), we don't support Streams beyond the basics. We want to find the messages that convert Streams to other things." "ReadWriteStream" #("file status" closed) do: [:sel | Approved add: sel]. #("accessing" next: on: ) do: [:sel | AddAndRemove add: sel]. "WriteStream" #("in class, instance creation" on:from:to: with: with:from:to: ) do: [:sel | Approved add: sel]. #("positioning" resetToStart "character writing" crtab crtab:) do: [:sel | AddAndRemove add: sel]. "LookupKey, Association, Link" #("accessing" key nextLink) do: [:sel | Approved add: sel]. #(key: key:value: nextLink:) do: [:sel | AddAndRemove add: sel]. "Point" #("in class, instance creation" r:degrees: x:y: "accessing" x y "comparing" "arithmetic" "truncation and round off" "polar coordinates" degrees r theta "point functions" bearingToPoint: crossProduct: dist: dotProduct: eightNeighbors flipBy:centerAt: fourNeighbors grid: nearestPointAlongLineFrom:to: nearestPointOnLineFrom:to: normal normalized octantOf: onLineFrom:to: onLineFrom:to:within: quadrantOf: rotateBy:centerAt: transposed unitVector "converting" asFloatPoint asIntegerPoint corner: extent: rect: "transforming" adhereTo: rotateBy:about: scaleBy: scaleFrom:to: translateBy: "copying" "interpolating" interpolateTo:at:) do: [:sel | Approved add: sel]. "Rectangle" #("in class, instance creation" center:extent: encompassing: left:right:top:bottom: merging: origin:corner: origin:extent: "accessing" area bottom bottomCenter bottomLeft bottomRight boundingBox center corner corners innerCorners left leftCenter origin right rightCenter top topCenter topLeft topRight "comparing" "rectangle functions" adjustTo:along: amountToTranslateWithin: areasOutside: bordersOn:along: encompass: expandBy: extendBy: forPoint:closestSideDistLen: insetBy: insetOriginBy:cornerBy: intersect: merge: pointNearestTo: quickMerge: rectanglesAt:height: sideNearestTo: translatedToBeWithin: withBottom: withHeight: withLeft: withRight: withSide:setTo: withTop: withWidth: "testing" containsPoint: containsRect: hasPositiveExtent intersects: isTall isWide "truncation and round off" "transforming" align:with: centeredBeneath: newRectFrom: squishedWithin: "copying" ) do: [:sel | Approved add: sel]. "Color" #("in class, instance creation" colorFrom: colorFromPixelValue:depth: fromRgbTriplet: gray: h:s:v: r:g:b: r:g:b:alpha: r:g:b:range: "named colors" black blue brown cyan darkGray gray green lightBlue lightBrown lightCyan lightGray lightGreen lightMagenta lightOrange lightRed lightYellow magenta orange red transparent veryDarkGray veryLightGray veryVeryDarkGray veryVeryLightGray white yellow "other" colorNames indexedColors pixelScreenForDepth: quickHighLight: "access" alpha blue brightness green hue luminance red saturation "equality" "queries" isBitmapFill isBlack isGray isSolidFill isTranslucent isTranslucentColor "transformations" alpha: dansDarker darker lighter mixed:with: muchLighter slightlyDarker slightlyLighter veryMuchLighter alphaMixed:with: "groups of shades" darkShades: lightShades: mix:shades: wheel: "printing" shortPrintString "other" colorForInsets rgbTriplet "conversions" asB3DColor asColor balancedPatternForDepth: bitPatternForDepth: closestPixelValue1 closestPixelValue2 closestPixelValue4 closestPixelValue8 dominantColor halfTonePattern1 halfTonePattern2 indexInMap: pixelValueForDepth: pixelWordFor:filledWith: pixelWordForDepth: scaledPixelValue32 "private" privateAlpha privateBlue privateGreen privateRGB privateRed "copying" ) do: [:sel | Approved add: sel]. " For each selector that requires a block argument, add (selector argNum) to the set Blocks." "ourClasses := #(Object Boolean True False UndefinedObject Behavior ClassDescription Class Metaclass MethodContext BlockContext Message Magnitude Date Time Number Integer SmallInteger LargeNegativeInteger LargePositiveInteger Float Fraction Random Collection SequenceableCollection ArrayedCollection Bag Set Dictionary IdentityDictionary IdentitySet LinkedList Interval MappedCollection OrderedCollection SortedCollection Character String Symbol Array Array2D ByteArray FloatArray IntegerArray WordArray RunArray Stream PositionableStream ReadWriteStream WriteStream LookupKey Association Link Point Rectangle Color). ourClasses do: [:clsName | cls := Smalltalk at: clsName. (cls selectors) do: [:aSel | ((Approved includes: aSel) or: [AddAndRemove includes: aSel]) ifTrue: [ (cls formalParametersAt: aSel) withIndexDo: [:tName :ind | (tName endsWith: 'Block') ifTrue: [ Blocks add: (Array with: aSel with: ind)]]]]]. " #((timesRepeat: 1 ) (indexOf:ifAbsent: 2 ) (pairsCollect: 1 ) (mergeSortFrom:to:by: 3 ) (ifNotNil:ifNil: 1 ) (ifNotNil:ifNil: 2 ) (ifNil: 1 ) (at:ifAbsent: 2 ) (ifNil:ifNotNil: 1 ) (ifNil:ifNotNil: 2 ) (ifNotNil: 1 ) (at:modify: 2 ) (identityIndexOf:ifAbsent: 2 ) (sort: 1 ) (sortBlock: 1 ) (detectMax: 1 ) (repeatLastIfEmpty: 1 ) (allSubclassesWithLevelDo:startingLevel: 1 ) (keyAtValue:ifAbsent: 2 ) (in: 1 ) (ifTrue: 1 ) (or: 1 ) (select: 1 ) (inject:into: 2 ) (forPoint:closestSideDistLen: 2 ) (value:ifError: 2 ) (selectorsDo: 1 ) (removeAllSuchThat: 1 ) (keyAtIdentityValue:ifAbsent: 2 ) (detectMin: 1 ) (detect:ifNone: 1 ) (ifTrue:ifFalse: 1 ) (ifTrue:ifFalse: 2 ) (detect:ifNone: 2 ) (hasLiteralSuchThat: 1 ) (indexOfAnyOf:ifAbsent: 2 ) (reject: 1 ) (newRectFrom: 1 ) (removeKey:ifAbsent: 2 ) (at:ifPresent: 2 ) (associationAt:ifAbsent: 2 ) (withIndexCollect: 1 ) (repeatLast:ifEmpty: 2 ) (findLast: 1 ) (indexOf:startingAt:ifAbsent: 3 ) (remove:ifAbsent: 2 ) (ifFalse:ifTrue: 1 ) (ifFalse:ifTrue: 2 ) (caseOf:otherwise: 2 ) (count: 1 ) (collect: 1 ) (sortBy: 1 ) (and: 1 ) (asSortedCollection: 1 ) (with:collect: 2 ) (sourceCodeAt:ifAbsent: 2 ) (detect: 1 ) (collectWithIndex: 1 ) (compiledMethodAt:ifAbsent: 2 ) (bindWithTemp: 1 ) (detectSum: 1 ) (indexOfSubCollection:startingAt:ifAbsent: 3 ) (findFirst: 1 ) (sourceMethodAt:ifAbsent: 2 ) (collect:thenSelect: 1 ) (collect:thenSelect: 2 ) (select:thenCollect: 1 ) (select:thenCollect: 2 ) (ifFalse: 1 ) (indexOfAnyOf:startingAt:ifAbsent: 3 ) (indentationIfBlank: 1 ) ) do: [:anArray | Blocks add: anArray]. self initialize3. " MethodFinder new initialize. MethodFinder new organizationFiltered: TranslucentColor class " "Do not forget class messages for each of these classes" ! Item was changed: ----- Method: MethodDictionary>>at:ifAbsent: (in category 'accessing') ----- at: key ifAbsent: aBlock | index | + index := self scanFor: key. - index := self findElementOrNil: key. (self basicAt: index) == nil ifTrue: [ ^ aBlock value ]. ^ array at: index! Item was changed: ----- Method: MethodDictionary>>at:putNoBecome: (in category 'accessing') ----- at: key putNoBecome: value "Set the value at key to be value. Answer the resulting MethodDictionary" | index | + index := self scanFor: key. - index := self findElementOrNil: key. (self basicAt: index) == nil ifTrue: [tally := tally + 1. self basicAt: index put: key] ifFalse: [(array at: index) flushCache]. array at: index put: value. ^self fullCheckNoBecome! Item was changed: ----- Method: Delay>>schedule (in category 'private') ----- schedule "Schedule this delay" + beingWaitedOn ifTrue: [^self error: 'This Delay has already been scheduled.']. resumptionTime := Time millisecondClockValue + delayDuration. AccessProtect critical:[ ScheduledDelay := self. TimingSemaphore signal. ].! Item was changed: ----- Method: MethodDictionary>>scanFor: (in category 'private') ----- scanFor: anObject + "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - | element start finish | - finish := array size. - start := (anObject identityHash \\ finish) + 1. - - "Search from (hash mod size) to the end." - start to: finish do: - [:index | ((element := self basicAt: index) == nil or: [element == anObject]) - ifTrue: [^ index ]]. + | index start | + index := start := anObject identityHash \\ array size + 1. + [ + | element | + ((element := self basicAt: index) == nil or: [ element == anObject ]) + ifTrue: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - "Search from 1 to where we started." - 1 to: start-1 do: - [:index | ((element := self basicAt: index) == nil or: [element == anObject]) - ifTrue: [^ index ]]. - - ^ 0 "No match AND no empty slot"!

1 0

The Inbox: Collections-ul.145.mcz
by commits＠source.squeak.org 28 Sep '09

28 Sep '09

A new version of Collections was added to project The Inbox: http://source.squeak.org/inbox/Collections-ul.145.mcz ==================== Summary ==================== Name: Collections-ul.145 Author: ul Time: 26 September 2009, 3:09:51 am UUID: 82a41c01-844f-764d-82ee-39ae38d692ec Ancestors: Collections-ul.144 deprecated #findElementOrNil: and #noCheckAdd: =============== Diff against Collections-ul.144 =============== Item was changed: ----- Method: KeyedSet>>noCheckAdd: (in category 'private') ----- noCheckAdd: anObject + + self deprecated: 'This method should not be used anymore.'. array at: (self scanFor: (keyBlock value: anObject)) put: anObject. tally := tally + 1! Item was changed: ----- Method: Set>>findElementOrNil: (in category 'private') ----- findElementOrNil: anObject "Answer the index of a first slot containing either a nil (indicating an empty slot) or an element that matches the given object. Answer the index of that slot or zero. Fail if neither a match nor an empty slot is found." | index | + self deprecated: 'Use #scanFor:.'. - index := self scanFor: anObject. index > 0 ifTrue: [^index]. "Bad scene. Neither have we found a matching element nor even an empty slot. No hashed set is ever supposed to get completely full." self error: 'There is no free space in this set!!'.! Item was changed: ----- Method: Set>>noCheckAdd: (in category 'private') ----- noCheckAdd: anObject + + self deprecated: 'This method should not be used anymore.'. array at: (self scanFor: anObject) put: anObject. tally := tally + 1! Item was changed: ----- Method: Dictionary>>noCheckAdd: (in category 'private') ----- noCheckAdd: anObject "Must be defined separately for Dictionary because (self scanFor:) expects a key, not an association. 9/7/96 tk" + self deprecated: 'This method should not be used anymore.'. array at: (self scanFor: anObject key) put: anObject. tally := tally + 1!

1 0

The Inbox: Collections-ul.144.mcz
by commits＠source.squeak.org 28 Sep '09

28 Sep '09

A new version of Collections was added to project The Inbox: http://source.squeak.org/inbox/Collections-ul.144.mcz ==================== Summary ==================== Name: Collections-ul.144 Author: ul Time: 26 September 2009, 3:07:17 am UUID: 69c3f50c-9f0b-4d4f-9c98-3b88c49b5371 Ancestors: Collections-ul.140, Collections-ul.143 - replaced all uses of #findElementOrNil: with #scanFor: - #scanFor: raises an error if it can't find a slot - new #scanFor:, #scanForEmptySlotFor: and #fixCollisionsFrom: implementations - removed unnecessary WeakKeyDictionary >> #scanFor: - added Set >> #errorNoFreeSpace as a common error message for #scanFor: and #scanForEmptySlotFor: =============== Diff against Collections-ul.140 =============== Item was changed: ----- Method: WeakSet>>scanFor: (in category 'private') ----- scanFor: anObject + "Scan the key array for the first slot containing either a nil or a flag (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements" - - | element start finish | + | index start | + index := start := anObject hash \\ array size + 1. + [ + | element | + ((element := array at: index) == flag or: [ element = anObject ]) + ifTrue: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - finish := array size. - start := (anObject hash \\ finish) + 1. - - "Search from (hash mod size) to the end." - start to: finish do: - [:index | ((element := array at: index) == flag or: [element = anObject]) - ifTrue: [^ index ]]. - - "Search from 1 to where we started." - 1 to: start-1 do: - [:index | ((element := array at: index) == flag or: [element = anObject]) - ifTrue: [^ index ]]. - - ^ 0 "No match AND no empty slot"! Item was changed: ----- Method: Set>>scanFor: (in category 'private') ----- scanFor: anObject + "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - - | element start | - start := (anObject hash \\ array size) + 1. - - "Search from (hash mod size) to the end." - start to: array size do: [ :index | - ((element := array at: index) == nil or: [ element = anObject ]) - ifTrue: [ ^index ] ]. + | index start | + index := start := anObject hash \\ array size + 1. + [ + | element | - "Search from 1 to where we started." - 1 to: start - 1 do: [ :index | ((element := array at: index) == nil or: [ element = anObject ]) + ifTrue: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - ifTrue: [ ^index ] ]. - - ^0 "No match AND no empty slot"! Item was changed: ----- Method: Dictionary>>values (in category 'accessing') ----- values "Answer a Collection containing the receiver's values." + + ^Array new: self size streamContents: [ :stream | + self valuesDo: [ :value | stream nextPut: value] ]! - | out | - out := WriteStream on: (Array new: self size). - self valuesDo: [:value | out nextPut: value]. - ^ out contents! Item was added: + ----- Method: KeyedSet>>keyAt: (in category 'private') ----- + keyAt: index + + ^keyBlock value: (array at: index)! Item was changed: ----- Method: WeakKeyDictionary>>at:put: (in category 'accessing') ----- at: key put: anObject "Set the value at key to be anObject. If key is not found, create a new entry for key and set is value to anObject. Answer anObject." | index element | key isNil ifTrue:[^anObject]. + index := self scanFor: key. - index := self findElementOrNil: key. element := array at: index. element == nil ifTrue: [self atNewIndex: index put: (WeakKeyAssociation key: key value: anObject)] ifFalse: [element value: anObject]. ^ anObject! Item was changed: ----- Method: WeakSet>>add: (in category 'public') ----- add: newObject "Include newObject as one of the receiver's elements, but only if not already present. Answer newObject" | index | newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element']. + index := self scanFor: newObject. - index := self findElementOrNil: newObject. ((array at: index) == flag or: [(array at: index) isNil]) ifTrue: [self atNewIndex: index put: newObject]. ^newObject! Item was changed: ----- Method: Set>>add: (in category 'adding') ----- add: newObject "Include newObject as one of the receiver's elements, but only if not already present. Answer newObject." | index | newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element']. + index := self scanFor: newObject. - index := self findElementOrNil: newObject. (array at: index) ifNil: [self atNewIndex: index put: newObject]. ^ newObject! Item was changed: ----- Method: IdentitySet>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start hash | + array size > 4096 + ifTrue: [ hash := anObject identityHash * (array size // 4096) ] - | finish hash start | - (finish := array size) > 4096 - ifTrue: [ hash := anObject identityHash * (finish // 4096) ] ifFalse: [ hash := anObject identityHash ]. + index := start := hash \\ array size + 1. + [ + (array at: index) ifNil: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - start := hash \\ finish + 1. - "Search from (hash mod size) to the end." - start to: finish do: [ :index | - (array at: index) ifNil: [ ^index ] ]. - "Search from 1 to where we started." - 1 to: start - 1 do: [ :index | - (array at: index) ifNil: [ ^index ] ]. - self error: 'There is no free space in this collection!!'! Item was changed: ----- Method: Dictionary>>scanFor: (in category 'private') ----- scanFor: anObject + "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - | element start finish | - finish := array size. - start := (anObject hash \\ finish) + 1. - - "Search from (hash mod size) to the end." - start to: finish do: - [:index | ((element := array at: index) == nil or: [element key = anObject]) - ifTrue: [^ index ]]. + | index start | + index := start := anObject hash \\ array size + 1. + [ + | element | + ((element := array at: index) == nil or: [ element key = anObject ]) + ifTrue: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - "Search from 1 to where we started." - 1 to: start-1 do: - [:index | ((element := array at: index) == nil or: [element key = anObject]) - ifTrue: [^ index ]]. - - ^ 0 "No match AND no empty slot"! Item was changed: ----- Method: KeyedIdentitySet>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start hash | + array size > 4096 + ifTrue: [ hash := anObject identityHash * (array size // 4096) ] - | finish hash start | - (finish := array size) > 4096 - ifTrue: [ hash := anObject identityHash * (finish // 4096) ] ifFalse: [ hash := anObject identityHash ]. + index := start := hash \\ array size + 1. + [ + (array at: index) ifNil: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - start := hash \\ finish + 1. - "Search from (hash mod size) to the end." - start to: finish do: [ :index | - (array at: index) ifNil: [ ^index ] ]. - "Search from 1 to where we started." - 1 to: start - 1 do: [ :index | - (array at: index) ifNil: [ ^index ] ]. - self error: 'There is no free space in this collection!!'! Item was changed: ----- Method: IdentityDictionary>>scanFor: (in category 'private') ----- scanFor: anObject + "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - | finish hash start element | - finish := array size. - finish > 4096 - ifTrue: [hash := anObject identityHash * (finish // 4096)] - ifFalse: [hash := anObject identityHash]. - start := (hash \\ finish) + 1. - - "Search from (hash mod size) to the end." - start to: finish do: - [:index | ((element := array at: index) == nil or: [element key == anObject]) - ifTrue: [^ index ]]. - - "Search from 1 to where we started." - 1 to: start-1 do: - [:index | ((element := array at: index) == nil or: [element key == anObject]) - ifTrue: [^ index ]]. + | index start hash | + array size > 4096 + ifTrue: [ hash := anObject identityHash * (array size // 4096) ] + ifFalse: [ hash := anObject identityHash ]. + index := start := hash \\ array size + 1. + [ + | element | + ((element := array at: index) == nil or: [ element key == anObject ]) + ifTrue: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - ^ 0 "No match AND no empty slot"! Item was changed: ----- Method: KeyedSet>>noCheckAdd: (in category 'private') ----- noCheckAdd: anObject + array at: (self scanFor: (keyBlock value: anObject)) put: anObject. - array at: (self findElementOrNil: (keyBlock value: anObject)) put: anObject. tally := tally + 1! Item was changed: ----- Method: Dictionary>>add: (in category 'adding') ----- add: anAssociation | index element | + index := self scanFor: anAssociation key. - index := self findElementOrNil: anAssociation key. element := array at: index. element == nil ifTrue: [self atNewIndex: index put: anAssociation] ifFalse: [element value: anAssociation value]. ^ anAssociation! Item was changed: ----- Method: WeakIdentityKeyDictionary>>scanFor: (in category 'private') ----- scanFor: anObject + "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - | element start finish hash | - finish := array size. - finish > 4096 - ifTrue: [hash := anObject identityHash * (finish // 4096)] - ifFalse: [hash := anObject identityHash]. - start := (hash \\ finish) + 1. - - "Search from (hash mod size) to the end." - start to: finish do: - [:index | ((element := array at: index) == nil or: [element key == anObject]) - ifTrue: [^ index ]]. - - "Search from 1 to where we started." - 1 to: start-1 do: - [:index | ((element := array at: index) == nil or: [element key == anObject]) - ifTrue: [^ index ]]. + | index start hash | + array size > 4096 + ifTrue: [ hash := anObject identityHash * (array size // 4096) ] + ifFalse: [ hash := anObject identityHash ]. + index := start := hash \\ array size + 1. + [ + | element | + ((element := array at: index) == nil or: [ element key == anObject ]) + ifTrue: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - ^ 0 "No match AND no empty slot"! Item was changed: ----- Method: WeakSet>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by flag or a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start | + index := start := anObject hash \\ array size + 1. + [ + | element | + ((element := array at: index) == flag or: [ element == nil ]) ifTrue: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - | start element | - start := anObject hash \\ array size + 1. - "Search from (hash mod size) to the end." - start to: array size do: [ :index | - ((element := array at: index) == flag or: [ element == nil ]) ifTrue: [ ^index ] ]. - "Search from 1 to where we started." - 1 to: start - 1 do: [ :index | - ((element := array at: index) == flag or: [ element == nil ]) ifTrue: [ ^index ] ]. - self error: 'There is no free space in this collection!!'! Item was changed: ----- Method: Dictionary>>associationAt:ifAbsent: (in category 'accessing') ----- associationAt: key ifAbsent: aBlock "Answer the association with the given key. If key is not found, return the result of evaluating aBlock." | index assoc | + index := self scanFor: key. - index := self findElementOrNil: key. assoc := array at: index. nil == assoc ifTrue: [ ^ aBlock value ]. ^ assoc! Item was changed: ----- Method: KeyedSet>>includesKey: (in category 'testing') ----- includesKey: key + ^ (array at: (self scanFor: key)) ~~ nil! - ^ (array at: (self findElementOrNil: key)) ~~ nil! Item was changed: ----- Method: KeyedSet>>remove:ifAbsent: (in category 'removing') ----- remove: oldObject ifAbsent: aBlock | index | + index := self scanFor: (keyBlock value: oldObject). - index := self findElementOrNil: (keyBlock value: oldObject). (array at: index) == nil ifTrue: [ ^ aBlock value ]. array at: index put: nil. tally := tally - 1. self fixCollisionsFrom: index. ^ oldObject! Item was changed: ----- Method: Set>>noCheckAdd: (in category 'private') ----- noCheckAdd: anObject + array at: (self scanFor: anObject) put: anObject. - array at: (self findElementOrNil: anObject) put: anObject. tally := tally + 1! Item was changed: ----- Method: KeyedSet>>removeKey:ifAbsent: (in category 'removing') ----- removeKey: key ifAbsent: aBlock | index obj | + index := self scanFor: key. - index := self findElementOrNil: key. (obj := array at: index) == nil ifTrue: [ ^ aBlock value ]. array at: index put: nil. tally := tally - 1. self fixCollisionsFrom: index. ^ obj! Item was changed: ----- Method: KeyedSet>>includes: (in category 'testing') ----- includes: anObject + ^ (array at: (self scanFor: (keyBlock value: anObject))) ~~ nil! - ^ (array at: (self findElementOrNil: (keyBlock value: anObject))) ~~ nil! Item was changed: ----- Method: IdentityDictionary>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start hash | + array size > 4096 + ifTrue: [ hash := anObject identityHash * (array size // 4096) ] - | finish hash start | - (finish := array size) > 4096 - ifTrue: [ hash := anObject identityHash * (finish // 4096) ] ifFalse: [ hash := anObject identityHash ]. + index := start := hash \\ array size + 1. + [ + (array at: index) ifNil: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - start := hash \\ finish + 1. - "Search from (hash mod size) to the end." - start to: finish do: [ :index | - (array at: index) ifNil: [ ^index ] ]. - "Search from 1 to where we started." - 1 to: start - 1 do: [ :index | - (array at: index) ifNil: [ ^index ] ]. - self error: 'There is no free space in this collection!!'! Item was changed: ----- Method: Dictionary>>noCheckAdd: (in category 'private') ----- noCheckAdd: anObject + "Must be defined separately for Dictionary because (self scanFor:) expects a key, + not an association. 9/7/96 tk" - "Must be defined separately for Dictionary because (self findElementOrNil:) expects a key, not an association. 9/7/96 tk" + array at: (self scanFor: anObject key) put: anObject. - array at: (self findElementOrNil: anObject key) put: anObject. tally := tally + 1! Item was changed: ----- Method: WeakValueDictionary>>at:put: (in category 'accessing') ----- at: key put: anObject "Set the value at key to be anObject. If key is not found, create a new entry for key and set is value to anObject. Answer anObject." | index element | + index := self scanFor: key. - index := self findElementOrNil: key. element := array at: index. element == nil ifTrue: [self atNewIndex: index put: (WeakValueAssociation key: key value: anObject)] ifFalse: [element value: anObject]. ^ anObject! Item was changed: ----- Method: KeyedSet>>member: (in category 'adding') ----- member: newObject "Include newObject as one of the receiver's elements, if already exists just return it" | index | newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element']. + index := self scanFor: (keyBlock value: newObject). - index := self findElementOrNil: (keyBlock value: newObject). (array at: index) ifNotNil: [^ array at: index]. self atNewIndex: index put: newObject. ^ newObject! Item was added: + ----- Method: Set>>errorNoFreeSpace (in category 'private') ----- + errorNoFreeSpace + + self error: 'There is no free space in this collection!!'! Item was changed: ----- Method: PluggableDictionary>>scanFor: (in category 'private') ----- scanFor: anObject + "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - "Scan the key array for the first slot containing either a nil (indicating an empty slot) - or an element that matches anObject. Answer the index of that slot or zero if no slot - is found. This method will be overridden in various subclasses that have different - interpretations for matching elements." + | index start | + index := start := (hashBlock + ifNil: [ anObject hash ] + ifNotNil: [ hashBlock value: anObject ]) \\ array size + 1. + [ + | element | + ((element := array at: index) == nil or: [ + equalBlock + ifNil: [ element key = anObject ] + ifNotNil: [ equalBlock value: element key value: anObject ] ]) + ifTrue: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - | element start | - start := (hashBlock ifNil: [anObject hash] - ifNotNil: [hashBlock value: anObject]) - \\ array size + 1. - "Search from (hash mod size) to the end." - start to: array size do: [:index | ((element := array at: index) == nil or: - [equalBlock ifNil: [element key = anObject] - ifNotNil: [equalBlock value: element key value: anObject]]) - ifTrue: [^ index]]. - "Search from 1 to where we started." - 1 to: start - 1 do: [:index | ((element := array at: index) == nil or: - [equalBlock ifNil: [element key = anObject] - ifNotNil: [equalBlock value: element key value: anObject]]) - ifTrue: [^ index]]. - ^ 0"No match AND no empty slot"! Item was changed: ----- Method: Set>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start | + index := start := anObject hash \\ array size + 1. + [ + (array at: index) ifNil: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - | start | - start := anObject hash \\ array size + 1. - "Search from (hash mod size) to the end." - start to: array size do: [ :index | - (array at: index) ifNil: [ ^index ] ]. - "Search from 1 to where we started." - 1 to: start - 1 do: [ :index | - (array at: index) ifNil: [ ^index ] ]. - self error: 'There is no free space in this collection!!'! Item was changed: ----- Method: Set>>like: (in category 'accessing') ----- like: anObject "Answer an object in the receiver that is equal to anObject, nil if no such object is found. Relies heavily on hash properties" | index | + index := self scanFor: anObject. + ^array at: index! - - ^(index := self scanFor: anObject) = 0 - ifFalse: [array at: index]! Item was changed: ----- Method: KeyedSet>>at:ifAbsent: (in category 'accessing') ----- at: key ifAbsent: aBlock "Answer the value associated with the key or, if key isn't found, answer the result of evaluating aBlock." | obj | + obj := array at: (self scanFor: key). - obj := array at: (self findElementOrNil: key). obj ifNil: [^ aBlock value]. ^ obj! Item was changed: ----- Method: WeakSet>>do:after: (in category 'public') ----- do: aBlock after: anElement | each startIndex | tally = 0 ifTrue: [^self]. startIndex := anElement ifNil: [1] ifNotNil: + [self scanFor: anElement]. - [self findElementOrNil: anElement]. startIndex + 1 to: array size do: [:index | ((each := array at: index) == nil or: [each == flag]) ifFalse: [aBlock value: each] ]! Item was changed: ----- Method: PluggableSet>>scanFor: (in category 'private') ----- scanFor: anObject + "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." + + | index start | + index := start := (hashBlock - "Scan the key array for the first slot containing either a nil (indicating an empty slot) - or an element that matches anObject. Answer the index of that slot or zero if no slot - is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - | element start | - start := (hashBlock ifNil: [ anObject hash ] ifNotNil: [ hashBlock value: anObject ]) \\ array size + 1. + [ + | element | + ((element := array at: index) == nil or: [ + equalBlock + ifNil: [ element = anObject ] + ifNotNil: [ equalBlock value: element value: anObject ] ]) + ifTrue: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - "Search from (hash mod size) to the end." - start to: array size do: [:index | ((element := array at: index) == nil or: - [equalBlock ifNil: [element = anObject] - ifNotNil: [equalBlock value: element value: anObject]]) - ifTrue: [^ index]]. - "Search from 1 to where we started." - 1 to: start - 1 do: [:index | ((element := array at: index) == nil or: - [equalBlock ifNil: [element = anObject] - ifNotNil: [equalBlock value: element value: anObject]]) - ifTrue: [^ index]]. - ^ 0"No match AND no empty slot"! Item was changed: ----- Method: WeakSet>>remove:ifAbsent: (in category 'public') ----- remove: oldObject ifAbsent: aBlock | index | + index := self scanFor: oldObject. - index := self findElementOrNil: oldObject. (array at: index) == flag ifTrue: [ ^ aBlock value ]. array at: index put: flag. tally := tally - 1. self fixCollisionsFrom: index. ^oldObject! Item was added: + ----- Method: Set>>postCopy (in category 'copying') ----- + postCopy + + array := array shallowCopy! Item was changed: ----- Method: Set>>remove:ifAbsent: (in category 'removing') ----- remove: oldObject ifAbsent: aBlock | index | + index := self scanFor: oldObject. + (array at: index) ifNil: [ ^ aBlock value ]. - index := self findElementOrNil: oldObject. - (array at: index) == nil ifTrue: [ ^ aBlock value ]. array at: index put: nil. tally := tally - 1. self fixCollisionsFrom: index. ^ oldObject! Item was changed: ----- Method: WeakSet>>includes: (in category 'public') ----- includes: anObject + ^(array at: (self scanFor: anObject)) ~~ flag! - ^(array at: (self findElementOrNil: anObject)) ~~ flag! Item was changed: ----- Method: Set>>includes: (in category 'testing') ----- includes: anObject + ^ (array at: (self scanFor: anObject)) ~~ nil! - ^ (array at: (self findElementOrNil: anObject)) ~~ nil! Item was changed: ----- Method: WeakIdentityKeyDictionary>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start hash | + array size > 4096 + ifTrue: [ hash := anObject identityHash * (array size // 4096) ] - | finish hash start | - (finish := array size) > 4096 - ifTrue: [ hash := anObject identityHash * (finish // 4096) ] ifFalse: [ hash := anObject identityHash ]. + index := start := hash \\ array size + 1. + [ + (array at: index) ifNil: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - start := hash \\ finish + 1. - "Search from (hash mod size) to the end." - start to: finish do: [ :index | - (array at: index) ifNil: [ ^index ] ]. - "Search from 1 to where we started." - 1 to: start - 1 do: [ :index | - (array at: index) ifNil: [ ^index ] ]. - self error: 'There is no free space in this collection!!'! Item was changed: ----- Method: PluggableDictionary>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start | + index := start := (hashBlock - | start | - start := (hashBlock ifNil: [ anObject hash ] ifNotNil: [ hashBlock value: anObject ]) \\ array size + 1. + [ + (array at: index) ifNil: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - "Search from (hash mod size) to the end." - start to: array size do: [ :index | - (array at: index) ifNil: [ ^index ] ]. - "Search from 1 to where we started." - 1 to: start - 1 do: [ :index | - (array at: index) ifNil: [ ^index ] ]. - self error: 'There is no free space in this collection!!'! Item was changed: ----- Method: WeakSet>>fixCollisionsFrom: (in category 'private') ----- + fixCollisionsFrom: start - fixCollisionsFrom: index - "The element at index has been removed and replaced by nil. - This method moves forward from there, relocating any entries - that had been placed below due to collisions with this one" - - | length oldIndex newIndex element | + "The element at start has been removed and replaced by flag. + This method moves forward from there, relocating any entries + that had been placed below due to collisions with this one." + + | element index | + index := start. + [ (element := self keyAt: (index := index \\ array size + 1)) == flag ] whileFalse: [ + | newIndex | + (newIndex := self scanFor: element) = index ifFalse: [ + self swap: index with: newIndex ] ] + ! - oldIndex := index. - length := array size. - [oldIndex = length - ifTrue: [oldIndex := 1] - ifFalse: [oldIndex := oldIndex + 1]. - (element := self keyAt: oldIndex) == flag] - whileFalse: - [newIndex := self findElementOrNil: element. - oldIndex = newIndex ifFalse: [self swap: oldIndex with: newIndex]]! Item was added: + ----- Method: Dictionary>>postCopy (in category 'copying') ----- + postCopy + "Must copy the associations, or later store will affect both the + original and the copy" + + array := array collect: [ :association | + association ifNotNil: [ association copy ] ]! Item was changed: ----- Method: Set>>fixCollisionsFrom: (in category 'private') ----- + fixCollisionsFrom: start + "The element at start has been removed and replaced by nil. - fixCollisionsFrom: index - "The element at index has been removed and replaced by nil. This method moves forward from there, relocating any entries + that had been placed below due to collisions with this one." - that had been placed below due to collisions with this one" + | element index | + index := start. + [ (element := self keyAt: (index := index \\ array size + 1)) == nil ] whileFalse: [ + | newIndex | + (newIndex := self scanFor: element) = index ifFalse: [ + self swap: index with: newIndex ] ]! - | length oldIndex newIndex element | - - oldIndex := index. - length := array size. - [oldIndex = length - ifTrue: [oldIndex := 1] - ifFalse: [oldIndex := oldIndex + 1]. - (element := self keyAt: oldIndex) == nil] - whileFalse: - [newIndex := self findElementOrNil: element. - oldIndex = newIndex ifFalse: [self swap: oldIndex with: newIndex]]! Item was changed: ----- Method: IdentitySet>>scanFor: (in category 'private') ----- scanFor: anObject + "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - | finish hash start element | - finish := array size. - finish > 4096 - ifTrue: [hash := anObject identityHash * (finish // 4096)] - ifFalse: [hash := anObject identityHash]. - start := (hash \\ finish) + 1. - - "Search from (hash mod size) to the end." - start to: finish do: - [:index | ((element := array at: index) == nil or: [element == anObject]) - ifTrue: [^ index ]]. - - "Search from 1 to where we started." - 1 to: start-1 do: - [:index | ((element := array at: index) == nil or: [element == anObject]) - ifTrue: [^ index ]]. + | index start hash | + array size > 4096 + ifTrue: [ hash := anObject identityHash * (array size // 4096) ] + ifFalse: [ hash := anObject identityHash ]. + index := start := hash \\ array size + 1. + [ + | element | + ((element := array at: index) == nil or: [ element == anObject ]) + ifTrue: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - ^ 0 "No match AND no empty slot"! Item was changed: ----- Method: KeyedIdentitySet>>scanFor: (in category 'private') ----- scanFor: anObject + "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - - | element hash start finish | - finish := array size. - finish > 4096 - ifTrue: [ hash := anObject identityHash * (finish // 4096) ] - ifFalse: [ hash := anObject identityHash ]. - start := hash \\ finish + 1. - - "Search from (hash mod size) to the end." - start to: finish do: - [:index | ((element := array at: index) == nil or: [(keyBlock value: element) == anObject]) - ifTrue: [^ index ]]. - - "Search from 1 to where we started." - 1 to: start-1 do: - [:index | ((element := array at: index) == nil or: [(keyBlock value: element) == anObject]) - ifTrue: [^ index ]]. + | index start hash | + array size > 4096 + ifTrue: [ hash := anObject identityHash * (array size // 4096) ] + ifFalse: [ hash := anObject identityHash ]. + index := start := hash \\ array size + 1. + [ + | element | + ((element := array at: index) == nil or: [ (keyBlock value: element) == anObject ]) + ifTrue: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - ^ 0 "No match AND no empty slot"! Item was changed: ----- Method: Dictionary>>removeKey:ifAbsent: (in category 'removing') ----- removeKey: key ifAbsent: aBlock "Remove key (and its associated value) from the receiver. If key is not in the receiver, answer the result of evaluating aBlock. Otherwise, answer the value externally named by key." + | index association | + index := self scanFor: key. + (association := array at: index) ifNil: [ ^ aBlock value ]. - | index assoc | - index := self findElementOrNil: key. - assoc := array at: index. - assoc == nil ifTrue: [ ^ aBlock value ]. array at: index put: nil. tally := tally - 1. self fixCollisionsFrom: index. + ^association value! - ^ assoc value! Item was changed: ----- Method: KeyedSet>>scanFor: (in category 'private') ----- scanFor: anObject + "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - | element start finish | - finish := array size. - start := (anObject hash \\ finish) + 1. - - "Search from (hash mod size) to the end." - start to: finish do: - [:index | ((element := array at: index) == nil or: [(keyBlock value: element) = anObject]) - ifTrue: [^ index ]]. + | index start | + index := start := anObject hash \\ array size + 1. + [ + | element | + ((element := array at: index) == nil or: [ (keyBlock value: element) = anObject ]) + ifTrue: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - "Search from 1 to where we started." - 1 to: start-1 do: - [:index | ((element := array at: index) == nil or: [(keyBlock value: element) = anObject]) - ifTrue: [^ index ]]. - - ^ 0 "No match AND no empty slot"! Item was changed: ----- Method: Dictionary>>at:ifAbsent: (in category 'accessing') ----- at: key ifAbsent: aBlock "Answer the value associated with the key or, if key isn't found, answer the result of evaluating aBlock." | assoc | + assoc := array at: (self scanFor: key). - assoc := array at: (self findElementOrNil: key). assoc ifNil: [^ aBlock value]. ^ assoc value! Item was changed: ----- Method: PluggableSet>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start | + index := start := (hashBlock - | start | - start := (hashBlock ifNil: [ anObject hash ] ifNotNil: [ hashBlock value: anObject ]) \\ array size + 1. + [ + (array at: index) ifNil: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse: [ ]. + self errorNoFreeSpace! - "Search from (hash mod size) to the end." - start to: array size do: [ :index | - (array at: index) ifNil: [ ^index ] ]. - "Search from 1 to where we started." - 1 to: start - 1 do: [ :index | - (array at: index) ifNil: [ ^index ] ]. - self error: 'There is no free space in this collection!!'! Item was changed: ----- Method: Dictionary>>at:put: (in category 'accessing') ----- at: key put: anObject "Set the value at key to be anObject. If key is not found, create a new entry for key and set is value to anObject. Answer anObject." | index assoc | + index := self scanFor: key. - index := self findElementOrNil: key. assoc := array at: index. assoc ifNil: [self atNewIndex: index put: (Association key: key value: anObject)] ifNotNil: [assoc value: anObject]. ^ anObject! Item was changed: ----- Method: KeyedSet>>add: (in category 'adding') ----- add: newObject "Include newObject as one of the receiver's elements, but only if not already present. Answer newObject." | index | newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element']. + index := self scanFor: (keyBlock value: newObject). - index := self findElementOrNil: (keyBlock value: newObject). (array at: index) ifNil: [self atNewIndex: index put: newObject]. ^ newObject! Item was removed: - ----- Method: Set>>copy (in category 'copying') ----- - copy - ^ self shallowCopy withArray: array shallowCopy! Item was removed: - ----- Method: Dictionary>>copy (in category 'private') ----- - copy - "Must copy the associations, or later store will affect both the - original and the copy" - - ^ self shallowCopy withArray: - (array collect: [:assoc | - assoc ifNil: [nil] - ifNotNil: [Association key: assoc key - value: assoc value]])! Item was removed: - ----- Method: WeakKeyDictionary>>scanFor: (in category 'private') ----- - scanFor: anObject - "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." - | element start finish | - finish := array size. - start := (anObject hash \\ finish) + 1. - - "Search from (hash mod size) to the end." - start to: finish do: - [:index | ((element := array at: index) == nil or: [element key = anObject]) - ifTrue: [^ index ]]. - - "Search from 1 to where we started." - 1 to: start-1 do: - [:index | ((element := array at: index) == nil or: [element key = anObject]) - ifTrue: [^ index ]]. - - ^ 0 "No match AND no empty slot"! Item was removed: - ----- Method: KeyedSet>>fixCollisionsFrom: (in category 'private') ----- - fixCollisionsFrom: index - "The element at index has been removed and replaced by nil. - This method moves forward from there, relocating any entries - that had been placed below due to collisions with this one" - | length oldIndex newIndex element | - oldIndex := index. - length := array size. - [oldIndex = length - ifTrue: [oldIndex := 1] - ifFalse: [oldIndex := oldIndex + 1]. - (element := self keyAt: oldIndex) == nil] - whileFalse: - [newIndex := self findElementOrNil: (keyBlock value: element). - oldIndex = newIndex ifFalse: [self swap: oldIndex with: newIndex]]! Item was removed: - ----- Method: Set>>withArray: (in category 'private') ----- - withArray: anArray - "private -- for use only in copy" - array := anArray!

1 0

Where to find the FT2Plugin sources
by Damien Cassou 27 Sep '09

27 Sep '09

Hi, where can I get the free type plugin sources for the unix Squeak vm? Thank you -- Damien Cassou http://damiencassou.seasidehosting.st "Lambdas are relegated to relative obscurity until Java makes them popular by not having them." James Iry

4 3

Cannot copy and paste between images on Linux with new vm
by Ralph Boland 27 Sep '09

27 Sep '09

I recently downloaded the new Squeak vm i.e. Squeak-3.11.3.2135-linux_i386.deb onto my ubuntu 9.10 (Linux) machine and also the image/changes files in Squeak3.10.2-Trunk-090919.zip I can now no longer copy and paste between images because my carriage returns are lost when I paste the text. This problem now also occurs if I run an older sqeuak3.10.2 image so I assume the problem relates to the virtual machine somehow. Any suggestions on how to fix this other than reverting back to an older virtual machine? Ralph Boland -- Quantum Theory cannot save us from the tyranny of a deterministic universe. But it does give God something to do.

4 3

How to package changes on submit?
by Markus Lampert 27 Sep '09

27 Sep '09

Hi all, I have some enhancements for splitters in tool builder windows. Affected are the packages Morphic-Windows (ProportionalSplitterMorph, ScrollBar, ScrollPane) and Morphic-Layouts (LayoutFrame). As I understand it I should submit a package to the 'inbox'.So, should I a) submit a new version of the existing Monticello package 'Morphic' (1.5M)? b) create two packages 'Morphic-Windows' (104k) and 'Morphic-Layouts' (22k) and submit them independently? Have fun, Markus

3 2

3.11.3.2135 for Unix
by Ian Piumarta 27 Sep '09

27 Sep '09

Dear Unix Squeakers, 3.11.3.2135 for Unix is now available at squeakvm.org/unix (sources plus binaries for MacOS/Darwin, Linux, NetBSD, FreeBSD and Solaris, on Intel and, occasionally, PowerPC hardware). Some important stuff has changed in this release (see notes below) so please consider it a BETA release even though there is no beta tag on the version number. As usual: comments, suggestions, bug fixes (as whole files please *not* diffs) and any unwanted vinyl LPs sitting in your attic can be sent directly to me. Thanks. Enjoy! Ian Changes since 3.10-6: Numbering scheme changed to X.Y.Z.R where X.Y.Z = VMMaker version used to generate the Interpreter and R is the subversion revision of the platform support code. VMMaker and plugins updated to most recent versions; generated source regenerated: Balloon3D-Plugins-ar.4.mcz DBus-Plugin-bf.32.mcz GStreamer-Plugins-JMM.16.mcz Kedama-Plugins-yo.1.mcz Rome-Plugin-yo.39.mcz OSProcessPlugin-dtl.16.mcz VMConstruction-Plugins-AioPlugin-dtl.9.mcz VMConstruction-Plugins-XDisplayControlPlugin-dtl.7.mcz VMMaker-dtl.138.mcz Build system rewritten using CMake instead of autotools. Big THANK-YOU to Bert, Subbu and Dave Lewis for providing invaluable feedback. Any plugin can now be turned off in configure with the option '--without-<pluginName>'. Experimental PulseAudio driver (vm-sound-pulse) added, thanks to Derek O'Connell. Default is still OSS on Linux; if you want pulse you have to ask for it in one of the usual ways. FFI tweaked on Linux to avoid a potential FPU stack overflow. ClipboardExtendedPlugin will no longer try to build if you don't have X11 development headers and libs. FileCopyPlugin made resilient to EINTR. VM renamed to 'squeakvm'. 'squeak' is now a script that looks for 'squeakvm', figures out if you need any obscure command-line options, and then launches 'squeakvm' for you. This in turn allows... Plugin search stretegy rationalised and simplified. Default location is now the executable directory (where 'squeakvm' is installed). The -plugins argument can be a colon-separated list of locations to search, just like PATH. Plugins are named 'so.plugin' to make interference with FFI libraries less likely. NOTE: FFI libraries are no longer searched for in every single nook and cranny, which means you might have to set LD_LIBRARY_PATH (or your local equivalent) for FFI-based programs to work properly. Failure to load a plugin because of unresolved symbols is now always reported on the terminal. Another script 'squeak.sh' is provided for launching squeak from a menu. This isn't finished and suggestions are welcome. Default path and text encoding is now UTF-8. X11 driver no longer reports SHIFT pressed when CAPS LOCK engaged. SerialPlugin now supports named ports. All occurences of dprintf() renamed to avoid a name conflict with a less-than-stellar decision by POSIX to introduce a standard function of the same name. RomePlugin is no longer built if cairo was built without Pango support. iconv_open() no longer spams you with thousands of error messages if you are missing conversion tables. Valid unicode characters that have no corresponding keycode are reported with keycode zero to avoid an invalid index error in the image. XImmPlugin should now work on MacOS X/Darwin too. Sound driver on MacOS X now works on Intel as well as PowerPC. Various changes to make the VM compile and run on GNU/Linux running on DEC Alpha. vm-sound-Sun now uses asynchronous i/o. Various changes to fix compilation on Solaris.

8 23

The Trunk: Morphic-ar.195.mcz
by commits＠source.squeak.org 27 Sep '09

27 Sep '09

Andreas Raab uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ar.195.mcz ==================== Summary ==================== Name: Morphic-ar.195 Author: ar Time: 26 September 2009, 8:17:47 am UUID: 8db33b9f-5897-ac48-8273-a6f07a03f5c3 Ancestors: Morphic-ml.194 Fixes the standard font chooser for changing default system fonts (list, window, code etc) which require the ability to set the emphasis flags for them. =============== Diff against Morphic-ml.194 =============== Item was changed: ----- Method: TextMorphEditor>>changeTextFont (in category 'attributes') ----- changeTextFont "Present a dialog which allows the user to select a font, and if one is chosen, apply it to the current selection. If there is no selection, or the selection is empty, apply it to the whole morph." | curFont startIndex chooser newFont | startIndex := self startIndex. curFont := (paragraph text fontAt: startIndex withStyle: paragraph textStyle). morph openModal: ( Cursor wait showWhile: [ (chooser := FontChooserTool default withTitle: 'Change the selected text''s font to...' translated for: self setSelector: #changeSelectionFontTo: + getSelector: curFont) + "Do not allow changing the emphasis; we don't know how to deal with + a 'pre-emphasized' font here, so bail." + offerStyleList: false; + open]). - getSelector: curFont) open]). newFont := chooser result. newFont ifNotNil:[self changeSelectionFontTo: newFont].! Item was changed: ----- Method: TextEditor>>changeTextFont (in category 'attributes') ----- changeTextFont "Present a dialog which allows the user to select a font, and if one is chosen, apply it to the current selection. If there is no selection, or the selection is empty, apply it to the whole morph." | curFont startIndex chooser newFont | startIndex := self startIndex. curFont := (paragraph text fontAt: startIndex withStyle: paragraph textStyle). morph openModal: ( Cursor wait showWhile: [ (chooser := FontChooserTool default withTitle: 'Change the selected text''s font to...' translated for: self setSelector: #changeSelectionFontTo: + getSelector: curFont) + "Do not allow changing the emphasis; we don't know how to deal with + a 'pre-emphasized' font here, so bail." + offerStyleList: false; + open]). - getSelector: curFont) open]). newFont := chooser result. newFont ifNotNil:[self changeSelectionFontTo: newFont].! Item was changed: ----- Method: FontChooserTool>>offerStyleList (in category 'initialize') ----- offerStyleList + "Whether to offer a choice of styles with the font." + ^offerStyleList! - "Whether to offer a choice of styles with the font. - Currently disabled since most of the text machinery doesn't like emphasis - already being applied to the font. Would have to decompose font/emphasis - in order for that to work." - ^false! Item was added: + ----- Method: FontChooserTool>>selectedTextStyle (in category 'font list') ----- + selectedTextStyle + + ^TextStyle named: (self selectedFontFamily ifNil:[^TextStyle default]).! Item was changed: ----- Method: FontChooserTool>>pointSizeList (in category 'point size') ----- pointSizeList + ^self selectedTextStyle pointSizes collect: [:each | each asString padded: #left to: 3 with: $ ]! - ^self selectedFont textStyle pointSizes collect: [:each | each asString padded: #left to: 3 with: $ ]! Item was changed: Model subclass: #FontChooserTool + instanceVariableNames: 'title selectedFontIndex fontList target getSelector setSelector pointSize emphasis window result offerStyleList' - instanceVariableNames: 'title selectedFontIndex fontList target getSelector setSelector pointSize emphasis window result' classVariableNames: 'Default' poolDictionaries: '' category: 'Morphic-Support'! !FontChooserTool commentStamp: 'ar 8/30/2009 14:28' prior: 0! A ToolBuilder version of FreeTypePlus' FontChooser[Morph].! Item was changed: ----- Method: FontChooserTool>>selectedFont (in category 'font list') ----- selectedFont + | font | + font := self selectedTextStyle fontOfPointSize: pointSize. - | font family | - family := self fontList at: self selectedFontIndex ifAbsent:[^TextStyle defaultFont]. - font := (TextStyle named: family) fontOfPointSize: pointSize. ^font emphasized: emphasis! Item was added: + ----- Method: FontChooserTool>>offerStyleList: (in category 'initialize') ----- + offerStyleList: aBool + "Whether to offer a choice of styles with the font." + offerStyleList := aBool! Item was changed: ----- Method: FontChooserTool>>initialize (in category 'initialize') ----- initialize super initialize. title := 'Choose A Font'. getSelector := TextStyle defaultFont. + emphasis := 0. + offerStyleList := true.! - emphasis := 0.! Item was removed: - ----- Method: TextEditor>>changeTextFontDialog (in category 'attributes') ----- - changeTextFontDialog - "Present a dialog which allows the user to select a font, and if one is chosen, apply it to the current selection. If there is no selection, or the selection is empty, apply it to the whole morph." - | curFont startIndex chooser newFont | - startIndex := self startIndex. - curFont := (paragraph text fontAt: startIndex withStyle: paragraph textStyle). - (curFont isKindOf: LogicalFont) - ifTrue:[ - curFont := curFont copy. - ((paragraph text emphasisAt: startIndex) anyMask: 1) ifTrue:[curFont forceBold]. - ((paragraph text emphasisAt: startIndex) anyMask: 2) ifTrue:[curFont forceItalicOrOblique]. - curFont clearRealFont]. - morph openModal: ( - Cursor wait showWhile: [ - (chooser := FontChooserTool default - withTitle: 'Change the selected text''s font to...' translated - for: self - setSelector: #changeSelectionFontTo: - getSelector: curFont) open]). - newFont := chooser result. - newFont ifNotNil:[self changeSelectionFontTo: newFont].!

1 0

← Newer
1
2
3
4
5
6
7
8
9
...
37
Older →

Jump to page: