X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Ff4%2FFRTSRC%2Fdsqrt.ra;fp=sw%2Ff4%2FFRTSRC%2Fdsqrt.ra;h=520a86dff7fd1e0718eb527be17c7f68f292110f;hb=7af5ad59491ddf2066641aef1e0025a337c0f247;hp=0000000000000000000000000000000000000000;hpb=919757fd611e482003ce51f366f6783cab73dea3;p=pdp8.git

diff --git a/sw/f4/FRTSRC/dsqrt.ra b/sw/f4/FRTSRC/dsqrt.ra
new file mode 100644
index 0000000..520a86d
--- /dev/null
+++ b/sw/f4/FRTSRC/dsqrt.ra
@@ -0,0 +1,79 @@
+/
+/
+/	D S Q R T
+/
+/ VERSION 5A 4-27-77  PT
+/
+	SECT	DSQRT
+	JA	#DSQRT
+	DPCHK
+	TEXT	+DSQRT +
+/
+DSQXR,	SETX	XRDSQ
+	SETB	BPDSQ
+	JA	.+3
+BPDSQ,	F 0.0
+XRDSQ,	F 0.0
+DARSAV,	F 0.0
+	F 0.0
+DSQ2,	F 2.0
+ 	F 0.0
+SNGL,	F 0.0
+	F 0.0
+	ORG 10*3+BPDSQ
+	FNOP
+	JA	DSQXR
+/
+	0
+DSQRTN,	JA	.
+DSQ1,	F 0.0
+	F 0.0
+/PICK UP ARGUMENTS
+	BASE	0
+#DSQRT,	STARTD
+	FLDA	10*3
+	FSTA	DSQRTN
+	FLDA	0
+	SETX	XRDSQ
+	SETB	BPDSQ
+	BASE	BPDSQ
+	LDX	1,1
+	FSTA	BPDSQ
+	FLDA%	BPDSQ,1	/ADDR OF X
+	FSTA	BPDSQ
+/
+/DO GENERAL TESTS ON THE ARGUMENT
+/
+	STARTE
+	FLDA%	BPDSQ
+	JEQ	DSQRTN	/RETURN IF 0
+	JLT	DSQER	/<0 ERROR
+	FSTA	DARSAV	/SAVE DOUBLE
+	STARTF		/F MODE + ROUND
+	FSTA	SNGL	/SAVE
+/
+/GET INITIAL APPROXIMATION BY CALLING
+/SINGLE PRECISION ROUTINE
+/
+	EXTERN	SQRT
+	JSR	SQRT
+	JA	.+4
+	JA	SNGL
+	FSTA	SNGL	/FIRST APPROX
+	STARTE		/BACK TO E
+/
+/TAKE N ITERATIONS OF
+/X(K+1)=1/2(X(K)+X/X(K))
+/
+	LDX	-3,0	/3 TIMES
+DSIT,	FLDA	DARSAV	/GET X
+	FDIV	SNGL	/X(K)
+	FADD	SNGL	/X(K)
+	FDIV	DSQ2	/DIVIDE BY 2
+	FSTA	SNGL	/X(K+1)
+	JXN	DSIT,0+	/ITERATE
+	FLDA	SNGL	/GET ANSWER
+	JA	DSQRTN	/RETURN
+	EXTERN	#ARGER
+DSQER,	TRAP4	#ARGER
+