--
--	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 libraries, no vector space
#COMMENT "TA compiler library, V1.4 07/04/90"
#COMMENT "(c) Copyright INMOS Limited 1988"
--}}}

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

#INCLUDE "realvals.inc"

--{{{  
INT32 FUNCTION REAL32TOINT32 (VAL INT Mode, VAL REAL32 X)

  --{{{  comment
  -- Round real value to nearest integer or to zero, returns an integer
  -- result.
  --   N         : destination integer
  --   Mode      : Nearest or Truncate
  --   X         : real value to convert from
  --}}}
  --{{{  history
  -- V1.1, 21-Feb-89
  -- V1.2, 24-Feb-89
  -- Changed result type from INT to INT32; V1.3, 10-Jan-90 SRH
  -- V1.4, 7-Apr-90 SRH
  --}}}

  INT N:
  VALOF
    VAL INT X RETYPES X :
    --{{{  constants
    VAL INT REAL32MININT32 IS #CF000000 :
    --}}}
    --{{{  variables
    INT Guard, Xexp, Xfrac, Sign :
    --}}}
    --{{{  code
    SEQ
      Sign := SignBit
      Xexp,  Xfrac := SHIFTLEFT ( 0,  X /\ (~Sign),  RealShift + 1)
      IF
        Xexp = RealExp                     --not valid
          CAUSEERROR()
        Xexp < (RealXcess - 1)             --less than half
          N := 0
        Xexp < RealXcess                   --0.5 to 0.9*
          --{{{  
          IF
            (Mode = Truncate) OR (Xfrac = 0)
              N := 0                       --round down
            (X /\ Sign) = 0                --round up (positive)
              N := 1
            TRUE                           --round up (negative)
              N := -1
          --}}}
        X = REAL32MININT32
          N := Sign                        --most negative integer number
        TRUE
          --{{{  general case
          SEQ
            Xexp := Xexp - RealXcess
            Guard := 1                                  --set top bit
            IF
              Xexp > (BitsPerWord - 2)                  --losing bits
                --{{{  
                SEQ
                  CAUSEERROR()
                  Guard,  Xfrac := SHIFTLEFT ( Guard,  Xfrac,  Xexp - BitsPerWord)
                --}}}
              TRUE
                Guard,  Xfrac := SHIFTLEFT ( Guard,  Xfrac,  Xexp)
            IF
              (Mode = Truncate) OR ((Xfrac /\ Sign) = 0)
                SKIP
              ((Xfrac /\ (~Sign)) \/ (Guard /\ 1)) = 0  --round down
                SKIP
              TRUE                                      --round up/even
                --{{{  
                SEQ
                  Guard := Guard + 1
                  IF
                    (Guard /\ Sign) = 0                 --no overflow
                      SKIP
                    TRUE
                      CAUSEERROR()
                --}}}
            IF
              (X /\ Sign) = 0                           --positive
                N := Guard /\ (~Sign)
              TRUE                                      --negative
                N := -(Guard /\ (~Sign))
          --}}}
    --}}}
    RESULT (INT32 N)
:
--}}}

#ENDIF


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

--{{{  #options and #comments
#OPTION "E V"  -- no compiler libraries, no vector space
#COMMENT "T2 compiler library, V1.2 07/04/90"
#COMMENT "(c) Copyright INMOS Limited 1988"
--}}}

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

#INCLUDE "realvals.inc"

--{{{  
INT32 FUNCTION REAL32TOINT32 (VAL INT Mode, VAL REAL32 X)

  --{{{  comment
  -- Round real value double length integer (round to nearest or zero),
  -- returns an integer result. Error flag is set if an error occurs.
  --   Mode      : Truncate or Nearest (rounding mode)
  --   X         : source real
  --}}}
  --{{{  history
  -- Function version (10 Jun 87)
  -- V1.1, 21-Feb-89
  -- V1.2, 7-Apr-90 SRH
  --}}}

  INT32 N :
  VALOF
    [2]INT N RETYPES N :
    VAL [2]INT X RETYPES X :
    INT Carry, Dump, Guard, Xexp :
    [2] INT Xfrac :
    PLACE Xfrac IN WORKSPACE :
    INT Xsign :
    INT Sign :
    SEQ
      Sign := SignBit
      Xexp,  Dump := SHIFTLEFT ( 0,  X[1]<<1 ,  RealShift)
      Xfrac[1],  Xfrac[0] := SHIFTLEFT ( X[1],  X[0],  RealShift + 1)
      IF
        --{{{  Inf or NaN
        Xexp = RealExp
          CAUSEERROR()
        --}}}
        --{{{  0  <= |X| < 0.5
        Xexp < (RealXcess - 1)
          N := [0,0]
        --}}}
        --{{{  0.5 <= |X| < 1
        Xexp < RealXcess
          IF
            (Mode = Truncate) OR ((Xfrac[1] \/ Xfrac[0]) = 0)--round to zero
              N := [0,0]
            (X[1] /\ Sign) = 0             --round up
              N := [1,0]
            TRUE
              N := [-1,-1]
        --}}}
        --{{{  Most negative floated integer
        (Xexp = (RealXcess + ((BitsPerWord * 2) - 1))) AND
         ((Xfrac[1] \/ Xfrac[0]) = 0) AND ((X[1] /\ Sign) <> 0)
          N := [0,Sign]   -- most negative integer
        --}}}
        --{{{  |X| > 1
        TRUE
          SEQ
            Xsign := X[1] /\ Sign
            Xexp := Xexp - RealXcess
            IF
              Xexp > ((2 * BitsPerWord) - 2)--losing bits
                CAUSEERROR()
              TRUE
                SKIP
            --{{{  Do Shift
            IF
              Xexp < BitsPerWord        --not past word shift
                SEQ
                  Carry := Xfrac[0]
                  Xfrac[0] := Xfrac[1]
                  Xfrac[1] := 1
                  Guard := 0
              Xexp < (2 * BitsPerWord)
                SEQ
                  Xexp := Xexp - BitsPerWord
                  Carry := 0
                  Guard := 1               --set top bit
              TRUE
                SEQ
                  Xexp := Xexp - (2 * BitsPerWord)
                  Guard := Xfrac[1]
                  Xfrac[1] := Xfrac[0]
                  Xfrac[0] := 0
                  Carry := 0
            Guard,  Dump := SHIFTLEFT ( Guard,  Xfrac[1],  Xexp)
            Xfrac[1],  Dump := SHIFTLEFT ( Xfrac[1],  Xfrac[0],  Xexp)
            Xfrac[0],  Carry := SHIFTLEFT ( Xfrac[0],  Carry,  Xexp)
            --}}}
            --{{{  Round
            IF
              (Mode = Truncate) OR ((Xfrac[0] /\ Sign) = 0)--round to zero
                SKIP
              (((Xfrac[0] /\ (~Sign)) \/ Carry) \/ (Xfrac[1] /\ 1)) = 0--round down
                SKIP
              TRUE                           --round up/even
                SEQ
                  Carry,  Xfrac[1] := LONGSUM ( Xfrac[1],  1,  0)
                  Carry,  Guard := LONGSUM ( Guard,  0,  Carry)
                  IF
                    Guard < 0
                      CAUSEERROR()
                    TRUE
                      SKIP
            --}}}
            --{{{  Set sign
            N[1] := Guard /\ (~Sign)         --dump excess top bits
            N[0] := Xfrac[1]
            IF
              Xsign = 0                      --positive
                SKIP
              TRUE
                SEQ
                  Carry,  N[0] := LONGDIFF ( 0,  N[0],  0)
                  Carry,  N[1] := LONGDIFF ( 0,  N[1],  Carry)
            --}}}
        --}}}
    RESULT N
:
--}}}

#ENDIF
