Generic.Unix.Objects.Mod 21 KB

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