Source file: J#IMP       Compiled: 30-MAY-1984  15.50.16
Object file: J#REL

         Edinburgh IMP77 Compiler - Version 8.2 release 3

     1  %control 1
     2  
     3  
     4  !*******************************************
     5  !*                                         *
     6  !*   Accounting and Accrediting Module     *
     7  !*                                         *
     8  !*               ACCOUNT                   *
     9  !*                                         *
    10  !*     Version     9.26 19 Mar  1984       *
    11  !*                                         *
    12  !*******************************************
    13  !*
    14  %begin
    15  
    16  ! Options used:T#A,J#IMP,G,CLEAN
    17  %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
    18  %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
    19  !@@ %include "ercm06.inc_nvarious"
    20  %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
    21  %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
    22  %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
    23  %include "ercm06.INC_FSYS"
&    0  !
&    1  !     FILE SYSTEM HANDLER INTERFACE
&    2  !
&    3  %CONSTINTEGER EXAMINE=0
&    4  %CONSTINTEGER GET NEXT=1
&    5  %CONSTINTEGER DESTROY=2
&    6  %CONSTINTEGER CREATE=3
&    7  %CONSTINTEGER APPEND=4
&    8  %CONSTINTEGER RENAME=5
&    9  %CONSTINTEGER RENAME TEMP=6
&   10  %CONSTINTEGER RENAME FSYS=7
&   11  %CONSTINTEGER GET DIR=8
&   12  %ENDOFFILE
    24  %include "ercm06.INC_ITPBITS"
&    0  !Value of control bits used in ITP
&    1  
&    2  %CONSTBYTEINTEGER CONTROLBIT           =  1
&    3  %CONSTBYTEINTEGER GOAHEADBIT           =  2
&    4  %CONSTBYTEINTEGER GOODBYEBIT           =  4
&    5  %CONSTBYTEINTEGER HELLOBIT             =  8
&    6  %CONSTBYTEINTEGER BREAKINBIT           =  1
&    7  %CONSTBYTEINTEGER SETMODEBIT           =  2
&    8  %CONSTBYTEINTEGER KILLRXBIT            =  4
&    9  %CONSTBYTEINTEGER KILLTXBIT            =  8
&   10  %CONSTBYTEINTEGER BINCHARBIT           =  1
&   11  %CONSTBYTEINTEGER TERMINATEBIT         =  2
&   12  %CONSTBYTEINTEGER PROMPTBIT            =  4
&   13  %CONSTBYTEINTEGER MARKERBIT            =  8
&   14  %CONSTBYTEINTEGER SEQVALIDBIT          = 32
&   15  %CONSTBYTEINTEGER SEQNOBITS            =192
&   16  %CONSTBYTEINTEGER BINARY               =  1
&   17  %CONSTBYTEINTEGER CHARACTER            =  0
&   18  
&   19  %ENDOFFILE
    25  
    26  !Note these are INTERNAL MESSAGE NOS with a tag, NOT disc. qualifiers
    27  %constinteger nullmsg                  = x'80'
    28  %constinteger invalid facility         = x'81'
    29  %constinteger illegal command          = x'82'
    30  %constinteger user not found           = x'83'
    31  %constinteger host not found           = x'84'
    32  %constinteger duplicate user           = x'85'
    33  %constinteger duplicate host           = x'86'
    34  %constinteger invalid password         = x'87'
    35  %constinteger invalid category         = x'88'
    36  %constinteger invalid funds            = x'89'
    37  %constinteger invalid username         = x'8A'
    38  %constinteger directory full           = x'8B'
    39  %constinteger parameter missing        = x'8C'
    40  %constinteger invalid service no       = x'8D'
    41  %constinteger invalid facilities       = x'8E'
    42  %constinteger invalid cudf             = x'8F'
    43  %constinteger text too long            = x'90'
    44  %constinteger prot not available       = x'91'
    45  %constinteger access failure           = x'92'
    46  %constinteger user deaf                = x'93'
    47  %constinteger no funds                 = x'94'
    48  %constinteger invalid network          = x'95'
    49  %constinteger preset                   = x'FF'
    50  
    51  %constinteger call                     =  0
    52  %constinteger user                     =  1
    53  %constinteger tell                     =  2
    54  %constinteger password                 =  3
    55  %constinteger host                     =  4
    56  %constinteger help                     =  5
    57  %constinteger alert                    =  6
    58  %constinteger name                     =  7
    59  %constinteger deaf                     =  8
    60  %constinteger line                     =  9
    61  %constinteger info                     = 10
    62  %constinteger files                    = 11
    63  %constinteger notice                   = 12
    64  %constinteger abort                    = 13
    65  %constinteger newhost                  = 14
    66  %constinteger newname                  = 15
    67  %constinteger deletehost               = 16
    68  %constinteger deletename               = 17
    69  %constinteger newalert                 = 18
    70  %constinteger funds                    = 19
    71  %constinteger newacct                  = 20
    72  %constinteger newhelp                  = 21
    73  %constinteger limitusers               = 22
    74  %constinteger closeusers               = 23
    75  %constinteger tcat                     = 24
    76  %constinteger tcom                     = 25
    77  %constinteger ucat                     = 26
    78  %constinteger pseud                    = 27
    79  %constinteger open                     = 28
    80  %constinteger invalid                  = 29
    81  
    82  %constinteger out of range             =  1
    83  %constinteger bad key                  = 2
    84  %constinteger not found                = 3
    85  %constinteger block 0 error            = 4
    86  %constinteger append failure           = 5
    87  %constinteger cell 0 failure           =  6
    88  %constinteger file too big             =  7
    89  %constinteger header missing           =  8
    90  %constinteger insert                   = 0
    91  %constinteger remove                   = 1
    92  %constinteger display                  = 2
    93  %constinteger unknown                  = 3
    94  %constinteger end                      = 4
    95  %constinteger discread                 = 0
    96  %constinteger discwrite                = 1
    97  %constinteger free                     = 0
    98  %constinteger in use                   = 1
    99  %constinteger headercell               = 2
   100  
   101  %constinteger account record = 0
   102  %constinteger open record = 1
   103  %constinteger close record = 2
   104  %constinteger eof record = 3
   105  %constinteger dafile = 0
   106  %constinteger sqfile =  1
   107  %constinteger window =  2
   108  %constinteger idle =  0 ;!FIXED
   109  %constinteger accredited =  1
   110  %constinteger charging =  2
   111  %constinteger wait for hello =  5
   112  %constinteger estb =  6
   113  %constinteger wait for disc =  7
   114  
   115  %constinteger down = 0
   116  %constinteger up = 1
   117  %constinteger closing = 2
   118  %constinteger sync = 0
   119  
   120  %constinteger unlimited = -1 ;!Funds unlimited not goaheads this time
   121  %constinteger message = 9
   122  %constinteger old enable facility =  1
   123  %constinteger call reply =  3
   124  %constinteger message reply = 10
   125  
   126  %constinteger ok               =  0
   127  
   128  %owninteger max users = no of procs + no of tsb procs - 2
   129  %owninteger no of users = 0
   130  %ownbyte service =  up
   131  %ownstring(2) nlstr = "<>"
   132  
   133  %owninteger rc,block,currentcell,currentblock,opencell = -1
   134  %owninteger curwritten = 0
   135  %owninteger i,linetype,buffers held, weekday = 0
   136  
   137  %include "ercm06.INC_nFORMATS"
&    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(252) s %or %bytearray a(0:252)))
&    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 %or %string (243) ds)) %c
&    8+    %or %string(250) s ))
&    9  %recordformat filef(%byte unit, fsys, %bytearray name(0:5), %c
&   10+ %integer cellsize,no of cells,no of blocks,cells per block,type, %integerarray blockno(0:maxblocks-1))
&   11  %recordformat pf( %c
&   12+     (%byte ser, reply, fn, s1, %record (mef) %name m, %byte gate port, task port) %c
&   13+ %or (%byte d1, d2, d3, process, %record (filef) %name f, %integer len) %c
&   14+ %or (%integer address, d5, %string (3) facility) %c
&   15+ %or (%byte d6, d7, a1, a2, b1, b2, c1, c2) %c
&   16+  %or (%integer type, a, b, c))
&   17  %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
&   18+                          %or %bytearray a(0:26)) %c
&   19+                %or %string(27) s)
&   20  
&   21  %endoffile
   138  !@@ %include "ercm09.b_deimosspecs"
   139  %recordformat mefs(%byte ser,category,l,chargeband, (%bytearray a(0:81) %or %string(81) s))
   140  !SER takes the place of LINK so PACKSTRNG packs successfully into TCELLs
   141  
   142  
   143  
   144  %recordformat cellf( %c
   145+     %bytearray a(0:127) %c
   146+ %or (%integer flag, (%bytearray b(0:125) %c
   147+                 %or (%integer no of cells, generation, %string (121) s1) %c
   148+                 %or (%integer type, %string(7) user, %string(31) source, %string (31) destination, %c
   149+                      %integer sdate, stime, edate, etime, %record (cvf) cv, %c
   150+                     %integer charge, %byte procno, chargeband, %string(11) s3) %c
   151+                 %or (%string (7) key, ((%record (mefs) m, %string(31) comment)  %c
   152+                                  %or (%string(7) pass, %integer fundsmax, category, %byte maxcur, timeout, %c
   153+                                   %integer funds, %string(5) s4))))))
   154  
   155  %recordformat ucellf(%integer flag, %string(7) key, pass, %c
   156+ %integer fundsmax, category, %byte maxcur, timeout, %integer funds,  %string(5) spare)
   157  !NB: Append free cell contains record which must be of largest
   158  !Cell format
   159  !Tcellf_Key and Ucellf_Key must be same length and in same place
   160  %recordformat sfilef(%byte unit, fsys, %bytearray name(0:5), %c
   161+ %integer cellsize, no of cells, no of blocks, cells per block, type, %c
   162+ %integerarray blockno(0:15))
   163  %recordformat bff(%bytearray a(0:blocksize-1) %or %c
   164+ (%integer flag, no of cells, generation))
   165  %constrecord (*) %name null == 0
   166  
   167  %recordformat procf(%byte state,mode,outputs,cnsl,ser,gate port,task port, %c
   168+ cmd,%record (filef) %name curfil, %c
   169+ %record (mef) %name outbuff, %integer category,curcell, srcecell, deaf, %c
   170+ %string (1) user, %string (15) source, %string (7) destination)
   171  
   172  %ownrecord (procf) %array proctab(1:no of procs+no of tsb procs) = 0(no of procs+no of tsb procs)
   173  
   174  %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
   175  
   176  %integerfnspec b to i(%byte b)
   177  %routinespec closedown
   178  %integerfnspec decode(%string (127) %name s)
   179  %string (95) %fnspec display host(%record (cellf) %name trec)
   180  %routinespec handle ts
   181  %routinespec next record
   182  %routinespec handle gate
   183  %integerfnspec user proc(%string(127) %name s)
   184  %string (63) %fnspec display user(%record (procf) %name proc)
   185  %string (31) %fnspec lju(%string (*) %name s, %integer width)
   186  %routinespec new file(%string(15) s,%record (sfilef) %name file)
   187  %bytefnspec accredit user(%string (7) pass)
   188  %routinespec unravel ts(%string (*) %name ts addr, ts params, %integername net)
   189  %integerfnspec rw(%integer block, readwrite)
   190  %routinespec enq(%record (*) %name fil, %integer function)
   191  %routinespec free buffer(%record (*) %name mes)
   192  %integerfnspec getnet(%string (63) %name s)
   193  %record (mef) %mapspec get z buffer
   194  %routinespec handle account
   195  %bytefnspec handle command(%record (mef) %name mes)
   196  %externalstring(31) %fnspec itos(%integer no,posns)
   197  %routinespec checkstop(%integer where, qualifier)
   198  %routinespec to bridge(%record (mef) %name mes, %integer fn)
   199  %routinespec move(%integer len, from, to)
   200  %routinespec open file(%string(6) name, %c
   201+ %record (filef) %name fil, %integer cellsize,type)
   202  %routinespec packstring(%string (*) %name s,%record (mef) %name mes)
   203  %integerfnspec stoi(%string(*) %name s)
   204  %record (cellf) %mapspec find cell(%record (filef) %name file)
   205  %record (cellf) %mapspec look cell(%record (filef) %name file, %integer cell)
   206  %routinespec append free cell(%record (filef) %name file, %integername cell)
   207  %record (cellf) %mapspec match cell(%record (filef) %name file, %string(*) %name key)
   208  %string (127) %fnspec substring(%record (mef) %name mes, %integer no)
   209  
   210  %ownbytearray linestate(0:no of nets) = 1(no of nets+1)
   211  %ownbytearray sers(10:29) = prot not available(20) ;!All Prot not supported
   212  %ownrecord (procf) %name process
   213  %ownrecord (filef) tfil
   214     %ownstring (10) %array comname(0:29) = %c
   215+    "CALL","USER","TELL","PASSWORD","HOST","HELP","ALERT","NAME","DEAF","LINE",
   216+    "INFO","FILES","NOTICE","ABORT","NEWHOST","NEWNAME","DELETEHOST","DELETENAME",
   217+    "NEWALERT","FUNDS","NEWACCT","NEWHELP","LIMITUSERS","CLOSEUSERS","TCAT","TCOM",
   218+    "UCAT","PSEUD","OPEN",""
   219  
   220  %ownrecord (sfilef) bfil, hfil
   221  %ownrecord (pf) p
   222  %ownrecord (bff) buffer
   223  %ownrecord (cellf) %name ar
   224  %ownrecord (mef) %name mes
   225  %record (cellf) %name rec
   226  
   227  change out zero = t3 ser
   228  !@@ use tt(t3 ser)
   229  comname(password) = syspass
   230  charno(nlstr,1) = cr ;charno(nlstr,2) = lf
   231  printstring("ACCT Version     9.26 19 Mar  1984 (Min,Large,Glas)
   232+ ")
   233  linkin(account ser)
   234  !@@ i = map virt(buffer manager, 5, 4)
   235  !@@ i = map virt(buffer manager, 6, 5)
   236  map virt(buffer manager, 6, 5) ;map virt(buffer manager, 5, 4)
   237  
   238  !Set up links into User/Password and Translate Mnemonic files
   239  
   240  
   241  open file("ADRFIL",tfil,128,dafile)
   242  open file("HLPFIL",hfil,128,dafile)
   243  open file("ALTFIL",bfil,128,dafile)
   244  
   245  sers(account ser) = id
   246  
   247  %cycle
   248  
   249     p_ser = 0 ;!Accept anything
   250     poff(p)   ;!Wait
   251     
   252     mes == p_m
   253  
   254     %if p_reply = gate ser %start
   255        handle gate
   256  
   257     %elseif p_reply = 0
   258  
   259     %elseif p_reply = sers(time ser) ;!Only unsolicited timer msg = 1st one or alarm
   260  
   261     %elseif accredit user pass <= p_fn <= log session end
   262        handle account
   263  
   264     %else
   265        handle ts
   266     %finish
   267  
   268  %repeat
   269  
   270  
   271  %bytefn accredit user(%string (7) pass)
   272     !All users must provide the correct password. SYSTEM then always gets on
   273     !Category 15 users can get on when system is otherwise closed to users
   274        process_category = 10
   275        %if service = down %thenresult = no user service
   276        %if service = closing %then %result = shutdown imminent
   277        %result = gateway full %if no of users >= max users
   278     %result = ok
   279  %end ;
?PASS unused
   280        ;!of Accredit
   280  
   281  
   282  %integerfn b to i(%byte b)
   283     !Convert from BCD to a binary integer
   284     %result = (b>>4)*10 + b&15
   285  %end ;!of B to I
   286  
   287  
   288  %routine closedown
   289     %if service = closing %start
   290        p_s1 = 0
   291        to bridge(null, abort session)
   292  
   293     %elseif service = up
   294        service = closing
   295  
   296     %finish
   297  %end ;!of Closedown
   298  
   299  
   300  
   301  %routine enq(%record (*) %name file, %integer function)
   302     p_ser = 4 ;p_reply = id
   303     p_a = function ;p_m == file
   304     p_c = block
   305     ponoff(p)
   306  %end ;!of ENQ
   307  
   308  %routine unravel ts(%string (*) %name ts addr, ts params, %integername line)
   309     !Routine takes a TS address of the general form <Net>.<NUA>.<residue>
   310     !and splits it up into those components, making allowance for defaults.
   311     %string (63) ls
   312     %if ts addr -> ls.(".").ts addr %start
   313        !Not just a bare NUA. Possible formats are <Net>.<NUA>.<residue>
   314        !or <NUA>.<residue>       Remember <residue> may contain dots.
   315        line = getnet(ls)
   316        %if line >= 0 %start
   317           !It was <Net>....
   318           ts params = "" %unless ts addr -> ts addr.(".").ts params
   319  
   320        %else
   321           !It was <NUA>...  Our address and params strings are in the wrong place.
   322           ts params = ts addr ;ts addr = ls
   323  
   324        %finish
   325  
   326     %else
   327        !It was just <NUA>.   Return defaults. ts addr should be unaltered
   328        line = -1 ;ts params = ""
   329  
   330     %finish
   331  
   332  %end ;!of Unravel TS
   333  
   334  
   335  
   336  %routine free buffer(%record (*) %name mes)
   337     %record (pf) p
   338     %unless mes == null %start
   339        p_ser = buffer manager
   340        p_reply = id
   341        p_fn = release buffer
   342        p_m == mes
   343        buffers held = buffers held - 1
   344        pon(p)
   345     %finish
   346  %end ;!of Free Buffer
   347  
   348  %integerfn getnet(%string (63) %name s)
   349     !Find out if s is a valid network name and if so what line its on
   350     %integer i
   351     %for i = 0, 1, no of nets - 1 %cycle
   352        %result = i %if s = shortnetname(i) %or s = longnetname(i)
   353     %repeat
   354     %result = -1
   355  %end ;!of Get net
   356  
   357  
   358  %record (mef) %map get z buffer
   359     !This routine guarantees to find a buffer. If it finds one in the
   360     !pool, it returns with it. If not, it requests one from Buffer Manager
   361     !and waits for it.
   362     
   363     %record (pf) p
   364     
   365     p_ser = buffer manager ;p_reply = id
   366     p_fn = request buffer 
   367     p_len = 0 ;!Always a long buffer
   368     ponoff(p)
   369     buffers held = buffers held + 1
   370     p_m_l = 0 ;!Zero it for benefit of packing routines
   371     %result == p_m
   372  %end ;!of Get Buffer
   373  
   374  %routine handle account
   375     %record (cellf) %name urec, t
   376     %record (mef) %name tmes
   377     %string (63) source, destination, v, s params, v params
   378     %string (7) pass
   379     %byte q
   380     %integer rc,i,j,proc,charge,s net,v net
   381     %if p_fn = hello %start
   382        %if 10 <= p_s1 <= 29 %then sers(p_s1) = p_reply
   383  
   384        %if p_s1 = gatex ser %start
   385           linestate(p_task port) = p_gate port
   386  
   387        %elseif p_s1 = glue ser
   388           !Grab INFO input
   389           p_ser = gate ser
   390           p_reply = id
   391           p_fn = old enable facility
   392           p_c2 = infostream
   393           pon(p)
   394  
   395        %finish
   396        %return
   397  
   398     %elseif p_fn = goodbye
   399        %if 10 <= p_s1 <= 29 %then sers(p_s1) = prot not available
   400        %return
   401  
   402     %finish
   403  
   404     proc = p_task port ;!ITP Bridge gets the ports 1-16, FTP bridge the rest
   405     !p_gate port contains ID of relevant Bridge module. (Will differ from p_reply
   406     !when gatex sends in checkpoints). NB. FTP must currently identify
   407     !itself by putting tsb ser in p_reply
   408     %if p_gate port = tsb ser %then proc = proc + no of procs
   409     %if 1 <= proc <= no of procs+no of tsb procs %then process == proctab(proc) %else checkstop(2, 1)
   410  
   411  
   412  
   413  
   414     %if p_fn = accredit user pass %start
   415        buffers held = buffers held + 1
   416        %if process_state # idle %then q = process running %elsestart
   417           process = 0 ;!Clear everything
   418           process_ser = p_reply
   419           process_gate port = proc
   420           process_task port = p_task port
   421           !Take the address (of the form <Net>.<Address>.<Residue>.), compare
   422           !<Net>.<Address> against the mnemonic directory and returns the supplied
   423           !address and parameters with <Net>.<Address> replaced by the appropriate
   424           !mnemonic.
   425  
   426           source = mes_s
   427           unravel ts(source, s params, s net)
   428  
   429           %for i = tfil_no of cells-1,-1,0 %cycle
   430              t == look cell(tfil, i)
   431              %if t_flag = in use %start
   432                 v = t_m_s
   433                 unravel ts(v, v params, v net)
   434                 %if v net = s net %and v = source %then source = t_key %and %exit
   435              %finish
   436        
   437           %repeat
   438           !With a bit of luck, currentcell is now 0 if we didn't find it
   439           process_source = source
   440           source = source.".".s params %unless s params = ""
   441           process_srcecell = currentcell
   442  ! #if ~(g ! m)
   443           process_user = substring(mes, 3)  ;! Ruth 2/3/84
   444           q = accredit user(pass)
   445           !Look at source here rather than after User/Password validation
   446           !so we can trace failed logons by source using int U
   447           !process_destination is "Local" till the call is successfully
   448           !processed and is the laundered version thereafter.
   449           process_destination = "Local"
   450           %if q = 0 %start ;!Username/Password OK.
   451              destination = substring(mes, 2)
   452              !Destination is what appeared in the call or command line
   453              process_state = accredited
   454              %if destination # "" %start ;!THROUGH call
   455                 mes_s = "CALL".destination
   456                 q = handle command(mes)
   457                 %if q >= 128 %then process_state = idle %and no of users = no of users - 1
   458              %finish
   459              no of users = no of users + 1
   460           %finish
   461        %finish
   462        %if int = 'C' %or (int = 'U' %and process_srcecell = 0) %start ;!Log Logons while INT = L
   463           printstring(process_user) ;space
   464           printstring(source) ;space
   465           printstring(destination)
   466           write(q, 1)
   467           newline
   468        %finish
   469        p_s1 = q
   470        to bridge(mes, accredit reply)
   471        %return
   472  
   473     %elseif p_fn = process command
   474        buffers held = buffers held + 1
   475        checkstop(6, process_state-accredited)
   476        !Guard against commands in short blocks generating > 48 bytes o/p
   477        %if mes_type # 0 %start
   478           tmes == get z buffer
   479           tmes_s = mes_s
   480           free buffer(mes)
   481           mes == tmes
   482        %finish
   483        q = handle command(mes)
   484        !handle Command returns either:
   485        !a) n: n<128, n= service no of required task. Mes = connect params
   486        !c) n: n=128, Mes = Command Text.
   487        p_s1 = q
   488        %if mes_s = "" %then free buffer(mes) %and mes == null
   489        to bridge(mes, command reply)
   490        %return
   491  
   492     %elseif p_fn = log call start
   493        checkstop(7, process_state-accredited)
   494        process_state = charging
   495        %return
   496  
   497     %elseif p_fn = checkpoint
   498        buffers held = buffers held + 1
   499        free buffer(mes)
   500        %return
   501  
   502     %elseif p_fn = log call end
   503        buffers held = buffers held + 1 %unless mes == null
   504              freebuffer(mes) ; mes == null
   505           to bridge(mes, end call reply)
   506        process_destination = "Local"
   507        process_state = accredited
   508        %return
   509  
   510     %elseif p_fn = log session end
   511        %if process_state = accredited %start
   512           !The user could supply an invalid password then DISCONNECT.
   513           !If this happens we wil get a spurious LOG SESSION END
   514           no of users = no of users - 1
   515           process_state = idle
   516     
   517           %if service = closing %and no of users = 0 %start
   518              service = down
   519              printstring("Gateway closed
   520+    ")
   521     
   522           %finish
   523        %finish
   524        %return
   525     
   526  
   527     %else
   528        checkstop(9, p_fn)
   529     %finish
   530     %return
   531  
   532  %end ;
?CHARGE unused
?J unused
?RC unused
?UREC unused
   533        ;!of Handle Account
   533  
   534  
   535  %bytefn handle command(%record (mef) %name mes)
   536     %record (cellf) %name urec
   537     %record (mef) %name lmes
   538  
   539     %conststring(23) %array text(0:21) = %c
   540+    "",
   541+    "Invalid Facility",
   542+    "Illegal Command",
   543+    "User Not Found",
   544+    "Host Not Found",
   545+    "Duplicate User",
   546+    "Duplicate Host",
   547+    "Invalid Password",
   548+    "Invalid Category",
   549+    "Invalid Funds",
   550+    "Invalid User",
   551+    "Directory Full",
   552+    "Parameter Missing",
   553+    "Invalid Service No",
   554+    "Invalid Facilities",
   555+    "Invalid CUDF",
   556+    "Text too long",
   557+    "Protocol Not Available",
   558+    "Access Barred",
   559+    "User is Deaf",
   560+    "No Funds",
   561+    "Invalid Network"
   562  
   563     %conststring(4) %array stext(0:1) = "Up","Down"
   564     %string (*) %name s
   565     %record (cellf) %name rec
   566     %integer command,i,f,r,cell,rc,q,acr
   567     %byte res
   568     %string(127) d1,d2,category
   569     %string(63) username,fundslim,facs
   570     %string (*) %name dest
   571     %string (*) %name address
   572     %string (*) %name cudf
   573     %string (*) %name pass
   574     res = nullmsg
   575     s == mes_s
   576     dest == username ;address == fundslim ;cudf == category ;!do this to save stack
   577     pass == facs
   578  
   579     %for command = 0, 1, 29 %cycle
   580        %exitif s -> (comname(command)).d1
   581     %repeat
   582  
   583  
   584     %if command = call %start
   585        !Params are CALL <mnemonic> from users and CALL <mnemonic>.<residue>
   586        !from through calls
   587        dest = d1 %and d1 = "" %unless d1 -> dest.(".").d1
   588        rec == match cell(tfil, dest)
   589        facs = "" ;cudf = ""
   590        %if rec == null %then res = invalid facility %elsestart
   591           !Look for it in disc file
   592           process_destination = rec_key
   593           dest = rec_m_s
   594           unravel ts(dest, facs, i)
   595           %if d1 = "" %then d1 = facs
   596           dest = dest.".".d1 %unless d1 = ""
   597           dest = shortnetname(i).".".dest %unless i <= 0
   598           facs = substring(rec_m, 2) ;!Facilities
   599           cudf = substring(rec_m, 3) ;!CUDF
   600           res = rec_m_ser ;acr = rec_m_category
   601           process_destination = "*" %if acr > 15
   602  
   603        %finish
   604     
   605  
   606        %if res > 128 %start
   607           !Not interested if its a failure already
   608  
   609        %elseif res < 10 %or res > 29
   610           res = prot not available
   611  
   612        %elseif acr&15 > process_category
   613           res = access failure
   614           process_destination = "Local" ;! Ruth 7/3/84
   615  
   616        %elseif sers(res) & x'80' # 0
   617           res = sers(res)
   618  
   619        %else
   620  
   621           mes_l = 0
   622           packstring(dest, mes)
   623           %if res = glue ser %start ;!F-nos
   624              dest = "#".itos(process_srcecell, -1) ;!F-nos
   625              packstring(dest, mes) ;!F-nos
   626           %else ;!F-nos
   627              packstring(process_source, mes)
   628           %finish ;!F-nos
   629           res = sers(res)
   630           packstring(facs, mes) ;!Null facilities
   631           packstring(cudf, mes)
   632        %finish
   633  
   634     %elseif command = user
   635        %if d1 = "SALL" %start
   636           process_cmd = user
   637           %result = account ser
   638  
   639        %elseif d1 = "S"
   640           s = "Users =".itos(no of users, 1)
   641           res = preset
   642  
   643        %elseif user proc(d1) > 0
   644           i = user proc(d1)
   645           s = display user(proctab(i))
   646           res = preset
   647  
   648        %else 
   649           res = user not found
   650  
   651        %finish
   652  
   653     %elseif command = tell
   654     ! Modified such that users can only send messages to the console
   655     ! and that only the system process is allowed to send messages
   656     ! to any user.
   657     ! Ruth 01/03/84
   658        %if length(d1) < 100 %start
   659           %if d1 -> d1.(",").d2 %start
   660              %if d1 = "OPER" %or process_category = 15 %start
   661                 d2 = "** ".itos(process_gate port, 2).": ".d2.nlstr
   662                 %if d1 = "OPER" %then printstring(d2) %elsestart
   663                    %if length(d2) <= 72 %start ;!Limit is 2 * TEXT length in Bridge
   664                       %if d1 = "ALL" %and process_category = 15 %then i = 0 %elsestart
   665                          i = user proc(d1)
   666                          res = user not found %and -> end %if i <= 0
   667                          res = user deaf %and -> end %if proctab(i)_deaf = true
   668                       %finish
   669                       lmes == get z buffer
   670                       lmes_s = d2
   671                       rc = process_task port ;process_task port = i
   672                       to bridge(lmes, broadcast)
   673                       process_task port = rc
   674                    %finishelse res = text too long
   675                 %finish
   676              %finishelse res = illegal command
   677           %finishelse res = parameter missing
   678        %finishelse res = text too long
   679  
   680     %elseif command = password ;!i.e. the system password
   681        process_category = 15; process_user = "*"
   682  
   683     %elseif command = host
   684        %if d1 = "SALL" %start ;!Hosts all
   685           process_cmd = host ;process_curfil == tfil
   686           %result = account ser
   687  
   688        %elseif d1 = "S"
   689           s ="Hosts =".itos(tfil_no of cells, 1)
   690           res = preset
   691  
   692        %else
   693           rec == match cell(tfil, d1)
   694  
   695           %if rec == null %or rec_m_category > 15 %start
   696              res = host not found
   697           %else
   698              s = display host(rec)
   699              res = preset
   700           %finish
   701  
   702        %finish
   703  
   704     %elseif command = help
   705        process_cmd = help ;process_curfil == hfil
   706        %result = account ser
   707  
   708     %elseif command = alert
   709        process_cmd = alert ;process_curfil == bfil
   710        %result = account ser
   711  
   712     %elseif command = deaf
   713        process_deaf = true
   714  
   715     %elseif command = line %or command = info
   716        !INFO command just returns information about PSS line
   717        s = longnetname(sercline)
   718        s = s."is ".stext(linestate(sercline))
   719        %if command = line %and no of x25 nets > 1 %then %start
   720           s = s.", ".longnetname(pssline)
   721           s = s." is ".stext(linestate(pssline))
   722        %finish
   723        res = preset
   724  
   725  
   726     %elseif process_category = 15
   727  
   728        %if command = notice %start
   729           %if length(d1) < 60 %start
   730              %if length(d1) = 0 %then lmes == null %elsestart
   731                 d1 = d1.nlstr
   732                 lmes == get z buffer
   733                 lmes_s = d1
   734              %finish
   735              rec == look cell(bfil, 0)
   736              rec_s1 = d1
   737              curwritten = 1
   738              to bridge(lmes, noticeboard)
   739           %finishelse res = text too long
   740  
   741        %elseif command = abort
   742           !Abort a process. This may be a TSB process, a Bridge process
   743           !or all processes. The process number to be aborted is in the usual place
   744           !(p_task port) but the special case of p_task port = 0 aborts all processes.
   745           %if d1 = ("ALL") %then i = 0 %elsestart 
   746              i = user proc(d1) ;!Find the user process (d1 may be a user name or process no.)
   747              %if i = -1 %then res = user not found %and -> end
   748           %finish
   749           p_reply = account ser
   750           p_fn = abort session
   751           p_task port = i
   752           p_m == null
   753           %if i = 0 %start
   754              !Abort ALL processes of bridge and TSB. pon to both.
   755              p_ser = bridge ser; pon(p)
   756              p_ser = tsb ser
   757           %finishelse p_ser = proctab(i)_ser
   758        p_task port = p_task port - no of procs %if p_ser = tsb ser
   759           pon(p)
   760  
   761        %elseif command = newhost
   762           %if d1 -> dest.(",").d2 %and d2 -> address.(",").d1 %c
   763+          %and d1 -> cudf.(",").d2 %start
   764           %if address -> facs.(".").d1 %then i = getnet(facs) %else i = -1
   765              !Address of form <Net>.<residue> supplied is valid if and only
   766              !if there are more than two networks.
   767              %if i >= 0 %start
   768                 %if no of nets = 2 %then res = invalid network %and -> end
   769              %else
   770                 %if no of nets # 2 %then res = invalid network %and -> end
   771              %finish
   772  
   773              d1 = d2 %and d2 = "" %unless d2 -> d1.(",").d2
   774              r = stoi(d1)
   775              %if 0 <= r <= 15 %start
   776                 i = stoi(cudf)
   777                 %if 10 <= i <= 29 %start
   778                    facs = "" ;cudf = d2 ;!I know its nasty
   779                    %if cudf -> ("W=").d1 %start
   780                       facs = d1 %and cudf = "" %unless d1 -> facs.(",").cudf
   781                       facs = "W=".facs
   782                    %finish
   783  
   784                    %if cudf -> ("P=").d1 %start
   785                       d2 = d1 %and cudf = "" %unless d1 -> d2.(",").cudf
   786                       facs = facs."," %unless facs = ""
   787                       facs = facs."P=".d2
   788  
   789                    %elseif shortnetname(i) = "S" ;!Default for SERCNET is explicit P=128
   790                       facs = facs."," %unless facs = ""
   791                       facs = facs."P=128/128"
   792                    %finish
   793  
   794                    %if cudf -> ("C=").d1 %start ;!Reverse charge specified
   795                       d2 = d1 %and cudf = "" %unless d1 -> d2.(",").cudf
   796                       facs = facs."," %unless facs = ""
   797                       facs = facs."C=".d2
   798                    %finish
   799  
   800                   i = i %unless cudf -> (",").cudf ;!Strip off a redundant comma
   801                   %if length(facs) <= 17 %start
   802                       %if decode(cudf) = ok %start
   803                          length(dest) = 7 %if length(dest) > 7
   804                          rec == match cell(tfil, dest)
   805                          %if rec == null %start
   806                             rec == find cell(tfil)
   807                             rec_flag = in use
   808                             rec_key = dest
   809                             rec_m_chargeband = 5 ;!Default = UK PSS rates
   810                             rec_comment = ""
   811                          %finish
   812                          rec_m_ser = i ;rec_m_category = r
   813                          rec_m_l = 0
   814                          packstring(address,rec_m)
   815                          packstring(facs, rec_m)
   816                          packstring(cudf, rec_m)
   817                          curwritten = 1
   818        
   819                       %finishelse res = invalid cudf
   820                    %finishelse res = invalid facilities
   821                 %finishelse res = invalid service no
   822              %finishelse res = invalid category
   823           %finishelse res = parameter missing
   824  
   825        %elseif command = deletehost
   826           rec == match cell(tfil, d1)
   827           %unless rec == null %start
   828              rec_flag = free
   829              curwritten = 1
   830           %finishelse res = host not found
   831  
   832        %elseif command = newalert
   833           new file(d1, bfil)
   834  
   835        %elseif command = newhelp
   836           new file(d1, hfil)
   837  
   838        %elseif command = limitusers
   839           max users = stoi(d1) %if stoi(d1) >= 0
   840  
   841        %elseif command = closeusers
   842           !First call of CLOSE merely keeps new users off.
   843           !Second kicks existing users off and puts up No User Service
   844           closedown
   845  
   846        %elseif command = tcat
   847           %if d1 -> d1.(",").d2 %start
   848              rec == match cell(tfil, d1)
   849              %unless rec == null %start
   850                 d1 = d2 %and d2 = "" %unless d2 -> d1.(",").d2
   851                 rec_m_category = stoi(d1)
   852                 rec_m_chargeband = stoi(d2)
   853                 curwritten = 1
   854              %finishelse res = host not found
   855           %finishelse res = parameter missing
   856  
   857        %elseif command = tcom ;!Add comment to Host
   858           %if d1 -> d1.(",").d2 %start
   859              %if length(d2) <= 31 %start
   860                 rec == match cell(tfil, d1)
   861                 %unless rec == null %start
   862                    rec_comment = d2
   863                    curwritten = 1
   864                 %finishelse res = host not found
   865              %finishelse res = text too long
   866           %finishelse res = parameter missing
   867  
   868        %elseif command = open
   869           service = up
   870  
   871        %else
   872           res = illegal command %unless length(s) = 0
   873        %finish
   874     %else
   875        res = illegal command %unless length(s) = 0
   876     %finish
   877  
   878     end:
   879     %if res < 128 %then %result = res
   880     rc = res ;!Stupid compiler
   881     s = text(rc&127) %unless res = preset
   882     s = s.nlstr %unless s = ""
   883     %result = reply
   884  %end ;
?Q unused
?CELL unused
?F unused
?UREC unused
   885        ;!of Handle Command
   885  
   886  %routine handle gate
   887     %recordformat mf(%integer link, %byte l, type, %integerarray i(0:10))
   888     %record (mf) %name mm
   889     %integer i
   890     %byte ser
   891     mm == p_m
   892     %if p_fn = message %start ;!INFO poll
   893        !Info poll contains 2 tag words at start of message
   894        !Sync. Message hdr lgth = 5 wds.  Ring lgth = 7
   895  !      %IF LINETYPE = SYNC %START
   896  !         mm_i(7) = NO OF USERS
   897  !         mm_i(8) = 1 ;!Service state
   898  !      %ELSE
   899           mm_i(9) = no of users
   900           mm_i(10) = 1
   901  !      %FINISH
   902        mm_l = 32 ;!Should be long enough
   903        p_c2 = 128 ;!Reply OK.
   904  
   905     %else ;!Spurious connect
   906        p_c2 = 0
   907     %finish
   908     ser = p_ser
   909     p_ser = p_reply ;!Bounce it back whence it came
   910     p_reply = ser ;!With love from us
   911     p_fn = call reply
   912     pon(p)
   913  %end ;
?I unused
   914        ;!of Handle Gate
   914  
   915  
   916  
   917  %routine handle ts
   918    %byte n
   919     %record (mef) %name mes
   920     n = p_task port
   921     %if p_reply = tsb ser %then n = n + no of procs
   922     process == proctab(n)
   923     mes == p_m
   924     buffers held = buffers held + 1 %unless mes == null
   925  
   926     %if p_fn = data %or p_fn = control data %start
   927        %if mes_itp_hb2 & hellobit # 0 %start ;!Hello from far end
   928           process_mode = estb
   929           process_cnsl = mes_itp_cnsl
   930        %finish
   931        next record
   932        p_s1 = 1
   933        to bridge(null, ack)
   934  
   935     %elseif p_fn = ack
   936        process_outputs = process_outputs - p_s1
   937        next record
   938        mes == null
   939  
   940     %elseif p_fn = connect
   941        process_destination = "Local"
   942        %if process_state = accredited %and process_mode = idle %start
   943           %if process_cmd = 0 %start ;!No command up - almost certainly INFO
   944              mes_l = 12 ;mes_a(0) = 0 ;mes_a(1) = 0 ;mes_a(2) = 9
   945              string(addr(mes_a(3))) = sysname ;mes_a(11) = no of users
   946              p_s1 = short interaction
   947              to bridge(mes, disconnect) ;mes == null
   948  
   949           %else
   950              to bridge(null, accept call)
   951              to bridge(null, no goaheads)
   952              process_mode = wait for hello
   953              %if process_cmd = user %and process_category # 15 %then %c
   954+             process_curcell = 1 %else process_curcell = 0
   955              process_outputs = 0
   956           %finish
   957  
   958        %else
   959           n = p_reply ;p_reply = p_ser ;p_ser = n
   960           p_fn = disconnect
   961           p_m == null
   962           p_s1 = process running
   963           pon(p)
   964        %finish
   965  
   966     %elseif p_fn = disconnect
   967        %if process_mode = estb %or process_mode = wait for hello %then %c
   968+       to bridge(null, disconnect)
   969        process_mode = idle; process_cmd = 0
   970  
   971     %elseif p_fn = expedited data
   972        %if p_s1&x'DF' = 'A' %and process_mode = estb %start
   973           p_s1 = softly softly
   974           to bridge(null, disconnect)
   975           process_mode = wait for disc
   976        %finish
   977  
   978     %elseif p_fn = reset
   979        %if process_mode = estb %start
   980           process_outputs = 0
   981           to bridge(null, reset)
   982           next record
   983        %finish
   984  
   985     %elseif p_fn = poke
   986        p_s1 = 0
   987        p_c1 = no of users ;p_c2 = buffers held
   988        p_ser = p_reply ;p_reply = account ser
   989        pon(p)
   990        mes == null
   991  
   992     %else
   993        checkstop(3, p_fn)
   994  
   995     %finish
   996     free buffer(mes)
   997     %return
   998  
   999  %end ;!of Handle TS
  1000  
  1001  
  1002  
  1003  
  1004  %routine move(%integer len,from,to)
  1005  !
  1006  ! 'Assembler Routine' to emulate EMAS MOVE.
  1007  ! Note: 1. No action if LEN<=0
  1008  !       2. Registers 1,2 and 3 used.
  1009  !
  1010  %label loop, return
  1011  !
  1012        *mov_len,1          ;! Load the length
  1013        *ble_return         ;! Return if less than or equal to zero
  1014        *mov_from,2         ;! Load the FROM address
  1015        *mov_to,3           ;! Load the TO address
  1016  !
  1017  !     Loop to move LEN bytes FROM -> TO
  1018  !
  1019  loop: *movb_(2)+,(3)+     ;! Move the byte
  1020        *dec_1              ;! Decrement length count
  1021        *bne_loop           ;! Continue if length not exhausted       
  1022  return:
  1023        %return
  1024  %end
  1025  
  1026  
  1027  
  1028  
  1029  %routine new file(%string(15) s,%record (sfilef) %name file)
  1030     !Convert a character file with lines terminating in
  1031     !linefeed into a DA file with lines ending in CR-LF
  1032  
  1033     %integer j,cell,op
  1034     %record (sfilef) infil
  1035     %record (cellf) inrec, outrec
  1036     %record (cellf) %name rec
  1037     %routinespec pack(%byte c)
  1038  
  1039     length(s) = 6
  1040     open file(s, infil, 128, sqfile)
  1041     op = 0
  1042  
  1043     !Zero out file we'll be writing to
  1044     file_no of cells = 1
  1045     %if infil_no of cells > 0 %start
  1046        %for cell = 0,1,infil_no of cells-1 %cycle
  1047           rec == look cell(infil, cell) ;!Bring down a text record
  1048           inrec = rec
  1049           
  1050           %for j = 0,1,127 %cycle
  1051              %if inrec_a(j) = 4 %then -> end
  1052              %if inrec_a(j) = lf %then pack(cr)
  1053              pack(inrec_a(j))
  1054           %repeat
  1055        %repeat
  1056     %finish
  1057  end:pack(4)
  1058  
  1059  
  1060     %routine pack(%byte c)
  1061        %integer i
  1062        !Pack a single byte into a dafile cell and write it up when full
  1063        outrec_b(op) = c
  1064        op = op + 1
  1065  
  1066        %if op = 124 %or c = 4 %start
  1067           op = 0
  1068           outrec_flag = in use
  1069           rec == find cell(file)
  1070           rec = outrec
  1071           curwritten = 1
  1072        %finish
  1073     %end ;
?I unused
  1074           ;!of Pack (in New File)
  1074  %end ;!of New File
  1075  
  1076  %routine open file(%string(6) name, %c
  1077+ %record (filef) %name file, %integer cellsize, type)
  1078     !Sets up a DA-type file for access. Attempts to create and format
  1079     !one if it does not exist. Stops if unsuccessful.
  1080  
  1081     %record (cellf) %name crec
  1082     %integer i,j
  1083  
  1084     i = rw(currentblock, discwrite) %if curwritten # 0
  1085     file_unit = drive ;file_fsys = fsys
  1086     file_type = type
  1087     file_cellsize = cellsize
  1088     file_cells per block = blocksize//cellsize
  1089     move(6, addr(name)+1, addr(file_name(0)))
  1090  
  1091     enq(file, examine) ;!Is it there?
  1092  
  1093     %if p_a = 0 %start ;!No
  1094        enq(file, create) ;!Create it
  1095        %if type = dafile %start
  1096           buffer_flag = headercell
  1097           buffer_no of cells = 1
  1098           buffer_generation = 0
  1099        %finishelse buffer_a(0) = 4
  1100        rc = rw(p_a, discwrite) ;checkstop(15, rc)
  1101        printstring("File ".name." created
  1102+ ")
  1103     %finish
  1104  
  1105     i=0
  1106     %while p_a # 0 %cycle
  1107        file_blockno(i) = p_a
  1108        block = p_a
  1109        enq(file, getnext)
  1110        i = i + 1
  1111     %repeat
  1112  
  1113     file_no of blocks = i
  1114  
  1115     %if type = dafile %start
  1116        rc = rw(file_blockno(0), discread)
  1117        check stop(16, rc)
  1118        file_no of cells = buffer_no of cells
  1119     %else
  1120        file_no of cells = i*file_cells per block
  1121  
  1122        %if file_no of cells > 0 %start
  1123           %for i = 0,1,file_no of cells - 1 %cycle
  1124              crec == look cell(file, i)
  1125              %for j = 0,1,cellsize-1 %cycle
  1126                 %if crec_a(j) = 4 %then file_no of cells = i + 1 %and - >end
  1127              %repeat
  1128           %repeat
  1129        %finish
  1130        end:
  1131     %finish
  1132  
  1133  %end
  1134  
  1135  %routine next record
  1136     %integer rc, l, i, count
  1137     %record (procf) %name pr
  1138     %record (cellf) %name crec
  1139     %record (mef) %name outbuff
  1140  
  1141     %return %if process_outputs > 0 %or process_mode # estb
  1142  
  1143  
  1144     %if process_outbuff == null %then process_outbuff == get z buffer
  1145  
  1146     outbuff == process_outbuff
  1147  
  1148     %if process_cmd = user %start
  1149        count = no of procs+no of tsb procs + 1
  1150        %if process_curcell = 0 %then pr == null %elsestart
  1151           %cycle
  1152              pr == proctab(process_curcell)
  1153              %exit %if pr_state # idle
  1154              process_curcell = process_curcell + 1
  1155              -> end %if process_curcell = count
  1156           %repeat
  1157        %finish
  1158        outbuff_itp_s = display user(pr).nlstr
  1159     %else
  1160        count = process_curfil_no of cells
  1161        %cycle
  1162           crec == look cell(process_curfil, process_curcell)
  1163           !We skip cells if they are not in use or 
  1164           !we are doing a HOSTS ALL and the cells have ACR >= 15 and we are not ops
  1165           %if crec_flag = in use %and (process_cmd # host %or crec_m_category < 15 %or process_category = 15) %thenexit
  1166           process_curcell = process_curcell + 1
  1167           %if process_curcell = count  %then -> end
  1168        %repeat
  1169  
  1170        %if process_cmd = help %or process_cmd = alert %start
  1171           !Help or alert text files
  1172           l = 124
  1173     
  1174           !Last block: Probably short so check for EOF, then clear file
  1175           %if process_curcell = count - 1 %start
  1176              %for i = 0, 1, 123 %cycle
  1177                 %if crec_b(i) = 4 %then l = i %and %exit
  1178              %repeat
  1179           %finish
  1180        
  1181           !Make CREC_B a string by planting a length on top of Flag field
  1182           i = crec_a(1) ;crec_a(1) = l
  1183           outbuff_itp_s = string(addr(crec_a(1)))
  1184           crec_a(1) = i
  1185           !We were careful to restore crec_a(1) since this was changed on the
  1186           !Actual disc I/O block, not a copy - It could get paged up again
  1187     
  1188        %elseif process_cmd = host
  1189           outbuff_itp_s = display host(crec).nlstr
  1190     
  1191        %finish
  1192     %finish
  1193  
  1194     outbuff_l = outbuff_itp_a(0) + 4
  1195     outbuff_itp_cnsl = process_cnsl
  1196     outbuff_itp_hb2 = 0
  1197     outbuff_itp_hb3 = terminatebit
  1198     process_outputs = process_outputs + 1 ;p_s1 = 0 ;!Dont PUSH it
  1199     to bridge(outbuff, data) ;process_outbuff == null
  1200     process_curcell = process_curcell + 1
  1201  end:
  1202     %if process_curcell = count %start ;!Last block
  1203        p_s1 = softly softly
  1204        to bridge(null, disconnect)
  1205        free buffer(process_outbuff) ;process_outbuff == null
  1206        process_mode = wait for disc
  1207     %finish
  1208  
  1209  %end
?RC unused
  1210  
  1211  
  1212  %string (31) %fn lju(%string (*) %name s, %integer width)
  1213     !Left-justify string to <width> 
  1214     !Implementation dependant. Works like this:
  1215     %string (31) t
  1216     t = "                               " ;!31 spaces
  1217     t = s ;!Spaces still in T beyond end of S
  1218     %if width > length(t) %then length(t) = width ;!Length inrcreased to include spaces
  1219     %result = t
  1220  %end
  1221  
  1222  
  1223  %routine packstring(%string (*) %name s,%record (mef) %name mes)
  1224     !Add string S as a substring to MES, taking pointer from MES_L
  1225     string(addr(mes_a(mes_l))) = s
  1226     mes_l = mes_l + length(s) + 1
  1227  %end
  1228  
  1229  %integerfn stoi(%string(*) %name s)
  1230     %integer n,i
  1231     n=0
  1232     %if length(s) > 0 %start
  1233        %for i = 1, 1, length(s) %cycle
  1234           %result = -1 %unless '0' <= charno(s,i) <= '9'
  1235           n = n*10 + charno(s,i)-'0'
  1236        %repeat
  1237     %finishelseresult = -1
  1238     %result = n
  1239  %end
  1240  
  1241  
  1242  %string (127) %fn substring(%record (mef) %name mes ,%integer no)
  1243     %integer i,l
  1244     %unless mes == null %start
  1245        l = 0
  1246        %while no>1 %cycle
  1247           l = l + mes_a(l) + 1
  1248           %result = "" %if l >= mes_l
  1249           no = no - 1
  1250        %repeat
  1251        %result = string(addr(mes_a(l)))
  1252     %finishelseresult = ""
  1253  %end
?I unused
  1254  
  1255  
  1256  %routine checkstop(%integer where, qualifier)
  1257     %record (pf) p
  1258     %return %if qualifier = 0
  1259     printstring("ACCT disaster ") ;write(where, 1) ;printstring(", qual ")
  1260     write(qualifier, 1) ;newline
  1261        %cycle
  1262           poff(p)
  1263        %repeat
  1264  %end ;!of Checkstop
  1265  
  1266  
  1267  %routine to bridge(%record (mef) %name mes, %integer fn)
  1268     p_reply = account ser
  1269     %if fn = noticeboard %start
  1270        p_ser = bridge ser
  1271        p_task port = 0
  1272     %else
  1273        p_ser = process_ser
  1274        p_task port = process_task port
  1275        p_gate port = process_gate port
  1276     %finish
  1277     p_fn = fn
  1278     p_m == mes
  1279     buffers held = buffers held - 1 %unless mes == null
  1280     pon(p)
  1281     %return
  1282  %end ;!of To Lower
  1283  
  1284  
  1285  %integerfn user proc(%string(127) %name s)
  1286     !Takes a string and finds the corresponding user process.
  1287     !String may either be a user name, in which case the first active
  1288     !Incarnation of that user will be found, or a number in which case
  1289     !That process number will be returned if active. Function returns -1
  1290     !if there is no corresponding process
  1291     %integer i
  1292     i = stoi(s)
  1293     %result = i %if 1 <= i <= no of procs+no of tsb procs %and proctab(i)_state # idle
  1294     %for i = 1,1,no of procs+no of tsb procs %cycle
  1295        %if proctab(i)_state # idle %and proctab(i)_user = s %then %result = i
  1296     %repeat
  1297     %result = -1
  1298  %end
  1299  
  1300  
  1301  %record (cellf) %map find cell(%record (filef) %name file)
  1302     %record (cellf) %name rec
  1303     %integer cell
  1304     checkstop(10, header missing) %if file_no of cells = 0
  1305     %for cell = 0,1,file_no of cells - 1 %cycle
  1306        rec == look cell(file, cell)
  1307        %if rec_flag = free %thenresult == rec
  1308     %repeat
  1309     append free cell(file, cell)
  1310     %result == look cell(file, cell)
  1311  %end
  1312  
  1313  ! %control 257  ;! Ruth 2/3/84
  1314  
  1315  %record (cellf) %map look cell(%record (filef) %name file, %integer cell)
  1316     %integer block ;!My block Number (=index to Blocknos)
  1317     %integer posn ;!Position of cell in block
  1318     %record (cellf) %name c
  1319  
  1320     checkstop(13, out of range) %unless 0 <= cell < file_no of cells ;!Dont allow him to read out of range
  1321     block = cell//file_cells per block
  1322     posn = cell - (block*file_cells per block)
  1323  
  1324     %if file_blockno(block) # currentblock %start ;!Demand-page
  1325        %if curwritten # 0 %start ;!Existing block has been altered
  1326           rc =rw(currentblock, discwrite) ;checkstop(4, rc) ;!Write up old block
  1327        %finish
  1328        rc = rw(file_blockno(block), discread) ;!Bring in new one
  1329        checkstop(12, rc)
  1330     %finish
  1331  
  1332     currentcell = cell
  1333     c == record(addr(buffer_a(posn*file_cellsize)))
  1334     checkstop(17, c_flag) %if cell = 0 %and file_type = dafile %and c_flag # 2
  1335     %result == c
  1336  
  1337  %end ;!Of Look Cell
  1338  
  1339  
  1340  %routine append free cell(%record (filef) %name file, %integername cell)
  1341     %integer rc
  1342     %record (cellf) %name r
  1343  
  1344     checkstop(11, header missing) %if file_no of cells = 0
  1345     %if file_no of cells >= file_no of blocks*file_cells per block %start ;!We need to add a new file block
  1346        checkstop(5, file too big) %if file_no of blocks >= maxblocks
  1347        block = file_blockno(file_no of blocks-1) ;!Real filestore block 
  1348        enq(file, append) ;!Returns new block in P_A
  1349        checkstop(8, append failure) %if p_a = 0
  1350        file_blockno(file_no of blocks) = p_a
  1351        file_no of blocks = file_no of blocks + 1
  1352     %finish
  1353  
  1354     cell = file_no of cells
  1355     file_no of cells = file_no of cells + 1
  1356     !Set the last cell free
  1357     !OK. Be careful here.
  1358     !Look cell brings down the appropriate block and returns a pointer to
  1359     !the right bit of it.
  1360     r == look cell(file, cell)
  1361     !Zap the appropriate location in the disc I/O block
  1362     r_flag = free
  1363     curwritten = 1
  1364  
  1365     !Now update cell count in header
  1366     r == look cell(file, 0)
  1367     checkstop(18, r_flag) %if r_flag # 2
  1368     r_no of cells = file_no of cells
  1369     curwritten = 1
  1370  %end ;
?RC unused
  1371        ;!of Append Cell
  1371  
  1372  
  1373  %control 1
  1374  
  1375  %record (cellf) %map match cell(%record (filef) %name file, %string (*) %name key)
  1376     !Find the cell with a supplied keyword and return a pointer to it
  1377     %record (cellf) %name r
  1378     %integer cell
  1379     %if key # "" %and file_no of cells # 0 %start
  1380        %if key -> ("#").key %start ;!F-nos
  1381           cell = stoi(key) ;!F-nos
  1382           %if 1 <= cell < file_no of cells %start ;!F-nos
  1383              r == look cell(file, cell) ;!F-nos
  1384              %if r_flag = in use %then %result == r ;!F-nos
  1385           %finish ;!F-nos
  1386  
  1387        %else ;!F-nos
  1388           %for cell = 0,1,file_no of cells-1 %cycle ;!Scan through all cells (incl. Header)
  1389              r == look cell(file, cell)
  1390              %if r_flag = in use %and r_key = key %thenresult == r
  1391           %repeat
  1392  
  1393        %finish ;!F-nos
  1394     %finish
  1395     currentcell = -1
  1396     %result == null
  1397  %end ;!of Match Cell
  1398  
  1399  
  1400  %integerfn decode(%string (127) %name s)
  1401     %string (127) res
  1402     %string (31) t
  1403     %integer i,flag
  1404     %if length(s) # 0 %start
  1405     
  1406        flag = 0 ;res = ""
  1407     
  1408        %for i = 1,1,63 %cycle
  1409           t = s %and flag = 1 %unless s -> t.(";").s
  1410           %if charno(t, 1) = '''' %start
  1411              charno(t, 1) = (length(t)-1) ! 128
  1412     
  1413           %elseif 0 <= stoi(t) <= 255
  1414              charno(t,1) = stoi(t) %and length(t) = 1
  1415     
  1416           %finish
  1417  
  1418           res = res.t
  1419           %exitif flag = 1
  1420        %repeat
  1421  
  1422        s = res
  1423     %finish
  1424  
  1425     %result = ok
  1426  
  1427  %end
  1428  
  1429  %string (95) %fn display host(%record (cellf) %name trec)
  1430     %conststring(4) %array pcms(22:26) = "PCMA","PCMC","XGAT","PCMB","GLUE"
  1431     %conststring(3) %array prots(22:26) = "XXX","RTP","FTP","STP","RTP"
  1432     !Displays the contents of a Host cell
  1433     !Text length currently 83
  1434     %string(63) s
  1435     %string (95) res
  1436     %integer lineno
  1437     s = trec_m_s
  1438     unravel ts(s, res, lineno)
  1439     %if process_category = 15 %then res = itos(currentcell, 3).": " %else res = ""
  1440     res = res.lju(trec_key, 8).": "
  1441     s = lju(s, 15)
  1442     res = res.s."  "
  1443     %if no of nets # 2 %then res = res.longnetname(lineno)."  "
  1444     %if process_category = 15 %start
  1445        %if 22 <= trec_m_ser <= 26 %start
  1446           res = res.prots(trec_m_ser)."  "
  1447           res = res.pcms(trec_m_ser)
  1448        %else
  1449           res = res."???".itos(trec_m_ser, 5)
  1450        %finish
  1451     %finish
  1452     res = res.itos(trec_m_category, 3)
  1453     res = res."  ".trec_comment
  1454     %result = res
  1455  %end
  1456  
  1457  
  1458  %string (63) %fn display user(%record (procf) %name proc)
  1459     %integer i
  1460     %string (63) s
  1461     %if proc == null %start ;!Special case - buffer info
  1462        !Information provided is:
  1463        !Buffers Held by Acct, Big Buffs, Small Buffs, Buffs Queued
  1464        !Min Large and small buffs during interval (All from Buff Mgr)
  1465        s = itos(buffers held, 3)
  1466        %for i = 0,1,4 %cycle ;s = s.itos(bms(i), 3) ;%repeat
  1467     %else
  1468        s = itos(proc_gate port, 2)."  "
  1469        s = s.lju(proc_user, 8).": "
  1470        s = s.lju(proc_source, 15)." -> "
  1471        s = s.proc_destination
  1472     %finish
  1473     %result = s
  1474  %end ;!of Info
  1475  
  1476  %integerfn rw(%integer block, readwrite)
  1477     %recordformat p2f(%byte ser, reply, %integer a, %c
  1478+    %record (bff) %name b, %integer c)
  1479     %record (p2f) p2
  1480  
  1481     checkstop(14, block 0 error) %if block = 0
  1482     !1FFF below is to and drive number out of top of block number
  1483     checkstop(1, block) %unless lub <= block & X'1FFF' <= hub
  1484     !Trap any attempt to write outside user data
  1485     p2_ser = 3 ;p2_reply = id
  1486     p2_a = readwrite ;p2_b == buffer
  1487     p2_c = block
  1488     ponoff(p2)
  1489     %if readwrite = discread %and p2_a = 0 %then currentblock = block ;!Last block read
  1490     curwritten = 0
  1491     %result = p2_a
  1492  %end
  1493  
  1494  
  1495  %endofprogram
?REC unused
?AR unused
?BTOI unused
?SETPRIO unused
?GETID unused
?MAPHWR unused
?MAPABS unused
?DUPADDR unused
?ALARM unused
?UCELLF unused
?X25F unused
?HDRL unused
?WEEKDAY unused
?LINETYPE unused
?I unused
?OPENCELL unused
?MESSAGEREPLY unused
?UNLIMITED unused
?SYNC unused
?WINDOW unused
?EOFRECORD unused
?CLOSERECORD unused
?OPENRECORD unused
?ACCOUNTRECORD unused
?END unused
?UNKNOWN unused
?DISPLAY unused
?REMOVE unused
?INSERT unused
?CELL0FAILURE unused
?NOTFOUND unused
?BADKEY unused
?INVALID unused
?PSEUD unused
?UCAT unused
?NEWACCT unused
?FUNDS unused
?DELETENAME unused
?NEWNAME unused
?FILES unused
?NAME unused
?NOFUNDS unused
?DIRECTORYFULL unused
?INVALIDUSERNAME unused
?INVALIDFUNDS unused
?INVALIDPASSWORD unused
?DUPLICATEHOST unused
?DUPLICATEUSER unused
?CHARACTER unused
?BINARY unused
?SEQNOBITS unused
?SEQVALIDBIT unused
?MARKERBIT unused
?PROMPTBIT unused
?BINCHARBIT unused
?KILLTXBIT unused
?KILLRXBIT unused
?SETMODEBIT unused
?BREAKINBIT unused
?GOODBYEBIT unused
?GOAHEADBIT unused
?CONTROLBIT unused
?GETDIR unused
?RENAMEFSYS unused
?RENAMETEMP unused
?RENAME unused
?DESTROY unused
?PROD unused
?CONTROLINPUTHERE unused
?PUTCONTROLOUTPUT unused
?DISABLEFACILITY unused
?ENABLEFACILITY unused
?DATAGRAMREPLY unused
?DATAGRAM unused
?INPUTHERE unused
?PUTOUTPUT unused
?ENABLEOUTPUT unused
?ENABLEINPUT unused
?SHORTINTERACTIONFAILS unused
?SHORTCALLACCEPTED unused
?UNKNOWNFAILURE unused
?BADINTERFACEPARAMS unused
?SPURIOUSCLEARREQ unused
?FACSNOTNEGOTIABLE unused
?CALLRESTARTED unused
?USERABORT unused
?TIMEDOUT unused
?OPERATORABORT unused
?CALLRESET unused
?LCNCONFLICT unused
?PACKETLEVELERROR unused
?FARENDHUNG unused
?CALLCOLLISION unused
?NETWORKDOWN unused
?SESSIONLEVELERROR unused
?BADPARAM unused
?ACCOUNTINGFAILURE unused
?FACILITYUNAVAILABLE unused
?CALLCLEARED unused
?CONVERSATIONTERMINATED unused
?NOFREELCNS unused
?NOLOOPBACK unused
?PROTNOTSUPPORTED unused
?CAUSEUNKNOWN unused
?INVALIDPASS unused
?INVALIDUSER unused
?TSRESETBEFOREACCEPT unused
?TSDISCONNECTAFTERRESET unused
?TSGOINGOUTOFSERVICE unused
?TSTRANSPORTSERVICEABOR unused
?TSOPERATORABORT unused
?TSTRANSPORTSERVICEFAIL unused
?TSAPPLICATIONFAILURE unused
?TSNETWORKFAILURE unused
?TSCONGESTION unused
?TSFLOWCONTROLERROR unused
?TSCONNECTIONLOST unused
?TSTIMEOUT unused
?TSPROTOCOLACCUSATION unused
?TSPROTOCOLAPOLOGY unused
?TSMESSAGETOOLONG unused
?TSNETWORKCONGESTION unused
?TSNOREVERSECHARGING unused
?TSINCOMPATIBLEFACILITIES unused
?TSACCESSBARRED unused
?TSINVALIDADDRESS unused
?TSOUTOFORDER unused
?TSNUMBERBUSY unused
?TSNOCONNECTION unused
?TSRESPONSE unused
?TSOK unused
?PSSPROTNOTSUPPORTED unused
?PFTPSER unused
?PCMDSER unused
?PCMCSER unused
?PCMBSER unused
?PCMASER unused
?RLOOPSER unused
?LOOPBSER unused
?FROMXPROT unused
?KERNELSER unused
?TESTSER unused
?FTPSTREAM unused
?TIMESTREAM unused
?ITPSTREAM unused
?LPSTREAM unused
?DOCINPUTPR unused
?DOCINPUTCR unused
?NOOFBUFF unused
?OWNID unused
?TTSER unused
?SHORT unused
?LONG unused
?FALSE unused
?NOOFRCONETS unused
?RCOLINE unused
?NOOFLCNS unused
?MAXL3PACKET unused
?GATEPORT2 unused
?GATEPORT1 unused
?DATESTRING unused
