Generic.Unix.Objects.Mod 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792
  1. (* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)
  2. MODULE Objects; (** AUTHOR "pjm, G.F."; PURPOSE "Active object runtime support"; *)
  3. IMPORT S := SYSTEM, Trace, Glue, Unix, Machine, Heaps, Modules;
  4. CONST
  5. (*! Process flags, meaningless in Unix ports !!! *)
  6. PleaseHalt* = 10; (* Process requested to Halt itself soon *)
  7. Unbreakable*= 11; (* FINALLY shall not catch HALT exception (PleaseHalt is also set) *)
  8. SelfTermination*=12; (* Indicates the process has requested to terminate ifself (PleaseHalt is also set) *)
  9. Preempted* = 27; (* Has been preempted. *)
  10. Resistant* = 28; (* Can only be destroyed by itself *)
  11. MinPriority* = Unix.ThreadLow;
  12. Low* = Unix.ThreadLow + 1;
  13. Normal* = Unix.ThreadNormal;
  14. High* = Unix.ThreadHigh - 2;
  15. GCPriority* = Unix.ThreadHigh - 1;
  16. Realtime* = Unix.ThreadHigh;
  17. (* Process flag defined by compiler in OPC.CallRecBody *)
  18. Restart* = 0; (* Restart/Destroy process on exception *)
  19. (* Process modes (in UnixAos Running means Running or Ready!) *)
  20. Unknown* = 0; Ready* = 1; Running* = 2; AwaitingLock* = 3;
  21. AwaitingCond* = 4; AwaitingEvent* = 5; Terminated* = 6;
  22. Second* = 1000; (* frequency of ticks increments in Hz *)
  23. DefaultStacksize = 128*1024;
  24. AddrSize = SIZEOF( ADDRESS )
  25. VAR
  26. (* timer *)
  27. timerActivity : TimerActivity;
  28. timers : Timer;
  29. timerListMutex : Unix.Mutex_t;
  30. (* processes *)
  31. mainProcess : Process; (* runs the GC *)
  32. root- : Process; (*! Anchor of all instantiated threads in system *)
  33. stacksize: LONGINT; (* stack size of active objects, adjustable via boot parameter *)
  34. processList : Unix.Mutex_t;
  35. createProcess : Unix.Mutex_t;
  36. startProcess : Unix.Mutex_t;
  37. childrunning : Unix.Condition_t;
  38. newProcess: Process;
  39. nextPID: LONGINT;
  40. (* garbage colletion *)
  41. gcFinished: Unix.Condition_t; igc: Unix.Mutex_t;
  42. collect: BOOLEAN;
  43. finalizerCaller : FinalizerCaller;
  44. finCaller : Process;
  45. TYPE
  46. LockT= POINTER TO RECORD
  47. mtx, enter: ADDRESS;
  48. END;
  49. CpuCyclesArray* = ARRAY Machine.MaxCPU OF HUGEINT;
  50. ProtectedObject = POINTER TO RECORD END;
  51. ObjectHeader = Heaps.ProtRecBlock;
  52. ProcessQueue = Heaps.ProcessQueue;
  53. EventHandler* = PROCEDURE {DELEGATE};
  54. Timer* = OBJECT
  55. VAR
  56. next: Timer;
  57. trigger: LONGINT;
  58. handler: EventHandler
  59. END Timer;
  60. TimerActivity = OBJECT
  61. VAR
  62. t, r: Timer; h: EventHandler; restart: BOOLEAN;
  63. PROCEDURE UpdateTicks;
  64. BEGIN {EXCLUSIVE}
  65. Machine.UpdateTicks
  66. END UpdateTicks;
  67. PROCEDURE Restart;
  68. BEGIN {EXCLUSIVE}
  69. restart := TRUE
  70. END Restart;
  71. BEGIN {ACTIVE, SAFE, PRIORITY(High)}
  72. restart := FALSE;
  73. LOOP
  74. t := timers;
  75. IF t # NIL THEN
  76. h := NIL; r := NIL;
  77. BEGIN {EXCLUSIVE}
  78. AWAIT( (Machine.ticks >= t.trigger) OR restart ); restart := FALSE;
  79. IF Machine.ticks >= t.trigger THEN
  80. h := t.handler; r := t
  81. END
  82. END;
  83. IF r # NIL THEN Remove( r ) END;
  84. IF h # NIL THEN (* not canceled *) h END
  85. ELSE
  86. BEGIN{EXCLUSIVE}
  87. AWAIT( restart ); restart := FALSE;
  88. END
  89. END
  90. END
  91. END TimerActivity;
  92. FinalizedCollection* = OBJECT (* base type for collection, extended in Kernel.Mod *)
  93. PROCEDURE RemoveAll*(obj: ANY); (** abstract *)
  94. BEGIN HALT(301) END RemoveAll;
  95. END FinalizedCollection;
  96. FinalizerNode* = POINTER TO RECORD (Heaps.FinalizerNode)
  97. c*: FinalizedCollection (* base type for collection containing object *)
  98. END;
  99. FinalizerCaller = OBJECT (* separate active object that calls finalizers *)
  100. VAR
  101. n: Heaps.FinalizerNode; start: BOOLEAN;
  102. PROCEDURE Start;
  103. BEGIN {EXCLUSIVE}
  104. start := TRUE
  105. END Start;
  106. BEGIN {ACTIVE, SAFE, PRIORITY(High)}
  107. finCaller := CurrentProcess( ); start := FALSE;
  108. LOOP
  109. BEGIN {EXCLUSIVE} AWAIT( start ) END;
  110. start := FALSE;
  111. LOOP
  112. n := Heaps.GetFinalizer();
  113. IF n = NIL THEN EXIT END;
  114. IF n IS FinalizerNode THEN
  115. n(FinalizerNode).c.RemoveAll(n.objStrong) (* remove it if it is not removed yet *)
  116. END;
  117. IF n.finalizer # NIL THEN
  118. n.finalizer(n.objStrong) (* may acquire locks *)
  119. END;
  120. END;
  121. Machine.ReleaseGC
  122. END
  123. END FinalizerCaller;
  124. Body = PROCEDURE ( self: ProtectedObject );
  125. Condition = PROCEDURE ( slink: ADDRESS ): BOOLEAN;
  126. Process* = OBJECT (Heaps.ProcessLink)
  127. VAR
  128. threadId : Unix.Thread_t;
  129. nextProcess- : Process; (* next in list of all processes *)
  130. stackBottom - : ADDRESS;
  131. SP- : ADDRESS; (* SP value at last NEW *)
  132. id- : LONGINT;
  133. body : Body;
  134. mode- : LONGINT;
  135. flags- : SET;
  136. priority- : LONGINT; (* only effective if Aos is running SUID root *)
  137. succ : Process; (* in ProcessQueue *)
  138. obj- : ProtectedObject; (* associated active object *)
  139. condition- : Condition; (* awaited process' condition *)
  140. condFP- : ADDRESS; (* awaited process' condition's context *)
  141. continue : Unix.Condition_t; (* gets signaled when condition yields true *)
  142. waitingOn- : ProtectedObject;
  143. procID- : LONGINT; (* processor ID where running, not used in UnixAos *)
  144. state- : Machine.State; (*! not used in UnixAos! *)
  145. state0 : ARRAY 2048 OF CHAR; (* thread state at body start, used for restart after trap *)
  146. PROCEDURE FindRoots*;
  147. VAR sp, ptr: ADDRESS;
  148. BEGIN
  149. IF mode # Terminated THEN
  150. sp := SP;
  151. WHILE sp < stackBottom DO
  152. S.GET( sp, ptr );
  153. IF (ptr # 0) & (ptr MOD 8 = 0) THEN Heaps.Candidate( ptr ) END;
  154. INC( sp, AddrSize )
  155. END;
  156. END;
  157. Heaps.Mark( nextProcess )
  158. END FindRoots;
  159. PROCEDURE Cancel;
  160. VAR pt, t: Process; kt: Unix.Thread_t;
  161. BEGIN
  162. IF SELF = CurrentProcess() THEN Exit
  163. ELSE
  164. Machine.Acquire( Machine.X11 ); (* let the thread to be killed first finish its last I/O, if any *)
  165. Unix.MtxLock( processList );
  166. pt := NIL; t := root; kt := 0;
  167. WHILE (t # NIL ) & (t # SELF) DO pt := t; t := t.nextProcess END;
  168. IF t = SELF THEN
  169. kt := threadId;
  170. IF pt = NIL THEN root := t.nextProcess ELSE pt.nextProcess := t.nextProcess END;
  171. END;
  172. Unix.MtxUnlock( processList );
  173. IF kt # 0 THEN Unix.ThrKill( kt ) END;
  174. Machine.Release( Machine.X11 );
  175. END
  176. END Cancel;
  177. PROCEDURE GetPriority( ): LONGINT;
  178. BEGIN
  179. RETURN Unix.ThrGetPriority( threadId )
  180. END GetPriority;
  181. PROCEDURE SetPriority( prio: LONGINT );
  182. VAR pr: LONGINT;
  183. BEGIN
  184. pr := max( Machine.prioLow, min( prio, Machine.prioHigh ) );
  185. Unix.ThrSetPriority( threadId, pr ); (* works only if SUID root *)
  186. priority := GetPriority( )
  187. END SetPriority;
  188. PROCEDURE & Initialize( obj: ProtectedObject; bodyProc: Body; prio: LONGINT; fl: SET; stacksize: LONGINT);
  189. VAR thr: Unix.Thread_t;
  190. BEGIN
  191. SELF.obj := obj; condition := NIL; continue := Unix.ConInit(0);
  192. flags := fl;
  193. priority := prio;
  194. nextProcess := NIL;
  195. IF root # NIL THEN
  196. newProcess := SELF;
  197. ASSERT( bodyProc # NIL );
  198. body := bodyProc;
  199. Unix.MtxLock( startProcess );
  200. thr := Unix.ThrStart( BodyStarter, stacksize );
  201. Unix.ConWait( childrunning, startProcess );
  202. Unix.MtxUnlock( startProcess );
  203. RegisterFinalizer( SELF, FinalizeProcess );
  204. ELSE
  205. (* first process *)
  206. stackBottom := Glue.stackBottom;
  207. SP := Machine.CurrentSP( );
  208. threadId := Unix.ThrThis(0);
  209. id := 0; nextPID := 1;
  210. root := SELF;
  211. mainProcess := SELF;
  212. mode := Running;
  213. END;
  214. END Initialize;
  215. END Process;
  216. PROCEDURE BodyStarter;
  217. VAR p{UNTRACED}: Process; res: LONGINT; prevBP: ADDRESS; i: LONGINT;
  218. BEGIN
  219. Unix.MtxLock( startProcess );
  220. p := newProcess; newProcess := NIL;
  221. p.threadId := Unix.ThrThis(0);
  222. p.id := nextPID; INC( nextPID );
  223. p.SP := Machine.CurrentSP( );
  224. p.stackBottom := Machine.CurrentBP( );
  225. S.GET( p.stackBottom, prevBP );
  226. S.PUT( prevBP, S.VAL( ADDRESS, 0 ) ); (* for terminating Reflection.StackTraceBack *)
  227. Unix.MtxLock( processList );
  228. p.nextProcess := root; root := p;
  229. Unix.MtxUnlock( processList );
  230. Unix.ConSignal( childrunning );
  231. Unix.MtxUnlock( startProcess );
  232. p.SetPriority( p.priority );
  233. (*!
  234. IF Restart IN p.flags THEN
  235. res := Unix.sigsetjmp( ADDRESSOF( p.state0[0] ), 1 );
  236. END;
  237. *)
  238. p.mode := Running;
  239. p.body( p.obj );
  240. p.mode := Terminated;
  241. Exit
  242. END BodyStarter;
  243. (*--------------------- create, lock, await, unlock -------------------------*)
  244. PROCEDURE InitProtHeader( hdr: ObjectHeader );
  245. VAR lock: LockT;
  246. BEGIN
  247. NEW(lock);
  248. hdr.lock := lock;
  249. lock.mtx := Unix.MtxInit( 0 ); lock.enter := Unix.ConInit( 0 ); hdr.lockedBy := NIL;
  250. END InitProtHeader;
  251. PROCEDURE CreateProcess*( body: Body; priority: LONGINT; flags: SET; obj: ProtectedObject );
  252. VAR p: Process; hdr: ObjectHeader;
  253. BEGIN
  254. Unix.MtxLock( createProcess );
  255. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr ); InitProtHeader( hdr );
  256. IF priority = 0 THEN priority := Normal END;
  257. NEW( p, obj, body, priority, flags, stacksize ) ; (* execute BodyStarter as new (posix or solaris) thread *)
  258. Unix.MtxUnlock( createProcess );
  259. RegisterFinalizer( obj, FinalizeActiveObj )
  260. END CreateProcess;
  261. PROCEDURE Lock*( obj: ProtectedObject; exclusive: BOOLEAN );
  262. VAR hdr: ObjectHeader; p: Process; lock: LockT;
  263. BEGIN
  264. ASSERT( exclusive ); (* shared not implemented yet *)
  265. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr );
  266. p := CurrentProcess();
  267. p.mode := AwaitingLock;
  268. IF hdr.lock = NIL THEN InitProtHeader( hdr ) END;
  269. lock := S.VAL(LockT, hdr.lock);
  270. Unix.MtxLock( lock.mtx );
  271. WHILE hdr.lockedBy # NIL DO
  272. (* wait until threads with complied AWAIT conditions have left the monitor *)
  273. Unix.ConWait( lock.enter, lock.mtx );
  274. END;
  275. p.mode := Running; hdr.lockedBy := p; p.waitingOn := NIL
  276. END Lock;
  277. PROCEDURE Await*( cond: Condition; slink: ADDRESS; obj: ProtectedObject; flags: SET );
  278. VAR hdr: ObjectHeader; p, c: Process; lock: LockT;
  279. BEGIN
  280. IF 1 IN flags THEN (* compiler did not generate IF *)
  281. IF cond( slink ) THEN (* condition already true *) RETURN END
  282. END;
  283. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr ); c := NIL;
  284. lock := S.VAL(LockT, hdr.lock);
  285. IF hdr.awaitingCond.head # NIL THEN c := FindCondition( hdr.awaitingCond ) END;
  286. p := CurrentProcess(); p.succ := NIL; p.condition := cond; p.condFP := slink;
  287. p.waitingOn := obj; p.mode := AwaitingCond;
  288. Put( hdr.awaitingCond, p );
  289. hdr.lockedBy := c;
  290. IF c # NIL THEN Unix.ConSignal( c.continue ) ELSE Unix.ConSignal( lock.enter ) END;
  291. Unix.ConWait( p.continue, lock.mtx );
  292. p.mode := Running; hdr.lockedBy := p; p.waitingOn := NIL
  293. END Await;
  294. PROCEDURE Unlock*( obj: ProtectedObject; dummy: BOOLEAN );
  295. VAR hdr: ObjectHeader; c: Process; lock: LockT;
  296. BEGIN
  297. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr ); c := NIL;
  298. lock := S.VAL(LockT,hdr.lock);
  299. IF hdr.awaitingCond.head # NIL THEN c := FindCondition( hdr.awaitingCond ) END;
  300. hdr.lockedBy := c;
  301. IF c # NIL THEN Unix.ConSignal( c.continue ) ELSE Unix.ConSignal( lock.enter ) END;
  302. Unix.MtxUnlock( lock.mtx );
  303. END Unlock;
  304. PROCEDURE FindCondition( VAR q: ProcessQueue ): Process;
  305. VAR first, cand: Process;
  306. BEGIN
  307. Get( q, first );
  308. IF first.condition( first.condFP ) THEN RETURN first ELSE Put( q, first ) END;
  309. WHILE q.head # first DO
  310. Get( q, cand );
  311. IF cand.condition( cand.condFP ) THEN RETURN cand ELSE Put( q, cand ) END;
  312. END;
  313. RETURN NIL
  314. END FindCondition;
  315. PROCEDURE Get( VAR queue: ProcessQueue; VAR new: Process );
  316. VAR t: Process;
  317. BEGIN
  318. t := queue.head(Process);
  319. IF t # NIL THEN
  320. IF t = queue.tail THEN queue.head := NIL; queue.tail := NIL
  321. ELSE queue.head := t.succ; t.succ := NIL
  322. END
  323. END;
  324. new := t
  325. END Get;
  326. PROCEDURE Put( VAR queue: ProcessQueue; t: Process );
  327. BEGIN
  328. IF queue.head = NIL THEN queue.head := t ELSE queue.tail(Process).succ := t END;
  329. queue.tail := t
  330. END Put;
  331. (*-------------------------------------------------------------------------*)
  332. PROCEDURE Terminate*;
  333. BEGIN
  334. Exit
  335. END Terminate;
  336. PROCEDURE TerminateThis*( p: Process; unbreakable: BOOLEAN );
  337. BEGIN
  338. p.mode := Terminated;
  339. p.Cancel
  340. END TerminateThis;
  341. PROCEDURE SetPriority*( pri: LONGINT ); (* Set the current process' priority. *)
  342. VAR me: Process;
  343. BEGIN
  344. me := CurrentProcess();
  345. me.SetPriority( pri )
  346. END SetPriority;
  347. PROCEDURE Sleep*( ms: LONGINT );
  348. BEGIN
  349. Unix.ThrSleep( ms )
  350. END Sleep;
  351. PROCEDURE Yield*; (* Relinquish control. *)
  352. BEGIN
  353. Unix.ThrYield(0);
  354. END Yield;
  355. (* Return current process. (DEPRECATED, use ActiveObject) *)
  356. PROCEDURE CurrentProcess*( ): Process;
  357. VAR me: Unix.Thread_t; p: Process;
  358. BEGIN
  359. me := Unix.ThrThis(0);
  360. Unix.MtxLock( processList );
  361. p := root;
  362. WHILE (p # NIL) & (p.threadId # me) DO p := p.nextProcess END;
  363. Unix.MtxUnlock( processList );
  364. RETURN p
  365. END CurrentProcess;
  366. (* Return the active object currently executing. *)
  367. PROCEDURE ActiveObject*( ): ANY;
  368. VAR p: Process;
  369. BEGIN
  370. p := CurrentProcess();
  371. RETURN p.obj
  372. END ActiveObject;
  373. (* Return stack bottom of process. For compatibility WinAos/UnixAos/NativeAos *)
  374. PROCEDURE GetStackBottom*(p: Process): ADDRESS;
  375. BEGIN
  376. RETURN p.stackBottom
  377. END GetStackBottom;
  378. PROCEDURE GetProcessID*( ): LONGINT;
  379. VAR p: Process;
  380. BEGIN
  381. p := CurrentProcess();
  382. RETURN p.id;
  383. END GetProcessID;
  384. PROCEDURE GetCpuCycles*( process : Process; VAR cpuCycles: CpuCyclesArray; all: BOOLEAN );
  385. VAR i: LONGINT;
  386. BEGIN
  387. ASSERT( process # NIL );
  388. FOR i := 0 TO Machine.MaxCPU-1 DO cpuCycles[i] := 0 END;
  389. END GetCpuCycles;
  390. (*-----------------------------------------------------------------------*)
  391. PROCEDURE min( a, b: LONGINT ): LONGINT;
  392. BEGIN
  393. IF a <= b THEN RETURN a ELSE RETURN b END
  394. END min;
  395. PROCEDURE max( a, b: LONGINT ): LONGINT;
  396. BEGIN
  397. IF a >= b THEN RETURN a ELSE RETURN b END
  398. END max;
  399. PROCEDURE RegisterFinalizer( obj: ANY; fin: Heaps.Finalizer );
  400. VAR n: Heaps.FinalizerNode;
  401. BEGIN
  402. NEW( n ); n.finalizer := fin; Heaps.AddFinalizer( obj, n );
  403. END RegisterFinalizer;
  404. PROCEDURE FinalizeActiveObj( obj: ANY );
  405. VAR p: Process;
  406. BEGIN
  407. Unix.MtxLock( processList );
  408. p := root;
  409. WHILE (p # NIL) & (p.obj # obj) DO p := p.nextProcess END;
  410. Unix.MtxUnlock( processList );
  411. IF (p # NIL) & (p.obj = obj) THEN
  412. p.mode := Terminated;
  413. Unix.ConDestroy( p.continue ); p.continue := 0;
  414. FinalizeProtObject( obj );
  415. p.Cancel
  416. END;
  417. END FinalizeActiveObj;
  418. PROCEDURE FinalizeProtObject( obj: ANY );
  419. VAR hdr: ObjectHeader; lock: LockT;
  420. BEGIN
  421. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr );
  422. IF hdr.lock # NIL THEN
  423. lock := S.VAL(LockT, hdr.lock);
  424. Unix.MtxDestroy( lock.mtx ); lock.mtx := 0
  425. END
  426. END FinalizeProtObject;
  427. PROCEDURE FinalizeProcess( obj: ANY );
  428. VAR p: Process;
  429. BEGIN
  430. p := obj(Process);
  431. IF p.continue # 0 THEN
  432. Unix.ConDestroy( p.continue ); p.continue := 0
  433. END
  434. END FinalizeProcess;
  435. (* Terminate calling thread. *)
  436. PROCEDURE Exit;
  437. VAR prev, p, me: Process;
  438. BEGIN
  439. me := CurrentProcess();
  440. me.mode := Terminated;
  441. Unix.MtxLock( processList );
  442. prev := NIL; p := root;
  443. WHILE (p # NIL ) & (p # me) DO prev := p; p := p.nextProcess END;
  444. IF p = me THEN
  445. IF prev = NIL THEN root := p.nextProcess ELSE prev.nextProcess := p.nextProcess END;
  446. END;
  447. Unix.MtxUnlock( processList );
  448. Unix.ThrExit(0);
  449. END Exit;
  450. PROCEDURE ExitTrap*;
  451. VAR p: Process;
  452. BEGIN
  453. p := CurrentProcess();
  454. (* restart the object body if it was given the SAFE flag *)
  455. IF Restart IN p.flags THEN
  456. Unix.siglongjmp( ADDRESSOF( p.state0[0] ), 1 )
  457. END;
  458. Exit
  459. END ExitTrap;
  460. (*---------------------------- Timer --------------------------------*)
  461. PROCEDURE Remove( t: Timer ); (* remove timer from list of active timers *)
  462. VAR p, x: Timer;
  463. BEGIN
  464. Unix.MtxLock( timerListMutex );
  465. t.trigger := 0; t.handler := NIL;
  466. IF timers # NIL THEN
  467. IF t = timers THEN
  468. timers := t.next
  469. ELSE
  470. p := timers; x := p.next;
  471. WHILE (x # NIL) & (x # t) DO p := x; x := p.next END;
  472. IF x = t THEN p.next := t.next END
  473. END;
  474. t.next := NIL
  475. END;
  476. Unix.MtxUnlock( timerListMutex )
  477. END Remove;
  478. PROCEDURE Insert( t: Timer );
  479. VAR p, x: Timer;
  480. BEGIN
  481. Unix.MtxLock( timerListMutex );
  482. p := NIL; x := timers;
  483. WHILE (x # NIL) & (x.trigger < t.trigger) DO p := x; x := p.next END;
  484. t.next := x;
  485. IF p = NIL THEN timers := t ELSE p.next := t END;
  486. Unix.MtxUnlock( timerListMutex )
  487. END Insert;
  488. PROCEDURE SetTimeout*( t: Timer; h: EventHandler; ms: LONGINT );
  489. BEGIN
  490. ASSERT( ( t # NIL) & ( h # NIL) );
  491. Remove( t );
  492. IF ms < 1 THEN ms := 1 END;
  493. t.trigger := Machine.ticks + ms; t.handler := h;
  494. Insert( t );
  495. timerActivity.Restart
  496. END SetTimeout;
  497. PROCEDURE SetTimeoutAt*( t: Timer; h: EventHandler; ms: LONGINT );
  498. BEGIN
  499. ASSERT( (t # NIL) & (h # NIL) );
  500. Remove( t );
  501. t.trigger := ms; t.handler := h;
  502. Insert( t );
  503. timerActivity.Restart
  504. END SetTimeoutAt;
  505. PROCEDURE CancelTimeout*( t: Timer );
  506. BEGIN
  507. Remove( t )
  508. END CancelTimeout;
  509. (*-------------------- Garbage Collection ------------------------------------*)
  510. PROCEDURE SuspendActivities;
  511. VAR t: Process;
  512. BEGIN
  513. t := root;
  514. WHILE t # NIL DO
  515. IF (t # mainProcess) & (t # finCaller) THEN Unix.ThrSuspend( t.threadId ) END;
  516. t := t.nextProcess
  517. END;
  518. END SuspendActivities;
  519. PROCEDURE ResumeActivities;
  520. VAR t: Process;
  521. BEGIN
  522. t := root;
  523. WHILE t # NIL DO
  524. IF (t # mainProcess) & (t # finCaller) THEN Unix.ThrResume( t.threadId ) END;
  525. t := t.nextProcess
  526. END;
  527. END ResumeActivities;
  528. PROCEDURE SaveSP; (* save current SP for usage by the GC *)
  529. VAR me: Unix.Thread_t; t: Process;
  530. BEGIN
  531. me := Unix.ThrThis(0); t := root;
  532. WHILE (t # NIL ) & (t.threadId # me) DO t := t.nextProcess END;
  533. IF t # NIL THEN t.SP := Machine.CurrentSP( ) END
  534. END SaveSP;
  535. PROCEDURE InvokeGC;
  536. BEGIN
  537. IF Machine.AcquireGC() THEN (* gets released by FinalizerCaller *)
  538. collect := TRUE;
  539. Unix.ConWait( gcFinished, igc )
  540. END;
  541. END InvokeGC;
  542. (*! GCLoop gets called as last procedure in BootConsole (main thread).
  543. The stack of the main thread is not limited by the boot parameter 'StackSize' !!
  544. *)
  545. PROCEDURE GCLoop*; (* Timer and GC activity *)
  546. BEGIN
  547. SetPriority( GCPriority );
  548. LOOP
  549. IF collect THEN
  550. collect := FALSE;
  551. Machine.Acquire( Machine.Heaps );
  552. SuspendActivities;
  553. Heaps.CollectGarbage( Modules.root );
  554. Machine.Release( Machine.Heaps );
  555. ResumeActivities;
  556. finalizerCaller.Start;
  557. Unix.ConSignal( gcFinished );
  558. ELSE
  559. Unix.ThrSleep( 10 );
  560. END;
  561. timerActivity.UpdateTicks
  562. END
  563. END GCLoop;
  564. PROCEDURE CurrentProcessTime*(): HUGEINT;
  565. BEGIN
  566. RETURN Machine.GetTimer()
  567. END CurrentProcessTime;
  568. PROCEDURE TimerFrequency*(): HUGEINT;
  569. BEGIN
  570. RETURN Machine.mhz * 1000000
  571. END TimerFrequency;
  572. (*----------------------------- initialization ----------------------------------*)
  573. PROCEDURE StartTimerActivity;
  574. BEGIN
  575. timerListMutex := Unix.MtxInit(0); timers := NIL;
  576. NEW( timerActivity );
  577. END StartTimerActivity;
  578. PROCEDURE GetStacksize;
  579. VAR str: ARRAY 32 OF CHAR; i: LONGINT;
  580. BEGIN
  581. Machine.GetConfig( "StackSize", str );
  582. IF str = "" THEN stacksize := DefaultStacksize
  583. ELSE
  584. i := 0; stacksize := Machine.StrToInt( i, str );
  585. stacksize := stacksize * 1024;
  586. END;
  587. IF Glue.debug # {} THEN
  588. Trace.String( "Stacksize of active objects = " );
  589. Trace.Int( stacksize DIV 1024, 0 ); Trace.StringLn( "K" )
  590. END;
  591. END GetStacksize;
  592. PROCEDURE Convert;
  593. VAR p: Process;
  594. BEGIN
  595. (* make current thread the first active object *)
  596. NEW( p, NIL, NIL, 0, {}, 0 );
  597. END Convert;
  598. PROCEDURE Init;
  599. BEGIN
  600. TRACE("Init");
  601. (*
  602. Unix.Dlsym( 0, "Unix.MtxInit", ADDRESSOF( Unix.MtxInit ) );
  603. Unix.Dlsym( 0, "Unix.MtxDestroy", ADDRESSOF( Unix.MtxDestroy ) );
  604. Unix.Dlsym( 0, "Unix.MtxLock", ADDRESSOF( Unix.MtxLock ) );
  605. Unix.Dlsym( 0, "Unix.MtxUnlock", ADDRESSOF( Unix.MtxUnlock ) );
  606. Unix.Dlsym( 0, "Unix.ConInit", ADDRESSOF( Unix.ConInit ) );
  607. Unix.Dlsym( 0, "Unix.ConDestroy", ADDRESSOF( Unix.ConDestroy ) );
  608. Unix.Dlsym( 0, "Unix.ConWait", ADDRESSOF( Unix.ConWait ) );
  609. Unix.Dlsym( 0, "Unix.ConSignal", ADDRESSOF( Unix.ConSignal ) );
  610. Unix.Dlsym( 0, "thrStart", ADDRESSOF( thrStart ) );
  611. Unix.Dlsym( 0, "Unix.ThrThis", ADDRESSOF( Unix.ThrThis ) );
  612. Unix.Dlsym( 0, "Unix.ThrSleep", ADDRESSOF( Unix.ThrSleep ) );
  613. Unix.Dlsym( 0, "Unix.ThrYield", ADDRESSOF( Unix.ThrYield ) );
  614. Unix.Dlsym( 0, "Unix.ThrExit", ADDRESSOF( Unix.ThrExit ) );
  615. Unix.Dlsym( 0, "Unix.ThrSuspend", ADDRESSOF( Unix.ThrSuspend ) );
  616. Unix.Dlsym( 0, "Unix.ThrResume", ADDRESSOF( Unix.ThrResume ) );
  617. Unix.Dlsym( 0, "Unix.ThrGetPriority", ADDRESSOF( Unix.ThrGetPriority ) );
  618. Unix.Dlsym( 0, "Unix.ThrSetPriority", ADDRESSOF( Unix.ThrSetPriority ) );
  619. Unix.Dlsym( 0, "thrKill", ADDRESSOF( thrKill ) );
  620. *)
  621. createProcess := Unix.MtxInit( 0 ); processList := Unix.MtxInit( 0 );
  622. startProcess := Unix.MtxInit(0); childrunning := Unix.ConInit(0);
  623. collect := FALSE;
  624. igc := Unix.MtxInit( 0 ); gcFinished := Unix.ConInit( 0 );
  625. GetStacksize;
  626. Convert;
  627. StartTimerActivity;
  628. NEW( finalizerCaller );
  629. (*
  630. Heaps.saveSP := SaveSP;
  631. Heaps.GC := InvokeGC;
  632. Heaps.InvokeGC := InvokeGC;
  633. *)
  634. END Init;
  635. PROCEDURE {FINAL} Final;
  636. BEGIN
  637. TRACE("FINAL END ");
  638. Machine.Shutdown(FALSE);
  639. END Final;
  640. BEGIN
  641. TRACE("Objects.Body1");
  642. Init;
  643. TRACE("Objects.Body2");
  644. END Objects.