// IfsEventMgr.bcpl - Event Manager - RESIDENT // Copyright Xerox Corporation 1979, 1982 // Last modified July 25, 1982 2:10 PM by Taft get "Ifs.decl" external [ // outgoing procedures EventMgr; QueueEvent; CreateEvent; DestroyEvent // incoming procedures Dequeue; Unqueue; InsertAfter; SysAllocate; SysFree SetTimer; TimerHasExpired; Block // outgoing statics eventState // incoming statics ] static @eventState structure EventState: [ queue: [ head word; tail word ] active word ] //---------------------------------------------------------------------------- let EventMgr() be //---------------------------------------------------------------------------- // Event manager process. Assumes queue is never empty. [ // repeat Block() repeatuntil TimerHasExpired(lv (eventState>>EventState.queue.head)>>ECB.timer) eventState>>EventState.active = true let ecb = Dequeue(lv eventState>>EventState.queue) ecb>>ECB.proc(ecb) eventState>>EventState.active = false ] repeat //---------------------------------------------------------------------------- and QueueEvent(ecb, delta; numargs na) be //---------------------------------------------------------------------------- [ if na gr 1 then SetTimer(lv ecb>>ECB.timer, delta) let necb = lv eventState>>EventState.queue.head [ // repeat if necb>>ECB.link eq 0 % necb>>ECB.link>>ECB.timer-ecb>>ECB.timer gr 0 break necb = necb>>ECB.link ] repeat InsertAfter(lv eventState>>EventState.queue, necb, ecb) ] //---------------------------------------------------------------------------- and CreateEvent(Proc, delta; numargs na) = valof //---------------------------------------------------------------------------- [ let ecb = SysAllocate(lenECB) ecb>>ECB.proc = Proc QueueEvent(ecb, (na gr 1) & delta) // = (na gr 1? delta, 0) resultis ecb ] //---------------------------------------------------------------------------- and DestroyEvent(ecb) be //---------------------------------------------------------------------------- [ Block() repeatwhile eventState>>EventState.active Unqueue(lv eventState>>EventState.queue, ecb) SysFree(ecb) ]