          EJECT
*         CTEXT  CTP$DFT SEND PACKET FOR NON S0.
*
*         COPYRIGHT CONTROL DATA SYSTEMS INC. 1992
*
*         THIS DECK CONTAINS CODE FOR SENDING A PACKET ON NON-S0
*         MAINFRAMES.
 PKT      SPACE  4,15
**        PKT - PROCESS CONSOLE PACKETS VIA *2AP*.
*
*         ENTRY  (RTP1) = 4/0, 2/C, 1/S, 1/0, 8/CODE.
*                (RTP2) = 16/L.
*                C = OFFSET TO PACKET CONTROL WORD IF TIMING DESIRED.
*                S = 1, IF SEQUENCE NUMBER IS IN UPPER 8 BITS.
*                CODE = PACKET FUNCTION CODE (SEE *CTI$PACKET_DEFINITIONS*).
*                L = PACKET LENGTH IN 8-BIT BYTES.
*
*         EXIT   (CALB+1) = 0, IF NO ERROR.
*
*         USES   T1, T2, T3.
*
*         CALLS  CER, ICP, SCF.


          ROUTINE  PKT

*         STORE PARAMETERS IN *2AP* CALL BLOCK.

          LDM    RTP1        CALL PARAMETERS
          LPC    0#FF
          STM    CALB+1      SAVE PACKET FUNCTION CODE
          LDC    140         REQUEST = SEND PACKET
          STM    CALB+0
          LDML   TINB        SET BUFFER ADDRESS (*TOIP*)
          STML   CALB+2
          LDM    RTP2        SET PACKET LENGTH
          STM    CALB+3
          ADN    1           ROUND UP TO NEAREST MULTIPLE OF TWO
          SHN    -1
          STD    T2

*         SET PACKET SEQUENCE NUMBER.

          AOML   PKSEQ       INCREMENT PACKET SEQUENCE NUMBER
          LPC    0#FF
          STDL   T1
          LDD    T2          PACKET LENGTH IN PP WORDS
          SBN    1
          ADML   TINB
          STDL   T2
          LDML   RTP1
          SHN    21-11
          PJN    PKT1        IF SEQUENCE NUMBER IS TO BE IN LOWER PART
          LDDL   T1
          SHN    10
          STDL   T1
          LDIL   T2
          LPC    0#FF
          UJN    PKT2

 PKT1     LDIL   T2
          LPC    0#FF00
 PKT2     LMDL   T1          SET SEQUENCE NUMBER
          STIL   T2

*         ISSUE A CLEAR PACKETS REQUEST TO THE TWO PORT MUX.
*         THIS IS DONE IN CASE A RESPONSE PACKET IS PRESENT
*         IN THE TWO PORT MUX FROM A PREVIOUS TIMED OUT PACKET
*         REQUEST.  IF THIS WAS NOT DONE, THEN AN EXISTING
*         RESPONSE PACKET WOULD PREVENT THE RECEIPT OF THE
*         RESPONSE PACKET FOR THE NEW REQUEST.  THE NEW RESPONSE
*         PACKET WOULD BE DISCARDED IF THE TWO PORT MUX
*         ALREADY CONTAINED A RESPONSE PACKET.

          RJM    ICP         ISSUE CLEAR PACKETS REQUEST

*         SEND PACKET TO CONSOLE VIA *2AP* AND CHECK FOR ERRORS.

          LDN    MX          GET CHANNEL 15 INTERLOCK
          RJM    SCF
          FNC    MXPT,MX     SELECT PORT
          AJM    *,MX
          CALL   PFC         CALL *2AP*
          FNC    MXDM,MX     DESELECT MUX
          AJM    *,MX
          CCF    *,MX        RELEASE CHANNEL 15 INTERLOCK
          LDM    RTP1        SET PACKET TIMING DESIRED
          LPC    0#C00
          SHN    2
          STML   PKTIM
          LDML   CALB+1
          ZJN    PKT3        IF NO ERROR
          LDN    0           CLEAR PACKET TIMING CONTROL
          STML   PKTIM
 PKT3     LJM    PKTX        RETURN

*         END    CTP$DFT SEND PACKET FOR NON S0
