TITLE F_DSQR
      MODULE F_DSQR
      EXPORTC F_DSQR
      IMPORTC F_ZSTE,F_HANDLER
      AREADEF PROG,[PIC,READ,SHARED,CODE],DOUBLE
      AREADEF DATA,[WRITE,DATA],DOUBLE
      DEFSB   DATA
      AREA    PROG
      DCS     'F_DSQR      '
F_DSQR
      SPRD   FP,TOS
      LPRD   FP,12(SP)
      ABSL   0(0(FP)),F0  ;argument in F0
      MOVD   4(0(FP)),R0  ;top half
      CMPQD  0,R0         ;check for negative
      BGE    neg
      ASHD   =-15,R0
      MOVZBD R0,R1        ;1ST BYTE OF MANTISSA
      BICB   =#X3F,R0     ;REMOVE OLD MANTISSA
      BICB   =#XC0,R1
      MOVB   INI[R1:B],R1
      ADDD   R0,R0
      ADDD   R1,R0        ;insert new mantissa
      ADDD   =#XFF80,R0   ;1st approximation
      ASHD   =13,R0
      MOVD   R0,TOS
      MOVQD  0,TOS
      ABSL   F0,F2
      DIVL   0(SP),F2
      ADDL   TOS,F2
      MULL   =0.5,F2      ;1st iteration
      ABSL   F0,F4
      DIVL   F2,F4
      ADDL   F2,F4
      MULL   =0.5,F4      ;2nd iteration
      DIVL   F4,F0
      ADDL   F4,F0
      MULL   =0.5,F0      ;3rd iteration
fin   MOVL   F0,ans
      ADDR   ans,R0
      LPRD   FP,TOS
      RXP    4
neg   BEQ    fin
      CMPD   =#X80000000,R0
      BEQ    fin
      ADDR   mess,TOS
      CXP    F_ZSTE
      HANDLER
      CXP    F_HANDLER
txt   DCS    'negative argument in DSQRT'
lgt   EQU    *
INI   DCD    #X3F3C3936,#X49474441,#X53514E4C,#X5D5A5855
      DCD    #X6663615F,#X6E6C6A68,#X77757371,#X7F7D7B79
      DCD    #X87858381,#X8E8C8B89,#X95949290,#X9C9A9997
      DCD    #XA2A19F9E,#XA9A7A6A4,#XAFADACAA,#XB4B3B1B0
      AREA   DATA
ans   ALLOCD  2
mess  ADDRESS mm
mm    ADDRESS txt
      DCD     lgt-txt
      END