         SYSTEM   SIG7FDP
         PAGE
         TITLE    'CONVERSION ROUTINES'
         DEF      C:CDB,C:CDE,C:CDF,C:CBD,C:CED
         DEF      C:CFD,C:DBD,C:DED,C:DFD
         DEF      C:CFE
         DEF      C:MSB                                                 C:CONV
R2       EQU      2                                                     C:CONV
R3       EQU      3                                                     C:CONV
R4       EQU      4                                                     C:CONV
R5       EQU      5                                                     C:CONV
R11      EQU      11                                                    C:CONV
B1       EQU      1
B2       EQU      2
B3       EQU      3
B4       EQU      4
B5       EQU      5
B6       EQU      6
B7       EQU      7
B8       EQU      8
B9       EQU      9
B10      EQU      10
PSWD     RES      1                 CONDITION CODE
RREG     RES      1                 RREG                                C:CONV
SAV11    RES      1                                                     C:CONV
         BOUND    8                                                     C:CONV
ZROS     DATA     0,0               A DW OF ZERO                        C:CONV
STREGS   RES      11                SAVE REGISTERS
SVDSA    RES      1                 COUNT FOR DSA
DECPS    RES      1                 DECP
ADJSTE   RES      1                 ADJUST E VALUE
         BOUND    8
POTSF    DATA     X'7F235FAD'       10**75
         DATA     X'D81C2813'
POTMU    DATA     X'59C9F2C9'       10**30
         DATA     X'CD046740'
         DATA     X'45186A00'       10**5
         DATA     X'00000000'
         DATA     X'41A00000'       10
         DATA     X'00000000'
POTSB    DATA     X'662CD76F'       10**45
         DATA     X'E086B935'
         DATA     X'7B172EBA'       10**70
         DATA     X'D6DDC733'
POTSN    DATA     X'7E389916'       10**74
         DATA     X'26937352'
         DATA     X'7E71322C'       2X10**74
         DATA     X'4D26E6A4'
         DATA     X'7EE26458'       4X10**74
         DATA     X'9A4DCD48'
         DATA     X'7F1C4C8B'       8X10**74
         DATA     X'1349B9A9'
MAXTST   DATA     X'7F199999'       FOR OVER FLOW TEST
         DATA     X'99999999'
BITWD    DATA     X'FF000000'
TENSEV   DATA     10000000          10**7
DECFIF   DATA     X'0065536C'       2**16
CVTBL    DATA     8000000           CONVERSION TABLE
         DATA     4000000
         DATA     2000000
         DATA     1000000
         DATA     800000
         DATA     400000
         DATA     200000
         DATA     100000
         DATA     80000
         DATA     40000
         DATA     20000
         DATA     10000
         DATA     8000
         DATA     4000
         DATA     2000
         DATA     1000
         DATA     800
         DATA     400
         DATA     200
         DATA     100
         DATA     80
         DATA     40
         DATA     20
TEN      DATA     10
         DATA     8
         DATA     4
         DATA     2
         DATA     1
         DATA     0
         DATA     0
         DATA     0
         DATA     0
SUBPOT   CD,B8    POTSB,B3
MULPOT   FML,B8   POTMU,B3
SUBEXP   AI,B10   1
         AI,B10   5
         AI,B10   30
GETDIGC  LI,B1    8
         LI,B1    8
         LI,B1    8
         LI,B1    7
*     ** SET PSWD FOR RESET CONDITION CODE
LDCF     LCF      PSWD              RESET CONDITION CODE
         B        *11
STCFP    LI,B3    X'20'             SET CONDITION CODE-POSITIVE
         STB,B3   PSWD
         B        *B7
STCFN    LI,B3    X'10'             NEGATIVE
         B        STCFP+1
STCFZ    LI,B3    0                 ZERO
         B        STCFP+1
SCFBO    LI,B3    X'40'             OVERFLOW
         B        STCFP+1
*  THIS  ROUTINE  REMOVES  AND SAVE THE SIGN  BIT                       C:CONV
*  IT IS  USED  BY EXHIBIT AND DISPLAY                                  C:CONV
C:MSB    RES      0                                                     C:CONV
         LCI      4                 SAVE REGISTERS                      C:CONV
         STM,R2   STREGS                                                C:CONV
         LW,R2    R3                R3 CONTAINS ADDRESS OF SIGN         C:CONV
         AI,R2    -1                BYTE PLUS 1                         C:CONV
         LB,R4    0,R2                                                  C:CONV
         LW,R5    R4                                                    C:CONV
         OR,R4    L(X'F0')          REMOVE  SIGN AND                    C:CONV
         STB,R4   0,R2              STORE                               C:CONV
         SLS,R5   -4                                                    C:CONV
         CI,R5    X'D'              IS SIGN NEGATIVE                    C:CONV
         BE       %+3                                                   C:CONV
         LI,R2    X'4E'             NO  GET PLUS SIGN                   C:CONV
         B        %+2                                                   C:CONV
         LI,R2    X'60'             YES GET MINUS SIGN                  C:CONV
         STB,R2   0,R3              STORE IT                            C:CONV
         LCI      4                                                     C:CONV
         LM,R2    STREGS                                                C:CONV
         B        *R11                                                  C:CONV
*     ** FLOATING TO PACKED DECIMAL
*        INPUT-FLS,FLL IN SREG, DECP IN R10
*        OUTPUT-PACKED DECIMAL IN DECA, DECP IN R10
C:CED    LCI      11                SHORT
         STM,1    STREGS
         STH,B10  DECPS
         LH,B10   B10
         AI,B10   4
         LW,B8    *B10
         LI,B9    0
         BAL,11   HEXTEN
         LI,13    0
         B        C:CBF0
C:CFD    LCI      11                 LONG
         STM,1    STREGS
         STH,B10  DECPS
         LH,B10   B10
         AI,B10   4
         LCI      2
         LM,B8    *B10
         BAL,11   HEXTEN
C:CBF0   LCW,B10  B10
         AH,B10   DECPS
         DSA      *B10
         BCR,4    %+3
         BAL,B7   SCFBO
         B        C:CBF1
         BCS,3    C:CBF1
         BAL,B7   STCFZ
C:CBF1   LH,B10   DECPS
         STW,B10  STREGS+9
C:CBF2   LCI      11
         LM,1     STREGS
         B        LDCF
HEXTEN   LI,12    0                 FLOATING TO DEC
         LFI      0
         SFL,B8   1
         CW,12    B9
         BCS,3    HEXTEN0
         CW,12    B8
         BCS,3    HEXTEN0
         LI,B6    X'C'
         DL,4     B6
         LI,B10   0
         STW,B10  SVDSA
         BAL,B7   STCFZ
         B        *11
HEXTEN0  LW,B3    BITWD             CHECK AND SET SIGN
         AND,B3   B8
         BCS,1    %+4
         BAL,B7   STCFP
         LI,B6    X'C'
         B        %+4
         LCD,B8   B8
         BAL,B7   STCFN
         LI,B6    X'D'
         DL,4     B6
         LI,B10   -44
         CD,B8    POTSF
         BG       DIGFNF
         BNE      %+4
HEXTEN1  LI,B4    X'10'             EXACT NUMBER FOUND
         STB,B4   12
         B        *11
         LI,B3    0
         LI,B2    3
PWTFND   EXU      SUBPOT            FIND EXPONENT
         BG       PWTFND1
         BL       %+3
         EXU      SUBEXP-1,B2
         B        HEXTEN1
         EXU      SUBEXP-1,B2
         EXU      MULPOT
         B        PWTFND
PWTFND1  AI,B3    1
         BDR,B2   PWTFND
         B        DIGFND
DIGFNF   FDL,B8   POTMU+4           FOR NUMBER>10**75
         AI,B10   -1
DIGFND   LI,B1    -2
         LI,B2    32
         LI,B3    3
         LI,B7    4
DIGFND1  CD,B8    POTSN,B3
         BE       DIGEND
         BL       %+4
         LW,B5    BITWD
         FSL,B8   POTSN,B3
         B        %+2
         LI,B5    0
         SLD,B4   1                 SET BIT
         AI,B2    -1
         AI,B3    -1
         BDR,B7   DIGFND1
DIGFND11 FML,B8   POTMU+4
         CI,B2    0
         BNE      DIGFND+2
         BIR,B1   DIGFND3
DIGFND2  SLS,B4   -4                ELIMINATE EXTRANEOUS DIGIT
         SLS,B4   4
         STW,B4   13
         B        *11
DIGFND3  STW,B4   12
         B        DIGFND+1
DIGEND   LW,B5    BITWD
         SLD,B4   1
         SLS,B4   -1,B2
         CI,B1    -1
         BCR,3    DIGFND2
         STW,B4   12                FINISHED ONE WORD
         B        *11
*     ** PACKED DECIMAL TO FLOATING
*        INPUT-PACKED DECIMAL IN DECA, DECP AND SREG IN R10
*        OUTPUT-FLS, FLL IN RREG
C:CDE    LCI      11                SHORT
         STM,1    STREGS
         STH,B10  DECPS
         AI,B10   X'40000'
         STW,B10  RREG
         LH,B10   DECPS
         BAL,11   TENHEX
         LH,B4    RREG
         STW,B8   STREGS-1,B4
         B        C:CBF2
C:CDF    LCI      11                LONG
         STM,1    STREGS
         STH,B10  DECPS
         AI,B10   X'40000'
         STW,B10  RREG
         LH,B10   DECPS
         BAL,11   TENHEX
         LH,B4    RREG
         LCI      2
         STM,B8   STREGS-1,B4
         B        C:CBF2
TENHEX   LI,B2    0                 DEC TO FLOATING
         LI,B3    0
         LFI      0
         EXU      GETDIGC,B2
         LI,B4    0
         LW,B5    12,B2
         SLD,B4   4
         CI,B4    0
         BCS,3    FNDFRC
         AI,B3    1                 SUPRESS LEADING ZERO
         BDR,B1   %-4
         CI,B3    31
         BCS,3    %+5
         LI,B8    0
         LI,B9    0
TENHEX1  BAL,B7   STCFZ
         B        *11
         AI,B2    1
         B        TENHEX+3
FNDFRC   LW,B8    B4                INITIALIZE FLOATING
         LI,B9    0
         SLD,B8   -4
         LI,B8    X'41'
         SLD,B8   24
FNDFRC1  AI,B3    1                 CHECK NUMBER OF DIGITS PROCESSED
         CI,B3    31
         BCR,3    EXPROC
         BDR,B1   FNDFRC2
         AI,B2    1
         EXU      GETDIGC,B2
         LW,B5    12,B2
FNDFRC2  FML,B8   POTMU+4           NEXT DIGIT
         LI,B4    0
         SLD,B4   4
         LW,B6    B4
         BCR,3    FNDFRC1
         LI,B7    0
         SLD,B6   -4
         LI,B6    X'41'
         SLD,B6   24
         FAL,B8   B6
         B        FNDFRC1
EXPROC   CI,B10   0
         BCR,3    EXPROC1
         BCS,2    EXPROC2
         FML,B8   POTMU+4           NEGATIVE DECP
         BIR,B10  %+2
         B        EXPROC1
         CD,B8    MAXTST
         BCS,1    EXPROC+3
         BAL,B7   SCFBO
         B        *11
EXPROC1  LI,B4    X'F'              CHECK SIGN
         AND,B4   15
         CI,B4    X'D'
         BCR,3    %+3
         BAL,B7   STCFP
         B        *11
         LCD,B8   B8
         BAL,B7   STCFN
         B        *11
EXPROC2  FDL,B8   POTMU+4           POSITIVE DECP
         BCR,3    TENHEX1
         BDR,B10  %-2
         B        EXPROC1
*     ** PACKED DECIMAL TO BINARY
*        INPUT-PACKED DECIMAL IN DECA, DECP IN R10
*        OUTPUT-BINARY IN RREG
C:CDB    EQU      %                                                     C:CONV
         STW,R11  SAV11            STORE RETURN                         C:CONV
         STD,4    STREGS+4                                              C:CONV
         STD,6    STREGS+6                                              C:CONV
         LI,B7    0                                                     C:CONV
CDBA     EQU      %                                                     C:CONV
         AI,B10   X'40000'                                              C:CONV
         STW,B10  RREG                                                  C:CONV
         AND,B10  L(X'FFFF')                                            C:CONV
         BEZ      %+3                                                   C:CONV
         LCW,B4   B10                                                   C:CONV
         DSA      *B4                                                   C:CONV
         CD,12    ZROS                                                  C:CONV
         BNEZ     DECBIN                                                C:CONV
CDBB     EQU      %                                                     C:CONV
         CI,14    0                                                     C:CONV
         BEZ      CDBB2                                                 C:CONV
         CI,14    X'214'                                                C:CONV
         BG       DECBIN                                                C:CONV
         LW,B5    14                                                    C:CONV
         SLS,B5   4                                                     C:CONV
         CVA,B4   CVTBL                                                 C:CONV
         LW,B7    B4                                                    C:CONV
         MW,B6    TENSEV                                                C:CONV
CDBB2    EQU      %                                                     C:CONV
         LW,B5    15                                                    C:CONV
         CVA,B4   CVTBL                                                 C:CONV
         AW,B4    B7                                                    C:CONV
         BCS,4    DECBIN                                                C:CONV
CDBC     EQU      %                                                     C:CONV
         BEZ      CDBD                                                  C:CONV
         LI,B5    X'20'                                                 C:CONV
         CI,15    1                                                     C:CONV
         BAZ      DECBIN1                                               C:CONV
         AI,B5    -X'10'                                                C:CONV
         LCW,B4   B4                                                    C:CONV
DECBIN1  EQU      %                                                     C:CONV
         STB,B5   PSWD                                                  C:CONV
         LH,B7    RREG                                                  C:CONV
         AND,B7   =X'F'             KEEP WITHIN REGISTER SET
         STW,B4   STREGS,B7                                             C:CONV
         STW,B4   0,B7                                                  C:CONV
DECBIN2  EQU      %                                                     C:CONV
         LD,4     STREGS+4                                              C:CONV
         LD,6     STREGS+6                                              C:CONV
         LCF      PSWD                                                  C:CONV
         B        *SAV11           RETURN                               C:CONV
CDBD     EQU      %                                                     C:CONV
         LI,B5    0                                                     C:CONV
         B        DECBIN1                                               C:CONV
DECBIN   EQU      %                                                     C:CONV
         LI,B5    X'40'                                                 C:CONV
         STB,B5   PSWD                                                  C:CONV
         B        DECBIN2                                               C:CONV
*     ** BINARY TO PACKED DECIMAL
*        INPUT-BINARY IN SREG
*        OUTPUT-PACKED DECIMAL IN DECA, DECP IN R10
C:CBD    EQU      %                                                     C:CONV
         STW,R11  SAV11            STORE RETURN                         C:CONV
         STD,8    STREGS+8                                              C:CONV
         STH,B10  DECPS                                                 C:CONV
         LH,B10   B10                                                   C:CONV
         AI,B10   4                                                     C:CONV
         LW,B9    *B10                                                  C:CONV
BDCOM    RES      0                                                     C:CONV
         STCF     PSWD                                                  C:CONV
         BEZ      BDZER                                                 C:CONV
         BG       BDCOM0                                                C:CONV
         LCW,B9   B9                                                    C:CONV
BDCOM0   EQU      %                                                     C:CONV
         LI,8     0                                                     C:CONV
         LI,12    0                                                     C:CONV
         LI,13    0                                                     C:CONV
         LI,14    0                                                     C:CONV
         DW,8     TENSEV                                                C:CONV
         BEZ      BDCOM1                                                C:CONV
         LW,14    9                                                     C:CONV
         CVS,14   CVTBL                                                 C:CONV
         SLS,15   -4                                                    C:CONV
         STW,15   14                                                    C:CONV
BDCOM1   EQU      %                                                     C:CONV
         CVS,8    CVTBL                                                 C:CONV
         STW,9    15                                                    C:CONV
         AND,15   L(X'FFFFFFFC')                                        C:CONV
BDCOM2   RES      0                                                     C:CONV
         LH,10    DECPS                                                 C:CONV
         BEZ      %+2                                                   C:CONV
         DSA      *10                                                   C:CONV
         LD,8     STREGS+8                                              C:CONV
         LCF      PSWD                                                  C:CONV
         BGEZ     *SAV11           RETURN                               C:CONV
         AI,15    1                                                     C:CONV
         B        *SAV11           RETURN                               C:CONV
BDZER    RES      0                                                     C:CONV
         DL,1     =X'0C000000'                                          C:CONV
         B        BDCOM2                                                C:CONV
*     ** BINARY TO DECIMAL DISPLAY
*        INPUT-BINARY IN SREG
*        OUTPUT-DECIMAL DISPLAY IN BYTE ADDRESS POINTED BY R10
C:DBD    LCI      11                BINARY TO DECIMAL DISPLAY
         STM,1    STREGS
         LI,B9    0                                                     C:CONV
         STW,B9   DECPS             NO DECIMALS                         C:CONV
         LI,R11   DBD:RTN                                               C:CONV
         STW,R11  SAV11            STORE RETURN                         C:CONV
         LW,B9    B6                                                    C:CONV
         B        BDCOM                                                 C:CONV
DBD:RTN  RES      0                                                     C:CONV
         LW,B1    STREGS+9
         UNPK,6   0,B1
         BAL,B7   SETSGN
         AI,B1    10
         BAL,B7   SETF
         B        C:CBF2
**     * FLOATING TO DECIMAL DISPLAY
*        INPUT-FLS IN R8 OR FLL IN R8, R9
*        OUTPUT-DECIMAL DISPLAY IN BYTE ADDRESS POINTED BY R10
C:DED    LCI      11             SHORT
         STM,1    STREGS
         LI,B9    0
         LI,B6    -23
         STW,B6   SVDSA
         LI,B6    7
         STW,B6   ADJSTE
         BAL,11   HEXTEN
         DSA      *SVDSA
         LW,B1    STREGS+9
         AI,B1    1
         UNPK,5   0,B1
         B        C:DBD1
C:DFD    LCI      11          LONG
         STM,1    STREGS
         LI,B6    -15
         STW,B6   SVDSA
         LI,B6    15
         STW,B6   ADJSTE
         BAL,11   HEXTEN
         DSA      *SVDSA
         LW,B1    STREGS+9
         AI,B1    1
         UNPK,9   0,B1
C:DBD1   BAL,B7   SETSGN
         AI,B1    2
         LB,B4    0,B1
         LI,B5    X'4B'             DECIMAL POINT
         STB,B5   0,B1
         AI,B1    -1
         STB,B4   0,B1
         AI,B1    1
         AW,B1    ADJSTE
         BAL,B7   SETF
         LB,B3    PSWD
         BCS,3    %+3
         LW,B8    B10
         B        %+5
         LCW,B8   B10
         SW,B8    SVDSA
         AW,B8    ADJSTE            FIND EXPONENT
         BCS,1    %+3
         LI,B6    X'C54E'
         B        %+3
         LCW,B8   B8
         LI,B6    X'C560'
         CVS,B8   CVTBL
         SLS,B9   20
         SLD,B8   4
         SLS,B8   4
         SLD,B8   4
         LI,B9    X'F0F0'
         OR,B8    B9
         STH,B8   B6
         SCS,B6   -16
         LW,B5    B1
         LI,B4    4
         STB,B4   B5
         LI,B4    24
         MBS,B4   0
         B        C:CBF2
SETF     LB,B4    0,B1              CHANGE C OR D TO F
         LI,B5    X'F0'
         OR,B4    B5
         STB,B4   0,B1
         AI,B1    1
         B        *B7
SETSGN   LW,B1    STREGS+9          SIGN
         LI,B4    X'F'
         AND,B4   15
         CI,B4    X'C'
         BCS,3    %+3
         LI,B4    X'4E'
         B        %+2
         LI,B4    X'60'
         STB,B4   0,B1
         B        *B7
*  DOUBLE TO SINGLE PRECISION FLOATING
*  INPUT - POINTER TO FLD REGISTER PAIR IN R10
C:CFE    LCI      11
         STM,1    STREGS
         STW,B10  RREG
         LD,B8    *B10              LOAD DP VALUE
         AI,B8    0                 TEST OPERAND SIGN
         BGZ      CDS1              POSITIVE
         BEZ      CDS4              ZERO
*              OPERAND NEGATIVE
         BAL,B7   STCFN             SET CONTINUATION CODE NEGATIVE
         AD,B8    NEGROUND          ROUND IN 2ND WORD  (CAN'T OVFL)
         CW,B8    =X'00FFFFFF'      IF STILL NORMALIZED, NO EXP CHANGE
         BANZ     CDS5               NEEDED -- EXIT
*              NEGATIVE, EXPONENT CHANGE
         SW,B8    =X'00100000'      DECREMENT EXP, MANTISSA = X'F00000'
         BNOV     CDS5              TYPICAL CASE = NO OVERFLOW - EXIT
*              NEGATIVE, OVERFLOW
         LCW,B8   MAXPOS            MINUS INFINITY
         B        CDS2
*              OPERAND POSITIVE
CDS1     BAL,B7   STCFP             SET CONDITION CODE POSITIVE
         AD,B8    POSROUND          ROUND IN 2ND WORD
         BNOV     CDS3
*              POSITIVE, OVERFLOW
         LW,B8    MAXPOS            PLUS INFINITY
*              POS & NEG OVERFLOW
CDS2     FAS,B8   B8                PROVOKE OVERFLOW
         B        CDS5              EXIT
*              POSITIVE, NO OVERFLOW
CDS3     CW,B8    =X'00FFFFFF'      IF STILL NORMALIZED, NO EXP CHANGE
         BANZ     CDS5               NEEDED -- EXIT
*              POSITIVE, EXPONENT CHANGE
         AW,B8    =X'00100000'      INCREMENT EXP, MANTISSA = X'100000'
         B        CDS5              EXIT  (PREV. ADD CAN'T OVERFLOW)
*              OPERAND ZERO
CDS4     BAL,B7   STCFZ             SET CONDITION CODE ZERO
CDS5     LW,B6    RREG
         STW,B8   STREGS-1,B6
         B        C:CBF2
         BOUND    8
POSROUND DATA     X'00000000',X'80000000'
NEGROUND DATA     X'00000000',X'7FFFFFFF'
MAXPOS   EQU      NEGROUND+1        =X'7FFFFFFF'
         END
