⚠️ Warning: This is a draft ⚠️

This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.

If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.

### 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            ------------------------------------
```