Source file: P#B       Compiled: 30-MAY-1984  15.11.52
Object file: PCMA#REL

         Edinburgh IMP77 Compiler - Version 8.2 release 3

     1  
     2  !**********************************************************
     3  !*                                                        *
     4  !*       RCO ITP to XXX Protocol Conversion Module        *
     5  !*                                                        *
     6  !*                       PCMA                             *
     7  !*                                                        *
     8  !*           Version     9.24 24 May  1984                *
     9  !*                                                        *
    10  !**********************************************************
    11  
    12  !*
    13  %control 1 ;!No record checking.
    14  !*
    15  %begin
    16  ! Options used:PCMA_NSOURCE,P#B,F,G
    17  !*
    18  !**************************
    19  !*                        *
    20  !*    Declarations        *
    21  !*                        *
    22  !**************************
    23  
    24  !****** Constintegers ******
    25  !*
    26  
    27  !States
    28  %constinteger estb = 2
    29  %constinteger wait data = 1
    30  %constinteger disconnected = 0
    31  
    32  %include "ercm06.INC_VARIOUS"
&    0  !Various useful consts etc
&    1  
&    2  %CONSTINTEGER TRUE                     =  1
&    3  %CONSTINTEGER FALSE                    =  0
&    4  %CONSTINTEGER CR                       = 13
&    5  %CONSTINTEGER LF                       = 10
&    6  
&    7  !Buffer Manager Consts
&    8  
&    9  %CONSTINTEGER LONG                     =  0
&   10  %CONSTINTEGER SHORT                    =  1
&   11  %CONSTINTEGER REQUEST BUFFER           =  0
&   12  %CONSTINTEGER RELEASE BUFFER           =  1
&   13  
&   14  %CONSTBYTENAME TT SER                  == K'160061'
&   15  %constbytename id                      == k'160030'
&   16  %CONSTBYTENAME OWN ID                  == K'160030'
&   17  %CONSTBYTENAME INT                     == K'160060'
&   18  %CONSTINTEGERNAME NO OF BUFF           == K'100112'
&   19  %CONSTINTEGERARRAYNAME BMS             == K'100112' ;!Buffer Manager Statistics
&   20  %CONSTBYTENAME CHANGE OUT ZERO         == K'160310'
&   21  
&   22  !*Standard stream numbers
&   23  !
&   24  %CONSTINTEGER DOC INPUT CR             = 12
&   25  %CONSTINTEGER DOC INPUT PR             = 13
&   26  %CONSTINTEGER LP STREAM                =  4
&   27  %CONSTINTEGER ITP STREAM               = 18
&   28  %CONSTINTEGER INFO STREAM              = 21
&   29  %CONSTINTEGER TIME STREAM              = 22
&   30  %CONSTINTEGER FTP STREAM               = 16
&   31  
&   32  %ENDOFFILE
    33  !#if  m(=false)
    34  {%include "ercm06.inc_minconf"}
    35  !#else(=true)
    36  !#if  g(=true)
    37  %include "ercm06.inc_configglas"
&    0  ! Configuration file for Glasgow
&    1  
&    2  ! Options used:INC_CONFIGGEN,TEMP,G,CLEAN
&    3  %conststring (8) datestring="25/04/84"
&    4  
&    5  !Versions required:
&    6  
&    7  
&    8  ! System            Name  Accred Nets  Procs*    Disc Drv Prep
&    9  
&   10  ! P PSSE            PSSE  Yes    2+1   16  6 10  RL01 0     P
&   11  ! M XGATE           XGATE  No    1+1   37 20 40  RL01 0     M
&   12  ! K Kent            GATE  Yes    1+1   16  6 10  RL02 0     K
&   13  ! U Kent #2         SGATE Yes    1+2   ?? ?? ??  RK05 0     U
&   14  ! G Glasgow         GGATE  No    1+2   16  6 31  RX02 1     G
&   15  ! F FEP (GATEX)     -      No     +2   60 20 40  -    -     H
&   16  
&   17  !Disc Configuration Information
&   18  !Define first and last user blocks to prevent us overwriting directory
&   19  !etc. Ranges for various discs are:
&   20  !RK05: 400 - 10767.    RL01: 400 - 21757. RX02:  241 - 1750. (octal)
&   21  
&   22  %constinteger drive                    = 0
&   23  %constinteger fsys                     = 8_33
&   24  %constinteger lub                      = 8_241
&   25  %constinteger hub                      = 8_1750
&   26  %constinteger blocksize                = 512
&   27  %constinteger maxblocks                = 128 
&   28  !maxblocks is largest Acct/Help/Alert/Name/Mnemonic file
&   29  
&   30  !NSI ports and facility numbers
&   31  !Set Gateport 2 = Gateport 1 if only 1 ring/NSI gateway
&   32  !Nothing terrible will happen if you get these wrong - Source addresses
&   33  !will not be correctly interpreted in the USERS ALL command etc is all
&   34  
&   35  %constinteger gate port 1              = 11 ;!Ring port of Ring - NSI Gateway
&   36  %constinteger gate port 2              = 12 ;!2nd ring/NSI Gateway 
&   37  
&   38  !X25 Level 3 options
&   39  
&   40  %constinteger max l3 packet            = 256 ;!Max Level 3 packet size in bytes
&   41  
&   42  !Procs, TSB procs, LCNs
&   43  
&   44  %constinteger no of procs              = 16 ;!No of simultaneous users
&   45  %constinteger no of tsb procs          = 6
&   46  %constinteger no of lcns               = 31 ;!No of X25 LCNs subscribes to
&   47  
&   48  %constinteger no of nets             = 2
&   49  %constinteger no of x25 nets         = 1
&   50  %constinteger sercline               = 0
&   51  %constinteger pssline                = 1
&   52  %constinteger rcoline                = 2
&   53  %constinteger no of rco nets         = 1
&   54  %conststring (5) sysname              = "GGATE"
&   55  %conststring (7) syspass             = "YAHOO"
&   56  %conststring (4) %array longnetname(-1:2) = "????","X25 ","????","RCO "
&   57  %conststring (1) %array shortnetname(-1:2) = "?","X","?","R"
&   58  
&   59  !                                               
&   60  !     Other things that need to be altered      
&   61  !                                               
&   62  
&   63  ! The text "RCONET" in the welcome message in BRIDGE
&   64  ! The text "PSSE/"  in the Command: prompt in BRIDGE
&   65  
&   66  %endoffile
    38  !#else(=false)
    39  {%include "ercm06.INC_CONFIG"}
    40  !#fi
    41  !#fi
    42  %include "ercm06.INC_DISCQUALS"
&    0  !*Disconnect qualifiers
&    1  !*From PSS:
&    2  %constinteger pss prot not supported   = x'43'
&    3  
&    4  !*Transport Service
&    5  !
&    6  %constinteger ts ok                    = 0
&    7  %constinteger ts response              = 1
&    8  %constinteger ts no connection         = 16
&    9  %constinteger ts numberbusy            = 17
&   10  %constinteger ts out of order          = 18
&   11  %constinteger ts invalid address       = 19
&   12  %constinteger ts access barred         = 20
&   13  %constinteger ts incompatible facilities=21
&   14  %constinteger ts no reverse charging   = 22
&   15  %constinteger ts network congestion    = 23
&   16  %constinteger ts message too long      = 24
&   17  %constinteger ts protocol apology      = 32
&   18  %constinteger ts protocol accusation   = 33
&   19  %constinteger ts timeout               = 34
&   20  %constinteger ts connection lost       = 35
&   21  %constinteger ts flow control error    = 36
&   22  %constinteger ts congestion            = 37
&   23  %constinteger ts network failure       = 38
&   24  %constinteger ts application failure   = 39
&   25  %constinteger ts transport service fail= 40
&   26  %constinteger ts operator abort        = 41
&   27  %constinteger ts transport service abor= 42
&   28  %constinteger ts going out of service  = 43
&   29  %constinteger ts disconnect after reset= 44
&   30  %constinteger ts reset before accept   = 45
&   31  
&   32  !*Internally generated
&   33  %constinteger reply                    = x'80'
&   34  %constinteger invalid user             = x'81'
&   35  %constinteger invalid pass             = x'82'
&   36  %constinteger cause unknown            = x'83'
&   37  %constinteger shutdown imminent        = x'84'
&   38  %constinteger prot not supported       = x'85'
&   39  %constinteger no loopback              = x'86'
&   40  %constinteger softly softly            = x'87'
&   41  %constinteger no free lcns             = x'88'
&   42  %constinteger gateway full             = x'89'
&   43  %constinteger conversation terminated  = x'8A'
&   44  %constinteger call cleared             = x'8B'
&   45  %constinteger facility unavailable     = x'8C'
&   46  %constinteger process running          = x'8D'
&   47  %constinteger no user service          = x'8E'
&   48  !%CONSTINTEGER NO FUNDS                 = X'8F'
&   49  %constinteger accounting failure       = x'90' ;!Account or Mnemonic file full or non-existant
&   50  %constinteger bad param                = x'91'
&   51  %constinteger session level error      = x'92'
&   52  %constinteger network down             = x'93'
&   53  %constinteger call collision           = x'94'
&   54  %constinteger far end hung             = x'95'
&   55  %constinteger packet level error       = x'96'
&   56  %constinteger lcn conflict             = x'97'
&   57  %constinteger call reset               = x'98'
&   58  %constinteger operator abort           = x'99'
&   59  %constinteger timed out                = x'9A'
&   60  %constinteger user abort               = x'9B'
&   61  %constinteger call restarted           = x'9C'
&   62  %constinteger facs not negotiable      = x'9D'
&   63  %constinteger spurious clear req       = x'9E'
&   64  %constinteger bad interface params     = x'9F'
&   65  %constinteger unknown failure          = x'A0'
&   66  %constinteger short call accepted      = x'A1'
&   67  %constinteger short interaction        = x'A2'
&   68  %constinteger short interaction fails  = X'A3'
&   69  
&   70  %endoffile
    43  %include "ercm06.INC_XGTFNS"
&    0  !New X-25 Gate to task Interface - extended set to include Accounting
&    1  !Functions:
&    2  
&    3  !Accounting Functions:
&    4  %constinteger accredit user pass       = 40
&    5  %constinteger process command          = 41
&    6  %constinteger accredit reply           = 42
&    7  %constinteger command reply            = 43
&    8  %constinteger log call start           = 44
&    9  %constinteger checkpoint               = 45
&   10  %constinteger log call end             = 46
&   11  %constinteger end call reply           = 46
&   12  %constinteger hello                    = 47
&   13  %constinteger abort session            = 48
&   14  %constinteger broadcast                = 49
&   15  %constinteger goodbye                  = 50
&   16  %constinteger log session end          = 51
&   17  %constinteger noticeboard              = 52
&   18  
&   19  !Transport Functions:
&   20  %constinteger connect                  =  1
&   21  %constinteger accept call              =  2
&   22  %constinteger disconnect               =  3
&   23  %constinteger enable input             =  4
&   24  %constinteger enable output            =  4
&   25  %constinteger put output               =  5
&   26  %constinteger input here               =  5
&   27  %constinteger expedited data           =  6
&   28  %constinteger reset                    =  7
&   29  %constinteger datagram                 =  8
&   30  %constinteger datagram reply           =  9
&   31  
&   32  %constinteger enable facility          = 10
&   33  %constinteger disable facility         = 11
&   34  %constinteger put control output       = 12
&   35  %constinteger control input here       = 12
&   36  %constinteger control data             = 12
&   37  
&   38  %constinteger ack                      =  4
&   39  %constinteger data                     =  5
&   40  %constinteger prod                     = 21
&   41  %constinteger poke                     = 22
&   42  %constinteger no goaheads              = 23
&   43  
&   44  %endoffile
    44  %include "ercm06.INC_SERS"
&    0  !PSS Gateway Service Numbers
&    1  
&    2  !DEIMOS hardware driver sers etc
&    3  ! 1 tty #1
&    4  ! 2 CLI
&    5  ! 3 DK
&    6  ! 4 DIRT
&    7  ! 5 LOAD
&    8  ! 6 TU16 (-5) & MOTH
&    9  ! 8 Big disc #1 - ERTE Big disc handler BDKH
&   10  ! 9 Big Disc #1 DIR
&   11  !11 DQS11S (KMC/DU11)
&   12  !12 LP
&   13  !13 LP #2 ?
&   14  !17 Spool
&   15  !18 SPCI
&   16  !19 tty #2
&   17  !20 CLI #2
&   18  !21 tty #3
&   19  !22 CLI #3
&   20  !23 CR
&   21  !24 GP
&   22  !25 PR
&   23  !28 Big Disc #2 (DIRT)
&   24  !29 Big Disc #2 DIR
&   25  
&   26  !Globally accepted Services:
&   27  %constinteger buffer manager           = 17
&   28  %constinteger t3 ser                   = 21 ;!Buffered tty I/O
&   29  %constinteger gate ser                 = 16 ;!NSI Level 3 handler
&   30  !%CONSTINTEGER FROM PROT               = 10 ;!HDLC level 2 handler (No. Used by Gate)
&   31  
&   32  !Gateway Specials:
&   33  %constinteger test ser                 = 23 ;!Not a DEIMOS Ser. Note clash with pcmc
&   34  %constinteger tsb ser                  = 19 ;!Transport Service Bridge
&   35  !! %constinteger ftp ser                  = 19
&   36  %constinteger gatex ser                = 24
&   37  %constinteger kernel ser               = 11
&   38  %constinteger from xprot               = 11
&   39  %constinteger loop ser                 = 20
&   40  %constinteger loopb ser                = 18 ;!Not a DEIMOS Ser.
&   41  %constinteger rloop ser                = loop ser
&   42  %constinteger glue ser                 = 26
&   43  %constinteger pcma ser                 = 22
&   44  %constinteger pcmb ser                 = 25
&   45  %constinteger pcmc ser                 = 23
&   46  %constinteger pcmd ser                 = 23 ;!Note clash with pcmc
&   47  %constinteger bridge ser               = 29
&   48  %constinteger account ser              = 27
&   49  %constinteger time ser                 = 28 ;!Not a DEIMOS Ser
&   50  %constinteger pftp ser                 = 21 ;!Not a DEIMOS Ser
&   51  
&   52  %endoffile
    45  %include "ercm06.INC_ITPBITS"
&    0  !Value of control bits used in ITP
&    1  
&    2  %CONSTBYTEINTEGER CONTROLBIT           =  1
&    3  %CONSTBYTEINTEGER GOAHEADBIT           =  2
&    4  %CONSTBYTEINTEGER GOODBYEBIT           =  4
&    5  %CONSTBYTEINTEGER HELLOBIT             =  8
&    6  %CONSTBYTEINTEGER BREAKINBIT           =  1
&    7  %CONSTBYTEINTEGER SETMODEBIT           =  2
&    8  %CONSTBYTEINTEGER KILLRXBIT            =  4
&    9  %CONSTBYTEINTEGER KILLTXBIT            =  8
&   10  %CONSTBYTEINTEGER BINCHARBIT           =  1
&   11  %CONSTBYTEINTEGER TERMINATEBIT         =  2
&   12  %CONSTBYTEINTEGER PROMPTBIT            =  4
&   13  %CONSTBYTEINTEGER MARKERBIT            =  8
&   14  %CONSTBYTEINTEGER SEQVALIDBIT          = 32
&   15  %CONSTBYTEINTEGER SEQNOBITS            =192
&   16  %CONSTBYTEINTEGER BINARY               =  1
&   17  %CONSTBYTEINTEGER CHARACTER            =  0
&   18  
&   19  %ENDOFFILE
    46  
    47  !Reasons for grabbing buffers
    48  %constinteger set parameters           =  3
    49  %constinteger read parameters          =  5
    50  %constinteger setread parameters       =  7
    51  %constinteger parameters indication    =  1
    52  %constinteger break indication         =  9 ;!Short
    53  %constinteger send hello               = x'81' ;!Short
    54  %constinteger pss data                 =  6 ;!Long
    55  %constinteger rco data                 =  8 ;!Long
    56  
    57  !Monitor Calls
    58  %constinteger grotted 1                =  1
    59  %constinteger grotted 2                =  2
    60  %constinteger query                    =  3
    61  %constinteger bad process              =  4
    62  %constinteger grotted 3                =  5
    63  %constinteger grotted 4                =  6
    64  %constinteger from rco                 =  8
    65  %constinteger from pss                 =  9
    66  %constinteger mon to pss               = 19
    67  %constinteger mon to rco               = 26
    68  %constinteger push error = 33
    69  %constinteger pop error = 34
    70  
    71  !ITP control bits
    72  %constinteger qbit                     =  1
    73  %constinteger morebit                  = 16
    74  %constinteger pss setmodebit           =  2
    75  %constinteger pss readmodebit          =  4
    76  
    77  
    78  !Various consts
    79  %constinteger unallocated = 0
    80  %constinteger timeout = 10
    81  %constinteger window                   =  2
    82  %constbytearray p13(0:15) = 0,2,0,2, 2,2,0,0, 1,1,0,0, 0,1,0,1
    83  
    84  !*
    85  !****** End of Constintegers ******
    86  !*
    87  
    88  
    89  !*
    90  !****** Recordformats ******
    91  !*
    92  %include "ercm06.INC_FORMATS"
&    0  %constinteger hdrl = 8 ;!Length of dummy area before data field
&    1  %recordformat qf(%record (qf) %name link, %integer count)
&    2  %recordformat ts29f(%string (255) s %or %byte octet1 %or %bytearray a(0:255))
&    3  %recordformat itpf(%byte cnsl, hb2, hb3, (%string(255) s %or %bytearray a(0:255)))
&    4  %recordformat x25f(%byte octet1, lcn, fn, %bytearray a(0:255))
&    5  %recordformat mef(%record (mef) %name link, %byte l,type, %c
&    6+        (%bytearray a(0:251) %c
&    7+    %or (%string(4) padding, %byte octet1, lcn, fn ,(%bytearray data(0:243) %or %record (itpf) itp %or %record (ts29f) ts29)) %c
&    8+    %or %string(250) s ))
&    9  %recordformat pf(%byte ser, reply, %c
&   10+    ((%byte fn, (%byte s1 %or %byte process), ((%record (mef) %name m, (%byte gate port %or %byte len), %byte task port) %or %string(3) facility)) %c
&   11+ %or (%byte a1, a2, b1, b2, c1, c2) %or (%integer a, b, c)))
&   12  
&   13  %recordformat cvf((%byte l, (%byte reason, cause, diags, %bytearray our ct(0:3), our segs(0:7),pss ct(0:3), pss segs(0:7)) %c
&   14+                          %or %bytearray a(0:26)) %c
&   15+                %or %string(27) s)
&   16  
&   17  %endoffile
    93  
    94  %recordformat sidef(%byte proc, state, inputs, outputs, timer, reason, user,%c
    95+ br pending, %record (mef) %name discptr, %record (qf) inq, outq, %record (mef) %name outb)
    96  
    97  %recordformat procf(%record (sidef) rco,pss, %bytearray profile(0:37), %integer cnsl, lastchar)
    98  
    99  !*
   100  !****** Monitoring Information ******
   101  !*
   102  %ownbyte monbyte = 3 ;!EXT
   103  !Disaster = 3, Exception = 2, Log = 1, Query = 0
   104  %constbytearray monaction(0:39) = %c
   105+ 2, 1, 2, 2, 2, 2, 3, 2, 1, 1, 1, 2, 1, 1, 1, 1,
   106+ 2, 3, 3, 1, 1, 1, 3, 3, 1, 1, 1, 1, 1, 1, 3, 3,
   107+ 1, 2, 1, 1, 1, 1, 1, 1
   108  ! %ownintegerarray moncount(0:39) = 0(40)  ;! Ruth 15/3/84
   109  !*
   110  !****** Names ******
   111  !*
   112  %ownrecord (procf) %name process
   113  %ownrecord (sidef) %name rco
   114  %ownrecord (sidef) %name pss
   115  %ownrecord (sidef) %name this side
   116  %ownrecord (sidef) %name other side
   117  !*
   118  !****** Records and Recordarrays ******
   119  !*
   120  %constrecord (qf) %name null == 0
   121  %ownrecord (pf) p = 0
   122  %owninteger buffers held = 0
   123  %ownrecord (procf) %array proctab(1:no of procs) = 0(no of procs)
   124  !*
   125  !****** Routine Specs ******
   126  !*
   127  %include "ercm06.INC_EXTS"
&    0  !Commonly Used Externals
&    1  
&    2  %externalroutinespec alarm(%integer ticks)
&    3  %externalroutinespec linkin(%integer ser)
&    4  %externalintegerfnspec dup addr(%integer seg)
&    5  %externalintegerfnspec map abs(%integer adr, len, req id)
&    6  %externalroutinespec map hwr(%integer seg)
&    7  %externalintegerfnspec get id
&    8  %externalroutinespec map virt(%integer ser,seg1,seg2)
&    9  %externalroutinespec set prio(%integer n)
&   10  %externalroutinespec pon(%record (*) %name p)
&   11  %externalroutinespec ponoff(%record (*) %name p)
&   12  %externalroutinespec poff(%record (*) %name p)
&   13  
&   14  %endoffile
   128  %routinespec ask for buffer(%byte reason)
   129  %integerfnspec find(%byte element, %bytearrayname list) ;!EXT
   130  %routinespec free buffer(%record (mef) %name mes) ;!EXT
   131  %routinespec buffer arrived
   132  %routinespec handle clock tick
   133  %routinespec handle interrupt
   134  %routinespec handle pss inq
   135  %routinespec handle outq(%record (sidef) %name side)
   136  %routinespec handle ts packet(%byte ser)
   137  %routinespec handle rco inq
   138  %routinespec maybe ack(%record (sidef) %name side)
   139  !#if  ~f(=false)
   140  {%routinespec monitor(%record (pf) %name p, %integer type) ;!EXT}
   141  !#fi
   142  %routinespec query processes
   143  %routinespec pass on(%record (pf) %name p)
   144  %record (qf) %mapspec pop(%record (qf) %name q) ;!EXT
   145  %routinespec push(%record (qf) %name q,item) ;!EXT
   146  %routinespec send(%record (mef) %name mes, %c
   147+ %integer fn,%record (sidef) %name side)
   148  %routinespec stop(%integer reason)
   149  !*
   150  !****** Others ******
   151  !*
   152  %constbytearray rco set no(-1:6) = 7,  1,14,7,8,17,3,11 ;!Mappable RCO setmodes
   153  %constbytearray pss set no(-1:6) = 7,  2,9,16,17,12,10,10 ;!Equivalent PSS setmodes
   154  !Next declaration must be own to allow it to be used as a string
   155  !Default Profile:
   156  !The values tagged with x'40' will be sent in the Set & Read message
   157  !at start of connection
   158  %ownbytearray profile(0:37) = 37,2,
   159+ 1,1,x'42',1,x'43',2,4,0,5,0,6,1,x'47',1,8,0,
   160+ x'49',0,x'4A',80,11,0,x'4C',0,x'4D',4,14,0,15,1,16,127,17,24,18,18
   161  !************************
   162  !*                      *
   163  !*    Main Program      *
   164  !*                      *
   165  !************************
   166  !*
   167  change out zero = t3 ser
   168  printstring("PCMA Version     9.24 24 May  1984 (Fast,Large)
   169+ ")
   170  
   171  linkin(pcma ser)
   172  map virt(buffer manager, 6, 5)
   173  map virt(buffer manager, 5, 4)
   174  
   175  process == proctab(0)
   176  
   177  p_ser = gatex ser
   178  p_reply = pcma ser
   179  p_fn = enable facility
   180  p_facility = "XXX"
   181  p_s1 = 0
   182  pon(p)
   183  
   184  !Tell ACCOUNT we're up
   185  p_ser = account ser
   186  p_reply = pcma ser
   187  p_fn = hello
   188  p_s1 = pcma ser
   189  pon(p)
   190  
   191  alarm(100)
   192  
   193  %cycle
   194     p_ser = 0
   195     poff(p)
   196     %unless p_m == null %or p_reply = 0 %start
   197        buffers held = buffers held + 1
   198        stop(grotted 1) %if 0 # p_m_type # 64
   199     %finish
   200     %if p_reply = 0 %start
   201        handle clock tick 
   202  
   203     %elseif p_reply = buffer manager
   204        buffer arrived
   205  
   206     %else
   207        handle ts packet(p_reply)
   208  
   209     %finish
   210  %repeat
   211  
   212  !*********************
   213  !*                   *
   214  !*    Routines       *
   215  !*                   *
   216  !*********************
   217  
   218  
   219  
   220  %routine ask for buffer(%byte reason)
   221     !This routine fires off a buffer request to Buffer Manager
   222     
   223     %record (pf) p
   224     
   225     p_ser = buffer manager ;p_reply = id
   226     p_fn = request buffer 
   227     p_process = process_rco_proc
   228     p_len = reason & 1
   229     p_c2 = reason
   230     pon(p)
   231     
   232  %end ;!of Ask For Buffer
   233  
   234  
   235  
   236  %routine buffer arrived
   237     %integer i,j,k,ol
   238     %record (mef) %name mes
   239     process == proctab(p_process)
   240     ol = 0
   241     mes == p_m
   242     rco == process_rco ;pss == process_pss
   243     %if p_c2 > 127 %then this side == rco %else this side == pss
   244     free buffer(mes) %and %return %unless this side_state = estb
   245  
   246     %if p_c2 = pss data %start
   247        pss_br pending = 0
   248        mes_l = 0; mes_fn = unallocated
   249        pss_outb == mes
   250        handle rco inq
   251        handle outq(pss)
   252        handle outq(rco)
   253        %return
   254  
   255     %elseif p_c2 = rco data
   256        rco_br pending = 0
   257        mes_l = 0; mes_itp_a(0) = 0; mes_fn = unallocated
   258        rco_outb == mes
   259        handle pss inq
   260        handle outq(rco)
   261        handle outq(pss)
   262        %return
   263  
   264     %elseif p_c2 = send hello ;!We tagged RCO messages by setting the top bit
   265        !Messages for RCO (assumed to speak RCO ITP)
   266        mes_itp_hb3 = 0
   267        mes_itp_a(0) = 0
   268        mes_l = 4
   269        mes_fn = data
   270        mes_itp_hb2 = controlbit ! hellobit
   271  
   272     %elseif p_c2 = break indication
   273        mes_fn = control data
   274        mes_data(0) = 3
   275        %if pss_user = 0 %start ;!He's the DTE-P - indicate function 8 is 1
   276           mes_data(1) = 8
   277           mes_data(2) = 1
   278           mes_l = 3
   279        %finishelse mes_l = 1
   280  
   281     %else
   282        !Message for PSS - Set & Read parameters
   283        mes_fn = control data
   284        mes_data(0) = p_c2 & 14
   285        j = 1
   286        %for i = 2, 2, 36 %cycle
   287           %if process_profile(i) & x'40' # 0 %start ;!We tagged it to send to PSS
   288              mes_data(j) = i>>1
   289              mes_data(j+1) = process_profile(i+1)
   290              j = j + 2
   291           %finish
   292        %repeat
   293        mes_l = j
   294     %finish
   295     push(this side_outq, mes)
   296     handle outq(this side)
   297     %return
   298  
   299  %end ;
?K unused
   300        ;!of Buffer Arrived
   300  
   301  
   302  %integerfn find(%byte element,%bytearrayname list)
   303     !Return the position of ELEMENT in LIST, counting from 0.
   304     !Return -1 if ELEMENT is not found. LIST(-1) = Length of list
   305     %integer i
   306     %for i = 0,1, list(-1)-1 %cycle
   307        %if list(i) = element %thenresult = i
   308     %repeat
   309     %result = -1
   310  %end ;!of Find
   311  
   312  %routine free buffer(%record (mef) %name mes)
   313     %record (pf) p
   314     %if mes == null %then %return ;!No buffer to free
   315     p_ser = buffer manager ;p_reply = id
   316     p_fn = release buffer
   317     p_m == mes
   318     buffers held = buffers held - 1
   319     stop(grotted 2) %if 0 # mes_type # 64
   320     pon(p)
   321  %end ;!of Free Buffer
   322  
   323  
   324  %routine handle clock tick
   325     %routinespec check timeout(%record (sidef) %name side)
   326     %integer i
   327     handle interrupt
   328     %for i = 1,1,no of procs %cycle
   329        process == proctab(i) ;rco == process_rco ;pss == process_pss
   330        check timeout(process_rco)
   331        check timeout(process_pss)
   332     %repeat
   333     alarm(100)
   334  
   335     %routine check timeout(%record (sidef) %name side)
   336        %if side_state = wait data %start
   337           side_timer = side_timer - 1
   338           %if side_timer = 0 %start
   339              free buffer(pop(side_outq)) %while side_outq_count # 0
   340              free buffer(side_outb) ;side_outb == null
   341              free buffer(pop(other side_inq)) %while other side_inq_count # 0
   342              side_outputs = 0
   343              p_s1 = far end hung
   344              send(null, disconnect, side)
   345              side_state = disconnected
   346           %finish
   347        %finish
   348     %end ;!of Check Timeout
   349  %end ;!of Handle Clock Tick
   350  
   351  
   352  %routine handle interrupt
   353     %if int = '?' %start
   354        query processes
   355  !#if  ~f(=false)
   356  {      monitor(null, query)}
   357  !#fi
   358  
   359     %elseif '0' <= int <= '9'
   360        monbyte = int - '0'
   361  
   362     %elseif int = 'N'  ;! Ruth mod 1/3/84
   363        selectoutput(1); close output
   364  
   365     %elseif int = 'V'
   366        printstring("PCMA Version     9.24 24 May  1984 (Fast,Large)") ;newline
   367  
   368     %finish
   369     int = 0
   370  %end ;!of Handle Interrupt
   371  
   372  
   373  %routine handle pss inq
   374     !Parameters Negotiation:
   375  
   376     ! Mes_data(0)  |   Params -> RCO? | Params -> PSS?
   377     !-----------------------------------------------
   378     ! 0  Param Ind |        Yes       |      No
   379     ! 2  Set Param |        Yes       |      No
   380     ! 4 Read Param |        No        |      Yes
   381     ! 6 Set & Read |        Yes       |      Yes
   382  
   383     %integer i, j, lfctrl, k, c
   384     %bytename inptr, outptr
   385     %bytearrayname in, out
   386     %record (mef) %name inb, outb
   387  
   388     %if rco_state = estb %start
   389  
   390        lfctrl = (process_profile(27)&3) ! PSS_USER
   391        lfctrl = p13(lfctrl)
   392        %while pss_inq_count # 0 %cycle
   393           %exit %if rco_outb == null
   394  
   395           inb == pss_inq_link_link ;!Point at top of Q
   396           inptr == inb_a(1); in == inb_data
   397  
   398           outb == rco_outb
   399           out == outb_itp_a
   400           outptr == outb_itp_a(0)
   401  
   402           %if inb_fn = data %start ;!User data
   403              %exit %if outb_fn = control data ;!Outb has been used for setmodes
   404              outb_fn = data
   405              outb_itp_hb2 = 0 ;!User data
   406              !We dont use the More bit
   407              outb_itp_hb3 = terminatebit
   408              !Implement suppression of data delivery to DTE-C by zapping length
   409              !of packet as it comes through.
   410              %if process_profile(17) = 1 %then inb_l = 0
   411              !Go through the block stripping parity and adding LF after CR
   412              !where instructed to by PAD param 13. (See comment at bottom of program)
   413              %while outptr < 122 %cycle
   414                 -> get next inb %if inptr >= inb_l ;!Ran out of input
   415                 c = in(inptr) & 127; inptr = inptr + 1
   416                 outptr = outptr + 1; out(outptr) = c
   417                 %if c = cr %and lfctrl # 0 %then outptr = outptr + 1 %and out(outptr) = lf
   418              %repeat
   419     
   420              outb_l = outptr + 4 %unless outptr = 0
   421              %exit
   422  get next inb:
   423              inb_fn = unallocated
   424              outb_l = outptr + 4 %unless outptr = 0
   425        
   426           %else
   427              %exit %if outb_fn = data ;!Already used for user data
   428              outb_fn = control data
   429              c = in(0)
   430              %if c & x'F9' = 0 %and inb_l & 1 # 0 %start
   431                 !Set or Set & Read Parameters, Params Indication. Length must be >= 1 and odd
   432                 %if inb_l = 1 %start ;!All parameters
   433                    %if c >= 4 %start
   434                       %for i = 1, 2, 37 %cycle
   435                          in(i) = process_profile(i) & x'3f'
   436                          in(i+1) = process_profile(i+1)
   437                       %repeat
   438                       inb_l = 37
   439                    %finish
   440                 %else
   441                    %for inptr = 1, 2, inb_l-2 %cycle
   442                       %if 1 <= in(inptr) <= 18 %start
   443                          k = in(inptr) << 1
   444                          %if c = 4 %start ;!Just read - Copy our values back
   445                            !Note we leave inb_l unchanged
   446                             in(inptr+1) = process_profile(k+1)
   447                          %else ;!Not read - Has a setting function so set
   448                             process_profile(k +1) = in(inptr+1) 
   449                             j = find(in(inptr), pss set no) ;!Can we map it?
   450                 
   451                             %if j >=0 %start ;!Mappable Setmode no.
   452                                k = process_profile(k+1)
   453                                %if in(inptr) = 10 %start ;!Line Folding
   454                                   %if k = 0 %start ;!Line length = 0 maps to set Graph mode on
   455                                      j = 6
   456                                      k = 1
   457                                
   458                                   %else ;!Otherwise, set graph mode off and then set line length
   459                                      outptr = outptr + 1; out(outptr) = 11
   460                                      outptr = outptr + 1; out(outptr) = 0
   461                             
   462                                   %finish
   463                                %finish
   464                                outptr = outptr + 1 ;out(outptr) = rco set no(j)
   465                                outptr = outptr + 1 ;out(outptr) = k
   466                             %finish
   467                          %finish
   468                       %finish
   469                    %repeat
   470                    outb_itp_hb2 = controlbit
   471                    outb_itp_hb3 = setmodebit
   472                    outb_l = outptr + 4 %unless outptr = 0
   473     
   474                 %finish
   475        
   476                 %if c >= 4 %start ;!Read or Set & Read
   477                    inb_fn = control data
   478                    in(0) = 0 ;!Parameters Indication
   479                 %finishelse inb_fn = unallocated
   480        
   481              %elseif c = 1
   482                 !Invitation to clear - map to Goodbye
   483                 outb_itp_hb3 = 0
   484                 outb_itp_hb2 = controlbit ! goodbyebit
   485                 outb_l = 4
   486        
   487              %finish
   488           %finish
   489           outb_fn = unallocated %if outb_l = 0 ;!Deallocate buffer if we never used it
   490           inb == pop(pss_inq) ;!De-queue (empty) input buffer
   491           %if inb_fn = unallocated %then free buffer(inb) %else push(pss_outq, inb)
   492           !Send the input buffer back whence it came if he read PAD parameters
   493        %repeat
   494     
   495        %unless rco_outb == null %or rco_outb_l = 0 %start
   496           !If we have any data in the out buffer, queue it for sending.
   497           rco_outb_fn = data; push(rco_outq, rco_outb); rco_outb == null
   498        %finish
   499     
   500        %if rco_outb == null %and pss_inq_count # 0 %start
   501           !If we no longer have an out buffer but do have data to reblock, get another
   502           ask for buffer(rco data) %if rco_br pending = 0
   503           rco_br pending = 1
   504        %finish
   505  
   506     %finish
   507     %return
   508  %end ;!of Handle PSS Data
   509  
   510  %routine handle outq(%record (sidef) %name side)
   511     !Sends off data waiting to go to side unless we are out of transmission window
   512     %record (mef) %name mes
   513     %byte fn
   514     %if process_cnsl # 0 %or side == process_pss %start
   515        %while side_outq_count # 0 %and side_outputs < window %cycle
   516           mes == pop(side_outq)
   517           fn = mes_fn
   518           p_s1 = 0 ;!Don't PUSH it
   519           mes_itp_cnsl = process_cnsl %if side == process_rco
   520           send(mes, fn, side)
   521        %repeat
   522     %finish
   523  
   524     %if side_state = wait data %and side_outq_count = 0 %start
   525        p_s1 = side_reason
   526        send(side_discptr, disconnect, side)
   527        side_state = disconnected
   528     %finish
   529  
   530  %end ;!of Handle outq
   531  
   532  !#if  k(=false)
   533  {!Data for UKC mod to handle block setmodes}
   534  {%constinteger blocksmlen = 5}
   535  {%constbytearray block sm offset(1:blocksmlen) = 1, 3, 5, 17, 18}
   536  {!The above are the offsets ofwithin the block of params}
   537  {!which have PSS equivalents, the corresponding PSS codes are below:}
   538  {%constbytearray block sm pss setno(1:blocksmlen) = 2, 9, 10, 16, 17}
   539  !#fi
   540  
   541  %routine handle rco inq
   542     %constbytearray nativeon(-1:13) = 14,
   543+    2, 0, 4, 1, 9, 0, 10, 0, 13, 0, 14, 0, 15, 0
   544     %constbytearray nativeoff(-1:9) = 10,
   545+    2, 1, 4, 0, 10, 80, 13, 4, 15, 1
   546     %integer j, c, v, lfctrl
   547     %bytename inptr, outptr
   548     %bytearrayname in, out
   549     %record (mef) %name inb, outb
   550  
   551     %while rco_inq_count # 0 %cycle
   552        %exit %if pss_outb == null
   553  
   554        inb == rco_inq_link_link ;!Point at top of Q
   555        inptr == inb_a(1) ;in == inb_itp_a
   556  
   557        outb == pss_outb
   558        out == outb_data
   559        outptr == outb_l
   560  
   561        %if inb_itp_hb2 & controlbit = 0 %start ;!User data
   562           %exit %if outb_fn = control data ;!Outb has  been used for ctrl
   563           outb_fn = data
   564  
   565           lfctrl = (process_profile(27) & 3) ! pss_user ! 8
   566           lfctrl = p13(lfctrl)
   567  
   568           %while outptr < 124 %cycle
   569              -> get next inb %if inptr >= in(0) ;!Ran out of input
   570              inptr = inptr + 1 ;c = in(inptr) ;!NB: inptr runs from 0 but
   571              !we unpack from in(1)...
   572  
   573              %if lfctrl # 1 %or c # lf %or process_lastchar # cr %start
   574                 !Its either not an lf or is one that doesnt need to be stripped
   575                 out(outptr) = c ;outptr = outptr + 1
   576              %finish
   577              process_lastchar = c
   578           %repeat
   579           %exit ;!to outer cycle
   580  get next inb:
   581  
   582        %elseif inb_itp_hb2 & hellobit # 0
   583           process_cnsl = inb_itp_cnsl
   584  
   585        %elseif inb_itp_hb3 & setmodebit # 0
   586           %exit %if outb_fn = data ;!Already used for user data
   587           outb_fn = control data
   588           out(0) = pss setmode bit 
   589           outptr = 1 %if outptr = 0
   590  
   591           %while outptr < 127 %cycle
   592              -> get next inb 2 %if inptr >= in(0)
   593              inptr = inptr + 1 ;c = in(inptr)
   594              -> get next inb 2 %unless 1 <= c <= 30 %and c # 10 ;!Invalid setmodes
   595  
   596              %if c = 30 %start ;!Native mode
   597                 %if in(inptr+1) = 1 %start ;!Set on
   598                    %for j = 0, 1, nativeon(-1) -1 %cycle
   599                       out(outptr) = nativeon(j) ;outptr = outptr + 1
   600                    %repeat
   601                 %else ;!Set off
   602                    %for j = 0, 1, nativeoff(-1) -1 %cycle
   603                       out(outptr) = nativeoff(j) ;outptr = outptr + 1
   604                    %repeat
   605                 %finish
   606  
   607  !#if  k(=false)
   608  {            !Code to handle UKC block setmodes}
   609  {            %elseif c = 22}
   610  {               %if inptr+18 <= in(0) %and outptr+blocksmlen*2 <127 %start}
   611  {                  %for j = 1, 1, blocksmlen %cycle}
   612  {                     v = in(inptr+blocksm offset(j))}
   613  {                     %if j = 1 %then v = ((v+2) >>1)&1 ;!echo on/off}
   614  {                     out(outptr) = blocksm pss setno(j) ;outptr = outptr + 1}
   615  {                     out(outptr) = v ;outptr = outptr + 1}
   616  {                  %repeat}
   617  {               %finish}
   618  {               -> get next inb 2}
   619  {               !End of UKC code}
   620  !#fi
   621  
   622              %else
   623                 inptr = inptr + 1 ;v = in(inptr)
   624     
   625                 j = find(c, rco setno)
   626                 %if j >= 0 %start ;!Mappable
   627                    %if j = 6 %start ;!Graph Mode
   628                       !1 (Set on) : Set Line Length to 0 (No folding)
   629                       !0 (Set off): Set Line Length to global default (80)
   630                       %if v = 1 %then v = 0 %else v = profile(21)
   631                    %finish
   632                    out(outptr) = pss setno(j) ;outptr = outptr + 1
   633                    out(outptr) = v ;outptr = outptr + 1
   634                 %finish
   635              %finish
   636  
   637           %repeat
   638           %exit ;!to outer cycle
   639  get next inb 2:
   640           outptr = 0 %if outptr = 1
   641        %finish
   642        outb_fn = unallocated %if outptr = 0 ;!Deallocate block if we never used it
   643        inb == pop(rco_inq) ;!De-queue (empty) input buffer
   644        free buffer(inb)
   645     %repeat
   646  
   647     %unless pss_outb == null %or pss_outb_fn = unallocated %start
   648        !If we have any data in the out buffer, queue it for sending
   649        push(pss_outq, outb) ;pss_outb == null
   650     %finish
   651  
   652     %if pss_outb == null %and rco_inq_count # 0 %start
   653        !If we no longer have an out buffer but do have data to reblock, get another
   654        ask for buffer(pss data) %if pss_br pending = 0
   655        pss_br pending = 1
   656     %finish
   657  
   658  %end ;!of Handle RCO Inq
   659  
   660  %routine handle ts packet(%byte ser)
   661     %record (mef) %name mes
   662     %integer gate port, task port
   663     %switch sw(connect:control data)
   664     mes == p_m
   665     task port = p_task port
   666     gate port = p_gate port
   667  !#if  ~f(=false)
   668  {   %if ser = gatex ser %then monitor(p, from pss) %else %c}
   669  {   monitor(p, from rco)}
   670  !#fi
   671     %if p_fn = poke %start
   672        p_c1 = 0 ;p_c2 = buffers held
   673        gate port = p_ser ;p_ser = p_reply ;p_reply = gate port
   674        pon(p)
   675        %return
   676     %finish
   677  
   678     %if task port # 0 %and gate port # 0 %start
   679        %if 1 <= task port <= no of procs %start
   680           process == proctab(task port)
   681           pss == process_pss ;rco == process_rco
   682           %if ser = gatex ser %then this side == pss %and other side == rco %else this side == rco %and other side == pss
   683        %else
   684  !#if  ~f(=false)
   685  {         monitor(p, bad process)}
   686  !#fi
   687           free buffer(mes)
   688           %return
   689        %finish
   690        %if connect <= p_fn <= control data %then -> sw(p_fn)
   691     %finish
   692  
   693     -> unknown
   694  
   695  sw(accept call):
   696     process = 0
   697     string(addr(process_profile(0))) = string(addr(profile(0)))
   698     !Set it up as we like it irrespective of what he says
   699     rco_proc = task port ;pss_proc = gate port
   700     rco_state = estb ;pss_state = estb
   701     process_lastchar = -1
   702     pass on(p)
   703     send(null, no goaheads, rco)
   704     %if this side == rco %start ;!We're the server, He's the PAD (User).
   705        process_cnsl = task port
   706        pss_user = 4
   707        ask for buffer(send hello) ;!RCO server requires Hello packet
   708        ask for buffer(setread parameters) ;!PSS Pad requires setmodes to establish profile
   709     %finishelse rco_user = 4
   710     -> return
   711  
   712  sw(control data):
   713  sw(data):
   714     this side_inputs = this side_inputs + 1
   715     %if other side_state = estb %start
   716        push(this side_inq, mes)
   717        mes_a(1) = 0; mes_fn = p_fn
   718    %finishelse free buffer(mes)
   719     %if this side == rco %then handle rco inq %else handle pss inq
   720     maybe ack(this side)
   721     -> return
   722  
   723  sw(disconnect):
   724     rco_proc = task port %if rco_proc = 0
   725     pss_proc = gate port %if pss_proc = 0
   726     other side_reason = p_s1 ;other side_discptr == mes
   727     free buffer(pop(this side_outq)) %while this side_outq_count # 0
   728     free buffer(pop(other side_inq)) %while other side_inq_count # 0
   729     free buffer(this side_outb) ;this side_outb == null
   730     this side_outputs = 0
   731     other side_state = wait data
   732     other side_timer = timeout
   733     -> return
   734  
   735  sw(expedited data):
   736     !Two notes:
   737     !1) This will gobble buffers if the expedited packet carries a buffer
   738     !2) No other form of break implemented yet (eg RESET)
   739     pass on(p)
   740     %if process_profile(15) = 1 %start
   741        ! Transmit INTERRUPT to DTE-P
   742  
   743     %elseif process_profile(15) = 5
   744        ! Transmit INTERRUPT plus Indication of break to DTE-P
   745        ask for buffer(break indication)
   746  
   747     %elseif process_profile(15) = 21
   748        ! Transmit INTERRUPT plus Indication of Break to DTE-P and..
   749        ! set parameter 8 to 1 (scrap data)
   750        process_profile(17) = 1
   751        ask for buffer(break indication)
   752  
   753     %else
   754        %return
   755  
   756     %finish
   757  
   758     %return
   759  unknown:
   760  sw(connect):
   761     p_s1 = 1 %if p_s1 = 0 ;!Not T.S.
   762  
   763  sw(disable facility):
   764     pass on(p)
   765     %return
   766  
   767  sw(reset):
   768  
   769     printstring("Reset in PCMA")   ;! 24/5/84
   770     newline
   771     write(this side_inputs,1)
   772     write(this side_outputs,1)
   773     write(other side_outputs,1)
   774     write(other side_inputs,1)
   775     write(this side_inq_count,1)
   776     write(this side_outq_count,1)
   777     write(other side_inq_count,1)
   778     write(other side_outq_count,1)
   779     newline
   780  
   781     process_profile(17) = 0
   782     pass on(p)
   783     %return
   784  
   785  sw(ack):
   786     this side_outputs = this side_outputs - p_s1
   787     maybe ack(other side)
   788     -> return
   789  
   790  return:
   791     handle outq(rco)
   792     handle outq(pss)
   793     %return
   794  
   795  sw(*):
   796         printstring("PCMA STOPPED: function ")
   797         write(p_fn,2);newline
   798         %cycle
   799         %repeat
   800  
   801  %end ;!of Handle TS packet
   802  
   803  %routine maybe ack(%record (sidef) %name side)
   804     %record (sidef) %name other side
   805     %if side == rco %then other side == pss %else other side == rco
   806     %if other side_outputs + side_inq_count + other side_outq_count < window %and %c
   807+    side_inputs # 0 %start
   808        p_s1 = 1 ;side_inputs = side_inputs - 1
   809        send(null, ack, side)
   810     %finish
   811  %end
   812  
   813  !#if  ~f(=false)
   814  {%routine monitor(%record (pf) %name p,%integer type)}
   815  {   %recordformat pfa(%bytearray a(0:27))}
   816  {   %record (pfa) %name pa}
   817  {   %integer i,j,k}
   818  {   %record (mef) %name mes}
   819  {   }
   820  {!   moncount(type) = moncount(type) + 1  ;! Ruth 15/3/84}
   821  {   k = monaction(type)}
   822  {}
   823  {   %if k = 0 %start}
   824  {      %return}
   825  {}
   826  {   %elseif k = 1}
   827  {      i = monbyte & 2 ;j = 0}
   828  {}
   829  {   %elseif k = 2}
   830  {      i = 1 ;j = monbyte & 1}
   831  {}
   832  {   %elseif k = 3}
   833  {      i = 1 ;j = 1}
   834  {}
   835  {   %finish}
   836  {}
   837  {   %if j # 0 %start ;!Log to .TT}
   838  {      printstring("*PCMA") ;write(type,1) ;newline}
   839  {   %finish}
   840  {}
   841  {   %if i # 0 %start}
   842  {      selectoutput(1)}
   843  {      %if p == null %start}
   844  {         printsymbol(2) ;printsymbol(pcma ser) ;printsymbol(type)}
   845  {      %else}
   846  {         %if monbyte & 4 = 0 %or p_fn = connect %or p_fn = disconnect %start}
   847  {            pa == p}
   848  {            printsymbol(10) ;printsymbol(pcma ser) ;printsymbol(type)}
   849  {            %for i = 0,1,7 %cycle}
   850  {               printsymbol(pa_a(i))}
   851  {            %repeat}
   852  {            %unless p_m == null %start}
   853  {               pa == p_m}
   854  {               printsymbol(28)}
   855  {               %for i = 0,1,27 %cycle}
   856  {                  printsymbol(pa_a(i))}
   857  {               %repeat}
   858  {            %finish}
   859  {         %finish}
   860  {      %finish}
   861  {      selectoutput(0)}
   862  {   %finish}
   863  {   %return}
   864  {%end ;!of Monitor}
   865  !#fi
   866  
   867  %routine pass on(%record (pf) %name p)
   868     %if p_reply = gatex ser %start
   869        p_ser = bridge ser
   870        p_reply = pcma ser
   871  !#if  ~f(=false)
   872  {      monitor(p, mon to rco)}
   873  !#fi
   874     %else
   875        p_ser = gatex ser 
   876        p_reply = pcma ser
   877  !#if  ~f(=false)
   878  {      monitor(p, mon to pss)}
   879  !#fi
   880     %finish
   881     %unless p_m == null %start
   882        buffers held = buffers held - 1
   883        stop(grotted 3) %if 0 # p_m_type # 64
   884     %finish
   885     pon(p)
   886  %end ;!of Pass On
   887  
   888  %routine push(%record (qf) %name q,new)
   889     %if new == null %then stop(push error)
   890     %if q_link == null %start
   891        q_link == new
   892        new_link == new
   893     %else
   894        new_link == q_link_link
   895        q_link_link == new
   896        q_link == new
   897     %finish
   898     q_count = q_count + 1
   899  %end ;!of Push
   900  
   901  
   902  %record (qf) %map pop(%record (qf) %name q)
   903     %record (qf) %name old
   904     %if q_link == null %or q_count = 0 %then stop(pop error)
   905     %if q_link_link == q_link %start ;!One element only on Q
   906        old == q_link
   907        q_link == null
   908     %else
   909        old == q_link_link
   910        q_link_link == old_link
   911     %finish
   912     q_count = q_count - 1
   913     %result == old
   914  %end ;!of Pop
   915  
   916  
   917  %routine query processes
   918     %integer i,j
   919     %routinespec monside(%record (sidef) %name side)
   920     printstring("BH=") ;write(buffers held, 1) ;newline
   921  
   922     %for i=1,1,no of procs %cycle
   923        process == proctab(i)
   924        %if (process_rco_state # disconnected %and process_pss_state # disconnected) %start ;!Has been used
   925           write(i,-2) ;printstring("/ CL:")
   926           write(process_cnsl, 1)
   927           printstring(" PRO=")
   928           %for j = 3,2,37 %cycle ;write(process_profile(j), 1) ;%repeat
   929           newline 
   930           printstring("    RCO:") ;monside(process_rco)
   931           printstring("  PSS:") ;monside(process_pss)
   932           newline
   933        %finish
   934     %repeat
   935     %routine monside(%record (sidef) %name side)
   936        write(side_proc, 2)
   937        write(side_state, 1)
   938        write(side_inputs, 1)
   939        write(side_outputs, 1)
   940        write(side_inq_count, 1) ;write(side_outq_count, 1)
   941        write(side_timer, 2)
   942        write(side_br pending, 1)
   943        printstring(" *") %unless side_outb == null
   944     %end ;!of Monside (in Query Processes)
   945  %end ;!of Query Processes
   946  
   947  
   948  
   949  
   950  
   951  
   952  
   953  
   954  %routine send(%record (mef) %name mes, %integer fn %c
   955+ ,%record (sidef) %name side)
   956     %byte q
   957     %if fn = data %or fn = control data %then side_outputs = side_outputs + 1
   958     p_reply = pcma ser
   959     p_fn = fn
   960     p_m == mes
   961     p_gate port = pss_proc
   962     p_task port = rco_proc
   963     %if side == process_rco %start
   964        p_ser = bridge ser
   965  !#if  ~f(=false)
   966  {      monitor(p, mon to rco)}
   967  !#fi
   968     %else
   969        p_ser = gatex ser
   970  !#if  ~f(=false)
   971  {      monitor(p, mon to pss)}
   972  !#fi
   973     %finish
   974     %unless p_m == null %start
   975        buffers held = buffers held - 1
   976        stop(grotted 4) %if 0 # p_m_type # 64
   977     %finish
   978     pon(p)
   979     %return
   980  %end ;
?Q unused
   981        ;!of Send
   981  
   982  %routine stop(%integer reason)
   983     printstring("PCMA Stopped") ;write(reason, 1)
   984  !#if  ~f(=false)
   985  {   monitor(null, query)}
   986  !#fi
   987     %cycle
   988     %repeat
   989  %end ;!of Stop
   990  
   991  
   992  
   993  
   994  
   995  !********************************************************
   996  !*
   997  !*          PAD Parameter 13 (LF after CR)
   998  !*
   999  !**********************************************************
  1000  
  1001  ! The RCO TCPs add a line feed to all carriage-returns echoed to the DTE-C
  1002  ! and sent to the DTE-P.  This equates to PAD parameter 13 = 6 (nearly) and is unalterable.
  1003  ! If we try to set param 13 = 6 over PSS, although the PADs add CR after
  1004  ! LF as expected, they FORWARD on CR so the LF either comes at the start of the
  1005  ! next block or sometimes by itself. This screws up prompt sequences etc. We 
  1006  ! therefore set param 13 = 4 - Add LF to CR echoed to DTE-C only.
  1007  ! RCO hosts expect all command lines to terminate in CR-LF and generate such
  1008  ! lines for all output.
  1009  !
  1010  ! PCMA therefore maps as follows:
  1011  !
  1012  ! PAD parameter 13 can be taken as follows:
  1013  !
  1014  ! If bit 2**0 = 1 the PAD will add LF to every CR transmitted to the DTE-P
  1015  ! If bit 2**1 = 1 the PAD will add LF to every CR transmitted to the DTE-C
  1016  ! If bit 2**2 = 1 the Pad will add LF to every CR echoed      to the DTE-C
  1017  !
  1018  ! For data from PSS
  1019  !
  1020  ! If the DTE-C is in PSS (and we're the DTE-P)
  1021  !
  1022  ! If 2**1 = 0 LF will not have been added to CR so we add one ourselves
  1023  ! If 2**1 = 1 LF should have been added so we leave well alone.
  1024  !
  1025  ! If the DTE-P is in PSS (and we're the DTE-C)
  1026  !
  1027  ! If 2**0 = 0 the DTE-P will have added any necessary LFs (cos it knows we wont)
  1028  ! If 2**0 = 1 it'll be expecting us to do so.
  1029  !
  1030  ! For data sent to PSS:
  1031  !
  1032  ! If the DTE-C is in PSS (and we're the DTE-P)
  1033  !
  1034  ! If 2**0 = 0 the PAD will not insert LF after CR so leave well alone.
  1035  ! If 2**0 = 1 the PAD will add a LF so delete any LF after CR.
  1036  !
  1037  ! If the DTE-P is in PSS (and we're the DTE-C)
  1038  
  1039  ! If 2**1 = 0 It is not expecting LFs after CR so delete them
  1040  ! If 2**1 = 1 It is expecting LF after CR so leave well alone.
  1041  !
  1042  ! This is encoded as follows:
  1043  !
  1044  ! Construct a value, 2**0 = P13 2**0 :: 2**1 = P13 2**1
  1045  ! 2**2 = 0 if the DTE-P is in PSS, 1 if the DTE-C is in PSS.
  1046  ! 2**3 = 0 for data from PSS, 1 for data sent to PSS.
  1047  !then look up in table P13.  0 = leave alone.  1 = delete LF. 2 = add LF
  1048  ! Note that we never delete LF from data coming in or add LF to data going out
  1049  %endofprogram
?PONOFF unused
?SETPRIO unused
?GETID unused
?MAPHWR unused
?MAPABS unused
?DUPADDR unused
?MONACTION unused
?CVF unused
?X25F unused
?HDRL unused
?PSSREADMODEBIT unused
?MOREBIT unused
?QBIT unused
?MONTORCO unused
?MONTOPSS unused
?FROMPSS unused
?FROMRCO unused
?BADPROCESS unused
?QUERY unused
?PARAMETERSINDICATION unused
?READPARAMETERS unused
?SETPARAMETERS unused
?CHARACTER unused
?BINARY unused
?SEQNOBITS unused
?SEQVALIDBIT unused
?MARKERBIT unused
?PROMPTBIT unused
?BINCHARBIT unused
?KILLTXBIT unused
?KILLRXBIT unused
?BREAKINBIT unused
?GOAHEADBIT unused
?PFTPSER unused
?TIMESER unused
?PCMDSER unused
?PCMCSER unused
?PCMBSER unused
?GLUESER unused
?RLOOPSER unused
?LOOPBSER unused
?FROMXPROT unused
?KERNELSER unused
?TSBSER unused
?TESTSER unused
?GATESER unused
?PROD unused
?CONTROLINPUTHERE unused
?PUTCONTROLOUTPUT unused
?DATAGRAMREPLY unused
?DATAGRAM unused
?INPUTHERE unused
?PUTOUTPUT unused
?ENABLEOUTPUT unused
?ENABLEINPUT unused
?NOTICEBOARD unused
?LOGSESSIONEND unused
?GOODBYE unused
?BROADCAST unused
?ABORTSESSION unused
?ENDCALLREPLY unused
?LOGCALLEND unused
?CHECKPOINT unused
?LOGCALLSTART unused
?COMMANDREPLY unused
?ACCREDITREPLY unused
?PROCESSCOMMAND unused
?ACCREDITUSERPASS unused
?SHORTINTERACTIONFAILS unused
?SHORTINTERACTION unused
?SHORTCALLACCEPTED unused
?UNKNOWNFAILURE unused
?BADINTERFACEPARAMS unused
?SPURIOUSCLEARREQ unused
?FACSNOTNEGOTIABLE unused
?CALLRESTARTED unused
?USERABORT unused
?TIMEDOUT unused
?OPERATORABORT unused
?CALLRESET unused
?LCNCONFLICT unused
?PACKETLEVELERROR unused
?CALLCOLLISION unused
?NETWORKDOWN unused
?SESSIONLEVELERROR unused
?BADPARAM unused
?ACCOUNTINGFAILURE unused
?NOUSERSERVICE unused
?PROCESSRUNNING unused
?FACILITYUNAVAILABLE unused
?CALLCLEARED unused
?CONVERSATIONTERMINATED unused
?GATEWAYFULL unused
?NOFREELCNS unused
?SOFTLYSOFTLY unused
?NOLOOPBACK unused
?PROTNOTSUPPORTED unused
?SHUTDOWNIMMINENT unused
?CAUSEUNKNOWN unused
?INVALIDPASS unused
?INVALIDUSER unused
?REPLY unused
?TSRESETBEFOREACCEPT unused
?TSDISCONNECTAFTERRESET unused
?TSGOINGOUTOFSERVICE unused
?TSTRANSPORTSERVICEABOR unused
?TSOPERATORABORT unused
?TSTRANSPORTSERVICEFAIL unused
?TSAPPLICATIONFAILURE unused
?TSNETWORKFAILURE unused
?TSCONGESTION unused
?TSFLOWCONTROLERROR unused
?TSCONNECTIONLOST unused
?TSTIMEOUT unused
?TSPROTOCOLACCUSATION unused
?TSPROTOCOLAPOLOGY unused
?TSMESSAGETOOLONG unused
?TSNETWORKCONGESTION unused
?TSNOREVERSECHARGING unused
?TSINCOMPATIBLEFACILITIES unused
?TSACCESSBARRED unused
?TSINVALIDADDRESS unused
?TSOUTOFORDER unused
?TSNUMBERBUSY unused
?TSNOCONNECTION unused
?TSRESPONSE unused
?TSOK unused
?PSSPROTNOTSUPPORTED unused
?SHORTNETNAME unused
?LONGNETNAME unused
?SYSPASS unused
?SYSNAME unused
?NOOFRCONETS unused
?RCOLINE unused
?PSSLINE unused
?SERCLINE unused
?NOOFX25NETS unused
?NOOFNETS unused
?NOOFLCNS unused
?NOOFTSBPROCS unused
?MAXL3PACKET unused
?GATEPORT2 unused
?GATEPORT1 unused
?MAXBLOCKS unused
?BLOCKSIZE unused
?HUB unused
?LUB unused
?FSYS unused
?DRIVE unused
?DATESTRING unused
?FTPSTREAM unused
?TIMESTREAM unused
?INFOSTREAM unused
?ITPSTREAM unused
?LPSTREAM unused
?DOCINPUTPR unused
?DOCINPUTCR unused
?BMS unused
?NOOFBUFF unused
?OWNID unused
?TTSER unused
?SHORT unused
?LONG unused
?FALSE unused
?TRUE unused
