ASMB,R,L,C,B
      HED  RTE-BASIC FLOATING POINT TO BCD UTILITY
      NAM BCD6,7       29100-16007 REV.A
****************************************
* RTE-BASIC FLOATING POINT TO BCD UTILITY 
* 29100-16007 
* REVISION A
****************************************
* EXT. REF. SPEC.   A-29100-16007-1 
* LISTING           A-29100-16007-2 
* SOURCE TAPE       29100-18007 
* RELOC. BIN. TAPE  29100-16007 
* 
      ENT BCD6
* 
      EXT .IENT,.FSB,.ENTR,.DLD,.DST
* 
*               ****FLOATING POINT TO BCD CONVERSION****
* 
*      FORTRAN CALL:            CALL BCD6(VALUE,IBCD(1))
*              ANSWER IN IBCD(1) AND IBCD(2)
* 
* 
*      ASSEMBLY LANGUAGE CALL:     EXT BCD6 
*                                  .
*                                  .
*                                  JSB BCD6 
*                                  DEF *+3
*                                  DEF DATA 
*                                  DEF IBCD 
*                                  <RETURN POINT> 
*                             IBCD BSS 2
*                   (V3.1)
*  THIS IS NOT A GOOD ALGORITHM, BECAUSE OF ROUNDING
*  IN THE FLOATING POINT OPERATIONS.
* 
VALUE BSS 1 
IBCD  BSS 1 
BCD6  NOP 
      JSB .ENTR 
      DEF VALUE 
      JSB .DLD
      DEF VALUE,I 
LP1   STA .T1.
      STB .T1.+1
      JSB .FSB
      DEF .100K       SUBTRACT 100000.0 
      SSA           RESULT POS.?
      JMP *+3       NO. 
      ISZ TCNTA     YES.
      JMP LP1       DO AGAIN
      LDA TCNTA     POSITION
      ALF           FIRST 
      STA TCNTA     DIGIT.
      LDA .T1.      RECOVER NO. 
      LDB .T1.+1
LP2   STA .T1.
      STB .T1.+1
      JSB .FSB
      DEF .10K        SUBTRACT 10000.0
      SSA           RESULT POS.?
      JMP *+3 
      ISZ TCNTA 
      JMP LP2 
      LDA .T1.
      LDB .T1.+1
      JSB .IENT     CONVERT REMAINING 
      NOP 
      LDB 0 
      LDA DPTR
      STA CONV
      LDA TCNTA 
      STA .T1.+1
      CLA 
      STA TCNTA 
BCL   STB .T1.      SAVE CONVERSION SO FAR
      ADB CONV,I    SUBTRACT 10^N 
      SSB 
      JMP BCM       NEGATIVE, DONE ENOUGH 
      INA           POSITIVE, 
      JMP BCL       DO MORE 
* 
BCM   ALF           POSITION DIGIT
      ISZ CONV
      CLB 
      CPB CONV,I    DONE? 
      JMP BCX       YES.
      LDB .T1.      RECOVER VALUE 
      JMP BCL       CONVERT SOME MORE 
* 
BCX   ADA .T1.
      LDB .T1.+1    GET MSD'S 
      JSB .DST
      DEF IBCD,I      STORE RESULT
      JMP BCD6,I    ***RETURN***
* 
.100K DEC 1.0E+5
.10K  DEC 1.0E+4
DPTR  DEF *+1 
      DEC -1000,-100,-10,0
CONV  BSS 1 
.T1.  BSS 2 
TCNTA OCT 0 
* 
      END 
                                                                                                                                          