* MOVE ALPHANUMERIC                                     HEADER  C:MVA   0001.000
*                                                                       0002.000
*              MOVE ALPHANUMERIC                                        0003.000
*                                                                       0004.000
         M.PGM     C:MVA,MPX-32,3.6.1,00                                0005.000
         DEF   C:MVA                                                    0006.000
         DEF   CR.MVA                                                   0007.000
*                                                                       0008.000
* ALPHANUMERIC MOVE                                                     0009.000
*                                                                       0010.000
*    CALLING SEQUENCE                                                   0011.000
*        BL    C:MVA                                                    0012.000
*        AC    DD1            SOURCE DD                                 0013.000
*        AC    DD2            DESTINATION DD                            0014.000
*                                                                       0015.000
*                                                                       0016.000
         EXT   CR.ABORT       ABORT ROUTINE                             0017.000
         M.REQS                                                         0018.000
         DD.EQU                                                         0019.000
         COBOLDAT                                                       0020.000
*                                                                       0021.000
* GET LENGTH OF AND POINTER TO DESTINATION AND SOURCE DATA              0022.000
*                                                                       0023.000
C:MVA   LOAD  2              LOAD ARGUMENTS                             0024.000
CR.MVA   TRR   R0,R4          SAVE RETURN ADDRESS                       0025.000
         LB    R5,DD.D,X1     GET DECIMAL POSITION OF SOURCE            0026.000
         SLL   R5,26             AND EXTEND SIGN                        0027.000
         SRA   R5,26                                                    0028.000
         LH    R6,DD.LEN,X1   GET LENGTH OF SOURCE                      0029.000
         LH    R7,DD.LEN,X2   GET LENGTH OF DESTINATION                 0030.000
         LW    R3,DD.PTR,X2   GET POINTER TO DESTINATION DATA           0031.000
         LW    R2,DD.PTR,X1   GET POINTER TO SOURCE DATA                0032.000
*                                                                       0033.000
* DETERMINE TYPE OF SOURCE DATA TO BE MOVED                             0034.000
*                                                                       0035.000
         TBM   DD.T,0,X1      IF ITEM IS ALPHANUMERIC                   0036.000
         BNS   MOVALPHA          THEN GO TO MOVALPHA                    0037.000
         TBM   DD.S,0,X1      IF ITEM IS UNSIGNED                       0038.000
         BNS   DECMOVE           THEN GO MOVE DECIMAL                   0039.000
         TBM   DD.L,0,X1      IF SIGN IS TRAILING                       0040.000
         BNS   NOTLEAD           THEN GO TO NOTLEAD                     0041.000
         TBM   DD.P,0,X1      IF SIGN IS LEADING NON-SEPARATE           0042.000
         BNS   COMBSGN           THEN GO TO COMBSGN                     0043.000
         ADI   R2,1           INCREMENT SOURCE TO SKIP LEADING SIGN     0044.000
*                                                                       0045.000
* MOVE DECIMAL TO DESTINATION                                           0046.000
*                                                                       0047.000
DECMOVE  BL    MOVDIGS        MOVE SOURCE TO DESTINATION                0048.000
         BU    TSTDEC         GO INSERT TRAILING 0'S IF NECESSARY       0049.000
*                                                                       0050.000
* NON-SEPARATE LEADING SIGN                                             0051.000
*                                                                       0052.000
COMBSGN  BL    TRNSDIG        TRANSLATE SIGNED DIGIT                    0053.000
         BU    DECMOVE        MOVE REMAINDER OF DATA                    0054.000
*                                                                       0055.000
* TERMINAL SIGN                                                         0056.000
*                                                                       0057.000
NOTLEAD  TBM   DD.P,0,X1      IF SIGN IS SEPARATE                       0058.000
         BS    DECMOVE           THEN GO MOVE DECIMAL                   0059.000
         SUI   R6,1           ELSE                                      0060.000
         BL    MOVDIGS           MOVE ALL BUT THE SIGN DIGIT            0061.000
         TRR   R7,R7          IF THE DESTINATION IS FILLED              0062.000
         BNP   RETURN            THEN RETURN                            0063.000
         BL    TRNSDIG           ELSE TRANSLATE AND MOVE SIGN DIGIT     0064.000
*                                                                       0065.000
* IF DEC IS NEGATIVE STORE ZERO'S IN DESTINATION                        0066.000
*                                                                       0067.000
TSTDEC   TRR   R5,R5          IF DEC IS NON-NEGATIVE                    0068.000
         BNN   FILSP             THEN GO TO FILSP                       0069.000
         ADR   R5,R7          LET R5 = -MIN(-R5,R7)                     0070.000
         BNN   SAVZERO                AND                               0071.000
         SUR   R7,R5              R7 = R7 + R5                          0072.000
         BNN   RETURN         IF R5 >= 0 THEN RETURN                    0073.000
SAVZERO  LI    R1,G'0'                                                  0074.000
ZLOOP    STB   R1,0,X3        SAVE '0'                                  0075.000
         ADI   R3,1           INCREMENT POINTER                         0076.000
         BIB   R5,ZLOOP       INCREMENT R5 AND IF R5<0 THEN REPEAT      0077.000
*                                                                       0078.000
* FILL REMAINDER OF DESTINATION WITH SPACES                             0079.000
*                                                                       0080.000
FILSP    TRN   R7,R7          NEGATE R7                                 0081.000
         BNN   RETURN         IF ITS NOT NEGATIVE THEN RETURN           0082.000
         LI    R1,G' '        LOAD SPACE                                0083.000
SPLOOP   STB   R1,0,X3        SAVE SPACE IN DESTINATION                 0084.000
         ADI   R3,1           INCREMENT POINTER                         0085.000
         BIB   R7,SPLOOP      REPEAT UNTIL END OF DESTINATION REACHED   0086.000
RETURN   TRSW  4              RETURN                                    0087.000
*                                                                       0088.000
* MOVE ALPHA FIELD                                                      0089.000
*                                                                       0090.000
MOVALPHA BL    MOVDIGS                                                  0091.000
         BU    FILSP                                                    0092.000
*                                                                       0093.000
* MOVE PROCEDURE                                                        0094.000
*                                                                       0095.000
MOVDIGS  TRN   R6,R6          LET R6 = -MIN(R6,R7)                      0096.000
         ADR   R6,R7                    AND                             0097.000
         BNN   MOVE               R7 = R7 - R6                          0098.000
         SUR   R7,R6                                                    0099.000
MOVE     TRR   R6,R6          IF R6 IS GREATER OR EQUAL TO ZERO         0100.000
         BNN   MOVRET            THEN RETURN                            0101.000
MOVLOOP  LB    R1,0,X2        MOVE BYTE FROM DESTINATION                0102.000
         STB   R1,0,X3           TO SOURCE                              0103.000
         ABR   R2,31          INCREMENT SOURCE POINTER                  0104.000
         ABR   R3,31          INCREMENT DESTINATION POINTER             0105.000
         BIB   R6,MOVLOOP                                               0106.000
MOVRET   TRSW  0              RETURN                                    0107.000
*                                                                       0108.000
* TRANSLATE AND STORE DIGIT PROCEDURE                                   0109.000
*                                                                       0110.000
TRNSDIG  LB    R1,0,X2        GET NEXT BYTE                             0111.000
         LB    R1,DIGIT,X1    TRANSLATE IT TO DECIMAL                   0112.000
         CI    R1,X'FF'       IF IT EQUALS X'FF'                        0113.000
         BEQ   ERROR             THEN ITS ILLEGAL                       0114.000
         ADI   R1,G'0'        CONVERT IT TO ASCII                       0115.000
         STB   R1,0,X3           AND SAVE IT IN DESTINATION             0116.000
         ABR   R2,31          INCREMENT SOURCE POINTER                  0117.000
         ABR   R3,31          INCREMENT DESTINATION POINTER             0118.000
         SUI   R6,1           DECREMENT SOURCE LENGTH                   0119.000
         SUI   R7,1           DECREMENT DESTINATION LENGTH              0120.000
         TRSW  0              RETURN                                    0121.000
*                                                                       0122.000
* DATA ERROR                                                            0123.000
*                                                                       0124.000
ERROR    LI    R1,1           LOAD ERROR NUMBER                         0125.000
         TRR       R0,R7                                                0126.000
         BL    CR.ABORT       ABORT JOB                                 0127.000
         END                                                            0128.000
