!**********************************************************
!* *
!* PSS X-25 Level 3 Protocol Handler *
!* *
!* GATEX *
!* *
!* Version 10.10 9 Mar 1987 *
!* *
!**********************************************************
!*
#if o
%control 1
%include "b_deimosperm"
#else
%control x'4001'
%include "ercm09:b_deimosspecs"
#fi
%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
%constinteger second clear = 37; ! bg 22/9/86
#if ~b
%constintegername no of big buff == k'100112'; ! bg 26 SEp 84
#else
%constintegername no of big buff == k'100040'; ! in seg four
#fi
#if (m ! g)
#if h
%include "ercm09:inc_configf"
#else
#if g
%include "ercm09:inc_configglas"
#else
%include "ercm09:inc_minconf"
#fi
#fi
#else
#if l
%include "ercm09:inc_configlge"
#else
%include "ercm09:INC_CONFIG"
#fi
#fi
%include "ercm09:INC_VARIOUS"
%include "ercm09: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 "ercm09:INC_DISCQUALS"
%include "ercm09: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:inc_bformats"
#else
%include "ercm09: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.
%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 (factabf) %name facpt
%ownrecord (procf) %array proctab(1:no of procs)
#if o
%constbyteintegername change out zero == k'160310'
%constinteger t3 ser = 21
#fi
!*
!****** 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)
! New compiler - so must get 0
%result == null %if buff no = 0
*mov_1,0
*mov_#10,1; ! desired vm seg no *2 ie 4*2
*iot
%result == record(k'120000')
%end
#fi
! %include "ercm09: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(*)%name s,%record (mef) %name mes)
%routinespec pack ts string(%string(255) s, %string (*) %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 (*) %name ts addr, ts params, %integername line)
%integerfnspec wp to facs(%string (31) facs, %string (31) %name pssfacs)
%routinespec strip parity(%string(*)%name s) ;! 13/6/85
!***************************************
!* *
!* Main Program *
!* *
!***************************************
linkin(from xprot);!dentify ourself to DEIMOS for receiving messages
#if o
change out zero = t3 ser
#else
use tt(t3 ser);!Use buffered console I/O
#fi
#if ~b
i = map virt(buffer manager,5,4) ;!Get access to buffer pool
i = map virt(buffer manager,6,5)
#else
i = map virt(buffer manager, 6, 4)
#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'
%if p_m_type # 0 %and p_m_l > 64 - 8 %start; ! too long
printstring("Gatx:too long"); write(p_m_l, 1)
write(p_ser, 1); write(p_a1, 1); write(p_a2, 1); newline
stop(91)
%finish
#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<<process_ps in, -1)."/".itos(1<<process_ps out, -1)
%finish
%if flags & fast select # 0 %start; ! 7/3/86 (restr. resp. removed -bg)
facs = facs."," %unless facs = ""
facs = facs."C=F"
! rest. response code removed bg 7.3.86
%finish
%result = facs
%end ;!of Form Facilities
%routine clear outq; ! bg 25 sep 84
#if ~b
free buffer(pop(process_outq)) %while process_outq_count # 0
#else
free buff no(bpop(process_outq)) %while process_outq_count # 0
#fi
%end
#if b
%routine free buff no(%integer buff no)
! not mapped, so send it straight back
%record (pf) p
%return %if buff no = 0; ! rest of code is very loose on this
p_ser = buffer manager; p_reply = id
p_fn = release buffer
p_buff no = buff no
cpon(p)
%end
#fi
%routine free buffer(%record (mef) %name mes)
%record (pf) p
#if b
%integer buff no
! nb: routine ASSUMES buffer is mapped on
#fi
%unless mes == null %start
!There really is a buffer
#if b
buff no = mes_buff no
stop(95) %if buff no = 0
#fi
%if mes_type = short %and short q_count < critical short %start
#if ~b
push(short q, mes)
#else
bpush(short q, buff no)
#fi
%else
!Tell Buffer Manager it can have its buffer back.
p_ser = buffer manager ;p_reply = id
p_fn = release buffer
#if ~b
p_m == mes
#else
p_buff no = buff no
#fi
cpon(p)
%finish
%finish
%end ;!of Free Buffer
%routine handle clock tick
! %record (mef) %name mes ;! Ruth 13/3/84
%integer i,j
#if ~(m ! g)
!Maintain time-since-IPL timer
curtime_a(3) = curtime_a(3) + 2
%if curtime_a(3) = 60 %start ;!Seconds wrap-round
curtime_a(3) = 0
curtime_a(2) = curtime_a(2) + 1
%if curtime_a(2) = 60 %start ;!Minutes wrap-around
curtime_a(2) = 0
curtime_a(1) = curtime_a(1) + 1
%if curtime_a(1) = 24 %start ;!Hours wrap-around
curtime_a(1) = 0
curtime_a(0) = curtime_a(0) + 1
%finish
%finish
%finish
#fi
!1) Time out stuck calls
!2) Checkpoint
!3) Poll restarts at link startup
!4) release any RNR condition still up
%if busy q_count # 0 %start
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
%if line_state = established %start
process == process_link
#if ~(m ! g)
%if curtime_a(3) = 0 %and curtime_a(2)&3 = 0 %then get buffer(checkpoint, short)
!Checkpoint on every 4th minute
#fi
%if process_state = estb %and process_substate & 48 # 0 %start
maybe send rr(null)
%elseif process_state = wait data
process_quiettime = process_quiettime - 1
%if process_quiettime = 0 %then get buffer(clear request, short)
%elseif process_state = wtdsn2 ;!We'll lose stats record.
process_quiettime = process_quiettime - 1
%if process_quiettime = 0 %start
%if process_substate & 2 = 0 %then process_substate = process_substate ! 2 %and get buffer(disconnect, long)
process_state = wtdsn
%finish
%finish
%elseif line_state = restarting
line_time = line_time + 1
%if line_time & 3 = 0 %then process == line %and get buffer(restart indication, short)
%finish
%repeat
%finish
%repeat
%finish
%if int = 'D' %start
shutters up = 1 - shutters up
%elseif int = 'C'
mon cons = 1 - mon cons
%elseif int = 'V'
printstring("GATX Running") ;newline
%elseif int = 'R' ;! Ruth 13/3/84
mon reset = 1 - mon reset
#if ~f
%elseif int = 'N'
selectoutput(1)
close output ;!Close current trace file (Selectoutput 1) and start another
#fi
%elseif int = '?'
query processes
! 6/2/85 monitor(null,query) ;!Display process variables
#if ~f
%elseif '0' <= int <= '9'
monbyte = int - '0' ;!Change monitoring level
#fi
%finish
int = 0
alarm(100)
%end ;!of HANDLE CLOCK TICK
%routine handle line input
%string (127) caller
%string(63) called, caller params, called params, exptext
%string (23) facs
%string(4) protb
!Lengths: Packets come in with the full level 3 data length
!(Packet header + data)
%string(2) subaddr
%bytearrayname data
%record (mef) %name mes
%integer state, buff no, stp
%byte nr,ns,fn,x,cudfl,facl,lcgn,dtel
%integer i,j, rc
#if ~f
monitor(p, from low); ! removed bg 7aug84
#fi
#if ~b
%if p_m == null %then monitor(p, bad block) %and %return
mes == p_m ;data == mes_data
#else
buff no = p_buff no
%if buff no = 0 %then monitor(p, bad block) %and %return
mes == map(buff no); data == mes_data
mes_owner = own id ;! 5/2/85
#fi
fn = mes_fn
#if b
{printstring("Gin"); write(fn, 1); write(buff no, 3); newline}
#fi
!Identify which line it came in on
%if busy q_count # 0 %start
line == busy q_link
%for i = 1, 1, busy q_count %cycle
-> 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 int = '*' %then process_ww out = 7; ! crunch it
#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&15 + data(0)&15 + 1)>>1&x'7f' ;!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
#if p
increment(rx, cudfl)
#fi
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
!bg 26/11/86 str2 = called params %unless called params -> ("(").str1 %c
!bg 26/11/86 %and str1 -> str1.(").").str2
!bg 26/11/86 !str2 now contains <dest>.<facility>.<residue) or <facility>
str1 = str2 %unless str2 -> str2.(".").str1
!str1 now contains <facility> if address is valid
process_task id = 0
%for i = 0,1,factot-1 %cycle
facpt == faclist(i)
%if str1 -> (facpt_facility).str1 %then process_task id = facpt_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
facpt == faclist(i)
%if facpt_facility = "XXX" %then process_task id = facpt_ser %and %exit
%repeat
%finish
%if process_task id # 0 %start
stp = dtel+facl+6
caller params = ts substring(mes, stp, 2)
caller = caller.".".caller params %unless caller params = ""
exptext = ts substring(mes, stp, 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)
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&7 ;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'
#if p
increment(rx, mes_l-3) ;!Increment will catch case where mes_l-3 < 0
#fi
%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&15 + data(0) & 15 + 1)>>1&x'7f'
facl = data(dtel + 1)
#if p
increment(rx, mes_l - dtel - facl - 5)
#fi
%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)
%if int = '*' %then process_ww out = 7; ! crunch the call (bg 22/sep/87)
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&15 + data(i) & 15 + 1)>>1&x'7f'
facl = data(dtel + 3)
cudfl = mes_l - dtel - facl - i - 5
#if p
increment(rx, cudfl)
#fi
%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
%unless process_clrbuff == null %start; ! multiple clears ?
free buffer(process_clrbuff)
monitor(p, second clear); ! put out message
%finish
process_clrbuff == mes ;mes_fn = cudfl
mes_a(1) = k'123'; ! marker
#else
free buff no(process_clrbuff); ! just in case !
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:") ; write(p_reply, 0)
printsymbol('.'); write(p_task port, 0); space
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&x'7f'))) = facs
index = index + length(facs)<<1 + 2
move(length(cudf), addr(cudf)+1, addr(mes_data(index>>1&x'7f')))
index = index + length(cudf)<<1
mes_l = index>>1&x'7f' ;!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 = string(addr(mes_a(0)))
#if b
mes_owner = own id
#fi
buffers held = buffers held+1; ! does NOT go thru cbuff call above
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
%unless mes == null %start; ! shouldn't be a buffer here
buffers held = buffers held-1; ! got counted earlier
! don't risk freeing as progs are not watertight on zeroing it
%finish; ! bg 22/9/86
%if process_state = estb %and process_rstate = clear %start
process_ccc = (process_ccc + p_s1) & 7
%if p_s1 > 1 %then process_substate = process_substate!16
! more than one ack, force an immediate
! L3 RR
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&15 + f(dtel)&15 + 1)>>1&x'7f'
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.
%if process_substate & 48 # 0 %or %c
process_ww in = 1 %start
%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 (*) %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 (*) %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
%unless qualifier = spurious clear req %then mex_fn = clear request %else %c
mex_fn = clear confirmation
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
%record (mef) %name mex
!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}
{ str1 = substring(mex, 2); str2 = substring(mex, 3)}
#else
%unless fn # clear request %or process_discbuff = 0 %start
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}
#fi
{ %unless length(str1)+length(str2) > 40 %start; ! protection measure}
{ 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}
{ mes_s = ""}
{ pack ts string(str1, mes_s)}
{ pack ts string(str2, mes_s)}
{ mes_l = length(mes_s) - 4}
{ %finish}
{9 mar 87 - above section removed because }
{ modules are sending rubbish contents}
{ also: problems with non fast-select calls}
#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 (*) %name ts addr, ts params, %integername line)
!Routine takes a TS address of the general form <Net>.<NUA>.<residue>
!and splits it up into those components, making allowance for defaults.
%integerfnspec getnet(%string (*) %name s)
%string (63) ls
%if ts addr -> ls.(".").ts addr %start
!Not just a bare NUA. Possible formats are <Net>.<NUA>.<residue>
!or <NUA>.<residue> Remember <residue> may contain dots.
line = getnet(ls)
%if line >= 0 %start
!It was <Net>....
ts params = "" %unless ts addr -> ts addr.(".").ts params
%else
!It was <NUA>... 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 <NUA>. Return defaults. ts addr should be unaltered
line = default line ;ts params = ""
%finish
%integerfn getnet(%string (*) %name s)
!Find out if s is a valid network name and if so what line its on
%integer i
%string (63) t
t = s; ! new compiler fault with string compare
%for i = 0, 1, no of x25 nets - 1 %cycle
%result = i %if t = shortnetname(i) %or t = 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(*)%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