%conststring (7) vsn = "vsnx01a" !******************************** !* emas-2900 fep rje server * !* file: rjesx1/rjesx1y * !* date: 07.aug.81 * !* modified for ring 27.oct.80 !******************************** !! stack size = 300 %control 1 %include "deimosperm" %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)) %recordformat maf(%record (mef) %name l, %byteinteger mlen, %c mtype, %byteintegerarray spacer(0:19), %byteintegerarray a(0:240)) !! Incoming data on stream 5 from the 2900 is in the form of !! records preceeded by their length. These are placed in a !! buffer in the format 'maf', ie with a spacer array to place !! them further down th buffer !! 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, node, term, facility, %c o state, port, iso, kill, %c n, cpos, count, nc, %record (qf) inp q) !************************************************************ !* Function Values between Upper level and Gate !************************************************************ %constinteger connect = 1 ;! start a call up %constinteger accept call = 2; ! accept a call %constinteger Disconnect = 3; ! Stop a call, or reject a connect %constinteger Enable Input = 4; ! Allow data, Gate -> Task %constinteger Put Output = 5; ! Output Block, Gate -> Task %constinteger Enable Output = 4; ! Allow Output, Task -> Gate %constinteger Input Here = 5; ! Input Block, Task -> Gate %constinteger Reset = 6; ! Reset the Virtual Circuit (!) %constinteger Expedited = 7; ! Pass 'Interrputs' %constinteger Datagram = 8; ! Send a 'datagram' %constinteger Datagram Reply = 9; ! Reply to a datagram %constinteger Enable Facility = 10; ! Claim incoming calls Task -> Gate %constinteger Disable Facility= 11; ! Stop them !************************************************************** !* buffer manager calls (from and to) * !************************************************************** ! %constinteger buffer here = 0 !********** to buffer manager *********** %constinteger request buffer = 0 %constinteger release buffer = 1 !************************************************************** !* calls to 2900 link handler * !************************************************************** %constinteger send data = 0 %constinteger low level control = 1 %constinteger here i am = 2 %constinteger return control = 3 !************************************************************** !* replies from 2900 link handler * !**************************************************************** %constinteger interf addr = 0 %constinteger do input = 1 %constinteger do output = 2 %constinteger message = 3 %constinteger mainframe up = 4 %constinteger mainframe down = 5 !**************************************************************** !********** various service numbers ************* %constinteger gate ser = 16 %constinteger buffer manager = 17 %constinteger link handler = 18 %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 !*********************************************************** !* 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 connected = 6; ! in file %constinteger enabld = 7; ! 2900 has started file %constinteger closing = 8; ! 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 transfer message = 28 %constinteger connecting reply = 29 %constinteger connecting reply failed = 30 !************************************************************** %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) %routinespec do transfer message(%record (maof) %name mes) %routinespec reform message(%record (maf) %name m) %routinespec do repm(%record (mef) %name mes, %integer flag) %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 %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 max ports = 50 %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 = -1; ! monitoring flag %owninteger fep weight = 40; ! 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 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) = "??", "di", "??"(2), "lp", "??", "pp", "cp", "gp", "mp", "??"(2), "cr", "do", "??"(6), "mt" %conststring (7) %array ostates(-1:8) = "not all", "waiting", "ready", "asking", "timing", "abortng", "chcking", "conning", "going", "close" %constinteger fac max = 3 %ownstring (3) %array fac(1:3) = "TT", "RJE", "LP" ! gate facility nos %ownstring (21) %array address(0:con lim) %ownstring (255) Explan Text %ownstring (1) snil = "" !********************************************** !* initialisation * !********************************************** change out zero = t3 ser %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(500); ! set clock for 10 secs !********************************************** !* main loop * !********************************************** %cycle p_ser = 0; poff(p) %if 'M' <= int <= 'P' %start mon = int-'O'; int = 0 %finish %if int = '?' %start %cycle i = 2, 1, con lim d == con desa(i) %if d_o state # not alloc %start printstring("rje:") who and state printstring("p ="); write(d_port, 1) printstring(", c ="); write(d_nc, 1) newline %finish %repeat int = 0 newline %finish %if '0' <= int <='9' %start; ! change weight int fep weight = (int-'0')*10; int = 0 %finish %if p_reply = link handler %start from 2900 %finish %else %if p_reply = gate ser %start from gate %finish %else %if p_reply = buffer manager %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 %then do connect(Connect, null) %repeat alarm(500) %finish %repeat !************************************************* !* routines to do the work * !************************************************* %routine crunch %integer i who and state; newline %cycle i = 1, 1, 10 printstring("**** rjes failed - dump it *** ") %repeat *=k'104001' %end %routine to gate(%integer fn, %record (mef) %name mes, %c %integer flag) !======================================================== %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'77'#0 %then crunch %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 pon(p) %end %routine to 2900(%integer fn, %record (m2900f) %name m2900) p_ser = link handler; p_reply = own id p_fn = fn; p_mes == m2900 pon(p) %end %routine get buffer(%integer reason) %record (pe) p !******************************************************* !* 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 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) %finish %end %routine free buffer(%record (mef) %name mes) %record (pe) p %if addr(mes)&k'140000'=k'140000' %or addr(mes)&k'77'#0 %then crunch %if mes_type # 0 %or no of buff > 3 %start p_ser = buffer manager; p_reply = own id !! queue it if it is a long buffer p_fn = release buffer; p_mes == mes pon(p) %else !! long buffer, so queue it mes_link == buffer pool; buffer pool == mes no of buff = no of buff+1 %finish %end !! %routine tell !! monitoring routine %integer n n = d_facility %if d_stream&1 = 0 %and n=13 %then n = 1; ! input printstring(sfacil(n)) 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 %routine do repm(%record(mef)%name mes, %integer flag) !! sends a 'call reply' to gate, nb: assumes p_port = port number 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 %routine from gate !================= %record (mef) %name mes %string (15) called, s1, s2 %integer fn, flag, strm, max, i, char, trm, fac %integer node %switch fns(connect:disable facility) fn = p_fn strm = p_gate port mes == p_mes d == con desa(p_task port) ->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, ie node, term, Facility etc picked up later ! address(d_index) = unpack(mes, 2) d_o state = connect 1; ! wait for confirmation d_nc = 0; d_kill = 0 d_hold == mes; ! hold params for now %if mon # 0 %start tell; printstring("asking ") %finish get buffer(do input connect) %return fns(input here): rjei = rjei+1 mes == p_mes %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 push(d_inp q, mes); ! q buffer anyway d_nc = d_nc+1; ! count it %return fns(enable output): d_permit = d_permit+p_s1 %if d_permit = 1 %and d_o state = enabld %then %c get buffer(get op block) %return fns(Disconnect): ! Which variety %if d_o state = trying %start; ! reply (failed) to a 'Connect' %if flag=18 %start; !device u/s get buffer(connecting reply); !pretend it's ok get buffer(send abort); !then kill it d_ostate=idle %if host state=down %then retrieve(d) %else d_nc = d_nc+1; d_port = flag; ! remember reason d_o state = timing %finish %return %finish %if d_stream&1 = 0 %and p_s1 = 0 %start; ! normal Input Disc d_kill = 1; ! check other uses ????????????? %return %finish %if d_o state = closing %start %if mon>0 %start tell; printstring("close ack ") %finish %if host state = down %then retrieve(d) %and %return to 2900(low level control, d_hold) d_o state = idle; d_hold == null %else who and state printstring("network abort ") %if d_o state = not alloc %then %return; ! very nasty *************** %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 = aborted %or host state = down %then %c retrieve(d) %else d_o state = idle %finish %return fns(Accept Call): ! reply from remote device 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 = 98 %return %finish %if mon # 0 %start tell; printstring("connected ") %finish get buffer(connecting reply); ! get buffer to reply to spoolr d_permit = 0; d_iso = 0; ! set iso mode d_o state = connected d_nc = 0 %return 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 %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): 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 -> control reply %if d == null -> 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 do connect(Connect, m2900); d_nc = 0; %return %else; ! input %if d_o state = connect 1 %start to gate(Accept Call, null, 0) to gate(Enable Input, null, 0) d_o state = connected ->control reply %finish ! its ready and waiting d_o state = input ready %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 d_o state = closing %if ioflag # 0 %and d_kill = suspending %start flush file flag = 0; ! Normal disconnect %else flag = 39; tidy buffers %finish d_hold == m2900 to gate(Disconnect, null, flag); ! reply to gate %return; ! hold reply till later %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: 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 com state b(connecting): 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 ") -> 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) 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 %string (15) ad p_ser = gate ser; p_reply = own id p_fn = type p_gate port = 0; p_task port = d_index p_mes == mes facn = "S2" %if type = connect %then %c facn = "S".tostring(d_facility+'0'); ! name - ie .lp later mes_len = 0 ad = address(d_index).facn pack(mes, ad) pack(mes, snil) pack(mes, snil) pack(mes, explan text) pon(p) %end %record (con des f) %map get free des qfrig == free des %if qfrig == null %start printstring("rjes: out of descriptors! **** ") %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 %if d_n <= 2 %then free buffer(mes) %else %start block type = x'0500'; ! set iso mode %if d_iso # 0 %then block type = x'0100'; ! 2nd byte len = d_n+2; !$e %if d_n = d_cpos+2 %then len = len-2 ! 2 dummy length bytes present mes_len = len; d_n = 0 d_permit = d_permit-1; ! for mode changing to gate(put output, mes, 0) %finish %finish %end %routine send input connect to 2900(%record (maof) %name m) !============================================================ %integer n, devtype %record (mef) %name mes %string (15) called 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 %if called = "S12" %then devtype = 4 %else %start %if called = "S13" %then devtype = 2 %else %start devtype = 6 ! cr(12)=4, pr(13)=2, lp(4)=6 %finish %finish d_facility = facil(devtype) m_a(n) = devtype; 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 mon < 0 %start select output(1) printstring("r>2") %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 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 reason = p_c2; ! get reason for calling d == con desa(p_a2); ! find record of caller %if reason = get op block %start d_hold == p_mes; d_n = 0 get buffer(low level op transfer) %return %finish %if reason = transfer message %start do transfer message(p_mes) %return %finish %if reason = do input connect %start send input connect to 2900(p_mes) %return %finish !! message to 2900 reason !! note: streams 4&5 also use this mechanism m2900 == p_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) %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 %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 %finish am1a(d_stream) = k'377'; ! mark unused tidy buffers d_o state = not alloc; address(d_index) = "" alloc(d_stream) = 0 qfrig == d qfrig_e == free des free des == qfrig %end %routine do transfer message(%record (maof) %name m) !===================================================== !! send operator message to the 2900 %record (mef) %name mes %integer i, n, x %string (*) %name s mes == pop(mes q); ! get stored message explan text = unpack(mes, 4) m_type = x'0100'; ! = swab(1) m_address = unpack(mes, 2) x = (length(m_address)+6)&x'fffe' n = 1 %if charno(explan text, 1) >= x'80' %then n = 2 s == string(addr(explan text)+n) %if length(s)>50 %then length(s) = 50 string(addr(m_a(x))) = s x = (x+length(s)+3)&x'fffe' m_m len = x; ! includes length itself m_len = swab(x) kick 2900 message(m) d == null p_gate port = mes_params(1); ! restore p_gate port number explan text = ""; ! delete the text do repm(mes, 0); ! reply to gate %end %routine reform message(%record (maf) %name m) !! send 2900 message to rje operator %record (mef) %name mes %recordformat ssmf(%bytearray a(0:240)) %record (ssmf) %name ssmessage %integer i, len, x, pt, npt, max %string (15) called mes == m ssmessage == record(addr(explan text)) called = string(addr(m_a(4))) pt = (6+length(called))&x'fffe' max = m_a(pt)+pt pt = pt+1 x = 1; len = 0; npt = 2 %cycle i = m_a(pt) ssmessage_a(npt) = i %if i = nl %start ssmessage_a(x) = npt-x npt = npt+1; x = npt %finish pt = pt+1; npt = npt+1 %exit %if pt > max %repeat address(d_index) = called; ! pickup address in message ssmessage_a(0) = npt-2; ! length of message + len + extra len do connect(Datagram, mes); ! mes is noe redundant, for use in do connect %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) ->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): to gate(Disconnect, null, 39) d_o state = aborted %continue sts(trying): 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, 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 = 2; !! allow for 2 byte count cpos = 0 %finish !! next section is in assembler in a file 'ercc14.rjeassm' ! acfy =10 ! xopl =20 l2 == l adr2 = addr(mes_a(0)); !$e max ad = adr2+239 rep cycle: adr = adr2+n; ! mes_a(n) ! *=k'016401';*=k'10'; ! mov 10(r4),r1 ! r1 == mes_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'001051' ; ! 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'001031' ; ! bne parity ! yes, so fails ! y1: *=k'006202' ; ! asr r2 ! get comm bit *=k'103432' ; ! bcs commbt ! comm bit seen *=k'110021' ; ! movb r0,(r1)+ ! nss_a(n) = sym! n=n+1 *=k'020027';*=k'000040'; ! cmp r0,#40 ! space? *=k'002012' ; ! bge y3 ! greater than, so ok *=k'020027';*=k'000012'; ! cmp r0,#10. ! newline *=k'001415' ; ! beq exit ! is lf *=k'002406' ; ! blt y3 ! not in special char range *=k'020027';*=k'000015'; ! cmp r0,#13. *=k'001411' ; ! beq exit *=k'020027';*=k'000014'; ! cmp r0,#12. *=k'001406' ; ! beq exit ! form feed *=k'020164';*=k'6'; ! y3: cmp r1,6(r4) ! 239 chars? *=k'103003' ; ! bhis exit ! yes, so exit *=k'052713';*=k'000002'; ! bis #2,(r3) ! accept char *=k'000731' ; ! br cycle ! ! exit: ! etc *=k'010164';*=k'10'; ! mov r1,10(r4) ! restore 'adr' -> exit ! parity: *=k'010164';*=k'10'; ! mov r1,10(r4) l1: ->parity ! commbt: *=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 mes_a(cpos) = x'80'; mes_a(cpos+1) = n-cpos-2 skip2: p_c1 = t; ! long block+accept last to 2900(return control, null) %return exit: n = adr-adr2; ! recompute n mes_a(cpos) = x'80' mes_a(cpos+1) = n-cpos-2 %if n < 239-132 %start cpos = n; n = n+2 l_rxs = l_rxs!accept char; ! accept the last char -> rep cycle %finish d_hold == null p_c1 = 0!128; ! done+accept last to 2900(return control, null) d_n = 0 mes_len = n 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, f 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 max = 0; f = 1; n = d_n; ! start of block - d_n = 0 %if n # 0 %then max = d_count %and f = 0; ! in block already %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 max = 0 %start %if f = 0 %and d_facility = 12 %start f = 1 l_txd = nl %continue %finish max = mes_a(n) %if max>127 %start; ! 2 byte length max = mes_a(n+1) n = n+1 %finish n = n+1; ! in block f = 0 %unless max = 0; ! nasty zero length %finish %if n > end %start %if d_kill # 0 %and d_inp q_e == null %start; ! disconnect has been rec'd am1 reply = 4; ! condition y ! on the end of file gate reply = Disconnect %if mon#0 %then printstring("close received ") d_o state = idle %finish !! send go ahead to gate(gate reply, null, 1); ! enable input or disconnect free buffer(mes) d_hold == null; d_n = 0 %if d_inp q_e == null %then ->am1 rep %exit %finish %if max # 0 %start l_txd = mes_a(n); n=n+1; max = max-1 %finish %else l_txd = nl %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:10)) %recordformat mt1(%integer a, b, %byteintegerarray spacer(0:19), %c %record (mf) m) %recordformat mt2(%integer a, b, %record (mf) m) %record (maf) %name m %integer n, sym, t, stat, x %integer type, strm %record (mt1) %name m1; %record (mt2) %name m2 %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 mon < 0 %start select output(1) printstring("r<2") %cycle x = 0, 1, n-1 write(m_a(x), 2) newline %and spaces(2) %if x&15 = 15 %repeat newline select output(0) %finish type = m_a(3); ! max = 256 x = (8+m_a(4))&x'fffe'; ! point x past address & pointer !! format is, len, type, address (pointer, stream etc or ?) ! pointer = 8; ! for future use m_m len = n %unless 1 <= type <= 5 %then ->badm -> hlm(type) hlm(1): ! Operator message reform message(m) -> reply hlm(2): ! Request O/P Device Allocation d == get free des %if d == null %start; ! failed m_a(x) = 0; m_a(x+1) = 0 %else i = allocate stream(d, 1); ! odd stream for printer etc d_o state = idle d_facility = facil(m_a(x-2)) address(d_index) = string(addr(m_a(4))) m_a(x) = 1; m_a(x+1) = d_stream; ! Stream in two bytes move it: m_a(x+2) = 0 %finish m_a(1) = x+2 m_m len = x+2 m1 == m; m2 == m1 m2_m = m1_m; ! Move the 2900 message down buffer 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) 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)) -> 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 %start get buffer(connecting reply failed) %finish %if d_o state = trying %start d_o state = aborted; ! wait for connect response d_nc = 99 %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) -> 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 m_a(x-2) = 0 %else %c m_a(x-2) = 140-users-fep 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 ! %routine mon mes(%record (mef) %name mes) ! %integer i, j, k, n ! %record (bsp3f) %name bsp3 ! ! k = mes_len+8;! bsp3 == mes_bsp ! write(k, 1);! space;! space ! j = 0 ! %cycle i = 0, 1, k-1 ! write(bsp3_a(i), 1) ! j = j+1;! %if j = 20 %then j = 0 %and newline ! %repeat ! newline;! select output(0) ! %end %endofprogram