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

diff --git a/sw/f4/FRTSRC/csqrt.ra b/sw/f4/FRTSRC/csqrt.ra
new file mode 100644
index 0000000..161769d
--- /dev/null
+++ b/sw/f4/FRTSRC/csqrt.ra
@@ -0,0 +1,92 @@
+/
+/   C S Q R T
+/   - - - - - 
+/
+/ VERSION 5A 4-27-77  PT
+/
+/COMPLEX SQUARE ROOT ROUTINE
+/ENTER+ EXIT IN COMPLEX
+/Z=X+IX
+/
+/SQRT(Z)=SQRT(R)*COS(THETA)+SIN(THETA))
+/
+/R=SQRT(X*X+Y*Y)
+/THETA=ATAN2(Y/X)/2
+/
+/CALLS SQRT,ATAN2,SIN,COS
+/
+	SECT	CSQRT
+	JA	#CSQRT
+	DPCHK
+	TEXT	+CSQRT +
+CSQRTX,	SETX	XR
+	SETB	BP
+	JA	.+3
+BP,	F 0.0
+XR,	F 0.0
+ARG,	F 0.0
+	F 0.0
+THETA,	F 0.0
+FP2,	F 2.0
+	ORG 10*3+BP
+	FNOP
+	JA	CSQRTX
+	0
+RT,	JA	.
+	BASE	0
+#CSQRT,	STARTD
+	FLDA	10*3
+	FSTA	RT
+	FLDA	0
+	SETB	BP
+	SETX	XR
+	BASE	BP
+	LDX	1,1
+	FSTA	BP
+	FLDA%	BP,1
+	FSTA	BP
+	STARTE
+	FLDA%	BP
+	FSTA	ARG
+	STARTF
+	EXTERN	ATAN2
+	JSR	ATAN2		/ATAN(Y/X)
+	JA	CSA
+	JA	ARG+3
+	JA	ARG
+CSA,	FDIV	FP2		/ATAN/2
+	FSTA	THETA
+	FLDA	ARG
+	FMULM	ARG		/X*X
+	FLDA	ARG+3
+	FMUL	ARG+3		/Y*Y
+	FADD	ARG		/X*X+Y*Y
+	FSTA	ARG
+	EXTERN	SQRT		/SQRT(X*X+Y*Y)
+	JSR	SQRT
+	JA	CSB
+	JA	ARG
+CSB,	FSTA	ARG		/R
+	EXTERN	SQRT
+	JSR	SQRT
+	JA	CSC
+	JA	ARG		/SQRT(R)
+CSC,	FSTA	ARG		/SQRT(R)
+	EXTERN	SIN
+	JSR	SIN		/SIN(THETA/2)
+	JA	CSD
+	JA	THETA
+CSD,	FMUL	ARG		/*SQRT(X)
+	FSTA	ARG+3
+	EXTERN	COS
+	JSR	COS		/COS(THETA/2)*SQRT(R)
+	JA	CSE
+	JA	THETA
+CSE,	FMUL	ARG
+	FSTA	ARG
+	STARTE
+	FLDA	ARG
+	FSTA	#CAC
+	JA	RT
+	EXTERN	#CAC
+