*DECK,DCFTOD
          IDENT  DC$FTOD     CONVERTS SINGLE OR DOUBLE PRECISION BINARY 
                             FLOATING PT TO DISPLAY CODE. 
          ENTRY  DC$FTOD
  
          ENTRY  DC$DBLA
                             PERFORM DOUBLE PRECISION ADDITION. 
  
*#
* *   DC$FTOD - FLTNG PT TO DSPLY CDE CINVERSION PAGE 1 
* *   C C CHOW      5/16/74 
* 
* DC  PURPOSE 
*       CONVERT SINGLE OR DOUBLE PRECISION FLOATING PT NUMBER TO
*     DISPLAY CODE. 
* 
* DC  LANGUAGE
*       CP COMPASS
* 
* DC  ENTRY CONDITIONS
*       DC$CMFD 
*         ADDRSR  = LOCATION OF FLOATING PT SOURCE. 
*         DBLFGSR = 0 IF SINGLE PRECISION. 1 IF DOUBLE. 
* 
* DC  EXIT CONDITIONS 
*       NORMAL: 
*         DC$CMFD 
*           DISPCTG = RESULTING DISPLAY CODE. 20 DIGITS.
*           DECPTTG = DEC PT POSITION OF RESULTING DISPLAY CODE.
*           SGNPLTG = SIGN OF DATA. 0 -VE. 1 +VE. 
*           CRETURN = RETURN CODE IS 0. 
*       ERROR:  
*         DC$CMFD 
*           CRETURN = 667B. 
* 
* DC  CALLING ROUTINES
*       DC$CONV - CDCS 1.0 CONVERSION ROUTINES. 
* 
* DC  NON-LOCAL VARIABLES 
*       DC$CM10 - COMMON BLOCK CONTAINING POWERS OF 10. 
* 
* DC  DESCRIPTIONS
*       INITIALIZE "CRETURN" TO 0.
*       CHECK SOURCE DATA FOR INDEFINITE OR OUT OF RANGE. IF YES, SET 
*     "CRETURN" AND RETURN. 
*       CHECK SOURCE SIGN AND SET "SGNPLTG". COMPLIMENT SOURCE IF -VE.
*     WE WILL BE WORKING WITH +VE NUMBERS.
*       SCALE AND CONVERT SOURCE DATA INTO 19 DISPLAY CODE NUMERIC CHARS
*     STORED IN 19 CONTIGUOUS LOCATIONS STARTING AT ADDRESS ("SCRATCH"
*     + 1). DISPLAY CODE 0 IS STORED INTO LOC "SCRATCH" TO TAKE CARE OF 
*     EXTREME CASE ROUNDING. ROUND THE NUMERIC STRING.
*       SET "DECPTTG" TO INDICATE DECIMAL PT POSITION FROM TOP DIGIT. 
*       MOVE DATA STRING IN ARRAY "SCRATCH" INTO "DISPCTG" CHAR BY CHAR 
*     AND RETURN. 
* 
* DC  ACKNOWLEDGEMENTS
*       THIS ROUTINE IS EXTRACTED AND MODIFIED FROM "QU2" ROUTINE 
*     WITH IDENT "QU2KOD".
*#
  
  
          USE    /DC$CMFD/   COMMON BLOCK FOR FLOATING TO DISPLAY.
 ADDRSR   BSS    1           LOCATION OF SOURCE.
 DBLFGSR  BSS    1           1 IMPLIES SOURCE IS DOUBLE PRECISION.
 DISPCTG  BSS    2           TO CONTAIN RESULTING 18 DISPLAY CODE CHARS.
 DECPTTG  BSS    1           TO CONTAIN DECIMAL POSITION FOR RESULT.
 SGNPLTG  BSS    1           TO CONTAIN SIGN OF THE NUMBER. 1 +VE.
 CRETURN  BSS    1           RETURN CODE. 
          USE    /DC$CM10/   POWERS OF 10 COMMON BLOCK. 
 TEN0     BSS    16D
 BIG10    BSS    15D
 LIL10    BSS    15D
          USE    0
  
 LG102    DATA   17172321011520476750B
 TENMU    DATA   17170631463146314632B
          DATA   20000000000000000012B
 SCRATCH  BSS    20D         TEMP STORE FOR THE 20 DISPLAY CODE CHARS.
  
 DC$FTOD  DATA   0           FLOATING TO DISPLAY ENTRY PT.
          SX6    B0 
          SA6    CRETURN     SET RETURN CODE TO 0.
          SB6    1           SET B6 TO 1 FOR LATER USE. 
          SA5    ADDRSR      ADDRESS OF SOURCE INTO X5. 
          SA1    X5          SOURCE INTO X1.
          SA3    DBLFGSR     DOUBLE FLAG INTO X3. 
          ID     X1,INDEF    TEST FOR INDEFINITE. 
          OR     X1,RANGE    TEST FOR OUT OF RANGE. 
          MX2    0           X2 WILL CONTAIN LOW HALF OF DP NUMBER. 
          ZR     X3,SP       ZERO - SINGLE PRECISION SOURCE.
          SA4    X5+1        LOW PART OF DP INTO X4.
          ID     X4,INDEF 
          OR     X4,RANGE 
          DX2    X1+X4       LOWER PART OF DP INTO X2.
          FX1    X1+X4       UPPER PART OF DP INTO X1.
 SP       SX6    1           X6 WILL CONTAIN SIGN.  PRESET TO 1.
          PL     X1,POS      JMP IF DATA +VE. 
          SX6    B0 
          BX1    -X1         COMPLIMENT X1 AND X2.
          BX3    X2 
          AX2    73B
          BX2    X2-X3
 POS      SA6    SGNPLTG     STORE SIGN.
          NX1    B5,X1       BEGIN SCALING DATA.
          MX0    70B
          ZR     X1,ZROS     JMP IF DATA ZERO 
          SA4    LG102       UN-NORMALIZED LOG BASE 10 OF 2 
          UX3    B5,X1       EXPONENT TO B5 
          SX5    B5+57B 
          PX3    X5          PACK EXPONENT AS INTEGER 
          FX6    X4*X3
          SB4    X6          SET INITIAL EXPONENT OF 10 
          SA4    BIG10-1     START OF POSITIVE POWERS 
          SX6    -B4
          PL     X6,POSX     JMP IF EXPONENT IS POSITIVE
          BX3    -X0
          IX7    X3-X6
          SA4    LIL10-1     START OF NEGATIVE POWERS 
          BX6    X7-X3
 POSX     BX7    -X0*X6      FOR SMALL POSITIVE SCALING 
          AX6    4           FOR LARGE SCALING
          SB1    X7+TEN0
          SB5    X6 
          SX3    B0 
          ZR     X6,SDONE    JMP IF NO LARGE SCALING
 SLOOP    SX4    B6 
          BX7    X4*X6       MASK OFF NEXT POWER OF 10 BIT
          AX6    1
          SA4    A4+B6       FETCH UPPER PART BU
          ZR     X7,SLOOP    LOOP IF BIT IS ZERO
          SA5    A4+5        FETCH MIDDLE PART BM 
          SB5    X6 
          FX0    X4*X3        1. BU*AL   SINGLE LOWER 
          DX6    X5*X1        2. BM*AU   DOUBLE LOWER 
          FX7    X0+X6        3. 1 + 2   SL 
          DX3    X4*X2        4. BU*AM   DL 
          FX0    X5*X2        5. BM*AM   SL 
          FX6    X3+X0        6. 4 + 5   SL 
          FX3    X4*X2        7. BU*AM   SINGLE MIDDLE
          FX0    X5*X1        8. AM*BU   SM 
          SA5    A5+5           FETCH BL
          RX2    X7+X6        9. 3 + 6   SL 
          FX6    X5*X1       10. BL*AU   SL 
          DX7    X3+X0       11. 7 + 8   DL 
          RX5    X2+X6       12. 9+10    SL 
          DX6    X4*X1       13. AU*BU   DOUBLE MIDDLE
          FX2    X3+X0       14. 7 + 8   SM 
          FX3    X4*X1       15. AU*BU   SINGLE UPPER 
          RX0    X7+X5       16. 11+12   SL 
          DX4    X6+X2       17. 13+14   DL 
          FX5    X6+X2       18. 13+14   SM 
          RX7    X0+X4       19. 16+17   SL 
          FX4    X5+X7       20. 18+19   SM 
          DX6    X5+X7       21. 18+19   DL 
          FX1    X3+X4       22. 15+20   SU 
          DX5    X3+X4       23. 15+20   DM 
          FX2    X6+X5       24. 21+23   SM 
          DX3    X6+X5       25. 21+23   DL 
          SX6    B5 
 SDONE    NZ     X6,SLOOP    LOOP FOR FURTHER SCALING 
          SA4    B1          FETCH 10**N S
          FX6    X4*X3        1.  S*AL   SL 
 SMORE    DX0    X4*X2        2.  S*AM   DL 
          RX3    X0+X6        3. 1 + 2   SL 
          DX7    X4*X1        4.  S*AU   DM 
          FX2    X4*X2        5.  S*AM   SM 
          DX5    X7+X2        6. 4 + 5   DL 
          RX0    X3+X5        7. 3 + 6   SL 
          FX3    X7+X2        8. 4 + 5   SM 
          FX6    X0+X3        9. 7 + 8   SM 
          FX7    X4*X1       10.  S*AU   SU 
          DX5    X0+X3       11. 7 + 8   DL 
          FX1    X7+X6       12. 10+9    SU 
          DX4    X7+X6       13. 10+9    DM 
          FX2    X4+X5       14. 13+11   SM 
          DX3    X4+X5       15. 13+11   DL 
          SA4    TEN0+1      FETCH 10**1
          SA5    A4-B6       FETCH 10**0
          IX6    X1-X4
          NG     X6,LT10     JMP IF RESULT LT 10
          SB1    TEN0+15     SET FOR 10**15 
          SA4    LIL10-1     SET FOR NEGATIVE SCALING 
          SX6    B6 
          SB4    B4+B6       INCREMENT EXPONENT OF 10 
          EQ     SLOOP       LOOP TO CONTINUE SCALING 
 LT10     IX6    X1-X5
          PL     X6,GE1      JMP IF RESULT GE 1 
          FX6    X4*X3
          ZR     X1,ZROS     JMP IF RESULT IS ZERO
          SB4    B4-B6
          EQ     SMORE       LOOP TO CONTINUE SCALING 
 GE1      UX1    B5,X1       REPOSITION 108+ HIGH BITS OF X1,X2,X3
          SB1    B5+66B      X1 WILL CONTAIN 54+ HIGH BITS
          MX0    6           RIGHT JUSTIFIED
          LX1    B1,X1       X2 WILL CONTAIN 54 LOW BITS
          SB1    B5+102B     LEFT JUSTIFIED 
          UX2    B0,X2
          LX2    B1,X2
          MX7    60B
          BX4    -X7*X2 
          IX1    X1+X4
          UX3    B0,X3
          BX2    X7*X2
          SB1    B5+22B 
          LX3    B1,X3
          MX7    66B
          BX3    X3*X7
          IX2    X2+X3       SCALING COMPLETED
          SB7    B4+B6       N FOR .XXXX*10**N
          SA0    SCRATCH     TEMPORARY STORAGE FOR OUTPUT.
          SX6    33B
          SA6    A0          STORE ZERO AS 1ST DIGIT TO PREPARE FOR 
                             EXTREME CASE IN ROUNDING.
          SA0    A0+B6
         SB1     19D         B1 CONTAINS LENGTH REMAINING TO BE SET.
          RJ     DPCH        CONVERT AND STORE FRACTION STRING
          AX1    66B         ROUND THE DATA 
          SA3    A0-B6       FETCH LAST CHAR
* 
* IN FOLLOWING STATEMENT, LOGICALLY WE SHOULD SUBTRACT 5 INSTEAD OF 4.
* I USE 4 BECAUSE WITH 5, SOMETIMES IT FAILS TO ROUND IF LAST DIGIT IS
* 5. SO IF IT STARTS TO ROUND WHEN IT SHOULD NOT, THIS MAY BE THE 
* PROBLEM.
* 
          SX2    X1-4 
          NG     X2,NXP3     JMP IF NO ROUND
          SB4    33B
 RNA      SX6    X3+B6
          SB5    X3-44B 
          SA6    A3          STORE INCREMENTED CHAR 
          NG     B5,NXP3     JMP IF LAST WAS NOT 9
          SX6    B4 
          SA3    A3-B6       FETCH NEXT CHAR
 RNB      SA6    A6          OVER-STORE ZERO
          EQ     RNA         LOOP TO CONTINUE CARRY ON 9
 NXP3     SX1    B7+B6
          BX6    X1 
          SA6    DECPTTG     STORE DECIMAL POSITION.
          EQ     CDONE
 ZROS     BSS    0           SOURCE VALUE 0. FILL TARGET WITH ZEROS.
          SX7    33B
          SA7    SCRATCH
          MX6    0
          SA6    DECPTTG
          SB1    19D         19 MORE ZEROS TO GO. 
 ZLOOP    SA7    A7+B6
          SB1    B1-B6
          GT     B1,B0,ZLOOP
          EQ     CDONE
 DPCH     BSS    1           CONVERT B1 DIGITS TO DISPLAY CODE
          MX7    54 
 DPC      LX4    B6,X2       2*LOWER
          BX5    -X0*X1      MASK OFF DIGIT 
          AX1    66B         POSITION DIGIT 
          LX2    3           8*LOWER
          SX6    X1+33B      DISPLAY CODE OF DIGIT
          IX3    X2+X4       10*LOWER 
          LX4    B6,X5       2*UPPER
          BX2    X7*X3       REMOVE CARRY FROM LOWER
          LX5    3           8*UPPER
          SA6    A0          STORE CHARACTER
          BX3    -X7*X3      CARRY FROM LOWER 
          IX1    X5+X4       10*UPPER 
          SB1    B1-B6       DECREMENT COUNT
          SA0    A0+B6       ADVANCE POSITION IN OUTPUT STRING
          IX1    X1+X3       10*UPPER+CARRY 
          LT     B0,B1,DPC   LOOP 
          EQ     DPCH        RETURN 
 CDONE    SA0    SCRATCH     PACK CHARS FOR OUTPUT
          SB7    60          NR BITS PER WORD 
          SB2    6           NR BITS PER CHAR 
          SB5    B2          SHIFT CONTROL
          MX6    0           ZERO OUTPUT WORD 
          SB3    B0          OUTPUT CHAR COUNTER
          SB4    20D         NR OUTPUT CHARS DESIRED
          SX4    DISPCTG
 PLOOP    SA1    A0+B3       PICK UP CHAR 
          SB1    B7-B5       CALCULATE SHIFT REQUIRED 
          LX1    B1,X1       POSITION CHAR
          IX6    X1+X6       ADD CHAR 
          SB3    B3+B6       INCR OUTPUT CHAR COUNTER 
          EQ     B3,B4,STORE RETURN IF DONE PACKING 
          SB5    B5+B2       INCR SHIFT CONTROL 
          LE     B5,B7,PLOOP LOOP FILLING OUTPUT WORD 
          SB5    B2          RESET SHIFT CONTROL
          SA6    X4          STORE OUTPUT WORD
          SX4    X4+B6       NEXT OUTPUT WORD 
          MX6    0           ZERO OUTPUT WORD 
          EQ     PLOOP       CONTINUE PACKING 
 STORE    SA6    X4          STORE LAST OUTPUT WORD 
          EQ     DC$FTOD
 INDEF    BSS    0
 RANGE    BSS    0
          SX7    667B 
          SA7    CRETURN     SET RETURN CODE TO INDICATE INDEFINITE OR
                             OUT OF RANGE.
          EQ     DC$FTOD
 DC$DBLA  EJECT 
*#
* *   DC$DBLA - DOUBLE PRECISION ADDITION.       PAGE 1 
* *   J.W.PERRY              1/22/75
* 
* DC  PURPOSE 
*     ADD TWO DOUBLE PRECISION VALUES.
* DC  LANGUAGE
*     CP COMPASS
* DC  ENTRY CONDITIONS
*     FORMAL PARAMETERS 1 -- HIGH ORDER WORD OF FIRST ADDEND. 
*     FORMAL PARAMETERS 2 -- LOW ORDER WORD OF FIRST ADDEND.
*     FORMAL PARAMETERS 3 -- HIGH ORDER WORD OF SECOND ADDEND.
*     FORMAL PARAMETERS 4 -- LOW ORDER WORD OF SECOND ADDEND. 
*       ADDENDS ARE STANDARD DOUBLE PRECISION REPRESENTATION
*     (FLOATING, PACKED, NORMALIZED VALUES.)
* DC  EXIT CONDITIONS 
*     FORMAL PARAMETER 5 -- HIGH ORDER OF SUM.
*     FORMAL PARAMETER 6 -- LOW ORDER WORD OF SUM.
*       SUM IS IN STANDARD DOUBLE PRECESION REPRESENTATION. 
* DC  CALLING ROUTINE 
*     DC$CONV 
* DC  NON-LOCAL VARIABLES 
*     NONE
* DC  REGISTERS PRESERVED 
*     A0
*#
 DC$DBLA  BSSZ   1
          SB1    1
          SA5    A1 
          SA1    X5          A HIGH, PARAM 1
          SA5    A5+B1
          SA2    X5          A LOW, PARAM 2 
          SA5    A5+B1
          SA3    X5          B HIGH, PARAM 3
          SA5    A5+B1
          SA4    X5          B LOW, PARAM 4 
          FX0    X1+X3       A HIGH + B HIGH, HIGH ORDER
          DX1    X1+X3       A HIGH + B HIGH, LOW ORDER 
          NX3    B0,X0       NORMALIZE A HIGH + B HIGH, HIGH
          FX2    X2+X4       A LOW + B LOW
          FX0    X1+X2       SUM OF LOW ORDERS
          FX1    X0+X3       LOW SUM + NORMALIZED HIGH, HIGH
          NX2    B0,X1       RENORMALIZE HIGH 
          DX3    X0+X3       LOW SUM + NORMALIZED HIGH, LOW 
          NX0    B0,X3       NORMALIZE LOW
          FX6    X0+X2       C HIGH, HIGH ORDER RESULT
          DX7    X0+X2       C LOW, LOW ORDER RESULT
          SA1    A5+B1
          SA6    X1 
          SA2    A1+B1
          SA7    X2 
          EQ     DC$DBLA
          END 
