A fast CPRNG

Windows specific questions.
Josep Roca
Posts: 564
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: A fast CPRNG

Post by Josep Roca »

Especially for Windows libraries I would suggest to use the ones provided by Microsoft (in the Windows SDK) instead of trying to create them oneself.
How? I only find propsys.lib, whereas FB wants libpropsys.dll.a.
Josep Roca
Posts: 564
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: A fast CPRNG

Post by Josep Roca »

With languages that don't use import libraries, such PowerBasic, you declare a function to import as

DECLARE FUNCTION Foo LIB [or IMPORT] "dll name" ALIAS "Foo" (parameters) AS LONG [or wathever]

The compiler loads the needed dlls at startup and retrieves the addresses of the functions being called. If an address is not found, the application fails with a message indicating that the function "x" can't be found.

For delay loading, a syntax like

DECLARE FUNCTION Foo DELAYLOAD [or wathever] "dll name" ALIAS "Foo" (parameters) AS LONG [or wathever]

could be used. The application won't load the dll at startup, but only when you call a function that you have told in the declare that is inside the specified dll.

The first syntax is suitable for functions that exist in all Windows versions and, therefore, won't fail. The second syntax is suitable for functions that only exist in some (or one) versions of Windows.

Another advantage of not using import libraries is that for new versions of the dll you only need to update the header adding the new declares or even adding the declares in your application.
St_W
Posts: 1619
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: A fast CPRNG

Post by St_W »

Josep Roca wrote:How? I only find propsys.lib, whereas FB wants libpropsys.dll.a.
You should be able to use propsys.lib directly. (Otherwise you can also try to just rename it.) The linker searches for multiple variants of the library name.

And of course make sure that you use the 64-bit version for 64-bit FB and the 32-bit import library for 32-bit FB. Otherwise you'll get an error like this:
ld.exe: skipping incompatible ./libname.lib when searching for -llibname

//edit: thank you for explaining how library usage is implemented in PowerBasic. Of course it can't be mapped 1:1 to FreeBasic (due to the existing library handling implementation, if one wants to keep backward-compatibility), but it definitely gives a good idea how it could work.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: A fast CPRNG

Post by deltarho[1859] »

Replace

Code: Select all

#If (ALGO = 1)
  Private Sub CleanUpCryptoRndIIBuffer
    BCryptCloseALGOrithmProvider( hRand, 0  )
    CloseThreadpoolWork(Work1)
    CloseThreadpoolWork(Work1plus)
    CloseThreadpool(Pool)
  End Sub
#Endif
with

Code: Select all

#If (ALGO = 1)
  Sub on_exit( ) Destructor
    BCryptCloseALGOrithmProvider( hRand, 0  )
    CloseThreadpoolWork(Work1)
    CloseThreadpoolWork(Work1plus)
    CloseThreadpool(Pool)
  End Sub
#Else
  Sub on_exit( ) Destructor
    CloseThreadpoolWork(Work1)
    CloseThreadpoolWork(Work1plus)
    CloseThreadpool(Pool)
  End Sub
#Endif
We don't have to remember to call CleanUpCryptoRndIIBuffer now.
Last edited by deltarho[1859] on Dec 12, 2017 13:08, edited 1 time in total.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: A fast CPRNG

Post by deltarho[1859] »

Just had a crash on termination. Not the Destructor.

There are two ReDims, they should be 'As UByte' and not 'As Byte'. That has not been an issue until now - don't know why.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: A fast CPRNG

Post by deltarho[1859] »

The clean up dates back to CryptoRnd which used threads and the only clean up was BCryptCloseALGOrithmProvider used with 'ALGO = 1'. With CryptoRndII the thread pool objects got deleted as well. However, 'ALGO = 2' also uses thread pools so we need to clean up there as well.

The last but one post now has the correct clean up to use.

Without the correction we would get a memory leak when using 'ALGO = 2'. The leak would only occur per instance of CryptoRndII, it would not accumulate during a CryptoRndII session.

I should add that if I need cryptographic random numbers and speed is not an issue (62.8MHz for 32 bit 120.2MHz for 64 bit) then I will use 'ALGO = 2'. If I want the very best quality random numbers, with speed not an issue and I do not need to repeat sequences then I will use 'ALGO = 2' here as well. Of course, if your PC does not support Intel's RdRand then CryptoRndII will not compile with 'ALGO = 2', I reckon.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: A fast CPRNG

Post by deltarho[1859] »

I am currently reading 'Serious Cryptography: A Practical Introduction to Modern Encryption' by Jean-Philippe Aumasson, which was very recently published. From a quality perspective CryptoRndII is top drawer and it is very fast. However, even though it is a CPRNG, as opposed to a PRNG, it seems that my implementation has compromised the security aspect and should not be used in cryptographic work. The implementation is about speed and I treated the cryptographic aspect as a bonus. It was not a bonus - the cryptographic aspect went 'out of the window'.

If you are into crypto' this book is a good read, so far - only five reviews at Amazon but all five stars and it is receiving a good press.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: A fast CPRNG

Post by deltarho[1859] »

Just for the record here is the latest version of CryptoRNDII.bas

Usage:

Code: Select all

Const _WIN32_WINNT = &h0602
'#define algo 2 ' For Intel RdRand
#Include "CryptoRndII.bas"
Functions:
CryptoDW As Ulong
CryptoS As Double [0,1) ' 32-bit granularity
CryptoSX As Double ' [-1,1)
CryptoD As Double ' [0,1) ' 53-bit granularity
CryptoDX As Double ' [-1,1)
CryptoR( Byval One As Long, Byval Two As Long ) As Long
Gauss As Single

CryptoRNDII.bas

Code: Select all

#include once "windows.bi"
#include once "win/bcrypt.bi"
#inclib "bcrypt"

#ifndef ALGO
  #define ALGO 1
#endif
 
#if (ALGO = 2)
  Declare Function RtlGenRandom Lib "Advapi32.dll" Alias "SystemFunction036" _
  ( RandomBuffer As Any Ptr, RandomBufferLength As Ulong ) As Byte
#endif

Dim Shared As UByte Buffer0(), Buffer1()
Dim Shared As Long BufferSize
Dim Shared As Any Ptr ptrBuffer, ptrBaseBuffer0, ptrBaseBuffer1
Dim Shared As Any Ptr ptrBaseBuffer0plus, ptrBaseBuffer1plus
Dim Shared As Long SwitchBufferCriteria
Dim Shared Pool As PTP_POOL
Dim Shared As PTP_WORK Work0, Work0plus, Work1, Work1plus
Dim Shared hRand As BCRYPT_ALG_HANDLE

Declare Sub SwitchBuffer
Declare Sub FillBuffer( As PTP_CALLBACK_INSTANCE, As PVOID Ptr, As PTP_WORK )
Declare Sub ResetBufferPointer
Declare Sub InitializeCryptoBuffers( As Long )

#If (ALGO = 1)
  BufferSize = 128*1024
#Else
  BufferSize = 32*1024
#Endif
 
Pool = CreateThreadpool(Null)

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( Byval One As Long, Byval Two As Long ) As Long
Dim As Ulong TempVar
 
  If ptrBuffer >= SwitchBufferCriteria Then
    SwitchBuffer
  End If
 
' ASM by John Gleason @ PowerBASIC forums
   Asm
  mov edx, dword Ptr [ptrBuffer]
  mov edx, [edx]
  mov ecx, [One]
  mov eax, [Two]
  cmp ecx, eax
  jl 0f
  xchg eax, ecx
0:
  Sub eax, ecx
  inc eax
  jz 1f
  mul edx
  Add edx, ecx
1:
  mov [Function], edx
   End Asm
   
  ptrBuffer += 4
 
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 (ALGO = 1)
    BCryptOpenALGOrithmProvider Varptr(hRand), BCRYPT_RNG_ALGORITHM, 0, 0
  #endif
  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
  #ifdef __FB_64BIT__
    SwitchBufferCriteria = Cast(Longint, ptrBuffer) + BufferSize
  #Else
    SwitchBufferCriteria = Cast(Long, ptrBuffer) + BufferSize
  #endif
  Work0 = CreateThreadpoolWork(Cast(PTP_WORK_CALLBACK, @FillBuffer), @ptrBaseBuffer0, Null)
  ptrBaseBuffer0plus = ptrBaseBuffer0 + BufferSize\2
  Work0plus = CreateThreadpoolWork(Cast(PTP_WORK_CALLBACK,@FillBuffer), @ptrBaseBuffer0plus, Null)
  SubmitThreadpoolWork(Work0)
  SubmitThreadpoolWork(Work0plus)
  Redim Buffer1( 1 To BufferSize) As UByte
  ptrBaseBuffer1 = Varptr( Buffer1(1) )
  Work1 = CreateThreadpoolWork(Cast(PTP_WORK_CALLBACK,@FillBuffer), @ptrBaseBuffer1, Null)
  ptrBaseBuffer1plus = ptrBaseBuffer1 + BufferSize\2
  Work1plus = CreateThreadpoolWork(Cast(PTP_WORK_CALLBACK,@FillBuffer), @ptrBaseBuffer1plus, Null)
  SubmitThreadpoolWork(Work1)
  SubmitThreadpoolWork(Work1plus)
  WaitForThreadpoolWorkCallbacks(Work0,FALSE)
  WaitForThreadpoolWorkCallbacks(Work0plus,FALSE)
  ' We don't need Work0 related objects again.
  CloseThreadpoolWork(Work0)
  CloseThreadpoolWork(Work0plus)
End Sub
 
#If (ALGO = 1)
  Sub on_exit( ) Destructor
    BCryptCloseALGOrithmProvider( hRand, 0  )
    CloseThreadpoolWork(Work1)
    CloseThreadpoolWork(Work1plus)
    CloseThreadpool(Pool)
  End Sub
#Else
  Sub on_exit( ) Destructor
    CloseThreadpoolWork(Work1)
    CloseThreadpoolWork(Work1plus)
    CloseThreadpool(Pool)
  End Sub
#Endif
 
#If (ALGO = 1)
Private Sub FillBuffer( Instance As PTP_CALLBACK_INSTANCE, Context As PVOID Ptr, Work As PTP_WORK)
Dim BaseBuffer As Any Ptr

  BaseBuffer = *Context
  BCryptGenRandom( hRand, BaseBuffer, BufferSize\2, 0)
End Sub
#Else
Private Sub FillBuffer(Byval Instance As PTP_CALLBACK_INSTANCE, Byval Context As PVOID Ptr, Byval Work As PTP_WORK)
Dim BaseBuffer As Any Ptr
Dim As Long HalfBuffer
Dim As Ulong RecoverBuffer
Dim As Any Ptr ptrRecoverBuffer
 
  BaseBuffer = *Context
  ptrRecoverBuffer = Varptr(RecoverBuffer)
 
  HalfBuffer = BufferSize\2
  Asm
    mov edi, dword Ptr [HalfBuffer]
    mov esi, 0
    mov ebx, dword Ptr [BaseBuffer]
  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
  #ifdef __FB_64BIT__
    RtlGenRandom(ptrRecoverBuffer, 8)  ' Populate buffer
  #Else
    RtlGenRandom(ptrRecoverBuffer, 4)
  #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
#Endif
 
Private Sub SwitchBuffer
  WaitForThreadpoolWorkCallbacks(Work1,FALSE)
  WaitForThreadpoolWorkCallbacks(Work1plus,FALSE)
  Swap ptrBaseBuffer0, ptrBaseBuffer1
  Swap ptrBaseBuffer0plus, ptrBaseBuffer1plus
  ptrBuffer = ptrBaseBuffer0
  #ifdef __FB_64BIT__
    SwitchBufferCriteria = Cast(Longint, ptrBuffer) + BufferSize
  #Else
    SwitchBufferCriteria = Cast(Long, ptrBuffer) + BufferSize
  #endif
  SubmitThreadpoolWork(Work1)
  SubmitThreadpoolWork(Work1plus)
End Sub
 
Private Sub ResetBufferPointer
  ptrBuffer = ptrBaseBuffer0
End Sub
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: A fast CPRNG

Post by srvaldez »

deltarho[1859] wrote:It passed a PractRand one terabyte test with three small anomalies so we are back in business. Rather than update the code above which is now on a different page it is posted here.

CryptoRndII comparison with PCG32II

Code size: PCG32II is very much smaller than CryptoRndII.
Speed: Comparable in 32 bit, PCG32II is faster in 64 bit.
Thread Safety: PCG32II is thread safe, CryptoRndII is not.
PractRand: Comparable with a one terabyte test.
Seeding: CryptoRndII is a seedless generator, PCG32II may be seeded, random or fixed, and have different sequences, random or fixed.

'A fast CPRNG' has been an interesting exercise - twin buffering and the use of a threadpool - but I will now be using PCG32II as my default generator.

CryptpRndII.bas (13 Decg 2017) Some 'Sleep' statements, for test purposes, had been left in - now removed.

Code: Select all

#include once "windows.bi"
#include once "win/bcrypt.bi"
#inclib "bcrypt"

#ifndef ALGO
  #define ALGO 1
#endif
 
#if (ALGO = 2)
  Declare Function RtlGenRandom Lib "Advapi32.dll" Alias "SystemFunction036" _
  ( RandomBuffer As Any Ptr, RandomBufferLength As Ulong ) As Byte
#endif

Dim Shared As UByte Buffer0(), Buffer1()
Dim Shared As Long BufferSize
Dim Shared As Any Ptr ptrBuffer, ptrBaseBuffer0, ptrBaseBuffer1
Dim Shared As Any Ptr ptrBaseBuffer0plus, ptrBaseBuffer1plus
Dim Shared As Long SwitchBufferCriteria
Dim Shared Pool As PTP_POOL
Dim Shared As PTP_WORK Work0, Work0plus, Work1, Work1plus
Dim Shared hRand As BCRYPT_ALG_HANDLE

Declare Sub SwitchBuffer
Declare Sub FillBuffer( As PTP_CALLBACK_INSTANCE, As PVOID Ptr, As PTP_WORK )
Declare Sub ResetBufferPointer
Declare Sub InitializeCryptoBuffers( As Long )

#If (ALGO = 1)
  BufferSize = 128*1024
#Else
  BufferSize = 32*1024
#Endif
 
Pool = CreateThreadpool(Null)

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)
Dim As Ulongint uld
 
  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( Byval One As Long, Byval Two As Long ) As Long
Dim As Ulong TempVar
 
  If ptrBuffer >= SwitchBufferCriteria Then
    SwitchBuffer
  End If
 
' ASM by John Gleason @ PowerBASIC forums
	Asm
  mov edx, dword Ptr [ptrBuffer]
  mov edx, [edx]
  mov ecx, [One]
  mov eax, [Two]
  cmp ecx, eax
  jl 0f
  xchg eax, ecx
0:
  Sub eax, ecx
  inc eax
  jz 1f
  mul edx
  Add edx, ecx
1:
  mov [Function], edx
	End Asm
	
  ptrBuffer += 4
 
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 (ALGO = 1)
    BCryptOpenALGOrithmProvider Varptr(hRand), BCRYPT_RNG_ALGORITHM, 0, 0
  #endif
  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
  #ifdef __FB_64BIT__
    SwitchBufferCriteria = Cast(Longint, ptrBuffer) + BufferSize
  #Else
    SwitchBufferCriteria = Cast(Long, ptrBuffer) + BufferSize
  #endif
  Work0 = CreateThreadpoolWork(Cast(PTP_WORK_CALLBACK, @FillBuffer), @ptrBaseBuffer0, Null)
  ptrBaseBuffer0plus = ptrBaseBuffer0 + BufferSize\2
  Work0plus = CreateThreadpoolWork(Cast(PTP_WORK_CALLBACK,@FillBuffer), @ptrBaseBuffer0plus, Null)
  SubmitThreadpoolWork(Work0)
  SubmitThreadpoolWork(Work0plus)
  Redim Buffer1( 1 To BufferSize) As UByte
  ptrBaseBuffer1 = Varptr( Buffer1(1) )
  Work1 = CreateThreadpoolWork(Cast(PTP_WORK_CALLBACK,@FillBuffer), @ptrBaseBuffer1, Null)
  ptrBaseBuffer1plus = ptrBaseBuffer1 + BufferSize\2
  Work1plus = CreateThreadpoolWork(Cast(PTP_WORK_CALLBACK,@FillBuffer), @ptrBaseBuffer1plus, Null)
  SubmitThreadpoolWork(Work1)
  SubmitThreadpoolWork(Work1plus)
  WaitForThreadpoolWorkCallbacks(Work0,FALSE)
  WaitForThreadpoolWorkCallbacks(Work0plus,FALSE)
  ' We don't need Work0 related objects again.
  CloseThreadpoolWork(Work0)
  CloseThreadpoolWork(Work0plus)
End Sub
 
#if (ALGO = 1)
  Private Sub CleanUpCryptoRndIIBuffer
    BCryptCloseALGOrithmProvider( hRand, 0  )
    CloseThreadpoolWork(Work1)
    CloseThreadpoolWork(Work1plus)
    CloseThreadpool(Pool)
  End Sub
#endif
 
#If (ALGO = 1)
Private Sub FillBuffer( Instance As PTP_CALLBACK_INSTANCE, Context As PVOID Ptr, Work As PTP_WORK)
Dim BaseBuffer As Any Ptr

  BaseBuffer = *Context
  BCryptGenRandom( hRand, BaseBuffer, BufferSize\2, 0)
End Sub
#Else
Private Sub FillBuffer(Byval Instance As PTP_CALLBACK_INSTANCE, Byval Context As PVOID Ptr, Byval Work As PTP_WORK)
Dim BaseBuffer As Any Ptr
Dim As Long HalfBuffer
Dim As Ulong RecoverBuffer
Dim As Any Ptr ptrRecoverBuffer
 
  BaseBuffer = *Context
  ptrRecoverBuffer = Varptr(RecoverBuffer)
 
  HalfBuffer = BufferSize\2
  Asm
    mov edi, dword Ptr [HalfBuffer]
    mov esi, 0
    mov ebx, dword Ptr [BaseBuffer]
  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
  #ifdef __FB_64BIT__
    RtlGenRandom(ptrRecoverBuffer, 8)  ' Populate buffer
  #Else
    RtlGenRandom(ptrRecoverBuffer, 4)
  #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
#Endif
 
Private Sub SwitchBuffer
  WaitForThreadpoolWorkCallbacks(Work1,FALSE)
  WaitForThreadpoolWorkCallbacks(Work1plus,FALSE)
  Swap ptrBaseBuffer0, ptrBaseBuffer1
  Swap ptrBaseBuffer0plus, ptrBaseBuffer1plus
  ptrBuffer = ptrBaseBuffer0
  #ifdef __FB_64BIT__
    SwitchBufferCriteria = Cast(Longint, ptrBuffer) + BufferSize
  #Else
    SwitchBufferCriteria = Cast(Long, ptrBuffer) + BufferSize
  #endif
  SubmitThreadpoolWork(Work1)
  SubmitThreadpoolWork(Work1plus)
End Sub
 
Private Sub ResetBufferPointer
  ptrBuffer = ptrBaseBuffer0
End Sub
@deltarho[1859]
for the life of me I can't get this to compile, I went all the way back to FB version 1.01.0 and after adding the missing win/bcrypt.bi and win/winapifamily.bi I get unknown type errors like PTP_POOL, PTP_WORK
care to shed some light on this?
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: A fast CPRNG

Post by srvaldez »

I got it to compile by adding this at the top #define _WIN32_WINNT &h0602 compiles ok in version 1.07.1
would someone care to elaborate on _WIN32_WINNT ?
is it mentioned in the FB manual ?
why is it not defined automatically when you #include "windows.bi" ?
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: A fast CPRNG

Post by srvaldez »

wow!
this forum is deader than the Sahara desert
SARG
Posts: 1756
Joined: May 27, 2005 7:15
Location: FRANCE

Re: A fast CPRNG

Post by SARG »

Hi srvaldez,
srvaldez wrote:wow!
this forum is deader than the Sahara desert
I'm just behind your left shoulder :-)
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: A fast CPRNG

Post by srvaldez »

hi SARG :-)
I have been searching the web for a way to #define _WIN32_WINNT automatically to the version of Windows being used when compiling a program, but it seems that there's no macro facility to determining the OS version other than hard-coded #defines
it seems very unfriendly to me that there's no clue why some code won't compile due to one's ignorance about setting _WIN32_WINNT to certain a value
the error messages received due to not having _WIN32_WINNT defined don't give you any clue unless you are already knowledgeable about such issues
so why not include something like this in the bi files that depend on a certain value of _WIN32_WINNT

Code: Select all

#ifndef _WIN32_WINNT
    #error "_WIN32_WINNT needs to be defined at the top of your code, e.g. #define _WIN32_WINNT &h0602"
    ' you need to make the define in your code and not in this include
#endif
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: A fast CPRNG

Post by srvaldez »

I don't get why it won't work, I pasted the suggested snippet in winbase.bi but it won't work
if I put a #print _WIN32_WINNT in winbase.bi before any use of _WIN32_WINNT all I get is _WIN32_WINNT
so is _WIN32_WINNT defined or not?
how to test if it's defined to itself?

P.S. I will check back in a week, maybe somebody will have chimed in by then, or not.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: A fast CPRNG

Post by deltarho[1859] »

srvaldez wrote:this forum is deader than the Sahara desert
The PowerBASIC forum is in a bad place - down to 180 active members. However, the active members are very active, I could pop out for an hour or so to do some shopping and come back to a dozen or more posts.

Anyway, I will 'chime in' re WIN32_WINNT.

I think I first saw 'const _WIN32_WINNT = &h0602' in rpkelly's thread here ( May 24, 2017) where I also first saw a reference to 'Thread Pool'. CryptoRnd started to use Thread Pooling in CryptoRndII (Jun 02, 2017). 'const _WIN32_WINNT = &h0602' is used many times after that date in this thread.

It is also needed when we use the Windows TaskDialog and GeTickCount64; the latter by yourself here (Jan 21, 2019). You could have got away with &h0600, Windows Vista. José Roca uses WIN32_WINNT quite a lot in his WinFBX Framework Afx folder.

There is some info at Update WINVER and _WIN32_WINNT, &h0602 was introduced in Windows 8.
Post Reply