diff --git a/rtl/gtailq.pas b/rtl/gtailq.pas index 5b8439de..a71d0a07 100644 --- a/rtl/gtailq.pas +++ b/rtl/gtailq.pas @@ -33,6 +33,11 @@ procedure TAILQ_INSERT_HEAD(head,elm,field:Pointer); inline; procedure TAILQ_INSERT_TAIL(head,elm,field:Pointer); inline; procedure TAILQ_REMOVE (head,elm,field:Pointer); inline; +procedure LIST_INIT (head:Pointer); inline; +function LIST_EMPTY (head:Pointer):Boolean; inline; +function LIST_FIRST (head:Pointer):Pointer; inline; +function LIST_NEXT (elm,field:Pointer):Pointer; inline; + implementation type @@ -69,6 +74,30 @@ begin Result:=p_tq_entry(field)^.pNext; end; +// + +procedure LIST_INIT(head:Pointer); inline; +begin + PPointer(head)^:=nil; +end; + +function LIST_EMPTY(head:Pointer):Boolean; inline; +begin + Result:=PPointer(head)^=nil; +end; + +function LIST_FIRST(head:Pointer):Pointer; inline; +begin + Result:=PPointer(head)^; +end; + +function LIST_NEXT(elm,field:Pointer):Pointer; inline; +begin + Result:=PPointer(field)^; +end; + +// + procedure TAILQ_INSERT_HEAD(head,elm,field:Pointer); inline; var offset:ptruint; diff --git a/sys/kern/kern_mtx.pas b/sys/kern/kern_mtx.pas index 6636a368..26dc2542 100644 --- a/sys/kern/kern_mtx.pas +++ b/sys/kern/kern_mtx.pas @@ -5,39 +5,34 @@ unit kern_mtx; interface -uses - windows, - ntapi; +type + mtx=TRTLCriticalSection; -function mtx_init(m:PPointer):Integer; -function mtx_destroy(m:PPointer):Integer; -function mtx_lock(m:PPointer):Integer; -function mtx_unlock(m:PPointer):Integer; +procedure mtx_init(var m:mtx); +procedure mtx_destroy(var m:mtx); +procedure mtx_lock(var m:mtx); +procedure mtx_unlock(var m:mtx); implementation -function mtx_init(m:PPointer):Integer; +procedure mtx_init(var m:mtx); inline; begin - Result:=NtCreateMutant( - PHandle(m), - MUTANT_ALL_ACCESS, - nil, - False); + InitCriticalSection(m); end; -function mtx_destroy(m:PPointer):Integer; +procedure mtx_destroy(var m:mtx); inline; begin - Result:=NtClose(THandle(m^)); + DoneCriticalSection(m); end; -function mtx_lock(m:PPointer):Integer; +procedure mtx_lock(var m:mtx); inline; begin - Result:=NtWaitForSingleObject(THandle(m^),False,nil); + EnterCriticalSection(m); end; -function mtx_unlock(m:PPointer):Integer; +procedure mtx_unlock(var m:mtx); inline; begin - Result:=NtReleaseMutant(THandle(m^),nil); + LeaveCriticalSection(m); end; diff --git a/sys/kern/kern_sig.pas b/sys/kern/kern_sig.pas index 622f9e18..fa4aa723 100644 --- a/sys/kern/kern_sig.pas +++ b/sys/kern/kern_sig.pas @@ -92,8 +92,8 @@ Function kern_sigprocmask(td:p_kthread; procedure ast; -function ps_mtx_lock:Integer; -function ps_mtx_unlock:Integer; +procedure ps_mtx_lock; +procedure ps_mtx_unlock; implementation @@ -104,8 +104,7 @@ uses kern_mtx, kern_time, vm_machdep, - machdep, - trap; + machdep; const max_pending_per_proc=128; @@ -491,14 +490,14 @@ begin end; end; -function ps_mtx_lock:Integer; +procedure ps_mtx_lock; inline; begin - Result:=mtx_lock(@p_sigacts.ps_mtx); + mtx_lock(p_sigacts.ps_mtx); end; -function ps_mtx_unlock:Integer; +procedure ps_mtx_unlock; inline; begin - Result:=mtx_unlock(@p_sigacts.ps_mtx); + mtx_unlock(p_sigacts.ps_mtx); end; Function kern_sigaction(sig:Integer; @@ -644,7 +643,7 @@ procedure siginit; var i:Integer; begin - mtx_init(@p_sigacts.ps_mtx); + mtx_init(p_sigacts.ps_mtx); For i:=1 to NSIG do begin diff --git a/sys/kern/kern_thread.pas b/sys/kern/kern_thread.pas index a5f48cda..524ba0b2 100644 --- a/sys/kern/kern_thread.pas +++ b/sys/kern/kern_thread.pas @@ -210,7 +210,7 @@ function curkthread:p_kthread; procedure set_curkthread(td:p_kthread); function SIGPENDING(td:p_kthread):Boolean; -function TD_IS_RUNNING(td:p_kthread):Boolean; inline; +function TD_IS_RUNNING(td:p_kthread):Boolean; procedure PROC_LOCK; procedure PROC_UNLOCK; @@ -248,7 +248,7 @@ uses kern_sig; var - p_mtx:Pointer=nil; + p_mtx:mtx; tidhashtbl:TSTUB_HAMT32; tidhash_lock:Pointer=nil; @@ -274,24 +274,24 @@ begin sigsetmasked(@td^.td_sigqueue.sq_signals,@td^.td_sigmask); end; -function TD_IS_RUNNING(td:p_kthread):Boolean; inline; +function TD_IS_RUNNING(td:p_kthread):Boolean; begin Result:=td^.td_state=TDS_RUNNING end; procedure PROC_LOCK; begin - mtx_lock(@p_mtx); + mtx_lock(p_mtx); end; procedure PROC_UNLOCK; begin - mtx_unlock(@p_mtx); + mtx_unlock(p_mtx); end; procedure threadinit; inline; begin - mtx_init(@p_mtx); + mtx_init(p_mtx); FillChar(tidhashtbl,SizeOf(tidhashtbl),0); end; diff --git a/sys/kern/subr_sleepqueue.pas b/sys/kern/subr_sleepqueue.pas new file mode 100644 index 00000000..b7d5bd37 --- /dev/null +++ b/sys/kern/subr_sleepqueue.pas @@ -0,0 +1,117 @@ +unit subr_sleepqueue; + +{$mode ObjFPC}{$H+} +{$CALLING SysV_ABI_CDecl} + +interface + +uses + gtailq, + hamt, + kern_mtx; + +const + SLEEPQ_TYPE =$ff; // Mask of sleep queue types. + SLEEPQ_SLEEP =$00; // Used by sleep/wakeup. + SLEEPQ_CONDVAR =$01; // Used for a cv. + SLEEPQ_PAUSE =$02; // Used by pause. + SLEEPQ_SX =$03; // Used by an sx lock. + SLEEPQ_LK =$04; // Used by a lockmgr. + SLEEPQ_INTERRUPTIBLE=$100; // Sleep is interruptible. + SLEEPQ_STOP_ON_BDRY =$200; // Stop sleeping thread + + SC_TABLESIZE=128; + SC_MASK =(SC_TABLESIZE-1); + SC_SHIFT =8; + + NR_SLEEPQS=2; + +type + kthread_list=packed record + pFirst:Pointer; + pLast :PPointer; + end; + + p_sleepqueue=^sleepqueue; + sleepqueue=packed record + sq_blocked :array[0..NR_SLEEPQS-1] of kthread_list; + sq_blockedcnt:array[0..NR_SLEEPQS-1] of DWORD; + sq_hash :TSTUB_HAMT64; + sq_free :p_sleepqueue; + sq_wchan :Pointer; + sq_type :Integer; + end; + + p_sleepqueue_chain=^sleepqueue_chain; + sleepqueue_chain=packed record + sc_queues:p_sleepqueue; + sc_lock :mtx; + end; + +function sleepq_alloc:p_sleepqueue; inline; +procedure sleepq_free(sq:p_sleepqueue); inline; +procedure sleepq_lock(wchan:Pointer); +procedure sleepq_release(wchan:Pointer); + +implementation + +uses + kern_thread; + +var + sleepq_chains:array[0..SC_MASK] of sleepqueue_chain; + +procedure init_sleepqueues; +var + i:Integer; +begin + For i:=0 to SC_MASK do + begin + LIST_INIT(@sleepq_chains[i].sc_queues); + mtx_init ( sleepq_chains[i].sc_lock); + end; +end; + +function sleepq_alloc:p_sleepqueue; inline; +begin + Result:=AllocMem(SizeOf(sleepqueue)); +end; + +procedure sleepq_free(sq:p_sleepqueue); inline; +begin + FreeMem(sq); +end; + +function SC_HASH(wc:Pointer):DWORD; inline; +begin + Result:=(ptruint(wc) shr SC_SHIFT) and SC_MASK; +end; + +function SC_LOOKUP(wc:Pointer):p_sleepqueue_chain; inline; +begin + Result:=@sleepq_chains[SC_HASH(wc)]; +end; + +procedure sleepq_lock(wchan:Pointer); +var + sc:p_sleepqueue_chain; +begin + sc:=SC_LOOKUP(wchan); + mtx_lock(sc^.sc_lock); +end; + +procedure sleepq_release(wchan:Pointer); +var + sc:p_sleepqueue_chain; +begin + sc:=SC_LOOKUP(wchan); + mtx_unlock(sc^.sc_lock); +end; + + + +initialization + init_sleepqueues; + +end. + diff --git a/sys/signalvar.pas b/sys/signalvar.pas index 0665cb1b..97085b91 100644 --- a/sys/signalvar.pas +++ b/sys/signalvar.pas @@ -5,7 +5,7 @@ unit signalvar; interface uses - _umtx, + kern_mtx, signal; type @@ -19,7 +19,7 @@ type ps_siginfo :sigset_t; ps_sigignore :sigset_t; ps_sigcatch :sigset_t; - ps_mtx :umtx; + ps_mtx :mtx; ps_flag :Integer; end; diff --git a/sys/test/project1.lpi b/sys/test/project1.lpi index 3948f298..af7ffe63 100644 --- a/sys/test/project1.lpi +++ b/sys/test/project1.lpi @@ -161,6 +161,10 @@ + + + + diff --git a/sys/test/project1.lpr b/sys/test/project1.lpr index e0f44a58..14748d6f 100644 --- a/sys/test/project1.lpr +++ b/sys/test/project1.lpr @@ -23,7 +23,8 @@ uses pthread_md, sysutils, errno, - md_context; + md_context, + subr_sleepqueue; var mtx:umutex;