(* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)

MODULE Objects;   (** AUTHOR "pjm"; PURPOSE "Active object runtime support"; *)

(*	2006.06.20	g.f.	Unix port  *)

IMPORT S := SYSTEM, Trace, Glue, Unix, Machine, Heaps, Modules;

CONST

	(* Process flags, meaningless in Unix ports !!! *)
	PleaseHalt* = 10;		(* Process requested to Halt itself soon *)
	Unbreakable*= 11;		(* FINALLY shall not catch HALT exception (PleaseHalt is also set) *)
	SelfTermination*=12;	(* Indicates the process has requested to terminate ifself (PleaseHalt is also set) *)
	Preempted* = 27;		(* Has been preempted. *)
	Resistant* = 28;			(* Can only be destroyed by itself *)


	MinPriority* = Unix.ThreadLow;
	Low* = Unix.ThreadLow + 1;
	Normal* = Unix.ThreadNormal;
	High* = Unix.ThreadHigh - 2;
	GCPriority* = Unix.ThreadHigh - 1;
	Realtime* = Unix.ThreadHigh;

	(* Process flag defined by compiler in OPC.CallRecBody *)
	Restart* = 0;	(* Restart/Destroy process on exception *)

	(* Process modes (in UnixAos Running means Running or Ready!) *)
	Unknown* = 0;  Ready* = 1;  Running* = 2;  AwaitingLock* = 3;
	AwaitingCond* = 4;  AwaitingEvent* = 5;  Terminated* = 6;

	Second* = 1000;	(* frequency of ticks increments in Hz *)

	DefaultStacksize = 128*1024;
	
	AdrSize = S.SIZEOF( S.ADDRESS )


VAR
	
	timerActivity: TimerActivity;
	timers: Timer;  
	timerListMutex: Unix.Mutex_t;
	
	finalizerCaller: FinalizerCaller;
	
	processes-: Process;	(*!  Anchor of all instantiated threads in system *)
	processListMutex: Unix.Mutex_t;
	
	createmtx: Unix.Mutex_t;
	startProcess: Unix.Mutex_t;
	childrunning: Unix.Condition_t;
	newProcess: Process;
	nid: Unix.Thread_t;	
	nextPID: LONGINT;
	
	gcFinished: Unix.Condition_t; igc: Unix.Mutex_t;
	collect: BOOLEAN;
	
	stacksize: LONGINT;		(* stack size of active objects, adjustable by boot parameter *)
	
	(* the dummy parameters assure proper stack alignment when compiled with 
		option "\A" or "--darwinHost" *)
	mtxInit: 		PROCEDURE {REALTIME, C}  ( dummy: LONGINT ): Unix.Mutex_t;
	mtxDestroy: 	PROCEDURE {REALTIME, C}  ( mtx: Unix.Mutex_t );
	mtxLock: 		PROCEDURE {REALTIME, C}  ( mtx: Unix.Mutex_t );
	mtxUnlock:	 	PROCEDURE {REALTIME, C}  ( mtx: Unix.Mutex_t );

	conInit: 			PROCEDURE {REALTIME, C}  ( dummy: LONGINT ): Unix.Condition_t;
	conDestroy: 	PROCEDURE {REALTIME, C}  ( cond: Unix.Condition_t );
	conWait: 		PROCEDURE {REALTIME, C}  ( cond: Unix.Condition_t;  mtx: Unix.Mutex_t );
	conSignal: 		PROCEDURE {REALTIME, C}  ( cond: Unix.Condition_t );
	
	thrStart: 		PROCEDURE {REALTIME, C} ( p: PROCEDURE;  stackLen: LONGINT ): Unix.Thread_t;
	thrThis: 			PROCEDURE {REALTIME, C} ( dummy: LONGINT ): Unix.Thread_t;
	thrSleep: 		PROCEDURE {REALTIME, C} ( ms: LONGINT );
	thrYield: 		PROCEDURE {REALTIME, C} ( dummy: LONGINT );
	thrExit: 			PROCEDURE {REALTIME, C} ( dummy: LONGINT );
	thrSuspend: 	PROCEDURE {REALTIME, C} ( t: Unix.Thread_t );
	thrResume: 		PROCEDURE {REALTIME, C} ( t: Unix.Thread_t );
	thrSetPriority: 	PROCEDURE {REALTIME, C} ( t: Unix.Thread_t;  prio: LONGINT );
	thrGetPriority: 	PROCEDURE {REALTIME, C} ( t: Unix.Thread_t ): LONGINT;
	thrKill: 			PROCEDURE {REALTIME, C} ( t: Unix.Thread_t );
	
	

TYPE
	Address = S.ADDRESS;

	CpuCyclesArray* = ARRAY Machine.MaxCPU OF HUGEINT;

	ProtectedObject = POINTER TO RECORD END;

	ObjectHeader = Heaps.ProtRecBlock;

	ProcessQueue = Heaps.ProcessQueue;

	EventHandler* = PROCEDURE  {DELEGATE};



	Timer* =  OBJECT
	VAR
		next: Timer;
		trigger: LONGINT;
		handler: EventHandler
	END Timer;
			
	TimerActivity = OBJECT		
	VAR 
		t, r: Timer;  h: EventHandler;  restart: BOOLEAN; ticks: LONGINT;
		
		PROCEDURE Notify;
		BEGIN {EXCLUSIVE}
			ticks := Machine.ticks
		END Notify;
		
		PROCEDURE Restart;
		BEGIN {EXCLUSIVE}
			restart := TRUE
		END Restart;
		
	BEGIN{ACTIVE, SAFE, PRIORITY(High)}
		restart := FALSE;
		LOOP
			t := timers;
			IF t # NIL THEN				
				h := NIL;  r := NIL;
				BEGIN {EXCLUSIVE}
					AWAIT( (ticks >= t.trigger) OR restart );  restart := FALSE;
					IF ticks >= t.trigger THEN
						h := t.handler;  r := t
					END
				END;
				IF r # NIL THEN  Remove( r )  END;
				IF h # NIL THEN  (* not canceled *) h  END
			ELSE				
				BEGIN{EXCLUSIVE}
					AWAIT( restart );  restart := FALSE;
				END
			END
		END
	END TimerActivity;



	FinalizedCollection* = OBJECT (* base type for collection, extended in Kernel.Mod *)
		PROCEDURE RemoveAll*(obj: ANY); (** abstract *)
		BEGIN HALT(301) END RemoveAll;
	END FinalizedCollection;

	FinalizerNode* = POINTER TO RECORD (Heaps.FinalizerNode)
		c*: FinalizedCollection (* base type for collection containing object *)
	END;

		
	FinalizerCaller = OBJECT	(* separate active object that calls finalizers *)
		VAR n: Heaps.FinalizerNode; activated: BOOLEAN;

		PROCEDURE &Init;
		BEGIN
			activated := FALSE
		END Init;

		PROCEDURE Activate;
		BEGIN {EXCLUSIVE}
			activated := TRUE
		END Activate;

	BEGIN {ACTIVE, SAFE, PRIORITY(High)}
		LOOP
			BEGIN {EXCLUSIVE}
				AWAIT(activated); activated := FALSE
			END;
			LOOP
				n := Heaps.GetFinalizer();
				IF n = NIL THEN EXIT END;
				IF n IS FinalizerNode THEN
					n(FinalizerNode).c.RemoveAll(n.objStrong)	(* remove it if it is not removed yet *)
				END;
				IF n.finalizer # NIL THEN
					n.finalizer(n.objStrong)	(* may acquire locks *)
				END
			END;
			Machine.Release( Machine.GC )
		END
	END FinalizerCaller;
	


	Body = PROCEDURE ( self: ProtectedObject );
	Condition = PROCEDURE ( slink: Address ): BOOLEAN;
	
	Process* = OBJECT (Heaps.RootObject)
	VAR
		thrId			: Unix.Thread_t;
		processLink-	: Process;	(* next in list of all processes *)
		stackBottom-	: Address;
		SP-				: Address;	(* SP value at last NEW *)
		id-				: LONGINT;
		proc			: Body;
		mode-			: LONGINT;
		flags-			: SET;
		priority-		: LONGINT;	(* only used if Aos is running SUID root *)
				
		succ			: Process;   		  	(* in ProcessQueue *)
		obj-			: ProtectedObject;	(* associated active object *)
		condition-		: Condition;   		(* awaited process' condition *)
		condFP-		: Address;			(* awaited process' condition's context *)
		cond			: Unix.Condition_t;	(* gets signaled when condition yields true *)
		waitingOn-		: ProtectedObject;
		procID-			: LONGINT;			(* processor ID where running, not used in UnixAos *)
		state-			: Machine.State;		(* not used in UnixAos! *)
		state0	: ARRAY 2048 OF CHAR;		(* thread state at body start, used for restart after trap *)
					
				
		PROCEDURE FindRoots*;
		VAR sp, ptr: Address;
		BEGIN
			IF mode # Terminated THEN
				sp := SP;
				WHILE Machine.LessThan(sp, stackBottom) DO  
					S.GET( sp, ptr );  
					IF (ptr # 0) & (ptr MOD 8 = 0) THEN  Heaps.AddCandidate( ptr )  END;  
					INC( sp, AdrSize )  
				END;
			END;
			Heaps.Mark( processLink ) 
		END FindRoots;
				
		PROCEDURE Cancel;
		VAR pt, t: Process;  kt: Unix.Thread_t;
		BEGIN
			IF SELF = CurrentProcess() THEN  Exit
			ELSE
				Machine.Acquire( Machine.X11 );  (* let the thread to be killed first finish its last I/O, if any *)
				mtxLock( processListMutex );
					pt := NIL; t := processes;  kt := 0;
					WHILE (t # NIL ) & (t # SELF) DO  pt := t;  t := t.processLink  END;
					IF t = SELF THEN
						kt := thrId;
						IF pt = NIL THEN  processes := t.processLink  ELSE  pt.processLink := t.processLink  END;
					END;
				mtxUnlock( processListMutex );
				IF kt # 0 THEN  thrKill( kt )  END;
				Machine.Release( Machine.X11 );
			END
		END Cancel;

		PROCEDURE GetPriority( ): LONGINT;
		BEGIN
			RETURN thrGetPriority( thrId ) 
		END GetPriority;

		PROCEDURE SetPriority( prio: LONGINT );
		VAR pr: LONGINT;
		BEGIN
			pr := max( Machine.prioLow, min( prio, Machine.prioHigh ) );
			thrSetPriority( thrId, pr );	(* works only if SUID root *)
			priority := GetPriority( )	
		END SetPriority;
				
				
		PROCEDURE & Initialize( obj: ProtectedObject;  bodyProc: Body;  prio: LONGINT; fl: SET; stacksize: LONGINT );
		BEGIN
			SELF.obj := obj;  condition := NIL;  cond := conInit(0);
			flags := fl;
			priority := prio;
			processLink := NIL;
			IF processes # NIL THEN
				newProcess := SELF;
				ASSERT( bodyProc # NIL );
				proc := bodyProc;  
				mtxLock( startProcess );
					nid := thrStart( BodyStarter, stacksize );
					conWait( childrunning, startProcess );
				mtxUnlock( startProcess );
				ASSERT( thrId = nid );				
				RegisterFinalizer( SELF, FinalizeProcess );
			ELSE 
				stackBottom := Glue.stackBottom;  
				SP := Machine.CurrentSP( );
				thrId := thrThis(0);
				id := 0;  nextPID := 1;
				processes := SELF;
				mode := Running;
			END;
		END Initialize;
				
	END Process;


	
	PROCEDURE BodyStarter;
	VAR p{UNTRACED}: Process;  res: LONGINT; prevBP: Address;
	BEGIN
		mtxLock( startProcess );
			p := newProcess;  newProcess := NIL;
			p.thrId := thrThis(0);  
			p.id := nextPID;  INC( nextPID );
			p.SP := Machine.CurrentSP(  );  
			p.stackBottom := Machine.CurrentBP( );
			S.GET( p.stackBottom, prevBP );
			S.PUT( prevBP, S.VAL( Address, 0 ) );	(* for terminating Reflection.StackTraceBack *)
			(* processes # NIL *)
			mtxLock( processListMutex );
				p.processLink := processes;  processes := p;
			mtxUnlock( processListMutex );
			conSignal( childrunning );
		mtxUnlock( startProcess );

		p.SetPriority( p.priority );
		IF Restart IN p.flags THEN
			res := Unix.sigsetjmp( S.ADR( p.state0[0] ), 1 );
		END;
		p.mode := Running;
		p.proc( p.obj );
		p.mode := Terminated;
		Exit
	END BodyStarter;




	(*---------------------   create,  lock,  await,  unlock   -------------------------*)
	
	PROCEDURE CreateProcess*( body: Body;  priority: LONGINT;  flags: SET;  obj: ProtectedObject );
	VAR p: Process;  hdr: ObjectHeader;
	BEGIN
		mtxLock( createmtx );
		S.GET( S.VAL( Address, obj ) + Heaps.HeapBlockOffset, hdr );
		InitObjectHeader( hdr );
		IF priority = 0 THEN  priority := Normal  END;
		NEW( p, obj, body, priority, flags, stacksize ) ;	(* execute BodyStarter as new (posix or solaris) thread *)
		mtxUnlock( createmtx );
		RegisterFinalizer( obj, FinalizeActiveObj )
	END CreateProcess;


	PROCEDURE Lock*( obj: ProtectedObject;  exclusive: BOOLEAN );
	VAR hdr: ObjectHeader;  p: Process;  
	BEGIN
		ASSERT( exclusive );   (* shared not implemented yet *)
		S.GET( S.VAL( Address, obj ) + Heaps.HeapBlockOffset, hdr );
		p := CurrentProcess();
		p.mode := AwaitingLock;
		IF hdr.mtx = 0 THEN
			(* module object *)
			InitObjectHeader( hdr );
			RegisterFinalizer( obj, FinalizeProtObject )
		END;
		mtxLock( hdr.mtx );
		WHILE hdr.lockedBy # NIL DO
			(* wait until threads with complied AWAIT conditions have left the monitor *)
			conWait( hdr.enter, hdr.mtx );
		END;
		p.mode := Running;  hdr.lockedBy := p;  p.waitingOn := NIL
	END Lock;

	PROCEDURE Await*( cond: Condition;  slink: Address;  obj: ProtectedObject;  flags: SET );
	VAR hdr: ObjectHeader;  p, c: Process;
	BEGIN
		IF 1 IN flags THEN  (* compiler did not generate IF *)
			IF cond( slink ) THEN  (* condition already true *)  RETURN  END
		END;
		S.GET( S.VAL( Address, obj ) + Heaps.HeapBlockOffset, hdr );  c := NIL;
		IF hdr.awaitingCond.head # NIL THEN  c := FindCondition( hdr.awaitingCond )  END;
		
		p := CurrentProcess();  p.succ := NIL;
		p.condition := cond;  p.condFP := slink;   
		p.waitingOn := obj;  p.mode := AwaitingCond;
		
		Put( hdr.awaitingCond, p );
		
		hdr.lockedBy := c;
		IF c # NIL THEN  conSignal( c.cond )  ELSE  conSignal( hdr.enter )  END;
		conWait( p.cond, hdr.mtx );   
		
		p.mode := Running;  hdr.lockedBy := p;  p.waitingOn := NIL
	END Await;

	PROCEDURE Unlock*( obj: ProtectedObject;  dummy: BOOLEAN );
	VAR hdr: ObjectHeader;  c: Process;
	BEGIN
		S.GET( S.VAL( Address, obj ) + Heaps.HeapBlockOffset, hdr );  c := NIL;
		IF hdr.awaitingCond.head # NIL THEN  c := FindCondition( hdr.awaitingCond )  END;
		
		hdr.lockedBy := c;
		IF c # NIL THEN  conSignal( c.cond )  ELSE  conSignal( hdr.enter )  END;
		mtxUnlock( hdr.mtx );
	END Unlock;
	
	
	
	PROCEDURE FindCondition( VAR q: ProcessQueue ): Process;
	VAR first, cand: Process;
	BEGIN
		Get( q, first );
		IF first.condition( first.condFP ) THEN  RETURN first  ELSE  Put( q, first )  END;
		WHILE q.head # first DO
			Get( q, cand );
			IF cand.condition( cand.condFP ) THEN  RETURN cand  ELSE  Put( q, cand )  END;
		END;
		RETURN NIL
	END FindCondition;

	PROCEDURE Get( VAR queue: ProcessQueue;  VAR new: Process );
	VAR t: Process;
	BEGIN
		t := queue.head(Process);
		IF t # NIL THEN
			IF t = queue.tail THEN  queue.head := NIL;  queue.tail := NIL
			ELSE  queue.head := t.succ;  t.succ := NIL
			END
		END;
		new := t
	END Get;

	PROCEDURE Put( VAR queue: ProcessQueue;  t: Process );
	BEGIN
		IF queue.head = NIL THEN  queue.head := t  ELSE  queue.tail(Process).succ := t  END;
		queue.tail := t
	END Put;
	
	
	
	(*-------------------------------------------------------------------------*)
	
	PROCEDURE Terminate*;
	BEGIN
		Exit
	END Terminate;

	PROCEDURE TerminateThis*( p: Process; unbreakable: BOOLEAN );
	BEGIN
		p.mode := Terminated;
		p.Cancel
	END TerminateThis;
	
	PROCEDURE SetPriority*( pri: LONGINT );		(* Set the current process' priority. *)
	VAR me: Process;
	BEGIN
		me := CurrentProcess();
		me.SetPriority( pri )
	END SetPriority;
	
	PROCEDURE Sleep*( ms: LONGINT );
	BEGIN
		thrSleep( ms )
	END Sleep;

	PROCEDURE Yield*;	(* Relinquish control. *)
	BEGIN
		thrYield(0);
	END Yield;
	
	(* Return current process. (DEPRECATED, use ActiveObject) *)
	PROCEDURE CurrentProcess*( ): Process;	
	VAR me: Unix.Thread_t;  p: Process;
	BEGIN
		me := thrThis(0);
		mtxLock( processListMutex );
		p := processes;
		WHILE (p # NIL ) & (p.thrId # me) DO  p := p.processLink  END;
		mtxUnlock( processListMutex );
		RETURN p
	END CurrentProcess;

	
	(* Return the active object currently executing. *)
	PROCEDURE ActiveObject*( ): ANY;		
	VAR p: Process;
	BEGIN
		p := CurrentProcess();
		RETURN p.obj 
	END ActiveObject;
	
	
	(* Return stack bottom of process. For compatibility WinAos/UnixAos/NativeAos  *)
	PROCEDURE GetStackBottom*(p: Process): LONGINT;
	BEGIN
		RETURN p.stackBottom
	END GetStackBottom;


	PROCEDURE GetProcessID*( ): LONGINT;
	VAR p: Process;
	BEGIN
		p := CurrentProcess();
		RETURN p.id;
	END GetProcessID;

	
	PROCEDURE GetCpuCycles*( process : Process; VAR cpuCycles: CpuCyclesArray; all: BOOLEAN );
	VAR i: LONGINT;
	BEGIN
		ASSERT( process # NIL );
		FOR i := 0 TO Machine.MaxCPU-1 DO  cpuCycles[i] := 0  END;
	END GetCpuCycles;
	
	
	
	(*-----------------------------------------------------------------------*)
	
	PROCEDURE min( a, b: LONGINT ): LONGINT;
	BEGIN
		IF a <= b THEN  RETURN a  ELSE  RETURN b  END
	END min;

	PROCEDURE max( a, b: LONGINT ): LONGINT;
	BEGIN
		IF a >= b THEN  RETURN a  ELSE  RETURN b  END
	END max;
	
	PROCEDURE InitObjectHeader( hdr: ObjectHeader );
	BEGIN
		hdr.mtx := mtxInit( 0 );  hdr.enter := conInit( 0 );  hdr.lockedBy := NIL;  
	END InitObjectHeader;
	
	PROCEDURE RegisterFinalizer( obj: ANY;  fin: Heaps.Finalizer );
	VAR n: Heaps.FinalizerNode;
	BEGIN
		NEW( n ); n.finalizer := fin;  Heaps.AddFinalizer( obj, n );
	END RegisterFinalizer;


	PROCEDURE FinalizeActiveObj( obj: ANY );
	VAR p: Process;
	BEGIN
		mtxLock( processListMutex );
			p := processes;
			WHILE (p # NIL) & (p.obj # obj) DO p := p.processLink  END;
		mtxUnlock( processListMutex );
		IF (p # NIL) & (p.obj = obj) THEN
			p.mode := Terminated;
			conDestroy( p.cond );
			p.cond := 0;
			FinalizeProtObject( obj );
			p.Cancel
		END;
	END FinalizeActiveObj;

	PROCEDURE FinalizeProtObject( obj: ANY );
	VAR hdr: ObjectHeader;
	BEGIN
		S.GET( S.VAL( Address, obj ) + Heaps.HeapBlockOffset, hdr );
		IF hdr.mtx # 0 THEN
			mtxDestroy( hdr.mtx );  hdr.mtx := 0
		END
	END FinalizeProtObject;


	PROCEDURE FinalizeProcess( obj: ANY );
	VAR p: Process;
	BEGIN
		p := obj(Process);
		IF p.cond # 0 THEN
			conDestroy( p.cond );  p.cond := 0
		END
	END FinalizeProcess;
	
	(* Terminate calling thread. *)
	PROCEDURE Exit;
	VAR prev, p, me: Process;
	BEGIN
		me := CurrentProcess();
		me.mode := Terminated;
		mtxLock( processListMutex );
			prev := NIL;  p := processes;
			WHILE (p # NIL ) & (p # me) DO  prev := p;  p := p.processLink  END;
			IF p = me THEN
				IF prev = NIL THEN  processes := p.processLink  ELSE  prev.processLink := p.processLink  END;
			END;
		mtxUnlock( processListMutex );
		thrExit(0)
	END Exit;

	PROCEDURE ExitTrap*;
	VAR p: Process;
	BEGIN
		p := CurrentProcess();
		(* restart the object body if it was given the SAFE flag *)
		IF Restart IN p.flags THEN
			Unix.siglongjmp( S.ADR( p.state0[0] ), 1 )
		END;
		Exit
	END ExitTrap;




	(*---------------------------- Timer --------------------------------*)


	PROCEDURE Remove( t: Timer );  (* remove timer from list of active timers *)
	VAR p, x: Timer;
	BEGIN
		mtxLock( timerListMutex ); 
		t.trigger := 0;  t.handler := NIL;
		IF timers # NIL THEN
			IF t = timers THEN  
				timers := t.next
			ELSE
				p := timers;  x := p.next;
				WHILE (x # NIL) &(x # t)  DO  p := x;  x := p.next  END;
				IF x = t THEN  p.next := t.next  END
			END;
			t.next := NIL
		END;
		mtxUnlock( timerListMutex )
	END Remove;
	
	PROCEDURE Insert( t: Timer );
	VAR  p, x: Timer;
	BEGIN
		mtxLock( timerListMutex ); 
		p := NIL;  x := timers;
		WHILE (x # NIL) &(x.trigger < t.trigger)  DO  p := x;  x := p.next  END;
		t.next := x;
		IF p = NIL THEN  timers := t  ELSE   p.next := t  END;
		mtxUnlock( timerListMutex )
	END Insert;

	PROCEDURE SetTimeout*( t: Timer;  h: EventHandler;  ms: LONGINT );
	BEGIN
		ASSERT(( t # NIL ) & ( h # NIL ));
		Remove( t );  
		IF ms < 1 THEN ms := 1 END;
		t.trigger := Machine.ticks + ms;  t.handler := h;
		Insert( t );
		timerActivity.Restart
	END SetTimeout;

	PROCEDURE SetTimeoutAt*( t: Timer;  h: EventHandler;  ms: LONGINT );
	BEGIN
		ASSERT(( t # NIL ) & ( h # NIL ));
		Remove( t );
		t.trigger := ms;  t.handler := h;
		Insert( t );
		timerActivity.Restart
	END SetTimeoutAt;

	PROCEDURE CancelTimeout*( t: Timer );
	BEGIN
		Remove( t )
	END CancelTimeout;



	(*--------------------  Garbage Collection  ------------------------------------*)
	
	PROCEDURE SuspendActivities;
	VAR t: Process;  me: Unix.Thread_t;
	BEGIN
		me := thrThis(0);
		t := processes;
		WHILE t # NIL DO
			IF t.thrId # me THEN  thrSuspend( t.thrId )  END;
			t := t.processLink
		END;
	END SuspendActivities;

	PROCEDURE ResumeActivities;
	VAR t: Process;  me: Unix.Thread_t;
	BEGIN
		me := thrThis(0);
		t := processes;
		WHILE t # NIL DO
			IF t.thrId # me THEN  thrResume( t.thrId )  END;
			t := t.processLink
		END;
	END ResumeActivities;
	

	PROCEDURE SaveSP;   (* save current SP for usage by the GC *)
	VAR me: Unix.Thread_t;  t: Process;
	BEGIN
		me := thrThis(0);  t := processes;
		WHILE (t # NIL ) & (t.thrId # me) DO  t := t.processLink  END;
		IF t # NIL THEN  t.SP := Machine.CurrentSP( )  END
	END SaveSP;
	
	
	PROCEDURE CollectGarbage;
	BEGIN
		SuspendActivities;
		Heaps.CollectGarbage( Modules.root );
		ResumeActivities;
		
		finalizerCaller.Activate	(* finalizers will be called by seperate process *)
	END CollectGarbage;
	
	
	
	PROCEDURE InvokeGC;
	BEGIN
		Machine.Acquire( Machine.GC ); (* gets released by FinalizerCaller *)
		Machine.Acquire( Machine.Heaps );
		collect := TRUE;
		conWait( gcFinished, igc );
		Machine.Release( Machine.Heaps )
	END InvokeGC;
	
	(*!   GCLoop gets called as last procedure in BootConsole (main thread). 
		The stack of the main thread is not limited by the  boot parameter 'StackSize' !!
	*)
	PROCEDURE GCLoop*;	(* Timer and GC activity *)
	VAR t0, t1, f: HUGEINT;  
	BEGIN
		f := Machine.mhz * 1000;
		t0 := Machine.GetTimer( );
		LOOP
			IF collect THEN  
				collect := FALSE;
				CollectGarbage;  
				conSignal( gcFinished );
			ELSE
				thrSleep( 10 ); 
			END;
			t1 := Machine.GetTimer();
			Machine.ticks := SHORT( (t1 - t0 ) DIV f );
			timerActivity.Notify
		END
	END GCLoop;	
	
	
	(*----------------------------- initialization ----------------------------------*)
	
	PROCEDURE StartTimerActivity;
	BEGIN
		timerListMutex := mtxInit(0);  timers := NIL;  
		NEW( timerActivity );
	END StartTimerActivity;


	PROCEDURE GetStacksize;
	VAR str: ARRAY  32 OF  CHAR;  i: LONGINT;
	BEGIN
		Machine.GetConfig( "StackSize", str );
		IF str = "" THEN  stacksize := DefaultStacksize
		ELSE
			i := 0;  stacksize := Machine.StrToInt( i, str );
			stacksize := stacksize * 1024;
		END;
		IF Glue.debug # {} THEN
			Trace.String( "Stacksize of active objects = " );
			Trace.Int( stacksize DIV 1024, 0 );  Trace.StringLn( "K"  )
		END;
	END GetStacksize;

	
	PROCEDURE Convert;
	VAR p: Process;
	BEGIN
		(* make current thread the first active object  *)
		NEW( p, NIL, NIL, 0, {}, 0 );
	END Convert;

	PROCEDURE Init;
	VAR
		lock		: PROCEDURE ( obj: ProtectedObject;  exclusive: BOOLEAN );
		unlock	: PROCEDURE ( obj: ProtectedObject;  dummy: BOOLEAN );
		await	: PROCEDURE ( cond: Condition;  slink: Address;  obj: ProtectedObject;  flags: SET );
		create	: PROCEDURE ( body: Body;  priority: LONGINT;  flags: SET;  obj: ProtectedObject );
	BEGIN
		lock := Lock;  unlock := Unlock;  await := Await;  create := CreateProcess;

		Modules.kernelProc[3] := S.VAL( Address, create);	(* 250 *)
		Modules.kernelProc[4] := S.VAL( Address, await);	(* 249 *)
		Modules.kernelProc[6] := S.VAL( Address, lock);		(* 247 *)
		Modules.kernelProc[7] := S.VAL( Address, unlock);	(* 246 *)

		Unix.Dlsym( 0, "mtxInit",		S.VAL( Address, mtxInit ) );
		Unix.Dlsym( 0, "mtxDestroy",	S.VAL( Address, mtxDestroy ) );
		Unix.Dlsym( 0, "mtxLock",		S.VAL( Address, mtxLock ) );
		Unix.Dlsym( 0, "mtxUnlock",		S.VAL( Address, mtxUnlock ) );
		Unix.Dlsym( 0, "conInit",			S.VAL( Address, conInit ) );
		Unix.Dlsym( 0, "conDestroy",	S.VAL( Address, conDestroy ) );
		Unix.Dlsym( 0, "conWait",		S.VAL( Address, conWait ) );
		Unix.Dlsym( 0, "conSignal",		S.VAL( Address, conSignal ) );
		
		Unix.Dlsym( 0, "thrStart",		S.VAL( Address, thrStart ) );
		Unix.Dlsym( 0, "thrThis",			S.VAL( Address, thrThis ) );
		Unix.Dlsym( 0, "thrSleep",		S.VAL( Address, thrSleep ) );
		Unix.Dlsym( 0, "thrYield",		S.VAL( Address, thrYield ) );
		Unix.Dlsym( 0, "thrExit",			S.VAL( Address, thrExit ) );
		Unix.Dlsym( 0, "thrSuspend",	S.VAL( Address, thrSuspend ) );
		Unix.Dlsym( 0, "thrResume",		S.VAL( Address, thrResume ) );
		Unix.Dlsym( 0, "thrGetPriority",	S.VAL( Address, thrGetPriority ) );
		Unix.Dlsym( 0, "thrSetPriority",	S.VAL( Address, thrSetPriority ) );
		Unix.Dlsym( 0, "thrKill",			S.VAL( Address, thrKill ) );
		
		createmtx := mtxInit( 0 );  processListMutex := mtxInit( 0 );
		startProcess := mtxInit(0);  childrunning := conInit(0); 
		
		collect := FALSE;
		igc := mtxInit( 0 );  gcFinished := conInit( 0 );
							
		GetStacksize;  
		
		Convert;
		StartTimerActivity;
		NEW( finalizerCaller );
		
		Machine.saveSP := SaveSP;
		Heaps.GC := InvokeGC;
	END Init;

BEGIN
	Init;
END Objects.