*DECK C$R22XF 
          IDENT  C$R22XF
          TITLE  CBR22XF -  REGISTER COMP-2 TO EXTERNAL FLOAT FORMAT
          COMMENT  REGISTER COMP-2 TO EXTERNAL FLOAT FORMAT 
          B1=1
 *SAVES   OPSYN  NIL
          SPACE  4
**        C.R22XF -  REGISTER COMP-2 TO EXTERNAL FLOAT FORMAT 
* 
*         X1 = REGISTER COMP-2 VALUE
*         B3 = SCALING FACTOR 
*                (I.E. TRUE VALUE OF SOURCE IS X1 * 10'(-B3).)
*         B4 = BCP OF DESTINATION FIELD 
*                (LENGTH OF DESTINATION FIELD IS 23 CHARACTERS) 
*         B5 = FWA OF DESTINATION FIELD 
*         RJ     C.R22XF
* 
*         SETS SOURCE:  
*                NORMALLY,   +.999999999999999E+9999
*                                  (+ MEANS + OR -, 9 MEANS 0_9)
*                ZERO,       *.000000000000000E+0000
*                                  (* MEANS + OR -) 
*                INFINITE,   (***$INFINITE VALUE***)
*                                  ($ MEANS + OR -) 
*                TRUE INDEFINITE  (MANTISSA = 0000000000000000B), 
*                            (**$INDEFINITE VALUE**)
*                                  ($ MEANS + OR -) 
*                NONSTANDARD INDEFINITE  (MANTISSA " 0000000000000000B),
*                            $INDEF=7777777777777777
*                                  ($ MEANS + OR -,  7 MEANS 0 _ 7) 
* 
*         USES-  X  0 1 2 3 4 5 6 7 
*                A  0 1 2 3 4 5 6 7 
*                B    * 2 3 4 5 6 7    * B1=1 
  
*    *** TEMPORARY NOTE *** 
*         X2 IS NOT NOW USED IN CASE IT IS NEEDED FOR 
*         DOUBLE PRECISION ARITHMETIC.
  
  
          ENTRY  C.R22XF
 C.R22XF  DATA   0
  
*      MAKE SOURCE VALUE (N) POSITIVE 
  
          BX0    X1 
          AX0    59 
          BX1    X1-X0       ABSOLUTE VALUE OF N
  
*      IF INFINITE OR INDEFINITE,  GO HANDLE
  
          ID     X1,INDEF    IF BITS 59-48 = 1777B
          OR     X1,INFINITE IF BITS 59-48 = 3777B
  
*      IF ZERO VALUE,  GO HANDLE
  
          UX4    X1          0000XXXXXXXXXXXXXXXXB
          ZR     X4,ZERO
  
*      SET UP SIGN CHARACTER FOR NORMAL CASE
  
          SX4    B1 
          BX5    X4*X0       1 IFF SOURCE IS NEGATIVE 
          SX6    X5+1R+      SIGN CHARACTER 
          ERRNZ  1+1R+-1R-   (-) MUST EQUAL (+) + 1 
          LX6    6           ::::::::+: 
          SX6    X6+1R.      ::::::::+. 
          LX6    8*6         +.:::::::: 
          SA6    DEST 
  
*      IF VALUE TOO SMALL TO NORMALIZE,  GO HANDLE
  
          UX3    B7,X1
          PX3    X3 
          NX4    B6,X3       B6 = SHIFT NEEDED TO NORMALIZE 
          SB7    B7+1777B    B7 = MAXIMUM POSSIBLE SHIFT
          LT     B7,B6,SMALL
          ZR     B7,SMALL 
  
          NX1    X1          NORMALIZE
  
*      ENSURE 1.0 @ N < 10
  
 L1       SX7    -B3         ORIGINAL EXPONENT
          SB7    IMAX 
 L2       SA3    A+B7        A[I] 
          IX0    X1-X3
          NG     X0,L3       IF N < A[I],  SKIP 
          RX1    X1/X3       N = N / A[I] 
          SA4    POWER+B7    POWER[I] 
          IX7    X7+X4       EXPONENT = EXPONENT + POWER[I] 
 L3       SB7    B7-1        I = I - 1
          PL     B7,L2       IF I \ 0,  LOOP
  
          SB7    IMAX        I = IMAX 
 L4       SA3    B+B7        B[I] 
          IX0    X1-X3
          PL     X0,L5       IF N \ B[I],  SKIP 
          SA3    A+B7        A[I] 
          SA4    POWER+B7    POWER[I] 
          RX1    X1*X3       N = N * A[I] 
          IX7    X7-X4       EXPONENT = EXPONENT - POWER[I] 
 L5       SB7    B7-1        I = I - 1
          PL     B7,L4       IF I \ 0,  LOOP
          SX7    X7+B1       ADJUST FOR DISPLAYING NO. AS +.999...
  
  
*      CONVERT TO NUMERIC DISPLAY 
  
          SB3    -17         CONVERT 17 MORE DIGITS TO RIGHT OF POINT 
*         X1 = VALUE
          BX2    X0-X0       X2 = 0 
          RJ     =X_C.R4S18 
         *SAVES  X7,B4,B5,A6
*         X1 = MOST SIGNIFICANT 8 DIGITS:   00ABCDEFGH
*         X2 = LEAST SIGNIFICANT 8 DIGITS:  IJKLMNOPQR
*         X7 = EXPONENT 
*         B4 = BCP OF DESTINATION FIELD 
*         B5 = FWA OF DESTINATION FIELD 
          SA5    DEST        +.::::::::    OR    -.:::::::: 
          MX0    -8*6        77770000000000000000B
          BX6    -X0*X1      ::ABCDEFGH 
          IX6    X5+X6       +.ABCDEFGH 
          SA6    A5 
  
*      CONVERT EXPONENT TO NUMERIC DISPLAY AND PUT IN PICTURE 
  
          BX0    X7          EXPONENT 
          AX0    59 
          BX1    X7-X0       ABSOLUTE VALUE OF EXPONENT 
          SX4    1S6
          BX5    X0*X4       1 IFF EXPONENT IS NEGATIVE 
          SX6    X5+2LE+
          BX7    X2          IJKLMNOPQR 
          RJ     =X_C.R1U06 
         *SAVES  X6,X7,B4,B5,A6 
*         X1 = EXPONENT:  0000001234
*         X6 =     :::::::E+:   
*         X7 =     IJKLMNOPQR 
*         B4 = BCP OF DESTINATION FIELD 
*         B5 = FWA OF DESTINATION FIELD 
*         A6 = DEST 
          MX0    7*6         77777777777777000000B
          BX7    X0*X7       IJKLMNO::: 
          IX6    X6+X7       IJKLMNOE+: 
          MX0    -6          77777777777777777700B
          LX1    -3*6        2340000001 
          BX5    -X0*X1      :::::::::1 
          IX6    X6+X5       IJKLMNOE+1 
          SA6    A6+B1       STORE INTO DEST+1
          BX7    X1          2340000001 
          SA7    A6+B1       STORE INTO DEST+2
  
*      MOVE THE SETUP FIELD TO THE ACTUAL DESTINATION 
  
 L6       SB3    B5          FWA OF DESTINATION FIELD 
*         B4 = BCP OF DESTINATION FIELD 
          SB5    DEST        FWA OF SOURCE
          SB6    B0          BCP OF SOURCE
          BX2    X0-X0       APPEND/PREFIX NO BLANKS
          SB7    23          23 CHARACTERS TO MOVE
          RJ     =X_C.MOVE
  
*      EXIT 
  
          EQ     C.R22XF
          TITLE  INDEF -  HANDLE INDEFINITE VALUES
**        INDEF -  HANDLE INDEFINITE VALUES 
* 
*         X0 = SIGN 
*         X1 = VALUE
*         B4 = BCP OF DESTINATION FIELD 
*         B5 = FWA OF DESTINATION FIELD 
  
  
 INDEF    MX5    12          77770000000000000000B
          BX4    -X5*X1 
          NZ     X4,INDEF1   IF UNUSUAL CASE
          SA3    INDFDEST    (**+INDEFI 
          SX4    B1 
          BX5    X0*X4       1 IFF SOURCE IS NEGATIVE 
          LX5    6*6
          IX6    X3+X5       (**-INDEFI 
          SA6    DEST        STORE FIRST WORD 
          SA3    A3+B1       NITE VALUE 
          BX6    X3 
          SA6    A6+B1       STORE SECOND WORD
          SA3    A3+B1       **)
          BX6    X3 
          SA6    A6+B1       STORE THIRD WORD 
          EQ     L6          GO STORE FIELD 
  
  
*                            SET UP +INDEF=ABCDEFGHIJKLMNOP 
 INDEF1   SA3    =10H00+INDEF=0 
          SX4    B1 
          BX5    X0*X4       1 IFF SOURCE IS NEGATIVE 
          LX5    7*6
          IX6    X3+X5       00-INDEF=0 
          MX0    -3 
          LX1    12+3        RIGHT-JUSTIFY FIRST OCTAL DIGIT
          BX4    -X0*X1      ISOLATE FIRST OCTAL DIGIT
          IX6    X6+X4       00-INDEF=A 
          LX1    3           RIGHT-JUSTIFY SECOND OCTAL DIGIT 
          BX4    -X0*X1      ISOLATE SECOND OCTAL DIGIT 
          LX6    6           0-INDEF=A0 
          IX6    X6+X4       0-INDEF=AB 
          LX1    3           RIGHT-JUSTIFY THIRD OCTAL DIGIT
          BX4    -X0*X1      ISOLATE THIRD OCTAL DIGIT
          LX6    6           -INDEF=AB0 
          IX6    X6+X4       -INDEF=ABC 
          SA6    DEST        STORE FIRST WORD 
          SB7    10          10 OCTAL DIGITS IN NEXT WORD 
          SA3    =X_C.ZEROS  0000000000 
          BX6    X3          0000000000 
 INDEF2   LX6    6           000000DEF0   (E.G.)
          SB7    B7-1        DECREMENT COUNT
          LX1    3           RIGHT-JUSTIFY NEXT OCTAL DIGIT 
          BX4    -X0*X3      ISOLATE OCTAL DIGIT
          IX6    X6+X4       000000DEFG   (E.G.)
          NZ     B7,INDEF2   IF MORE DIGITS TO CONVERT,  LOOP 
          SA6    A6+B1       STORE SECOND WORD
          BX6    X3          0000000000 
  
          DUP    3,4
          LX1    3           RIGHT-JUSTIFY NEXT OCTAL DIGIT 
          BX4    -X0*X1      ISOLATE OCTAL DIGIT
          LX6    6           MAKE ROOM FOR DIGIT
          IX6    X6+X4       CONVERT TO DISPLAY 
  
          LX6    7*6         NOP0000000 
          SA6    A6+B1       STORE THIRD WORD 
          EQ     L6          GO STORE FIELD 
          TITLE  INFINITE -  HANDLE POSSIBLE INFINITE VALUE 
**        INFINITE -  HANDLE POSSIBLE INFINITE VALUE
* 
*         X1 = SOURCE 
*                EXPONENT IS 3777B, BUT VALUE MAY BE LEGITIMATE NUMBER. 
*         X0 = SIGN OF SOURCE 
*         B4 = BCP OF DESTINATION FIELD 
*         B5 = FWA DESTINATION FIELD
  
  
 INFINITE UX4    X1          0000XXXXXXXXXXXXXXXXB
          NZ     X4,INFIN1   IF UNUSUAL CASE
          SA3    INFNDEST    (***+INFIN 
          SX4    B1 
          BX5    X0*X5       1 IFF SOURCE IS NEGATIVE 
          LX5    5*6
          IX6    X3+X5       (***-INFIN 
          SA6    DEST        STORE FIRST WORD 
          SA3    A3+B1       ITE VALUE* 
          BX6    X3 
          SA6    A6+B1       STORE SECOND WORD
          SA3    A3+B1       **)
          BX6    X3 
          SA6    A6+B1       STORE THIRD WORD 
          EQ     L6          GO MOVE FIELD
  
  
 INFIN1   UX3    B7,X1       B7 = 1777B 
          NX5    B6,X3       B6 = SHIFT NEEDED TO NORMALIZE 
          ZR     B6,INFIN2   IF ALREADY NORMALIZED
*      WE CANNOT NORMALIZE BECAUSE IT WOULD GET A MODE ERROR
          SB7    B7-B6       SIMULATE A NORMALIZE 
          PX1    B7,X5
          EQ     L1          TREAT AS A NORMAL NUMBER 
  
  
 INFIN2   PX1    X4          (ALSO NORMALIZED)
*      THE ACTUAL VALUE OF THE SOURCE IS NOW  X1 * 2'1777B, 
*      WHICH CANNOT BE USED DIRECTLY IN A FLOATING POINT OPERATION. 
*      WE MULTIPLY X1 BY (2'1777B)*[10'(-307)] AND
*      ADD 307 TO THE EXPONENT,  LEAVING A WORKABLE VALUE IN X1.
* 
*      LOG10(2) = .30102 99956 63981 19521 37388, 
*      SO 1777B*LOG10(2) = 307 + .95368 55642 52762 70365 48... 
*      AND THE ANTILOG OF 0.95375 96  IS  8.98846 
          SA3    =8.98846    (2'1777B)*[10'(-307)]
          FX1    X1*X3
          SB3    B3-307      (B3 IS CURRENTLY NEGATIVE EXPONENT)
          EQ     L1          TREAT AS NORMAL NUMBER 
          TITLE  SMALL -  HANDLE VERY SMALL VALUES
**        SMALL -  HANDLE VERY SMALL VALUES 
* 
*         X3 = ORIGINAL VALUE,  UNPACKED
*         B7 = SHIFT COUNT TO GET AN EXPONENT OF EXACTLY -1777B 
*                (I.E. BITS 59-48 = 0000B)
*         B3 = ORIGINAL SCALING FACTOR
*         B4 = BCP OF DESTINATION FIELD 
*         B5 = FWA OF DESTINATION FIELD 
* 
*         SETS X1 = WORKABLE VALUE. 
*         MODIFIES B3 TO RETAIN ACTUAL VALUE. 
  
  
 SMALL    LX1    B7,X3
*      THE ACTUAL VALUE OF THE SOURCE IS NOW
*      X1 (INTERPRETED AS AN INTEGER) MULTIPLIED BY 2'(-1777B), 
*      WHICH CANNOT BE REPRESENTED DIRECTLY.
*      WE MULTIPLY X1 BY [2'(-1777B)]*(10'308) AND
*      SUBTRACT 308 FROM THE EXPONENT,
*      LEAVING A WORKABLE VALUE IN X1.
* 
*      LOG10(2) = .30102 99956 63981 19521 37388, 
*      SO  -1777B*LOG10(2) = -308 + .04631 44357 47237 29634 52 
*      AND THE ANTILOG OF 0.0463 IS 1.113 
          SA3    =1.113      [2'(-1777B)]*(10'308)
          PX1    X1 
          NX1    X1 
          FX1    X1*X3
          SB3    B3+308      (B3 IS CURRENTLY NEGATIVE EXPONENT)
          EQ     L1          RESUME AS IF NORMAL NUMBER 
          TITLE  ZERO -  HANDLE ZERO VALUE
**        ZERO -  HANDLE ZERO VALUE 
* 
*         X0 = SIGN OF VALUE
*         B4 = BCP OF DESTINATION FIELD 
*         B4 = FWA DESTINATION FIELD
* 
*         INSERTS SIGN INTO PICTURE OF ZERO RESULT. 
  
  
 ZERO     SA3    ZERODEST    +.00000000 
          SX4    B1 
          BX5    X0*X4       1 IFF SOURCE IS NEGATIVE 
          LX5    9*6
          IX6    X3+X5       -.00000000 
          SA6    DEST        STORE FIRST WORD 
          SA3    A3+B1       0000000E+0 
          BX6    X3 
          SA6    A6+B1       STORE SECOND WORD
          SA3    A3+B1       000
          BX6    X3 
          SA6    A6+B1       STORE THIRD WORD 
          EQ     L6          GO MOVE FIELD
          TITLE  WORKING-STORAGE SECTION
* 
*      VARIABLES AND CONSTANTS
* 
  
 DEST     BSS    3
 INDFDEST DATA   23H(**+INDEFINITE VALUE**) 
 INFNDEST DATA   23H(***+INFINITE VALUE***) 
 ZERODEST DATA   23H+.000000000000000E+0000 
          SPACE  4
* 
*      TABLE TO ADJUST EXPONENT 
* 
  
 POWERS   MACRO  P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14,P15,P16 
 PMAX     SET    PMAX+1 
          USE    A
          CON    1.0E+P1     A
          USE    B
          CON    1.0E-P1               B
          USE    POWER
          CON    P1                              POWER
          IFC    NE, P2  ,1 
          POWERS P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14,P15
POWERS    ENDM
  
 PMAX     SET    -1 
  
  
          LIST   G
          USE    A
 A        BSS    0
          USE    B
 B        BSS    0
          USE    POWER
 POWER    BSS    0
          POWERS 1,2,3,6,11,21,41,81,162
  
 IMAX     EQU    PMAX 
          SPACE  4
          END 
