!******************************** !* emas-2900 fep itp server * !* file: x25_xxx3s/xxx3y * !******************************** !! stack size = 500 !* #options ! b = Big Buffer Manager ! a = Amdahl FEP #if i %control x'4001' %include "b_deimosspecs" #else %control 1 %include "deimosperm" #fi %begin %conststring (13)vsn = "xxx...3a " #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 #if ~b %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' #else %constinteger small block max = 115; ! 128-4-6-4 %constinteger big block max = 127; ! for P=128/128 calls %constinteger big 256 len = 254; ! < 256 %constintegername no of big == k'120040'; ! no free big buffs %constintegername no of small == k'120042';! no free small buffs #fi %owninteger critical = 15; ! switch off o/p level %recordformat itpf((%byte res, %bytearray a(1:128) %or %string (128) s)) #if ~b %recordformat lev3f(%bytearray reserved(0:6), %record (itpf) itp) %recordformat ts29f(%bytearray reserved(0:7), %record (itpf) itp) %recordformat mef(%record (mef) %name link, %c %byteinteger len, type, (%record (lev3f)lev3 %or %c %record(ts29f)ts29 %or %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))) #else %recordformat lev3f(%bytearray reserved(0:4), %record (itpf) itp) %recordformat ts29f(%bytearray reserved(0:5), %record (itpf) itp) %recordformat mef(%Integer buff no, len, %c %byteinteger owner, type, (%record (lev3f)lev3 %or %c #if ~a %record(ts29f)ts29 %or %bytearray params(0:231))) #else %record (ts29f)ts29 %or %bytearray params(0:231) %or %c %integer kick to go, from flag, spare, %bytearray a(0:240))) #fi %recordformat m2900f(%Integer buff no, len, %byteinteger owner, type, %c %integer stream, sub ident, %c #if ~a p2a, p2b, p3a, p3b, p4a, p4b, p5a, p5b, p6a, p6b) #else p2a, p2b, p3a, p3b, p4a, p4b, p5a, p5b, p6a, p6b, trf buff) #fi %recordformat m2900bf(%Integer buff no, len, %byteinteger owner, type, %c %integer stream, sub ident, %c %byteintegerarray b(0:19)) %recordformat m2900if(%Integer buff no, len, %byteinteger owner, type, %c %integer stream, sub ident, p2a, p2b, %string (15) int) %recordformat m2900cf(%Integer buff no, len, %byteinteger owner, type, %c %integer stream, sub ident, %integerarray pa(0:9)) %recordformat maf(%Integer buff no, mlen, %byteinteger owner, %c #if ~a mtype, %byteintegerarray a(0:240)) #else mtype, %bytearray reserved(0:5), %bytearray a(0:240)) #fi %recordformat pe(%byteinteger ser, reply, %c (%integer a, b, (%integer c %or %byte c1, c2) %or %byte fn, a2, %c (%Integer buff no, %byte gate port, task port %or %c %string (3) facility))) #fi %recordformat qf(%record (mef) %name e) !******************************************************** !* formats of tables, ie stream descriptors, tcps etc * !******************************************************** #if ~b %recordformat con desf(%record (mef) %name hold, %c #else %recordformat con desf(%Integer hold, %c #fi %integer state, stream, %byteinteger o state, out go, %c in cnt, tcp, cnsl, seq bits, pmt n, mode, hold f, abortf, %c imode, kick, %c %integer trig, i pos, opos, o lim, o trig, p lim, %c in lim, out lim, o posx, %c #if ~b (%record (mef) %name in mes %or %record (qf) inp q)) #else %integer hold i, %record (qf) inp q) #fi %recordformat cons statef(%record (con desf) %name con des) %recordformat tcpf(%integer state, con state ind, %c held, h ind, h no, %byteinteger port, tsf, tcpn, term, %c size, max, P256, spare, %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 !************************************************************** !* 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 welcome = 10 ! %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 pad params = 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 do enable facility(%string (11) address) %routinespec handle clock %routinespec get o block %routinespec to gate(%integer fn, %record (mef) %name mes, %c %integer flag) #if ~b %routinespec to 2900(%integer fn, %record (m2900f) %name m2900) #else %routinespec to 2900(%integer fn, buff no) #fi %routinespec get buffer(%integer reason) #if b %routinespec free buff no(%integer buff no) #fi %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 (mef) %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 #if ~a %constinteger fixed = 198; ! 1st available stream (out of itp way) #else %constinteger fixed = 20; ! 1st available stream #fi #if ~a %constinteger max calls = 25; ! reduced because of stream limitations #else %constinteger max calls = 50; ! only XXX, so can be greater than 2900 #fi %constinteger tcp limit = max calls; ! increase con statea as well !!!!!!! %ownrecord (tcpf) %array tcpa(0:tcp limit) %ownstring(21) %array tnames(0:tcp limit) %constinteger con lim = max calls; ! number of active terminals %ownrecord (con desf) %array con desa(-2:con lim) %constinteger max tts = 49; ! ie 0 to 48 %owninteger mon = 0; ! monitoring flag %owninteger bh = 0; ! no of buffers held by Task %owninteger held = 0; ! no of conversations held for buffer shortage %owninteger theld = 0; ! Total no held ever %owninteger lose op = 0; ! discard output for erte #if ~b %constintegername users == k'100014'; ! no of users in buffer seg #else %constintegername users == k'120014'; ! no of users in buff seg (my seg 5) #fi %owninteger messflag = 0 %integer i, n %ownstring (63) str %ownstring (1) snil = "" %constinteger header len = 0 #if b %recordformat hold bufff(%record (hold bufff) %name link, %integer buff no) %ownrecord (holdbufff) %array hba(0:100) %ownrecord (holdbufff) %name free hold #fi !********************************************** !* initialisation * !********************************************** change out zero = t3 ser first d == con desa(0) %cycle i = con lim, -1, 1 push(free des, con desa(i)) con desa(i)_stream = 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 #if b %cycle i = 100, -1, 2 hba(i-1)_link == hba(i) %repeat free hold == hba(1) #fi printstring(vsn) #if i printstring("new ") #fi printstring(datestring); newline #if i map hwr(3); ! map am1 to seg 3 #else #if ~a map hwr(0); ! map am1 to segment 0 #fi #fi #if ~b i = map virt(buffer manager, 5, 4); ! map buff man stack to seg 4 i = map virt(buffer manager, 6, 5); ! and second seg #else i = map virt(buffer manager, 6, 5); ! stack seg to my 5 #fi users = 0 p_c = 8 #if ~b to 2900(here i am, null) #else to 2900(here i am, 0) #fi p_c = 9 #if ~b to 2900(here i am, null) #else to 2900(here i am, 0) #fi tcp == tcpa(0); ! dummy for below do enable facility("XXX") do enable facility("TS29") alarm(50) !********************************************** !* main loop * !********************************************** %cycle p_ser = 0; poff(p) %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 %start from buffer manager(p) %finish %else %if p_reply = 0 %then handle clock %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'100000' %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 > 250 %then d_out go = 0; ! not negative %if mon < 0 %start select output(1) printstring("To Tcp "); mon mes(mes) %finish %finish p_ser = gate ser; p_reply = own id #if ~b p_fn = fn; p_gate port = tcp_port; p_mes == mes #else p_fn = fn; p_gate port = tcp_port %if mes == null %then p_buff no = 0 %else p_buff no = mes_buff no #fi 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 #if ~b bh = bh-1 %unless p_mes == null #else bh = bh-1 %unless p_buff no = 0 #fi pon(p) %end #if ~b %routine to 2900(%integer fn, %record (m2900f) %name m2900) #else %routine to 2900(%integer fn, buff no) #fi p_ser = link handler; p_reply = own id #if ~b p_fn = fn; p_mes == m2900 bh = bh-1 %unless m2900 == null #else p_fn = fn; p_buff no = buff no bh = bh-1 %unless buff no = 0 #fi pon(p) %end %routine get buffer(%integer reason) %record (pe) p %integer type #if b %record (holdbufff) %name hb #fi !******************************************************* !* 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 #if ~b p_mes == buffer pool; buffer pool == p_mes_link p_mes_link == null #else hb == buffer pool buffer pool == hb_link p_buff no = hb_buff no hb_link == free hold free hold == hb #fi no of buff = noof buff-1; from buffer manager(p) bh = bh-1 %finish %end #if b %routine free short buff(%integer buff no) %record (holdbufff) %name hb %if no of buff > 10 %or no of small < 20 %then free buff no(buff no) ! send it back if we hold too many or there is a shortage hb == free hold; free hold == hb_link hb_buff no = buff no hb_link == buffer pool buffer pool == hb no of buff = no of buff+1 %end #fi %routine free buffer(%record (mef) %name mes) %record (pe) p #if ~b %if addr(mes)&k'140000' # k'100000' %then crunch #else %if mes_buff no < k'4000' %or mes_buff no > k'7777' %then crunch #fi #if ~b %if mes_type=0 %or no of buff>4 %or no of small < 20 %start #else %if mes_type = 0 %start #fi p_ser = buffer manager; p_reply = own id !! queue it if it is a short buffer #if ~b p_fn = release buffer; p_mes == mes #else p_fn = release buffer; p_buff no = mes_buff no #fi bh = bh-1 pon(p) %else !! short buffer, so queue it #if ~b mes_link == buffer pool; buffer pool == mes no of buff = no of buff+1 #else free short buff(mes_buff no) #fi %finish %end #if b %routine bpush(%record (qf) %name q, %integer buff no) %record (hold bufff) %name bf bf == free hold free hold == bf_link bf_buff no = buff no push(q, bf) %end %integerfn bpop(%record (qf) %name q) %record (hold bufff) %name bf %integer x bf == pop(q) %result = 0 %if bf == null; ! none left in q x = bf_buff no bf_link == free hold free hold == bf %result = x %end %record (mef) %map map(%integer buff no) ! buff no is already in r0 - where its wanted %result == null %if buff no = 0 *mov_#8,1; ! desired vm seg no *2 ie 4*2 *mov_#k'2006',2; ! lenght of segment *iot %result == record(k'100000'); ! map to base of seg 4 %end %record (mef) %map map0(%integer buff no) ! buff no is already in r0 - where its wanted %result == null %if buff no = 0 *mov_#0,1; ! desired vm seg no *2 ie 0*2 *mov_#k'2006',2; ! lenght of segment *iot %result == record(k'000000'); ! map to base of seg 0 %end %routine free buff no(%integer buff no) ! not mapped, so send it straight back %record (pe) p %return %if buff no = 0; ! rest of code is very loose on this p_ser = buffer manager; p_reply = id p_fn = release buffer p_buff no = buff no pon(p) bh = bh+1 %end #fi %routine handle clock %integer i %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) printstring(", bh ="); write(bh, 1) printstring(", held ="); write(held, 1) printstring(", tot h ="); write(theld, 1); newline printstring("term qu mq held no held sta goah ") %cycle i = 1, 1, tcp limit tcp == tcpa(i) %if tcp_state = connected %start write(tcp_tcpn, 3) %if tcp_tsf = 0 %then printstring(" X ") %else %c printstring(" T ") printstring(tnames(i)) write(tcp_size, 3); write(tcp_max, 3) write(tcp_held, 3); write(tcp_h no, 5) write(tcp_con state ind, 4) %if tcp_con state ind # 0 %start d == con desa(tcp_con state ind) junk label: write(d_state, 1) write(d_outgo, 1) %finish newline tcp_max = 0 %finish %repeat %finish %if int = 'C' %start select output(1) close output printstring("Done ") %finish int = 0 %finish %if held # 0 %and no of small > critical %and no of big > critical %start %cycle i = 1, 1, con lim tcp == tcpa(i) %if tcp_held # 0 %start held = held-1; tcp_held = 0 %if tcp_con state ind # 0 %start d == con desa(tcp_con state ind) %if d_o state > enabld %then get o block %and %return %finish %finish %repeat held = 0 %finish alarm(50) %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 handle x3 inmode(%record (mef) %name mes, %string (*) %name x) %record (maf) %name m d == con desa(tcp_con state ind) %if tcp_con state ind = 0 %or d_state = not allocated %start free buffer(mes); ! free it %else %if mon < 0 %start write(tcp_con state ind, 1); write(d_state, 1); newline %finish str = x; ! 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 %finish to gate(enable input, null, 1); ! ack buffer to gate %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>20 %then %c get buffer(get big op block) %else %c get buffer(get op block) %end %routine do enable facility(%string (11) address) #if b %record (mef) %name mes #fi p_ser = buffer manager; p_reply = id p_fn = request buffer ponoff(p) p_ser = gate ser; p_reply = own id p_fn = enable facility; p_a2 = 1 #if ~b string(addr(p_mes_params)) = address #else mes == map(p_buff no) string(addr(mes_params)) = address #fi pon(p) %end %routine from gate %record (mef) %name mes %record (tcpf) %name targ %integer fn, flag, type, x, q, stream, buff no %switch fns(connect:Control Data) %string (63) calling %string (23) qual fn = p_fn tcpn = p_task port tcp == tcpa(tcpn) #if ~b mes == p_mes bh = bh+1 %unless mes == null #else buff no = p_buff no mes == map(buff no) %unless mes == null %start bh = bh+1 mes_owner = own id; ! mark it as mine %finish #fi %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 reject it: tcp == tcpa(0) tcp_port = p_gate port; ! for 'to gate' call only to gate(Disconnect, null, 17) free buffer(mes) %return %finish d == pop(free des); ! find a descriptor -> reject it %if d == null; ! run out tcp_state = connected tcp_port = p_gate port qual = unpack(mes, 1); ! celled address %if qual -> qual.("TS").qual %then tcp_tsf = 1 %else tcp_tsf = 0 qual = unpack(mes, 3); ! real qual of service this time #if ~b %if qual -> calling.("P=256/256").str %then %c qual = calling."P=128/128".str #else %if qual -> calling.("P=256/256").str %then %c tcp_p256 = 1 %else tcp_p256 = 0 #fi calling = unpack(mes, 2) %if messflag=1 %start printstring(" xxx: ") printstring(calling) printstring(" connected ") %finish tcp_max = 0; tcp_size = 0; tcp_held = 0; ! for monitoring %if charno(calling, 2) = '.' %start %unless calling -> ("2.").calling %then x = 0 %finish %if length(calling)>20 %then length(calling) = 20 tnames(tcp_tcpn) = calling mes_len = 0 pack(mes, snil) pack(mes, qual) pack(mes, snil) to gate(accept call, mes, 0) stream = d_stream; ! hold the stream d = 0; ! zero the record d_stream = stream d_tcp = tcp_tcpn; d_cnsl = 0 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) %return %finish get buffer(send pad params) get buffer(send name prompt) users = users+1 #if ~b d_hold == null #else d_hold = 0 #fi get buffer(store user name) %return fns(input here): %if mon < 0 %start select output(1) printstring("From Tcp "); mon mes(mes) %finish flag = -1; ! enable input if zero length packet %if mes_len > 0 %start mes_lev3_reserved(0) = 1; ! missing gah count flag = analyse itp message(mes) %if flag > 0 %then %return %finish #if ~b free buffer(mes) #else free buff no(buff no) #fi to gate(enable input, null, 1) %if flag < 0 ! flag > 0 - going to 2900 ! flag = 0 - free, but no ack ! flag < 0 - may be freed %return fns(enable output): tcp_size = tcp_size-p_a2 tcp_size = 0 %if tcp_size > 250; ! byte quantity ! %return %if tcp_con state ind = 0 d == con desa(tcp_con state ind) d_out go = d_out go+1 %unless d_out go > 2 %if d_out go = 1 %and d_ostate > enabld %start %if no of small < critical %or no of big < critical %start tcp_held = 1; held = held+1; theld = theld+1 %finish %else get o block ! global control for buffer management ! output is held in EMAS if buffers are low %finish %return fns(Expedited): ! int: etc %unless tcp_con state ind = 0 %start d == con desa(tcp_con state ind) junk label2: %if d_state = input enabled %start get buffer(Send int) d_state = awaiting int %finish %finish #if ~b free buffer(mes) %unless mes == null #else free buff no(buff no) %unless buff no = 0 #fi %return fns(Disconnect): ! Call has been cleared flag = p_a2; ! pickup reason for close free buffer(mes) %unless mes == null %if messflag=1 %start printstring(" t"); write(tcp_tcpn, 1) printstring(" connection ") printstring("cleared") write(flag, 1) write(tcp_max, 1); newline %finish lose consoles(-1) to gate(disconnect, null, 1) %unless tcp_state = disconnecting tcp tcp_state = not allocated tcp_max = 0 %return fns(Reset): printstring("X:Reset rec'd ") %unless mes == null %start mon mes(mes) free buffer(mes) %finish to gate(Disconnect, null, 1) tcp_state = disconnecting tcp %return fns(Control Data): %if mon < 0 %start printstring("XXX:Control data in:") mon mes(mes) %finish mes_lev3_itp_res = mes_len handle x3 inmode(mes, mes_lev3_itp_s) %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 %record (ts29f) %name ts29 %string (16) int mes %switch console state(idle:logging off 2) %if tcp_tsf = 0 %then itp == mes_lev3_itp %else %c itp == mes_ts29_itp %and mes_len = mes_len-1 x = itp_res; ! hold it for ts29 in mode itp_res = mes_len; ! nb: overwrites last byte of header %if tcp_tsf # 0 %and x = 128 %start; ! ts29 & control data handle x3 inmode(mes, itp_s) %result = 2; ! chuck buffer, no ack %finish %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 printstring("oops") write(tcp_tcpn, 1); newline %result = -1 console state(name sent): ! user name arrived ? #if ~b %if d_hold == null %start; ! no buffer to put name into !! #else %if d_hold = 0 %start; ! no buffer to put name into !! #fi to gate(disconnect, null, 253); ! so get rid of conn tcp_state = disconnecting tcp %result = -1 %finish d_state = pass sent get buffer(put echo off); ! switch echo off get buffer(send pass prompt); ! send pass: str = itp_s; ! copied for big buffer version %if length(str) > 2 %then length(str) = length(str)-1 %if charno(str,length(str))=13 %then length(str) = %c length(str)-1 %if length(str) > 20 %then length(str) = 20 #if ~b m == d_hold; ! pickup buffer with 'address' #else m == map(d_hold); ! map onto buffer with 'calling' #fi string(addr(m_a(m_mlen))) = str m_mlen = m_mlen+length(str)+1 %result = -1; ! de-alloctae block (mes) console state(pass sent): ! password arrived ?? str = itp_s; ! copy it out of the way (big buffer vsn) get buffer(send nl); ! send out a newline get buffer(put echo on); ! put echo back on #if ~b m == d_hold #else m == map(d_hold); ! get saved block #fi !! check that it has switched buffers?? %if length(str) > 2 %then length(str) = length(str)-1 %if charno(str,length(str))=13 %then length(str)= %c length(str)-1 index = d_stream<<1+fixed x = m_mlen %if x+length(str) > small block max %then %c length(str) = small block max-x string(addr(m_a(x))) = str; ! put in password x = x+length(str) m_a(0) = x d_state = logging on #if ~b d_hold == null #else d_hold = 0; ! block has gone to 2900 #fi kick 2900 message(m); ! nb: disturbs 'd' p_c = index; ! param for 'here i am' #if ~b to 2900(here i am, null) #else to 2900(here i am, 0) #fi p_c = index+1; ! param for 'here i am' #if ~b to 2900(here i am, null) #else to 2900(here i am, 0) #fi %result = -1 console state(awaiting int): d_state = input enabled %if itp_res > 16 %then itp_res = 16 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 %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 #if ~b to 2900(send data, mi); ! send to am1h #else to 2900(send data, mi_buff no) #fi to gate(enable input, null, 1); ! horrible - flag 'res' too complicated 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 ~b %if %not d_in mes == null %start d_seq bits = d_seq bits+seq inc %if tcp_tsf = 0 %then itp2 == d_in mes_lev3_itp %else %c itp2 == d_in mes_ts29_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 %start itp2_s = itp2_s.itp_s %finish %else printstring("XXX:Data Ditched ") %result = 0; ! chuck the buffer, but NO ack %finish d_in mes == mes #else #if a mes_kick to go = 1; ! for now, always kick the process mes_from flag = 12; ! start of data ! NB: All output from the DX11 MUST start on an even ! boundary, so it will be necesssary to MOVE ts29 ! data up a byte #fi %if d_holdi # 0 %start; ! data first in holdi, then q'd bpush(d_inp q, mes_buff no) %else d_holdi = mes_buff no get buffer(low level ip transfer); ! signal to 2900 input here mes_lev3_reserved(1) = 0; ! pos in block flag = 0 #if b %finish #fi %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 ~b %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 #else %if %not d_hold i = 0 %then free buff no(d_holdi) %and d_holdi=0 %if %not d_hold = 0 %then free buff no(d_hold) %and d_hold =0 %while %not d_inp q_e == null %cycle free buff no(bpop(d_inp q)) %repeat #fi %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, buff no %integer type, p2b, pf, p2a, p3b %switch link fns(interf addr:mainframe down) #if ~b m2900 == p_mes; m2900b == m2900 #else buff no = p_buff no m2900 == map(buff no); m2900b == m2900 #fi %if p_fn = message %start stream = m2900_stream; ! get first stream no #if b m2900_owner = own id #fi %else %if p_fn > message %or p_fn = interf addr %then ->link fns(p_fn) stream = p_c %finish d == con desa((stream-fixed)>>1) tcp == tcpa(d_tcp) %unless stream < fixed; ! control streams -> link fns(p_fn) link fns(interf addr): ! interface addr from eam5 #if i #if ~b l == record(addr(p_mes)&k'17777'!k'060000'); ! put in seg 3 #else l == record(p_buff no&k'17777'!k'060000'); ! put in seg 3 #fi #else #if ~b l == record(addr(p_mes)&k'17777'); ! force to seg 0 #else l == record(p_buff no&k'17777') #fi #fi %return link fns(do output): ! -> 11/34 %if stream = 9 %then read message from am1 %else %c read from am1 ! ->d mon %return link fns(do input): ! -> 2900 %if stream = 8 %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): link fns(mainframe 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 = 8 %then d == d2 %if stream = 9 %then d == d3 bh = bh+1 #if a p2a = swab(m2900_p2a); p2b = swab(m2900_p2b) p3b = swab(m2900_p3b) #else p2a = m2900_p2a; p2b = m2900_p2b p3b = m2900_p3b #fi type = 0 sub ident = m2900_sub ident #if ~a state = m2900b_b(1); mode = m2900b_b(0) #else state = m2900b_b(0); mode = m2900b_b(1) #fi %if mon < 0 %start select output(1) printstring("mess:s,su,st:") write(stream, 1); write(sub ident, 1); write(state, 1) write(p2b, 1); write(p3b, 1) newline select output(0) %finish %if sub ident # 0 %start; ! low level %if stream < 10 %start %if state = connecting %start !! initial logon stream connected 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 = p2b; d_o pos = 0; d_o lim = 0; d_o posx=0 printstring("logon stream enabled ") HOST STATE = UP %finish %if state = disconnecting %start host state = down printstring("logon stream disconnected ") tidy message streams %finish %finish %else %if d_state = not allocated %start -> 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 = p2b d_i pos = p3b d_imode = mode >> 4; ! find out binary %finish %else d_out lim = p2b; d_o state = enabld d_o pos = 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 ~b %if %not d_hold == null %then %c free buffer(d_hold) %and d_hold == null #else %if d_hold # 0 %then free buff no(d_hold) %and d_hold=0 #fi %finish %finish %finish m2900_p2a = 0; m2900_p2b = 0 send reply: #if ~b to 2900(low level control, m2900) #else m2900_trf buff = 0; ! for safety to 2900(low level control, buff no) #fi %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 = p3b %if d_i pos = trig %and d_o lim # p2b %start ! prompt IF no input ahead AND ! its not a null prompt d_p lim = p2b i = d_o state d_o state = i!pmt p ! hold for use later %if i = enabld %start #if ~b d_hold == m2900; ! retain buffer #else d_hold = buff no; ! remember buffer mes_lev3_itp_a(0) = 1; mes_ts29_itp_a(0) = 1 ! set pointer at beginning of buffer #fi get buffer(low level op transfer) %return %finish %finish #if ~b free buffer(m2900); ! past that position already #else free short buff(buff no); ! past that position already #fi %else !************************ !* output stream * !************************ %if stream = 9 %start !! update of pointer on message stream #if ~b free buffer(m2900) #else free short buff(buff no) #fi 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 = p2b d_o trig = 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 ~b %if %not d_hold == null %start free buffer(m2900) #else %if d_hold # 0 %start free short buff(buff no) #fi %else #if ~b d_hold == m2900 #else d_hold = buff no #fi %finish %if tcp_size>= 3 %or no of small < critical %c %or no of big < critical %start tcp_held = 1; held = held+1; theld = theld+1 #if ~b free buffer(d_hold); d_hold == null #else free short buff(d_hold); d_hold = 0 #fi %else mes == m2900; ! map to it mes_lev3_itp_a(0) = 1; mes_ts29_itp_a(0) = 1 ! set pointer at beginning of buffer get buffer(low level op transfer) %finish %return %finish %finish #if ~b free buffer(m2900) #else free short buff(buff no) #fi %finish %finish %end %routine fill(%record (mef) %name mes, %integer no) %integer n, pt, max %record (itpf) %name itp %constbyteintegerarray pts(1:last itp reason) = 100, 10, 19, 26, 33, 39, 40, 45, 45, 45(8), 45, 65, 75, 81 !! pt to itp mess %ownbyteintegerarray itp message(1:139) = 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 0, 0, 0, 16, 13, nl, '*', '*', ' ', 'E', 'M', 'A', 'S', ' ', '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 0(3), 15, 2, 2, 1, 3, 126, 7, 1, 9, 0, 10, 80, 12, 0, 13, 4,; ! sensible pad parameters 0(3), 36, 'C', 'o', 'n', 'n', 'e', 'c', 't', 'e', 'd', ' ', 't', 'o', ' ', 'E', 'd', 'i', 'n', 'b', 'u', 'r', 'g', 'h', '.', 'E', 'M', 'A', 'S', '-', 'A', 13, nl, 'U', 's', 'e', 'r', ':'; ! new user prompt pt = pts(no) %if tcp_tsf = 0 %then itp == mes_lev3_itp %else %c itp == mes_ts29_itp itp_s = string(addr(itp message(pt+3))) mes_len = length(itp_s) itp_res = 0; ! for ts29 %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 %integer k ! 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 logr_a(1) = 1 logr_a(2) = 0 logr_a(3) = d_stream<<1+fixed k = tcpa(d_tcp)_tcpn string(addr(logr_a(4))) = tnames(k) logr_mlen = logr_a(4) +4+1 #if ~b d_hold == logr #else d_hold = logr_buff no #fi %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, buff no, max trf, max len %record (m2900f) %name m2900 %record (mef) %name mes %record (m2900if) %name mi %conststring (1) the chop = "Y" bh = bh+1 reason = p_c2; ! get reason for calling #if ~b mes == p_mes #else buff no = p_buff no mes == map(buff no) mes_owner = own id #fi 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) #if b printstring(", b:"); write(p_buff no, 1) #fi newline; select output(0) %finish %if d_state = not allocated %start printstring("XXX:Not all!"); write(d_tcp, 1) write(reason, 1); newline -> free %finish %if reason = store user name %then move user name(mes) %andc %return %if reason <= last itp reason %start %if d_cnsl # 255 %start; ! cnsl = 255 - disconnected tcp == tcpa(d_tcp) fill(mes, reason); ! insert the message call ty = put output %if 3<=reason<=4 %or reason = 7 %or %c reason = send pad params %then call ty = Control data %if tcp_tsf # 0 %start %if call ty = control data %start call ty = put output mes_ts29_itp_res = 128; ! assert ts29 control byte %finish mes_len = mes_len+1; ! additional byte in ts29 %finish to gate(call ty, mes, 0) %if reason = send emas down %then d_state = logging off 2 %and %c get buffer(send disconnect) %else #if ~b free: free buffer(p_mes); ! MUST be 'p_' as 'mes' gets changed #else free: free buff no(buff no) #fi %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 #if ~b %unless d_hold==null %then free buffer(d_hold) d_hold == mes #else %if d_hold # 0 %then free buff no(d_hold) d_hold = buff no #fi #if ~a mes_lev3_itp_a(0) = 1; mes_ts29_itp_a(0) = 1 ! set both xxx & ts29 lengths to the start #else %if d_stream < 0 %then mes_len = 64 %else mes_len = x'7f' ! desrired length of incoming transfer #fi get buffer(low level op transfer) %return %finish !! message to 2900 reason m2900 == mes m2900_stream = d_stream<<1+fixed+reason&1 m2900_sub ident = x'0a00'; ! = swab(10) %if d_stream < 0 %then m2900_stream = 10+d_stream ! streams 8 & 9 are internally -2 & -1 %if reason = low level op transfer %start #if ~b %if d_hold == null %or d_state = awaiting int %then -> free #else %if d_hold = 0 %or d_state = awaiting int %then -> free #fi ! kill op done, so ignore tran request m2900_p2a = k'400'; ! = swab(1) m2900_p2b = swab(d_o pos) #if a m2900_trf buff = d_hold d_hold = 0; bh = bh-1 %if d_stream < 0 %then max len = x'4000' %else max len = x'7f00' m2900_p3a = max len ! max transfer request, 64 for login stream ! ie =swab(64) or =swab(127) (compiler probs) ! NB: It is assumed that the kick to go flag ! was set while the buffer was being ! handled earlier #fi %else m2900_p2b = 0; m2900_p2a = 0 %finish #if a %if reason = low level ip transfer %start; ! ->amdahl m2900_trf buff = bpop(d_inp q); ! get the next 'user' buffer bh = bh-1 m2900_p3a = x'8000'; ! max size of trf (dummy here) =swab(128) %finish #fi ! One of the integers now contains the desired max length ! of transfer (say P3a) ! To amdahl = max data len (actual very difficult to get) ! To Fep = xxx = 128 ! = Ts29= 127 ! (say 127 for both for now) ! Control Buffer ! Units of 64 for now in both directions 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 #if ~b to 2900(type, m2900) #else to 2900(type, buff no) #fi %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 input enabled <= d_state <= awaiting int %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 #if a %routine read from am1 ! This routine now indicates that a buffer with data has ! actually arrived from the amdahl, there are 3 conditions ! 1) Stop at a page bdry, oe end of buffer -> More to come ! 2) Max length, but more to come ! 3) Possibly max len, but no more to come %record (mef) %name mes %record (itpf) %name it %integer n, flag, sym, lim, type, t, stat, len, new pos mes ==map(p_buff no) mes_owner = own id %if mes == null %or d_state = not allocated %start printstring("xxx:sequence? ") %return %finish %if tcp_tsf = 0 %start it == mes_lev3_itp %else it == mes_ts29_itp %finish ! No prompt now, so delete this? %if d_ostate&out p # 0 %start lim = d_o lim; type = out p %else lim = d_p lim; type = pmt p %finish len = mes_len new pos = d_opos + len %if d_otrig > 0 %and d_opos < d_otrig <= new pos %then %c get buffer(send trig reply) ! mapping ? %if new pos = d_out lim %then d_opos = 0 %else d_opos = new pos %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 %finish mes_len = n+header len; ! no of chars %if tcp_tsf # 0 %then mes_len = mes_len+1 %and it_res = 0 ! additional byte for ts29 %if d_cnsl = 255 %start; ! gone away free buffer(mes) %else to gate(put output, mes, 0) %finish %if d_out go > 0 %and d_ostate > enabld %then %c get o block %return %finish %end %routine write to am1 ! This routine now indicates that the amdahl has taken an ! input buffer from us. To Gate(Enable input, null ,1) get buffer(low level ip transfer) %unless d_inp q == null %end #else %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 #if ~b mes == d_hold #else mes == map(d_hold) #fi %if mes == null %or d_state = not allocated %start printstring("xxx:sequence? ") %cycle %exit %if l_rxs&(ready!xopl)#0 %repeat sym = l_rxd; ! read a char, to prevent one char transfer #if ~b p_c1 = 0!128; to 2900(return control, null) #else p_c1 = 0!128; to 2900(return control, 0) #fi %return %finish #if ~b d_hold == null #else d_hold = 0 #fi #if ~b %if mes_type=0 %then len=bigblockmax-2 %else %c len = small block max-2 #else %if mes_type = 0 %start %if tcp_p256 # 0 %then len = big 256 len-2 %else %c len = bigblockmax-2 %finish %else len = small block max-2 %if tcp_tsf = 0 %start it == mes_lev3_itp %else it == mes_ts29_itp %finish n = it_a(0); ! start of data = 1 initially 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 #if ~b to 2900(return control, null) d_hold == mes; it_a(0) = n #else to 2900(return control, 0) d_hold = mes_buff no; it_a(0) = n #fi %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 %finish #if ~b to 2900(return control, null) #else to 2900(return control, 0) #fi mes_len = n+header len; ! no of chars %if tcp_tsf # 0 %then mes_len = mes_len+1 %and it_res = 0 ! additional byte for ts29 %if d_cnsl = 255 %start; ! gone away free buffer(mes) %else to gate(put output, mes, 0) %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, buff no %constinteger cr = 13 #if ~b mes == d_in mes #else read next block: %if d_holdi # 0 %then buff no = d_holdi %else %start buff no = Bpop(d_inp q) %finish mes == map(buff no) #fi %if d_state # input enabled %or mes == null %start p_c1 = 0; ! terminate ->am1 rep; ! reply to am1 hanmdler %finish %if tcp_tsf = 0 %then it == mes_lev3_itp %else %c it == mes_ts29_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 #if ~b am1 rep: to 2900(return control, null) #else am1 rep: to 2900(return control, 0) #fi %return %finish %if l_txs&ready # 0 %then %exit %repeat %if n > max %start #if ~b p_c1 = 4; ! condition y to 2900(return control, null) to gate(enable input, null, mes_lev3_reserved(0)) ! send the suppressed data acks (at level 3) free buffer(d_in mes); d_in mes == null #else to gate(enable input, null, 1); ! one at a time for now ! free buff no(buff no); d_holdi = 0 -> read next block %unless d_inp q_e == null p_c1 = 4 to 2900(return control, 0) #fi %return %finish char = it_a(n) char = nl %if char = cr %and d_imode = 0; ! 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 #fi #fi %routine kick 2900 message(%record (mef) %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 ~b %if (d_hold == null %and d_inp q_e == null) %or d_incnt>5 %then %c #else #if ~a %if d_hold = 0 %and d_inp q_e == null %then %c #else %if d_kick = 0 %then d_kick = 1 %and %c #fi #fi get buffer(low level ip transfer) #if ~b push(d_inp q, log) #else #if a log_len = 64; ! they are all 64 now log_kick to go = 1; ! wake up director #fi bpush(d_inp q, log_buff no) #fi 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 buff no(bpop(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 #if a ! This routine now means that a buffer has actually arrived ! from the amdahl, all buffers are 64 bytes in length #if ~a %record (maf) %name m #else %record (mef) %name m #fi %integer n, sym, t, stat, lreply, stream, mode %record (mef) %name mes %integer type %record (itpf) %name itp %switch hlm(1:2) #if a m == map(p_buff no) m_owner = own id; ! pick up the buffer #else ! d3 is allways used #if ~b m == d3_hold; d3_hold == null #else m == map(d3_hold); d3_hold = 0 #fi #fi %if m == null %or d3_opos = d3_o lim %start printstring("xxx: seq2! ") t = 0!128; -> reply %finish #if ~a !! (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 -> 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 -> skip %finish %finish %if stat&comm bit # 0 %start t = 2!128 skip: #if ~b d3_o posx = n; d3_hold == m #else d3_o posx = n; d3_hold = m_buff no #fi reply: p_c1 = t; ! long block+accept last #if ~b to 2900(return control, null) #else to 2900(return control, 0) #fi %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 m %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 #fi 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(" xxx 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 #fi #if a d3_opos = d3_opos+64 #fi #if a type = m_a(1) %if mon < 0 %start select output(1) mon mes(m) select output(0) %finish %if mon # 0 %start printstring("Hlm:ty="); write(type, 1) write(m_len, 1); newline %finish #fi #if ~a type = m_a(1); ! max = 256 #fi ! ? x = (8+m_a(4))&x'fffe' stream = m_a(2)<<8!m_a(3) #if ~a m_m len = n #fi #if ~a %unless 1 <= type <= 2 %then ->badm #else %unless 1 <= type <= 2 %%start printstring("Bad HLM, type ="); write(type, 1); newline -> reply %finish #fi 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) tcp == tcpa(d_tcp) %if tcp_tsf = 0 %then itp == mes_lev3_itp %else %start itp == mes_ts29_itp mes_len = mes_len+1; ! ts29 byte itp_res = 0; ! ensure its zero %finish itp_s = str; ! copy text back in to gate(put output, mes, 0) %if l reply = 0 %start d_state = logged on %else d_state = logging off %if d_cnsl = 255 %then retrieve(d) %else %c 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 ! XXX param settings ! - there is a dummy 255 as the ! 1st byte past the length. This ! is to avoid sending itp setmodes out tcp == tcpa(d_tcp); ! pickup tcp descriptor %if m_a(6) = 255 %start; ! proper xxx mode set m_a(6) = m_a(5)-1; ! move length down one to scrap 255 str = string(addr(m_a(6))); ! copy setmode out of the way mes == m; ! change the buffer to an itp one %if tcp_tsf = 0 %start mode = control data; itp == mes_lev3_itp; mes_len = mes_len+1 %else mode = put output; itp == mes_ts29_itp %finish itp_s = str; ! put the setmode back in mes_len = length(str)+header len; ! hdr+string+string length length(itp_s) = 128; ! flag control in TS29, else ignored to gate(mode, mes, 0); ! send the buffer %finish %else FREE BUFFER(m); ! CANT HANDLE SETMODE #if ~a ->reply; ! give control back to am1h #else reply: ! nothing to do here except to check if another one ready to come. %if d3_opos # d3_olim %start d == d3 get buffer(get op block) %finish #fi %end !! w r i t e m e s s a g e t o a m 1 %routine write message to am1 #if ~a %record (maf) %name m #fi %integer n, max, am1 reply, stat ! allways use d2 #if a ! This now means that a message has gone to the amdahl, ! simply see if there is another to be sent d2_kick = 0; ! may now send another %unless d2_inp q_e == null %then get buffer(low level ip transfer) %c %and d2_kick = 1 #else am1 reply = 4; ! "condition y" %cycle #if ~b m == d2_hold %if m == null %then m == pop(d2_inp q) %and d2_in cnt = d2_in cnt-1 #else %if d2_hold # 0 %then m == map(d2_hold) %else %start m == map(bpop(d2_inp q)); d2_incnt = d2_in cnt-1 %finish #fi %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 #if ~b d2_hold == m; ! retain buffer for retry #else d2_hold = m_buff no; ! retain buffer for retry (from q perhaps) #fi 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 #if ~b d2_hold == m; ! retain for later #else d2_hold = m_buff no; ! retain for later #fi -> am1 rep %finish %if l_txs&ready # 0 %then %exit %repeat %if n > m_a(0) %start free buffer(m) #if ~b d2_hold == null; d2_o posx = 0; d2_hold f = 0 #else d2_hold = 0; d2_o posx = 0; d2_hold f = 0 #fi %if d2_inp q_e == null %then ->am1 rep %exit %finish #if m %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 #fi l_txd = m_a(n); n=n+1 %repeat %repeat am1 rep: p_c1 = am1 reply #if ~b to 2900(return control, null) #else to 2900(return control, 0) #fi #fi %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; %return %if k = 0 %cycle i = 1, 1, k write(itp_a(i), 1) j = j+1; %if j = 25 %then j = 0 %and newline %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 b printstring(", b:"); write(p_buff no, 1) #fi newline %end %endofprogram