--
--	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 = 32)

--{{{  #options and #comments
#OPTION "V"  -- no vector space
#COMMENT "TA compiler library, V1.4 15/05/91"
#COMMENT "(c) Copyright INMOS Limited 1988"
--}}}

#PRAGMA TRANSLATE DARGUMENT.REDUCE "DARGUMENT.REDUCE%O"

#INCLUDE "realvals.inc"

--{{{  DARGUMENT.REDUCE for TA
BOOL, INT32, REAL64 FUNCTION DARGUMENT.REDUCE (VAL REAL64 Y, Z, Z.err)

  --{{{  history
  -- 20 Aug 87
  -- V1.2, version using QUOTREM 20-Mar-1989
  -- V1.3, 6-Apr-90 SRH
  -- Altered so that main transputer error flag is not set, and
  -- routine acts pretty much in the way one would expect for an
  -- IEEE implementation. Bug report TS/1252; V1.4, 15-May-91 SRH
  --}}}

  #INCLUDE "endian.inc" -- 4-Sep-07

  BOOL   b :
  INT32  N :
  REAL64 X :
  VALOF
    #INCLUDE "nan32.inc"
    --{{{  IEEE64QUOTREM -- returning INT32
    BOOL, INT32, REAL64 FUNCTION IEEE64QUOTREM (VAL REAL64 X, VAL REAL64 Y)
    
      -- Beta-3 (11feb87)
      -- Modified to produce quotient 20-Mar-1989 PWT
      -- Quotient initialised to zero; 15-May-1991 SRH
    
      BOOL   Error:
      INT32  Quotient :
      REAL64 Result:
      VALOF
        #PRAGMA TRANSLATE RealIDiv "RealIDiv%CHK"
        #USE "ridiv"  --  13-Sep-07
        --{{{  declarations
        INT Quotient RETYPES Quotient :
        [2]INT Result RETYPES Result :
        VAL [2]INT X RETYPES X :
        VAL [2]INT Y RETYPES Y :
        INT Xexp, Yexp :
        [2] INT Xfrac :
        PLACE Xfrac IN WORKSPACE :
        [2] INT Yfrac :
        PLACE Yfrac IN WORKSPACE :
        INT Carry, Guard, Places :
        [2] INT Ans :
        PLACE Ans IN WORKSPACE :
        VAL INT Sign IS SignBit :
        --}}}
        SEQ
          --{{{  Unpack operands
          --{{{  Seperate mantissa and exponents
          Xfrac [hi],  Xfrac [lo] := SHIFTLEFT ( X [hi],  X [lo],  DRealShift)
          Yfrac [hi],  Yfrac [lo] := SHIFTLEFT ( Y [hi],  Y [lo],  DRealShift)
          
          Xexp := (X [hi] >> DRealExpSh) /\ DRealExp
          Yexp := (Y [hi] >> DRealExpSh) /\ DRealExp
          --}}}
          
          Quotient := 0
          Ans [lo]  := 0
          Carry    := 0                                -- assume not normal case
          Error    := FALSE                            -- assume not normal case
          IF
            (Xexp <> DRealExp) AND (Yexp <> DRealExp)
              --{{{  zeros or real numbers
              IF
                (Xexp <> 0) AND (Yexp <> 0)
                  --{{{  both normal numbers
                  SEQ                                  -- normal case
                    Carry := 1
                    Xfrac [hi] := Xfrac [hi] \/ Sign
                    Yfrac [hi] := Yfrac [hi] \/ Sign
                  --}}}
                ((Yexp \/ Yfrac [hi]) \/ Yfrac [lo]) = 0
                  --{{{  Y is zero
                  SEQ
                    Ans [hi] := RemZeroNaN.hi
                    Ans [lo] := 0
                    Error := TRUE
                  --}}}
                ((Xexp \/ Xfrac [hi]) \/ Xfrac [lo]) = 0
                  --{{{  X is zero
                  SEQ
                    Ans := X
                    Quotient := 0
                  --}}}
                TRUE
                  --{{{  one or both are denormalised
                  -- Put in implicit MSB
                  -- Normalise any denormaliseds and correct their exponents if op is
                  -- multiply, divide or rem leave unormal for add and sub
                  SEQ
                    Carry := 1                         -- work to do
                    IF
                      Xexp <> 0                        -- set leading bit
                        Xfrac [hi] := Xfrac [hi] \/ Sign
                      TRUE                             -- set correct exponent
                        SEQ
                          Places,  Xfrac [hi],  Xfrac [lo] := NORMALISE ( Xfrac [hi],  Xfrac [lo])
                          Xexp := 1 - Places
                    IF
                      Yexp <> 0
                        Yfrac [1] := Yfrac [1] \/ Sign
                      TRUE
                        SEQ
                          Places,  Yfrac [hi],  Yfrac [lo] := NORMALISE ( Yfrac [hi],  Yfrac [lo])
                          Yexp := 1 - Places
                  --}}}
              --}}}
            TRUE
              --{{{  one or other inf/NaN
              SEQ
                Xfrac [hi] := Xfrac [hi] /\ (~Sign)      -- clear top bits
                Yfrac [hi] := Yfrac [hi] /\ (~Sign)
                Error := TRUE
                IF
                  (Xexp = DRealExp) AND (Yexp = DRealExp)
                    --{{{  both inf/NaN
                    IF
                      ((Xfrac[hi] \/ Xfrac[lo]) \/ (Yfrac[hi] \/ Yfrac[lo])) = 0  -- both infs
                        SEQ
                          Ans [hi] := RemInfNaN.hi
                          Ans [lo] := 0
                      TRUE
                        SEQ
                          Guard, Places := LONGDIFF (Xfrac[lo], Yfrac[lo], 0)
                          Guard, Places := LONGDIFF (Xfrac[hi], Yfrac[hi], Guard)
                          IF
                            Places < 0
                              Ans := Y
                            TRUE
                              Ans := X
                    --}}}
                  Xexp = DRealExp
                    --{{{  X is inf/NaN
                    IF
                      (Xfrac [hi] \/ Xfrac [lo]) <> 0
                        Ans := X
                      TRUE
                        SEQ
                          Ans [hi] := RemInfNaN.hi
                          Ans [lo] := 0
                    --}}}
                  (Yfrac [hi] \/ Yfrac [lo]) <> 0
                    --{{{  Y is NaN
                    Ans := Y
                    --}}}
                  TRUE
                    --{{{  Y is inf
                    Ans := X
                    --}}}
              --}}}
          --}}}
          --{{{  evaluate
          IF
            Carry = 0
              --{{{  Answer is set up
              SEQ
                Result[hi] := Ans[hi]
                Result[lo] := Ans[lo]
              --}}}
            TRUE
              --{{{  Do remainder
              SEQ
                --{{{  find remainder
                SEQ
                  -- Denorms already normalised
                  Ans[hi] := X[hi] /\ Sign               -- set correct sign
                  Places := Xexp - Yexp
                  IF
                    Places >= 0                        -- general case
                      SEQ
                        Carry := Places /\ (BitsPerWord - 1)
                        Guard,  Xexp := SHIFTLEFT ( 0,  Xfrac[hi],  Carry)
                        Xfrac[hi],  Xfrac[lo] := SHIFTLEFT ( Xfrac[hi],  Xfrac[lo],  Carry)
                        Guard,  Xfrac[hi],  Xfrac[lo] := RealIDiv (Guard,  Xfrac[hi],  Xfrac[lo],  Yfrac)
                        Places := Places - Carry
                        WHILE Places > 0
                          SEQ
                            Guard := Xfrac[hi]
                            Xfrac[hi] := Xfrac[lo]
                            Xfrac[lo] := 0
                            Carry,  Xexp := LONGDIFF ( Xfrac[hi],  Yfrac[hi],  0)
                            IF
                              (Guard = 0) AND (Carry <> 0) -- filter out some 0 quotients
                                SKIP
                              TRUE
                                Guard,  Xfrac[hi],  Xfrac[lo] := RealIDiv (Guard,  Xfrac[hi],  Xfrac[lo],  Yfrac)
                            Places := Places - BitsPerWord
                        IF
                          (Xfrac[hi] \/ Xfrac[lo]) = 0   -- divides exactly
                            SEQ
                              Xexp := 0
                              Quotient := Guard
                          TRUE
                            SEQ
                              Ans[hi],  Ans[lo] := SHIFTRIGHT (Yfrac[hi],  Yfrac[lo],  1)
                              Carry,  Ans[lo] := LONGDIFF ( Ans[lo], Xfrac[lo],  0)
                              Carry,  Ans[hi] := LONGDIFF ( Ans[hi], Xfrac[hi],  Carry)
                              IF
                                (Carry <> 0) OR (((Ans[hi] \/ Ans[lo]) = 0) AND
                                 ((Guard /\ 1) <> 0))
                                  --over half or exactly half -- round up
                                  SEQ
                                    Ans[hi] := (X[hi] >< Sign) /\ Sign--negate ans
                                    Carry,  Xfrac[lo] := LONGDIFF ( Yfrac[lo], Xfrac[lo],  0)
                                    Carry,  Xfrac[hi] := LONGDIFF ( Yfrac[hi], Xfrac[hi],  Carry)
                                    Quotient := Guard + 1
                                TRUE
                                  SEQ
                                    Ans[hi] := X[hi] /\ Sign  -- reset sign
                                    Quotient := Guard
                              Xexp := Yexp
                    Places = (-1)                      -- half to nearly one
                      SEQ
                        Carry,  Guard := LONGDIFF ( Yfrac[lo],  Xfrac[lo],  0)
                        Carry,  Guard := LONGDIFF ( Yfrac[hi],  Xfrac[hi],  Carry)
                        IF
                          Carry = 0                    -- X is answer
                            Quotient := 0
                          TRUE                         -- Y-X is answer
                            SEQ
                              Ans[hi] := Ans[hi] >< Sign -- invert sign
                              Xfrac[hi],  Xfrac[lo] := SHIFTRIGHT (Xfrac[hi],  Xfrac[lo],  1)
                              Carry,  Xfrac[lo] := LONGDIFF ( Yfrac[lo], Xfrac[lo],  0)
                              Carry,  Xfrac[hi] := LONGDIFF ( Yfrac[hi], Xfrac[hi],  Carry)
                              Xexp := Yexp
                              Quotient := 1
                    TRUE                               -- less than half
                      Quotient := 0
                  Guard := 0
                  Places,  Xfrac[hi],  Xfrac[lo] := NORMALISE ( Xfrac[hi],  Xfrac[lo])
                  Xexp := Xexp - Places                -- ensure normalised
                  IF
                    Xexp <= 0                          -- gone denorm
                      SEQ
                        Xfrac[hi],  Xfrac[lo] := SHIFTRIGHT (Xfrac[hi],  Xfrac[lo],  1 - Xexp)
                        Xexp := 0
                    TRUE
                      SKIP
                --}}}
                --{{{  pack result
                Places := Xfrac[lo]                     -- save round bits
                Xfrac[hi],  Xfrac[lo] := SHIFTRIGHT (Xfrac[hi] /\ (~Sign),  Xfrac[lo],  DRealShift)
                Carry,  Xexp := SHIFTRIGHT ( Xexp,  0,  DRealShift + 1)
                Xfrac[hi] := Xfrac[hi] \/ Xexp
                
                Result[hi] := Ans[hi] \/ Xfrac[hi]
                Result[lo] := Xfrac[lo]
                --}}}
                --{{{  adjust sign of quotient
                IF
                  ((X[hi] >< Y[hi]) /\ Sign) <> 0        -- signs differ
                    Quotient := MINUS Quotient
                  TRUE
                    SKIP
                --}}}
              --}}}
          --}}}
        RESULT Error, Quotient, Result
    :
    --}}}
    VAL INT Max.Diff IS 30 :
    INT exp1, exp2, frac :
    SEQ
      --{{{  extract exponents
      VAL [2]INT Y.int RETYPES Y:
      exp1, frac := SHIFTLEFT (0, (Y.int[hi] << 1), DRealShift)
      VAL [2]INT Z.int RETYPES Z:
      exp2, frac := SHIFTLEFT (0, (Z.int[hi] << 1), DRealShift)
      --}}}
      b, N, X := IEEE64QUOTREM (Y, Z)
      IF
        (exp1 - exp2) <= Max.Diff
          SEQ
            #IF DEFINED(TARGET.HAS.FPU)
            X := X - ((REAL64 ROUND N) * Z.err)
            #ELSE
            X := REAL64OP( X, sub, REAL64OP( (REAL64 ROUND N), mul, Z.err ) )
            #ENDIF
            INT32 Nprimed :
            BOOL  bprimed :
            SEQ
              -- take another remainder in case the correction has taken us
              -- out of range :
              bprimed, Nprimed, X := IEEE64QUOTREM (X, Z)
              b := NOT (b OR bprimed) -- true unless an error
              N := N + Nprimed
        TRUE
          SEQ
            b := FALSE
            -- Y and Z may be normal, but a non-finite Z.err must then be
            -- invalid so now check for such an occurrence.
            IF
              DNOTFINITE( Z.err )
                [2]INT X RETYPES X:
                SEQ
                  X[hi] := InvalidOperandsNaN.hi
                  X[lo] := 0
              TRUE
                SKIP
    RESULT b, N, X
:
--}}}

#ENDIF


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

--{{{  #OPTION and #COMMENT
#OPTION "V"  -- no vector space
#COMMENT "T2 compiler library, V1.3 15/05/91"
#COMMENT "(c) Copyright INMOS Limited 1988"
--}}}

--{{{  #PRAGMA TRANSLATE
#PRAGMA TRANSLATE DARGUMENT.REDUCE "DARGUMENT.REDUCE%O"
--}}}

#INCLUDE "realvals.inc"

--{{{  DARGUMENT.REDUCE for T2
BOOL, INT32, REAL64 FUNCTION DARGUMENT.REDUCE (VAL REAL64 Y, Z, Z.err)

  --{{{  history
  -- Function version (20 Aug 87)
  -- V1.1, version using QUOTREM 20-Mar-1989
  -- V1.2, 6-Apr-90 SRH
  -- Altered so that main transputer error flag is not set, and
  -- routine acts pretty much in the way one would expect for an
  -- IEEE implementation. Bug report TS/1252; V1.3, 15-May-91 SRH
  --}}}

  BOOL   b :
  INT32  N :
  REAL64 X :
  VALOF
    #INCLUDE "nan16.inc"
    --{{{  #USEs
    #PRAGMA TRANSLATE QRealIDiv "QRealIDiv%CHK"
    #PRAGMA TRANSLATE QUADNORMALISE "QUADNORMALISE%CHK"
    #PRAGMA TRANSLATE QUADSHIFTRIGHT "QUADSHIFTRIGHT%CHK"
    #USE "qnorm"
    #USE "qridiv"
    #USE "qshiftr"
    --}}}
    VAL INT Max.Diff IS 30 :
    INT exp1, exp2, frac :
    --{{{  IEEE64QUOTREM -- returns INT32
    BOOL, INT32, REAL64 FUNCTION IEEE64QUOTREM (VAL REAL64 X, Y)
    
      -- Beta-3 (11may87)  Function version (10 Jun 87)
      -- Modified to produce quotient 20-Mar-1989 PWT
      -- Quotient initialised to zero. 15-May-1991 SRH
    
      BOOL   Error :
      INT32  Quotient :
      REAL64 Result :
      VALOF
        --{{{  Definitions
        VAL DRealExpSh  IS     4 :
        VAL DRealInf    IS #7FF0 :
        --}}}
        --{{{  declarations
        [2]INT Quotient RETYPES Quotient :
        [4]INT Result RETYPES Result :
        VAL [4]INT X RETYPES X :
        VAL [4]INT Y RETYPES Y :
        [4] INT Ans :
        PLACE Ans IN WORKSPACE :
        INT Xexp :
        [4] INT Xfrac :
        PLACE Xfrac IN WORKSPACE :
        INT Yexp :
        [4] INT Yfrac :
        PLACE Yfrac IN WORKSPACE :
        INT Carry, Carry2, Guard, Places :
        VAL INT Sign IS SignBit :
        --}}}
        SEQ
          --{{{  Unpack operands
          --{{{  Separate mantissa and exponents
          Xfrac[3],  Carry := SHIFTLEFT ( X[3],  X[2],  DRealShift)
          Xfrac[2],  Carry := SHIFTLEFT ( X[2],  X[1],  DRealShift)
          Xfrac[1],  Xfrac[0] := SHIFTLEFT ( X[1],  X[0],  DRealShift)
          Yfrac[3],  Carry := SHIFTLEFT ( Y[3],  Y[2],  DRealShift)
          Yfrac[2],  Carry := SHIFTLEFT ( Y[2],  Y[1],  DRealShift)
          Yfrac[1],  Yfrac[0] := SHIFTLEFT ( Y[1],  Y[0],  DRealShift)
          
          Xexp := (X[3] >> DRealExpSh) /\ DRealExp
          Yexp := (Y[3] >> DRealExpSh) /\ DRealExp
          --}}}
          
          Quotient[0] := 0
          Quotient[1] := 0
          Ans[0]      := 0
          Ans[1]      := 0
          Ans[2]      := 0
          Carry       := 0                             -- assume not normal case
          Error       := FALSE                         -- assume no errors
          IF
            (Xexp <> DRealExp) AND (Yexp <> DRealExp)
              --{{{  zeros or real numbers
              IF
                (Xexp <> 0) AND (Yexp <> 0)
                  --{{{  both normal numbers
                  SEQ                                  -- normal case
                    Carry := 1
                    Xfrac[3] := Xfrac[3] \/ Sign
                    Yfrac[3] := Yfrac[3] \/ Sign
                  --}}}
                ((((Yexp \/ Yfrac[3]) \/ Yfrac[2]) \/ Yfrac[1]) \/ Yfrac[0]) = 0
                  --{{{  Y is zero
                  SEQ
                    Ans := RemZeroNaN.64
                    Error := TRUE
                  --}}}
                ((((Xexp \/ Xfrac[3]) \/ Xfrac[2]) \/ Xfrac[1]) \/ Xfrac[0]) = 0
                  --{{{  X is zero
                  SEQ
                    Ans := X
                    Quotient := [0,0]
                  --}}}
                TRUE
                  --{{{  one or both are denormalised
                  -- Put in implicit MSB
                  -- Normalise any denormaliseds and correct their exponents if op is
                  -- multiply, divide or rem leave unormal for add and sub
                  SEQ
                    Carry := 1                         -- work to do
                    IF
                      Xexp <> 0                        -- set leading bit
                        Xfrac[3] := Xfrac[3] \/ Sign
                      TRUE                             -- set correct exponent
                        [4]INT temp.Xfrac :
                        PLACE temp.Xfrac IN WORKSPACE :
                        SEQ
                          temp.Xfrac := Xfrac
                          QUADNORMALISE (Places, Xfrac, Guard, temp.Xfrac, 0)
                          Xexp := 1 - Places
                    IF
                      Yexp <> 0
                        Yfrac[3] := Yfrac[3] \/ Sign
                      TRUE
                        [4]INT temp.Yfrac :
                        PLACE temp.Yfrac IN WORKSPACE :
                        SEQ
                          temp.Yfrac := Yfrac
                          QUADNORMALISE (Places, Yfrac, Guard, temp.Yfrac, 0)
                          Yexp := 1 - Places
                  --}}}
              --}}}
            TRUE
              --{{{  one or other inf/NaN
              SEQ
                Xfrac[3] := Xfrac[3] /\ (~Sign)        -- clear top bits
                Yfrac[3] := Yfrac[3] /\ (~Sign)
                Error := TRUE
                IF
                  (Xexp = DRealExp) AND (Yexp = DRealExp)
                    --{{{  both inf/NaN
                    SEQ
                      Guard, Places := LONGDIFF (Xfrac[0], Yfrac[0], 0)
                      Guard, Places := LONGDIFF (Xfrac[1], Yfrac[1], Guard)
                      Guard, Places := LONGDIFF (Xfrac[2], Yfrac[2], Guard)
                      Guard, Places := LONGDIFF (Xfrac[3], Yfrac[3], Guard)
                      IF
                        ((((Xfrac [0] \/ Xfrac [1]) \/ Xfrac [2]) \/ Xfrac [3]) \/
                            (((Yfrac [0] \/ Yfrac [1]) \/ Yfrac [2]) \/ Yfrac [3])) = 0
                          Ans := RemInfNaN.64
                        Places < 0
                          Ans := Y
                        TRUE
                          Ans := X
                    --}}}
                  Xexp = DRealExp
                    --{{{  X is inf/NaN
                    IF
                      (((Xfrac[3] \/ Xfrac[2]) \/ Xfrac[1]) \/ Xfrac[0]) <> 0
                        Ans := X
                      TRUE
                        Ans := RemInfNaN.64
                    --}}}
                  (((Yfrac[3] \/ Yfrac[2]) \/ Yfrac[1]) \/ Yfrac[0]) <> 0
                    --{{{  Y is NaN
                    SEQ
                      Ans[3] := Y[3]                   -- keep NaN (may be - if sub)
                      Ans[2] := Y[2]
                      Ans[1] := Y[1]
                      Ans[0] := Y[0]
                    --}}}
                  TRUE
                    --{{{  Y is inf
                    SEQ
                      Ans[3] := X[3]
                      Ans[2] := X[2]
                      Ans[1] := X[1]
                      Ans[0] := X[0]
                    --}}}
              --}}}
          --}}}
          --{{{  evaluate
          IF
            Carry = 0
              --{{{  Answer is set up
              Result := Ans
              --}}}
            TRUE
              --{{{  Do remainder
              SEQ
                --{{{  find remainder
                SEQ
                  -- Denorms already normalised
                  Ans[3] := X[3] /\ Sign               -- set correct sign
                  Places := Xexp - Yexp
                  IF
                    Places >= 0                        -- general case
                      SEQ
                        Quotient := [0,0]
                        Carry := Places /\ (BitsPerWord - 1)
                        Guard,  Xexp := SHIFTLEFT ( 0,  Xfrac[3],  Carry)
                        Xfrac[3],  Xexp := SHIFTLEFT ( Xfrac[3],  Xfrac[2],  Carry)
                        Xfrac[2],  Xexp := SHIFTLEFT ( Xfrac[2],  Xfrac[1],  Carry)
                        Xfrac[1],  Xfrac[0] := SHIFTLEFT ( Xfrac[1],  Xfrac[0],  Carry)
                        Quotient[0],  Xfrac[3],  Xfrac[2],  Xfrac[1],  Xfrac[0] := QRealIDiv (Guard,  Xfrac[3],  Xfrac[2],  Xfrac[1],  Xfrac[0],  Yfrac)
                        Places := Places - Carry
                        WHILE Places > 0
                          SEQ
                            Guard := Xfrac[3]
                            Xfrac[3] := Xfrac[2]
                            Xfrac[2] := Xfrac[1]
                            Xfrac[1] := Xfrac[0]
                            Xfrac[0] := 0
                            Carry,  Carry2 := LONGDIFF ( Xfrac[3],  Yfrac[3],  0)
                            Quotient[1] := Quotient[0]
                            IF
                              (Guard = 0) AND (Carry <> 0)  -- filter out some 0 quotients
                                Quotient[0] := 0
                              TRUE
                                Quotient[0],  Xfrac[3],  Xfrac[2], Xfrac[1],
                                    Xfrac[0] := QRealIDiv (Guard,  Xfrac[3],
                                            Xfrac[2],  Xfrac[1],  Xfrac[0],  Yfrac)
                            Places := Places - BitsPerWord
                        IF
                          (((Xfrac[3] \/ Xfrac[2]) \/ Xfrac[1]) \/ Xfrac[0]) = 0--divides exactly
                            Xexp := 0
                          TRUE
                            SEQ
                              Carry,  Ans[0] := SHIFTRIGHT ( Yfrac[1],  Yfrac[0],  1)
                              Carry,  Ans[1] := SHIFTRIGHT ( Yfrac[2],  Yfrac[1],  1)
                              Ans[3],  Ans[2] := SHIFTRIGHT ( Yfrac[3],  Yfrac[2], 1)
                              Carry,  Ans[0] := LONGDIFF ( Ans[0],  Xfrac[0],  0)
                              Carry,  Ans[1] := LONGDIFF ( Ans[1],  Xfrac[1],  Carry)
                              Carry,  Ans[2] := LONGDIFF ( Ans[2],  Xfrac[2],  Carry)
                              Carry,  Ans[3] := LONGDIFF ( Ans[3],  Xfrac[3],  Carry)
                              IF
                                (Carry <> 0) OR (((((Ans[3] \/ Ans[2]) \/ Ans[1]) \/
                                  Ans[0]) = 0) AND ((Guard /\ 1) <> 0)) -- over half
                                  SEQ
                                    Ans[3] := (X[3] >< Sign) /\ Sign -- negate ans
                                    Carry,  Xfrac[0] := LONGDIFF ( Yfrac[0],  Xfrac[0], 0)
                                    Carry,  Xfrac[1] := LONGDIFF ( Yfrac[1],  Xfrac[1], Carry)
                                    Carry,  Xfrac[2] := LONGDIFF ( Yfrac[2],  Xfrac[2], Carry)
                                    Carry,  Xfrac[3] := LONGDIFF ( Yfrac[3],  Xfrac[3], Carry)
                                    -- add 1 to Quotient
                                    Carry, Quotient[0] := LONGSUM (Quotient[0], 1, 0)
                                    Carry, Quotient[1] := LONGSUM (Quotient[1], 0, Carry)
                                TRUE
                                  Ans[3] := X[3] /\ Sign        --reset sign
                              Xexp := Yexp
                    Places = (-1)                      -- half to nearly one
                      SEQ
                        Carry,  Carry2 := LONGDIFF ( Yfrac[0],  Xfrac[0],  0)
                        Carry,  Carry2 := LONGDIFF ( Yfrac[1],  Xfrac[1],  Carry)
                        Carry,  Carry2 := LONGDIFF ( Yfrac[2],  Xfrac[2],  Carry)
                        Carry,  Carry2 := LONGDIFF ( Yfrac[3],  Xfrac[3],  Carry)
                        IF
                          Carry = 0                    -- X is answer
                            Quotient := [0,0]
                          TRUE                         -- Y-X is answer
                            SEQ
                              Quotient := [1,0]        -- Quotient = 1
                              Ans[3] := Ans[3] >< Sign -- invert sign
                              Carry,  Xfrac[0] := SHIFTRIGHT ( Xfrac[1],  Xfrac[0], 1)
                              Carry,  Xfrac[1] := SHIFTRIGHT ( Xfrac[2],  Xfrac[1], 1)
                              Xfrac[3],  Xfrac[2] := SHIFTRIGHT ( Xfrac[3],  Xfrac[2], 1)
                              Carry,  Xfrac[0] := LONGDIFF ( Yfrac[0],  Xfrac[0],  0)
                              Carry,  Xfrac[1] := LONGDIFF ( Yfrac[1],  Xfrac[1],  Carry)
                              Carry,  Xfrac[2] := LONGDIFF ( Yfrac[2],  Xfrac[2],  Carry)
                              Carry,  Xfrac[3] := LONGDIFF ( Yfrac[3],  Xfrac[3],  Carry)
                              Xexp := Yexp
                    TRUE                               -- less than half
                      Quotient := [0,0]
                
                  [4]INT temp.Xfrac :
                  PLACE temp.Xfrac IN WORKSPACE :
                  SEQ
                    temp.Xfrac := Xfrac
                    --N.B. also sets Guard to 0
                    QUADNORMALISE (Places, Xfrac, Guard, temp.Xfrac, 0)
                
                  Xexp := Xexp - Places                -- ensure normalised
                  IF
                    Xexp <= 0                          -- gone denorm
                      [4]INT temp.Xfrac :
                      PLACE temp.Xfrac IN WORKSPACE :
                      INT    temp.Guard :
                      SEQ
                        temp.Xfrac := Xfrac
                        temp.Guard := Guard
                        QUADSHIFTRIGHT (Xfrac, Guard, temp.Xfrac, temp.Guard, 1 - Xexp)
                        Xexp := 0
                    TRUE
                      SKIP
                --}}}
                --{{{  pack result
                Places := Xfrac[0]                     -- save round bits
                Carry,  Xfrac[0] := SHIFTRIGHT ( Xfrac[1],  Xfrac[0],  DRealShift)
                Carry,  Xfrac[1] := SHIFTRIGHT ( Xfrac[2],  Xfrac[1],  DRealShift)
                Xfrac[3],  Xfrac[2] := SHIFTRIGHT (Xfrac[3] /\ (~Sign),  Xfrac[2],
                                                                   DRealShift)
                Carry,  Xexp := SHIFTRIGHT ( Xexp,  0,  DRealShift + 1)
                Xfrac[3] := Xfrac[3] \/ Xexp
                Result[3] := Ans[3] \/ Xfrac[3]
                [Result FROM 0 FOR 3] := [Xfrac FROM 0 FOR 3]
                --}}}
                --{{{  adjust sign of quotient
                IF
                  ((X[3] >< Y[3]) /\ Sign) <> 0        -- signs differ
                    SEQ -- Quotient := MINUS Quotient
                      Guard, Quotient[0] := LONGDIFF (0, Quotient[0], 0)
                      Guard, Quotient[1] := LONGDIFF (0, Quotient[1], Guard)
                  TRUE
                    SKIP
                --}}}
              --}}}
          --}}}
        RESULT Error, Quotient, Result
    :
    --}}}
    SEQ
      --{{{  extract exponents
      VAL [4]INT Y.int RETYPES Y:
      exp1, frac := SHIFTLEFT (0, (Y.int[3] << 1), DRealShift)
      VAL [4]INT Z.int RETYPES Z:
      exp2, frac := SHIFTLEFT (0, (Z.int[3] << 1), DRealShift)
      --}}}
      b, N, X := IEEE64QUOTREM (Y, Z)
      IF
        (exp1 - exp2) <= Max.Diff
          SEQ
            X := REAL64OP( X, sub, REAL64OP( (REAL64 ROUND N), mul, Z.err ) )
            INT32 Nprimed :
            BOOL  bprimed :
            SEQ
              -- take another remainder in case the correction has taken us
              -- out of range :
              bprimed, Nprimed, X := IEEE64QUOTREM (X, Z)
              b := NOT (b OR bprimed) -- true unless an error
              N := N + Nprimed
        TRUE
          SEQ
            b := FALSE
            -- Y and Z may be normal, but a non-finite Z.err must then be
            -- invalid so now check for such an occurrence.
            IF
              DNOTFINITE( Z.err )
                X := InvalidOperandsNaN.r64
              TRUE
                SKIP
    RESULT b, N, X
:
--}}}

#ENDIF
