# 360 Assembly include

### 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         [email protected](@FMTFDE)[email protected]         LA     R2,1(R2)           [email protected] 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            ------------------------------------`