2
0

Generic.Unix.Objects.Mod 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817
  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. TRACE(root);
  192. SELF.obj := obj; condition := NIL; continue := Unix.ConInit(0);
  193. flags := fl;
  194. priority := prio;
  195. nextProcess := NIL;
  196. IF root # NIL THEN
  197. newProcess := SELF;
  198. ASSERT( bodyProc # NIL );
  199. body := bodyProc;
  200. Unix.MtxLock( startProcess );
  201. TRACE(body);
  202. thr := Unix.ThrStart( BodyStarter, stacksize );
  203. TRACE(1,thr);
  204. TRACE(1, childrunning, startProcess);
  205. Unix.ConWait( childrunning, startProcess );
  206. Unix.MtxUnlock( startProcess );
  207. TRACE(2,thr);
  208. RegisterFinalizer( SELF, FinalizeProcess );
  209. TRACE(3,thr);
  210. ELSE
  211. (* first process *)
  212. stackBottom := Glue.stackBottom;
  213. SP := Machine.CurrentSP( );
  214. TRACE(root);
  215. threadId := Unix.ThrThis(0);
  216. id := 0; nextPID := 1;
  217. root := SELF;
  218. mainProcess := SELF;
  219. mode := Running;
  220. END;
  221. END Initialize;
  222. END Process;
  223. PROCEDURE BodyStarter;
  224. VAR p{UNTRACED}: Process; res: LONGINT; prevBP: ADDRESS; i: LONGINT;
  225. BEGIN
  226. TRACE("Bodystarter running");
  227. Unix.MtxLock( startProcess );
  228. TRACE("start process");
  229. p := newProcess; newProcess := NIL;
  230. p.threadId := Unix.ThrThis(0);
  231. p.id := nextPID; INC( nextPID );
  232. p.SP := Machine.CurrentSP( );
  233. p.stackBottom := Machine.CurrentBP( );
  234. S.GET( p.stackBottom, prevBP );
  235. S.PUT( prevBP, S.VAL( ADDRESS, 0 ) ); (* for terminating Reflection.StackTraceBack *)
  236. Unix.MtxLock( processList );
  237. p.nextProcess := root; root := p;
  238. Unix.MtxUnlock( processList );
  239. Unix.ConSignal( childrunning );
  240. Unix.MtxUnlock( startProcess );
  241. p.SetPriority( p.priority );
  242. (*!
  243. IF Restart IN p.flags THEN
  244. res := Unix.sigsetjmp( ADDRESSOF( p.state0[0] ), 1 );
  245. END;
  246. *)
  247. p.mode := Running;
  248. p.body( p.obj );
  249. p.mode := Terminated;
  250. Exit
  251. END BodyStarter;
  252. (*--------------------- create, lock, await, unlock -------------------------*)
  253. PROCEDURE InitProtHeader( hdr: ObjectHeader );
  254. VAR lock: LockT;
  255. BEGIN
  256. NEW(lock);
  257. hdr.lock := lock;
  258. lock.mtx := Unix.MtxInit( 0 ); lock.enter := Unix.ConInit( 0 ); hdr.lockedBy := NIL;
  259. END InitProtHeader;
  260. PROCEDURE CreateProcess*( body: Body; priority: LONGINT; flags: SET; obj: ProtectedObject );
  261. VAR p: Process; hdr: ObjectHeader;
  262. BEGIN
  263. TRACE(body);
  264. Unix.MtxLock( createProcess );
  265. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr ); InitProtHeader( hdr );
  266. IF priority = 0 THEN priority := Normal END;
  267. NEW( p, obj, body, priority, flags, stacksize ) ; (* execute BodyStarter as new (posix or solaris) thread *)
  268. Unix.MtxUnlock( createProcess );
  269. RegisterFinalizer( obj, FinalizeActiveObj )
  270. END CreateProcess;
  271. PROCEDURE Lock*( obj: ProtectedObject; exclusive: BOOLEAN );
  272. VAR hdr: ObjectHeader; p: Process; lock: LockT;
  273. BEGIN
  274. ASSERT( exclusive ); (* shared not implemented yet *)
  275. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr );
  276. TRACE(hdr);
  277. p := CurrentProcess();
  278. p.mode := AwaitingLock;
  279. IF hdr.lock = NIL THEN InitProtHeader( hdr ) END;
  280. lock := S.VAL(LockT, hdr.lock);
  281. Unix.MtxLock( lock.mtx );
  282. WHILE hdr.lockedBy # NIL DO
  283. (* wait until threads with complied AWAIT conditions have left the monitor *)
  284. Unix.ConWait( lock.enter, lock.mtx );
  285. END;
  286. p.mode := Running; hdr.lockedBy := p; p.waitingOn := NIL
  287. END Lock;
  288. PROCEDURE Await*( cond: Condition; slink: ADDRESS; obj: ProtectedObject; flags: SET );
  289. VAR hdr: ObjectHeader; p, c: Process; lock: LockT;
  290. BEGIN
  291. IF 1 IN flags THEN (* compiler did not generate IF *)
  292. IF cond( slink ) THEN (* condition already true *) RETURN END
  293. END;
  294. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr ); c := NIL;
  295. lock := S.VAL(LockT, hdr.lock);
  296. IF hdr.awaitingCond.head # NIL THEN c := FindCondition( hdr.awaitingCond ) END;
  297. p := CurrentProcess(); p.succ := NIL; p.condition := cond; p.condFP := slink;
  298. p.waitingOn := obj; p.mode := AwaitingCond;
  299. Put( hdr.awaitingCond, p );
  300. hdr.lockedBy := c;
  301. IF c # NIL THEN Unix.ConSignal( c.continue ) ELSE Unix.ConSignal( lock.enter ) END;
  302. Unix.ConWait( p.continue, lock.mtx );
  303. p.mode := Running; hdr.lockedBy := p; p.waitingOn := NIL
  304. END Await;
  305. PROCEDURE Unlock*( obj: ProtectedObject; dummy: BOOLEAN );
  306. VAR hdr: ObjectHeader; c: Process; lock: LockT;
  307. BEGIN
  308. TRACE("unlock");
  309. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr ); c := NIL;
  310. lock := S.VAL(LockT,hdr.lock);
  311. TRACE(hdr);
  312. TRACE(c);
  313. IF hdr.awaitingCond.head # NIL THEN c := FindCondition( hdr.awaitingCond ) END;
  314. TRACE(c);
  315. TRACE("unlock2");
  316. hdr.lockedBy := c;
  317. TRACE("unlock3");
  318. IF c # NIL THEN Unix.ConSignal( c.continue ) ELSE Unix.ConSignal( lock.enter ) END;
  319. TRACE("unlock4");
  320. Unix.MtxUnlock( lock.mtx );
  321. TRACE("unlock5");
  322. END Unlock;
  323. PROCEDURE FindCondition( VAR q: ProcessQueue ): Process;
  324. VAR first, cand: Process;
  325. BEGIN
  326. Get( q, first );
  327. IF first.condition( first.condFP ) THEN RETURN first ELSE Put( q, first ) END;
  328. WHILE q.head # first DO
  329. Get( q, cand );
  330. IF cand.condition( cand.condFP ) THEN RETURN cand ELSE Put( q, cand ) END;
  331. END;
  332. RETURN NIL
  333. END FindCondition;
  334. PROCEDURE Get( VAR queue: ProcessQueue; VAR new: Process );
  335. VAR t: Process;
  336. BEGIN
  337. t := queue.head(Process);
  338. IF t # NIL THEN
  339. IF t = queue.tail THEN queue.head := NIL; queue.tail := NIL
  340. ELSE queue.head := t.succ; t.succ := NIL
  341. END
  342. END;
  343. new := t
  344. END Get;
  345. PROCEDURE Put( VAR queue: ProcessQueue; t: Process );
  346. BEGIN
  347. IF queue.head = NIL THEN queue.head := t ELSE queue.tail(Process).succ := t END;
  348. queue.tail := t
  349. END Put;
  350. (*-------------------------------------------------------------------------*)
  351. PROCEDURE Terminate*;
  352. BEGIN
  353. Exit
  354. END Terminate;
  355. PROCEDURE TerminateThis*( p: Process; unbreakable: BOOLEAN );
  356. BEGIN
  357. p.mode := Terminated;
  358. p.Cancel
  359. END TerminateThis;
  360. PROCEDURE SetPriority*( pri: LONGINT ); (* Set the current process' priority. *)
  361. VAR me: Process;
  362. BEGIN
  363. me := CurrentProcess();
  364. me.SetPriority( pri )
  365. END SetPriority;
  366. PROCEDURE Sleep*( ms: LONGINT );
  367. BEGIN
  368. Unix.ThrSleep( ms )
  369. END Sleep;
  370. PROCEDURE Yield*; (* Relinquish control. *)
  371. BEGIN
  372. Unix.ThrYield(0);
  373. END Yield;
  374. (* Return current process. (DEPRECATED, use ActiveObject) *)
  375. PROCEDURE CurrentProcess*( ): Process;
  376. VAR me: Unix.Thread_t; p: Process;
  377. BEGIN
  378. me := Unix.ThrThis(0);
  379. Unix.MtxLock( processList );
  380. p := root;
  381. WHILE (p # NIL) & (p.threadId # me) DO p := p.nextProcess END;
  382. Unix.MtxUnlock( processList );
  383. RETURN p
  384. END CurrentProcess;
  385. (* Return the active object currently executing. *)
  386. PROCEDURE ActiveObject*( ): ANY;
  387. VAR p: Process;
  388. BEGIN
  389. p := CurrentProcess();
  390. RETURN p.obj
  391. END ActiveObject;
  392. (* Return stack bottom of process. For compatibility WinAos/UnixAos/NativeAos *)
  393. PROCEDURE GetStackBottom*(p: Process): ADDRESS;
  394. BEGIN
  395. RETURN p.stackBottom
  396. END GetStackBottom;
  397. PROCEDURE GetProcessID*( ): LONGINT;
  398. VAR p: Process;
  399. BEGIN
  400. p := CurrentProcess();
  401. RETURN p.id;
  402. END GetProcessID;
  403. PROCEDURE GetCpuCycles*( process : Process; VAR cpuCycles: CpuCyclesArray; all: BOOLEAN );
  404. VAR i: LONGINT;
  405. BEGIN
  406. ASSERT( process # NIL );
  407. FOR i := 0 TO Machine.MaxCPU-1 DO cpuCycles[i] := 0 END;
  408. END GetCpuCycles;
  409. (*-----------------------------------------------------------------------*)
  410. PROCEDURE min( a, b: LONGINT ): LONGINT;
  411. BEGIN
  412. IF a <= b THEN RETURN a ELSE RETURN b END
  413. END min;
  414. PROCEDURE max( a, b: LONGINT ): LONGINT;
  415. BEGIN
  416. IF a >= b THEN RETURN a ELSE RETURN b END
  417. END max;
  418. PROCEDURE RegisterFinalizer( obj: ANY; fin: Heaps.Finalizer );
  419. VAR n: Heaps.FinalizerNode;
  420. BEGIN
  421. NEW( n ); n.finalizer := fin; Heaps.AddFinalizer( obj, n );
  422. END RegisterFinalizer;
  423. PROCEDURE FinalizeActiveObj( obj: ANY );
  424. VAR p: Process;
  425. BEGIN
  426. Unix.MtxLock( processList );
  427. p := root;
  428. WHILE (p # NIL) & (p.obj # obj) DO p := p.nextProcess END;
  429. Unix.MtxUnlock( processList );
  430. IF (p # NIL) & (p.obj = obj) THEN
  431. p.mode := Terminated;
  432. Unix.ConDestroy( p.continue ); p.continue := 0;
  433. FinalizeProtObject( obj );
  434. p.Cancel
  435. END;
  436. END FinalizeActiveObj;
  437. PROCEDURE FinalizeProtObject( obj: ANY );
  438. VAR hdr: ObjectHeader; lock: LockT;
  439. BEGIN
  440. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr );
  441. IF hdr.lock # NIL THEN
  442. lock := S.VAL(LockT, hdr.lock);
  443. Unix.MtxDestroy( lock.mtx ); lock.mtx := 0
  444. END
  445. END FinalizeProtObject;
  446. PROCEDURE FinalizeProcess( obj: ANY );
  447. VAR p: Process;
  448. BEGIN
  449. p := obj(Process);
  450. IF p.continue # 0 THEN
  451. Unix.ConDestroy( p.continue ); p.continue := 0
  452. END
  453. END FinalizeProcess;
  454. (* Terminate calling thread. *)
  455. PROCEDURE Exit;
  456. VAR prev, p, me: Process;
  457. BEGIN
  458. me := CurrentProcess();
  459. me.mode := Terminated;
  460. Unix.MtxLock( processList );
  461. prev := NIL; p := root;
  462. WHILE (p # NIL ) & (p # me) DO prev := p; p := p.nextProcess END;
  463. IF p = me THEN
  464. IF prev = NIL THEN root := p.nextProcess ELSE prev.nextProcess := p.nextProcess END;
  465. END;
  466. Unix.MtxUnlock( processList );
  467. Unix.ThrExit(0);
  468. END Exit;
  469. PROCEDURE ExitTrap*;
  470. VAR p: Process;
  471. BEGIN
  472. p := CurrentProcess();
  473. (* restart the object body if it was given the SAFE flag *)
  474. IF Restart IN p.flags THEN
  475. Unix.siglongjmp( ADDRESSOF( p.state0[0] ), 1 )
  476. END;
  477. Exit
  478. END ExitTrap;
  479. (*---------------------------- Timer --------------------------------*)
  480. PROCEDURE Remove( t: Timer ); (* remove timer from list of active timers *)
  481. VAR p, x: Timer;
  482. BEGIN
  483. Unix.MtxLock( timerListMutex );
  484. t.trigger := 0; t.handler := NIL;
  485. IF timers # NIL THEN
  486. IF t = timers THEN
  487. timers := t.next
  488. ELSE
  489. p := timers; x := p.next;
  490. WHILE (x # NIL) & (x # t) DO p := x; x := p.next END;
  491. IF x = t THEN p.next := t.next END
  492. END;
  493. t.next := NIL
  494. END;
  495. Unix.MtxUnlock( timerListMutex )
  496. END Remove;
  497. PROCEDURE Insert( t: Timer );
  498. VAR p, x: Timer;
  499. BEGIN
  500. Unix.MtxLock( timerListMutex );
  501. p := NIL; x := timers;
  502. WHILE (x # NIL) & (x.trigger < t.trigger) DO p := x; x := p.next END;
  503. t.next := x;
  504. IF p = NIL THEN timers := t ELSE p.next := t END;
  505. Unix.MtxUnlock( timerListMutex )
  506. END Insert;
  507. PROCEDURE SetTimeout*( t: Timer; h: EventHandler; ms: LONGINT );
  508. BEGIN
  509. ASSERT( ( t # NIL) & ( h # NIL) );
  510. Remove( t );
  511. IF ms < 1 THEN ms := 1 END;
  512. t.trigger := Machine.ticks + ms; t.handler := h;
  513. Insert( t );
  514. timerActivity.Restart
  515. END SetTimeout;
  516. PROCEDURE SetTimeoutAt*( t: Timer; h: EventHandler; ms: LONGINT );
  517. BEGIN
  518. ASSERT( (t # NIL) & (h # NIL) );
  519. Remove( t );
  520. t.trigger := ms; t.handler := h;
  521. Insert( t );
  522. timerActivity.Restart
  523. END SetTimeoutAt;
  524. PROCEDURE CancelTimeout*( t: Timer );
  525. BEGIN
  526. Remove( t )
  527. END CancelTimeout;
  528. (*-------------------- Garbage Collection ------------------------------------*)
  529. PROCEDURE SuspendActivities;
  530. VAR t: Process;
  531. BEGIN
  532. t := root;
  533. WHILE t # NIL DO
  534. IF (t # mainProcess) & (t # finCaller) THEN Unix.ThrSuspend( t.threadId ) END;
  535. t := t.nextProcess
  536. END;
  537. END SuspendActivities;
  538. PROCEDURE ResumeActivities;
  539. VAR t: Process;
  540. BEGIN
  541. t := root;
  542. WHILE t # NIL DO
  543. IF (t # mainProcess) & (t # finCaller) THEN Unix.ThrResume( t.threadId ) END;
  544. t := t.nextProcess
  545. END;
  546. END ResumeActivities;
  547. PROCEDURE SaveSP; (* save current SP for usage by the GC *)
  548. VAR me: Unix.Thread_t; t: Process;
  549. BEGIN
  550. me := Unix.ThrThis(0); t := root;
  551. WHILE (t # NIL ) & (t.threadId # me) DO t := t.nextProcess END;
  552. IF t # NIL THEN t.SP := Machine.CurrentSP( ) END
  553. END SaveSP;
  554. PROCEDURE InvokeGC;
  555. BEGIN
  556. IF Machine.AcquireGC() THEN (* gets released by FinalizerCaller *)
  557. collect := TRUE;
  558. Unix.ConWait( gcFinished, igc )
  559. END;
  560. END InvokeGC;
  561. (*! GCLoop gets called as last procedure in BootConsole (main thread).
  562. The stack of the main thread is not limited by the boot parameter 'StackSize' !!
  563. *)
  564. PROCEDURE GCLoop*; (* Timer and GC activity *)
  565. BEGIN
  566. SetPriority( GCPriority );
  567. LOOP
  568. IF collect THEN
  569. collect := FALSE;
  570. Machine.Acquire( Machine.Heaps );
  571. SuspendActivities;
  572. Heaps.CollectGarbage( Modules.root );
  573. Machine.Release( Machine.Heaps );
  574. ResumeActivities;
  575. finalizerCaller.Start;
  576. Unix.ConSignal( gcFinished );
  577. ELSE
  578. Unix.ThrSleep( 10 );
  579. END;
  580. timerActivity.UpdateTicks
  581. END
  582. END GCLoop;
  583. PROCEDURE CurrentProcessTime*(): HUGEINT;
  584. BEGIN
  585. RETURN Machine.GetTimer()
  586. END CurrentProcessTime;
  587. PROCEDURE TimerFrequency*(): HUGEINT;
  588. BEGIN
  589. RETURN Machine.mhz * 1000000
  590. END TimerFrequency;
  591. (*----------------------------- initialization ----------------------------------*)
  592. PROCEDURE StartTimerActivity;
  593. BEGIN
  594. timerListMutex := Unix.MtxInit(0); timers := NIL;
  595. NEW( timerActivity );
  596. END StartTimerActivity;
  597. PROCEDURE GetStacksize;
  598. VAR str: ARRAY 32 OF CHAR; i: LONGINT;
  599. BEGIN
  600. Machine.GetConfig( "StackSize", str );
  601. IF str = "" THEN stacksize := DefaultStacksize
  602. ELSE
  603. i := 0; stacksize := Machine.StrToInt( i, str );
  604. stacksize := stacksize * 1024;
  605. END;
  606. IF Glue.debug # {} THEN
  607. Trace.String( "Stacksize of active objects = " );
  608. Trace.Int( stacksize DIV 1024, 0 ); Trace.StringLn( "K" )
  609. END;
  610. END GetStacksize;
  611. PROCEDURE Convert;
  612. VAR p: Process;
  613. BEGIN
  614. (* make current thread the first active object *)
  615. TRACE(p);
  616. NEW( p, NIL, NIL, 0, {}, 0 );
  617. TRACE(p);
  618. END Convert;
  619. PROCEDURE Init;
  620. BEGIN
  621. TRACE("Init");
  622. (*
  623. Unix.Dlsym( 0, "Unix.MtxInit", ADDRESSOF( Unix.MtxInit ) );
  624. Unix.Dlsym( 0, "Unix.MtxDestroy", ADDRESSOF( Unix.MtxDestroy ) );
  625. Unix.Dlsym( 0, "Unix.MtxLock", ADDRESSOF( Unix.MtxLock ) );
  626. Unix.Dlsym( 0, "Unix.MtxUnlock", ADDRESSOF( Unix.MtxUnlock ) );
  627. Unix.Dlsym( 0, "Unix.ConInit", ADDRESSOF( Unix.ConInit ) );
  628. Unix.Dlsym( 0, "Unix.ConDestroy", ADDRESSOF( Unix.ConDestroy ) );
  629. Unix.Dlsym( 0, "Unix.ConWait", ADDRESSOF( Unix.ConWait ) );
  630. Unix.Dlsym( 0, "Unix.ConSignal", ADDRESSOF( Unix.ConSignal ) );
  631. Unix.Dlsym( 0, "thrStart", ADDRESSOF( thrStart ) );
  632. Unix.Dlsym( 0, "Unix.ThrThis", ADDRESSOF( Unix.ThrThis ) );
  633. Unix.Dlsym( 0, "Unix.ThrSleep", ADDRESSOF( Unix.ThrSleep ) );
  634. Unix.Dlsym( 0, "Unix.ThrYield", ADDRESSOF( Unix.ThrYield ) );
  635. Unix.Dlsym( 0, "Unix.ThrExit", ADDRESSOF( Unix.ThrExit ) );
  636. Unix.Dlsym( 0, "Unix.ThrSuspend", ADDRESSOF( Unix.ThrSuspend ) );
  637. Unix.Dlsym( 0, "Unix.ThrResume", ADDRESSOF( Unix.ThrResume ) );
  638. Unix.Dlsym( 0, "Unix.ThrGetPriority", ADDRESSOF( Unix.ThrGetPriority ) );
  639. Unix.Dlsym( 0, "Unix.ThrSetPriority", ADDRESSOF( Unix.ThrSetPriority ) );
  640. Unix.Dlsym( 0, "thrKill", ADDRESSOF( thrKill ) );
  641. *)
  642. createProcess := Unix.MtxInit( 0 ); processList := Unix.MtxInit( 0 );
  643. startProcess := Unix.MtxInit(0); childrunning := Unix.ConInit(0);
  644. collect := FALSE;
  645. igc := Unix.MtxInit( 0 ); gcFinished := Unix.ConInit( 0 );
  646. GetStacksize;
  647. TRACE(0);
  648. Convert;
  649. TRACE(1);
  650. StartTimerActivity;
  651. TRACE(2);
  652. NEW( finalizerCaller );
  653. TRACE(3);
  654. (*
  655. Heaps.saveSP := SaveSP;
  656. Heaps.GC := InvokeGC;
  657. Heaps.InvokeGC := InvokeGC;
  658. *)
  659. END Init;
  660. PROCEDURE {FINAL} Final;
  661. BEGIN
  662. TRACE("FINAL END ");
  663. Machine.Shutdown(FALSE);
  664. END Final;
  665. BEGIN
  666. TRACE("Objects.Body1");
  667. Init;
  668. TRACE("Objects.Body2");
  669. END Objects.