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/smlnj/init/core-word64.sml
ViewVC logotype

Diff of /sml/trunk/src/system/smlnj/init/core-word64.sml

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

revision 1684, Thu Nov 11 06:15:33 2004 UTC revision 1685, Thu Nov 11 16:51:42 2004 UTC
# Line 3  Line 3 
3    local    local
4        fun notyet () = raise Assembly.Overflow        fun notyet () = raise Assembly.Overflow
5    
6          type w32 = PrimTypes.word32
7    
8        infix o val op o = InLine.compose        infix o val op o = InLine.compose
9        val not = InLine.inlnot        val not = InLine.inlnot
10          infix 7 * val op * = InLine.w32mul
11          infix 6 + - val op + = InLine.w32add val op - = InLine.w32sub
12          infix 5 << >> val op << = InLine.w32lshift val op >> = InLine.w32rshiftl
13          infix 5 & val op & = InLine.w32andb
14          infix 4 < val op < = InLine.w32lt
15    
16        fun lift1' f = f o InLine.w64p        fun lift1' f = f o InLine.w64p
17        fun lift1 f = InLine.p64w o lift1' f        fun lift1 f = InLine.p64w o lift1' f
18        fun lift2' f (x, y) = f (InLine.w64p x, InLine.w64p y)        fun lift2' f (x, y) = f (InLine.w64p x, InLine.w64p y)
19        fun lift2 f = InLine.p64w o lift2' f        fun lift2 f = InLine.p64w o lift2' f
20    
21          fun split16 w32 = (w32 >> 0w16, w32 & 0wxffff)
22    
23        fun neg64 (hi, 0w0) = (InLine.w32neg hi, 0w0)        fun neg64 (hi, 0w0) = (InLine.w32neg hi, 0w0)
24          | neg64 (hi, lo) = (InLine.w32notb hi, InLine.w32neg lo)          | neg64 (hi, lo) = (InLine.w32notb hi, InLine.w32neg lo)
25    
26        fun add64 ((hi1, lo1), (hi2, lo2)) =        fun add64 ((hi1, lo1), (hi2, lo2)) =
27            let val lo = InLine.w32add (lo1, lo2)            let val (lo, hi) = (lo1 + lo2, hi1 + hi2)
28                val hi = InLine.w32add (hi1, hi2)            in (if lo < lo1 then hi + 0w1 else hi, lo)
           in (if InLine.w32lt (lo, lo1) then InLine.w32add (hi, 0w1) else hi,  
               lo)  
29            end            end
30    
31        fun sub64 ((hi1, lo1), (hi2, lo2)) =        fun sub64 ((hi1, lo1), (hi2, lo2)) =
32            let val lo = InLine.w32sub (lo1, lo2)            let val (lo, hi) = (lo1 - lo2, hi1 - hi2)
33                val hi = InLine.w32sub (hi1, hi2)            in (if lo1 < lo then hi - 0w1 else hi, lo)
           in (if InLine.w32gt (lo, lo1) then InLine.w32sub (hi, 0w1) else hi,  
               lo)  
34            end            end
35        fun mul64 _ = notyet ()  
36        fun div64 _ = notyet ()        fun mul64 ((hi1, lo1), (hi2, lo2)) =
37        fun mod64 _ = notyet ()            let val ((a1, b1), (c1, d1)) = (split16 hi1, split16 lo1)
38                  val ((a2, b2), (c2, d2)) = (split16 hi2, split16 lo2)
39                  val dd = d1 * d2
40                  val (cd, dc) = (c1 * d2, d1 * c2)
41                  val (bd, cc, db) = (b1 * d2, c1 * c2, d1 * b2)
42                  val (ad, bc, cb, da) = (a1 * d2, b1 * c2, c1 * b2, d1 * a2)
43                  val diag0 = dd
44                  val diag1 = cd + dc
45                  val diag1carry = if diag1 < cd then 0wx10000 else 0w0
46                  val diag2 = bd + cc + db
47                  val diag3 = ad + bc + cb + da
48                  val lo = diag0 + (diag1 << 0w16)
49                  val locarry = if lo < diag0 then 0w1 else 0w0
50                  val hi = (diag1 >> 0w16) + diag2 + (diag3 << 0w16)
51                           + locarry + diag1carry
52              in (hi, lo)
53              end
54    
55          fun div64 (_, (0w0, 0w0)) = raise Assembly.Div
56            | div64 ((0w0: w32, lo1), (0w0: w32, lo2)) = (0w0: w32, InLine.w32div (lo1, lo2))
57            | div64 _ = notyet ()
58    
59          fun mod64 (x, y) = sub64 (x, mul64 (div64 (x, y), y))
60    
61        fun swap (x, y) = (y, x)        fun swap (x, y) = (y, x)
62    
# Line 43  Line 71 
71        val intern = InLine.p64w        val intern = InLine.p64w
72    
73        val ~ = lift1 neg64        val ~ = lift1 neg64
74        val + = lift2 add64        val op + = lift2 add64
75        val - = lift2 sub64        val op - = lift2 sub64
76        val * = lift2 mul64        val op * = lift2 mul64
77        val div = lift2 div64        val div = lift2 div64
78        val mod = lift2 mod64        val mod = lift2 mod64
79        val < = lift2' lt64        val op < = lift2' lt64
80        val <= = lift2' le64        val <= = lift2' le64
81        val > = lift2' gt64        val > = lift2' gt64
82        val >= = lift2' ge64        val >= = lift2' ge64

Legend:
Removed from v.1684  
changed lines
  Added in v.1685

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