!******************************** !* emas-2900 fep rje server * !* file: rjesx2/rjesx2y * !* x25 only version !******************************** !! stack size = 300 %control 1 %include "deimosperm" %conststring(13) vsn = "Rjes...v2t " #datestring #timestring %begin %recordformat am1f(%integer rxs, rxd, txs, txd) %ownrecord (am1f) %name l == 1; ! supplied by am1 handler %recordformat ssmessagef(%bytearray a(0:240) %or %c %integer x1,x2,x3,x4, users, state, cpu, pkts, sbr, byt, rjeo, rjei) %recordformat mef(%record (mef) %name link, %c %byteinteger len, type, (%bytearray reserved(0:7), %c %byteintegerarray a(0:241) %or %c %bytearray params(0:241))) %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)) !! Data to the 2900 on stream 4 is similar exept that there is no !! spacer array - format 'maof' is used. %recordformat maof(%record (mef) %name l, %byteinteger mlen, %c mtype, (%bytearray a(0:240) %or %c %integer len, type, %string(240) address)) %recordformat pe(%byteinteger ser, reply, %c (%byte a1, a2, b1, b2, (%byte c1, c2 %or %integer c) %or %c %byte fn, s1, (%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 index, stream, permit, %byteinteger delay, timcount, %c %integer devno, facility, o state, port, iso, kill, %c n, cpos, count, nc, push flag, %record (qf) inp q) %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 %constinteger t3 ser = 21 %constinteger comm bit = k'1' %constinteger accept char = k'002' %constinteger acfy = k'010'; ! peter calls it rxfy %constinteger xopl = k'020'; ! x operable - latched ! %constinteger xop = k'040'; ! x operable %constinteger ready = k'200' ! %constinteger cr = 13 ! %constinteger ff = 14 %constinteger ts accept = 17 !*********************************************************** !* 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; ! end of section or file %constinteger aborting = 5 %constinteger enabling = 7 %constinteger enabled = 8 !* s t a t e s %constinteger not alloc = -1 %constinteger idle = 0 %constinteger op ready = 1; ! applies to the connection %constinteger input ready = 1; ! input streams only %constinteger trying = 2; ! awaiting network reply %constinteger timing = 3; ! connection refused, waiting for clock %constinteger aborted = 4; ! 2900 has gone down %constinteger connect 1 = 5; ! bsp connected, waiting for ! 2900 connect&enable %constinteger reseting = 6 %constinteger wait ts = 7; ! avoid non-yellow book gatex %constinteger connected = 8; ! in file %constinteger enabld = 9; ! 2900 has started file %constinteger closing = 10; ! close has been sent to network !****************************************** !* reasons for waiting for a buffer * !****************************************** %constinteger low level ip transfer = 22 %constinteger low level op transfer = 23 %constinteger get op block = 24 %constinteger send abort = 25; ! ask emas to abort stream %constinteger do input connect = 27 %constinteger connecting reply = 29 %constinteger connecting reply failed = 30 %constinteger do outbound connect = 31 %constinteger get block for eof = 32 %constinteger set transparent mode = 33 !************************************************************** %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 who and state %routinespec tell %routinespec from gate %routinespec from 2900 %routinespec do connect(%integer tpye, %record (mef) %name mes) %record (con desf) %mapspec get free des %routinespec flush file %routinespec kick 2900 message(%record (maof) %name log) %routinespec from buffer manager(%record (pe) %name p) %integerfnspec allocate stream(%record (con desf) %name d, %c %integer type) %routinespec tidy buffers %routinespec retrieve(%record (con desf) %name d) #if d %routinespec do repm(%record (mef) %name mes, %integer flag) #fi %routinespec clear all streams %routinespec read from am1 %routinespec write to am1 %routinespec read message from am1 %routinespec write message to am1 %routinespec mon mes(%record (mef) %name mes) !! %permroutinespec push(%record (qf) %name q, %record (mef) %name e) !! %permrecord (mef) %mapspec pop(%record (qf) %name q) !****************************************************** %record (pe) p %ownrecord (qf) mes q; ! Used to hold messages for 2900 %ownrecord (ssmessagef) %name ssmessage %owninteger con sub id reply = 1; ! picks up from actual mess %ownrecord (con desf) %name d; ! at 140072 %ownrecord (con desf) %name d4, d5 %constinteger con lim = 40; ! number of active terminals (see fixed top) %ownrecord (con desf) %array con desa(0:con lim) %ownrecord (qf) %name free des; ! pts to list of free con desa %record (qf) %name q frig %constinteger fixed = 258; ! 1st available stream %constinteger fixed top = 350; ! number of 2900 streams in eam5 ! was 281 ! %ownbyteintegerarray am1a(fixed:fixed top) = k'377'(*) %ownbyteintegerarray alloc(fixed:fixed top) !* * * * * * * * * * * * * * * * * * !mapping from spoolr internal device codes to facility numbers %constbyteintegerarray facil(0:14) = 0, 6, 13, 7, 12, 20, 4, 8, 0, 9, 13, 0, 0, 0, 9 !device number/facility codes ! spoolr no. facility code document type ! 0 0 ! 1 6 pp no ! 2 0 pr yes ! 3 7 cp no ! 4 0 cr yes ! 5 20 mt no ! 6 4 lp no ! 7 8 gp no ! 8 0 op no ! 9 9 mp no ! 10 13 do yes ! 11 0 no ! 12 0 ct no ! 13 0 su no ! 14 9 fe yes ! 15 0 no %ownrecord (qf) %name buffer pool; ! =k'142472' %owninteger no of buff = 0 %owninteger mon = 0; ! monitoring flag %owninteger bh = 0; ! total no of buffers in this process %owninteger fep weight = 60; ! discourage rje traffic wt %constintegername users == k'100014'; ! no of users in buffer seg %constintegername cpu == k'100012'; ! idle cpu count %constintegername pkts == k'100010'; ! packet count %constintegername sbr == k'100006'; ! no of sbrs %constintegername byt == k'100004'; ! no of bytes %owninteger no desc = 0; ! no descriptor message has been output %owninteger last weight = 0; ! last route goodness passed to spoolr %owninteger rjei = 0; ! no of rje packets %owninteger rjeo = 0 ! l o g g i n g o n %integer i %conststring (3) %array sfacil(0:20) = "??", "DD", "??"(2), "LP", "??", "PP", "CP", "GP", "MP", "??"(2), "CR", "DD", "??"(6), "MT" %conststring (7) %array ostates(-1:10) = "not all", "waiting", "ready", "asking", "timing", "abortng", "chcking", "resetng", "Wait Ts", "conning", "going", "close" %constinteger fac max = 6 %ownstring (3) %array fac(1:fac max) = "TT", "RJE", "LP", "DD", "PR", "CR" ! gate facility nos %ownbytearray trans mode(0:16) = 16, 128, 2, 4, 0, 3, 126, 7, 1, 9, 0, 10, 0, 12, 1, 15, 1 %ownstring (43) %array address(0:con lim) %ownstring (63) Explan Text, calling %ownstring (1) snil = "" !********************************************** !* initialisation * !********************************************** change out zero = t3 ser printstring(vsn); printstring(datestring); newline %cycle i = con lim, -1, 2 con desa(i)_index = i; con desa(i)_o state = not alloc qfrig == con desa(i) qfrig_e == free des free des == qfrig %repeat con desa(1)_index = 1 condesa(0)_stream = 4 con desa(1)_stream = 5 map hwr(0); ! map am1 to segment 3 i = map virt(buffer manager, 5, 4); ! map buff man stack to seg 4 i = map virt(buffer manager, 6, 5) d == con desa(0) d4 == d d5 == con desa(1) p_c = 4; ! param for 'here i am' to 2900(here i am, null) p_c = 5 to 2900(here i am, null) %cycle i = 1, 1, fac max p_ser = gate ser; p_reply = own id p_fn = enable facility; p_s1 = 0 p_facility = fac(i) pon(p) %repeat alarm(250); ! set clock for 5 secs !********************************************** !* main loop * !********************************************** %cycle p_ser = 0; poff(p) %if int # 0 %start %if 'M' <= int <= 'P' %start mon = int-'O'; int = 0 %finish %if int = 'C' %start select output(1); close output printstring("done ") int = 0 %finish %if int = '?' %start printstring("Buff Pool:"); write(no of buff, 1) printstring(", bh :"); write(bh, 1) printstring(" Last weight:"); write(last weight, 1); newline %cycle i = 2, 1, con lim d == con desa(i) %if d_o state # not alloc %start printstring("rje:") who and state printstring("Gp ="); write(d_port, 1) printstring(", c ="); write(d_nc, 1) printstring(", d1,d2:"); write(d_n, 1); write(d_iso, 1) printstring(", strm ="); write(d_stream, 1) newline %finish %repeat int = 0 newline %finish %if '0' <= int <='9' %start; ! change weight int (9=no users) fep weight = (int-'0')*10; int = 0 %finish %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 %start from buffer manager(p) %finish %else %if p_reply = 0 %start; ! clock tick %cycle i = con lim, -1, 0 d == con desa(i) %if d_o state = timing %start d_timcount = d_timcount-1 %if d_timcount <= 0 %then get buffer(do outbound connect) %else %if d_timcount # 0 %then d_timcount = d_timcount-1 %finish %repeat %if no desc > 0 %then no desc = no desc-1; ! 60 sec timeout alarm(100) %finish %repeat !************************************************* !* routines to do the work * !************************************************* %routine crunch %integer i who and state; newline %cycle i = 1, 1, 10 printstring("**** rjes bad buffer *** ") %repeat ! *=k'104001' %end %routine to gate(%integer fn, %record (mef) %name mes, %c %integer flag) !======================================================== #if m %if mon<0 %start select output(1) printstring("To Gate, fn ="); write(fn, 1) printstring(", G port, T Port:") %if d == null %start write(p_gate port, 1); write(p_task port, 1) %else write(d_port, 1); write(d_index, 1) %finish printstring(", Flag:"); write(flag, 1) newline select output(0) %finish #fi %if fn = put output %start; ! queue these as necessary %if mon = -1 %start select output(1) printstring("io "); mon mes(mes) %finish rjeo = rjeo+1 %if addr(mes)&k'140000'=k'140000' %or addr(mes)&k'17'#0 %then crunch %c %and %return %finish p_ser = gate ser; p_reply = own id p_fn = fn; p_mes == mes; p_s1 = flag %unless d == null %start; ! no d p_gate port = d_port; p_task port = d_index %finish bh = bh-1 %unless mes == null 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 bh = bh-1 %unless m2900 == null pon(p) %end %routine get buffer(%integer reason) %record (pe) p !******************************************************* !* hold a pool, so can call buffer here immedialtely* !* otherwise hold the activity until it arrives* !******************************************************* %if reason = get op block %then p_c1 = 0 %else p_c1 = 1 ! ****** watch the above line ******** p_c2 = reason; p_a2 = d_index %if buffer pool == null %or p_c1 = 0 %start; ! have to ask for it ! no buffs, or want a long p_ser = buffer manager; p_reply = own id p_fn = request buffer pon(p) %else p_mes == buffer pool; buffer pool == p_mes_link p_mes_link == null no of buff = noof buff-1; from buffer manager(p) bh = bh-1; ! from buff adds it back on %finish %end %routine free buffer(%record (mef) %name mes) %record (pe) p %if addr(mes)&k'140000'=k'140000' %or addr(mes)&k'17'#0 %then crunch %c %and %return %if mes_type = 0 %or no of buff > 3 %start; ! Q Short buffs p_ser = buffer manager; p_reply = own id !! release long buffers p_fn = release buffer; p_mes == mes pon(p) bh = bh-1 %else !! short buffer, so queue it mes_link == buffer pool; buffer pool == mes no of buff = no of buff+1 %finish %end %routine fault(%integer i) printstring("Rjes: Fault:"); write(i, 1) space; who and state; newline %end !! %routine tell !! monitoring routine %integer n write(d_index, 2); space n = d_facility %if d_stream&1 = 0 %and n=13 %then n = 1; ! input printstring(sfacil(n)) %if d_devno = 0 %then space %else printsymbol('0'+d_devno) space printstring(address(d_index)) space %end %routine who and state tell printsymbol('(') printstring(ostates(d_o state)) printstring(") ") %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 plant fail(%integer type, %record (mef) %name mes) !========================================================= %ownstring (5) downn = "Down" mes_len = 0 pack(mes, fac(2)) pack(mes, downn) to gate(Disconnect, mes, type) %end #if d %routine do repm(%record(mef)%name mes, %integer flag) !! sends a 'call reply' to gate, nb: assumes p_port = port number explan text = "EMAS -rje" p_ser = gate ser; p_reply = own id p_fn = Datagram reply; p_s1 = flag p_mes == mes mes_len = 0 pack(mes, fac(3)) pack(mes, Explan text) pon(p) %end #fi %routine from gate !================= %record (mef) %name mes %string (15) called %string (31) s1; %string (5) s2 %integer fn, flag, strm, max, i, char, d1, d2, fac %integer node %switch fns(connect:control data) fn = p_fn strm = p_gate port mes == p_mes d == con desa(p_task port) #if m %if mon < 0 %start select output(1) printstring("From Gate, fn =") write(fn, 1) printstring(", G Port, T Port ") write(p_gate port, 1); write(p_task port, 1) printstring(", Flag:"); write(p_s1, 1) newline select output(0) %finish #fi bh = bh+1 %unless mes == null ->fns(fn) fns(connect): d == null %if host state = down %start plant fail(39, mes); ! Application Failure %return %finish ! get its address ? d == get free des %if d == null %then plant fail(37, mes) %and %return; ! congestion ! No free descriptors d_port = p_gate port !! construct a message to the 2900 ******* i = allocate stream(d, 0); ! even stream only ! Address, Facility etc picked up later ! s1 = unpack(mes, 2) %if mon # 0 %start printstring("In call ") %finish %if charno(s1, 2) = '.' %start; ! address is 2.150000xx etc s1 -> s2.(".").s1; ! spoolr only wants main part %finish address(d_index) = s1 d_o state = connect 1; ! wait for confirmation d_nc = 0; d_kill = 0 d_push flag = 1; ! expect ts29 byte as 1st d_hold == mes; ! hold params for now get buffer(do input connect) %return fns(input here): -> fails %if d_o state = not alloc rjei = rjei+1 #if m %if mon = -1 %start select output(1) printstring("In "); mon mes(mes) %finish #fi %if d_inp q_e == null %and d_hold == null %and %c d_o state = enabld %start !! stream is waiting for a network buffer get buffer(low level ip transfer) d_n = 0; ! into buffer pointer, and kick 2900 %finish mes_reserved(0) = p_s1; ! store the 'push' indication push(d_inp q, mes); ! q buffer anyway d_nc = d_nc+1; ! count it %return fns(enable output): -> fails %if d_o state = not alloc i = d_permit d_permit = d_permit+p_s1 %if i = 0 %and d_o state = enabld %then %c get buffer(get op block) %return fns(Disconnect): ! Which variety %unless mes == null %start d1 = mes_reserved(2); d2 = mes_reserved(3) free buffer(mes) %finish %if d_o state = not alloc %then %return; ! horrible %if p_task port = 0 %start ! Disconnect before Accept %cycle i = 0, 1, con lim d == con desa(i) %if d_port = p_gate port %start d_o state = idle; ! horrible !!!!!??????!!!!!!! printstring("RJE:Disconnect before Accept sent by rjes ") who and state newline to gate(Disconnect, null, 1) %return %finish %repeat -> fails %finish %if d_o state = aborted %start; ! Deallocate OR Emas down retrieve(d); %return; ! re-claim the descriptor %finish %if d_o state = trying %or d_o state = wait ts %start; ! reply (failed) to a 'Connect' %if d_ostate = wait ts %then to gate(Disconnect, null, 39) d_nc = d_nc+1; d_port = p_s1; ! remember reason d_timcount = 5 d_n = d1; d_iso =d2; ! hold reasons for displaying d_o state = timing %return %finish d_timcount = 8; ! hold new call for 16 secs %if d_o state = closing %start %if mon<0 %start tell; printstring("disc from other end ") %finish to gate(Disconnect, null, 1) %unless d_nc = 95 ! ack the disconnect unless we have already sent ! a disc. in response to a reset ! or an 'abort file from spoolr' %if d_hold == null %then crunch %and %return to 2900(low level control, d_hold) d_o state = idle; d_hold == null %else who and state printstring("network abort, reason =") write(p_s1, 1); write(d1, 1); write(d2, 1); newline %if d_o state >= connected %or d_o state = input ready %c %start get buffer(send abort); ! get 2900 to abort stream to gate(Disconnect, null, 1); ! reply to gate to clear port %finish %if d_o state = reseting %then get buffer(send abort) %if host state = down %then %c retrieve(d) %else d_o state = idle %finish %return fns(Accept Call): ! reply from remote device d_delay = 0; ! set delay for attempted calls back to 0 free buffer(p_mes) %unless p_mes == null mes == null; ! mark freed d_port = p_gate port; ! d is mapped using task port %if d_o state = aborted %start !! connection established ! to gate(disconnect, null, 39); ! application failure d_nc = 99; ! wait for disc before the retrieve %return %finish -> Fails %if d_o state # trying d_permit = 1; d_iso = 0; ! set iso mode NB: Permit only affects queing within Gate - NOT WINDOW d_o state = wait ts; ! wait for ts accept to come up (new feature) d_nc = 0; d_n = 0 %return #if d fns(Datagram): ! incoming login or enquiry flag = 39; ! mainframe down called = unpack(mes, 1) Explan text = unpack(mes, 4) %unless called -> s1.("S").s2 %then -> repm; ! ??? s1 = unpack(mes, 2); ! calling %if s2 = "21" %start; ! poll from info flag = 0 ssmessage == record(addr(explan text)) ssmessage_users = users; !$e - all of section $e ssmessage_state = host state ssmessage_cpu = cpu; ssmessage_pkts = pkts; ssmessage_sbr = sbr ssmessage_byt = byt; ssmessage_rjeo = rjeo ssmessage_rjei = rjei ssmessage_a(0) = 24; ! lenght of same -> repm2 %finish %if s2 = "11" %start !! logon or oper message and 2900 is actually up %if host state = down %start flag = 0; plant fail(39, mes) %return %finish push(mes q, mes); ! retain the message mes_params(1) = p_gate port get buffer(transfer message) %return; ! wAIT FOR THE BUFFER %finish i=1 spaces(6); printstring(s1); ! print who is printsymbol(':') flag = 0 %cycle max = charno(explan text, i) %if max = x'80' %then max = charno(explan text, i+1) %and i = i+1 i = i+1 %while max > 0 %cycle char = charno(explan text, i) printsymbol(char); i = i+1; max = max-1 %repeat newline %unless char = nl %exit %if i >= length(explan text) spaces(12) %repeat repm: explan text = "" repm2: do repm(mes, flag) %return fns(Datagram Reply): ! reply to sendmessage free buffer(p_mes) %unless p_mes==null ! ignore, but free buffer #fi fns(reset): %if mon # 0 %then tell %and printstring("reset ! ") -> fails %unless wait ts <= d_o state <= enabld %or d_o state = closing free buffer(mes) %unless mes == null to gate(disconnect, null, 0) ! gate is told to disconect, but wait for reply ! before telling emas to abort %if d_o state = wait ts %then d_o state = trying %else %start %if d_o state = closing %then d_nc = 95 %else d_o state = reseting %finish %return fns(control data): to gate(Enable Input, null, 1) %if d_o state = wait ts %start i = mes_a(0) free buffer(mes) %if i # ts accept %start printstring("ts accept? "); write(i, 1); newline %else d_o state = connected get buffer(connecting reply); ! tell EMAS to go get buffer(set transparent mode) %finish %return %finish fns(*): Fails: printstring("Rjes:Gate fails:"); write(fn, 1) printstring(" On T Port:"); write(p_task port, 1) int = '?' newline free buffer(mes) %unless mes == null %end !! r o u t i n e from 2900 !! all messages from the 2900 come to this routine !=================== %routine from 2900 %record (m2900f) %name m2900 %record (m2900bf) %name m2900b %integer stream, sub ident, state, mode, am1c, flag %integer p2a, p2b, ioflag %switch link fns(interf addr:mainframe down) %switch com state(disconnecting:enabled) %switch com state b(disconnecting:enabled) m2900 == p_mes; m2900b == m2900 %if p_fn = message %start stream = m2900_stream; ! get first stream no %finish %else stream = p_c am1c = am1a(stream) %if am1c = k'377' %then d == null %else %c d == con desa(am1c) -> link fns(p_fn) link fns(interf addr): ! interface addr from eam5 l == record(addr(p_mes)&k'17777'); ! force to seg 0 %return link fns(do output): ! -> 11/34 %if stream = 5 %then read message from am1 %else %c read from am1 %return link fns(do input): ! -> 2900 %if stream = 4 %then write message to am1 %else %c write to am1 %return link fns(mainframe down): link fns(mainframe up): host state = down clear all streams %return link fns(message): bh = bh+1 sub ident = m2900_sub ident state = m2900b_b(1); mode = m2900b_b(0)&x'f0' ! mode = 0 - seq, 1 - circ, 2 - seq cont ! = x'10' - iso, x'20' - ebc, x'30' - bin p2a = m2900_p2a; p2b = m2900_p2b m2900_p2a = 0; m2900_p2b = 0 %if sub ident # 0 %start; ! low level !****************************************** !* l o w l e v e l control message !****************************************** ioflag = stream&1; ! ioflag = 1 => 2900 o/p %if stream <= 5 %start %if stream = 4 %then d ==d4 %else d == d5 ->com state b(state) %finish %if d == null %or d_o state = not alloc %or stream < fixed %c %or stream > fixed top %start printstring("Rjes:Emas state:"); write(state, 1) printstring(", On invalid stream:"); write(stream, 1) newline -> control reply %finish -> com state(state) com state(enabling): -> control reply %if d_o state = idle d_o state = enabld %if mon < 0 %start tell; printstring(" enabling ") %finish %if ioflag # 0 %start %if mode # d_iso %then flush file; ! mode change d_iso = mode %if d_permit > 0 %start %if d_hold == null %start get buffer(get op block) %else do trans and reply: to 2900(low level control, m2900) get buffer(low level op transfer) %return %finish %finish %else %unless d_hold == null %and d_inp q_e == null %c %then -> do trans and reply %finish -> control reply com state(connecting): con sub id reply = m2900_sub ident; ! retain for reply %if mon<0 %then %c tell %and printstring("conn ") %if ioflag # 0 %start; ! output d_o state = timing; ! do connect wants it in this state d_nc = 0; ! retry count %if d_timcount = 0 %start do connect(Connect, m2900); ! ok - go %else free buffer(m2900) %finish %return %else; ! input %if d_o state = connect 1 %start to gate(Accept Call, null, 0) d_o state = connected ->control reply %finish %if d_o state = idle %start get buffer(connecting reply) get buffer(send abort); ! it has been chopped %finish %finish free buffer(m2900); ! reply is made up later %return com state(disconnecting): %if mon < 0 %start tell; printstring("disc ") %finish %if d_o state # idle %start fault(1) %if d_o state # connected %if ioflag # 0 %and d_kill = suspending %start flush file get buffer(get block for eof) %else flag = 39; tidy buffers to gate(Disconnect, null, flag) d_nc = 95; ! suppress another disconnect %finish d_o state = closing; ! other end will disconnect free buffer(d_hold) %unless d_hold == null d_hold == m2900 %return; ! withhold reply %finish -> control reply com state(aborting): %if mon < 0 %start tell; printstring("aborting ") %finish ->suspd com state(suspending): %if mon < 0 %start tell; printstring("susp ") %finish suspd: %if d_o state # enabld %and d_o state # idle %then fault(2) d_o state = connected %unless d_o state = idle d_kill = state; ! remember type of call ! stop transfers unless its idle anyway control reply: to 2900(low level control, m2900) %return !! *********************************************** !! the following are all stream 4 & 5 manipulations !! ************************************************ com state b(enabling): d_o state = enabling d_iso = p2b; ! bUFFER SIZE host state = up -> junk m %if stream = 4 -> control reply com state b(connecting): %if stream = 4 %then clear all streams %and d == d4 d_o state = connected d_n = 0; d_nc = 0; d_count = 0; d_iso = 0; d_cpos = 0 printstring("rje: logon stream"); write(stream, 1) printstring(" connected ") string(addr(m2900_p3a)) = "X25"; ! flag x25 fep to spoolr -> junk m com stateb(aborting): com stateb(suspending): com stateb(disconnecting): d_o state = idle host state = down junk m: tidy buffers -> control reply %finish !! high level control message d == d5 free buffer(m2900); ! it may be short get buffer(get op block) %if d_nc = d_count; ! dont do twice d_nc = p2b; ! update pointer %end %routine do connect(%integer type, %record (mef) %name mes) !============================================================ %string (3) facn fault(3) %if d_o state # timing %if d_o state = idle %start; ! chopped free buffer(mes); %return %finish p_ser = gate ser; p_reply = own id p_fn = type p_s1 = 2; ! new type to gatex - pass up ts accept p_gate port = 0; p_task port = d_index p_mes == mes facn = sfacil(d_facility) %if d_devno # 0 %then facn = facn.tostring('0'+d_devno) mes_len = 0 calling = address(d_index).".".facn pack(mes, calling) pack(mes, snil) pack(mes, snil) pack(mes, explan text) %if mon < 0 %start select output(1) printstring("Connect to "); printstring(calling) printstring(", explan ="); printstring(explan text); newline select output(0) %finish pon(p) bh = bh-1 d_o state = trying %end %record (con des f) %map get free des qfrig == free des %if qfrig == null %start %if no desc = 0 %start; ! suppress multiple printing printstring("rjes: out of descriptors! **** ") no desc = 30; ! wait 60 secs & refuse more devices on ! 'route goodness' poll %finish %result == null %finish free des == qfrig_e qfrig_e == null %result == qfrig %end %routine flush file %integer block type, len %record (mef) %name mes mes == d_hold %unless mes == null %start d_hold == null mes_len = d_n; d_n = 0 mes_a(0) = 0; ! push last frame d_permit = d_permit-1; ! for mode changing to gate(put output, mes, 0) %finish %end %routine send eof(%record (mef) %name mes) mes_len = 2 mes_a(0) = 128; ! ts29 control packet mes_a(1) = 1; ! request ts29 disconnect d_nc = 0; ! marker to stop 2 discs after a reset to gate(put output, mes, 0) %end %routine send input connect to 2900(%record (maof) %name m) !============================================================ %integer n, devtype %record (mef) %name mes %string (15) called %integer i, k mes == d_hold; d_hold == null m_type = x'0300'; ! swab(3) called = unpack(mes, 1) m_address = address(d_index) n = (5+length(m_address)+1)&x'fffe'; ! point past + align i = 2; ! assume "PR" (or "DD") unless otherwise %if called = "LP" %then i = 6 %if called = "CR" %then i = 4 %if mon # 0 %start printstring("In Call,n:"); printstring(called) printstring(": -> type"); write(i, 1) printstring(", from:"); printstring(m_address); newline %finish d_facility = facil(i) m_a(n) = i; m_a(n+1) = 0 m_a(n+2) = 1; m_a(n+3) = d_stream m_a(n+4) = 0; m_a(n+5) = 0 m_mlen = n+5-1; ! len is included (was 12 for address of 2) m_len = swab(m_mlen); ! this is for the 2900 kick 2900 message(m) free buffer(mes) %end %routine kick 2900 message(%record (maof) %name log) !===================================================== %integer x !! this routine sends 'log' to the 2900 by inserting !! it in the input q for stream 4, and kicking it if !! necessary d == d4 %if d_hold == null %and d_inp q_e == null %then %c get buffer(do output) get buffer(do output) %if d_cpos > 5; ! nb compiler fault above #if z %if mon < 0 %start select output(1) printstring("r>E") %cycle x = 0, 1, log_mlen-1 write(log_a(x), 2) newline %and spaces(2) %if x&15=15 %repeat newline select output(0) %finish #fi push(d_inp q, log) d_cpos = d_cpos+1 %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, devtype, devno %record (m2900f) %name m2900 %record (maof) %name m %record (mef) %name mes bh = bh+1 mes == p_mes reason = p_c2; ! get reason for calling d == con desa(p_a2); ! find record of caller %if mon = -1 %start select output(1); printstring("from buff,r&s") write(reason, 1); write(p_a2, 1); newline select output(0) %finish %if d_o state = not alloc %start printstring("RJE: No desc, buff man call =") write(reason, 1); newline free buffer(mes); %return %finish %if reason = get op block %start free buffer(d_hold) %unless d_hold == null d_hold == mes; d_n = 0 get buffer(low level op transfer) %return %finish %if reason = do outbound connect %start do connect(Connect, mes) %return %finish %if reason = do input connect %start send input connect to 2900(mes) %return %finish %if reason = set transparent mode %start string(addr(mes_reserved(7))) = string(addr(trans mode(0))) mes_len = trans mode(0) to gate(put output, mes, 0) %return %finish %if reason = get block for eof %then send eof(mes) %and %return !! message to 2900 reason !! note: streams 4&5 also use this mechanism m2900 == mes m2900_stream = d_stream m2900_sub ident = 10; m2900_p2a = 0; m2900_p2b = 0 type = low level control %if reason = send abort %start m2900_sub ident = 0 m2900_p3a = 0 m2900_p3b = 1 type = send data %finish %if reason = connecting reply %then %c m2900_sub ident = con sub id reply %if reason = connecting reply failed %start m2900_sub ident = con sub id reply m2900_p2b = x'0a00'; ! = swab(10) %if d_nc # 99 %then retrieve(d) ! Spoolr has done a deallocate, descriptor can be ! retrieved immediately UNLESS a Connect is outstanding %finish to 2900(type, m2900) !! %finish %end %integerfn allocate stream(%record (con desf) %name d, %integer type) !! nb: type = 0, allocate even stream for input !! type = 1, allocate odd stream for output(lp etc) %integer i d_stream = 0 %cycle i = fixed+type, 2, fixed top-2+type %if alloc(i) = 0 %start alloc(i) = d_index d_stream = i p_c = i; ! claim the stream to 2900(here i am, null) am1a(i) = d_index %result = i %finish %repeat %result = 0 %end %routine tidy buffers free buffer(pop(d_inp q)) %while %not d_inp q_e == null free buffer(d_hold) %unless d_hold == null d_hold == null %end %routine retrieve(%record (con desf) %name d) !! sever link between 2900 and descriptor and !! free the descriptor %if d_stream <= 5 %start; ! illegae crunch; %return %finish am1a(d_stream) = k'377'; ! mark unused tidy buffers d_o state = not alloc; address(d_index) = "" d_port = 0 alloc(d_stream) = 0 qfrig == d qfrig_e == free des free des == qfrig %end %routine clear all streams !! used when emas goes down %integer i %switch sts(not alloc:closing) %cycle i = 2, 1, con lim d == con desa(i) d_nc = 0 ->sts(d_o state) sts(connect 1): to gate(Disconnect, null, 34); ! reject the connect sts(idle): sts(op ready): sts(timing): retrieve(d) %continue sts(connected): sts(enabld): sts(wait ts): to gate(Disconnect, null, 39) d_o state = aborted %continue sts(trying): sts(reseting): d_o state = aborted %continue sts(aborted): sts(closing): ! must wait for network sts(not alloc): %repeat host state = down %end %routine read from am1 %record (am1f) %name l2 %integer max ad, adr, mode, adr2 %record (mef) %name mes %integer n, cpos, t %if d == null %then mes == null %else %c mes == d_hold %if mes == null %start printstring("rje: seq1! ") t = 0!128; -> skip2 %finish !! (cater for partial block rec'd) %if d_n # 0 %start n = d_n; cpos = d_cpos %else n = 1; !! allow for 1 byte type cpos = 0 %finish !! next section is in assembler in a file 'ercc14.rjeassm' ! acfy =10 ! xopl =20 mode = d_iso&x'20'; ! iso=0, bin # 0 ! if file is iso, then a CR is put ! in front of every LF. ! No change for Binary files l2 == l adr2 = addr(mes_a(0)); !$e max ad = adr2+127; ! can be either 127 or 128 rep cycle: adr = adr2+n; ! mes_a(n) ! #if i *mov_adr,r1 *mov_l2,r3 cyc: *mov_@r3,r2; ! r2 = status *bit_#k'220',r2; ! ready or xopl set? *beq_cyc; ! no, so wait *bit_#xopl,r2; ! was it xop? *bne_xopdwn; ! it was set, so get out *mov_2(r3),r0; ! pick up char *bit_#acfy,@r3; ! did it fail to read? *beq_y1; ! no, so carry on *mov_2(r3),r0; ! read it again *bit_#acfy,@r3; ! failed again? *bne_parity; ! hard failure, so get out y1: *asr_r2; ! get comm bit (9th bit) *bcs_commbt; ! set, so exit *movb_r0,(r1)+; ! store char in array y3: *cmp_r1,maxad; ! at end of array? *bhis_exit2; ! yes, so get out *bis_#2,(r3); ! accept the last char *br_cyc; ! go for the next one exit2: *mov_r1,adr -> exit parity: *mov_r1,adr t = 3; -> skip commbt: *mov_r1,adr t = 2!128; -> skip xopdwn: *mov_r1,adr t = 64 #else *=k'016401';*=k'10'; ! mov 10(r4),r1 ! r1 == nss_a(n) *=k'016403';*=k'4'; ! mov 4(r4),r3 ! l2 = -4(r5) *=k'011302' ; ! cycle: mov (r3),r2 ! stat=r2 *=k'032702';*=k'000220'; ! bit #200+xopl,r2 *=k'001774' ; ! beq cycle ! nothing set, so wait *=k'032702';*=k'000020'; ! bit #xopl,r2 ! xopl set? *=k'001044' ; ! bne xopdwn ! yes, so fail it ! *=k'016300';*=k'000002'; ! mov 2(r3),r0 ! sym=r0 *=k'032713';*=k'000010'; ! bit #acfy,@r3 ! failed to read? *=k'001405' ; ! beq y1 ! no, so carry on *=k'016300';*=k'000002'; ! mov 2(r3),r0 ! read it again *=k'032713';*=k'000010'; ! bit #acfy,@r3 ! failed again? *=k'001024' ; ! bne parity ! yes, so fails ! y1: *=k'006202' ; ! asr r2 ! get comm bit *=k'103425' ; ! bcs commbt ! comm bit seen *=k'020027';*=k'12'; ! cmp r0,#nl ! line feed? *=k'1005'; ! bne y2 ! no, so get out *=k'005764';*=k'12'; ! tst 12(r4) ! is MODE zero? *=k'1002'; ! bne y2 ! no (ie bin) so get out *=k'112721';*=k'15'; ! movb #15,(r1)+ ! plant CR in buffer ! y2: *=k'110021' ; ! movb r0,(r1)+ ! nss_a(n) = sym! n=n+1 *=k'020164';*=k'6'; ! y3: cmp r1,6(r4) ! end of cuurent record *=k'103003' ; ! bhis exit ! yes, so exit *=k'052713';*=k'000002'; ! bis #2,(r3) ! accept char *=k'000736' ; ! br cycle ! ! exit: ! etc *=k'010164';*=k'10'; ! mov r1,10(r4) ! restore 'adr' -> exit ! parity: s1: *=k'010164';*=k'10'; ! mov r1,10(r4) l1: ->parity ! commbt: s2: *=k'010164';*=k'10'; ! mov r1,10(r4) l3: ->comm bit ! xopdwn: xopdwn: t = 64; -> skip; ! send unsuccessfull parity: t = 3; -> skip comm bit: t = 2!128 skip: n = adr-adr2; ! recomput n d_n = n; d_cpos = cpos skip2: p_c1 = t; ! long block+accept last to 2900(return control, null) %return exit: n = adr-adr2; ! recompute n d_hold == null p_c1 = 0!128; ! done+accept last to 2900(return control, null) d_n = 0 mes_len = n mes_a(0) = 0 to gate(put output, mes, 0) d_nc = d_nc+1 d_permit = d_permit-1 %if d_permit > 0 %then get buffer(get op block) %end %routine write to am1 %record (mef) %name mes %integer n, max, end, gate reply, am1 reply, stat am1 reply = 0; ! "normal" reply %while d_o state = enabld %cycle mes == d_hold %if mes == null %then mes == pop(d_inp q) %if mes == null %then %exit !! terminate with "normal" (shouldnt happen) end = mes_len gate reply = enable input; ! allow next to gate n = d_n; ! start of block - d_n = 0 %if n = 0 %and d_push flag = 1 %start; ! 1st char is the ts29 'flag' n = 1; ! skip 1st byte %if mes_a(0) # 0 %start; ! push, ie that was final block %if mes_a(1) # 1 %start printstring("Rjes:con?") write(mes_a(1), 1); newline %finish am1 reply = 4; ! condition y ! on the end of file gate reply = Disconnect %if mon<0 %then printstring("close received ") d_o state = idle -> send to gate %finish %finish %cycle %cycle stat = l_rxs %if stat&xopl#0 %start am1 reply = 64 d_hold == mes; ! retain for retry -> am1 rep %finish %if stat&ready # 0 %start !! l i m i t sent am1 reply = 2; ! long block d_n = n; d_count = max d_hold == mes; ! retain for later -> am1 rep %finish %if l_txs&ready # 0 %then %exit %repeat %if n >= end %start send to gate: !! send go ahead to gate(gate reply, null, 1); ! enable input or disconnect d_push flag = mes_reserved(0); ! pickup the stored p_s1 free buffer(mes) d_hold == null; d_n = 0 %if d_inp q_e == null %then ->am1 rep %exit %finish l_txd = mes_a(n); n=n+1 %repeat %repeat am1 rep: p_c1 = am1 reply to 2900(return control, null) %end !! r e a d m e s s a g e f r o m a m 1 %routine read message from am1 %recordformat mf(%integerarray x(0:15)) %recordformat mt2(%integer a, b, %record (mf) m) %record (maof) %name m %integer n, sym, t, stat, x, q %integer type, strm %switch hlm(1:5) d == d5; ! messages on stream 5 m == d_hold %if m == null %start printstring("rje: seq2! ") t = 0!128; -> reply %finish !! (cater for partial block rec'd) n = d_n %if n = 0 %then d_cpos = 0 %cycle %cycle stat = l_rxs %exit %if stat&(ready!xopl) # 0 %repeat %if stat&xopl # 0 %start; ! xop gone down t = 64; ! send unsuccessfull printstring("rjes: 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("rjes: parity ") -> skip %finish %finish %if stat&comm bit # 0 %start t = 2!128 skip: d_n = n reply: p_c1 = t; ! long block+accept last to 2900(return control, null) %return %finish %if d_count = d_iso %then d_count = -1 %if d_count = d_nc %then -> badm d_count = d_count+1 m_a(n) = sym; n = n+1 %if n = 2 %start; ! Got the total length d_cpos = m_a(1); ! max = 256 %unless 5 < d_cpos <= 256-18 %start badm: printstring("***rjes: message fails -") write(d_cpos, 1); write(d_count, 1); write(d_iso, 1) write(d_nc, 1); write(type, 1) printstring(" all rje messages lost ") -> reply %finish %else %if n = d_cpos %then -> exit3; ! gOT THE WHOLE MESSAGE %finish l_rxs = l_rxs!accept char; ! accept the last char %repeat exit3: d_hold == null t = 0!128; ! normal+accept last %if d_count # d_nc %start; ! Another message waiting get buffer(get op block) %finish #if z %if mon < 0 %start select output(1) printstring("rbadm -> hlm(type) hlm(1): ! Operator message q = (m_a(4)+6)&x'fffe'; ! find op mess %if mon < 0 %start printstring(string(addr(m_a(q)))) %finish free buffer(m) -> reply hlm(2): ! Request O/P Device Allocation d == get free des %if d == null %or m_a(4) > 43 %start; ! failed ! NB: It is failed if either:- ! no streams or descriptors left OR ! Address length is too long (43) m_a(x) = 0; m_a(x+1) = 0 %else i = allocate stream(d, 1); ! odd stream for printer etc address(d_index) = string(addr(m_a(4))) m_a(x) = 1; m_a(x+1) = d_stream; ! Stream in two bytes %if i = 0 %start; ! no free stream qfrig == d; qfrig_e == free des free des == qfrig; ! cant use retrieve - no stream no. m_a(x) = 0; ! send back zero to fail it %else d_o state = idle d_facility = facil(m_a(x-2)) d_devno = m_a(x-1) %finish move it: m_a(x+2) = 0 %finish m_a(1) = x+2 m_m len = x+2 kick 2900 message(m) -> reply hlm(3): ! spoolr Reply to INPUT Device Request strm = m_a(x+1)!(m_a(x)<<8) d == con desa(alloc(strm)) %if m_a(x+3) # 0 %start; ! Rejected to gate(Disconnect, null, 37) %unless d_o state = idle; ! already done retrieve(d) %finish !! a 'yes' will be dealt with when the 2900 does a !! 'connect' to the particular stream free buffer(m) -> reply hlm(4): ! spoolr requests deallocation strm = swab(integer(addr(m_a(x-2)))) d == con desa(alloc(strm)) fault(10) %and -> move it %if d == d4; ! ie was zero! %if mon < 0 %start who and state printstring(" deallocated ") %finish %if d_o state = input ready %or d_o state = timing %c %or d_o state = trying %or d_o state = wait ts %start d_nc = 0 %if d_o state = trying %or d_o state = wait ts %start %if d_o state = wait ts %then to gate(Disconnect, null, 39) d_o state = aborted; ! wait for connect response d_nc = 99 %finish %else d_o state = idle get buffer(connecting reply failed) %else %if d_ostate = connect 1 %start to gate(Disconnect, null, 37) %finish %if d_o state > connect 1 %start m_a(x) = 1; m_a(x+1) = 0; ! send failed (x over) fault(4) -> move it %finish retrieve(d) %finish m_a(x) = 0; m_a(x+1) = 0; ! set flag = ok -> move it; ! shift down record and reply hlm(5): ! spoolr requests route 'goodness' %if m_a(4) = 2 %then last weight = 0 %else %start %if no desc # 0 %then last weight = 0 %else last weight = 200-users-fep weight %finish m_a(x-2) = last weight ! refuse all old style requests -> move it %end !! w r i t e m e s s a g e t o a m 1 %routine write message to am1 %record (maof) %name m %integer n, max, am1 reply, stat d == d4; ! messages on stream 4 am1 reply = 4; ! "condition y" %cycle m == d_hold %if m == null %then m == pop(d_inp q) %and d_cpos = d_cpos-1 %if m == null %then %exit !! terminate with "normal" (shouldnt happen) n = d_n; ! start of block - d_n = 0 %cycle %cycle stat = l_rxs %if stat&xopl#0 %start d_hold == m; ! retain buffer for retry am1 reply = 64; d_kill = n; ->am1 rep %finish %if stat&ready # 0 %start !! l i m i t sent am1 reply = 2; ! long block d_n = n; d_count = max d_hold == m; ! retain for later -> am1 rep %finish %if l_txs&ready # 0 %then %exit %repeat %if n >= m_m len %start free buffer(m) d_hold == null; d_n = 0; d_kill = 0 %if d_inp q_e == null %then ->am1 rep %exit %finish l_txd = m_a(n); n=n+1 %repeat %repeat am1 rep: p_c1 = am1 reply to 2900(return control, null) %end #if m %routine mon mes(%record (mef) %name mes) %integer i, j, k, n k = mes_len write(k, 1); space; space j = 0 %cycle i = 0, 1, k-1 write(mes_a(i), 1) j = j+1; %if j = 20 %then j = 0 %and newline %repeat newline; select output(0) %end %endofprogram