ARM.Objects.Mod 68 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882
  1. MODULE Objects; (** AUTHOR "pjm"; PURPOSE "Active object runtime support"; *)
  2. IMPORT SYSTEM, Trace, Machine, Heaps, Modules;
  3. CONST
  4. (** Process flags *)
  5. Restart* = 0; (* Restart/Destroy process on exception (hardcoded in compiler (OPC.CallRecBody / PCC.SysStart)) *)
  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. (** Process modes *)
  12. Unknown* = 0; Ready* = 1; Running* = 2; AwaitingLock* = 3;
  13. AwaitingCond* = 4; AwaitingEvent* = 5; Suspended* = 6; (* Suspened for compatibility with WinAos, not used for native A2 *)
  14. Terminated* = 7;
  15. (** Process priorities *)
  16. MinPriority = 0; (* only system idle processes run at this priority level *)
  17. Low* = 1; Normal* = 2; High* = 3; (* "user" priorities *)
  18. GCPriority* = 4; (* priority of garbage collector *)
  19. Realtime* = 5; (* reserved for interrupt handling and realtime apps, these processes are not allowed to allocate memory *)
  20. NumPriorities = Heaps.NumPriorities; (* number of priority levels *)
  21. (* Process termination halt codes *)
  22. halt* = 2222;
  23. haltUnbreakable* = 2223;
  24. MinIRQ = Machine.IRQ0;
  25. NumIRQ = Machine.MaxIRQ-MinIRQ+1;
  26. Stats* = FALSE; (* maintain statistical counters *)
  27. TraceVerbose = FALSE; (* write out verbose trace info *)
  28. StrongChecks = TRUE; (* strong sanity checks *)
  29. VeryConservative = FALSE; (* temp - be very conservative about stack-based pointers *)
  30. YieldTrick = FALSE; (* avoid yield when no ready process available *)
  31. HandlePriorityInv = TRUE; (* enables or disables priority inversion handling. Handling of priority inversion leads to a simplified locking, see Lock, Unlock and Await *)
  32. (* constant used in GC Process.FindPointers *)
  33. InitDiff = MAX(LONGINT);
  34. AddressSize = SIZEOF(ADDRESS);
  35. ReturnStackDisplacement = 2 * AddressSize;
  36. TYPE
  37. CpuCyclesArray* = ARRAY Machine.MaxCPU OF HUGEINT;
  38. EventHandler* = PROCEDURE {DELEGATE};
  39. Timer* = POINTER TO RECORD
  40. next*, prev* : Timer;
  41. trigger: LONGINT;
  42. handler: EventHandler
  43. END;
  44. ProtectedObject = POINTER TO RECORD END; (* protected object *)
  45. ProcessQueue = Heaps.ProcessQueue;
  46. Body = PROCEDURE (self: ProtectedObject);
  47. Condition = PROCEDURE (slink: ADDRESS): BOOLEAN;
  48. InterruptList = POINTER TO RECORD
  49. next: InterruptList;
  50. handler: EventHandler
  51. END;
  52. TYPE
  53. (** All exported fields and variables should be considered read-only. *)
  54. Process* = OBJECT (Heaps.ProcessLink)
  55. VAR
  56. rootedNext : Process; (** for rootedProcesses *)
  57. obj-: ProtectedObject; (** associated active object *)
  58. state-: Machine.State; (** processor state of suspended process *)
  59. sse: Machine.NEONState; (* fpu and sse state of preempted process (only valid if Preempted IN flag) *)
  60. sseAdr: ADDRESS;
  61. condition-: Condition; (** awaited process' condition *)
  62. condFP-: ADDRESS; (** awaited process' condition's context *)
  63. mode-: LONGINT; (** process state *) (* only changed inside Objects lock ??? *)
  64. procID-: LONGINT; (** processor ID where running *)
  65. waitingOn-: ProtectedObject; (** obj this process is waiting on (for lock or condition) *)
  66. id-: LONGINT; (** unique process ID for tracing *)
  67. flags*: SET; (** process flags *)
  68. priority-, staticPriority*: LONGINT; (** process dynamic priority (can change during priority inversion handling) and static priority *) (* exported for AosExceptions *)
  69. stack*: Machine.Stack; (** user-level stack of process *)
  70. restartPC-: ADDRESS; (** entry point of body, for SAFE exception recovery *)
  71. restartSP-: ADDRESS; (** stack level at start of body, for SAFE exception recovery *)
  72. exp*: Machine.ExceptionState;
  73. oldReturnPC: ADDRESS;
  74. cpuCycles-, lastCpuCycles- : CpuCyclesArray;
  75. prioRequests : ARRAY NumPriorities OF LONGINT; (* priorities of processes that wait for resources locked by this process, only the highest priority per resource is stored *)
  76. context: ANY;
  77. (* set priority of process: Machine.Objects lock is taken *)
  78. PROCEDURE SetPriority(p : LONGINT);
  79. BEGIN
  80. DEC(prioRequests[staticPriority]);
  81. staticPriority := p;
  82. INC(prioRequests[staticPriority]);
  83. priority := MaxPrio(prioRequests)
  84. END SetPriority;
  85. PROCEDURE FindRoots; (* override *)
  86. VAR pc, bp, curbp, sp: ADDRESS; d0, d1: SIZE; first : BOOLEAN;
  87. BEGIN
  88. IF traceProcess # NIL THEN traceProcess(SELF) END;
  89. (* stack garbage collection *)
  90. IF (priority >= Low) & (priority <= High) & (mode >= Ready) & (mode # Terminated) THEN
  91. (* only processes with priority < GCPriority are preempted during GC,
  92. only those are allowed to allocate memory and their stacks are inspected.
  93. Furthermore, the process must be in a valid state, e.g. terminated processes have a disposed stack. *)
  94. IF Heaps.GCType = Heaps.HeuristicStackInspectionGC THEN
  95. IF VeryConservative THEN
  96. Heaps.RegisterCandidates(stack.adr, stack.high-stack.adr)
  97. ELSE
  98. sp := state.SP; (* cf. Enter *)
  99. IF sp # 0 THEN
  100. IF Machine.ValidStack(stack, sp) THEN
  101. Heaps.RegisterCandidates(sp, stack.high - sp)
  102. END
  103. ELSE
  104. Trace.String("[Objects.FindRoots sp=0]")
  105. END
  106. END;
  107. IF TraceProcessHook # NIL THEN
  108. bp := state.BP; pc := state.PC; sp := state.SP;
  109. TraceProcessHook(SELF,pc,bp,sp,stack.high);
  110. END;
  111. ELSIF Heaps.GCType = Heaps.MetaDataForStackGC THEN
  112. bp := state.BP; pc := state.PC; first := TRUE;
  113. IF pc # 0 THEN (* process is running already *)
  114. WHILE (bp # Heaps.NilVal) & (stack.adr <= bp) & (bp < stack.high) DO
  115. FindPointers(bp, pc, d0, d1);
  116. IF first THEN
  117. IF (d0 = 0) OR (d0 = 1) OR (d1 = 3) THEN
  118. (* situation where pc and bp are not synchronized: *)
  119. (* entry protocol of a procedure:
  120. PUSH EBP -- 1 byte instruction length, if pc points to this instruction at offset 0 from the codeoffset then bp still refers to caller frame -> critical
  121. MOV EBP, ESP -- 2 bytes instruction length, do. for offset 1 from the codeoffset
  122. (followed by initialization of local variables)
  123. exit protocol of a procedure:
  124. MOV ESP, EBP -- 2 bytes instruction length
  125. POP EBP -- 1 byte instruction length
  126. RET n -- 3 bytes instruction length, if pc points to this instruction at offset 3 from the last statement then bp already refers to caller's frame -> critical
  127. *)
  128. IF (d0 = 0) OR (d1 = 3) THEN
  129. SYSTEM.GET(state.SP, pc); (* matching pc is at position of stack pointer *)
  130. ELSE
  131. SYSTEM.GET(state.SP+AddressSize, pc); (* matching pc is at 4 bytes after stack pointer, pushed base pointer is at stack pointer position *)
  132. END;
  133. ELSE
  134. (* regular case: bp and pc were synchronized *)
  135. curbp := bp;
  136. SYSTEM.GET(curbp, bp);
  137. SYSTEM.GET(curbp+AddressSize, pc);
  138. END;
  139. first := FALSE;
  140. ELSE
  141. (* regular case: bp and pc were synchronized *)
  142. curbp := bp;
  143. SYSTEM.GET(curbp, bp);
  144. SYSTEM.GET(curbp+AddressSize, pc);
  145. END
  146. END
  147. END
  148. ELSE
  149. HALT(900) (* wrong GCType constant *)
  150. END
  151. END
  152. END FindRoots;
  153. (*!TODO: adapt the code according to the new Modules/Reflection *)
  154. PROCEDURE FindPointers(bp, pc : ADDRESS; VAR diff0, diff1: SIZE);
  155. (*VAR data: Modules.ProcTableEntry; startIndex, i: LONGINT; ptr : ADDRESS; success: BOOLEAN;
  156. BEGIN
  157. diff0 := InitDiff; diff1 := InitDiff;
  158. (*Modules.FindProc(pc, data, startIndex, success);*)
  159. IF success THEN
  160. diff0 := pc - data.pcFrom;
  161. diff1 := pc - data.pcStatementEnd;
  162. IF (data.noPtr > 0) & (pc >= data.pcStatementBegin) & (pc <= data.pcStatementEnd) THEN
  163. FOR i := 0 TO data.noPtr - 1 DO
  164. SYSTEM.GET(bp + Modules.ptrOffsets[startIndex + i], ptr);
  165. IF ptr # Heaps.NilVal THEN
  166. Heaps.Mark(SYSTEM.VAL(ANY, ptr))
  167. END
  168. END
  169. END
  170. END*)
  171. END FindPointers;
  172. END Process;
  173. TraceProcess* = PROCEDURE (p: Process);
  174. ExceptionHandler* = PROCEDURE(p: Process; VAR int: Machine.State; VAR exc: Machine.ExceptionState; VAR return: BOOLEAN);
  175. Idle = OBJECT
  176. BEGIN {ACTIVE, SAFE, PRIORITY(-1)} (* negative priority equivalent to MinPriority *)
  177. LOOP
  178. REPEAT
  179. IF ProcessorHLT # NIL THEN ProcessorHLT (* UP *)
  180. ELSE
  181. Machine.SpinHint; (* MP *)
  182. END;
  183. UNTIL maxReady >= lowestAllowedPriority;
  184. Yield
  185. END
  186. END Idle;
  187. Clock = OBJECT
  188. VAR h: Timer;
  189. BEGIN {ACTIVE, SAFE, PRIORITY(High)}
  190. LOOP
  191. Machine.Acquire(Machine.Objects);
  192. LOOP
  193. h := event.next;
  194. IF (h = event) OR (h.trigger - Machine.ticks > 0) THEN EXIT END;
  195. event.next := h.next; event.next.prev := event; (* unlink *)
  196. h.next := NIL; h.prev := NIL;
  197. Machine.Release(Machine.Objects);
  198. h.handler; (* assume handler will return promptly *)
  199. Machine.Acquire(Machine.Objects)
  200. END;
  201. ASSERT(timer = NIL); (* temp strong check *)
  202. timer := running[Machine.ID ()];
  203. timer.mode := AwaitingEvent;
  204. SwitchToNew
  205. END
  206. END Clock;
  207. ReadyProcesses = OBJECT(Heaps.RootObject)
  208. VAR q {UNTRACED}: ARRAY NumPriorities OF ProcessQueue;
  209. PROCEDURE &Init;
  210. VAR i: LONGINT;
  211. BEGIN
  212. FOR i := 0 TO NumPriorities - 1 DO
  213. q[i].head := NIL; q[i].tail := NIL
  214. END
  215. END Init;
  216. PROCEDURE FindRoots; (* override *)
  217. VAR i: LONGINT;
  218. BEGIN
  219. (* only mark queues of user processes since these will not change during GC *)
  220. FOR i := Low TO High DO
  221. Heaps.Mark(q[i].head);
  222. Heaps.Mark(q[i].tail)
  223. END
  224. END FindRoots;
  225. END ReadyProcesses;
  226. GCStatusExt = OBJECT(Heaps.GCStatus)
  227. VAR gcOngoing: BOOLEAN;
  228. PROCEDURE &Init;
  229. BEGIN
  230. gcOngoing := FALSE;
  231. END Init;
  232. (* called from Heaps.InvokeGC, i.e. this is a hidden upcall. However, it is necessary to take the Machine.Objects lock here since writing
  233. the set of variables here must not be interrupted, i.e. atomic writing of the set of variables is absolutely necessary. They system may hang
  234. if the lock is not taken. *)
  235. PROCEDURE SetgcOngoing(value: BOOLEAN);
  236. VAR p: Process;
  237. BEGIN
  238. IF value THEN
  239. Machine.Acquire(Machine.Objects);
  240. IF ~gcOngoing THEN
  241. gcOngoing := TRUE;
  242. lowestAllowedPriority := GCPriority;
  243. gcBarrier := Machine.allProcessors
  244. END;
  245. p := running[Machine.ID()];
  246. Enter(p);
  247. p.mode := Ready;
  248. SwitchToNew (* this method cannot schedule the running user process with priority Low, Normal or High since
  249. lowestAllowedPriority is set to GCPriority *)
  250. ELSE
  251. Machine.Acquire(Machine.Objects);
  252. gcOngoing := FALSE;
  253. lowestAllowedPriority := Low;
  254. Machine.Release(Machine.Objects)
  255. END;
  256. END SetgcOngoing;
  257. (* caller must hold Machine.Objects lock *)
  258. PROCEDURE GetgcOngoing(): BOOLEAN;
  259. BEGIN
  260. RETURN gcOngoing
  261. END GetgcOngoing;
  262. END GCStatusExt;
  263. GCActivity = OBJECT
  264. BEGIN {ACTIVE, SAFE, PRIORITY(GCPriority)}
  265. UpdateState;
  266. LOOP
  267. Machine.Acquire(Machine.Objects);
  268. ASSERT(gcProcess = NIL); (* temp strong check *)
  269. gcProcess := running[Machine.ID()];
  270. gcProcess.mode := AwaitingEvent;
  271. SwitchToNew; (* SwitchTo called by SwitchToNew will release the lock Machine.Objects *)
  272. (* process is scheduled -> gcProcess = NIL set by scheduler (Timeslice), perform garbage collection now *)
  273. Heaps.CollectGarbage(Modules.root);
  274. Machine.Acquire(Machine.Objects);
  275. IF finalizerProcess # NIL THEN
  276. (* it is safe to move finalizerProcess to the ready queue and set the variable to NIL
  277. since the process has been marked by the GC already - marking is finished here *)
  278. Enter(finalizerProcess);
  279. finalizerProcess := NIL
  280. END;
  281. Machine.Release(Machine.Objects);
  282. Heaps.gcStatus.SetgcOngoing(FALSE)
  283. END
  284. END GCActivity;
  285. FinalizedCollection* = OBJECT (* base type for collection, extended in Kernel.Mod *)
  286. PROCEDURE RemoveAll*(obj: ANY); (** abstract *)
  287. BEGIN HALT(301) END RemoveAll;
  288. END FinalizedCollection;
  289. FinalizerNode* = POINTER TO RECORD (Heaps.FinalizerNode)
  290. c*: FinalizedCollection (* base type for collection containing object *)
  291. END;
  292. FinalizerCaller = OBJECT (* separate active object that calls finalizers *)
  293. VAR n: Heaps.FinalizerNode;
  294. BEGIN {ACTIVE, SAFE, PRIORITY(High)}
  295. LOOP
  296. Machine.Acquire(Machine.Objects);
  297. ASSERT(finalizerProcess = NIL); (* temp strong check *)
  298. finalizerProcess := running[Machine.ID()];
  299. finalizerProcess.mode := AwaitingEvent;
  300. SwitchToNew; (* SwitchTo called by SwitchToNew will release the lock Machine.Objects *)
  301. (* process is scheduled -> finalizerProcess = NIL set by GCActivity, perform finalization now *)
  302. LOOP
  303. n := Heaps.GetFinalizer();
  304. IF n = NIL THEN EXIT END;
  305. IF n IS FinalizerNode THEN
  306. n(FinalizerNode).c.RemoveAll(n.objStrong) (* remove it if it is not removed yet *)
  307. END;
  308. IF n.finalizer # NIL THEN
  309. n.finalizer(n.objStrong) (* may acquire locks *)
  310. END
  311. END;
  312. END
  313. END FinalizerCaller;
  314. Interrupter = OBJECT (ProtectedObject) (* to do: like Timer *)
  315. VAR interruptNumber: LONGINT;
  316. END Interrupter;
  317. VAR
  318. ready: ReadyProcesses; (* ready queue represented as an object that contains the queues *)
  319. maxReady: LONGINT; (* for all i : MinPriority <= maxReady < i < NumPriorities : Empty(ready.q[i]) *)
  320. lowestAllowedPriority: LONGINT; (* denotes the minimal user or realtime priority greater than the idle priority that can be
  321. scheduled depending on the GC status, minPriority = Low if GC is not running,
  322. minPrioriy = GCPriority otherwise *)
  323. running-{UNTRACED}: ARRAY Machine.MaxCPU OF Process; (** processes currently running, exported for Traps, not traced by the GC since it may change during collection *)
  324. nextProcessID: LONGINT;
  325. gcBarrier: SET; (* barrier that must be passed by all processors before actual collection starts *)
  326. gcActivity: GCActivity; (* active object for GC handling *)
  327. gcProcess: Process; (* suspended GC process, is NIL when collection has started, not equal NIL when no garbage collection is in process, same behaviour as for timer *)
  328. finalizerProcess: Process; (* finalizer process, regarded as part of GC *)
  329. interrupt: ARRAY NumIRQ OF RECORD
  330. root: InterruptList;
  331. process: Process
  332. END;
  333. processingIRQ: ARRAY NumIRQ OF BOOLEAN;
  334. rootedProcesses: ARRAY NumPriorities OF Process; (* list of potential processes that are not traced by GC when processing the ready queues, since GC only traces processes with
  335. priorities Low ... High in ready queues. The potentially not traced processes are rooted here and traced by the GC *)
  336. event: Timer; (* list of events *)
  337. timer (*, realtimeTimer *): Process; (* suspended timer processes *)
  338. terminate: PROCEDURE;
  339. trap, trapReturn: ARRAY 2 OF PROCEDURE;
  340. ProcessorHLT*: PROCEDURE; (** installable procedure to halt the current processor while idle *)
  341. traceProcess*: TraceProcess; (** for debugging purposes (see Info.Active) *)
  342. entry: ADDRESS;
  343. init: Process;
  344. initObject: ProtectedObject; (* Active object for the init process *)
  345. (* Performance monitoring *)
  346. idlecount*: ARRAY Machine.MaxCPU OF LONGINT; (** count of idle process timeslice interrupts *)
  347. idleCycles- : ARRAY Machine.MaxCPU OF HUGEINT; (** CPU cycles of idle threads *)
  348. perfTsc-: ARRAY Machine.MaxCPU OF HUGEINT;
  349. (* Statistics *)
  350. Nlock-, Nunlock-, Nawait-, NawaitNoIF-, NawaitTrue-, Ncreate-, Nterminate-,
  351. Ncondition-, Ncondition1True-, Ncondition2-, Ncondition2True-,
  352. Ntimeslice-, NtimesliceTaken-, NtimesliceNothing-, NtimesliceIdle-,
  353. NtimesliceKernel-, NtimesliceV86-, NtimesliceCritical-,
  354. Npreempt-, NpreemptTaken-, NpreemptNothing-,
  355. NpreemptKernel-, NpreemptV86-, NpreemptCritical-,
  356. Nenter- : LONGINT;
  357. debugCounter: LONGINT;
  358. PROCEDURE GetMaxPrio(VAR queue: ProcessQueue; VAR new: Process);
  359. VAR
  360. t: Heaps.ProcessLink;
  361. maxPriority : LONGINT;
  362. BEGIN
  363. ASSERT(new = NIL);
  364. t := queue.head;
  365. maxPriority := MIN(LONGINT);
  366. WHILE (t # NIL) DO
  367. IF (t(Process).priority > maxPriority) THEN
  368. new := t(Process); maxPriority := t(Process).priority;
  369. END;
  370. t := t.next;
  371. END;
  372. IF new = NIL THEN (* zero elements in queue *)
  373. (* skip *)
  374. ELSE (* more than one element in queue *)
  375. IF new.next # NIL THEN new.next.prev := new.prev END;
  376. IF new.prev # NIL THEN new.prev.next := new.next END;
  377. IF queue.head = new THEN
  378. queue.head := new.next
  379. END;
  380. IF queue.tail = new THEN
  381. queue.tail := new.prev
  382. END;
  383. new.next := NIL; new.prev := NIL
  384. END;
  385. END GetMaxPrio;
  386. (* Get a process from a queue (NIL if none). Caller must hold lock for specific queue. *)
  387. PROCEDURE Get(VAR queue: ProcessQueue; VAR new: Process);
  388. VAR t: Heaps.ProcessLink;
  389. BEGIN
  390. t := queue.head;
  391. IF t = NIL THEN (* zero elements in queue *)
  392. (* skip *)
  393. ELSIF t = queue.tail THEN (* one element in queue *)
  394. queue.head := NIL; queue.tail := NIL (* {(t.next = NIL) & (t.prev = NIL)} *)
  395. ELSE (* more than one element in queue *)
  396. queue.head := t.next; t.next := NIL; queue.head.prev := NIL
  397. END;
  398. ASSERT((t = NIL) OR (t.next = NIL) & (t.prev = NIL)); (* temp strong check *)
  399. IF t = NIL THEN
  400. new := NIL
  401. ELSE
  402. ASSERT(t IS Process);
  403. new := t(Process)
  404. END;
  405. END Get;
  406. (* Put a process in a queue. Caller must hold lock for specific queue. *)
  407. (* If t was running, be careful to protect Put and the subsequent SwitchTo with the ready lock. *)
  408. PROCEDURE Put(VAR queue: ProcessQueue; t: Process);
  409. BEGIN (* {t # NIL & t.next = NIL} *)
  410. ASSERT((t.next = NIL) & (t.prev = NIL));
  411. IF queue.head = NIL THEN (* queue empty *)
  412. queue.head := t
  413. ELSE (* queue not empty *)
  414. queue.tail.next := t; t.prev := queue.tail
  415. END;
  416. queue.tail := t
  417. END Put;
  418. (* Select a process of at least the specified priority to run next on current processor (returns NIL if none). Caller must hold ready lock. *)
  419. PROCEDURE Select(VAR new: Process; priority: LONGINT);
  420. VAR thresholdPrio: LONGINT;
  421. BEGIN
  422. IF Heaps.gcStatus.GetgcOngoing() THEN
  423. thresholdPrio := GCPriority
  424. ELSE
  425. thresholdPrio := priority
  426. END;
  427. LOOP
  428. IF maxReady < thresholdPrio THEN
  429. IF priority < thresholdPrio THEN Get(ready.q[MinPriority], new) ELSE new := NIL END;
  430. EXIT
  431. END;
  432. Get(ready.q[maxReady], new);
  433. IF (new # NIL) OR (maxReady = MinPriority) THEN EXIT END;
  434. DEC(maxReady)
  435. END
  436. END Select;
  437. (* Enter a process in the ready queue. Caller must hold ready lock. *)
  438. (* If t was running, be careful to make Enter and the subsequent SwitchTo atomic, as the process could be grabbed by another process while it is still running. *)
  439. PROCEDURE Enter(t: Process);
  440. BEGIN
  441. IF Stats THEN Machine.AtomicInc(Nenter) END;
  442. t.mode := Ready;
  443. Put(ready.q[t.priority], t);
  444. IF t.priority > maxReady THEN
  445. maxReady := t.priority (* to do: re-establish global priority invariant *)
  446. END
  447. END Enter;
  448. (* Remove a process from a queue that contains it. Caller must hold lock for specific queue. *)
  449. (* Not intended for frequent use. *)
  450. PROCEDURE Remove(VAR queue: ProcessQueue; t: Process);
  451. BEGIN
  452. IF t.prev # NIL THEN t.prev.next := t.next END;
  453. IF t.next # NIL THEN t.next.prev := t.prev END;
  454. IF t = queue.head THEN queue.head := t.next END;
  455. IF t = queue.tail THEN queue.tail := t.prev END;
  456. ASSERT((queue.head = NIL) OR (queue.head.prev = NIL) & (queue.tail.next = NIL));
  457. t.prev := NIL;
  458. t.next := NIL
  459. END Remove;
  460. (* Switch to the specified process. Caller must hold ready lock. Return may be on different processor! *)
  461. PROCEDURE SwitchTo(VAR running: Process; new: Process); (* parameters used in SwitchToState, TerminateThis, New *)
  462. VAR id: LONGINT;
  463. BEGIN
  464. id := Machine.ID ();
  465. INC (running.cpuCycles[id], Machine.GetTimer () - perfTsc[id]);
  466. (*TRACE(CurrentProcessTime(), perfTsc[id], Machine.GetTimer());*)
  467. IF running.priority = MinPriority THEN (* Special treatment for idle threads *)
  468. INC (idleCycles[id], Machine.GetTimer () - perfTsc[id]);
  469. END;
  470. (* save current state *)
  471. running.state.PC := SYSTEM.PC();(*Machine.CurrentPC ();*) (* for GC *) (* ug *)
  472. running.state.SP := SYSTEM.SP();(*SYSTEM.GetStackPointer ();*) (* for GC *)
  473. running.state.BP := SYSTEM.FP();(*SYSTEM.GetFramePointer ();*) (* save state *)
  474. Machine.FPUSaveMin(running.sse);
  475. running := new; new.mode := Running;
  476. IF Preempted IN new.flags THEN
  477. EXCL(new.flags, Preempted);
  478. perfTsc[id] := Machine.GetTimer ();
  479. (*SYSTEM.SetStackPointer (new.state.SP);*) (* for UpdateState - run on new stack (EBP on old) *)
  480. SYSTEM.SETSP(new.state.SP);
  481. Machine.PushState(new.state);
  482. Machine.FPURestoreFull(new.sse);
  483. Machine.Release(Machine.Objects);
  484. Machine.JumpState (* pops the state parameter from the stack and returns from interrupt *)
  485. ELSE
  486. Machine.FPURestoreMin(new.sse);
  487. perfTsc[id] := Machine.GetTimer ();
  488. SYSTEM.SETSP(new.state.SP);
  489. SYSTEM.SETFP(new.state.BP);
  490. Machine.Release(Machine.Objects);
  491. END
  492. END SwitchTo;
  493. (* Select a new process to run and switch to it. Caller must hold ready lock. *)
  494. PROCEDURE SwitchToNew;
  495. VAR new: Process;
  496. BEGIN
  497. Select(new, MinPriority); (* will return at least an Idle process *)
  498. new.procID := Machine.ID ();
  499. SwitchTo(running[new.procID], new)
  500. END SwitchToNew;
  501. PROCEDURE GetProcessPtr(): Process;
  502. VAR
  503. p: Process;
  504. BEGIN
  505. Machine.Acquire(Machine.Objects);
  506. p := GetProcessPtr0();
  507. Machine.Release(Machine.Objects);
  508. RETURN p
  509. END GetProcessPtr;
  510. PROCEDURE GetProcessPtr0(): Process;
  511. BEGIN
  512. RETURN running[Machine.ID()]
  513. END GetProcessPtr0;
  514. (** Relinquish control. *)
  515. PROCEDURE Yield*;
  516. VAR r, new: Process;
  517. BEGIN
  518. IF ~YieldTrick OR (maxReady >= lowestAllowedPriority) THEN
  519. r := GetProcessPtr ();
  520. Machine.Acquire(Machine.Objects);
  521. Select(new, r.priority);
  522. IF new # NIL THEN (* found another process *)
  523. Enter(r);
  524. new.procID := Machine.ID ();
  525. SwitchTo(running[new.procID], new)
  526. ELSE (* stay with same process *)
  527. Machine.Release(Machine.Objects)
  528. END
  529. END
  530. END Yield;
  531. PROCEDURE SwitchToState(new: Process; VAR state: Machine.State);
  532. BEGIN
  533. (* simulate return from SwitchTo - MOV ESP, EBP; POP EBP; RET 8 *)
  534. state.SP := new.state.BP+AddressSize*2; (* AddressSize*4 is effect of POP, RET AddressSize*2 *)
  535. SYSTEM.GET (new.state.BP, state.BP); (* effect of POP *)
  536. SYSTEM.GET (new.state.BP + AddressSize, state.PC); (* effect of RET *)
  537. END SwitchToState;
  538. (** Preempt the current process. *)
  539. PROCEDURE Timeslice*(VAR state: Machine.State);
  540. VAR id: LONGINT; new: Process;
  541. BEGIN
  542. (* handle a timer tick *)
  543. Machine.Acquire(Machine.Objects);
  544. IF Stats THEN Machine.AtomicInc(Ntimeslice) END;
  545. id := Machine.ID ();
  546. IF id = 0 THEN (* process 0 checks event queues *)
  547. IF event.next.trigger - Machine.ticks <= 0 THEN (* next normal event due *)
  548. IF event.next # event THEN (* not dummy event *)
  549. IF timer # NIL THEN
  550. ASSERT(timer.mode = AwaitingEvent);
  551. Enter(timer); timer := NIL
  552. END
  553. ELSE (* reset dummy event *)
  554. event.trigger := Machine.ticks + MAX(LONGINT) DIV 2 (* ignore overflow *)
  555. END
  556. END
  557. END;
  558. IF Heaps.gcStatus.GetgcOngoing() & (id IN gcBarrier) THEN
  559. EXCL(gcBarrier, id);
  560. IF gcBarrier = {} THEN
  561. ASSERT(gcProcess.mode = AwaitingEvent);
  562. Enter(gcProcess); gcProcess := NIL
  563. END
  564. END;
  565. (* pre-empt the current process *)
  566. IF Machine.PreemptCount(id) = 1 THEN (* check against 1, because we are holding one lock *)
  567. IF running[id].priority # MinPriority THEN (* idle processes are not timesliced *)
  568. Select(new, running[id].priority);
  569. IF new # NIL THEN
  570. INC (running[id].cpuCycles[id], Machine.GetTimer () - perfTsc[id]);
  571. (*TRACE(CurrentProcessTime(), perfTsc[id], Machine.GetTimer());*)
  572. IF Stats THEN Machine.AtomicInc(NtimesliceTaken) END;
  573. INCL(running[id].flags, Preempted);
  574. Machine.CopyState(state, running[id].state);
  575. Machine.FPUSaveFull(running[id].sse); (* to do: floating-point exception possible / Machine.SetupFPU *)
  576. Enter(running[id]);
  577. running[id] := new;
  578. new.mode := Running; new.procID := id;
  579. IF Preempted IN new.flags THEN
  580. EXCL(new.flags, Preempted);
  581. Machine.CopyState(new.state, state);
  582. Machine.FPURestoreFull(new.sse)
  583. ELSE
  584. SwitchToState(new, state);
  585. Machine.FPURestoreMin(new.sse)
  586. END;
  587. perfTsc[id] := Machine.GetTimer ()
  588. ELSE
  589. IF Stats THEN Machine.AtomicInc(NtimesliceNothing) END;
  590. END;
  591. (* Check if the process has the PleasHalt flag and handle it. *)
  592. IF PleaseHalt IN running[id].flags THEN
  593. (* Simulate procedure call: Increase stack & put return PC *)
  594. DEC(state.SP, AddressSize);
  595. SYSTEM.PUT (state.SP, state.PC); (* Here an stack overflow could happen! *)
  596. (* Set the right halt procedure *)
  597. IF (Unbreakable IN running[id].flags) THEN
  598. state.PC := SYSTEM.VAL (ADDRESS, trap[1]);
  599. ELSE
  600. state.PC := SYSTEM.VAL (ADDRESS, trap[0]);
  601. END;
  602. END;
  603. ELSE
  604. INC(idlecount[id]);
  605. IF Stats THEN Machine.AtomicInc(NtimesliceIdle) END;
  606. END
  607. ELSE
  608. IF Stats THEN Machine.AtomicInc(NtimesliceCritical) END (* not preemptable *)
  609. END;
  610. Machine.Release(Machine.Objects)
  611. END Timeslice;
  612. (** Return current process. (DEPRECATED, use ActiveObject) *)
  613. PROCEDURE CurrentProcess*( ): Process;
  614. BEGIN
  615. RETURN GetProcessPtr();
  616. END CurrentProcess;
  617. (** Return current process' context *)
  618. PROCEDURE CurrentContext*(): ANY;
  619. VAR p: Process;
  620. BEGIN
  621. p := CurrentProcess();
  622. IF p # NIL THEN RETURN p.context
  623. ELSE RETURN NIL
  624. END;
  625. END CurrentContext;
  626. PROCEDURE SetContext*(context: ANY);
  627. VAR p: Process;
  628. BEGIN
  629. p := CurrentProcess();
  630. IF p # NIL THEN p.context := context END;
  631. END SetContext;
  632. (* Return stack bottom of process. For compatibility WinAos/UnixAos/NativeAos *)
  633. PROCEDURE GetStackBottom*(p: Process): ADDRESS;
  634. BEGIN
  635. RETURN p.stack.high
  636. END GetStackBottom;
  637. (** Return the active object currently executing. *)
  638. PROCEDURE ActiveObject* (): ANY;
  639. VAR r: Process;
  640. BEGIN
  641. r := GetProcessPtr ();
  642. ASSERT(r # NIL);
  643. ASSERT(r.obj # NIL);
  644. RETURN r.obj
  645. END ActiveObject;
  646. (** Return the ID of the active currently executing process. *)
  647. PROCEDURE GetProcessID* (): LONGINT;
  648. VAR r: Process;
  649. BEGIN
  650. r := GetProcessPtr ();
  651. RETURN r.id
  652. END GetProcessID;
  653. (** Set the current process' priority. *)
  654. PROCEDURE SetPriority*(priority: LONGINT);
  655. VAR id: LONGINT;
  656. BEGIN
  657. ASSERT((priority >= Low) & (priority <= Realtime)); (* priority in bounds *)
  658. IF HandlePriorityInv THEN
  659. Machine.Acquire(Machine.Objects);
  660. id := Machine.ID();
  661. running[id].SetPriority(priority);
  662. Machine.Release(Machine.Objects)
  663. ELSE
  664. id := Machine.AcquirePreemption ();
  665. running[id].priority := priority;
  666. Machine.ReleasePreemption
  667. (* to do: re-establish global priority invariant *)
  668. END
  669. END SetPriority;
  670. (** Return TRUE iff the specified protected object is locked exclusive to the current process. *)
  671. PROCEDURE LockedByCurrent*(obj: ANY): BOOLEAN;
  672. VAR hdr {UNTRACED}: Heaps.ProtRecBlock; id: LONGINT; res: BOOLEAN;
  673. BEGIN
  674. SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
  675. ASSERT(hdr IS Heaps.ProtRecBlock);
  676. IF HandlePriorityInv THEN
  677. Machine.Acquire(Machine.Objects);
  678. id := Machine.ID();
  679. res := (hdr.lockedBy = running[id]);
  680. Machine.Release(Machine.Objects)
  681. ELSE
  682. id := Machine.AcquirePreemption ();
  683. Machine.AcquireObject(hdr.locked);
  684. res := (hdr.lockedBy = running[id]);
  685. Machine.ReleaseObject(hdr.locked);
  686. Machine.ReleasePreemption;
  687. END;
  688. RETURN res
  689. END LockedByCurrent;
  690. (** Return number of ready and running processes, excluding idle processes. *)
  691. PROCEDURE NumReady* (): LONGINT;
  692. VAR i, n: LONGINT; p: Heaps.ProcessLink;
  693. BEGIN
  694. n := 0;
  695. Machine.Acquire(Machine.Objects);
  696. FOR i := MinPriority+1 TO NumPriorities-1 DO
  697. p := ready.q[i].head; WHILE p # NIL DO INC(n); p := p.next END
  698. END;
  699. FOR i := 0 TO Machine.MaxCPU-1 DO
  700. IF (running[i] # NIL) & (running[i].priority > MinPriority) THEN INC(n) END
  701. END;
  702. Machine.Release(Machine.Objects);
  703. RETURN n
  704. END NumReady;
  705. (** Return number of CPU cycles consumed by the specified process for each processor. If all is TRUE,
  706. return the number of cycles since the process has been created. If FALSE, return the number of cycles
  707. consumed since the last time asked. *)
  708. PROCEDURE GetCpuCycles*(process : Process; VAR cpuCycles : CpuCyclesArray; all : BOOLEAN);
  709. VAR i : LONGINT;
  710. BEGIN
  711. ASSERT(process # NIL);
  712. FOR i := 0 TO Machine.MaxCPU-1 DO cpuCycles[i] := process.cpuCycles[i]; END;
  713. IF ~all THEN
  714. FOR i := 0 TO Machine.MaxCPU-1 DO
  715. cpuCycles[i] := cpuCycles[i] - process.lastCpuCycles[i];
  716. process.lastCpuCycles[i] := process.cpuCycles[i]; (* actually could have changed meanwhile *)
  717. END;
  718. END;
  719. END GetCpuCycles;
  720. (*! DEBUG *)
  721. VAR
  722. currentProcessTime- : HUGEINT;
  723. PROCEDURE CurrentProcessTime * (): HUGEINT;
  724. VAR result: HUGEINT; process: Process; i: LONGINT;
  725. BEGIN
  726. currentProcessTime := Machine.GetTimer();
  727. result := currentProcessTime - perfTsc[Machine.ID()];
  728. process := CurrentProcess();
  729. FOR i := 0 TO Machine.MaxCPU-1 DO result := result + process.cpuCycles[i]; END;
  730. RETURN result;
  731. END CurrentProcessTime;
  732. PROCEDURE TimerFrequency * (): HUGEINT;
  733. BEGIN
  734. RETURN 333000000
  735. END TimerFrequency;
  736. (* Handle hardware interrupt and route it to an interrupt handler process. *)
  737. PROCEDURE FieldIRQ(VAR state: Machine.State);
  738. VAR t: Process; id: LONGINT; new: Process; preempt: BOOLEAN;
  739. BEGIN
  740. Machine.DisableIRQ(state.INT); (* do this before acknowledging irq *)
  741. IF StrongChecks THEN
  742. IF processingIRQ[state.INT-MinIRQ] THEN
  743. (*Trace.String("IRQ recursion "); Trace.Address(state.INT); Trace.Ln;*)
  744. RETURN
  745. ELSE
  746. processingIRQ[state.INT-MinIRQ] := TRUE;
  747. END;
  748. END;
  749. (* if the reenabling of interrupts cannot be circumvented, then it is REQUIRED to acknowledge interrupts
  750. BEFORE reenabling. Otherwise spurious IRQs cannot be identified as such.
  751. Please note that this particular problem with spurious IRQs cannot observed on many machines but IF it is observed
  752. then the machine will behave unexpected. Very hard to debug and trace!
  753. Machine.Ack(state.INT);
  754. Machine.Sti (); (* avoid Processors.StopAll deadlock when waiting for locks below (remove this) *)
  755. *)
  756. Machine.Acquire(Machine.Objects);
  757. (*IF state.INT = 53 THEN Trace.String("|") END;*)
  758. t := interrupt[state.INT-MinIRQ].process;
  759. IF StrongChecks THEN ASSERT(t.mode = AwaitingEvent) END;
  760. id := Machine.ID ();
  761. preempt := (t.priority > maxReady) & (maxReady # MinPriority) & (t.priority > running[id].priority);
  762. Enter(t);
  763. IF preempt THEN
  764. IF Stats THEN Machine.AtomicInc(Npreempt) END;
  765. (* pre-empt the current process *)
  766. IF Machine.PreemptCount(id) = 1 THEN (* check against 1, because we are holding one lock *)
  767. Select(new, running[id].priority + 1);
  768. IF new # NIL THEN
  769. INC (running[id].cpuCycles[id], Machine.GetTimer () - perfTsc[id]);
  770. IF running[id].priority = MinPriority THEN (* Special treatment for idle threads *)
  771. INC (idleCycles[id], Machine.GetTimer () - perfTsc[id]);
  772. END;
  773. IF Stats THEN Machine.AtomicInc(NpreemptTaken) END;
  774. INCL(running[id].flags, Preempted);
  775. Machine.CopyState(state, running[id].state);
  776. Machine.FPUSaveFull(running[id].sse); (* to do: floating-point exception possible / Machine.SetupFPU *)
  777. Enter(running[id]);
  778. running[id] := new;
  779. new.mode := Running; new.procID := id;
  780. IF Preempted IN new.flags THEN
  781. EXCL(new.flags, Preempted);
  782. Machine.CopyState(new.state, state);
  783. Machine.FPURestoreFull(new.sse)
  784. ELSE
  785. SwitchToState(new, state);
  786. Machine.FPURestoreMin(new.sse)
  787. END;
  788. perfTsc[id] := Machine.GetTimer ()
  789. ELSE
  790. IF Stats THEN Machine.AtomicInc(NpreemptNothing) END
  791. END
  792. ELSE
  793. IF Stats THEN Machine.AtomicInc(NpreemptCritical) END (* not preemptable *)
  794. END
  795. END;
  796. Machine.Release(Machine.Objects)
  797. END FieldIRQ;
  798. (* Process scheduled to handle an interrupt. *)
  799. PROCEDURE InterruptProcess(self: ProtectedObject);
  800. VAR h: InterruptList; t: Process; int: LONGINT;
  801. BEGIN
  802. int := self(Interrupter).interruptNumber;
  803. t := interrupt[int-MinIRQ].process;
  804. LOOP
  805. h := interrupt[int-MinIRQ].root; (* concurrent updates allowed in InstallHandler and RemoveHandler *)
  806. WHILE h # NIL DO h.handler (); h := h.next END;
  807. Machine.Acquire(Machine.Objects);
  808. ASSERT(running[Machine.ID ()] = t); (* strong check *)
  809. t.mode := AwaitingEvent;
  810. processingIRQ[int-MinIRQ] := FALSE;
  811. Machine.EnableIRQ(int);
  812. SwitchToNew
  813. END
  814. END InterruptProcess;
  815. (** Install interrupt handler. *)
  816. PROCEDURE InstallHandler*(h: EventHandler; int: LONGINT);
  817. VAR t: Process; new: BOOLEAN; ih: Interrupter; n: InterruptList; i: LONGINT;
  818. BEGIN
  819. ASSERT((int >= MinIRQ) & (int-MinIRQ < NumIRQ)); (* range check *)
  820. IF interrupt[int-MinIRQ].process = NIL THEN (* first handler for this irq *)
  821. (* allocate process outside lock region, to avoid GC lock problems. *)
  822. (* hack: use type parameter to pass int index & set obj to h, for System.ShowProcesses *)
  823. NEW(ih); ih.interruptNumber := int;
  824. NewProcess(InterruptProcess, {Resistant}, ih, t);
  825. t.priority := High; (* second-level interrupt handling processes have high priority, handlers may allocate memory, use exclusive locks and awaits *)
  826. t.staticPriority := t.priority;
  827. FOR i := 0 TO LEN(t.prioRequests) - 1 DO t.prioRequests[i] := 0 END;
  828. INC(t.prioRequests[t.priority])
  829. END;
  830. NEW(n); n.handler := h;
  831. Machine.Acquire(Machine.Objects);
  832. IF interrupt[int-MinIRQ].process = NIL THEN (* still first handler for this irq *)
  833. t.id := nextProcessID; INC(nextProcessID);
  834. t.mode := AwaitingEvent;
  835. interrupt[int-MinIRQ].process := t;
  836. new := TRUE
  837. ELSE
  838. new := FALSE
  839. END;
  840. n.next := interrupt[int-MinIRQ].root; (* can be concurrent with loop in InterruptProcess *)
  841. interrupt[int-MinIRQ].root := n;
  842. Machine.Release(Machine.Objects);
  843. IF new THEN Machine.InstallHandler(FieldIRQ, int) END (* do outside lock region to avoid NEW/GC deadlock *)
  844. END InstallHandler;
  845. (** Remove interrupt handler. *)
  846. PROCEDURE RemoveHandler*(h: EventHandler; int: LONGINT);
  847. VAR p, c: InterruptList;
  848. BEGIN
  849. ASSERT((int >= MinIRQ) & (int-MinIRQ < NumIRQ)); (* range check *)
  850. Machine.Acquire(Machine.Objects);
  851. p := NIL; c := interrupt[int-MinIRQ].root;
  852. WHILE (c.handler # h) & (c # NIL) DO p := c; c := c.next END;
  853. IF c.handler = h THEN (* handler found *)
  854. IF p = NIL THEN
  855. interrupt[int-MinIRQ].root := c.next;
  856. (*
  857. IF c.inext = NIL THEN (* this was the last handler *)
  858. Machine.RemoveHandler(FieldIRQ, int)
  859. (* to do: synchronize with FieldIRQ and InterruptProcess *)
  860. END
  861. *)
  862. ELSE
  863. p.next := c.next
  864. END
  865. ELSE
  866. HALT(99); (* handler not found *)
  867. END;
  868. (* can not clear c.next field, because InterruptProcess may be traversing it. *)
  869. Machine.Release(Machine.Objects)
  870. END RemoveHandler;
  871. (* local procedure *)
  872. PROCEDURE SetTimeoutAbsOrRel(t: Timer; h: EventHandler; ms: LONGINT; isAbsolute: BOOLEAN);
  873. VAR e: Timer; trigger: LONGINT;
  874. BEGIN
  875. ASSERT(Machine.Second= 1000); (* assume milliseconds for now *)
  876. ASSERT((t # NIL) & (h # NIL));
  877. IF ms < 1 THEN ms := 1 END;
  878. Machine.Acquire(Machine.Objects);
  879. IF isAbsolute THEN trigger := ms ELSE trigger := Machine.ticks + ms (* ignore overflow *) END;
  880. IF t.next # NIL THEN (* cancel previous timeout *)
  881. t.next.prev := t.prev; t.prev.next := t.next
  882. END;
  883. t.trigger := trigger; t.handler := h;
  884. e := event.next; (* performance: linear search! *)
  885. WHILE (e # event) & (e.trigger - trigger <= 0) DO e := e.next END;
  886. t.prev := e.prev; e.prev := t; t.next := e; t.prev.next := t;
  887. Machine.Release(Machine.Objects)
  888. END SetTimeoutAbsOrRel;
  889. (** Set (or reset) an event handler object's timeout value. *)
  890. PROCEDURE SetTimeout*(t: Timer; h: EventHandler; ms: LONGINT);
  891. BEGIN
  892. SetTimeoutAbsOrRel(t, h, ms, FALSE)
  893. END SetTimeout;
  894. (** Set (or reset) an event handler object's timeout value. Here ms is absolute *)
  895. PROCEDURE SetTimeoutAt*(t: Timer; h: EventHandler; ms: LONGINT);
  896. BEGIN
  897. SetTimeoutAbsOrRel(t, h, ms, TRUE)
  898. END SetTimeoutAt;
  899. (** Cancel an event handler object's timeout, if any. It is possible that the timer has expired, but not yet been scheduled to run. *)
  900. PROCEDURE CancelTimeout*(t: Timer);
  901. BEGIN
  902. Machine.Acquire(Machine.Objects);
  903. ASSERT(t # event);
  904. IF t.next # NIL THEN
  905. t.next.prev := t.prev; t.prev.next := t.next;
  906. t.next := NIL; t.prev := NIL
  907. END;
  908. Machine.Release(Machine.Objects)
  909. END CancelTimeout;
  910. (** Terminate the current process and switch to next process. *)
  911. PROCEDURE Terminate*; (* exported for Linker *)
  912. VAR id: LONGINT;
  913. BEGIN
  914. IF Stats THEN Machine.AtomicInc(Nterminate) END;
  915. Machine.Acquire(Machine.Objects);
  916. id := Machine.ID ();
  917. (*running[id].state.PC := CallerPC ();*) (* for tracing *)
  918. running[id].mode := Terminated; (* a process can also be "terminated" if the queue containing it is garbage collected *)
  919. SwitchToNew;
  920. HALT(2201) (* process resurrected *)
  921. END Terminate;
  922. PROCEDURE Halt;
  923. BEGIN
  924. HALT(halt); (* process halted *)
  925. END Halt;
  926. PROCEDURE HaltUnbreakable;
  927. BEGIN
  928. HALT(haltUnbreakable); (* process halted *)
  929. END HaltUnbreakable;
  930. (* Set the return PC which is saved in the process and set it to -1 *)
  931. PROCEDURE HaltAltPC(haltCode: LONGINT);
  932. VAR bp: ADDRESS; p: Process;
  933. BEGIN
  934. p := running[Machine.ID ()];
  935. ASSERT(p.oldReturnPC # -1);
  936. bp := SYSTEM.GetFramePointer ();
  937. SYSTEM.PUT (bp + AddressSize, p.oldReturnPC);
  938. CASE haltCode OF
  939. |halt: HALT(halt);
  940. |haltUnbreakable: HALT(haltUnbreakable);
  941. END;
  942. END HaltAltPC;
  943. PROCEDURE HaltReturn;
  944. VAR bp: ADDRESS;
  945. BEGIN
  946. bp := SYSTEM.GetFramePointer ();
  947. SYSTEM.GET (bp, bp); (* Get the dynamic link *)
  948. SYSTEM.SetFramePointer (bp); (* Undo the actual paf *)
  949. HaltAltPC(halt);
  950. END HaltReturn;
  951. PROCEDURE HaltUnbreakableReturn;
  952. VAR bp: ADDRESS;
  953. BEGIN
  954. bp := SYSTEM.GetFramePointer ();
  955. SYSTEM.GET (bp, bp); (* Get the dynamic link *)
  956. SYSTEM.SetFramePointer (bp); (* Undo the actual paf *)
  957. HaltAltPC(haltUnbreakable);
  958. END HaltUnbreakableReturn;
  959. PROCEDURE TerminateThis*(t: Process; unbreakable: BOOLEAN);
  960. VAR hdr {UNTRACED}: Heaps.ProtRecBlock; pc, fp : ADDRESS;
  961. (* terminates a process that is either in mode AwaitingLock or AwaitingCond *)
  962. PROCEDURE TerminateAwaiting(t: Process);
  963. VAR hdr {UNTRACED}: Heaps.ProtRecBlock;
  964. BEGIN
  965. SYSTEM.GET(SYSTEM.VAL(ADDRESS, t.waitingOn) + Heaps.HeapBlockOffset, hdr);
  966. ASSERT(hdr IS Heaps.ProtRecBlock);
  967. IF t.mode = AwaitingLock THEN
  968. fp := t.state.BP; (* SwitchTo PAF *)
  969. SYSTEM.GET (fp, fp); (* SwitchToNew PAF *)
  970. SYSTEM.GET (fp, fp); (* Lock PAF*)
  971. SYSTEM.GET (fp + AddressSize, pc); (* Get the return address*)
  972. IF ~Modules.IsExceptionHandled(pc, fp, FALSE) THEN
  973. Remove(hdr.awaitingLock, t);
  974. t.waitingOn := NIL; SYSTEM.GET (t.state.BP + AddressSize, t.oldReturnPC);
  975. IF unbreakable THEN
  976. SYSTEM.PUT (t.state.BP + AddressSize, SYSTEM.VAL (ADDRESS, trapReturn[1]))
  977. ELSE
  978. SYSTEM.PUT (t.state.BP + AddressSize, SYSTEM.VAL (ADDRESS, trapReturn[0]))
  979. END;
  980. Enter(t)
  981. ELSE
  982. Machine.Acquire (Machine.TraceOutput);
  983. Trace.String(" Not allowed to kill "); Trace.Int(t.id, 1); Trace.Char(" "); Trace.Int(t.mode, 1); Trace.Ln;
  984. Machine.Release (Machine.TraceOutput);
  985. END
  986. ELSIF t.mode = AwaitingCond THEN
  987. SYSTEM.GET (t.state.BP, fp);
  988. SYSTEM.GET (t.state.PC, pc);
  989. IF ~Modules.IsExceptionHandled(pc, fp, TRUE) THEN
  990. Remove(hdr.awaitingCond, t);
  991. t.waitingOn := NIL; SYSTEM.GET (t.state.BP + AddressSize, t.oldReturnPC);
  992. IF unbreakable THEN
  993. SYSTEM.PUT (t.state.BP + AddressSize, SYSTEM.VAL (ADDRESS, trapReturn[1]))
  994. ELSE
  995. SYSTEM.PUT (t.state.BP + AddressSize, SYSTEM.VAL (ADDRESS, trapReturn[0]))
  996. END;
  997. Enter(t)
  998. ELSE
  999. Machine.Acquire (Machine.TraceOutput);
  1000. Trace.String(" Not allowed to kill "); Trace.Int(t.id, 1); Trace.Char(" "); Trace.Int(t.mode, 1); Trace.Ln;
  1001. Machine.Release (Machine.TraceOutput);
  1002. END
  1003. END
  1004. END TerminateAwaiting;
  1005. BEGIN
  1006. IF PleaseHalt IN t.flags THEN
  1007. IF TraceVerbose THEN
  1008. Machine.Acquire (Machine.TraceOutput);
  1009. Trace.String("Process (ID="); Trace.Int(t.id, 0); Trace.StringLn (") is already halting!");
  1010. Machine.Release (Machine.TraceOutput);
  1011. END;
  1012. RETURN
  1013. ELSE
  1014. Machine.Acquire(Machine.Objects);
  1015. IF (t = running[Machine.ID ()]) THEN INCL(t.flags, SelfTermination); END;
  1016. IF TraceVerbose THEN
  1017. Machine.Acquire (Machine.TraceOutput);
  1018. Trace.String(" Kill "); Trace.Int(t.id, 1); Trace.Char(" "); Trace.Int(t.mode, 1); Trace.Ln;
  1019. Machine.Release (Machine.TraceOutput);
  1020. END;
  1021. CASE t.mode OF
  1022. |Running:
  1023. INCL(t.flags, PleaseHalt);
  1024. IF unbreakable THEN INCL(t.flags, Unbreakable) END
  1025. |Ready:
  1026. DEC(t.state.SP, AddressSize); SYSTEM.PUT (t.state.SP, t.state.PC);
  1027. IF unbreakable THEN t.state.PC := SYSTEM.VAL (ADDRESS, trap[1])
  1028. ELSE t.state.PC := SYSTEM.VAL (ADDRESS, trap[0]) END
  1029. |AwaitingLock, AwaitingCond:
  1030. IF HandlePriorityInv THEN
  1031. TerminateAwaiting(t)
  1032. ELSE
  1033. SYSTEM.GET(SYSTEM.VAL(ADDRESS, t.waitingOn) + Heaps.HeapBlockOffset, hdr);
  1034. ASSERT(hdr IS Heaps.ProtRecBlock);
  1035. IF ~hdr.locked THEN
  1036. Machine.AcquireObject(hdr.locked);
  1037. TerminateAwaiting(t);
  1038. Machine.ReleaseObject(hdr.locked)
  1039. END
  1040. END
  1041. | AwaitingEvent, Unknown, Terminated: (* skip *)
  1042. END;
  1043. Machine.Release(Machine.Objects)
  1044. END
  1045. END TerminateThis;
  1046. (* called by WMProcessInfo to obtain the current state of a running process *)
  1047. PROCEDURE UpdateProcessState*( p: Process );
  1048. BEGIN
  1049. (* update p.stat.{PC,BP,SP} *)
  1050. END UpdateProcessState;
  1051. (* Finalize a process. *)
  1052. PROCEDURE FinalizeProcess(t: ANY);
  1053. BEGIN
  1054. Machine.DisposeStack(t(Process).stack)
  1055. END FinalizeProcess;
  1056. (* Allocate a new process associated with "obj". Must be outside lock region, because of potential GC. *)
  1057. PROCEDURE NewProcess(body: Body; flags: SET; obj: ProtectedObject; VAR new: Process);
  1058. VAR t: Process; sp: ADDRESS; id: LONGINT; fn: Heaps.FinalizerNode;
  1059. BEGIN
  1060. NEW(t); NEW(fn); (* implicit call Heaps.NewRec *)
  1061. t.next := NIL; t.prev := NIL; t.rootedNext := NIL;
  1062. t.waitingOn := NIL; t.flags := flags;
  1063. t.obj := obj; t.mode := Unknown;
  1064. (* initialize the stack *)
  1065. Machine.NewStack(t.stack, t, sp);
  1066. IF VeryConservative THEN
  1067. Machine.Fill32(t.stack.adr, sp-t.stack.adr, LONGINT(0D0D0DEADH))
  1068. END;
  1069. SYSTEM.PUT (sp-1*AddressSize, obj); (* self parameter for body *)
  1070. SYSTEM.PUT (sp-2*AddressSize, terminate); (* return address for body *)
  1071. SYSTEM.PUT (sp-3*AddressSize, NIL); (* FP for body *)
  1072. (* the following two are not necessary because the compiler instruments the caller to cleanup parameters, not the callee! *)
  1073. (*SYSTEM.PUT (sp-3*AddressSize, NIL);*) (* parameter for SwitchTo (ADR(running)) *)
  1074. (*SYSTEM.PUT (sp-4*AddressSize, NIL);*) (* parameter for SwitchTo (new) *)
  1075. SYSTEM.PUT (sp-4*AddressSize, SYSTEM.VAL(ADDRESS, body) + ReturnStackDisplacement); (* return address for SwitchTo (body entry point) *)
  1076. SYSTEM.PUT (sp-5*AddressSize, sp-3*AddressSize); (* end of dynamic link list (FP value at entry to body) *)
  1077. t.sseAdr := ADDRESSOF(t.sse) + ((-ADDRESSOF(t.sse)) MOD 16);
  1078. Machine.FPUSaveMin(t.sse); (* inherit FPU state of caller *)
  1079. t.state.BP := sp - 5*AddressSize;
  1080. t.state.SP := t.state.BP;
  1081. t.state.PC := 0; (* indicating that process is not running yet *)
  1082. (* set up exception handling *)
  1083. IF Restart IN flags THEN (* restart object body *)
  1084. t.restartPC := SYSTEM.VAL (ADDRESS, body) + ReturnStackDisplacement;
  1085. t.restartSP := sp-3*AddressSize (* 1 parameter and return address of body *)
  1086. ELSE (* terminate process *)
  1087. t.restartPC := SYSTEM.VAL (ADDRESS, terminate) + ReturnStackDisplacement;
  1088. t.restartSP := sp-AddressSize
  1089. END;
  1090. fn.finalizer := FinalizeProcess;
  1091. Heaps.AddFinalizer(t, fn);
  1092. (* return *)
  1093. FOR id := 0 TO Machine.MaxCPU-1 DO t.cpuCycles[id] := 0 END;
  1094. new := t
  1095. END NewProcess;
  1096. (* Create the process associated with an active object (kernel call). *)
  1097. PROCEDURE CreateProcess*(body: Body; priority: LONGINT; flags: SET; obj: ProtectedObject);
  1098. VAR t: Process; type: ADDRESS; heapBlock {UNTRACED}: Heaps.HeapBlock; i: LONGINT;
  1099. BEGIN
  1100. IF Stats THEN Machine.AtomicInc(Ncreate) END;
  1101. SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, heapBlock);
  1102. ASSERT(heapBlock IS Heaps.ProtRecBlock); (* protected object *)
  1103. SYSTEM.GET (SYSTEM.VAL (ADDRESS, obj) + Heaps.TypeDescOffset, type); (* type tag *)
  1104. IF Restart IN flags THEN INCL(flags, Resistant) END; (* SAFE => Restart & Resistant *)
  1105. NewProcess(body, flags, obj, t);
  1106. Machine.Acquire(Machine.Objects);
  1107. t.id := nextProcessID; INC(nextProcessID);
  1108. IF priority = 0 THEN (* no priority specified *)
  1109. t.priority := running[Machine.ID ()].priority (* inherit priority of creator *)
  1110. ELSIF priority > 0 THEN (* positive priority specified *)
  1111. t.priority := priority
  1112. ELSE (* negative priority specified (only for Idle process) *)
  1113. t.priority := MinPriority
  1114. END;
  1115. t.staticPriority := t.priority;
  1116. FOR i := 0 TO LEN(t.prioRequests) - 1 DO t.prioRequests[i] := 0 END;
  1117. INC(t.prioRequests[t.priority]);
  1118. CASE t.priority OF
  1119. MinPriority : t.rootedNext := rootedProcesses[t.priority]; rootedProcesses[t.priority] := t
  1120. | Low, Normal, High : (* do nothing, processes with this priority are traced by GC automatically *)
  1121. | GCPriority, Realtime : t.rootedNext := rootedProcesses[t.priority]; rootedProcesses[t.priority] := t
  1122. END;
  1123. Enter(t);
  1124. Machine.Release(Machine.Objects)
  1125. END CreateProcess;
  1126. (* Lock a protected object (kernel call) *)
  1127. (* There are two different procedures for locking a protected object in case of priority inversion handling enabled or disabled due to the different
  1128. locking strategy. *)
  1129. PROCEDURE Lock*(obj: ProtectedObject; exclusive: BOOLEAN);
  1130. BEGIN
  1131. IF HandlePriorityInv THEN
  1132. LockPriorityInv(obj, exclusive)
  1133. ELSE
  1134. LockNoPriorityInv(obj, exclusive)
  1135. END
  1136. END Lock;
  1137. (* Lock a protected object if priority inversion handling is disabled. Header locks, preemption and Machine.Objects locks are used. *)
  1138. PROCEDURE LockNoPriorityInv(obj: ProtectedObject; exclusive: BOOLEAN);
  1139. VAR hdr {UNTRACED}: Heaps.ProtRecBlock; r: Process; id: LONGINT;
  1140. BEGIN (* {called from user level} *)
  1141. IF Stats THEN Machine.AtomicInc(Nlock) END;
  1142. SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
  1143. IF StrongChecks THEN
  1144. ASSERT(hdr IS Heaps.ProtRecBlock); (* protected object *)
  1145. ASSERT(exclusive) (* shared not implemented yet *)
  1146. END;
  1147. id := Machine.AcquirePreemption ();
  1148. Machine.AcquireObject(hdr.locked);
  1149. IF hdr.count = 0 THEN (* not locked *)
  1150. hdr.count := -1; hdr.lockedBy := GetProcessPtr (); (* set exclusive lock *)
  1151. Machine.ReleaseObject(hdr.locked);
  1152. Machine.ReleasePreemption;
  1153. ELSE (* locked *)
  1154. r := GetProcessPtr ();
  1155. IF hdr.lockedBy = r THEN
  1156. Machine.ReleaseObject(hdr.locked);
  1157. Machine.ReleasePreemption;
  1158. ASSERT(hdr.lockedBy # r, 2203); (* nested locks not allowed *)
  1159. END;
  1160. ASSERT(r.waitingOn = NIL);
  1161. r.waitingOn := obj; r.mode := AwaitingLock;
  1162. Machine.Acquire(Machine.Objects);
  1163. Put(hdr.awaitingLock, r);
  1164. Machine.ReleaseObject(hdr.locked);
  1165. Machine.ReleasePreemption;
  1166. SwitchToNew
  1167. END
  1168. END LockNoPriorityInv;
  1169. (*
  1170. (* propagation of priorities - lock Machine.Objects is taken.
  1171. This is a procedure that calls itself recursively if a higher priority is propagated along a chain of resources and processes where each resource
  1172. is locked by a process that itself waits on a resource. The procedure can be rewritten into a non-recursive procedure if needed..
  1173. Remark: parameters of type Heaps.HeapBlock or extensions of it are not passed as parameters for clarity and safety reasons .
  1174. Instead, a ProtectedObject pointer is passed as the first parameter. *)
  1175. PROCEDURE PropagatePrio(obj: ProtectedObject; prevMaxWaitingPrio, waitingPrio: LONGINT);
  1176. VAR hdr {UNTRACED}: Heaps.ProtRecBlock; p: Process;
  1177. BEGIN
  1178. SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
  1179. IF hdr.lockedBy # NIL THEN
  1180. p := hdr.lockedBy(Process);
  1181. DEC(p.prioRequests[prevMaxWaitingPrio]);
  1182. INC(p.prioRequests[waitingPrio]);
  1183. IF (p.waitingOn # NIL) & (waitingPrio > p.priority) THEN
  1184. obj := p.waitingOn;
  1185. SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
  1186. prevMaxWaitingPrio := MaxPrio(hdr.waitingPriorities);
  1187. DEC(hdr.waitingPriorities[p.priority]);
  1188. INC(hdr.waitingPriorities[waitingPrio]);
  1189. IF waitingPrio > prevMaxWaitingPrio THEN PropagatePrio(obj, prevMaxWaitingPrio, waitingPrio) END
  1190. END;
  1191. IF waitingPrio > p.priority THEN
  1192. IF p.mode = Ready THEN Remove(ready.q[p.priority], p) END; (* remove p from the lower priority queue ... *)
  1193. p.priority := waitingPrio;
  1194. IF p.mode = Ready THEN Enter(p) END; (* ... and add it to the higher priority queue *)
  1195. END
  1196. END;
  1197. END PropagatePrio;
  1198. *)
  1199. (* propagation of priorities - lock Machine.Objects is taken.
  1200. This procedure is the iterative version of the above commented out recursive procedure.
  1201. Remark: hdr is an actually UNTRACED parameter. The GC, however, can handle this, see procedure Heaps.Mark, there is a check whether the
  1202. pointer to the header part is valid. In case of hdr, the pointer ot the header part is NIL. *)
  1203. PROCEDURE PropagatePrio(hdr: Heaps.ProtRecBlock; prevMaxWaitingPrio, waitingPrio: LONGINT);
  1204. VAR propagateFurther: BOOLEAN; p: Process; obj: ProtectedObject;
  1205. BEGIN
  1206. propagateFurther := TRUE;
  1207. WHILE propagateFurther & (waitingPrio > prevMaxWaitingPrio) DO
  1208. IF hdr.lockedBy # NIL THEN
  1209. p := hdr.lockedBy(Process);
  1210. DEC(p.prioRequests[prevMaxWaitingPrio]);
  1211. INC(p.prioRequests[waitingPrio]);
  1212. IF (p.waitingOn # NIL) & (waitingPrio > p.priority) THEN
  1213. obj := p.waitingOn;
  1214. SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
  1215. prevMaxWaitingPrio := MaxPrio(hdr.waitingPriorities);
  1216. DEC(hdr.waitingPriorities[p.priority]);
  1217. INC(hdr.waitingPriorities[waitingPrio]);
  1218. ELSE (* p is not waiting for a resource or waitingPrio is less or equal to p's priority - priority propagation finishes *)
  1219. propagateFurther := FALSE
  1220. END;
  1221. IF waitingPrio > p.priority THEN (* independently of whether p is waiting on a resource or not the priority of p is changed if it is lower than waitingPrio *)
  1222. IF p.mode = Ready THEN Remove(ready.q[p.priority], p) END; (* remove p from the lower priority queue ... *)
  1223. p.priority := waitingPrio;
  1224. IF p.mode = Ready THEN Enter(p) END; (* ... and add it to the higher priority queue *)
  1225. END
  1226. ELSE (* current resource is not locked - priority propagation finishes *)
  1227. propagateFurther := FALSE
  1228. END
  1229. END
  1230. END PropagatePrio;
  1231. (* TO DO: adapt priority inversion algorithm such that priority of a process is not raised higher than High, it must not become Realtime, otherwise
  1232. GC may be corrupted *)
  1233. (* Lock a protected object if priority inversion handling is enabled. Machine.Objects lock is used. *)
  1234. PROCEDURE LockPriorityInv(obj: ProtectedObject; exclusive: BOOLEAN);
  1235. VAR hdr {UNTRACED}: Heaps.ProtRecBlock; r: Process;
  1236. maxWaitingPrio, prevMaxWaitingPrio: LONGINT;
  1237. BEGIN (* {called from user level} *)
  1238. IF Stats THEN Machine.AtomicInc(Nlock) END;
  1239. SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
  1240. IF StrongChecks THEN
  1241. ASSERT(hdr IS Heaps.ProtRecBlock); (* protected object *)
  1242. ASSERT(exclusive) (* shared not implemented yet *)
  1243. END;
  1244. Machine.Acquire(Machine.Objects);
  1245. r := (*GetProcessPtr0();*) running[Machine.ID()];
  1246. ASSERT(r # NIL);
  1247. IF hdr.count = 0 THEN (* not locked *)
  1248. hdr.count := -1; hdr.lockedBy := r; (* set exclusive lock *)
  1249. maxWaitingPrio := MaxPrio(hdr.waitingPriorities);
  1250. INC(r.prioRequests[maxWaitingPrio]);
  1251. r.priority := MaxPrio(r.prioRequests);
  1252. Machine.Release(Machine.Objects);
  1253. ELSE (* locked (to do: on multiprocessors, perhaps spin here for a while, if lockedBy.mode = running) *)
  1254. IF hdr.lockedBy = NIL THEN
  1255. Machine.Release(Machine.Objects);
  1256. ASSERT(hdr.lockedBy # NIL)
  1257. END;
  1258. IF hdr.lockedBy = r THEN
  1259. Machine.Release(Machine.Objects);
  1260. ASSERT(hdr.lockedBy # r, 2203); (* nested locks not allowed *)
  1261. END;
  1262. IF r.waitingOn # NIL THEN
  1263. Machine.Acquire(Machine.TraceOutput);
  1264. Trace.String("Objects: LockPriorityInv - hdr.count # NIL, but r.waitingOn # NIL");
  1265. Machine.Release(Machine.TraceOutput)
  1266. END;
  1267. ASSERT(r.waitingOn = NIL);
  1268. r.waitingOn := obj; r.mode := AwaitingLock;
  1269. prevMaxWaitingPrio := MaxPrio(hdr.waitingPriorities);
  1270. INC(hdr.waitingPriorities[r.priority]);
  1271. IF r.priority > prevMaxWaitingPrio THEN PropagatePrio(hdr, prevMaxWaitingPrio, r.priority) END;
  1272. Put(hdr.awaitingLock, r);
  1273. SwitchToNew
  1274. END
  1275. END LockPriorityInv;
  1276. (* Find the first true condition from the queue and remove it. Assume the object is currently locked. *)
  1277. PROCEDURE FindCondition(VAR q: ProcessQueue): Process;
  1278. VAR first, cand: Process;
  1279. BEGIN
  1280. IF Stats THEN Machine.AtomicInc(Ncondition) END;
  1281. Get(q, first);
  1282. IF first.condition(first.condFP) THEN
  1283. IF Stats THEN Machine.AtomicInc(Ncondition1True) END;
  1284. RETURN first
  1285. END;
  1286. Put(q, first);
  1287. WHILE q.head # first DO
  1288. IF Stats THEN Machine.AtomicInc(Ncondition2) END;
  1289. Get(q, cand);
  1290. IF cand.condition(cand.condFP) THEN
  1291. IF Stats THEN Machine.AtomicInc(Ncondition2True) END;
  1292. RETURN cand
  1293. END;
  1294. Put(q, cand)
  1295. END;
  1296. RETURN NIL
  1297. END FindCondition;
  1298. (* Find highest priority in array of priority counts *)
  1299. PROCEDURE MaxPrio(CONST priorityCounts: ARRAY OF LONGINT): LONGINT;
  1300. VAR i: LONGINT;
  1301. BEGIN
  1302. i := LEN(priorityCounts) - 1;
  1303. WHILE (i >= 0) & (priorityCounts[i] = 0) DO DEC(i) END;
  1304. IF priorityCounts[i] = 0 THEN
  1305. Machine.Acquire(Machine.TraceOutput);
  1306. Trace.StringLn("Objects: MaxPrio - SEVERE ERROR: priorityCounts contains all zeros");
  1307. Machine.Release(Machine.TraceOutput);
  1308. END;
  1309. RETURN i
  1310. END MaxPrio;
  1311. (* Unlock a protected object (kernel call). *)
  1312. (* There are two different procedures for locking a protected object in case of priority inverison handling enabled or disabled due to the different
  1313. locking strategy. *)
  1314. PROCEDURE Unlock*(obj: ProtectedObject; dummy: BOOLEAN);
  1315. BEGIN
  1316. IF HandlePriorityInv THEN
  1317. UnlockPriorityInv(obj)
  1318. ELSE
  1319. UnlockNoPriorityInv(obj)
  1320. END
  1321. END Unlock;
  1322. (* transfer the lock from a resource to another process.
  1323. Remark: hdr is an actually UNTRACED parameter. The GC, however, can handle this, see procedure Heaps.Mark, there is a check whether the
  1324. pointer to the header part is valid. In case of hdr, the pointer ot the header part is NIL. *)
  1325. PROCEDURE TransferLock(hdr: Heaps.ProtRecBlock; p: Process);
  1326. VAR maxWaitingPrio: LONGINT;
  1327. BEGIN
  1328. ASSERT(p # NIL);
  1329. p.waitingOn := NIL; hdr.lockedBy := p;
  1330. IF HandlePriorityInv THEN
  1331. DEC(hdr.waitingPriorities[p.priority]);
  1332. maxWaitingPrio := MaxPrio(hdr.waitingPriorities);
  1333. INC(p.prioRequests[maxWaitingPrio]);
  1334. p.priority := MaxPrio(p.prioRequests)
  1335. END
  1336. END TransferLock;
  1337. (* Unlock a protected object if priority inversion handling is disabled. Header locks, preemption and Machine.Objects locks are used. *)
  1338. PROCEDURE UnlockNoPriorityInv(obj: ProtectedObject);
  1339. VAR hdr {UNTRACED}: Heaps.ProtRecBlock; t, c, r: Process; id: LONGINT;
  1340. BEGIN
  1341. IF Stats THEN Machine.AtomicInc(Nunlock) END;
  1342. SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
  1343. IF StrongChecks THEN
  1344. ASSERT(hdr IS Heaps.ProtRecBlock) (* protected object *)
  1345. END;
  1346. ASSERT(hdr.count = -1); (* exclusive locked *)
  1347. IF hdr.awaitingCond.head # NIL THEN (* evaluate the waiting conditions *)
  1348. (* we are holding the lock, so the queue can not change (to do: except in TerminateThis) *)
  1349. c := FindCondition(hdr.awaitingCond) (* interrupts should be on during this call *)
  1350. ELSE
  1351. c := NIL
  1352. END;
  1353. id := Machine.AcquirePreemption ();
  1354. Machine.AcquireObject(hdr.locked);
  1355. r := running[Machine.ID ()];
  1356. ASSERT(r # NIL);
  1357. IF hdr.lockedBy # r THEN
  1358. Machine.ReleaseObject(hdr.locked);
  1359. Machine.ReleasePreemption;
  1360. ASSERT(hdr.lockedBy = r)
  1361. END;
  1362. IF c = NIL THEN (* no true condition found, check the lock queue *)
  1363. Get(hdr.awaitingLock, t);
  1364. IF t # NIL THEN
  1365. IF StrongChecks THEN
  1366. ASSERT((t.mode = AwaitingLock) & (t.waitingOn = obj))
  1367. END;
  1368. TransferLock(hdr, t)
  1369. ELSE
  1370. hdr.lockedBy := NIL; hdr.count := 0
  1371. END
  1372. ELSE (* true condition found, transfer the lock *)
  1373. TransferLock(hdr, c);
  1374. t := NIL
  1375. END;
  1376. Machine.ReleaseObject(hdr.locked);
  1377. IF (c # NIL) OR (t # NIL) THEN
  1378. Machine.Acquire(Machine.Objects);
  1379. IF c # NIL THEN Enter(c) END;
  1380. IF t # NIL THEN Enter(t) END;
  1381. Machine.Release(Machine.Objects);
  1382. END;
  1383. Machine.ReleasePreemption;
  1384. END UnlockNoPriorityInv;
  1385. (* Unlock a protected object in case priority inversion handling is enabled. Machine.Objects lock is used. *)
  1386. PROCEDURE UnlockPriorityInv(obj: ProtectedObject);
  1387. VAR hdr {UNTRACED}: Heaps.ProtRecBlock; t, c, r: Process; maxWaitingPrio: LONGINT;
  1388. BEGIN
  1389. IF Stats THEN Machine.AtomicInc(Nunlock) END;
  1390. SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
  1391. IF StrongChecks THEN
  1392. ASSERT(hdr IS Heaps.ProtRecBlock) (* protected object *)
  1393. END;
  1394. ASSERT(hdr.count = -1); (* exclusive locked *)
  1395. IF hdr.awaitingCond.head # NIL THEN (* evaluate the waiting conditions *)
  1396. (* we are holding the lock, so the queue can not change (to do: except in TerminateThis) *)
  1397. c := FindCondition(hdr.awaitingCond) (* interrupts should be on during this call *)
  1398. ELSE
  1399. c := NIL
  1400. END;
  1401. Machine.Acquire(Machine.Objects);
  1402. r := running[Machine.ID ()];
  1403. ASSERT(r # NIL);
  1404. IF hdr.lockedBy # r THEN
  1405. Machine.Release(Machine.Objects);
  1406. ASSERT(hdr.lockedBy = r)
  1407. END;
  1408. maxWaitingPrio := MaxPrio(hdr.waitingPriorities);
  1409. DEC(r.prioRequests[maxWaitingPrio]);
  1410. r.priority := MaxPrio(r.prioRequests);
  1411. IF c = NIL THEN (* no true condition found, check the lock queue *)
  1412. t := NIL;
  1413. GetMaxPrio(hdr.awaitingLock, t);
  1414. IF t = NIL THEN
  1415. hdr.lockedBy := NIL; hdr.count := 0
  1416. ELSE
  1417. IF StrongChecks THEN ASSERT((t.mode = AwaitingLock) & (t.waitingOn = obj)) END;
  1418. TransferLock(hdr, t)
  1419. END
  1420. ELSE (* true condition found, transfer the lock *)
  1421. TransferLock(hdr, c);
  1422. t := NIL
  1423. END;
  1424. IF (c # NIL) OR (t # NIL) THEN
  1425. IF c # NIL THEN Enter(c) END;
  1426. IF t # NIL THEN Enter(t) END;
  1427. END;
  1428. Machine.Release(Machine.Objects);
  1429. END UnlockPriorityInv;
  1430. (* Await a condition (kernel call). *)
  1431. (* There are two different procedures for locking a protected object in case of priority inverison handling enabled or disabled due to the different
  1432. locking strategies, i.e. there are no header locks in case of priority inversion handling. *)
  1433. PROCEDURE Await*(cond: Condition; slink: ADDRESS; obj: ProtectedObject; flags: SET);
  1434. BEGIN
  1435. IF HandlePriorityInv THEN
  1436. AwaitPriorityInv(cond, slink, obj, flags)
  1437. ELSE
  1438. AwaitNoPriorityInv(cond, slink, obj, flags)
  1439. END
  1440. END Await;
  1441. (* Await a condition if priority inversion handling is disabled. Header locks, preemption and Machine.Objects locks are used. *)
  1442. PROCEDURE AwaitNoPriorityInv(cond: Condition; slink: ADDRESS; obj: ProtectedObject; flags: SET);
  1443. VAR hdr {UNTRACED}: Heaps.ProtRecBlock; r, c, t: Process; id: LONGINT;
  1444. BEGIN
  1445. IF Stats THEN Machine.AtomicInc(Nawait) END;
  1446. IF 1 IN flags THEN (* compiler did not generate IF *)
  1447. IF Stats THEN Machine.AtomicInc(NawaitNoIF) END;
  1448. IF cond(slink) THEN
  1449. IF Stats THEN Machine.AtomicInc(NawaitTrue) END;
  1450. RETURN (* condition already true *)
  1451. END
  1452. END;
  1453. SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
  1454. IF StrongChecks THEN
  1455. ASSERT(hdr IS Heaps.ProtRecBlock) (* protected object *)
  1456. END;
  1457. id := Machine.AcquirePreemption ();
  1458. Machine.AcquireObject(hdr.locked); (* must acquire object lock before other locks *)
  1459. r := running[id];
  1460. ASSERT(r # NIL);
  1461. IF hdr.lockedBy = r THEN (* current process holds exclusive lock *)
  1462. IF StrongChecks THEN ASSERT(hdr.count = -1) END; (* exclusive locked *)
  1463. IF hdr.awaitingCond.head # NIL THEN (* evaluate the waiting conditions *)
  1464. (* we are holding the lock, so the queue can not change (to do: except in TerminateThis) *)
  1465. c := FindCondition(hdr.awaitingCond) (* interrupts should be on during this call *)
  1466. ELSE
  1467. c := NIL
  1468. END;
  1469. IF c = NIL THEN
  1470. Get(hdr.awaitingLock, t);
  1471. IF t = NIL THEN (* none waiting - remove lock *)
  1472. hdr.count := 0; hdr.lockedBy := NIL;
  1473. ELSE (* transfer lock to first waiting process *)
  1474. IF StrongChecks THEN ASSERT(t.mode = AwaitingLock) END;
  1475. TransferLock(hdr, t)
  1476. END;
  1477. ELSE
  1478. TransferLock(hdr, c);
  1479. t := NIL
  1480. END;
  1481. ELSE (* no lock, or some other process may hold the lock, but that's the user's indaba (may be monotonic condition) *)
  1482. Machine.ReleaseObject(hdr.locked);
  1483. Machine.ReleasePreemption;
  1484. HALT(2204) (* await must be exclusive region *)
  1485. END;
  1486. Machine.Acquire(Machine.Objects); (* Put and SwitchTo must be protected *)
  1487. IF c # NIL THEN Enter(c) END;
  1488. IF t # NIL THEN Enter(t) END;
  1489. IF StrongChecks THEN ASSERT(r.waitingOn = NIL) END;
  1490. r.condition := cond; r.condFP := slink;
  1491. r.waitingOn := obj; r.mode := AwaitingCond;
  1492. Put(hdr.awaitingCond, r);
  1493. Machine.ReleaseObject(hdr.locked);
  1494. Machine.ReleasePreemption;
  1495. (* reschedule *)
  1496. SwitchToNew;
  1497. IF StrongChecks THEN
  1498. ASSERT(cond(slink));
  1499. ASSERT(hdr.lockedBy = r) (* lock held again *)
  1500. END
  1501. END AwaitNoPriorityInv;
  1502. (* Await a condition in case priority inversion handling is enabled. Machine.Objects lock is used. *)
  1503. PROCEDURE AwaitPriorityInv(cond: Condition; slink: ADDRESS; obj: ProtectedObject; flags: SET);
  1504. VAR hdr {UNTRACED}: Heaps.ProtRecBlock; r, c, t: Process; id, maxWaitingPrio, prevMaxWaitingPrio: LONGINT;
  1505. BEGIN
  1506. IF Stats THEN Machine.AtomicInc(Nawait) END;
  1507. IF 1 IN flags THEN (* compiler did not generate IF *)
  1508. IF Stats THEN Machine.AtomicInc(NawaitNoIF) END;
  1509. IF cond(slink) THEN
  1510. IF Stats THEN Machine.AtomicInc(NawaitTrue) END;
  1511. RETURN (* condition already true *)
  1512. END
  1513. END;
  1514. SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
  1515. IF StrongChecks THEN
  1516. ASSERT(hdr IS Heaps.ProtRecBlock) (* protected object *)
  1517. END;
  1518. Machine.Acquire(Machine.Objects);
  1519. id := Machine.ID();
  1520. r := running[id];
  1521. ASSERT(r # NIL);
  1522. IF hdr.lockedBy = r THEN (* current process holds exclusive lock *)
  1523. IF StrongChecks THEN ASSERT(hdr.count = -1) END; (* exclusive locked *)
  1524. maxWaitingPrio := MaxPrio(hdr.waitingPriorities);
  1525. DEC(r.prioRequests[maxWaitingPrio]);
  1526. r.priority := MaxPrio(r.prioRequests);
  1527. IF hdr.awaitingCond.head # NIL THEN (* evaluate the waiting conditions *)
  1528. (* we are holding the lock, so the queue can not change (to do: except in TerminateThis) *)
  1529. c := FindCondition(hdr.awaitingCond) (* interrupts should be on during this call *)
  1530. ELSE
  1531. c := NIL
  1532. END;
  1533. IF c = NIL THEN
  1534. t := NIL;
  1535. GetMaxPrio(hdr.awaitingLock, t);
  1536. IF t = NIL THEN (* none waiting - remove lock *)
  1537. hdr.count := 0; hdr.lockedBy := NIL;
  1538. ELSE (* transfer lock to first waiting process *)
  1539. IF StrongChecks THEN ASSERT(t.mode = AwaitingLock) END;
  1540. TransferLock(hdr, t);
  1541. END;
  1542. ELSE (* true condition found, transfer the lock *)
  1543. TransferLock(hdr, c);
  1544. t := NIL;
  1545. END;
  1546. ELSE (* no lock, or some other process may hold the lock, but that's the user's indaba (may be monotonic condition) *)
  1547. Machine.Release(Machine.Objects);
  1548. HALT(2204) (* await must be exclusive region *)
  1549. END;
  1550. IF c # NIL THEN Enter(c) END;
  1551. IF t # NIL THEN Enter(t) END;
  1552. IF StrongChecks THEN ASSERT(r.waitingOn = NIL) END;
  1553. r.condition := cond; r.condFP := slink;
  1554. r.waitingOn := obj; r.mode := AwaitingCond;
  1555. IF hdr.lockedBy # NIL THEN
  1556. prevMaxWaitingPrio := MaxPrio(hdr.waitingPriorities);
  1557. INC(hdr.waitingPriorities[r.priority]);
  1558. IF r.priority > prevMaxWaitingPrio THEN PropagatePrio(hdr, prevMaxWaitingPrio, r.priority) END;
  1559. ELSE (* it may happen that hdr is not locked - in that case no priority propagation takes place *)
  1560. INC(hdr.waitingPriorities[r.priority])
  1561. END;
  1562. Put(hdr.awaitingCond, r);
  1563. (* reschedule *)
  1564. SwitchToNew;
  1565. IF StrongChecks THEN
  1566. ASSERT(cond(slink));
  1567. ASSERT(hdr.lockedBy = r) (* lock held again *)
  1568. END
  1569. END AwaitPriorityInv;
  1570. (** Update the state snapshot of the current process for GC. (for Processors) *)
  1571. PROCEDURE UpdateState;
  1572. VAR t: Process;
  1573. BEGIN (* interrupts off *)
  1574. Machine.Acquire(Machine.Objects);
  1575. t := running[Machine.ID ()];
  1576. ASSERT(t # NIL);
  1577. IF t # NIL THEN
  1578. t.state.PC := Machine.CurrentPC(); (* ug: required information for GC with meta data for stack inspection *)
  1579. t.state.SP := SYSTEM.GetStackPointer(); (* ug: not necessarily needed for GC *)
  1580. t.state.BP := SYSTEM.GetFramePointer(); (* ug: necessary information for GC with meta data for stack inspection *)
  1581. END;
  1582. Machine.Release(Machine.Objects)
  1583. END UpdateState;
  1584. (** Start executing user processes. Every processor calls this during initialization. *)
  1585. PROCEDURE Start*;
  1586. VAR id, ignored: LONGINT; idle: Idle; new: Process;
  1587. BEGIN (* running at kernel level (not preemptable) *)
  1588. ignored := Machine.AcquirePreemption();
  1589. id := Machine.ID (); (* preemption not enabled yet, because we are running at kernel level *)
  1590. NEW(idle); (* create process with MinPriority *)
  1591. Machine.Acquire(Machine.Objects);
  1592. Get(ready.q[MinPriority], new); (* can not use Select here, as it might return a preempted process *)
  1593. ASSERT(~(Preempted IN new.flags)); (* will at least get the Idle process just created *)
  1594. Machine.Release(Machine.Objects);
  1595. running[id] := new; (* schedule new process *)
  1596. perfTsc[id] := Machine.GetTimer();
  1597. new.mode := Running; new.procID := id;
  1598. Machine.FPURestoreMin(new.sse);
  1599. Machine.ReleasePreemption;
  1600. Machine.JumpToUserLevel(new.state.BP);
  1601. HALT(100); (* does never return here *)
  1602. END Start;
  1603. (* Initialize module. *)
  1604. PROCEDURE Init; (* can not use NEW *)
  1605. VAR
  1606. i: LONGINT;
  1607. BEGIN
  1608. ProcessorHLT := NIL;
  1609. maxReady := High; (* scan all queues at start *)
  1610. lowestAllowedPriority := Low; (* normal case, will be set to GCPriority if GC is running *)
  1611. gcBarrier := {};
  1612. FOR i := 0 TO Machine.MaxCPU - 1 DO running[i] := NIL END;
  1613. FOR i := 0 TO NumPriorities - 1 DO rootedProcesses[i] := NIL END;
  1614. FOR i := 0 TO NumIRQ-1 DO processingIRQ[i] := FALSE END;
  1615. nextProcessID := 0; Machine.ticks := 0;
  1616. traceProcess := NIL;
  1617. terminate := Terminate;
  1618. trap[0] := Halt;
  1619. trap[1] := HaltUnbreakable;
  1620. trapReturn[0] := HaltReturn;
  1621. trapReturn[1] := HaltUnbreakableReturn;
  1622. END Init;
  1623. PROCEDURE InitEventHandling;
  1624. VAR i: LONGINT; clock: Clock; (* realtimeClock: RealtimeClock; *)
  1625. BEGIN
  1626. FOR i := 0 TO NumIRQ-1 DO
  1627. interrupt[i].root := NIL; interrupt[i].process := NIL
  1628. END;
  1629. (* create normal event list *)
  1630. NEW(event); event.next := event; event.prev := event;
  1631. event.trigger := Machine.ticks + MAX(LONGINT) DIV 2;
  1632. (* create normal timer processes *)
  1633. timer := NIL; NEW(clock);
  1634. END InitEventHandling;
  1635. PROCEDURE InitGCHandling;
  1636. VAR finalizerCaller: FinalizerCaller;
  1637. BEGIN
  1638. gcProcess := NIL; NEW(gcActivity);
  1639. finalizerProcess := NIL; NEW(finalizerCaller);
  1640. END InitGCHandling;
  1641. PROCEDURE InitStats;
  1642. BEGIN
  1643. Nlock := 0; Nunlock := 0; Nawait := 0; NawaitNoIF := 0; NawaitTrue := 0;
  1644. Ncreate := 0; Nterminate := 0; Ncondition := 0; Ncondition1True := 0;
  1645. Ncondition2 := 0; Ncondition2True := 0;
  1646. Ntimeslice := 0; NtimesliceTaken := 0; NtimesliceNothing := 0;
  1647. NtimesliceIdle := 0; NtimesliceKernel := 0; NtimesliceV86 := 0; NtimesliceCritical := 0;
  1648. Npreempt := 0; NpreemptTaken := 0; NpreemptNothing := 0;
  1649. NpreemptKernel := 0; NpreemptV86 := 0; NpreemptCritical := 0;
  1650. Nenter := 0;
  1651. END InitStats;
  1652. PROCEDURE GCStatusFactory(): Heaps.GCStatus;
  1653. VAR gcStatusExt : GCStatusExt;
  1654. BEGIN
  1655. ASSERT(Heaps.gcStatus = NIL);
  1656. NEW(gcStatusExt);
  1657. RETURN gcStatusExt
  1658. END GCStatusFactory;
  1659. (** Return current user stack *)
  1660. PROCEDURE GetCurrentStack(VAR stack: Machine.Stack);
  1661. BEGIN
  1662. stack := running[Machine.ID()].stack;
  1663. END GetCurrentStack;
  1664. PROCEDURE InitPrioRequest;
  1665. VAR
  1666. i: LONGINT;
  1667. BEGIN
  1668. FOR i := 0 TO LEN(init.prioRequests) - 1 DO init.prioRequests[i] := 0 END;
  1669. END InitPrioRequest;
  1670. VAR
  1671. (* for compatibility and later extension *)
  1672. TraceProcessHook*: PROCEDURE (prcoess: Process; pc, bp: ADDRESS; stacklow, stackhigh: ADDRESS);
  1673. BEGIN
  1674. IF Stats THEN InitStats; END;
  1675. Init;
  1676. (* initialize memory management *)
  1677. Machine.UpdateState; (* for gc *)
  1678. Machine.getStack := GetCurrentStack;
  1679. Heaps.CollectGarbage(Modules.root); (* still in single-processor mode *)
  1680. (* now NEW can be used *)
  1681. NEW(ready); (* create the ready queues *)
  1682. Machine.InitInterrupts;
  1683. (*Machine.Start; initialize interrupts *)
  1684. InitEventHandling;
  1685. InitGCHandling;
  1686. Heaps.gcStatus := GCStatusFactory();
  1687. (* create a process for rest of init code, which runs at user level *)
  1688. entry := SYSTEM.GetFramePointer ();
  1689. SYSTEM.GET (entry+AddressSize, entry); (* return address into linker-generated call table *)
  1690. NEW(initObject);
  1691. NewProcess(SYSTEM.VAL (Body, entry-ReturnStackDisplacement), {Resistant}, initObject, init); (* create init process *)
  1692. init.priority := High;
  1693. init.staticPriority := init.priority;
  1694. (* initialize prioRequests for init process *)
  1695. InitPrioRequest;
  1696. INC(init.prioRequests[init.priority]);
  1697. Machine.Acquire(Machine.Objects);
  1698. init.id := -1; Enter(init); init := NIL;
  1699. Machine.Release(Machine.Objects);
  1700. Start (* start it *)
  1701. (* linker call table will end with a call to Terminate. So after executing all module bodies,
  1702. the init process will terminate and other processes created during init will continue running. *)
  1703. END Objects.
  1704. (*
  1705. 24.03.1998 pjm Started
  1706. 06.05.1998 pjm CreateProcess init process, page fault handler
  1707. 06.08.1998 pjm Moved exception interrupt handling here for current process
  1708. 17.08.1998 pjm FindRoots method
  1709. 02.10.1998 pjm Idle process
  1710. 06.11.1998 pjm snapshot
  1711. 25.03.1999 pjm Scope removed
  1712. 28.05.1999 pjm EventHandler object
  1713. 01.06.1999 pjm Fixed InterruptProcess lock error
  1714. 16.06.1999 pjm Flat IRQ priority model to avoid GC deadlock
  1715. 23.06.1999 pjm Flat IRQ priority experiment failed, rather do STI in FieldIRQ to avoid GC deadlock
  1716. 29.06.1999 pjm Timeout in EventHandler object
  1717. 13.01.2000 pjm Overed (Interrupt Objects, Event Handlers, Process ID, Process state, Process mode, Process stack, Await)
  1718. 17.10.2000 pjm Priorities
  1719. 22.10.2003 mib SSE2 extension
  1720. 24.10.2003 phk Priority inversion / cycle counters
  1721. 19.06.2007 ug Garbage Collector using meta data for stack inspection
  1722. *)
  1723. (*
  1724. Location Stack
  1725. Lock Current process
  1726. SwitchTo.A Current process
  1727. SwitchTo.B
  1728. *)