// 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)
]