(*
/*

CLASS {NATIVE_Thread|_Delphi},
UNTESTED, NATIVE, ABSTRACT:

IMPORT, ANYWAY: {Thread} .
IMPORT: {System_functions} .

NATIVE: "uses NATIVE_Thread {$IFDEF KOL}, Windows"
		"					{$ELSE} , "
		"						{$IFDEF FPC} LCLIntf,"
		"						{$ENDIF}"
		"						SyncObjs "
		"						{$IFDEF LINUX} , CThreads"
		"						{$ELSE}	, Windows "
		"						{$ENDIF}"
		"					{$ENDIF};"
		.
NATIVE: "{$I AL4_options.inc}" .
NATIVE: "///COPY AL4_options.inc" .
NATIVE: "///COPY NATIVE_Thread.pas" .

//FUNCTION Set_interesting_thread, NATIVE : @
//	"Set_interesting_thread;" .
*/
*)

{$DEFINE USE_LISTS_OF_DESCRIPTORS} // A N Y W A Y !!!!!!!!!!!!!!!!

unit NATIVE_Thread;
interface

uses  
//?{Thread}
	{$IFDEF LINUX}
		 		cthreads,
	{$ENDIF}
//.
	 All_classes, AL4
	 {$IFDEF FPC}
	 , LCLIntf
	 {$ENDIF}
	 {$IFDEF KOL}, KOL, Windows
	 {$ELSE}, SysUtils	
	 	 , Classes, SyncObjs
		 {$IFDEF FPC}
		 	{$IFDEF LINUX}
		 	{$ELSE}
		 		, Windows
		 	{$ENDIF}
		 {$ELSE}	 
		 	, Windows
		 {$ENDIF}
	 {$ENDIF}
	 ;

// Id of the main thread, set in the	\ИД главной нити, устанавливается в секции
// initialization section, used to		\инициализации, используется для проверки
// check if the currect thread is main	\того, что текущая нить является главной
var mainThreadId: Cardinal;
const WAIT_INFINITE = MAXINT;

{$IFDEF KOL}
type
	//------------------------------------------------------------------------
	// The class to implement mutex in KOL\Класс для реализации мьютекса в KOL
	PCriticalSection = ^TCriticalSection;
	TCriticalSection = object(TObj)
		FSection: TRTLCriticalSection;
	public
		constructor Create;
		procedure Enter;
		procedure Leave;
		destructor Destroy; virtual;
	end;
	
	//--------------------------------------------------------------------------
	// The class to implement simple	\Класс для реализации простого ожидаемого
	// wasitable event					\события
	PSimpleEvent = ^TSimpleEvent;
	TSimpleEvent = object(TObj)
		FEvent: THandle;
	public
		constructor Create;
		procedure SetEvent;
		procedure ResetEvent;
		procedure WaitFor(TimeOut: Cardinal);
		destructor Destroy; virtual;
	end;
{$ENDIF}

{$I AL4_options.inc}

{$DEFINE USE_PROTECT_TAKE_YIELD}
{$IFDEF USE_PROTECT_TAKE_YIELD}
var protect_take_yield: {$IFDEF KOL} PCriticalSection 
						{$ELSE} 
						   {$IFDEF FPC}syncobjs.{$ENDIF}
						   TCriticalSection
						{$ENDIF} ;
{$ENDIF}

{$DEFINE USE_PROTECT_ALLOC_THREAD}
{$IFDEF USE_PROTECT_ALLOC_THREAD}
var protect_alloc_thread: {$IFDEF KOL} PCriticalSection 
						{$ELSE} 
						   {$IFDEF FPC}syncobjs.{$ENDIF}
						   TCriticalSection
						{$ENDIF} ;
{$ENDIF}

{$IFDEF KOL}
	{$DEFINE PROTECT_DYNAOBJ_DISCARD}
	{$IFDEF PROTECT_DYNAOBJ_DISCARD}
	var protect_dynaobj_discard: PCriticalSection;
	procedure dynaobj_discard_enter;
	procedure dynaobj_discard_leave;
	{$ENDIF}
{$ENDIF}

type
//----------------------------------------------------------
// The class to implement thread \ Класс для реализации нити
{$IFDEF KOL}
AL4_thread = ^TAL4_thread;
TAL4_thread = object(TObj)
{$ELSE}
TExecute_thread = class;
	 
AL4_thread = class(TObject)
{$ENDIF}
	started_already: Boolean;
	started_in_thread: Boolean;
	priority: Integer;
	//ref_controller_: Ref_obj;
	finished: Boolean;
	constructor Create;
	destructor Destroy; {$IFDEF KOL} virtual; {$ELSE} override; {$ENDIF}
	procedure clear;
	public function Was_Terminated: Boolean;  

	//reference to OS (be exactly, Delphi)	\ссылка на экземпляр объекта
	//implementation of the thread object	\нити в ОС (точнее, в Delphi)
	public thread: {$IFDEF KOL} PThread {$ELSE} TExecute_thread {$ENDIF};
	{$IFDEF FPC}
	public when_ended: PRTLEvent;
	{$ENDIF}

	// reference to AL-IV	\ ссылка на объект нити {Thread}
	// {Thread} object		\ языки и библиотеки АЛФОР
	public ref_C_Thread: C_Thread;
	
	// The mutex to protect Take	\ Мьютекс для защиты операций Take и
	// & Yield operations			\ Yield

	// The event to signal that	\ Событие для сигнализации о том, что
	// the thread was started	\ запускаемая нить стартовала
    //public thread_started: {$IFDEF KOL} PSimpleEvent
    //                       {$ELSE} TSimpleEvent {$ENDIF};
								   
	//queue of objects passed to the thread	\очередь объектов, переданных в нить
	//by Take method from the parent thread	\из родительской нити методом Take
	//(together with hard-linked objects	\(вместе с объектами, на которые
	//referenced by object fields of passed	\жестко ссылаются поля переданных
	//objects, if this is an option or this	\объектов, при указании такой опции
	//is a single hard link field)			\или при единственности связи)
	public queue_input_objects: {$IFDEF KOL} PList {$ELSE} TList {$ENDIF};
	
	//the event to wait receiving objects	\событие для ожидания приемки объектов
	data_arrive: {$IFDEF KOL} PSimpleEvent {$ELSE} TSimpleEvent {$ENDIF};
	//---------------------- declare methods
	
	// {Thread}.execute --> Thread_run --> Execute_routine
	{$IFDEF KOL}
		function Execute(Sender: PThread): Integer;
	{$ELSE}
		procedure Execute;
	{$ENDIF}
	
	// {Thread}.Take --> Thread_take_objects --> take_objects
	// taking objects from the parent\передача объектов от родительской
	// thread to the running thread	 \к исполняющейся дочерней нити
	public procedure take_objects(A: DynAObj; Together: Boolean);
	
	//take a single object to the thread \передача единичного объекта в
	//started (from the parent thread)	 \запущенную подчиненную нить
	public function take_single_object(Ai: Ref_obj; Together: Boolean;
		   add_to_queue: Boolean): Ref_obj;
		   
	// break a single link to the	  \разрыв единичной ссылки на объект,
	// object left in previous thread \который остается в адресном про-
	// address space				  \странстве исходной нити
	public function break_object_ref(X: Ref_obj): Ref_obj;
	
	// receive objects --> \приемка отправленных объектов 
	public procedure receive_objects(A: DynAObj; Wait: Boolean);

	//receiving a single object	\приемка единичного объекта
	public procedure receive_single_object(Di: Ref_obj);

	//rejoin a single object migrated\восстановление ссылок из одного объ-
	//to the thread resting a broken \екта, когда они указывают на объ-
	//link in case when it refers to \екты, находящиеся в той же нити 
	//an object also belonging to the\в результате отправки нескольких
	//same thread (together or separately)\объектов (вместе или последо-
	//									  \вательно)
	public function rejoin_object_ref(
		   S_ref_from_dummy: Ref_obj; R: Ref_obj): Ref_obj;

	// yield_objects forced	\возврат объектов принудительный
	public procedure yield_objects(A: DynAObj);
	
	// yield a single object	\ возврат одного объекта
	public procedure yield_single_object(Ai: Ref_obj);
end;

{$IFDEF KOL}
{$ELSE} TAL4_thread = AL4_thread; {$ENDIF}

//_________________________________________________________________________
// class overriding Ref_obj to be used	\класс переопределяющий Ref_obj для
// as a temp reference while the object	\использования в подчиненном потоке
// lives in another thread				\взамен исходного ссылочного объекта
{$IFDEF KOL}
Ref_obj_foreign = ^TRef_obj_foreign;
TRef_obj_foreign = object(TRef_obj)
{$ELSE}
Ref_obj_foreign = class(Ref_obj)
{$ENDIF}
 	//redefining Ref_dec_hard, we use it	\переопределяем Ref_dec_hard, вместо
 	//not to destroy the object but to		\уничтожения объекта отправляем его
 	//return it to the sending (master)		\назад к нити-отправителю, когда его
 	//thread when its Count becomes == 0	\счетчик Count становится = 0
	public procedure Ref_dec_hard(); 
	{$IFDEF KOL} virtual {$ELSE} override {$ENDIF};
	
	// handling fields of the X object	\ обработка полей объекта X
	// returning home					\ при возвращении его домой
	procedure rejoin_fields(X: Ref_obj);
	
	//rejoin a single object migrated\восстановление ссылок из одного объ-
	//to the thread resting a broken \екта, когда они указывают на объ-
	//link in case when it refers to \екты, находящиеся в той же нити 
	//an object also belonging to the\в результате отправки нескольких
	//same thread (together or separately)\объектов (вместе или последо-
	//									  \вательно)
	function rejoin_object_ref(
	S_ref_from_dummy: Ref_obj; R: Ref_obj; is_hard_link: Boolean): Ref_obj;
	
end;

{$IFDEF KOL}
{$ELSE} 
	TRef_obj_foreign = Ref_obj_foreign;
	
TExecute_thread = class(TThread)
	AL4_thread: TAL4_thread;
	constructor Create(t: TAL4_thread);
	{$IFDEF FPC}
		destructor Destroy; override;
 	{$ELSE}
		destructor Destroy; 
		{$IFDEF KOL} virtual {$ELSE} override {$ENDIF};
 	{$ENDIF}
	procedure Execute; override;
	function Is_terminated: Boolean;
end;

{$ENDIF} 

var
    //lock_thread: {$IFDEF FPC}
    //                PRTLEvent
    //             {$ELSE}
    //                THandle
    //             {$ENDIF} ;
	All_threads: {$IFDEF KOL} PList {$ELSE} TList {$ENDIF};
	C11_threads: array of Byte;

function alloc_thread(F: AL4_thread): Integer;
procedure release_thread_handle(h: Integer);
procedure destroy_thread_handle(h: Integer);
function thread_by_handle(handle: Integer): AL4_thread;

procedure Do_Thread_set_priority(X_Handle, X_Priority: Integer);
	
function new_Ref_obj_foreign(obj_: AL4_object; count_: Integer): Ref_obj_foreign;
	 
var Total_count_running_threads: Integer;

implementation
(*
/*

FUNCTION Total_count_of_running_threads ==> INT, NATIVE : @
	"RESULT := Total_count_running_threads;" .

FUNCTION Create_thread(
{Thread} Thread|_object) ==> INT, NATIVE:
@	"var t: AL4_thread;"
	"{$IFDEF KOL}"
	"	new(t, Create);"
	"{$ELSE}"
	"	t := AL4_thread.Create();"
	"{$ENDIF}"
	"t.ref_C_Thread := C_Thread(X_Thread.Obj);"
	"t.Started_already := false;"
	"{$IFDEF KOL}"
	"{$ELSE}"
	"	t.thread := nil;"
	"{$ENDIF}"
	"RESULT := alloc_thread(t);" .

FUNCTION Destroy_thread_handle(
{Thread} T|hread_to_destroy), NATIVE :
	INT handle|_to_destroy = T.Handle
	CASE handle == 0 ? ==> ;
	NATIVE : @
"destroy_thread_handle(X_handle);" .
	
FUNCTION Thread_is_main ==> BOOL, NATIVE :
@	"RESULT := mainThreadId = GetCurrentThreadId;"
	.
	
*/
*)

function thread_by_handle(
handle: Integer): AL4_thread;
begin
	{$IFDEF USE_PROTECT_ALLOC_THREAD}
	protect_alloc_thread.Enter();
	try
	{$ENDIF}
	 	Result := AL4_thread(All_threads{$IFDEF KOL}.Items{$ENDIF}[handle]);
	{$IFDEF USE_PROTECT_ALLOC_THREAD}
	finally
		protect_alloc_thread.Leave();
	end;
	{$ENDIF}
end;

(*
/*
	
FUNCTION Thread_run({Thread} Thread|_object), NATIVE :
	//DEBUG: << "running thread in Thread_run" #NL ;
	NATIVE @
	"var t: AL4_thread;"
	"var t_p: Pointer;"
	"	t := thread_by_handle(C_Thread(X_Thread.Obj).F_Handle);"
	"   if t.Started_already then "
	"   begin"
	"	   Exit;"
	"   end;"
	
	"   t_p := Pointer(t);"
	"   t.Started_already := true;"
    
	"{$IFDEF KOL}"
	"   if t.thread = nil then"
	"   begin"
	"	   t.thread := NewThread;"
	"	   t.thread.OnExecute := t.Execute;"
	"	   if t.priority >= 0 then"
	"	   begin"
	"		   Do_Thread_set_priority(C_Thread(X_Thread.Obj).F_Handle, t.priority);"
	"		   t.priority := -1;"
	"	   end;"
	"   end;"
	"   t.thread.Resume();"
	"{$ELSE}"
	"	{$IFDEF FPC}"
	"	if t.when_ended = nil then t.when_ended := RTLEventCreate;"
	"	{$ENDIF}"
	"	t.thread := TExecute_thread.Create(t);"
	//"   t.thread.Resume();" -- resumed automatically
	"{$ENDIF}" 
	.
	
FUNCTION Thread_ended(INT Handle|_thread) ==> BOOL, NATIVE :
@	"var t: AL4_thread;"
	"	t := thread_by_handle(X_Handle);"
	"	RESULT := t.Was_terminated;"
	.
	
FUNCTION Thread_stop(
INT Handle|_thread, BOOL Terminate), NATIVE:
@	"var t: AL4_thread;"
	"	t := thread_by_handle(X_Handle);"
	"   if t.Was_terminated then Exit;"
	"   if t.thread = nil then Exit;"
	"   t.thread.Terminate();" .
	
CONST STR :
	Native_import = @
	"uses NATIVE_Thread {$IFDEF linux}{$ELSE}, Windows {$ENDIF} "
	"{$I AL4_options.inc}"	
	";"

	Native_wait_threads = @
	"var i, j: Integer;"
	"var h: array of THandle;"
    "var th: Integer;"
    "var t: AL4_thread;"
    "	if X_A.Count() = 0 then "
    "	begin"
    "		Exit;"
    "	end;"
	"{$IFDEF FPC}"
	"	for i := 0 to X_A.Count()-1 do"
	"	begin"
	"		th := C_Thread(X_A.GetObjects(i).Obj).F_Handle;"
	"		t := thread_by_handle(th);"
	"		if t.thread = nil then continue;"
	"		RtlEventWaitFor(t.when_ended);"
	"	end;"
	"	RESULT := true;"
	"{$ELSE}"
	"	{$IFDEF KOL}"
	"	if Assigned(fun_dynaobj_discard_enter) then fun_dynaobj_discard_enter;"     
	"	{$ENDIF}"     
	"	SetLength(h, X_A.Count());"
	"	try"     
	"	    for i := 0 to X_A.Count()-1 do"
	"	    begin"
	"		    th := C_Thread(X_A.GetObjects(i).Obj).F_Handle;"
	"		    t := thread_by_handle(th);"
	"		    if t.thread = nil then h[i] := 0"
	"		    else h[i] := t.thread.Handle;"
	"	    end;"
	"	    for i := High(h) downto 0 do"
	"	    begin"
	"		    if h[i] = 0 then"
	"		    begin"
	"			    for j := i+1 to High(h) do"
	"				    h[j-1] := h[j];"
	"			    SetLength(h, High(h));"
	"		    end;"
	"	    end;"
	"	    if X_Max = 0 then X_Max := INFINITE;"
	"	{$IFDEF KOL}"
	"	if Assigned(fun_dynaobj_discard_leave) then fun_dynaobj_discard_leave;"     
	"	{$ENDIF}"     
	"	    if X_A.Count() = 1 then"
	"		    i := WaitForSingleObject(h[0], X_Max)"
	"	    else if X_A.Count() > 1 then"
	"		    i := WaitForMultipleObjects(X_A.Count(), @h[0], TRUE, X_Max)"
	"	    else i := WAIT_OBJECT_0;"
	"	{$IFDEF KOL}"
	"	if Assigned(fun_dynaobj_discard_enter) then fun_dynaobj_discard_enter;"     
	"	{$ENDIF}"     
	"	    RESULT := (i <> WAIT_FAILED) and (i <> WAIT_TIMEOUT);"
	"	finally"
	"		SetLength(h, 0);"     
	"	    {$IFDEF KOL}"
	"	    if Assigned(fun_dynaobj_discard_leave) then "
	"					fun_dynaobj_discard_leave;"     
	"	    {$ENDIF}"     
	"	end;"     
	"{$ENDIF}" .
	
FUNCTION Thread_priority(
INT Handle|_thread) ==> {Thread}.{priority}, NATIVE:
@	"var t: AL4_thread;"
	"	t := thread_by_handle(X_Handle);"
    "if t.thread = nil then Exit;"
	"{$IFDEF KOL}"
	"	case t.thread.PriorityClass of"
	"	IDLE_PRIORITY_CLASS:	RESULT := 1;"
	"	NORMAL_PRIORITY_CLASS:	RESULT := 2;"
	"	HIGH_PRIORITY_CLASS:	RESULT := 3;"
	"	REALTIME_PRIORITY_CLASS:RESULT := 4;"
	"	end;"
	"{$ELSE}"
	"	case t.thread.Priority of" 
	"	tpIdle: RESULT := 0;"
	"	tpLowest: RESULT := 0;"
	"	tpLower: RESULT := 1;"
	"	tpNormal: RESULT := 2;"
	"	tpHigher: RESULT := 3;"
	"	tpHighest: RESULT := 3;"
	"	tpTimeCritical: RESULT := 4;"
	"	else RESULT := 1;"
	"	end;" 
	"{$ENDIF}" .
	
FUNCTION Thread_set_priority(
INT Handle|_thread, {priority} Priority), NATIVE:
	"Do_Thread_set_priority(X_Handle, X_Priority);" .
	
*/
*)
procedure Do_Thread_set_priority(X_Handle, X_Priority: Integer);
var t: AL4_thread;
begin
	 t := thread_by_handle(X_Handle);
     if t.thread = nil then
     begin
        t.priority := X_Priority; 
     end;
	 {$IFDEF KOL}
	 	case X_Priority of
	 	0, 1: t.thread.PriorityClass := IDLE_PRIORITY_CLASS;
	 	2: t.thread.PriorityClass := NORMAL_PRIORITY_CLASS;
	 	3: t.thread.PriorityClass := HIGH_PRIORITY_CLASS;
	 	4: t.thread.PriorityClass := REALTIME_PRIORITY_CLASS;
	 	end;
	 {$ELSE}
	 	case X_Priority of
	 	0: t.thread.Priority := tpLowest;
	 	1: t.thread.Priority := tpLower;
	 	2: t.thread.Priority := tpNormal;
	 	3: t.thread.Priority := tpHigher;
	 	4: t.thread.Priority := tpTimeCritical;
	 	end;
	 {$ENDIF}
end;
	
(*
/*
FUNCTION Thread_take_objects(
INT Handle|_thread, {Object} A|rray_of_objects_passed[*],
BOOL Together|_with_hard_linked), NATIVE:
	//DEBUG: << "Thread_take_objects(" Handle.S ", A[" A[].Count.S "])"#NL ;
	NATIVE @	
	"var t: AL4_thread;"
	"t := thread_by_handle(X_Handle);"
	"t.take_objects(X_A, X_Together);" .
	
FUNCTION Thread_receive_objects(
INT Handle|_thread, {Object} A|rray_of_objects_received[], BOOL Wait|_for_take),
NATIVE:
@	"var t: AL4_thread;"
	"t := thread_by_handle(X_Handle);"
	"t.receive_objects(X_A, X_Wait);" .
	
FUNCTION Thread_yield_objects(
INT Handle|_thread, {Object} A|rray_of_objects_returned[*]), NATIVE:
@	"var t: AL4_thread;"
	"t := thread_by_handle(X_Handle);"
	"t.yield_objects(X_A);" .
	
FUNCTION Is_thread_running(
INT Handle|_thread) ==> BOOL, NATIVE
	:
	CASE Handle <= 0 ? ==> ;
	NATIVE
@	"var t: AL4_thread;"
	"var ct: C_Thread;"
	"t := thread_by_handle(X_Handle);"
	"ct := C_Thread(t.ref_C_Thread);"
	"RESULT := ct.F_running;" .

*/
*)

function alloc_thread(
F: AL4_thread): Integer;
begin
	{$IFDEF USE_PROTECT_ALLOC_THREAD}
	protect_alloc_thread.Enter();
	try
	{$ENDIF}
		if All_threads = nil then
		begin 
			All_threads := {$IFDEF KOL} NewList {$ELSE} TList.Create {$ENDIF} ;
			All_threads.Add(Pointer(-1)); // do not use Handle = 0
		end;
		Result := All_threads.IndexOf(nil);
		if Result < 0 then begin
			Result := All_threads.Count;
			All_threads.Add(F);
		end
			else
		All_threads
			{$IFDEF KOL}.Items
			{$ENDIF} [Result] := F;
		
		{$IFDEF KOL}
			{$IFDEF PROTECT_DYNAOBJ_DISCARD}
			if Assigned(fun_dynaobj_discard_enter) then
			begin 
				protect_alloc_thread.Leave();
				fun_dynaobj_discard_enter;
			end;
			try
			{$ENDIF}
		{$ENDIF}
		if Length(C11_threads) < Result then
			SetLength(C11_threads, Length(C11_threads) + 100);
		C11_threads[Result] := 2;
		{$IFDEF KOL}
			finally
			{$IFDEF PROTECT_DYNAOBJ_DISCARD}
			if Assigned(fun_dynaobj_discard_leave) then
			begin 
				fun_dynaobj_discard_leave;
				protect_alloc_thread.Enter();
			end;
			{$ENDIF}
			end;
		{$ENDIF}
	{$IFDEF USE_PROTECT_ALLOC_THREAD}
	finally
		protect_alloc_thread.Leave();
	end;
	{$ENDIF}
end;

procedure release_thread_handle(
h: Integer);
begin
	if h = 0 then Exit;
	{$IFDEF USE_PROTECT_ALLOC_THREAD}
	protect_alloc_thread.Enter();
	try
	{$ENDIF}
		dec(C11_threads[h]);
		if C11_threads[h] = 0 then
	    	All_threads
	    		{$IFDEF KOL}.Items
	    		{$ENDIF}		  [h] := nil;
	{$IFDEF USE_PROTECT_ALLOC_THREAD}
	finally
		protect_alloc_thread.Leave();
	end;
	{$ENDIF}
end;

procedure destroy_thread_handle(
h: Integer);
var t: AL4_thread;
begin
	t := thread_by_handle(h);
    //{$IFDEF USE_PROTECT_TAKE_YIELD}
    //protect_take_yield.Enter();
    //{$ENDIF}
	try
		release_thread_handle(h);
		if C11_threads[h] > 0 then Exit;
	finally
       //{$IFDEF USE_PROTECT_TAKE_YIELD}
       //protect_take_yield.Leave();
       //{$ENDIF}
	end;
{$IFDEF FPC}
    if t <> nil then t.clear;
{$ELSE}
    t.Free;
{$ENDIF}
end;

(*
/*

FUNCTION Release_thread_handle(
INT Handle|_to_release), NATIVE : @
"	release_thread_handle(X_Handle);" .
	
*/
*)

function new_Ref_obj_foreign(
	obj_: AL4_object; count_: Integer): Ref_obj_foreign;
begin
	{$IFDEF KOL}
 		new(Result, Create);
	{$ELSE}
		Result := Ref_obj_foreign.Create();
	{$ENDIF}
 	Result.Obj := obj_;
 	Result.Count := count_;
end;

constructor TAL4_thread.Create;
begin
	priority := -1;
	{$IFDEF KOL} queue_input_objects := NewList;
	{$ELSE}		 inherited Create();		 
				 queue_input_objects := TList.Create;
	{$ENDIF}
end;

procedure TAL4_thread.clear;
begin
	queue_input_objects.Free;
	queue_input_objects := nil;
	data_arrive.Free; //???????????????????????????
	data_arrive := nil;
end;

destructor TAL4_thread.Destroy;
begin
	clear;
	
	{$IFDEF KOL}
	Free_And_Nil(thread);
	{$ENDIF}
	{$IFDEF FPC}
	if when_ended <> nil then RTLEventDestroy(when_ended);
	when_ended := nil;
	{$ENDIF}
	inherited;
end;

function TAL4_thread.Was_terminated: Boolean;
var status: Cardinal;
begin
	{$IFDEF KOL}
		Result := TRUE;
		if thread <> nil then
		begin
			GetExitCodeThread(thread.Handle, status);
			if status = STILL_ACTIVE then 
				Result := FALSE;
		end;
	{$ELSE}
		//Result := (thread <> nil) and thread.Is_terminated();
		{$IFDEF FPC}
			{$IFDEF LINUX}
			//Result := (thread = nil) or thread.Terminated;
			Result := (thread = nil) or thread.Terminated or finished;
			{$ELSE}
			Result := (thread = nil) or thread.Terminated or finished;
			{$ENDIF}
		{$ELSE}
			Result := TRUE;
			if thread <> nil then
			begin
				GetExitCodeThread(thread.Handle, status);
				if {thread.Terminated and} (status = STILL_ACTIVE) then 
				begin
					//WaitForSingleObject(thread.Handle, INFINITE);
					Result := FALSE;
				end;
			end;
		{$ENDIF}
	{$ENDIF}
end;

//____________________________________________________
// {Thread}.execute --> Thread_run --> Execute_routine
{$IFDEF KOL} 

function TAL4_thread.Execute(
Sender: PThread): Integer;
{$ELSE}

procedure TAL4_thread.Execute;
{$ENDIF}
var X: Ref_obj;
	h: Integer;
begin
     {$IFDEF KOL}
     	{$IFDEF PROTECT_DYNAOBJ_DISCARD}
     	if not Assigned(fun_dynaobj_discard_enter)  then
     	begin
     	fun_dynaobj_discard_enter := @dynaobj_discard_enter; 
     	fun_dynaobj_discard_leave := @dynaobj_discard_leave;
     	end; 
     	{$ENDIF}
     {$ENDIF}
//writeln('#1');
    if protect_take_yield = nil then
    begin
        {$IFDEF KOL}
           new(protect_take_yield, Create);
        {$ELSE}
           //protect_take_yield := {$IFDEF FPC}syncobjs.{$ENDIF}
           //    TCriticalSection.Create();
        {$ENDIF}
    end;
	//simulate here Take					\симулируем здесь передачу Take 
	//for the ref_C_Thread object itself	\самого объекта нити ref_C_Thread
	inc(Total_count_running_threads);
	started_in_thread := true;
//writeln('#2');
	{$IFDEF FPC}
	if when_ended = nil then
	   when_ended := RTLEventCreate; 
	{$ENDIF}
	try
//writeln('#3' + IntToStr(Integer(Pointer(protect_take_yield))));
//writeln('#3Y');
		{$IFDEF USE_PROTECT_TAKE_YIELD}
		protect_take_yield.Enter();
		{$ENDIF}
//writeln('#3Z');
		try
//writeln('#3A');
			X := take_single_object(ref_C_Thread.hard_link, true, false);
//writeln('#3B');
		finally
			{$IFDEF USE_PROTECT_TAKE_YIELD}
			protect_take_yield.Leave();
			{$ENDIF}
//writeln('#3E');
		end;
		receive_single_object(X);
//writeln('#3C');
			//ref_controller_ := ref_C_Thread.F_controller_;
			//here X.Count == 0	\ здесь должно быть X.Count == 0
		X.Count := X.Count + 2;
//writeln('#3D');
//writeln('#4');
		
		//thread_started.SetEvent();
		
		//without this statement, freezing	\без этого опратора, виснет
        {$IFDEF FPC}
        {$ELSE}
		//Sleep(1); -----------------------------------------------------
		{$ENDIF}
		//Sleep(0); -- also does not work!!!\- так же не работает!!!
		
		//call executing the user defined			\вызываем пользовательскую
		//function which is running in the thread	\функцию для исполнения нити
		
		//controller.F_Running := true;
		C_Thread(X.Obj).F_running := true;
		//writeln('...calling M_execute');
		C_Thread(X.Obj).M_execute();
        {$IFDEF FPC}
        Sleep(0);
        {$ELSE}
        Sleep(0); //+++++++++++++++++++++++++++++++++++++++++++++++++++++
        {$ENDIF}
		C_Thread(X.Obj).F_running := false;
		
		//return back the ref_C_Thread object	\возвращаем назад сам объект
		//itself onto the side of the parent	\нити ref_C_Thread, в родитель-
		//thread								\скую нить
		{$IFDEF USE_PROTECT_TAKE_YIELD}
		if protect_take_yield <> nil then
		begin
			protect_take_yield.Enter();
			try
		{$ENDIF}
				if (X.Count = 2) then
			 	begin
			 		// still Count -= 2 --> 0		\т.к. Count -= 2 --> 0,
			 		// X is returned automatically	\то возврат будет автоматический
			 		//writeln('count==2 ==> X.Ref_dec_hard');
			 		X.Ref_dec_hard();
			 	end
			 	else 
			 	begin
			 		//writeln('count<>2 ==> yield_single_object(X)');
			 		yield_single_object(X);
			 	end;
			 	//writeln('--');
		{$IFDEF USE_PROTECT_TAKE_YIELD}
			finally
				protect_take_yield.Leave();
			end;
		end;
		{$ENDIF}
	finally
		dec(Total_count_running_threads);
		{$IFDEF FPC}
		//writeln('set rtl event');
		RtlEventSetEvent(when_ended);
		//writeln('rtl event set OK');
		{$ENDIF}
	end;
	finished := true;
	//writeln('...finished');
end;
	
//_______________________________________________________
// {Thread}.Take --> Thread_take_objects --> take_objects
// taking objects from the parent	\передача объектов от родительской нити
// thread to the running thread		\к исполняющейся дочерней нити
//[diagram:Object_isolation]
procedure TAL4_thread.take_objects(A: DynAObj; Together: Boolean);
var i: Integer;
	Ai: Ref_obj;
begin
	{$IFDEF USE_PROTECT_TAKE_YIELD}
	protect_take_yield.Enter();
	{$ENDIF}
	try
		for i := 0 to A.Count()-1 do
		begin
			Ai := A.GetObjects(i);
			if Ai.Obj.Is_NONE_object then continue;
			take_single_object(Ai, Together, true);
		end;
		if queue_input_objects.Count > 0 then
		begin
			//there are received objects:	\есть принятые объекты в очереди
			//set the flag to end waiting	\установка флага для прекращения
			//receiving object event		\ожидания принятых объектов
			if data_arrive = nil then
			begin
				{$IFDEF KOL}
				new(data_arrive, Create);
				{$ELSE}
				data_arrive := TSimpleEvent.Create();
				{$ENDIF}
			end;
			data_arrive.SetEvent();
		end;
	finally
		{$IFDEF USE_PROTECT_TAKE_YIELD}
		protect_take_yield.Leave();
		{$ENDIF}
	end;
end;
	
//____________________________________________________________________
//take a single object to the thread	\передача единичного объекта в
//started (from the parent thread)		\запущенную подчиненную нить
function TAL4_thread.take_single_object(Ai: Ref_obj;
	Together, add_to_queue: Boolean): Ref_obj;
var Z: AL4_object;
	h, w, W_new: Ref_obj;
	H_new: Ref_obj_foreign;
	c_fields: Integer;
	j, k, last: Integer;
	is_weak: Boolean;
	f_name: String;
	Bk: Ref_obj;
begin
	if Ai = nil then Exit;
	//writeln('take_single_object :1');
	//_______________________________________________
	// separate hard_link	\отделение жесткой 
	//[diagram:Object_separate1]
	Z := Ai.Obj;
	
	h := Z.hard_link;
	{$IFDEF KOL} H_new := new_Ref_obj_foreign(Z, 0);
	{$ELSE}		 H_new := new_Ref_obj_foreign(Z, 0);
	{$ENDIF}
	 
	Z.hard_link := H_new;
	H_new.Parent_ref := h;
	if thread <> nil then
	   H_new.Thread_handle := thread.ThreadID;
	
	// add local reference to the queue \добавляется в очередь принятия
	if add_to_queue then
		queue_input_objects.Add(H_new);
	RESULT := H_new;
	
	// previous hard_link redirect to NONE	\прежний hard_link -> на NONE
	h.Migrated_ref := H_new;
	h.Obj := Z.NONE_obj_instance().Obj;
	//[diagram:Object_separate2]

	//_______________________________________________
	// separate weak_link	\отделение слабой ссылки
	w := Z.weak_link;
	W_new := new_Ref_obj_foreign(Z, 1);
	
	Z.weak_link := W_new; 
	W_new.Parent_ref := w;
	if thread <> nil then
	   W_new.Thread_handle := thread.ThreadID;
	
	// previous weak_link redirect to NONE	\прежний weak_link -> на NONE
	w.Migrated_ref := W_new;
	w.Obj := h.Obj;
	
	// look at all the object fields	\просмотр объектных полей объекта
	//of the object migrating			\мигрирующего в нить при передаче
	c_fields := Ai.Obj.RTTI_object_field_count();
	for j := 0 to c_fields-1 do
	begin
		k := RTTI_type_kind(Ai.Obj.RTTI_object_info_field(j, 0));
		if k <> 3 then continue;
			
		is_weak := false;
		if Together then
		begin
			f_name := Ai.Obj.RTTI_object_field_name(j);
			is_weak := f_name[Length(f_name)-1] = '_';
		end;				

		last := 1;
		if Ai.Obj.RTTI_object_info_field(j, 1) > 0 then
			last := Ai.Obj.RTTI_object_info_field(j, 4);
			
		if is_weak or not Together then
		begin
			//if the field is an array,	\для поля-массива, поэлементная
			//separate its items		\обработка
			for k := 0 to last-1 do
			begin
				Bk := Ai.Obj.RTTI_object_get_object(j, k);
				if (Bk.Count = 2) and not is_weak then
					//there is only a single	\есть только 1 жесткая ссылка
					//reference to Bk from Ai,	\на Bk из Ai, взять его с
					//take it together anyway	\собой при переносе в нить
					take_single_object(Bk, false, add_to_queue)
				else
				begin
					Bk := break_object_ref(Bk);
					Ai.Obj.RTTI_object_set_object(j, Bk, k);
				end;
			end;
		end
		else // Together
		begin
			//migrate all the objects,	\ режим отправки всех подчиненных
			//by the fields which are	\ объектов, на которые есть жесткие
			//hard links to the objects	\ ссылки из полей отпраяленного объекта
			for k := 0 to last-1 do
			begin
				Bk := Ai.Obj.RTTI_object_get_object(j, k);
				if Bk.Obj = nil then continue;
				if Bk.Obj.Is_NONE_object then continue;
				take_single_object(Bk, Together, add_to_queue);
			end;
		end;
	end;
end;
	
//_____________________________________________________________________
// break a single link to the		\разрыв единичной ссылки на объект,
// object left in previous thread	\который остается в адресном пространстве
// address space					\исходной нити
function TAL4_thread.break_object_ref(X: Ref_obj): Ref_obj;
var X_new: Ref_obj;
begin
	X_new := new_Ref_obj(X.Obj.NONE_obj_instance().Obj, -1);
	X_new.Thread_handle := thread.ThreadID;
	X_new.Migrated_ref := X;
	
	//return new reference to NONE	\возвращается новая ссылка на NONE,
	//replacing the broken link		\которая замещает разорванную ссылку
	Result := X_new;
end;
	
//____________________________________________________
// receive objects --> \приемка отправленных объектов 
procedure TAL4_thread.receive_objects(A: DynAObj; Wait: Boolean);
var wait_and_try_again: Boolean;
	i: Integer;
	Di: Ref_obj;
begin
	wait_and_try_again := false;
	{$IFDEF USE_PROTECT_TAKE_YIELD}
	protect_take_yield.Enter();
	{$ENDIF}
	try
		if (queue_input_objects.Count = 0) and not Wait then Exit;
		if (queue_input_objects.Count = 0) then
		begin
			wait_and_try_again := true;
		end
		else
		for i := 0 to queue_input_objects.Count-1 do
		begin
			Di := Ref_obj(queue_input_objects 
				{$IFDEF KOL} .Items 
				{$ENDIF} [i]);
			A.Add(MAXINT, Di);
			receive_single_object(Di);
		end;
	finally
		{$IFDEF USE_PROTECT_TAKE_YIELD}
		protect_take_yield.Leave();
		{$ENDIF}
	end;
	if not wait_and_try_again then Exit; 
	//second attempt, after wait	\повторная попытка, после ожидания
	{$IFDEF USE_PROTECT_TAKE_YIELD}
	protect_take_yield.Enter();
	{$ENDIF}
	try
		//waiting	\ожидание
		if data_arrive <> nil then
			data_arrive.WaitFor(WAIT_INFINITE);
		for i := 0 to queue_input_objects.Count-1 do 
		begin
			Di := Ref_obj(queue_input_objects 
				{$IFDEF KOL}.Items 
				{$ENDIF} [i]);
			A.Add(MAXINT, Di);
			receive_single_object(Di);
		end;
	finally
		{$IFDEF USE_PROTECT_TAKE_YIELD}
		protect_take_yield.Leave();
		{$ENDIF}
	end;
end;
	
//_____________________________________________________
//receiving a single object	\приемка единичного объекта
procedure TAL4_thread.receive_single_object(Di: Ref_obj);
var c_fields: Integer;
	j, k, last: Integer;
	is_weak: Boolean;
	f_name: String;
	Bk: Ref_obj;
begin
	//look at all the object fields of Di	\см. на все объектные поля Di
	c_fields := Di.Obj.RTTI_object_field_count();
	for j := 0 to c_fields-1 do
	begin
		if RTTI_type_kind(Di.Obj.RTTI_object_info_field(j, 0)) <> 3 then
			continue;
			
		is_weak := false;
		f_name := Di.Obj.RTTI_object_field_name(j);
		is_weak := f_name[Length(f_name)-1] = '_';
		
		last := 0;
		if Di.Obj.RTTI_object_info_field(j, 0) > 0 then
			last := Di.Obj.RTTI_object_info_field(j, 4);

		for k := 0 to last-1 do
		begin
			Bk := Di.Obj.RTTI_object_get_object(j, k);
			Bk := rejoin_object_ref(Di, Bk);
			Di.Obj.RTTI_object_set_object(j, Bk, k);
			if not is_weak and not Bk.Obj.Is_NONE_object then
				receive_single_object(Bk);
		end;
	end;
end;
	
//___________________________________________________________________
//rejoin a single object migrated	\восстановление ссылок из одного объекта
//to the thread resting a broken	\в случаях, когда они указывают на
//link in case when it refers to	\объекты, находящиеся в той же нити 
//an object also belonging to the	\в результате отправки нескольких объектов
//same thread (together or separately)	\(вместе или последовательно)
function TAL4_thread.rejoin_object_ref(S_ref_from_dummy, R: Ref_obj): Ref_obj;
begin
	if (R.Obj.Is_NONE_object and
		(R.Migrated_ref <> nil) and
		(R.Migrated_ref.Parent_ref = R) and
		(R.Migrated_ref.Thread_handle = thread.ThreadID)) then
		//[diagram:Object_separate2]
	begin
		RESULT := R.Migrated_ref;
		R.Free;
		Exit;
		//[diagram:Object_rejoin]
	end;
	RESULt := R;
end;
	
//______________________________________________________
// yield_objects forced	\возврат объектов принудительный
procedure TAL4_thread.yield_objects(A: DynAObj);
var i: Integer;
	Ai, n: Ref_obj;
begin
	 for i := 0 to A.Count()-1 do
	 begin
	 	Ai := A.GetObjects(i);
		if Ai.Obj.hard_link.Parent_ref = nil then
			//it is not possible to yield	\нельзя возвратить объект,
			//an object, which was created	\созданный в этой нити, в отличии
			//in the current thread rather	\от переданного из родительской
			//then taken from the parent	\нити
			continue;	 	

	 	if Ai.Obj.hard_link.Count = 2 then
	 	begin
	 		// still Count -= 2 --> 0		\т.к. Count -= 2 --> 0,
	 		// Ai is returned automatically	\то возврат будет автоматический
	 		A.SetObjects(i, Ai.Obj.NONE_obj_instance());
	 		continue;
	 	end;
	 	
	 	n := Ai.Obj.NONE_obj_instance();
	 	yield_single_object(Ai);
	 	
	 	// actual yielding is performed here	\реально передача происходит
	 	// still an intermediate Ref_obj is		\здесь, т.к. на самом деле
	 	// actually of class Ref_obj_foreign	\промежуточная ссылка класса
	 	// and after setting Count-=2 --> 0,	\Ref_obj_foreign и при обну-
	 	// it performs re-linking of the object	\лении счетчика запускается
	 	// referencing back to the source thread\отправка объекта в исходную
	 	//										\нить
		A.SetObjects(i, n);
	 end;
end;
	
//__________________________________________________
// yield a single object	\ возврат одного объекта
procedure TAL4_thread.yield_single_object(Ai: Ref_obj);
var h, w: Ref_obj;
	f: Ref_obj_foreign;
	r: Ref_obj;
	Z: AL4_object;
begin
 	//[diagram:Object_separate2]
	h := Ai.Obj.hard_link;
	Z := Ai.Obj;
	
	{$IFDEF KOL} //f := new_Ref_obj_foreign(Ai.Obj, 2);
				 //Z.hard_link := f;
			Z.hard_link := new_Ref_obj_foreign(Z, 2);
	{$ELSE}	Z.hard_link := new_Ref_obj_foreign(Z, 2);
	{$ENDIF}
	Z.hard_link.Parent_ref := h.Parent_ref;
	if h.Parent_ref <> nil then
	   h.Parent_ref.Migrated_ref := Z.hard_link;
	h.Obj := Z.NONE_obj_instance().Obj;
	h.Parent_ref := nil;
	Dec(h.Count, 2);
	//[diagram:Object_yield_forced]
	//[diagram:Object_yield_forced2]
	
	w := Z.weak_link;
	
	{$IFDEF KOL} //r := new_Ref_obj(Z, 1);
				 //Z.weak_link := r;
			Z.weak_link := new_Ref_obj(Z, 1);
	{$ELSE} Z.weak_link := new_Ref_obj(Z, 1);
	{$ENDIF}
	Z.weak_link.Parent_ref := w.Parent_ref;
	w.Parent_ref.Migrated_ref := Z.weak_link;
	w.Obj := Z.NONE_obj_instance().Obj;
	w.Parent_ref := nil;
	
	Z.hard_link.Ref_dec_hard();
end;

//--------------------------------------------------------------------------
//redefining Ref_dec_hard, we use it	\переопределяем Ref_dec_hard, вместо
//not to destroy the object but to		\уничтожения объекта отправляем его
//return it to the sending (master)		\назад к нити-отправителю, когда его
//thread when its Count becomes == 0	\счетчик Count становится равен 0
procedure TRef_obj_foreign.Ref_dec_hard();
var w, h: Ref_obj;
	Z: AL4_object;
begin
	//writeln('called redefined Ref_dec_hard');
    Obj.hard_link.Count := Obj.hard_link.Count - 2;
    if Obj.hard_link.Count = 0 then
    begin
    	//writeln('start migrating obj_ect');
    	if Obj.hard_link.Parent_ref <> nil then
    	begin
    		Z := Obj;
    	
			//still this is a migrant reference,	\ это все еще ссылка на
			//we just move it back to				\ мигрировавший объект,
			//the parent thread now					\ возвратим его домой
			w := Obj.weak_link;
			Obj.weak_link := Obj.weak_link.Parent_ref;
			Obj.weak_link.Obj := Obj;
			Obj.weak_link.Migrated_ref := nil;
			
			//[diagram:Object_ref_dec_hard1]
			h := Obj.hard_link;
			Obj.hard_link := Obj.hard_link.Parent_ref;
			Obj.hard_link.Obj := Obj;
			Obj.hard_link.Migrated_ref := nil;
			
			h.Obj := Obj.NONE_obj_instance().Obj;
			w.Obj := h.Obj;
			//[diagram:Object_ref_dec_hard2]
			
			//writeln('call rejoin_fields');
			rejoin_fields(Z.hard_link);
			
			if Obj.hard_link.Count = 0 then
			begin
				//the object was created as		\ объект был создан как
				//an owned, and while it was	\ дочерний, и пока он
				//abroad its parent has died,	\ отсутствовал дома, его
				//so we should now rip the		\ хозяин умер, так что
				//returned object with him		\ он тоже должен умереть
				
				Obj.hard_link.Count := Obj.hard_link.Count + 2;
				inherited Ref_dec_hard();
			end;
			// finally, free the Ref_obj
			// which is not more referenced
			//writeln('h.free');
			h.Free;
    	end
    	else
    	begin
    		//writeln('Parent_ref == nil ==> Count+=2 & inherited Ref_dec_hard');
    		Obj.hard_link.Count := Obj.hard_link.Count + 2;
    		inherited Ref_dec_hard();
    	end;
    end;
end;
    
// handling fields of the X object	\ обработка полей объекта X
// returning home					\ при возвращении его домой
procedure TRef_obj_foreign.rejoin_fields(X: Ref_obj);
var c_fields: Integer;
	is_weak: Boolean;
	f_name: String;
	last, k, j, type_index: Integer;
	Bk: Ref_obj;
begin
	c_fields := X.Obj.RTTI_object_field_count();
	for j := 0 to c_fields-1 do
	begin
		type_index := X.Obj.RTTI_object_info_field(j, 0); 
		if type_index = 0 then continue;
		if RTTI_type_kind(type_index) <> 3 then continue; 
		// only object fields \ интересуют только объектные поля
		
		is_weak := false;
		f_name := X.Obj.RTTI_object_field_name(j);
		is_weak := f_name[Length(f_name)] = '_';

		last := 1;
		if X.Obj.RTTI_object_info_field(j, 0) > 0 then
			last := X.Obj.RTTI_object_info_field(j, 4);
		
		//........... what if field				\что если поле было NONE при
		//was NONE but assigned in the thread ?	\отправке, но присвоено пока
		//see below.							\находилось в нити: см. ниже
		if is_weak then
		begin
			for k := 0 to last-1 do
			begin
				try
					Bk := X.Obj.RTTI_object_get_object(j, k);
					Bk := rejoin_object_ref(X, Bk, false);
					X.Obj.RTTI_object_set_object(j, Bk, k);
				except
				end;
			end;
		end
		else
		begin
			for k := 0 to last-1 do
			begin
				try
					Bk := X.Obj.RTTI_object_get_object(j, k);
					Bk := rejoin_object_ref(X, Bk, true);
					X.Obj.RTTI_object_set_object(j, Bk, k);
					if not Bk.Obj.Is_NONE_object then
						rejoin_fields(Bk);
				except
				end;
			end;
		end;
	end;
end;
	
//rejoin a single object migrated\восстановление ссылок из одного объ-
//to the thread resting a broken \екта, когда они указывают на объ-
//link in case when it refers to \екты, находящиеся в той же нити 
//an object also belonging to the\в результате отправки нескольких
//same thread (together or separately)\объектов (вместе или последо-
//									  \вательно)
function TRef_obj_foreign.rejoin_object_ref(
	S_ref_from_dummy: Ref_obj; R: Ref_obj; is_hard_link: Boolean): Ref_obj;
var m: Ref_obj;
begin
	if R.Obj.Is_NONE_object and
	   (R.Migrated_ref <> nil) and
	   (R.Migrated_ref.Parent_ref = R) then
	   //[diagram:rejoin_object_ref]
	begin
		R.Migrated_ref.Parent_ref := nil;
		RESULT := R.Migrated_ref;
		R.Free;
		Exit;
		//[diagram:rejoin_object_ref2] - after re-assign result to a field
	end;
	if not R.Obj.Is_NONE_object and
	   (R.Migrated_ref <> nil) and
	   (R.Migrated_ref.Parent_ref = R) then
	   //[diagram:rejoin_object_ref_changed] -- object was changed
	begin
		if not is_hard_link or (R.Count >= 4) then
		begin
			m := R.Migrated_ref;
			m.Parent_ref := nil;
			R.Migrated_ref := nil;
			R.Ref_dec_hard();
			RESULT := m;
			Exit;
		end;
		M := R.Migrated_ref;
		M.Parent_ref := nil;
		R.Migrated_ref := nil;
		M.Ref_dec_hard();
	end;
	RESULT := R;
end;

{$IFDEF KOL}
//----- implementation of TCriticalSection \ реализация TCriticalSection для KOL
constructor TCriticalSection.Create;
begin
	{$IFNDEF KOL} inherited; {$ENDIF}
	InitializeCriticalSection(FSection);
end;

destructor TCriticalSection.Destroy;
begin
	DeleteCriticalSection(FSection);
	inherited;
end;

procedure TCriticalSection.Enter;
begin
	EnterCriticalSection(FSection);
end;

procedure TCriticalSection.Leave;
begin
	LeaveCriticalSection(FSection);
end;

//------------- implementation of TSimpleEvent \ реализация TSimpleEvent для KOL
constructor TSimpleEvent.Create;
begin
	{$IFNDEF KOL} inherited; 
	{$ENDIF}
	FEvent := CreateEvent(nil, TRUE, false, '');
end;

destructor TSimpleEvent.Destroy;
begin
	CloseHandle(FEvent);
	inherited;
end;

procedure TSimpleEvent.SetEvent;
begin
	Windows.SetEvent(FEvent);
end;

procedure TSimpleEvent.ResetEvent;
begin
	Windows.ResetEvent(FEvent);
end;

procedure TSimpleEvent.WaitFor(TimeOut: Cardinal);
begin
	WaitForSingleObject(FEvent, TimeOut);
end;
{$ENDIF}

{$IFDEF KOL}

	{$IFDEF PROTECT_DYNAOBJ_DISCARD}
	procedure dynaobj_discard_enter;
	begin
		protect_dynaobj_discard.Enter;
	end;
	procedure dynaobj_discard_leave;
	begin
		protect_dynaobj_discard.Leave;
	end;
	{$ENDIF}
	
{$ELSE}

constructor TExecute_thread.Create(
	t: TAL4_thread);
begin
	inherited Create(true);
	AL4_thread := t;
	Resume();
end;

destructor TExecute_thread.Destroy;
begin
	{$IFDEF KOL}
	Free_And_Nil(AL4_thread);
	{$ELSE}
	 	{$IFDEF FPC}
	 	{$ELSE}
	 	{$ENDIF}
	FreeAndNil(AL4_thread);
	{$ENDIF}
	inherited;
end;

procedure TExecute_thread.Execute;
begin
	AL4_thread.Execute();
end;

function TExecute_thread.Is_terminated
	: Boolean;
begin
	Result := Terminated;
end;

{$ENDIF}


initialization
	IsMultiThread := true;

	{$IFDEF LINUX} try {$ENDIF}
	mainThreadId := GetCurrentThreadId();
	{$IFDEF LINUX} except end; {$ENDIF}
	 {$IFDEF USE_PROTECT_TAKE_YIELD}
     	{$IFDEF KOL}
     	new(protect_take_yield, Create);
     	{$ELSE}
     	protect_take_yield := {$IFDEF FPC}syncobjs.{$ENDIF}
     			TCriticalSection.Create();
     	{$ENDIF}
     {$ENDIF}
	
	 {$IFDEF USE_PROTECT_ALLOC_THREAD}
     	{$IFDEF KOL}
     	new(protect_alloc_thread, Create);
     	{$ELSE}
     	protect_alloc_thread := {$IFDEF FPC}syncobjs.{$ENDIF}
     			TCriticalSection.Create();
     	{$ENDIF}
     {$ENDIF}
     
     {$IFDEF KOL}
     	{$IFDEF PROTECT_DYNAOBJ_DISCARD}
     	//new(protect_dynaobj_discard, Create);
     	protect_dynaobj_discard :=  protect_alloc_thread;
        fun_dynaobj_discard_enter := @dynaobj_discard_enter;
        fun_dynaobj_discard_leave := @dynaobj_discard_leave;
     	{$ENDIF}
     {$ENDIF}
     
     //{$IFDEF FPC}
     //   lock_thread := RTLEventCreate;
     //{$ELSE}
     //   lock_thread := CreateMutex(nil, false, nil);
     //{$ENDIF}
     
finalization
	{$IFDEF USE_PROTECT_TAKE_YIELD}
	protect_take_yield.Free;
	protect_take_yield := nil;
	{$ENDIF}

	{$IFDEF USE_PROTECT_ALLOC_THREAD}
	protect_alloc_thread.Free;
	protect_alloc_thread := nil;
	{$ENDIF}
	
	{$IFDEF KOL}
     	{$IFDEF PROTECT_DYNAOBJ_DISCARD}
     	//fun_dynaobj_discard_enter := nil; 
     	//fun_dynaobj_discard_leave := nil; 
     	//protect_dynaobj_discard.Free; 
     	protect_dynaobj_discard := nil; 
     	{$ENDIF}
     {$ENDIF}
	
    //{$IFDEF FPC}
    //    RTLEventDestroy(lock_thread);
    //{$ELSE}
    //    CloseHandle(lock_thread);
    //{$ENDIF}

(*
/*

END
*/
*)

end.

{

function TObj.RefDec: Integer;
var P: Pointer;
begin
  Result := 0; // stop Delphi alerting the Warning
  if  @ Self = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$IFDEF DEBUG_OBJINDEX}
  RefDec_of_obj := fObjIndex;
  if  (fObjIndex = 253) then
  asm nop end;
  {$ENDIF}
  //Dec( fRefCount, 2 );
  P := @fRefCount;
  asm
      MOV   EDX, [P]
      MOV   EAX,-2
 LOCK XADD  [EDX],EAX
  end;
  {$IFDEF OLD_REFCOUNT}
  if  (fRefCount < 0) and LongBool(fRefCount and 1) then
      Destroy;
  {$ELSE}
  if  fRefCount < 0 then
      Destroy;
  {$ENDIF}
end;

procedure TObj.RefInc;
var P: Pointer;
begin
  //Inc( fRefCount, 2 );
  P := @fRefCount;
  asm
      MOV   EDX, [P]
      MOV   EAX, 2
 LOCK XADD  [EDX],EAX
  end;
end;

}
