+

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;

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;
 
 

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

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;
 

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.
+

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;
 

sys/test/project1.lpi

@@ -161,6 +161,10 @@
         <Filename Value="..\md_context.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="..\kern\subr_sleepqueue.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

sys/test/project1.lpr

@@ -23,7 +23,8 @@ uses
  pthread_md,
  sysutils,
  errno,
- md_context;
+ md_context,
+ subr_sleepqueue;
 
 var
  mtx:umutex;