Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/system/Basis/Implementation/int64.sml
ViewVC logotype

Diff of /sml/trunk/src/system/Basis/Implementation/int64.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1686, Thu Nov 11 23:26:27 2004 UTC revision 1687, Fri Nov 12 06:31:53 2004 UTC
# Line 2  Line 2 
2   *   *
3   *   64-bit integers   *   64-bit integers
4   *   *
  *   (This is still in its very early stages.)  
  *  
5   * Copyright (c) 2004 by The Fellowship of SML/NJ   * Copyright (c) 2004 by The Fellowship of SML/NJ
6   *   *
7   * Author: Matthias Blume (blume@tti-c.org)   * Author: Matthias Blume (blume@tti-c.org)
8   *)   *)
9  structure Int64 (* : INTEGER *) = struct  structure Int64 : INTEGER = struct
10    
11      type int = Int64.int      type int = Int64.int
12    
13      local structure I64 = InlineT.Int64      val extern = InlineT.Int64.extern
14      in      val intern = InlineT.Int64.intern
15    
16        val precision = SOME 64
17    
18        val minIntVal : int = ~0x8000000000000000
19        val minInt : int option = SOME minIntVal
20        val maxInt : int option = SOME 0x7fffffffffffffff
21    
22        val toLarge = CoreIntInf.extendInf64 o CoreInt64.extern
23        val fromLarge = CoreInt64.intern o CoreIntInf.testInf64
24    
25        fun negbit hi = Word32Imp.andb (hi, 0wx80000000)
26        fun isneg hi = negbit hi <> 0w0
27    
28        fun toInt i =
29            let val mask = 0wxc0000000
30            in case extern i of
31                   (0w0, lo) =>
32                     if Word32Imp.andb (lo, mask) = 0w0 then Word32Imp.toInt lo
33                     else raise Assembly.Overflow
34                 | (0wxffffffff, lo) =>
35                     if Word32Imp.andb (lo, mask) = mask then Word32Imp.toIntX lo
36                     else raise Assembly.Overflow
37              | _ => raise Assembly.Overflow
38            end
39    
40        fun fromInt i31 =
41            let val i32 = Int32Imp.fromInt i31
42                val hi = if i32 < 0 then 0wxffffffff else 0w0
43            in intern (hi, InlineT.Word32.copyf_int32 i32)
44            end
45    
46        fun quot (x, y) = fromLarge (IntInfImp.quot (toLarge x, toLarge y))
47        fun rem (x, y) = x - quot (x, y) * y
48    
49        fun sign 0 = 0
50          | sign i = if isneg (#1 (extern i)) then ~1 else 1
51    
52        fun sameSign (x, y) = sign x = sign y
53    
54      val extern = I64.extern      fun min (x: int, y) = if x < y then x else y
55      val intern = I64.intern      fun max (x: int, y) = if x > y then x else y
56    
57        fun compare (x, y) =
58            let val (hi1, lo1) = extern x
59                val (hi2, lo2) = extern y
60                fun normal () =     (* same-sign case *)
61                    if hi1 < hi2 then LESS
62                    else if hi1 > hi2 then GREATER
63                    else if lo1 < lo2 then LESS
64                    else if lo1 > lo2 then GREATER
65                    else EQUAL
66            in if isneg hi1 then
67                   if isneg hi2 then normal () else LESS
68               else if isneg hi2 then GREATER
69               else normal ()
70      end      end
71    
72        fun fmt rdx i = IntInfImp.fmt rdx (toLarge i)
73        val toString = fmt StringCvt.DEC
74    
75        fun scan rdx rdr s =
76            case IntInfImp.scan rdx rdr s of
77                SOME (i, s') =>
78                  if i < ~0x80000000 orelse i > 0x7fffffff then
79                      raise Assembly.Overflow
80                  else SOME (intern (CoreIntInf.truncInf64 i), s')
81              | NONE => NONE
82    
83        val fromString = PreBasis.scanString (scan StringCvt.HEX)
84    
85        val ~      : int -> int        = ~
86        val op +   : int * int -> int  = op +
87        val op -   : int * int -> int  = op -
88        val op *   : int * int -> int  = op *
89        val op div : int * int -> int  = op div
90        val op mod : int * int -> int  = op mod
91        val abs    : int -> int        = abs
92        val op <   : int * int -> bool = op <
93        val op <=  : int * int -> bool = op <=
94        val op >   : int * int -> bool = op >
95        val op >=  : int * int -> bool = op >=
96  end  end

Legend:
Removed from v.1686  
changed lines
  Added in v.1687

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0