%begin
{'CORAL' TEST RESPONDER}

{'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}


{'LIBRARY' (%ROUTINEspec trwritestring(%INTEGER b), }
{                       trwriteint(%INTEGER, %INTEGER b), }
{                       trwriteout }
{          ) }
{'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' }
%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 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 c, %INTEGER b)
%ROUTINEspec abandon command
%ROUTINEspec send and buffer ns message(%INTEGER A, %c
             %INTEGER d,%INTEGER c, %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)
%ROUTINEspec supply initial values(%INTEGERARRAYname  c, %INTEGERARRAYname f, %c
                          %integername  d)


%constinteger  blocksize      = 0
%constinteger  getpntr        = 1
%constinteger  putpntr        = 2;  {(For using "blocks")}
%constinteger  response size  = 4;  {(Max. no. of parameters)}
%constinteger  response limit = 4;  {(Upper array bound)}

%constinteger  true  = 1
%constinteger  false = 0;  {(Boolean values)}
%owninteger  h = 72
%owninteger  t = 84
%owninteger  w = 87;  {(ASCII codes)}

%owninteger  allowed to wait = true
%owninteger  not allowed to wait = false

%owninteger  none     = 0
%owninteger  warn     = true
%owninteger  no warn  = false
%owninteger  addrx     = true
%owninteger  not addr = false;  {(Constant parameters)}

%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)}

%owninteger  forward buffered output = 99;  {(Used by Chart 30 when calling}
{                                         Chart 33 to simulate Chart 31)}

{'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}

%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)}

%owninteger  qs limit        = 255;  {(Array bound for block for Quality}
{                                  of Service parameter)}
%owninteger  expl text size  = 255;  {(Maximum length of expl. text parameter)}

%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)}

%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)}

%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 }
      %integer dum;       ! for use with fns used as routines

%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)}

{'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)
%ownintegerarray set up(1:352) =
              19, 20,  3, 21, 22, 23, 24, 25,
               1, 12, 13, 14, 15, 16, 17, 18,
              11,  2,  4, 14, 15, 16, 17, 18,
              11, 12,  3,  5,  6,  7,  8, 18,
              11, 12,  3,  5,  6,  7,  8,  9,
              11, 12,  3, 21, 22, 23, 24, 10,
              11, 12,  3, 14, 15, 16, 17, 18,
              11, 12,  4, 21, 22, 23, 24, 25,
              11, 12, 13, 14, 15, 16, 17, 18,
              11,  2,  4, 14, 15, 16, 17, 18,
              11, 12, 13, 14, 15, 16, 17, 18,
               0,  0,  8,  0,  0,  0,  0,  0,
               3,  1,  1,  1,  1,  1,  1,  1,
               0,  4,  1,  0,  0,  0,  0,  0,
               0,  0, 10,  3,  3,  3,  3,  0,
               0,  0,  8,  4,  4,  4,  4,  6,
               0,  0,  8,  5,  5,  5,  5,  5,
               0,  0,  8,  0,  0,  0,  0,  0,
               7,  7,  1,  7,  7,  7,  7,  7,
               8,  8,  8,  8,  8,  8,  8,  8,
               9,  7,  1,  9,  9,  9,  9,  9,
              10, 10, 10, 10, 10, 10, 10, 10,
              47, 48, 31, 49, 50, 51, 52, 53,
              29, 40, 41, 42, 43, 44, 45, 46,
              39, 40, 31, 33, 34, 35, 36, 46,
              39, 30, 32, 42, 43, 44, 45, 46,
              39, 40, 31, 33, 34, 35, 36, 37,
              39, 40, 31, 33, 34, 35, 36, 37,
              39, 40, 31, 49, 50, 51, 52, 38,
              39, 40, 41, 42, 43, 44, 45, 46,
              39, 40, 32, 49, 50, 51, 52, 53,
              39, 40, 41, 42, 43, 44, 45, 46,
              39, 30, 32, 42, 43, 44, 45, 46,
               0,  0,  7,  0,  0,  0,  0,  0,
               2,  1,  1,  1,  1,  1,  1,  1,
               0,  0,  9,  2,  2,  2,  2,  0,
               0,  4,  1,  0,  0,  0,  0,  0,
               0,  0,  7,  4,  4,  4,  4,  5,
               0,  0,  7,  5,  5,  5,  5,  5,
               0,  0,  7,  6,  6,  6,  6,  4,
               7,  7,  7,  7,  7,  7,  7,  7,
               8,  8,  1,  8,  8,  8,  8,  8,
               9,  9,  9,  9,  9,  9,  9,  9,
              10,  8,  1, 10, 10, 10, 10, 10
{'COMMENT' end of common declarations }

{'SEGMENT' c1 }
      %routine trwritestring(%string (63) s); printstring(s); %end
      %routine trwriteint(%integer n, i); write(n, i); %end
      %routine trwriteout; newline; %end
 

{'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) }

%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 = byteinteger(string loc)
   %IF  octet1 > 0 %THEN  %c
       integer(string loc)= octet1 - 5;  {(If we already have a block, then}
{                                    octet1 is 0, otherwise reduce}
{                                    blocksize by 5 for TEXT=)}
    integer(string loc +2)= 0;  {(getpntr)}
    integer(string loc +4)= integer(string loc);  {(putpntr = blocksize)}
   %RESULT = string loc %c
;%end


%ROUTINE initblock (%INTEGERarrayname  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

%INTEGERFN putch (%INTEGERARRAYname  b)
{'COMMENT' Appends to block b the character given in  ch}
   %INTEGER  p, i
   p = b(putpntr)
   %IF  p >= b(blocksize)%THEN  %RESULT = false %c
   %else %start
      i = (p+6)>>1
      %IF   p & 1 = 0 %c
      %THEN   b(i) = (b(i)&x'00ff')!ch<<8   %c
      %else   b(i) = (b(i)&x'ff00')!(ch&255)

      b(putpntr)= p+1
      %RESULT = true 
    %FINISH  %c
;%end

%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
      %IF   g & 1 = 0 %c
         %THEN   ch = b((g+6)>>1)>>8 %c
         %else   ch = b((g+6)>>1)&255
      b(getpntr)= g+1
      %RESULT = true 
    %FINISH  %c
;%end


%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
      %cycle; %exit %if getch(a) # true; dum = putch(b); %repeat
   a(getpntr)= g %c
;%end


%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, hold
   %INTEGERFN get(%INTEGER a, %c
                             %integername  g); %c
   {'COMMENT' Fetches to ch the character of the block located by a}
{   whose getpntr value is g, and increments g}
      %IF  g>= integer(a+putpntr)%THEN  %RESULT = false %c
      %else %start; %c
         %IF  g & 1 = 0 %c
               %THEN  ch = integer(a + (g+6)>>1)>>8  %c
               %else  ch = integer(a + (g+6)>>1)&255
         g = g+1
         %RESULT = true 
       %FINISH  %c
   ;%end
   g = 0
   %cycle; %exit %if get(a,g)#true; dum = putch(b); %repeat
;%end

%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
  dum = getch(a);  count = ch;  {(Length octet)}
    %cycle; count = count-1; %exit %if count<0
     dum = getch(a); dum = putch(b)
   %repeat
;%end


%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); dum = putch(b);  {(Length octet)}
   copy(a,b) %c
;%end


%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; dum = 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

%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

%ROUTINE set default mode
{'COMMENT' Chart 2}
      %string (63) s
   %INTEGER  n
   %for n = 0 , 1 , 55  %cycle
       integer(addr(c1) +n)= 0;  {(Clear message counts)}
   %repeat
   ch = 64; dum = putch(ocr1)
      ;{(Outgoing Coded Reason for normal use with}
{       RESET or DISCONNECT, local use)}
   ch = 255; dum = putch(ocr2)
      ;{(Ditto after an invalid command)}
   ch = 254; dum = putch(ocr3)
      ;{(Ditto after a Primitive Out of Context)}
   s = "TEXT=INVALID COMMAND"
   copytext(block(ADDR(S)), oet2)
      ;{(Outgoing Explanatory Text after an invalid command)}
   s = "TEXT=PRIMITIVE OUT OF CONTEXT"
   copytext(block(addr(s)), oet3)
      ;{(Ditto after POC)}
   s = "TEXT=TEST RESPONDER VERSION 1.1"
   copytext(block(addr(s)), oet4)
      ;{(For use with CONNECT or ACCEPT)}

   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)}

   copy(oad2, oad3)
         ;{(Outgoing recall address set to outgoing calling address)}

  {'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}

   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)}
  dum = putch(m2); dum = putch(m5)
  dum = putch(m6); dum = putch(m7); dum = putch(m8); dum = putch(m10)
  dum = putch(m11); dum = putch(m12);  {(Response parameters:  do nothing,}
{                             m2 or m11 will be overwritten below)}

   ch = 6; dum = putch(m3)
   ch = 20; dum = putch(m3)
      ;{(Response to Initial DISCONNECT:}
{         Final DISCONNECT and End Test Session)}
   ch = 20; dum = putch(m4)
      ;{(Response to Final DISCONNECT:  End Test Session)}
   ch = 6; dum = putch(m9); dum = putch(m13); dum = putch(m14)
      ;{(Responses to Initial RESET, Invalid Command or}
{       Primitive Out of Context:}
{         Initial DISCONNECT)}

   %IF  default mode connect in = true %THEN %START
    %c
      ch = 5; dum = putch(m1);  {(Response to CONNECT:  ACCEPT)}
      ch = 6; dum = putch(m2);  {(Response to ACCEPT:  Initial DISCONNECT)}
   ; %FINISH %else %start
      ch = 2; dum = putch(m11);  {(Response to start:  CONNECT)}
      ch = 6; dum = putch(m1)
      ch = 20; dum = putch(m1)
         ;{(Response to CONNECT:  Final DISCONNECT, End Test Session)}
   ; %FINISH  %c
;%end

%INTEGERFN read command octet
{'COMMENT' Chart 3}
   %INTEGERFN process primitive gives command octet
{                  to find TDRP commands.It incorporates charts 15 & 16 }

      %IF  count and respond to primitive message = true %THEN %START
      ; {(14. Normal DATA or EXPEDITED message,}
{                          not yet responded to)}
         %IF  type = data %THEN %START
         ;  {(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 
             %FINISH 
            %IF  d suspense = true %THEN %START
             %c
               d suspense = false;          {(ordinary data)}
               respond to incoming message;  {(24)}
            ; %FINISH %else  %c
            %IF  octin = h %THEN %START
            ;  {(D herald)}
               %IF  e command = true %THEN %START
                   respond to invalid command event; {(8)} 
               %finish %else  d command = true
            %finish %else  %IF  octin = w %THEN  %c
               d suspense = true %else %start
                  respond to invalid command event; {(8)}
              %finish
          %FINISH  %else %start
            {'COMMENT' The following 'write' statements can be used to}
{                   display the received expedited octet if required}
            trwritestring %c
        ("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 
             %FINISH 

            %IF  e suspense = true %THEN %START
             %c
               e suspense = false;          {(ordinary expedited)}
               respond to incoming message;  {(24)}
            %finish %c
            %else  %c
            %IF  octin = h %THEN %START; 
            ;  {(E herald)}
               %IF  d command = true %THEN %START
                   respond to invalid command event;  {(8)} ; %FINISH %else  %c
                  e command = true
            %finish %c
            %else %c
            %IF  octin = w %THEN %c
               e suspense = true%c
            %else %start;%c
                   respond to incoming message; {(24 ordinary expedited)}
               ; %FINISH  %c
         ;%finish;  {(EXPEDITED)}
      ;%finish;  {(Use of Octin)}
      %RESULT = false %c
   ;%end; {process primitive gives command octet}

   %INTEGER  dummy

   d suspense = false;  e suspense = false
   abandon = false

   %cycle;  {(Loop repeated indefinitely)}
      %IF  abandon = true %THEN  %RESULT = false

      %IF  test input(type, not allowed to wait) = false %THEN %START
      
         %IF  drive automatic source = false %THEN %START
          %c
            dum = test input(type, allowed to wait) ;  {(12)}
            %IF  process primitive gives command octet = true %THEN  %c
               %RESULT = true 
          %FINISH 
         {'COMMENT' Else Source was driven so respond to cles and loop}
      %finish %else %start
         %IF  process primitive gives command octet = true %THEN  %c
            %RESULT = true 
       %FINISH 
      %repeat
      {'COMMENT' initblock(in buf, buf size) is unnecessary because}
{                test input overwrites whatever is in 'in buf'}
!      respond to cles 
   ;! %repeat;  {(Loop)}
;%end;  {(Read command octet)}

%ROUTINE respond to change mode event
{'COMMENT' Chart  4}
   auto on = false;   {(Initialise Sources- chart 9)}

   %IF  as stream <> 0 %THEN %START

      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)}

      %IF  as stream = 1 %THEN %START
       %c
         auto stream = data
         ss stream   = expedited
      ; %FINISH %else %start
         auto stream = expedited
         ss stream   = data
      ; %FINISH 
   ;%finish

   do actions(m11);        {(10)}
   respond to cles;        {(11)}
;%end

%INTEGERFN param count checks with command type
{'COMMENT'  Chart 5}
   %ownINTEGERARRAY  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

   %IF  param count = params for command(command type) %c
   %THEN  %RESULT = true %c
   %else  %RESULT = false
;%end

%INTEGERFN read parameter
{'COMMENT'  Chart 6}
   %INTEGER  count
   %IF  read command octet = false %THEN  %c
      %RESULT = false;  {(Command abandoned)}

   %IF  no of octets checks with command type and param count %c
      = false %THEN %START
    %c
      respond to invalid command event
      %RESULT = false 
    %FINISH 

   count = octin;  {(Number of octets in parameter)}
   ch = count; dum = putch(comd);  {(Store length octet)}

      %cycle; count = count-1; %exit %if count < 0
      %IF  read command octet = false %THEN  %c
         %RESULT = false;  {(Command abandoned)}
      ch = octin; dum = putch(comd);  {(Store octet)}
   ;%repeat
   %RESULT = true %c
;%end

%ROUTINE respond to command
{'COMMENT'  Chart 7}
   %INTEGER  count, ifrepeat
{'COMMENT'  Note: not addr is a constant = false, and addr = true.}
      %routine abort(%integer i)
         printstring("Abort called, reason ="); write(i, 1); newline
      %end

{}
{         The following five procedures are declared here because}
{         they are not used elsewhere}

   %ROUTINE store one (%integername  x)
   {'COMMENT' Checks parameter length 1 in block comd, then copies to x}
     dum = getch(comd)
      %IF  ch <> 1 %THEN  abort(1);  {(Wrong length)}
     dum = getch(comd);  x = ch %c
   ;%end

   %ROUTINE store two (%integername  x)
   {'COMMENT' Checks parameter length 2 in block comd, then copies to x}
      %INTEGER  first
     dum = getch(comd)
      %IF  ch <> 2 %THEN  abort(2)
     dum = getch(comd);  first = ch
     dum = getch(comd)
      x = 256*first + ch %c
   ;%end

   %ROUTINE fetch one (%INTEGER x)
   {'COMMENT'  Appends x to block reply, preceded by length octet 1}
      ch = 1; dum = putch(reply)
      ch = x; dum = putch(reply) %c
   ;%end

   %ROUTINE fetch two (%INTEGER x)
   {'COMMENT'  Appends top and bottom octets of x to block reply,}
{      preceded by length octet 2}
      ch = 2; dum = putch(reply)
      ch =x>>8&255; dum = putch(reply)
      ch = x&255; dum = putch(reply) %c
   ;%end

   %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; dum = putch(reply);  {(Length octet for qualifier)}
      ch = qual; dum = putch(reply);  {(Qualifier)}
      send reply(repeat mode, comtyp, 2); {(30)}
   ;%end

{'COMMENT'  Here begin the statements of  Respond_to_command}

   %IF  command type = 1 %THEN %START
   ;  {(Change Mode)}
      %IF  mode parameters check = false %THEN %START
       %c
         -> parameter error;  {(To respond to invalid command event)}
      ; %FINISH %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
            act 13;  {(Stop automatic source)}
            respond to cles; {(11)}
         ; %FINISH 
         respond to change mode event;  {(4)}
      %finish
   ;%finish %c
   %else  %c
   %IF  command type = 10 %THEN %START
       act 15;  {(Generate a parallel Test Responder,}
{                        with CONNECT out default mode)}
      ; %FINISH %else  %c
   %IF  command type = 2 %THEN %START
    %c
      %for count = 0 , 1 , 55  %cycle
       integer(addr(c1) +count)= 0;  {(Reset message counts)}
     %repeat
   ; %FINISH %else  %IF  command type = 9 %THEN %START

      act 12;           {(Start Automatic Source)}
      respond to cles;   {(11)}
   ; %FINISH %else  %IF  command type = 19 %THEN %START

      act 13;  {(Stop Automatic Source)}
      respond to cles;  {(11)}
   ; %FINISH %else  %c
   %IF  command type = 3 %THEN %START
   ;  {(Set Outgoing Coded Reason and Explanatory Text)}
      store param(comd, ocr1);  {(Coded Reason)}
      store param(comd, oet1);  {(Explanatory Text)}
   ; %FINISH %else  %c
   %IF  command type = 4 %THEN %START
   ;  {(Set Outgoing Quality of Service and Explanatory Text)}
      store param(comd, oqs);   {(Quality of Service)}
      store param(comd, oet4);  {(Explanatory Text)}
   ; %FINISH %else  %c
   %IF  command type = 5 %THEN %START
   ;  {(Set Outgoing Called Address, for use with CONNECT)}
      store param(comd, oad1) 
    %FINISH %else  %c
   %IF  command type = 6 %THEN %START
   ;  {(Set Outgoing Calling Address, for use with CONNECT)}
      store param(comd, oad2) 
    %FINISH %else  %c
   %IF  command type = 7 %THEN %START
   ;  {(Set Outgoing Recall Address, for use with ACCEPT)}
      store param(comd, oad3) 
    %FINISH %else  %c
   %IF  command type = 8 %THEN %START
   ;  {(Set Outgoing Location, for use with RESET and DISCONNECT)}
      store param(comd, oad4) 
    %FINISH %else %start
      reply(putpntr)= 0;  {(Prepare to form Reply)}

     dum = getch(comd);  count = ch;  {(Length octet)}
     dum = getch(comd)

      %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)}

      %IF  command type = 11 %THEN %START
      ;  {(Give Mode Parameters:}
{                 Copy parameters,  from m1 to ss_burst,  into reply)}

         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 %else  %c
      %IF  command type = 12 %THEN %START
      ;  {(Give Message Counts)}
         %for count = 0 , 1 , 55  %cycle
            fetch two( addr(c1) +(count)) 
         %repeat

         send reply(not addr, 12, 56); {(30)}
      ; %FINISH %else  %c
      %IF  command type = 13 %THEN %START
      ;  {(Give Incoming Coded Reason and Explanatory Text)}
         fetch param(icr, reply)
         fetch param(iet1, reply)
         send reply(not addr, 13, 2) 
       %FINISH %else  %c
      %IF  command type = 14 %THEN %START
      ;  {(Give Quality of Service and Explanatory Text)}
         fetch param(iqs, reply)
         fetch param(iet2, reply)
         send reply(not addr, 14, 2) 
       %FINISH %else  %c
      %start

         {(Command type = 15 to 18, give specified}
{                        address, repeat as ADDRESS if second param = 1)}
        dum = getch(comd);  count = ch;  {(Length octet of second parameter)}
        dum = getch(comd)

         %IF  count = 1 %AND  ch = 0 %THEN  %c
            ifrepeat = not addr %c
         %else  %c
         %IF  count = 1 %AND  ch = 1 %THEN  %c
            ifrepeat = addrx %c
         %else  %c
         -> parameter error;   {(Invalid parameter length or value)}

         %IF  command type = 15 %THEN %START
            ; {(Give Called Address)}
                send addr(iad1, 1, 15, ifrepeat)
            ; %FINISH %else  %c
         %IF  command type = 16 %THEN %START
            ; {(Give Calling Address)}
                send addr(iad2, 0, 16, ifrepeat)
            ; %FINISH %else  %c
         %IF  command type = 17 %THEN %START
            ; {(Give Recall Address)}
                send addr(iad3, 0, 17, ifrepeat)
            ; %FINISH %else %start
               send addr(iad4, 0, 18, ifrepeat) 
             %FINISH  %c
      ;%finish

      respond to cles;  {(11)}
   ;%finish

   -> return;         {(Skip round error section)}

parameter error: %c
                  respond to invalid command event;  {(8)}
return: %c
;%end;  {(Respond to command)}

%ROUTINE respond to invalid command event
{'COMMENT'  Chart 8}
   invalid = true
   do actions(m13);  {(10)}
   invalid = false
   respond to cles;  {(11)}
;%end

{'COMMENT'  Chart 9 - has been absorbed in 4}

%ROUTINE do actions (%INTEGERARRAYname  m)
{'COMMENT'  Chart 10}
   %INTEGER  dummy
   %ROUTINE do act (%INTEGER i)
      %switch sw(1:20)
      -> sw(i)

sw(2): act 2; %return
sw(3): act 3; %return
sw(4): act 4; %return
sw(5): act 5; %return
sw(6): act 6; %return
sw(7): act 7; %return
sw(8): act 8; %return
sw(9): act 9; %return
sw(10): act 10; %return
sw(11): act 11; %return
sw(12): act 12; %return
sw(13): act 13; %return
sw(14): act 14; %return
sw(15): act 15; %return
sw(16): act 16; %return
sw(17): act 17; %return
sw(18): act 18; %return
sw(19): act 19; %return
sw(20): act 20
sw(1):
   ;{(i = 1   means do nothing)}
  %end

   m(getpntr)= 0;  {(Prepare to read from block)}
      %cycle; %exit %if getch(m) # true; do act(ch); %repeat
;%end

%ROUTINE respond to cles
{'COMMENT'  Chart 11}
   %INTEGER  dummy
      %cycle; %exit %if cle count <= 0
      cle count = cle count - 1 
      do actions (m12);  {(Respond to Count Limit Event - 20)}
   ;%repeat
;%end

%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
     dum = 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
      %IF  wait <> true %THEN %START
       %c
         %IF  input ns(in buf) = false %THEN  %RESULT = false ; {(200)}
      ; %FINISH %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
     dum = getch(in buf);  {(Type octet.  First 3 bits to be used)}
      type = 1 +integer(ch-1)&7;  {(From 1 to 8)}

      {'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)}

   set block: %c
      in buf(putpntr)= in buf(getpntr);  {(Total of octets in block)}
      in buf(getpntr)= 1;  {(Past the type octet)}

      %IF  type <> data %AND  type <> expedited %THEN  %RESULT = true %c
      %else %start
         heldin = type
        dum = getch(in buf);  {(Pass the length octet)}
      ; %FINISH  %c
   ;%finish; {(Now heldin = Data or Expedited)}

  dum = 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

%INTEGERFN drive automatic source
{'COMMENT'  Chart 13}
%IF  auto on = true %AND  auto channel free = true %THEN %START

   %IF  as oct = as last %c
   %THEN  %c
   as oct = as first %c
   %else  %c
   as oct = integer(as oct + as inc)&255;  {(Modulo 256)}

   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 
 %FINISH %else  %c
   %RESULT = false
%end

%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)}

   %IF  message type = 4 %THEN  resets sent = 0
                                             ;{(Normal Final DISCONNECT)}

   %IF  context = 5 %AND  message type = 10 %THEN %START
   ;                        {(Matching RESET)}
      resets sent = resets sent - 1
      %IF  resets sent = 0 %THEN  %c
         context = 4;  {(Corrects for final matching RESET)}
   ; %FINISH 

   %IF  last in was data = true %THEN %START
    %c
      %IF  message type = 6 %THEN %START
       %c
         message type = 15;  {(Corrects for ADDRESS following DATA)}
         context = 0;        {(Context corrected to $*)}
      ; %FINISH 

      %IF  message type <> 5 %AND  message type <> 8 %THEN  %c
         last in was data = false
                                 ;{(5 is Normal DATA, 8 Normal EXPEDITED)}
   ;%finish %c
   %else  %c
   %IF  message type = 5 %THEN  %c
      last in was data = true

   loc =  message type + addr(c1) - 1
   count =integer(loc)+ 1
   integer(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

   %IF  message type <= 10 %THEN %START
   ;  {(Normal primitive)}
      c26 = c26 + 1
      process cle count(message type);        {(22)}

      %IF  type <> data %AND  type <> expedited %THEN %START
       %c
         respond to incoming message;  {(24)}
         %RESULT = false 
       %FINISH %else  %c
         %RESULT = true %c
   ;%finish %c
   %else  %IF  message type <= 18 %THEN %START
   ;  {(Primitive Out of Context)}
      c27 = c27 + 1
      process cle count(message type);        {(22)}
      respond to poc event;                   {(23)}
      %RESULT = false 
    %FINISH 
   ;{(Now  message type > 18 :  Superfluous primitive)}
   c28 = c28 + 1
   process cle count(message type);          {(22)}
   %RESULT = false %c
;%end

{'COMMENT' Charts 15 and 16 have been incorporated into 3 }

%INTEGERFN no of octets checks with command type and param count
{'COMMENT' Chart 17}
   {'COMMENT' octin holds the length of the current parameter}
      %integer hold

      %if octin = 1 %then hold = true %else hold = false
   %IF  command type > 8 %THEN  %c
      %RESULT = hold

      %if octin > address size %then hold = false %else hold = true
   %IF  command type > 4 %THEN  %c
      %RESULT = hold

   %IF  command type > 2 %THEN %START

      %IF  param count = 1 %THEN  %start
            %if octin = cr size %then hold = true %else hold = false
           %IF  command type = 3 %THEN  %RESULT = hold
               %if octin > qs size %then hold = false %else hold = true
               %result = hold
          ; %FINISH  %else  %c
               %if octin > expl text size %then hold = false %else hold = true
               %result = hold
   ;%finish
   %RESULT = true;  {(Reset message counts has no parameters and}
{                    Change mode is checked via Chart 18)}
;%end

%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}
  %end

{'COMMENT'  Chart 19 - has been absorbed in 30 & 108}
{'COMMENT'  Chart 20 - has been absorbed in 11}

%ROUTINE send octet (%INTEGER stream, warning)
{'COMMENT'  Chart 21}
   %IF  warning <> true  %or   (octout <> h %AND  octout <> w) %THEN %START
      {'COMMENT'  Dummy statement.}
{               'CORAL' 66 requires %AND  to bind tighter than %or }
   ; %FINISH %else %start
      send and count ns message(stream, w);            {(Send 'w')}
   ; %FINISH 
      send and count ns message(stream, octout);       {(29)}
;%end


%ROUTINE process cle count (%INTEGER mt)
{'COMMENT'  Chart 22}
   %INTEGER  loc
   loc = mt + addr(c1) - 1
   %IF   mt = cle id  %AND   integer(loc)= cle limit  %THEN %START
   ;  {(Count limit reached)}
      integer(loc)= 0
      cle count = cle count + 1 
    %FINISH  %c
;%end

%ROUTINE respond to poc event
{'COMMENT'  Chart 23}
   poc = true
   do actions(m14);  {(10)}
   poc = false %c
;%end

%ROUTINE respond to incoming message
{'COMMENT'  Chart 24}
%IF  type = connect %THEN %START

   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) 
 %FINISH %else  %IF  type = accept %THEN %START

   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 %else  %IF  type = disconnect %THEN %START

   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
   ;  {(Final DISCONNECT)}
      do actions(m4);  {(10)}
      abandon command; {(32)}
   ; %FINISH %else  %c
   do actions(m3);  {(Initial DISCONNECT)}
;%finish %c
%else  %IF  type = data %THEN  %c
   do actions(m5)  %c
%else  %IF  type = address %THEN %START

   store param(in buf, adrin);  {(Address part)}
  dum = getch(in buf);  {(Pass the length octet of qualifier)}
  dum = getch(in buf);  qualifier = ch
   do actions(m6) 
 %FINISH %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
   ;  {(Matching RESET)}
      do actions(m10)
      abandon command 
    %FINISH %else  %c
   do actions(m9);  {(Initial RESET)}
;%finish
  %end


%INTEGERFN response parameters check
{'COMMENT'  Chart 25.        (Parameters 1 to 14)}
   %INTEGER  count, n
   %for count = 1 , 1 , 14  %cycle
     dum = getch(comd);  n = ch;  {(Length of response parameter)}
      %IF  n<1 %or  n>response size %THEN  %RESULT = false
                                 ;{(Response wrong length)}
         %cycle; n= n-1; %exit %if n < 0
        dum = getch(comd)
         %IF  ch = 0 %or  ch > 20 %THEN  %RESULT = false
      %repeat;           {(Erroneous primitive action)}
   %repeat
   %RESULT = true
%end


%INTEGERFN cle parameters check
{'COMMENT'  Chart 26.            (Parameters 15 and 16)}
  dum = getch(comd);  {(Get the length octet)}
   %IF  ch <> 1 %THEN  %RESULT = false; {(Parameter 15 not a single octet)}
  dum = getch(comd);  {(Cle_id)}
   %IF  ch > 56 %THEN  %RESULT = false;  {(Count limit identifier wrong)}
  dum = getch(comd);  {(Length octet);}
{   %IF  ch <> 2 %THEN  %RESULT = false;}
{                         ;(Parameter 16, Count Limit, not 16 bits)}
   %RESULT = true %c
;%end


%INTEGERFN source parameters check
{'COMMENT'  Chart 27.            (Parameters 17 to 24)}
   %INTEGER  count
  dum = getch(comd); dum = getch(comd); dum = getch(comd)
      ;{(Pass by Cle_limit to length octet of As_stream)}
   %IF  ch <> 1 %THEN  %RESULT = false;  {(Parameter 17 not single octet)}
  dum = getch(comd);  {(As_stream)}
   %IF  ch <> 0 %AND  ch <> 1 %AND  ch <> 2 %c
   %THEN  %RESULT = false;  {(As_stream number wrong)}
   %for count = 18 , 1 , 23  %cycle
     dum = getch(comd);                   {(Length octet)}
      %IF  ch <> 1 %THEN  %RESULT = false
                                   ;{(Parameter value not a single octet)}
     dum = getch(comd);                   {(Pass over parameter)}
   ;%repeat
  dum = 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

%ROUTINE send parameter
{'COMMENT' Chart 28.  Assumes that the getpntr of reply points to}
{the parameter.  Leaves this past the parameter}
   %INTEGER  count
  dum = getch(reply);  count = ch;  {(Parameter length)}
   octout = count
   send octet(reply stream, no warn);        {(21)}

      %cycle; count = count-1; %exit %if count < 0
     dum = getch(reply);  octout = ch
      send octet(reply stream, no warn) %c
   ;%repeat; %c
;%end

%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
   ;                    {(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
      %IF  message type = 34 %THEN %START
       %c
         message type = 41;  {(Corrects for ADDRESS following DATA)}
         context = 0;        {(Corrected to $*)}
      ; %FINISH 

      %IF  message type <> 33 %AND  message type <> 36 %THEN  %c
         last out was data = false;    {(Neither DATA nor EXPEDITED)}
   ;%finish %c
   %else  %IF  message type = 33 %THEN  %c
         last out was data = true

   %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

   %IF  message type = 32 %or  message type = 38 %THEN  %c
      abandon command;  {(Final DISCONNECT or Matching RESET -(32))}

   loc = message type + addr(c1) - 1
   count =integer(loc)+ 1
   integer(loc)= count;  {(Increment message count)}

   %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.)}

   process cle count(message type);    {(22)}
;%end

%ROUTINE %c
 send reply (%INTEGER isadr, reply type, reply length)
{'COMMENT' Chart 30.  Param_list occupies the block reply}
   %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)}

   reply(getpntr)= 0
                  ;{(Prepare to read the first parameter from reply)}
   param count = reply length
      %cycle; param count=param count-1; %exit %if param count < 0
      send parameter;  {(28)}
      %repeat

   %IF  isadr = true %THEN %START
   ;  {(Address parameter)}
      out buf(putpntr)= 0
      ch = push; dum = putch(out buf)
      send and count ns message(push, none);        {(29)}
      reply(getpntr)= reply(getpntr)-1
         ;{(Prepare to read last octet of reply again)}
     dum = getch(reply);  {(Fetch qualifier to ch)}
      %IF  ch = 0 %THEN  ch = 1 %else  %c
      %IF  ch = 1 %then  ch = 0;  {(Reverse qualifier - 'Chart 19')}

      reply(putpntr)= reply(getpntr)- 1
         ;{(Prepare to write last octet of reply again)}
     dum = putch(reply);  {(Reversed qualifier in reply)}
      out buf(putpntr)= 0;  ch = address; dum = putch(out buf)
                                               ;{(Type octet)}
      copy(reply, out buf);  {(Append address and qualifier)}
      send and count ns message(address, none);            {(29)}
   ; %FINISH 

   send(t);  {(Trailer 'T')}

   %IF  isadr = true %or  reply stream = data %THEN %START
    %c
      out buf(putpntr)= 0
      ch = push; dum = putch(out buf)
      send and count ns message(push, none);        {(29)}
   ; %FINISH %else   send and buffer ns message(forward buffered output, none, %c
                                      message type, context) ;  {(33)}
;%end


{'COMMENT'  Chart 31 - has been absorbed in chart 33}

%ROUTINE abandon command
{'COMMENT' Chart 32}
   d command = false
   e command = false
   d suspense = false
   e suspense = false
   abandon = true %c
;%end

%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

   %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)}
     dum = putch(nsidu out);  {(Type octet)}
      ch = pp - 2
     dum = 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

   matching = false;          {(Will be set to true only for a Final}
{                                DISCONNECT or a Matching RESET)}
   %IF  mt = forward buffered output %THEN %START
   ;                              {(This is 'Chart 31')}
      %IF  heldout <> none %THEN  send nsidu
      -> return
   ; %FINISH 

   %IF  heldout <> none %THEN %START
    %c
      %IF  mt <> heldout %THEN  send nsidu %c
      %else  -> store octet 
    %FINISH 

   %IF  mt <> data %AND  mt <> expedited %THEN %START
    %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 
    %FINISH %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 

store octet: %c
   ch = datum
  dum = putch(nsidu out)
   %IF  nsidu out(putpntr)= nsidu size %c
      %THEN   send nsidu
return: %c
;%end

%ROUTINE act 2
{'COMMENT'  Chart 102:  Primitive Action 2:  Send a CONNECT message}
{   using Outgoing Called address}
send connect(oad1)

%end

%ROUTINE act 3
{'COMMENT'  Chart 103:  Primitive Action 3:  Send a CONNECT message}
{   using Incoming Calling address}
send connect(iad2)

%end

%ROUTINE act 4
{'COMMENT'  Chart 104:  Primitive Action 4:  Send a CONNECT message}
{   using Incoming Recall address}
send connect(iad3)

%end

%ROUTINE act 5
{'COMMENT'  Chart 105:  Primitive Action 5:  Send an ACCEPT message}
   out buf(putpntr)= 0
   ch = accept; dum = 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

%ROUTINE act 6
{'COMMENT'  Chart 106:  Primitive Action 6:  Send a DISCONNECT message}
   out buf(putpntr)= 0
   ch = disconnect; dum = putch(out buf);  {(Type octet)}
   %IF  invalid = true %THEN %START
   ;  {(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 %else  %c
   %IF  poc = false %THEN %START
   ;  {(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 %else  %c
   %IF  context <> 1 %AND  context <> 7 %AND  context <> 9 %THEN %START
   ;  {(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) 
    %FINISH ;  {(Otherwise do nothing - DISCONNECT would be a POC)}
;%end

%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


%ROUTINE act 8
{'COMMENT'  Chart 108:  Primitive Action 8:  Echo a received address}
{   with reversed qualifier}
   out buf(putpntr)= 0
   ch = address; dum = putch(out buf);  {(Type octet)}
   fetch param(adrin, out buf)
   ch = 1; dum = putch(out buf);  {(Length octet)}

   ch = qualifier
   %IF  ch = 0 %THEN  ch = 1 %else  %c
   %IF  ch = 1 %then  ch = 0;  {(Reverse Qualifier - 'Chart 19')}
  dum = putch(out buf)
   send and count ns message(address, none);  {(29)}
;%end


%ROUTINE act 9
{'COMMENT'  Chart 109:  Primitive Action 9:  Send a PUSH message}
   out buf(putpntr)= 0
   ch = push; dum = putch(out buf);  {(Type octet)}
   send and count ns message(push, none);  {(29)}
;%end


%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

%ROUTINE act 11
{'COMMENT'  Chart 111:  Primitive Action 11:  Send a RESET message}
   out buf(putpntr)= 0
   ch = reset; dum = putch(out buf);  {(Type octet)}
   %IF  invalid = true %THEN %START
   ;  {(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 %else  %c
   %IF  poc = true %THEN %START
    %c
      %IF  context <> 1 %AND  context <> 2 %AND  context <> 3 %AND  %c
           context <> 7 %AND  context <> 9 %AND  context <> 10 %THEN %START
       ;{( 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) 
       %FINISH  ;{( otherwise do nothing - RESET would be a POC)}
   ;%finish %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) 
    %FINISH 
;%end


%ROUTINE act 12
{'COMMENT'  Chart 112:  Primitive Action 12:  Start Automatic Source}
%IF  as stream <> 0 %AND  auto on = false %THEN %START

   auto on = true
   dum = drive automatic source;  {(13.  Sends an octet now, in case}
{                            the next Action stops the source)}
; %FINISH 


%end

%ROUTINE act 13
{'COMMENT'  Chart 113:  Primitive Action 13:  Stop Automatic Source}
%IF  auto on = true %or  as stream <> 0 %THEN %START

   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; dum = putch(reply)
   ch = as oct; dum = putch(reply)
   send reply(not addr, 19, 1);  {(30)}
; %FINISH 

%end

%ROUTINE act 14
{'COMMENT'  Chart 114:  Primitive Action 14:  Send a burst from}
{   Single-shot Source}
%integer burst count
%IF  ss burst > 0 %THEN %START

   burst count = ss burst
      %cycle; burst count = burst count-1; %exit %if burst count < 0
      %IF  ss oct = ss last %THEN  %c
         ss oct = ss first %else  %c
         ss oct = integer(ss oct + ss inc)&255;  {(Modulo 256)}
      %repeat
      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

%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

%ROUTINE act 16
{'COMMENT'}
{  Chart 116:  Primitive Action 16:  Store Outgoing Called address}
copy(adrin, oad1)
%end

%ROUTINE act 17
{'COMMENT'}
{  Chart 117:  Primitive Action 17:  Store Outgoing Calling address}
copy(adrin, oad2)
%end

%ROUTINE act 18
{'COMMENT'}
{  Chart 118:  Primitive Action 18:  Store Outgoing Recall address}
copy(adrin, oad3)

%end

%ROUTINE act 19
{'COMMENT'}
{  Chart 119:  Primitive Action 19:  Store Outgoing Location}
copy(adrin, oad4)

%end

%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

%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)}
{     ...     ...                ...}
{    }
      printstring("Input ns called
")
%RESULT = false
%end

%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 }
      printstring("Wait for ns input called
")
%end

%ROUTINE 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)    }
      printstring("Output ns called
")
%end

%ROUTINE supply initial values (%INTEGERARRAYname  called addr, calling addr, %c
                                 %integername  connect mode)
  {'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. }
      printstring("Supply initial values called
")
%end


{'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 }

{'COMMENT'  Here begin the statements of the Test Responder, i.e.}
{           the body of the "Main_loop"}
   %ROUTINE syntax error
      respond to invalid command event;  {(8)}
   ;%end

   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)}

   command type = octin
   %IF  command type < 1 %or  command type > 19 %THEN  %c
      syntax error %and -> again;  {(Command type out of range)}

   %IF  read command octet = false %THEN  -> again;    {(3)}
   param count = octin
   %IF  param count checks with command type = false %c
      %THEN  syntax error %and -> again
         ;{(param count checks with command type is (5))}

   comd(putpntr)= 0;  {(Chart 204 has been incorporated into Main)}
                        ;{(Prepare to write command to block comd)}
      %cycle; param count = param count-1; %exit %if param count<0
      %IF  read parameter = false %THEN  -> again
      %repeat
        ;{(read parameter is (6))}
    {'COMMENT' Now all parameters have been stored in comd}

   %IF  read command octet = false %THEN  -> again;    {(3)}

   d command = false;                {(End of command)}
   e command = false

   %IF  octin <> t %THEN  syntax error %and -> again
              ;{(Trailer)}

   comd(getpntr)= 0;  {(Prepare to read the command)}
   respond to command;  {(7)}
   -> again
%endofprogram