Generic.Unix.Objects.Mod 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942
  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. VAR
  25. (* timer *)
  26. timerActivity : TimerActivity;
  27. clock : Clock;
  28. timers : Timer;
  29. timerListMutex : Unix.Mutex_t;
  30. timerStopped: BOOLEAN;
  31. (* processes *)
  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. lockMutex : Unix.Mutex_t;
  38. childrunning : Unix.Condition_t;
  39. newProcess: Process;
  40. nextPID: LONGINT;
  41. finalizerCaller : FinalizerCaller;
  42. mainthread: Unix.Thread_t;
  43. TYPE
  44. LockT= POINTER TO RECORD
  45. mtx, enter: ADDRESS;
  46. END;
  47. CpuCyclesArray* = ARRAY Machine.MaxCPU OF HUGEINT;
  48. ProtectedObject = POINTER TO RECORD END;
  49. ObjectHeader = Heaps.ProtRecBlock;
  50. ProcessQueue = Heaps.ProcessQueue;
  51. EventHandler* = PROCEDURE {DELEGATE};
  52. Timer* = OBJECT
  53. VAR
  54. next: Timer;
  55. trigger: LONGINT;
  56. handler: EventHandler
  57. END Timer;
  58. TimerActivity = OBJECT
  59. VAR
  60. t, r: Timer; h: EventHandler; restart: BOOLEAN;
  61. PROCEDURE UpdateTicks;
  62. BEGIN {EXCLUSIVE}
  63. Machine.UpdateTicks
  64. END UpdateTicks;
  65. PROCEDURE Restart;
  66. BEGIN {EXCLUSIVE}
  67. restart := TRUE
  68. END Restart;
  69. BEGIN {ACTIVE, SAFE, PRIORITY(High)}
  70. restart := FALSE;
  71. LOOP
  72. t := timers;
  73. IF t # NIL THEN
  74. h := NIL; r := NIL;
  75. BEGIN {EXCLUSIVE}
  76. AWAIT( (Machine.ticks >= t.trigger) OR restart ); restart := FALSE;
  77. IF Machine.ticks >= t.trigger THEN
  78. h := t.handler; r := t
  79. END
  80. END;
  81. IF r # NIL THEN Remove( r ) END;
  82. IF h # NIL THEN (* not canceled *) h END
  83. ELSE
  84. BEGIN{EXCLUSIVE}
  85. AWAIT( restart ); restart := FALSE;
  86. END
  87. END
  88. END
  89. END TimerActivity;
  90. Clock* = OBJECT
  91. BEGIN {ACTIVE}
  92. LOOP
  93. Unix.ThrSleep( 10 );
  94. IF ~timerStopped THEN timerActivity.UpdateTicks END
  95. END;
  96. END Clock;
  97. FinalizedCollection* = OBJECT (* base type for collection, extended in Kernel.Mod *)
  98. PROCEDURE RemoveAll*(obj: ANY); (** abstract *)
  99. BEGIN HALT(301) END RemoveAll;
  100. END FinalizedCollection;
  101. FinalizerNode* = POINTER TO RECORD (Heaps.FinalizerNode)
  102. c*: FinalizedCollection (* base type for collection containing object *)
  103. END;
  104. FinalizerCaller = OBJECT (* separate active object that calls finalizers *)
  105. VAR
  106. n: Heaps.FinalizerNode; start: BOOLEAN;
  107. PROCEDURE Activate;
  108. BEGIN {EXCLUSIVE}
  109. start := TRUE
  110. END Activate;
  111. BEGIN {ACTIVE, SAFE, PRIORITY(High)}
  112. start := FALSE;
  113. LOOP
  114. BEGIN {EXCLUSIVE} AWAIT( start ) END;
  115. start := FALSE;
  116. LOOP
  117. n := Heaps.GetFinalizer();
  118. IF n = NIL THEN EXIT END;
  119. IF n IS FinalizerNode THEN
  120. n(FinalizerNode).c.RemoveAll(n.objStrong) (* remove it if it is not removed yet *)
  121. END;
  122. IF n.finalizer # NIL THEN
  123. n.finalizer(n.objStrong) (* may acquire locks *)
  124. END;
  125. END;
  126. END
  127. END FinalizerCaller;
  128. Body = PROCEDURE ( self: ProtectedObject );
  129. Condition = PROCEDURE ( slink: ADDRESS ): BOOLEAN;
  130. Process* = OBJECT (Heaps.ProcessLink)
  131. VAR
  132. threadId- : Unix.Thread_t;
  133. nextProcess- : Process; (* next in list of all processes *)
  134. stackBottom - : ADDRESS;
  135. id- : LONGINT;
  136. body : Body;
  137. mode- : LONGINT;
  138. flags- : SET;
  139. priority- : LONGINT; (* only effective if Aos is running SUID root *)
  140. succ : Process; (* in ProcessQueue *)
  141. obj- : ProtectedObject; (* associated active object *)
  142. condition- : Condition; (* awaited process' condition *)
  143. condFP- : ADDRESS; (* awaited process' condition's context *)
  144. continue : Unix.Condition_t; (* gets signaled when condition yields true *)
  145. waitingOn- : ProtectedObject;
  146. procID- : LONGINT; (*! processor ID where running, not used in UnixAos *)
  147. state- : Machine.State;
  148. context- : Unix.McontextDesc;
  149. state0 : ARRAY 2048 OF CHAR; (* thread state at body start, used for restart after trap *)
  150. context: ANY; (* commands context *)
  151. PROCEDURE FindRoots*;
  152. VAR sp, bp, n, a0, a1, adr: ADDRESS; desc: Modules.ProcedureDescPointer; i: LONGINT; p {UNTRACED}: ANY;
  153. BEGIN
  154. IF mode # Terminated THEN
  155. IF SELF = CurrentProcess() THEN
  156. state.SP := Machine.CurrentSP( );
  157. state.BP := Machine.CurrentBP( );
  158. END;
  159. sp := state.SP; bp := state.BP;
  160. IF Heaps.GCType = Heaps.HeuristicStackInspectionGC THEN
  161. IF (stackBottom # 0) & (sp # 0) & (sp <= stackBottom) THEN
  162. Heaps.RegisterCandidates( sp, stackBottom - sp );
  163. END;
  164. ELSIF Heaps.GCType = Heaps.MetaDataForStackGC THEN
  165. IF bp < stackBottom THEN
  166. WHILE (bp # Heaps.NilVal) & (bp > 1024) & (bp < stackBottom) DO (* do not test for bp >= sp: could be wrong temporarily! *)
  167. S.GET( bp, n );
  168. IF ODD( n ) THEN (* procedure descriptor at bp *)
  169. IF n > 1024 THEN
  170. desc := S.VAL( Modules.ProcedureDescPointer, n-1 );
  171. IF desc # NIL THEN
  172. a0 := ADDRESSOF( desc.offsets );
  173. a1 := S.VAL( ADDRESS, desc.offsets );
  174. ASSERT( a0+SIZEOF( ADDRESS ) = a1, 54321 );
  175. FOR i := 0 TO LEN( desc.offsets ) - 1 DO
  176. adr := bp + desc.offsets[i]; (* pointer at offset *)
  177. S.GET( adr, p ); (* load pointer *)
  178. IF p # NIL THEN
  179. Heaps.Mark( p );
  180. END
  181. END
  182. END
  183. END;
  184. S.GET( bp + SIZEOF( ADDRESS ), bp );
  185. ELSE (* classical stack frame *)
  186. bp := n;
  187. END;
  188. END;
  189. ASSERT( (bp = stackBottom) OR (bp < 1024) , 12345 );
  190. END;
  191. END
  192. END;
  193. Heaps.Mark( nextProcess )
  194. END FindRoots;
  195. PROCEDURE Cancel;
  196. VAR pt, t: Process; kt: Unix.Thread_t;
  197. BEGIN
  198. IF SELF = CurrentProcess() THEN Exit
  199. ELSE
  200. Machine.Acquire( Machine.X11 ); (* let the thread to be killed first finish its last I/O, if any *)
  201. Unix.MtxLock( processList );
  202. pt := NIL; t := root; kt := 0;
  203. WHILE (t # NIL ) & (t # SELF) DO pt := t; t := t.nextProcess END;
  204. IF t = SELF THEN
  205. kt := threadId;
  206. IF pt = NIL THEN root := t.nextProcess ELSE pt.nextProcess := t.nextProcess END;
  207. END;
  208. Unix.MtxUnlock( processList );
  209. IF kt # 0 THEN Unix.ThrKill( kt ) END;
  210. Machine.Release( Machine.X11 );
  211. END
  212. END Cancel;
  213. PROCEDURE GetPriority( ): LONGINT;
  214. BEGIN
  215. RETURN Unix.ThrGetPriority( threadId )
  216. END GetPriority;
  217. PROCEDURE SetPriority( prio: LONGINT );
  218. VAR pr: LONGINT;
  219. BEGIN
  220. pr := max( Machine.prioLow, min( prio, Machine.prioHigh ) );
  221. Unix.ThrSetPriority( threadId, pr ); (* works only if SUID root *)
  222. priority := GetPriority( )
  223. END SetPriority;
  224. PROCEDURE & Initialize( obj: ProtectedObject; bodyProc: Body; prio: LONGINT; fl: SET; stacksize: LONGINT);
  225. BEGIN
  226. SELF.obj := obj; condition := NIL; continue := Unix.NewCond( );
  227. flags := fl;
  228. priority := prio;
  229. nextProcess := NIL;
  230. context := CurrentContext();
  231. IF root # NIL THEN
  232. newProcess := SELF;
  233. ASSERT( bodyProc # NIL );
  234. body := bodyProc;
  235. Unix.MtxLock( startProcess );
  236. threadId := Unix.ThrStart( BodyStarter, stacksize );
  237. Unix.CondWait( childrunning, startProcess );
  238. Unix.MtxUnlock( startProcess );
  239. RegisterFinalizer( SELF, FinalizeProcess );
  240. ELSE
  241. (* first process *)
  242. stackBottom := Glue.stackBottom;
  243. threadId := Unix.ThrThis( );
  244. id := 0; nextPID := 1;
  245. root := SELF;
  246. mode := Running;
  247. END;
  248. END Initialize;
  249. END Process;
  250. GCStatusExt = OBJECT (Heaps.GCStatus)
  251. (* called from Heaps.InvokeGC, i.e. this is a hidden upcall. However, it is necessary to take the Machine.Objects
  252. lock here since writing the set of variables here must not be interrupted, i.e. atomic writing of the set of variables
  253. is absolutely necessary. They system may hang if the lock is not taken. *)
  254. PROCEDURE SetgcOngoing( value: BOOLEAN );
  255. VAR cur: Process;
  256. BEGIN (* serialize writers *)
  257. cur := CurrentProcess();
  258. IF value THEN
  259. Machine.Acquire( Machine.Objects );
  260. Machine.Acquire( Machine.Heaps );
  261. cur.state.SP := Machine.CurrentSP();
  262. cur.state.BP := Machine.CurrentBP();
  263. cur.state.PC := ADDRESSOF( GCLoop );
  264. SuspendActivities;
  265. Heaps.CollectGarbage( Modules.root );
  266. Machine.Release( Machine.Heaps );
  267. Machine.Release( Machine.Objects );
  268. ResumeActivities;
  269. finalizerCaller.Activate;
  270. END;
  271. END SetgcOngoing;
  272. END GCStatusExt;
  273. PROCEDURE BodyStarter;
  274. VAR p{UNTRACED}: Process; res: LONGINT; prevBP: ADDRESS;
  275. BEGIN
  276. Unix.MtxLock( startProcess );
  277. p := newProcess; newProcess := NIL;
  278. p.id := nextPID; INC( nextPID );
  279. p.stackBottom := Machine.CurrentBP( );
  280. S.GET( p.stackBottom, prevBP );
  281. S.PUT( prevBP, S.VAL( ADDRESS, 0 ) ); (* for terminating Reflection.StackTraceBack *)
  282. Unix.MtxLock( processList );
  283. p.nextProcess := root; root := p;
  284. Unix.MtxUnlock( processList );
  285. Unix.CondSignal( childrunning );
  286. Unix.MtxUnlock( startProcess );
  287. p.SetPriority( p.priority );
  288. IF Restart IN p.flags THEN
  289. res := Unix.sigsetjmp( ADDRESSOF( p.state0[0] ), 1 );
  290. END;
  291. p.mode := Running;
  292. p.body( p.obj );
  293. p.mode := Terminated;
  294. Exit
  295. END BodyStarter;
  296. (*--------------------- create, lock, await, unlock -------------------------*)
  297. (* initialize the ObjectHeader, requires lockMutex temporarily *)
  298. PROCEDURE InitProtHeader( hdr: ObjectHeader);
  299. VAR lock: LockT;
  300. BEGIN
  301. (* we cannot hold the lockMute here because allocation can trigger the GC that requires the lock when activating the finalizers *)
  302. NEW(lock);
  303. Unix.MtxLock(lockMutex);
  304. IF hdr.lock = NIL THEN
  305. hdr.lock := lock;
  306. lock.mtx := Unix.NewMtx( ); lock.enter := Unix.NewCond( ); hdr.lockedBy := NIL;
  307. END;
  308. Unix.MtxUnlock(lockMutex);
  309. END InitProtHeader;
  310. PROCEDURE CreateProcess*( body: Body; priority: LONGINT; flags: SET; obj: ProtectedObject );
  311. VAR p: Process; hdr: ObjectHeader;
  312. BEGIN
  313. Unix.MtxLock( createProcess );
  314. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr );
  315. InitProtHeader( hdr );
  316. IF priority = 0 THEN priority := Normal END;
  317. NEW( p, obj, body, priority, flags, stacksize ) ; (* execute BodyStarter as new (posix or solaris) thread *)
  318. Unix.MtxUnlock( createProcess );
  319. RegisterFinalizer( obj, FinalizeActiveObj )
  320. END CreateProcess;
  321. PROCEDURE Lock*( obj: ProtectedObject; exclusive: BOOLEAN );
  322. VAR hdr: ObjectHeader; p: Process; lock: LockT;
  323. BEGIN
  324. ASSERT( exclusive ); (* shared not implemented yet *)
  325. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr );
  326. p := CurrentProcess();
  327. p.state.SP := Machine.CurrentSP( );
  328. p.state.BP := Machine.CurrentBP( );
  329. p.state.PC := Machine.CurrentPC( );
  330. p.mode := AwaitingLock;
  331. (*! we might want to replace the lock mutex by a lock free construct *)
  332. IF hdr.lock = NIL THEN InitProtHeader( hdr ) END;
  333. lock := S.VAL(LockT, hdr.lock);
  334. p.mode := AwaitingLock;
  335. Unix.MtxLock( lock.mtx );
  336. WHILE hdr.lockedBy # NIL DO
  337. (* wait until threads with complied AWAIT conditions have left the monitor *)
  338. Unix.CondWait( lock.enter, lock.mtx );
  339. END;
  340. p.mode := Running; hdr.lockedBy := p; p.waitingOn := NIL
  341. END Lock;
  342. PROCEDURE Await*( cond: Condition; slink: ADDRESS; obj: ProtectedObject; flags: SET );
  343. VAR hdr: ObjectHeader; p, c: Process; lock: LockT;
  344. BEGIN
  345. IF 1 IN flags THEN (* compiler did not generate IF *)
  346. IF cond( slink ) THEN (* condition already true *) RETURN END
  347. END;
  348. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr ); c := NIL;
  349. lock := S.VAL(LockT, hdr.lock);
  350. IF hdr.awaitingCond.head # NIL THEN c := FindCondition( hdr.awaitingCond ) END;
  351. p := CurrentProcess(); p.succ := NIL; p.condition := cond; p.condFP := slink;
  352. p.waitingOn := obj; p.mode := AwaitingCond;
  353. Put( hdr.awaitingCond, p );
  354. hdr.lockedBy := c;
  355. IF c # NIL THEN Unix.CondSignal( c.continue ) ELSE Unix.CondSignal( lock.enter ) END;
  356. p.state.SP := Machine.CurrentSP( );
  357. p.state.BP := Machine.CurrentBP( );
  358. p.state.PC := Machine.CurrentPC( );
  359. Unix.CondWait( p.continue, lock.mtx );
  360. p.mode := Running; hdr.lockedBy := p; p.waitingOn := NIL
  361. END Await;
  362. PROCEDURE Unlock*( obj: ProtectedObject; dummy: BOOLEAN );
  363. VAR hdr: ObjectHeader; c: Process; lock: LockT;
  364. BEGIN
  365. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr ); c := NIL;
  366. lock := S.VAL(LockT,hdr.lock);
  367. IF hdr.awaitingCond.head # NIL THEN c := FindCondition( hdr.awaitingCond ) END;
  368. hdr.lockedBy := c;
  369. IF c # NIL THEN Unix.CondSignal( c.continue ) ELSE Unix.CondSignal( lock.enter ) END;
  370. Unix.MtxUnlock( lock.mtx );
  371. END Unlock;
  372. PROCEDURE FindCondition( VAR q: ProcessQueue ): Process;
  373. VAR first, cand: Process;
  374. BEGIN
  375. Get( q, first );
  376. IF first.condition( first.condFP ) THEN RETURN first ELSE Put( q, first ) END;
  377. WHILE q.head # first DO
  378. Get( q, cand );
  379. IF cand.condition( cand.condFP ) THEN RETURN cand ELSE Put( q, cand ) END;
  380. END;
  381. RETURN NIL
  382. END FindCondition;
  383. PROCEDURE Get( VAR queue: ProcessQueue; VAR new: Process );
  384. VAR t: Process;
  385. BEGIN
  386. t := queue.head(Process);
  387. IF t # NIL THEN
  388. IF t = queue.tail THEN queue.head := NIL; queue.tail := NIL
  389. ELSE queue.head := t.succ; t.succ := NIL
  390. END
  391. END;
  392. new := t
  393. END Get;
  394. PROCEDURE Put( VAR queue: ProcessQueue; t: Process );
  395. BEGIN
  396. IF queue.head = NIL THEN queue.head := t ELSE queue.tail(Process).succ := t END;
  397. queue.tail := t
  398. END Put;
  399. (*-------------------------------------------------------------------------*)
  400. PROCEDURE Terminate*;
  401. BEGIN
  402. Exit
  403. END Terminate;
  404. PROCEDURE TerminateThis*( p: Process; unbreakable: BOOLEAN );
  405. BEGIN
  406. p.mode := Terminated;
  407. p.Cancel
  408. END TerminateThis;
  409. PROCEDURE SetPriority*( pri: LONGINT ); (* Set the current process' priority. *)
  410. VAR me: Process;
  411. BEGIN
  412. me := CurrentProcess();
  413. me.SetPriority( pri )
  414. END SetPriority;
  415. PROCEDURE Sleep*( ms: LONGINT );
  416. BEGIN
  417. Unix.ThrSleep( ms );
  418. END Sleep;
  419. PROCEDURE Yield*; (* Relinquish control. *)
  420. BEGIN
  421. Unix.ThrYield( );
  422. END Yield;
  423. (* Return current process. (DEPRECATED, use ActiveObject) *)
  424. PROCEDURE CurrentProcess*( ): Process;
  425. VAR me: Unix.Thread_t; p: Process;
  426. BEGIN
  427. me := Unix.ThrThis( );
  428. Unix.MtxLock( processList );
  429. p := root;
  430. WHILE (p # NIL) & (p.threadId # me) DO p := p.nextProcess END;
  431. Unix.MtxUnlock( processList );
  432. RETURN p
  433. END CurrentProcess;
  434. PROCEDURE CurrentContext*(): ANY;
  435. VAR p: Process;
  436. BEGIN
  437. p := CurrentProcess();
  438. IF p # NIL THEN RETURN p.context
  439. ELSE RETURN NIL
  440. END;
  441. END CurrentContext;
  442. PROCEDURE SetContext*(context: ANY);
  443. VAR p: Process;
  444. BEGIN
  445. p := CurrentProcess();
  446. IF p # NIL THEN p.context := context END;
  447. END SetContext;
  448. PROCEDURE CurrentProcess0( ): Process;
  449. VAR me: Unix.Thread_t; p: Process;
  450. BEGIN
  451. me := Unix.ThrThis( );
  452. p := root;
  453. WHILE (p # NIL) & (p.threadId # me) DO p := p.nextProcess END;
  454. RETURN p
  455. END CurrentProcess0;
  456. (* Return the active object currently executing. *)
  457. PROCEDURE ActiveObject*( ): ANY;
  458. VAR p: Process;
  459. BEGIN
  460. p := CurrentProcess();
  461. RETURN p.obj
  462. END ActiveObject;
  463. (* Return stack bottom of process. For compatibility WinAos/UnixAos/NativeAos *)
  464. PROCEDURE GetStackBottom*(p: Process): ADDRESS;
  465. BEGIN
  466. RETURN p.stackBottom
  467. END GetStackBottom;
  468. PROCEDURE GetProcessID*( ): LONGINT;
  469. VAR p: Process;
  470. BEGIN
  471. p := CurrentProcess();
  472. RETURN p.id;
  473. END GetProcessID;
  474. PROCEDURE GetCpuCycles*( process : Process; VAR cpuCycles: CpuCyclesArray; all: BOOLEAN );
  475. VAR i: LONGINT;
  476. BEGIN
  477. ASSERT( process # NIL );
  478. FOR i := 0 TO Machine.MaxCPU-1 DO cpuCycles[i] := 0 END;
  479. END GetCpuCycles;
  480. (*-----------------------------------------------------------------------*)
  481. PROCEDURE min( a, b: LONGINT ): LONGINT;
  482. BEGIN
  483. IF a <= b THEN RETURN a ELSE RETURN b END
  484. END min;
  485. PROCEDURE max( a, b: LONGINT ): LONGINT;
  486. BEGIN
  487. IF a >= b THEN RETURN a ELSE RETURN b END
  488. END max;
  489. PROCEDURE RegisterFinalizer( obj: ANY; fin: Heaps.Finalizer );
  490. VAR n: Heaps.FinalizerNode;
  491. BEGIN
  492. NEW( n ); n.finalizer := fin; Heaps.AddFinalizer( obj, n );
  493. END RegisterFinalizer;
  494. PROCEDURE FinalizeActiveObj( obj: ANY );
  495. VAR p: Process;
  496. BEGIN
  497. Unix.MtxLock( processList );
  498. p := root;
  499. WHILE (p # NIL) & (p.obj # obj) DO p := p.nextProcess END;
  500. Unix.MtxUnlock( processList );
  501. IF (p # NIL) & (p.obj = obj) THEN
  502. p.mode := Terminated;
  503. Unix.CondDestroy( p.continue ); p.continue := 0;
  504. FinalizeProtObject( obj );
  505. p.Cancel
  506. END;
  507. END FinalizeActiveObj;
  508. PROCEDURE FinalizeProtObject( obj: ANY );
  509. VAR hdr: ObjectHeader; lock: LockT;
  510. BEGIN
  511. S.GET( S.VAL( ADDRESS, obj ) + Heaps.HeapBlockOffset, hdr );
  512. IF hdr.lock # NIL THEN
  513. lock := S.VAL(LockT, hdr.lock);
  514. Unix.MtxDestroy( lock.mtx ); lock.mtx := 0
  515. END
  516. END FinalizeProtObject;
  517. PROCEDURE FinalizeProcess( obj: ANY );
  518. VAR p: Process;
  519. BEGIN
  520. p := obj(Process);
  521. IF p.continue # 0 THEN
  522. Unix.CondDestroy( p.continue ); p.continue := 0
  523. END
  524. END FinalizeProcess;
  525. (* Terminate calling thread. *)
  526. PROCEDURE Exit;
  527. VAR prev, p, me: Process;
  528. BEGIN
  529. me := CurrentProcess();
  530. me.mode := Terminated;
  531. Unix.MtxLock( processList );
  532. prev := NIL; p := root;
  533. WHILE (p # NIL ) & (p # me) DO prev := p; p := p.nextProcess END;
  534. IF p = me THEN
  535. IF prev = NIL THEN root := p.nextProcess ELSE prev.nextProcess := p.nextProcess END;
  536. END;
  537. Unix.MtxUnlock( processList );
  538. Unix.ThrExit( );
  539. END Exit;
  540. PROCEDURE ExitTrap*;
  541. VAR p: Process;
  542. BEGIN
  543. p := CurrentProcess();
  544. (* restart the object body if it was given the SAFE flag *)
  545. IF Restart IN p.flags THEN
  546. Unix.siglongjmp( ADDRESSOF( p.state0[0] ), 1 )
  547. END;
  548. Exit
  549. END ExitTrap;
  550. (*---------------------------- Timer --------------------------------*)
  551. PROCEDURE Remove( t: Timer ); (* remove timer from list of active timers *)
  552. VAR p, x: Timer;
  553. BEGIN
  554. Unix.MtxLock( timerListMutex );
  555. t.trigger := 0; t.handler := NIL;
  556. IF timers # NIL THEN
  557. IF t = timers THEN
  558. timers := t.next
  559. ELSE
  560. p := timers; x := p.next;
  561. WHILE (x # NIL) & (x # t) DO p := x; x := p.next END;
  562. IF x = t THEN p.next := t.next END
  563. END;
  564. t.next := NIL
  565. END;
  566. Unix.MtxUnlock( timerListMutex )
  567. END Remove;
  568. PROCEDURE Insert( t: Timer );
  569. VAR p, x: Timer;
  570. BEGIN
  571. Unix.MtxLock( timerListMutex );
  572. p := NIL; x := timers;
  573. WHILE (x # NIL) & (x.trigger < t.trigger) DO p := x; x := p.next END;
  574. t.next := x;
  575. IF p = NIL THEN timers := t ELSE p.next := t END;
  576. Unix.MtxUnlock( timerListMutex )
  577. END Insert;
  578. PROCEDURE SetTimeout*( t: Timer; h: EventHandler; ms: LONGINT );
  579. BEGIN
  580. ASSERT( ( t # NIL) & ( h # NIL) );
  581. Remove( t );
  582. IF ms < 1 THEN ms := 1 END;
  583. t.trigger := Machine.ticks + ms; t.handler := h;
  584. Insert( t );
  585. timerActivity.Restart
  586. END SetTimeout;
  587. PROCEDURE SetTimeoutAt*( t: Timer; h: EventHandler; ms: LONGINT );
  588. BEGIN
  589. ASSERT( (t # NIL) & (h # NIL) );
  590. Remove( t );
  591. t.trigger := ms; t.handler := h;
  592. Insert( t );
  593. timerActivity.Restart
  594. END SetTimeoutAt;
  595. PROCEDURE CancelTimeout*( t: Timer );
  596. BEGIN
  597. Remove( t )
  598. END CancelTimeout;
  599. (*-------------------- Garbage Collection ------------------------------------*)
  600. PROCEDURE GetContext( ctxt: Unix.Ucontext );
  601. VAR t: Process;
  602. BEGIN
  603. (* use CurrentProcess0 here instead of CurrentProcess in order to
  604. avoid a possible deadlock *)
  605. t := CurrentProcess0( );
  606. Unix.CopyContext( ctxt.mc, t.context );
  607. t.state.PC := t.context.r_pc;
  608. t.state.BP := t.context.r_bp;
  609. t.state.SP := t.context.r_sp
  610. END GetContext;
  611. (* called by WMProcessInfo to obtain the current state of a running process *)
  612. PROCEDURE UpdateProcessState*( p: Process );
  613. BEGIN
  614. IF p.threadId = Unix.ThrThis( ) THEN
  615. p.state.PC := Machine.CurrentPC( );
  616. p.state.BP := Machine.CurrentBP( );
  617. p.state.SP := Machine.CurrentSP( )
  618. ELSE
  619. IF p.mode = Running THEN
  620. timerStopped := TRUE;
  621. Unix.ThrSleep( 3 );
  622. IF p.mode = Running THEN (* still running *)
  623. Unix.ThrSuspend( p.threadId, TRUE );
  624. Unix.ThrResume( p.threadId );
  625. END;
  626. timerStopped := FALSE
  627. END
  628. END
  629. END UpdateProcessState;
  630. PROCEDURE SuspendActivities;
  631. VAR t, me: Process;
  632. BEGIN
  633. me := CurrentProcess();
  634. t := root;
  635. WHILE t # NIL DO
  636. IF t # me THEN
  637. Unix.ThrSuspend( t.threadId, t.mode = Running );
  638. END;
  639. t := t.nextProcess
  640. END;
  641. END SuspendActivities;
  642. PROCEDURE ResumeActivities;
  643. VAR t, me: Process;
  644. BEGIN
  645. me := CurrentProcess();
  646. t := root;
  647. WHILE t # NIL DO
  648. IF (t # me) THEN
  649. Unix.ThrResume( t.threadId );
  650. END;
  651. t := t.nextProcess
  652. END;
  653. END ResumeActivities;
  654. PROCEDURE GCLoop*; (* Timer and GC activity *)
  655. BEGIN
  656. (*
  657. If using BootConsole keep main thread running.
  658. If the thread is blocked by a mutex (MainThreadSleep)
  659. the signals SIGHUP, SIGINT and SIGQUIT don't branch into SignalHandler
  660. but terminate A2 (at least in Solaris).
  661. *)
  662. LOOP Sleep( 100 ) END
  663. END GCLoop;
  664. PROCEDURE CurrentProcessTime*(): HUGEINT;
  665. BEGIN
  666. RETURN Machine.GetTimer()
  667. END CurrentProcessTime;
  668. PROCEDURE TimerFrequency*(): HUGEINT;
  669. BEGIN
  670. RETURN Machine.mhz * 1000000
  671. END TimerFrequency;
  672. PROCEDURE LeaveA2;
  673. VAR cur: Process; bp, n: ADDRESS;
  674. BEGIN
  675. IF clock = NIL THEN RETURN END;
  676. cur := CurrentProcess();
  677. IF cur # NIL THEN
  678. bp := Machine.CurrentBP();
  679. S.GET( bp, n );
  680. IF ODD( n ) THEN S.GET( bp + SIZEOF( ADDRESS ), bp ) ELSE bp := n END;
  681. cur.state.BP := bp;
  682. END;
  683. END LeaveA2;
  684. PROCEDURE ReenterA2;
  685. VAR cur: Process;
  686. BEGIN
  687. IF clock = NIL THEN RETURN END;
  688. cur := CurrentProcess();
  689. IF cur # NIL THEN
  690. cur.state.BP := 0;
  691. END;
  692. END ReenterA2;
  693. (*----------------------------- initialization ----------------------------------*)
  694. PROCEDURE StartTimerActivity;
  695. BEGIN
  696. timerListMutex := Unix.NewMtx( ); timers := NIL;
  697. NEW( timerActivity );
  698. END StartTimerActivity;
  699. PROCEDURE GetStacksize;
  700. VAR str: ARRAY 32 OF CHAR; i: LONGINT;
  701. BEGIN
  702. Machine.GetConfig( "StackSize", str );
  703. IF str = "" THEN stacksize := DefaultStacksize
  704. ELSE
  705. i := 0; stacksize := Machine.StrToInt( i, str );
  706. stacksize := stacksize * 1024;
  707. END;
  708. IF Glue.debug # {} THEN
  709. Trace.String( "Stacksize of active objects = " );
  710. Trace.Int( stacksize DIV 1024, 0 ); Trace.StringLn( "K" )
  711. END;
  712. END GetStacksize;
  713. PROCEDURE Convert;
  714. VAR p: Process;
  715. BEGIN
  716. (* make current thread the first active object *)
  717. mainthread := Unix.ThrThis();
  718. NEW( p, NIL, NIL, 0, {}, 0 );
  719. END Convert;
  720. PROCEDURE Init;
  721. BEGIN
  722. Unix.suspendHandler := GetContext;
  723. createProcess := Unix.NewMtx( ); processList := Unix.NewMtx( );
  724. startProcess := Unix.NewMtx( ); childrunning := Unix.NewCond( );
  725. lockMutex := Unix.NewMtx( );
  726. GetStacksize;
  727. Convert;
  728. NEW( clock ); StartTimerActivity; timerStopped := FALSE;
  729. NEW( finalizerCaller );
  730. Heaps.gcStatus := GCStatusFactory()
  731. END Init;
  732. TYPE
  733. MainThread = OBJECT
  734. VAR exit: BOOLEAN;
  735. PROCEDURE & Init;
  736. BEGIN
  737. exit := FALSE;
  738. END Init;
  739. PROCEDURE Await();
  740. BEGIN {EXCLUSIVE}
  741. AWAIT( exit );
  742. END Await;
  743. END MainThread;
  744. VAR main: MainThread;
  745. PROCEDURE MainThreadSleep;
  746. BEGIN
  747. NEW( main );
  748. main.Await( );
  749. Unix.exit( 0 );
  750. END MainThreadSleep;
  751. PROCEDURE {FINAL} Final;
  752. BEGIN
  753. MainThreadSleep;
  754. END Final;
  755. PROCEDURE GCStatusFactory(): Heaps.GCStatus;
  756. VAR gcStatusExt : GCStatusExt;
  757. BEGIN
  758. ASSERT( Heaps.gcStatus = NIL );
  759. NEW( gcStatusExt );
  760. RETURN gcStatusExt
  761. END GCStatusFactory;
  762. VAR
  763. (* for compatibility and later extension *)
  764. TraceProcessHook*: PROCEDURE (prcoess: Process; pc, bp: ADDRESS; stacklow, stackhigh: ADDRESS);
  765. BEGIN
  766. TraceProcessHook := NIL;
  767. Init;
  768. END Objects.