The result is CryptoRndIV.
CryptoRndII gives us a choice between using Microsoft's BCryptGenRandom or Intel's RdRand and Microsoft thread pooling. Intel introduced RdRand in 2012 so some of you may not have that on board. RdSeed was introduced in 2014, and I don't have that. CryptoRndIV only uses RdRand and no check is made to test whether you have it or not. If you are not sure, I have some code which will query your PC; just ask. Microsoft's thread pooling has been replaced by fxm's thread pooling (ThreadInitThenMultiStart).
Intel does not guarantee that a RdRand will be returned, but the likelihood of a failure is minimal. We can try again. I allow ten attempts before giving up, and have never seen that. However, it is not impossible, so we must cater for it. CryptoRndII recovers by using RtlGenRandom which is a Microsoft CPRNG function. CryptoRndIV recovers by using FreeBASIC's random number generator #5 available on Win32 and Linux.
So CryptoRndIV is a Microsoft free zone which should work on Linux. It should not be used for cryptographic work.
It is not as fast as PCG32II and MsWs, but is far from being a slouch.
These are the throughputs, in 32-bit mode, that I am getting.
Code: Select all
MHz
DW (Ulong) 533
S [0,1) 550
SX [-1, 1] 550
D 497
DX [-1,1] 467
R (Integral) 528
R (Floating point) 549
Gauss (Single) 39
D and DX have a 53-bit granularity
R a range overloaded as integer or floating point
Gauss is the normal distribution
In 64-bit mode, we use the 64-bit RdRand.
The timings were done using a large buffer greater than the number of random numbers requested to avoid a buffer switch. The CryptoRnd family uses two buffers. When one is purged, we switch buffers and then fill up the purged buffer with fresh data. Two secondary threads of execution are used to fill two half buffers. The switch is too fast for us to perceive it; just over 7 milliseconds on my machine. The buffers default sizes are 5MiB. For numbers requiring 8 bytes, that gives 655,360 random numbers before a buffer switch is executed. Recommendation is to use buffers of at least 1Mib. A 5MiB buffer is filled, in 32-bit mode, in 27 milliseconds, so in practice the unused buffer will be ready for us when the other is purged.
I normally expect one or two insignificant anomalies with PractRand, but I didn't get any up to 1TB. I left it at that – I would rather not insult a class act in RdRand. I have mentioned this before, but when you get to my age you don't push PractRand to 16TiB. Headstone: “He passed away at 8TiB with PractRand.”
Unlike other PRNG implementations, we don't have the facility to get snapshots and so on – we are using a CPRNG remember with no state vector. However, we can go back to the beginning of the first buffer by using ResetBufferPointer provided we have not switched buffers. Once we start to refresh the first buffer, we are stuffed.
So, except for D and DX we have a top class half GHz CPRNG; on my beast anyway.
Now I don't have Linux. Would someone be kind enough to test CryptRndIV on Linux for me?
CryptoRndIV.bas
Code: Select all
/'
This is the same as CryptoRndII except we use fxm's FreeBASIC method
as opposed to Microsoft's thread pooling and it only uses Intel RdRand
'/
' ****************************** fxm's code
Type ThreadInitThenMultiStart
Public:
Declare Constructor()
Declare Sub ThreadInit(Byval pThread As Sub(Byval As Any Ptr), Byval p As Any Ptr = 0)
Declare Sub ThreadStart()
Declare Sub ThreadStart(Byval p As Any Ptr)
Declare Sub ThreadWait()
Declare Destructor()
Private:
Dim As Sub(Byval p As Any Ptr) _pThread
Dim As Any Ptr _p
Dim As Any Ptr _mutex1, _mutex2, _mutex3
Dim As Any Ptr _pt
Dim As Byte _end
Declare Static Sub _Thread(Byval p As Any Ptr)
End Type
Constructor ThreadInitThenMultiStart()
This._mutex1 = Mutexcreate()
Mutexlock(This._mutex1)
This._mutex2 = Mutexcreate()
Mutexlock(This._mutex2)
This._mutex3 = Mutexcreate()
Mutexlock(This._mutex3)
End Constructor
Sub ThreadInitThenMultiStart.ThreadInit(Byval pThread As Sub(Byval As Any Ptr), Byval p As Any Ptr = 0)
This._pThread = pThread
This._p = p
If This._pt = 0 Then
This._pt = Threadcreate(@ThreadInitThenMultiStart._Thread, @This)
Mutexunlock(This._mutex3)
End If
End Sub
Sub ThreadInitThenMultiStart.ThreadStart()
Mutexlock(This._mutex3)
Mutexunlock(This._mutex1)
End Sub
Sub ThreadInitThenMultiStart.ThreadStart(Byval p As Any Ptr)
Mutexlock(This._mutex3)
This._p = p
Mutexunlock(This._mutex1)
End Sub
Sub ThreadInitThenMultiStart.ThreadWait()
Mutexlock(This._mutex2)
Mutexunlock(This._mutex3)
End Sub
Sub ThreadInitThenMultiStart._Thread(Byval p As Any Ptr)
Dim As ThreadInitThenMultiStart Ptr pThis = p
Do
Mutexlock(pThis->_mutex1)
If pThis->_end = 1 Then Exit Sub
pThis->_pThread(pThis->_p)
Mutexunlock(pThis->_mutex2)
Loop
End Sub
Destructor ThreadInitThenMultiStart()
If This._pt > 0 Then
This._end = 1
Mutexunlock(This._mutex1)
.ThreadWait(This._pt)
End If
Mutexdestroy(This._mutex1)
Mutexdestroy(This._mutex2)
Mutexdestroy(This._mutex3)
End Destructor
' ****************************** End of fxm's code
Dim Shared As UByte Buffer0(), Buffer1()
Dim Shared As Integer BufferSize
Dim Shared As Any Ptr ptrBuffer, ptrBaseBuffer0, ptrBaseBuffer1
Dim Shared As Any Ptr ptrBaseBuffer0plus, ptrBaseBuffer1plus
Dim Shared As Integer SwitchBufferCriteria
Dim Shared As ThreadInitThenMultiStart t0, t0plus, t1, t1plus
Declare Sub SwitchBuffer
Declare Sub FillBuffer( ByVal As Any Ptr )
Declare Sub ResetBufferPointer
Declare Sub InitializeCryptoBuffers( As Long )
BufferSize = 5*1024*1024
InitializeCryptoBuffers( BufferSize )
Private Function CryptoDW As Ulong
If ptrBuffer >= SwitchBufferCriteria Then
SwitchBuffer
End If
Asm
mov eax, dword Ptr [ptrBuffer]
mov eax, [eax]
mov [Function], eax
End Asm
ptrBuffer += 4
End Function
Private Function CryptoS As Double ' [0,1)
Dim As Ulong TempVar
If ptrBuffer >= SwitchBufferCriteria Then
SwitchBuffer
End If
Asm
mov eax, dword Ptr [ptrBuffer]
mov eax, [eax]
mov dword Ptr [TempVar], eax
End Asm
ptrBuffer += 4
Return TempVar/4294967296.0
End Function
Private Function CryptoSX As Double ' [-1,1]
Dim As Ulong TempVar
If ptrBuffer >= SwitchBufferCriteria Then
SwitchBuffer
End If
Asm
mov eax, dword Ptr [ptrBuffer]
mov eax, [eax]
mov dword Ptr [TempVar], eax
End Asm
ptrBuffer += 4
Return TempVar/2147483648.0 - 1
End Function
Private Function CryptoD As Double ' [0,1)
If ptrBuffer >= SwitchBufferCriteria Then
SwitchBuffer
End If
' ASM by Wilbert at PureBasic forums
Asm
mov eax, dword Ptr [ptrBuffer]
movd xmm0, [eax]
movd xmm1, [eax + 4]
punpckldq xmm0, xmm1
psrlq xmm0, 12
mov eax, 1
cvtsi2sd xmm1, eax
por xmm0, xmm1
subsd xmm0, xmm1
movq [Function], xmm0
End Asm
ptrBuffer += 8
End Function
Private Function CryptoDX As Double ' [-1,1]
If ptrBuffer >= SwitchBufferCriteria Then
SwitchBuffer
End If
' ASM adapted from CryptoD by author
Asm
mov eax, dword Ptr [ptrBuffer]
movd xmm0, [eax]
movd xmm1, [eax + 4]
punpckldq xmm0, xmm1
psrlq xmm0, 12
mov eax, 2
cvtsi2sd xmm1, eax
por xmm0, xmm1
subsd xmm0, xmm1
mov eax, 1
cvtsi2sd xmm1, eax
subsd xmm0, xmm1
movq [Function], xmm0
End Asm
ptrBuffer += 8
End Function
Private Function CryptoR Overload( Byval One As Long, Byval Two As Long ) As Long
Dim As Ulong TempVar
If ptrBuffer >= SwitchBufferCriteria Then
SwitchBuffer
End If
Asm
mov eax, dword Ptr [ptrBuffer]
mov eax, [eax]
mov dword Ptr [TempVar], eax
End Asm
ptrBuffer += 4
return clng(TempVar Mod (Two-One+1)) + One ' By dodicat
End Function
Private Function CryptoR Overload( Byval One As Double, Byval Two As Double ) As Double
Dim As Ulong TempVar
If ptrBuffer >= SwitchBufferCriteria Then
SwitchBuffer
End If
Asm
mov eax, dword Ptr [ptrBuffer]
mov eax, [eax]
mov dword Ptr [TempVar], eax
End Asm
ptrBuffer += 4
Return TempVar/2^32*( Two - One ) + One
End Function
Private Function Gauss As Single
Static As Long u2_cached
Static As Single u1, u2, x1, x2, w
If u2_cached = -1 Then
u2_cached = 0
Function = u2
Else
Do
x1 = CryptoS
x2 = CryptoS
w = x1 * x1 + x2 * x2
Loop While w >= 1
w = Sqr( -2 * Log(w)/w )
u1 = x1 * w
u2 = x2 * w
u2_cached = -1
Function = u1
End If
End Function
Private Sub InitializeCryptoBuffers( Byval Buffer As Long )
If Buffer < 1024 Then
BufferSize = 1024
Else
BufferSize = Buffer - Buffer Mod 8
End If
Redim Buffer0( 1 To BufferSize) As UByte
ptrBaseBuffer0 = Varptr( Buffer0(1) )
ptrBuffer = ptrBaseBuffer0
SwitchBufferCriteria = Cast( Integer, ptrBuffer ) + BufferSize
t0.ThreadInit( @FillBuffer )
ptrBaseBuffer0plus = ptrBaseBuffer0 + BufferSize\2
t0plus.ThreadInit( @FillBuffer )
t0.ThreadStart( ptrBaseBuffer0 )
t0plus.ThreadStart( ptrBaseBuffer0plus )
Redim Buffer1( 1 To BufferSize) As UByte
ptrBaseBuffer1 = Varptr( Buffer1(1) )
t1.ThreadInit( @FillBuffer )
ptrBaseBuffer1plus = ptrBaseBuffer1 + BufferSize\2
t1plus.ThreadInit( @FillBuffer )
t1.ThreadStart( ptrBaseBuffer1 )
t1plus.ThreadStart( ptrBaseBuffer1plus )
t0.ThreadWait()
t0plus.ThreadWait()
End Sub
Private Sub FillBuffer( ByVal BaseBuffer As Any Ptr )
Dim As ULong HalfBuffer
Dim As Ulongint RecoverBuffer
Dim As Ulong Ptr ptrRecoverBuffer
Dim AS Ulong Ptr Dummy = BaseBuffer
ptrRecoverBuffer = cast( Ulong Ptr, @RecoverBuffer)
HalfBuffer = BufferSize\2
Asm
mov edi, dword Ptr [HalfBuffer]
mov esi, 0
mov ebx, dword Ptr [Dummy]
rptRdRand:
mov ecx, 10 ' Max number Of tries before going into a recovery
queryAgain:
#ifdef __FB_64BIT__
RdRand rax
#Else
RdRand eax
#endif
jc OK ' A Random value was available
dec ecx
jnz queryAgain
Call Recover ' Use RtlGenRandom For This ULong
OK:
#ifdef __FB_64BIT__
mov qword Ptr [ebx + esi], rax ' Store RdRand
Add esi, 8
#Else
mov dword Ptr [ebx + esi], eax ' Store RdRand
Add esi, 4
#endif
cmp edi, esi
jne rptRdRand
jmp Done
Recover:
#ifndef __FB_64BIT__
pushad ' I am playing it safe here
#endif
End Asm
Randomize , 5
#ifdef __FB_64BIT__
*ptrRecoverBuffer = Int(Rnd*2^32)
*(ptrRecoverBuffer + 1) = Int(Rnd*2^32)
#Else
*ptrRecoverBuffer = Int(Rnd*2^32)
#endif
Asm
#ifndef __FB_64BIT__
popad
#endif
#ifdef __FB_64BIT__
mov rax, qword Ptr [ptrRecoverBuffer]
#Else
mov eax, dword Ptr [ptrRecoverBuffer]
#endif
ret
Done:
End Asm
End Sub
Private Sub SwitchBuffer
t1.ThreadWait()
t1plus.ThreadWait()
Swap ptrBaseBuffer0, ptrBaseBuffer1
Swap ptrBaseBuffer0plus, ptrBaseBuffer1plus
ptrBuffer = ptrBaseBuffer0
SwitchBufferCriteria = Cast( Integer, ptrBuffer ) + BufferSize
t1.ThreadStart( ptrBaseBuffer1 )
t1plus.ThreadStart( ptrBaseBuffer1plus )
End Sub
Private Sub ResetBufferPointer
ptrBuffer = ptrBaseBuffer0
End Sub
Code: Select all
#Include Once "CryptoRndIV.bas"
Print CryptoDW
Print CryptoS
Print CryptoSX
Print CryptoD
Print CryptoDX
Print CryptoR(10, 20)
Print CryptoR(10.,20.)