unit kern_thread;

{$mode ObjFPC}{$H+}
{$CALLING SysV_ABI_CDecl}

interface

uses
 sysutils,
 mqueue,
 kern_thr,
 ucontext,
 signal,
 signalvar,
 time,
 rtprio,
 kern_rtprio,
 hamt;

type
 p_kthread_iterator=^kthread_iterator;
 kthread_iterator=THAMT_Iterator32;

procedure thread_reap();

function  thread_alloc:p_kthread;
procedure thread_free(td:p_kthread);

function  sys_thr_new     (_param:Pointer;_size:Integer):Integer;
function  sys_thr_create  (ctx:Pointer;id:PDWORD;flags:Integer):Integer;
function  sys_thr_self    (id:PDWORD):Integer;
procedure sys_thr_exit    (state:PQWORD);
function  sys_thr_kill    (id,sig:Integer):Integer;
function  sys_thr_kill2   (pid,id,sig:Integer):Integer;
function  sys_thr_suspend (timeout:Pointer):Integer;
function  sys_thr_wake    (id:DWORD):Integer;
function  sys_thr_set_name(id:DWORD;pname:PChar):Integer;
function  sys_thr_get_name(id:DWORD;pname:PChar):Integer;

function  sys_amd64_set_fsbase(base:Pointer):Integer;
function  sys_amd64_get_fsbase(base:PPointer):Integer;
function  sys_amd64_set_gsbase(base:Pointer):Integer;
function  sys_amd64_get_gsbase(base:PPointer):Integer;

procedure thread_inc_ref(td:p_kthread);
procedure thread_dec_ref(td:p_kthread);
procedure thread_lock   (td:p_kthread);
procedure thread_unlock (td:p_kthread);
function  tdfind(tid:DWORD):p_kthread;

function  FOREACH_THREAD_START (i:p_kthread_iterator):Boolean;
procedure FOREACH_THREAD_FINISH();
function  THREAD_NEXT(i:p_kthread_iterator):Boolean;
function  THREAD_GET (i:p_kthread_iterator):p_kthread;

function  SIGPENDING(td:p_kthread):Boolean;

procedure threadinit; //SYSINIT

function  kthread_add (func,arg:Pointer;newtdp:pp_kthread;name:PChar):Integer;
procedure kthread_exit();

implementation

uses
 errno,
 systm,
 md_sleep,
 md_context,
 machdep,
 md_proc,
 md_thread,
 kern_rwlock,
 kern_umtx,
 kern_sig,
 kern_synch,
 sched_ule,
 subr_sleepqueue;

var
 tidhashtbl:TSTUB_HAMT32;
 tidhash_lock:Pointer=nil;

 zombie_threads:TAILQ_HEAD=(tqh_first:nil;tqh_last:@zombie_threads.tqh_first);
 zombie_lock:Pointer=nil;

 p_numthreads:Integer=0;

const
 max_threads_per_proc=1500;

function SIGPENDING(td:p_kthread):Boolean;
begin
 Result:=SIGNOTEMPTY(@td^.td_sigqueue.sq_signals) and
         sigsetmasked(@td^.td_sigqueue.sq_signals,@td^.td_sigmask);
end;

//

function _thread_null(parameter:pointer):ptrint; register;
begin
 Result:=0;
end;

procedure threadinit;
begin
 FillChar(tidhashtbl,SizeOf(tidhashtbl),0);
 //init internals
 BeginThread(@_thread_null);
end;

{
 * Place an unused thread on the zombie list.
 * Use the slpq as that must be unused by now.
 }
procedure thread_zombie(td:p_kthread);
begin
 rw_wlock(zombie_lock);
 TAILQ_INSERT_HEAD(@zombie_threads,td,@td^.td_slpq);
 rw_wunlock(zombie_lock);
end;

{
 * Reap zombie resources.
 }
procedure thread_reap();
var
 td_first,td_next:p_kthread;
begin
 if rw_try_wlock(zombie_lock) then
 begin
  if (not TAILQ_EMPTY(@zombie_threads)) then
  begin
   td_first:=TAILQ_FIRST(@zombie_threads);

   while (td_first<>nil) do
   begin
    td_next:=TAILQ_NEXT(td_first,@td_first^.td_slpq);

    if cpu_thread_finished(td_first) then
    begin
     TAILQ_REMOVE(@zombie_threads,@td_first,@td_first^.td_slpq);
     thread_free(td_first);
    end else
    begin
     Break;
    end;

    td_first:=td_next;
   end;
  end;

  rw_wunlock(zombie_lock);
 end;
end;

function thread_alloc:p_kthread;
begin
 thread_reap();

 Result:=cpu_thread_alloc();

 Result^.td_state:=TDS_INACTIVE;
 Result^.td_lend_user_pri:=PRI_MAX;

 Result^.td_sleepqueue:=sleepq_alloc();
 umtx_thread_init(Result);
end;

procedure thread_free(td:p_kthread);

begin
 sleepq_free(td^.td_sleepqueue);
 umtx_thread_fini(td);
 cpu_thread_free(td);
end;

procedure thread_inc_ref(td:p_kthread);
begin
 System.InterlockedIncrement(td^.td_ref);
end;

procedure thread_dec_ref(td:p_kthread);
begin
 if (System.InterlockedDecrement(td^.td_ref)=0) then
 begin
  thread_zombie(td);
 end;
end;

procedure thread_lock(td:p_kthread);
begin
 rw_wlock(td^.td_lock);
end;

procedure thread_unlock(td:p_kthread);
begin
 rw_wunlock(td^.td_lock);
end;

procedure thread_link(td:p_kthread);
begin
 td^.td_state:=TDS_INACTIVE;
 td^.td_flags:=TDF_INMEM;

 sigqueue_init(@td^.td_sigqueue);

 System.InterlockedIncrement(p_numthreads);
end;

procedure thread_unlink(td:p_kthread);
begin
 System.InterlockedDecrement(p_numthreads)
end;

function tdfind(tid:DWORD):p_kthread;
Var
 data:PPointer;
begin
 Result:=nil;
 rw_rlock(tidhash_lock);

 data:=HAMT_search32(@tidhashtbl,tid);

 if (data<>nil) then
 begin
  Result:=data^;
 end;

 if (Result<>nil) then
 begin
  thread_inc_ref(Result);
 end;

 rw_runlock(tidhash_lock);
end;

procedure tidhash_add(td:p_kthread);
var
 data:PPointer;
begin
 rw_wlock(tidhash_lock);

 data:=HAMT_insert32(@tidhashtbl,td^.td_tid,td);

 if (data<>nil) then
 begin
  if (data^=td) then
  begin
   thread_inc_ref(td);
  end;
 end;

 rw_wunlock(tidhash_lock);
end;

procedure tidhash_remove(td:p_kthread);
var
 data:Pointer;
begin
 data:=nil;
 rw_wlock(tidhash_lock);

 HAMT_delete32(@tidhashtbl,td^.td_tid,@data);

 rw_wunlock(tidhash_lock);

 if (data=td) then
 begin
  thread_dec_ref(td);
 end;
end;

function FOREACH_THREAD_START(i:p_kthread_iterator):Boolean;
begin
 rw_rlock(tidhash_lock);

 Result:=HAMT_first32(@tidhashtbl,i);

 if not Result then //space
 begin
  rw_runlock(tidhash_lock);
 end;
end;

procedure FOREACH_THREAD_FINISH();
begin
 rw_runlock(tidhash_lock);
end;

function THREAD_NEXT(i:p_kthread_iterator):Boolean;
begin
 Result:=HAMT_next32(i);
end;

function THREAD_GET(i:p_kthread_iterator):p_kthread;
begin
 Result:=nil;
 HAMT_get_value32(i,@Result);
end;

procedure KernSetThreadDebugName(newtd:p_kthread;prefix:PChar);
var
 name:shortstring;
begin
 name:=shortstring(prefix)+shortstring(newtd^.td_name);
 SetThreadDebugName(newtd^.td_tid,name);
end;

procedure before_start(td:p_kthread);
begin
 //init this
 ipi_sigreturn; //switch
end;

function create_thread(td        :p_kthread; //calling thread
                       ctx       :p_mcontext_t;
                       start_func:Pointer;
                       arg       :Pointer;
                       stack_base:Pointer;
                       stack_size:QWORD;
                       tls_base  :Pointer;
                       child_tid :PDWORD;
                       parent_tid:PDWORD;
                       rtp       :p_rtprio;
                       name      :PChar
                      ):Integer;
var
 newtd:p_kthread;
 stack:stack_t;

 n:Integer;
begin
 Result:=0;
 if (p_numthreads>=max_threads_per_proc) then
 begin
  Exit(EPROCLIM);
 end;

 thread_reap();

 if (rtp<>nil) then
 begin
  Case (rtp^._type and $fff7) of //RTP_PRIO_BASE
   RTP_PRIO_IDLE:
     begin
      if (rtp^._prio<>960) then Exit(EINVAL);
     end;
   RTP_PRIO_NORMAL:
     begin
      if (rtp^._prio>959) then Exit(EINVAL);
     end;
   PRI_REALTIME:
     begin
      if (rtp^._prio>767) then Exit(EINVAL);
     end;
   else
     Exit(EINVAL)
  end;
 end;

 if (stack_size<$1000) then
 begin
  if (ctx<>nil) then
  begin
   stack_size:=$1000;
  end else
  begin
   Exit(EINVAL);
  end;
 end;

 if (ptruint(stack_base)<$1000) then
 begin
  if (ctx<>nil) then
  begin
   stack_base:=Pointer(ctx^.mc_rsp-stack_size);

   //re check
   if (ptruint(stack_base)<$1000) then
   begin
    Exit(EINVAL);
   end;
  end else
  begin
   Exit(EINVAL);
  end;
 end;

 newtd:=thread_alloc;
 if (newtd=nil) then Exit(ENOMEM);

 //user stack
 newtd^.td_ustack.stack:=stack_base+stack_size;
 newtd^.td_ustack.sttop:=stack_base;
 //user stack

 n:=cpu_thread_create(newtd,
                      stack_base,
                      stack_size,
                      @before_start,
                      Pointer(newtd));

 if (n<>0) then
 begin
  thread_free(newtd);
  Exit(EINVAL);
 end;

 if (child_tid<>nil) then
 begin
  n:=suword32(child_tid^,newtd^.td_tid);
  if (n<>0) then
  begin
   cpu_thread_terminate(newtd);
   thread_free(newtd);
   Exit(EFAULT);
  end;
 end;

 if (parent_tid<>nil) then
 begin
  n:=suword32(parent_tid^,newtd^.td_tid);
  if (n<>0) then
  begin
   cpu_thread_terminate(newtd);
   thread_free(newtd);
   Exit(EFAULT);
  end;
 end;

 if (ctx<>nil) then
 begin
  // old way to set user context
  n:=set_mcontext(newtd,ctx);
  if (n<>0) then
  begin
   cpu_thread_terminate(newtd);
   thread_free(newtd);
   Exit(n);
  end;
 end else
 begin
  // Set up our machine context.
  stack.ss_sp  :=stack_base;
  stack.ss_size:=stack_size;
  // Set upcall address to user thread entry function.
  cpu_set_upcall_kse(newtd,start_func,arg,@stack);
  // Setup user TLS address and TLS pointer register.
  cpu_set_user_tls(newtd,tls_base);
 end;

 if (td<>nil) then
 begin
  newtd^.td_sigmask:=td^.td_sigmask;
 end;

 thread_link(newtd);

 if (name<>nil) then
 begin
  Move(name^,newtd^.td_name,SizeOf(t_td_name));
 end;
 KernSetThreadDebugName(newtd,'ps4:');

 sched_fork_thread(td,newtd);

 tidhash_add(newtd);

 if (rtp<>nil) then
 begin
  if (td=nil) then
  begin
   rtp_to_pri(rtp,newtd);
   sched_prio(newtd,newtd^.td_user_pri);
  end else
  if (td^.td_pri_class<>PRI_TIMESHARE) then
  begin
   rtp_to_pri(rtp,newtd);
   sched_prio(newtd,newtd^.td_user_pri);
  end;
 end;

 n:=cpu_sched_add(newtd);
 if (n<>0) then
 begin
  cpu_thread_terminate(newtd);
  thread_free(newtd);
  Exit(EFAULT);
 end;
end;

function kthread_add(func,arg:Pointer;newtdp:pp_kthread;name:PChar):Integer;
var
 td:p_kthread;
 newtd:p_kthread;
 stack:stack_t;

 n:Integer;
begin
 Result:=0;

 if (func=nil) or
    (newtdp=nil) then
 begin
  Exit(EINVAL);
 end;

 thread_reap();

 td:=curkthread;

 newtd:=thread_alloc;
 if (newtd=nil) then Exit(ENOMEM);

 stack.ss_sp  :=newtd^.td_kstack.sttop;
 stack.ss_size:=(ptruint(newtd^.td_kstack.stack)-ptruint(newtd^.td_kstack.sttop));

 //user stack
 newtd^.td_ustack.stack:=newtd^.td_kstack.stack;
 newtd^.td_ustack.sttop:=newtd^.td_kstack.sttop;
 //user stack

 n:=cpu_thread_create(newtd,
                      stack.ss_sp,
                      stack.ss_size,
                      func,
                      arg);

 if (n<>0) then
 begin
  thread_free(newtd);
  Exit(EINVAL);
 end;

 cpu_set_upcall_kse(newtd,func,arg,@stack);

 if (td<>nil) then
 begin
  newtd^.td_sigmask:=td^.td_sigmask;
 end;

 thread_link(newtd);

 newtd^.td_pflags:=newtd^.td_pflags or TDP_KTHREAD;

 if (name<>nil) then
 begin
  Move(name^,newtd^.td_name,SizeOf(t_td_name));
 end;
 KernSetThreadDebugName(newtd,'kern:');

 sched_fork_thread(td,newtd);

 tidhash_add(newtd);

 thread_inc_ref(newtd);

 n:=cpu_sched_add(newtd);
 if (n<>0) then
 begin
  cpu_thread_terminate(newtd);
  thread_dec_ref(newtd);
  thread_free(newtd);
  Exit(EFAULT);
 end;

 newtdp^:=newtd;
end;

function kern_thr_new(td:p_kthread;param:p_thr_param):Integer;
var
 rtp:t_rtprio;
 rtpp:p_rtprio;
 name:t_td_name;
begin
 Result:=0;
 rtpp:=nil;

 if (param^.rtp<>nil) then
 begin
  Result:=copyin(param^.rtp,@rtp,Sizeof(t_rtprio));
  if (Result<>0) then Exit;
  rtpp:=@rtp;
 end;

 name:=Default(t_td_name);

 if (param^.name<>nil) then
 begin
  Result:=copyinstr(param^.name,@name,32,nil);
  if (Result<>0) then Exit;
 end;

 Result:=create_thread(td,
                       nil,
                       param^.start_func,
                       param^.arg,
                       param^.stack_base,
                       param^.stack_size,
                       param^.tls_base,
                       param^.child_tid,
                       param^.parent_tid,
                       rtpp,
                       @name);
end;

function sys_thr_new(_param:Pointer;_size:Integer):Integer;
var
 param:thr_param;
begin
 if (_size<0) or (_size>Sizeof(thr_param)) then Exit(EINVAL);

 param:=Default(thr_param);

 Result:=copyin(_param,@param,_size);
 if (Result<>0) then Exit;

 Result:=kern_thr_new(curkthread,@param);
end;

function sys_thr_create(ctx:Pointer;id:PDWORD;flags:Integer):Integer;
var
 _ctx:ucontext_t;
begin
 Result:=copyin(ctx,@_ctx,sizeof(ucontext_t));
 if (Result<>0) then Exit;

 //flags ignored
 Result:=create_thread(curkthread,
                       @_ctx.uc_mcontext,
                       nil,
                       nil,
                       nil,
                       0,
                       nil,
                       id,
                       nil,
                       nil,
                       nil);

end;

procedure thread_exit;
var
 td:p_kthread;
begin
 td:=curkthread;
 if (td=nil) then Exit;

 ASSERT(TAILQ_EMPTY(@td^.td_sigqueue.sq_list),'signal pending');

 td^.td_state:=TDS_INACTIVE;

 tidhash_remove(td);
 thread_unlink(td);

 umtx_thread_exit(td);

 //free
 thread_dec_ref(td);

 cpu_sched_throw;
end;

function sys_thr_self(id:PDWORD):Integer;
var
 td:p_kthread;
begin
 if (id=nil) then Exit(EINVAL);

 td:=curkthread;
 if (td=nil) then Exit(EFAULT);

 Result:=suword32(id^,td^.td_tid);
 if (Result<>0) then Exit(EFAULT);

 Result:=0;
end;

procedure sys_thr_exit(state:PQWORD);
var
 td:p_kthread;
begin
 td:=curkthread;
 if (td=nil) then Exit;

 if (state<>nil) then
 begin
  kern_umtx_wake(td,Pointer(state),High(Integer),0);
 end;

 tdsigcleanup(td);
 //thread_stopped(p);
 thread_reap();
 thread_exit();
 // NOTREACHED
end;

procedure kthread_exit();
begin
 thread_reap();
 thread_exit();
 // NOTREACHED
end;

function sys_thr_kill(id,sig:Integer):Integer;
var
 td,ttd:p_kthread;
 ksi:ksiginfo_t;
 i:kthread_iterator;
begin
 td:=curkthread;

 thread_reap();

 ksiginfo_init(@ksi);
 ksi.ksi_info.si_signo:=sig;
 ksi.ksi_info.si_code :=SI_LWP;
 ksi.ksi_info.si_pid  :=g_pid;

 if (id=-1) then //all
 begin
  if (sig<>0) and (not _SIG_VALID(sig)) then
  begin
   Result:=EINVAL;
  end else
  begin
   Result:=ESRCH;
   PROC_LOCK;

   if FOREACH_THREAD_START(@i) then
   begin
    repeat
     ttd:=THREAD_GET(@i);
     if (ttd<>td) then
     begin
      Result:=0;
      if (sig=0) then Break;
      tdksignal(ttd,sig,@ksi);
     end;
    until not THREAD_NEXT(@i);
    FOREACH_THREAD_FINISH();
   end;

   PROC_UNLOCK;
  end;
 end else
 begin
  Result:=0;

  td:=tdfind(DWORD(id));
  if (td=nil) then Exit(ESRCH);

  if (sig=0) then
  begin
   //
  end else
  if (not _SIG_VALID(sig)) then
   Result:=EINVAL
  else
  begin
   PROC_LOCK;
   tdksignal(td,sig,@ksi);
   PROC_UNLOCK;
  end;

  thread_dec_ref(td);
 end;
end;

function sys_thr_kill2(pid,id,sig:Integer):Integer;
begin
 if (pid<>0) and (pid<>g_pid) then
 begin
  Exit(ESRCH);
 end;

 Result:=sys_thr_kill(id,sig);
end;

function kern_thr_suspend(td:p_kthread;tsp:p_timespec):Integer;
var
 tv:Int64;
begin
 Result:=0;

 thread_reap();

 if ((td^.td_pflags and TDP_WAKEUP)<>0) then
 begin
  td^.td_pflags:=td^.td_pflags and (not TDP_WAKEUP);
  Exit(0);
 end;

 tv:=0;
 if (tsp<>nil) then
 begin
  if (tsp^.tv_sec=0) and (tsp^.tv_nsec=0) then
  begin
   Result:=EWOULDBLOCK;
  end else
  begin
   tv:=TIMESPEC_TO_UNIT(tsp);
   tv:=tvtohz(tv);
  end;
 end;

 PROC_LOCK;

 if (Result=0) and ((td^.td_flags and TDF_THRWAKEUP)=0) then
 begin
  //PROC_UNLOCK; //
  //Result:=msleep_td(tv);
  //PROC_LOCK;   //
  Result:=msleep(td,@p_proc.p_mtx,PCATCH,'lthr',tv);
 end;

 if ((td^.td_flags and TDF_THRWAKEUP)<>0) then
 begin
  thread_lock(td);
  td^.td_flags:=td^.td_flags and (not TDF_THRWAKEUP);
  thread_unlock(td);
  PROC_UNLOCK;
  Exit(0);
 end;

 PROC_UNLOCK;

 if (Result=EWOULDBLOCK) then
 begin
  Result:=ETIMEDOUT;
 end else
 if (Result=ERESTART) then
 begin
  if (tv<>0) then
  begin
   Result:=EINTR;
  end;
 end;
end;

function sys_thr_suspend(timeout:Pointer):Integer;
var
 td:p_kthread;
 ts:timespec;
 tsp:p_timespec;
begin
 td:=curkthread;
 if (td=nil) then Exit(-1);

 tsp:=nil;
 if (timeout<>nil) then
 begin
  Result:=umtx_copyin_timeout(timeout,@ts);
  if (Result<>0) then Exit;
  tsp:=@ts;
 end;

 Result:=kern_thr_suspend(td,tsp);
end;

function sys_thr_wake(id:DWORD):Integer;
var
 td:p_kthread;
begin
 Result:=0;
 td:=curkthread;

 thread_reap();

 if (td<>nil) then
 if (id=td^.td_tid) then
 begin
  td^.td_pflags:=td^.td_pflags or TDP_WAKEUP;
  Exit(0);
 end;

 td:=tdfind(DWORD(id));
 if (td=nil) then Exit(ESRCH);

 thread_lock(td);
 td^.td_flags:=td^.td_flags or TDF_THRWAKEUP;
 thread_unlock(td);

 wakeup_td(td); //broadcast

 thread_dec_ref(td);
end;

function sys_thr_set_name(id:DWORD;pname:PChar):Integer;
var
 td:p_kthread;
 name:t_td_name;
begin
 Result:=0;

 thread_reap();

 name:=Default(t_td_name);
 if (name<>nil) then
 begin
  Result:=copyinstr(pname,@name,32,nil);
  if (Result<>0) then Exit;
 end;

 if (Integer(id)=-1) then
 begin
  //TODO SetProcName
  Exit;
 end;

 td:=tdfind(DWORD(id));
 if (td=nil) then Exit(ESRCH);

 thread_lock(td);

 td^.td_name:=name;
 KernSetThreadDebugName(td,'ps4:');

 thread_unlock(td);

 thread_dec_ref(td);
end;

function strnlen(s:PChar;maxlen:ptrint):ptrint;
var
 len:size_t;
begin
 For len:=0 to maxlen-1 do
 begin
  if (s^=#0) then Break;
  Inc(s);
 end;
 Exit(len);
end;

function sys_thr_get_name(id:DWORD;pname:PChar):Integer;
var
 td:p_kthread;
 name:t_td_name;
 len:ptrint;
begin
 Result:=0;

 thread_reap();

 td:=tdfind(DWORD(id));
 if (td=nil) then Exit(ESRCH);

 thread_lock(td);

 name:=td^.td_name;

 thread_unlock(td);

 len:=strnlen(name,31);
 Result:=copyout(@name,pname,len+1);

 thread_dec_ref(td);
end;

function sys_amd64_set_fsbase(base:Pointer):Integer;
var
 td:p_kthread;
begin
 Result:=0;
 td:=curkthread;
 if (td=nil) then Exit(-1);
 cpu_set_user_tls(td,base);
end;

function sys_amd64_get_fsbase(base:PPointer):Integer;
var
 td:p_kthread;
begin
 Result:=0;
 td:=curkthread;
 if (td=nil) or (base=nil) then Exit(-1);
 base^:=td^.pcb_fsbase;
end;

function sys_amd64_set_gsbase(base:Pointer):Integer;
var
 td:p_kthread;
begin
 Result:=0;
 td:=curkthread;
 if (td=nil) then Exit(-1);
 cpu_set_gsbase(td,base);
end;

function sys_amd64_get_gsbase(base:PPointer):Integer;
var
 td:p_kthread;
begin
 Result:=0;
 td:=curkthread;
 if (td=nil) or (base=nil) then Exit(-1);
 base^:=td^.pcb_gsbase;
end;

end.