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

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

#INCLUDE "realvals.inc"

--{{{  
INT64 FUNCTION REAL32TOINT64 (VAL INT Mode, VAL REAL32 A)

  --{{{  history
  -- Beta-2 (27feb87)
  -- V1.1, 21-Feb-89
  -- V1.2, 24-Feb-89
  -- V1.3, 7-Apr-90 SRH
  --}}}

  INT64 Result:
  VALOF
    --{{{  constants
    VAL INT REAL32MININT64 IS #DF000000 :
    VAL low  IS 0 :
    VAL high IS 1 :
    --}}}
    [2]INT Result RETYPES Result :
    VAL INT A RETYPES A :
    [2] INT B :
    PLACE B IN WORKSPACE :
    INT Xfrac, Xexp, Carry :
    --{{{  main body
    IF
      A = REAL32MININT64
        SEQ
          Result [high] := SignBit
          Result [low] := 0
      TRUE
        SEQ
          Xexp,  Xfrac := SHIFTLEFT ( 0,  A << 1,  RealShift)
          IF
            Xexp < (RealXcess - 1) -- 0 <= x < 0.5
              SEQ
                Result [high] := 0
                Result [low] := 0
            Xexp > (((2 * BitsPerWord) - 2) + RealXcess)
              CAUSEERROR()
            TRUE
              --{{{  
              SEQ
                Carry,  Xfrac := SHIFTRIGHT ( 1,  Xfrac,  1)
                IF
                  Xexp < (RealXcess + BitsPerWord)-- Doesnt move out of
                    SEQ
                      B [low],  Xfrac := SHIFTLEFT ( 0,  Xfrac,  (1 + Xexp) - RealXcess)
                      B [high] := 0
                      IF
                        (Mode = Truncate) OR ((Xfrac /\ SignBit) = 0)
                          SKIP
                        ((Xfrac /\ (~SignBit)) \/ (B [low] /\ 1)) = 0--round down
                          SKIP
                        TRUE                                   --round up/even
                          --{{{  
                          SEQ
                            Carry,  B [low] := LONGSUM ( 1,  B [low],  0)
                            B [high] := LONGADD ( B [high],  0,  Carry)
                          --}}}
                  TRUE
                    SEQ
                      B [high],  B [low] := SHIFTLEFT ( 0,  Xfrac, ((1 + Xexp) - RealXcess) -
                                                                   BitsPerWord)
                --{{{  Negate if necessary
                IF
                  A < 0
                    SEQ
                      Carry,  Result [low] := LONGDIFF ( 0,  B [low],  0)
                      Carry,  Result [high] := LONGDIFF ( 0,  B [high],  Carry)
                  TRUE
                    SEQ
                      Result [low] := B [low]
                      Result [high] := B [high]
                --}}}
              --}}}
    --}}}
    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 07/04/90"
#COMMENT "(c) Copyright INMOS Limited 1988"
--}}}

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

#INCLUDE "realvals.inc"

--{{{  
INT64 FUNCTION REAL32TOINT64 (VAL INT Mode, VAL REAL32 A)

  --{{{  history
  -- Function version (10 Jun 87)
  -- V1.1, 21-Feb-89
  -- V1.2, 7-Apr-90 SRH
  --}}}
  --{{{  comments
  -- 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)
  --   A         : source real
  --}}}

  INT64 N :
  VALOF
    [4]INT N RETYPES N :
    VAL [2]INT X RETYPES A :

    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)
      IF
        --{{{  Inf or NaN
        Xexp = RealExp
          CAUSEERROR()
        --}}}
        --{{{  0  <= |X| < 0.5
        Xexp < (RealXcess - 1)
          N := [0,0,0,0]
        --}}}
        --{{{  0.5 <= |X| < 1
        Xexp < RealXcess
          IF
            (Mode = Truncate) OR ((Xfrac[1] \/ Xfrac[0]) = 0)--round to zero
              N := [0,0,0,0]
            (X[1] /\ Sign) = 0             --round up
              N := [1,0,0,0]
            TRUE
              N := [-1,-1,-1,-1]
        --}}}
        --{{{  Most negative floated integer
        (Xexp = (RealXcess + ((BitsPerWord * 4) - 1))) AND
                        ((Xfrac[1] \/ Xfrac[0]) = 0) AND ((X[1] /\ Sign) <> 0)
          N := [0,0,0,Sign]   -- most negative integer
        --}}}
        --{{{  |X| > 1
        TRUE
          SEQ
            Xfrac[1] := Xfrac[1] \/ Sign -- restore implied bit
            Xsign := X[1] /\ Sign
            Xexp := Xexp - RealXcess
            IF
              Xexp > ((4 * BitsPerWord) - 2)--losing bits
                CAUSEERROR()
              TRUE
                SKIP
            --{{{  Do Shift
            IF
              Xexp < BitsPerWord        --not past word shift
                --{{{  
                SEQ
                  Carry := Xfrac[0]
                  Guard := Xfrac[1]
                  N := [0,0,0,0]
                --}}}
              Xexp < (2 * BitsPerWord)
                --{{{  
                SEQ
                  Xexp := Xexp - BitsPerWord
                  Carry := 0
                  Guard := Xfrac [0]
                  N := [Xfrac [1],0,0,0]
                --}}}
              Xexp < (3 * BitsPerWord)
                --{{{  
                SEQ
                  Xexp := Xexp - (2 * BitsPerWord)
                  Carry := 0
                  Guard := 0
                  N := [Xfrac [0], Xfrac[1], 0, 0]
                --}}}
              Xexp < (4 * BitsPerWord)
                --{{{  
                SEQ
                  Xexp := Xexp - (3 * BitsPerWord)
                  Carry := 0
                  Guard := 0
                  N := [0, Xfrac[0], Xfrac[1], 0]
                --}}}
              TRUE
                --{{{  
                SEQ
                  Xexp := Xexp - (4 * BitsPerWord)
                  N := [0, 0, Xfrac[0], Xfrac[1]]
                  Guard := 0
                  Carry := 0
                --}}}
            Xexp := Xexp + 1 -- to get correct shift
            N[3],  Dump := SHIFTLEFT ( N[3],  N[2],  Xexp)
            N[2],  Dump := SHIFTLEFT ( N[2],  N[1],  Xexp)
            N[1],  Dump := SHIFTLEFT ( N[1],  N[0],  Xexp)
            N[0],  Dump := SHIFTLEFT ( N[0],  Guard,  Xexp)
            Guard,  Carry := SHIFTLEFT ( Guard,  Carry,  Xexp)
            --}}}
            --{{{  Round
            IF
              (Mode = Truncate) OR ((Guard /\ Sign) = 0)--round to zero
                SKIP
              (((Guard /\ (~Sign)) \/ Carry) \/ (N[0] /\ 1)) = 0--round down
                SKIP
              TRUE                           --round up/even
                SEQ
                  Carry,  N[0] := LONGSUM ( N[0],  1,  0)
                  Carry,  N[1] := LONGSUM ( N[1],  0,  Carry)
                  Carry,  N[2] := LONGSUM ( N[2],  0,  Carry)
                  Carry,  N[3] := LONGSUM ( N[3],  0,  Carry)
                  IF
                    N[3] < 0
                      CAUSEERROR()
                    TRUE
                      SKIP
            --}}}
            --{{{  Set sign
            N [3] := N [3] /\ (~Sign)
            IF
              Xsign = 0                      --positive
                SKIP
              TRUE
                SEQ
                  Carry,  N[0] := LONGDIFF ( 0,  N[0],  0)
                  Carry,  N[1] := LONGDIFF ( 0,  N[1],  Carry)
                  Carry,  N[2] := LONGDIFF ( 0,  N[2],  Carry)
                  Carry,  N[3] := LONGDIFF ( 0,  N[3],  Carry)
            --}}}
        --}}}
    RESULT N
:
--}}}

#ENDIF
