*DECK XPACK 
          IDENT  XPACK
          ENTRY  XPACK
 XPACK    TITLE  XPACK -- MOVES 12-BIT CHRS TO 8-BIT CHR FIELD
* 
**
* 
*   CALLING PARAMETERS--
*               STRING-P -- ADDRESS OF PACKED RESULT (8-BIT CHRS
*                                7 CHRS PER WORD, RT JUST)
*                STRING-U  -- ADDRESS OF UNPACKED INPUT (12 BIT CHRS, 
*                                5 CHRS PER WORD) 
*                LENGTH    -- NUMBER OF CHRS TO MOVE, OPTIONAL FOR
*                              COBOL, IF SPECIFIED, EXACTLY THE NUMBER
*                              OF CHRS STATED SHALL BE PACKED + MOVED.
*                              IF NOT, THE SMALLER NUM OF CHRS IN 
*                              STRING-U OR P SHALL BE MOVED WITH
*                              ZERO (NULL) FILL IN THE REMAINDER OF THE 
*                              PACKED FIELD (IF ANY). ALSO, UNUSED
*                              CHR POSITIONS IN THE LAST PARTIAL WORD 
*                            OF THE PACKED FIELD SHALL BE FILLED WITH 
*                              NULL CHRS. 
*                POSITION-U  -- OFFSET IN CHRS OF UNPACKED FIELD
*                            NUMBERED 1 FROM LEFT (DEFAULT = 1 OR 
*                            ACTUAL BCP IF COBOL).
**    FUNCTION
*         XPACK-MOVES 12 BIT CHRS FROM THE STRING-U FIELD TO THE
*                STRING-P FIELD, TRUNCATING THE UPPER 4 BITS IN THE 
*                CHR, PACKING 7 CHRS PER WORD OMITTING BITS 56-59 
* 
* **********************************************************************
**    METHODS 
*         1.
*          TDCRACK IS CALLED TO CRACK THE PARAMETER LIST, FILLING THE 
*          NEEDED ITEMS IN THE COMMON BLOCK T8.COM1.
* 
*         2.
*          CHARACTERS ARE RETRIEVED FROM THE UNPACKED SOURCE FIELD
*          ONE AT A TIME VIA NXBITS. THE UPPER 4 BITS ARE IGNORED.
*          THE REMAINING 8 BITS ARE SAVED IN X5 UNTIL 7 CHRS (56 BITS)
*          HAVE BEEN SAVED.  THEN X5 IS STORED INTO THE NEXT FREE 
*          PACK FIELD WORD. 
* 
*         3.
*          NXBITS RETURNS X2 AS ZERO WHEN NO MORE CHRS ARE LEFT. THEN 
*          IF NOTHING HAS YET BEEN PLACED IN X5 CONTROL PASSES TO STEP
*         4.  OTHERWISE, ALIGN X5 (LEFT JUSTIFY CHRS CONTAINED WITHIN), 
*          AND STORE IT IN THE NEXT FREE WORD OF THE PACK FIELD.
* 
*         5. IF NULL FILL IS REQUIRED IN THE PACKED RECEIVING FIELD,
*          DO IT. 
* 
  
* **********************************************************************
* 
* 
*CALL COM1
 TC.PACK  VFD    42/5HXPACK,18/XPACK   TRACEBACK WORD 
 XPACK1   SA1    T.SAVEA0 
          SX6    B0 
          SX7    B0 
          SA0    X1 
 XPACK    DATA   0           ENTRY
          SB1    1
          SX6    A0 
          SX7    TC.PACK
          SB2    B0 
          SA6    T.SAVEA0 
          SB6    BACK1       RETURN ADDRESS FOR TDCRACK 
          EQ     TDCRACK
 BACK1    BSS    0
          SA1    T.SRC1      STRING-U DESCRIPTOR (SOURCE FIELD) 
*                            FOR NXBITS 
          SX2    12                CHR SZ FOR NXBITE
 LOOP2    SB5    7           STORE 7 CHRS PER SINK WORD--MUST BE
*                            WORD ALIGNED 
          SX5    B0          INITIALIZE ACCUMULATIVE REGISTER 
 LOOP1    BSS    0
          SB6    BACK2       NXBITS RETURN
          EQ     NXBITS      GET NEXT 12 BITS FROM UNPACKED FIELD 
 BACK2    ZR     X2,LASTWRD        BR IF NO MORE SOURCE BITS
          MX0    60-8 
          LX5    8           MAKE HOLE FOR NEXT CHR 
          BX6    -X0*X6      LOSE 4 HIGH ORDER BITS 
          BX5    X5+X6       INSERT 8 OF THOSE 12 BITS IN X5
          SB5    B5-B1       B5=NUM OF UNUSED CHRS LEFT IN X5 (PACKED 
*                            WORD)
          NE     B5,B0,LOOP1 BR IF STILL ROOM FOR MORE CHRS IN
*                            PACKED WORD (X5) 
*  X5 NOW FULL -- STORE IT AND UPDATE T.SRC1
          SA3    T.SRC2            STRING-P DESCRIPTOR
          SX6    X3+B1             PACKED FIELD PTR UPDATED 
          BX7    X5                PACKED WORD JUST FROMED--FULL
          SA6    A3                T.SRC2 
          SA7    X3                STORE NEW PACKED WORD
          EQ     LOOP2       GO FORM NEXT PACKED WORD 
 LASTWRD  SB4    7
          SA1    T.EXL2      NUMBER OF BITS IN STRING-P REQUIRING 
*                            NULL FILL (EXCLUDES BITS 56-59)
          NZ     X1,MORESNK  BR IF NULL FILL REQUIRED 
          EQ     B4,B5,XPACK1 LEAVE IF NO CHRS HAVE YET BEEN
*                            PUT IN X5
 LW2      SX3    B5          NUM UNUSED CHRS LEFT IN X5 
          LX3    3           TIMES 8
          SA2    T.SRC2      STRING-P DESCRIPTOR
          SB2    X3          SHIFT CNT
          LX7    B2,X5       ALIGN PACKED CHRS IN X5
          SA7    X2          STORE PACKED WORD
          EQ     XPACK1 
*  SECTION TO DO NULL FILL
 MORESNK  EQ     B5,B0,STWRD BR IF X5 CURRENTLY FULL
          LX5    8           MAKE ROOM FOR NEXT CHR 
          SB5    B5-B1       DECREMENT NUM OF UNUSED CHRS 
          SX1    X1-8        DECREMENT NUM OF BITS REQUIRING NULL FILL
          NZ     X1,MORESNK  BR IF X5 STRING-P NOT YET EXHAUSTED
          EQ     LW2         BR IF LAST WORD IN STRING-P
 STWRD    SA3    T.SRC2      STRING-P DESCRIPTOR
          BX7    X5 
          SA7    X3          STORE NEXT STRING-P WORD 
          SX7    B0 
 MS2      SX1    X1-56       DECREMENT NULL FILL CNTR BY 1 WORD 
          SA7    A7+B1       ZERO PREVIOUS WRD
          SX2    X1-1 
          PL     X1,MS2      BR IF MORE ZERO FILL STILL NEEDED
          EQ     XPACK1 
          END 
