Generic.Unix.Objects.Mod 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798
  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. CpuCyclesArray* = ARRAY Machine.MaxCPU OF HUGEINT;
  47. ProtectedObject = POINTER TO RECORD END;
  48. ObjectHeader = Heaps.ProtRecBlock;
  49. ProcessQueue = Heaps.ProcessQueue;
  50. EventHandler* = PROCEDURE {DELEGATE};
  51. Timer* = OBJECT
  52. VAR
  53. next: Timer;
  54. trigger: LONGINT;
  55. handler: EventHandler
  56. END Timer;
  57. TimerActivity = OBJECT
  58. VAR
  59. t, r: Timer; h: EventHandler; restart: BOOLEAN;
  60. PROCEDURE UpdateTicks;
  61. BEGIN {EXCLUSIVE}
  62. Machine.UpdateTicks
  63. END UpdateTicks;
  64. PROCEDURE Restart;
  65. BEGIN {EXCLUSIVE}
  66. restart := TRUE
  67. END Restart;
  68. BEGIN {ACTIVE, SAFE, PRIORITY(High)}
  69. restart := FALSE;
  70. LOOP
  71. t := timers;
  72. IF t # NIL THEN
  73. h := NIL; r := NIL;
  74. BEGIN {EXCLUSIVE}
  75. AWAIT( (Machine.ticks >= t.trigger) OR restart ); restart := FALSE;
  76. IF Machine.ticks >= t.trigger THEN
  77. h := t.handler; r := t
  78. END
  79. END;
  80. IF r # NIL THEN Remove( r ) END;
  81. IF h # NIL THEN (* not canceled *) h END
  82. ELSE
  83. BEGIN{EXCLUSIVE}
  84. AWAIT( restart ); restart := FALSE;
  85. END
  86. END
  87. END
  88. END TimerActivity;
  89. FinalizedCollection* = OBJECT (* base type for collection, extended in Kernel.Mod *)
  90. PROCEDURE RemoveAll*(obj: ANY); (** abstract *)
  91. BEGIN HALT(301) END RemoveAll;
  92. END FinalizedCollection;
  93. FinalizerNode* = POINTER TO RECORD (Heaps.FinalizerNode)
  94. c*: FinalizedCollection (* base type for collection containing object *)
  95. END;
  96. FinalizerCaller = OBJECT (* separate active object that calls finalizers *)
  97. VAR
  98. n: Heaps.FinalizerNode; start: BOOLEAN;
  99. PROCEDURE Start;
  100. BEGIN {EXCLUSIVE}
  101. start := TRUE
  102. END Start;
  103. BEGIN {ACTIVE, SAFE, PRIORITY(High)}
  104. finCaller := CurrentProcess( ); start := FALSE;
  105. LOOP
  106. BEGIN {EXCLUSIVE} AWAIT( start ) END;
  107. start := FALSE;
  108. LOOP
  109. n := Heaps.GetFinalizer();
  110. IF n = NIL THEN EXIT END;
  111. IF n IS FinalizerNode THEN
  112. n(FinalizerNode).c.RemoveAll(n.objStrong) (* remove it if it is not removed yet *)
  113. END;
  114. IF n.finalizer # NIL THEN
  115. n.finalizer(n.objStrong) (* may acquire locks *)
  116. END;
  117. END;
  118. Machine.ReleaseGC
  119. END
  120. END FinalizerCaller;
  121. Body = PROCEDURE ( self: ProtectedObject );
  122. Condition = PROCEDURE ( slink: ADDRESS ): BOOLEAN;
  123. Process* = OBJECT (Heaps.ProcessLink)
  124. VAR
  125. threadId : Unix.Thread_t;
  126. nextProcess- : Process; (* next in list of all processes *)
  127. stackBottom - : ADDRESS;
  128. SP- : ADDRESS; (* SP value at last NEW *)
  129. id- : LONGINT;
  130. body : Body;
  131. mode- : LONGINT;
  132. flags- : SET;
  133. priority- : LONGINT; (* only effective if Aos is running SUID root *)
  134. succ : Process; (* in ProcessQueue *)
  135. obj- : ProtectedObject; (* associated active object *)
  136. condition- : Condition; (* awaited process' condition *)
  137. condFP- : ADDRESS; (* awaited process' condition's context *)
  138. continue : Unix.Condition_t; (* gets signaled when condition yields true *)
  139. waitingOn- : ProtectedObject;
  140. procID- : LONGINT; (* processor ID where running, not used in UnixAos *)
  141. state- : Machine.State; (*! not used in UnixAos! *)
  142. state0 : ARRAY 2048 OF CHAR; (* thread state at body start, used for restart after trap *)
  143. PROCEDURE FindRoots*;
  144. VAR sp, ptr: ADDRESS;
  145. BEGIN
  146. IF mode # Terminated THEN
  147. sp := SP;
  148. WHILE sp < stackBottom DO
  149. S.GET( sp, ptr );
  150. IF (ptr # 0) & (ptr MOD 8 = 0) THEN Heaps.Candidate( ptr ) END;
  151. INC( sp, AddrSize )
  152. END;
  153. END;
  154. Heaps.Mark( nextProcess )
  155. END FindRoots;
  156. PROCEDURE Cancel;
  157. VAR pt, t: Process; kt: Unix.Thread_t;
  158. BEGIN
  159. IF SELF = CurrentProcess() THEN Exit
  160. ELSE
  161. Machine.Acquire( Machine.X11 ); (* let the thread to be killed first finish its last I/O, if any *)
  162. Unix.MtxLock( processList );
  163. pt := NIL; t := root; kt := 0;
  164. WHILE (t # NIL ) & (t # SELF) DO pt := t; t := t.nextProcess END;
  165. IF t = SELF THEN
  166. kt := threadId;
  167. IF pt = NIL THEN root := t.nextProcess ELSE pt.nextProcess := t.nextProcess END;
  168. END;
  169. Unix.MtxUnlock( processList );
  170. IF kt # 0 THEN Unix.ThrKill( kt ) END;
  171. Machine.Release( Machine.X11 );
  172. END
  173. END Cancel;
  174. PROCEDURE GetPriority( ): LONGINT;
  175. BEGIN
  176. RETURN Unix.ThrGetPriority( threadId )
  177. END GetPriority;
  178. PROCEDURE SetPriority( prio: LONGINT );
  179. VAR pr: LONGINT;
  180. BEGIN
  181. pr := max( Machine.prioLow, min( prio, Machine.prioHigh ) );
  182. Unix.ThrSetPriority( threadId, pr ); (* works only if SUID root *)
  183. priority := GetPriority( )
  184. END SetPriority;
  185. PROCEDURE & Initialize( obj: ProtectedObject; bodyProc: Body; prio: LONGINT; fl: SET; stacksize: LONGINT);
  186. VAR thr: Unix.Thread_t;
  187. BEGIN
  188. TRACE(root);
  189. SELF.obj := obj; condition := NIL; continue := Unix.ConInit(0);
  190. flags := fl;
  191. priority := prio;
  192. nextProcess := NIL;
  193. IF root # NIL THEN
  194. newProcess := SELF;
  195. ASSERT( bodyProc # NIL );
  196. body := bodyProc;
  197. Unix.MtxLock( startProcess );
  198. TRACE(body);
  199. thr := Unix.ThrStart( BodyStarter, stacksize );
  200. TRACE(1,thr);
  201. TRACE(1, childrunning, startProcess);
  202. Unix.ConWait( childrunning, startProcess );
  203. Unix.MtxUnlock( startProcess );
  204. TRACE(2,thr);
  205. RegisterFinalizer( SELF, FinalizeProcess );
  206. TRACE(3,thr);
  207. ELSE
  208. (* first process *)
  209. stackBottom := Glue.stackBottom;
  210. SP := Machine.CurrentSP( );
  211. TRACE(root);
  212. threadId := Unix.ThrThis(0);
  213. id := 0; nextPID := 1;
  214. root := SELF;
  215. mainProcess := SELF;
  216. mode := Running;
  217. END;
  218. END Initialize;
  219. END Process;
  220. PROCEDURE BodyStarter;
  221. VAR p{UNTRACED}: Process; res: LONGINT; prevBP: ADDRESS; i: LONGINT;
  222. BEGIN
  223. TRACE("Bodystarter running");
  224. Unix.MtxLock( startProcess );
  225. TRACE("start process");
  226. p := newProcess; newProcess := NIL;
  227. p.threadId := Unix.ThrThis(0);
  228. p.id := nextPID; INC( nextPID );
  229. p.SP := Machine.CurrentSP( );
  230. p.stackBottom := Machine.CurrentBP( );
  231. S.GET( p.stackBottom, prevBP );
  232. S.PUT( prevBP, S.VAL( ADDRESS, 0 ) ); (* for terminating Reflection.StackTraceBack *)
  233. Unix.MtxLock( processList );
  234. p.nextProcess := root; root := p;
  235. Unix.MtxUnlock( processList );
  236. Unix.ConSignal( childrunning );
  237. Unix.MtxUnlock( startProcess );
  238. p.SetPriority( p.priority );
  239. (*!
  240. IF Restart IN p.flags THEN
  241. res := Unix.sigsetjmp( ADDRESSOF( p.state0[0] ), 1 );
  242. END;
  243. *)
  244. p.mode := Running;
  245. p.body( p.obj );
  246. p.mode := Terminated;
  247. Exit
  248. END BodyStarter;
  249. (*--------------------- create, lock, await, unlock -------------------------*)
  250. PROCEDURE InitProtHeader( hdr: ObjectHeader );
  251. BEGIN
  252. hdr.mtx := Unix.MtxInit( 0 ); hdr.enter := Unix.ConInit( 0 ); hdr.lockedBy := NIL;
  253. END InitProtHeader;
  254. PROCEDURE CreateProcess*( body: Body; priority: LONGINT; flags: SET; obj: ProtectedObject );
  255. VAR p: Process; hdr: ObjectHeader;
  256. BEGIN
  257. TRACE(body);
  258. Unix.MtxLock( createProcess );
  259. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr ); InitProtHeader( hdr );
  260. IF priority = 0 THEN priority := Normal END;
  261. NEW( p, obj, body, priority, flags, stacksize ) ; (* execute BodyStarter as new (posix or solaris) thread *)
  262. Unix.MtxUnlock( createProcess );
  263. RegisterFinalizer( obj, FinalizeActiveObj )
  264. END CreateProcess;
  265. PROCEDURE Lock*( obj: ProtectedObject; exclusive: BOOLEAN );
  266. VAR hdr: ObjectHeader; p: Process;
  267. BEGIN
  268. ASSERT( exclusive ); (* shared not implemented yet *)
  269. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr );
  270. p := CurrentProcess();
  271. p.mode := AwaitingLock;
  272. IF hdr.mtx = 0 THEN InitProtHeader( hdr ) END;
  273. Unix.MtxLock( hdr.mtx );
  274. WHILE hdr.lockedBy # NIL DO
  275. (* wait until threads with complied AWAIT conditions have left the monitor *)
  276. Unix.ConWait( hdr.enter, hdr.mtx );
  277. END;
  278. p.mode := Running; hdr.lockedBy := p; p.waitingOn := NIL
  279. END Lock;
  280. PROCEDURE Await*( cond: Condition; slink: ADDRESS; obj: ProtectedObject; flags: SET );
  281. VAR hdr: ObjectHeader; p, c: Process;
  282. BEGIN
  283. IF 1 IN flags THEN (* compiler did not generate IF *)
  284. IF cond( slink ) THEN (* condition already true *) RETURN END
  285. END;
  286. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr ); c := NIL;
  287. IF hdr.awaitingCond.head # NIL THEN c := FindCondition( hdr.awaitingCond ) END;
  288. p := CurrentProcess(); p.succ := NIL; p.condition := cond; p.condFP := slink;
  289. p.waitingOn := obj; p.mode := AwaitingCond;
  290. Put( hdr.awaitingCond, p );
  291. hdr.lockedBy := c;
  292. IF c # NIL THEN Unix.ConSignal( c.continue ) ELSE Unix.ConSignal( hdr.enter ) END;
  293. Unix.ConWait( p.continue, hdr.mtx );
  294. p.mode := Running; hdr.lockedBy := p; p.waitingOn := NIL
  295. END Await;
  296. PROCEDURE Unlock*( obj: ProtectedObject; dummy: BOOLEAN );
  297. VAR hdr: ObjectHeader; c: Process;
  298. BEGIN
  299. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr ); c := NIL;
  300. IF hdr.awaitingCond.head # NIL THEN c := FindCondition( hdr.awaitingCond ) END;
  301. hdr.lockedBy := c;
  302. IF c # NIL THEN Unix.ConSignal( c.continue ) ELSE Unix.ConSignal( hdr.enter ) END;
  303. Unix.MtxUnlock( hdr.mtx );
  304. END Unlock;
  305. PROCEDURE FindCondition( VAR q: ProcessQueue ): Process;
  306. VAR first, cand: Process;
  307. BEGIN
  308. Get( q, first );
  309. IF first.condition( first.condFP ) THEN RETURN first ELSE Put( q, first ) END;
  310. WHILE q.head # first DO
  311. Get( q, cand );
  312. IF cand.condition( cand.condFP ) THEN RETURN cand ELSE Put( q, cand ) END;
  313. END;
  314. RETURN NIL
  315. END FindCondition;
  316. PROCEDURE Get( VAR queue: ProcessQueue; VAR new: Process );
  317. VAR t: Process;
  318. BEGIN
  319. t := queue.head(Process);
  320. IF t # NIL THEN
  321. IF t = queue.tail THEN queue.head := NIL; queue.tail := NIL
  322. ELSE queue.head := t.succ; t.succ := NIL
  323. END
  324. END;
  325. new := t
  326. END Get;
  327. PROCEDURE Put( VAR queue: ProcessQueue; t: Process );
  328. BEGIN
  329. IF queue.head = NIL THEN queue.head := t ELSE queue.tail(Process).succ := t END;
  330. queue.tail := t
  331. END Put;
  332. (*-------------------------------------------------------------------------*)
  333. PROCEDURE Terminate*;
  334. BEGIN
  335. Exit
  336. END Terminate;
  337. PROCEDURE TerminateThis*( p: Process; unbreakable: BOOLEAN );
  338. BEGIN
  339. p.mode := Terminated;
  340. p.Cancel
  341. END TerminateThis;
  342. PROCEDURE SetPriority*( pri: LONGINT ); (* Set the current process' priority. *)
  343. VAR me: Process;
  344. BEGIN
  345. me := CurrentProcess();
  346. me.SetPriority( pri )
  347. END SetPriority;
  348. PROCEDURE Sleep*( ms: LONGINT );
  349. BEGIN
  350. Unix.ThrSleep( ms )
  351. END Sleep;
  352. PROCEDURE Yield*; (* Relinquish control. *)
  353. BEGIN
  354. Unix.ThrYield(0);
  355. END Yield;
  356. (* Return current process. (DEPRECATED, use ActiveObject) *)
  357. PROCEDURE CurrentProcess*( ): Process;
  358. VAR me: Unix.Thread_t; p: Process;
  359. BEGIN
  360. me := Unix.ThrThis(0);
  361. Unix.MtxLock( processList );
  362. p := root;
  363. WHILE (p # NIL) & (p.threadId # me) DO p := p.nextProcess END;
  364. Unix.MtxUnlock( processList );
  365. RETURN p
  366. END CurrentProcess;
  367. (* Return the active object currently executing. *)
  368. PROCEDURE ActiveObject*( ): ANY;
  369. VAR p: Process;
  370. BEGIN
  371. p := CurrentProcess();
  372. RETURN p.obj
  373. END ActiveObject;
  374. (* Return stack bottom of process. For compatibility WinAos/UnixAos/NativeAos *)
  375. PROCEDURE GetStackBottom*(p: Process): ADDRESS;
  376. BEGIN
  377. RETURN p.stackBottom
  378. END GetStackBottom;
  379. PROCEDURE GetProcessID*( ): LONGINT;
  380. VAR p: Process;
  381. BEGIN
  382. p := CurrentProcess();
  383. RETURN p.id;
  384. END GetProcessID;
  385. PROCEDURE GetCpuCycles*( process : Process; VAR cpuCycles: CpuCyclesArray; all: BOOLEAN );
  386. VAR i: LONGINT;
  387. BEGIN
  388. ASSERT( process # NIL );
  389. FOR i := 0 TO Machine.MaxCPU-1 DO cpuCycles[i] := 0 END;
  390. END GetCpuCycles;
  391. (*-----------------------------------------------------------------------*)
  392. PROCEDURE min( a, b: LONGINT ): LONGINT;
  393. BEGIN
  394. IF a <= b THEN RETURN a ELSE RETURN b END
  395. END min;
  396. PROCEDURE max( a, b: LONGINT ): LONGINT;
  397. BEGIN
  398. IF a >= b THEN RETURN a ELSE RETURN b END
  399. END max;
  400. PROCEDURE RegisterFinalizer( obj: ANY; fin: Heaps.Finalizer );
  401. VAR n: Heaps.FinalizerNode;
  402. BEGIN
  403. NEW( n ); n.finalizer := fin; Heaps.AddFinalizer( obj, n );
  404. END RegisterFinalizer;
  405. PROCEDURE FinalizeActiveObj( obj: ANY );
  406. VAR p: Process;
  407. BEGIN
  408. Unix.MtxLock( processList );
  409. p := root;
  410. WHILE (p # NIL) & (p.obj # obj) DO p := p.nextProcess END;
  411. Unix.MtxUnlock( processList );
  412. IF (p # NIL) & (p.obj = obj) THEN
  413. p.mode := Terminated;
  414. Unix.ConDestroy( p.continue ); p.continue := 0;
  415. FinalizeProtObject( obj );
  416. p.Cancel
  417. END;
  418. END FinalizeActiveObj;
  419. PROCEDURE FinalizeProtObject( obj: ANY );
  420. VAR hdr: ObjectHeader;
  421. BEGIN
  422. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr );
  423. IF hdr.mtx # 0 THEN
  424. Unix.MtxDestroy( hdr.mtx ); hdr.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. TRACE(p);
  597. NEW( p, NIL, NIL, 0, {}, 0 );
  598. TRACE(p);
  599. END Convert;
  600. PROCEDURE Init;
  601. BEGIN
  602. TRACE("Init");
  603. (*
  604. Unix.Dlsym( 0, "Unix.MtxInit", ADDRESSOF( Unix.MtxInit ) );
  605. Unix.Dlsym( 0, "Unix.MtxDestroy", ADDRESSOF( Unix.MtxDestroy ) );
  606. Unix.Dlsym( 0, "Unix.MtxLock", ADDRESSOF( Unix.MtxLock ) );
  607. Unix.Dlsym( 0, "Unix.MtxUnlock", ADDRESSOF( Unix.MtxUnlock ) );
  608. Unix.Dlsym( 0, "Unix.ConInit", ADDRESSOF( Unix.ConInit ) );
  609. Unix.Dlsym( 0, "Unix.ConDestroy", ADDRESSOF( Unix.ConDestroy ) );
  610. Unix.Dlsym( 0, "Unix.ConWait", ADDRESSOF( Unix.ConWait ) );
  611. Unix.Dlsym( 0, "Unix.ConSignal", ADDRESSOF( Unix.ConSignal ) );
  612. Unix.Dlsym( 0, "thrStart", ADDRESSOF( thrStart ) );
  613. Unix.Dlsym( 0, "Unix.ThrThis", ADDRESSOF( Unix.ThrThis ) );
  614. Unix.Dlsym( 0, "Unix.ThrSleep", ADDRESSOF( Unix.ThrSleep ) );
  615. Unix.Dlsym( 0, "Unix.ThrYield", ADDRESSOF( Unix.ThrYield ) );
  616. Unix.Dlsym( 0, "Unix.ThrExit", ADDRESSOF( Unix.ThrExit ) );
  617. Unix.Dlsym( 0, "Unix.ThrSuspend", ADDRESSOF( Unix.ThrSuspend ) );
  618. Unix.Dlsym( 0, "Unix.ThrResume", ADDRESSOF( Unix.ThrResume ) );
  619. Unix.Dlsym( 0, "Unix.ThrGetPriority", ADDRESSOF( Unix.ThrGetPriority ) );
  620. Unix.Dlsym( 0, "Unix.ThrSetPriority", ADDRESSOF( Unix.ThrSetPriority ) );
  621. Unix.Dlsym( 0, "thrKill", ADDRESSOF( thrKill ) );
  622. *)
  623. createProcess := Unix.MtxInit( 0 ); processList := Unix.MtxInit( 0 );
  624. startProcess := Unix.MtxInit(0); childrunning := Unix.ConInit(0);
  625. collect := FALSE;
  626. igc := Unix.MtxInit( 0 ); gcFinished := Unix.ConInit( 0 );
  627. GetStacksize;
  628. TRACE(0);
  629. Convert;
  630. TRACE(1);
  631. StartTimerActivity;
  632. TRACE(2);
  633. NEW( finalizerCaller );
  634. TRACE(3);
  635. (*
  636. Heaps.saveSP := SaveSP;
  637. Heaps.GC := InvokeGC;
  638. Heaps.InvokeGC := InvokeGC;
  639. *)
  640. END Init;
  641. PROCEDURE {FINAL} Final;
  642. BEGIN
  643. TRACE("FINAL END ");
  644. Machine.Shutdown(FALSE);
  645. END Final;
  646. BEGIN
  647. TRACE("Objects.Body1");
  648. Init;
  649. TRACE("Objects.Body2");
  650. END Objects.