--
--      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
--

--** @module forall

#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/04/90"
#COMMENT "(c) Copyright INMOS Limited 1988"
--}}}

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

#INCLUDE "realvals.inc"

--{{{  
INT16 FUNCTION REAL32TOINT16 (VAL INT Mode, VAL REAL32 X)

  -- Function version (10 Jun 87)
  -- Changed the result type from INT to INT16; V1.2, 16 Nov 89 SRH
  -- V1.3, 7-Apr-90 SRH

  -- Round real value to nearest integer or to zero, returns an integer
  -- result. Error flag is set if overflow occurs.
  --   Mode      : Truncate or Nearest (rounding mode)
  --   X         : source real

  INT N :
  VALOF
    VAL [2]INT X RETYPES X :
    INT Dump, Guard, Xexp :
    [2] INT Xfrac :
    PLACE Xfrac IN WORKSPACE :
    INT Sign :
    SEQ
      Sign := SignBit
      Xexp,  Dump := SHIFTLEFT ( 0,  X[1] /\ (~Sign),  RealShift + 1)
      Xfrac[1],  Xfrac[0] := SHIFTLEFT ( X[1],  X[0],  RealShift + 1)
      IF
        --{{{  Inf or NaN
        Xexp = RealExp                    --not valid
          CAUSEERROR()
        --}}}
        --{{{  X < 0.5
        Xexp < (RealXcess - 1)            --less than half
          N := 0
        --}}}
        --{{{  0.5 <= X < 1.0
        Xexp < RealXcess                  --0.5 to 0.9*
          IF
            (Mode = Truncate) OR ((Xfrac[1] \/ Xfrac[0]) = 0)--round to zero
              N := 0
            (X[1] /\ Sign) = 0             --round up
              N := 1
            TRUE
              N := -1
        --}}}
        --{{{  X is most negative integer
        (Xexp = (RealXcess + (BitsPerWord - 1))) AND ((X[1] /\ Sign) <> 0) AND
         ((Xfrac[1] = 0) OR ((Mode = Truncate) AND (Xfrac[1] = 1)))
          N := Sign
        --}}}
        --{{{  1.0 <= X
        TRUE
          SEQ
            --{{{  Extract integer
            Xexp := Xexp - RealXcess
            Guard := 1                     --set top bit
            IF
              Xexp > (BitsPerWord - 2)  --losing bits
                CAUSEERROR()
              TRUE
                SKIP
            IF
              Xexp >= BitsPerWord
                SEQ
                  Guard,  Xfrac[1] := SHIFTLEFT ( Xfrac[1],  Xfrac[0],  Xexp - BitsPerWord)
                  Xfrac[0] := 0
              TRUE
                SEQ
                  Guard,  Dump := SHIFTLEFT ( Guard,  Xfrac[1],  Xexp)
                  Xfrac[1],  Xfrac[0] := SHIFTLEFT ( Xfrac[1],  Xfrac[0],  Xexp)
            --}}}
            --{{{  Round
            IF
              --round bit clear
              (Mode = Truncate) OR ((Xfrac[1] /\ Sign) = 0)--round to zero
                SKIP
              (((Xfrac[1] /\ (~Sign)) \/ Xfrac[0]) \/ (Guard /\ 1)) = 0--round down
                SKIP
              TRUE                         --round up/even
                SEQ     -- Check, overflow may occur
                  Dump,  Guard := LONGSUM ( Guard,  1,  0)
                  IF
                    Guard < 0
                      CAUSEERROR()
                    TRUE
                      SKIP
            --}}}
            --{{{  Get sign of real
            Guard := Guard /\ (~Sign)      --drop excess top bit
            IF
              (X[1] /\ Sign) = 0           --positive
                SKIP
              TRUE
                Guard := -Guard
            --}}}
            N := Guard
        --}}}
    RESULT INT16 N
:
--}}}

#ENDIF
