New subject: The Trunk: Network-topa.165.mcz

2 Nov 2015

      Bravo!
_,,,^..^,,,_ (phone)
...
On Oct 24, 2015, at 7:29 AM, commits@source.squeak.org wrote:
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 martin.mcclure@gemtalksystems.com)
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 johnmci@smalltalkconsulting.com

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.!

Re: [squeak-dev] The Trunk: Network-topa.165.mcz