!********************************************************** !* * !* PSS X-25 Level 3 Protocol Handler * !* * !* GATEX * !* * !* Version 9.31 15 Sep 1983 * !* * !********************************************************** !* %control 1 %begin !************************************ !* * !* Declarations * !* * !************************************ !* !****** Constintegers ****** !* !*Link states %constinteger established = 0 %constinteger down = 1 %constinteger restarting = 2 %constinteger gfi = x'10' !*State values %constinteger idle = 0 ;!Fixed %constinteger wtaci = 1 ;!Fixed %constinteger wtacn = 2 ;!Fixed %constinteger estb = 3 ;!Fixed %constinteger wait data = 4 ;!Fixed %constinteger wtdsi = 7 %constinteger wtdsn = 8 %constinteger wtdsn2 = 9 %constinteger wdaci =10 !Tstate and Rstate values %constinteger clear = 0 %constinteger set = 1 %constinteger ackpending = 1 %constinteger wrstn = 1 %constinteger wrsti = 2 !Monitor calls %constinteger ok =0 %constinteger line down = 1 %constinteger line up = 2 %constinteger query = 3 %constinteger bad process = 4 %constinteger bad outstate = 5 !6-13 Used for Connect rejection monitoring %constinteger mon process running = 6 %constinteger mon bad param = 7 %constinteger mon no free lcns = 8 !14-21 Used for incoming call rejection monitoring %constinteger bad fn = 22 %constinteger bad instate = 23 %constinteger data outside connect = 24 %constinteger mon no procs = 25 %constinteger bad ack = 26 %constinteger mon to acct = 27 %constinteger from up = 28 %constinteger to up = 29 %constinteger from low = 30 %constinteger to low = 31 %constinteger bad block = 32 %constinteger mon call collision = 33 %constinteger mon rej recd = 34 #if m #if h %include "inc_configf" #else %include "inc_minconf" #fi #else #if l %include "inc_configlge" #else %include "INC_CONFIG" #fi #fi %include "INC_VARIOUS" %include "INC_XGTFNS" !TS Functions %constinteger ts connect = 16 %constinteger ts accept = 17 %constinteger ts disconnect = 18 !*X25 Functions %constinteger incoming call = 11 ;!From DCE %constinteger call request = 11 ;!To DCE %constinteger call connected = 15 ;!From DCE %constinteger call accepted = 15 ;!To DCE %constinteger clear indication = 19 ;!From DCE %constinteger clear request = 19 ;!To DCE %constinteger clear confirmation = 23 ;!Covers DTE & DCE !Data and interrupt %constinteger dce data = 0 ;!From DCE %constinteger dte data = 0 ;!To DCE %constinteger interrupt = 35 ;!Both ways %constinteger interrupt confirmation = 39 ;!Both ways !Flow control and reset %constinteger rr = 1 ;!Both ways %constinteger rnr = 5 ;!Both ways %constinteger rej = 9 ;!To DCE %constinteger reset indication = 27 ;!From DCE %constinteger reset request = 27 ;!To DCE %constinteger reset confirmation = 31 ;!Covers DCE & DTE !Restart %constinteger restart indication =251 ;!From DCE %constinteger restart request =251 ;!To DCE %constinteger restart confirmation =255 ;!Covers DCE & DTE %constinteger fast select bit =128 %constinteger restricted response bit = 64 %constinteger ww set = 4 %constinteger ps set = 2 %constinteger reverse charge bit = 1 !* !Commands to and from lower level %constinteger line input = 1 %constinteger line output = 2 %include "INC_DISCQUALS" %include "INC_SERS" !*Various consts !Note LCN = 255 is used as a flag %constinteger critical long = 6 %constinteger critical short = 2 %constinteger max writes = 24 %constinteger dte = 0 %constinteger dce = 1 %constinteger txc = 6 %constinteger tx = 7 %constinteger rx = 3 %constinteger fast = 1 %constinteger not negotiable = -9 %constinteger xprot hello = 2 !* !****** End of constintegers ****** !* !****** Recordformats ****** %include "INC_FORMATS" %recordformat timef(%bytearray a(0:3)) %recordformat factabf(%string(7) facility, %integer ser) %recordformat linef(%record (qf) %name link, %c %byte procno, state, writes left, lcgn, ser, dcedte, time, %c %record (qf) call q, %integer line no, %bytearray lcntab(0:no of lcns - 1)) %recordformat scvf((%byte l, (%byte reason, cause, diags) %or %bytearray a(0:3)) %or %string (3) s) %recordformat procf(%record (qf) %name link, %c %byte procno, state, task id, task port, fac, quiettime, istate, tsflag, %c %record (linef) %name linelink,%record (qf) outq, %integer acks, %record (mef) %name clrbuff, discbuff, %c %byte lcgn,lcn,aaa,eee,ttt,ccc,tstate,rstate,substate,ww in,ww out,ps in,ps out, #if m %record (scvf) cv) #else %record (timef) time, %record (cvf) cv) #fi !* substate ******************************************************* !* * !* Bit 0: !* Bit 1: !* Bit 2: !* Bit 3: !* Bit 4: If set indicates that an RR or RNR is being deferred * !* Bit 5: If set indicates that we have sent RNR * !* * !****************************************************************** #if ~f !* !****** Monitoring information ****** !* %constinteger maxmon = 34 %constbyteintegerarray monaction(0:maxmon)= %c 2, 2, 2, 2, 3, 3, 3, 3, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 2, 2,1, 1, 1, 1, 1, 1, 3, 2, 2 %ownbyteinteger monbyte = 3 ;!all messages to disc. %owninteger monchan = 0 ;!all channels %ownintegerarray moncount(0:maxmon) = 0(maxmon+1) %owninteger datarx, rrrx, rnrrx, rejrx, callrx, accrx, clrrx, clrcrx, intrx, intcrx, resrx, rescrx, rstrx, rstcrx, derrrx, d1 = 0 %owninteger datatx, rrtx, rnrtx, rejtx, calltx, acctx, clrtx, clrctx, inttx, intctx, restx, resctx, rsttx, rstctx = 0 #fi %ownbyteinteger dcedte = 0 %owninteger shutters up = 0 !****** Integers ****** !* !No. of writes we have left out of WRITEMAX (currently 24) %owninteger i,r,s,m,index = 0 %owninteger mon cons, buffers held = 0 %owninteger default line = -1 %ownstring(1) nullstr = "" %ownstring(2) fac = "**" %ownbytearray protb(0:14) = 4, 127, 255, 255, 255, 4, 1, 0, 0, 0, 4, 204, 0, 0, 0 %ownstring (4) %name tsprotb %ownstring (4) %name xxxprotb !* !Upper level refers to Protocol conversion modules. Lower refers to level 2 !protocol handlers and Buffer Manager. %constrecord (qf) %name null == 0 %ownrecord (linef) %name line %ownrecord (procf) %name process %ownrecord (pf) p !****** Records and Recordarrays ****** %ownrecord (qf) busy q, free lq, free pq, short q = 0 %constinteger facmax = 16 #if ~m %ownrecord (timef) curtime = 0 #fi %ownrecord (linef) %array linetab(1:no of x25 nets) %owninteger factot = 0 %ownrecord (factabf) %array faclist(0:facmax-1) %ownrecord (procf) %array proctab(1:no of procs) !* !****** Routine Specs ****** !* %routine push(%record (qf) %name q,new) q_count = q_count + 1 %if q_link == null %start q_link == new new_link == new %else new_link == q_link_link q_link_link == new q_link == new %finish %end %record (qf) %map pop(%record (qf) %name q) %record (qf) %name old %if q_link == null %then old == null %elsestart %if q_link_link == q_link %start ;!One element only on Q old == q_link q_link == null %else old == q_link_link q_link_link == old_link %finish q_count = q_count - 1 %finish %result == old %end %include "INC_EXTS" %routinespec increment(%integer txrx, length) %externalstring (15) %fnspec itos(%integer no, width) %integerfnspec next free lcn(%integer dcedte) %integerfnspec acknowledge(%byte seqno) %routinespec get buffer(%byte fn, length) %routinespec maybe send rr(%record (mef) %name mes) %routinespec move(%integer len, from, to) %routinespec cbuff %routinespec cpon(%record (pf) %name p) %routinespec pull(%record (qf) %name q,item) %routinespec query processes %routinespec reject call(%integer qualifier) %routinespec reject connect(%integer fn, qualifier) %routinespec release process %string (255) %fnspec sub string(%record (mef) %name mes, %integer no) #if ~m %routinespec subtract times #fi %routinespec buffer arrived %string (15) %fnspec form facilities(%integer flags) %routinespec free buffer(%record (mef) %name mes) %routinespec handle ts packet %routinespec handle clock tick %routinespec handle outq %routinespec handle line input %routinespec handle line output %integerfnspec interpret facilities(%integer fn, %bytearrayname f) %routinespec monitor(%record (pf) %name p, %integer type) %routinespec pack bcd string(%string(255) s,%bytearrayname a, %integername index) %routinespec packchar(%byte char, %record (mef) %name mes) %integerfnspec packetlength(%integer fn) %routinespec pack string(%string(255)%name s,%record (mef) %name mes) %routinespec pack ts string(%string(255) s, %string (255) %name t) %routinespec restart processes %integerfnspec stoi(%string (15) s) %routinespec stop(%integer reason) %routinespec to account(%record (mef) %name mes, %integer fn) %routinespec to lower(%record (mef) %name mes, %integer fn, datal) %routinespec to upper(%record (mef) %name mes, %integer fn) %string (63) %fnspec ts substring(%record (mef) %name mes, %integer ptr, no) %string (15) %fnspec unpack bcd string(%bytearrayname a,%integer no) %routinespec unravel ts(%string (63) %name ts addr, ts params, %integername line) %integerfnspec wp to facs(%string (31) facs, %string (31) %name pssfacs) !*************************************** !* * !* Main Program * !* * !*************************************** linkin(from xprot);!dentify ourself to DEIMOS for receiving messages change out zero = t3 ser ;!Use buffered console I/O map virt(buffer manager,5,4) ;!Get access to buffer pool map virt(buffer manager,6,5) printstring("GATX Running") ;newline charno(fac, 1) = 1 tsprotb == string(addr(protb(0))) xxxprotb == string(addr(protb(5))) %for i = 1, 1, no of x25 nets %cycle linetab(i)_procno = i push(free lq, linetab(i)) %repeat %for i=1,1,no of procs %cycle ;!Initialise our main tables proctab(i)_procno = i ;!Give each process a process no. push(free pq,proctab(i)) %repeat poff(p) ;!Wait for configuration message from loader dcedte = p_fn ;!Are we a DCE or a DTE? linkin(gatex ser) #if ~f monbyte = p_process ;!Set monitoring level #fi shutters up = p_c2 ;!This enables us to come up refusing connections !Grab a spare buffer for double-buffering buffer requests p_ser = buffer manager ;p_reply = id p_fn = request buffer ;p_len = short ponoff(p) push(short q, p_m) alarm(100) ;!Set off a 2-second clock tick %cycle ;!We never leave this loop p_ser = 0 ;!Accept anything poff(p) ;!Wait for a message %if p_ser = gatex ser %start ;!A message from the higher levels (PCMs) handle ts packet %elseif p_reply = 0 ;!Clock tick message handle clock tick %elseif p_reply = buffer manager ;!A buffer request has been granted cbuff buffer arrived %elseif p_fn = line input ;!Something from the comms line handler cbuff handle line input %finishelse handle line output %repeat !**************************************** !* * !* Routines * !* * !**************************************** !* %integerfn acknowledge(%byte seqno) !Update AAA from incoming N(R) unless we have a bad ack %byte acks acks = (seqno - process_aaa) & 7 %result = bad ack %unless acks <= (process_ttt - process_aaa) & 7 process_aaa = seqno !Right. process_acks counts the number of immediate acks that were !done. If this is positive, we reduce the no. of acks we send up. process_acks = process_acks - acks %if process_acks < 0 %start p_s1 = -process_acks process_acks = 0 to upper(null, ack) %finish %result = 0 %end ;!of Acknowledge %routine get buffer(%byte reason, length) !This routine pulls a buffer off its private queue if its got one and fires ! off a buffer request to Buffer Manager if it hasn't p_process = process_procno p_c2 = reason !Check on reason prevents recursive calls %if short q_count = 0 %or reason = 0 %or length = long %start p_ser = buffer manager ;p_reply = id p_fn = request buffer p_len = length pon(p) %else p_m == pop(short q) buffer arrived get buffer(0, short) %finish %end ;!of get buffer %routine buffer arrived !A previously issued buffer request has been granted. !P_C2 was set up in get buffer and tells us why we !asked for it. %integer l %string (63) s %record (mef) %name mes %bytename state mes == p_m mes_l = 0 process == proctab(p_process) state == process_state line == process_linelink %if p_c2 = rr %and 3 <= state <= 4 %start ;!Value 1 maybe send rr(mes) %elseif p_c2 = restart indication ;!Value 251 !Note PROCESS points to LINE process line == linetab(p_process) %if line_state = restarting %then to lower(mes, restart indication, -1) %c %else free buffer(mes) %elseif p_c2 = clear request ;!Value 19 free buffer(pop(process_outq)) %while process_outq_count # 0 %if state = estb %or state = wait data %or state = wtacn %start to lower(mes, clear request, 0) ;clrtx = clrtx + 1 state = wtdsn2 ;process_quiettime = 6 %elseif state = wtaci to lower(mes, clear request, 0) ;clrtx = clrtx + 1 state = wtdsn %else free buffer(mes) %finish %elseif (p_c2 = interrupt%or p_c2 = reset request %or p_c2 = reset confirmation) %c %and 3 <= state <= 4 ;!Values 35, 27, 31 to lower(mes, p_c2, 0) %elseif p_c2 = disconnect ;!Value 3 process_substate = process_substate & (\2) #if ~m subtract times #fi packstring(process_cv_s, mes) %unless process_clrbuff == null %start !We held onto the clear packet so we could extract its parameters !We stuck the user data length in clrbuff_fn to save us recalculating it l = process_clrbuff_l - process_clrbuff_fn - 3;!points to start of UD s = ts substring(process_clrbuff, l, 1) packstring(s, mes) s = ts substring(process_clrbuff, l, 2) packstring(s, mes) !OK we've finished with the clear - send it off as a clear conf. & !decouple LCN to lower(process_clrbuff, clear confirmation, 0) ;clrctx = clrctx + 1 ;process_clrbuff == null line_lcntab(process_lcn) = 0 ;process_lcn = 255 %finish p_s1 = process_cv_reason %if state = estb %or state = wtaci %or state = wdaci %start ! P_S1 = 1 ;!Bound to be a Disconnect in response to a received Disconnect to upper(mes, disconnect) state = wtdsi %elseif state = wtacn %or state = wtdsn2 %or state = wait data to upper(mes, disconnect) release process %elseif state = wtdsn to upper(mes, disconnect) process_taskport = 0 ;!Decouple process from higher level %else free buffer(mes) %finish #if ~m %elseif p_c2 = checkpoint %and 3 <= state <= 4 ;!Value 45 subtract times mes_s = process_cv_s to account(mes, checkpoint) #fi %elseif p_c2 = call accepted ;!Value 15 accrx = accrx + 1 process_substate = process_substate & (\1) mes_data(0) = 0 ;!Address lengths (=0) mes_data(1) = 0 mes_l = 2 to lower(mes, call accepted, -1) ;acctx = acctx + 1 %if process_tsflag = 0 %start process_substate = process_substate ! 4 ;get buffer(ts accept, short) %finishelse handle outq %elseif p_c2 = ts accept ;!Value 17 process_substate = process_substate & (\4) !OK. We've sent the TS accept - tell ACKNOWLEDGE to swallow the first Ack. process_acks = process_acks + 1 mes_l = 1 ;mes_fn = x'80' mes_data(0) = ts accept to lower(mes, dce data, 0) ;datatx = datatx + 1 process_ttt = (process_ttt + 1)&7 handle outq %else ;!Only expected one is Value 0 %if short q_count = 0 %then push(short q, mes) %else free buffer(mes) %finish %end ;!of Buffer Arrived %routine cbuff %unless p_m == null %start !Buffer type bits not 0 or 64 constitutes a disaster stop(98) %if 0 # p_m_type # 64 !Buffer pointer should be in range k'100000' - k'137777' and should be a !multiple of k'100'. Look at top 2 bits and bottom 6. stop(96) %unless p_b & k'140077' = k'100000' buffers held = buffers held + 1 %finish %end %routine cpon(%record (pf) %name p) !As PON, but a) check buffer is valid first and b) decrement count %unless p_m == null %start stop(99) %if 0 # p_m_type # 64 stop(97) %unless p_b & k'140077' = k'100000' buffers held = buffers held - 1 %finish pon(p) %end %string (15) %fn form facilities(%integer flags) %string (15) facs !Takes two sets of information: 1) The current facilities !values and 2) which of these are to be passed on. !It then creates a facilities field of the form "W=m/n,P=m/n" facs = "" %if flags & ww set # 0 %start ;!We want to specify a window size facs = "W=".itos(process_ww in, -1)."/".itos(process_ww out, -1) facs = facs."," %if flags & ps set # 0 %finish %if flags & ps set # 0 %start ;!Specify packet size !Note PSS transfers packet size as n, where 2**n = size facs = facs."P=".itos(1< found line %if p_process = line_lineno line == line_link %repeat %finish monitor(p, bad process) free buffer(mes) %return found line: lcgn = mes_octet1&15;!Received LCGN %if fn = incoming call %start !Can occur in any state but only IDLE accepted %if line_state = established %start !Set up a process if one is available and does not exist already %if line_call q_count # 0 %start process == line_call q %for i = 1, 1, line_call q_count %cycle process == process_link %if process_lcgn = lcgn %and process_lcn = mes_lcn %start ;!LCGN and LCN clash - Call collision !PSS X-25 Call collision: DCE accepts the Call Request !and a) forgets about its Incoming Call then b) rejects the CONNECT !which generated it. Ultimately it will retry on another LCN !DTE just ditches the Incoming Call as it knows the DCE !will handle it. !If the other process is not waiting for a call accepted !(Call connected) then it is an error and should be ditched monitor(p, mon call collision) %if line_dcedte = dte %or process_state # wtacn %start free buffer(mes) %return %else p_s1 = call collision to upper(null, disconnect) release process %exit ;!Should not be TWO active processes with the same LCN %finish %finish %repeat %finish %if line_lcntab(mes_lcn) = 0 %start ;!Make sure he isnt using a busy stream process == pop(free pq) %unless process == null %start ;!There is a process available !Zero the entire process but save its process number i = process_procno ;process=0 ;process_procno = i push(line_call q,process) ;!Queue it on busy process q state == process_state ;process_lcgn = lcgn #if m process_cv_l = 3 #else process_cv_l = 15 ;!Set up call statistics record #fi process_lcn = mes_lcn ;line_lcntab(mes_lcn) = 1 process_linelink == line %if shortnetname(line_line no) = "S" %then process_ww in = 1 %else process_ww in = 2 process_ww out = process_ww in #if ~m process_time = curtime #fi !TSTATE = Clear, OUTQ == NULL implicitly !Extract DCE & DTE addresses, facilities and Call User Data field !From Incoming call packet caller = unpack bcd string(data,1) called = unpack bcd string(data, 0) %if shutters up # true %start !strip off subaddress if present and put its value in rc %if length(called) = 14 %then rc = (data(7)>>4)*10+data(7)&15 %else rc = 0 dtel = (data(0)>>4 + data(0)&15 + 1)>>1 ;!Length of DTE addresses facl = data(dtel+1) ;!Length of facilities field i = interpret facilities(incoming call, data) %if i >= 0 %and factot > 0 %start cudfl = mes_l - facl - dtel - 5 process_fac = i !Three bytes header + Length of DTE/DCE addresses + Facilities length = 5 increment(rx, cudfl) facs = form facilities(i) %if cudfl >= 4 %then length(protb) = 4 %else length(protb) = cudfl move(length(protb), addr(data(dtel+facl+2)), addr(protb)+1) !It's only true T.S. if Protocol bytes are 127-255-255-255 process_tsflag = 1 %if protb # tsprotb %if no of x25 nets > 1 %and line_lineno # default line %then caller = shortnetname(line_lineno).".".caller !Try and unscramble addresses TS-style. called params = ts substring(mes, dtel+facl+6, 1) !Strip any accrediting info. off the front, discard it and leave residue in t. t = called params %unless called params -> ("(").s %and s -> s.(").").t !t now contains .. s = t %unless t -> t.(".").s !s now contains if address is valid process_task id = 0 %for i = 0,1,factot-1 %cycle %if s -> (faclist(i)_facility).s %then process_task id = faclist(i)_ser %repeat !All unknown non-TS traffic -> XXX enabler if there is one. %if process_task id = 0 %and process_tsflag # 0 %start %for i = 0, 1, factot-1 %cycle %if faclist(i)_facility = "XXX" %then process_task id = faclist(i)_ser %and %exit %repeat %finish %if process_task id # 0 %start caller params = ts substring(mes, dtel+facl+6, 2) caller = caller.".".caller params %unless caller params = "" exptext = ts substring(mes, dtel+facl+6, 4) %if mon cons # 0 %start printstring("GATX In Call:") ;printstring(caller) printstring("->") ;printstring(called) printsymbol('.') ;printstring(called params) newline ;printstring(" F:") ;printstring(facs) printstring(" E:") ;printstring(exptext) printstring(" fails") %if j < 0 newline %finish mes_l = 0 packstring(called params, mes) ;!Called packstring(caller,mes) ;!Caller packstring(facs, mes) ;!Facilities/Quality packstring(exptext, mes) ;!Explanatory Text %if process_tsflag # 0 %then packstring(protb, mes) p_s1 = process_tsflag to upper(mes, connect) process_state = wtaci %else process_state = wtdsn mes_data(1) = prot not supported to lower(mes, clear request, 0) ;clrtx = clrtx + 1 %finish %else process_state = wtdsn mes_data(1) = ts incompatible facilities to lower(mes, clear indication, 0) ;clrtx = clrtx + 1 %finish %else process_state = wtdsn mes_data(1) = ts going out of service to lower(mes, clear indication, 0) ;clrtx = clrtx + 1 %finish %else ;!No free processes !Note: a clear confirmation will come back with no process reject call(ts number busy) %finish %finishelse reject call(lcn conflict) %finishelse free buffer(mes) ;!Ignore Calls while restarting or down %elseif fn = restart indication !Clear down Network side (all processes) completely and !Interface (upper) side tidily. rstrx = rstrx + 1 %if line_state = restarting %start p_len = 0 to account(null, hello) ;!Tell Account line is up line_state = established free buffer(mes) %else mes_fn = restart confirmation !Dont use TO LOWER as we dont have a process i = p_ser ;p_ser = p_reply ;p_reply = i ;!Send it back whence it came p_fn = line output !P_M == MES already p_len = 3 rstctx = rstctx + 1 pon(p) restart processes %finish %elseif fn = restart confirmation rstcrx = rstcrx + 1 %if line_state = restarting %start p_len = 0 to account(null, hello) ;!Tell Account line is up line_state = established %finish free buffer(mes) %else !There ought to be a process for this message on the circular !List queued off LINE_CALL Q %if line_call q_count # 0 %start process == line_call q %for i = 1,1,line_call q_count %cycle process == process_link %if process_lcgn = lcgn %and process_lcn = mes_lcn %then -> found it ;!Correct LCGN and LCN %repeat %finish %if fn = clear request %start !He thinks the call is up - we don't. Let's put him out of his misery !By confirming his clear. reject call(spurious clear req) %else %if fn # clear confirmation %then monitor(p,bad instate) !Should have been a process if it wasnt an incoming call free buffer(mes) %finish %return found it: state == process_state %if fn&3 #3 %start ;!Data,RR,RNR, (REJ) nr = fn>>5 ;fn = fn&x'1F' ;!Remove R: Next block expected %finish %if fn = rr %start !Level 3 RR process_tstate = clear ;!Clear remote RNR if set against us. rrrx = rrrx + 1 ->end1 %elseif fn & 1 = 0 !Level 3 data block. ns = (fn>>1)&7 ;!Block sequence no. m = fn&x'10' increment(rx, mes_l-3) ;!Increment will catch case where mes_l-3 < 0 %if 3 <= state <= 4 %and process_rstate = clear %start rc = acknowledge(nr) %if rc # 0 %then -> chop %if ns = process_eee %start ;!Level 3 sequence OK datarx = datarx + 1 process_eee = (process_eee + 1) & 7 p_s1 = 1 - m >> 4 ;!Push it if asked to mes_l = mes_l - 3 ;!User data length only %if mes_octet1 < 128 %start ;!Ordinary data and Push to upper(mes, input here) %elseif mes_l = 0 ;!Ignore any zero-length blocks we may receive process_ccc = (process_ccc + 1) & 7 maybe send rr(mes) %elseif process_tsflag = 1 ;!Control data, not T.S. to upper(mes, control input here) %else ;!Control data, T.S. !We don't implement this yet so discard it (nasty isnt it) process_ccc = (process_ccc + 1) & 7 maybe send rr(mes) %finish handle outq %else ;!Sequence error - shouldn't happen derrrx = derrrx + 1 process_cv_reason = packet level error to lower(mes, clear indication, 0) ;clrtx = clrtx + 1 process_state = wdaci %finish %finishelse free buffer(mes) %elseif fn = rnr !Level 3 RNR process_tstate = set ;!Remote RNR set against us. rnrrx = rnrrx + 1 ->end1 %elseif fn = call connected %if process_fac & restricted response bit = 0 %start !Reply to call request to Network !Work out user data length for stats %if mes_l >= 5 %start dtel = (data(0)>>4 + data(0) & 15 + 1)>>1 facl = data(dtel + 1) increment(rx, mes_l - dtel - facl - 5) %finish !Expect in states WTACN or WTDSN2 %if state = wtacn %start ;!Call now successfully established. i = interpret facilities(call connected, data) state = estb facs = form facilities(i) mes_l = 0 packchar(0, mes) ;!Recall Address %if length(facs) # 0 %then packstring(facs, mes) %else %c free buffer(mes) %and mes == null p_s1 = process_tsflag ;!For benefit of PCMs. to upper(mes, accept call) handle outq %finishelse free buffer(mes) %else to lower(mes, clear indication, 0) ;clrtx = clrtx + 1 process_state = wtdsn p_s1 = short call accepted to upper(null, disconnect) %finish %elseif fn = clear confirmation %or fn = clear indication %if fn = clear confirmation %start !Expect in states WTDSN,WTDSN2 clrcrx = clrcrx + 1 %else !Expect in any state clrrx = clrrx + 1 process_cv_reason = call cleared ;process_cv_cause = data(0) ;process_cv_diags = data(1) %finish %if mes_l > 5 %start ;!Fastselect or extended formats may have user data !DCE Clear Confirmation doesnt have the Cause & Diags fields %if fn = clear confirmation %and line_dcedte = dte %then i = 0 %else i = 2 dtel = (data(i)>>4 + data(i) & 15 + 1)>>1 facl = data(dtel + 3) cudfl = mes_l - dtel - facl - i - 5 increment(rx, cudfl) %finish i = interpret facilities(fn, data) ;!to get call stats if present free buffer(pop(process_outq)) %while process_outq_count # 0 !We either reply immediately to a clear (in which case we !decouple ourselves from the LCN) or we hold on to it till we get !the disconnect buffer so we can write up the parameters %if state = wtdsn %start line_lcntab(process_lcn) = 0 ;process_lcn = 255 free buffer(mes) %if process_substate & 2 # 0 %start !We are in the process of disconnecting a call by timeout state = wtdsn2 ;process_quiettime = 6 %finishelse release process %else %if 1 <= state <= 5 %start !Evidence is that this packet is charged for in advance by PSS process_clrbuff == mes ;mes_fn = cudfl %else free buffer(mes) line_lcntab(process_lcn) = 0 ;process_lcn = 255 %finish process_substate = process_substate ! 2 ;get buffer(disconnect, long) %finish %elseif fn = interrupt !Action in state ESTB only intrx = intrx + 1 increment(rx, 0) to lower(mes,interrupt confirmation, 0) ;intctx = intctx + 1 %if state = estb %start %if mes_l > 3 %then x = data(0) %else x = 'A' !Interrupt user data (one byte only) p_s1 = x to upper(null,expedited data) %finish %elseif fn = interrupt confirmation intcrx = intcrx + 1 increment(rx, 0) process_istate = 0 ;!Clear interrupt pending condition free buffer(mes) %elseif fn = reset indication increment(rx, 0) printstring("Reset") ;write(data(0), 1) ;printsymbol('/') write(data(1), 1) ;newline resrx = resrx + 1 %if process_rstate = clear %or process_rstate = wrstn %start !Either out of the blue or we were expecting one from Network to upper(mes, reset) process_rstate = wrsti %finishelse free buffer(mes) %elseif fn = reset confirmation %if process_rstate = wrstn %start to upper(mes, reset) free buffer(pop(process_outq)) %while process_outq_count # 0 process_aaa = 0 ;process_ccc = 0 ;process_eee = 0 ;process_ttt = 0 process_tstate = clear process_rstate = clear %finishelse free buffer(mes) %elseif fn = rej !Level 3 REJ. Shouldn't get this. rc = mon rej recd ;->chop %else monitor(p,bad fn) free buffer(mes) %finish %finish %return end1: %if 3 <= state <= 4 %and process_rstate = clear %start rc = acknowledge(nr) %if rc # 0 %then -> chop handle outq %finish free buffer(mes) %return chop: monitor(p, rc) process_cv_reason = packet level error to lower(mes, clear indication, 0) ;clrtx = clrtx + 1 process_state = wdaci %return %end ;!of HANDLE LINE INPUT %routine handle line output %integer i monitor(p, from low) %if p_len = xprot hello %start ;!Init message at Task startup (one only per task) line == pop(free lq) ;!Get a line process %unless line == null %start ;!Got one OK. i = line_procno ;line = 0 ;line_procno = i push(busy q, line) line_state = down line_ser = p_reply line_line no = p_process ;default line = line_lineno %if default line < 0 line_dcedte = (dcedte>>line_lineno) & 1 line_lcgn = 4 line_writes left = max writes %finishelse stop(mon no procs) %else ;!Line Up/Down or write ack !XPROT hello is first thing XPROT sends so should always be at least !one line in queue by now. line == busy q_link %for i = 0, 1, busy q_count-1 %cycle -> found line %if line_line no = p_process line == line_link %repeat monitor(p, bad process) found line: %if p_len = 1 %start ;!Link down message to account(null, hello) monitor(null,line down) restart processes line_state = down %else %if line_state = down %start printstring(longnetname(line_lineno)) ;printstring(" Line Up") ;newline monitor(null,line up) process == line ;!For benefit of get buffer line_state = restarting get buffer(restart indication, short) %finish %finish %finish %end ;!of HANDLE LINE OUTPUT %routine handle outq !Send off what we can from the output queue %record (mef) %name mes %return %unless 3 <= process_state <= 4 %return %if process_substate & 5 # 0 %while process_tstate = clear %and process_outq_count # 0 %c %and (process_ttt - process_aaa)&7 < process_ww out %cycle mes == pop(process_outq) to lower(mes,dte data, mes_l) ;datatx = datatx + 1 process_ttt = (process_ttt+1)&7 %repeat %if process_state = wait data %and process_outq_count = 0 %then %c get buffer(clear request, short) %end ;!of HANDLE OUTQ %routine handle ts packet %string(63) caller, called, called params, cudf, exptext %string (31) facs %record (mef) %name mes %bytename state %byte r,s %integer flags %integer fn,lcn,lineno,l,i,j %string(7) ls mes == p_m ;fn = p_fn cbuff %unless fn = enable facility %or fn = disable facility monitor(p, from up) %if fn = connect %start called = substring(mes, 1) unravel ts(called, calledparams, lineno) %if busy q_count # 0 %start line == busy q %for i = 1, 1, busy q_count %cycle line == line_link %if line_lineno = lineno %and line_state = established %then -> ok %repeat %finish reject connect(fn, network down) %return ok: !Scan calls on this line to ensure this is not a duplicate request %if line_call q_count # 0 %start process == line_call q %for i = 1,1,line_call q_count %cycle process == process_link %if process_task id = p_reply %and process_task port = p_task port %start ;!Duplicate request monitor(null, mon process running) reject connect(fn, process running) %return %finish %repeat %finish lcn = next free lcn(line_dcedte) %if lcn >= 0 %start ;!Got a free LCN process == pop(free pq) %unless process == null %start ;!All OK. !Record the connection and send off a Call Request i = process_procno ;process=0 ;process_procno = i push(line_call q,process) #if m process_cv_l = 3 #else process_cv_l = 15 #fi process_tsflag = p_s1 !Tstate = Clear, OUTQ_COUNT = 0 implicitly %if shortnetname(line_lineno) = "S" %start !SERCNET has different defaults from other X25 networks process_ww in = 1 %else process_ww in = 2 %finish process_ww out = process_ww in process_linelink == line ;!Reverse link for speed process_task port = p_task port process_lcgn = line_lcgn process_lcn = lcn process_task id = p_reply caller = substring(mes, 2) facs = substring(mes, 3) ;!Facilities/Quality exptext = substring(mes, 4) ;!Call User Data/Explanatory Text %if mon cons # 0 %start printstring("GATX OutCall:") ;printstring(caller) printstring("->") ;printstring(called) printsymbol('.') ;printstring(called params) printstring(" Q:") ;printstring(facs) printstring(" E:") ;printstring(exptext) newline %finish i = wp to facs(facs, facs) !1st "facs" passed by value, 2nd by name. Not as nasty as it looks %if i >= 0 %start ;!All OK mes_data(0) = length(called)&15 index = 2 ;!Index counts in quartets not bytes pack bcd string(called, mes_data, index) !last field is explanatory text for TS calls and verbatim CUDF !otherwise. Null CUDF in a non-TS call will be assumed to be XXX !and will set protocol bytes 1-0-0-0 and TS called and caller strings %if process_tsflag = 0 %or exptext = "" %start !If T.S. protocol bytes must be 127-255-255-255. !If not, assume XXX (1-0-0-0). SERC-ITP must set CUDF explicitly. %if process_tsflag = 0 %then cudf = tsprotb %else cudf = xxxprotb pack ts string(called params, cudf) pack ts string(caller, cudf) %if process_tsflag = 0 %start ;!TS only pack ts string(nullstr, cudf) pack ts string(exptext, cudf) %finish %finishelse cudf = exptext %if length(cudf) > 16 %then process_fac = process_fac ! fast select bit %if process_fac # 0 %start charno(fac, 2) = process_fac ;facs = facs.fac %finish string(addr(mes_data(index>>1))) = facs index = index + length(facs)<<1 + 2 move(length(cudf), addr(cudf)+1, addr(mes_data(index>>1))) index = index + length(cudf)<<1 mes_l = index>>1 ;!Length of data + header (Used by TO LOWER) i = interpret facilities(call request, mes_data) #if ~m process_time = curtime #fi to lower(mes,call request, length(cudf)) ;calltx = calltx + 1 !Connect may be specified to be a datagram by using "C=S" process_state = wtacn %else monitor(null, mon bad param) line_lcntab(lcn) = 0 reject connect(fn, bad param) release process %finish %else line_lcntab(lcn) = 0 reject connect(fn, gateway full) %finish %else monitor(null, mon no free lcns) reject connect(fn, no free lcns) %finish %elseif fn = enable facility %or fn = disable facility !First get facility string from P or P_M (According to P_S1) %if p_s1 = 0 %start facs = p_facility %else facs = mes_s free buffer(mes) %finish !Note that once assigned the facility has a table entry for ever !Next, look throught table and see if we know about this one %if factot # 0 %start %for i = 0, 1, factot-1 %cycle %if faclist(i)_facility = facs %then -> assigned already %repeat %finish !Never heard of it. Make a new table entry if we can. i = factot %return %if factot = facmax factot = factot + 1 faclist(i)_facility = facs assigned already: !Non-zero SER indicates is is enabled. Zero SER = disabled %if fn = enable facility %then faclist(i)_ser = p_reply %else faclist(i)_ser = 0 #if m %elseif fn = prod monchan = p_s1 %elseif fn = poke p_s1 = 0 %if p_c2 = 0 %start p_c1 =no of procs - free lq_count - free pq_count ;p_c2 = buffers held %elseif p_c2 = 1 p_c = addr(datarx) %elseif p_c2 = 2 p_c = addr(factot) %elseif p_c2 = 3 p_c = addr(busy q) %finish i = p_ser ;p_ser = p_reply ;p_reply = i cpon(p) %return #fi %else !Process numbers: Processes are identified by two process numbers, !but usually GATE PORT. In the case of CONNECT or DISCONNECT before !ACCEPT CALL this is not known, so GATE PORT is 0 and the process is !identified by the sender's process TASK PORT %if 1 <= p_gate port <= no of procs %start !He correctly specified one of our processes process == proctab(p_gate port) ->found it %else %if busyq_count # 0 %or p_gate port # 0 %start !He specified his process only and there are processes active line == busy q %for i = 1, 1, busy q_count %cycle line == line_link %if line_call q_count # 0 %start process == line_call q %for j = 1, 1, line_call q_count %cycle process == process_link %if process_task port=p_task port %then ->found it %repeat %finish %repeat %finish %finish !Failed to find a process corresponding to specified proc.no monitor(p,bad process) free buffer(mes) %return found it: state == process_state line == process_linelink %if fn = put output %or fn = put control output %start !Control data (for transmission with QBIT = 1 is flagged by a x'80' %if fn = put output %then mes_fn = 0 %else mes_fn = x'80' %if line_state # down %and state = estb %and process_rstate = clear %start ;!Data only valid in established call push(process_outq,mes) !We ignore the PUSH bit in P_S1 since all data is acknowleged !end-to-end anyway !MES_L contains length of Level 3 user data handle outq ;!See if we can send anything. %if process_outq_count + (process_ttt - process_aaa) & 7 < process_ww out %start !If queued buffers + buffers in transit is less than window, ack !immediately and count the no. of times we do so. process_acks = process_acks + 1 p_s1 = 1 to upper(null, ack) %finish !Allow upper level to transmit ahead up to window limit. After that he !will get one ack up for each rr received. %else monitor(p, data outside connect) !Line down free buffer(mes) %finish %elseif fn = ack %if process_state = estb %and process_rstate = clear %start process_ccc = (process_ccc + p_s1) & 7 maybe send rr(null) %finish %elseif fn = expedited data %if process_istate = 0 %start get buffer(interrupt, short) process_istate = 1 ;!Block further interrupts or we may get reset %finish %elseif fn = reset %if process_rstate = clear %start ;!Out of the blue get buffer(reset request, short) process_rstate = wrstn %elseif process_rstate = wrsti !Its a confirmation to a reset we issued get buffer(reset confirmation, short) free buffer(pop(process_outq)) %while process_outq_count # 0 process_aaa = 0 ;process_ccc = 0 ;process_eee = 0 ;process_ttt = 0 process_tstate = clear process_rstate = clear %finish %elseif fn = disconnect process_discbuff == mes process_cv_reason = p_s1 %if process_cv_reason = 0 %if state = estb %and process_outq_count # 0 %start state = wait data ;process_quiettime = 6 %else %if state=estb %or state=wtacn %or state=wtaci %then %c get buffer(clear request, short) %elsestart free buffer(pop(process_outq)) %while process_outq_count # 0 %if state = wtdsi %then release process %else state = wtdsn2 %and process_quiettime = 6 %finish %finish %elseif fn = accept call !States WTACI, WDACI %if state = wtaci %start !Connection now fully established. Log his process number and process_state = estb process_task port = p_task port %if mes == null %start process_substate = process_substate ! 1 ;get buffer(call accepted, short) %else i = wp to facs(substring(mes, 2), facs) mes_data(0) = 0 %if i >= 0 %and process_fac & restricted response bit = 0 %start string(addr(mes_data(1))) = facs mes_l = length(facs) + 2 to lower(mes, call accepted, -1) ;acctx = acctx + 1 %if process_tsflag = 0 %start process_substate = process_substate ! 4 ;get buffer(ts accept, short) %finish %else !We didn't like the facilities in the Accept mes_data(1) = bad interface params to lower(mes, clear request, 0) ;clrtx = clrtx + 1 process_state = wdaci %finish %finish %finishelse free buffer(mes) ;!Otherwise just ignore it (WDACI, WTDSI) %else stop(bad fn) %finish %finish %return %end ;!of handle ts %routine increment(%integer txrx, length) %integer i,segs !Inefficient but it'll do for now !Increment segment count. PSS counts 0-64 bytes = 1 segment !65-128 bytes = 2 segments etc. (Obviously not devised by !a programmer) %if length > 0 %start segs = (length-1) >> 6 + 1 %elseif length = 0 segs = 1 %else segs = 0 monitor(p, 64) %finish !We dont expect SEGS to exceed about 4. Algorithm breaks down !for segs >= 255. #if ~m i = process_cv_our segs(txrx) + segs ;!Add on segs process_cv_our segs(txrx) = i ;!Jam bottom 8 bits into Our Segs %if i > 255 %start ;!There was an overflow (can only be 1 bit) %for i = txrx-1, -1, txrx-3 %cycle process_cv_our segs(i) = process_cv_our segs(i) + 1 ;!Add to next more significant byte %exit %if process_cv_our segs(i) & 255 # 0 ;!Stupid compiler !Carry on if we overflowed again %repeat %finish #fi %end ;!of Increment %integerfn interpret facilities(%integer fn, %bytearrayname f) !Integerfn interprets facilities field of incoming packets !Note - if it sees one it doesn't recognise or wants to ignore !it assumes it occupies 2 bytes. %integer i,p,dtel %if fn = clear indication %then dtel = 2 %else dtel = 0 dtel = dtel + (f(dtel)>>4 + f(dtel)&15 + 1)>>1 i = 0 p = dtel+2 %while p < f(dtel+1) + dtel + 2 %cycle %if f(p) = x'43' %start process_ww in = f(p+1) process_ww out = f(p+2) i = i ! ww set p = p + 1 ;!i.e. one more than basic 2 bytes %elseif f(p) = x'42' !Not our problem process_ps in = f(p+1) process_ps out = f(p+2) i = i ! ps set p = p + 1 %elseif f(p) = x'C1' !Duration always comes before stats #if m p = p + 12 #else move(4, addr(f(p+2)), addr(process_cv_pss ct(0))) p = p + 4 move(8, addr(f(p+2)), addr(process_cv_pss segs(0))) p = p + 8 process_cv_l =27 #fi %elseif f(p) = 1 ;!Rev. Charging & Fast Select (+/- Rest. Resp.) process_fac = f(p+1) %if f(p+1) & 1 # 0 %start ;!Reverse charging %result = not negotiable %elseif f(p+1) & x'C0' = x'C0' ;!Fast Select - Restricted Response i = i ! fast select bit ! restricted response bit %elseif f(p+1) & x'80' # 0 ;!Fast Select i = i ! fast select bit %finish %finish p = p + 2 %repeat %result = i %end ;!of Interpret Facilities %routine maybe send rr(%record (mef) %name mes) !Send a level 3 RR if we absolutely have to. Defer it otherwise till the next tick %if mes == null %then get buffer(rr, short) %and %return !The complex condition: Send an RR or RNR if... !Cond. 1: We have got a deferred RR or RNR outstanding already !Cond. 2: We don't have any buffers queued and he is out of window, !Cond. 3: We have buffers queued and he has RNR up against us. !Cond: 4: buffers are low !! %if process_substate & 48 # 0 %or %c !! (process_outq_count = 0 %and (process_ccc - process_aaa) & 7 >= process_ww in) %or %c !! (process_outq_count # 0 %and process_tstate = set) %or %c !! no of buff < critical long %start %if no of buff > critical long %start to lower(mes, rr, 0) ;rrtx = rrtx + 1 ;process_substate = process_substate & (\48) %else to lower(mes, rnr, 0) ;rnrtx = rnrtx + 1 ;process_substate = process_substate ! 32 %finish !! %else !! process_substate = process_substate ! 16 !! !Defer sending anything till next block or timer !! free buffer(mes) !! %finish %end ;!of Maybe send rr %routine monitor(%record (pf) %name p,%integer type) #if ~f %recordformat pfa(%bytearray a(0:27)) %record (pfa) %name pa %integer i,j,k moncount(type) = moncount(type) + 1 k = monaction(type) %if k = 0 %start %return %elseif k = 1 i = monbyte & 2 ;j = 0 %elseif k = 2 i = 1 ;j = monbyte & 1 %else i = 1 ;j = 1 %finish %if j # 0 %start ;!Log to .TT printstring("*GATX") ;write(type,1) ;newline %finish %if i # 0 %start selectoutput(1) %if p == null %start printsymbol(2) ;printsymbol(gatex ser) ;printsymbol(type) %else !Monbyte bit 2**2 set indicates we dont want data monitored pa == p ;printsymbol(10) ;printsymbol(gatex ser) ;printsymbol(type) %for i = 0,1,7 %cycle printsymbol(pa_a(i)) %repeat %unless p_m == null %or p_fn = enable facility %or p_fn = disable facility %start pa == p_m j = p_m_l + 12 j = 28 %unless 1 <= j <= 28 printsymbol(j) %for i = 0,1,j-1 %cycle printsymbol(pa_a(i)) %repeat %finish end: %finish selectoutput(0) %finish %return #fi %end ;!of MONITOR %routine move(%integer len, from, to) ! ! 'Assembler Routine' to emulate EMAS MOVE. ! Note: 1. No action if LEN<=0 ! 2. Registers 1,2 and 3 used. ! %label loop, return ! *mov_len,1 ;! Load the length *ble_return ;! Return if less than or equal to zero *mov_from,2 ;! Load the FROM address *mov_to,3 ;! Load the TO address ! ! Loop to move LEN bytes FROM -> TO ! loop: *movb_(2)+,(3)+ ;! Move the byte *dec_1 ;! Decrement length count *bne_loop ;! Continue if length not exhausted return: %return %end %integerfn next free lcn(%integer dcedte) !Find the next free LCN. Test is done inside loop to save code. !Remember that DTEs go from top down and DCEs from 0 up %integer i, j %for i = no of lcns-1, -1, 0 %cycle %if dcedte = dte %then j = i %else j = no of lcns - i %if line_lcntab(j) = 0 %then line_lcntab(j) = 1 %and %result = j %repeat %result = -1 %end ;!of Next free LCN %routine pack bcd string(%string(255) s,%bytearrayname a, %c %integername index) !This routine takes a decimal number as a character string and packs it into A !in packed BCD (two digits per byte) starting ! at A(INDEX) and updating INDEX as it goes. INDEX is a global !variable used for this purpose. Trailing quartets are set to zero. !This routine is intended primarily for packing X-25 addresses %routinespec pack bcd char(%byte no) %integer i %if length(s) > 0 %start %for i=1,1,length(s) %cycle pack bcd char(charno(s,i) - '0') %repeat %finish index=(index+1)&x'FE' ;!Rounds INDEX up to the nearest byte boundary %return %routine pack bcd char(%byte no) %integer p p=index>>1 %if index&1=0 %then a(p)=no<<4 %else a(p) = a(p)+no&15 index = index + 1 %end ;!of PACK BCD CHAR %end ;!of PACK BCD STRING %routine packchar(%byte char, %record (mef) %name mes) mes_a(mes_l) = char mes_l = mes_l + 1 %end ;!of Pack Char %integerfn packetlength(%integer fn) !Returns the length of the control fields in an X-25 packet. !Call request, Data are not catered for %if fn = 19 %or fn = 27 %or fn = 251 %thenresult = 2 ;!Clear & conf, Reset & conf, Restart & conf. %if fn = 35 %then %result = 1 ;!Interrupt %result = 0 %end ;!of PACKETLENGTH %routine pack string(%string (255) %name s,%record (mef) %name mes) !Add string S as a substring to MES_A, taking the end of MES_A !From a length supplied in MES_L string(addr(mes_a(mes_l))) = s mes_l = mes_l + length(s) + 1 %end ;!of PACKSTRING %routine pack ts string(%string (255) s, %string (255) %name t) !Add s as a TS substring to t. length(t) = length(t) + 1 charno(t, length(t)) = length(s) ! 128 t = t.s %end %routine pull(%record (qf) %name q,item) !Pulls the specified item off a circular queue with header at Q %record (qf) %name p %if q_link == null %then %return ;!No elements (Why??) q_count = q_count - 1 %if q_link_link == q_link %then q_link == null %and %return ;!One element on Q p == q %cycle p == p_link %repeatuntil p_link == item p_link == p_link_link %if q_link == item %then q_link == p ;!If we removed Q head, reposition it %end %routine query processes #if ~s %integer i,j,k %record (linef) %name ln %record (procf) %name pr printstring("BH=") ;write(buffers held, 1) #if ~m printstring(" CT=") ;%for i = 0,1,3 %cycle ;write(curtime_a(i), 1) ;%repeat #fi newline %if busy q_count # 0 %start ln == busy q %for i = 1,1,busy q_count %cycle ln == ln_link write(ln_procno,1) ;printsymbol('/') %if ln_dcedte = dce %then printstring(" DCE") %else printstring(" DTE") printstring(" S,ID,L,LG") ;write(ln_state, 1) write(ln_ser, 1) ;write(ln_lineno, 1) ;write(ln_lcgn, 1) newline %if ln_call q_count # 0 %start pr == ln_callq %for j = 1,1,ln_call q_count %cycle pr == pr_link spaces(3) write(pr_procno, -1) ;printsymbol('/') printstring(" ST=") ;write(pr_state,-1) ;printsymbol('/') write(pr_substate, -1) ;write(pr_tstate, -1) ;write(pr_rstate, 1) printstring(" ID=") ;write(pr_task id,-1) printsymbol('.') ;write(pr_task port, -1) printstring(" LC=") ;write(pr_lcgn,-1) printsymbol('.') ;write(pr_lcn, -1) printstring(" TS,QU,OQ:") ;write(pr_tsflag, -1) write(pr_quiettime, 1) ;write(pr_outq_count, 1) printstring(" WI,WO,PI,PO:") write(pr_ww in, -1) ;write(pr_ww out, 1) ;write(pr_ps in, 1) ;write(pr_ps out, 1) printstring(" AETC:") ;write(pr_aaa, -1) write(pr_eee,-1) ;write(pr_ttt,-1) ;write(pr_ccc,-1) printstring(" CV") %if pr_cv_l > 0 %and pr_cv_l <= 27 %start %for k = 0,1,pr_cv_l %cycle ;write(pr_cv_a(k),1) ;%repeat %finish newline %repeat %finish %repeat %finish #fi %end ;!of Query Processes %routine reject connect(%integer fn, qualifier) !Reject CONNECT outright %byte ser ser = p_ser ;p_ser = p_reply ;p_reply = ser ;!Send it back whence it came p_fn = disconnect free buffer(p_m) p_m == null p_s1 = qualifier monitor(p, to up) pon(p) %end %routine reject call(%integer qualifier) !Reject incoming call outright !Dont use TO LOWER as we dont have a process %byte ser p_m_fn = clear request %unless qualifier = spurious clear req p_m_data(0) = 0 ;!Clearing cause = DTE Clearing p_m_data(1) = qualifier ;!Diagnostics ser = p_ser ;p_ser = p_reply ;p_reply = ser p_fn = line output p_len = 5 monitor(p, to low) cpon(p) %end ;!of REJECT CALL %string (255) %fn sub string(%record (mef) %name mes, %integer no) %integer i,l %unless mes == null %start l=0 %while no > 1 %cycle l=l+mes_a(l)+1 %result = "" %if l >= mes_l no = no - 1 %repeat %if mes_a(l) > 63 %then %result = "Err/Too Long" %else %result = string(addr(mes_a(l))) %finishelse %result = "" %end ;!of SUB STRING #if ~m %routine subtract times %integer i,j %bytearrayname t,st %byte borrow t == process_cv_our ct st == process_time_a !Calculate call duration. t(3) = (curtime_a(3) - st(3)) & 255 ;!Stupid compiler %if t(3)&255 < 60 %then borrow = 0 %else t(3) = t(3) + 60 %and borrow = 1 t(2) = (curtime_a(2) - st(2) - borrow) & 255 ;!Stupid compiler %if t(2)&255 < 60 %then borrow = 0 %else t(2) = t(2) + 60 %and borrow = 1 t(1) = (curtime_a(1) - st(1) - borrow) & 255 ;!Stupid compiler %if t(1)&255 < 24 %then borrow = 0 %else t(1) = t(1) + 24 %and borrow = 1 t(0) = curtime_a(0) - st(0) - borrow %for i = 0,1,3 %cycle j = t(i)//10 t(i) = j<<4 + (t(i)-j*10) %repeat %end ;!of Subtract times #fi %routine release process %integer i !Tidy up process. !Clear out-bound data queue free buffer(pop(process_outq)) %while process_outq_count # 0 free buffer(process_discbuff) pull(line_call q,process) ;push(free pq,process) %end ;!of RELEASE PROCESS %routine restart processes %integer i %bytename state %record (mef) %name mes %record (procf) %name pr %if line_call q_count # 0 %start process == line_call q_link %for i = 1,1,line_call q_count %cycle pr == process_link state == process_state process_cv_reason = call restarted %if state = wtdsn %then release process %elsestart %if process_substate & 2 = 0 %then process_substate = process_substate ! 2 %and get buffer(disconnect, long) %finish line_lcntab(process_lcn) = 0 ;!Free off LCN process_lcn = 255 ;!Decouple process from LCN/LCGN process == pr %repeat %finish %end ;!of RESTART PROCESSES %integerfn stoi(%string (15) s) %integer n,i n=0 %if length(s) > 0 %start %for i = 1,1,length(s) %cycle n = n*10 + charno(s,i)-'0' %repeat %finish %result = n %end ;!of Stoi %routine stop(%integer reason) printstring("*GATX Disaster ") ;write(reason, 1) ;newline monitor(null, query) %cycle %repeat %end ;!of Stop %routine to account(%record (mef) %name mes, %integer fn) p_ser = account ser p_reply = gatex ser p_fn = fn p_m == mes #if ~m cbuff %if fn = hello %start #fi p_s1 = gatex ser p_c2 = line_lineno #if ~m %else p_gate port = process_task id ;p_task port = process_task port %finish #fi monitor(p, mon to acct) pon(p) %end ;!of To Account %routine to lower(%record (mef) %name mes, %integer fn, datal) !datal is the length used to calculate no. of segments transmitted, !using the PSS algorithm. Datal is sometimes supplied as 0 (= 1 segment) !when the data field is known to be less than 63 bytes to avoid unnecessary !calculation. A supplied value of -1 means "don't count this one" %record (pf) p !Find the length of the Packet. For most packets this is fixed !but for Data,interrupt and connect packets it must be supplied. Length !supplied is Level 3 data length + 3 bytes control mes_l = packetlength(fn) %unless fn = dte data %or fn = call request %or fn = call accepted %if fn < 250 %start ;!Not Restarts or Restart Confirmations mes_octet1 = gfi + process_lcgn %if fn = dce data %then mes_octet1 = mes_octet1 ! (MES_FN & X'80') !Q-bit buried in bit 2**7 of MES_FN mes_lcn = process_lcn ;!Bottom byte only %if fn&3 # 3 %start ;!Data, RR, RNR, REJ fn = fn ! PROCESS_CCC<<5 %if fn&1 = 0 %then fn = fn ! PROCESS_TTT<<1 !We dont use the M bit %finish %else mes_octet1 = gfi mes_lcn = 0 %finish %if datal > 0 %then increment(tx, datal) %if fn = clear request %or fn >= 250 %start mes_a(0) = 9; !Allow for cause and diags bytes %unless fn # clear request %or process_discbuff == null %start mes_a(0) = mes_a(0) + 2; !Fast select. !These are DTE/DCE address lengths and facilities length. mes_data(2) = 0; mes_data(3) = 0 pack ts string(substring(process_discbuff, 2), mes_s) pack ts string(substring(process_discbuff, 3), mes_s) mes_l = length(mes_s) - 4 free buffer(process_discbuff); process_discbuff == null %finish mes_data(0) = 0; !Cause is always zero from us %finish process_substate = process_substate & (\16) mes_fn = fn p_ser = line_ser p_reply = gatex ser p_fn = line output p_process = line_line no p_m == mes p_len = mes_l + 3 monitor(p, to low) cpon(p) %end ;!of To Lower %routine to upper(%record (mef) %name mes, %integer fn) p_ser = process_task id p_reply = gatex ser p_fn = fn p_gate port = process_procno p_task port = process_task port p_m == mes monitor(p, to up) cpon(p) %end ;!of TO UPPER %string (63) %fn ts substring(%record (mef) %name mes, %integer ptr, no) !Routine to unpack Transport service substrings. !NO contains the substring number to go looking for !%result = "Err" if the TS substring was invalid !%result = "" if the substring is not there. !Note that currently a split substring will be rejected. !Note also that ptr is referenced to mes_data(0) but that mes_l includes !the x25 3-byte packet header %string (63) t %integer c %cycle %result = "" %if ptr >= mes_l-3 ;!TS substring not present c = mes_data(ptr) %result = "Err" %if c & 64 # 0 no = no - 1 %exit %if no <= 0 ptr = ptr + c & 63 + 1 %repeat !If TS substring overflows end of block it is invalid %result = "Err" %if ptr + c & 63 > mes_l-3 move((c & 63) + 1, addr(mes_data(ptr)), addr(t)) length(t) = length(t) & 63 %result = t %end ;!of TS Substring %routine unravel ts(%string (63) %name ts addr, ts params, %integername line) !Routine takes a TS address of the general form .. !and splits it up into those components, making allowance for defaults. %integerfnspec getnet(%string (63) %name s) %string (63) ls %if ts addr -> ls.(".").ts addr %start !Not just a bare NUA. Possible formats are .. !or . Remember may contain dots. line = getnet(ls) %if line >= 0 %start !It was .... ts params = "" %unless ts addr -> ts addr.(".").ts params %else !It was ... Our address and params strings are in the wrong place. line = default line ;ts params = ts addr ;ts addr = ls %finish %else !It was just . Return defaults. ts addr should be unaltered line = default line ;ts params = "" %finish %integerfn getnet(%string (63) %name s) !Find out if s is a valid network name and if so what line its on %integer i %for i = 0, 1, no of x25 nets - 1 %cycle %result = i %if s = shortnetname(i) %or s = longnetname(i) %repeat %result = -1 %end ;!of getnet (in unravel ts %end ;!of Unravel TS %string (15) %fn unpack bcd string(%bytearrayname a, %integer no) !Retrieves X-25 addresses. These are presented as: !Length(caller),Length(called),called,caller. Lengths are 1 !quartet each. NO=1 gives us the length and contents of caller ! NO=0 " " " " " " " called %bytefnspec next bcd char %integer i,l,index %string(255) s l=(a(0)>>(no*4))&15 ;!Assumes >>0 is valid. index = (a(0)&15)*no + 2 %if l>0 %start %for i=1, 1, l %cycle charno(s,i) = next bcd char + '0' %repeat length(s) = l %result = s %finishelseresult = "" %bytefn next bcd char %byte b %if index&1 = 0 %then b = a(index>>1)>>4 %else b = a(index>>1)&15 index = index + 1 %result = b %end ;!of NEXT BCD CHAR %end ;!of UNPACK BCD STRING %integerfn wp to facs(%string (31) facs, %string (31) %name pssfacs) !Take a facilities field presented as "W=m/n,P=m/n" and !1) validate it, 2) pull out facilities values, and 3) set flags !to indicate which were specified. Thi function is essentially !the opposite of Form Facilities %bytefnspec shift(%integer n) %string (15) m,n %integer im, in, l, flags l = 0 ;flags = 0 ;pssfacs = "" %result = -8 %if length(facs) > 21 ;!Max = "W=7/7,P=256/256,C=RFS" (21 chars) %if facs -> facs.("C=").m %start ;!Strip connection controls off length(facs) = length(facs) - 1 %if length(facs) > 0 ;!Strip off the comma process_fac = process_fac ! reverse charge bit %if m -> ("R").m process_fac = process_fac ! fast select bit %if m -> ("F").m process_fac = process_fac ! fast select bit ! restricted response bit %if m -> ("S").m %finish %if facs -> facs.("P=").m %start ;!Strip packet size indication length(facs) = length(facs) - 1 %if length(facs) > 0 ;!Strip off comma %result = -6 %unless m -> m.("/").n im = stoi(m) ;in = stoi(n) im = shift(im) ;in = shift(in) %result = -7 %unless im # 0 %and in # 0 process_ps in = im ;process_ps out = in charno(pssfacs, l+1) = x'42' ;charno(pssfacs, l+2) = im ;charno(pssfacs, l+3) = in l = l + 3 %finish %if facs -> ("W=").m %start ;!Window size indication %result = -4 %unless m -> m.("/").n im = stoi(m) ;in = stoi(n) %result = -5 %unless 0 <= im <= 7 %and 0 <= in <= 7 process_ww in = im ;process_ww out = in charno(pssfacs, l+1) = x'43' ;charno(pssfacs, l+2) = im ;charno(pssfacs, l+3) = in l = l + 3 %finish length(pssfacs) = l %result = 0 %bytefn shift(%integer n) !Function to convert from an integer packet size to form n !where 2**n = packet size. Function just shifts right till either !we get bored or we are left with the topmost bit. I'm sure there !is a clever way to do this in assembler. %integer i %for i = 0,1,15 %cycle ;!Its a 16-bit integer %result = i %if n = 1 ;!Gotcha n = n >> 1 %repeat %result = 0 ;!Signifies invalid packet size. (NB: size=1 does also) %end ;!of Shift (in WP to Facs) %end ;!of WP to Facs %endofprogram ! !Version Hierarchy: !m (Min) Minimal system - chops out checkpointing and stats reporting to ACCT !f (Fast) Fast version - chops out monitoring. !s (short) Chops out e.g. Query processes code if space is at a premium !p (Pre-ack) operates on a "read for data - data arrived" basis rather than ! "data arrived - acknowledge" to comply with the BACG/JHB spec.