* STORE BINARY VALUE                                    HEADER  CR.SBVAL0001.000
*                                                                       0002.000
*              STORE BINARY VALUE                                       0003.000
*                                                                       0004.000
         M.PGM     CR.SBVAL,MPX-32,3.6.1,00                             0005.000
         DEF   CR.SBVAL                                                 0006.000
*                                                                       0007.000
* ROUTINE TO STORE BINARY VALUE                                         0008.000
*                                                                       0009.000
*    CALLING SEQUENCE                                                   0010.000
*        LD    R6,VAL         BINARY VALUE TO STORE                     0011.000
*        LW    R2,DD          ADDRESS OF DESTINATION DD                 0012.000
*        BL    CR.SBVAL                                                 0013.000
*                                                                       0014.000
*                                                                       0015.000
         M.REQS                                                         0016.000
         DD.EQU                                                         0017.000
         COBOLDAT                                                       0018.000
*                                                                       0019.000
* INTERNAL DATA                                                         0020.000
*                                                                       0021.000
BTMP     RES       1D                                                   0022.000
R3SAV    RES       1W                                                   0023.000
*                                                                       0024.000
* SAVE BINARY VALUE                                                     0025.000
*                                                                       0026.000
CR.SBVAL EQU       $                                                    0027.000
         STW       R3,R3SAV                                             0028.000
         STD       R6,BTMP                                              0029.000
         TBM       0,BTMP                                               0030.000
         BNS       $+2W                                                 0031.000
         LND       R6,BTMP                                              0032.000
         LH        R3,DD.LEN,X2                                         0033.000
         CI        R3,18                                                0034.000
         BEQ       STOIT                                                0035.000
         SLL       R3,3                                                 0036.000
         TRR       R3,R5                                                0037.000
         CAMD      R6,POW10,X3                                          0038.000
         BLT       STOIT                                                0039.000
         LI        R3,17D                                               0040.000
LP100    EQU       $                                                    0041.000
         CAMD      R6,POW10,X3                                          0042.000
         BLT       DEC3                                                 0043.000
         SUMD      R6,POW10,X3                                          0044.000
         BU        LP100                                                0045.000
DEC3     EQU       $                                                    0046.000
         SUI       R3,1D                                                0047.000
         CAR       R5,R3                                                0048.000
         BGE       LP100                                                0049.000
STOIT    EQU       $                                                    0050.000
         TBM       0,BTMP                                               0051.000
         BNS       GOSTO                                                0052.000
         TBM       DD.S,0,X2                                            0053.000
         BNS       GOSTO                                                0054.000
         STD       R6,BTMP                                              0055.000
         LND       R6,BTMP                                              0056.000
GOSTO    EQU       $                                                    0057.000
         LW        R3,R3SAV                                             0058.000
         LH        R5,DD.LEN,X2                                         0059.000
         LW    R2,DD.PTR,X2   LOAD POINTER TO DESTINATION               0060.000
         CI    R5,4                                                     0061.000
         BGT   WORD                                                     0062.000
         STB   R7,1,X2                                                  0063.000
         SRA   R7,8                                                     0064.000
         STB   R7,0,X2                                                  0065.000
         TRSW  0              RETURN                                    0066.000
WORD     CI    R5,9                                                     0067.000
         BGT   DOUBLE                                                   0068.000
         STB   R7,3,X2                                                  0069.000
         SRA   R7,8                                                     0070.000
         STB   R7,2,X2                                                  0071.000
         SRA   R7,8                                                     0072.000
         STB   R7,1,X2                                                  0073.000
         SRA   R7,8                                                     0074.000
         STB   R7,0,X2                                                  0075.000
         TRSW  0                                                        0076.000
DOUBLE   EQU   $                                                        0077.000
         STB   R6,3,X2                                                  0078.000
         STB   R7,7,X2                                                  0079.000
         SRAD  R6,8                                                     0080.000
         STB   R6,2,X2                                                  0081.000
         STB   R7,6,X2                                                  0082.000
         SRAD  R6,8                                                     0083.000
         STB   R6,1,X2                                                  0084.000
         STB   R7,5,X2                                                  0085.000
         SRAD  R6,8                                                     0086.000
         STB   R6,0,X2                                                  0087.000
         STB   R7,4,X2                                                  0088.000
         TRSW  0              RETURN                                    0089.000
         END                                                            0090.000
