Patch title: Release 85 bulk changes
Abstract:
File: /pliant/language/type/number/int64.pli
Key:
    Removed line
    Added line
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program 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 General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

scope "/pliant/language/""/pliant/install/"
module "/pliant/install/ring3.pli"
module "intn.pli"


if Int:size=4

  type uInt64
    field uInt low 
    field uInt high

  function compare a b -> c
    arg uInt64 a b ; arg Int c
    c := compare a:high b:high
    if c=compare_equal
      c := compare a:low b:low

  function 'cast uInt64' i -> j
    arg uInt i ; arg uInt64 j
    extension ; has_no_side_effect
    j low := i
    j high := 0

  function 'cast uInt' i -> j
    arg uInt64 i ; arg uInt j
    reduction ; has_no_side_effect
    check i:high=0 "The value is too large to fit in an uInt"
    j := i low

  function 'cast Intn' i -> j
    arg uInt64 i ; arg Intn j
    extension ; has_no_side_effect
    j 'please resize' 2
    memory_copy addressof:i j:'please bits' uInt64:size
    j 'please status' := 'please positive'
    j 'please shrink'

  function 'cast uInt64' i -> j
    arg Intn i ; arg uInt64 j
    reduction ; has_no_side_effect
    var uInt p := i 'please read_lock'
    if p<>'please positive'
      error error_id_unexpected "The integer is negative"
    if i:'please size'>0
      j low := i:'please bits' map uInt
    else
      j low := 0
    if i:'please size'>1
      j high := (i:'please bits' translate uInt 1) map uInt
    else
      j high := 0
    if i:'please size'>2
      error error_id_arithmetic "The value is too large to fit in an uInt64"
    i 'please read_unlock'

  export uInt64 compare 'cast uInt64' 'cast uInt' 'cast Intn' 'cast uInt64'


if Int:size=4

  type Int64
    field uInt low 
    field Int high

  function compare a b -> c
    arg Int64 a b ; arg Int c
    c := compare a:high b:high
    if c=compare_equal
      if a:high>=0
        c := compare a:low b:low
      else
        c := compare 0FFFFFFFFh-a:low 0FFFFFFFFh-b:low

  function 'cast Int64' i -> j
    arg Int i ; arg Int64 j
    extension ; has_no_side_effect
    j low := i
    if i>=0
      j high := 0
    else
      j high := -1

  function 'cast Int' i -> j
    arg Int64 i ; arg Int j
    reduction ; has_no_side_effect
    check (i:high=0 and i:low<80000000h) or (i:high=(-1) and i:low>=80000000h) "The value is too large to fit in an Int"
    j := i low

  function 'cast Intn' i -> j
    arg Int64 i ; arg Intn j
    extension ; has_no_side_effect
    j 'please resize' 2
    memory_copy addressof:i j:'please bits' uInt64:size
    j 'please status' := 'please positive'
    j 'please shrink'
    if i:high<0
      j := j - 2n^64

  function raw_convert i j
    arg Intn i ; arg_w Int64 j
    var uInt p := i 'please read_lock'
    if i:'please size'>0
      j low := i:'please bits' map uInt
    else
      j low := 0
    if i:'please size'>1
      j high := (i:'please bits' translate uInt 1) map Int
    else
      j high := 0

  function 'cast Int64' i -> j
    arg Intn i ; arg Int64 j
    reduction ; has_no_side_effect
    var uInt p := i 'please read_lock'
    if p='please positive'
      raw_convert i j
      if i:'please size'>2 or j:high<0
        error error_id_arithmetic "The value is too large to fit in an Int64"
    else
      raw_convert i+2n^64 j
      if i:'please size'>2 or j:high>=0
        error error_id_arithmetic "The value is too large to fit in an Int64"
    i 'please read_unlock'

  export Int64 compare 'cast Int64' 'cast Int' 'cast Intn' 'cast Int64'