1(*
2    Title:      Standard Basis Library: Word32 Structure
3    Author:     David Matthews
4        Achim D. Brucker
5    Copyright   David Matthews 1999
6                Achim D. Brucker 2006
7
8        This library is free software; you can redistribute it and/or
9    modify it under the terms of the GNU Lesser General Public
10    License as published by the Free Software Foundation; either
11    version 2.1 of the License, or (at your option) any later version.
12
13    This library is distributed in the hope that it will be useful,
14    but WITHOUT ANY WARRANTY; without even the implied warranty of
15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16    Lesser General Public License for more details.
17
18    You should have received a copy of the GNU Lesser General Public
19    License along with this library; if not, write to the Free Software
20    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
21*)
22
23(*
24  This is a hacked version of Word32 - a 32bit Word implementation for
25  PolyML 5. It's neither well tested nor efficiently implemented.
26  Nevertheless, it works well enough for the XML parser fxp
27  (http://www2.in.tum.de/~berlea/Fxp/).
28*)
29
30(* This version has been modified for 64-bit architecture and does not
31   require boxed word values.  DCJM 14/8/09.
32*)
33
34(* We need to declare a Word64 structure as well. *)
35structure Word64 = LargeWord;
36
37val () = if Word64.wordSize <> 64 then raise Fail "Not 64-bit" else ()
38
39structure Word32 :> WORD =
40struct
41    (* We can use Word here because a 63-bit tagged value is sufficient. *)
42    open Word
43
44    (* Values of type Word32.word can be in the range 0.. 4294967295 *)
45    val wordSize = 32
46    val maxWord = 4294967295
47    val maxWordAsWord: word = (Word.fromInt maxWord)
48    infix 8 << >> ~>> ;
49
50    (* Comparison operations, min, max and compare, fmt, toString,
51       orb, andb, xorb can be inherited directly from LargeWord.
52       Similarly div, mod and >> since the results will always be no
53       larger than the arguments. *)
54
55    (* Not the same as Word.notb because it only affects the bottom 32 bits.  *)
56    fun notb x = xorb(maxWordAsWord, x)
57
58    (* Internal function to convert from Word.word. *)
59    fun fromWord (w: Word.word) = andb(w, maxWordAsWord)
60
61    (* Converting from LargeWord.word.  First convert to Word.word and
62       then mask. *)
63    val fromLargeWord = fromWord o Word.fromLargeWord
64    and fromInt = fromWord o Word.fromInt
65    and fromLargeInt = fromWord o Word.fromLargeInt
66
67    val fromLarge = fromLargeWord
68
69            (* Arithmetic shift - sign extends. *)
70    (* Shift the "sign" bit into the real sign bit position then
71       shift right down again. *)
72    local
73        val toSignBit = (Word.fromInt(Int.-(Word.wordSize,wordSize)))
74    in
75        fun op ~>> (a: word, b: Word.word): word =
76            fromWord(Word.~>>(Word.<<(a, toSignBit), Word.+(b, toSignBit)))
77
78        (* Convert to a large word by sign extending. *)
79        fun toLargeWordX (w: word): LargeWord.word =
80            LargeWord.~>>(Word.toLargeWordX(Word.<<(w, toSignBit)), toSignBit)
81    end
82    val toLargeX = toLargeWordX
83
84    (* Conversion to signed integer. *)
85    fun toIntX (x: word) : int = LargeWord.toIntX(toLargeWordX x)
86    and toLargeIntX (x: word) : LargeInt.int = LargeWord.toLargeIntX(toLargeWordX x)
87
88    (* Use Word.scan but check that the result is in the range. *)
89    val wordScan = scan;
90
91    fun scan radix getc src =
92        case wordScan radix getc src of
93            NONE => NONE
94         |  SOME(res, src') =>
95                if res > maxWordAsWord
96                then raise General.Overflow
97                else SOME(res, src')
98
99    val fromString = StringCvt.scanString (scan StringCvt.HEX)
100
101    (* TODO: Replace by built-ins? *)
102    fun op + (a, b) = fromWord(Word.+(a, b))
103    and op - (a, b) = fromWord(Word.-(a, b))
104    and op * (a, b) = fromWord(Word.*(a, b))
105    and op << (a, b) = fromWord(Word.<<(a, b))
106
107    fun ~ x = 0w0 - x
108
109end;
110
111
112
113(* Because we are using opaque signature matching we have to install
114   type-dependent functions OUTSIDE the structure. *)
115local
116        (* The string may be either 0wnnn or 0wxXXX *)
117        fun convWord s : Word32.word =
118                let
119                val radix =
120                        (* The word value must consist of at least 0w and a digit. *)
121                        if String.sub(s, 2) = #"x" then StringCvt.HEX else StringCvt.DEC
122                in
123                        case StringCvt.scanString (Word32.scan radix) s of
124                                NONE => raise RunCall.Conversion "Invalid Word32.word constant"
125                          | SOME res => res
126                end
127
128        (* Install the pretty printer for Word32.word *)
129        fun pretty _ _ x = PolyML.PrettyString("0wx" ^ Word32.toString x)
130in
131        val () = RunCall.addOverload convWord "convWord"
132        val () = PolyML.addPrettyPrinter pretty
133end;
134
135
136
137
138(* Add the overloaded operators. *)
139val () = RunCall.addOverload Word32.~ "~";
140val () = RunCall.addOverload Word32.+ "+";
141val () = RunCall.addOverload Word32.- "-";
142val () = RunCall.addOverload Word32.* "*";
143val () = RunCall.addOverload Word32.div "div";
144val () = RunCall.addOverload Word32.mod "mod";
145val () = RunCall.addOverload Word32.< "<";
146val () = RunCall.addOverload Word32.> ">";
147val () = RunCall.addOverload Word32.<= "<=";
148val () = RunCall.addOverload Word32.>= ">=";
149