.
.         INTER - SITE DATA INTERCHANGE COMMAND PROCESSES
.
.                   CONNECT
.                   DISCONNECT
.                   INTERCHANGE
.                   MESSAGE
.
.
.         (C)  Copyright 1972-1978  John Walker
.
.         This software is in the public domain
.
          AXR$
          DEFUNCT$
          FANG
.
          ON        INTERSITE
.
.
.         LINE CONTROL CHARACTERS
.
NUL       EQU       0                   NULL (FILL CHARACTER)
SOH       EQU       1                   START OF HEADER
STX       EQU       2                   START OF TEXT
EOT       EQU       4                   END OF TRANSMISSION
SYN       EQU       026                 ASCII SYNC CHARACTER
ESC       EQU       033                 ESCAPE SEQUENCE START
.
.         MESSAGE TYPE BITS
.
ACK       EQU       1                   ACKNOWLEDGE
NAK       EQU       2                   NEGATIVE ACKNOWLEDGE
ALT       EQU       010                 ALTERNATION BIT
.
REALTHING EQU       1                   IT'S THE PHONEY THING !
DUMPING   EQU       1                   TURN ON INPUT, OUTPUT SNAPS
.
.         PROCEDURES TO GENERATE CALLING SEQUENCES
.
P         PROC      *1
OUTWORD*  NAME      0
          DO        P(1)>0 , LA A0,P(1,1),P(1,2),P(1,3)
          LMJ       X5,OUTWORD
          END       .
.
P         PROC      *1
OUTCHAR*  NAME      0
OTC*      PROC      *0
          DO        P(1)>0 , LA,U A1,P(1,I)
          LMJ       X6,OUTCHAR
          END       .
I         DO        P(1)+(P(1)=0) , OTC
          END       .
.
P         PROC      0,1
GETCHAR*  NAME      0
          LMJ       X5,GETCHAR
          END       .
.
.
.
.         COMMONLY USED REGISTERS THROUGHOUT COMMUNICATOR
.
CRC2      EQU       A14                 CYCLIC REDUNDANCY CHECK CHARACTER 2
CRC1      EQU       A15                 CYCLIC REDUNDANCY CHECK CHARACTER 1
.                                       (NOTE:  CRC2 MUST PRECEDE CRC1, BECAUSE
.                                        CRC PROC COUNTS ON THIS FOR XOR).
.
.         THIS PROC GENERATES THE CODING SEQUENCE TO UPDATE THE RUNNING
.         CYCLIC REDUNDANCY CHECK CHARACTERS FOR A CHARACTER IN THE REGISTER
.         SUPPLIED.  THE CHARACTER MUST BE IN THE RANGE 0 <= CH <= 0377
.         (THIS IS NOT CHECKED).  THE CHARACTER WILL NOT BE CHANGED, BUT
.         THE REGISTER ABOVE THE ONE CONTAINING THE CHARACTER WILL BE DESTROYED.
.
P         PROC      1,3                 COMPUTE CYCLIC REDUNDANCY CHECK
CRC*      NAME      0
A         EQU       P(1,1)              A REGISTER CONTAINING THE CHARACTER
LOW8      EQUF      0,,H2               LOWER 8 BITS OF REMAINDER
HIGH8     EQUF      0,,H1               UPPER 8 BITS OF REMAINDER
.
          XOR       A,CRC1              A+1 = A -- CRC1
          XOR       CRC2,REMAINDER+LOW8,A+1 CRC1 = CRC2 -- (REMAINDER(A--CRC1))
          LA        CRC2,REMAINDER+HIGH8,A+1 CRC2 = REMAINDER/(1*/8)
          END
/.
.
.         CONNECT COMMAND PROCESS
.
CONNECT*  quarterword                   TURN ON QUARTER WORD MODE
          LX        X9,CDBPC,X8         LOAD PARAMETER POINTER
          LX        X9,PBVAL,X9         LOAD FDT FOR COMMUNICATIONS LINE
          LA        A0,FDPROP,X9        LOAD PROPERTIES OF FILE
          ON        REALTHING
          TOP,U     A0,EPCOMM           COMMUNICATIONS LINE ?
          J         CONEQTW             NO.  ERROR, IMPROPER EQUIPMENT
          OFF       REALTHING
          TZ        FDLT,X9             HAS LINE BEEN CONNECTED ?
          J         CONALR              YES.  LINE ALREADY CONNECTED
          BGET      LTL                 ALLOCATE A LINE TABLE
          SA        A0,FDLT,X9          SET LINE TABLE POINTER IN FDT
          AA        A0,(1,0)            FORM POINTER TO CLEAR LINE TABLE
          LR,U      R1,LTL-1            LOAD LOOP COUNTER
          SZ        0,*A0               CLEAR THE LINE TABLE
          JGD       R1,$-1              LOOP FOR ALL WORDS
          LX        X3,FDLT,X9          LOAD LINE TABLE POINTER
          DL        A0,FDIN,X9          LOAD INTERNAL NAME FOR LTG
          DS        A0,LTFN,X3          SET NAME IN LINE TABLE
          LA,U      A0,1                LOAD A ONE
          SA        A0,LTQWI,X3         SET QUARTER-WORD COMPLETION ACT
          SA        A0,LTOUSG,X3        SET INTERRUPT ON OUTPUT COMPLETION
          SA        A0,LTIUSG,X3        SET INTERRUPT ON INPUT COMPLETION
          LA,U      A0,OUTINT           LOAD OUTPUT COMPLETION ADDRESS
          SA        A0,LTOCRTN,X3       SET OUTPUT COMPLETION ADDRESS
          LA,U      A0,ININT            LOAD INPUT COMPLETION ROUTINE
          SA        A0,LTICRTN,X3       SET INPUT COMPLETION ADDRESS
          LA,U      A0,20               LOAD TIMER FOR 12 SECONDS
          SA        A0,LTOBTIM,X3       TURN ON OUTPUT BUFFER TIMING
          INITQ     LTSCQ,X3            INITIALISE SUBCHANNEL QUEUE
          INITQ     LTOQ,X3             INITIALISE OUTPUT MESSAGE QUEUE
          INITPVQ   0,LTOAQ,X3          INITIALISE OUTPUT AVAILABLE QUEUE
          LA        A0,FDQWM,X9         LOAD QUARTER-WORD FLAG FOR FDT
          ON        REALTHING=0
          LA,U      A0,1                SET QUARTER WORD FOR EMULATION
          OFF       REALTHING=0
          SA        A0,LTQWM,X3         SET FLAG IN LINE TABLE
.
.         INITIALISE BITS-PER-CHARACTER VALUES
.
          LA        A0,FDBITPC,X9       LOAD BITS PER CHARACTER
          ON        REALTHING=0
          LA,U      A0,8                SET 8 BITS PER CHARACTER FOR EMULATION
          OFF       REALTHING=0
          SA        A0,LTBITPC,X3       SET BITS PER CHARACTER IN LT
          LA,U      A1,1                LOAD A ONE BIT
          LSSL      A1,,A0              TAKE 2**(BITS PER CHARACTER)
          ANA,U     A1,1                COMPUTE LARGEST VALUE FOR CHARACTER
          SA        A1,LTCMSK,X3        SET CHARACTER MASK IN LINE TABLE
.
.         COMPUTE LARGEST VALUED WORD WORTH SENDING AS
.         A SHORT WORD (DELIMITED BY ESC 8).
.
          LA,U      A1,36               LOAD BITS IN FULL WORD
          AA        A1,A0               ADD BITS PER CHARACTER TO ROUND UP
          ANA,U     A1,1                SUBTRACT ONE FOR COVERED DIVIDE
          DSL       A1,36               SHIFT TO GET TWO WORD NUMBER
          DI        A1,A0               COMPUTE BYTES REQUIRED TO HOLD A WORD
          ANA,U     A1,3                SUBTRACT TWO-BYTE OVERHEAD FOR
.                                       ESCAPE 8 SEQUENCE AND ONE BYTE
.                                       ADVANTAGE TO MAKE IT WORTH IT.
          MSI,U     A1,A0               COMPUTE BITS IN THAT NUMBER OF BYTES
          LA,U      A2,1                LOAD A ONE BIT
          LSSL      A2,,A1              GET SMALLEST NUMBER TO SEND AS FULL WORD
          SA        A2,LTOPTMX,X3       SAVE FOR COMPARISON LATER
.
          LA        A0,FDCTMSPD,X9      LOAD CTM SPEED ON LINE
          ON        REALTHING=0
          LA,U      A0                  SET ASYNCHRONOUS FOR EMULATION
          OFF       REALTHING=0
          LA,U      A1,SYN              LOAD A SYNC CHARACTER
          TG,U      A0,2                IS LINE SYNCHRONOUS ?
          SA        A1,LTSYNC,X3        NO.  SET SYNC CHARACTER FOR LINE
.
          LA,U      A0,5                ** FUDGE **
          SA        A0,LTTIME,X3        SET TIMEOUT QUANTUM FOR LINE
.
.         COMPUTE LENGTH OF COMMUNICATIONS BUFFER REQUIRED
.
          LA,U      A0,16               LOAD BITS IN CRC FOR MESSAGE
          DSL       A0,36               SHIFT TO DOUBLE-WORD FOR DIVIDE
          DI        A0,LTBITPC,X3       DIVIDE BY BITS PER CHARACTER
          TZ        A1                  IS THERE A REMAINDER ?
          AA,U      A0,1                YES.  INCLUDE A BYTE TO HOLD IT
          AA,U      A0,ICHTXTL+ICHPREL+ICHPOST ADD TEXT, PREAMBLE, POSTAMBLE
          SA        A0,LTICOUNT,X3      SET AS INPUT COUNT IN LINE TABLE
          TZ        LTSYNC,X3           IS THIS A SYNCHRONOUS LINE ?
          AA,U      A0,ICHNSYN          YES.  INCLUDE ROOM FOR SYNC CHARACTERS
          SA        A0,LTOCOUNT,X3      SET OUTPUT COUNT IN LINE TABLE
          LA,U      A1                  CLEAR REMAINDER FOR WORD COMPUTATION
          DSL       A0,1                DIVIDE CHARACTERS BY TWO
          TZ        LTQWM,X3            QUARTER-WORD MODE LINE ?
          DSL       A0,1                YES.  DIVIDE CHARACTERS BY FOUR
          TZ        A1                  ARE THERE CHARACTERS LEFT OVER ?
          AA,U      A0,1                YES.  ROUND TO NEXT WORD
          AA,U      A0,ITTEXT           ADD TRANSACTION BUFFER PREAMBLE
          SA        A0,LTBLW,X3         SET BUFFER LENGTH IN WORDS
.
.         CREATE TIMEOUT ACTIVITY FOR THE LINE TABLE
.
          FORK      ICTIMER             CREATE A TIMEOUT ACTIVITY
.
.         INCREMENT LINES ACTIVE.  IF THIS IS THE FIRST LINE,
.         ACQUIRE THE REAL-TIME BUFFER POOL AND RAISE TO REAL
.         TIME LEVEL.
.
          P         ICHGLOCK            LOCK MASTER INTERCHANGE LOCK
          LA        A0,LINEACTV         LOAD LINES ACTIVE COUNT
          AU,U      A0,1                INCREMENT LINES ACTIVE
          SA        A1,LINEACTV         UPDATE LINES ACTIVE
          JNZ       A0,NOTFLC           SKIP IF NOT FIRST LINE
          FORK      ITC                 CREATE TRANSACTION PROCESSOR
          BGET      RTBUFL              ACQUIRE ALL THE SPACE WE'LL EVER NEED
          BRELP     A0                  RELEASE TO BUFFER POOL
          ON        REALTHING
          RT$       35                  RAISE TO REAL TIME LEVEL
          OFF       REALTHING
NOTFLC    V         ICHGLOCK            RELEASE INTERCHANGE LOCK
          FORK      LTIACT              CREATE LT INPUT ACTIVITY
          P         LTOAQ,X3            WAIT FOR INPUT ACTIVITY TO BE READY
          FORK      LTOACT              CREATE LT OUTPUT ACTIVITY
          P         LTOAQ,X3            WAIT FOR OUTPUT ACTIVITY
          COMPLETE  .                   COMPLETE THE COMMAND
.
.
.         IMPROPER EQUIPMENT TYPE ON FILE TO BE CONNECTED
.
CONEQTW   LA,U      A6,BADEQT           LOAD ERROR MESSAGE ADDRESS
CONERR    R$DIT     .                   FIRE UP THE EDITOR
          E$MSG     A6,,W               EDIT THE ERROR MESSAGE
          LA,U      A0,,X9              LOAD INPUT FDT ADDRESS
          LMJ       X11,FIST            APPEND FILE AND STATEMENT, PRINT
          ZAP       .                   ERROR THE COMMAND, ROADBLOCK FILES
          COMPLETE  .                   COMPLETE THE COMMAND
.
.         FILE SPECIFIED ALREADY CONNECTED
.
CONALR    LA,U      A6,CONALM           LOAD ERROR MESSAGE ADDRESS
          J         CONERR              PROCESS CONNECT ERROR
.
BADEQT    'CANNOT CONNECT NON-COMMUNICATIONS !'
CONALM    'CONNECT ALREADY PERFORMED ON !'
/.
.
.         INTERCHANGE COMMAND PROCESS
.
ICHG*     quarterword                   TURN ON QUARTER WORD MODE
          LA        A13,CDOPTS,X8       LOAD OPTIONS ON COMMAND
          LX        X9,CDBPC,X8         LOAD FIRST PARAMETER
          LX        X10,PBLINK,X9       CHAIN TO SECOND PARAMETER
          LX        X9,PBVAL,X9         LOAD INPUT FDT ADDRESS
          LX        X10,PBVAL,X10       LOAD OUTPUT FDT ADDRESS
          LA        A0,FDPROP,X9        LOAD INPUT FILE PROPERTIES
          LA        A1,FDPROP,X10       LOAD OUTPUT FILE PROPERTIES
.
.         CHECK FOR NEITHER FILE COMMUNICATIONS EQUIPMENT
.
          TOP,U     A0,EPCOMM           IS INPUT FILE COMMUNICATIONS ?
          TEP,U     A1,EPCOMM           NO.  IS OUTPUT FILE A LINE ?
          J         $+2                 YES.  COMMAND IS OK
          J         ICNEITH             NO.  NEITHER FILE IS A LINE
.
.         CHECK FOR BOTH FILES COMMUNICATIONS EQUIPMENT
.
          TEP,U     A0,EPCOMM           IS FIRST FILE A LINE ?
          TOP,U     A1,EPCOMM           YES.  IS THE SECOND ONE ALSO ?
          J         $+2                 NO.  COMMAND IS OK
          J         ICBOTH              YES.  ERROR, BOTH FILES ARE LINES
          AND,U     A1,EPCOMM           GET FLAG FOR OUTPUT FILE A LINE
          LR        R10,A2              LOAD OUTPUT A LINE FLAG
          DL        A2,X9               LOAD INPUT AND OUTPUT FDT POINTERS
          TNZ       R10                 IS OUTPUT FILE THE COMM. LINE ?
          DSC       A2,36               NO.  SWAP POINTERS
          DS        A2,X9               RESET POINTERS TO FDT'S
.
.         AT THIS POINT, X9 = FILE FDT, X10 = LINE FDT
.
          TNZ       FDLT,X10            HAS LINE BEEN CONNECTED ?
          J         ICNCON              NO.  ISSUE ERROR MESSAGE
.
.         ESTABLISH SUBCHANNEL FOR THE COMMUNICATION
.
          LR        R11,X9              SAVE FDT FOR FILE PARAMETER
          LX        X3,FDLT,X10         LOAD LINE TABLE FOR LINE
          LA        A1,LTSCN,X3         LOAD SUBCHANNEL NUMBER
          AA,U      A1,1                INCREMENT SUBCHANNEL NUMBER
          SA        A1,LTSCN,X3         UPDATE SUBCHANNEL NUMBER
          LMJ       X5,STINIT           INITIALISE SUBCHANNEL TABLE
          SX        X8,STCDB,A0         SET COMMAND IN SUBCHANNEL
          LX        X9,A0               MAKE X9 SUBCHANNEL POINTER
          LA        A1,A0               LOAD SUBCHANNEL ADDRESS
          INSERT    LTSCQ,X3            INSERT SUBCHANNEL ON LT
.
.         CREATE I/O FCT FOR THE FILE SPECIFICATION
.
          LA        A1,R11              LOAD FDT FOR FILE IN INTERCHANGE
          LMJ       A2,IOGET            BUILD AN I/O FCT FOR FILE
          SA        A0,STFCT,X9         SAVE FCT IN SUBCHANNEL
          LX        X10,A0              SET X10 AS I/O FCT POINTER
          TNZ       R10                 FILE SOURCE INTERCHANGE ?
          J         ICHFO               NO.  PROCESS FILE OUTPUT INTERCHANGE
.
.         FILE INPUT INTERCHANGE SETUP
.
          SZ        STDMFCT,X9          MARK AS FILE SOURCE INTERCHANGE
          LX        X5,CDBPC,X8         LOAD THE PARAMETER CHAIN LINK
          LX        X5,PBLINK,X5        LINK TO SECOND PARAMETER
          LX        X5,PBLINK,X5        LINK TO THIRD PARAMETER
          TZ        X5                  WAS THIRD PARAMETER SPECIFIED ?
          J         ICH3PA              YES.  LOAD IT
          LA,U      A0,0377777          NO.  LOAD INFINITY BLOCK COUNT
          TEP,U     A13,OPTION('M')     WAS THE 'M' OPTION ON ?
          LA,U      A0,1                YES.  DEFAULT IS THEN ONE
          J         ICHSBC              GO SET BLOCK COUNT IN FCT
ICH3PA    LA        A0,PBVAL,X5         LOAD THE THIRS PARAMETER
ICHSBC    SA        A0,IOCOUNT,X10      SET COUNT IN INPUT FCT
          LA,U      A0                  CLEAR I/O OPTION FOR DEFAULT
          TEP,U     A13,OPTION('M')     'M' OPTION SPECIFIED ?
          LA,U      A0,'M'              YES.  SET 'M' I/O OPTION
          SA        A0,IOOPT,X10        SET I/O OPTION FOR READING
          LMJ       A2,INPUT            CREATE AN INPUT ACTIVITY
          BGET      ITTEXT              ALLOCATE A START INTERCHANGE TRANSACTION
          SX        X3,ITLT,A0          SET LINE TABLE IN TRANSACTION
          SX        X9,ITST,A0          SET SUBCHANNEL TABLE IN TRANS.
          LA,U      A1,ITYSTOUT         LOAD 'START OUTPUT' TYPE
          SA        A1,ITTYPE,A0        SET TYPE IN TRANSACTION
          LA        A1,A0               LOAD TRANSACTION ADDRESS
          INSERT    ICHWQ               PUT ON TRANSACTION QUEUE
          V         ICHWORK             MARK TRANSACTION AVAILABLE
          EXIT      .                   TERMINATE THIS ACTIVITY
.
.         FILE OUTPUT INTERCHANGE SETUP
.
ICHFO     LMJ       A2,IOGNF            CREATE NON-I/O FCT TO DRIVE OUTPUT
          SA        A0,STDMFCT,X9       SAVE DUMMY FCT IN SUBCHANNEL
          LX        X10,A0              LOAD DUMMY FCT AS INPUT FCT
          LX        X9,STFCT,X9         LOAD REAL FCT AS OUTPUT FCT
.
.         GET INTERCHANGE PREFIX BLOCK AND EDIT HEADER
.
          GET       IOBB,X10            GET INTERCHANGE PREFIX BLOCK
          LX,U      X7,IBDATA,A1        LOAD ADDRESS OF DATA IN BLOCK
          LA        A0,IPBH,X7          LOAD PREFIX BLOCK HEADER
          TE        A0,('*INTR*')       IS IT A VALID HEADER BLOCK ?
          IERR      .                   NO.  BOMB OUT
          R$DITA    .                   FIRE UP THE EDITOR
          ASCII
          A$LMSG    ICRCSTM             EDIT 'RECEIVING FILE' MESSAGE
          A$FD2     IPBQUAL,X7          EDIT QUALIFIER OF FILE
          A$LMSR    .                   COPY MESSAGE TEXT
          A$FD2     IPBFNAME,X7         EDIT FILE NAME
          LA        A4,IPBEQTW,X7       LOAD WORD WITH F-CYCLE
          LSSL      A4,24               SHIFT OFF UNWANTED DATE
          SSL       A4,24               RIGHT JUSTIFY VALUE
          TZ        A4                  TEMPORARY FILE ?
          TNE,U     A4,1                IS CYCLE 1 BEING SENT ?
          J         ICHMNOT1            YES.  SKIP EDITING
          A$QCHR    '('                 NO.  EDIT LEFT PARENTHESIS
          A$DECV    A4,,W               EDIT ABSOLUTE F-CYCLE
          A$QCHR    ')'                 EDIT RIGHT PARENTHESIS
ICHMNOT1  A$LMSR    .                   COPY MESSAGE TO EQUIPMENT TYPE
          LA,S1     A0,IPBEQTW,X7       LOAD EQUIPMENT TYPE OF FILE
          LA        A0,EQTTAB,A0        LOAD EQUIPMENT TYPE MNEMONIC
          SSL       A0,12               SHIFT OFF PROPERTY BITS
          A$FD1     .                   EDIT EQUIPMENT TYPE NAME
          A$LMSR    .                   COPY TO SITE NAME
          A$FD1     IPBSITE,X7          EDIT SENDING SITE NAME
          A$LMSR    .                   COPY TO END OF MESSAGE
          R$PRTXA   1                   PRINT THE RECEIVING MESSAGE
          FIELDATA
.
.         ESTABLISH PROPERTIES OF SOURCE FILE FROM PREFIX BLOCK
.
          LA,U      A0                  CLEAR I/O OPTION FOR WRITING
          LA        A1,IPBPROP,X7       LOAD PROPERTIES OF SOURCE FILE
          TEP,U     A1,EPMASS           IS SOURCE A MASS STORAGE FILE ?
          SNONZ     IOMASS,X10          YES.  SET MASS IN DUMMY FCT
          TEP,U     A1,EPWAD            WORD-ADDRESSABLE SOURCE FILE ?
          SNONZ     IOWAD,X10           YES.  MARK WORD ADDRESSABLE
          TZ        IOMASS,X10          IS INPUT A TAPE FILE ?
          TNZ       IOMASS,X9           NO.  IS OUTPUT TAPE ?
          J         ICHONTP             YES.  HANDLE INTERCHANGE INVOLVING TAPE
          LA,U      A0,'D'              LOAD I/O OPTION TO DUPLICATE ADDRESS
ICHSIOP   SA        A0,IOOPT,X9         SET I/O OPTION IN FCT
          LA        A0,X7               LOAD PREFIX BLOCK ADDRESS
          ANA,U     A0,IBDATA           BACK UP TO START OF BLOCK
          BRELP     A0                  RELEASE THE BLOCK
          LMJ       A2,OUTPUT           CREATE AN OUTPUT ACTIVITY
          P         IOBB+QL,X9          WAIT FOR OUTPUT TO COMPLETE
          BRELP     X9                  RELEASE OUTPUT FCT
          BRELP     X10                 RELEASE INPUT FCT
.         ** RELEASE SUBCHANNEL **
          COMPLETE  .                   COMPLETE THE COMMAND
.
ICHONTP   TNZ       IOMASS,X10          IS INPUT TAPE ?
          TZ        IOMASS,X9           YES.  IS OUTPUT TAPE ?
          J         ICHDIFF             NO.  DIFFERENT DEVICES AT EACH END
          LA,U      A0,'M'              YES.  COPY END OF FILES ON TAPE
          J         ICHSIOP             GO SET I/O OPTION
.
ICHDIFF   TEP,U     A13,OPTION('Q')     IS TAPE SIMULATION DESIRED ?
          J         ICHSIOP             YES.  JUST COPY ADDRESSES
          TNZ       IOMASS,X9           NO.  IS OUTPUT MASS STORAGE ?
          J         ICHDFFI             NO.  THIS IS MASS => TAPE
          GET       IOBB,X10            READ FILE LABEL BLOCK FROM TAPE
          LA        A0,IBLEN,A1         LOAD LENGTH OF BLOCK
          TNE,U     A0,28               IS THIS CORRECT LENGTH OF A LABEL ?
          TZ        IBSTAT,A1           WAS I/O STATUS NORMAL ON BLOCK ?
 IERR     J         ICHGBL              NO.  BAD LABEL
          LA        A0,IBDATA,A1        LOAD LABEL FROM BLOCK READ
          TNE       A0,('COPYGD')       WAS ORIGINAL FILE WORD ADDRESSABLE ?
          SNONZ     IOWAD,X10           YES.  FLAG IT WORD ADDRESSABLE
          TE        A0,('COPYG ')       IS THIS A CORRECT FORMAT TAPE ?
          TNE       A0,('COPYGD')       OR A WORD-ADDRESSABLE COPY,G ?
 IERR     J         ICHGBL              NO.  REJECT FOR BAD LABEL
          LA,U      A0,'G'              LOAD 'G' I/O OPTION
          J         ICHSIOP             GO SET I/O OPTION
.
ICHDFFI   .
.         *** GENERATE COPY,G LABEL BLOCK ***
          LA,U      A0,'G'              LOAD 'G' I/O OPTION
          J         ICHSIOP             SET I/O OPTION FOR OUTPUT
.
.
.         INITIALISE SUBCHANNEL BUFFER
.
.         LA,U      A1,<SUBCHANNEL NUMBER>
.         LMJ       X5,STINIT
.         <RETURN>                      A0 = SUBCHANNEL BUFFER
.
STINIT    BGET      STL                 ALLOCATE A SUBCHANNEL BUFFER
          SA        A1,STSCN,A0         SET SUBCHANNEL NUMBER IN BUFFER
          LA,U      A1,ALT              LOAD INITIAL INPUT ALTERNATION
          SA        A1,STIALT,A0        SET TO RECEIVE 0 ALTERNATION FIRST
          SZ        STOALT,A0           SET TO SEND 0 ALTERNATION FIRST
          SX        X3,STLT,A0          SET LINE TABLE BACKPOINTER
.
.         INPUT AREA INITIALISATION
.
          LA,U      A1,36               LOAD BITS PER WORD
          SA        A1,STBITL,A0        SET BITS LEFT IN TEXT WORD
          SZ        STIWA,A0            SET INPUT WORD ACCUMULATOR ZERO
          LA,U      A1,IPNXINT          LOAD INITIAL RETURN ADDRESS
          SA        A1,STIRTN,A0        SET GET CHARACTER RETURN POINT
          LA,U      A1,STILEN,A0        LOAD INITIAL BUFFER POINTER
          SA        A1,STIBP,A0         SET TO STORE INTO STILEN INITIALLY
          SZ        STRETRANS,A0        CLEAR LAST OUTPUT BUFFER SENT
          SZ        STILEN,A0           CLEAR LENGTH OF INPUT BLOCK
          SZ        STMSAD,A0           CLEAR ADDRESS OF LAST BLOCK
.
          J         0,X5                RETURN TO CALLER
.
.         ERROR ROUTINES
.
ICNCON    R$DIT     .                   FIRE UP THE EDITOR
          E$MSG     ICNCOM              EDIT NOT CONNECTED MESSAGE
          LA,U      A0,,X10             LOAD I/O FCT ADDRESS
          LMJ       X11,FIST            EDIT FILE AND STATEMENT
          ZAP       .                   ERROR THE COMMAND
          COMPLETE  .                   COMPLETE THE COMMAND
.
ICNEITH   LA,U      A6,ICNEITHM         LOAD 'NEITHER' MESSAGE
ICHPERR   R$DIT     .                   ENTER EDITOR
          E$MSG     A6,,W               EDIT ERROR MESSAGE
          LMJ       X11,IST             APPEND STATEMENT NUMBER
          ZAP       .                   ERROR THE COMMAND
          COMPLETE  .                   AND COMPLETE IT
.
ICBOTH    LA,U      A6,ICBOTHM          LOAD ERROR MESSAGE
          J         ICHPERR             PRINT THE ERROR MESSAGE
.
ICNCOM    'ATTEMPT TO INTERCHANGE ON UNCONNECTED !'
ICBOTHM   'BOTH FILES ARE COMMUNICATIONS FOR INTERCHANGE !'
ICNEITHM  'NEITHER FILE IS COMMUNICATIONS FOR INTERCHANGE !'
          ASCII
ICRCSTM   '#RECEIVING FILE &*& FROM & AT SITE &.&'
          FIELDATA
/.
.
.         DISCONNECT COMMAND PROCESS
.
DISCT*    quarterword                   TURN ON QUARTER-WORD MODE
          LX        X9,CDBPC,X8         LOAD LINK TO PARAMETER
          LX        X9,PBVAL,X9         LOAD FDT ADDRESS FOR FILE
          LA        A0,FDPROP,X9        LOAD PROPERTIES OF FILE
          TOP,U     A0,EPCOMM           IS FILE COMMUNICATIONS TYPE ?
          J         DCBEQT              NO.  IMPROPER EQUIPMENT TYPE
          TNZ       FDLT,X9             HAS FILE BEEN CONNECTED ?
          J         DCNCON              NO.  CAN'T DISCONNECT AN UNCONNECTED FIL
          LX        X3,FDLT,X9          LOAD ADDRESS OF FILE TABLE
          INITPVQ   0,LTSCQ,X3          REINITIALISE SUBCHANNEL QUEUE AS
.                                       A P/V QUEUE.  IT WILL BE USED TO
.                                       SYNCHRONISE TERMINATION OF THE
.                                       LINE TABLE AND ASSOCIATED
.                                       ACTIVITIES.
          ON        REALTHING
          RT$       35                  RAISE TO REAL-TIME IN CASE WE ARE LAST
          OFF       REALTHING
          V         LTOAQ,X3            TELL THE OUTPUT ACTIVITY TO TERMINATE
          SNONZ     LTCLOSE,X3          SET TERMINATION FLAG IN LT
          ACT$      LTINAME,X3          FIRE OFF INPUT ACTIVITY
          P         LTSCQ,X3            WAIT FOR INPUT ACTIVITY TO TERMINATE
          P         LTSCQ,X3            WAIT FOR OUTPUT ACTIVITY
          P         LTSCQ,X3            WAIT FOR TIMER TO TERMINATE
.
          ON        REALTHING
.         ** HANG UP IF AUTO-DIAL AVAILABLE **
          CMT$      LTFN,X3             TERMINATE THE LINE TERMINAL
          OFF       REALTHING
.
          P         ICHGLOCK            LOCK INTERCHANGE COMMON STORAGE
          LA        A0,LINEACTV         LOAD LINES ACTIVE COUNT
          ANA,U     A0,1                DECREMENT LINES ACTIVE
          SA        A0,LINEACTV         UPDATE LINES ACTIVE
          ON        DEBUG
          TP        A0                  HAS LINES ACTIVE GONE NEGATIVE ?
          IERR      .                   YES.  BOMB
          OFF       DEBUG
          JNZ       A0,DCNLLA           SKIP IF NOT LAST LINE ACTIVE
          V         ICHWORK             LAST ONE.  TERMINATE TRANSACTION PROCESS
DCNLLA    V         ICHGLOCK            RELEASE INTERCHANGE STORAGE LOCK
          SZ        FDLT,X9             MARK LINE TERMINAL NOT CONNECTED
          BRELP     X3                  RELEASE THE LINE TABLE
          COMPLETE  .                   COMPLETE THE COMMAND
.
.         ERROR ROUTINES AND MESSAGES
.
DCBEQT    LA,U      A6,DCBEQM           LOAD ERROR MESSAGE
DCNERR    R$DIT     .                   FIRE UP THE EDITOR
          E$MSG     A6,,W               COPY THE ERROR MESSAGE
          LA        A0,X9               LOAD THE FDT ADDRESS
          LMJ       X11,FIST            APPEND FILE IN STATEMENT
          ZAP       .                   ERROR THE COMMAND
          COMPLETE  .                   TERMINATE
.
DCNCON    LA,U      A6,DCNCOM           LOAD ERROR MESSAGE ADDRESS
          J         DCNERR              PRINT ERROR MESSAGE
.
.
DCBEQM    'CANNOT DISCONNECT NON-COMMUNICATIONS !'
DCNCOM    'CANNOT DISCONNECT UNCONNECTED !'
/.
.
.         TRANSACTION PROCESSOR
.
NEXTRANS  BRELP     X7                  RELEASE PREVIOUS TRANSACTION
.
ITC       P         ICHWORK             WAIT FOR WORK TO BE AVAILABLE
          REMOVE    ICHWQ               REMOVE NEXT TRANSACTION
          TNE,U     A1,ICHWQ            TERMINATION ACTIVATION ?
          EXIT      .                   YES.  TERMINATE WHEN ALL DONE
          SA        A1,X7               SAVE TRANSACTION BUFFER ADDRESS
          LX        X3,ITLT,X7          LOAD LINE TABLE ADDRESS
          LX        X9,ITST,X7          LOAD SUBCHANNEL TABLE ADDRESS
          LA        A0,ITTYPE,X7        LOAD TRANSACTION TYPE
          TLE,U     A0,MXTRT            ILLEGAL TRANSACTION TYPE ?
          J         $+1,A0              BRANCH ON TRANSACTION TYPE
TRT0      IERR      .                   TYPE 0:  KABOOM !!
          J         ICHIN               TYPE 1:  INPUT MESSAGE TEXT
          J         ICHTMO              TYPE 2:  TIMEOUT ON OUTPUT
          J         ICHSTO              TYPE 3:  START INTERCHANGE OUTPUT
MXTRT     EQU       $-TRT0              HIGHEST TRANSACTION TYPE
/.
.
.         PROCESS INPUT BUFFER
.
.
.         INPUT BUFFER FORMAT:
.
.    CONTROL MESSAGE                    TEXT
.
.
.         SOH                           SOH
.         <SUBCHANNEL>                  <SUBCHANNEL>
.         <TYPE>                        <TYPE>
.         EOT                           STX
.         CRC1                           T
.         CRC2                           E
.                                        X
.                                        T
.                                       EOT
.                                       CRC1
.                                       CRC2
.
.         THE TEXT CONTAINED IN THE TEXT PORTION IS A FREE-FORMAT
.         BYTE STREAM OF THE SIZE BYTES THE LINE CAN HANDLE.
.
.         ANY CHARACTER OTHER THAN THE 'ESCAPE' CODE IS ACCRUED INTO
.         THE WORD ACCUMULATOR.  WHEN 36 BITS OR MORE DATA HAVE BEEN
.         ACCUMULATED, THE EXCESS, IF ANY, IS DISCARDED, AND THE WORD
.         IS STORED INTO THE BUFFER.  AN 'ESCAPE' TRIGGERS THE SCAN
.         OF THE NEXT CHARACTER AND ITS INTERPRETATION AS FOLLOWS:
.
.         ESC 1     THE PRECEDING WORD SPECIFIED THE LENGTH OF
.                   THE BLOCK TO FOLLOW.  ALLOCATE A BUFFER WITH
.                   THAT TEXT CAPACITY AND POSITION THE POINTER
.                   TO STORE INTO THAT BUFFER.
.
.         ESC 2     THE PRECEDING WORD WAS THE MASS STORAGE
.                   ADDRESS AT WHICH THIS BLOCK WAS READ.  PUT
.                   THE WORD INTO THE ADDRESS WORD FOR THE BLOCK
.                   AND DELETE IT FROM THE TEXT PORTION.
.
.         ESC 3     THE FOLLOWING BYTE IS A COUNT OF THE NUMBER
.                   OF TIMES TO REPLICATE THE PRECEDING WORD IN THE
.                   BUFFER.  THIS WILL NEVER CROSS A BLOCK BOUNDARY.
.                   IF NO PRECEDING WORD EXISTS, ENTER THE SPECIFIED
.                   NUMBER OF ZERO WORDS.
.
.         ESC 4     INSERT THE CODE FOR 'ESCAPE' AS A TEXT CHARACTER.
.
.         ESC 5     THE BLOCK BUFFER IS COMPLETE.  WRITE IT NOW.
.
.         ESC 6     ALL DATA HAS BEEN TRANSMITTED FOR THIS FILE.
.
.         ESC 7     THE FOLLOWING BYTE IS THE INCREMENT MINUS ONE
.                   WHICH, ADDED TO THE ADDRESS OF THE LAST
.                   BLOCK RECEIVED, GIVES THE ADDRESS OF THE
.                   CURRENT BLOCK.  IF PRESENT IN THE FIRST
.                   BLOCK RECEIVED, ADD TO ZERO.
.
.         ESC 8     TAKE THE BITS ACCUMULATED SO FAR AS THE NEXT
.                   TEXT WORD.
.
.
ICHIN     LX,U      X1,ITTEXT,X7        LOAD TEXT START ADDRESS
          ON        DUMPING
          SX,H2     X1,ISPK+1           SET ADDRESS IN PACKET
          LA        A0,LTICOUNT,X3      LOAD INPUT COUNT FROM LT
          AA,U      A0,3                *QW* ROUND UP
          SSL       A0,2                *QW* DIVIDE BY 4 TO GET WORDS
          SA,H1     A0,ISPK+1           SET LENGTH IN PACKET
          LA        A0,PARTBL           LOAD OPTIONS
          TOP,U     A0,OPTION('W')      TRANSACTION DUMP DESIRED ?
          J         ICHSNP              NO.  SKIP DUMP
          SNAP$P    ISPK                DUMP INPUT BUFFER
ICHSNP    .
$(2).
ISPK      SNAP$PKT  ,,'INPUT '
$(1)      OFF       DUMPING
          AX        X1,(1,0)            FORM WORD POINTER TO TEXT
          LX        X2,(1,0)            SET CHARACTER POINTER TO START
          ON        EITHER
          TZ        LTQWM,X3            QUARTER WORD LINE TERMINAL ?
          AX,U      X2,QWFETCH          YES.  OFFSET CHARACTER POINTER
          OFF       EITHER
          DSL       CRC2,72             CLEAR CRC ACCUMULATORS
.
.         VALIDATE THE INPUT BUFFER FORMAT AND CHECK CRC
.
          EX        FETCH               GET THE FIRST CHARACTER
          CRC       A0                  INCLUDE IN CRC
          TE,U      A0,SOH              IS IT START OF HEADER ?
          LMJ       X11,IPRJ            NO.  REJECT MESSAGE
          EX        FETCH               LOAD THE SECOND CHARACTER
          CRC       A0                  INCLUDE IT IN THE CRC
.
.         LOOK UP THE SUBCHANNEL CONTROL TABLE
.
          LX        X9,LTSCQ+QFL,X3     LOAD LINK TO FIRST SUBCHANNEL ON LT
IPSCS     LA        A1,X9               LOAD SUBCHANNEL POINTER
          TNE,U     A1,LTSCQ,X3         SUBCHANNEL NOT FOUND ?
          J         NEXTRANS            RIGHT.  IGNORE THE MESSAGE
          TNE       A0,STSCN,X9         DOES SUBCHANNEL MATCH MESSAGE ?
          J         IPSCOK              YES.  THIS IS THE SUBCHANNEL
          LX        X9,QFL,X9           LOAD LINK TO NEXT SUBCHANNEL
          J         IPSCS               CHECK FOR END OF LIST
.
IPSCOK    EX        FETCH               LOAD THE NEXT CHARACTER
          CRC       A0                  ADD INTO THE CRC
          LA        A6,A0               SAVE THE MESSAGE TYPE BITS
          EX        FETCH               LOAD THE STX/EOT CHARACTER
          CRC       A0                  INCLUDE IN THE CRC
          TNE,U     A0,EOT              IS THIS END OF MESSAGE ?
          J         IPSCCRC             YES.  GO CHECK CRC
          TE,U      A0,STX              NO.  IS IT START OF TEXT ?
          LMJ       X11,IPRJ            NO.  REJECT MESSAGE
          AND,U     A6,ACK+NAK          AND OFF ACK AND NAK BITS
          TZ        A7                  IS THIS A TEXT MESSAGE ?
          LMJ       X11,IPRJ            NO.  REJECT ACK/NAK WITH TEXT
          SX        X1,R5               SAVE WORD POINTER AT TEXT START
          SX        X2,R6               SAVE CHARACTER POINTER AT TEXT START
          LR,U      R1,ICHTXTL-1        LOAD TEXT LENGTH IN CHARACTERS
IPTXCRC   EX        FETCH               LOAD NEXT CHARACTER FROM TEXT
          CRC       A0                  ADD TEXT CHARACTER TO CRC
          JGD       R1,IPTXCRC          LOOP FOR ALL TEXT CHARACTERS
          EX        FETCH               LOAD THE EOT FOR THE MESSAGE
          CRC       A0                  INCLUDE IN CRC
          TE,U      A0,EOT              WAS IT AN EOT ?
          LMJ       X11,IPRJ            NO.  REJECT MESSAGE
.
.         NOW LOAD CRC FROM THE MESSAGE AND VALIDATE AGAINST
.         CRC COMPUTED FROM EXAMINATION OF THE MESSAGE.  THE
.         16 BIT CRC WILL SPAN AS MANY BYTES AS ARE REQUIRED
.         TO HOLD IT.
.
IPSCCRC   LA        A3,LTBITPC,X3       LOAD BITS PER CHARACTER ON LINE
          LA,U      A2                  CLEAR RESULT ACCUMULATOR
          LA,U      A4,16               LOAD NUMBER TO BITS TO ACCRUE
IPSCRCL   EX        FETCH               GET THE NEXT BYTE
          LSSL      A2,,A3              SHIFT OVER CRC ACCUMULATOR
          AA        A2,A0               ADD IN THIS BYTE
          ANA       A4,A3               DECREMENT BITS LEFT TO SCAN
          JZ        A4,IPCRCD           SKIP IF ALL OF CRC SCANNED
          JP        A4,IPSCRCL          CONTINUE IF MORE TO SCAN
          LNA       A3,A4               LOAD BITS TO RIGHT JUSTIFY CRC
          SSL       A2,,A3              RIGHT JUSTIFY THE CRC TOTAL
IPCRCD    DSL       A2,8                SHIFT OFF SECOND CRC CHARACTER
          SSL       A3,36-8             RIGHT JUSTIFY SECOND CRC
          TNE       A2,CRC1             IS FIRST CRC CHAR CORRECT ?
          TE        A3,CRC2             YES.  IS THE SECOND RIGHT, TOO ?
          J         IBADCRC             NO.  SEND A NAK FOR MESSAGE
.
.         CRC GOOD.  NOW ANALYSE MESSAGE
.
          AND,U     A6,ACK+NAK          AND OFF ACK AND NAK BITS
          JZ        A7,IPTEXT           PROCESS TEXT IF NEITHER BIT ON
          TOP,U     A6,ACK              IS THIS AN ACK ?
          J         IPNAK               NO.  RESEND THE MESSAGE
.
.         ACK RECEIVED FOR OUTPUT TEXT
.
          AND,U     A6,ALT              ISOLATE ALTERNATION BIT
          TE        A7,STOALT,X9        ACK FOR MESSAGE WE SENT ?
          J         IPNAK               NO.  RESEND MESSAGE FOR WRONG ACK
          LA        A0,STOALT,X9        LOAD OUTPUT ALTERNATION
          XOR,U     A0,ALT              COMPLEMENT ALTERNATION
          SA        A1,STOALT,X9        UPDATE OUTPUT ALTERNATION
          LA        A0,STRETRANS,X9     LOAD RETRANSMISSION BUFFER
          SZ        STRETRANS,X9        CLEAR RETRANSMISSION AVAILABLE
          BRELP     A0                  RELEASE LAST MESSAGE
          BRELP     X7                  RELEASE THE TRANSACTION
          J         ICOACKR             ENTER OUTPUT CODE TO SEND NEXT MESSAGE
.
.         NAK RECEIVED.  RESEND TEXT BUFFER
.
IPNAK     LA        A1,STRETRANS,X9     LOAD PREVIOUS TEXT BUFFER
          TNZ       A1                  IS THIS A SPURIOUS NAK ?
          LMJ       X11,IPRJ            YES.  REJECT TRANSACTION
          INSERT    LTOQ,X3             PUT BACK ON OUTPUT QUEUE FOR LT
          V         LTOAQ,X3            MARK OUTPUT AVAILABLE ON LT
          J         NEXTRANS            GO PROCESS NEXT TRANSACTION
.
.
.         TEXT MESSAGE RECEIVED
.
.         DECOMPOSE MESSAGE INTO I/O BUFFERS
.
IPTEXT    AND,U     A6,ALT              ISOLATE ALTERNATION BIT
          TNE       A7,STIALT,X9        DIFFERENT FROM LAST TEXT MESSAGE ?
          J         IPACKI              NO.  JUST SEND ACK AND IGNORE
          SA        A7,STIALT,X9        SAVE ALTERNATION OF LAST MESSAGE
          LX        X6,STIBP,X9         LOAD INPUT BUFFER POINTER
          AX        X6,(1,0)            SET INCREMENT ON POINTER
          LX        X1,R5               LOAD WORD POINTER TO TEXT START
          LX        X2,R6               LOAD CHARACTER POINTER TO TEXT START
          LA        A4,STBITL,X9        A4 = BITS LEFT IN WORD
          LA        A2,STIWA,X9         RELOAD INPUT WORD ACCUMULATOR
          LA        A3,LTBITPC,X3       LOAD BITS PER CHARACTER ON LINE
          LR,U      R4,ICHTXTL          LOAD CHARACTERS IN BUFFER TEXT
          LX        X5,STIRTN,X9        LOAD RETURN POINT TO GETCHAR
          J         GETCHAR             GO FETCH NEXT CHARACTER
.
IPNXTC    GETCHAR   .                   LOAD THE NEXT TEXT CHARACTER
IPNXINT   TNE,U     A0,ESC              START OF ESCAPE SEQUENCE ?
          J         IPESC               YES.  INTERPRET ESCAPE SEQUENCE
IPACCUM   DSL       A0,,A3              MOVE CHARACTER TO A1
          LDSC      A1,,A3              ACCRUE CHARACTER IN A2
.                                       NOTE OVERFLOW BITS MAY GO TO A1
          ANA       A4,A3               SUBTRACT BITS LEFT IN WORD
          JZ        A4,IPWRD            SKIP IF TEXT WORD COMPLETED
          JP        A4,IPNXTC           CONTINUE IF MORE BITS NEEDED
.
          LNA       A0,A4               LOAD NUMBER OF EXTRA BITS SHIFTED IN
          DSL       A1,,A0              RIGHT JUSTIFY TEXT WORD
IPWRD     SA        A2,,*X6             SET WORD IN BUFFER
          ON        DEBUG
          LA,U      A2,,X6              LOAD BUFFER POINTER
          ANA,U     A2,1                BACK OFF THE INCREMENT
          TNE,U     A2,STILEN,X9        ARE WE STORING LENGTH ?
          J         IPWDBOK             YES.  SKIP RANGE TEST
          ANA       A2,STIB,X9          SUBTRACT BUFFER START
          ANA,U     A2,IBDATA           COMPUTE WORDS STORED IN BUFFER
          TG        A2,STILEN,X9        HAVE WE OVERFLOWED BUFFER ?
          IERR      .                   YES.  BOMB
IPWDBOK   OFF       DEBUG
          LA,U      A4,36               RELOAD BITS NEEDED FOR WORD
          LA,U      A2                  CLEAR TEXT WORD ACCUMULATOR
          J         IPNXTC              PROCESS NEXT CHARACTER
.
.
.         PROCESS ESCAPE SEQUENCE
.
IPESC     GETCHAR   .                   LOAD TYPE OF ESCAPE SEQUENCE
          TLE,U     A0,MXESC            IS IT A LEGAL TYPE ?
          J         $+1,A0              BRANCH ON ESCAPE TYPE
IPEB      IERR      .                   ILLEGAL ESCAPE SEQUENCE TYPE
          J         IPELEN              1:  DEFINE LENGTH OF BLOCK
          J         IPEADR              2:  DEFINE ADDRESS FOR MASS STORAGE
          J         IPERPC              3:  SPECIFY REPEAT COUNT FOR PREVIOUS
          J         IPEESC              4:  INSERT 'ESC' INTO TEXT
          J         IPEWRT              5:  WRITE THE BLOCK TO FILE
          J         IPEEOT              6:  END OF DATA.  CLOSE OUTPUT FILE
          J         IPEINCM             7:  INCREMENT MASS STORAGE ADDRESS
          J         IPESWRD             8:  END OF SHORT WORD
MXESC     EQU       $-IPEB              NUMBER OF DEFINED ESCAPE CODES
.
.
.         ESC 1
.
.         PREVIOUS WORD IS LENGTH OF BLOCK WHICH FOLLOWS
.
IPELEN    LA        A0,STILEN,X9        LOAD LENGTH OF INPUT BLOCK
          AA,U      A0,IBDATA           ADD BLOCK HEADER LENGTH
          BGET      .                   ALLOCATE A BLOCK BUFFER
          SA        A0,STIB,X9          SAVE INPUT BLOCK ADDRESS
          LA        A1,STILEN,X9        LOAD LENGTH OF BLOCK
          SA        A1,IBLEN,A0         SET LENGTH IN BLOCK BUFFER
          SZ        IBSTAT,A0           CLEAR BUFFER STATUS
          SZ        IBLAST,A0           CLEAR LAST BUFFER FLAG
          LXM,U     X6,IBDATA,A0        SET POINTER TO TEXT OF BLOCK
          J         IPNXTC              PROCESS NEXT CHARACTER
.
.
.         ESC 2
.
.         PREVIOUS WORD IS ADDRESS OF BLOCK ON MASS STORAGE
.
IPEADR    ANX,U     X6,1                DECREMENT BLOCK POINTER
          LA        A0,,X6              LOAD ADDRESS FOR BLOCK
          SA        A0,STMSAD,X9        SET ADDRESS OF THIS BLOCK IN SUBCHANNEL
          J         IPNXTC              PROCESS NEXT CHARACTER
.
.
.         ESC 3 <REPEAT>
.
.         REPEAT PREVIOUS WORD NUMBER OF TIMES SPECIFIED BY
.         THE NEXT BYTE.
.
IPERPC    GETCHAR   .                   LOAD NEXT CHARACTER (REPEAT COUNT)
          LR        R1,A0               LOAD COUNT FOR CHARACTER
          LA,U      A0,,X6              LOAD POINTER INTO BLOCK
          ANA,U     A0,1                BACK UP POINTER ONE WORD
          LA        A1,STIB,X9          LOAD BLOCK BUFFER ADDRESS
          LA,U      A2                  SET DEFAULT FILL AS ZERO
          TE,U      A0,IBDATA-1,A1      IS SEQUENCE BEFORE ANY DATA
          LA        A2,,A0              NO.  FILL WITH PREVIOUS WORD
          J         IPERPE              ENTER REPEAT LOOP
IPERPL    SA        A2,,*X6             SET DUPLICATE WORD IN BUFFER
          ON        DEBUG
          LA,U      A1,,X6              LOAD STORE POINTER
          ANA       A1,STIB,X9          SUBTRACT BUFFER START
          ANA,U     A1,IBDATA+1         COMPUTE WORDS STORED IN BUFFER
          TG        A1,STILEN,X9        HAVE WE OVERFLOWED BUFFER ?
          IERR      .                   YES.  BOMB OUT
          OFF       DEBUG
IPERPE    JGD       R1,IPERPL           LOOP FOR REPEAT COUNT
          LA,U      A2                  CLEAR ACCUMULATION REGISTER
          J         IPNXTC              PROCESS NEXT CHARACTER
.
.
.         ESC 4
.
.         INSERT ESCAPE IN TEXT
.
IPEESC    LA,U      A0,ESC              LOAD AN ESCAPE CHARACTER
          J         IPACCUM             GO ACCRUE AS TEXT CHARACTER
.
.
.         ESC 5
.
.         WRITE BLOCK TO OUTPUT FILE
.
IPEWRT    LA        A1,STIB,X9          LOAD BLOCK BUFFER ADDRESS
          TNZ       STSCN,X9            CONTROL SUBCHANNEL ?
          J         IPCTXT              YES.  GO PROCESS DATA BLOCK
          LA        A0,STMSAD,X9        LOAD ADDRESS FOR THIS BLOCK
          SA        A0,IBMSAD,A1        SET ADDRESS IN BLOCK
          ON        REALTHING=0
          LX        X6,A1               LOAD BLOCK ADDRESS
          R$DIT     .                   FIRE UP THE EDITOR
          E$FD4     ('WRITE: ')         LABEL THE WRITE
          E$DECV    IBLEN,X6            EDIT NUMBER OF WORDS
          E$FD4     (' WORDS AT ')      LABEL LENGTH AND ADDRESS
          E$DECV    IBMSAD,X6           LABEL THE ADDRESS
          R$PRTX    1                   PRINT THE LINE
          LA        A1,STIB,X9          RESTORE BLOCK BUFFER ADDRESS
          OFF       REALTHING=0
          LA        A0,STDMFCT,X9       LOAD DUMMY I/O FCT
          PUT       IOBB,A0             PUT BUFFER ON I/O BOUNDED BUFFER
IPCRTN    SZ        STIB,X9             MARK NO INPUT BUFFER ALLOCATED
          LX,U      X6,STILEN,X9        RESET POINTER TO GET LENGTH
          AX        X6,(1,0)            RESET INCREMENT IN POINTER
          LA        A3,LTBITPC,X3       RELOAD BITS IN A CHARACTER
          LA,U      A2                  CLEAR WORD ACCUMULATOR
          J         IPNXTC              GO PROCESS NEXT CHARACTER
.
.
.         ESC 6
.
.         END OF DATA.  CLOSE OUTPUT FILE
.
IPEEOT    TNZ       STSCN,X9            MASTER SUBCHANNEL MESSAGE ?
          J         IPEOTMS             YES.  HANDLE END OF TRANSMISSION DIFFERE
          BGET      IBDATA              ALLOCATE BUFFER TO TERMINATE OUTPUT
          ON        DEBUG
          TZ        STIB,X9             HAS LAST BUFFER BEEN WRITTEN ?
          IERR      .                   NO.  MISSING ESC 5 AFTER LAST BLOCK
          OFF       DEBUG
          LA        A1,A0               LOAD ADDRESS OF BLOCK BUFFER
          SZ        IBLEN,A1            MARK BLOCK LENGTH ZERO
          LA,U      A0,STERM            LOAD TERMINATION STATUS
          SA        A0,IBSTAT,A1        SET STATUS IN BLOCK
          SNONZ     IBLAST,A1           MARK THIS BLOCK LAST
          LA        A0,STDMFCT,X9       LOAD DRIVE FCT ADDRESS
          PUT       IOBB,A0             PLACE ON BOUNDED BUFFER
IPEEOTA   LR,U      R4                  CLEAR CHARACTERS LEFT IN BLOCK
          GETCHAR   .                   FORCE ACKNOWLEDGE OF BLOCK
          J         IPEEOTA             ...AND ALL OTHERS ON THIS SUBCHANNEL
.
IPEOTMS   LR,U      R4                  CLEAR CHARACTERS LEFT IN THE BUFFER
          J         IPNXTC              RETURN TO WATCH FOR NEXT BUFFER
.
.
.         ESC 7 <INCREMENT>
.
.         SETS THE ADDRESS FOR THE CURRENT BLOCK TO THE ADDRESS
.         OF THE LAST BLOCK PLUS <INCREMENT>.  THE LAST BLOCK
.         ADDRESS IS SET TO THE CURRENT BLOCK ADDRESS.
.
IPEINCM   GETCHAR   .                   PICK UP ADDRESS INCREMENT
          AA        A0,STMSAD,X9        ADD TO ADDRESS OF LAST BLOCK
          AA,U      A0,1                ADD IN IMPLIED BUMP OF ONE
          SA        A0,STMSAD,X9        REPLACE ADDRESS IN SUBCHANNEL
          J         IPNXTC              RETURN FOR NEXT CONTROL SEQUENCE
.
.
.         ESC 8
.
.         TERMINATES A 'SHORT WORD'.  THE DATA BYTES WHICH HAVE BEEN
.         RECEIVED SO FAR ARE DECLARED COMPLETE, AND ARE STORED AS
.         THE NEXT DATA WORD.  IF NO DATA BYTES HAVE BEEN RECEIVED,
.         ZERO IS STORED.
.
IPESWRD   EQUF      IPWRD               PROCESS JUST LIKE FULL WORD
.
.
.         GET CHARACTER
.
.         LMJ       X5,GETCHAR
.         <RETURN>                      A0 = CHARACTER
.
GETCHAR   JGD       R4,GETCAV           IF BUFFER EMPTY ?
          J         GTCNXB              YES.  ACK THIS ONE AND GET ANOTHER
GETCAV    EX        FETCH               NO.  LOAD THE NEXT CHARACTER
          J         0,X5                RETURN TO CALLER
.
GTCNXB    SX        X5,STIRTN,X9        SAVE GETCHAR RETURN POINT
.
.         SAVE DECODING ENVIRONMENT AND WAIT FOR NEXT BUFFER
.
          SA        A2,STIWA,X9         SAVE PARTIALLY ACCUMULATED WORD
          SA        A4,STBITL,X9        SAVE NUMBER OF BITS ACCUMULATED
          SX        X6,STIBP,X9         SAVE INPUT BUFFER STORE POINTER
.
.         SEND AN ACK FOR THIS TEXT BUFFER
.
IPACKI    LA,U      A4,ACK              LOAD AN ACK AS RESPONSE
          ON        REALTHING=0
          V         WACK                MARK ACK SENT FOR BUFFER
          OFF       REALTHING=0
IPSRESP   LMJ       X11,OPSETUP         SET UP OUTPUT TEXT IN BUFFER
          AA        A4,STIALT,X9        SEND ALTERNATION OF MESSAGE ACK'ED
          LA        A1,A4               LOAD THE TYPE CHARACTER
          CRC       A1                  INCLUDE IN THE CRC
          EX        STORE               PLACE TYPE IN BUFFER
          LMJ       X11,OPCLOSE         CLOSE THE OUTPUT BUFFER
          SNONZ     ITRELF,X7           MARK RELEASE UPON CHANNEL RESUME
          LA        A1,X7               LOAD ADDRESS OF TRANSACTION
          INSERT    LTOQ,X3             PLACE ON OUTPUT QUEUE FOR LT
          V         LTOAQ,X3            MARK OUTPUT AVAILABLE
          J         ITC                 GO PROCESS NEXT TRANSACTION
.
.
.         PROCESS CONTROL SUBCHANNEL MESSAGE
.
IPCTXT    LA,H1     A0,IBDATA,A1        LOAD MESSAGE TYPE
          TLE,U     A0,IPCMXT           IS IT WITHIN RANGE ?
          J         $+1,A0              YES.  BRANCH ON MESSAGE TYPE
IPCT0     J         IPCDONE             ILLEGAL.  IGNORE IT
          J         IPCMSG              1:  MESSAGE COMMAND TEXT
IPCMXT    EQUF      $-IPCT0             MAXIMUM CONTROL SUBCHANNEL TYPE
.
.         TYPE 1    MESSAGE COMMAND TEXT
.
IPCMSG    R$DIT     .                   FIRE UP THE EDITOR
          E$MSG     IPCMST              COPY THE MESSAGE HEADING
          LA        A0,STIB,X9          LOAD INPUT BUFFER ADDRESS
          E$FD1     IBDATA+1,A0         EDIT SITE OF SENDER
          E$MSGR    .                   COPY TO MESSAGE TEXT
          LA        A0,STIB,X9          LOAD BUFFER ADDRESS
          LA,H2     A1,IBDATA,A0        LOAD LENGTH OF MESSAGE TEXT
          LA,U      A0,IBDATA+2,A0      LOAD ADDRESS OF MESSAGE TEXT
          E$COPY    .                   COPY MESSAGE TEXT INTO LINE
          R$PRTX    1                   PRINT LINE AND TERMINATE
          J         IPCDONE             GO AWAIT NEXT MESSAGE
.
IPCMST    'MESSAGE FROM !:  1'
.
.
IPCDONE   BRELP     STIB,X9             RELEASE THE BLOCK BUFFER
          J         IPCRTN              GO SET UP FOR NEXT BLOCK
.
.         PROCESS MESSAGE WITH BAD CRC
.
IBADCRC   AND,U     A6,ACK+NAK          ISOLATE ACK, NAK BITS
          TZ        A7                  BAD CRC ON ACK OR NAK ?
          LMJ       X11,IPRJ            YES.  REJECT MESSAGE
          PRINT$    ('* BAD CRC * '),2  ** FLAG IT
          LA,U      A4,NAK              LOAD A NAK FOR RESPONSE
          J         IPSRESP             SEND RESPONSE TO MESSAGE
.
.         REJECT MESSAGE
.
IPRJ      SX,H2     X7,RJSPK+1          SET BUFFER ADDRESS IN SNAP PACKET
          LR        R14,LTBLW,X3        LOAD LENGTH TO DUMP
          SR,Q2     R14,RJSPK+1         SET LENGTH IN PACKET
          SNAP$P    RJSPK               SNAP THE BAD MESSAGE
          J         NEXTRANS            RELEASE IT AND CONTINUE
.
RJSPK     SNAP$PKT,'XAR' $-$,$-$,'REJECT'
/.
.
.         TIMEOUT TRANSACTION PROCESSING
.
.         THE TIMER ACTIVITY WILL PERIODICALLY SUBMIT A TIMER
.         TRANSACTION FOR EACH ACTIVE LINE TABLE.  WHEN THE TRANSACTION
.         IS RECEIVED, THIS CODE WILL SCAN ALL ACTIVE SUBCHANNELS ON THE
.         LINE TABLE AND DECREMENT THE TIMER CELL (STTIME) IN ANY
.         SUBCHANNEL WHICH HAS A PENDING (UNACKNOWLEDGED) OUTPUT
.         MESSAGE (STRETRANS IS NONZERO).  WHEN THE TIMER COUNTS DOWN
.         TO ZERO, THE MESSAGE WILL BE RETRANSMITTED AND THE COUNTER
.         WILL BE RESET TO THE ORIGINAL TIMEOUT VALUE FOR THE LINE
.         TABLE.
.
ICHTMO    LX        X9,LTSCQ+QFL,X3     LOAD LINK TO FIRST SUBCHANNEL
ICHTMN    LA,U      A0,,X9              LOAD SUBCHANNEL ADDRESS
          TNE,U     A0,LTSCQ,X3         END OF SUBCHANNEL LIST ?
          J         NEXTRANS            YES.  PROCESS NEXT TRANSACTION
          TNZ       STRETRANS,X9        IS THERE AN UNACKNOWLEDGED OUTPUT BUFFER
          J         ICHTML              NO.  LOOK AT NEXT SUBCHANNEL
          LA        A0,STTIME,X9        YES.  LOAD TIMEOUT VALUE
          ANA,U     A0,1                DECREMENT TIMER
          JNZ       A0,ICHTMS           SKIP IF TIMER IS NOT EXPIRED
          ON        REALTHING=0
          LA        A0,PARTBL           LOAD OPTIONS FROM CALL
          TOP,U     A0,OPTION('Y')      IS THE 'Y' OPTION ON ?
          J         NOTYO               NO.  SKIP THIS FOLLY
          TNZ       WACK+QN             ** READY FOR ACK ** ?
          J         ICHTML              NO.  SKIP IT
          P         WACK                YES.  DECREMENT THE COUNT
          BRELP     STRETRANS,X9        YES.  RELEASE THE MESSAGE BUFFER
          SZ        STRETRANS,X9        PREVENT RE-ENTRY
          LA        A0,STOALT,X9        LOAD OUTPUT ALTERNATION
          XOR,U     A0,ALT              COMPLEMENT ALTERNATION
          SA        A1,STOALT,X9        UPDATE OUTPUT ALTERNATION
          J         ICOACKR             BLITHER INTO ACK RECEIVED CODE
NOTYO     OFF       REALTHING=0
          LA        A1,STRETRANS,X9     EXPIRED.  LOAD MESSAGE TO RESEND
          INSERT    LTOQ,X3             PLACE ON OUTPUT QUEUE FOR LT
          V         LTOAQ,X3            MARK OUTPUT AVAILABLE FOR LT
          ON        REALTHING=0
          PRINT$    ('TIMEOUT     '),2  PRINT TIMEOUT DIAGNOSTIC
          OFF       REALTHING=0
          LA        A0,LTTIME,X3        LOAD TIME QUANTUM FOR LINE TABLE
ICHTMS    SA        A0,STTIME,X9        UPDATE TIME IN SUBCHANNEL
ICHTML    LX        X9,QFL,X9           LINK TO NEXT SUBCHANNEL
          J         ICHTMN              LOOP FOR ALL SUBCHANNELS
/.
.
.         START FILE SOURCE INTERCHANGE
.
ICHSTO    BGET      IBDATA+IPBL         GET BUFFER FOR PREFIX BLOCK
          SA        A0,STOB,X9          SAVE AS CURRENT OUTPUT BUFFER
.
.         BUILD INTERCHANGE PREFIX BLOCK
.
          LA,U      A2,IPBL             LOAD LENGTH OF PREFIX BLOCK
          SA        A2,IBLEN,A0         SET LENGTH FOR OUTPUT
          SZ        IBMSAD,A0           CLEAR SOURCE ADDRESS OF BLOCK
          SZ        IBLAST,A0           CLEAR LAST BLOCK FLAG
          SZ        IBSTAT,A0           CLEAR I/O STATUS
          LA,U      A1,IBDATA,A0        SET POINTER TO TEXT AREA
          LA        A2,('*INTR*')       LOAD INTERCHANGE SENTINEL
          SA        A2,IPBH,A1          SET AS HEADER
          LA        A2,(LEVEL)          LOAD LEVEL OF ORIGINATING FANG
          SA        A2,IPBFL,A1         SET ORIGINATING FANG LEVEL
          LA,U      A2,IPBSITE,A1       LOAD ADDRESS OF SITE WORD
          LXI,U     A2,3                LOAD FUNCTION FOR MCT$
          LA        A3,(1,021)          READ 1 WORD (SITE CODE)
          DS        A2,IPBQUAL,A1       USE QUALIFIER FOR MCT$ PACKET
          LA,U      A0,IPBQUAL,A1       LOAD MCT$ PACKET ADDRESS
          MCT$      .                   GET SITE CODE FROM MCT
          LA        A2,STFCT,X9         LOAD FCT FOR FILE BEING SENT
          LA        A3,IOOPT,A2         LOAD I/O OPTION BEING USED
          SA        A3,IPBIOOP,A1       SET I/O OPTION ON FILE
          LA        A2,IOFDT,A2         LINK TO FDT FOR SOURCE FILE
          DL        A3,FDQUAL,A2        LOAD QUALIFIER FOR FILE
          DS        A3,IPBQUAL,A1       SET QUALIFIER IN PREFIX
          DL        A3,FDFN,A2          LOAD FILE NAME OF FILE
          DS        A3,IPBFNAME,A1      SET FILE NAME IN PREFIX
          LA        A3,6,A2             LOAD FITEM$ GOODIES WORD
          SA        A3,IPBEQTW,A1       SAVE EQUIPMENT TYPE, F-CYCLE
          LA        A3,FDPROP,A2        LOAD SOURCE FILE PROPERTIES
          SA        A3,IPBPROP,A1       PUT PROPERTIES IN PREFIX
.
.         SET UP COMMUNICATIONS OUTPUT BUFFER
.
          BRELP     X7                  RELEASE THE TRANSACTION
          LA        A0,LTBLW,X3         LOAD COMMUNICATIONS BUFFER LENGTH
          BGET      .                   ALLOCATE COMMUNICATIONS BUFFER
          SA        A0,X7               SAVE AS TRANSACTION
          LMJ       X11,OPSETUP         INITIALISE OUTPUT BUFFER
          LA        A1,STOALT,X9        LOAD OUTPUT ALTERNATION
          CRC       A1                  INCLUDE IN CRC
          EX        STORE               SET ALTERNATION IN BUFFER
.                                       ABSENCE OF ACK, NAK FLAGS AS TEXT
          LA,U      A1,STX              LOAD START OF TEXT FLAG
          CRC       A1                  INCLUDE IN THE CRC
          EX        STORE               STORE IT IN THE BUFFER
          LR,U      R5,ICHTXTL-1        SET TEXT LENGTH COUNTER
          LA        A1,STOB,X9          LOAD OUTPUT BLOCK BUFFER
          J         ICOSKG              SKIP GET FOR THIS CANNED BUFFER
.
.         PROCESS NEXT BLOCK FROM SOURCE FILE
.
ICOGET    LA        A0,STFCT,X9         LOAD SOURCE FILE FCT
          GET       IOBB,A0             GET NEXT BUFFER FROM FILE
          TZ        IBLEN,A1            DOES BUFFER CONTAIN DATA ?
          J         ICOSKG              YES.  GO OUTPUT THE DATA
.         ** HANDLE TAPE EOF MARK **
          SA        A1,STOB,X9          SAVE BLOCK BUFFER ADDRESS
          J         ICONULB             JUST OUTPUT END SEQUENCE FOR NULL BLOCK
.
ICOSKG    SA        A1,STOB,X9          SAVE BLOCK BUFFER ADDRESS
          LX,U      X8,IBDATA,A1        SET POINTER TO TEXT OF BLOCK
          AX        X8,(1,0)            GET INCREMENT ON POINTER
          LR        R4,IBLEN,A1         LOAD WORDS IN BUFFER
          LA        A0,R4               LOAD LENGTH OF THE BLOCK
          TNE       A0,STILEN,X9        SAME AS LAST LENGTH SENT ?
          J         ICOLSAM             YES.  DON'T SEND LENGTH AGAIN
          SA        A0,STILEN,X9        NO.  SAVE LENGTH OF LAST BLOCK
          OUTWORD   .                   SEND THE LENGTH
ICOLSAM   OUTCHAR   ESC,1               SEND ESC 1 SEQUENCE AFTER LENGTH
          LA        A0,STFCT,X9         LOAD SOURCE FILE FCT ADDRESS
          TNZ       IOMASS,A0           IS SOURCE MASS STORAGE ?
          J         ICONAD              NO.  SKIP SENDING ADDRESS
          LA        A1,STOB,X9          YES.  LOAD BLOCK BUFFER ADDRESS
          LA        A0,IBMSAD,A1        LOAD ADDRESS OF THIS BLOCK
          ANU       A0,STMSAD,X9        COMPUTE CHANGE IN ADDRESS
          JZ        A1,ICONAD           DON'T SEND ADDRESS IF UNCHANGED
          ANU,U     A1,2                GET VALUT TO CHECK FIT IN BYTE
          TN        A1                  DID ADDRESS GO DOWN ?
          TG        A2,LTCMSK,X3        NO.  WILL (DELTA ADDRESS - 1) FIT ?
          J         ICOSFAD             NO.  SEND FULL ADDRESS
          SA        A1,A6               SAVE CHANGE IN IBMSAD
          OUTCHAR   ESC,7               SEND ESCAPE 7 SEQUENCE
          LA        A1,A6               LOAD CHANGE IN IBMSAD
          ANA,U     A1,1                DECREMENT CHANGE TO FIT MORE IN
          OUTCHAR   .                   SEND CHANGE IN ADDRESS
          J         ICONAD              GO SEND THE TEXT
.
ICOSFAD   OUTWORD   .                   SEND THE FULL ADDRESS WORD
          OUTCHAR   ESC,2               DELIMIT WITH ESCAPE 2 SEQUENCE
ICONAD    LA        A1,STOB,X9          LOAD BLOCK BUFFER ADDRESS
          LA        A0,IBMSAD,A1        LOAD ADDRESS / BLOCK NUMBER
          SA        A0,STMSAD,X9        UPDATE LAST BLOCK ADDRESS
.
.         OUTPUT TEXT OF BLOCK
.
          DSL       A6,72               CLEAR LAST WORD, SUPPRESS COUNT
          J         ICOTXE              ENTER TEXT PROCESSING LOOP
.
ICOTXS    LA        A0,,*X8             LOAD NEXT WORD OF TEXT
          TLE       A7,LTCMSK,X3        IS SUPPRESS COUNT A FULL BYTE ?
          TE        A0,A6               NO.  IS THIS WORD SAME AS LAST ?
          J         ICOTPW              NO.  OUTPUT THE WORD
          AA,U      A7,1                YES.  INCREMENT WORDS SUPPRESSED
          J         ICOTXE              GO PROCESS NEXT WORD
.
ICOTPW    LA        A6,A0               SAVE AS LAST WORD
          JZ        A7,ICONSP           SKIP IF NO PREVIOUS SUPPRESSED
          OUTCHAR   ESC,3               OUTPUT ESC 3 SEQUENCE
          LA        A1,A7               LOAD SUPPRESS COUNT
          OUTCHAR   .                   OUTPUT SUPPRESSED WORD COUNT
          LA,U      A7                  CLEAR WORDS SUPPRESSED COUNT
ICONSP    OUTWORD   A6                  OUTPUT THE TEXT WORD
ICOTXE    JGD       R4,ICOTXS           LOOP FOR ALL WORDS IN BLOCK
          JZ        A7,ICOENS           SUPPRESSION AT END OF BLOCK ?
          OUTCHAR   ESC,3               YES.  OUTPUT ESC 3 SEQUENCE
          LA        A1,A7               LOAD SUPPRESSION COUNT
          OUTCHAR   .                   OUTPUT SUPPRESSED WORD COUNT
ICOENS    OUTCHAR   ESC,5               OUTPUT THE END-OF-BLOCK SEQUENCE
ICONULB   LA        A0,STOB,X9          LOAD OUTPUT BUFFER ADDRESS
          LA        A1,IBLAST,A0        LOAD LAST BLOCK FLAG
          BRELP     A0                  RELEASE THE BLOCK BUFFER
          JZ        A1,ICOGET           GET NEXT BLOCK IF NOT LAST
.
.
.         END OF FILE PROCESSING
.
          OUTCHAR   ESC,6               OUTPUT THE END OF FILE SEQUENCE
ICOFILL   LA        A0,R5               LOAD CHARACTERS IN BUFFER
          TNE,U     A0,ICHTXTL-1        HAS BUFFER FLUSHED ?
          J         ICOBFULL            YES.  BUFFER IS FULL
          OUTCHAR   NUL                 NO.  FILL BUFFER WITH NUL'S
          J         ICOFILL             LOOP UNTIL BUFFER FLUSHES
.
ICOBFULL  LX        X8,STCDB,X9         LOAD COMMAND JUST COMPLETED
          FORK      COMPLETE            COMPLETE THE COMMAND
          TS        LTSCQ+QHEAD,X3      LOCK THE QUEUE HEAD
          LA        A0,QFL,X9           LOAD FORWARD LINK FROM SUBCHANNEL
          LA        A1,QHL,X9           LOAD BACK LINK
          SA        A0,QFL,A1           REMOVE SUBCHANNEL FROM LT
          SA        A1,QHL,A0           RESET LINKS
          CTS       LTSCQ+QHEAD,X3      UNLOCK THE QUEUE HEAD
          BRELP     X9                  RELEASE THE SUBCHANNEL
          J         NEXTRANS            PROCESS NEXT TRANSACTION
.                                       (WHICH WILL RELEASE EXTRA COMMUNICATIONS
.                                       BUFFER POINTED TO BY X7)
.
.
.         OUTPUT WORD
.
.         LA        A0,(<WORD>)
.         LMJ       X5,OUTWORD
.         <RETURN>
.
OUTWORD   LA        A3,LTBITPC,X3       LOAD BITS PER CHARACTER
          SZ        STOPTWF,X9          CLEAR WORD OPTIMISED FLAG
          LA,U      A4,36               LOAD BITS IN A WORD
          TN        A0                  IS SIGN BIT ON ?
          TG        A0,LTOPTMX,X3       NO.  IS VALUE SMALL ENOUGH TO OPTIMISE ?
          J         OUTWL               NO.  SEND WHOLE WORD
          JZ        A0,OUTWZO           IF ZERO, JUST SEND ESC 8
          SNONZ     STOPTWF,X9          MARK OPTIMISATION DONE
          LA,U      A1                  CLEAR LEFT-JUSTIFIED DATA ACCUMULATOR
          LX,U      X11                 CLEAR BITS SHIFTED COUNT
OUTWSH    DSL       A0,,A3              SHIFT OFF ONE BYTE
          AX        X11,A3              INCREMENT TOTAL SHIFT COUNT
          JNZ       A0,OUTWSH           CONTINUE IF DATA REMAINS
          LA        A0,A1               IF DONE, LOAD LEFT JUSTIFIED BYTES
          LA        A4,X11              LOAD BITS TO SEND FOR VALUE
OUTWL     LA,U      A1                  CLEAR TO SHIFT OFF NEXT CHARACTER
          LDSC      A0,,A3              SHIFT OFF NEXT CHARACTER
          ANA       A4,A3               COMPUTE BITS LEFT TO STORE
          TP        A4                  MORE THAN 36 BITS SHIFTED OUT ?
          LA,U      A4                  YES.  INDICATE ENTIRE WORD OUTPUT
          TE,U      A1,ESC              IS THIS AN ESCAPE CODE ?
          J         OUTNESC             NO.  OUTPUT IT AS IS
          OUTCHAR   ESC,4               YES.  OUTPUT ESC 4 SEQUENCE
          J         OUTWLE              LOOP FOR ALL BITS
.
OUTNESC   OUTCHAR   .                   OUTPUT THE CHARACTER
OUTWLE    JNZ       A4,OUTWL            CONTINUE IF MORE BITS TO OUTPUT
          TNZ       STOPTWF,X9          WERE ZERO BYTES OPTIMISED OUT ?
          J         0,X5                NO.  RETURN FOR NEXT WORD
OUTWZO    OUTCHAR   ESC,8               SEND SHORT WORD DELIMITER
          J         0,X5                RETURN TO CALLER
.
.
.         OUTPUT CHARACTER
.
.         LA,U      A1,<CHARACTER>
.         LMJ       X6,OUTCHAR
.         <RETURN>
.
OUTCHAR   EX        STORE               PUT CHARACTER IN BUFFER
          CRC       A1                  CALCULATE CRC FOR CHARACTER
          JGD       R5,,X6              RETURN IF BUFFER NOT FULL
.
.         SEND OUTPUT BUFFER AND AWAIT ACK
.
          SX        X8,STOBP,X9         SAVE OUTPUT BUFFER POINTER
          SA        A0,STOWA,X9         SAVE REMNANT OF PARTIAL WORD
          SA        A4,STBITLO,X9       SAVE BITS LEFT TO SEND
          SX        X5,STORTNP,X9       SAVE RETURN POINT FOR OUTWORD
          SX        X6,STOCRTNP,X9      SAVE RETURN POINT FOR OUTCHAR
          SR        R4,STOWLB,X9        SAVE WORDS LEFT IN BUFFER
          DS        A6,STOSUPP,X9       SAVE LAST WORD AND SUPPRESS COUNT
          LMJ       X11,OPCLOSE         EDIT FINAL INFORMATION IN BUFFER
          SZ        ITRELF,X7           FLAG NON-RELEASE ON CHANNEL RESUME
          LA        A0,LTTIME,X3        LOAD TIME QUANTUM FOR LINE TABLE
          SA        A0,STTIME,X9        START TIMER ON MESSAGE
          LA        A1,X7               LOAD BUFFER POINTER
          SX        X7,STRETRANS,X9     SET BUFFER FOR RETRANSMISSION
          INSERT    LTOQ,X3             OUTPUT BUFFER ON LINE TABLE
          V         LTOAQ,X3            MARK OUTPUT AVAILABLE
          J         ITC                 GO PROCESS NEXT TRANSACTION
.
.         CONTROL COMES HERE WHEN ACK IS RECEIVED FOR OUTPUT BUFFER
.
ICOACKR   LA        A0,LTBLW,X3         LOAD LENGTH FOR NEXT BUFFER
          BGET      .                   ALLOCATE NEXT COMMUNICATIONS BUFFER
          SA        A0,X7               SAVE BUFFER POINTER
          LMJ       X11,OPSETUP         SET UP OUTPUT BUFFER
          LA        A1,STOALT,X9        LOAD OUTPUT ALTERNATION BIT
          CRC       A1                  INCLUDE ALTERNATION IN CRC
          EX        STORE               STORE ALTERNATION IN BUFFER
          LA,U      A1,STX              LOAD START OF TEXT
          CRC       A1                  INCLUDE IN THE CRC
          EX        STORE               SET START OF TEXT IN BUFFER
          LA        A3,LTBITPC,X3       RESTORE BITS PER CHARACTER
          LX        X8,STOBP,X9         RECOVER OUTPUT BUFFER POINTER
          AX        X8,(1,0)            RESET INCREMENT IN POINTER
          LA        A0,STOWA,X9         LOAD OUTPUT WORD REMNANT
          LA        A4,STBITLO,X9       LOAD BITS LEFT TO OUTPUT
          LX        X5,STORTNP,X9       RELOAD RETURN FROM OUTWORD
          LX        X6,STOCRTNP,X9      RELOAD RETURN FROM OUTCHAR
          LR        R4,STOWLB,X9        LOAD WORDS LEFT IN BUFFER
          DL        A6,STOSUPP,X9       RELOAD SUPPRESSION WORDS
          LR,U      R5,ICHTXTL-1        RESET TEXT LENGTH FOR EMPTY BUFFER
          J         0,X6                RETURN TO CALL OF OUTCHAR
.
.
.         SET UP OUTPUT BUFFER
.
.         LX,U      X7,<TRANSACTION BUFFER>
.         LMJ       X11,OPSETUP
.
.         SETS UP CRC ACCUMULATORS, SYNC CHARACTERS, SOH AND
.         SUBCHANNEL NUMBER.
.
OPSETUP   DSL       CRC2,72             CLEAR CRC ACCUMULATORS
          SX        X3,ITLT,X7          SET LINE TABLE IN BUFFER
          SX        X9,ITST,X7          SET SUBCHANNEL IN TRANSACTION
          LX,U      X1,ITTEXT,X7        LOAD POINTER TO TEXT
          AX        X1,(1,0)            GET INCREMENT ON POINTER
          LX        X2,(1,0)            GET CHARACTER POINTER
          ON        EITHER
          TZ        LTQWM,X3            QUARTER WORD MODE LINE ?
          AX,U      X2,QWSTORE          YES.  ADVANCE TO Q.W. TABLE
          OFF       EITHER
          TNZ       LTSYNC,X3           IS THIS LINE SYNCHRONOUS ?
          J         OPSESOH             NO.  SKIP SYNC CHARACTERS
          LR,U      R1,ICHNSYN-1        LOAD LOOP COUNTER TO STORE SYNCS
          LA        A1,LTSYNC,X3        LOAD SYNC CHARACTER FOR LINE
OPSTSYN   EX        STORE               STORE SYNC CHARACTER
          JGD       R1,OPSTSYN          LOOP STORING SYNC CHARACTERS
OPSESOH   LA,U      A1,SOH              LOAD START OF HEADER
          CRC       A1                  START UP CRC WITH SOH
          EX        STORE               PUT SOH IN BUFFER
          LA        A1,STSCN,X9         LOAD SUBCHANNEL NUMBER
          CRC       A1                  INCLUDE IN CRC
          EX        STORE               AND PUT IN BUFFER
          J         0,X11               RETURN TO CALLER
.
.
.         CLOSE OUTPUT BUFFER
.
.         LX,U      X7,<OUTPUT TRANSACTION>
.         LMJ       X11,OPCLOSE
.         <RETURN>
.
.         EOT'S AND CRC STORED IN BUFFER
.
OPCLOSE   LA,U      A1,EOT              LOAD EOT
          CRC       A1                  ADD INTO THE CRC
          EX        STORE               STORE EOT AT END OF BUFFER
          LA        A0,CRC1             LOAD FIRST CRC CHARACTER
          LSSL      A0,8                SHIFT LEFT 8 BITS
          AA        A0,CRC2             COMPUTE 16 BIT CRC TOTAL
          LSSL      A0,36-16            LEFT JUSTIFY IN REGISTER
          LA        A3,LTBITPC,X3       LOAD BITS PER CHARACTER
          LA,U      A4,16               LOAD BITS TO BE OUTPUT
OPCCRC    LA,U      A1                  CLEAR NEXT BITS REGISTER
          LDSC      A0,,A3              SHIFT OFF NEXT BITS
          ANA       A4,A3               COMPUTE BITS LEFT TO BE OUTPUT
          EX        STORE               PUT CRC IN BUFFER
          TZ        A4                  ALL BITS OUTPUT ?
          JP        A4,OPCCRC           MORE BITS TO GO ?
          J         0,X11               NO.  RETURN
.
.
.         LOAD CHARACTER TABLE
.
FETCH     EQUF      $,*X2               REFERENCE TO PICK A CHARACTER
FET1      .
          ON        ICHALF              START HALF WORD CODE
          LA,H2     A0,,X1
          LA,H1     A0,,X1
          LA,H2     A0,1,X1
          LMJ       X10,$+1             TRAP EXECUTE INSTRUCTION
          LA,H1     A0,1,X1             LOAD LAST CHARACTER
          AX,U      X1,2                ADVANCE TO NEXT TWO WORDS
          LXM,U     X2                  RESET CHARACTER POINTER
          J         0,X10               RETURN AFTER EX
          OFF       ICHALF
.
QWFETCH   EQUF      $-FET1              OFFSET TO QUARTER-WORD TABLE
          ON        ICQUARTER           START QUARTER WORD CODE
          LA,Q1     A0,,X1
          LA,Q2     A0,,X1
          LA,Q3     A0,,X1
          LMJ       X10,$+1             TRAP EXECUTE REMOTE
          LA,Q4     A0,,*X1             PICK UP LAST CHARACTER
          LXM,U     X2,QWFETCH          RESET POINTER TO TABLE START
          J         0,X10               RETURN TO EX
          OFF       ICQUARTER           END QUARTER WORD CODE
.
.
.         STORE CHARACTER TABLE
.
STORE     EQUF      $,*X2               REFERENCE TO STORE A CHARACTER
STR1      .
          ON        ICHALF              START HALF WORD CODE
          SA,H2     A1,,X1
          SA,H1     A1,,X1
          SA,H2     A1,1,X1
          LMJ       X10,$+1             TRAP EXECUTE INSTRUCTION
          SA,H1     A1,1,X1             SET LAST CHARACTER IN BUFFER
          AX,U      X1,2                ADVANCE WORD POINTER
          LXM,U     X2                  CLEAR CHARACTER POINTER
          J         0,X10               RETURN AFTER EXECUTE
          OFF       ICHALF              END HALF WORD CODE
.
QWSTORE   EQUF      $-STR1              OFFSET FOR QUARTER-WORD STORE
          ON        ICQUARTER           START QUARTER-WORD CODE
          SA,Q1     A1,,X1
          SA,Q2     A1,,X1
          SA,Q3     A1,,X1
          LMJ       X10,$+1             TRAP EXECUTE
          SA,Q4     A1,,*X1             STORE LAST CHARACTER, ADVANCE POINTER
          LXM,U     X2,QWSTORE          RESET CHARACTER POINTER
          J         0,X10               RETURN TO EXECUTE
          OFF       ICQUARTER           END QUARTER-WORD CODE
/.
.
.         TIMER ACTIVITY
.
.         A TIMER ACTIVITY IS CREATED FOR EVERY LINE TABLE CURRENTLY
.         ACTIVE.  THE TIMER WAITS FOR A SPECIFIED TIME INTERVAL AND
.         SUBMITS A TIMEOUT TRANSACTION TO THE TRANSACTION PROCESSOR.
.         THE TRANSACTION PROCESSOR WILL THEN SCAN FOR MESSAGES WHICH
.         NEED TO BE RETRANSMITTED AND RESEND THEM.
.
ICTIMER   TZ        LTCLOSE,X3          IS LINE TABLE TERMINATING ?
          J         ICTCLS              YES.  FLAG TERMINATION AND EXIT
. **      TWAIT$    2000                NO.  WAIT FOR TWO SECONDS
          BGET      ITTEXT              ALLOCATE A TRANSACTION
          LA,U      A1,ITYTIME          LOAD TIMEOUT TRANSACTION TYPE
          SA        A1,ITTYPE,A0        SET TRANSACTION TYPE IN BUFFER
          SX        X3,ITLT,A0          PUT LINE TABLE IN TRANSACTION
          LA        A1,A0               LOAD TRANSACTION BUFFER ADDRESS
          INSERT    ICHWQ               PUT TRANSACTION ON QUEUE
          V         ICHWORK             INDICATE WORK AVAILABLE FOR TRANSACTION
 TWAIT$ 20 . ***
          J         ICTIMER             GO WAIT FOR THE NEXT TIME
.
.         SHUT DOWN TIMER WHEN LINE TABLE TERMINATES
.
ICTCLS    V         LTSCQ,X3            MARK TIMER TERMINATED
          EXIT      .                   TERMINATE
/.
.
.         LINE TABLE OUTPUT ACTIVITY
.
.         THIS ACTIVITY IS DRIVEN BY TRANSACTION BUFFERS SUBMITTED
.         ON THE LINE TABLE OUTPUT QUEUE, AND IS NOTIFIED OF THE
.         APPEARANCE OF BUFFERS BY THE LINE TABLE OUTPUT AVAILABLE
.         QUEUE.  THE ACTIVITY SIMPLY SENDS THE BUFFERS DOWN THE
.         LINE, AND IF THE RELEASE ON CHANNEL RESUME FLAG IS SET,
.         RELEASES THEM.
.
LTOACT    LA        A0,QL,X4            LOAD ACTIVITY NAME
          SA        A0,LTONAME,X3       SET OUTPUT ACTIVITY NAME IN LT
          V         LTOAQ,X3            MARK OUTPUT ACTIVITY READY
          ON        REALTHING
          RT$       34                  SWITCH TO OUTPUT ACTIVITY LEVEL
          OFF       REALTHING
.
LTONEXT   P         LTOAQ,X3            WAIT FOR A BUFFER TO OUTPUT
          REMOVE    LTOQ,X3             REMOVE A BUFFER FROM THE QUEUE
          TNE,U     A1,LTOQ,X3          IS THIS A TERMINATION REQUEST ?
          J         LTOTERM             YES.  GO TERMINATE
          LA,U      A0,ITTEXT,A1        LOAD OUTPUT TEXT START ADDRESS
          SA        A0,LTOBUF,X3        SET AS OUTPUT BUFFER IN LT
          ON        REALTHING
          CMO$      LTFN,X3             OUTPUT THE BUFFER ON LINE
          DACT$     .                   WAIT FOR OUTPUT COMPLETION
          OFF       REALTHING
          ON        (REALTHING=0)++DUMPING
          LA        A0,LTOBUF,X3        LOAD BUFFER ADDRESS
          SA,H2     A0,SPK+1            SET WORD COUNT IN PACKET
          LA        A0,LTOCOUNT,X3      LOAD OUTPUT CHARACTER COUNT
          AA,U      A0,3                ROUND IT UP *QW*
          SSL       A0,2                DIVIDE BY FOUR *QW*
          SA,H1     A0,SPK+1            SET IN PACKET
          LA        A0,PARTBL           LOAD FANG OPTIONS
          TOP,U     A0,OPTION('W')      ARE SNAPS DESIRED ?
          J         LTOSNP              NO.  SKIP THE SNAP
          SNAP$P    SPK                 SNAP THE OUTPUT BUFFER
LTOSNP    TZ        ITRELF,A1           IS OUTPUT TEXT ?
          J         ITOBUNGA            NO.  SKIP WRITE TO FILE
          LA        A0,SPK+1            LOAD ACCESS WORD FOR DATA
          SA        A0,WWIOP+4          SET IN I/O PACKET
          IOW$      WWIOP               WRITE DATA TO TRACE FILE
          LA        A0,WWIOP+5          LOAD ADDRESS IN FILE
          AA,U      A0,1                INCREMENT NEXT WRITE ADDRESS
          SA        A0,WWIOP+5          UPDATE ADDRESS IN FILE
          V         WWRD                MARK BLOCK AVAILABLE FOR INPUT
ITOBUNGA  .
$(2).
WWIOP     IO$PKT,W$ 'COMM-FILE' $-$,$-$ $-$
RRIOP     IO$PKT,R$ 'COMM-FILE' $-$,$-$ $-$
WWRD      PVQUEUE   0
WACK      PVQUEUE   0                   ACK WAIT QUEUE
SPK       SNAP$PKT  ,,'OUTPUT'
$(1)      OFF       (REALTHING=0)++DUMPING
.         ** CHECK STATUS **
          LA        A0,A1               LOAD BUFFER ADDRESS
          TZ        ITRELF,A1           SHOULD BUFFER BE RELEASED ?
          BRELP     A0                  YES.  RELEASE IT
          J         LTONEXT             PROCESS NEXT OUTPUT MESSAGE
.
LTOTERM   V         LTSCQ,X3            MARK OUTPUT TERMINATED
          EXIT      .                   TERMINATE
.
.
.         ESI OUTPUT COMPLETION ACTIVITY
.
OUTINT    ACT$      LTONAME,A0          ACTIVATE THE OUTPUT ACTIVITY
/.
.
.         LINE TABLE INPUT ACTIVITY
.
.         THE INPUT ACTIVITY RECEIVES CONTROL BY BEING ACTIVATED
.         BY THE ESI INPUT COMPLETION ACTIVITY WHENEVER A BUFFER
.         IS FILLED.  THE INPUT ACTIVITY HANDS THE COMPLETED
.         BUFFER OFF TO THE TRANSACTION PROCESSOR, THEN RAISES
.         INPUT IMMEDIATELY ON THE LINE AGAIN.
.
LTIACT    LA        A0,QL,X4            LOAD ACTIVITY NAME FOR ACT$
          SA        A0,LTINAME,X3       SET INPUT ACTIVITY NAME IN LT
          ON        REALTHING
          RT$       33                  ADJUST REAL TIME LEVEL FOR INPUT
          OFF       REALTHING
          LA,U      A0,LTFN,X3          LOAD LINE TABLE ADDRESS
          ON        REALTHING
 er       CMS$      .                   INITIALISE LINE TABLE
          OFF       REALTHING
          V         LTOAQ,X3            MARK INPUT ACTIVITY READY
          J         LTISTART            INITIALISE FOR FIRST BUFFER
.
LTINEXT   .
          ON        REALTHING=0
          LA,S1     A0,LTFN,X3          LOAD FIRST CHARACTER OF FILE NAME
          TE,U      A0,'I'              INPUT FILE NAME
          DACT$     .                   NO.  WAIT FOR A WHILE
          OFF       REALTHING=0
          ON        REALTHING
          DACT$     .                   WAIT FOR INPUT COMPLETION
          OFF       REALTHING
          ON        REALTHING=0
          P         WWRD                WAIT FOR OUTPUT TO BE DONE
          LA        A0,LTIBUF,X3        LOAD INPUT BUFFER ADDRESS
          LXI,H1    A0,WWIOP+4          GET LENGTH TO READ
          SA        A0,RRIOP+4          SET READ ACCESS WORD IN PACKET
          IOW$      RRIOP               READ IN NEXT INPUT BLOCK
          LA        A0,RRIOP+5          LOAD ADDRESS
          AA,U      A0,1                ADVANCE TO NEXT SECTOR
          SA        A0,RRIOP+5          UPDATE NEXT READ ADDRESS
          OFF       REALTHING=0
          TZ        LTCLOSE,X3          IS LINE TERMINATING ?
          J         LTITERM             YES.  GO TERMINATE INPUT
.         ** CHECK LINE TABLE STATUS **
          INSERT    ICHWQ               PLACE BUFFER ON TRANSACTION QUEUE
          V         ICHWORK             MARK WORK AVAILABLE FOR TRANSACTION
.
LTISTART  LA        A0,LTBLW,X3         LOAD LENGTH OF INPUT BUFFER
          BGET      .                   ALLOCATE A NEW INPUT BUFFER
          AA,U      A0,ITTEXT           COMPUTE TEXT START ADDRESS
          SA        A0,LTIBUF,X3        SET INPUT BUFFER ADDRESS
          ON        REALTHING
          CMI$      LTFN,X3             FIRE UP INPUT IMMEDIATELY
          OFF       REALTHING
          LA        A1,LTIBUF,X3        LOAD BUFFER ADDRESS
          ANA,U     A1,ITTEXT           BACK UP TO HEADER
          LA,U      A2,ITYIN            LOAD INPUT BUFFER TYPE
          SA        A2,ITTYPE,A1        SET TYPE IN BUFFER
          SX        X3,ITLT,A1          SET LINE TABLE IN BUFFER
          J         LTINEXT             WAIT FOR INPUT COMPLETION
.
LTITERM   BRELP     A1                  RELEASE THE INPUT BUFFER
          V         LTSCQ,X3            MARK INPUT TERMINATED
          EXIT      .                   TERMINATE
.
.         INPUT ESI COMPLETION ACTIVITY
.
ININT     ACT$      LTINAME,A0          ACTIVATE INPUT ACTIVITY FOR LT
/.
.
.         THIS SEQUENCE OF CODING GENERATES A 256 WORD POLYNOMIAL DIVISION
.         REMAINDER TABLE.  THIS TABLE IS USED TO COMPUTE THE CRC OF MESSAGES
.         TRANSMITTED AND RECEIVED.  TO REDUCE CHARACTER PROCESSING OVERHEAD,
.         THE 16 BIT REMAINDER IS STORED WITH THE HIGH-ORDER 8 BITS RIGHT
.         JUSTIFIED IN H1, AND THE LOW-ORDER 8 BITS RIGHT JUSTIFIED IN H2.
.
.         FUNCTION TO REVERSE BITS IN 8 OR 16 BIT BYTE
.
F         FUNC      .
REVERSE8* NAME      7
REVERSE16* NAME     15
I         DO        F(0)+1 ,;
A(0)      EQU       A(0)++(1*/(F(0)-I+1))*(((1*/(I-1))**F(1))>0)
          END       A(0)
.
.         PERFORM POLYNOMIAL DIVISION
.
DIVIDE*   FUNC      .
DIVIDEND(0) EQU     DIVIDE(1)*/16       EXPAND TO 24 BITS
DIVISOR(0) EQU      0300005*/7          BITS SET FOR COEFFICIENTS
DP*       PROC      *0
A         EQU       24-I                BIT BEING PROCESSED ON THIS INVOKATION
          DO        (DIVIDEND(0)**(1*/A))>0 ,;
DIVIDEND*(0) EQU    DIVIDEND(0)--DIVISOR(0)
DIVISOR*(0) EQU     DIVISOR(0)/2
          END
I         DO        8 , DP
          END       DIVIDEND(0)
.
.         GENERATE THE TABLE ENTRIES
.
REMAINDER* PROC     0,1
Z         EQU       REVERSE16(DIVIDE(REVERSE8(I-1)))
          *         Z/(1*/8),Z**0377
          END
.
          ON        .                   *** REDUCE ASSEMBLY TIME ***
REMAINDER .
I         DO        256 , REMAINDER
          OFF       .                   ** REDUCE ASSEMBLY TIME **
          OFF       INTERSITE
/.
.
.         INTERCEPT ROUTINES FOR INTERCHANGE DECONFIGURED
.
          ON        INTERSITE=0
.
CONNECT*  .                             TRAP 'CONNECT' COMMAND
DISCT*    .                             TRAP 'DISCONNECT' COMMAND
ICHG*     .                             TRAP 'INTERCHANGE' COMMAND
MESAIS*   .                             TRAP 'MESSAGE' COMMAND
.
          R$DIT     .                   FIRE UP THE EDITOR
          E$MSG     ISNCOM              COPY NOT CONFIGURED MESSAGE
          LMJ       X11,IST             EDIT STATEMENT NUMBER
          COMPLETE  .                   TERMINATE
.
ISNCOM    'INTER-SITE INTERCHANGE NOT CONFIGURED.  IGNORED COMMAND !'
          OFF       INTERSITE=0
          END