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