⚠️ 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.


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
         B      @FMTFRT 
         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
@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
@FMTFBI  DS     F                  dcl 32-bit fixed integer
@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            ------------------------------------