!prep options :- ! ! k - kent ! n - nsi ! r - ring ! x - transport service ! #if (k & n) ! (n & r) ! (n & x) ! (x & r) ! ~(r ! x ! n) #report Incompatible options #abort #fi ! file 'fep_rjes10s' #if k conststring (21) vsn= "rjes:vsn0n10a (kent) " #else conststring (14) vsn= "rjes:vsn0n10a " #fi #datestring !******************************** !* emas-2900 fep rje server * !* file: rjes10s/rjes10y * !* date: 9.Mar.83 * !******************************** control 1 include "deimosperm" begin recordformat am1f(integer rxs, rxd, txs, txd) ownrecord (am1f) name l == 1; ! supplied by am1 handler #if x recordformat lev3f(bytearray reserved(0:7), #if k (byteinteger uflag, #else (integer uflag, #fi bytearray a(0:239) )) #fi #if n recordformat lev3f(byteinteger fn, sufl, st, ss, (byte sn, dn, dt, ds, xflag, ufl, (byteintegerarray aa(0:238) or c integer x1, x2, users, state, cpu, pkts, sbr, byt, rjeo, rjei) orbyte flag, uflag, byteintegerarray a(0:239))) #fi #if r #if k recordformat lev3f(integer sou,ds,rc,tc, c (byteinteger uflag, bytearray a(0:241) or c integer x1, (integer x3, x4, users, state, cpu, c pkts, sbr, byt, rjeo, rjei or c bytearray aa(0:240)))) #else recordformat lev3f(integer sou,ds,rc,tc, c (integer uflag, bytearray a(0:241) or c integer ss, st, sn, (integer x3, x4, users, state, cpu, c pkts, sbr, byt, rjeo, rjei or c bytearray aa(0:240)))) #fi #fi #if x recordformat mef(record (mef) name link, byteinteger len, type, (record (lev3f) lev3 orbytearray params(0:241))) #else recordformat mef(record (mef) name link, byteinteger len, type, record (lev3f) lev3) #fi recordformat m2900f(record (mef) name l, byteinteger len, type, integer stream, sub ident, p2a, p2b, p3a, p3b, p4a, p4b, c p5a, p5b, p6a, p6b) recordformat m2900bf(record (mef) name l, byteinteger len, type, integer stream, sub ident, byteintegerarray b(0:19)) #if n recordformat maf(record (mef) name l, byteinteger mlen, mtype, byteintegerarray spacer(0:11), byteintegerarray a(0:240)) #fi #if r ! x recordformat maf(record (mef) name l, byteinteger mlen, mtype, byteintegerarray spacer(0:19), byteintegerarray a(0:240)) #fi recordformat logf(record (mef) name l, byteinteger mlen, mtype, integer len, type, byteintegerarray m(0:242)) recordformat maof(record (mef) name l, byteinteger mlen, mtype, #if ~x byteintegerarray a(0:240)) #else (byteintegerarray a(0:240) orc integer len, type, string (240) address)) #fi #if x recordformat pe(byteinteger ser, reply, fn, s1, (record (mef) name mes, byteinteger gate port, task port or c string (3) facility orbyte b1, b2, (integer str orbyte c1, c2))) #else recordformat pe(byteinteger ser, reply, fn, port, (record (mef) name mes, byteinteger len, s1 orc byteinteger b1, b2, (byteinteger c1,c2 or integer str))) #fi recordformat qf(record (mef) name e) !******************************************************** !* formats of tables, ie stream descriptors, tcps etc * !******************************************************** recordformat con desf(record (mef) name hold, c #if k integer unitcount, byteinteger unitsize, subunitcount, #fi #if x string (15) called, calling, #else integer node, term, #fi integer index, stream, permit, o state, port, iso, kill, n, cpos, count, nc, facility, record (qf) inp q) !************************************************************ #if x include "tsbsp_tscodes" #else !* upper level (itp&rje) handler messages to gate !************************************************************ constinteger enable facility= 1; ! enable the facility constinteger disable facility= 2; ! the reverse constinteger call reply= 3; ! reply to a 'call connect' constinteger enable input= 4; ! allow a block to be read constinteger put output= 5; ! send a block of output constinteger close call= 6; ! terminate a call constinteger abort call= 7; ! abort the call constinteger open call= 8; ! open up a call constinteger open message= 9; ! send a message constinteger reject= 0; ! qualifier on above !********************************************************** !* messages from gate to upper level protocols !********************************************************** constinteger incoming call= 2 constinteger input recd= 3; ! block arrived from node constinteger output transmitted= 4; ! prepared to accept more constinteger call closed= 5; ! either end has closed down constinteger call aborted= 6; ! other end has aborted constinteger open call a= 7 constinteger open call b= 8; ! reply from remote constinteger message r= 9; ! message rec'd constinteger message reply= 10; ! message reply from gate #fi !************************************************************** !* buffer manager calls (from and to) * !************************************************************** constinteger buffer here= 0 !********** to buffer manager *********** constinteger request buffer= 0 constinteger release buffer= 1 !************************************************************** !* calls to 2900 link handler * !************************************************************** constinteger send data= 0 constinteger low level control= 1 constinteger here i am= 2 constinteger return control= 3 !************************************************************** !* replies from 2900 link handler * !**************************************************************** constinteger interf addr= 0 constinteger do input= 1 constinteger do output= 2 constinteger message= 3 constinteger mainframe up= 4 constinteger mainframe down= 5 !**************************************************************** !********** various service numbers ************* constinteger gate ser= 16 constinteger buffer manager= 17 constinteger link handler= 18 constbyteintegername change out zero == k'160310' constinteger t3 ser= 21 constinteger comm bit= k'1' constinteger accept char= k'002' constinteger acfy= k'010'; ! peter calls it rxfy constinteger xopl= k'020'; ! x operable - latched ! %constinteger xop = k'040'; ! x operable constinteger ready= k'200' constinteger cr= 13 constinteger ff= 14 !*********************************************************** !* 2900 states * !*********************************************************** owninteger 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; ! network 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 #if x constinteger wt close= 9; !data has been pushed, waiting for close #fi !****************************************** !* reasons for waiting for a buffer * !****************************************** constinteger last rje reason= 21 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 #if x constinteger send connect= 31 constinteger send push= 32 #fi !************************************************************** routinespec to gate(integer fn, record (mef) name mes, 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 from buffer manager(record (pe) name p) integerfnspec allocate stream(record (con desf) name d, integer type) routinespec tidy buffers integerfnspec get weight routinespec retrieve(record (con desf) name d) routinespec do transfer message(record (maof) name mes) routinespec reform message(record (maf) name m) #if ~x routinespec do repm(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 !! %permroutinespec push(%record (qf) %name q, %record (mef) %name e) !! %permrecord (mef) %mapspec pop(%record (qf) %name q) #if x routinespec send input connect to 2900(record (maof) name m) #fi !****************************************************** record (pe) p ownrecord (qf) mes q; ! Used to hold messages for 2900 owninteger con sub id reply= 1; ! picks up from actual mess ownrecord (con desf) name d ownrecord (con desf) name d4, d5 owninteger own term= 0; ! distinguish between 2972 & 2980 #if k constinteger con lim= 50; ! number of active terminals (see fixed top) #else constinteger con lim= 90; ! number of active terminals (see fixed top) #fi ownrecord (con desf) array con desa(0:con lim) ownrecord (qf) name free des; ! pts to list of free con desa owninteger no free des= con lim record (qf) name q frig constinteger max ports= 50 #if ~x ownbyteintegerarray porta(0:max ports) #fi ! cross index from port to tcp 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) !* * * * * * * * * * * * * * * * * * constbyteintegerarray facil(0:14)= 0, 6, 0, 7, 0, 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 wt= 0; ! additional 'route' weight owninteger port= 0; ! current port no ? 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 owninteger m1, m2, m3, m4, m5; ! $$ buffer monitoring integer i #if x conststring (3) array sfacil(0:15)= ".??", ".pp", ".pr", ".cp", ".cr", ".mt", ".lp", ".gp", ".op", ".mp", ".do", ".??", ".ct", ".su", ".fe", ".??" !convert spoolr device code to string which is appended to address string !to give the name looked up #else conststring (3) array sfacil(0:20)= "??", "di", "??"(2), "lp", "??", "pp", "??", "gp", "mp", "??"(2), "cr", "do", "??"(6), "mt" #fi #if x conststring (7) array ostates(-1:9)= "not all", "waiting", "ready", "asking", "timing", "abortng", "chcking", "conning", "going", "close", "wt clse" #else conststring (7) array ostates(-1:8)= "not all", "waiting", "ready", "asking", "timing", "abortng", "chcking", "conning", "going", "close" #fi #if x constinteger fac max= 8 conststring (3) array fac(1:fac max)= "CR", "MES", "INF", "LOG", "PR", "DI", "CR1", "CR2" #else constbyteintegerarray ef(1:8)= 1, 2, 10, 11, 12, 13, 21, 4 #fi ! gate facility nos #if n constinteger header len= 6, message header = 10 #fi #if r ! x #if k constinteger header len= 1, message header = 0; ! ?? #else constinteger header len = 2, message header = 0; ! ?? #fi #fi #if n constinteger clock time= 100; ! nsi - 2 secs #fi #if r ! x constinteger clock time= 500; ! ring - 10 secs #fi #if n constinteger iso flag= 5, binary flag = 1 #fi #if r ! x #if k constinteger iso flag= x'5', binary flag = x'1' #else constinteger iso flag = x'0500', binary flag = x'0100' #fi #fi ownstring (1) snil="" ownstring (4) me="RJES" #if k !table of name/address to convert sendmessage destinations (ring addresses) !into machine names constinteger maxnames=10 ownstring (3) array ring addr(1:maxnames)="T45","T57","T27", "T15","T71","T54","T43","T30","T39","T46" ownstring (7) array ring name(1:maxnames)="EAGLE","COMET","DEVSYS", "EMASFEP","BOOK","GATE","SGATE","TCPA","TCPB","TCPC" #fi !********************************************** !* 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 #if ~k p_ser = 0; poff(p); ! wait for instructions own term = p_fn; ! 2980 or 2972 ? if own term=80 then wt = 40; ! weight at 40 for 2980 if own term#80 and own term#72 then wt = 90; ! not allowed thru #fi printstring(vsn.datestring); newline map hwr(0); ! map am1 to segment 0 !!!! i = map virt(buffer manager, 5, 4); ! i = 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_str = 4; ! param for 'here i am' to 2900(here i am, null) p_str = 5 to 2900(here i am, null) #if x for i = 1, 1, fac max cycle p_ser = gate ser; p_reply = own id p_fn = enable facility; p_s1 = 0 p_facility = fac(i) pon(p) repeat #else to gate(enable facility, null, ef(i)) for i = 1, 1, 8 #fi alarm(clock time); ! set clock for 2 secs !********************************************** !* main loop * !********************************************** cycle p_ser = 0; poff(p) if 'M'<=int<='P' start mon = int-'O'; int = 0 finish if '0'<=int<='9' start wt = (int-'0')*10; int = 0 finish if int='?' start printstring("Current wt ="); write(get 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("p ="); write(d_port, 1) printstring(", c ="); write(d_nc, 1) newline finish repeat int = 0 newline finish if p_reply=link handler start from 2900 finishelseif p_reply=gate ser start from gate finishelseif p_reply=buffer manager start from buffer manager(p) finishelseif p_reply=0 start ; ! clock tick cycle i = con lim, -1, 0 d == con desa(i) #if x if d_o state=timing then get buffer(send connect) and d_o state = trying #else if d_o state=timing then do connect(open call, null) #fi repeat alarm(clock time) 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 wait end routine to gate(integer fn, record (mef) name mes, integer flag) if fn=put output start ; ! queue these as necessary 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 #if x p_task port = d_index; p_gate port = d_port #else p_port = d_port #fi p_fn = fn; p_mes == mes; p_s1 = flag pon(p) end routine to 2900(integer fn, record (m2900f) name m2900) p_ser = link handler; p_reply = own id p_fn = fn; p_mes == m2900 pon(p) end routine get buffer(integer reason) record (pe) p !******************************************************* !* hold a pool, so can call buffer here immedialtely* !* otherwise hold the activity until it arrives* !******************************************************* #if x if reason=get op block then p_c1 = 0 else p_c1 = 1 p_c2 = reason; p_s1 = d_index #else if reason=get op block then p_len = 0 else p_len = 1 p_s1 = reason; p_port = d_index #fi ! ****** watch the above line ******** if buffer pool==null or reason#get op block 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 #if x printstring(d_called); spaces(10-length(d_called)) printstring(d_calling); spaces(10-length(d_calling)) #else integer n #if k n = d_facility & 31; !device no in top 3 bits #else n = d_facility #fi if d_stream&1=0 and n=13 then n = 1; ! input printstring(sfacil(n)) #if k printsymbol((d_facility >> 5) +'0'); !device no #fi write(d_term, 1) space #fi end routine who and state tell printsymbol('(') printstring(ostates(d_o state)) printstring(") ") end routine report error(integer n) who and state; printstring(" error "); write(n, 1); newline end #if x integerfn pposition(record (mef) name mes, integer i) !-------------------------------------------------------- integer n n = 0; !return position of i'th param in mes while i > 1 cycle n = n+mes_params(n)+1 i = i-1 repeat result = n end routine unpack(string (*) name s, record (mef) name mes, integer i, maxlen) !-------------------------------------------------------------------- !unpack the i'th string from mes into s making sure it's not longer than maxlen string (*) name source integer len source == string(addr(mes_params(pposition(mes, i)))) len = length(source) if len>maxlen then length(source) = maxlen; !change length in situ s = source; !copy the string length(source) = len; !restore the length end routine pack(record (mef) name mes, string (*) name s) ! append s as ts parameter to mes integer l l = mes_len string(addr(mes_params(l))) = s mes_len = l+length(s)+1 end routine mreply(string (*) name s, integer flag, record (mef) name m) !------------------------------------------------------------------------- m_len = 0 pack(m, me) pack(m, s); !message text to gate(datagram reply, m, flag) end routine send disconnect(string (*) name s, integer flag, record (mef) name mes) !--------------------------------------------------------------- mes_len = 0 pack(mes, me) pack(mes, s) to gate(disconnect, mes, flag) end #else routine plant fail(integer type, record (mef) name mes) record (lev3f) name lev3 lev3 == mes_lev3 lev3_aa(0) = 1 lev3_aa(1) = type mes_len = 12 end #fi #if x #if k routine convert(string (*) name calling) !------------------------------------------ integer i !convert calling ring address (Tnn) to name using fixed table for i=1, 1, maxnames cycle if calling=ring addr(i) then calling=ring name(i) andexit repeat end #fi routine from gate; !ts version switch fns(connect:datagram reply) integer fn, strm, l, i, flag, max, char record (mef) name mes string (15) called, calling recordformat inff(integer users,state,cpu,pkts,sbr,byt,rjeo,rjei or byteintegerarray byta(1:16)) record (inff) inf; !formatting data for info poll ownstring (9) emas down mess="emas down" ownstring (9) not known mess = "not known" ownstring (16) device busy mess = "device busy" ownstring (4) down mess = "down" ownstring (22) no free rje ports mess = "no free rje ports" string (63) explan fn = p_fn strm = p_task port if (fn#connect) and (fn#datagram) start ; !check task port if 0<=strm<=con lim start d == con desa(strm) else printstring("rjes: illegal stream no.") write(strm, 1); write(fn, 1); newline return finish else d == d4; !use if all else fails d_port = p_gate port finish mes == p_mes ->fns(fn) fns(connect): if host state=down start send disconnect(emas down mess, 19, p_mes) return finish !check if device already known unpack(called, mes, 1, 15) unpack(calling, mes, 2, 15) if mon<0 start printstring("connect to ".called." from ".calling) newline finish for i = 2, 1, con lim cycle d == con desa(i) if d_stream&1=0 and d_calling=calling and d_called=called start if d_o state#input ready start d == d4; !use this descriptor send disconnect(device busy mess, 17, p_mes) return finish mes_len=0 pack(mes, me); pack(mes, snil) d_port = p_gate port to gate(accept call, mes, 0); !ok get buffer(connecting reply); !accept connect d_o state = connected return finish repeat !not known so allocate new descriptor d == get free des; !new device if d==null start d == d4; !use this as the only available descriptor send disconnect(no free rje ports mess, 17, mes) return finish d_port = p_gate port i = allocate stream(d, 0) d_calling = calling d_called = called d_o state = connect1 d_nc = 0; d_iso = 0 if mon<0 start tell; printstring("asking ") finish send input connect to 2900(mes) return fns(input here): rjei = rjei+1 mes_lev3_reserved(0) = p_s1; !push flag if d_inp q_e==null and d_hold==null and d_o state=enabld start get buffer(low level ip transfer) d_n = 0 finish push(d_inp q, mes); !put buffer on queue d_nc = d_nc+1 return fns(enable output): l = p_s1; !number of enables if d_permit=0 and d_ostate=enabld then get buffer(get op block); !was waiting for network d_permit = d_permit+l return fns(disconnect): if mes == null start explan = snil else unpack(explan, mes, 2, 63) freebuffer(mes) finish flag = p_s1 if d_o state=trying start ; !connect failed ! %if flag#17 %and flag#23 %start; !not busy or network congestion ! get buffer(connecting reply); !pretend it's ok ! get buffer(send abort); !then kill it ! d_o state = idle ! tell ! printstring(" connect failed-"); printstring(explan); newline ! %else if flag#17 start ; !not busy reply, give message now and again if d_nc & 31 = 1 start ; !about 5 min intervals tell printstring(" connect failed (still trying)-") printstring(explan); newline finish finish d_nc = d_nc+1; d_port = flag d_o state = timing ! %finish return finish if d_o state#closing and d_o state#aborted then to gate(disconnect, null, 1); !acknowledge if flag>1 and d_o state # wt close start ; !0 => ok, 1 => ack who and state printstring("Network abort-"); printstring(explan); newline finish if d_ostate=closing or d_o state=wt close start unless d_hold==null then to 2900(low level control, d_hold); !reply to 2900 disconnect d_o state = idle; d_hold == null else if d_o state=not alloc thenreturn ; !*************** if d_o state=connected or d_o state=enabld or d_ostate=input ready then get buffer(send abort) if d_o state=aborted then retrieve(d) else d_o state = idle finish return fns(accept call): free buffer(mes) if d_o state#aborted start report error(7) andreturnunless d_o state=trying if mon<0 start tell; printstring("connected ") finish d_port = p_gate port get buffer(connecting reply) d_iso = 0; d_permit = 1 d_o state = connected d_nc = 0 finish return fns(reset):; !can't do anything but disconnect %if mes == null %start explan = snil %else unpack(explan, mes, 2, 63) free buffer(mes) %finish %if d_o state = closing %or d_o state = aborted %then %return who and state printstring("network reset-"); printstring(explan); printstring("-aborting") newline to gate(disconnect, null, 30) %if d_o state = connected %or d_o state = enabld %or d_ostate = wt close %c %then get buffer(send abort); !into 2900 d_o state = closing %return fns(datagram): ; !send message unpack(called, mes, 1, 15) unpack(calling,mes, 2, 15) unpack(explan,mes,4,63) %if called="INF" %start; !poll from info {!build up reply, then copy into correct portion of explan string} {!and send it back (there's a horrible overhead in string copying here} {!and inside the ts driver)} { inf_users = users} { inf_state = host state} { inf_cpu = cpu; inf_pkts = pkts; inf_sbr = sbr} { inf_byt = byt; inf_rjeo = rjeo} { inf_rjei = rjei} {!the first 6 bytes of explan are returned unchanged} {!the copying is done in bytes because the integers all span words in explan} { %for i=1,1,16 %cycle} { charno(explan, 6+i)=inf_byta(i)} { %repeat} { length(explan)=22} charno(explan, 5)=users charno(explan, 7)=host state length(explan)=8 mreply(explan, 0, mes) return finish if called="LOG" start ; !logon/off if host state=down start mreply(down mess, 18, mes) return finish mes_len = p_gate port; !remember it for the reply push(mes q, mes) get buffer(transfer message) return finish if called="MES" start #if k convert(calling); !convert from address (Tnn) to name #fi printstring(calling); printsymbol(':') unpack(explan, mes, 4, 63) i = 1; !first char position cycle max = charno(explan, i) if max=x'80' then i = i+1 and max = charno(explan, i) i = i+1 while max>0 cycle char = charno(explan, i) printsymbol(char); i = i+1 max = max-1 repeat newline unless char=nl exitif i>=length(explan) spaces(12) repeat mreply(snil, 0, mes) return finish mreply(not known mess, 16, mes) return fns(datagram reply): unless mes==null then free buffer(mes) return end #else routine from gate record (mef) name mes record (lev3f) name lev3 record (con des f) name d2 integer fn, flag, strm, max, i, ind, char, trm, fac, fl, node switch fns(incoming call:message reply) fn = p_fn strm = p_port d == con desa(porta(strm)) ->fns(fn) fns(incoming call): flag = 0; ! reject if all else fails !! There are two possible conditions, !! 1) The specific device has already send in a file. !! 2) the 2900 has to be asked to validate the device if host state=down start plant fail('D', p_mes) ->reply finish lev3 == p_mes_lev3 trm = p_s1; fl = p_c1; ! for/rev buffer limits #if n i = fl>>4 if i>2 then i = 2 fl = i<<4; ! limit to 2 forward fac = lev3_ds #fi #if ~k node = lev3_sn #else node = 0 #fi #if r fac = p_s1 #if k trm = p_c1 #else trm = lev3_st if node = 0 then trm = p_c1; ! _c1 if from ring #fi #fi cycle i = 2, 1, con lim d == con desa(i) if d_stream&1=0 and d_term=trm and fac=d_facility start ; ! Already known to FEP if d_o state#input ready then plant fail('B', p_mes) and ->reply get buffer(connecting reply); ! connect reply d_o state = connected #if n flag = fl; ! accept the call #fi #if r flag = 1 #fi ->connect port finish repeat d == get free des if d==null then plant fail('F', p_mes) and ->reply ! No free descriptors !! construct a message to the 2900 ******* i = allocate stream(d, 0); ! even stream only d_facility = fac; ! fixed at cr for now d_node = node; d_term = trm d_iso = fl; ! remember the flags word d_o state = connect 1; ! wait for confirmation d_nc = 0 if mon<0 start tell; printstring("asking ") finish get buffer(do input connect) connect port: d_port = p_port; ! remember gate port no porta(p_port) = d_index; ! backward mapping returnif flag=0; ! Asking the 2900, so wait reply: do repm(flag) return fns(input recd): rjei = rjei+1 mes == p_mes if d_inp q_e==null and d_hold==null and 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(output transmitted): d_permit = d_permit+1 if d_permit=1 and d_o state=enabld then get buffer(get op block) return fns(call closed): returnif d_stream&1=0 and d_o state#closing !! eof on input is handled by "write to am1" !! on output is handled inside "call aborted" fns(call aborted): ! all is lost if d_o state=closing start if mon#0 start tell; printstring("close ack ") finish if host state=down then retrieve(d) andreturn to 2900(low level control, d_hold) d_o state = idle; d_hold == null else who and state #if k cycle i=1,1,10 printsymbol(7); !ring the bell for operators repeat #fi printstring("network abort ") if d_o state=not alloc thenreturn ; ! very nasty *************** if d_o state>=connected or d_o state=input ready start get buffer(send abort); ! get 2900 to abort stream to gate(abort call, null, 0); ! reply to gate to clear port finish if d_ostate=aborted or host state=down then retrieve(d) else d_o state = idle finish return fns(open call a): ! allocated port no d == con desa(p_port) !! p_port < 0 (ie failed!) #if n d_port = p_s1 #fi #if r d_port = p_b1 #fi if d_port=0 then p_s1 = 125 elsestart porta(d_port) = p_port return finish !* d_port = 0 => no gate ports, so treat as a open call b !* with error flag = 125 fns(open call b): ! reply from remote device flag = p_s1; ! success/fail flag if d_o state=aborted start !! connection established ? if flag#0 then retrieve(d) elsestart to gate(abort call, null, 0) d_nc = 98 finish return finish report error(7) andreturnunless d_o state=trying ! problems with not-allocated if flag#0 start if d_nc=0 start if mon<0 start tell; printstring("connect failed"); write(flag, 1) newline finish finish #if k if flag = 18 start ; !device u/s get buffer(connecting reply); !pretend its ok get buffer(send abort); !then kill it d_ostate=idle if host state=down then retrieve(d) else #else if flag#0 start #fi d_nc = d_nc+1; d_port = flag; ! remember reason d_o state = timing finish else if mon#0 start tell; printstring("connected ") finish get buffer(connecting reply); ! get buffer to reply to spoolr d_permit = 1; d_iso = 0; ! set iso mode d_o state = connected d_nc = 0 finish return fns(message r): ! incoming login or enquiry flag = 128; ! reply ok, unless ... lev3 == p_mes_lev3 #if n fac = lev3_ds #fi #if r fac = p_s1 #fi if fac=21 start ; ! poll from info lev3_users = users; !$e - all of section $e lev3_state = host state lev3_cpu = cpu; lev3_pkts = pkts; lev3_sbr = sbr lev3_byt = byt; lev3_rjeo = rjeo lev3_rjei = rjei p_mes_len = 22+message header-1; !$e - and above section ->repm2 finish if fac>=10 start ->repm if fac=10 !! logon or oper message and 2900 is actually up if host state=down start flag = 0; plant fail('d', p_mes) ->repm finish push(mes q, p_mes); ! retain the message #if n lev3_sufl = p_port; ! remember the gate port #fi #if r lev3_rc = p_port #if k lev3_sou=p_c1 #else if lev3_sn = 0 then lev3_st = p_c1; ! set the source in correctly #fi #fi get buffer(transfer message) return ; ! Wait for the buffer finish i = 0 if mon#0 or fac=1 start #if k printstring(" t"); write(lev3_sou, 1) #else printstring(" t"); write(lev3_st, 1) #fi printsymbol(':') cycle max = lev3_aa(i) if max=x'80' then max = lev3_aa(i+1) and i = i+1 i = i+1 while max>0 cycle char = lev3_aa(i) printsymbol(char); i = i+1; max = max-1 repeat newline unless char=nl exitif i>=p_mes_len-message header spaces(12) repeat finish repm: p_mes_len = message header repm2: do repm(flag) return fns(message reply): ! reply to sendmessage free buffer(p_mes) unless p_mes==null ! ignore, but free buffre if necessaay end #fi !! 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 (mef) name mes integer stream, sub ident, state, mode, am1c #if k integer unitsize #fi 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 else unless p_fn<message then ->link fns(p_fn) stream = p_str finish am1c = am1a(stream) if am1c=k'377' then d == null else 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 read from am1 return link fns(do input): ! -> 2900 if stream=4 then write message to am1 else 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 #if k unitsize = m2900b_b(0) ! this is relevant only when connecting ! as the mode is meaningless at this point #fi 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 start printstring("rjes:no desc, kick =") write(state, 1); newline ->control reply finish ->com state(state) com state(enabling): report error(1) and ->control reply if d_o state=idle report error(2) if d_o state#connected 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 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 tell and printstring("conn ") if ioflag#0 start ; ! output report error(3) if d_o state#idle #if k d_unitsize = unitsize d_subunitcount = 0 d_unitcount = 0 #fi #if x do connect(connect, m2900); d_nc = 0 return #else do connect(open call, null); d_nc = 0 #fi else ; ! input if d_o state=connect 1 start #if x to gate(accept call, null, 0) #else p_port = d_port; ! for repm #if n do repm(d_iso) #fi #if r do repm(1); ! ok #fi #fi 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 x if d_o state=connected start if ioflag#0 and d_kill=suspending start ; !end of transfer flush file get buffer(send push); !to close the stream d_o state = wt close else to gate(disconnect, null, 42) tidy buffers d_o state = closing finish d_hold == m2900; !save reply till later return finish report error(4) if d_o state#idle ->control reply #else report error(4) unless d_o state=connected or d_o state=idle if d_o state#idle start d_o state = closing if ioflag#0 and d_kill=suspending start flush file mode = close call; ! for "to gate" call else mode = abort call; tidy buffers finish d_hold == m2900 to gate(mode, null, 0); ! reply to gate return ; ! hold reply till later finish ->control reply #fi com state(aborting): if mon#0 start tell; printstring("aborting ") finish ->suspd com state(suspending): if mon<0 start tell; printstring("susp ") finish suspd: report error(5) unless d_o state=enabld or d_o state=idle d_o state = connected unless d_o state=idle d_kill = state; ! remember type of call ! stop transfers unless its idle anyway #if k m2900_p3b = swab(d_subunitcount) m2900_p3a = swab(d_unitcount) #fi 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 clear all streams ->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) ownstring (15) emas rje output mess = "emas rje output" #if n recordformat p3f(byteinteger ser, reply, fn, port, (byteinteger facility, flag or c record (mef) name mes), byteinteger node, term) #fi #if r recordformat p3f(byteinteger ser, reply, c fn, port, (byteinteger node, flag or c record (mef) name mes), byteinteger term, facility) #fi #if ~x record (p3f) p3 p3_ser = gate ser; p3_reply = own id p3_fn = type; p3_port = d_index p3_node = d_node p3_term = d_term #if r p3_facility = 2; ! for send messages #fi if type=open call start #if n p3_flag = x'40' #fi p3_facility = d_facility d_o state = trying finishelse p3_mes == mes pon(p3) #else mes_len = 0 pack(mes, d_called) pack(mes, me); !calling address pack(mes, snil); !quality of service pack(mes, emas rje output mess); !explanatory text d_port = 0; !not assigned yet to gate(type, mes, 0) if type=connect then d_o state = trying #fi 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) elsestart block type = iso flag; ! set iso mode if d_iso#0 then block type = binary flag len = d_n+header len if d_n=d_cpos+2 then len = len-2 ! 2 dummy length bytes present mes_lev3_uflag = block type; mes_len = len; d_n = 0 d_permit = d_permit-1; ! for mode changing to gate(put output, mes, 0) finish finish end !! r o u t i n e from buffer manager !! all requests for buffers come back through here #if ~x routine form 2900 message(record (logf) name log) !! this routine inserts the stream no, sub ident !! network address into a message for stream 4 log_m len = 12 log_type = x'0300'; ! = swab(3) log_len = x'0c00'; ! = swab(12) log_m(0) = 2; log_m(1) = d_node; log_m(2) = d_term log_m(5) = 0; log_m(6) = 1; log_m(7) = d_stream log_m(8) = 0; log_m(9) = 0 end #fi routine kick 2900 message(record (logf) 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 == d4 if d_hold==null and d_inp q_e==null then get buffer(do output) get buffer(do output) if d_cpos>5; ! nb compiler fault above push(d_inp q, log) d_cpos = d_cpos+1 end #if x routine send input connect to 2900(record (maof) name m) !---------------------------------------------------------- integer l, n, devno, devtype string (15) called m_type = x'0300' called = d_called m_address = d_calling l = length(called) devno = 0 if '0'<=charno(called, l)<='9' start devno = charno(called, l)-'0'; !e.g. LP0 length(called) = l-1; !remove digit at end finish if called="CR" then devtype = 4 elsestart if called="LP" then devtype = 6 else devtype = 2 finish n = (5+length(d_calling)+1)&x'fffe'; !4 bytes for len and type fields !1 for string len and 1 for rounding m_a(n) = devtype; m_a(n+1) = devno m_a(n+2) = 1; m_a(n+3) = d_stream m_a(n+4) = 0; m_a(n+5) = 0 m_mlen = n+4 m_len = swab(m_mlen) kick 2900 message(m) end #fi routine from buffer manager(record (pe) name p) integer reason, n, type #if k integer devtype, devno; !facility number in 2 fields #fi record (m2900f) name m2900 record (mef) name mes record (logf) name log #if x reason = p_c2 d == con desa(p_s1) #else reason = p_s1; ! get reason for calling d == con desa(p_port); ! get console desxcriptor #fi 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 ~x if reason=do input connect start log == p_mes form 2900 message(log) #if k devtype = d_facility & 31 devno = d_facility >> 5 if devtype = 12 then i = 4 elsestart if devtype = 4 then i = 6 else c i = 2; ! cr (12) = 4, pr(13) = 2 finish #else if d_facility=12 then i = 4 elsestart if d_facility=4 then i = 6 else i = 2; ! cr (12) = 4, pr(13) = 2 finish #fi log_m(4) = i #if k log_m(5) = devno #fi kick 2900 message(log) return finish #fi #if x if reason=send connect start do connect(connect, p_mes) return finish if reason = send push start p_mes_len=0 d_permit = d_permit - 1 to gate(put output, p_mes, 1); !push null data to close the transfer return finish #fi !! 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 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_str = i; ! claim the stream to 2900(here i am, null) am1a(i) = d_index no free des = no free des-1 result = i finish repeat result = 0 end routine tidy buffers free buffer(pop(d_inp q)) whilenot d_inp q_e==null free buffer(d_hold) unless d_hold==null d_hold == null end integerfn get weight #if k result = 100 #else integer n result = 1 if wt=90 n = 120-wt+no free des if own term#80 then n = n-users result = n #fi end routine retrieve(record (con desf) name d) !! sever link between 2900 and descriptor and !! free the descriptor if d_stream<=5 then crunch am1a(d_stream) = k'377'; ! mark unused tidy buffers #if x d_called = snil d_calling = snil #else d_term = -1 #fi d_o state = not alloc alloc(d_stream) = 0 qfrig == d qfrig_e == free des free des == qfrig no free des = no free des+1 end routine do transfer message(record (maof) name m) !! send operator message to the 2900 record (mef) name mes record (lev3f) name lev3 integer i, n, x mes == pop(mes q); ! get stored message #if x m_type = x'0100' unpack(m_address, mes, 2, 15); !calling address #if k convert(m_address); !from address (Tnn) to name #fi x = (length(m_address)+6)&x'fffe' !copy explan text (the datagram message) into the 2900 form i = pposition(mes, 4)+1; !start of param 4 text in mes n = mes_params(i) if n>=128 then i = i+1 and n = mes_params(i); !2 byte length if n>50 then n = 50; !only short buffer mes_params(i) = n; !set length in buffer string(addr(m_a(x))) = string(addr(mes_params(i))); !copy the string x = (x+n+2)&x'fffe'; !aligned length !x=length of address + len and type, n is the length !of the text (+2 for len byte & rounding ) m_m len = x m_len = swab(x) d == d4; !use d4 for 'to gate' call d_port = mes_len; !saved in here mreply(snil, 0, mes) kick 2900 message(m) #else lev3 == mes_lev3 form 2900 message(m) n = 0 if lev3_aa(0)>=128 then n = n+1; ! 2 byte length x = lev3_aa(n) if x>50 then x = 50; ! give it a big buffer???? lev3_aa(n) = x; ! shorten length in buffer cycle i = 0, 1, x m_a(i+8) = lev3_aa(n+i) repeat i = (i+9+1)&x'fffe'; ! Allow for header and make even m_a(1) = i; ! length of message m_a(3) = 1; ! type = 1 #if k m_a(5) = 0; m_a(6) = lev3_sou #else m_a(5) = lev3_sn; m_a(6) = lev3_st #fi m_m len = i; ! length again kick 2900 message(m) p_mes == mes #if n p_port = mes_lev3_sufl; ! restore gate port number #fi #if r p_port = mes_lev3_rc #fi mes_len = message header; ! delete the text do repm(128); ! reply to gate #fi end routine reform message(record (maf) name m) !! send 2900 message to rje operator record (mef) name mes #if x string (63) text string (15) called #else record (lev3f) name lev3 #fi integer i, len, x, pt, npt, max mes == m #if x called = string(addr(m_a(4))) pt = (6+length(called))&x'fffe' if m_a(pt)>63 then m_a(pt) = 63; !truncate message if too long text = string(addr(m_a(pt))) !pack info in network format mes_len = 0 called = called.".SSP" pack(mes, called) pack(mes, snil) pack(mes, snil) npt = mes_len+2; !point to position of 4'th param x = npt-1; !position of length of sub record pt = 1; !string pointer cycle i = charno(text, pt); !next char mes_params(npt) = i if i=nl or pt=length(text) start ; !handle lines without nl mes_params(x) = npt-x; !length of sub record npt = npt+1; !leave hole for length of next sub rec x = npt; !and remember where exitif pt = length(text); !npt points to next unused byte finish pt = pt+1; npt = npt+1 repeat len = npt-mes_len; !total length of param 4 mes_params(mes_len) = len-1; !string length mes_len = mes_len+len d_port = 0 to gate(datagram, mes, 0) #else lev3 == mes_lev3 #if n lev3_ds = 2; ! facility = 2 #fi lev3_aa(0) = 0; ! protect against zero data max = m_a(8)+8; ! pick up length (strings later?) x = 0; len = 0; pt = 9; npt = 1 cycle i = m_a(pt) lev3_aa(npt) = i if i=nl start lev3_aa(x) = npt-x npt = npt+1; x = npt finish pt = pt+1; npt = npt+1 exitif pt>max repeat #if n lev3_ufl = 5; ! set iso #fi #if r & ~k lev3_sn = d_node #fi mes_len = npt-2+message header+1 do connect(open message, mes) #fi end #if ~x routine do repm(integer flag) !! sends a 'call reply' to gate, nb: assumes p_port = port number p_ser = gate ser; p_reply = own id p_fn = call reply; p_s1 = flag pon(p) end #fi ! c l e a r a l l s t r e a m s 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): #if x to gate(disconnect, null, 39) #else p_port = d_port do repm(0); ! reply 'reject' to connect #fi sts(idle): sts(op ready): sts(timing): retrieve(d) continue sts(connected): sts(enabld): #if x sts(trying): to gate(disconnect, null, 39) #else to gate(abort call, null, 0) #fi d_o state = aborted continue #if ~x sts(trying): #fi sts(closing): d_o state = aborted continue sts(aborted): sts(not alloc): repeat end routine read from am1 record (am1f) name l2 integer max ad, adr, adr2 record (mef) name mes record (lev3f) name lev3 integer n, sym, cpos, t, stat #if k integer c #fi if d==null then mes == null else mes == d_hold if mes==null start printstring("rje: seq1! ") t = 0!128; ->skip2 finish lev3 == mes_lev3 !! (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(lev3_a(0)); ! lev3_a(0) max ad = adr2+239 rep cycle: adr = adr2+n; ! lev3_a(n) ! *=k'016401'; *=k'10'; ! mov 10(r4),r1 ! r1 == lev3_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)+ ! lev3_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 lev3_a(cpos) = x'80'; lev3_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 lev3_a(cpos) = x'80' lev3_a(cpos+1) = n-cpos-2 #if k if d_unitsize#0 start if d_facility=4 or d_facility=9 start ; ! lp or mp c = lev3_a(n-1) if c=k'12' start ; ! linefeed d_subunitcount = d_subunitcount+1 if d_subunitcount>=d_unitsize thenstart d_unitcount = d_unitcount+1 d_subunitcount = d_subunitcount-d_unitsize finish finishelsestart if c=k'14' start ; ! formfeed d_unitcount = d_unitcount+1 d_subunitcount = 0 finish finish finishelseif d_facility=6 start ; ! pp c = d_subunitcount+(n-cpos-2) while c>d_unitsize cycle d_unitcount = d_unitcount+1 c = c-d_unitsize repeat d_subunitcount = c finish finish #fi 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 if d_iso=0 then lev3_uflag = iso flag else lev3_uflag = binary flag !! iso = 0, flag=5 => iso, iso # 0 => binary mes_len = n+header len 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 record (lev3f) name lev3 integer n, max, char, end, gate reply, am1 reply, stat, f ownstring (14) input finished mess = "input finished" 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 thenexit !! terminate with "normal" (shouldnt happen) lev3 == mes_lev3 end = mes_len-header len #if ~x gate reply = enable input; ! allow next to gate #fi 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 thenexit repeat if max=0 start #if x if f=0 and d_called="CR" start #else if f=0 and d_facility=12 start #fi f = 1 l_txd = nl continue finish max = lev3_a(n) if max>127 start ; ! 2 byte length max = lev3_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 n if lev3_flag&128#0 start #fi #if r if lev3_tc & 4 # 0 start ; ! e-o-f #fi #if x if lev3_reserved(0)#0 start ; !pushed #fi am1 reply = 4; ! condition y ! on the end of file #if x send disconnect(input finished mess, 0, mes) d_hold == null; d_n = 0 d_o state = closing ->am1 rep #else gate reply = close call if mon#0 then tell and printstring("close received ") d_o state = idle #fi finish !! send go ahead #if x to gate(enable input, null, 1) #else to gate(gate reply, null, 0); ! enable input or close call #fi 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 = lev3_a(n); n = n+1; max = max-1 finishelse 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:7)) #if n recordformat mt1(integer a, b, byteintegerarray c(0:11), record (mf) m) #fi #if r ! x recordformat mt1(integer a, b, bytearray c(0:19), c record (mf) m) #fi recordformat mt2(integer a, b, record (mf) m) record (mef) name mes record (lev3f) name lev3 record (logf) name log record (maf) name m integer n, flag, sym, cpos, count, t, stat, x integer node, term, type, strm record (mt1) name m1; record (mt2) name m2 record (m2900f) name m2900 #if x string (3) facname #fi 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 exitif 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: 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 start printstring("***rjes: message overrun -") printstring(" all rje messages lost ") ->reply finish 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)+m_a(0)<<8; ! max = 256 if d_cpos>256-18 start printstring("***rjes: message too long -") 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 type = m_a(3); ! max = 256 #if ~x d_node = m_a(5); ! NSI Dependant d_term = m_a(6) #fi ! pointer = 8; ! for future use x = (8+m_a(4))&x'fffe' m_m len = n ->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 #if x facname = sfacil(m_a(x-2)); !facility name from spoolr code d_called = string(addr(m_a(4))).facname #else d_node = d5_node; d_term = d5_term #fi d_facility = facil(m_a(x-2)) 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 = swab(integer(addr(m_a(x)))) d == con desa(alloc(strm)) if d==d4 start printstring("rjes: spoolr type 3? ") else if m_a(x+3)#0 start ; ! Rejected #if x to gate(disconnect, null, 37) #else p_port = d_port; ! set up p_port for do repm do repm(0); ! reject flag #fi retrieve(d) finish !! a 'yes' will be dealt with when the 2900 does a !! 'connect' to the particular stream finish free buffer(m) ->reply hlm(4): ! spoolr requests deallocation strm = swab(integer(addr(m_a(x-2)))) d == con desa(alloc(strm)) if d==d4 start ; ! ie was zero printstring("rjes: deallocation with no desc, stream =") write(strm, 1); newline ->do it finish if mon#0 start who and state printstring(" deallocated ") finish if d_o state=input ready or d_o state=timing 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 #if x to gate(disconnect, null, 37) #else p_port = d_port do repm(0); ! reject the connect #fi finish if d_o state>connect 1 start report error(6) #if x m_a(x) = 1; m_a(x+1) = 0; !send failed ->move it #else m_a(x) = 0; m_a(x+1) = d_o state; ->move it #fi finish retrieve(d) finish do it: m_a(x) = 0; m_a(x+1) = 0; ! set flag = ok ->move it; ! shift down record and reply hlm(5): ! spoolr requests route 'goodnness' ! m_a(4) = address len, 5&6 are adress, 8 is remote no #if x if m_a(4)=2 start ; ! address len # 2 (old style) #else if m_a(4)#2 start ; ! address len # 2 (new style) #fi m_a(x-2) = 0; ! complete reject ->move it finish m_a(x-2) = get weight ->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, end, 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 thenexit !! 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 thenexit 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 endofprogram