*DECK,XMOVE 
          IDENT  XMOVE
          TITLE  XMOVE - 8-BIT MOVE ROUTINE 
* 
*** 
*     FUNCTION
* 
*         ROUTINE XMOVE WILL MOVE CHARACTERS FROM ONE FIELD (FIELD A) 
*         TO ANOTHER (FIELD B), AS SPECIFIED BY THE CALL, THE LENGTH OF 
*         THE MOVE IS EITHER AS SPECIFIED, OR IF NOT SPECIFIED (IN
*         COBOL ONLY) WILL BE OF THE SIZE OF THE SMALLER OF THE TWO 
*         FIELDS.   THE OFFSET OF EACH FIELD IS SPECIFIED BY THE CALL.
*         CONVERSION WILL BE PERFORMED ON THE FIELDS AS SPECIFIED.
*         XMOVE CALLS THE ROUTINE T.CRACK TO CRACK THE PARAMETERS - 
*         MORE DETAILED INFORMATION ON RETURN FROM THAT ROUTINE IS
*         DOCUMENTED IN IT.  NXBITS IS A ROUTINE USED TO FETCH THE
*         NUMBER OF CHARACTERS SPECIFIED IN X2 FROM THE FIELD SPECIFIED 
*         BY X1, THE RETURN BEING RIGHT JUSTIFIED IN X6, MAXIMUM OF 
*         60 BITS.
*         XMOVE SAVES A0, AND DESTROYS ALL OTHER REGISTERS
          SPACE  3
**
*     CALLING SEQUENCE
* 
*         THE CALLING PARAMETERS ARE AS FOLLOWS - 
*         CALL
*         OR
*         ENTER      XMOVE
*         CONVERSION,FIELD A, FIELD B, LENGTH, OFFSET A, OFFSETB
*         DEFAULT OFFSET IS 1.
*         CONVERSION IS IN FORM 2HAB, WHERE A IS MODE OF FIELD A, AND 
*         B IS THE MODE OF FIELD B.   FOR EXAMPLE, XX IS NO CONVERSION, 
*         DISPLAY CODE MOVE.  XA IS CONVERSION FROM DISPLAY CODE TO 
*         ASCII.
          SPACE  1
* 
* 
*CALL COM1
          SPACE  4
* 
 TC.XMOVE VFD    42/5HXMOVE,18/XMOVE  TRACEBACK WORD
 XMOVE1   SA1    T.SAVEA0 
          SX6    B0 
          SX7    B0 
          SA0    X1 
* 
 XMOVE    JP     400000B+*   ENTRY
          SX6    A0 
          SB2    1
          SX7    TC.XMOVE 
          SA6    T.SAVEA0 
          SB6    RETUR1 
          EQ     TDCRACK
* 
 RETUR1   BSS    0
          SA1    T.SRC1           INFORMATION FOR FIELD A 
          SA2    T.XY             CONVERSION TYPE 
          SB3    T.CNVT           CONVERSION TABLE
          SA5    X1          A5,X5 - POINTER TO AND FIRST WORD OF 
*                                 FIELD A.
          AX1    18 
          SA3    T.S1             SIZE OF CHARACTER, FIELD A. 
          SB2    X1          B2 - BCP OF FIELD A IN BITS
          AX1    18 
          SB5    X3          B5 - CHARACTER SIZE, FIELD A.
          SA0    X1          A0 - BIT SIZE OF MOVE FROM FIELD A 
          SB4    B5-1             SHIFT COUNT FOR MASK
          MX0    1
          ZR     X1,FINUPA        IF NO CHARACTERS TO MOVE, BRANCH
          SA1    X2+B3            CONVERSION TABLE INFORMATION
          AX3    B4,X0            MASK FOR CHARACTER SIZE OF A
          SB7    X2-3        SEE IF ANY CONVERSION IS REQUIRED
          SA2    T.SRC2           FIELD B INFORMATION 
          SB3    X1          B3 - CONVERSION TABLE POINTER
          SA4    X2          A4,X4 - POINTER TO AND FIRST WORD OF 
*                                 FIELD B.
          LX3    B5          X3 - MASK FOR CHARACTER SIZE OF A, RIGHT 
*                                 JUSTIFIED.
          AX2    18 
          SX6    B5-12
          NZ     X6,NOT12         IF SOURCE CHAR SIZE " 12
          SX3    377B             SET MASK FOR CHAR A SIZE = 8
 NOT12    LT     B7,B0,WRDMOV     BRANCH IF NO CONVERSION (XY LT. 3)
          LX1    42               RIGHT JUSTIFY LEFT SHIFT COUNT
          SB7    X2          B7 - BCP OF FIELD B IN BITS
          SA2    T.S2             CHARACTER SIZE, FIELD B.
          SB4    X1               LEFT SHIFT COUNT FOR CONVERSION TABLE 
          LX1    42               GET MASK FOR CONVERSION TABLE 
          SB6    X2-1             SHIFT COUNT FOR MASK
          AX0    B6          CREATE MASK
          SA2    X2          A2 - CHARACTER SIZE, FIELD B 
          LX0    B6               NEED TO RIGHT JUSTIFY MASK, SO SHIFT
*                            BY B6+1. 
          SB6    60          B6 - 60. 
          SX2    X1          X2 - MASK FOR CHARACTER SIZE IN CONVERSION 
*                                 TABLE.
          LX0    B1          X0 - MASK FOR CHARACTER SIZE B, RIGHT JUST.
* 
* 
*         THE FOLLOWING LOOP PICKS UP 1 CHRACTER AT A TIME FROM FIELD A,
*         CONVERTS IT TO THE CHARACTER TYPE OF FIELD B, AND SOTRES IT 
*         INTO FIELD B.  PROCESSING STOPS WHEN FIELD A RUNS OUT OF
*         CHARACTERS. IF NECESSARY, FIELD B IS THEN BLANK FILLED
*         REGISTERS ARE SET UP AS FOLLOWS --- 
*         A0   -   NUMBER OF BITS TO BE MOVED FROM FIELD A
*         X0   -   MASK FOR CHARACTER SIZE OF FIELD B, RIGHT JUSTIFIED
*         A2   -   CHARACTER SIZE OF FIELD B  (6 OR 12) 
*         X2 - MASK FOR CHARACTER IN CONVERSION TABLE 
*         X3   -   MASK FOR CHARACTER SIZE A, RIGHT JUSTIFIED 
*         A4,X4   -   LOCATION AND CONTENTS OF FIRST WORD FIELD B.
*         A5,X5   -   LOCATION AND CONTENTS OF FIRST WORD FIELD A.
*         B1   -   1
*         B2   -   BCP OF FIELD A IN BITS 
*         B3   -   CONVERSION TABLE POINTER 
*         B4   -   CONVERSION TABLE SHIFT COUNT 
*         B5   -   CHARACTER SIZE OF FIELD A IN BITS
*         B6   -   60 
*         B7   -   BCP OF FIELD B IN BITS 
* 
*                NOTE - THIS IS AN IN-STACK LOOP, SO CODE CAHGES SHOULD 
*                BE CAREFULLY MADE. 
* 
* 
STRTLP    BSS    0
          SB2    B2+B5       INCREMENT BCP OF FIELD A BY AMOUNT TO BE 
*                            MOVED. THIS WILL GIVE A SHIFT COUNT TO RIGH
*                            JUSTIFY THE CHARACTER TO BE MOVED. 
          SB7    B7+A2       SAME FOR BCP OF FIELD B
          LX6    B2,X5       SHIFT A
          LX7    B7,X4       SHIFT B
* 
          BX6    X3*X6       PICK UP CHARACTER FROM A 
          BX7    -X0*X7      MASK OF LOC. IN B WHERE CHARACTER GOES 
          SA1    B3+X6       PICK UP CONVERSION TABLE WORD
          AX6    B4,X1       SHIFT TO GET CONVERTED CHARACTER 
* 
          BX6    X2*X6       MASK OFF ALL BUT CONVERTED CHARACTER 
          SB1    B7-B6       GET SHIFT CHARACTER TO RESTORE ORIGINAL
*                            POSITION OF B. 
          BX7    X6+X7       OR IN NEW CHARACTER
          AX4    B1,X7       SHIFT
* 
          SB1    1           RESTORE B1 
          NE     B7,B6,BR2   IF B HAS MORE BITS, BRANCH  (B6 = 60)
* 
          BX7    X4          STORE AWAY FINISHED WORD 
          SA7    A4 
          SA4    A4+B1       GET NEXT WORD FROM FIELD B 
          SB7    B0          SET BCP TO 0 
* 
BR2       BSS    0
          NE     B2,B6,BR1   IF A HAS MORE BITS IN IT, BRANCH (B6=60) 
          SB2    B0          SET BCP = 0
          SA5    A5+B1       GET NEXT WORD
* 
BR1       BSS    0
          SA0    A0-B5       DECREASE NO. OF BITS LEFT TO PROCESS 
          SX1    A0          SEE IF FINISHED
          NZ     X1,STRTLP   BR IF NOT
* 
* 
          BX7    X4          STORE AWAY PARTIALLY FIELLED WROD
          SA7    A4 
* 
* 
*         COME HERE TO BLANK FILL FIELD B IF NECESSARY. 
*         INPUT REGISTERS - B7 = BCP, IN BITS; A4 = POINTER TO WROD B;
*         X4 = (A4).
* 
* 
FINUP1    BSS    0
          SA2    T.EXL2      SEE IF ANY EXCESS TO FILL
          SB1    1
* 
*                            BLANK FILL FIRST WORD TO END, THEN 
*                            ENTER LOOP TO DO REST
* 
          ZR     X2,XMOVE1   BR IF NO BLANK FILL
          SA3    T.XY        CONVERSION TYPE
          MX5    1
          SA3    X3+BLKCNVT  PICK UP WORD OF BLANKS IN CORRECT CODE 
          SB5    -B1         KEEP -1 IN B5
          SB3    B7-B1       SHIFT COUNT FOR MASK 
          AX5    B3          MASK OF BCP SIZE 
          SB4    -60
          SX0    B7+B4       COMPUTE NO. OF BITS LEFT IN WROD B (= -B2) 
          EQ     B7,B0,LOOP1  IF POSITIONED AT START OF WORD, ENTER LOOP
          IX2    X2+X0       X2 - NUMBER OF BITS LEFT TO STORE INTO WROD
*                            B, X0 HAS NEGATIVE OF NUMBER OF BITS LEFT
*                            IN WORD B.  COMPUTE NUMBER OF BITS LEFT TO 
*                            STORE AFTER THIS WORD
          NG     X2,LOOP3    BR. IF EVEN LESS THAN THIS WORD
          BX6    X5*X4       SAVE FRONT PART OF WORD B (IN X4)
          BX7    -X5*X3      CLEAR OFF FRONT PART OF BLANKS 
          BX7    X7+X6
          SA7    A4          STORE
* 
* 
*         LOOP TO BLANK FILL.   INPUT - A7+1 = NEXT ADDRESS TO BE 
*         STORED INTO, X3 = WORD OF BLANKS IN CORRECT CODE,  X2 = NO. OF
*         BITS LEFT TO STORE
* 
* 
LOOP1     BSS    0
          BX7    X3 
          SX6    X2+B4       SEE IF STILL FULL WORD LEFT  (B4=-60)
          SB2    B1          COUNTER
  
          NG     X6,ENDLP 
* 
* 
LOOP2     BSS    0
          SX6    X6+B4       SEE IF FULL WORD MORE
          SA7    A7+B1       STORE
          PL     X6,LOOP2    BR. IF MORE TO STORE 
*                HERE IF NO MORE FULL WRODS TO STORE
ENDLP     BSS    0
          SX6    X6+60
          MX0    1
          ZR     X6,XMOVE1
          SB3    X6+B5       SHIFT FOR MASK 
          SA5    A7+B1       PICK UP FIELD B
          AX0    B3          MASK 
          BX7    -X0*X7      X7 = WORD OF BLANKS
          BX6    X0*X5
          BX7    X6+X7
          SA7    A5          STORE
          EQ     XMOVE1 
LOOP3     BSS    0
* 
* 
*         COME HERE WHEN NEED TO BLANK FILL THE MIDDLE PART OF A WORD.
*         INPUT - X1 = NO. OF BITS LEFT TO STORE (I.E., SIZE OF MASK) 
*         A4 = ADDRESS OF WROD TO STORE INTO, X4 = (A4), B7 = BCP IN BIT
* 
* 
          MX0    1
          SB2    X1+B5       B2 = SHIFT COUNT FOR MASK
          SB3    B7-60       SHIFT COUNT TO POSITION MASK CORRECTLY 
          AX0    B2          X0 - MASK
          BX7    -X0*X4      CLEAR WORD B OF THE BITS TO CHANGE 
          BX6    X0*X3       MASK AWAY ALL BUT WANTED BLANKS
          BX7    X6+X7
          SA7    A4 
          EQ     XMOVE1      FINISHED 
* 
* 
WRDMOV    BSS    0
* 
*         COME HERE IF NO CONVERSION IS TO BE DONE. FIRST FILL UP 
*         RECEIVING FIELD TO FULL WORD AND THEN SET UP LOOP TO MOVE 1 
*         WORD AT A TIME FROM FIELD A TO FIELD B. 
* 
          SX2    X2 
          ZR     X2,FULWORD  IF OFFSET FOR FIELDB IS 0, NO NEED FILL. 
          SX2    X2-60       X2 - OFFSET B; COMPUTE HOW MANY BITS LEFT
*                            TI FILL UP WORD B. 
          SB6    RETUR3      RETURN ADDRESS FOR NXBITS
          BX2    -X2
          SA1    T.SRC1      POINTER WORD FOR NXBITS
          SX5    X2          SAVE X2 THROUGH NXBITS TO SEE IF ALL BITS
*                            WERE RETURNED
*                            IF NOT, X2 WILL HAVE NO. OF BITS REMAINING 
          EQ     NXBITS      FETCH NEXT X2 BITS FROM FIELD POINTED TO BY
*                            X1. RETURN WITH BITS IN X6, RT. JUST., AND 
*                            UPDATED POINTER WORD IN X7 
* 
RETUR3    BSS    0
          ZR     X2,FINUPA   X2 = 0 MEANS NO MORE TO GET
          IX5    X2-X5       DECREMENT FIELD A BIT COUNT
          SA7    A1          RESTORE T.SRC1 
          SA1    T.SRC2 
          MX0    1
          SA3    X1           GET ADDRESS TO MOVE TO
          SB3    X2-59D 
          SB3    -B3
          AX0    B3          MASK FOR OFFSET OF FIELD A 
          NG     X5,MIDDLE   BR IF FIELD A HAS LESS BITS THAN NEEDED
          SB5    X2          USE TO DECREASE CHARACTER COUNT
          BX2    X0*X3       CLEAR AWAY REST OF WORD B
          BX6    X2+X6       X6 - CHARS. TO BE MOVED
          SA6    A3 
FULWOR    BSS    0
          SA5    X7          X7 = T.SRC1
          AX7    18          BCP FOR FIELD A
          MX0    1
          SB3    X7-1        SHIFT COUNT FOR MASK 
          SB4    X7          NEED TO SET UP MASK FOR OFFSET OF FIELD A
          AX4    X0,B3       IN SUCH A WAY THAT A ZERO MASK CAN BE
          AX0    B4          CREATED
          BX0    X0*X4
          SB2    -60
          SB3    X7 
          SX2    A0-B5       NUMBER OF BITS LEFT TO MOVE
          ZR     X2,FINUPA   BR IF NO BITS LEFT TO MOVE 
LOOP4     BSS    0
          BX6    -X0*X5      LAST HALF OF FIRST WORD OF FIELD A 
          SA5    A5+B1
          BX4    X0*X5       FIRST HALS OF NEXT WORD OF FIELD A 
          SX2    X2+B2       DECREASE MOVE COUNT
          BX6    X6+X4       HAVE FULL WORD, NEED TO SHIFT BY OFFSET
          LX6    B3 
          NG     X2,NOT60A   FIELD A RAN OUT
          SA6    A6+B1       STORE
          EQ     LOOP4
* 
* 
FULWORD   BSS    0
*         COME HERE TO SET UP FOR LOOP TO MOVE WHOLE WORDS. 
* 
          SA3    T.SRC2 
          SA1    T.SRC1 
          SA5    X3-1        USE THIS FOR SETTING UP A6 FOR STORE 
          BX7    X1          MOVE T.SRC1 TO X7
          SB5    B0          FOR DECREASING BITS LEFT COUNT 
          BX6    X5 
          SA6    A5 
          EQ     FULWOR      BRANCH TO STORE LOOP 
* 
* 
*         SET UP REGISTERS TO GO TO FINUP1
* 
FINUPA    BSS    0
          SA1    T.SRC2      GET POINTER
          SA4    X1 
          AX1    18 
          SB7    X1 
          EQ     FINUP1 
* 
* 
NOT60A    BSS    0
* 
*         COME HERE IF FIELD A HAS LESS THAN 60 BITS IN IT.  THE CORRECT
*         BITS ARE ALREADY LEFT JUSTIFIED IN X6. MASK AWAY REST, GET FIE
*         LF B, AND SAVE PART, MOVE X6 AND STORE FIELD B BACK.
* 
          MX0    1
          SB3    X2+59       SHIFT COUNT FOR MASK 
          NG     B3,FINUPA   BR IF NO BITS LEFT TO MOVE 
          AX0    B3          MASK 
          BX6    X0*X6
          SA4    A6+B1
          BX7    -X0*X4 
          SB7    B3+B1
          BX7    X6+X7
          SA7    A4 
          BX4    X7          SET UP REGISTERS FOR FINUP 1 X4,A4,B7
          EQ     FINUP1 
* 
MIDDLE    BSS    0
* 
*         COME HERE WHEN THE ENTIRE MOVE IS INTO ONE WORD 
* 
          SB4    X5          NEED TO MASK OFF FIGTH HALF OF X6 AND
          AX6    B4          SHIFT LEFT TO POSITION CHARACTERS IN MIDDLE
          SB7    X5+60       OR IN WHAT WAS IN FIELD B. 
          ZR     X1,XMOVE1   X1 = NUMBER OF BITS TO MOVE
          AX0    B4          POSITION MASK IN MIDDLE OF WORD
          BX2    X0*X3
          BX6    -X0*X6 
          BX6    X2+X6
          SA6    A3          A3 POINTS TO FIELD B 
          SA4    A6          SET UP A4,X4, B7 FOR FINUP1
          EQ     FINUP1 
* 
* 
*         TABLE BLKCNVT IS USED TO PICK UP THE CORRECT TYPE OF
*                BLANKS FOR THE CURRENT CONVERSION FOR BLANK FILL.
 BLKCNVT  BSS    0
          DATA   10H                       XX - XX
          DATA   00400040004000400040B     AA - XA
          DATA   01000100010001000100B        CC - XC 
          DATA   00400040004000400040B     XA - XA
          DATA   01000100010001000100B        XC - XC 
          DATA   10H                       AX - XX
          DATA   01000100010001000100B        AC - XC 
          DATA   10H                       CX - XX
          DATA   00400040004000400040B     CA - XA
          DATA   0                         XAL - XAL
          END 
