File: SQRT.RA of Tape: Sources/Fortran/os8-f4-3

(Source file text) 

---

/R=SQRT(R) SINGLE PREC. SQUARE ROOT
/
/
/ VERSION 40A 20-MAY-80 WVDM GOOD FOR M&S FPP
/
/
	SECT	SQRT
	JA	#SQRT
	0			/THE MANTISSA AND EXPONENT DIDDLE AREAS.
	0
SQRTEX,	0
	0
SQRT13,	0
	0
	13			/PHONEY EXPONENT PATCH.
/
	EXTERN	#ARGER
SQRTM1,	TRAP4	#ARGER
	TEXT	+SQRT  +
SQRTXR,	SETX	XRSQRT
	SETB	BPSQRT
BPSQRT,	F 0.0
XRSQRT,	F 0.0
SQRT1,	F 0.0
SQRT2,	F 0.0
SQRT3,	F 0.0
F1SQRT,	F 1.
F2SQRT,	F 2.
	ORG	10*3+BPSQRT
	FNOP
	JA SQRTXR
	0
SQTRTN,	JA	.
SQRTS1,	0			/IF BETWEEN 1/4 & 1/2
	3200
	0
	0			/IF BETWEEN 1/2 & 1
	2240
	0
/
SQRTS2,	7777			/IF BETWEEN 1/4 & 1/2
	2327
	7772
	7777			/IF BETWEEN 1/2 & 1
	3300
	0
	BASE	0
#SQRT,	STARTD
	FLDA	10*3
	FSTA	SQTRTN
	FLDA	0
	SETX	XRSQRT
	SETB	BPSQRT
	BASE	BPSQRT
	LDX	1,1
	FSTA	BPSQRT
	FLDA%	BPSQRT,1  	/ADDR OF X
	FSTA	BPSQRT
	STARTF
	FLDA%	BPSQRT 		/GET X
	JEQ	SQTRTN		/IF =0 JUST RTN
	JLT	SQRTM1		/IF <0 THEN ERROR
	FSTA	SQRTEX+1	/SAVE NUMBER AWAY FOR A SECOND.
	FSUB	F1SQRT		/.LT. 1 ?
	JGE	SQPOSR
	LDX	0,1		/REMEMBER LT 1
	FLDA	F1SQRT		/INVERT
	FDIV	SQRTEX+1
	FSTA	SQRTEX+1
SQPOSR,	FLDA	SQRT13		/GET A RIGHT ADJUSTED 13 IN THE FAC.
	FSTA	SQRTEX-2	/STORE AWAY RIGHT AHEAD OF THE EXPONENT.
	FLDA	SQRTEX		/NOW RETREIVE THE EXPONENT AS HIGH ORDER WORD.
	ALN	0		/CHOP OFF CRAP.
	FNORM			/NORMALIZE IT.
	FSUB	F1SQRT		/NOW SUBTRACT ONE FROM IT.
	FDIV	F2SQRT		/CHOP IT IN HALF NOW.
	FSTA	SQRT2		/AND SAVE 1/2 EXP IN A TEMP.
	ALN	0		/NOW FIX THE EXPONENT.
	FSTA	SQRT1		/SAVE FIXED-UP EXP FOR LATER
	FNORM			/AND NORMALIZE IT TO REMOVE UNDESIRABLE BITS.
	FSUB	SQRT2		/NOW SUBTRACT OFF EXTRANEOUS BITS.
	FMUL	F2SQRT		/EXPAND IT AGAIN [FAC =0 OR -1]
	FNEG			/NOW MAKE IT 0 IF NO BIT OR +1 IF BIT
SQRTBK,	ATX	2		/SAVE IN AN INDEX.
	FSUB	F1SQRT		/SUBTRACT 1 FOR  -1 IF NO BIT OR 0 IF BIT.
	ALN	0		/AND NOW SHIFT IT RIGHT.
	FSTA	SQRTEX-1	/AND SAVE IT OVER THE OLD EXPONENT.
/
/		SQRTEX IS NOW 1/4 <X< 1
/
	FLDA	SQRTEX+1	/RECALL NUMBER.
	FSTA	SQRT2		/SAVE IN A TEMP.
/
	FMUL	SQRTS1,2	/MULTIPLY BY CORRECT CONSTANT.
	FADD	SQRTS2,2	/AND NOW ADD IN CORRECT CONSTANT.
/
/	NOTE: INITIAL APPROXIMATION DEPENDS ON WHETHER X IS 1/4<X<1/2 OR
/		     1/2<X<1
/
	FSTA	SQRT3		/SAVE IN A SECOND TEMP.
	FLDA	SQRT2		/RECALL INITIAL.
	FDIV	SQRT3		/CALCULATE X(0)/X(1)
	FADD	SQRT3		/X(1)+X(0)/X(1)
	FDIV	F2SQRT		/1/2(X(1)+X(0)/X(1))
	FSTA	SQRT3		/SAVE AGAIN. NOW X(2)
	FLDA	SQRT2		/RECALL ORIGINAL.
	FDIV	SQRT3		/X(0)/X(2)
	FADD	SQRT3		/X(2)+X(0)/X(2)
	FSTA	SQRTEX+1	/NOW STORE AWAY FOR FINAL EXPONENT DIDDLING.
/
	STARTD
	FCLA			/ZERO HIGH ORDER EXPONENT PART.
	FSTA	SQRTEX-1
	FLDA	SQRT1		/RECALL MODIFIED EXPONENT.
	FADD	SQRTEX		/UPDATE FRACTIONAL EXPONENT.
	FSTA	SQRTEX
/
	STARTF			/RETURN TO FLOATING MODE.
	JXN	SQEXPO,1	/WAS IT .GE. 1 ?
	FLDA	F1SQRT		/NO, INVERT
	FDIV	SQRTEX+1	/SQRT(1/X)=1/SQRT(X)
	JA	SQTRTN		/AND RTN
/
SQEXPO,	FLDA	SQRTEX+1	/PICK UP THE ANSWER DIRECTLY
	JA	SQTRTN		/AND RTN

---