FORMATF

An 'include' file to format a floating-point value.

FORMATF  CNOP   0,4                ***WRITE Y,X FORMAT(F13.n)**********
*                                  (F0,R0)->R1
         STM    R14,R12,@FMTF0F    Store registers
		 LR     R1,R0              R0=decimals
         STH    R1,@FMTFNC         Number of decimals N
         SLA    R1,2               R1=N*4
         ME     F0,@FMTFCO(R1)     F0=F0*10**N
         STE    F0,@FMTFWF         WF=X*10**N
         MVI    @FMTFTS,X'00'      Initialize the sign field
         L      R9,@FMTFWF         Load the floating-point value
         CH     R9,=H'0'           and examine the sign bit.
         BZ     @FMTFDN            The value is zero, nothing to do.
         BNL    @FMTFNN            Is the value negative?
         MVI    @FMTFTS,X'80'      Yes, it is negative.
         N      R9,=X'7FFFFFFF'    Zero out the sign bit.
@FMTFNN  LR     R8,R9              Copy the value into R8
         N      R8,=X'00FFFFFF'    Examine the fraction.  Is it 0?
         BNZ    @FMTFNZ            No, keep on working
         SR     R9,R9              Yes, the value is zero.  So set
         B      @FMTFDN            the result as 0 and exit.
@FMTFNZ  LR     R8,R9              Copy the value into R8
         N      R8,=X'FF000000'    Isolate the characteristic field
         SRL    R8,24              Shift to least significant byte
         CH     R8,=H'64'          Is exponent big enough? 16**0
         BH     @FMTFO1            Yes, number is not < 1.
         SR     R9,R9              No, set result to zero
         B      @FMTFDN            and be done with it.
@FMTFO1  CH     R8,=H'72'          Is the exponent too big? 2**32
         BH     @FMTFOV            overflow (72-64=8 16**8=2**32)
         SR     R8,R8              Set R8 to zero
         SLDL   R8,8               Shift two high-order digits into R8
         CH     R8,=H'72'          Is the exponent an 8?
         BL     @FMTFDI            Yes, we can continue
         CH     R9,=H'0'           Is the sign bit set?
         BNP    @FMTFOV            overflow, the high-order bit is 1
@FMTFDI  SH     R8,=H'72'          Produce (Characteristic - 72)
         LCR    R8,R8              Produce (72 - Characteristic)
         SLL    R8,2               Multiply by 4
         SRL    R9,0(R8)           Shift R9 by the amount in R8
@FMTFSV  SR     R8,R8              Set R8 to 0.
         IC     R8,@FMTFTS         Load the sign value
         CH     R8,=H'0'           Is the sign bit set?
         BZ     @FMTFDN            No, we are OK
         LCR    R9,R9              Negate the absolute value
@FMTFIP  B      @FMTFDN            Sign OK
@FMTFOV  MVC    @FMTFDF,=30C'*'
         B      @FMTFRT 
@FMTFDN  ST     R9,@FMTFBI
         CVD    R9,@FMTFPA         to fixed(15)
         MVC    @FMTFMA,@FMTFMO
         LA     R1,@FMTFMA+10
         SH     R1,@FMTFNC
         MVI    0(R1),X'21'        10-N
         MVC    @FMTFDE,@FMTFMA
         EDMK   @FMTFDE,@FMTFPA+2  fixed(11,N)-> pic' (10-N)#(N+1)9S'
         BCTR   R1,0
         MVC    0(1,R1),@FMTFDE+12
         LA     R1,12              12-N
         SH     R1,@FMTFNC
         EX     R1,@FMTFM1         MVC @FMTFDF(0),@FMTFDE on 13-N
         LA     R2,@FMTFDF+12
         SH     R2,@FMTFNC
         MVI    0(R2),C'.'
         LA     R3,@FMTFDE+12
         SH     R3,@FMTFNC         R3=@(@FMTFDE)+12-@FMTFNC
         LA     R2,1(R2)           R2=@ after the point in @FMTFDF
         LH     R1,@FMTFNC
         BCTR   R1,0
         EX     R1,@FMTFM2         MVC 0(0,R2),0(R3) on @FMTFNC
         B      @FMTFRT
@FMTFM1  MVC    @FMTFDF(0),@FMTFDE len=13-N
@FMTFM2  MVC    0(0,R2),0(R3)      len=N 
@FMTFRT  LM     R14,R12,@FMTF0F
		 LA     R1,@FMTFDF
         BR     R14
@FMTFXX  DS     E
@FMTFNC  DS     H
@FMTFCO  DC     E'1E0'             1
         DC     E'1E1'             10
         DC     E'1E2'             100
         DC     E'1E3'             1000
         DC     E'1E4'             10000
         DC     E'1E5'             100000
         DC     E'1E6'             1000000
         DC     E'1E7'             10000000
         DC     E'1E8'             100000000
         DC     E'1E9'             1000000000
@FMTFWF  DS     F
@FMTFBI  DS     F                  dcl 32-bit fixed integer
@FMTFTS  DS     X
@FMTFMO  DC     X'40',11X'20',X'60' CL13
@FMTFMA  DS     CL13
@FMTFDE  DS     CL13               pic'B###99999999S' 
@FMTFDF  DS     CL13               pic'S###9V.9999999'
@FMTFPA  DS     PL8                dec fixed(15)
@FMTF0F  DS     15F                save regs
*        END    FORMATF            ------------------------------------