!******************************** !* emas-2900 fep itp server * !* file: xxx1/xxx1y * !* date: 31.may.82 * !******************************** !! stack size = 500 !* !* nsi version - include !n! statements !* ring version - !n! -> !n! and !r! -> {r} !* #if i %control x'4001' %include "b_deimosspecs" #else %control 1 %include "deimosperm" #fi %begin %conststring (13)vsn = "xxx...1a " #datestring %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 = 51; ! 64-4-6-4 %constinteger big block max = 127; ! < 256 ! %constintegername no of big == k'100112'; ! no of free buffs %constintegername no of small == k'100114' %owninteger critical = 15; ! switch off o/p level %recordformat itpf((%byte res, %bytearray a(1:128) %or %string (128) s)) !n! %recordformat lev3f(%bytearray reserved(0:5), %c !n! %record (itpf) itp) ! nb: replaces fn,sufl,st,ss,flag,uflag %recordformat lev3f(%bytearray reserved(0:6), %record (itpf) itp) %recordformat mef(%record (mef) %name link, %c %byteinteger len, type, (%record (lev3f)lev3 %or %c %bytearray params(0:231))) %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 m2900cf(%record (mef) %name l, %byteinteger len, type, %c %integer stream, sub ident, %integerarray pa(0:9)) %recordformat maf(%record (mef) %name l, %byteinteger mlen, %c mtype, %byteintegerarray a(0:240)) %recordformat pe(%byteinteger ser, reply, %c (%integer a, b, (%integer c %or %byte c1, c2) %or %byte fn, a2, %c (%record(mef)%name mes, %byte gate port, task port %or %c %string (3) facility))) %recordformat qf(%record (mef) %name e) !******************************************************** !* 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) !************************************************************ !* upper level (itp&rje) handler messages to gate !************************************************************ %include "b_ygatecalls" !************************************************************** !* 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 = 24 %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 disconnecting tcp = 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 awaiting int = 6 %constinteger logging off = 7; ! 2970 is getting rid of it %constinteger logging off 2 = 8; ! 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 i 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 login reply = 8; ! logon successful ! %constinteger send login fails 1 = 9; ! 9-17 %constinteger send emas down = 18 %constinteger Send int = 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) %routinespec mon p(%record (pe) %name p) !****************************************************** %record (pe) p %ownrecord (tcpf) %name tcp %owninteger tcpn %ownrecord (con desf) %name d %ownrecord (qf) free des; ! holds free descriptors %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 max calls = 50 %constinteger tcp limit = max calls; ! increase con statea as well !!!!!!! %ownrecord (tcpf) %array tcpa(0:tcp limit) %constinteger con lim = max calls; ! number of active terminals %ownrecord (con desf) %array con desa(-2:con lim) %constinteger max ports = 50 ! cross index from port to tcp %constinteger max tts = 49; ! ie 0 to 48 %owninteger mon = 0; ! monitoring flag %owninteger lose op = 0; ! discard output for erte %constintegername users == k'100014'; ! no of users in buffer seg %owninteger messflag = 1 %integer i, n %ownstring (63) str %ownstring (1) snil = "" !n! %constinteger header len = 6 !r! %constinteger header len = 2 %constinteger header len = 0 !********************************************** !* initialisation * !********************************************** change out zero = t3 ser first d == con desa(0) %cycle i = con lim, -1, 0 push(free des, con desa(i)) %repeat n = 0 %cycle i = 1, 1, tcp limit tcp == tcpa(i) tcp_tcpn = i %repeat d2 == con desa(-2) d2_stream = -2 d3 == con desa(-1) d3_stream = -1 printstring(vsn) #if i printstring("new ") #fi printstring(datestring); newline #if i map hwr(3); ! map am1 to seg 3 #else map hwr(0); ! map am1 to segment 0 #fi 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_c = 2; ! param for 'here i am' to 2900(here i am, null) p_c = 3; ! and claim stream 3 to 2900(here i am, null) tcp == tcpa(0); ! dummy for below p_ser = gate ser; p_reply = own id p_fn = enable facility; p_a2 = 0 p_facility = "XXX" pon(p) !********************************************** !* 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, 3) write(tcp_held, 3); write(tcp_h no, 5) write(tcp_con state ind, 4) 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("xxx: 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 %or fn = control data %start %if tcp_state # connected %start; ! throw away free buffer(mes); %return %finish %if addr(mes)&k'140000' = k'140000' %then crunch; ! had it tcp_size = tcp_size+1 tcp_max = tcp_size %if tcp_size>tcp_max d_out go = d_out go-1 %if d_out go = 255 %then d_out go = 0; ! not negative %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_gate port = tcp_port; p_mes == mes p_a2 = flag p_task port = tcp_tcpn %if mon # 0 %start select output(1); spaces(5) printstring("xxx: to gate:"); mon p(p) select output(0) %finish 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_c2 = reason p_a2 = 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_c1 = 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 %string (127) %fn unpack(%record (mef) %name mes, %integer no) %integer i, l %unless mes == null %or mes_len<=0 %or no<=0 %start l = 0 %while no>1 %cycle l=l+mes_params(l)+1 no = no-1 %repeat %result = string(addr(mes_params(l))) %finish %else %result = "" %end %routine pack(%record(mef) %name mes, %string (*) %name s) string(addr(mes_params(mes_len))) = s mes_len = mes_len+length(s)+1 %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 %return %if d_state = awaiting int 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(connect:Control Data) %string (63) calling %string (23) qual fn = p_fn tcpn = p_task port tcp == tcpa(tcpn) mes == p_mes %if mon # 0 %start select output(1); spaces(5) printstring("xxx: from gate:") mon p(p) select output(0) %finish ->fns(fn) fns(Connect): tcp == null %cycle tcpn = tcp limit, -1, 1 targ == tcpa(tcpn) %if targ_state = not allocated %then tcp == targ %repeat %if tcp == null %start ! 2900 down or full up tcp == tcpa(0) tcp_port = p_gate port; ! for 'to gate' call only to gate(Disconnect, null, 17) %return %finish tcp_state = connected; tcp_ostate = idle tcp_port = p_gate port tcp_node = 0; ! ?????? calling = unpack(mes, 2) qual = unpack(mes, 3) %if messflag=1 %start printstring(" xxx: ") printstring(calling) printstring(" connected ") %finish tcp_max = 0; ! for monitoring mes_len = 0 pack(mes, snil) pack(mes, qual) pack(mes, snil) to gate(accept call, mes, 0) ! to gate(enable input, null, 1); ! out till pre-ack gate ready %return fns(input here): %if mes_len <= 0 %start free buffer(mes) %return %finish to gate(enable input, null, 1) %if mon < 0 %start select output(1) printstring("ii "); mon mes(mes) %finish mes_lev3_reserved(0) = 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(enable output): tcp_ostate = idle tcp_size = tcp_size-1 d == con desa(tcpn) d_out go = d_out go+1 %unless d_out go > 2 %if d_out go = 1 %and d_ostate > enabld %start get o block %finish %return ! ring vsn? %return; ! handled in 'input recd' fns(Expedited): ! int: etc get buffer(Send int) d_state = awaiting int %return fns(Disconnect): ! Call has been cleared flag = p_a2; ! pickup reason for close %if messflag=1 %start printstring(" t"); write(tcp_term, 1) printstring(" connection ") %if flag = 0 %then printstring("aborted") %else %c printstring("closed") write(flag, 1) write(tcp_max, 1); newline %finish lose consoles(-1) to gate(disconnect, null, 1) tcp_state = not allocated free buffer(mes) %unless mes == null tcp_max = 0 %return fns(Reset): printstring("Reset rec'd ") mon mes(mes) %return fns(Control Data): printstring("Control data in:") mon mes(mes) %end %integerfn analyse itp message(%record (mef) %name mes) %record (itpf) %name itp, itp2 %integer cnsl, index, stream, len, q, x, res %record (maf) %name m %record (m2900if) %name mi %string (15) int mes %switch console state(idle:logging off 2) itp == mes_lev3_itp itp_res = mes_len; ! nb: overwrites last byte of header %unless tcp_con state ind = 0 %start d == con desa(tcp_con state ind) ->console state(d_state) %finish console state(not allocated): ! eg no descriptor d == pop(free des) %if d == null %then -> get rid of it stream = d_stream; ! hold the stream d = 0; ! zero the record d_stream = stream d_tcp = tcpn; d_cnsl = cnsl tcp_con state ind = stream d_state = name sent; ! if down, goes to logging off whe 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 console state(name sent): ! user name arrived ? %if addr(d_hold)&k'140000'=k'140000' %then printstring("name?")%and crunch d_state = pass sent get buffer(put echo off); ! switch echo off get buffer(send pass prompt); ! send pass: %if length(itp_s) > 1 %then length(itp_s) = length(itp_s)-1 %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 %result = -1; ! de-alloctae block console state(pass sent): ! password arrived ?? %if addr(d_hold)&k'140000'=k'140000' %then printstring("pass?")%and crunch 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) > 1 %then length(itp_s) = length(itp_s)-1 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 kick 2900 message(m); ! nb: disturbs 'd' p_c = index; ! param for 'here i am' to 2900(here i am, null) p_c = index+1; ! param for 'here i am' to 2900(here i am, null) %result = -1 console state(awaiting int): d_state = input enabled int mes = itp_s; ! copy it out of the way len = length(int mes); ! check for cr, nl & nl len = len-1; ! delete the cr len = 15 %if len > 15 %if len <= 0 %then res = -1 %else %start; ! invalid length(int mes) = 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 = int mes; ! copy string accross to 2900(send data, mi); ! send to am1h res = 2; ! don't deallocate buffer %finish %if d_o state > enabld %and d_out go >0 %then get o block %result = res console state(logging on): ! go ahead only? console state(logged on): ! still no input %result = -1 console state(input enabled): ! input messages and ints %if %not d_in mes == null %start d_seq bits = d_seq bits+seq inc itp2 == d_in mes_lev3_itp d_in mes_lev3_reserved(0) = d_in mes_lev3_reserved(0)+1; ! missing gah count %unless length(itp_s)+length(itp2_s)>240 %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_lev3_reserved(1) = 0; ! pos in block flag = 0 %result = 2 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 %record (m2900cf) %name m2900c %record (mef) %name mes %integer stream, sub ident, state, trig, l reply, 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_c %finish d == con desa((stream-fixed)>>1) tcp == tcpa(d_tcp) -> link fns(p_fn) link fns(interf addr): ! interface addr from eam5 #if i l == record(addr(p_mes)&k'17777'!k'060000'); ! put in seg 3 #else l == record(addr(p_mes)&k'17777'); ! force to seg 0 #fi %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 d_state # not allocated %and d_cnsl=255 %then %c retrieve(d) %else %start %if not allocated < d_state < logging off %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("xxx: 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 %finish %else 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 %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 ! 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) 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 m2900_p3a = k'050505'; ! diagnostic purposes !! 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 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 tcp_size>=4 %or no of small < critical %start d_hold f = 1; tcp_held = tcp_held+1 free buffer(d_hold); d_hold == null %else get buffer(low level op transfer) %finish %return %finish %finish free buffer(m2900) %finish %finish %end %routine fill(%record (mef) %name mes, %integer no) %integer n, pt, max %constbyteintegerarray pts(1:last itp reason) = 1, 10, 19, 26, 33, 39, 40, 45, 45, 45(8), 45, 64, 74, 74 !! pt to itp mess %ownbyteintegerarray itp message(1:79) = 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, 3, 2, 2, 1,; ! echo on 5, 3, 2, 3, 2, 2, 0,; ! echo off 5, 0, 2, 2, 13, nl,; ! nl 0,; ! not used 3, 5, 0, 1, 1,; ! i disconnect 18, 0, 2, 15, 13, nl, '*', '*', '2', '9', '0', '0', ' ', 'D', 'o', 'w', 'n', 13, nl,; ! emas down 0, 0, 0, 6, 13, nl, 'I', 'n', 't', ':',; ! send Int: 0, 0, 0, 2, 13, nl; ! nl pt = pts(no) mes_lev3_itp_s = string(addr(itp message(pt+3))) mes_len = length(mes_lev3_itp_s) %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("xxx: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 string(addr(logr_a(4))) = add.mes_lev3_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, type, call ty %record (m2900f) %name m2900 %record (mef) %name mes %record (m2900if) %name mi %conststring (1) the chop = "Y" reason = p_c2; ! get reason for calling !n! n = p_gate port; ! byte quantity ! n = p_a2 %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_gate 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 call ty = put output %if 3<=reason<=4 %or reason = 7 %then call ty = Control data tcp == tcpa(d_tcp) to gate(call ty, 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 %or d_state = awaiting int %then -> free ! kill op done, so ignore tran request length(mes_lev3_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) %record (tcpf) %name tcp %return %if d_state = not allocated %if d_cnsl # 255 %start; ! cnsl = 255 - disconnected tcp == tcpa(d_tcp) tcp_con state ind = 0; ! only one user in XXX %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 q = tcp_con state ind %unless q = 0 %start d == con desa(q) 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 not catered for 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 %end %routine read from am1 !! itp server has control of the link %record (mef) %name mes %record (itpf) %name it %integer n, flag, sym, lim, type, t, stat, len mes == d_hold %if mes == null %or d_state = not allocated %start printstring("xxx:sequence? ") p_c1 = 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_lev3_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_c1 = 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 d_ostate = d_ostate&(\out p) reply: p_c1 = 0!128; ! eam1 to reject last char %if type = pmt p %start !! this is actually a prompt - not output d_o pos = d_o posx; ! see comment above at type = pmt p d_ostate = enabld %else %finish to 2900(return control, null) mes_len = n+header len; ! no of chars %if d_cnsl = 255 %start; ! gone away free buffer(mes) %else %if type # out p %or lose op = 0 %then %c to gate(put output, mes, 0) %else %c free buffer(mes) %finish %if d_out go > 0 %and d_ostate > enabld %then %c get o block %return %finish %if n >= len %start !! leave room for a cr/lf sequence -> 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 (itpf) %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_c1 = 0; ! terminate ->am1 rep; ! reply to am1 hanmdler %finish it == mes_lev3_itp n = mes_lev3_reserved(1)+1; ! pos in buffer, when buffer split max = it_a(0) %if mon < 0 %start select output(1); printstring("inp:") printstring(string(addr(it_a(0)))); newline; select output(0) %finish %cycle %cycle stat = l_rxs %if stat&xopl # 0 %then p_c1 = 64 %and ->am1 rep %if stat&ready # 0 %start !! l i m i t sent p_c1 = 2; ! long block mes_lev3_reserved(1) = n-1 am1 rep: to 2900(return control, null) %return %finish %if l_txs&ready # 0 %then %exit %repeat %if n > max %start p_c1 = 4; ! condition y to 2900(return control, null) free buffer(d_in mes); d_in mes == null %return %finish char = it_a(n) char = nl %if char = cr; ! forwarding on cr, with no lf n = n+1 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_incnt>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("xxx: 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("xxx: 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("xxx: parity ") -> skip %finish %finish %if stat&comm bit # 0 %start t = 2!128 skip: d3_o posx = n; d3_hold == m reply: p_c1 = 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("***xxx: 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) %if d_state = not allocated %start; ! user has disconnected etc printstring("xxx: Invalid logon reply ") free buffer(m) -> reply %finish -> 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 +header len mes_lev3_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 get buffer(send disconnect); ! immediate request to go %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_lev3_itp itp_s = str; ! put the setmode back in mes_len = length(str)+4+header len; ! hdr+string+string length tcp == tcpa(d_tcp); ! map to tcp description !?! to gate(put output, mes, 0); ! send the buffer FREE BUFFER(MES); ! CANT HANDLE SETMODE ->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_c1 = am1 reply to 2900(return control, null) %end %routine mon mes(%record (mef) %name mes) %integer i, j, k, n %record (itpf) %name itp k = mes_len; itp == mes_lev3_itp write(k, 1); space; space j = 0 %cycle i = 1, 1, k %if mon > 0 %and i > 3 %start; ! 'p' and not header n = itp_a(i) printsymbol(n) %unless n = 0 %or n = 4 %else write(itp_a(i), 1) j = j+1; %if j = 25 %then j = 0 %and newline %finish %repeat newline; select output(0) %end %routine mon p(%record (pe)%name p) %integer i printstring(" fn ="); write(p_fn, 1) printstring(" gate port"); write(p_gate port, 1) printstring(" task port"); write(p_task port, 1) printstring(" a2"); write(p_a2, 1) %if %not p_mes == null %start newline; spaces(5) write(p_mes_len, 3) %cycle i = 1, 1, 25 write(p_mes_params(i), 2) %repeat %finish newline %end %endofprogram