!********************************************************** !* * !* PSS X-25 Level 3 Protocol Handler * !* * !* GATEX * !* * !* Version 9.62 14 Mar 1986 * !* * !********************************************************** !* %control 1 %begin #options !************************************ !* * !* 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 %constinteger looping for process = 35 %constinteger mon null buffer = 36 ;! 9/8/84 #if ~b %constintegername no of big buff == k'100112'; ! bg 26 SEp 84 #else %constintegername no of big buff == k'000040'; ! in seg zero #fi #if (m ! g) #if h %include "ercm06.inc_configf" #else #if g %include "ercm06.inc_configglas" #else %include "ercm06.inc_minconf" #fi #fi #else #if l %include "ercm06.inc_configlge" #else %include "ercm06.INC_CONFIG" #fi #fi %include "ercm06.INC_VARIOUS" %include "ercm06.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 =128 %constinteger restricted rsp = 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 "ercm06.INC_DISCQUALS" %include "ercm06.INC_SERS" !*Various consts !Note LCN = 255 is used as a flag %constinteger critical long = 5 ;! 11/9/84 %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 ****** #if b %include "ercm09.x25_bformats" #else %include "ercm06.INC_FORMATS" #fi %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 #if b %record (linef) %name linelink,%record (qf) outq, %integer acks outstanding, clrbuff, discbuff, %c #else %record (linef) %name linelink, %record(qf) outq, %integer acks outstanding, %record(mef) %name clrbuff,discbuff, %c #fi %byte lcgn,lcn,aaa,eee,ttt,ccc,tstate,rstate,substate,ww in,ww out,ps in,ps out, #if (m ! g) %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 #fi #if b %recordformat hold bufff(%record (hold bufff) %name link, %integer buff no) %record (holdbufff) %array hba(0:100) %record (holdbufff) %name free hold #fi %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 %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 mon reset = 0 ;! Ruth 13/3/84 %owninteger default line = -1 %ownstring(1) nullstr = "" %ownstring(2) fac = "**" %ownstring (63) str1, str2 ;! bg 14/11/84 %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 %ownrecord (mef) %name mex, mes; ! bg 25 sep 84 !****** Records and Recordarrays ****** %ownrecord (qf) busy q, free lq, free pq, short q = 0 %constinteger facmax = 16 #if ~(m ! g) %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 #if b %routine bpush(%record (qf) %name q, %integer buff no) %record (hold bufff) %name bf bf == free hold free hold == bf_link bf_buff no = buff no push(q, bf) %end %integerfn bpop(%record (qf) %name q) %record (hold bufff) %name bf %integer x bf == pop(q) x = bf_buff no bf_link == free hold free hold == bf %result = x %end %record (mef) %map map(%integer buff no) ! buff no is already in r0 - where its wanted %result == null %if buff no = 0 *mov_#10,1; ! desired vm seg no *2 ie 5*2 *iot %result == record(k'120000'); ! allow 3 code segs for now %end #fi %include "ercm06.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 clear outq #if b %routinespec free buff no(%integer buff no) #fi %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, rejtype) %routinespec reject connect(%integer fn, qualifier) %routinespec release process %string (255) %fnspec sub string(%record (mef) %name mes, %integer no) #if ~(m ! g) %routinespec subtract times #fi %routinespec buffer arrived %string (23) %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) #if ~a %routinespec to account(%record (mef) %name mes, %integer fn) #fi %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) %routinespec strip parity(%string(255)%name s) ;! 13/6/85 !*************************************** !* * !* Main Program * !* * !*************************************** linkin(from xprot);!dentify ourself to DEIMOS for receiving messages change out zero = t3 ser ;!Use buffered console I/O #if ~b map virt(buffer manager,5,4) ;!Get access to buffer pool map virt(buffer manager,6,5) #else map virt(buffer manager, 6, 0) #fi 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 #if b %cycle i = 100, -1, 2 hba(i-1)_link == hba(i) %repeat free hold == hba(1) #fi 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_b ;!This enables us to come up refusing connections. NB cant undo this !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); buffers held = buffers held + 1 #if ~b push(short q, p_m) #else bpush(short q, p_buff no) #fi 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 b ! safety measure for testing mes == map(k'7600'); ! map OFF last buffer #fi %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, i ;! 4/3/85 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. ! check acks received against acks outstanding %if acks > 0 %and process_acks outstanding > 0 %start ;! 1/3/85 %if process_acks outstanding > acks %start i = acks process_acks outstanding = process_acks outstanding - acks %else ;! 4/3/85 i = process_acks outstanding process_acks outstanding = 0 %finish p_s1 = i 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 #if ~b p_m == pop(short q) #else p_buff no = bpop(short q) #fi buffer arrived get buffer(0, short) %unless shortq_count > 1 ;! 11/9/84 %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, buff no %record (mef) %name mes %integer state #if ~b mes == p_m #else buff no = p_buff no mes == map(buff no) mes_owner = own id ;! 14/2/85 #fi 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 clear outq ;! bg 14/11/84 mes_data(1) = process_cv_reason %if state = estb %or state = wait data %or state = wtacn %start to lower(mes, clear request, 0) ;clrtx = clrtx + 1 process_state = wtdsn2 ;process_quiettime = 6 %elseif state = wtaci to lower(mes, clear request, 0) ;clrtx = clrtx + 1 process_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 ! g) subtract times #fi packstring(process_cv_s, mes) #if ~b %unless process_clrbuff == null %start mex == process_clrbuff ;! bg 14/11/84 #else %unless process_clrbuff = 0 %start mex == map(process_clrbuff) #fi !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 = mex_l - mex_fn - 3;!points to start of UD str1 = ts substring(mex, l, 1) str2 = ts substring(mex, l, 2) !OK we've finished with the clear - send it off as a clear conf. & !decouple LCN to lower(mex, clear confirmation, 0) ;clrctx = clrctx + 1 #if b process_clrbuff = 0 mes == map(buff no); ! get back to 'mes' #else process_clrbuff == null #fi packstring(str1, mes) packstring(str2, mes); ! bg 01oct84 - should be the same in effect 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) process_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 ! g) %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 # 1 %start; ! bg 2aug84 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. ! 1/3/85 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 ~b %if short q_count <= 2 %then push(short q, mes) %else free buffer(mes); ! bg 25 sep 84 #else %if short q_count <= 2 %then bpush(short q, mes_buff no) %else free buffer(mes) #fi %finish %end ;!of Buffer Arrived %routine cbuff #if ~b %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'20'. Look at top 2 bits and bottom 6. stop(96) %unless p_b & k'140017' = k'100000' ;! Ruth 13/3/84 #else %unless p_buff no = 0 %start stop(97) %unless k'1000' <= p_buff no <= k'7777' #fi 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 #if ~b %unless p_m == null %start stop(99) %if 0 # p_m_type # 64 stop(97) %unless p_b & k'140017' = k'100000' #else %unless p_buff no = 0 %start stop(97) %unless k'1000' <= p_buff no <= k'7777' #fi buffers held = buffers held - 1 %finish pon(p) %end %string (23) %fn form facilities(%integer flags) %string (23) 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=mmm/nnn,C=rfs" 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) %finish %if flags & ps set # 0 %start ;!Specify packet size !Note PSS transfers packet size as n, where 2**n = size facs = facs."," %unless facs = "" 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 ! g) 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 process_ww in = 2; ! serc mod removed bg 10.3.86 process_ww out = process_ww in #if ~(m ! g) 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) !Shutters up either locks out calls completely or can allow only !only those callers with the correct last two digits. i = charno(caller, length(caller)-1)<<8 + charno(caller, length(caller)) %if shutters up = 0 %or shutters up = i %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. strip parity(called params) ;! 13/6/85 !bg 14/11/84 str2 = called params %unless called params -> ("(").str1 %c %and str1 -> str1.(").").str2 !str2 now contains .. str1 = str2 %unless str2 -> str2.(".").str1 !str1 now contains if address is valid process_task id = 0 %for i = 0,1,factot-1 %cycle %if str1 -> (faclist(i)_facility).str1 %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 = 1 %start; ! bg 2aug84 %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) newline %if length(caller) > 40 ;! 11/9/84 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 = 1 %then packstring(protb, mes); ! bg 2aug84 p_s1 = process_tsflag to upper(mes, connect) process_state = wtaci %finishelse reject call(prot not supported, 1) %finishelse reject call(ts incompatible facilities, 1) %finishelse reject call(ts going out of service, 1) %else ;!No free processes !Note: a clear confirmation will come back with no process reject call(ts number busy, 0) %finish %finishelse reject call(lcn conflict, 0) %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 #if ~a p_len = 0 to account(null, hello) ;!Tell Account line is up #fi 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 #if b ! new interface, len_3 is passed in _l i.e. user data length mes_l = 0 ;! 5/2/85 #fi p_len = 3 rstctx = rstctx + 1 cpon(p) ;! Ruth 13/3/84 %finish restart processes %elseif fn = restart confirmation rstcrx = rstcrx + 1 %if line_state = restarting %start #if ~a p_len = 0 to account(null, hello) ;!Tell Account line is up #fi line_state = established %finish free buffer(mes) restart processes %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, 0) %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. %if mes_data(0) = ts disconnect %start process_cv_reason = mes_data(2) ;! 26/2/85 %if mon reset # 0 %start ;! Ruth 13/3/84 ! write out explanatory text ! bg mods 2aug84 mes_l = mes_l+3; ! ts sub. wants orig. length printstring("TSd:") called = ts substring(mes, 1, 2) printstring(called) %if length(called) > 25 %then newline %else printsymbol(',') printstring(ts substring(mes, 1, 3)) newline ! bg mods end %finish to lower(mes, clear indication, 0); clrtx = clrtx + 1 process_state = wdaci %else !We don't implement this yet so discard it (nasty isnt it) ! bg mods 2/aug/84 %if mes_data(0) = ts accept %and process_tsflag # 0 %start ! special case, send ts accept up to process to upper(mes, control input here) process_tsflag = 0; ! now normal type %else process_ccc = (process_ccc + 1) & 7 maybe send rr(mes) %finish %finish %finish handle outq %else ;!Sequence error - shouldn't happen derrrx = derrrx + 1 rc = bad ack -> chop; ! bg 2aug84 %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 rsp = 0 %start (bg 7.3.86) !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) process_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 (bg 7.3.86)} { 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 = 2 %else i = 0; !bg 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 clear outq ;! bg 14/11/84 !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 process_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 #if ~b process_clrbuff == mes ;mes_fn = cudfl #else process_clrbuff = mes_buff no; mes_fn = cudfl #fi %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) %if mon cons #0 %or data(0) # 0 %start ;! 11/10/85 printstring("Reset") ;write(data(0), 1) ;printsymbol('/') write(data(1), 1) ;newline %finish 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) clear outq ;! 14/11/84 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 #if ~b free buffer(mes) #else free buff no(buff no) #fi %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 #if ~f monitor(p, from low); ! removed bg 7aug84 #fi %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 #if ~a to account(null, hello) #fi #if ~f monitor(null,line down); ! removed bg 7aug84 #fi restart processes line_state = down %else %if line_state = down %start printstring(longnetname(line_lineno)) ;printstring(" Line Up") ;newline #if ~f monitor(null,line up); ! removed bg 7aug84 #fi 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 #if ~b mes == pop(process_outq) #else mes == map(bpop(process_outq)) #fi 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 %record (mef) %name mes %string(63) caller, called, called params, cudf, exptext ;! 5/2/85 %string (31) facs %bytename state %byte r,s %integer flags %integer fn,lcn,lineno,l,i,j, buff no %string(7) ls #if ~b mes == p_m ;fn = p_fn #else buff no = p_buff no fn = p_fn mes == map(buff no) #fi #if ~b cbuff %unless fn = enable facility %or fn = disable facility #else %unless fn = enable facility %or fn = disable facility %start ;! 5/1/85 cbuff %unless mes == null %then mes_owner = id %finish #fi #if ~f monitor(p, from up); ! removed bg 7aug84 #fi %if fn = connect %start %if mes == null %start ;! 9/8/84 monitor(null, mon null buffer) reject connect(fn,cause unknown) %return %else called = substring(mes, 1) unravel ts(called, calledparams, lineno) %if busy q_count # 0 %start again: 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 %if lineno = 0 %then lineno = 1 %and -> again; ! bg 7.3.86 ! try both lines if #1 is down 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 ! g) process_cv_l = 3 #else process_cv_l = 15 #fi process_tsflag = p_s1&127 ! TSFLAG 0 = ts bg 2aug84 ! 1 = xxx ! 2 = ts BUT pass ts accept to caller !Tstate = Clear, OUTQ_COUNT = 0 implicitly { %if shortnetname(line_lineno) = "S" %start (bg 7.3.86)} { !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) ! added 22 oct 1984 by dw. Enabling a task to specify ! that it wants the supplied caller address to be ! included in the call request packet and not just ! as call user data.. ! If length of called address is odd, then decrement ! value of index by one, since pack bcd string rounds ! up index to next byte boundary .. 21/8/85 %IF p_s1&128 # 0 %AND caller # "" %START mes_data(0) = mes_data(0)!(length(caller)&15)<<4 %if length(called) & 1 # 0 %then index = index - 1 ;! 21/8/85 pack bcd string(caller,mes_data,index) %FINISH !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 # 1 %or exptext = "" %start; ! bg 2aug84 !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 # 1 %then cudf = tsprotb %else cudf = xxxprotb; ! bg 2aug84 pack ts string(called params, cudf) pack ts string(caller, cudf) %unless p_s1&128 # 0 %if process_tsflag # 1 %start ;!TS only; ! bg 2aug84 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 %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 ! g) process_time = curtime #fi to lower(mes,call request, length(cudf)) ;calltx = calltx + 1 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 %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 buffers held = buffers held + 1 ;! Ruth 13/3/84 #if b mes_owner = own id #fi 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 ! g) %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 id = p_reply %and process_task port=p_task port %then ->found it %repeat %finish %repeat %finish %finish !Failed to find a process corresponding to specified proc.no failed:; ! bg 2aug84 monitor(p,bad process) free buffer(mes) %return found it: state == process_state %if state = idle %then -> failed; ! bg 2aug84 line == process_linelink %if fn = put output %or fn = put control output %start %if mes == null %start ;! 9/8/84 monitor(null, mon null buffer) %return %else !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 #if ~b push(process_outq,mes) #else bpush(process_outq,mes_buff no) #fi !We ignore the PUSH bit in P_S1 since all data is acknowleged !end-to-end anyway ! user sent block, count it as outstanding process_acks outstanding = process_acks outstanding + 1 ;! 1/3/85 !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. ! Acks sent so one less reauired ! 1/3/85 process_ acks outstanding = process_acks outstanding - 1 ! ? check if < zero 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) %unless state = wtdsi ;! 13/8/84 !Line down free buffer(mes) %finish %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 process_istate = 1 { Block further ints or we may get reset } %if mes == null %start get buffer(interrupt, short) %else %if 3 <= state <= 4 %start mes_data(0) = p_s1 ; to lower(mes,interrupt,0) %else free buffer(mes) %finish %finish %else free buffer(mes) %unless mes == null %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) clear outq ;! 14/11/84 process_aaa = 0 ;process_ccc = 0 ;process_eee = 0 ;process_ttt = 0 process_tstate = clear process_rstate = clear %finish #if ~b free buffer(mes) #else free buff no(buff no) #fi %elseif fn = disconnect #if ~b process_discbuff == mes #else process_discbuff = buff no #fi 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 %start get buffer(clear request,short) %else clear outq ;! bg 14/11/84 %if state = wtdsi %start release process %else state = wtdsn2 process_quiettime = 6 %finish %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 rsp = 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 # 1 %start; ! bg 2aug84 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) #if ~(m ! g) ;! Ruth 13/3/84 %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 ! g) ;! Ruth 13/3/84 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,q %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 ! g) 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.) q = f(p+1) process_fac = q %if q & 1 # 0 %or q&x'c0' = x'c0' %start ;!Reverse charging ! or restr. resp (bg 7.3.86) %result = not negotiable %elseif q & x'80' # 0 ;!Fast Select i = i ! fast select %finish %finish p = p + 2 %repeat %result = i %end ;!of Interpret Facilities %routine maybe send rr(%record (mef) %name mes) %integer x ! 11/9/84 ! Routine changed to a) Cut down rrs and ! b) Put back rnr !Send a level 3 RR if we absolutely have to. Defer it otherwise till the next tick ! New condition ! Withhold rr or rnr unless one has already been withheld ! or window is only one. x = (process_ccc-process_eee) & 7; ! no to be acked %if process_substate & 48 # 0 %or %c process_ww in = 1 %or x > 1 %start; ! bg 10.3.86 %if mes == null %then get buffer(rr, short) %and %return %if no of big 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) %unless mes == null %finish %end ;!of Maybe send rr %routine monitor(%record (pf) %name p,%integer type) #if f printstring("*GATX:"); write(type, 1); newline; ! bg 2aug84 #fi #if ~f %recordformat pfa(%bytearray a(0:27)) %record (pfa) %name pa %record (mef) %name me2 %integer i,j,k 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 %if monbyte & 4 = 0 %or p_fn = connect %or p_fn = disconnect %start pa == p ;printsymbol(10) ;printsymbol(gatex ser) ;printsymbol(type) %for i = 0,1,7 %cycle printsymbol(pa_a(i)) %repeat #if ~b %unless p_m == null %or p_fn = enable facility %or p_fn = disable facility %start pa == p_m me2 == pa #else %unless p_buff no = 0 %or p_fn = enable facility %or p_fn = disable facility %start pa == map(p_buff no) me2 == pa #fi j = me2_l + 12 j = 28 %unless 1 <= j <= 28 printsymbol(j) %for i = 0,1,j-1 %cycle printsymbol(pa_a(i)) %repeat %finish %finish %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 *sob_1,loop ;! Decrement length count: 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 ! %integer x %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 ! x = x + 1 ! %if x > q_count + 1 %then stop(looping for process) %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 ! g) 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 ! 4/3/85 #if ~b ! 4/3/85 #if ~d ! 4/3/85 free buffer(p_m); p_m == null ! 4/3/85 #fi ! 4/3/85 #else ! 4/3/85 free buff no(p_buff no); p_buff no = 0 ! 4/3/85 #fi p_s1 = qualifier #if ~f monitor(p, to up); ! removed bg 7aug84 #fi cpon(p) %end %routine reject call(%integer qualifier, rejtype) !This routine rejects calls either (rejtype = 0) outright without !there being a process around or (rejtype = 1) with a process around. %byte ser #if ~b mex == p_m; ! bg 26 sep 84 #else mex == map(p_buff no); ! is it mapped - check !!!!!!!! #fi %if rejtype = 0 %start; !Reject incoming call outright !Dont use TO LOWER as we dont have a process mex_fn = clear request %unless qualifier = spurious clear req mex_data(0) = 0 ;!Clearing cause = DTE Clearing mex_data(1) = qualifier ;!Diagnostics ser = p_ser ;p_ser = p_reply ;p_reply = ser p_fn = line output p_len = 5 #if ~f monitor(p, to low); ! removed bg 7aug84 #fi cpon(p) %else process_state = wtdsn mex_data(1) = prot not supported to lower(mex, clear request, 0) %finish clrtx = clrtx + 1 %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 ! g) %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 clear outq ;! bg 14/11/84 #if ~b free buffer(process_discbuff); process_discbuff == null free buffer(process_clrbuff);process_clrbuff == null #else free buff no(process_discbuff); process_discbuff = 0 free buff no(process_clrbuff); process_clrbuff = 0 #fi pull(line_call q,process) ;push(free pq,process) process_state = idle; ! bg 2aug84 process_task port = 0; ! bg 2aug84 %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 #if ~a %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 ! g) cbuff %if fn = hello %start #fi p_s1 = gatex ser p_c2 = line_lineno #if ~(m ! g) %else p_gate port = process_task id ;p_task port = process_task port %finish #fi #if ~f monitor(p, mon to acct) ;! removed bg 7aug84 #fi cpon(p) %end ;!of To Account #fi %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 #if b %integer buff no #fi 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 #if ~b %unless fn # clear request %or process_discbuff == null %start mex == process_discbuff; ! bg 26 sep 84 #else %unless fn # clear request %or process_discbuff = 0 %start #fi 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 #if b buff no = mes_buff no mex == map(process_discbuff) str1 = substring(mex, 2); str2 = substring(mex, 3) mes == map(buff no); ! get back to mes pack ts string(str1, mes_s) pack ts string(str2, mes_s) #else pack ts string(substring(mex, 2), mes_s) pack ts string(substring(mex, 3), mes_s) #fi mes_l = length(mes_s) - 4 #if ~b free buffer(process_discbuff); process_discbuff == null #else free buff no(process_discbuff); process_discbuff = 0 #fi %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 #if ~b p_m == mes #else p_buff no = mes_buff no #fi p_len = mes_l + 3 #if ~f monitor(p, to low); ! removed bg 7aug84 #fi 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 #if ~b p_m == mes #else %if mes == null %then p_buff no = 0 %else p_buff no = mes_buff no #fi #if ~f monitor(p, to up); ! removed bg 7aug84 #fi 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 %or ptr<0 ;!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 %if m -> ("F").m { process_fac = process_fac ! fast select ! restricted rsp %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 %routine strip parity(%string(255)%name s) ;! 13/6/85 %integer i %byte c %if length(s) > 0 %start %for i = 1,1,length(s) %cycle c = charno(s,i)&127 %if 'a' <= c <= 'z' %then c = c & x'5F' charno(s,i) = c %repeat %finish %end %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. !b Brians new buffer manager 12/11/84 !a To get rid of account module for info,feps and xcall