• Print

Author Topic: playing with a 2nd thread in QB64  (Read 861 times)

mcalkins

  • Hero Member
  • *****
  • Posts: 1409
    • qbasicmichael.com
    • Email
playing with a 2nd thread in QB64
« on: April 01, 2012, 02:53:34 pm »
mainly for fun at the moment.

thread.h
Code: [Select]
#include <process.h>

uint32 FUNC_ASYNC(ptrszint*);

unsigned int __stdcall threadentry(void * arglist){
 return FUNC_ASYNC((ptrszint *) & arglist);
 /* call to _endthreadex is implicit */
}

uintptr_t newThread(void * arglist, unsigned int * thrdaddr){
 return _beginthreadex(0, 0, & threadentry, arglist, 0, thrdaddr);
 /* the caller will need to call CloseHandle */
}

Code: [Select]
CONST WAIT_ABANDONED = &H00000080&
CONST WAIT_OBJECT_0 = 0&
CONST WAIT_TIMEOUT = &H00000102&
CONST WAIT_FAILED = -1&

DECLARE CUSTOMTYPE LIBRARY 'CRT
 FUNCTION get_errno& ALIAS _get_errno (BYVAL pValue%&)
END DECLARE

DECLARE DYNAMIC LIBRARY "kernel32"
 FUNCTION CloseHandle& (BYVAL hObject%&)
 FUNCTION GetLastError~& ()
 FUNCTION GetExitCodeThread& (BYVAL hThread%&, BYVAL lpExitCode%&)
 FUNCTION GetCurrentThreadId~& ()

 'these Wait functions are not suitable for use within threads that create
 'windows. You would need to use the MsgWait functions instead.

 FUNCTION WaitForSingleObject~& (BYVAL hHandle%&, BYVAL dwMilliseconds~&)
 FUNCTION WaitForMultipleObjects~& (BYVAL nCount~&, BYVAL lpHandles~&, BYVAL bWaitAll&, BYVAL dwMilliseconds~&)

 'note: the Interlocked functions are __cdecl. QB64 will leak stack when
 'calling them. Wrap them in QB64 functions to reclaim the leaked stack.

 FUNCTION InterlockedExchange& (BYVAL Target%&, BYVAL Value&)
 FUNCTION InterlockedCompareExchange& (BYVAL Destination%&, BYVAL Exchange&, BYVAL Comparand&)
 FUNCTION InterlockedDecrement& (BYVAL Addend%&)
 FUNCTION InterlockedIncrement& (BYVAL Addend%&)
END DECLARE

DECLARE CUSTOMTYPE LIBRARY "thread"
 FUNCTION newThread%& (BYVAL arglist%&, BYVAL thrdaddr%&)
END DECLARE

DIM hThread AS _OFFSET
DIM arg AS LONG
DIM TID AS _UNSIGNED LONG
DIM errno AS LONG
DIM errerr AS LONG
DIM result AS _UNSIGNED LONG

arg = -1

hThread = newThread(_OFFSET(arg), _OFFSET(TID))
IF 0 = hThread THEN
 errerr = get_errno(_OFFSET(errno))
 IF errerr THEN
  PRINT "_beginthreadex failed, and so did get_errno. Error: 0x" + hexd(errerr)
 ELSE
  PRINT "_beginthreadex failed. Error: 0x" + hexd(errno)
 END IF
 END
END IF

PRINT "hThread: 0x" + hexp(hThread)
PRINT "Thread ID: 0x" + hexd(TID), "decimal: "; TID

DO UNTIL LEN(INKEY$)
 PRINT "looping in main thread."
 _DELAY 3
LOOP
PRINT "Telling the thread to return..."
result = Exchange(_OFFSET(arg), 0)

SELECT CASE WaitForSingleObject(hThread, 5000)
 CASE WAIT_FAILED: PRINT "WaitForSingleObject failed. Error: 0x" + hexd(GetLastError)
 CASE WAIT_TIMEOUT: PRINT "The thread didn't return within 5 seconds."
 CASE WAIT_OBJECT_0
  IF 0 = GetExitCodeThread(hThread, _OFFSET(result)) THEN
   PRINT "GetExitCodeThread failed. Error: 0x" + hexd(GetLastError)
  END IF
  PRINT "Exit code: 0x" + hexd(result)
  IF 0 = CloseHandle(hThread) THEN
   PRINT "CloseHandle failed. Error: 0x" + hexd(GetLastError)
  END IF
END SELECT

END

FUNCTION Async~& (arglist AS _OFFSET)
DIM TID AS _UNSIGNED LONG
TID = GetCurrentThreadId
DO WHILE CompareExchange(arglist, 0, 0)
 PRINT "looping inside thread 0x" + hexd(TID)
 _DELAY 2
LOOP
Async = &H12345
END FUNCTION

FUNCTION Exchange& (Target AS _OFFSET, Value AS LONG)
Exchange = InterlockedExchange(Target, Value)
END FUNCTION

FUNCTION CompareExchange& (Destination AS _OFFSET, E AS LONG, Comparand AS LONG)
CompareExchange = InterlockedCompareExchange(Destination, E, Comparand)
END FUNCTION

FUNCTION Decrement& (Addend AS _OFFSET)
Decrement = InterlockedDecrement(Addend)
END FUNCTION

FUNCTION Increment& (Addend AS _OFFSET)
Increment = InterlockedIncrement(Addend)
END FUNCTION

'$include:'hexx.bi'
(code is public domain. I forgot to put the comments. It's obviously only experimental right now.)

The code also requires my hexx.bi, unless you replace the function calls with hex$().

I'm going to say that the PRINT statement doesn't seem to be re-entrant. The above program tends to crash with access violations. So far, they have been in:

qbs_free(qbs*) called by FUNC_ASYNC(int*)
msvcrt!memcpy called by qbs_set(qbs*, qbs*) called by QBMAIN(void*)
qbs_free(qbs*) called by QBMAIN(void*)

(Information obtained by comparing the Dr. Watson log with the map file from ld.)

I would think it would be possible to write multithreaded QB64 code even now, to the extent that you avoid non-re-entrant parts of the QB64 runtime library. I hope that QB64's runtime library is eventually made into a thread-safe re-entrant DLL.

Regards,
Michael
The QBASIC Forum Community: http://www.network54.com/index/10167 Includes off-topic subforums.
QB64 Off-topic subforum: http://qb64offtopic.freeforums.org/

mcalkins

  • Hero Member
  • *****
  • Posts: 1409
    • qbasicmichael.com
    • Email
Re: playing with a 2nd thread in QB64
« Reply #1 on: April 01, 2012, 04:08:03 pm »
I'm thinking that the trouble is related to the way QB64 uses temporary strings and memory allocation.

I think lines like this illustrate the problem:

uint32 qbs_tmp_base=qbs_tmp_list_nexti;
uint8 *tmp_mem_static_pointer=mem_static_pointer;
uint32 tmp_cmem_sp=cmem_sp;

I think the qbs_tmp_list_nexti is related to a shared index of temporary string descriptors. With both QBMAIN, and functions called by it, and FUNC_ASYNC and functions called by it allocating and freeing temporary strings, they will be conflicting, I think. I don't know what is the ideal solution to this problem.

Regards,
Michael
The QBASIC Forum Community: http://www.network54.com/index/10167 Includes off-topic subforums.
QB64 Off-topic subforum: http://qb64offtopic.freeforums.org/

LeChuck

  • Hero Member
  • *****
  • Posts: 1055
  • 18 * 37
Re: playing with a 2nd thread in QB64
« Reply #2 on: April 07, 2012, 08:46:34 am »
GL mcalkins,

It's nice to see that someone is looking into this, it would be a big + to QB64. Even if only supported to a lesser degree.
Dyspraxious

mcalkins

  • Hero Member
  • *****
  • Posts: 1409
    • qbasicmichael.com
    • Email
Re: playing with a 2nd thread in QB64
« Reply #3 on: April 15, 2012, 07:49:26 pm »
Thread Local Storage experiment in C++ (No QB64 code, but TLS might be relevant to future multi-threading in QB64):

http://www.network54.com/Forum/613583/message/1334543352/

Regards,
Michael
The QBASIC Forum Community: http://www.network54.com/index/10167 Includes off-topic subforums.
QB64 Off-topic subforum: http://qb64offtopic.freeforums.org/

  • Print