1(* 2 Title: Standard Basis Library: Pack Real structures and signatures 3 Author: David Matthews 4 Copyright David Matthews 2000, 2015 5 6 This library is free software; you can redistribute it and/or 7 modify it under the terms of the GNU Lesser General Public 8 License version 2.1 as published by the Free Software Foundation. 9 10 This library is distributed in the hope that it will be useful, 11 but WITHOUT ANY WARRANTY; without even the implied warranty of 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 Lesser General Public License for more details. 14 15 You should have received a copy of the GNU Lesser General Public 16 License along with this library; if not, write to the Free Software 17 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18*) 19 20signature PACK_REAL = 21sig 22 type real 23 val bytesPerElem : int 24 val isBigEndian : bool 25 val toBytes : real -> Word8Vector.vector 26 val fromBytes : Word8Vector.vector -> real 27 val subVec : Word8Vector.vector * int -> real 28 val subArr : Word8Array.array * int -> real 29 val update : Word8Array.array * int * real -> unit 30end; 31 32local 33 open LibrarySupport 34 open LibrarySupport.Word8Array 35 36 local 37 val realSizeCall: unit -> word = RunCall.rtsCallFast1 "PolyRealSize" 38 in 39 val realSize: word = realSizeCall () 40 end 41 42 local 43 val System_move_bytes: address*address*word*word*word->unit = RunCall.moveBytes 44 45 (* Move bytes, reversing the order. *) 46 fun swapOrder(src: address, srcOff: word, 47 dest: address, destOff: word, 48 length: word) = 49 if length = 0w0 then () 50 else 51 ( 52 RunCall.storeByte(dest, destOff+length-0w1, RunCall.loadByte(src, srcOff)); 53 swapOrder(src, srcOff+0w1, dest, destOff, length-0w1) 54 ) 55 in 56 fun doMove(src: address, srcOff: word, 57 dest: address, destOff: word, wantBigEndian: bool) = 58 if wantBigEndian = bigEndian (* Host byte order = required byte order *) 59 then System_move_bytes(src, dest, srcOff, destOff, realSize) 60 else (* Host byte order is reverse of required byte order. *) 61 swapOrder(src, srcOff, dest, destOff, realSize) 62 end 63in 64 65 structure PackRealBig: PACK_REAL = 66 struct 67 type real = real 68 69 val bytesPerElem: int = Word.toInt realSize 70 val isBigEndian = true (* Note: this seems unnecessary. *) 71 72 fun toBytes r = 73 let 74 val v = allocString realSize 75 (* r is actually represented by a pointer to a vector. *) 76 val addr: address = RunCall.unsafeCast r 77 in 78 doMove(addr, 0w0, stringAsAddress v, wordSize, isBigEndian); 79 RunCall.clearMutableBit v; 80 w8vectorFromString v 81 end 82 83 fun fromBytes v = 84 (* Raises an exception if the vector is too small and takes the first 85 few elements if it's larger. *) 86 if Word8Vector.length v < bytesPerElem 87 then raise Subscript 88 else 89 let 90 val r = allocBytes realSize 91 in 92 doMove(w8vectorAsAddress v, wordSize, r, 0w0, isBigEndian); 93 RunCall.clearMutableBit r; 94 (RunCall.unsafeCast r): real 95 end 96 97 fun subVec(v, i) = 98 let 99 val iW = unsignedShortOrRaiseSubscript i * realSize 100 in 101 if iW >= Word.fromInt(Word8Vector.length v) 102 then raise Subscript (* This IS defined. *) 103 else 104 let 105 val r = allocBytes realSize 106 in 107 doMove(w8vectorAsAddress v, wordSize + iW, r, 0w0, isBigEndian); 108 RunCall.clearMutableBit r; 109 (RunCall.unsafeCast r): real 110 end 111 end 112 113 fun subArr(Array(l, v), i) = 114 let 115 val iW = unsignedShortOrRaiseSubscript i * realSize 116 in 117 if iW >= l 118 then raise Subscript (* This IS defined. *) 119 else 120 let 121 val r = allocBytes realSize 122 in 123 doMove(v, iW, r, 0w0, isBigEndian); 124 RunCall.clearMutableBit r; 125 (RunCall.unsafeCast r): real 126 end 127 end 128 129 fun update(Array(l, v), i, r) = 130 let 131 val iW = unsignedShortOrRaiseSubscript i * realSize 132 in 133 if iW >= l 134 then raise Subscript (* This IS defined. *) 135 else 136 let 137 (* r is actually represented by a pointer to a vector. *) 138 val addr: address = RunCall.unsafeCast r 139 in 140 doMove(addr, 0w0, v, iW, isBigEndian) 141 end 142 end 143 end; 144 145 structure PackRealLittle: PACK_REAL = 146 struct 147 type real = real 148 val bytesPerElem: int = Word.toInt realSize 149 val isBigEndian = false 150 fun toBytes r = 151 let 152 val v = allocString realSize 153 (* r is actually represented by a pointer to a vector. *) 154 val addr: address = RunCall.unsafeCast r 155 in 156 doMove(addr, 0w0, stringAsAddress v, wordSize, isBigEndian); 157 RunCall.clearMutableBit v; 158 w8vectorFromString v 159 end 160 161 fun fromBytes v = 162 (* Raises an exception if the vector is too small and takes the first 163 few elements if it's larger. *) 164 if Word8Vector.length v < bytesPerElem 165 then raise Subscript 166 else 167 let 168 val r = allocBytes realSize 169 in 170 doMove(w8vectorAsAddress v, wordSize, r, 0w0, isBigEndian); 171 RunCall.clearMutableBit r; 172 (RunCall.unsafeCast r): real 173 end 174 175 fun subVec(v, i) = 176 let 177 val iW = unsignedShortOrRaiseSubscript i * realSize 178 in 179 if iW >= Word.fromInt(Word8Vector.length v) 180 then raise Subscript (* This IS defined. *) 181 else 182 let 183 val r = allocBytes realSize 184 in 185 doMove(w8vectorAsAddress v, wordSize+iW, r, 0w0, isBigEndian); 186 RunCall.clearMutableBit r; 187 (RunCall.unsafeCast r): real 188 end 189 end 190 191 fun subArr(Array(l, v), i) = 192 let 193 val iW = unsignedShortOrRaiseSubscript i * realSize 194 in 195 if iW >= l 196 then raise Subscript (* This IS defined. *) 197 else 198 let 199 val r = allocBytes realSize 200 in 201 doMove(v, iW, r, 0w0, isBigEndian); 202 RunCall.clearMutableBit r; 203 (RunCall.unsafeCast r): real 204 end 205 end 206 207 fun update(Array(l, v), i, r) = 208 let 209 val iW = unsignedShortOrRaiseSubscript i * realSize 210 in 211 if iW >= l 212 then raise Subscript (* This IS defined. *) 213 else 214 let 215 (* r is actually represented by a pointer to a vector. *) 216 val addr: address = RunCall.unsafeCast r 217 in 218 doMove(addr, 0w0, v, iW, isBigEndian) 219 end 220 end 221 end; 222end; 223