Print Page - Threading

Title: Threading
Post by: justsomeguy on May 03, 2021, 03:31:18 pm

Hello

I'm starting down the rabbit-hole of using threads in my 2d physics engine. I'm aware that multi-threading is not supported, nor probably ever supported by QB64, however, I'm trying to see if it is possible to do by using the pthreads library.

When you are creating threads in pthread, you must provide a void pointer to the sub/function that you are trying to create multiple threads of. I'm at loss on how to get these pointers. It seems that it is a one way street between the libraries and your QB program, no way for them to call back your program.

Is there some clever workaround? I read a post somewhere that someone had some limited success with the windows multi-threading in QB64, but they only got to the demo stage.

Any help in this regard will be appreciated. Thanks!

Title: Re: Threading
Post by: SpriggsySpriggs on May 03, 2021, 03:40:09 pm

@justsomeguy I believe we can use threads in QB64 but it could be quite a labor to do so if you want to use it purely (or almost purely) in the QB64 IDE. It's probably quite simple when doing it by using a header file. This idea has been nagging my brain for quite some time. I'm planning on looking into this at some point both as a header and as (mostly) QB64 syntax. If you look at the page from the MSDN on threads here (https://docs.microsoft.com/en-us/windows/win32/procthread/creating-threads), it looks like it might not be too terrible.

Title: Re: Threading
Post by: justsomeguy on May 03, 2021, 04:07:52 pm

Okay, so using a header file, how would you call a function/sub that you wrote in QB?

Title: Re: Threading
Post by: SpriggsySpriggs on May 03, 2021, 04:56:10 pm

Here is an example in which a QB64 function is used as a CALLBACK:

Code: C++: [Select]

ptrszint FUNC_WINDOWPROC(ptrszint*_FUNC_WINDOWPROC_OFFSET_HWND,uint32*_FUNC_WINDOWPROC_ULONG_UMSG,uptrszint*_FUNC_WINDOWPROC_UOFFSET_WPARAM,ptrszint*_FUNC_WINDOWPROC_OFFSET_LPARAM);
//^^this is the declaration of the QB64 function WindowProc%&, as it would appear after being translated by the IDE^^
 
LRESULT CALLBACK WindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) {
 return FUNC_WINDOWPROC((ptrszint *) (& hwnd), & uMsg, & wParam, (ptrszint *) (& lParam));
//^^returning the value from the QB64 function^^
}
 
void * GetWindowProc() {
 return (void *) WindowProc;
//^^getting the pointer to the function that could be used to call the QB64 function^^
}
 

Title: Re: Threading
Post by: justsomeguy on May 03, 2021, 05:14:23 pm

Thank you! I will try to make a more generic version of this and try it.

Title: Re: Threading
Post by: Galleon on May 04, 2021, 07:56:56 am

Calling multiple QB64 subs/functions in parallel without a lot of changes to the compiler is not going to work.
Have a look at what ...\internal\temp\main.txt looks like after compiling this simple program...

Code: QB64: [Select]

c = addnums(5, 6)
FUNCTION addnums (a, b)
    addnums = a + b
END FUNCTION
 

You will see a lot of extra code and the beginning and end of a function called FUNC_ADDNUMS.
That code is working with a range of global variables and if two SUBs/FUNCTIONs were called at the same time it's going to be very bad.
If you really need that extra power, may I suggest running multiple exes at once and using TCP/IP communication between them.

That said, if you do proceed down this route, I imagine you have more chance of inventing general AI than many of the researchers in that field.

Title: Re: Threading
Post by: justsomeguy on May 04, 2021, 08:25:14 am

Quote

Calling multiple QB64 subs/functions in parallel without a lot of changes to the compiler is not going to work.

Hmmm that is disappointing. Would it be equally impossible if I wrote this instead?

Code: QB64: [Select]

c = addnumsThread0(5, 6)
d = addnumsThread1(4, 8)
e = addnumsThread2(1, 3)
 
FUNCTION addnumsThread0 (a, b)
    addnums = a + b
END FUNCTION
 
FUNCTION addnumsThread1 (a, b)
    addnums = a + b
END FUNCTION
 
FUNCTION addnumsThread2 (a, b)
    addnums = a + b
END FUNCTION

I know this looks foolish. But maybe a slightly altered approach?

Quote

If you really need that extra power, may I suggest running multiple exes at once and using TCP/IP communication between them.

That is a good idea. I have not really explored that.

Title: Re: Threading
Post by: FellippeHeitor on May 04, 2021, 08:57:44 am

Quote from: Galleon on May 04, 2021, 07:56:56 am

Calling multiple QB64 subs/functions in parallel without a lot of changes to the compiler is not going to work.

You now have me wondering if ON TIMER calling Subs is all good to go.

Code: QB64: [Select]

t = _FreeTimer
On Timer(t, 1) doIt
Timer(t) On
 
goLoop
 
Sub goLoop
    Do
        Print "looping... ";
        _Limit 10
    Loop
End Sub
 
Sub doIt
    Color 5
    Print "--> Doing it..."
    Color 7
End Sub

Title: Re: Threading
Post by: justsomeguy on May 04, 2021, 09:42:17 am

I guess ultimately my thought was along the lines of, if running the exact same sub/function concurrently is problematic, then what about different sub/functions concurrently?

I suspect 'ON TIMER' might be okay since it is not actually concurrent.

Title: Re: Threading
Post by: justsomeguy on May 05, 2021, 10:20:44 am

Hello

Well, I got threads to work...somewhat...mostly...kinda. I've run it many, many times and I only get core dumps occasionally ;). Its obviously not as stable as I like, but It is merely a proof of concept. Its okay for testing and it has taught me a lot.

I'm using a linux machine so I'm using the pthread library, but I imagine the process would be similar to make it work in Windows, no idea about Mac. To keep it simple I kept all of the pthread stuff in the header. Functions are of course in the QB program.

If you would like to try it and you are on a Linux box then here is the source.

This is the header required it must be saved as "qbthread2.h" in your folder with the program.

Code: QB64: [Select]

#include "pthread.h"
 
typedef struct thread_data {
   int a;
   float result;
} thread_data;
 
 
float FUNC_THREAD0(int16*_FUNC_THREAD0_INTEGER_A);
float FUNC_THREAD1(int16*_FUNC_THREAD1_INTEGER_A);
float FUNC_THREAD2(int16*_FUNC_THREAD2_INTEGER_A);
 
static pthread_mutex_t mutex0;
static pthread_mutex_t mutex1;
static pthread_mutex_t mutex2;
 
void* RunThread0(void *arg){
        pthread_mutex_lock(&mutex0);
        thread_data *tdata=(thread_data *)arg;
        int a = tdata->a;
        tdata->result = FUNC_THREAD0((int16*)&a);
        pthread_mutex_unlock(&mutex0);
        pthread_exit(NULL); 
}
 
void* RunThread1(void *arg){
        pthread_mutex_lock(&mutex1);
        thread_data *tdata=(thread_data *)arg;
        int a = tdata->a;
        tdata->result = FUNC_THREAD1((int16*)&a);
        pthread_mutex_unlock(&mutex1);
        pthread_exit(NULL); 
}
 
void* RunThread2(void *arg){
        pthread_mutex_lock(&mutex2);
        thread_data *tdata=(thread_data *)arg;
        int a = tdata->a;
        tdata->result = FUNC_THREAD2((int16*)&a);
        pthread_mutex_unlock(&mutex2);
        pthread_exit(NULL); 
}
 
long invokeThreadsMethodOne(int a, int b, int c){
        pthread_t threads01;
        pthread_t threads02;
        pthread_t threads03;
        
        thread_data tdata1;
        thread_data tdata2;
        thread_data tdata3;
        
        tdata1.a = a;
        tdata2.a = b;
        tdata3.a = c;
        
        int t1 = pthread_create(&threads01, NULL, RunThread0, (void *)&tdata1);
        if (t1 != 0)
    {
                cout << "Error in thread creation: " << t1 << endl;
    }
    
    int t2 = pthread_create(&threads02, NULL, RunThread1, (void *)&tdata2);
        if (t2 != 0)
    {
                cout << "Error in thread creation: " << t2 << endl;
    }
    
    int t3 = pthread_create(&threads03, NULL, RunThread2, (void *)&tdata3);
        if (t3 != 0)
    {
                cout << "Error in thread creation: " << t3 << endl;
    }
    
    void* status1;
    void* status2;
    void* status3;
    
        t1 = pthread_join(threads01, &status1);
        if (t1 != 0)
        {
                cout << "Error in thread join: " << t1 << endl;
        }
        
        t2 = pthread_join(threads02, &status2);
        if (t2 != 0)
        {
                cout << "Error in thread join: " << t2 << endl;
        }
 
        t3 = pthread_join(threads03, &status3);
        if (t3 != 0)
        {
                cout << "Error in thread join: " << t3 << endl;
        }
    return tdata1.result + tdata2.result + tdata3.result;
}
 
long invokeThreadsMethodTwo(int a, int b, int c)
{
    pthread_t threads[3];
    thread_data tdata[3];
    tdata[0].a = a;
    tdata[1].a = b;
    tdata[2].a = c;
 
    for (long int i = 0 ; i < 3 ; ++i)
    {
        int t = pthread_create(&threads[i], NULL, RunThread0, (void *)&tdata[i]);
 
        if (t != 0)
        {
            cout << "Error in thread creation: " << t << endl;
        }
    }
 
    for(int i = 0 ; i < 3; ++i)
    {
        void* status;
        int t = pthread_join(threads[i], &status);
        if (t != 0)
        {
            cout << "Error in thread join: " << t << endl;
            }
    }
 
    return tdata[0].result + tdata[1].result + tdata[2].result;
}
 

Here is the QBasic portion. It can be saved as whatever you like.

Code: QB64: [Select]

$CHECKING:OFF
' a,b,c are integers passed to the individual threads
' right now only a long value is returned
DECLARE LIBRARY "./qbthread2"
    FUNCTION invokeThreadsMethodOne (BYVAL a AS INTEGER, BYVAL b AS INTEGER, BYVAL c AS INTEGER)
    FUNCTION invokeThreadsMethodTwo (BYVAL a AS INTEGER, BYVAL b AS INTEGER, BYVAL c AS INTEGER)
END DECLARE
 
CONST cITERATIONS = 100
CONST cSUBITERATIONS = 1000
CONST cFUNCTIONITERATIONS = 20000
DIM z AS LONG
DIM i AS LONG
DIM tmr AS DOUBLE
 
i = 0
tmr = TIMER(.001)
DO
    LOCATE 1, 1
    PRINT "Invoke Three Different Functions  --- Iteration:"; i
    z = invokeThreadsMethodOne(cSUBITERATIONS, cSUBITERATIONS, cSUBITERATIONS)
    PRINT "Threads returned:"; z
    i = i + 1
LOOP UNTIL i >= cITERATIONS OR _KEYHIT = 27
PRINT TIMER(.001) - tmr; " Seconds have elapsed."
PRINT "Press Space to continue..."
DO
LOOP UNTIL _KEYHIT = 32
CLS
 
i = 0
tmr = TIMER(.001)
DO
    LOCATE 1, 1
    PRINT "Invoke Same Function Three Times --- Iteration:"; i
    z = invokeThreadsMethodTwo(cSUBITERATIONS, cSUBITERATIONS, cSUBITERATIONS)
    PRINT "Threads returned:"; z
    i = i + 1
LOOP UNTIL i >= cITERATIONS OR _KEYHIT = 27
PRINT TIMER(.001) - tmr; " Seconds have elapsed."
PRINT "Press Space to continue..."
DO
LOOP UNTIL _KEYHIT = 32
CLS
 
i = 0
tmr = TIMER(.001)
DO
    LOCATE 1, 1
    PRINT "Just Call Functions Normally --- Iteration:"; i
    z = thread0(cSUBITERATIONS) + thread1(cSUBITERATIONS) + thread2(cSUBITERATIONS)
    PRINT "Functions returned:"; z
    i = i + 1
LOOP UNTIL i >= cITERATIONS OR _KEYHIT = 27
PRINT TIMER(.001) - tmr; " Seconds have elapsed."
 
'***********************************************************************************
' Threaded Functions
'***********************************************************************************
 
FUNCTION thread0 (a AS INTEGER)
    DIM AS LONG i, o
    FOR i = 1 TO a * cFUNCTIONITERATIONS
        o = o + 7
    NEXT
    thread0 = o
END FUNCTION
 
FUNCTION thread1 (a AS INTEGER)
    DIM AS LONG i, o
    FOR i = 1 TO a * cFUNCTIONITERATIONS
        o = o + 7
    NEXT
    thread1 = o
END FUNCTION
 
FUNCTION thread2 (a AS INTEGER)
    DIM AS LONG i, o
    FOR i = 1 TO a * cFUNCTIONITERATIONS
        o = o + 7
    NEXT
    thread2 = o
END FUNCTION
 

In the program I tested a couple of different approaches to creating threads to see how it effects stability and speed and compared it to a baseline of just running the functions sequentially.

On my machine which is few years old and not very fast to begin with I got these results.

Pthreads opens 3 threads of different functions that perform the same task - 41.03 seconds
Pthreads opens 3 threads of a single function - 29.33 seconds
Run the functions normally in sequence - 27.54 seconds

Needless to say the result were surprising. Unless there is some flaw in the way I implemented the threads or the test, it appears that running a single sequential thread outperforms three threads. I suspect that the overhead in creating the threads may play a part in it, or more likely my test is garbage. The attached pictures show my CPU utilzation during the tests.

The first method is unorthodox and occassionally returns the wrong result. Clearly a bad idea, but now I know for sure.

I might experiment with more threads to see if results change.

Title: Re: Threading
Post by: Richard Frost on May 05, 2021, 04:22:28 pm

Impressive attempt. Threads would be useful for my chess program.

I don't understand what the .001 parameter in your use of TIMER is for.

Title: Re: Threading
Post by: SpriggsySpriggs on May 05, 2021, 04:24:42 pm

@justsomeguy I didn't realize you were using Linux. In that case, look up the pages on fork for another neat thing. I am genuinely impressed by your header file. I'm not at my Linux right now but when I get back from my business trip then I'll for sure give your file a try.

Title: Re: Threading
Post by: justsomeguy on May 05, 2021, 05:47:08 pm

Quote

Impressive attempt. Threads would be useful for my chess program.

Well if my data is correct, which it very well may not be, threading may not help you. It was in fact slower, even when I bumped it up to four threads. Not to mention threading in QB64 is a complete minefield full of "seg faults" and "core dumps." It is not for the faint of heart.

The test I wrote relies heavily with not interacting with QB built-in functions. Even PRINT will core dump. The idea was to pass a threaded function/sub some arguments, and have it chew on it, and then pass results to some memory that is allocated just for that thread. These functions would have to be very simple and not call anything from the outside.

Quote

I don't understand what the .001 parameter in your use of TIMER is for.

This is from the help for TIMER

Quote

Example 3: Using a DOUBLE variable for TIMER(.001) millisecond accuracy in QB64 throughout the day.

ts! = TIMER(.001) 'single variable
td# = TIMER(.001) 'double variable

PRINT "Single ="; ts!
PRINT "Double ="; td#

Single = 77073.09
Double = 77073.094

Explanation: SINGLE variables will cut off the millisecond accuracy returned so DOUBLE variables should be used. TIMER values
will also exceed INTEGER limits. When displaying TIMER values, use LONG for seconds and DOUBLE for milliseconds.

Granted it was ultimately unneeded.

@SpriggsySpriggs First, Thank you! Without your guidance I would not have been able to even get started. I will look into fork and thanks for complimenting the header.

I have stripped it down to essentials now that I have finished testing some dumb ideas.

This header must be named "qbthread3.h" and be located in the same folder as the source.

Code: QB64: [Select]

#include "pthread.h"
 
typedef struct thread_data {
   int a;
   float result;
} thread_data;
 
#define NUM_OF_THREADS 3
 
float FUNC_THREAD0(int16*_FUNC_THREAD0_INTEGER_A);
 
static pthread_mutex_t mutex0;
 
void* RunThread0(void *arg){
        pthread_mutex_lock(&mutex0);
        thread_data *tdata=(thread_data *)arg;
        int a = tdata->a;
        tdata->result = FUNC_THREAD0((int16*)&a);
        pthread_mutex_unlock(&mutex0);
        pthread_exit(NULL); 
}
 
 
long invokeThreads(int a, int b, int c) // you will have to add more arguments for more threads
{
    pthread_t threads[NUM_OF_THREADS];
    thread_data tdata[NUM_OF_THREADS];
    tdata[0].a = a;
    tdata[1].a = b;
    tdata[2].a = c;
    float res = 0;
 
    for (long int i = 0 ; i < NUM_OF_THREADS ; ++i)
    {
        int t = pthread_create(&threads[i], NULL, RunThread0, (void *)&tdata[i]);
 
        if (t != 0)
        {
            cout << "Error in thread creation: " << t << endl;
        }
    }
 
    for(int i = 0 ; i < NUM_OF_THREADS; ++i)
    {
        void* status;
        int t = pthread_join(threads[i], &status);
        if (t != 0)
        {
            cout << "Error in thread join: " << t << endl;
        }
        res += tdata[i].result;
    }
    return res;
}
 

This is the stripped down source. Name it whatever you want.

Code: QB64: [Select]

$CHECKING:OFF
' a,b,c are integers passed to the individual threads
' right now only a long value is returned
DECLARE LIBRARY "./qbthread3"
    FUNCTION invokeThreads (BYVAL a AS INTEGER, BYVAL b AS INTEGER, BYVAL c AS INTEGER)
END DECLARE
 
CONST cITERATIONS = 10
CONST cSUBITERATIONS = 10000
CONST cFUNCTIONITERATIONS = 20000
DIM z AS LONG
DIM i AS LONG
DIM tmr AS DOUBLE
 
i = 0
tmr = TIMER(.001)
DO
    LOCATE 1, 1
    PRINT "Invoke 3 Threads  --- Iteration:"; i
    z = invokeThreads(cSUBITERATIONS, cSUBITERATIONS, cSUBITERATIONS)
    PRINT "Threads returned:"; z
    i = i + 1
LOOP UNTIL i >= cITERATIONS OR _KEYHIT = 27
PRINT TIMER(.001) - tmr; " Seconds have elapsed."
PRINT "Press Space to continue..."
DO
LOOP UNTIL _KEYHIT = 32
CLS
 
i = 0
tmr = TIMER(.001)
DO
    LOCATE 1, 1
    PRINT "Just Call Functions Normally --- Iteration:"; i
    z = thread0(cSUBITERATIONS) + thread0(cSUBITERATIONS) + thread0(cSUBITERATIONS)
    PRINT "Functions returned:"; z
    i = i + 1
LOOP UNTIL i >= cITERATIONS OR _KEYHIT = 27
PRINT TIMER(.001) - tmr; " Seconds have elapsed."
 
 
 
'***********************************************************************************
' Threaded Functions
'***********************************************************************************
 
FUNCTION thread0 (a AS INTEGER)
    DIM AS LONG i, o
    FOR i = 1 TO a * cFUNCTIONITERATIONS
        o = o + 3
    NEXT
    thread0 = o
END FUNCTION
 
 

Title: Re: Threading
Post by: SpriggsySpriggs on May 06, 2021, 08:43:01 am

I am quite excited to see this code progress. I can't wait to get home from my trip and try your code.

Title: Re: Threading
Post by: bplus on May 06, 2021, 11:45:03 am

Quote from: Richard Frost on May 05, 2021, 04:22:28 pm

Impressive attempt. Threads would be useful for my chess program.

I don't understand what the .001 parameter in your use of TIMER is for.

The .001 parameter tells the function the level of accuracy desired.

Maybe different threads but only one CPU, wouldn't the management of different threads take away from time a huge number crunching algo that Max\min to some high level look ahead needs?

Title: Re: Threading
Post by: SpriggsySpriggs on May 06, 2021, 11:20:55 pm

@justsomeguy You got me seriously interested in this topic so I decided to whip up some WinAPI QB64 code based on the example on the MSDN page on threading here (https://docs.microsoft.com/en-us/windows/win32/procthread/creating-threads). Below is the code that will run three threads in the same executable.

A header you will need, save it as threadwin.h

Code: C++: [Select]

#include<strsafe.h>
int32 FUNC_MYTHREADFUNCTION(ptrszint*_FUNC_MYTHREADFUNCTION_OFFSET_LPPARAM);
extern "C"{
        __declspec(dllexport) int32 MyThreadFunction(ptrszint*lpParam){
                return FUNC_MYTHREADFUNCTION((lpParam));
        }
}
 
int32 sizeoftchar(){
        return sizeof(TCHAR);
}

Code: QB64: [Select]

Option _Explicit
$Console:Only
 
Type MyData
    As Long val1, val2
End Type
 
Const BUF_SIZE = 255
Const MAX_THREADS = 20
Const HEAP_ZERO_MEMORY = &H00000008
Const INFINITE = 4294967295
Const STD_OUTPUT_HANDLE = -11
Const INVALID_HANDLE_VALUE = -1
 
Const MB_OK = 0
 
Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H00000100
Const FORMAT_MESSAGE_FROM_SYSTEM = &H00001000
Const FORMAT_MESSAGE_IGNORE_INSERTS = &H00000200
Const LANG_NEUTRAL = &H00
Const SUBLANG_DEFAULT = &H01
 
Const LMEM_ZEROINIT = &H0040
 
Declare CustomType Library
    Function LoadLibrary%& (lpLibFileName As String)
    Function GetProcAddress%& (ByVal hModule As _Offset, lpProcName As String)
    Function FreeLibrary%% (ByVal hLibModule As _Offset)
    Sub FreeLibrary (ByVal hLibModule As _Offset)
    Function GetLastError& ()
    Function HeapAlloc%& (ByVal hHeap As _Offset, Byval dwFlags As Long, Byval dwBytes As _Offset)
    Function GetProcessHeap%& ()
    Sub ExitProcess (ByVal uExitCode As _Unsigned Long)
    Function CreateThread%& (ByVal lpThreadAttributes As _Offset, Byval dwStackSize As _Offset, Byval lpStartAddress As _Offset, Byval lpParameter As _Offset, Byval dwCreationFlags As Long, Byval lpThreadId As _Offset)
    Function WaitForMultipleObjects& (ByVal nCount As Long, Byval lpHandles As _Offset, Byval bWaitAll As _Byte, Byval dwMilliseconds As Long)
    Sub WaitForMultipleObjects (ByVal nCount As Long, Byval lpHandles As _Offset, Byval bWaitAll As _Byte, Byval dwMilliseconds As Long)
    Function CloseHandle%% (ByVal hObject As _Offset)
    Sub CloseHandle (ByVal hObject As _Offset)
    Function HeapFree%% (ByVal hHeap As _Offset, Byval dwFlags As Long, Byval lpMem As _Offset)
    Sub HeapFree (ByVal hHeap As _Offset, Byval dwFlags As Long, Byval lpMem As _Offset)
    Sub StringCchPrintf Alias "StringCchPrintfA" (ByVal pszDest As _Offset, Byval cchDest As _Offset, byvalpszFormat As String, Byval arg1 As Long, Byval arg2 As Long)
    Sub StringCchPrintf2 Alias "StringCchPrintfA" (ByVal pszDest As _Offset, Byval cchDest As _Offset, pszFormat As String, lpszFunction As String, Byval error As Long, Byval lpMsgBuf As _Offset)
    Sub StringCchLength Alias "StringCchLengthA" (ByVal psz As _Offset, Byval cchMax As _Offset, Byval pcchLength As _Offset)
    Function GetStdHandle%& (ByVal nStdHandle As Long)
    Function CreateMutex%& Alias "CreateMutexA" (ByVal lpMutexAttributes As _Offset, Byval bInitialOwner As Long, Byval lpName As _Offset)
    Sub WriteConsole (ByVal hConsoleOutput As _Offset, Byval lpBuffer As _Offset, Byval nNumberOfCharsToWrite As Long, Byval lpNumberOfCharsWritten As _Offset, Byval lpReserved As _Offset)
    Sub FormatMessage Alias FormatMessageA (ByVal dwFlags As Long, Byval lpSource As Long, Byval dwMessageId As Long, Byval dwLanguageId As Long, Byval lpBuffer As _Offset, Byval nSize As Long, Byval Arguments As _Offset)
    Sub MessageBox Alias "MessageBoxA" (ByVal hWnd As _Offset, Byval lpText As _Offset, lpCaption As String, Byval uType As _Unsigned Long)
    Sub LocalFree (ByVal hMem As _Offset)
    Function LocalAlloc%& (ByVal uFlags As _Unsigned Long, Byval uBytes As _Unsigned _Offset)
    Function lstrlen& Alias "lstrlenA" (ByVal lpString As _Offset)
    Function LocalSize%& (ByVal hMem As _Offset)
    Sub SetLastError (ByVal dwError As Long)
End Declare
 
Declare Library "threadwin"
    Function sizeoftchar& ()
End Declare
 
Declare Library
    Function MAKELANGID& (ByVal p As Long, Byval s As Long)
End Declare
 
Dim As _Offset libload: libload = LoadLibrary(Command$(0))
Dim As _Offset MyThreadFunc: MyThreadFunc = GetProcAddress(libload, "MyThreadFunction")
 
Dim As MyData pDataArray(1 To MAX_THREADS)
Dim As Long dwThreadIdArray(1 To MAX_THREADS)
Dim As _Offset hThreadArray(1 To MAX_THREADS), heap(1 To MAX_THREADS)
 
Dim As _Offset ghMutex: ghMutex = CreateMutex(0, 0, 0)
If ghMutex = 0 Then
    ErrorHandler "CreateMutex"
End If
Dim As Long i
For i = 1 To MAX_THREADS
    heap(i) = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, Len(pDataArray(i)))
    Dim As _MEM pdata: pdata = _MemNew(8)
    _MemPut pdata, pdata.OFFSET, heap(i)
    _MemGet pdata, pdata.OFFSET, pDataArray(i)
    If heap(i) = 0 Then
        ExitProcess 2
    End If
    pDataArray(i).val1 = i
    pDataArray(i).val2 = i + 100
    hThreadArray(i) = CreateThread(0, 0, MyThreadFunc, _Offset(pDataArray(i)), 0, _Offset(dwThreadIdArray(i)))
    If hThreadArray(i) = 0 Then
        ErrorHandler "CreateThread"
        ExitProcess 3
    End If
Next
WaitForMultipleObjects MAX_THREADS, _Offset(hThreadArray()), 1, INFINITE
For i = 1 To MAX_THREADS
    CloseHandle hThreadArray(i)
    If heap(i) <> 0 Then
        HeapFree GetProcessHeap, 0, heap(i)
    End If
Next
CloseHandle ghMutex
FreeLibrary libload
 
Function MyThreadFunction& (lpParam As _Offset)
    Dim As String * BUF_SIZE msgBuf
    Dim As _Offset hStdout
    Dim As Long cchStringSize, dwChars
    Dim As MyData MyData
    hStdout = GetStdHandle(STD_OUTPUT_HANDLE)
    If hStdout = INVALID_HANDLE_VALUE Then
        MyThreadFunction = 1
    End If
    Dim As _MEM PMYDATA: PMYDATA = _MemNew(8)
    _MemPut PMYDATA, PMYDATA.OFFSET, lpParam
    _MemGet PMYDATA, PMYDATA.OFFSET, MyData
    StringCchPrintf _Offset(msgBuf), BUF_SIZE, "Parameters = %d, %d" + Chr$(10) + Chr$(0), MyData.val1, MyData.val2
    StringCchLength _Offset(msgBuf), BUF_SIZE, _Offset(cchStringSize)
    WriteConsole hStdout, _Offset(msgBuf), cchStringSize, _Offset(dwChars), 0
    MyThreadFunction = 0
End Function
 
Sub ErrorHandler (lpszFunction As String)
    Dim As _Offset lpMsgBuf, lpDisplayBuf
    Dim As Long dw: dw = GetLastError
    FormatMessage FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0, dw, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), _Offset(lpMsgBuf), 0, 0
    lpDisplayBuf = LocalAlloc(LMEM_ZEROINIT, (lstrlen(lpMsgBuf) + lstrlen(_Offset(lpszFunction)) + 40) * sizeoftchar)
    StringCchPrintf2 lpDisplayBuf, LocalSize(lpDisplayBuf) / sizeoftchar, "%s failed with error %d:" + Chr$(10) + " %s" + Chr$(0), lpszFunction + Chr$(0), dw, lpMsgBuf
    MessageBox 0, lpDisplayBuf, "Error" + Chr$(0), MB_OK
    LocalFree lpMsgBuf
    LocalFree lpDisplayBuf
End Sub

And a screenshot of the output:
[ This attachment cannot be displayed inline in 'Print Page' view ]

Edit: For a bit of fun, increase the MAX_THREADS constant to a higher number. I've tried 20

Title: Re: Threading
Post by: SpriggsySpriggs on May 06, 2021, 11:31:06 pm

If you aren't already, please join the Discord. I would love to collaborate with you on more similar projects. It's been a long time since I've been this excited about API programming. Excited enough that I pulled out my work laptop and coded this one while laying in a hotel bed. I NEVER touch my work laptop when I'm at a hotel.

Title: Re: Threading
Post by: justsomeguy on May 07, 2021, 12:10:03 am

@SpriggsySpriggs Very impressive. I'm glad that I could get you fired up!

Have you tried bench-marking it? How's the stability? I'm surprised that the 'print' statement isn't core dumping on you.

Anyway, I am on discord, and I don't mind collaborating, but I think your programming skill is several orders magnitude greater than mine.

Title: Re: Threading
Post by: SpriggsySpriggs on May 07, 2021, 10:42:40 am

I had to edit my post above with the thread safe functions for printing. I was noticing small issues with launching and running. This should behave a bit better. You were correct about the printing causing an issue. So, this new printing is far safer (from what I can tell)

Text Only | Text with Attachments

QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: justsomeguy on May 03, 2021, 03:31:18 pm