--
--	Inmos Libraries
--	Copyright (C) 1988, 1989, 1990, 1991, 1993  Inmos Limited
--
--	This library is free software; you can redistribute it and/or
--	modify it under the terms of the GNU Lesser General Public
--	License as published by the Free Software Foundation; either
--	version 2 of the License, or (at your option) any later version.
--
--	This library is distributed in the hope that it will be useful,
--	but WITHOUT ANY WARRANTY; without even the implied warranty of
--	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--	Lesser General Public License for more details.
--
--	You should have received a copy of the GNU Lesser General Public
--	License along with this library; if not, write to the Free Software
--	Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
--

#IF (TARGET.BITS.PER.WORD = 32) AND (NOT DEFINED(TARGET.HAS.FPU))

--{{{  #options and #comments
#OPTION "V"  -- no vector space; compiler libraries not required in TB mode
#COMMENT "TA compiler library, V1.3 07/12/92"
#COMMENT "(c) Copyright INMOS Limited 1988"
--}}}

#PRAGMA TRANSLATE SQRT "SQRT%O"

#INCLUDE "realvals.inc"

--{{{  
REAL32 FUNCTION SQRT (VAL REAL32 X)

  --{{{  history
  -- V1.2 21/02/89
  -- Moved position of CAUSEERRORs from ends of branches to the beginning of
  -- them to allow compiler to do dead code elimination; V1.3, 7-Dec-92 SRH
  --}}}

  REAL32 Root :
  VALOF
    #INCLUDE "nan32.inc"
    --{{{  definitions and variables
    VAL Sign      IS #80000000(INT) :
    VAL R2C2      IS #D413CCD0(INT) :
    VAL R2K2      IS #4C1E24CD(INT) :
    VAL R2C1      IS #93000000(INT) :
    VAL R2K1      IS #6CFFFFFF(INT) :
    INT Root.i RETYPES Root :
    VAL INT X.i RETYPES X :
    VAL PosX IS X.i /\ (~Sign) :
    INT Xexp, Xfrac, Type :
    --}}}
    SEQ
      Xfrac, Xexp, Type := UNPACKSN (PosX)
      IF
        --{{{  special cases
        (Type = 3)                      -- NaN
          SEQ
            CAUSEERROR()
            Root.i := X.i
        (Type = 0)                      -- 0
          Root.i := X.i
        (X.i <> PosX)                   -- negative
          SEQ
            CAUSEERROR()
            Root.i := INT root.NaN
        (Type = 2)                      -- Inf
          SEQ
            CAUSEERROR()
            Root.i := X.i
        --}}}
        TRUE                       --proper case
          INT Y :
          SEQ
            --{{{  deal with denormal input
            IF
              Xexp = 1  --denormal; it is UNPACKSN that gives the 1 here
                INT N :
                SEQ
                  INT Discard :
                  N, Xfrac, Discard := NORMALISE (Xfrac, 0)
                  Xexp :=  1 - N
              TRUE
                SKIP
            --}}}
            --{{{  adjust for power of two and make initial approximation
            IF
              (Xexp /\ 1) = 1               -- unbiased exponent is even
                SEQ
                  Xfrac := Xfrac >> 1       -- divide fractional part by 2
                  INT Carry :
                  Y, Carry := LONGPROD (Xfrac, R2C2, 0)  -- linear approximation
                  INT Carry :
                  Carry, Y := LONGSUM (Y, R2K2, 0)       -- over [1/4,1/2)
              TRUE
                SEQ
                  INT Carry :
                  Y, Carry := LONGPROD (Xfrac, R2C1, 0)   -- linear approximation
                  INT Carry :
                  Carry, Y := LONGSUM (Y, R2K1, 0)        -- over [1/2, 1)
            --}}}
            --{{{  perform Newton-Raphson iterations
            VAL XF IS Xfrac >> 1 :              --to ensure no div overflow
            INT Y0 :
            SEQ
              INT Carry :
              Y0, Carry := LONGDIV (XF, 0, Y)     --to 14 bits
              INT Carry :
              Carry, Y := LONGSUM (Y >> 1, Y0, 0) --always carry into top bit
              INT Carry :
              Y0, Carry := LONGDIV (XF, 0, Y)     --to 28 bits
              INT Carry :
              Carry, Y := LONGSUM (Y >> 1, Y0, 0)
            --}}}
            --{{{  determine correct value
            VAL INT mask IS #FFFFFF00 :
            VAL INT lsbit IS #100 :
            INT Carry, Y0 :
            SEQ
              Y := Y /\ mask  -- truncate
              Y0, Carry := LONGDIV (Xfrac >> 1, 0, Y)
              Y0 := Y0 << 1
              INT overflow, YplusLsbit :
              SEQ
                overflow, YplusLsbit := LONGSUM( Y, lsbit, 0)
                IF
                  overflow = 0
                    --{{{  select between Y and (Y + lsbit)
                    IF
                      YplusLsbit = Y0
                        --{{{  equal so be careful
                        IF
                          Carry = 0
                            --{{{  equidistant
                            IF
                              (Y /\ lsbit) <> 0  -- odd fraction, so round up
                                SEQ
                                  Y := YplusLsbit
                              TRUE
                                SKIP
                            --}}}
                          TRUE  -- truncation error
                            SEQ
                              Y := YplusLsbit
                        --}}}
                      YplusLsbit < Y0  -- stricly less than
                        SEQ
                          Y := YplusLsbit
                      TRUE
                        SKIP
                    --}}}
                  TRUE
                    SKIP -- Y is the correct representation, as Y + lsbit overflows
            --}}}
            Root.i := ROUNDSN ((Xexp + RealXcess) >> 1, Y, 0)
    RESULT Root
:
--}}}

#ENDIF


#IF (TARGET.BITS.PER.WORD = 16)

--{{{  #options and #comments
#OPTION "E V"  -- no compiler libs, no vector space
#COMMENT "T2 compiler library, V1.3 07/12/92"
#COMMENT "(c) Copyright INMOS Limited 1988"
--}}}  

#PRAGMA TRANSLATE SQRT "SQRT%O"

#INCLUDE "realvals.inc"

--{{{  
REAL32 FUNCTION SQRT (VAL REAL32 X)

  --{{{  history
  -- V1.2 21/02/89
  -- Moved position of CAUSEERRORs from ends of branches to the beginning of
  -- them to allow compiler to do dead code elimination; V1.3, 7-Dec-92 SRH
  --}}}  

  REAL32 Root :
  VALOF
    #INCLUDE "nan16.inc"
    --{{{  definitions
    VAL Sign      IS #80000000(INT32) :
    VAL RealInf   IS #7F800000(INT32) :
    VAL zero      IS         0(INT32) :
    VAL one       IS         1(INT32) :
    VAL R2C2      IS #D413CCD0(INT32) :
    VAL R2K2      IS #4C1E24CD(INT32) :
    VAL R2C1      IS #93000000(INT32) :
    VAL R2K1      IS #6CFFFFFF(INT32) :
    VAL INT32 X.i RETYPES X :
    VAL PosX IS X.i /\ (~Sign) :
    INT32 Root.i RETYPES Root :
    --}}}  
    IF
      --{{{  special cases
      (PosX > RealInf)                    -- NaN
        SEQ
          CAUSEERROR()
          --Root.i := X.i
      (PosX = zero)                       -- 0
        Root.i := X.i
      X.i < zero                          -- negative
        SEQ
          CAUSEERROR()
          --Root.i := root.NaN
      X.i = RealInf                       -- Inf
        SEQ
          CAUSEERROR()
          --Root.i := X.i
      --}}}  
      TRUE                                 -- proper case
        --{{{  SUM32
        INT32 FUNCTION SUM32 (VAL INT32 Left, Right)
          INT32 Sum :
          VALOF
            VAL [2]INT left  RETYPES Left  :
            VAL [2]INT right RETYPES Right :
            [2]INT sum RETYPES Sum :
            INT carry :
            SEQ
              carry,  sum[0] := LONGSUM ( left[0],  right[0],  0)
              carry,  sum[1] := LONGSUM ( left[1],  right[1],  carry)
            RESULT Sum
        :
        --}}}  
        INT32 Y, Xfrac :
        INT Xexp :
        SEQ
          --{{{  deal with denormals and convert to fixed point
          VAL [2]INT lo.in RETYPES PosX :
          [2]INT lo.out RETYPES Xfrac :
          SEQ
            Xexp := lo.in[1] >> 7
            lo.out[1],  lo.out[0] := SHIFTLEFT (lo.in[1], lo.in[0], RealShift + 1)
          IF
            Xexp = 0                         --denormal
              SEQ
                [2]INT hi.out RETYPES Xfrac :
                Xexp,  hi.out[1],  hi.out[0] := NORMALISE ( hi.out[1],  hi.out[0])
                Xexp :=  - Xexp
            TRUE
              Xfrac := (Xfrac >> 1) \/ Sign     --set proper value
          --}}}  
          --{{{  adjust for power of two and make initial approximation
          --{{{  PROD32
          INT32 FUNCTION PROD32 (VAL INT32 Left, Right)
            INT32 Hi.out :
            VALOF
              VAL [2]INT left     RETYPES Left :
              VAL [2]INT right    RETYPES Right :
              [2]INT hi.out RETYPES Hi.out :
              INT work1, work3, c0, c1 :
              SEQ
                INT carry, work0 :
                SEQ
                  carry,  work0 := LONGPROD ( left[0],  right[0],  0)
                  c0,  work1 := LONGPROD ( left[1],  right[0],  carry)
                INT carry, work2 :
                SEQ
                  carry,  work2 := LONGPROD ( left[0],  right[1],  work1)
                  c1,  work3 := LONGPROD ( left[1],  right[1],  carry)
                INT carry :
                SEQ
                  carry,  hi.out[0] := LONGSUM ( work3,  c0,  0)
                  carry,  hi.out[1] := LONGSUM ( c1,  0,  carry)
              RESULT Hi.out
          :
          --}}}  
          IF
            (Xexp /\ 1) = 1          -- unbiased exponent is even
              SEQ
                Xfrac := Xfrac >> 1  -- divide fractional part by 2
                Y := SUM32 (PROD32 (Xfrac,  R2C2),  R2K2)
            TRUE
              SEQ
                Y := SUM32 (PROD32 (Xfrac,  R2C1),  R2K1)
          --}}}  
          --{{{  perform iterations
          --{{{  DIV32
          INT32 FUNCTION DIV32 (VAL INT32 Num.hi, Divisor)

            INT32 Quot :
            VALOF
              PROC PartDivide( INT Q, Num2, NumR1, NumR0, VAL [2]INT Denom)
                --{{{  
                VAL MaxUnsignedInt IS #FFFF :
                INT qhat, rem :
                SEQ
                  --{{{  estimate quotient
                  IF
                    Denom[1] = Num2
                      SEQ
                        qhat := MaxUnsignedInt
                        rem  := Num2 PLUS NumR1
                    TRUE
                      qhat,  rem := LONGDIV ( Num2,  NumR1,  Denom[1])
                  --}}}  
                  IF
                    qhat <> 0
                      --{{{  ensure not too big
                      INT c, s :
                      [3]INT W :
                      PLACE W IN WORKSPACE :
                      SEQ
                        --{{{  first check for 2 too big
                        -- compare qhat*Denom[0] with remainder (carry) and third digit
                        W[1],  W[0] := LONGPROD ( qhat,  Denom[0],  0)
                        c,  s := LONGDIFF ( W[0],  NumR0,  0)
                        c,  s := LONGDIFF ( W[1],  rem,  c)
                        IF
                          c = 0
                            qhat := qhat MINUS 1
                          TRUE
                            SKIP
                        --}}}  
                        --{{{  multiply and subtract
                        W[2],  W[1] := LONGPROD ( qhat,  Denom[1],  W[1])
                        c,  NumR0 := LONGDIFF ( NumR0, W[0],  0)
                        c,  NumR1 := LONGDIFF ( NumR1, W[1],  c)
                        c,  Num2  := LONGDIFF ( Num2,  W[2],  c)
                        --}}}  
                        IF
                          c <> 0
                            --{{{  too big, add back
                            SEQ
                              qhat := qhat MINUS 1
                              c,  NumR0 := LONGSUM ( NumR0, Denom[0],  0)
                              c,  NumR1 := LONGSUM ( NumR1, Denom[1],  c)
                              c,  Num2  := LONGSUM ( Num2,  0,  c)
                            --}}}  
                          TRUE
                            SKIP
                      --}}}  
                    TRUE
                      SKIP
                  Q := qhat
                --}}}  
              :
              VAL [2]INT num.hi RETYPES Num.hi :
              VAL [2]INT divis  RETYPES Divisor :
              [2]INT quot RETYPES Quot :
              IF
                divis[1] = 0
                  --{{{  short divisor
                  INT rem :
                  SEQ
                    quot[1],  rem := LONGDIV ( num.hi[0],  0,  divis[0])
                    quot[0],  rem := LONGDIV ( rem,  0,  divis[0])
                  --}}}  
                TRUE
                  --{{{  long divisor
                  [2]INT hi :
                  PLACE hi IN WORKSPACE :
                  [2]INT lo :
                  PLACE lo IN WORKSPACE :
                  [2]INT div :
                  PLACE div IN WORKSPACE :
                  INT places :
                  SEQ
                    places,  div[1],  div[0] := NORMALISE ( divis[1],  divis[0])
                    hi[1],  hi[0] := SHIFTLEFT ( num.hi[1],  num.hi[0],  places)
                    lo := [0,0]
                    PartDivide( quot[1], hi[1], hi[0], lo[1], div)
                    PartDivide( quot[0], hi[0], lo[1], lo[0], div)
                  --}}}  
              RESULT Quot
          :
          --}}}  
          VAL XF IS Xfrac >> 1 :                     --ensure no div overflow
          SEQ
            Y := SUM32 (Y >> 1, DIV32 (XF,  Y))
            Y := SUM32 (Y >> 1, DIV32 (XF,  Y))
          --}}}  
          --{{{  determine correct value -- multiplication
          [2]INT32 Y2 :
          PLACE Y2 IN WORKSPACE :
          VAL INT lsbit IS #100 :
          VAL INT mask IS #FF00 :
          VAL INT lsbitShift IS 8 :
          SEQ
            [2]INT Y.i RETYPES Y :
            Y.i[0] := Y.i[0] /\ mask  -- truncate
            --{{{  multiply Y2 := Y * Y
            [2]INT hi.out RETYPES Y2[1] :
            VAL [2]INT x RETYPES Y :
            VAL [2]INT y RETYPES Y :
            [2]INT lo.out RETYPES Y2[0] :
            INT work1, work3, c0, c1 :
            SEQ
              INT carry :
              SEQ
                carry,  lo.out[0] := LONGPROD ( y[0],  x[0],  0)
                c0,  work1 := LONGPROD ( y[1],  x[0],  carry)
              INT carry :
              SEQ
                carry,  lo.out[1] := LONGPROD ( y[0],  x[1],  work1)
                c1,  work3 := LONGPROD ( y[1],  x[1],  carry)
              INT carry :
              SEQ
                carry,  hi.out[0] := LONGSUM ( work3,  c0,  0)
                carry,  hi.out[1] := LONGSUM ( c1,  0,  carry)
            --}}}  
            --{{{  add Y2 := Y2 + (Y * lsbit)
            [2]INT Y.i RETYPES Y :
            [4]INT Y.times.lsbit :
            PLACE Y.times.lsbit IN WORKSPACE :
            [4]INT Y2.i RETYPES Y2 :
            SEQ
              Y.times.lsbit := [0, 0, 0, 0 ]
              Y.times.lsbit[2], Y.times.lsbit[1] := SHIFTLEFT( 0 , Y.i[1], lsbitShift)
              Y.times.lsbit[1], Y.times.lsbit[0] := SHIFTLEFT( Y.i[1] , Y.i[0],lsbitShift)
              INT carry :
              SEQ
                carry, Y2.i[0] := LONGSUM( Y2.i[0], Y.times.lsbit[0], 0)
                carry, Y2.i[1] := LONGSUM( Y2.i[1], Y.times.lsbit[1], carry)
                carry, Y2.i[2] := LONGSUM( Y2.i[2], Y.times.lsbit[2], carry)
                carry, Y2.i[3] := LONGSUM( Y2.i[3], Y.times.lsbit[3], carry)
            --}}}  
            INT overflow :
            INT32 YplusLsbit :
            SEQ
              --{{{  YplusLsbit := Y + lsbit
              INT carry :
              [2]INT YplusLsbit.i RETYPES YplusLsbit :
              [2]INT Y.i RETYPES Y :
              SEQ
                carry, YplusLsbit.i[0] := LONGSUM( Y.i[0], lsbit, 0)
                overflow, YplusLsbit.i[1] := LONGSUM( Y.i[1], carry, 0)
              --}}}  
              IF
                overflow = 0
                  --{{{  select between Y and (Y + lsbit)
                  IF
                    Xfrac = Y2[1]
                      --{{{  equal
                      IF
                        Y2[0] = 0 (INT32)
                          --{{{  equal
                          [2]INT Y.i RETYPES Y :
                          [2]INT YplusLsbit.i RETYPES YplusLsbit :
                          IF
                            (Y.i[0] /\ lsbit) <> 0  -- odd fraction, so round up
                              SEQ
                                Y.i[0] := YplusLsbit.i[0]
                                Y.i[1] := YplusLsbit.i[1]
                            TRUE
                              SKIP
                          --}}}  
                        TRUE
                          SKIP
                      --}}}  
                    Xfrac > Y2[1]
                      Y := YplusLsbit
                    TRUE
                      SKIP
                  --}}}  
                TRUE
                  SKIP -- Y is the correct representation, as Y + lsbit overflows
          --}}}  
          --{{{  pack and round
          Xexp := (Xexp + RealXcess) >> 1
          Xfrac := Y /\ (INT32 RealExp)               --get round mask
          INT32 frac :
          SEQ
            frac := Y << 1
            VAL [2]INT lo.in RETYPES frac :
            [2]INT lo.out RETYPES Y :
            SEQ
              INT carry :
              carry,  lo.out[0] := SHIFTRIGHT (lo.in[1], lo.in[0], RealShift + 1)
              INT carry :
              carry,  lo.out[1] := SHIFTRIGHT (Xexp, lo.in[1], RealShift + 1)
          IF
            (Xfrac /\ (INT32 RealRBit)) = zero         --no round bit
              Root.i := Y
            ((Xfrac /\ (INT32 RealXcess)) \/ (Y /\ one)) <> zero --round up
              Root.i := Y + one
            TRUE
              Root.i := Y
          --}}}  
    RESULT Root
:
--}}}  

#ENDIF
