fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2008-10-09 20:51 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/common.mak
  * harbour/source/rtl/Makefile
    + added thfuncx.prg

  * harbour/source/rtl/thfuncx.prg
    + added ThreadObject() function

  * harbour/source/rtl/tthreadx.prg
    + added xBase++ compatible TThread class.
      Special thanks to Pritpal Bedi for class skeleton with info about
      xbase++.
      Now only basic functionality is supported though it was enough to
      compile and execute examples Pritpal sent. I'm leaving rest for
      xBase++ users.
      BTW The examples suggest that in xbase++ DispOutAt() does not change
      cursor position. It's not Clipper compatible so I cannot make it
      in Harbour though I can add new function which will work in such way.
This commit is contained in:
Przemyslaw Czerpak
2008-10-09 18:51:31 +00:00
parent c7c37159d0
commit af1e261b5b
5 changed files with 190 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
harbour/ChangeLog
View File

@@ -8,6 +8,25 @@
2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org)
*/
2008-10-09 20:51 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/common.mak
* harbour/source/rtl/Makefile
+ added thfuncx.prg
* harbour/source/rtl/thfuncx.prg
+ added ThreadObject() function
* harbour/source/rtl/tthreadx.prg
+ added xBase++ compatible TThread class.
Special thanks to Pritpal Bedi for class skeleton with info about
xbase++.
Now only basic functionality is supported though it was enough to
compile and execute examples Pritpal sent. I'm leaving rest for
xBase++ users.
BTW The examples suggest that in xbase++ DispOutAt() does not change
cursor position. It's not Clipper compatible so I cannot make it
in Harbour though I can add new function which will work in such way.
2008-10-09 10:48 UTC-0800 Pritpal Bedi (pritpal@vouchcac.com)
! harbour/bin/bld.bat
+ _C_MT= if not HB_MT==MT

1
harbour/common.mak
View File

@@ -646,6 +646,7 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\tget$(OBJEXT) \
$(OBJ_DIR)\tgetint$(OBJEXT) \
$(OBJ_DIR)\tgetlist$(OBJEXT) \
$(OBJ_DIR)\thfuncx$(OBJEXT) \
$(OBJ_DIR)\tlabel$(OBJEXT) \
$(OBJ_DIR)\tmenuitm$(OBJEXT) \
$(OBJ_DIR)\tmenusys$(OBJEXT) \

1
harbour/source/rtl/Makefile
View File

@@ -207,6 +207,7 @@ PRG_SOURCES=\
tget.prg \
tgetint.prg \
tgetlist.prg \
thfuncx.prg \
tlabel.prg \
tmenuitm.prg \
tmenusys.prg \

12
harbour/source/rtl/thfuncx.prg
View File

@@ -58,6 +58,14 @@ FUNCTION ThreadID()
RETURN hb_threadId()
FUNCTION ThreadObject( oThread )
THREAD STATIC s_oThread
IF PCount() > 0
s_oThread := oThread
ENDIF
RETURN s_oThread
FUNCTION ThreadWait( aThreads, nTimeOut )
LOCAL xResult, nPos, apThIDs, th
@@ -70,7 +78,7 @@ FUNCTION ThreadWait( aThreads, nTimeOut )
ENDIF
NEXT
nPos := hb_threadWait( apThIDs, iif( ISNUMBER( nTimeOut ), nTimeOut / 1000, ) )
nPos := hb_threadWait( apThIDs, iif( ISNUMBER( nTimeOut ), nTimeOut / 100, ) )
IF nPos != 0
xResult := aThreads[ nPos ]
ENDIF
@@ -90,7 +98,7 @@ FUNCTION ThreadWaitAll( aThreads, nTimeOut )
ENDIF
NEXT
RETURN hb_threadWait( apThIDs, iif( ISNUMBER( nTimeOut ), nTimeOut / 1000, ), ;
RETURN hb_threadWait( apThIDs, iif( ISNUMBER( nTimeOut ), nTimeOut / 100, ), ;
.T. ) == Len( apThIDs )
/* TODO: ThreadInfo() */

161
harbour/source/rtl/tthreadx.prg
View File

@@ -8,6 +8,9 @@
*
* Copyright 2008 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://www.harbour-project.org
* special thanks for Pritpal Bedi for class skeleton with info about
* xbase++ and to other contributors which I hope will finish and fix
* this code
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -55,12 +58,20 @@
#ifdef HB_COMPAT_XPP
/* I do not know xBase++ values */
#define QUIT_NORESTART 1
#define QUIT_RESTART 2
/*
* SIGNAL class
*/
CREATE CLASS TSignal FUNCTION Signal
VAR cargo AS USUAL EXPORTED
VAR mutex AS USUAL PROTECTED
EXPORTED:
EXPORTED:
METHOD new()
METHOD wait( nTimeOut )
@@ -68,8 +79,9 @@ CREATE CLASS TSignal FUNCTION Signal
ENDCLASS
METHOD new() CLASS TSIGNAL
METHOD new( ... ) CLASS TSIGNAL
::mutex := hb_mutexCreate()
::Init( ... )
RETURN Self
METHOD wait( nTimeOut ) CLASS TSIGNAL
@@ -84,4 +96,149 @@ METHOD signal() CLASS TSIGNAL
hb_mutexNotify( ::mutex )
RETURN Self
/*
* THREAD class
*/
CREATE CLASS TThread FUNCTION Thread
EXPORTED:
VAR cargo AS USUAL SYNC
VAR active AS LOGICAL READONLY INIT .f.
VAR deltaTime AS NUMERIC READONLY INIT 0
VAR interval AS USUAL READONLY INIT NIL
VAR priority AS NUMERIC READONLY INIT 0
VAR startCount AS NUMERIC READONLY INIT 0
VAR startTime AS USUAL READONLY INIT NIL
VAR atEnd AS USUAL INIT NIL SYNC
VAR atStart AS USUAL INIT NIL SYNC
VAR result AS USUAL INIT NIL SYNC
PROTECTED:
VAR maxStackSize AS USUAL INIT 50000
HIDDEN:
VAR pThreadID AS USUAL INIT NIL SYNC
EXPORTED:
METHOD new( nMaxStackSize )
PROTECTED:
/* METHOD atEnd() */
/* METHOD atStart() */
METHOD execute()
EXPORTED:
METHOD quit( xResult, nRestart ) SYNC
METHOD setInterval( nHSeconds )
METHOD setPriority( nPriority )
METHOD setStartTime( nSeconds )
METHOD start() SYNC
METHOD synchronize( nTimeOut )
METHOD threadSelf()
METHOD threadID()
METHOD thread INLINE ::TThread()
ENDCLASS
METHOD new( nMaxStackSize ) CLASS TTHREAD
::maxStackSize := nMaxStackSize
::Init()
RETURN Self
METHOD execute() CLASS TTHREAD
HB_SYMBOL_UNUSED( Self )
RETURN NIL
METHOD quit( xResult, nRestart ) CLASS TTHREAD
IF hb_threadSelf() == ::pThreadID
IF ISNUMBER( nRestart )
IF nRestart == QUIT_NORESTART
::interval := NIL
ELSEIF nRestart == QUIT_RESTART
IF ISNUMBER( ::interval )
/* TODO: do not interrupt by QUIT but restart execution */
ENDIF
ENDIF
ENDIF
IF PCOUNT() > 0
::result := xResult
ENDIF
QUIT
ENDIF
RETURN NIL
METHOD setInterval( nHSeconds ) CLASS TTHREAD
IF ISNUMBER( nHSeconds )
::interval := nHSeconds
ENDIF
RETURN .F.
METHOD setPriority( nPriority ) CLASS TTHREAD
/* TODO: add thread priority setting */
IF ISNUMBER( nPriority )
::priority := nPriority
ENDIF
RETURN .F.
METHOD setStartTime( nSeconds ) CLASS TTHREAD
/* TODO: add such functionality, probably by special thread */
IF ISNUMBER( nSeconds )
::startTime := nSeconds
ELSEIF nSeconds == NIL
::startTime := NIL
ENDIF
RETURN .F.
METHOD start( xAction, ... ) CLASS TTHREAD
/* TODO: thread stack size set by user ::maxStackSize */
IF ::active
RETURN .F.
ELSEIF xAction == NIL
::active := .T.
::pThreadID := hb_threadStart( { |...|
::startTime := Seconds()
ThreadObject( Self )
::result := ::execute( ... )
RETURN NIL
}, ... )
ELSEIF !Empty( xAction ) .AND. ValType( xAction ) $ "CBP"
::active := .T.
::pThreadID := hb_threadStart( { |...|
::startTime := Seconds()
ThreadObject( Self )
IF ::atStart != NIL
EVAL( ::atStart, ... )
ENDIF
::result := DO( xAction, ... )
IF ::atEnd != NIL
EVAL( ::atEnd, ... )
ENDIF
::startTime := NIL
RETURN NIL
}, ... )
ELSE
RETURN .F.
ENDIF
RETURN .T.
METHOD synchronize( nTimeOut ) CLASS TTHREAD
LOCAL pThreadID := ::pThreadID
IF hb_threadSelf() != pThreadID
RETURN hb_threadWait( pThreadID, ;
iif( ISNUMBER( nTimeOut ), nTimeOut / 100, ) )
ENDIF
RETURN .F.
METHOD threadSelf() CLASS TTHREAD
RETURN ::pThreadID
METHOD threadID() CLASS TTHREAD
LOCAL pThreadID := ::pThreadID
RETURN IIF( pThreadID == NIL, 0, hb_threadID( pThreadID ) )
#endif