KERMIT
          IDENT  KERMIT 
          ENTRY  KERMIT 
          SYSCOM B1 
          SST    PPR
          TITLE  KERMIT PROTOCOL HANDLER. 
          COMMENT KERMIT PROTOCOL HANDLER 
          SPACE  4,10 
***       KERMIT - KERMIT PROTOCOL HANDLER. 
* 
*         KERMIT IS AN IMPLEMENTATION OF THE 'KERMIT PROTOCOL'
*         DEVELOPED AT THE UNIVERSITY OF COLUMBIA. THIS VERSION 
*         SUPPORTS A MINIMAL COMMAND/PROTOCOL SET AND IS INTENDED 
*         TO BE USE MAINLY IN 'SERVER' MODE. WINDOWING AS PER 
*         RECOMMENDATIONS IS SUPPORTED. 
* 
*         P. JARVIS.               86/02/19.
          SPACE  4,10 
***       MODIFICATION HISTORY. 
* 
*         AUGUST 1986.  VERSION 1.2 
* 
*              ORIGINAL STABALISED
* 
*         JANUARY 1987.  VERSION 1.3
* 
*              INTERACTIVE HELP ADDED 
*              CORRECTIONS TO PROCESSING DUPLICATE PACKETS
*              ADD SYMBOL 'PSR' TO ALLOW WINDOWING BELOW NOS 2.3
*              ADD BINARY FORMAT SUPORT 
*              CORRECT RECEIVE DATA TIMEOUT PROCESSING
*              CHANGE DEFAULT PACKET LENGTH TO 94 
*              CORRECT PROCESSING OF RECEIVED ILLEGAL CHARACTERS
          SPACE  4,10 
***       METHOD OF USE.
* 
*         KERMIT IS DESIGNED TO BE RUN BY A USER UNDER THE IAF
*         SUBSYSTEM. THE USER LOGS ON TO THE HOST IN THE NORMAL 
*         MANNER AND THEN INITIATES KERMIT. KERMIT DIRECTIVES MAY 
*         BE ENTERED FROM A LOCAL FILE OR FROM THE KERMIT COMMAND 
*         (OR BOTH). SEE LATER SECTION FOR DETAILS. 
* 
*             KERMIT[,I=LFN1][,D=LFN2][,L=LFN3].
* 
*                  LFN1 = NAME OF FILE CONTAINING KERMIT DIRECTIVES 
*                            (DEFAULT = INPUT,  'I' = INPUT)
*                  LFN2 = NAME OF FILE TO RECEIVE DEBUG DATA (IF ON)
*                            (DEFAULT = ZZZZDBG,  'D' = DBG)
*                  LFN3 = NAME OF FILE TO RECEIVE LOG DATA (IF ON)
*                            (DEFAULT = ZZZZLOG,  'L' = LOG)
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         * ILLEGAL PARAMETER - XX.* - INDICATES PARAMETER 'XX' IS
*                                      INVALID AND KERMIT IS ABORTED. 
* 
*         * ILLEGAL - XXXXXXX      * - INDICATES THE COMMAND XXXXXXX
*                                      INVALID AND KERMIT IS ABORTED. 
          SPACE  4,10 
****      SYSTEM DEPENDANT SYMBOLS. 
* 
 PSR      EQU    647         SYSTEM PSR LEVEL 
****
          SPACE  4,10 
****      DEFAULT SYMBOLS.
* 
 D_CODE   EQU    1           0 = DIS64, 1 = ASCII, 2 = ASCII8, 3 = HEX
 D_DEBUG  EQU    0           0 = DEBUG OFF, 1 = DEBUG ON
 D_DELAY  EQU    6           DELAY IN SECONDS BEFORE 'SENDING'
 D_EOL    EQU    015B        C/R AT END OF LINE 
 D_MARK   EQU    1           SOH (START OF PACKET MARKER) 
 D_MAXL   EQU    94          MAXIMUM PACKET LENGTH
 D_MODE   EQU    1           0 = LOCAL, 1 = SAVE, 2 = REPLACE 
 D_NPAD   EQU    0           NUMBER OF PADDING CHARACTERS 
 D_PADC   EQU    0           PADDING CHARACTER
 D_QUIET  EQU    0           QUIET MODE FLAG (0 = SEND WAKEUP NAKS) 
 D_WSIZE  EQU    8           WINDOW SIZE
****
          SPACE  4,10 
*         COMMON DECK SYMBOLS.
* 
 OPL      XTEXT  COMSPFM
 OPL      XTEXT  COMSRPV
          SPACE  4,10 
*         ASSEMBLY CONSTANTS. 
* 
 CBUFL    EQU    201B        COMMAND/CATLIST BUFFER LENGTH
 DBUFL    EQU    1001B       DEBUG BUFFER LENGTH
 IBUFL    EQU    101B        TERMINAL INPUT BUFFER LENGTH 
 LBUFL    EQU    101B        LOG FILE BUFFER LENGTH 
 FBUFL    EQU    1001B       FILE BUFFER LENGTH 
 OBUFL    EQU    201B        TERMINAL OUTPUT BUFFER LENGTH
 WTABL    EQU    34          WINDOW TABLE LENGTH
 OBCNT    EQU    36          OUTPUT BUFFER COUNT
 OBLEN    EQU    41          OUTPUT BUFFER LENGTH 
 LFTABL   EQU    64          LOCAL FILE TABLE LENGTH
          SPACE  4,10 
*         PACKET TYPE SYMBOLS.
* 
 CHKERR   EQU    0           CHECKSUM ERROR 
 TIMEOUT  EQU    1           TIME OUT                             [ T ] 
 DATA     EQU    2           DATA PACKET                          [ D ] 
 ACK      EQU    3           ACKNOWLEDGE PACKET                   [ Y ] 
 NAK      EQU    4           NEGATIVE ACKNOWLEDGE PACKET          [ N ] 
 SENDI    EQU    5           SEND INITIATE PACKET                 [ S ] 
 BREAK    EQU    6           BREAK TRANSMISSION PACKET (EOT)      [ B ] 
 FILEH    EQU    7           FILE HEADER PACKET                   [ F ] 
 EOF      EQU    8           END OF FILE PACKET                   [ Z ] 
 ERROR    EQU    9           ERROR PACKET                         [ E ] 
 RECI     EQU    10          RECEIVE INITIATE PACKET              [ R ] 
 GENCOM   EQU    11          GENCOM  COMMAND PACKET               [ G ] 
 INITP    EQU    12          INIT PACKET                          [ I ] 
 FILEX    EQU    13          FILE HEADER (TYPED) PACKET 
          SPACE  4,10 
*         PACKET OFFSET SYMBOLS.
* 
 PLINK    EQU    0           LINK TO NEXT PACKET
 PLEN     EQU    1           PACKET LENGTH
 PSEQ     EQU    2           PACKET SEQUENCE NUMBER 
 PTYPE    EQU    3           PACKET TYPE
 PDATA    EQU    4           START OF DATA
          SPACE  4,10 
*         ERROR CODES.
* 
 E_PROERR EQU    0           PROTOCOL ERROR 
 E_TIMEOT EQU    1           PROTOCOL TIME OUT
 E_RLIMIT EQU    2           PACKET RETRY LIMIT EXCEEDED
 E_ILDATA EQU    3           ILLEGAL DATA PACKET STRUCTURE
 E_FILENF EQU    4           FILE NOT FOUND 
 E_ILCHAR EQU    5           ILLEGAL CHARACTER CODE 
          SPACE  4,10 
*         MICRO DEFINITIONS.
* 
 VERSION  MICRO  1,,*1.30*
          SPACE  4,10 
*         FILE ENVIRONMENT TABLES.
* 
 C        BSS    0           COMMAND BUFFER 
 INPUT    FILEB  CBUF,CBUFL,FET=8 
 D        BSS    0           DEBUG FILE 
 ZZZZDBG  FILEB  DBUF,DBUFL,FET=8 
 I        BSS    0           TERMINAL INPUT FILE
 ZZZZZIN  FILEB  IBUF,IBUFL,FET=8,DTY=2RTT
 L        BSS    0           LOGGING FILE 
 ZZZZLOG  FILEB  LBUF,LBUFL,FET=8 
 F        BSS    0           FILE BUFFER
 ZZZZZFN  FILEB  FBUF,FBUFL,FET=16,EPR
 O        BSS    0           TERMINAL OUTPUT FILE 
 ZZZZZOU  FILEB  OBUF,OBUFL,FET=8,DTY=2RTT
 S        BSS    0           STATUS FET 
 ZZZZZST  FILEB  CBUF,CBUFL,FET=8 
 Q        BSS    0           CATLIST BUFFER 
 ZZZZCAT  FILEB  CBUF,CBUFL,FET=16,EPR
 H        BSS    0           HELP FILE
 ZZZZHLP  RFILEB CBUF,CBUFL,FET=8,EPR 
          SPACE  4,10 
*         ARGUMENT EQUIVALENCE TABLE. 
* 
 ARGTAB   BSS    0           ARGUMENT TABLE 
          VFD    12/0LD,18/ASVD,12/3,18/D 
          VFD    12/0LI,18/ASVI,12/3,18/C 
          VFD    12/0LL,18/ASVL,12/3,18/L 
          VFD    60/0 
  
 ASVD     VFD    42/0LDBG,18/3
 ASVI     VFD    42/0LINPUT,18/3
 ASVL     VFD    42/0LLOG,18/3
          SPACE  4,10 
*         REPRIEVE BLOCK. 
* 
 RPB      RPVBLK KMT4 
          SPACE  4,10 
**        MACRO DEFINITIONS.
* 
          SPACE  2,10 
**        CHR - CONVERT NONE PRINTING CHARACTER.
* 
*         CHR  X
* 
  
 CHR      MACRO  X
          CON    32D+X
          ENDM
          SPACE  2,10 
**        CTL - CONVERT CONTROL CODE TO PRINTABLE FORM. 
* 
*         CTL  X
* 
  
 CTL      MACRO  X
          CON    64D&_X 
          ENDM
          SPACE  2,10 
**        CDC - CREATE ASCII TO CDC CONVERSION TABLE ENTRY. 
* 
*         CDC   EXT,DIS,PKT,SYM 
* 
*               EXT = EXTENDED (6/12) DISPLAY CODE
*               DIS = 6 BIT DISPLAY CODE (64 CHARACTER SET) 
*               PKT = PACKET ORDINAL IF VALID PACKET TYPE 
*               SYM = SET IF NOT VALID IN SYMBOLIC NAME 
  
 CDC      MACRO  EXT,DIS,PKT,SYM
          LOCAL  N
          BASE   OCTAL
 .1       IFC    EQ,/SYM/*/ 
          VFD    1/1,5/0
 .1       ELSE
          VFD    1/0,5/0
 .1       ENDIF 
 N        SET    PKT 777776 
          VFD    18D/N
 N        SET    DIS 777776 
          VFD    18D/N
          VFD    18D/EXT
          BASE   *
          ENDM
          SPACE  2,10 
**        ASC - CREATE CDC TO ASCII CONVERSION TABLE ENTRY. 
* 
*         ASC   DIS,D76,D74 
* 
*               DIS = ASCII EQUIVALENT OF 6 BIT CODE
*               D76 = EQUIVALENT OF 76NN CODE 
*               D74 = EQUIVALENT OF 74NN CODE 
  
 ASC      MACRO  DIS,D76,D74
          LOCAL  N
          BSS    0
 N        SET    D76 -1 
          VFD    2/0,18/N 
 N        SET    D74 -1 
          VFD    2/0,18/N 
          VFD    2/0,18/DIS 
          ENDM
          SPACE  2,10 
**        CVE - CREATE VALIDATION ENTRY.
* 
*         CVE    TEXT,NUM,TYPE,HELP,ADR,V1,V2 
* 
*         WHERE:- 
*                 TEXT = COMMAND NAME 
*                  NUM = NUMBER OF SIGNIFICANT CHARACTERS 
*                 TYPE = PROCESSING TYPE CODE 
*                        0 - FURTHER TABLE ENTRIES REQUIRED 
*                        1 - SET VARIABLE TO SPECIFIC VALUE 
*                        2 - SET VARIABLE TO NUMERIC PARAMETER
*                        3 - PROCESS AT GIVEN ADDRESS 
*                        4 - RETURN GIVEN MESSAGE REQUEST 
*                 HELP = HELP MESSAGE ORDINAL 
*                  ADR = ADDRESS OF TABLE OR VARIABLE 
*                   V1 = VALUE OR MAXIMUM EXTENT
*                   V2 = MINIMUM EXTENT 
          SPACE  2,10 
 CVE      MACRO  TEXT,NUM,TYPE,HELP,ADR,V1,V2 
          NOREF  N,N1 
 M        MICRO  1,,*_TEXT_*
 N        MICCNT M
 N1       SET    1
 .1       DUP    N
 M        MICRO  N1,1,*_TEXT_*
          VFD    7/040B+1R"M" 
 N1       SET    N1+1 
 .1       ENDD
 N1       SET    8-N
          ERRNG  N1          COMMAND NAME LONGER THAN 8 CHARACTERS
          IFGT   N1,0,2 
 N1       SET    N1*7 
          VFD    N1/0 
          VFD    4/NUM
          IFC    EQ,/TYPE/0/,1
          VFD    18/0,18/ADR,18/HELP,6/0
          IFC    EQ,/TYPE/1/,1
          VFD    18/V1,18/ADR,18/HELP,6/1 
          IFC    EQ,/TYPE/2/,1
          VFD    9/V1,9/V2,18/ADR,18/HELP,6/2 
          IFC    EQ,/TYPE/3/,1
          VFD    18/V1,18/ADR,18/HELP,6/3 
          IFC    EQ,/TYPE/4/,1
          VFD    18/0,18/HELP,18/HELP,6/4 
          ENDM
          SPACE  2,10 
**        MSG - DEFINE MESSAGE FOR ERROR PACKET.
* 
*         MSG   TEXT
* 
*               TEXT = REQUIRED CHARACTERS (6 BIT DISPLAY CODE) 
  
          MACRO  MSG,SYM,TEXT 
          LOCAL  M,N
 SYM      BSS    0
 M        MICRO  1,,#_TEXT_#
 M        MICCNT M
 N        SET    1
          CODE   ASCII
 .1       DUP    M
 M        MICRO  N,1,#_TEXT_# 
          CON    1R"M"+040B 
 N        SET    N+1
 .1       ENDD
          CODE   *
 SYM_L    EQU    *-SYM
          ENDM
          SPACE  2,10 
**        STATE - GENERATE STATE TABLE ENTRY. 
* 
*   ST    STATE  P1,P2,P3,P4,P5,P6,P7,P8,P9,P10 
* 
*                ST = CURRENT STATE ORDINAL 
*                PN = NEXT STATE ORDINAL
  
          MACRO  STATE,ST,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P 
          IF     -DEF,S.ORD,1 
 S.ORD    SET    0
 ST       EQU    S.ORD
 S.ORD    SET    S.ORD+1
          VFD    7/A,7/B,7/C,7/D,7/E,7/F,7/G,7/H,4/0
          VFD    7/I,7/J,7/K,7/L,7/M,7/N,7/O,7/P,4/0
          BSSZ   2
          ENDM
          SPACE  4,10 
*         VARIABLES.
* 
 DEBUG    CON    D_DEBUG     DEBUG FLAG (0 = OFF, 1 = ON) 
 PFFLAG   CON    D_MODE      P.F. FLAG (0 = LOCAL, 1 = SAVE, 2 = REPLACE
 MARK     CON    D_MARK      MARK CHARACTER (START OF PACKET) 
 MAXL     CON    D_MAXL      MAIMUM PACKET LENGTH 
 NPAD     CON    D_NPAD      NUMBER OF PADDING CHARACTERS 
 PADC     CON    D_PADC      PADDING CHARACTER
 EOL      CON    D_EOL       END OF LINE MARKER 
 SEQ      CON    0           CURRENT SEQUENCE NUMBER
 DELAY    CON    D_DELAY     DELAY TIME BEFORE 'SENDING' FILE 
 EMODE    CON    0           ERROR MODE (SEE 'PROCFPE' FOR DEFINITION)
 ILCHAR   CON    0           ILLEGAL CHARACTER CODE 
 TMODE    CON    0           TRANSFER MODE (0=SERVER, 1=SEND, 2=REC.) 
 QUIETF   CON    D_QUIET     QUIET MODE FLAG (0 = SEND NAKS)
 PSTATE   CON    0           PREVIOUS PROTOCOL STATE
 STATE    CON    0           CURRENT PROTOCOL STATE 
 CSTATE   CON    -1          CHANGED STATE FLAG (0 IF SAME STATE AS PREV
 RETRY    CON    5           RETRY COUNTER
 TIMER    CON    10          TIMEOUT TIMER (IN SECONDS) 
 RETIME   CON    5           RETRY TIMEOUT COUNTER
 RXQCTL   CON    043B        RECEIVE CONTROL QUOTE CHARACTER
 TXQCTL   CON    043B        TRANSMIT CONTROL QUOTE CHARACTER 
 QBIN     CON    0           8 BIT QUOTE CHARACTER
 CHKT     CON    0           CHECKSUM TYPE (DEFAULT)
 REPT     CON    0           REPEAT QUOTE CHARACTER 
 FIRSTF   CON    0           FIRST FILE FLAG (-1 IF FIRST FILE) 
 TTYPE    CON    0           TRANSFER TYPE ( 0 = FILE, 1 = TYPE ) 
 FNAME    CON    0           FILE NAME
 FMASK    CON    0           FILE NAME MASK 
 CNAME    CON    0           CURRENT FILE NAME
 ANAME    CON    0           ALTERNATIVE FILE NAME
 FFORM    CON    D_CODE      FILE FORMAT (0=DIS64, 1=ASCII, 2=ASCII8) 
                                         (3=HEX, 4=BINARY)
 FWORD    CON    0           FILE WORD FOR I/O
 FCOUNT   CON    0           UNPACKING COUNTER
 RXPWORD  CON    0           RX PREFIX WORD 
 TXPWORD  CON    0           TX PREFIX WORD 
 CAPAS    CON    2           CAPABILITY FLAG BITS 
 FQPTR    CON    0           FREE QUEUE POINTER 
 IQPTR    CON    0           INPUT QUEUE POINTER
 LASTSEQ  CON    0           LAST SEQUENCE NUMBER IN RECEIVE WINDOW 
 RWSIZE   CON    D_WSIZE     REQUESTED WINDOW SIZE
 WSIZE    CON    0           USED WINDOW SIZE 
 WPTR     CON    0           WINDOW TABLE POINTER 
 WTABLE   BSSZ   WTABL       WINDOW TABLE 
 LFPTR    CON    0           LOCAL FILE LIST POINTER
 LFTAB    BSS    LFTABL+1    LOCAL FILE NAME TABLE
 HELPCDE  CON    0           HELP MESSAGE CODE NUMBER 
 HLPTABL  BSSZ   20          HELP FILE POINTER TABLE
 LINEP    BSSZ   1           LINE POINTER 
 LINE     BSSZ   100         LINE STRING BUFFER 
 LOGPTR   CON    128         LOG BUFFER POINTER 
 LOGBUF   BSS    128         LOG BUFFER 
          SPACE  4,10 
**        ASCII TO CDC CONVERSION TABLE.
* 
*         THE TABLE FORMAT IS AS FOLLOWS:-
* 
*T 1/F,5/0,18/CODE,18/6BIT,18/612 
* 
*         WHERE:- 
*                F    = SET IF INVALID IN FILE NAME 
*                CODE = PACKET TYPE CODE (-1 IF INVALID)
*                6BIT = 6 BIT DISPLAY CODE (-1 IF INVALID)
*                EXT  = EXTENDED (6/12) DISPLAY CODE
  
 A2C      BSS    0           ASCII TO CDC CONVERSION TABLE
          LOC    0
          CDC    7640,,,*    NUL
          CDC    7641,,,*    SOH
          CDC    7642,,,*    STX
          CDC    7643,,,*    ETX
          CDC    7644,,,*    EOT
          CDC    7645,,,*    ENQ
          CDC    7646,,,*    ACK
          CDC    7647,,,*    BEL
          CDC    7650,,,*    BS 
          CDC    7651,,,*    HT 
          CDC    7652,,,*    LF 
          CDC    7653,,,*    VT 
          CDC    7654,,,*    FF 
          CDC    7655,,,*    CR 
          CDC    7656,,,*    SO 
          CDC    7657,,,*    SI 
          CDC    7660,,,*    DLE
          CDC    7661,,,*    DC1
          CDC    7662,,,*    DC2
          CDC    7663,,,*    DC3
          CDC    7664,,,*    DC4
          CDC    7665,,,*    NAK
          CDC    7666,,,*    SYN
          CDC    7667,,,*    ETB
          CDC    7670,,,*    CAN
          CDC    7671,,,*    EM 
          CDC    7672,,,*    SUB
          CDC    7673,,,*    ESC
          CDC    7674,,,*    FS 
          CDC    7675,,,*    GS 
          CDC    7676,,,*    RS 
          CDC    7677,,,*    VS 
          CDC    55,55,,*    SPACE
          CDC    66,66,,*    !
          CDC    64,64,,*    "
          CDC    60,60,,*    #
          CDC    53,53,,*    $
          CDC    63,63,,*    PERCENT
          CDC    67,67,,*    &
          CDC    70,70,,*    '
          CDC    51,51,,*    (
          CDC    52,52,,*    )
          CDC    47,47,,*    *
          CDC    45,45,,*    +
          CDC    56,56,,*    ,
          CDC    46,46,,*    -
          CDC    57,57,,*    .
          CDC    50,50,,*    /
          CDC    33,33       0
          CDC    34,34       1
          CDC    35,35       2
          CDC    36,36       3
          CDC    37,37       4
          CDC    40,40       5
          CDC    41,41       6
          CDC    42,42       7
          CDC    43,43       8
          CDC    44,44       9
          CDC    7404,00,,*  COLON
          CDC    77,77,,*    SEMI-COLON 
          CDC    72,72,,*    <
          CDC    54,54,,*    =
          CDC    73,73,,*    >
          CDC    71,71,,*    ?
          CDC    7401,74,,*  AT SIGN
          CDC    01,01       U.C. A 
          CDC    02,02,BREAK U.C. B 
          CDC    03,03       U.C. C 
          CDC    04,04,DATA  U.C. D 
          CDC    05,05,ERROR U.C. E 
          CDC    06,06,FILEH U.C. F 
          CDC    07,07,GENCOM U.C. G
          CDC    10,10       U.C. H 
          CDC    11,11,INITP U.C. I 
          CDC    12,12       U.C. J 
          CDC    13,13       U.C. K 
          CDC    14,14       U.C. L 
          CDC    15,15       U.C. M 
          CDC    16,16,NAK   U.C. N 
          CDC    17,17       U.C. O 
          CDC    20,20       U.C. P 
          CDC    21,21       U.C. Q 
          CDC    22,22,RECI  U.C. R 
          CDC    23,23,SENDI U.C. S 
          CDC    24,24       U.C. T 
          CDC    25,25       U.C. U 
          CDC    26,26       U.C. V 
          CDC    27,27       U.C. W 
          CDC    30,30       U.C. X 
          CDC    31,31,ACK   U.C. Y 
          CDC    32,32,EOF   U.C. Z 
          CDC    61,61,,*    [
          CDC    75,75,,*    BACK / 
          CDC    62,62,,*    ]
          CDC    7402,76,,*  ^
          CDC    65,65,,*    UNDERSCORE 
          CDC    7407,,,*    BACK QUOTE 
          CDC    7601,01     L.C. A 
          CDC    7602,02     L.C. B 
          CDC    7603,03     L.C. C 
          CDC    7604,04     L.C. D 
          CDC    7605,05     L.C. E 
          CDC    7606,06     L.C. F 
          CDC    7607,07     L.C. G 
          CDC    7610,10     L.C. H 
          CDC    7611,11     L.C. I 
          CDC    7612,12     L.C. J 
          CDC    7613,13     L.C. K 
          CDC    7614,14     L.C. L 
          CDC    7615,15     L.C. M 
          CDC    7616,16     L.C. N 
          CDC    7617,17     L.C. O 
          CDC    7620,20     L.C. P 
          CDC    7621,21     L.C. Q 
          CDC    7622,22     L.C. R 
          CDC    7623,23     L.C. S 
          CDC    7624,24     L.C. T 
          CDC    7625,25     L.C. U 
          CDC    7626,26     L.C. V 
          CDC    7627,27     L.C. W 
          CDC    7630,30     L.C. X 
          CDC    7631,31     L.C. Y 
          CDC    7632,32     L.C. Z 
          CDC    7633,,,*    LEFT BRACE 
          CDC    7634,,,*    VERTICAL BAR 
          CDC    7635,,,*    RIGHT BRACE
          CDC    7636,,,*    TILDE
          CDC    7637,,,*    DEL
          LOC    *O 
          SPACE  4,10 
**        CDC TO ASCII CONVERSION TABLE.
* 
*         THE TABLE FORMAT IS AS FOLLOWS:-
* 
*T 2/0,18/76NN,2/0,18/74NN,2/0,18/NN
* 
*         WHERE:- 
*                THE REQUIRED TABLE ENTRY IS INDEXED BY THE CDC DISPLAY 
*                76NN = ASCII CODE FOR DIPLAY CODE 76NN 
*                74NN = ASCII CODE FOR DISPLAY CODE 74NN
*                NN   = ASCII CODE FOR DISPLAY CODE NN
* 
*         NOTE:-
*               IF THE ASCII VALUE OBTAINED FROM THIS TABLE IS NEGATIVE 
*               THEN THE SOURCE DISPLAY ESCAPE SEQUENCE IS ILLEGAL. 
* 
  
 C2A      BSS    0           CDC TO ASCII CONVERSION TABLE
          LOC    0
          ASC    072B                  COLON
          ASC    101B,141B,100B        A
          ASC    102B,142B,136B        B
          ASC    103B,143B             C
          ASC    104B,144B,072B        D
          ASC    105B,145B             E
          ASC    106B,146B             F
          ASC    107B,147B,140B        G
          ASC    110B,150B             H
          ASC    111B,151B             I
          ASC    112B,152B             J
          ASC    113B,153B             K
          ASC    114B,154B             L
          ASC    115B,155B             M
          ASC    116B,156B             N
          ASC    117B,157B             O
          ASC    120B,160B             P
          ASC    121B,161B             Q
          ASC    122B,162B             R
          ASC    123B,163B             S
          ASC    124B,164B             T
          ASC    125B,165B             U
          ASC    126B,166B             V
          ASC    127B,167B             W
          ASC    130B,170B             X
          ASC    131B,171B             Y
          ASC    132B,172B             Z
          ASC    060B,173B             0
          ASC    061B,174B             1
          ASC    062B,175B             2
          ASC    063B,176B             3
          ASC    064B,177B             4
          ASC    065B,000B             5
          ASC    066B,001B             6
          ASC    067B,002B             7
          ASC    070B,003B             8
          ASC    071B,004B             9
          ASC    053B,005B             +
          ASC    055B,006B             -
          ASC    052B,007B             *
          ASC    057B,010B             /
          ASC    050B,011B             (
          ASC    051B,012B             )
          ASC    044B,013B             $
          ASC    075B,014B             =
          ASC    040B,015B             SPACE
          ASC    054B,016B             ,
          ASC    056B,017B             .
          ASC    043B,020B             #
          ASC    133B,021B             [
          ASC    135B,022B             ]
          ASC    045B,023B             PERCENT
          ASC    042B,024B             "
          ASC    137B,025B             UNDERSCORE 
          ASC    041B,026B             !
          ASC    046B,027B             &
          ASC    047B,030B             '
          ASC    077B,031B             ?
          ASC    074B,032B             <
          ASC    076B,033B             >
          ASC    100B,034B             AT SIGN
          ASC    134B,035B             BACK / 
          ASC    136B,036B             CAROT
          ASC    073B,037B             SEMI-COLON 
          LOC    *O 
          SPACE  4,10 
*         HEX TO DISPLAY CODE CONVERSION TABLE. 
* 
  
 H2D      BSS    0           HEX TO DISPLAY CODE CONVERSION TABLE.
          LOC    0
          CON    1R0
          CON    1R1
          CON    1R2
          CON    1R3
          CON    1R4
          CON    1R5
          CON    1R6
          CON    1R7
          CON    1R8
          CON    1R9
          CON    1RA
          CON    1RB
          CON    1RC
          CON    1RD
          CON    1RE
          CON    1RF
          LOC    *O 
          CODE   ASCII
  
 VTABLE   BSS    0           VALIDATION TABLE 
          CVE    HELP,1,3,2,SVT18,2 
          CVE    EXIT,1,3,25,SVT20,3
          CVE    RECEIVE,1,3,23,SVT24,2 
          CVE    SEND,3,3,22,SVT22,1
          CVE    SERVER,3,3,24,SVT20,0
          CVE    SET,3,0,3,VT.A 
          CVE    STATUS,3,4,-7
          CVE    TAKE,3,3,28,SVT22,-1 
          CVE    VERSION,3,4,-5 
          CON    0
  
 VT.A     BSS    0           SET VALIDATION TABLE 
          CVE    CODE,1,0,4,VT.A1 
          CVE    DEBUG,3,0,10,VT.A2 
          CVE    DELAY,3,2,13,DELAY,500,0 
          CVE    MODE,1,0,14,VT.A3
          CVE    WINDOW,1,0,18,VT.A4
          CON    0
  
 VT.A1    BSS    0           CODE VALIDATION TABLE
          CVE    ASCII,5,1,5,FFORM,1
          CVE    ASCII8,6,1,6,FFORM,2 
          CVE    BINARY,3,1,7,FFORM,4 
          CVE    DIS64,3,1,8,FFORM,0
          CVE    HEX,3,1,9,FFORM,3
          CON    0
  
 VT.A2    BSS    0           SET DEBUG VALIDATION TABLE 
          CVE    ON,2,1,11,DEBUG,1
          CVE    OFF,2,1,12,DEBUG,0 
          CON    0
  
 VT.A3    BSS    0           MODE VALIDATION TABLE
          CVE    LOCAL,3,1,15,PFFLAG,0
          CVE    REPLACE,3,1,16,PFFLAG,2
          CVE    SAVE,3,1,17,PFFLAG,1 
          CON    0
  
 VT.A4    BSS    0           WINDOW VALIDATION TABLE
          CVE    ON,2,1,19,RWSIZE,D_WSIZE 
          CVE    OFF,2,1,20,RWSIZE,0
          CVE    SIZE,1,2,21,RWSIZE,31,0
          CON    0
  
 HTABLE   BSS    0           HELP VALIDATION TABLE
          CVE    ASCII,5,4,5
          CVE    ASCII8,6,4,6 
          CVE    BINARY,3,4,7 
          CVE    DIS64,3,4,8
          CVE    HEX,3,4,9
          CVE    CODE,1,4,4 
          CVE    DEBUG,3,4,10 
          CVE    DELAY,3,4,13 
          CVE    MODE,2,4,14
          CVE    WINDOW,3,4,18
          CVE    HELP,3,4,2 
          CVE    EXIT,3,4,25
          CVE    RECEIVE,3,4,23 
          CVE    SEND,3,4,22
          CVE    SERVER,3,4,24
          CVE    SET,3,4,3
          CVE    STATUS,3,4,27
          CVE    TAKE,3,4,28
          CVE    VERSION,3,4,26 
          CVE    COMMAND,7,4,1
          CON    0
          CODE   *
  
          SPACE  4,10 
*         ****  ENTRY  **** 
  
 KERMIT   SB1    1
  
*         PROCESS ARGUMENTS.
  
          SA1    ACTR        (X1) = ARGUMENT COUNT
          SA4    ARGR        (X4) = FIRST ARGUMENT
          SB5    ARGTAB      (B5) = FWA OF ARGUMENT TABLE 
          SB4    X1+         (B4) = ARGUMENT COUNT
          RJ     ARG         PROCESS ARGUMENT LIST
          ZR     X1,KMT2     NO ERROR 
  
*         ARGUMENT ERROR. 
  
          MX6    42 
          BX6    X4*X6       (X6) = ILLEGAL ARGUMENT
          SX4    1R 
          BX6    X4+X6       ADD BLANK
          LX6    60-6        LEFT JUSTIFY BLANK 
          SA6    KMT.C+2     SAVE IN MESSAGE BUFFER 
          MESSAGE KMT.C,3,R  ISSUE MESSAGE
          ABORT 
  
*         INITIALISE. 
  
          SX6    FPE
          SA6    STATE       INITIALISE STATE VARIABLE
 KMT2     RJ     WHF         WRITE HELP FILE
          RJ     ITF         INITIALISE TERMINAL FILES
          RJ     SFB         SET FLUSH BITS 
          RJ     OLF         OPEN LOG FILE
          SA1    KMT.A       (X1) = FIRST WORD OF LOG MESSAGE 
          RJ     WLM         WRITE LOG MESSAGE
          RJ     PID         PROCESS INPUT DIRECTIVES 
          RJ     STI         SET TERMINAL INTERFACE 
          RJ     DBC         DEBUG COMMENCE (IF SELECTED) 
          RJ     IBC         INITIALISE BUFFER CHAIN
          SX1    1           (X1) = INITIAL WINDOW SIZE 
          RJ     IWP         INITIALISE WINDOW POINTER
          REPRIEVE RPB,SETUP,277B 
          WRITEC O,KMT.A     WRITE INITIALISATION MESSAGE 
          WRITER X2,R 
          MESSAGE KMT.A,1,R  SET 'B' DISPLAY
          SA1    TMODE       (X1) = TRANSFER MODE 
          SA1    KMT.B+X1    (X1) = INITIAL STATE CODE
          SX6    X1 
          EQ     SGS         SET GIVEN STATE
  
*         PROCESS REPRIEVE. 
  
 KMT4     RJ     DBX         DEBUG EXCHANGE PACKAGE AREA
          SX6    3           FLAG TERMINATE MODE
          SA6    TMODE       SAVE 
          EQ     PROCABT     PROCESS ABORT
  
 KMT.A    DIS    ,'KERMIT INITIALISED.' 
 KMT.B    BSS    0           INITIAL STATE TABLE
          CON    SCW         SERVER 
          CON    SND         SEND 
          CON    REC         RECEIVE
          CON    CMP         QUIT 
 KMT.C    CON    10H ILLEGAL P,10HARAMETER -,0
          TITLE  PROTOCOL STATE PROCESSORS. 
**        PROTOCOL STATE PROCESSORS.
* 
*         THE FOLLOWING ROUTINE ARE USED TO CHANGE THE CURRENT
*         PROTOCOL STATE ACCORDING TO THE SPECIFIED PROCESS.
* 
*         CPS - CHANGE PROTOCOL STATE 
*         PCS - PROCESS CURRENT STATE 
*         SGS - SET GIVEN STATE 
*         WCS - WAIT FOR INPUT AND CHANGE STATE 
          SPACE  4,10 
****      KERMIT STATE TABLE. 
* 
*         THE KERMIT STATE TABLE DESCRIBES ALL THE STATE CHANGES
*         REQUIRED DURING THE PROTOCOL. THE TABLE IS IN EFFECT A
*         MATRIX THE ROW NUMBER BEING THE CURRENT STATE AND THE 
*         COLUMN NUMBER BEING THE ACTION CODE TO CHANGE STATE (THIS 
*         IS NORMALLY AN INPUT PACKET TYPE). THE CODE AT THE ROW
*         AND COLUMN INTERSECTION IS THE REQUIRED NEW STATE.
  
  
 STABLE   BSS    0           KERMIT STATE TABLE 
          LOC    0
  
* INIT            ?   T   D   A   N   S   B   F   Z   E   R   G   I 
 FPE      STATE  ___,___,___,___,___,___,___,___,___,ERR,___,___,___
 SCW      STATE  SCW,SCT,SCW,SCW,SCW,SCR,SCW,SCW,SCW,ERR,SCS,SCG,INT
 SCT      STATE  SCW,___,___,___,___,___,___,___,___,___,___,___,___
 SND      STATE  ___,___,___,___,___,___,___,___,___,ERR,___,___,___
 REC      STATE  REC,REC,___,___,___,SCR,___,___,___,ERR,___,___,___
 SCS      STATE  SI_,___,___,___,___,___,___,___,___,ERR,___,___,___
 SCR      STATE  ABT,___,___,___,___,___,___,___,___,ERR,___,___,___
 INT      STATE  ___,___,___,___,___,___,___,___,___,___,___,___,___
 SI       STATE  SIE,SIE,SIE,SIV,SIE,SIE,SIE,SIE,SIE,ERR,SIE,SIE,SIE
 SIE      STATE  SIE,SIE,SIE,SIV,SIE,SIE,SIE,SIE,SIE,ERR,SIE,SIE,SIE
 SIV      STATE  SF_,SI_,SI_,SI_,SI_,SI_,SI_,SI_,SI_,ERR,SI_,___,___
 OF       STATE  ___,___,___,___,___,___,___,___,___,ERR,___,___,___
 SF       STATE  SF_,SF_,___,SFW,SFW,___,___,___,___,ERR,___,___,___
 SFW      STATE  ___,SFW,___,SFW,SFW,___,___,___,___,ERR,___,___,___
 SD       STATE  SDT,SDT,___,SD_,SD_,___,___,___,___,ERR,___,___,___
 SDT      STATE  ___,___,___,___,___,___,___,___,___,ERR,___,___,___
 SDW      STATE  SDW,___,___,SDW,SDW,___,___,___,___,ERR,___,___,___
 SEF      STATE  ___,SET,___,OF_,___,___,___,___,___,ERR,___,___,___
 SET      STATE  SET,SET,___,OF_,___,___,___,___,___,ERR,___,___,___
 SB       STATE  ___,SB_,___,CMP,___,___,___,___,___,ERR,___,___,___
 RF       STATE  ___,___,___,___,___,SCR,RDE,RFF,ADP,ERR,___,___,___
 RFF      STATE  ___,___,___,___,___,___,___,___,___,ERR,___,___,___
 RD       STATE  RDT,RDT,RD_,___,___,___,___,ADP,RDW,ERR,___,___,___
 RDT      STATE  ___,___,___,___,___,___,___,___,___,ERR,___,___,___
 RDW      STATE  ___,___,___,___,___,___,___,___,___,ERR,___,___,___
 RDE      STATE  ___,___,___,___,___,___,___,___,___,ERR,___,___,___
 SCG      STATE  ___,___,___,___,___,___,___,___,___,ERR,___,___,___
 ADP      STATE  ___,___,___,___,___,___,___,___,___,___,___,___,___
 ERR      STATE  ___,___,___,___,___,___,___,___,___,___,___,___,___
 ABT      STATE  ___,___,___,___,___,___,___,___,___,ERR,___,___,___
 CMP      STATE  ___,___,___,___,___,___,___,___,___,ERR,___,___,___
  
          LOC    *O 
****
          SPACE  4,10 
**        CPS - CHANGE PROTOCOL STATE.
* 
*         THIS ROUTINE CHANGES STATE ACCORDING TO THE GIVEN PROCESS 
*         CODE (NORMALLY PACKET TYPE). NOTE THAT THIS CODE IS NOT A 
*         SUBROUTIINE AND SO SHOULD BE ENTERED USING A JUMP NOT 
*         A CALL. 
* 
*         ENTRY  (B1) = 1 
*                (X1) = PROCESS CODE
* 
*         EXIT   (X6) = NEW STATE ORDINAL 
*                STATE CHANGED
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 7. 
* 
*         CALLS  NONE.
          SPACE  4,10 
 CPS      BSS    0           ENTRY
  
          MX6    -3 
          BX6    -X6*X1      (X6) = WORD POSITION IN STATE TABLE
          SA2    STATE       (X2) = CURRENT STATE ORDINAL 
          BX7    X1-X2       COMPARE NEW STATE WITH PREVIOUS
          AX1    3           (X1) = WORD OFFSET 
          LX2    2           (X2) = OFFSET TO START OF CURENT STATE ENTR
          SX6    X6+B1       OFFSET WORD POSITION 
          IX1    X1+X2       (X1) = OFFSET TO REQUIRED STATE CHANGE 
          BX2    X6 
          SA1    STABLE+X1   (X1) = REQUIRED ENTRY FROM STATE TABLE 
          LX6    3
          IX6    X6-X2       (X6) = 7 * ENTRY POSITION WITHIN WORD
          SB7    X6          (B7) = SHIFT COUNT 
          LX1    B7          RIGHT JUSTIFY REQUIRED STATE 
          MX6    -7 
          BX6    -X6*X1      (X6) = NEW REQUIRED STATE
          SA7    CSTATE      SAVE STATE CHANGE FLAG 
*         EQ     SGS         SET GIVEN STATE
          SPACE  4,10 
**        SGS - SET GIVEN STATE.
* 
*         THIS ROUTINE SETS THE CURRENT STATE TO THE GIVEN
*         VALUE AND THEN STARTS PROCESSING. NOTE THAT THIS
*         IS NOT A SUBROUTINE AND SO SHOULD BE ENTERED VIA
*         A JUMP NOT A CALL.
* 
*         ENTRY  (B1) = 1 
*                (X6) = REQUIRED STATE ORDINAL
* 
*         EXIT   ENTRY TO PROCESS REQUESTED 
* 
*         USES   X - 1. 
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS  DBS. 
          SPACE  4,10 
 SGS      SA6    STATE       SAVE REQUIRED STATE
          SA1    DEBUG       (X1) = DEBUG FLAG
          ZR     X1,PCS      DEBUG OFF
          RJ     DBS         DEBUG STATE
*         EQ     PCS         PROCESS CURRENT STATE
          SPACE  4,10 
**        PCS - PROCESS CURRENT STATE.
* 
*         THIS CODE BRANCHES TO THE REQUIRED CODDE AREA ACCORDING 
*         TO THE CURRENT PROTOCOL STATE. NOTE THAT THIS CODE IS NOT 
*         A SUBROUTINE AND HENCE SHOULD BE JUMPED TO NOT CALLED.
* 
*         ENTRY  CURRENT STATE DEFINED. 
* 
*         EXIT   TO REQUIRED CODE 
* 
*         USES   X - 1. 
*                A - 1. 
*                B - 7. 
* 
*         CALLS  NONE.
  
 PCS      SA1    STATE       (X1) = CURRENT STATE 
          SA1    PCS.A+X1    (X) = PROCESS ADDRESS
          SB7    X1 
          JP     B7+         BRANCH TO PROCESS ADDRESS
  
 PCS.A    BSS    0           PROCESS ADDRESS TABLE
          LOC    0
 FPE      CON    PROCFPE     FORCE PROTOCOL ERROR 
 SCW      CON    PROCSCW     SERVER COMMAND WAIT
 SCT      CON    PROCSCT     SERVER COMMAND TIMEOUT 
 SND      CON    PROCSND     SEND FILE(S) 
 REC      CON    PROCREC     RECEIVE FILE(S)
 SCS      CON    PROCSCS     SERVER COMMAND SEND
 SCR      CON    PROCSCR     SERVER COMMAND RECEIVE 
 INT      CON    PROCINT     PROCESS INIT PACKET
 SI       CON    PROCSI      SEND INIT PACKET 
 SIE      CON    PROCSIE     SENT INIT ERROR
 SIV      CON    PROCSIV     WAIT FOR SEND INIT VERIFY
 OF       CON    PROCOF      OPEN FILE
 SF       CON    PROCSF      SEND FILE
 SFW      CON    PROCSFW     SEND FILE WAIT 
 SD       CON    PROCSD      SEND DATA
 SDT      CON    PROCSDT     SEND DATA TIMEOUT
 SDW      CON    PROCSDW     SEND DATA WAIT 
 SEF      CON    PROCSEF     SEND END OF FILE 
 SET      CON    PROCSET     SEND END OF FILE TIMEOUT 
 SB       CON    PROCSB      SEND BREAK 
 RF       CON    PROCRF      RECEIVE FILE 
 RFF      CON    PROCRFF     RECEIVE FILE - FILE HEADER RECEIVED
 RD       CON    PROCRD      RECEIVE DATA 
 RDT      CON    PROCRDT     RECEIVE DATA TIMEOUT 
 RDW      CON    PROCRDW     RECEIVE DATA WAIT
 RDE      CON    PROCRDE     RECEIVE DATA END 
 SCG      CON    PROCSCG     SERVER GENERIC COMMAND 
 ADP      CON    PROCADP     ACK DUPLICATE (SUPERFLUOUS) PACKET 
 ERR      CON    PROCERR     ERROR CONDITION
 ABT      CON    PROCABT     ABORT
 CMP      CON    PROCCMP     COMPLETE 
          LOC    *O 
          SPACE  4,10 
**        WCS - WAIT FOR INPUT AND CHANGE STATE.
* 
*         THIS ROUTINE WAITS FOR INPUT AND WHEN AVAILABLE CHANGES 
*         STATE ACCORDING TO THE INPUT. IF THERE IS NO INPUT THEN 
*         A TIMEOUT SHOULD OCCURR WHICH WILL CAUSE THE STATE CHANGE.
*         NOTE THAT THIS CODE IS NOT A SUBROUTINE AND SO SHOULD 
*         BE ENTERED USING A JUMP NOT A CALL. 
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   STATE CHANGED ACCORDING TO INPUT 
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS  RTI, SYS=. 
          SPACE  4,10 
*         INITIALISE TIMEOUT COUNTER. 
  
 WCS      SA1    TIMER       (X1) = TIMEOUT REQUIRED IN SECONDS 
          SX6    20          (X6) = CONVERSION TO WAIT TIME 
          IX6    X1*X6       (X6) = NUMBER OF TIMES TO LOOP 
          SA6    WCS.A       SAVE 
  
*         WAIT TILL INPUT AVAILABLE.
  
 WCS2     RJ     RTI         READ TERMINAL INPUT
          NZ     X1,WCS6     INPUT AVAILABLE
          SA1    WCS.A       (X1) = TIMEOUT COUNTER 
          SX6    X1-1        DECREMENT
          SA6    A1+         REPLACE
          ZR     X6,WCS4     TIMEOUT
          WAIT   50          RELINQUISH CPU 
          EQ     WCS2        LOOP TILL INPUT AVAILABLE
  
*         TIMED OUT WHILE WAITING FOR INPUT SO FORCE ERROR. 
  
 WCS4     SX1    TIMEOUT     (X1) = TIMEOUT CODE
          EQ     CPS         CHANGE PROTOCOL STATE
  
*         INPUT AVAILABLE SO DETERMINE PACKET TYPE. 
  
 WCS6     NG     X1,WCS8     CHECKSUM ERROR 
          MX6    -7 
          BX1    -X6*X1      ENSURE TYPE IS 7 BIT ASCII 
          SA1    A2C+X1      TABLE LOOKUP 
          AX1    18+18
          SX1    X1          (X1) = PACKET TYPE ORDINAL 
          PL     X1,CPS      VALID SO CHANGE STATE
  
*         INVALID PACKET TYPE OR CHECKSUM.
  
 WCS8     MX1    0           FLAG CHECKSUM ERROR
          EQ     CPS         CHANGE PROTOCOL STATE
  
 WCS.A    BSS    1           TIMER
          SPACE  4,10 
**        PROCFPE - FORCE PROTOCOL ERROR. 
* 
*         THIS ROUTINE SENDS AN ERROR PACKET SPECIFYING A 
*         'PROTOCOL ERROR' AND ENTERS THE ABORT STATE.
  
 PROCFPE  SX1    1
          RJ     IWP         FORCE MINIMUM WINDOW SIZE
          RJ     IBC         INITIALISE BUFFER CHAIN
  
*         DETERMINE MESSAGE REQUIRED. 
  
          SA1    EMODE       (X1) = ERROR MODE
          MX6    0
          SA6    A1          CLEAR IT FOR NEXT TIME!
          SA1    FPE.A+X1    (X1) = PARAMETER WORD
          SB7    X1          (B7) = LENGTH
          AX1    18 
          SB6    X1          (B6) = FWA OF TEXT 
          SB5    ERROR       (B5) = PACKET TYPE 
          MX3    59          FLAG NEXT SEQUENCE NUMBER
          RJ     BTP         BUILD TRANSMISSION PACKET
          ZR     X6,FPE2     ERROR
          BX1    X6          (X1) = ATTRIBUTES
          RJ     TPK         TRANSMIT PACKET
  
 FPE2     SX6    ABT         FORCE ABORT STATE
          EQ     SGS         SET GIVEN STATE
  
 FPE.A    BSS    0           MESSAGE PARAMETER TABLE
          VFD    24/0,18/FPE.B,18/FPE.BL  0 - PROTOCOL ERROR
          VFD    24/0,18/FPE.C,18/FPE.CL  1 - PROTOCOL TIME OUT 
          VFD    24/0,18/FPE.D,18/FPE.DL  2 - PACKET RETRY LIMIT EXCEEDE
          VFD    24/0,18/FPE.E,18/FPE.EL  3 - ILLEGAL DATA PACKET STRUCT
          VFD    24/0,18/FPE.F,18/FPE.FL  4 - FILE NOT FOUND
          VFD    24/0,18/FPE.G,18/FPE.GL  5 - ILLEGAL CHARACTER 
 FPE.B    MSG    ( PROTOCOL ERROR.) 
 FPE.C    MSG    ( PROTOCOL TIMED OUT.) 
 FPE.D    MSG    ( PACKET RETRY LIMIT EXCEEDED.)
 FPE.E    MSG    ( ILLEGAL DATA PACKET STRUCTURE.)
 FPE.F    MSG    ( FILE NOT FOUND.) 
 FPE.G    MSG    ( ILLEGAL CHARACTER CODE - SEE LOG.) 
          SPACE  4,10 
**        PROCSCW - SERVER COMMAND WAIT.
* 
*         THIS COMMAND WAITS FOR DIRECTIVES VIA THE KERMIT
*         PACKET PROTOCOL.
  
 PROCSCW  MESSAGE SCW.A,1,R 
          RJ     IBC         INITIALISE BUFFER CHAIN
          SX1    1           (X1) = REQUIRED WINDOW SIZE
          RJ     IWP         INITIALISE WINDOW POINTER
          EQ     WCS         WAIT FOR INPUT AND CHANGE STATE
  
 SCW.A    DIS    ,'KERMIT SERVER WAIT.' 
          SPACE  4,10 
**        PROCSCT - SERVER COMMAND TIMEOUT. 
* 
*         THIS STATE IS ENTERED WHEN A TIMEOUT OCCURS IN SERVER 
*         COMMAND WAIT STATE. IF QUIET MODE IS NOT SELECTED THEN
*         A 'NAK' PACKET IS TRANSMITTED EVERY 5 TIMEOUTS. 
  
 PROCSCT  SA1    SCT.A       (X1) = TIME OUT COUNTER
          SX6    X1-1        DECREMENT
          SA6    A1+         REPLACE
          NZ     X6,SCT2     NO 'NAK' REQUIRED
  
*         RESET COUNTER AND CHECK IF IN 'QUIET MODE'. 
  
          SX6    5           (X6) = TIMEOUT COUNTER 
          SA6    A6+         RESET
          SA1    QUIETF      (X1) = QUIET MODE FLAG 
          NZ     X1,SCT2     QUIET MODE SELECTED SO NO 'NAK'
  
*         TRANSMIT 'NAK' WITH SEQUENCE NUMBER ZERO. 
  
          SX3    B0          (X3) = SEQUENCE NUMBER 
          RJ     NGP         NAK GIVEN PACKET 
  
*         RESET SCW STATE.
  
 SCT2     SX6    SCW         (X6) = SERVER COMMAND WAIT 
          EQ     SGS         SET GIVEN STATE
  
 SCT.A    CON    1           TIMEOUT LOOP COUNTER 
          SPACE  4,10 
**        PROCSND - SEND FILE(S). 
* 
*         THIS STATE IS THE NONE SERVER ENTRY FOR SENDING FILES.
*         IT WAITS FOR THE SPECIFIED DELAY TIME AND THEN ENTERS 
*         THE SEND INIT STATE.
  
 PROCSND  SA1    FNAME       (X1) = FILE NAME POINTER 
          SB7    X1          (B7) = LWA + 1 OF FILE NAME
          AX1    18 
          SB6    X1          (B6) = FWA OF FILE NAME
          SB5    0           FLAG WILD CARDS VALID
          SB7    B7-B6       (B7) = CHARACTER COUNT 
          RJ     BFN         BUILD FILE NAME
          SA6    FNAME       SAVE FILE NAME 
          SA7    FMASK       SAVE FILE NAME MASK
  
          SA1    SND.B       (X1) = FIRST WORD OF LOG MESSAGE 
          RJ     WLM         WRITE LOG MESSAGE
          SA1    DELAY       (X1) = DELAY COUNTER 
          ZR     X1,SND4     NO DELAY REQUIRED
          SX6    X1+
          SA6    SND.A       SAVE DELAY COUNT 
          MESSAGE SND.C,1,R 
  
*         WAIT FOR SPECIFIED DELAY TIME.
  
 SND2     WAIT   1000        WAIT FOR ONE SECOND
          SA1    SND.A       (X1) = LOOP COUNT
          SX6    X1-1        DECREMENT
          SA6    A1+         REPLACE
          NZ     X6,SND2     LOOP TILL DELAY EXPIRED
  
*         ENTER SEND INIT STATE.
  
 SND4     MESSAGE SND.B,1,R 
          SX6    SI          (X6) = SEND INIT STATE 
          EQ     SGS         SET GIVEN STATE
  
 SND.A    BSS    1           DELAY COUNTER
 SND.B    DIS    ,'KERMIT SENDING.' 
 SND.C    DIS    ,'KERMIT WAITING.' 
          SPACE  4,10 
**        PROCREC - RECEIVE FILE(S).
* 
*         THIS STATE IS ENTERED FOR A NONE SERVER RECEIVE FUNCTION. 
*         THE STATE WAITS FOR AN 'S' PACKET FROM THE REMOTE END.
  
 PROCREC  EQ     WCS         WAIT FOR INPUT 
          SPACE  4,10 
**        PROCSCR - SERVER COMMAND RECEIVE. 
* 
*         THIS STATE IS ENTERED WHEN AN 'S' TYPE PACKET IS
*         RECEIVED. THE PACKET IS PROCESSED AND AN 'ACK' RETURNED 
*         WITH THE ACCEPTED ATTRIBUTES. THE 'RECEIVE FILE' STATE
*         IS THEN ENTERED.
  
 PROCSCR  SA1    IQPTR       (X1) = FWA OF 'S' PACKET 
          SA2    X1+PSEQ     (X2) = SEQUENCE NUMBER 
          ZR     X2,SCR2     ZERO SO VALID
          SX6    SCW         RETURN TO WAIT STATE 
          EQ     SGS         SET GIVEN STATE
  
*         PROCESS 'S' PARAMETERS. 
  
 SCR2     RJ     CPR         CREATE PARAMETER REPLY 
          RJ     RIB         RETURN INPUT BUFFER
          SA1    SCR.A       (X1) = FIRST WORD OF LOG MESSAGE 
          RJ     WLM         WRITE LOG MESSAGE
          MESSAGE SCR.A,1,R 
          SX6    RF          (X6) = NEXT STATE
          SA6    STATE       SAVE CURRENT STATE 
          EQ     WCS         WAIT FOR INPUT AND CHANGE STATE
  
 SCR.A    DIS    ,'KERMIT RECEIVING.' 
          SPACE  4,10 
**        PROCSCS - SERVER COMMAND SEND.
* 
*         THIS STATE IS ENTERED WHEN AN 'R' PACKET IS RECEIVED WHEN 
*         SERVER COMMAND WAIT. THE FILE NAME IS EXTRACTED AND THEN
*         THE SEND INIT STATE IS ENTERED. 
  
 PROCSCS  SA1    IQPTR       (X1) = INPUT QUEUE POINTER 
          SA2    X1+PSEQ     (X2) = PACKET SEQUENCE NUMBER
          NZ     X2,SCS2     ILLEGAL
          RJ     UDF         UNPACK DATA FIELD
          ZR     B7,SCS2     ILLEGAL
          SB5    0           ALLOW WILD CHARACTERS IN FILE NAME 
          RJ     BFN         BUILD FILE NAME
          SX6    0
          SA6    TTYPE       SET TRANSFER TYPE
          SX6    SI          (X6) = REQUIRED STATE (SEND INIT)
          EQ     SGS         SET GIVEN STATE
  
*         ILLEGAL SEQUENCE NUMBER.
  
 SCS2     RJ     RIB         RETURN INPUT BUFFER
          SX6    SCW         RETURN TO SERVER COMMAND WAIT
          EQ     SGS         SET GIVEN STATE
          SPACE  4,10 
**        PROCINT - PROCESS INIT PACKET.
* 
*         THIS STATE IS ENTERED WHEN AN 'I' PACKET IS RECEIVED
*         WHILE IN THE 'SERVER COMMAND WAIT' STATE. 
  
 PROCINT  SA1    IQPTR       (X1) = FWA OF 'I' PACKET 
          SA2    X1+PSEQ     (X2) = PACKET SEQUENCE NUMBER
          ZR     X2,INT2     ZERO SO VALID
          SX6    SCW         RETURN TO WAIT STATE 
          EQ     SGS         SET GIVEN STATE
  
 INT2     RJ     CPR         CREATE PARAMETER REPLY 
          RJ     RIB         RETURN INPUT BUFFER
          SX6    SCW         RETURN TO WAIT STATE 
          EQ     SGS         SET GIVEN STATE
          SPACE  4,10 
**        PROCSI - SEND INITIALISATION. 
* 
*         THIS CODE SENDS AN 'S' PACKET AND THEN AWAITS THE REPLY 
*         IF NOT A SUITABLE 'ACK' THEN ANOTHER PACKET IS SENT UNTIL 
*         THE RETRY LIMIT IS REACHED. 
* 
  
 PROCSI   MX7    59 
          SX6    B0 
          SA7    FIRSTF      FLAG FIRST FILE
          SA6    SEQ         FORCE ZERO 
          SB5    SENDI       (B5) = REQUIRED PACKET TYPE
          SA6    REPT        CLEAR REPEAT CHARACTER 
          RJ     BCP         BUILD CONNECTION PARAMETERS
          MX3    59          USE NEXT SEQUENCE NUMBER 
          RJ     BTP         BUILD TRANSMISSION PACKET
          RJ     TGP         TRANSMIT GIVEN PACKET
          EQ     WCS         WAIT FOR INPUT AND CHANGE STATE
          SPACE  4,10 
**        PROCSIE - SEND INITIALISATION ERROR.
* 
*         THIS STATE IS ENTERED WHEN AN ILLEGAL RESPONSE IS 
*         RECEIVED AFTER SENDING A 'SEND INIT' PACKET. THE
*         PACKET IS RESENT UNTIL THE RETRY LIMIT IS REACHED.
  
 PROCSIE  SX1    0           (X1) = SEQUENCE NUMBER OF PACKET TO RESEND 
          RJ     RSP         RESEND PACKET
          EQ     WCS         WAIT FOR INPUT AND CHANGE STATE
          SPACE  4,10 
**        PROCSIV - SEND INIT VERIFICATION. 
* 
*         THIS TASK IS ENTERED WHEN AN 'ACK' IS RECEIVED AFTER A
*         'SEND INIT' HAS BEEN TRANSMITTED. 
* 
  
 PROCSIV  SA1    IQPTR       (X1) = INPUT QUEUE POINTER 
          SA1    X1+PSEQ     (X1) = PACKET SEQUENCE NUMBER
          ZR     X1,SIV2     VALID
          SX6    SIE         FORCE ERROR
          EQ     SGS         SET GIVEN STATE
  
*         PACKET SEQUENCE VALID SO PROCESS. 
  
 SIV2     RJ     PPR         PROCESS PARAMETER REPLY
          RJ     RIB         RETURN INPUT BUFFER
          SX1    0
          RJ     PAP         PROCESS ACK PACKET 
          SX6    OF          (X6) = REQUIRED STATE
          EQ     SGS         GOTO SET GIVEN STATE 
          SPACE  4,10 
**        PROCOF - OPEN FILE. 
* 
*         THIS ROUTINE GETS THE NEXT FILE NAME AND OPENS THE FILE 
*         FOR READING.
  
 PROCOF   RJ     GNF         GET NEXT FILE
          NZ     X6,OF2      FILE FOUND 
  
*         CHECK THIS IS NOT THE FIRST FILE. 
  
          SA1    FIRSTF      (X1) = FIRST FILE FLAG 
          NG     X1,OF1      FIRST FILE NOT FOUND SO ERROR
  
*         NO MORE FILES SO SEND BREAK.
  
          SX6    SB          (X6) = REQUIRED STATE
          EQ     SGS         SET GIVEN STATE
  
*         FIRST FILE NOT FOUND SO FLAG ERROR. 
  
 OF1      SX6    4
          SA6    EMODE       SET ERROR MODE 
          SX6    FPE         FORCE PROTOCOL ERROR 
          EQ     SGS         SET GIVEN STATE
  
*         FILE FOUND SO OPEN FILE.
  
 OF2      SX6    0
          SA6    IQPTR       CLEAR INPUT QUEUE POINTER
          SA6    FIRSTF      CLEAR FIRST FILE FLAG
          SA6    FWORD       CLEAR PACKING WORD 
          SA6    FCOUNT      CLEAR PACKING COUNTER
          RJ     IBC         INITIALISE BUFFER CHAIN
          SX1    1           (X1) = REQUIRED WINDOW SIZE
          RJ     IWP         INITIALISE WINDOW POINTER
          SA1    OF.A        (X1) = FIRST WORD OF TEXT
          RJ     WLM         WRITE LOG MESSAGE
          SX6    SF          (X6) = REQUIRED STATE
          EQ     SGS         SET GIVEN STATE
  
 OF.A     DIS    ,'    SENDING - ;A.' 
          SPACE  4,10 
**        PROCSF - SEND FILE. 
* 
*         THIS ROUTINE SENDS A FILE HEADER FOR THE CURRENTLY
*         OPEN FILE.
* 
  
 PROCSF   SA1    ANAME       CHECK FOR ALTERNATIVE FILE NAME
          NZ     X1,SF3      ALTERNATIVE SPECIFIED
          SA1    SF.A-1      (A1) = BUFFER ADDRESS - 1
          BX6    X1 
          SA6    A1          PRESET DESTINATION ADDRESS 
          SX0    77B
          SB7    -1          CLEAR BYTE COUNT 
          SA1    CNAME       (X1) = CURRENT FILE NAME 
          MX6    42 
          BX1    X1*X6       TRUNCATE TO 7 CHARACTERS 
  
*         UNPACK NAME TO STRING BUFFER. 
  
 SF2      LX1    6
          SB7    B7+1        INCREMENT BYTE COUNT 
          BX2    X0*X1       (X2) = CDC DISPLAY CODE
          ZR     X2,SF4      END OF NAME
          SA2    C2A+X2      CONVERT TO ASCII 
          SX6    X2 
          SA6    A6+B1       SAVE IN STRING BUFFER
          SB6    SF.A        (B6) = FWA OF DATA 
          EQ     SF2         LOOP TILL END OF NAME
  
*         USE ALTERNATIVE FILE NAME.
  
 SF3      SB7    X1          (B7) = LWA + 1 OF NAME 
          MX6    0
          AX1    18 
          SA6    A1          CLEAR ALTERNATIVE NAME 
          SB6    X1          (B6) = FWA OF NAME 
          SB7    B7-B6       (B7) = BYTE COUNT
  
*         TRANSMIT FILE HEADER PACKET.
  
 SF4      SA1    TTYPE       (X1) = TRANSFER TYPE 
          SA1    SF.B+X1     (X1) = PACKET TYPE CODE
          SB5    X1 
          MX3    59          USE NEXT SEQUENCE NUMBER 
          RJ     BTP         BUILD TRANSMISSION PACKET
          RJ     TGP         TRANSMIT GIVEN PACKET
          EQ     WCS         WAIT FOR INPUT AND CHANGE STATE
  
 SF.A     BSS    8           FILE NAME BUFFER 
 SF.B     BSS    0           TRANSFER TYPE FLAG 
          CON    FILEH       FILE 
          CON    FILEX       TYPE 
          SPACE  4,10 
**        PROCSFW - SEND FILE HEADER WAIT.
* 
*         THIS STATE IS ENTERED AFTER A FILE HEADER HAS BEEN SENT.
*         WHEN THE CORRESPONDING ACK HAS BEEN PROCESSED THE WINDOW
*         SIZE IS RESET FOR THE DATA TRANSFER.
  
 PROCSFW  SA1    IQPTR       (X1) = INPUT QUEUE POINTER 
          ZR     X1,WCS      NO INPUT SO WAIT TILL THERE IS 
          SA1    X1+PTYPE    (X1) = TYPE CODE 
          SX1    X1-131B     CHECK IF 'ACK' 
          NZ     X1,SFW2     NOT ACK
  
*         PROCESS ACK PACKET. 
  
          SA1    A1-PTYPE+PSEQ (X1) = PACKET SEQUENCE NUMBER
          RJ     PAP         PROCESS ACK PACKET 
  
*         CHECK WINDOW IS NOW FULLY OPEN. 
  
          RJ     CWO         CHECK WINDOW IS OPEN 
          SX1    X1-1        CHECK FULLY OPEN 
          NZ     X1,WCS      ACK STILL OUTSTANDING
  
*         RESET WINDOW SIZE FOR DATA TRANSFER.
  
          SA1    WSIZE       (X1) = AGREED WINDOW SIZE
          RJ     IWP         INITIALISE WINDOW POINTER
          SX6    SD          (X6) = NEXT STATE
          EQ     SGS         SET GIVEN STATE
  
*         CHECK FOR PENDING NAK.
  
 SFW2     SX1    X1+131B-116B CHECK FOR NAK 
          NZ     X1,SFW4     NOT NAK SO MUST BE TIMEOUT 
  
*         PROCESS NAK PACKET. 
  
          SA1    A1-PTYPE+PSEQ (X1) = SEQUENCE NUMBER 
          SA2    LASTSEQ     (X2) = LAST SEQUENCE NUMBER
          MX6    -6 
          SX2    X2+B1       INCREMENT
          BX2    -X6*X2      ENSURE 6 BIT 
          BX2    X1-X2       COMPARE
          NZ     X2,SFW4     NOT NEXT SO RESEND 
  
*         NAK FOR N+1 SO SET TO 'SEND DATA' STATE.
  
          SX6    SD          (X6) = SEND DATA STATE 
          EQ     SGS         SET GIVEN STATE
  
*         NAK OR TIMEOUT SO RESEND 'F' PACKET.
  
 SFW4     SA1    LASTSEQ     (X1) = SEQUENCE NUMBER 
          RJ     RSP         RESEND PACKET
          EQ     WCS         WAIT FOR INPUT 
          SPACE  4,10 
**        PROCSD - SEND DATA. 
* 
*         THIS ROUTINE TRANSMITS DATA PACKETS UNTIL AN END OF FILE
*         IS REACHED. 
  
*         CHECK FOR PENDING ACK.
  
 PROCSD   SA1    IQPTR       (X1) = INPUT QUEUE POINTER 
          ZR     X1,SD4      NO INPUT PACKET
          SA1    X1+PTYPE    (X1) = TYPE CODE 
          SX1    X1-131B     CHECK IF 'ACK' 
          NZ     X1,SD2      NOT ACK
  
          SA1    A1-PTYPE+PSEQ (X1) = PACKET SEQUENCE NUMBER
          RJ     PAP         PROCESS ACK PACKET 
  
*         CHECK FOR INTERRUPT.
  
          SA1    IQPTR       (X1) = FWA OF PACKET 
          SA1    X1+PLEN     (X1) = PACKET LENGTH 
          SX1    X1-4        CHECK LENGTH 
          NG     X1,SD4      NO DATA FIELD
          SA1    A1-PLEN+PDATA (X1) = DATA WORD 
          MX6    -8 
          BX1    -X6*X1      (X1) = FIRST DATA BYTE 
          SX1    X1-130B     CHECK FOR 'X'
          ZR     X1,SD1      ABORT FILE 
          SX1    X1+130B-132B          CHECK FOR 'Z'
          NZ     X1,SD4      NO INTERRUPT 
          SX7    0
          SA7    FNAME       CLEAR FILE NAME TO FORCE END OF GROUP
          SA7    A7+1        CLEAR MASK 
  
*         RETURN ANY OUTSTANDING PACKETS. 
  
 SD1      SX1    B1 
          RJ     IWP         RESET WINDOW SIZE
          RJ     IBC         INITIALISE BUFFER CHAIN
          SX6    SEF         SEND EOF PACKET
          EQ     SGS         SET GIVEN STATE
  
*         CHECK FOR PENDING NAK.
  
 SD2      SX1    X1+131B-116B CHECK FOR NAK 
          NZ     X1,SD4      NOT NAK
  
          SA1    A1-PTYPE+PSEQ (X1) = PACKET SEQUENCE NUMBER
          RJ     RSP         RESEND PACKET IF WITHIN WINDOW 
          ZR     X6,SD4      PACKET FOUND AND RESENT
          RJ     ROU         RE-TRANSMIT OLDEST UNACKED PACKET
  
*         CHECK IF WINDOW IS OPEN.
  
 SD4      RJ     CWO         CHECK IF WINDOW IS OPEN
          ZR     X1,WCS      WINDOW CLOSED SO WAIT FOR INPUT
  
*         BUILD AND TRANSMIT DATA PACKET. 
  
 SD5      RJ     BDP         BUILD DATA PACKET
          ZR     X6,SD6      END OF DATA
          RJ     TGP         TRANSMIT GIVEN PACKET
 .1       IFLT   PSR,617
  
*         AS NO TLX LOOK-AHEAD ONLY READ IF WINDOW IS CLOSED. 
  
          RJ     CWO         CHECK IF WINDOW OPEN 
          NZ     X1,SD5      STILL OPEN SO SEND NEXT DATA PACKET
 .1       ENDIF 
  
*         CHECK IF ANY INPUT NOW AVAILABLE. 
  
          RJ     RTI         READ TERMINAL INPUT
          SX6    0
          SA6    WCS.A       CLEAR DEBUG TIMER
          ZR     X1,SD4      NO INPUT 
          EQ     WCS6        GOTO PACKET IDENTIFICATION AND STATE CHANGE
  
*         END OF DATA SO SEND EOF.
  
 SD6      RJ     RIB         RETURN INPUT BUFFER
          SX6    SDW         WAIT FOR END OF DATA TRANSMISSION
          EQ     SGS         SET GIVEN STATE
          SPACE  4,10 
**        PROCSDT - SEND DATA TIMEOUT.
* 
*         THIS STATE IS ENTERED WHEN A TIMEOUT OCCURS WHEN IN 
*         THE SEND DATA STATE. THE OLDEST UNACKED PACKET IS RESENT. 
  
 PROCSDT  SA1    RETIME      (X1) = TIMEOUT RETRY COUNTER 
          SX6    X1-1        DECREMENT
          ZR     X6,SDT2     PROTOCOL TIME OUT
          SA6    A1+         REPLACE
          RJ     ROU         RETRANSMIT OLDEST UNACKED PACKET 
          SX6    SD          (X6) = SEND DATA STATE 
          EQ     SGS         SET GIVEN STATE
  
*         PROTOCOL TIMED OUT. 
  
 SDT2     SX6    1           FLAG TIMED OUT 
          SA6    EMODE       SAVE ERROR MODE
          SX6    FPE         FORCE PROTOCOL ERROR 
          EQ     SGS         SET GIVEN STATE
          SPACE  4,10 
**        PROCSDW - SEND DATA WAIT. 
* 
*         THIS STATE IS ENTERED AFTER ALL DATA HAS BEEN SENT. 
*         WHEN THE CORRESPONDING ACK HAS BEEN PROCESSED THE WINDOW
*         SIZE IS RESET TO ONE. 
  
 PROCSDW  SA1    IQPTR       (X1) = INPUT QUEUE POINTER 
          ZR     X1,SDW1     NO INPUT PACKET
          SA1    X1+PTYPE    (X1) = TYPE CODE 
          SX1    X1-131B     CHECK IF 'ACK' 
          NZ     X1,SDW2     NOT ACK
  
*         PROCESS ACK PACKET. 
  
          SA1    A1-PTYPE+PSEQ (X1) = PACKET SEQUENCE NUMBER
          RJ     PAP         PROCESS ACK PACKET 
  
*         CHECK WINDOW IS NOW FULLY OPEN. 
  
 SDW1     RJ     UWP         UPDATE WINDOW POINTER
          SA1    WSIZE       (X1) = MAXIMUM WINDOW SIZE 
 +        NZ     X1,*+1      WINDOWING ENABLED
          SX1    1           ASSUME MINIMUM SIZE
          BX1    X1-X6       COMPARE
          NZ     X1,WCS      NOT FULLY OPEN SO WAIT FOR MORE INPUT
  
*         RESET WINDOW SIZE TO END TRANSFER.
  
          SX1    B1          (X1) = WINDOW SIZE 
          RJ     IWP         INITIALISE WINDOW POINTER
          SX6    SEF         (X6) = NEXT STATE
          EQ     SGS         SET GIVEN STATE
  
*         CHECK FOR PENDING NAK.
  
 SDW2     SX1    X1+131B-116B CHECK FOR NAK 
          NZ     X1,SDW4     NOT NAK
  
*         PROCESS NAK PACKET. 
  
          SA1    A1-PTYPE+PSEQ (X1) = PACKET SEQUENCE NUMBER
          RJ     RSP         RESEND PACKET IF WITHIN WINDOW 
          EQ     WCS         WAIT FOR INPUT AND CHANGE STATE
  
*         ILLEGAL PACKET TYPE (IMPOSSIBLE ERROR). 
  
 SDW4     SX6    FPE         FORCE PROTOCOL ERROR 
          EQ     SGS         SET GIVEN STATE
          SPACE  4,10 
**        PROCSEF - SEND END OF FILE. 
* 
*         THIS STATE SENDS AND END OF FILE PACKET.
  
 PROCSEF  MX3    -1          USE NEXT SEQUENCE NUMBER 
          SB5    EOF         (B5) = REQUIRED PACKET TYPE
          SB7    B0          (B7) = DATA LENGTH 
          RJ     BTP         BUILD TRANSMISSION PACKET
          RJ     TGP         TRANSMIT GIVEN PACKET
  
*         IF FILE WAS NOT LOCAL BEFORE TRANSMISSION RETURN IT.
  
          SA1    CNAME       (X1) = CURRENT FILE NAME 
          SA2    F           (X2) = NAME FROM FET 
          BX6    X1-X2       COMPARE
          AX6    18          IGNORE STATUS
          ZR     X6,WCS      MATCH SO FILE WAS LOCAL
          RETURN F,R         GET RID OF LOCAL COPY
          EQ     WCS         WAIT FOR INPUT AND CHANGE STATE
          SPACE  4,10 
**        PROCSET - SEND END OF FILE TIMEOUT. 
* 
*         THIS CODE RESENDS THE 'Z' EOF PACKET. 
  
 PROCSET  SA1    RETIME      (X1) = TIMEOUT RETRY COUNTER 
          SX6    X1-1        DECREMENT
          ZR     X6,SET2     PROTOCOL TIMEOUT 
          SA6    A1+         REPLACE
          RJ     ROU         RESEND OLDEST UNACKED PACKET 
          EQ     WCS         WAIT FOR INPUT AND CHANGE STATE
  
*         PROTOCOL TIMED OUT. 
  
 SET2     SX6    1
          SA6    EMODE       FLAG TIMED OUT 
          SX6    FPE         FORCE PROTOCOL ERROR 
          EQ     SGS         SET GIVEN STATE
          SPACE  4,10 
**        PROCSB - SEND BREAK.
* 
*         THIS CODE SENDS A 'BREAK' PACKET TO INDICATE END OF FILE
*         TRANSMISSION. 
  
 PROCSB   SA1    IQPTR       (X1) = INPUT QUEUE POINTER 
          SA1    X1+PSEQ     (X1) = SEQUENCE NUMBER 
          RJ     PAP         PROCESS ACK PACKET 
          NZ     X6,SB2      ERROR IN ACK 
  
*         SEND BREAK. 
  
          SB7    B0          NO DATA FIELD
          SB5    BREAK       (B5) = REQUIRED PACKET TYPE
          MX3    59          FLAG NEXT SEQUENCE NUMBER
          RJ     BTP         BUILD TRANSMISSION PACKET
          RJ     TGP         TRANSMIT GIVEN PACKET
          EQ     WCS         WAIT FOR INPUT AND CHANGE STATE
  
*         ERROR IN ACK PACKET.
  
 SB2      SX6    ABT         ABORT
          EQ     SGS         SET GIVEN STATE
          SPACE  4,10 
**        PROCRF - RECEIVE FILE.
* 
*         THIS STATE IS ENTERED WHEN A FILE TRANSFER IS EXPECTED
*         INTO THE CYBER. NOTE THAT THIS STATE IS NEVER EXECUTED
*         IT IS USED WHILE WAITING FOR MORE INPUT 
  
 PROCRF   EQ     WCS         WAIT FOR INPUT AND CHANGE STATE
          SPACE  4,10 
**        PROCRFF - RECEIVE FILE (FILE HEADER RECEIVED).
* 
*         THIS STATE IS ENTERED WHEN A FILE HEADER PACKET IS READ WHILE 
*         IN THE 'RECEIVE FILE' STATE.
  
 PROCRFF  SA1    ANAME       (X1) = ALTERNATIVE NAME POINTER
          ZR     X1,RFF2     NO ALTERNATIVE NAME
          SB7    X1          (B7) = LWA + 1 
          MX6    0
          AX1    18 
          SA6    A1          CLEAR POINTER
          SB6    X1          (B6) = FWA OF NAME 
          SB7    B7-B6       (B7) = CHARACTER COUNT 
          EQ     RFF4        GOTO CRACK NAME
  
*         NO ALTERNATIVE SO USE NAME FROM PACKET. 
  
 RFF2     SA1    IQPTR       (X1) = FWA OF PACKET 
          RJ     UDF         UNPACK DATA FIELD
  
*         BUILD NAME (WILD CHARACTERS ILLEGAL). 
  
 RFF4     SB5    B1          FLAG WILD CHARACTERS ILLEGAL 
          RJ     BFN         BUILD FILE NAME
          SA1    WSIZE       (X1) = WINDOW SIZE 
          RJ     IWP         INITIALISE WINDOW POINTER FOR DATA TRANSFER
          SA3    IQPTR       (X3) = FWA OF PACKET 
          SA3    X3+PSEQ     (X3) = SEQUENCE NUMBER 
          SX6    X3 
          SA6    LASTSEQ     PRESET LAST SEQUENCE NUMBER
          LX6    18 
          SA6    WTABLE      PRESET OLDEST WINDOW TABLE ENTRY 
          RJ     AGP         ACK GIVEN PACKET 
          SA1    FNAME       (X1) = FILE NAME 
          SA2    RFF.B       (X2) = DEFAULT FILE NAME 
          BX6    X1 
          BX7    X2 
          SA6    CNAME       SAVE CURRENT NAME
          SA7    F           RESET DEFAULT FILE NAME
          REWIND F,R         REWIND FILE
          WRITE  X2,*        PRESET WRITE FUNCTION
          MX6    0
          SA6    FWORD       CLEAR PACKING WORD 
          SA6    A6+B1       CLEAR PACKING COUNTER
          RJ     RIB         RETURN INPUT BUFFER
          SA1    RFF.A       (X1) = FIRST WORD OF TEXT
          RJ     WLM         WRITE LOG MESSAGE
          SX6    RD          (X6) = RECEIVE DATA STATE CODE 
          EQ     SGS         SET GIVEN STATE
  
 RFF.A    DIS    ,'    RECEIVING - ;A.' 
 RFF.B    VFD    42/0LZZZZZFN,18/3
          SPACE  4,10 
**        PROCRD - RECEIVE DATA.
* 
*         THIS STATE IS USED TO READ DATA FROM THE REMOTE LINK. 
  
 PROCRD   SA1    IQPTR       (X1) = FWA OF INCOMMING PACKET 
          SA2    LASTSEQ     (X2) = LAST SEQUENCE NUMBER
          ZR     X1,WCS      NO INPUT SO WAIT TILL THERE IS 
          SA1    X1+PSEQ     (X1) = PACKET SEQUENCE NUMBER
          SX2    X2+B1       CALCULATE EXPECTED SEQUENCE NUMBER 
          MX7    -6 
          BX2    -X7*X2      ENSURE MODULO 64 
          IX6    X1-X2       CHECK IF REQUIRED VALUE
          ZR     X6,RD4      EXPECTED PACKET SO ACK IT
          SA3    WSIZE       (X3) = WINDOW SIZE 
 +        NZ     X3,*+1      WINDOW SIZE DEFINED
          SX3    1           USE MINIMUM
          SX6    X6+64       ALLOW FOR WRAP AROUND
          BX6    -X7*X6      ENSURE MODULO 64 
          IX7    X3-X6       CHECK IF WITHIN WINDOW 
          NG     X7,RD6      MAY BE DUPLICATE 
  
*         PACKET WITHIN WINDOW SO NAK PRECEEDING PACKETS. 
  
          SA6    RD.A        SAVE NUMBER OF NAKS REQUIRED 
  
*         NAK MISSING PACKETS.
  
 RD2      RJ     NNP         NAK NEXT PACKET
          SA1    RD.A        (X1) = COUNT 
          SX6    X1-1        DECREMENT
          SA6    A1+         REPLACE
          NZ     X6,RD2      LOOP FOR ALL NAKS
  
*         NOW SAVE THE DATA.
  
 RD4      SA1    IQPTR       (X1) = FWA OF PACKET 
          SA2    X1+PSEQ     (X2) = SEQUENCE NUMBER 
          SX6    X1          (X6) = FWA 
          LX2    18          POSITION SEQUENCE NUMBER 
          SA1    RETRY       (X1) = RETRY COUNTER 
          BX6    X2+X6       (X6) = 33/0,9/SEQ,18/FWA 
          LX1    18+9+9 
          BX6    X1+X6       (X6) = 15/0,9/RETRY,9/0,9/SEQ,18/FWA 
          MX1    1
          BX6    X1+X6       FLAG ACKED 
          RJ     SRP         SAVE RECEIVED PACKET 
          SX6    0
          SA6    IQPTR       CLEAR INPUT QUEUE
          SA3    LASTSEQ     (X3) = PACKET SEQUENCE NUMBER
          RJ     AGP         ACK GIVEN PACKET 
          RJ     RIB         RETURN INPUT BUFFER
          EQ     WCS         WAIT FOR INPUT AND CHANGE STATE
  
*         CHECK IF PACKET IS A DUPLICATE. 
  
 RD6      SA3    WPTR        (X3) = WINDOW POINTER
          SB4    X3          (B4) = LIMIT 
          AX3    18 
          SB3    X3          (B3) = OUT 
          AX3    18 
          SB2    X3          (B2) = IN
          MX6    -9 
          EQ     B2,B3,RD12  EMPTY SO IGNORE
  
*         SCAN CURRENT WINDOW.
  
 RD8      SA3    WTABLE+B3   (X3) = NEXT ATTRIBUTE WORD 
          BX7    X3 
          AX7    18 
          BX7    -X6*X7      (X7) = SEQUENCE NUMBER FROM TABLE
          BX7    X1-X7       COMPARE
          ZR     X7,RD10     ENTRY FOUND
 +        SB3    B3+B1       INCREMENT OUT
          NE     B3,B4,*+1   NOT LIMIT
          SB3    B0          SET OUT = FIRST
          NE     B2,B3,RD8   NOT END OF WINDOW
          EQ     RD12        GOTO RETURN BUFFER AND EXIT
  
*         ENTRY FOUND SO SAVE PACKET UNLESS DUPLICATE.
  
 RD10     NG     X3,RD11     DUPLICATE SO ACK AND IGNORE
          SX3    X1+         (X3) = PACKET SEQUENCE NUMBER
          SX6    A1-PSEQ     (X6) = FWA OF PACKET 
          LX1    18 
          BX6    X1+X6       (X6) = 33/0,9/SEQ,18/FWA 
          SA1    RETRY       (X1) = RETRY COUNTER 
          LX1    18+9+9 
          BX6    X1+X6       ADD RETRY COUNTER
          MX1    1
          BX6    X1+X6       ADD ACKED FLAG 
          SA6    A3          UPDATE ATTRIBUTES
          MX6    0
          SA6    IQPTR       CLEAR INPUT POINTER
          RJ     AGP         ACK PACKET 
          EQ     WCS         GOTO WAIT FOR INPUT
  
*         DUPLICATE SO ACK AND IGNORE.
  
 RD11     SX3    X1          (X3) = SEQUENCE NUMBER OF DUPLICATE PACKET 
          RJ     AGP         ACK GIVEN PACKET 
  
*         RETURN BUFFER TO FREE QUEUE.
  
 RD12     RJ     RIB         RETURN INPUT BUFFER
          EQ     WCS         GOTO WAIT FOR INPUT
  
 RD.A     BSS    1           NAK COUNT
          SPACE  4,10 
**        PROCRDT - RECEIVE DATA TIMEOUT. 
* 
*         THIS STATE IS ENTERED WHEN A TIMEOUT OCCURS WHILE WAITING 
*         FOR DATA INPUT. A NAK IS SENT FOR THE NEXT PACKET EXPECTED. 
  
 PROCRDT  SB5    NAK         (B5) = PACKET TYPE 
          SA3    LASTSEQ     (X3) = LAST RECEIVED SEQUENCE NUMBER 
          SB7    B0          NO DATA FIELD
          SX3    X3+B1       INCREMENT SEQUENCE NUMBER
          MX6    -6 
          BX3    -X6*X3      CALCULATE MODULO 64
          RJ     BTP         BUILD TRANSMISSION PACKET
          SA6    RDT.A       SAVE ATTRIBUTE WORD
          BX1    X6          (X1) = ATTRIBUTE WORD
          RJ     TPK         TRANSMIT PACKET
          SA1    RDT.A       (X1) = PACKET ATTRIBUTE WORD 
          SX6    X1+         (X6) = FWA OF PACKET 
          RJ     RBF         RETURN BUFFER TO FREE QUEUE
          SX6    RD          (X6) = REQUIRED STATE
          EQ     SGS         SET GIVEN STATE
  
 RDT.A    BSS    1           PACKET ATTRIBUTE WORD
          SPACE  4,10 
**        PROCRDW - RECEIVE DATA WAIT.
* 
*         THIS STATE IS ENTERED WHEN A TYPE 'Z' PACKET IS 
*         RECEIVED. THE REMAINING DATA PACKETS ARE FLUSHED TO DISC
*         AND THE FILE CLOSED. IF THE DATA PART OF THE 'Z' PACKET 
*         IS 'D' THEN THE FILE IS DISCARDED.
  
 PROCRDW  SA1    IQPTR       (X1) = FWA OF 'Z' PACKET 
          SA1    X1+PLEN     (X1) = PACKET LENGTH 
          SX1    X1-3        CHECK DATA FIELD LENGTH
          ZR     X1,RDW2     NO DATA
  
*         CHECK IF DISCARD REQUIRED.
  
          SA1    A1-PLEN+PDATA         (X1) = FIRST DATA WORD 
          MX6    -8 
          BX6    -X6*X1      (X6) = FIRST DATA BYTE 
          SX6    X6-104B     CHECK FOR 'D'
          NZ     X6,RDW2     NOT 'DISCARD'
  
*         DISCARD FILE. 
  
          REWIND F,R         REWIND FILE
          RETURN X2,R        DISCARD FILE 
          EQ     RDW6        GOTO RESET WINDOW
  
*         DATA REQUIRED SO FLUSH WINDOW.
  
 RDW2     SA2    WPTR        (X2) = WINDOW POINTER
          SB4    X2          (B4) = LIMIT 
          AX2    18 
          SB3    X2          (B3) = OUT 
          AX2    18 
          SB2    X2+         (B2) = IN
          EQ     B2,B3,RDW4  EMPTY
  
*         WRITE OLDEST PACKET.
  
          SA1    WTABLE+B3   (X1) = OLDEST ATTRIBUTE WORD 
 +        SB3    B3+B1       INCREMENT OUT
          NE     B3,B4,*+1   NOT LIMIT
          SB3    B0          SET OUT = FIRST
          SX6    B2          (X6) = IN
          SX2    B3          (X2) = OUT 
          LX6    18 
          BX6    X2+X6       (X6) = 6/0,18/0,18/IN,18/OUT 
          SX2    B4          (X2) = LIMIT 
          LX6    18 
          BX6    X2+X6       (X6) = 6/0,18/IN,18/OUT,18/LIMIT 
          SA6    A2          SAVE POINTER 
          RJ     WDP         WRITE DATA PACKET
          EQ     RDW2        LOOP TILL WINDOW EMPTY 
  
*         FLUSH BUFFER. 
  
 RDW4     RJ     FRB         FLUSH RECEIVE BUFFER 
          RJ     PRF         PROCESS RECEIVED FILE
  
*         RESET WINDOW TO CLOSE.
  
 RDW6     SX1    1           (X1) = CONTROL WINDOW SIZE 
          RJ     IWP         INITIALISE WINDO+ POINTER
  
*         ACK 'Z' PACKET. 
  
          SA3    IQPTR       (X3) = FWA OF PACKET 
          SA3    X3+PSEQ     (X3) = SEQUENCE NUMBER 
          RJ     AGP         ACK GIVEN PACKET 
          RJ     RIB         RETURN INPUT BUFFER
          SX6    RF          (X6) = REQUIRED STATE
          EQ     SGS         SET GIVEN STATE
          SPACE  4,10 
**        PROCRDE - RECEIVE DATA END. 
* 
*         THIS STATE IS ENTERED WHEN A 'BREAK' PACKET IS RECEIVED.
*         RECEIVE MODE IS CLEARED AND THE SERVER COMMAND WAIT ENTERED.
  
 PROCRDE  SA3    IQPTR       (X3) = FWA OF PACKET 
          SA3    X3+PSEQ     (X3) = SEQUENCE NUMBER 
          RJ     AGP         ACK GIVEN PACKET 
          RJ     RIB         RETURN INPUT BUFFER
          EQ     PROCCMP     COMPLETE PROCESSING
          SPACE  4,10 
**        PROCSCG - GENERIC COMMAND.
* 
*         THIS STATE IS ENTERED TO PROCESS A GENERIC COMMAND ENTERED
*         VIA A 'G' PACKET. 
  
 PROCSCG  SA1    IQPTR       (X1) = FWA OF PACKET 
          SA1    X1+PLEN     (X1) = PACKET LENGTH 
          SB7    X1-3        CALCULATE DATA LENGTH
          LE     B7,B0,SCG4  INVALID OR MISSING SO NAK
          SA1    A1-PLEN+PDATA         (X1) = FIRST SOURCE WORD 
          MX6    -8 
          BX6    -X6*X1      (X6) = FIRST DATA BYTE 
  
*         SEARCH VALIDATION TABLE.
  
          SA2    SCG.A       (X2) = FIRST TABLE ENTRY 
  
 SCG2     SX1    X2          (X1) = CHARACTER FROM TABLE
          AX2    18 
          BX1    X1-X6       COMPARE WITH DATA
          SB7    X2          (B7) = PROCESS ADDRESS 
 +        NZ     X1,*+1      NO MATCH 
          JP     B7+         PRROCESS 
          SA2    A2+1        (X2) = NEXT TABLE ENTRY
          NZ     X2,SCG2     LOOP TILL FOUND OR END OF TABLE
  
*         COMMAND NOT RECOGNISED. 
  
 SCG4     SA3    A1-PDATA+PSEQ (X3) = SEQUENCE NUMBER 
          RJ     NGP         NAK GIVEN PACKET 
          SX6    SCW         (X6) = SERVER COMMAND WAIT 
          EQ     SGS         SET GIVEN STATE
  
*         COMMAND - F  (FINISH).
  
 SCG6     SA3    A1-PDATA+PSEQ (X3) = SEQUENCE NUMBER 
          RJ     AGP         ACK GIVEN PACKET 
          SX6    3           FLAG TERMINATION MODE
          SA6    TMODE       SAVE 
          EQ     PROCCMP     COMPLETE PROCESSING
  
*         COMMAND - L  (LOGOUT).
  
 SCG8     SA3    A1-PDATA+PSEQ (X3) = SEQUENCE NUMBER 
          RJ     AGP         ACK GIVEN PACKET 
          MX6    1
          LX6    50-59       (X) = '0004' LOGOUT BYTE 
          WRITEO O           WRITE TO TERMINAL
          WRITER X2 
          ABORT 
  
*         COMMAND - T (TYPE). 
  
 SCG10    SA1    IQPTR       (X1) = FWA OF PACKET 
          RJ     UDF         UNPACK DATA FIELD
*         LE     B7,B1,SCG?? ILLEGAL FILE SPECIFICATION 
          SA1    B6          (X1) = NAME LENGTH 
          SB6    B6+B1       INCREMENT
          SB5    B1          FLAG WILD CHARACTERS ILLEGAL 
          SB7    X1          (B7) = CHARACTER COUNT 
          RJ     BFN         BUILD FILE NAME
          SX6    -1 
          SA6    FIRSTF      CLEAR FIRST FILE FLAG
          SX6    1
          SA6    TTYPE       SET TRANSFER TYPE
          SX6    SI          SEND INIT
          EQ     SGS         SET GIVEN STATE
  
 SCG.A    BSS    0           COMMAND VALIDATION TABLE 
          VFD    6/0,18/0,18/SCG6,18/106B  'F' - FINISH 
          VFD    6/0,18/0,18/SCG8,18/114B  'L' - LOGOUT 
          VFD    6/0,18/0,18/SCG10,18/124B 'T' - TYPE 
          CON    0
          SPACE  4,10 
**        PROCESS DUPLICATE (SUPERFLUOUS) PACKET. 
* 
*         THIS ROUTINE ACKS THE CURRENT PACKET PROVIDING THAT THE SEQUEN
*         NUMBER IS THAT OF THE PRECEEDING PACKET. THIS IS USED, FOR EXM
*         WHEN THE ACK TO A 'F' PACKET HAS BEEN LOST AND A DUPLICATE SEN
  
 PROCADP  SA3    IQPTR       (X3) = FWA OF PACKET 
          SX6    X3+
          RJ     RBF         RETURN BUFFER TO FREE QUEUE
          SA1    X3+PSEQ     (X1) = PACKET SEQUENCE NUMBER
          SA3    LASTSEQ     (X3) = PREVIOUS SEQUENCE NUMBER
          BX6    X1-X3       COMPARE
          SX1    77B
          BX6    X1*X6       IGNORE ANY FLAG BITS 
          NZ     X6,ADP2     NO MATCH SO ERROR
          RJ     AGP         ACK GIVEN PACKET 
          EQ     WCS         GOTO WAIT FOR INPUT
  
*         PROTOCOL ERROR AS OT OF SEQUENCE. 
  
 ADP2     SX1    FPE         FORCE PROTOCOL ERROR 
          EQ     CPS         CHANGE PROTOCOL STATE
          SPACE  4,10 
**        PROCESS ERROR PACKET. 
* 
*         THIS STATE IS ENTERD WHEN AN ERROR PACKET IS RECEIVED 
*         FROM THE REMOTE KERMIT. THE MESSAGE IS WRITTEN TO THE LOG 
*         FILE AND KERMIT ABORTED OR RETURNED TO SERVER WAIT STATE. 
  
 PROCERR  SB6    ERR.A       (B6) = FWA OF MESSAGE
          RJ     WLT         WRITE LOG TEXT 
          SA1    IQPTR       (X1) = FWA OF PACKET 
          RJ     UDF         UNPACK DATA FIELD
          LE     B7,B0,PROCABT MISSING OR ILLEGAL DATA FIELD
          SB2    10-1        RESET PACKING COUNTER
          SX6    1R 
          SA6    ERR.B       PRESET DESTINATION ADDRESS 
          MX0    -6          (X0) = CHARACTER MASK
          SB3    A2C         (B3) = FWA OF ASCII TO DISPLAY CODE CONVERS
          SB7    B6+B7       (B7) = LWA + 1 OF ASCII STRING 
  
*         PROCESS NEXT CHARACTER. 
  
 ERR2     SA1    B6          (X1) = NEXT ASCII CHARACTER
          LX6    6
          SB2    B2-B1       DECREMENT PACKING COUNTER
          SA1    X1+B3       CONVERT TO DISPLAY CODE
          SX1    X1          (X1) = 6/12 CODE 
          SB6    B6+1        INCREMENT SOURCE ADDRESS 
          BX2    -X0*X1      (X2) = SECOND BYTE (IF 2)
          AX1    6           (X1) = FIRST BYTE
          ZR     X1,ERR6     ONLY 6 BIT CHARACTER 
  
          BX6    X1+X6       ADD FIRST 6 BITS 
          NZ     B2,ERR4     PACKING WORD FULL
          SA6    A6+B1       SAVE FULL WORD 
          BX6    X2          (X6) = SECOND BYTE 
          SB2    10-1        RESET PACKING COUNTER
          EQ     ERR8        GOTO CHECK FOR MORE DATA 
  
 ERR4     LX6    6           MAKE ROOM
          SB2    B2-1        DECREMENT PACKING COUNTER
  
 ERR6     BX6    X2+X6       ADD 6 BIT CODE TO PACKING WORD 
          NZ     B2,ERR8     PACKING WORD NOT FULL
          SA6    A6+B1       SAVE FULL WORD 
          SB2    10          RESET PACKING COUNTER
          SX6    0           RESET PACKING WORD 
  
 ERR8     LT     B6,B7,ERR2  LOOP TILL END OF DATA
  
*         END OF DATA SO FORCE EOL. 
  
          SX1    B2          (X1) = REMAINING CHARACTER COUNT 
          LX1    59-0        CHECK IF ODD 
          PL     X1,ERR10    EVEN SO NO TRAILING BLANK REQUIRED 
          SX2    1R 
          LX6    6
          SX1    X1+         (X1) = REMAINING 12 BIT BYTE COUNT 
          BX6    X2+X6       BLANK FILL 
          NZ     X1,ERR10    PACKING WORD NOT FULL
          SA6    A6+B1       SAVE FULL WORD 
          MX6    0           CLEAR
  
 ERR10    LX1    2           * 4
          LX2    X1,B1       * 8
          IX1    X1+X2       (X1) = REMAINING BIT COUNT 
          SB2    X1 
          LX6    B2          FORCE EOL
          SB6    ERR.B+1     (B6) = FWA OF MESSAGE
          SA6    A6+B1       SAVE LAST DATA WORD + EOL
          RJ     WLT         WRITE LOG TEXT 
          EQ     PROCABT     GOTO ABORT PROCESSING
  
 ERR.A    DIS    ,' REMOTE KERMIT REQUESTED AN ABORT.'
 ERR.B    BSS    21          MESSAGE BUFFER 
          SPACE  4,10 
**        PROCABT - ABORT PROCESS.
* 
*         THIS ROUTINE RESETS ANYTHING WHICH REQUIRES RESETTING 
*         AND RETURNS TO THE SERVER COMMAND WAIT STATE. 
  
 PROCABT  SX6    SCW         (X6) = SERVER COMMAND WAIT 
          SA1    TMODE       (X1) = TRANSFER MODE 
          ZR     X1,SGS      SERVER SO GO INTO WAIT STATE 
          RJ     CTI         CLEAR TERMINAL INTERFACE 
          RJ     DBE         CLOSE DEBUG FILE (IF ON) 
          SA1    ABT.A       (X1) = FIRST WORD OF LOG MESSAGE 
          RJ     WLM         WRITE LOG MESSAGE
          RJ     CLF         CLOSE LOG FILE 
          MESSAGE ABT.A,3,R 
          ENDRUN
  
 ABT.A    DIS    ,'KERMIT ABORTED.' 
          SPACE  4,10 
**        PROCCMP - COMPLETE PROCESSING.
* 
*         THIS TASK IS ENETERED WHEN A FILE TRANSFER HAS BEEN COMPLETED.
*         IF IN SERVER MODE THEN THE WAIT STATE IS ENTERED, OTHERWISE 
*         THE PROGRAM IS TERMINATED.
  
 PROCCMP  SX6    SCW         ASSUME SERVER
          SA1    TMODE       (X1) = TRANSFER MODE 
          ZR     X1,SGS      SERVER SO ENTER WAIT STATE 
  
*         NOT SERVER SO CLOSE DOWN. 
  
          RJ     DBE         CLOSE DEBUG FILE (IF ON) 
          SA1    CMP.A       (X1) = FIRST WORD OF LOG MESSAGE 
          RJ     WLM         WRITE LOG MESSAGE
          RJ     CLF         CLOSE LOG FILE 
          RJ     CTI         CLOSE TERMINAL INTERFACE 
          MESSAGE CMP.A,3,R 
          ENDRUN
  
 CMP.A    DIS    ,'KERMIT COMPLETE.'
          TITLE  WINDOW PROCESSING ROUTINES.
**        WINDOW PROCESSING ROUTINES. 
* 
*         THE FOLLOWING ROUTINES ARE USED TO ALLOCATE AND MANAGE
*         PACKET FLOW TAKING INTO ACCOUNT THE WINDOW SIZE.
* 
*         CWO - CHECK WINDOW IS OPEN
*         IWP - INITIALISE WINDOW POINTER 
*         PAP - PROCESS ACK PACKET
*         ROU - RE-TRANSMIT OLDEST UNACKED PACKET 
*         RSP - RESEND PACKET 
*         SRP - SAVE RECEIVED PACKET
*         UWP - UPDATE WINDOW POINTER 
          SPACE  4,10 
**        WINDOW TABLE STRUCTURE. 
* 
*         THE WINDOW TABLE CONTAINS ONE WORD PER ENTRY AS FOLLOWS:- 
* 
*T  1/A,5/0,9/LEN,9/RETRY,9/TIMER,9/SEQ,18/ADR
* 
*         WHERE:- 
*                     A = SET IF PACKET ACKED 
*                   LEN = LENGTH OF DATA PART IN WORDS
*                 RETRY = RETRY COUNTER 
*                 TIMER = TIMEOUT COUNTER (IF USED) 
*                   SEQ = PACKET SEQUENCE NUMBER
*                   ADR = ADDRESS OF PACKET 
* 
*         THE TABLE IS TREATED AS A CIRCULAR BUFFER ADDRESSED 
*         BY THE WINDOW POINTER WITH THE FORMAT:- 
* 
*T  1/0,5/N,18/IN,18/OUT,18/LIMIT 
* 
*         WHERE:- 
*                     N = AVAILABLE WINDOW (0 IF WINDOW CLOSED) 
*                    IN = OFFSET TO NEXT SPACE IN TABLE 
*                   OUT = OFFSET TO LAST USED TABLE WORD
*                 LIMIT = TABLE LENGTH
* 
*         WHEN SENDING THE WINDOW IS USED AS FOLLOWS:-
* 
*         AS EACH PACKET IS TRANSMITTED THE AVAILABLE WINDOW IS 
*         DECREMENTED. WHEN IT BECOMES ZERO THEN THE WINDOW IS CLOSED 
*         AND CANNOT BE OPENED UNTIL THE OLDEST PACKET WITHIN THE 
*         WINDOW IS ACKED. WHEN ACKED THE 'A' FLAG IS SET AND, IF 
*         THIS PACKET IS THE OLDEST IN THE TABLE THE TABLE ENTRY IS 
*         DISCARDED AND THE AVAILABLE WINDOW INCREMENTED. 
* 
*         WHEN RECEIVING THE WINDOW IS USED AS FOLLOWS:-
* 
*         AS EACH DATA PACKET IS RECEIVED THE WINDOW TABLE IS CHECKED 
*         IF IT IS FULL THE PACKET ASSOCIATED WITH THE OLDEST TABLE 
*         ENTRY IS WRITTEN TO DISK PROVIDED THAT THE ATTRIBUTES 
*         INDICATE THE PACKET HAS BEEN ACKED. IF IT HAS NOT BEEN
*         ACKED A PROTOCOL ERROR RESULTS. THE REMAINING ACTION
*         DEPENDS ON THE SEQUENCE NUMBER OF THE RECIEVED PACKET:- 
* 
*         1) IF THE RECEIVED SEQUENCE NUMBER IS THE ONE EXPECTED
*            (I.E. THE NEXT ONE) THEN THE PACKET IS ACKED AND THE 
*            PACKET ATTRIBUTE WORD SAVED IN THE WINDOW TABLE. 
*         2) IF THE RECIEVED SEQUENCE NUMBER IS BETWEEN THE EXPECTED
*            AND THE EXPECTED PLUS THE WINDOW SIZE THEN A 'NAK' IS
*            TRANSMITTED FOR EACH MISSING SEQUENCE NUMBER. FOR EACH 
*            NAK AN ENTRY IS MADE IN THE WINDOW TABLE. IF FULL THE
*            OLDEST ENTRY IS WRITTEN TO DISK PROVIDED IT HAS BEEN 
*            ACKED. THE RECEIVED PACKET IS THEN ACKED AND AN ENTRY
*            MADE IN THE WINDOW TABLE.
*         3) IF THE RECEIVED SEQUENCE NUMBER MATCHES AN ENTRY ALREADY 
*            IN THE WINDOW TABLE THEN THE PACKET IS ACKED. THE TABLE
*            ENTRY IS UPDATED IF IT PREVIOUSLY HAD A 'NAK' ATTRIBUTE. 
*         4) IF THE SEQUENCE NUMBER DOES NOT MATCH ANY OF THE ABOVE 
*            CASES THEN THE RECEIVED PACKET IS IGNORED. 
          SPACE  4,10 
**        CWO - CHECK WINDOW IS OPEN. 
* 
*         THIS ROUTINE RETURNS THE AVAILABLE WINDOW SIZE. IF ZERO 
*         THE WINDOW IS CLOSED. 
* 
*         ENTRY  NONE.
* 
*         EXIT   (X1) = AVAILABLE WINDOW
* 
*         USES   X - 1. 
*                A - 1. 
*                B - NONE.
* 
*         CALLS  NONE.
          SPACE  4,10 
CWO       SUBR               ENTRY/EXIT 
          SA1    WPTR        (X1) = WINDOW POINTER
          AX1    18+18+18    RIGHT JUSTIFY AVAILABLE WINDOW 
          EQ     CWOX        EXIT 
          SPACE  4,10 
**        IWP - INITIALISE WINDOW POINTER.
* 
*         THIS ROUTINE INITIALISES THE WINDOW POINTER AND MUST
*         BE CALLED BEFORE ANY PACKET I/O IS ATTEMPTED. 
* 
*         ENTRY  (B1) = 1 
*                (X1) = REQUIRED WINDOW SIZE
* 
*         EXIT   WINDOW POINTER INITIALISED 
* 
*         USES   X - 1, 6.
*                A - 6. 
*                B - NONE.
* 
*         CALLS  NONE.
          SPACE  4,10 
 IWP      SUBR               ENTRY/EXIT 
  
          MX6    -5 
          BX6    -X6*X1      ENSURE ONLY 5 BIT WINDOW 
          SX1    WTABL       (X1) = WINDOW TABLE LENGTH 
 +        NZ     X6,*+1      WINDOW VALID 
          SX6    1           FORCE NO WINDOWING 
          LX6    18+18+18    SET IN = OUT = FIRST (=0)
          BX6    X1+X6       ADD LIMIT
          SA6    WPTR        SAVE WINDOW POINTER
          EQ     IWPX        EXIT 
          SPACE  4,10 
**        ROU - RE-TRANSMIT OLDEST UNACKED PACKET.
* 
*         THIS ROUTINE SCANS THE WINDOW TABLE FOR THE OLDEST PACKET 
*         WHICH HAS NOT YET BEEN ACKED. THIS PACKET IS THEN RESENT. 
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   OLDEST PACKET RESENT 
* 
*         USES   X - 1. 
*                A - 1. 
*                B - 2, 3, 4. 
* 
*         CALLS  TPK. 
          SPACE  4,10 
 ROU      SUBR               ENTRY/EXIT 
  
*         INITIALISE POINTER. 
  
          SA1    WPTR        (X1) = WINDOW POINTER
          SB4    X1          (B4) = LIMIT 
          AX1    18 
          SB3    X1          (B3) = OUT 
          AX1    18 
          SB2    X1+         (B2) = IN
  
*         SEARCH FROM 'OUT' TO 'IN-1' FOR UN-ACKED PACKET.
  
 ROU2     SA1    WTABLE+B3   (X1) = NEXT ENTRY
          PL     X1,ROU4     THIS IS THE OLDEST 
 +        SB3    B3+B1       INCREMENT OUT
          NE     B3,B4,*+1   NOT LIMIT
          SB3    B0          SET OUT = FIRST
          NE     B2,B3,ROU2  LOOP TILL END OF TABLE 
  
*         NO UNACKED PACKET SO PROBLEM. 
  
          EQ     ROUX        IGNORE 
  
*         PACKET FOUND SO RESEND. 
  
 ROU4     AX1    18 
          SX6    777B 
          BX1    X1*X6       (X1) = SEQUENCE NUMBER OF PACKET TO RESEND 
          RJ     RSP         RESEND PACKET
          EQ     ROUX        EXIT 
          SPACE  4,10 
**        RSP - RESEND PACKET.
* 
*         THIS ROUTINE RESEND THE PACKET WITH THE SPECIFIED 
*         SEQUENCE NUMBER. IF THE PACKET RETRY COUNT IS 
*         EXCEEDED THE ABORT STATE IS ENTERED.
* 
*         ENTRY  (B1) = 1 
*                (X1) = SEQUENCE NUMBER OF PACKET TO RESEND 
* 
*         EXIT   (X6) = 0 IF PACKET FOUND AND PROCESSED 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 6.
*                B - 2, 3, 4, 5, 6, 7.
* 
*         CALLS  BTP, TPK.
          SPACE  4,10 
 RSP      SUBR               ENTRY/EXIT 
  
*         INITIALISE POINTER. 
          BX6    X1          (X6) = REQUIRED SEQUENCE NUMBER
          SA1    WPTR        (X1) = WINDOW POINTER
          SB4    X1          (B4) = LIMIT 
          AX1    18 
          SB3    X1          (B3) = OUT 
          AX1    18 
          SB2    X1          (B2) = IN
          SX7    777B        (X7) = SEQUENCE NUMBER MASK
          SB7    18 
  
*         SEARCH WINDOW TABLE FOR REQUIRED SEQUENCE NUMBER. 
  
 RSP2     SA1    WTABLE+B3   (X1)  NEXT TABLE ENTRY 
          AX2    X1,B7       RIGHT JUSTIFY SEQUENCE NUMBER
          BX2    X2*X7       (X2) = SEQUENCE NUMBER 
          BX2    X2-X6       COMPARE
          ZR     X2,RSP4     REQUIRED ENTRY FOUND 
          SB3    B3+B1       INCREMENT OUT
 +        LT     B3,B4,*+1   NOT LIMIT
          SB3    0           SET OUT = FIRST
          NE     B2,B3,RSP2  LOOP TILL FOUND OR END OF WINDOW 
          SX6    -1          FLAG NOT FOUND 
          EQ     RSPX        NOT FOUND SO IGNORE
  
*         PACKET FOUND SO DECREMENT RETRY COUNT.
  
 RSP4     LX1    60-18-9-9   RIGHT JUSTIFY RETRY COUNT
          BX2    X1*X7       (X2) = RETRY COUNT 
          SX2    X2-1        DECREMENT
          ZR     X2,RSP6     RETRY COUNT EXPIRED
          BX1    -X7*X1      CLEAR PREVIOUS RETRY COUNT 
          BX1    X1+X2       ADD NEW VALUE
          LX1    18+9+9      RESTORE ATTRIBUTE WORD POSITION
          BX6    X1 
          SA6    A1+         UPDATE WINDOW TABLE ENTRY
          RJ     TPK         TRANSMIT PACKET
          MX6    0           FLAG PACKET FOUND AND PROCESSED
          EQ     RSPX        EXIT 
  
*         PACKET RETRY COUNT EXPIRED SO ABORT.
  
 RSP6     SX6    2           (X6) = EXIT MODE CODE
          SA6    EMODE       SAVE 
          SX6    FPE         FORCE PROTOCOL ERROR 
          EQ     SGS         SET GIVEN STATE
          SPACE  4,10 
**        PAP - PROCESS ACK PACKET. 
* 
*         THIS ROUTINE SEARCHES THE WINDOW FOR THE PACKET WITH
*         THE SAME SEQUENCE NUMBER AS SPECIFIED. IF FOUND THEN
*         THE PACKET IS FLAGGED AS ACKED AND, IF THE OLDEST, THE
*         WINDOW POINTER IS UPDATED.
* 
*         ENTRY  (B1) = 1 
*                (X1) = SEQUENCE NUMBER TO ACK
* 
*         EXIT   (X6) = 0 IF ACK PROCESSED O.K. 
* 
*         USES   X - 2, 3, 6, 7.
*                A - 2, 3, 6. 
*                B - 2, 3, 4, 6.
* 
*         CALLS  RBF. 
          SPACE  4,10 
 PAP      SUBR               ENTRY/EXIT 
  
*         INITIALISE POINTERS.
  
          SB7    18 
          SA2    WPTR        (X2) = WINDOW POINTER
          SB4    X2          (B4) = LIMIT 
          AX2    18 
          SB3    X2          (B3) = OUT 
          MX7    -9 
          AX2    18 
          SB2    X2          (B2) = IN
          AX2    18          (X2) = AVAILABLE WINDOW
          SB6    B3          (B6) = OUT'
  
*         SEARCH TABLE FOR ENTRY WITH SAME SEQUENCE NUMBER. 
  
 PAP2     SA3    WTABLE+B6   (X3) = NEXT TABLE ENTRY
          AX6    X3,B7
          BX6    -X7*X6      (X6) = SEQUENCE NUMBER FROM TABLE
          BX6    X1-X6       COMPARE
          ZR     X6,PAP4     ENTRY FOUND
 +        SB6    B6+B1       INCREMENT OUT' 
          NE     B4,B6,*+1   NOT LIMIT
          SB6    B0          SET OUT' = FIRST 
          NE     B2,B6,PAP2  LOOP TILL END OF TABLE 
  
*         PACKET WITH SAME SEQUENCE NUMBER NOT FOUND. 
  
          SX6    -1          FLAG NOT FOUND 
          EQ     PAPX        EXIT 
  
*         PACKET FOUND SO MARK ACKED. 
  
 PAP4     MX6    1
          BX6    X3+X6       FLAG ACKED 
          SA6    A3          REPLACE
          MX6    0           FLAG COMPLETED 
          NZ     X2,PAPX     WINDOW IS NOT CLOSED SO EXIT 
  
*         WINDOW CLOSED SO CHECK OLDEST ENTRY.
  
          SA3    WTABLE+B3   (X3) = OLDEST ENTRY
          PL     X3,PAP6     NOT ACKED SO CHECK FOR SPECIAL 
  
*         DELETE OLDEST ENTRY TO OPEN WINDOW. 
  
          SX2    X2+B1       INCREMENT AVAILABLE WINDOW 
          SB3    B3+B1       INCREMENT OUT
 +        LX2    18 
          NE     B3,B4,*+1   NOT LIMIT
          SB3    B0          SET OUT = FIRST
          SX6    B2          (X6) = IN
          BX6    X2+X6       ADD AVAILABLE WINDOW 
          SX2    B3          (X2) = OUT 
          LX6    18 
          BX6    X2+X6       ADD TO POINTER 
          SX2    B4          (X2) = LIMIT 
          LX6    18 
          BX6    X2+X6       ADD TO POINTER 
          SA6    A2          UPDATE WINDOW POINTER
          SX6    X3          (X6) = FWA OF BUFFER TO BE RETURNED
          RJ     RBF         RETURN BUFFER TO FREE QUEUE
          MX6    0           FLAG COMPLETED 
          EQ     PAPX        EXIT 
  
*         WINDOW CLOSED AND LAST PACKET NOT ACKED SO CHECK IF 
*         REMOTE END IS NOT WINDOWING.
  
 PAP6     SA2    WSIZE       (X2) = WINDOW SIZE 
          NZ     X2,PAPX     WINDOWING ACTIVE SO EXIT 
  
*         REMOTE END NOT WINDOWING SO ACK IF NEXT PACKET IS ACKED.
  
 +        SB3    B3+B1       INCREMENT OUT
          NE     B3,B4,*+1   NOT LIMIT
          SB3    B0          SET OUT = FIRST
          EQ     B2,B3,PAPX  WINDOW EMPTY 
          SA2    WTABLE+B3   (X2) = NEXT TABLE ENTRY
          PL     X2,PAPX     NOT ACKED SO WAIT
          SX6    X3          (X6) = BUFFER ADDRESS OF PREVIOUS PACKET 
          SX2    B1          FLAG WINDOW AVAILABLE
          RJ     RBF         RETURN BUFFER TO FREE QUEUE
  
*         UPDATE WINDOW POINTER.
  
          SX6    B2          (X6) = IN
          LX2    18 
          BX6    X2+X6       (X6) = AVAILABLE WINDOW (1) + IN 
          SX2    B3          (X2) = OUT 
          LX6    18 
          BX6    X2+X6       ADD
          SX2    B4          (X2) = LIMIT 
          LX6    18 
          BX6    X2+X6       (X6) = POINTER WORD
          SA6    WPTR        SAVE 
          MX6    0           FLAG COMPLETED 
          EQ     PAPX        EXIT 
          SPACE  4,10 
**        SRP - SAVE RECEIVED PACKET. 
* 
*         THIS ROUTINE SAVES THE GIVEN ATTRIBUTE WORD IN THE
*         WINDOW TABLE. THE ATTRIBUTE WORD IS ASSUMED TO BE 
*         THAT OF A RECEIVED PACKET ALTHOUGH THIS ROUTINE IS
*         IS ALSO CALLED FOR INTERNALLY GENERATED NAKS. THE 
*         ATTRIBUTE WORD IS SAVED. IF THE WINDOW WAS CLOSED 
*         ON ENTRY THEN THE OLDEST PACKET IS WRITTEN TO DISC
*         UNLESS IT IS NOT ACKED. IN THE LATTER CASE A PROTOCOL 
*         ERROR OCCURS. 
* 
*         ENTRY  (B1) = 1 
*                (X6) = REQUIRED ATTRIBUTE WORD 
* 
*         EXIT   ATTRIBUTE WORD SAVE IN WINDOW
*                OLDEST PACKET WRITTEN TO DISC IF REQUIRED
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6. 
*                B - 2, 3, 4. 
* 
*         CALLS  WDP. 
          SPACE  4,10 
 SRP      SUBR               ENTRY/EXIT 
  
*         UNPACK WINDOW POINTER.
  
          SA2    WPTR        (X2) = WINDOW POINTER
          SB4    X2          (B4) = LIMIT 
          AX2    18 
          SB3    X2          (B3) = OUT 
          AX2    18 
          SB2    X2          (B2) = IN
          AX2    18          (X2) = AVAILABLE WINDOW
          SX1    0           ASSUME WINDOW IS OPEN
          NZ     X2,SRP2     ASSUMPTION CORRECT 
  
*         WINDOW CLOSED SO GET OLDEST ATTRIBUTE FOR LATER.
  
          SA1    WTABLE+B3   (X1) = OLDEST ATTRIBUTE WORD 
          SX2    1           OPEN WINDOW
          SB3    B3+B1       INCREMENT OUT
          NE     B3,B4,SRP2  NO WRAP AROUND 
          SB3    B0          SET OUT = FIRST
  
*         SAVE NEW ATTRIBUTES.
  
 SRP2     SX2    X2-1        DECREMENT AVAILABLE WINDOW 
          SA6    WTABLE+B2   SAVE ATTRIBUTES
 +        SB2    B2+B1       INCREMENT IN 
          NE     B2,B4,*+1   NO WRAP AROUND 
          SB2    B0          SET IN = FIRST 
  
*         UPDATE LAST SEQUENCE NUMBER 
  
          SX7    777B 
          AX6    18 
          BX6    X6*X7       (X6) = SEQUENCE NUMBER 
          SA6    LASTSEQ     SAVE 
  
*         SAVE UPDATED POINTER WORD.
  
          SX6    B2          (X6) = IN
          LX2    18 
          BX6    X2+X6       ADD TO AVAILABLE WINDOW
          SX2    B3          (X2) = OUT 
          LX6    18 
          BX6    X2+X6       ADD
          SX2    B4          (X2) = LIMIT 
          LX6    18 
          BX6    X2+X6       ADD
          SA6    A2          UPDATE POINTER WORD
  
*         PROCESS PREVIOUS ATTRIBUTE WORD.
  
          ZR     X1,SRPX     NO ATTRIBUTES TO PROCESS 
          PL     X1,SRP4     PACKET NOT ACKED SO PROTOCOL ERROR 
          RJ     WDP         WRITE DATA PACKET
          EQ     SRPX        EXIT 
  
*         PROTOCOL ERROR. 
  
 SRP4     SX6    FPE         FORCE PROTOCOL ERROR 
          EQ     SGS         SET GIVEN STATE
          SPACE  4,10 
**        UWP - UPDATE WINDOW POIINTER. 
* 
*         THIS ROUTIINE IS CALLED AT THE END OF DATA TRANSFER TO
*         UPDATE THE WINDOW POINTER THUS DELETING FROM THE WINDOW 
*         ALL ACKED PACKETS. THIS IS REQUIRED SO THAT THE WINDOW SIZE 
*         CAN BE RESET TO 1 TO TERMINATE THE TRANSFER.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   (X6) = AVAILABLE WINDOW
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 2, 3, 4. 
* 
*         CALLS  NONE.
          SPACE  4,10 
 UWP      SUBR               ENTRY/EXIT 
  
*         UNPACK POINTER WORD.
  
          SA1    WPTR        (X1) = WINDOW POINTER
          SB4    X1          (B4) = LIMIT 
          AX1    18 
          SB3    X1+         (B3) = OUT 
          AX1    18 
          SB2    X1          (B2) = IN
          AX1    18          (X1) = AVAILABLE WINDOW
          BX6    X1 
          EQ     B2,B3,UWP   EMPTY SO EXIT
  
*         SEARCH TABLE FOR ACKED PACKETS. 
  
 UWP2     SA1    WTABLE+B3   (X1) = NEXT TABLE ENTRY
          PL     X1,UWP4     NOT YET ACKED
          SX6    X6+1        INCREMENT AVAILABLE WINDOW 
          SB3    B3+1        INCREMENT OUT
 +        NE     B3,B4,*+1   NOT LIMIT
          SB3    0           RESET OUT = FIRST
          NE     B2,B3,UWP2  LOOP TILL END OF WINDOW
  
*         END OF WINDOW OR UNACKED PACKED SO UPDATE POINTER.
  
 UWP4     SX1    B2 
          LX6    18 
          BX6    X1+X6       (X) = AVAILABLE WINDOW + IN
          SX1    B3 
          LX6    18 
          BX6    X1+X6       ADD OUT
          SX1    B4 
          LX6    18 
          BX6    X1+X6       ADD LIMIT
          SA6    WPTR        UPDATE POINTER 
          AX6    18+18+18    (X6) = AVAILABLE WINDOW
          EQ     UWPX        EXIT 
          TITLE  INPUT/OUTPUT ROUTINES. 
**        INPUT/OUTPUT ROUTINES.
* 
*         THE FOLLOWING ROUTINES ARE USED FOR CHARACTER CONVERSIONS 
*         AND SIMILAR INPUT/OUTPUT CONVERSIONS. THE DATA FILE FET 
*         MUST BE AT LEAST 8 WORDS LONG. WORD 'FFORM' IS USED TO HOLD 
*         THE REQUIRED FILE FORMAT AS FOLLOWS:- 
*                     0 = 6 BIT DISPLAY CODE (DIS64)
*                     1 = 6/12 DISPLAY CODE (ASCII) 
*                     2 = 8 IN 12 ASCII (ASCII8)
*         WORD 'FWORD' IS USED TO HOLD THE CURRENT WORD BEING PACKED
*         OR UNPACKED.
* 
*         BPW - BUILD PREFIX WORD 
*         GNC - GET NEXT CHARACTER
*         ROC - READ ONE CHARACTER
*         WAC - WRITE ASCII CHARACTER 
*         WOC - WRITE ONE CHARACTER 
          SPACE  4,10 
**        BPW - BUILD PREFIX WORD.
* 
*         THIS ROUTINE COMBINES THE THREE PREFIX CODES AND SAVES
*         THE COMBINATION IN 'PWORD' IN THE FORM- 
* 
*T        2/0,18/-REPT,2/0,18/-QBIN,2/0,18/QCTL 
* 
*         WHERE REPT = REPEAT PREFIX
*               QBIN = 8 BIT PREFIX 
*               QCTL = CONTROL PREFIX 
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   'PWORD' DEFINED
* 
*         USES   X - 1, 6, 7. 
*                A - 11, 6. 
*                B - NONE.
* 
*         CALLS  NONE 
          SPACE  4,10 
 BPW      SUBR               ENTRY/EXIT 
  
*         BUILD TX PREFIX WORD. 
  
          SX6    0           CLEAR RESULT 
          SA1    BPW.A       (X1) = LIST OF PREFIX ADDRESSES
          RJ     BPW2        CONVERT
          SA6    TXPWORD     SAVE 
  
*         BUILD RX PREFIX WORD. 
  
          SX6    0           CLEAR RESULT 
          SA1    BPW.B       (X1) = LIST OF PREFIX ADDRESSES
          RJ     BPW2        CONVERT
          SA6    RXPWORD     SAVE 
          EQ     BPWX        EXIT 
  
*         BUILD RESULT FROM ADDRESS LIST. 
  
 BPW2     PS
  
 BPW4     SA2    X1          (X2) = NEXT PREFIX CHARACTER 
          MX7    -8 
          AX1    18 
          BX2    -X7*X2      ENSURE 8 BITS
 +        BX2    -X2         COMPLEMENT 
          NZ     X2,*+1      DEFINED
          SX2    B1          FORCE ILLEGAL VALUE
          LX6    20 
          MX7    -18
          BX2    -X7*X2      TRUNCATE TO 18 BITS
          BX6    X2+X6       ADD TO RESULT
          NZ     X1,BPW4     LOOP FOR ALL PREFIX ADDRESSES
          EQ     BPW2        EXIT 
  
 BPW.A    VFD    6/0,18/REPT,18/QBIN,18/TXQCTL
 BPW.B    VFD    6/0,18/REPT,18/QBIN,18/RXQCTL
          SPACE  4,10 
**        GNC - GET NEXT CHARACTER. 
* 
*         THIS ROUTINE RETURNS THE NEXT CHARACTER FROM THE SOURCE 
*         FILE. THE CHARACTER IS RETURNED WITH REQUIRED PREFIX CODES
*         PACKED INTO ONE REGISTER WITH THE FIRST CODE RIGHT JUSTIFIED. 
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   (X6) = ASCII CODE
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 6, 7. 
*                B - NONE.
* 
*         CALLS  ROC. 
          SPACE  4,10 
 GNC      SUBR               ENTRY/EXIT 
  
          SA1    GNC.A       CHECK IF PENDING L/F 
          NZ     X1,GNC2     PENDING CHARACTER
  
 GNC0     SX2    F           (X2) = SOURCE FET ADDRESS
          RJ     ROC         READ ONE CHARACTER 
          NZ     X1,GNC14    END OF DATA
          PL     X6,GNC8     NOT EOL
  
*         END OF LINE SO SAVE FLAG AND RETURN C/R.
  
          SX1    -2 
          SA2    GNC.D       (X2) = PENDING CHARACTER COUNT 
          NG     X2,GNC2     NO PENDING CHARACTERS
          BX6    X1          (X6) = -2 (EOL FLAG) 
          SA1    A2-B1       (X1) = CURRENT CHARACTER 
          SX7    X2+4041B    CONVERT REPEAT COUNT TO PRINTABLE FORM 
          SA6    GNC.A       FLAG C/R & L/F REQUIRED
          MX6    59 
          SA6    A2          CLEAR PENDING CHARACTER COUNT
          BX6    X1          (X6) = CHARACTER 
          MX1    0           CLEAR RETURN CODE
          ZR     X2,GNCX     REPEAT COUNT OF 1
          LX6    12 
          BX6    X6+X7       ADD REPEAT COUNT 
          SA2    REPT        (X2) = REPEAT CHARACTER
          LX6    12 
          BX6    X2+X6       ADD TO RETURN CODE 
          EQ     GNCX        EXIT 
  
*         CHECK IF CHARACTER IS EOL.
  
 GNC2     PL     X1,GNC6     CHARACTER OTHER THAN EOL 
          SA2    GNC.B+2+X1  (X2) = REQUIRED CHARACTER
          SX6    X1+B1       INCREMENT PENDING CHARACTER CODE 
          SA6    GNC.A       REPLACE
          BX6    X2          (X6) = CHARACTER CODE
  
*         ADD CONTROL CHARACTER PREFIX. 
  
          SA1    TXQCTL      (X1) = TRANSMIT QUOTE CHARACTER
          SX1    X1+4000B    SET TOP BIT
          LX6    12 
          BX6    X1+X6       ADD TO EOL CODE
          SX1    0           CLEAR ERROR CODE 
          EQ     GNCX        EXIT 
  
*         PENDING CHARACTER.
  
 GNC6     MX6    0
          SA6    A1          CLEAR PENDING CHARACTER
          BX6    X1          (X6) = CHARACTER 
          MX1    0           CLEAR RETURN CODE
          EQ     GNCX        EXIT 
  
*         CHECK FOR REPEAT COUNT. 
  
 GNC8     SA1    REPT        (X1) = REPEAT CHARACTER
          ZR     X1,GNCX     REPEAT DISABLED SO EXIT
  
*         COMPARE WITH PREVIOUS CHARACTER.
  
          SA2    GNC.C       (X2) = PREVIOUS CHARACTER
          BX7    X2-X6       COMPARE
          SA6    A2          UPDATE 
          LX2    12+12       MAKE ROOM FOR REPEAT COUNT 
          BX1    X1+X2       (X1) = 36/CHAR,12/0,12/REPT CHAR 
          SA2    GNC.D       (X2) = REPEAT COUNT
          SX6    X2+B1       INCREMENT
          SA6    A2          REPLACE
          NG     X2,GNC0     FIRST CHARACTER
          NZ     X7,GNC10    DIFFERENT
  
*         CHECK FOR MAX. REPEAT COUNT.
  
          SX6    X6-94       CHECK FOR MAXIMUM
          NG     X6,GNC0     IN RANGE SO GET NEXT CHARACTER 
          EQ     GNC12       GOTO BUILD AND RETURN MAX. REPEAT COUNT
  
*         CHECK REPEAT COUNT GREATER THAN 2.
  
 GNC10    AX7    X2,B1       (X7) = 0 IF REPT = 1 OR 2 (NOTE OFFSET BY 1
          NZ     X7,GNC12    MORE THAN 2
          MX6    12+12+12 
          BX6    X1*X6       CLEAR REPEAT CHARACTER 
          MX1    0           CLEAR RETURN CODE
          LX6    12+12+12    RIGHT JUSTIFY CHARACTER
          SA7    A2          RESET REPEAT COUNT 
          ZR     X2,GNCX     NOT REPEATED 
          SA6    GNC.A       SAVE PENDING CHARACTER 
          EQ     GNCX        EXIT 
  
*         ADD REPEAT COUNT AND CHARACTER TO RETURN WORD.
  
 GNC12    SX2    X2+4041B    CONVERT REPEAT COUNT TO PRINTABLE
          LX2    12 
          BX6    X1+X2       ADD REPEAT COUNT TO CHARACTER
          SX7    B0 
          SX1    0           CLEAR RETURN CODE
          SA7    A2          RESET REPEAT COUNT 
          EQ     GNCX        EXIT 
  
*         END OF DATA SO RETURN LAST CHARACTER. 
  
 GNC14    SA2    REPT        (X2) = REPEAT CHARACTER
          ZR     X2,GNCX     NO REPEAT SO NO PENDING CHARACTER
          SX7    X2+
          SA2    GNC.D       (X2) = REPEAT COUNT
          NG     X2,GNCX     ALREADY CLEARED
          MX6    59 
          SX2    X2+4041B    MAKE REPEAT COUNT PRINTABLE
          SA6    A2          CLEAR REPEAT COUNT 
          SA1    GNC.C       (X1) = PREVIOUS CHARACTER
          BX6    X1 
          MX1    0           CLEAR RETURN FLAG
          SX1    X2-4041B    CHECK FOR UNITY REPEAT COUNT 
          ZR     X1,GNCX     NO REPEAT NEEDED 
          LX6    12 
          BX6    X2+X6       ADD REPEAT COUNT 
          LX6    12 
          BX6    X6+X7       ADD REPEAT CHARACTER 
          MX1    0           CLEAR EXIT FLAG
          EQ     GNCX        EXIT 
  
 GNC.A    CON    0           PENDING EOL FLAG 
 GNC.B    BSS    0           SPECIAL CHARACTER TABLE
          CON    4115B       C/R
          CON    4112B       L/F
 GNC.C    CON    -1          PREVIOUS CHARACTER 
 GNC.D    CON    -1          REPEAT COUNT 
          SPACE  4,10 
**        ROC - READ ONE CHARACTER. 
* 
*         THIS ROUTINE READS DATA FROM THE SOURCE FILE AND RETURNS
*         THE NEXT ASCII CHARACTER. 
* 
*         ENTRY  (B1) = 1 
*                (X2) = SOURCE FET ADDRESS
* 
*         EXIT   (X1) = 0 IF DATA AVAILABLE 
*                       (1 IF EOR, -1 IF EOF, -2 IF EOI)
*                (X2) = FET ADDRESS 
*                (X6) = ASCII BYTE (-1 IF EOL)
* 
*         USES   X -
*                A -
*                B -
* 
*         CALLS  RDO=.
          SPACE  4,10 
 ROC      SUBR               ENTRY/EXIT 
  
*         DETERMINE SOURCE FORMAT.
  
          SA1    FFORM       (X1) = FILE FORMAT CODE
          SA1    X1+ROC.A    (X1) = PROCESS ADDRESS 
          SB7    X1          (B7) = PROCESS ADDRESS 
          SA1    FWORD       (X1) = CURRENT WORD
          SA3    A1+B1       (X3) = UNPACKING COUNTER 
          JP     B7+         PROCESS
  
*         6 BIT DISPLAY CODE SOURCE.
  
 ROC2     NZ     X3,ROC4     SOURCE WORD NOT EMPTY
          READO  X2          READ NEXT WORD 
          NZ     X1,ROCX     END OF DATA SO EXIT
          SX3    10          RESET UNPACKING COUNTER
          BX1    X6          (X1) = SOURCE WORD 
  
*         EXTRACT CHARACTER.
  
 ROC4     LX1    6
          SX7    X3-1        DECREMENT UNPACKING COUNTER
          MX6    -6 
          BX6    -X6*X1      (X6) = CHARACTER 
          BX1    X1-X6       CLEAR FROM SOURCE
          NZ     X6,ROC8     NOT COLON OR EOL 
          ZR     X7,ROC6     LAST CHARACTER OF SOURCE WORD SO CHECK FOR 
          ZR     X1,ROC50    REMAINING SOURCE NULL SO EOL 
          EQ     ROC8        COLON
  
*         COLON AT END OF WORD SO CHECK IF EOL. 
  
 ROC6     READO  X2          READ NEXT SOURCE WORD
          NZ     X1,ROCX     END OF DATA
          ZR     X6,ROC50    END OF LINE
          BX1    X6          (X1) = SOURCE WORD 
          SX7    10          RESET UNPACKING COUNTER
          MX6    0           FORCE COLON
  
*         CONVERT CHARACTER TO ASCII. 
  
 ROC8     SA7    FCOUNT      UPDATE UNPACKING COUNTER 
          BX7    X1 
          SA7    A7-B1       UPDATE REMAINING SOURCE WORD 
          SA1    C2A+X6      CONVERT TO ASCII 
          SX6    X1+         (X6) = ASCII CODE
          EQ     ROC38       GOTO CHECK FOR CONTROL CHARACTERS
  
*         MIXED 6/12 DISPLAY CODE.
  
 ROC10    NZ     X3,ROC12    SOURCE WORD NOT EMPTY
          READO  X2          READ NEXT WORD 
          NZ     X1,ROCX     END OF DATA
          SX3    10          RESET UNPACKING COUNTER
          BX1    X6          (X1) = SOURCE WORD 
  
*         EXTRACT CHARACTER.
  
 ROC12    LX1    6
          SX7    X3-1        DECREMENT UNPACKING COUNTER
          MX6    -6 
          BX6    -X6*X1      (X6) = CHARACTER 
          BX1    X1-X6       CLEAR FROM SOURCE
          NZ     X6,ROC16    NOT COLON OR EOL 
          ZR     X7,ROC14    END OF WORD SO COLON OR EOL
          ZR     X1,ROC50    REMAINDER NULL SO EOL
          EQ     ROC18       COLON
  
*         COLON AT END OF WORD SO CHECK FOR EOL.
  
 ROC14    READO  X2          READ NEXT SOURCE WORD
          NZ     X1,ROCX     END OF DATA
          ZR     X6,ROC50    END OF LINE
          BX1    X6          (X1) = SOURCE WORD 
          SX7    10          RESET UNPACKING COUNTER
          MX6    0           FORCE COLON
  
*         CHECK FOR ESCAPE CODE.
  
 ROC16    SB7    20          ASSUME 76NN
          SX3    X6-76B      CHECK
          ZR     X3,ROC20    CORRECT (AS USUAL) 
          SX3    X6-74B      CHECK FOR 74NN 
          SB7    B7+B7       ASSUME IT IS 
          ZR     X3,ROC20    CORRECT (WHAT A GENIUS)
          SB7    B0          CLEAR ESCAPE FLAG
  
*         CONVERT CHARACTER TO ASCII. 
  
 ROC18    SA7    FCOUNT      UPDATE UNPACKING COUNTER 
          BX7    X1 
          SA7    A7-B1       SAVE SOURCE WORD 
          SA1    C2A+X6      CONVERT CHARACTER TO ASCII 
          LX1    B7          ALLOW FOR ESCAPE CODE
          SX6    X1          (X6) = ASCII CODE
          PL     X6,ROC38    VALID
  
*         ILLEGAL CHARACTER CODE. 
  
          SX6    A1-C2A      (X6) = DISPLAY CODE
          MX7    -3 
          BX7    -X7*X6      (X7) = L.O. 3 BITS 
          AX6    3
          LX6    6
          BX6    X6+X7
          SX6    X6+2R00     (X6) = DISPLAY CODE
          LX6    60-12
          ZR     B7,ROC36    CHARACTER IS NOT ESCAPED (MUST BE '00')
          SX7    2R74        ASSUME 74NN
          SB7    B7-40       CHECK ASSUMPTION 
 +        ZR     B7,*+1      ASSUMPTION CORRECT 
          SX7    2R76 
          BX6    X6+X7       ADD PREFIX 
          LX6    60-12       LEFT JUSTIFY 
          EQ     ROC36       GOTO FLAG ERROR
  
*         PROCESS SECOND HALF OF ESCAPE CODE. 
  
 ROC20    NZ     X7,ROC22    SOURCE WORD NOT EMPTY
          READO  X2          READ NEXT SOURCE WORD
          NZ     X1,ROCX     END OF DATA
          SX7    10          RESET UNPACKING COUNTER
          BX1    X6          (X1) = SOURCE WORD 
  
*         EXTRACT SECOND HALF OF CODE.
  
 ROC22    MX6    -6 
          SX7    X7-1        DECREMENT UNPACKING COUNTER
          LX1    6
          BX6    -X6*X1      (X6) = CHARACTER 
          BX1    X1-X6       CLEAR FROM SOURCE
          NZ     X6,ROC18    NOT COLON OR EOL 
          ZR     X7,ROC18    LAST CHARACTER OF WORD SO NOT EOL
          NZ     X1,ROC18    NOT END OF LINE
          EQ     ROC50       PROCESS END OF LINE
  
*         8 IN 12 ASCII.
  
 ROC24    MX0    -12
          BX7    -X0*X1      (X7) = REMAINING BYTE COUNT
          NZ     X7,ROC26    WORD NOT EMPTY 
          READO  F           READ SOURCE WORD 
          NZ     X1,ROCX     END OF DATA SO EXIT
          SX7    5           RESET UNPACKING COUNT
          BX1    X6          (X1) = SOURCE WORD 
  
 ROC26    LX1    12 
          SX7    X7-1        DECREMENT REMAINING BYTE COUNT 
          BX6    -X0*X1      (X6) = DATA BYTE 
          BX1    X0*X1       CLEAR FROM SOURCE
          BX7    X1+X7       ADD REMAINING CHARACTER COUNT
          ZR     X6,ROC24    EOL
          MX0    -8 
          BX7    X1+X7       ADD BYTE COUNT TO REMAINING DATA 
          BX6    -X0*X6      CLEAR TOP BIT IF SET 
          SA7    FWORD       UPDATE CURRENT WORD
          EQ     ROC38       GOTO CHECK FOR CONTROL CODES 
  
*         HEX FORMAT. 
  
 ROC28    MX0    -6 
          BX7    -X0*X1      (X7) = REMAINING BYTE COUNT
          NZ     X7,ROC32    DATA AVAILABLE 
  
 ROC30    READO  F           READ NEXT SOURCE WORD
          NZ     X1,ROCX     END OF DATA
          SX7    5           RESET BYTE COUNT 
          BX1    X6          (X1) = SOURCE WORD 
  
 ROC32    LX1    6
          SX7    X7-1        DECREMENT AVAILABLE CHARACTER COUNT
          BX2    -X0*X1      (X2) = NEXT DISPLAY CODE 
          ZR     X2,ROC30    IGNORE EOL 
          SX2    X2-1R0      ASSUME 0-9 
 +        PL     X2,*+1      ASSUMPTION PROBABLY CORRECT
          SX2    X2+1R0-1RA+10
          MX6    -4 
          BX6    X2*X6       CHECK VALID
          NZ     X6,ROC34    ILLEGAL CHARACTER SO ABORT 
          LX1    6
          BX6    -X0*X1      (X6) = SECOND DISPLAY CODE 
          SX6    X6-1R0      ASSUME 0-9 
 +        PL     X6,*+1      ASSUMPTION PROBABLY CORRECT
          SX6    X6+1R0-1RA+10
          MX3    -4 
          BX3    X3*X6       CHECK VALID
          NZ     X3,ROC34    ILLEGAL CHARACTER SO ABORT 
          LX2    4           POSITION HIGH NIBBLE 
          BX6    X2+X6       ADD LOW NIBBLE 
          BX1    X0*X1       ENSURE ROMM IN SOURCE WORD FOR COUNT 
          BX7    X1+X7       ADD COUNT
          SA7    FWORD       UPDATE CURRENT WORD
          EQ     ROC38       GOTO CHECK FOR CONTROL CODES 
  
*         DISPLAY CODE NOT 0-9 OR A-F SO ABORT. 
  
 ROC34    BX6    -X0*X1      (X6) = OFFENDING CHARACTER 
          LX6    60-6        POSITION 
  
*         FLAG ILLEGAL CHARACTER (DISPLAY CODE IN X6).
  
 ROC36    SA6    ILCHAR      SAVE ILLEGAL CHARACTER CODE
          SX6    E_ILCHAR    SET EXIT MODE
          SA6    EMODE
          SA1    ROC.B       (X1) = FWA OF LOG MESSAGE
          RJ     WLM         WRITE LOG MESSAGE
          SX6    FPE         FORCE PROTOCOL ERROR 
          EQ     SGS         SET GIVEN STATE
  
*         CHECK FOR 8 BIT PREFIX. 
  
 ROC38    MX0    -7 
          BX0    X0*X6       CHECK IF TOP BIT SET 
          ZR     X0,ROC40    NOT SET
          BX6    X0-X6       CLEAR
          SA3    TXPWORD     (X3) = TRANSMIT PREFIX WORD
          AX3    20 
          SX3    X3          (X3) = 8 BIT PREFIX CODE 
          PL     X3,ROC48    NO PREFIXING ALLOWED SO ERROR
          BX3    -X3         COMPLEMENT 
          SX0    X3+4000B    SET TOP BIT
  
*         CHECK FOR CONTROL CHARACTER.
  
 ROC40    MX1    -5 
          SX7    X6-177B     CHECK FOR DEL
          BX1    X1*X6       CHECK FOR 0-31 
          IX7    X1*X7       (X7) = 0 IF CONTROL CODE 
          MX1    0           CLEAR CONTROL PREFIX 
          ZR     X7,ROC42    CONTROL CHARACTER
  
*         CHECK CHARACTER IS NOT PREFIX CHARACTER.
  
          SB7    X6          (B7) = CHARACTER 
          SA3    TXPWORD     (X3) = PREFIX CHARACTERS FOR TX
          SX7    X3+B7       CHECK FOR CONTROL PREFIX 
          ZR     X7,ROC44    PREFIX 
          AX3    20 
          SX7    X3+B7       CHECK FOR 8 BIT PREFIX 
          ZR     X7,ROC44    PREFIX 
          AX3    20 
          SX7    X3+B7       CHECK FOR REPEAT PREFIX
          ZR     X7,ROC44    PREFIX 
          SX7    0           CLEAR CONTROL PREFIX FLAG
          EQ     ROC46       GOTO BUILD CHARACTER 
  
*         ADD CONTROL CHARACTER PREFIX. 
  
 ROC42    SX1    64 
          BX6    X1-X6       CTRL[CHAR] 
  
 ROC44    SA1    TXQCTL      (X1) = TX CONTROL PREFIX 
          SX7    X1+4000B    SET BIT 11 
  
*         BUILD CHARACTER,  (X0) = 8 BIT, (X6) = CHAR, (X7) = CTRL. 
  
 ROC46    SX6    X6+4000B    SET TOP BIT
          SX1    0           CLEAR ERROR CODE 
 +        ZR     X7,*+1      NO CONTROL PREFIX
          LX6    12 
          BX6    X6+X7       ADD TO CHARACTER 
 +        ZR     X0,*+1      NO 8 BIT PREFIX
          LX6    12 
          BX6    X0+X6       ADD TO CHARACTER 
          EQ     ROCX        EXIT 
  
*         ERROR AS 8 BIT CODE WHEN PREFIXING NOT ALLOWED. 
  
 ROC48    MX3    -3 
          BX7    -X3*X7      (X7) = LAST 3 BITS 
          AX6    3
          BX3    -X3*X6      (X3) = NEXT 3 BITS 
          AX6    3
          LX6    6
          BX6    X3+X6       FIRST TWO DIGITS 
          LX6    6
          BX6    X6+X7       (X6) = OCTAL DIGITS
          SX6    X6+3R200    CONVERT TO DISPLAY CODE
          LX6    60-18       LEFT JUSTIFY 
          EQ     ROC36       GOTO FLAG ERROR
  
*         END OF LINE.
  
 ROC50    MX6    0
          SA6    FCOUNT      CLEAR REMAINING SOURCE COUNT 
          SA6    A6+B1       CLEAR UNPACKING COUNTER
          MX6    59          RETURN EOL 
          MX1    0           CLEAR EOF FLAG 
          EQ     ROCX        EXIT 
  
*         BINARY FORMAT.
  
 ROC52    MX0    -4 
          BX7    -X0*X1      (X7) = REMAINING NIBBLE COUNT
          SB7    X7+
          GT     B7,B1,ROC58 AT LEAST ONE BYTE
          ZR     B7,ROC56 
  
*         BYTE CROSSES WORD BOUNDARY
  
          LX1    4
          BX0    -X0*X1      (X0) = HIGH NIBBLE 
          READO  F           READ NEXT SOURCE WORD
          NZ     X1,ROC54    END OF DATA
          MX1    4
          BX1    -X1*X6      (X1) = REST OF WORD
          BX6    X1-X6       (X6) = TOP NIBBLE
          BX6    X0+X6       ADD HIGH NIBBLE FROM PREVIOUS WORD 
          LX6    4           RIGHT JUSTIFY
          LX1    4
          SX7    14          (X7) = REMAINING NIBBLE COUNT
          BX7    X1+X7       MERGE
          SA7    FWORD       UPDATE UNPACKING WORD
          EQ     ROC38       GOTO CHECK FOR CONTROL CODES 
  
*         END OF DATA HALF WAY THROUGH NIBBLE.
  
 ROC54    BX6    X0          (X6) = AVAILABLE NIBBLE
          SX7    0
          LX6    4           (X6) = RETURN BYTE 
          SA7    FWORD       CLEAR PACKING WORD 
          EQ     ROC38       GOTO CHECK FOR CONTROL CODES 
  
*         ZERO OR EMPTY SOURCE WORD.
  
 ROC56    READO  F           READ NEXT SOURCE WORD
          NZ     X1,ROCX     END OF DATA
          BX1    X6          (X1) = SOURCE WORD 
          SX7    15          (X7) = REMAINING NIBBLE COUNT
  
*         EXTRACT NEXT BYTE.
  
 ROC58    MX0    -8 
          SX7    X7-2        DECREMENT REMAINING NIBBLE COUNT 
          LX1    8
          BX6    -X0*X1      (X6) = DATA BYTE 
          BX1    X0*X1       CLEAR FROM SOURCE WORD 
          BX7    X1+X7       ADD REMAINING COUNT TO CURRENT WORD
          SA7    FWORD       UPDATE 
          EQ     ROC38       GOTO CHECK FOR CONTROL CODES 
  
 ROC.A    BSS    0           SOURCE FORMAT TYPE TABLE 
          CON    ROC2        6 BIT DISPLAY CODE 
          CON    ROC10       MIXED 6/12 DISPLAY CODE
          CON    ROC24       ASCII 8 IN 12
          CON    ROC28       HEX FORMAT 
          CON    ROC52       BINARY FORMAT
 ROC.B    DIS    ,' ILLEGAL CHARACTER CODE - ;D'
          SPACE  4,10 
**        WAC - WRITE ASCII CHARACTER.
* 
*         THIS ROUTINE WRITES THE GIVEN ASCII CHARACTER TO THE DATA 
*         FILE THE SPECIFIED NUMBER OF TIMES. UNLIKE THE ROUTINE 'WOC'
*         THIS ROUTINE CHECKS FOR THE SEQUENCE 'C/R' 'L/F' AND INSERTS
*         AN END OF LINE ACCORDINGLY. 
* 
*         ENTRY  (B1) = 1 
*                (B5) = NUMBER OF TIMES TO WRITE CHARACTER
*                (X0) = ASCII CHARACTER 
* 
*         EXIT   CHARACTER WRITTEN TO DATA FILE 
* 
*         USES   X -
*                A -
*                B -
* 
*         CALLS  WOC. 
          SPACE  4,10 
 WAC      SUBR               ENTRY/EXIT 
  
          SX6    X0-012B     CHECK FOR 'L/F'
          NZ     X6,WAC2     NOT L/F
  
*         L/F SO FORCE EOL IF PENDING C/R.
  
          SA1    WAC.A       (X1) = PENDING C/R FLAG
          ZR     X1,WAC6     NO C/R SO NOT EOL
          SX6    B5-B1       (X6) = REMAINING REPEAT COUNT
          SA6    A1          SAVE 
          RJ     WEL         WRITE END OF LINE
          SA1    WAC.A       (X1) = REMAINING REPEAT COUNT
          ZR     X1,WACX     ONLY ONE L/F SO EXIT (NOTE C/R FLAG CLEARED
          MX6    0           CLEAR PENDING C/R FLAG 
          SB5    X1+         RESTORE REPEAT COUNT 
          SA6    A1          CLEAR FLAG 
          SX0    012B        RESTORE CHARACTER
          EQ     WAC6        GOTO WRITE CHARACTER 'B5' TIMES
  
*         NOT L/F SO CHECK FOR PENDING C/R. 
  
 WAC2     SA1    WAC.A       (X1) = PENDING C/R FLAG
          ZR     X1,WAC4     NO PENDING C/R 
  
*         OUTPUT PENDING C/R. 
  
          SX6    B5          (X) = REPEAT COUNT 
          LX0    18 
          BX6    X0+X6       (X6) = CHARACTER + REPEAT COUNT
          SA6    A1          SAVE 
          SX0    015B        (X0) = C/R 
          SB5    1           (B5) = REPEAT COUNT
          RJ     WOC         WRITE ONE CHARACTER
          SX6    0
          SA1    WAC.A       (X1) = CHARACTER + REPEAT COUNT
          SB5    X1          RESTORE REPEAT COUNT 
          AX1    18 
          SX0    X1          RESTORE ASCII CHARACTER
          SA6    A1          CLEAR PENDING C/R FLAG 
  
*         CHECK FOR C/R.
  
 WAC4     SX6    X0-015B     CHECK FOR C/R
          NZ     X6,WAC6     NOT C/R
          MX6    59 
          SB5    B5-B1       DECREMENT REPEAT COUNT 
          SA6    WAC.A       FLAG PENDING C/R 
          ZR     B5,WACX     NOT REPEATED SO EXIT 
  
*         WRITE CHARACTER.
  
 WAC6     RJ     WOC         WRIITE ONE CHARACTER 
          EQ     WACX        EXIT 
  
 WAC.A    CON    0           PENDING C/R FLAG 
          SPACE  4,10 
**        WEL - WRITE END OF LINE.
* 
*         THIS ROUTINE FORCES AN END OF LINE ON THE DATA FILE.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   EOL WRITTEN TO DATA FILE 
* 
*         USES   X -
*                A -
*                B -
* 
*         CALLS  WTO=.
          SPACE  4,10 
 WEL      SUBR               ENTRY/EXIT 
  
*         INITIALISE. 
  
          SA1    FFORM       (X1) = FILE FORMAT 
          SA2    WEL.A+X1    (X2) = PROCESS ADDRESS 
          SA1    A1+B1       (X1) = PACKING WORD
          MX6    0           ASSUME EMPTY 
          ZR     X1,WEL10    WORD EMPTY SO WRITE AS EOL 
          SB5    X2          (B5) = PROCESS ADDRESS 
          JP     B5+         BRANCH ACCORDING TO FILE FORMAT
  
*         6 BIT OR 6/12 FORMAT (DIS64 OR ASCII).
  
 WEL2     MX6    -6 
          BX7    -X6*X1      (X7) = AVAILABLE SPACE 
          BX6    X1*X6       (X6) = PACKED DATA 
          LX6    60-6        RIGHT JUSTIFY
          SB5    X7-10       CHECK FOR EMPTY WORD 
          ZR     B5,WEL6     EMPTY SO WRITE EOL 
          LX7    59-0        CHECK IF ODD CHARACTER COUNT 
          SB5    X7          (B5) = REMAINING 12 BIT COUNT
          PL     X7,WEL4     EVEN CHARACTER COUNT 
          LX6    6
          SX2    1R 
          BX6    X2+X6       ADD TRAILING BLANK 
  
 WEL4     NZ     B5,WEL6     PACKING WORD NOT FULL
          WRITEO F           WRITE FULL WORD
          SX6    0           CLEAR PACKING WORD 
          SB5    10          RESET PACKING COUNTER
  
*         LEFT JUSTIFY AND SAVE PACKING WORD. 
  
 WEL6     SB5    B5+B5       * 2
          SX7    B5+B5       * 4
          SB5    X7+B5       * 6
          SB5    B5+B5       * 12 
          MX7    0
          LX6    B5          LEFT JUSTIFY PACKING WORD
          SA7    FWORD       CLEAR PACKING WORD 
          WRITEO F           WRITE PACKING WORD FORCING EOL 
          EQ     WELX        EXIT 
  
*         8 IN 12 FORMAT. 
  
 WEL8     LX1    12          LEFT JUSTIFY 
          PL     X1,* 
          BX6    X1          (X6) = LEFT JUSTIFIED PACKED DATA
  
 WEL10    WRITEO F           WRITE PACKING WORD 
          SX6    0
          SA6    FWORD       CLEAR PACKING WORD 
          EQ     WELX        EXIT 
  
*         HEX FORMAT. 
  
 WEL12    SX0    015B        (X0) = C/R 
          SB5    1           (B5) = REPEAT COUNT
          RJ     WOC         WRITE ONE CHARACTER
          SX0    012B        (X0) = L/F 
          SB5    1           (B5) = REPEAT COUNT
          RJ     WOC         WRITE ONE CHARACTER
          EQ     WELX        EXIT 
  
 WEL.A    BSS    0           FILE FORMAT BRANCH TABLE 
          CON    WEL2        6 BIT DISPLAY CODE (DIS64) 
          CON    WEL2        6/12 DISPLAY CODE (ASCII)
          CON    WEL8        8 IN 12 ASCII (ASCII8) 
          CON    WEL12       HEX FORMAT 
          CON    WEL12       BINARY FORMAT
          SPACE  4,10 
**        WOC - WRITE ONE CHARACTER.
* 
*         THIS ROUTINE WRITES THE GIVEN ASCII CHARACTER THE SPECIFIED 
*         NUMBER OF TIMES TO THE DATA FILE. 
* 
*         ENTRY  (B1) = 1 
*                (B5) = NUMBER OF TIMES TO WRITE CHARACTER
*                (X0) = ASCII CHARACTER 
* 
*         EXIT   CHARACTER WRITTEN TO FILE
* 
*         USES   X -
*                A -
*                B -
* 
*         CALLS 
          SPACE  4,10 
 WOC      SUBR               ENTRY/EXIT 
  
*         INITIALISE. 
  
          SA1    FWORD       (X1) = PACKING WORD
          BX6    X1 
          SA1    A1-B1       (X1) = FILE TYPE 
          SA1    WOC.A+X1    (X1) = PROCESS ADDRESS 
          SA0    B5          (A0) = NUMBER OF TIMES TO WRITE
          SB5    X1          (B5) = PROCESS ADDRESS 
          JP     B5+         BRANCH ACCORDING TO FILE FORMAT
  
*         6 BIT DISPLAY CODE (DIS64). 
  
 WOC2     SX4    77B
          BX4    X4*X6       (X4) = REMAINING BYTE COUNT
          BX6    X4-X6       (X6) = DATA
 +        NZ     X4,*+1      NOT EMPTY WORD 
          SX4    10          RESET PACKING COUNTER
          MX2    -7 
          BX2    -X2*X0      (X2) = 7 BIT ASCII CODE
          SA2    A2C+X2      CONVERT TO DISPLAY CODE
          AX2    18 
          SX0    X2          (X0) = 6 BIT DISPLAY CODE
          NG     X0,WOC40    ILLEGAL
          SB5    A0+         (B5) = NUMBER OF TIMES TO WRITE
          SX2    F           (X2) = FET ADDRESS 
  
*         SAVE CHARACTER 'B5' TIMES.
  
 WOC4     BX6    X0+X6       ADD CHARACTER
          SX4    X4-1        DECREMENT PACKING COUNTER
          SB5    B5-B1       DECREMENT REPEAT COUNT 
          NZ     X4,WOC6     PACKING WORD NOT FULL
          WRITEO X2          WRITE FULL WORD
          SX6    0           CLEAR PACKING WORD 
          SX4    10          RESET PACKING COUNTER
  
 WOC6     LX6    6           MOVE ONE CHARACTER 
          NZ     B5,WOC4     LOOP TILL REPEAT COUNT EXHAUSTED 
          BX6    X4+X6       ADD PACKING COUNTER TO PACKED WORD 
          SA6    FWORD       SAVE 
          EQ     WOCX        EXIT 
  
*         6/12 DISPLAY CODE (ASCII).
  
 WOC8     SX4    77B
          BX4    X4*X6       (X4) = REMAINING BYTE COUNT
          BX6    X4-X6       (X6) = DATA
 +        NZ     X4,*+1      NOT EMPTY WORD 
          SX4    10          RESET PACKING COUNTER
          MX2    -7 
          BX2    -X2*X0      (X2) = 7 BIT ASCII 
          SA2    A2C+X2      CONVERT TO DISPLAY CODE
          SX0    X2          (X0) = CODE
          NG     X0,WOC40    ILLEGAL (THIS SHOULD BE IMPOSSIBLE)
          SB5    A0          (B5) = REPEAT COUNT
  
*         WRITE CHARACTER 'X0' TIMES. 
  
 WOC10    BX2    X0          (X2) = DISPLAY CODE
          AX2    6           CHECK IF 12 BIT CODE 
          ZR     X2,WOC14    6 BIT CODE 
  
          SX4    X4-2        CHECK IF ROOM IN CURRENT WORD
          NG     X4,WOC12    CROSSES WORD BOUNDARY
          LX6    6           MAKE ROOM
          BX6    X0+X6       ADD 12 BIT CODE
          EQ     WOC16       GOTO CHECK FOR FULL WORD 
  
 WOC12    BX6    X2+X6       ADD FIRST 6 BITS TO FILL WORD
          WRITEO F           WRITE FULL WORD
          MX6    -6 
          SX4    10-1        RESET PACKING COUNTER
          BX6    -X6*X0      (X6) = L.O. 6 BITS 
          EQ     WOC18       GOTO CHECK FOR REPEAT
  
*         ONLY 6 BIT CODE.
  
 WOC14    BX6    X0+X6       ADD CODE TO PACKING WORD 
          SX4    X4-1        DECREMENT PACKING COUNTER
  
*         CHECK IF PACKING WORD FULL. 
  
 WOC16    NZ     X4,WOC18    NOT FULL 
          WRITEO F           WRITE FULL WORD
          SX6    0           RESET PACKING WORD 
          SX4    10          RESET PACKING COUNTER
  
*         CHECK REPEAT COUNT. 
  
 WOC18    SB5    B5-B1       DECREMENT REPEAT COUNT 
          LX6    6
          NZ     B5,WOC10    LOOP TILL REPEAT COUNT EXPIRED 
          BX6    X4+X6       ADD PACKING COUNTER TO PACKING WORD
          SA6    FWORD       SAVE 
          EQ     WOCX        EXIT 
  
*         8 IN 12 ASCII.
  
 WOC20    SB5    A0          (B5) = REPEAT COUNT
          SX1    4000B
          BX0    X0+X1       ENSURE TOP BIT SET 
  
*         SAVE BYTE.
  
 WOC22    LX6    12 
          SB5    B5-1        DECREMENT REPEAT COUNT 
          BX6    X0+X6       ADD BYTE 
          NG     X6,WOC24    WORD FULL
          NZ     B5,WOC22    CHARACTER REPEATED 
          SA6    FWORD       UPDATE CURRENT WORD
          EQ     WOCX        EXIT 
  
*         WORD FULL.
  
 WOC24    WRITEO F           WRITE FULL WORD
          SX6    0           CLEAR PACKING WORD 
          NZ     B5,WOC22    CHARACTER REPEATED 
          SA6    FWORD       UPDATE CURRENT WORD
          EQ     WOCX        EXIT 
  
*         HEX FORMAT. 
  
 WOC26    NZ     X6,*+1      NOT NEW WORD 
          SX6    39          RESET PACKING COUNTER
          SX4    77B
          BX4    X4*X6       (X4) = PACKING BYTE COUNT
          BX6    X4-X6       (X6) = CURRENT DATA
          SB5    X4          (B5) = PACKING COUNTER 
          SX4    A0          (X4) = REPEAT COUNT
          MX1    -4 
          BX2    -X1*X0      (X2) = LOW NIBBLE OF DATA
          SA2    H2D+X2      CONVET TO DISPLAY CODE 
          AX0    4
          BX1    -X1*X0      (X1) = HIGH NIBBLE OF DATA 
          SA1    H2D+X1      CONVERT TO DISPLAY CODE
          LX1    6
          BX0    X1+X2       (X0) = DISPLAY CODE TO SAVE
  
*         SAVE DISPLAY CODE 'X4' TIMES. 
  
 WOC28    BX6    X0+X6       ADD TO PACKING WORD
          SB5    B5-10B      DECREMENT COUNTER
          LX6    12 
          PL     B5,WOC30    NOT END OF WORD/LINE 
          LX6    60-12       POSITION 
          SA0    X4          SAVE REMAINING REPEAT COUNT
          WRITEO F           WRITE FULL WORD
          SX4    A0          RESTORE REPEAT COUNT 
          SB5    B5+39       RESET PACKING COUNTER
          MX6    0           CLEAR PACKING WORD 
          SX7    B5-39+8     CHECK FOR EOL
          NZ     X7,WOC30    NOT EOL
  
*         FORCE EOL.
  
          WRITEO X2          FORCE EOL
          SX4    A0          RESTORE REPEAT COUNT 
          SB5    39          RESET PACKING COUNTER
          MX6    0           CLEAR PACKING WORD 
  
*         CHECK IF MORE ENTRIES REQUIRED. 
  
 WOC30    SX4    X4-1        DECREMENT REPEAT COUNT 
          NZ     X4,WOC28    CHARACTER REPEATED 
          SX1    B5          (X1) = COUNTER 
          BX6    X1+X6       ADD TO PACKING WORD
          SA6    FWORD       REPLACE
          EQ     WOCX        EXIT 
  
*         BINARY FORMAT.
  
 WOC32    NZ     X6,*+1      SOURCE WORD EMPTY
          SX6    15          FORCE MAX. NIBBLE COUNT
          MX4    -4 
          BX4    -X4*X6      (X4) = REMAINING NIBBLE COUNT
          BX6    X4-X6       (X6) = DATA
          SB5    X4          (B5) = UNUSED NIBBLE COUNT 
  
*         CHECK IF SPACE IN CURRENT WORD. 
  
 WOC34    SB5    B5-2        ASSUME SPACE FOR ONE BYTE
          PL     B5,WOC36    YES THERE IS ROOM
  
*         BYTE MUST BE SPLIT OVER TWO CDC WORDS.
  
          BX4    X0          (X4) = DATA BYTE 
          AX4    4           KEEP TOP NIBBLE
          BX6    X4+X6       ADD TO PACKING WORD
          WRITEO F           WRITE FULL WORD
          MX6    -4 
          SB5    14          RESET REMAINING NIBBLE COUNT 
          BX6    -X6*X0      (X6) = LOW NIBBLE
          EQ     WOC38       GOTO CHECK FOR REPEAT
  
*         BYTE FITS IN CURRENT WORD.
  
 WOC36    LX6    4           MAKE ROOM FOR BYTE 
          BX6    X0+X6       ADD DATA BYTE
          NZ     B5,WOC38    NOT FULL WORD
          WRITEO F           WRITE FULL WORD
          SB5    15          RESET REMAINING NIBBLE COUNT 
          SX6    0           CLEAR PACKING WORD 
  
                             CHECK FOR MORE DATA BYTES
  
 WOC38    LX6    4           POSITION PACKING WORD
          SA0    A0-1        DECREMENT REPEAT COUNT 
          SX1    A0 
          NZ     X1,WOC34    LOOP FOR REPEAT COUNT
  
*         UPDATE PACKING WORD AND EXIT. 
  
          SX1    B5          (X1) = REMAINING NIBBLE COUNT
          BX6    X1+X6       ADD TO PACKING WORD
          SA6    FWORD       SAVE 
          EQ     WOCX        EXIT 
  
*         ILLEGAL CHARACTER ON INPUT. 
  
 WOC40    SX2    A2          (X2) = ADDRESS OF LOOKUP TABLE ENTRY 
          SX6    A2C         (X6) = FWA OF LOOKUP TABLE 
          IX2    X2-X6       (X2) = OFFENDING ASCII CHARACTER 
          MX4    -3 
          SX6    3R000
          BX7    -X4*X2      (X7) = LAST OCTET
          IX6    X6+X7       ADD
          LX6    60-6        POSITION 
          AX2    3
          BX7    -X4*X2      (X7) = SECOND OCTET
          IX6    X6+X7       ADD
          LX6    60-6 
          AX2    3
          BX7    -X4*X2      (X7) = FIRST OCTET 
          IX6    X6+X7       ADD
          LX6    60-6 
          SA6    ILCHAR      SAVE ILLEGAL CHARACTER CODE
          SX6    E_ILCHAR    SET EXIT MODE
          SA6    EMODE
          SA1    WOC.B       (X1) = FWA OF LOG MESSAGE
          RJ     WLM         WRITE LOG MESSAGE
          SX6    FPE         FORCE PROTOCOL ERROR 
          EQ     SGS         SET GIVEN STATE
  
 WOC.A    BSS    0           FILE TYPE BRANCH TABLE 
          CON    WOC2        6 BIT DISPLAY CODE (DIS64) 
          CON    WOC8        6/12 DISPLAY CODE (ASCII)
          CON    WOC20       8 IN 12 ASCII (ASCII8) 
          CON    WOC26       HEX FORMAT (HEX) 
          CON    WOC32       BINARY FORMAT (BINARY) 
 WOC.B    DIS    ,' ILLEGAL CHARACTER CODE - ;D'
          SPACE  4,10 
**        FRB - FLUSH RECEIVE BUFFER. 
* 
*         THIS ROUTINE IS CALLED WHEN AN END OF FILE PACKET IS
*         RECEIVED. IT THEN FLUSHES ANY DATA LEFT IN THE FILE.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   BUFFER FLUSHED 
* 
*         USES   X -
*                A -
*                B -
* 
*         CALLS 
          SPACE  4,10 
 FRB      SUBR               ENTRY/EXIT 
  
          SA1    FFORM       (X1) = FILE FORMAT CODE
          SA2    X1+FRB.A    (X2) = PROCESS ADDRESS 
          SB7    X2 
          SA1    A1+B1       (X1) = PACKING WORD
          JP     B7+         BRANCH ACCORDING TO TYPE 
  
*         8 IN 12 ASCII.
  
 FRB2     BX6    X1          (X6) = REMAINING DATA
          ZR     X6,FRB6     NO DATA
  
 +        LX6    12 
          PL     X6,*        LEFT JUSTIFY 
          WRITEO F           WRITE LAST WORD
          EQ     FRB6        GOTO FLUSH BUFFER
  
*         HEX FORMAT. 
  
 FRB4     SX6    7777B
          BX6    -X6*X1      (X6) = REMAINING DATA
          BX1    X1-X6       (X1) = REMAINING BYTE COUNT
          SX7    X1-39       CHECK FOR EMPTY LINE 
          ZR     X1,FRB6     IGNORE 
  
*         LEFT JUSTIFY LAST WORD. 
  
          AX1    3           (X1) = REMAINING 12 BIT COUNT
          LX1    2           * 4
          LX7    X1,B1       * 8
          IX1    X1+X7       * 12 
          SB7    X1 
          LX6    B7          LEFT JUSTIFY 
          WRITEO F           WRITE LAST WORD
  
*         FLUSH BUFFER. 
  
 FRB6     WRITER F,R         FLUSH BUFFER 
          EQ     FRBX        EXIT 
  
*         BINARY FORMAT.
  
 FRB8     ZR     X1,FRB6     NO PARTIAL WORD
          MX7    -4 
          BX6    X1*X7       (X6) = REMAINING DATA
          BX7    -X7*X1      (X7) = REMAINING NIBBLE COUNT
          SX2    X7-15       CHECK FOR EMPTY WORD 
          LX7    2           (X7) = REMAINING BIT COUNT 
          ZR     X2,FRB6     EMPTY WORD SO EXIT 
          SB7    X7 
          LX6    B7          POSITION LAST WORD 
          WRITEO F           AND WRITE IT 
          WRITER X2,R        FLUSH BUFFER 
          EQ     FRBX        EXIT 
  
 FRB.A    BSS    0           FILE TYPE BRANCH TABLE 
          CON    FRB6        DIS64
          CON    FRB6        ASCII
          CON    FRB2        8 IN 12
          CON    FRB4        HEX
          CON    FRB8        BINARY 
          TITLE  TERMINAL INTERFACE ROUTINES. 
***       TERMINAL INTERFACE ROUTINES.
* 
*         NOS KERMIT ASSUMES THAT ALL CONNECTION PARAMETERS (E.G. PARITY
*         HAVE BEEN SET PRIOR TO RUNNING KERMIT. THERE IS NO FACILITY 
*         FOR CHANGING CONNECTION PARAMETERS WITHIN THIS IMPLEMENTATION.
* 
*         THERE ARE TWO ROUTINES WHICH ARE USED TO MODIFY THE 2550/2551 
*         FRONT END CONTROL. THESE ROUTINES (STI - SET TERMINAL INTERFAC
*         AND CTI - CLEAR TERMINAL INTERFACE) ARE USED TO EFFECT THE
*         FOLLOWING 'TERMDEF' FUNCTIONS.
* 
*         STI - CALLED BEFORE TRANSFER. 
* 
*               %EL=N 
*               %EP=N 
*               %IC=Y 
*               %OC=Y 
*               %PG=N 
* 
*         CTI - CALLED AFTER TRANSFER.
* 
*               %EL=CL
*               %EP=Y 
* 
*         THESE ROUTINES MAY NEED MODIFICATION DEPENDING ON THE LOCAL 
*         NETWORK AVAILABLE.
          SPACE  4,10 
**        TERMINAL INTERFACE ROUTINES.
* 
*         THE FOLLOWING ROUTINES ARE USED TO DO ALL THE INPUT/OUTPUT
*         TO THE TERMINAL.
* 
*         CTI - CLEAR TERMINAL INTERFACE
*         RTI - READ TERMINAL INPUT 
*         STI - SET TERMINAL INTERFACE
          SPACE  4,10 
**        CTI - CLEAR TERMINAL INTERFACE. 
* 
*         THIS ROUTINE IS CALLED TO CLEAR THE TERMINAL INTERFACE
*         PARAMETERS WHICH WERE CHANGED TO ALLOW THE TRANSFER. IT 
*         IS NOT POSSIBLE TO RETURN ALL PARAMETERS TO THEIR ORIGINAL
*         STATE, THOSE NOT RESTORED ARE LISTED BELOW. 
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   TERMINAL INTERFACE CLEARED 
* 
*         USES   X -
*                A -
*                B -
* 
*         CALLS 
          SPACE  4,10 
 CTI      SUBR               ENTRY/EXIT 
  
          CSET   RESTORE     RESTORE TERMINAL MODE
          WRITER O,R         ENSURE START OF POT
          WRITEW X2,CTI.A,CTI.AL
          WRITER X2,R 
  
*         RETURN UNWANTED FILES.
  
          RETURN Q,R         RETURN CATLIST FILE
          RETURN I,R         RETURN INPUT FILE
          RETURN O,R         RETURN OUTPUT FILE 
          SA1    CNAME       (X1) = CURRENT FILE NAME 
          SA2    F           (X2) = NAME FROM FET 
          BX1    X1-X2       COMPARE
          AX1    18          IGNORE STATUS BITS 
          ZR     X1,CTIX     FILE WAS ALREADY LOCAL 
          RETURN F           RETURN DATA FILE 
          EQ     CTIX        EXIT 
  
 CTI.A    VFD    12/0016B    CLEAR TERMINAL INTERFACE 
          VFD    12/4077B,12/4003B   EL=CL
          VFD    12/4061B,12/4001B   EP=Y 
          VFD    12/0        ENSURE EOL 
          IFNE   *P,60,1     ZERO FILL REMAINDER OF WORD
          VFD    *P/0 
 CTI.AL   EQU    *-CTI.A
          SPACE  4,10 
**        RTI - READ TERMINAL INPUT.
* 
*         THIS ROUTINE CHECKS FOR ANY INPUT. IF THERE IS INPUT THEN 
*         IT IS READ IN.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   (X1) = 0 IF NO INPUT, -1 IF CHECKSUM ERROR 
*                       OTHERWISE PACKET TYPE CODE IN ASCII 
* 
*         USES   X - 0, 1, 2, 6, 7. 
*                A - 0, 1, 2, 6, 7. 
*                B - 2, 3, 6, 7.
* 
*         CALLS  AFB, CBA, CIO, RDC=, SYS=, VPC.
          SPACE  4,10 
 RTI      SUBR               ENTRY/EXIT 
  
*         RETURN INPUT BUFFER IF ASSIGNED.
  
          RJ     RIB         RETURN INPUT BUFFER
  
*         CHECK FOR AVAILABLE INPUT BUFFER. 
  
          RJ     CBA         CHECK IF BUFFER AVAILABLE
          ZR     X1,RTIX     NO BUFFER AVAILABLE SO EXIT
 .1       IFGE   PSR,617
  
*         CHECK IF ANY INPUT AVAILABLE. 
  
 RTI2     SYSTEM TLX,R,RTI.A,1600B
          SA1    RTI.A       (X1) = STATUS
          ZR     X1,RTIX     NO INPUT AVAILABLE SO EXIT 
  
*         INPUT AVAILABLE SO RESET TIME OUT RETRY COUNTER.
  
          SA1    RETRY       (X1) = RETRY LIMIT 
          SX6    X1+
          SA6    RETIME      RESET RETRY TIMEOUT COUNTER
 .1       ELSE
 RTI2     BSS    0
 .1       ENDIF 
  
*         NOW READ THE INPUT. 
  
          READC  I,RTI.B,32  READ LINE
          NZ     X1,RTI2     BLANK INPUT SO IGNORE
          RJ     AFB         ALLOCATE FREE BUFFER 
          SA0    X1+         (A0) = FWA OF BUFFER 
  
*         SCAN INPUT BUFFER FOR START OF PACKET.
  
          SA1    MARK        (X1) = START OF PACKET CHARACTER 
          MX0    -6 
          BX6    X1          (X6) = MARK CHARACTER (IN ASCII) 
          SA1    RTI.B       (X1) = FIRST SOURCE WORD 
          SB2    B0          CLEAR ESCAPE FLAG
          SB3    5           (B3) = A MUCH USED CONSTANT
          SB6    B3+B3       (B6) = SOURCE UNPACKING COUNTER
  
*         GET NEXT CHARACTER AND CHECK FOR MARK.
  
 RTI4     LX1    6
          SB6    B6-B1       DECREMENT UNPACKING COUNTER
          BX2    -X0*X1      (X2) = 6 BIT DISPLAY CODE
          BX1    X0*X1       CLEAR BYTE FROM SOURCE 
 +        NZ     B6,*+1      SOURCE WORDD NOT EMPTY 
          SB6    B3+B3       RESET SOURCE UNPACKING COUNTER 
          SA1    A1+B1       (X1) = NEXT SOURCE WORD
          NZ     B2,RTI8     ALREADY IN ESCAPE SEQUENCE 
          SX7    X2-76B      CHECK FOR 76NN 
          ZR     X7,RTI6     ESCAPE CODE
          SX7    X2-74B      CHECK FOR 74NN 
          NZ     X7,RTI8     NOT ESCAPE SEQUENCE
          SX7    20          FLAG 74NN ESCAPE 
  
 RTI6     SB2    X7+20       FLAG ESCAPE SEQUENCE IN PROGRESS 
          EQ     RTI4        GOTO GET NEXT 6 BIT CODE 
  
 RTI8     NZ     X2,*+1      NOT POSSIBLE EOL 
          ZR     X1,RTI20    END OF LINE WITHOUT MARK SO IGNORE 
          SA2    X2+C2A      CONVERT TO ASCII 
          LX2    B2          ALLOW FOR ESCAPE SEQUENCE
          SB2    B0          CLEAR ESCAPE FLAG
          SX2    X2          (X2) = ASCII CODE
          BX2    X2-X6       COMPARE WITH MARK CHARACTER
          NZ     X2,RTI4     NOT MARK SO CONTINUE SEARCH
  
*         MARK FOUND SO PACK ASCII INTO INPUT BUFFER. 
  
          SX7    A0+         (X7) = FWA OF BUFFER 
          SA7    IQPTR       UPDATE POINTER 
          SB7    4           RESET PACKING COUNTER
          SA6    A0+PDATA-1  PRESET DESTINATION ADDRESS 
  
 RTI10    LX1    6
          SB6    B6-B1       DECREMENT UNPACKING COUNT
          BX2    -X0*X1      (X2) = NEXT 6 BIT DISPLAY CODE 
          BX1    X0*X1       CLEAR BYTE FROM SOURCE 
 +        NZ     B6,*+1      SOURCE WORD NOT EMPTY
          SB6    B3+B3       RESET UNPACKING SOURCE COUNT 
          SA1    A1+B1       (X1) = NEXT SOURCE WORD
          NZ     B2,RTI14    IN ESCAPE SEQUENCE 
  
          SX7    X2-76B      CHECK FOR 76NN 
          ZR     X7,RTI12    ESCAPE SEQUENCE
          SX7    X2-74B      CHECK FOR 74NN 
          NZ     X7,RTI14    NOT ESCAPE SEQUENCE
          SX7    20          FLAG ESCAPE
  
 RTI12    SB2    X7+20       FLAG WITHIN ESCAPE SEQUENCE
          EQ     RTI10       GOTO GET NEXT 6 BIT CODE 
  
 RTI14    NZ     X2,*+1      NOT POSSIBLE EOL 
          ZR     X1,RTI16    END OF PACKET
          SA2    X2+C2A      CONVERT TO ASCII 
          LX2    B2          ALLOW FOR ESCAPE CODE
          SB2    B0          CLEAR ESCAPE FLAG
          SX2    X2          (X2) = ASCII CODE
          NG     X2,RTI10    IGNORE IF ILLEGAL
          LX6    12 
          SB7    B7-B1       DECREMENT PACKING COUNTER
          BX6    X2+X6       ADD ASCII TO PACKING WORD
          NZ     B7,RTI10    PACKING WORD NOT FULL
          SA6    A6+B1       SAVE FULL WORD 
          SX6    0           CLEAR PACKING WORD 
          SB7    B3          RESET PACKING COUNTER
          EQ     RTI10       GOTO GET NEXT CHARACTER
  
*         END OF PACKET SO SAVE LAST PACKED WORD. 
  
 RTI16    SB6    B7+B7       CALCULATE SHIFT COUNT (12 * REMAINING) 
          SB7    B6+B7       *3 
          SB7    B7+B7       *6 
          SB7    B7+B7       *12
          LX6    B7          POSITION LAST WORD 
          SA6    A6+B1       SAVE 
  
*         EXTRACT AND SAVE PACKET ATTRIBUTES. 
  
          SA1    A0+PDATA    (X1) = FIRST PACKED WORD 
          LX1    12+12       IGNORE MARK
          SX2    377B 
          BX6    X1*X2       (X2) = LENGTH
          SX6    X6-32       DECHAR 
          LX1    12 
          SA6    A0+B1       SAVE LENGTH
          BX6    X1*X2       (X6) = SEQUENCE NUMBER 
          SX6    X6-32       DECHAR 
          LX1    12 
          SA6    A6+B1       SAVE SEQUENCE NUMBER 
          BX6    X1*X2       (X6) = TYPE CODE 
          SA6    A6+1        SAVE 
  
*         VALIDATE CHECKSUM.
  
 RTI18    RJ     VPC         VALIDATE PACKET CHECKSUM 
          ZR     X6,RTI19    NO ERROR 
  
*         CHECKSUM ERROR. 
  
          SA1    A0+PDATA    (X1) = FIRST DATA WORD 
          RJ     DBQ         DEBUG CHECKSUM ERROR (IF DEBUG ON) 
          MX6    0
          SA6    IQPTR       THROW AWAY INPUT PACKET
          SX6    A0          (X6) = FWA OF PACKET 
          RJ     RBF         RETURN BUFFER TO FREE QUEUE
          SX1    -1          FLAG CHECKSUM ERROR
          EQ     RTIX        EXIT 
  
*         VALID PACKET SO DEBUG IF SELECTED.
  
 RTI19    SA1    A0+PDATA    (X1) = FIRST DATA WORD 
          RJ     DBI         DDEBUG INPUT (IF DEBUG ON) 
          SA1    A0+PTYPE    (X1) = PACKET TYPE CODE
          EQ     RTIX        EXIT 
  
*         INVALID INPUT AFTER BUFFER ASSIGNED.
  
 RTI20    SB6    RTI.B       (B6) = FWA OF INPUT TEXT 
          RJ     DBL         DEBUG LOST DATA (IF DEBUG ON)
          MX6    0
          SA6    IQPTR       CLEAR INPUT QUEUE POINTER
          SX6    A0          (X6) = FWA OF ASSIGNED BUFFER
          RJ     RBF         RETURN BUFFER TO FREE QUEUE
          EQ     RTI2        GOTO CHECK FOR MORE INPUT
  
 RTI.A    BSS    1           INPUT BUFFER STATUS WORD 
 RTI.B    BSS    33          INPUT BUFFER 
          SPACE  4,10 
**        STI - SET TERMINAL INTERFACE. 
* 
*         THIS ROUTINE IS CALLED TO SET THE TERMINAL INTERFACE
*         PARAMETERS TO THOSE REQUIRED FOR TRANSFER.
* 
*         THE PARAMETERS CHANGED ARE:-
* 
*             ASCII MODE
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   TERMINAL INTERFACE SELECTED
* 
*         USES   X -
*                A -
*                B -
* 
*         CALLS 
          SPACE  4,10 
 STI      SUBR               ENTRY/EXIT 
  
          CSET   ASCII       SET TERMINAL TO ASCII MODE 
          WRITER O,R         ENSURE START OF POT
          WRITEW X2,STI.A,STI.AL
          WRITER X2,R 
 .1       IFGE   PSR,617
  
*         DISCARD ANY PENDING INPUT.
  
 STI2     SYSTEM TLX,R,STI.B,1600B
          SA1    STI.B       (X1) = INPUT AVAILABLE FLAG
          ZR     X1,STIX     NO INPUT SO EXIT 
          READC  I,FBUF,1000B READ AND IGNORE DATA
          EQ     STI2        LOOP TILL END OF DATA
 .1       ELSE
          PROMPT OFF         DISABLE INPUT PROMPT 
          EQ     STIX        EXIT 
 .1       ENDIF 
  
 STI.A    VFD    12/0016B            SET TERMINAL INTERFACE 
          VFD    12/4077B,12/4000B   EL=NO
          VFD    12/4101B,12/4001B   OC=Y 
          VFD    12/4061B,12/4000B   EP=N 
          VFD    12/4103B,12/4001B   IC=Y 
          VFD    12/4045B,12/4000B   PG=N 
          VFD    12/0                ENSURE EOL 
          IFNE   *P,60,1     ZERO FILL REMAINDER OF WORD
          VFD    *P/0 
 STI.AL   EQU    *-STI.A
 STI.B    BSS    1           INPUT AVAILABLE FLAG 
          TITLE  PACKET HANDLERS. 
**        PACKET HANDLERS.
* 
*         THE FOLLOWING ROUTINES ARE USED TO BUILD OR PROCESS 
*         PACKETS AS FOLLOWS:-
* 
*         AGP - ACK GIVEN PACKET
*         BCP - BUILD CONNECTION PARAMETERS 
*         BDP - BUILD DATA PACKET 
*         BTP - BUILD TRANSMISSION PACKET 
*         CPR - CREATE PARAMETER REPLY
*         NGP - NAK GIVEN PACKET
*         NNP - NACK NEXT PACKET
*         PPR - PROCESS PARAMETER REPLY 
*         TGP - TRANSMIT GIVEN PACKET 
*         TPK - TRANSMIT PACKET 
*         UDF - UNPACK DATA FIELD 
*         VPC - VALIDATE PACKET CHECKSUM
*         WDP - WRITE DATA PACKET 
          SPACE  4,10 
**        AGP - ACK GIVEN PACKET. 
* 
*         THIS ROUTINE TRANSMITS AN ACK PACKET FOR THE GIVEN
*         SEQUENCE NUMBER.
* 
*         ENTRY  (B1) = 1 
*                (X3) = SEQUENCE NUMBER OF PACKET TO ACK
* 
*         EXIT   PACKET ACKED 
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 5, 7.
* 
*         CALLS  BTP, RBF, TPK. 
          SPACE  4,10 
 AGP      SUBR               ENTRY/EXIT 
  
          SB5    ACK         (B5) = PACKET TYPE 
          SB7    0           (B7) = LENGTH OF DATA FIELD
          RJ     BTP         BUILD TRANSMISSION PACKET
          BX1    X6          (X1) = ATTRIBUTES
          SX6    X1          (X6) = FWA OF PACKET 
          SA6    AGP.A       SAVE 
          RJ     TPK         TRANSMIT PACKET
          SA1    AGP.A       (X1) = FWA OF ACK PACKET 
          SX6    X1+
          RJ     RBF         RETURN BUFFER TO FREE QUEUE
          EQ     AGPX       EXIT
  
 AGP.A    BSS    1           ADDRESS OF ASSIGNE PACKET
          SPACE  4,10 
**        BCP - BUILD CONNECTION PARAMETERS.
* 
*         THIS ROUTINE BUILD THE DATA PART OF AN 'ACK' OR 'S' PACKET
*         ACCORDING TO THE CURRENT PARAMETERS.
* 
*         ENTRY  (B1) = 1 
*                (B5) = PACKET CODE 
* 
*         EXIT   (B6) = FWA OF DATA STRING
*                (B7) = LENGTH OF DATA STRING 
* 
*         USES   X - 2, 3, 6. 
*                A - 2, 3, 6. 
*                B - 2, 3, 6, 7.
* 
*         CALLS  NONE.
          SPACE  4,10 
 BCP      SUBR               ENTRY/EXIT 
  
          SB6    BCP.B       (B6) = ADDRESS OF DESTINATION BUFFER 
          SA2    BCP.A       (X2) = FIRST DESCRIPTOR TABLE ENTRY
          SB3    18          ASSUME 'I' OR 'S' PACKET TYPE
          SX6    B5-ACK      CHECK TYPE 
 +        SB7    B6          (B7) = DESTINATION ADDRESS 
          NZ     X6,*+1      'I' OR 'S' PACKET
          SB3    B3+B3       USE 'ACK' PACKET 
  
*         PROCESS NEXT DESCRIPTOR.
  
 BCP2     SB2    X2          (B2) = PROCESS ADDRESS 
          AX2    B3          RIGHT JUSTIFY CODE 
          SX3    X2+         (X3) = REQUIRED CODE (OR ADDRESS)
          NG     X3,BCP4     ADDRESS GIVEN SO EXTRACT 
          JP     B2+         PROCESS ACCORDING TO TYPE
  
*         GET ADDRESSED VALUE AND LOOKUP DEFAULT IF ZERO. 
  
 BCP4     BX3    -X3         (X3) = ADDRESS 
          SA3    X3          (X3) = PARAMETER 
          NZ     X3,BCP6     VALUE DEFINED
          SX3    B5-ACK      CHECK FOR ACK
          ZR     X3,BCP14    ALL RECEIVED PARAMETERS ACKNOWLEDGED 
          SX3    B7-B6       (X3) = PARAMETER OFFSET
          SA3    BCP.C+X3    TABLE LOOKUP 
          SX3    X3 
 BCP6     JP     B2+         PROCESS
  
*         CONVERT USING CTL().
  
 BCP8     SX6    64 
          BX6    X3-X6       FORM PRINTABLE CHARACTER 
          SA2    A2+B1       (X2) = NEXT TABLE ENTRY
          SA6    B7          SAVE CHARACTER 
          SB7    B7+B1       INCREMENT POINTER
          NZ     X2,BCP2     LOOP TILL END OF TABLE 
          EQ     BCP14       END OF TABLE SO EXIT 
  
*         CONVERT USING CHAR(). 
  
 BCP10    SX6    X3+32       CONVERT TO PRINTABLE FORM
          SA2    A2+1        (X2) = NEXT TABLE ENTRY
          SA6    B7          SAVE CHARACTER 
          SB7    B7+B1       INCREMENT POINTER
          NZ     X2,BCP2     NOT END OF TABLE 
          EQ     BCP14       END OF TABLE SO EXIT 
  
*         CONVERT TO ASCII NUMBER (CHKT). 
  
 BCP11    NZ     X3,*+1      DEFINED
          SX3    1           FORCE MINIMUM
          SX6    X3+48       CONVERT TO NUMBER
          SA2    A2+1        (X2) = NEXT TABLE ENTRY
          SA6    B7          SAVE 
          SB7    B7+B1       INCREMENT POINTER
          EQ     BCP2        GOTO PROCESS NEXT TABLE ENTRY
  
*         NO CONVERSION REQUIRED. 
  
 BCP12    MX6    -8 
          BX6    -X6*X3      (X6) = CHARACTER 
          SA2    A2+B1       (X2) = NEXT TABLE ENTRY
          SA6    B7          SAVE CHARACTER 
          SB7    B7+1        INCREMENT POINTER
          NZ     X2,BCP2     NOT END OF TABLE 
          EQ     BCP14       END OF TABLE SO EXIT 
  
*         CAPABILITY BYTE(S). 
  
 BCP13    MX6    -5 
          BX6    -X6*X3      (X6) = NEXT BYTES WORTH
          AX3    5           DELETE FROM SOURCE 
          LX6    1
 +        ZR     X3,*+1      NO CONTINUATION
          SX6    X6+1        FLAG CONTINUATIION 
          SB7    B7+B1       INCREMENT DESTINATION ADDRESS
          SX6    X6+32       CHAR() 
          SA6    B7-B1       SAVE 
          NZ     X3,BCP13    LOOP FOR ALL BYTES 
          SA2    A2+1        (X2) = NEXT TABLE ENTRY
          NZ     X2,BCP2     LOOP TILL END OF TABLE 
          EQ     BCP14       END OF TABLE SO EXIT 
  
*         ADD WINDOW SIZE.
  
 BCP13A   SA1    CAPAS       (X1) = CAPABILITY MASK 
          LX1    59-1        CHECK IF WINDOWING REQUIRED
          NG     X1,BCP10    CHAR CHARACTER 
          SA2    A2+1        (X2) = NEXT TABLE ENTRY
          NZ     X2,BCP2     LOOP TILL END OF TABLE 
*         EQ     BCP14       EXIT 
  
*         END OF TABLE SO CALCULATE LENGTH AND EXIT.
  
 BCP14    SB7    B7-B6       (B7) = STRING LENGTH 
          EQ     BCPX        EXIT 
  
 BCP.A    BSS    0           PARAMETER DESCRIPTOR TABLE 
          VFD    6/0,18/94,18/94,18/BCP10       MAXL
          VFD    6/0,18/5,18/5,18/BCP10         TIME
          VFD    6/0,18/0,18/0,18/BCP10         NPAD
          VFD    6/0,18/0,18/0,18/BCP8          PADC
          VFD    6/0,18/015B,18/015B,18/BCP10   EOL 
          VFD    6/0,18/043B,18/043B,18/BCP12   QCTL
          VFD    6/0,18/-QBIN,18/046B,18/BCP12  QBIN
          VFD    6/0,18/-CHKT,18/1,18/BCP11  CHKT 
          VFD    6/0,18/-REPT,18/176B,18/BCP12  REPT
          VFD    6/0,18/-CAPAS,18/-CAPAS,18/BCP13    CAPAS
          VFD    6/0,18/-WSIZE,18/-RWSIZE,18/BCP13A  WINDOW 
          CON    0
 BCP.B    BSS    20          DATA BUFFER
 BCP.C    BSS    0           DEFAULT VALUE TABLE
          CON    94          MAXL 
          CON    5           TIME 
          CON    0           NPAD 
          CON    0           PADC 
          CON    015B        EOL
          CON    043B        QCTL 
          CON    116B        QBIN 
          CON    1           CHKT 
          CON    040B        REPT 
          CON    2           CAPAS
          CON    8           WINDOW 
          SPACE  4,10 
**        BDP - BUILD DATA PACKET.
* 
*         THIS ROUTINE READS DATA FROM THE CURRENT FILE AND BUILDS
*         A DATA PACKET. IF THERE IS NOT DATA AVAILABLE AN EXIT FLAG
*         IS SET TO INDICATE EOF. 
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   DATA PACKET BUILT
* 
*         USES   X -
*                A -
*                B -
* 
*         CALLS  GNC. 
          SPACE  4,10 
 BDP      SUBR               ENTRY/EXIT 
  
*         PRESET COUNTERS.
  
          SB2    BDP.A       (B2) = FWA OF BUFFER 
          SA1    MAXL        (X1) = MAXIMUM PACKET LENGTH 
          SB3    0           CLEAR DATA COUNT 
          SB4    X1-3        (B4) = DATA LENGTH 
          SA1    BDP.B       (X1) = SAVED CHARACTER 
          BX6    X1          (X6) = SAVED CHARACTER (IF ANY)
          SA1    A1+B1       (X1) = COUNT MASK
          NZ     X6,BDP2A    PENDING CHARACTER
  
*         GET NEXT CHARACTER. 
  
 BDP2     RJ     GNC         GET NEXT CHARACTER 
          NZ     X1,BDP8     END OF DATA
          SA1    BDP.C       (X1) = COUNT MASK
  
*         CHECK NUMBER OF CHARACTERS TO DEFINE. 
  
 BDP2A    BX1    X1*X6       CHECK NUMBER OF CHARACTERS 
          CX1    X1          (X1) = NUMBER OF CHARACTERS TO SAVE
          SB7    X1          (B7) = COUNT 
          SB3    B3+B7       CHECK IF ROOM
          GE     B3,B4,BDP4  NO ROOM
  
*         SAVE CHARACTERS.
  
          SX1    377B 
  
 BDP3     BX7    X1*X6       (X7) = NEXT CHARACTER
          SB7    B7-1        DECREMENT COUNT
          SA7    B2          SAVE 
          AX6    12 
          SB2    B2+B1
          NZ     B7,BDP3     LO0P FOR ALL CHARACTERS
          EQ     BDP2        GOTO GET NEXT CHARACTER
  
*         NOT ENOUGH ROOM SO SAVE.
  
 BDP4     SA6    BDP.B       SAVE CHARACTER 
          SB5    DATA        (B5) = REQUIRED PACKET TYPE
          SB6    BDP.A       (B6) = FWA OF DATA 
          MX3    59          FLAG NEXT SEQUENCE NUMBER
          SB7    B3-B7       (B7) = DATA BYTE COUNT 
          RJ     BTP         BUILD TRANSMISSION PACKET
          EQ     BDPX        EXIT 
  
*         END OF DATA SO SAVE PARTIAL BLOCK (IF ANY). 
  
 BDP8     MX6    0
          SB7    B0          ASSUME ZERO LENGTH DATA
          SA6    BDP.B       CLEAR PENDING CHARACTER
          NZ     B3,BDP4     SOME DATA ALREADY SAVED
          EQ     BDPX        EXIT 
  
 BDP.A    BSS    94          MAXIMUM DATA SIZE
 BDP.B    CON    0           LAST DATA BYTE 
 BDP.C    CON    40004000400040004000B
          SPACE  4,10 
**        BTP - BUILD TRANSMISSION PACKET.
* 
*         THIS ROUTINE TAKES THE GIVEN DATA AND BUILDS THE
*         REQUIRED PACKET FROM IT. THIS ROUTINE SHOULD ONLY 
*         BE CALLED IF THERE IS SPACE TO PUT THE PACKET.
* 
*         ENTRY  (B1) = 1 
*                (B5) = PACKET TYPE CODE
*                (B6) = FWA OF DATA STRING (IF REQUIRED)
*                (B7) = LENGTH OF DATA STRING 
*                (X3) = REQUIRED SEQUENCE NUMBER (OR -VE FOR NEXT)
* 
*         EXIT   (X6) = PACKET ATTRIBUTES 
*                              6/0,9/LEN,9/0,9/0,9/SEQ,18/ADR 
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7. 
*                B - 2. 
* 
*         CALLS  AFB. 
          SPACE  4,10 
 BTP      SUBR               ENTRY/EXIT 
  
*         ALLOCATE SPACE FOR PACKET.
  
          RJ     AFB         ALLOCATE OUTPUT BUFFER 
          MX6    0           ASSUME ERROR 
          ZR     X1,BTPX     NO PACKET SO EXIT
          SX0    A6          (X0) = FWA OF PACKET 
  
*         SET UP PACKET HEADER WITH PADDING IF REQUIRED.
  
          SX6    7           (X6) = BINARY OUTPUT REQUEST 
          SA1    NPAD        (X1) = NUMBER OF PADDING CHARACTERS REQUIRE
          SB2    4           RESET PACKING COUNTER
          ZR     X1,BTP6     NO PADDING REQUIRED
          SA2    PADC        (X2) = PADDING CHARACTER 
          SX2    X2+4000B    FORCE TOP BIT SET
  
 BTP2     LX6    12 
          SX1    X1-1        DECREMENT PADDING CHARACTER COUNT
          BX6    X2+X6       ADD PADDING CHARACTER
          SB2    B2-B1       DECREMENT PACKING COUNTER
          NZ     B2,BTP4     PACKING WORD NOT FULL
          SA6    A6+B1       SAVE FULL FORD 
          SB2    5           RESET PACKING COUNTER
          SX6    0           CLEAR PACKING WORD 
  
 BTP4     NZ     X1,BTP2     LOOP FOR ALL PADDING CHARACTERS
  
*         ADD START OF PACKET HEADER. 
  
 BTP6     SA1    MARK        (X1) = PACKET MARKER 
          SX1    X1+4000B    SET TOP BIT
          LX6    12 
          SB2    B2-1        DECREMENT PACKING COUNTER
          BX6    X1+X6       ADD MARK 
          NZ     B2,BTP8     PACKING WORD NOT FULL
          SA6    A6+1        SAVE FULL WORD 
          SB2    5           RESET PACKING COUNTER
          SX6    0           CLEAR PACKING WORD 
  
*         ADD PACKET LENGTH.
  
 BTP8     LX6    12 
          SX2    B7+4043B    CONVERT LENGTH TO PRINTABLE FORM 
          SB2    B2-B1       DECREMENT PACKING COUNTER
          BX6    X2+X6       ADD LENGTH 
          NZ     B2,BTP10    NOT FULL WORD
          SA6    A6+B1       SAVE FULL WORD 
          SB2    5           RESET PACKING COUNTER
          SX6    0           CLEAR PACKING WORD 
  
*         GET AND UPDATE SEQUENCE NUMBER. 
  
 BTP10    PL     X3,BTP12    SEQUENCE NUMBER DEFINED
          SA3    SEQ         (X3) = SEQUENCE NUMBER 
          MX1    -6 
          SX7    X3+B1       INCREMENT
          BX7    -X1*X7      ENSURE 6 BITS
          SA7    A3          REPLACE
  
 BTP12    BX7    X3          (X7) = SEQUENCE NUMBER 
          SX3    X3+4040B    ENSURE PRINTABLE 
          LX7    18          POSITION FOR ATTRIBUTE WORD
          SB2    B2-B1       DECREMENT PACKING COUNTER
          LX6    12 
          BX0    X0+X7       ADD SEQUENCE NUMBER TO ATTRIBUTE WORD
          BX6    X3+X6       ADD SEQUENCE NUMBER TO PACKING WORD
          IX7    X2+X3       INITIALISE CHECKSUM
          NZ     B2,BTP14    PACKING WORD NOT FULL
          SA6    A6+B1       SAVE FULL WORD 
          SB2    5           RESET PACKING COUNTER
          SX6    0           CLEAR PACKING WORD 
  
*         ADD PACKET TYPE.
  
 BTP14    LX6    12 
          SA1    BTP.A+B5    CONVERT TO ASCII CODE
          SB2    B2-B1       DECREMENT PACKING COUNTER
          IX7    X1+X7       AD TYPE CODDE TO CHECKSUM
          BX6    X1+X6       ADD PACKET TYPE
          NZ     B2,BTP16    PACKING WORD NOT FULL
          SA6    A6+B1       SAVE FULL WORD 
          SB2    5           RESET PACKING COUNTER
          MX6    0           CLEAR PACKING WORD 
  
*         COPY DATA (IF ANY). 
  
 BTP16    ZR     B7,BTP22    NO DATA FIELD
          SA1    B6+         (X1) = FIRST DATA BYTE 
  
 BTP18    LX6    12 
          SX1    X1+4000B    SET TOP BIT
          IX7    X1+X7       ADD TO CHECKSUM
          SB2    B2-B1       DECREMENT PACKING COUNTER
          BX6    X1+X6       ADD TO PACKING WORD
          NZ     B2,BTP20    PACKING WORD NOT FULL
          SA6    A6+B1       SAVE FULL WORD 
          SB2    5           RESET PACKING COUNTER
          MX6    0           CLEAR PACKING WORD 
  
 BTP20    SB7    B7-B1       DECREMENT CHARACTER COUNT
          SA1    A1+B1       (X1) = NEXT CHARACTER
          NZ     B7,BTP18    LOOP TILL END OF DATA
  
*         CALCULATE AND ADD CHECKSUM (TYPE 1).
  
 BTP22    SX3    77B
          BX1    X3*X7       (X1) = L.O. 6 BITS 
          AX7    6
          MX2    -2 
          BX2    -X2*X7      (X2) = H.O. 2 BITS 
          IX1    X1+X2       (X1) = CHECKSUM
          BX1    X1*X3      ENSURE 6 BIT RESULT 
          SX1    X1+4040B    MAKE PRINTABLE 
          LX6    12 
          BX6    X1+X6       ADD CHECKSUM 
          GT     B2,B1,BTP24 PACKING WORD NOT FULL
          SA6    A6+B1       SAVE FULL WORD 
          SB2    5+1         RESET PACKING COUNTER
          MX6    0           CLEAR PACKING WORD 
  
*         ADD REQUIRED TERMINATION CHARACTER. 
  
 BTP24    SB2    B2-2        DECREMENT PACKING COUNTER
          SA1    EOL         (X1) = REQUIRED END OF LINE CHARACTER
          LX6    12 
          SX1    X1+4000B    SET TOP BIT
          BX6    X1+X6       ADD TO PACKING WORD
 +        NZ     B2,*+1      PACKING WORD NOT FULL
          SA6    A6+B1       SAVE FULL WORD 
          MX6    0           CLEAR PACKING WORD 
  
*         LEFT JUSTIFY AND SAVE LAST WORD.
  
          SB7    B2+B2       CALCULATE 12 * REMAINING CHARACTER COUNT 
          SB7    B2+B7       *3 
          SB7    B7+B7       *6 
          SB7    B7+B7       *12
          LX6    B7          LEFT JUSTIFY LAST WORD 
          SB6    X0+         (B6) = FWA OF PACKET 
          SA6    A6+B1       SAVE LAST WORD 
  
*         CALCULATE AND SAVE PACKET LENGTH IN WORDS.
  
          SB7    A6          (B7) = LWA 
          SX6    B7-B6       (X6) = PACKET LENGTH 
          LX6    18+9+9+9    POSITION FOR ATTRIBUTE WORD
          BX6    X0+X6       ADD TO ATTRIBUTES
          EQ     BTPX        EXIT 
  
 BTP.A    BSS    0           PACKET TYPE TO ASCII CHARACTER TABLE 
          LOC    0
          CON    4040B       COMPLETE 
          CON    4040B       TIMEOUT
          CON    4104B       DATA 
          CON    4131B       ACK
          CON    4116B       NAK
          CON    4123B       SENDI
          CON    4102B       BREAK
          CON    4106B       FILE HEADER
          CON    4132B       END OF FILE
          CON    4105B       ERROR
          CON    4122B       RECEIVE
          CON    4107B       GENERIC COMMAND
          CON    4111B       INIT 
          CON    4130B       TYPE 
          LOC    *O 
          SPACE  4,10 
**        CPR - CREATE PARAMETER REPLY. 
* 
*         THIS ROUTINE IS CALLED TO PROCESS A RECEIVED 'S' PACKET 
*         AND GENERATE THE REQUIRED REPLY.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT
* 
*         USES   X -
*                A -
*                B -
* 
*         CALLS 
          SPACE  4,10 
 CPR      SUBR               ENTRY/EXIT 
  
*         PROCESS 'S' OR 'I' PARAMETERS.
  
          RJ     PPR         PROCESS PARAMETER REPLY
  
*         BUILD 'ACK' PACKET. 
  
          SB5    ACK         (B5) = REQUIRED PACKET TYPE
          RJ     BCP         BUILD CONNECTION PARAMETERS
          SX6    B0          CLEAR CURRENNT SEQUENCE NUMBER 
          MX3    59          FLAG NEXT
          SA6    SEQ         CLEAR
          RJ     BTP         BUILD TRANSMISSION PACKET
          BX1    X6 
          RJ     TPK         TRANSMIT PACKET
          EQ     CPRX        EXIT 
          SPACE  4,10 
**        NGP - NAK GIVEN PACKET. 
* 
*         THIS ROUTINE TRANSMITS A NAK PACKET FOR THE GIVEN 
*         SEQUENCE NUMBER.
* 
*         ENTRY  (B1) = 1 
*                (X3) = SEQUENCE NUMBER OF PACKET TO NAK
* 
*         EXIT   PACKET NAKED 
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 5, 7.
* 
*         CALLS  BTP,RBF,TPK. 
          SPACE  4,10 
 NGP      SUBR               ENTRY/EXIT 
  
          SB5    NAK         (B5) = PACKET TYPE 
          SB7    0           (B7) = LENGTH OF DATA FIELD
          RJ     BTP         BUILD TRANSMISSION PACKET
          BX1    X6          (X1) = ATTRIBUTES
          SX6    X1          (X6) = FWA OF PACKET 
          SA6    NGP.A       SAVE 
          RJ     TPK         TRANSMIT PACKET
          SA1    NGP.A       (X1) = FWA OF PACKET 
          SX6    X1+
          RJ     RBF         RETURN BUFFER TO FREE QUEUE
          EQ     NGPX        EXIT 
  
 NGP.A    BSS    1           ADDRESS OF ASSIGNED PACKET 
          SPACE  4,10 
**        NNP - NAK NEXT PACKET.
* 
*         THIS ROUTINE IS USED TO OUTPUT A NAK PACKET WHEN A DATA 
*         PACKET IS RECEIVED WHICH IS OUT OF SEQUENCE.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   NAK PACKET TRANSMITTED 
* 
*         USES   X -
*                A -
*                B -
* 
*         CALLS  SRP. 
          SPACE  4,10 
 NNP      SUBR               ENTRY/EXIT 
  
          SB5    NAK         (B5) = PACKET TYPE 
          SA3    LASTSEQ     (X3) = LAST SEQUENCE NUMBER
          SB7    B0          NO DATA
          SX3    X3+B1       INCREMENT SEQUENCE NUMBER
          MX6    -6 
          BX3    -X6*X3      ENSURE 6 BIT 
          RJ     BTP         BUILD TRANSMISSION PACKET
          SX7    X6+         (X7) = FWA OF PACKET 
          SA7    NNP.A       SAVE 
          RJ     SRP         SEND RECEIVED PACKET 
          SA1    NNP.A       (X1) = FWA OF PACKET 
          SX6    X1+
          RJ     RBF         RETURN BUFFER TO FREE QUEUE
          EQ     NNPX        EXIT 
  
 NNP.A    BSS    1           BUFFER ADDRESS 
          SPACE  4,10 
**        PPR - PROCESS PARAMETER REPLY.
* 
*         THIS ROUTINE IS CALLED TO PROCESS THE DATA FIELD OF 
*         AN 'ACK' PACKET WHICH IS THE RESPONSE TO EITHER AN
*         'I' OR AN 'S' PACKET. 
* 
*         ENTRY  (B1) = 1 
*                (IQPTR) = FWA OF ACK PACKET
* 
*         EXIT   PARAMETERS PROCESSED 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6. 
*                B - 2, 6, 7. 
* 
*         CALLS  BPW. 
          SPACE  4,10 
 PPR      SUBR               ENTRY/EXIT 
  
*         GET DATA LENGTH AND FIRST DATA ENTRY. 
  
          SA2    IQPTR       (X2) = INPUT QUEUE POINTER 
          SA2    X2+PLEN     (X2) = PACKET LENGTH 
          SB7    X2-3        (B7) = LENGTH OF DATA FIELD
          SA1    A2-PLEN+PDATA PRESET (A1)
          SB6    B1          (B6) = UNPACKING COUNTER 
          LX1    60-12       POSITION FIRST DATA BYTE 
          SA2    PPR.A       (X2) = FIRST VALIDATION TABLE ENTRY
  
*         GET NEXT DATA BYTE AND VALIDATE.
  
 PPR2     SX3    0           ASSUME END OF DATA 
          LE     B7,B0,PPR3A ASSUMPTION CORRECT 
          NZ     B6,PPR3     NOT END OF SOURCE WORD 
          SA1    A1+1        (X1) = NEXT SOURCE WORD
          SB6    5           RESET UNPACKING COUNTER
  
 PPR3     LX1    12 
          MX3    -7 
          SB6    B6-B1       DECREMENT UNPACKING COUNTER
          BX3    -X3*X1      (X3) = NEXT DATA BYTE
  
 PPR3A    SB2    X2          (B2) = PROCESS ADDRESS 
          SB7    B7-1        DECREMENT AVAILABLE DATA COUNT 
          AX2    18 
          JP     B2+         BRANCH ACCORDING TO CHARACTER CODING.
  
*         CHARACTER NOT ENCODED.
  
 PPR4     SX6    X3          (X6) = CHARACTER FROM PACKET 
          NZ     X3,*+1      DATA VALID 
          SX6    X2          USE DEFAULT FROM TABLE 
          AX2    18 
          SA6    X2+         SAVE 
          SA2    A2+B1       (X2) = NEXT VALIDATION TABLE ENTRY 
          NZ     X2,PPR2     MORE ENTRIES REQUIRED
          EQ     PPR10       END OF TABLE 
  
*         CHARACTER ENCODED USING CTL().
  
 PPR6     SX6    64 
          BX6    X3-X6       UNCTL BYTE FROM PACKET 
 +        NZ     X3,*+1      DATA VALID 
          SX6    X2+         USE DEFAULT FROM TABLE 
          AX2    18 
          SA6    X2+         SAVE 
          SA2    A2+B1       (X2) = NEXT VALIDATION TABLE ENTRY 
          NZ     X2,PPR2     MORE ENTRIES REQUIRED
          EQ     PPR10       END OF TABLE 
  
*         CHARACTER ENCODED USING CHAR(). 
  
 PPR8     NZ     X3,*+1      VALUE FROM PACKET VALID
          SX3    X2+32       USE DEFAULT FROM TABLE 
          AX2    18 
          SX6    X3-32       (X6) = REQUIRED CODE 
          SA6    X2          SAVE 
          SA2    A2+1        (X2) = NEXT TABLE ENTRY
          NZ     X2,PPR2     MORE ENTRIES REQUIRED
  
*         PROCESS OPTIONAL FIELDS.
  
 PPR10    SX6    0
          SA2    PPR.B       (X2) = FIRST ENTRY OF BRANCH TABLE 
          SA6    CAPAS       CLEAR CAPABILITY BYTE
  
 PPR12    LE     B7,B0,PPR15 NO MORE DATA 
          NZ     B6,PPR14    NOT END OF SOURCE WORD 
          SB6    5           RESET UNPACKING COUNTER
          SA1    A1+1        (X1) = NEXT SOURCE WORD
  
*         PROCESS OPTION. 
  
 PPR14    LX1    12 
          MX3    -7 
          SB6    B6-B1       DECREMENT UNPACKING COUNTER
          BX3    -X3*X1      (X3) = NEXT DATA BYTE
          SB2    X2          (B2) = PROCESS ADDRESS 
          SB7    B7-1        DECREMENT REMAINING DATA COUNT 
          AX2    18 
          JP     B2+         PROCESS
  
*         END OF DATA SO USE DEFAULT FROM TABLE.
  
 PPR15    SB2    X2          (B2) = PROCESS ADDRESS 
          AX2    18 
          SX3    X2+         (X3) = DEFAULT 
          JP     B2+         PROCESS
  
*         'QBIN'. 
  
 PPR16    SX3    X3-116B     CHECK FOR 'N'
          ZR     X3,PPR18    NO 8 BIT QUOTING 
          SX3    X3+116B     RESTORE CHARACTER
          SX6    X3-131B     CHECK FOR 'Y'
          NZ     X6,PPR18    QUOTE CHARACTER DEFINED
          SX3    046B        USE DEFAULT CHARACTER '&'
  
 PPR18    BX6    X3          (X6) = CHARACTER 
          SA6    QBIN        SAVE 
          SA2    A2+B1       (X2) = NEXT TABLE ENTRY
          EQ     PPR12       LOOP FOR ALL BYTES 
  
*         'CHKT'. 
  
 PPR20    SX6    B1 
          SA6    CHKT        FORCE MINIMAL CHECKSUM TYPE
          SA2    A2+B1       (X2) = NEXT TABLE ENTRY
          EQ     PPR12       LOOP FOR ALL BYTES 
  
*         'REPT'. 
  
 PPR22    SX6    X3-32       CHECK FOR SPACE
          ZR     X6,PPR24    NO REPEAT PREFIXING
          BX6    X3 
          SA3    REPT        (X3) = CURRENT REPEAT CHARACTER
          MX2    -11
          BX3    -X2*X3      ENSURE TOP BIT CLEAR 
          BX2    X3-X6       COMPARE
          ZR     X3,PPR24    FIRST DEFINITION SO USE
          ZR     X2,PPR24    SAME DEFINITION SO USE 
          SX6    0           DISABLE REPEAT PREFIXING 
  
 PPR24    ZR     X6,*+1      NOT DEFINED
          SX6    X6+4000B    SET TOP BIT
          SA6    REPT        SAVE 
          SA2    A2+1        (X2) = NEXT TABLE ENTRY
          EQ     PPR12       LOOP FOR ALL BYTES 
  
*         'CAPAS'.
  
 PPR26    SX3    X3-32       DECHR()
          LX3    59-0        LEFT JUSTIFY CONTINUATION FLAG 
          MX2    -5 
          SA4    CAPAS       (X4) = CURRENT CAPABILTY BITS
          BX6    -X2*X4      (X6) = SHIFT COUNT 
          BX4    X4-X6       (X4) = REMAINDER 
          SX6    X6+B1       INCREMENT SHIFT COUNT
          SB2    X6          CONVERT TO BIT COUNT (* 5) 
          SB2    B2+B2       *2 
          SB2    B2+B2       *4 
          SB2    X6+B2       *5 
          BX2    -X2*X3      (X2) = DATA BITS 
          LX2    B2          POSITION 
          BX6    X2+X6       ADD TO SHIFT COUNT 
          BX6    X4+X6       ADD DATA BITS
          SA6    A4          SAVE 
          NG     X3,PPR12    CONTINUATION 
  
*         NO MORE CONTINUATION BYTES SO PROCESS.
  
          SX4    2           MASK FOR 'WINDOW' FLAG 
          AX6    5           CLEAR SHIFT COUNT
          BX6    X4*X6       ALLOW ONLY WINDOWING 
          SA6    A4           UPDATE CAPABILITY BYTE
          SA2    A2+B1       INCREMENT TABLE ADDRESS
          NZ     X6,PPR12    WINDOWING REQUESTED
          SA6    WSIZE       CLEAR WINDOWING
          EQ     PPR99       EXIT 
  
*         WINDOW SIZE DEFINITION. 
  
 PPR28    SX6    X3-32       DECHAR 
          SX3    37B
          BX6    X3*X6       ENSURE VALID 
          SA3    RWSIZE      (X3) = REQUESTED WINDOW SIZE 
          IX7    X3-X6       COMPARE
 +        PL     X7,*+1      USE VALUE FROM PACKET
          SX6    X3+         USE PARAMETER SPECIFIED VALUE
          SA6    WSIZE       SAVE USED WINDOW SIZE
          EQ     PPR99       EXIT 
  
*         BUILD PREFIX WORDS. 
  
 PPR99    RJ     BPW         BUILD PREFIX WORDS 
          EQ     PPRX        EXIT 
  
 PPR.A    BSS    0           PARAMETER VALIDATION TABLE 
          VFD    6/0,18/MAXL,18/80,18/PPR8     MAX. PACKET LENGTH 
          VFD    6/0,18/TIMER,18/5,18/PPR8     TIMEOUT VALUE
          VFD    6/0,18/NPAD,18/0,18/PPR8      PADDING COUNT
          VFD    6/0,18/PADC,18/0,18/PPR6      PADDING CHARACTER
          VFD    6/0,18/EOL,18/015B,18/PPR8    END OF LINE CHAR.
          VFD    6/0,18/RXQCTL,18/043B,18/PPR4 CTL QUOTE CHAR.
          CON    0
 PPR.B    BSS    0           OPTIONAL PARAMETER VALIDATION TABLE
          VFD    24/0,18/116B,18/PPR16  'QBIN'
          VFD    24/0,18/61B,18/PPR20   'CHKT'
          VFD    24/0,18/32,18/PPR22    'REPT'
          VFD    24/0,18/32,18/PPR26    'CAPAS' 
          VFD    24/0,18/32,18/PPR28    'WINDOW'
          SPACE  4,10 
**        TGP - TRANSMIT GIVEN PACKET.
* 
*         THIS ROUTINE TAKES THE GIVEN ATTRIBUTE WORD, ADDS IT
*         TO THE WINDOW TABLE AND TRANSMITS THE CORRESPONDING PACKET. 
* 
*         ENTRY  (B1) = 1 
*                (X6) = PACKET ATTRIBUTE WORD 
* 
*         EXIT   ENTRY MADE IN WINDOW TABLE 
*                PACKET TRANSMITTED 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 6, 7.
*                B - 2, 3, 4, 6, 7. 
* 
*         CALLS  TPK. 
          SPACE  4,10 
 TGP      SUBR               ENTRY/EXIT 
  
*         EXTRACT WINDOW POINTERS.
  
          SA1    WPTR        (X1) = WINDOW POINTER
          SB4    X1          (B4) = LIMIT 
          AX1    18 
          SB3    X1          (B3) = OUT 
          AX1    18 
          SB2    X1          (B2) = IN
          AX1    18          (X1) = AVAILABLE WINDOW
  
*         SET RETRY COUNTER AND SAVE ENTRY IN WINDOW TABLE. 
  
          SA2    RETRY       (X2) = MAX. RETRY COUNT
          LX2    18+9+9      POSITION 
          BX6    X2+X6       ADD TO ATTRIBUTE WORD
          SA6    WTABLE+B2   SAVE IN WINDOW TABLE 
  
*         UPDATE WINDOW POINTERS. 
  
          SX6    X1-1        DECREMENT AVAILABLE WINDOW 
 +        SB2    B2+B1       INCREMENT IN 
          NE     B2,B4,*+1   NOT LIMIT
          SB2    B0          SET IN = FIRST 
  
*         UPDATE POINTER WORD.
  
          LX6    18 
          SX1    B2          (X1) = IN
          BX6    X1+X6
          SX1    B3          (X1) = OUT 
          LX6    18 
          BX6    X1+X6
          SX1    B4          (X1) = LIMIT 
          LX6    18 
          BX7    X1+X6       (X7) = REQUIRED POINTER WORD 
          SA7    A1+         SAVE 
  
*         TRANSMIT PACKET.
  
          SA1    A6          (X1) = ATTRIBUTE WORD
          RJ     TPK         TRANSMIT PACKET
          EQ     TGPX        EXIT 
  
          SPACE  4,10 
**        TPK - TRANSMIT PACKET.
* 
*         THIS ROUTIINE TRANSMITS THE GIVEN PACKET. 
* 
*         ENTRY  (X1) = CURRENT POINTER WORD
* 
*         EXIT   PACKET TRANSMITTED 
* 
*         USES   X - 1, 6, 7. 
*                A - 1, 6.
*                B - 6, 7.
* 
*         CALLS  CIO=, DBO, WTW=. 
          SPACE  4,10 
 TPK      SUBR               ENTRY/EXIT 
  
          SB6    X1+B1       (B6) = FWA OF DATA PACKET
          MX7    -9 
          AX1    18+9+9+9    RIGHT JUSTIFY PACKET LENGTH
          BX7    -X7*X1 
          SB7    X7+         (B7) = PACKET LENGTH 
  
*         CHECK IF DEBUG SELECTED.
  
          SA1    DEBUG       (X1) = DEBUG FLAG
          ZR     X1,TPK2     DEBUG OFF
  
          SX6    B6+         (B6) = FWA OF TEXT 
          LX6    18 
          BX6    X6+X7       (X6) = 24/0,18/FWA,18/LEN
          SA6    TPK.A       SAVE 
          SA1    B6          (X1) = FIRST PACKED WORD 
          RJ     DBO         DEBUG OUTPUT 
          SA1    TPK.A       (X1) = POINTER WORD
          SB7    X1+         RESTORE LENGTH 
          AX1    18 
          SB6    X1          RESTORE FWA
  
*         WRITE PACKET TO TERMINAL. 
  
 TPK2     WRITEW ZZZZZOU,B6,B7 WRITE LINE 
          WRITER X2          FLUSH BUFFER 
          EQ     TPKX        EXIT 
  
 TPK.A    BSS    1           POINTER WORD 
          SPACE  4,10 
**        UDF - UNPACK DATA FIELD.
* 
*         THIS ROUTINE UNPACKS THE DATA FIELD OF THE SPECIFIED
*         PACKET ACCOUNTING FOR CONTROL AND PREFIX CHARACTERS.
* 
*         ENTRY  (B1) = 1 
*                (X1) = FWA OF PACKET 
* 
*         EXIT   (B6) = FWA OF ASCII STRING 
*                (B7) = LENGTH OF STRING
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 6. 
*                B - 2, 3, 4, 5, 6, 7.
* 
*         CALLS  NONE.
          SPACE  4,10 
 UDF      SUBR               ENTRY/EXIT 
  
*         INITIALISE. 
  
          SA1    X1+PLEN     (X1) = PACKET LENGTH 
          SB7    X1-3        (B7) = DATA LENGTH 
          LE     B7,B0,UDF20 ILLEGAL
          SA1    A1-PLEN+PDATA (X1) = FIRST DATA WORD 
          SB5    B1          (B5) = UNPACKING COUNTER 
          LX1    60-12       POSITION FIRST DATA BYTE 
          SA2    RXPWORD     (X2) = RX PREFIX WORD
          SB2    X2          (B2) = -REPEAT COUNT PREFIX
          AX2    30 
          SB3    X2          (B3) = -8 BIT PREFIX 
          AX2    30 
          SB4    X2          (B4) = -CONTROL PREFIX 
          MX7    -8 
          SB6    UDF.A       (B6) = DESTINATION ADDRESS 
  
*         EXTRACT NEXT CHARACTER. 
  
 UDF2     LX1    12 
          SX0    B1          ASSUME NO REPEAT COUNT 
          BX2    -X7*X1      (X2) = NEXT ASCII CODE 
          SB7    B7-B1       DECREMENT AVAILABLE CHARACTER COUNT
          SB5    B5-B1       DECREMENT UNPACKING COUNTER
          SX6    X2+B2       CHECK FOR REPEAT PREFIX
          NZ     X6,UDF8     NO REPEAT PREFIX 
  
*         PROCESS REPEAT PREFIX.
  
          ZR     B7,UDF20    ILLEGAL PACKET STRUCTURE 
          NZ     B5,UDF4     SOURCE WORD NOT EMPTY
          SB5    5           RESET UNPACKING COUNTER
          SA1    A1+1        (X1) = NEXT SOURCE WORD
  
 UDF4     LX1    12 
          SB5    B5-1        DECREMENT UNPACKING COUNTER
          BX2    -X7*X1      (X2) = NEXT ASCII CHARACTER
          SX0    X2-32       DE-CHAR
          ZR     B7,UDF20    ILLEGAL PACKET STRUCTURE 
          SB7    B7-1        DECREMENT AVAILABLE CHARACTER COUNT
          NZ     B5,UDF6     SOURCE WORD NOT EMPTY
          SB5    5           RESET UNPACKING COUNTER
          SA1    A1+1        (X1) = NEXT SOURCE WORD
  
 UDF6     LX1    12 
          SB5    B5-1        DECREMENT UNPACKING COUNTER
          BX2    -X7*X1      (X2) = NEXT ASCII CHARACTER
          ZR     B7,UDF20    ILLEGAL PACKET STRUCTURE 
          SB7    B7-1        DECREMENT AVAILABLE CHARACTER COUNT
  
*         CHECK FOR 8 BIT PREFIX. 
  
 UDF8     SX6    X2+B3       CHECK FOR 8 BIT PREFIX 
          MX3    0           ASSUME NO PREFIX 
          NZ     X6,UDF12    ASSUMPTION CORRECT 
          ZR     B7,UDF20    ILLEGAL PACKET STRUCTURE 
          ZR     B5,UDF10    SOURCE WORD NOT EMPTY
          SB5    5           RESET UNPACKING COUNTER
          SA1    A1+1        (X1) = NEXT SOURCE WORD
  
 UDF10    LX1    12 
          SB6    B6-1        DECREMENT UNPACKING COUNTER
          BX2    -X7*X1      (X2) = NEXT ASCII CODE 
          SB7    B7-1        DECREMENT AVAILABLE CHARACTER COUNT
          SX3    200B        FLAG 8 BIT SET 
  
*         CHECK FOR CONTROL PREFIX. 
  
 UDF12    SX6    X2+B4       CHECK FOR CONTROL PREFIX 
          NZ     X6,UDF16    NOT CONTROL PREFIX 
          LX1    12 
          ZR     B7,UDF20    ILLEGAL PACKET STRUCTURE 
          NZ     B5,UDF14    SOURCE WORD NOT EMPTY
          SB5    5           RESET UNPACKING COUNTER
          SA1    A1+B1       (X1) = NEXT SOURCE WORD
          LX1    12 
  
 UDF14    BX2    -X7*X1      (X2) = NEXT ASCII CHARACTER
          SX6    X2-77B      CHECK IF CONTROL CHARACTER 
          SB7    B7-B1       DECREMENT AVAILABLE CHARACTER COUNT
          SB5    B5-1        DECREMENT UNPACKING COUNTER
          NG     X6,UDF16    NOT CONTROL CHARACTER
          SX6    X2-137B-1   CHECK UPPER BOUND
          PL     X6,UDF16    NOT CONTROL CHARACTER
          SX6    64 
          BX2    X2-X6       DE-CTL() 
  
*         SAVE CHARACTER. 
  
 UDF16    BX6    X2+X3       ADD  BIT PREFIX
          SX0    X0-1        DECREMENT REPEAT COUNT 
          SA6    B6          SAVE CHARACTER 
          SB6    B6+1        INCREMENT ADDRESS
          NZ     X0,UDF16    LOOP FOR ALL REPEATS 
  
*         CHECK FOR MORE DATA.
  
          ZR     B7,UDF18    END OF DATA
          NZ     B5,UDF2     NOT END OF SOURCE WORD 
          SB5    5           RESET UNPACKING COUNTER
          SA1    A1+1        (X1) = NEXT SOURCE WORD
          EQ     UDF2        LOOP TILL END OF DATA
  
*         END OF DATA SO RETURN.
  
 UDF18    SB2    UDF.A       (B2) = FWA OF STRING 
          SB7    B6-B2       (B7) = CHARACTER COUNT 
          SB6    B2          (B6) = FWA 
          EQ     UDFX        EXIT 
  
*         ILLEGAL OR MISSING DATA.
  
 UDF20    SB7    B0          FLAG NO DATA 
          EQ     UDFX        EXIT 
  
 UDF.A    BSS    94          STRING BUFFER
          SPACE  4,10 
**        VPC - VALIDATE PACKET CHECKSUM. 
* 
*         THIS ROUTINE VALIDATES THE CHECKSUM OF THE PACKET 
*         SPECIFIED ON INPUT. THE PACKET MUST BE IN THE INPUT 
*         BUFFER IN 8IN12 ASCII.
* 
*         ENTRY  (B1) = 1 
*                (A0) = FWA OF QUEUE PACKET 
* 
*         EXIT   (X6) = 0 IF VALID CHECKSUM 
* 
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2.
*                B - 2, 6, 7. 
* 
*         CALLS  NONE 
          SPACE  4,10 
 VPC      SUBR               ENTRY/EXIT 
          SA2    A0+B1       (X1) = PACKET LENGTH 
          SA1    A0+PDATA    (X1) = FIRST PACKED WORD 
          SB2    X2          (B2) = NUMBER OF BYTES TO CHECK
          MX0    -8          (X0) = BYTE MASK 
          SX6    0           CLEAR CHECKSUM 
          LX1    12          IGNORE MARK CHARACTER
          SB6    5           (B6) = A USEFUL CONSTANT 
          SB7    B6-1        (B7) = UNPACKING COUNTER 
  
 VPC2     LX1    12 
          SB7    B7-B1       DECREMENT UNPACKING COUNTER
          BX7    -X0*X1      (X7) = ASCII CHARACTER 
          IX6    X6+X7       ADD TO ACCUMULATION
 +        NZ     B7,*+1      NOT END OF SOURCE WORD 
          SB7    B6          RESET UNPACKING COUNTER
          SA1    A1+B1       (X1) = NEXT SOURCE WORD
          SB2    B2-1        DECREMENT PACKET LENGTH
          NZ     B2,VPC2     LOOP TILL END OF PACKET
  
*         CALCULATE BASIC CHECKSUM. 
  
          BX6    -X0*X6      FORM 8 BIT CHECKSUM
          SX2    77B
          BX7    X2*X6
          AX6    6
          IX6    X6+X7
          LX1    12 
          BX6    X2*X6
          SX6    X6+32       (X6) = EXPECTED CHECKSUM CHARACTER 
          BX1    -X0*X1      (X1) = ACTUAL CHECKSUM CHARACTER 
          BX6    X1-X6       COMPARE
          EQ     VPCX        EXIT 
          SPACE  4,10 
**        WDP - WRITE DATA PACKET.
* 
*         THIS ROUTINE WRITES THE SPECIFIED DATA PACKET TO THE DATA 
*         FILE. 
* 
*         ENTRY  (B1) = 1 
*                (X1) = PACKET ATTRIBUTE WORD 
* 
*         EXIT   PACKET WRITTEN TO DATA FILE
* 
*         USES   X - 1, 2, 5, 6, 7. 
*                A - 1, 5, 6. 
*                B - 2, 3, 4, 5, 6, 7.
* 
*         CALLS  RBF, WAC.
          SPACE  4,10 
 WDP      SUBR               ENTRY/EXIT 
  
*         INITIALISE. 
  
          SA5    X1+PLEN     (X5) = PACKET LENGTH 
          SB7    X5-3        (B7) = DATA BYTE COUNT 
          LE     B7,B0,WDP17 ILLEGAL DATA BYTE COUNT
          SA5    A5-PLEN+PDATA (X5) = FIRST DATA WORD 
          SB6    B1          (B6) = UNPACKING COUNTER 
          SX6    X1+         (X6) = FWA OF BUFFER 
          LX5    60-12       LEFT JUSTIFY FIRST DATA BYTE 
          RJ     RBF         RETURN BUFFER TO FREE QUEUE
          SA1    RXPWORD     (X1) = RX PREFIX WORD
          SB2    X1+         (B2) = - REPEAT COUNT PREFIX 
          AX1    20 
          SB3    X1          (B3) = -8 BIT PREFIX 
          AX1    20 
          SB4    X1+         (B4) = -CONTROL PREFIX 
          MX1    -8          (X1) = ASCII MASK
  
*         EXTRACT NEXT CHARACTER. 
  
 WDP2     LX5    12 
          BX2    -X1*X5      (X2) = NEXT ASCII CODE 
          SB6    B6-B1       DECREMENT UNPACKING COUNTER
          SX6    X2+B2       CHECK FOR REPEAT PREFIX
          SB5    B1          ASSUME NO REPEAT PREFIX
          SB7    B7-B1       DECREMENT AVAILABLE CHARACTER COUNT
          NZ     X6,WDP8     NO REPEAT PREFIX 
  
*         PROCESS REPEAT PREFIX.
  
          ZR     B7,WDP18    ILLEGAL PACKET STRUCTURE 
          NZ     B6,WDP4     SOURCE WORD NOT EMPTY
          SB6    5           RESET UNPACKING COUNTER
          SA5    A5+1        (X5) = NEXT SOURCE WORD
  
 WDP4     LX5    12 
          SB6    B6-1        DECREMENT UNPACKING COUNTER
          BX2    -X1*X5      (X2) = ASCII CODE
          SB5    X2-32       DE-CHAR REPEAT COUNT 
          ZR     B7,WDP18    ILLEGAL PACKET STRUCTURE 
          SB7    B7-1        DECREMENT AVAILABLE CHARACTER COUNT
          NZ     B6,WDP6     SOURCE WORD NOT EMPTY
          SB6    5           RESET UNPACKING COUNTER
          SA5    A5+1        (X5) = NEXT SOURCE WORD
  
 WDP6     LX5    12 
          SB6    B6-1        DECREMENT UNPACKING COUNTER
          BX2    -X1*X5      (X2) = NEXT ASCII CODE 
          ZR     B7,WDP18    ILLEGAL PACKET STRUCTURE 
          SB7    B7-1        DECREMENT AVAILABLE CHARACTER COUNT
  
*         CHECK FOR 8 BIT PREFIX. 
  
 WDP8     SX6    X2+B3       CHECK FOR 8 BIT PREFIX 
          MX7    0           ASSUME NO PREFIX 
          NZ     X6,WDP12    ASSUMPTION CORRECT 
          ZR     B7,WDP18    ILLEGAL PACKET STRUCTURE 
          NZ     B6,WDP10    SOURCE WORD NOT EMPTY
          SA5    A5+1        (X5) = NEXT SOURCE WORD
          SB6    5           RESET UNPACKING COUNTER
  
 WDP10    LX5    12 
          SB6    B6-1        DECREMENT UNPACKING COUNTER
          BX2    -X1*X5      (X2) = NEXT ASCII CODE 
          SB7    B7-1        DECREMENT AVAILABLE CHARACTER COUNT
          SX7    200B        FLAG 8 BIT SET 
  
*         CHECK FOR CONTROL PREFIX. 
  
 WDP12    SX6    X2+B4       CHECK FOR CONTROL PREFIX 
          NZ     X6,WDP16    NOT CONTROL PREFIX 
          LX5    12 
          ZR     B7,WDP18    ILLEGAL PACKET STRUCTURE 
          NZ     B6,WDP14    SOURCE WORD NOT EMPTY
          SA5    A5+1        (X5) = NEXT SOURCE WORD
          SB6    5           RESET UNPACKING COUNTER
          LX5    12          RIGHT JUSTIFY NEXT DATA BYTE 
  
 WDP14    BX2    -X1*X5      (X2) = NEXT ASCII CHARACTER
          SX6    X2-77B      CHECK IF CONTROL CHARACTER 
          SB7    B7-B1       DECREMENT AVAILABLE CHARACTER COUNT
          SB6    B6-1        DECREMENT UNPACKING COUNTER
          NG     X6,WDP16    NOT CONTROL CHARACTER
          SX6    X2-137B-1   CHECK UPPER BOUND
          PL     X6,WDP16    NOT CONTROL CHARACTER
          SX6    64 
          BX2    X2-X6       DECTL()
  
*         WRITE CHARACTER.
  
 WDP16    BX0    X2+X7       (X0) = CHARACTER + 8 BIT FLAG
          RJ     WAC         WRITE ASCII CHARACTER
  
*         CHECK FOR MORE DATA.
  
          ZR     B7,WDPX     END OF DATA SO EXIT
          MX1    -8          RESET ASCII MASK 
          NZ     B6,WDP2     NOT END OF SOURCE WORD 
          SA5    A5+1        (X5) = NEXT SOURCE WORD
          SB6    5           RESET UNPACKING COUNTER
          EQ     WDP2        LOOP TILL END OF PACKET
  
*         ILLEGAL DATA BYTE COUNT SO RETURN BUFFER. 
  
 WDP17    ZR     X1,WDPX     NULL BUFFER
          SX6    X1+         (X6) = FWA OF BUFFER 
          RJ     RBF         RETURN BUFFER TO FREE QUEUE
          EQ     WDPX        EXIT 
  
*         ILLEGAL PACKET STRUCTURE. 
  
 WDP18    SX6    3           (X6) = ERROR CODE
          SA6    EMODE       SAVE EXIT MODE 
          SX6    FPE         FORCE PROTOCOL ERROR 
          EQ     SGS         SET GIVEN STATE
          TITLE  BUFFER ALLOCATION ROUTINES.
**        BUFFER ALLOCATION ROUTINES. 
* 
*         THE FOLLOWING ROUTINES ARE USED TO INITIALISE, ALLOCATE 
*         AND RETURN PACKET BUFFERS.
* 
*         AFB - ALLOCATE FREE BUFFER
*         CBA - CHECK BUFFER AVAILABLE
*         IBC - INITIALISE BUFFER CHAIN 
*         RBF - RETURN BUFFER TO FREE CHAIN 
          SPACE  4,10 
**        AFB - ALLOCATE FREE BUFFER. 
* 
*         THIS ROUTINE RETURNS THE ADDRESS OF THE NEXT AVAILABLE
*         OUTPUT BUFFER.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   (X1) = FWA OF ALLOCATED BUFFER (0 IF NONE AVAILABLE) 
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS  NONE.
          SPACE  4,10 
 AFB      SUBR               ENTRY/EXIT 
          SA1    FQPTR       (X1) = FREE POINTER
          ZR     X1,AFBX     NO BUFFER AVAILABLE SO EXIT
          SA1    X1          (X1) = LINK FROM ASSIGNED PACKET 
          BX6    X1 
          SA6    FQPTR       UPDATE FREE POINTER
          MX6    0
          SX1    A1+         (X1) = ADDRESS OF ASSIGNED PACKET
          SA6    A1          CLEAR LINK 
          EQ     AFBX        EXIT 
          SPACE  4,10 
**        CBA - CHECK BUFFER AVAILABLE. 
* 
*         THIS ROUTINE RETURNS THE CURRENT VALUE OF THE FREE QUEUE
*         POINTER. IF ZERO NO BUFFER IS AVAILABLE, IF NONE ZERO 
*         THEN THIS IS THE ADDRESS OF THE NEXT AVAILABLE BUFFER.
*         THIS ROUTINE DOES NOT ASSIGN OR RESERVE THE BUFFER SO 
*         UNLESS THE BUFFER IS SUBSEQUENTLY ASSIGNED THE FREE BUFFER
*         LIST IS NOT CHANGED.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   (X1) = FWA OF NEXT AVAILABLE BUFFER (0 IF NONE)
* 
*         USES   X - 1. 
*                A - 1. 
*                B - NONE.
* 
*         CALLS  NONE.
          SPACE  4,10 
 CBA      SUBR               ENTRY/EXIT 
          SA1    FQPTR       (X1) = FREE QUEUE POINTER
          EQ     CBAX        EXIT 
          SPACE  4,10 
**        IBC - INITIALISE BUFFER CHAIN.
* 
*         THIS ROUTINE INITIALISES THE OUTPUT BUFFERS BY SETTING
*         THE LINK WORDS SUCH THAT THE BUFFERS FORM A CHAIN WITH
*         THE LAST LINK BEING ZERO. 
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   BUFFER POINTERS INITIALISED
*                FQPTR = FWA OF FIRST BUFFER
* 
*         USES   X - 6, 7.
*                A - 6, 7.
*                B - 6, 7.
* 
*         CALLS  NONE.
          SPACE  4,10 
 IBC      SUBR               ENTRY/EXIT 
          SB7    OBCNT-1     (B7) = OUTPUT BUFFER COUNT - 1 
          SX6    OBFWA       (X6) = OUTPUT BUFFER FIRST WORD ADDRESS
          SB6    OBLEN       (X6) = OUTPUT BUFFER LENGTH
          SA6    FQPTR       RESET FREE POINTER 
  
 IBC2     SX7    X6+B6       (X7) = ADDRESS OF NEXT LINK
          SA7    X6          SAVE LINK
          SB7    B7-B1       DECREMENT BUFFER COUNT 
          BX6    X7          UPDATE CURRENT ADDRESS 
          NZ     B7,IBC2     LOOP FOR ALL BUFFERS 
          MX6    0
          SA6    X7          CLEAR LAST LINK
          SA6    IQPTR       CLEAR INPUT QUEUE POINTER
          EQ     IBCX        EXIT 
          SPACE  4,10 
**        RBF - RETURN BUFFER TO FREE CHAIN.
* 
*         THIS ROUTINE RETURNS THE GIVEN OUTPUT BUFFER TO THE 
*         FREE QUEUE. 
* 
*         ENTRY  (B1) = 1 
*                (X6) = FWA OF BUFFER TO BE RETURNED
* 
*         EXIT   BUFFER RETURNED TO FREE QUEUE
* 
*         USES   X - 1, 7.
*                A - 1, 6, 7. 
*                B - NONE.
* 
*         CALLS  NONE.
          SPACE  4,10 
 RBF      SUBR               ENTRY/EXIT 
          SA1    FQPTR       (X1) = FREE POINTER
          BX7    X1 
          SA6    A1          UPDATE FREE POINTER
          SA7    X6          UPDATE LINK IN BUFFER BEING RETURNED 
          EQ     RBFX        EXIT 
          SPACE  4,10 
**        RIB - RETURN INPUT BUFFER.
* 
*         THIS ROUTINE CHECKS THE INPUT QUEUE POINTER AND IF
*         A BUFFER IS ASSIGNED RETURNS THE BUFFER TO THE FREE 
*         CHAIN.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   BUFFER RELEASED (IF ASSIGNED)
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS  RBF. 
          SPACE  4,10 
 RIB      SUBR               ENTRY/EXIT 
          SX6    0
          SA1    IQPTR       (X1) = INPUT QUEUE POINTER 
          ZR     X1,RIBX     NO BUFFER ASSIGNED SO EXIT 
          SA6    A1          CLEAR POINTER
          SX6    X1          (X6) = FWA OF BUFFER 
          RJ     RBF         RETURN BUFFER TO FREE LIST 
          EQ     RIBX        EXIT 
          TITLE  CDC FILE INTERFACE.
***       CDC FILE INTEFACE.
* 
*         KERMIT ATTEMPTS TO INTERFACE TO THE CDC PERMANENT FILE
*         BASE. IT USUALLY SUCCEDES BUT THERE ARE SOME PROBLEMS.
*         THE TWO MOST SIGNIFICANT PROBLEMS KNOWN ARE:- 
* 
*         1) IF THE 'REPLACE' MODE IS SELECTED AND A FILE IS
*            RECEIVED WITH THE SAME NAME AS AN EXISTING INDIRECT
*            ACCESS FILE AND THE INCOMMING FILE IS TOO LONG TO 'SAVE' 
*            THEN ALL THAT HAPPENS IS THAT THE FILE IS LEFT LOCAL.
* 
*         2) WHEN A LARGE FILE IS RECEIVED WHICH REQUIRES A DIRECT
*            ACCESS FILE TO SAVE IT THEN THE TIME TAKEN TO COPY THE 
*            FILE TO THE CORRECT DISK MAY RESULT IN THE REMOTE KERMIT 
*            TIMING OUT. IT IS HOPED THAT THIS WILL BE RESOLVED SOON. 
* 
*         WHEN TRANSMITTING FILES THE FOLLOWING CHARACTERS HAVE A 
*         SPECIAL MEANING WITHIN THE FILE NAME:-
* 
*         '#' OR '?' MEANS 'ANY SINGLE CHARACTER' 
*         '*'        MEANS 'ZERO OR MORE CHARACTERS'
          SPACE  4,10 
**        CDC FILE INTERFACE. 
* 
*         THE FOLLOWING ROUTINES ARE USED TO CREATE, MODIFY 
*         OR GET CDC FORMAT FILES.
* 
*         BFN - BUILD FILE NAME.
*         BLL - BUILD LOCAL FILE NAME LIST
*         GFN - GET FILE NAME (PROCESSES WILD CHARACTERS) 
*         ITF - INITIALISE TERMINAL FILES.
*         PRF - PROCESS RECEIVED FILE.
*         SFB - SET FLUSH BITS. 
*         VFN - VALIDATE FILE NAME
          SPACE  4,10 
**        BFN - BUILD FILE NAME.
* 
*         THIS ROUTINE PROCESSES THE GIVEN ASCII STRING AND 
*         RETURNS A CDC FORMAT FILE NAME AND VALIDATION MASK. 
*         THE CHARACTERS '?' OR '#' MAY BE USED TO SPECIFY A SINGLE 
*         OCCURRENCE OF ANY CHARACTER. THE CHARACTER '*' CAN
*         BE USED AT THE END OF THE STRING TO SPECIFY ZERO OR 
*         MORE OCCURRENCIES OF ANY CHARACTER. ILLEGAL CHARACTERS
*         ARE IGNORED AS ARE CHARACTERS FOLLOWING THE SEVENTH 
*         LEGAL CHARACTER.
* 
*         ENTRY  (B1) = 1 
*                (B5) = 0 IF WILD CHARACTERS ALLOWED
*                (B6) = FWA OF ASCII STRING 
*                (B7) = LENGTH OF STRING
* 
*         EXIT   (X6) = FILE NAME LEFT JUSTIFIED
*                (X7) = FILE NAME MASK
* 
*         USES   X - 0, 1, 2, 3, 6 ,7.
*                A - 1, 2, 6, 7.
*                B - 3, 4, 6, 7.
* 
*         CALLS  BLL. 
          SPACE  4,10 
 BFN      SUBR               ENTRY/EXIT 
  
*         INITIALISE. 
  
          MX6    0           CLEAR FILE NAME
          SX7    B0          CLEAR MASK 
          LE     B7,B0,BFNX  ILLEGAL LENGTH SO EXIT 
          MX0    -7          (X0) = ASCII MASK
          SB4    7           (B4) = MAXIMUM FILE NAME LENGTH
          MX3    -6          (X3) = DISPLAY CODE MASK 
  
*         GET NEXT CHARACTER. 
  
 BFN2     SB6    B6+B1       INCREMENT SOURCE ADDRESS 
          SB7    B7-1        DECREMENT SOURCE COUNT 
          SA2    B6-B1       (X2) = NEXT CHARACTER
          SA2    A2C+X2      CONVERT TO DISPLAY CODE
          NG     X2,BFN4     POSSIBLE WILD CHARACTER
  
*         ADD CHARACTER TO NAME AND SHIFT MASK. 
  
          LX7    6           SHIFT MASK 
          AX2    18 
          LX6    6
          SB4    B4-B1       DECREMENT FILE NAME LENGTH 
          SX2    X2          (X2) = 6 BIT DISPLAY CODE
          BX6    X2+X6       ADD CHARACTER TO FILE NAME 
          ZR     B7,BFN12    END OF STRING
          ZR     B4,BFN12    FILE NAME LENGTH LIMIT 
          EQ     BFN2        GOTO GET NEXT CHARACTER
  
*         INVALID CHARACTER SO CHECK FOR WILD CHARACTER.
  
 BFN4     ZR     B5,BFN6     WILD CARDS ALLOWED 
          ZR     B7,BFN12    END OF STRING
          EQ     BFN2        GOTO GET NEXT CHARACTER
  
*         POSSIBLE WILD CHARACTER.
  
 BFN6     SX2    X2-1R?      CHECK FOR SINGLE CHARACTER WILD
          ZR     X2,BFN7     '?' SO SINGLE CHARACTER WILD CARD
          SX2    X2+1R?-1R#  CHECK FOR ALTERNATIVE
          NZ     X2,BFN8     NOT SINGLE CHARACTER WILD CARD 
  
*         SINGLE CHARACTER WILD CARD. 
  
 BFN7     LX6    6           USE NULL CHARACTER 
          SB4    B4-B1       DECREMENT FILE NAME LENGTH 
          LX7    6
          BX7    -X3+X7      ADD MASK 
          ZR     B7,BFN12    END OF STRING
          ZR     B4,BFN12    IF FILE NAME LIMIT REACHED 
          EQ     BFN2        GOTO GET NEXT CHARACTER
  
*         CHECK FOR GLOBAL WILD CHARACTER.
  
 BFN8     SX2    X2+1R#-1R*  CHECK FOR '*'
          ZR     X2,BFN10    ALLOW ANY REMAINING CHARACTERS 
          NZ     B7,BFN2     NOT END OF STRING
          EQ     BFN12       END OF STRING
  
*         '*' SO ALLOW ANY TRAILING CHARACTERS. 
  
 BFN10    SB3    B3+B4
          SB3    B3+B4
          SB3    B3+B3       (B3) = 6 * REMAINING CHARACTER COUNT 
          SB3    B3-B1
          MX2    1
          AX2    B3          (X2) = MASK FOR REMAINING CHARACTERS 
          SB3    B3+B1
          LX2    B3          RIGHT JUSTIFY MASK 
          LX7    B3          MAKE ROOM
          SB4    0           CLEAR REMAINING CHARACTER COUNT
          BX2    X2+X7       ADD TO FILE NAME MASK
  
*         END OF SOURCE DATA SO LEFT JUSTIFY NAME AND MASK. 
  
 BFN12    SB4    B4+3        (B4) = REMAINING CHARACTER COUNT + 3 
          SB3    B4+B4
          SB4    B3+B4
          SB4    B4+B4       (B4) = 6 * REMAINING CHARACTER COUNT + 18
          LX6    B4          LEFT JUSTIFY FILE NAME 
          SA6    FNAME       SAVE 
          LX7    B4          LEFT JUSTIFY MASK
          SA7    A6+B1       SAVE 
  
*         IF WILD CHARACTERS BUILD LOCAL FILE NAME LIST.
  
          ZR     X7,BFNX     NO WILD CHARACTERS 
          RJ     BLL         BUILD LOCAL FILE NAME LIST 
          SA2    FNAME       (X2) = REQUIRED FILE NAME
          BX6    X2 
          SA2    A2+B1       (X2) = MASK
          BX7    X2 
          EQ     BFNX        EXIT 
          SPACE  4,10 
**        BLL - BUILD LIST OF LOCAL FILES.
* 
*         THIS ROUTINE EXAMINES THE FNT ENTRIES AND SAVES A LIST
*         OF ALL THE LOCAL FILES ASSIGNED TO MASS STORAGE. NOTE 
*         THAT A MAXIMUM OF 'LFTABL' ENTRIES ARE SAVED. 
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   FILE LIST BUILT
* 
*         USES   X - 0, 1, 6, 7.
*                A - 1, 6, 7. 
*                B - 7. 
* 
*         CALLS  LFM=.
          SPACE  4,10 
 BLL      SUBR               ENTRY/EXIT 
  
          SA1    BLL.A       (X1) = FET + 10B PATCH WORD
          MX7    0
          BX6    X1 
          SA7    LFPTR       RESET LOCAL FILE POINTER 
          SA6    Q+10B       PATCH FET
          SB7    -LFTABL     (B7) = - LOCAL FILE TABLE LENGTH 
          SA7    BLL.B       CLEAR CONTINUATION FLAG
  
*         GET NEXT FNT BLOCK. 
  
 BLL2     GETFNT Q           GET NEXT BLOCK 
          SA1    BLL.B+1     (X1) = FIRST ENTRY 
          ZR     X1,BLL8     NO MORE ENTRIES
  
*         SCAN BLOCK EXTRACTING FILES ASSIGNED TO MASS STORAGE. 
  
          SX0    60000B      (X0) = TYPE FIELD MASK 
  
 BLL4     BX6    X0*X1       (X6) = FILE TYPE 
          NZ     X6,BLL6     NOT MASS STORAGE 
          MX6    42 
          BX6    X1*X6       (X6) = FILE NAME 
          SA6    LFTAB+LFTABL+B7
          SB7    B7+B1       INCREMENT POINTER
          ZR     B7,BLL8     END OF DATA
  
 BLL6     SA1    A1+2        (X1) = NEXT TABLE ENTRY
          NZ     X1,BLL4     LOOP FOR ALL ENTRIES 
  
*         CHECK FOR MORE. 
  
          SA1    BLL.B       (X1) = CONTINUATION FLAG 
          NZ     X1,BLL2     LOOP TILL END
  
*         END OF DATA OF FILE LIST LIMIT REACHED. 
  
 BLL8     SX6    0
          SA6    LFTAB+LFTABL+B7
          EQ     BLLX        EXIT 
  
 BLL.A    VFD    12/16,6/0,18/023000B,6/10B,18/BLL.B
 BLL.B    BSS    16*2+2 
          SPACE  4,10 
**        GCE - GET CATALOG ENTRY.
* 
*         THIS ROUTINE READS THE NEXT CATALOG ENTRY FROM
*         THE USER CATALOG. 
* 
*         ENTRY  (B1) = 1 
*                'C' REWOUND IF FIRST ENTRY 
* 
*         EXIT   (X1) = FILE NAME 
*                (A1) = ADDRESS OF CATALOG ENTRY
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS  CIO=, LFM=, PFM=, RDW=.
          SPACE  4,10 
 GCE      SUBR               ENTRY/EXIT 
  
 GCE2     READW  Q,GCE.A,NWCE READ CATALOG ENTRY
          NG     X1,GCE4     NO DATA AVAILABLE
          SA1    GCE.A       (X1) = FILE NAME 
          EQ     GCEX        EXIT 
  
*         NO DATA SO ISSUE CATLIST UNLESS EOI.
  
 GCE4     SX1    X1+B1       CHECK FOR EOI
          NG     X1,GCE6     EOI SO END OF CATALOG
          SA1    X2+B1       (X1) = FIRST + ....
          SX6    X1          (X6) = FIRST 
          SA6    A1+1        SET IN = FIRST 
          SA6    A6+B1       SET OUT = FIRST
          CATLIST Q          EXTEND CATALOG 
          EQ     GCE2        GOTO READ NEXT ENTRY 
  
*         END OF CATALOG SO INITIALISE FOR NEXT TIME. 
  
 GCE6     MX1    0           CLEAR RETURN FLAG
          EQ     GCEX        EXIT 
  
 GCE.A    BSS    NWCE        CATALOG ENTRY BUFFER 
          SPACE  4,10 
**        GFN - GET FILE NAME.
* 
*         THIS ROUTINE RETURNS THE NEXT FILE NAME. IT ALLOWS
*         FOR WILD CHARACTERS AND RETURNS A ZERO VALUE WHEN 
*         ALL POSSIBLE NAMES HAVE BEEN RETURNED.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   (X6) = NAME LEFT JUSTIFIED (0 IF NO NAME)
* 
*         USES   X - 1, 6, 7. 
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS  GCE. 
          SPACE  4,10 
 GFN      SUBR               ENTRY/EXIT 
  
          SA1    FMASK       (X1) = FILE NAME MASK
          NZ     X1,GFN2     WILD CHARACTERS
  
*         NO WILD CHARACTERS TO BE PROCESSED. 
  
          SA1    FNAME       (X1) = FILE NAME 
          MX6    0
          SA6    A1          CLEAR FOR NEXT TIME ROUND
          BX6    X1          (X6) = FILE NAME 
          EQ     GFNX        EXIT 
  
*         WILD CHARACTERS.
  
 GFN2     SA2    LFPTR       (X2) = LOCAL FILE POINTER
          NG     X2,GFN8     LOCAL FILE LIST EXHAUSTED
  
*         SCAN LOCAL FILE LIST FROM CURRENT POSITION FOR MATCH. 
  
          BX6    X1          (X6) = FILE NAME MASK
          SA1    FNAME       (X1) = REQUIRED FILE NAME
          BX7    X1 
  
 GFN4     SA1    LFTAB+X2    (X1) = CURRENT ENTRY 
          ZR     X1,GFN6     END OF LOCAL FILE LIST 
          BX3    X1-X7       COMPARE WITH REQUIRED NAME 
          SX2    X2+1        INCREMENT CURRENT POINTER
          BX3    -X6*X3      MASK 
          NZ     X3,GFN4     NO MATCH 
  
*         ENTRY FOUND SO UPDATE POINTER AND RETURN. 
  
          BX6    X2          (X6) = UPDATED POINTER 
          SA6    A2          REPLACE
          BX6    X1          (X6) = FILE NAME 
          EQ     GFNX        EXIT 
  
*         END OF FILE LIST SO RESET POINTER AND PRESET FET. 
  
 GFN6     MX6    59 
          SA1    Q+1         (X1) = FIRST + ....
          SA6    A2          FLAG LOCAL FILES PROCESSED 
          SX6    X1          (X6) = FIRST 
          SA6    A1+1        SET IN = FIRST 
          SA6    A6+B1       SET OUT = FIRST
          SX6    0
          SA6    Q+6         CLEAR CONTINUATION COUNT 
          SA6    Q+10B       CLEAR FNT FLAGS FROM PFN 
          CATLIST Q          LOAD CATALOG BUFFER
  
*         GET NEXT CATALOG ENTRY. 
  
 GFN8     RJ     GCE         GET CATALOG ENTRY
          SX6    0           ASSUME NO ENTRY
          ZR     X1,GFNX     ASSUMPTION CORRECT SO EXIT 
  
*         CHECK IF POSSIBLE CANDIDATE.
  
          MX6    42 
          BX6    X1*X6       (X6) = FILE NAME 
          SA1    FNAME       (X1) = REQUIRED FILE NAME
          BX7    X1-X6       COMPARE
          SA1    FMASK       (X1) = FILE NAME MASK
          BX7    -X1*X7      CHECK
          NZ     X7,GFN8     NO MATCH SO TRY AGAIN
  
*         VALID CONTENDER SO CHECK IF ALREADY PROCESSED AS LOCAL. 
  
          SA1    LFTAB       (X1) = FIRST LOCAL FILE NAME 
          ZR     X1,GFNX     NO LOCAL FILES SO USE
  
 GFN10    BX7    X1-X6       COMPARE
          ZR     X7,GFN8     FILE FOUND SO ALREADY PROCESSED
          SA1    A1+B1       (X1) = NEXT TABLE ENTRY
          NZ     X1,GFN10    LOOP TILL END OF LOCAL FILE LIST 
          EQ     GFNX        NOT FOUND SO USE IT
          SPACE  4,10 
**        GNF - GET NEXT FILE.
* 
*         THIS ROUTINE GETS THE NEXT FILE FROM THE FILE NAME
*         LIST, ASSIGNS THE FILE AND LOADS THE INPUT BUFFER.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   (X6) = 0 IF NO FILE AVAILABE 
* 
*         USES   X - 1, 6, 7. 
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS 
          SPACE  4,10 
 GNF      SUBR               ENTRY/EXIT 
  
*         RESET DEFAULT FILE NAME.
  
          SX6    3
          SA1    GNF.A       (X1) = FILE NAME 
          BX6    X1+X6       ADD STATUS 
          SA6    F           SAVE 
  
*         GET NEXT FILE NAME. 
  
 GNF2     RJ     GFN         GET FILE NAME
          ZR     X6,GNFX     NO FILE FOUND
  
*         SAVE NAME IN FET AND CHECK IF LOCAL.
  
          SA6    CNAME       SAVE CURRENT FILE NAME 
          MX7    -2 
          BX6    -X7+X6      ADD STATUS TO FILE NAME
          SA6    S           SAVE IN STATUS FET 
          REWIND S,R         SET STATUS BITS (INCASE INCOMPLETE READ) 
          STATUS X2          CHECK IF LOCAL 
          SA1    X2          (X1) = RETURN CODE 
          MX6    -12
          BX6    -X6*X1      EXTRACT STATUS 
          AX6    1           IGNORE COMPLETED BIT 
          NZ     X6,GNF6     FILE LOCAL 
  
*         FILE NOT LOCAL SO TRY TO 'GET' IT.
  
          GET    F,CNAME     GET THE FILE 
          SA1    X2          (X1) = STATUS WORD 
          MX6    -18
          BX6    -X6*X1      (X6) = STATUS BITS 
          AX6    10          (X6) = ABNORMAL TERMINATION CODE 
          ZR     X6,GNF8     FILE OPTAINED SO LOAD BUFFER 
  
*         NOT ASSIGNED SO TRY TO ATTACH FILE IF APPROPRIATE.
  
          SX6    X6-/ERRMSG/FNF        CHECK IF DIRECT ACCESS 
          NZ     X6,GNF4     CANNOT OBTAIN THIS FILE
          ATTACH F,CNAME     ATTACH THE FILE
          SA1    X2          (X1) = STATUS WORD 
          MX6    -18
          BX6    -X6*X1      (X6) = STATUS
          AX6    10          (X6) = ABNORMAL TERMINATION CODE 
          ZR     X6,GNF8     FILE OBTAINED
  
*         CANNOT GET THIS FILE. 
  
 GNF4     SA1    GNF.B       (X1) = FIRST WORD OF LOG MESSAGE 
          RJ     WLM         WRITE LOG MESSAGE
          EQ     GNF2        GOTO GET NEXT (IF WILD CARD) 
  
*         FILE LOCAL SO PATCH SOURCE FET NAME.
  
 GNF6     SA1    CNAME       (X1) = CURRENT FILE NAME 
          MX6    -2 
          BX6    -X6+X1      SET STATUS BITS
          SA6    F           SAVE FILE NAME IN FET
          REWIND F,R         REWIND 
  
*         OPEN FILE NOW THAT IT IS LOCAL. 
  
 GNF8     READ   F           LOAD BUFFER
          MX6    0
          SA6    FWORD       CLEAR PACKING/UNPACKING WORD 
          SA6    A6+B1       CLEAR UNPACKING COUNTER
          SX6    B1          FLAG FILE ASSIGNED 
          EQ     GNFX        EXIT 
  
 GNF.A    VFD    42/0LZZZZZFN,18/0
 GNF.B    DIS    ,'**** UNABLE TO FIND ;A.' 
          SPACE  4,10 
**        ITF - INITIALISE TERMINAL FILES.
* 
*         THIS ROUTINE ASSIGNS THE FILES 'ZZZZZIN' AND 'ZZZZZOU'
*         TO THE TERMINAL. THESE ARE USED BY KERMIT FOR THE 
*         PACKET INPUT AND OUTPUT.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   FILES ASSIGNED TO THE TERMINAL 
* 
*         USES   X - NONE.
*                A - NONE.
*                B - NONE.
* 
*         CALLS  LFM=.
          SPACE  4,10 
 ITF      SUBR               ENTRY/EXIT 
  
          RETURN ZZZZZIN,R   INITIALISE INPUT FILE
          REQUEST X2,U,ND 
          SA1    X2          (X1) = FET + 0 
          MX6    42 
          BX6    X1*X6       CLEAR STATUS 
          SX1    11B         (X1) = 'READ' FUNCTION 
          BX6    X1+X6       ADD TO FILE NAME 
          SA6    A1          PRESET READ FUNCTION 
          RETURN ZZZZZOU,R   INITIALISE OUTPUT FILE 
          REQUEST X2,U,ND 
          EQ     ITFX        EXIT 
          SPACE  4,10 
**        PROCESS RECEIVED FILE.
* 
*         THIS ROUTINE MAKES THE RECEIVED FILE PERMANENT ACCORDING
*         TO THE P.F. FLAG. 
* 
*         ENTRY  (B1) = 1 
*                PFFLAG = 0 - LEAVE FILE LOCAL
*                         1 - SAVE/DEFINE FILE
*                         2 - REPLACE/ATTACH & COPY FILE
* 
*         EXIT   FILE PROCESSED 
* 
*         USES   X -
*                A -
*                B -
* 
*         CALLS 
          SPACE  4,10 
 PRF      SUBR               ENTRY/EXIT 
  
*         BRANCH ACCORDING TO FUNCTION. 
  
          SA1    PFFLAG      (X1) = P.F. FLAG 
          SA1    PRF.A+X1    (X1) = PROCESS ADDRESS 
          SB7    X1 
          JP     B7+         PROCESS
  
*         LEAVE FILE LOCAL. 
  
 PRF0     RJ     VLN         VALIDATE LOCAL FILE NAME 
          SA1    CNAME       (X1) = CURRENT FILE NAME 
          SA2    F+6         (X2) = LOCAL FILE NAME 
          BX2    X1-X2       COMPARE
          AX2    18          IGNORE STATUS BITS 
          SA1    PRF.G       ASSUME SAME NAME 
 +        ZR     X2,*+1      ASSUMPTION CORRECT 
          SA1    PRF.I       USE ALTERNATIVE NAME 
          RJ     WLM         WRITE LOG FILE MESSAGE 
          EQ     PRFX        EXIT 
  
*         SAVE/DEFINE FILE. 
  
 PRF2     RJ     VFN         VALIDATE FILE NAME 
          SAVE   F           TRY TO SAVE FILE 
  
*         CHECK RETURN CODE.
  
          SX6    377B 
          SA1    F           (X1) = FILE NAME + STATUS
          AX1    10 
          BX6    X1*X6       (X6) = ERROR CODE
          NZ     X6,PRF4     ERROR OF SOME SORT SO TRY TO IDENTIFY. 
  
*         WRITE MESSAGE TO LOG FILE.
  
          SA1    CNAME       (X1) = CURRENT FILE NAME 
          SA2    F+10B       (X2) = NAME USED IN SAVE 
          BX2    X1-X2       COMPARE
          AX2    18          IGNORE STATUS BITS 
          SA1    PRF.B       ASSUME NAMES MATCH 
 +        ZR     X2,*+1      ASSUMPTION CORRECT 
          SA1    PRF.C       USE ALTERNATIVE TEXT 
          RJ     WLM         WRITE LOG MESSAGE
          EQ     PRFX        EXIT 
  
*         UNABLE TO SAVE FILE SO CHECK IF TOO LONG. 
  
 PRF4     SX7    X6-/ERRMSG/FTL CHECK IF TOO LONG 
          NZ     X7,PRF10    NOT TOO LONG 
          RETURN Q,R         RETURN CATLIST FILE
          DEFINE Q           TRY TO DEFINE FILE 
  
*         CHECK RETURN CODE.
  
          SX6    377B 
          SA1    Q           (X1) = FILE NAME + STATUS
          AX1    10 
          BX6    X1*X6       X6) = STATUS BITS
          NZ     X6,PRF10    ERROR SO UNABLE TO SAVE
  
*         COPY LOCAL FILE TO PERMANENT. 
  
          REWIND F,R         REWIND SOURCE
          READ   X2          LOAD BUFFER
          REWIND Q,R         REWIND DESTINATION 
          WRITE  X2,*        PRESET FET WRITE FUNCTION
  
 PRF6     READO  F           READ NEXT WORD 
          NZ     X1,PRF8     END OF DATA
          WRITEO Q           WRITE TO PERMANENT FILE
          EQ     PRF6        LOOP TILL END OF DATA
  
 PRF8     WRITER Q,R         FLUSH OUTPUT BUFFER
          RETURN X2          RETURN FILE
  
*         WRITE LOG MESSAGE.
  
          SA1    CNAME       (X1) = CURRENT FILE NAME 
          SA2    F+10B       (X2) = NAME USED IN DEFINE 
          BX2    X1-X2       COMPARE
          AX2    18          IGNORE STATUS BITS 
          SA1    PRF.D       (X1) = DEFAULT MESSAGE 
 +        ZR     X2,*+1      ASSUMPTION CORRECT 
          SA1    PRF.E       USE ALTERNATIVE TEXT 
          RJ     WLM         WRITE LOG MESSAGE
          EQ     PRFX        EXIT 
  
*         UNABLE TO SAVE FILE SO LOG AND EXIT.
  
 PRF10    RJ     VLN         VALIDATE LOCAL FILE NAME 
          SA1    CNAME       X1) = CURRENT FILE NAME
          SA2    F+6         (X2) = LOCAL FILE NAME 
          BX2    X1-X2       COMPARE
          AX2    18          IGNORE STATUS BITS 
          SA1    PRF.F       ASSUME SAME NAME 
 +        ZR     X2,*+1      ASSUMPTION CORRECCT
          SA1    PRF.H       USE ALTERNATIVE MESSAGE
          RJ     WLM         WRITE LOG MESSAGE
          EQ     PRFX        EXIT 
  
*         REPLACE/ATTACH & COPY FILE. 
  
 PRF12    SA1    CNAME       (X1) = CURRENT FILE NAME 
          MX6    42 
          BX6    X1*X6       CLEAR STATUS BITS
          SA6    F+10B       SAVE AS PFN
          REPLACE F          TRY TO REPLACE FILE
  
*         CHECK RETURN CODE.
  
          SX6    377B 
          SA1    F           (X1) = FILE NAME + STATUS
          AX1    10 
          BX6    X1*X6       (X6) = ERROR CODE
          NZ     X6,PRF10    ERROR OF SOME SORT 
  
*         WRITE MESSAGE TO LOG FILE.
  
          SA1    PRF.J       (X1) = FIRST WORD OF MESSAGE.
          RJ     WLM         WRITE LOG MESSAGE
          EQ     PRFX        EXIT 
  
 PRF.A    BSS    0           FUNCTION BRANCH TABLE
          CON    PRF0        0 - LEAVE LOCAL
          CON    PRF2        1 - SAVE/DEFINE
          CON    PRF12       2 - REPLACE/ATTACH & COPY
 PRF.B    DIS    ,'    ;A SAVED.' 
 PRF.C    DIS    ,'    ;A SAVED AS ;B.' 
 PRF.D    DIS    ,'    ;A DEFINED.' 
 PRF.E    DIS    ,'    ;A DEFINED AS ;B.' 
 PRF.F    CON    10H ** UNABLE,10H TO SAVE, 
 PRF.G    DIS    ,'    ;A LEFT LOCAL.'
 PRF.H    CON    10H ** UNABLE,10H TO SAVE, 
 PRF.I    DIS    ,'    ;A LEFT LOCAL AS ;C.'
 PRF.J    DIS    ,'    ;A REPLACED.'
          SPACE  4,10 
**        SFB - SET FLUSH BITS. 
* 
*         THIS ROUTINE SETS THE FLUSH BITS IN THE REQUIRED FETS.
*         THIS MAY ASSIST THROUGHPUT ON THE TERMINAL FILE.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   FLUSH BIT (FET+1 BIT 36) SET 
* 
*         USES   X - 1, 6, 7. 
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS  CPM=, RCL=.
          SPACE  4,10 
 SFB      SUBR               ENTRY/EXIT 
  
          SX7    B1 
          LX7    36-0        (X7) = FLUSH BIT 
  
*         SET DEBUG FILE FLUSH BIT. 
  
          SA1    D+1         (X1) = FIRST + ....
          BX6    X1+X7       SET FLUSH BIT
          SA6    A1          REPLACE
  
*         SET DATA FILE FLUSH BIT.
  
          SA1    F+1         (X1) = FIRST + ....
          BX6    X1+X7       SET FLUSH BIT
          SA6    A1          REPLACE
  
*         SET LOG FILE FLUSH BIT. 
  
          SA1    L+1         (X1) = FIRST + ....
          BX6    X1+X7       SET FLUSH BIT
          SA6    A1          REPLACE
  
*         SET TERMINAL OUTPUT FLUSH BIT.
  
          SA1    O+1         (X1) = FIRST + ....
          BX6    X1+X7       SET FLUSH BIT
          SA6    A1          REPLACE
  
*         GIVE LIST OF FILES TO SYSTEM. 
  
          SETLOF SFB.A
          RECALL SFB.A
          EQ     SFBX        EXIT 
  
 SFB.A    VFD    12/0,18/SFB.B,29/0,1/0 
 SFB.B    BSS    0           LIST OF FILES TO FLUSH 
          VFD    1/0,41/0,18/SFB.BL 
          VFD    42/7LZZZZZOU,18/O
          VFD    42/7LZZZZDBG,18/D
          VFD    42/7LZZZZZFN,18/F
          VFD    42/7LZZZZLOG,18/L
          CON    0
 SFB.BL   EQU    *-SFB.B-1
          SPACE  4,10 
**        VFN - VALIDATE FILE NAME. 
* 
*         THIS ROUTINE CHECKS IF THE CURRENT FILE NAME IS ALREADY 
*         A PERMANENT FILE. IF IT IS THEN THE FILE NAME IS MODIFIED 
*         WHEN THE FUNCTION IS 'SAVE' OR 'DEFINE'.
* 
*         ENTRY  (B1) = 1 
*                (CNAME) = CURRENT FILE NAME
* 
*         EXIT   (F+10B) = FILE NAME TO USE 
* 
*         USES   X -
*                A -
*                B -
* 
*         CALLS 
          SPACE  4,10 
 VFN      SUBR               ENTRY/EXIT 
  
*         CHECK IF FILE ALREADY PERMANENT.
  
          SETFET Q,ERA=VFN.A
          SA1    CNAME       (X1) = CURRENT FILE NAME 
          MX6    0
          BX7    X1 
          SA6    VFN.B       CLEAR ATTEMPTED FILE NAME
          SA7    F+10B       INITIALISE PFN IN FET
  
 VFN2     REWIND Q,R         INITIALISE FET 
          SX6    0
          SA6    X2+6        CLEAR CATLIST CONTINUATION 
          CATLIST Q,F+10B 
          SA1    Q+2         (X1) = IN
          SA2    A1+B1       (X2) = OUT 
          BX1    X1-X2       COMPARE
          ZR     X1,VFNX     NO INPUT SO FILE NOT FOUND 
          READW  Q,VFN.C,NWCE READ CATALOG ENTRY
          NZ     X1,VFNX     FILE NOT FOUND SO USE AS IS
  
*         FILE NAME REQUIRES MODIFICATION.
  
          SA5    VFN.B       (X5) = ATTEMPTED FILE NAME 
          NZ     X5,VFN4     NOT FIRST ATTEMPT
          SA5    CNAME       (X5) = CURRENT FILE NAME 
  
*         EXTRACT CURRENT COUNT AND FILE NAME.
  
 VFN4     SX6    X5          (X6) = CURRENT COUNT VALUE 
          SX1    X6+B1       (X1) =NEXT NUMBER
          BX5    X5-X6       (X5) = BASE NAME 
          BX6    X1+X5       (X6) = 42/NAME,18/NEXT NUMBER
          SA6    VFN.B       SAVE 
          RJ     CDD         CONVERT TO DECIMAL DISPLAY CODE
  
*         DETERMINE NUMBER OF CHARACTERS IN BASE FILE NAME. 
  
          MX7    6
          SB7    0
          LX6    18          POSITION NUMERIC DISPLAY CODE
 +        LX7    60-6        SHIFT MASK 
          SB7    B7+6        INCREMENT BIT COUNT
          BX1    X5*X7       CHECK IF END OF NAME 
          NZ     X1,*-1      NOT END OF NAME
  
*         TRY TO MERGE NAME AND NUMBER. 
  
          SB3    42          (B3) = MAXIMUM FILE NAME LENGTH (IN BITS)
 +        SB6    B2+B7       (B6) = LENGTH OF NAME + NUMBER (IN BITS) 
          LE     B6,B3,*+1   IN RANGE 
          SB7    B3-B2       TRUNCATE NAME PART 
          MX7    1
          SB6    B7-1 
          AX7    B6          (X7) = MASK FOR FILE NAME
          BX5    X5*X7       (X5) = FILE NAME 
          AX4    B7          POSITION NUMERIC PART
          BX4    -X7*X4      CLEAR SIGN EXTENSION 
          BX6    X4+X5       MERGE NAME AND NUMBER
          AX7    B2          EXTEND MASK TO TOTAL LENGTH
          BX6    X6*X7       CLEAR ANY TRAILING BLANKS
          SA6    F+10B       SAVE IN FET
          EQ     VFN2        CHECK IF THIS NAME IS O.K. 
  
 VFN.A    BSS    3           PFM ERROR MESSAGE BUFFER 
 VFN.B    BSS    1           ATTEMPTED FILE NAME
 VFN.C    BSS    NWCE        FILE CATALOG ENTRY 
          SPACE  4,10 
**        VLN - VALIDATE LOCAL FILE NAME. 
* 
*         THIS ROUTINE LEAVES THE CURRENT FILE LOCAL ENSURING 
*         NO NAME CONFLICT. 
* 
*         ENTRY  (B1) = 1 
*                (CNAME) = CURRENT FILE NAME
* 
*         EXIT   FILE LOCAL (NAME IN F+6) 
* 
*         USES   X -
*                A -
*                B -
* 
*         CALLS 
          SPACE  4,10 
 VLN      SUBR               ENTRY/EXIT 
  
          SA1    CNAME       (X1) = CURRENT NAME
          MX6    0
          BX7    X1 
          SA6    VLN.A       CLEAR ATTEMPTED FILE NAME
          SX6    B1 
          BX6    X6+X7       (X6) = 42/NAME,18/STATUS 
          SA6    F           SAVE IN FET
  
*         CHECK IF FILE ALREADY EXISTS. 
  
 VLN2     REWIND F,R         REWIND FILE TO ENSURE STATUS SET 
          STATUS X2          CHECK IF LOCAL 
          SA1    X2          (X1) = RETURN CODE 
          MX6    -12
          BX6    -X6*X1      EXTRACT STATUS 
          AX6    1           IGNORE COMPLETED BIT 
          ZR     X6,VLN6     FILE NOT LOCAL SO USE IT 
  
*         FILE NAME REQUIRES MODIFICATION.
  
          SA5    VLN.A       (X5) = ATTEMPTED FILE NAME 
          NZ     X5,VLN4     NOT FIRST ATTEMPT
          SA5    CNAME       (X5) = CURRENT FILE NAME 
  
*         EXTRACT CURRENT COUNT AND FILE NAME.
  
 VLN4     SX6    X5          (X6) = CURRENT COUNT VALUE 
          SX1    X6+B1       ((X1) = NEXT NUMBER
          BX5    X5-X6       (X5) = BASE NAME 
          BX6    X1+X5       (X6) = 42/NAME,18/NEXT NUMBER
          SA6    VLN.A       SAVE 
          RJ     CDD         CONVERT TO DECIMAL DISPLAY CODE
  
*         DETERMINE NUMBER OF CHARACTERS IN BASE FILE NAME. 
  
          MX7    6
          SB7    0
          LX6    18          POSITION NUMBERIC DISPLAY CODE 
 +        LX7    60-6        SHIFT MASK 
          SB7    B7+6        INCREMENT BIT COUNT
          BX1    X5*X7       CHECK IF END OF NAME 
          NZ     X1,*-1      NOT END OF NAME
  
*         TRY TO MERGE NAME AND NUMBER. 
  
          SB3    42          (B3) = MAXIMUM FILE NAME LENGTH (IN BITS)
 +        SB6    B2+B7       (B6) = LENGTH OF NAME + NUMBER (IN BITS) 
          LE     B6,B3,*+1   IN RANGE 
          SB7    B3-B2       TRUNCATE NAME PART 
          MX7    1
          SB6    B7-1 
          AX7    B6          (X7) = MASK FOR FILE NAME
          BX5    X5*X7       (X5) = FILE NAME 
          AX4    B7          POSITION NUMERIC PART
          BX4    -X7*X4      CLEAR SIGN EXTENSION 
          BX6    X4+X5       MERGE NAME AND NUMBER
          AX7    B2          EXTEND MASK TO TOTAL LENGTH
          BX6    X6*X7       CLEAR ANY TRAILING BLANKS
          SX7    B1 
          BX6    X6+X7       SET COMPLETE BIT 
          SA6    F           UPDATE FET + 0 
          EQ     VLN2        GOTO CHECK IF THIS FILE EXISTS 
  
*         RENAME FILE TO MAKE LOCAL.
  
 VLN6     SX2    F           (X2) = FET ADDRESS 
          SA1    X2+         (X1) = NAME TO USE 
          MX6    42 
          BX6    X1*X6       CLEAR STATUS BITS
          SA6    X2+6        SAVE LOCAL FILE NAME 
          SA1    VLN.B       (X1) = TEMP FILE NAME
          BX6    X1 
          SA6    X2          SAVE 
          RENAME X2          RENAME FILE
          SA1    VLN.B       (X1) = TEMP. FILE NAME 
          BX6    X1 
          SA6    X2          RESET FET
          EQ     VLNX        EXIT 
  
 VLN.A    BSS    1           ATTEMPTED FILE NAME
 VLN.B    VFD    42/0LZZZZZFN,18/1
          TITLE  LOG FILE PROCESSORS. 
**        LOG FILE PROCESSORS.
* 
*         THE FOLLOWING ROUTINES MANIPULATE A LOG FILE WHICH
*         SUMMARISES ALL THE FILE TRANSFERS DURING A GIVEN
*         SESSION.
* 
*         CLF - CLOSE LOG FILE. 
*         OLF - OPEN LOG FILE.
*         WDL - WRITE DIRECTIVE TO LOG FILE 
*         WLM - WRITE LOG FILE MESSAGE. 
*         WLT - WRITE LOG TEXT (NO PARAMETERS)
          SPACE  4,10 
**        CLF - CLOSE LOG FILE. 
* 
*         THIS ROUTINE IS USED TO CLOSE THE LOG FILE AND SUPPRESS 
*         ANY FURTHER LOGGING MESSAGES. 
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   LOG FILE CLOSED
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS  CIO=, WLM. 
          SPACE  4,10 
 CLF      SUBR               ENTRY/EXIT 
  
          SA1    CLF.A       (X1) = FWA OF TEXT 
          RJ     WLM         WRITE LOG MESSAGE
          WRITER L,R         FLUSH BUFFER 
          SA1    X2          (X1) = FILE NAME + STATUS
          MX6    42 
          BX6    X1*X6       CLEAR STATUS TO PREVENT FURTHER LOGGING
          SA6    A1          REPLACE
          EQ     CLFX        EXIT 
  
 CLF.A    DIS    ,'CLOSING LOG FILE.' 
          SPACE  4,10 
**        OLF - OPEN LOG FILE.
* 
*         THIS ROUTINE IS CALLED TO OPEN THE LOG FILE. ANY EXISTING 
*         LOG IS DISCARDED WITHOUT WARNING. 
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   LOG FILE OPENED
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS  CIO=, WLM. 
          SPACE  4,10 
 OLF      SUBR               ENTRY/EXIT 
  
          MX6    42 
          SX2    L           (X2) = LOG FET ADDRESS 
          SA1    X2          (X1) = LOG FILE NAME + STATUS
          BX6    X1*X6       CLEAR STATUS 
          MX1    -2 
          BX6    -X1+X6      SET REQUIRED STATUS
          SA6    A1          REPLACE
          REWIND X2,R        INITIALISE LOG FILE
          SA1    OLF.A       (X1) = MESSAGE 
          RJ     WLM         WRITE LOG MESSAGE
          EQ     OLFX        EXIT 
  
 OLF.A    DIS    ,'LOG FILE OPENED.'
          SPACE  4,10 
**        WDL - WRITE DIRECTIVE TO LOG FILE.
* 
*         THIS ROUTINE WRITES THE GIVEN DIRECTIVES TO THE LOG 
*         FILE. 
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   DIRECTIVE WRITTEN TO LOG FILE IF ACTIVE
* 
*         USES   X -
*                A -
*                B -
* 
*         CALLS 
          SPACE  4,10 
 WDL      SUBR               ENTRY/EXIT 
  
*         GET DIRECTIVE LIMITS AND COPY TO LOG FILE.
  
          RJ     GDL         GET DIRECTIVE LIMITS 
          SX6    1R 
          SA6    WDL.A       PRESET DESTINATION ADDRESS 
          SB2    9           RESET PACKING COUNTER
          EQ     B6,B7,WDLX  NO DATA
  
 WDL2     SA1    B6          (X1) = ASCII CHARACTER 
          SB6    B6+B1       INCREMENT POINTER
          SA1    A2C+X1      CONVERT TO 6/12 DISPLAY CODE 
          MX7    -6 
          LX1    60-6 
          BX7    -X7*X1      (X7) = FIRST 6 BITS
          ZR     X7,WDL4     ONLY 6 BIT CODE
          LX6    6
          BX6    X6+X7       ADD FIRST 6 BITS TO PACKING WORD 
          SB2    B2-B1       DECREMENT PACKING COUNTER
          NZ     B2,WDL4     NOT FULL 
          SA6    A6+B1       SAVE FULL WORD 
          SB2    10          RESET PACKING COUNTER
          MX6    0           CLEAR PACKING WORD 
  
 WDL4     MX7    -6 
          LX1    6
          BX7    -X7*X1      (X7) = LAST 6 BITS 
          LX6    6
          SB2    B2-B1       DECREMENT PACKING COUNTER
          BX6    X6+X7       ADD CHARACTER
          NZ     B2,WDL6     NOT FULL WORD
          SA6    A6+B1       SAVE FULL WORD 
          SB2    10          RESET PACKING COUNTER
          MX6    0           CLEAR PACKING WORD 
  
 WDL6     LT     B6,B7,WDL2  LOOP TILL END OF DIRECTIVE 
          GT     B2,B1,WDL8  EOL IN CURRENT WORD
          LX6    6
          SX7    1R 
          BX6    X6+X7       BLANK FILL 
          SA6    A6+1        SAVE 
          SX6    0
  
 WDL8     SX1    B2+B2
          SB2    X1+B2
          SB2    B2+B2       (B2) = REMAINING BIT COUNT 
          LX6    B2 
          SA6    A6+B1       SAVE LAST WORD 
          SB6    WDL.A+1     (B6) = FWA OF TEXT 
          RJ     WLT         WRITE TEXT TO LOG FILE 
          EQ     WDLX        EXIT 
  
 WDL.A    BSS    17 
          SPACE  4,10 
**        WLM - WRITE LOG FILE MESSAGE. 
* 
*         IF THE LOG FILE IS OPEN THEN THE SPECIFIED MESSAGE IS 
*         WRITTEN TO THE LOG FILE. THE MESSAGE MUST BE IN UPPER 
*         CASE DISPLAY CODE WITH A 6 BIT ZERO TERMINATION CODE. 
*         IF DISPLAY CODE 77B (;) APPEARS WITHIN THE GIVEN TEXT 
*         THEN THE FOLLOWING CHARACTER IS TAKEN AS A PARAMETER
*         AND THE CORRESPONDING TEXT (E.G. FILE NAME) IS INSERTED.
* 
*         ENTRY  (B1) = 1 
*                (X1) = FIRST WORD OF TEXT
*                (A1) = ADDRESS OF FIRST WORD 
* 
*         EXIT   MESSAGE WRITTEN TO LOG FILE IF OPENED
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 6. 
*                B - 2, 3, 4, 7.
* 
*         CALLS  WLT. 
          SPACE  4,10 
 WLM      SUBR               ENTRY/EXIT 
  
*         INITIALISE. 
  
          SB4    10 
          MX0    -6          (X0) = CHARACTER MASK
          SX6    B0          CLEAR PACKING WORD 
          SA6    WLM.A       PRESET DESTINATION ADDRESS 
          SB2    B4          (B2) = PACKING COUNTER 
          SX6    1R 
          SB3    B4-B1       (B3) = UNPACKING COUNTER 
          EQ     WLM4        GOTO GET NEXT CHARACTER
  
*         GET NEXT SOURCE WORD. 
  
 WLM2     SB2    B4+         RESET UNPACKING COUNTER
          SA1    A1+1        (X1) = NEXT SOURCE WORD
  
*         GET NEXT CHARACTER. 
  
 WLM4     LX1    6
          SB2    B2-1        DECREMENT UNPACKING COUNTER
          BX2    -X0*X1      (X2) = NEXT CHARACTER
          ZR     X2,WLM14    END OF TEXT
          SX7    X2-77B      CHECK FOR PARAMETER
          ZR     X7,WLM8     PARAMETER
          LX6    6
          BX6    X2+X6       ADD TO PACKING WORD
          SB3    B3-B1       DECREMENT PACKING COUNTER
          NZ     B3,WLM6     PACKING WORD NOT FULL
          SA6    A6+B1       SAVE FULL WORD 
          SB3    B4+         RESET PACKING COUNTER
          SX6    0           CLEAR PACKING WORD 
  
 WLM6     NZ     B2,WLM4     SOURCE WORD NOT EMPTY
          EQ     WLM2        GOTO GET NEXT SOURCE WORD
  
*         PARAMETER CODE SO GET ORDINAL.
  
 WLM8     NZ     B2,*+1      NOT END OF SOURCE WORD 
          SB2    B4          RESET UNPACKING COUNTER
          SA1    A1+B1       (X1) = NEXT SOURCE WORD
          LX1    6
          SB2    B2-1        DECREMENT UNPACKING COUNTER
          BX2    -X0*X1      (X2) = PARAMETER ORDINAL 
          ZR     X2,WLM14    END OF LINE
          SA2    WLM.B-1+X2  GET PARAMETER DESCRIPTOR 
          SB7    X2 
          AX2    18 
          JP     B7+         PROCESS
  
*         FILE NAME PARAMETER.
  
 WLM10    MX3    42 
          SA2    X2+         (X2) = FILE NAME + ....
          BX2    X2*X3       ENSURE 7 CHARACTERS
  
 WLM12    LX2    6
          BX3    -X0*X2      (X3) = NEXT CHARACTER
          ZR     X3,WLM6     END OF NAME
          LX6    6
          SB3    B3-1        DECREMENT PACKING COUNTER
          BX6    X3+X6       ADD TO PACKING WORD
          NZ     B3,WLM12    NOT FULL 
          SB3    B4          RESET PACKING COUNTER
          SA6    A6+B1       SAVE FULL WORD 
          MX6    0           CLEAR PACKING WORD 
          EQ     WLM12       LOOP TILL END OF FILE NAME 
  
*         END OF SOURCE TEXT SO FORCE EOL AND WRITE.
  
 WLM14    NE     B3,B1,WLM16 ROOM FOR EOL IN CURRENT WORD 
          SX2    1R 
          LX6    6
          BX6    X2+X6       BLANK FILL 
          SA6    A6+B1       SAVE 
          MX6    0           CLEAR PACKING WORD 
  
*         LEFT JUSTIFY TO FORCE EOL.
  
 WLM16    SB2    B3+B3       *2 
          SB2    B2+B3       *3 
          SB2    B2+B2       (B2) * 6 * REMAINING CHARACTER COUNT 
          LX6    B2          LEFT JUSTIFY LAST WORD 
          SA6    A6+1        SAVE 
          SB6    WLM.A+1     (B6) = FWA OF TEXT 
          RJ     WLT         WRITE TEXT TO LOG FILE 
          EQ     WLMX        EXIT 
  
 WLM.A    BSS    11          MESSAGE BUFFER 
 WLM.B    BSS    0           PARAMETER DESCRIPTOR TABLE 
          VFD    24/0,18/CNAME,18/WLM10   A - CURRENT FILE NAME 
          VFD    24/0,18/F+10B,18/WLM10   B - MODIFIED FILE NAME
          VFD    24/0,18/F+6,18/WLM10     C - LOCAL FILE NAME 
          VFD    24/0,18/ILCHAR,18/WLM10  D - ILLEGAL CHARACTER 
          SPACE  4,10 
**        WLT - WRITE LOG TEXT. 
* 
*         THIS ROUTINE WRITES THE GIVEN 6/12 PACKED DISPLAY 
*         CODE TO THE LOG FILE. 
* 
*         ENTRY  (B1) = 1 
*                (B6) = FWA OF TEXT 
* 
*         EXIT   TEXT WRITTEN TO LOG FILE (IF ACTIVE) 
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 2.
*                B - NONE.
* 
*         CALLS  SYS=, WTC=, WTO=.
          SPACE  4,10 
 WLT      SUBR               ENTRY/EXIT 
  
          CLOCK  WLT.A       GET MESSAGE TIME 
  
*         COPY TEXT TO LOG BUFFER.
  
          SA2    LOGPTR      (X2) = LOG POINTER 
          SB4    X2          (B4) = LIMIT 
          AX2    18 
          SB3    X2          (B3) = IN
          AX2    18 
          SB2    X2          (B2) = OUT 
          AX2    18          (X2) = LINE COUNT
  
*         SAVE MESSAGE TIME.
  
          SA1    WLT.A       (X1) = TIME
          BX6    X1 
          MX3    -12
          SA1    B6-1        PRESET SOURCE ADDRESS
  
*         COPY LINE.
  
 WLT2     SA6    LOGBUF+B3   SAVE 
          SB3    B3+B1       INCREMENT IN 
          BX6    -X3*X6      CHECK FOR EOL
 +        LT     B3,B4,*+1   NO WRAP
          SB3    0           SET IN = FIRST 
          ZR     X6,WLT4     END OF LINE
          SA1    A1+B1       (X1) = NEXT SOURCE WORD
          BX6    X1 
          EQ     WLT2 
  
*         END OF LINE SO UPDATE POINTER.
  
 WLT4     SX6    X2+1        INCREMENT
          SX2    X6-8-1      COMPARE WITH MAXIMUM 
          NG     X2,WLT8     NOT MAXIMUM
  
*         ADVANCE OUT FOR ONE COMMAND.
  
 WLT6     SA1    LOGBUF+B2   (X1) = SOURCE WORD 
          SB2    B2+B1       INCREMENT POINTER
          BX2    -X3*X1      CHECK FOR EOL
          NZ     X2,WLT6     LOOP TILL EOL
          SX6    X6-1        (X6) = MAX LINE COUNT
  
 WLT8     LX6    18 
          SX7    B2+
          BX6    X6+X7       (X6) = 6/COUNT,18/IN 
          LX6    18 
          SX7    B3 
          BX6    X6+X7       ADD IN 
          LX6    18 
          SX7    B4 
          BX6    X6+X7       ADD LIMIT
          SA6    A2          REPLACE POINTER
  
*         CHECK IF LOG FILE ACTIVE. 
  
          SA2    L           (X2) = LOG FILE NAME AND STATUS
          SX2    X2+         (X2) = STATUS
          ZR     X2,WLTX     LOG FILE NOT ACTIVE
  
*         WRITE TEXT TO LOG FILE. 
  
          SA1    WLT.A       (X1) = MESSAGE TIME
          BX6    X1 
          WRITEO L           WRITE TIME 
          WRITEC X2,B6       WRITE TEXT 
          EQ     WLTX        EXIT 
  
 WLT.A    BSS    1           CURRENT TIME 
          TITLE  KERMIT DIRECTIVE PROCESSORS. 
***       KERMIT DIRECTIVE PROCESSORS.
* 
*         KERMIT DIRECTIVES MAY BE ENTERED VIA FOUR ROUTES:-
* 
*         1.  FROM THE KERMIT COMMAND ITSELF
*         2.  FROM A SPECIFIED INPUT FILE 
*         3.  INTERACTIVELY 
*         4.  FROM A REMOTE MICRO IN 'K' PACKETS
          SPACE  4,10 
***       INPUT COMMAND FORMAT. 
* 
*         WHEN KERMIT IS INITIALISED THERE IS THE OPTION TO ENTER 
*         COMMANDS. THESE COMMANDS MAY BE READ FROM INPUT OR FROM 
*         A SPECIFIED FILE. ONLY ONE COMMAND PER LINE MAY BE
*         ENTERED. KEYWORDS MAY BE SEPARATED BY BLANKS, COMMAS
*         OR UNDERLINES AND MUST NOT BE ABBREVIATED. THE VALID
*         COMMAND AND OPTIONS ARE SPECIFIED BELOW.
* 
*           HELP  [PARAM]          (GENERAL OR SPECIFIC HELP) 
* 
*           SET 
*                  CODE 
*                         ASCII    (SET 6 IN 12 DISPLAY CODE) 
*                         ASCII8   (SET 8 IN 12 ASCII)
*                         BINARY   (SET 7.5 IN 60 ASCII)
*                         DIS64    (SET 6 BIT DISPLAY CODE) 
*                         HEX      (SET HEX PAIR CODE - FORTRAN '40Z2') 
*                  DEBUG
*                         OFF      (DESELECT DEBUG LOGGING) 
*                         ON       (SELECT DEBUG LOGGING) 
*                  DELAY
*                         N        (SET DELAY TIME TO 'N' SECONDS)
*                  MODE 
*                         LOCAL    (LEAVE FILE LOCAL) 
*                         SAVE     (SAVE FILES - DO NOT REPLACE)
*                         REPLACE  (REPLACE FILES)
*                  WINDOW 
*                         OFF      (DESELECT WINDOWING OPTION)
*                         ON       (SELECT DEFAULT WINDOW SIZE) 
*                         SIZE N   (SET WINDOW SIZE TO 'N'  0<N<32 )
* 
*           SEND   LFN  [NAME]     (TRANSMIT FILE TO REMOTE MICRO)
* 
*           RECEIVE  [NAME]        (WAIT FOR INCOMMING FILE FROM MICRO) 
* 
*           SERVER                 (ENTER SERVER MODE - RECOMMENDED)
* 
*           VERSION                (DISPLAY NOS KERMIT VERSION NUMBER)
* 
*           EXIT                   (EXIT KERMIT WITHOUT TRANSFER) 
* 
*         WHEN THE INPUT FILE IS ASSIGNED TO A TERMINAL THEN A
*         '?' MAY BE ENTERED TO OBTAIN HELP. NOTE THAT THE '?'
*         SHOULD BE SEPARATED FROM ANY PRECEEDING TEXT BY AT
*         LEAST ONE SPACE.
* 
*         IT IS ALSO POSSIBLE TO ENTER ONE OR MORE OF THE ABOVE 
*         DIRECTIVES ON THE KERMIT CONTROL STATEMENT. EACH
*         KERMIT DIRECTIVE SHOULD BE SEPARATED FROM THE NEXT BY 
*         A '/'. WHEN DIRECTIVES ARE ENTERED BOTH ON THE CONTROL
*         STATEMENT AND ALSO FROM A LOCAL DIRECTIVES FILE THEN
*         THOSE ON THE FILE ARE PROCESSED FIRST. WHEN DIRECTIVES
*         ARE ENTERED BOTH ON THE CONTROL STATEMENT AND ALSO
*         FROM 'INPUT' THEN THOSE ON THE CONTROL STATEMENT ARE
*         PROCESSED FIRST.
          SPACE  4,10 
**        DIRECTIVE PROCESSORS. 
* 
*         THE FOLLOWING ROUTINES PROCESS KERMIT DIRECTIVES AS FOLLOWS:- 
* 
*         GDL - GET DIRECTIVE LIMITS
*         GPL - GET PARAMETER LIMITS
*         GDW - GET DIRECTIVE WORD
*         LND - LOCATE NEXT DIRECTIVE 
*         PCD - PROCESS COMMAND DIRECTIVES
*         PID - PROCESS INPUT DIRECTIVES
*         PHM - PRINT HELP MESSAGE
*         PID - PROCESS INPUT DIRECTIVES
*         SVT - SEARCH VALIDATION TABLE 
*         UDL - UNPACK DIRECTIVE LINE 
          SPACE  4,10 
**        PCD - PROCESS COMMAND DIRECTIVES. 
* 
*         THIS ROUTINE SCANS THE KERMIT COMMAND LINE FOR ANY
*         DIRECTIVES. IF FOUND THESE ARE PROCESSED. IF AN 
*         ERROR IS FOUND THEN INTERACTIVE MODE IS ENTERED.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   (X1) = 0 IF NO ERRORS
* 
*         USES   X - 1, 2, 3, 6.
*                A - 1, 2, 6. 
*                B - 2, 3, 4, 6, 7. 
* 
*         CALLS  GDW, SVT.
          SPACE  4,10 
 PCD      SUBR               ENTRY/EXIT 
  
*         SEARCH FOR END OF COMMAND.
  
          SB3    80          (B3) = MAX. COMMAND LENGTH 
          SA1    CCDR        (X1) = FIRST PACKED WORD 
          MX3    -6          (X3) = CHARACTER MASK
          SB2    10          (B2) = UNPACKING COUNTER 
          SB4    B2 
  
*         SEARCH FOR FINAL DELIMITER. 
  
 PCD2     LX1    6
          SB2    B2-B1       DECREMENT UNPACKING COUNTER
          BX2    -X3*X1      (X2) = CHARACTER 
          SB3    B3-B1       DECREMENT INSTRUCTION LENGTH 
 +        NZ     B2,*+1      NOT END OF SOURCE WORD 
          SB2    B4          RESET UNPACKING COUNTER
          SA1    A1+B1       (X1) = NEXT SOURCE WORD
          SX6    X2-1R.      CHECK FOR TERMINATOR 
          ZR     X6,PCD4     END
          SX6    X2-1R) 
          NZ     X6,PCD2     LOOP TILL TERMINATOR FOUND 
  
*         PROCESS REMAINDER OF LINE.
  
 PCD4     SB6    LINE        (B6) = FWA OF LINE BUFFER
          SB7    B6 
          MX3    -6 
  
 PCD6     NZ     B2,*+1 
          SB2    B4          RESET UNPACKING COUNTER
          SA1    A1+B1       (X1) = NEXT PACKED WORD
          LX1    6
          BX2    -X3*X1      (X2) = NEXT 6 BIT CODE 
          ZR     X2,PCD8     END OF COMMAND (COLON ILLEGAL) 
          SB2    B2-1        DECREMENT UNPACKING COUNTER
          SA2    X2+C2A      CONVERT TO ASCII 
          SX6    X2 
          SB3    B3-B1       DECREMENT COMMAND LENGTH 
          SB7    B7+B1       INCREMENT DESTINATION ADDRESS
          SA6    B7-B1       SAVE ASCII CHARACTER 
          NZ     B3,PCD6     LOOP TILL END OF COMMAND 
 PCD8     SX6    B6          (X6) = FWA OF COMMAND
          SX7    B7          (X7) = LWA + 1 
          LX6    18 
          BX6    X6+X7       (X6) = 24/0,18/FWA,18/LWA+1
          SA6    LINEP       SAVE 
          RJ     GDW         GET DIRECTIVE WORD 
          SX1    0           ASSUME NO INPUT
          ZR     X2,PCDX     NO INPUT SO EXIT 
          RJ     SVT         SEARCH VALIDATION TABLE
          EQ     PCDX        EXIT 
          SPACE  4,10 
**        PHM - PRINT HELP MESSAGE. 
* 
*         THIS ROUTINE COPIES THE GIVEN HELP MESSAGE TO THE 
*         OUTPUT FILE. NOTE THAT THE MESSAGE IS WRITTEN AS
*         ASCII.
* 
*         ENTRY  (B1) = 1 
*                (X1) = MESSAGE ORDINAL 
* 
*         EXIT   MESSAGE PRINTED
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 3, 6.
*                B - 2, 3, 6, 7.
* 
*         CALLS  CIO=, GDL, RDC=, WTC=. 
          SPACE  4,10 
 PHM      SUBR               ENTRY/EXIT 
  
*         RESET HELP FET. 
  
          SA2    ZZZZHLP+1   (X2) = FIRST + ....
          SX6    X2          (X6) = FIRST 
          SA6    A2+B1       SET IN = FIRST 
          SA6    A6+1        SET OUT = FIRST
  
*         CHECK FOR ERROR MESSAGE.
  
          PL     X1,PHM40    NO ERROR MESSAGE 
  
*         MOVE ERROR MESSAGE INTO FILE BUFFER.
  
          SA1    PHM.A+PHM.AL+X1 (X1) = MESSAGE ATTRIBUTE WORD
          SB7    X1 
          AX1    18 
          JP     B7+         PROCESS
  
*         LOCATE AND COPY COMMAND TO OUTPUT BUFFER. 
  
 PHM2     RJ     GDL         GET DIRECTIVE LIMITS 
          SA3    PHM.H       (X3) = FIRST WORD OF LINE
          BX6    X3          COPY TO HELP BUFFER
          SA3    A3+B1
          SA6    CBUF        SAVE WORD 1
          BX6    X3 
          SA3    A3+B1
          SA6    A6+B1       SAVE WORD 2
          SB2    6           RESET PACKING COUNTER
          BX6    X3          (X6) = WORD 3
          SX2    77B         (X2) = CHARACTER MASK
  
*         PACK STRING BUFFER BETWEEN LIMITS.
  
          GE     B6,B7,PHM10 ILLEGAL POINTER
  
 PHM4     SA3    B6          (X3) = NEXT ASCII CHARACTER
          SB6    B6+B1       INCREMENT POINTER
          SA3    X3+A2C      CONVERT TO 6/12 FORMAT 
          SX3    X3 
          BX7    X3 
          BX3    X2*X3       (X3) = LOW 6 BITS (IF 12 BIT CODE) 
          AX7    6           (X7) = TOP 6 BITS (IF 12 BIT CODE) 
          ZR     X7,PHM6     ONLY 6 BIT CODE
          LX6    6
          BX6    X6+X7       ADD 74 OR 76 CODE TO PACKING WORD
          SB2    B2-B1       DECREMENT PACKING COUNTER
          NZ     B2,PHM6     PACKING WORD NOT FULL
          SA6    A6+B1       SAVE FULL WORD 
          SB2    10          RESET PACKING COUNTER
          SX6    0           CLEAR PACKING WORD 
  
 PHM6     LX6    6
          SB2    B2-1        DECREMENT PACKING COUNTER
          BX6    X3+X6       ADD LOW 6 BITS 
          NZ     B2,PHM8     PACKING WORD NOT FULL
          SA6    A6+1        SAVE FULL WORD 
          SB2    10          RESET PACKING COUNTER
          SX6    0           CLEAR PACKING WORD 
  
 PHM8     LT     B6,B7,PHM4  LOOP TILL END OF DIRECTIVE 
  
*         COPY REST OF ERROR MESSAGE. 
  
 PHM10    SA3    X1          (X3) = PACKED DISPLAY CODE 
          SB3    10          RESET UNPACKING COUNTER
          SX1    X1+B1       INCREMENT CURRENT ADDRESS
  
 PHM12    LX3    6
          SB3    B3-1        DECREMENT UNPACKING COUNTER
          BX7    X2*X3       (X7) = NEXT CHARACTER
          ZR     X7,PHM16    END OF SOURCE
          LX6    6
          BX6    X6+X7       ADD CHARACTER TO PACKING WORD
          SB2    B2-1        DECREMENT PACKING COUNTER
          NZ     B2,PHM14    PACKING WORD NOT FULL
          SA6    A6+B1       SAVE FULL WORD 
          SB2    10          RESET PACKING COUNTER
          MX6    0           CLEAR PACKING WORD 
  
 PHM14    NZ     B3,PHM12    NOT END OF SOURCE WORD 
          EQ     PHM10       GOTO GET NEXT WORD 
  
*         END OF SOURCE SO FORCE EOL. 
  
 PHM16    GT     B2,B1,PHM18 NOT SINGLE BLANK 
          SX7    1R 
          LX6    6
          BX6    X6+X7       ADD BLANK
          SA6    A6+B1       SAVE FULL WORD 
          MX6    0
  
*         LEFT JUSTIFY TO FORCE EOL.
  
 PHM18    SB3    B2+B2
          SB2    B3+B2
          SB2    B2+B2       (B2) = UNUSED BIT COUNT
          LX6    B2          LEFT JUSTIFY LAST WORD 
          SA6    A6+1        SAVE 
          SX1    B1          SET REQUIRED HELP MESSAGE
          SA1    HELPCDE     (X1) = LATEST HELP CODE
          EQ     PHM38       GOTO OUTPUT TEXT 
  
*         OUTPUT GIVEN MESSAGE. 
  
 PHM20    SB7    X1          (B7) = WORD COUNT
          AX1    18 
          SA1    X1          (X1) = FIRST WORD
          BX6    X1 
          SA6    CBUF        SAVE FIRST WORD
          SX1    0
          SB7    B7-1        DECREMENT WORD COUNT 
          EQ     B7,B1,PHM38 ONLY ONE WORD
  
 +        SA1    A1+B1
          SB7    B7-B1       DECREMENT WORD COUNT 
          BX6    X1 
          SA6    A6+B1       SAVE 
          NZ     B7,*-1      LOOP TILL END OF TEXT
          SX1    0           FORCE NULL MESSAGE 
          EQ     PHM38       GOTO PRINT MESSAGE 
  
*         STATUS REQUEST. 
  
 PHM22    SX3    7777B       (X3) = EOL MASK
          SA1    PHM.J       (X1) = FIRST WORD OF STATUS MESSAGE
          BX6    X1 
          SA6    CBUF        PRESET DESTINATION ADDRESS 
  
*         PROCESS ACCORDING TO ATTRIBUTE WORD.
  
 PHM24    SA1    A1+B1       (X1) = NEXT WORD 
          ZR     X1,PHM34    END OF TEXT
          SB7    X1          (B7) = PROCESS ADDRESS 
          JP     B7+         PROCESS
  
*         OUTPUT TEXT.
  
 PHM26    AX1    18 
          SA2    X1          (X2) = FIRST WORD
          AX1    18 
          SB7    X1          (B7) = WORD COUNT
  
 +        BX6    X2          (X6) = DATA WORD 
          SB7    B7-B1       DECREMENT WORD COUNT 
          SA6    A6+B1       SAVE 
          SA2    A2+B1       LOAD NEXT WORD 
          NZ     B7,*-1      LOOP TILL END OF TEXT
          EQ     PHM24       GOTO READ NEXT ATTRIBUTE WORD
  
*         REGISTER LOOK-UP. 
  
 PHM28    AX1    18 
          SA2    X1+         (X2) = VALUE OF VARIABLE 
          AX1    18 
          SB7    X1+         (B7) = ADDRESS OF TABLE
          AX1    18          (X1) = LENGTH OF TABLE - 1 
          IX6    X2-X1       CHECK RANGE
 +        NG     X6,*+1      VALID
          SX2    X1+         FORCE LAST ENTRY 
          SA2    X2+B7       (X2) = REQUIRED TEXT 
          BX6    X2 
          SA6    A6+1        SAVE 
          EQ     PHM24       GOTO OUTPUT TEXT 
  
*         OUTPUT NUMERIC VALUE. 
  
 PHM30    AX1    18          (X1) = ADDRESS OF VARIABLE 
          SA2    X1+         (X2) = VALUE 
          BX1    X2 
          RJ     CDD         CONVERT TO DECIMAL DISPLAY 
          BX6    X4 
          LX6    60-6        FORCE LEADING BLANK
          MX4    -12
          BX6    X4*X6       FORCE EOL
          SX3    7777B       RESTORE MASK 
          SA6    A6+1        SAVE 
          EQ     PHM24       GOTO OUTPUT TEXT 
  
*         PROCESS WINDOW OPTION.
  
 PHM32    SA2    RWSIZE      (X2) = REQUESTED WINDOW SIZE 
          SA4    PHM.J2+1    ASSUME 'ON'
 +        NZ     X2,*+1      ASSUMPTION CORRECT 
          SA4    A4-1        USE 'OFF'
          BX6    X4 
          SA6    A6+B1       SAVE 
          NZ     X2,PHM24    GOTO PRINT SIZE
          SA1    A1+2        SKIP WINDOW SIZE 
          EQ     PHM24       GOTO NEXT TEXT 
  
*         OUTPUT LOG FILE.
  
 PHM34    SA1    LOGPTR      (X1) = LOG BUFFER POINTER
          SB4    X1+         (B4) = LIMIT 
          AX1    18 
          SB3    X1          (B3) = IN
          AX1    18 
          SB2    X1          (B2) = OUT 
  
*         COPY TO OUTPUT BUFFER.
  
 PHM36    SA1    LOGBUF+B2   (X1) = NEXT TEXT 
          BX6    X1 
          SA6    A6+B1       SAVE 
 +        SB2    B2+B1       INCREMENT OUT
          LT     B2,B4,*+1   NO WRAP AROUND 
          SB2    B0          SET OUT = FIRST
          NE     B2,B3,PHM36 LOOP TILL END OF BUFFER
          SX1    0           FORCE NULL MESSAGE 
  
*         LOAD FILE BUFFER AND COPY MESSAGE.
  
 PHM38    SX6    A6+1        (X6) = LWA + 1 
          SA6    ZZZZHLP+2   SET IN = LWA + 1 
  
 PHM40    MX6    -2 
          BX6    -X6*X1      (X6) = POSITION
          AX1    2           (X1) = WORD OFFSET 
          SX2    ZZZZHLP     (X2) = HELP FET ADDRESS
          SA1    HLPTABL+X1  (X1) = POINTER WORD
          BX7    X6 
          LX7    4
          IX7    X7-X6       (X7) = 15 * POSITION 
          SB7    X7+15
          LX1    B7          RIGHT JUSTIFY RANDOM SECTOR ADDRESS
          MX6    -15
          BX6    -X6*X1      (X6) = RANDOM SECTOR ADDRESS OF MESSAGE
          SA6    X2+6        SAVE IN FET
          READ   X2          LOAD INPUT BUFFER
  
*         COPY TEXT TO OUTPUT.
  
 PHM42    READC  ZZZZHLP,PHM.B+1,20 
          NZ     X1,PHM44    END OF TEXT
          WRITEC O,PHM.B
          EQ     PHM42       LOOP TILL END OF TEXT
  
*         FLUSH OUTPUT BUFFER AND EXIT. 
  
 PHM44    WRITER O,R
          EQ     PHMX        EXIT 
  
 PHM.A    BSS    0           ERROR MESSAGE DESCRIPTOR TABLE 
          VFD    6/0,18/0,18/0,18/PHM22  STATUS REQUEST 
          VFD    6/0,18/PHM.I,18/PHM.IL,18/PHM20  EMPTY TAKE FILE 
          VFD    6/0,18/PHM.G,18/PHM.GL,18/PHM20  VERSION REQUEST 
          VFD    6/0,18/0,18/PHM.C,18/PHM2  NUMERIC RANGE ERROR 
          VFD    6/0,18/0,18/PHM.D,18/PHM2  COMMAND INCOMPLETE
          VFD    6/0,18/0,18/PHM.E,18/PHM2  COMMAND AMBIGUOUS 
          VFD    6/0,18/0,18/PHM.F,18/PHM2  COMMAND ILLEGAL 
 PHM.AL   EQU    *-PHM.A
 PHM.B    VFD    12/0011B,48/6H 
          BSS    20 
 PHM.C    BSS    0
          CON    10H < ^C^O^N^,10HT^A^I^N^S ,10H^A^N ^I^L^      ! 
          CON    10HL^E^G^A^L ,10H^N^U^M^E^R,10H^I^C ^V^A^      ! 
          CON    6LL^U^E. 
 PHM.D    CON    10H < ^I^S ^I,10H^N^C^O^M^P,10H^L^E^T^E. ,0
 PHM.E    CON    10H < ^I^S ^A,10H^M^B^I^G^U,8L^O^U^S.
 PHM.F    CON    10H < ^I^S ^I,10H^L^L^E^G^A,4L^L.
 PHM.G    BSS    0           VERSION TEXT 
          CON    2L 
          DIS    ,'               NOS KERMIT' 
          DIS    ,'               ==========' 
          CON    2L 
          DIS    ,'         VERSION        "VERSION"' 
          DIS    ,'         AUTHOR         P. JARVIS' 
          DIS    ,'         DOCUMENTATION  A. BALLARD'
          DIS    ,'         DATE          "DATE"' 
          DIS    ,'         TIME          "TIME"' 
          CON    2L 
 PHM.GL   EQU    *-PHM.G
 PHM.H    CON    10H T^H^E ^C^,10HO^M^M^A^N^,4RD >
 PHM.I    BSS    0           MISSING OR EMPTY TAKE FILE 
          CON    2L 
          DIS    ,'E^M^P^T^Y ^O^R ^M^I^S^S^I^N^G TAKE ^F^I^L^E.'
          CON    2L 
 PHM.IL   EQU    *-PHM.I
 PHM.J    BSS    0           STATUS TEXT
          CON    2L 
          VFD    6/0,18/PHM.J1L,18/PHM.J1,18/PHM26
          VFD    6/2,18/PHM.J2,18/DEBUG,18/PHM28
          VFD    6/0,18/PHM.J3L,18/PHM.J3,18/PHM26
          VFD    6/3,18/PHM.J4,18/PFFLAG,18/PHM28 
          VFD    6/0,18/PHM.J5L,18/PHM.J5,18/PHM26
          VFD    6/5,18/PHM.J6,18/FFORM,18/PHM28
          VFD    6/0,18/PHM.J7L,18/PHM.J7,18/PHM26
          VFD    6/0,18/0,18/DELAY,18/PHM30 
          VFD    6/0,18/PHM.J8L,18/PHM.J8,18/PHM26
          VFD    6/0,18/0,18/0,18/PHM32 
          VFD    6/0,18/PHM.J9L,18/PHM.J9,18/PHM26
          VFD    6/0,18/0,18/RWSIZE,18/PHM30
          VFD    6/0,18/PHM.JZL,18/PHM.JZ,18/PHM26
          CON    0
 PHM.J1   BSS    0
          DIS    ,'    CURRENT STATUS'
          DIS    ,'    =============='
          DIS    ,'  '
          CON    10HDEBUG STAT,10HUS       -
 PHM.J1L  EQU    *-PHM.J1 
 PHM.J2   BSS    0           DEBUG TEXT TABLE 
          CON    4L OFF 
          CON    4L ON
          CON    2L ? 
 PHM.J3   BSS    0
          CON    10HFILE MODE ,10H         -
 PHM.J3L  EQU    *-PHM.J3 
 PHM.J4   BSS    0           FILE MODE TABLE
          CON    6L LOCAL 
          CON    6L SAVE
          CON    8L REPLACE 
          CON    2L ? 
 PHM.J5   BSS    0
          CON    10HFILE CODE ,10H         -
 PHM.J5L  EQU    *-PHM.J5 
 PHM.J6   BSS    0           FILE CODE BRANCH TABLE 
          CON    6L DIS64 
          CON    6L ASCII 
          CON    8L ASCII8
          CON    4L HEX 
          CON    8L BINARY
          CON    2L ? 
 PHM.J7   BSS    0
          CON    10HDELAY TIME,10H (SECS)  -
 PHM.J7L  EQU    *-PHM.J7 
 PHM.J8   BSS    0
          CON    10HWINDOWING ,10HOPTION   -
 PHM.J8L  EQU    *-PHM.J8 
 PHM.J9   BSS    0
          CON    10HWINDOW SIZ,10HE        -
 PHM.J9L  EQU    *-PHM.J9 
 PHM.JZ   BSS    0
          CON    2L 
          DIS    ,'LAST LINES OF LOG FILE ARE-' 
          CON    2L 
 PHM.JZL  EQU    *-PHM.JZ 
          SPACE  4,10 
**        PID - PROCESS INPUT DIRECTIVES. 
* 
*         THIS ROUTINE PROCESSES DIRECTIVES ENTERED EITHER
*         ON THE KERMIT COMMAND OR FROM AN INPUT FILE. IF THE 
*         INPUT IS FROM A FILE ASSIGNED TO THE TERMINAL THEN
*         AN INTERACTIVE DIALOGUE IS ENTERED. 
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   (X1) = EXIT CODE 
*                        0 - SERVER 
*                        1 - SEND 
*                        2 - RECEIVE
*                        3 - EXIT 
* 
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2, 6. 
*                B - NONE.
* 
*         CALLS  CIO=, GDW, PCD, PHM, RDC=, SVT, UDL, WTW=. 
          SPACE  4,10 
 PID      SUBR               ENTRY/EXIT 
  
*         CHECK FOR NO INPUT. 
  
          SA1    C           (X1) = INPUT FET STATUS WORD 
          MX6    42 
          BX1    X1*X6       EXTRACT FILE NAME
          ZR     X1,PIDX     NO INPUT SO EXIT 
  
*         CHECK IF INPUT ASSIGNED TO THE TERMINAL.
  
 PID2     REWIND C,R         ENSURE DEVICE TYPE FIELD IS SET
          SA1    X2+B1       (X1) = FIRST + TYPE CODE 
          MX6    -11
          LX1    12 
          BX6    -X6*X1      (X6) = DEVICE CODE 
          ZR     X6,PID16    DEVICE NOT ASSIGNED
          SX0    X6-2RTT     CHECK IF ASSIGNED TO TERMINAL
          ZR     X0,PID4     ASSIGNED TO THE TERMINAL 
          READ   X2,R        LOAD BUFFER
          SA1    X2          (X1) = FET STATUS WORD 
          LX1    59-9        CHECK FOR EMPTY FILE 
          PL     X1,PID8     DATA FOUND 
          SX1    -6          FORCE ERROR MESSAGE
          EQ     PID18       GOTO PRINT MESSAGE 
  
*         INPUT FILE ASSIGNED TO TERMINAL SO DISABLE SYSTEM PROMPT. 
  
 PID4     PROMPT OFF         TURN OFF PROMPT
          RJ     PCD         PROCESS COMMAND DIRECTIVES (IF ANY)
          NZ     X1,PID18    HELP TEXT REQUESTED
          NG     X1,PID12    TERMINATED COMMAND LIST
  
*         ISSUE INPUT PROMPT. 
  
 PID6     WRITEW O,PID.A,3
          WRITER X2,R 
          READ   C           LOAD BUFFER
  
*         PROCESS INPUT.
  
 PID8     READC  C,PID.B     READ LINE
          ZR     X1,PID10    DATA AVAILABLE 
  
*         END OF DATA UNLESS ASSIGNED TO THE TERMINAL.
  
          ZR     X0,PID6     TERMINAL INPUT SO CONTINUE 
          RJ     PCD         PROCESS COMMAND DIRECTIVES (IF ANY)
          NZ     X1,PID18    HELP REQUESTED 
          EQ     PID12       GOTO RETURN TRANSFER MODE FLAG 
  
*         PROCESS DATA. 
  
 PID10    SA1    PID.B       (X1) = FIRST WORD OF INPUT 
          RJ     UDL         UNPACK DIRECTIVE LINE
          RJ     GDW         GET DIRECTIVE WORD 
          ZR     X2,PID22    NO INPUT SO IGNORE 
          RJ     SVT         SEARCH VALIDATION TABLE
          NZ     X1,PID18    HELP REQUESTED 
          PL     X1,PID22    EOL SO CHECK FOR MORE
  
*         END OF DIRECTIVES SO EXIT.
  
 PID12    SA1    TMODE       (X1) = TRANSFER MODE FLAG
          NG     X1,PID14    'TAKE' REQUEST 
  
*         SET 'CAPAS' BYTE AND EXIT.
  
          SA2    RWSIZE      (X2) = REQUESTED WINDOW SIZE 
          SX6    2           ASSUME WINDOWING REQUIRED
 +        NZ     X2,*+1      ASSUMPTION CORRECT 
          SX6    0           CLEAR WINDOWING FLAG 
          SA6    CAPAS       UPDATE 'CAPAS' BYTE
          EQ     PIDX        EXIT 
  
*         PROCESS 'TAKE' REQUEST. 
  
 PID14    MX6    0
          SX1    -3          ASSUME FILE NAME MISSING 
          SA6    A1          CLEAR TRANSFER MODE
          SA2    FNAME       (X2) = TAKE FILE NAME
          ZR     X2,PID18    NO FILE NAME SPECIFIED 
          SB7    X2          (B7) = LWA + 1 OF FILE NAME
          AX2    18 
          SB6    X2          (B6) = FWA OF FILE NAME
          SB7    B7-B6       (B7) = LENGTH OF FLE NAME
          SB5    B1          FLAG WILD CARDS ILLEGAL
          RJ     BFN         BUILD FILE NAME
          MX7    -18
          SA2    C           (X2) = HELP FET WORD 
          BX6    X6*X7       ENSURE CORECT LENGTH 
          BX7    -X7*X2      EXTRACT CURRENT STATUS 
          BX6    X6+X7       MERGE NEW NAME 
          SA6    A2+         UPDATE FET NAME
          EQ     PID2        GOTO INITIALISE INPUT
  
*         DEVICE NOT ASSIGNED SO CHECK FOR 'INPUT'. 
  
 PID16    SA1    X2+         (X1) = FILE NAME + STATUS
          SA2    PID.C       (X2) = 'INPUT' 
          BX2    X1-X2       COMPARE
          AX2    18          IGNORE STATUS
          ZR     X2,PID20    FORCE 'INPUT' ASSIGNED TO TERMINAL 
          SX1    -6          FLAG 'TAKE' FILE NOT FOUND 
  
*         HELP TEXT REQUESTED.
  
 PID18    RJ     PHM         PRINT HELP MESSAGE 
          ZR     X0,PID6     TERMINAL INPUT SO NO PROBLEM 
  
*         SWITCH INPUT TO TERMINAL. 
  
 PID20    SA1    C           (X1) = SOURCE FET
          MX6    -18
          BX6    -X6*X1      (X6) = STATUS
          SA2    PID.C       (X2) = REQUIRED FILE NAME 'INPUT'
          BX6    X2+X6       ADD TO STATUS
          SA6    A1          UPDATE FET 
          SX0    0           FLAG TERMINAL INPUT
          REWIND C,R         INITIALISE FILE
          PROMPT OFF
          EQ     PID6        GOTO INTERACTIVE INPUT 
  
*         INPUT PROCESSED SO CHECK FOR MORE.
  
 PID22    ZR     X0,PID6     INTERACTIVE SO ISSUE PROMPT
          EQ     PID8        GOTO BATCH INPUT 
  
 PID.A    BSS    0           PROMPT 
          VFD    12/0007B,12/4116B,12/4117B,12/4123B,12/4040B 
          VFD    12/4113B,12/4105B,12/4122B,12/4115B,12/4111B 
          VFD    12/4124B,12/4076B,12/0000B,12/0000B,12/0000B 
 PID.B    BSS    21          INPUT LINE BUFFER
 PID.C    CON    5LINPUT
          SPACE  4,10 
          SPACE  4,10 
**        SVT - SEARCH VALIDATION TABLE.
* 
*         THIS ROUTINE SCANS THE GIVEN VALIDATION TABLE FOR 
*         THE CURRENT COMMAND. SUBSEQUENT PROCESSING IS AS
*         SPECIFIED WITHIN ANY FOUND TABLE ENTRY. 
* 
*         ENTRY  (B1) = 1 
*                (X2) = FIRST COMMAND WORD
* 
*         EXIT   (X1) = EXIT FLAG 
*                           +N = HELP MESSAGE 'N' REQUESTED 
*                            0 = COMMAND PROCESSED
*                           -1 = ILLEGAL COMMAND
*                           -2 = COMMAND AMBIGUOUS
*                           -3 = COMMAND INCOMPLETE 
*                           -4 = NUMERIC VALUE OUT OF RANGE 
*                           -5 = VERSION REQUEST
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 2, 7.
* 
*         CALLS  GDW, GPL, LND, WDL.
          SPACE  4,10 
 SVT      SUBR               ENTRY/EXIT 
  
 SVT0     SX6    1
          SA6    HELPCDE     RESET HELP CODE
          SA1    VTABLE      (X1) = FIRST ENTRY IN VALIDATION TABLE 
  
*         IF HELP NOT REQUIRED EXTRACT COUNTERS FROM DATA.
  
 SVT2     SX6    X2-077B     CHECK FOR HELP 
          ZR     X6,SVT30    HELP REQUESTED 
          MX3    -4 
          BX6    -X3*X2      (X6) = COMMAND CHARACTER COUNT 
          BX2    X2-X6       (X2) = COMMAND CHARACTERS
          LX7    X6,B1
          SB2    X6+         (B2) = NUMBER OF CHARACTERS IN COMMAND 
          LX7    2
          IX6    X7-X6       (X6) = NUMBER OF BITS IN COMMAND CHARACTERS
          MX7    1
          SB7    X6-1 
          AX7    B7          (X7) = COMMAND CHARACTER MASK
  
*         SEARCH TABLE FOR MATCH. 
  
 SVT4     BX6    X1-X2       COMPARE
          BX6    X6*X7       CHECK ONLY SUPPLIED CHARACTERS 
          ZR     X6,SVT6     MATCH (PROBABLY) 
          SA1    A1+2        (X1) = NEXT TABLE ENTRY
          NZ     X1,SVT4     NOT END OF TABLE 
          SX1    -1          FLAG NOT FOUND 
          EQ     SVTX        EXIT 
  
*         CHARACTERS SUPPLIED MATCH SO CHECK IF ENOUGH. 
  
 SVT6     BX6    -X3*X1      (X6) = REQUIRED CHARACTER COUNT
          SB7    X6 
          GE     B2,B7,SVT8  COMMAND RECOGNISED 
          SX1    -2          FLAG AMBIGUITY 
          EQ     SVTX        EXIT 
  
*         COMMAND RECOGNISED. 
  
 SVT8     SA1    A1+B1       (X1) = COMMAND ATTRIBUTE WORD
          BX6    X3*X1       (X6) = PARAMETERS
          BX1    -X3*X1      (X1) = PROCESS CODE
          LX6    60-6        RIGHT JUSTIFY HELP LEVEL 
          SX7    X6          (X7) = HELP CODE 
          AX6    18 
          SA7    HELPCDE     UPDATE REQUIRED HELP CODE
          SA1    SVT.A+X1    (X1) = PROCESS ADDRESS 
          SB7    X1+
          JP     B7+         BRANCH ACCORDING TO PROCESS CODE 
  
*         MORE TABLE ENTRIES REQUIRED.
  
 SVT10    SA1    X6          (X1) = NEXT TABLE ENTRY
          RJ     GDW         GET DIRECTIVE WORD 
          NZ     X2,SVT2     NOT END OF LINE
          SX1    -3          FLAG COMMAND INCOMPLETE
          EQ     SVTX        EXIT 
  
*         SET ADDRESS TO SPECIFIC VALUE.
  
 SVT12    BX5    X6          SAVE ATTRIBUTE DESCRIPTOR
          RJ     GDW         GET DIRECTIVE WORD 
          SX7    X2-077B     CHECK FOR HELP REQUEST 
          ZR     X7,SVT30    HELP REQUEST 
          SX7    X5          (X7) = ADDRESS OF VARIABLE TO DEFINE 
          AX5    18 
          SX6    X5          (X6) = VALUE TO DEFINE 
          SA6    X7          SAVE VALUE 
          EQ     SVT32       GOTO CHECK FOR END OF DIRECTIVE
  
*         SET GIVEN ADDRESS TO NUMERIC VALUE. 
  
 SVT14    SA6    SVT.B       SAVE ATTRIBUTE WORD
          RJ     GDW         GET DIRECTIVE WORD 
          SX7    X2-077B     CHECK FOR HELP REQUEST 
          ZR     X7,SVT30    HELP REQUESTED 
          MX3    -4 
          BX2    X2*X3       CLEAR CHARACTER COUNT
          MX3    -7 
          MX6    0
  
*         CONVERT ASCII TO BINARY NUMBER. 
  
 SVT15    LX2    7
          BX7    -X3*X2      (X7) = NEXT ASCII CODE 
          SX7    X7-060B     CONVERT TO BINARY
          NG     X7,SVT28    ILLEGAL
          SX1    X7-10       CHECK RANGE
          PL     X1,SVT28    ILLEGAL
          BX2    X2*X3       CLEAR FROM SOURCE
          LX1    X6,B1       (X1) = 2 * CURRENT VALUE 
          LX6    3
          IX6    X1+X6       (X6) = CURRENT VALUE * 10
          IX6    X6+X7       ADD NEW VALUE
          NZ     X2,SVT15    LOOP TILL END OF NUMBER
  
*         CHECK NUMBER IS WITHIN LIMITS.
  
          SA2    SVT.B       (X2) = ATTRIBUTE WORD
          SB7    X2 
          AX2    18 
          MX7    -9 
          BX7    -X7*X2      (X7) = MIN VALUE 
          AX2    9
          IX7    X6-X7       COMPARE
          NG     X7,SVT28    TOO SMALL
          IX7    X2-X6       COMPARE WITH MAX VALUE 
          NG     X7,SVT28    TOO LARGE
          SA6    B7          SAVE VALUE 
          EQ     SVT32       GOTO ADVANCE COMMAND POINTER 
  
*         PROCESS AT GIVEN ADDRESS. 
  
 SVT16    SB7    X6          (B7) = PROCESS ADDRESS 
          AX6    18 
          JP     B7+         PROCESS
  
*         PROCESS HELP REQUEST. 
  
 SVT18    SX1    X6+         ASSUME NO EXTENSION
          SA6    HELPCDE     PRESET HELP CODE 
          RJ     GDW         GET DATA WORD
          ZR     X2,SVTX     NO EXTENSION 
          SA1    HTABLE      (X1) = FIRST WORD FROM VALIDATION TABLE
          EQ     SVT2        PROCESS
  
*         'SERVER' OR 'EXIT'. 
  
 SVT20    SA6    SVT.B       SAVE MODE FLAG 
          SX6    0
          SA6    FNAME       CLEAR FILE NAME
          SA6    ANAME       CLEAR ALTERNATIVE FILE NAME
          RJ     GDW         GET DIRECTIVE WORD 
          ZR     X2,SVT34    NO EXTENSION SO VALID
          SX6    X2-077B     CHECK FOR HELP REQUEST 
          ZR     X6,SVT30    HELP 
          SX1    -1          FLAG ILLEGAL 
          EQ     SVTX        EXIT 
  
*         'SEND' OR 'TAKE'. 
  
 SVT22    SA6    SVT.B       SAVE TRANSFER MODE FLAG
          SX6    0
          SA6    FNAME       CLEAR FILE NAME POINTER
          SA6    ANAME       CLEAR ALTERNATIVE NAME POINTER 
          RJ     GPL         GET PARAMETER LIMITS (FILE NAME) 
          SX1    -3          ASSUME ERROR 
          ZR     X6,SVTX     ASSUMPTION CORRECT 
          SX2    X6-077B     CHECK FOR HELP REQUEST 
          ZR     X2,SVT30    HELP 
          SA6    FNAME       SAVE FILE NAME POINTER 
          RJ     GPL         GET PARAMETER LIMITS (ALTERNATIVE FILE NAME
          ZR     X6,SVT34    NO ALTERNATIVE FILE NAME 
          SX2    X6-077B     CHECK FOR HELP REQUEST 
          ZR     X2,SVT30    HELP 
          SA6    ANAME       SAVE ALTERNATIVE FILE NAME 
          EQ     SVT34       GOTO RETURN TRANSFER MODE
  
*         RECEIVE.
  
 SVT24    SA6    SVT.B       SAVE TRANSFER MODE FLAG
          SX6    0
          SA6    ANAME       CLEAR ALTERNATIVE FILE NAME
          RJ     GPL         GET PARAMETER LIMITS 
          ZR     X6,SVT34    NO NAME SPECIFIED
          SX2    X6-077B     CHECK FOR HELP REQUEST 
          ZR     X2,SVT30    HELP 
          SA6    ANAME       SAVE ALTERNATIVE FILE NAME 
          EQ     SVT34       GOTO RETURN TRANSFER MODE
  
*         RETURN GIVEN MESSAGE REQUEST. 
  
 SVT26    SX1    X6          (X1) = MESSAGE CODE
          EQ     SVTX        EXIT 
  
*         ILLEGAL NUMERIC VALUE.
  
 SVT28    SX1    -4          FLAG NUMERIC CONVERSION ERROR
          EQ     SVTX        EXIT 
  
*         HELP REQUESTED. 
  
 SVT30    SA1    HELPCDE     (X1) = REQUIRED MESSAGE ORDINAL
          EQ     SVTX        EXIT 
  
*         SKIP TILL END OF DIRECTIVE
  
 SVT32    RJ     WDL         WRITE DIRECTIVE TO LOG FILE
          RJ     LND         LOCATE NEXT DIRECTIVE
          SX1    0           ASSUME NO MORE 
          ZR     X6,SVTX     EXIT 
          RJ     GDW         GET DIRECTIVE WORD 
          EQ     SVT0        NOW SCAN THIS DIRECTIVE
  
*         SET TRANSFER MODE FLAG AND EXIT.
  
 SVT34    RJ     WDL         WRITE DIRECTIVE TO LOG FILE
          SA2    SVT.B       (X2) = TRANSFER MODE FLAG REQUIRED 
          MX1    60          FLAG COMPLETE
          SX6    X2          (X6) = TRANSFER MODE FLAG
          SA6    TMODE       SAVE 
          EQ     SVTX        EXIT 
  
 SVT.A    BSS    0           COMMAND CODE BRANCH TABLE
          CON    SVT10       MORE TABLE ENTRIES REQUIRED
          CON    SVT12       SET VARIABLE TO SPECIFIC VALUE 
          CON    SVT14       SET VARIABLE TO NUMERIC VALUE
          CON    SVT16       PROCESS AT GIVEN ADDRESS 
          CON    SVT26       RETURN GIVEN MESSAGE REQUEST 
 SVT.B    BSS    1           NUMERIC PARAMETER LIMITS 
          SPACE  4,10 
**        GDW - GET DIRECTIVE WORD. 
* 
*         THIS ROUTINE RETURNS THE NEXT WORD OF UPTO 8 ASCII
*         CHARACTERS FROM THE SOURCE STRING. LOWER CASE CHARACTERS
*         ARE CONVERTED TO UPPER CASE AND LEADING BLANKS ARE
*         IGNORED. A WORD TERMINATES ON A BLANK, A SLASH OR AT
*         THE END OF LINE.
* 
*         ENTRY  (B1) = 1 
*                (LINEP) POINT TO CURRENT LINE POSITION AND LIMIT 
* 
*         EXIT   (X2) = 56/PACKED ASCII,4/CHAR COUNT
*                       OR  52/0,8/077B IF HELP REQUEST 
*                (LINEP) UPDATED
* 
*         USES   X - 2, 3, 6, 7.
*                A - 2, 7.
*                B - 2, 3, 6, 7.
* 
*         CALLS 
          SPACE  4,10 
 GDW      SUBR               ENTRY/EXIT 
          SA2    LINEP       (X2) = LINE POINTER
          SB7    X2+         (B7) = LWA + 1 
          AX2    18 
          SB6    X2+         (B6) = CURRENT ADDRESS 
          MX2    0           CLEAR RETURN CODE
          GE     B6,B7,GDWX  END OF LINE REACHED
          SX6    0           CLEAR PACKING WORD 
  
*         SKIP LEADING BLANKS AND '/' CHARACTERS. 
  
 GDW2     SA2    B6          (X2) = NEXT ASCII CHARACTER
          SB6    B6+B1       INCREMENT ADDRESS
          SX3    X2-040B     CHECK FOR BLANK
          ZR     X3,GDW4     IGNORE BLANKS
          SX3    X2-057B     CHECK FOR '/'
          ZR     X3,GDW6     EOL SO NO PARAMETER
          SB2    0           (B2) = CURRENT CHARACTER COUNT 
          SB3    8           (B3) = MAXIMUM CHARACTER COUNT 
          SX3    X2-077B     CHECK FOR ?
          NZ     X3,GDW8     NOT HELP REQUEST 
          SX3    B6          (X3) = CURRENT ADDRESS 
          SX7    B7          (X7) = LIMIT ADDRESS 
          LX3    18 
          BX7    X3+X7       (X7) = 24/0,18/CURRENT ADR,18/LIMIT ADR
          SA7    LINEP       UPDATE LINE POINTER
          EQ     GDWX        EXIT 
  
 GDW4     LT     B6,B7,GDW2  LOOP TILL WORD OR EOL
  
 GDW6     SX2    0           FLAG NO DATA 
          EQ     GDWX        EXIT (X6) = 0
  
*         CONVERT TO UPPER CASE IF REQUIRED.
  
 GDW8     EQ     B2,B3,GDW12 ALREADY MAX. CHARACTER COUNT 
          SX3    X2-141B     CHECK FOR L.C. A 
          NG     X3,GDW10    NO ADJUSTMENT
          SX3    X2-172B-1   CHECK FOR L.C. Z 
          PL     X3,GDW10    NO ADJUSTMENT
          SX2    X2-40B      CONVERT TO UPPER CASE
  
 GDW10    LX6    7
          SB2    B2+1        INCREMENT CHARACTER COUNT
          BX6    X2+X6       ADD NEW CHARACTER
  
 GDW12    EQ     B6,B7,GDW14 END OF LINE SO MUST BE END OF WORD 
          SA2    B6+         (X2) = NEXT CHARACTER
          SX3    X2-077B     CHECK FOR '?'
          ZR     X3,GDW14    END OF WORD
          SX3    X2-057B     CHECK FOR '/'
          ZR     X3,GDW14    END OF WORD
          SB6    B6+1        INCREMENT POINTER
          SX3    X2-040B     CHECK FOR BLANK
          NZ     X3,GDW8     LOOP TILL END OF WORD
  
*         END OF WORD SO UPDATE POINTER.
  
 GDW14    SX3    B6          (X3) = CURRENT ADDRESS 
          SX7    B7          (X7) = LIMIT ADDRESS 
          LX3    18 
          BX7    X3+X7       (X7) = 24/0,18/CURRENT,18/LWA+1
          SA7    LINEP       SAVE 
  
*         LEFT JUSTIFY TEXT AND ADD CHARACTER COUNT.
  
          SB7    B3-B2       (B7) = UNUSED CHARACTER COUNT
          SX7    B7 
          LX7    3
          SB6    X7          (B6) = 8 * UNUSED CHARACTER COUNT
          SB7    B6-B7       (B7) = SHIFT COUNT 
          LX6    B7          LEFT JUSTIFY TEXT
          SX7    B2          (X7) = CHARACTER COUNT 
          LX6    4
          BX2    X6+X7       (X2) = 56/ASCII,4/COUNT
          EQ     GDWX        EXIT 
          SPACE  4,10 
**        GDL - GET DIRECTIVE LIMITS. 
* 
*         THIS ROUTINE SCANS FORWARD AND BACKWARDS FROM THE CURRENT 
*         LINE BUFFER POSITION FOR THE START AND END OF THE DIRECTIVE.
*         IT IS USED TO LOCATE THE AREA TO BE PRINTED WHEN AN ERROR 
*         IS DETECTED.
* 
*         ENTRY  (B1) = 1 
*                (LINEP) CONTAINS CURRENT POINTER 
* 
*         EXIT   (B6) = FWA OF DIRECTIVE
*                (B7) = LWA + 1 OF DIRECTIVE
* 
*         USES   X - 2, 6.
*                A - 2. 
*                B - 2, 6, 7. 
* 
*         CALLS  NONE.
          SPACE  4,10 
 GDL      SUBR               ENTRY/EXIT 
          SA2    LINEP       (X2) = POINTER 
          SB7    X2          (B7) = LWA + 1 OF STRING 
          AX2    18 
          SB6    X2          (B6) = CURRENT ADDRESS 
  
*         LOCATE END OF COMMAND.
  
          EQ     B6,B7,GDL4  ALREADY AT LIMIT 
          SB2    B7          (B2) = LIMIT 
          SB7    B6          (B7) = CURRENT 
  
 GDL2     SA2    B7+         (X2) = CURRENT CHARACTER 
          SX6    X2-057B     CHECK FOR '/'
          ZR     X6,GDL4     END OF DIRECTIVE FOUND 
          SB7    B7+1        INCREMENT POINTER
          LT     B7,B2,GDL2  LOOP TILL END FOUND
  
*         SEARCH FOR BEGINNING OF DIRECTIVE.
  
 GDL4     SB2    LINE        (B2) = FWA OF LINE POINTER 
          EQ     B2,B6,GDLX  AT START 
  
 GDL6     SB6    B6-B1       DECREMENT CURRENT POSITION 
          SA2    B6          (X2) = CURRENT CHARACTER 
          SX6    X2-057B     CHECK FOR '/'
          ZR     X6,GDL8     START FOUND
          GT     B6,B2,GDL6  LOOP TILL START FOUND
          EQ     GDLX 
  
 GDL8     SB6    B6+B1       (B6) = STARTING ADDRESS
          EQ     GDLX        EXIT 
          SPACE  4,10 
**        GPL - GET PARAMETER LIMITS. 
* 
*         THIS ROUTINE SCANS THE STRING BUFFER FROM THE CURRENT 
*         POSITION AND RETURNS THE STARTING AND ENDING ADDRESS OF 
*         THE NEXT PARAMETER. THIS IS DESIGNED FOR LOCATING FILE
*         NAMES IN 'SEND' AND 'RECEIVE' COMMANDS. 
* 
*         ENTRY  (B1) = 1 
*                (LINEP) = CURRENT LINE POINTERS
* 
*         EXIT
* 
*         USES   X - 2, 3, 6, 7.
*                A - 2, 6, 7. 
*                B - 6, 7.
* 
*         CALLS  NONE.
          SPACE  4,10 
 GPL      SUBR               ENTRY/EXIT 
          SA2    LINEP       (X2) = LINE POINTER
          SB7    X2          (B7) = LIMIT ADDRESS 
          AX2    18 
          SB6    X2          (B6) = CURRENT POSITION
          MX6    0           ASSUME NO PARAMETER
          EQ     B6,B7,GPLX  NO PARAMETER 
  
*         SKIP TILL START OF PARAMETER. 
  
 GPL2     SA2    B6          (X2) = NEXT CHARACTER
          SX3    X2-057B     CHECK FOR '/'
          ZR     X3,GPLX     EOL SO NO PARAMETER
          SX3    X2-077B     CHECK FOR HELP REQUEST 
          ZR     X3,GPL4     HELP 
          SX3    X2-040B     CHECK FOR BLANK
          NZ     X3,GPL6     START OF PARAMETER FOUND 
          SB6    B6+1        INCREMENT CURRENT ADDRESS
          LT     B6,B7,GPL2  LOOP IF NOT END OF BUFFER
          EQ     GPLX        NO PARAMETER SO EXIT 
  
*         HELP REQUEST. 
  
 GPL4     SX6    B6          (X6) = CURRENT ADDRESS 
          SX3    B7          (X3) = LIMIT ADDRESS 
          LX6    18 
          BX6    X3+X6       (X6) = 24/0,18/CURRENT/18/LIMIT
          SA6    LINEP       UPDATE LINE POINTER
          SX6    077B        RETURN '?' 
          EQ     GPLX        EXIT 
  
*         LOCATE END OF PARAMETER.
  
 GPL6     SX6    B6          (X6) = STARTING ADDRESS
          SB6    B6+1        INCREMENT CURRENT ADDRESS
          LX6    18 
  
 GPL8     EQ     B6,B7,GPL10 END OF BUFFER
          SA2    B6+         (X2) = CURRENT CHARACTER 
          SX3    X2-040B     CHECK FOR BLANK
          ZR     X3,GPL10    END OF PARAMETER FOUND 
          SX3    X2-077B     CHECK FOR '?'
          ZR     X3,GPL10    END OF PARAMETER FOUND 
          SX3    X2-057B     CHECK FOR '/'
          SB6    B6+1        INCREMENT POINTER
          NZ     X3,GPL8     LOOP TILL END FOUND
  
*         END OF DIRECTIVE SO SAVE LWA + 1 AND UPDATE POINTER.
  
 GPL10    SX7    B6          (X7) = LWA + 1 
          BX6    X6+X7       (X6) = POINTER FOR PARAMETER 
          SX3    B7 
          LX7    18 
          BX7    X3+X7       (X7) = LINE POINTER
          SA7    LINEP       UPDATE 
          EQ     GPLX        EXIT 
          SPACE  4,10 
**        LND - LOCATE NEXT DIRECTIVE.
* 
*         THIS ROUTINE SCANS FROM THE CURRENT POINTER POSITION UNTIL
*         THE NEXT DIRECTIVE IS LOCATED OR THE END OF LINE REACHED. 
* 
*         ENTRY  (B1) = 1 
*                (LINEP) = CURRENT LINE POINTER 
* 
*         EXIT   (X6) = NEW POINTER VALUE (ZERO IF EOL) 
* 
*         USES   X - 2, 6.
*                A - 2, 6.
*                B - 6, 7.
* 
*         CALLS  NONE.
          SPACE  4,10 
 LND      SUBR               ENTRY/EXIT 
  
          SA2    LINEP       (X2) = LINE POINTER
          SB7    X2          (B7) = LIMIT 
          AX2    18 
          SB6    X2          (B6) = CURRENT ADDRESS 
          MX6    0           ASSUME EOL 
          EQ     B6,B7,LNDX  ASSUMTION CORRECT
  
*         SKIP TILL '/' OR EOL. 
  
 LND2     SA2    B6          (X2) = NEXT ASCII CHARACTER
          SB6    B6+B1       INCREMENT POINTER
          SX6    X2-057B     CHECK FOR '/'
          ZR     X6,LND4     END OF STATEMENT 
          SX6    X2-040B     CHECK FOR BLANK
          ZR     X6,LND4     IGNORE BLANKS
  
*         START OF DIRECTIVE SO UPDATE POINTER. 
  
          SX6    B6-B1       (X6) = ADDRESS OF START
          SX2    B7          (X2) = LIMIT 
          LX6    18 
          BX6    X2+X6       (X6) = 24/0,18/CURRENT,18/LIMIT
          SA6    LINEP       UPDATE POINTER 
          EQ     LNDX        EXIT 
  
*         NOT END OF DIRECTIVE SO CHECK FOR EOL.
  
 LND4     LT     B6,B7,LND2  CONTINUE SEARCH
          EQ     LNDX        EXIT (X6) = 0
          SPACE  4,10 
**        UDL - UNPACK DIRECTIVE LINE.
* 
*         THIS ROUTINE UNPACKS THE GIVEN PACKED 6/12 FORMAT 
*         LINE INTO THE ASCII STRING BUFFER 'LINE'. THE 
*         POINTER 'LINEP' IS SET ACCORDINGLY. 
* 
*         ENTRY  (B1) = 1 
*                (X1) = FIRST PACKED WORD 
*                (A1) = ADDRESS OF FIRST PACKED WORD
* 
*         EXIT   (LINE CONVERTED AND POINTER SET
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6. 
*                B - 2, 3.
* 
*         CALLS  NONE.
          SPACE  4,10 
 UDL      SUBR               ENTRY/EXIT 
  
          SB2    10          RESET UNPACKING COUNTER
          SA6    LINEP       PRESET DESTINATION ADDRESS 
          SX7    77B         (X7) = CHARACTER MASK
  
 UDL2     LX1    6
          BX2    X1*X7       (X2) = NEXT SOURCE CHARACTER 
          ZR     X2,UDL8     END OF INPUT 
          SX6    X2-74B      CHECK FOR ESCAPE CODE
          NG     X6,UDL6     NOT ESCAPE CODE
          LX6    59-0 
          NG     X6,UDL6     NOT 74 OR 76 
          LX2    X6,B1
          LX6    4
          LX2    B1 
          IX6    X2+X6       (X6) = 0 IF 74NN, 20 IF 76NN 
          SB2    B2-B1       DECREMENT UNPACKING COUNTER
          SB3    X6+20       (B3) = 20 IF 74NN, 40 IF 76NN
  
          NZ     B2,UDL4     SOURCE WORD NOT EMPTY
          SB2    10          RESET UNPACKING COUNT
          SA1    A1+1        (X1) = NEXT SOURCE WORD
 UDL4     LX1    6
          BX2    X1*X7       (X2) = NEXT 6 BIT CODE 
          SA2    X2+C2A      CONVERT TO ASCII 
          AX2    B3          POSITION 
          SB2    B2-1        DECREMENT UNPACKING COUNTER
          SX6    X2          (X6) = ASCII CODE
 +        NG     X6,*+1      ILLEGAL SO IGNORE
          SA6    A6+1        SAVE CHARACTER 
          NZ     B2,UDL2     NOT END OF SOURCE WORD 
          SA1    A1+1        GET NEXT SOURCE WORD 
          SB2    10          RESET UNPACKING COUNTER
          EQ     UDL2 
  
*         NOT ESCAPED CHARACTER.
  
 UDL6     SA2    X2+C2A      CONVERT TO ASCII 
          SX6    X2 
          SA6    A6+B1       SAVE 
          SB2    B2-B1       DECREMENT UNPACKING COUNTER
          NZ     B2,UDL2     NOT END OF SOURCE WORD 
          SA1    A1+B1       (X1) = NEXT SOURCE WORD
          SB2    10          RESET UNPACKING COUNTER
          EQ     UDL2 
  
*         END OF LINE SO SET POINTER. 
  
 UDL8     SX6    A6+1        (X6) = LWA + 1 
          SX7    LINE        (X7) = FWA 
          LX7    18 
          BX6    X6+X7       (X6) = 24/0,18/FWA,18/LWA+1
          SA6    LINEP       SET POINTER
          EQ     UDLX        EXIT 
          TITLE  DEBUG ROUTINES.
***       DEBUG FILE FORMAT.
* 
*         WHEN DEBUG IS SELECTED USING THE COMMAND 'SET DEBUG ON' THEN
*         A LOCAL FILE IS PRODUCED CONTAINING ALL THE I/O PROCESSED BY
*         KERMIT. BY DEFAULT THE LOCAL FILE NAME IS 'ZZZZDBG'. THE FILE 
*         IS CREATED IN 6/12 FORMAT. THE OUTPUT IS AS FOLLOWS:- 
* 
*         WHEN THE KERMIT STATE CHANGE ROUTINE IS CALLED THE NEW STATE
*         IS PRINTED WITH THE WINDOW POINTER AND FREE BUFFER QUEUE
*         POINTER (IN OCTAL). THE FORMAT IS-
* 
*            STATE - SCW     WPTR = NNNNNNNNB      FQPTR = MMMMMMMMB
* 
*         ANY PACKET TRANSMITTED IS LISTED IN FULL, INCLUDING THE 
*         PACKET HEADER AND CHECKSUM. THE FORMAT IS-
* 
*            XMT-[SOH]XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX[CR]
* 
*         ANY INPUT RECEIVED IS LISTED IN A SIMILAR FORM TO THE 
*         ABOVE EXCEPT THAT THE LINE STARTS WITH ONE OF THE FOLLOWING 
*         PREFIX- 
*                 RCV-         NORMAL VALID PACKET
*                 CHK-         CHECKSUM ERROR IN PACKET 
*                 LOST-        START OF PACKET LOST 
* 
*         IF A FATAL ERROR OCCURS WITHIN KERMIT THEN THE REPRIEVE 
*         BLOCK, INCLUDING EXCHANGE PACKAGE, IS WRITTEN TO THE
*         DEBUG FILE. THIS WILL OCCUR EVEN IF 'DEBUG' IS NOT
*         SELECETED.
          SPACE  4,10 
**        DEBUG ROUTINES. 
* 
*         THE FOLLOWING ROUTINES ARE USED TO PROVIDE DIAGNOSTIC 
*         INFORMATION TO ASSIST PROGRAM DEVELOPMENT.
  
* 
*         DBC - DEBUG COMMENCE
*         DBE - DEBUG END 
*         DBI - DEBUG INPUT PACKET
*         DBL - DEBUG LOST INPUT
*         DBO - DEBUG OUTPUT PACKET 
*         DBQ - DEBUG INPUT CHECKSUM ERROR
*         DBS - DEBUG STATE CHANGE
*         DBU - DEBUG UNPACK ROUTINE
*         DBX - DEBUG EXCHANGE PACKAGE AREA 
*         DBZ - UNPACK DISPLAY CODE TO ASCII BUFFER 
          SPACE  4,10 
**        DBC - DEBUG COMMENNCE.
* 
*         THIS ROUTINE SHOULD BE CALLED DURING THE PROGRAM
*         STARTUP. IF THE DEBUG FLAG IS SET THEN THE DEBUG
*         FILE 'ZZZZDBG' IS INITIALISED.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   DEBUG FILE INITIALISED 
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS  CIO=, WLM. 
          SPACE  4,10 
 DBC      SUBR               ENTRY/EXIT 
  
          SA1    DEBUG       (X1) = DEBUG FLAG
          ZR     X1,DBCX     DEBUG OFF SO IGNORE
          REWIND D,R         INITIALISE FILE
          WRITE  X2,*        PRESET FET WRITE FUNCTION
          SA1    DBC.A       (X1) = FIRST WORD OF LOG FILE MESSAGE
          RJ     WLM         WRITE LOG MESSAGE
          EQ     DBCX        EXIT 
  
 DBC.A    DIS    ,'DEBUG FILE OPENED.'
          SPACE  4,10 
**        DBE - DEBUG END.
* 
*         THIS ROUTINE FLUSHES THE DEBUG OUTPUT FILE AND
*         CLOSES THE FILE.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   FILE CLOSED IF DEBUG SELECTED
* 
*         USES   X - 1. 
*                A - 1. 
*                B - NONE.
* 
*         CALLS  CIO=, WLM. 
          SPACE  4,10 
 DBE      SUBR               ENTRY/EXIT 
  
          SA1    DEBUG       (X1) = DEBUG FLAG
          ZR     X1,DBEX     DEBUG OFF SO IGNORE
          WRITER D,R         FLUSH BUFFER 
          REWIND X2,R 
          SA1    DBE.A       (X1) = FIRST WORD OF TEXT
          RJ     WLM         WRITE LOG MESSAGE
          EQ     DBEX        EXIT 
  
 DBE.A    DIS    ,'DEBUG FILE CLOSED.'
          SPACE  4,10 
**        DBI - DEBUG INPUT.
* 
*         THIS ROUTINE DUMPS THE CONTENTS OF THE GIVEN INPUT
*         PACKET TO THE LOG FILE IF DEBUG IS SELECTED.
* 
*         ENTRY  (B1) = 1 
*                (X1) = FIRST PACKED WORD OF PACKET (8 IN 12) 
*                (A1) = ADDRESS OF FIRST WORD 
* 
*         EXIT   PACKET WRITTEN TO DEBUG FILE 
* 
*         USES   X - 2, 3.
*                A - 2. 
*                B - NONE.
* 
*         CALLS  DBU. 
          SPACE  4,10 
 DBI      SUBR               ENTRY/EXIT 
          SA2    DEBUG       (X2) = DEBUG FLAG
          ZR     X2,DBIX     NOT SELECTED SO EXIT 
          SX3    0           FLAG PRINT FIRST BYTE
          SA2    DBI.A       (X2) = HEADER TEXT 
          RJ     DBU         DEBUG UNPACK 
          EQ     DBIX        EXIT 
  
 DBI.A    CON    6LRCV -
          SPACE  4,10 
**        DBL - DEBUG LOST INPUT. 
* 
*         THIS ROUTINE DUMPS THE CONTENTS OF THE GIVEN INPUT
*         TO THE DEBUG FILE IF DEBUG IS ON. THIS ROUTINE IS CALLED
*         WHEN INPUT IS READ WITHOUT AN 'SOH' BYTE. 
* 
*         ENTRY  (B1) = 1 
*                (B6) = FWA OF INPUT BUFFER (IN DISPLAY CODE) 
* 
*         EXIT   DEBUG DATA WRITTEN IF SELECTED 
* 
*         USES   X - 1, 2, 3. 
*                A - 1, 2.
*                B - NONE.
* 
*         CALLS  DBU. 
          SPACE  4,10 
 DBL      SUBR               ENTRY/EXIT 
          SA2    DEBUG       (X2) = DEBUG FLAG
          ZR     X2,DBLX     DEBUG OFF SO IGNORE
          SA1    B6          (X1) = FIRST SOURCE WORD 
          SX3    B0          PRINT FIRST BYTE FLAG
          SA2    DBL.A       (X2) = HEADER TEXT 
          RJ     DBU         DEBUG UNPACK 
          EQ     DBLX        EXIT 
  
 DBL.A    CON    7LLOST - 
          SPACE  4,10 
**        DBO - DEBUG OUTPUT. 
* 
*         THIS ROUTINE DUMPS THE CONTENTS OF THE GIVEN OUTPUT 
*         PACKET TO TH LOG FILE. THIS ROUTINE SHOULD ONLY BE
*         CALLED IF DEBUG IS ACTIVE.
* 
*         ENTRY  (B1) = 1 
*                (X1) = FIRST PACKED WORD OF PACKET 
*                (A1) = ADDRESS OF FIRST WORD 
* 
*         EXIT   PACKET WRITTEN TO DEBUG FILE 
* 
*         USES   X - 2. 
*                A - 2. 
*                B - NONE.
* 
*         CALLS  DBU. 
          SPACE  4,10 
 DBO      SUBR               ENTRY/EXIT 
          SX3    1           FLAG SKIP FIRST BYTE 
          SA2    DBO.A       (X2) = HEADER TEXT 
          RJ     DBU         DEBUG UNPACK 
          EQ     DBOX        EXIT 
  
 DBO.A    CON    6LXMT -
          SPACE  4,10 
**        DBQ - DEBUG INPUT CHECKSUM ERROR. 
* 
*         THIS ROUTINE DUMPS THE CONTENTS OF THE GIVEN INPUT
*         PACKET TO THE LOG FILE IF DEBUG IS SELECTED. THE
*         PACKET HAS A CHECKSUM ERROR SO IS NOT PROCESSED 
*         FURTHER.
* 
*         ENTRY  (B1) = 1 
*                (X1) = FIRST PACKED WORD OF PACKET (8 IN 12) 
*                (A1) = ADDRESS OF FIRST WORD 
* 
*         EXIT   PACKET WRITTEN TO DEBUG FILE 
* 
*         USES   X - 2, 3.
*                A - 2. 
*                B - NONE.
* 
*         CALLS  DBU. 
          SPACE  4,10 
 DBQ      SUBR               ENTRY/EXIT 
          SA2    DEBUG       (X2) = DEBUG FLAG
          ZR     X2,DBQX     NOT SELECTED SO EXIT 
          SX3    0           FLAG PRINT FIRST BYTE
          SA2    DBQ.A       (X2) = HEADER TEXT 
          RJ     DBU         DEBUG UNPACK 
          EQ     DBQX        EXIT 
  
 DBQ.A    CON    6LCHK -
          SPACE  4,10 
**        DBS - DEBUG STATE CHANGE. 
* 
*         THIS ROUTINE WRITES THE NEW PROTOCOL STATE TO THE 
*         LOG FILE. IT SHOULD ONLY BE CALLED IF DEBUG IS ACTIVE.
* 
*         ENTRY  (B1) = 1 
*                (X6) = STATE ORDINAL 
* 
*         EXIT   STATE CHANGE WRITTEN TO LOG FILE 
* 
*         USES   X - 1, 6.
*                A - 1, 6, 7. 
*                B - 6. 
* 
*         CALLS  SYS=, WOD, WTW=. 
          SPACE  4,10 
 DBS      SUBR               ENTRY/EXIT 
          SB6    DBS.A+1     (B6) = FWA OF BUFFER + 1 
          SA1    DBS.B+X6    (X1) = STATE TEXT
          BX6    X1          SAVE 
          SA6    B6+B1       SAVE 
          CLOCK  DBS.A       SAVE CURRENT TIME
          SA1    WPTR        (X1) = WINDOW POINTER
          RJ     WOD         CONVERT WORD TO OCTAL
          SA6    DBS.A+4     SAVE 
          SA7    A6+1 
          SA1    FQPTR       (X1) = FREE QUEUE POINTER
          RJ     WOD         CONVERT WORD TO OCTAL
          SA6    DBS.A+8     SAVE 
          SA7    A6+1 
          WRITEW D,DBS.A,11 
          EQ     DBSX        EXIT 
  
 DBS.A    CON    0,10H  STATE - ,0
          CON    10H  WPTR  - ,0,0,10HB 
          CON    10H  FQPTR - ,0,0,2LB
 DBS.B    BSS    0           TEXT FOR EACH STATE
          LOC    0
 FPE      CON    4HFPE
 SCW      CON    4HSCW
 SCT      CON    4HSCT
 SND      CON    4HSND
 REC      CON    4HREC
 SCS      CON    4HSCS
 SCR      CON    4HSCR
 INT      CON    4HINT
 SI       CON    2HSI 
 SIE      CON    4HSIE
 SIV      CON    4HSIV
 OF       CON    2HOF 
 SF       CON    2HSF 
 SFW      CON    4HSFW
 SD       CON    2HSD 
 SDT      CON    4HSDT
 SDW      CON    4HSDW
 SEF      CON    4HSEF
 SET      CON    4HSET
 SB       CON    2HSB 
 RF       CON    2HRF 
 RFF      CON    4HRFF
 RD       CON    2HRD 
 RDT      CON    4HRDT
 RDW      CON    4HRDW
 RDE      CON    4HRDE
 SCG      CON    4HSCG
 ADP      CON    4HADP
 ERR      CON    4HERR
 ABT      CON    4HABT
 CMP      CON    4HCMP
          LOC    *O 
          SPACE  4,10 
**        DBU - DEBUG UNPACK. 
* 
*         THIS ROUTINE UNPACKS THE GIVEN ASCII PACKET TO A CDC DISPLAY
*         FORMAT AND WRITES IT TO THE LOG FILE. 
* 
*         ENTRY  (B1) = 1 
*                (X1) = FIRST WORD OF PACKET (8 IN 12)
*                (X2) = HEADER TEXT (6 BIT) 
*                (X3) = 1 IF FIRST DATA BYTE TO BE SKIPPED (ELSE 0) 
*                (A1) = ADDRESS OF PACKET 
* 
*         EXIT   PACKET WRITTEN TO LOG FILE 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 6. 
*                B - 6, 7.
* 
*         CALLS  WTS=.
          SPACE  4,10 
 DBU      SUBR               ENTRY/EXIT 
  
*         INITIALISE. 
  
          SX6    1R 
          SA6    DBU.B       PRESET DESTINATION ADDRESS 
          SB6    5           (B6) = SHIFT COUNT 
          SB7    5           (B7) = UNPACKING COUNTER 
          SX0    177B        (X0) = ASCII MASK
          SX7    77B         (X7) = CDC DISPLAY CODE MASK 
  
*         CHECK IF FIRST CHARACTER TO BE SKIPPED. 
  
          ZR     X3,DBU2     PRINT FIRST BYTE 
          SB7    B7-B1       DECREMENT UNPACKING COUNTER
          LX1    12          DROP FIRST DATA BYTE 
  
*         UNPACK DISPLAY CODE TEXT. 
  
 DBU2     LX2    6
          BX6    X2*X7       (X6) = NEXT DISPLAY CODE 
          BX2    -X7*X2      CLEAR FROM SOURCE
          SA6    A6+B1       SAVE 
          NZ     X2,DBU2     LOOP TILL END OF TEXT
          NZ     B7,DBU4     NOT END OF PACKET SOURCE WORD
          SB7    5           RESET UNPACKING COUNTER
          SA1    A1+1        (X1) = NEXT PACKED WORD
  
*         UNPACK PACKET DATA TO STRING BUFFER.
  
 DBU4     LX1    12 
          BX2    X0*X1       (X2) = NEXT ASCII CODE 
          AX3    X2,B6       CHECK FOR CONTROL CODE (0-31)
          BX6    X0-X2       CHECK FOR 'DEL'
          IX6    X3*X6       (X6) = 0 IF CONTROL CODE 
          SB7    B7-B1       DECREMENT UNPACKING COUNTER
          ZR     X6,DBU6     CONTROL CODE 
          SA2    A2C+X2      CONVERT TO 6/12 DISPLAY CODE 
          SX2    X2 
          BX6    X2 
 +        AX6    6           (X6) = ESCAPE CODE (IF REQUIRED) 
          ZR     X6,*+1      NO ESCAPE CODE 
          SA6    A6+B1       SAVE 
          BX6    X2*X7       (X6) = L.O. CHARACTER
          SA6    A6+B1       SAVE 
          NZ     B7,DBU4     NOT END OF SOURCE WORD 
          SB7    B6          RESET UNPACKING COUNTER
          SA1    A1+B1       (X1) = NEXT SOURCE WORD
          EQ     DBU4        LOOP TILL END OF PACKET
  
*         CONTROL CHARACTER (OR END OF PACKET). 
  
 DBU6     ZR     X3,*+1      IF CONTROL CHARACTER (0-31)
          SX2    32          FORCE 'DEL' OFFSET 
          MX3    -12         CHECK FOR END OF PACKET
          BX3    -X3*X1 
          ZR     X3,DBU8     END OF LINE
          SA2    DBU.A+X2    (X2) = REQUIRED CONTROL CODE TEXT
          EQ     DBU2        GOTO UNPACK CDC TEXT 
  
*         END OF LINE SO WRITE TO DEBUG FILE. 
  
 DBU8     SB7    A6+B1       (B7) = LWA + 1 
          SB6    DBU.B       (B6) = FWA OF BUFFER 
          SB7    B7-B6       (B7) = CHARACTER COUNT 
          CLOCK  DBU.C       GET CURRENT TIME 
          SX2    D           (X2) = ADDRESS OF DUMP FET 
          SA1    DBU.C       (X1) = TIME
          BX6    X1 
          WRITEO X2          WRITE TO LOG FILE
          WRITES X2,B6,B7    WRITE TEXT 
          EQ     DBUX        EXIT 
  
 DBU.A    BSS    0           CONTROL CODE TEXT TABLE
          LOC    0
          CON    5L[NUL]
          CON    5L[SOH]
          CON    5L[STX]
          CON    5L[ETX]
          CON    5L[EOT]
          CON    5L[ENQ]
          CON    5L[ACK]
          CON    5L[BEL]
          CON    4L[BS] 
          CON    4L[HT] 
          CON    4L[LF] 
          CON    4L[VT] 
          CON    4L[FF] 
          CON    4L[CR] 
          CON    4L[SO] 
          CON    4L[SI] 
          CON    5L[DLE]
          CON    5L[DC1]
          CON    5L[DC2]
          CON    5L[DC3]
          CON    5L[DC4]
          CON    5L[NAK]
          CON    5L[SYN]
          CON    5L[ETB]
          CON    5L[CAN]
          CON    4L[EM] 
          CON    5L[SUB]
          CON    5L[ESC]
          CON    4L[FS] 
          CON    4L[GS] 
          CON    4L[RS] 
          CON    4L[VS] 
          CON    5L[DEL]
          LOC    *O 
 DBU.B    BSS    334         LINE BUFFER
 DBU.C    BSS    1           CURRENT TIME 
          SPACE  4,10 
**        DBX - DEBUG EXCHANGE PACKAGE AREA.
* 
*         THIS ROUTINE IS CALLED WHEN A REPREIVED ERROR IS BEING
*         PROCESSED. THE REPREIVE BLOCK IS WRITTEN TO THE DEBUG 
*         FILE EVEN IF DEBUG IS NOT SELECTED. 
* 
*         ENTRY  (B1) = 1 
*                REPRIEVE BLOCK DEFINED 
* 
*         EXIT   BLOCK WRITTEN TO DEBUG FILE
* 
*         USES   X -
*                A -
*                B -
* 
*         CALLS 
          SPACE  4,10 
 DBX      SUBR               ENTRY/EXIT 
  
          CLOCK  DBX.A       GET CURRENT TIME 
          WRITEW D,DBX.A,3   WRITE HEADER 
          SA1    DBX.A       (X1) = CURRENT TIME
          BX6    X1 
          SA0    -30B        (A0) = -WORD COUNT 
          SA6    DBX.B       SAVE CLOCK TIME
  
*         PROCESS NEXT WORD.
  
 DBX2     SA1    RPB+30B+A0  (X1) = NEXT WORD FROM BLOCK
          RJ     WOD         CONVERT WORD TO OCTAL DISPLAY CODE 
          SA6    DBX.B+2     SAVE FIRST WORD
          SA1    DBX.C+30B+A0 (X1) = TEXT 
          SA0    A0+B1       DECREMENT WORD COUNT 
          SA7    A6+B1       SAVE SECOND WORD 
          BX6    X1 
          SA6    A6-B1       SAVE TEXT
          MX7    0
          SA7    A7+B1       TERMINATE BUFFER 
          WRITEW D,DBX.B,5   WRITE LINE 
          SX1    A0-1        CHECK FOR END
          NG     X1,DBX2     LOOP FOR ALL WORDS 
  
*         FLUSH BUFFER IF DEBUG NOT SELECTED. 
  
          SA1    DEBUG       (X1) = DEBUG FLAG
          NZ     X1,DBXX     DEBUG SELECTED 
          WRITER X2,R        FLUSH OUTPUT BUFFER
          EQ     DBXX        EXIT 
  
 DBX.A    CON    0,10H INTERNAL ,6LERROR. 
 DBX.B    BSS    5           LINE BUFFER
 DBX.C    BSS    0           HEADER TEXT TABLE
          LOC    0
          CON    10H LEN+FUNC 
          CON    10H CHK+TADR 
          CON    10H CHECKSUM 
          CON    10H MSK+EC+E 
          CON    10H PEND INT 
          CON    10H PEND RA1 
          CON    10H INT I/O
          CON    10H EF 
          CON    10H
          CON    10H  P+A0+B0 
          CON    10H RA+A1+B1 
          CON    10H FL+A2+B2 
          CON    10H EM+A3+B3 
          CON    10H RE+A4+B4 
          CON    10H FE+A5+B5 
          CON    10H MA+A6+B6 
          CON    10H    A7+B7 
          CON    10H       X0 
          CON    10H       X1 
          CON    10H       X2 
          CON    10H       X3 
          CON    10H       X4 
          CON    10H       X5 
          CON    10H       X6 
          CON    10H       X7 
          LOC    *O 
          SPACE  4,10 
**        DBZ - UNPACK DISPLAY CODE TO ASCII STRING BUFFER. 
* 
*         THIS ROUTINE UNPACKS ONE WORD IN CDC 6 BIT DISPLAY
*         CODE AND SAVES THE RESULT AS AN ASCII STRING. 
* 
*         ENTRY  (B1) = 1 
*                (X6) = DISPLAY CODE
*                (A0) = DESTINATION ADDRESS 
* 
*         EXIT   ASCII IN STRING BUFFER 
*                (A0) = NEXT ADDRESS
* 
*         USES   X - 1, 6, 7. 
*                A - 0, 1, 7. 
*                B - NONE.
* 
*         CALLS  NONE.
          SPACE  4,10 
 DBZ      SUBR               ENTRY/EXIT 
  
 DBZ2     MX1    -6 
          LX6    6
          BX1    -X1*X6      (X1) = NEXT CHARACTER
          BX6    X1-X6       DELETE FROM SOURCE 
          SA1    C2A+X1      CONVERT TO ASCII 
          SX7    X1+         (X7) = ASCII 
          SA7    A0          SAVE IN BUFFER 
          SA0    A0+B1       INCREMENT BUFFER ADDRESS 
          NZ     X6,DBZ2     LOOP FOR ALL CHARACTERS
          EQ     DBZX        EXIT 
          SPACE  4,10 
*         COMMON DECKS. 
* 
 OPL      XTEXT  COMCARG
 OPL      XTEXT  COMCCDD
 OPL      XTEXT  COMCCFD
 OPL      XTEXT  COMCCIO
 OPL      XTEXT  COMCCPM
 OPL      XTEXT  COMCDXB
 OPL      XTEXT  COMCLFM
 OPL      XTEXT  COMCPFM
 OPL      XTEXT  COMCRDC
 OPL      XTEXT  COMCRDO
 OPL      XTEXT  COMCRDW
 OPL      XTEXT  COMCSYS
 OPL      XTEXT  COMCWOD
 OPL      XTEXT  COMCWTC
 OPL      XTEXT  COMCWTO
 OPL      XTEXT  COMCWTS
 OPL      XTEXT  COMCWTW
          SPACE  4,10 
*         BUFFERS.
* 
 CBUF     BSS    CBUFL       COMMAND BUFFER 
 DBUF     BSS    DBUFL       DEBUG BUFFER 
 IBUF     BSS    IBUFL       TERMINAL INPUT BUFFER
 LBUF     BSS    LBUFL       LOGGING BUFFER 
 FBUF     BSS    FBUFL       FILE BUFFER
 OBUF     BSS    OBUFL       TERMINAL OUTPUT BUFFER 
 OBFWA    BSS    OBCNT*OBLEN PACKET OUTPUT BUFFERS
          TITLE  PRESET CODE
          ORG    CBUF 
          SPACE  4,10 
**        WHF - WRITE HELP FILE.
* 
*         THIS ROUTINE PRESETS THE HELP FILE AS A RANDOM FILE 
*         CONTAINING ONE HELP MESSAGE PER PRU. THE DATA IS READ 
*         SEQUENTIALLY FROM THE SOURCE WITH A '.EOR' INDICATING 
*         EACH PRU BOUNDARY.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   HELP FILE CREATED
* 
*         USES   X - 0, 1, 5, 6, 7. 
*                A - 1, 6, 7. 
*                B - 5, 6, 7. 
* 
*         CALLS  CIO=.
          SPACE  4,10 
 WHF      SUBR               ENTRY/EXIT 
          REWIND ZZZZHLP,R
          SB6    WHF.A       (B6) = FWA OF TEXT 
          SB7    4           RESET TABLE PACKING COUNT
          SX5    0
          SB5    HLPTABL     (B5) = FWA OF HELP POINTER TABLE 
  
*         SEARCH FOR '.EOR' 
  
          SA1    =4L.EOR
          BX0    X1 
          SA1    B6-B1
  
 WHF2     SA1    A1+B1       (X1) = NEXT WORD 
          BX6    X0-X1       COMPARE
          NZ     X6,*        LOOP TILL EOR
  
*         WRITE THIS BLOCK (FROM (B6) TO (A1)-1). 
  
          SX6    B6          (X6) = START ADDRESS 
          SB6    A1+B1       (B6) = ADDRESS OF NEXT BLOCK 
          SA1    X2+B1       (X1) = FIRST + ... 
          MX7    42 
          BX7    X1*X7       CLEAR FIRST
          BX7    X6+X7       ADD NEW FIRST
          SA7    A1          REPLACE
          SX7    B6-B1       (X7) = LWA + 1 
          SA7    A7+B1       SET OUT = LWA + 1
          SA6    A7+B1       SET OUT = FIRST
          SA1    A6+B1       (X1) = LIMIT + ....
          MX6    42 
          SX7    X7+B1       (X7) = LWA + 2 
          BX6    X1*X6
          BX6    X6+X7       ADD NEW LIMIT
          SA6    A1          REPLACE
  
*         SAVE STARTING ADDRESS IN HELP TABLE.
  
          SA1    X2+6        (X1) = RANDOM WORD POINTER FROM FET
          LX5    15 
          AX1    30          (X1) = CURRENT RANDOM INDEX
          SB7    B7-B1       DECREMENT PACKING COUNTER
          BX5    X1+X5       ADD NEW POINTER
          NZ     B7,WHF4     NOT FULL 
          BX6    X5          (X6) = FULL POINTER
          SA6    B5          SAVE 
          SB7    4           RESET PACKING COUNTER
          SB5    B5+1        INCREMENT TABLE POINTER
          SX5    0           CLEAR PACKING WORD 
  
*         NOW WRITE BLOCK.
  
 WHF4     WRITER X2,R        FLUSH BUFFER 
  
*         CHECK IF END OF DATA. 
  
          SA1    B6          (X1) = NEXT SOURCE WORD
          BX6    X0-X1       CHECK FOR TWO '.EOR'S
          NZ     X6,WHF2     NOT END OF DATA
  
*         END OF DATA SO UPDATE LAST HELP POINTER.
  
          ZR     X5,WHFX     POINTER EMPTY
          BX6    X5 
 +        SB7    B7-B1       DECREMENT COUNTER
          LX6    15 
          NZ     B7,*        LEFT JUSTIFY 
          SA6    B5          SAVE 
          REWIND X2,R        CLOSE FILE 
          SETFET X2,(BUF=CBUF,101B) 
          EQ     WHFX        EXIT 
  
 WHF.A    BSS    0           DATA FOR HELP FILE 
          CON    2L  ,4L.EOR,2L  ,10L 
          CON    10L      KERM,10LIT HELP FA,6LCILITY,2L
          CON    10LW^H^E^N ^Y,10L^O^U ^U^S^,10LE K^E^R^M^,10LI^T ^Y^O^U
          CON    10L ^C^A^N ^S,10L^P^E^C^I^F,10L^Y ^A^N^Y ,10L^O^F ^T^H^
          CON    10LE ^F^O^L^L,10L^O^W^I^N^G,4L@D  ,2L
          CON    10L     C^O^M,10L^M^A^N^D  ,10L   P^A^R^A,10L^M^E^T^E^R
          CON    10L   ^1    C,10L^O^M^M^A^N,10L^D     P^A,10L^R^A^M^E^T
          CON    4L^E^R,10L     HELP ,10L          ,10L         ^ 
          CON    10L1    RECEI,2LVE,10L     SET  ,10L 
          CON    10L         ^,10L1    SEND ,2L  ,10L 
          CON    10L       COD,10LE        ^,10L1    SERVE,2LR
          CON    10L          ,10L       DEB,10LUG       ^,10L1    EXIT 
          CON    2L  ,10L          ,10L       DEL,10LAY       ^ 
          CON    10L1    VERSI,2LON,10L          ,10L       MOD 
          CON    10LE        ^,10L1    STATU,2LS ,10L 
          CON    10L       WIN,10LDOW      ^,10L1    TAKE ,2L 
          CON    2L  ,10LF^O^R ^M^O,10L^R^E ^I^N^,10LF^O^R^M^A^ 
          CON    10LT^I^O^N ^E,10L^N^T^E^R ^,10LT^H^E ^C^O,10L^M^M^A^N^D
          CON    10L-^N^A^M^E ,2L? ,10L          ,10L 
          CON    10L          ,6L  ^O^R,10L          ,10L        ^C 
          CON    10L^O^M^M^A^N,10L^D-^N^A^M^,10LE ^P^A^R^A,10L^M^E^T^E^R
          CON    6L(^S) ?,2L  ,4L.EOR,2L
          CON    10L          ,10L          ,10L       HEL,2LP
          CON    2L  ,10LF^O^R ^M^O,10L^R^E ^I^N^,10LF^O^R^M^A^ 
          CON    10LT^I^O^N ^A,10L^B^O^U^T ^,10LC^O^M^M^A^,10LN^D^S ^A^N
          CON    10L^D ^P^A^R^,10LA^M^E^T^E^,10LR^S ^Y^O^U,10L ^C^A^N ^E
          CON    10L^I^T^H^E^R,2L  ,10L^E^N^T^E^R,10L@D   ^C^O^ 
          CON    10LM^M^A^N^D-,10L^N^A^M^E ?,2L  ,10L         ^ 
          CON    10LC^O^M^M^A^,10LN^D-^N^A^M,10L^E ^P^A^R^,10LA^M^E^T^E^
          CON    4LR ? ,10L         ^,10LH^E^L^P ^C,10L^O^M^M^A^N 
          CON    10L^D-^N^A^M^,2LE ,10L         ^,10LH^E^L^P ^P 
          CON    10L^A^R^A^M^E,6L^T^E^R,2L  ,10LF^O^R ^A ^
          CON    10LL^I^S^T ^O,10L^F ^C^O^M^,10LM^A^N^D^S ,10L^A^V^A^I^L
          CON    10L^A^B^L^E ^,10LE^N^T^E^R ,2L  ,2L
          CON    10L          ,10L          ,2L? ,6L  ^O^R
          CON    10L          ,10L    HELP C,6LOMMAND,2L
          CON    10LE^N^T^E^R^,10LI^N^G HELP,10L ^W^I^L^L ,10L^R^E-^D^I^
          CON    10LS^P^L^A^Y ,10L^T^H^I^S ^,8LP^A^G^E.,2L
          CON    4L.EOR,2L  ,10L          ,10L
          CON    10L        SE,2LT ,2L  ,10LT^H^E SET 
          CON    10L^C^O^M^M^A,10L^N^D ^A^L^,10LL^O^W^S ^Y,10L^O^U ^T^O 
          CON    10L^A^L^T^E^R,10L ^A ^N^U^M,10L^B^E^R ^O^,10LF ^P^A^R^A
          CON    10L^M^E^T^E^R,2L^S,10L^T^H^A^T ^,10LA^R^E ^U^S 
          CON    10L^E^D ^D^U^,10LR^I^N^G ^F,10L^I^L^E ^T^,10LR^A^N^S^F^
          CON    10LE^R.  F^O^,10LR ^E^X^A^M,10L^P^L^E, ^T,10L^H^E ^F^O^
          CON    8LR^M^A^T ,10L^O^F ^T^H^,10LE ^F^I^L^E,10L ^O^N ^T^H 
          CON    10L^E C^Y^B^E,10L^R ^C^A^N ,10L^B^E ^C^H^,10LA^N^G^E^D.
          CON    10L  T^O ^L^O,10L^O^K ^A^T ,10L^T^H^E ^C^,10LU^R^R^E^N^
          CON    2LT ,10L^S^E^T^T^I,10L^N^G^S ^E^,10LN^T^E^R@D
          CON    8LSTATUS. ,2L  ,10LT^H^E ^P^A,10L^R^A^M^E^T
          CON    10L^E^R^S ^W^,10LH^I^C^H ^C,10L^A^N ^B^E ,10L@G^S^E^T' 
          CON    10L^A^R^E@D  ,2L  ,2L  ,10L      CODE
          CON    10L  DEBUG  D,10LELAY  MODE,8L  WINDOW,2L
          CON    10LF^O^R ^M^O,10L^R^E ^I^N^,10LF^O^R^M^A^,10LT^I^O^N ^E
          CON    10L^N^T^E^R  ,10LSET ^P^A^R,10L^A^M^E^T^E,10L^R^N^A^M^E
          CON    2L? ,2L  ,2L  ,4L.EOR
          CON    2L  ,10L          ,10L          ,10L      SET
          CON    4LCODE,2L  ,10LT^H^E CODE,10L ^P^A^R^A^
          CON    10LM^E^T^E^R ,10L^A^L^L^O^W,10L^S ^Y^O^U ,10L^T^O ^S^E^
          CON    10LL^E^C^T ^T,10L^H^E C^Y^B,10L^E^R ^F^I^,10LL^E ^F^O^R
          CON    8L^M^A^T. ,10LT^H^I^S ^S,10L^H^O^U^L^D,10L ^B^E ^S^P 
          CON    10L^E^C^I^F^I,10L^E^D ^T^O ,10L^E^N^S^U^R,10L^E ^T^H^A^
          CON    10LT ^A^N^Y ^,10LF^I^L^E ^T,10L^R^A^N^S^F,10L^E^R^R^E^D
          CON    2L  ,10L^I^S ^T^H^,10LE^N ^R^E^A,10L^D^A^B^L^E 
          CON    10L.  F^I^L^E,10L^S ^T^R^A^,10LN^S^F^E^R^,10LR^E^D ^U^S
          CON    10L^I^N^G ^T^,10LH^E ^W^R^O,10L^N^G ^C^O^,10LD^E ^C^A^N
          CON    2L  ,10L^C^O^N^T^A,10L^I^N ^A ^N,10L^U^M^B^E^R 
          CON    10L ^O^F ^I^N,10L^C^O^R^R^E,10L^C^T ^C^H^,10LA^R^A^C^T^
          CON    6LE^R^S.,2L  ,10LT^H^E ^F^I,10L^L^E ^F^O^
          CON    10LR^M^A^T^S ,10L^S^U^P^P^O,10L^R^T^E^D ^,8LA^R^E@D
          CON    2L  ,10LASCII  ASC,10LII8  BINAR,10LY  DIS64 
          CON    4LHEX ,2L  ,10LT^H^E ^D^E,10L^F^A^U^L^T
          CON    10L ^F^I^L^E ,10L^F^O^R^M^A,10L^T ^I^S AS,4LCII. 
          CON    2L  ,10LF^O^R ^M^O,10L^R^E ^I^N^,10LF^O^R^M^A^ 
          CON    10LT^I^O^N ^A,10L^B^O^U^T ^,10LT^H^E ^D^I,10L^F^F^E^R^E
          CON    10L^N^T ^C^O^,10LD^E^S ^E^N,10L^T^E^R@D  ,2L 
          CON    2L  ,10L          ,10L        SE,10LT CODE  ^F 
          CON    10L^O^R^M^A^T,2L? ,2L  ,10L^W^H^E^R^E
          CON    10L @G^F^O^R^,10LM^A^T' ^I^,10LS ^O^N^E ^,10LO^F ^T^H^E
          CON    10L ^A^B^O^V^,2LE.,2L  ,4L.EOR 
          CON    2L  ,10L          ,10L          ,10L SET CODE
          CON    6LASCII ,2L  ,10LT^H^I^S ^I,10L^S ^T^H^E 
          CON    10L^D^E^F^A^U,10L^L^T ^F^I^,10LL^E ^F^O^R,10L^M^A^T.  T
          CON    10L^H^E ^F^U^,10LL^L 128 ^C,10L^H^A^R^A^C,10L^T^E^R ASC
          CON    2LII,10L^S^T^A^N^D,10L^A^R^D ^I^,10LS ^S^U^P^P 
          CON    10L^O^R^T^E^D,10L ^S^O ^T^H,10L^A^T ^A^N^,10LY ^T^E^X^T
          CON    10L ^F^I^L^E ,10L^F^R^O^M ^,10LA ^M^I^C^R,10L^O ^C^A^N 
          CON    4L^B^E,10L^S^T^O^R^E,10L^D ^W^I^T^,10LH ^A^L^L ^ 
          CON    10LC^H^A^R^A^,10LC^T^E^R^S ,10L^R^E^M^A^I,10L^N^I^N^G ^
          CON    10LI^N^T^A^C^,10LT.  N^O^T^,10LE ^T^H^A^T,10L ^T^H^E C^
          CON    8LY^B^E^R ,10L^C^H^A^R^A,10L^C^T^E^R ^,10LS^I^Z^E ^I 
          CON    10L^S ^S^I^X ,10L^B^I^T^S ^,10LS^O, ^I^N ,10L^O^R^D^E^R
          CON    10L ^T^O ^O^B,10L^T^A^I^N ^,10LT^H^E ^F^U,8L^L^L 128 
          CON    10LASCII ^C^H,10L^A^R^A^C^T,10L^E^R ^S^E^,10LT, ^A ^C^O
          CON    10L^N^V^E^N^T,10L^I^O^N ^I^,10LS ^U^S^E^D,10L ^W^H^E^R^
          CON    10LE ^B^Y ^S^,10LO^M^E ASCI,2LI ,10L^C^H^A^R^A 
          CON    10L^C^T^E^R^S,10L ^A^R^E ^S,10L^A^V^E^D ^,10LA^S ^T^W^O
          CON    10L C^Y^B^E^R,10L ^M^A^I^N^,10LF^R^A^M^E ,10L^C^H^A^R^A
          CON    10L^C^T^E^R^S,8L.  F^O^R,10L^I^N^S^T^A,10L^N^C^E, ^T 
          CON    10L^H^E ^C^H^,10LA^R^A^C^T^,10LE^R A ^I^S,10L ^S^T^O^R^
          CON    10LE^D ^A^S 0,10L1 ^A^N^D ^,10LT^H^E ^C^H,10L^A^R^A^C^T
          CON    10L^E^R ^A ^I,2L^S,10L^S^T^O^R^E,10L^D ^A^S 76 
          CON    10L01.  T^H^E,10L C^Y^B^E^R,10L ^M^A^I^N^,10LF^R^A^M^E 
          CON    10L^F^I^L^E ^,10LT^H^E^R^E^,10LF^O^R^E ^C,10L^O^N^T^A^I
          CON    10L^N^S ^E^I^,8LT^H^E^R ,10L^S^I^X ^O^,10LR ^T^W^E^L 
          CON    10L^V^E ^B^I^,10LT^S ^P^E^R,10L ASCII ^C^,10LH^A^R^A^C^
          CON    10LT^E^R ^A^N,10L^D ^H^E^N^,10LC^E, ^T^H^,10LE ^F^I^L^E
          CON    10L ^F^O^R^M^,4LA^T ,10L^I^S ^O^F^,10LT^E^N ^R^E 
          CON    10L^F^E^R^R^E,10L^D ^T^O ^A,10L^S 6/12 ^F,10L^O^R^M^A^T
          CON    10L.  W^H^E^N,10L ^A^N ASCI,10LI ^C^H^A^R,10L^A^C^T^E^R
          CON    6L ^I^S ,10L^S^T^O^R^E,10L^D ^A^S ^A,10L ^T^W^E^L^ 
          CON    10LV^E ^B^I^T,10L ^V^A^L^U^,10LE ^T^H^E ^,10LF^I^R^S^T 
          CON    10L^S^I^X ^B^,10LI^T^S ^A^R,10L^E ^E^I^T^,10LH^E^R 74 ^
          CON    8LO^R 76, ,10L^W^H^I^C^H,10L ^C^O^R^R^,10LE^S^P^O^N^ 
          CON    10LD ^T^O ^T^,10LH^E C^Y^B^,10LE^R ^M^A^I,10L^N^F^R^A^M
          CON    10L^E ^C^H^A^,10LR^A^C^T^E^,10LR^S @A ^A^,10LN^D @B.  I
          CON    6L^F ^A ,10L^F^I^L^E ^,10LI^S ^T^R^A,10L^N^S^F^E^R 
          CON    10L^R^E^D ^A^,10LN^D ^T^H^E,10L ^R^E^S^U^,10LL^T^I^N^G 
          CON    10L^O^U^T^P^U,10L^T ^H^A^S ,10L^A ^N^U^M^,10LB^E^R ^O^F
          CON    10L @A ^O^R @,2LB ,10L^T^H^E^N ^,10LI^T ^I^S ^ 
          CON    10LR^E^A^S^O^,10LN^A^B^L^E ,10L^T^O ^A^S^,10LS^U^M^E ^T
          CON    10L^H^A^T ^T^,10LH^E ^F^I^L,10L^E ^I^S ^I,10L^N ASCII ^
          CON    10LF^O^R^M^A^,2LT.,2L  ,4L.EOR 
          CON    2L  ,10L          ,10L        SE,10LT CODE ASC 
          CON    4LII8 ,2L  ,10LT^H^I^S ^F,10L^I^L^E ^F^
          CON    10LO^R^M^A^T ,10L^S^U^P^P^O,10L^R^T^S ^T^,10LH^E ^F^U^L
          CON    10L^L ASCII ^,10LC^H^A^R^A^,10LC^T^E^R ^S,10L^E^T ^A^N^
          CON    2LD ,10L^E^A^C^H ^,10LC^H^A^R^A^,10LC^T^E^R ^I 
          CON    10L^S ^S^A^V^,10LE^D ^A^S ^,10LI^T^S ^E^I,10L^G^H^T ^B^
          CON    10LI^T ^V^A^L,10L^U^E.  A^S,10L ^T^H^E C^,8LY^B^E^R
          CON    10L^M^A^C^H^I,10L^N^E^S ^U^,10LS^E ^A 60-,10L^B^I^T ^W^
          CON    10LO^R^D ^A^N,10L^D ^E^I^G^,10LH^T ^B^I^T,10L ^V^A^L^U^
          CON    10LE^S ^C^A^N,10L^N^O^T ^B^,2LE ,10L^P^A^C^K^E 
          CON    10L^D ^E^X^A^,10LC^T^L^Y, ^,10LE^A^C^H ^E,10L^I^G^H^T ^
          CON    10LB^I^T ASCI,10LI ^C^H^A^R,10L^A^C^T^E^R,10L ^I^S ^S^A
          CON    10L^V^E^D ^W^,10LI^T^H^I^N ,2L  ,10L^T^W^E^L^V 
          CON    10L^E ^B^I^T^,10LS.  T^H^I^,10LS ^M^E^A^N,10L^S ^T^H^A^
          CON    10LT ^F^I^V^E,10L ASCII ^C^,10LH^A^R^A^C^,10LT^E^R^S ^C
          CON    10L^A^N ^B^E ,2L  ,10L^S^T^O^R^E,10L^D ^P^E^R
          CON    10L^M^A^C^H^I,10L^N^E ^W^O^,10LR^D.  T^H^,10LI^S ^F^I^L
          CON    10L^E ^F^O^R^,10LM^A^T ^I^S,10L ^O^F^T^E^,10LN ^R^E^F^E
          CON    10L^R^R^E^D ^,4LT^O ,10L^A^S @G8 ^,10LI^N 12'; ^ 
          CON    10LE^I^G^H^T ,10L^D^A^T^A ^,10LB^I^T^S ^A,10L^R^E ^S^A^
          CON    10LV^E^D ^I^N,10L ^E^A^C^H ,10L12 ^B^I^T^,10LS ^O^F ^C^
          CON    10LO^M^P^U^T^,4LE^R ,10L^W^O^R^D. ,10L T^H^I^S ^ 
          CON    10LF^I^L^E ^F,10L^O^R^M^A^T,10L ^I^S ^P^R,10L^O^B^A^B^L
          CON    10L^Y ^T^H^E ,10L^L^E^A^S^T,10L ^P^O^P^U^,10LL^A^R ^O^F
          CON    10L ^T^H^O^S^,2LE ,10L^S^U^P^P^O,10L^R^T^E^D ^ 
          CON    10LB^Y K^E^R^,6LM^I^T.,2L  ,4L.EOR 
          CON    2L  ,10L          ,10L          ,10L   SET COD 
          CON    8LE BINARY,2L  ,10LT^H^I^S ^I,10L^S ^N^O^T 
          CON    10L^A C^Y^B^E,10L^R ^M^A^I^,10LN^F^R^A^M^,10LE ^F^I^L^E
          CON    10L ^F^O^R^M^,10LA^T ^B^U^T,10L ^O^N^E ^I,10L^N^V^E^N^T
          CON    4L^E^D,10L^S^P^E^C^I,10L^F^I^C^A^L,10L^L^Y ^F^O^ 
          CON    10LR K^E^R^M^,10LI^T.  T^H^,10LE ^D^A^T^A,10L ^I^S ^S^T
          CON    10L^O^R^E^D ^,10LA^S ^S^E^V,10L^E^N-^A^N^,10LD-^A-^H^A^
          CON    4LL^F ,10L^B^Y^T^E^S,10L ^P^E^R ^W,10L^O^R^D.  A 
          CON    10L ^F^I^L^E ,10L^T^R^A^N^S,10L^M^I^T^T^E,10L^D ^U^P ^T
          CON    10L^O ^T^H^E ,10LC^Y^B^E^R ,10L^W^I^L^L ^,10LB^E ^S^T^O
          CON    6L^R^E^D,10L^A^S ^A^N ,10L^I^N^T^E^G,10L^E^R ^N^U^ 
          CON    10LM^B^E^R ^O,10L^F ^W^O^R^,10LD^S; ^H^E^,10LN^C^E, ^N^
          CON    10LU^L^L ^B^Y,10L^T^E^S ^M^,10LA^Y ^B^E ^,10LA^D^D^E^D 
          CON    4L^T^O,10L^T^H^E ^E^,10LN^D ^O^F ^,10LT^H^E ^F^I 
          CON    10L^L^E ^T^O ,10L^C^O^M^P^L,10L^E^T^E ^T^,10LH^E ^F^I^N
          CON    10L^A^L ^W^O^,10LR^D.  I^F ,10L^T^H^E ^F^,10LI^L^E ^I^S
          CON    2L  ,10L^T^H^E^N ^,10LR^E-^S^E^N,10L^T ^B^A^C^ 
          CON    10LK ^T^O ^T^,10LH^E ^O^R^I,10L^G^I^N^A^T,10L^I^N^G ^M^
          CON    10LI^C^R^O, ^,10LI^N ^B^I^N,10L^A^R^Y ^F^,10LO^R^M^A^T,
          CON    10L ^T^H^E^S^,2LE ,10L^N^U^L^L ^,10LB^Y^T^E^S
          CON    10L^W^I^L^L ^,10LA^L^S^O ^B,10L^E ^T^R^A^,10LN^S^M^I^T^
          CON    6LT^E^D.,2L  ,10LT^H^I^S ^F,10L^O^R^M^A^T
          CON    10L ^I^S ^N^O,10L^T ^G^E^N^,10LE^R^A^L^L^,10LY ^R^E^C^O
          CON    10L^M^M^E^N^D,6L^E^D. ,2L  ,4L.EOR 
          CON    2L  ,10L          ,10L          ,10L   SET COD 
          CON    8LE DIS64 ,2L  ,10LT^H^I^S ^F,10L^I^L^E ^F^
          CON    10LO^R^M^A^T ,10L^S^T^O^R^E,10L^D ^E^A^C^,10LH ^C^H^A^R
          CON    10L^A^C^T^E^R,10L ^R^E^C^E^,10LI^V^E^D ^A,10L^S ^A ^S^I
          CON    10L^X-^B^I^T ,2L  ,10L^Q^U^A^N^T,10L^I^T^Y ^A^ 
          CON    10LN^D, ^H^E^,10LN^C^E, ^O^,10LN^L^Y 64 ^,10LC^H^A^R^A^
          CON    10LC^T^E^R^S ,10L^A^R^E ^A^,10LL^L^O^W^E^,10LD.  T^H^I^
          CON    6LS ^I^S,10L^T^H^E ^D^,10LE^F^A^U^L^,10LT ^F^I^L^E 
          CON    10L ^F^O^R^M^,10LA^T ^O^N ^,10LT^H^E C^Y^,10LB^E^R ^M^A
          CON    10L^I^N^F^R^A,10L^M^E^S, ^A,10L^L^T^H^O^U,10L^G^H K^E^R
          CON    6L^M^I^T,10L^D^E^F^A^U,10L^L^T^S ^T^,8LO ASCII.
          CON    2L  ,10LDIS64 ^I^S,10L ^U^S^E^D ,10L^B^Y ^T^H^ 
          CON    10LE FORTRAN ,10L^C^O^M^P^I,10L^L^E^R^S ^,10LA^N^D ^S^O
          CON    10L ^Y^O^U ^S,10L^H^O^U^L^D,10L ^T^R^A^N^,8LS^F^E^R
          CON    10L^A^N^Y ^S^,10LU^C^H ^S^O,10L^U^R^C^E ^,10LF^I^L^E^S 
          CON    10L^I^N ^T^H^,10LI^S ^F^I^L,10L^E ^F^O^R^,6LM^A^T. 
          CON    2L  ,10LT^H^E^R^E ,10L^I^S ^O^N^,10LE ^M^A^J^O 
          CON    10L^R ^F^L^A^,10LW ^W^I^T^H,10L ^T^H^I^S ,10L^F^O^R^M^A
          CON    10L^T; ^T^H^E,10L ^R^E^P^R^,10LE^S^E^N^T^,10LA^T^I^O^N 
          CON    2L  ,10L^O^F ^T^H^,10LE @G^E^N^D,10L-^O^F-^L^I 
          CON    10L^N^E', ^W^,10LH^I^C^H ^I,10L^S 0000.  ,10LA^S ^A ^C^
          CON    10LO^L^O^N (@,10LD) ^I^S ^S,10L^T^O^R^E^D,2L 
          CON    10L^A^S 00, ^,10LT^W^O ^O^R,10L ^M^O^R^E ,10L^C^O^N^S^E
          CON    10L^C^U^T^I^V,10L^E ^C^O^L^,10LO^N^S ^C^O,10L^U^L^D ^P^
          CON    10LR^O^D^U^C^,10LE ^A^N ^E^,10LN^D-^O^F-^,8LL^I^N^E. 
          CON    10LA^L^T^H^O^,10LU^G^H ^T^H,10L^I^S ^M^A^,10LY ^S^E^E^M
          CON    10L ^A^N ^U^N,10L^L^I^K^E^L,10L^Y ^O^C^C^,10LU^R^E^N^C^
          CON    10LE, ^I^T ^C,10L^A^N ^S^T^,6LI^L^L ,10L^C^A^U^S^E 
          CON    10L ^O^B^S^C^,10LU^R^E ^E^R,10L^R^O^R^S. ,2L 
          CON    2L  ,4L.EOR,2L  ,10L 
          CON    10L          ,10L    SET CO,6LDE HEX,2L
          CON    10LT^H^I^S ^I,10L^S ^N^O^T ,10L^A C^Y^B^E,10L^R ^M^A^I^
          CON    10LN^F^R^A^M^,10LE ^F^I^L^E,10L ^F^O^R^M^,10LA^T ^B^U^T
          CON    10L ^O^N^E ^I,10L^N^V^E^N^T,4L^E^D,10L^S^P^E^C^I 
          CON    10L^F^I^C^A^L,10L^L^Y ^F^O^,10LR K^E^R^M^,10LI^T.  I^F 
          CON    10L^A ^F^I^L^,10LE ^I^S ^T^,10LR^A^N^S^F^,10LE^R^R^E^D 
          CON    10L^I^N^T^O ^,10LA C^Y^B^E^,2LR ,10L^M^A^I^N^F 
          CON    10L^R^A^M^E, ,10L^U^S^I^N^G,10L ^O^N^E ^O,10L^F ^T^H^E 
          CON    10L^A^B^O^V^E,10L ^F^I^L^E ,10L^F^O^R^M^A,10L^T^S, ^O^N
          CON    10L^E ^O^R ^M,6L^O^R^E,10L^B^L^A^N^K,10L^S ^C^A^N
          CON    10L^B^E ^A^D^,10LD^E^D ^A^T,10L ^T^H^E ^E,10L^N^D ^O^F 
          CON    10L^T^H^E ^F^,10LI^L^E ^T^O,10L ^E^N^S^U^,10LR^E ^T^H^A
          CON    10L^T ^T^H^E ,2L  ,10L^F^I^L^E ^,10LC^O^N^T^A^ 
          CON    10LI^N^S ^A ^,10LC^O^M^P^L^,10LE^T^E ^N^U,10L^M^B^E^R ^
          CON    10LO^F ^C^O^M,10L^P^U^T^E^R,10L, 60-^B^I^,10LT, ^W^O^R^
          CON    4LD^S.,10LI^F ^T^H^I,10L^S ^F^I^L^,10LE ^I^S ^S^ 
          CON    10LU^B^S^E^Q^,10LU^E^N^T^L^,10LY ^T^R^A^N,10L^S^M^I^T^T
          CON    10L^E^D ^B^A^,10LC^K ^T^O ^,10LT^H^E ^S^O,8L^U^R^C^E 
          CON    10L^M^I^C^R^O,10L ^T^H^E^S^,10LE ^B^L^A^N,10L^K^S ^W^I^
          CON    10LL^L ^B^E ^,10LS^E^N^T; ^,10LT^H^E ^F^I,10L^L^E ^R^E^
          CON    10LC^E^I^V^E^,10LD ^I^S ^N^,4LO^T ,10L^I^D^E^N^T 
          CON    10L^I^C^A^L ^,10LT^O ^T^H^E,10L ^O^N^E ^S,10L^E^N^T.  T
          CON    10L^O ^O^V^E^,10LR^C^O^M^E ,10L^T^H^I^S ^,10LP^R^O^B^L^
          CON    10LE^M ^Y^O^U,8L ^C^A^N ,10L^U^S^E HEX,10L ^M^O^D^E. 
          CON    10L  T^H^I^S ,10L^S^T^O^R^E,10L^S ^E^A^C^,10LH ASCII ^C
          CON    10L^H^A^R^A^C,10L^T^E^R ^R^,10LE^C^E^I^V^,10LE^D ^A^S ^
          CON    6LT^W^O ,10L^H^E^X^A^D,10L^E^C^I^M^A,10L^L ^D^I^G^ 
          CON    10LI^T^S ^A^N,10L^D ^W^I^L^,10LL ^O^N^L^Y,10L ^T^R^A^N^
          CON    10LS^M^I^T ^S,10L^I^M^I^L^A,10L^R^L^Y ^C^,10LO^D^E^D ^F
          CON    10L^I^L^E^S. ,2L  ,10LT^H^U^S, ^,10LT^H^E ^F^I 
          CON    10L^L^E ^R^E^,10LT^U^R^N^I^,10LN^G ^T^O ^,10LT^H^E ^O^R
          CON    10L^I^G^I^N^A,10L^L ^M^I^C^,10LR^O ^W^I^L,10L^L ^B^E ^I
          CON    10L^D^E^N^T^I,8L^C^A^L, ,10L^A^L^T^H^O,10L^U^G^H ^N^ 
          CON    10LO^T ^P^A^R,10L^T^I^C^U^L,10L^A^R^L^Y ^,10LU^S^E^F^U^
          CON    10LL ^O^N ^T^,10LH^E C^Y^B^,4LE^R.,2L
          CON    4L.EOR,2L  ,10L          ,10L
          CON    10L    SET DE,4LBUG ,2L  ,10LT^H^I^S ^I
          CON    10L^S ^M^A^I^,10LN^L^Y ^U^S,10L^E^D ^W^H^,10LE^N ^D^E^V
          CON    10L^E^L^O^P^I,10L^N^G ^T^H^,10LE K^E^R^M^,10LI^T ^P^R^O
          CON    10L^G^R^A^M ^,10LI^T^S^E^L^,4LF@D ,10L^H^O^W^E^V 
          CON    10L^E^R, ^I^T,10L ^M^A^Y ^P,10L^R^O^V^E ^,10LU^S^E^F^U^
          CON    10LL ^F^O^R ^,10LD^I^A^G^N^,10LO^S^T^I^C ,10L^P^U^R^P^O
          CON    10L^S^E^S ^F^,10LO^R ^T^H^O,4L^S^E,10L^F^A^M^I^L 
          CON    10L^I^A^R ^W^,10LI^T^H ^T^H,10L^E K^E^R^M,10L^I^T ^P^R^
          CON    10LO^T^O^C^O^,10LL.  W^H^E^,10LN D^E^B^U^,10LG ^I^S ^S^
          CON    10LE^L^E^C^T^,4LE^D,,10L^A^L^L ^I^,10LN^P^U^T ^A 
          CON    10L^N^D ^O^U^,10LT^P^U^T ^T,10L^O ^T^H^E ,10LC^Y^B^E^R 
          CON    10L^I^S ^A^L^,10LS^O ^W^R^I,10L^T^T^E^N ^,10LT^O ^A ^L^
          CON    10LO^C^A^L ^F,8L^I^L^E; ,10L^B^Y ^D^E^,10LF^A^U^L^T
          CON    10L^T^H^E ^F^,10LI^L^E^N^A^,10LM^E ^I^S Z,10LZZZDBG.  I
          CON    10L^N ^T^H^I^,10LS ^F^I^L^E,10L ^T^H^E ^F,10L^O^L^L^O^W
          CON    6L^I^N^G,10L^A^B^B^R^E,10L^V^I^A^T^I,10L^O^N^S ^A^ 
          CON    10LR^E ^U^S^E,6L^D@D  ,10L          ,10L 
          CON    10L        RC,10LV - ^F^I^L,10L^E ^R^E^C^,10LE^I^V^E^D 
          CON    2L  ,10L          ,10L          ,10L        XM 
          CON    10LT - ^F^I^L,10L^E ^T^R^A^,10LN^S^M^I^T^,6LT^E^D
          CON    10L          ,10L          ,10L        CH,10LK - ^C^H^E
          CON    10L^C^K^S^U^M,10L ^E^R^R^O^,2LR ,10L 
          CON    10L          ,10L       LOS,10LT - ^P^A^C,10L^K^E^T ^I^
          CON    10LN^C^O^M^P^,8LL^E^T^E ,2L  ,10LDEBUG ^I^S
          CON    10L ^E^N^A^B^,10LL^E^D ^B^Y,10L ^T^H^E ^C,10L^O^M^M^A^N
          CON    10L^D SET DEB,10LUG ON ^A^N,10L^D ^D^I^S^,10LA^B^L^E^D 
          CON    4L^B^Y,10LSET DEBUG ,10LOFF.  B^Y ,10L^D^E^F^A^U 
          CON    10L^L^T DEBUG,10L ^I^S ^O^F,4L^F. ,2L
          CON    4L.EOR,2L  ,10L          ,10L
          CON    10L    SET DE,6LBUG ON,2L  ,10LT^H^I^S ^S
          CON    10L^E^L^E^C^T,10L^S ^D^E^B^,10LU^G ^L^O^G,10L^G^I^N^G. 
          CON    10L A^L^L ^I^,10LN^P^U^T ^A,10L^N^D ^O^U^,10LT^P^U^T ^T
          CON    10L^O ^T^H^E ,2L  ,10LC^Y^B^E^R ,10L^I^S ^A^L^ 
          CON    10LS^O ^W^R^I,10L^T^T^E^N ^,10LT^O ^A ^L^,10LO^C^A^L ^F
          CON    10L^I^L^E; ^T,10L^H^E ^D^E^,10LF^A^U^L^T ,10L^F^I^L^E^N
          CON    6L^A^M^E,10L^I^S ZZZDB,10LG.   F^O^R,10L ^M^O^R^E
          CON    10L^I^N^F^O^R,10L^M^A^T^I^O,10L^N ^E^N^T^,10LE^R HELP D
          CON    6LEBUG. ,2L  ,4L.EOR,2L
          CON    10L          ,10L          ,10L   SET DEB,6LUG OFF 
          CON    2L  ,10LT^H^I^S ^I,10L^S ^T^H^E ,10L^D^E^F^A^U 
          CON    10L^L^T ^S^E^,10LT^T^I^N^G.,10L D^E^B^U^G,10L ^L^O^G^G^
          CON    10LI^N^G ^I^S,10L ^D^E^S^E^,10LL^E^C^T^E^,2LD. 
          CON    10LF^O^R ^M^O,10L^R^E ^I^N^,10LF^O^R^M^A^,10LT^I^O^N ^E
          CON    10L^N^T^E^R H,10LELP DEBUG.,2L  ,2L
          CON    4L.EOR,2L  ,10L          ,10L
          CON    10L   SET DEL,6LAY ^N ,2L  ,10LT^H^I^S ^P
          CON    10L^A^R^A^M^E,10L^T^E^R ^I^,10LS ^O^N^L^Y,10L ^U^S^E^D 
          CON    10L^I^N ^C^O^,10LN^J^U^N^C^,10LT^I^O^N ^W,10L^I^T^H ^T^
          CON    10LH^E S^E^N^,2LD ,10L^C^O^M^M^A,10L^N^D. I^T
          CON    10L^S^P^E^C^I,10L^F^I^E^S ^,10LT^H^E ^T^I,10L^M^E ^T^O 
          CON    10L^W^A^I^T ^,10LA^F^T^E^R ,10L^T^H^E S^E,10L^N^D ^C^O^
          CON    10LM^M^A^N^D ,2L  ,10L^H^A^S ^B^,10LE^E^N ^E^N 
          CON    10L^T^E^R^E^D,10L ^B^E^F^O^,10LR^E ^T^H^E,10L ^T^R^A^N^
          CON    10LS^F^E^R ^S,10L^T^A^R^T^S,10L.  T^H^I^S,10L ^W^I^L^L 
          CON    10L^A^L^L^O^W,2L  ,10L^Y^O^U ^E^,10LN^O^U^G^H
          CON    10L^T^I^M^E ^,10LT^O ^P^R^E,10L^P^A^R^E ^,10LT^H^E ^L^O
          CON    10L^C^A^L ^M^,10LI^C^R^O ^F,10L^O^R ^R^E^,10LC^E^I^V^I^
          CON    10LN^G ^T^H^E,2L  ,10L^F^I^L^E. ,10L T^H^E ^D^ 
          CON    10LE^F^A^U^L^,10LT ^I^S 0 ^,10LS^E^C^O^N^,10LD^S ^D^E^L
          CON    6L^A^Y. ,2L  ,10LI^T ^I^S ^,10LR^E^C^O^M^
          CON    10LM^E^N^D^E^,10LD ^T^H^A^T,10L ^Y^O^U ^U,10L^S^E S^E^R
          CON    10L^V^E^R ^M^,10LO^D^E, ^I^,10LF ^P^O^S^S,10L^I^B^L^E, 
          CON    10L^I^N ^W^H^,6LI^C^H ,10L^C^A^S^E ^,10LY^O^U ^D^O 
          CON    10L ^N^O^T ^N,10L^E^E^D ^T^,10LO ^S^E^T ^,10LT^H^E ^D^E
          CON    10L^L^A^Y ^T^,6LI^M^E.,2L  ,4L.EOR 
          CON    2L  ,10L          ,10L          ,10L     SET M 
          CON    4LODE ,2L  ,10LT^H^I^S ^A,10L^L^L^O^W^S
          CON    10L ^Y^O^U ^T,10L^O ^S^P^E^,10LC^I^F^Y ^W,10L^H^E^T^H^E
          CON    10L^R ^A^N ^I,10L^N^C^O^M^I,10L^N^G ^F^I^,10LL^E ^I^S ^
          CON    10LT^O ^B^E ^,10LK^E^P^T ^A,2L^S,10L^A ^L^O^C^ 
          CON    10LA^L ^F^I^L,10L^E ^O^N ^T,10L^H^E C^Y^B,10L^E^R, ^O^R
          CON    10L ^S^A^V^E^,10LD ^A^N^D ^,10LR^E^P^L^A^,10LC^E^D.  I^
          CON    10LF ^Y^O^U ^,10LS^A^V^E ^A,10L ^F^I^L^E ,2L 
          CON    10L^A^N^D ^O^,10LN^E ^O^F ^,10LT^H^E ^S^A,10L^M^E ^N^A^
          CON    10LM^E ^A^L^R,10L^E^A^D^Y ^,10LE^X^I^S^T^,10LS, ^T^H^E 
          CON    10L^N^A^M^E ^,10LO^F ^T^H^E,10L ^I^N^C^O^,10LM^I^N^G ^F
          CON    6L^I^L^E,10L^I^S ^A^L^,10LT^E^R^E^D ,10L^B^Y ^T^H^ 
          CON    10LE ^A^D^D^I,10L^T^I^O^N ^,10LO^F ^A ^D^,10LE^C^I^M^A^
          CON    10LL ^N^U^M^B,10L^E^R.  I^F,10L ^Y^O^U ^S,10L^P^E^C^I^F
          CON    2L^Y,10L^R^E^P^L^A,10L^C^E ^T^H^,10LE^N ^A^N^Y 
          CON    10L ^E^X^I^S^,10LT^I^N^G ^F,10L^I^L^E, ^O,10L^F ^T^H^E 
          CON    10L^S^A^M^E ^,10LN^A^M^E, ^,10LI^S ^O^V^E,10L^R^W^R^I^T
          CON    8L^T^E^N. ,2L  ,10LF^O^R ^M^O,10L^R^E ^I^N^
          CON    10LF^O^R^M^A^,10LT^I^O^N ^E,10L^N^T^E^R@D,2L 
          CON    10L          ,10L          ,10L       SET,10L MODE LOCA
          CON    10LL?    ^O^R,2L  ,10L          ,10L 
          CON    10L       SET,10L MODE SAVE,10L?     ^O^R,2L 
          CON    10L          ,10L          ,10L       SET,10L MODE REPL
          CON    4LACE?,2L  ,4L.EOR,2L
          CON    10L          ,10L          ,10L        SE,10LT MODE LOC
          CON    2LAL,2L  ,10LT^H^I^S ^E,10L^N^S^U^R^E
          CON    10L^S ^T^H^A^,10LT ^A^N ^I^,10LN^C^O^M^I^,10LN^G ^F^I^L
          CON    10L^E ^R^E^M^,10LA^I^N^S ^A,10L^S ^A ^L^O,10L^C^A^L ^F^
          CON    6LI^L^E.,10LW^H^E^N ^T,10L^H^E ^S^E^,10LS^S^I^O^N
          CON    10L^O^N ^T^H^,10LE C^Y^B^E^,10LR ^I^S ^D^,10LI^S^C^O^N^
          CON    10LT^I^N^U^E^,10LD ^T^H^E ^,10LF^I^L^E ^I,10L^S ^P^U^R^
          CON    6LG^E^D.,2L  ,4L.EOR,2L
          CON    10L          ,10L          ,10L       SET,10L MODE SAVE
          CON    2L  ,2L  ,10LT^H^I^S ^E,10L^N^S^U^R^E
          CON    10L^S ^T^H^A^,10LT ^A^N ^I^,10LN^C^O^M^I^,10LN^G ^F^I^L
          CON    10L^E ^I^S ^S,10L^A^V^E^D ^,10LO^N ^Y^O^U,10L^R ^P^E^R^
          CON    10LM^A^N^E^N^,2LT ,10L^F^I^L^E^B,10L^A^S^E ^A^ 
          CON    10LN^D ^I^S ^,10LT^H^E ^D^E,10L^F^A^U^L^T,10L ^S^E^T^T^
          CON    6LI^N^G.,2L  ,10LI^F ^Y^O^U,10L ^A^L^R^E^
          CON    10LA^D^Y ^H^A,10L^V^E ^A ^F,10L^I^L^E ^O^,10LF ^T^H^E ^
          CON    10LS^A^M^E ^N,10L^A^M^E ^T^,10LH^E^N ^A ^,10LD^E^C^I^M^
          CON    4LA^L ,10L^I^N^T^E^G,10L^E^R ^I^S ,10L^A^D^D^E^D 
          CON    10L ^T^O ^T^H,10L^E ^F^I^L^,10LE ^N^A^M^E,2L.
          CON    2L  ,4L.EOR,2L  ,10L 
          CON    10L          ,10L     SET M,10LODE REPLAC,2LE
          CON    2L  ,10LA^N^Y ^I^N,10L^C^O^M^I^N,10L^G ^F^I^L^ 
          CON    10LE ^W^I^L^L,10L ^B^E ^S^A,10L^V^E^D ^O^,10LN ^Y^O^U^R
          CON    10L ^P^E^R^M^,10LA^N^E^N^T ,10L^F^I^L^E^B,8L^A^S^E;
          CON    10L^I^F ^Y^O^,10LU ^H^A^V^E,10L ^A^N ^E^X,10L^I^S^T^I^N
          CON    10L^G ^F^I^L^,10LE ^W^I^T^H,10L ^T^H^E ^S,10L^A^M^E ^N^
          CON    10LA^M^E ^A^S,10L ^T^H^E ^I,10L^N^C^O^M^I,4L^N^G 
          CON    10L^F^I^L^E ^,10LI^T ^W^I^L,10L^L ^B^E ^R,10L^E^P^L^A^C
          CON    6L^E^D. ,2L  ,4L.EOR,2L
          CON    10L          ,10L          ,10L      SET ,6LWINDOW 
          CON    2L  ,10LW^I^N^D^O^,10LW^I^N^G ^I,10L^S ^A^N ^E 
          CON    10L^X^T^E^N^S,10L^I^O^N ^O^,10LF ^T^H^E ^,10LB^A^S^I^C 
          CON    10LK^E^R^M^I^,10LT ^P^R^O^T,10L^O^C^O^L ^,6LA^N^D
          CON    10L^I^S ^C^U^,10LR^R^E^N^T^,10LL^Y ^S^U^P,10L^P^O^R^T^E
          CON    10L^D ^O^N ^A,10L ^F^E^W ^M,10L^I^C^R^O^S,10L.  I^T ^E^
          CON    10LN^A^B^L^E^,10LS ^M^O^R^E,10L ^T^H^A^N ,2L 
          CON    10L^O^N^E ^P^,10LA^C^K^E^T ,10L^A^C^K^N^O,10L^W^L^E^D^G
          CON    10L^E^M^E^N^T,10L ^T^O ^B^E,10L ^O^U^T^S^,10LT^A^N^D^I^
          CON    10LN^G ^A^N^D,10L ^R^E^S^U^,10LL^T^S ^I^N,4L ^A
          CON    10L^F^A^S^T^E,10L^R ^D^A^T^,10LA ^T^R^A^N,10L^S^F^E^R. 
          CON    10L G^E^N^E^R,10L^A^L^L^Y, ,10L^T^H^E ^L^,10LA^R^G^E^R 
          CON    10L^T^H^E ^W^,10LI^N^D^O^W ,8L^S^I^Z^E,10L^T^H^E ^F^ 
          CON    10LA^S^T^E^R ,10L^T^H^E ^T^,10LR^A^N^S^F^,4LE^R. 
          CON    2L  ,10LI^F ^W^I^N,10L^D^O^W^I^N,10L^G ^I^S ^R 
          CON    10L^E^Q^U^E^S,10L^T^E^D ^B^,10LU^T ^T^H^E,10L ^M^I^C^R^
          CON    10LO ^C^A^N^N,10L^O^T ^S^U^,10LP^P^O^R^T ,10L^I^T ^T^H^
          CON    4LI^S ,10L^I^S ^R^E^,10LS^O^L^V^E^,10LD ^A^T ^T^ 
          CON    10LH^E ^S^T^A,10L^R^T ^O^F ,10L^T^H^E ^T^,10LR^A^N^S^F^
          CON    10LE^R ^A^N^D,10L ^W^I^N^D^,10LO^W^I^N^G ,10L^I^S ^N^O^
          CON    10LT ^U^S^E^D,2L. ,2L  ,10LF^O^R ^M^O
          CON    10L^R^E ^I^N^,10LF^O^R^M^A^,10LT^I^O^N ^S,10L^E^E@D   S
          CON    10LET WINDOW ,10LON?   ^O^R,2L  ,10L 
          CON    10L          ,10L        SE,10LT WINDOW O,10LFF?  ^O^R 
          CON    2L  ,10L          ,10L          ,10L        SE 
          CON    10LT WINDOW S,4LIZE?,2L  ,4L.EOR 
          CON    2L  ,10L          ,10L          ,10L    SET WI 
          CON    8LNDOW ON ,2L  ,10LT^H^I^S ^S,10L^E^L^E^C^T
          CON    10L^S ^W^I^N^,10LD^O^W^I^N^,10LG ^A^N^D ^,10LI^S ^T^H^E
          CON    10L ^D^E^F^A^,10LU^L^T ^S^E,10L^T^T^I^N^G,2L.
          CON    10LT^H^E ^D^E,10L^F^A^U^L^T,10L ^W^I^N^D^,10LO^W ^S^I^Z
          CON    10L^E ^I^S 8.,2L  ,2L  ,4L.EOR 
          CON    2L  ,10L          ,10L          ,10L    SET WI 
          CON    8LNDOW OFF,2L  ,10LT^H^I^S ^D,10L^E^S^E^L^E
          CON    10L^C^T^S ^T^,10LH^E ^W^I^N,10L^D^O^W ^O^,10LP^T^I^O^N.
          CON    2L  ,2L  ,4L.EOR,2L
          CON    10L          ,10L          ,10L   SET WIN,10LDOW SIZE ^
          CON    2LM ,2L  ,10LT^H^I^S ^S,10L^E^T^S ^T^
          CON    10LH^E ^S^I^Z,10L^E ^O^F ^W,10L^I^N^D^O^W,10L ^T^O ^M ^
          CON    10LW^H^E^R^E ,8L0<^M<32.,10LT^H^E ^D^E,10L^F^A^U^L^T 
          CON    10L ^S^I^Z^E ,8L^I^S 8. ,2L  ,4L.EOR 
          CON    2L  ,10L          ,10L        SE,10LND ^F^I^L^ 
          CON    10LE^N^A^M^E ,10L[^A^L^T-^N,8L^A^M^E] ,2L
          CON    10LT^H^E SEND,10L ^C^O^M^M^,10LA^N^D ^T^R,10L^A^N^S^M^I
          CON    10L^T^S ^A ^F,10L^I^L^E ^T^,10LO ^A ^R^E^,10LM^O^T^E ^M
          CON    10L^I^C^R^O. ,2L  ,10LY^O^U ^S^H,10L^O^U^L^D ^ 
          CON    10LO^N^L^Y ^E,10L^N^T^E^R ^,10LA SEND ^C^,10LO^M^M^A^N^
          CON    10LD ^A^T ^T^,10LH^E ^E^N^D,10L ^O^F ^Y^O,4L^U^R 
          CON    10L^I^N^P^U^T,10L ^A^S ^T^H,10L^I^S ^C^O^,10LM^M^A^N^D 
          CON    10L^T^E^R^M^I,10L^N^A^T^E^S,10L ^T^H^E ^I,10L^N^T^E^R^A
          CON    10L^C^T^I^V^E,10L ^D^I^A^L^,8LO^G^U^E.,2L
          CON    10LF^I^L^E^N^,10LA^M^E ^I^S,10L ^T^H^E ^N,10L^A^M^E ^O^
          CON    10LF ^T^H^E ^,10LF^I^L^E ^T,10L^O ^B^E ^T,10L^R^A^N^S^M
          CON    10L^I^T^T^E^D,10L. I^F ^T^H,2L^E,10L^F^I^L^E ^ 
          CON    10LS^P^E^C^I^,10LF^I^E^D ^I,10L^S ^L^O^C^,10LA^L ^T^H^E
          CON    10L^N ^T^H^I^,10LS ^I^S ^S^,10LE^N^T ^O^T,10L^H^E^R^W^I
          CON    10L^S^E ^T^H^,10LE ^F^I^L^E,2L  ,10L^I^S ^O^B^ 
          CON    10LT^A^I^N^E^,10LD ^F^R^O^M,10L ^T^H^E ^P,10L^E^R^M^A^N
          CON    10L^E^N^T ^F^,10LI^L^E ^B^A,6L^S^E. ,2L
          CON    10LI^F @G^A^L,10L^T-^N^A^M^,10LE' ^I^S ^S,10L^P^E^C^I^F
          CON    10L^I^E^D ^T^,10LH^E^N ^T^H,10L^I^S ^I^S ,10L^T^H^E ^N^
          CON    10LA^M^E ^U^S,10L^E^D ^B^Y ,6L^T^H^E,10L^R^E^C^E^I 
          CON    10L^V^I^N^G K,10L^E^R^M^I^T,10L. N^O^T^E ,10L^T^H^A^T ^
          CON    10LI^F ^W^I^L,10L^D ^C^H^A^,10LR^A^C^T^E^,10LR^S ^A^R^E
          CON    10L ^U^S^E^D ,8L^T^H^E^N,10L^T^H^E ^A^,10LL^T^E^R^N^ 
          CON    10LA^T^I^V^E ,10L^N^A^M^E ^,10LA^P^P^L^I^,10LE^S ^O^N^L
          CON    10L^Y ^T^O ^T,10L^H^E ^F^I^,10LR^S^T ^F^I,10L^L^E ^S^E^
          CON    4LN^T.,2L  ,10LT^H^E ^C^H,10L^A^R^A^C^T
          CON    10L^E^R @G*' ,10L^C^A^N ^B^,10LE ^U^S^E^D,10L ^W^I^T^H^
          CON    10LI^N ^A ^F^,10LI^L^E ^N^A,10L^M^E ^T^O ,10L^S^P^E^C^I
          CON    4L^F^Y,10L^Z^E^R^O ^,10LO^R ^M^O^R,10L^E ^C^H^A^ 
          CON    10LR^A^C^T^E^,10LR^S. F^O^R,10L ^E^X^A^M^,10LP^L^E @G*'
          CON    10L ^W^O^U^L^,10LD ^M^E^A^N,10L ^A^L^L ^F,10L^I^L^E^S, 
          CON    2L  ,10L@G^X*' ^W^,10LO^U^L^D ^M,10L^E^A^N ^A^ 
          CON    10LL^L ^F^I^L,10L^E^S ^S^T^,10LA^R^T^I^N^,10LG ^W^I^T^H
          CON    10L ^T^H^E ^L,10L^E^T^T^E^R,8L @G^X'. ,2L
          CON    10LT^H^E ^C^H,10L^A^R^A^C^T,10L^E^R @G?' ,10L^C^A^N ^B^
          CON    10LE ^U^S^E^D,10L ^T^O ^R^E,10L^P^R^E^S^E,10L^N^T ^A^N^
          CON    10LY ^C^H^A^R,10L^A^C^T^E^R,8L. F^O^R ,10L^E^X^A^M^P 
          CON    10L^L^E @G^X?,10L' ^W^O^U^L,10L^D ^M^E^A^,10LN ^A^N^Y ^
          CON    10LF^I^L^E ^W,10L^H^O^S^E ^,10LN^A^M^E ^W,10L^A^S ^E^X^
          CON    10LA^C^T^L^Y ,6L^T^W^O,10L^C^H^A^R^A,10L^C^T^E^R^S 
          CON    10L ^L^O^N^G ,10L^A^N^D ^S^,10LT^A^R^T^S ,10L^W^I^T^H ^
          CON    10LA^N @G^X'.,2L  ,2L  ,4L.EOR 
          CON    2L  ,10L          ,10L          ,10L     RECEI 
          CON    10LVE [^N^A^M,4L^E] ,2L  ,10LW^H^E^N ^Y
          CON    10L^O^U ^I^S^,10LS^U^E ^A R,10LECEIVE ^C^,10LO^M^M^A^N^
          CON    10LD K^E^R^M^,10LI^T ^W^A^I,10L^T^S ^F^O^,10LR ^A^N ^I^
          CON    10LN^C^O^M^I^,4LN^G ,10L^F^I^L^E. ,10L Y^O^U ^S^ 
          CON    10LH^O^U^L^D ,10L^O^N^L^Y ^,10LE^N^T^E^R ,10L^A RECEIVE
          CON    10L ^C^O^M^M^,10LA^N^D ^A^T,10L ^T^H^E ^E,10L^N^D ^O^F 
          CON    2L  ,10L^Y^O^U^R ^,10LI^N^P^U^T ,10L^A^S ^T^H^ 
          CON    10LI^S ^C^O^M,10L^M^A^N^D ^,10LT^E^R^M^I^,10LN^A^T^E^S 
          CON    10L^T^H^E ^I^,10LN^T^E^R^A^,10LC^T^I^V^E ,10L^D^I^A^L^O
          CON    8L^G^U^E. ,2L  ,10LI^F @G^N^A,10L^M^E' ^I^S
          CON    10L ^S^P^E^C^,10LI^F^I^E^D ,10L^T^H^E ^T^,10LH^E ^F^I^R
          CON    10L^S^T ^F^I^,10LL^E ^R^E^C,10L^E^I^V^E^D,10L ^I^S ^S^A
          CON    6L^V^E^D,10L^U^S^I^N^G,10L ^T^H^I^S ,10L^N^A^M^E.
          CON    10LS^U^B^S^E^,10LQ^U^E^N^T ,10L^F^I^L^E^S,10L ^A^R^E ^S
          CON    10L^A^V^E^D ^,10LU^S^I^N^G ,10L^T^H^E ^N^,6LA^M^E
          CON    10L^G^I^V^E^N,10L ^B^Y ^T^H,10L^E ^T^R^A^,10LN^S^M^I^T^
          CON    10LT^I^N^G K^,10LE^R^M^I^T.,2L  ,2L
          CON    4L.EOR,2L  ,10L          ,10L
          CON    10L    SERVER,2L  ,2L  ,10LW^H^E^N ^Y
          CON    10L^O^U ^U^S^,10LE K^E^R^M^,10LI^T ^O^N ^,10LT^H^E C^Y^
          CON    10LB^E^R ^M^A,10L^I^N^F^R^A,10L^M^E ^F^R^,10LO^M ^A ^R^
          CON    10LE^M^O^T^E ,10L^M^I^C^R^O,2L  ,10L^A^N^D ^U^ 
          CON    10LS^E S^E^R^,10LV^E^R ^M^O,10L^D^E ^T^O ,10L^E^N^T^E^R
          CON    10L ^C^O^M^M^,10LA^N^D^S ^T,10L^H^E K^E^R,10L^M^I^T ^R^
          CON    10LU^N^N^I^N^,6LG ^O^N,10L^T^H^E ^M^,10LI^C^R^O ^W 
          CON    10L^H^I^C^H ^,10LW^I^L^L ^I,10L^N^S^T^R^U,10L^C^T ^T^H^
          CON    10LE C^Y^B^E^,10LR ^M^A^I^N,10L^F^R^A^M^E,10L ^A^C^C^O^
          CON    10LR^D^I^N^G^,4LL^Y.,10LI^F ^Y^O^U,10L ^D^O ^N^O 
          CON    10L^T ^U^S^E ,10L^S^E^R^V^E,10L^R ^M^O^D^,10LE ^Y^O^U ^
          CON    10LM^U^S^T ^E,10L^N^T^E^R ^,10LC^O^M^M^A^,10LN^D^S ^T^O
          CON    10L ^B^O^T^H ,6L^T^H^E,10LK^E^R^M^I^,10LT ^O^N ^T^ 
          CON    10LH^E ^M^I^C,10L^R^O ^A^N^,10LD ^T^H^E K,10L^E^R^M^I^T
          CON    10L ^O^N ^T^H,10L^E C^Y^B^E,4L^R. ,2L
          CON    10LI^F ^Y^O^U,10L^R ^M^I^C^,10LR^O ^H^A^S,10L ^A^N ^I^M
          CON    10L^P^L^E^M^E,10L^N^T^A^T^I,10L^O^N ^O^F ,10LK^E^R^M^I^
          CON    10LT ^T^H^A^T,10L ^C^A^N^N^,10LO^T ^T^A^L,2L^K 
          CON    10L^T^O ^S^E^,10LR^V^E^R^S ,10L^Y^O^U ^M^,10LU^S^T ^U^S
          CON    10L^E ^T^H^E ,10LC^Y^B^E^R ,10L^I^N ^N^O^,10LN-^S^E^R^V
          CON    10L^E^R ^M^O^,10LD^E.  I^F ,6L^Y^O^U,10L^F^I^N^D ^ 
          CON    10LT^H^A^T ^Y,10L^O^U ^C^A^,10LN^N^O^T ^U,10L^S^E ^T^H^
          CON    10LE GET ^C^O,10L^M^M^A^N^D,10L ^O^N ^Y^O,10L^U ^M^I^C^
          CON    10LR^O K^E^R^,6LM^I^T ,10L^Y^O^U ^W^,10LI^L^L ^N^O 
          CON    10L^T ^B^E ^A,10L^B^L^E ^T^,10LO ^U^S^E S,10L^E^R^V^E^R
          CON    10L ^M^O^D^E ,10L^T^O ^T^R^,10LA^N^S^F^E^,10LR ^F^I^L^E
          CON    4L^S. ,2L  ,4L.EOR,2L
          CON    10L          ,10L          ,8L    EXIT,2L
          CON    10LT^E^R^M^I^,10LN^A^T^E^S ,10L^T^H^E ^I^,10LN^T^E^R^A^
          CON    10LC^T^I^V^E ,10L^D^I^A^L^O,10L^G^U^E ^A^,10LN^D K^E^R^
          CON    6LM^I^T.,2L  ,4L.EOR,2L
          CON    10L          ,10L          ,8L VERSION,2L
          CON    10LD^I^S^P^L^,10LA^Y^S ^T^H,10L^E ^C^U^R^,10LR^E^N^T K^
          CON    10LE^R^M^I^T ,10L^V^E^R^S^I,10L^O^N ^N^U^,8LM^B^E^R. 
          CON    2L  ,4L.EOR,2L  ,10L 
          CON    10L          ,10L        ST,4LATUS,2L
          CON    10LSTATUS ^D^,10LI^S^P^L^A^,10LY^S ^T^H^E,10L ^S^T^A^T^
          CON    10LE ^O^F ^A^,10LN^Y @G^S^E,10L^T^T^A^B^L,10L^E' ^P^A^R
          CON    10L^A^M^E^T^E,10L^R^S.  F^O,2L^R,10L^I^N^S^T^A 
          CON    10L^N^C^E, ^T,10L^H^E ^C^U^,10LR^R^E^N^T ,10L^C^O^D^E, 
          CON    10L^W^I^N^D^O,10L^W ^S^I^Z^,10LE, ^W^H^E^,10LT^H^E^R ^D
          CON    10L^E^B^U^G ^,8LI^S ^O^N,10L^O^R ^O^F^,10LF, ^E^T^C. 
          CON    10L  I^T ^A^L,10L^S^O ^D^I^,10LS^P^L^A^Y^,10LS ^T^H^E ^
          CON    10LL^A^S^T ^T,10L^H^R^E^E ^,10LL^I^N^E^S ,10L^O^F ^Y^O^
          CON    4LU^R ,10L^L^O^G ^F^,10LI^L^E, ZZZ,10LZLOG.  T^H 
          CON    10L^I^S ^I^S ,10L^U^S^E^F^U,10L^L ^I^F ^Y,10L^O^U ^H^A^
          CON    10LV^E ^T^R^A,10L^N^S^F^E^R,10L^R^E^D ^A ,2L 
          CON    10L^F^I^L^E ^,10LA^N^D ^R^E,10L^Q^U^E^S^T,10L^E^D ^I^T 
          CON    10L^T^O ^B^E ,10L^S^A^V^E^D,10L ^B^U^T ^A,10L^L^R^E^A^D
          CON    10L^Y ^H^A^V^,10LE ^A ^F^I^,8LL^E ^O^F,10L^T^H^A^T ^ 
          CON    10LN^A^M^E ^P,10L^R^E^S^E^N,10L^T.  K^E^R,10L^M^I^T ^W^
          CON    10LI^L^L ^A^D,10L^D ^A ^D^E,10L^C^I^M^A^L,10L ^I^N^T^E^
          CON    10LG^E^R ^T^O,8L ^T^H^E ,10L^F^I^L^E^N,10L^A^M^E ^A^ 
          CON    10LN^D ^T^H^E,10L ^L^O^G ^F,10L^I^L^E ^W^,10LI^L^L ^T^E
          CON    10L^L^L ^Y^O^,10LU ^T^H^E ^,10LN^E^W ^N^A,10L^M^E ^O^F 
          CON    10L^T^H^E ^F^,6LI^L^E.,2L  ,4L.EOR 
          CON    2L  ,10L          ,10L          ,10L      TAKE 
          CON    10L ^F^I^L^E^,8LN^A^M^E ,2L  ,10LTAKE ^E^N^
          CON    10LA^B^L^E^S ,10L^Y^O^U ^T^,10LO ^U^S^E ^,10LA ^F^I^L^E
          CON    10L ^Y^O^U ^H,10L^A^V^E ^P^,10LR^E^V^I^O^,10LU^S^L^Y ^C
          CON    10L^R^E^A^T^E,8L^D ^T^O ,10L^S^E^T ^U^,10LP ^V^A^R^I 
          CON    10L^O^U^S ^P^,10LA^R^A^M^E^,10LT^E^R^S.  ,10LT^H^E ^F^I
          CON    10L^L^E ^Y^O^,10LU TAKE ^M^,10LU^S^T ^B^E,10L ^L^O^C^A^
          CON    2LL.,10LF^O^R ^E^X,10L^A^M^P^L^E,10L@D ^Y^O^U
          CON    10L^C^O^U^L^D,10L ^H^A^V^E ,10L^A ^F^I^L^,10LE ^T^H^A^T
          CON    10L ^S^E^T^S ,10L^U^P ^P^A^,10LR^A^M^E^T^,10LE^R^S ^S^O
          CON    2L  ,10L^Y^O^U ^C^,10LA^N ^T^R^A,10L^N^S^F^E^R 
          CON    10L ^A W^O^R^,10LDS^T^A^R ^,10LF^I^L^E ^F,10L^R^O^M ^A^
          CON    10LN IBM ^T^O,10L ^T^H^E C^,8LY^B^E^R.,10LI^N ^T^H^I 
          CON    10L^S ^C^A^S^,10LE ^Y^O^U^R,10L ^F^I^L^E ,10L^C^O^U^L^D
          CON    10L ^B^E ^C^A,10L^L^L^E^D I,10LBMCYB ^A^N,10L^D ^C^O^N^
          CON    10LT^A^I^N ^T,4L^H^E,10L^F^O^L^L^O,10L^W^I^N^G ^ 
          CON    10LL^I^N^E^S@,2LD ,2L  ,10L
          CON    10L          ,10L      SET ,10LCODE ASCII,2L 
          CON    10L          ,10L          ,10L      SET ,10LWINDOW 10 
          CON    2L  ,10L          ,10L          ,10L      SERV 
          CON    2LER,2L  ,10LY^O^U ^C^A,10L^N ^S^A^V^
          CON    10LE ^T^H^I^S,10L ^F^I^L^E ,10L^S^O ^E^V^,10LE^R^Y ^T^I
          CON    10L^M^E ^Y^O^,10LU ^W^A^N^T,10L ^T^O ^T^R,10L^A^N^S^F^E
          CON    10L^R ^B^E^T^,8LW^E^E^N ,10L^A^N IBM ^,10LA^N^D ^T^H 
          CON    10L^E C^Y^B^E,10L^R ^Y^O^U ,10L^N^E^E^D ^,10LO^N^L^Y ^E
          CON    10L^N^T^E^R@D,10L   TAKE IB,4LMCYB,10L^F^O^L^L^O 
          CON    10L^W^E^D ^B^,10LY ^A G^E^T,10L ^O^R S^E^,10LN^D ^C^O^M
          CON    10L^M^A^N^D ^,10LI^S^S^U^E^,10LD ^F^R^O^M,10L ^T^H^E ^M
          CON    10L^I^C^R^O. ,2L  ,2L  ,4L.EOR 
          CON    4L.EOR 
  
          END    KERMIT 
