! file 'fep_eam77'
!********************************
!* emas-2900 fep am1 handler *
!* file: eam7 *
!* date: 24.mar.82 *
!* modified for pcb interface *
!********************************
!! stack size = 300
owninteger fep no = 9; ! number supplied on load
control 1
include "deimosperm"
begin
conststring (13)vsn = "am1h:vsn07v
"
recordformat am1 linkf(integer rxs, rxd, txs, txd)
constrecord (am1 linkf) name inter A == k'075160'; ! in seg 3 ?
constrecord (am1 linkf) name inter B == k'075170'; ! i/f #2
ownrecord (am1 linkf) name l == 1; ! supplied on start
recordformat nsi3f(byteintegerarray a(0:100))
recordformat mef(record (mef) name link, c
byteinteger len, type, record (nsi3f)nss)
! think about the position of 'len'
recordformat m2900f(record (mef) name link, byteinteger len, type, c
integer stream, sub ident, c
p2a, p2b, p3a, p3b, p4a, p4b, p5a, p5b, p6a, p6b)
recordformat m2900cf(record (mef) name link, byteinteger len, type, c
byteintegerarray b(0:23))
recordformat pe(byteinteger ser, reply, c
fn, port, record (mef) name mes, integer str)
recordformat p2f(byteinteger ser, reply, c
fn, port, record (mef) name mes, integer str)
recordformat qf(record (mef) name e)
!********************************************************
!* formats of tables, ie stream descriptors, tcps etc *
!********************************************************
recordformat streamf(integer owner, id 2900)
!*************************************************************
!* am1 commands (when the ninth bit is set)
!*************************************************************
constinteger primary = x'00'
constinteger funny = 1
constinteger read = x'02'
constinteger write c = x'03'
constinteger sense = x'04'
constinteger write control = x'05'
constinteger identify = x'0a'
constinteger limit = x'0c'
constinteger property = x'0e'
!***** primary status bits (11/34 -> 2900)
constinteger unsuccessful = x'80'
constinteger attention = x'20'
constinteger terminated = x'10'
constinteger short block = x'08'
constinteger long block = x'04'
constinteger condition x = x'02'
constinteger condition y = x'01'
!******************************************
!* 2900 constants
!******************************************
constinteger property code = 14; ! as defined by k.y.
constinteger attn byte = x'80'
!********************************************************
!* 2900 am1 link transmitter & receiver bits
!********************************************************
constinteger int on = k'100'; ! both
constinteger ready = k'200'; ! both
constinteger scfy = k'010'; ! transmitter only (txfy)
constinteger maint = k'002'; ! force parity inbound error
constinteger operable = k'004'; ! transmitter only
constinteger comm bit = k'001'
constinteger accept char = k'002'; ! really 'fetch next'
constinteger rset = k'004'
constinteger acfy = k'010'; ! peter calls it rxfy
constinteger xopl = k'020'; ! x operable - latched
constinteger xop = k'040'; ! x operable
!**************************************************************
!* 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
constinteger stop = 4
constinteger high lev con len = 24
! %constinteger low lev con len = 8
!**************************************************************
!* 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
!***************************************************
!* am1 link states
!***************************************************
constinteger idle = 0
constinteger user reading = 2
constinteger user writing = 3
constinteger terminate = 4; ! -> idle
constinteger prop 1 = 5; ! -> prop 2
constinteger prop 2 = 6; ! -> prop 3
constinteger prop 3 = 7; ! -> prop 4
constinteger prop 4 = 8; ! -> terminate
constinteger ident 1 = 9; ! -> ident 2
constinteger ident 2 = 10; ! -> terminate
constinteger next control = 11; ! -> control m
constinteger control m = 12; ! -> control m 2
constinteger control m2 = 13; ! -> control m 2, or terminate
constinteger term x pend = 14; ! -> term x bit ?
constinteger term x bit = 15; ! (?) -> idle
constinteger error = 16; ! -> idle
!! in state states
constinteger initial 4 = 1; ! states of in state
constinteger user read = 2
constinteger user write = 3
constinteger control input trf = 4
constinteger control output trf 1 = 5
constinteger control output trf 2 = 6
constintegerarray next state(idle:error) =
idle, error, error, error, idle, prop 2,prop 3,
prop 4, terminate, ident 2, terminate,
control m, control m2, control m2, term x bit, idle, idle
!****************************************************************
!********** various service numbers *************
constintegername no of small == k'100114'; ! in buff manager
constinteger gate ser = 16
constinteger buffer manager = 17
constinteger link handler = 18
constbyteinteger am1 rx int = -13; ! ????????????????????????
constbyteinteger am1 tx int = -14; ! ???????????????????????/
constinteger t3 ser = 21
constbyteintegername change out zero == k'160310'
!************************************************************
!! state variables
owninteger state = 0; ! transmitter state
owninteger in state = idle; ! input state
owninteger to 2900 control; ! end of outward transfer buff
owninteger control pt; ! start of same
owninteger x bit sent; ! 1 = x bit sent (or about to)
owninteger tx int expected; ! 1 = interrupt expected
owninteger term cond = terminated; ! holds condition to go on terminate
owninteger down = 1; ! 0 = up, 1 = down
owninteger clock = 0; ! missing interrupt count
owninteger mon = 1; ! monitoring flag
owninteger swabf = 1; ! swab flag
owninteger tot out l = 0; ! counts control output mess
owninteger xop status = 0
owninteger read rej = 0; ! number of 'out of buffers'
owninteger i int, o int, ich, o ch
constbyteintegerarray swabx(0:23) =
1, 0, 3, 2, 4, 5, 6, 7, 8, 9, 10, 11, 12,
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23
!!
constinteger lower = -2, upper = 400
ownrecord (streamf) array sta(lower:upper)
ownrecord (streamf) name str
ownrecord (m2900cf) name outm
ownrecord (qf) mq; ! = k'143362'
record (pe) p
ownrecord (qf) name buffer pool
owninteger no of buff = 0
integer i
owninteger prflag = 0; ! dump print flag - temporary
owninteger mon pt = 0
constinteger mon lim = 63
ownbyteintegerarray mon1(0:mon lim)
ownintegerarray mon2(0:mon lim)
!**************************************************
!* routine specs
!**************************************************
routinespec input interrupt
routinespec output interrupt
routinespec output
routinespec interrupt am1
routinespec user call
routinespec stop interface
routinespec clock int
routinespec up down(integer which)
routinespec free buffer(record (mef) name mes)
record (m2900f) mapspec get buffer
routinespec fault(integer stream, type, add)
routinespec monitor(integer type, info)
routinespec octal(integer i)
routinespec dump regs
!**********************************************
!* initialisation *
!**********************************************
map hwr(3); ! map top seg to seg 3
linkin(link handler)
linkin(am1 rx int); linkin(am1 tx int)
printstring(vsn)
i = map virt(buffer manager, 5, 4); ! map to my seg 4
i = map virt(buffer manager, 6, 5); ! and seg 6 to my 5
sta(2)_id 2900 = 2; ! artificially set stream 2 up
p_ser = 0; poff(p); ! wait for fep no
fep no = p_fn; ! supplied by load prog
l == p_mes; ! set hardware address
printstring("fep"); printsymbol(fepno+'0')
newline
alarm(50)
change out zero = t3 ser; ! switch o/p to comm
!! remove the tx int bit, set the rx int bit and accept char?
l_txs=operable; l_rxs=accept char!int on
cycle
p_ser = 0; poff(p)
if p_ser = own id and p_reply = 0 start ; ! clock int
alarm(50)
if 'm' <= int <= 'o' start
mon = int-'o'; int = 0
finish
if '1' <= int <= '2' start
if down = 0 start
printstring("Am1h: Wait till Emas is down
")
else
l_rxs = l_rxs&(¬int on); ! ints off on old interface
printstring("Am1h: Going to Interface "); printsymbol(int)
newline
if int = '1' then l == inter A else l == inter B
l_txs = operable; l_rxs = accept char!int on
finish
int=0
finish
if int = 'F' start
int = 0
i = mon pt
selectoutput(1)
cycle
if mon1(i) # 0 start
space
printsymbol(mon1(i)); write(mon2(i), 3)
if i & 15 = 0 then newline
finish
i = (i+1)&mon lim
repeat until i = mon pt
newline
selectoutput(0)
finish
if int = 'x' start
dump regs
int = 0
finish
if int = 'Z' start
stop interface
p_ser = 0; poff(p)
stop
finish
if int = '?' start
int = 0
printstring("am1h: buf ="); write(no of buff, 1)
printstring(", rej ="); write(read rej, 1); newline
printstring("i int ="); write(i int, 1); printstring("o int =")
write(o int, 1); printstring(" i ch="); write(i ch, 1)
printstring(" o ch ="); write(o ch, 1); newline
i int = 0; o int = 0; i ch = 0; o ch = 0;
finish
clock int
continue
finish
if mon # 0 start ; ! monitoring
if p_reply = 0 then i = p_ser else i = p_fn
monitor('m', i)
finish
if p_ser = link handler start
user call
finish else if p_ser = am1 rx int&x'ff' start
input interrupt
finish else if p_ser = am1 tx int&x'ff' then output interrupt
repeat
!********************************************************
!* routines *
!********************************************************
routine input interrupt
!*************************************************
!* first part of any transfer is four bytes *
!* two byte stream no, two byte max length *
!*************************************************
integer pp, error type, ninth bit, sym, stream, max
integer ind, s2, sub ident, extra, i
recordformat byteaf(byteintegerarray b(0:200))
recordformat intaf(integerarray a(0:100))
recordformat r3f(integername x)
recordformat r4f(record (m2900f) name m)
recordformat m2900df(byteintegerarray b(0:23))
recordformat mbf(integer link, two, record (m2900df) m)
ownrecord (byteaf) header
record (intaf) name head2
record (m2900f) name m2900
record (r3f) r3; record (r4f) name r4
record (mbf) name mb
record (p2f) p2
switch state sw(idle:control output trf 2)
switch control(0:15)
pp = 0
head2 == header
l_rxs = l_rxs&(¬int on)
cycle
i = 1000
while l_rxs&(ready!xopl) = 0 and i > 0 cycle ; i = i-1; repeat
monitor('*', i) if mon # 0 and i # 1000
if i = 0 start ; ! timeout
dump regs
fault(instate, 't', state)
instate = idle
exit
finish
if l_rxs&xopl # 0 start ; ! x operable has gone down
if xop status # 0 start ; ! print change only
printstring("xop down!"); dump regs
finish
monitor('r', instate) if mon # 0
l_rxs = l_rxs&(¬xopl)
l_txs = l_txs&(¬int on)
in state = idle
tx int expected = 0
unless outm == null start
push(mq, outm)
outm == null; ! put message back on q
finish
xop status = 0
if l_rxs&xop # 0 start
printstring("xop up again
")
l_rxs = l_rxs!accept char
finish
exit
finish
if xop status = 0 # l_rxs&xop start ; ! xop has come back
l_rxs = l_rxs&(¬rset); ! i/f leaves rset on after xop back
cycle i = 1,1,200; repeat ; ! wait two millisecs.
if l_rxs&(ready!acfy!comm bit) c
= (ready!acfy!comm bit) start
xop status = 1
finish else start
dump regs; newline
extra = l_rxd
error type = 6; ->fail it
finish
finish
ninth bit = l_rxs&comm bit
i ch = i ch+1
sym = l_rxd
if l_rxs&acfy # 0 start ; ! failed to read
sym = l_rxd; ! retry
if l_rxs&acfy # 0 start ; ! hard failure
printstring("am1: parity error
")
error type = 7; extra = l_rxd; -> fail it
finish
finish
l_rxs = l_rxs!accept char
if ninth bit = 0 start ; ! 'true' data
if pp>200 start ; ! not normal
printstring("am1h:Missing control bit on link!
")
pp = 0; !junk the bad data
! h/w has obviously had it
finish
header_b(pp+swabf) = sym
pp = pp+1; swabf = swabf!!x'fffe'; ! flip 1 -> -1 -> 1
!*************************************************
!* note: all 'data' bytes swapped on entry *
!*************************************************
monitor('i', sym) if mon # 0
continue ; ! get next char
finish
if mon # 0 then monitor('c', sym)
->control(sym&15); ! control command
control(limit):
if state # idle start
monitor('x', state) if mon # 0
state = terminate
exit if tx int expected # 0; ! will be coming
->check transmitter
finish
control(write c):
control(read):
->state sw(in state)
control(property):
to 2900 control = 0; term cond = terminated; x bit sent = 0
up down(0); ! now up
state = prop 1; ->check transmitter
control(identify):
state = ident 1; -> check transmitter
control(sense):
state = prop 3; ! sends 0, 0
check transmitter: ! attempt to send a character
output
exit
state sw(initial 4):
if down # 0 then error type = 9 and -> fail it
if pp # 4 start
error type = 1; extra = pp; -> fail it
finish
stream = head2_a(0); max = head2_a(1)
monitor('s', stream) if mon # 0
str == sta(stream)
if stream > 0 start ; ! data coming/going
if str_owner # 0 start
p_ser = str_owner; p_reply = link handler
p_mes == null
p_port = max
p_str = stream
pp = 0
in state = (stream&1)+user read
! even = am1 input, odd = am1 output
state = terminate; output; ! send a 'prim stat'
continue
!* ie pick up the 'write c' or 'read' before going to user
finish
error type = 2; extra = stream; ->fail it; ! stream not in use
finish
!* must be a control stream transfer ********
pp = 0
if stream = -2 start
!! inward control stream
in state = control input trf
else
!! outward control stream (-1)
in state = control output trf 1
finish
state = terminate
output
exit
state sw(user read): ! pick up 'read' command
state sw(user write): ! pick up 'write' command
if pp # 0 start
error type = 3; extra = pp; ->fail it; ! data not expected
finish
p_fn = in state-1; ! read=2=doinput, write=3=dooutput
pon(p)
state = in state; ! transfer 11/34 -> am1 or reverse
return
state sw(control input trf): ! ie 11/34 -> 2900
control pt = 0
in state = idle; ! nothing more coming in
state = control m
if mq_e == null start
monitor('?', to 2900 control) if mon # 0
state = terminate
finish
-> check transmitter
state sw(control output trf 2): ! ie 2900 -> 11/34
!* after the 'limit' - data has been read
!! now cycle up the buffer, firing the requests
ind = 0; r4 == r3
cycle
s2 = head2_a(ind); r3_x == head2_a(ind)
if s2 # -1 start
sub ident = head2_a(ind+1)
if mon # 0 then monitor('l', s2)
if s2 < lower or s2 > upper start
fault(s2, 's', ind); exit
finish
str == sta(s2)
if str_owner = 0 then fault(s2, 's', ind) elsestart
m2900 == get buffer
mb == m2900; ! align it to data area
mb_m = r4_m; ! and copy it accross
!! pick up "id 2900" if its a connecting messgae
if mb_m_b(5) = 2 then str_id 2900 = m2900_p2b
p2_ser = str_owner; p2_reply = link handler
p2_fn = message
p2_mes == m2900
pon(p2)
finish
finish
ind = ind+high lev con len//2
exit if ind >= pp//2
repeat
in state = idle
state = term x bit; ! send x bit if necessary
output
exit
control(write control): ! write control from 2900
!! this can only happen at the beginning of a transfer
!! from the 2900, so whatever the state, force it to idle
state sw(idle):
extra = pp
if pp # 0 then error type = 6 and -> fail it
! no control char ??
clock = 0
swabf = 1; ! used to "swab" the bytes
in state = initial 4; continue
state sw(control output trf 1): ! seen the 'write' command
in state = control output trf 2
if no of small+no of buff < 7 or int='L' start
read rej = read rej+1
in state = idle
state = term x bit
output
while l_txs&ready = 0 cycle ; repeat
i = l_rxd
l_rxs = l_rxs!accept char
monitor('q', read rej) if mon # 0
exit
finish
repeat
l_rxs = l_rxs!int on
return
control(funny): ! should not occur
control(primary):
control(6):control(7):control(8):
control(9):control(11):control(13):control(15):
error type = 5; extra = sym
fail it:
fault(error type, 'i', extra)
l_rxs = l_rxs!int on; in state = idle
term cond = unsuccessful!terminated; state = terminate
unless outm == null then free buffer(outm) and outm==null
output
end
routine output interrupt
!********************************************
!* routine handles output interrupt from am1 *
!*********************************************
o int = o int+1
l_txs = l_txs&(¬int on)
if tx int expected = 0 start
fault(0, 'o', state)
else
if tx int expected = 2 start ; ! special case of accept char
!user has handed back control after reading from am1
!this handler must now say 'next char', but only after
! the GPC has seen the terminate
tx int expected = 0
l_rxs = l_rxs!accept char
l_rxs = l_rxs!int on
monitor('u', in state) if mon # 0
in state = idle
unless mq_e == null then interrupt am1
return
finish
tx int expected = 0; clock = 0
output; ! see whats up
finish
end
routine output
!! this routine is entered to check whether a character can
!! be send to the 2900
!! if it can, then characters are sent until -
!! 1) it goes 'busy' - in which case an interrupt is requested
!! 2) all has gone - the state then goes to idle
integer i, sym, ostate
switch ts(idle:error)
cycle
if l_txs&ready = 0 start ; ! 'busy'
l_txs = l_txs!int on; ! put ints on
tx int expected = 1; ! set the flag
return
finish
l_txs = l_txs&(¬comm bit); ! ensure ninth bit off
ostate = state
-> ts(state)
ts(term x bit): ! send terminate+x bit if necessary
sym = term cond!x bit sent
-> set comm bit
ts(terminate):
sym = term cond
set comm bit:
l_txs = l_txs!comm bit
monitor('d', -sym) if mon # 0
term cond = terminated
-> send
ts(prop 1):
sym = property code; -> send
ts(prop 2):
sym = fep no; -> send
ts(prop 3):
ts(prop 4):
ts(ident 1):
sym = 0; -> send
ts(ident 2):
sym = attn byte; -> send
ts(control m): ! set up transfer
outm == pop(mq); ! get next entry
to 2900 control = outm_len; ! get the length
control pt = 0; ! start at beginning
ts(control m2):
sym = outm_b(swabx(control pt))
control pt = control pt+1; tot out l = tot out l+1
if control pt = to 2900 control start
free buffer(outm)
outm == null
unless mq_e == null or tot out l > 180 start
state = next control; ! get the next buffer
else
state = term x pend
!! ** next state = term x bit - send x bit if necessary
to 2900 control = 0
x bit sent = 0
unless mq_e == null then interrupt am1
finish
finish
send:
o ch = o ch+1
if l_txs&comm bit # 0 and sym = (unsuccessful!terminated) start
! print string("abterm")! dump regs
l_txd = sym
l_rxs = l_rxs!accept char if l_rxs&acfy = 0
finish else l_txd = sym
monitor('d', sym) if mon # 0
state = next state(state)
repeat
ts(error):
ts(user reading): ts(user writing): ts(next control): ts(term x pend):
int = 'F' if prflag = 0; prflag = 1
fault(state, 'e', ostate)
ts(idle):
end
routine interrupt am1
if state = idle and in state = idle start
term cond = attention; state = terminate
output; ! kick the transmitter
finish
x bit sent = condition x
tot out l = 0
end
routine user call
!****************************************************
!* reasons *
!* 0) send data - high level control *
!* 1) low level control *
!* 2) here i am - ipl info wanted *
!* 3) return control - was reading/writing *
!****************************************************
constintegerarray typea(0:5) =
terminated, short block, long block, unsuccessful,
condition y, terminated
integer fn, i, len, pp, stream
byteinteger ind
record (m2900f) name m2900
record (m2900cf) name m2900c
switch user sw(send data:stop)
->user sw(p_fn)
user sw(send data): ! high level control ->2900
user sw(low level control):
len = high lev con len
m2900c == p_mes; m2900 == m2900c
stream = sta(m2900_stream)_id 2900
if stream = 0 start ; ! error
printstring("am1: attempt to send zero stream, stream = ")
write(m2900_stream, 1); write(m2900_sub ident, 1)
write(m2900_p2a, 1); newline
free buffer(m2900); return ; ! junk it
finish
m2900_stream = stream
m2900_len = len; ! hold its length
if down = 0 start ; ! 2900 is up
if mq_e == null then interrupt am1
push(mq, m2900)
!******************************************************
!* note: stream & sub ident are alwys swabbed
!*******************************************************
finish else free buffer(m2900); ! junk it
return
user sw(return control):
unless user reading <= state <=user writing start
fault(in state, 'r', state)
else
ind = p_str; ! type of termination
if ind&64 = 0 start ; ! xopl not set.
term cond = typea(ind&7)!terminated; ! send the terminate
state = term x bit; ! append x bit as necessary
output
if ind&128 # 0 start ; ! char to accept
l_txs = l_txs!int on; ! wait for GPC to terminate
tx int expected = 2; ! with special flag set
return ; ! and wait
finish
finish
ints on:
l_rxs = l_rxs!int on; in state = idle
finish
return
user sw(here i am):
stream = p_str
sta(stream)_owner = p_reply; ! enable the stream
if stream < 10 start ; ! control streams
p_ser = p_reply; p_reply = link handler
p_fn = interf addr; p_mes == l; ! pass addr of "l"
pon(p)
finish
return
user sw(stop): ! stop the am1
stop interface
end
!* routine clock int
routine stop interface
l_txs = l_txs&(¬(operable!int on))
l_rxs = l_rxs&(¬int on)
end
routine clock int
!! handles clock interrupts
integer i
if tx int expected # 0 or x bit sent # 0 start
clock = clock+1
monitor('w', clock) if mon < 0 and clock&3 = 0
if clock = 5 start ; ! emergency action
printstring("am1:dying")
dump regs
l_txs = l_txs&(¬operable); ! drop operable
cycle i = 1,1,10; repeat ; ! delay
l_txs = l_txs!operable
return
finish
if clock = 10 and l_txs&ready#0 then interrupt am1
if clock = 20 start ; ! 20 sec timeout
fault(x bit sent, 'c', tx int expected)
up down(1)
state = idle; in state = idle
l_txs = l_txs&(¬int on)
int = 'F'
finish
finish else clock = 0
end
!* routine up down
routine up down(integer which)
integer i, ser
down = which
cycle i = 2, 1, 6; ! send 'status' message to itp, rje ftp
ser = sta(i)_owner
if ser # 0 start
if down = 0 start ; ! going up
p_ser = ser; p_reply = link handler
p_fn = interf addr; p_mes == l; ! pass 'l' (it may have changed)
pon(p)
finish
p_ser = ser; p_reply = link handler
p_fn = mainframe up+which
p_mes == null
pon(p)
finish
repeat
!* tidy up variables
x bit sent = 0; tx int expected = 0
while not mq_e == null cycle
free buffer(pop(mq))
repeat
unless outm == null then free buffer(outm) and outm==null
end
routine free buffer(record (mef) name mes)
record (pe) p
if no of buff > 13 or mes_type = 0 start
!release if q too big, or its a big block
p_ser = buffer manager; p_reply = own id
p_fn = release buffer; p_mes == mes
pon(p)
else
!! q it
mes_link == buffer pool; buffer pool == mes
no of buff = no of buff+1
finish
end
record (m2900f) map get buffer
if buffer pool == null start ; ! ask for it
p_ser = buffer manager; p_reply = own id
p_fn = request buffer; p_str = 1; ! short buffer
ponoff(p)
else
p_mes == buffer pool; buffer pool == p_mes_link
p_mes_link == null
no of buff = no of buff-1
finish
result == p_mes
end
routine fault(integer stream, type, add)
printstring("am1: fault "); printsymbol(type)
write(stream, 3)
printstring(", "); write(add, 1); newline
monitor('f', type) if int # 'a'
end
routine monitor(integer type, info)
mon1(mon pt) = type; mon2(mon pt) = info
mon pt = (mon pt+1)&mon lim
end
routine octal(integer i)
integer n
space
cycle n = 15, -3, 0
printsymbol((i>>n)&7+'0')
repeat
end
routine dump regs
printstring(" r"); octal(l_rxs)
printstring(" t"); octal(l_txs)
newline
end
endofprogram