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