software: Added more and more

[pdp8.git] / sw / f4 / FRTSRC / dsqrt.ra

diff --git a/sw/f4/FRTSRC/dsqrt.ra b/sw/f4/FRTSRC/dsqrt.ra
new file mode 100644 (file)
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
+\f