--
--	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 "E V"  -- no compiler libs, no vector space
#COMMENT "TA compiler library, V1.3 02/12/92"
#COMMENT "(c) Copyright INMOS Limited 1988"
--}}}

--{{{  #PRAGMA TRANSLATE
#PRAGMA TRANSLATE REAL64TOREAL32 "REAL64TOREAL32%CHK"
--}}}

#INCLUDE "realvals.inc"

--{{{  REAL64TOREAL32
REAL32 FUNCTION REAL64TOREAL32 (VAL INT Mode, VAL REAL64 X)

  --{{{  history
  -- Beta-2 (27feb87)
  -- V1.1, 21-Feb-89
  -- V1.2, 24-Feb-89
  -- V1.3,  2-Dec-92 SRH: textual clean up
  --}}}

  -- From here to the end of the routine is the same as that of the idebug
  -- version.  A change in one should be reflected in the other.

  REAL32 Result:
  VALOF
    #INCLUDE "nan32.inc"
    --{{{  constants
    --{{{  IEEE Constants
    VAL SN IS 1 :
    VAL DB IS 0 :
    VAL RealInf IS [#7FF00000, #7F800000] :
    --}}}
    --{{{  IEEE Double length constants for 32 bit implementation
    VAL DRealExpSh  IS   20 :
    --}}}
    VAL low  IS 0 :
    VAL high IS 1 :
    --}}}
    INT Result RETYPES Result :
    VAL [2]INT X RETYPES X :
    [2] INT Xfrac :
    PLACE Xfrac IN WORKSPACE :
    INT Xexp, Yfrac, Yexp, Places, Guard, Sign :
    SEQ
      --{{{  Unpack operands
      Xfrac [1],  Xfrac [0] := SHIFTLEFT ( X [1],  X [0],  DRealShift)
      Xexp := (X [1] >> DRealExpSh) /\ DRealExp
      Sign := (X [1] /\ SignBit)
      IF
        Xexp <> DRealExp
          --{{{  zeros or real no
          IF
            Xexp <> 0
              --{{{  normalised number
              SEQ                                  --normal case
                Yfrac := Xfrac [high] \/ SignBit   --replace implicit bit
                Guard := Xfrac [low]
                Yexp := Xexp - (DRealXcess - RealXcess)
                IF
                  Yexp >= RealExp                  --overflow
                    IF
                      Mode = Nearest
                        --{{{  overflow to infinity
                        SEQ
                          CAUSEERROR()
                          Yexp := RealExp
                          Yfrac := SignBit         --InfFrac
                        --}}}
                      Mode = Truncate
                        --{{{  overflow to biggest
                        SEQ
                          CAUSEERROR()
                          Yexp := (RealExp - 1)
                          Yfrac := #7FFFFF80       --BiggestFrac
                        --}}}
                  Yexp > 0                         --correct range
                    SKIP
                  Yexp > (1 - BitsPerWord)         --denormalised
                    -- Yexp = -31 => shift length = 32, so let fall through
                    SEQ -- the use of Places here is purely local to this SEQ
                      Places := Guard              --don't lose
                      Yfrac,  Guard := SHIFTRIGHT ( Yfrac,  Guard,  1 - Yexp)
                      Guard := Places \/ Guard
                      Yexp := 0
                  TRUE                             --underflow case
                    SEQ
                      Guard := Guard \/ Yfrac      --guard it correctly
                      Yfrac := 0                   --but set fraction to zero
                      Yexp := 0                    --and give it a zero exponent
              --}}}
            TRUE
              --{{{  Zero or denorm that goes to zero
              SEQ
                Yexp := 0
                Yfrac := 0
                Guard := Xfrac [1] \/ Xfrac [0]
              --}}}
          --}}}
        TRUE
          --{{{  inf or NaN
          SEQ
            CAUSEERROR()
            Xfrac [1] := Xfrac [1] /\ (~SignBit)   --clear top bit
            Yexp := RealExp
            IF
              ((Xfrac [1] \/ Xfrac [0]) <> 0)
                SEQ
                  Yfrac := Real64to32NaNfrac       --make sure nans don't become infs !
                  Sign := 0                        --created NaNs are +ve
              TRUE
                Yfrac := 0
          --}}}
      --}}}
      --{{{  round & pack result
      IF
        --{{{  Still in range
        Yexp < RealExp                             --still in range
          SEQ
            Places := Yfrac /\ RealExp             --get round bits
            Yexp,  Yfrac := SHIFTRIGHT ( Yexp,  Yfrac << 1,  RealShift + 1)
            IF
              (Mode = Truncate) OR ((Places /\ RealRBit) = 0)--round bit not set
                SKIP
              ((Guard \/ (Places /\ RealXcess)) \/ (Yfrac /\ 1)) = 0
                SKIP                               --round down
              TRUE                                 --round up/even
                SEQ
                  Yfrac := Yfrac + 1
                  IF
                    Yfrac = RealInf [SN]           --overflow
                      CAUSEERROR()
                    TRUE
                      SKIP
        --}}}
        --{{{  overflow to infinity
        TRUE
          SEQ
            CAUSEERROR()
            Yexp,  Yfrac := SHIFTRIGHT ( Yexp,  Yfrac << 1,  RealShift + 1)
        --}}}
      Result := Sign \/ Yfrac
      --}}}
    RESULT Result
:
--}}}

#ENDIF


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

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

--{{{  #PRAGMA TRANSLATE
#PRAGMA TRANSLATE REAL64TOREAL32 "REAL64TOREAL32%CHK"
--}}}

#INCLUDE "realvals.inc"

--{{{  REAL64TOREAL32
REAL32 FUNCTION REAL64TOREAL32 (VAL INT Mode, VAL REAL64 X)

  --{{{  history
  -- Function version (10 Jun 87)
  -- V1.1, 21-Feb-89
  -- V1.2,  2-Dec-92 SRH: bug fix TS/1981 - the smallest denormalised
  -- results were all being set to zero.
  --}}}

  REAL32 Result :
  VALOF
    #INCLUDE "nan16.inc"
    --{{{  constants
    --{{{  IEEE Quad length constants for 16 bit implementation
    VAL DRealExpSh  IS     4 :
    --}}}
    --{{{  IEEE Single length constants for 16 bit implementation
    VAL RealExpSh  IS     7 :
    VAL RealInf    IS #7F80 :
    --}}}
    --}}}
    [2]INT Result RETYPES Result :
    VAL [4]INT X RETYPES X :
    [4] INT Xfrac :
    PLACE Xfrac IN WORKSPACE :
    [2] INT Yfrac :
    PLACE Yfrac IN WORKSPACE :
    INT Xexp, Yexp, Carry, Places, Guard, Sign :
    SEQ
      --{{{  Unpack operands
      -- use Guard as a dummy here:
      Xfrac [3],  Guard := SHIFTLEFT ( X [3],  X [2],  DRealShift)
      Xfrac [2],  Guard := SHIFTLEFT ( X [2],  X [1],  DRealShift)
      Xfrac [1],  Xfrac [0] := SHIFTLEFT ( X [1],  X [0],  DRealShift)
      Xexp := (X [3] >> DRealExpSh) /\ DRealExp
      Sign := X[3] /\ SignBit
      IF
        Xexp <> DRealExp
          --{{{  zeros or real no
          IF
            Xexp <> 0
              --{{{  normalised number
              SEQ
                Yfrac [1] := Xfrac [3] \/ SignBit  --replace implicit bit
                Yfrac [0] := Xfrac [2]
                Guard := Xfrac [1] \/ Xfrac [0]
                Yexp := Xexp - (DRealXcess - RealXcess)
                IF
                  Yexp >= RealExp                  --overflow
                    IF
                      Mode = Nearest
                        --{{{  overflow to infinity
                        SEQ
                          CAUSEERROR()
                          Yexp := RealExp
                          Yfrac[1] := SignBit     --InfFrac
                          Yfrac[0] := 0
                        --}}}
                      Mode = Truncate
                        --{{{  overflow to biggest
                        SEQ
                          CAUSEERROR()
                          Yexp := (RealExp - 1)
                          Yfrac[1] := #7FFF       --BiggestFrac
                          Yfrac[0] := #FF80
                        --}}}
                  Yexp > 0                         --correct range
                    SKIP
                  Yexp > (1 - BitsPerWord)         --denormalised - 1 word shift
                    SEQ
                      -- Xexp is used as a dummy here:
                      Xexp, Carry := SHIFTRIGHT (Yfrac[0], Guard, 1 - Yexp)
                      Yfrac[1], Yfrac[0] := SHIFTRIGHT (Yfrac[1], Yfrac[0], 1 - Yexp)
                      Guard := Carry \/ Guard
                      Yexp := 0
                  Yexp > (1 - (2 * BitsPerWord))
                    SEQ
                      Yfrac[0], Carry := SHIFTRIGHT (Yfrac[1], Yfrac[0], 1 - (Yexp + BitsPerWord))
                      Yfrac [1] := 0
                      Guard := ((Guard \/ Carry) \/ Yfrac[0])
                      Yexp := 0
                  TRUE                             --underflow case
                    SEQ
                      Guard := (Guard \/ Yfrac [1]) \/ Yfrac [0] -- guard it correctly
                      Yfrac [1] := 0               --but set fraction to zero
                      Yfrac [0] := 0
                      Yexp := 0
              --}}}
            TRUE
              --{{{  Zero or denorm that goes to zero
              SEQ
                Yexp := 0
                Yfrac[1] := 0
                Yfrac[0] := 0
                Guard := ((Xfrac [3] \/ Xfrac [2]) \/ Xfrac [1]) \/ Xfrac [0]
              --}}}
          --}}}
        TRUE
          --{{{  inf or NaN
          SEQ
            CAUSEERROR()
            Xfrac [3] := Xfrac [3] /\ (~SignBit)   --clear top bit
            Yexp := RealExp
            IF
              ((Xfrac [3] \/ (Xfrac [2] \/ (Xfrac [1] \/ Xfrac[0]))) = 0) -- inf
                SEQ
                  Yfrac [1] := 0
                  Yfrac [0] := 0
              TRUE                                 --NaN
                SEQ
                  Yfrac [1] := Real64to32NaNfrac
                  Yfrac [0] := 0
                  Sign := 0                        --Created NaN is +ve
          --}}}
      --}}}
      --{{{  round & pack result
      --ROUND & PACK RESULT--
      IF
        --{{{  Still in range
        Yexp < RealExp                             --still in range
          SEQ
            Places := Yfrac [0]  /\ RealExp        --get round bits
            Yfrac [0],  Carry := SHIFTLEFT ( Yfrac [1],  Yfrac [0],  RealExpSh + 1)
            Yfrac [1],  Carry := SHIFTLEFT ( Yexp,  Yfrac [1] << 1,  RealExpSh)
            IF
              (Mode = Truncate) OR ((Places /\ RealRBit) = 0) --round bit not set
                SKIP
              ((Guard \/ (Places /\ RealXcess)) \/ (Yfrac [0] /\ 1)) = 0
                SKIP                               --round down
              TRUE                                 --round up/even
                SEQ
                  Carry, Yfrac[0] := LONGSUM (Yfrac[0], 1, 0)
                  Carry, Yfrac[1] := LONGSUM (Yfrac[1], 0, Carry)
                  IF
                    Yfrac [1] = RealInf            --overflow
                      CAUSEERROR()
                    TRUE
                      SKIP
        --}}}
        --{{{  overflow to infinity
        TRUE
          SEQ
            CAUSEERROR()
            Carry,  Yfrac [0] := SHIFTRIGHT ( Yfrac [1],  Yfrac [0],  RealShift)
            Yexp,  Yfrac [1] := SHIFTRIGHT ( Yexp,  Yfrac [1] << 1,  RealShift + 1)
        --}}}
      Result [1] := Sign \/ Yfrac [1]
      Result [0] := Yfrac [0]
      --}}}
    RESULT Result
:
--}}}

#ENDIF
