Source file: GATEX#IMP       Compiled: 30-MAY-1984  15.17.21
Object file: GATEX#REL

         Edinburgh IMP77 Compiler - Version 8.2 release 3

     1  
     2  !**********************************************************
     3  !*                                                        *
     4  !*           PSS X-25 Level 3 Protocol Handler            *
     5  !*                                                        *
     6  !*                      GATEX                             *
     7  !*                                                        *
     8  !*                Version     9.41 13 Mar  1984           *
     9  !*                                                        *
    10  !**********************************************************
    11  !*
    12  %control 1
    13  %begin
    14  ! Options used:T#B,GATEX#IMP,G,F,CLEAN
    15  !************************************
    16  !*                                  *
    17  !*          Declarations            *  
    18  !*                                  *
    19  !************************************
    20  !*
    21  !****** Constintegers ******
    22  !*
    23  !*Link states
    24  %constinteger established              = 0
    25  %constinteger down                     = 1
    26  %constinteger restarting               =  2
    27  %constinteger gfi                      = x'10'
    28  !*State values
    29  %constinteger idle                     = 0 ;!Fixed
    30  %constinteger wtaci                    = 1 ;!Fixed
    31  %constinteger wtacn                    = 2 ;!Fixed
    32  %constinteger estb                     = 3       ;!Fixed
    33  %constinteger wait data                =  4 ;!Fixed
    34  %constinteger wtdsi                    = 7
    35  %constinteger wtdsn                    = 8
    36  %constinteger wtdsn2                   =  9
    37  %constinteger wdaci                    =10
    38  
    39  !Tstate and Rstate values
    40  %constinteger clear                    = 0
    41  %constinteger set                      = 1
    42  %constinteger ackpending               = 1
    43  
    44  %constinteger wrstn                    =  1
    45  %constinteger wrsti                    =  2
    46  
    47  !Monitor calls
    48  %constinteger ok                       =0
    49  %constinteger line down                = 1
    50  %constinteger line up                  = 2
    51  %constinteger query                    = 3
    52  %constinteger bad process              = 4
    53  %constinteger bad outstate             = 5
    54  !6-13 Used for Connect rejection monitoring
    55  %constinteger mon process running      =  6
    56  %constinteger mon bad param            =  7
    57  %constinteger mon no free lcns         =  8
    58  !14-21 Used for incoming call rejection monitoring
    59  %constinteger bad fn                   = 22
    60  %constinteger bad instate              = 23
    61  %constinteger data outside connect     = 24
    62  %constinteger mon no procs             = 25
    63  %constinteger bad ack                  = 26
    64  %constinteger mon to acct              = 27
    65  %constinteger from up                  = 28
    66  %constinteger to up                    = 29
    67  %constinteger from low                 = 30
    68  %constinteger to low                   = 31
    69  %constinteger bad block                = 32
    70  %constinteger mon call collision       = 33
    71  %constinteger mon rej recd             = 34
    72  %constinteger looping for process = 35
    73  
    74  %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
    75  %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
    76  %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
    77  
    78  !TS Functions
    79  %constinteger ts connect               = 16
    80  %constinteger ts accept                = 17
    81  %constinteger ts disconnect            = 18
    82  !*X25 Functions
    83  %constinteger incoming call            = 11  ;!From DCE
    84  %constinteger call request             = 11  ;!To   DCE
    85  %constinteger call connected           = 15  ;!From DCE
    86  %constinteger call accepted            = 15  ;!To   DCE
    87  %constinteger clear indication         = 19  ;!From DCE
    88  %constinteger clear request            = 19  ;!To   DCE
    89  %constinteger clear confirmation       = 23  ;!Covers DTE & DCE
    90  !Data and interrupt
    91  %constinteger dce data                 =  0  ;!From DCE
    92  %constinteger dte data                 = 0   ;!To   DCE
    93  %constinteger interrupt                = 35  ;!Both ways
    94  %constinteger interrupt confirmation   = 39  ;!Both ways
    95  !Flow control and reset
    96  %constinteger rr                       =  1  ;!Both ways
    97  %constinteger rnr                      =  5  ;!Both ways
    98  %constinteger rej                      =  9  ;!To   DCE
    99  %constinteger reset indication         = 27  ;!From DCE
   100  %constinteger reset request            = 27  ;!To   DCE
   101  %constinteger reset confirmation       = 31  ;!Covers DCE & DTE
   102  !Restart
   103  %constinteger restart indication       =251  ;!From DCE
   104  %constinteger restart request          =251  ;!To   DCE
   105  %constinteger restart confirmation     =255  ;!Covers DCE & DTE
   106  
   107  %constinteger fast select          =128
   108  %constinteger restricted rsp  = 64
   109  %constinteger ww set                   =  4
   110  %constinteger ps set                   =  2
   111  %constinteger reverse charge bit       =  1
   112  !*
   113  !Commands to and from lower level
   114  %constinteger line input               = 1
   115  %constinteger line output              = 2
   116  
   117  %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
   118  %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
   119  
   120  !*Various consts
   121  !Note LCN = 255 is used as a flag
   122  %constinteger critical long            =  2 ;! changed by Ruth 11/11/83
   123  %constinteger critical short           =  2
   124  %constinteger max writes               = 24
   125  %constinteger dte                      =  0
   126  %constinteger dce                      =  1
   127  %constinteger txc                      =  6
   128  %constinteger tx                       =  7
   129  %constinteger rx                       =  3
   130  %constinteger fast                     =  1
   131  %constinteger not negotiable           = -9
   132  %constinteger xprot hello              =  2
   133  
   134  !*
   135  !****** End of constintegers ******
   136  !*
   137  !****** Recordformats ******
   138  %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
   139  %recordformat timef(%bytearray a(0:3))
   140  %recordformat factabf(%string(7) facility, %integer ser)
   141  
   142  %recordformat linef(%record (qf) %name link, %c
   143+ %byte procno, state, writes left, lcgn, ser, dcedte, time, %c
   144+ %record (qf) call q, %integer line no, %bytearray lcntab(0:no of lcns - 1))
   145  
   146  %recordformat scvf((%byte l, (%byte reason, cause, diags) %or %bytearray a(0:3)) %or %string (3) s)
   147  %recordformat procf(%record (qf) %name link,  %c
   148+ %byte procno, state, task id, task port, fac, quiettime, istate, tsflag, %c
   149+ %record (linef) %name linelink,%record (qf) outq, %integer acks, %record (mef) %name clrbuff, discbuff, %c
   150+ %byte lcgn,lcn,aaa,eee,ttt,ccc,tstate,rstate,substate,ww in,ww out,ps in,ps out,
   151+ %record (scvf) cv)
   152  !* substate *******************************************************
   153  !*                                                                *
   154  !* Bit 0:
   155  !* Bit 1:
   156  !* Bit 2:
   157  !* Bit 3:
   158  !* Bit 4:  If set indicates that an RR or RNR is being deferred   *
   159  !* Bit 5:  If set indicates that we have sent RNR                 *
   160  !*                                                                *
   161  !******************************************************************
   162  
   163  %owninteger datarx, rrrx, rnrrx, rejrx, callrx, accrx, clrrx, clrcrx, intrx, intcrx, resrx, rescrx, rstrx, rstcrx, derrrx, d1 = 0
   164  %owninteger datatx, rrtx, rnrtx, rejtx, calltx, acctx, clrtx, clrctx, inttx, intctx, restx, resctx, rsttx, rstctx = 0
   165  
   166  %ownbyteinteger dcedte = 0
   167  %owninteger shutters up                =  0
   168  !****** Integers ******
   169  !*
   170     !No. of writes we have left out of WRITEMAX (currently 24)
   171  %owninteger i,r,s,m,index = 0
   172  %owninteger mon cons, buffers held = 0
   173  %owninteger mon reset = 0          ;! Ruth 13/3/84
   174  %owninteger default line = -1
   175  %ownstring(1) nullstr = ""
   176  %ownstring(2) fac = "**"
   177  %ownbytearray protb(0:14) = 4, 127, 255, 255, 255, 4, 1, 0, 0, 0, 4, 204, 0, 0, 0
   178  %ownstring (4) %name tsprotb
   179  %ownstring (4) %name xxxprotb
   180  !*
   181  !Upper level refers to Protocol conversion modules. Lower refers to level 2
   182  !protocol handlers and Buffer Manager.
   183  %constrecord (qf) %name null == 0
   184  %ownrecord (linef) %name line
   185  %ownrecord (procf) %name process
   186  %ownrecord (pf) p
   187  !****** Records and Recordarrays ******
   188  %ownrecord (qf) busy q, free lq, free pq, short q = 0
   189  %constinteger facmax                   = 16
   190  %ownrecord (linef) %array linetab(1:no of x25 nets)
   191  %owninteger factot                     =  0
   192  %ownrecord (factabf) %array faclist(0:facmax-1)
   193  %ownrecord (procf) %array proctab(1:no of procs)
   194  !*
   195  !****** Routine Specs ******
   196  !*
   197  %routine push(%record (qf) %name q,new)
   198     q_count = q_count + 1
   199     %if q_link == null %start
   200        q_link == new
   201        new_link == new
   202     %else
   203        new_link == q_link_link
   204        q_link_link == new
   205        q_link == new
   206     %finish
   207  %end
   208  
   209  %record (qf) %map pop(%record (qf) %name q)
   210     %record (qf) %name old
   211     %if q_link == null %then old == null %elsestart
   212        %if q_link_link == q_link %start ;!One element only on Q
   213           old == q_link
   214           q_link == null
   215        %else
   216           old == q_link_link
   217           q_link_link == old_link
   218        %finish
   219        q_count = q_count - 1
   220     %finish
   221     %result == old
   222  %end
   223  %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
   224  %routinespec increment(%integer txrx, length)
   225  %externalstring (15) %fnspec itos(%integer no, width)
   226  %integerfnspec next free lcn(%integer dcedte)
   227  %integerfnspec acknowledge(%byte seqno)
   228  %routinespec get buffer(%byte fn, length)
   229  %routinespec maybe send rr(%record (mef) %name mes)
   230  %routinespec move(%integer len, from, to)
   231  %routinespec cbuff
   232  %routinespec cpon(%record (pf) %name p)
   233  %routinespec pull(%record (qf) %name q,item)
   234  %routinespec query processes
   235  %routinespec reject call(%integer qualifier, rejtype)
   236  %routinespec reject connect(%integer fn, qualifier)
   237  %routinespec release process
   238  %string (255) %fnspec sub string(%record (mef) %name mes, %integer no)
   239  %routinespec buffer arrived
   240  %string (23) %fnspec form facilities(%integer flags)
   241  %routinespec free buffer(%record (mef) %name mes)
   242  %routinespec handle ts packet
   243  %routinespec handle clock tick
   244  %routinespec handle outq
   245  %routinespec handle line input
   246  %routinespec handle line output
   247  %integerfnspec interpret facilities(%integer fn, %bytearrayname f)
   248  %routinespec monitor(%record (pf) %name p, %integer type)
   249  %routinespec pack bcd string(%string(255) s,%bytearrayname a, %integername index)
   250  %routinespec packchar(%byte char, %record (mef) %name mes)
   251  %integerfnspec packetlength(%integer fn)
   252  %routinespec pack string(%string(255)%name s,%record (mef) %name mes)
   253  %routinespec pack ts string(%string(255) s, %string (255) %name t)
   254  %routinespec restart processes
   255  %integerfnspec stoi(%string (15) s)
   256  %routinespec stop(%integer reason)
   257  %routinespec to account(%record (mef) %name mes, %integer fn)
   258  %routinespec to lower(%record (mef) %name mes, %integer fn, datal)
   259  %routinespec to upper(%record (mef) %name mes, %integer fn)
   260  %string (63) %fnspec ts substring(%record (mef) %name mes, %integer ptr, no)
   261  %string (15) %fnspec unpack bcd string(%bytearrayname a,%integer no)
   262  %routinespec unravel ts(%string (63) %name ts addr, ts params, %integername line)
   263  %integerfnspec wp to facs(%string (31) facs, %string (31) %name pssfacs)
   264  
   265  
   266  !***************************************
   267  !*                                     *
   268  !*           Main  Program             *
   269  !*                                     *
   270  !***************************************
   271  
   272  linkin(from xprot);!dentify ourself to DEIMOS for receiving messages
   273  change out zero = t3 ser ;!Use buffered console I/O
   274  map virt(buffer manager,5,4) ;!Get access to buffer pool
   275  map virt(buffer manager,6,5)
   276  
   277  printstring("GATX Version     9.41 13 Mar  1984 (Min,Glas)") ;newline
   278  charno(fac, 1) = 1
   279  tsprotb == string(addr(protb(0)))
   280  xxxprotb == string(addr(protb(5)))
   281  
   282  %for i = 1, 1, no of x25 nets %cycle
   283     linetab(i)_procno = i
   284     push(free lq, linetab(i))
   285  %repeat
   286  
   287  %for i=1,1,no of procs %cycle ;!Initialise our main tables
   288     proctab(i)_procno = i ;!Give each process a process no.
   289     push(free pq,proctab(i))
   290  %repeat
   291  
   292  poff(p) ;!Wait for configuration message from loader
   293  dcedte = p_fn ;!Are we a DCE or a DTE?
   294  linkin(gatex ser)
   295  shutters up = p_b ;!This enables us to come up refusing connections. NB cant undo this
   296  
   297  !Grab a spare buffer for double-buffering buffer requests
   298  p_ser = buffer manager ;p_reply = id
   299  p_fn = request buffer ;p_len = short
   300  ponoff(p); buffers held = buffers held + 1
   301  push(short q, p_m)
   302  
   303  
   304  alarm(100) ;!Set off a 2-second clock tick
   305  
   306  %cycle ;!We never leave this loop
   307     
   308     p_ser = 0 ;!Accept anything
   309     poff(p)   ;!Wait for a message
   310  
   311     %if p_ser = gatex ser %start ;!A message from the higher levels (PCMs)
   312        handle ts packet
   313  
   314     %elseif p_reply = 0 ;!Clock tick message
   315        handle clock tick
   316  
   317     %elseif p_reply = buffer manager ;!A buffer request has been granted
   318        cbuff
   319        buffer arrived
   320  
   321     %elseif p_fn = line input ;!Something from the comms line handler
   322        cbuff
   323        handle line input
   324  
   325     %finishelse handle line output
   326  
   327  %repeat
   328  
   329  
   330  
   331  !****************************************
   332  !*                                      *
   333  !*            Routines                  *
   334  !*                                      *
   335  !****************************************
   336  !*
   337  
   338  
   339  %integerfn acknowledge(%byte seqno)
   340     !Update AAA from incoming N(R) unless we have a bad ack
   341     %byte acks
   342  
   343     acks = (seqno - process_aaa) & 7
   344     %result = bad ack %unless acks <= (process_ttt - process_aaa) & 7
   345  
   346     process_aaa = seqno
   347     !Right. process_acks counts the number of immediate acks that were
   348     !done. If this is positive, we reduce the no. of acks we send up.
   349     process_acks = process_acks - acks
   350     %if process_acks < 0 %start
   351        p_s1 = -process_acks
   352        process_acks = 0
   353        to upper(null, ack)
   354     %finish
   355  
   356     %result = 0
   357  %end ;!of Acknowledge
   358  
   359  
   360  
   361  %routine get buffer(%byte reason, length)
   362     !This routine pulls a buffer off its private queue if its got one and fires
   363     ! off a buffer request to Buffer Manager if it hasn't
   364     
   365     p_process = process_procno
   366     p_c2 = reason
   367     !Check on reason prevents recursive calls
   368     %if short q_count = 0 %or reason = 0 %or length = long %start
   369        p_ser = buffer manager ;p_reply = id
   370        p_fn = request buffer 
   371        p_len = length
   372        pon(p)
   373     %else
   374        p_m == pop(short q)
   375        buffer arrived
   376        get buffer(0, short)
   377     %finish
   378     
   379  %end ;!of get buffer
   380  
   381  
   382  %routine buffer arrived
   383     !A previously issued buffer request has been granted.
   384     !P_C2 was set up in get buffer and tells us why we
   385     !asked for it.
   386     %integer l
   387     %string (63) s
   388     %record (mef) %name mes
   389     %integer state
   390  
   391     mes == p_m
   392     mes_l = 0
   393     process == proctab(p_process)
   394     state = process_state
   395     line == process_linelink
   396  
   397     %if p_c2 = rr %and 3 <= state <= 4 %start ;!Value 1
   398        maybe send rr(mes)
   399  
   400     %elseif p_c2 = restart indication ;!Value 251
   401        !Note PROCESS points to LINE process
   402        line == linetab(p_process)
   403        %if line_state = restarting %then to lower(mes, restart indication, -1) %c
   404+       %else free buffer(mes)
   405  
   406     %elseif p_c2 = clear request ;!Value 19
   407        free buffer(pop(process_outq)) %while process_outq_count # 0
   408        mes_data(1) = process_cv_reason
   409        %if state = estb %or state = wait data %or state = wtacn %start
   410           to lower(mes, clear request, 0) ;clrtx = clrtx + 1
   411           process_state = wtdsn2 ;process_quiettime = 6
   412  
   413        %elseif state = wtaci
   414           to lower(mes, clear request, 0) ;clrtx = clrtx + 1
   415           process_state = wtdsn
   416  
   417        %else
   418           free buffer(mes)
   419        %finish
   420  
   421     %elseif (p_c2 = interrupt%or p_c2 = reset request %or p_c2 = reset confirmation) %c
   422+    %and 3 <= state <= 4 ;!Values 35, 27, 31
   423        to lower(mes, p_c2, 0)
   424  
   425     %elseif p_c2 = disconnect ;!Value 3
   426        process_substate = process_substate & (\2)
   427        packstring(process_cv_s, mes)
   428        %unless process_clrbuff == null %start
   429           !We held onto the clear packet so we could extract its parameters
   430           !We stuck the user data length in clrbuff_fn to save us recalculating it
   431  
   432           l = process_clrbuff_l - process_clrbuff_fn - 3;!points to start of UD
   433           s = ts substring(process_clrbuff, l, 1)
   434           packstring(s, mes)
   435           s = ts substring(process_clrbuff, l, 2)
   436           packstring(s, mes)
   437  
   438           !OK we've finished with the clear - send it off as a clear conf. & 
   439           !decouple LCN
   440  
   441           to lower(process_clrbuff, clear confirmation, 0) ;clrctx = clrctx + 1 ;process_clrbuff == null
   442           line_lcntab(process_lcn) = 0 ;process_lcn = 255
   443        %finish
   444  
   445        p_s1 = process_cv_reason
   446        %if state = estb %or state = wtaci %or state = wdaci %start
   447  !         P_S1 = 1 ;!Bound to be a Disconnect in response to a received Disconnect
   448           to upper(mes, disconnect)
   449           process_state = wtdsi
   450  
   451        %elseif state = wtacn %or state = wtdsn2 %or state = wait data
   452           to upper(mes, disconnect)
   453           release process
   454  
   455        %elseif state = wtdsn
   456           to upper(mes, disconnect)
   457           process_taskport = 0 ;!Decouple process from higher level
   458  
   459        %else
   460           free buffer(mes)
   461        %finish
   462  
   463     %elseif p_c2 = call accepted ;!Value 15
   464        accrx = accrx + 1
   465        process_substate = process_substate & (\1)
   466        mes_data(0) = 0 ;!Address lengths (=0)
   467        mes_data(1) = 0
   468        mes_l = 2
   469        to lower(mes, call accepted, -1) ;acctx = acctx + 1
   470        %if process_tsflag = 0 %start
   471           process_substate = process_substate ! 4 ;get buffer(ts accept, short)
   472        %finishelse handle outq
   473  
   474     %elseif p_c2 = ts accept ;!Value 17
   475        process_substate = process_substate & (\4)
   476        !OK. We've sent the TS accept - tell ACKNOWLEDGE to swallow the first Ack.
   477        process_acks = process_acks + 1
   478        mes_l = 1 ;mes_fn = x'80'
   479        mes_data(0) = ts accept
   480        to lower(mes, dce data, 0) ;datatx = datatx + 1
   481        process_ttt = (process_ttt + 1)&7
   482        handle outq
   483  
   484     %else ;!Only expected one is Value 0
   485        %if short q_count = 0 %then push(short q, mes) %else free buffer(mes)
   486     %finish
   487  
   488  %end ;!of Buffer Arrived
   489  
   490  %routine cbuff
   491     %unless p_m == null %start
   492        !Buffer type bits not 0 or 64 constitutes a disaster
   493        stop(98) %if 0 # p_m_type # 64
   494        !Buffer pointer should be in range k'100000' - k'137777' and should be a
   495        !multiple of k'20'.   Look at top 2 bits and bottom 6.
   496        stop(96) %unless p_b & k'140017' = k'100000' ;! Ruth 13/3/84
   497        buffers held = buffers held + 1
   498     %finish
   499  %end
   500  
   501  %routine cpon(%record (pf) %name p)
   502     !As PON, but a) check buffer is valid first and b) decrement count
   503     %unless p_m == null %start
   504        stop(99) %if 0 # p_m_type # 64
   505        stop(97) %unless p_b & k'140017' = k'100000'
   506        buffers held = buffers held - 1
   507     %finish
   508     pon(p)
   509  %end
   510  
   511  %string (23) %fn form facilities(%integer flags)
   512     %string (23) facs
   513     !Takes two sets of information: 1) The current facilities
   514     !values and 2) which of these are to be passed on.
   515     !It then creates a facilities field of the form "W=m/n,P=mmm/nnn,C=rfs"
   516  
   517     facs = ""
   518  
   519     %if flags & ww set # 0 %start ;!We want to specify a window size
   520        facs = "W=".itos(process_ww in, -1)."/".itos(process_ww out, -1)
   521     %finish
   522  
   523     %if flags & ps set # 0 %start ;!Specify packet size
   524        !Note PSS transfers packet size as n, where 2**n = size
   525        facs = facs."," %unless facs = ""
   526        facs = facs."P=".itos(1<<process_ps in, -1)."/".itos(1<<process_ps out, -1)
   527     %finish
   528  
   529     %if flags & (fast select ! restricted rsp) # 0 %start
   530        facs = facs."," %unless facs = ""
   531        facs = facs."C="
   532        %if flags & restricted rsp # 0 %then facs = facs."S" %else facs = facs."F"
   533     %finish
   534  
   535     %result = facs
   536  %end ;!of Form Facilities
   537  
   538  %routine free buffer(%record (mef) %name mes)
   539     %record (pf) p
   540     %unless mes == null %start
   541        !There really is a buffer
   542        %if mes_type = short %and short q_count < critical short %start
   543           push(short q, mes)
   544  
   545        %else
   546           !Tell Buffer Manager it can have its buffer back.
   547           p_ser = buffer manager ;p_reply = id
   548           p_fn = release buffer
   549           p_m == mes
   550           cpon(p)
   551        %finish
   552     %finish
   553  %end ;!of Free Buffer
   554  
   555  %routine handle clock tick
   556  !    %record (mef) %name mes ;! Ruth 13/3/84
   557     %integer i,j
   558  
   559  
   560     !1) Time out stuck calls
   561     !2) Checkpoint
   562     !3) Poll restarts at link startup
   563     !4) release any RNR condition still up
   564     %if busy q_count # 0 %start
   565        line == busy q
   566        %for i = 1,1,busy q_count %cycle
   567           line == line_link
   568           %if line_call q_count # 0 %start
   569              process == line_call q
   570              %for j = 1,1,line_call q_count %cycle
   571                 %if line_state = established %start
   572                    process == process_link
   573     
   574     
   575                    %if process_state = estb %and process_substate & 48 # 0 %start
   576                       maybe send rr(null)
   577     
   578                    %elseif process_state = wait data
   579                       process_quiettime = process_quiettime - 1
   580                       %if process_quiettime = 0 %then get buffer(clear request, short)
   581     
   582                    %elseif process_state = wtdsn2 ;!We'll lose stats record.
   583                       process_quiettime = process_quiettime - 1
   584                       %if process_quiettime = 0 %start
   585                          %if process_substate & 2 = 0 %then process_substate = process_substate ! 2 %and get buffer(disconnect, long) 
   586                          process_state = wtdsn
   587                       %finish
   588     
   589                    %finish
   590                 %elseif line_state = restarting
   591                    line_time = line_time + 1
   592                    %if line_time & 3 = 0 %then process == line %and get buffer(restart indication, short)
   593  
   594                 %finish
   595              %repeat
   596           %finish
   597        %repeat
   598     %finish
   599  
   600     %if int = 'D' %start
   601        shutters up = 1 - shutters up
   602  
   603     %elseif int = 'C'
   604        mon cons = 1 - mon cons
   605  
   606     %elseif int = 'V'
   607        printstring("GATX Version     9.41 13 Mar  1984 (Min,Glas)") ;newline
   608  
   609     %elseif int = 'R'     ;! Ruth 13/3/84
   610        mon reset = 1 - mon reset
   611  
   612  
   613     %elseif int = '?'
   614        query processes
   615        monitor(null,query) ;!Display process variables
   616  
   617  
   618     %finish
   619     int = 0
   620     alarm(100)
   621     
   622  %end ;!of HANDLE CLOCK TICK
   623  
   624  
   625  %routine handle line input
   626     %string(63) caller, called, caller params, called params, exptext, s, t
   627     %string (23) facs
   628     %string(4) protb
   629     !Lengths:  Packets come in with the full level 3 data length
   630    !(Packet header + data)
   631     %string(2) subaddr
   632     %bytearrayname data
   633     %record (mef) %name mes
   634     %integer state
   635     %byte nr,ns,fn,x,cudfl,facl,lcgn,dtel
   636     %integer i,j, rc
   637     monitor(p, from low)
   638     %if p_m == null %then monitor(p, bad block) %and %return
   639     mes == p_m ;data == mes_data
   640     fn = mes_fn
   641     
   642     !Identify which line it came in on
   643  
   644     %if busy q_count # 0 %start
   645        line == busy q_link
   646     
   647        %for i = 1, 1, busy q_count %cycle
   648           -> found line %if p_process = line_lineno
   649           line == line_link
   650        %repeat
   651     %finish
   652     
   653     monitor(p, bad process)
   654     free buffer(mes)
   655     %return
   656  
   657  found line:
   658     lcgn = mes_octet1&15;!Received LCGN
   659     %if fn = incoming call %start
   660        !Can occur in any state but only IDLE accepted
   661        
   662        %if line_state = established %start
   663           !Set up a process if one is available and does not exist already
   664           %if line_call q_count # 0 %start
   665              process == line_call q
   666              %for i = 1, 1, line_call q_count %cycle
   667                 process == process_link
   668                 %if process_lcgn = lcgn %and process_lcn = mes_lcn %start ;!LCGN and LCN clash - Call collision
   669                    !PSS X-25 Call collision: DCE accepts the Call Request
   670                    !and a)  forgets about its Incoming Call then b) rejects the CONNECT
   671                    !which generated it. Ultimately it will retry on another LCN
   672                    !DTE just ditches the Incoming Call as it knows the DCE
   673                    !will handle it.
   674     
   675                    !If the other process is not waiting for a call accepted
   676                    !(Call connected) then it is an error and should be ditched
   677                    monitor(p, mon call collision)
   678                    %if line_dcedte = dte %or process_state # wtacn %start
   679                       free buffer(mes)
   680                       %return
   681                    %else
   682                       p_s1 = call collision
   683                       to upper(null, disconnect)
   684                       release process
   685                       %exit ;!Should not be TWO active processes with the same LCN
   686                    %finish
   687                 %finish
   688              %repeat
   689           %finish
   690           
   691           %if line_lcntab(mes_lcn) = 0 %start ;!Make sure he isnt using a busy stream
   692              process == pop(free pq)
   693              %unless process == null %start ;!There is a process available
   694              
   695                 !Zero the entire process but save its process number
   696                 i = process_procno ;process=0 ;process_procno = i
   697                 push(line_call q,process) ;!Queue it on busy process q
   698                state = process_state ;process_lcgn = lcgn
   699                 process_cv_l = 3
   700                 process_lcn = mes_lcn ;line_lcntab(mes_lcn) = 1
   701                 process_linelink == line
   702                 %if shortnetname(line_line no) = "S" %then process_ww in = 1 %else process_ww in = 2
   703                 process_ww out = process_ww in
   704                 !TSTATE = Clear, OUTQ == NULL implicitly
   705                 !Extract DCE & DTE addresses, facilities and Call User Data field
   706                 !From Incoming call packet
   707                 caller = unpack bcd string(data,1)
   708                 called = unpack bcd string(data, 0)
   709        
   710                 !Shutters up either locks out calls completely or can allow only
   711                 !only those callers with the correct last two digits.
   712                 i = charno(caller, length(caller)-1)<<8 + charno(caller, length(caller))
   713                 %if shutters up = 0 %or shutters up = i %start
   714                    !strip off subaddress if present and put its value in rc
   715                    %if length(called) = 14 %then rc = (data(7)>>4)*10+data(7)&15 %else rc = 0
   716                    dtel = (data(0)>>4 + data(0)&15 + 1)>>1 ;!Length of DTE addresses
   717                    facl = data(dtel+1) ;!Length of facilities field
   718                    i = interpret facilities(incoming call, data)
   719                    %if i >= 0 %and factot > 0 %start
   720                       cudfl = mes_l - facl - dtel - 5
   721                       process_fac = i
   722                       !Three bytes header + Length of DTE/DCE addresses + Facilities length = 5
   723                       increment(rx, cudfl)
   724                       facs = form facilities(i)
   725                       %if cudfl >= 4 %then length(protb) = 4 %else length(protb) = cudfl
   726                       move(length(protb), addr(data(dtel+facl+2)), addr(protb)+1)
   727                       !It's only true T.S. if Protocol bytes are 127-255-255-255
   728                       process_tsflag = 1 %if protb # tsprotb
   729                       %if no of x25 nets > 1 %and line_lineno # default line %then caller = shortnetname(line_lineno).".".caller
   730                       !Try and unscramble addresses TS-style.
   731                       called params = ts substring(mes, dtel+facl+6, 1)
   732                       !Strip any accrediting info. off the front, discard it and leave residue in t.
   733                       t = called params %unless called params -> ("(").s %and s -> s.(").").t
   734                       !t now contains <dest>.<facility>.<residue) or <facility>
   735                       s = t %unless t -> t.(".").s
   736                       !s now contains <facility> if address is valid
   737                       process_task id = 0
   738                       %for i = 0,1,factot-1 %cycle
   739                          %if s -> (faclist(i)_facility).s %then process_task id = faclist(i)_ser
   740                       %repeat
   741  
   742                       !All unknown non-TS traffic -> XXX enabler if there is one.
   743                       %if process_task id = 0 %and process_tsflag # 0 %start
   744                          %for i = 0, 1, factot-1 %cycle
   745                             %if faclist(i)_facility = "XXX" %then process_task id = faclist(i)_ser %and %exit
   746                          %repeat
   747                       %finish
   748  
   749                       %if process_task id # 0 %start
   750                    
   751                          caller params = ts substring(mes, dtel+facl+6, 2)
   752                          caller = caller.".".caller params %unless caller params = ""
   753                          exptext = ts substring(mes, dtel+facl+6, 4)
   754  
   755                          %if mon cons # 0 %start
   756                             printstring("GATX In Call:") ;printstring(caller)
   757                             printstring("->") ;printstring(called)
   758                             printsymbol('.') ;printstring(called params)
   759                             newline ;printstring(" F:") ;printstring(facs)
   760                             printstring(" E:") ;printstring(exptext)
   761                             printstring(" fails") %if j < 0
   762                             newline
   763                          %finish
   764  
   765                          mes_l = 0
   766                          packstring(called params, mes) ;!Called
   767                          packstring(caller,mes) ;!Caller
   768                          packstring(facs, mes) ;!Facilities/Quality
   769                          packstring(exptext, mes) ;!Explanatory Text
   770                         %if process_tsflag # 0 %then packstring(protb, mes)
   771                          p_s1 = process_tsflag
   772                          to upper(mes, connect)
   773                          process_state = wtaci
   774  
   775                       %finishelse reject call(prot not supported, 1)
   776                    %finishelse reject call(ts incompatible facilities, 1)
   777                 %finishelse reject call(ts going out of service, 1)
   778              %else ;!No free processes
   779                 !Note: a clear confirmation will come back with no process
   780                 reject call(ts number busy, 0)
   781              %finish
   782           %finishelse reject call(lcn conflict, 0)
   783        %finishelse free buffer(mes) ;!Ignore Calls while restarting or down
   784  
   785     %elseif fn = restart indication
   786        !Clear down Network side (all processes) completely and 
   787        !Interface (upper) side tidily.
   788        rstrx = rstrx + 1
   789        %if line_state = restarting %start
   790           p_len = 0
   791           to account(null, hello) ;!Tell Account line is up
   792           line_state = established
   793           free buffer(mes)
   794        %else
   795           mes_fn = restart confirmation
   796           !Dont use TO LOWER as we dont have a process
   797           i = p_ser ;p_ser = p_reply ;p_reply = i ;!Send it back whence it came
   798           p_fn = line output
   799           !P_M == MES already
   800           p_len = 3
   801           rstctx = rstctx + 1
   802           cpon(p) ;! Ruth 13/3/84
   803        %finish
   804        restart processes
   805  
   806     %elseif fn = restart confirmation
   807        rstcrx = rstcrx + 1
   808        %if line_state = restarting %start
   809           p_len = 0
   810           to account(null, hello) ;!Tell Account line is up
   811           line_state = established
   812        %finish
   813        free buffer(mes)
   814        restart processes
   815     %else
   816  
   817        !There ought to be a process for this message on the circular
   818        !List queued off LINE_CALL Q
   819        %if line_call q_count # 0 %start
   820           process == line_call q
   821           %for i = 1,1,line_call q_count %cycle
   822              process == process_link
   823              %if process_lcgn = lcgn %and process_lcn = mes_lcn %then -> found it ;!Correct LCGN and LCN
   824           %repeat
   825        %finish
   826     
   827        %if fn = clear request %start
   828           !He thinks the call is up - we don't.   Let's put him out of his misery
   829           !By confirming his clear.
   830           reject call(spurious clear req, 0)
   831  
   832        %else
   833           %if fn # clear confirmation %then monitor(p,bad instate)
   834           !Should have been a process if it wasnt an incoming call
   835           free buffer(mes)
   836     
   837        %finish
   838        %return
   839     
   840  found it:
   841  
   842       state = process_state
   843        %if fn&3 #3 %start ;!Data,RR,RNR, (REJ)
   844           nr = fn>>5 ;fn = fn&x'1F' ;!Remove R: Next block expected
   845        %finish
   846  
   847        %if fn = rr %start
   848           !Level 3 RR
   849           process_tstate = clear ;!Clear remote RNR if set against us.
   850           rrrx = rrrx + 1
   851           ->end1
   852  
   853        %elseif fn & 1 = 0
   854           !Level 3 data block.
   855           ns = (fn>>1)&7 ;!Block sequence no.
   856           m = fn&x'10'
   857           increment(rx, mes_l-3) ;!Increment will catch case where mes_l-3 < 0
   858           %if 3 <= state <= 4 %and process_rstate = clear %start
   859              rc = acknowledge(nr)
   860              %if rc # 0 %then -> chop
   861              %if ns = process_eee %start ;!Level 3 sequence OK
   862                 datarx = datarx + 1
   863                 process_eee = (process_eee + 1) & 7
   864                 p_s1 = 1 - m >> 4 ;!Push it if asked to
   865                 mes_l = mes_l - 3 ;!User data length only
   866           
   867                 %if mes_octet1 < 128 %start ;!Ordinary data and Push
   868                    to upper(mes, input here)
   869           
   870                 %elseif mes_l = 0 ;!Ignore any zero-length blocks we may receive
   871                    process_ccc = (process_ccc + 1) & 7
   872                    maybe send rr(mes)
   873           
   874                 %elseif process_tsflag = 1 ;!Control data, not T.S.
   875                    to upper(mes, control input here)
   876           
   877                 %else ;!Control data, T.S.
   878                    %if mes_data(0) = ts disconnect %start
   879                       process_cv_reason = mes_data(3)
   880                       to lower(mes, clear indication, 0); clrtx = clrtx + 1
   881                       %if mon reset # 0 %start      ;! Ruth 13/3/84
   882                          ! write out explanatory text
   883                          printstring(substring(mes,3))
   884                          newline
   885                       %finish
   886                       process_state = wdaci
   887                    %else
   888                       !We don't implement this yet so discard it (nasty isnt it)
   889                       process_ccc = (process_ccc + 1) & 7
   890                       maybe send rr(mes)
   891                    %finish
   892           
   893                 %finish
   894           
   895                 handle outq
   896              %else ;!Sequence error - shouldn't happen
   897                 derrrx = derrrx + 1
   898                 process_cv_reason = packet level error
   899                 to lower(mes, clear indication, 0) ;clrtx = clrtx + 1
   900                 process_state = wdaci
   901              %finish
   902           %finishelse free buffer(mes)
   903  
   904        %elseif fn = rnr
   905           !Level 3 RNR
   906           process_tstate = set ;!Remote RNR set against us.
   907           rnrrx = rnrrx + 1
   908           ->end1
   909  
   910        %elseif fn = call connected
   911           %if process_fac & restricted rsp = 0 %start
   912              !Reply to call request to Network
   913              !Work out user data length for stats
   914              %if mes_l >= 5 %start
   915                 dtel = (data(0)>>4 + data(0) & 15 + 1)>>1
   916                 facl = data(dtel + 1)
   917                 increment(rx, mes_l - dtel - facl - 5)
   918              %finish
   919              !Expect in states WTACN or WTDSN2
   920              %if state = wtacn %start ;!Call now successfully established.
   921                 i = interpret facilities(call connected, data)
   922                 process_state = estb
   923                 facs = form facilities(i)
   924                 mes_l = 0
   925                 packchar(0, mes) ;!Recall Address
   926                 %if length(facs) # 0 %then packstring(facs, mes) %else %c
   927+                free buffer(mes) %and mes == null
   928                 p_s1 = process_tsflag ;!For benefit of PCMs.
   929                 to upper(mes, accept call)
   930                 handle outq
   931              %finishelse free buffer(mes)
   932           %else
   933              to lower(mes, clear indication, 0) ;clrtx = clrtx + 1
   934              process_state = wtdsn
   935              p_s1 = short call accepted
   936              to upper(null, disconnect)
   937           %finish
   938     
   939        %elseif fn = clear confirmation %or fn = clear indication
   940           %if fn = clear confirmation %start
   941              !Expect in states WTDSN,WTDSN2
   942              clrcrx = clrcrx + 1
   943           %else
   944              !Expect in any state
   945              clrrx = clrrx + 1
   946              process_cv_reason = call cleared ;process_cv_cause = data(0) ;process_cv_diags = data(1)
   947           %finish
   948           %if mes_l > 5 %start ;!Fastselect or extended formats may have user data
   949              !DCE Clear Confirmation doesnt have the Cause & Diags fields
   950              %if fn = clear confirmation %and line_dcedte = dte %then i = 0 %else i = 2
   951              dtel = (data(i)>>4 + data(i) & 15 + 1)>>1
   952              facl = data(dtel + 3)
   953              cudfl = mes_l - dtel - facl - i - 5
   954              increment(rx, cudfl)
   955           %finish
   956        
   957           i = interpret facilities(fn, data) ;!to get call stats if present
   958           free buffer(pop(process_outq)) %while process_outq_count # 0
   959        
   960           !We either reply immediately to a clear (in which case we
   961           !decouple ourselves from the LCN) or we hold on to it till we get
   962           !the disconnect buffer so we can write up the parameters
   963           %if state = wtdsn %start
   964              line_lcntab(process_lcn) = 0 ;process_lcn = 255 
   965              free buffer(mes)
   966              %if process_substate & 2 # 0 %start
   967                 !We are in the process of disconnecting a call by timeout
   968                 process_state = wtdsn2 ;process_quiettime = 6
   969              %finishelse release process
   970           %else
   971              %if 1 <= state <= 5 %start
   972                 !Evidence is that this packet is charged for in advance by PSS
   973                 process_clrbuff == mes ;mes_fn = cudfl
   974              %else
   975                 free buffer(mes)
   976                 line_lcntab(process_lcn) = 0 ;process_lcn = 255
   977              %finish
   978              process_substate = process_substate ! 2 ;get buffer(disconnect, long)
   979        
   980           %finish
   981     
   982        %elseif fn = interrupt
   983           !Action in state ESTB only
   984           intrx = intrx + 1
   985           increment(rx, 0)
   986           to lower(mes,interrupt confirmation, 0) ;intctx = intctx + 1
   987           %if state = estb %start
   988              %if mes_l > 3 %then x = data(0) %else x = 'A'
   989              !Interrupt user data (one byte only)
   990              p_s1 = x
   991              to upper(null,expedited data)
   992           %finish
   993  
   994        %elseif fn = interrupt confirmation
   995           intcrx = intcrx + 1
   996           increment(rx, 0)
   997           process_istate = 0 ;!Clear interrupt pending condition
   998           free buffer(mes)
   999  
  1000        %elseif fn = reset indication
  1001           increment(rx, 0)
  1002           printstring("Reset") ;write(data(0), 1) ;printsymbol('/')
  1003           write(data(1), 1) ;newline
  1004           resrx = resrx + 1
  1005           %if process_rstate = clear %or process_rstate = wrstn %start
  1006              !Either out of the blue or we were expecting one from Network
  1007              to upper(mes, reset)
  1008              process_rstate = wrsti
  1009           %finishelse free buffer(mes)
  1010           ! Monitoring out in 11/5/84
  1011           printstring("*GATX: ")
  1012           write(process_procno,2)
  1013           write(process_rstate,2)
  1014           write(resrx,2)
  1015           newline
  1016           query processes
  1017  
  1018        %elseif fn = reset confirmation
  1019           %if process_rstate = wrstn %start
  1020              to upper(mes, reset)
  1021              free buffer(pop(process_outq)) %while process_outq_count # 0
  1022              process_aaa = 0 ;process_ccc = 0 ;process_eee = 0 ;process_ttt = 0
  1023              process_tstate = clear
  1024              process_rstate = clear
  1025           %finishelse free buffer(mes)
  1026  
  1027        %elseif fn = rej
  1028           !Level 3 REJ. Shouldn't get this.
  1029           rc = mon rej recd ;->chop
  1030  
  1031        %else
  1032           monitor(p,bad fn)
  1033           free buffer(mes)
  1034        %finish
  1035     %finish
  1036     %return
  1037     
  1038  
  1039  end1:
  1040     %if 3 <= state <= 4 %and process_rstate = clear %start
  1041        rc = acknowledge(nr)
  1042        %if rc # 0 %then -> chop
  1043        handle outq
  1044     %finish
  1045     free buffer(mes)
  1046     %return
  1047  
  1048  chop:
  1049     monitor(p, rc)
  1050     process_cv_reason = packet level error
  1051     to lower(mes, clear indication, 0) ;clrtx = clrtx + 1
  1052     process_state = wdaci
  1053     %return
  1054  
  1055  
  1056  %end ;
?SUBADDR unused
  1057        ;!of HANDLE LINE INPUT
  1057  
  1058  
  1059  %routine handle line output
  1060     %integer i
  1061     monitor(p, from low)
  1062     %if p_len = xprot hello %start ;!Init message at Task startup (one only per task)
  1063        line == pop(free lq) ;!Get a line process
  1064        %unless line == null %start ;!Got one OK.
  1065           i = line_procno ;line = 0 ;line_procno = i
  1066           push(busy q, line)
  1067           line_state = down
  1068           line_ser = p_reply
  1069           line_line no = p_process ;default line = line_lineno %if default line < 0
  1070           line_dcedte = (dcedte>>line_lineno) & 1
  1071           line_lcgn = 4
  1072           line_writes left = max writes
  1073        %finishelse stop(mon no procs)
  1074     %else ;!Line Up/Down or write ack
  1075     !XPROT hello is first thing XPROT sends so should always be at least
  1076     !one line in queue by now.
  1077     line == busy q_link
  1078     %for i = 0, 1, busy q_count-1 %cycle
  1079        -> found line %if line_line no = p_process
  1080        line == line_link
  1081     %repeat
  1082     monitor(p, bad process)
  1083  
  1084  found line:
  1085        %if p_len = 1 %start  ;!Link down message
  1086           to account(null, hello)
  1087           monitor(null,line down)
  1088           restart processes
  1089           line_state = down
  1090        %else
  1091           %if line_state = down %start
  1092              printstring(longnetname(line_lineno)) ;printstring(" Line Up") ;newline
  1093              monitor(null,line up)
  1094              process == line ;!For benefit of get buffer
  1095              line_state = restarting
  1096              get buffer(restart indication, short)
  1097           %finish
  1098        %finish
  1099     %finish
  1100  %end ;!of HANDLE LINE OUTPUT
  1101  
  1102  
  1103  
  1104  %routine handle outq
  1105     !Send off what we can from the output queue
  1106     %record (mef) %name mes
  1107     %return %unless 3 <= process_state <= 4
  1108     %return %if process_substate & 5 # 0
  1109     %while process_tstate = clear %and process_outq_count # 0 %c
  1110+    %and (process_ttt - process_aaa)&7 < process_ww out %cycle
  1111        mes == pop(process_outq)
  1112        to lower(mes,dte data, mes_l) ;datatx = datatx + 1
  1113        process_ttt = (process_ttt+1)&7
  1114     %repeat
  1115  
  1116     %if process_state = wait data %and process_outq_count = 0 %then %c
  1117+    get buffer(clear request, short)
  1118  %end ;!of HANDLE OUTQ
  1119  
  1120  
  1121  %routine handle ts packet
  1122     %string(63) caller, called, called params, cudf, exptext
  1123     %string (31) facs
  1124     %record (mef) %name mes
  1125     %bytename state
  1126     %byte r,s
  1127     %integer flags
  1128     %integer fn,lcn,lineno,l,i,j
  1129     %string(7) ls
  1130     
  1131     mes == p_m ;fn = p_fn
  1132     cbuff %unless fn = enable facility %or fn = disable facility
  1133     monitor(p, from up)
  1134     
  1135     %if fn = connect %start
  1136        called = substring(mes, 1)
  1137        unravel ts(called, calledparams, lineno)
  1138     
  1139        %if busy q_count # 0 %start
  1140           line == busy q
  1141           %for i = 1, 1, busy q_count %cycle
  1142              line == line_link
  1143              %if line_lineno = lineno %and line_state = established %then -> ok
  1144           %repeat
  1145        %finish
  1146        reject connect(fn, network down)
  1147        %return
  1148     ok:
  1149        !Scan calls on this line to ensure this is not a duplicate request
  1150        
  1151        %if line_call q_count # 0 %start
  1152           process == line_call q
  1153           %for i = 1,1,line_call q_count %cycle
  1154              process == process_link
  1155              %if process_task id = p_reply %and process_task port = p_task port %start ;!Duplicate request
  1156                 monitor(null, mon process running)
  1157                 reject connect(fn, process running)
  1158                 %return
  1159              %finish
  1160           %repeat
  1161        %finish
  1162        
  1163        lcn = next free lcn(line_dcedte)
  1164        %if lcn >= 0 %start ;!Got a free LCN
  1165           process == pop(free pq)
  1166           %unless process == null %start ;!All OK.
  1167              !Record the connection and send off a Call Request
  1168        
  1169              i = process_procno ;process=0 ;process_procno = i
  1170              push(line_call q,process)
  1171              process_cv_l = 3
  1172              process_tsflag = p_s1
  1173              !Tstate = Clear, OUTQ_COUNT = 0 implicitly
  1174     
  1175              %if shortnetname(line_lineno) = "S" %start
  1176                 !SERCNET has different defaults from other X25 networks
  1177                 process_ww in = 1
  1178              %else
  1179                 process_ww in = 2
  1180              %finish
  1181              process_ww out = process_ww in
  1182     
  1183              process_linelink == line ;!Reverse link for speed
  1184              process_task port = p_task port
  1185              process_lcgn = line_lcgn
  1186              process_lcn = lcn
  1187              process_task id = p_reply
  1188              caller = substring(mes, 2)
  1189              facs = substring(mes, 3) ;!Facilities/Quality
  1190              exptext = substring(mes, 4) ;!Call User Data/Explanatory Text
  1191              %if mon cons # 0 %start
  1192                 printstring("GATX OutCall:") ;printstring(caller)
  1193                 printstring("->") ;printstring(called)
  1194                 printsymbol('.') ;printstring(called params)
  1195                 printstring(" Q:") ;printstring(facs)
  1196                 printstring(" E:") ;printstring(exptext)
  1197                 newline
  1198              %finish
  1199              i = wp to facs(facs, facs)
  1200              !1st "facs" passed by value, 2nd by name. Not as nasty as it looks
  1201              %if i >= 0 %start ;!All OK
  1202           
  1203                 mes_data(0) = length(called)&15
  1204                 index = 2 ;!Index counts in quartets not bytes
  1205                 pack bcd string(called, mes_data, index)
  1206  
  1207                 !last field is explanatory text for TS calls and verbatim CUDF
  1208                 !otherwise. Null CUDF in a non-TS call will be assumed to be XXX
  1209                 !and will set protocol bytes 1-0-0-0 and TS called and caller strings
  1210  
  1211  
  1212                 %if process_tsflag = 0 %or exptext = "" %start
  1213                    !If T.S. protocol bytes must be 127-255-255-255.
  1214                    !If not, assume XXX (1-0-0-0). SERC-ITP must set CUDF explicitly.
  1215                    %if process_tsflag = 0 %then cudf = tsprotb %else cudf = xxxprotb
  1216                    pack ts string(called params, cudf)
  1217                    pack ts string(caller, cudf)
  1218                    %if process_tsflag = 0 %start ;!TS only
  1219                       pack ts string(nullstr, cudf)
  1220                       pack ts string(exptext, cudf)
  1221                    %finish
  1222                 %finishelse cudf = exptext
  1223                 %if length(cudf) > 16 %then process_fac = process_fac ! fast select
  1224                 %if process_fac # 0 %start
  1225                    charno(fac, 2) = process_fac ;facs = facs.fac
  1226                 %finish
  1227     
  1228                 string(addr(mes_data(index>>1))) = facs
  1229                 index = index + length(facs)<<1 + 2
  1230                 move(length(cudf), addr(cudf)+1, addr(mes_data(index>>1)))
  1231                 index = index + length(cudf)<<1
  1232                 mes_l = index>>1 ;!Length of data + header (Used by TO LOWER)
  1233                 i = interpret facilities(call request, mes_data)
  1234                 to lower(mes,call request, length(cudf)) ;calltx = calltx + 1
  1235        
  1236                 !Connect may be specified to be a datagram by using "C=S"
  1237                  process_state = wtacn
  1238              %else
  1239                 monitor(null, mon bad param)
  1240                 line_lcntab(lcn) = 0
  1241                 reject connect(fn, bad param)
  1242                 release process
  1243              %finish
  1244           %else
  1245              line_lcntab(lcn) = 0
  1246              reject connect(fn, gateway full)
  1247           %finish
  1248        %else
  1249           monitor(null, mon no free lcns)
  1250           reject connect(fn, no free lcns)
  1251        %finish
  1252  
  1253     %elseif fn = enable facility %or fn = disable facility
  1254        !First get facility string from P or P_M (According to P_S1)
  1255        %if p_s1 = 0 %start
  1256           facs = p_facility
  1257        %else
  1258           facs = mes_s
  1259           buffers held = buffers held + 1   ;! Ruth 13/3/84
  1260           free buffer(mes)
  1261        %finish
  1262     
  1263        !Note that once assigned the facility has a table entry for ever
  1264        !Next, look throught table and see if we know about this one
  1265     
  1266        %if factot # 0 %start
  1267           %for i = 0, 1, factot-1 %cycle
  1268              %if faclist(i)_facility = facs %then -> assigned already
  1269           %repeat
  1270        %finish
  1271     
  1272        !Never heard of it. Make a new table entry if we can.
  1273        i = factot
  1274        %return %if factot = facmax
  1275        factot = factot + 1
  1276        faclist(i)_facility = facs
  1277  
  1278  assigned already:
  1279        !Non-zero SER indicates is is enabled. Zero SER = disabled
  1280        %if fn = enable facility %then faclist(i)_ser = p_reply %else faclist(i)_ser = 0
  1281  
  1282     %elseif fn = poke
  1283        p_s1 = 0
  1284        %if p_c2 = 0 %start
  1285           p_c1 =no of procs - free lq_count - free pq_count ;p_c2 = buffers held
  1286  
  1287        %elseif p_c2 = 1
  1288           p_c = addr(datarx)
  1289  
  1290        %elseif p_c2 = 2
  1291           p_c = addr(factot)
  1292  
  1293        %elseif p_c2 = 3
  1294           p_c = addr(busy q)
  1295  
  1296        %finish
  1297        i = p_ser ;p_ser = p_reply ;p_reply = i
  1298        cpon(p)
  1299        %return
  1300  
  1301     %else
  1302        !Process numbers: Processes are identified by two process numbers,
  1303        !but usually GATE PORT. In the case of CONNECT or DISCONNECT before
  1304        !ACCEPT CALL this is not known, so GATE PORT is 0 and the process is
  1305        !identified by the sender's process TASK PORT
  1306        %if 1 <= p_gate port <= no of procs %start
  1307           !He correctly specified one of our processes
  1308           process == proctab(p_gate port)
  1309           ->found it
  1310        %else
  1311           %if busyq_count # 0 %or p_gate port # 0 %start
  1312           !He specified his process only and there are processes active
  1313              line ==    busy q
  1314              %for i = 1, 1, busy q_count %cycle
  1315                 line == line_link
  1316                 %if line_call q_count # 0 %start
  1317                    process == line_call q
  1318                    %for j = 1, 1, line_call q_count %cycle
  1319                       process == process_link
  1320                       %if process_task id = p_reply %and process_task port=p_task port %then ->found it
  1321                    %repeat
  1322                 %finish
  1323              %repeat
  1324           %finish
  1325        %finish
  1326        !Failed to find a process corresponding to specified proc.no
  1327        monitor(p,bad process)
  1328        free buffer(mes)
  1329        %return
  1330        
  1331     found it: state == process_state
  1332     
  1333        line == process_linelink
  1334  
  1335        %if fn = put output %or fn = put control output %start
  1336           !Control data (for transmission with QBIT = 1 is flagged by a x'80'
  1337           %if fn = put output %then mes_fn = 0 %else mes_fn = x'80'
  1338           %if line_state # down %and state = estb %and process_rstate = clear %start ;!Data only valid in established call
  1339              push(process_outq,mes)
  1340              !We ignore the PUSH bit in P_S1 since all data is acknowleged
  1341              !end-to-end anyway
  1342              !MES_L contains length of Level 3 user data
  1343              handle outq ;!See if we can send anything.
  1344              %if process_outq_count + (process_ttt - process_aaa) & 7 < process_ww out %start
  1345                 !If queued buffers + buffers in transit is less than window, ack
  1346                 !immediately and count the no. of times we do so.
  1347                 process_acks = process_acks + 1
  1348                 p_s1 = 1
  1349                 to upper(null, ack)
  1350              %finish
  1351              !Allow upper  level to transmit ahead up to window limit. After that he
  1352              !will get one ack up for each rr received.
  1353           %else
  1354              monitor(p, data outside connect)
  1355              !Line down
  1356              free buffer(mes)
  1357           %finish
  1358  
  1359        %elseif fn = ack
  1360           %if process_state = estb %and process_rstate = clear %start
  1361              process_ccc = (process_ccc + p_s1) & 7
  1362              maybe send rr(null)
  1363           %finish
  1364  
  1365        %elseif fn = expedited data
  1366           %if process_istate = 0 %start
  1367              get buffer(interrupt, short)
  1368              process_istate = 1 ;!Block further interrupts or we may get reset
  1369           %finish
  1370  
  1371        %elseif fn = reset
  1372        
  1373           %if process_rstate = clear %start ;!Out of the blue
  1374              get buffer(reset request, short)
  1375              process_rstate = wrstn
  1376        
  1377           %elseif process_rstate = wrsti
  1378              !Its a confirmation to a reset we issued
  1379              get buffer(reset confirmation, short)
  1380              free buffer(pop(process_outq)) %while process_outq_count # 0
  1381              process_aaa = 0 ;process_ccc = 0 ;process_eee = 0 ;process_ttt = 0
  1382              process_tstate = clear
  1383              process_rstate = clear
  1384        
  1385           %finish
  1386           free buffer(mes)
  1387  
  1388        %elseif fn = disconnect
  1389           process_discbuff == mes
  1390           process_cv_reason = p_s1 %if process_cv_reason = 0
  1391           %if state = estb %and process_outq_count # 0 %start
  1392              state = wait data ;process_quiettime = 6
  1393           %else
  1394              %if state=estb %or state=wtacn %or state=wtaci %then %c
  1395+             get buffer(clear request, short) %elsestart
  1396                 free buffer(pop(process_outq)) %while process_outq_count # 0
  1397                 %if state = wtdsi %then release process %else state = wtdsn2 %and process_quiettime = 6
  1398              %finish
  1399           %finish
  1400  
  1401        %elseif fn = accept call
  1402           !States WTACI, WDACI
  1403           %if state = wtaci %start
  1404              !Connection now fully established. Log his process number and
  1405              process_state = estb
  1406              process_task port = p_task port
  1407              %if mes == null %start
  1408                 process_substate = process_substate ! 1 ;get buffer(call accepted, short)
  1409              %else
  1410                 i = wp to facs(substring(mes, 2), facs)
  1411                 mes_data(0) = 0
  1412                 %if i >= 0 %and process_fac & restricted rsp = 0 %start
  1413                    string(addr(mes_data(1))) = facs
  1414                    mes_l = length(facs) + 2
  1415                    to lower(mes, call accepted, -1) ;acctx = acctx + 1
  1416                    %if process_tsflag = 0 %start
  1417                       process_substate = process_substate ! 4 ;get buffer(ts accept, short)
  1418                    %finish
  1419                 %else
  1420                    !We didn't like the facilities in the Accept
  1421                    mes_data(1) = bad interface params
  1422                    to lower(mes, clear request, 0) ;clrtx = clrtx + 1
  1423                    process_state = wdaci
  1424                 %finish
  1425              %finish
  1426           %finishelse free buffer(mes) ;!Otherwise just ignore it (WDACI, WTDSI) 
  1427  
  1428        %else
  1429           stop(bad fn)
  1430  
  1431        %finish
  1432     %finish
  1433     
  1434  
  1435     %return
  1436     
  1437  %end ;
?LS unused
?L unused
?FLAGS unused
?S unused
?R unused
  1438        ;!of handle ts
  1438  
  1439  
  1440  %routine increment(%integer txrx, length)
  1441  %end ;
?LENGTH unused
?TXRX unused
  1442        ;!of Increment
  1442  
  1443  %integerfn interpret facilities(%integer fn, %bytearrayname f)
  1444     !Integerfn interprets facilities field of incoming packets
  1445     !Note - if it sees one it doesn't recognise or wants to ignore
  1446     !it assumes it occupies 2 bytes.
  1447     %integer i,p,dtel
  1448  
  1449     %if fn = clear indication %then dtel = 2 %else dtel = 0
  1450     dtel = dtel + (f(dtel)>>4 + f(dtel)&15 + 1)>>1
  1451  
  1452     i = 0
  1453     p = dtel+2
  1454  
  1455     %while p < f(dtel+1) + dtel + 2 %cycle
  1456        %if f(p) = x'43' %start
  1457           process_ww in = f(p+1)
  1458           process_ww out = f(p+2)
  1459           i = i ! ww set
  1460           p = p + 1 ;!i.e. one more than basic 2 bytes
  1461  
  1462        %elseif f(p) = x'42'
  1463           !Not our problem
  1464           process_ps in = f(p+1)
  1465           process_ps out = f(p+2)
  1466           i = i ! ps set
  1467           p = p + 1
  1468  
  1469        %elseif f(p) = x'C1'
  1470           !Duration always comes before stats
  1471           p = p + 12
  1472  
  1473        %elseif f(p) = 1 ;!Rev. Charging & Fast Select (+/- Rest. Resp.)
  1474           process_fac = f(p+1)
  1475           %if f(p+1) & 1 # 0 %start ;!Reverse charging
  1476              %result = not negotiable
  1477  
  1478           %elseif f(p+1) & x'C0' = x'C0' ;!Fast Select - Restricted Response
  1479              i = i ! fast select ! restricted rsp
  1480  
  1481           %elseif f(p+1) & x'80' # 0 ;!Fast Select
  1482              i = i ! fast select
  1483  
  1484           %finish
  1485        %finish
  1486  
  1487        p = p + 2
  1488     %repeat
  1489     %result = i
  1490  %end ;!of Interpret Facilities
  1491  
  1492  
  1493  %routine maybe send rr(%record (mef) %name mes)
  1494     !Send a level 3 RR if we absolutely have to. Defer it otherwise till the next tick
  1495  
  1496     %if mes == null %then get buffer(rr, short) %and %return
  1497  
  1498    !The complex condition: Send an RR or RNR if...
  1499     !Cond. 1: We have got a deferred RR or RNR outstanding already
  1500     !Cond. 2: We don't have any buffers queued and he is out of window,
  1501     !Cond. 3: We have buffers queued and he has RNR up against us.
  1502     !Cond: 4: buffers are low
  1503  
  1504  !!   %if process_substate & 48 # 0 %or %c
  1505  !!   (process_outq_count = 0 %and (process_ccc - process_aaa) & 7 >= process_ww in) %or %c
  1506  !!   (process_outq_count # 0 %and process_tstate = set) %or %c
  1507  !!   no of buff < critical long %start
  1508  
  1509  !!      %if no of buff > critical long %start;   ! removed by B.G. 15.dec.83
  1510           to lower(mes, rr, 0) ;rrtx = rrtx + 1 ;process_substate = process_substate & (\48)
  1511  !!      %else
  1512  {         to lower(mes, rnr, 0) ;rnrtx = rnrtx + 1 ;process_substate = process_substate ! 32}
  1513  !      %finish
  1514  !!   %else
  1515  !!      process_substate = process_substate ! 16
  1516  !!      !Defer sending anything till next block or timer
  1517  !!      free buffer(mes)
  1518  !!   %finish
  1519  %end ;!of Maybe send rr
  1520  
  1521  
  1522  %routine monitor(%record (pf) %name p,%integer type)
  1523  %end ;
?TYPE unused
?P unused
  1524        ;!of MONITOR
  1524  
  1525  
  1526  
  1527  %routine move(%integer len, from, to)
  1528  !
  1529  ! 'Assembler Routine' to emulate EMAS MOVE.
  1530  ! Note: 1. No action if LEN<=0
  1531  !       2. Registers 1,2 and 3 used.
  1532  !
  1533  %label loop, return
  1534  !
  1535        *mov_len,1          ;! Load the length
  1536        *ble_return         ;! Return if less than or equal to zero
  1537        *mov_from,2         ;! Load the FROM address
  1538        *mov_to,3           ;! Load the TO address
  1539  !
  1540  !     Loop to move LEN bytes FROM -> TO
  1541  !
  1542  loop: *movb_(2)+,(3)+     ;! Move the byte
  1543        *sob_1,loop         ;! Decrement length count: Continue if length not exhausted       
  1544  return:
  1545        %return
  1546  %end
  1547  
  1548  
  1549  %integerfn next free lcn(%integer dcedte)
  1550     !Find the next free LCN. Test is done inside loop to save code.
  1551     !Remember that DTEs go from top down and DCEs from 0 up
  1552     %integer i, j
  1553     %for i = no of lcns-1, -1, 0 %cycle
  1554        %if dcedte = dte %then j = i %else j = no of lcns - i
  1555        %if line_lcntab(j) = 0 %then line_lcntab(j) = 1 %and %result = j
  1556     %repeat
  1557     %result = -1
  1558  %end ;!of Next free LCN
  1559  
  1560  %routine pack bcd string(%string(255) s,%bytearrayname a, %c
  1561+    %integername index)
  1562     !This routine takes a decimal number as a character string and packs it into A
  1563     !in packed BCD (two digits per byte) starting
  1564     ! at A(INDEX) and updating INDEX as it goes. INDEX is a global
  1565     !variable used for this purpose. Trailing quartets are set to zero.
  1566     !This routine is intended primarily for packing X-25 addresses
  1567     %routinespec pack bcd char(%byte no)
  1568     %integer i
  1569     
  1570     %if length(s) > 0 %start
  1571        %for i=1,1,length(s) %cycle
  1572           pack bcd char(charno(s,i) - '0')
  1573        %repeat
  1574     %finish
  1575     
  1576     index=(index+1)&x'FE' ;!Rounds INDEX up to the nearest byte boundary
  1577     %return
  1578  
  1579     %routine pack bcd char(%byte no)
  1580        
  1581        %integer p
  1582        p=index>>1
  1583        %if index&1=0 %then a(p)=no<<4 %else a(p) = a(p)+no&15
  1584        index = index + 1
  1585        
  1586     %end ;!of PACK BCD CHAR
  1587  %end ;!of PACK BCD STRING
  1588  
  1589  %routine packchar(%byte char, %record (mef) %name mes)
  1590     mes_a(mes_l) = char
  1591     mes_l = mes_l + 1
  1592  %end ;!of Pack Char
  1593  
  1594  %integerfn packetlength(%integer fn)
  1595     !Returns the length of the control fields in an X-25 packet.
  1596     !Call request, Data are not catered for
  1597     %if fn = 19 %or fn = 27 %or fn = 251 %thenresult = 2 ;!Clear & conf, Reset & conf, Restart & conf.
  1598     %if fn = 35 %then %result = 1 ;!Interrupt
  1599     %result = 0
  1600  %end ;!of PACKETLENGTH
  1601  
  1602  
  1603  %routine pack string(%string (255) %name s,%record (mef) %name mes)
  1604     !Add string S as a substring to MES_A, taking the end of MES_A
  1605     !From a length supplied in MES_L
  1606     
  1607     string(addr(mes_a(mes_l))) = s
  1608  
  1609     mes_l = mes_l + length(s) + 1
  1610     
  1611  %end ;!of PACKSTRING
  1612  
  1613  %routine pack ts string(%string (255) s, %string (255) %name t)
  1614     !Add s as a TS substring to t.
  1615  
  1616     length(t) = length(t) + 1
  1617     charno(t, length(t)) = length(s) ! 128
  1618     t = t.s
  1619  %end
  1620  
  1621  %routine pull(%record (qf) %name q,item)
  1622     !Pulls the specified item off a circular queue with header at Q
  1623     %record (qf) %name p
  1624  !   %integer x
  1625  
  1626     %if q_link == null %then %return ;!No elements (Why??)
  1627     q_count = q_count - 1
  1628     %if q_link_link == q_link %then q_link == null %and %return ;!One element on Q
  1629  
  1630     p == q
  1631     %cycle
  1632        p == p_link
  1633  !      x = x + 1
  1634  !      %if x > q_count + 1 %then stop(looping for process)
  1635     %repeatuntil p_link == item
  1636     p_link == p_link_link
  1637     %if q_link == item %then q_link == p ;!If we removed Q head, reposition it
  1638  %end
  1639  
  1640  
  1641  
  1642  
  1643  %routine query processes
  1644     %integer i,j,k
  1645     %record (linef) %name ln
  1646     %record (procf) %name pr
  1647     printstring("BH=") ;write(buffers held, 1)
  1648     newline
  1649     %if busy q_count # 0 %start
  1650        ln == busy q
  1651        %for i = 1,1,busy q_count %cycle
  1652           ln == ln_link
  1653           write(ln_procno,1) ;printsymbol('/')
  1654           %if ln_dcedte = dce %then printstring(" DCE") %else printstring(" DTE")
  1655           printstring(" S,ID,L,LG") ;write(ln_state, 1)
  1656           write(ln_ser, 1) ;write(ln_lineno, 1) ;write(ln_lcgn, 1)
  1657           newline
  1658           %if ln_call q_count # 0 %start
  1659              pr == ln_callq
  1660              %for j = 1,1,ln_call q_count %cycle
  1661                 pr == pr_link
  1662                 spaces(3)
  1663                 write(pr_procno, -1) ;printsymbol('/')
  1664                 printstring(" ST=") ;write(pr_state,-1) ;printsymbol('/')
  1665                 write(pr_substate, -1) ;write(pr_tstate, -1) ;write(pr_rstate, 1)
  1666                 printstring(" ID=") ;write(pr_task id,-1)
  1667                 printsymbol('.') ;write(pr_task port, -1)
  1668                 printstring(" LC=") ;write(pr_lcgn,-1)
  1669                 printsymbol('.') ;write(pr_lcn, -1)
  1670                 printstring(" TS,QU,OQ:") ;write(pr_tsflag, -1)
  1671                 write(pr_quiettime, 1) ;write(pr_outq_count, 1)
  1672                 printstring(" WI,WO,PI,PO:")
  1673                 write(pr_ww in, -1) ;write(pr_ww out, 1) ;write(pr_ps in, 1) ;write(pr_ps out, 1)
  1674                 printstring(" AETC:") ;write(pr_aaa, -1)
  1675                 write(pr_eee,-1) ;write(pr_ttt,-1) ;write(pr_ccc,-1)
  1676                 printstring("
  1677+    CV")
  1678                 %if pr_cv_l > 0 %and pr_cv_l <= 27 %start
  1679                    %for k = 0,1,pr_cv_l %cycle ;write(pr_cv_a(k),1) ;%repeat
  1680                 %finish
  1681                 newline
  1682              %repeat
  1683           %finish
  1684        %repeat
  1685     %finish
  1686  %end ;!of Query Processes
  1687  
  1688  %routine reject connect(%integer fn, qualifier)
  1689     !Reject CONNECT outright
  1690     %byte ser
  1691     ser = p_ser ;p_ser = p_reply ;p_reply = ser ;!Send it back whence it came
  1692     p_fn = disconnect
  1693     free buffer(p_m); p_m == null
  1694     p_s1 = qualifier
  1695     monitor(p, to up)
  1696     pon(p)
  1697  %end
?FN unused
  1698  
  1699  %routine reject call(%integer qualifier, rejtype)
  1700     !This routine rejects calls either (rejtype = 0) outright without
  1701     !there being a process around or (rejtype = 1) with a process around.
  1702     %byte ser
  1703     %if rejtype = 0 %start; !Reject incoming call outright
  1704  
  1705        !Dont use TO LOWER as we dont have a process
  1706        p_m_fn = clear request %unless qualifier = spurious clear req
  1707        p_m_data(0) = 0 ;!Clearing cause = DTE Clearing
  1708        p_m_data(1) = qualifier ;!Diagnostics
  1709        ser = p_ser ;p_ser = p_reply ;p_reply = ser
  1710        p_fn = line output
  1711        p_len = 5
  1712        monitor(p, to low)
  1713        cpon(p)
  1714     %else
  1715        process_state = wtdsn
  1716        p_m_data(1) = prot not supported
  1717        to lower(p_m, clear request, 0)
  1718     %finish
  1719     clrtx = clrtx + 1
  1720  %end ;!of REJECT CALL
  1721  
  1722  %string (255) %fn sub string(%record (mef) %name mes, %integer no)
  1723     %integer i,l
  1724     %unless mes == null %start
  1725        l=0
  1726        %while no > 1 %cycle
  1727           l=l+mes_a(l)+1
  1728           %result = "" %if l >= mes_l
  1729           no = no - 1
  1730        %repeat
  1731     
  1732        %if mes_a(l) > 63 %then %result = "Err/Too Long" %else %result = string(addr(mes_a(l)))
  1733     %finishelse %result = ""
  1734  %end ;
?I unused
  1735        ;!of SUB STRING
  1735  
  1736  
  1737  
  1738  %routine release process
  1739     %integer i
  1740     !Tidy up process.
  1741     !Clear out-bound data queue
  1742     free buffer(pop(process_outq)) %while process_outq_count # 0
  1743     free buffer(process_discbuff); process_discbuff == null
  1744     free buffer(process_clrbuff);process_clrbuff == null
  1745  
  1746     pull(line_call q,process) ;push(free pq,process)
  1747        
  1748  %end ;
?I unused
  1749        ;!of RELEASE PROCESS
  1749  
  1750  
  1751  %routine restart processes
  1752     %integer i
  1753     %bytename state
  1754     %record (mef) %name mes
  1755     %record (procf) %name pr
  1756     %if line_call q_count # 0 %start
  1757        process == line_call q_link
  1758        %for i = 1,1,line_call q_count %cycle
  1759           pr == process_link
  1760           state == process_state
  1761           process_cv_reason = call restarted
  1762           %if state = wtdsn %then release process %elsestart
  1763              %if process_substate & 2 = 0 %then process_substate = process_substate ! 2 %and get buffer(disconnect, long) 
  1764              
  1765           %finish
  1766           line_lcntab(process_lcn) = 0 ;!Free off LCN
  1767           process_lcn = 255 ;!Decouple process from LCN/LCGN
  1768           process == pr
  1769        %repeat
  1770     %finish
  1771     
  1772  %end ;
?MES unused
  1773        ;!of RESTART PROCESSES
  1773  
  1774  
  1775  %integerfn stoi(%string (15) s)
  1776     %integer n,i
  1777     n=0
  1778     %if length(s) > 0 %start
  1779        %for i = 1,1,length(s) %cycle
  1780           n = n*10 + charno(s,i)-'0'
  1781        %repeat
  1782     %finish
  1783     %result = n
  1784  %end ;!of Stoi
  1785  
  1786  %routine stop(%integer reason)
  1787     printstring("*GATX Disaster ") ;write(reason, 1) ;newline
  1788     monitor(null, query)
  1789     %cycle
  1790     %repeat
  1791  %end ;!of Stop
  1792  
  1793  %routine to account(%record (mef) %name mes, %integer fn)
  1794     p_ser = account ser
  1795     p_reply = gatex ser
  1796     p_fn = fn
  1797     p_m == mes
  1798        p_s1 = gatex ser
  1799        p_c2 = line_lineno
  1800     monitor(p, mon to acct)
  1801     cpon(p)
  1802  %end ;!of To Account
  1803  
  1804  
  1805  %routine to lower(%record (mef) %name mes, %integer fn, datal)
  1806     !datal is the length used to calculate no. of segments transmitted,
  1807     !using the PSS algorithm. Datal is sometimes supplied as 0 (= 1 segment)
  1808     !when the data field is known to be less than 63 bytes to avoid unnecessary
  1809     !calculation.    A supplied value of -1 means "don't count this one"
  1810     %record (pf) p
  1811     !Find the length of the Packet. For most packets this is fixed
  1812     !but for Data,interrupt and connect packets it must be supplied. Length
  1813     !supplied is Level 3 data length + 3 bytes control
  1814     mes_l = packetlength(fn) %unless fn = dte data %or fn = call request %or fn = call accepted
  1815  
  1816     %if fn < 250 %start ;!Not Restarts or Restart Confirmations
  1817        mes_octet1 = gfi + process_lcgn
  1818        %if fn = dce data %then mes_octet1 = mes_octet1 ! (MES_FN & X'80')
  1819        !Q-bit buried in bit 2**7 of MES_FN
  1820        mes_lcn = process_lcn ;!Bottom byte only
  1821  
  1822        %if fn&3 # 3 %start ;!Data, RR, RNR, REJ
  1823           fn = fn ! PROCESS_CCC<<5
  1824           %if fn&1 = 0 %then fn = fn ! PROCESS_TTT<<1 
  1825           !We dont use the M bit
  1826        %finish
  1827     %else
  1828        mes_octet1 = gfi
  1829        mes_lcn = 0
  1830     %finish
  1831  
  1832     %if datal > 0 %then increment(tx, datal)
  1833     %if fn = clear request %or fn >= 250 %start
  1834        mes_a(0) = 9; !Allow for cause and diags bytes
  1835        %unless fn # clear request %or process_discbuff == null %start
  1836           mes_a(0) = mes_a(0) + 2; !Fast select. 
  1837           !These are DTE/DCE address lengths and facilities length.
  1838           mes_data(2) = 0; mes_data(3) = 0
  1839           pack ts string(substring(process_discbuff, 2), mes_s)
  1840           pack ts string(substring(process_discbuff, 3), mes_s)
  1841           mes_l = length(mes_s) - 4
  1842           free buffer(process_discbuff); process_discbuff == null
  1843        %finish
  1844        mes_data(0) = 0; !Cause is always zero from us
  1845     %finish
  1846  
  1847     process_substate = process_substate & (\16)
  1848  
  1849     mes_fn = fn
  1850     p_ser = line_ser
  1851     p_reply = gatex ser
  1852     p_fn = line output
  1853     p_process = line_line no
  1854     p_m == mes
  1855     p_len = mes_l + 3
  1856     monitor(p, to low)
  1857     cpon(p)
  1858  
  1859  %end ;!of To Lower
  1860  
  1861  
  1862  %routine to upper(%record (mef) %name mes, %integer fn)
  1863     p_ser = process_task id
  1864     p_reply = gatex ser
  1865     p_fn = fn
  1866     p_gate port = process_procno
  1867     p_task port = process_task port
  1868     p_m == mes
  1869     monitor(p, to up)
  1870     cpon(p)
  1871  %end ;!of TO UPPER
  1872  
  1873  
  1874  %string (63) %fn ts substring(%record (mef) %name mes, %integer ptr, no)
  1875     !Routine to unpack Transport service substrings.
  1876     !NO contains the substring number to go looking for
  1877     !%result = "Err" if the TS substring was invalid
  1878     !%result = "" if the substring is not there.
  1879     !Note that currently a split substring will be rejected.
  1880     !Note also that ptr is referenced to mes_data(0) but that mes_l includes
  1881     !the x25 3-byte packet header
  1882  
  1883     %string (63) t
  1884     %integer c
  1885  
  1886     %cycle
  1887        %result = "" %if ptr >= mes_l-3 ;!TS substring not present
  1888  
  1889        c = mes_data(ptr)
  1890        %result = "Err" %if c & 64 # 0
  1891        no = no - 1
  1892        %exit %if no <= 0
  1893        ptr = ptr + c & 63 + 1
  1894     %repeat
  1895  
  1896     !If TS substring overflows end of block it is invalid
  1897     %result = "Err" %if ptr + c & 63 > mes_l-3
  1898     move((c & 63) + 1, addr(mes_data(ptr)), addr(t))
  1899     length(t) = length(t) & 63
  1900     %result = t
  1901  %end ;!of TS Substring
  1902  
  1903  
  1904  %routine unravel ts(%string (63) %name ts addr, ts params, %integername line)
  1905     !Routine takes a TS address of the general form <Net>.<NUA>.<residue>
  1906     !and splits it up into those components, making allowance for defaults.
  1907     %integerfnspec getnet(%string (63) %name s)
  1908     %string (63) ls
  1909     %if ts addr -> ls.(".").ts addr %start
  1910        !Not just a bare NUA. Possible formats are <Net>.<NUA>.<residue>
  1911        !or <NUA>.<residue>       Remember <residue> may contain dots.
  1912        line = getnet(ls)
  1913        %if line >= 0 %start
  1914           !It was <Net>....
  1915           ts params = "" %unless ts addr -> ts addr.(".").ts params
  1916  
  1917        %else
  1918           !It was <NUA>...  Our address and params strings are in the wrong place.
  1919           line = default line ;ts params = ts addr ;ts addr = ls
  1920  
  1921        %finish
  1922  
  1923     %else
  1924        !It was just <NUA>.   Return defaults. ts addr should be unaltered
  1925        line = default line ;ts params = ""
  1926  
  1927     %finish
  1928  
  1929     %integerfn getnet(%string (63) %name s)
  1930        !Find out if s is a valid network name and if so what line its on
  1931        %integer i
  1932        %for i = 0, 1, no of x25 nets - 1 %cycle
  1933           %result = i %if s = shortnetname(i) %or s = longnetname(i)
  1934        %repeat
  1935        %result = -1
  1936     %end ;!of getnet (in unravel ts
  1937  
  1938  
  1939  %end ;!of Unravel TS
  1940  
  1941  
  1942  %string (15) %fn unpack bcd string(%bytearrayname a, %integer no)
  1943     !Retrieves X-25 addresses. These are presented as:
  1944     !Length(caller),Length(called),called,caller. Lengths are 1 
  1945     !quartet each.  NO=1 gives us the length and contents of caller
  1946     !               NO=0   "    "  "     "    "     "      " called
  1947     %bytefnspec next bcd char
  1948     %integer i,l,index
  1949     %string(255) s
  1950     l=(a(0)>>(no*4))&15 ;!Assumes >>0 is valid.
  1951     index = (a(0)&15)*no + 2
  1952     
  1953     %if l>0 %start
  1954        %for i=1, 1, l %cycle
  1955           charno(s,i) = next bcd char + '0'
  1956        %repeat
  1957     
  1958        length(s) = l
  1959        %result = s
  1960     %finishelseresult = ""
  1961     
  1962     %bytefn next bcd char
  1963        %byte b
  1964        %if index&1 = 0 %then b = a(index>>1)>>4 %else b = a(index>>1)&15
  1965        index = index + 1
  1966        %result = b
  1967     %end ;!of NEXT BCD CHAR
  1968  %end ;!of UNPACK BCD STRING
  1969  
  1970  %integerfn wp to facs(%string (31) facs, %string (31) %name pssfacs)
  1971     !Take a facilities field presented as "W=m/n,P=m/n" and
  1972     !1) validate it, 2) pull out facilities values, and 3) set flags
  1973     !to indicate which were specified.  Thi function is essentially
  1974     !the opposite of Form Facilities
  1975     %bytefnspec shift(%integer n)
  1976  
  1977     %string (15) m,n
  1978     %integer im, in, l, flags
  1979  
  1980     l = 0 ;flags = 0 ;pssfacs = ""
  1981  
  1982     %result = -8 %if length(facs) > 21 ;!Max = "W=7/7,P=256/256,C=RFS" (21 chars)
  1983  
  1984     %if facs -> facs.("C=").m %start ;!Strip connection controls off
  1985        length(facs) = length(facs) - 1 %if length(facs) > 0 ;!Strip off the comma
  1986        process_fac = process_fac ! reverse charge bit %if m -> ("R").m
  1987        process_fac = process_fac ! fast select %if m -> ("F").m
  1988        process_fac = process_fac ! fast select ! restricted rsp %if m -> ("S").m
  1989     %finish
  1990  
  1991     %if facs -> facs.("P=").m %start ;!Strip packet size indication
  1992        length(facs) = length(facs) - 1 %if length(facs) > 0 ;!Strip off comma
  1993        %result = -6 %unless m -> m.("/").n
  1994        im = stoi(m) ;in = stoi(n)
  1995        im = shift(im) ;in = shift(in)
  1996        %result = -7 %unless im # 0 %and in # 0
  1997        process_ps in = im ;process_ps out = in
  1998        charno(pssfacs, l+1) = x'42' ;charno(pssfacs, l+2) = im ;charno(pssfacs, l+3) = in
  1999        l = l + 3
  2000     %finish
  2001  
  2002     %if facs -> ("W=").m %start ;!Window size indication
  2003        %result = -4 %unless m -> m.("/").n
  2004        im = stoi(m) ;in = stoi(n)
  2005        %result = -5 %unless 0 <= im <= 7 %and 0 <= in <= 7
  2006        process_ww in = im ;process_ww out = in
  2007        charno(pssfacs, l+1) = x'43' ;charno(pssfacs, l+2) = im ;charno(pssfacs, l+3) = in
  2008        l = l + 3
  2009     %finish
  2010  
  2011  
  2012     length(pssfacs) = l
  2013     %result = 0
  2014  
  2015     %bytefn shift(%integer n)
  2016        !Function to convert from an integer packet size to form n
  2017        !where 2**n = packet size. Function just shifts right till either
  2018        !we get bored or we are left with the topmost bit. I'm sure there
  2019        !is a clever way to do this in assembler.
  2020  
  2021        %integer i
  2022  
  2023        %for i = 0,1,15 %cycle ;!Its a 16-bit integer
  2024           %result = i %if n = 1 ;!Gotcha
  2025           n = n >> 1
  2026        %repeat
  2027  
  2028        %result = 0 ;!Signifies invalid packet size. (NB: size=1 does also)
  2029     %end ;!of Shift (in WP to Facs)
  2030  %end ;!of WP to Facs
  2031  %endofprogram
?SETPRIO unused
?GETID unused
?MAPHWR unused
?MAPABS unused
?DUPADDR unused
?S unused
?R unused
?RSTTX unused
?RESCTX unused
?RESTX unused
?INTTX unused
?REJTX unused
?RNRTX unused
?D1 unused
?RESCRX unused
?CALLRX unused
?REJRX unused
?TIMEF unused
?CVF unused
?X25F unused
?HDRL unused
?FAST unused
?TXC unused
?CRITICALLONG unused
?PFTPSER unused
?TIMESER unused
?BRIDGESER unused
?PCMDSER unused
?PCMCSER unused
?PCMBSER unused
?PCMASER unused
?GLUESER unused
?RLOOPSER unused
?LOOPBSER unused
?KERNELSER unused
?TSBSER unused
?TESTSER unused
?GATESER unused
?SHORTINTERACTIONFAILS unused
?SHORTINTERACTION unused
?UNKNOWNFAILURE unused
?FACSNOTNEGOTIABLE unused
?USERABORT unused
?TIMEDOUT unused
?OPERATORABORT unused
?CALLRESET unused
?FARENDHUNG unused
?SESSIONLEVELERROR unused
?ACCOUNTINGFAILURE unused
?NOUSERSERVICE unused
?FACILITYUNAVAILABLE unused
?CONVERSATIONTERMINATED unused
?SOFTLYSOFTLY unused
?NOLOOPBACK unused
?SHUTDOWNIMMINENT unused
?CAUSEUNKNOWN unused
?INVALIDPASS unused
?INVALIDUSER unused
?REPLY unused
?TSRESETBEFOREACCEPT unused
?TSDISCONNECTAFTERRESET 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
?TSACCESSBARRED unused
?TSINVALIDADDRESS unused
?TSOUTOFORDER unused
?TSNOCONNECTION unused
?TSRESPONSE unused
?TSOK unused
?PSSPROTNOTSUPPORTED unused
?RESTARTREQUEST unused
?TSCONNECT unused
?NOGOAHEADS unused
?PROD unused
?DATA unused
?CONTROLDATA unused
?DATAGRAMREPLY unused
?DATAGRAM 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
?FTPSTREAM unused
?TIMESTREAM unused
?INFOSTREAM unused
?ITPSTREAM unused
?LPSTREAM unused
?DOCINPUTPR unused
?DOCINPUTCR unused
?BMS unused
?NOOFBUFF unused
?OWNID unused
?TTSER unused
?LF unused
?CR unused
?FALSE unused
?TRUE unused
?SYSPASS unused
?SYSNAME unused
?NOOFRCONETS unused
?RCOLINE unused
?PSSLINE unused
?SERCLINE unused
?NOOFNETS unused
?NOOFTSBPROCS unused
?MAXL3PACKET unused
?GATEPORT2 unused
?GATEPORT1 unused
?MAXBLOCKS unused
?BLOCKSIZE unused
?HUB unused
?LUB unused
?FSYS unused
?DRIVE unused
?DATESTRING unused
?LOOPINGFORPROCESS unused
?BADOUTSTATE unused
?OK unused
?ACKPENDING unused
?IDLE unused
