%begin {'CORAL' TEST RESPONDER} %c {'COMMENT' VERSION 1.1} {} {The official definition of Coral 66 does not provide for the output of} {data at run time. However the facilities provided by the following} {routines are useful within the Test Responder for logging/debugging} {purposes. They can be supplied by the implementor either by adapting} {existing routines or by writing new ones.} {} {The use of these routines is optional. If the implementor does not wish} {to generate such output, he can define these procedures to be null,} {comment them out, or delete each occurrence of them from the code. The} {occurrences within read.command.octet (chart 3) have been commented out,} {because for normal use they produce too much output:- one line per octet} {received. The function of each of the routines is as follows:} {} {} {trwritestring - writes the string supplied as the parameter to the} { output buffer.} {trwriteint - converts the integer supplied as the first parameter to} { its corresponding character representation before} { writing it to the output buffer right justified in a} { field of width given by the second parameter.} {trwriteout - writes the record in the output buffer to the currently} { selected output stream and resets the buffer}; %c %c 'LIBRARY' (%ROUTINEspec trwritestring(%INTEGER b), %c trwriteint(%INTEGER, %INTEGER b), %c trwriteout %c ) %c %c {'COMMENT'} {Acknowledgements:} { This code was originally written by M. Woodger. It was then updated} {by C.R.V. Reed of AERE Harwell under supervision of D. Rayner.} {Additional contributions to Version 1.1 have been made by the following} {members of the Protocol Standards Group: D.C. Eason, P. Oliver,} {J. R. Pavel, and D. Rayner }; 'COMMON' %c ( %c %INTEGERFNspec block(%INTEGER b); %ROUTINEspec initblock(%INTEGERARRAYname c, %INTEGER b); %INTEGERFNspec putch(%INTEGERARRAYname d); %INTEGERFNspec getch(%INTEGERARRAYname d); %ROUTINEspec copy(%INTEGERARRAYname c, %INTEGERARRAYname d); %ROUTINEspec copy text(%INTEGER A, %INTEGERARRAYname d); %ROUTINEspec store param(%INTEGERARRAYname c, %INTEGERARRAYname d); %ROUTINEspec fetch param(%INTEGERARRAYname c, %INTEGERARRAYname d); %ROUTINEspec send connect(%INTEGERARRAYname d); %ROUTINEspec initialise control variables; %ROUTINEspec set default mode; %INTEGERFNspec read command octet; %ROUTINEspec respond to change mode event; %INTEGERFNspec param count checks with command type; %INTEGERFNspec read parameter; %ROUTINEspec respond to command; %ROUTINEspec respond to invalid command event; %ROUTINEspec do actions(%INTEGERARRAYname d); %ROUTINEspec respond to cles; %INTEGERFNspec test input(%integername c, %c %INTEGER b); %INTEGERFNspec drive automatic source; %INTEGERFNspec count and respond to primitive message; %INTEGERFNspec %c no of octets checks with command type and param count; %INTEGERFNspec mode parameters check; %ROUTINEspec send octet(%INTEGER A, %INTEGER b); %ROUTINEspec process cle count(%INTEGER b); %ROUTINEspec respond to poc event; %ROUTINEspec respond to incoming message; %INTEGERFNspec response parameters check; %INTEGERFNspec cle parameters check; %INTEGERFNspec source parameters check; %ROUTINEspec send parameter; %ROUTINEspec send and count ns message(%INTEGER A, %c %INTEGER b); %ROUTINEspec send reply(%INTEGER A, %c %INTEGER A, %INTEGER b); %ROUTINEspec abandon command; %ROUTINEspec send and buffer ns message(%INTEGER A, %c %INTEGER A,%INTEGER A, %INTEGER b); %ROUTINEspec act2; %ROUTINEspec act3; %ROUTINEspec act4; %ROUTINEspec act5; %ROUTINEspec act6; %ROUTINEspec act7; %ROUTINEspec act8; %ROUTINEspec act9; %ROUTINEspec act10; %ROUTINEspec act11; %ROUTINEspec act12; %ROUTINEspec act13; %ROUTINEspec act14; %ROUTINEspec act15; %ROUTINEspec act16; %ROUTINEspec act17; %ROUTINEspec act18; %ROUTINEspec act19; %ROUTINEspec act20; %INTEGERFNspec input ns(%INTEGERARRAYname d); %ROUTINEspec wait for ns input(%INTEGERARRAYname d); %ROUTINEspec output ns(%INTEGERARRAYname c, %INTEGER b); %ROUTINE supply initial values(%INTEGERARRAYname c, %INTEGERARRAYname , %c %integername d); %c %c %owninteger blocksize = 0; %owninteger getpntr = 1; %owninteger putpntr = 2; {(For using "blocks")} %owninteger response size = 4; {(Max. no. of parameters)} %owninteger response limit = 4; {(Upper array bound)} %c %owninteger true = 1; %owninteger false = 0; {(Boolean values)} %owninteger h = 72; %owninteger t = 84; %owninteger w = 87; {(ASCII codes)} %c %owninteger allowed to wait = true; %owninteger not allowed to wait = false; %c %owninteger none = 0; %owninteger warn = true; %owninteger no warn = false; %owninteger addr = true; %owninteger not addr = false; {(Constant parameters)} %c %owninteger connect = 1; %owninteger accept = 2; %owninteger disconnect = 3; %owninteger data = 4; %owninteger address = 5; %owninteger push = 6; %owninteger expedited = 7; %owninteger reset = 8; {(NS primitive message types)} %c %owninteger forward buffered output = 99; {(Used by Chart 30 when calling} { Chart 33 to simulate Chart 31)} %c {'COMMENT' Definition of implementation dependent constants, actual} { values to be supplied by the implementor. Note that with the} { data structure used, LIMIT = round(0.5*SIZE) + 2} {} { Note: address size, qs size, expl text size and cr size do} { not have to allow for an initial length octet, whereas} { comd size, data size, expedited size and buf size do need to} { allow for appropriate type and length octets}; %c %owninteger address size = 255; {(Maximum length of an address - TDRP} { requires it to be < 256)} %owninteger address limit = 255; {(Array bound for block for} { address)} %owninteger comd size = 255; {(Maximum TDRP command or reply will be} { maximum of:} { i/ 168} { ii/ expl text size + qs size + 2} { iii/ expl text size + cr size + 2} { iv/ address size + 3)} %owninteger comd limit = 255; {(Array bound for block for} { command or reply buffer)} %owninteger qs size = 255; {(Maximum length of QoS parameter)} %c %owninteger qs limit = 255; {(Array bound for block for Quality} { of Service parameter)} %owninteger expl text size = 255; {(Maximum length of expl. text parameter)} %c %owninteger expl text limit = 255; {(Array bound for block for explanatory} { text)} %owninteger nsidu limit = 255; {(Array bound for block for Nsidu_out} { should = round 0.5*data(size)+2)} %owninteger cr size = 255; {(Maximum length of coded reason} { parameter, in octets, in case it is} { longer than the maximum integer size)} %owninteger cr limit = 255; {(Array bound for coded reason)} %c %owninteger data size = 255; {(Maximum for an NSIDU of DATA or} { EXPEDITED, plus type & length octets)} %owninteger expedited size = 255; {(Maximum for an NSIDU of EXPEDITED,} { plus type & length octets)} %owninteger buf size = 255; {(Block size. Must accommodate largest} { NSIDU, and largest message} { CONNECT: 5 + expl text size +} { 2 * address size + qs size)} %owninteger buf limit = 255; {(Array bound for blocks} { for input and output buffers)} %c %INTEGER ch; {(Used in manipulating octets in blocks)} %INTEGER default mode connect in ; ;{(Set within Supply Initial Values-Chart 203, by the implementor)} %INTEGER octin, octout; %INTEGER type, message type; {(Type goes from 1 to 8,} { message type from 1 to 25 and 29 to 53)} %INTEGER command type, param count, %c cle count, context, %c d command, e command, %c d suspense, e suspense, %c heldin, heldout, %c abandon, invalid, poc, %c last in was data, last out was data, %c resets sent, %c reply stream, %c auto stream, ss stream, %c auto on, auto channel free, %c as oct, ss oct; %INTEGER qualifier; %INTEGER cle id, cle limit, %c as stream, as first, as last, as inc, %c ss first, ss last, ss inc, ss burst; ;{(Mode parameters 15 to 24.} { NB: Only cle limit and ss burst have more than 8 bits)} %INTEGER c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15,c16, %c c17,c18,c19,c20,c21,c22,c23,c24,c25,c26,c27,c28,c29,c30, %c c31,c32,c33,c34,c35,c36,c37,c38,c39,c40,c41,c42,c43,c44, %c c45,c46,c47,c48,c49,c50,c51,c52,c53,c54,c55,c56;{(Message counts)} {'COMMENT' Total number of %INTEGER s is 96 }; %c %INTEGERARRAY in buf, out buf (0:buf limit); %INTEGERARRAY nsidu out (0:nsidu limit); %INTEGERARRAY comd, reply (0:comd limit); %INTEGERARRAY m1,m2,m3,m4,m5,m6,m7,m8,m9,m10,m11,m12,m13,m14 %c (0:response limit); ;{(Blocks for Response parameters)} %INTEGERARRAY ocr1,ocr2,ocr3,icr (0:cr limit); ;{(Blocks for Coded Reasons)} %INTEGERARRAY oet1,oet2,oet3,oet4,iet1,iet2 0:expl(text limit); ;{(Explanatory texts)} %INTEGERARRAY adrin, oad1,oad2,oad3,oad4, iad1,iad2,iad3,iad4 %c (0:address limit); {(Addresses and Locations)} %INTEGERARRAY oqs, iqs (0:qs limit); ;{(Quality of Service)} %c {'COMMENT' The following are the look-up tables for Incoming Message} {Type, Incoming New Context, Outgoing Message Type and Outgoing} {New Context, in terms of the two arguments Context and Type}; %INTEGERARRAY inmt, incon, outmt, outcon (0:10, 1:8)= %c (19, 20, 3, 21, 22, 23, 24, 25), %c ( 1, 12, 13, 14, 15, 16, 17, 18), %c (11, 2, 4, 14, 15, 16, 17, 18), %c (11, 12, 3, 5, 6, 7, 8, 18), %c (11, 12, 3, 5, 6, 7, 8, 9), %c (11, 12, 3, 21, 22, 23, 24, 10), %c (11, 12, 3, 14, 15, 16, 17, 18), %c (11, 12, 4, 21, 22, 23, 24, 25), %c (11, 12, 13, 14, 15, 16, 17, 18), %c (11, 2, 4, 14, 15, 16, 17, 18), %c (11, 12, 13, 14, 15, 16, 17, 18), %c ( 0, 0, 8, 0, 0, 0, 0, 0), %c ( 3, 1, 1, 1, 1, 1, 1, 1), %c ( 0, 4, 1, 0, 0, 0, 0, 0), %c ( 0, 0, 10, 3, 3, 3, 3, 0), %c ( 0, 0, 8, 4, 4, 4, 4, 6), %c ( 0, 0, 8, 5, 5, 5, 5, 5), %c ( 0, 0, 8, 0, 0, 0, 0, 0), %c ( 7, 7, 1, 7, 7, 7, 7, 7), %c ( 8, 8, 8, 8, 8, 8, 8, 8), %c ( 9, 7, 1, 9, 9, 9, 9, 9), %c (10, 10, 10, 10, 10, 10, 10, 10), %c (47, 48, 31, 49, 50, 51, 52, 53), %c (29, 40, 41, 42, 43, 44, 45, 46), %c (39, 40, 31, 33, 34, 35, 36, 46), %c (39, 30, 32, 42, 43, 44, 45, 46), %c (39, 40, 31, 33, 34, 35, 36, 37), %c (39, 40, 31, 33, 34, 35, 36, 37), %c (39, 40, 31, 49, 50, 51, 52, 38), %c (39, 40, 41, 42, 43, 44, 45, 46), %c (39, 40, 32, 49, 50, 51, 52, 53), %c (39, 40, 41, 42, 43, 44, 45, 46), %c (39, 30, 32, 42, 43, 44, 45, 46), %c ( 0, 0, 7, 0, 0, 0, 0, 0), %c ( 2, 1, 1, 1, 1, 1, 1, 1), %c ( 0, 0, 9, 2, 2, 2, 2, 0), %c ( 0, 4, 1, 0, 0, 0, 0, 0), %c ( 0, 0, 7, 4, 4, 4, 4, 5), %c ( 0, 0, 7, 5, 5, 5, 5, 5), %c ( 0, 0, 7, 6, 6, 6, 6, 4), %c ( 7, 7, 7, 7, 7, 7, 7, 7), %c ( 8, 8, 1, 8, 8, 8, 8, 8), %c ( 9, 9, 9, 9, 9, 9, 9, 9), %c (10, 8, 1, 10, 10, 10, 10, 10); ) %c {'COMMENT' end of common declarations }; %c 'SEGMENT' c1 %c %c {'COMMENT' Octet handling and Blocks.} { The routines initblock, getch, putch, the global ch and the macros} { getpntr and putpntr provide a mechanism for serially appending a} { sequence of octets into a Coral 66 array and reading them out} { again. This is called a "block".} {} { If b names the array, and it is to hold at most n octets, then} { initblock( b, n ) prepares the array b to act in this way as a} { block. It establishes the size of the block in the zeroth element} { of the array, and initializes to zero (in elements 1 and 2) two} { pointers used to keep track of the reading and writing. The get} { pointer indicates the next octet to be read out of the block, and} { put pointer indicates the next free space after the last octet} { inserted.} {} { It is helpful to remember that normally the value of the put} { pointer is the number of octets in the block, while the value of} { the get pointer is the number of octets that have been read from} { it.} {} { A call of the function putch(b) stores a copy of the octet held in} { ch into the block and adds one to the put pointer. As a function it} { normally returns the value true (=1), but if the block is full the} { value false (=0) is returned and no storing occurs.} {} { A call of getch(b) normally copies to ch the octet pointed to by} { the get pointer of b, adds 1 to get pointer, and returns the value} { true. If however the get pointer is equal to or greater than the} { put pointer (meaning all characters have been read), the value} { false is returned instead.} {} { To start another read out, the get pointer can be reset by the} { assignment b(getpntr)= 0.} {} { The general strategy is to initialise all blocks once, at the start} { of the program, to reset the put pointer just before filling a} { block, and to reset the get pointer just after each read out from} { it, unless it will only be read once (the common case) }; %c %INTEGERFN block (%INTEGER string loc); {'COMMENT' The actual parameter must be the location of (i.e. the} { value of) a string (and may therefore actually be a string)} { of the form "TEXT=...." where the dots represent zero or} { more characters.} { The string is converted into a block containing these} { characters (or is unaltered if it is already a block),} { and the answer is string loc.} { It is assumed that strings are stored two octets per word and} { start with a length octet (zero for a null string).} { The length octet and the five characters TEXT= are overwritten} { by the blocksize, getpntr and putpntr}; %INTEGER octet1; octet1 =BITS(8,8) string(loc); %IF octet1 > 0 %THEN %c string(loc)= octet1 - 5; {(If we already have a block, then} { octet1 is 0, otherwise reduce} { blocksize by 5 for TEXT=)} string loc +(1)= 0; {(getpntr)} string loc +(2)= (string loc); {(putpntr = blocksize)} %RESULT = string loc %c ;%end;; %c %c %ROUTINE initblock (%INTEGERARRAY a, %INTEGER l); {'COMMENT' Initialises the block a so that it can hold l characters.} {Assumes that the index of the array a can vary from 0 to lim,} {so that l = 2(lim-2) characters can be held}; a(blocksize)= l; a(getpntr)= 0; a(putpntr)=0 %c ;%end;; %c %INTEGERFN putch (%INTEGERARRAYname b); {'COMMENT' Appends to block b the character given in ch}; %INTEGER p; p =(b putpntr); %IF p >= b(blocksize)%THEN %RESULT = false %c %else %start; %IF p & 1 = 0 %c %THEN BITS(8,8)b (BITS(15,1)integer(p+6)) = ch %c %else BITS(8,0)b (BITS(15,1)integer(p+6)) = ch; %c b(putpntr)= p+1; %RESULT = true %c ; %FINISH %c ;%end;; %c %INTEGERFN getch (%INTEGERARRAYname b); {'COMMENT' Fetches to ch the character given by b(getpntr), and} {increments the getpntr}; %INTEGER g; g =(b getpntr); %IF g >= b(putpntr)%THEN %RESULT = false %c %else %start; ch = %IF g & 1 = 0 %c %THEN BITS(8,8)b (BITS(15,1)integer(g+6)) %c %else BITS(8,0)b (BITS(15,1)integer(g+6)); b(getpntr)= g+1; %RESULT = true %c ; %FINISH %c ;%end;; %c %c %ROUTINE copy (%INTEGERARRAYname a,b); {'COMMENT' Appends block a to block b (losing excess characters if} {b is too small). Restores getpntr of a to its value on entry}; %INTEGER dummy, g; g =(a getpntr); a(getpntr)= 0; 'FOR' dummy = 0 'WHILE' getch(a) = true 'DO' putch(b); a(getpntr)= g %c ;%end;; %c %c %ROUTINE copy text (%INTEGER a, %INTEGERARRAYname b); {'COMMENT' Assumes a is the value delivered by a call of block,} {i.e. is the location of a block. Appends this block to block b} {;{(losing excess characters if b is too small)};} { %INTEGER dummy, g;} { %INTEGERFN get(%INTEGER a,} { %integername g);} { {'COMMENT' Fetches to ch the character of the block located by a}} {{ whose getpntr value is g, and increments g};} { %IF g>= (a+putpntr)%THEN %RESULT = false} { %else %start;} { ch = %IF g & 1 = 0} { %THEN BITS (8,8)(a+BITS(15,1)integer(g+6))} %else BITS (8,0)(a+BITS(15,1)integer(g+6)); g = g+1; %RESULT = true %c ; %FINISH %c ;%end;; g = 0; 'FOR' dummy = 0 'WHILE' get(a,g)=true 'DO' putch(b) %c ;%end;; %c %ROUTINE store param (%INTEGERARRAYname a,b); {'COMMENT' Assumes the getpntr of a accesses the length octet of} {a parameter. Replaces the contents of the block b by this} {parameter, leaving the getpoiner of a past it. If b is too small} {the excess is wasted}; %INTEGER count; b(putpntr)= 0; b(getpntr)= 0; getch(a); count = ch; {(Length octet)} 'FOR' count = count-1 'WHILE' count >= 0 'DO' %c 'BEGIN' %c getch(a); putch(b) %c ;%end;; ;%end;; %c %c %ROUTINE fetch param (%INTEGERARRAYname a,b); {'COMMENT' Appends to block b, firstly the putpntr of block a} {;{(which will be the length octet), then the contents of a. The}} {{getpntr of a must initially be zero (and will be left zero)};} { ch =(a putpntr); putch(b); (Length octet)} copy(a,b) %c ;%end;; %c %c %ROUTINE send connect (%INTEGERARRAYname called address); {'COMMENT' Sends a CONNECT primitive with the given called address and} {other parameters according to stored values }; out buf(putpntr)= 0; ch = connect; putch(out buf); {(Type octet)} fetch param(called address, out buf); fetch param(oad2, out buf); fetch param(oqs, out buf); fetch param(oet4, out buf); send and count ns message(connect, none) ; {(29)} ;%end;; %c %ROUTINE initialise control variables; {'COMMENT' Chart 1. Also initialises all blocks, constants are defined} { in the common block above }; heldin = none; heldout = none; ;{(Buffers empty)} context = 1; {(No establshed connection)} cle count = 0; {(Empty queue of Count Limit Events)} d command = false; {(No command yet on DATA stream)} e command = false; {(No command yet on EXPEDITED stream)} last in was data = false; last out was data = false; poc = false; invalid = false; resets sent = 0; initblock(in buf, buf size); initblock(out buf, buf size); initblock(nsidu out, data size); initblock(comd, comd size); initblock(reply, comd size); initblock(m1, response limit); {(Allows Response parameters of up to} { 'response limit' primitive actions)} initblock(m2, response size); initblock(m3, response size); initblock(m4, response size); initblock(m5, response size); initblock(m6, response size); initblock(m7, response size); initblock(m8, response size); initblock(m9, response size); initblock(m10, response size); initblock(m11, response size); initblock(m12, response size); initblock(m13, response size); initblock(m14, response size); initblock(ocr1, cr size); {(Protocol encoding permits indefinite)} initblock(ocr2, cr size); {(length coded reasons)} initblock(ocr3, cr size); initblock(icr, cr size) ; initblock(oet1, expl text size); initblock(oet2, expl text size); initblock(oet3, expl text size); initblock(oet4, expl text size); initblock(iet1, expl text size); initblock(iet2, expl text size); initblock(adrin,address size); initblock(oad1, address size); initblock(oad2, address size); initblock(oad3, address size); initblock(oad4, address size); initblock(iad1, address size); initblock(iad2, address size); initblock(iad3, address size); initblock(iad4, address size); initblock(oqs, qs size); initblock(iqs, qs size) %c ;%end;; %c %ROUTINE set default mode; {'COMMENT' Chart 2}; %INTEGER n; 'FOR' n = 0 'STEP' 1 'UNTIL' 55 'DO' %c 'LOCATION'(c1) +(n)= 0; {(Clear message counts)} ch = 64; putch(ocr1); ;{(Outgoing Coded Reason for normal use with} { RESET or DISCONNECT, local use)} ch = 255; putch(ocr2); ;{(Ditto after an invalid command)} ch = 254; putch(ocr3); ;{(Ditto after a Primitive Out of Context)} copytext(block("TEXT=INVALID COMMAND"), oet2); ;{(Outgoing Explanatory Text after an invalid command)} copytext(block("TEXT=PRIMITIVE OUT OF CONTEXT"), oet3); ;{(Ditto after POC)} copytext(block("TEXT=TEST RESPONDER VERSION 1.1"), oet4); ;{(For use with CONNECT or ACCEPT)} %c supply initial values(oad1, oad2, default mode connect in); {(203)} ;{(Outgoing Called Address for use with CONNECT,} { Outgoing Calling Address for use with CONNECT and} { Default mode connect in = true or false.} { Implementation dependent)} %c copy(oad2, oad3); ;{(Outgoing recall address set to outgoing calling address)} %c {'COMMENT' The explanatory texts oet1,iet1,iet2, the addresses} { iad1,iad2,iad3,iad4 and oad4, the Quality of Service values in} { oqs,iqs, and the Coded Reason in icr are now null, since these blocks} { are empty}; %c cle id = 0; cle limit = 0; {(No Count Limit)} as stream = 0; as first = 0; as last = 0; as inc = 0; ss first = 0; ss last = 0; ss inc = 0; ss burst = 0; ;{(No data sources)} ch = 1; {(Primitive Action: do nothing)} putch(m2); putch(m5); putch(m6); putch(m7); putch(m8); putch(m10); putch(m11); putch(m12); {(Response parameters: do nothing,} { m2 or m11 will be overwritten below)} %c ch = 6; putch(m3); ch = 20; putch(m3); ;{(Response to Initial DISCONNECT:} { Final DISCONNECT and End Test Session)} ch = 20; putch(m4); ;{(Response to Final DISCONNECT: End Test Session)} ch = 6; putch(m9); putch(m13); putch(m14); ;{(Responses to Initial RESET, Invalid Command or} { Primitive Out of Context:} { Initial DISCONNECT)} %c %IF default mode connect in = true %THEN %START; %c %c ch = 5; putch(m1); {(Response to CONNECT: ACCEPT)} ch = 6; putch(m2); {(Response to ACCEPT: Initial DISCONNECT)} ; %FINISH %c %else %start; ch = 2; putch(m11); {(Response to start: CONNECT)} ch = 6; putch(m1); ch = 20; putch(m1); ;{(Response to CONNECT: Final DISCONNECT, End Test Session)} ; %FINISH %c ;%end;; %c %INTEGERFN read command octet; {'COMMENT' Chart 3}; %INTEGERFN process primitive gives command octet; { to find TDRP commands.It incorporates charts 15 & 16 }; %c %IF count and respond to primitive message = true %THEN %START; %c ; {(14. Normal DATA or EXPEDITED message,} { not yet responded to)} %IF type = data %THEN %START; %c ; {(DATA message, dealt with by chart 15)} {'COMMENT' The following 'write' statements can be used to} { display the received data octet values if required} { trwritestring} { ;{("TR - process primitive gives command octet - (Data) octin =")}} {{ trwriteint(octin, 6)}} {{ trwriteout end of commented out 'writes'};} { %IF d command = true %THEN %START; } { ; (Command octet)} respond to cles; {(11)} %RESULT = true %c ; %FINISH ; %IF d suspense = true %THEN %START; %c %c d suspense = false; {(ordinary data)} respond to incoming message; {(24)} ; %FINISH %c %else %c %IF octin = h %THEN %START; %c ; {(D herald)} %IF e command = true %THEN %START; %c respond to invalid command event; {(8) ; %FINISH } { %else } { d command = true} { ;%end;} { %else } { %IF octin = w %THEN } { d suspense = true} { %else %start;} { ; %FINISH } { %else %start;} { {'COMMENT' The following 'write' statements can be used to}} {{ display the received expedited octet if required}} {{ trwritestring}} {{ ;("TR - process primitive gives command octet - (Exp.) octin =")}} {{ trwriteint(octin, 6)}} {{ trwriteout end of commented out 'writes'};} { %IF e command = true %THEN %START; } { ; (Command octet)} respond to cles; %RESULT = true %c ; %FINISH ; %c %IF e suspense = true %THEN %START; %c %c e suspense = false; {(ordinary expedited)} 'BEGIN' respond to incoming message; {(24) ; %FINISH } { ;%end;} { %else } { %IF octin = h %THEN %START; } { ; (E herald)} %IF d command = true %THEN %START; %c respond to invalid command event; {(8) ; %FINISH } { %else } { e command = true} { ;%end;} { %else } { %IF octin = w %THEN } { e suspense = true} { %else %start;} { respond to incoming message; (24 ordinary expedited)} ; %FINISH %c ;%end;; {(EXPEDITED)} ;%end;; {(Use of Octin)} %RESULT = false %c ;%end; process primitive gives command octet; %c %INTEGER dummy; %c d suspense = false; e suspense = false; abandon = false; %c 'FOR' dummy = 0 'WHILE' 0=0 'DO' %c 'BEGIN'; {(Loop repeated indefinitely)} %IF abandon = true %THEN %RESULT = false; %c %IF test input(type, not allowed to wait) = false %THEN %START; %c ; %IF drive automatic source = false %THEN %START; %c %c test input(type, allowed to wait) ; {(12)} %IF process primitive gives command octet = true %THEN %c %RESULT = true %c ; %FINISH ; {'COMMENT' Else Source was driven so respond to cles and loop}; ;%end; %c %else %start; %IF process primitive gives command octet = true %THEN %c %RESULT = true %c ; %FINISH ; {'COMMENT' initblock(in buf, buf size) is unnecessary because} { test input overwrites whatever is in 'in buf'}; respond to cles %c ;%end;; {(Loop)} ;%end;; {(Read command octet)} %c %ROUTINE respond to change mode event; {'COMMENT' Chart 4}; auto on = false; {(Initialise Sources- chart 9)} %c %IF as stream <> 0 %THEN %START; %c %c as oct = aslast ; {( asoct is set so that it becomes asfirst} { instead of being incremented before it is sent )} ss oct = sslast ; ;{(Ditto for ss oct)} %c %IF as stream = 1 %THEN %START; %c %c auto stream = data; ss stream = expedited; ; %FINISH %c %else %start; auto stream = expedited; ss stream = data; ; %FINISH ; ;%end;; %c do actions(m11); {(10)} respond to cles; {(11)} ;%end;; %c %INTEGERFN param count checks with command type; {'COMMENT' Chart 5}; %INTEGERARRAYname params for command (1:19)= 24, 0, 2, 2, 1, 1, 1, %c 1, 0, 0, 1, 1, 1, 1, %c 2, 2, 2, 2, 0; %c %IF param count = params for command command(type) %c %THEN %RESULT = true %c %else %RESULT = false; ;%end;; %c %INTEGERFN read parameter; {'COMMENT' Chart 6}; %INTEGER count; %IF read command octet = false %THEN %c %RESULT = false; {(Command abandoned)} %c %IF no of octets checks with command type and param count %c = false %THEN %START; %c %c respond to invalid command event; %RESULT = false %c ; %FINISH ; %c count = octin; {(Number of octets in parameter)} ch = count; putch(comd); {(Store length octet)} %c 'FOR' count = count - 1 'WHILE' count >= 0 'DO' %c 'BEGIN' %c %IF read command octet = false %THEN %c %RESULT = false; {(Command abandoned)} ch = octin; putch(comd); {(Store octet)} ;%end;; %RESULT = true %c ;%end;; %c %ROUTINE respond to command; {'COMMENT' Chart 7}; %INTEGER count; {'COMMENT' Note: not addr is a constant = false, and addr = true.} {} { The following five procedures are declared here because} { they are not used elsewhere}; %c %ROUTINE store one (%integername x); {'COMMENT' Checks parameter length 1 in block comd, then copies to x}; getch(comd); %IF ch <> 1 %THEN -> parameter error; {(Wrong length)} getch(comd); x = ch %c ;%end;; %c %ROUTINE store two (%integername x); {'COMMENT' Checks parameter length 2 in block comd, then copies to x}; %INTEGER first; getch(comd); %IF ch <> 2 %THEN -> parameter error; {(Wrong length)} getch(comd); first = ch; getch(comd); x = 256*first + ch %c ;%end;; %c %ROUTINE fetch one (%INTEGER x); {'COMMENT' Appends x to block reply, preceded by length octet 1}; ch = 1; putch(reply); ch = x; putch(reply) %c ;%end;; %c %ROUTINE fetch two (%INTEGER x); {'COMMENT' Appends top and bottom octets of x to block reply,} { preceded by length octet 2}; ch = 2; putch(reply); ch =BITS(8,8)x; putch(reply); ch =BITS(8,0)x; putch(reply) %c ;%end;; %c %ROUTINE send addr( %INTEGERARRAYname a, %c %INTEGER qual, comtyp, repeat mode); {'COMMENT' Puts into reply an array parameter from block 'a' and a} { qualifier parameter of value qual, and sends reply with reply} { type comtyp. Repeat mode is set to addr (= true) if the address} { is to be repeated in an ADDRESS primitive, otherwise it is set to} { not addr (= false)}; fetch param(a, reply); ch = 1; putch(reply); {(Length octet for qualifier)} ch = qual; putch(reply); {(Qualifier)} send reply(repeat mode, comtyp, 2); {(30)} ;%end;; %c {'COMMENT' Here begin the statements of Respond_to_command}; %c %IF command type = 1 %THEN %START; %c ; {(Change Mode)} %IF mode parameters check = false %THEN %START; %c %c -> parameter error; {(To respond to invalid command event)} ; %FINISH %c %else %start; store param(comd, m1); {(Response parameters)} store param(comd, m2); store param(comd, m3); store param(comd, m4); store param(comd, m5); store param(comd, m6); store param(comd, m7); store param(comd, m8); store param(comd, m9); store param(comd, m10); store param(comd, m11); store param(comd, m12); store param(comd, m13); store param(comd, m14); store one(cle id); {(mode param 15)} store two(cle limit); {( " " 16)} store one(as stream); {( " " 17)} store one(as first); {( " " 18)} store one(as last); {( " " 19)} store one(as inc); {( " " 20)} store one(ss first); {( " " 21)} store one(ss last); {( " " 22)} store one(ss inc); {( " " 23)} store two(ss burst); {( " " 24)} %IF auto on = true %THEN %START; %c %c act 13; {(Stop automatic source)} respond to cles; {(11)} ; %FINISH ; respond to change mode event; {(4)} ;%end; %c ;%end; %c %else %c %IF command type = 10 %THEN %START; %c act 15; {(Generate a parallel Test Responder,} { with CONNECT out default mode)} ; %FINISH %c %else %c %IF command type = 2 %THEN %START; %c %c 'FOR' count = 0 'STEP' 1 'UNTIL' 55 'DO' %c 'LOCATION'(c1) +(count)= 0; {(Reset message counts)} ; %FINISH %c %else %c %c %IF command type = 9 %THEN %START; %c %c act 12; {(Start Automatic Source)} respond to cles; {(11)} ; %FINISH %c %else %c %IF command type = 19 %THEN %START; %c %c act 13; {(Stop Automatic Source)} respond to cles; {(11)} ; %FINISH %c %else %c %IF command type = 3 %THEN %START; %c ; {(Set Outgoing Coded Reason and Explanatory Text)} store param(comd, ocr1); {(Coded Reason)} store param(comd, oet1); {(Explanatory Text)} ; %FINISH %c %else %c %IF command type = 4 %THEN %START; %c ; {(Set Outgoing Quality of Service and Explanatory Text)} store param(comd, oqs); {(Quality of Service)} store param(comd, oet4); {(Explanatory Text)} ; %FINISH %c %else %c %IF command type = 5 %THEN %START; %c ; {(Set Outgoing Called Address, for use with CONNECT)} store param(comd, oad1) %c ; %FINISH %c %else %c %IF command type = 6 %THEN %START; %c ; {(Set Outgoing Calling Address, for use with CONNECT)} store param(comd, oad2) %c ; %FINISH %c %else %c %IF command type = 7 %THEN %START; %c ; {(Set Outgoing Recall Address, for use with ACCEPT)} store param(comd, oad3) %c ; %FINISH %c %else %c %IF command type = 8 %THEN %START; %c ; {(Set Outgoing Location, for use with RESET and DISCONNECT)} store param(comd, oad4) %c ; %FINISH %c %else %start; reply(putpntr)= 0; {(Prepare to form Reply)} %c getch(comd); count = ch; {(Length octet)} getch(comd); %c %IF count = 1 %AND ch = 1 %THEN %c reply stream = data %c %else %c %IF count = 1 %AND ch = 2 %THEN %c reply stream = expedited %c %else %c -> parameter error; {(Reply stream error)} %c %IF command type = 11 %THEN %START; %c ; {(Give Mode Parameters:} { Copy parameters, from m1 to ss_burst, into reply)} %c fetch param(m1, reply); {(response parameters)} fetch param(m2, reply); fetch param(m3, reply); fetch param(m4, reply); fetch param(m5, reply); fetch param(m6, reply); fetch param(m7, reply); fetch param(m8, reply); fetch param(m9, reply); fetch param(m10, reply); fetch param(m11, reply); fetch param(m12, reply); fetch param(m13, reply); fetch param(m14, reply); fetch one(cle id); fetch two(cle limit); fetch one(as stream); fetch one(as first); fetch one(as last); fetch one(as inc); fetch one(ss first); fetch one(ss last); fetch one(ss inc); fetch two(ss burst); send reply(not addr, 11, 24); {(30)} ; %FINISH %c %else %c %IF command type = 12 %THEN %START; %c ; {(Give Message Counts)} 'FOR' count = 0 'STEP' 1 'UNTIL' 55 'DO' %c fetch two( 'LOCATION'(c1) +(count)) ; %c send reply(not addr, 12, 56); {(30)} ; %FINISH %c %else %c %IF command type = 13 %THEN %START; %c ; {(Give Incoming Coded Reason and Explanatory Text)} fetch param(icr, reply); fetch param(iet1, reply); send reply(not addr, 13, 2) %c ; %FINISH %c %else %c %IF command type = 14 %THEN %START; %c ; {(Give Quality of Service and Explanatory Text)} fetch param(iqs, reply); fetch param(iet2, reply); send reply(not addr, 14, 2) %c ; %FINISH %c %else %c %c 'BEGIN' %c %INTEGER ifrepeat; {(Command type = 15 to 18, give specified} { address, repeat as ADDRESS if second param = 1)} getch(comd); count = ch; {(Length octet of second parameter)} getch(comd); %c %IF count = 1 %AND ch = 0 %THEN %c ifrepeat = not addr %c %else %c %IF count = 1 %AND ch = 1 %THEN %c ifrepeat = addr %c %else %c -> parameter error; {(Invalid parameter length or value)} %c %IF command type = 15 %THEN %START; %c ; {(Give Called Address)} send addr(iad1, 1, 15, ifrepeat); ; %FINISH %c %else %c %IF command type = 16 %THEN %START; %c ; {(Give Calling Address)} send addr(iad2, 0, 16, ifrepeat); ; %FINISH %c %else %c %IF command type = 17 %THEN %START; %c ; {(Give Recall Address)} send addr(iad3, 0, 17, ifrepeat); ; %FINISH %c %else %start; send addr(iad4, 0, 18, ifrepeat) %c ; %FINISH %c ;%end;; %c respond to cles; {(11)} ;%end;; %c -> return; {(Skip round error section)} %c parameter error: %c respond to invalid command event; {(8)} return: %c ;%end;; {(Respond to command)} %c %ROUTINE respond to invalid command event; {'COMMENT' Chart 8}; invalid = true; do actions(m13); {(10)} invalid = false; respond to cles; {(11)} ;%end;; %c {'COMMENT' Chart 9 - has been absorbed in 4}; %c %ROUTINE do actions (%INTEGERARRAYname m); {'COMMENT' Chart 10}; %INTEGER dummy; %ROUTINE do act (%INTEGER i); %IF i = 2 %THEN act 2 %else %c %IF i = 3 %then act 3 %else %c %IF i = 4 %THEN act 4 %else %c %IF i = 5 %then act 5 %else %c %IF i = 6 %THEN act 6 %else %c %IF i = 7 %then act 7 %else %c %IF i = 8 %THEN act 8 %else %c %IF i = 9 %then act 9 %else %c %IF i = 10 %THEN act 10 %else %c %IF i = 11 %then act 11 %else %c %IF i = 12 %THEN act 12 %else %c %IF i = 13 %then act 13 %else %c %IF i = 14 %THEN act 14 %else %c %IF i = 15 %then act 15 %else %c %IF i = 16 %THEN act 16 %else %c %IF i = 17 %then act 17 %else %c %IF i = 18 %THEN act 18 %else %c %IF i = 19 %then act 19 %else %c %IF i = 20 %THEN act 20; ;{(i = 1 means do nothing)} %c m(getpntr)= 0; {(Prepare to read from block)} 'FOR' dummy = 0 'WHILE' getch(m) = true 'DO' do act(ch) %c ;%end;; %c %ROUTINE respond to cles; {'COMMENT' Chart 11}; %INTEGER dummy; 'FOR' dummy = 0 'WHILE' cle count > 0 'DO' %c 'BEGIN' %c cle count = cle count - 1 ; do actions (m12); {(Respond to Count Limit Event - 20)} ;%end; %c ;%end;; %c %INTEGERFN test input (%integername type, %c %INTEGER wait); {'COMMENT' Chart 12. This sets octin if data results from the call. The} {parameter type is only affected when the answer is true and a new} {message or NSIDU has arrived. The message appears in in buf, whose} {getpntr is left past the type octet (or in the case of an NSIDU, past} {the length octet). If wait is true then the routine wait for NS input} {is called (rather than input NS) to obtain an NS message.} {Heldin is a control variable denoting the state of the input data} {buffer (in buf): either none when no data is held, or DATA or} {EXPEDITED when the last input message was an NSIDU of data. Heldin} {must initially be set to none }; %ROUTINE pass parameter; getch(in buf); {(Length octet)} in buf(getpntr)= in(buf getpntr)+ ch; ;{(Pass the parameter and its length octet)} ;%end;; %IF heldin = none %THEN %START; %c %c %IF wait <> true %THEN %START; %c %c %IF input ns(in buf) = false %THEN %RESULT = false ; {(200)} ; %FINISH %c %else %c wait for ns input(in buf) ; {(201)} {'COMMENT' The block in buf has now been filled from input}; in buf(putpntr)= buf size; ;{(So that getch can be used, but not beyond the block)} in buf(getpntr)= 0; getch(in buf); {(Type octet. First 3 bits to be used)} type = 1 +(BITS 3,0)integer(ch-1); {(From 1 to 8)} %c {'COMMENT' The following write statements can be used to display} { the type of each service primitive received }; trwritestring("TR - test input - type = "); %IF type = 1 %THEN trwritestring("Connect"); %IF type = 2 %then trwritestring("Accept"); %IF type = 3 %THEN trwritestring("Disconnect"); %IF type = 4 %then trwritestring("Data"); %IF type = 5 %THEN trwritestring("Address"); %IF type = 6 %then trwritestring("Push"); %IF type = 7 %THEN trwritestring("Expedited"); %IF type = 8 %then trwritestring("Reset"); trwriteout; %IF type = push %THEN -> set block; pass parameter; {(1st)} %IF type = data %or type = expedited %THEN -> set block; pass parameter; {(2nd)} %IF type = address %THEN -> set block; pass parameter; {(3rd)} %IF type = accept %or type = disconnect %or type = reset %c %THEN -> set block; pass parameter; {(4th: Type = Connect)} %c set block: %c in buf(putpntr)= in(buf getpntr); {(Total of octets in block)} in buf(getpntr)= 1; {(Past the type octet)} %c %IF type <> data %AND type <> expedited %THEN %RESULT = true %c %else %start; heldin = type; getch(in buf); {(Pass the length octet)} ; %FINISH %c ;%end;; {(Now heldin = Data or Expedited)} %c getch(in buf); {(Remove one octet from NSIDU)} octin = ch; ;{(Now heldin and octin together represent a NS primitive data} { message, and the block in buf holds the rest of the NSIDU)} %IF in buf(getpntr)= in buf(putpntr) %c %THEN heldin = none; {(NSIDU exhausted)} %RESULT = true %c ;%end;; %c %INTEGERFN drive automatic source; {'COMMENT' Chart 13}; %IF auto on = true %AND auto channel free = true %THEN %START; %c %c %IF as oct = as last %c %THEN %c as oct = as first %c %else %c as oct =BITS(8,0)integer(as oct + as inc); {(Modulo 256)} %c octout = as oct; send octet(auto stream, warn); {(21} { auto stream is DATA when} { as stream = 1, or EXPEDITED when} { as stream = 2. warn is a constant} { of value true indicating that} { warning characters are needed} { before h or w.)} %RESULT = true %c ; %FINISH %c %else %c %RESULT = false; %c %INTEGERFN %c count and respond to primitive message; {'COMMENT' Chart 14. Also adjusts context, sets message type, it} { counts Normal DATA and EXPEDITED messages but does not respond to} { them, instead it returns true. For all other messages it returns} { false }; %INTEGER loc, count; message type = inmt(context, type); context = incon(context, type); {(NB Table look-up gives new} { context 5 for RESET in context 5,} { and gives ADDRESS Normal in} { contexts 3 & 4 - in some cases} { this is not true context or} { message type)} %c %IF message type = 4 %THEN resets sent = 0; ;{(Normal Final DISCONNECT)} %c %IF context = 5 %AND message type = 10 %THEN %START; %c ; {(Matching RESET)} resets sent = resets sent - 1; %IF resets sent = 0 %THEN %c context = 4; {(Corrects for final matching RESET)} ; %FINISH ; %c %IF last in was data = true %THEN %START; %c %c %IF message type = 6 %THEN %START; %c %c message type = 15; {(Corrects for ADDRESS following DATA)} context = 0; {(Context corrected to $*)} ; %FINISH ; %c %IF message type <> 5 %AND message type <> 8 %THEN %c last in was data = false; ;{(5 is Normal DATA, 8 Normal EXPEDITED)} ;%end; %c %else %c %IF message type = 5 %THEN %c last in was data = true; %c loc = message type + 'LOCATION'(c1) - 1; count =( loc)+ 1; (loc)= count; {(Increment message count)} ;{(tests for contexts in which data would be POC)} %IF context = 1 %or context = 3 %or context = 7 %or context = 9 %c %or context = 10 %THEN %c auto channel free = false %c %else auto channel free = true; %c %IF message type <= 10 %THEN %START; %c ; {(Normal primitive)} c26 = c26 + 1; process cle count(message type); {(22)} %c %IF type <> data %AND type <> expedited %THEN %START; %c %c respond to incoming message; {(24)} %RESULT = false %c ; %FINISH %c %else %c %RESULT = true %c ;%end; %c %else %IF message type <= 18 %THEN %START; %c ; {(Primitive Out of Context)} c27 = c27 + 1; process cle count(message type); {(22)} respond to poc event; {(23)} %RESULT = false %c ; %FINISH ; ;{(Now message type > 18 : Superfluous primitive)} c28 = c28 + 1; process cle count(message type); {(22)} %RESULT = false %c ;%end;; %c {'COMMENT' Charts 15 and 16 have been incorporated into 3 }; %c %INTEGERFN %c no of octets checks with command type and param count; 'BEGIN'; {'COMMENT' Chart 17}; {'COMMENT' octin holds the length of the current parameter}; %c %IF command type > 8 %THEN %c %RESULT = %IF octin = 1 %then true %else false; %c %IF command type > 4 %THEN %c %RESULT = %IF octin > address size %then false %else true; %c %IF command type > 2 %THEN %START; %c %c %IF param count = 1 %c %THEN 'BEGIN' %c %IF command type = 3 %c %THEN %RESULT = %IF octin = cr size %then true %else false %c %else %RESULT = %IF octin > qs size %then false %c %else true %c ; %FINISH %c %else %c %RESULT = %IF octin > expl text size %THEN false %c %else true %c ;%end;; %RESULT = true; {(Reset message counts has no parameters and} { Change mode is checked via Chart 18)} ;%end;; %c %INTEGERFN mode parameters check; {'COMMENT' Chart 18. Restores block comd for reading again}; %IF response parameters check = true %c %AND cle parameters check = true %c %AND source parameters check = true %c %THEN %RESULT = true %c %else %RESULT = false; {(25, 26 and 27)} {'COMMENT' It is important that cle parameters check is not invoked} {when response parameters check gives the answer false, and similarly} {for the third component of the test. (As defined for Coral 66).} {This is because each leaves the getpntr of comd ready for the next}; %c {'COMMENT' Chart 19 - has been absorbed in 30 & 108}; {'COMMENT' Chart 20 - has been absorbed in 11}; %c %ROUTINE send octet (%INTEGER stream, warning); {'COMMENT' Chart 21}; %IF warning <> true %or octout <> h %AND octout <> w %THEN %START; %c %c {'COMMENT' Dummy statement.} { 'CORAL' 66 requires %AND to bind tighter than %or }; ; %FINISH %c %else %start; send and count ns message(stream, w); {(Send 'w')} ; %FINISH ; send and count ns message(stream, octout); {(29)} ;%end;; %c %c %ROUTINE process cle count (%INTEGER mt); {'COMMENT' Chart 22}; %INTEGER loc; loc = mt + 'LOCATION'(c1) - 1; %IF mt = cle id %AND (loc)= cle limit %THEN %START; %c ; {(Count limit reached)} (loc)= 0; cle count = cle count + 1 %c ; %FINISH %c ;%end;; %c %ROUTINE respond to poc event; {'COMMENT' Chart 23}; poc = true; do actions(m14); {(10)} poc = false %c ;%end;; %c %ROUTINE respond to incoming message; {'COMMENT' Chart 24}; %IF type = connect %THEN %START; %c %c store param(in buf, iad1); {(Called Address)} store param(in buf, iad2); {(Calling Address)} store param(in buf, iqs); {(Quality of Service)} store param(in buf, iet2); {(Explanatory Text)} do actions(m1) %c ; %FINISH %c %else %IF type = accept %THEN %START; %c %c store param(in buf, iad3); {(Recall Address)} store param(in buf, iqs); {(Quality of Service)} store param(in buf, iet2); {(Explanatory Text)} do actions(m2); {(10)} ; %FINISH %c %else %IF type = disconnect %THEN %START; %c %c store param(in buf, icr); {(Coded Reason)} store param(in buf, iad4); {(Location)} store param(in buf, iet1); {(Explanatory Text)} %IF message type = 4 %THEN %START; %c ; {(Final DISCONNECT)} do actions(m4); {(10)} abandon command; {(32)} ; %FINISH %c %else %c do actions(m3); {(Initial DISCONNECT)} ;%end; %c %else %IF type = data %THEN %c do actions(m5) %c %else %IF type = address %THEN %START; %c %c store param(in buf, adrin); {(Address part)} getch(in buf); {(Pass the length octet of qualifier)} getch(in buf); qualifier = ch; do actions(m6) %c ; %FINISH %c %else %IF type = push %THEN %c do actions(m7) %c %else %IF type = expedited %THEN %c do actions(m8) %c %else %start; store param(in buf, icr); {(Coded Reason)} store param(in buf, iad4); {(Location)} store param(in buf, iet1); {(Explanatory Text)} %IF message type = 10 %THEN %START; %c ; {(Matching RESET)} do actions(m10); abandon command %c ; %FINISH %c %else %c do actions(m9); {(Initial RESET)} ;%end;; %c %c %INTEGERFN response parameters check; {'COMMENT' Chart 25. (Parameters 1 to 14)}; %INTEGER count, n; 'FOR' count = 1 'STEP' 1 'UNTIL' 14 'DO' %c getch(comd); n = ch; {(Length of response parameter)} %IF n<1 %or n>response size %THEN %RESULT = false; ;{(Response wrong length)} 'FOR' n = n-1 'WHILE' n>=0 'DO' %c 'BEGIN' %c getch(comd); %IF ch = 0 %or ch > 20 %THEN %RESULT = false; ;%end;; {(Erroneous primitive action)} ;%end;; %RESULT = true %c ;%end;; %c %c %INTEGERFN cle parameters check; {'COMMENT' Chart 26. (Parameters 15 and 16)}; getch(comd); {(Get the length octet)} %IF ch <> 1 %THEN %RESULT = false; {(Parameter 15 not a single octet)} getch(comd); {(Cle_id)} %IF ch > 56 %THEN %RESULT = false; {(Count limit identifier wrong)} getch(comd); {(Length octet);} { %IF ch <> 2 %THEN %RESULT = false;} { ;(Parameter 16, Count Limit, not 16 bits)} %RESULT = true %c ;%end;; %c %c %INTEGERFN source parameters check; {'COMMENT' Chart 27. (Parameters 17 to 24)}; %INTEGER count; getch(comd); getch(comd); getch(comd); ;{(Pass by Cle_limit to length octet of As_stream)} %IF ch <> 1 %THEN %RESULT = false; {(Parameter 17 not single octet)} getch(comd); {(As_stream)} %IF ch <> 0 %AND ch <> 1 %AND ch <> 2 %c %THEN %RESULT = false; {(As_stream number wrong)} 'FOR' count = 18 'STEP' 1 'UNTIL' 23 'DO' %c 'BEGIN' %c getch(comd); {(Length octet)} %IF ch <> 1 %THEN %RESULT = false; ;{(Parameter value not a single octet)} getch(comd); {(Pass over parameter)} ;%end;; getch(comd); %IF ch <> 2 %THEN %RESULT = false; ;{(Parameter 24 should be 2 octets)} comd(getpntr)= 0; {(Prepare to read block comd again)} %RESULT = true %c ;%end;; %c %ROUTINE send parameter; {'COMMENT' Chart 28. Assumes that the getpntr of reply points to} {the parameter. Leaves this past the parameter}; %INTEGER count; getch(reply); count = ch; {(Parameter length)} octout = count; send octet(reply stream, no warn); {(21)} %c 'FOR' count = count - 1 'WHILE' count >= 0 'DO' %c 'BEGIN' %c getch(reply); octout = ch; send octet(reply stream, no warn) %c ;%end; %c ;%end;; %c %ROUTINE send and count ns message (%INTEGER mt, datum); {'COMMENT' Chart 29. If mt is data or expedited then octout is} { given in datum. Otherwise the message is given in out buf}; %INTEGER loc, count; message type = outmt(context, mt); {(This statement must come} { first, since} { send and buffer ns message} { uses 'new' message type but} { 'old' context)} send and buffer ns message(mt, datum, message type, context); {(33)} context = outcon(context, mt); {(NB Table look-up gives ADDRESS} { Normal in contexts 2, 4 and 5,} { even though in some cases this} { is not the true context or} { message type.)} %IF message type = 32 %THEN %START; %c ; {(Normal Final DISCONNECT)} resets sent = 0; {(Gives i for $|R(i))} ; %FINISH ; %IF mt = reset %AND context = 5 %THEN %c resets sent = resets sent + 1; ;{($|R(i), i=i+1 )} %IF last out was data = true %THEN %START; %c %c %IF message type = 34 %THEN %START; %c %c message type = 41; {(Corrects for ADDRESS following DATA)} context = 0; {(Corrected to $*)} ; %FINISH ; %c %IF message type <> 33 %AND message type <> 36 %THEN %c last out was data = false; {(Neither DATA nor EXPEDITED)} ;%end; %c %else %IF message type = 33 %THEN %c last out was data = true; %c %IF context = 1 %or context = 3 %or context = 7 %or context = 9 %c %or context = 10 %THEN %c auto channel free = false %c %else auto channel free = true; %c %IF message type = 32 %or message type = 38 %THEN %c abandon command; {(Final DISCONNECT or Matching RESET -(32))} %c loc = message type + 'LOCATION'(c1) - 1; count =( loc)+ 1; (loc)= count; {(Increment message count)} %c %IF message type <= 38 %THEN c54 = c54 + 1 %c %else %IF message type <= 46 %then c55 = c55 + 1 %c %else c56 = c56 + 1; ;{(Normal primitive, primitive out of context} { or superfluous primitive respectively.)} %c process cle count(message type); {(22)} ;%end;; %c %ROUTINE %c send reply (%INTEGER isadr, reply type, reply length); {'COMMENT' Chart 30. Param_list occupies the block reply}; 'BEGIN' %c %INTEGER param count; %ROUTINE send (%INTEGER x); octout = x; send octet(reply stream, no warn) %c ;%end;; send(h); {(Herald 'H')} send(reply type); send(reply length); {(No. of parameters)} %c reply(getpntr)= 0; ;{(Prepare to read the first parameter from reply)} param count = reply length; 'FOR' param count = param count - 1 'WHILE' param count >= 0 'DO' %c send parameter; {(28)} %c %IF isadr = true %THEN %START; %c ; {(Address parameter)} out buf(putpntr)= 0; ch = push; putch(out buf); send and count ns message(push, none); {(29)} reply(getpntr)=(reply getpntr)-1; ;{(Prepare to read last octet of reply again)} getch(reply); {(Fetch qualifier to ch)} %IF ch = 0 %THEN ch = 1 %else %c %IF ch = 1 %then ch = 0; {(Reverse qualifier - 'Chart 19')} %c reply(putpntr)=(reply getpntr)- 1; ;{(Prepare to write last octet of reply again)} putch(reply); {(Reversed qualifier in reply)} out buf(putpntr)= 0; ch = address; putch(out buf); ;{(Type octet)} copy(reply, out buf); {(Append address and qualifier)} send and count ns message(address, none); {(29)} ; %FINISH ; %c send(t); {(Trailer 'T')} %c %IF isadr = true %or reply stream = data %THEN %START; %c %c out buf(putpntr)= 0; ch = push; putch(out buf); send and count ns message(push, none); {(29)} ; %FINISH %c %else send and buffer ns message(forward buffered output, none, %c message type, context) ; {(33)} ;%end;; %c %c {'COMMENT' Chart 31 - has been absorbed in chart 33}; %c %ROUTINE abandon command; {'COMMENT' Chart 32}; d command = false; e command = false; d suspense = false; e suspense = false; abandon = true %c ;%end;; %c %ROUTINE send and buffer ns message (%INTEGER mt, datum, %c message type, context) ; {'COMMENT' Chart 33. The message is given in the block out buf} { unless DATA or EXPEDITED, in which case the octet of data is in datum}; %INTEGER matching, nsidu size; %c %ROUTINE send nsidu; {'COMMENT' Also clears heldout and resets nsidu out}; %INTEGER pp; pp = nsidu(out putpntr); {(Number of octets stored)} nsidu out(putpntr)= 0; ch = heldout; {(data or expedited)} putch(nsidu out); {(Type octet)} ch = pp - 2; putch(nsidu out); {(Length octet)} output ns(nsidu out, false); {(Send the NSIDU. Since this is, by} { definition, either DATA or} { EXPEDITED the second argument} { ;(Matching) must be False.)} {'COMMENT' The putpntr of nsidu out is now 2}; heldout = none %c ;%end;; %c matching = false; {(Will be set to true only for a Final} { DISCONNECT or a Matching RESET)} %IF mt = forward buffered output %THEN %START; %c ; {(This is 'Chart 31')} %IF heldout <> none %THEN send nsidu; -> return; ; %FINISH ; %c %IF heldout <> none %THEN %START; %c %c %IF mt <> heldout %THEN send nsidu %c %else -> store octet %c ; %FINISH ; %c %IF mt <> data %AND mt <> expedited %THEN %START; %c %c %IF message type = 32 %AND context <> 3 %or message type = 38 %c %THEN matching = true; {(Final DISCONNECT not replying to} { CONNECT, or a Matching RESET)} output ns(out buf, matching); {(Send NS message)} -> return %c ; %FINISH %c %else %start; heldout = mt; nsidu out(putpntr)= 2 ; %IF mt = data %c %THEN nsidu size = data size %c %else nsidu size = expedited size;{(set max size of this NSIDU)} ; %FINISH ; %c store octet: %c ch = datum; putch(nsidu out); %IF nsidu out(putpntr)= nsidu size %c %THEN send nsidu; return: %c ;%end;; %c %ROUTINE act 2; {'COMMENT' Chart 102: Primitive Action 2: Send a CONNECT message} { using Outgoing Called address}; send connect(oad1); %c %ROUTINE act 3; {'COMMENT' Chart 103: Primitive Action 3: Send a CONNECT message} { using Incoming Calling address}; send connect(iad2); %c %ROUTINE act 4; {'COMMENT' Chart 104: Primitive Action 4: Send a CONNECT message} { using Incoming Recall address}; send connect(iad3); %c %ROUTINE act 5; {'COMMENT' Chart 105: Primitive Action 5: Send an ACCEPT message}; out buf(putpntr)= 0; ch = accept; putch(out buf); {(Type octet)} fetch param(oad3, out buf); fetch param(oqs, out buf); fetch param(oet4, out buf); send and count ns message(accept, none); {(29)} ;%end;; %c %ROUTINE act 6; {'COMMENT' Chart 106: Primitive Action 6: Send a DISCONNECT message}; out buf(putpntr)= 0; ch = disconnect; putch(out buf); {(Type octet)} %IF invalid = true %THEN %START; %c ; {(Responding to Invalid Command event)} fetch param(ocr2, out buf); fetch param(oad4, out buf); fetch param(oet2, out buf); send and count ns message(disconnect, none); {(29)} ; %FINISH %c %else %c %IF poc = false %THEN %START; %c ; {(Normal case)} fetch param(ocr1, out buf); fetch param(oad4, out buf); fetch param(oet1, out buf); send and count ns message(disconnect, none); {(29)} ; %FINISH %c %else %c %IF context <> 1 %AND context <> 7 %AND context <> 9 %THEN %START; %c ; {(Responding to POC)} fetch param(ocr3, out buf); fetch param(oad4, out buf); fetch param(oet3, out buf); send and count ns message(disconnect, none) %c ; %FINISH ; {(Otherwise do nothing - DISCONNECT would be a POC)} ;%end;; %c %ROUTINE act 7; {'COMMENT' Chart 107: Primitive Action 7: Echo a received octet} { as a DATA message}; octout = octin; send octet(data, warn); {(21)} ;%end;; %c %c %ROUTINE act 8; {'COMMENT' Chart 108: Primitive Action 8: Echo a received address} { with reversed qualifier}; out buf(putpntr)= 0; ch = address; putch(out buf); {(Type octet)} fetch param(adrin, out buf); ch = 1; putch(out buf); {(Length octet)} %c ch = qualifier; %IF ch = 0 %THEN ch = 1 %else %c %IF ch = 1 %then ch = 0; {(Reverse Qualifier - 'Chart 19')} putch(out buf); send and count ns message(address, none); {(29)} ;%end;; %c %c %ROUTINE act 9; {'COMMENT' Chart 109: Primitive Action 9: Send a PUSH message}; out buf(putpntr)= 0; ch = push; putch(out buf); {(Type octet)} send and count ns message(push, none); {(29)} ;%end;; %c %c %ROUTINE act 10; {'COMMENT' Chart 110: Primitive Action 10: Echo a received octet} { as an EXPEDITED message}; octout = octin; send octet(expedited, warn); {(21)} ;%end;; %c %ROUTINE act 11; {'COMMENT' Chart 111: Primitive Action 11: Send a RESET message}; out buf(putpntr)= 0; ch = reset; putch(out buf); {(Type octet)} %IF invalid = true %THEN %START; %c ; {(Responding to Invalid Command event)} fetch param(ocr2, out buf); fetch param(oad4, out buf); fetch param(oet2, out buf); send and count ns message(reset, none); {(29)} ; %FINISH %c %else %c %IF poc = true %THEN %START; %c %c %IF context <> 1 %AND context <> 2 %AND context <> 3 %AND %c context <> 7 %AND context <> 9 %AND context <> 10 %THEN %START; %c ;{( Responding to Primitive Out of Context )} fetch param(ocr3, out buf); fetch param(oad4, out buf); fetch param(oet3, out buf); send and count ns message(reset, none) %c ; %FINISH ;{( otherwise do nothing - RESET would be a POC)} ;%end; %c %else %start; fetch param(ocr1, out buf); fetch param(oad4, out buf); fetch param(oet1, out buf); send and count ns message(reset, none) %c ; %FINISH ; ;%end;; %c %c %ROUTINE act 12; {'COMMENT' Chart 112: Primitive Action 12: Start Automatic Source}; %IF as stream <> 0 %AND auto on = false %THEN %START; %c %c auto on = true; drive automatic source; {(13. Sends an octet now, in case} { the next Action stops the source)} ; %FINISH ; %c %c %ROUTINE act 13; {'COMMENT' Chart 113: Primitive Action 13: Stop Automatic Source}; %IF auto on = true %or as stream <> 0 %THEN %START; %c ; auto on = false; {(whether or not it is already false)} reply stream = auto stream; {(DATA when as stream = 1,} { EXPEDITED when as stream = 2)} reply(putpntr)= 0; ch = 1; putch(reply); ch = as oct; putch(reply); send reply(not addr, 19, 1); {(30)} ; %FINISH ; %c %ROUTINE act 14; {'COMMENT' Chart 114: Primitive Action 14: Send a burst from} { Single-shot Source}; %IF ss burst > 0 %THEN %START; %c %c %INTEGER burst count; burst count = ss burst; 'FOR' burst count = burst count - 1 'WHILE' burst count >=0 'DO' %c %IF ss oct = ss last %THEN %c ss oct = ss first %else %c ss oct =BITS(8,0)integer(ss oct + ss inc); {(Modulo 256)} octout = ss oct; send octet(ss stream, warn); {(21)} ;{(ss stream = EXPEDITED when as stream = 1,} { ss stream = DATA when as stream = 2)} ; %FINISH %c ;%end;; %c %ROUTINE act 15; {'COMMENT' Generate a parallel Test Responder.} { Create a new instance of the Test Responder, set it to the} { "Outgoing CONNECT" version of the default mode, and run it in} { parallel with this Test Responder. (How this is done will depend on} { the capabilities of the operating system environment.)}; ;%end;; %c %ROUTINE act 16; {'COMMENT'} { Chart 116: Primitive Action 16: Store Outgoing Called address}; copy(adrin, oad1); %c %ROUTINE act 17; {'COMMENT'} { Chart 117: Primitive Action 17: Store Outgoing Calling address}; copy(adrin, oad2); %c %ROUTINE act 18; {'COMMENT'} { Chart 118: Primitive Action 18: Store Outgoing Recall address}; copy(adrin, oad3); %c %ROUTINE act 19; {'COMMENT'} { Chart 119: Primitive Action 19: Store Outgoing Location}; copy(adrin, oad4); %c %ROUTINE act 20; {'COMMENT' Chart 120: Primitive Action 20: End Test Session.} { STOP -- Terminate this Test Responder. If this is done by putting} { the Test Responder back into the 'CONNECT in' default mode, care} { must be taken to fully reinitialise all variables and blocks. }; ;%end;; %c %INTEGERFN input ns (%INTEGERARRAYname in); {'COMMENT' Chart 200 by another name.} { Input primitive or NSIDU.} { This procedure must deliver answer 0 (false) if there is no} { primitive or NSIDU waiting to be read from the Network Service} { Interface at the time the procedure is called, but otherwise answer} { 1 (true). If the answer is false, the array parameter (in) must be} { unaltered. If the answer is true, the actual parameter array must be} { filled (two octets per word, beginning with the word of index 3)} { from the message waiting to be read, and that message must be} { discarded.} {} { The first octet of each message must be from 1 to 8, giving the type} { of primitive. The type is extracted from the lowest three bits,} { ignoring higher bits, so that an erroneous type will probably} { produce unexpected behaviour. When this is detected some evidence} { should will be available for diagnosis. This is preferred to} { aborting the Test Responder.} {} { This type octet is followed by from 0 to 4 parameters. All} { parameters specified in the Yellow Book must be present in the} { defined order, even if null. Each must be preceded by a length} { octet, giving a maximum possible length of 255 octets. Null} { parameters are represented by a zero length octet. Data and} { expedited messages are passed as a single parameter proceded by a} { length octet. Addresses should not be longer than 'address size'.} { Explanatory text parameters should not be longer than 'expl text} { size'. Coded reasons should not be longer than 'cr size'. Qualifiers} { must be just one octet long, but still must be preceded by a length} { octet (value 1). Data messages should not be longer than} { 'data_size' - 2, and expedited messages should not be longer than} { 'expedited_size' - 2.} {} { If a length octet causes the capacity of the block 'in buf' to be} { exceeded, the parameter will be truncated when stored, and will} { subsequently be read as if extended by copies of the last octet} { stored there. This can only happen if 'buf size' is set too small in} { relation to other 'sizes'.} {} { Form of data 'in buf'} {} { Word 0 Block size )} { Word 1 Get pointer ) Ignored by 'input ns'} { Word 2 Put pointer )} { Word 3 Octet 0 Type of message} { Octet 1 Length of 1st parameter} { Word 4 Octet 2 )} { ... ... ) Octets (if any) of 1st parameter} { Octet 1 + length )} { next Octet Length of 2nd parameter (if any)} { ... ... ...} { }; %RESULT = true + false; %c %ROUTINE wait for ns input (%INTEGERARRAYname in); {'COMMENT' Chart 201 by another name.} { Input primitive or NSIDU.} { This procedure is similar to input ns (200) above, except that the} { TR is prepared to wait for the arrival of a primitive message if} { there is none available at the moment the procedure is called. If} { the waiting has to be abandoned for any reason, the TR should be} { terminated }; ;%end; ; %c %ROUTINE %c output ns (%INTEGERARRAYname out; %INTEGER matching); {'COMMENT' Chart 202 and 206 combined.} { Output primitive or NSIDU.} { This procedure outputs the message defined in the parameter array.} { This array will be filled in the same format as required for input.} { The procedure should not return until the output interaction} { requested is complete. Thus, if the output channel is blocked by} { flow-control, the TR must wait until output can proceed. If an} { acknowledgement is required from the Network Service, this must be} { waited for, even if this means that input must be buffered until the} { next call of (200) or (201). If the input buffer overflows, a RESET} { or DISCONNECT should be generated within output ns both towards the} { portable part of the TR and towards the IUT, with a suggested 'coded} { reason' of 37 (Congestion), to allow resynchronisation of the test.} { Output ns has a second argument which is set to 1 (true) for a} { Matching RESET or a Final DISCONNECT, which is not in response to a} { CONNECT: such messages may be discarded if they are not required by} { the IUT. This will be the case if the IUT provides an "end system"} { style of service as defined in the Yellow Book state tables.} { Otherwise the second parameter is 0 (false).} {} { Form of data 'out buf'} {} { Word 0 Block size )} { Word 1 Get pointer ) Ignored by 'output ns'} { Word 2 Put pointer )} { Word 3 Octet 0 Type of message} { Octet 1 Length of 1st parameter} { Word 4 Octet 2 )} { ... ... )Octets (if any) of 1st parameter} { Octet 1 + length)} { next Octet Length of 2nd parameter (if any)} { ... ... ...} { Form of data in 'nsidu out'} {} { Word 0 Block Size )} { Word 1 Get pointer ) Ignored by 'output ns'} { Word 2 Put pointer )} { Word 3 Octet 0 Type of message(4 for DATA,7 for EXPEDITED)} { Octet 1 Length of the parameter} { Word 4 Octet 2 )} { ... ... )Data Octets} { Octet 1 + length) }; ;%end;; %c %ROUTINE %c supply initial values (%INTEGERARRAYname called addr, calling addr; %integername connect mode); 'BEGIN' %c {'COMMENT' Chart 203} { This procedure obtains, in whatever manner is convenient, values} { for, the Called and Calling Addresses and whether the Test Responder} { is to wait for the Initial CONNECT (connect mode is 1 (true)) or} { send it (connect mode is 0 (false)). These values may be set by} { program, obtained from file, or by interaction with a human} { operator. They must be presented in block form: ie. the first 16 bit} { word must contain the value of address size, the second zero, and} { the third the length of the actual address, thereafter octets of the} { address must be packed two to each 16 - bit word. }; ;%end;; %c %c {'COMMENT' Chart 204 has been absorbed in the main program below.} { Chart 205 has been absorbed in chart 30.} { Chart 206 has been combined with chart 202 }; %c {'COMMENT' Here begin the statements of the Test Responder, i.e.} { the body of the "Main_loop"}; 'BEGIN' %c %ROUTINE syntax error; respond to invalid command event; {(8)} -> again %c ;%end;; %c initialise control variables; {(1)} set default mode; {(2)} respond to change mode event; {(4)} again: %c %IF read command octet = false %THEN -> again; {(3)} {'COMMENT' A command octet has now been read to octin)}; %c command type = octin; %IF command type < 1 %or command type > 19 %THEN %c syntax error; {(Command type out of range)} %c %IF read command octet = false %THEN -> again; {(3)} param count = octin; %IF param count checks with command type = false %c %THEN syntax error; ;{(param count checks with command type is (5))} %c comd(putpntr)= 0; {(Chart 204 has been incorporated into Main)} ;{(Prepare to write command to block comd)} 'FOR' param count = param count - 1 'WHILE' param count >= 0 'DO' %c %IF read parameter = false %THEN -> again; ;{(read parameter is (6))} {'COMMENT' Now all parameters have been stored in comd}; %c %IF read command octet = false %THEN -> again; {(3)} %c d command = false; {(End of command)} e command = false; %c %IF octin <> t %THEN syntax error; ;{(Trailer)} %c comd(getpntr)= 0; {(Prepare to read the command)} respond to command; {(7)} -> again %c ;%end; %c ;%end; OF SEGMENT c1 %c 'FINISH' %c %c %c %c %c ;%endofprogram