* LOAD DECIMAL ACCUM WITH PACKED DATA                   HEADER  CR.LDP8 0001.000
*                                                                       0002.000
*              LOAD DECIMAL ACCUMULATOR WITH PACKED DATA                0003.000
*                                                                       0004.000
         M.PGM      CR.LDP8,MPX-32,3.6.1,00                             0005.000
*                                                                       0006.000
*                                                                       0007.000
*                                                                       0008.000
          M.REQS                                                        0009.000
          DEF  CR.LDP8                                                  0010.000
          EXT  CR.ABORT                                                 0011.000
          DD.EQU                                                        0012.000
          COBOLDAT                                                      0013.000
DECA8     EQU   DECA+320                                                0014.000
DDECA8    EQU   DDECA+16                                                0015.000
DOFLO8    EQU   DOFLO+8                                                 0016.000
*                                                                       0017.000
*    R0 - RETURN ADDRESS                                                0018.000
*    R1 - DD   DATA DESCRIPTOR FOR SOURCE DATA                          0019.000
*                                                                       0020.000
*--- CLEAR DECIMAL ACCUMULATOR 8 ---                                    0021.000
CR.LDP8  EQU    $                                                       0022.000
         ZMD    DECA8                                                   0023.000
         ZMD    DECA8+8             ZERO OUT DECA8                      0024.000
         ZMD    DECA8+16                                                0025.000
         ZMD    DECA8+24                                                0026.000
         ZMD    DECA8+32                                                0027.000
         ZMB   DOFLO8              CLEAR OVERFLOW FLAG                  0028.000
*--- GET POSITION OF LEFTMOST DIGIT TO STORE ---                        0029.000
         LB     R2,DD.D,X1          GET DECIMAL POSITION                0030.000
         SLL    R2,24                                                   0031.000
         SRA    R2,24                   AND EXTEND ITS SIGN.            0032.000
         ADI    R2,18                                                   0033.000
*--- GET POINTER TO LEFTMOST BYTE OF SOURCE ---                         0034.000
         LH     R3,DD.LEN,X1        GET LENGTH                          0035.000
         TRN    R3,R7                                                   0036.000
         SRA    R3,1                                                    0037.000
         ADMW   R3,DD.PTR,X1                                            0038.000
*--- DETERMINE SIGN OF DECIMAL ACCUMULATOR ---                          0039.000
         LI     R6,G'+'                                                 0040.000
         LI     R4,X'0F'                                                0041.000
         TBM    DD.S,0,X1                                               0042.000
         BNS    LOADDECA                                                0043.000
         LMB    R5,0,X3                                                 0044.000
         CI     R5,X'0D'                                                0045.000
         BNE    LOADDECA                                                0046.000
         LI     R6,G'-'                                                 0047.000
LOADDECA  EQU   $                                                       0048.000
          STB   R6,DECA8             SAVE SIGN                          0049.000
          LI    R6,1                                                    0050.000
MOVLOOP   EQU   $                                                       0051.000
          TRN   R6,R6                                                   0052.000
          BP    L1                                                      0053.000
          LB    R5,0,X3                                                 0054.000
          SRL   R5,4                                                    0055.000
          SUI   R3,1                                                    0056.000
          BU    L2                                                      0057.000
L1        EQU   $                                                       0058.000
          LMB   R5,0,X3                                                 0059.000
L2        EQU   $                                                       0060.000
          CI    R5,9                                                    0061.000
          BGT   ERROR                                                   0062.000
          STB   R5,DECA8,X2                                             0063.000
          SUI   R2,1                                                    0064.000
          BIB   R7,MOVLOOP                                              0065.000
          ADI   R2,321                                                  0066.000
          STH   R2,DDECA8                                               0067.000
          TRSW  0                                                       0068.000
*--- BAD DATA ERROR ---                                                 0069.000
ERROR     EQU   $                                                       0070.000
          LI    R1,1                                                    0071.000
         TRR       R0,R7                                                0072.000
          BL    CR.ABORT                                                0073.000
         END                                                            0074.000
