! file 'fep_itpe9s' !******************************** !* emas-2900 fep itp server * !* file: itpe9s/itpey * !* date: 25.mar.82 * !******************************** !! stack size = 1000 %include "deimosperm" %control 1 %begin %conststring (13)vsn = "itps:vsnea9j " %recordformat am1f(%integer rxs, rxd, txs, txd) %ownrecord (am1f) %name l == 1; ! addr passed by eam1 !! no of data bytes in a short block %constinteger small block max = 44 !start with 64 !buff man takes 4 !bsp takes 10 !itp takes 4 !for luck 2 !leaves 44 %constinteger big block max = 127; ! < 256 ! %constintegername no of big == k'100112' %constintegername no of small == k'100114' %owninteger critical = 15; ! switch off o/p level %recordformat qf(%record (qf) %name e) %recordformat itpf(%byteinteger cnsl, hdb1, hdb2, %string (238) s) %recordformat itp2f(%byteintegerarray a(0:238)) %recordformat itp3f(%byteinteger cnsl, hdb1, hdb2, %c %byteintegerarray a(0:32)) %recordformat bspf(%integer st,ss,rc,tc,ufl, %record (itpf) itp); !$e %recordformat mef(%record (mef) %name link, %c %byteinteger len, type, %record (bspf)bsp) %recordformat m2900f(%record (mef) %name l, %byteinteger len, type, %c %integer stream, sub ident, %c p2a, p2b, p3a, p3b, p4a, p4b, p5a, p5b, p6a, p6b) %recordformat m2900bf(%record (mef) %name l, %byteinteger len, type, %c %integer stream, sub ident, %c %byteintegerarray b(0:19)) %recordformat m2900if(%record (mef) %name l, %byteinteger len, type, %c %integer stream, sub ident, p2a, p2b, %string (15) int) %recordformat maf(%record (mef) %name l, %byteinteger mlen, %c mtype, %byteintegerarray a(0:240)) %recordformat pe(%byteinteger ser, reply, %c fn, port, %record (mef) %name mes, (%byteinteger len, s1 %or %c %integer str)) !******************************************************** !* formats of tables, ie stream descriptors, tcps etc * !******************************************************** %recordformat con desf(%record (mef) %name hold, %c %integer state, stream, %byteinteger o state, out go, %c in cnt, tcp, cnsl, seq bits, pmt n, mode, hold f, abortf, %c %integer trig, i pos, opos, o lim, o trig, p lim, %c in lim, out lim, o posx, (%record (mef) %name in mes %or %c %record (qf) inp q)) %recordformat cons statef(%record (con desf) %name con des) %recordformat tcpf(%integer state, con state ind, %c held, h ind, h no, %byteinteger port, ostate, tcpn, node, term, %c size, max, %record (qf) outq) !*********************************************************** !* record formats for 2900 input messages !*********************************************************** !************************************************************ !* 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 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 !************************************************************** !* 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' !************************************************************ !* tcp states * !************************************************************ ! %constinteger not allocated = 0 %constinteger connected = 1 %constinteger tcp disconnecting = 2 !****** tcp_ostate states (permission to send) ***** %constinteger idle = 0 ! %constinteger busy = 1 !*********************************************************** !* 2900 states * !*********************************************************** %own %integer 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 %constinteger aborting = 5 %constinteger enabling = 7 ! %constinteger enabled = 8 %constinteger fixed = 10; ! 1st available stream !************************************************************** !* console states * !************************************************************** %constinteger not allocated = 0 %constinteger name sent = 1; ! hello has been received %constinteger pass sent = 2; ! 'name' has been received %constinteger logging on = 3 %constinteger logged on = 4; ! 2970 has accepted it %constinteger input enabled = 5 %constinteger logging off = 6; ! 2970 is getting rid of it %constinteger logging off 2 = 7; ! waiting to send it !! ostate states !! %constinteger idle = 0 %constinteger enabld = 1 %constinteger out p = 2; ! output req pending %constinteger pmt p = 4; ! prompt request pending !********************************************************** !* itp header bytes definitions * !********************************************************** %constinteger text = 0; ! in itp_hdb1 %constinteger bin b = 1 %constinteger control = 1 %constinteger go ahead = 2; ! in itp_hdb1 %constinteger hello = 8 %constinteger disconnect = 4 %constinteger terminated = 2; ! in itp_hdb2 %constinteger prompt = 4 %constinteger text marker = 8 %constinteger seq no valid = 32 %constinteger seq no bits = x'c0' %constinteger seq inc = x'40' %constinteger intm = 1; ! hdb2 - control message %constinteger set mode = 2 %constinteger kill transmit = 8 %constinteger kill receive = 4 !****************************************** !* reasons for waiting for a buffer * !****************************************** %constinteger send name prompt = 1 %constinteger send pass prompt = 2 %constinteger put echo on =3, put echo off = 4, send nl = 5 %constinteger store user name = 6 %constinteger send disconnect = 7 %constinteger send emas down = 18 %constinteger send go ahead = 19 %constinteger send kill transmit = 20 %constinteger send text marker = 21 %constinteger last itp reason = 21 %constinteger low level ip transfer = 22 %constinteger low level op transfer = 23 %constinteger get op block = 24 %constinteger send trig reply = 25; ! must be odd (output trigger) %constinteger send the chop = 26; ! send an "int y" to 2900 %constinteger get big op block = 27 %constinteger kick message stream = 28 !************************************************************** %routinespec to gate(%integer fn, %record (mef) %name mes, %c %integer flag) %routinespec to 2900(%integer fn, %record (m2900f) %name m2900) %routinespec get buffer(%integer reason) %routinespec free buffer(%record (mef) %name mes) %routinespec from gate %routinespec from 2900 %routinespec from buffer manager(%record (pe) %name p) %integerfnspec analyse itp message(%record (mef) %name mes) %routinespec retrieve(%record (con desf) %name d) %routinespec lose consoles(%integer x) %routinespec read from am1 %routinespec write to am1 %routinespec kick 2900 message(%record (maf) %name log) %routinespec tidy message streams %routinespec read message from am1 %routinespec write message to am1 %routinespec mon mes(%record (mef) %name mes) !! %permroutinespec push(%record (qf) %name q, %record (mef) %name e) !! %permrecord (mef) %mapspec pop(%record (qf) %name q) !****************************************************** %record (pe) p %ownrecord (tcpf) %name tcp %owninteger tcpn %ownrecord (con desf) %name d %ownrecord (qf) free des; ! pts to list of free con desa %ownrecord (con desf) %name first d; ! for dumping only %ownrecord (con desf) %name d2, d3 %ownrecord (qf) %name buffer pool %owninteger no of buff = 0 %constinteger tcp limit = 30; ! increase con index as well !!!!!!! %ownrecord (tcpf) %array tcpa(0:tcp limit) %ownbytearray con index(0:1570) %constinteger con lim = 118; ! number of active terminals %ownrecord (con desf) %array con desa(-2:con lim) %constinteger max ports = 50 %ownbyteintegerarray porta(0:max ports) ! cross index from port to tcp %constinteger max tts = 49; ! ie 0 to 48 %owninteger mon = 0; ! monitoring flag %constintegername users == k'100014'; ! no of users in buffer seg %owninteger messflag=0; !w.s.c. 9/4/81 tcp connections %integer i, n %ownstring (63) str !********************************************** !* initialisation * !********************************************** change out zero = t3 ser first d == con desa(0) %cycle i = con lim, -1, 1; ! zero is not to be used push(free des, con desa(i)) %repeat n = 0 %cycle i = 1, 1, tcp limit tcp == tcpa(i) tcp_tcpn = i tcp_con state ind = n; n = n+max tts %repeat d2 == con desa(-2) d2_stream = -2 d3 == con desa(-1) d3_stream = -1 printstring(vsn) map hwr(0); ! map am1 to segment 0 i = map virt(buffer manager, 5, 4); ! map buff man stack to seg 4 i = map virt(buffer manager, 6, 5); ! and second seg users = 0 con desa(i)_stream = i %for i = 0, 1, con lim p_str = 2; ! param for 'here i am' to 2900(here i am, null) p_str = 3 to 2900(here i am, null) tcp == tcpa(0); ! dummy for below to gate(enable facility, null, 18) !********************************************** !* main loop * !********************************************** %cycle p_ser = 0; poff(p) %if int # 0 %start %if 'M' <= int <= 'P' %start mon = int-'O' %finish %if int='A' %then messflag=1; !turn messages on %if int='B' %then messflag=0; !turn off %if int = '?' %start; ! $$ mon write(no of buff, 4); newline printstring("term qu mq held no held ") %cycle i = 1, 1, tcp limit tcp == tcpa(i) %if tcp_state = connected %start write(tcp_term, 3) write(tcp_size, 3); write(tcp_max, 2) write(tcp_held, 3); write(tcp_h no, 2) newline tcp_max = 0 %finish %repeat %finish int = 0 %finish %if p_reply = link handler %start from 2900 %finish %else %if p_reply = gate ser %start from gate %finish %else %if p_reply = buffer manager %then from buffer manager(p) %repeat !************************************************* !* routines to do the work * !************************************************* %routine crunch %integer i %cycle i = 1, 1, 15 printstring("itps: Bad buffer ***** dump fep ******** ") %repeat *=k'104001'; ! emt wait %end %routine to gate(%integer fn, %record (mef) %name mes, %c %integer flag) %if fn = put output %start; ! queue these as necessary mes_len = mes_len+2; !$e (uflag bytes) %if tcp_state # connected %start; ! throw away free buffer(mes); %return %finish %if addr(mes)&k'140000' = k'140000' %then crunch tcp_size=tcp_size+1 tcp_max=tcp_size %if tcp_size>tcp_max ! %if mon # 0 %start ! select output(1) ! printstring("io ");! mon mes(mes) ! %finish %finish p_ser = gate ser; p_reply = own id p_fn = fn; p_port = tcp_port; 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 %integer type !******************************************************* !* hold a pool, so can call buffer here immedialtely* !* otherwise hold the activity until it arrives* !******************************************************* %if reason = get big op block %then type=0 %else type=1 p_s1 = reason; p_port = d_stream %if buffer pool == null %or type=0 %start; ! have to ask for it p_ser = buffer manager; p_reply = own id p_fn = request buffer p_len = type; ! either size 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' %then crunch %if mes_type=0 %or no of buff>10 %or no of small < 15 %start p_ser = buffer manager; p_reply = own id !! queue it if it is a short buffer p_fn = release buffer; p_mes == mes pon(p) %else !! short buffer, so queue it mes_link == buffer pool; buffer pool == mes no of buff = no of buff+1 %finish %end %routine get o block !! this routine determines whether it is worth asking for !! a big buffer to put itp output in, otherwise gets small !! nb: 1st transfer is always a small buffer (not done here) %integer x x = d_o lim-d_o pos %if x<0 %then x=x+d_out lim %if x>small block max %and no of big > 15 %then %c get buffer(get big op block) %else %c get buffer(get op block) %end %routine from gate %record (mef) %name mes %record (tcpf) %name targ %integer fn, flag, type, x, q %switch fns(incoming call:call aborted) fn = p_fn tcpn = porta(p_port) tcp == tcpa(tcpn) ->fns(fn) fns(incoming call): tcp == null %cycle tcpn = tcp limit, -1, 1 targ == tcpa(tcpn) %if targ_state = not allocated %then tcp == targ %repeat %if tcp == null %start ! full up tcp == tcpa(0) tcp_port = p_port; ! for 'to gate' call only flag = reject %else tcp_term = p_len; tcp_state = connected; tcp_ostate = idle %if tcp_term = 11 %then tcp_term = p_mes_bsp_itp_cnsl tcp_node = p_mes_bsp_itp_hdb2 porta(p_port) = tcp_tcpn; ! fill in port no - tcp no index tcp_port = p_port flag = 1; !connect ok %if messflag=1 %start printstring(" itp: t") write(p_len, 1); printstring(" Connected ") %finish tcp_max = 0; ! for monitoring tcp_size = 0; tcp_held = 0; tcp_h no = 0 %finish to gate(call reply, null, flag) %return fns(input recd): mes == p_mes; ! hold for possible freeing to gate(enable input, null, 0) ! %if mon # 0 %start ! select output(1) ! printstring("ii ");! mon mes(mes) ! %finish %if mes_len < 4+2 %start; !buffer empty freebuffer(mes); !throw it away %return %finish mes_len = mes_len-2; ! $e - uflag bytes ******** mes_bsp_rc = 0; ! missing gah count flag = analyse itp message(mes) %if flag < 0 %then free buffer(mes) ! flag > 0 - going to 2900 ! flag = 0 - used internally ! flag < 0 - may be freed %return fns(output transmitted): tcp_size=tcp_size-1 %if tcp_held # 0 %and tcp_size<3 %start !! consoles are held & q is now redduced x = tcp_h ind %cycle x = x+1 %if x > max tts %then x = 0 q = con index(x+tcp_con state ind) %unless q = 0 %start; ! console active d == con desa(q) %if d_hold f # 0 %start; ! and held d_hold f = 0; tcp_held = tcp_held-1 get o block %if tcp_size > 0 %then %c tcp_h ind = x %and ->got it !! if q is still non-zero, release only 1 %finish %finish %repeat %until x = tcp_h ind tcp_held = 0; ! didn't find any! got it: %finish %return fns(call closed): type=close call -> kill it fns(call aborted): ! either way, all is lost type = abort call kill it: %while %not tcp_outq_e == null %cycle free buffer(pop(tcp_outq)) %repeat %if messflag=1 %start printstring(" t"); write(tcp_term, 1) printstring(" Connection ") %if type = abort call %then printstring("ABORTED") %else %c printstring("Closed") write(tcp_max, 1); newline %finish lose consoles(-1) tcp_state = not allocated to gate(type, null, 0) x = 0 %while %not tcp_outq_e == null %cycle free buffer(pop(tcp_outq)) x = x+1 %if x&7 = 7 %then set prio(1) !! force a reschedule, to avoid overload %repeat; ! flush any queued items %return %end %integerfn analyse itp message(%record (mef) %name mes) %record (itpf) %name itp, itp2 %record (maf) %name m %integer cnsl, index, stream, len, x, q %record (m2900if) %name mi %switch console state(idle:logging off 2) itp == mes_bsp_itp cnsl = itp_cnsl %if cnsl >= max tts %start printstring("itps: cnsl no too high, tcp,cnsl:") write(tcp_term, 1); write(cnsl, 1) newline -> get rid of it %finish index = cnsl+tcp_con state ind q = con index(index) %unless q = 0 %start d == con desa(q) %if cnsl#d_cnsl %or d_tcp#tcp_tcpn %start printstring("itps: console mismatch (warning) ") -> get rid of it %finish %if itp_hdb1&disconnect # 0 %start !! console ctrl+d lose consoles(cnsl) -> get rid of it %finish %if itp_hdb1&go ahead# 0 %start; ! 'simple' goahead d_out go = d_out go+1 %if d_out go > 4 %then d_out go = 4 %if d_out go = 1 %and d_ostate &out p # 0 %start %if tcp_size >= 3 %or no of small < critical %start d_hold f = 1; tcp_held = tcp_held+1; tcp_h no=tcp_h no+1 %finish %else get o block %finish %finish ->console state(d_state) %finish console state(not allocated): ! eg no descriptor %if itp_hdb1&hello # 0 %start; ! sent hello d == pop(free des) %if d == null %then -> get rid of it stream = d_stream; ! hold the stream con index(index) = stream d = 0; ! zero the record d_stream = stream d_tcp = tcpn; d_cnsl = cnsl d_state = name sent %if host state = down %start get buffer(send emas down) %result = -1 %finish get buffer(send name prompt) users = users+1 d_hold == mes get buffer(store user name) %result = 2; ! buffer retained %finish %result = -1; ! deallocate block console state(name sent): ! user name arrived ? %if itp_hdb1&control = 0 %start; ! is a text message d_state = pass sent get buffer(put echo off); ! switch echo off get buffer(send pass prompt); ! send pass: %if length(itp_s) > 2 %then length(itp_s) = length(itp_s)-2 %if length(itp_s) > 20 %then length(itp_s) = 20 m == d_hold; ! pickup buffer with 'address' string(addr(m_a(m_mlen))) = itp_s m_mlen = m_mlen+length(itp_s)+1 %finish %result = -1; ! de-alloctae block console state(pass sent): ! password arrived ?? %if itp_hdb1&control = 0 %start; ! ia a text message d_out go = d_out go-1 get buffer(send nl); ! send out a newline get buffer(put echo on); ! put echo back on m == d_hold !! check that it has switched buffers?? %if length(itp_s) > 2 %then length(itp_s) = length(itp_s)-2; ! delete the cr/lf index = d_stream<<1+fixed x = m_mlen %if x+length(itp_s) > small block max %then %c length(itp_s) = small block max-x string(addr(m_a(x))) = itp_s; ! put in password x = x+length(itp_s) m_a(0) = x d_state = logging on d_hold == null d_seq bits = x'c0' kick 2900 message(m); ! nb: disturbs 'd' p_str = index; ! param for 'here i am' to 2900(here i am, null) p_str = index+1; ! param for 'here i am' to 2900(here i am, null) %finish %result = -1 console state(logging on): ! go ahead only? console state(logged on): ! still no input %result = -1 console state(input enabled): ! input messages and ints !! check for a text message %if itp_hdb1&control = 0 %start; ! text %if %not d_in mes == null %start d_seq bits = d_seq bits+seq inc itp2 == d_in mes_bsp_itp d_in mes_bsp_rc = d_in mes_bsp_rc+1; ! missing gah count %unless length(itp_s)+length(itp2_s)>238 %then %c itp2_s = itp2_s.itp_s %result = -1; ! chuck the buffer %finish get buffer(low level ip transfer); ! signal to 2900 input here d_in mes == mes mes_bsp_tc = 0; ! missing gah = 1 %result = 2 %finish !! check for an "int" messgae %if itp_hdb2&intm # 0 %start; ! int message str = itp_s; ! copy it out of the way len = length(str); ! check for cr, nl & nl %if charno(str, len-1) = 13 %then len = len-2 %if charno(str, len) = nl %then len = len-1 len = 15 %if len > 15 %result = -1 %if len <= 0; ! invalid int length(str) = len mi == mes; ! re-use 'mes' mi_stream = (d_stream<<1)+fixed; mi_sub ident = 0 mi_p2a = -1; mi_p2b = -1; ! set up params mi_int = str; ! copy string accross to 2900(send data, mi); ! send to eam1 %result = 2; ! don't deallocate buffer %finish %if itp_hdb2&set mode # 0 %start; ! setmode in str = itp_s; ! copy to global string m == mes; ! change to 'to 2900' type m_a(1) = 2; ! type = set mode m_a(2) = 0; ! top half of stream m_a(3) = d_stream<<1+fixed; ! rest of stream string(addr(m_a(4))) = str; ! copy setmode back in m_a(0) = length(str)+4; ! put in total length kick 2900 message(m); ! put in q for 2900 %result = 2; ! dont free buffer %finish %result = -1 console state(logging off): ! message is out, just disconnect d_state = logging off 2 get buffer(send disconnect) %result = -1 get rid of it: console state(logging off 2): ! ignore %result = -1 %end %routine free transient %if %not d_in mes == null %then free buffer(d_in mes) %and %c d_in mes == null %if %not d_hold == null %start free buffer(d_hold); d_hold == null %finish %end !! 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 %integer stream, sub ident, state, trig, mode, i %integer type, p2b, pf %switch link fns(interf addr:mainframe down) m2900 == p_mes; m2900b == m2900 %if p_fn = message %start stream = m2900_stream; ! get first stream no %else %if p_fn > message %then -> link fns(p_fn) stream = p_str %finish d == con desa((stream-fixed)>>1) tcp == tcpa(d_tcp) -> 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 = 3 %then read message from am1 %else %c read from am1 ! ->d mon %return link fns(do input): ! -> 2900 %if stream = 2 %then write message to am1 %else %c write to am1 !d mon: %if mon #0 %start ! select output(1);! printsymbol('t') ! write(p_fn, 1);! write(stream, 1);! newline;! select output(0) ! %finish %return link fns(mainframe up): printstring("emas-2900 up ") -> tidy link fns(mainframe down): printstring("emas down ") tidy: tidy message streams %cycle i = 0, 1, con lim d == con desa(i) %if not allocated < d_state < logging off %start %if d_cnsl=255 %then retrieve(d) %else %start free transient get buffer(send emas down) d_state = logging off %finish %finish %if i&3 = 3 %then set prio(1); ! force re-schedule %repeat host state = down users = -1 %return link fns(message): %if stream = 2 %then d == d2 %if stream = 3 %then d == d3 type = 0 sub ident = m2900_sub ident state = m2900b_b(1); mode = m2900b_b(0) %if mon < 0 %start select output(1) printstring("mess:") write(stream, 1); write(sub ident, 1); write(state, 1) write(m2900_p2b, 1); write(m2900_p3b, 1) newline select output(0) %finish %if sub ident # 0 %start; ! low level %if stream <= 3 %start %if state = connecting %start !! initial logon stream connected host state = up printstring("logon stream connected ") users = 0 %else %if state = enabling %start d_o state = enabld d_state = logged on; ! not quite right, but? d_out lim = m2900_p2b; d_o pos = 0; d_o lim = 0; d_o posx=0 printstring("logon stream enabled ") %finish %if state = disconnecting %start host state = down printstring("logon stream disconnected ") tidy message streams %finish %finish %else %if d_state = not allocated %start %if stream&1 = 0 %start; ! monitor input str only printstring("itps: not allocated problem") write(state, 1); newline %finish -> send reply %finish %if state = enabling %start; ! 1st intersting condition %if stream&1 = 0 %start d_state = input enabled %if d_cnsl = 255 %start; ! gone away type = 1 %else d_in lim = m2900_p2b d_i pos = m2900_p3b get buffer(send go ahead); get buffer(send go ahead) get buffer(send go ahead) %finish %else %if d_out lim # 0 %start %if d_abortf = aborting %start !! an 'aborting' has been done get buffer(send text marker) d_out go = d_out go-1 %finish %finish d_out lim = m2900_p2b; d_o state = enabld d_o pos = m2900_p3b; d_o lim = 0; d_p lim = 0 d_mode = mode>>4; ! 0-iso,x'20'-bin,x'30'-cont %finish %finish %else %if state = disconnecting %start %if stream&1 = 0 %then d_in lim = 0 %else %start d_out lim = 0 d_o state = idle %finish %if d_in lim = 0 %and d_out lim = 0 %start ! both disconnected d_state = logging off get buffer(send disconnect) %finish %finish %else %if state = aborting %or state = suspending %start %if stream&1 # 0 %start; ! output side d_o state = idle; ! stop transfers d_abortf = state; ! remember type get buffer(send kill transmit) %if state = aborting %if %not d_hold == null %then %c free buffer(d_hold) %and d_hold == null %finish %finish %finish m2900_p2a = 0; m2900_p2b = 0 send reply: to 2900(low level control, m2900) %if type # 0 %then get buffer(send the chop) %return %finish !********************************* !* high level message !******************************** %if stream&1 = 0 %and stream > 2 %start; ! input high level trig = m2900_p3b %if d_i pos = trig %start d_p lim = m2900_p2b i = d_o state d_o state = i!pmt p d_pmt n = d_seq bits!terminated!prompt!seq no valid ! hold for use later %if i = enabld %start d_hold == m2900; ! retain buffer get buffer(low level op transfer) %return %finish %finish free buffer(m2900); ! past that position already %else !************************ !* output stream * !************************ %if stream = 3 %start !! update of pointer on message stream p2b = m2900_p2b free buffer(m2900) %if mon < 0 %start write(d_olim, 2); write(d_opos, 2); write(p2b, 2); write(d_out lim, 2); newline %finish get buffer(get op block) %if d_o lim = d_o pos d_o lim = p2b %else !! request output message ! %integer output pos, trig pos d_o lim = m2900_p2b d_o trig = m2900_p3b !! check whether immediate trig reply is needed %if d_o trig >= 0 %start; ! maybe get buffer(send trig reply) %if d_opos = d_olim %or %c (d_oposd_olim %and d_olim<=d_otrig<=d_opos) %finish pf = d_o state; ! keep, to check for prompt bit d_o state = d_o state&(\pmt p); ! discard prompt %if d_o state&out p = 0 %and d_opos # d_olim %start d_ostate = d_ostate!outp %if d_out go > 0 %start; ! allowed to send %if %not d_hold == null %start free buffer(m2900) %else d_hold == m2900 %finish %if pf&pmt p = 0 %start; ! no prompt outst. %if tcp_size >= 5 %or no of small < critical %start d_hold f = 1; tcp_held = tcp_held+1 tcp_h no = tcp_h no+1 free buffer(d_hold); d_hold == null %else get buffer(low level op transfer) %finish %finish %return %finish %finish free buffer(m2900) %finish %finish %end %routine fill(%record (mef) %name mes, %integer no) %integer pt %constbyteintegerarray pts(1:last itp reason) = 1, 10, 19, 25, 31, 37, 38, 42, 42, 42(8), 42, 61, 65, 69 !! pt to itp mess %ownbyteintegerarray itp message(1:74) = 8, 2, k'146', 5, 'U', 's', 'e', 'r', ':',; ! name prompt 8, 0, k'246', 5, 'P', 'a', 's', 's', ':',; ! pass prompt 5, 1, 2, 2, 1, 1,; ! echo on 5, 3, 2, 2, 1, 0,; ! echo off+go ahead 5, 0, 2, 2, 13, nl,; ! nl 0,; ! not used 3, 5, 0, 0,; ! disconnect 18, 0, 2, 15, 13, nl, '*', '*', '2', '9', '0', '0', ' ', 'D', 'o', 'w', 'n', 13, nl,; ! emas down 3, 3, 0, 0,; ! go ahead 3, 1, 8, 0,; ! kill transmit 5, 0, 10, 2, 13, nl; ! nl+text marker pt = pts(no) string(addr(mes_bsp_itp_cnsl)) = string(addr(itp message(pt))) mes_len = itp message(pt)+1; ! cnsl no %end !! r o u t i n e move user name (from big to small buffer) %routine move user name(%record (maf) %name logr) %record (mef) %name mes %string (3) add ! N B ! Total length of addr, name and password must not exceed ! small block max ! Password is truncated if this is so %if d_state # name sent %start printstring("itp:mun fails") write(d_state, 1); newline free buffer(logr); %return %finish mes == d_hold logr_a(1) = 1 logr_a(2) = 0 logr_a(3) = d_stream<<1+fixed ! string(addr(logr_a(4))) = mes_bsp_itp_s ! logr_mlen = length(mes_bsp_itp_s)+5+1 ! until tcp passes address length(add) = 3 charno(add, 1) = tcpa(d_tcp)_node charno(add, 2) = tcpa(d_tcp)_term charno(add, 3) = d_cnsl string(addr(logr_a(4))) = add.mes_bsp_itp_s logr_mlen = logr_a(4) +4+1 free buffer(mes) d_hold == logr %end !! r o u t i n e from buffer manager !! all requests for buffers come back through here %routine from buffer manager(%record (pe) %name p) %integer reason, n, type %record (m2900f) %name m2900 %record (mef) %name mes %record (m2900if) %name mi %conststring (1) the chop = "Y" reason = p_s1; ! get reason for calling p_mes_bsp_rc = reason; ! monitoring n = p_port; ! byte quantity ! %if n >= 254 %then n = n-256 d == con desa(n); ! get console desxcriptor %if mon < 0 %start select output(1); printstring("from buff:") write(p_port, 1); write(n, 1); write(reason, 1) write(d_stream, 1); write(d_state, 1) newline; select output(0) %finish %if d_state = not allocated %then -> free %if reason = store user name %then move user name(p_mes) %andc %return %if reason <= last itp reason %start %if d_cnsl # 255 %start; ! cnsl = 255 - disconnected fill(p_mes, reason); ! insert the message p_mes_bsp_itp_cnsl = d_cnsl tcp == tcpa(d_tcp) to gate(put output, p_mes, 0) %if reason = send emas down %then d_state = logging off %else free: free buffer(p_mes) %finish %if reason = send disconnect %start retrieve(d) %finish %else %if reason=get op block %or reason=get big op block %start %if d_o state = idle %then -> free; ! kill o/p done %unless d_hold==null %then free buffer(d_hold) d_hold == p_mes get buffer(low level op transfer) %return %finish !! message to 2900 reason m2900 == p_mes m2900_stream = d_stream<<1+fixed+reason&1 m2900_sub ident = 10 %if d_stream < 0 %then m2900_stream = 4+d_stream %if reason = low level op transfer %start mes == d_hold %if mes == null %then -> free ! kill op done, so ignore tran request length(mes_bsp_itp_s) = 1 m2900_p2a = k'400'; ! = swab(1) m2900_p2b = swab(d_o pos) %else m2900_p2b = 0; m2900_p2a = 0 %finish type = low level control %if reason = send trig reply %start m2900_sub ident = 0 m2900_p5a = 0; m2900_p5b = swab(d_opos) type = send data d_o trig = -1 %finish %if reason = send the chop %start mi == m2900; mi_sub ident = 0; type = send data mi_p2a = -1; mi_p2b = -1 mi_int = the chop %finish %if mon < 0 %start select output(1) printstring("trf:") write(m2900_stream, 1); write(m2900_sub ident, 1) write(swab(m2900_p2a), 1); write(swab(m2900_p2b), 1) write(d_o lim, 4); write(d_p lim, 1) newline; select output(0) %finish to 2900(type, m2900) %finish %end %routine retrieve(%record (con desf) %name d) %return %if d_state = not allocated %if d_cnsl # 255 %start; ! cnsl = 255 - disconnected tcp == tcpa(d_tcp) con index(d_cnsl+tcp_con state ind) = 0 %finish free transient d_state = not allocated users = users-1 %unless users <= 0 push(free des, d) %end !! r o u t i n e lose consoles(all or a specific one) %routine lose consoles(%integer x) !! throw away connected consoles %integer index, i, t, q index = tcp_con state ind %if x < 0 %then t = max tts-1 %and x = 0 %c %else t = x %cycle i = x, 1, t q = con index(i+index) d == con desa(q) con index(i+index) = 0 %unless q = 0 %start d_cnsl = 255; ! no messages to the tcp now free transient %unless d_state >= logging off %start %if d_state = input enabled %start !! log off 2900 !! nb: the case of "logged on" is catered for when enabled get buffer(send the chop) %else %unless d_state >= logging on %then %c retrieve(d); ! may re-claim immediately %finish %finishelseif d_state=logging off %then retrieve(d) %finish set prio(1) %if i&15 = 15; ! Don't do too many at once %repeat %end %routine read from am1 !! itp server has control of the link %record (mef) %name mes %record (itp3f) %name it %integer i, n, flag, sym, lim, type, t, stat, len mes == d_hold %if mes == null %or d_state = not allocated %start printstring("itp:sequence? ") p_len = 0!128; to 2900(return control, null) %return %finish d_hold == null %if mes_type=0 %then len=bigblockmax-2 %else %c len = small block max-2 it == mes_bsp_itp n = it_a(0) flag = 0 %if d_ostate&out p # 0 %start lim = d_o lim; type = out p %else lim = d_p lim; type = pmt p d_o posx = d_o pos %if n = 1 !! hold beginning of prompt (temporarily) in oposx !! in case it spans the end of buffer %finish %cycle %cycle stat = l_rxs %exit %if 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: p_len = t; ! long block+accept last to 2900(return control, null) d_hold == mes; it_a(0) = n %return %finish %if sym = nl %and d_mode = 0 %start it_a(n) = 13; n = n+1; ! plant cr %finish %if d_o pos = d_out lim %then d_opos = -1 d_o pos = d_o pos+1 it_a(n) = sym %if d_o pos = d_o trig %start; ! send trigger message get buffer(send trig reply) %finish %if d_o pos = lim %start it_hdb2 = terminated d_ostate = d_ostate&(\out p) reply: p_len = 0!128; ! eam1 to reject last char %if type = pmt p %start !! this is actually a prompt - not output it_hdb2 = d_pmt n; ! at time of request d_o pos = d_o posx; ! see comment above at type = pmt p d_ostate = enabld %else d_out go = d_out go-1 %unless d_mode = 3 %finish to 2900(return control, null) it_cnsl = d_cnsl; it_hdb1 = text %if d_mode = 2 %start; ! binary it_hdb2 = it_hdb2!bin b %else %if d_mode = 3 %start; ! set mode it_hdb1 = control; it_hdb2 = set mode %finish %finish it_a(0) = n; ! itp length mes_len = n+1+3; ! cnsl+itp+no of chars %if d_cnsl = 255 %start; ! gone away free buffer(mes) %finish %else to gate(put output, mes, 0) %if (d_ostate > enabld %and d_out go > 0 ) %or %c d_ostate = pmt p!enabld %then get o block %return %finish %if n >= len %start !! leave room for a cr/lf sequence it_hdb2 = 0 -> reply %finish n = n+1 l_rxs = l_rxs!accept char; ! accept the last char %repeat %end %routine write to am1 %record (mef) %name mes %record (itp3f) %name it %integer n, max, char, stat, gah %constinteger cr = 13 mes == d_in mes %if d_state # input enabled %or mes == null %start p_len = 0; ! terminate ->am1 rep; ! reply to am1 hanmdler %finish it == mes_bsp_itp n = mes_bsp_tc+1; ! nb: used when buffer split!!! max = it_a(0) %cycle %cycle stat = l_rxs %if stat&xopl # 0 %then p_len = 64 %and ->am1 rep %if stat&ready # 0 %start !! l i m i t sent p_len = 2; ! long block mes_bsp_tc = n-1; ! store for return am1 rep: to 2900(return control, null) %return %finish %if l_txs&ready # 0 %then %exit %repeat %if n > max %start p_len = 4; ! condition y to 2900(return control, null) gah = mes_bsp_rc; ! missing gah count %if gah > 3 %start; ! remove in due course printstring("itps: gah count =") write(gah, 1); newline gah = 1 %finish free buffer(d_in mes); d_in mes == null d_seq bits = d_seq bits+seq inc get buffer(send go ahead) %and gah = gah-1 %c %while gah >= 0 %return %finish %cycle char = it_a(n) n = n+1 %exit %if char # cr %or it_hdb2&bin b # 0 %repeat l_txd = char %if d_i pos = d_in lim %then d_i pos = -1 d_i pos = d_i pos+1 %repeat %end %routine kick 2900 message(%record (maf) %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 == d2 %if (d_hold == null %and d_inp q_e == null) %or d_in cnt>5 %then %c get buffer(kick message stream) push(d_inp q, log) d_in cnt = d_in cnt+1 %end %routine tidy message streams d2_o state = idle; d3_o state = idle %while %not d2_inp q_e == null %cycle free buffer(pop(d2_inp q)) %repeat %end !! r e a d m e s s a g e f r o m a m 1 %routine read message from am1 %record (maf) %name m %integer n, sym, t, stat, lreply, stream %record (mef) %name mes %integer type %record (itpf) %name itp %switch hlm(1:2) ! d3 is allways used m == d3_hold; d3_hold == null %if m == null %or d3_opos = d3_o lim %start printstring("itp: seq2! ") t = 0!128; -> reply %finish !! (cater for partial block rec'd) n = d3_o posx %if n = 0 %then d3_in cnt = 0 %cycle %cycle stat = l_rxs %exit %if stat&(ready!xopl) # 0 %repeat %if stat&xopl # 0 %start; ! xop gone down t = 64; ! send unsuccessfull printstring("itps: xop d ") -> skip %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 printstring("itps: parity ") -> skip %finish %finish %if stat&comm bit # 0 %start t = 2!128 skip: d3_o posx = n; d3_hold == m reply: p_len = t; ! long block+accept last to 2900(return control, null) %return %finish %if d3_o pos = d3_out lim %then d3_o pos = -1 %if d3_o pos = d3_o lim %then -> badm d3_o pos = d3_o pos+1 %if mon < 0 %start select output(1) printsymbol('i'); write(n, 2); write(sym, 2); space printsymbol(sym) %if sym > 32; newline select output(0) %finish m_a(n) = sym; n = n+1 %if n = 1 %start; ! Got the total length d3_in cnt = m_a(0); ! max = 256 %unless 5 < d3_in cnt <= 64-18 %start ! nb: SMALL buffer is used badm: printstring("***itps: message fails -") write(d3_in cnt, 1); write(d3_o pos, 1); write(d3_out lim, 1) write(d3_o lim, 1); write(type, 1); write(n, 1) printstring(" itp messages lost ") %if n > 0 %start %cycle sym = 0, 1, n write(m_a(sym), 2); newline %if n&15=15 %repeat newline %finish d3_o pos = d3_o lim -> reply %finish %else %if n = d3_in cnt %then -> exit3; ! Got the whole message %finish l_rxs = l_rxs!accept char; ! accept the last char %repeat exit3: d3_o posx = 0; ! full message taken t = 0!128; ! normal+accept last %if d3_o pos # d3_o lim %start; ! Another message waiting d == d3 get buffer(get op block) %finish type = m_a(1); ! max = 256 ! ? x = (8+m_a(4))&x'fffe' stream = m_a(2)<<8!m_a(3) m_m len = n %unless 1 <= type <= 2 %then ->badm d == con desa((stream-fixed)>>1) -> hlm(type) hlm(1): ! Logon Reply lreply = m_a(5) str = string(addr(m_a(6))); ! copy text out of way mes == m; ! make it a network buffer mes_len = length(str)+4 mes_bsp_itp_cnsl = d_cnsl mes_bsp_itp_hdb1 = 0 mes_bsp_itp_hdb2 = 2 mes_bsp_itp_s = str; ! copy text back in tcp == tcpa(d_tcp) to gate(put output, mes, 0) d_out go = d_out go-1 %if l reply = 0 %start d_state = logged on %else d_state = logging off retrieve(d) %if d_cnsl = 255 %finish -> reply hlm(2): ! setmode out, string at m_a(5) %if d_cnsl = 255 %start free buffer(m); -> reply %finish str = string(addr(m_a(5))); ! copy setmode out of the way mes == m; ! change the buffer to an itp one itp == mes_bsp_itp itp_cnsl = d_cnsl itp_hdb1 = control; itp_hdb2 = set mode itp_s = str; ! put the setmode back in mes_len = length(str)+1+3; ! hdr+string+string length tcp == tcpa(d_tcp); ! map to tcp description to gate(put output, mes, 0); ! send the buffer ->reply; ! give control back to am1h %end !! w r i t e m e s s a g e t o a m 1 %routine write message to am1 %record (maf) %name m %integer n, max, am1 reply, stat ! allways use d2 am1 reply = 4; ! "condition y" %cycle m == d2_hold %if m == null %then m == pop(d2_inp q) %and d2_in cnt = d2_in cnt-1 %if m == null %then %exit !! terminate with "normal" (shouldnt happen) n = d2_o posx; ! start of block - d2_o posx = 0 %cycle %cycle stat = l_rxs %if stat&xopl#0 %start d2_hold == m; ! retain buffer for retry am1 reply = 64; d2_hold f = n; ->am1 rep %finish %if stat&ready # 0 %start !! l i m i t sent am1 reply = 2; ! long block d2_o posx = n; d2_o pos = max d2_hold == m; ! retain for later -> am1 rep %finish %if l_txs&ready # 0 %then %exit %repeat %if n > m_a(0) %start free buffer(m) d2_hold == null; d2_o posx = 0; d2_hold f = 0 %if d2_inp q_e == null %then ->am1 rep %exit %finish %if mon < 0 %start select output(1) printsymbol('o'); write(n, 2); write(m_a(n), 2); space printsymbol(m_a(n)) %if m_a(n) > 32; newline select output(0) %finish l_txd = m_a(n); n=n+1 %repeat %repeat am1 rep: p_len = am1 reply to 2900(return control, null) %end %routine mon mes(%record (mef) %name mes) %integer i, j, k, n %record (itp2f) %name itp2 k = mes_len; itp2 == mes_bsp_itp write(k, 1); space; space j = 0 %cycle i = 0, 1, k-1 %if mon > 0 %and i > 3 %start; ! 'p' and not header n = itp2_a(i) printsymbol(n) %unless n = 0 %or n = 4 %else write(itp2_a(i), 1) j = j+1; %if j = 25 %then j = 0 %and newline %finish %repeat newline; select output(0) %end %endofprogram %repeat write(itp2_a(i), 1) 5, 1, 2, 2, 1, 1,; ! echo on