1(*
2    Title:      Standard Basis Library: Binary IO
3    Copyright   David C.J. Matthews 2000, 2005
4
5    This library is free software; you can redistribute it and/or
6    modify it under the terms of the GNU Lesser General Public
7    License as published by the Free Software Foundation; either
8    version 2.1 of the License, or (at your option) any later version.
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
20(* G&R 2004 status: in progress. *)
21
22
23signature BIN_IO =
24sig
25    include IMPERATIVE_IO
26       where type StreamIO.vector = Word8Vector.vector
27       where type StreamIO.elem = Word8.word
28       where type StreamIO.reader = BinPrimIO.reader
29       where type StreamIO.writer = BinPrimIO.writer
30       where type StreamIO.pos = BinPrimIO.pos
31
32    val openIn  : string -> instream
33    val openOut : string -> outstream
34    val openAppend : string -> outstream
35end;
36
37
38structure BinIO: BIN_IO =
39struct
40    open IO
41    
42    structure StreamIO =
43        BasicStreamIO(
44            structure PrimIO = BinPrimIO
45            structure Vector = Word8Vector
46            structure Array = Word8Array
47            structure VectorSlice = Word8VectorSlice
48            structure ArraySlice = Word8ArraySlice
49            val someElem : PrimIO.elem = 0wx20
50        );
51    (* For binary streams line-buffering is supposed to be treated as block
52       buffering so we don't need to do anything special. *)
53
54    structure ImpIO = ImperativeIO(
55        structure StreamIO = StreamIO
56        structure Vector = Word8Vector
57        structure Array = Word8Array)
58    open ImpIO
59
60    exception Interrupt = RunCall.Interrupt
61
62    (* Called after any exception in the lower level reader or
63       writer to map any exception other than Io into Io. *)
64    fun mapToIo (io as Io _, _, _) = io
65      | mapToIo (Interrupt, _, _) = Interrupt
66      | mapToIo (nonIo, name, caller) =
67            Io { name = name, function = caller, cause = nonIo }
68
69    type fileDescr = OS.IO.iodesc (* Actually abstract.  This isn't
70                                     the file descriptor itself, rather
71                                     a pointer into the io table. *)
72
73    local
74        local
75            val doIo: int*int*string -> fileDescr
76                 = RunCall.rtsCallFull3 "PolyBasicIOGeneral"
77        in
78            fun sys_open_in_bin name = doIo(4, 0, name)
79            and sys_open_out_bin name = doIo(6, 0, name)
80            and sys_open_append_bin name = doIo(14, 0, name)
81        end
82
83        local
84            val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral"
85        in
86            fun sys_get_buffsize (strm: fileDescr): int = doIo(15, strm, 0)
87        end
88
89        fun wrapInFileDescr(n, name) =
90        let
91            val binPrimRd =
92                LibraryIOSupport.wrapBinInFileDescr {fd=n, name=name, initBlkMode=true}
93
94            val streamIo =
95                StreamIO.mkInstream(binPrimRd, Word8Vector.fromList [])
96        in
97            mkInstream streamIo
98        end
99
100        fun wrapOutFileDescr(n, name, buffering, isAppend) =
101        let
102            val buffSize = sys_get_buffsize n
103            val binPrimWr =
104                LibraryIOSupport.wrapBinOutFileDescr{fd=n,
105                    name=name, appendMode=isAppend, chunkSize=buffSize, initBlkMode=true}
106            (* Construct a stream. *)
107            val streamIo = StreamIO.mkOutstream(binPrimWr, buffering)
108        in
109            mkOutstream streamIo
110        end
111    in
112        (* Open a file for input. *)
113        fun openIn s =
114            wrapInFileDescr(
115                sys_open_in_bin s
116                    handle exn => raise mapToIo(exn, s, "BinIO.openIn"),
117                s)
118
119        (* Open a file for output. *)
120        fun openOut s =
121        let
122            val f = 
123                sys_open_out_bin s
124                    handle exn => raise mapToIo(exn, s, "BinIO.openOut")
125        in
126            wrapOutFileDescr (f, s, IO.BLOCK_BUF, false (* Not append *))
127        end
128
129        fun openAppend s =
130        let
131            val f = 
132                sys_open_append_bin s
133                    handle exn => raise mapToIo(exn, s, "BinIO.openAppend")
134        in
135            wrapOutFileDescr (f, s, IO.BLOCK_BUF, true (* setPos will not work. *))
136        end
137    end
138end;
139