diff --git a/kernel/libthr/thr_init.pas b/kernel/libthr/thr_init.pas
index 84faaa20..b248405d 100644
--- a/kernel/libthr/thr_init.pas
+++ b/kernel/libthr/thr_init.pas
@@ -91,55 +91,10 @@ var
init_once:Integer=0;
-procedure THR_LIST_ADD(thrd:p_pthread);
-procedure THR_LIST_REMOVE(thrd:p_pthread);
-procedure THR_GCLIST_ADD(thrd:p_pthread);
-procedure THR_GCLIST_REMOVE(thrd:p_pthread);
-
procedure _libpthread_init(curthread:p_pthread);
implementation
-procedure THR_LIST_ADD(thrd:p_pthread);
-begin
- if ((thrd^.tlflags and TLFLAGS_IN_TDLIST)=0) then
- begin
- TAILQ_INSERT_HEAD(@_thread_list,@thrd,@thrd^.tle);
- //_thr_hash_add(thrd);
- thrd^.tlflags:=thrd^.tlflags or TLFLAGS_IN_TDLIST;
- end;
-end;
-
-procedure THR_LIST_REMOVE(thrd:p_pthread);
-begin
- if (((thrd)^.tlflags and TLFLAGS_IN_TDLIST)<>0) then
- begin
- TAILQ_REMOVE(@_thread_list,@thrd,@thrd^.tle);
- //_thr_hash_remove(thrd);
- thrd^.tlflags:=thrd^.tlflags and (not TLFLAGS_IN_TDLIST);
- end;
-end;
-
-procedure THR_GCLIST_ADD(thrd:p_pthread);
-begin
- if ((thrd^.tlflags and TLFLAGS_IN_GCLIST)=0) then
- begin
- TAILQ_INSERT_HEAD(@_thread_gc_list,@thrd,@thrd^.gcle);
- thrd^.tlflags:=thrd^.tlflags or TLFLAGS_IN_GCLIST;
- Inc(_gc_count);
- end;
-end;
-
-procedure THR_GCLIST_REMOVE(thrd:p_pthread);
-begin
- if (((thrd)^.tlflags and TLFLAGS_IN_GCLIST)<>0) then
- begin
- TAILQ_REMOVE(@_thread_list,@thrd,@thrd^.gcle);
- thrd^.tlflags:=thrd^.tlflags and (not TLFLAGS_IN_GCLIST);
- Dec(_gc_count);
- end;
-end;
-
const
g_user_stacksize=$10000;
diff --git a/kernel/libthr/thr_private.pas b/kernel/libthr/thr_private.pas
index 1f890939..b85f8296 100644
--- a/kernel/libthr/thr_private.pas
+++ b/kernel/libthr/thr_private.pas
@@ -7,6 +7,7 @@ interface
uses
mqueue,
+ time,
signal,
_umtx;
@@ -115,6 +116,7 @@ type
child :TProcedure;
end;
+ p_pthread_attr=^pthread_attr;
pthread_attr=packed record
sched_policy :Integer;
sched_inherit :Integer;
@@ -289,14 +291,49 @@ type
sched_priority:Integer;
end;
-function TID(thr:p_pthread):Integer; inline;
+function TID(thr:p_pthread):Integer; inline;
-function SHOULD_CANCEL(thr:p_pthread):Boolean; inline;
-function THR_SHOULD_GC(thr:p_pthread):Boolean; inline;
-function THR_IN_CRITICAL(thr:p_pthread):Boolean; inline;
+function SHOULD_CANCEL(thr:p_pthread):Boolean; inline;
+function THR_SHOULD_GC(thr:p_pthread):Boolean; inline;
+function THR_IN_CRITICAL(thr:p_pthread):Boolean; inline;
+procedure THR_CRITICAL_ENTER(thr:p_pthread); inline;
+procedure THR_CRITICAL_LEAVE(thr:p_pthread); inline;
+
+function THR_UMUTEX_TRYLOCK(thr:p_pthread;lck:p_umutex):Integer; inline;
+function THR_UMUTEX_LOCK(thr:p_pthread;lck:p_umutex):Integer; inline;
+function THR_UMUTEX_TIMEDLOCK(thr:p_pthread;lck:p_umutex;timo:ptimespec):Integer; inline;
+function THR_UMUTEX_UNLOCK(thr:p_pthread;lck:p_umutex):Integer; inline;
+
+procedure THR_LOCK_ACQUIRE(thr:p_pthread;lck:p_umutex); inline;
+procedure THR_LOCK_ACQUIRE_SPIN(thr:p_pthread;lck:p_umutex); inline;
+procedure THR_ASSERT_LOCKLEVEL(thr:p_pthread); inline;
+procedure THR_LOCK_RELEASE(thr:p_pthread;lck:p_umutex); inline;
+
+procedure THR_LOCK(curthrd:p_pthread); inline;
+procedure THR_UNLOCK(curthrd:p_pthread); inline;
+procedure THR_THREAD_LOCK(curthrd,thr:p_pthread); inline;
+procedure THR_THREAD_UNLOCK(curthrd,thr:p_pthread); inline;
+
+procedure THREAD_LIST_RDLOCK(curthrd:p_pthread); inline;
+procedure THREAD_LIST_WRLOCK(curthrd:p_pthread); inline;
+procedure THREAD_LIST_UNLOCK(curthrd:p_pthread); inline;
+
+procedure THR_LIST_ADD(thrd:p_pthread);
+procedure THR_LIST_REMOVE(thrd:p_pthread);
+procedure THR_GCLIST_ADD(thrd:p_pthread);
+procedure THR_GCLIST_REMOVE(thrd:p_pthread);
+
+procedure THR_REF_ADD(curthrd,thrd:p_pthread); inline;
+procedure THR_REF_DEL(curthrd,thrd:p_pthread); inline;
+
+function GC_NEEDED:Boolean; inline;
implementation
+uses
+ thr_init,
+ thr_umtx;
+
function TID(thr:p_pthread):Integer; inline;
begin
Result:=thr^.tid;
@@ -322,5 +359,161 @@ begin
(thr^.critical_count>0);
end;
+procedure THR_CRITICAL_ENTER(thr:p_pthread); inline;
+begin
+ Inc(thr^.critical_count);
+end;
+
+procedure THR_CRITICAL_LEAVE(thr:p_pthread); inline;
+begin
+ Dec(thr^.critical_count);
+ //_thr_ast(thr);
+end;
+
+function THR_UMUTEX_TRYLOCK(thr:p_pthread;lck:p_umutex):Integer; inline;
+begin
+ Result:=_thr_umutex_trylock(lck,TID(thr));
+end;
+
+function THR_UMUTEX_LOCK(thr:p_pthread;lck:p_umutex):Integer; inline;
+begin
+ Result:=_thr_umutex_lock(lck,TID(thr));
+end;
+
+function THR_UMUTEX_TIMEDLOCK(thr:p_pthread;lck:p_umutex;timo:ptimespec):Integer; inline;
+begin
+ Result:=_thr_umutex_timedlock(lck,TID(thr),timo);
+end;
+
+function THR_UMUTEX_UNLOCK(thr:p_pthread;lck:p_umutex):Integer; inline;
+begin
+ Result:=_thr_umutex_unlock(lck,TID(thr));
+end;
+
+procedure THR_LOCK_ACQUIRE(thr:p_pthread;lck:p_umutex); inline;
+begin
+ Inc(thr^.locklevel);
+ _thr_umutex_lock(lck,TID(thr));
+end;
+
+procedure THR_LOCK_ACQUIRE_SPIN(thr:p_pthread;lck:p_umutex); inline;
+begin
+ Inc(thr^.locklevel);
+ _thr_umutex_lock_spin(lck,TID(thr));
+end;
+
+procedure THR_ASSERT_LOCKLEVEL(thr:p_pthread); inline;
+begin
+ if (thr^.locklevel<=0) then
+ begin
+ //_thr_assert_lock_level();
+ end;
+end;
+
+procedure THR_LOCK_RELEASE(thr:p_pthread;lck:p_umutex); inline;
+begin
+ THR_ASSERT_LOCKLEVEL(thr);
+ _thr_umutex_unlock(lck,TID(thr));
+ Dec(thr^.locklevel);
+ //_thr_ast(thr);
+end;
+
+procedure THR_LOCK(curthrd:p_pthread); inline;
+begin
+ THR_LOCK_ACQUIRE(curthrd,@curthrd^.lock);
+end;
+
+procedure THR_UNLOCK(curthrd:p_pthread); inline;
+begin
+ THR_LOCK_RELEASE(curthrd,@curthrd^.lock);
+end;
+
+procedure THR_THREAD_LOCK(curthrd,thr:p_pthread); inline;
+begin
+ THR_LOCK_ACQUIRE(curthrd,@thr^.lock);
+end;
+
+procedure THR_THREAD_UNLOCK(curthrd,thr:p_pthread); inline;
+begin
+ THR_LOCK_RELEASE(curthrd,@thr^.lock);
+end;
+
+procedure THREAD_LIST_RDLOCK(curthrd:p_pthread); inline;
+begin
+ Inc(curthrd^.locklevel);
+ _thr_rwl_rdlock(@_thr_list_lock);
+end;
+
+procedure THREAD_LIST_WRLOCK(curthrd:p_pthread); inline;
+begin
+ Inc(curthrd^.locklevel);
+ _thr_rwl_wrlock(@_thr_list_lock)
+end;
+
+procedure THREAD_LIST_UNLOCK(curthrd:p_pthread); inline;
+begin
+ _thr_rwl_unlock(@_thr_list_lock);
+ Dec(curthrd^.locklevel);
+ //_thr_ast(curthrd);
+end;
+
+procedure THR_LIST_ADD(thrd:p_pthread);
+begin
+ if ((thrd^.tlflags and TLFLAGS_IN_TDLIST)=0) then
+ begin
+ TAILQ_INSERT_HEAD(@_thread_list,@thrd,@thrd^.tle);
+ //_thr_hash_add(thrd);
+ thrd^.tlflags:=thrd^.tlflags or TLFLAGS_IN_TDLIST;
+ end;
+end;
+
+procedure THR_LIST_REMOVE(thrd:p_pthread);
+begin
+ if (((thrd)^.tlflags and TLFLAGS_IN_TDLIST)<>0) then
+ begin
+ TAILQ_REMOVE(@_thread_list,@thrd,@thrd^.tle);
+ //_thr_hash_remove(thrd);
+ thrd^.tlflags:=thrd^.tlflags and (not TLFLAGS_IN_TDLIST);
+ end;
+end;
+
+procedure THR_GCLIST_ADD(thrd:p_pthread);
+begin
+ if ((thrd^.tlflags and TLFLAGS_IN_GCLIST)=0) then
+ begin
+ TAILQ_INSERT_HEAD(@_thread_gc_list,@thrd,@thrd^.gcle);
+ thrd^.tlflags:=thrd^.tlflags or TLFLAGS_IN_GCLIST;
+ Inc(_gc_count);
+ end;
+end;
+
+procedure THR_GCLIST_REMOVE(thrd:p_pthread);
+begin
+ if (((thrd)^.tlflags and TLFLAGS_IN_GCLIST)<>0) then
+ begin
+ TAILQ_REMOVE(@_thread_list,@thrd,@thrd^.gcle);
+ thrd^.tlflags:=thrd^.tlflags and (not TLFLAGS_IN_GCLIST);
+ Dec(_gc_count);
+ end;
+end;
+
+procedure THR_REF_ADD(curthrd,thrd:p_pthread); inline;
+begin
+ THR_CRITICAL_ENTER(curthrd);
+ Inc(thrd^.refcount);
+end;
+
+procedure THR_REF_DEL(curthrd,thrd:p_pthread); inline;
+begin
+ Dec(thrd^.refcount);
+ THR_CRITICAL_LEAVE(curthrd);
+end;
+
+function GC_NEEDED:Boolean; inline;
+begin
+ Result:=(_gc_count>=5);
+end;
+
+
end.
diff --git a/kernel/libthr/thr_stack.pas b/kernel/libthr/thr_stack.pas
new file mode 100644
index 00000000..3919f4e3
--- /dev/null
+++ b/kernel/libthr/thr_stack.pas
@@ -0,0 +1,172 @@
+unit thr_stack;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ mqueue,
+ pthread_md,
+ thr_private,
+ thr_init;
+
+procedure _thr_stack_fix_protection(td:p_pthread);
+function _thr_stack_alloc(attr:p_pthread_attr):Integer;
+procedure _thr_stack_free(attr:p_pthread_attr);
+
+implementation
+
+type
+ //Spare thread stack.
+ p_stack=^t_stack;
+ t_stack=packed record
+ qe :LIST_ENTRY; //Stack queue linkage.
+ stacksize:QWORD; //Stack size (rounded up).
+ guardsize:QWORD; //Guard size.
+ stackaddr:Pointer; //Stack address.
+ end;
+
+var
+ dstackq :p_stack=nil;
+ mstackq :p_stack=nil;
+ last_stack:Pointer=nil;
+
+function round_up(size:QWORD):QWORD; inline;
+begin
+ if ((size mod _thr_page_size)<>0) then
+ begin
+ size:=((size div _thr_page_size)+1)*_thr_page_size;
+ end;
+ Result:=size;
+end;
+
+procedure _thr_stack_fix_protection(td:p_pthread);
+begin
+ //mprotect(td^.attr.stackaddr_attr+
+ // round_up(td^.attr.guardsize_attr),
+ // round_up(td^.attr.stacksize_attr),
+ // _rtld_get_stack_prot);
+end;
+
+function _thr_stack_alloc(attr:p_pthread_attr):Integer;
+var
+ curthread:p_pthread;
+ spare_stack,next:p_stack;
+ stacksize:QWORD;
+ guardsize:QWORD;
+ stackaddr:Pointer;
+ r:Integer;
+begin
+ curthread:=_get_curthread;
+
+ stacksize:=round_up(attr^.stacksize_attr);
+ guardsize:=round_up(attr^.guardsize_attr);
+
+ attr^.stackaddr_attr:=nil;
+ attr^.flags:=attr^.flags and (not THR_STACK_USER);
+
+ THREAD_LIST_WRLOCK(curthread);
+
+ if ((stacksize=THR_STACK_DEFAULT) and
+ (guardsize=_thr_guard_default)) then
+ begin
+ spare_stack:=LIST_FIRST(@dstackq);
+ if (spare_stack<>nil) then
+ begin
+ LIST_REMOVE(spare_stack,@spare_stack^.qe);
+ attr^.stackaddr_attr:=spare_stack^.stackaddr;
+ end;
+ end else
+ begin
+ spare_stack:=LIST_FIRST(@mstackq);
+ While (spare_stack<>nil) do
+ begin
+ next:=LIST_NEXT(spare_stack,@spare_stack^.qe);
+ if (spare_stack^.stacksize=stacksize) and
+ (spare_stack^.guardsize=guardsize) then
+ begin
+ LIST_REMOVE(spare_stack,@spare_stack^.qe);
+ attr^.stackaddr_attr:=spare_stack^.stackaddr;
+ break;
+ end;
+ spare_stack:=next;
+ end;
+ end;
+
+ if (attr^.stackaddr_attr<>nil) then
+ begin
+ THREAD_LIST_UNLOCK(curthread);
+ end else
+ begin
+ if (last_stack=nil) then
+ begin
+ last_stack:=_usrstack-_thr_stack_initial-_thr_guard_default;
+ end;
+
+ stackaddr:=last_stack-stacksize-guardsize;
+
+ last_stack:=last_stack-(stacksize+guardsize);
+
+ THREAD_LIST_UNLOCK(curthread);
+
+ //stackaddr:=mmap(stackaddr,
+ // stacksize+guardsize,
+ // _rtld_get_stack_prot,
+ // MAP_STACK,-1,0
+ // );
+
+ r:=0;
+ if (stackaddr<>Pointer(-1)) then //MAP_FAILED
+ begin
+ //r:=mprotect(stackaddr,guardsize,PROT_NONE);
+ end;
+
+ if (stackaddr<>Pointer(-1)) and //MAP_FAILED
+ ((guardsize=0) or (r=0)) then
+ begin
+ //sceKernelSetVirtualRangeName(addr,guardsize,'stack guard');
+ stackaddr:=stackaddr+guardsize;
+ end else
+ begin
+ if (stackaddr<>Pointer(-1)) then //MAP_FAILED
+ begin
+ //munmap(stackaddr,stacksize+guardsize);
+ end;
+ stackaddr:=nil;
+ end;
+ attr^.stackaddr_attr:=stackaddr;
+ end;
+
+ if (attr^.stackaddr_attr<>nil) then
+ Result:=0
+ else
+ Result:=-1;
+end;
+
+procedure _thr_stack_free(attr:p_pthread_attr);
+var
+ spare_stack:p_stack;
+begin
+ if (attr<>nil) and
+ ((attr^.flags and THR_STACK_USER)=0) and
+ (attr^.stackaddr_attr<>nil) then
+ begin
+ spare_stack:=attr^.stackaddr_attr+attr^.stacksize_attr-sizeof(t_stack);
+ spare_stack^.stacksize:=round_up(attr^.stacksize_attr);
+ spare_stack^.guardsize:=round_up(attr^.guardsize_attr);
+ spare_stack^.stackaddr:=attr^.stackaddr_attr;
+
+ if (spare_stack^.stacksize=THR_STACK_DEFAULT) and
+ (spare_stack^.guardsize=_thr_guard_default) then
+ begin
+ LIST_INSERT_HEAD(@dstackq,spare_stack,@spare_stack^.qe);
+ end else
+ begin
+ LIST_INSERT_HEAD(@mstackq,spare_stack,@spare_stack^.qe);
+ end;
+ attr^.stackaddr_attr:=nil;
+ end;
+end;
+
+end.
+
diff --git a/sys/test/project1.lpi b/sys/test/project1.lpi
index ef14eb13..4f975728 100644
--- a/sys/test/project1.lpi
+++ b/sys/test/project1.lpi
@@ -213,6 +213,10 @@
+
+
+
+
diff --git a/sys/test/project1.lpr b/sys/test/project1.lpr
index f45aa6be..498f4f78 100644
--- a/sys/test/project1.lpr
+++ b/sys/test/project1.lpr
@@ -31,8 +31,10 @@ uses
kern_id,
sys_osem,
kern_evf,
- sys_evf, rtprio,
- pthread;
+ sys_evf,
+ rtprio,
+ pthread,
+ thr_stack;
var
mtx:umutex;