! file 'fep_gatex1' %conststring (7) vsn = "vsn001a" !**************************** !* emas-2900 fep gate * !* file: gatex1 * !* date: 07.aug.81 * !**************************** !! stack size = 300 %owninteger own term = 72; ! network address %owninteger subattach flag = 74 %control 1 %include "deimosperm" %externalstring (127) %fnspec itos(%integer i,j) %begin %recordformat nsif((%byteinteger fn, sufl, st, ss, %c (%byte sn, dn, dt, ds, flag, ufl, %bytearray a(0:238) %or %c %byte sflag, suflag, %bytearray sa(0:242)) %or %c %byteintegerarray b(0:246))) %recordformat mef(%record (mef) %name link, %c %byte len, type, (%integer compatibility, %record (nsif)nsi %or %c %bytearray params(0:239))) %recordformat pe(%byteinteger ser, reply, %c (%byte fn, s1, %record(mef)%name mes, %byte gate port, task port %or %c %byte a1, a2, b1, b2, c1, c2)) %recordformat qf(%record (mef) %name e) %recordformat line statef(%integer node state, att flag, %c line no, ser no, node number) %recordformat portf(%byte state, task port, %c no, mt, node, term, fl, rl, owner, niff, max fl, ss, ingo, uib, %c %integer inbl, outbl, %c %record (qf) input q, out q, %record (line statef) %name ln) !********************************************** !* nsi functions fron node * !********************************************** %constinteger attach = 1; ! nsi fn values %constinteger send mess = 2 %constinteger connect c = 3 %constinteger send block = 4 %constinteger status = 5 %constinteger nif = 6 %constinteger remove = 7 %constinteger subattach = 255 %constinteger reply = 128; ! added to above for reply %constinteger attach r = 8; ! 'real' value is attach+128 %constinteger send mess r = 9 %constinteger connect r = 10 %constinteger send block r = 11 %constinteger status r = 12 %constinteger nif r = 13 %constinteger remove r = 14 !************************************************************ !* 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 !********** to buffer manager *********** %constinteger request buffer = 0 %constinteger release buffer = 1 !************************************************************** !******* calls on line (or protocol) handler ********* !************************************************************ %constinteger line input = 1 %constinteger line output = 2 %constinteger hello = 2; ! in p_c1 !************************************************************ !********** various service numbers ************* %constinteger gate ser = 16 %constinteger from prot = 10 %constinteger buffer manager = 17 %constintegername pkt == k'100010' %constintegername sbr == k'100006' %constintegername byt == k'100004' %constbyteintegername change out zero == k'160310' %constinteger t3 ser = 21 !********************************************** !* port states * !********************************************** %constinteger down = 0 %constinteger connecting = 1 %constinteger connected = 2 %constinteger disconnecting = 3 %constinteger discon 2 = 4 %constinteger aborting = 5 %constinteger clearing = 6; ! line has gone down %constinteger port busy = 7 !**** rest are sub states of 'awaiting buffer' %constinteger attach rb = 5 %constinteger status reply rb = 7 %constinteger send status rb = 8 %constinteger send bl reply rb = 6 %constinteger send bl reply drb = 9; ! also set disconnect %constinteger send bl drb = 10; ! send a block with disconnect %constinteger send message = 11; ! send an nsi message %constinteger send connect = 12; ! send an "nsi" connect %constinteger send connect reply = 13 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! general variables !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! %record (pe) p !! %owninteger mon = 0; ! monitoring off %constinteger maxt = 50 %ownrecord (portf) %name port %ownrecord (portf) %array porta(0:maxt) %record (line statef) %name ln, l0, l1 %record (line statef) %array lna(0:1) !******************************************************** !* facility: containes either - zero - not allocated * !* or - ser no of owner proc * !******************************************************** %constinteger fac max = 25 %ownbyteintegerarray facility(0:fac max) = 0(*) %constinteger mfact = 5 %ownstring (3) %array fac type(1:mfact) = "ITP", "RJE", "TT", "FEP", "LP" %constintegerarray fac value(1:mfact) = 18, 13, 2, 9, 4 %ownstring (239) text %routinespec from higher level %routinespec do att rem(%integer type, %record (mef) %name mes) %routinespec fault(%integer type, port n) %routinespec to upper(%integer call, %record (mef) %name mes) %routinespec to node(%record (mef) %name mes) %routinespec ask for block(%integer reason, port no) %record (mef) %mapspec node %routinespec buffer arrived %routinespec tidy ports %routinespec free buffer(%record (mef) %name mes) %routinespec clear busy ports %integerfnspec unpack qual(%string (*) %name s) %integerfnspec unpack address(%string(*)%name s, %bytename n, t, st) %string (127) %fnspec unpack(%record (mef) %name mes, %integer no) %string (127) %fnspec con qual(%integer n) %routinespec pack(%record(mef)%name mes, %string (*) %name s) %string (127) %fnspec convert(%integer node, term) %routinespec node monitor(%record (mef) %name mes) %ownstring (1) snil = "" %integer i %record (mef) %name mes %owninteger tsl, ib, ic, ob, oc change out zero = t3 ser; ! set 'select output(0)' to common i = map virt(buffer manager, 5, 4) i = map virt(buffer manager, 6, 5) ! map buf man seg 6 to seg 4 port == porta(1) linkin(gate ser); linkin(from prot) p_ser = 0; poff(p); ! wait for instructions own term = p_fn; sub attach flag = p_gate port alarm(100) %cycle i = 1, 1, maxt port == porta(i) port_no = i %repeat l0 == lna(0) l1 == lna(1) %cycle p_ser = 0; poff(p) %if 'M' <= int <='O' %start mon = int-'O'; int = 0 %finish %if int = 'D' %start; ! force down ask for block(attach rb, 0) ln_att flag = 0 int = 0 tidy ports %finish !********************************* !* 1) message from upper level * !* 2) message from node * !********************************* %if p_ser = gate ser %then from higher level %if p_reply = buffer manager %start buffer arrived %finish %else %if p_ser = own id %start %if p_reply = 0 %start; ! clock tick alarm(100); ! 2 secs %if int = '?' %start %cycle i = 0, 1, 1 %if i = 0 %then %c printstring("ln0 ") %else printstring("ln1 ") ln == lna(i) %if ln_att flag = 0 %then printstring("down") %c %else printstring("att ") printstring(" to Node") write(ln_node number, 1); newline %repeat printstring("Strm State T Line F/B Buff uib in blk out blk ") %cycle i = 1, 1, maxt port == porta(i) %if port_state # down %start write(i, 2); write(port_state, 5) write(port_term, 5) %if port_ln == l0 %then printstring(" ln0") %c %else printstring(" ln1") write(port_max fl, 5); write(port_rl, 1) write(port_uib, 6) write(port_in bl, 6); write(port_out bl, 6) newline %finish %repeat int = 0 %finish %if int = 'F' %then int=0 %and clear busy ports tsl = tsl+1 %if tsl = 15 %start; ! 30 secs tsl = 0 %if int = 'P' %start printstring("gate: i,o") write(ib, 3); write(ic, 4) write(ob, 4); write(oc, 4); newline ib=0; ic=0; ob=0; oc=0 %finish %finish %continue %finish %finish %else %if p_ser = from prot %start; ! message from prot han ln == lna(p_a2) %if p_fn = line input %START mes == node %unless mes == null %then free buffer(mes) %else !! line output %if p_c1 = hello %start ln == lna(p_a2); ! its line number ln_line no = p_a2 ln_ser no = p_reply %continue %finish %if p_c1 = 1 %start; ! node down printstring("line ") printsymbol(ln_line no+'0'); printstring(" down ") ln_node state = 0; ln_att flag = 0 tidy ports %else !! up message or write ack %if ln_node state = 0 %start printstring("line ") printsymbol(ln_line no+'0'); printstring(" up ") ask for block(attach rb, ln_line no) ln_node number = p_c2 ln_node state = 1 %finish %finish %finish %finish %repeat %routine to node(%record (mef) %name mes) %if ln_node state = 0 %start free buffer(mes); ! node is down %return %finish %if mon # 0 %start select output(1) printstring("o "); node monitor(mes) select output(0) %finish p_mes == mes; p_c1 = mes_len pkt = pkt+1; byt = byt+(p_c1>>2) ob = ob+1; oc = oc+p_c1 !************************************************* !* message to node: p_mes points to hdlc space * !************************************************* p_ser = ln_ser no; p_reply = own id p_fn = line output pon(p) %end %routine ask for block(%integer reason, port no) !=============================================== %record (pe) p p_ser = buffer manager; p_reply = own id p_fn = request buffer; p_c2 = reason; p_a2 = port no p_c1 = 0; ! ask for long block pon(p) %end %routine check SBR !================== %if (port_max fl<2 %and port_uib>=1 %and port_fl>=1) %c %or (port_uib>=2 %and port_fl>=2) %start ask for block(send bl reply rb, port_no) sbr = sbr+1 %finish %end %record (mef) %map node !====================== %integer fn, i, term, port n, discon, fac no, type %record (nsif) %name nsi %record (mef) %name mes %string (15) called, calling, qual %constbyteintegerarray valid(attach:remove r) = 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0 !! a "1" in valid specifies that nsi_ss = portn %switch sw(0:15) !**************************************************** !* all messages from node come to here * !* p_a1 points no the nsi header * !* p_a2 is the length of the nsi pcket * !**************************************************** mes == p_mes nsi == mes_nsi fn = nsi_fn %if mon # 0 %start select output(1) printstring("i "); node monitor(mes) select output(0) %finish ib = ib+1; ic = ic+mes_len %if fn&128 # 0 %then fn = fn&127+7 port n = nsi_ss; ! pick up stream as index port == porta(port n); ! for those who need it %unless 1<= fn <= 15 %start rubbish: fault(1, port n); node monitor(mes) ->free %finish !! compiler fault with complex conditio %if fn = 7 %then -> rubbish %if mes_len <= 5 %then -> rubbish %unless 0<=port n<=maxt %or valid(fn) = 0 %then -> rubbish -> sw(fn) sw(attach): -> fail sw(send mess): type = datagram; fac no = 2 nsi_ufl = mes_len-10; text = string(addr(nsi_ufl)) -> get sw(connect c): type = connect; text = "" fac no = nsi_ds; ! get the facility number get: %if fac no <= fac max %and facility(fac no) # 0 %start; ! enabled ok %cycle i = 1, 1, maxt port == porta(i) %if port_state = down %start port_state = connecting port_owner = facility(fac no) port_term = p_s1; ! copy to port port_ln == ln; ! remember which line port_mt = mes_nsi_dt; ! could be on sub-attach term port_node = nsi_sn; port_term = nsi_st; port_ss = nsi_ss port_niff = nsi_flag called = "S" called = called.itos(nsi_ds, -1) calling = convert(nsi_sn, nsi_st) qual= con qual(nsi_flag) mes_len = 0 pack(mes, called); pack(mes, calling) pack(mes, qual); pack(mes, text) to upper(type, mes) %result == null %finish %repeat %finish !! either facility not enabled or no free ports nsi_fn = nsi_fn!128 nsi_sufl = 128+8; nsi_a(0) = 2 nsi_a(1) = 'n'; nsi_a(2) = 'o' mes_len = 13; ! +2 ????? to node(mes) %result == null sw(send block): -> fail %unless port_state > down !! deal with incoming buffer ack %if nsi_sflag&x'70'#0 %start i = nsi_sflag>>4 %if port_rl = 0 %then to upper(enable output, null) port_rl = port_rl+i !! discon 2 state ???? %finish mes_len = mes_len-6; ! delete nsi header discon = nsi_sflag&128 port_uib = port_uib+1; ! Unacknowl. Input Blocks port_in bl = port_in bl+1 %if port_ingo > 0 %start port_ingo = port_ingo-1 to upper(Input Here, mes) %else push(port_input Q, mes) %finish %if discon # 0 %start port_state = disconnecting p_s1 = 0; ! normal disconnect to upper(Disconnect, null) %finish %else check SBR; ! see if an SBR should be sent %result == null sw(status): -> fail %unless port_state > down %if nsi_sflag&128 # 0 %start ! disconnect set do status: p_s1 = 41; ! call abandoned by operator to upper(Disconnect, null) %if port_state >= disconnecting %then %c port_state = down %else %c port_state = aborting ->free %finish -> reply sw(nif): port n = nsi_ss; ! some nifs have differing addresses port == porta(portn) printstring("gate> nif") node monitor(mes) %if nsi_flag&128#0 %then port_niff=1 %and -> do status !! without disconnect ->free sw(attachr): -> free %if nsi_st = sub attach flag %if nsi_sufl # 0 %start ! failed do att rem(remove, mes) %result == null %finish ln_att flag = 1 printstring("attached ok ") %if subattach flag#0 %and ln == l0 %start do att rem(subattach, mes) %result == null %finish -> free sw(send messr): sw(connect r): %if port_state # connecting %then -> fail p_s1 = nsi_sufl %if p_s1 = 128+3 %start printstring("gate: busy port") write(port n, 1); newline port_state = port busy %finish %if fn = send mess r %start p_c1 = port_task port; ! return users index no to upper(datagram reply, mes) !! nb: upper must free 'mes' port_state = down %unless port_state = port busy %result == null %finish %if nsi_sufl # 0 %start port_state = down %unless port_state = port busy p_s1 = nsi_sufl to upper(Disconnect, null) -> free %finish %else port_state = connected port_rl = nsi_flag>>4; ! technically is flag not rl(see put output) port_max fl = (nsi_flag>>1)&7; ! sbr removal code port_fl = 0; ! port_fl contains the no of unack blocks port_ingo=1; port_in bl=0; port_out bl=0; port_uib = 0 called = "" qual = con qual(nsi_flag) mes_len = 0 pack(mes, called); pack(mes, qual) to upper(accept call, mes) p_s1 = port_rl to upper(Enable Output, mes) %result == null sw(send block r): %if port_state = disconnecting %and nsi_sflag&128 # 0 %start p_s1 = 1; ! response to a Disconnect to upper(Disconnect, null) port_state = down %else i = nsi_sflag>>4 %if i = 0 %then i = 1 port_rl = port_rl+i p_s1 = i to upper(Enable Output, null) %finish %if port_state = discon 2 %start; ! waiting to send disconnect port_state = disconnecting nsi_fn = 4; nsi_sflag = 128; mes_len = 6 -> send to node %finish ->free sw(status r): -> fail %unless port_state = aborting p_s1 = 1 to upper(disconnect, null); ! confirmation of abort port_state = down -> free sw(nif r):-> fail sw(remove): -> fail sw(remove r): do att rem(attach, mes) %result == null reply: nsi_fn = nsi_fn!128 send to node: to node(mes) %result == null free: %result == mes; ! block is passed back for ! next read sw(*): fail: fault(100+fn, port n) printstring("state ="); write(port_state, 1); newline node monitor(mes) %result == mes %end !! %routine from higher level %record (mef) %name mes %record (nsif) %name nsi %integer fn, port n, flag, reason, x %string (15) qual, called %switch function(Connect:Disable Facility) %switch post(down: port busy) %constbytearray port ok(Connect:Disable Facility) = 0, 1, 1, 1, 1, 0, 0, 0, 1, 0, 0 port n = p_gate port fn = p_fn %if (portn=0 %or portn>maxt) %and port ok(fn) # 0 %then %c fault(2, port n) %and %return port == porta(port n) ln == port_ln; ! pick up output line mes == p_mes; nsi == mes_nsi %if mon < 0 %start select output(1) printstring("fn:"); write(fn, 2); write(portn, 2) write(p_task port, 2); write(p_s1, 2); newline select output(0) %finish ->function(fn) function(enable facility): %cycle x = 1, 1, mfact %if string(addr(p_b1)) = fac type(x) %start facility(fac value(x)) = p_reply %return %finish %repeat printstring("Gate: Unexpect facility "); printstring(string(addr(p_b1))) newline %return function(disable facility): facility(p_s1) = 0 %return function(accept call): ! reply to a 'connect' -> fault it %if port_state # connecting port_state = connected port_task port = p_task port flag = port_niff; ! get rl & fl in case no buffer %if %not mes == null %start qual = unpack(mes, 2); ! get second parameter out flag = unpack qual(qual) free buffer(mes) %finish port_rl = flag>>1&7 port_fl = 0; port_max fl = flag >>4 port_niff = flag; ! hold for connect reply port_ingo=1; port_in bl=0; port_out bl=0; port_uib = 0 reason = send connect reply -> do request buffer function(enable input): ! allow a block to be read %return %if port_state # connected x = p_s1 port_fl = port_fl+x port_ingo = port_ingo+x %while port_ingo#0 %and %not port_input Q_e == null %cycle mes == pop(port_input Q) to upper(Input Here, mes) port_ingo = port_ingo-1 %repeat check SBR %return function(put output): ! p_mes to be sent %if port_state # connected %start free buffer(mes) %return %finish port_out bl = port_out bl+1 %if port_rl > 0 %start; ! allowed to send one port_rl = port_rl-1 nsi_fn = 4; nsi_sufl = 0 nsi_st = port_mt; nsi_ss = port_no nsi_suflag = 1; ! binary !! sbr removal code %if port_max fl >=2 %and port_fl#0 %start x = port_fl; ! no Task has ack %if x>port_uib %then x = port_uib; ! actual no in nsi_sflag = x<<4; port_fl = port_fl-x; port_uib = port_uib-x %finish %else nsi_sflag = 0 mes_len = mes_len+6; ! nsi header to node(mes) %else !! reverse buffer limit is zero ???? fault(3, port n); free buffer(mes) %finish %return function(Disconnect): ! close it down reason = p_s1 ->post(port_state) post(connected): %if port_rl = 0 %start; ! unable to send just now port_state = discon 2; ! hold it %return %finish %if p_s1 = 0 %start; ! normal disconnect reason = send bl drb; ! send it now port_state = disconnecting %finish %else reason = send status rb %and port_state = aborting -> do request buffer post(disconnecting): reason = send bl reply drb; ! reply to a disconnect port_state = disconnecting ->do request buffer post(clearing): port_state = down; %return ! caused by line down, so no status post(aborting): reason = status reply rb port_state = aborting -> do request buffer post(connecting): ! connect reply (reject) port_niff = 0; ! flag it reason = send connect reply -> do request buffer; ! clear stream when sent function(datagram): function(Connect): port n = 0 %if l0_att flag#0 %or l1_att flag # 0 %c %start; ! attached ok %cycle port n = maxt, -1, 0 port == porta(port n) %if port_state = down %then %exit %repeat %if port n = 0 %start !! full up !! printstring("Gate: Ports full ") %else port_owner = p_reply; port_task port = p_task port ! find the address qual = unpack(mes, 3) port_fl = unpack qual(qual) called = unpack(mes,1) text = unpack(mes, 4) x = unpack address(called, port_node, port_term, port_rl) %if x < 0 %then -> fails port_mt = own term; ! for now at least, always main address port_niff = 0 %finish %finish %if port n = 0 %start %if fn = datagram %start p_s1 = 64 p_mes == null p_fn = datagram reply pon(p) free buffer(mes) %return %finish fails: ! connect has failed, either no ports or invaild address p_s1 = 64 to upper(disconnect, null) %return %finish port_state = connecting; port_ln == null %if p_fn = connect %start nsi_fn = 3; mes_len = 10 %else nsi_fn = 2 string(addr(nsi_ufl)) = text nsi_ufl = 5 mes_len = 10+length(text) %finish nsi_sn = 0; nsi_dn = port_node nsi_st = own term; nsi_ss = port_no nsi_dt = port_term; nsi_ds = port_rl; ! term+facility nsi_flag = port_fl port_fl = nsi_fn; ! remember type %if (l1_att flag # 0 %and nsi_dn = l1_node number) %or %c l0_att flag = 0 %then ln == l1 %else ln == l0 port_ln == ln; ! needed for reply etc to node(mes) %return do request buffer: ask for block(reason, port_no) %return function(Datagram Reply): -> fault it %if port_state # connecting %if mes == null %start fault(14, p_reply) %return %finish text = unpack(mes, 3) %if p_s1 = 0 %then flag = 0 %else flag = 128+8 nsi == mes_nsi; ! use it for nsi now nsi_fn = 128+2; nsi_sufl = flag nsi_st = port_term; nsi_ss = port_ss; nsi_sn=port_node nsi_dt = port_mt; nsi_ds = port_no; nsi_dn = 0 nsi_flag = 0 string(addr(nsi_ufl)) = text; nsi_ufl = 5 mes_len = length(text)+10 to node(mes) port_state = down %return fault it: post(*): printstring("State ="); write(port_state, 1) function(*): printstring("gate: illegal fn:"); fault(fn, p_reply) %end %routine to upper(%integer call, %record (mef) %name mes) p_ser = port_owner; p_reply = gate ser p_fn = call; p_mes == mes; p_gate port = port_no p_task port = port_task port pon(p) %end %routine buffer arrived !======================== %switch sub state(attach rb:send connect reply) %record (mef) %name mes %record (nsif) %name nsi %integer x mes == p_mes nsi == mes_nsi port == porta(p_a2); ! may be zero nsi_sufl = 0; nsi_st = port_mt; nsi_ss = port_no nsi_sflag = 0; nsi_suflag = 5 nsi_fn = send block+reply %if p_c2 > attach rb %then ln == port_ln ->sub state(p_c2) sub state(attach rb): ln == lna(p_a2) do att rem(attach , mes) %return sub state(status reply rb): nsi_fn = 128+5; ! status reply %if port_niff # 0 %then nsi_fn = 5; ! response to nif port_state = down; ! finished now -> set disc bit; ! set disconnect and send it sub state(send status rb): !* abort the connection nsi_fn = 5; ! status -> set disc bit; ! set disconnect and send it sub state(send bl reply drb): ! disconnect reply nsi_fn = 4+128; ! send block reply port_state = down; ! finished now set disc bit: nsi_sflag = 128; ! set the nsi disconnect bit ->onw sub state(send bl reply rb): ! normal reply nsi_fn = 128+4 %if port_uib = 0 %start; ! already sent ! free buffer(mes); %return %finish x = port_fl; ! max poss (ack by Task) %if x>port_uib %then x = port_uib; ! no actually needed nsi_sflag = x<<4; port_fl = port_fl-x; port_uib = port_uib-x onw: nsi_sa(0) = 0 mes_len = 6 ->send it sub state(send bl drb): ! block with disconnect nsi_fn = 4; ! send block -> set disc bit; ! set nsi disconnect and send it sub state(send connect reply): nsi_fn = 3+128 %if port_niff # 0 %start nsi_sufl = 0 %else nsi_sufl = 128+8 port_state = down %finish nsi_st = port_term; nsi_ss = port_ss; nsi_sn = port_node nsi_dt = own term; nsi_ds = port_no; nsi_dn = 0 nsi_flag = port_niff; ! composite fl & rl port_niff = 0 mes_len = 10+2 +2; ! temp feature ! -> send it send it: to node(mes) %end %routine tidy ports %integer i %cycle i = 1, 1, maxt port == porta(i) %if port_state # down %and port_state fault"); write(n, 1) printstring(" strm:"); write(port n, 1) %if ln == null %start printstring(" lnx ") %FINISH%else %start %if ln == l0 %then printstring(" ln0 ") %c %else printstring(" ln1 ") %finish %end %routine do att rem(%integer type, %record (mef) %name mes) %integer term, node %if type = subattach %start type = attach; node=0; term = sub attach flag %else node = own term; term = own term %finish mes_nsi_fn = type mes_nsi_sufl = 0 mes_nsi_st = term; mes_nsi_ss = 0 mes_nsi_sn = node; mes_nsi_dn = node mes_nsi_dt = term; mes_nsi_ds = 255 mes_nsi_flag = 0 mes_len = 12 to node(mes) %end %routine clear busy ports %integer i %cycle i = 1,1,maxt %if porta(i)_state = port busy %then porta(i)_state=down %repeat %end %integerfn unpack qual(%string (*) %name s) %integer for, rev %if s = "" %then %result = x'24'; ! default = 2/2 %if charno(s,4)#'/' %or %not s->("W=").s %start printstring("illegal qual "); printstring(s); newline %result = -1 %finish for = charno(s,1); rev = charno(s,3) %result = (rev-'0')<<1!(for-'0')<<4 %end %integer %fn stoi(%string (127)%name s) %integer x,y,sum sum = 0 %result = 0 %if s = "" %cycle x = 1, 1, length(s) sum = sum*10+(charno(s, x)-'0') %repeat %result = sum %end %integerfn unpack address(%string(*)%name s, %bytename n, t, st) %string (15) v, u, w n = 0; t = 0; st = 0 %unless s ->("N").v %start fail: printstring("Gate: failed to interpret address "); printstring(s) newline %result = -1 %finish %unless v ->v.("T").u %then -> fail %unless u ->u.("S").w %then -> fail n = stoi(v); t = stoi(u); st = stoi(w) %result = 0 %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 %string (127) %fn con qual(%integer n) %integer for, rev %string (5) s s = "W=" for = (n>>4)&7+'0' rev = (n>>1)&7+'0' s = s.tostring(for)."/".tostring(rev) %result = s %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 %string (127) %fn convert(%integer node, term) %string (21) s s = "N" s = s.itos(node, -1) s = s."T" s = s.itos(term,-1) %result = s %end %routine node monitor(%record (mef) %name mes) %integer i, n, j, k, p %record (nsif) %name nsi nsi == mes_nsi p = mes_len write(p, 2) spaces(2) %cycle i = 0, 1, p n = nsi_b(i) %cycle j = 4, -4, 0 k = (n >> j)&15 %if k > 9 %then printsymbol(k+'a'-10) %else %c printsymbol(k+'0') %repeat space newline %and spaces(7) %if i&31=31 %repeat newline %end %endofprogram %cycle i = 0, 1, p