Coop.Objects.Mod 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390
  1. (* Aos, Copyright 2001, Pieter Muller, ETH Zurich; this module ported for the windows version, fof. *)
  2. MODULE Objects; (** AUTHOR "pjm, ejz, fof"; PURPOSE "Active object runtime support"; *)
  3. IMPORT SYSTEM, Environment, Machine, Modules, Heaps, Activities, Interrupts, CPU, TimerModule := Timer;
  4. CONST
  5. (* Process flags *)
  6. Restart* = 0; (* Restart/Destroy process on exception *)
  7. PleaseHalt* = 10; (* Process requested to Halt itself soon *)
  8. Unbreakable* = 11;
  9. SelfTermination* = 12;
  10. Preempted* = 27; (* Has been preempted. *)
  11. Resistant* = 28; (* Can only be destroyed by itself *)
  12. PleaseStop* = 31; (* Process requested to Terminate or Halt itself soon *)
  13. InActive* = 26; (* needed to prevent processes to call finalizers while in await or lock or unlock, see Kernel.GC *)
  14. (** Process modes *)
  15. Unknown* = 0; Ready* = 1; (* for compatibility with native A2 *)
  16. Running* = 2; AwaitingLock* = 3; AwaitingCond* = 4; AwaitingEvent* = 5; Suspended* = 6; Terminated* = 7;
  17. (** Process priorities *)
  18. Low* = Activities.DefaultPriority; (* "user" priorities *)
  19. Normal* = Activities.DefaultPriority;
  20. High* = Activities.HighPriority;
  21. Realtime* = Activities.RealtimePriority; (* reserved for interrupt handling and realtime apps *)
  22. (* Process termination halt codes *)
  23. halt* = 2222;
  24. haltUnbreakable* = 2223;
  25. TYPE
  26. CpuCyclesArray* = ARRAY Machine.MaxCPU OF HUGEINT;
  27. ProtectedObject = POINTER TO RECORD END; (* protected object (10000) *)
  28. Body = PROCEDURE (self: ProtectedObject);
  29. Condition = PROCEDURE (slink: ADDRESS): BOOLEAN;
  30. EventHandler* = PROCEDURE {DELEGATE};
  31. RealtimeEventHandler* = PROCEDURE {DELEGATE, REALTIME};
  32. Timer* = POINTER TO RECORD
  33. next, prev : Timer;
  34. trigger: LONGINT;
  35. handler: EventHandler
  36. END;
  37. RealtimeTimer* = POINTER TO RECORD
  38. next, prev: RealtimeTimer;
  39. trigger: LONGINT;
  40. handler: RealtimeEventHandler
  41. END;
  42. Clock = OBJECT
  43. VAR h: Timer;
  44. BEGIN {ACTIVE, SAFE, PRIORITY(High)}
  45. WHILE Environment.status = 0 DO
  46. Machine.Acquire(Machine.Objects);
  47. LOOP
  48. h := event.next;
  49. IF (h = event) OR (h.trigger - Environment.Clock () > 0) THEN EXIT END;
  50. event.next := h.next; event.next.prev := event; (* unlink *)
  51. h.next := NIL; h.prev := NIL;
  52. Machine.Release(Machine.Objects);
  53. h.handler; (* assume handler will return promptly *)
  54. Machine.Acquire(Machine.Objects);
  55. END;
  56. Machine.Release(Machine.Objects);
  57. Environment.Sleep (1);
  58. END
  59. END Clock;
  60. TYPE
  61. Process* = OBJECT(Heaps.ProcessLink)
  62. VAR
  63. obj-: ProtectedObject; (* associated active object *)
  64. state-: RECORD PC-,BP-,SP-: ADDRESS END;
  65. condition-: Condition; (* awaited process' condition *)
  66. condFP-: LONGINT; (* awaited process' condition's context *)
  67. mode-: LONGINT; (* process state *) (* only changed inside Objects lock ??? *)
  68. procID-: LONGINT; (* processor ID where running, exported for compatibilty , useless in WinAos *)
  69. waitingOn-: ProtectedObject; (* obj this process is waiting on (for lock or condition) *)
  70. id-: LONGINT; (* unique process ID for tracing *)
  71. flags*: SET; (* process flags *)
  72. priority-: LONGINT; (* process priority *)
  73. stackBottom: LONGINT;
  74. restartPC-: LONGINT; (** entry point of body, for SAFE exception recovery *)
  75. restartSP-: LONGINT; (** stack level at start of body, for SAFE exception recovery *)
  76. cpuCycles, lastCpuCycles : CpuCyclesArray;
  77. END Process;
  78. FinalizedCollection* = OBJECT
  79. PROCEDURE RemoveAll*(obj: ANY); (** abstract *)
  80. BEGIN HALT(301) END RemoveAll;
  81. END FinalizedCollection;
  82. FinalizerNode* = POINTER TO RECORD (Heaps.FinalizerNode)
  83. c*: FinalizedCollection (* base type for collection containing object *)
  84. END;
  85. InterruptList = POINTER TO RECORD
  86. next: InterruptList;
  87. handler: EventHandler
  88. END;
  89. Interrupter* = OBJECT
  90. VAR root: InterruptList;
  91. VAR cancelled: BOOLEAN;
  92. VAR interrupt: Interrupts.Interrupt;
  93. PROCEDURE &Init (irq: SIZE);
  94. BEGIN
  95. Interrupts.Install (interrupt, irq);
  96. END Init;
  97. PROCEDURE Add (handler: EventHandler);
  98. VAR item: InterruptList;
  99. BEGIN {EXCLUSIVE}
  100. NEW (item);
  101. item.next := root;
  102. item.handler := handler;
  103. root := item;
  104. END Add;
  105. PROCEDURE Remove (handler: EventHandler);
  106. VAR previous, current: InterruptList;
  107. BEGIN {EXCLUSIVE}
  108. previous := NIL; current := root;
  109. WHILE (current # NIL) & (current.handler # handler) DO
  110. previous := current; current := current.next;
  111. END;
  112. IF current # NIL THEN
  113. IF previous = NIL THEN
  114. root := current.next;
  115. ELSE
  116. previous.next := current.next;
  117. END;
  118. END;
  119. END Remove;
  120. PROCEDURE Count(): SIZE;
  121. VAR count := 0: SIZE; item: InterruptList;
  122. BEGIN {EXCLUSIVE}
  123. item := root;
  124. WHILE item # NIL DO INC (count); item := item.next END;
  125. RETURN count;
  126. END Count;
  127. PROCEDURE Cancel;
  128. BEGIN {EXCLUSIVE}
  129. IF ~cancelled THEN
  130. cancelled := TRUE;
  131. Interrupts.Cancel (interrupt);
  132. WAIT (SELF);
  133. END;
  134. END Cancel;
  135. PROCEDURE Handle;
  136. VAR item: InterruptList;
  137. BEGIN {EXCLUSIVE}
  138. item := root;
  139. WHILE item # NIL DO
  140. item.handler;
  141. item := item.next;
  142. END;
  143. END Handle;
  144. BEGIN {ACTIVE, PRIORITY(Realtime)}
  145. LOOP
  146. Interrupts.Await (interrupt);
  147. IF cancelled THEN EXIT END;
  148. Handle;
  149. END;
  150. END Interrupter;
  151. VAR
  152. awc-, awl-: LONGINT;
  153. oberonLoop*: ANY; (* Oberon Loop Process temporary workaround for Threads.oberonLoop *)
  154. event: Timer; (* list of events *)
  155. clock: Clock;
  156. interrupt: ARRAY CPU.Interrupts OF Interrupter;
  157. (* for compatibility and later extension *)
  158. TraceProcessHook* := NIL: PROCEDURE (prcoess: Process; pc, bp: ADDRESS; stacklow, stackhigh: ADDRESS);
  159. (* Set the current process' priority. *)
  160. PROCEDURE SetPriority*( priority: LONGINT );
  161. BEGIN
  162. END SetPriority;
  163. (** Return TRUE iff the specified protected object is locked exclusive to the current process. *)
  164. PROCEDURE LockedByCurrent*( obj: ANY ): BOOLEAN;
  165. VAR hdr {UNTRACED}: Heaps.ProtRecBlock; res: BOOLEAN;
  166. BEGIN
  167. SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
  168. ASSERT(hdr IS Heaps.ProtRecBlock);
  169. Machine.Acquire(Machine.Objects);
  170. res := (hdr.lockedBy = ActiveObject());
  171. Machine.Release(Machine.Objects);
  172. RETURN res
  173. END LockedByCurrent;
  174. PROCEDURE Yield*;
  175. BEGIN
  176. Activities.Switch;
  177. END Yield;
  178. (** Return current process. (DEPRECATED, use ActiveObject) *)
  179. PROCEDURE CurrentProcess*( ): Process;
  180. BEGIN
  181. HALT (1234);
  182. RETURN NIL;
  183. END CurrentProcess;
  184. (* Return stack bottom of process. For compatibility WinAos/UnixAos/NativeAos *)
  185. PROCEDURE GetStackBottom*(p: Process): ADDRESS;
  186. BEGIN
  187. RETURN p.stackBottom
  188. END GetStackBottom;
  189. (** Return the active object currently executing. *)
  190. PROCEDURE ActiveObject* (): ANY;
  191. VAR activity {UNTRACED}: Activities.Activity;
  192. BEGIN {UNCOOPERATIVE, UNCHECKED}
  193. activity := Activities.GetCurrentActivity ();
  194. IF activity.object # NIL THEN RETURN activity.object ELSE RETURN activity END;
  195. END ActiveObject;
  196. (** Return the ID of the active currently executing process. *)
  197. PROCEDURE GetProcessID* (): LONGINT;
  198. BEGIN
  199. RETURN SYSTEM.VAL (LONGINT, Activities.GetCurrentActivity ());
  200. END GetProcessID;
  201. (* Attempt to terminate a specific process (mostly ignoring its locks). DEPRECATED *)
  202. PROCEDURE TerminateThis*( t: Process; halt: BOOLEAN );
  203. END TerminateThis;
  204. PROCEDURE Terminate*;
  205. BEGIN
  206. Activities.TerminateCurrentActivity;
  207. END Terminate;
  208. (** Set (or reset) an event handler object's timeout value. *)
  209. PROCEDURE SetTimeout*(t: Timer; h: EventHandler; ms: LONGINT );
  210. VAR e: Timer; trigger: LONGINT;
  211. BEGIN
  212. ASSERT((t # NIL) & (h # NIL));
  213. IF ms < 1 THEN ms := 1 END;
  214. Machine.Acquire(Machine.Objects);
  215. trigger := Environment.Clock () + ms;
  216. IF t.next # NIL THEN (* cancel previous timeout *)
  217. t.next.prev := t.prev; t.prev.next := t.next
  218. END;
  219. t.trigger := trigger; t.handler := h;
  220. e := event.next; (* performance: linear search! *)
  221. WHILE (e # event) & (e.trigger - trigger <= 0) DO e := e.next END;
  222. t.prev := e.prev; e.prev := t; t.next := e; t.prev.next := t;
  223. Machine.Release(Machine.Objects)
  224. END SetTimeout;
  225. (** Set (or reset) an event handler object's timeout value. Here ms is absolute *)
  226. PROCEDURE SetTimeoutAt*(t: Timer; h: EventHandler; ms: LONGINT);
  227. VAR e: Timer; trigger: LONGINT;
  228. BEGIN
  229. ASSERT((t # NIL) & (h # NIL));
  230. Machine.Acquire(Machine.Objects);
  231. trigger := ms; (* ignore overflow *)
  232. IF t.next # NIL THEN (* cancel previous timeout *)
  233. t.next.prev := t.prev; t.prev.next := t.next
  234. END;
  235. t.trigger := trigger; t.handler := h;
  236. e := event.next; (* performance: linear search! *)
  237. WHILE (e # event) & (e.trigger - trigger <= 0) DO e := e.next END;
  238. t.prev := e.prev; e.prev := t; t.next := e; t.prev.next := t;
  239. Machine.Release(Machine.Objects);
  240. END SetTimeoutAt;
  241. (** Cancel an event handler object's timeout, if any. It is possible that the timer has expired, but not yet been scheduled to run. *)
  242. PROCEDURE CancelTimeout*( t: Timer );
  243. BEGIN
  244. Machine.Acquire(Machine.Objects);
  245. ASSERT (t # event );
  246. IF t.next # NIL THEN
  247. t.next.prev := t.prev; t.prev.next := t.next; t.next := NIL;
  248. t.prev := NIL
  249. END;
  250. Machine.Release(Machine.Objects);
  251. END CancelTimeout;
  252. PROCEDURE InitEventHandling;
  253. BEGIN
  254. NEW(event); event.next := event; event.prev := event; (* event: head of timer event queue, only a sentinel *)
  255. NEW(clock)
  256. END InitEventHandling;
  257. PROCEDURE NumReady*( ): LONGINT;
  258. BEGIN
  259. RETURN 0
  260. END NumReady;
  261. (** Return number of CPU cycles consumed by the specified process. If all is TRUE,
  262. return the number of cycles since the process has been created. If FALSE, return the number of cycles
  263. consumed since the last time asked. *)
  264. PROCEDURE GetCpuCycles*(process : Process; VAR cpuCycles : CpuCyclesArray; all : BOOLEAN);
  265. VAR i : LONGINT;
  266. BEGIN
  267. ASSERT(process # NIL);
  268. FOR i := 0 TO Machine.MaxCPU-1 DO cpuCycles[i] := process.cpuCycles[i]; END;
  269. IF ~all THEN
  270. FOR i := 0 TO Machine.MaxCPU-1 DO
  271. cpuCycles[i] := cpuCycles[i] - process.lastCpuCycles[i];
  272. process.lastCpuCycles[i] := process.cpuCycles[i]; (* actually could have changed meanwhile *)
  273. END;
  274. END;
  275. END GetCpuCycles;
  276. PROCEDURE CurrentProcessTime*(): HUGEINT;
  277. BEGIN
  278. RETURN Activities.GetProcessTime();
  279. END CurrentProcessTime;
  280. PROCEDURE TimerFrequency*(): HUGEINT;
  281. BEGIN
  282. RETURN TimerModule.GetFrequency();
  283. END TimerFrequency;
  284. (** Install interrupt handler. *)
  285. PROCEDURE InstallHandler*(h: EventHandler; int: LONGINT);
  286. VAR ih: Interrupter;
  287. BEGIN {EXCLUSIVE}
  288. ASSERT((int >= 0) & (int < CPU.Interrupts));
  289. ih := interrupt[int];
  290. IF ih = NIL THEN
  291. NEW (ih, int);
  292. interrupt[int] := ih;
  293. END;
  294. ih.Add(h);
  295. END InstallHandler;
  296. (** Remove interrupt handler. *)
  297. PROCEDURE RemoveHandler*(h: EventHandler; int: LONGINT);
  298. VAR ih: Interrupter;
  299. BEGIN {EXCLUSIVE}
  300. ASSERT((int >= 0) & (int < CPU.Interrupts));
  301. ih := interrupt[int];
  302. IF ih # NIL THEN
  303. ih.Remove(h);
  304. IF ih.Count () = 0 THEN
  305. ih.Cancel;
  306. interrupt[int] := NIL;
  307. END;
  308. END;
  309. END RemoveHandler;
  310. BEGIN
  311. InitEventHandling;
  312. END Objects.
  313. (*
  314. 24.03.1998 pjm Started
  315. 06.05.1998 pjm CreateProcess init process, page fault handler
  316. 06.08.1998 pjm Moved exception interrupt handling here for current process
  317. 17.08.1998 pjm FindRoots method
  318. 02.10.1998 pjm Idle process
  319. 06.11.1998 pjm snapshot
  320. 25.03.1999 pjm Scope removed
  321. 28.05.1999 pjm EventHandler object
  322. 01.06.1999 pjm Fixed InterruptProcess lock error
  323. 16.06.1999 pjm Flat IRQ priority model to avoid GC deadlock
  324. 23.06.1999 pjm Flat IRQ priority experiment failed, rather do STI in FieldIRQ to avoid GC deadlock
  325. 29.06.1999 pjm Timeout in EventHandler object
  326. 13.01.2000 pjm Overed (Interrupt Objects, Event Handlers, Process ID, Process state, Process mode, Process stack, Await)
  327. 17.10.2000 pjm Priorities
  328. 22.10.2003 mib SSE2 extension
  329. 24.10.2003 phk Priority inversion / cycle counters
  330. Stack invariant for GC:
  331. o if process is running, the processor registers contain its state
  332. o if process is not running, at least state.ESP is valid, and between stack.adr and stack.high (for GC)
  333. o when releasing the Ready lock, make sure the process state is up to date
  334. *)