!prep options :-
!
! k - kent
! n - nsi
! r - ring
! x - transport service
!
#if (k & n) ! (n & r) ! (n & x) ! (x & r) ! ~(r ! x ! n)
#report Incompatible options
#abort
#fi
! file 'fep_rjes10s'
#if k
conststring (21) vsn= "rjes:vsn0n10a (kent) "
#else
conststring (14) vsn= "rjes:vsn0n10a "
#fi
#datestring
!********************************
!* emas-2900 fep rje server *
!* file: rjes10s/rjes10y *
!* date: 9.Mar.83 *
!********************************
control 1
include "deimosperm"
begin
recordformat am1f(integer rxs, rxd, txs, txd)
ownrecord (am1f) name l == 1; ! supplied by am1 handler
#if x
recordformat lev3f(bytearray reserved(0:7),
#if k
(byteinteger uflag,
#else
(integer uflag,
#fi
bytearray a(0:239) ))
#fi
#if n
recordformat lev3f(byteinteger fn, sufl, st, ss, (byte sn, dn, dt, ds, xflag, ufl, (byteintegerarray aa(0:238) or c
integer x1, x2, users, state, cpu, pkts, sbr, byt, rjeo, rjei) orbyte flag, uflag, byteintegerarray a(0:239)))
#fi
#if r
#if k
recordformat lev3f(integer sou,ds,rc,tc, c
(byteinteger uflag, bytearray a(0:241) or c
integer x1, (integer x3, x4, users, state, cpu, c
pkts, sbr, byt, rjeo, rjei or c
bytearray aa(0:240))))
#else
recordformat lev3f(integer sou,ds,rc,tc, c
(integer uflag, bytearray a(0:241) or c
integer ss, st, sn, (integer x3, x4, users, state, cpu, c
pkts, sbr, byt, rjeo, rjei or c
bytearray aa(0:240))))
#fi
#fi
#if x
recordformat mef(record (mef) name link, byteinteger len, type, (record (lev3f) lev3 orbytearray params(0:241)))
#else
recordformat mef(record (mef) name link, byteinteger len, type, record (lev3f) lev3)
#fi
recordformat m2900f(record (mef) name l, byteinteger len, type, integer stream, sub ident, p2a, p2b, p3a, p3b, p4a, p4b, c
p5a, p5b, p6a, p6b)
recordformat m2900bf(record (mef) name l, byteinteger len, type, integer stream, sub ident, byteintegerarray b(0:19))
#if n
recordformat maf(record (mef) name l, byteinteger mlen, mtype, byteintegerarray spacer(0:11), byteintegerarray a(0:240))
#fi
#if r ! x
recordformat maf(record (mef) name l, byteinteger mlen, mtype, byteintegerarray spacer(0:19), byteintegerarray a(0:240))
#fi
recordformat logf(record (mef) name l, byteinteger mlen, mtype, integer len, type, byteintegerarray m(0:242))
recordformat maof(record (mef) name l, byteinteger mlen, mtype,
#if ~x
byteintegerarray a(0:240))
#else
(byteintegerarray a(0:240) orc
integer len, type, string (240) address))
#fi
#if x
recordformat pe(byteinteger ser, reply, fn, s1, (record (mef) name mes, byteinteger gate port, task port or c
string (3) facility orbyte b1, b2, (integer str orbyte c1, c2)))
#else
recordformat pe(byteinteger ser, reply, fn, port,
(record (mef) name mes, byteinteger len, s1 orc
byteinteger b1, b2, (byteinteger c1,c2 or integer str)))
#fi
recordformat qf(record (mef) name e)
!********************************************************
!* formats of tables, ie stream descriptors, tcps etc *
!********************************************************
recordformat con desf(record (mef) name hold, c
#if k
integer unitcount, byteinteger unitsize, subunitcount,
#fi
#if x
string (15) called, calling,
#else
integer node, term,
#fi
integer index, stream, permit, o state, port, iso, kill, n, cpos,
count, nc, facility,
record (qf) inp q)
!************************************************************
#if x
include "tsbsp_tscodes"
#else
!* upper level (itp&rje) handler messages to gate
!************************************************************
constinteger enable facility= 1; ! enable the facility
constinteger disable facility= 2; ! the reverse
constinteger call reply= 3; ! reply to a 'call connect'
constinteger enable input= 4; ! allow a block to be read
constinteger put output= 5; ! send a block of output
constinteger close call= 6; ! terminate a call
constinteger abort call= 7; ! abort the call
constinteger open call= 8; ! open up a call
constinteger open message= 9; ! send a message
constinteger reject= 0; ! qualifier on above
!**********************************************************
!* messages from gate to upper level protocols
!**********************************************************
constinteger incoming call= 2
constinteger input recd= 3; ! block arrived from node
constinteger output transmitted= 4; ! prepared to accept more
constinteger call closed= 5; ! either end has closed down
constinteger call aborted= 6; ! other end has aborted
constinteger open call a= 7
constinteger open call b= 8; ! reply from remote
constinteger message r= 9; ! message rec'd
constinteger message reply= 10; ! message reply from gate
#fi
!**************************************************************
!* buffer manager calls (from and to) *
!**************************************************************
constinteger buffer here= 0
!********** to buffer manager ***********
constinteger request buffer= 0
constinteger release buffer= 1
!**************************************************************
!* calls to 2900 link handler *
!**************************************************************
constinteger send data= 0
constinteger low level control= 1
constinteger here i am= 2
constinteger return control= 3
!**************************************************************
!* replies from 2900 link handler *
!****************************************************************
constinteger interf addr= 0
constinteger do input= 1
constinteger do output= 2
constinteger message= 3
constinteger mainframe up= 4
constinteger mainframe down= 5
!****************************************************************
!********** various service numbers *************
constinteger gate ser= 16
constinteger buffer manager= 17
constinteger link handler= 18
constbyteintegername change out zero == k'160310'
constinteger t3 ser= 21
constinteger comm bit= k'1'
constinteger accept char= k'002'
constinteger acfy= k'010'; ! peter calls it rxfy
constinteger xopl= k'020'; ! x operable - latched
! %constinteger xop = k'040'; ! x operable
constinteger ready= k'200'
constinteger cr= 13
constinteger ff= 14
!***********************************************************
!* 2900 states *
!***********************************************************
owninteger host state= 0; ! holds 2900 state
constinteger down= 0
constinteger up= 1
!****************** comms control states ********************
constinteger unused= 0
constinteger disconnecting= 1
constinteger connecting= 2
constinteger suspending= 4; ! end of section or file
constinteger aborting= 5
constinteger enabling= 7
constinteger enabled= 8
!* s t a t e s
constinteger not alloc= -1
constinteger idle= 0
constinteger op ready= 1; ! applies to the connection
constinteger input ready= 1; ! input streams only
constinteger trying= 2; ! awaiting network reply
constinteger timing= 3; ! connection refused, waiting for clock
constinteger aborted= 4; ! 2900 has gone down
constinteger connect 1= 5; ! network connected, waiting for
! 2900 connect&enable
constinteger connected= 6; ! in file
constinteger enabld= 7; ! 2900 has started file
constinteger closing= 8; ! close has been sent to network
#if x
constinteger wt close= 9; !data has been pushed, waiting for close
#fi
!******************************************
!* reasons for waiting for a buffer *
!******************************************
constinteger last rje reason= 21
constinteger low level ip transfer= 22
constinteger low level op transfer= 23
constinteger get op block= 24
constinteger send abort= 25; ! ask emas to abort stream
constinteger do input connect= 27
constinteger transfer message= 28
constinteger connecting reply= 29
constinteger connecting reply failed= 30
#if x
constinteger send connect= 31
constinteger send push= 32
#fi
!**************************************************************
routinespec to gate(integer fn, record (mef) name mes, integer flag)
routinespec to 2900(integer fn, record (m2900f) name m2900)
routinespec get buffer(integer reason)
routinespec free buffer(record (mef) name mes)
routinespec who and state
routinespec tell
routinespec from gate
routinespec from 2900
routinespec do connect(integer tpye, record (mef) name mes)
record (con desf) mapspec get free des
routinespec flush file
routinespec from buffer manager(record (pe) name p)
integerfnspec allocate stream(record (con desf) name d, integer type)
routinespec tidy buffers
integerfnspec get weight
routinespec retrieve(record (con desf) name d)
routinespec do transfer message(record (maof) name mes)
routinespec reform message(record (maf) name m)
#if ~x
routinespec do repm(integer flag)
#fi
routinespec clear all streams
routinespec read from am1
routinespec write to am1
routinespec read message from am1
routinespec write message to am1
!! %permroutinespec push(%record (qf) %name q, %record (mef) %name e)
!! %permrecord (mef) %mapspec pop(%record (qf) %name q)
#if x
routinespec send input connect to 2900(record (maof) name m)
#fi
!******************************************************
record (pe) p
ownrecord (qf) mes q; ! Used to hold messages for 2900
owninteger con sub id reply= 1; ! picks up from actual mess
ownrecord (con desf) name d
ownrecord (con desf) name d4, d5
owninteger own term= 0; ! distinguish between 2972 & 2980
#if k
constinteger con lim= 50; ! number of active terminals (see fixed top)
#else
constinteger con lim= 90; ! number of active terminals (see fixed top)
#fi
ownrecord (con desf) array con desa(0:con lim)
ownrecord (qf) name free des; ! pts to list of free con desa
owninteger no free des= con lim
record (qf) name q frig
constinteger max ports= 50
#if ~x
ownbyteintegerarray porta(0:max ports)
#fi
! cross index from port to tcp
constinteger fixed= 258; ! 1st available stream
constinteger fixed top= 350; ! number of 2900 streams in eam5
! was 281 !
ownbyteintegerarray am1a(fixed:fixed top)= k'377'(*)
ownbyteintegerarray alloc(fixed:fixed top)
!* * * * * * * * * * * * * * * * * *
constbyteintegerarray facil(0:14)=
0, 6, 0, 7, 0, 20, 4, 8, 0, 9, 13, 0, 0, 0, 9
!device number/facility codes
! spoolr no. facility code document type
! 0 0
! 1 6 pp no
! 2 0 pr yes
! 3 7 cp no
! 4 0 cr yes
! 5 20 mt no
! 6 4 lp no
! 7 8 gp no
! 8 0 op no
! 9 9 mp no
! 10 13 do yes
! 11 0 no
! 12 0 ct no
! 13 0 su no
! 14 9 fe yes
! 15 0 no
ownrecord (qf) name buffer pool; ! =k'142472'
owninteger no of buff= 0
owninteger mon= 0; ! monitoring flag
owninteger wt= 0; ! additional 'route' weight
owninteger port= 0; ! current port no ?
constintegername users == k'100014'; ! no of users in buffer seg
constintegername cpu == k'100012'; ! idle cpu count
constintegername pkts == k'100010'; ! packet count
constintegername sbr == k'100006'; ! no of sbrs
constintegername byt == k'100004'; ! no of bytes
owninteger rjei= 0; ! no of rje packets
owninteger rjeo= 0
! l o g g i n g o n
owninteger m1, m2, m3, m4, m5; ! $$ buffer monitoring
integer i
#if x
conststring (3) array sfacil(0:15)=
".??", ".pp", ".pr", ".cp", ".cr", ".mt", ".lp", ".gp",
".op", ".mp", ".do", ".??", ".ct", ".su", ".fe", ".??"
!convert spoolr device code to string which is appended to address string
!to give the name looked up
#else
conststring (3) array sfacil(0:20)=
"??", "di", "??"(2), "lp", "??", "pp", "??", "gp",
"mp", "??"(2), "cr", "do", "??"(6), "mt"
#fi
#if x
conststring (7) array ostates(-1:9)= "not all",
"waiting", "ready", "asking", "timing", "abortng",
"chcking", "conning", "going", "close", "wt clse"
#else
conststring (7) array ostates(-1:8)= "not all",
"waiting", "ready", "asking", "timing", "abortng",
"chcking", "conning", "going", "close"
#fi
#if x
constinteger fac max= 8
conststring (3) array fac(1:fac max)=
"CR", "MES", "INF", "LOG", "PR", "DI", "CR1", "CR2"
#else
constbyteintegerarray ef(1:8)= 1, 2, 10, 11, 12, 13, 21, 4
#fi
! gate facility nos
#if n
constinteger header len= 6, message header = 10
#fi
#if r ! x
#if k
constinteger header len= 1, message header = 0; ! ??
#else
constinteger header len = 2, message header = 0; ! ??
#fi
#fi
#if n
constinteger clock time= 100; ! nsi - 2 secs
#fi
#if r ! x
constinteger clock time= 500; ! ring - 10 secs
#fi
#if n
constinteger iso flag= 5, binary flag = 1
#fi
#if r ! x
#if k
constinteger iso flag= x'5', binary flag = x'1'
#else
constinteger iso flag = x'0500', binary flag = x'0100'
#fi
#fi
ownstring (1) snil=""
ownstring (4) me="RJES"
#if k
!table of name/address to convert sendmessage destinations (ring addresses)
!into machine names
constinteger maxnames=10
ownstring (3) array ring addr(1:maxnames)="T45","T57","T27",
"T15","T71","T54","T43","T30","T39","T46"
ownstring (7) array ring name(1:maxnames)="EAGLE","COMET","DEVSYS",
"EMASFEP","BOOK","GATE","SGATE","TCPA","TCPB","TCPC"
#fi
!**********************************************
!* initialisation *
!**********************************************
change out zero = t3 ser
cycle i = con lim, -1, 2
con desa(i)_index = i; con desa(i)_o state = not alloc
qfrig == con desa(i)
qfrig_e == free des
free des == qfrig
repeat
con desa(1)_index = 1
condesa(0)_stream = 4
con desa(1)_stream = 5
#if ~k
p_ser = 0; poff(p); ! wait for instructions
own term = p_fn; ! 2980 or 2972 ?
if own term=80 then wt = 40; ! weight at 40 for 2980
if own term#80 and own term#72 then wt = 90; ! not allowed thru
#fi
printstring(vsn.datestring); newline
map hwr(0); ! map am1 to segment 0 !!!!
i = map virt(buffer manager, 5, 4); ! i = map buff man stack to seg 4
i = map virt(buffer manager, 6, 5)
d == con desa(0)
d4 == d
d5 == con desa(1)
p_str = 4; ! param for 'here i am'
to 2900(here i am, null)
p_str = 5
to 2900(here i am, null)
#if x
for i = 1, 1, fac max cycle
p_ser = gate ser; p_reply = own id
p_fn = enable facility; p_s1 = 0
p_facility = fac(i)
pon(p)
repeat
#else
to gate(enable facility, null, ef(i)) for i = 1, 1, 8
#fi
alarm(clock time); ! set clock for 2 secs
!**********************************************
!* main loop *
!**********************************************
cycle
p_ser = 0; poff(p)
if 'M'<=int<='P' start
mon = int-'O'; int = 0
finish
if '0'<=int<='9' start
wt = (int-'0')*10; int = 0
finish
if int='?' start
printstring("Current wt ="); write(get weight, 1); newline
cycle i = 2, 1, con lim
d == con desa(i)
if d_o state#not alloc start
printstring("rje:")
who and state
printstring("p ="); write(d_port, 1)
printstring(", c ="); write(d_nc, 1)
newline
finish
repeat
int = 0
newline
finish
if p_reply=link handler start
from 2900
finishelseif p_reply=gate ser start
from gate
finishelseif p_reply=buffer manager start
from buffer manager(p)
finishelseif p_reply=0 start ; ! clock tick
cycle i = con lim, -1, 0
d == con desa(i)
#if x
if d_o state=timing then get buffer(send connect) and d_o state = trying
#else
if d_o state=timing then do connect(open call, null)
#fi
repeat
alarm(clock time)
finish
repeat
!*************************************************
!* routines to do the work *
!*************************************************
routine crunch
integer i
who and state; newline
cycle i = 1, 1, 10
printstring("**** rjes failed - dump it ***
")
repeat
wait
end
routine to gate(integer fn, record (mef) name mes, integer flag)
if fn=put output start ; ! queue these as necessary
rjeo = rjeo+1
if addr(mes)&k'140000'=k'140000' or addr(mes)&k'77'#0 then crunch
finish
p_ser = gate ser; p_reply = own id
#if x
p_task port = d_index; p_gate port = d_port
#else
p_port = d_port
#fi
p_fn = fn; p_mes == mes; p_s1 = flag
pon(p)
end
routine to 2900(integer fn, record (m2900f) name m2900)
p_ser = link handler; p_reply = own id
p_fn = fn; p_mes == m2900
pon(p)
end
routine get buffer(integer reason)
record (pe) p
!*******************************************************
!* hold a pool, so can call buffer here immedialtely*
!* otherwise hold the activity until it arrives*
!*******************************************************
#if x
if reason=get op block then p_c1 = 0 else p_c1 = 1
p_c2 = reason; p_s1 = d_index
#else
if reason=get op block then p_len = 0 else p_len = 1
p_s1 = reason; p_port = d_index
#fi
! ****** watch the above line ********
if buffer pool==null or reason#get op block start ; ! have to ask for it
p_ser = buffer manager; p_reply = own id
p_fn = request buffer
pon(p)
else
p_mes == buffer pool; buffer pool == p_mes_link
p_mes_link == null
no of buff = noof buff-1; from buffer manager(p)
finish
end
routine free buffer(record (mef) name mes)
record (pe) p
if addr(mes)&k'140000'=k'140000' or addr(mes)&k'77'#0 then crunch
if mes_type#0 or no of buff>3 start
p_ser = buffer manager; p_reply = own id
!! queue it if it is a long buffer
p_fn = release buffer; p_mes == mes
pon(p)
else
!! long buffer, so queue it
mes_link == buffer pool; buffer pool == mes
no of buff = no of buff+1
finish
end
!!
routine tell
!! monitoring routine
#if x
printstring(d_called); spaces(10-length(d_called))
printstring(d_calling); spaces(10-length(d_calling))
#else
integer n
#if k
n = d_facility & 31; !device no in top 3 bits
#else
n = d_facility
#fi
if d_stream&1=0 and n=13 then n = 1; ! input
printstring(sfacil(n))
#if k
printsymbol((d_facility >> 5) +'0'); !device no
#fi
write(d_term, 1)
space
#fi
end
routine who and state
tell
printsymbol('(')
printstring(ostates(d_o state))
printstring(") ")
end
routine report error(integer n)
who and state; printstring(" error "); write(n, 1); newline
end
#if x
integerfn pposition(record (mef) name mes, integer i)
!--------------------------------------------------------
integer n
n = 0; !return position of i'th param in mes
while i > 1 cycle
n = n+mes_params(n)+1
i = i-1
repeat
result = n
end
routine unpack(string (*) name s, record (mef) name mes, integer i, maxlen)
!--------------------------------------------------------------------
!unpack the i'th string from mes into s making sure it's not longer than maxlen
string (*) name source
integer len
source == string(addr(mes_params(pposition(mes, i))))
len = length(source)
if len>maxlen then length(source) = maxlen; !change length in situ
s = source; !copy the string
length(source) = len; !restore the length
end
routine pack(record (mef) name mes, string (*) name s)
! append s as ts parameter to mes
integer l
l = mes_len
string(addr(mes_params(l))) = s
mes_len = l+length(s)+1
end
routine mreply(string (*) name s, integer flag, record (mef) name m)
!-------------------------------------------------------------------------
m_len = 0
pack(m, me)
pack(m, s); !message text
to gate(datagram reply, m, flag)
end
routine send disconnect(string (*) name s, integer flag, record (mef) name mes)
!---------------------------------------------------------------
mes_len = 0
pack(mes, me)
pack(mes, s)
to gate(disconnect, mes, flag)
end
#else
routine plant fail(integer type, record (mef) name mes)
record (lev3f) name lev3
lev3 == mes_lev3
lev3_aa(0) = 1
lev3_aa(1) = type
mes_len = 12
end
#fi
#if x
#if k
routine convert(string (*) name calling)
!------------------------------------------
integer i
!convert calling ring address (Tnn) to name using fixed table
for i=1, 1, maxnames cycle
if calling=ring addr(i) then calling=ring name(i) andexit
repeat
end
#fi
routine from gate; !ts version
switch fns(connect:datagram reply)
integer fn, strm, l, i, flag, max, char
record (mef) name mes
string (15) called, calling
recordformat inff(integer users,state,cpu,pkts,sbr,byt,rjeo,rjei or
byteintegerarray byta(1:16))
record (inff) inf; !formatting data for info poll
ownstring (9) emas down mess="emas down"
ownstring (9) not known mess = "not known"
ownstring (16) device busy mess = "device busy"
ownstring (4) down mess = "down"
ownstring (22) no free rje ports mess = "no free rje ports"
string (63) explan
fn = p_fn
strm = p_task port
if (fn#connect) and (fn#datagram) start ; !check task port
if 0<=strm<=con lim start
d == con desa(strm)
else
printstring("rjes: illegal stream no.")
write(strm, 1); write(fn, 1); newline
return
finish
else
d == d4; !use if all else fails
d_port = p_gate port
finish
mes == p_mes
->fns(fn)
fns(connect):
if host state=down start
send disconnect(emas down mess, 19, p_mes)
return
finish
!check if device already known
unpack(called, mes, 1, 15)
unpack(calling, mes, 2, 15)
if mon<0 start
printstring("connect to ".called." from ".calling)
newline
finish
for i = 2, 1, con lim cycle
d == con desa(i)
if d_stream&1=0 and d_calling=calling and d_called=called start
if d_o state#input ready start
d == d4; !use this descriptor
send disconnect(device busy mess, 17, p_mes)
return
finish
mes_len=0
pack(mes, me);
pack(mes, snil)
d_port = p_gate port
to gate(accept call, mes, 0); !ok
get buffer(connecting reply); !accept connect
d_o state = connected
return
finish
repeat
!not known so allocate new descriptor
d == get free des; !new device
if d==null start
d == d4; !use this as the only available descriptor
send disconnect(no free rje ports mess, 17, mes)
return
finish
d_port = p_gate port
i = allocate stream(d, 0)
d_calling = calling
d_called = called
d_o state = connect1
d_nc = 0; d_iso = 0
if mon<0 start
tell; printstring("asking
")
finish
send input connect to 2900(mes)
return
fns(input here):
rjei = rjei+1
mes_lev3_reserved(0) = p_s1; !push flag
if d_inp q_e==null and d_hold==null and d_o state=enabld start
get buffer(low level ip transfer)
d_n = 0
finish
push(d_inp q, mes); !put buffer on queue
d_nc = d_nc+1
return
fns(enable output):
l = p_s1; !number of enables
if d_permit=0 and d_ostate=enabld then get buffer(get op block); !was waiting for network
d_permit = d_permit+l
return
fns(disconnect):
if mes == null start
explan = snil
else
unpack(explan, mes, 2, 63)
freebuffer(mes)
finish
flag = p_s1
if d_o state=trying start ; !connect failed
! %if flag#17 %and flag#23 %start; !not busy or network congestion
! get buffer(connecting reply); !pretend it's ok
! get buffer(send abort); !then kill it
! d_o state = idle
! tell
! printstring(" connect failed-"); printstring(explan); newline
! %else
if flag#17 start ; !not busy reply, give message now and again
if d_nc & 31 = 1 start ; !about 5 min intervals
tell
printstring(" connect failed (still trying)-")
printstring(explan); newline
finish
finish
d_nc = d_nc+1; d_port = flag
d_o state = timing
! %finish
return
finish
if d_o state#closing and d_o state#aborted then to gate(disconnect, null, 1); !acknowledge
if flag>1 and d_o state # wt close start ; !0 => ok, 1 => ack
who and state
printstring("Network abort-"); printstring(explan); newline
finish
if d_ostate=closing or d_o state=wt close start
unless d_hold==null then to 2900(low level control, d_hold); !reply to 2900 disconnect
d_o state = idle; d_hold == null
else
if d_o state=not alloc thenreturn ; !***************
if d_o state=connected or d_o state=enabld or d_ostate=input ready then get buffer(send abort)
if d_o state=aborted then retrieve(d) else d_o state = idle
finish
return
fns(accept call):
free buffer(mes)
if d_o state#aborted start
report error(7) andreturnunless d_o state=trying
if mon<0 start
tell; printstring("connected
")
finish
d_port = p_gate port
get buffer(connecting reply)
d_iso = 0; d_permit = 1
d_o state = connected
d_nc = 0
finish
return
fns(reset):; !can't do anything but disconnect
%if mes == null %start
explan = snil
%else
unpack(explan, mes, 2, 63)
free buffer(mes)
%finish
%if d_o state = closing %or d_o state = aborted %then %return
who and state
printstring("network reset-"); printstring(explan); printstring("-aborting")
newline
to gate(disconnect, null, 30)
%if d_o state = connected %or d_o state = enabld %or d_ostate = wt close %c
%then get buffer(send abort); !into 2900
d_o state = closing
%return
fns(datagram):
; !send message
unpack(called, mes, 1, 15)
unpack(calling,mes, 2, 15)
unpack(explan,mes,4,63)
%if called="INF" %start; !poll from info
{!build up reply, then copy into correct portion of explan string}
{!and send it back (there's a horrible overhead in string copying here}
{!and inside the ts driver)}
{ inf_users = users}
{ inf_state = host state}
{ inf_cpu = cpu; inf_pkts = pkts; inf_sbr = sbr}
{ inf_byt = byt; inf_rjeo = rjeo}
{ inf_rjei = rjei}
{!the first 6 bytes of explan are returned unchanged}
{!the copying is done in bytes because the integers all span words in explan}
{ %for i=1,1,16 %cycle}
{ charno(explan, 6+i)=inf_byta(i)}
{ %repeat}
{ length(explan)=22}
charno(explan, 5)=users
charno(explan, 7)=host state
length(explan)=8
mreply(explan, 0, mes)
return
finish
if called="LOG" start ; !logon/off
if host state=down start
mreply(down mess, 18, mes)
return
finish
mes_len = p_gate port; !remember it for the reply
push(mes q, mes)
get buffer(transfer message)
return
finish
if called="MES" start
#if k
convert(calling); !convert from address (Tnn) to name
#fi
printstring(calling); printsymbol(':')
unpack(explan, mes, 4, 63)
i = 1; !first char position
cycle
max = charno(explan, i)
if max=x'80' then i = i+1 and max = charno(explan, i)
i = i+1
while max>0 cycle
char = charno(explan, i)
printsymbol(char); i = i+1
max = max-1
repeat
newline unless char=nl
exitif i>=length(explan)
spaces(12)
repeat
mreply(snil, 0, mes)
return
finish
mreply(not known mess, 16, mes)
return
fns(datagram reply):
unless mes==null then free buffer(mes)
return
end
#else
routine from gate
record (mef) name mes
record (lev3f) name lev3
record (con des f) name d2
integer fn, flag, strm, max, i, ind, char, trm, fac, fl, node
switch fns(incoming call:message reply)
fn = p_fn
strm = p_port
d == con desa(porta(strm))
->fns(fn)
fns(incoming call):
flag = 0; ! reject if all else fails
!! There are two possible conditions,
!! 1) The specific device has already send in a file.
!! 2) the 2900 has to be asked to validate the device
if host state=down start
plant fail('D', p_mes)
->reply
finish
lev3 == p_mes_lev3
trm = p_s1; fl = p_c1; ! for/rev buffer limits
#if n
i = fl>>4
if i>2 then i = 2
fl = i<<4; ! limit to 2 forward
fac = lev3_ds
#fi
#if ~k
node = lev3_sn
#else
node = 0
#fi
#if r
fac = p_s1
#if k
trm = p_c1
#else
trm = lev3_st
if node = 0 then trm = p_c1; ! _c1 if from ring
#fi
#fi
cycle i = 2, 1, con lim
d == con desa(i)
if d_stream&1=0 and d_term=trm and fac=d_facility start ; ! Already known to FEP
if d_o state#input ready then plant fail('B', p_mes) and ->reply
get buffer(connecting reply); ! connect reply
d_o state = connected
#if n
flag = fl; ! accept the call
#fi
#if r
flag = 1
#fi
->connect port
finish
repeat
d == get free des
if d==null then plant fail('F', p_mes) and ->reply
! No free descriptors
!! construct a message to the 2900 *******
i = allocate stream(d, 0); ! even stream only
d_facility = fac; ! fixed at cr for now
d_node = node; d_term = trm
d_iso = fl; ! remember the flags word
d_o state = connect 1; ! wait for confirmation
d_nc = 0
if mon<0 start
tell; printstring("asking
")
finish
get buffer(do input connect)
connect port:
d_port = p_port; ! remember gate port no
porta(p_port) = d_index; ! backward mapping
returnif flag=0; ! Asking the 2900, so wait
reply:
do repm(flag)
return
fns(input recd):
rjei = rjei+1
mes == p_mes
if d_inp q_e==null and d_hold==null and d_o state=enabld start
!! stream is waiting for a network buffer
get buffer(low level ip transfer)
d_n = 0; ! into buffer pointer, and kick 2900
finish
push(d_inp q, mes); ! q buffer anyway
d_nc = d_nc+1; ! count it
return
fns(output transmitted):
d_permit = d_permit+1
if d_permit=1 and d_o state=enabld then get buffer(get op block)
return
fns(call closed):
returnif d_stream&1=0 and d_o state#closing
!! eof on input is handled by "write to am1"
!! on output is handled inside "call aborted"
fns(call aborted):
! all is lost
if d_o state=closing start
if mon#0 start
tell; printstring("close ack
")
finish
if host state=down then retrieve(d) andreturn
to 2900(low level control, d_hold)
d_o state = idle; d_hold == null
else
who and state
#if k
cycle i=1,1,10
printsymbol(7); !ring the bell for operators
repeat
#fi
printstring("network abort
")
if d_o state=not alloc thenreturn ; ! very nasty ***************
if d_o state>=connected or d_o state=input ready start
get buffer(send abort); ! get 2900 to abort stream
to gate(abort call, null, 0); ! reply to gate to clear port
finish
if d_ostate=aborted or host state=down then retrieve(d) else d_o state = idle
finish
return
fns(open call a):
! allocated port no
d == con desa(p_port)
!! p_port < 0 (ie failed!)
#if n
d_port = p_s1
#fi
#if r
d_port = p_b1
#fi
if d_port=0 then p_s1 = 125 elsestart
porta(d_port) = p_port
return
finish
!* d_port = 0 => no gate ports, so treat as a open call b
!* with error flag = 125
fns(open call b):
! reply from remote device
flag = p_s1; ! success/fail flag
if d_o state=aborted start
!! connection established ?
if flag#0 then retrieve(d) elsestart
to gate(abort call, null, 0)
d_nc = 98
finish
return
finish
report error(7) andreturnunless d_o state=trying
! problems with not-allocated
if flag#0 start
if d_nc=0 start
if mon<0 start
tell; printstring("connect failed"); write(flag, 1)
newline
finish
finish
#if k
if flag = 18 start ; !device u/s
get buffer(connecting reply); !pretend its ok
get buffer(send abort); !then kill it
d_ostate=idle
if host state=down then retrieve(d)
else
#else
if flag#0 start
#fi
d_nc = d_nc+1; d_port = flag; ! remember reason
d_o state = timing
finish
else
if mon#0 start
tell; printstring("connected
")
finish
get buffer(connecting reply); ! get buffer to reply to spoolr
d_permit = 1; d_iso = 0; ! set iso mode
d_o state = connected
d_nc = 0
finish
return
fns(message r):
! incoming login or enquiry
flag = 128; ! reply ok, unless ...
lev3 == p_mes_lev3
#if n
fac = lev3_ds
#fi
#if r
fac = p_s1
#fi
if fac=21 start ; ! poll from info
lev3_users = users; !$e - all of section $e
lev3_state = host state
lev3_cpu = cpu; lev3_pkts = pkts; lev3_sbr = sbr
lev3_byt = byt; lev3_rjeo = rjeo
lev3_rjei = rjei
p_mes_len = 22+message header-1; !$e - and above section
->repm2
finish
if fac>=10 start
->repm if fac=10
!! logon or oper message and 2900 is actually up
if host state=down start
flag = 0; plant fail('d', p_mes)
->repm
finish
push(mes q, p_mes); ! retain the message
#if n
lev3_sufl = p_port; ! remember the gate port
#fi
#if r
lev3_rc = p_port
#if k
lev3_sou=p_c1
#else
if lev3_sn = 0 then lev3_st = p_c1; ! set the source in correctly
#fi
#fi
get buffer(transfer message)
return ; ! Wait for the buffer
finish
i = 0
if mon#0 or fac=1 start
#if k
printstring(" t"); write(lev3_sou, 1)
#else
printstring(" t"); write(lev3_st, 1)
#fi
printsymbol(':')
cycle
max = lev3_aa(i)
if max=x'80' then max = lev3_aa(i+1) and i = i+1
i = i+1
while max>0 cycle
char = lev3_aa(i)
printsymbol(char); i = i+1; max = max-1
repeat
newline unless char=nl
exitif i>=p_mes_len-message header
spaces(12)
repeat
finish
repm:
p_mes_len = message header
repm2:
do repm(flag)
return
fns(message reply):
! reply to sendmessage
free buffer(p_mes) unless p_mes==null
! ignore, but free buffre if necessaay
end
#fi
!! r o u t i n e from 2900
!! all messages from the 2900 come to this routine
routine from 2900
record (m2900f) name m2900
record (m2900bf) name m2900b
record (mef) name mes
integer stream, sub ident, state, mode, am1c
#if k
integer unitsize
#fi
integer p2a, p2b, ioflag
switch link fns(interf addr:mainframe down)
switch com state(disconnecting:enabled)
switch com state b(disconnecting:enabled)
m2900 == p_mes; m2900b == m2900
if p_fn=message start
stream = m2900_stream; ! get first stream no
else
unless p_fn<message then ->link fns(p_fn)
stream = p_str
finish
am1c = am1a(stream)
if am1c=k'377' then d == null else d == con desa(am1c)
->link fns(p_fn)
link fns(interf addr):
! interface addr from eam5
l == record(addr(p_mes)&k'17777'); ! force to seg 0
return
link fns(do output):
! -> 11/34
if stream=5 then read message from am1 else read from am1
return
link fns(do input):
! -> 2900
if stream=4 then write message to am1 else write to am1
return
link fns(mainframe down):
link fns(mainframe up):
host state = down
clear all streams
return
link fns(message):
sub ident = m2900_sub ident
state = m2900b_b(1); mode = m2900b_b(0)&x'f0'
! mode = 0 - seq, 1 - circ, 2 - seq cont
! = x'10' - iso, x'20' - ebc, x'30' - bin
#if k
unitsize = m2900b_b(0)
! this is relevant only when connecting
! as the mode is meaningless at this point
#fi
p2a = m2900_p2a; p2b = m2900_p2b
m2900_p2a = 0; m2900_p2b = 0
if sub ident#0 start ; ! low level
!******************************************
!* l o w l e v e l control message
!******************************************
ioflag = stream&1; ! ioflag = 1 => 2900 o/p
if stream<=5 start
if stream=4 then d == d4 else d == d5
->com state b(state)
finish
if d==null start
printstring("rjes:no desc, kick =")
write(state, 1); newline
->control reply
finish
->com state(state)
com state(enabling):
report error(1) and ->control reply if d_o state=idle
report error(2) if d_o state#connected
d_o state = enabld
if mon<0 start
tell; printstring(" enabling
")
finish
if ioflag#0 start
if mode#d_iso then flush file; ! mode change
d_iso = mode
if d_permit>0 start
if d_hold==null start
get buffer(get op block)
else
do trans and reply:
to 2900(low level control, m2900)
get buffer(low level op transfer)
return
finish
finish
else
unless d_hold==null and d_inp q_e==null then ->do trans and reply
finish
->control reply
com state(connecting):
con sub id reply = m2900_sub ident; ! retain for reply
if mon#0 then tell and printstring("conn
")
if ioflag#0 start ; ! output
report error(3) if d_o state#idle
#if k
d_unitsize = unitsize
d_subunitcount = 0
d_unitcount = 0
#fi
#if x
do connect(connect, m2900); d_nc = 0
return
#else
do connect(open call, null); d_nc = 0
#fi
else ; ! input
if d_o state=connect 1 start
#if x
to gate(accept call, null, 0)
#else
p_port = d_port; ! for repm
#if n
do repm(d_iso)
#fi
#if r
do repm(1); ! ok
#fi
#fi
d_o state = connected
->control reply
finish
! its ready and waiting
d_o state = input ready
finish
free buffer(m2900); ! reply is made up later
return
com state(disconnecting):
if mon#0 start
tell; printstring("disc
")
finish
#if x
if d_o state=connected start
if ioflag#0 and d_kill=suspending start ; !end of transfer
flush file
get buffer(send push); !to close the stream
d_o state = wt close
else
to gate(disconnect, null, 42)
tidy buffers
d_o state = closing
finish
d_hold == m2900; !save reply till later
return
finish
report error(4) if d_o state#idle
->control reply
#else
report error(4) unless d_o state=connected or d_o state=idle
if d_o state#idle start
d_o state = closing
if ioflag#0 and d_kill=suspending start
flush file
mode = close call; ! for "to gate" call
else
mode = abort call; tidy buffers
finish
d_hold == m2900
to gate(mode, null, 0); ! reply to gate
return ; ! hold reply till later
finish
->control reply
#fi
com state(aborting):
if mon#0 start
tell; printstring("aborting
")
finish
->suspd
com state(suspending):
if mon<0 start
tell; printstring("susp
")
finish
suspd:
report error(5) unless d_o state=enabld or d_o state=idle
d_o state = connected unless d_o state=idle
d_kill = state; ! remember type of call
! stop transfers unless its idle anyway
#if k
m2900_p3b = swab(d_subunitcount)
m2900_p3a = swab(d_unitcount)
#fi
control reply:
to 2900(low level control, m2900)
return
!! ***********************************************
!! the following are all stream 4 & 5 manipulations
!! ************************************************
com state b(enabling):
d_o state = enabling
d_iso = p2b; ! bUFFER SIZE
host state = up
->junk m
com state b(connecting):
d_o state = connected
d_n = 0; d_nc = 0; d_count = 0; d_iso = 0; d_cpos = 0
printstring(" rje: logon stream"); write(stream, 1)
printstring(" connected
")
->junk m
com stateb(aborting):
com stateb(suspending):
com stateb(disconnecting):
d_o state = idle
host state = down
junk m:
tidy buffers
clear all streams
->control reply
finish
!! high level control message
d == d5
free buffer(m2900)
get buffer(get op block) if d_nc=d_count; ! dont do twice
d_nc = p2b; ! update pointer
end
routine do connect(integer type, record (mef) name mes)
ownstring (15) emas rje output mess = "emas rje output"
#if n
recordformat p3f(byteinteger ser, reply, fn, port, (byteinteger facility, flag or c
record (mef) name mes), byteinteger node, term)
#fi
#if r
recordformat p3f(byteinteger ser, reply, c
fn, port, (byteinteger node, flag or c
record (mef) name mes), byteinteger term, facility)
#fi
#if ~x
record (p3f) p3
p3_ser = gate ser; p3_reply = own id
p3_fn = type; p3_port = d_index
p3_node = d_node
p3_term = d_term
#if r
p3_facility = 2; ! for send messages
#fi
if type=open call start
#if n
p3_flag = x'40'
#fi
p3_facility = d_facility
d_o state = trying
finishelse p3_mes == mes
pon(p3)
#else
mes_len = 0
pack(mes, d_called)
pack(mes, me); !calling address
pack(mes, snil); !quality of service
pack(mes, emas rje output mess); !explanatory text
d_port = 0; !not assigned yet
to gate(type, mes, 0)
if type=connect then d_o state = trying
#fi
end
record (con des f) map get free des
qfrig == free des
if qfrig==null start
printstring("rjes: out of descriptors! ****
")
result == null
finish
free des == qfrig_e
qfrig_e == null
result == qfrig
end
routine flush file
integer block type, len
record (mef) name mes
mes == d_hold
unless mes==null start
d_hold == null
if d_n<=2 then free buffer(mes) elsestart
block type = iso flag; ! set iso mode
if d_iso#0 then block type = binary flag
len = d_n+header len
if d_n=d_cpos+2 then len = len-2
! 2 dummy length bytes present
mes_lev3_uflag = block type; mes_len = len; d_n = 0
d_permit = d_permit-1; ! for mode changing
to gate(put output, mes, 0)
finish
finish
end
!! r o u t i n e from buffer manager
!! all requests for buffers come back through here
#if ~x
routine form 2900 message(record (logf) name log)
!! this routine inserts the stream no, sub ident
!! network address into a message for stream 4
log_m len = 12
log_type = x'0300'; ! = swab(3)
log_len = x'0c00'; ! = swab(12)
log_m(0) = 2; log_m(1) = d_node; log_m(2) = d_term
log_m(5) = 0; log_m(6) = 1; log_m(7) = d_stream
log_m(8) = 0; log_m(9) = 0
end
#fi
routine kick 2900 message(record (logf) name log)
!! this routine sends 'log' to the 2900 by inserting
!! it in the input q for stream 4, and kicking it if
!! necessary
d == d4
if d_hold==null and d_inp q_e==null then get buffer(do output)
get buffer(do output) if d_cpos>5; ! nb compiler fault above
push(d_inp q, log)
d_cpos = d_cpos+1
end
#if x
routine send input connect to 2900(record (maof) name m)
!----------------------------------------------------------
integer l, n, devno, devtype
string (15) called
m_type = x'0300'
called = d_called
m_address = d_calling
l = length(called)
devno = 0
if '0'<=charno(called, l)<='9' start
devno = charno(called, l)-'0'; !e.g. LP0
length(called) = l-1; !remove digit at end
finish
if called="CR" then devtype = 4 elsestart
if called="LP" then devtype = 6 else devtype = 2
finish
n = (5+length(d_calling)+1)&x'fffe'; !4 bytes for len and type fields
!1 for string len and 1 for rounding
m_a(n) = devtype; m_a(n+1) = devno
m_a(n+2) = 1; m_a(n+3) = d_stream
m_a(n+4) = 0; m_a(n+5) = 0
m_mlen = n+4
m_len = swab(m_mlen)
kick 2900 message(m)
end
#fi
routine from buffer manager(record (pe) name p)
integer reason, n, type
#if k
integer devtype, devno; !facility number in 2 fields
#fi
record (m2900f) name m2900
record (mef) name mes
record (logf) name log
#if x
reason = p_c2
d == con desa(p_s1)
#else
reason = p_s1; ! get reason for calling
d == con desa(p_port); ! get console desxcriptor
#fi
if reason=get op block start
d_hold == p_mes; d_n = 0
get buffer(low level op transfer)
return
finish
if reason=transfer message start
do transfer message(p_mes)
return
finish
#if ~x
if reason=do input connect start
log == p_mes
form 2900 message(log)
#if k
devtype = d_facility & 31
devno = d_facility >> 5
if devtype = 12 then i = 4 elsestart
if devtype = 4 then i = 6 else c
i = 2; ! cr (12) = 4, pr(13) = 2
finish
#else
if d_facility=12 then i = 4 elsestart
if d_facility=4 then i = 6 else i = 2; ! cr (12) = 4, pr(13) = 2
finish
#fi
log_m(4) = i
#if k
log_m(5) = devno
#fi
kick 2900 message(log)
return
finish
#fi
#if x
if reason=send connect start
do connect(connect, p_mes)
return
finish
if reason = send push start
p_mes_len=0
d_permit = d_permit - 1
to gate(put output, p_mes, 1); !push null data to close the transfer
return
finish
#fi
!! message to 2900 reason
!! note: streams 4&5 also use this mechanism
m2900 == p_mes
m2900_stream = d_stream
m2900_sub ident = 10; m2900_p2a = 0; m2900_p2b = 0
type = low level control
if reason=send abort start
m2900_sub ident = 0
m2900_p3a = 0
m2900_p3b = 1
type = send data
finish
if reason=connecting reply then m2900_sub ident = con sub id reply
if reason=connecting reply failed start
m2900_sub ident = con sub id reply
m2900_p2b = x'0a00'; ! = swab(10)
finish
to 2900(type, m2900)
!! %finish
end
integerfn allocate stream(record (con desf) name d, integer type)
!! nb: type = 0, allocate even stream for input
!! type = 1, allocate odd stream for output(lp etc)
integer i
cycle i = fixed+type, 2, fixed top-2+type
if alloc(i)=0 start
alloc(i) = d_index
d_stream = i
p_str = i; ! claim the stream
to 2900(here i am, null)
am1a(i) = d_index
no free des = no free des-1
result = i
finish
repeat
result = 0
end
routine tidy buffers
free buffer(pop(d_inp q)) whilenot d_inp q_e==null
free buffer(d_hold) unless d_hold==null
d_hold == null
end
integerfn get weight
#if k
result = 100
#else
integer n
result = 1 if wt=90
n = 120-wt+no free des
if own term#80 then n = n-users
result = n
#fi
end
routine retrieve(record (con desf) name d)
!! sever link between 2900 and descriptor and
!! free the descriptor
if d_stream<=5 then crunch
am1a(d_stream) = k'377'; ! mark unused
tidy buffers
#if x
d_called = snil
d_calling = snil
#else
d_term = -1
#fi
d_o state = not alloc
alloc(d_stream) = 0
qfrig == d
qfrig_e == free des
free des == qfrig
no free des = no free des+1
end
routine do transfer message(record (maof) name m)
!! send operator message to the 2900
record (mef) name mes
record (lev3f) name lev3
integer i, n, x
mes == pop(mes q); ! get stored message
#if x
m_type = x'0100'
unpack(m_address, mes, 2, 15); !calling address
#if k
convert(m_address); !from address (Tnn) to name
#fi
x = (length(m_address)+6)&x'fffe'
!copy explan text (the datagram message) into the 2900 form
i = pposition(mes, 4)+1; !start of param 4 text in mes
n = mes_params(i)
if n>=128 then i = i+1 and n = mes_params(i); !2 byte length
if n>50 then n = 50; !only short buffer
mes_params(i) = n; !set length in buffer
string(addr(m_a(x))) = string(addr(mes_params(i))); !copy the string
x = (x+n+2)&x'fffe'; !aligned length
!x=length of address + len and type, n is the length
!of the text (+2 for len byte & rounding )
m_m len = x
m_len = swab(x)
d == d4; !use d4 for 'to gate' call
d_port = mes_len; !saved in here
mreply(snil, 0, mes)
kick 2900 message(m)
#else
lev3 == mes_lev3
form 2900 message(m)
n = 0
if lev3_aa(0)>=128 then n = n+1; ! 2 byte length
x = lev3_aa(n)
if x>50 then x = 50; ! give it a big buffer????
lev3_aa(n) = x; ! shorten length in buffer
cycle i = 0, 1, x
m_a(i+8) = lev3_aa(n+i)
repeat
i = (i+9+1)&x'fffe'; ! Allow for header and make even
m_a(1) = i; ! length of message
m_a(3) = 1; ! type = 1
#if k
m_a(5) = 0; m_a(6) = lev3_sou
#else
m_a(5) = lev3_sn; m_a(6) = lev3_st
#fi
m_m len = i; ! length again
kick 2900 message(m)
p_mes == mes
#if n
p_port = mes_lev3_sufl; ! restore gate port number
#fi
#if r
p_port = mes_lev3_rc
#fi
mes_len = message header; ! delete the text
do repm(128); ! reply to gate
#fi
end
routine reform message(record (maf) name m)
!! send 2900 message to rje operator
record (mef) name mes
#if x
string (63) text
string (15) called
#else
record (lev3f) name lev3
#fi
integer i, len, x, pt, npt, max
mes == m
#if x
called = string(addr(m_a(4)))
pt = (6+length(called))&x'fffe'
if m_a(pt)>63 then m_a(pt) = 63; !truncate message if too long
text = string(addr(m_a(pt)))
!pack info in network format
mes_len = 0
called = called.".SSP"
pack(mes, called)
pack(mes, snil)
pack(mes, snil)
npt = mes_len+2; !point to position of 4'th param
x = npt-1; !position of length of sub record
pt = 1; !string pointer
cycle
i = charno(text, pt); !next char
mes_params(npt) = i
if i=nl or pt=length(text) start ; !handle lines without nl
mes_params(x) = npt-x; !length of sub record
npt = npt+1; !leave hole for length of next sub rec
x = npt; !and remember where
exitif pt = length(text); !npt points to next unused byte
finish
pt = pt+1; npt = npt+1
repeat
len = npt-mes_len; !total length of param 4
mes_params(mes_len) = len-1; !string length
mes_len = mes_len+len
d_port = 0
to gate(datagram, mes, 0)
#else
lev3 == mes_lev3
#if n
lev3_ds = 2; ! facility = 2
#fi
lev3_aa(0) = 0; ! protect against zero data
max = m_a(8)+8; ! pick up length (strings later?)
x = 0; len = 0; pt = 9; npt = 1
cycle
i = m_a(pt)
lev3_aa(npt) = i
if i=nl start
lev3_aa(x) = npt-x
npt = npt+1; x = npt
finish
pt = pt+1; npt = npt+1
exitif pt>max
repeat
#if n
lev3_ufl = 5; ! set iso
#fi
#if r & ~k
lev3_sn = d_node
#fi
mes_len = npt-2+message header+1
do connect(open message, mes)
#fi
end
#if ~x
routine do repm(integer flag)
!! sends a 'call reply' to gate, nb: assumes p_port = port number
p_ser = gate ser; p_reply = own id
p_fn = call reply; p_s1 = flag
pon(p)
end
#fi
! c l e a r a l l s t r e a m s
routine clear all streams
!! used when emas goes down
integer i
switch sts(not alloc:closing)
cycle i = 2, 1, con lim
d == con desa(i)
->sts(d_o state)
sts(connect 1):
#if x
to gate(disconnect, null, 39)
#else
p_port = d_port
do repm(0); ! reply 'reject' to connect
#fi
sts(idle):
sts(op ready):
sts(timing):
retrieve(d)
continue
sts(connected):
sts(enabld):
#if x
sts(trying):
to gate(disconnect, null, 39)
#else
to gate(abort call, null, 0)
#fi
d_o state = aborted
continue
#if ~x
sts(trying):
#fi
sts(closing):
d_o state = aborted
continue
sts(aborted):
sts(not alloc):
repeat
end
routine read from am1
record (am1f) name l2
integer max ad, adr, adr2
record (mef) name mes
record (lev3f) name lev3
integer n, sym, cpos, t, stat
#if k
integer c
#fi
if d==null then mes == null else mes == d_hold
if mes==null start
printstring("rje: seq1!
")
t = 0!128; ->skip2
finish
lev3 == mes_lev3
!! (cater for partial block rec'd)
if d_n#0 start
n = d_n; cpos = d_cpos
else
n = 2; !! allow for 2 byte count
cpos = 0
finish
!! next section is in assembler in a file 'ercc14.rjeassm'
! acfy =10
! xopl =20
l2 == l
adr2 = addr(lev3_a(0)); ! lev3_a(0)
max ad = adr2+239
rep cycle:
adr = adr2+n; ! lev3_a(n)
!
*=k'016401'; *=k'10'; ! mov 10(r4),r1 ! r1 == lev3_a(n)
*=k'016403'; *=k'4'; ! mov 4(r4),r3 ! l2 = -4(r5)
*=k'011302' ; ! cycle: mov (r3),r2 ! stat=r2
*=k'032702'; *=k'000220'; ! bit #200+xopl,r2
*=k'001774' ; ! beq cycle ! nothing set, so wait
*=k'032702'; *=k'000020'; ! bit #xopl,r2 ! xopl set?
*=k'001051' ; ! bne xopdwn ! yes, so fail it
!
*=k'016300'; *=k'000002'; ! mov 2(r3),r0 ! sym=r0
*=k'032713'; *=k'000010'; ! bit #acfy,@r3 ! failed to read?
*=k'001405' ; ! beq y1 ! no, so carry on
*=k'016300'; *=k'000002'; ! mov 2(r3),r0 ! read it again
*=k'032713'; *=k'000010'; ! bit #acfy,@r3 ! failed again?
*=k'001031' ; ! bne parity ! yes, so fails
! y1:
*=k'006202' ; ! asr r2 ! get comm bit
*=k'103432' ; ! bcs commbt ! comm bit seen
*=k'110021' ; ! movb r0,(r1)+ ! lev3_a(n) = sym! n=n+1
*=k'020027'; *=k'000040'; ! cmp r0,#40 ! space?
*=k'002012' ; ! bge y3 ! greater than, so ok
*=k'020027'; *=k'000012'; ! cmp r0,#10. ! newline
*=k'001415' ; ! beq exit ! is lf
*=k'002406' ; ! blt y3 ! not in special char range
*=k'020027'; *=k'000015'; ! cmp r0,#13.
*=k'001411' ; ! beq exit
*=k'020027'; *=k'000014'; ! cmp r0,#12.
*=k'001406' ; ! beq exit ! form feed
*=k'020164'; *=k'6'; ! y3: cmp r1,6(r4) ! 239 chars?
*=k'103003' ; ! bhis exit ! yes, so exit
*=k'052713'; *=k'000002'; ! bis #2,(r3) ! accept char
*=k'000731' ; ! br cycle
!
! exit: ! etc
*=k'010164'; *=k'10'; ! mov r1,10(r4) ! restore 'adr'
->exit
! parity:
*=k'010164'; *=k'10'; ! mov r1,10(r4)
l1:
->parity
! commbt:
*=k'010164'; *=k'10'; ! mov r1,10(r4)
l3:
->comm bit
! xopdwn:
xopdwn:
t = 64; ->skip; ! send unsuccessfull
parity:
t = 3; ->skip
comm bit:
t = 2!128
skip:
n = adr-adr2; ! recomput n
d_n = n; d_cpos = cpos
lev3_a(cpos) = x'80'; lev3_a(cpos+1) = n-cpos-2
skip2:
p_c1 = t; ! long block+accept last
to 2900(return control, null)
return
exit:
n = adr-adr2; ! recompute n
lev3_a(cpos) = x'80'
lev3_a(cpos+1) = n-cpos-2
#if k
if d_unitsize#0 start
if d_facility=4 or d_facility=9 start ; ! lp or mp
c = lev3_a(n-1)
if c=k'12' start ; ! linefeed
d_subunitcount = d_subunitcount+1
if d_subunitcount>=d_unitsize thenstart
d_unitcount = d_unitcount+1
d_subunitcount = d_subunitcount-d_unitsize
finish
finishelsestart
if c=k'14' start ; ! formfeed
d_unitcount = d_unitcount+1
d_subunitcount = 0
finish
finish
finishelseif d_facility=6 start ; ! pp
c = d_subunitcount+(n-cpos-2)
while c>d_unitsize cycle
d_unitcount = d_unitcount+1
c = c-d_unitsize
repeat
d_subunitcount = c
finish
finish
#fi
if n<239-132 start
cpos = n; n = n+2
l_rxs = l_rxs!accept char; ! accept the last char
->rep cycle
finish
d_hold == null
p_c1 = 0!128; ! done+accept last
to 2900(return control, null)
d_n = 0
if d_iso=0 then lev3_uflag = iso flag else lev3_uflag = binary flag
!! iso = 0, flag=5 => iso, iso # 0 => binary
mes_len = n+header len
to gate(put output, mes, 0)
d_nc = d_nc+1
d_permit = d_permit-1
if d_permit>0 then get buffer(get op block)
end
routine write to am1
record (mef) name mes
record (lev3f) name lev3
integer n, max, char, end, gate reply, am1 reply, stat, f
ownstring (14) input finished mess = "input finished"
am1 reply = 0; ! "normal" reply
while d_o state=enabld cycle
mes == d_hold
if mes==null then mes == pop(d_inp q)
if mes==null thenexit
!! terminate with "normal" (shouldnt happen)
lev3 == mes_lev3
end = mes_len-header len
#if ~x
gate reply = enable input; ! allow next to gate
#fi
max = 0; f = 1; n = d_n; ! start of block - d_n = 0
if n#0 then max = d_count and f = 0; ! in block already
cycle
cycle
stat = l_rxs
if stat&xopl#0 start
am1 reply = 64
d_hold == mes; ! retain for retry
->am1 rep
finish
if stat&ready#0 start
!! l i m i t sent
am1 reply = 2; ! long block
d_n = n; d_count = max
d_hold == mes; ! retain for later
->am1 rep
finish
if l_txs&ready#0 thenexit
repeat
if max=0 start
#if x
if f=0 and d_called="CR" start
#else
if f=0 and d_facility=12 start
#fi
f = 1
l_txd = nl
continue
finish
max = lev3_a(n)
if max>127 start ; ! 2 byte length
max = lev3_a(n+1)
n = n+1
finish
n = n+1; ! in block
f = 0 unless max=0; ! nasty zero length
finish
if n>end start
#if n
if lev3_flag&128#0 start
#fi
#if r
if lev3_tc & 4 # 0 start ; ! e-o-f
#fi
#if x
if lev3_reserved(0)#0 start ; !pushed
#fi
am1 reply = 4; ! condition y
! on the end of file
#if x
send disconnect(input finished mess, 0, mes)
d_hold == null; d_n = 0
d_o state = closing
->am1 rep
#else
gate reply = close call
if mon#0 then tell and printstring("close received
")
d_o state = idle
#fi
finish
!! send go ahead
#if x
to gate(enable input, null, 1)
#else
to gate(gate reply, null, 0); ! enable input or close call
#fi
free buffer(mes)
d_hold == null; d_n = 0
if d_inp q_e==null then ->am1 rep
exit
finish
if max#0 start
l_txd = lev3_a(n); n = n+1; max = max-1
finishelse l_txd = nl
repeat
repeat
am1 rep:
p_c1 = am1 reply
to 2900(return control, null)
end
!! r e a d m e s s a g e f r o m a m 1
routine read message from am1
recordformat mf(integerarray x(0:7))
#if n
recordformat mt1(integer a, b, byteintegerarray c(0:11), record (mf) m)
#fi
#if r ! x
recordformat mt1(integer a, b, bytearray c(0:19), c
record (mf) m)
#fi
recordformat mt2(integer a, b, record (mf) m)
record (mef) name mes
record (lev3f) name lev3
record (logf) name log
record (maf) name m
integer n, flag, sym, cpos, count, t, stat, x
integer node, term, type, strm
record (mt1) name m1; record (mt2) name m2
record (m2900f) name m2900
#if x
string (3) facname
#fi
switch hlm(1:5)
d == d5; ! messages on stream 5
m == d_hold
if m==null start
printstring("rje: seq2!
")
t = 0!128; ->reply
finish
!! (cater for partial block rec'd)
n = d_n
if n=0 then d_cpos = 0
cycle
cycle
stat = l_rxs
exitif stat&(ready!xopl)#0
repeat
if stat&xopl#0 start ; ! xop gone down
t = 64; ->skip; ! send unsuccessfull
finish
sym = l_rxd; ! read the char
if l_rxs&acfy#0 start ; ! failed to read
sym = l_rxd; ! read it again
if l_rxs&acfy#0 start ; ! hard failure - parity
t = 3; ->skip
finish
finish
if stat&comm bit#0 start
t = 2!128
skip:
d_n = n
reply:
p_c1 = t; ! long block+accept last
to 2900(return control, null)
return
finish
if d_count=d_iso then d_count = -1
if d_count=d_nc start
printstring("***rjes: message overrun -")
printstring(" all rje messages lost
")
->reply
finish
d_count = d_count+1
m_a(n) = sym; n = n+1
if n=2 start ; ! gOT THE TOTAL LENGTH
d_cpos = m_a(1)+m_a(0)<<8; ! max = 256
if d_cpos>256-18 start
printstring("***rjes: message too long -")
printstring(" all rje messages lost
")
->reply
finish
else
if n=d_cpos then ->exit3; ! gOT THE WHOLE MESSAGE
finish
l_rxs = l_rxs!accept char; ! accept the last char
repeat
exit3:
d_hold == null
t = 0!128; ! normal+accept last
if d_count#d_nc start ; ! Another message waiting
get buffer(get op block)
finish
type = m_a(3); ! max = 256
#if ~x
d_node = m_a(5); ! NSI Dependant
d_term = m_a(6)
#fi
! pointer = 8; ! for future use
x = (8+m_a(4))&x'fffe'
m_m len = n
->hlm(type)
hlm(1):
! Operator message
reform message(m)
->reply
hlm(2):
! Request O/P Device Allocation
d == get free des
if d==null start ; ! failed
m_a(x) = 0; m_a(x+1) = 0
else
i = allocate stream(d, 1); ! odd stream for printer etc
d_o state = idle
#if x
facname = sfacil(m_a(x-2)); !facility name from spoolr code
d_called = string(addr(m_a(4))).facname
#else
d_node = d5_node; d_term = d5_term
#fi
d_facility = facil(m_a(x-2))
m_a(x) = 1; m_a(x+1) = d_stream; ! Stream in two bytes
move it:
m_a(x+2) = 0
finish
m_a(1) = x+2
m_m len = x+2
m1 == m; m2 == m1
m2_m = m1_m; ! Move the 2900 message down buffer
kick 2900 message(m)
->reply
hlm(3):
! SPOOLR Reply to INPUT Device Request
strm = swab(integer(addr(m_a(x))))
d == con desa(alloc(strm))
if d==d4 start
printstring("rjes: spoolr type 3?
")
else
if m_a(x+3)#0 start ; ! Rejected
#if x
to gate(disconnect, null, 37)
#else
p_port = d_port; ! set up p_port for do repm
do repm(0); ! reject flag
#fi
retrieve(d)
finish
!! a 'yes' will be dealt with when the 2900 does a
!! 'connect' to the particular stream
finish
free buffer(m)
->reply
hlm(4):
! spoolr requests deallocation
strm = swab(integer(addr(m_a(x-2))))
d == con desa(alloc(strm))
if d==d4 start ; ! ie was zero
printstring("rjes: deallocation with no desc, stream =")
write(strm, 1); newline
->do it
finish
if mon#0 start
who and state
printstring(" deallocated
")
finish
if d_o state=input ready or d_o state=timing or d_o state=trying start
get buffer(connecting reply failed)
finish
if d_o state=trying start
d_o state = aborted; ! wait for connect response
d_nc = 99
else
if d_ostate=connect 1 start
#if x
to gate(disconnect, null, 37)
#else
p_port = d_port
do repm(0); ! reject the connect
#fi
finish
if d_o state>connect 1 start
report error(6)
#if x
m_a(x) = 1; m_a(x+1) = 0; !send failed
->move it
#else
m_a(x) = 0; m_a(x+1) = d_o state; ->move it
#fi
finish
retrieve(d)
finish
do it:
m_a(x) = 0; m_a(x+1) = 0; ! set flag = ok
->move it; ! shift down record and reply
hlm(5):
! spoolr requests route 'goodnness'
! m_a(4) = address len, 5&6 are adress, 8 is remote no
#if x
if m_a(4)=2 start ; ! address len # 2 (old style)
#else
if m_a(4)#2 start ; ! address len # 2 (new style)
#fi
m_a(x-2) = 0; ! complete reject
->move it
finish
m_a(x-2) = get weight
->move it
end
!! w r i t e m e s s a g e t o a m 1
routine write message to am1
record (maof) name m
integer n, max, end, am1 reply, stat
d == d4; ! messages on stream 4
am1 reply = 4; ! "condition y"
cycle
m == d_hold
if m==null then m == pop(d_inp q) and d_cpos = d_cpos-1
if m==null thenexit
!! terminate with "normal" (shouldnt happen)
n = d_n; ! start of block - d_n = 0
cycle
cycle
stat = l_rxs
if stat&xopl#0 start
d_hold == m; ! retain buffer for retry
am1 reply = 64; d_kill = n; ->am1 rep
finish
if stat&ready#0 start
!! l i m i t sent
am1 reply = 2; ! long block
d_n = n; d_count = max
d_hold == m; ! retain for later
->am1 rep
finish
if l_txs&ready#0 thenexit
repeat
if n>=m_m len start
free buffer(m)
d_hold == null; d_n = 0; d_kill = 0
if d_inp q_e==null then ->am1 rep
exit
finish
l_txd = m_a(n); n = n+1
repeat
repeat
am1 rep:
p_c1 = am1 reply
to 2900(return control, null)
end
endofprogram