// Copyright Xerox Corporation 1979
external [ InitializeContext; CallContextList; Block
SerialNumber; Ws; Wns; Gets; Endofs; keys; dsp
InitializeZone; Allocate]
manifest RTC=#430
manifest EPLoc=#600
manifest EICLoc=#604
manifest EIPLoc=#605
manifest ESLoc=#610
manifest SIO=#61004
static [ CtxZn; CtxHead; NumTimeProcs=0 ]
let main() be
[
let z=vec 10000; CtxZn=z // Zone to allocate contexts from
InitializeZone(CtxZn,10000)
let s1=vec 200
let s2=vec 200
CtxHead=InitializeContext(s1, 200, CommandProc)
let next=InitializeContext(s2, 200, EtherProc)
@CtxHead=next
CallContextList(CtxHead) repeat
]
and CommandProc() be
[
Ws("*n**")
while Endofs(keys) do Block() // Block until user types something
let Char=Gets(keys)
switchon Char into
[
case $S: case $s:
[
Ws("*nStart another TimeProc")
let region=Allocate(CtxZn,200) // Create new context
let ctx=InitializeContext(region,200,TimeProc,1)
NumTimeProcs=NumTimeProcs+1
ctx!3=NumTimeProcs // Parameter for this instance of TimeProc
ctx!0=CtxHead; CtxHead=ctx // Link into context list
endcase
]
case $Q: case $q: [ Ws("Quit"); finish]
default: Ws("?")
]
] repeat
and TimeProc(Ctx) be
[
let interval=Ctx!3 // Get interval from context
let f=@RTC+27*interval // That many seconds from now
until (@RTC-f) gr 0 do Block()
Wns(dsp,interval) // Type our interval
] repeat
and EtherProc() be
[
StartIO(3) //Reset Ether
@ESLoc=SerialNumber
let buf=vec 50
@EICLoc=50
@EIPLoc=buf
@EPLoc=0
StartIO(2) //Start input
until @EPLoc ne 0 do Block()
if (@EPLoc rshift 8) eq 0 then Ws("Message arrived")
] repeat
and StartIO(c) be (table [ SIO; #1401 ])(c)