* SCALE BINARY ACCUMLTOR FOR ADDITION                   HEADER  CR.SCALE0001.000
*                                                                       0002.000
*              SCALE BINARY ACCUMULATOR FOR ADDITION                    0003.000
*                                                                       0004.000
         M.PGM     CR.SCALE,MPX-32,3.6.1,00                             0005.000
         DEF   CR.SCALE,CR.LSCL,CR.RSCL                                 0006.000
*                                                                       0007.000
* ALIGN THE DECIMAL POINTS FOR (R6,R7) AND ACC(R1) FOR ADDITION         0008.000
*    R1 - INDICATES DESTINATION BINARY ACCUMULATOR ( UNAFFECTED)        0009.000
*    R5 - DECIMAL POSITION FOR SOURCE OPERAND                           0010.000
*    R6 - MOST SIGNIFICANT WORD OF SOURCE OPERAND                       0011.000
*    R7 - LEAST SIGNIFICANT WORD OF SOURCE OPERAND                      0012.000
*                                                                       0013.000
         EXT   CR.BDIVW                                                 0014.000
         M.REQS                                                         0015.000
         COBOLDAT                                                       0016.000
*                                                                       0017.000
* INTERNAL DATA                                                         0018.000
*                                                                       0019.000
         ORG   WORKAREA+4D                                              0020.000
BTMP     RES   1D                                                       0021.000
BTMP1    RES   1D                                                       0022.000
RET1     RES   1W                                                       0023.000
RET      RES   1W                                                       0024.000
         REL                                                            0025.000
*                                                                       0026.000
* DETERMINE DIRECTION OF SCALING                                        0027.000
*                                                                       0028.000
CR.SCALE STW   R0,RET         SAVE RETURN ADDRESS                       0029.000
         TRR   R1,R2                                                    0030.000
         SLL   R2,1           SUBTRACT DECIMAL POSITION OF ACCUMULATOR  0031.000
         SUMH  R5,DACC,X2        SPECIFIED BY R1 FROM R5                0032.000
         BZ    *RET           IF RESULT IS ZERO, THEN RETURN            0033.000
         BP    SCLACC         IF RESULT IS POSITIVE, THEN GO SCALE ACC  0034.000
         BL    CR.LSCL        SCALE NUMBER IN (R6,R7)                   0035.000
         TRR   R5,R5          TEST DECIMAL POSITION                     0036.000
         BZ    *RET           IF ZERO, RETURN                           0037.000
*                                                                       0038.000
* SCALE  NUMBER IN ACC(X1) RIGHT TO ALIGN DECIMAL POINT                 0039.000
*                                                                       0040.000
         ARMH  R5,DACC,X2     ADD R5 TO ACC SCALE FACTOR                0041.000
         STD   R6,BTMP1       STORE (R6,R7) IN BTMP1                    0042.000
         TRN   R5,R5          NEGATE SCALE FACTOR                       0043.000
         SLL   R2,2                                                     0044.000
         LD    R6,ACC,X2      LOAD ACCUMULATOR                          0045.000
         BL    CR.RSCL        SCALE IT RIGHT UNTIL SCALE FACTOR IS ZERO 0046.000
         STD   R6,ACC,X2      STORE ACCUMULATOR                         0047.000
         LD    R6,BTMP1       LOAD BTMP1 INTO (R6,R7)                   0048.000
         BU    *RET           RETURN                                    0049.000
*                                                                       0050.000
* SCALE NUMBER IN ACC(X1) LEFT UNTIL R5 IS ZERO                         0051.000
*                                                                       0052.000
SCLACC   ARMH  R5,DACC,X2     ADD R5 TO ACC SCALE FACTOR                0053.000
         STD   R6,BTMP1       STORE (R6,R7) TO BTMP1                    0054.000
         TRN   R5,R5          NEGATE R5                                 0055.000
         SLL   R2,2                                                     0056.000
         LD    R6,ACC,X2      LOAD ACCUMULATOR INTO (R6,R7)             0057.000
         BL    CR.LSCL        SCALE IT LEFT UNTIL R5 IS ZERO            0058.000
         STD   R6,ACC,X2      STORE IT BACK INTO ACCUMULATOR            0059.000
         LD    R6,BTMP1       LOAD BTMP1 INTO (R6,R7)                   0060.000
         SRL   R2,2                                                     0061.000
         TRR   R5,R5          TEST R5                                   0062.000
         BZ    *RET           IF ZERO, THEN RETURN                      0063.000
*                                                                       0064.000
* SCALE NUMBER IN (R6,R7) RIGHT                                         0065.000
*                                                                       0066.000
         ARMH  R5,DACC,X2     ADD R5 TO ACCUMULATOR SCALE FACTOR        0067.000
         TRN   R5,R5          NEGATE SCALE FACTOR                       0068.000
         BL    CR.RSCL        SCALE NUMBER IN (R6,R7) RIGHT             0069.000
         BU    *RET           RETURN                                    0070.000
*                                                                       0071.000
* SCALE NUMBER IN (R6,R7) LEFT WHILE ITS <  1E17 AND R5<0               0072.000
*                                                                       0073.000
CR.LSCL  CAMD  R6,P1E17       IF R6 >= 1E17                             0074.000
         BGE   RETURN            THEN RETURN                            0075.000
         CAMD  R6,M1E17       IF R6 <= -1E17                            0076.000
         BLE   RETURN            THEN RETURN                            0077.000
         SLAD  R6,1                                                     0078.000
         STD   R6,BTMP                                                  0079.000
         SLAD  R6,2           MULTIPLY (R6,R7) BY 10                    0080.000
         ADMD  R6,BTMP                                                  0081.000
         BIB   R5,CR.LSCL     INCREMENT R5 AND REPEAT IF R5<0           0082.000
RETURN   TRSW  R0             RETURN                                    0083.000
*                                                                       0084.000
* DIVIDE NUMBER IN (R6,R7) BY 10**(R5)                                  0085.000
*                                                                       0086.000
CR.RSCL  STW   R0,RET1        SAVE RETURN                               0087.000
         TRR   R5,R3          TRANSFER R5 TO R3                         0088.000
         SLL   R3,3              AND ADJUST FOR DOUBLE WORD INDEXING    0089.000
         CI    R3,9*8         IF SCALE FACTOR > 9                       0090.000
         BLE   SW                                                       0091.000
         LW    R5,POW10+9D+1W  THEN DIVIDE   (R6,R7) BY 1E9;            0092.000
         BL    CR.BDIVW                                                 0093.000
         SUI   R3,9*8         SUBTRACT 9*8 FROM R3                      0094.000
SW       LW    R5,POW10+1W,X3 LOAD DIVISOR                              0095.000
         BL    CR.BDIVW       DIVIDE (R6,R7) BY 10**(R5)                0096.000
         BU    *RET1          RETURN                                    0097.000
*                                                                       0098.000
* INTERNAL CONSTANTS                                                    0099.000
*                                                                       0100.000
P1E17    DATAD F'1E17'                                                  0101.000
M1E17    DATAD F'-1E17'                                                 0102.000
         END                                                            0103.000
