!*********************
!* *
!* name server *
!* interface *
!* *
!*********************
include "deimosperm"
constrecord (*) name nil == 0
control 1
begin
conststring (7)vsn = "vsn006b"
recordformat nscallf(integer f, ( byteinteger flags, address, c
integer port, function code, string (55) newname orc
string (55) name) )
recordformat nsreplyf(integer return code,(byteinteger flags, address,c
integer port, function code, string (55) rest of name orc
string (55) myname) )
recordformat mef(record (mef) name link, byteinteger len, c
type, integer address,port,command,rport, c
(record (nsreplyf) nsreply orc
record (nscallf) nscall) )
recordformat pe(byteinteger ser, reply, fn, port,
(integer minport, maxport or
record (mef) name mes, byteinteger len, s1))
!transport service command codes
constinteger open=x'6a00'
constinteger sspreq=x'6c00'
constinteger openack=x'6500'
constinteger longblock=x'9000'
constinteger longblockch=x'9000'
constinteger longblockcs0=x'9400'
constinteger singleshot=x'9800'
! incoming function codes
! -------------------------
!he following values may be added to the output codes
constinteger release flag=x'80'; !release buffer at end of output
constinteger tell flag=x'40'; !notify at end of transfer
constinteger cs0flag=x'20'
constinteger command mask=x'1f'; !to get command code
constinteger enable port=0
constinteger xdata=1
constinteger ssout=2; !single shot output
constinteger xrdy=3
constinteger xnotrdy=4
constinteger xnodata=5
constinteger xclose=6
constinteger xreset=7
constinteger xclosereq=8
constinteger disable port=15
constinteger output trace=16; !force output of trace buffer
! outgoing function codes
! -----------------------
constinteger output done=0
constinteger transfer error=1
constinteger r input done=2
constinteger input error=3
constinteger ring down=4
!name server functions
!-----------------------
constinteger lookup=0
constinteger addname=1
constinteger removename=2
constinteger revlookup=3
constinteger ownname=4
ownbyteintegerarray portno(lookup:ownname)=1,5,6,2,4
constinteger request buffer = 0
constinteger release buffer = 1
!********** various service numbers *************
constinteger name ser=15
constinteger ring ser = 10
constinteger buffer manager = 17
constinteger time int = 0
constinteger t3 ser = 21
!************************************************************
ownrecord (pe) p
ownrecord (pe) name holdp
constinteger pqmax=31; !size of request queue
constinteger names reply=0
constinteger names fail=1
ownrecord (pe) array pq(0:pqmax)
owninteger pqn,pqs,pqe; !pqn=number of ps on queue
!pqs=index of queue start
!pqe=index of queue end
owninteger reply port,state,t,c,i; !state=idle or busy
!t counts clock ticks while busy
!c=repetion count
constinteger timeout=2
constinteger maxretries=3
constinteger idle=0
constinteger busy=1
constinteger minrport=256; !reply port limits
constinteger maxrport=511
routinespec from ring
routinespec from clock
routinespec from above
routinespec sendup(integer reply,fn,port)
routinespec freebuffer(record (mef) name buf)
routinespec start new
routinespec do transfer
routinespec finish req(integer f)
routinespec to ring(integer f)
routinespec swaba(integer a,integer l)
pqn=0; pqs=0; pqe=0; !init queue pointers
linkin(name ser)
i=map virt(buffer manager, 5, 4)
i=map virt(buffer manager, 6, 5)
state=idle
!plug into reply ports
p_minport=min rport
p_maxport=max rport
to ring(enable port)
reply port=min rport
alarm(50)
cycle
p_ser=0; poff(p)
if p_ser=own id start
if p_reply=ring ser start
from ring
else
from clock
finish
else
from above
finish
repeat
integerfn stoi(string (*) name s, integername err)
!-----------------------------------------------------
!set err non-zero if error found
integer n,c,i
if length(s)=0 then ->error
n=0
for i=1,1,length(s) cycle
c=charno(s, i)
if '0'<=c<='9' start
n=n*10+c-'0'
finishelse ->error
repeat
result =n
error:
err=1
result =0
end
routine from ring; !ignore all but input dones
switch incmd(lookup:ownname)
if p_fn=r input done start
if state=busy and p_mes_port=reply port andc
p_mes_address=x'f0' and (p_mes_command&x'ff00')= c
openack start ; !validate reply
->incmd(holdp_fn)
incmd(revlookup):
incmd(ownname):
if p_mes_len>2 start
swaba(addr(p_mes_nsreply_my name), p_mes_len-2)
p_mes_len=length(p_mes_nsreply_my name)
else
p_mes_len=0
length(p_mes_nsreply_my name)=0
finish
->fin req
incmd(add name):
incmd(remove name):
-> fin req
incmd(lookup):
if p_mes_len>5 start
swaba(addr(p_mes_nsreply_rest of name), p_mes_len-5)
else
length(p_mes_nsreply_rest of name)=0
finish
p_mes_len=length(p_mes_nsreply_rest of name)
fin req:
free buffer(holdp_mes); !free users buffer
finish req(names reply)
startnew
return
finish
freebuffer(p_mes); !ignore input
finish
end
routine from clock
if state=busy start
t=t+1
if t>timeout start
c=c+1
if c>maxretries start
free buffer(holdp_mes); !release users buffer
finish req(names fail)
start new; !if queue not empty
else
do transfer; !send it again
finish
finish
finish
alarm(50)
end
routine from above
if pqn>=pqmax or p_fn>own name start ; !queue full
free buffer(p_mes)
sendup(p_reply, names fail, p_port)
else
pq(pqs)=p
pqs=(pqs+1) & pqmax
pqn=pqn+1
finish
if state=idle then start new
end
routine send up(integer reply, fn, port)
p_ser=reply; p_reply=name ser
p_fn=fn
p_port=port
pon(p)
end
routine freebuffer(record (mef) name buf)
record (pe) p
p_ser=buffer manager
p_reply=own id
p_mes==buf
p_fn=release buffer
pon(p)
end
routine start new
record (mef) name buf
integer l,port,f, term, fac no, err
string (63) ad1, ad2
switch cmd(lookup:ownname)
restart:
if pqn>0 start
holdp==pq(pqe)
c=1
buf==holdp_mes
buf_address=x'f0'
buf_command=sspreq
buf_rport=reply port
buf_nscall_f=0
->cmd(holdp_fn)
cmd(lookup):
!see if name of form NnnTnn.Fnn
if buf_nscall_name -> ("N0T").ad1 and ad1 -> ad1.(".F").ad2 start
err = 0; !set by stoi if non-numeric string
term=stoi(ad1, err)
fac no=stoi(ad2, err)
if err = 0 start
buf_nsreply_return code = 0; !return code
buf_nsreply_flags = 0; ! not set at moment
buf_nsreply_address = term; !address
buf_nsreply_port=1; !default for bsp opens
buf_nsreply_function code=fac no
buf_nsreply_restofname=""
buf_len=0
p_mes==buf
finish req(names reply)
->restart; !avoid recursive call
finish
finish
cmd(remove name):
l=(length(buf_nscall_name)+2) >> 1
swaba(addr(buf_nscall_name), l)
-> send
cmd(add name):
l=(length(buf_nscall_newname) + 2) >> 1
swaba(addr(buf_nscall_newname), l)
l=l+3
->send
cmd(rev lookup):
l=1
->send
cmd(own name):
l=0
->send
send:
buf_len=l+2
buf_port=port no(holdp_fn)
do transfer
finish
end
routine do transfer
state=busy; t=0
p_mes==holdp_mes
to ring(xdata)
end
routine finish req(integer f)
!transfer finished-remove from
!queue and reply
state=idle
pqe=(pqe+1)&pqmax
pqn=pqn-1
reply port=reply port+1
if reply port>max rport then reply port=min rport
send up(holdp_reply, f, holdp_port)
end
routine to ring(integer f)
p_ser=ring ser; p_reply=own id
p_fn=f
pon(p)
end
routine swaba(integer address,integer count)
!------------------------------------
!%integer i
!swab the bytes in the count words addressed by addr
! %for i=1,1,count %cycle
! address=((address>>8) & 16_ff)+(address<<8)
! address==integer(addr(address)+2)
! %repeat
*=8_000321; !loop: swab (r1)+
*=8_005300; ! dec r0
*=8_003375; ! bgt loop
end
endofprogram