A fast CPRNG

[MrSwiss]

... so is _WIN32_WINNT defined or not?

It is defined only if "windows.bi" is included in the code.
The version is &h0502 which means: everyting larger than WinXP (Vista, 7, 8.0, 8.1 & 10) is okay.

Simple test code:

Code: Select all

#Include "windows.bi"	' comment to check "undefined"

#Ifdef _WIN32_WINNT
    Print "_WIN32_WINNT = "; Hex(_WIN32_WINNT And &hFFFF, 4)
#Else
    Print "_WIN32_WINNT = NOT defined!"
#EndIf

Print : Print : Print "... done ... ";

Sleep

[deltarho[1859]]

The question is how do we know whether a function requires a _WIN32_WINNT definition or not?

The CreateThreadpool function tells us in the Remarks section: "To compile an application that uses this function, define _WIN32_WINNT as 0x0600 or higher."

Logically none of the other Threadpool functions need mention _WIN32_WINNT since they all rely on the CreateThreadpool function being executed first, and we are told at that function. However, _WIN32_WINNT is mentioned in the Remarks section of the CreateThreadpoolWork function, for example; and the SubmitThreadpoolWork function as well; and the WaitForThreadpoolWorkCallbacks function. I did not check any other Thread Pool functions.

I should imagine then that we cannot plead ignorance and the lowest value for Thread Pools is &h0600 and not &h0602. &h0600 has been tested and CryptoRndII works fine.

[dodicat]

wow!
this forum is deader than the Sahara desert

Code: Select all

 
#include once "fbgfx.bi"
#Include Once "GL/glu.bi"
#include "GL/glext.bi"

Dim Shared As Integer xres,yres
Screenres 1024,768,32,,2 Or 64
Screeninfo xres,yres

'Simple structure just to hold corners of one quad
Type pair
      As Single x,y
End Type
Operator *(x As Double,n As pair) As pair
Return Type<pair>(x*n.x,x*n.y)
End Operator

Type v3
      As Single x,y,z
End Type

Function RotatePoint(c As V3,p As v3,angle As V3,scale As V3=Type<V3>(1,1,1)) As V3
      Dim As Single sx=Sin(angle.x),sy=Sin(angle.y),sz=Sin(angle.z)
      Dim As Single cx=Cos(angle.x),cy=Cos(angle.y),cz=Cos(angle.z)
      Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
      Return Type<V3>((scale.x)*((cy*cz)*dx+(-cx*sz+sx*sy*cz)*dy+(sx*sz+cx*sy*cz)*dz)+c.x,_
      (scale.y)*((cy*sz)*dx+(cx*cz+sx*sy*sz)*dy+(-sx*cz+cx*sy*sz)*dz)+c.y,_
      (scale.z)*((-sy)*dx+(sx*cy)*dy+(cx*cy)*dz)+c.z)
End Function

Function perspective(p As v3,eyepoint As v3) As v3
      Dim As Single   w=1+(p.z/eyepoint.z)
      Return Type<v3>((p.x-eyepoint.x)/w+eyepoint.x,_
      (p.y-eyepoint.y)/w+eyepoint.y,_
      (p.z-eyepoint.z)/w+eyepoint.z)',p.col)
End Function

Sub drawstring(xpos As Long,ypos As Long,text As String ,col As Ulong,size As Single,xres As Long,yres As Long)
      glMatrixMode GL_PROJECTION 'save projection
      glPushMatrix
      glMatrixMode GL_MODELVIEW
      glPushMatrix
      
      glMatrixMode GL_PROJECTION 'make ortho
      glLoadIdentity
      glOrtho 0, xres, yres, 0,-1, 1
      glMatrixMode GL_MODELVIEW
      glLoadIdentity
      #define Red(c) ((c) Shr 16 And 255)
      #define Green(c) ((c) Shr  8 And 255)
      #define Blue(c) ((c) And 255)
      #define Alph(c) ((c) Shr 24)
      glColor4ub Red(col),Green(col),Blue(col),alph(col)
      glend
      glpointsize(1.1*size)
      glBegin (GL_POINTS)
      Type D2
            As Single x,y
      End Type
      Static As d2 cpt(),XY()
      Static As Long runflag
      If runflag=0 Then   
            Redim  XY(128,127)
            Redim cpt(1 To 64*2)
            Screen 8
            Width 640\8,200\16
            Dim As Ulong Pointer img
            Dim count As Long
            For ch As Long=1 To 127
                  img=Imagecreate(640,200)
                  Draw String img,(1,1),Chr(ch)
                  For x As Long=1 To 8 
                        For y As Long=1 To 16
                              If Point(x,y,img)<>0 Then
                                    count=count+1
                                    XY(count,ch)=Type<D2>(x,y)
                              End If
                        Next y
                  Next x
                  count=0
                  Imagedestroy img
            Next ch
            runflag=1
      End If
      If size=0 Then Exit Sub
      Dim As D2 np,t
      #macro Scale(p1,p2,d)
      np.x=d*(p2.x-p1.x)+p1.x
      np.y=d*(p2.y-p1.y)+p1.y
      #endmacro
      
      Dim As D2 c=Type<D2>(xpos,ypos)
      Dim As Long dx=xpos,dy=ypos
      For z6 As Long=1 To Len(text)
            Var asci=text[z6-1]
            For _x1 As Long=1 To 64*2
                  t=Type<D2>(XY(_x1,asci).x+dx,XY(_x1,asci).y+dy)         
                  Scale(c,t,size)
                  cpt(_x1)=np
                  
                  If XY(_x1,asci).x<>0 Then
                        If Abs(size)>0 Then
                              glVertex3f (cpt(_x1).x,(cpt(_x1).y),0)
                        End If
                  End If
            Next _x1
            dx=dx+8
      Next z6
      glend
      glMatrixMode GL_PROJECTION 'restore 
      glPopMatrix
      glMatrixMode GL_MODELVIEW
      glPopMatrix
End Sub

Sub inittext Constructor
      drawstring(0,0,"",0,0,0,0)
End Sub

Function Filter(Byref tim As Ulong Pointer,_
      Byval rad As Long,_
      Byval destroy As Long=1,_
      Byval fade As Long=0) As Ulong Pointer
      #define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
      If fade<0 Then fade=0:If fade>100 Then fade=100
      Type p2
            As Long x,y
            As Ulong col
      End Type
      #macro ppoint(_x,_y,colour)
      pixel=row+pitch*(_y)+(_x)*4
      (colour)=*pixel
      #endmacro
      #macro ppset(_x,_y,colour)
      pixel=row+pitch*(_y)+(_x)*4
      *pixel=(colour)
      #endmacro
      #macro average()
      ar=0:ag=0:ab=0:inc=0
      xmin=x:If xmin>rad Then xmin=rad
      xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x
      ymin=y:If ymin>rad Then ymin=rad
      ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y
      For y1 As Long=-ymin To ymax
            For x1 As Long=-xmin To xmax
                  inc=inc+1 
                  ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
                  ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
                  ab=ab+(NewPoints(x+x1,y+y1).col And 255)
            Next x1
      Next y1
      If fade=0 Then
            averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))
      Else
            averagecolour=Rgb(fd*ar/(inc),fd*ag/(inc),fd*ab/(inc))
      End If
      #endmacro
      Dim As Single fd=map(0,100,fade,1,0)
      Dim As Integer _x,_y
      Imageinfo tim,_x,_y
      Dim  As Ulong Pointer im=Imagecreate(_x,_y)
      Dim As Integer pitch
      Dim  As Any Pointer row
      Dim As Ulong Pointer pixel
      Dim As Ulong col
      Imageinfo tim,,,,pitch,row
      Dim As p2 NewPoints(_x-1,_y-1)
      For y As Long=0 To (_y)-1
            For x As Long=0 To (_x)-1
                  ppoint(x,y,col)
                  NewPoints(x,y)=Type<p2>(x,y,col)
            Next x
      Next y
      Dim As Ulong averagecolour
      Dim As Long ar,ag,ab
      Dim As Long xmin,xmax,ymin,ymax,inc
      Imageinfo im,,,,pitch,row
      For y As Long=0 To _y-1
            For x As Long=0 To _x-1  
                  average()
                  ppset((NewPoints(x,y).x),(NewPoints(x,y).y),averagecolour) 
            Next x
      Next y
      If destroy Then Imagedestroy tim: tim = 0
      Function= im
End Function

Sub cloud(x As Long, y As Long,length As Long=100,Alpha As Long=155, Zoom As Single = 0,im As Any Pointer=0)
      Dim As Long rr=255
      Dim As Long bb=255
      Dim As Long gg=255
      Dim As Double pi=3.14159
      #define mp(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
      If Length<=1 Or Alpha<=1 Then Exit Sub
      Dim As Single rnded = -pi+Rnd*1*pi/2
      Dim As Single rnded2 = -pi+Rnd*-3*pi
      If Alpha<25 Then
            For i As Long = 0 To 255-Alpha Step 100
                  Var c=mp((0),(700),y,0,100)
                  Line im,(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded*PI/3),y+Length/6+length*Sin(-pi/2+rnded*PI/3)),Rgba(Rr-c,Gg-c,Bb-c,Alpha)
                  Line im,(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded2*PI/3),y+Length/6+length*Sin(pi/2+rnded2*PI/3)),Rgba(Rr-c,Gg-c,Bb-c,Alpha)
            Next
      End If
      cloud(-(Zoom/2)+x+length*Cos(-pi/2+rnded*PI/3),(Zoom/2)+y+length*Sin(-pi/2+rnded*PI/3),length/1.4,Alpha/1.2,Zoom,im)
      cloud(-(Zoom/2)+x+length*Cos(-pi/2+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi/2+rnded2*PI/3),length/1.4,Alpha/1.2,Zoom,im)
      cloud(-(Zoom/2)+x+length*Cos(pi/3+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi+rnded2*PI/3),length/1.4,Alpha/2,Zoom,im)
End Sub
'Create a FreeBasic image
Sub CreateFBimageBackground(Byref im2 As Any Ptr)
      Dim As Single minx,maxx,miny,maxy,lasty,grad
      #define dist(x1,y1,x2,y2) Sqr((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2))
      #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
      #macro paintsketch(_function,r,g,b)
      For x As Double=minx To maxx Step (maxx-minx)/5000
            Dim As Double x1=(xres)*(x-minx)/(maxx-minx)
            Dim As Double y1=(yres)*(_function-maxy)/(miny-maxy)
            grad=y1-lasty
            lasty=y1
            grad=grad*250
            Line im2,(x1,0)-(x1,yres-y1),Rgb(r+grad,g+grad,b)
      Next x
      #endmacro
      #macro _window(topleftX,topleftY,bottomrightX,bottomrightY)
      minx=topleftX
      maxx=bottomrightX
      miny=bottomrightY
      maxy=topleftY
      #endmacro
      For x As Long=0 To xres
            For y As Long=0 To yres
                  Var d=dist(x,y,(.69*xres),(.79*yres))
                  Var r=map(0,800,d,255,0)
                  Var g=map(0,800,d,255,0)
                  Var b=map(0,800,d,250,255)
                  Pset im2,(x,y),Rgb(r,g,b)
            Next y
      Next x
      _window(-5,3,25,-1.2)
      paintsketch(.05*Sin(x)+.05*Sin(2*x),100,100,50)
      _window(5,2,30,-.8) 
      paintsketch(.1*Sin(x),100,100,0)
      
      _window(1,2,12,-.6) 
      paintsketch(.1*Sin(x),100,100,0)  
      _window(0,2,8,-.5)
      paintsketch(.2*Sin(x),100,100,0)
      cloud(800,500,50,,,im2)
      im2=filter(im2,1)
End Sub

'Set a Quad to hold image
Sub setbackgroundquad(e() As pair)
      Dim As Single r1=xres/yres,r2=1 'same ratio as screen
      Dim As Single n=1 'left open for a fiddle around
      e(1)=n*Type(-r1,r2)
      e(2)=n*Type(r1,r2)
      e(3)=n*Type(r1,-r2)
      e(4)=n*Type(-r1,-r2)
End Sub

Sub DrawBackGroundQuad(e() As pair)
      Dim As Single n=1
      glLoadIdentity() 
      glTranslatef(0,0,-2) 'adjust the z translate for a good fit
      glbegin gl_quads
      glTexCoord2f( 0,n )
      glvertex3f(e(1).x,e(1).y,0)
      glTexCoord2f( n,n )
      glvertex3f(e(2).x,e(2).y,0)
      glTexCoord2f( n,0 )
      glvertex3f(e(3).x,e(3).y,0)
      glTexCoord2f( 0,0 )
      glvertex3f(e(4).x,e(4).y,0)
      glend
End Sub

Sub glsetup 
      glShadeModel(GL_SMOOTH)                 ' Enables Smooth Color Shading
      glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST) 
      glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
      glEnable GL_ALPHA
      glEnable GL_BLEND
      glViewport(0, 0, xres, yres)       ' Set the viewport
      glMatrixMode(GL_PROJECTION)        ' Change Matrix Mode to Projection
      glLoadIdentity                     ' Reset View
      gluPerspective(45.0, xres/yres, 1.0, 100.0) 
      glMatrixMode(GL_MODELVIEW)         ' Return to the modelview matrix
      glLoadIdentity                     '  Reset View
      
End Sub

'Transfer FB image to OpenGL
Sub settexture( texture As gluint, image As Any Ptr)
      glGenTextures(1, @texture)
      glBindTexture( GL_TEXTURE_2D, texture )
      glTexImage2d( GL_TEXTURE_2D, 0, GL_RGBA, Cast(fb.image Ptr, image)->Width, Cast(fb.image Ptr, image)->height, 0, GL_BGRA, GL_UNSIGNED_BYTE, image+Sizeof(fb.image) )
      glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST )
      glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST )
      glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL)
End Sub


'Rotate and draw the cube with texturing on each face
Sub DrawGlCube(Byref rotangle As Single)
      Static As Double a
      a+=.0075
      Static As v3 p
      p=Type<v3>(-7,0,-9)
      Var r=rotatepoint(Type<v3>(0,0,-15),p,Type<v3>(0,a,0),Type(1,1,1.1))
      r=perspective(r,Type(0,0,-30))
      
      glLoadIdentity()
      glTranslatef(r.x,r.y,r.z)
      
      glRotatef(rotangle,1,.5,.25)           ' Rotate 
      glBegin(GL_QUADS)
      
      glTexCoord2f( 1,1 )
      glVertex3f( 1.0, 1.0,-1.0)            ' Top right of the quad (top)
      glTexCoord2f( 0,1 )
      glVertex3f(-1.0, 1.0,-1.0)            ' Top left of the quad (top)
      glTexCoord2f( 0,0 )
      glVertex3f(-1.0, 1.0, 1.0)            ' Bottom left of the quad (top)
      glTexCoord2f( 1,0 )
      glVertex3f( 1.0, 1.0, 1.0)            ' Bottom right of the quad (top)
      
      glTexCoord2f( 1,1 )       
      glVertex3f( 1.0,-1.0, 1.0)            ' Top right of the quad (bottom)
      glTexCoord2f( 0,1 )
      glVertex3f(-1.0,-1.0, 1.0)            ' Top left of the quad (bottom)
      glTexCoord2f( 0,0 )
      glVertex3f(-1.0,-1.0,-1.0)            ' Bottom left of the quad (bottom)
      glTexCoord2f( 1,0 )
      glVertex3f( 1.0,-1.0,-1.0)            ' Bottom right of the quad (bottom)
      
      glTexCoord2f( 1,1 )
      glVertex3f( 1.0, 1.0, 1.0)            ' Top right of the quad (front)
      glTexCoord2f( 0,1 )
      glVertex3f(-1.0, 1.0, 1.0)            ' Top left of the quad (front)
      glTexCoord2f( 0,0 )
      glVertex3f(-1.0,-1.0, 1.0)            ' Bottom left of the quad (front)
      glTexCoord2f( 1,0 )
      glVertex3f( 1.0,-1.0, 1.0)            ' Bottom right of the quad (front)
      
      glTexCoord2f( 1,1 )
      glVertex3f( 1.0,-1.0,-1.0)            ' Bottom left of the quad (back)
      glTexCoord2f( 0,1 )
      glVertex3f(-1.0,-1.0,-1.0)            ' Bottom right of the quad (back)
      glTexCoord2f( 0,0 )
      glVertex3f(-1.0, 1.0,-1.0)            ' Top right of the quad (back)
      glTexCoord2f( 1,0 )
      glVertex3f( 1.0, 1.0,-1.0)            ' Top left of the quad (back)
      
      glTexCoord2f( 1,1 )
      glVertex3f(-1.0, 1.0, 1.0)            ' Top right of the quad (left)
      glTexCoord2f( 0,1 )
      glVertex3f(-1.0, 1.0,-1.0)            ' Top left of the quad (left)
      glTexCoord2f( 0,0 )
      glVertex3f(-1.0,-1.0,-1.0)            ' Bottom left of the quad (left)
      glTexCoord2f( 1,0 )
      glVertex3f(-1.0,-1.0, 1.0)            ' Bottom right of the quad (left)
      
      glTexCoord2f( 1,1 )
      glVertex3f( 1.0, 1.0,-1.0)            ' Top right of the quad (right)
      glTexCoord2f( 0,1 )
      glVertex3f( 1.0, 1.0, 1.0)            ' Top left of the quad (right)
      glTexCoord2f( 0,0 )
      glVertex3f( 1.0,-1.0, 1.0)            ' Bottom left of the quad (right)
      glTexCoord2f( 1,0 )
      glVertex3f( 1.0,-1.0,-1.0)
      glend
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long
      Static As Double timervalue,_lastsleeptime,t3,frames
      Var t=Timer
      frames+=1
      If (t-t3)>=1 Then t3=t:fps=frames:frames=0
      Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
      If sleeptime<1 Then sleeptime=1
      _lastsleeptime=sleeptime
      timervalue=T
      Return sleeptime
End Function

'Some variables
Dim As gluint tex1
Dim As Any Ptr background=Imagecreate(xres,yres)
Dim  As pair BackgroundCorners(1 To 4)


CreateFBimageBackground(background)
setbackgroundquad(BackgroundCorners())

'NOW START OPENGL
glsetup
'transfer freebasic image to openGL
settexture(tex1,background)
'enable texturing
glEnable( GL_TEXTURE_2D )
Dim As Single angle
Dim As Long fps

Do
      angle=angle+1
      glClear(GL_COLOR_BUFFER_BIT)
      'freebasic image is planted onto the background quad
      DrawBackGroundQuad(BackgroundCorners())
      drawstring(50,50,"Framerate = " &fps,Rgb(0,0,0),1,xres,yres)
      'standard rotate cube
      'with image planted to each face
      glEnable (GL_CULL_FACE)
      DrawGlcube(angle)
      gldisable(GL_CULL_FACE)
      glend
      Flip
      Sleep regulate(60,fps),1
Loop Until Inkey=Chr(27)
Imagedestroy background
 

[deltarho[1859]]

[SARG]

Hi srvaldez,

I found where it's defined : _mingw.bi

Code: Select all

#ifndef _WIN32_WINNT
	const _WIN32_WINNT = &h0502
#endif

CreateThreadpool is declared only for windows Vista and higher.

Code: Select all

#if _WIN32_WINNT >= &h0600
	declare function CreateThreadpool(byval reserved as PVOID) as PTP_POOL

Try to define the value after all the includes

Code: Select all

	#include "windows.bi"
	 #undef _WIN32_WINNT
	const _WIN32_WINNT = &h0600

IMO it should be hard to output a warning or an error message when happens a such case.

As a reminder.

Code: Select all

Windows 10			_WIN32_WINNT_WIN10 (0x0A00)
Windows 8.1			_WIN32_WINNT_WINBLUE (0x0603)
Windows 8			_WIN32_WINNT_WIN8 (0x0602)
Windows 7				_WIN32_WINNT_WIN7 (0x0601)
Windows Server 2008	_WIN32_WINNT_WS08 (0x0600)
Windows Vista		_WIN32_WINNT_VISTA (0x0600)
Windows Server 2003 with SP1, Windows XP with SP2	_WIN32_WINNT_WS03 (0x0502)
Windows Server 2003, Windows XP						_WIN32_WINNT_WINXP (0x0501)

Edit Thanks deltarho Vista not W8. I kept in memory 602 from srvaldez's post....

[deltarho[1859]]

From Microsoft CreateThreadpool function's requirements: Minimum supported client, Windows Vista.

So, SARG's statement "CreateThreadpool is declared only for windows8 and higher." should read "CreateThreadpool is declared only for Windows Vista and higher." [Now corrected by SARG]

As mentioned three posts back: "&h0600 has been tested and CryptoRndII works fine."

[deltarho[1859]]

In the Version 1.06.0 [added] section of the changelog.txt file we have:

- Windows API binding updated to additionally support _WIN32_WINNT &h0501, &h0600, &h0601

[srvaldez]

thank you all for your insightful replies

The question is how do we know whether a function requires a _WIN32_WINNT definition or not?

the problem is that with the default value for _WIN32_WINNT = &h0502 = Windows Server 2003 some functions are not available, only when you set it to &h0602 or higher
@dodicat
love your desert cube

[deltarho[1859]]

the problem is that with the default value for _WIN32_WINNT = &h0502 = Windows Server 2003 some functions are not available, only when you set it to &h0602 or higher

Well, that is my understanding of _WIN32_WINNT out of the window. I would have thought that Windows Server 2003, SP2 in 2007, would not know what &h0602 is since that was introduced with Windows 8 in 2012.

[deltarho[1859]]

Here is a version of CryptoRndII which does not use Microsoft's thread pooling but uses fxm's FreeBASIC method as a direct replacement. It is not a replacement of thread pooling but a replacement of the thread pooling aspects used in CryptoRndII. fxm's code is very readable compared to thread pooling and is easier to use. Just to make sure that nothing untoward occurred in this version it was subject to a PractRand test and allowed to run for 1TB. Only one small anomaly was recorded which is excellent.

Code: Select all

'#Console On
Const _WIN32_WINNT = &h0600
#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

' ******************** fxm 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
		Dim As Any Ptr _mutex2
		Dim As Any Ptr _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 code

Dim Shared hRand As BCRYPT_ALG_HANDLE
#If (ALGO = 1)
  Sub on_exit( ) Destructor
    BCryptCloseALGOrithmProvider( hRand, 0  )
  End Sub
#Endif

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 )

#If (ALGO = 1)
  BufferSize = 128*1024
#Else
  BufferSize = 32*1024
#Endif
 
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
  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
 
#If (ALGO = 1)
Private Sub FillBuffer( ByVal BaseBuffer As Any Ptr )
  BCryptGenRandom( hRand, BaseBuffer, BufferSize\2, 0)
End Sub
#Else
Private Sub FillBuffer( ByVal BaseBuffer As Any Ptr )
Dim As Long HalfBuffer
Dim As Ulong RecoverBuffer
Dim As Any Ptr ptrRecoverBuffer
 
  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
  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

[deltarho[1859]]

fxm has been developing even more powerful code, but the code used above is just right for CryptoRndII purposes.