/pliant/language/type/number/int64.pli
 
 1  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 2  # 
 3  # This program is free software; you can redistribute it and/or 
 4  # modify it under the terms of the GNU General Public License version 2 
 5  # as published by the Free Software Foundation. 
 6  # 
 7  # This program is distributed in the hope that it will be useful, 
 8  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 9  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 10  # GNU General Public License for more details. 
 11  # 
 12  # You should have received a copy of the GNU General Public License 
 13  # version 2 along with this program; if not, write to the Free Software 
 14  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 15   
 16  scope "/pliant/language/""/pliant/install/" 
 17  module "/pliant/install/ring3.pli" 
 18  module "intn.pli" 
 19   
 20   
 21  if Int:size=4 
 22   
 23    type uInt64 
 24      field uInt low  
 25      field uInt high 
 26   
 27    function compare a b -> c 
 28      arg uInt64 b ; arg Int c 
 29      := compare a:high b:high 
 30      if c=compare_equal 
 31        := compare a:low b:low 
 32   
 33    function 'cast uInt64' i -> j 
 34      arg uInt i ; arg uInt64 j 
 35      extension ; has_no_side_effect 
 36      low := i 
 37      high := 0 
 38   
 39    function 'cast uInt' i -> j 
 40      arg uInt64 i ; arg uInt j 
 41      reduction ; has_no_side_effect 
 42      check i:high="The value is too large to fit in an uInt" 
 43      := low 
 44   
 45    function 'cast Intn' i -> j 
 46      arg uInt64 i ; arg Intn j 
 47      extension ; has_no_side_effect 
 48      'please resize' 2 
 49      memory_copy addressof:j:'please bits' uInt64:size 
 50      'please status' := 'please positive' 
 51      'please shrink' 
 52   
 53    function 'cast uInt64' i -> j 
 54      arg Intn i ; arg uInt64 j 
 55      reduction ; has_no_side_effect 
 56      var uInt := 'please read_lock' 
 57      if p<>'please positive' 
 58        error error_id_unexpected "The integer is negative" 
 59      if i:'please size'>0 
 60        low := i:'please bits' map uInt 
 61      else 
 62        low := 0 
 63      if i:'please size'>1 
 64        high := (i:'please bits' translate uInt 1) map uInt 
 65      else 
 66        high := 0 
 67      if i:'please size'>2 
 68        error error_id_arithmetic "The value is too large to fit in an uInt64" 
 69      'please read_unlock' 
 70   
 71    export uInt64 compare 'cast uInt64' 'cast uInt' 'cast Intn' 'cast uInt64' 
 72   
 73   
 74  if Int:size=4 
 75   
 76    type Int64 
 77      field uInt low  
 78      field Int high 
 79   
 80    function compare a b -> c 
 81      arg Int64 b ; arg Int c 
 82      := compare a:high b:high 
 83      if c=compare_equal 
 84        if a:high>=0 
 85          := compare a:low b:low 
 86        else 
 87          := compare 0FFFFFFFFh-a:low 0FFFFFFFFh-b:low 
 88   
 89    function 'cast Int64' i -> j 
 90      arg Int i ; arg Int64 j 
 91      extension ; has_no_side_effect 
 92      low := i 
 93      if i>=0 
 94        high := 0 
 95      else 
 96        high := -1 
 97   
 98    function 'cast Int' i -> j 
 99      arg Int64 i ; arg Int j 
 100      reduction ; has_no_side_effect 
 101      check (i:high=and i:low<80000000h) or (i:high=(-1) and i:low>=80000000h) "The value is too large to fit in an Int" 
 102      := low 
 103   
 104    function 'cast Intn' i -> j 
 105      arg Int64 i ; arg Intn j 
 106      extension ; has_no_side_effect 
 107      'please resize' 2 
 108      memory_copy addressof:j:'please bits' uInt64:size 
 109      'please status' := 'please positive' 
 110      'please shrink' 
 111      if i:high<0 
 112        := 2n^64 
 113   
 114    function raw_convert i j 
 115      arg Intn i ; arg_w Int64 j 
 116      var uInt := 'please read_lock' 
 117      if i:'please size'>0 
 118        low := i:'please bits' map uInt 
 119      else 
 120        low := 0 
 121      if i:'please size'>1 
 122        high := (i:'please bits' translate uInt 1) map Int 
 123      else 
 124        high := 0 
 125   
 126    function 'cast Int64' i -> j 
 127      arg Intn i ; arg Int64 j 
 128      reduction ; has_no_side_effect 
 129      var uInt := 'please read_lock' 
 130      if p='please positive' 
 131        raw_convert j 
 132        if i:'please size'>or j:high<0 
 133          error error_id_arithmetic "The value is too large to fit in an Int64" 
 134      else 
 135        raw_convert i+2n^64 j 
 136        if i:'please size'>or j:high>=0 
 137          error error_id_arithmetic "The value is too large to fit in an Int64" 
 138      'please read_unlock' 
 139   
 140    export Int64 compare 'cast Int64' 'cast Int' 'cast Intn' 'cast Int64'