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

diff --git a/sw/f4/FRTSRC/cabs.ra b/sw/f4/FRTSRC/cabs.ra
new file mode 100644
index 0000000..ab166b0
--- /dev/null
+++ b/sw/f4/FRTSRC/cabs.ra
@@ -0,0 +1,57 @@
+/
+/   C A B S
+/   - - - -
+/
+/ VERSION 5A 4-27-77  PT
+/
+/ENTER IN COMPLEX, EXIT IN REAL
+/
+/Z=X+IY
+/
+/CABS(Z)=SQRT(X^2+Y^2)
+/
+	DPCHK
+	SECT	CABS
+	JA	#CABS
+	TEXT	+CABS  +
+CABSXR,	SETX	XRCABS
+	SETB	BPCABS
+	JA	.+3
+BPCABS,	F 0.0
+XRCABS,	F 0.0
+ARG,	F 0.0
+	F 0.0
+	ORG	10*3+BPCABS
+	FNOP
+	JA	CABSXR
+	0
+CABSRT,	JA	.
+	BASE	0
+#CABS,	STARTD
+	FLDA	10*3
+	FSTA	CABSRT
+	FLDA	0
+	SETB	BPCABS
+	SETX	XRCABS
+	BASE	BPCABS
+	LDX	1,1
+	FSTA	BPCABS
+	FLDA%	BPCABS,1
+	FSTA	BPCABS
+	STARTE
+	FLDA%	BPCABS
+	FSTA	ARG
+	STARTF
+	FLDA	ARG
+	FMULM	ARG		/X^2
+	FLDA	ARG+3		/Y
+	FMUL	ARG+3		/Y^2
+	FADD	ARG		/X^2+Y^2
+	FSTA	ARG
+	EXTERN	SQRT
+	JSR	SQRT
+	JA	RT1
+	JA	ARG
+RT1,	JA	CABSRT
+	EXTERN	#CAC
+