The Trunk: Collections-dtl.395.mcz

David T. Lewis uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-dtl.395.mcz

==================== Summary ====================

Name: Collections-dtl.395
Author: dtl
Time: 24 October 2010, 1:00:08.124 pm
UUID: 89a62a10-7b7b-4963-b90b-83adb9a0c2f1
Ancestors: Collections-eem.394

Use pragma declarations in methods that are translated to C in MiscPrimitivePlugin. Supports removal of Object>>inline: and Object>>var:declareC: from trunk.

=============== Diff against Collections-eem.394 ===============

Item was changed:
  ----- Method: ByteArray class>>hashBytes:startingWith: (in category 'byte based hash') -----
  hashBytes: aByteArray startingWith: speciesHash
  "Answer the hash of a byte-indexed collection,
  using speciesHash as the initial value.
  See SmallInteger>>hashMultiply.
 
  The primitive should be renamed at a
  suitable point in the future"
 
  | byteArraySize hash low |
  <primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'>
+ <var: #aHash declareC: 'int speciesHash'>
+ <var: #aByteArray declareC: 'unsigned char *aByteArray'>
 
- self var: #aHash declareC: 'int speciesHash'.
- self var: #aByteArray declareC: 'unsigned char *aByteArray'.
-
  byteArraySize := aByteArray size.
  hash := speciesHash bitAnd: 16rFFFFFFF.
  1 to: byteArraySize do: [:pos |
  hash := hash + (aByteArray basicAt: pos).
  "Begin hashMultiply"
  low := hash bitAnd: 16383.
  hash := (16r260D * low + ((16r260D * (hash bitShift: -14) + (16r0065 * low) bitAnd: 16383) * 16384)) bitAnd: 16r0FFFFFFF.
  ].
  ^ hash!

Item was changed:
  ----- Method: ByteString class>>compare:with:collated: (in category 'primitives') -----
  compare: string1 with: string2 collated: order
  "Return 1, 2 or 3, if string1 is <, =, or > string2, with the collating order of characters given by the order array."
 
  | len1 len2 c1 c2 |
  <primitive: 'primitiveCompareString' module: 'MiscPrimitivePlugin'>
+ <var: #string1 declareC: 'unsigned char *string1'>
+ <var: #string2 declareC: 'unsigned char *string2'>
+ <var: #order declareC: 'unsigned char *order'>
- self var: #string1 declareC: 'unsigned char *string1'.
- self var: #string2 declareC: 'unsigned char *string2'.
- self var: #order declareC: 'unsigned char *order'.
 
  len1 := string1 size.
  len2 := string2 size.
  1 to: (len1 min: len2) do:
  [:i |
  c1 := order at: (string1 basicAt: i) + 1.
  c2 := order at: (string2 basicAt: i) + 1.
  c1 = c2 ifFalse:
  [c1 < c2 ifTrue: [^ 1] ifFalse: [^ 3]]].
  len1 = len2 ifTrue: [^ 2].
  len1 < len2 ifTrue: [^ 1] ifFalse: [^ 3].
  !

Item was changed:
  ----- Method: ByteString class>>findFirstInString:inSet:startingAt: (in category 'primitives') -----
  findFirstInString: aString  inSet: inclusionMap  startingAt: start
  | i stringSize |
  <primitive: 'primitiveFindFirstInString' module: 'MiscPrimitivePlugin'>
+ <var: #aString declareC: 'unsigned char *aString'>
+ <var: #inclusionMap  declareC: 'char *inclusionMap'>
- self var: #aString declareC: 'unsigned char *aString'.
- self var: #inclusionMap  declareC: 'char *inclusionMap'.
 
  inclusionMap size ~= 256 ifTrue: [ ^0 ].
 
  i := start.
  stringSize := aString size.
  [ i <= stringSize and: [ (inclusionMap at: (aString at: i) asciiValue+1) = 0 ] ] whileTrue: [
  i := i + 1 ].
 
  i > stringSize ifTrue: [ ^0 ].
  ^i!

Item was changed:
  ----- Method: ByteString class>>indexOfAscii:inString:startingAt: (in category 'primitives') -----
  indexOfAscii: anInteger inString: aString startingAt: start
 
  | stringSize |
  <primitive: 'primitiveIndexOfAsciiInString' module: 'MiscPrimitivePlugin'>
+ <var: #aCharacter declareC: 'int anInteger'>
+ <var: #aString declareC: 'unsigned char *aString'>
 
- self var: #aCharacter declareC: 'int anInteger'.
- self var: #aString declareC: 'unsigned char *aString'.
-
  stringSize := aString size.
  start to: stringSize do: [:pos |
  (aString at: pos) asciiValue = anInteger ifTrue: [^ pos]].
 
  ^ 0
  !

Item was changed:
  ----- Method: ByteString class>>translate:from:to:table: (in category 'primitives') -----
  translate: aString from: start  to: stop  table: table
  "translate the characters in the string by the given table, in place"
  <primitive: 'primitiveTranslateStringWithTable' module: 'MiscPrimitivePlugin'>
+ <var: #table  declareC: 'unsigned char *table'>
+ <var: #aString  declareC: 'unsigned char *aString'>
- self var: #table  declareC: 'unsigned char *table'.
- self var: #aString  declareC: 'unsigned char *aString'.
 
  start to: stop do: [ :i |
  aString at: i put: (table at: (aString at: i) asciiValue+1) ]!

Item was changed:
  ----- Method: ByteString>>findSubstring:in:startingAt:matchTable: (in category 'comparing') -----
  findSubstring: key in: body startingAt: start matchTable: matchTable
  "Answer the index in the string body at which the substring key first occurs, at or beyond start.  The match is determined using matchTable, which can be used to effect, eg, case-insensitive matches.  If no match is found, zero will be returned.
 
  The algorithm below is not optimum -- it is intended to be translated to C which will go so fast that it wont matter."
  | index |
  <primitive: 'primitiveFindSubstring' module: 'MiscPrimitivePlugin'>
+ <var: #key declareC: 'unsigned char *key'>
+ <var: #body declareC: 'unsigned char *body'>
+ <var: #matchTable declareC: 'unsigned char *matchTable'>
- self var: #key declareC: 'unsigned char *key'.
- self var: #body declareC: 'unsigned char *body'.
- self var: #matchTable declareC: 'unsigned char *matchTable'.
 
  key size = 0 ifTrue: [^ 0].
  start to: body size - key size + 1 do:
  [:startIndex |
  index := 1.
  [(matchTable at: (body at: startIndex+index-1) asciiValue + 1)
  = (matchTable at: (key at: index) asciiValue + 1)]
  whileTrue:
  [index = key size ifTrue: [^ startIndex].
  index := index+1]].
  ^ 0
  "
  ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 1 matchTable: CaseSensitiveOrder 1
  ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 2 matchTable: CaseSensitiveOrder 7
  ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 8 matchTable: CaseSensitiveOrder 0
  ' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseSensitiveOrder 0
  ' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseInsensitiveOrder 7
  "!

Item was added:
+ ----- Method: WeakRegistry class>>migrateOldRegistries (in category 'migrating registry') -----
+ migrateOldRegistries
+ Smalltalk at: #WeakFinalizationRegistry ifAbsent: [ ^ self "already done" ].
+
+ Smalltalk recreateSpecialObjectsArray.
+ WeakArray restartFinalizationProcess.
+
+ Smalltalk garbageCollect; garbageCollect.
+
+ "leave no chance to interrupt migration"
+ Compiler evaluate: '
+ [ | old new oldClass newClass |
+ old := OrderedCollection new.
+ new := OrderedCollection new.
+ WeakRegistry allInstancesDo: [:registry | | newr |
+ old add: registry.
+ newr := WeakFinalizationRegistry basicNew initialize.
+ registry migrateTo: newr.
+ new add: newr ].
+ old asArray elementsForwardIdentityTo: new asArray.
+
+ oldClass := WeakRegistry.
+ newClass := WeakFinalizationRegistry.
+
+ Smalltalk forgetClass: newClass logged: false.
+ newClass superclass removeSubclass: newClass.
+ newClass setName: #WeakRegistry.
+ oldClass becomeForward: newClass.
+ ] forkAt: Processor highestPriority.
+ '.
+ !