*DECK SUBSTR
          IDENT  SUBSTR 
          TITLE  SUBSTR - RIGHT TO LEFT STRING MOVE 
**        SUBSTR - RIGHT TO LEFT STRING MOVE
* 
*         CALLING SEQUENCE
*                SUBSTR(SADDR,SOFFS,DADDR,DOFFS,LEN); 
*         INPUT 
*                SADDR - SOURCE ADDRESS 
*                DADDR - DESTINATION ADDRESS
*                SOFFS - SOURCE OFFSET
*                DOFFS - DESTINATION OFFSET 
*                LEN - NUMBER-OF CHARACTERS TO MOVE 
* 
*         DOES - MOVES LEN CHARACTERS FROM SOURCE TO DESTINATION. 
*                MOVE IS DONE RIGHT TO LEFT TO ALLOW FOR RIGHT SHIFTS.
* 
          ENTRY  SUBSTR 
 SUBSTR   DATA   0
          SB1    1
          SB2    X1          SOURCE ADDR
          SA1    A1+B1
          SA2    X1          SOURCE OFFS
          SA1    A1+B1
          SB3    X1          DEST ADDR
          SA1    A1+B1
          SA3    X1          DEST OFFS
          SA1    A1+B1
          SA1    X1 
          SB4    X1          LENGTH 
          SB5    10 
          LE     B4,B5,SUBST10   LENGTH LQ 10 
          SX7    314632B     (1/10)*2**20 
          SX6    X2+B4
          IX4    X7*X6
          AX4    20 
          SB2    B2+X4       LWA SOURCE 
          IX5    X4+X4
          LX4    3
          IX5    X5+X4
          IX4    X6-X5       ECP SOURCE 
          SX0    X3+B4
          IX6    X7*X0
          AX6    20 
          SB3    B3+X6       LWA DEST 
          IX5    X6+X6
          LX6    3
          IX7    X5+X6
          IX5    X0-X7       ECP DEST 
          IX0    X5-X4       ECP DEST - ECP SOURCE
          NZ     X0,SUBST3   NOT SAME ALIGNMENT 
          NZ     X5,SUBST0   ECP NOT ZERO 
          SB2    B2-B1
          SB3    B3-B1
          SX5    B5 
 SUBST0   SA1    B2          LAST WORD SOURCE 
          SA4    B3          LAST WORD DEST 
          SA2    =XC.MASK+X5
          BX6    X2*X1
          BX7    -X2*X4 
          BX6    X6+X7
          SA6    B3 
          SB6    X5 
          SB4    B4-B6       DECREMENT LENGTH 
          LT     B4,B5,SUBST2 
 SUBST1   SA1    A1-B1
          BX6    X1 
          SA6    A6-B1
          SB4    B4-B5
          GE     B4,B5,SUBST1 
          ZR     B4,SUBSTR   DONE 
 SUBST2   SA1    A1-B1       MOVE FIRST WORD
          SA2    A6-B1
          SB6    B5-B4
          SA3    =XC.MASK+B6
          BX6    -X3*X1 
          BX7    X3*X2
          BX6    X6+X7
          SA6    A2 
          EQ     SUBSTR 
          SPACE  3
* 
*    LONG MOVE, UNEQUAL ALIGNMENT 
* 
 SUBST3   NZ     X4,SUBST4   NON-ZERO ECP SOURCE
          SB2    B2-B1
          SX4    B5 
 SUBST4   NZ     X5,SUBST5   NON-ZERO ECP DEST
          SB3    B3-B1
         SX5    B5
 SUBST5   IX0    X4-X5
          NG     X0,SUBST8   ECP SOURCE LS ECP DEST 
          SA1    B2          LAST WORD SOURCE 
          SA2    B3          LAST WORD DEST 
          BX6    X0 
          LX6    1
          IX7    X6+X0
          LX7    1           6*(ECP SOURCE - ECP DEST)
          SB6    X7 
          LX1    B6,X1
          SA3    =XC.MASK+X5
          BX6    X3*X1
          BX7    -X3*X2 
          BX6    X6+X7
          SA6    B3 
          SB7    X5 
          SB4    B4-B7       DECREMENT LENGTH 
          LT     B4,B5,SUBST7  LESS THAN ONE WORD LEFT
          SA3    =XC.MASK+X0
          LX3    X3,B6
 SUBST6   BX6    X1 
          SA1    A1-B1
          BX6    X3*X6
          LX1    B6,X1
          BX7    -X3*X1 
          BX6    X6+X7
          SA6    A6-B1
          SB4    B4-B5
          GE     B4,B5,SUBST6 
          EQ     B4,B0,SUBSTR  DONE 
 SUBST7   SB7    X0          NUMBER OF CHARS LEFT IN X1 
          LE     B4,B7,SUBST7A
          SA1    A1-B1
          LX1    B6,X1
          BX6    X3*X6
          BX7    -X3*X1 
          BX1    X6+X7
 SUBST7A  SB4    B5-B4
          SA4    =XC.MASK+B4
          SA2    A6-B1
          BX7    X4*X2
          BX6    -X4*X1 
          BX7    X6+X7
          SA7    A2 
          EQ     SUBSTR 
          SPACE  3
* 
*      LONG MOVE, ECP SOURCE LS ECP DEST
* 
 SUBST8   BX0    -X0
          SA1    B2          LAST WORD SOURCE 
          SA2    B3          LAST WORD DESTINATION
          BX6    X0 
          LX6    1
          IX7    X6+X0
          LX7    1           6*(ECP DEST - ECP SOURCE)
          SB6    60 
          SB7    X7 
          SB6    B6-B7       60 - 6*( ECPD - ECPS)
          SA3    =XC.MASK+X4
          BX7    X3*X1
          LX7    B6,X7
          SA1    A1-B1
          LX1    B6,X1
          SA3    =XC.MASK+X0
          BX6    X3*X1
          BX7    X6+X7
          SA4    =XC.MASK+X5
          BX6    -X4*X2 
          BX6    X6+X7
          SA6    B3 
          SB7    X5 
          SB4    B4-B7
          LT     B4,B5,SUBST9A  LESS THAN ONE WORD LEFT 
 SUBST9   BX6    X1 
          SA1    A1-B1
          LX1    B6,X1
          BX7    X3*X1
          BX6    -X3*X6 
          BX6    X6+X7
          SA6    A6-B1
          SB4    B4-B5
          GE     B4,B5,SUBST9 
          ZR     B4,SUBSTR   DONE 
 SUBST9A  SB7    X0 
          SB7    B5-B7       NUMBER OF CHARS LEFT IN X1 
          LE     B4,B7,SUBST9B
          BX6    X1 
          SA1    A1-B1
          LX1    B6,X1
          BX7    X3*X1
          BX6    -X3*X6 
          BX1    X6+X7
 SUBST9B  SB6    B5-B4       FINISH FIRST WORD
          SA3    =XC.MASK+B6
          SA2    A6-B1
          BX6    X3*X2
          BX7    -X3*X1 
          BX6    X6+X7
          SA6    A2 
          EQ     SUBSTR 
          SPACE  3
* 
*      SHORT MOVE 
* 
 SUBST10  SX0    314632B     (1/10)*2**20 
          IX4    X0*X2
          AX4    20 
          SB2    B2+X4       UPDATE SOURCE ADDR 
          IX5    X4+X4
          LX4    3
          IX5    X4+X5
          IX2    X2-X5       BCP SOURCE 
          IX4    X0*X3
          AX4    20 
          SB3    B3+X4       UPDATE DEST ADDR 
          IX5    X4+X4
          LX4    3
          IX5    X4+X5
          IX3    X3-X5       BCP DEST 
          SB7    X3+B4       ECP DEST 
          IX0    X2+X2
          IX0    X0+X2
          LX0    1
          SB6    X0          6*BCP SOURCE 
          SA4    B2 
          LX4    B6,X4
          SB6    X2+B4       ECP SOURCE 
          GT     B6,B5,SUBST11     SOURCE CROSSES WORD BOUNDARY 
          SA5    =XC.MASK+B4
          BX6    X4*X5       SOURCE ZERO FILLED, JUST LEFT
          EQ     SUBST12
          SPACE  3
 SUBST11  BX2    -X2
          SB6    X2+B5       10 - BCP 
          SA5    =XC.MASK+B6
          BX6    X5*X4       UPPER HALF SOURCE
          SA5    B2+B1       SECOND WORD SOURCE 
          SB6    B4-B6       ECP
          SA4    =XC.MASK+B6
          BX5    X4*X5
          BX4    -X2
          BX7    X4 
          LX7    1
          IX4    X4+X7
          LX4    1
          SB6    X4 
          LX5    B6,X5
          BX6    X6+X5       SOURCE ZERO FILLED, JUST LEFT
 SUBST12  BX7    -X3
          SX4    X7+B5
          BX7    X4 
          LX7    1
          IX4    X4+X7
          LX4    1
          SB6    X4 
          LX6    B6,X6       ALIGN SOURCE 
          SA5    B3          DESTINATION
          GT     B7,B5,SUBST13     DEST CROSSES WORD BOUNDARY 
          SA4    =XC.MASK+B4
          LX4    B6,X4       ALIGN MASK 
          BX7    -X4*X5 
          BX6    X6+X7
          SA6    A5 
          EQ     SUBSTR 
          SPACE  3
 SUBST13  SA4    =XC.MASK+X3
          BX7    X4*X5
          BX0    -X4*X6 
          BX7    X0+X7
          SA7    A5 
          SA5    B3+B1       SECOND WORD DESTINATION
          SB7    B7-B5       ECP
          SA4    =XC.MASK+B7
          BX6    X4*X6
          BX7    -X4*X5 
          BX6    X6+X7
          SA6    A5 
          EQ     SUBSTR 
          END 
