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

SCM Repository

[smlnj] Annotation of /sml/trunk/system/Basis/Implementation/Target32Bit/pack-word-l64.sml
ViewVC logotype

Annotation of /sml/trunk/system/Basis/Implementation/Target32Bit/pack-word-l64.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5448 - (view) (download)

1 : jhr 5448 (* pack-word-l64.sml
2 :     *
3 :     * COPYRIGHT (c) 2019 The Fellowship of SML/NJ (http://www.smlnj.org)
4 :     * All rights reserved.
5 :     *
6 :     * Implementation of PackWord64Little for 32-bit targets.
7 :     *)
8 :    
9 :     local
10 :     structure LargeWord = LargeWordImp
11 :     in
12 :     structure PackWord64Little : PACK_WORD =
13 :     struct
14 :    
15 :     structure Word = InlineT.Word
16 :     structure W8 = Word8Imp
17 :     structure W32 = InlineT.Word32
18 :     structure W64 = InlineT.Word64
19 :     structure W8V = InlineT.Word8Vector
20 :     structure W8A = InlineT.Word8Array
21 :    
22 :     (* fast add avoiding the overflow test *)
23 :     infix ++
24 :     fun x ++ y = InlineT.Int.fast_add(x, y)
25 :    
26 :     val bytesPerElem = 8
27 :     val isBigEndian = false
28 :    
29 :     (* convert the byte length into word64 length (n div 8), and check the index *)
30 :     fun chkIndex (len, i) = let
31 :     val len = Word.toIntX(Word.rshiftl(Word.fromInt len, 0w3))
32 :     in
33 :     if (InlineT.Int.ltu(i, len)) then () else raise Subscript
34 :     end
35 :    
36 :     (* scale word64 index to byte index *)
37 :     fun scale i = Word.toIntX(Word.lshift(Word.fromInt i, 0w3))
38 :    
39 :     val w8ToW32 = W32.fromLarge o W8.toLarge
40 :     val w32ToW8 = W8.fromLarge o W32.toLarge
41 :    
42 :     (* make a word32 from little-endian-order bytes [b1, b2, b3, b4] *)
43 :     fun mkWord32 (b1, b2, b3, b4) =
44 :     W32.orb (W32.lshift(w8ToW32 b4, 0w24),
45 :     W32.orb (W32.lshift(w8ToW32 b3, 0w16),
46 :     W32.orb (W32.lshift(w8ToW32 b2, 0w8),
47 :     w8ToW32 b1)))
48 :    
49 :     fun subVec (vec, i) = let
50 :     val _ = chkIndex (W8V.length vec, i)
51 :     val k = scale i
52 :     in
53 :     W64.intern(
54 :     mkWord32 (W8V.sub(vec, k++4), W8V.sub(vec, k++5),
55 :     W8V.sub(vec, k++6), W8V.sub(vec, k++7)),
56 :     mkWord32 (W8V.sub(vec, k), W8V.sub(vec, k++1),
57 :     W8V.sub(vec, k++2), W8V.sub(vec, k++3)))
58 :     end
59 :     (* since LargeWord is 64-bits, no sign extension is required *)
60 :     val subVecX = subVec
61 :    
62 :     fun subArr (arr, i) = let
63 :     val _ = chkIndex (W8A.length arr, i)
64 :     val k = scale i
65 :     in
66 :     W64.intern(
67 :     mkWord32 (W8A.sub(arr, k++4), W8A.sub(arr, k++5),
68 :     W8A.sub(arr, k++6), W8A.sub(arr, k++7)),
69 :     mkWord32 (W8A.sub(arr, k), W8A.sub(arr, k++1),
70 :     W8A.sub(arr, k++2), W8A.sub(arr, k++3)))
71 :     end
72 :     (* since LargeWord is 64-bits, no sign extension is required *)
73 :     val subArrX = subArr
74 :    
75 :     fun update (arr, i, w) = let
76 :     val _ = chkIndex (W8A.length arr, i)
77 :     val k = scale i
78 :     val (hi, lo) = W64.extern w
79 :     in
80 :     W8A.update (arr, k, w32ToW8 lo);
81 :     W8A.update (arr, k+1, w32ToW8(W32.rshiftl(lo, 0w8)));
82 :     W8A.update (arr, k+2, w32ToW8(W32.rshiftl(lo, 0w16)));
83 :     W8A.update (arr, k+3, w32ToW8(W32.rshiftl(lo, 0w24)));
84 :     W8A.update (arr, k, w32ToW8 hi);
85 :     W8A.update (arr, k+1, w32ToW8(W32.rshiftl(hi, 0w8)));
86 :     W8A.update (arr, k+2, w32ToW8(W32.rshiftl(hi, 0w16)));
87 :     W8A.update (arr, k+3, w32ToW8(W32.rshiftl(hi, 0w24)))
88 :     end
89 :    
90 :     end
91 :     end (* local *)

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