TITLE F_SQRT
      MODULE F_SQRT
      EXPORTC F_SQRT
      IMPORTC F_ZSTE,F_HANDLER
      AREADEF PROG,[PIC,READ,SHARED,CODE],DOUBLE
      AREADEF DATA,[WRITE,DATA],DOUBLE
      DEFSB   DATA
      AREA    PROG
      DCS     'F_SQRT      '
F_SQRT
      SPRD   FP,TOS
      LPRD   FP,12(SP)
      MOVF   0(0(FP)),F0
      MOVZWD 2(0(FP)),R0     ;EXPONENT & 1ST BYTE OF MANTISSA
      CMPQW  0,R0         ;CHECK FOR NEGATIVE
      BGE    neg
      ASHW   =-1,R0
      MOVZBD R0,R1        ;1ST BYTE OF MANTISSA
      BICB   =#X7F,R0     ;REMOVE OLD MANTISSA
      BICB   =#X80,R1
      ASHB   =-1,R1
      MOVB   INI[R1:B],R1
      ADDW   R1,R0        ;INSERT NEW MANTISSA
      ADDW   =#X1F80,R0   ;1ST APPROX
      MOVW   R0,TOS
      MOVQW  0,TOS
      MOVFL  F0,F2
      DIVF   0(SP),F0
      ADDF   TOS,F0
      MULF   =0.5,F0      ;1ST ITERATION
      MOVFL  F0,F0
      DIVL   F0,F2
      ADDL   F2,F0
      MULL   =0.5,F0      ;SECOND ITERATION
      MOVLF  F0,ans
fin   ADDR   ans,R0
      LPRD    FP,TOS
      RXP     4
neg   ANDW    =#X7FFF,R0
      CMPQW   0,R0
      BNE     bad
      MOVQD   0,ans
      BR      fin
bad   ADDR    mess,TOS
      CXP     F_ZSTE
      HANDLER
      CXP     F_HANDLER
txt   DCS     'negative argument in SQRT'
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  1
mess  ADDRESS mm
mm    ADDRESS txt
      DCD     lgt-txt
      END