The Trunk: Network-topa.165.mcz

Tobias Pape uploaded a new version of Network to project The Trunk:
http://source.squeak.org/trunk/Network-topa.165.mcz

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

Name: Network-topa.165
Author: topa
Time: 19 October 2015, 11:28:20.052 pm
UUID: b4b1febc-df00-4213-b76f-c007b06bb2e2
Ancestors: Network-ul.164

Simplify and speed up non-primitive UUID generation (hat-tip to Martin McClure <[hidden email]>)

Instead of generating all parts of the UUID separately, we generate
a single, 128-bit number and modify it slightly to match the UUID definition.
This complies with RFC 4122, Sec. 4.4.

This approach is 2500 times faster than the old method and only about 3 times
slower than the primitive. Hence, we disable the primitive and no longer need
to rely on the UUIDPlugin to be present.

Informational: The Timings:

{
'Pure allocation' -> [UUID basicNew: 16] bench.
'Primitive + alloc' -> [(UUID basicNew: 16) primMakeUUID] bench.
'Old +  alloc' -> [|u| u := (UUID basicNew: 16). UUIDGeneratorOld new generateBytes: u forVersion: 4] bench.
'New + alloc' -> [|u| u := (UUID basicNew: 16). UUIDGeneratorNew new generateBytes: u forVersion: 4] bench.
}.
"{
'Pure allocation'->'56,500,000 per second. 17.7 nanoseconds per run.' .
'Primitive + alloc'->'1,510,000 per second. 663 nanoseconds per run.' .
'Old +  alloc'->'202 per second. 4.95 milliseconds per run.' .
'New + alloc'->'519,000 per second. 1.93 microseconds per run.'
}."

=============== Diff against Network-ul.164 ===============

Item was changed:
  ----- Method: String>>asAlphaNumeric:extraChars:mergeUID: (in category '*network-uuid') -----
  asAlphaNumeric: totalSize extraChars: additionallyAllowed mergeUID: minimalSizeOfRandomPart
  "Generates a String with unique identifier ( UID ) qualities, the difference to a
  UUID is that its beginning is derived from the receiver, so that it has a meaning
  for a human reader.
 
  Answers a String of totalSize, which consists of 3 parts
  1.part: the beginning of the receiver only consisting of
  a-z, A-Z, 0-9 and extraChars in Collection additionallyAllowed ( which can be nil )
  2.part: a single _
  3.part: a ( random ) UID of size >= minimalSizeOfRandomPart consisting of
  a-z, A-Z, 0-9
 
  Starting letters are capitalized.
  TotalSize must be at least 1.
  Exactly 1 occurrence of $_ is guaranteed ( unless additionallyAllowed includes $_ ).
  The random part has even for small sizes good UID qualitites for many practical purposes.
  If only lower- or uppercase letters are demanded, simply convert the answer with
  say #asLowercase. The probability of a duplicate will rise only moderately ( see below ).
 
  Example:
  size of random part = 10
  in n generated UIDs the chance p of having non-unique UIDs is
  n = 10000 ->  p < 1e-10 if answer is reduced to lowerCase: p < 1.4 e-8
  n = 100000 -> p < 1e-8
  at the bottom is a snippet for your own calculations  
  Note: the calculated propabilites are theoretical,
  for the actually used random generator they may be much worse"
 
  | stream out sizeOfFirstPart index ascii ch skip array random |
  totalSize > minimalSizeOfRandomPart
  ifFalse: [ self errorOutOfBounds ].
  stream := ReadStream on: self.
  out := WriteStream on: ( String new: totalSize ).
  index := 0.
  skip := true.
  sizeOfFirstPart := totalSize - minimalSizeOfRandomPart - 1.
  [ stream atEnd or: [ index >= sizeOfFirstPart ]]
  whileFalse: [
  ((( ascii := ( ch := stream next ) asciiValue ) >= 65 and: [ ascii <= 90 ]) or: [
  ( ascii >= 97 and: [ ascii <= 122 ]) or: [
  ch isDigit or: [
  additionallyAllowed notNil and: [ additionallyAllowed includes: ch ]]]])
  ifTrue: [
  skip
  ifTrue: [ out nextPut: ch asUppercase ]
  ifFalse: [ out nextPut: ch ].
  index := index + 1.
  skip := false ]
  ifFalse: [ skip := true ]].
  out nextPut: $_.
  array := Array new: 62.
  1 to: 26 do: [ :i |
  array at: i put: ( i + 64 ) asCharacter.
  array at: i + 26 put: ( i + 96 ) asCharacter ].
  53 to: 62 do: [ :i |
  array at: i put: ( i - 5 ) asCharacter ].
+ random := ThreadSafeRandom value.
- random := UUIDGenerator default randomGenerator.
  totalSize - index - 1 timesRepeat: [
  out nextPut: ( array atRandom: random )].
  ^out contents
 
  " calculation of probability p for failure of uniqueness in n UIDs
  Note: if answer will be converted to upper or lower case replace 62 with 36
  | n i p all |
  all := 62 raisedTo: sizeOfRandomPart.
  i := 1.
  p := 0.0 .
  n := 10000.
  [ i <= n ]
  whileTrue: [
  p := p + (( i - 1 ) / all ).
  i := i + 1 ].
  p  
 
  approximation formula: n squared / ( 62.0 raisedTo: sizeOfRandomPart ) / 2
  "
 
  "'Crop SketchMorphs and Grab Screen Rect to JPG'
  asAlphaNumeric: 31 extraChars: nil mergeUID: 10  
  'CropSketchMorphsAndG_iOw94jquN6'
  'Monticello'
  asAlphaNumeric: 31 extraChars: nil mergeUID: 10    
  'Monticello_kp6aV2l0IZK9uBULGOeG'
  'version-', ( '1.1.2' replaceAll: $. with: $- )
  asAlphaNumeric: 31 extraChars: #( $- ) mergeUID: 10    
  'Version-1-1-2_kuz2tMg2xX9iRLDVR'"
  !

Item was changed:
  ----- Method: UUID>>initialize (in category 'initalize-release') -----
  initialize
+ self makeUUID.!
- self primMakeUUID.!

Item was added:
+ ----- Method: UUID>>makeUUID (in category 'as yet unclassified') -----
+ makeUUID
+ UUIDGenerator default generateBytes: self forVersion: 4.!

Item was changed:
  ----- Method: UUID>>primMakeUUID (in category 'system primitives') -----
  primMakeUUID
  <primitive: 'primitiveMakeUUID' module: 'UUIDPlugin'>
+ self makeUUID!
- UUIDGenerator default generateBytes: self forVersion: 4.!

Item was changed:
  Object subclass: #UUIDGenerator
+ instanceVariableNames: 'bits'
+ classVariableNames: 'Default TheRandom TheSemaphore'
- instanceVariableNames: 'timeLow timeMid timeHiAndVersion clockSeqHiAndReserved clockSeqLow node randomCounter randomGenerator semaphoreForGenerator'
- classVariableNames: 'Default'
  poolDictionaries: ''
  category: 'Network-UUID'!
 
+ !UUIDGenerator commentStamp: 'topa 10/19/2015 23:23:19' prior: 0!
+ I generate a pseudo-random UUID by asking Random for a 128 bit value.
- !UUIDGenerator commentStamp: '<historical>' prior: 0!
- This class generates a pseudo-random UUID
- by John M McIntosh [hidden email]
 
+ See https://tools.ietf.org/html/rfc4122.html#section-4.4 for reference.!
- See http://www.webdav.org/specs/draft-leach-uuids-guids-01.txt!

Item was changed:
  ----- Method: UUIDGenerator class>>initialize (in category 'class initialization') -----
  initialize
+ TheRandom := Random new.
+ TheSemaphore := Semaphore forMutualExclusion.
  Smalltalk addToStartUpList: self after: nil.!

Item was changed:
  ----- Method: UUIDGenerator>>generateFieldsVersion4 (in category 'instance creation') -----
  generateFieldsVersion4
+  
+ TheSemaphore critical: [
+ bits := 16rffffffffffffffffffffffffffffffff atRandom: TheRandom. "128 bit"].!
-
- timeLow := self generateRandomBitsOfLength: 32.
- timeMid := self generateRandomBitsOfLength: 16.
- timeHiAndVersion := 16r4000 bitOr: (self generateRandomBitsOfLength: 12).
- clockSeqHiAndReserved := 16r80 bitOr: (self generateRandomBitsOfLength: 6).
- clockSeqLow := self generateRandomBitsOfLength: 8.
- node := self generateRandomBitsOfLength: 48.
- !

Item was removed:
- ----- Method: UUIDGenerator>>generateOneOrZero (in category 'generator') -----
- generateOneOrZero
- ^self semaphoreForGenerator
- critical: [| value |
- value := self randomGenerator next.
- self randomCounter: self randomCounter + 1.
- self randomCounter > 100000
- ifTrue: [self setupRandom].
- value < 0.5
- ifTrue: [0]
- ifFalse: [1]].!

Item was removed:
- ----- Method: UUIDGenerator>>generateRandomBitsOfLength: (in category 'generator') -----
- generateRandomBitsOfLength: aNumberOfBits
- | target |
- target := 0.
- aNumberOfBits isZero ifTrue: [^target].
- target := self generateOneOrZero.
- (aNumberOfBits - 1)  timesRepeat:
- [target := (target bitShift: 1)  bitOr: self generateOneOrZero].
- ^target!

Item was removed:
- ----- Method: UUIDGenerator>>initialize (in category 'instance creation') -----
- initialize
- self setupRandom.
- semaphoreForGenerator := Semaphore forMutualExclusion.
- !

Item was removed:
- ----- Method: UUIDGenerator>>makeSeed (in category 'random seed') -----
- makeSeed
- "Try various methods of getting good seeds"
- | seed |
- seed := self makeUnixSeed.
- seed ifNotNil: [^seed].
-
- "not sure if this is reliably random... commented out for now. -dew"
- "seed := self makeSeedFromSound.
- seed ifNotNil: [^seed]."
-
- "default"
- [seed := (Time millisecondClockValue bitAnd: 16r3FFFFFFF) bitXor: self hash.
- seed := seed bitXor: (Time totalSeconds bitAnd: 16r3FFFFFFF).
- seed = 0] whileTrue: ["Try again if ever get a seed = 0"].
-
- ^seed
- !

Item was removed:
- ----- Method: UUIDGenerator>>makeSeedFromSound (in category 'random seed') -----
- makeSeedFromSound
- ^[SoundService default randomBitsFromSoundInput: 32]
- ifError: [nil].!

Item was removed:
- ----- Method: UUIDGenerator>>makeUnixSeed (in category 'random seed') -----
- makeUnixSeed
-
- ^[
- StandardFileStream readOnlyFileNamed: '/dev/urandom' do: [ :stream |
- stream binary.
- (Integer
- byte1: stream next
- byte2: stream next
- byte3: stream next
- byte4: stream next) ] ]
- on: Error
- do: [ nil ]!

Item was changed:
  ----- Method: UUIDGenerator>>placeFields: (in category 'instance creation') -----
  placeFields: aByteArray
 
+ | version fixed |
+ bits isLarge
+ ifTrue: [ aByteArray replaceFrom: 1 to: bits size with: bits]
+ ifFalse: [aByteArray unsignedLongAt: 1 put: bits bigEndian: false].
+
+ version := ((aByteArray at: 7) bitAnd: 16r0F) bitOr: 16r40. "Version 4"
+ fixed := ((aByteArray at: 9) bitAnd: 16r3F) bitOr: 16r80. "Fixed 8..b value"
+ aByteArray
+ at: 7 put: version;
+ at: 9 put: fixed.!
- aByteArray at: 1 put: ((timeLow bitShift: -24) bitAnd: 16rFF).
- aByteArray at: 2 put: ((timeLow bitShift: -16) bitAnd: 16rFF).
- aByteArray at: 3 put: ((timeLow bitShift: -8) bitAnd: 16rFF).
- aByteArray at: 4 put: (timeLow bitAnd: 16rFF).
- aByteArray at: 5 put: ((timeMid bitShift: -8) bitAnd: 16rFF).
- aByteArray at: 6 put: (timeMid bitAnd: 16rFF).
- aByteArray at: 7 put: ((timeHiAndVersion bitShift: -8) bitAnd: 16rFF).
- aByteArray at: 8 put: (timeHiAndVersion bitAnd: 16rFF).
- aByteArray at: 9 put: clockSeqHiAndReserved.
- aByteArray at: 10 put: clockSeqLow.
- 0 to: 5 do: [:i |
- aByteArray at: 11 + i put: ((node bitShift: (-8*i)) bitAnd: 16rFF)]
- !

Item was removed:
- ----- Method: UUIDGenerator>>randomCounter (in category 'accessors and mutators') -----
- randomCounter
- ^randomCounter!

Item was removed:
- ----- Method: UUIDGenerator>>randomCounter: (in category 'accessors and mutators') -----
- randomCounter: aNumber
- randomCounter := aNumber
- !

Item was removed:
- ----- Method: UUIDGenerator>>randomGenerator (in category 'accessors and mutators') -----
- randomGenerator
- ^randomGenerator
- !

Item was removed:
- ----- Method: UUIDGenerator>>randomGenerator: (in category 'accessors and mutators') -----
- randomGenerator: aGenerator
- randomGenerator := aGenerator
- !

Item was removed:
- ----- Method: UUIDGenerator>>semaphoreForGenerator (in category 'accessors and mutators') -----
- semaphoreForGenerator
- ^semaphoreForGenerator!

Item was removed:
- ----- Method: UUIDGenerator>>semaphoreForGenerator: (in category 'accessors and mutators') -----
- semaphoreForGenerator: aSema
- semaphoreForGenerator := aSema
- !

Item was removed:
- ----- Method: UUIDGenerator>>setupRandom (in category 'instance creation') -----
- setupRandom
- randomCounter := 0.
- randomGenerator := Random seed: self makeSeed.!